ASMB
  HED .           T M S  -  I M A G E    U S E R   L I B R A R Y
      NAM XMLIM,7 92080-16594 REV.2026  800528 1100 
  SPC 3 
**********************************************************************
*                                                                    *
*     NAME:   XMLIM     TMS-IMAGE USER CALLS                         *
*     ENT:    XBGET,XBDEL,XBPUT,XBFND,XBUPD,XBULK,XBINF,XBSND        *
*     SOURCE: &XMLIM    92080-18594                                  *
*     BINARY: %XMLIM    92080-16594                                  *
*                                                                    *
*     PGMR:   FRANCOIS GAULLIER, MILES NAKAMURA                      *
*                                                                    *
**********************************************************************
      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 XBGET,XBDEL,XBPUT,XBFND,XBUPD,XBULK 
      ENT XBOPN,XBCLS,XBINF,XBSND 
      EXT .ENTR,EXEC,DORMT,ISCAN,NAMR,RMPAR,LOGLU 
      EXT ISBTW,NUL,KLCLS,PUTCA,PNAME 
*     EXT DUBGR 
*REQ  EXT DMPTM 
  SPC 1 
A     EQU 0 
B     EQU 1 
      SUP 
   HED TERMINAL-MONITOR  DBOPN REQUEST
* 
**********************************************************************
* 
* XBOPN - XMLIM DBOPN CALL
* XBOPN PROCESS DESCRIPTON: 
* 
*     1 - THE PARAMETERS OF THE XBOPN CALL ARE RETRIEVED BY GETPA.
*     2 - IF THE CALLING PROGRAM IS DCRCV, THEN THE OPEN MODE IS SET
*         TO -3.  OTHERWISE, THE DATA-BASE IS OPENED IN MODE 1. 
*     3 - A CHECK IS MADE TO INSURE THAT THE NUMBER OF OPEN DATA-BASES
*         WILL NOT EXCEED 8. (ERROR NO. 470)
*     4 - THE DATA-BASE NAMR ARRAY IS PARSED TO GET THE NAME, SEC.
*         CODE, CR. NO. 
*     5 - THE DATA-BASE SAVE TABLE IS ACCESSED TO INSURE THAT THE 
*         CALLING PROGRAM HAS NOT ALREADY OPENED THE DATA-BASE, AND TO
*         FIND AN EMPTY ENTRY TO STORE THE NEW DATA-BASE INFORMATION
*         IN. 
*     6 - THE OPEN REQUEST IS ISSUED TO THE TMS-IMAGE MODULE. 
*     7 - THE DATA-BASE SAVE TABLE IS INITIALIZED FOR THIS DATA-BASE. 
*     8 - ALL ENTRIES PREVIOUSLY LOCKED BY THIS PROCESS FOR THIS
*         DATA-BASE ARE UNLOCKED. 
*     9 - THE IO CLASS ON WHICH XMLIM IS TO RECEIVE DATA FROM THE 
*         TMS-IMAGE MODULE IS ALLOCATED, IF IT HAS NOT BEEN DONE
*         PREVIOUSLY. 
*    10 - CONTROL IS RETURNED TO THE USER.
* 
* 
* PARAMETERS PASSED TO XBOPN CALL 
* 
*     .PAR1 - IBASE (NAMR, 1ST WD MUST BE BLANK)
*     .PAR2 - ILEVL (DUMMY PARAMETER) 
*     .PAR3 - IMODE (DISABLED FOR NOW)  
*                   1 - SHARED READ/WRITE 
*                   3 - EXCLUSIVE READ/WRITE  (-3, INHIBIT LOGGING) 
*                   8 - SHARED READONLY 
*     .PAR4 - ISTAT (STATUS RETURN ARRAY) 
* 
**********************************************************************
* 
XBOPN NOP 
* 
*---------------------------------------------------------------------
*  1 - GET XBOPN CALL PARAMETERS
*---------------------------------------------------------------------
* 
      CLA 
      JSB GETPA 
* 
*---------------------------------------------------------------------
*  2 - GET NAME OF CALLING PROGRAM, IF DCRCV, MODE=-3, ELSE MODE=1
*---------------------------------------------------------------------
* 
      JSB PNAME     GET PROGRAM NAME
      DEF *+2 
      DEF BUF 
* 
      LDA .BUF      GET ADDR OF PROGRAM NAME
      LDB .DCRC     GET ADDR OF "DCRCV" 
      CMW D3        IS THE PROGRAM NAME "DCRCV" ? 
      JMP XBOP1             
      NOP                 
      CLA,INA,RSS      NO, SET OPEN MODE TO 1 
XBOP1 LDA DM3          YES, SET OPEN MODE TO -3 FOR RECOVERY
      STA MODE
      LDA .BUF      GET ADDR OF PROGRAM NAME
      LDB .TMP1     GET ADDR OF "TMP1"
      CMW D2        IS THE PROGRAM NAME "TMP1" ?
      JMP ER474        YES, ERROR 474, XMLIM CALL FROM DATACAP SUB
      NOP              NO, VERIFY THAT IT IS NOT TMP2 
      LDA .BUF      GET ADDR OF PROGRAM NAME
      LDB .TMP2     GET ADDR OF "TMP2"
      CMW D2        IS THE PROGRAM NAME "TMP2"
      JMP ER474        YES, ERROR 474, XMLIM CALL FROM DATACAP SUB
      NOP              NO, CONTINUE 
* 
*---------------------------------------------------------------------
*  3 - MAKE SURE THAT THE MAX. NO. OF OPEN DATA-BASES WILL NOT BE 
*      EXCEEDED BY THIS CALL. 
*---------------------------------------------------------------------
* 
      LDA NDBOP     GET NO. OF DATA-BASES ALREADY OPEN
      CPA D8        =8? 
      JMP OPER1          YES, OPEN ERROR #470 
