ASMB,R,L,C        RTMG2 
*     NAME:   RTMG2 RTE-M SEGMENTED GEN.-LOADER (SEGMENT 6) 
*     SOURCE: 91740-18051 
*     RELOC:  91740-16051 
*     PGMR:   MIKE SCHOENDORF 
* 
*  ***************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977.  ALL RIGHTS     *
*  * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,      *
*  * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT*
*  * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.       *
*  ***************************************************************
* 
* 
      HED  RTE-M SYSTEM GENERATOR-LOADER
      NAM RTMG2,5 91740-16051 REV 2013 800129 
* 
* 
A     EQU 0 
***************** - HIGH CORE - ******************
*                                                *
*                    - IDENTS -                  *
*                                                *
**************************************************
*                 - FIXUP TABLES -               *
*                    ----------                  *
*                                                *
*                                                *
*                     -------                    *
*                     - LST -                    *
**************************************************
*                                                *
*                                                *
*           PROGRAM LOADING CONTROL              *
*                                                *
*                                                *
**************************************************
*                                                *
* 
*               I/O TABLE GENERATION             *
* 
*                                                *
**************************************************
*                                                *
*                                                *
*                  PARAMETER INPUT               *
*                                                *
*                                                *
**************************************************
* 
* 
* 
      SKP 
* 
* 
* 
* 
* 
*  RTMGN PROGRAM TABLE FORMAT (IDENTS)
* 
*  WORD 1:  IP1 - NAME  1,2 
*  WORD 2:  IP2 - NAME  3,4 
*  WORD 3:  IP3 - NAME  5,SC
* 
*          SC = 0  PROGRAM HAS BEEN LOADED
*             = XX (OCTAL) INT PRG
* 
* 
*  LST FORMAT 
* 
*  WORD 1: LST1 - NAME 1,2
*  WORD 2: LST2 - NAME 3,4
*  WORD 3: LST3 - NAME 5, ORDINAL 
*  WORD 4: LST4 - IDENT ADDRESS 
*  WORD 5: LST5 - BP LINK ADDRESS 
* 
* 
* 
*  ENTERNS AND EXTERNS
* 
* 
* 
      EXT ADDRS,ABRT1,BPLOC,CLFL2,CONSO 
      EXT DCB2,ER#OR,EXEC6,IN#CK,KONSO
      EXT LENGT,LNKDR,LST4,LSTUL
      EXT MAPS,.MEM1,.MEM2
      EXT .MEM3,.MEM4,.MEM5,.MEM6,MLOCC,OPT.3 
      EXT PLK4,PLK,PLKS,PRINT 
      EXT SSTBL,TIMES 
      EXT ?XFER 
* 
      EXT AINT#,ALBUF,BIDNT,CURAT 
      EXT DO#ON,ELIB,GBUF,GE#AL,GE#NA 
      EXT GE#OC,GI#IT,GNSG2,GREAD,GTIME 
      EXT IDNOS,IDS,IDSAD,IN#RR 
      EXT INTER,IP1,IP2,IP3 
      EXT KEYCN,LWACG,LWAMG,LWSA1 
      EXT MATA,MAXPT,MPFT 
      EXT MRMP,MSIZE,OC#NO
      EXT PARNO,PCOM,PGLIB,PLIB,PNAMA,PNZQZ,PP#EL 
      EXT PRIN1,PRIN2,PROCT,RANAD,REL06,RELOC 
      EXT RTMLI,SAVE2,SG1AD,SP#CE,SSGAP,START 
      EXT STRAD,STRPN,SYSAD,SYSTM,TBUF#,TCNT,WDCNT
* 
      EXT $OPSY 
      EXT DU#MY 
* 
* 
* 
ERROR EQU ER#OR 
INDCK EQU IN#CK 
AINT  EQU AINT# 
DOCON EQU DO#ON 
GETAL EQU GE#AL 
GETNA EQU GE#NA 
GETOC EQU GE#OC 
GINIT EQU GI#IT 
INERR EQU IN#RR 
LOCC  EQU MLOCC 
OCTNO EQU OC#NO 
PPREL EQU PP#EL 
SPACE EQU SP#CE 
TBUF  EQU TBUF# 
FTIME EQU GTIME 
LBUF  EQU GBUF
READ  EQU GREAD 
* 
* 
* 
* 
*    .MEM. TABLE DEFINITIONS
* 
*       .MEM1 = FWABP 
*       .MEM2 = LWABP 
*       .MEM3 = FWAM
*       .MEM4 = LWAM
*       .MEM5 = FWAC
*       .MEM6 = LWAC
* 
* 
* 
*  ERROR CODES
* 
*  AD: INVALID ENTRY POINT
*  CH: INVALID CHANNEL NUMBER 
*  DR: INVALID DRIVER NAME
*  DU: DUPLICATE PROGRAM NAME 
*  EQ: INVALID EQT. NO. IN INT. RECORD
*  IN: PARAMETER INTERVAL EXECUTION ERROR 
*  LU: INVALID DEVICE REFERENCE NUMBER
*  ON: INVALID ON PARAMETER 
*  NA: PARAMETER NAME ERROR 
*  PA: PARAMETER ERROR
*  PD: PARTITION ALREADY DEFINED
*  PR: PARAMETER PRIORITY ERROR 
*  PS: NOT ENOUGH MEMORY LEFT FOR PARTITION 
*  PT: PARTITION DEFINITION ERROR 
*  SO: SYSTEM OVERFLOW
*  TB: SYMBOL TABLE/ID SEGMENT OVERFLOW 
* 
* 
      SUP 
      SKP 
RTMG2 NOP 
      NOP 
      LDA IDAA      REMOVE
      JSB INDCK 
      STA IDAA          INDIRECT
      LDA STRPA 
      JSB INDCK             ADDRESSES 
      STA STRPA 
      LDA PATBL                 FOR 
      JSB INDCK 
      STA PATBL                     DEFS
      LDA APNAM 
      JSB INDCK 
      STA APNAM 
      LDA GNSG2     WHERE GO FLAG 
      SZA,RSS 
      JMP REL06     RET  TO SEG. THAT CALLED LDR. SUBCONTROL
      CPA P1
      JMP RTMG4     FIRST ENTRY IN GEN SEG 2
      CPA P2
      JMP RTMG7     RELOCATE RESIDENT LIBRARY 
      JMP RTMGS     RETURN FROM SNAP OUTPUT 
* 
      HED ** SYSTEM BASE PAGE COMMUNICATION AREA ** 
*** SYSTEM BASE PAGE  COMMUNICATION  AREA *** 
* 
* 
* SYSTEM TABLE DEFINITION * 
* 
.     EQU 1650B 
KEYWD DEF .+7       FWA  OF  KEYWORD BLOCK
* 
* DEFINITION OF SYSTEM LISTS (QUEUES) * 
* 
SKEDD DEF .+33      'SCHEDULE' LIST,
* 
* DEFINITION OF MEMORY ALLOCATION BASES * 
* 
BPA1  DEF .+58      FWA USER BP LINK AREA 
LBORG DEF .+61      FWA OF RESIDENT LIBRARY AREA
RTORG DEF .+62      FWA OF REAL-TIME COMMON 
RTCOM DEF .+63      LENGTH OF REAL TIME COMMON AREA 
AVMEM DEF .+65      LWA+1 MEMORY REAL TIME PARTITION
BGORG DEF .+66      FWA OF BACKGROUND COMMON
* 
* UTILITY PARAMETERS
* 
BGLWA DEF .+87      LWA MEMORY BACKGROUND PARTITION 
      SKP 
* 
*  ROUTINE TO RESERVE AND SET CORE   ON THE 
*  LOADER PRODUCED ABSOLUTE OUTPUT. 
* 
*  CALLING SEQUENCE:
*    A = FINAL STARTING ADDRES
*    B = FINAL ENDING ADDRESS 
* 
*    SETAD = ADDRESS OF THE OUTPUT DATA BUFFER
* 
*    JSB SETCR
* 
*  RETURN: A AND B ARE DESTROYED
* 
SETCR NOP 
      STA TEMP1 
      CMA,INA 
      ADA ALBUF     BUFFER ADDRESS
      STA PLKS      OFFSET ADDRESS
      LDA TEMP1     STARTING ADDRESS
      STA PLK4
      JSB PLK       OUTPUT ROUTINE IN THE LOADER
      JMP SETCR,I 
* 
* 
* 
*  SUBROUTINE TO DETERMINE IF ANSWER IS YES OR NO 
* 
MAYBE NOP 
      JSB READ      PRINT MESSAGE, GET REPLY
      LDA N2        GET FIRST TWO ASCII CHARACTERS
      JSB GETNA 
      CCB 
      CPA NO        NO? 
      CLB           YES 
      CPA YE        YES?
      CLB,INB       YES 
      SSB,RSS 
      ISZ MAYBE 
      SSB 
      JSB INERR     PARMETER ERROR
      JMP MAYBE,I 
* 
NO    ASC 1,NO
YE    ASC 1,YE
* 
N2    DEC -2
      SKP 
