{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: LDSTART850)}}
====== LDSTART850 ======
(George Source)
**Macros used:** [[george:macro:ACROSS|ACROSS]], [[george:macro:ALTLEN|ALTLEN]], [[george:macro:ALTLEND|ALTLEND]], [[george:macro:BACKSPACE|BACKSPACE]], [[george:macro:CHAIN|CHAIN]], [[george:macro:CHNUMCO1|CHNUMCO1]], [[george:macro:CLOSE|CLOSE]], [[george:macro:CLOSETOP|CLOSETOP]], [[george:macro:DOWN|DOWN]], [[george:macro:ENDCOM|ENDCOM]], [[george:macro:FILECOUNT|FILECOUNT]], [[george:macro:FNORM|FNORM]], [[george:macro:FREEBUFF|FREEBUFF]], [[george:macro:FREECORE|FREECORE]], [[george:macro:FSUD|FSUD]], [[george:macro:FTM|FTM]], [[george:macro:GEOERR|GEOERR]], [[george:macro:HLSINFORM|HLSINFORM]], [[george:macro:LONGWAIT|LONGWAIT]], [[george:macro:MAGREAD|MAGREAD]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MFREE|MFREE]], [[george:macro:MFREEW|MFREEW]], [[george:macro:MHUNT|MHUNT]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:NAME|NAME]], [[george:macro:NAMETOP|NAMETOP]], [[george:macro:PARABEGX|PARABEGX]], [[george:macro:PARANUMB|PARANUMB]], [[george:macro:PPCUBS|PPCUBS]], [[george:macro:PTYPE|PTYPE]], [[george:macro:READ|READ]], [[george:macro:REPERR|REPERR]], [[george:macro:SEG|SEG]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:SETUPCORE|SETUPCORE]], [[george:macro:SPARANOT|SPARANOT]], [[george:macro:TESTREP2|TESTREP2]], [[george:macro:TESTRPN2|TESTRPN2]], [[george:macro:TOPFCB|TOPFCB]], [[george:macro:USEROPEN|USEROPEN]], [[george:macro:VFREEW|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