ASMB
    HED .           T    M    S            H    E    A    R    T
      NAM $MTMS,7 92903-16100 REV.1913  781215
  SPC 3 
**********************************************************************
*                                                                    *
*     NAME:   $MTMS     HEART OF TMS                                 *
*     SOURCE: &$MTMS    92903-18102                                  *
*     BINARY: %$MTMS    ----NONE---    PART OF  %TMSLB  92903-16100  *
*                                                                    *
*     PGMR:   FRANCOIS GAULLIER                                      *
*                                                                    *
**********************************************************************
      SPC 2 
*     **************************************************************
*     * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978.  ALL RIGHTS    *
*     * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- *
*     * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH-  *
*     * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.  *
*     **************************************************************
  SPC 3 
      ENT $MTMS,.MGT0 
      EXT $TMSA,.EMAP,.EMIO,BITSR,BITST,ERR0
      EXT .MGTG,.MGTR,#REQU 
      EXT EXEC,LURQ,$CVT3,$LIBR,$LIBX 
      EXT .ENTR,$TIME,IDGET,KLCLS,NRCLS,PNAME,RMPAR 
      EXT DORMT,.UPIO,MESSS,.LURQ 
  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 
.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 
* 
      LDA BUF       RECALL FIRST PARAM (LU) 
      SZA,RSS       DEFAULT LU IS 1 
      INA 
      STA BUF 
      STA LU        SET CONSOLE LU
  SPC 1 
   IFZ
      JSB .DBUG     CALL DBUG: INTERNAL USE ONLY !!!!!!!!!!!!!!!!!!!!!
      EXT .DBUG     CALL DBUG: INTERNAL USE ONLY !!!!!!!!!!!!!!!!!!!!!
  XIF 
  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
      HLT 10B       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 
      DLD LUXXX,I   LOGGING REQUIRED
      SZB,RSS 
      JMP STA40     NO LOGGING
* 
      STB LULOG     SET LU OF LOG DEVICE
* 
      LDA LULOG     UP THE DEVICE IF
      JSB .UPIO     IS WAS DOWN 
      JMP LOGAB     CAN'T UP DEVICE !, ABORT TMS APPLICATION
      STA TEMP      RETURN OK, SAVE EQT # 
      LDA B         GET EQT5 TO CHECK THE DVR TYPE
      AND LBYTE     ISOLATE EQUIPEMENT TYPE 
      CPA O114C     DVR 23 ?
      JMP STA36     YES, OK 
LOGAB LDA D3        NO, PRINT ERROR MESS: "LOGG. DOWN OR LOCKED"
      JSB LOGER     AND ABORT THE TMS APPLICATION 
* 
STA36 JSB LURQ      LOCK THE DEVICE TO THAT PROGRAM 
      DEF *+4 
      DEF IOPTN     LOCK/NO WAIT/NO ABORT/
      DEF LULOG     LU
      DEF D1        NUMBER OF LU
      HLT 11B       ERROR RETURN
      SZA           LOCK OK ? 
      JMP LOGAB     NO, ABORT TMS 
* 
      LDA TEMP      RECALL EQT #
      CLB           TO 'UNBUFFERED' THE LOG DEVICE
      DIV D10       SO THE COMPLETION OF THE WRITE
      ALF,ALF       MEANS THAT THE PHYSICAL WRITE IS COMPLETE 
      ADA B         CONVERT EQT # INTO ASCII
      ADA =A00      TO BUILD THE COMMAND
      STA UNBMS+2   " EQ,XX,UN "
      JSB MESSS     CALL THE SYSTEM PROCESSOR 
      DEF *+3       TO UNBUF THE DEVICE 
      DEF UNBMS 
      DEF D10 
* 
      JSB OPLOG     'OPEN' THE LOGG DEVICE
   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 LDB IMRQ2     DBOPEN IS SUCCESSFULL 
      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 - 
      INA           MAX ITEM LN - MAX ENTRY LEN 
      MVW D4        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
   HED .   CONSTANT, VARIABLE AND UTILITIES FOR THE START-UP PHASE
IOPTN OCT 140001    LU LOCK/NO WAIT/NO ABORT
O200  OCT 200 
O72   OCT 72
O40   OCT 40
@APLN DBL APLNM 
O100  OCT 100 
O377  OCT 377 
O400  OCT 400 
D26   DEC 26
LBYTE OCT 177400
O114C OCT 11400 
BIT13 OCT 20000 
D1024 DEC 1024
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 & DB# - PID (LOCKIDW) 
      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
      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 D13       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
      SZA,RSS       IMAGE REQUEST OK ?
      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 CLA,INA       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) 