*                        NO, CONTINUE 
* 
*---------------------------------------------------------------------
*  4 - PARSE DATA-BASE NAMR TO GET:  DATA-BASE PROGRAM NAME, SEC. CODE, 
*      CR. NO.
*      INFORMATION RETURNED IN BUF: 
* 
*           BUF+0 - BUF+2  - DATA-BASE/PROGRAM NAME 
*           BUF+3          - NOT USED 
*           BUF+4          - SEC. CODE
*           BUF+5 -        - CR. NO.
*---------------------------------------------------------------------
* 
      LDA .PAR1     GET ADDRESS OF USER'S NAMR BUFFER 
      INA 
      LDB .BF10 
      MVW D12       MOVE NAMR TO BUF+10 
* 
      CLA,INA       SET NAMR LENGTH TO 1
      STA NAMRL 
      JSB ISCAN     CALCULATE CHARACTER LENGTH OF NAMR
      DEF *+5 
.BF10 DEF BUF+10
      DEF NAMRL 
      DEF BSCOL 
      DEF D0
* 
      JSB PUTCA     PUT , AFTER LAST CHARACTER OF NAMR
      DEF *+4 
      DEF BUF+10
      DEF COMBL 
      DEF NAMRL 
* 
      CLA,INA       SET COUNT TO 1 FOR CALL TO NAMR 
      STA DUMMY 
* 
      JSB NAMR      PARSE NAMR
      DEF *+5 
      DEF BUF       NAME, SEC CODE, CRNO OUTPUT BUFFER
      DEF BUF+10    NAMR IN BUF+10
      DEF NAMRL     CR. NO. IN BUF+5
      DEF DUMMY 
* 
*---------------------------------------------------------------------
*  5 - VERIFY THAT DATA-BASE IS NOT ALREADY OPEN        
*      CALCULATE D.B. SAVE TABLE ENTRY ADDR AND INTERNAL D.B. NO. 
*---------------------------------------------------------------------
* 
      LDB .DBSV     GET POINTER TO D.B. SAVE TABLE
      LDY DM8       Y = -MAX. NO. OF D.B.  (8)
* 
XBOP2 LDA B,I       GET FIRST D.B. ENTRY
      SZA,RSS       AVAILABLE? (A=0?) 
      JMP XBOP3          YES, SAVE NUMBER AND ADDR
* 
      LDA .BUF           NO, NAME OF OPENED DATA BASE IN TABLE
      CMW D3             IS IT SAME D.B. AS ONE IN CALL?
      JMP ER150             YES, ERROR 150, OPEN D.B TWICE
      NOP 
      ADB D15               NO, POINT TO NEXT D.B. ENTRY  
      JMP XBO31 
* 
XBOP3 CYA           AVAILABLE ENTRY FOUND 
      ADA D8        CALCULATE INTERNAL D.B. NO. 
      STA SVDBN     SAVE XMLIM INTERNAL D.B. NO.
      STB SVTBE     SAVE ENTRY ADDR 
      ADB D18       POINT TO NEXT ENTRY ADDR
* 
XBO31 ISY           ALL ENTRIES CHECKED?
      JMP XBOP2          NO, CHECK NEXT ONE 
* 
*---------------------------------------------------------------------
*  6 - ISSUE OPEN REQUEST TO IMAGE MODULE USING STRING PASSING
*      FORMAT OF STRING BUFFER SENT TO IMAGE MODULE:
* 
*           IMRQC         - IMAGE REQUEST CODE (0)
*           RECVC         - NOT USED
*           CHECK         - 125252
*           CHECK+1       -  52525
*           BUF+0 - BUF+2 - DATA-BASE/PROGRAM NAME
*           BUF+3 - BUF+5 - LEVEL ACCESS WORD 
*           BUF+6         - SEC. CODE.
*           BUF+7         - CR. NO. 
*           BUF+8         - D.S. NODE # (NOT USED)
*           BUF+9         - OPEN MODE 
* 
*      RESULTS ARE RETURNED IN A RMPAR STRING 
*      FORMAT:
* 
*           BUF+10 - NEG. IMAGE INTERNAL D.B. NO. IF OK / POS. STATUS 
*                    IF ERROR 
*           BUF+11 - SEND CLASS I-O WORD (CLASS IO ON WHICH DATA IS 
*                    SENT TO THE IMAGE MODULE)
*           BUF+12 - DATA-BASE CRC (NOT USED HERE)
*           BUF+13 - MAX ITEM LENGTH
*           BUF+14 - MAX ENTRY LENGTH 
*---------------------------------------------------------------------
* 
* SET UP BUFFER FOR OPEN REQUEST
* 
*                   NAME ALREADY IN BUF - BUF+2 
      LDA BUF+4     MOVE SEC. CODE FROM BUF+4 
      STA BUF+6          TO BUF+6 
      LDA BUF+5     MOVE CR. NO. FROM BUF+5 
      STA BUF+7          TO BUF+7 
      LDA .PAR2     GET LEVEL ACCESS WD. ADDR 
      LDB .BF3      MOVE LEVEL ACCESS WD. 
      MVW D3             TO BUF+3 - BUF+5 
      CLA           ZERO D.S. NODE
      STA BUF+8 
      LDA MODE      GET MODE
*     LDA .PAR3,I   GET MODE
      STA BUF+9 
* 
* ISSUE OPEN REQUEST TO DATA-BASE MODULE
* 
      LDA .BUF      SET UP PROGRAM NAME ADDR
      STA .IMPG 
      JSB SENDS     SCHEDULE TMS-IMAGE MODULE 
      CMA,INA       D.B. NO., SET POSITIVE
      CAX           SAVE D.B. NO. IN X REG FOR LATER USE
