SETPR867
(George Source)
Macros used: ACROSS, BRUSEN, CHNUMCOD, CHNUMCON, CLOSETOP, COMBRKIN, COMERRX, FNORM, FREECORE, GETJOB, GETSOUT, HUNT, MFREE, MHUNT, NAMETOP, PARAFREE, PARALYSE, PARANEXT, PARAPASS, READDICT, REPALLER, SEG, SEGENTRY, SETNCORE, SETUPCORE, SETXCORE, SPARAPAS, SSEARCH, STEP, STEPAGAIN, TESTHKN, TESTREP, TESTREP2, UNIFREE, UP, USEROPEN
- SETPR867.txt
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