*                   8 WORDS PER ENTRY 
* 
*     3 WORDS -  TMS-IMAGE-MODULE NAME
*     1 WORD  -  INITIAL LOCKIDWORD   ( DB# / PID ) 
*                                BIT  15-13 / 12-0
*     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+8
      DEF .DB1+16 
      DEF .DB1+24 
* 
.DB1  EQU * 
      REP 32
      DEC 0 
  SPC 2 
IMBF  BSS 13        BUFFER SEND TO TMS-IMAGE-MODULE 
D13   DEC 13
  SPC 2 
OPLOG NOP           'OPEN' THE LOGG DEVICE
      ISZ REEL#     BUMP MAG-TAPE REEL NUMBER 
* 
OPLO2 JSB .OPLO+1   CHECK IF DEVICE OK
      JSB LOGER     DEVICE IS NOT OK, REPORT ERROR
      LDA DM120     WAIT FOR 30 SECONDS 
      LDB .OPLO     BUT CHECK EVERY 250 MS
      JSB WAIT
      JMP OPLO2     RE-ISSUE THE ERROR MESSAGE
  SPC 1 
.OPLO DEF *+1 
      NOP 
      LDA LULOG     CHECK THAT THE DEVICE IS READY AND OK 
      IOR O400      SET 'REWIND' FUNCTION CODE
      STA TEMP
      IOR O200      SET 'DYNAMIC STATUS' FUNCTION CODE
      STA TEMP1 
* 
      JSB EXEC      DO A DYNAMIC STATUS 
      DEF *+3       TO CHECK THAT THE DEVICE IS ON LINE 
      DEF D3
      DEF TEMP1 
      SLA           DEVICE ON LINE ?
      JMP OPLO6     NO, REPORT ERROR
* 
      JSB EXEC      DO THE REWIND 
      DEF *+3 
      DEF D3        CONTROL RQ
      DEF TEMP
* 
OPLO5 JSB EXEC      DO THE DYNAMIC STATUS 
      DEF *+3 
      DEF D3        CONTROL RQ
      DEF TEMP1 
      STA TEMP      SAVE STATUS 
      AND O100      ISOLATE TAPE AT LOAD POINT BIT
      SZA,RSS       TAPE AT LOAD POINT ?
      JMP OPLO5     NO, WAIT UNTIL TAPE AT LOAD POINT 
      LDA TEMP      YES, RECALL STATUS
      AND O377      AND ISOLATE STATUS TO CHECK WRITE ENABLE ...
      CPA O100      STATUS OK ? 
      JMP OPLO8     YES, WRITE TAPE HEADER AND EXIT 
* 
      CLA,RSS       REPORT "NO WRITE RING" ERROR
OPLO6 CLA,INA       REPORT "DEVICE OFF LINE" ERROR
      JMP .OPLO+1,I EXIT CHECK MODULE TO REPORT ERROR 
  SPC 1 
OPLO8 LDB OPLO4     INIT HEADER BUFFER
      LDA D16 
      STA B,I       SET RECORD LENGTH 
      INB 
      STB OPLO9     SET ADDR. FOR TIME STAMP
      ADB D5        LEAVE ROOM FOR TIME 
      STB OPLO9+1   SET ADDR. FOR YEAR
      INB 
      LDA REEL#     SET MAG-TAPE REEL NUMBER
      STA B,I 
      INB 
      LDA .LOGH     MOVE HEADER INTO THE BUFFER 
      MVW D8
* 
      JSB EXEC      GET TIME STAMP FROM THE SYSTEM
      DEF *+4 
      DEF D11 
OPLO9 BSS 2         BUFFER ADDR 
* 
      JSB EXEC      WRITE ON THE MAG-TAPE 
      DEF *+5       THE MAG-TAPE LOGGING HEADER 
      DEF D2        WRITE 
      DEF LULOG     LU
OPLO4 DEF BUF+10    BUFFER
      DEF D16       BUFFER LENGTH 
      JMP OPLOG,I 
* 
REEL# DEC 0         LOGGING MAG-TAPE REEL NUMBER
.LOGH DEF *+1       DO NOT MIX UP FOLLOWING WORDS 
      ASC 5,TMS LOGG. 
APLNM BSS 3 
D5    DEC 5 
D16   DEC 16
DM120 DEC -120
  SPC 2 
CLLOG NOP           'CLOSE' THE LOGG DEVICE 
      LDA LULOG     RECALL LOGG LU
      ADA O100      WRITE AN EOF AND REWIND STANDBY 
      STA TEMP
      ADA O400
      STA TEMP1 
      JSB EXEC      WRITE EOF 
      DEF *+3 
      DEF D3
      DEF TEMP
      JSB EXEC      REWIND STANDBY
      DEF *+3 
      DEF D3
      DEF TEMP1 
      JMP CLLOG,I 
  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 
      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 
                                                                                    