* 
* 
* 
*  THE BUFCL SUBROUTINE STUFFS A 64 WORD BUFFER WITH CALL+1 
* 
*  CALLING SEQUENCE:
*    A = IGNORED
*    B = ADDRESS OF BUFFER
*    JSB BUFCL
*    CALL+1 = DATA TO BE STUFFED
* 
*  RETURN: CONTENTS OF A AND B ARE DESTROYED. 
* 
BUFCL NOP 
      LDB ALBUF 
      LDA N64 
      STA WDCNT     SET BUFFER LENGTH = 64
      LDA BUFCL,I    GET STUFF DATA 
      STA 1,I       CLEAR BUFFER WORD 
      INB 
      ISZ WDCNT     ALL WORDS CLEAR?
      JMP *-3       NO - CONTINUE CLEARING
      ISZ BUFCL 
      JMP BUFCL,I   RETURN
* 
N64   DEC -64 
      SPC 5 
* 
*  SUBROUTINE TO CLEAR THE OUTPUT BUFFER
* 
BUFC  NOP 
      JSB BUFCL 
      OCT 0 
      JMP BUFC,I
      SKP 
* 
*  ROUTINE TO COMPARE TWO NAME BUFFERS
* 
* 
*  CALLING SEQUENCE:
*    A = ADDRESS OF SOURCE NAME- 3 ENTRIES
*    B = ADDRESS OF TABLE 3 ENTRIES 
*    JSB NACMP
* 
*  RETURN: A AND B ARE DESTROYED
*    (N+1) NAMES DO NOT COMPARE 
*    (N+2) NAMES COMPARE
* 
NACMP NOP 
      STA TEMP1     SAVE SOURCE ADDRESS 
      STB TEMP2     SAVE TABLE ADDRESS
      LDA N2        LOOP COUNT
      STA TEMP3 
NACM1 LDA TEMP1,I   SOURCE ENTRY
      CPA TEMP2,I   TABLE COMPARE 
      RSS           YES,COMPARE, LOOK NEXT
      JMP NACMP,I   NO IT DOESN'T RETURN
      ISZ TEMP1     BUMP SOURCE 
      ISZ TEMP2     BUMP TABLE
      ISZ TEMP3 
      JMP NACM1     TRY AGAIN 
      LDA TEMP2,I   FIRST TWO COMPARE, LOOK LAST
      AND M400      LOOK UPPER ONLY 
      STA 1 
      LDA TEMP1,I 
      AND M400
      CPA 1 
      ISZ NACMP     BUMP RETURN FOR COMPARE!
      JMP NACMP,I 
* 
M400  OCT -400
TEMP1 NOP 
TEMP2 NOP 
TEMP3 NOP 
      SKP 
* 
* 
* 
*  SUBROUTINE TO RESERVE AND SET CORE 
* 
*  CALLING SEQUENCE:
*    A = DATA TO BE OUTPUT
*    B = ADDRESS OF DATA
*    JSB STCR1
* 
*  RETURN:
*    A = DATA WORD OUTPUTTED
* 
STCR1 NOP 
      STA LBUF      SAVE DATA TO BE OUTPUT
      LDA 1         SET A REG TO ADDRESS
      JSB SETCR     GO OUTPUT IT
      LDA LBUF      GET DATA
      JMP STCR1,I 
      SPC 5 
      SKP 
* 
*  SUBROUTINE TO GET THE ADDRESS OF THE FOLLOWING ENTRIES 
*  IN THE LST, TO SET THEM TO THEIR PROPER VALUE, AND TO
*  OUTPUT THEM. 
* 
STUFF NOP 
      STA LBUF      SAVE VALUE OF ENTRY 
      JSB SSTBL     FIND IN LST 
      JMP ABRT1     ISN'T THERE, START OVER 
      LDA LST4,I    GET ADDRESS 
      LDB 0 
      JSB SETCR     GO OUTPUT VALUE 
      JMP STUFF,I 
* 
*  THE 3 WORD PROGRAM NAME IS PUT INTO THE RTMGN PROG 
*  TABLE. THE NAMES ARE LOADED FROM THE TOP DOWN. 
* 
*  CALLING SEQUENCE:
*    A = ADDRESS OF PROGRAM NAME
*    B = IGNORED
*    JSB LDIPX
* 
*  RETURN:  A AND B ARE DESTROYED 
* 
LDIPX NOP 
      STA IPXSV     SAVE PROG NAME ADDRESS
      JSB INIPX     INITIALIZE TO START OF TABLE
      LDA PROCT      NUMBER OF ENTRIES
      ALS            MULT X2
      ADA PROCT      PLUS ONE TO MAKE IT X3 
      CMA,INA 
      ADA BIDNT      BUILD NEXT NAME ADDRESS
      STA BIDNT      FOR SAVE 
      JSB IPX       INITIALIZE IP POINTERS
      LDA IPXSV,I   GET N1-N2 
      STA IP1,I     PUT IN TABLE
      ISZ IPXSV     BUMP POINTER
      LDA IPXSV,I   GET N3-N4 
      STA IP2,I     SAVE
      ISZ IPXSV 
      LDA IPXSV,I   GET N5-XX 
      STA IP3,I     SAVE
      ISZ PROCT     BUMP NUMBER OF NAMES
      JMP LDIPX,I   RETURN
* 
IPXSV NOP           PROGRAM NAME ADDRESS
* 
      SKP 
* 
*  INIPX SETS THE ADDRESS OF THE FIRST ENTRY IN THE 
*  PROGRAM IDENT TABLE AS THE CURRENT ADDRESS.
* 
* 
*  CALLING SEQUENCE:
*    A = IGNORED
*    B = IGNORED
* 
*  RETURN:  A AND B DESTROYED 
* 
INIPX NOP 
      LDA LWAMG 
      ADA N2
      STA BIDNT 
      JMP INIPX,I 
* 
* 
* 
*  THE IPX ROUTINE ADDRESSES THE CURRENT 3 WORD ENTRY 
*  IN THE INTERRUPT PROGRAM TABLE FROM THE ADDRESS OF 
*  THE CURRENT ENTRY (BIDNT). THE TABLE START ADDRESS 
*  IS LWAM. 
* 
*  CALLING SEQUENCE:
*    A = IGNORED
*    B = IGNORED
*    JSB IPX
* 
*  RETURN, CONTENTS OF A AND B ARE DESTROYED
* 
IPX NOP 
      LDA BIDNT     BUILD POINTERS
      STA IP1 
      INA 
      STA IP2 
      INA 
      STA IP3 
      ADA N5
      STA BIDNT 
      JMP IPX,I 
* 
* 
N5    DEC -5
      SKP 
* 
      SKP 
*                                   CONVERT A TO ASCII AT B 
* 
*  THE CONVD SUBROUTINE CONVERTS THE CONTENTS OF A
*  INTO ASCII (DECIMAL OR OCTAL) AT THE LOCATION SPECIFIED
*  BY B.  THE CONVERTED RESULT REQUIRES 3 WORDS, AND IS 
*  IN THE FORMAT:  XXXXX, WITH A SPACE IN THE FIRST POSITION. 
* 
*  CALLING SEQUENCE:
*    A = NO. TO BE CONVERTED.  IF THE SIGN OF A IS POS.,
*        THE CONVERSION IS TO BE IN OCTAL;  IF NEGATIVE,
*        IN DECIMAL.
*    B = ADDRESS OF CORE LOCATION FOR CONVERTED RESULT
*    JSB CONVD
* 
*  RETURN: CONTENTS OF A AND B ARE DESTOYED.
* 
CONVD NOP 
      STB CURAT     SET MESSAGE ADDRESS 
      LDB OPWRS     GET ADDR OF OCTAL POWERS
      SSA           SKIP IF OCTAL CONV REQUIRED 
      LDB DPWRS     GET ADDRESS OF DECIMAL POWERS 
      STB RANAD     SET POWER RANGE ADDRESS 
      SSA,RSS       SKIP IF NEGATIVE (DECIMAL)
      CMA,INA       CONVERT NUMBER TO NEGATIVE
      STA 1         PUT NUMBER IN B (REMAINDER) 
      LDA N2
      STA TCNT      SET CONVERSION COUNTER
      JSB GETD      GET FIRST DIGIT 
      IOR B20K      ADD BLANK TO FIRST CHAR 
      STA CURAT,I   SAVE FIRST BLANK, CHARACTER 
      ISZ CURAT     INCR MESSAGE ADDRESS
NEXTD JSB GETD      GET NEXT DIGIT
      ALF,ALF       ROTATE TO UPPER 
      STA CURAT,I   SAVE UPPER CHARACTER
      JSB GETD      GET NEXT DIGIT
      IOR CURAT,I   ADD UPPER CHAR
      STA CURAT,I   SAVE NEXT 2 CHARACTERS
      ISZ CURAT     INCR MESSAGE ADDRESS
      ISZ TCNT      SKIP - 5 DIGITS IN
      JMP NEXTD     NO - CONTINUE WITH NEXT DIGIT 
      JMP CONVD,I   YES - RETURN
* 
B20K  OCT 20000 
      SKP 
* 
* 
DPWRS DEF *+1 
      DEC 10000 
      DEC 1000
      DEC 100 
      DEC 10
P1    DEC 1 
OPWRS DEF *+1 
      OCT 10000 
      OCT 1000
      OCT 100 
      OCT 10
      OCT 1 
* 
      SKP 
      SKP 
