ASMB
  HED .           T M S  -  I M A G E    L I B R A R Y
      NAM TMLIM,7 92080-1X110 REV.2026  800523 1600 
  SPC 3 
**********************************************************************
*                                                                    *
*     NAME:   TMLIM     TMS-IMAGE CALL                               *
*     ENT:    TBGET,TBDEL,TBPUT,TBFND,TBUPD,TBULK                    *
*     SOURCE: &TMLIM    92080-18110                                  *
*     BINARY: %TMLIM    ----NONE---    PART OF  $TMSLB  92080-12100  *
*                                                                    *
*     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,ISCAN,PUTCA
*REQ  EXT DMPTM 
  SPC 1 
A     EQU 0 
B     EQU 1 
      SUP 
   HED TERMINAL-MONITOR  DBOPN REQUEST
* 
* PARAMETERS PASSED TO TBOPN CALL 
* 
*     .PAR1 - IBASE (NAMR, 1ST WD MUST BE BLANK)
*     .PAR2 - ILEVL (DUMMY PARAMETER) 
*     .PAR3 - IMODE (DUMMY PARAMETER) 
*     .PAR4 - ISTAT (STATUS RETURN ARRAY) 
* 
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 DBNAMR INTO .PAR6
      ADB D4
      MVW D10 
* 
      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 
*     JSB DMPTM 
*     DEF *+7 
*     DEF D6
*     DEF .PAR6 
*     DEF D20 
*     DEF MES1
*     DEF D20 
*     DEF D2
      LDA ..PA1     A = PARAM ADDR
      JMP .EXIT,I   GOTO TMLIB
* 
RTNAD DEF *+1 
      JSB RCONF     RESET POINTER 
*     JSB DMPTM 
*     DEF *+7 
*     DEF D6
*     DEF .SAVR,I 
*     DEF D20 
*     DEF MES2
*     DEF D20 
*     DEF D0
      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 SURE THE USER
      MVW D8        DOES NOT MODIFY THOSE WORDS.
      JMP .PAR1,I   RETURN
*ES1  ASC 20, TMLIM BEFORE $MTMS
*ES2  ASC 20, TMLIM AFTER  $MTMS
   HED TERMINAL-MONITOR  DBGET REQUEST
* 
* PARAMETERS PASSED IN TBGET CALL 
* 
*     .PAR1 - TMS INTERNAL DB#
*     .PAR2 - DS# 
*     .PAR3 - IMODE 
*     .PAR4 - ISTAT 
*     .PAR5 - ILIST 
*     .PAR6 - IBUF
*     .PAR7 - IARG
*     .PAR8 - LOCK WD 
* 
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 
      CPA D4        IF MODE 4 (DIRECTED READ), IARG HAS LENGTH 2
      LDB D2
      CPA D7        IF MODE 7 (USE MAX LEN) 
      LDB .MITL,I 
      STB TEMP
* 
      LDB .PAR7 
      STB .IARG     SAVE IARG ADDR
      LDB .PAR8 
      SZB,RSS       LOCK WORD DEFINED IN CALL?
      LDB .D0            NO, SET LOCK WORD PARAMETER TO 0 
      STB .LCKW     SAVE LOCK WORD ADDR 
* 
      JSB MVPAR     MOVE PARAMETERS INTO IMAGE MODULE REQUEST BUFFER
* 
      LDB .PAR6     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
      LDB D10        IMAGE STATUS LENGTH
      STB TEMP      SET IMAGE STATUS LENGTH 
* 
      LDA .RCBU     STORE VALUE INTO USER BUFFER
      LDB .PAR2     RESTORE IMAGE STATUS
      MVW TEMP
      LDB .SAVR     STORE RUN TABLE BUFFER
      MVW D12 
      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+22  USE ENTRY LENGTH
      JMP RTN       RETURN TO USER CODE 
* 
.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 
*REQ  JSB DMPTM 
*REQ  DEF *+7 
*REQ  DEF D6
*REQ  DEF BUF 
*REQ  DEF D20 
*REQ  DEF TBMES 
*REQ  DEF D20 
*REQ  DEF D1
      JMP UNLCK,I 
   SPC 2
*REQS ASC 20, TBULK, TMLIM
PIDMK OCT 17777 
DBMSK OCT 160000
   SPC 2
IMSCD EQU 23
ULKCD DEC 16
  HED TMS-IMAGE  DBFND REQUEST
* 
* PARAMETERS PASSED TO TBFND FROM CALLING PROGRAM 
* 
*     .PAR1 - TMS INTERNAL DB#
*     .PAR2 - DS# 
*     .PAR3 - IMODE 
*     .PAR4 - STATUS
*     .PAR5 - NAME LIST 
*     .PAR6 - VALUE LIST
*     .PAR7 - LOCK WORD 
* 
TBFND NOP 
      LDA D3
      JSB GETPA 