* 
*---------------------------------------------------------------------
*  7 - INITIALIZE DATA BASE SAVE TABLE ADDRESSES AND DATA 
*      FORMAT OF TABLE DBSAV: 
* 
*           THE TABLE CONSISTS OF 4 ENTRIES, EACH OF WHICH IS 18 WORDS
*           LONG.  AN ENTRY IS FORMATTED AS FOLLOWS:
* 
*                WDS.  0 - 2  - DATA-BASE/PROGRAM NAME (ASCII)
*                      3      - SEND CLASS IO WORD
*                      4      - MAX D.B. ITEM LENGTH
*                      5      - MAX D.B. ENTRY LENGTH 
*                      6      - LOCK ID 
*                      7      - IMAGE INTERNAL D.B. NO. 
*                      8 - 17 - RUNTABLE SAVE AREA
* 
*           THIS IS IN THE SAME FORMAT AS THE IMAGE AREA IN TMS COMMON
*           BLOCK 1.
*---------------------------------------------------------------------
*     NOTE: UPON ENTRY TO THIS SECTION OF CODE THE FOLLOWING REGISTERS
*           MUST CONTAIN: 
* 
*                B - ADDR. OF FIRST WORD OF ENTRY IN DBSAV
*                X - IMAGE INTERNAL D.B. NO.
*                Y - XMLIM INTERNAL D.B. NO.
* 
* ENTER DATA INTO TABLE, AND INITIALIZE ADDRESS POINTERS
* 
      ISZ NDBOP     INCREMENT NO. OF D.B. OPENED
      LDA .BUF      BUFFER ADDR OF D.B./PROG NAME 
      LDB SVTBE     ADDR OF ENTRY IN D.B. SAVE TABLE
      STB .IMPG 
      MVW D3        MOVE PROGRAM NAME 
* 
      STB .IMCL     SAVE TABLE ADDR OF SEND CLASS IO WD 
      LDA .BF11,I 
      STA B,I       MOVE SEND CLASS IO WORD 
* 
      INB 
      STB .MITL     SAVE TABLE ADDR OF MAX ITEM LENGTH
      STB .METL     AND MAX ENTRY LENGTH
      ISZ .METL 
      LDA .BF13     BUFFER ADDR OF MAX ITEM, ENTRY LENGTH 
      MVW D2        MOVE MAX ITEM, ENTRY LENGTH 
* 
      STB .LKID     SAVE TABLE ADDR OF LOCK ID
      LDA SVDBN     GET XBLIM IMTERNAL D.B. NO. 
      ALF,ALF       CALCULATE LOCK ID WORD
      ALF,RAL            (MOVE D.B. NO. INTO BITS 15-13)
      STA B,I       SAVE LOCK ID
* 
      INB           POINT TO IMAGE INTERNAL D.B. NO.
      STX B,I       SAVE IMAGE INTERNAL D.B. #
* 
*---------------------------------------------------------------------
*  8 - UNLOCK ALL RECORDS IN THIS DATA-BASE THAT WERE PREVIOUSLY
*      LOCKED BY THIS PROCESS 
*---------------------------------------------------------------------
* 
      JSB UNLCK 
* 
*---------------------------------------------------------------------
*  9 - ALLOCATE RECEIVE CLASS IO, IF NONE IS ALREADY ALLOCATED
*      (CLASS ON WHICH DATA FROM IMAGE MODULE IS TO BE RECEIVED)
*      ALLOCATION PROCEDURE:
* 
*           1 - AN EXEC 19 (CLASS IO CONTROL) TO LU 0 IS PERFORMED
*               IN ORDER TO ALLOCATE A CLASS NO.
*           2 - AN EXEC 21 (CLASS IO GET) IS ISSUED TO DEALLOCATE THE 
*               BUFFER ALLOCATED BY THE EXEC 19, AND SAVE THE CLASS NO. 
*---------------------------------------------------------------------- 
* 
      LDA RCLAS     GET CLASS IO WORD 
      SZA           ALREADY BEEN ALLOCATED?  (.NE. 0) 
      JMP XBOP4          YES, RETURN TO USER
*                        NO, ALLOCATE CLASS 
      JSB EXEC
      DEF *+5 
      DEF NAB19     EXEC 19, NO ABORT 
      DEF D0        DUMMY LU
      DEF *         DUMMY PARAMETER 
      DEF RCLAS     CLASS IO WORD 
      JMP OPER4     ERROR RETURN #471, CANNOT ALLOCATE CLASS IO 
* 
      LDA RCLAS     SET DO NOT DEALLOCATE BIT 
      IOR BIT13 
      STA RCLAS 
* 
      JSB EXEC      DEALLOCATE BUFFER, SAVE CLASS IO
      DEF *+5 
      DEF NAB21     EXEC 21, NO ABORT 
      DEF RCLAS      RECEIVE CLASS
      DEF *          DUMMY BUFFER 
      DEF D0         DUMMY BUFFER LENGTH
      JMP OPER4      ERROR RETURN #471, CANNOT ALLOCATE CLASS IO
* 
*---------------------------------------------------------------------
* 10 - END OF XBOPN, RETURN 
*---------------------------------------------------------------------
* 
XBOP4 CLA            SET STATUS TO 0
      STA .PAR4,I 
      LDA SVDBN      GET INTERNAL D.B. NO.
      STA .PAR1,I    RETURN TO USER 
      JMP RTRN,I
* 
*---------------------------------------------------------------------
* XBOPN ERROR PROCESSING
*---------------------------------------------------------------------
* 
* ERROR 470, MAX NO. OF DATA-BASES ALREADY OPEN (MAX=8) 
* 
OPER1 LDA D470      GET ERROR CODE
      JMP OPER3 
D470  DEC 470 
* 
* ERROR 450, CANNOT SCHEDULE DATA-BASE PROGRAM
* 
OPER2 LDA D450      GET ERROR CODE
      JMP OPER3 
D450  DEC 450 
* 
* ERROR 150, DATA-BASE ALREADY OPEN 
* 
ER150 LDA D150      GET ERROR CODE
      JMP OPER3 
D150  DEC 150 
* 
* ERROR 474, XMLIM REQUEST FROM DATACAP USER SUBROUTINE 
* 
ER474 LDA D474      GET ERROR CODE  
      JMP OPER3 