* 
*  GETD PROVIDES THE ASCII CHARACTERS FOR CONVD.
* 
*  CALLING SEQUENCE:
*    A = IGNORED
*    B = REMAINDER
*    JSB GETD 
* 
*  RETURN:
*    A = ASCII DIGIT
*    B = IGNORED
* 
GETD  NOP 
      CLA 
INCRA ADB RANAD,I   ADD POWER 
      CMB,SSB,INB,SZB   SKIP - TRY NEXT HIGHER DIGIT
      JMP *+4       DIGIT FOUND 
      INA           INCR DIGIT
      CMB,INB       RESTORE REMAINDER TO NEGATIVE 
      JMP INCRA     TRY HIGHER DIGIT
      ADB RANAD,I   ADD POWER 
      CMB,INB       RESTORE REMAINDER 
      ISZ RANAD     INCR POWER LIST ADDRESS 
      IOR B60       CONVERT TO ASCII
      JMP GETD,I    RETURN WITH DIGIT IN A
* 
B60   OCT 60
* 
      SKP 
* 
*  GET PAGE NUMBER
* 
PAGE  NOP 
      AND B76K      GET PAGE BITS 
      ALF           SHIFT TO BITS 0 - 5 
      RAL,RAL 
      JMP PAGE,I
* 
B76K  OCT 76000 
      SPC 5 
* 
*  THIS ROUTINE WILL OUTPUT A 31 WORD BLOCK FROM THE
*  I/O BUFFER AREA. 
* 
*  CALLING SEQUENCE:
*    A = ABS STARTING ADDR
*    B = IGNORED
*    JSB GENID
* 
*  RETURN: A AND B ARE DESTROYED
* 
OUTID NOP 
      LDB A 
      ADB P30       SET LAST ADDRESS
      JSB SETCR     GO SET CORE 
      JMP OUTID,I   RETURN
* 
      SKP 
*  THIS ROUTINE WILL BUILD AN ID SEGMENT IN THE OUTPUT
*  BUFFER (LBUF) AREA. THE BUFFER IS CLEARED AND STUFFED
*  WITH DATA (FROM THE PNAME TABLE) BEFORE BEING OUTPUT 
*  BY THE OUTID ROUTINE.
* 
*  CALLING SEQUENCE:
*    A = ABSOLUTE ADDRESS OF SEGMENT
*    B = LIST LINK ADDREESS TO NEXT SEGMENT 
*    JSB GENID
* 
* 
*  RETURN: A AND B ARE DESTROYED
* 
GENID NOP 
      STA IDSAV 
      STB LNKSV 
      JSB BUFC      CLEAR BUFFER
      LDA LNKSV     GET LINK ADDRESS
      STA LBUF      PUT IN BUFFER 
      LDA PNZQZ+7   GET PRIORITY
      SZA,RSS 
      LDA P9999     DEFAULT TO 9999 
      STA LBUF+6
      LDA ?XFER     ENTRY POINT 
      STA LBUF+7
      LDA IDSAV     ADDRESS OF WORD 2 OF
      INA           ID SEGMENT
      STA LBUF+10 
      LDA PNZQZ     NAME 1,2
      STA LBUF+12 
      LDA PNZQZ+1   NAME 3,4
      STA LBUF+13 
      LDA PNZQZ+2   NAME 5, BLNK
      AND M400      MASK OUT BLANK
      INA           MAKE TYPE 1 
      STA LBUF+14 
      LDA PNZQZ+8   RESOLUTION
      ALF,ALF 
      ALF,RAL       SHIFT INTO PLACE
      IOR PNZQZ+9   MERGE EXEC MULT 
      STA LBUF+17   PUT IN BUFFER 
      JSB TIMES     PROCESS TIME PARAMETERS 
      STA LBUF+18 
      STB LBUF+19 
      LDA .MEM3     LOW MAIN
      STA LBUF+22 
      LDA LOCC      HIGH MAIN 
      STA LBUF+23 
      LDA .MEM1     LOW BASE
      STA LBUF+24 
      LDA BPLOC     HIGH BASE 
      STA LBUF+25 
      LDA LOCC      UPDATE FWAM 
      STA .MEM3     FWAM
      LDA BPLOC     UPDATE FWABP
      STA .MEM1     FWABP 
      LDA IDSAV     ABS ADDRESS 
      JSB OUTID     GO OUTPUT ID SEGMEMT
      JMP GENID,I   RETURN
* 
IDSAV NOP           ABSOLUTE ADDRESS OF SEGMENT 
LNKSV NOP           LINK ADDRESS TO NEXT SEGMENT
* 
P9999 DEC 9999
* 
      SKP 
* 
*      SEARCH RTMGN PROG TABLE
* 
*  THIS IS A MULTIPLE ENTRY ROUTINE WHICH WILL EITHER 
*  SEARCH FOR A NAME OR CONTINUE FROM THE LAST FIND.
* 
*  CALLING SEQUENCE:
*    A = ADDRESS OF NAME (3WORD)
*    B = IGNORED
*    JSB SRIPX
* 
*  RETURN:
*    (N+1) PROGRAM NAME WAS FOUND IN TABLE, IN IP1-3
*    (N+2) REACHED THE END OF THE PROGRAM TABLE 
* 
SRIPX NOP 
      LDB WDCNT     SEARCH OR CONTINUE? 
      SZB 
      JMP SRIP1     CONTINUE
      STA SRISV     INIT SEARCH 
      JSB INIPX     SET UP IP POINTERS
      LDA PROCT     NUMBER OF ENTRIES 
      CMA 
      STA WDCNT     SAVE FOR LOOPING
SRIP1 ISZ WDCNT     ALL DONE? 
      JMP *+3       NO, GO COMPARE NAMES
      ISZ SRIPX     YES, BUMP RETURN
      JMP SRIPX,I 
      JSB IPX       SET POINTERS
      LDB IP1       NAME IN TABLE 
      LDA SRISV,I   LOOK FOR NAME 
      JSB NACMP     GO COMPARE
      JMP SRIP1     DOSN'T COMPARE, LOOK NEXT 
      JMP SRIPX,I   DOES COMPARE, RETURN
* 
SRISV NOP 
IDAA  DEF *+1 
ID5   NOP           PRIORTY 
ID6   NOP           RESOLUTION CODE 
ID7   NOP           EXEC. MULTIPLE
ID8   NOP           HOURS 
ID9   NOP           MINUTES 
ID10  NOP           SECONDS 
ID11  NOP           TENS OF MILLISECONDS
* 
M20K  OCT -20000
*                                   SET PARAMETERS
      SKP 
* 
*  THE PARAMETER INPUT SECTION PERMITS ALTERATION (OR INTRODUCTION) 
*  OF THE NAME, PRIORITY, AND EXECUTION INTERVAL FOR EACH PROGRAM.
*  EACH PARAMETER RECORD HAS ONE OF THE FOLLOWING FORMATS:
* 
*    NAME 
*    NAME,PRIORITY
*    NAME,PRIORITY,EXECUTION INTERVAL 
* 
*  PRIORITY = 5 DECIMAL DIGITS (1-32767)
*  EXECUTION INTERVAL = 6 OPERANDS
*    1 - RESOLUTION CODE (2 DECIMAL DIGITS) 
*    2 - EXECUTION MULTIPLE (5 DECIMAL DIGITS)
*    3 - HOURS (2 DECIMAL DIGITS) 
*    4 - MINUTES (2 DECIMAL DIGITS) 
*    5 - SECONDS (2 DECIMAL DIGITS) 
*    6 - 10'S MULLISECONDS (2 DECIMAL DIGITS) 
* 
* 
*  RETURN: A AND B ARE DESTROYED
*    (N+1): SOME PARAMETERS WERE ENTERED
*    (N+2): NO PARAMETERS WERE ENTERED
* 
*    TBUF CONTAINS THE ENTERED NAME 
* 
* 
PARAM NOP 
PAR00 JSB READ      GET ASCII PARAMETER RECORD
      SZA,RSS       SKIP IF CHARS INPUT 
      JMP PAR01     REPEAT PARAMETER INPUT
      STA PARNO     SAVE PARAMETER RECORD LENGTH
      CLA 
      STA ID5 
      STA ID6 
      STA ID7 
      STA ID8 
      STA ID9 
      STA ID10
      STA ID11
      JSB GETAL 
      CPA B60 
      JMP PARAM,I 
      STA 1 
      CMA,INA       CHECK TO SEE IF ASCII 
      ADA B132      IS < = TO OCT 132 
      SSA 
      JMP PAR05     NO
      CMA,INA 
      ADA B71       AND > = TO OCT 41 
      SSA 
      JMP PAR05     NO
      ADB M56       OCT 47 TO OCT 55
      SSB,RSS       NOT ALLOWED 
      JMP PAR02     > = OCT 56
      CMB,INB 
      ADB N8
      SSB 
      JMP PAR05     > = OCT 47 AND < = OCT 55 
PAR02 ISZ PARAM 
      JSB GINIT     INITIALIZE BUFFER SCAN
      LDA N5
      JSB GETNA     MOVE CHARS FROM LBUF TO TBUF
      JSB GETAL     GET NEXT CHAR FROM LBUF 
      CPA BLANK     CHAR = BLANK?(DELIMITER = COMMA)
      JMP SETYP     YES - CONTINUE
      CPA ZERO
      JMP PARAM,I 
