ASMB
  HED .           T M S  -  I M A G E    L I B R A R Y
      NAM TMLIM,7 92903-16100 REV.1913  781218
  SPC 3 
**********************************************************************
*                                                                    *
*     NAME:   TMLIM     TMS-IMAGE CALL                               *
*     ENT:    TBGET,TBDEL,TBPUT,TBFND,TBUPD,TBULK                    *
*     SOURCE: &TMLIM    92903-18110                                  *
*     BINARY: %TMLIM    ----NONE---    PART OF  %TMSLB  92903-16100  *
*                                                                    *
*     PGMR:   FRANCOIS GAULLIER                                      *
*                                                                    *
**********************************************************************
      SPC 2 
*     **************************************************************
*     * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978.  ALL RIGHTS    *
*     * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- *
*     * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH-  *
*     * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.  *
*     **************************************************************
  SPC 3 
      ENT TBGET,TBDEL,TBPUT,TBFND,TBUPD,TBULK 
      ENT TBOPN 
      EXT $TML3,$TML5,$TML8 
      EXT .ENTR,.DRCT,EXEC,DORMT
  SPC 1 
A     EQU 0 
B     EQU 1 
      SUP 
   HED TERMINAL-MONITOR  DBOPN REQUEST
TBOPN NOP 
      CLA 
      JSB GETPA 
 SPC 1
      JSB UNLCK     UNLOCK ALL RECORD FROM PREVIOUS DB
  SPC 1 
      LDA .PAR1 
      INA           SKIP THE 1ST WORD 
      LDB ..PA1     AND MOVE DBNAME INTO .PAR7
      ADB D6
      MVW D4
* 
      LDA .PAR4     IMG STATUS ADDR 
      LDB .PAR1     DB# ADDR
      DST .PAR2     SAVE THEM 
      LDA RTRN      SAVE USER RETURN ADDR 
      STA .PAR1     TO HAVE IT ON RETURN
      LDA RTNAD     GET RETURN ADDR INTO TMLIM
      STA RTRN      SO TMLIB VILL RETURN INTO TMLIM 
      LDA ..PA1     A = PARAM ADDR
      JMP .EXIT,I   GOTO TMLIB
* 
RTNAD DEF *+1 
      JSB RCONF     RESET POINTER 
      LDA .SAVR     RECALL STATUS FROM CB1[14:17] 
      ADA D2
      LDB .PAR2     ADDR OF USER STATUS BUFFER
      MVW D4        MOVE THE STATUS IN USER BUFFER
      LDA .SAVR,I   RECALL DB#
      ALF,RAR 
      STA .PAR3,I   AND STORE IT INTO 1ST WORD OF DBNAME
  SPC 1 
RTN   LDA .IMPG     RETURN TO THE USER FROM A TMS-IMAGE CALL
      LDB .SCB1     SAVE CB1[6:13] TO MAKE SUR THE USER 
      MVW D8        DO NOT MODIFY THOSE WORDS.
      JMP .PAR1,I   RETURN
   HED TERMINAL-MONITOR  DBGET REQUEST
TBGET NOP 
      LDA D2        SUBROUTINE CODE=2 FOR READ
      JSB GETPA     GO GET PARAMETER
   SPC 1
      CLB           SET UP IARG LENGTH
      LDA .PAR3,I   RECALL MODE 
      ADA DM3       IF MODE 1 & 2 NO IARG 
      SSA,RSS 
      LDB .MITL,I   IT IS MODE 3 OR 4, GET MAX ITEM LEN 
      STB TEMP
* 
      LDB .PAR7     LOCK WORD ADDR
      JSB GETLW     GET LOCK WORD 
      LDA .SAVR     MOVE SAVE RUN TABLE BUFFER
      MVW D8
      LDA .PAR3,I   GET MODE
      STA B,I 
      INB 
      LDA .PAR2     MOVE DATA SET NAME
      MVW D3
      LDA .PAR6     MOVE IARG 
      MVW TEMP
      ADB M.BUF     COMPUTE MAIL BOX LENGTH 
      STB BUFLN     SET MAIL BOX LENGTH 