* 
  SPC 1 
* 
      LDB .MITL,I 
      STB TEMP      SET UP MAX VALUE LIST COUNT 
      LDB .PAR6     VALUE LIST ADDR 
      STB .IARG 
      LDB .PAR7 
      SZB,RSS       LOCK WORD DEFINED IN CALL ? 
      LDB .D0            NO, SET LOCK WORD PARAMETER TO 0 
      STB .LCKW     LOCK WD ADDR
* 
      JSB MVPAR     STORE PARAMETERS  TO BE PASSED TO IMAGE MODULE
* 
      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 570       MAXIMUM BUF LEN RETURNED BY TMS-IMAGE-MODULE
  HED TMS-IMAGE  DBPUT/DBUPD/DBDEL REQUEST
* 
* PARAMETERS PASSED TO TBPUT, TBUPD, TBDEL
* 
*     .PAR1 - TMS INTERNAL DB#
*     .PAR2 - DS# 
*     .PAR3 - MODE
*     .PAR4 - STATUS
*     .PAR5 - NAME LIST     (NOT USED BY TBDEL) 
*     .PAR6 - VALUE LIST      "   "   "    "
* 
TBPUT NOP 
      LDA D4
      JSB GETPA 
* 
TBPU5 LDB .METL,I     GET MAX VALUE LIST LENGTH 
      STB TEMP
      LDB .PAR6       SAVE VALUE LIST ADDR
      STB .IARG 
TBPU7 LDB .D2       FORCE SPECIAL LOCK WORD TO UNLCK
      STB .LCKW 
* 
      JSB MVPAR     MOVE PARAMETERS INTO IMAGE MODULE BUFFER
* 
      CLB 
      JSB SENDI     SAVE PARAM ADDR & SEND MAIL BOX 
  SPC 1 
      JSB RECMB     RESTORE PARAM ADDR & RECEIVE MAIL BOX 
      LDA .RCBU     RECALL IMAGE STATUS 
      LDB .PAR2 
      MVW D10 
      JMP RTN       RETURN TO USER
  SPC 2 
TBUPD NOP 
      LDA D5
      JSB GETPA 
      JMP TBPU5     EXACTLY LIKE DBPUT CALL 
  SPC 2 
TBDEL NOP 
      LDA D6
      JSB GETPA 
      CLB 
      STB TEMP      NO VALUE LIST 
      STB .IARG 
      JMP TBPU7 
* 
  HED SAVE PARAMETERS TO BE PASSED TO TMS IMAGE MODULE
MVPAR NOP 
      CLA 
      STA LLIST 
      LDA IMRQC      GET REQUEST CODE 
      CPA D6         TBDEL CALL ? 
      JMP MVPA2      YES, SKIP NAME LIST LENGTH CALCULATION 
      JSB LISTL 
      STA LLIST 
* 
MVPA2 LDA .LCKW,I   GET LOCK WD ADDR
      LDB .BUF      GET START OF BUFFER TO PASS TO $ITMS
      STA B,I       SAVE LOCK WD
      INB 
* 
      LDA .SAVR     MOVE SAVE RT BUFFER 
      MVW D12 
* 
      LDA .PAR3,I   SAVE MODE 
      STA B,I 
      INB 
* 
      LDA .PAR2     SAVE DATA SET NAME
      MVW D8
* 
      LDA LLIST     SAVE LIST LENGTH
      STA B,I 
      INB 
* 
      LDA .PAR5     SAVE NAME-LIST
      MVW LLIST 
* 
      LDA .IARG     SAVE IARG/VALUE LIST
      MVW TEMP
* 
      ADB M.BUF     CALCULATE TOTAL BUFFER LENGTH 
      STB BUFLN 
* 
      JMP MVPAR,I 
* 
.LCKW BSS 1 
.IARG BSS 1 
LLIST BSS 1 
* 
* 
* CALCULATE NAME-LIST LENGTH
* 
* 
LISTL NOP 
      LDA .PAR5     GET NAME LIST ADDR
      STA LIST2 
* 
      LDB A,I 
      CPB A@BL      @^ SPECIAL CHARACTER ?
      JMP LIST7     YES, RETURN WITH LENGTH = 1 
* 
      CPB A0BL      0^ SPECIAL CHARACTER ?
      JMP LIST7     YES, RETURN WITH LENGTH = 1 
* 
      CPB D0        0 (NUMERIC) ? 
      JMP LIST7     YES, RETURN WITH LENGTH =1
* 
      LDA B 
      ADB DM256     ASCII OR INTEGER ?
      SSB 
      JMP LIST8     INTEGER, LIST LENGTH IN FIRST WD
* 
      CLA,INA       ASCII, USE ISCAN TO CALCULATE LIST LENGTH 
      STA LISTE 
      JSB ISCAN 
      DEF *+5 
