ASMB,R,Q,C
*     NAME:   LOAD
*     SOURCE: 92071-18156 
*     RELOC:  92071-16156 
*     PGMR:   HLC 
* 
* 
*  **************************************************************** 
*  * (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.        * 
*  **************************************************************** 
* 
* 
      NAM LOAD,0  92071-16156  REV.2041  800730 
      ENT $EX08,$EX28,$LDAB,$XEQ2 
      ENT $LDRS,$LOAD,$PREL,$PR?
      ENT $XS1,$XS2,$$LOA,$.LOA 
* 
      EXT $VBUF,.MWF,.CAX,$PART 
      EXT .XLD,.XCA,$MATV,$XEQ4 
      EXT $LUTA,$MATA,$MASZ,$CMAP 
      EXT $XQT,$LIST,$XEQ,$A
      EXT $RQP2,$DREL,$SEGS 
      EXT $SCXX,$HIGH,$TRAK 
      EXT $CSEG,$HIBP,$SUSP 
      EXT $PRIO,$PRAM,$RQ.3 
      EXT $NAMX,$WRKS,$EXEX 
      EXT $XSIO,$SCHD,$ZLST 
      EXT $IDSQ,$ERMG,$IOCL 
      EXT $XEQ1,$TEST,$DISC 
      EXT $XEQ3,$SWIN,$SISZ 
      EXT $WORK,$BGPR,$SC#,.XLA 
      EXT $STAT 
* 
A     EQU 0 
B     EQU 1 
* 
$EX08 EQU * 
      JSB AVAIL     SUSPEND CALLER IF $LOAD NOT AVAILABLE 
      LDB $XQT
      JSB $VBUF     CHECK USER BUFFER 
      DEF $RQP2,I 
      DEF D3
      JMP SC04      ILLEGAL RANGE 
* 
      LDA $SEGS,I   GET NUMBER OF SEGMENTS
      ALF,ALF 
      AND =B377 
      CMA,INA,SZA,RSS 
      JMP SC05      NO SEGMENTS, NAME NOT FOUND 
      STA S1
      STA S2
      CMA,INA 
      MPY $SISZ 
      CMA,INA 
      ADA $HIGH,I   SEGMENT IDENTIFIERS END AT HIGH MAIN
      STA PTR 
      STA TP
* 
      CLA 
LP0   LDB =D-7      CHECK ALL SEGMENT IDENTIFIERS 
      STB CNT 
LP1   STA ACC       CHECKSUM ACCUMULATOR
      JSB .XLD
PTR   NOP 
      ADA ACC 
      ISZ PTR 
      ISZ CNT 
      JMP LP1       NEXT WORD 
* 
      JSB .XCA      COMPARE COMPUTED TO STORED
      DEF PTR,I 
      CLA,RSS       CHECKSUM OK 
      JMP SC05      NAME NOT FOUND, SOMEONE CLOBBERED IT
      ISZ PTR 
      ISZ S1
      JMP LP0       NEXT SEGMENT ID 
* 
*     ALL CHECKSUMS OK
* 
      LDA D3
      JSB .CAX      SET FOR THREE WORDS 
      LDA $RQP2 
      LDB DBUF
      JSB .MWF      COPY NAME TO SYSTEM 
* 
      LDB TP        SCAN SHORT ID SEGS FOR NAME 
LP2   STB $A,I
      JSB .XLA
      DEF B,I       CHECK FOR MATCH 
      CPA BUFF
      INB,RSS 
      JMP NEXT      DOES NOT MATCH
      JSB .XLA
      DEF B,I 
      CPA BUFF+1
      INB,RSS       STILL OK
      JMP NEXT
      JSB .XLA
      DEF B,I 
      XOR BUFF+2
      AND =B177400  IGNORE SIXTH CHARACTER
      SZA,RSS 
      JMP FND       FOUND IT!!
NEXT  LDB $A,I
      ADB $SISZ 
      ISZ S2        LAST NAME CHECKED?
      JMP LP2 
SC05  LDB =D5 
      JMP $SCXX     NOT FOUND, ABORT
* 
SC04  LDB =D4 
      JMP $SCXX     ILLEGAL BUFFER
* 
D3    DEC 3 
DBUF  DEF BUFF
BL/TR NOP 
BLOCK NOP 
OSTAT NOP 
OPRIO NOP 
OTICK NOP 
* 
FND   LDA =D5 
      JSB .CAX
      LDA B         START WITH THIRD WORD OF SHORT ID 
      LDB DBUF
      JSB .MWF      COPY SHORT ID TO SYSTEM 
* 
      LDA BUFF
      AND =B377 
      STA BUFF      BASE PAGE TRACK OFFSET
* 
      LDA $SEGS,I 
      AND =B177400
      STA B         NUMBER OF SEGMENTS
      BLF,BLF 
      ADB S2
      INB           CURRENT SEGMENT NO. 
      IOR B 
      STA $SEGS,I 
* 
* 
      LDA BUFF+1
      STA $SUSP,I   POINT OF SUSPENSION 
* 
      LDA BUFF+2
      STA $CSEG,I   STORE CURRENT HIGH SWAP LIMIT 
* 
      LDB $SC#      COMPUTE NEG. SIZE OF SYSTEM COMMON
      CMB,INB 
* 
      LDA $STAT,I   SHIFT 'SC' BIT TO E-REG 
      ALF,ELA 
* 
      LDA $HIGH,I 
      SEZ 
      ADA B         ADJUST LOW MAIN FOR SYSTEM COMMON 
      STA MLO       LOW MAIN OF SEGMENT = HIGH MAIN OF MAIN + 1 
* 
      LDA $HIGH,I 
      CMA,INA 
      ADA BUFF+2    COMPUTE SIZE
      STA MSZ 
* 
      LDA $HIBP,I 
      AND =B1777
      STA BLO       LOW BP OF SEGMENT = HIGH BP OF MAIN + 1 
      CMA,INA 
      ADA BUFF+3    COMPUTE BP SIZE 
      STA BSZ 
      ISZ BLO       HIGH BP + 1 
* 
      LDA $PRIO,I   PRIORITY OF CALLER
      STA MPR       SAVE PRIORITY 
      STA BPR 
* 
      LDB $XQT
      JSB PART      GET THE PARTITION ADDRESS 
      ADA =D2 
      LDB A,I       STARTING PAGE 
      STB MPA       SAVE IN FIRST I/O CALL
      STB BPA       SAVE IN SECOND I/O CALL 
* 
      LDA $PART,I 
      ALF,ALF 
      AND =B377 
      STA BLOCK     STARTING BLOCK FOR MAIN 
* 
      LDA $DISC,I   DISC LU (SWAP AREA = 0) 
      STA MLU 
      STA BLU 
      ADA =D-1
      ADA $LUTA     GET DVT ADDRESS 
      LDB A,I 
      ADB =D28
      LDA B,I       BLOCKS PER TRACK
      STA BL/TR 
      MPY $TRAK,I   COMPUTE ABSOLUTE BLOCK OF MAIN
      CLE 
      ADA BLOCK 
      ADA BUFF+4    ADD STARTING BLOCK OF SEGMENT 
      SEZ 
      CLE,INB       DOUBLE INTEGER
      DST BUFF+3    SAVE IT TEMPORARILY 
* 
      ADA BUFF      ADD STARTING BLOCK OF SEG BP
      SEZ 
      INB           DOUBLE INTEGER
      DIV BL/TR     DIVIDE BY BLOCKS PER TRACK
      RBL           CONVERT BLOCK NO. TO SECTOR 
      DST BTR 
* 
      DLD BUFF+3
      DIV BL/TR     DIVIDE MAIN DISC BLOCK NO.
      RBL             INTO TRACK AND SECTOR 
      DST MTR 
* 
* 
      LDA =B20001   READ REQUEST CODE + 'UE' BIT
      STA MRQ 
      STA BRQ 
* 
      LDB $XQT
      JSB $PRAM     PASS PARAMETERS TO THE SEGMENT
      DEF $RQ.3 
* 
      LDB $XQT
      JSB $LOAD     START THE TRANSFER
* 
      ISZ $LIST     NEED TO SCAN SCHEDULED LIST 
      JMP $XEQ
* 
* 
AVAIL NOP           SUSPEND CALLER IF $LOAD NOT AVAILABLE 
      CLA 
      CPA $LDRS 
      JMP AVAIL,I 
      LDB $XQT
      JSB $LIST     NOT FREE, SUSPEND THE CALLER
      OCT 56
      JMP $XEQ
* 
* 
PART  NOP           COMPUTE ADDRESS OF PARTITION TABLE
      ADB =D25
      LDA B,I 
      AND =B377 
      ADA =D-1
      MPY $MASZ     MULTIPLY PARTITION NO. BY SIZE
      ADA $MATA 
      JMP PART,I
* 
      HED  REAL-TIME PROGRAM LOAD 
* 
$EX28 EQU * 
      LDB $XQT
      JSB $VBUF     CHECK BUFFER RANGE
      DEF $RQP2,I 
      DEF D3
      JMP SC04      ILLEGAL BUFFER
* 
      JSB $NAMX     FIND PROGRAM NAME 
      DEF $RQP2,I 
      SZB,RSS 
      JMP SC05      NOT FOUND 
* 
      ADB =D6 
      LDA $BGPR 
      CMA,INA 
      ADA B,I       COMPARE PRIORITY TO BACKGROUND LIMIT
      SSA,RSS 
      JMP $EXEX     BACKGROUND PROGRAM
* 
      JSB AVAIL     SUSPEND CALLER IF $LOAD NOT AVAILABLE 
      LDB $WORK 
      STB $TEST 
      JSB READ      LOAD IT 
      NOP           NO FREE PARTITIONS, DON'T SWAP
      ISZ $LIST     SET FLAG FOR DISPATCHER 
      JMP $EXEX 
* 
* 
      HED  DISC LOAD SUBROUTINE 
* 
READ  NOP           LOAD PROGRAM FROM DISC
      ADB =D25
      LDA B,I 
      AND =B377     ISOLATE PARTITION NUMBER
      SZA 
      JMP RDEX      ALREADY IN MEMORY, DONE 
      ADB =D2 
      LDA B,I       DISC LU AND SWAP AREA 
      SZA,RSS 
      JMP RDEX      NOT DISC RESIDENT, SKIP READ
* 
      AND =B377 
      STA MLU       DISC LU (ALSO USED BY SWAP MODULE)
      XOR B,I 
      ALF,ALF 
      STA MST       SWAP AREA NUMBER (ALSO USED BY SWAP MODULE) 
* 
      ADB =D-21 
      LDA B,I       TEST PROGRAM PRIORITY 
      STA MPR       (ALSO USED BY SWAP MODULE)
* 
      ADB =D18
      LDA B,I 
      RRR 10
      AND =B37      ISOLATE REQUIRED SIZE 
      STA BSZ       (ALSO USED BY SWAP MODULE)
      CMA,INA 
      STA MSZ       NEGATIVE SIZE (ALSO USED BY SWAP MODULE)
* 
      LDA =B77777 
      STA BESTZ     FIND AN EMPTY PARTITION 
      LDA $MATV 
      CMA,INA 
      STA CNT       NUMBER OF PARTITIONS
* 
      LDB $MATA 
LP    STB TP        POINTER TO CURRENT PARTITION
      LDA B,I       ID SEG OF OCCUPANT
      SZA 
      JMP OVRL?     OCCUPIED, CAN IT BE OVERLAID? 
* 
BACK  INB 
      LDB B,I       SIZE OF PARTITION 
      CPB BSZ 
      JMP EXACT     EXACT FIT, STOP LOOKING 
      STB A 
      CMA,INA 
      ADB MSZ       B POSITIVE IF PARTITION IS BIG ENOUGH 
      ADA BESTZ     A POSITIVE IF SMALLER THAN PREVIOUS BEST FIT
      IOR B 
      SSA 
      JMP BUMP      NOT BIG ENOUGH, OR BIGGER THAN NEEDED 
* 
      ADB BSZ 
      STB BESTZ     BEST SIZE SO FAR
      LDB TP
      STB BEST      ADDRESS OF BEST PARTITION SO FAR
* 
BUMP  LDB TP
      ADB $MASZ     BUMP TO NEXT TABLE
      ISZ CNT 
      JMP LP        TRY NEXT
* 
      LDA BESTZ 
      CPA =B77777 
      JMP READ,I    NO AVAILABLE PARTITIONS 
* 
      LDA BEST      ADDRESS OF BEST PARTITION 
* 
FOUND LDB A,I       OCCUPIED? 
      SZB 
      JMP RELES     YES, DEALLOCATE PARTITION 
NEW   LDB $TEST 
      STB A,I       PUT ID SEG ADDRESS IN PARTITION TABLE 
      ADA =D2 
      LDB A,I       STARTING PAGE OF PARTITION
      STB MPA       SAVE IN I/O REQUEST 
* 
      CLB 
      LDA $MATA 
      CMA,INA 
      ADA BEST      COMPUTE PARTITION NUMBER
      DIV $MASZ 
      INA 
      LDB $TEST 
      ADB =D25
      IOR B,I 
      STA B,I       SAVE NUMBER IN ID 
* 
      CLB 
      STB BSZ       ONE REQUEST ONLY
      STB MLO       LOW ADDRESS = 0 
* 
      LDB =B20001   READ REQUEST CODE + 'UE' BIT
      STB MRQ 
* 
      LDB MST       IF PROGRAM IS ON SWAP AREA
      SZB 
      JMP SWIN        SET TO SWAP IN
* 
      ALF,ALF       HIGH BYTE IS BLOCK NUMBER 
      AND =B377 
      RAL           CONVERT TO SECTOR NUMBER
      STA MSC 
* 
      LDA $SC#
      CMA,INA 
      STA MSZ       NEG. SIZE OF SYSTEM COMMON
* 
      LDB $TEST 
      ADB =D15
      LDA B,I       STATUS WORD 
      ALF,ELA       SHIFT 'SC' BIT INTO E-REG 
      ADB =D6 
      LDA B,I       HIGH MAIN ADDRESS 
      SEZ 
      ADA MSZ       SUBTRACT SIZE OF SYS COM IF USED
      STA MSZ 
* 
      ADB =D5 
      LDA B,I 
      STA MTR       STARTING TRACK
* 
* 
* 
GO    LDB $TEST 
      JSB $LOAD     MAKE I/O REQUEST
RDEX  ISZ READ
      JMP READ,I
* 
SWIN  LDB $TEST 
      JSB $SWIN     SET UP SWAP-IN PARAMETERS 
      JMP GO
* 
EXACT LDA TP        EXACT FIT, SAVE POINTER 
      STA BEST
      JMP FOUND 
* 
* 
OVRL? SSA 
      JMP BUMP      THE PARTITION IS NOT VALID
      ADA =D27      IS THE PROGRAM OVERLAYABLE? 
      STA DISC
      CLB 
      CPB A,I       DISC LU AND SWAP AREA 
      JMP BUMP      VIRGIN COPY NOT AVAILABLE ON DISC 
      ADA =D-19 
      CPB A,I       IF THE PRIMARY ENTRY POINT IS ZERO, 
      JMP PRIO?       THEN NOT DISPATCHED SINCE LAST LOAD 
      LDA DISC,I
      AND =B177400  ISOLATE SWAP AREA NUMBER
      SZA,RSS 
      JMP BUMP      NO SWAP IMAGE ON DISC 
* 
PRIO? LDB TP,I      OVERLAYABLE 
      JSB $PR?      COMPARE PRIORITIES
      JMP BUMP      OCCUPANT TAKES PRIORITY 
      LDB TP        TEST PROGRAM TAKES PRIORITY 
      JMP BACK
* 
* 
      SKP 
* 
*     CALLING SEQUENCE: 
* 
*       LDB ID      ID SEGMENT ADDRESS OF PARTITION OCCUPANT
*                   (MRQ CONTAINS PRIORITY OF TEST PROGRAM) 
*       JSB $PR?    COMPARE TEST PRIORITY TO OCCUPANT'S PRIORITY
*       >           DO NOT SWAP 
*       >           SWAP  (E=0 IF OCCUPANT IS BG, 1 IF RT)
* 
*     THE 'SWAP' RETURN IS MADE IF
*       1)  THE TEST PROGRAM IS HIGHER PRIORITY THAN THE OCCUPANT, OR 
*       2)  THE OCCUPANT IS A BACKGROUND PROGRAM AND IS NOT SCHEDULED, OR 
*       3)  THE OCCUPANT IS EQUAL IN PRIORITY TO THE TEST PROGRAM 
*           AND IT HAS USED ITS ENTIRE TIME SLICE.
* 
* 
* 
$PR?  NOP           COMPARE PROGRAM PRIORITIES
      ADB =D6 
      STB OPRIO     OCCUPANT'S PRIORITY 
      ADB =D9 
      STB OSTAT     OCCUPANT'S STATUS 
      ADB =D5 
      STB OTICK     OCCUPANT'S TIME SLICE CLOCK 
