{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: SETPR867)}}
====== SETPR867 ======
(George Source)
**Macros used:** [[george:macro:ACROSS|ACROSS]], [[george:macro:BRUSEN|BRUSEN]], [[george:macro:CHNUMCOD|CHNUMCOD]], [[george:macro:CHNUMCON|CHNUMCON]], [[george:macro:CLOSETOP|CLOSETOP]], [[george:macro:COMBRKIN|COMBRKIN]], [[george:macro:COMERRX|COMERRX]], [[george:macro:FNORM|FNORM]], [[george:macro:FREECORE|FREECORE]], [[george:macro:GETJOB|GETJOB]], [[george:macro:GETSOUT|GETSOUT]], [[george:macro:HUNT|HUNT]], [[george:macro:MFREE|MFREE]], [[george:macro:MHUNT|MHUNT]], [[george:macro:NAMETOP|NAMETOP]], [[george:macro:PARAFREE|PARAFREE]], [[george:macro:PARALYSE|PARALYSE]], [[george:macro:PARANEXT|PARANEXT]], [[george:macro:PARAPASS|PARAPASS]], [[george:macro:READDICT|READDICT]], [[george:macro:REPALLER|REPALLER]], [[george:macro:SEG|SEG]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:SETUPCORE|SETUPCORE]], [[george:macro:SETXCORE|SETXCORE]], [[george:macro:SPARAPAS|SPARAPAS]], [[george:macro:SSEARCH|SSEARCH]], [[george:macro:STEP|STEP]], [[george:macro:STEPAGAIN|STEPAGAIN]], [[george:macro:TESTHKN|TESTHKN]], [[george:macro:TESTREP|TESTREP]], [[george:macro:TESTREP2|TESTREP2]], [[george:macro:UNIFREE|UNIFREE]], [[george:macro:UP|UP]], [[george:macro:USEROPEN|USEROPEN]]
22FL ... SEG SETPR,,CENT(INSTALLATION HOOKS),,G400
22^= [
23DW [ (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD 1982
23YG [
24D6 #
24XQ # THIS CHAPTER IS FOR G3PLUS-IH MK2
25CB #
25X2 SEGENTRY K1SETPR,SENTRY1 [ENTRY FOR PRIVILEGED PARAMS
26BL #
26W= # LOCAL IDENTIFIERS FOR CONTROL BLOCK
27*W #
27TG #DEF STYPE=A1+1
28*6 #DEF RSTAR=A1+2
28SQ #DEF RPLUS=A1+3
29#B #DEF RD=A1+4
29S2 #DEF RS=A1+5
2=?L #DEF SPARE=A1+6
2=R= #DEF RCOUNT=A1+7
2?=W #DEF RSTRING=A1+8
2?QG YDSK1 #37777777
2#=6 YDSK2 #77777
2#PQ YDSK20 +20
2*9B YDSK3 #777777
2*P2 Y125 +125
2B8L Y8 +8
2BN= Y9 +9
2C7W NINDEX +8
2CMG Y13 +13
2D76 SPEC 8H-8388608
2DLQ MAGIC +7036875
2F6B MINUS #35
2FL2 PA 4H000A
2G5L PC 4H000C
2GK= PS 4H000S
2H4W PK 4H000K
2HJG PD 4H000D
2J46 PV 4H000V
2JHQ PZPLUS #73
2K3B PSTAR 4H000*
2KH2 PLUS 4H000+
2L2L PAREN 4H000(
2LG= 4H000)
2L^W PDTABNO 4
2MFG PDTAB 4H000?
2M^6 4H000"
2NDQ 4H000'
2NYB 4H000/
2PD2 #
2PXL MESSAGENOS
2QC= #
2QWW # SPACE-SAVING VERSION TO ALLOW OTHER MODS
2RBG #
2RW6 SBX 5 FX1
2S*Q LDN 7 0 [ INDICATE NO NUMBERS YET READ
2STB PARAPASS [ (N1,N2) IF PRESENT
2T*2 HUNT 3,CPB,CUNI
2TSL NGX 4 ANUM(3)
2W#= BPZ 4 SLINK [ NO PARAMETER
2WRW LDEX 6 ATYPE(3) [PARAM NO. FROM MULTI PARAM BL
2X?G PARANEXT #34,,6
2XR6 XH
2Y=Q HUNT 3,CPB,CUNI [ N1 OR N2
2YQB LDX 4 ANUM(3)
2^=2 BZE 4 XERR [ ERROR IF NULL PARAMETER
2^PL BNG 4 NON [ PARAMETER MISSING
329= CHNUMCOD 1,3,XBREAK
32NW TESTREP2 CHNUMERR,XERR1
338G LDX 6 ACOMMUNE1(2) [ CONVERTED NUMBER
33N6 BNG 6 XERR [ ERROR IF NEGATIVE
347Q BZE 6 XERR [ OR ZERO
34MB BNZ 7 SLINK [ EXIT IF BOTH N1 AND N2 NOW READ
3572 LDX 7 6 [ COPY N1 INTO X7
35LL PARAPASS [ N2 IF PRESENT
366= BRN XH [ REPEAT CONVERSION FOR N2
36KW NON
375G BZE 7 XERR [ ERROR IF N1 MISSING
37K6 SLINK
384Q MHUNT 3,CPB,CUNI
38JB FREECORE 3
3942 ADX 5 FX1
39HL EXIT 5 0
3=3= SPAR
3=GW SBX 7 FX1
3?2G SPARAPAS
3?G6 MHUNT 3,CPB,CUNI
3?^Q ADX 7 FX1
3#FB EXIT 7 0
3#^2 XIT
3*DL LDN 5 AWORK1
3*Y= XITC
3BCW ADN 4 2
3BXG SETUPCORE 4,3,COMDAT,CSETP [PARAM BLK
3CC6 STO 7 ANUM(3)
3CWQ BZE 7 XITA
3DBB SMO 5
3DW2 LDN 1 0(2)
3F*L LDN 2 APARA(3)
3FT= SMO 7
3G#W MVCH 1 0 [PARAM TO BE INSERTED
3GSG SBN 4 2
3H#6 SLL 4 2
3HRQ SBX 4 7
3J?B BZE 4 XITA
3JR2 LDN 1 ACES
3K=L SMO 4
3KQ= MVCH 1 0
3L9W XITA
3LPG ... ACROSS SETPARAM,4
3M96 XITB
3MNQ LDN 5 ACOMMUNE1
3N8B BRN XITC
3N?G ... SEGENTRY G400RECB
3NBL ...NOTUSERCN
3NFQ ... LDX 7 PJRWRONGUS(1)
3NJW ... BRN XER1
3NN2 XERR1
3P7L LDX 7 PCHNUMERR(1) [ERROR CODE ...
3PM= BRN XER1
3Q6W XERR
3QLG LDX 7 PAPFERR(1)
3R66 XER1
3RKQ SMO FX2
3S5B LDX 4 AWORK4
3SK2 NGN 6 1
3T4L BZE 4 XER2
3TJ= PARAFREE
3W3W UNIFREE
3WHG LDX 2 FX2
3X36 LDX 0 AWORK3(2)
3XGQ STO 0 JOBEVENTS(2)
3Y2B UP
3YG2 XER2
3Y^L COMERRX 7,6
3^F= #
3^YW PCHNUMERR +CHNUMERR
42DG PAPFERR +APFERR
42N# ...PJRWRONGUS +JRWRONGUSER
42Y6 #
43CQ XBREAK
43XB COMBRKIN
44C2 #
44WL # #############################################################
45B= #
45TW # K K 1
46*G # K K 11
46T6 # K K 1
47#Q # K K 1
47SB # KKK 1
48#2 # K K 1
48RL # K K 1
49?= # K K 1
49QW # K K 1
4==G #
4=Q6 # #############################################################
4?9Q #
4?PB SENTRY1
4#92 XREC
4#NL LDN 4 2
4*8= PARALYSE ,,4 [REMOVE ENCLOSURE
4*MW PARALYSE #34 [SEPARATE FD,RD,ETC
4B7G CALL 7 SPAR [FILE DESCRIPTION
4BM6 LDX 0 ANUM(3)
4C6Q BZE 0 XERR [ERROR IF NULL
4CLB BNG 0 XERR [OR NON-EXISTENT
4CMR ... BRUSEN XDSKF [J IF NO USER CONTEXT
4CP8 ... BRN XDSK3
4CQK ...XDSKF
4CS2 ... TESTHKN NOTUSERCN [MUST BE HOOKED IF NO USER
4CTC ... SEGENTRY G400RECA
4CWS ... NULL [BRN NOTUSERCN IF IHSPNOUSER OF
4CY9 ... STOZ CPREFIX(2) [CLEAR CPREFIX AREA
4C^L ... STOZ CPREFIX+1(2)
4D33 ... STOZ CPREFIX+2(2)
4D4D ...XDSK3
4D62 NAMETOP 3,FILE,FNAME [RENAME CUNI FILE/FNAME
4DDC ... FNORM 2 [DECODE FILE NAME
4DQS ... TESTREPN OK,XERR
4DY3 ... BRUSEN XDSJ1
4F5= USEROPEN XBREAK,READ,TERMDIR,LEAVE,NOERREP
4F7G ... TESTREP NOTRAP,XDSJ2
4F9Q ...XDSJ0
4F#2 ... TESTREPN OK,XERR
4FB= ... BRN XDSK14
4FDG ...XDSJ1
4FGQ ... USEROPEN XBREAK,READ,TERMDIR,UNTRAP,LEAVE,NOERREP
4FK2 ... BRN XDSJ0
4FM= ...XDSJ2
4FPL ... LDX 4 AWORK4(2)
4FRC ... BNZ 4 XERR
4FT8 ... REPALLER [REPORT TRAPS CLOSED ERROR
4FWB ... BRN XERR
4G36 ...XDSK14
4G4G MHUNT 3,FILE,ENT [COPY OF DIRENT
4GJ6 LDX 5 ETM(3)
4H3Q STO 5 AWORK1(2)
4HHB LDX 0 EINDEX(3)
4J32 STO 0 AWORK2(2)
4JGL FREECORE 3 [FREE DIR ENT BLK
4K2= CALL 7 SPAR [RECORD DESCRIPTION
4KFW LDX 0 ANUM(3)
4K^G BNG 0 XERRC [J IF NON-EXISTENT
4LF6 BZE 0 XERRC [OR,NULL
4LYQ SRL 0 12 [PARAMETER TYPE
4MDB BNZ 0 XRCT [NOT SIMPLE
4MY2 CHNUMCON 1,XBREAK [CONV CONTENTS OF CUNI TO BIN
4NCL TESTREPN OK,XERRC
4NX= MHUNT 3,CPAR,GNUMCON
4PBW LDX 4 A1+1(3) [BINARY RESULT
4PWG BZE 4 XERRC
4QB6 BNG 4 XERRC
4QTQ XRCD
4R*B CALL 7 STEP [READ N RECORDS ACCORDING
4RT2 BRN £ [TO + REC. DESCRIPTOR
4S#L BZE 3 XERRC
4SS= BCT 4 XRCD
4T?W XRCDI
4TRG LDN 5 2
4W?6 SMO FX2
4WQQ LDX 0 AWORK1
4X=B BNG 0 XRCD3 [J IF NOT AMORPHOUS
4XQ2 SBN 5 1
4Y9L XRCD3
4YP= LDX 7 0(3)
4^8W TXL 7 Y125(1)
4^NG BCS XRCD1
5286 LDX 7 Y125(1) [SIZE OF COMDAT TO BE CREATED
52MQ XRCD1
537B ADN 7 APARA-A1
53M2 SETUPCORE 7,2,COMDAT,CSETP
546L STEPAGAIN
54L= MHUNT 2,COMDAT,CSETP
555W SBN 7 APARA-A1
55KG SBX 7 5
5656 SLL 7 2
56JQ STO 7 ANUM(2) [LENGTH OF REC
574B SRL 7 2
57J2 BZE 7 XRCD2 [J IF ZERO LENGTH
583L LDN 4 APARA(2)
58H= ADX 3 5
592W SMO 7
59GG MOVE 3 0 [MOVE TO COMDAT
5=26 XRCD2
5=FQ CLOSETOP
5=^B MFREE CPB,CMULTI
5?F2 MFREE CPB,CMULTI
5?YL PARAPASS [UPDATE PARAM PTR AS ...
5#D= MFREE CPB,CUNI [HAVING BEEN ACCESSED
5#XW CALL 5 MESSAGENOS [GET FROM & TO PARAMS
5*CG BZE 7 XITA [J IF N1 ABSENT
5*X6 MHUNT 3,COMDAT,CSETP
5BBQ LDX 4 ANUM(3) [COUNT
5BWB TXL 6 7
5CB2 BCS XERR
5CTL TXL 4 7
5D*= BCC XRM1
5DSW STOZ ANUM(3)
5F#G BRN XITA
5FS6 XRM1
5G?Q TXL 4 6
5GRB BCC XRM2
5H?2 LDX 6 4 [COUNT
5HQL XRM2
5J== SBX 6 7 [N2-N1
5JPW ADN 6 1 [NEW COUNT
5K9G STO 6 ANUM(3)
5KP6 LDN 4 APARA(3) ['TO' ADDRESS
5L8Q SBN 7 1
5LNB BZE 7 XITA
5M82 SRC 7 2 [CHAR. ADDR.
5MML LDX 3 4
5N7= ADX 3 7
5NLW SMO 6 [ADDR. OF TO
5P6G MVCH 3 0
5PL6 BRN XITA
5Q5Q STEP
5QKB SBX 7 FX1
5R52 STEP [READ FILE INTO FILE/FURB
5RJL ADX 7 FX1
5S4= TESTREP OK,STEP1
5SHW EXIT 7 0
5T3G STEP1
5TH6 EXIT 7 1
5W2Q XRCT
5WGB LDX 4 ANUM(3) [PARAM TYPE&LENGTH
5X22 ANDN 4 #7777
5XFL LDX 6 4
5X^= ADN 6 RSTRING-A1*4+3
5YDW SRL 6 2
5YYG SETXCORE 6,3,IUSER,G400BLK [SET UP CTXT CONTROL BLK
5^D6 LDN 0 4
5^XQ STO 0 A1(3)
62CB LDN 0 1
62X2 STO 0 STYPE(3)
63BL STO 0 SPARE(3)
63W= STO 0 RSTAR(3) [DEFAULT "*"
64*W LDX 0 GSIGN
64TG STO 0 RD(3) [DEFAULT "D"
65*6 STOZ RPLUS(3) [DEFAULT "+"
65SQ LDN 0 8
66#B LDX 7 AWORK1(2)
66S2 BNG 7 XRCT1 [J IF SERIAL FILE
67?L LDN 0 0 [DEFAULT "S" -AMORPHOUS FL
67R= XRCT1
68=W STO 0 RS(3)
68QG MHUNT 2,CPB,CUNI
69=6 LDCH 5 APARA(2)
69PQ CALL 0 PDCH [CHECK FOR DELIMITER
6=9B BRN XRCEN [RETURN HERE IF IT IS
6=P2 LDN 0 2
6?8L TXU 5 PC(1)
6?N= BCC XRCE1
6#7W LDN 0 3
6#MG TXU 5 PS(1)
6*76 BCC XRCE1
6*LQ LDN 0 4
6B6B TXU 5 PK(1)
6BL2 BCC XRCE1
6C5L BRN XERRC
6CK= XRCE1
6D4W STO 0 STYPE(3) [2=C,3=S
6DJG BCHX 2 £
6F46 SBN 4 1
6FHQ BZE 4 XERRC
6G3B LDCH 5 APARA(2)
6GH2 CALL 0 PDCH
6H2L BRN XRCEN [J IF DELIMITER
6HG= BRN XERRC
6H^W XRCEN
6JFG SBN 4 2
6J^6 STO 4 RCOUNT(3) [COUNT OF CHARS MINUS DELIM
6KDQ ADN 4 1
6KYB XRCE3
6LD2 BCHX 2 £
6LXL LDCH 0 APARA(2)
6MC= TXU 0 5
6MWW BCC XRCE2 [J IF DELIM
6NBG DCH 0 RSTRING(3)
6NW6 BCHX 3 £
6P*Q BCT 4 XRCE3
6PTB BRN XERRC
6Q*2 XRCE2
6QSL BCT 4 XERRC
6R#= #
6RRW # DECODE D,*,S,V,+ PARTS OF RECORD DESCRIPTION
6S?G #
6SR6 XRCE4
6T=Q CALL 7 SPAR [GET NEXT PARAM
6TQB LDX 4 ANUM(3) [COUNT WORD
6W=2 BNG 4 XRCA8A [SKIP IF NON-EXISTENT
6WPL BZE 4 XRCE4 [TRY AGAIN IF NULL
6X9= ANDN 4 #7777 [MASK FOR COUNT
6XNW LDCH 6 APARA(3) [FIRST CHAR
6Y8G TXU 6 PD(1) [D?
6YN6 BCS XRCE5 [J IF NOT D
6^7Q SBN 4 1 [1 OTHER CH REQD
6^MB BZE 4 XERRC [ERROR IF NONE
7272 BCHX 3 £
72LL LDCH 6 APARA(3) [LOAD DUMMY
736= CALL 7 PCB [LOCATE CONTROL BLOCK
73KW STO 6 RD(2) [STORE DUMMY
745G BRN XRCE4 [TRY NEXT
74K6 XRCE5
754Q LDN 5 RSTAR ['*' POSN IN CTRL BLK
75JB TXU 6 PSTAR(1) [*?
7642 BCC XRCE6 [J IF *
76HL LDN 5 RS ['S' POSN IN CTRL BLK
773= TXU 6 PS(1) [S?
77GW BCS XRCE7 [J IF NOT 'S'
782G XRCE6
78G6 SBN 4 1 [COUNT
78^Q LDN 0 0 [INITIALISE
79FB TXL 4 Y8(1)
79^2 BCC XERRC [TOO BIG
7=DL LDN 1 0
7=Y= XRCE8
7?CW BCHX 3 £
7?XG CDB 0 APARA(3) [CVT TO BINARY
7#C6 BCS XERRC
7#WQ BCT 4 XRCE8 [BACK ROUND LOOP
7*BB BNZ 0 XERRC [J,OVERFLOW
7*W2 CALL 7 PCB [LOCATE CTRL BLK
7B*L SMO 5
7BT= STO 1 0(2) [STORE RESULT
7C#W BRN XRCE4 [J FOR NEXT PARAM
7CSG XRCE7
7D#6 TXU 6 PV(1) [V?
7DRQ BCS XRCE9 [J IF NOT 'V'
7F?B SBN 4 1 [1 OTHER CHAR REQUD
7FR2 BZE 4 XERRC [J IF NONE -> ERROR
7G=L BCHX 3 £
7GQ= LDCH 6 APARA(3) [LOAD VISIBLE SPACE CHAR
7H9W MHUNT 3,IUSER,G400BLK [FIND BL WITH REC DESC
7HPG LDN 4 #20
7J96 LDX 5 RCOUNT(3) [COUNT OF CHARS IN REC DESC
7JNQ XRCE7A
7K8B LDCH 7 RSTRING(3) [LOAD CHAR FROM REC DESC
7KN2 TXU 6 7 [IS IT A VISIBLE SPACE CHAR?
7L7L BCS XRCE7B [NO-NEXT CHAR
7LM= DCH 4 RSTRING(3) [REPLACE WITH SPACE(INVISIBLE!)
7M6W XRCE7B
7MLG BCHX 3 £
7N66 BCT 5 XRCE7A
7NKQ BRN XRCE4 [NEXT PARAM
7P5B XRCE9
7PK2 LDN 5 RPLUS
7Q4L TXU 6 PLUS(1)
7QJ= BCS XERRC
7R3W BRN XRCE6
7RHG XRCA8A
7S36 CALL 7 PCB
7SGQ LDX 0 STYPE(2)
7T2B SBN 0 4
7TG2 BZE 0 XRCK1
7T^L XRCA8
7WF= CALL 7 STEP
7WYW XRCA2
7XDG CALL 7 PCB
7XY6 BNZ 3 XRCA6 [X3=0,EOF
7YCQ XRCAN
7YXB CLOSETOP [CLOSE FILE
7^C2 LDN 7 0
7^WL LDN 4 0
82B= BRN XITC [SET PARAM NULL
82TW XRCA6
83*G SMO 4 [PTR TO IUSER/G400BLK
83T6 LDX 1 RS [FILE TYPE
84#Q SMO 4
84SB LDN 2 RSTRING [RECORD DESCRIPTION
85#2 LDX 5 0(3) [WORD COUNT OF REC
85RL SMO FX2
86?= LDX 0 AWORK1
86QW BZE 0 XRCA0 [J IF AMORPHOUS
87=G LDCT 7 #600
87Q6 ANDX 7 1(3)
889Q BZE 7 XRCA9 [J FULL WORD
88PB SBN 5 1
8992 XRCA9
89NL ORX 5 7
8=8= XRCA0
8=MW SLC 5 2 [SIZE IN CHARACTERS
8?7G SBX 5 1
8?M6 BNG 5 XRCA8 [J TOO SMALL,GET NEXT
8#6Q SMO 4
8#LB LDX 7 RCOUNT
8*62 TXL 5 7
8*KL BCS XRCA8 [READ AGAIN IF REC < NO. OF CHARS IN
8B5= SRC 1 2
8BJW ADX 1 3
8C4G LDN 6 1
8CJ6 SMO 4
8D3Q LDX 0 STYPE [C OR S PARAM
8DHB SBN 0 2
8F32 BNZ 0 XRCA3 [J IR S
8FGL LDX 6 5
8G2= SBX 6 7
8GFW ADN 6 1
8G^G XRCA3
8HF6 SMO 4
8HYQ STO 6 SPARE [NO. OF SPARE CHARS
8JDB SBN 0 1
8JY2 BNZ 0 XRCA4 [J IF NOT S
8KCL LDX 6 5
8KX= SBX 6 7 [NO OF SPARE CHARS
8LBW BZE 6 XRCA4 [J IF NONE
8LWG XRCA5
8MB6 LDCH 0 0(1)
8MTQ SBN 0 #20
8N*B BNZ 0 XRCA4 [REMOVE LEADING SPACES
8NT2 BCHX 1 £
8P#L BCT 6 XRCA5
8PS= BRN XRCA8
8Q?W XRCA4
8QRG CALL 7 SCAN [FIND REC MATCHING CONTEXT
8R?6 BRN XRCA8 [NOT FOUND
8RQQ SMO 4
8S=B LDX 0 RSTAR
8SQ2 BCT 0 XRCA7 [J IF NTH REC SPEC BY * PARAM
8T9L LDX 1 FX1
8TP= XRCAP
8W8W SMO 4
8WNG LDX 4 RPLUS
8X86 BZE 4 XRCDI
8XMQ BRN XRCD
8Y7B XRCA7
8YM2 SMO 4
8^6L STO 0 RSTAR
8^L= BRN XRCA8
925W PCB
92KG MHUNT 2,IUSER,G400BLK
9356 LDX 4 2
93JQ EXIT 7 0
944B #
94J2 # SUBROUTINE TO SCAN CONTEXT
953L #
95H= SCAN
962W SMO 4
96GG LDX 5 RCOUNT [COUNT OF CHARS MINUS DELIMS
9726 SCAN5
97FQ LDCH 6 0(2) [CHAR FROM RECORD DESC
97^B SMO 4
98F2 LDX 0 RD [DUMMY
98YL BNG 0 SCAN1 [J IF ABSENT
99D= TXU 0 6 [IS CHAR A DUMMY?
99XW BCC SCAN2 [J IF Y
9=CG SCAN1
9=X6 LDCH 0 0(1) [CHAR FROM REC
9?BQ TXU 0 6 [MATCHES CONTEXT?
9?WB BCS SCAN3 [J IF NO
9#B2 SCAN2
9#TL BCHX 1 £
9**= BCHX 2 £
9*SW BCT 5 SCAN5
9B#G EXIT 7 1
9BS6 SCAN3
9C?Q SMO 4
9CRB LDX 0 SPARE [NO. OF SPARE CHARS
9D?2 BCT 0 SCAN4
9DQL EXIT 7 0
9F== SCAN4
9FPW SMO 4
9G9G STO 0 SPARE
9GP6 LDX 1 0(3)
9H8Q SLL 1 2
9HNB SBX 1 0
9J82 ADN 1 1
9JML SMO 4
9K7= SBX 1 RCOUNT
9KLW SRC 1 2
9L6G ADX 1 3
9LL6 SMO 4
9M5Q LDN 2 RSTRING
9MKB BRN SCAN
9N52 XERRC
9NJL CLOSETOP
9P4= BRN XERR
9PHW #
9Q3G # SUROUTINE TO CHECK FOR DELIMITER
9QH6 #
9R2Q PDCH
9RGB TXU 5 PAREN(1)
9S22 BCS PDCH3
9SFL LDX 5 PAREN+1(1)
9S^= EXIT 0 0
9TDW PDCH3
9TYG LDX 6 PDTABNO(1)
9WD6 PDCH1
9WXQ TXU 5 PDTAB(1)
9XCB BCC PDCH2
9XX2 ADN 1 1
9YBL BCT 6 PDCH1
9YW= ADN 0 1
9^*W PDCH2
9^TG LDX 1 FX1
=2*6 EXIT 0 0
=2SQ XRCK1
=3#B SMO FX2
=3S2 LDX 0 AWORK2
=4?L SMO FX1
=4R= TXL 0 NINDEX
=5=W BCC XERRC
=5QG SMO 0
=6=6 BRN £
=6PQ BRN XERRC
=79B BRN XERRC
=7P2 BRN XRKD
=88L BRN XRKS
=8N= BRN XERRC
=97W BRN XRKO
=9MG BRN XRKJ
==76 BRN XERRC
==LQ #
=?6B # DICTIONARY ENTRIES
=?L2 #
=#5L # CHECK KEY
=#K= #
=*4W XRKD
=*JG LDX 4 RCOUNT(2)
=B46 TXL 4 Y13(1) [>12=ERROR
=BHQ BCC XERRC [NOT USERNAME FORMAT
=C3B LDCH 0 RSTRING(2) [1ST CHAR
=CH2 SBN 0 #41
=D2L BNG 0 XERRC [<'A'
=DG= SBN 0 #33
=D^W BPZ 0 XERRC [>'Z'
=FFG SBN 4 1 [STEP COUNT
=F^6 BCHX 2 £ [AND POINTER
=GDQ BZE 4 XRKD1
=GYB XRKD2
=HD2 LDCH 0 RSTRING(2)
=HXL SBN 0 #41
=JC= BNG 0 XRKD3 [<'A'
=JWW SBN 0 #33
=KBG BPZ 0 XERRC [>'Z'
=KW6 XRKD4
=L*Q BCHX 2 £
=LTB BCT 4 XRKD2 [RTRY NEXT
=M*2 #
=MSL # GET RECORD
=N#= #
=NRW XRKD1
=P?G SETNCORE 3,3,FILE,ADICT
=PR6 LDX 0 ACES [SPACE-FILL ADICT
=Q=Q STO 0 A1(3)
=QQB STO 0 A1+1(3)
=R=2 STO 0 A1+2(3)
=RPL CALL 7 PCB
=S9= LDN 4 RSTRING(2)
=SNW LDN 5 A1(3)
=T8G SMO RCOUNT(2)
=TN6 MVCH 4 0
=W7Q READDICT ,,NO
=WMB TESTREP NOUSER,XRCAN
=X72 XRCKX
=XLL CALL 7 PCB
=Y6= STEPAGAIN
=YKW BRN XRCAP [DO +SS AND INSERT RECORD
=^5G #
=^K6 # EXTRA BIT OF KEY CHECK
?24Q #
?2JB XRKD3
?342 ADN 0 #21
?3HL BZE 0 XRKD4 [J IF SPACE
?43= SBN 0 #15 [J IF HYPHEH
?4GW BZE 0 XRKD4
?52G ADN 0 #23
?5G6 BNG 0 XRKD4
?5^Q BRN XERRC [ELSE ERROR
?6FB #
?6^2 # :SYSTEM.SERIAL
?7DL #
?7Y= # DECODE KEY
?8CW XRKS
?8XG LDX 4 RCOUNT(2) [COUNT
?9C6 TXL 4 Y9(1) [TEST NO OF OCTITS
?9WQ BCC XERRC [ERROR=TOOMANY
?=BB LDN 3 RSTRING(2) [POINTER TO KEY
?=W2 LDN 5 0 [INITIALISE TSN WORD
??*L XRKS1
??T= LDCH 6 0(3) [LOAD OCTIT
?##W TXL 6 Y8(1)
?#SG BCC XERRC [ERROR NOT < 8
?*#6 SRC 6 3
?*RQ SLL 56 3
?B?B BCHX 3 £ [STEP POINTER
?BR2 BCT 4 XRKS1 [J IF MORE FOR NEXT
?C=L XRKS2
?CQ= SSEARCH XRCAN,5
?D9W BRN XRCKX
?DPG #
?F96 # :SYSTEM.OUTPUT
?FNQ #
?G8B XRKO
?GN2 # DECODE KEY
?H7L # I.E. JOBNO URGENCY -(SUBINDEX)-
?HM= #
?J6W LDX 4 RCOUNT(2) [LOAD COUNT
?JLG LDN 3 RSTRING(2) [POINTER TO KEY
?K66 CALL 7 XDECBIN [CONVERT TO DEC
?KKQ BZE 4 XERRC [ERROR,NO URGENCY
?L5B ANDX 6 YDSK3(1) [MASK URGENCY FIELD
?LK2 LDCH 0 0(3) [URGENCY
?M4L TXL 0 PA(1)
?MJ= BCS XERRC [ERROR NOT LETTER
?N3W TXL 0 PZPLUS(1)
?NHG BCC XERRC [ERROR NOT LETTER
?P36 SRC 0 6 [SHIFT TO CHAR 0
?PGQ ORX 6 0 [ADD IN TO JOBNO
?Q2B SBN 4 1
?QG2 BCHX 3 £
?Q^L SMO FX2 [STORE URG/JOBNO
?RF= STO 6 AWORK1
?RYW LDN 6 1 [DEFAULT SUBINDEX
?SDG BZE 4 XRKO1 [J NO AUXILIARY KEY
?SY6 CALL 7 XDECBIN
?TCQ #
?TXB # READ RECORD
?WC2 XRKO1
?WWL LDX 2 FX2
?XB= GETSOUT ,AWORK1(2),6
?XTW BRN XRCKX [REJOIN MAIN STREAM
?Y*G #
?YT6 # CONVERSION ROUTINE
?^#Q #
?^SB XDECBIN
#2#2 LDN 5 0
#2RL LDN 6 0
#3?= XDECB1
#3QW CDB 5 0(3)
#4=G BCS XDECB2 [END OF DECS
#4Q6 BNZ 5 XERRC [TOO BIG
#59Q BCHX 3 £
#5PB BCT 4 XDECB1
#692 XDECB2
#6NL EXIT 7 0
#78= #
#7MW # :SYSTEM.JOBLIST
#87G #
#8M6 XRKJ
#96Q #
#9LB # CONVERT KEY TO BINARY
#=62 #
#=KL LDX 4 RCOUNT(2) [LOAD COUNT
#?5= TXL 4 Y8(1) [TEST TOO BIG
#?JW BCC XERRC
##4G LDN 5 0
##J6 LDN 6 0
#*3Q LDN 3 RSTRING(2) [POINTER TO KEY
#*HB XRKJ1
#B32 CDB 5 0(3) [CONVERT TO BINARY
#BGL BCS XERRC [ERROR NON-DECIMAL CHAR
#C2= BNZ 5 XERRC [ERROR,OVERFLOW
#CFW BCHX 3 £ [STEP POINTER
#C^G BCT 4 XRKJ1 [LOOP FOR NEXT DIGIT
#DF6 #
#DYQ # KEY NOW IN BINARY IN X6
#FDB # READ RECORD FROM JOBLIST
#FY2 GETJOB 6,SYSTEM
#GCL TESTREPN OK,XRCAN
#GX= BRN XRCKX [REJOIN MAIN STREAM
#HBW #END
^^^^ ...605466770003