* 
      LDA .PAR4     STATUS USER ADDR
      LDB .PAR5     USER BUFFER ADDR
TBGE8 JSB SENDI     GIVE PARAM. ADDR. TO TMLIB & GOTO TMLIB TO SUSP.
  SPC 1 
      JSB RECMB     RESTORE PARM ADDR & RECEIVE MAIL BOX
      LDA BUF+1     RECALL TMS-IMAGE-RQ-COD 
      LDB D4        IMAGE STATUS LENGTH 
      ADA DM4       SUBSTRACT 4 FORM IMRQC
      SSA,RSS       DBGET OR DBFND CALL ? 
      CLB,INB       NO, IMAGE STATUS LENGTH IS 1
      STB TEMP      SET IMAGE STATUS LENGTH 
* 
      LDA .RCBU     STORE VALUE INTO USER BUFFER
      LDB .SAVR     RESTORE SAVE RUN TABLE BUFFER 
      MVW D8
      LDB .PAR2     STORE IMAGE STATUS IN USER BUFFER 
      MVW TEMP
      LDB .PAR2,I   RECALL IMAGE STATUS 
      SZB           WAS IT OK ? 
      JMP RTN       NO, DO NOT STORE ENTRY INTO USER BUF. 
      LDB .PAR3     STORE ENTRY (DATA RECORD + MEDIA RECORD)
      SZB,RSS       USER BUFFER ADDR DEFINED ?
      JMP RTN       NO, RETURN IMMEDIATELY
      INA           SKIP WORD COUNT 
      MVW RCBUF+12  USE ENTRY LENGTH
      JMP RTN       RETURN TO USER CODE 
* 
D8    DEC 8 
DM4   DEC -4
.RCBU DEF RCBUF 
  HED TMS-IMAGE  TBULK REQUEST
TBULK NOP 
      LDA D8
      JSB GETPA 
  SPC 1 
      JSB UNLCK     UNLOCK ALL RECORDS OWN BY THE PROCESS 
   SPC 1
RTNDI LDA RTRN      RETURN TO THE USER DIRECTLY 
      STA .PAR1     SET RETURN ADDR 
      JMP RTN       AND GO TO CENTRAL RETURN PROCESS
  SPC 2 
UNLCK NOP 
      LDA .SAVR,I   GET LOCK ID WORD
      AND PIDMK     ISOLATE PID 
      SZA,RSS       ID DEFINED ?
      JMP UNLCK,I   NO, FORGET THE CALL 
      LDA .SAVR,I   YES, RECALL  DB# - PID
      STA BUF       SEND IT TO TMSYS
      AND DBMSK     KEEP DB# BUT CLEAR PID
      STA .SAVR,I   TO RETURN LCKID TO THE USER 
* 
      JSB EXEC      SEND BUFFER TO TMSYS (USING EXTERNAL CLASS) 
      DEF *+8 
      DEF D20       CLASS I/O WRITE/READ
      DEF D0        DUMMY LU
      DEF BUF       BUFFER SEND 
      DEF D1        BUFFER LENGTH 
      DEF STKPT     1ST PARAM. (STACK POINTER)
      DEF ULKCD     2ND PARAM. (TMS INTERNAL SUBR. CODE)
      DEF ECLAS     TMS EXTERNAL CLASS I/O WORD 
      JMP UNLCK,I 
   SPC 2
D1    DEC 1 
D20   DEC 20
PIDMK OCT 17777 
DBMSK OCT 160000
   SPC 2
IMSCD EQU 23
ULKCD DEC 16
  HED TMS-IMAGE  DBFND REQUEST
TBFND NOP 
      LDA D3
      JSB GETPA 
  SPC 1 
      LDB .PAR6     LOCK WORD ADDR
      JSB GETLW     GET LOCK WORD 
      LDA .SAVR     MOVE SAVE RUN TABLE BUFFER
      MVW D8
      LDA .PAR3     MOVE DATA SET NAME
      MVW D3
      LDA .PAR4     MOVE KEY ITEM NAME (IPATH)
      MVW D3
      LDA .PAR5     MOVE KEY ITEM VALUE (IARG)
      MVW .MITL,I 
      ADB M.BUF 
      STB BUFLN     SET MAIL BOX LENGTH 