* 
      LDB OPRIO,I   COMPARE OCCUPANT'S PRIORITY 
      CMB,INB 
      ADB MPR          TO TEST PRIORITY 
* 
      LDA OPRIO,I   CHECK FOR REAL-TIME OR BACKGROUND 
      CMA,CLE       CLEAR E REGISTER
      ADA $BGPR     SET E IF OCCUPANT IS A REAL TIME PROGRAM
* 
      SSB 
      JMP PREX      TEST PROGRAM TAKES PRIORITY 
* 
*                   A HIGH PRIORITY BACKGROUND PROGRAM
*                    CAN BE SWAPPED TO MAKE ROOM
*                     FOR A LOWER PRIORITY PROGRAM
*                      IF THE OCCUPANT IS NOT SCHEDULED 
* 
      LDA OSTAT,I 
      AND =B77
      SEZ,RSS       SKIP IF THE OCCUPANT IS A REAL TIME PROGRAM 
      CPA =B60
      JMP SLICE     THE OCCUPANT IS SCHEDULED OR REAL TIME
PREX  ISZ $PR?      OK TO SWAP
      JMP $PR?,I
* 
* 
SLICE LDA OTICK,I   SWAPPABLE IF OCCUPANT'S ENTIRE SLICE USED 
      IOR B           AND PRIORITIES ARE EQUAL
      SZA,RSS 
      ISZ $PR?      ALLOW SWAP
      JMP $PR?,I
