ASMB,R
      HED <RTE-M APLDR> 
*USE 'ASMB,R,N' (RTE-M I/RTE-M II) OR 'ASMB,R,Z' (RTE-M III)
* 
*     IFN OPTION
*     NAME:   APLDR 
*     SOURCE: 92064-18027 
*     RELOC:  92064-16012 
*     PROGMR: E.J.W.
* 
*     IFZ OPTION
*     NAME  : APLDR 
*     SOURCE: 92064-18027 
*     RELOC:  92064-16016 
*     PROGMR: E.J.W.
* 
*  **************************************************************** 
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980.  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.        * 
*  **************************************************************** 
* 
* 
      IFN 
* BEGIN NON-DMS CODE ***************
      NAM APLDR,1,40  92064-16012  REV.2013  800209 
*** END NON-DMS CODE ***************
      XIF 
      IFZ 
***** BEGIN DMS CODE ***************
      NAM APLDR,1,40  92064-16016  REV.2013  800209 
******* END DMS CODE ***************
      XIF 
      SPC 1 
      EXT $LIBR,$LIBX,EXEC,$CVT3
      EXT IDCB1,OPEN,READF,LOCF,CLOSE,IMESS,$CON
      SPC 1 
      IFN 
* BEGIN NON-DMS CODE ***************
      EXT .MVW
*** END NON-DMS CODE ***************
      XIF 
      IFZ 
***** BEGIN DMS CODE ***************
      EXT $MATA,$ENDS 
******* END DMS CODE ***************
      XIF 
      SPC 1 
* 
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#,OPT 
*           (1)(0)
*        LO,PNAME,SC,DRN-LU,PTTN#,SIZE
*            LU#
*            (4)  (0)  (0)   (0)   (0)
* 
*   THE SCHEDULE CALL PASSES THE PARAMETERS IN THE FOLLOWING
*   ORDER:
*        P1 - LU 4:9 / FUNC 0:3 
*        P2 - #PAGES 10:14  / PTTN# 0:5   OR  LIST OPTION 
*        P3 - CHAR1 8:15  / CHAR2 0:7 
*        P4 - CHAR3 8:15  / CHAR4 0:7 
*        P5 - CHAR5 8:15  / CHAR6 0:7 
* 
*   WHERE FUNCTION CODE IS: 
*        0 - PROGRAM LIST 
*        1 - LOAD PROGRAM INTO MEMORY RESIDENT AREA 
*        2 - LOAD PROGRAM INTO A PARTITION
      SKP 
APLDR NOP 
      LDA DPARM     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 
* 
      ADB D20       INDEX TO WORD 27
      STB DFSC       SAVE ADDR OF SECURITY CODE 
      INB 
      STB DFCR       SAVE ADDR OF CART.REF.OR NEG.LU# 
      LDA ERLUF 
      ALF,ALF 
      ALF 
      AND B77 
      STA LU        SAVE LU FOR LISTING 
* 
* 
      LDA ERLUF     GET FUNCTION FROM BITS 0-3
      AND B17 
      STA FUNC
      SZA,RSS       IS IT LIST?     0 
      JMP LIST
      CPA D1        IS IT LOAD?     1 
      JMP LOAD
      IFZ 
***** BEGIN DMS CODE ***************
      CPA D2        IS IT PARTITION LOAD? 2 
      JMP LOAD
******* END DMS CODE ***************
      XIF 
* 
      UNL 
*     EXT DBUG      *** DEBUGGING *** 
*     JSB DBUG      *** DEBUGGING *** 
*     DEF *+1       *** DEBUGGING *** 
* 
      NOP           *** DEBUGGING *** 
      NOP           *** DEBUGGING *** 
      LST 
* 
      JMP ABORT     NO, IT IS ERROR.
* 
DPARM DEF ERLUF 
MD5   DEC -5
B77   OCT 77
D3    OCT 3 
D20   DEC 20
FUNC  NOP           FUNCTION CODE 
      HED <RTE-M APLDR>  LO: LOAD PROGRAM 
DMAGI DEF MAGIC     ADDR OF MAGIC LU FILENAME 
MAGIC BSS 3 
* 
DFNAM DEF MAGLU     ADDR OF DEFAULT FILENAME
MAGLU ASC 3,LU..04   WHICH IS MAGIC LU FILENAME FOR LU 4
* 
* 
LOAD  EQU * 
      SPC 1 
      IFZ 