* 
PAR05 LDA PA        PARAMETER NAME ERROR
      JMP PARER 
PAR01 JSB INTER 
      JSB SPACE 
      LDA LENGT 
      LDB ADDRS 
      JMP PAR00 
* 
*                                   SET NEW PROGRAM PRIORITY
SETYP LDA N5        SET COUNT FOR DECIMAL CONVERSION
      JSB GETOC     CONVERT TO OCTAL
      JMP PAPER     PRIORITY ERROR
      JSB GETAL     GET NEXT CHAR FROM LBUF 
      CPA ZERO      CHAR = ZERO ? (END OF BUFFER) 
      RSS           YES - CONTINUE
      CPA BLANK     CHAR = BLANK?(DELIMITER = COMMA)
      JMP SETNR     SET PRIORITY
PAPER LDA PR        PARAMETER PRIORITY ERROR
      JMP PARER 
* 
SETNR LDB OCTNO     GET PRIORITY
      STB ID5        SET NEW PRIORITY 
      JSB GETAL     GET NEXT CHAR FROM LBUF 
      CPA ZERO      CHAR = ZERO ? (END OF BUFFER) 
      JMP PARAM,I   YES,RETURN
* 
*                                   GET RESOLUTION CODE 
      LDA N2        SET FOR 2 DECIMAL DIGITS
      JSB EXINT     GET DIGITS FROM LBUF
      STA ID6       SET IN IDENT 6
* 
*                                   GET EXECUTION MULTIPLE
      LDA N5        SET COUNT FOR DECIMAL CONVERSION
      JSB EXINT     GET DIGITS FROM LBUF
      AND M20K      ISOLATE UPPER 3 BITS IN A 
      SZA           SKIP IF VALID MULTIPLE
      JMP PAIER     INVALID EXECUTION INTERV FORMAT 
      LDA OCTNO     GET CONVERTED NUMBER
      STA ID7 
* 
*                                   GET HOURS 
      LDA N2        SET FOR 2 DECIMAL DIGITS
      JSB EXINT     GET DIGITS FROM LBUF
      ADA N24 
      STA ID8 
* 
*                                   GET MINUTES 
      LDA N2        SET FOR 2 DECIMAL DIGITS
      JSB EXINT     GET DIGITS FROM LBUF
      ADA N60 
      STA ID9 
* 
*                                   GET SECONDS 
      LDA N2        SET FOR 2 DECIMAL DIGITS
      JSB EXINT     GET DIGITS FROM LBUF
      ADA N60 
      STA ID10
* 
*                                   GET TENS OF MILLISECONDS
      LDA N2        SET FOR DECIMAL CONVERSION
      JSB GETOC     CONVERT TO OCTAL
      JMP PAIER     INVALID DIGIT 
      JSB GETAL     GET NEXT CHAR FROM LBUF 
      CPA ZERO      CHAR = 0? (END OF BUFFER) 
      RSS           YES - CONTINUE
      JMP PAIER     NO - INVALID DELIMITER
      LDA OCTNO 
      ADA N100
      STA ID11
      JMP PARAM,I 
* 
*                                   EXECUTION INTERVAL INPUT CONTROL
EXINT NOP 
      JSB GETOC     CONVERT TO OCTAL
      JMP PAIER     INVALID DIGIT 
      JSB GETAL     GET NEXT CHAR FROM LBUF 
      CPA BLANK     CHAR = BLANK? (DELIMITER=COMMA) 
      RSS           YES - CONTINUE
      JMP PAIER     NO - INVALID DELIMITER
      LDA OCTNO     GET CONVERTED NUMBER
      JMP EXINT,I   RETURN WITH NUMBER IN A 
PAIER LDA IN        PARAMETER INTERVAL ERROR
* 
PARER CLB           NO FMP ERROR
      JSB ERROR     ERROR 
      JMP PAR01     REPEAT INPUT
* 
IN    ASC 1,IN      PARAMETER INTERVAL ERROR
PA    ASC 1,PA      PARAMETER ERROR 
PR    ASC 1,PR      PARAMETER PRIORITY ERROR
* 
M56   OCT -56 
N8    DEC -8
N24   DEC -24 
N60   DEC -60 
N100  DEC -100
B71   OCT 71
B132  OCT 132 
ZERO  DEC 0 
BLANK OCT 40
* 
      SKP 
      SKP 
*  THIS ROUTINE WILL UPDATE THE PARAMETERS IN THE 
*  PNAME TABEL. THE SOURCE WILL BE  FROM THE
*  "ENTR PRAMS" TABLE 
* 
*  CALLING SEQUENCE:
*    A = SOURCE ADDRESS 
*    B = IGNORED
*    JSB UPNAM
* 
*  RETURN: A AND B ARE DESTROYED
* 
UPNAM NOP 
      STA TEMP1     SAVE SOURCE ADDRESS 
      LDA TEMP1,I   GET PRIORITY
      STA PNZQZ+7   YES 
      ISZ TEMP1 
      LDA TEMP1,I   GET RESOLUTION
      SZA 
      STA PNZQZ+8   UPDATE
      ISZ TEMP1 
      LDA TEMP1,I   EXEC MULT.
      SZA 
      STA PNZQZ+9 
      ISZ TEMP1 
      LDA TEMP1,I   HOURS 
      SZA 
      STA PNZQZ+10
      ISZ TEMP1 
      LDA TEMP1,I   MINUTES 
      SZA 
      STA PNZQZ+11
      ISZ TEMP1 
      LDA TEMP1,I   SECONDS 
      SZA 
      STA PNZQZ+12
      ISZ TEMP1 
      LDA TEMP1,I   TENS OF MILLISECONDS
      SZA 
      STA PNZQZ+13
      JMP UPNAM,I    RETURN 
* 
      HED  BUILD ID'S AND KEY WORD TABLE
* 
*  GET ID'S AND BUILD KEY WORD TABLE
* 
RTMG4 JSB BUFC
      LDA PPREL     KEY WORD TABLE ADDRESS
      LDB KEYWD     ABS ADDRESS 
      JSB STCR1 
      LDA PPREL 
      STA KEYAD     KEY WORD ADDRESS
KEYID JSB INTER 
      LDA P10 
      LDB MES42     # ID SEGS?
      JSB READ      PRINT MESSAGE, GET REPLY
      LDA N2        GET TWO DECIMAL 
      JSB GETOC 
      JMP IDWER     BAD NUMBER
      STA KEYCN     # OF ID SEGS TO KEY COUNT 
      SZA,RSS 
      JMP IDWER     DO NOT ACCEPT ID COUNT OF ZERO! 
      CMA,INA 
      ADA P99       OR > 99 
      SSA 
      JMP IDWER 
      LDA KEYCN     RESTORE A 
      ADA PPREL     ADD TO PRESENT LOCATION 
      ADA P3        FOR ZERO END
      STA PPREL     UPDATE PPREL
      STA SYSAD     INITIAL ID SEG ADDRESS
      STA IDSAD     FIRST ID SEG ADDRESS
      JMP *+3 
IDWER JSB INERR     ERROR 
      JMP KEYID     REPEAT INPUT
      JSB GETAL 
      SZA 
      JMP IDWER     NO, ERROR 
      LDA KEYCN     NO. OF KEY WORDS
      CMA,INA 
      STA WDCNT 
      LDA SYSAD 
      STA TEMP2 
      LDA KEYAD 
      STA TEMP3 
KYBLD LDA TEMP2     ADDRESS OF NEXT ID
      LDB TEMP3     KEY WORD ADDRESS
      ISZ TEMP3     BUMP TO NEXT KEY WORD ADDR
      JSB STCR1     OUTPUT TO ABS 
      LDA TEMP2     UPDATE ID ADDRESS 
      ADA P31       SEG SIZE
      STA TEMP2 
      ISZ WDCNT     ALL DONE? 
      JMP KYBLD     NOT DONE YET
      STA PPREL     NEW RELOCATE ADDRESS
      JSB BUFC
      CLA           ZERO
      LDB TEMP3     LAST KEYWORD ADDRESS
      JSB STCR1 
      LDA KEYCN     GET ID SEG COUNT
      CMA,INA 
      STA WDCNT     SAVE NEG
      LDA SYSAD     ADDRESS OF FIRST ID SEG 
      STA TEMP3 
      ADA N2
      LDB 0 
      INB           CLEAR 1ST TWO WORDS OF ID SEGMENT 
      JSB SETCR 
CLOOP LDA TEMP3     STARTING ADDRESS
      LDB A 
      ADB P30       BUMP TO  LAST ADDR
      STB TEMP3     UPDATE
      STB LBUF
      ISZ LBUF      POINT TO NEXT ID SEG
      ISZ TEMP3           TO NEXT ADDR
      JSB SETCR     CLEAR ID SEGMENT
      ISZ WDCNT     ALL DONE? 
      JMP CLOOP     NO, DO MORE 
      LDB TEMP3     CLEAR LAST LINK POINTER 
      ADB N31 
      CLA 
      JSB STCR1 
