SETPE867
(George Source)
Macros used: ACROSS, CHNUMCOD, COMBRKIN, COMERRX, FINDCORE, FREECORE, GETCORE, HUNT, MFREE, MHUNT, NAME, ON, PARAFREE, PARALYSE, PARALYSX, PARANEXT, PARANUMB, PARAPASS, PARATYPE, PHOTO, PTYPE, SEG, SEGENTRY, SETUPCORE, SPARANOT, SPARANOX, SPARANXT, SPARAPAS, TESTREP, TESTREP2, UNIFREE, UP, UPPLUS
- SETPE867.txt
22FL ... SEG SETPE,,CENT(INSTALLATION HOOKS),,G400 22^= [ 23DW [ (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD 1982 23YG [ 24D6 # 24XQ SEGENTRY K1SETPE,SENTRY1 [SP PARAM[(CONTEXT)] 25CB SEGENTRY K2SETPE,SENTRY2 [SP "ENCLOSED STRING"[(CONTEXT)] 25X2 # 26BL # THIS CHAPTER IS FOR G3PLUS-IH MK2 26W= # 27*W # 27TG # THIS ROUTINE ANALYSES 2ND PART OF 2ND PARAM . 28*6 # IF OF TYPE (N1,N2) IT BRANCHES TO MESSAGENOS. 28SQ # OTHERWISE ON EXIT X6 CONTAINS CONTEXT TYPE 29#B # AND X7 CONTAINS SEARCH CHARACTER. 29S2 # IF 2ND PART MISSING X6 & X7 = 0. 2=?L # 2=R= XCONTMESS 2?=W SBX 5 FX1 2?QG LDN 7 0 [FOR COMPATABILITY WITH MESSAGENOS 2#=6 SPARAPAS [(CONTEXT) 2#PQ MHUNT 3,CPB,CUNI 2*9B NGX 4 ANUM(3) 2*P2 BPZ 4 XCONTOUT [J IF NO PARAM 2B8L LDEX 6 ATYPE(3) [PARAM NO WITHIN CMULTI 2BN= PARANEXT #34,,6 [SPLIT AT COMMA IF PRESENT 2C7W PARANUMB 6 2CMG SBN 6 1 2D76 MHUNT 3,CPB,CUNI 2DLQ LDX 4 ANUM(3) 2F6B BZE 4 XERR [ERROR IF 1ST PARAM NULL 2FL2 LDCH 4 APARA(3) 2G5L TXU 4 XCA(1) [CHECK IF CONTEXT 2GK= BCC XCONTA 2H4W TXU 4 XCB(1) 2HJG BCC XCONTA 2J46 TXU 4 XCH(1) 2JHQ BCC XCONTA 2K3B TXU 4 XCT(1) 2KH2 BCC XCONTA 2L2L TXU 4 XAST(1) 2LG= BCS XH [(N1,N2) ASSUMED IF NOT 2L^W XCONTA 2MFG BZE 6 XCONT1 [J IF ONLY 1 PARAM 2M^6 LDX 6 ANUM(3) 2NDQ ANDN 6 #7777 2NYB SBN 6 1 2PD2 BNZ 6 XERR [ERROR IF PARAM LENGTH > 1 2PXL LDCH 6 APARA(3) [SAVE 1ST PARAM 2QC= PARAPASS 2QWW MHUNT 3,CPB,CUNI [2ND PARAM 2RBG LDX 7 ANUM(3) 2RW6 BNZ 7 XERR [ERROR IF 2ND PARAM NOT NULL 2S*Q LDX 7 XCOMMA(1) 2STB BRN XCONT3 2T*2 XCONT1 2TSL LDCH 6 APARA(3) 2W#= LDX 4 6 2WRW SBN 4 #32 2X?G BNZ 4 XCONT2 [J IF NOT * 2XR6 LDN 0 0 2Y=Q DCH 0 APARA(3) [REPLACE * WITH 0 2YQB CHNUMCOD 1,3,XBREAK 2^=2 TESTREP CHNUMERR,XERR10 [J IF CONVERSION UNSUCCESSFUL 2^PL NGN 6 #32 [* IN X6 329= LDX 7 ACOMMUNE1(2) [RESULT IN X7 32NW BRN XCONT4 [&EXIT 338G XCONT2 33N6 LDX 7 ANUM(3) [GET PARAM LENGTH 347Q ANDN 7 #7777 34MB SBN 7 2 [IS PARAM LENGTH = 2 3572 BZE 7 XCONT2A [STRAIGHTFORWARD CASE 35LL BPZ 7 XERR [>2 PARAM LENGTH -> ERROR 366= LDCH 6 APARA(3) [1ST PARAM IN X6 36KW LDX 7 XSPACE(1) [ASSUME SPACE AS SPLITTER 375G BRN XCONT3 37K6 XCONT2A 384Q LDN 6 0 38JB LDX 7 APARA(3) 3942 SLL 67 6 [1ST CHAR OF PARAM IN X6 39HL BRN XCONT3 3=3= XCONTOUT 3=GW LDN 6 0 [NO ACTION CASE 3?2G LDX 7 GSIGN [UNSET INDICATORS 3?G6 BRN XCONT4 3?^Q XCONT3 3#FB NGX 6 6 [NEGATE X6 AS CONTEXT INDIC 3#^2 SRL 7 18 [SEARCH CHAR IN N3 POS OF X7 3*DL XCONT4 3*Y= MFREE CPB,CMULTI 3BCW MFREE CPB,CUNI 3BXG ADX 5 FX1 3CC6 EXIT 5 0 3CWQ # 3DBB XCA 4H000A 3DW2 XCB 4H000B 3F*L XCH 4H000H 3FT= XCT 4H000T 3G#W XBIG #73 [[ 3GSG SPACE #20 3H#6 XAST 4H000* 3HRQ XCOMMA 4H,000 3J?B XSPACE 4H 000 3JR2 # 3K=L # 3KQ= MESSAGENOS 3L9W # 3LPG # SPACE-SAVING VERSION TO ALLOW OTHER MODS 3M96 # 3MNQ SBX 5 FX1 3N8B LDN 7 0 [ INDICATE NO NUMBERS YET READ 3NN2 PARAPASS [ (N1,N2) IF PRESENT 3P7L HUNT 3,CPB,CUNI 3PM= NGX 4 ANUM(3) 3Q6W BPZ 4 SLINK [ NO PARAMETER 3QLG LDEX 6 ATYPE(3) [PARAM NO. FROM MULTI PARAM BL 3R66 PARANEXT #34,,6 3RKQ XH 3S5B HUNT 3,CPB,CUNI [ N1 OR N2 3SK2 LDX 4 ANUM(3) 3T4L BZE 4 XERR [ ERROR IF NULL PARAMETER 3TJ= BNG 4 NON [ PARAMETER MISSING 3W3W XH2 3WHG CHNUMCOD 1,3,XBREAK 3X36 TESTREP2 CHNUMERR,XERR 3XGQ LDX 6 ACOMMUNE1(2) [ CONVERTED NUMBER 3Y2B BNG 6 XERR [ ERROR IF NEGATIVE 3YG2 BZE 6 XERR [ OR ZERO 3Y^L BNZ 7 SLINK [ EXIT IF BOTH N1 AND N2 NOW READ 3^F= LDX 7 6 [ COPY N1 INTO X7 3^YW PARAPASS [ N2 IF PRESENT 42DG BRN XH [ REPEAT CONVERSION FOR N2 42Y6 NON 43CQ BZE 7 XERR [ ERROR IF N1 MISSING 43XB SLINK 44C2 MHUNT 3,CPB,CUNI 44WL FREECORE 3 45B= ADX 5 FX1 45TW EXIT 5 0 46*G XHNT1 46T6 SBX 7 FX1 47#Q SPARANXT ,,4 47SB BRN XHNT2 48#2 XHNT 48RL SBX 7 FX1 49?= PARANEXT ,,4 49QW XHNT2 4==G TESTREP UNPAIR,XERR 4=Q6 ADX 7 FX1 4?9Q HUNT 3,CPB,CUNI 4?PB EXIT 7 0 4#92 # 4#NL # ROUTINE TO LOCATE CPB CALAS BLOCK AT THE 4*8= # LEVEL ABOVE 4*MW # 4B7G XP400 4BM6 LDX 1 FX2 4C6Q LDN 6 2 [GOING UP 2 CPB/CALAS BLKS 4CLB XP400A 4D62 LDX 1 FPTR(1) [GO ROUND CHAIN 4DKL LDX 0 ATYPE(1) [THE BLOCK TYPE 4F5= SRL 0 12 [INTO BOTTOM BITS 4FJW ERN 0 CPB+CALAS [MASK TYPE 4G4G BNZ 0 XP400A [NOT REQUIRED BLOCK 4GJ6 BCT 6 XP400A [JUMP FIRST TIME AROUND 4H3Q EXIT 7 0 [THAT'S ALL 4HHB XERR 4J32 SMO FX1 4JGL LDX 7 PAPFERR 4K2= XER1 4KFW SMO FX2 4K^G LDX 4 AWORK4 4LF6 NGN 6 1 4LYQ BZE 4 XER2 [J IF NOT SETPARAM EXPRESSION 4MDB PARAFREE 4MY2 UNIFREE 4NCL LDX 2 FX2 4NX= LDX 0 AWORK3(2) 4PBW STO 0 JOBEVENTS(2) 4PWG UP 4QB6 XER2 4QTQ COMERRX 7,6 4R*B # 4RT2 PCHNUMERR +CHNUMERR 4S#L PAPFERR +APFERR 4SS= # 4T?W XBREAK 4TRG COMBRKIN 4W?6 # 4WQQ # ############################################################# 4X=B # 4XQ2 # K K 1 4Y9L # K K 11 4YP= # K K 1 4^8W # K K 1 4^NG # KKK 1 5286 # K K 1 52MQ # K K 1 537B # K K 1 53M2 # K K 1 546L # 54L= # ############################################################# 555W # 55KG SENTRY1 5656 # 56JQ # THE CODING FOR SP PARAM [(CONTEXT)] 574B # 57J2 XPAR 583L LDN 4 2 [2ND PARAM 58H= CALL 7 XHNT1 [FORM CPB/CUNI CONTAINING OLD PARAM 592W LDX 7 ANUM(3) 59GG BNG 7 XERR [PARAM MISSING 5=26 BZE 7 XERR [OR NULL 5=FQ ANDN 7 #7777 5=^B SBN 7 1 5?F2 BNZ 7 XERR [ERROR IF OLD PARAM > 1 CHAR 5?YL LDCH 6 APARA(3) 5#D= TXL 6 XCA(1) 5#XW BCS XERR [J IF PARAM < A 5*CG TXL 6 XBIG(1) [OR >= X 5*X6 BCC XERR 5BBQ XPAR2 5BWB CALL 7 XP400 [LOCATE CPB/CALAS AT LEVEL ABOVE 5CB2 LDCH 6 APARA(3) 5CTL SBN 6 #40 5D*= LDX 7 APARANUM(1) [NO. OF PARAMS 5DSW SBX 7 6 5F#G BPZ 7 XPAR2A 5FS6 LDN 5 0 [SET NULL FOR COMDAT 5G?Q STO 5 AWORK1(2) 5GRB BRN XPAR5 5H?2 XPAR2A 5HQL LDN 4 0 5J== # 5JPW # AT END OF LOOP X4+X1 POINT TO TYPE/LENGTH OF REQUIRED PARAM 5K9G # 5KP6 BRN XPAR4 5L8Q XPAR3 5LNB ADX 4 5 [ADD LENGTH IN 5M82 XPAR4 5MML SMO 4 5N7= LDX 5 APARAFIR(1) 5NLW ANDN 5 #7777 [GET LENGTH OF PARAM 5P6G STO 5 AWORK1(2) [SAVE CHAR COUNT 5PL6 ADN 5 3 5Q5Q SRL 5 2 [ROUND UP TO WORDS 5QKB ADN 4 1 [PLUS 1 FOR LENGTH WORD 5R52 BCT 6 XPAR3 5RJL XPAR5 5S4= ADN 5 APARA-A1 [LENGTH+(APARA-A1) GIVES REQUD BLKSIZ 5SHW SETUPCORE 5,3,COMDAT,CSETP 5T3G SBN 5 APARA-A1 5TH6 LDX 0 AWORK1(2) 5W2Q STO 0 ANUM(3) [SET CHAR COUNT 5WGB BZE 5 XITA 5X22 CALL 7 XP400 [RELOCATE CALAS 5XFL ADX 1 4 [X1 -> REQD PARAM 5X^= LDCT 7 #400 [SET B0=1,IE PARAM ACCESSED 5YDW ORS 7 APARAFIR-1(1) [ALLOW FOR X1 POINTING 5YYG # [BEYOND TYPE/LENGTH WORD 5^D6 ADN 1 APARAFIR 5^XQ LDN 2 APARA(3) 62CB XNNUL 62X2 SMO 5 63BL MOVE 1 0 [MOVE TO COMDAT 63W= MFREE CPB,CMULTI 64*W MFREE CPB,CUNI 64TG PARAPASS 65*6 MFREE CPB,CUNI 65SQ CALL 5 XCONTMESS 66#B BNG 7 XITA [NO FURTHER ACTION 66S2 MHUNT 3,COMDAT,CSETP 67?L BPZ 6 XPAR5Z [X6 +VE -> NOT CONTEXT SEARCH 67R= NGX 6 6 [RESTORE X6 TO CORRECT VAL 68=W LDX 1 FX1 68QG TXU 6 XCA(1) 69=6 BCC XPAR5AA 69PQ TXU 6 XCB(1) 6=9B BCS XERR [ONLY CONTEXT A& B ALLOWED 6=P2 XPAR5AA 6?8L LDX 4 3 [SAVE COMDAT ADDR. 6?N= LDX 0 ANUM(3) [COUNT 6#7W ANDN 0 #7777 6#MG XPAR5A1 6*76 LDCH 5 APARA(3) [TRY TO MATCH SEARCH CHAR 6*LQ SBX 5 7 6B6B BCHX 3 £ 6BL2 BZE 5 XPAR5A2 [J IF MATCH 6C5L BCT 0 XPAR5A1 [DROP THROUGH-> NO MATCH 6CK= TXU 6 XCB(1) 6D4W BCC XITA 6DJG SMO 4 6F46 STO 0 ANUM [ZEROISE COUNT 6FHQ BRN XITA [AND EXIT 6G3B XPAR5A2 6GH2 TXU 6 XCA(1) 6H2L BCS XPAR5B [J IF CONTEXT B 6HG= BCT 0 £ 6H^W SMO 4 6JFG STO 0 ANUM [STORE NEW LENGTH 6J^6 BZE 0 XITA [J IF NOCHARS FOLLOW SPLITTER 6KDQ ADN 4 APARA 6KYB ADN 3 APARA [ABSOLUTE ADDR OF PARAM IN COMDAT 6LD2 SMO 0 6LXL MVCH 3 0 6MC= BRN XITA 6MWW XPAR5B 6NBG SMO 4 6NW6 SBS 0 ANUM [NEW COUNT 6P*Q BRN XITA 6PTB XPAR5Z 6Q*2 LDX 4 ANUM(3) [COUNT OF CHARS IN REC 6QSL TXL 6 7 [N2<N1? 6R#= BCS XERR [Y 6RRW TXL 4 7 [CHARS IN REC < N1 6S?G BCC XPAR6 6SR6 STOZ ANUM(3) [ZEROISE COUNT AND EXIT 6T=Q BRN XITA 6TQB XPAR6 6W=2 TXL 4 6 6WPL BCC XPAR7 [JIF N2 WITHIN REC 6X9= LDX 6 4 [REPLACE N2 BY REC CT 6XNW XPAR7 6Y8G SBX 6 7 [X6=N2-N1 6YN6 ADN 6 1 6^7Q STO 6 ANUM(3) [NEW COUNT 6^MB LDN 4 APARA(3) ['TO' ADDR 7272 SBN 7 1 72LL BZE 7 XITA 736= SRC 7 2 [CONV TO CHAR ADDR 73KW LDX 3 4 745G ADX 3 7 74K6 SMO 6 754Q MVCH 3 0 75JB BRN XITA 7642 # 76HL # ############################################################# 773= # 77GW # K K 222 782G # K K 2 2 78G6 # K K 2 78^Q # K K 2 79FB # KKK 2 79^2 # K K 2 7=DL # K K 2 7=Y= # K K 2 7?CW # K K 2222222 7?XG # 7#C6 # ############################################################# 7#WQ # 7*BB SENTRY2 7*W2 # 7B*L # THE CODING FOR SP (ENCLOSED [(CONTEXT)] 7BT= # 7C#W CALL 5 XCONTMESS 7CSG ANDN 7 #7777 7D#6 LDN 4 1 7DRQ LDX 5 AWORK4(2) 7F?B BZE 5 XNSE [J IF NOT SETPARAM EXPRESSION 7FR2 LDN 4 2 7G=L XNSE 7GQ= STO 4 AWORK1(2) [SAVE ANALYSIS LEV 7H9W LDN 5 1 7HPG SPARANXT ,4,5 7J96 HUNT 3,CPB,CUNI [CUNI CONTAINS ENCLOSED STR 7JNQ LDX 4 ANUM(3) 7K8B BNG 4 PN2 7KN2 ANDN 4 #7777 7L7L SBN 3 1 7LM= BZE 7 ZALLM [BRN IF ALL MESSAGE REQUIRED 7M6W BPZ 6 XGETRZ [J IF NOT CONTEXT SEARCH 7MLG NGX 6 6 [X6 REVERTS TO TRUE VALUE 7N66 LDX 4 AWORK1(2) 7NKQ ADN 4 1 [INCREASE ANAL. LEV. 7P5B TXU 6 XAST(1) 7PK2 BCS XGETCON2 [J IF NOT * 7Q4L PARALYSE ,4,5 [SPLIT 1ST PARAM AT ANAL. LEV. SPEC B 7QJ= ADN 4 1 [AND AGAIN 7R3W PARANUMB 4,4 7RHG SBX 4 7 [<NO. SPEC. IN CONTEXT 7S36 BPZ 4 XGETCON1 [J IF N 7SGQ LDN 6 0 7T2B BRN XLOAD1A [NULL STRING 7TG2 XGETCON1 7T^L SPARANOX 7 [PASS NTH PARAM 7WF= HUNT 3,CPB,CUNI 7WYW LDN 7 APARA+1 7XDG BRN XLOAD1 7XY6 XGETCON2 7YCQ TXU 6 XCH(1) [CONTEXT = H? 7YXB BCS XGETCON3 [J IF N 7^C2 PARALYSX 7,4,5 [SPLIT AT CHAR SPECIFIED 7^WL # [IN CONTEXT PARAM 82B= SPARANOT 1 [PASS STR PRECEDING SPLITTER 82TW MHUNT 3,CPB,CUNI 83*G LDN 7 APARA+1 83T6 BRN XLOAD1 84#Q XGETCON3 84SB TXU 6 XCT(1) [CONTEXT = T? 85#2 BCS XERR [J IF NO 85RL PARALYSX 7,4,5 [SPLIT AT CONTEXT CHAR 86?= PARANUMB 6 86QW SBN 6 1 87=G BNZ 6 XGETCON4 [J IF > 1 STR PRODUCED 87Q6 # [IF ONLY 1 IT MEANS NOTHING FOLLOWS 889Q # [CONTEXT CHAR SO A NULL STR RETURNED 88PB BRN XLOAD1A 8992 XGETCON4 89NL SBN 6 1 [MORE THAN 2 STRS? 8=8= BNZ 6 XGETCON5 [J IF Y 8=MW LDN 6 2 8?7G SPARANOX 6 [PASS LAST STR 8?M6 HUNT 3,CPB,CUNI 8#6Q LDN 7 APARA+1 8#LB BRN XLOAD1 8*62 XGETCON5 8*KL # [IF > 2 STRS PRODUCED 8B5= # [ALL EXCEPT 1ST SHOULD BE PASSED 8BJW SPARAPAS 8C4G HUNT 3,CPB,CUNI [1ST STR FROM CMULTI 8CJ6 LDX 4 7 [SAVE SPLITTER 8D3Q LDX 7 ANUM(3) 8DHB ANDN 7 #7777 [NO. OF CHARS.IN 1ST STR 8F32 PARATYPE 6 [GET PARAM TYPE OF STR 8FGL # [SPLIT BY PARALYSE AFTER XGETCON3 8G2= MFREE CPB,CUNI 8GFW MFREE CPB,CMULTI 8G^G HUNT 3,CPB,CUNI [CUNI CONTAINING WHOLE STR 8HF6 SBN 6 2 8HYQ BNZ 6 XGETCON6 8JDB # 8JY2 # IF COMPOSITE WANT TO IGNORE BRACKET 8KCL ADN 7 1 8KX= XGETCON6 8LBW LDX 0 3 [SAVE CUNI ADDR 8LWG LDX 5 7 [COPY NUMERIC CHAR CT 8MB6 SRC 5 2 [BUILD CHAR MOD 8MTQ ADX 3 5 8N*B XGTCN6B 8NT2 LDCH 6 APARA(3) 8P#L SBX 6 4 8PS= ADN 7 1 8Q?W BZE 6 XGTCN6A [JUMP OUT IF SPLITTER 8QRG BCHX 3 £ 8R?6 BRN XGTCN6B 8RQQ XGTCN6A 8S=B # 8SQ2 # NOW X7 CAN LOCATE STRING AFTER 1ST SPLITTER 8T9L LDX 3 0 [RESTORE CUNI ADDR 8TP= SBS 7 ANUM(3) [DECREASE COUNT IN COMDAT 8W8W SRC 7 2 8WNG ADN 7 APARA+1 8X86 BRN XLOAD1 8XMQ XGETRZ [THIS IS WHERE WE COME FOR (N1,N2) PA 8Y7B TXL 4 7 [N1> NO OF CHRS IN BL? 8YM2 BCC XNALL 8^6L LDN 4 0 [N 8^L= BRN ZALLM 925W XNALL 92KG TXL 6 7 [N2<N1? 9356 BCS XERR 93JQ XGETA 944B TXL 4 6 94J2 BCC XGET 953L LDX 6 4 [N2>NO OF CHARS.NOT AN ERROR NOW 95H= XGET 962W SBS 7 6 [6=N1-N2 96GG ADN 6 1 [COUNT OF CHARS IN 'NEW' PARAMETER 9726 SBN 7 1 97FQ SRC 7 2 [ADDRESS OF 1ST CHAR IN 7 97^B BRN XKILL 98F2 ZALLM 98YL LDX 6 4 [CHARACTER COUNT IN 6 99D= BZE 6 XLOAD1A [BRN IF NULL PARAMETER 99XW # 9=CG # ELIMINATE LEADING AND TRAILING SPACES FROM 'NEW' PARAMETER 9=X6 # 9?BQ XKILL 9?WB STO 3 AWORK2(2) [STORE ADDR OF CUNI 9#B2 ADX 3 7 9#TL ADN 3 A1+3 [X3 IS NOW ABSOLUTE POINTER TO 1ST CH 9**= LDN 0 0 9*SW STO 1 AWORK1(2) 9B#G LDX 1 FX1 9BS6 TSP 9C?Q LDCH 4 0(3) [GET A CHARACTER FROM PARAMETER 9CRB TXU 4 SPACE(1) 9D?2 BCS ONGO [BRN IF NO MORE LEADING SPACES 9DQL BCHX 3 £ 9F== BCT 6 TSP [BRN IF CHARACTER COUNT NOT EXHAUSTED 9FPW BRN XLOAD2 [NULL PARAMETER 9G9G ONGO 9GP6 LDX 5 6 [ADJUSTED CHARACTER COUNT 9H8Q SBN 5 1 9HNB STO 3 7 9J82 SBX 7 AWORK2(2) 9JML BZE 5 XLOAD2 [J IF SINGLE CHARACTER 9K7= TNC 9KLW BCHX 3 £ [POINTER TO NEXT CHARACTER 9L6G LDCH 4 0(3) [GET NEXT CHARACTER 9LL6 TXU 4 SPACE(1) 9M5Q BCS NTAA [NO TROUBLE AT ALL IF NOT SPACE 9MKB ADN 0 1 [SPACE COUNT 9N52 BCT 5 TNC [BRN IF CHARACTER COUNT NOT EXHAUSTED 9NJL SBX 6 0 [REDUCE CHARACTER COUNT BY 1 PER SPAC 9P4= BRN XLOAD2 9PHW NTAA 9Q3G LDN 0 0 [ZEROISE SPACE COUNT FOR NON SPACE CH 9QH6 BCT 5 TNC [BRN IF CHARACTER COUNT NOT EXHAUSTED 9R2Q XLOAD2 9RGB LDX 3 AWORK2(2) 9S22 BRN XLOAD1A 9SFL XLOAD1 9S^= LDX 6 ANUM(3) 9TDW ANDN 6 #7777 [CHAR COUNT 9TYG XLOAD1A 9WD6 LDX 5 6 [CHARACTER COUNT IN X5 9WXQ ADN 5 11 [8 FOR RED TAPE,3 TO ROUND DIVISION 9XCB SRL 5 2 [NO OF WORDS NEEDED 9XX2 PHOTO 4 9YBL GETCORE 5,1 9YW= FINDCORE 2 9^*W NAME 2,COMDAT,CSETP [CREATE COMDAT,CSETP 9^TG BNZ 6 ON [BRN IF NOT NULL PARAMETER =2*6 STOZ ANUM(2) [SET NULL PARAMETER =2SQ BRN XCROSS =3#B ON =3S2 XAPAR =4?L MHUNT 3,CPB,CUNI =4R= SBN 3 1 =5=W MLOAD =5QG LDX 4 3 [IELATIVISED DATUM =6=6 ADX 4 7 [ADDRESS OF 1ST CHAR REQUIRED =6PQ LDN 5 A1+2(2) [START ADDRESS IN COMDAT,CSETP =79B SMO 6 [CHARACTER COUNT =7P2 MVCH 4 0 ['NEW' PARAMETER IN COMDAT,CSETP =88L STO 6 A1+1(2) [CHARACTER COUNT IN =8N= # =97W # ROUTINE TO DETERMINE PARAMETER TYPE =9MG # ==76 LDX 3 2 ==LQ PTYPE =?6B PTYPE COMDAT,CSETP,3,APARA,ANUM(3) =?L2 XCROSS =#5L SMO FX2 =#K= LDX 4 AWORK4 =*4W BZE 4 XC1 [J IF NOT SP EXPRESSION =*JG CALL 7 UNIF =B46 UPPLUS 1 =BHQ XC1 =C3B ACROSS SETPB,1 =CH2 # =D2L UNIF =DG= SBX 7 FX1 =D^W PARAFREE =FFG UNIFREE =F^6 LDX 2 FX2 =GDQ LDX 0 AWORK3(2) =GYB STO 0 JOBEVENTS(2) =HD2 ADX 7 FX1 =HXL EXIT 7 0 =JC= XITA =JWW LDX 2 FX2 =KBG LDX 1 FX1 =KW6 LDX 7 AWORK2(2) =L*Q BPZ 7 XITB [J IF SP PARAM =LTB MHUNT 3,COMDAT,CSETP =M*2 LDEX 7 ANUM(3) =MSL BZE 7 XERR [ZERO CHARS = ERR =N#= SBN 7 4 =NRW NGX 7 7 =P?G BNG 7 XERR [ONLY 1 TO 4 CHARS ALLOWED =PR6 LDX 4 APARA(3) [WD TO BE CONVERTED =Q=Q BZE 7 NOSH [J IF NO SHIFT REQUD =QQB MPY 7 X6(1) [CONV TO BITS TO SHIFT =R=2 SMO 0 =RPL SRL 4 0 =S9= NOSH =SNW FREECORE 3 [FREE OLD COMDAT =T8G CALL 5 XDEC =TN6 BRN XIT =W7Q XDEC =WMB SBX 5 FX1 =X72 STO 5 GEN0 =XLL SMO FX2 =Y6= LDN 2 AWORK1 [RESULT ADDRESS =YKW STOZ 0(2) =^5G STOZ 1(2) =^K6 LDN 7 1 [INITIALISE COUNT ?24Q BPZ 4 POZ [J IF RESULT NON-NEG ?2JB ADN 7 1 [ELSE UP CT FOR MINUS ?342 NGX 4 4 ?3HL BNG 4 SPECIAL [TREAT #40000000# ?43= LDX 6 MINUS(1) ?4GW DCH 6 0(2) [INSERT MINUS ?52G BCHX 2 £ [STEP PTR ?5G6 POZ ?5^Q MPY 4 MAGIC(1) [CONV TO DL FRACTION ?6FB LDN 0 7 ?6^2 MODE 0 ?7DL XCDR ?7Y= CBD 4 0(2) ?8CW LDCH 6 0(2) ?8XG BNZ 6 YOKO ?9C6 BCT 0 XCDR [DO NEXT ?9WQ BRN WEND ?=BB ONO ?=W2 BCHX 2 £ ??*L CBD 4 0(2) ??T= ADN 7 1 [UPDATE CHAR CT ?##W YOKO ?#SG BCT 0 ONO ?*#6 WEND ?*RQ LDX 4 7 ?B?B ADN 4 3 ?BR2 SRL 4 2 ?C=L BRN XITDC ?CQ= SPECIAL ?D9W LDN 1 SPEC(1) [-8388608 ?DPG MOVE 1 2 ?F96 LDN 7 8 ?FNQ LDN 4 2 ?G8B XITDC ?GN2 LDX 5 GEN0 ?H7L ADX 5 FX1 ?HM= EXIT 5 0 ?J6W XCONV ?JLG SBX 5 FX1 ?K66 CHNUMCOD 1,3 ?KKQ TESTREP CHNUMERR,XCONV1 ?L5B ADX 5 FX1 ?LK2 EXIT 5 1 [NORMAL EXIT ?M4L XCONV1 ?MJ= ADX 5 FX1 [ERROR EXIT ?N3W EXIT 5 0 ?NHG XIT ?P36 LDN 5 AWORK1 ?PGQ XITC ?Q2B ADN 4 2 ?QG2 SETUPCORE 4,3,COMDAT,CSETP [PARAM BLOCK ?Q^L STO 7 ANUM(3) ?RF= BZE 7 XITB ?RYW SMO 5 ?SDG LDN 1 0(2) ?SY6 LDN 2 APARA(3) ?TCQ SMO 7 ?TXB MVCH 1 0 ?WC2 # [INSERT PARAM ?WWL SBN 4 2 ?XB= SLL 4 2 ?XTW SBX 4 7 ?Y*G BZE 4 XITB ?YT6 LDN 1 ACES ?^#Q SMO 4 ?^SB MVCH 1 0 #2#2 XITB #2RL ... ACROSS SETPARAM,4 #3?= # #3QW PN2 #4=G FREECORE 3 #4Q6 BRN XERR2 [PARAMETER FORMAT ERROR #59Q XERR1 #5PB LDX 6 PJSETP3(1) [ 2ND PARAMETER MISSING #692 CALL 2 XOR #6NL +JPARMIS #78= XERR2 #7MW CALL 2 NGN [ PARAMETER FORMAT ERROR #87G +APFERR #8M6 XERR3 #96Q CALL 2 NGN [ NO MESSAGE #9LB +JSETP6 #=62 XERR4 #=KL CALL 2 NGN [ NO DISPLAY #?5= +JSETP5 #?JW XERR5 ##4G LDX 6 PJSETP8(1) [ 1ST PARAMETER MISSING ##J6 CALL 2 XOR #*3Q +JPARMIS #*HB XERR6 #B32 CALL 2 NGN [ NOT ALLOWED AT C.P. LEVEL 0 #BGL +JSETP2 #C2= XERR8 #CFW CALL 2 NGN #C^G +JSETP12 #DF6 XERR9 #DYQ CALL 2 NGN #FDB +ERUNPAIR #FY2 XERR12 #GCL NAME 3,CPB,CUNI #GX= XERR10 #HBW CALL 2 NGN #HWG +CHNUMERR #JB6 XERR7 #JTQ CALL 2 NGN #K*B +JSETP7 #KT2 NGN #L#L NGN 6 1 #LS= XOR #M?W LDX 7 0(2) #MRG SMO FX2 #N?6 LDX 4 AWORK4 #NQQ BZE 4 XOR1 #P=B CALL 7 UNIF #PQ2 UP #Q9L XOR1 #QP= COMERRX 7,6 #R8W # #RNG MAGIC +7036875 #S86 X6 +6 #SMQ MINUS #35 #T7B SPEC 8H-8388608 #TM2 PJSETP3 +JSETP3 #W6L PJSETP8 +JSETP8 #WL= #END ^^^^ ...160054360001