ASMB,Q,C
      HED APLDX: MINI-APLDR FOR RTE-L *(C) HEWLETT-PACKARD CO. 1980*
      NAM APLDX,19,30 91750-16223 REV 2013 800625 (MEMORY-BASED L)
* 
      SPC 1 
*  ***************************************************************
*  * (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 THE HEWLETT-PACKARD COMPANY.   *
*  ***************************************************************
* 
*    NAME:   APLDX
*    SOURCE: 91750-18223
*    RELOC:  91750-16223
*    PGMR:   L. WEIMAN [6/6/80] 
* 
*  <APLDX> IS THE DS/1000 MONITOR WHOSE FUNCTION IS TO PROCESS ALL
*   PROGRAM "LOAD" REQUESTS, EFFECTIVELY PROVIDING AN "RP,<PROG>" FUNCTION, 
*   WHERE THE PROGRAM FILE EXISTS AT SOME REMOTE.  THE MASTER REQUESTS ARE
*   ORIGINATED BY A USER RUNNING PROGRAM "RPRTL".  THIS PROGRAM ONLY HANDLES
*   THE SLAVE SIDE OF ITS REQUESTS. 
      SKP 
* GLBLK-START 
* 
******************************************************************
*                                                                *
*     G L O B A L   B L O C K               REV 2013 791213      *
*                                                                *
*     GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY:      *
*                                                                *
*         REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST        *
*         GET,   #SLAV, RQCNV, RPCNV, GRPM,  DINIT, PTOPM        *
*         EXECM, EXECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3        *
*         DSTIO, LUMAP, #CMGT, INCNV, OTCNV, RMTIO               *
*         RSM,   DLGON, #DISM, #DSSM, #MSSM, #SCSM, #UPSM        *
******************************************************************
* 
***!!!!! THE ORDER OF THE FIRST 8 WORDS (#STR THRU #LVL) IS      *
***!!!!!     FIXED BY THE REQUIREMENT THAT THE STREAM, ADDRESSES *
***!!!!!     ERROR CODES & LEVEL # ALWAYS BE IN THE SAME PLACE,  *
***!!!!!     REGARDLESS OF MESSAGE FORMAT.  THIS ALSO MAKES      *
***!!!!!     STORE-AND-FORWARD CODE MUCH SIMPLER.                *
#STR  EQU 0         STREAM WORD.
#SEQ  EQU #STR+1    SEQUENCE NUMBER.
#SRC  EQU #SEQ+1    SOURCE NODE #.
#DST  EQU #SRC+1    DEST. NODE #. 
#EC1  EQU #DST+1    REPLY ECOD1.
#EC2  EQU #EC1+1    REPLY ECOD2.
#ENO  EQU #EC2+1    NUMBER OF NODE REPORTING ERROR. 
#ECQ  EQU #ENO+1    ERROR CODE QUALIFIER (BITS 4 TO 7)
#LVL  EQU #ECQ      MESSAGE FORMAT LEVEL (BITS 0 TO 3)
* 
#MAS  EQU #LVL+1    MA "SEND" SEQ. #
#MAR  EQU #MAS+1    MA "RECV" SEQ. #
#MAC  EQU #MAR+1    MA "CANCEL" FLAGS 
#HCT  EQU #MAC+1    HOP COUNT 
#SID  EQU #HCT+1    SESSION ID WORD 
* 
#EHD  EQU #SID      LAST ITEM OF HEADER 
#MHD  EQU #EHD+1    MINIMUM HEADER SIZE 
#REQ  EQU #MHD      START OF REQUEST SPECIFIC AREA
#REP  EQU #MHD      START OF REPLY SPECIFIC AREA
* 
#MXR  EQU #MHD+24   <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>>
#LSZ  EQU 2         <<< SIZE OF LOCAL APPENDAGE AREA >>>
* 
******************************************************************
* 
* 
* GLBLK-END 
      SKP 
* APBLK-START 
* 
******************************************************************
*                                                                *
*       A P L D X         G L O B A L  B L O C K  REV 2013 800611*
*                                                                *
*     GLOBAL OFFSETS FOR APLDX MESSAGE BUFFERS, USED BY          *
*                                                                *
*      RPRTL     APLDX                                           *
******************************************************************
* 
* 
* DEFINE APLDX REQUEST BUFFER 
* 
#FCOD EQU #MHD      FUNCTION CODE 
#ERCD EQU #FCOD     ERROR-RETURN CODE 
#P1   EQU #ERCD+1 
#P2   EQU #ERCD+2 
#P3   EQU #ERCD+3 
#P4   EQU #ERCD+4 
#P5   EQU #ERCD+5 
#P6   EQU #ERCD+6 
#P7   EQU #ERCD+7 
#P8   EQU #ERCD+8 
#P9   EQU #ERCD+9 
#P10   EQU #ERCD+10 
#P11   EQU #ERCD+11 
#P12   EQU #ERCD+12 
#ADR  EQU #P1 
* 
***************************************************** 
* 
* 
* APBLK-END 
      SKP 
*     REQUEST FORMAT: 
* 
*     +--------------------------------------------+
*     !                           STREAM=11        !
*     !         STD BEGINNING FORMAT FOR ALL       !
*     !                 DS 1000 MSGS               !
*     !                                            !
* #MHD!  ID               ! FUNCTION CODE (8 BITS) !
*     !     P1                                     !
*     !     P2                                     !
*     !     P3                                     !
*     !     P4                                     !
*     !     P5                                     !
*     !     P6                                     !
*     !     P7                                     !
*     !     P8                                     !
*     !     P9                                     !
*     !     P10                                    !
*     !     P11                                    !
*     !     P12                                    !
*     +--------------------------------------------+
      SPC 2 
*     UNLESS OTHERWISE SPECIFIED, NO DATA BUFFERS ARE USED. 
* 
*     FUNCTION CODES: 
*      0 = ID SEGMENT (IN DATA BUFFER)
*          ID = 31 TO IDENTIFY 'FATHER' AS RPRTL
* 
*          (SLAVE RETURNS MEMORY ADDRESS OF PROGRAM IN REPLY P1)
* 
*      1 = PROGRAM CODE DATA
*          P1 = ADDRESS 
*          DATA BUFFER CONTAINS 1 TO 128 DATA WORDS, TO BE LOADED 
*          INTO MEMORY. 
* 
*      2 = PROGRAM BASE PAGE CODE 
*          P1 = ADDRESS 
*          DATA BUFFER CONTAINS 1 TO 128 DATA WORDS, TO BE LOADED 
*          INTO MEMORY
* 
*      3 = SHORT ID SEGMENTS/END
*          P1,P2,P3 = FILE NAME 
*          P4 = FILE SECURITY CODE
*          P5 = FILE CARTRIDGE REFERENCE NUMBER 
*          P6 = MASTER NODE # 
*          P7 = NUMBER OF SHORT ID SEGMENTS (NEGATIVE)
*          P8 = LOW MAIN
*          P9 = HIGH MAIN+1 
*          P10 = LOW BASE PAGE ADDRESS
*          P11 = HIGH BASE PAGE ADDRESS+1 
*          P12 = ID SEGMENT ADDRESS 
* 
*      4 = MASTER IS ABORTING.  CLEAR ID SEGMENT, ADDRESS SUPPLIED
*          IN P1
* 
*          P1 = ADDRESS OF ID SEGMENT TO BE CLEARING
      SKP 
*     REPLY FORMAT
*     +--------------------------------------------+
*     !01                             STREAM       !
*     + STANDARD BEGINNING FORMAT FOR ALL DS 1000  +
*     +            MSGS                            +
*     +                                            +
*#MHD +  ERROR CODE                                +
*     +  P1                                        +
*     +  P2                                        +
*     +  P3                                        +
*     +                                            +
*     +--------------------------------------------+
* 
*     ERROR CODES:
*     0 = NO ERROR.  ON FUNCTION CODE 0 RQSTS, RTE-L MEMORY ADDRESS 
*         WHERE SLAVE IS PLACING ID SEGMENT IS RETURNED IN P1.
* 
*     1=UNRECOGNIZED FUNCTION CODE (SERIOUS INTERNAL ERROR. SEE HP REP) 
* 
*     2=DUPLICATE PROGRAM NAME.  A PROGRAM ALREADY EXISTS BY THE SAME 
*       NAME. 
* 
*     3=NO BLANK ID SEGMENTS
* 
*     4=PROGRAM CONFLICT.  NAME OF PROGRAM OCCUPYING SAME MEMORY SPACE
*       AS THE ONE YOU WANTED RETURNED IN P1-P3 
* 
*     5=PROGRAM NOT RELOCATED WITH CORRECT SNAPSHOT FILE: CHECKSUM
*       IN FILE DOES NOT MATCH SYSTEM CHECKSUM AT RTE-L.
* 
*     6=ILLEGAL BG LOAD ATTEMPT:  ATTEMPT TO LOAD PROGRAM IN BACKGROUND,
*       BUT LOAD/SWAP MODULES INCLUDED IN RTE-L GEN.
      SPC 2 
      SKP 
      EXT #GET,#SLAV,.MVW,#RPB
      EXT $CKSM,$.LOA,$FWBG,$ID#,$IDA,$BGBP 
      EXT $LIBR,$LIBX,IDSGA,IDMEM 
A     EQU 0 
B     EQU 1 
      SUP 
      SPC 2 
APLDX EQU * 
      LDA B,I       RETRIEVE THE STREAM CLASS NUMBER
      STA SAVCL       PARAMETER(S). 
* 
GET   EQU * 
      JSB #GET      WE WAIT FOR A REQUEST TO ARRIVE 
      DEF *+6 
      DEF SAVCL     MONITOR'S CLASS 
      DEF #RPB       REQUEST BUFFER ADDRESS.
      DEF L#MXR     MAXIMUM REQUEST LENGTH. 
DABFA DEF DABUF     DATA BUFFER ADDRESS.
      DEF DBMAX     MAXIMUM DATA BUFFER SIZE. 
      JMP GET       IGNORE INITIAL ERRORS!
* 
      DST SAVA      <A> = REQUEST LENGTH; <B> = DATA LENGTH.
* 
      LDA #RPB+#FCOD     CHECK FUNCTION CODE
      AND  B377     MASK FN CODE
* 
      SZA,RSS       IS THIS AN ID SEGMENT?
      JMP WKID      YES, WORK ON ID SEGMENT 
      CPA D1        PROGRAM DATA AREA?
      JMP LODIT     YES, LOAD IT. 
      CPA D2        PROGRAM'S BASE PAGE?
      JMP LODIT     YES, LOAD IT. 
      CPA D3        SHORT ID SEGMENT/END? 
      JMP SHTID     YES 
      CPA D4        ABORT?
      JMP ABORT 
* 
*     UNRECOGNIZED FUNCTION CODE: REJECT W/ ERROR = 1 
* 
BADMS EQU * 
      CLA,INA       REJECT REQUEST: CODE=1
* 
SRPL0 EQU * 
      STA #RPB+#ERCD
      SPC 2 
*     SEND REPLY
* 
SRPLY EQU * 
      JSB #SLAV 
      DEF *+4 
      DEF RQLEN     REQUEST LENGTH
      DEF ZERO      NO DATA 
      DEF ZERO
      NOP           --ERROR 
      JMP GET 
      SKP 
*     HERE ON 1ST STEP IN PROGRAM LOAD SEQUENCE.
*     CHECK PROGRAM'S ID SEGMENT: 
*       RELOCATED FOR THIS RTE-L SYSTEM?
*       MEMORY AREA DECLARED CONFLICT WITH ANY OTHER PROGRAM? 
*         ETC.
* 
WKID  EQU * 
*     VERIFY THAT FATHER IS 'RPRTL' 
      LDA #RPB+#FCOD
      ALF,ALF       ROTATE SPECIAL CODE 
      AND  B377        TO LOW BYTE & MASK 
      CPA  D31      IS IT?
      RSS 
      JMP           BADMS NO, RETURN ERROR CODE 
* 
*     HAS THIS PROGRAM FILE BEEN RELOCATED FOR CORRECT SYSTEM?
      LDA $CKSM     GET SYSTEM CHECKWORD
      CPA ID+31     COMPARE ? 
      RSS 
      JMP ERR12 
* 
*     TEST FOR BACKGROUND PROGRAM - IF SO, ONLY LEGAL 
*      TO LOAD IF 'LOAD' & 'SWAP' MODULES NOT IN SYSTEM 
*      AND NO OTHER BG PROGRAM IS LOADED
* 
      LDA $FWBG     START OF BACKGROUND 
      CMA,INA       COMPARE WITH LOW MAIN 
      ADA ID+21 
      SSA 
      JMP LO..1     REAL TIME SO OK 
      LDA $ID#      GET NEGATIVE NUMBER 
      CMA,INA         OF ID SEGMENTS
      STA LPCNT         FOR COUNTER 
      LDB $IDA      POINT TO LO MAIN ADDRESS
      ADB D20         OF FIRST ID SEGMENT 
LO..5 LDA B,I       IS THIS 
      CPA $FWBG       A BACKGROUND PROGRAM? 
      RSS             YES 
      JMP LO..6     NO, NO PROBLEM
      ADB M8        YES, GET FIRST WORD 
      LDA B,I         OF NAME 
      SZA           NON-ZERO? 
      JMP ERR40     YES, PROGRAM CONFLICT 
      ADB D8        NO, GO BACK TO LOW MAIN ADDRESS 
LO..6 ADB D30       ADVANCE TO NEXT ID SEGMENT
      ISZ LPCNT     MORE TO DO? 
      JMP LO..5     YES 
      LDA $.LOA     'LOAD MODULE IN SYSTEM' FLAG
      SZA           0 IS YES
      JMP LO..2     BACKGROUND OK ! 
      JMP ERR13     ILLEGAL BG LOAD ATTEMPT 
* 
*     TEST FOR SEGMENTED PROGRAM AND IF SO RAISE HIGH 
*      MAIN TO LIMIT OF REAL-TIME AREA FOR PROGRAM
*      CONFLICT CHECKS LATER. 
* 
LO..1 LDA ID+24     FIND # OF SEGMENTS
      AND B176K 
      SZA,RSS 
      JMP LO..2     NONE
      LDA $FWBG     YES, CHANGE UPPER LIMIT 
      STA ID+33 
      LDA $BGBP     ALSO OF BASE PAGE 
      STA ID+34 
      SKP 
* 
LO..2 EQU * 
* 
*     CHECK PRIORITY, SET TO 99 IF 0
* 
      LDA ID+7      GET PRIORITY
      SZA,RSS       TEST FOR ZERO 
      LDA D99        IF SO SET IT TO 99 
      STA ID+7
* 
*     GO PRIVILEGED TO WRITE THE ID SEGMENT 
* 
      JSB $LIBR 
      NOP 
* 
      JSB IDSGA     SEARCH FOR DUPLICATE PROGRAM NAMES
      DEF *+2 
      DEF ID+13 
      SEZ,CME       IF NOT FOUND, CLEAR E-REG 
      JMP RTPRG      AND CHECK MEMORY BOUNDS
      LDA D2        SET ERROR CODE
      STA #RPB+#FCOD  CODE
      JMP PEXIT      WITH E-REG = 1 
* 
*     TEST FOR REAL-TIME PROGRAM MEMORY CONFLICT
* 
RTPRG JSB IDMEM     TEST FOR REAL-TIME MEMORY BOUNDS
      DEF *+2         CONFLICTS 
DEFID DEF DABUF     PASS IT THE BUILT UP ID SEGMENT 
      CCE,SZA,RSS   IF NO CONFLICT FOUND (OR NOT R.T.)
      JMP SERCH      THEN SEARCH FOR FREE ID SEG. 
      LDB A         PUT NAME ADDRESS IN B 
      CLA            & FLAG SPECIAL 'REMOVE' MESSAGE
      JMP PEXIT      WITH E-REG = 1 
      SKP 
* 
*     SEARCH FOR FREE ID SEGMENT
* 
SERCH JSB IDSGA     CALL FOR MATCH OF BLANK NAME
      DEF *+2 
      DEF ZERO      ARRAY OF THREE ZEROS
      SEZ,RSS       IF FOUND, GO MOVE ID DOWN 
      JMP MOVE
* 
*     NO BLANK ID SEGMENTS FOUND. 
      LDA D3        SET ERROR CODE = 3
      STA #RPB+#FCOD  CODE
      JMP PEXIT      E-REG = 1
* 
*     MOVE ID SEGMENT INTO SYSTEM 
* 
MOVE  STA B         SAVE COPY OF ID ADDRESS 
      STB IDSEG     SAVE FOR COMPLETION 
      STB #RPB+#FCOD+1 RETURN ID SEGMENT ADDRESS TO MASTER
      LDA DEFID     SET A TO SOURCE (B TO DEST.)
      JSB .MVW      MOVE THE ID SEGMENT 
      DEF D30 
      NOP 
      CLA,CLE       SET UP FOR GOOD RETURN
PEXIT JSB $LIBX     DONE! 
      DEF *+1 
      DEF LO..3 
* 
LO..3 SEZ,RSS       CHECK FOR AN ERROR
      JMP LO..4     NO ERROR, SEND REPLY
      SZA           'REM' ERROR ? 
      JMP SRPLY     NO, SOME OTHER ERROR.  SEND REPLY.
      JMP ERR40     MEMORY CONFLICT ('REM') 
* 
LO..4 EQU * 
      CLA 
      JMP SRPL0     SEND REPLY, ERROR CODE = 0 (NO ERROR) 
      SKP 
*     MOVE PROGRAM TO FINAL DESTINATION 
LODIT EQU * 
* 
      LDA DABFA     SOURCE
      LDB #RPB+#ADR DESTINATION 
      JSB $LIBR     GO PRIVILEGED 
      NOP 
      JSB .MVW
      DEF DALEN     # WORDS 
      NOP 
      JSB $LIBX     BACK TO NORMAL STATE
      DEF *+1 
      DEF *+1 
* 
      CLA           RETURN "NO ERROR" CODE
      JMP SRPL0         AND SEND REPLY
      SKP 
*     SET UP BLOCK NUMBERS OF SEGMENT MAINS & PLACE IN
*       SHORT IDS 
* 
*     SHORT ID SEGMENTS EXIST AT THE START OF THE PROGRAM'S 
*     MEMORY AREA, THE SAME AS FOR ALL SEGMENTED PROGRAMS IN
*     RTE-L.  SHORT IDS ARE SET UP AS FOLLOWS (NOTE DIFFERENCES 
*     FROM RTE FMGR 'RP' COMMAND):
* 
*     +------------------------------------------------+
*     ! NAME (1ST & 2ND CHARACTERS)                    ! \
*     ! NAME (3RD & 4RTH CHARS)                        ! FROM RTE-L LOADER
*     ! NAME (5TH CHAR) !                              ! /
*     ! SEGMENT ENTRY POINT                            !
*     ! HIGH MAIN ADDRESS+1                            !
*     !     0                   ! HIGH BASE PAGE ADDR+1!
*     ! BASE PAGE BLOCK # OFFSET!PRGM SEGMENT BLOCK #  !
*     ! 1'S COMPLEMENT OF CHECKSUM                     !
*     +------------------------------------------------+
* 
*     NOTE THAT THE CHECKSUM IS COMPLEMENTED.  THIS IS TO FORCE AN
*     ERROR TRAP FOR THE CASE WHERE THE USER HAS ACCIDENTALLY 
*     INCLUDED THE NON-DS VERSION OF 'SEGLD' WITH THE PROGRAM,
*     BUT USED DS TO PUT THE PROGRAM IN MEMORY.  IN THIS CASE,
*     'SEGLD' WILL RETURN THE ERROR CODE INDICATING THE SHORT 
*     ID SEGMENTS HAVE BEEN CORRUPTED (WHICH IS, IN FACT, TRUE, 
*     BY THAT ROUTINE'S STANDARDS). 
* 
SHTID EQU *         SET UP SHORT ID SEGMENTS
      LDA #RPB+#P7   ARE THERE
      SZA,RSS         ANY SHORT ID SEGMENTS TO BE SET UP? 
      JMP STMRB        NO, FINISH UP
* 
      STA LPCNT     SAVE LOOP COUNTER 
* 
      LDA D2        INITIALIZE BLOCK # OF FILE TO 
      STA BLOK#       SKIP OVER SHORT ID SEGMENT(S) 
* 
*     COMPUTE BLOCK OFFSET IN PROGRAM FILE OF FIRST SEGMENT MAIN
      LDA #RPB+#P9
      LDB #RPB+#P8   LOW MAIN ADDRESS (1ST SHORT ID)
      STB SEGAD     SAVE FOR CHECKSUM 
      JSB BUMP      BUMP 'BLOK#' TO MAIN'S BP AREA
* 
      LDA #RPB+#P11  HIGH BP+1
      LDB #RPB+#P10  LOW BASE PAGE
      JSB BUMP      BUMP 'BLOK#' TO 1ST SEGMENT'S MAIN AREA 
* 
*     'BLOK#' NOW CONTAINS THE BLOCK NUMBER OF THE FIRST
*     SEGMENT MAIN, AND SEGAD POINTS TO THE FIRST 
*     SHORT ID SEGMENT, WHICH WE WILL 'FIX UP' IN A LOOP. 
* 
*     FIX UP SHORT IDS
* 
LOOP  LDB SEGAD     CURRENT SHORT ID
      STB SIDAD     SAVE FOR CHECKSUM CALL
      ADB D4
      STB TEMP      SAVE A(SEG HIGH MAIN) 
      ADB D2
      STA B,I       SAVE SEG MAIN BLK# (FROM BUMP CALL) 
      INB           POINT TO CHECKSUM WORD
      STB SEGAD 
      CLA 
      JSB SUM       DO CHECKSUM 
SIDAD NOP 
      CMA           DS REQUIRES ONE'S COMPLEMENT
      STA SEGAD,I     PUT CHECKSUM IN SHORT ID
      ISZ SEGAD     ADVANCE POINTER TO NEXT SHORT ID
      LDA TEMP,I    SEGMENT HIGH MAIN+1 
      LDB #RPB+#P9  SEGMENT START ADDRESS 
      JSB BUMP      ADVANCE FILE BLOCK #
      ISZ TEMP      BUMP PNTR TO HIGH BASE PAGE 
      LDA TEMP,I    LOAD SEGMENT HIGH BASE PAGE + 1 
      LDB #RPB+#P11 LOAD HIGH MAIN BP+1 
      JSB BUMP      ADVANCE 'BLOK#' PAST BP AREA
      ISZ LPCNT     DONE ?
      JMP LOOP
      SKP 
* 
*     SET UP DS RESERVED AREA FOLLOWING SHORT IDS.
*     THE RTE-L LOADER AUTOMATICALLY RESERVES ONE MORE SHORT
*     ID SEGMENT THAN REQUIRED.  THE LAST ONE IS FOR DS USE,
*     AND STORES THE FILE NAME, SECURITY CODE, ETC.,
*     FOR 'SEGLD' TO USE.  'SEGLD' MAKES RFA REQUESTS TO GET THE
*     SEGMENTS, AND NEEDS TO KNOW WHAT THE FILE IS NAMED, WHERE IT
*     IS, ETC.
* 
*     THE "RESERVED SHORT ID" IS SET UP AS FOLLOWS: 
* 
* 
*                     \ BIT # 
*                      \
*               WORD #  \15          8  7            0
*                        -----------------------------
*                 1      /     0       /     C6      /
*                 2      /    FILE SECURITY CODE     /
*                 3      /            CR#            /
*                 4      /    MASTER NODE #          /
*                 5      /    RESERVED FOR FUTURE    /
*                 6      /            "              /
*                 7      /            "              /
*                 8      /    -   CHECKSUM           /
*                        -----------------------------
* 
*     C6 = 6TH CHARACTER OF THE REMOTE FILE NAME
      SPC 2 
      LDA #RPB+#P3      PICK UP 6TH CHAR OF FILE NAME 
      AND B377
      STA SEGAD,I   PLACE IN 1ST WORD OF BLOCK
      LDB SEGAD     BLOCK ADDRESS 
      STB TEMP      SAVE FOR CHECKSUM 
      ISZ SEGAD     POINT TO 2ND WORD 
* 
      DLD #RPB+#P4  MOVE FILE SECURITY CODE 
      DST SEGAD,I     AND CARTRIDGE REFERENCE NUMBER
      ISZ SEGAD     BUMP POINTER TO 
      ISZ SEGAD     4RTH WORD 
      LDA #RPB+#P6  STORE MASTER
      STA SEGAD,I     NODE NUMBER 
      ISZ SEGAD 
* 
      CLA           CLEAR OUT 
      STA SEGAD,I     WORD 5, 
      ISZ SEGAD       WORD
      STA SEGAD,I          6, 
      ISZ SEGAD       WORD
      STA SEGAD,I          7,T ONE
      ISZ SEGAD        MOVE POINTER TO CHECKSUM WORD
      JSB SUM 
TEMP  NOP           START ADDR OF RESERVED BLOCK
      CMA           ONE'S COMPLEMENT FOR DS SEGLD 
      STA SEGAD,I   SAVE IT 
      SPC 2 
STMRB EQU *         HERE TO SET 'MR' BIT SO PROGRAM CAN BE EXECUTED 
* 
      JSB $LIBR 
      NOP 
      LDB #RPB+#P12  GET ADDRESS OF ID SEG STATUS WORD
      ADB D15       ADVANCE TO WORD W/ 'MR' BIT 
      LDA B,I 
      IOR MRBIT       SET 'MR' BIT
      STA B,I 
      CLA           RETURN 'NO-ERROR' CODE TO MASTER
      JSB $LIBX       AND RESTORE MEMORY PROTECT
      DEF *+1 
      DEF SRPL0       GO SEND REPLY 
      SKP 
*     HERE IF MASTER WISHES TO ABORT THE LOAD, E.G., FILE ERROR 
*     OCCURRED.  ID SEGMENT BEING SET UP IS BLANKED.
* 
ABORT EQU * 
      JSB $LIBR     GO PRIVILEGED 
      NOP 
      LDA DABFA      SRC ADDRESS
      LDB #RPB+#ADR  ADDRESS TO BE BLANKING 
      JSB .MVW
      DEF #IDSZ     BLANK THE ID SEGMENT
      NOP 
* 
      CLA           RETURN "NO ERROR" CODE TO MASTER
*     RESTORE INTERRUPTS
      JSB $LIBX 
      DEF *+1 
      DEF SRPL0       AND SEND REPLY
      SKP 
*     ERROR PROCESSING
* 
*     HERE IF CHECKWORD DOES NOT MATCH THAT OF SYSTEM 
ERR12 LDA D5        SET ERROR CODE=5
      JMP SRPL0       (STORE CODE & SEND REPLY) 
      SPC 2 
ERR13 LDA D6        SET ERROR CODE = 6
      JMP SRPL0     SEND REPLY
* 
*          * REMOVE CONFLICTING PROGRAM * 
*     ENTERED WITH B POINTING TO NAME OF PROGRAM
*      TO BE REMOVED
* 
ERR40 EQU * 
      LDA B         GET MEMORY ADDRESS OF PROGRAM'S NAME
      LDB @P1         WHICH CONFLICTS 
      JSB .MVW      MOVE THE NAME TO REPLY ERR BUFFER 
      DEF D3
      NOP 
* 
*     RETURN 'MR' BIT OF CONFLICTING PROGRAM
      LDB #RPB+#ADR  ADVANCE TO 
      ADB D15         'MR' BIT
      LDA B,I       PICK UP 'MR' BIT
      STA #RPB+#P4   RETURN TO MASTER 
      LDA D4        RETURN ERROR CODE=4 
      JMP SRPL0 
      SKP 
* 
* BUMP - BUMP BLOCK NUMBERS TO POINT AT THE VARIOUS MAINS, BASE 
*        PAGES, AND SEGMENTS CONTAINED WITHIN A TYPE 6 FILE.
* 
* 
*     CALLING SEQUENCE: 
*                       A = HIGH ADDRESS + 1
*                       B = LOW ADDRESS 
*                       JSB BUMP
* 
*     ON RETURN:     <A> = BLOK# = BLOCK NUMBER 
*                       B IS DESTROYED
* 
* 
BUMP  NOP 
      CMB,INB       SET THE LOW ADDRESS NEGATIVE
      ADA B         AND ADD TO HIGH ADDRES. 
      CLB           CLEAR FOR DIVIDE
      DIV D128      FIND # OF BLOCKS
      SZB           IF REMAINDER IS ZERO OK 
      INA            OTHERWISE, ADD 1 MORE BLOCK
      ADA BLOK#     CURRENT + OLD 
      STA BLOK# 
      JMP BUMP,I    RETURN
      SKP 
*     SUM - USED TO SUM THE WORDS IN ID SEGMENTS FOR CHECKSUM TESTS 
* 
SUM   NOP           P+1 = ADDRESS 
      LDB M7
      STB #CNTR 
      LDB SUM,I     LOAD ADDRESS
      ISZ SUM       POINT TO RETURN 
*     ACCUMULATE THE SUM
      ADA B,I 
      INB           BUMP TO NEXT WORD 
      ISZ #CNTR     DONE? 
      JMP *-3       NO, ADD THE NEXT
      JMP SUM,I 
#CNTR NOP           LOOP COUNTER FOR "SUM" ROUTINE
      SKP 
* 
*     CONSTANTS 
* 
ZERO  DEC 0         DO NOT CHANGE THE NEXT 3
      DEC 0           LOCATIONS !!! 
      DEC 0 
* 
M7    DEC -7
M8    DEC -8
D1    DEC 1 
D2    DEC 2 
D3    DEC 3 
D4    DEC 4 
D5    DEC 5 
D6    DEC 6 
D8    DEC 8 
D15   DEC 15
D20   DEC 20
D30   DEC 30
D31   DEC 31
D99   DEC 99
D128  DEC 128 
B176K OCT 176000
B377  OCT 377 
SBIT  OCT 100000
MRBIT EQU SBIT
* 
@P1   DEF #RPB+#P1
RQLEN ABS #P6 
* 
*     VARIABLES 
* 
LPCNT NOP           # SEGMENTS IN LOADED PROGRAM
* 
IDSEG NOP           ADDRESS OF PROGRAM ID SEGMENT 
#IDSZ DEC 34        SIZE OF ID SEGMENT AREA 
BLOK# NOP           FILE BLOCK # POINTER
SEGAD NOP           CURRENT SHORT ID MEMORY ADDR
* 
* 
* 
DBMAX ABS 128       MAXIMUM DATA BUFFER SIZE. 
L#MXR ABS #MXR
* 
* * * DO NOT CHANGE ORDER OF NEXT SIX STATEMENTS * * *
* 
*     SAVA & DALEN MUST BE CONTIGUOUS!
SAVA  NOP 
DALEN NOP 
* 
SAVCL NOP 
DABUF BSS 128       DATA BUFFER.
* 
ID    EQU DABUF-1   DEFINE ZERO-OFFSET SYMBOL TO ID SEGMENT AREA
* * * * * * * * * * * * * * * * * * * * * * * * * * * 
* 
      BSS 0         [ SIZE OF <APLDX> ] 
* 
      UNS 
      END APLDX