(George Source)
Macros used: ACROSS, ALTLEN, ALTLEND, BACKSPACE, CHAIN, CHNUMCO1, CLOSE, CLOSETOP, DOWN, ENDCOM, FILECOUNT, FNORM, FREEBUFF, FREECORE, FSUD, FTM, GEOERR, HLSINFORM, LONGWAIT, MAGREAD, MENDAREA, MFREE, MFREEW, MHUNT, MHUNTW, NAME, NAMETOP, PARABEGX, PARANUMB, PPCUBS, PTYPE, READ, REPERR, SEG, SEGENTRY, SETNCORE, SETUPCORE, SPARANOT, TESTREP2, TESTRPN2, TOPFCB, USEROPEN, VFREEW
22FL SEG LDSTART,70,RUTH PORTER 22^= # 23DW # 23YG SEGENTRY K1LDSTART,XENT1 24D6 SEGENTRY K2LDSTART,XENT2 24XQ SEGENTRY K5LDSTART,XENT5 25CB SEGENTRY K7LDSTART,XENT7 25X2 # 26BL # THE SEGMENT DEALS WITH THE INITIALISATION OF THE LOADING PROCESS FOR 26W= # OBJECT PROGRAMS.IT OPENS THE LOAD FILE,READS THE FIRST RECORD FROM IT, 27*W # 27TG #OPT ASHEETSIZE=BSSS 28*6 # 28SQ # WORKING SPACE 29#B # 29S2 # YCOUNT B0-20 COUNT OF RECORDS READ - SERIAL FILE ONLY 2=?L # B21-3 COUNT OF BLOCKS OF BINARY PROG READ & DEALT 2=R= # WITH ONLY VALUES 0,1,2 POSSIBLE 2?=W # 2?QG # XLDEXA B0-9 FLAGS ALREADY USED 2#=6 # B12 INITIAL LOAD OF A PURE PROCEDURE 2#PQ # B13 SUBSEQUENT LOAD OF A PURE PROCEDURE 2*9B # B21 RESUME 2*P2 # B22 LOADENTER 2B8L # B23 LOAD 2BN= # 2C7W #DEF YCOUNT=EXTPS 2CMG #DEF XLDEX=EXTPS+3 2D76 #DEF XLDEXA=EXTPS+4 2DLQ # 2F6B PGLP 4HLO # 2FL2 PLOAD 4HLOAD 2G5L PGPLS 4H0LO# 2GK= XB2B23 #10000001 2H4W XNBIT1 #57777777 2HJG XNB6T17 #77000077 [FOR CHECKING START OF BINARY PROG BK 2J46 XRQS #73000001 [FIRST WORD OF REQ SLIP 2JHQ XSRQS #73000006 [FIRST WORD OF SUPP REQ SLIP 2K3B MAXSIZE #20000001 2KH2 #SKIP G4 2L2L ( 2LG= XSUDNOMAX +512 [MAX PERMITTED SUD NO. 2L^W XB15LS #77777 2MFG ) 2M^6 # NAMES OF COMMAND ERROR REPORTS 2NDQ NAME +JFNAME 2NYB NAPP +FNAPP 2PD2 PARMIS +JPARMIS 2PXL PTYPE +ERPERITYPE 2QC= WRBLK +JWRBLK 2QWW RINF +JINFF 2RBG RJCHER +JCHER 2RW6 NORES +JNORES 2S*Q RICR +ICR 2STB NOENT +JNOENT 2T*2 #SKIP G4 2TSL ( 2W#= WQUOTA +IQR 2WRW WRLP +JINFF 2X?G ) 2XR6 # 2Y=Q # 2YQB # ENTRY POINT FOR THE RESUME COMMAND 2^=2 # 2^PL XENT7 329= VFREEW APED,ADISPLAY [CLEAR CURRENT DISPLAY 32NW LDN 4 4 [SET FLAGS TO INDICATE ENTRY POINT 338G BRN Z011 33N6 # 347Q # 34MB # ENTRY POINTS FOR LOAD & LOADENTER 3572 # ANY EXISTING CORE IMAGE IS DELETED AND THEN THE PARAMETERS 35LL # ARE ANALYSED.THE FIRST PARAMETER IS EITHER A FILE NAME OR NULL 366= # INDICATING A LOAD FROM THE JOB SOURCE,WHICH MUST NOT BE MOP. 36KW # A LOAD COMMAND CAN OPTIONALLY HAVE A 'CORE'PARAM'SPECIFYING THE 375G # SIZE OF THE PROG,A'QUOTA'PARAM SPECIFYING ITS INITIAL QUOTA AND 37K6 # A'PRIVATE'PARAM SPECIFYING THAT THE PROGRAM IS NOT TO BE TREATED 384Q # AS A PURE PROCEDURE.THE LAST TWO PARAMS ARE ONLY SIGN.IN G4 38JB # 3942 XENT2 [ENTRY FOR LOADENTER 39HL NGNC 4 1 3=3= XENT1 [ENTRY FOR LOAD AND RESTORE 3=GW LDX 4 XB2B23(1) 3?2G LDN 0 #1000 3?G6 ANDX 0 CONTEXT(2) [DELETE PREVIOUS CORE IMAGE IF THE 3?^Q BNZ 0 Z947 [CONTEXT SHOWS THERE IS ONE 3#FB VFREEW APED,ADISPLAY [CLEAR CURRENT DISPLAY 3#^2 VFREEW APED,ANEVENT [CLEAR PROGRAM EVENT MESSAGE 3*DL BRN Z01 3*Y= Z947 DOWN PROSTART,10 3BCW Z01 SPARANOT 1 3BXG Z011 3CC6 MHUNT 3,CPB,CUNI 3CWQ STO 4 XLDEXA(2) [STORE FLAGS 3DBB STOZ YCOUNT(2) [CLEAR WORKING SPACE 3DW2 STOZ XLDEX(2) 3F*L STOZ EXTPS+1(2) 3FT= STOZ EXTPS+2(2) 3G#W STOZ AWORK1(2) [TO CONTAIN CORE PARAMETER 3GSG #SKI G4 3H#6 STOZ AWORK2(2) [TO CONTAIN QUOTA PARAMETER 3HRQ NGX 0 ANUM(3) 3J?B BNG 0 Z02 [J UNLESS FIRST PARAM NULL 3JR2 Z012 FILECOUNT 0 [A NULL 1ST PARAM INDICATES A LOAD 3K=L SBN 0 2 [FROM THE JOB SOURCE.CHECK THAT JOB 3KQ= [HAS A JOB SOURCE 3L9W BNG 0 XJSLO [JUMP IF ERROR 3L#5 ...# NEXT THREE LINES ARE FOR B6858.IF A MOP CONNECTS TO A JOB THEN QUITS 3LB# ...# IT STILL HAS 2 FILES OPEN.THEREFORE WE MUST ALSO CHECK THAT THE 3LDH ...# COMMAND PROCESSOR LEVEL IS AT LEAST 1. 3LGQ ... LDX 0 CPLEV(2) 3LJ^ ... SBN 0 1 3LM8 ... BNG 0 XJSLO 3LPG Z014 LDCT 0 #40 3M96 ORS 0 XLDEXA(2) 3MNQ BRN Z03 3N8B Z02 NAMETOP 3,FILE,FNAME [RENAME CPB,CUNI FOR FNORM 3NN2 FNORM 3 3NR6 ... TESTREP2 NAMEFORM,Z09 3NW= ...#UNS FTS1 3N^B ...#SKI 3P4G ...( 3P7L ...[ 3P=Q ...[ THIS IS A TWIN SYSTEM ENHANCEMENT CORRECTION 3P*W ...[ *** NO TESTING OF ADJUNCTS BLOCK ! 3PF2 ...[ DONE 19.FEB.75 :CENT 3PJ6 ...[ 3PM= TESTRPN2 ADJUNCTS,Z03 [JUMP IF NO ADJUNCTS SPECIFIED 3Q6W MHUNTW 3,FILE,ADJUNCTS [OTHERWISE LOCATE THE ADJUNCTS BLOCK 3QLG LDX 0 A1(3) [& REPORT AN ERROR IF IT CONTAINS 3R66 SBN 0 ADPAIR-A1 [ANYTHING OTHER THAN THE TEMPORARY 3RKQ BNZ 0 XCE1 [FILE MARKER. 3S5B LDX 0 XNBIT1(1) [#57777777 3SK2 ANDX 0 A1+1(3) 3T4L BNZ 0 XCE1 3TJ= TXU 0 A1+2(3) 3W3W TXU 0 A1+3(3) 3WHG BCS XCE1 3WR# ...) 3X36 Z03 3XGQ ANDN 4 1 [JUMP UNLESS LOAD 3Y2B BZE 4 Z07 3YG2 # 3Y^L # THE LOAD COMMAND CAN HAVE 'CORE','QUOTA'&'PRIVATE'PARAMS 3^F= # THE LATTER ARE ONLY SIGN.IN GEORGE 4 & ARE IGNORED IN GEORGE 3. 3^YW # 42DG PARANUMB 4 [NO OF PARAMS 42Y6 SBN 4 2 43CQ BNG 4 Z07 [JUMP UNLESS AT LEAST TWO 43XB CALL 7 Z1000 [LOOK FOR CORE PARAM. 44C2 +4 44WL 8HCORE 45B= BRN Z038 45TW BRN Z039 46*G Z038 MFREE CPB,CUNI 46T6 CALL 7 Z1000 [OR A SIZE PARAM 47#Q +4 47SB 8HSIZE 48#2 BRN Z04 48RL Z039 CHNUMCO1 [EVAL CORE OR SIZE PARAM 49?= TESTRPN2 OK,NOERR [ERROR IN CORE OR SIZE 49QW LDX 0 ACOMMUNE1(2) 4==G STO 0 AWORK1(2) 4=Q6 BZE 0 SERR2 4?9Q TXL 0 MAXSIZE(1) [INVALID CORE PARAM 4?PB BCC SERR2 4#92 SBN 4 1 [REDUCE COUNT OF PARAMS 4#NL Z04 MFREE CPB,CUNI 4*8= #SKIP G4 4*MW ( 4B7G BNG 4 Z07 4BM6 CALL 7 Z1000 [LOOK FOR QUOTA PARAM 4C6Q +5 4CLB 8HQUOTA 4D62 BRN Z05 4DKL CHNUMCO1 [EVALUATE QUOTA PARAM. 4F5= TESTRPN2 OK,NOERR [ERROR IN QUOTA 4FJW LDX 0 ACOMMUNE1(2) 4G4G BZE 0 XQUOTA 4GJ6 TXL 0 MAXSIZE(1) [INVALID QUOTA PARAM 4H3Q BCC SERR2 4HHB ADN 0 1023 4J32 SRL 0 10 4JGL STO 0 AWORK2(2) 4K2= SBN 4 1 4KFW Z05 MFREE CPB,CUNI 4K^G BNG 4 Z07 4LF6 CALL 7 Z1000 4LYQ +7 4MDB 8HPRIVATE 4MY2 BNZ 0 Z06 [J IF NO'PRIVATE'PARAM 4NCL LDCT 0 #400 4NX= ORS 0 AWORK2(2) [SET'PRIVATE'BIT 4PBW Z06 MFREE CPB,CUNI 4PWG ) 4QB6 # 4QTQ # LOOK TO SEE WHETHER THE PROG IS A PURE PROCEDURE WHICH IS ALREADY 4R*B # LOADED - OTHERWISE OPEN THE FILE 4RT2 # 4S#L Z07 LDCT 0 #40 4SS= ANDX 0 XLDEXA(2) 4T?W BNZ 0 Z200 [J IF LOAD FROM JOB SOURCE 4TRG Z08 4W?6 MHUNT 2,FILE,FNAME [RENAME BLOCK FOR USEROPEN 4WQQ NAMETOP 2,CPB,CUNI 4X=B #SKIP G4 4XQ2 ( 4Y9L MHUNT 3,FILE,FABSNB 4YP= LDX 3 ATYPE(3) 4^8W ANDN 3 #200 4^NG BNZ 3 Z088A [TREAT WORKFILE AS PRIVATE 5286 SMO FX2 52MQ LDX 0 AWORK2 537B BNG 0 Z088 [J IF PRIVATE PARAM SPEC 53M2 USEROPEN XBN,EXECUTE,DIR,LEAVE 546L TESTRPN2 OK,Z09A [REPORT ERROR IF NEC 54L= MHUNTW 1,FILE,ENT 555W LDX 0 ELAN(1) [STORE NAME OF FILE IN ACOMMUNE WORDS 55KG STO 0 ACOMMUNE9(2) 5656 ADN 1 ELOC1 [& REST OF LOCAL NAME FROM FILE,ENT 56JQ ADN 2 ACOMMUNE4 574B MOVE 1 5 57J2 TOPFCB 1 [USER NAME FROM FCB 583L ADN 1 FME1 58H= SBN 2 ACOMMUNE4-ACOMMUNE1 592W MOVE 1 3 59GG CLOSETOP [CLOSE DIRECTORY 5=26 CALL 7 Z4100A [SEE IF ENTRY ON SUD CHAIN 5=FQ BRN Z088 [J IF NO SUD FOUND 5=^B LDX 5 HSUDNO(3) 5?F2 LDX 0 HUSER(3) 5?YL BNG 0 Z088 [J IF PP NOT FULLY LOADED 5#D= 5#XW PPCUBS XBN,Z09A [CHECK BS LIMITS 5*CG FSUD 3,5,(GEOERR) [X3 -> SUD 5*X6 BRN Z300A 5BBQ Z088A LDX 0 GSIGN 5BWB SMO FX2 5CB2 ORS 0 AWORK2 5CTL Z088 5D*= ) 5DSW USEROPEN XBN,EXECUTE,LEAVE [OPEN FILE 5F#G TESTREP2 RANDOM,Z10 5FS6 Z09A REPERR Z10 5G?Q Z09 ENDCOM 5GRB Z10 5H?2 LDN 0 #1000 [THIS DELETE OF CORE IMAGE 5HQL ANDX 0 CONTEXT(2) [IS REQD FOR THE RESUME PATH 5J== BZE 0 Z11 [WE KINDLY DO NOT DESTROY AN EXISTING 5JPW DOWN PROSTART,10 [PROG UNTIL WE ARE SURE THEY MEAN IT 5K9G Z11 5KP6 # 5L8Q # CHECK & SWITCH ON TYPE OF FILE 5LNB # 5M82 RANDOM 5MML MHUNTW 3,FILE,ENT 5N7= LDXC 0 EINF1(3) 5NLW BCS SERLOAD 5P6G LDXC 0 ETM(3) 5PL6 SRL 0 15 5Q5Q SBN 0 5 5QKB BZE 0 XMT [JUMP IF MT 5R52 SBN 0 1 5RJL BZE 0 XFOEDS [JUMP IF EDS 5S4= SBN 0 7 5SHW BZE 0 XFOEDS [ OR FDS 5T3G BRN XFILETYPE 5TH6 # READ RQS & SUPP RQS FROM SERIAL FILE & SET UP AOBRES 5W2Q # 5WGB SERLOAD 5X22 Z200 LDN 4 0 [INIT'LOAD'CARD MARKER 5XFL CALL 7 Z1300 [READ A RECORD 5X^= BRN Z201 [NOT PART OF A PROG 5YDW CALL 7 Z1100 [CHECK THAT IT'S A RQS & SETUP AOBRES 5YYG CALL 7 Z1300 [READ NEXT RECORD 5^D6 BRN Z205 [ERROR IF NOT PART OF A PROG 5^XQ CALL 7 Z1200 [DEAL WITH SUPP RQS 62CB BRN Z200A [J IF NO SUPP RQS 62X2 BRN SETUP [ 63BL Z200A BACKSPACE [BACKSPACE FILE 63W= MFREEW FILE,FRB 64*W LDN 0 8 [REDUCE COUNT OF RECORDS READ 64TG SBS 0 YCOUNT(2) 65*6 BRN SETUP 65SQ # NULL RECORDS,SPACEFUL RECORDS AND A'LOAD'CARD ARE ALLOWED 66#B # BEFORE THE RQS 66S2 # 67?L Z201 BZE 6 Z200 [JUMP IF NULL RECORD 67R= Z202 SMO 6 68=W LDX 0 A1+2(3) 68QG TXU 0 ACES [JUMP IF NOT A LINE OF SPACES 69=6 BCS Z204 69PQ BCT 6 Z202 6=9B Z203 FREECORE 3 6=P2 BRN Z200 6?8L Z204 LDX 0 A1+2(3) [PROG CAN START WITH 6?N= TXU 0 PGLP(1) [ LO # 6#7W BCC Z206 6#MG TXU 0 PLOAD(1) [OR LOAD 6*76 BCC Z206 6*LQ SRL 0 6 6B6B TXU 0 PGPLS(1) [OR LO# 6BL2 BCC Z206 6C5L Z205 LDCT 0 #40 [DIFFERENT ERROR MESSAGES DEPENDING 6CK= ANDX 0 XLDEXA(2) [ON WHETHER LOADING FROM JOB SOURCE 6D4W BZE 0 RINFF [OR NOT 6DJG BRN XEL 6F46 Z206 BNZ 4 RINFF [ERROR IF LOAD CARD ALREADY MET 6FHQ LDN 4 1 [SET IT 6G3B BRN Z203 6GH2 # 6H2L # READ RQS & SUPP RQS FROM A MT FILE 6HG= # 6H^W XMT 6JFG LDCT 0 #20 [SET LOAD FROM MT FILE MARK 6J^6 ORS 0 XLDEXA(2) 6KDQ FTM XEOF 6KYB LDN 3 20 6LD2 MAGREAD XEOF,XTM,Z230,3 6LXL Z230 MHUNTW 3,FILE,FRRB 6MC= CALL 7 Z1100 [CHECK THAT IT'S A RQS & SETUP AOBRES 6MWW LDN 3 20 6NBG MAGREAD XEOF,XTM,Z231,3 6NW6 Z231 MHUNTW 3,FILE,FRRB 6P*Q NAME 3,FILE,FRB 6PTB CALL 7 Z1200 [IF IT IS A SUPP RQS COPY INTO AOBRES 6Q*2 BRN SETUP 6QSL BRN SETUP 6R#= # 6RRW # 6S?G # OBTAIN RQS & SUPP RQS FROM A RANDOM ACCESS FILE & SET UP AOBRES 6SR6 # 6T=Q XFOEDS 6TQB LDCT 0 #10 [SET LOAD FROM EDS(OR FDS) FILE MARK 6W=2 ORS 0 XLDEXA(2) 6WPL ACROSS LOADX,1 6X9= XENT5 6XNW # THE 1ST ORG BUCKET IS IN A FILE/FRB 6Y8G # IT HAS BEEN CHECKED FOR VALIDITY AS AN ORG BUCKET 6YN6 MHUNTW 3,FILE,FRB [FIND ORGANISATIONAL BUCKET 6^7Q LDX 5 A1(3) [AMT OF DATA IN BUCK 6^MB SBN 5 3 [ - RED TAPE 7272 LDX 0 A1+3(3) 72LL ANDX 0 XNB6T17(1) 736= TXU 0 XRQS(1) 73KW BCS XRS [ERROR IF FIRST RECORD IS NOT A RQS 745G BCHX 3 £ 74K6 LDCH 6 A1+3(3) [LENGTH OF RQS 754Q LDX 0 6 75JB SBN 0 14 7642 BZE 0 Z252 76HL SBN 0 2 773= BNZ 0 XRSLENG [ERROR UNLESS 14 OR 16 77GW Z252 782G SBX 5 6 78G6 BNG 5 RINFF [BUCKET TOO SHORT 78^Q LDN 7 16 [REQUIRED LENGTH FOR AOBRES 79FB BZE 5 Z253 79^2 SMO 6 7=DL LDX 0 A1+3(3) 7=Y= ANDX 0 XNB6T17(1) 7?CW TXU 0 XSRQS(1) 7?XG BCS Z253 [NO SUPP RQS 7#C6 SMO 6 7#WQ LDCH 0 A1+3(3) [LENGTH OF SUPP RQS 7*BB SBN 0 8 7*W2 BNZ 0 XSRS [ERROR UNLESS 8 WRDS LONG 7B*L SBN 5 8 7BT= BNG 5 RINFF [BUCKET SHORT 7C#W ADN 7 8 [AOBRES TO INCLUDE SUPP R/S 7CSG Z253 7D#6 LDN 3 0(3) [X3 PTS TO FILE/FRB 7DRQ NAME 3,AOBRES 7F?B LDN 1 A1+3(3) 7FR2 LDN 2 A1(3) 7G=L SMO 6 7GQ= MOVE 1 0 7H9W LDN 0 16 7HPG SBX 0 7 7J96 BZE 0 Z256 7JNQ ADX 1 6 [MOVE IN SUPP RQS 7K8B ADN 2 16 7KN2 MOVE 1 8 7L7L Z256 ALTLEN 3,7,AOBRES 7LM= #SKIP G3 7M6W BRN SETUP 7MLG #SKIP G4 7N66 ( 7NKQ SBN 7 16 7P5B BZE 7 SETUP [NO SUPP R/S 7PK2 MHUNTW 3,AOBRES 7Q4L LDX 0 A1+20(3) 7QJ= BPZ 0 SETUP [JUMP IF NOT PP 7R3W LDCT 0 #600 7RHG ANDX 0 A1+2(3) 7S36 BNZ 0 XRLP [ERROR IF RETAIL LOAD PERIP BIT SET 7SGQ SMO FX2 7T2B LDX 0 AWORK2 [JUMP IF'PRIVATE' PARAM SPECIFIED 7TG2 BNG 0 SETUP 7T^L # 7WF= # IF THE PROG IS A PURE PROCEDURE THEN WE INSERT AN ENTRY ON THE 7WYW # SUD CHAIN TO SAY IT IS BEING LOADED 7XDG # 7XY6 # 7YCQ Z260 SETNCORE HRQS-A1+32,1,ADATA,ASUD 7YXB Z261 CALL 7 Z4200 [OBTAIN SUD NO. 7^C2 CALL 7 Z4100 [CHECK WHETHER NAME IS ON SUD CHAIN 7^WL BRN Z262 [JUMP IF NO SUD FOUND 82B= LDN 0 1 82TW ADS 0 HUSERS(3) [UPDATE USER COUNT 83*G MFREE ADATA,ASUD 83T6 LDX 5 HSUDNO(3) 84#Q LDX 0 HUSERS(3) 84SB BNG 0 Z263 [JUMP IF SUD NOT FULLY LOADED 85#2 CLOSE [CLOSE FILE 85RL BRN Z309 [JOIN SUBSEQUENT LOAD PATH 86?= Z262 MHUNTW 1,ADATA,ASUD 86QW BNG 5 SETUPF [IF NO SUD NO OBTAINED NORMAL LOAD 87=G LDN 3 HSUDNAME(1) [MOVE FILE NAME INTO SUD BLOCK 87Q6 MOVE 2 9 889Q SBN 2 FUSER1 [SET PURE PROCEDURE BIT IN FCB 88PB LDX 0 BIT10 [NOTE - WE DO NOT BOTHER TO CLEAR 8992 ORS 0 FCOMM(2) [ THIS BIT IF THE LOAD FAILS 89NL LDCT 0 #400 [MARK BEING LOADED 8=8= ADN 0 1 [USER COUNT = 1 8=MW STO 0 HUSERS(1) [MARK AS BEING LOADED 8?7G STO 5 HSUDNO(1) [INSERT SUD NO 8?M6 SMO FX2 [STORE VALUE OF SIZE PARAM IN SUD 8#6Q LDX 0 AWORK1 8#LB STO 0 HSEGTAB(1) 8*62 STOZ HODBITS(1) 8*KL CHAIN 1,BSUD+BPTR [PUT NEW SUD AT THE END OF THE CHAIN 8B5= Z263 8BJW LDN 0 #4000 8C4G ORS 0 XLDEXA(2) [SET INITIAL LOAD OF PP BIT 8CJ6 BRN SETUPA 8D3Q # 8DHB # ENTRY FOUND ON SUD CHAIN BEFORE OPENNING THE FILE 8F32 # 8FGL Z300A 8G2= LDN 0 1 8GFW ADS 0 HUSERS(3) [INCREASE &OUNT OF USERS 8G^G LDX 5 HSUDNO(3) [PICK UP SUD NO 8HF6 # 8HYQ # IF SUD IS ALREADY LOADED WE ATTACH TO IT 8JDB # 8JY2 Z309 8KCL SETNCORE 24,3,AOBRES 8KX= Z310 LDN 0 #2000 [SET SUBSEQ -OAD OF PP MARK 8LBW ORS 0 XLDEXA(2) 8LWG CALL 7 Z4400 [SET UP SCB & INSERT SUD NO. 8MB6 # WAIT FOR PURE PROCEDURE TO BE LOADED 8MTQ Z311 8N*B FSUD 3,5,(GEOERR) [RELOCATE SUD 8NT2 LDX 0 HUSERS(3) 8P#L BPZ 0 Z320 [J IF PP LOADED 8PS= LONGWAIT XBNA,HLOADPPWT [WAIT FOR IT TO BE LOADED 8Q?W MHUNTW 2,BSTB,BSCB 8QRG BRN Z311 8R?6 Z320 MHUNTW 1,AOBRES 8RQQ LDN 7 HRQS(3) [MOVE RQS & SUPP RQS INTO SUD 8S=B LDN 0 A1(1) 8SQ2 MOVE 7 24 8T9L ADN 7 24 8TP= LDN 0 HPERM(2) [MOVE PERM AREA INTO SUD 8W8W MOVE 7 8 8WNG BRN SETUPB 8X86 # 8XMQ # ENSURE THAT SCB IS SET UP BEFORE ENTERING LOADPROG 8Y7B # 8YM2 SETUPF 8^6L FREECORE 1 8^L= SETUP LDN 5 0 925W SETUPA 92KG CALL 7 Z4400 9356 SETUPB 93JQ ) 944B #SKIP G3 94J2 ( 953L SETUP 95H= SETUPA 962W ) 965F ...#SKI JWPHASE4 9684 ...( 96=M ... LDX 2 FX2 96?7 ...#UNS FREEBUFF 96?M ...( 96#7 ... FREEBUFF [ FREEBUFF CPAT 96#M ...) 96*= ... HLSINFORM XBNC,LOAD,JOBNO(2) 96B5 ... LDCT 0 4 [SET MARKER - LOAD EVENT 96BY ... ORS 0 XLDEXA(2) [REPORTED TO HLS 96CT ...) 96GG # CODE TO FREE FILE/ENT ETC 9726 ACROSS LOADPROG,1 97FQ # 97^B # THIS SUBR SEARCHES FOR A PARAM OTHER THAN THE FIRST WHICH STARTS 98F2 # WITH A SPECIFIED STRING.IF ONE IS FOUND IT EXITS+1 & OTHERWISE+0 98YL # 99D= Z1000 SBX 7 1 99XW LDN 0 1 [LOOK FOR FIRST OCCURRENCE OF STRING 9=CG Z1001 ADX 1 7 [ADDRESS OF STRING 9=X6 PARABEGX 0,0(1) 9?BQ MHUNT 3,CPB,CUNI 9?WB LDX 0 ANUM(3) 9#B2 BNG 0 Z1003 [J IF NO PARAM 9#TL LDX 0 JPARNUM(3) [IF PARAM FOUND IS NO.1 THEN LOOK 9**= BCT 0 Z1002 [FOR SECOND OCCURRENCE OF STRING 9*SW FREECORE 3 9B#G LDN 0 2 9BS6 BRN Z1001 9C?Q Z1002 LDX 0 ANUM(3) 9CRB BZE 0 Z1003 [J IF PARAM CONSISTS ONLY OF CHAR STR 9D?2 ADN 7 1 9DQL Z1003 ADX 7 1 9F== EXIT 7 3 9FPW # 9G9G # THIS SUBROUTINE RENAMES THE BLOCK HOLDING THE RQS AOBRES 9GP6 # & CONVERTS IT TO THE STANDARD LENGTH OF 16.IT ALSO CHECKS 9H8Q # TO SEE THAT THERE IS A VALID RQS 9HNB # 9J82 Z1100 SBX 7 1 [RELATIVISE LINK 9JML NAME 3,AOBRES [RENAME 9K7= ALTLEND 3,16,AOBRES [CONVERT TO STD LENGTH 9KLW MHUNTW 3,AOBRES 9L6G LDX 0 A1(3) [PICK UP SPECIFIER WORD 9LL6 ANDX 0 XNB6T17(1) [& CHECK IT IS R/S 9M5Q TXU 0 XRQS(1) 9MKB BCS XRS 9N52 BCHX 3 £ [EXTRACT LENGTH & CHECK THAT IT 9NJL LDCH 0 A1(3) [IS EITHER 14 OR 16 9P4= LDN 3 0(3) 9PHW LDX 1 0 9Q3G SBN 1 14 9QH6 BZE 1 Z1104 9R2Q SBN 1 2 9RGB BNZ 1 XRSLENG 9S22 Z1104 LDN 1 A1(3) [CHECKSUM BLOCK 9SFL SMO 0 9S^= SUM 0 0 9TDW BNZ 0 XCHSUM 9TYG Z1106 LDX 1 FX1 [RESTORE X1 & LINK 9WD6 LDN 0 1 [COUNT OF BINARY BLOCKS READ 9WXQ ADS 0 YCOUNT(2) 9XCB ADX 7 1 9XX2 EXIT 7 0 9YBL # 9YW= # THIS SUBR CHECKS TO SEE WHETHER THE BLOCK CONTAINS A SUPP RQS 9^*W # IF SO IT CHECK SUMS THE BLOCK & INSERTS IT INTO THE AOBRES 9^TG # =2*6 Z1200 LDX 0 A1(3) [CHECK WHETHER SPECIFIER WORD =2SQ ANDX 0 XNB6T17(1) [INDICATES SUPP R/S =3#B TXU 0 XSRQS(1) =3S2 BCS Z1201 [JUMP IF NOT =4?L BCHX 3 £ =4R= LDCH 0 A1(3) [EXTRACT LENGTH & CHECK THAT IT IS 8 =5=W LDN 3 0(3) =5QG SBN 0 8 =6=6 BNZ 0 XSRS [ERROR =6PQ LDN 1 A1(3) [CHECKSUM BLOCK =79B SUM 0 8 =7P2 BNZ 0 XCHSUM =88L SBX 7 FX1 =8N= MHUNTW 3,AOBRES =97W ALTLEND 3,24,AOBRES [ALTER LENGTH OF AOBBRES TO 24 =9MG MHUNTW 2,FILE,FRB [AND MOVE SUPP R/S IN ==76 MHUNTW 3,AOBRES ==LQ LDN 0 A1(2) =?6B LDN 1 A1+16(3) =?L2 MOVE 0 8 =#5L FREECORE 2 =#K= LDN 0 1 =*4W ADS 0 YCOUNT(2) [COUNT OF BINARY BLOCKS READ =*JG ADX 7 1 =B46 EXIT 7 1 =BHQ Z1201 EXIT 7 0 =C3B # =CH2 # THIS SUBR READS THE NEXT RECORD FROM A SERIAL FILE. =D2L # AN ERROR IS REPORTED IF THE END OF FILE IS ENCOUNTERED. =DG= # IF THE RECORD CONTAINS A BINARY PROG BLOCK IT IS MOVED TO =D^W # THE FRONT OF THE FRB & ANY SPACES LOST FROM THE END OF THE =FFG # BLOCK ARE REPLACED & THE SUBR EXITS+1. =F^6 # OTHERWISE THE ROUTINE EXITS+0. =GDQ # =GYB Z1300 SBX 7 1 =HD2 READ [READ RECORD =HXL MHUNTW 3,FILE,FRB =JC= # ADD TO COUNT BEFORE CHECKING END OF FILE SO WE WILL BACKSPACE AND COMM =JWW # PROCESSOR CANT GET END OF FIOE GEOE-R =KBG LDN 0 8 =KW6 ADS 0 YCOUNT(2) [NO.OF RECORDS READ FROM A SERIAL FIL =L*Q LDX 6 A1(3) =LTB BZE 6 XEOF [END OF FILE =M*2 SBN 6 2 =MSL BZE 6 Z1306 [J IF NULL RECORD =N#= LDCH 0 A1+2(3) =NRW SBN 0 #73 =P?G BNZ 0 Z1306 =PR6 LDN 0 A1+2(3) [MOVE DOWN BLOCK =Q=Q LDN 1 A1(3) =QQB SMO 6 =R=2 MOVE 0 0 =RPL BCHX 3 £ [EXTRACT LENGTH OF BLOCK =S9= LDCH 0 A1(3) =SNW LDN 3 0(3) =T8G SBX 6 0 =TN6 BPZ 6 Z1304 =W7Q LDX 5 0 [ALTER LENGTH OF BLOCK - VERY RARE =WMB ALTLEN 3,5,FILE,FRB =X72 MHUNTW 3,FILE,FRB =XLL ADX 3 5 [RESTORE SPACES =Y6= LDX 0 ACES =YKW Z1302 SMO 6 =^5G STO 0 A1(3) =^K6 ADN 6 1 ?24Q BNG 6 Z1302 ?2JB SBX 3 5 ?342 Z1304 LDX 1 FX1 ?3HL ADX 7 1 ?43= EXIT 7 1 ?4GW Z1306 ADX 7 1 ?52G EXIT 7 0 ?5G6 #SKIP G4 ?5^Q ( ?6FB # ?6^2 # SEARCH THE SUD CHAIN FOR AN ENTRY WITH A SPECIFIED NAME ?7DL # ON EXIT+0 X3 LOCATES THE SUD ?7Y= # ?8CW Z4100 TOPFCB 2 [ENTRY PT IF REQD NAME IS IN FCB ?8XG ADN 2 FUSER1 ?9C6 Z4100A [ENTRY PT IF NAME IS LOCATED BY X2 ?9WQ LDN 3 BSUD ?=BB Z4102 LDX 3 FPTR(3) [NEXT ENTRY IN SUD CHAIN ?=W2 TXU 3 CXSU [J IF END OF CHAIN ??*L BCC Z4104 ??T= LDX 0 3(2) [COMPARE FIRST WORD OF LOCAL NAME ?##W TXU 0 HSUDNAME+3(3) ?#SG BCS Z4102 [J IF NO MATCH ?*#6 LDN 1 8 ?*RQ Z4103 SMO 1 [COMPARE WHOLE ABSOLUTE NAME ?B?B LDX 0 0(2) ?BR2 SMO 1 ?C=L TXU 0 HSUDNAME(3) ?CQ= BCS Z4102 [J IF NO MATCH ?D9W SBN 1 1 ?DPG BPZ 1 Z4103 ?F96 ADN 7 1 [IF MATCH FOUND EXIT +1 ?FNQ Z4104 LDX 1 FX1 ?G8B EXIT 7 0 [OTHERWISE EXIT +0 ?GN2 # ?H7L # THIS SUBR OBTAINS A NO FOR A SHARED UNIT DESCRIPTION-IN X5 ON EXIT ?HM= # SUD NOS ARE ALLOCATED CYCLICALLY IN THE RANGE 1-511 & WE ARRANGE ?J6W # AS FAR AS POSSIBLE THAT THE MOST RECENTLY SET UP SUDS ARE AT ?JLG # THE END OF THE CHAIN ?K66 # CURRENTLY WE GEOERR IF THERE ARE NO FREE NUMBERS ?KKQ # ?L5B Z4200 LDN 5 1 ?LK2 LDX 3 BSUD+BPTR [J IF SUD CHAIN EMPTY ?M4L TXU 3 CXSU ?MJ= BCC Z4204 ?N3W LDX 5 HSUDNO(3) [NUMBER OF LAST SUD IN CHAIN ?NHG LDN 1 BSUD ?P36 Z4202 LDX 1 FPTR(1) [NEXT SUD IN CHAIN ?PGQ TXU 1 CXSU ?Q2B BCC Z4206 [ERROR IF WE HAVE BEEN RIGHT ROUND ?QG2 Z4203 ADN 5 1 ?Q^L ANDN 5 #777 [STEP SUD NO CYCLICALLY ?RF= BZE 5 Z4203 ?RYW TXU 5 HSUDNO(1) ?SDG BCC Z4202 [J IF NO ALLOCATED ?SY6 CHAIN FPTR(3),BPTR(1) [ADJUST SUD CHAIN SO FREE NO.IS LAST ?TCQ Z4204 EXIT 7 0 [EXIT ?TXB Z4206 GEOERR 0,SUDNOMAX ?WC2 # ?WWL # THIS SUBR SETS UP A SCB & INITIALISES IT ?XB= # ON ENTRY X5 CONTAINS A SUD NO TO BE INSERTED IN THE BLOCK OR ZERO ?XTW # INDICATING THAT THE SHORTER SCB CAN BE SET UP ?Y*G # ON EXIT THE ADDR OF THE SCB IS IN X2 ?YT6 Z4400 SBX 7 FX1 ?^#Q LDN 6 HSUD-A1 ?^SB BZE 5 Z4402 [J IF NO SUD #2#2 ADN 6 2 #2RL Z4402 SETUPCORE 6,2,BSTB,BSCB #3?= BZE 5 Z4404 #3QW STO 5 HSUD(2) #4=G STOZ HSUD+1(2) #4Q6 Z4404 STOZ A1(2) #59Q LDN 0 A1(2) #5PB LDN 1 A1+1(2) #692 MOVE 0 HPERM-A1-1 #6NL NGN 0 1 #78= STO 0 HPERM(2) #7MW LDN 0 HPERM(2) #87G ADN 1 HPERM-A1 #8M6 MOVE 0 7 #96Q LDX 1 FX1 #9LB ADX 7 1 #=62 EXIT 7 0 #=KL ) #?5= # #?JW # REPORT VARIOUS ERRORS ##4G XEL ##J6 LDX 0 YCOUNT(2) #*3Q ANDN 0 3 #*HB BNZ 0 XNOENT [HAVE READ R/S #B32 LDN 1 PARMIS #BGL LDN 2 NAME #C2= BRN RERROR1 #CFW XJSLO #C^G LDN 1 PARMIS #DF6 LDN 2 NAME #DYQ BRN RERROR3A #FDB XCE1 #FY2 LDN 1 NAPP #GCL BRN RERROR3 #GX= SERR2 LDN 1 RICR [INVALID CORE PARM #HBW BRN RERROR3 #HWG #SKIP G4 #JB6 ( #JTQ XQUOTA [INVALID QUOTA PARAM #K*B LDN 1 WQUOTA #KT2 BRN RERROR3 #L#L XRLP LDN 1 WRLP [RETAIN LOAD PERIP SET FOR PP #LS= BRN RERROR #M?W ) #MRG XFILETYPE #N?6 LDN 1 PTYPE #NQQ BRN RERROR #P=B XWRBLK #PQ2 LDN 1 WRBLK #Q9L BRN RERROR #QP= XEOF #R8W LDX 0 YCOUNT(2) #RNG ANDN 0 3 #S86 BZE 0 RINFF [NOT READ R/S #SMQ XNOENT #T7B LDN 1 NOENT #TM2 BRN RERROR #W6L XTM #WL= XRSLENG #X5W XSRS [INCORRECT SUPP RQS #XKG RINFF #Y56 LDN 1 RINF #YJQ BRN RERROR #^4B XCHSUM #^J2 LDN 1 RJCHER *23L BRN RERROR *2H= XRS *32W LDN 1 NORES *3GG BRN RERROR *426 NOERR *4FQ LDN 5 0 [ERROR ALREADY REPORTED *4^B LDN 6 0 *5F2 BRN RERROR3C *5YL RERROR3A *6D= SMO FX1 *6XW LDX 6 0(2) [ADDR OF SUBSID MESSAGE *7CG BRN RERROR3B *7X6 # RERROR3,RERROR3A - ERRORS BEFORE LOADFILE OPENED *8BQ RERROR3 *8WB LDN 6 0 *9B2 RERROR3B *9TL SMO FX1 *=*= LDX 5 0(1) *=SW RERROR3C *?#G LDN 7 1 [FILE NOT TO BE CLOSED *?S6 BRN RERROR2 *#?Q # RERROR,RERROR1 - ERRORS AFTER LOADFILE OPENED *#RB RERROR1 **?2 SMO FX1 **QL LDX 6 0(2) *B== BRN RERROR1A *BPW RERROR *C9G LDN 6 0 [NO SUBSIDIARY PART OF ERROR MESSAGE *CP6 RERROR1A *D8Q SMO FX1 *DNB LDX 5 0(1) [ADDR OF MAIN MESSAGE *F82 LDN 7 0 [FILE TO BE CLOSED *FML RERROR2 *G7= LDX 2 FX2 *GLW LDX 0 YCOUNT(2) [LEAVE YCOUNT HOLDING NO OF RECORDS *H6G SRL 0 3 *HL6 STO 0 YCOUNT(2) *J5Q ORN 7 2 [NO ERRORS REQUIRE PROG TO BE DELETED *JKB ACROSS LOADERR,1 *K52 # *KJL # DEAL WITH BREAKIN AT VARIOUS STAGES *L4= # *LHW ...XBNA *M3G ...XBN LDN 7 3 [INDICATE NO FILE OPEN & NO COREIMAGE *MK* ...#SKI JWPHASE4 *MMJ ...( *MPR ... BRN XBNB *MS2 ...XBNC LDN 7 2 [FILE MAY BE OPEN,BUT NO PCA *MW9 ...XBNB *MYD ...) *N2Q LDN 5 0 [NO SWAP SPACE OBTAINDE *N5W ... LDX 2 FX2 *N92 ... LDX 0 YCOUNT(2) [SET YCOUNT = NO OF RECORDS READ *N#6 ... SRL 0 3 *NC= ... STO 0 YCOUNT(2) *NGB ACROSS LOADERR,3 *P22 MENDAREA 50,K99LDSTART *PFL #END ^^^^ ...43625553000700000000