* 
* 
      SKP 
* 
* 
RELES CPB $CMAP     IF THIS PROGRAM IS CURRENTLY MAPPED,
      ISZ $CMAP       INVALIDATE THE POINTER
      ADB =D15      RELEASE THE PARTITION 
      LDA B,I 
      RAL,CLE,ERA   CLEAR THE 'MR' BIT OF THE OCCUPANT
      STA B,I 
* 
      ADB =D10
      LDA B,I 
      AND =B177400  CLEAR THE PARTITION NUMBER
      STA B,I 
* 
      LDA BEST
      JMP NEW       SET UP NEW PARTITION OCCUPANT 
* 
* 
* 
TP    NOP 
CNT   NOP 
ACC   NOP 
BEST  NOP 
BESTZ NOP 
DISC  NOP 
* 
BUFF  BSS 5 
* 
* 
      SKP 
* 
$LOAD NOP           LOAD/SWAP CALL
      LDA =D-5
      STA RTRY?     ALLOW FIVE RETRIES
      STB $LDRS 
      ADB =D15
      STB DSTAT     STATUS ADDRESS
      JSB XSIO      DO THE I/O
      JMP $LOAD,I 
* 
* 
XSIO  NOP           SYSTEM I/O REQUESTS 
      LDA =D-2
      STA DONE?     SET FOR TWO REQUESTS PER LOAD 
      LDA DSTAT,I 
      RAL,CLE,ERA   CLEAR THE 'MR' BIT
      STA DSTAT,I 
      JSB $XSIO     START LOAD OF MAIN
      DEF $XS1