LIST2 NOP           NAME LIST ADDR
      DEF LISTE     RETURN FOR STRING LENGTH
      DEF BSCOL     BLANK - TERMINATOR CHAR, ; - TEST CHAR
      DEF D0
* 
      JSB PUTCA 
      DEF *+4       PUT BLANK IN TERMINATOR POSITION
      DEF LIST2,I 
      DEF BSCOL 
      DEF LISTE 
* 
      LDB D6  
      LDA LISTE     MAKE SURE THAT LENGTH IS .GE. 6 
      ADA DM6 
      SSA           IS LENGTH .GE. 6? 
      STB LISTE        NO, SET LENGTH = 6 
* 
      LDA LISTE     CONVERT BYTE COUNT TO WD COUNT
      INA 
      ARS 
* 
      JMP LISTL,I   RETURN WITH WD COUNT IN A 
* 
LIST7 CLA,INA 
      JMP LISTL,I 
* 
LIST8 LDB IMRQC     CHECK IF FUNCTION IS TBFND
      CPB D3
      CLA           TBFND, LIST LENGTH IS 1 
      INA 
      JMP LISTL,I 
* 
* 
* 
BSCOL ASC 1, ;
A@BL  ASC 1,@ 
A0BL  ASC 1,0 
LISTE BSS 1 
  HED GENERAL TRANSFER 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 
.PAR8 NOP 
      BSS 6 
.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)
* 
*     JSB DMPTM 
*     DEF *+7 
*     DEF D6
*     DEF IMRQC 
*     DEF D1
*     DEF MES1
*     DEF D20 
*     DEF D0
      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 DM9       NEVER MORE THAN 8 PARAMETERS
      SSA,RSS 
      HLT 
      JSB CONF      RECONFIGURE PT ADDR 
      JMP GETPA,I 
  SPC 1 
PAR#. EQU RQCNT-.PAR1 
PAR#  ABS PAR#. 
  HED  UTILITY SUBROUTINE 
   SPC 2
   SPC 3
* 
* UPON ENTRY TO THIS ROUTINE, B MUST CONTAIN THE USER DATA BUFFER ADDR
* 
SENDI NOP           SAVE USER PARAMETERS ADDR AND 
      LDA .PAR4 
      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
      JMP SENER     ERROR RETURN
      SZA           OK ?
      JMP SENER     ERROR !!
*     JSB DMPTM 
*     DEF *+7 
*     DEF D6
*     DEF IMRQC 
*     DEF BUFLN 
*     DEF MES1
*     DEF D20 
*     DEF D1
* 
      JSB DORMT     CHECK STATUS OF THE TMS-IMAGE-MODULE
      DEF *+3 
.IMPG NOP           PROGRAM NAME
      DEF RCONF     PROGRAM STATUS RETURNED HERE. 
* 
      SSA           DORMANT ? 
      JMP SENER     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 
      JMP SENER     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 1 
SENER CLA,INA       ERROR 1, IMAGE PROGRAM NOT PRESENT
      LDB IMRQC 
      DST .PAR2,I 
      JMP RTN 
  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
*     JSB DMPTM 
*     DEF *+7 
*     DEF D6
*     DEF BUF 
*     DEF MBUFL 
*     DEF MES2
*     DEF D20 
*     DEF D1
* 
      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:16] 
      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 DM23      YES, LENGTH MUST BE AT LEAST 23 
      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:16] 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 # 472
* 
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
* 
  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 D472      DBNAME IN TBXXX CALL IS WRONG 
      LDB IMRQC     RECALL SUBROUTINE CODE
      STA .PAR4,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:16] 
      JMP $TML8 
   SPC 3
.D0   DEF D0
.D2   DEF D2
DM256 DEC -256
DM23  DEC -23 
DM10  DEC -10 
DM9   DEC -9
DM6   DEC -6
DM4   DEC -4
DM3   DEC -3
DM1   DEC -1
D0    DEC 0 
D1    DEC 1 
D2    DEC 2 
D3    DEC 3 
D4    DEC 4 
D5    DEC 5 
D6    DEC 6 
D7    DEC 7 
D8    DEC 8 
D9    DEC 9 
D10   DEC 10
D11   DEC 11
D12   DEC 12
D20   DEC 20
D472  DEC 472 
  SPC 1 
TEMP  NOP 
PARM1 NOP 
PARM2 NOP 
  SPC 1 
.SCB1 NOP           ADDR. OF LOCAL COPY OF  CB1[6:16] 
  SPC 2 
*                   BUFFER SEND FROM 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 566       (1+1+2+23+543 TO SEND DBPUT)
  SPC 1 
RCBUF EQU BUF+2 
  SPC 2 
      UNS 
* 
      ORG *         DEFINE LAST LOCATION
      END 
                                                                                                                                                        