*     HLT 66B       HOW ORNERY DO WE WANT TO BE ABOUT THIS  
D474  DEC 474 
* 
* IMAGE DATA-BASE OPEN ERROR (FROM TMS-IMAGE PROG)
* 
OPER3 NOP 
      STA .PAR4,I   RETURN ERROR CODE TO USER 
      JMP RTRN,I
* 
* ERROR 471, CANNOT ALLOCATE CLASS IO 
* 
OPER4 NOP 
      DST OPSAV     SAVE EXEC ERROR CODES 
      LDA D471
      STA .PAR4,I   RETURN CODE 471 TO USER 
      LDA .PAR4 
      INA 
      STA .PR1
      DLD OPSAV     RETURN EXEC ERROR CODES TO USER 
      DST .PR1,I
      JMP XBCL1     FATAL ERROR, CLOSE DATA-BASE
D471  DEC 471 
* 
OPSAV BSS 2 
.PR1  BSS 1 
* 
*---------------------------------------------------------------------
* 
* OFFSETS INTO BUF USED BY XBOPN CALL 
* 
.BF3  DEF BUF+3     LEVEL ACCESS WORD 
.BF11 DEF BUF+11    CLASS IO WORD 
.BF13 DEF BUF+13    MAX ENTRY 
* 
* 
BIT13 OCT 20000 
DUMMY BSS 1         GENERAL PURPOSE DUMMY 
LU    OCT 1         LU NO. OF TERMINAL, DEFAULT = 1 
NAMRL BSS 1         NAMR LENGTH IN CHARACTERS 
MODE  BSS 1         DATA BASE OPEN MODE 
SVDBN BSS 1         TEMPORARY STORAGE FOR INTERNAL D.B. NO. 
SVTBE BSS 1         TEMPORARY STORAGE FOR DBSAV TABLE ENTRY ADDRESS 
.DCRC DEF DCRCV 
DCRCV ASC 3,DCRCV 
.TMP1 DEF TMP1  
TMP1  ASC 2,TMP1  
.TMP2 DEF TMP2  
TMP2  ASC 2,TMP2  
  HED  TERMINAL-MONITOR DBCLS REQUEST 
* 
**********************************************************************
* 
* XBCLS - XMLIM DBCLS CALL
* XBCLS PROCESS DESCRIPTION:
* 
*     1 - THE PARAMETERS OF THE XBCLS CALL ARE RETREIVED BY GETPA.
*     2 - ALL ENTRIES IN THIS DATA-BASE LOCKED BY THIS PROCESS ARE
*         UNLOCKED. 
*     3 - THE CLOSE REQUEST IS ISSUED TO THE TMS-IMAGE MODULE.
*     4 - ALL ENTRIES IN THE DATA-BASE SAVE TABLE (DBSAV) FOR THIS
*         DATA-BASE ARE ZEROED. 
*     5 - IF NO DATA-BASES ARE OPEN, THE RECEIVE CLASS IO IS
*         DEALLOCATED.
*     6 - CONTROL IS RETURNED TO THE USER.
* 
* PARAMETERS PASSED TO THE XBCLS CALL:
* 
*     .PAR1 - IBASE ( D.B. NUMBER AND NAMR) 
*     .PAR2 - DATA-SET NO. (NOT USED) 
*     .PAR3 - MODE (NOT USED) 
*     .PAR4 - ISTAT (STATUS OF CALL)
* 
**********************************************************************
* 
XBCLS NOP 
* 
*---------------------------------------------------------------------
*  1 - GET XBCLS CALL PARAMTERS, SET UP ADDRESSING INTO DATA-BASE 
*      SAVE TABLE 
*---------------------------------------------------------------------
* 
      CLA,INA       CODE FOR CLOSE CALL = 1 
      JSB GETPA     GET CALL PARAMETERS 
      JSB CONF      SET UP ADDRESSING INTO DATA-BASE SAVE TABLE 
* 
*---------------------------------------------------------------------
*  2 - UNLOCK ALL ENTRIES IN THIS DATA-BASE LOCKED BY THIS PROCESS
*---------------------------------------------------------------------
* 
      JSB UNLCK 
* 
*---------------------------------------------------------------------
*  3 - ISSUE OPEN REQUEST TO DATA-BASE MODULE USING STRING PASSING
*---------------------------------------------------------------------
* 
      CLA           SET STATUS TO OK
      STA .PAR4,I 
XBCL1 CLA,INA       SET IMAGE REQUEST CODE TO 1 FOR DBCLS 
      STA IMRQC     SAVE IN BUFFER TO BE SENT 
      JSB SENDS     ISSUE CLOSE REQUEST, WAIT FOR COMPLETION
* 
*---------------------------------------------------------------------
*  4 - ZERO OUT ENTRY FOR THIS DATA-BASE IN DATA-BASE SAVE TABLE DBSAV
*---------------------------------------------------------------------
* 
      JSB NUL 
      DEF *+3 
      DEF .IMPG,I   ENTRY ADDR
      DEF D18       18 WORDS
* 
*---------------------------------------------------------------------
*  5 - IF NO DATA-BASES ARE OPEN, DEALLOCATE RECEIVE CLASS IO WORD
*---------------------------------------------------------------------
* 
      LDA NDBOP 
      ADA DM1       DECREMENT OPEN DATA-BASE COUNT
      STA NDBOP 
      SZA           ANY DATA-BASES OPEN?
      JMP RTRN,I         YES, RETURN TO USER (COUNT IS NON-ZERO)
* 
      JSB KLCLS          NO, DEALLOCATE RECEIVE CLASS IO
      DEF *+2 
      DEF RCLAS 
      CLA           ZERO CLASS IO WORD
      STA RCLAS 
      JMP RTRN,I
  HED  DATA-BASE SAVE TABLE 