* 
      LDA BSZ       SKIP SECOND REQUEST IF NO LINKS 
      SZA,RSS 
      JMP NULL
* 
      JSB $XSIO     START LOAD OF BASE PAGE 
      DEF $XS2
      JMP XSIO,I
* 
NULL  STA BTL       DUMMY THE TRANSMISSION LOG
      ISZ DONE? 
      JMP XSIO,I
* 
$LDRS NOP           ID SEGMENT OF OCCUPANT
DSTAT NOP           ADDRESS OF STATUS WORD
DONE? NOP           COMPLETION COUNT
RTRY? NOP           RETRY COUNT 
* 
      SKP 
* 
$XS1  EQU *         SYSTEM I/O CONTROL BLOCK
MLU   NOP 
      DEF COMP      COMPLETION ROUTINE
      NOP           LINKAGE 
MRQ   NOP 
MLO   NOP 
MSZ   NOP 
MTR   NOP 
MSC   NOP 
MPR   NOP 
MPA   NOP 
MST   NOP 
MTL   NOP 
* 
$XS2  EQU *         SYSTEM I/O CONTROL BLOCK
BLU   NOP 
      DEF COMP      COMPLETION ROUTINE
      NOP           LINKAGE 
BRQ   NOP 
BLO   NOP 
BSZ   NOP 
BTR   NOP 
BSC   NOP 
BPR   NOP 
BPA   NOP 
BST   NOP 
BTL   NOP 
* 
* 
      SKP 