* 
*  RESERVE SPACE FOR IDENTS 
* 
      LDA KEYCN     # OF ID SEGMENTS
      ALS 
      ADA KEYCN     MULTIPLY BY 3 
      CMA,INA 
      ADA OPT.3 
      STA OPT.3     SET FOR START OF FIXUP TABLE
      LDB LSTUL     HIGHEST LST ENTRY 
      CMB 
      ADA 1 
      SSA,RSS 
      JMP STUPG     GET START UP PROGRAM
LSERR LDA TB        IDENTOLST OVERFLOW
      CLB           NO FMP ERROR
      JSB ERROR     IRRECOVERABLE ERROR 
      JMP ABRT1     EXIT TO SYSTEM
      SKP 
* 
N31   DEC -31 
P3    DEC 3 
P10   DEC 10
P30   DEC 30
P99   DEC 99
* 
KEYAD NOP           ADDRESS OF KEYWORD TABLE
* 
MES42 DEF *+1 
      ASC 5,* #ID SEG?
* 
TB    ASC 1,TB      IDENT/LST OVERFLOW
      HED  GET START-UP PROGRAM 
* 
*  GET START-UP PROGRAM 
* 
STUPG JSB SPACE     NEW LINE
      JSB INTER 
      LDA P16 
      LDB MES05     START-UP PROG 
      JSB PARAM     GO GET PARAMETERS 
      JMP RTMLI     NO PARAMS WERE INPUT
      LDA TBUF      MOVE NAME 1,2 
      STA STRPN 
      STA START     START-UP PROGRAM USED 
      LDA TBUF+1    NAME 3,4
      STA STRPN+1 
      LDA TBUF+2    NAME 5
      AND UPCR
      IOR BLANK 
      STA STRPN+2 
      LDA SYSAD      SEG ONE ADDRESS
      LDB SKEDD     ADDRESS IN BASE PAGE
      JSB STCR1     TO ABSOLUTE 
      LDA SYSAD     SEG ONE ADDRESS 
      STA SG1AD 
      ADA P31        UPDATE TO NEXT 
      STA SYSAD 
      ISZ IDNOS      BUMP NOS OF ID'S 
* 
      JMP RTMLI 
      SKP 
      HED  RELOCATE  RESIDENT LIBRARY 
* 
*  RELOCATE RESIDENT LIBRARY
* 
RTMG7 JSB SPACE     NEW LINE
RESL1 JSB INTER     INTERACTIVE INPUT 
      LDA PPREL     UP LOCC FOR RELOCATE
      STA .MEM3 
      LDB LBORG 
      JSB STCR1 
      LDA P13       PRINT:
      LDB MES04     REL RES LIB 
      JSB RELOC     RELOCATE MODULE 
      DEC 2 
      JMP RESL1     LOADER ERROR, TRY AGAIN 
      LDA .MEM3 
      STA SAVE2,I 
      STA PLIB      SAVE ADD JUST PAST RES LIB
      STA SSGAP 
      ADA N1
      STA ELIB      ADDRESS AT END OF RES LIB 
      JSB PAGE      GET PAGE NO.
      STA PGLIB     PAGE NO. AT END OF RES LIB
      SPC 5 
* 
*  RELOCATE SSGA MODULES
* 
      JSB SPACE     NEW LINE
RSSGA JSB INTER     INTERACTIVE INPUT 
      LDA P10 
      LDB MES19     REL SSGA
      JSB RELOC     RELOCATE MODULE 
      DEC 3 
      JMP RSSGA     LOADER ERROR, TRY AGAIN 
      LDA .MEM3 
      LDB RTORG     BASE PAGE LOCATION
      JSB STCR1     OUTPUT TO ABS 
      JSB BUFC
      LDA .MEM1     SET BASE PAGE LOWER LIMIT 
      STA LBUF
      LDA .MEM2     SET BASE PAGE UPPER LIMIT 
      STA LBUF+1
      LDA BPA1      FIRST BP ADDRESS
      LDB A 
      INB           LAST BP ADDRESS 
      JSB SETCR     SET TO BP COMMON AREA 
      SKP 
* 
*  SET UP COMMON AREA 
* 
      JSB SPACE     NEW LINE
WDSCM JSB INTER     INTERACTIVE INPUT 
      LDA P16 
      LDB MES07     # WDS IN COMM?
      JSB READ      PRINT MESSAGE, GET REPLY
      LDA N5
      JSB DOCON     GET 5 DIGITS
      JMP WDSCM     ERROR, REPEAT INPUT 
      LDA .MEM3     UPDATE FWAC 
      STA .MEM5 
      ADA OCTNO     UPDATE LWAC 
* 
*  ADJUST COMMON AREA TO PAGE BOUNDARY
* 
      JSB SIZE      PRINT LAST WORD OF COMMON 
      JSB SPACE     NEW LINE
ALIGN JSB INTER     INTERACTIVE INPUT 
      LDA P21 
      LDB MES23     ALIGN AT NEXT PAGE? 
      JSB MAYBE     PRINT MESSAGE, GET REPLY
      JMP ALIGN     ERROR, REPEAT INPUT 
      SZB,RSS 
      JMP MPFTI     NO
      LDA .MEM6     YES, ADJUST LWAC TO END OF PAGE 
      AND M2000 
      ADA B2000 
      JSB SIZE      PRINT LAST WORD OF COMMON 
MPFTI LDA .MEM6     SAVE LWAC 
      STA LWACG 
      LDA .MEM5     GET FWAC
      CMA,INA 
      ADA .MEM6     DETERMINE COMMON LENGTH 
      INA 
      LDB RTCOM     COMMON SIZE TO BASE PAGE
      JSB STCR1 
* 
*  STUFF MEMORY PROTECT FENCE TABLE AND OUTPUT IT 
* 
      JSB BUFC      CLEAR OUTPUT BUFFER 
      LDA PLIB      1ST ENTRY IN MPFT 
      STA LBUF      ADD JUST PAST RES LIB 
      STA LBUF+3
      STA LBUF+4
      LDA .MEM3     ADDRESS JUST PAST COMMON
      STA LBUF+1
      LDA .MEM5     ADDRESS AT START OF COMMON
      STA LBUF+2
      LDA MPFT
      LDB 0 
      ADB P4
      JSB SETCR     OUTPUT TABLE
      JMP REL00 
      SKP 
* 
APNAM DEF PNAMA 
* 
M2000 OCT -2000 
N4    DEC -4
B1001 OCT 100001
B2000 OCT 2000
P4    DEC 4 
P13   DEC 13
P15   DEC 15
P16   DEC 16
P19   DEC 19
P21   DEC 21
P28   DEC 28
* 
DU    ASC 1,DU      DUPLICATE ENTRY 
* 
MES3I DEF MES3A 
MES03 DEF *+1 
      ASC 9,* LWA OF COMMON = 
MES3A BSS 3 
MES04 DEF *+1 
      ASC 7,* REL RES LIB 
MES05 DEF *+1 
      ASC 8,* START-UP PROG?
MES07 DEF *+1 
      ASC 8,* # WDS IN COMM?
MES19 DEF *+1 
      ASC 5,* REL SSGA
MES23 DEF *+1 
      ASC 11,* ALIGN AT NEXT PAGE?
* 
* 
* 
*  DISPLAY LWA OF COMMON
* 
* 
SIZE  NOP 
      STA .MEM3     SET FWAM
      ADA N1
      STA .MEM6 
      LDB MES3I 
      JSB CONVD     STUFF LWAC TO OUTPUT BUFFER 
      LDA P24 
      LDB MES03     LWA OF COMMON = 
      JSB PRIN1 
      JMP SIZE,I
* 
N1    DEC -1
P24   DEC 24
      HED  RELOCATE CORE RESIDENT PROGRAMS
* 
*  RELOCATE CORE RESIDENT PROGRAMS
* 
REL00 CLA,INA       SET LINK DIRECTION FLAG 
      STA LNKDR     TO USER LINKS 
REL01 JSB SPACE     NEW LINE
RELRS JSB INTER     INTERACTIVE INPUT 
      LDA IDNOS     GET # OF ID SEGMENTS LEFT 
      CMA,INA 
      ADA KEYCN 
      LDB STRPN     START-UP PROGRAM REQUESTED? 
      SZB 
      INA           YES 
      STA IDS 
      SZA,RSS       ANY ID SEGMENTS LEFT? 
      JMP IDZER     NO
      LDA P16 
      LDB MES08     REL USER PROGS
      JSB RELOC 
      DEC 0 
      JMP RELRS     LOADER ERROR, TRY AGAIN 
      LDA ?XFER     WAS ZERO INPUT? 
      SZA,RSS 
      JMP SNAPO     YES, GO DO SNAPSHOT 
* 
*  CHANGE PARAMETERS
* 
      JSB SPACE     NEW LINE
SRFIN JSB INTER     INTERACTIVE INPUT 
      LDA P13 
      LDB MES10     ENTER PRAMS 
      JSB PARAM     GO GET PARAMS 
      JMP SRFI5     NO PARAMS INPUT, NO CHANGE
      LDA TBUF      NAME 1,2
      STA PNZQZ 
      LDA TBUF+1    NAME 3,4
      STA PNZQZ+1 
      LDA TBUF+2    NAME 5
      STA PNZQZ+2 
      LDA IDAA      ADDRESS OF PARAMETERS 
      JSB UPNAM     UPDATE PARAMETERS 