* 
**********************************************************************
* 
* TABLE DBSAV 
* THIS TABLE IS USED TO SAVE THE VARIABLES THAT ARE UNIQUE TO 
* EACH OPEN DATA-BASE.  THE TABLE IS FORMATTED AS FOLLOWS:
* 
*      DBSAV IS MADE UP OF FOUR ENTRIES (ONE FOR EACH DATA-BASE), 
*      WHICH CONTAIN THE FOLLWING INFORMATION:
* 
*           WDS.  0 - 2  - DATA-BASE/PROGRAM NAME (ASCII) 
*                 3      - SEND CLASS IO WORD (INT) 
*                 4      - MAX D.B. ITEM LENGTH (INT) 
*                 5      - MAX D.B. ENTRY LENGTH (INT)
*                 6      - LOCK ID (INT)
*                          BITS 15 - 13  -  XMLIM INTERNAL D.B. NO. 
*                                           (THIS IS THE DBSAV TABLE
*                                            ENTRY NO.) 
*                          BITS 12 - 0   -  PROCESS ID (ALLOCATED BY
*                                           TMS-IMAGE MODULE FOR
*                                           RECORD LOCKING
*                 7      - IMAGE INTERNAL D.B. NO. (INT)
*                 8 - 17 - RUN TABLE SAVE AREA
*                          WD.  8       - CURRENT DATA SET
*                               9 - 10  - CURRENT MASTER D.S. RECORD NO.
*                              11 - 17  - RUN TABLE RETURNED BY DBINF 
* 
**********************************************************************
* 
* OFFSETS INTO DBSAV ENTRY: 
* 
SVNAM EQU 0         D.B./PROGRAM NAME 
SVCIO EQU 3         CLASS IO
SVITL EQU 4         D.B. MAX ITEM LENGTH
SVENL EQU 5         D.B. MAX ENTRY LENGTH 
SVLID EQU 6         LOCK ID 
SVIDB EQU 7         IMAGE INTERNAL D.B. NUMBER
SVRTS EQU 8         IMAGE RUNTABLE
* 
* 
RCLAS OCT 0         RECEIVE CLASS IO WORD 
NDBOP OCT 0         OPEN COUNT
.DBSV DEF DBSAV     POINTER TO FIRST WD IN DBSAV
DBSAV REP 144 
      OCT 0 
   HED TERMINAL-MONITOR  DBGET REQUEST
* 
* PARAMETERS PASSED IN XBGET CALL 
* 
*     .PAR1 - TMS INTERNAL DB#
*     .PAR2 - DS# 
*     .PAR3 - IMODE 
*     .PAR4 - ISTAT 
*     .PAR5 - ILIST 
*     .PAR6 - IBUF
*     .PAR7 - IARG
*     .PAR8 - LOCK WD 
* 
XBGET NOP 
      LDA D2        SUBROUTINE CODE=2 FOR READ
      JSB GETPA     GO GET PARAMETER
      JSB CONF      SET UP ADDRESSING INTO DATA-BASE SAVE TABLE 
   SPC 1
      CLB           SET UP IARG LENGTH
      LDA .PAR3,I   RECALL MODE 
      CPA D4        IF MODE 4 (DIRECTED READ):
      RSS 
      JMP XBGE2     
      LDB .PAR8,I      GET LOCK WORD
      SZB              IS ANY LOCK OPERATION SPECIFIED? 
      JMP GERR1           YES, ERROR 473
      LDB D2               NO, SET LENGTH TO 2
XBGE2 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
* 
XBGE8 JSB SENDI     GIVE PARAM. ADDR. TO TMLIB & GOTO TMLIB TO SUSP.
  SPC 1 
      JSB RECMB     RESTORE PARM ADDR & RECEIVE MAIL BOX
* 
      LDA .RCBU 
      LDB .PAR4     STORE IMAGE STATUS IN USER BUFFER 
      MVW D10 
      LDB .LKID     RESTORE LOCK ID, IMAGE INTERNAL D.B. NO., AND 
      MVW D12          RUN TABLE SAVE BUFFER
      LDB .PAR4,I   RECALL IMAGE STATUS 
      SZB           WAS IT OK ? 
      JMP RTRN,I       NO, DO NOT STORE ENTRY INTO USER BUF.
      LDB .PAR6     STORE ENTRY (DATA RECORD + MEDIA RECORD)
      SZB,RSS       USER BUFFER ADDR DEFINED ?
      JMP RTRN,I       NO, RETURN IMMEDIATELY 
      INA           SKIP WORD COUNT 
      MVW RCBUF+22  USE ENTRY LENGTH
      JMP RTRN,I       RETURN TO USER CODE
* 
GERR1 LDA D473      ERROR 473, MODE 4 XBGET WITH LOCK OPERATION 
      STA .PAR4,I 
      JMP RTRN,I
* 
D473  DEC 473 
.RCBU DEF RCBUF 
  HED TMS-IMAGE  XBULK REQUEST
* 
**********************************************************************
* 
* XBULK - UNLOCK ALL RECORDS IN A DATA-BASE BELONGING TO THE CALLING
*         PROCESS 
* 
* PARAMETERS PASSED TO XBULK FROM CALLING PROGRAM 
* 
*     .PAR1 - XMLIM INTERNAL D.B. NO. 
*     .PAR2 - NOT USED
*     .PAR3 - NOT USED
*     .PAR4 - USER STATUS RETURN BUFFER 
* 
**********************************************************************
* 
XBULK NOP 
      LDA D8
      JSB GETPA 
      JSB CONF      SET UP ADDRESSING INTO DATA-BASE SAVE TABLE 
  SPC 1 
      JSB UNLCK     UNLOCK ALL RECORDS OWN BY THE PROCESS 
      CLA           RETURN STATUS OF 0
      STA .PAR4,I 
   SPC 1
RTNDI JMP RTRN,I       AND GO TO CENTRAL RETURN PROCESS 
  SPC 2 
UNLCK NOP 
      LDA .LKID,I   GET LOCK ID 
      AND PIDMK     ISOLATE PID 
      SZA,RSS       ID DEFINED ?
      JMP UNLCK,I        NO, FORGET THE CALL
      LDA D8             YES, SET UP BUFFER FOR CALL
      STA IMRQC     STORE REQUEST CODE
      LDA .LKID,I   RECALL  DB# - PID 
      STA RECVC     SEND IT TO TMSYS
      AND DBMSK     KEEP DB# BUT CLEAR PID
      STA .LKID,I   TO RETURN LCKID TO THE USER 
* 
      JSB SENDS     SCHEDULE TMS-IMAGE PROG, AND SEND STRING
      JMP UNLCK,I 
   SPC 2
PIDMK OCT 17777 
DBMSK OCT 160000
   SPC 2
IMSCD EQU 23
ULKCD DEC 16
RSAVE NOP 
  HED TMS-IMAGE  DBFND REQUEST
* 
* PARAMETERS PASSED TO XBFND FROM CALLING PROGRAM 
* 
*     .PAR1 - TMS INTERNAL DB#
*     .PAR2 - DS# 
*     .PAR3 - IMODE 
*     .PAR4 - STATUS
*     .PAR5 - NAME LIST 
*     .PAR6 - VALUE LIST
*     .PAR7 - LOCK WORD 
* 
XBFND NOP 
      LDA D3
      JSB GETPA 
*     JSB DBUGR 
*     DEF *+2 
*     DEF D1
      JSB CONF      SET UP ADDRESSING INTO DATA-BASE SAVE TABLE 
* 
  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) 
      STB .PAR6 
      JMP XBGE8     USE XBGET 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 TERMINAL-MONITOR DBINF REQUEST