***** BEGIN DMS CODE ***************
      CLA 
      STA PT#PG 
      STA PTTN# 
******* END DMS CODE ***************
      XIF 
      SPC 1 
      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 AB12D     FOR SPEC. REC.
      CLA 
      STA ABS12 
      STA ABSCT     INDICATE NO ABS YET.
* 
LOAD1 LDA NAM12     IF NO NAME GIVEN
      LDB DFNAM      USE DEFAULT INPUT FILE 
      SZA 
      LDB DNM12 
      STB NAM 
* 
      LDA B,I       GET FIRST WORD OF NAME
      AND B77 
      CPA B,I       LEGAL NUMERIC LU? 
      RSS            YES, SKIP
      JMP LOAD3      NO, ASSUME IT'S ASCII NAME 
* 
      LDB DMAGI     CONVERT NUMERIC LU TO MAGIC LU FILENAME 
      STB NAM        (A) STILL HAS LU#
      JSB CVDEC 
      DLD MAGLU 
      DST MAGIC 
      LDA MAGIC+2   GET DIGITS PORTION
      IOR A00        INSURE ASCII ZEROES IF ANY 
      STA MAGIC+2 
* 
LOAD3 JSB STRID 
LOAD2 JSB SRCID     FIND A BLANK
       DEF ZERO      ID SEG.
       JMP LOADD    NO BLANK ID SEG.
       JMP LOAD2    KEEP LOOKING. 
      STA CURID     GOT IT, SAVE ADDR.
* 
      JSB OPEN      OPEN THE ABS INPUT FILE 
       DEF *+7
       DEF IDCB1
       DEF ERR
NAM    DEF *        FILE NAME ADDR
       DEF OPT      OPT = 2300B FOR ABS 
DFSC   DEF *        SECURITY CODE 
DFCR   DEF *        CARTRIDGE NUMBER OR NEG.LU# 
      SSA           ANY ERRORS? 
      JMP NOFIL      NO SUCH FILE 
* 
      JSB LOCF      GET FILE INFO 
       DEF *+9
       DEF IDCB1
       DEF ERR
       DEF TEMP1
       DEF TEMP1
       DEF TEMP1
       DEF TEMP1
       DEF TEMP1
       DEF TEMP 
      LDA TEMP
      SZA,RSS       TYPE 0 FILE?
      STA NAM12      FORCE USE OF TRAILER RECORD
      SZA,RSS 
      JMP ABS0       YES, SKIP DUP NAME CHECK NOW 
* 
      JSB DUPID     CHECK FOR DUPLICATE NAME
DNM12  DEF NAM12     CHANGE TO ..NAME IF POSSIBLE 
* 
*     READ AN ABSOLUTE RECORD 
* 
* 
ABS0  JSB READF     READ ABS RECORD 
       DEF *+6
       DEF IDCB1
       DEF ERR
DABS   DEF ABSBF
       DEF D64
       DEF LEN
      LDB LEN 
      CPB M1        EOF?
      JMP LOAD5      YES. 
      SSA 
      JMP ABSCK     ANY ERROR, CHECKSUM ERROR 
* 
      LDA ABSCT     GET WORD COUNT
      AND LHALF 
      ALF,ALF       SHIFT TO LOW BITS 
      STA ABSSZ     SAVE REC SIZE 
      CMA,INA 
      STA 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
* 
ABSCK LDB ERR10     CHECKSUM ERROR- 
      JMP ERPR4      ERR MSG THEN ABORT 
* 
NOFIL CMA,INA       FMP ERROR CODE IN (A) 
      LDB DABS      GET DEF TO TEMP BUFFER
      JSB CVDEC     CONVERT ERR CODE TO ASCII 
      LDA LDASH 
      IOR ABSAD     FILL IN "- "
      STA ABSAD      FOR " APLDR: -###" 
      LDB DABS
      INB           SET ADDR OF 4 CHARS 
      JMP ERPR4     PRINT ERROR, THEN ABORT 