SRFI5 CLA 
      STA WDCNT     CLEAR FOR FIRST TIME
      LDA APNAM 
      JSB SRIPX     SEARCH FOR DUPS 
      JMP *+7       FOUND ONE 
      LDA PNZQZ+2   MASK OUT LOWER BLANK
      AND M400
      STA PNZQZ+2   AND RESTORE 
      LDA PNAMA     THIS NAME NOT IN TABLE
      JSB LDIPX     SO, PUT IT THERE
      JMP SRFI6     CONTINUE PROCESSING 
      LDA IP3,I     IS THIS AN INT PRG? 
      AND B77 
      SZA 
      JMP SRFI6     YES, ITS OK 
      LDA DU        NO, LOOKS LIKE A DUP ENTRY
      CLB           NO FMP ERROR
      JSB ERROR 
      JMP SRFIN     ERROR, REPEAT INPUT 
* 
SRFI6 LDA STRPA     ADDRESS OF START UP NAME
      LDB PNAMA     JUST LOADED NAME
      JSB NACMP     COMPARE NAMES 
      JMP SRFI2     NO COMPARE
      CLA           DOES COMPARE
      STA STRPN     CLR STRT FLAG 
      LDA IDSAD     SEGMENT ADDRESS 
      CLB           POINTS TO ADDRESS 
      JSB GENID     GO BUILD ID SEGMENT 
      LDA IDSAD     GET ID SEG ADDRESS
      INA           POINT TO TEMPORARY STORAGE
      LDB 0 
      ADB P9        WORD 11 IN SEG
      JSB STCR1     ADD WORD TO SEG 
      CLA,INA 
      STA LBUF
      LDA IDSAD 
      ADA P15       PUT A 1 INTO WORD 16 OF THE SEG 
      LDB A 
      JSB SETCR 
      LDA IDSAD     GET CORRECT ID SEG ADDRESS
      JSB SRFI3     "PROGS" WERE ENTERED, GO LOOK FOR IT
      JMP REL01     GO RELOCATE NEXT
* 
SRFI2 ISZ IDNOS     ENTERED PROGS EXCEEDED ID SEGS? 
      LDA IDNOS 
      CMA,INA 
      ADA KEYCN 
      SSA 
      JMP LSERR     IRRECOVERABLE ERROR YES!! 
      LDA SYSAD     GET CORRECT ID SEG ADDRESS
      JSB SRFI3     GO CHECK FOR INT-PRGS 
      LDA SYSAD     BUILD SEG IN THIS ADDRESS 
      LDB A 
      ADB P31       LOOK TO NEXT SEGMENT
      STB SYSAD     DYNAMIC SEG POINTER 
      JSB GENID     BUILD ID SEG
      LDA IDNOS     NO. OF ID SEGMENTS USED 
      CPA KEYCN     ON LAST ONE?
      RSS 
      JMP REL01     NO, GO GET NEXT 
      LDB SYSAD     DON'T LINK TO NEXT ID SEGMENT 
      ADB N31 
      CLA 
      JSB STCR1 
      JMP REL01     GO GET NEXT 
* 
SRFI3 NOP 
      STA PPREL     SAVE ID SEG ADDRESS 
      CLA 
      STA WDCNT     CLEAR FOR INITIAL ENTRY 
      LDA APNAM     ADDRESS OF INPUTTED PROG NAME 
SRFI4 JSB SRIPX     GO SEARCH 
      RSS           FOUND NAME
      JMP SRFI3,I   END OF TABLE
      LDA IP3,I     COMPARES,GET SC 
      AND B77 
      SZA,RSS 
      JMP SRFI4 
      ADA AINT      ADDRESS OF INTERRUPT TABLE
      ADA N6
      LDB A 
      LDA PPREL     SET NEG OF ID ADDRESS 
      CMA,INA       INTO THE INTERRUPT TABLE
      JSB STCR1 
      LDA IP3,I 
      AND M400
      STA IP3,I     SHOW ENTRY AS USED
      JMP SRFI4     LOOK AGAIN
      SKP 
* 
N3    DEC -3
N6    DEC -6
N30   DEC -30 
P5    DEC 5 
P9    DEC 9 
P22   DEC 22
P36   DEC 36
P38   DEC 38
B77   OCT 77
* 
ESAM  NOP           END OF SAM
FPSAM NOP           FIRST PAGE OF SAM 
LPMRP NOP           LAST PAGE OF MEMORY RESIDENT PROGRAMS 
LWAMR NOP           LWA OF MEM RES PROG AREA
NOSAM NOP 
SAM   NOP 
* 
STRPA DEF STRPN 
* 
MES08 DEF *+1 
      ASC 8,* REL USER PROGS
MES10 DEF *+1 
      ASC 7,* ENTER PRAMS 
ME35I DEF ME35A 
MES35 DEF *+1 
      ASC 10,* LWA MEM RES PROG = 
ME35A BSS 3 
      OCT 20040 
      ASC 4,CHANGE? 
ME36I DEF ME36A 
MES36 DEF *+1 
      ASC 4,* SAM = 
ME36A BSS 3 
      OCT 20040 
      ASC 3,WORDS 
ME37I DEF ME37A 
MES37 DEF *+1 
      ASC 16,* NO. ADD. PAGES FOR SAM? MAX =
ME37A BSS 3 
      SKP 
      HED CHANGE CORE BOUNDARIES
* 
*  START-UP PROGRAM REQUESTED?
* 
IDZER LDA P21 
      LDB MES48     NO ID SEGMENTS LEFT 
      JSB PRIN1     PRINT MESSAGE 
SNAPO LDA STRPN     WAS START-UP PRG REQUESTED? 
      SZA,RSS       BUT NOT LOADED
      JMP MRPA      NO
      LDA IDS 
      SZA,RSS       ANY ID SEGMENTS LEFT? 
      JMP LSERR     NO, IRRECOVERABLE ERROR 
      JSB SPACE     NEW LINE
      LDA P16 
      LDB MES05     START-UP PROG?
      JSB PRIN2     PRINT MESSAGE 
      JSB INTER     INTERACTIVE INPUT 
      JSB SPACE     NEW LINE
      LDA P5
      LDB STRPA     START-UP PROG NAME
      JSB PRINT     PRINT MESSAGE 
      LDA P5
      LDB STRPA 
      JSB MAPS
      JSB SPACE     NEW LINE
      JSB INTER     INTERACTIVE INPUT 
      CLA 
      STA FTIME 
      CLA,INA 
      STA CONSO     INPUT TO SESSION CONSOLE
      JMP RELRS     RELOCATE START-UP PROGRAM 
* 
MRPA  LDA KONSO 
      STA CONSO 
      CLA 
      STA PPREL     HEADER FLAG 
      STA WDCNT 
      LDA P1        NAME ADDRESS
SNAP6 JSB SRIPX     GO SEARCH 
      RSS           FOUND SOMETHING 
      JMP SNAP7     END OF TABLE
      LDA IP3,I     IS IT AN INT PRG NAME?
      AND B77 
      SZA,RSS 
      JMP SNAP6     NO, LOOK NEXT 
      LDA PPREL     HEADER BEEN PRINTED?
      SZA 
      JMP *+7       YES 
      JSB SPACE     NO, PRINT IT
      LDA P10 
      LDB MES12     INT PRGS
      STA PPREL     SET HEADER FLAG 
      JSB PRIN2 
      JSB SPACE     NEW LINE
      LDA IP3,I     PUT BLANK IN LAST CHARACTER 
      AND UPCR
      IOR P32 
      STA IP3,I 
      LDA P5
      LDB IP1       PRG NAME
      JSB PRINT 
      LDA LENGT 
      LDB ADDRS 
      JSB MAPS
      JMP SNAP6     LOOK NEXT 
* 
SNAP7 JSB SPACE     NEW LINE
SNAP9 JSB INTER     INTERACTIVE INPUT 
      LDA PPREL     ANY INT PRGS PRINTED? 
      SZA,RSS 
      JMP MRPA4     NO, CONTINUE
      CLA,INA 
      STA CONSO 
      LDA P9
      LDB MES13     IGNORE? 
      JSB MAYBE     PRINT MESSAGE, GET REPLY
      JMP SNAP9     ERROR, REPEAT INPUT 
      SZB,RSS 
      JMP RELRS 
MRPA4 LDA KONSO 
      STA CONSO 
      LDA START 
      SZA,RSS       ANY START-UP PROGRAM? 
      JMP MRPA0     NO
      JSB BUFC
      LDB SG1AD 
      ADB P28 
      LDA B1001 
      JSB STCR1 
MRPA0 JSB SPACE     NEW LINE
MRPA1 JSB INTER     INTERACTIVE INPUT 
      CCA 
      ADA .MEM3     GET LWA MEM RES PROG
      STA LWAMR 
      LDB ME35I 
      JSB CONVD     PUT IN OUTPUT BUFFER
      LDA P36 
      LDB MES35     LWA MEM RES PROG = XXXXX CHANGE?
      JSB READ      PRINT MESSAGE, GET REPLY
      LDA P5
      JSB DOCON     GET NEW LWA MEM RES PROG
      JMP MRPA1     REPEAT INPUT
      SZA,RSS 
      LDA LWAMR     NO CHANGE 
      STA LWMRP 
      CMA,INA       CHECK IF LWAMR IS SMALLER THAN BEFORE 
      ADA LWAMR 
      CMA,INA 
      SSA,RSS 
      JMP MRPA3     NEW LWAMR IS > OR = OLD LWAMR 
      JSB INERR     ERROR, TRY AGAIN
      JMP MRPA1 