* 
**********************************************************************
* 
* XBINF - GET DATA-BASE INFORMATION 
* XBINF PROCESS DESCRIPTION:
* 
*     1 - RETRIEVE XBINF CALL PARAMETERS
*     2 - SET UP ADDRESSING INTO DBSAV TABLE
*     3 - IF MODE 401:
*         A - TRANSFER RUNTABLE INFO FROM TABLE DBSAV TO USER BUFFER
*         B - RETURN CONTROL TO USER
*     4 - IF MODE 402:
*         A - TRANSFER RUNTABLE INFO FROM USER BUFFER TO TABLE DBSAV
*         B - RETURN CONTROL TO USER
*     5 - SEND CLASS IO REQUEST TO TMS-IMAGE MODULE 
*     6 - RETURN STATUS AND DATA TO USER
*     7 - RETURN CONTROL TO USER
* 
* PARAMETERS PASSED TO THE XBINF CALL:
* 
*     .PAR1 - IBASE (D.B. NUMBER AND NAMR)
*     .PAR2 - DATA SET NO.
*     .PAR3 - MODE
*     .PAR4 - ISTAT ARRAY (STATUS RETURN) 
*     .PAR5 - BUFFER TO RECEIVE DBINF INFORMATION 
* 
**********************************************************************
* 
XBINF NOP 
* 
*---------------------------------------------------------------------
*  1 - RETRIEVE XBINF CALL PARAMETERS 
*---------------------------------------------------------------------
* 
      LDA D7        CODE FOR XBINF CALL = 7 
      JSB GETPA 
* 
*---------------------------------------------------------------------
*  2 - SET UP DBSAV TABLE ADDRESSES 
*---------------------------------------------------------------------
* 
      JSB CONF
* 
*---------------------------------------------------------------------
*  3 - IF MODE = 401, RETURN RUNTABLE INFORMATION TO USER 
*---------------------------------------------------------------------
* 
      LDA .PAR3,I   GET MODE
      CPA D401      401?
      RSS                YES, RETURN RUNTABLE TO USER 
      JMP XB402          NO, CHECK IF MODE 402
* 
      LDA .SVRT     GET ADDR OF RUNTABLE SAVE BUFFER IN DBSAV 
      LDB .PAR5     GET ADDR OF USER BUFFER 
      JMP X4021     MOVE RUNTABLE TO USER BUFFER AND EXIT 
* 
*---------------------------------------------------------------------
*  4 - IF MODE = 402, RESTORE RUNTABLE SUPPLIED BY USER 
*---------------------------------------------------------------------
* NOTE:  UPON ENTRY TO THIS SECTION OF CODE, A MUST CONTAIN THE MODE
* 
XB402 CPA D402      MODE = 402 ?
      RSS                YES, RESTORE RUTABLE SUPPLIED BY USER
      JMP XBIN1          NO, PROCESS OTHER MODES
* 
      LDA .PAR5     GET ADDR OF USER BUFFER 
      LDB .SVRT     GET ADDR OF RUNTABLE BUFFER IN DBSAV
X4021 MVW D10 
      CLA 
      STA .PAR4,I   SET STATUS TO 0 (OK)
      JMP RTRN,I    RETURN TO USER
* 
*---------------------------------------------------------------------
*  5 - ISSUE DBINF REQUEST TO TMS-IMAGE MODULE
*---------------------------------------------------------------------
* 
XBIN1 CLB 
      STB TEMP      LENGHT OF VALUE LIST IS 0 
      JSB MVPAR     FORMAT BUFFER FOR XBINF CALL
* 
      JSB SENDI     ISSUE DBINF REQUEST 
      JSB RECMB     RECEIVE DATA FROM TMS-IMAGE 
* 
*---------------------------------------------------------------------
*  6 - RETURN STATUS AND DATA TO USER 
*---------------------------------------------------------------------
* 
      LDA .RCBU     ADDR OF STATUS
      LDB .PAR4     USER STAUS ADDR 
      MVW D10 
* 
      LDB .PAR5     USER DATA ADDR
      MVW RCBUF+1   MOVE DATA TO USER 
* 
*---------------------------------------------------------------------
*  7 - RETURN CONTROL TO USER 
*---------------------------------------------------------------------
* 
      JMP RTRN,I
* 
*---------------------------------------------------------------------
* 
* VARIABLES FOR XBINF CALL
* 
D401  DEC 401 
D402  DEC 402 
  HED TMS-IMAGE  DBPUT/DBUPD/DBDEL REQUEST