* 
      LDA .PAR2     USER BUFFER ADDR FOR STATUS 
      CLB           NO BUFFER ADDR (DBGET COMPATIBLE) 
      JMP TBGE8     USE DBGET CODE TO FINISH
  SPC 2 
.MITL DEF *+1 
      DEC 50        MAXIMUM ITEM LENGTH IN WORD (DEFAULT) 
.METL DEF *+1 
      DEC 256       MAXIMUM ENTRY LENGTH IN WORD (DEFAULT)
* 
MBUFL DEC 271       MAXIMUM BUF LEN RETURNED BY TMS-IMAGE-MODULE
  HED TMS-IMAGE  DBPUT/DBUPD/DBDEL REQUEST
TBPUT NOP 
      LDA D4
      JSB GETPA 
  SPC 1 
      LDB .D2       FORCE SPECIAL LOCK WORD TO UNLCK
      JSB GETLW     GET UNLOCK REQUEST ONLY 
      LDA .SAVR,I   GET LOCK WORD ID
      STA B,I 
      INB 
TBPU5 LDA .PAR2     MOVE DATA SET NAME
      MVW D3
      LDA .PAR4,I   GET NUMBER OF DEFINED ITEM #
      INA           FOR WORD COUNT
      STA TEMP
      LDA .PAR4     MOVE ITEM # DEFINTION ARRAY (INBR)
      MVW TEMP
      LDA .PAR5     MOVE ITEMS VALUE (IVALU)
      MVW .METL,I 
TBUP8 ADB M.BUF     COMPUTE BUFFER LENGTH 
      STB BUFLN     SET BUFFER LENGTH 
* 
      LDA .PAR3     SAVE USER STATUS ADDR 
      CLB 
      JSB SENDI     SAVE PARAM ADDR & SEND MAIL BOX 
  SPC 1 
      JSB RECMB     RESTORE PARAM ADDR & RECEIVE MAIL BOX 
      LDA RCBUF     RECALL IMAGE STATUS 
      STA .PAR2,I   AND STORE IT INTO USER BUFFER 
      JMP RTN       RETURN TO USER
  SPC 2 
TBUPD NOP 
      LDA D5
      JSB GETPA 
  SPC 1 
      LDB .D2       FORCE SPECIAL LOCK WORD TO UNLCK
      JSB GETLW     GET UNLOCK REQUEST ONLY 
      LDA .SAVR     MOVE SAVE RUN TABLE BUFFER
      MVW D8
      JMP TBPU5     FINISHES LIKE DBPUT CALL
  SPC 2 
TBDEL NOP 
      LDA D6
      JSB GETPA 
  SPC 1 
      LDB .D2       FORCE SPECIAL LOCK WORD TO UNLCK
      JSB GETLW     GET UNLOCK REQUEST ONLY 
      LDA .SAVR     MOVE SAVE RUN TABLE AREA
      MVW D8
      LDA .PAR2     MOVE DATA SET NAME
      MVW D3
      JMP TBUP8 
* 
.D2   DEF D2
  HED GENERAL TRANSFERT PARAMETER ADDRESS ROUTINE 
GETPA NOP 
      LDB GETPA 
      ADB DM3 
      LDB B,I 
      STB RTRN
      ADB DM1 
      STB XSUSP 
      LDX PAR#
      CLB           CLEAR FUTUR PARAMETERS ADRESSES 
      SBX .PAR1-1   TO KNOW HOW MANY PARAMETERS ARE 
      DSX           PASSED
      JMP *-3 
      STA IMRQC     SET UP IMAGE-REQUEST-CODE 
      STA .PA15     SET UP IMAGE-REQUEST-CODE 
      JMP RTRN+1
  SPC 1 
.PAR1 NOP 
.PAR2 NOP 
.PAR3 NOP 
.PAR4 NOP 
.PAR5 NOP 
.PAR6 NOP 
.PAR7 NOP 
      BSS 7 