* 
*       FIND WHERE ABSOLUTE RECORD FITS IN CORE 
* 
* 
ABS1  LDA ABSAD 
      LDB ABSCT 
      CPB HI2       ONLY 2 WORDS IN REC?
      RSS 
      JMP ABS1A      NO, CHECK NORMAL RECORD
      CPA D2        IS IT SPECIAL RECORD? 
      JMP ABS12      YES
ABS1A AND BPMSK     IS IT BASE PAGE?
      CPA ABSAD 
      JMP ABS2       YES, BASE PAGE.
* 
      SPC 1 
      IFZ 
***** BEGIN DMS CODE ***************
      LDA FUNC
      CPA D2        LOAD PTTN?
      JMP PTMN       YES, SET BOUNDS FOR ADDR CHECKS
* 
******* END DMS CODE ***************
      XIF 
      SPC 1 
      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  EQU * 
      SPC 1 
      IFZ 
***** BEGIN DMS CODE ***************
      LDA FUNC
      CPA D2        LOAD PTTN?
      JMP PTBP       YES, SET BOUNDS FOR ADDR CHECKS
* 
******* END DMS CODE ***************
      XIF 
      SPC 1 
      LDA BPA1      GET DEFAULT LOWEST ADDR 
      STA TEMP
      LDA BPA2      GET DEFAULT HIGHEST ADDR
      INA 
      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 D2
      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.
* 
      LDA B         (B) STILL HAS ADDR OF NAME
      ADA D2         BUMP TO TYPE 
      LDA A,I 
      AND B17       GET TYPE FROM ID SEG
      CPA D1        MEMORY RESIDENT TYPE? 
      RSS            YES, CHECK ADDRS 
      JMP ABS4       NO, IGNORE ID
* 
      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
      SPC 1 
      IFZ 
***** BEGIN DMS CODE ***************
      LDA FUNC
      CPA D1        LOAD MEMORY RESIDENT? 
      JMP LDMRP      YES
* 
REMAP LDA ABSAD      NO, LOAD PARTITION RESIDENT
      JSB PGNO      GET PAGE OF RECORD
      STA PAGE1 
      SZA,RSS       RECORD FOR BASE PAGE? 
      JMP BPMAP      YES
* 
      LDA ABSAD 
      ADA ABSSZ     GET ADDR OF LAST WORD IN RECORD 
      ADA M1
      STA ABSEN     SAVE ADDR OF LAST WORD IN REC 
      JSB PGNO      FIND PAGE OF THAT WORD
      STA B 
      STB PAGE2     SAVE ENDING PAGE NUMBER 
      CPB PAGE1     RECORD FITS WITHIN ONE PAGE?
      JMP SAMEP      YES
* 
      BLF,BLF        NO, CROSSES ONE PAGE 
      RBL,RBL        ASSUMING RECORD SIZE < 128 WORDS 
      STB PADDR     SAVE PAGE BOUNDARY ADDR 
      LDA ABSAD 
      CMA,INA 
      ADA PADDR     CALCULATE #WORDS ON THIS PAGE 
      CAX 
      STA WDS1
      LDA PTFWA 
      JSB PGNO
      STA B 
      CMB,INB       SUBTRACT PTTN PAGE# 
      ADB PAGE1      TO GET #PAGES OFFSET 
      ADB PTSPG      AND OFFSET FROM FIRST PAGE OF PTTN 
      INB           (B) = PHYSICAL PAGE #  AFTER COUNTING BP
* 
      LDA ABSAD 
      CAY           (Y) = LOGICAL ADDR FOR RECORD 
      LDA DABSD     (A) = ADDR OF RECORD IN INPUT BUFFER
      JSB MAPMV     PERFORM MAPPING WORD MOVE 
* 
      LDA PAGE2     SET UP TO MOVE SECOND PART
      ALF,ALF 
      RAL,RAL       CONVERT PAGE# TO ADDR 
      CMA,INA       SUBTRACT FROM END ADDR
      ADA ABSEN      TO GET # WORDS 
      INA 
      CAX           (X) = # WORDS TO MOVE 
      LDA PTFWA 
      JSB PGNO
      STA B 
      CMB,INB       SUBTRACT FIRST PAGE OF PTTN 
      ADB PAGE2      TO GET #PAGES OFFSET 
      ADB PTSPG      ADD TO PTTN FIRST PAGE 
      INB           (B) = PAGE #
      LDA PADDR 
      CAY           (Y) = LOGICAL ADDR FOR RECORD 
      LDA DABSD 
      ADA WDS1      (A) = ADDR OF ABS REC IN INPUT BUFFER 
      JSB MAPMV     DO MAPPED MOVE
      JMP ABS0      GO READ MORE
