ASMB
    HED .           T    M    S            M    A    I    N 
      NAM $MTMS,7 92080-1X102 REV.2026  800429  1125
  SPC 3 
**********************************************************************
*                                                                    *
*     NAME:   $MTMS     TMS MAIN PROGRAM                             *
*     SOURCE: &$MTMS    92080-18102                                  *
*     BINARY: %$MTMS    ----NONE---    PART OF  %TMSLB  92080-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 $MTMS,.MGT0 
      EXT $TMSA,.EMAP,.EMIO,BITSR,BITST,ERR0
*REQ  EXT DMPTM 
      EXT .MGTG,.MGTR,#REQU,#QCNT,DRTEQ 
      EXT EXEC,LURQ,$CVT3,$LIBR,$LIBX,NUL,JASC
      EXT .ENTR,$TIME,IDGET,KLCLS,NRCLS,PNAME,RMPAR 
      EXT DORMT,.UPIO,MESSS,.LURQ,NAMR
      EXT NSCAN,MOVCA,OPLOG 
*     EXT DBUGR 
  SPC 1 
A     EQU 0 
B     EQU 1 
      SUP 
   SKP
.PARA NOP           PRG PARAMETERS ADDR 
PNX00 NOP           DEFINE THE STARTING PROCESS 
PNXXX NOP           DEFINE THE INITIAL PROCESS
LUXXX NOP           DEFINE THE LU FOR THE INITIAL PROCESS 
LOGXX NOP           ADDR OF LOG FILE NAME OF LU 
.TMLU NOP 
.TMTP NOP 
.TMSB NOP 
.TMPR NOP 
.TMSL NOP           ADDR OF TMS LINK NAME 
.TMST NOP           ADDR OF TMS TIMER NAME
IMAGE NOP           IMAGE PARAMETERS
$MTMS NOP           TMS ENTRY POINT.
      JSB .ENTR 
      DEF .PARA 
  SPC 2 
*                   RETREIVE PROGRAM PARAMETER AND SAVE THEM
*                     TO INIT THE COMMON BLOCK # 0
  SPC 1 
      LDB .PARA,I   SAVE THE FIVE PARAMETERS
      JSB RMPAR     INTO BUF TO SEND THEM INTO SAM
      DEF *+2       AS THE INITIAL CB0
      DEF BUF 
* 
      JSB EXEC      GET RUN STRING
      DEF *+5       PASSED BY SCHEDULING PROGRAM
      DEF D14       FOR USE BY USER 
      DEF D1
      DEF URNST 
      DEF D19 
      SZA           SUCCESSFUL GET? 
      JMP STA10        NO, ZERO RUN STRING BUFFER 
* 
      LDA URNST        YES, CHECK FOR "RU" OR "ON" COMMAND
      CPA RU
      JMP STA09           "RU" COMMAND, PARSE BUFFER
      CPA ON
      JMP STA09           "ON" COMMAND, PARSE BUFFER
      JMP STA11           PROGRAM SCHEDULE, SKIP PARSING
* 
* 
STA09 CLA,INA       PARSE RUN STRING BUFFER 
      STA DUMMY     SET START CHAR TO 1 FOR NSCAN CALL
      JSB NSCAN     FIND PART OF STRING FOLLOWING:
      DEF *+5          "RU,PNAME,LU,,,,," 
      DEF URNST        THESE PARAMETERS ARE RESERVED FOR THE USER 
      DEF DUMMY 
      DEF AS0CM     , 
      DEF D7
      SZA           SEVENTH COMMA FOUND?
      JMP STA10        NO, USER RUN STRING NOT PRESENT
* 
      LDA DUMMY        CALCULATE NO. OF CHAR TO MOVE
      CMA,INA 
      ADA D40 
      STA DUMM2 
* 
      ISZ DUMMY     POINT TO FIRST CHAR IN USER RUN STRING
      JSB MOVCA     MOVE USER RUN STRING TO BEGINNING OF BUFFER 
      DEF *+6 
      DEF URNST 
      DEF DUMMY 
      DEF URNST 
      DEF D1
      DEF DUMM2 
      JMP STA11 
* 
STA10 JSB NUL        NO, ZERO RUN STRING BUFFER 
      DEF *+3 
      DEF URNST 
      DEF D19 
* 
STA11 LDA BUF       RECALL FIRST PARAM (LU) 
      SZA,RSS       DEFAULT LU IS 1 
      INA 
      STA BUF 
      STA LU        SET CONSOLE LU
* 
* SEARCH LU LIST TO CONVERT LU SPECIFIED IN TMPGN TO COSOLE LU
* 
      LDA .TMLU     GET START ADDR OF LU TABLE
      ADA DM2       POINT TO TOTAL NO. OF LUS 
      DLD A,I       A = TOTAL NO. OF LUS, B = NO. OF INTERACTIVE LUS
      CMA,INA 
      ADA B         A = - TOTAL NO. OF AUX LUS
      INB 
      CBX           X = INDEX TO FIRST AUX LU 
STA13 LBX .TMLU,I   GET AUX LU
      CPB LUXXX,I   SAME AS INIT PROCESS LU?
      JMP STA14        YES, SET LU TO CONSOLE LU
      ISX              NO, POINT TO NEXT LU 
      INA,SZA       LAST LU ? 
      JMP STA13        NO, KEEP SEARCHING 
      HLT 37B          YES, ERROR 
STA14 LDA LU        GET CONSOLE LU
      STA LUXXX,I   SET INIT PROCESS LU TO CONSOLE LU 
      SAX .TMLU,I   SET LU IN TABLE TO CONSOLE LU 
* 
* DISABLE REQUE CHECK IN #REQU (DS LIBRARY) 
* 
      LDA #QCNT 
      STA TQSAV 
      LDA BIT15 
      STA #QCNT 
  SPC 1 
*     JSB .DBUG     CALL DBUG: INTERNAL USE ONLY !!!!!!!!!!!!!!!!!!!!!
*     EXT .DBUG     CALL DBUG: INTERNAL USE ONLY !!!!!!!!!!!!!!!!!!!!!
  SPC 1 
      JSB EXEC      SWAP THE WHOLE AREA 
      DEF *+3 
      DEF D22 
      DEF D3        SWAP THE ENTIRE PARTITION 
  SPC 1 
      JSB PNAME     RETREIVE TMS-APPLICATION NAME 
      DEF *+2 
      DEF APLNM     SAVE NAME HERE
      LDB @APLN     SEARCH LAST CHARAC. TO PUT THE ":"
STA12 LBT           GET BYTE
      CPA O40       IS IT SPACE ? 
      RSS           YES 
      JMP STA12     NO, LOOP UNTIL SPACE
      LDA O72       ":" 
      ADB DM1       BACKSPACE BYTE POINTER
      SBT           AND STORE THE ":" 
      LDA @APLN 
      CMA,INA 
      ADA B 
      ADA @MSB1     ADD TO STARTING BYTE ADDR 
      INA 
      STA @MSBX     SAVE BYTE POINTER 
      LDA @APLN     MOVE PROG NAME
      LDB @MSB1     INTO THE MESSAGE BUFFER 
      MBT D6
  SPC 2 
*                   RETREIVE FWA AND LENGTH OF BUFFER AREA
*                     TO INIT THE TMS MEMORY MANAGEMENT ROUTINE 
  SPC 1 
*                   LEAVE THAT FOR RTE-III M (MAY BE)  !! 
* 
*        EXT COR.A
*  XEQT  EQU 1717B
*  AVMEM EQU 1751B
*  BGLWA EQU 1777B
* 
* 
*     LDA XEQT      GET ID SEGMENT ADDR 
*     JSB COR.A     GET FWA 
*     STA FWA 
*     CMA,INA 
*     LDB BGLWA     GET BACKGROUND LWA
*     ADA AVMEM     CHECK IF PROGRAM RUN FOR./BACK. PARTITION 
*     SSA,RSS       FOREGROUND ?
*     LDB AVMEM     YES, USE FOREGROUND LWA 
*     ADB DM1       YES, LOST TWO WORDS ! (MMGT PB)  !! 
*     LDA FWA       B=LWA 
*     CMA,INA 
*     ADA B         COMPUTE AVAILABLE MEMORY SIZE 
*     STA LENA
* 
      JSB EXEC      MEMORY SIZE REQUEST 
      DEF *+5 
      DEF D26       REQUEST CODE
      DEF FWA       FIRST WORD AVAILABLE
      DEF LENA      # OF WORDS AVAILABLE
      DEF TEMP      PARTITION LENGTH
* 
      JSB .MGTR 
FWA   NOP           FWA OF BUFFER 
LENA  NOP           # OF WORDS
      JMP .MGTG     INITIALISE MEMORY MANAGEMENT SYSTEM 
* 
.MGT0 EQU *         MEMORY MNGT SYSTEM IS READY.
  SPC 2 
*                   CHECK ALL INTERACTIVE TERMINALS, UP THE 
*                     TERMINAL IF IT IS DOWN AND LOCK IT. 
  SPC 1 
      LDB .TMLU     SET UP TO CALL LURQ 
      ADB DM1       TO LOCK ALL INTERACTIVE DEVICE
      STB STA33     SET # OF INTER. DEVICES ADDR. 
      ADB D2
      STB STA31     SET LU'S BUFFER 
      STB STKLN     SAVE LU'S ADDR. TO DO THE UPIO
      LDA STA33,I   RECALL NUMBER OF LU'S 
      CMA,INA       AND 
      STA #LU       SET UP LU COUNTER 
* 
STA26 LDA STKLN,I   GET LU
      JSB .UPIO     TRY TO UP THE DEVICE IF DOWN
      JMP LULAB     ERROR RETURN, ABORT TMS WITH ERROR # 1
      ISZ STKLN     BUMP LU ADDR. 
      ISZ #LU       BUMP LU COUNTER 
      JMP STA26     AND LOOP UNTIL THE END
* 
      JSB LURQ      LOCK ALL INTERCATIVE DEVICE 
      DEF *+4       TO PROTECT PREVENT ANY OTHER
      DEF IOPTN     LOCK/NO WAIT/NO ABORT 
STA31 NOP           BUFFER CONTAINING LU'S
STA33 NOP           NUMBER OF LU'S
      JMP LULAB     ERROR RETURN
      SZA           LOCK OK ? 
      JMP LULAB     NO, ABORT TMS WITH ERROR # 1