* 
COMP  EQU *         A REQUEST HAS BEEN COMPLETED OR ABORTED 
      ISZ DONE? 
      JMP $XEQ      FIRST COMPLETION (NOT SURE WHICH) 
      LDA DSTAT,I 
      ISZ $LOAD 
      JMP TLOG      NOT ABORTED, CHECK THE TRANSMISSION LOG 
* 
      LDB MRQ       LOADING OR SWAPPING?
      SLB 
      JMP IO?       LOAD REQUEST
* 
      LDB $LDRS     SWAP REQUEST
      JSB $IDSQ     SET UP POINTERS TO THE ID SEG 
      JSB $DREL     RELEASE THE SWAP AREA 
      LDA DSTAT,I 
      IOR =B100000  SET THE 'MR' BIT
      STA DSTAT,I 
* 
IO?   AND =B77
      CPA =D2 
      JMP DONE      I/O SUSPENDED, WAIT FOR I/O COMPLETION
* 
      LDA DSTAT,I 
      ALF,ALF 
      LDB $LDRS 
      SLA 
      JSB $ZLST     MOVE TO ABORT LIST
DONE  CLA 
      STA $LDRS     CLEAR OCCUPANT FLAG 
      JSB $SCHD     SCHEDULE $LOAD WAITERS
      OCT 56
      ISZ $LIST     FLAG FOR DISPATCHER 
      JMP $XEQ