.PA15 NOP 
RQCNT NOP 
XSUSP NOP 
      ABS IMSCD     TMS INTERNAL SUBROUTINE CODE FOR IMAGE RQ 
RTRN  NOP 
      JSB .ENTR     GET PARAMETERS ADDRESS
..PA1 DEF .PAR1     (HOPE IT IS MICRO-CODED)
* 
      CLA 
      STA RQCNT     TO BE SURE THAT THE LOOP WILL END 
      LDX D0
GETP7 LAX .PAR1 
      SZA,RSS       PARAMETER HERE ?
      JMP GETP8     NO, END OF LIST REACHED 
      ISX           YES, INCREMENT X REG
      JMP GETP7     AND LOOP
* 
GETP8 CXA           SAVE # OF PARAMETERS
      STA RQCNT 
      ADA DM10      NEVER MORE THAN 9 PARAMETERS
      SSA,RSS 
      HLT 
      JSB CONF      RECONFIGURE PT ADDR 
      JMP GETPA,I 
  SPC 1 
PAR#. EQU RQCNT-.PAR1 
PAR#  ABS PAR#. 
  HED  UTILITY SUBROUTINE 
D0    DEC 0 
DM1   DEC -1
DM3   DEC -3
DM10  DEC -10 
   SPC 2
GETLW NOP           SET LOCK WORD AND INIT BUFFER POINTER 
      CLA           DEFAULT VALUE IS ZERO 
      LDA B,I       GET LOCK WORD VALUE 
      LDB .BUF      INIT B REG = BUFFER WORD POINTER
      STA B,I       STORE LOCK WORD INTO BUFFER 
      INB           BUMP POINTER BUFFER 
      JMP GETLW,I 
   SPC 3
SENDI NOP           SAVE USER PARAMETERS ADDR AND 
      STA .PAR2     SEND THE BUFFER TO IMAGE MODULE 
      STB .PAR3     THEN EXIT USING TMLIB.
      LDA RTRN      SAVE RETURN ADDR IN USER CODE 
      STA .PAR1 
      LDA BUFLN     ADJUST BUFFER LENGTH
      ADA D4
      STA BUFLN 
   SPC 1
*-------------------------------------
* 
*     JSB EXEC      CALL TMS-IMAGE-MODULE PROGRAM 
*     DEF *+10
*     DEF NAB24     QUEUE SCHEDULE - NO WAIT - NO ABORT 
*.IMPG NOP           PROGRAM NAME 
*     DEF * 
*     DEF * 
*     DEF * 
*     DEF * 
*     DEF * 
*     DEF IMRQC     BUFFER TO PASSED USING STRING PASSING 
*     DEF BUFLN     BUFFER LENGTH 
*     HLT 10B       ERROR RETURN
* 
*-------------------------------------
* 
      JSB EXEC      SEND THE REQUEST TO TMS-IMAGE-MODULE
      DEF *+8       USING THE IMAGE CLASS I/O 
      DEF NAB20     CLASS I/O WRITE/READ - NO ABORT 
      DEF D0        DUMMY LU
      DEF IMRQC     BUFFER ADDR 
      DEF BUFLN     BUFFER LENGTH 
      DEF *         1ST PARAM 
      DEF *         2ND PARAM 
.IMCL NOP           ADDR OF IMAGE CLASS I/O WORD
      HLT 22B       ERROR RETURN
      SZA           OK ?
      HLT 23B       ERROR !!
* 
      JSB DORMT     CHECK STATUS OF THE TMS-IMAGE-MODULE
      DEF *+3 
.IMPG NOP           PROGRAM NAME
      DEF RCONF     PROGRAM STATUS RETURNED HERE. 
* 
      SSA           DORMANT ? 
      HLT 23B       YES, IT IS IMPOSSIBLE !!! 
* 
      LDA RCONF     RECALL PROG STATUS
      AND B17       ISOLATE THE STATUS BITS 
      SZA           SCHEDULE ?
      JMP SEND3     YES, DO NOT ISSUE THE SCHEDULE
