ASMB,R,B,L,C
      HED <RTE-C APLDR>  ABSOLUTE PROGRAM LOADER
* 
*************************************************************** 
* (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975.  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.       * 
*************************************************************** 
* 
* 
* 
*       RTE-C APLDR 
*       E. WONG 
*        REV.A  E.WONG  25MAY73 
*        REV.B  E.WONG   3AUG73 
*        REV.C  D.L.S.  10MAR75  COPYRIGHT
* 
*       SOURCE : 29101-80004
*       RELOC  : 29101-60004
*       LISTING: 29101-80004-2
* 
* 
      NAM APLDR,1,60
      ENT APLDR 
      EXT $LIBR,$LIBX,EXEC
* 
A     EQU 0 
B     EQU 1 
KEYWD EQU 1657B 
BPA1  EQU 1742B 
BPA2  EQU 1743B 
RTORG EQU 1746B 
RTCOM EQU 1747B 
AVMEM EQU 1751B 
BKLWA EQU 1777B 
      SUP 
* 
* 
*   APLDR IS SCHEDULED BY THE SYSTEM WHEN OPERATOR INPUTS 
*   ONE OF THE FOLLOWING: 
*        PL,LU
*        LO,PNAME,LU,FL,KB
*        RP,PNAME,LU,FL,KB
* 
*   THE SCHEDULE CALL PASSES THE PARAMETERS IN THE FOLLOWING
*   ORDER:
*        P1 - KEYBOARD LU # / FUNCTION CODE 
*        P2 - FILE NUMBER   / INPUT-OUTPUT LU # 
*        P3 - CHARACTER #1  / CHARACTER #2
*        P4 - CHARACTER #3  / CHARACTER #4
*        P5 - CHARACTER #5  / 
* 
*   WHERE FUNCTION CODE IS: 
*        0 - PROGRAM LIST 
*        1 - LOAD PROGRAM 
*        2 - REPLACE PROGRAM
* 
* 
* 
* 
APLDR NOP 
      LDA DKBFN     GET ADDR OF BUFFER
      STA TEMP1     SAVE TEMPORARILY
      LDA MD5 
      STA TEMP2 
RMPLP LDA B,I       GET PARAM FROM ID SEG 
      STA TEMP1,I   SAVE IN BUFFER
      INB 
      ISZ TEMP1 
      ISZ TEMP2 
      JMP RMPLP 
* 
      LDA NAM50     MAKE SURE 6 CHAR
      AND LHALF      IS ZERO. 
      STA NAM50 
* 
      CLA 
      LDB FILLU     GET FILE NO.&I/O LU 
      LSR 8          SAVE LEFT HALF 
      STB FILE       AS FILE NUMBER.
* 
      ALF,ALF       SAVE RIGHT HALF 
      STA LU         AS I/0 LU. 
* 
      LDB KBFUN     GET KYBD UNIT AND FUNC
      LSR 8          SAVE LEFT HALF 
      SZB,RSS       IF ZERO,
      LDB CONSL      USE DEFAULT
      STB KYBDU      AS KEYBOARD UNIT.
* 
      ALF,ALF       GET FUNC FROM RIGHT HALF
      SZA,RSS       IS IT LIST?     0 
      JMP LIST
      CPA B1        IS IT LOAD?     1 
      JMP LOAD
      CPA B2        IS IT REPLACE?  2 
      JMP REPL
      JMP ABORT     NO, IT IS ERROR.
* 
DKBFN DEF KBFUN 
MD5   DEC -5
* 
      HED <RTE-C APLDR>  L0: LOAD PROGRAM 
LOAD  LDA NAM12     IF NO NAME GIVEN
      SZA,RSS        SKIP DUPLIC NAME 
      JMP *+3        CHECKING 
      JSB DUPID     CHECK IF DUPLICATE
       DEF NAM12     ID NAME. 
* 
      JSB STRID     NOT DUPLI, FIND 
LOAD2 JSB SRCID      A BLANK
DFNUL  DEF ZERO      ID SEG.
       JMP LOADD    NO BLANK ID SEG.
       JMP LOAD2    KEEP LOOKING. 
      STA CURID     GOT IT, SAVE ADDR.
* 
LOAD3 JSB IHILO     INIT HI,LO ADDRS
      LDA DWRD1     INIT SPEC REC 
      STA WORD1      DUMMY ID ADDR. 
      LDA DWRD2 
      STA WORD2 
      LDA RSS       INITIALIZE SWITCH 
      STA ABS12     FOR SPEC. REC.
      STA LDRCT     INIT LEADER COUNT 
      STA IDOFS     INDICATE NO ABS YET.
* 
      LDA LU        GET LU PARAM, 
      SZA,RSS        IF ZERO
      LDA DINPT      USE DEFAULT
      IOR B2300      FOR THE ABS
      STA LU         INPUT UNIT.
* 
* 
* 
*       READ ABSOLUTE RECORD
* 
* 
ABS0  JSB EXEC      MAKE REQUEST
       DEF *+5       TO 
       DEF B1        READ 
       DEF LU        ABS RECORD 
       DEF ABSBF     INTO BUF 
       DEF D64       OF MAX SIZE. 
* 
      AND B240      CHECK FOR EOF/EOT 
      SZA,RSS       IS IT EOF?
      JMP ABS0A      NO 
      LDA LDRCT      YES, IS IT 
      SZA,RSS         JUST LEADER?
      JMP LOAD5     IS EOF. 
      JMP ABS0      IGNORE LEADER 
* 
ABS0A SZB,RSS       ANYTHING TRANSMITTED? 
      JMP ABS0       NO 
* 
      STA LDRCT     SET LDRCT FOR EOT 
      LDB ABSCT     GET WORD COUNT. 
      BLF,BLF        SHIFT TO LOW BITS
      STB ABSSZ      SAVE REC SIZE
      CMB,INB 
      STB TEMP1     SAVE NEG COUNT
      LDB ABSAD     GET ADDR, START CKSM. 
      LDA DABSD 
      STA TEMP2     SET DATA ADDR.
ABS0B LDA TEMP2,I   GET A WORD
      ADB A          ADD TO CKSM
      ISZ TEMP2      BUMP TO NEXT 
      ISZ TEMP1      BUMP COUNT 
      JMP ABS0B      REPEAT TIL DONE. 
* 
      LDA TEMP2,I 
      CPA B         COMPARE CKSMS 
      JMP ABS1       MATCHES
      LDB ERR10     CHECKSUM ERROR- 
      JMP ERPR4      ERR MSG THEN ABORT 
* 
* 
* 
*       FIND WHERE ABSOLUTE RECORD FITS IN CORE 
* 
* 
ABS1  LDA ABSAD     OK, SO FETCH ADDR 
      CPA B2        IS IT SPECIAL RECORD? 
      JMP ABS12      YES
      AND BPMSK     IS IT BASE PAGE?
      CPA ABSAD 
      JMP ABS2       YES, BASE PAGE.
* 
      LDA RTORG     GET DEFAULT LOWEST ADDR 
      STA TEMP
      LDA AVMEM     GET DEFAULT HIGHEST ADDR
      STA TEMP1 
      LDA DMAIN     GET PTRS TO MAIN HI/LO
      LDB D22       SET OFFSET FOR MAIN 
      JMP ABS3       ADDRS IN ID SEG. 
* 
ABS2  LDA BPA1      GET DEFAULT LOWEST ADDR 
      STA TEMP
      LDA BPA2      GET DEFAULT HIGHEST ADDR
      STA TEMP1 
      LDA DBASE     GET PTRS TO BASE HI/LO
      LDB D24       SET OFFSET FOR BASE PAGE
* 
* 
* 
*       FIND THE HI AND LO MEMORY BOUNDS OF FREE CORE 
* 
* 
ABS3  STB IDOFS     SAVE OFFSET TO GET ADDRS
      STA TEMP4     SAVE ADDR OF LFREE
      ADA B2
      STA TEMP5     SAVE ADDR OF HFREE
      LDA TEMP
      CMA,INA       CHECK IF ABS REC < FWABP USER LINKS 
      ADA ABSAD 
      SSA 
      JMP ABS14     ABS < FWABP, ERROR
      LDA ABSAD 
      ADA ABSSZ 
      CMA,INA       CHECK IF ABS REC > LWAM USER SPACE
      ADA TEMP1 
      SSA 
      JMP ABS14     ABS > LWAM, ERROR 
      LDA TEMP4,I 
      CPA TEMP
      RSS           ADDRS ALREADY SET?
      JMP ABS6       YES, SKIP SEARCH FOR HI/LO 
* 
      JSB STRID     INIT ID SEARCH. 
ABS4  JSB SRCID     SEARCH EACH ID
       DEF ZERO      EXCEPT BLANK ONES, 
       JMP ABS6      FOR THE HI/LO
RSS    RSS           ADDRS WHICH
       JMP ABS4      DEFINE FREE CORE.
      CPA CURID     IS THIS ID FOR PRG? 
      JMP ABS4      YES, IGNORE THIS ID BOUNDS
      ADA IDOFS 
      STA TEMP      SET ADDR OF ID ADDR.
* 
      CMA           CHECK IF ID SEG > 22 WORDS
      ADA ADRID,I 
      SSA 
      JMP ABS4       NEG, IGNORE IF RTE ID SEG. 
      CLA 
      STA TEMP1     CLEAR OVERLAP FLAG
* 
      LDA TEMP,I    GET ID LOW
      CMA,INA 
      ADA ABSAD     IS ID LOW > ABS REC?
      SSA 
      JMP ABS4B      LOW>ABS, CHECK MORE
      ISZ TEMP1      LOW<=ABS, CHECK IF OVERLAP 
      JMP ABS5       BY CHECKING IF HI>=ABS 
* 
ABS4B LDA TEMP,I    GET ID LOW AGAIN
      CMA            SUBTRACT IT
      ADA TEMP5,I     FROM LAST HFREE 
      SSA             AND 
      JMP ABS5        IF IT IS
      LDA TEMP,I      LOWER THEN KEEP IT
       DST TEMP5,I    AS NEW HFREE
* 
ABS5  ISZ TEMP
      LDA TEMP,I    GET ID HIGH ADDR
      CMA,INA 
      ADA ABSAD 
      SSA,RSS       ID HIGH < ADDR OF REC?
      JMP ABS5B      HI<=ABS, CHECK MORE
      CLA,INA        HI>ABS, MIGHT OVERLAP
      CPA TEMP1     DOES ABS OVERLAP? 
      JMP ABS13      YES, GIVE OF ERR 
      JMP ABS4       NO, IGNORE 
* 
ABS5B LDA TEMP,I    GET ID HI 
      CMA,INA       SUBTRACT IT 
      ADA TEMP4,I    FROM LAST LFREE
      SSA,RSS        AND IF IT IS 
      JMP ABS4
      LDA TEMP,I     HIGHER, WE KEEP IT 
      DST TEMP4,I   AS NEW LFREE
      JMP ABS4       REPEAT FOR EACH ID 
* 
* 
* 
*       ALREADY GOT MEMORY BOUNDS; SEE IF ABS CAN FIT 
* 
* 
ABS6  LDA ABSAD     GET ADDR OF ABS REC 
      LDB ABSSZ 
      ADB A         GET ADDR OF END OF ABS REC
      JSB CKBND     CHECK BOUNDS WITH LFREE,HFREE 
       JMP ABS13     ERROR. 
* 
* 
* 
*       COPY ABS RECORD TO CORE IF WITHIN BOUNDS
* 
* 
ABS10 LDA ABSSZ     SET UP ABSSZ
      CMA,INA        FOR TRANSFER 
      STA TEMP       OF RECORD. 
      LDA DABSD     SET UP BUFFER 
      STA BADDR      ADDR OF DATA WORDS.
      LDB ABSAD     SET UP CORE ADDR. 
ABS11 LDA BADDR,I   GET A DATA WORD.
      JSB SYSET     PUT INTO CORE.
      INB 
      ISZ BADDR 
      ISZ TEMP
      JMP ABS11     REPEAT UNTIL DONE.
      JMP ABS0      GO GET ANOTHER RECORD 
* 
* 
* 
*       PROCESS SPECIAL TRAILER RECORDS.
* 
* 
ABS12 RSS           NOP-ED AFTER 1ST ENTRY.!
      JMP AB12B     SO ONLY DO THIS ONCE. 
      LDA MD28
      STA TEMP1     SET COUNTER 
      LDB DDMID      TO CLEAR OUT 
      CLA 
AB12A STA B,I        SPECIAL RECORDS
      INB 
      ISZ TEMP1 
      JMP AB12A 
      STA ABS12     NOP SWITCH
* 
AB12B DLD ABSD1     PICK UP 2 DATA WORDS
      STA WORD1,I    PUT 1ST INTO DUMMY ID. 
      STB WORD2,I    PUT 2ND INTO DUMMY ID. 
      ISZ WORD1     BUMP DUMMY ID 
      ISZ WORD2      LOCATIONS. 
      JMP ABS0
* 
* 
* 
*       REACHED END-OF-FILE ON PROGRAM INPUT
* 
* 
LOAD5 LDB IDOFS     CHECK IF ANY ABS
      CPB RSS        WAS READ YET.
      JMP IDERR     ERROR IF NONE.
      LDA WORD1     SPEC REC MUST BE AT END 
      CPA DWRD2     WAS IT THERE? 
      JMP LOAD6      YES. 
IDERR LDA B5         NO.
      LDB ERR13     NO SPECIAL RECORDS, 
      JMP ERPR4     PRINT ERR MSG/ABORT 
* 
LOAD6 DLD NAM12     NAME GIVEN IN COMMAND?
      SZA,RSS 
      JMP LOAD7     NO, USE NAME FROM SPEC REC
      DST PNM12     YES, USE NAME FROM COMMAND
      LDA NAM50      GET 5TH CHAR 
      STA PNM50 
      JMP LOAD8      WE DID DUP.CHECK ALREADY.
LOAD7 JSB DUPID     NAME GIVEN IN SPECIAL RECORD, 
       DEF PNM12      CHECK FOR DUPLICATE.
* 
LOAD8 LDB SZCOM     GET SIZE OF COMMON
      SZB,RSS 
      JMP LOD8A     SKIP CHECK IF NO COMMON 
      LDA FWAC      GET FWA COMMON
      CMA           SUBTR FROM
      ADA RTORG      FWA REAL-TIME COMMON 
      SSA,RSS       FWAC<RTORG? 
      JMP LOADE      YES, ERROR 
      ADB FWAC      FIND END OF COMMON
      CMB,INB        SUBTRACT FROM
      ADB AVMEM      FWA SYS MEM
      SSB           (FWAC+SZCOM)>AVMEM? 
      JMP LOADE     YES, ERROR. 
* 
LOD8A LDA DMAIN     GET FREE AREA POINTERS
      STA TEMP4      FOR THE MAIN AREA
      DLD PRGMN     GET FINAL BOUNDS OF PROG
      JSB CKBND      SEE IF FIT. (IN CASE BSS USED) 
       JMP LOADC     ERROR. 
* 
      LDA DBASE    GET FREE AREA POINTERS 
      STA TEMP4     FOR THE BASE PAGE AREA
      DLD PRGBP    GET FINAL BOUNDS OF PROG 
      JSB CKBND     SEE IF FIT. (IN CASE BSS USED)
       JMP LOADC     ERROR. 
* 
* 
* 
*       MOVE ID SEGMENT TO SYSTEM AREA
* 
* 
LOD8B LDA PNM50     GET 5TH CHAR
      AND LHALF      MASK OUT TYPE
      INA            FORCE TO TYPE 1
      STA PNM50 
      LDA MD28     DONE LOAD, COPY ID SEG.
      STA TEMP     SET UP COUNT.
      LDA DDMID     SET UP ADDR 
      STA BADDR      FOR DATA WORDS.
      LDB CURID     SET ADDR FOR CORE LOC.
      JMP *+3       DON'T MOVE LINKAGE WORD 
* 
LOAD9 LDA BADDR,I 
      JSB SYSET     MOVE A WORD TO ID SEG 
      INB 
      ISZ BADDR 
      ISZ TEMP
      JMP LOAD9     REPEAT TILL DONE. 
* 
      LDA MSG1+1    SET UP DONE 
      STA BUF        MESSAGE WITH 
      LDA MSG1+2     PROG NAME
      STA BUF+1 
      LDA MSG1+3
      STA BUF+2 
      LDB DWRD1+1   GET ADDR OF PROG NAME 
      LDA LINE2     GET ADDR IN MSG FOR NAME
      INA 
      JSB MVNAM     MOVE NAME TO MSG
      LDA D10 
      STA TEMP3 
      JSB DSPLA     DISPLAY MESSAGE 
      JMP STOP      END APLDR.
* 
* 
*      ERROR RETURNS FROM LOADING SECTION 
* 
ABS13 JSB REMER     MEMORY ERROR
      JSB IHILO     CLEAR HI,LO ADDR
      JMP ABS1      GO RE-ESTABLISH HI/LO.
* 
ABS14 LDB ERR12     ABS<FWAM OR ABS>LWAM
      JMP ERPR4      SO ABORT 
* 
LOADC LDA B,I       GET NAM12 FROM ID 
      SZA,RSS       PROG REMOVED YET? 
      JMP LOD8B      YES. 
      JSB REMER     FINAL MEMORY ERROR
      JMP LOD8A     CHECK AGAIN 
* 
LOADD LDA DBLNK     NO BLANK
      STA MT.ID+1    ID SEG 
      LDA A00       SET ZEROES IN MSG 
      STA MT.ID+2 
      LDA D11 
      LDB MT.ID     SET UP MESSAGE
ERMPR JSB STUFP     PRINT MESSAGE 
      JMP ABORT     THEN ABORT. 
* 
LOADE LDB ERR11     ABS USED TOO MUCH COMMON
ERPR4 LDA B2        GET COUNT TO
      JMP ERMPR     PRINT ERR MSG, ABORT
      SKP 
* ****************************
*       SUBROUTINES USED IN LOAD AND ABSOLUTE RECORD PROCESSORS 
* ****************************
* 
*       DUPID CHECKS FOR DUPLICATE PROGRAM NAME, ISSUES ERROR 
*       MESSAGE AND ATTEMPTS TO CHANGE PROGRAM NAME.  ABORTS IF 
*       STILL NOT UNIQUE. 
*         JSB DUPID 
*         DEF PNAME 
*         <RETURN A,B DESTROYED>
* 
DUPID NOP           SEARCH FOR DUPLICATE
      LDA DUPID,I    ID NAME. 
      STA DUPNM     SAVE ID NAME. 
      ISZ DUPID 
DUP1  JSB STRID     INIT ID SCANNER.
DUP2  JSB SRCID     FIND ID SEG 
DUPNM  NOP           WITH SAME NAME 
       JMP DUPID,I  NO DUPLICATE. 
       JMP DUP2     REPEAT TIL DONE.
      LDA ERR02     DUPLIC. PROG ERR
      LDB DUPNM 
      JSB ERROR 
* 
      LDA C$$       CHANGE NAME ONLY ONCE 
      CPA DUPNM,I    IF NAME ALREADY CHANGED, 
      JMP ABORT      THEN ABORT,
      STA DUPNM,I    ELSE SEARCH AGAIN. 
      JMP DUP1
* 
* ****************************
* 
*       SYSET SETS A WORD INTO A CORE LOCATION. 
*         LDA WORD
*         LDB ADDR
*         JSB SYSET 
*         <RETURN A,B UNCHANGED>
* 
SYSET NOP           SYSTEM WORD SETTER. 
      JSB $LIBR     TURN OFF THE
       NOP           INTER. SYS.
      STA B,I       STORE WORD INTO SYS.
      JSB $LIBX     RESTORE INTER SYS 
       DEF SYSET     AND RETURN.
* 
* *********************************** 
* 
*       IHILO INITIALIZES DEFAULT HIGH AND LOW BOUNDS 
*       OF FREE MEMORY. 
*         JSB IHILO 
*         <RETURN A,B DESTROYED>
* 
IHILO NOP           INITIALIZE HI/LO ADDRS
      LDA BKLWA      TO FIND HIGHEST
      STA HMAIN      AND LOWEST 
      LDA B1647 
      STA HBASE      ADDRS OF UNUSED
      LDA RTORG      CORE WHICH MAY BE
      STA LMAIN      USED FOR LOADING 
      LDA BPA1
      STA LBASE      ABS PROGRAMS 
      CLA 
      STA LMID
      STA HMID
      STA LBID
      STA HBID
      JMP IHILO,I   RETURN
* 
* ******************************* 
* 
*       CKBND CHECKS PROGRAM BOUNDS AGAINST THAT OF FREE
*       CORE (TEMP4 POINTS TO FREE CORE POINTERS).
*         LDA PRGLO     LOW ADDR OF CORE USED 
*         LDB PRGHI     HI ADDR 
*         JSB CKBND 
*         <ERROR RETURN>
*         <NORMAL RETURN A,B DESTROYED> 
* 
CKBND NOP           CHECK BOUNDS OF PROG
      DST TEMP       AGAINST BOUNDS OF FREE CORE
      DLD TEMP4,I   GET LFREE 
      CMA,INA        SUBTR FROM 
      ADA TEMP       LOW ADDR 
      SSA           ADDR>=LFREE?
      JMP CKBND,I    NO, ERROR
* 
      LDA TEMP4 
      ADA B2
      DLD A,I       GET HFREE 
      CMA            SUBTR FROM 
      ADA TEMP1      HI ADDR
      SSA           ADDR<=HFREE?
      ISZ CKBND     RETURN TO P+2 IF NO ERROR 
      JMP CKBND,I   RETURN TO P+1 IF ERROR
* 
* **************************
* 
*       REMER ISSUES "REM XXX" ERROR MESSAGE IF NEED TO REMOVE
*       A PROGRAM TO GET SPACE IN CORE, THEN SUSPENDS APLDR.
*       IF SPACE BELONGS TO THE SYSTEM, APLDR IS ABORTED. 
*         LDB PNAME     PROG WHICH MUST BE REMOVED
*         JSB REMER 
*         <RETURN A,B DESTROYED>
* 
REMER NOP           -REM XXXXX- ERROR 
      SZB,RSS       MEMORY ERROR. 
      JMP ABS14      OUTSIDE AVAILABLE MEM
      LDA ERR01     GIVE -REM XXXXX- MESSAGE
      JSB ERROR 
      JSB EXEC      CALL EXEC 
       DEF *+2        TO SUSPEND
       DEF B7         THE APLDR.
      JMP REMER,I   RETURN
* 
* ******************************
* 
* 
MD28  DEC -28 
* 
B240  OCT 240 
B1647 OCT 1647
B2300 OCT 2300
* 
* 
D24   DEC 24
D64   DEC 64
* 
BPMSK OCT 1777
C$$    ASC 1,$$       NAME CHANGE CHAR. 
* 
ABSSZ NOP 
FILE  NOP 
CURID NOP 
IDOFS NOP 
BADDR NOP 
LDRCT NOP 
WORD1 NOP 
WORD2 NOP 
* 
*       DO NOT CHANGE ORDER OF FOLLOWING
* 
LMAIN NOP 
LMID  NOP 
HMAIN NOP 
HMID  NOP 
LBASE NOP 
LBID  NOP 
HBASE NOP 
HBID  NOP 
DMAIN DEF LMAIN     ADDR OF HI/LO ADDR FOR MAIN 
DBASE DEF LBASE     ADDR OF HI/LO ADDR FOR BASE PAGE
* 
* 
DWRD2 DEF DWR2,I
DWRD1 DEF *+1,I     DUMMY ID ADDRESSES
      DEF PNM12     NAM12 
      DEF PNM50     NAM50/TYPE
      DEF RESML     RESOL/MULT
      DEF HRS       HR
      DEF SEC       SEC 
      DEF PRGMN     LOW MAIN
      DEF PRGBP     LOW BASE
      DEF FWAC      FWA COMMON
DDMYD DEF JMPXF     JMP XFER
* 
DWR2  DEF PNM34     NAM34 
      DEF PRIOR     PR
      DEF SPAR1     SPARE WORD
      DEF MIN       MIN 
      DEF MSEC      MSEC
      DEF PRGM2     HMAIN 
      DEF PRGB2     HBASE 
      DEF SZCOM     SIZE COMMON 
      DEF XFER      XFER ADDR 
* 
      HED <RTE-C APLDR>  RP: REPLACE PROGRAM
REPL  LDA NAM12     IS IT A 
      SZA,RSS        BLANK NAME?
      JMP REPNO      YES, ERROR 
* 
REP00 JSB STRID     INIT ID SEARCH
REP01 JSB SRCID      TO FIND ID SEG 
DFNAM  DEF NAM12     WITH SAME NAME 
       JMP REPNO    NO SUCH PROG
       JMP REP01
      STA CURID     GOT IT, SAVE ID ADDR
      STB TEMP       SAVE ADDR OF ID NAME 
* 
      JSB $LIBR     TURN OFF INT. SYS.
       NOP
      ADA D8
      LDA A,I       POINT OF SUSPENSION 
      SZA            IS ZERO? 
      JMP REP03      NO, SUSPEND APLDR
      ADB B3
      LDA B,I 
      SZA           IS STATUS DORMANT?
      JMP REP03      NO, SUSPEND APLDR
      ADB B2
      LDA B,I 
      ALF,CLE,ERA 
      SEZ           IN TIME LIST? 
      JMP REP03      YES, SUSPEND APLDR 
* 
      DLD ZERO      CLEAR OUT NAME
      DST NAM12     -IN CALL SO WE CAN
      STA NAM50      USE NAME FROM ABS PROG 
      DST TEMP,I    CLEAR ID SEGMENT
      LDB TEMP
      ADB B2        FOR REPLACEMENT 
      STA B,I       BY THE RP COMMAND 
      JSB $LIBX     RESTORE INT SYS 
       DEF *+1
       DEF LOAD3     GO LOAD PROG 
* 
*       ERROR RETURNS FROM REPLACE
* 
REP03 JSB $LIBX     RESTORE INT SYS 
       DEF *+1
       DEF *+1
      LDA ERR04     PUT NAME INTO 
      LDB DFNAM      -OF  XXXXX- BECAUSE
      JSB ERROR      NON-ZERO SUSP OR T-LIST
      JSB EXEC      SUSPEND APLDR 
       DEF *+2
       DEF B7 
      JMP REP00     TRY TO REPLACE AGAIN
* 
REPNO LDA ERR03     NO SUCH PROG
      LDB DFNAM      PUT NAME IN ERR MSG
      JSB ERROR      PRINT ERR MSG
      JMP ABORT      THEN ABORT 
      HED <RTE-C APLDR>  PL: PROGRAM LIST 
*     LIST PROGRAMS.
* 
LIST  LDA LU        GET LU PARAM. 
      SZA,RSS       IF ZERO,
      LDA DLIST      USE DEFAULT. 
      STA LU        SET LIST UNIT.
* 
      JSB SPACE     PRINT 
      LDA D19        HEADING. 
      LDB HEAD1 
      JSB PRINT 
      JSB SPACE 
* 
      LDA DBLNK     SET UP OUTPUT BUFFER. 
      STA BUF 
      STA BUF+4 
      STA BUF+6 
      STA BUF+13
* 
      CLA           CLEAR OUT BLANK ID SEG. 
      STA TEMP5      COUNTER. 
* 
      JSB STRID     INIT ID SCANNER.
LIST2 JSB SRCID     SEARCH ID SEGS
       DEF ZERO 
       JMP LIST7     EOF
       JMP LIST3     NON BLANK ID SEG 
      ISZ TEMP5     BLANK ID SEG
      JMP LIST2     GO SEE NEXT ONE.
* 
LIST3 STB TEMP1      SAVE NAME ADDR 
      STA TEMP      SAVE ID ADDR
      LDA LINE      PUT PROG NAME 
      INA            INTO LINE
      JSB MVNAM 
* 
      LDB TEMP
      ADB B6        GET PRIORITY
      LDA B,I        WORD 
      JSB DIV10     DIVIDE BY 10
      STA BUF+5 
* 
      LDB TEMP
      ADB D22       GET PROG ADDRS. 
      STB TEMP
      LDA M2        SET -2 TO GET 
      STA TEMP4      MAIN AND BASE PAGE.
      LDB LINE      INITIALIZE ADDR 
      ADB B7         FOR NUMBER STUFFING. 
LIST4 LDA TEMP,I    GET LOW ADDR. 
      JSB CONV      CONVERT TO ASCII. 
      ISZ TEMP
      LDA TEMP,I    GET HIGH ADDR.
      ADA M1        -1 TO GET REAL HIGH ADDR
      JSB CONV      CONVERT TO ASCII. 
* 
      INB           LEAVE A SPACE.
      ISZ TEMP
      ISZ TEMP4 
      JMP LIST4     GO GET NEXT PAIR OF ADDRS.
* 
      LDA D20 
      LDB LINE
      JSB PRINT     PRINT PROG INFO.
* 
      JMP LIST2     GO GET NEXT ID SEG. 
* 
LIST7 LDA TEMP5     GET # OF BLANK ID SEGS
      JSB DIV10     DIVIDE BY 10
      STA MT.ID+2 
      LDA D11 
      LDB MT.ID 
      JSB PRINT     PRINT "# BLANK ID SEGMENTS" 
* 
DONE  LDA B2        PRINT "DONE"
      LDB MSG1      AFTER THE "APLDR:"
      JMP STOP1 
* 
ABORT LDA B4        PRINT "ABORTED" 
      LDB ERR99      AFTER THE "APLDR:" 
STOP1 JSB STUFP 
STOP  JSB EXEC      CALL EXEC 
       DEF *+2       TO END 
       DEF B6        APLDR. 
* 
      SKP 
*     SUBROUTINES FOR APLDR.
* 
* ***************************** 
* 
*       SPACE PRINTS A BLANK LINE ON LIST DEVICE. 
*         JSB SPACE 
*         <RETURN A,B DESTROYED>
* 
SPACE NOP           PRINT BLANK 
      CLA            LINE.
      LDB MSG1       (B)=DUMMY BUFFER 
      JSB PRINT 
      JMP SPACE,I 
* 
* ***************************** 
* 
*       PRINT PRINTS A LINE ON LIST DEVICE. 
*         LDA WORDS     NO. OF WORDS
*         LDB ADDR      ADDR OF TEXT
*         JSB PRINT 
*         <RETURN A,B DESTROYED>
* 
PRINT NOP 
      STA TEMP1 
      STB MADDR 
      JSB EXEC      CALL EXEC 
       DEF *+5       TO PRINT 
       DEF B2        ON LIST DEVICE 
       DEF LU 
MADDR  NOP
       DEF TEMP1
      JMP PRINT,I 
* 
* ********************************
* 
*       STUFP STUFFS A MESSAGE WITH THE IDENTIFIER "APLDR:" AND 
*       PRINTS IT ON CONSOLE. 
*         LDA WORDS 
*         LDB ADDR
*         JSB STUFP 
*         <RETURN A,B DESTROYED>
* 
STUFP NOP           STUFF MESSAGE INTO
       STB TEMP       SPECIAL IDENTIFIER
      LDB B4        ADD 4 TO
      ADB A          MESSAGE LENGTH 
      STB TEMP3      FOR TOTAL LENGTH 
      CMA,INA 
      STA TEMP2     NEGATIVE COUNT. 
      LDB MSG0
STFLP LDA TEMP,I
      STA B,I 
      INB 
      ISZ TEMP
      ISZ TEMP2 
      JMP STFLP 
      JSB DSPLA      DISPLAY MESSAGE
      JMP STUFP,I    RETURN 
* 
* ******************************
* 
*       DSPLA PRINTS A MESSAGE ON THE CONSOLE.  THE MESSAGE 
*       ADDRESS IS IN MSG AND THE WORD LENGTH IS IN TEMP3.
*         JSB DSPLA 
*         <RETURN A,B DESTROYED>
* 
DSPLA NOP 
      JSB EXEC
       DEF *+5
       DEF B2        CALL EXEC
       DEF KYBDU      TO WRITE
       DEF MSG        MESSAGE ON
       DEF TEMP3      OPERATOR CONSOLE. 
      JMP DSPLA,I     RETURN
* 
* ******************************
* 
*       MVNAM MOVES A PROGRAM NAME (3 WORDS) AND FILLS AN 
*       ASCII BLANK IN THE DESTINATION NAME.
*         LDA DEST      ADDR OF DESTINATION FOR NAME
*         LDA SORC      ADDR OF SOURCE NAME 
*         JSB MVNAM 
*         <RETURN A,B DESTROYED>
* 
MVNAM NOP           MOVE PROG NAME
      STA TEMP4     TO GIVEN DESTINATION
      LDA B,I 
      STA TEMP4,I   MOVE CHAR1,2
      ISZ TEMP4 
      INB 
      LDA B,I 
      STA TEMP4,I   MOVE CHAR3,4
      ISZ TEMP4 
      INB 
      LDA B,I 
      AND LHALF     PUT ASCII BLANK 
      IOR B40        IN CHAR6 
      STA TEMP4,I    THEN MOVE
      JMP MVNAM,I   RETURN
* 
* ******************************* 
* 
*       ERROR PUTS A PROGRAM NAME INTO AN ERROR MESSAGE 
*       THEN PRINTS IT ON THE CONSOLE.
*         LDA ERRAD     ADDR OF ERROR MESSAGE 
*         LDB PNAME     ADDR OF PROGRAM NAME
*         JSB ERROR 
*         <RETURN A,B DESTROYED>
* 
ERROR NOP           PUT NAME INTO 
      STB TEMP5      ERR MSG THEN 
      DLD A,I        PRINT IT 
      DST BUF       MOVE ERR MSG TO OUTPUT AREA 
      LDB TEMP5     GET ADDR OF NAME
      LDA LINE2      TO PUT INTO MSG
      JSB MVNAM 
      LDA D9
      STA TEMP3     SET LENGTH FOR
      JSB DSPLA        DISPLAY
      JMP ERROR,I   RETURN
* 
* ***************************** 
* 
*       STRID INITIALIZES ID SEGMENT SEARCH ROUTINE.
*         <RETURN A,B DESTROYED>
* 
STRID NOP           INITIALIZE ID SCANNER.
      LDA KEYWD     GET KEYWORD ADDRESS 
      STA ADRID       STORE AS ID ADDRESS.
      JMP STRID,I    RETURN 
* 
* ***************************** 
* 
*       SRCID FETCHS AN ID SEGMENT AND SEES IF MATCH/NO MATCH/BLANK.
*         JSB SRCID 
*         DEF PNAME     ADDR OF NAME TO SEARCH FOR
*         <RETURN-END OF LIST>
*         <RETURN-BLANK ID SEGMENT> 
*         <RETURN-MATCHING ID SEGMENT>
*           A CONTAINS ADDR OF ID SEGMENT 
*           B CONTAINS ADDR OF NAME IN ID SEGMENT 
* 
SRCID NOP           SEARCH ID SEGMENTS
      LDA SRCID,I    FOR A CERTAIN NAME.
      STA TEMP1     SAVE ADDR OF NAME 
      ISZ SRCID     SET RETURN AT P+2 
      LDB ADRID,I   PICK UP AN ID ADDR
      SZB,RSS       IS IT END OF ID SEGS? 
      JMP EOFID      YES
      ADB D12       BUMP TO NAME IN ID
      STB TEMP2     SAVE ADDR OF NAME 
      LDA B,I 
      CPA TEMP1,I   CHECK NAME 1,2
      INB,RSS        MATCHES. 
      JMP NOMAT      NO MATCH.
      ISZ TEMP1 
      LDA B,I 
      CPA TEMP1,I   CHECK NAME 3,4
      INB,RSS        MATCHES. 
      JMP NOMAT      NO MATCH.
      ISZ TEMP1 
      LDA B,I 
      AND LHALF 
      STA STRID     SAVE TEMPORARILY
      LDA TEMP1,I 
      AND LHALF 
      CPA STRID     COMPARE NAME 5
      ISZ SRCID      MATCHES, SET RETURN P+4
* 
NOMAT ISZ SRCID      NO MATCH, RETURN P+3 
      LDA ADRID,I   READY FOR RETURN. 
      ISZ ADRID 
      LDB TEMP2 
EOFID JMP SRCID,I   RETURN. 
* 
* ***************************** 
* SUBROUTINE: CONV  (CONVERT 15-BIT BINARY NUMBER 
*  TO 6-CHAR (LEADING BLANK) ASCII FORM OF OCTAL NUMBER 
* CALLING SEQUENCE: 
*             (A)-BINARY VALUE FOR CONVERSION 
*             (B)-ADDRESS OF 3-WORD AREA FOR
*                   STORING ASCII/OCTAL CHARACTERS
*       (P)    JSB  CONV
*       (P+1)  (RETURN):
*             (A) DESTROYED.
*             (B) ADDRESS OF NEXT STORAGE 
* 
CONV  NOP 
      STB TEMP1    SAVE STORAGE AREA ADDRESS
      LDB A 
      RBL          POSITION FIRST DIGIT TO B(15-13).
      LDA M3        LET CONVERT COUNTER 
      STA TEMP2      = -3.
      LDA B40       MAKE FIRST CHARACTER A SPACE. 
CONV1 ALF,ALF      ROTATE CHAR. TO UPPER POSITION 
      STA TEMP3     AND SAVE. 
      BLF,RBR      POSITION NEXT DIGIT TO B(02-00), 
      LDA B 
      AND B7         ISOLATE DIGIT. 
      IOR B60      MAKE AN ASCII CHAR. (60 - 67). 
      IOR TEMP3    PACK IN UPPER CHARACTER
      STA TEMP1,I  AND STORE IN STORAGE AREA. 
      ISZ TEMP1    ADD 1 TO STORAGE AREA ADDRESS. 
      BLF,RBR      ROTATE NEXT DIGIT TO LOW B,
      LDA B         ISOLATE CHAR
      AND B7         IN LOW A,
      IOR B60       MAKE AN ASCII CHAR. 
      ISZ TEMP2    INDEX CONVERT COUNTER
      JMP CONV1     NOT FINISHED. 
      LDB TEMP1    FINISHED, SET (B)= NEXT STORAGE
      JMP CONV,I    AREA WORD ADDRESS AND EXIT. 
* 
* *********************************** 
* 
*       DIV10 CONVERTS A VALUE TO ASCII CHARACTERS
*       (DECIMAL CONVERSION, 99 MAX). 
*         LDA VALUE 
*         JSB DIV10 
*         <RETURN A CONTAINS TWO ASCII CHARACTERS, B DESTROYED> 
* 
DIV10 NOP           DIVIDE BY 10 (99 MAX) 
      CLB            RETURN ASCII IN (A)
      DIV D10 
      ALF,ALF       MOVE TO LEFT HALF 
      ADA B         ADD REMAINDER 
      ADA A00       MAKE ASCII
      JMP DIV10,I   RETURN
      SKP 
*     CONSTANTS AND STORAGE.
* 
      UNS 
M3    OCT -3
M2    OCT -2
M1    OCT -1
* 
B1    OCT 1 
B2    OCT 2 
B3    OCT 3 
B4    OCT 4 
B5    OCT 5 
B6    OCT 6 
B7    OCT 7 
B40   OCT 40
B60   OCT 60
* 
D8    DEC 8 
D9    DEC 9 
D10   DEC 10
D11   DEC 11
D12   DEC 12
D19   DEC 19
D20   DEC 20
D22   DEC 22
* 
A00   ASC 1,00
CONSL EQU B1        OPERATOR CONSOLE. 
DINPT EQU B5        DEFAULT INPUT UNIT. 
DLIST EQU B6        DEFAULT LIST UNIT.
LHALF OCT 177400
ZERO  OCT 0,0,0 
ADRID NOP 
KYBDU NOP 
LU    NOP 
* 
TEMP  NOP 
TEMP1 NOP 
TEMP2 NOP 
TEMP3 NOP 
TEMP4 NOP 
TEMP5 NOP 
* 
KBFUN NOP           5-WORD TABLE. 
FILLU NOP 
NAM12 NOP 
NAM34 NOP 
NAM50 NOP 
* 
      SKP 
*     MESSAGES FROM APLDR WITH LOVE.
* 
* 
ERR01 DEF *+1 
      ASC 2,REM 
* 
ERR02 DEF *+1 
      ASC 2,DUP 
* 
ERR03 DEF *+1 
      ASC 2,NO
* 
ERR04 DEF *+1 
      ASC 2,OF
* 
ERR10 DEF *+1 
      ASC 2,CKSM
* 
ERR11 DEF *+1 
      ASC 2,COM 
* 
ERR12 DEF *+1 
      ASC 2,MEM 
* 
ERR13 DEF *+1 
      ASC 2,ID? 
* 
ERR99 DEF *+1 
      ASC 4,ABORTED 
* 
* 
MSG1  DEF *+1 
      ASC 3,DONE- 
* 
* 
MT.ID DEF *+1 
      ASC 11,     BLANK ID SEGMENTS 
* 
HEAD1 DEF *+1 
      ASC 19, PROGRAM LIST: NAME,PRIORITY,MAIN,BASE 
* 
* 
DBLNK EQU ERR04-1     DOUBLE BLANK WORD 
DABSD DEF ABSBF+2 
DDMID DEF DMYID 
LINE  DEF MSG+4 
LINE2 DEF MSG+6 
MSG0  EQU LINE
* 
MSG   ASC 9, APLDR: 
BUF   EQU MSG+4 
* 
ABSBF BSS 64
* 
ABSCT EQU ABSBF 
ABSAD EQU ABSBF+1 
ABSD1 EQU ABSBF+2 
ABSD2 EQU ABSBF+3 
* 
DMYID EQU ABSBF+35
JMPXF EQU DMYID-4 
SPAR1 EQU DMYID-3 
FWAC  EQU DMYID-2 
SZCOM EQU DMYID-1 
PRIOR EQU DMYID+6 
XFER  EQU DMYID+7 
PNM12 EQU DMYID+12
PNM34 EQU DMYID+13
PNM50 EQU DMYID+14
RESML EQU DMYID+17
MSEC  EQU DMYID+18
SEC   EQU DMYID+19
MIN   EQU DMYID+20
HRS   EQU DMYID+21
PRGMN EQU DMYID+22
PRGM2 EQU DMYID+23
PRGBP EQU DMYID+24
PRGB2 EQU DMYID+25
* 
      BSS 0          SIZE OF APLDR
* 
* 
      END APLDR