* 
* 
TLOG  IOR =B100000  SET THE 'MR' BIT
      STA DSTAT,I 
      LDA MTL       CHECK MAIN TRANSMISSION LOG 
      XOR MSZ       AGAINST REQUESTED SIZE
      LDB BTL       BASE PAGE TLOG
      CPB BSZ 
      SZA 
      CLA,RSS 
      JMP DONE      TRANSMISSION COMPLETE 
      ISZ RTRY? 
      JMP RTRY      TRY IT AGAIN
      LDB $LDRS     TOO MANY RETRIES, LOAD FAILED 
      STA $LDRS     CLEAR THE LOAD RESIDENT FLAG
      JSB $IDSQ     SET UP POINTERS TO ID SEGMENT 
      LDA =ASW      SWAP FAILURE
      LDB MRQ         IF REQUEST CODE = 2 
      SLB 
      LDA =ALD      LOAD FAILURE IF CODE = 1
      LDB =A
      JSB $ERMG     ABORT THE PROGRAM 
      JMP DONE
* 
* 
RTRY  JSB XSIO      RESTART THE REQUEST 
      JMP $XEQ
* 
      HED  ABORT CURRENT LOAD 
* 
$LDAB NOP           ABORT CURRENT LOAD OR SWAP
      CCB 
      CPB $LOAD 
      JMP $LDAB,I   ALREADY ABORTED 
      STB $LOAD     SET ABORT FLAG
* 
      LDB BSZ 
      SZB,RSS 
      JMP MAB       SINGLE REQUEST, ABORT MAIN
      JSB $IOCL     CLEAR LOAD OF BASE PAGE 
      DEF BLU 
* 
*                   DO NOT SWITCH ORDER OF CALLS
* 
MAB   JSB $IOCL     CLEAR LOAD OF MAIN
      DEF MLU 
      JMP $LDAB,I 
* 
* 
* 
* 
$PREL NOP           RELEASE PARTITION 
      LDB $XQT
      CPB $CMAP     IF THIS PROGRAM IS CURRENTLY MAPPED,
      ISZ $CMAP       INVALIDATE THE POINTER
      JSB PART      COMPUTE PARTITION ADDRESS 
      STA TP
* 
      CLB 
      LDA TP,I
      SSA,RSS       SKIP IF THE PARTITION IS DOWN 
      STB TP,I      CLEAR ID SEG ADDRESS IN TABLE 
* 
      LDA $PART,I 
      AND =B177400  CLEAR THE PARTITION NUMBER IN THE ID
      STA $PART,I 
      JMP $PREL,I 
* 
      HED  DISPATCHER LOAD EXTENSION
* 
* 
$XEQ2 LDA $LDRS 
      SZA 
      JMP $XEQ3     $LOAD NOT AVAILABLE 
* 
*                   B = TEST PROGRAM ID 
      JSB READ      LOAD IT!
      JMP $XEQ4     NO FREE PARTITIONS
      JMP $XEQ1     DONE!!
* 
* 
S1    NOP 
S2    NOP 
$$LOA EQU *         STANDARD MODULE 
$.LOA DEC 0         STANDARD MODULE 
      END 
                                                                                                                                                                                                                                    