* 
SAMEP LDA PTFWA 
      JSB PGNO
      STA B 
      CMB,INB 
      ADB PAGE1 
      INB 
      ADB PTSPG 
SAMEM LDA ABSSZ 
      CAX           (X) = #WORDS
      LDA ABSAD 
      CAY           (Y) = LOGICAL ADDR IN PTTN
      LDA DABSD     (A) = ADDR OF REC IN INPUT BUFFER 
      JSB MAPMV     DO MAPPED MOVE
      JMP ABS0      GO READ MORE
* 
BPMAP LDB PTSPG 
      JMP SAMEM 
* 
* 
PGNO  NOP           CONVERT ADDR TO PAGE #
      AND B76K
      ALF,RAL 
      RAL 
      JMP PGNO,I    RETURN (A)=PAGE #  (B)=UNCHANGED
* 
*   (A) = ADDR OF ABS REC IN INPUT BUFFER 
*   (B) = PAGE # OF PARTITION 
*   (X) = # WORDS TO MOVE 
*   (Y) = LOGICAL ADDR FOR ABS IN PTTN
* 
MAPMV NOP           MAPPED MOVE ROUTINE 
      STA MAPFR      TO MOVE ABS RECS TO PTTN 
      CYA 
      STA LOGSA     SAVE LOGICAL ADDR 
      CXA 
      STA NWDS      SAVE # WORDS
* 
      CLA,INA 
      CAX           (X) = 1 REGISTER TO SET UP
      LDA MAPPG     (A) = MAP REGISTER #
      JSB $LIBR     TURN OFF MEM PROT 
       NOP           SO WE CAN CHANGE MAP, ALSO MOVE TO BP
      XMS           (B) = PTTN'S PAGE # 
      LDA LOGSA     CONVERT LOG ADDR TO PAGE# 
      AND B76K
      CMA,INA 
      ADA LOGSA     OFFSET INTO PAGE
      ADA PAGBF     MAKE LOGICAL ADDR FOR MAPPED MOVE 
      STA B         (B) = ADDR OF DUMMY BUFFER FOR MOVE 
      LDA NWDS
      CAX           (X) = #WORDS TO MOVE
      LDA MAPFR     (A) = ADDR OF ABS REC IN BUFFER 
      MWI           MOVE WORDS VIA DUMMY BUFFER IN SYS MAP
      JSB $LIBX 
       DEF MAPMV    RETURN
* 
MAPFR NOP           ADDR OF ABS REC IN BUFFER 
LOGSA NOP           LOGICAL ADDR OF ABS REC IN PTTN 
MAPPG DEC 31        LAST PAGE IN SYSTEM MAP 
PAGBF OCT 76000     ADDR OF DUMMY BUFFER FOR CROSS MAP STORE
NWDS  NOP           #WORDS TO MOVE
PADDR NOP           PAGE BOUNDARY ADDR
B1777 OCT 1777
B76K  OCT 76000 
C100K OCT 77777 
CURPT NOP           ADDR OF CURRENT PTTN OWNER PTR
PAGE1 NOP           PAGE # OF FIRST PART OF REC 
PAGE2 NOP           PAGE # OF SECOND PART OF REC
ABSEN NOP           ADDR OF LAST WORD IN REC
PT#PG NOP           #PAGES IN PTTN
PTFWA NOP           LOGICAL ADDR OF FIRST WORD IN MAIN OF PTTN
PTLWA NOP           LOGICAL ADDR OF LAST WORD IN MAIN OF PTTN 
PTSPG NOP           PAGE # OF FIRST PAGE IN PTTN
PTTN# NOP           PTTN #
WDS1  NOP           # WORDS IN FIRST PAGE OF REC
DCRID DEF CURID 
* 
* 
PTMN  LDA DMAIN     GET PTRS TO MAIN HI/LO
      RSS           GO CHECK BOUNDS OF REC
