(George Source)
Macros used: ADDRECS, BACKSPACE, BSOFF, CHANGEACT, CHANGEFILE, CHERRMESS, CLEAR, CLOSE, COMBRKIN, DOWN, ENDCOM, ERRORX, FINDACTNO, FJOCA, FON, FPCACA, FREEALL, FREECORE, FREESS, FSUD, HLSINFORM, HUNT2, HUNT2J, HUNT2OPT, ILLEGAL, LINKSET, LOCK, MARK, MENDAREA, MFREE, OFF, PAIR, PERMITBRK, PMT, SEG, SEGENTRY, SETBIT, SETUPCORE, T, TBS, TRACE, UNLOCK, UNSETBIT, UP, UPPLUS
22FL ... SEG LOADERR,70,RUTH PORTER 22^= SEGENTRY K1LOADERR,XENT1 23DW SEGENTRY K2LOADERR,XENT2 23YG SEGENTRY K3LOADERR,XENT3 24D6 #DEF T=1 [INCLUDE TRACING 24XQ #DEF XLDEX=EXTPS+3 25CB #DEF XLDEXA=EXTPS+4 25X2 #DEF YCOUNT=EXTPS 26BL # 26W= MASK1 #00060000 [LOADNOW,LOADNOWX BITS 27*W PTR PAIR TROBJ,1 27TG PCR PAIR CROBJ,1 28*6 PMT PAIR MTOBJ,1 28SQ # LABELS OF ERROR MESSAGES 29#B MPROG +EMPROG 29S2 XENT2 2=?L LDN 7 0 [LOAD FILE OPEN 2=R= LDN 6 0 [NO SUPPLEMENTARY MESSAGE 2?=W XENT1 2?QG #SKI T 2#=6 ( 2#PQ TRACE 6,SUPPMESS 2*9B TRACE 7,SP MARK 2*P2 ) 2B8L LDCT 0 #200 2BN= ANDX 0 XLDEXA(2) 2C7W BNZ 0 RCONT [CONT EXTRACODE 2CMG # B22 OF X7 SET MEANS CORE IMAGE NOT TO BE DELETED - 2D76 # NOT SET UP OR ERROR IN RESUME 2DLQ # ONLY USED IN CASES OF DOUBT 2F6B LDN 0 2 2FL2 ANDX 0 7 2G5L BNZ 0 NOCI 2GK= LDN 0 #1000 [CORE IMAGE CONTEXT 2H4W ANDX 0 CONTEXT(2) 2HJG BZE 0 NOCI 2J46 #SKIP G4 2JHQ ( 2K3B FPCACA 3,2 [CLEAR ANY LOCKDOWN COUNTS LEFT SET 2KH2 CLEAR 3,0,,3,2 2L2L CALL 4 Z4302 [DEAL WITH SUD MARKED BEING LOADED 2LG= BRN £ 2L^W ) 2MFG DOWN PROSTART,16 2M^6 NOCI 2NDQ #SKIP G4 2NYB ( 2PD2 # 2PXL # IF THERE IS NO CORE IMAGE WE MAY STILL HAVE TO FREE 2QC= # SWAPPING SPACE OR REDUCE USER COUNTS 2QWW # 2RBG CALL 4 Z4300 2RW6 BRN (GEOERR) [ERROR IF REPLACEMENTS NON ZERO 2S*Q BNG 3 NSWAPSP [NO SCB 2STB LDX 4 AMAXSIZE(3) [AMOUNT OF SWAPPING SPACE BOOKED 2T*2 ANDX 4 BSP16 [FOR PROG 2TSL FREECORE 3 [FREE SCB 2W#= BZE 4 NSWAPSP 2WRW FREESS 4 2X?G NSWAPSP 2XR6 # 2Y=Q ) 2YQB # X7 B23 = 1 - FILE NOT OPENED XET 2^=2 # FOR EMBEDDED LOAD IT IMPLIES TH_AT THE 1ST CARD HAS NOT BEEN READ AND 2^PL # NOT BACKSPACE. THEREFORE B23 IS TESTED BEFORE EMBEEDDED LOAD 329= ANDN 7 1 32NW BNZ 7 NSAV [LOAD FILE NOT OPEN 338G LDCT 0 #40 33N6 ANDX 0 XLDEXA(2) 347Q BNZ 0 SAVEF [EMBEDDED LOAD 34MB #SKIP G4 3572 ( 35LL LDN 0 #2000 [IF SUBSEQ LOAD OF PURE PROCEDURE 366= ANDX 0 XLDEXA(2) [THERE IS NO FILE TO CLOSE 36KW BNZ 0 NSAV 375G ) 37K6 CLOSE [LOAD FILE 384Q NSAV 38JB #SKIP G4 3942 CHERRMESS 39HL BZE 5 NDCOM [ERROR ALREADY REPORTED 3=3= BNZ 6 TWOERRS [SUPP. MESSAGE AS WELL 3=GW ERRORX 5 [OUTPUT ERROR MESSAGE 3?2G BRN NDCOM 3?G6 TWOERRS 3?^Q ERRORX 5,6 [OUTPUT ERROR MESSAGE 3#FB NDCOM 3#H5 ... LDCT 0 4 3#JS ... ANDX 0 XLDEXA(2) 3#LH ... BZE 0 NDCOM2 3#N= ... HLSINFORM NDCOM1,NOTLOAD,JOBNO(2) 3#P^ ... BRN NDCOM2 3#RN ...NDCOM1 3#TC ... BRN (GEOERR) 3#X6 ...NDCOM2 3#^2 LDX 0 MASK1(1) 3*DL ANDX 0 XLDEXA(2) 3*Y= BNZ 0 UP2LOERR [JUMP IF LOADNOW(X) MACRO 3BCW ENDCOM 3BXG UP2LOERR 3CC6 ANDX 0 BIT9 3CWQ BZE 0 NOCUNI [JUMP IF NO CPB/CUNI WITH FILE 3DBB [NAME WHICH MUST BE ERASED 3DW2 MFREE CPB,CUNI [FREE CPB,CUNI 3F*L NOCUNI 3FT= UPPLUS 1 [UP TO ERROR LABEL 3G#W SAVEF 3GSG LDX 4 YCOUNT(2) 3H#6 SBN 4 1 3HRQ BNG 4 NSTART [ERROR WHILE READING COMMAND 3J?B ADDRECS 3,4 3JR2 BACKSPACE 3K=L NSTART 3KQ= BNZ 6 NSAV [SUBSID MESS ALREADYSET UP 3L9W LDX 6 MPROG(1) [EMBEDDEDPROGRAM SUB/MESSAGE 3LPG BRN NSAV 3M96 RCONT 3MNQ # MAKE PROG DORMANT HERE WHEN ILLEGAL ALLOWED FROM PCA 3N8B LDXC 0 XLDEXA(2) 3NN2 BCS NDILL [ONLINE CONT 3P7L FINDACTNO 3,XLDEX(2) [FIND OLPA 3PM= LOCK 3 [OLPA 3Q6W CHANGEFILE 3 [MOVE FILE TO OLPA 3QLG UNLOCK 3 3R66 # PICK UP PERIPHERAL TYPE FROM OLPA 3RKQ LDX 4 FTYPNO(3) 3S5B SRL 4 15 3SK2 BNZ 4 NTR [NOT TR 3T4L ADN 1 PTR 3TJ= BRN ZLINK 3W3W NTR 3WHG SBN 4 3 3X36 BNZ 4 NCR [NOT CR 3XGQ ADN 1 PCR 3Y2B BRN ZLINK 3YG2 NCR 3Y^L ADN 1 PMT [MUST BE MT 3^F= ZLINK 3^YW LINKSET 3,0(1) 42DG NDILL 42Y6 # BRK/IN HAS BEEN INHIBITED FOR CONT 43CQ PERMITBRK 43XB FPCACA 2,FX2 44C2 CHANGEACT 2 [TO PCA 44WL ILLEGAL CONT 45B= # 45TW # ENTRY POINT TO TIDY UP & REPORT BREAKIN 46*G # 46BG ...XENT3 46CG ...[ 46DG ...[ THIS IS A CORRECTION FOR B 1774 (RA10) AND CONCERNS 46FG ...[ BREAK-IN DURING LOAD OF A PURE-PROCEDURE. 46GG ...[ IT IS REQUIRED FOR LOADERR TO TIDY UP SO THAT IF WE 46HG ...[ CONTINUE(CU) OUR PP LOAD LOAD DOESNOT GO WRONG 46JG ...[ DONE 12.FEB.75 :CENT 46KG ...[ 46LG ...#SKI G4 46LP ...( 46LY ...[ 46M7 ...[ CURES B2208 - IE NO FPCACA IF NO PCA ! 46MB ...[ :CENT 11TH MARCH 75 46MK ...[ 46MS ... LDN 0 2 46N3 ... ANDX 0 7 [LDSTART SETS B22 OF X7 IF NO PCA 46N= ... BNZ 0 NPCA 46NG ... FPCACA 3,2 [FIND PCA 46PG ... LDN 5 AWORK1(2) 46QG ... LDN 6 AWORK1(3) 46RG ... MOVE 5 4 [AWORK WDS FROM CPA TO PCA 46SG ... LDN 5 YCOUNT(2) 46TG ... LDN 6 ACOMMUNE1(3) 46WG ... MOVE 5 5 [NOW THE WDS USED BY LOAD IN CPA 46XG ...[ BACK TO ACOMMUNE WDS IN PCA 46YG ...[ 46^G ...[ NOW WE MUST CLEAR THE LOAD OR LOADNOW MARKERS ( BIT 9 OR 10) 472G ...[ WHICH WAS HELD IN XLDEXA IN CPA NOW AN ACCOMMUNE? IN PCA 473G ...[ 474G ... LDX 0 BIT9 475G ... ORX 0 BIT10 476G ... ORS 0 ACOMMUNE1 + XLDEXA - YCOUNT(3) 4777 ... ERS 0 ACOMMUNE1 + XLDEXA - YCOUNT(3) 477S ...NPCA 478G ...[ 479G ...[ END OF CORRECTION 47=G ...[ 47?G ...) 47#Q LDN 6 0 47SB LDX 0 BIT9 48#2 ANDX 0 XLDEXA(2) 48RL BNZ 0 XMACRO [JUMP IF LOADNOW MACRO 49?= LDN 0 2 [AS IN OTHER ENTRY PTS B22 OF X7 49QW ANDX 0 7 [MEANS THERE IS NO CORE IMAGE 4==G BNZ 0 NOCIB 4=Q6 LDN 0 #1000 4?9Q ANDX 0 CONTEXT(2) [J UNLESS'CORE IMAGE'CON 4?PB BZE 0 NOCIB 4#92 #SKIP G4 4#NL ( 4*8= FPCACA 3,2 4*MW CLEAR 3,0,,3,2 4B7G CALL 4 Z4302 [DEAL WITH SUD MARKED BEING LOADED 4BM6 BRN £ 4C6Q ) 4CLB DOWN PROSTART,16 4D62 NOCIB 4DKL #SKIP G4 4F5= ( 4FJW # 4G4G # IF THERE IS NO CORE IMAGE WE MAY STILL HAVE TO FREE SWAPPING 4GJ6 # SPACE OR REDUCE USER COUNTS 4H3Q # 4HHB CALL 4 Z4300 4J32 BRN (GEOERR) 4JGL BNG 3 NSWAPSP1 [J IF NO SCB 4K2= LDX 4 AMAXSIZE(3) [SWAPPING SPACE BOOKED FOR PROG 4KFW ANDX 4 BSP16 4K^G FREECORE 3 [FREE SCB 4LF6 BZE 4 NSWAPSP1 4LYQ FREESS 4 [FREE SWAP SPACE 4MDB NSWAPSP1 4MY2 ) 4NCL # 4NX= # B23 OF X7 INDICATES THAT THERE IS NO FILE OPEN 4PBW # IF SET IN THE CASE OF EMBEDDED LOAD INDICATES NO BACKSPACING TO DO 4PWG # 4QB6 ANDN 7 1 4QTQ BNZ 7 NCLOSE 4R*B LDCT 0 #40 [IF EMBEDDED LOAD J TO DO BACKSPACING 4RT2 ANDX 0 XLDEXA(2) 4S#L BNZ 0 NBKSP 4SS= #SKIP G4 4T?W ( 4TRG LDN 0 #2000 [J IF SUBSEQ LOAD OF PP-NO FILE OPEN 4W?6 ANDX 0 XLDEXA(2) 4WQQ BNZ 0 NCLOSE 4X=B ) 4XQ2 CLOSE [CLOSE FILE 4Y9L NCLOSE 4YP= TESTUP 4YQ^ ... LDCT 0 4 4YSN ... ANDX 0 XLDEXA(2) 4YWC ... BZE 0 TESTUP2 [LOAD EVENT NOT REPORTED TO HLS 4YY6 ... HLSINFORM TESTUP1,NOTLOAD,JOBNO(2) 4Y^T ... BRN TESTUP2 4^3J ...TESTUP1 4^5? ... BRN (GEOERR) 4^72 ...TESTUP2 4^8W LDX 0 MASK1(1) 4^NG ANDX 0 XLDEXA(2) 5286 BNZ 0 UP2LOBRKIN [JUMP IF LOADNOW(X) MACRO 52MQ COMBRKIN 537B UP2LOBRKIN 53M2 UP [UP TO BREAK-IN LABEL 546L XMACRO 54L= #SKIP G3 555W ( 55KG FPCACA 3,2 5656 HUNT2J 3,BSTB,BSCB,,XNOSS [JUMP IF NO SWAP SPACE 56JQ LDX 4 BSHEET(3) [TOTAL NO OF SHEETS FOR PROGRAM 574B ADN 4 2 [ALLOWANCE FOR THE HEADER 57J2 SETUPCORE 4,3,FILE,FRB [SET UP THE BACKING STORE LIST BLOCK 583L FPCACA 2 58H= HUNT2 2,BSTB,BSCB 592W STO 2 1 [PRESERVE SCB POINTER 59GG STO 4 A1(3) [INSERT THE LENGTH OF THE LIST 5=26 LDX 4 AOBJLF(2) 5=FQ STO 4 A1+1(3) [STORE LFN IN BS LIST BLOCK 5=^B LDX 5 BSHEET(2) [NO OF SHEETS 5?F2 STOW LDX 4 AOBJST(2) [THE FIRST O/P BLOCK ENTRY 5?YL STO 4 A1+2(3) [INSERT ENTRY IN LIST 5#D= ADN 2 1 [STEP X2 TO NEXT O/P BS HOME 5#XW ADN 3 1 [STEP X3-POINTER TO NEXT FREE WORD 5*CG BCT 5 STOW [ARE ALL THE O/P BS HOMES INSERTED? 5*X6 FREECORE 1 [RELEASE SCB 5BBQ FREEALL 5BWB ) 5CB2 #SKIP G4 5CTL ( 5D*= FPCACA 3,2 5DSW HUNT2 1,BSTB,BSCB,3 5F#G LDX 0 ALOGLEN(1) 5FS6 SBN 0 HSUD-A1 5G?Q LDXC 7 AMAXSIZE(1) [SIZE OF PROGRAM 5GRB STOZ AMAXSIZE(1) 5H?2 BZE 7 XNOSS [JUMP IF NO SWAP SPACE BOOKED 5HQL BZE 0 NOSUD [JUMP IF NOT ATTACHED TO A SUD 5J== LDX 3 HSUD(1) 5JPW BZE 3 NOSUD 5K9G LDX 0 HSUD+1(1) 5KP6 ANDN 0 #7777 [NO OF SHARED PAGES 5L8Q SBX 7 0 5LNB STOZ HSUD+1(1) 5M82 FSUD 2,3,(GEOERR) 5MML UNSETBIT 1,HUSERS(2) [CLEAR BIT SAYING SWAP SPACE GOT 5N7= FON HLOADPPWT [LET SOMEONE ELSE LOAD IT. 5NLW NOSUD 5P6G FREESS 7 [FREE SWAP SPACE 5PL6 ) 5Q5Q XNOSS 5QKB FJOCA 3,2 5R52 TBS 5,JMISC(3),0 5RJL BZE 0 NOPCACA [JUMP IF PCACA BIT UNSET 5S4= ERS 0 JMISC(3) [CLEAR PCACA BIT 5SHW NOPCACA 5T3G SETBIT 14,JMISC(3) [SET LOAD MARKER 5TH6 BRN UP2LOBRKIN 5W2Q # 5WGB NBKSP LDX 4 YCOUNT(2) [BACKSPACE BY NO OF RECORDS READ 5X22 BZE 4 NCLOSE 5XFL NBK BACKSPACE 5X^= BCT 4 NBK 5YDW BRN NCLOSE 5YYG #SKIP G4 5^D6 ( 5^XQ # THIS SUBR EXAMINES THE SCB & REDUCES THE USER COUNT ASSOC WITH 62CB # A SUD WITH NO REPLACEMENTS RECORDED - PROGDEL DOES NOT CATER FOR 62X2 # THIS.IT ALSO RETURNS THE ADDRESS OF THE SCB 63BL # 63W= Z4300 LDX 3 FX2 64*W BRN Z4302 64TG Z4301 FPCACA 3,FX2 65*6 Z4302 HUNT2OPT 3,BSTB,BSCB [LOCATE SCB 65SQ BNG 3 Z4306 [J TO EXIT IF NONE 66#B LDX 0 ALOGLEN(3) 66S2 SBN 0 HSUD-A1 [J IF PROG NOT ATTACHED TO SUD 67?L BZE 0 Z4306 67R= LDX 0 HSUD(3) 68=W BZE 0 Z4306 68QG LDX 2 HSUD+1(3) [J IF REPLACEMENTS TO SUD-THIS 69=6 BNZ 2 Z4330 [IMPLIES SUD MARKED AS LOADED 69PQ STOZ HSUD(3) [SO THAT PROSTART WILL NOT SEE SUD 6=9B FSUD 2,0,(GEOERR) 6=P2 LDX 0 HUSERS(2) [REDUCE NO OF USERS OF SUD BY 1 6?8L SBN 0 1 6?N= STO 0 HUSERS(2) 6#7W BPZ 0 Z4320 [J IF SUD LOADED 6#MG ANDX 0 BITS22LS 6*76 BNZ 0 Z4310 [J IF OTHER'USERS' 6*LQ FREECORE 2 [FREE SUD 6B6B Z4306 LDX 1 FX1 6BL2 LDX 2 FX2 6C5L EXIT 4 1 6CK= Z4310 LDN 0 #4000 6D4W SMO FX2 6DJG ANDX 0 XLDEXA 6F46 BZE 0 Z4306 [J UNLESS INITIAL LOAD OF PP 6FHQ FON HLOADPPWT [WAKE UP ANY ONE WAITING FOR IT 6G3B BRN Z4306 [EXIT 6GH2 Z4320 BNZ 0 Z4306 [EXIT IF USER COUNT NON ZERO 6H2L BSOFF G4SUDBIT,Z4306 [JMP IF THERE ARE SUDS TO DELET 6HG= OFF G4SUDBIT [INDICATE THAT THERE IS A SUD T 6H^W FON HSWAPSPWT [WAKE UP THOSE WAITING FOR SWAP SPACE 6JFG FON #105 [OR FOR OBJ PROG CORE 6J^6 BRN Z4306 6KDQ Z4330 SBN 4 1 [EXIT + 0 IF THERE ARE REPLACEMENTS 6KYB BRN Z4306 [TO SUD 6LD2 ) 6LXL MENDAREA 30,K99LOADERR 6MC= #END ^^^^ ...47264644000900000000