* 
* PARAMETERS PASSED TO XBPUT, XBUPD, XBDEL
* 
*     .PAR1 - TMS INTERNAL DB#
*     .PAR2 - DS# 
*     .PAR3 - MODE
*     .PAR4 - STATUS
*     .PAR5 - NAME LIST     (NOT USED BY XBDEL) 
*     .PAR6 - VALUE LIST      "   "   "    "
* 
XBPUT NOP 
      LDA D4
      JSB GETPA 
* 
XBPU5 JSB CONF      SET UP ADDRESSING INTO DATA-BASE SAVE TABLE 
      LDB .METL,I     GET MAX VALUE LIST LENGTH 
      STB TEMP
      LDB .PAR6       SAVE VALUE LIST ADDR
      STB .IARG 
XBPU7 LDB .D2       FORCE SPECIAL LOCK WORD TO UNLCK
      STB .LCKW 
* 
      JSB MVPAR     MOVE PARAMETERS INTO IMAGE MODULE BUFFER
* 
      JSB SENDI     SAVE PARAM ADDR & SEND MAIL BOX 
  SPC 1 
XBPU9 JSB RECMB     RESTORE PARAM ADDR & RECEIVE MAIL BOX 
      LDA .RCBU     RECALL IMAGE STATUS 
      LDB .PAR4 
      MVW D10 
      JMP RTRN,I       RETURN TO USER 
  SPC 2 
XBUPD NOP 
      LDA D5
      JSB GETPA 
      JMP XBPU5     EXACTLY LIKE DBPUT CALL 
  SPC 2 
XBDEL NOP 
      LDA D6
      JSB GETPA 
      JSB CONF      SET UP ADDRESSING INTO DATA-BASE SAVE TABLE 
      CLB 
      STB TEMP      NO VALUE LIST 
      STB .IARG 
      JMP XBPU7 
  HED TMS-IMAGE SEND DATA REQUEST (FOR DCRCV ONLY)
* 
**********************************************************************
* 
* XBSND - SEND FORMATTED USER BUFFER TO IMAGE PROCESSOR 
* 
* PARAMETERS PASSED TO XBSND CALL:
* 
*     .PAR1 - IBASE (D.B. NUMBER AND NAMR)
*     .PAR2 - USER BUFFER 
*     .PAR3 - WORD COUNT OF BUFFER
*     .PAR4 - STATUS RETURN (10 WD ARRAY) 
* 
**********************************************************************
* 
XBSND NOP 
      CLA 
* 
*---------------------------------------------------------------------
*  1 - RETRIEVE CALL PARAMETERS 
*---------------------------------------------------------------------
* 
      JSB GETPA 
* 
*---------------------------------------------------------------------
* 2 - SET UP DBSAV TABLE ADDRESSES
*---------------------------------------------------------------------
* 
      JSB CONF
* 
*---------------------------------------------------------------------
* 3 - SET UP: 
*     A - WORD COUNT OF BUFFER
*     B - BUFFER ADDR 
*     C - RETURN CLASS WD (IN USER BUFFER)
*---------------------------------------------------------------------
* 
      LDA .PAR3,I   GET WORD COUNT
      STA BUFLN     SET UP WORD COUNT 
* 
      LDA .PAR2     SET UP USER BUFFER ADDR 
      LDB SEND1 
      STA SEND1 
      STB .PAR2 
* 
      INA          POINT TO USER CLASS IO ADDR
      LDB RCLAS    GET RETURN CLASS FOR THIS PROG 
      STB A,I      PUT CLASS IO WD IN USER BUFFER 
* 
*---------------------------------------------------------------------
* 4 - SEND BUFFER TO IMAGE MODULE 
*---------------------------------------------------------------------
* 
      JSB SENDI    SEND BUFFER
      LDA SEND1    SWITCH ADDRESSES BACK
      LDB .PAR2 
      STA .PAR2 
      STB SEND1 
      JMP XBPU9    FINISH LIKE PUT, UPDATE, DELETE
  HED SAVE PARAMETERS TO BE PASSED TO TMS IMAGE MODULE
MVPAR NOP 
      CLA 
      STA LLIST 
      LDA IMRQC      GET REQUEST CODE 
      CPA D6         XBDEL CALL ? 
      JMP MVPA2           YES, SKIP NAME LIST LENGTH CALCULATION
      CPA D7         XBINF 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 .LKID     MOVE LOCK ID, IMAGE INTERNAL D.B. NO., RUNTABLE 
      MVW D12            SAVE BUFFER
* 
      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 
      ADB D4
      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     PUT BLANC IN TERMINATOR LOCATION
      DEF *+4 
      DEF LIST2,I 
      DEF BSCOL 
      DEF LISTE 
* 
      LDA LISTE     IS LENGTH .GE. 6 CHARS? 
      LDB D6
      ADA DM6 
      SSA 
      STB LISTE        NO, SET LENGTH TO 6 CHARS
      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 XBFND
      CPB D3
      CLA           XBFND, LIST LENGTH IS 1 
      INA 
      JMP LISTL,I 
* 
* 
* 
BSCOL ASC 1, ;
COMBL 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 
      JMP RTRN+1
  SPC 1 
.PAR1 NOP 
.PAR2 NOP 
.PAR3 NOP 
.PAR4 NOP 
.PAR5 NOP 
.PAR6 NOP 
.PAR7 NOP 
.PAR8 NOP 
      BSS 6 
RQCNT NOP 
XSUSP NOP 
      ABS IMSCD     TMS INTERNAL SUBROUTINE CODE FOR IMAGE RQ 
RTRN  NOP 
      JSB .ENTR     GET PARAMETERS ADDRESS
..PA1 DEF .PAR1 
* 
*     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 
      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 RCLAS     SET-UP RECEIVE CLASS IO WORD
      STA RECVC 
*-------------------------------------
* 
*     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
SEND1 DEF IMRQC     BUFFER ADDR 
      DEF BUFLN     BUFFER LENGTH 
      DEF *         1ST PARAM 
      DEF *         2ND PARAM 