* 
PTBP  LDA DBASE     GET PTRS TO BP HI/LO
      STA TEMP4 
      JMP ABS6      GO CHECK BOUNDS OF REC
* 
******* END DMS CODE ***************
      XIF 
      SPC 1 
* 
* 
LDMRP LDA DABSD     SET UP BUFFER 
      LDB ABSAD     SET UP CORE ADDR. 
      JSB SYSET     PUT INTO CORE.
       DEF ABSSZ
      JMP ABS0      GO GET ANOTHER RECORD 
* 
* 
* 
*       PROCESS SPECIAL TRAILER RECORDS.
* 
* 
ABS12 NOP           RSS-ED AFTER SSGA SET UP. 
      JMP AB12C 
AB12D 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 AB12D     NOP SWITCH
* 
AB12B LDA WORD1 
      CPA DWRD2     ALL DONE ALREADY? 
      JMP IDERR      ERROR ON TRAILER RECORDS 
      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
* 
*  MPFT#  0-PRP NO COM, 1-MRP NO COM, 2-RT COM, 3-XXX, 4-SSGA 
* 
AB12C LDA RSS 
      STA ABS12     SET  RSS  IN THE SSGA SWITCH
      CLB,INB       PREPARE FOR FUNC=1 FOR MRP
      LDA ABSD1     FIRST SPECIAL RECORD
      RAL,CLE,ERA   SIGN BIT 0-MRP, 1-PRP 
      STA MPFT#      HAS MPFT INDEX 
      SEZ           IS IT MEMORY RESIDENT?
      INB            NO, SET FUNC=2 FOR PTTN LOAD 
      STB FUNC      OVERRIDE FUNC WITH ABS TYPE 
      SEZ,RSS       IS IT MEMORY RESIDENT?
      JMP ABS0       YES, READ NEXT RECORD
      SPC 1 
      IFN 
* BEGIN NON-DMS CODE ***************
      JMP IDERR     M1 OR M2 DOESN'T ALLOW PRP
*** END NON-DMS CODE ***************
      XIF 
      IFZ 
***** BEGIN DMS CODE ***************
      LDA PGPT
      JSB PGNO
      CMA,INA 
      INA 
      STA PT#PG     SAVE NEG #PAGES-1 
      CCB 
      ADB $MATA     (B) = ADDR OF #PTTNS
      LDA PGPT
      AND B77       GET PTTN #
      SZA,RSS       SPECIFIC PTTN# WANTED?
      JMP PTFND      NO, FIND A FREE ONE
* 
      ADA M1        SAVE PTTN# - 1
      STA PTTN# 
      CMA 
      ADA B,I       SUBTRACT FROM #PTTNS
      CMA 
      SSA,RSS       ANY ERROR?
      JMP ER.PT      YES, NO SUCH PTTN
* 
      LDA PTTN#     6*(PTTN#-1)+$MATA 
      MPY D6         IS ADDR OF ENTRY IN MAP TABLE
      ADA $MATA 
      ADA D2        INDEX TO ID OF PTTN OWNER 
      LDB A,I 
      SZB           IS PTTN FREE? 
      JMP PTTNO      NO, PTTN IS OCCUPIED 
* 
      LDB A 
      ADB D2        INDEX TO RESERVED FLAG
      LDB B,I        AND PTTN SIZE WORD 
      RBL,CLE,ERB   KEEP RESERVE FLAG IN (E)
      ADB PT#PG 
      CCE,SSB       PTTN LARGE ENOUGH?
      JMP PT.SZ 
* 
PTFR  LDB PTTN# 
      RBL,ERB       SET SIGN BIT FROM (E) 
      STB PTTN#      FOR PARTITION REQUESTED
      STA CURPT     SAVE CURR PTTN OWNER PTR
      LDB A 
      ADB M2        BACK UP TO LINK WORD
      LDB B,I 
      SSB           IS PTTN DEFINED?
      JMP ER.PT      NO.  GIVE 'PTN' ERROR
* 
      INA 
      LDB A,I 
      STB PTSPG     SAVE PTTN START PAGE #
      INA 
      LDB A,I 
      STB PT#PG     SAVE #PAGES IN PTTN 
      JMP PTADR     NOW FIND HI ADDR OF PTTN