* 
      JSB EXEC      NO, SCHEDULE THE TMS-IMAGE-MODULE 
      DEF *+8 
      DEF NAB24     QUEUE SCHEDULE - NO WAIT - NA ABORT 
      DEF .IMPG,I   PROGRAM NAME
      DEF *         1ST PARAM 
      DEF *         2ND PARAM 
      DEF *         3RD PARAM 
      DEF DM1       4TH PARAM, SPECIAL FLAG ! 
      DEF *         5TH PARAM 
      HLT 25B       ERROR RETURN !! 
* 
*-------------------------------------
  SPC 1 
SEND3 LDA SENDI     GET RETURN ADDR 
      STA RTRN      AND SET TMS RETURN ADDR. INTO TMLIM 
      LDA ..PA1     SET A REG = ADDR OF PARAM. AREA 
      JMP .EXIT,I   AND GOTO TMLIB ---> TMSYS 
  SPC 3 
RCONF NOP           RESTORE PARAM ADDR
      CLA           INDICATE RETURN TO THE USER 
      JSB CONF      RECONFIGURE LOCAL TABLE ADDR
      LDA .PARX     RESTORE TMS FUNCTION PARAMETERS 
      LDB ..PA1     TO GET BACK USER PARAMETERS ADDR
      MVW D3
      JMP RCONF,I 
  SPC 2 
RECMB NOP           RESTORE PARAM ADDR & RECEIVE MAIL-BOX 
      JSB RCONF 
* 
      JSB EXEC      GET THE BUFFER FROM TMS-IMAGE-MODULE
      DEF *+7 
      DEF NAB21     CLASS I/O GET WITH NO-ABORT 
      DEF .ICLA,I   CLASS I/O WORD (TMS INTERNAL CLASS) 
.BUF  DEF BUF       BUFFER
      DEF MBUFL     BUFFER LENGTH 
      DEF PARM1 
      DEF PARM2 
      HLT 10B       ERROR RETURN
* 
      LDA PARM1     CHECK THAT CORRECT PARAMETERS 
      CPA STKPT     HAVE BEEN RETURNED BY THE 
      RSS           TMS-IMAGE-MODULE PROGRAM. 
      HLT 
      LDA PARM2 
      CPA STKPT+1 
      RSS 
      HLT 
* 
      JMP RECMB,I 
  SPC 1 
NAB20 OCT 100024
NAB21 OCT 100025
NAB24 OCT 100030
B17   OCT 17
BUFLN NOP 
   SKP
CONF  NOP 
      STA M.BUF     SAVE RETURN TO USER FLAG
      JSB .DRCT 
      DEF $TML3 
      STA .SCB1     ADDR OF LOCAL COPY OF CB1[6:13] 
      JSB .DRCT 
      DEF $TML5     PARAMETER TABLE ADDR
      LDB .TBL
      MVW D5
* 
      LDB .STKP,I   GET STACK POINTER 
      STB STKPT     SET STACK POINTER 
* 
      LDA .PARX     GET ADDR OF THE THREE FUNCTION PARAMETERS 
      ADA D3
      LDB A,I       GET CB1 ADDR
      ADB D5
      STB .IMPG     SAVE TMS-IMAGE MODULE PRG. NAME ADDR
      ADB D3
      STB .IMCL     SAVE TMS-IMAGE CLASS I/O ADDR 
      INB 
      STB .MITL     SAVE MAXIMUM ITEM LENGTH ADDR 
      INB 
      STB .METL     SAVE MAXIMUM ENTRY LENGTH ADDR
      INB 
      STB .SAVR     SAVE ADR OF THE SAVE RUN TABLE AREA 
      INA 
      LDA A,I       GET CB1 CURRENT LENGTH
      SSA           ENABLED ? 
      JMP ERM07     CB1 NOT ENABLED: ERROR 07 
      ADA DM19      YES, LENGTH MUST BE AT LEAST 19 
      SSA           LENGTH OK ? 
      JMP ERM07     CB1 TOO SMALL: ERROR 07 
* 
      LDB M.BUF     RECALL RETURN TO USER FLAG
      SSB,RSS       RETURN TO THE USER ?
      JMP CONF7     YES, D'ONT DO ANY CHECK 
