{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: SETPE867)}}
====== SETPE867 ======
(George Source)
**Macros used:** [[george:macro:ACROSS|ACROSS]], [[george:macro:CHNUMCOD|CHNUMCOD]], [[george:macro:COMBRKIN|COMBRKIN]], [[george:macro:COMERRX|COMERRX]], [[george:macro:FINDCORE|FINDCORE]], [[george:macro:FREECORE|FREECORE]], [[george:macro:GETCORE|GETCORE]], [[george:macro:HUNT|HUNT]], [[george:macro:MFREE|MFREE]], [[george:macro:MHUNT|MHUNT]], [[george:macro:NAME|NAME]], [[george:macro:ON|ON]], [[george:macro:PARAFREE|PARAFREE]], [[george:macro:PARALYSE|PARALYSE]], [[george:macro:PARALYSX|PARALYSX]], [[george:macro:PARANEXT|PARANEXT]], [[george:macro:PARANUMB|PARANUMB]], [[george:macro:PARAPASS|PARAPASS]], [[george:macro:PARATYPE|PARATYPE]], [[george:macro:PHOTO|PHOTO]], [[george:macro:PTYPE|PTYPE]], [[george:macro:SEG|SEG]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETUPCORE|SETUPCORE]], [[george:macro:SPARANOT|SPARANOT]], [[george:macro:SPARANOX|SPARANOX]], [[george:macro:SPARANXT|SPARANXT]], [[george:macro:SPARAPAS|SPARAPAS]], [[george:macro:TESTREP|TESTREP]], [[george:macro:TESTREP2|TESTREP2]], [[george:macro:UNIFREE|UNIFREE]], [[george:macro:UP|UP]], [[george:macro:UPPLUS|UPPLUS]]
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 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 [N2NO 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