* 
      LDA STA31,I   RECALL FIRST INTERACTIVE LU 
      JSB .LURQ     TO GET THE LU-LOCK ID WORD
      STA RNLCK     SAVE FUNNY WORD (LOCKER ID - RN #)
  SPC 2 
*                   INITIATE LOGGING IF REQUIRED
  SPC 1 
      LDB LOGXX,I   LOGGING REQUIRED? 
      SZB,RSS 
      JMP STA40       NO, SKIP DCLOG INITIALIZATION 
      LDA LOGXX       YES, GET ADDR OF LOG FILE/DEV 
      STA OPLO1 
      CLA           SET LOG REQUEST TO 0 FOR OPEN 
      JSB OPLOG 
OPLO1 BSS 1 
      DEF LU
      SZA          ERROR? 
      JSB LOGER    YES, GO SHIT 
      STB LGCLA    NO, SAVE CLASS IO WD 
   SPC 2
*                   CHECK THAT ALL PROGRAM ARE IN IDSEG 
  SPC 1 
STA40 LDA .TMSL     TMS LINK
      JSB IDSG? 
      LDA .TMST     TMS TIMER 
      JSB IDSG? 
* 
      LDA .TMPR,I   CHECK PROGRAM CONTAINING
      CMA,INA       USER CODE (A = - # OF PRG)
* 
STA43 STA TEMP
      ADA .TMPR,I   COMPUTE INDEX INTO PRG TABLE
      MPY UPTEN     UPT TABLE ENTRY LENGTH
      INA 
      ADA .TMPR     GO INTO PRG TABLE 
      JSB IDSG? 
      LDA TEMP      RECALL INDEX
      INA,SZA       END OF TABLE ?
      JMP STA43     NO, CONTINUE UNTIL END
  SPC 2 
*                   ALLOCATE BIT TABLE, STACK TABLE AND ALL STACKS
  SPC 1 
      LDB .TMLU 
      ADB DM3 
      LDA B,I       GET EMA SIZE IN K WORDS 
      STA TEMP      SAVE IT 
      CLB           AND CALCULATE THE # OF WORDS PER ELEMENT
      DIV =D17      USING THE FOLLOWING FORMULA:
      ADA D2        # WORD/ELEM = 2 + EMA SIZE / 17 
      STA WPELE 
      CLA,INA       FIRST BIT # IN THE TABLE
      STA FSTBT 
      LDA TEMP      RECAL EMA SIZE IN K WORDS 
      MPY D1024 
      DIV WPELE     DIV BY # OF WORDS/ELEMENT 
      ADA DM1       LAST ELEMENT MIGHT NOT BE TOTALLY IN
      STA LSTBT     SETUP LAST BIT # IN THE TABLE 
      CLB 
      DIV D16       COMPUTE LENGTH OF THE TABLE 
      ADA D2        IN WORDS, TO BE SECURE
      STA STA46     SETUP BIT TABLE LENGTH IN WORD
* 
      JSB .MGTG     ALLOCATE THE BIT TABLE
STA46 NOP           LENGTH IN WORDS 
      JMP .ER02 
      JMP .ER02 
      STA .BITB     SETUP ADDR. OF THE BIT TABLE
      LDX STA46     AND CLEAR THE BIT TABLE 
      ADA DM1       TO USE X REGISTER 
      CLB           SET ALL WORDS TO ZERO 
STA47 SBX A,I 
      DSX 
      JMP STA47 
  SPC 1 
      LDB .TMLU     ALLOCATE STACK FOR EACH LU'S. 
      LDA B,I       GET STACK LENGTH
      STA STKLN 
      ADB =D-2
      LDA B,I       GET TOTAL # OF LU 
      STA #LU       AND SAVE LOCALY 
  SPC 1 
      JSB .MGTG     ALLOCATE MEMORY FOR STACK TABLE 
#LU   NOP           TABLE LENGTH
      JMP .ER02     ERROR, NOT ENOUGH MEMORY
      JMP .ER02     ERROR, NOT ENOUGH MEMORY
      ADA DM1       OK, A=TABLE ADDR, DO -1 TO USE X REG
      STA .STKT     INIT STACK TABLE ADDR.
  SPC 1 
      LDY #LU 
STAR4 JSB .MGTG     ALLOCATE MEMORY FOR EACH STACK
STKLN NOP           STACK LENGTH
.ER02 JSB ERRAB     NOT ENOUGH MEMORY TO ALLOCATE 
      JMP *-1       ALL STACKS: ERROR # 02 --> ABORT !!!
      SAY .STKT,I   SAVE ADDR. OF STACK IN STACK TABLE
      LDB BIT15     SET IN FIRST WORD 
      STB A,I       STACK NOT ACTIVE
      ADA T4OFS     CLEAR LINK WORD (TEMP4 IN THE STACK)
      CLB 
      STB A,I 
      DSY           MORE LU ? 
      JMP STAR4     YES, ALLOCATE AN OTHER STACK
  SPC 2 
*                   ALLOCATE ALL NEEDED CLASS I/O 
  SPC 1 
      JSB WRI/O     SAVE PRG. SCHEDULE PARAM INTO CB0 (STKPT MUST=100001) 
      LDA CLASS     RECALL CLASS I/O WORD FOR CB0 
      IOR BIT13     SET "DO NOT DEALLOCATE CLASS" BIT 
      STA CLAS0     AND SET CLASS I/O TO BE USED FOR CB0
      CLA,INA       RESET I/O BUF LENGTH
      STA WRI/L 
* 
      CLA           RESET CLASS WORD
      STA CLASS     TO ALLOCATE A NEW CLASS FOR THE 
      JSB WRI/O     TMS-FMP CALL, LENGTH OF BUFFER IS ONE 
      LDA CLASS     TO INDICATE THAT THE DIRECTORY IS EMPTY 
      IOR BIT13     SET "DO NOT DEALLOCATE CLASS" BIT 
      STA FMPCL     SET THE TMS-FMT CLASS I/O WORD
* 
      JSB GTCLW     GET A CLASS I/O WORD
      STA MCLAS     SET MAIN CLASS I/O
      JSB GTCLW     GET A CLASS I/O WORD
      STA ICLAS     INIT INTERNAL CLASS I/O 
      JSB GTCLW     GET ANOTHER CLASS I/O WORD
      STA CLASS     INIT EXTERNAL CLASS I/O 
      IOR =B40000   SAVE BUFFER CLASS 
      STA CLASG 
  SPC 2 
*                   INITIATE ALL TMS-SYSTEM PROGRAM:  TMSL/TMST/TMSIM 
  SPC 1 
      LDA .TMSL     SCHEDULE TMS LINK PRG.
      STA SCHFL     SET SCHEDULE FLAG "WITH WAIT" 
      JSB SCHUP 
      HLT 11B       PROGRAM MISSING !!! 
* 
      LDA .TMST     SCHEDULE TMS TIMER PRG. 
      JSB SCHUP 
      HLT 12B       PROGRAM MISSING !!! 
  SPC 2 
      LDA IMAGE,I   GET THE NUMBER OF DATA-BASES
      SZA,RSS       ANY DB DEFINED IN THIS APPLICATION ?
      JMP STAR6     NO, FORGET DB OPEN REQUEST
      CLB,INB       YES, OPEN ALL THE DATA-BASES
* 
STA53 STB TEMP      SAVE DB # 
      BLF,BLF       ROTATE DB# INTO BITS 15-13
      BLF,RBL 
      CLA           OPEN DATA BASE REQUEST
      JSB IMRQT     SCHEDULE TMS-IMAGE-MODULE PROGRAM 
      JMP STAR6     LAST DATA BASE HAS BEEN OPEN
      JMP STA58     RETURN OK CONTINUE
STA55 DST BUF       ERROR RETURN, SET IMAGE ERR# & RQ # 
.ER21 JSB ERRAB     AND PROCESS IMAGE ERROR (NEVER COME BACK) 
  SPC 1 
STA58 CMA,INA       DBOPN IS OK, A REG CONTAINS NEG INTERNAL DB NO. 
      STA .IMF4,I 
      LDB IMRQ2 
      ADB D3        INIT THE DBOPEN TABLE 
      LDA IMBF+1    SET THE INITIAL LOCKID WORD 
      STA B,I       AFTER PROG. NAME
      INB 
      LDA .IMF4     MOVE THE CLASS I/O - DB CRC - 
      MVW D5        INTO THE DBOPEN TABL. 
* 
      LDB TEMP      RECALL DB#
      INB           AND TRY TO OPEN THE NEXT DATA-BASE
      JMP STA53 
  SPC 2 
*                   INTERNAL INITIALISATION PHASE IS COMPLETED: 
*                   =========================================== 
* 
*                     START UP PROCESSES, THE INITIAL & ALL 
*                     INTERCATIVE PROCESSES.
  SPC 1 
STAR6 CCA           SET ABORT TMS WHEN ERROR FLAG 
      STA NOABT 
      CLA           SET SCHEDULE FLAG "NO-WAIT" 
      STA SCHFL 
* 
      LDA PNXXX,I   GET NAME ADDR OF THE INITIAL-PROCESS
      SZA           INITIAL-PROCESS ? 
      JMP ISPRL     YES, SET IT UP
STAR8 JSB STIPR     NO, START ALL INTERACTIVE PROCESSES 
   SPC 1
      JMP IDLE
  SPC 2 
UPTEN DEC 5         UPT TABLE ENTRY LENGTH
TUSEN DEC 5         TUS TABLE ENTRY LENGTH
AS0CM OCT 54        COMMA 
RU    ASC 1,RU
ON    ASC 1,ON
   HED .   CONSTANT, VARIABLE AND UTILITIES FOR THE START-UP PHASE
IOPTN OCT 140001    LU LOCK/NO WAIT/NO ABORT
O72   OCT 72
O40   OCT 40
@APLN DBL APLNM 
O77   OCT 77
LBYTE OCT 177400
O114C OCT 11400 
BIT13 OCT 20000 
CLASG NOP 
UNBMS ASC 5, EQ,XX,UN    UNBUFFERED THE LOG DEVICE
  SPC 2 
IDSG? NOP 
      STA IDSG3     SAVE PROGRAM NAME ADDR
      JSB IDGET     CHECK IF IDSEG IS THERE 
      DEF *+2 
IDSG3 NOP           PNAME 
      SZA,RSS       IDSEG HERE ?
      JMP IDSG6     NO, ERROR 
* 
      JSB DORMT     PROGRAM DORMANT ? 
      DEF *+2 
      DEF IDSG3,I   PROGRAM NAME ADDR.
      SSA           DORMANT ? 
      JMP IDSG?,I   YES, RETURN 
* 
      LDA IDSG3     NO, DO AN 'OF,PNAME,1'
      LDB .IDS8     TO MAKE IT DORMANT
      MVW D3        MOVE PROG. NAME INTO THE BUFFER 
      JSB MESSS     CALL SYSTEM PROCESSOR MESSAGE 
      DEF *+3 
      DEF IDS8      MESSAGE BUFFER
      DEF D12       MESSAGE LENGTH
      JMP IDSG?,I   AND RETURN
* 
IDSG6 LDA IDSG3     NO, PUT PNAME IN MESSAGE
      LDB .MS04 
      MVW D3
      LDA IDSG7 
      MVW =D4 
      LDA .MS0
      JSB OUTM      OUTPUT "TMS 00  PNAME MISSING"
      JMP ABT3      EXIT. 
* 
IDSG7 DEF *+1 
      ASC 4,MISSING 
.IDS8 DEF IDS8+2
IDS8  ASC 6, OF,XXXXXX,1
  SPC 2 
IMRQT NOP 
      DST IMBF      SET IMAGE RQ CODE 
      LDA B 
      ALF,RAR       ROTATE AND ISOLATE DB#
      AND D7
      STA DB#       SAVE DB# INTO B REG 
      ADA .DB       INDEX IN DBOPEN TABEL 
      LDA A,I 
      STA IMRQ2     SAVE PRGRAM NAME ADDR.
      LDA DB#       RECALL DB#
      CMA,INA       AND VERIFY IF THE DATA BASE EXIST 
      ADA IMAGE,I   ADD TO MAX DB#
      SSA           DATA BASE DEFINED ? 
      JMP IMRQT,I   NO, RETURN P+1
      LDA IMRQ2,I   RECALL 1ST WORD OF PRG NAME 
      SZA           PRG NAME DEFINED ?
      JMP IMRQ1     YES, CONTINUE 
      LDA IMBF      NO, RECALL RQ CODE
      SZA           OPEN REQUEST
      JMP IMRQT,I   NO, RETURN P+1 (DB UNDEFINED) 
IMRQ1 JSB DBNAD     RETREIVE DB NAME ADDR FROM DB#
      LDB .IMF4     MOVE THE DB OPEN INFORMATION
      MVW D9        INTO THE BUFFER THAT WILL BE SEND TO
      LDB IMRQ2     THE TMS-IMAGE MODULE, SAVE PROGRAM
      MVW D3        NAME INTO THE DBOPEN TABLE
      INB           MOVE WHATEVER IS IN IMAGE INTERNAL DB# SLOT 
      STB IMBF+2         INTO BUFFER, (IN CASE CALL IS DBCLS) 
      ISZ IMRQT     RETURN ADDR WILL BE  P+2 OR P+3 
* 
      JSB EXEC      SCHEDULE TMS-IMAGE-MODULE 
      DEF *+10
      DEF NAB23     QUEUE SCHEDULE WITH WAIT & NO-ABORT 
IMRQ2 NOP           PROGRAM NAME
      DEF LU        1ST PARAM 
      DEF * 
      DEF * 
      DEF * 
      DEF * 
      DEF IMBF      STRING PASSING BUFFER 
      DEF D14       STRING LENGTH 
      JMP IMRQ5     ERROR RETURN (PROGRAM NOT PRESENT)
      JSB RMPAR     RETURN OK, GET PARAMATER BACK 
      DEF *+2 
.IMF4 DEF IMBF+4
      DLD IMBF+4
      SSA           IMAGE REQUEST OK ?  (NEG - OK, POS - ERROR)!!!!!! 
*                         IF OK, THEN A CONTAINS NEG IMAGE INT. DB NO.
      JMP IMRQT,I   YES, RETURN P+2 
IMRQ4 LDB IMBF      NO, RECALL IMAGE RQ CODE
      ISZ IMRQT     AND RETURN P+3
      JMP IMRQT,I 
* 
IMRQ5 LDA D450      PROGRAM NOT LOADED = ERROR # 1
      JMP IMRQ4 
  SPC 2 
DBNAD NOP           RETEIVE THE DB NAME ADDR. FROM THE DB#
      LDA DB#       RECALL DB#
      ADA DM1       INDEX INTO THE DATA BASE DEFINITION TABLE 
      MPY D12       TO RETEIVE DATA BASE CHARACTERISTICS. 
      INA           SKIP THE DB COUNT 
      ADA IMAGE     INDEX IN THE DEFINITION TABLE.
      JMP DBNAD,I 
  SPC 2 
*                   DBOPEN DATA BASE
* 
*     FORMAT: 
*     ------- 
* 
*                   4 ENTRIES (ONE FOR EACH POSSIBLE DATA BASE) 
*                   9 WORDS PER ENTRY 
* 
*     3 WORDS -  TMS-IMAGE-MODULE NAME
*     1 WORD  -  INITIAL LOCKIDWORD   ( TMS DB# / PID ) 
*                                    BIT  15-13 / 12-0
*     1 WORD  -  IMAGE INTERNAL DB# 
*     1 WORD  -  CLASS I/O (USED TO SEND RQ TO TMS-IMAGE-MOD.)
*     1 WORD  -  DATA BASE CRC
*     1 WORD  -  MAXIMUM ITEM LENGTH IN WORDS 
*     1 WORD  -  MAXIMUM ENTRY LENGTH IN WORDS
  SPC 2 
DB#   NOP           HOLD THE DATA BASE NUMBER 
* 
.DB   DEF * 
      DEF .DB1
      DEF .DB1+9
      DEF .DB1+18 
      DEF .DB1+27 
* 
.DB1  EQU * 
      REP 36
      DEC 0 
  SPC 2 
IMBF  BSS 13        BUFFER SEND TO TMS-IMAGE-MODULE 
      DEC 1 
  SPC 2 
* 
* 
* 
APLNM BSS 3 
  SPC 2 
  SPC 2 
STIPR NOP           START ALL INTERACTIVE PROCESSES 
      LDA STKPT     SAVE STACK POINTER
      STA STIP4 
      CLA 
      STA SCODE     SUBROUTINE CODE=0 FOR START TMS 
      STA SPR80     CLEAR CALL TO THIS ROUTINE (ONLY ONCE)
      STA STAR8       "      "       "      " 
      STA .PAR5+4   INIT DEFAULT LOCK ID WORD (INIT CB1(7)) 
* 
      LDX DM1 
      LAX .TMLU,I   GET # OF INTERACTIVE DEVICES
      CAX 
STIP2 LBX .STKT,I 
      JSB INSTK     INITIALIZE STACK
      JSB WRI/O     START UP THE PROCESS
      DSX           MORE INTERACTIVE DEVICES ?
      JMP STIP2     YES, CONTINUE 
      LDA STIP4     NO, RESTORE STACK POINTER 
      STA STKPT     AND EXIT. 
      JMP STIPR,I 
* 
STIP4 NOP 
.STKT NOP           ADDR OF  STACK TABLE ADDR - 1 (USAGE OF X)
  SPC 2 
ILRQ  STA TEMP
      NOP 
      HLT 20B 
  HED .          T M S   ---  I D L E   L O O P  ---
EXITZ JSB WRI/O     QUEUE UP THIS PROCESS 
  SPC 2 
IDLE  RSS           FLAG TO SCAN/NOT SCAN THE EXT. EVENT WAIT QUEUE 
      JMP IDLEZ 
      LDB .EXTW,I   SCAN THE EXTERNAL EVENT WAIT QUEUE
      SZB,RSS       QUEUE EMPTY ? 
      JMP IDLEZ     YES, SUSPEND TMSYS ON THE CLASS I/O GET !!
* 
      LDB .EXTW     NO, GET QUEUE HEAD
IDLEQ STB EXTWP     SAVE QUEUE POINTER
      LDB B,I       GO AHEAD IN THE QUEUE 
      SZB,RSS       END OF QUEUE ?
      JMP IDLEY     YES, SET IDLE LOOP TIMING 
      ADB T3MOF     NO, SET B=STACK POINTER 
      LDA B,I       A=S REG.
      LDA A,I       A=SUBROUTINE ADDR 
      JSB A,I       TRY TO RESTART THE PROCESS
      LDB EXTWP,I   GET NEXT ELEMENT OF THE QUEUE 
      JMP IDLEQ     AND LOOP UNTIL END. 
  SPC 1 
IDLEZ JSB EXEC      CLASS I/O GET 
      DEF *+7 
      DEF D21 
      DEF CLASG     SAVE BUFFER 
.BUF  DEF BUF 
      DEF DM8 
      DEF STKPT     GET BACK STACK ADDR 
.SCOD DEF SCODE     GET BACK SUBROUTINE CODE
      SSA 
      HLT 22B 
      STA TEMP      SAVE STATUS OF THE LAST OPERATION 
  SPC 2 
      LDA SCODE     GET SUBROUTINE CODE 
      SSA           SPECIAL OPERATION FROM TMSB ? 
      HLT 24B       YES, PROCESS   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      ADA C.TAB     NO, INDEX IN TABLE
      JMP A,I       AND JMP TO RIGHT CODE 
  SPC 2 
*                   EXTERNAL EVENTS WAIT QUEUE PROCESS AND
*                   IDLE LOOP TIMING. 
  SPC 1 
IDLEY CLA           DO NOT SCAN THE EXT. EVENTS WAIT QUEUE
      STA IDLE      IF WAITING ON THE IDLE LOOP TIMING
      LDA .DSTK     GET DUMMY STACK ADDR
      STA STKPT     TO SET STACK POINTER
      LDA PAUCD     AND SIMULATE A PAUZ REQUEST 
      STA SCODE     FOR THAT DUMMY STACK. 
      LDA =D100     PAUSE FOR  1.00 SECONDS 
      STA .PAR1 
      JMP PAUS      EXECUTE PAUSE CODE
  SPC 1 
IDLEX LDA .RSS      RETURN FORM THE TIMER,
      STA IDLE      RESTORE THE SCANNING OF THE EXT. EVENT
      JMP IDLE      WAIT QUEUE
  SPC 1 
*     DUMMY STACK USED FOR IDLE LOOP TIMING.
  SPC 1 
.DSTK DEF *+1       DUMMY STACK ADDR (DO NOT MIX NEXT WORDS !!) 
* 
      DEF *+13      DUMMY S REG.
      DEF *+11      DUMMY Q REG.
EXTWP NOP           QUEUE POINTER 
.EXTW DEF *+1       EXTERNAL EVENT WAIT QUEUE HEAD
      OCT 0 
O40K  OCT 40000 
PAUCD DEC 12
      BSS 5         TEMP1/TEMP4 ON THE STACK
      OCT 40002     VERY 1ST TMS SUB. # (SPECIAL WITH BIT14)
      OCT 0         RTN ADDR OF THE DUMMY STACK 
  SPC 2 
DEXTW NOP           DEQUEUE FROM EXTERNAL EVENT WAIT QUEUE
      STB STKPT     B MUST = STACK POINTER
      ADB T3OFS     TO ACCESS THE LINK WORD 
      LDA B,I       GET NEXT LINK IN THE QUEUE
      STA EXTWP,I   TO REPLACE THE CURRENT ENTRY
      CLA 
      STA B,I       CLEAR LINK WORD IN THE STACK
      JMP DEXTW,I 
  SPC 2 
IDL00 JSB RELBU     RELEASE THE BUFFER CLASS AND FORGET 
      JMP IDLE      (THOSE CALL NEVER RETURN TO TMLIB)
  SPC 1 
IDL02 JSB RELBU     RELEASE THE BUFFER CLASS AND
IDL03 JSB SETST     SAVE STATUS & TLOG INTO CB1 WORD 4&5
      JMP EXIT4     AND RETURN TO 'TMLIB' 
  SPC 1 
IDL04 JSB RELBU     RELEASE THE BUFFER CLASS AND
IDL41 CLA           RESET STATUS & TLOG 
IDL42 CLB 
      JMP IDL03 
  SPC 1 
IDL06 JSB RELBU     RELEASE THE BUFFER CLASS AND
      JMP EXIT4     RETURN TO 'TMLIB' WITHOUT UPDATING STATUS.
  SPC 1 
IDL08 LDA DM4       DELAY THAT REQUEST, WAIT FOR A MAXIMUM
      LDB .IDL8     1 SEC, BUT CHECK QUEUE LEN EVERY 250 MS 
      JSB WAIT      SUSPEND PROGAM
IDL82 JSB #REQU     TIME ELAPSED, DO THE REQUEUE NOW
      DEF *+3 
      DEF CLASS 
      DEF CLASS 
      SZA           REQUE OK ?
      HLT 40B       ERROR !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
*REQ  JSB DMPTM 
*REQ  DEF *+7 
*REQ  DEF D6
*REQ  DEF LU
*REQ  DEF D20 
*REQ  DEF REQM1 
*REQ  DEF D20 
*REQ  DEF D1
      JMP IDLE
      DEC 100 
* 
.IDL8 DEF *+1 
      NOP           CHECK QUEUE LENGTH
      JSB NRCLS     RETREIVE THE NUMBER OF COMPLETED
      DEF *+2       REQUESTED PENDING ON THAT I/O CLASS 
      DEF CLASS     COMPLETION QUEUE
      CPA D1        ONLY ONE ?
      JMP .IDL8+1,I YES, THE ONE TO BE REQUE
      JMP IDL82     NO, REQUE NOW TO GET OTHER PENDING RQ 
  SPC 2 
WAIT  NOP           SUSPEND ITSELF FOR SMALL PERIOD OF TIME 
      STB WAITX     SAVE ADDR. OF THE CHECK CONDITION ROUTINE 
      SSA,RSS       MAKE TIME COUNTER NEGATIVE
      CMA 
      STA WAITY 
WAIT2 JSB WAITX,I   CHECK FOR THE CONDITION 
      JSB EXEC      SUSPEND ITSELF
      DEF *+6       FOR .25 SEC.
      DEF D12       TIMED EXECUTION (INITIAL OFFSET)
      DEF D0        PROGRAM NAME    (CALLING PROGRAM) 
      DEF D1        RESOLUTION CODE (1/100 SEC.)
      DEF D0        EXECUTION MULT. (ONLY ONCE) 
      DEF DM25      TIME (250 MS) 
      ISZ WAITY     CONDITION NOT MET YET, WAIT MORE ?
      JMP WAIT2     YES, WAIT LONGER
      JMP WAIT,I    NO, RETURN TO CALLER
* 
WAITX NOP 
WAITY NOP 
   HED TMS RETURN TO USER PROGRAM (RETURN INTO 'TMLIB') 
EXIT3 CCA           SET REQUEUE FLAG
      STA RQU?      AND RETURN TO TMLIB 
  SPC 1 
EXIT4 CCA 
      STA SRFLG     SET SEND MAIL-BOX FLAG
      DLD STKPT,I 
      DST S         SET S & Q REGISTER
* 
      INB 
      LDA B,I 
      STA RTRNA     SET RETURN ADDR 
   SPC 1
      LDA Q,I       RECALL TMS SUBROUTINE NUMBER
      CLE           CLEAR BIT15 AND 
      ELA,CLE,ELA   SAVE BIT14 INTO E 
      RAR,RAR 
      SEZ           SPECIAL RETURN ?
      JMP SEXIT     YES, SPECIAL RETURN PROCESSING
      MPY TUSEN     NO, RETURN TO TMLIB 
      ADA .TMSB     RETREIVE PRG NAME 
      STA .EPAO     INIT 'ENTRY POINT ADDR OF SUB' ADDR 
      ADA DM1       TO GET PROGRAM NAME ADDR
      LDA A,I       GET PROGRAM NAME ADDR 
      STA PNADR     SET IT TO THE SCHEDULE RQ 
      LDB RTRNA     GET RETURN ADDR 
      SZB           FIRST TIME ENTRY ?
      JMP EXIT6     NO, SKIP CALCULATION OF LOCAL SUB # 
      ADA UPTEN     YES, COMPUTE LOCAL SUB #
      ADA DM1 
      LDA A,I 
      CMA,INA 
      INA 
      ADA .EPAO 
      DIV TUSEN     B IS ALREADY CLEARED
      CMA,INA       MAKE IT NEGATIVE FOR THE FIRST ENTRY
      STA RTRNA     SET RTN ADDR TO NEG. LOCAL SUB #
   SPC 1
EXIT6 LDA .EPAO,I   GET 'ENTRY POINT ADDR OF SUB' 
      STA EPAOS 
* 
      LDA LEN00     SET CB0 LENGTH IF IT IS DEFINED 
      LDB Q,I       INSIDE THIS TMS SUBROUTINE
      SSB,RSS       CB0 DEFINED ? 
      CLA           NO, CB0 LEN = 0 
      STA LEN0      YES, SET CB0 LEN
* 
      LDA STKPT 
      ADA T1OFS     MOVE FUNCTION PARAMETERS
      LDB .FPAR     FROM THE STACK INTO THE BUFFER SEND 
      MVW #FPAR     TO TMLIB.  (3 FUNCTION PARAMETERS)
      LDA Q         GET ADDRESS IN THE STACK
      ADA QCBLA     TO MOVE CB DEFINITION 
      MVW D11       MOVE CB'S DEFINITION
  SPC 1 
      JSB SRCB      SEND ALL NEEDED CB'S
  SPC 1 
      LDA RQU?      RECALL REQU FLAG
      SZA,RSS       REQU NEEDED ? 
      JMP EXIT8     NO, CONTINUE
* 
      JSB #REQU     YES, REQUEUE THE PENDING BUFFER 
      DEF *+3       FROM THE TMS EXTERNAL CLASS I/O 
      DEF CLASS     TO THE TMS INTERNAL CLASS I/O 
      DEF ICLAS 
      SZA           REQUEUE OK ?
      HLT 25B       !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
*REQ  JSB DMPTM 
*REQ  DEF *+7 
*REQ  DEF D6
*REQ  DEF LU
*REQ  DEF D20 
*REQ  DEF REQM2 
*REQ  DEF D20 
*REQ  DEF D1
      CLA           RESET THE REQUEUE FLAG
      STA RQU?
  SPC 2 
EXIT8 LDA PNADR     RECALL PROGRAM NAME ADDR
      JSB SCHUP     SHEDULE PROGRAM (USER PARTITION)
      HLT 30B       ERROR RETURN !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  SPC 1 
      CLA 
      STA SRFLG     SET RECEIVE MAIL-BOX FLAG 
* 
      LDA ICLAS     SWAP THE MAIN & THE INTERNAL
      LDB MCLAS     CLASS I/O WORD
      STA MCLAS 
      STB ICLAS 
* 
      JSB MAILB     SUSPEND TMSYS ON THE MAIN CLASS I/O 
      DEF LCLAS     TO WAIT THAT THE UPT RETURN TO TMSYS
      ABS PARLN     WITH THE REQUEST ON THIS CLASS
  SPC 2 
**************************************************************************
  SPC 2 
      LDA ICLAS     SWAP BACK THE MAIN & THE INTERNAL 
      LDB MCLAS     CLASS I/O WORD TO RESTORE THEM
      STA MCLAS 
      STB ICLAS 
  SPC 1 
      LDA SCOD.     RESTORE SCODE 
      STA SCODE 
      CPA ABTFL     ERROR IN TM-LIBRARY ? 
      JMP TMLER     YES, PROCESS IT 
  SPC 1 
      LDB Q         SAVE RETURN ADDRESS 
      INB           INTO THE STACK
      LDA RTRN. 
      STA B,I 
      LDA LCLAS     GET LOCAL CLASS I/O 
      SZA,RSS       PROGRAM SUSPENDED ON CLASS I/O
      JMP SAV25     NO, CONTINUE
* 
      IOR BIT15     YES, SET BIT 15 TO DIFFERENTIATE FROM PNAME 
      CPA PNADR,I   FIRST TIME ?
      JMP SAV25     NO, CONTINUE
      STA TEMP      YES, SAVE IT TEMPORARILY
      JSB IDGET     RETREIVE ID SEG ADDR
      DEF *+2 
      DEF PNADR,I   RETURN WITH A = IDSEG ADDR
      LDB A         SET B = IDSEG ADDR
      LDA TEMP      AND REPLACE PNAME WITH CLASS I/O WORD 
      DST PNADR,I   AND ID SEG ADDR IN PLACE OF PNAME 
  SPC 1 
SAV25 CCA           SET 'NO ABORT FLAG' FALSE 
      STA NOABT     I.E.: ERRORS WILL ABORT TM
  SPC 1 
      JSB SRCB      SAVE CB'S DATA INTO THE EMA ARRAY 
  SPC 1 
SAV40 CLA           SET 'MEMORY SUSPEND FLAG' 
      STA MSUFL     I.E.: PROCESS WILL BE SUSPENDED 
      LDA SCODE     RECALL SUBROUTINE CODE
      ADA I.TAB 
      JMP A,I 
  SPC 1 
RQU?  OCT 0         REQUEUE FLAG (NOT 0 IF REQUEUE IS NEEDED) 
  SPC 3 
*                   SPECIAL RETURN INSIDE TMSYS INSTEAD OF
*                   RETURNING TO TMLIB. 
  SPC 1 
SEXIT ADA .SEXI     INDEX INTO RETURN TABLE 
      JMP A,I       AND GO EXECUTE THE PROPER STATEMENT 
  SPC 1 
.SEXI DEF *+1,I     SPECIAL RETURN TABLE
      DEF SPR80     0  RETURN FROM AN AUXILIARY PROCESS 
      DEF .ER07     1  RETURN FROM AN INTERACTIVE PROCESS --> ERROR 
      DEF IDLEX     2  IDLE LOOP TIMING RETURN
  SPC 2 
.ER07 JSB ERRAB     ERROR # 7: RETURN FROM AN INTERACTIVE PROCESS 
   SPC 4
SRCB  NOP 
      CLA           INIT THE NUMBER OF DEFINED CB'S 
      STA #DFCB 
      LDA Q         GET POINTER TO CB'S DEFINITION
      ADA QCBLA     INTO THE STACK
      LDX A,I       GET CB1 LOCAL ADDR
      LDB STKPT     SET UP LOGICAL CB ADDR
      ADB D2        POINTER INTO THE STACK
      STB PT
* 
SRCB1 INA           INCREMENT CB'S DEFINITION PT
      CPA S         END OF STACK ?
      JMP SRCB,I    YES, RETURN 
      LDB A,I       NO, GET CURRENT CB LENGTH 
      RBL,CLE,ERB   CLEAR BIT15, E=ENABLE/DESABLE FLAG
      SEZ           CB ENABLED ?
      JMP SRCB8     NO, GOTO NEXT CB
      STA TEMP      YES, SAVE A (CB DEFINI. PT) 
      LDA PT,I      GET LOGICAL CB ADDR.
      SZA,RSS       ALLOCATED ? 
      HLT 32B       NO, ERROR !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      JSB MAPCB     MAP CB DATA, RETURN ADDR. OF CBX(1) 
      DST SRCB6     SET ACTUAL CB ADDR & CURRENT CB LENGTH
  SPC 1 
      LDB PNADR     GET SYSTEM COMMON/CLASS I/O FLAG
      ADB D3        IT IS BIT15 OF WORD FOLLOWING PNAME 
      LDB B,I 
      SSB,RSS       SYSTEM COMMON BEING USED ?
      JMP SRCB5     NO, GO USE CLASS I/O
* 
      LDB SRFLG     YES, CHECK SEND/RECEIVE FLAG
      SZB           SEND ?
      JMP SRCB3     YES, MOVE FROM MEMORY TO COMMON 
      CXA           NO, MOVE FROM COMMON TO MEMORY
      LDB SRCB6     GET TO ADDR (INTO EMA ARRAY)
      JMP SRCB4     AND GO PERFORM THE MOVE 
SRCB3 CXB           SEND, GET TO ADDR (SYSTEM COMMON) 
SRCB4 MVW SRCB6+1   MOVE DATA 
*     DST PARM1 
*     JSB DMPTM 
*     DEF *+7 
*     DEF D6
*     DEF SRCB6,I 
*     DEF SRCB6+1 
*     DEF MES3
*     DEF D10 
*     DEF D1
*     DLD PARM1 
      JMP SRCB7     AND CONTINUE FOR NEXT CB
* 
SRCB5 JSB MAILB     SEND/RECEIVE COMMON BLOCK DATA
SRCB6 BSS 2 
* 
SRCB7 LDA TEMP      RESTORE CB'S DEFINITION POINTER 
  SPC 1 
SRCB8 INA           BUMP CB'S DEFINITION PT 
      ADX A,I       MAINTAIN LOCAL CB ADDR. INTO X REG
      ISZ PT        BUMP LOGICAL ADDR PT
      ISZ #DFCB     BUMP NUMBER OF DEFINED CB'S 
      JMP SRCB1     AND LOOP UNTIL END
  SPC 2 
STKPA JSB STKP.     STACK PARAM .ADDR.
      JMP IDLE      AND EXIT
* 
STKP. NOP           SAVE ADDR OF THE 3 FUNCTION PARAMETERS
      LDA ..PA1 
      LDB STKPT     INTO THE STACK
      ADB T1OFS 
      MVW #FPAR 
      JMP STKP.,I   AND GO TO IDLE LOOP.
* 
.FPAR DEF FPARM 
..PA1 DEF .PAR1 
NOABT NOP 
.EPAO NOP 
PNADR NOP           PROGRAM NAME ADDRESS
  HED START-UP TMS PROCESSES
START JSB RELBU 
      DLD STKPT,I   INIT S & Q REGISTERS
      DST S 
* 
      ISZ B,I       SET VERY 1ST TUS# FOR INTER. PROCESS
      CLA           SET STOP-INHIBIT FLAG TO 0
      ADB DM1       (TMS CAN BE STOPPED DURING A INTERACTIVE
      STA B,I       PROCESS)
* 
      LDA PNX00     MOVE STARTING PROCESS NAME
      LDB ..PA1     IN PLACE OF PARAMETERS TO 
      MVW D3        SIMULATE A TM SUBROUTINE CALL.
      JMP SPR88 
  SPC 4 
* 
*       RESTART THE PROCESS AFTER 
*       A MEMORY SUSPEND OPERATION. 
  SPC 1 
MSU50 JSB RELBU 
      DLD STKPT,I   RESTART PROCESS 
      DST S 
      LDB ..PA1     RESTORE CALLING SEQUENCE
      MVW D10       AT THE TIME OF THE MEM. SUSP. 
      LDA STKPT 
      ADA T2OFS     RETREIVE SUBROUTINE CODE OF 
      LDA A,I       SUSPENDED OPERATION 
      STA SCODE     AND 
      JMP SAV40     RESTART FROM THE SUSP. POINT
  SPC 3 
T1OFS DEC 7         OFFSET FROM BEGINNING OF STACK TO TEMP1 
T2OFS DEC 8         OFFSET FROM BEGINNING OF STACK TO TEMP2 
T3OFS DEC 9         OFFSET FROM BEGINNING OF STACK TO TEMP3 
T4OFS DEC 10        OFFSET FROM BEGINNING OF STACK TO TEMP4 
T3MOF DEC -9        NEG. OFFSET FROM BEGINNING OF STACK TO TEMP3
NSOFS DEC 11        OFFSET FROM BEGINNING OF STACK TO STP-INHIBIT 
TYOFS DEC 12        OFFSET FROM BEGINNING OF STACK TO STACK TYPE
  HED WRITE/READ AND LOGGING REQUEST
WRRQ  JSB RELBU     RELEASE OUTPUT BUFFER 
      LDA STKPT     RECALL STACK POINTER
      ADA T2OFS     RETREIVE FUNCTION PARAMATERS
      STA WRRQ3     SET READ BUFFER LENGTH
      INA           TO GET USER SUPPLIED CTL BIT
      LDB A,I       GET USER SUPPLIED CTL BIT 
      LDA STKPT 
      ADA D2
      LDA A,I       GET CB1 LOGICAL ADDR
      JSB GCBAD     MAP THE FIRST 1025 WORDS
      INA           TO GET CTL BIT FROM CB1 
      SZB,RSS       USER SUPPLY THE CTL BIT ? 
      LDB A,I       NO, GET THE STANDARD ONE
      SWP           YES, KEEP IT AND EXCHANGE A & B 
      AND =B177400  ISOLATE CTL BITS
      RAR,RAR       POSITION CTL BIT
      ADB DM1       TO RETREIVE LU
      IOR B,I       MERGE WITH LU 
      STA TEMP      SAVE CONTROL WORD 
      JSB EXEC      DO THE READ REQUEST 
      DEF *+10
      DEF D17       READ REQUEST
      DEF TEMP      LU
      DEF *         BUFFER ADDR.
WRRQ3 NOP           BUFFER LENGTH 
      DEF STKPT     1ST PARAM (STACK POINTER) 
      DEF D1        2ND PARAM (SCODE FOR READ RQ) 
      DEF CLASS     CLASS I/O WORD
      DEF *         PLACE HOLDER
      DEF RNLCK     BYPASS THE LU-LOCK CHECK
      JMP IDLE      RETURN
  SPC 1 
  SPC 2 
LOGRT LDA BUF       RECALL DCLOG STATUS 
      LDB BUF+1     GET SUBROUTINE CODE 
      SZA           OK? 
      JSB LOGER        NO, KILL PROGRAM 
      JMP IDL04        YES, IT IS OK, RELEASE BUF AND RETURN TO TMLIB 
* 
  HED IMAGE REQUEST 
IMULK LDX #LU       BEFORE UNLCK, CHECK IF LOCKID IS USED ! 
  SPC 1 
IMUL2 LBX .STKT,I   B=STACK POINTER 
      LDA B,I       GET S VALUE 
      SSA           STACK ACTIVE ?
      JMP IMUL7     NO, FORGET IT 
      ADB D2        ADDR. OF ACTUAL CB1 ADDR
      LDA B,I       RETREIVE CB1 ADDR. (0 IF NOT ALLOCATED) 
      ADB DM2       RESTORE B=STACK POINTER 
      JSB GCBAD     MAP 1025 FIRST WORDS OF CB & RETURN ADDR. 
      SWP           SWAP A & B REG. 
      ADB D11       ADDR. OF CB1(12) (LOCK ID WORD) 
      ADA T2OFS     PRESET A TO GET LOCKID FROM STACK AT TEMP2
      CPB D11       CB1 ALLOCATED ? 
      LDB A         NO, THEN THE LOCKID IS STILL ON STACK 
      ADA D2        PRESET A TO EXAMINE THE WAITING QUEUE 
      JMP IMUL5     AND GO CHECK THIS LOCK ID WORD
* 
IMUL4 LDA A,I       GO DOWN IN THE WAITING QUEUE
      SZA,RSS       END OF WAITING QUEUE ?
      JMP IMUL7     YES, GO TO NEXT STACK 
      LDB A         NO, RETREIVE THE LOCK ID FROM 
      ADB D9        THE WAITING BLOCK IN MEMORY 
IMUL5 JSB .IMU2,I   CHECK THIS LOCKID, B=ADDR. OF LOCKID
      JMP IMUL4     CONTINUE UNTIL END OF WAITING QUEUE 
* 
IMUL7 DSX           GO TO NEXT STACK
      JMP IMUL2     UNTIL END OF TABLE
      JMP .IMU4,I   ALL STACK HAVE BEEN CHECKED, EXIT 
  SPC 2 
.IMU4 DEF *+1       AND THIS LOCKID IS NO LONGER USED 
      JSB RELBU     RELEASE THE BUFFER
      LDB BUF       RECALL THE LOCKID WORD TO 
      JSB IMULO     RELEASE ALL RECORDS LOCK TO THIS ID 
      JMP IDLE      RETURN OK 
      JMP STA55     ERROR RETURN, ABORT TMS APPLICATION ! 
  SPC 2 
IMULO NOP           ROUTINE TO PERFORM THE UNLOCK REQUEST 
      LDA D8        IMAGE RQ=8 FOR UNLOCK REQUEST 
      JSB IMRQT     SCHEDULE TMS-IMAGE-MODULE PROGRAM 
      HLT 40B       IMAGE NOT THERE 
      JMP IMULO,I   RETURN OK 
      ISZ IMULO     GO PROCESS FATAL IMAGE ERROR. 
      JMP IMULO,I 
   SPC 2
.IMU2 DEF *+1       SUBROUTINE ENTRY POINT ADDR 
      NOP           SUBROUTINE ENTRY POINT
      LDB B,I       GET THE LOCK ID WORD
      CPB BUF       IS IT USED ?
      JMP IDL08     YES, DELAY THE UNLOCK REQUEST 
      JMP .IMU2+1,I NO, CONTINUE THE SEARCHING
*DLD1 JSB DMPTM 
***   DEF *+7 
***   DEF D6
***   DEF LU
***   DEF D100
***   DEF IDMS1 
***   DEF D20 
***   DEF D1
***   JMP IDL08 
*DLD2 JSB DMPTM 
***   DEF *+7 
***   DEF D6
***   DEF LU
***   DEF D100
***   DEF IDMS2 
***   DEF D20 
***   DEF D1
***   JMP IDL08 
*DMS1 ASC 10,1FROM .IMU2
*DMS2 ASC 10,1FROM TSP40
*100  DEC 100 
* 
  SPC 3 
*     IMAGE REQUEST:
*                   IF NOT DBOPN REQUEST, STACK PARAMETER AND RETURN
* 
*                   IF DBPON, RE-INIT CB1[6:13] AND RETURN
*                   DIRECTLY TO 'TMLIB'.
* 
*     FORMAT OF CB1[6:13] 
* 
*            WORD 1 - 3      IMAGE MODULE NAME
*                 4          CLASS I/O WD 
*                 5          MAX ITEM LENGTH
*                 6          MAX ENTRY LENGTH 
*                 7          TMS DB# / LOCK ID
*                 8          IMAGE INTERNAL DB# 
* 
* 
  SPC 1 
IMGRQ LDA .PAR1+14  RECALL IMAGE RQ 
      SZA           DBOPN RQ ?
      JMP STKPA     NO, STACK PARAM. AND EXIT 
* 
      CLB,INB       YES, MAP THE CB1
      JSB COM.U 
      STA TEMP      SAVE CB1 ACTUAL ADDR
      ADA D13       SAVE ALSO ADDR OF CB1(14) WHERE 
      STA TEMP1     THE IMAGE STATUS SHOULD BE RETURNED 
* 
      LDA IMAGE,I   GET THE NUMBER OF DATA BASES
      SZA,RSS       ANY DB DEFINED IN THIS APPLICATION ?
      JMP IMG30     NO, RETURN ERROR # 398
      CMA,INA 
      STA TEMP2     IMAGE DB COUNTER
      CLA,INA 
      STA DB#       INIT DB#
* 
      CLA,INA 
      STA DUMMY 
      JSB NAMR      PARSE INPUT DATA BASE NAMR
      DEF *+5 
      DEF BUF       OUTPUT BUFFER:
*                                  WDS 1-3 - D.B. NAME
*                                  WD  4   - TYPE CODE
*                                  WD  5   - SEC. CODE
*                                  WD  6   - CR. NO.
      DEF .PAR5     INPUT BUFFER (NAMR) 
      DEF D19       19 CHAR. MAX
      DEF DUMMY 
* 
IMG12 JSB DBNAD     RETRIEVE THE DB NAME ADDR FROM THE DB#
      LDB .BUF      ADDR OF DB NAME FROM OUTPUT BUFFER
      CMW D3        DB NAME COMPARE ? 
      JMP IMG14     YES, TEST SEC. CODE AND CR. NO. 
      NOP 
      JMP IMG16 
* 
IMG14 ADA D3
      INB 
      CMW D2        MAKE SURE THAT SEC. CODE AND CR. NO. MATCH
      JMP IMG20     EVERYTHING MATCHES, DATA BASE FOUND!! 
      NOP           NO MATCH
IMG16 ISZ DB#       NO, CHECK THE NEXT DATA-BASE
      ISZ TEMP2     ANY DATA-BASE LEFT ?
      JMP IMG12     YES, CHECK IF IT IS THIS ONE
IMG30 LDA =D398     NO, RETURN ERROR # 398 TO THE USER
IMG33 STA TEMP1,I 
      JSB STKP.     STACK PARAMETER 
      JMP EXIT4     AND RETURN TO 'TMLIB' IMMEDIATLY
  SPC 1 
IMG20 CLA           DBOPN SUCCED, RETURN GOOD IMAGE STATUS
      STA TEMP1,I   TO THE USER 
      ISZ TEMP1 
      STA TEMP1,I   RETURN ACCESS LEVEL 
      ISZ TEMP1 
      STA TEMP1,I   RETURN RUN TABLE SIZE 
      ISZ TEMP1     TO RETURN DB-CRC
      LDA DB#       RECALL DB# TO INDEX INTO THE DBOPEN TABLE 
      JSB ICB1I     INIT CB1 FOR IMAGE
      ADA DM6       SET ADDR OF INITIAL LOCKID WORD 
      MVW D2        STORE INITIAL LOCK ID WORD & IMAGE INTERNAL DB# 
      INA           SET ADDR OF DB-CRC
      LDA A,I       GET DB-CRC TO RETURN IT INTO
      JMP IMG33     IMGAGE STATUS WORD 4, RETURN
  SPC 1 
ICB1I NOP           INIT CB1 FOR IMAGE. 
      ADA .DB       RETREIVE TMS-IMAGE-MODULE NAME, 
      LDA A,I       CLASS I/O, MAX ITM LN & MAX ENT LN. 
      LDB TEMP      CB1(1) ADDR 
      ADB D5        CB1(6) ADDR 
      MVW D3        MOVE TMS-IMAGE-MODULE PROG. NAME
      ADA D2        SKIP LOCKID AND IMAGE INTERNAL DB#
      MVW D1        STORE CLASS I/O 
      INA           SKIP DB CRC 
      MVW D2        MOVE MAX ITM & MAX ENT LENGTH 
      JMP ICB1I,I 
  SPC 1 
..PA7 DEF .PAR1+6 
DUMMY BSS 1 
DUMM2 BSS 1 
  SPC 3 
*     RESTART THE PROCESS AFTER 
*     AN IMAGE REQUEST
  SPC 1 
IMRTN LDA BUF       RECALL IMAGE ERROR CODE 
      SZA,RSS       FATAL ERROR ? 
      JMP EXIT3     NO, SET REQUEUE FLAG AND RETURN TO USER 
* 
      JSB RELBU     YES, FATAL ERROR, RELEASE BUFFER
      CLB,INB       MAP CB1 TO GET THE LOCKID WORD
      JSB COM.U     AND THEN RETREIVE THE DB# 
      ADA D11 
      LDA A,I       A=LOCKID WORD 
      ALF,RAR       ISOLATE DB# 
      AND D7
      STA DB# 
      JMP .ER21     AND ABORT TMS.
   HED COMMON-BLOCK ENABLE/DISABLE PROCESS
CBENB LDA .PAR1     SET UP MEMORY SUSP. FLAG
      STA MSUFL     AS REQUESTED BY THE USER
      LDA ..PA2 
      JSB MEMOK     CHECK THAT THERE IS ENOUGH MEMORY 
      LDA ..PA2     OK, PERFORM THE FUNCTION
      STA TEMP1 
* 
CBEN3 LDA TEMP1,I   GET PARAMETER 
      SZA,RSS       PARAMETER DEFINED ? 
      JMP EXITZ     NO, RETURN TO THE OTHER PROG. 
      JSB GECB#     YES, GET CB # 
      JSB COM.E     ENABLE & ALLOCATE THIS CB 
      HLT 43B       MEMORY SUSPEND RETURN 
      SZA,RSS       ALLOCATED DONE ?
.ER05 JSB ERRAB     NO, LOCAL CB LENGTH =0  ---> ABORT TMS
      ISZ TEMP1     GET NEXT PARAMETER
      JMP CBEN3 
  SPC 1 
CBDES LDA ..PA1 
      STA TEMP1 
* 
CBDE3 LDA TEMP1,I   GET PARAMETER 
      SZA,RSS       PARAMETER DEFINED ? 
      JMP CBDE5     NO, RETURN MEMORY AND EXIT
      JSB GECB#     YES, GET CB # 
      JSB COM.D     DISABLE CB
      ISZ TEMP1     GET NEXT PARAMETER
      JMP CBDE3 
* 
CBDE5 JSB CLECO     RETURN FREE MEMORY TO MMGT
      JMP EXITZ     EXIT
  SPC 1 
CBLEN LDA .PAR1     CHANGE CB LENGTH
      JSB GECB#     RETREIVE CB # 
      JSB COM.U     INIT A,B & Y
      STA TEMP1     SAVE CB ACTUAL ADDR 
      LDB LCBLP,I   RECALL LOCAL CB LENGTH
      LDA .PAR2     GET NEW LENGTH
      SSA           NEW LENGTH OK ? 
.ER20 JSB ERRAB     NO, IRRECOVERABLE ERROR, ABORT TMS
      SZA,RSS       OK ?
      JMP .ER20     NO
CBLE3 CMB           MAKE  - LOC. LENGTH - 1 
      ADB A         NEW LEN - LOC. LEN - 1
      SSB,RSS       NEW MUST BE = < LOCAL LEN IN ANY CASE ! 
      JMP .ER20     NEW LENGTH IS TOO BIG, ERROR
      LDB TEMP1     RECALL ACTUAL CB ADDR.
      SZB           ENABLE OR 1ST TIME THROUGH ?
      JMP CBLE5     YES, CHECK FOR LENGTH WHEN ALLOCATED
      LDB CCBLP,I   NO, RECALL CURRENT LEN TO GET ENABLE
      RBL,CLE,ERB   MOVE ENABLE FLAG INTO E 
      RAL,ERA       AND SET ENABLE FLAG WITH NEW CURRENT LENGTH 
      STA CCBLP,I   STORE BACK NEW CURRENT CB LENGTH
      JMP EXIT4     AND RETURN. 
* 
CBLE5 ADB DM1       CHECK NEW LEN MUST BE = < LEN WHEN ALLOCATED
      LDB B,I       RECALL LENGTH WHEN ALLOCATED
      CLA           CLEAR 1ST TIME THROUGH
      STA TEMP1 
      LDA .PAR2     RESTORE A WITH NEW LENGTH 
      JMP CBLE3     AND CHECK THAT IS CORRECT 
  HED TM SUBROUTINE CALL/EXIT PROCESS 
SBCAL LDB STKPT     CHECK FOR STACK OVERFLOW
      CMB,INB 
      ADB S 
      ADB =D25      (ALWAYS 10 EXTRA FREE WORDS ON STACK) 
      CMB,INB 
      ADB STKLN 
      SSB           STACK OVERFLOW ?
.ER12 JSB ERRAB     YES, ERROR   ALWAYS ABORT !!
      DLD S         NO, RECALL S & Q
      CMB,INB       TO STACK THE NEW CALL 
      ADB A         COMPUTE  'DELTA Q'
      CMB           (-X-1) ROOM FOR DELTA Q 
      STB A,I       SAVE MINUS DELTA Q IN THE STACK 
      INA 
      STA TEMP      SAVE NEW Q REGISTER VALUE 
  SPC 1 
      LDB ..PA1     RECALL TM-SUBROUTINE NAME/# ADDR
      JSB GTSU#     GET TM-SUB # (A=TMSUB # ON EXIT)
      JMP SBCER     ERROR RETURN  (A = ERR#)
      STA TEMP,I    SAVE TUS # INTO THE STACK 
      LDA TEMP      A=NEW Q 
      CLB           CLEAR THE STACK 
      LDX QCBLA     USE X REG AS COUNTER TO CLEAR THE STACK 
SBCA4 INA           BUMP STACK PT 
      STB A,I       CLEAR /RTN ADDR/CB1 LOC ADDR./
      DSX 
      JMP SBCA4     LOOP UNTIL END
      INA           SKIP ONE EXTRA WORD TO HAVE S NEW VALUE 
      LDB TEMP      GET NEW Q VALUE 
      DST STKPT,I   SAVE NEW S & Q REGISTER 
      JMP EXITZ     JMP EXIT4 = DO NOT LEAVE THIS PROCESS 
  SPC 1 
SBCER LDB D10       NO ABORT PROCESSING 
      STB SCODE     SET RETURN SUBROUTINE CODE
      CMA,INA       SET STATUS WITH NEG. ERROR CODE 
      JMP SBRT3     AND EXIT WITH TM-SUB RETURN CODE
  SPC 2 
SBRTN JSB DSTAK     AJUST THE STACK 
      JSB CLECO     DE-ALLOCATE ALL NECESSARY CB
      CLA           SET STATUS TO OK
SBRT3 CLB           CLEAR TLOG AND
      JSB SETST     STORE STAT. & TLOG IN CB1 WORD 4 & 5
      JMP EXITZ     JMP EXIT4 = DO NOT LEAVE THIS PROCESS 
  SPC 3 
GTSU# NOP           GET TMS-SUB # (B=ADDR OF NAME/#)
      LDA B,I       CHECK FOR THE "NO ABORT" BIT
      RAL,CLE,SLA,ERA   CLEAR AND CHECK BIT 15
      STA NOABT     SET NOABT FLAG, IF NECESSARY
      STA B,I       AND STORE BACK THE FIRST PARAMETER
      ADA =D-256    IS THE SUBROUTINE DEFINED 
      SSA           BY NAME ? 
      JMP GTSU2     NO, IT IS THE SUBROUTINE #
      LDA .TMSB,I   YES, SUBROUTINE CALL BY NAME
      STA TEMP1     SAVE # OF SUBROUTINE
      CMA,INA 
      STA TEMP2     USE AS COUNTER
      STB TEMP4     SAVE B REG. 
* 
GTSU5 LDA TEMP2 
      ADA TEMP1 
      STA TEMP3 
      MPY TUSEN     MPY BY T.U.S. TABLE ENTRY LENGTH
      INA 
      ADA .TMSB 
      LDB TEMP4     ADDR. OF ASKED FOR SUB. NAME
      CMW D3
      JMP GTSU7     IT IS THIS ONE
      NOP           LESS THAN 
      ISZ TEMP2     GREATER THAN, MORE TM SUBROUTINE ?
      JMP GTSU5     YES, LOOP UNTIL END 
.ER10 JSB ERROR     NO, SUBROUTINE NAME NOT FOUND 
      JMP GTSU#,I   NO ABORT PROCESSING 
* 
GTSU7 LDA TEMP3 
      INA           A IS THE SUB #
      LDB TEMP4     RESTORE B REG 
      STA B,I       AND STORE TMS-SUB # IN PLACE OF NAME
* 
GTSU2 LDA B,I       IT IS THE SUBROUTINE #
      SZA,RSS 
      JMP GTSUE     ILLEGAL SUB # 
      CMA,INA       CHECK THE LEGALITY
      ADA .TMSB,I 
      SSA           IS IT LEGAL ? 
      JMP GTSUE     NO, ILLEGAL SUBROUTINE #
      LDA B,I       YES, GET SUB #
      ISZ GTSU#     RETURN OK 
      JMP GTSU#,I 
  SPC 1 
.ER11 EQU * 
GTSUE JSB ERROR     ILLEGAL TMS-SUB NUMBER
      JMP GTSU#,I   IF NO-ABORT RETURN IN ERROR RETURN
   SKP
DFINE LDA RQCNT     THIS CALL MUST HAVE AT LEAST
      ADA =D-3      TREE PARAMETERS 
      SSA           OK ?
.ER09 JSB ERRAB     NO, ERROR  --> ABORT TMS
      LDA Q,I       RECALL TMS-SUBR. # IN ORDER 
      AND =B37777   TO SET UP 'EPAOS', CLEAR BIT 14 & 15
      MPY TUSEN 
      ADA .TMSB     A=ADDR OF 'EPAOS' 
      LDB .PAR5+5   RECALL 'ENTRY POINT ADDR. OF SUBROUTINE'
      STB A,I       FROM 'TMLIB' BUFFER TO SAVE IT. 
      LDA Q         CHECK THAT
      ADA QCBLA     COMMON IS NOT ALREADY DEFINED 
      INA 
      CPA S         COMMON ALREADY DEFINED ?
.RSS  RSS           NO  CONTINUE
.ER14 JSB ERRAB     YES, 2ND TMDFN IN SAME TMSUB --> ABORT TMS
      LDX DM1       SET UP LOAD INDEX 
      LDY QCBLA     SET UP STORE INDEX
      LDB .PAR1     GET CB0 LOCAL ADDR
* 
DFIN1 CMB,INB       SAVE COMMON BLOCK DEFINTION INTO
      STB A         THE STACK 
      LBX .PAR3     GET NEXT PARAMETER (CB LOCAL ADDR.) 
      SZB,RSS       END OF CALLING SEQUENCE 
      JMP DFIN2     YES, CONTINUE 
      ADA B         NO, COMPUTE LOCAL CB LENGTH AND 
      SSA           AND VERIFY IT IS OK 
.ER08 JSB ERRAB     ERROR IN CB DEFINTION  --> ABORT TMS
      IOR BIT15     SET BIT 15 (NOT ENABLE) 
      SAY Q,I       STORE CB CURRENT LENGTH INTO THE STACK
      ISX           BUMP FORM INDEX, SKIP IF 1ST TIME 
      ISY           BUMP TO INDEX IF NOT 1ST TIME 
      RAL,CLE,ERA   CLEAR BIT 15 FOR LOCAL CB LENGTH
      SAY Q,I       STORE CB LOCAL LENGTH INTO THE STACK
      ISY           BUMP TO INDEX 
      JMP DFIN1     AND CONTINUE
* 
DFIN2 CYA           FIND NEW S VALUE
      ADA Q         A=NEW S VALUE 
      STA STKPT,I   SAVE NEW S INTO THE STACK 
      STA S         REINIT S REGISTER 
* 
      LDY QCBLA     SET Y TO RECALL 
      LAY Q,I       CB0 LOCAL LENGTH
      SZA,RSS       IS TRUE CB DEFINED IN THIS TM-SUBROUTINE ?
      JMP DFIN3     NO, NO TRUE COMMON IN THIS TM-SUBROUTINE
      LDB LEN00     YES, IS TRUE COMMON 
      SZB,RSS       ALREADY DEFINED ? 
      STA LEN00     NO, INIT LEN0 
      CPA LEN00     YES, IT MUST HAVE THE 
      RSS           THE SAME LENGTH THAT THE FIRST ONE
.ER04 JSB ERRAB     NO, ERROR  ---> ABORT TMS 
      LDA Q,I       SET CB0 DEFINED FLAG
      IOR BIT15     BY MERGING BIT15 WITH THE 
      STA Q,I       TMS SUBROUTINE # IN THE STACK 
* 
DFIN3 LDA .PAR2     RECALL CB1 LOCAL ADDR 
      SAY Q,I       AND SAVE IT INTO THE STACK
* 
      LDA STKPT 
      INA           NOW ENABLE AUTOMATICALLY
      STA PT        ALL PREVIOUSLY ALLOCATED CB 
* 
DFIN5 LAX PT,I      GET ACTUAL CB ADDR
      SZA,RSS       ALLOCATED ? 
      JMP DFIN6     NO
      CXB           YES, PASSES CB# TO ENABLE IT
      JSB COM.E     MEMORY IS ALREADY ALLOCATED, SET ENABLE BIT ONLY
      HLT 45B       MEMORY SUSPEND RETURN !!
DFIN6 DSX           MORE COMMON BLOCK 
      JMP DFIN5     YES, CONTINUE 
* 
      ISZ PT
      LDA PT,I      IS FIRST COMMON BLOCK 
      SZA           CURRENTLY ALLOCATED ? 
      JMP EXIT4     YES, EXIT 
  SPC 1 
      LDB DFNCD     NO, ALLOCATE CB # 1 
      STB SCODE     SET SPECIAL OP-CODE FOR MEM. SUSP.
DFN10 LDA STKPT 
      ADA T1OFS 
      DLD A,I       RECALL PARAM SAVED IN THE STACK 
      DST TEMP1     (X REG. & LOCKID) 
      CLB,INB       ENABLE THE FIRST COMMON BLOCK 
      JSB COM.E     ALLOCATE MEMORY 
      JMP MSU10     MEMORY SUSPEND RETURN, SUSPEND THE PROCESS
      SZA,RSS       ALLOCATED DONE ?
.ER03 JSB ERRAB     NO CB1 IN THE 1ST TMSUB. OF A PROCESS 
      STA TEMP      YES, SAVE CB1(1) ADDR.
      LDX TEMP1     SET UP X REGISTER WITH LU # INDEX 
      LBX .TMLU,I   GET LU
      STB A,I       AND SAVE IT IN 1ST WORD OF THE CB#1 
      INA 
      LDB =B2000    READ-WRITE CONTROL BITS 
      STB A,I       READ CTL=400B, WRITE CTL=0B 
      INA 
      LBX .TMTP,I 
      STB A,I       SET DEVICE TYPE 
      LDB CCBLP,I   RECALL CB1 LENGTH 
      ADB =D-3      TREE FIRST WORDS ARE ALREADY SET UP 
      SSB           CB1 LENGTH < 3
      JMP .ER03     YES, ERROR
      SZB,RSS 
      JMP .ER03 
      CBX           USE X REG AS A COUNTER
      CLB           INIT THE CB1 TO 0 
DFN12 SBX A,I 
      DSX 
      JMP DFN12 
* 
      LDB IMAGE,I   RECALL THE NUMBER OF DB DEFINED 
      SZB,RSS       ANY DB DEFINED ?
      JMP DFN11     NO, SKIP INIT CB1 FOR IMAGE 
      LDA TEMP2     RECALL PREVIOUS VALUE OF LOCKID 
      ALF,RAR       AND ISOLATE DB# 
      AND D7
      SZA,RSS       DBOPEN TO THAT PROCESS ?
      JMP DFN11     NO, SKIP INIT CB1 FOR IMAGE 
      LDB CCBLP,I   YES, RECALL CURRENT CB LENGTH 
      ADB DM23      IS CB1 BIG ENOUGH TO HANDLE 
      SSB           TMS-IMAGE CALL ?
      JMP DFN11     NO, SKIP INIT CB1 FOR IMAGE 
      JSB ICB1I     YES, INIT CB1 FOR IMAGE 
      ADA DM5 
      LDA A,I 
      INB 
      STA B,I 
      ADB DM1 
      LDA TEMP2     AND PASSES LOCKID WORD
      STA B,I 
* 
DFN11 LDA DFNS#     RESET THE SUBROUTINE CODE 
      STA SCODE 
      JMP EXIT4 
   SPC 1
DFNCD DEC 22
QCBLA DEC 2         # OF WORDS FROM Q --> CB1 LOCAL ADDR
LEN00 DEC 0         INITIAL TRUE COMMON BLOCK LENGTH
PT    NOP 
   HED TMS PAUSE PROCESS
PAUS  JSB STIME     SAVE CURRENT TIME.
      LDA STKPT 
      ADA T1OFS 
      STA TEMP      ROOM TO STORE FUTURE TIME VALUE 
      ADA D2
      STA TEMP3     LINK ADDR 
      LDA .PAR1     GET TIME OF THE PAUSE 
      SSA 
.ER18 JSB ERRAB     MUST BE POSITIVE
      SZA,RSS 
      JMP EXITZ     ALLOWS OTHERS PROCESS TO RUN
      CLB 
      DST X 
      DLD TTIME 
      JSB DADD      ADD TO CURRENT ONE
      DST TEMP,I    AND SAVE FINAL TIME IN STACK
      JSB DCMX      COMPLEMENTE IT
      DST X         AND SAVE IT 
* 
      LDB .PAUZ     GET PAUSE QUEUE HEAD
      RSS 
PAUS3 LDB TEMP2 
      LDA B,I 
      SZA,RSS       END OF QUEUE ?
      JMP PAUS4     YES, ADD NEW ENTRY HERE 
      STB TEMP4 
      STA TEMP2 
      ADA DM2       TO GET TIME IN THIS STACK 
      DLD A,I       GET TIME IN STACK 
      JSB DADD      COMPARE THE TWO TIME
      SSB           COMPARE ? 
      JMP PAUS3     STACK IN QUEUE < NEW STACK --> LOOP 
      SZB 
      HLT 50B 
      LDB TEMP4     S.I.Q > N.S  ---> QUEUE NEW STACK HERE
      LDA B,I       GET NEXT LINK 
PAUS4 STA TEMP3,I   SET IN NEW STACK
      LDA TEMP3     AND SET NEW STACK 
      STA B,I       IN THE QUEUE
      LDA .PAR1 
      CPB .PAUZ     DID WE CHANGE THE QUEUE HEAD ?
      JMP PAUS8     YES, MUST REQUEST ANOTHER TIME
      JMP IDLEZ     NO, DO NOT CHANGE TIME REQUESTD TO TIMER
  SPC 2 
PAUS0 JSB RELBU     TIMER IS BACK HERE, RELEASE THE BUFFER
PAUS5 LDA .PAUZ,I   AND PROCESS THE PAUSE QUEUE 
      SZA,RSS 
      JMP IDLEZ     (HLT)  ?????????????????????????????????????????? 
      LDB A,I       GET NEXT LINK 
      STB .PAUZ,I 
      ADA T3MOF 
      STA STKPT     RE-INIT STACK POINTER 
      LDA PAUCD     RE-INIT PAUSE SUBROUTINE CODE 
      STA SCODE 
      SZB,RSS       PAUSE QUEUE EMPTY ? 
      JMP EXIT4     YES, RETURN TO TMS LIBRARY NOW
      JSB WRI/O     NO, RE-QUEUE A GOOD BUFFER
      JSB STIME     AND RESTART THE TIMER FOR THE QUEUE HEAD
      LDB .PAUZ,I   GET THE FIRST ONE IN
      ADB DM2       THE QUEUE TO SCHEDULE 
      DLD B,I       GET FINAL TIME
      JSB DADD      FINAL TIME - CURRENT TIME 
      SSB 
      JMP PAUS5     TOO LATE, PROCESS IT IMMETIALLY 
      SZB 
      HLT 52B 
PAUS8 CMA,INA       INDICATE ABSOLUTE OFFSET
      SSA,RSS 
      JMP PAUS5     TOO LATE, PROCESS IT IMMEDIATELY
      STA STIME 
* 
      JSB EXEC      PUT "TMST" IN THE TIME LIST 
      DEF *+6 
      DEF D12       TIMED EXECUTION (INITIAL OFFSET)
      DEF .TMST,I   PROGRAM NAME
      DEF D1        RESOLUTION CODE ( 1/100 SEC)
      DEF D0        EXECUTION MULT. (ONLY ONCE) 
      DEF STIME     INITIAL TIME OFFSET 
      JMP IDLEZ     GOTO IDLE LOOP
* 
  SPC 1 
STIME NOP 
      LDB .TIME 
      XLA B,I       GET CURRENT TIME FROM THE SYSTEM MAP
      INB 
      XLB B,I 
      DST TTIME 
      JSB DCMX
      DST X 
      JMP STIME,I 
* 
.TIME DEF $TIME+0 
TTIME BSS 2 
  SPC 2 
DADD  NOP           A,B  PLUS  X,X+1
      CLE 
      ADA X         ADD LEAST SIGNIFICANT BITS
      CLO 
      SEZ,CLE 
      INB           PROPAGATE CARRY OUT 
      ADB X+1       ADD MOST SIGNIFICANT BITS 
      SOC           OVERFLOW ?
      HLT 53B 
      JMP DADD,I
  SPC 1 
DCMX  NOP           TWO'COMPLEMENT OF  A,B
      CMA           ONE' COMPLEMEMT 
      CMB 
      DST X 
      CLA,INA       AND THEN ADD ONE. 
      CLB 
      JSB DADD
      JMP DCMX,I
X     BSS 2 
   SPC 2
.PAUZ DEF *+1       PAUSE QUEUE HEAD
      OCT 0 
  SPC 1 
  HED TMS SUB-PROCESS LAUNCHING PROCESS 
ISPRL LDB LUXXX,I 
      SZB,RSS 
      LDB LU        NO, GET CONSOLE LU
      STB .PAR1 
      LDB ..PA2 
      LDA PNXXX     INITIAL PROCESS NAME ADDR 
      MVW D3
      JMP SPR01 
  SPC 2 
SPR00 JSB RELBU     PROCESS LAUNCH FROM 'TMSL', RELEASE BUFFER
      LDA .BUF      AND GET PARAMETERS PASSE BY 
      LDB ..PA1     'TMSL' TO MOVE THEM 
      MVW D4        INTO THE RIGTH BUFFER 
SPR01 CLA,CCE 
      STA .PAR5     NO CB ARE PASSED TO THE PROCESS 
      STA .PAR5+1 
      STA .PAR5+2 
      STA .PAR5+3 
      STA STKPT     NO STACK EXIST RIGHT NOW
      LDA .PAR2     SET THE NO ABORT BIT IN 
      RAL,ERA       THE TM-SUBROUTINE NAME
      STA .PAR2 
  SPC 1 
SPRL  CCA           SET SUBPRO-QUEUE FLAG TO 'QUEUE UP' 
      STA SPRQF 
      LDA .PAR1     RECALL LU  (BIT15 --> DO NOT QUEUE SUBPRO.) 
      RAL,CLE,SLA,ERA    CLEAR BIT15 AND
      STA SPRQF     SET SUBPRO-QUEUE FLAG TO 'DO NOT QUEUE' 
      STA SPRLU     SAVE LU 
      LDB ..PA2     RECALL TMSUB NAME/# ADDR
      JSB GTSU#     RECALL TMSUB # IN A REG. & .PAR2
      CMA,INA,RSS   ILLEGAL NAME OR # RETURN
      CLA           RETURN OK 
      CLB           CLEAR THE TLOG
      JSB SETST     SET STATUS ACCORDING TO GTSU# SUB.
      SZA           WAS IT OK ? 
      JMP SPR13     NO, FORGET THE LAUNCH 
      LDB .TMLU 
      ADB DM2 
      DLD B,I 
      CMA,INA 
      ADA B         B IS MINUS # OF AUXILIARY DEVICES 
      INB 
      CBX           X TO GET FIRST AUXILIARY DEVICE 
SPR12 LBX .TMLU,I   GET ONE LU
      CPB SPRLU     IS IT THIS ONE ?
      JMP SPR14     YES,
      ISX           NO, GET NEXT ONE
      INA,SZA       MORE LU ? 
      JMP SPR12     YES, CONTINUE 
SPR13 LDA STKPT     NO, FORGET THE LAUNCH 
      SZA           IF LAUNCH FROM AN OTHER PROCESS 
      JSB WRI/O     RESTART THE CALLING PROCESS 
      JMP STAR8     RETURN TO IDLE LOOP 
   SPC 5
*          THE LU IS FOUND, 
*            DUPLICATE CB'S TO BE PASSED TO THE SON PROCESS 
*            IF LU IS FREE THEN START THE PROCESS,
*            ELSE QUEUE IT ACCORDING TO THE QUEUE REQUEST FLAG. 
* 
SPR14 CLA           INIT LOCK ID WORD TO 0
      STA .PAR5+4 
* 
      LDA STKPT     PROCESS LAUNCH FROM 
      STA SPRLU     SAVE STACK POINTER TEMPORARILY
      SZA,RSS       OUTSIDE ? 
      JMP SPR50     YES, SKIP THE FOLLOWING 
   SPC 2
*                   DUPLICATE CB'S AND PASSES LOCKID
* 
      STX SPRTX     SAVE X REG
      LDA ..PA5     NO, SET UP TO GET PARAMETERS
      JSB MEMOK     RESOLVE MEMORY SUSPEND PROBLEM. 
* 
      JSB .MGTG     ALLOCATE A BUFFER TEMPORARILY 
SPR38 DEC 0         AS INTERMEDIATE STORAGE FOR CB
      JMP .ER13     TO DUPLICATE THEM.
      JMP MSU05     ---> GOTO MEM SUSP. 
      DST SPR47     SAVE ADDR. AND LENGTH 
  SPC 1 
      JSB WRI/O     RESTART CALLING PROCESS 
  SPC 1 
      LDA ..PA5 
      STA TEMP1     SET UP POINTER TO LOCAL CB'S ADDR.
      LDA Q 
      STA TEMP2     SAVE Q VALUE
      LDX SPRTX     RECALL X REG TO 
      LAX .STKT,I   GET THE STACK POINTER OF THE
      ADA S0        FUTURE STACK IN ORDER TO
      INA           CALCULATE THE FIRST Q VALUE 
      STA TEMP4     THAT WILL BE WHEN THE CB IS ENABLED 
* 
SPR42 LDA TEMP1,I   GET LOCAL CB ADDR FROM
      SZA,RSS       THE CALLING SEQUENCE, CB HERE ? 
      JMP SPR45     NO, IT IS THE END OF LIST 
      CLB           YES, CLEAR LOCAL ADDR. IN CALLING SEQUENCE
      STB TEMP1,I   SINCE IT WILL BE REPLACED BY LOGICAL ADDR.
      JSB GECB#     SET B = CB NUMBER 
      JSB COM.U     INIT A, B & Y AND MAP THE 1025 FIRST WORDS
      SZA,RSS       ALLOCATED ? 
      JMP SPR44     NO, GOTO NEXT ONE 
      SSB           YES, ENABLED ?
      JMP SPR44     NO, GOTO NEXT ONE 
      STB TEMP3     SAVE CURRENT CB LEN IN WORDS FOR MOVE 
* 
      LDA TEMP4     SET Q VALUE WITH WHAT IT WILL BE
      STA Q         WHEN THAT CB WILL BE ENABLED
      LDA TEMP1     A=ADDR WHERE CB SHOULD BE SAVED 
      JSB ALCB      ALLOCATE MEMORY FOR THAT CB 
      HLT 55B       SHOULD NOT HAPPENS, TESTED BY 'MEMOK' 
      LDA TEMP2     RESTORE THE VARIABLE Q
      STA Q 
* 
      LAY STKPT,I   RECALL ORIGINAL CB LOGICAL ADDR 
      LDB TEMP3     AND LENGTH TO 
      JSB MAPCB     MAKE SURE THE ENTIRE CB IS MAPPED 
      LDB SPR47     TO MOVE IT INTO THE INTERMEDIATE
      MVW TEMP3     BUFFER
* 
      LDA TEMP1,I   RECALL LOGICAL ADDR AND LENGTH
      LDB TEMP3     OF NEW CB TO MAKE SURE
      JSB MAPCB     THAT THE ENTIRE CB IS MAPPED
      LDB A         SET DESTINATION ADDR
      LDA SPR47     GET SOURCE ADDR AND 
      MVW TEMP3     MOVE FROM INTERMEDIATE TO THE NEW ONE 
SPR44 ISZ TEMP1     BUMP POINTER INTO CALLING SEQUENCE
      JMP SPR42     AND LOOP UNTIL END OF LIST
* 
SPR45 JSB .MGTR     RELEASE TEMPORARY BUFFER
SPR47 BSS 2 
* 
      LDB IMAGE,I   RECALL NUMBER OF DATA BASES 
      SZB,RSS       IMAGE USED ?
      JMP SPR49     NO
      CLB,INB       YES, GET PREVIOUS LOCK ID WORD FROM CB1 
      JSB COM.U     SET A,B,Y & TEMP, MAP THE FIRST 1025 WORDS
      SZA,RSS       ALLOCATED ? 
      JMP SPR49     NO, FORGET IT 
      LDB A         B = ACTUAL ADDR 
      ADB DM1 
      LDB B,I       B = ACTUAL SIZE 
      ADB DM23      ACTUAL SIZE - 23
      SSB           ACTUAL SIZE > 22
      JMP SPR49     NO, FORGET IT 
      ADA D11       YES, SET A TO CB1(12) 
      LDA A,I       GET LOCK ID WORD
      STA .PAR5+4   PASSES IT TO THE SON PROCESS
* 
SPR49 LDX SPRTX     RESTORE X REG 
   SPC 2
*                   START THE SON PROCESS, OR QUEUE THE REQUEST 
*                     IF LU IS BUSY OR LOCKED.
  SPC 1 
SPR50 LBX .STKT,I   GET STACK POINTER 
      LDA B,I 
      SSA,RSS       IS THIS LU FREE ? 
      JMP SPR70     NO, GO TO QUEUE THIS REQUEST
      JSB INSTK     YES, INITIALIZE STACK 
      LAX .TMLU,I   GET AUXILIARY LU
      STA TEMP,I    AND SAVE IT INTO THE STACK AT S+1 
      LDB STKPT     INIT B
      JSB LRQ       TRY TO LOCK LU
      JMP SPR85     LOCK WAS SUCCESSFULL, START SON PROCESS 
  SPC 1 
      LDA SPRQF     LOCK HAS FAILED, RECALL QUEUE FLAG
      SSA           QUEUED REQUEST ?
      JMP SPR56     YES, INSERT REQUEST INTO EXTER. EVENTS QUEUE
      LDA BIT15     NO, RETURN STATUS TO CALLING PROCESS AND
      STA STKPT,I   DO NOT START SON PROCESS. FREE STACK AGAIN
      LDA SPRLU     RESTORE STACK POINTER 
      STA STKPT 
SPR53 CCA           RETURN STAT.=-1 TO CALLING PROCESS, TO
      CLB           INDICATE THAT THE 'TMPRO' RQ IS NEITHER 
      JSB SETST     EXECUTED OR QUEUED. 
      LDA STKPT     PROCESS LAUNCH FROM 
      SZA,RSS       INSIDE ?
      JMP STAR8     NO, OK
* 
      LDA ..PA1     YES, MUST RELEASE ALL ALLOCATED CB
      ADA D3
      STA PT        SET UP POINTER TO CB LOGICAL ADDR 
      CLA 
      STA Q         TO RELEASE THE CB (CUR. Q > Q)
      STA .PAR5+4   NO CB HERE
      JSB RLCB      RELEASE THE MEMORY
      JMP STAR8     AND EXIT
  SPC 1 
SPR56 ADB T3OFS 
      LDA .EXTW,I   SET UP TO QUEUE ON THE
      STA B,I       EXTERNAL EVENT WAIT QUEUE 
      STB .EXTW,I 
      LDA .LRQX     SET SUBROUTINE ADR INTO THE STACK 
      STA S,I       AT S LOCATION 
      INB           UPDATE B AND QUEUE THE REQUEST
      JMP SPR72 
  SPC 2 
*          THE LU IS BUSY OR LOCK BY AN OTHER  RTE  PROGRAM 
*            QUEUE THIS REQUEST IN THE WAITING QUEUE OF 
*            THIS AUXILIARY LU. (REQUEST A 11 WORDS BLOCK TO
*            MMGT TO SAVE ALL INFORMATIONS) 
* 
SPR70 ADB T4OFS     UPDATE B TO GET HEAD OF WAITING QUEUE 
      LDA SPRQF     AUTOMATIC QUEUE FEATURE 
      SSA,RSS       REQUESTED ? 
      JMP SPR53     NO, RETURN STATUS TO CALLING PROCESS
SPR72 LDA B,I 
      SZA,RSS 
      JMP SPR75     END OF LIST 
      STA B         CONTINUE UNTIL END OF LIST
      JMP SPR72 
* 
SPR75 STB TEMP1     SAVE ADDR OF LAST ELEMENT IN
      JSB .MGTG     THE QUEUE 
      DEC 11
      HLT 56B 
      JMP SPR77     MEMORY SUSPEND RETURN !!
      STB A,I       SAVE ACTUAL BLOCK LENGTH
      INA 
      STA TEMP1,I   LINK THIS BLOCK IN THE LIST 
      CLB 
      STB 0,I       END OF LIST 
      INA 
      STX A,I       SAVE INDEX TO TMLU TABLE
      INA 
      LDB A         TO ADDR 
      LDA ..PA2 
      MVW D8        SAVE ADDR OF CB TO BE PASSED TO 
      JMP IDLE      THE SUB-PROCESS, RETURN 
  SPC 1 
SPR77 LDA STKPT     THIS PROCESS MUST HAVE BEEN 
      SZA           LAUNCHED FROM OUTSIDE, IS IT ?
      HLT 60B       NO  !!!!!!!!!!!!!!!!!!!!!!!!
      LDA =D18      SET UP SPECIAL
      STA SCODE     SUBROUTINE CODE 
      LDA D4        AND QUEUE UP AGAIN THIS EXTERNAL
      STA WRI/L     EVENT REQUEST IN THE EXTERNAL CLASS I/O 
      LDA DM4       DELAY THE REQUEUE FOR A MAXIMUM OF 1 SEC, 
      LDB .SPR7     BUT CHECK THE CLASS I/O QUEUE EVERY 250MS 
      JSB WAIT      SUSPEND FOR 250MS 
SPR78 JSB WRI/O     CLASS I/O QUEUE 
      CLA,INA       (THIS WILL LOAD THE SYSTEM A LOT
      STA WRI/L     BUT WHAT CAN WE DO ?) 
      JMP IDLE
* 
.SPR7 DEF *+1       ADDR OF SUB. EXECUTED EVERY 250MS 
      NOP 
      JSB NRCLS     RETREIVE THE NUMBER OF COMPLETED RQ 
      DEF *+2       PENDING ON THAT CLASS I/O 
      DEF CLASS     COMPLETION QUEUE. 
      SZA,RSS       NONE ?
      JMP .SPR7+1,I YES, WAIT LONGER
      JMP SPR78     NO, REQUEUE NOW TO GET OTHER RQ PENDING 
  SPC 2 
*          PREVIOUS PROCESS HAS COMPLETED,
*            START THE FIRST ONE OF THE WAITING QUEUE 
*            (USE THE 11 WORDS BLOCK AND REALESE THIS BLOCK)
   SPC 1
SPR80 JSB STIPR     START INTERAC. PROCESS (CLEARED WHEN DONE)
      LDA STKPT     END OF SUB-PROCESS
      ADA T4OFS     CHECK IF SOMETHING IS 
      LDB A,I       WAITING FOR THIS LU 
      SZB,RSS       WAITING QUEUE EMPTY ? 
      JMP SPR93     YES, UNLOCK LU AND SET IT INACTIVE
      STB TEMP1     SAVE ADD+1 OF THIS BLOCK
      LDB B,I       AND LINK THE NEXT ONE 
      STB A,I       IN PLACE OF THIS ONE. 
* 
      LDA TEMP1 
      INA           RESTORE INDEX IN TMLU TABLE 
      LDX A,I 
* 
      INA           RESTORE ALL PARAMETERS
      LDB ..PA2 
      MVW D8
* 
      LDA TEMP1     RETURN THIS BLOCK OF MEMORY 
      ADA DM1       TO MMGT 
      LDB A,I       GET ACTUAL LENGTH 
      DST SPR82 
      JSB .MGTR     RETURN MEMORY 
SPR82 BSS 2 
      LDB STKPT     RESTORE B REGISTER
      JSB INSTK     RE-INIT STACK 
   SPC 1
SPR85 LDA ..PA5     STORE LOGICAL CB ADDR INTO
      LDB STKPT     THE STACK 
      ADB D3
      MVW D4
      LDA .PAR2     RECALL T.U.S. NUMBER TO SIMULATE
      STA .PAR1     A 'TMSUB' CALL NOW. 
SPR88 LDA =D8 
      STA SCODE     SIMULATE TM SUB CALL
      JMP SBCAL 
  SPC 2 
*     PREVIOUS PROCESS HAS COMPLETED, 
*       AND NO REQUEST IS QUEUING FOR THAT LU 
*       SET THIS LU INACTIVE AND UNLOCK IT (RTE LU UNLOCK)
* 
   SPC 1
SPR93 LDB BIT15     SET LU INACTIVE 
      STB STKPT,I 
      ADA DM3       TO RECALL TEMP1 FROM STACK
      STA SPR95     TO UNLCK THE AUXILIARY LU 
      JSB LCKL?     LOCK THIS LU ?
      JMP IDLE      NO, FORGET IT 
      JSB LURQ      YES, PERFORM THE UNLOCK CALL
      DEF *+4 
      DEF O40K      UNLOCK LU 
SPR95 NOP           LU ADDR.
      DEF D1        UNLOCK ONLY ONE LU
      HLT 62B       ERROR RETURN
      SZA           UNLOCK OK ? 
      HLT 63B 
      JMP IDLE      AND RETURN TO IDLE LOOP 
  SPC 3 
INSTK NOP           INITIALIZE STACK ROUTINE
      STB STKPT 
      LDY T3OFS     CLEAR THE FIRST WORDS OF STACK
      CLA           UP TO TEMP4 (NOT INCLUDED)
INST3 SAY B,I 
      DSY 
      JMP INST3 
      DLD S0
      ADA STKPT     ABSOLUTE S VALUE
      ADB STKPT     ABSOLUTE Q VALUE
      DST S 
      DST STKPT,I   SET S & Q INITIAL VALUE 
      INA 
      STA TEMP      SAVE NEXT Q VALUE 
      LDA BIT14     SET BIT14 THAT INDICATE STACK FOR 
      STA B,I       AUXILIARY LU (SPECIAL RTN CD=0) 
      ADB DM1       SET STOP-INHIBITED FLAG TO NOT ZERO 
      STA B,I       (PROCESS CANNOT BE STOPPED) 
      ADB DM3 
      LDA .PAR5+4   SAVE LOCKID WORD INTO THE STACK AT
      STA B,I       TEMP2 TO INIT CB1(12) LATER.
      ADB DM1       SAVE X REG INTO THE STACK AT
      STX B,I       TEMP1 TO INIT CB1(1) & CB1(3) 
      JMP INSTK,I   TO ENABLE AND INIT CB1
  SPC 2 
.LRQX DEF *+1 
      NOP           SUBROUTINE ENTRY POINT
      JSB LRQ 
      RSS           OK, RESTART THE PROCESS 
      JMP .LRQX+1,I LOCK FAIL, RETURN 
      JSB DEXTW     DEQUEUE FROM EXTERNAL EVENT WAIT QUEUE
      JMP SPR80     AND RESTART THE PROCESS 
  SPC 1 
LRQ   NOP 
      LDA B,I       A = S REG.
      INA 
      STA LRQ3      SET LU ADDR.
      JSB LCKL?     LOCK THIS LU ?
      JMP LRQ,I     NO, FORGET IT 
      JSB LURQ      YES, PERFORM THE LU LOCK REQUEST
      DEF *+4 
      DEF IOPTN 
LRQ3  NOP           LU
      DEF D1        # OF LU 
      HLT 64B       ERROR RETURN
      SZA           LOCK DONE ? 
      ISZ LRQ       NO, RETURN  P+2 
      JMP LRQ,I     YES, RETRUN  P+1
  SPC 1 
LCKL? NOP           LOCK THIS LU ?
      LDA A,I       GET LU
      CPA D1        LU = 1 ?
      JMP LCK?3     YES, PERFORM THE LOCK RQ
      ADA DM4       IF LU = < 3 DO NOT LOCK IT
      SSA,RSS 
LCK?3 ISZ LCKL?     > 3, PERFORM THE LOCK RQ
      JMP LCKL?,I   = < 3, FORGET THE LOCK
  SPC 2 
..PA2 DEF .PAR2 
..PA5 DEF .PAR5 
BIT14 EQU O40K
SPRQF NOP           SON PROCESS QUEUE REQUEST FLAG
SPRLU NOP           SON PROCESS LU
SPRTX NOP 
  HED TMS SCHEDULE NON-TMS PROGRAM PROCESS
SCHPR LDA ..PA1 
      ADA D2        SKIP PROGRAM NAME 
      HLT 12B       !!!!!!!!!!!!! NOT IMPLEMENTED !!!!!!!!!!!!!!!!!!!!! 
      STA TEMP1     USE AS POINTER TO ACCESS USER PARAM 
* 
      CCA 
      STA SRFLG     SET SEND MAIL BOX FLAG
* 
      LDA ICLAS     SAVE TMS-INTERNAL CLASS WORD
      STA SCHPZ 
      CLA 
      STA ICLAS     INIT ICLAS TO ALLOCATE A CLASS WORD 
      STA RTRNA     INIT LENGTH OF 1ST CB SEND
* 
SCH02 ISZ TEMP1 
SCH03 LDA TEMP1,I   GET PARAM 
      SZA,RSS       END OF LIST ? 
      JMP SCH20     YES,
      JSB GECB#     NO, SET COMB# = CB NUMBER 
      JSB COM.U     AND INIT  A, B & Y
      SZA,RSS       ALLOCATED ? 
      JMP SCH02     NO, FORGET IT 
      SSB           YES, ENABLED ?
      JMP SCH02     NO, FORGET IT 
      DST SCH15     YES, SET MAILB PARAM
SCH05 ISZ TEMP1     GET LENGTH OF NEXT CB 
      LDA TEMP1,I 
      CLB 
      SZA,RSS       END OF LIST ? 
      JMP SCH07     YES, SEND THE CURRENT ONE 
      JSB GECB#     NO, TRY TO GET LENGTH 
      JSB COM.U 
      SZA,RSS       ALLOCATED ? 
      JMP SCH05     NO, FORGET IT 
      SSB           YES, ENABLED ?
      JMP SCH05     NO, FORGET IT 
SCH07 STB TEMP      YES, SAVE LENGTH OF NEXT CB 
      LDB SCH15+1   RECALL LENGTH OF CURRENT CB 
      LDA RTRNA     RTRNA ALREADY 
      SZA,RSS       INIATILIZED ? 
      STB RTRNA     NO, SET 1ST CB LEN SEND 
      LDA TEMP      RECALL NEXT CB LENGTH 
      JSB MAILB     AND SEND CURRENT CB 
SCH15 BSS 2 
      JMP SCH03     LOOP UNTIL END
  SPC 1 
SCH20 LDA .PAR1     RECALL FIRST WORD OF PRG NAME 
      SSA,RSS       REQUEST WITH WAIT ? 
      JMP SCH25     YES, DO IT WITH WAIT
      RAL,CLE,ERA   NO, CLEAR BIT 15
      STA .PAR1     TO RESTORE PROGRAM NAME 
      JSB WRI/O     QUEUE UP PROCESS IMMEDIATELY (NO WAIT)
SCH25 LDA ..PA1 
      JSB SCHUP     SCHEDULE NON-TMS USER PROGRAM 
.ER22 JSB ERRAB     ERROR RETURN !
* 
      LDA SCHPZ     RESTORE THE TMS-INTERNAL CLASS WORD 
      STA ICLAS 
      JMP IDLE      AND EXIT
* 
SCHPZ NOP 
   HED TMS ABORT / SOFT STOP PROCESS
*                   SET/RESET STOP-INHIBIT FLAG 
*                   =========================== 
* 
SIF   LDA .PAR1     GET USER REQUEST
      SZA           SET/RESET ? 
      JMP SIF05     DISALLOW STOP OF TMS
SIF03 LDB STKPT     ALLOW STOP AGAIN
      ADB NSOFS     SET THE STOP-INHIBIT FLAG 
      STA B,I       ON THE STACK
      JMP IDL41     RETURN STATUS OK AND EXIT 
* 
SIF05 LDB STPFL     RECALL STOP IN PROGRESS FLAG
      CCA 
      SZB,RSS       STOP IN PROGESS ? 
      JMP SIF03     NO, SET FLAG ON THE STACK AND EXIT
      JMP IDL42     YES, RETURN BAD STATUS TO THE USER
  SPC 1 
STPFL DEC 0         STOP IN PROGESS FLAG (NO 0=IN PROGRESS) 
   SPC 3
*                   STOP FROM 'TMSL'
*                   ================
* 
STPX  CLA           STOP TMS REQUEST FROM 'TMSL'
      STA STKPT     OUTPUT "TMS OPERATOR STOP ! " 
      JMP TMSP1 
  SPC 2 
STPY  CCA           "SOFT ABORT" TMSL 97
      STA STKPT 
      JMP TMSP1 
  SPC 2 
*                   STOP FROM A USER REQUEST USING 'TMSTP' CALL 
*                   =========================================== 
* 
TMSP  LDA .PAR1     GET STOP #
      STA STP#      AND SAVE IT 
      LDA STKPT     RESET THE STOP-INHIBIT FLAG FOR THIS
      ADA NSOFS     PROCESS 
      CLB 
      STB A,I 
* 
TMSP1 CCA           SET THE STOP IN PROGRESS FLAG 
      STA STPFL 
* 
      JSB RELBU     RELEASE THE BUFFER
      LDA =D25      SET THE NEW SUBROUTINE CODE 
      STA SCODE     FOR STOP IN PROCESS 
      JSB STIME     AND SAVE CURRENT TIME 
      DLD TTIME 
      DST STPTI 
      JMP EXITZ     AND QUEUE THAT STOP IN PROGRESS RQ
  SPC 2 
TMSPX CPB D3        TLOG = 3 ?
      JMP TSP90     YES, CHECK FOR ANSWER "YES" 
TSP10 LDX #LU       NO, CHECK STOP-INHIBIT FLAG OF ALL STACKS 
TMSP2 LAX .STKT,I   A=STACK POINTER 
* 
      LDB STKPT     GET STOP FLAG 
      SSB,RSS       "SOFT ABORT"? 
      JMP TSP11        NO, DON'T BOTHER TO CHECK STACK TYPE 
      ADA TYOFS        YES, CHECK STACK TYPE
      LDA A,I        GET TYPE 
      AND =B37777    KEEP LOWER 14 BITS 
      CPA D1         INTERACTIVE LU STACK?
      JMP TMSP6         YES, SKIP THIS STACK, GO ONTO NEXT
      LAX .STKT,I       NO, CHECK STACK FOR ACTIVITY
* 
TSP11 LDB A,I       GET S 
      SSB           STACK ACTIVE ?
      JMP TMSP3     NO, CHECK IF ANY THINGS IS WAITING
      ADA NSOFS     YES, ACCESS THE STOP-INHIBIT FLAG 
      LDA A,I       GET FLAG
      SZA           STOP ALLOWED ?
      JMP TSP40     NO, WAIT LONGER 
TMSP6 DSX           YES, CHECK NEXT STACK 
      JMP TMSP2     AND LOOP
  SPC 2 
      JSB OUTLF     YES, PERFORM THE TMS STOP REQUEST 
      JSB OUTLF 
      LDB STKPT 
      LDA .MS4
      SZB,RSS       STOP FROM 'TMSL' ?
      JMP TMAB8     YES, PRINT "TMS OPERATOR STOP !"
      LDA .MS5
      SSB           STOP 98?
      JMP TMAB8     YES, PRINT "TMS SCHEDULED STOP !" 
      LDA STP#      NO, FROM TMLIB, PRINT STOP #
      JMP TMAB4 
  SPC 1 
TMSP3 ADA T4OFS     TO ACCESS QUEUE HEAD OF THE WAITING LIST
      LDA A,I 
      SZA,RSS       WAITING BLOCK ? 
      JMP TMSP6     NO, CONTINUE
      HLT 13B       YES, ERROR !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
  SPC 2 
*                   TMS CANNOT BE STOPPED (STOP-INHIBIT FLAG AND/OR 
*                   SUBPROCESSES WAITING), CHECK IF TIME TO REPORT
*                   THAT, IF NOT WAIT LONGER. 
* 
TSP40 JSB STIME     GET THE CURRENT TIME
      DLD STPTI     RECALL FINAL TIME 
      JSB DADD      FINAL TIME - CURRENT TIME 
      SSB,RSS       FINAL TIME REACHED ?
      JMP IDL08     NO, WAIT LONGER TO REPORT ERROR 
      LDA D500      YES, SET THE NEXT FINAL TIME
      CLB 
      DST X 
      DLD TTIME 
      JSB DADD      ADD TO CURRENT TIME 
      DST STPTI     AND SAVE FINAL TIME 
* 
*                   REPORT TMS ACTIVITY NOW:
*                   (LU BUSY & SUBPROCESSES QUEUE UP) 
* 
      JSB OUTLF     SPACE TWO LINE
      JSB OUTLF 
      LDA .MSX      OUTPUT "STOP DELAYED DUE TO ACTIVE TERMINAL"
      JSB OUTM
* 
TMSP4 LAX .TMLU,I   THIS LU IS BUSY 
      JSB CASC
      STA .MSZ+3
      LDA .MSZ
      JSB OUTM
      LBX .STKT,I   NOW CHECK IF PROCESS ARE
      ADB T4OFS     WAITING FOR THIS LU 
      CCA           INIT # OF PRCESS WAITING
TSP42 LDB B,I       GO ON THE WAITING QUEUE 
      INA           INCREMENT THE COUNTER FOR WAITING PROCESS 
      SZB           END OF QUEUE ?
      JMP TSP42     NO, LOOP UNTIL END
* 
      SZA,RSS       PROCESS WAITING ? 
      JMP TSP70     NO, GO TO NEXT STACK
      JSB CASC      YES, REPORT THE NUMBER OF WAITING PROCESS 
      STA .MSY+3
      LDA .MSY
      JSB OUTM
TSP70 DSX           ANY MORE STACK ?
      RSS           YES, CHECK IF OK TO REPORT LU BUSY
      JMP TSP80     NO, ASK FOR ABORT NOW 
* 
      LAX .STKT,I   GET NEXT STACK POINTER
      LDB STKPT     GET TYPE OF STOP
      SSB,RSS       "SOFT ABORT"? 
      JMP TSP71        NO, DON'T CHECK FOR STACK TYPE 
      ADA TYOFS        YES, CHECK STACK TYPE
      LDA A,I       GET STACK TYPE
      AND =B37777   KEEP LOWEST 14 BITS 
      CPA D1        INTERACTIVE LU STACK? 
      JMP TSP70        YES, SKIP THIS STACK, CHECK NEXT 
      LAX .STKT,I      NO, CHECK IF STACK IS BUSY 
* 
TSP71 LDB A,I       B=S REG.
      SSB           STACK ACTIVE ?
      JMP TSP70     NO, GOTO NEXT STACK 
      ADA NSOFS     YES, GET THE STOP-INHIBIT FLAG
      LDA A,I 
      SZA           STOP ALLOWED ?
      JMP TMSP4     NO, REPORT LU BUSY
      JMP TSP70     YES, GOTO NEXT STACK
   SPC 1
*                   TMS ACTIVITY HAS BEEN REPORTED, ASK IF "OK TO ABORT ?"
* 
TSP80 LDA LU        SET TIME OUT ON THE TERMINAL
      IOR =B2200
      STA TEMP
      JSB EXEC
      DEF *+4 
      DEF D3        CONTROL RQ
      DEF TEMP      LU + 2200B
      DEF D500      TIME OUT IS 5 SEC.
* 
      JSB RELBU     RELEASE BUFFER QUEUED IN THE CLASS QUEUE
      LDA .MSW      OUTPUT
      JSB OUTM      "OK TO ABORT (YES/NO) _"
      LDA LU
      IOR =B400     MERGE ECHO BIT
      STA TEMP
      JSB EXEC      REQUEST THE ANSWER
      DEF *+8 
      DEF D17       CLASS READ
      DEF TEMP      LU + ECHO BIT, ASCII READ 
      DEF BUF       DUMMY BUFFER
      DEF DM4       MAX BUFFER LENGTH 
      DEF STKPT     1ST PARAM = STACK POINTER 
      DEF SCODE     2ND PARAM = SUBROUTINE CODE 
      DEF CLASS     CLASS WORD
      JMP IDLE
  SPC 1 
TSP90 LDA BUF       CHECK THE ANSWER
      CPA =AYE
      RSS           YES ? 
      JMP TSP10     NO, CHECK IF OK TO STOP 
      LDA BUF+1     NOW CHECK FOR "S" 
      AND =B177400
      CPA O514C     "S" 
      RSS           YES, ABORT TMS NOW
      JMP TSP10     NO, CHECK IF OK TO STOP 
      JSB OUTLF     SPACE ONE LINE
      JMP ABTX      AND ABORT TMS APPLICATION 
  SPC 1 
.MSZ  DEF *+1 
      ASC 11, LU XX IS BUSY 
.MSY  DEF *+1 
      ASC 11,    XX PROCESS WAITING 
.MSX  DEF *+1 
      ASC 11,STOP DELAYED BECAUSE:
.MSW  DEF *+1 
      ASC 11,OK TO ABORT(YES/NO) ?_ 
* 
STP#  NOP           SAVE THE STOP NUMBER
STPTI BSS 2 
O514C OCT 51400 
  SKP 
*                   ABORT FROM 'TMSL' 
*                   ================= 
* 
ABTX  LDA .MS3
      JMP TMAB8     REPORT "TMS OPERATOR ABORT ! "
  SPC 2 
*                   TMS ABORT REQUEST BY A USER CALL 'TMSAB'
*                   ========================================
* 
TMAB  EQU *         ABORT THE TM SOFTWARE 
      LDA .MS37     SET UP TO ABORT MESSAGE 
      LDB .MS12 
      MVW D3
      LDA .PAR1     GET STOP #
TMAB4 CCE           DECIMAL CONVERSION
      JSB $CVTX 
      INA 
      LDB .MS15 
      MVW D2
      JSB GPNAD     GET TM-SUBROUTINE NAME ADDR 
      LDB .MS18     AND MOVE IT IN MESSAGE
      MVW D3
      LDA .MS1
TMAB8 JSB OUTM      OUTPUT "TMS ABORT XXXX  TMSUBX" 
      JMP ABT00     CLEAN UP AND EXIT.
   SPC 3
GPNAD NOP           RETREIVE T.U.S. NAME
      LDA STKPT     RECALL STACK POINTER
      SZA,RSS       STACK DEFINED ? 
      JMP GPNA3     NO, LEAVE  "TMSYS"
      INA 
      LDA A,I       GET Q REG VALUE 
      LDA A,I       GET TUS# OR SPECAIL THINGS WITH BIT14 
      CLE           CLEAR BIT 15 & 14 
      ELA,CLE,ELA   AND MOVE BIT14 INTO E 
      RAR,RAR 
      SEZ           SPECIAL CASE ?
      JMP GPNA5     YES, NO TUS # DEFINED 
      ADA DM1       NO, THIS IS THE TUS#, GET NAME FORM 
      MPY D5        THE TMS TABLE.
      ADA .TMSB 
      INA,RSS 
GPNA2 LDA PNX00 
      JMP GPNAD,I 
GPNA3 LDA .MS04     LEAVE "TMSYS .."
      JMP GPNAD,I 
GPNA5 CPA D1        INTERACTIVE PROCESS ? 
      JMP GPNA2     YES, GET STARTING PROCESS NAME
      JMP GPNA3     NO, LEAVE "TMSYS" 
   SPC 2
MS0   ASC 16,TMS 00  TMSUB  @123456  -
MS1   ASC 11,TMS STOP  3456  TMSUB
MS3   ASC 11,TMS  OPERATOR ABORT !
MS4   ASC 11,TMS  OPERATOR STOP ! 
MS5   ASC 11,TMS SCHEDULED STOP ! 
.MS1  DEF MS1 
.MS3  DEF MS3 
.MS4  DEF MS4 
.MS5  DEF MS5 
.MS12 DEF MS1+2 
.MS15 DEF MS1+5 
.MS18 DEF MS1+8 
.MS37 DEF MS3+7 
ERR.  ASC 2,ERR 
ASC@  ASC 1, @
.M013 DEF MS0+13
   HED TERMINAL-MONITOR ERROR CONDITION PROCESS 
.ERR  DEC 35        TOTAL NUMBER OF ERRORS
      NOP            1 INTERAC. LU'S DOWN OR LOCKED 
      DEF .ER02+1    2 NOT ENOUGH MEM FOR STACK ALLOCATION
      DEF .ER03+1    3 NO OR BAD CB1 IN 1ST TUS OF A PROCESS
      DEF .ER04+1    4 TRUE COMMON HAS NOT THE SAME LENGTH
      DEF .ER05+1    5 ENABLE CB WITH LENGTH = 0
      DEF .ER06+1    6 ENABLE CB FOR THE 2ND TIME 
      DEF .ER07+1    7 'RETURN' IN AN INTERAC. PROCESS
      DEF .ER08+1    8 CB DEFINTION ERROR 
      DEF .ER09+1    9 'TMDFN' HAS LESS THAN 3 PARAMETERS 
      DEF .ER10+1   10 T.U.S. NAME NOT FOUND
      DEF .ER11+1   11 ILLEGAL T.U.S. NUMBER
      DEF .ER12+1   12 STACK OVERFLOW ('TMSUB' CALL) --> ABT
      DEF .ER13+1   13 CB LENGTH > EVER AVAILABLE MEMORY
      DEF .ER14+1   14 2ND 'TMDFN' IN A T.U.S.   --> ABT
      DEF .ER15+1   15 BAD CB IN 'TMCBE/D' (LEN=0 OR 1ST CB)
      DEF .ER16+1   16 DISABLE A NO-ALLOCATED CB
      DEF .ER17+1   17 DISABLE A NO-ENABLE CB 
      DEF .ER18+1   18 TIME IN 'TMPZ' REQUEST IS NOT LEGAL
      NOP           19
      DEF .ER20+1   20 NEW CB LEN IN 'TMCBL' IS NOT LEGAL 
.IMER DEF .ER21+1   21 RESERVED FOR IMAGE ERROR 
      DEF .ER22+1   22 SCHEDULE A NON-TMS PRG NOT LOADED
      NOP           23 INTERNAL TMS ERROR (LOGIQUE/TABLE) 
      NOP (TMLIB#4) 24 TMS USER CALL HAS MORE THAN 9 PARAM. 
      NOP (TMLIB#5) 25 'TMDFN' NOT 1ST CALL IN A T.U.S. 
      NOP (TMLIB#6) 26 CB1 DISABLE DURING AN I/O CALL 
      NOP (TMLIB#7) 27 CB1 DISABLE/TOO SMALL FOR 'TBXXX' CALL 
      NOP (TMLIB#8) 28 CB1(1) OR CB1[6:13] HAS BEEN MODIFIED
      NOP           29
      NOP           30
      NOP           31
      NOP           32
      NOP           33
      NOP           34
      NOP           35 RESERVED FOR LOGGING ERROR 
  SPC 1 
IMERC ABS .IMER-.ERR
  SPC 3 
ERRAB NOP           ERROR PROCESS FOR FATALS ERRORS 
      CCA 
      STA NOABT     SET ABORT FLAG
      LDA ERRAB 
      STA ERROR 
      JMP ERROR+1 
  SPC 1 
ERROR NOP 
      LDX .ERR
ERR02 LAX .ERR
      CPA ERROR     IS IT THIS ERROR ?
      JMP ERR03 
      DSX           END OF TABLE ?
      JMP ERR02     NO, CONTINUE
      HLT 65B       YES, ERROR IN ERROR !!! ????????????
  SPC 1 
ERR03 CXA 
      STA ERR#      SAVE ERROR #
      LDB NOABT     CHECK TO ABORT
      SSB,RSS       ABORT ALLOWED ? 
      JMP ERROR,I   NO ABORT !  RETURN TO CALLER
ERR   JSB ERRPR     PRINT ERROR MESSAGE 
      JMP ABT00     CLEAN UP AND EXIT.
  SPC 2 
ERRPR NOP           FORMAT AND PRINT ERROR MESSAGES 
      LDA ERR#
      JSB CASC      CONVERT IT INTO ASCII 
      STA MS0+2 
      LDA ERR#      RECALL ERROR NUMBER 
      CPA IMERC     IS IT AN IMAGE ERROR ?
      RSS           YES 
      JMP ERR04     NO, CONTINUE
* 
      LDA BUF+1     RECALL TMS-IMAGE SUBROUTINE CODE
      MPY D3
      ADA .IMGT     INDEX IN IMAGE NAME TABLE 
      LDB .MS04     AND MOVE TMS-IMAGE SUBROUTINE 
      MVW D3        NAME INTO OUTPUT BUFFER 
      LDA BUF       RECALL IMAGE STATUS 
      CCE           DECIMAL CONVERSION
      JMP ERR05 
  SPC 1 
ERR04 JSB GPNAD 
      LDB .MS04 
      MVW D3
      INA 
      LDA A,I       GET EPAOS 
      CMA,INA 
      SZA           IS IT DEFINED ? 
      ADA XSUSP     YES, COMPUTE RELATIVE ADDR IN THE TM-SUBROUTINE 
      CLE           IN ABORT MESSAGE (OCTAL VALUE)
ERR05 JSB $CVTX 
* 
      LDB .MS08 
      MVW D3
      ADB =D-3
      CLE,ELB 
ERR07 LBT 
      CPA O40 
      RSS 
      JMP ERR08 
      IOR =B20
      ADB DM1 
      SBT 
      JMP ERR07 
ERR08 LDA ASC@
      STA MS0+7 
      LDA ERR#      RECALL ERROR NUMBER 
      CPA IMERC     IS IT AN IMAGE ERROR ?
      RSS           YES 
      JMP ERR09     NO, CONTINUE
      DLD ERR.
      DST MS0+7     SET "ERR " INTO OUTPUT BUFFER 
      JSB DBNAD     RETEIVE THE DB NAME ADDR FROM THE DB# 
      LDB .M013 
      MVW D3
      LDA .MS0      ERROR MESSAGE ADDR. 
      LDB =D32      ERROR MESSAGE LENGTH IN BYTES 
      JSB OUTM0     OUTPUT ERROR MESSAGE
      JMP ERRPR,I 
ERR09 LDA .MS0
      JSB OUTM      OUTPUT "TMS XX  TMSUB @123456"
      JMP ERRPR,I 
  SPC 1 
CASC  NOP           CONVERT INTO ASC
      CLB 
      DIV D10 
      SZA,RSS 
      LDA =B360     TO HAVE LEADING SPACE INSTEAD OF ZERO 
      ALF,ALF 
      ADA B 
      ADA =A00
      JMP CASC,I
  SPC 1 
OUTM  NOP 
      LDB D22       MESSAGE LENGTH IN BYTES 
      JSB OUTM0 
      JMP OUTM,I
  SPC 1 
OUTM0 NOP 
      CLE,ELA       --> BYTE POINTER
      STB CASC
      LDB @MSBX     BYTE DESTINATION ADDR 
      MBT CASC      MOVE MESSAGE
      CMB,INB 
      ADB @MSBU 
      STB CASC
      JSB EXEC
      DEF *+5 
      DEF D2
      DEF LU
      DEF MSBU
      DEF CASC
      JMP OUTM0,I 
* 
@MSBX NOP 
  SPC 1 
OUTLF NOP 
      JSB EXEC      OUTPUT ONE SPACE
      DEF *+5 
      DEF D2
      DEF LU
      DEF MS0+3 
      DEF DM1       ONLY ONE BYTE 
      JMP OUTLF,I 
  SPC 2 
LULAB LDA .LUMS 
      JSB OUTM
      JMP ABT3
* 
.LUMS DEF *+1 
      ASC 11,TMS 01  DOWN OR LOCKED 
  SPC 2 
LOGER NOP           ERROR DUE TO LOGGING DEVICE 
      STB BUF+1     SAVE SUBROUTINE CODE, ERROR CODE IN A 
LOGE2 CCE           SET DECIMAL FLAG
      JSB $CVTX     CONVERT ERROR CODE TO ASCII 
      LDB .LGM1 
      MVW D3
      LDA .LGMS 
      LDB D24 
      JSB OUTM0     AND PRINT OUT "TMS 35  DCLOG ERR XXXX"
* 
      LDA BUF+1     RECALL OPERATION CODE 
      SZA,RSS       INITIALIZE DCLOG? 
      JMP ABT3         YES, DIE NOW 
      CPA D1        TERMINATE DCLOG?
      JMP LOGER,I      YES, RETURN
      CLB           RETURN FROM LOG OPERATION, ZERO OUT LOG DEVICE
      STB LOGXX,I   TO PREVENT DCLOG TERMINATION  (IT IS ALREADY DEAD)
      JMP ABT00     THEN, ABORT APPLICATION 
* 
* 
.LGMS DEF *+1 
      ASC 9,TMS 35  DCLOG ERR 
LGME1 BSS 3 
ASC01 ASC 1,01
* 
.LGM1 DEF LGME1 
  SPC 2 
ERR#  NOP 
* 
.MS0  DEF MS0 
.MS04 DEF MS0+4 
.MS08 DEF MS0+8 
  SPC 1 
.IMGT DEF *+1 
      ASC 12,DBOPN DBCLS TBGET TBFND
      ASC 12,TBPUT TBUPD TBDEL TBINF
      ASC 3,TBULK 
  SPC 2 
TMLER LDA .PAR1     RECALL ERROR #
      ADA =D20      SET IT TO ACTUAL TMS ERROR #
      STA ERR#
      JMP ERR       GOTO ERROR PROCESSING 
   HED TERMINAL-MONITOR ABORT PROCESSING
ABT00 CLA,INA       SET SCHEDULE FLAG "WITH WAIT" 
      STA SCHFL 
  SPC 2 
      LDA IMAGE,I   RECALL TMS-IMAGE-MODULE PROGRAM NAME
      SZA,RSS       IMAGE USED ?
      JMP ABT50     NO, SKIP IMAGE THINGS 
* 
      LDA IMERC     IMAGE IS USED, SET THE IMAGE ERROR
      STA ERR#      JUST IN CASE
      CLA,INA       INIT INDEX INTO BUF 
      STA ABT21     TO,KEEP TRACK OF THE LOCKID RELEASED. 
* 
      LDA ABT.1     SET UP ADDR. ROUTINE TO UNLOCK
      STA .IMU2     ALL RECORDS OWN BY THIS TMS 
      LDA ABT.4     APPLICATION.
      STA .IMU4 
      JMP IMULK     GO RETREIVE ALL LOCKID'S USED 
  SPC 1 
ABT.1 DEF *+1 
ABT10 NOP 
      STA ABT22     SAVE A REGISTER 
      STX ABT23     SAVE X REGISTER 
      LDA B,I       GET THE LOCKID WORD 
      STA TEMP      AND SAVE IT 
      AND PIDMK     ISOLATE PID (CLEAR DB#) 
      SZA,RSS       LOCKID WORD HERE ?
      JMP ABT17     NO, CONTINUE
      LDY ABT21     YES, SET UP Y INDEX REG.
ABT13 DSY           END OF BUFFER ? 
      RSS           NO, CHECK IF THE LOCKID IS ALREADY IN BUF 
      JMP ABT15     YES, THIS IS A NEW LOCKID, DO THE UNLOCK
      LBY BUF+1     RECALL LOCKID ALREADY RELEASED
      CPB TEMP      IS IT THE SAME ?
      JMP ABT17     YES, ALREADY RELEASED, FORGET IT
      JMP ABT13     NO, CONTINUE UP TO THE END OF BUF 
* 
ABT15 ISZ ABT21     BUMP  BUF INDEX 
      LDA ABT21     AND ADD THIS NEW LOCKID 
      CPA =D47      BUF OVERFLOW ?
      JMP ABT.4,I   YES, FORGET ALL THE UNLOCK
      ADA .BUF      NO, SAVE THE NEW LOCKID 
      LDB TEMP      INTO BUF AND
      STB A,I 
      JSB IMULO     RELEASE THIS LOCKID 
      JMP ABT17     RETURN OK 
      DST BUF       ERROR RETURN, SET UP ERROR CODES
      JSB ERRPR     PRINT THE ERROR MESSAGE 
ABT17 LDA ABT22     RESTORE A REG.
      LDX ABT23     RESTORE X REG.
      JMP ABT10,I   AND SEARCH THE NEXT LOCKID USED 
* 
ABT21 NOP 
ABT22 NOP 
ABT23 NOP 
PIDMK OCT 17777 
  SPC 1 
ABT.4 DEF *+1 
      CLB,INB       CLOSE ALL DATA-BASES OPEN 
ABT43 STB ABT21 
      BLF,BLF       ROTATE DB# INTO BITS 15-13
      BLF,RBL 
      CLA,INA       CLOSE DATA BASE REQUEST 
      JSB IMRQT 
      JMP ABT50     THE LAST DATA BASE HAS BEEN CLOSED
      JMP ABT46     RETURN OK, TRY TO CLOSE THE NEXT ONE
      DST BUF       SET UP IMAGE ERROR CODES
      JSB ERRPR     AND PRINT ERROR MESSAGE 
* 
ABT46 LDB ABT21     CLOSE THE NEXT DATA BASE
      INB 
      JMP ABT43 
  SPC 2 
ABT50 LDA LOGXX,I   IS A LOGGING DEVICE OR FILE 
      SZA,RSS       DEFINED ? 
      JMP ABT52        NO, SKIP DCLOG CLOSE 
      CLA,INA          YES, SET FLAG TO 1 FOR CLOSE 
      LDB LOGXX     GET LOG DEVICE ADDR 
      STB OPLO2 
      JSB OPLOG     CLOSE LOG FILE/DEV
OPLO2 BSS 1 
      DEF LU
      SZA           ERROR?
      JSB LOGER     YES, GO SHIT
   SPC 2
ABT52 JSB OUTLF     OUTPUT ONE BLANK LINE 
  SPC 1 
      JSB STPPR     STOP ALL PROGRAM OF THE APPLICATION 
  SPC 1 
      JSB RECLS     RELEASE ALL TMS CLASS I/O 
* 
* ENABLE REQUE COUNT CHECK IN #REQU 
* 
      LDA TQSAV 
      STA #QCNT 
  SPC 1 
ABT3  LDA @$END     MOVE "$END" INTO MESSAGE
      LDB @MSBX 
      MBT D10 
      JSB EXEC      PRINT " /XXXX: $END"
      DEF *+5 
      DEF D2
      DEF LU
      DEF MSBU
      DEF D7
* 
      LDA LU       SET TERMINAL TIME OUT TO 0 
      IOR =B2200
      STA TEMP
      JSB EXEC
      DEF *+4 
      DEF D3
      DEF TEMP
      DEF D0
  SPC 1 
      JSB EXEC      ABORT  TMSYS ITSELF 
      DEF *+4 
      DEF D6
      DEF D0
      DEF D0        KILL  TMS MAIN PROGRAM !! 
      HLT 67B 
  SPC 2 
ABTFL OCT 125252
TQSAV BSS 1         SAVE INITIAL REQU# COUNT
@MSBU DBL MSBU
@MSB1 DBL MSBU+1
MSBU  ASC 5, /XXXXX:
      ASC 16, 
@$END DBL *+1 
      ASC 5,$END
   HED ABORT ALL PROGRAMS OF THE APPLICATION
STPPR NOP           STOP ALL PROGRAM
      LDA ABTCD     GET ABORT CODE (17) 
      STA SCODE     SET SPECIAL ABORT INDICATOR 
      CLA           SIGNAL TO 'TMLIB' THAT THERE IS 
      STA #DFCB     NO CB'S TO RECEIVE !! 
      STA EPAOS     NO ENTRY POINT ADDR OF SUBROUTINE !!
  SPC 1 
      LDA .TMST 
      JSB SCHUP     ABORT "TMST" PROG.
      HLT 70B 
      JSB EXEC      REMOVE THE TMS-TIMER FROM 
      DEF *+6       THE TIME LIST 
      DEF D12 
      DEF .TMST,I   PROGRAM NAME
      DEF D1        RESOLUTION CODE ( 1/100 SEC)
      DEF D0        EXECUTION MULT. (ONLY ONCE) 
      DEF DM1       START IT NEXT TBG'S TIC 
* 
      LDA .TMSL 
      JSB SCHUP     ABORT "TMSL" PROG.
      HLT 71B 
* 
      LDA .TMPR,I   SETUP TO ABORT ALL TMS PROGRAM
      CMA,INA 
* 
STPP5 STA $CVTX     ABORT ALL TM PROGRAM
      ADA .TMPR,I   I.E.: ALL PROGRAM DECLARED IN 
      MPY UPTEN     THE TMSGN TABLE, MULTIPLY BY ENTRY LEN
      INA 
      ADA .TMPR 
      JSB SCHUP     SHEDULE USER PROG TO ABORT IT 
      HLT 72B 
* 
      LDA $CVTX 
      INA,SZA 
      JMP STPP5     LOOP UNTIL END
      JMP STPPR,I 
* 
ABTCD DEC 17
  SPC 3 
$CVTX NOP           CONVERSION PROGRAM
      SEZ,RSS       IS NUMBER OCTAL?
      JMP CVTX1        YES, CONVERT USING $CVT3 
* 
      STA $CVTZ        NO, DECIMAL, USE JASC
      JSB JASC
      DEF *+5 
      DEF $CVTZ 
      DEF $CVTY 
      DEF D1
      DEF D6
      JMP CVTX2 
* 
CVTX1 JSB $CVT3 
      LDB .CVTY 
      MVW D3
CVTX2 LDA .CVTY 
      JMP $CVTX,I 
* 
MINZE OCT 6400     MINUS SIGN WHEN IOR'ED WITH BLANK
.CVTY DEF $CVTY 
$CVTY BSS 3 
$CVTZ NOP 
  SPC 2 
RECLS NOP           RELEASE ALL TMS CLASS I/O 
  SPC 1 
*                  SET ALL INTERACTIVE LUS TO EQT 0 TO KILL ALL IO
*                  REQUESTS 
* 
      LDA STA33,I  GET NO. OF INTERACTIVE LUS 
      CMA,INA      NEGATE 
      STA #LU      SAVE 
      LDA STA31    GET ADDR OF LU TABLE IN HEADER PROGRAM 
      STA TEMP1    SAVE 
      LDA .SCOD    GET DESTINATION ADDR OF EQT TABLE
      STA TEMP2 
* 
RECL1 JSB DRTEQ    GET EQT FROM LU
      DEF *+2 
      DEF TEMP1,I  LU # 
      AND O77      GET EQT# (RETURNED IN LOWER SIX BITS OF A REG) 
      CCE          DECIMAL FLAG 
      JSB $CVTX    CONVERT EQT# TO ASCII
      ADA D2       ASCII NO. ADDR IN A REG, POINT TO TWO LEAST SIG DIGITS 
      LDA A,I      GET ASCII NO.
      STA TEMP2,I  SAVE IN EQT TABLE
      STA EQUP+2   SAVE IN "UP,XX" MESSAGE
      STA EQDN+2   SAVE IN "DN,XX" MESSAGE
      LDA TEMP1,I  GET LU NO. 
      CCE          DECIMAL FLAG 
      JSB $CVTX    CONVERT LU# TO ASCII 
      ADA D2       POINT TO TWO LEAST SIG DIGITS
      LDA A,I      GET ASCII NO.
      STA TEMP1,I  STORE BACK IN LU TABLE 
      STA LUEQ+2   STORE IN MESSAGE 
      JSB MESSS    ISSUE "LU,XX,0"
      DEF *+3 
      DEF LUEQ
      DEF D8
      JSB MESSS    ISSUE "DN,XX"
      DEF *+3 
      DEF EQDN
      DEF D6
      JSB MESSS    ISSUE "UP,XX"
      DEF *+3 
      DEF EQUP
      DEF D6
* 
      ISZ TEMP1     POINT TO NEXT LU
      ISZ TEMP2     POINT TO NEXT EQT SLOT
      ISZ #LU       LAST LU?
      JMP RECL1       NO, KEEP GOING
  SPC 1 
      LDA MCLAS     RELEASE MAIN CLASS I/O
      JSB KLCLX 
  SPC 1 
      LDA ICLAS     RELEASE INTERNAL CLASS I/O
      JSB KLCLX 
   SPC 1
      LDA CLASS     RELEASE EXTERNAL CLASS I/O
      JSB KLCLX 
  SPC 1 
      LDA CLAS0     RELEASE TRUE COMMON CLASS I/O 
      JSB KLCLX 
  SPC 1 
      LDA FMPCL     RELEASE TMS-FMP CLASS I/O 
      JSB KLCLX 
   SPC 1
* POINT LUS BACK TO THEIR ORIGINAL EQT'S
* 
      LDA STA33,I   GET NO. OF LUS
      CMA,INA 
      STA #LU       SAVE
      LDA STA31     GET ADDR OF LU TABLE IN HEADER PROGRAM
      STA TEMP1     SAVE
      LDA .SCOD     GET ADDR OF EQT TABLE 
      STA TEMP2 
RECL2 LDA TEMP1,I   GET ASCII LU NO.
      STA LUEQ+2    SAVE IN MESSAGE BUFFER
      LDA TEMP2,I   GET ASCII EQT NO. 
      STA LUEQ+4    SAVE IN MESSAGE BUFFER
      JSB MESSS     ISSUE "LU,XX,YY" MESSAGE
      DEF *+3 
      DEF LUEQ
      DEF D10 
      ISZ TEMP1     POINT TO NEXT LU
      ISZ TEMP2     POINT TO NEXT EQT 
      ISZ #LU       LAST LU?
      JMP RECL2        NO, CONTINUE 
      JMP RECLS,I      YES, RETURN
   SPC 1
LUEQ  ASC 5, LU,00,000
EQUP  ASC 3, UP,00
EQDN  ASC 3, DN,00
   SPC 2
KLCLX NOP 
      STA KLCL5 
      JSB KLCLS 
      DEF *+2 
      DEF KLCL5 
      SZA 
      HLT 73B 
      JMP KLCLX,I 
* 
KLCL5 NOP 
  HED UTILITY SUBROUTINE
*                   EMA UTILITY 
*                   =========== 
  SPC 1 
EMATB DEC 1         ONE DIMENSION ARRAY 
      DEC -1        LOWER BOUNDS
WPELE DEC 10        # WORDS/ELEMENT 
      DEC 0,0       OFFSET
  SPC 1 
*                   LDA CBLAD     CB LOGICAL ADDR. (FROM THE STACK) 
*                   JSB GCBAD     MAP IN C.B.  (1025 WORDS ONLY)
*                          A = ADDR OF WORD CBX(1) (1ST USER WORD)
*                          B,X & Y ARE NOT MODIFIED 
* 
GCBAD NOP 
      SZA,RSS       CB ALLOCATED ?
      JMP GCBAD,I   NO, FORGET IT 
      DST GCBA0     SAVE A & B REG. 
      CXA           SAVE X & Y REG. SINCE EMA SOFTWARE
      CYB           USE THEM, THIS IS THE FASTEST WAY 
      DST GCBA1     TO DO IT. 
      JSB .EMAP     CALL EMA ROUTINE
      DEF *+4 
      DEF $TMSA     EMA NAME
      DEF EMATB     EMA TABLE 
      DEF GCBA0     SUBSCRIPT VALUE (LOGICAL CB ADDR.)
      JSB ERR0
      LDA B         SET TRUE ADDR INTO A
      ADA CBOVH     SKIP CB INTERNAL THINGS 
      LDB GCBA0+1   RESTORE B REG.
      LDX GCBA1     RESTORE X REG.
      LDY GCBA1+1   RESTORE Y REG.
      JMP GCBAD,I   AND RETURN
* 
GCBA0 BSS 2 
GCBA1 BSS 2 
* 
MCBOV DEC -5
  SPC 1 
*                   LDA CBLAD     CB LOGICAL ADDR. (FROM THE STACK) 
*                   LDB CBLEN     CB LENGTH IN WORDS
*                   JSB MAPCB     MAP THE ENTIRE CB 
*                          A = ADDR OF WORD CBX(1), (1ST USER WORD) 
*                          B IS UNCHANGED 
* 
MAPCB NOP           GET ACTUAL ADDR. OF A CB
*                   CHECK FOR 1025 ( 1020 IN FACT) TO USE .EMAP 
      JSB GCBAD 
      JMP MAPCB,I   TEMPORARILY !!!!!!!!!!!!!!!!!!!!!!! 
      ADB CBOVH     FOR INTERNAL STAFF
      DST ACBA0 
      JSB .EMIO     CALL EMA ROUTINE
      DEF *+4 
      DEF ACBA0+1   BUFFER LENGTH 
      DEF EMATB     EMA TABLE 
      DEF ACBA0     SUBSCRIPT VALUE 
      JSB ERR0      ERROR RETURN
      LDA B         SET A=ACTUAL ADDR 
      ADA CBOVH     SKIP INTERNAL STAFF 
      LDB ACBA0+1   RESTORE B REG.
      ADB MCBOV 
      JMP MAPCB,I   AND RETURN
* 
ACBA0 BSS 2 
  SPC 2 
*                   LDA PT        ADDR WHERE THE LOGICAL ADDR. IS 
*                                 TO BE SAVE ( PT INTO THE STACK) 
*                   LDB CBLEN     CB LENGTH IN WORDS
*                   JSB ALCB      PERFORM THE ALLOCATION AND IF 
*                                 SUCCESFULL SETUP CB INTERNAL POINTER
*                                 AND SAVE CB LOGICAL ADDR. INTO A REG. 
*                                 ADDRESS.
*                      (P+1)  MEMORY SUSPEND RETURN, B=# OF ELEMENT 
*                             OF MEMORY REQUIRED
*                      (P+2)  RETURN OK, A=ADDR. OF CBX(1) (1ST USER WORD)
*                             AND THE FIRST 1025 WORDS ARE MAPPED.
  SPC 1 
ALCB  NOP 
      STA ALCB1     SAVE ADDR IN THE STACK
      LDA FSTBT     RECALL FIRST BIT # OF BIT TABLE 
      JSB ALCB0     AND GO FIND A HOLE IN THE BIT TABLE 
      SSB           OK ?
      JMP .ER13     NO, NEVER OK --> ABORT TMS
      LDB ALCB4     RECALL # OF ELEMENT REQUIRED
      SSA           IS IT OK NOW ?
      JMP ALCB,I    NO, WAIT --> MEMORY SUSPEND 
      ISZ ALCB      YES, SET RETURN ADDR
      STA ALCB3     AND SAVE THE LOGICAL ADDR OF THE CB 
* 
      JSB BITST     SET THAT PIECE OF MEMORY ALLOCATED
      DEF *+5       BY SETTING CORESPONDING BITS TO 1 
      DEF .BITB,I   BIT TABLE ADDR
      DEF ALCB3     STARTING BIT OF THE ZONE
      DEF ALCB4     NUMBER OF BIT TO SET
      DEF D1        VALUE TO SET THE BIT
* 
      LDA ALCB3     RECALL LOGICAL ADDR OF CB 
      JSB GCBAD     MAP THE FIRST 1025 WORDS OF IT
      ADA DM1       AND INITIALIZE THE 5 FIRST WORDS
      LDB ALCB2 
      STB A,I       CB LENGTH IN WORDS           (-1) 
      ADA DM1 
      LDB Q 
      STB A,I       CURRENT Q VALUE              (-2) 
      ADA DM1 
      LDB ALCB1,I   RECALL LOGICAL ADDR OF
      STB A,I       PREVIOUS COMMON BLOCK        (-3) 
      ADA DM1 
      LDB ALCB1     ADDR WHERE THAT CB IS SAVED  (-4) 
      STB A,I 
      LDB ALCB3     STORE LOGICAL ADDR. OF THIS CB
      STB ALCB1,I   WHERE IT SHOULD BE SAVED (STACK USUALLY)
      ADA DM1 
      LDB ALCB4     RECALL CB LENGTH IN 
      STB A,I       NUMBER OF ELEMENT            (-5) 
      ADA CBOVH     RESTORE CB ADDR. OF CBX(1) (1ST USER WORD)
      JMP ALCB,I
* 
ALCB1 NOP 
ALCB2 NOP 
ALCB3 NOP 
ALCB4 NOP 
ALCB5 NOP 
   SPC 2
ALCB0 NOP 
      STA ALCB5     SAVE 1ST BIT # IN THE TABLE 
      STB ALCB2     SAVE CB LENGTH IN WORDS 
      LDA B         GET CB LENGTH 
      ADA CBOVH     AND ADD LENGTH FOR INTERNAL CB DATA 
      CLB           TO COMPUTE LEN IN NUMBER OF ELEMENT 
      DIV WPELE     BY DIVIDING BY THE # OF WORDS / ELEMENT 
      SZB           IF REMAINDER NOT ZERO 
      INA           NEED ONE MORE ELEMENT 
      STA ALCB4     SAVE LENGTH IN # OF ELEMENT 
      CMA,INA       AND CHECK THAT THIS LENGTH
      ADA LSTBT     DOES NOT EXEED THE TOTAL LENGTH 
      SSA           EVER AVAILABLE
.ER13 JSB ERRAB     TOO BAD. CB IS TOO BIG --> ABORT TMS
      JSB BITSR     SEARCH INTO THE BIT TABLE 
      DEF *+5       FOR A HOLE BIG ENOUGH 
.BITB NOP           BIT TABLE ADDR
      DEF ALCB5     FIRST BIT NUMBER OF THE TABLE 
      DEF LSTBT     LAST  BIT NUMBER OF THE TABLE 
      DEF ALCB4     NUMBER OF BIT NEEDED
      JMP ALCB0,I 
  SPC 2 
*                   THIS SUBROUTINE RELEASE ALLOCATED COMMON-BLOCK
* 
*                     IT RELEASES CB WITH A "CURRENT Q VALUE" > Q,
*                     IF RECURSIVE ALLOCATION EXIT, THIS SUBROUTINE 
*                     WILL LINK THE NEW CB IN PLACE OF THE CURRENT ONE, 
*                     THE MEMORY OCCUPIED BY THE DEALLOCATED CB IS
*                     RELEASED AND THE TOTAL MEMORY RELEASED (IN NUMBER 
*                     OF ELEMENT) IS SAVED IN  TEMP.
   SPC 1
RLCB  NOP 
      LDX D5        INIT X REG TO CHECK ALL CB'S
      CLA           INIT # OF ELEMENT IN MEMORY RELEASED
      STA TEMP
* 
RLCB2 LAX PT,I      GET ACTUAL CB ADDR. 
      SZA,RSS       CB ALLOCATED ?
      JMP RLCB8     NO, CHECK NEXT ONE
      STA ALCB3     YES, SAVE LOGICAL ADDR. 
      JSB GCBAD     MAP THE 1025 FIRST WORDS OF THIS CB 
      ADA DM2       CHECK IF DE-ALLOCATED 
      LDB A,I       IS NEEDED, GET Q AT TIME
      CMB,INB       OF ALLOCATED
      ADB Q         Q NOW  -  Q AT ALLOC. TIME
      SSB,RSS       DEALLOCATED NEEDED ?
      JMP RLCB8     NO, CHECK NEXT ONE
      ADA DM1       YES, RESOLVE RECURSIVE ALLOCATION 
      LDB A,I       GET ACTUAL CB ADDR. OF PREVIOUS LEVEL 
      SBX PT,I      AND PUT IT IN THE STACK 
      ADA DM2 
      LDB A,I       GET # OF ELEMENT
      STB ALCB4     SAVE IT TO CLEAR THOSE BITS 
      ADB TEMP      AND ACCUMULATE THIS TO KNOW HOW MANY
      STB TEMP      ELEMENTS HAVE BEEN RELEASED 
* 
      JSB BITST     CLEAR BITS IN THE BIT TABLE 
      DEF *+5 
      DEF .BITB,I   BIT TABLE ADDR
      DEF ALCB3     STARTING BIT NUMBER 
      DEF ALCB4     # OF BITS TO BE CLEARED 
      DEF D0        CLEAR THE BITS, AND CHECK AGAIN 
      JMP RLCB2     FOR THE NEW CB ADDR. (RECURSIVE ALLOC.) 
* 
RLCB8 DSX           MORE COMMON BLOCK 
      JMP RLCB2     YES, CONTINUE 
      JMP RLCB,I    NO, RETURN
* 
FSTBT NOP           FIRST BIT NUMBER OF THE BIT TABLE 
LSTBT NOP           LAST  BIT NUMBER OF THE BIT TABLE 
  SKP 
*    ENABLE/DESABLE  COMMON BLOCK ROUTINE:
*    -------------------------------------
  SPC 1 
*                   'STKPT' & 'Q' VARIABLE MUST BE SET UP BEFORE
*                   USING ANY OF THE FOLLOWING ROUTINE. 
* 
*                      LDB CB#       B=CB NUMBER
*                      JSB COM.U
*                            RETURN (P+1) 
*                         A=ACTUAL ADDR INTO EMA ARRAY
*                         B=CURRENT LENGTH WITH BIT15=ENABLE FLAG 
*                         Y=INDEX TO GET LOGICAL ADDR FROM STACK
*                     LCBLP=ADDR OF LOCAL CB LENGTH IN THE STACK
*                     CCBLP=ADDR OF CURRENT CB LENGTH IN THE STACK
  SPC 1 
COM.U NOP           COMMON BLOCK ENABLE/DISABLE UTILITY 
      CBY           Y=CB #
      ISY           TO ACCESS CORRESPONDING LOGICAL ADDR
      BLS           MPY D2
      ADB QCBLA     ADD DISPLACEMENT FROM Q TO CB1 LOCAL ADDR 
      ADB Q         ADD Q VALUE TO GET POINTER IN THE STACK 
      STB LCBLP     SAVE POINTER TO LOCAL CB LENGTH 
      ADB DM1 
      STB CCBLP     SAVE POINTER TO CURRENT CB LENGTH 
      LAY STKPT,I   GET LOGICAL CB ADDRESS FROM STACK 
      JSB GCBAD     MAP THE 1025 FIRST WORDS OF THE CB
      LDB B,I       GET CURRENT CB LEN & BIT15=ENABLE FLAG
      JMP COM.U,I 
* 
LCBLP NOP 
CCBLP NOP 
  SPC 1 
COM.E NOP           ENABLE ONE COMMON BLOCK 
      JSB COM.U     SET A,B,Y,CCBLP & LCBLP, MAP 1ST 1025 WORDS 
      CPB BIT15     B=CURRENT LEN., DOES LOCAL CB EXIST ? 
      JMP CO4.E     NO, EXIT WITOUT ALLOCATION
      SZA           ALLOCATED ? 
      JMP CO2.E     YES, IT IS ALLOCATED
      SSB,RSS       NO, ENABLE ?
      HLT 13B       YES, ENABLE !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
CO1.E RBL,CLE,ERB   NO, SET BIT15 TO INDICATE ENABLE
      STB CCBLP,I   AND STORE BACK IN THE STACK 
      CYA           Y --> A 
      ADA STKPT     TO HAVE POINTER INTO THE STACK
      JSB ALCB      ALLOCATE THE MEMORY FOR THE CB
      JMP COM.E,I   RETURN P+1, PUT IN MEMORY SUSPEND ! 
CO9.E ISZ COM.E     RETURN OK (P+2) 
      JMP COM.E,I 
* 
CO2.E SSB,RSS       ALREADY ENABLE ?
      JMP CO5.E     YES, IT MUST BE A LOCAL ENABLE
      RBL,CLE,ERB   NO, SET BIT15 TO INDICATE ENABLE
      STB CCBLP,I   AND STORE CURRENT LENGTH IN THE STACK 
      CMB,INB 
      STA COM.U     SAVE A
      ADA DM1       VERIFY CURRENT LENGTH VS ACTUAL SIZE
      LDA A,I       GET ACTUAL SIZE 
      ADB A         ACTUAL SIZE - LOCAL SIZE
      SSB           ACTUAL GREATER ?
      STA CCBLP,I   NO, CHANGE CURRENT SIZE TO ACTUAL SIZE
      LDA COM.U     YES, RESTORE A TO ACTUAL COMMON ADDR
      JMP CO9.E 
  SPC 1 
CO4.E CLA           INDICATE NO ALLOCATION DONE 
      JMP CO9.E 
* 
CO5.E ADA DM2       LOCAL ENABLE PROCESS
      LDA A,I 
      CPA Q         SECOND ENABLE IN THE SAME ROUTINE ? 
.ER06 JSB ERRAB     YES, ERROR # 6  --> ABORT TMS 
      JMP CO1.E     NO, PERFORM RECURSIVE ALLOCATION OF CB
  SPC 3 
COM.D NOP           DESABLE ONE COMMON BLOCK
      JSB COM.U 
      SZA,RSS       ALLOCATED ? 
.ER16 JSB ERRAB     NO, NOT ALLOCATED, ERROR !! 
      SSB           YES, ENABLE ? 
.ER17 JSB ERRAB     NO, NOT ENABLED, ERROR !! 
* 
      ADA DM2 
      LDB =B77777   SET A LARGE Q VALUE 
      STB A,I       TO RETURN MEMORY WITH 'CLECO' ROUTINE 
      ADA DM1 
      LDB A,I       CHECK FOR RECURSIVE ENABLE
      CCE,SZB       RECURSIVELY ENABLED ? 
      JMP COM.D,I   YES, SO LEAVE THIS CB ENABLED 
      LDB CCBLP,I   NO, INDICATE THAT CB IS 
      RBL,ERB       NOW DISABLED. 
      STB CCBLP,I 
      JMP COM.D,I   RETURN
  SPC 3 
MEMOK NOP           A=POINTER TO CB LOCAL ADDR
      STA TEMP1     SAVE IT 
* 
      LDA =D12      INIT MEMORY NEEDED (12) FOR 
      STA SPR38     THE 11 WORDS BLOCK (SUB-PRO LAUNCH) 
      CLA,INA       SET UP 1ST BIT NUMBER 
      STA TEMP2 
      CLA           INIT
      STA TEMP3     TOTAL NUMBER OF ELEMENT NEEDED
      STA TEMP4     FAIL/SUCCES FLAG (0=OK) 
* 
MEMO3 LDA TEMP1,I 
      SZA,RSS       CB DEFINED HERE ? 
      JMP MEMO6     END OF CALLING SEQUENCE: NO MORE CB'S 
      JSB GECB#     YES, RETREIVE CB #
      JSB COM.U     INIT A,B AND Y REG., MAP THE FIRST 1025 WORDS 
      RBL,CLE,ERB   CLEAR BIT 15 OF CB LENGTH IN WORD 
      LDA TEMP2     RECALL STARTING BIT NUMBER
      JSB ALCB0     AND TRY TO ALLOCATE MEMORY
      LDB ALCB4     RECALL CB LENGTH IN # OF ELEMENT
      SSA,RSS       ALLOCATION OK ? 
      JMP MEMO4     YES, CONTINUE 
      STA TEMP4     NO, SET FAIL FLAG 
      LDA LSTBT     AND SET FIRST BIT TO LAST BIT NUMBER
      JMP MEMO5 
MEMO4 ADA B         COMPUTE THE NEW FIRST BIT NUMBER
MEMO5 STA TEMP2     SET NEW FIRST BIT NUMBER
      ADB TEMP3     ACCUMULATE NEEDED NUMBER OF ELEMENT 
      STB TEMP3     INTO TEMP3
      LDA ALCB2     RECALL CB LEN IN WORDS (SAVED BY 'ALCB0') 
      LDB SPR38     RECALL OLD MAX CB LENGTH
      CMB,INB       TO SAVE INTO 'SPR38' THE MAXIMUM CB LEN 
      ADB A         CURRENT CB LENGTH - MAX CB LEN
      SSB,RSS       CURRENT - MAX  >= 0  ?
      STA SPR38     YES, SET NEW MAXIMUM CB LEN 
      ISZ TEMP1     GET NEXT CB FROM THE CALLING SEQUENCE 
      JMP MEMO3     AND CONTINUE
* 
MEMO6 LDA TEMP4     RECALL THE FLAG 
      SZA,RSS       OK ?
      JMP MEMOK,I   YES, RETURN 
  SPC 1 
*                   PUT THAT PROCESS IN MEMORY SUSPEND
*                   ----------------------------------
  SPC 1 
MSU05 LDB TEMP3     RECALL THE TOTAL # OF ELEMENT REQUIRED
MSU10 LDA MSUFL     RECALL MEMORY SUSP. FLAG
      SZA           SUSPEND OK ?
      JMP MSU20     NO, DO NOT SUSPEND THE PROCESS
      LDA STKPT     YES, SUSPEND CURRENT PROCESS
      ADA =D7       SAVE # OF ELEMENT REQUIRED
      STB A,I       IN THE STACK
      INA           SAVE ALSO CURRENT SUBROUTINE CODE 
      LDB SCODE     IN THE
      STB A,I       STACK 
      INA 
      STA TEMP      SAVE ADDR OF THE LINK WORD
* 
      LDB .MSUP     MEMORY SUSPEND QUEUE HEAD 
MSU12 LDA B,I 
      SZA,RSS 
      JMP MSU14     END OF QUEUE
      LDB A         LOOP UNTIL
      JMP MSU12     END OF QUEUE IS REACHED 
* 
MSU14 STA TEMP,I    SET END OF QUEUE IN THE NEW LINK
      LDA TEMP      AND LINK
      STA B,I       NEW STACK IN THE QUEUE. 
* 
      LDA ..PA1     SAVE CALLING SEQUENCE PARAMETERS
      LDB S         IN THE STACK
      MVW D10       THERE IS ALWAYS 10 EXTRA FREE WORDS 
      JMP IDLE      ON THE STACK !  GOTO IDLE LOOP
  SPC 1 
MSUCD DEC 21
MSUFL NOP           MEMORY SUSPEND FLAG (0 -->  SUSP.)
.MSUP DEF *+1       MEMORY SUSPEND QUEUE HEAD 
      OCT 0 
  SPC 2 
MSU20 LDB Q         DO NOT SUSPEND THAT PROCESS, RETURN 
      INB           TO THE PROCESS AT THE SPECIAL 
      STA B,I       RETURN ADDR. PROVIDED IN THE
      JMP EXITZ     CALLING SEQUENCE. 
  SPC 3 
DSTAK NOP           DE-STACK ONE LEVEL
      LDA Q 
      ADA DM1       A IS THE NEW S REGISTER 
      LDB A,I       GET MINUS DELTA Q 
      ADB Q         B IS THE NEW Q REGISTER 
      DST STKPT,I   SAVE S & Q REGISTER IN THE STACK
      DST S         SET NEW S & Q VALUE 
      JMP DSTAK,I 
  SPC 2 
CLECO NOP           CLEAR ALL NEEDED COMMON BLOCK 
      LDB STKPT     RELATED TO THE STATE OF 
      INB           THE STACK.
      STB PT
      INB           POINTER TO ACTUAL ADDR. OF CB1
      LDA B,I       GET CB1 ADDR
      JSB GCBAD     MAP 1025 FIRST WORDS OF THAT CB 
      LDA A,I       GET LU ASSOCIATED WITH THAT STACK 
      ADB =D5 
      STA B,I       AND SAVE IT INTO THE STACK (INTO TEMP1) 
* 
      JSB RLCB      RELEASE THE MEMORY
* 
      LDA TEMP      MEMORY HAS BEEN RELEASED ?
      SZA,RSS 
      JMP CLECO,I   NO MEMORY RETURNED. 
      CMA,INA       MAKE # OF ELEMENT AVAILABLE 
      STA TEMP      NEGATIVE. 
  SPC 1 
      LDB .MSUP     TRY TO RESTART SOME PROCESSES 
* 
CLEC8 LDA B,I 
      SZA,RSS       END OF MEMORY SUSPEND QUEUE ? 
      JMP CLECO,I   YES, EXIT 
      STB TEMP1     SAVE QUEUE POINTER
      STA B 
      ADA =D-2      TO GET REQUESTED LEN
      LDA A,I       A = PROCESS REQUESTED MEMORY LEN
      ADA TEMP      ENOUGH AVAILABLE ?
      SSA,RSS 
      JMP CLEC8     NO, TRY ANOTHER PROCESS 
* 
      STA TEMP      AJUST FREE MEMORY LEN 
      LDA B,I       DEQUEUE THIS PROCESS
      STA TEMP1,I   BY LINKING NEXT ONE 
      CLA 
      STA B,I       CLEAR LINK WORD IN THIS STACK 
      LDA SCODE     SAVE CURRENT PROCESS SUBROUTINE CODE
      STA TEMP2 
      LDA STKPT     AND SAVE CURRENT PROCESS STACK ADDR 
      STA TEMP3 
      LDA MSUCD     SET MEMORY SUSPEND SUBROUTINE CODE
      STA SCODE 
      ADB =D-9
      STB STKPT 
      JSB WRI/O     REQUEUE THIS PROCESS TO RESTART IT
      LDA TEMP2     RESTORE CURRENT PROCESS PARAMETERS
      STA SCODE     (SUBROUTINE CODE AND STACK POINTER) 
      LDA TEMP3 
      STA STKPT 
      LDB TEMP1     RESTORE MEMORY SUSPEND QUEUE POINTER
      JMP CLEC8     AND LOOP UNTIL END OF QUEUE 
  SPC 2 
*                   RETREIVE THE NUMBER OF THE COMMON BLOCK FROM
*                   THE LOCAL CB ADDR 
*                   THIS ROUTINE MUST NOT BE USED FOR CB # 1
* 
*                      LDA LCBAD     A=LOCAL CB ADDR
*                      JSB GECB#
*                        RETURN (P+1) 
*                            B = CB#
* 
*                   IF THE CB IS NOT FOUND, THE TMS APPLICATION 
*                     IS ABORTED WITH ERROR # 15
  SPC 1 
GECB# NOP           GET CB# FROM LOCAL CB ADDR. IN A REG
      STA RELBU     SAVE LOCAL CB ADDR
      CLA           INIT THE CB # 
      STA TEMP
      LDA Q 
      ADA QCBLA     TO ACCESS THE FIRST CB LOCAL ADDR 
      LDX A,I       GET CB1 LOCAL ADDR
* 
GEC3# INA           BUMP STACK POINTER
      CPA S         END OF STACK ?
.ER15 JSB ERRAB     YES, UNKNOWN OR ILLEGAL CB ADR, ERROR !!
      ISZ TEMP      BUMP CB # 
      INA           TO ACCESS LOCAL CB LENGTH 
      LDB A,I       GET CB LOCAL LENGTH 
      SZB,RSS       LOCAL LENGTH NUL ?
      JMP GEC3#     YES, GO TO NEXT CB
      XBX           X=CB LENGTH, B=CB LOCAL ADDR. 
      ADX B         MAINTAIN X=LOCAL CB ADDR
      CPB RELBU     IS IT THIS CB ? 
      RSS           YES, CHECK FOR CB # 1 
      JMP GEC3#     NO, CONTINUE
      LDB TEMP      RECALL CB#
      CPB D1        IS IT CB1 ? 
      JMP .ER15     YES, IT MUST NOT BE --> ABORT TMS 
      JMP GECB#,I   NO, RETURN WITH  B=CB#
  SPC 3 
RELBU NOP           RELEASE BUFFER CLASS
      JSB EXEC
      DEF *+8 
      DEF D21 
      DEF CLASS 
      DEF BUF 
      DEF D10 
      DEF TEMP
      DEF TEMP1 
      DEF TEMP2 
      SSA 
      HLT 74B 
      JMP RELBU,I 
  SPC 2 
SETST NOP           SAVE STATUS & TLOG INTO CB1 WORD 4 & 5
      CAX           SAVE A INTO X REG 
      LDA STKPT     SETUP TO SAVE STATUS & TLOG 
      SZA,RSS       STACK DEFINED ? 
      JMP SETST,I   NO, FORGET IT 
      ADA D2        YES, ACCESS FIRST COMMON BLOCK
      LDA A,I       GET COMMON LOGICAL ADDR 
      SZA,RSS       CB1 ALLOCATED ? 
      JMP SETST,I   NO, FORGET IT 
      JSB GCBAD     YES, MAP THE CB TO STORE STATUS & TLOG
      XAX           RESTORE STAT IN A, SET X=CB ADDR
      SAX 3B        STORE STATUS
      SBX 4B        STORE TLOG
      JMP SETST,I 
   SPC 2
WRI/O NOP           EXECUTE A WRITE/READ CLASS I/O
      JSB EXEC
      DEF *+8 
      DEF D20       WRITE/READ
      DEF D0        DUMMY LU
      DEF BUF       DUMMY BUFFER
      DEF WRI/L     DUMMY LENGTH
      DEF STKPT     STACK ADDRESS 
      DEF SCODE     SUBROUTINE CODE 
      DEF CLASS     CLASS WORD
      JMP WRI/O,I 
* 
WRI/L DEC 5 
  SPC 2 
GTCLW NOP           GET A CLASS I/O WORD FROM SYSTEM
      LDA CLASS     SAVE THE CLASS WORD 
      STA TEMP3 
      CLA           INIT TO ZERO TO GET ONE CLASS 
      STA CLASS 
      JSB WRI/O     DO A WRITE/READ REQUEST 
      LDA CLASS     RECALL THE CLASS WORD 
      IOR BIT13     AND MERGE BIT 13 TO NOT DEALLOCATE
      STA CLASS     THE CLASS NUMBER. 
      JSB RELBU     RELEASE THE BUFFER CLASS
      LDA CLASS     A REG. IS THE NEW CLASS NUMBER
      LDB TEMP3     RESTORE WORD "CLASS"
      STB CLASS 
      JMP GTCLW,I   RETURN WITH A=CLASS I/O WORD
  SPC 2 
SCHUP NOP           SCHEDULE A USER PROGRAM (GROUPING OF TMSUB) 
      STA SCHU7     SAVE PARTITION NAME ADDR
      STA SRFLG     SET SEND MAIL BOX FLAG
      LDB SCHFL     RECALL SCHEDULE FLAG (0 --> NO-WAIT)
      LDA A,I       GET FIRST 2 CHAR. OF THE NAME OR
      SSA,RSS       CLASS WORD, CLASS WORD ?
      JMP SCHU3     NO, GO SCHEDULE PROGRAM 
      AND =B17777   YES, CLEAR BIT 15 OF CLASS WORD 
      SZB,RSS       WAIT / NO WAIT ?
      STB SCHU7     NO WAIT, CLEAR THE FLAG 
      LDB ICLAS     PUT LOCAL CLASS WORD INSTEAD OF 
      STA ICLAS     TMS INTERNAL CLASS WORD 
      STB SCHRQ     SAVE TEMPORARILY INTERNAL CLASS WORD
* 
      JSB MAILB 
      DEF SCODE 
#PARG ABS PARLG 
* 
      LDA SCHRQ     RESTORE TMS INTERNAL CLASS WORD 
      STA ICLAS 
      LDA SCHU7     WAIT / NO-WAIT REQUEST ?
      SZA,RSS 
      JMP SCHU8     NO WAIT REQUEST, RETURN IMMEDIATLY
* 
      ISZ SCHU7     REQUEST WITH WAIT OPTION
SCHU1 LDA DM2       WAIT UNTIL PRG GO TO 'DORMANT' STATE
      LDB .SCH2     CHEK ROUTINE ADDR 
      JSB WAIT
      JMP SCHU1     LOOP UNTIL PRG IS DORMANT 
* 
.SCH2 DEF *+1       CHECK ROUTINE ADDR
      NOP           CHECK ROUTINE ENTRY POINT 
      LDA SCHU7,I   VERIFY THAT PROGRAM IS NOW 'DORMANT'
      ADA =D15
      XLA A,I       GET STATUS
      AND =B17      ISOLATE STATUS
      SZA           DORMANT ? 
      JMP .SCH2+1,I NO, WAIT LONGER 
      JMP SCHU8     YES, EXIT 
  SPC 1 
SCHU3 LDA NAB24     GET NO WAIT - NO ABORT CODE 
      SZB           REQUEST WITH WAIT ? 
      LDA NAB23     YES, GET  WAIT - NO ABORT CODE
      STA SCHRQ 
      JSB EXEC      SCHEDULE REQUEST
      DEF *+10
      DEF SCHRQ     QUEUE SCHEDULE - NO ABORT 
SCHU7 NOP           PROGRAM NAME
      DEF LU        LU USED TO START UP THE TMS APPLICATION 
      DEF CLASS     TMS EXTERNAL CLASS I/O WORD 
      DEF MCLAS     MAIN CLASS I/O WORD 
      DEF ICLAS     TMS INTERNAL CLASS I/O WORD 
      DEF CLAS0     TMS CLASS I/O WORD USED FOR CB0 
      DEF SCODE     BUFFER SEND TO PROGRAM
      DEF #PAR2     BUFFER LENGTH 
      JMP SCHUP,I   ERROR RETURN
SCHU8 ISZ SCHUP     AND RETURN OK TO USER 
      JMP SCHUP,I 
* 
SCHRQ NOP 
SCHFL NOP 
NAB23 OCT 100027
NAB24 OCT 100030
#PAR2 ABS PARL2 
   SPC 2
MAILB NOP           SEND/RECEIVE MAIL-BOX TO/FROM  TMLIB
      DST PARM1 
      LDA MAILB,I   CALLING SEQUENCE:    JSB MAILB
      STA MAIL2     -----------------    DEF BUFF    BUF ADDR 
      ISZ MAILB                          DEC 10      BUF LENGTH 
      LDA SRFLG 
      SZA           SEND OR RECEIVE ? 
      JMP MAIL5     SEND MAIL BOX 
      JSB EXEC
      DEF *+7 
      DEF D21       CLASS I/O GET 
      DEF ICLAS     INTERNAL CLASS I/O WORD 
MAIL2 NOP 
      DEF MAILB,I   BUFFER LENGTH 
      DEF PARM1 
      DEF PARM2 
      SSA 
      HLT 75B 
*     JSB DMPTM 
*     DEF *+7 
*     DEF D6
*     DEF MAIL2,I 
*     DEF MAILB,I 
*     DEF MES1
*     DEF D10 
*     DEF D1
      ISZ MAILB     AJUST RETURN ADDR 
      DLD PARM1 
      JMP MAILB,I 
MES1  ASC 10,0MTMS REC M.B. 
* 
MAIL5 JSB EXEC
      DEF *+8 
      DEF D20       WRITE/READ CLASS I/O CALL 
      DEF D0        DUMMY LU
      DEF MAIL2,I   BUFFER ADDR 
      DEF MAILB,I   BUFFER LENGTH 
      DEF PARM1 
      DEF PARM2 
      DEF ICLAS     INTERNAL CLASS I/O WORD 
      SZA           WAS IT OK 
      HLT 76B 
*     JSB DMPTM 
*     DEF *+7 
*     DEF D6
*     DEF MAIL2,I 
*     DEF MAILB,I 
*     DEF MES2
*     DEF D10 
*     DEF D1
      ISZ MAILB     AJUST RETURN ADDR 
      DLD PARM1 
      JMP MAILB,I 
MES2  ASC 10,0MTMS SEND M.B.
MES3  ASC 10,0MTMS SY C.B.
  SPC 1 
SRFLG NOP           SEND/RECEIVE FLAG FOR MAIL-BOX SEND/RECEI. ROUTINE
   HED CONSTANTS & VARIABLES
PARM1 NOP 
PARM2 NOP 
* 
S     NOP           DO NOT DISTURB NEXT WORDS 
Q     NOP 
S0    DEC 13,12     (INITIAL S & Q  RELATIVE VALUE) 
TEMP  NOP           DO NOT DISTURB NEXT WORDS 
TEMP1 NOP 
TEMP2 NOP 
TEMP3 NOP 
TEMP4 NOP 
  SPC 2 
I.TAB DEF *+1,I 
      DEF ILRQ      0 
      DEF STKPA     1  READ: STACK PARAMETERS 
      DEF IDLE      2 
      DEF IDLE      3 
      DEF ILRQ      4 
      DEF ILRQ      5 
      DEF CBENB     6  CB ENABLE
      DEF CBDES     7  CB DISABLE 
      DEF SBCAL     8 
      DEF DFINE     9 
      DEF SBRTN     10
      DEF STKPA     11 WRITE-READ: STACK PARAMETERS 
      DEF PAUS      12 PAUS REQUEST 
      DEF SPRL      13 SUB-PROCESS LAUNCHING
      DEF CBLEN     14 CHANGE CB LENGTH 
      DEF SIF       15 SET/RESET STOP-INHIBIT FLAG
      DEF ILRQ      16 UNLCK-IMAGE FUNCTION (NEVER COME HERE) 
      DEF TMAB      17 ABORT TMS (RQ FROM  TMLIB) 
      DEF ILRQ      18 PROCESS LAUNCH FROM 'TMSL' (NEVER RETURN)
      DEF ILRQ      19 TIMER INTERRUPT (NEVER RETURN) 
      DEF TMSP      20 STOP TMS  (RQ FROM  TMLIB) 
      DEF ILRQ      21 MEMORY SUSPEND OPERATION 
      DEF DFN10     22 SPECIAL -DEFIN CB'S- OPCODE
      DEF IMGRQ     23 IMAGE REQUEST STACK PARAMETERS ADDR
      DEF IDLE      24 LOGGING REQUEST
      DEF ILRQ      25 TMS STOP IN PROGRESS (NEVER COME HERE) 
      DEF ILRQ      26 TMS "SOFT ABORT"     (NEVER COME HERE) 
  SPC 1 
C.TAB DEF *+1,I 
      DEF START     0  START: START UP INITIALS PROCESSES 
      DEF EXIT3     1  READ, REQUEUE THE BUFFER & RETURN TO USER
      DEF IDL02     2  WRITE, RELEASE THE BUFFER & RETURN TO USER 
      DEF IDL02     3  CNTL, RELEASE THE BUFFER & RETURN TO USER
      DEF IDL00     4  BUF. WRITE, RELEASE BUFFER & FORGET
      DEF IDL00     5  BUF. CNTL, RELEASE BUFFER & FORGET 
      DEF IDL04     6  CB ENABLE, RELEASE DUMMY BUF. & RETURN TO USER 
      DEF IDL04     7  CB DISABLE, RELEASE DUMMY BUF. & RETURN TO USER
      DEF IDL06     8  SB CALL, RELEASE DUMMY BUF. & RETURN TO USER 
      DEF IDL04     9  CB DEF., RELEASE DUMMY BUF. & RETURN TO USER 
      DEF IDL06     10 SB RTN, RELEASE DUMMY BUF. & RETURN TO USER
      DEF WRRQ      11 WRITE-READ, DO THE READ
      DEF IDL04     12 PAUSE, RELEASE DUMMY BUF. & RETURN TO USER 
      DEF IDL06     13 SUB-PROCESS
      DEF ILRQ      14 CHANGE CB LENGTH 
      DEF ILRQ      15 SET/RESET STP-INHIBIT FLG (NEVER GET HERE) 
      DEF IMULK     16 UNLCK-IMAGE FUNCTION 
      DEF ABTX      17 ABORT TMS (RQ FORM 'TMSL') 
      DEF SPR00     18 PROCESS LAUNCH FROM 'TMSL' 
      DEF PAUS0     19 TIMER INTERRUPT
      DEF STPX      20 STOP TMS (RQ FROM 'TMSL')
      DEF MSU50     21 MEMORY SUSPEND OPERATION 
      DEF ILRQ      22 SPECIAL DEFINE OPCODE (NEVER GET HERE) 
      DEF IMRTN     23 IMAGE REQUEST RETURN 
      DEF LOGRT     24 LOGGING REQUEST COMPLETED
      DEF TMSPX     25 STOP TMS IN PROGRESS 
      DEF STPY      26 TMS "SOFT ABORT" (FROM TMSL) 
  SPC 2 
DM900 DEC -900
DM120 DEC -120
DM25  DEC -25 
DM23  DEC -23 
DM21  DEC -21 
DM8   DEC -8
DM6   DEC -6
DM5   DEC -5
DM4   DEC -4
DM3   DEC -3
DM2   DEC -2
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
D13   DEC 13
D14   DEC 14
D16   DEC 16
D17   DEC 17
D26   DEC 26
D38   DEC 38
D450  DEC 450 
D500  DEC 500 
D1024 DEC 1024
D19   DEC 19
D20   DEC 20
D21   DEC 21
D22   DEC 22
D24   DEC 24
D40   DEC 40
* 
DFNS# EQU D9
CBOVH EQU D5
BIT15 OCT 100000
   HED  ***  BUFFER EXCHANGED BETWEEN  TMLIB & TMSYS  *** 
*                   BUFFER RECEIVED FROM TMLIB
*                     IDENTIFY THE TMS REQUEST THAT MUST BE EXECUTED
  SPC 1 
LCLAS NOP           CLASS I/O USED BY THE PRG. TO SUSP. ITSELF
.PAR1 NOP           USER PARAMETERS VALUE ARE RECIEVED HERE 
.PAR2 NOP 
.PAR3 NOP 
.PAR4 NOP 
.PAR5 NOP 
.PAR6 BSS 10
RQCNT NOP 
XSUSP NOP 
SCOD. NOP           SUBROUTINE CODE RETURNED BY TMLIB 
RTRN. NOP           RETURN ADDR IN THE USER PARTITION 
  SPC 1 
PARLN EQU RTRN.-LCLAS+1 
  SPC 2 
*                   BUFFERS SEND BY TMSYS TO TMLIB
*                     DEFINE ALL CLASS I/O WORD TO BE USED, 
*                     DEFINE THE CB LOCAL ADDR & LENGTH,
*                     AND GIVE SOME USEFUL INFORMATION TOO
  SPC 1 
*                   5 PARAMETERS SEND AS PRG PARAMETERS 
  SPC 1 
LU    NOP           LU USED TO START THE TMS APPLICATION
CLASS NOP           TMS EXTERNAL CLASS I/O WORD 
MCLAS NOP           TMS MAIN CLASS I/O WORD 
ICLAS NOP           TMS INTERNAL CLASS I/O WORD 
CLAS0 NOP           TMS CB0 SPECIAL CLASS I/O WORD
  SPC 2 
*                   BUFFER PASSES USING THE STRING PASSING FEATURE
  SPC 1 
SCODE OCT 0         TMS INTERNAL SUBR. CODE SEND BACK TO COMPLETE THE RQ
FMPCL NOP           TMS-FMP CLASS I/O WORD
LEN0  NOP           CURRENT CB0 LENGTH
#DFCB NOP           MINUS # OF DEFINED CB'S 
EPAOS NOP           'ENTRY POINT ADDR OF SUBROUTINE'
RTRNA NOP           RETURN ADDR / ABORT CODE
RNLCK NOP           RN# USED BY LURQ
STKPT OCT 100001    STACK POINTER 
LGCLA BSS 5         DCLOG CLASS IO NUMER
FPARM BSS 3         FUNCTION PARAMETERS (3 WORDS) 
      BSS 11        CB'S DEFINITION 
PARLG EQU *-SCODE 
URNST BSS 19        RUN STRING PASSED BY SCHEDULING PROG, FOR USE 
*                        USER 
      OCT 0 
  SPC 1 
PARL2 EQU *-SCODE 
#FPAR EQU D3
  SPC 1 
BUF   BSS 50
  SKP 
      UNS 
  SPC 3 
      ORG * 
      END 
                                                