* 
PTTNO ADB D12       INDEX B TO ADDR OF NAME 
      LDA ERR14     PTTN OCCUPIED 
      JSB ERROR     -PTN XXXXX- ERROR MESSAGE 
      JMP ABORT 
* 
PTFND CLA 
      STA PTTN#     INIT PTTN# TO 0 
      LDA B,I       GET #PTTNS
      CMA,INA 
      STA TEMP      NEGATE FOR PTTN SCAN
      LDA $MATA 
      ADA D2        LOOK AT EACH PTTN OWNER ID
* 
PTNX  LDB A,I 
      SZB           IS PTTN FREE? 
      JMP PTNFD      NO, PTTN NOT FOUND 
* 
      LDB A 
      ADB D2        INDEX TO SIZE WORD IN MAT ENTRY 
      LDB B,I 
      RBL,CLE,ERB 
      SEZ           RESERVED? 
      JMP PTNFD      YES, KEEP LOOKING
      ADB PT#PG 
      CLE,SSB,RSS   ENOUGH PAGES IN THIS PTTN?
      JMP PTFR       YES, USE THIS   (E=0 TOO)
* 
PTNFD ADA D6         NO, TRY NEXT ONE 
      ISZ PTTN#     BUMP PTTN#
      ISZ TEMP      LOOKED AT ALL OF THEM YET?
      JMP PTNX       NO, KEEP LOOKING 
* 
ER.PT LDB ERR14     NO SUCH PTTN OR NONE FREE 
      JMP ERPR4     -PTN- ERROR AND ABORT 
* 
PT.SZ LDB ERR15     NOT ENOUGH PAGES IN PTTN
      JMP ERPR4      -PTSZ- ERROR AND ABORT 
* 
* 
PTADR LDA MPFT# 
      SZA           IS COMMON OR SSGA NEEDED? 
      JMP USECM      YES
* 
      LDA $ENDS     GET LAST PAGE OF SYSTEM 
      ALF,ALF 
      RAL,RAL 
      JMP STFWA     SET UP FWA FOR USER 
* 
USECM LDA RTORG 
      ADA RTCOM 
      ADA B1777 
      AND B76K
* 
STFWA STA PAGE1     SAVE TEMPORARILY 
      CMA,INA        LOWEST POSSIBLE LOGICAL ADDR 
      STA B 
      LDA ABSD2 
      AND B76K      GET START PAGE OF USER ABS
      ADB A 
      SSB           USER ADDR  <  LOWEST LOGICAL ADDR?
      JMP ABS14      YES "ERR MEM"
* 
      STA PTFWA     SAVE FWA OF PARTITION USER
      STA LMAIN     SAVE FOR BOUNDS CHECK 
      LDB PT#PG     #PAGES - 1 IN PARTITION 
      BLF,BLF 
      RBL,RBL 
      ADB PAGE1     COMPUTE LWA PTTN OR 77777 
      CMA,INA 
      ADA B 
      JSB PGNO
      STA PT#PG     SAVE ACTUAL #PAGES USED 
      ADB M1
      SSB           ADDR > 77777? 
      LDB C100K      YES, SET LWA = 77777 
      STB PTLWA     LWA OF PARTITION AREA 
      STB HMAIN     SAVE FOR BOUNDS CHECK 
      LDA D2
      STA LBASE     SET LOW BASE ADDR FOR BOUNDS CHECK
      LDA BPA2
      INA 
      STA HBASE     SET HI BASE ADDR FOR BOUNDS CHECK 
      JMP ABS0      DONE WITH 1ST SPECIAL, GO READ ABS
* 
******* END DMS CODE ***************
      XIF 
      SPC 1 
* 
* 
* 
* 
*       REACHED END-OF-FILE ON PROGRAM INPUT
* 
* 
LOAD5 LDB ABSCT     CHECK IF ANY ABS
      SZB,RSS        WAS READ YET.
      JMP IDERR     ERROR IF NONE.
      LDA WORD1     SPEC REC MUST BE AT END 
      CPA DWRD2     WAS IT ALL THERE? 
      JMP LOAD6      YES. 
IDERR 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 
      AND LHALF 
      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. 
*