.IMCL NOP           ADDR OF IMAGE CLASS I/O WORD
      JMP OPER2     ERROR RETURN
      SZA           OK ?
      JMP OPER2     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 DRSTA     PROGRAM STATUS RETURNED HERE. 
* 
      SSA           DORMANT ? 
      JMP OPER2     YES, IT IS IMPOSSIBLE !!! 
* 
      LDA DRSTA     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 OPER2     ERROR RETURN !! 
* 
*-------------------------------------
  SPC 1 
SEND3 JMP SENDI,I 
  SPC 2 
RECMB NOP           RESTORE PARAM ADDR & RECEIVE MAIL-BOX 
* 
      JSB EXEC      GET THE BUFFER FROM TMS-IMAGE-MODULE
      DEF *+7 
      DEF NAB21     CLASS I/O GET WITH NO-ABORT 
      DEF RCLAS     RECEIVE CLASS IO WORD 
.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 CHECK     HAVE BEEN RETURNED BY THE 
*     RSS           TMS-IMAGE-MODULE PROGRAM. 
*     HLT 
*     LDA PARM2 
*     CPA CHECK+1 
*     RSS 
*     HLT 
* 
      JMP RECMB,I 
  SPC 1 
NAB19 OCT 100023
NAB20 OCT 100024
NAB21 OCT 100025
NAB23 OCT 100027
NAB24 OCT 100030
B17   OCT 17
BUFLN NOP 
DRSTA NOP           DORMANT STATUS
  HED UTILITY SUBROUTINE TO SCHEDULE IMAGE MODULE WITH STRING PASSING 
SENDS NOP 
      JSB EXEC
      DEF *+10
      DEF NAB23     SCHEDULE WITH WAIT, NO ABORT
      DEF .IMPG,I   NAME OF DATA-BASE PROGRAM 
      DEF LU        LU FOR ERROR MESSAGES 
      DEF *         DUMMY ARG 
      DEF *         DUMMY ARG 
      DEF *         DUMMY ARG 
      DEF *         DUMMY ARG 
      DEF IMRQC     STRING PASSING BUFFER 
      DEF D14       LENGTH = 14 
      JMP OPER2     ERROR #450, CANNOT SCHEDULE IMAGE PROGRAM 
* 
*  RECEIVE STRING SENT BACK BY TMS-IMAGE MODULE 
* 
      JSB RMPAR 
      DEF *+2 
      DEF BUF+10    RETURN DATA IN BUF+10 
      LDA BUF+10    CHECK RETURN STATUS 
      SSA,RSS       NEGATIVE? 
      JMP OPER3          NO, ERROR STATUS RETURNED
*                                 YES, NEG IMAGE INTERNAL D.B. NO.
*                                       RETURNED, OK
      JMP SENDS,I 
  HED UTILITY SUBROUTINE TO SET UP BUFFER ADDRESSES 
   SKP
CONF  NOP 
      JSB ISBTW     IS XMLIM INTERNAL D.B. NO. PASSED BY USER .GE. 0
      DEF *+4            .AND. .LE. 7 ? 
      DEF .PAR1,I 
      DEF D0
      DEF D7
      SZA 
      JSB COER1          NO, D.B. NO. IS INVALID, ERROR XXX 
*                        YES, CALCULATE POINTER INTO DBSAV
      LDA .PAR1,I        ENTRY POINTER CALCULATION: 
*     ADA DM1            ENTRY ADDR = (D.B. NO. * 18) + 
      MPY D18                  FIRST WD ADDR OF DBSAV TABLE 
      ADA .DBSV 
* 
      STA .IMPG     SAVE TMS-IMAGE MODULE PRG. NAME ADDR
      ADA D3
      STA .IMCL     SAVE TMS-IMAGE SEND CLASS IO ADDR 
      INA 
      STA .MITL     SAVE MAXIMUM ITEM LENGTH ADDR 
      INA 
      STA .METL     SAVE MAXIMUM ENTRY LENGTH ADDR
      INA 
      STA .LKID     SAVE LOCK ID WORD ADDR
      ADA D2
      STA .SVRT     SAVE RUNTABLE AREA ADDR 
* 
CONF4 LDA .LKID,I   RECALL XMLIM INTERNAL D.B. NO. FROM LOCK ID 
      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
      JSB COER1          NO, RETURN ERROR XXX 
* 
CONF5 LDA .BUF
      CMA,INA 
      STA M.BUF     MINUS ADDR OF BUF 
      JMP CONF,I
* 
*---------------------------------------------------------------------
* CONF ERROR PROCESSING 
*---------------------------------------------------------------------
* 
* ERROR 472, ILLEGAL XMLIM D.B. NO. IN SUBROUTINE CALL
* 
COER1 NOP 
      LDA D472      ERROR CODE 472
      LDB CONF      GET ERROR ADDRESS 
      DST .PAR4,I   SET USER STATUS 
      JMP RTRN,I   RETURN TO USER 
D472  DEC 472 
  SPC 1 
.LKID NOP           ADDR OF LOCK ID WORD
.SVRT NOP           STARTING ADDR OF THE SAVE RUNTABLE AREA 
M.BUF NOP           MINUS ADDR OF  BUF
* 
   SPC 3
.D0   DEF D0
.D2   DEF D2
DM256 DEC -256
DM9   DEC -9
DM8   DEC -8
DM6   DEC -6
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
D12   DEC 12
D14   DEC 14
D15   DEC 15
D18   DEC 18
D19   DEC 19
D24   DEC 24
  SPC 1 
TEMP  NOP 
PARM1 NOP 
PARM2 NOP 
  SPC 1 
  SPC 2 
*                   BUFFER SEND FROM TMLIM TO TMSIM 
  SPC 1 
IMRQC NOP           IMAGE REQUEST CODE
RECVC NOP           RECEIVE CLASS IO WORD OR SPECIAL PARAMETER
CHECK OCT 125252    PARAMETERS THAT MUST BE SEND BACK WITH ANSWER 
      OCT 052525
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 
                                                                                                                                                                                                              