* 
      LDA IMRQC     NO, VERIFY CB1[6:13] AND THE DB#
      SZA,RSS       SUPLLY BY THE USER, TBOPN REQUEST ? 
      JMP CONF7     YES, NO CHECK 
* 
      LDA .IMPG     NO, VERIFY CB1[6:13]
      LDB .SCB1     ADDR OF LOCAL COPY
      CMW D8        IS IT THE SAME ?
      JMP CONF4     YES, IT IS OK 
      NOP           NO
      JMP ERM08     NO, ABORT TMS WITH ERROR # 28 
* 
CONF4 LDA .SAVR,I   RECALL DB# FROM CB1(12) 
      AND DBMSK     ISOLATE IT AND
      ALF,RAR       ROTATE DB# TO LSB BIT 2-0 
      CPA .PAR1,I   IS IT THE DB# SUPPLY BY THE USER ?
      RSS           YES, IT IS OK 
      JMP ERM11     NO, RETURN IMAGE ERROR # 399
* 
CONF7 LDA .ECLA,I   GET TMS EXTERNAL CLASS I/O
      STA ECLAS 
      LDA .BUF
      CMA,INA 
      STA M.BUF     MINUS ADDR OF BUF 
      JMP CONF,I
* 
DM19  DEC -19 
  SPC 1 
.TBL  DEF *+1 
.EXIT NOP           ADDR TO EXIT INTO TMLIB 
.STKP NOP           ADDR OF THE STACK POINTER VALUE 
.PARX NOP           FUNCTION PARAMETERS ADDR. IN TMLIB
.ECLA NOP           TMS EXTERNAL CLASS I/O WORD ADDR
.ICLA NOP           TMS INTERNAL CLASS I/O WORD ADDR
  SPC 1 
.SAVR NOP           ADDR OF LOCK ID WORD
M.BUF NOP           MINUS ADDR OF  BUF
   SPC 3
ERM11 LDA D399      DBNAME IN TBXXX CALL IS WRONG 
      LDB IMRQC     RECALL SUBROUTINE CODE
      SZB           DBOPN ? 
      CPB D2        DBGET ? 
      STA .PAR4,I   YES, STORE STATUS 
      CPB D3        DBFND ? 
      STA .PAR2,I   YES, STORE STATUS 
      CPB D4        DBPUT ? 
      STA .PAR3,I   YES, STORE STATUS 
      CPB D5        DBUPD ? 
      STA .PAR3,I   YES, STORE STATUS 
      CPB D6        DBDEL ? 
      STA .PAR3,I   YES, STORE STATUS 
*     CPB D7        DBINF ? 
*     STA .    ,I   YES, STORE STATUS 
      JMP RTNDI     AND RETURN ERROR CODE TO THE USER 
* 
ERM07 LDA D7        CB1 NOT ENABLED OR TOO SMALL
      JMP $TML8 
* 
ERM08 LDA D8        USER HAS MODIFIED CB1[6:13] 
      JMP $TML8 
   SPC 3
D2    DEC 2 
D3    DEC 3 
D4    DEC 4 
D5    DEC 5 
D6    DEC 6 
D7    DEC 7 
D399  DEC 399 
  SPC 1 
TEMP  NOP 
PARM1 NOP 
PARM2 NOP 
  SPC 1 
.SCB1 NOP           ADDR. OF LOCAL COPY OF  CB1[6:13] 
  SPC 2 
*                   BUFFER SEND FORM TMLIM TO TMSIM 
  SPC 1 
IMRQC NOP           IMAGE REQUEST CODE
ECLAS NOP           TMS EXTERNAL CLASS I/O WORD 
STKPT NOP           PARAMETER THAT MUST BE SEND BACK WITH ANSWER
      ABS IMSCD     (STACK POINTER/TMS INTERNAL SUBROUTINE CODE)
BUF   BSS 389       (1+1+3+128+256 TO SEND DBPUT) 
  SPC 1 
RCBUF EQU BUF+2 
  SPC 2 
      UNS 
* 
      ORG *         DEFINE LAST LOCATION
      END 
                                                                                                                                                                                                                