MRPA3 LDA LWMRP 
      STA LWAMR 
      JSB SPACE     NEW LINE
ALSAM JSB INTER     INTERACTIVE INPUT 
      LDA P21 
      LDB MES23     ALIGN AT NEXT PAGE? 
      JSB MAYBE     PRINT MESSAGE, GET REPLY
      JMP ALSAM     ERROR, REPEAT INPUT 
      SZB,RSS 
      JMP MRPA2     NO
      LDA LWAMR     YES, ADJUST LWAMR TO END OF PAGE
      AND M2000 
      ADA B1777 
      STA LWAMR 
MRPA2 LDA LWAMR 
      STA .MEM4     NO, RESET LWAM
      AND M2000     ADJUST SYS AV. MEM. TO END
      ADA B1777     OF PAGE 
      CLB 
      CPA LWAMR 
      CLB,INB       MEM RES PROGS EXTEND TO END OF PAGE 
      STA ESAM      END OF SAM
      JSB PAGE      GET PAGE NO.
      STA LPMRP     LAST PAGE OF MEM RES PROGS
      ADA 1 
      STA FPSAM     FIRST PAGE OF SAM 
      CMB,INB 
      STB NOSAM 
      LDA LWSA1 
      LDB SYSTM 
      CPB P3
      LDA ESAM
      LDB LWAMR 
      CMB,INB 
      ADA 1 
      SSA 
      JMP MRERR     SAM NEGATIVE, ERROR EXIT
      STA SAMSZ 
      CMA,INA 
      LDB ME36I 
      JSB CONVD     PUT SAM SIZE IN OUTPUT BUFFER 
      LDA P22 
      LDB MES36     SAM = 
      JSB PRIN1     PRINT MESSAGE 
      LDB SYSTM     GET SYSTEM TYPE 
      CPB P3        TYPE 3 SYSTEM?
      RSS 
      JMP SNAP5     NO
      LDA ELIB      ADDRESS AT END OF LIB 
      LDB PCOM      PRIV. DRIVERS ACCESS COMMON?
      SZB 
      LDA .MEM6     YES, USE LAST WORD OF COMMON
      JSB PAGE      GET PAGE NUMBER 
      STA ECLIB     SAVE PAGE AT END OF COMMON/LIB
      ADA N30       # PAGES FOR SAM = 31 - # OF 
      STA SAM       PAGES THRU COMMON OR LIBRARY
      LDB ME37I 
      JSB CONVD     PUT IN OUTPUT BUFFER
      JSB SPACE     NEW LINE
PSYM  JSB INTER     INTERACTIVE INPUT 
      LDA P38 
      LDB MES37     NO. ADD. PAGES FOR SAM? 
      JSB READ      PRINT MESSAGE, GET REPLY
      LDA N3
      JSB DOCON 
      JMP PSYM      ERROR, REPEAT INPUT 
      STA 1         MAX. ADD. PAGES 
      ADA SAM 
      CMA,INA 
      SSA 
      JMP MRERR     MORE PAGES THAN ALLOWED 
      STB SAM       SAVE ADD. PAGES 
      LDB FPSAM     1ST PAGE OF SAM 
      ADB NOSAM 
      ADB SAM       ADDITIONAL PAGES
      STB LPSAM     LAST PAGE OF SAM
      CMB 
      ADB MSIZE     MEMORY SIZE 
      STB PAGES     NO. OF PAGES REMAINING
      HED DEFINE PARTITIONS 
* 
* 
*  PARTITION DEFINITION 
* 
* 
      CLA 
      STA FTIME 
PAR0A JSB INTER     INTERACTIVE INPUT?
      LDA N4        CLEAR PARTITION DEFINITION TABLE
      STA KOUNT 
      CLA 
PARCL LDB PATBL     4 WORDS = MAXIMUM 64 PARTITIONS 
      STA 1,I       WORD 1 BIT 0 = PARTITION 1, ETC.
      INB           IF BIT = 1 PARTITION DEFINED
      ISZ KOUNT 
      JMP PARCL 
      LDA PAGES     NO. OF PAGES REMAINING
      STA PAGE0     SAVE FOR RESTORE
      JSB SPACE     NEW LINE
      LDA P31 
      LDB MES45     LARGEST ADDRESSABLE PARTITION 
      JSB PRIN1     PRINT MESSAGE 
      JSB SPACE     NEW LINE
      CCA 
      ADA SSGAP     GET NUMBER OF PAGES USED W/O
      JSB PAGE      COMMON
      CMA,INA       FIND NUMBER OF PAGES LEFT 
      ADA P32 
      STA MXPTL     MAXIMUM PARTITION LENGTH
      LDB ME46I 
      CMA,INA       SET FOR DECIMAL 
      JSB CONVD     PUT IN MESSAGE
      LDA P22 
      LDB MES46     W/O COMMON XX PAGES 
      JSB PRIN1     PRINT MESSAGE 
      LDA LWACG     LAST WORD OF AVAILABLE COMMON 
      JSB PAGE      GET NO. OF PAGES USED WITH COMMON 
      CMA,INA       FIND NO. OF PAGES LEFT
      ADA P32 
      CMA,INA       SET FOR DECIMAL 
      LDB ME47I 
      JSB CONVD     PUT IN MESSAGE
      LDA P22 
      LDB MES47     W/  COMMON XX PAGES 
      JSB PRIN1     PRINT MESSAGE 
      JSB SPACE     NEW LINE
      JSB PTPAG     OUTPUT NO. OF PAGES REMAINING 
      JSB INTER     INTERACTIVE INPUT 
      LDA P19 
      LDB MES43     DEFINE PARTITIONS 
      JSB PRIN1     PRINT MESSAGE 
      JSB SPACE     NEW LINE
PAR04 JSB INTER     INTERACTIVE INPUT 
      LDA P3
      LDB QUEST     ? 
      JSB READ      PRINT MESSAGE, GET REPLY
      LDA N2
      JSB GETNA     GET FIRST 2 CHARACTERS
      CPA EN        END?
      JMP PAREN     YES, PARTITIONS ALL DEFINED 
      CPA RE        REPEAT ALL DEFINITIONS? 
      JMP PAR0A     YES 
      JSB GINIT     REINITIALIZE INPUT
      LDA N2        GET PARTITION NO. 
      JSB GETOC 
      JMP PARE4     ERROR 
      STA PANUM     SAVE PARTITION NO.
      CMA,INA 
      ADA MAXPT     EXCEEDS MAXIMUM PARTITION NO.?
      SSA,RSS       NO
      JMP PAR03 
PARE1 LDA PT        PARTITION DEFINITION ERROR
      RSS 
PARE2 LDA PD        PARTITION ALREADY DEFINED 
      RSS 
PARE3 LDA PS        NOT ENOUGH MEMORY LEFT
      CLB           NO FMP ERROR
      JSB ERROR     ERROR 
      RSS 
PARE4 JSB INERR     ERROR 
      JMP PAR04     REPEAT INPUT
PAR03 JSB GETAL     CHECK FOR COMMA 
      CPA BLANK 
      RSS           YES, COMMA
      JMP PARE4     NO, ERROR 
      LDA N2        GET PARTITION SIZE
      JSB GETOC 
      JMP PARE4     INPUT ERROR, TRY AGAIN
      STA PARSZ     SAVE PARTITION SIZE 
      CMA,INA 
      STA 1         CHECK IF GREATER THAN MAXIMUM 
      ADA MXPTL     ALLOWED 
      SSA 
      JMP PARE1     YES 
      LDA 1         CHECK IF GREATER THAN NUMBER OF 
      ADA PAGE0     PAGES REMAINING 
      SSA 
      JMP PARE3     YES, ERROR
      STA PAGE1     SAVE NO. OF PAGES REMAINING 
      LDA PARSZ 
      ADA N2
      SSA 
      JMP PARE4     MUST BE AT LEAST 2 PAGES
      JSB BUFC      CLEAR OUTPUT BUFFER 
      LDA PANUM     GET PARTITION NO. 
      RAR,RAR       CHECK TABLE TO SEE IF 
      RAR,RAR       ALREADY DEFINED 
      AND P15 
      ADA PATBL 
      STA KOUNT 
      LDA 0,I 
      STA TEMP1 
      LDA PANUM 
      AND P15 
      CMA,INA 
      LDB MNEG
      RBL 
      ISZ 0 
      JMP *-2 
      LDA 1 
      IOR TEMP1 
      CPA TEMP1 
      JMP PARE2     PARTITION ALREADY DEFINED 
      STA KOUNT,I   UPDATE TABLE
      LDA PAGE0     FIND BEGINNING PAGE ADDRESS 
      CMA,INA 
      ADA MSIZE 
      STA LBUF+3
      LDA PAGE1 
      STA PAGE0     UPDATE NO. OF PAGE REMAINING
      CCA 
      ADA PARSZ     PARTITION SIZE
      STA LBUF+4
      CCA 
      ADA PANUM     OUTPUT SIZE AND 
      RAL           BEGINNING PAGE
      STA 1         ADDRESS OF
      RAL           PARTITION 
      ADA 1         TO CORRECT
      INA 
      ADA MATA      ENTRY IN
      LDB 0         MEMORY
      ADB P5        ALLOCATION
      JSB SETCR     TABLE 
      JSB PTPAG     OUTPUT NO. OF PAGES LEFT
      CLA 
      STA FTIME 
      JMP PAR04     GET NEXT PARTITION DEFINITION 
      HED OUTPUT MRMP AND STUFF ENTRIES 
* 
*  STUFF MEMORY RESIDENT PROG. MAP AND OUTPUT IT
* 
PAREN JSB BUFC
      LDA LPMRP     GET LAST PAGE OF MEM RES PROGS
      CMA 
      STA MRMPG 
      ADA P32 
      CMA 
      STA WRPOT 
      LDA ALBUF     SET 0,1,2.....N IN OUTPUT 
      CLB           BUFFER, WHERE N = PAGE #
      STB 0,I       OF ADJUSTED END OF MEM RES PROGS
      INB 
      INA 
      ISZ MRMPG 
      JMP *-4 
      CCB 
      ISZ WRPOT 
      RSS 
      JMP *+4 
      STB 0,I       SET REMAINING PAGES TO -1 
      INA           FOR WRITE PROTECT 
      JMP *-5 
      LDA MRMP      GET ADDRESS OF TABLE
      LDB 0 
      ADB P31 
      JSB SETCR     GO OUTPUT VALUES
* 
*STUFF $ENDS, $LPSA, $MPSA
* 
      LDA PGLIB     PAGE # AT END OF RES LIB
      INA           # OF PAGES SYS + LIB
      LDB $ENDS 
      JSB STUFF     PUT IN $ENDS
      LDB $LPSA 
      LDA LPSAM     LAST PAGE OF SAM
      JSB STUFF     PUT IN $LPSA
      LDA SAM       GET # OF ADD PAGES OF SAM 
      INA           ADD 1 FOR 1ST PAGE
      ADA NOSAM     ADJUST IF SAM DOESN'T SHARE PAGE
      ALF,ALF       WITH MEM RES PROGS
      RAL,RAL       SHIFT TO BITS 10 - 15 
      IOR FPSAM     MERGE WITH 1ST PAGE OF SAM
      LDB $MPSA 
      JSB STUFF     PUT IN $MPSA
SNAP5 LDB $EMRP 
      LDA LWAMR     LAST WORD OF MEM RES PROGS
      JSB STUFF     PUT IN $EMRP
      JMP *+3 
MRERR JSB INERR     ERROR 
      JMP MRPA1     REPEAT INPUT
* 
      LDA JMP3I     SET STARTING JMP
      STA LBUF
      LDA STRAD     SET STARTING ADDRESS
      STA LBUF+1
      LDA P2
      LDB P3
      JSB SETCR 
      HED SNAPSHOT OUTPUT FOR LOADER RELOCATION 
      LDB SYSTM 
      CPB P3        RTE-M-3?
      JMP SNAP1     YES 
      LDA LWAMR     SET AVMEM TO NEXT WORD PAST 
      INA           MEM RES PROGS. (SAM)
SNAP0 LDB AVMEM     BP ADDRESS
      JSB STCR1     SET FWA SYS MEM INTO RTM BP 
      LDA SAM 
      ALF,ALF 
      RAL,RAL 
      ADA SAMSZ 
      ADA SAMST 
      LDB SYSTM 
      CPB P1
      LDA LWSA1 
      CPB P2
      LDA LWSA1 
      LDB BGORG     FWA OF BACKGROUND COMMON
      JSB STCR1 
      LDB BGLWA     LWA MEMORY BACKGROUND PARTITION 
      JSB STCR1 
      CLB,INB 
      JSB CLFL2 
      JSB SPACE     NEW LINE
      JMP RTMLI 
RTMGS JSB SPACE     NEW LINE
      LDA $OPSY     TYPE OF OPERATING SYSTEM
      CPA N7        RTE-M-I?
      JMP SNAPA     YES 
      CPA N15       RTE-M-II? 
      JMP SNAPA     YES 
      CPA N5        RTE-M-III?
      JMP SNAPA     YES 
      JMP SNAP3     NONE OF THE ABOVE 
SNAPA LDA DCB2      IS OUTPUT A TYPE 0 FILE?
      SSA,RSS 
      JMP SNAPX 
      AND UDFE
      LDA 0,I 
      JMP *-4 
SNAPX ADA P2
      LDB 0,I 
      SZB,RSS 
      JMP SNAP3     YES 
      INA 
      LDB 0,I       GET TRACK NUMBER
      CMB,INB 
      STB TRACK 
      INA 
      LDB 0,I       GET SECTOR NUMBER 
      CMB,INB 
      STB SECTR 
      LDA TRACK     PUT TRACK # IN MESSAGE
      LDB ME49I 
      JSB CONVD 
      LDA SECTR     PUT SECTOR # IN MESSAGE 
      LDB ME50I 
      JSB CONVD 
      LDA P46       MESSAGE LENGTH
      LDB MES49     MESSAGE ADDRESS 
      JSB PRIN1 
      JSB SPACE 
SNAP3 LDA P16 
      LDB MES11     RTMLG FINISHED
      JSB PRIN2 
      JMP EXEC6 
SNAP1 LDB ECLIB     LIBRARY ON SAME PAGE AS SAM?
      CPB FPSAM 
      JMP SNAP0     YES 
      BLF,BLF       SET AVMEM TO NEXT PAGE WITH SAME
      RBL,RBL       OFFSET THAT SAM HAS WHERE IT STARTS 
      LDA LWAMR 
      AND B1777 
      CPA B1777 
      RSS 
      ADB B2000 
      ADA 1 
      STA SAMST 
      INA 
      JMP SNAP0 
* 
* 
*  SUBROUTINE TO OUTPUT NO. OF PAGES REMAINING
* 
* 
PTPAG NOP 
      LDA PAGE0     NO. OF PAGES REMAINING
      LDB ME44I 
      CMA,INA       SET FOR DECIMAL 
      JSB CONVD     PUT IN MESSAGE
      LDA P26 
      LDB MES44     PAGES REMAINING = 
      JSB PRIN1     PRINT MESSAGE 
      JMP PTPAG,I 
* 
* 
EN    ASC 1,EN
RE    ASC 1,RE
* 
QUEST DEF *+1 
      ASC 2,* ? 
* 
B1777  OCT 1777 
UPCR  OCT 77400 
UDFE  OCT 77777 
MNEG  OCT 100000
N7    DEC -7
N15   DEC -15 
P2    DEC 2 
P32   DEC 32
P26   DEC 26
P31   DEC 31
P46   DEC 46
* 
ECLIB NOP 
KOUNT NOP           TEMP STORE
LPSAM NOP           LAST PAGE OF SAM
LWMRP NOP           LAST WORD OF MEM RES PROGS. 
MRMPG NOP 
MXPTL NOP           MAXIMUM PARTITION LENGTH
PAGE0 NOP           TEMP STORE FOR NO. OF PAGES LEFT
PAGE1 NOP            "      "      "       "
PAGES NOP           # PAGES AFT REL CORE RES PROG 
PANUM NOP           PARTITION NO. 
PARSZ NOP           PARTITION SIZE
SAMST NOP 
SAMSZ NOP 
SECTR NOP           SECTOR NUMBER 
TRACK NOP           TRACK NUMBER
WRPOT NOP 
* 
PATBL DEF *+1 
      REP 4 
      OCT 0 
$EMRP DEF *+1 
      ASC 3,$EMRP 
$ENDS DEF *+1 
      ASC 3,$ENDS 
$LPSA DEF *+1 
      ASC 3,$LPSA 
$MPSA DEF *+1 
      ASC 3,$MPSA 
* 
PT    ASC 1,PT      PARTITION DEFINITION ERROR
PD    ASC 1,PD      PARTITION ALRADY DEFINED ERROR
PS    ASC 1,PS      PARTITION SIZE ERROR
* 
JMP3I JMP 3,I 
* 
MES11 DEF *+1 
      ASC 8,* RTMLG FINISHED
MES12 DEF *+1 
      ASC 5,* INT PRGS
MES13 DEF *+1 
      ASC 5,* IGNORE? 
MES43 DEF *+1 
      ASC 10,* DEFINE PARTITIONS
ME44I DEF ME44A 
MES44 DEF *+1 
      ASC 10,* PAGES REMAINING =
ME44A BSS 3 
MES45 DEF *+1 
      ASC 16,* LARGEST ADDRESSABLE PARTITION
ME46I DEF ME46A 
MES46 DEF *+1 
      ASC 5,* W/O COM 
ME46A BSS 3 
      ASC 3, PAGES
ME47I DEF ME47A 
MES47 DEF *+1 
      ASC 5,* W/  COM 
ME47A BSS 3 
      ASC 3, PAGES
MES48 DEF *+1 
      ASC 11,* NO ID SEGMENTS LEFT
ME49I DEF ME49A 
ME50I DEF ME50A 
MES49 DEF *+1 
      ASC 13,* SYSTEM STARTS AT TRACK 
ME49A BSS 3 
      ASC 4, SECTOR 
ME50A BSS 3 
      END RTMG2 
* 
                                                                        