{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: CHNUMCON867)}}
====== CHNUMCON867 ======
(George Source)
**Macros used:** [[george:macro:ALTLEN|ALTLEN]], [[george:macro:BXL|BXL]], [[george:macro:BXU|BXU]], [[george:macro:ERROR|ERROR]], [[george:macro:FINDCORE|FINDCORE]], [[george:macro:FREECORE|FREECORE]], [[george:macro:GEOERR|GEOERR]], [[george:macro:GETCORE|GETCORE]], [[george:macro:GETCOREN|GETCOREN]], [[george:macro:GETWORD|GETWORD]], [[george:macro:HUNT|HUNT]], [[george:macro:JANAL|JANAL]], [[george:macro:MASK|MASK]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MFREEW|MFREEW]], [[george:macro:MHUNT|MHUNT]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:NAME|NAME]], [[george:macro:OR|OR]], [[george:macro:OVER|OVER]], [[george:macro:RESET|RESET]], [[george:macro:SEG|SEG]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETREP|SETREP]], [[george:macro:TESTREP2|TESTREP2]], [[george:macro:TESTREPNOT|TESTREPNOT]], [[george:macro:TRACE|TRACE]], [[george:macro:UP|UP]], [[george:macro:UPPLUS|UPPLUS]], [[george:macro:VFREEW|VFREEW]], [[george:macro:WORDFIN|WORDFIN]]
22FL #OPT K0CHNUMCON=0
22^= #LIS K0CHNUMCON>K0ALLGEO>K0GREATGEO>K0UTILITY
235Y ... SEG CHNUMCON,867,SECTION CENT,,G250
23=L ...[
23C# ...[ (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD 1982
23J2 ...[ THIS EXCLUDES CODE UNDER #SKI G250
23NN ...[
23TB ...#OPT G250 = 0
2424 ...#SKI G250&1
246Q ...# WITH G3UG EDIT M250 (ADDITIONAL NUMBER FORMATS)
24?D ...# THIS MEND IS ALSO USED BY INSTALLATION HOOKS
24D6 #
24XQ # THIS ROUTINE EVALUATES A NUMERICAL EXPRESSION OR SERIES OF SUCH
25CB # EXPRESSIONS SEPARATED BY COMMAS : THE RESULT IS IN BINARY
25X2 # ENTRY POINTS
26BL SEGENTRY K1CHNUMCON,ZEP1 [CHNUMCON MACRO WHEN ERROR MESS REQD
26W= SEGENTRY K11CHNUMCON,ZEP11 [ SAME WITH BREAK-IN INHIBITED
27*W SEGENTRY K3CHNUMCON,ZEP3 [CHNUMCON MACRO WHEN NO ERR MESS REQD
27TG SEGENTRY K31CHNUMCON,ZEP31 [ SAME WITH BREAK-IN INHIBITED
28*6 SEGENTRY K4CHNUMCON,ZEP4 [CHNUMCO1 MACRO WHEN ERROR MESS REQD
28SQ SEGENTRY K41CHNUMCON,ZEP41 [ SAME WITH BREAK-IN INHIBITED
29#B SEGENTRY K5CHNUMCON,ZEP5 [CHNUMCO1 MACRO WHEN NO ERR MESS REQD
29S2 SEGENTRY K51CHNUMCON,ZEP51 [ SAME WITH BREAK-IN INHIBITED
2=?L #
2=R= [THIS ROUTINE LOOKS FOR THE INPUT BLOCK ,TYPE CPB,CUNI ,CHECKS FOR NO
2?=W [OR NULL PARAMETER,AND SCANS THE INPUT STRING FOR COMMAS.
2?QG #DEF Z=A1+8
2#=6 OCT +8
2#PQ SCOMMA #34
2#WY P8388608
2*46 8H8388608 [PRESET IN CASE -8388608
2*9B SMA #17777777
2*P2 STRING
2B8L 4H0(+-
2BN= #FID 0 5 #73
2BS7 ...#SKI G250&1$1
2BY4 22H*/><$^&])#,0123456789K
2C7W ...#SKI G250&1
2CCN ... 23H*/><$^&])#@,0123456789K[ @ IS HEXADECIMAL SIGN
2CMG # ENTRY POINTS TO INHIBIT BREAKIN
2D76 ZEP51
2DLQ CALL 7 XFIDDLE
2F6B BRN NUMCON5
2FL2 ZEP41
2G5L CALL 7 XFIDDLE
2GK= BRN NUMCON4
2H4W ZEP31
2HJG CALL 7 XFIDDLE
2J46 BRN NUMCON3
2JHQ ZEP11
2K3B CALL 7 XFIDDLE
2KH2 BRN NUMCON1
2L2L #
2LG= # ROUTINE FOR FIDDLING JOBEVENTS
2L^W #
2MFG XFIDDLE
2M^6 LDX 0 JOBEVENTS(2)
2NDQ STO 0 AWORK3(2) [REMEMBER OLD CONTENTS
2NYB LDCT 0 #40
2PD2 STO 0 JOBEVENTS(2) [INHIBIT BREAKIN
2PXL STO 0 AWORK4(2) [INDICATE FIDDLE
2QC= EXIT 7 0
2QWW ZEP5
2RBG STOZ AWORK4(2)
2RW6 NUMCON5
2S*Q STOZ AWORK2(2) [SHOW NO ERROR MESSAGE REQUIRED
2STB BRN ROUTT
2T*2 ZEP4
2TSL STOZ AWORK4(2)
2W#= NUMCON4
2WRW LDN 3 1
2X?G STO 3 AWORK2(2) [SHOW ERROR MESSAGE REQUIRED
2XR6 ROUTT
2Y=Q HUNT 3,CPB,CUNI
2YQB BNG 3 UPERR1
2^=2 NGX 4 ANUM(3)
2^PL BPZ 4 UPERR1
329= STO 4 AWORK1(2) [FLAG INDICATING RESULT OF CONVERTION
32NW [ TO GO TO ACOMMUNE1
338G BRN XSTABL
33N6 ZEP3
347Q STOZ AWORK4(2)
34MB NUMCON3
3572 STOZ AWORK2(2) [SHOW NO ERROR MESSAGE REQUIRED
35LL BRN ROUTS
366= ZEP1
36KW STOZ AWORK4(2)
375G NUMCON1
37K6 #SKIP K6CHNUMCON>399-399
384Q TRACE 1,CHNUMCON
38JB LDN 3 1
3942 STO 3 AWORK2(2) [SHOW ERROR MESSAGE REQUIRED
39HL ROUTS
3=3= HUNT 3,CPB,CUNI [HUNT FOR UNIBLOCK
3=GW BNG 3 UPERR1 [ERROR NOT PRESENT
3?2G STOZ AWORK1(2) [FLAG INDICATING RESULT OF CONVERTION
3?G6 [ TO GO TO GNUMCON BLOCK
3?^Q LDX 4 ANUM(3) [PAR TYPE INTO X4
3#FB BNG 4 UPERR1 [ERROR NO PARAMETER
3#^2 BZE 4 UPERR1 [ERROR NULL PARAMETER
3*DL ANDN 4 #7777 [NUMBER OF CHARACTERS IN X4
3*Y= LDX 2 3 [POINTER TO PAR BLOCK INTO X2
3BCW LDN 7 0 [ZEROISE COMMA COUNT IN X7
3BXG NYCH LDCH 5 APARA(2) [CHAR INTO X5
3CC6 TXU 5 SCOMMA(1) [TEST IF COMMA
3CWQ BCS NXCH [IF NOT,EXAMINE NEXT CHAR
3DBB ADN 7 1 [IF COMMA,ADD 1 TO COMMA COUNT
3DW2 NXCH BCHX 2 £ [STEP POINTER
3F*L SBN 4 1 [REDUCE CHAR COUNT
3FT= BNZ 4 NYCH [IF ANOTHER CHAR,J TO TEST IT
3G#W [SET UP OUTPUT BLOCK
3GSG ADN 7 2
3H#6 GETCORE 7,1
3HRQ FINDCORE 2
3J?B NAME 2,CPAR,GNUMCON
3JR2 STOZ A1(2) [SET PARAMETER COUNT ZERO
3K=L [SET UP STACK BLOCK
3KQ= XSTABL
3L9W GETCOREN 20,1 [GET AND NAME BLOCK FOR STACKS
3LPG FINDCORE 3
3M96 NAME 3,CPAR,GSTACK
3MNQ MHUNT 2,CPB,CUNI
3N8B STO 2 A1+1(3)
3NN2 LDX 4 ANUM(2)
3P7L ANDN 4 #7777
3PM= RESET
3Q6W STO 4 A1+2(3) [COUNT OF CHARACTERS INTO A1+2
3QLG STOZ A1+3(3) [SET SWITCH S ZERO
3R66 STOZ A1+4(3) [SET SB COUNT ZERO
3RKQ STOZ A1+5(3) [SET CB COUNT ZERO
3S5B STOZ Z(3) [SET FIRST PAR ZERO
3SK2 LDN 5 11
3T4L STO 5 A1+6(3) [SET POINTER TO OPERATOR STACK
3TJ= STOZ Z+11(3) [SET FIRST OPERATOR ZERO
3W3W NGN 5 1
3WHG STO 5 A1+7(3) [SET POINTER TO PAR STACK=-1
3X36 POINTA [TEST IF ANY MORE CHARACTERS
3XGQ #SKIP K6CHNUMCON>599-599
3Y2B TRACE A1+2(3),POINTA
3YG2 LDX 4 A1+2(3)
3Y^L BNZ 4 TECH [IF MORE J TO READ NEXT CHARACTER
3^F= #SKIP K6CHNUMCON>599-599
3^YW TRACE A1+6(3),OFF
42DG CALL 0 STACKCLEAR [CLEAR STACK AND STORE RESULT
42Y6 UPOUT
43CQ SETREP OK
43XB FREECORE 3
44C2 BRN UP
44WL TERM
45B= #SKIP K6CHNUMCON>599-599
45TW TRACE 7,TERM
46*G CALL 0 STACKCLEAR
46T6 BRN RESET
47#Q TECH
47SB LDCH 6 APARA(2) [CHARACTER INTO X6
4848 LDX 5 2 [KEEP POINTER FOR -8388608 POSSIBILIT
48#2 BCHX 2 £ [STEP POINTER
48RL LDN 7 1
49?= SBS 7 A1+2(3) [REDUCE CHAR COUNT
49QW LDN 7 0 [SET COUNT IN X7 ZERO
49WR ...#SKI G250&1$1
4=2N LDN 4 27
4==G ...#SKI G250&1
4=G# ... LDN 4 28
4=Q6 NECH LDCH 0 STRING(1) [LOAD CHAR FOR COMPARISON INTO X5
4?9Q BCHX 1 £ [STEP POINTER
4?PB TXU 0 6 [TEST IF SAME CHARS
4#92 BCC REBR [IF SO,J TO SELECT APPROPRIATE ROUTIN
4#NL ADN 7 1 [STEP COUNT
4*8= TXL 7 4 [IF NOT A LEGAL CHARACTER
4*MW BCC UPERR [J FOR ERROR
4B7G BRN NECH
4BM6 REBR LDX 1 FX1
4C6Q BZE 7 SBRAC [J FOR LEFT BRACKET
4CLB #SKIP K6CHNUMCON>599-599
4D62 TRACE 7,REBR
4DKL SBN 7 1
4F5= BZE 7 SPAR [J FOR LEFT PARENTHESIS
4FJW SBN 7 10
4G4G BNG 7 SOP [J FOR OPERATOR
4GJ6 BZE 7 RBRAC [J FOR RIGHT BRACKET
4H3Q SBN 7 1
4HHB BZE 7 RPAR [J FOR RIGHT PARENTHESIS
4J32 SBN 7 1
4JGL BZE 7 OCTAL [J FOR HASH SIGN
4JK9 ...#SKI G250&1
4JMS ...(
4JQC ... SBN 7 1
4JT2 ... BZE 7 XHEX
4JXK ...)
4K2= SBN 7 1
4KFW BZE 7 TERM [J FOR COMMA
4K^G SBN 7 11
4LF6 BNG 7 NUM [J FOR DIGIT
4LRG BZE 7 SKOP [J FOR K
4LYQ BRN UPERR [J FOR ERROR OTHERWISE
4MDB [ROUTINE TO STACK AWAY LEFT BRACKET
4MY2 SBRAC LDX 4 A1+3(3) [S INTO X4
4NCL #SKIP K6CHNUMCON>599-599
4NX= TRACE 4,SBRAC
4PBW BNZ 4 UPERR [ERROR S SET
4PWG LDN 4 1
4QB6 ADS 4 A1+4(3) [ADD 1 TO SQ BRAC COUNT
4QTQ LDN 7 1
4R*B CALL 0 OSTACK [STACK [
4RT2 BRN POINTA
4S#L [THIS ROUTINE STACKS AWAY LEFT PARENTHESIS
4SS= SPAR LDX 4 A1+3(3) [S INTO X4
4T?W #SKIP K6CHNUMCON>599-599
4TRG TRACE 4,SPAR
4W?6 BNZ 4 UPERR [ERROR S SET
4WQQ LDN 4 1
4X=B ADS 4 A1+5(3) [ADD 1 TO PARENTHESIS COUNT
4XQ2 LDN 7 2
4Y9L CALL 0 OSTACK [STACK C
4YP= BRN POINTA [J FOR NEXT CHARACTER
4^8W [THIS ROUTINE STACKS OPERATORS , CHECKING THEIR PRIORITY
4^NG SOP ADN 7 12 [PRIORITY INTO X7
5286 #SKIP K6CHNUMCON>599-599
52MQ TRACE 7,SOP
537B LDX 4 A1+3(3)
53M2 BZE 4 UNARY [ERROR S UNSET
546L STOZ A1+3(3) [ UNSET S
54L= PARD SMO A1+6(3)
555W LDX 6 Z(3)
55KG TXL 6 7 [COMPARE PRIORITIES
5656 BCS UNEFF [IF MORE POWERFUL,PUT ON STACK
56JQ CALL 0 OEFF [IF NOT,EFFECT TOP OF STACK
574B BRN PARD [AND TRY AGAIN
57J2 UNEFF CALL 0 OSTACK
583L BRN POINTA [J FOR NEXT CHAR
58H= UNARY SBN 7 3
592W BZE 7 POINTA [BRANCH IF + FOR NEXT CHAR
59GG SBN 7 1
5=26 BNZ 7 UPERR [IF NOT + OR -,ERROR
5=FQ LDN 7 12
5=^B CALL 0 OSTACK [IF,STACK UNARY
5?F2 BRN POINTA [J FOR NEXT CHARACTER
5?H* [ THIS ROUTINE DEALS WITH THE SPECIAL 'K' OPERATOR.
5?J6 [ IT STACKS THE '*' OPERATOR THEN JUMPS INTO 'NUM'
5?JX [ AND STACKS 1024
5?KN SKOP LDN 7 5
5?LF LDX 4 A1+3(3)
5?M= BZE 4 UNARY [ERROR S UNSET
5?N3 STOZ A1+3(3) [UNSET S
5?NS SKOP2 SMO A1+6(3)
5?PK LDX 6 Z(3)
5?QB BXL 6 7,SKOP4 [J IF MORE POWERFUL OPERATOR
5?R7 CALL 0 OEFF [ELSE EFFECT TOP OF STACK
5?RY BRN SKOP2 [AND TRY AGAIN
5?SP SKOP4 CALL 0 OSTACK
5?TG LDN 6 0
5?W? LDN 7 1024
5?X4 BRN ND2 [PUT 1024 IN STACK
5?YL [THIS ROUTINE DEALS WITH RIGHT BRACKETS
5#D= RBRAC LDX 7 A1+3(3) [S INTO X7
5#XW #SKIP K6CHNUMCON>599-599
5*CG TRACE 7,RBRAC
5*X6 BZE 7 UPERR [ERROR S UNSET
5BBQ LDX 7 A1+4(3) [SQ BRAC COUNT INTO X4
5BWB SBN 7 1 [REDUCE BY ONE
5CB2 BNG 7 UPERR [ERROR SQ BRAC COUNT NEGATIVE
5CTL STO 7 A1+4(3) [STORE AWAY UPDATED COUNT
5D*= PARC SMO A1+6(3)
5DSW LDX 7 Z(3) [TOP OF OSTACK INTO X4
5F#G BZE 7 UPERR [ERROR IF END OF OSTACK
5FS6 SBN 7 1
5G?Q BZE 7 SLOC [J TO EFFECT IF LEFT BRACKET
5GRB SBN 7 1
5H?2 BZE 7 UPERR [ERROR IF LEFT PARENTHESIS
5HQL ADN 7 2
5J== LDX 6 7
5JPW CALL 0 OEFF [OTHERWISE EFFECT OPERATOR
5K9G BRN PARC [AND J TO TEST NEXT
5KP6 [THIS ROUTINE DEALS WITH RIGHT PARENTHESIS
5L8Q RPAR LDX 7 A1+3(3) [S INTO X7
5LNB #SKIP K6CHNUMCON>599-599
5M82 TRACE 7,RPAR
5MML BZE 7 UPERR [ERROR S UNSET
5N7= LDX 7 A1+5(3) [CB COUNT INTO X7
5NLW SBN 7 1 [REDUCE BY 1
5P6G BNG 7 UPERR [ERROR CB COUNT NEGATIVE
5PL6 STO 7 A1+5(3) [STORE NEW COUNT
5Q5Q PARB SMO A1+6(3)
5QKB LDX 7 Z(3) [TOP OPERATOR INTO X4
5R52 BZE 7 UPERR [ERROR IF END OF STACK
5RJL SBN 7 1
5S4= BZE 7 UPERR [ERROR IF LEFT BRACKET
5SHW SBN 7 1
5T3G BNZ 7 PARK [TEST IF LEFT PARENTHESIS
5TH6 LDN 7 1
5W2Q ADS 7 A1+6(3) [YES-UPDATE POINTER TO OSTACK
5WGB BRN POINTA [AND J FOR NEXT CHAR
5X22 PARK ADN 7 2
5XFL LDX 6 7
5X^= CALL 0 OEFF [NO-EFFECT OPERATOR
5YDW BRN PARB
5YF7 ...[
5YFD ...[
5YFP ...#SKI G250&1
5YG2 ...(
5YG? ...# HEXADECIMAL PRECEDED BY @ SIGN
5YGJ ...XTEN +10
5YGT ...XSIX +6
5YH6 ...#
5YHC ...XHEX LDX 4 A1+2(3)
5YHN ...#SKIP K6CHNUMCON>599-599
5YH^ ... TRACE 4,XHEX [ WHEN IN ROME, ...
5YJ= ... BZE 4 UPERR
5YJH ... LDN 5 6
5YJS ... LDN 7 0
5YK5 ...XHEX1 LDCH 6 APARA(2)
5YKB ... TXL 6 XTEN(1)
5YKM ... BCS XHEX2 [ ACCEPT 0-9
5YKY ... SBN 6 #41
5YL9 ... TXL 6 XSIX(1) [ ACCEPT A-F
5YLG ... BCC XHEX3 [ TERMINATOR
5YLR ... ADN 6 10 [ CORRECT DIGIT VALUE
5YM4 ...XHEX2 SLL 7 4
5YM* ... ORX 7 6
5YML ... SBN 5 1
5YMX ... BNG 5 UPERR
5YN8 ... BCHX 2 £
5YNF ... BCT 4 XHEX1
5YNQ ...XHEX3 TXU 5 XSIX(1)
5YP3 ... BCC UPERR [ NO DIGITS
5YP# ... BRN ND [ STACK NUMBER
5YPK ...#
5YPW ...# POSSIBLE HOLLERITH
5YQ7 ...XHOLL LDCH 6 APARA(2) [ CHECK IF DECIMAL TERMINATOR
5YQD ... ERN 6 #50 [ OR HOLLERITH 'H'
5YQP ... BNZ 6 ND
5YR2 ... SMO 7
5YR? ... SBN 4 1
5YRJ ... BNG 4 UPERR
5YRT ... LDX 5 7 [ HOLLERITH CHAR COUNT
5YS6 ... SBN 7 1
5YSC ... SRL 7 2
5YSN ... BNZ 7 UPERR [ NOT 1-4 CHARS
5YS^ ...XHOL1 BCHX 2 £
5YT= ... LDCH 6 APARA(2)
5YTH ... SLL 7 6
5YTS ... ORX 7 6
5YW5 ... BCT 5 XHOL1
5YWB ... BCHX 2 £
5YWM ... BRN ND [ STORE VALUE (RIGHT-JUSTIFIED)
5YWY ...#
5YX9 ...)
5YXG ...[
5YXR ...[
5YYG [THIS ROUTINE LOOKS FOR AND CONVERTS THE OCTAL NUMBER PRECEDED BY
5^D6 [A HASH SIGN AND STORES IT ON THE PARAMETER STACK
5^XQ OCTAL LDX 4 A1+2(3)
62CB #SKIP K6CHNUMCON>599-599
62X2 TRACE 4,OCTAL
63BL BZE 4 UPERR
63W= LDN 5 8
64*W STOZ 7
64TG OC1 LDCH 6 APARA(2)
65*6 TXL 6 OCT(1)
65SQ BCC OC2
66#B SLL 7 3
66S2 ORX 7 6
67?L SBN 5 1
67R= BNG 5 UPERR
68=W BCHX 2 £
68QG BCT 4 OC1
69=6 OC2 TXL 5 OCT(1) [ERROR NO OCTAL NUMERALS
69PQ BCC UPERR
6=9B BRN ND
6=P2 [THIS ROUTINE CONVERTS DECIMALS TO BINARY
6?8L NUM LDX 4 A1+2(3)
6?DD [ -8388608 IS ALLOWED BUT HAS TO BE TESTED EXPLICITLY
6?N= #SKIP K6CHNUMCON>599-599
6#7W TRACE 4,NUM
6#MG LDX 7 6
6*76 LDN 6 0
6*LQ BZE 4 ND
6B6B ND1 CDB 6 APARA(2)
6B=? ...#SKI G250&1
6BB8 ... BCS XHOLL [ COULD BE HOLLERITH
6BG5 ...#SKI G250&1$1
6BL2 BCS ND
6C5L BCHX 2 £
6CK= BNZ 6 X8388608
6D4W BCT 4 ND1
6DJG [STACK CONVERTED PARAMETER
6F46 ND STO 4 A1+2(3)
6F?Y ND2 LDN 4 1
6G3B STO 4 A1+3(3) [SET S
6GH2 LDX 4 A1+7(3)
6H2L ADN 4 1
6HG= TXL 4 A1+6(3) [TEST IF ROOM IN BLOCK
6H^W BCS OKTS
6JFG CALL 0 XBLK
6J^6 OKTS LDN 4 1
6KDQ ADS 4 A1+7(3) [UPDATE PARAMETER POINTER
6KYB SMO A1+7(3)
6LD2 STO 7 Z(3)
6LXL BRN POINTA
6LY7 [ SPECIAL ROUTINE FOR -8388608: ONLY ALLOWED IF OPERATOR AT TOP
6LYN [ OF STACK IS MINUS.IF SO,VALUE IS SET TO #40000000,OTHERWISE ERROR
6L^9 X8388608
6L^Q LDX 2 5 [POINTER INPUT STRING
6M2? LDX 1 FX1
6M2S LDN 6 7 [CHARACTER COUNT
6M3* SPECLOOP
6M3W LDCH 0 APARA(2)
6M4C LDCH 7 P8388608(1)
6M4Y BXU 0 7,UPERR [ERROR IF UNEQUAL
6M5F BCHX 2 £
6M62 BCHX 1 £
6M6H BCT 6 SPECLOOP [DROP THRU IF MATCH
6M74 SMO A1+6(3) [NOW CHECK IF OPERATOR IS MINUS
6M7K LDX 0 Z(3) [OPERATOR AT TOP OF STACK
6M86 SBN 0 12
6M8M BNZ 0 UPERR [ERROR IF NOT NEGATIVE
6M98 LDX 0 A1+2(3)
6M9P SBN 0 6
6M== STO 0 A1+2(3) [UPDATE CHARACTER COUNT
6M=R BZE 0 SPECOK
6M?# LDCH 0 APARA(2)
6M?T SBN 0 10
6M#B BNG 0 UPERR [ERROR IF FOLLOWED BY ANOTHER DIGIT
6M#X SPECOK
6M*D LDX 7 GSIGN
6M*^ LDX 1 FX1
6MBG BRN ND2
6MC= [THIS ROUTINE STACKS AN OPERATOR ,ENLARGING THE STACK BLOCK WHERE
6MWW [NECESSARY.
6NBG OSTACK
6NW6 #SKIP K6CHNUMCON>599-599
6P*Q TRACE A1+6(3),OSTACK
6PTB LDX 5 A1+7(3) [PARAMETER POINTER
6Q*2 LDX 6 A1+6(3) [OPERATOR POINTER
6QSL ADN 5 1
6R#= TXU 5 6 [ENOUGH ROOM?
6RRW BCS OKFS [IF SO J TO STACK
6S?G SBX 0 FX1
6SR6 STO 0 A1(3) [OTHERWISE EXTEND BLOCK
6T=Q CALL 0 XBLK
6TQB LDX 0 A1(3) [RESTORE LINK
6W=2 ADX 0 FX1
6WPL OKFS LDN 4 1
6X9= SBS 4 A1+6(3) [UPDATE OPERATOR POINTER
6XNW SMO A1+6(3)
6Y8G STO 7 Z(3) [STACK OPERATOR
6YN6 EXIT 0 0 [EXIT
6^7Q XBLK SBX 0 FX1
6^MB SBX 2 A1+1(3) [RELATIVISE CHARACTER POINTER
7272 STO 0 A1+1(3)
72LL STO 2 4 [STORE CHARACTER POINTER
736= LDX 6 ALOGLEN(3)
73KW ADX 6 6
745G ALTLEN 3,6,CPAR,GSTACK
74K6 MHUNT 2,CPB,CUNI
754Q MHUNTW 3,CPAR,GSTACK
75#J ... STO 2 1
75JB ADX 2 4 [POINT TO NEXT CHAR. OF PARAMETER
7642 SMO A1+6(3)
76HL LDN 4 Z(3) [ADDRESS OF 'OLD' TOP OPERATOR
773= SRL 6 1 [OLD LENGTH OF BLOCK
77GW STO 6 0
782G SBX 6 A1+6(3)
78G6 SBN 6 Z-A1 [NUMBER OF OPERATORS SO FAR
78^Q LDX 5 4
79FB ADX 5 0 [ADDRESS OF 'NEW' TOP OPERATOR
79^2 SMO 6
7=DL MOVE 4 0 [MOVE DOWN OPERATOR STACK
7=Y= ADS 0 A1+6(3) [RESET OPERATOR POINTER
7?CW LDX 0 A1+1(3)
7?XG ADX 0 FX1 [RESTORE LINK
7#4N ... STO 1 A1+1(3)
7#9W ... LDX 1 FX1
7#C6 EXIT 0 0 [EXIT
7#WQ [SUBROUTINE TO EFFECT THE OPERATOR ON TOP OF THE OPERATOR STACK
7*BB OEFF
7*W2 LDN 5 1
7B*L ADS 5 A1+6(3)
7BT= SMO 6
7C#W TABER BVCR TABER [J FOR APPROPRIATE ROUTINE
7CSG BRN UPERR2
7D#6 BRN UPERR2
7DRQ BRN PLUS
7F?B BRN MINUS
7FR2 BRN MULT
7G=L BRN OVER
7GQ= BRN MAX
7H9W BRN MIN
7HPG BRN NOTEQ
7J96 BRN OR
7JNQ BRN MASK
7K8B BRN NEG
7KN2 PLUS
7L7L #SKIP K6CHNUMCON>599-599
7LM= TRACE 5,PLUS
7M6W CALL 4 OPSET
7MLG ADX 5 6
7N66 BRN SWAY
7NKQ MINUS
7P5B #SKIP K6CHNUMCON>599-599
7PK2 TRACE 5,MINUS
7Q4L CALL 4 OPSET
7QJ= SBX 5 6
7R3W BRN SWAY
7RHG MULT
7S36 #SKIP K6CHNUMCON>599-599
7SGQ TRACE 5,MULT
7T2B CALL 4 OPSET
7TG2 BVCR £
7T^L MPY 5 6
7WF= BVSR UPERR
7WYW BZE 5 OKAY
7XDG ADN 5 1
7XY6 BNZ 5 UPERR
7YCQ LDCT 5 256
7YXB ORS 5 6
7^C2 OKAY LDX 5 6
7^WL BRN SWAY
82B= OVER
82TW #SKIP K6CHNUMCON>599-599
83*G TRACE 5,OVER
83T6 CALL 4 OPSET
84#Q DVS 4 6
84SB BVSR UPERR
85#2 BRN SWAY
85RL MIN
86?= #SKIP K6CHNUMCON>599-599
86QW TRACE 5,MIN
87=G CALL 4 OPSET
87Q6 TXL 5 6
889Q BCS SWAY
88PB LDX 5 6
8992 BRN SWAY
89NL MAX
8=8= #SKIP K6CHNUMCON>599-599
8=MW TRACE 5,MAX
8?7G CALL 4 OPSET
8?M6 TXL 6 5
8#6Q BCS SWAY
8#LB LDX 5 6
8*62 BRN SWAY
8*KL NOTEQ
8B5= #SKIP K6CHNUMCON>599-599
8BJW TRACE 5,NOTEQ
8C4G CALL 4 OPSET
8CJ6 ERX 5 6
8D3Q BRN SWAY
8DHB OR
8F32 #SKIP K6CHNUMCON>599-599
8FGL TRACE 5,OR
8G2= CALL 4 OPSET
8GFW ORX 5 6
8G^G BRN SWAY
8HF6 MASK
8HYQ #SKIP K6CHNUMCON>599-599
8JDB TRACE 5,MASK
8JY2 CALL 4 OPSET
8KCL ANDX 5 6
8KX= BRN SWAY
8LBW NEG
8LWG #SKIP K6CHNUMCON>599-599
8MB6 TRACE 5,NEG
8MTQ SMO A1+7(3)
8N*B LDX 5 Z(3)
8NT2 SMO A1+7(3)
8P#L NGS 5 Z(3)
8PS= EXIT 0 0
8Q?W OPSET
8QRG LDX 5 A1+7(3)
8R?6 #SKIP K6CHNUMCON>599-599
8RQQ TRACE 5,OPSET
8S=B SBN 5 1
8SQ2 BNG 5 UPERR
8T9L STO 5 A1+7(3)
8TP= SMO A1+7(3)
8W8W LDX 5 Z(3)
8WNG SMO A1+7(3)
8X86 LDX 6 Z+1(3)
8XMQ EXIT 4 0
8Y7B SWAY
8YC8 BVS UPERR [J IF OVERFLOW
8YM2 SMO A1+7(3)
8^6L STO 5 Z(3)
8^L= EXIT 0 0
925W [CLEAR STACK AND STORE RESULT
92KG STACKCLEAR
9356 #SKIP K6CHNUMCON>599-599
93JQ TRACE A1+7(3),CLEAR
944B LDX 4 A1+3(3) [ S SET ?
94J2 BZE 4 UPERR
953L LDX 4 A1+4(3) [SB COUNT ZERO ?
95H= BNZ 4 UPERR
962W LDX 4 A1+5(3) [CB COUNT
96GG BNZ 4 UPERR
9726 SBX 0 FX1
97FQ STO 0 A1(3) [DEPOSIT LINK
97^B SEEP SMO A1+6(3)
98F2 LDX 6 Z(3)
98YL BZE 6 STOPAR
99D= CALL 0 OEFF
99XW BRN SEEP
9=CG STOPAR
9=X6 #SKIP K6CHNUMCON>599-599
9?BQ TRACE A1+7(3),STOPAR
9?WB LDX 4 A1+7(3)
9#B2 BNZ 4 UPERR
9#TL LDX 5 2
9**= LDX 2 FX2
9*SW LDX 4 AWORK1(2)
9B#G BZE 4 XHBL [J IF CHNUMCON MACRO - NOT CHNUMCO1
9BS6 LDX 4 Z(3)
9C?Q STO 4 ACOMMUNE1(2)
9CRB BRN UPOUT
9D?2 XHBL
9DQL MHUNTW 2,CPAR,GNUMCON
9F== LDN 4 1
9FPW ADS 4 A1(2)
9G9G LDX 4 Z(3)
9GP6 SMO A1(2)
9H8Q STO 4 A1(2)
9HNB #SKI K6CHNUMCON>499-499
9J82 TRACE 4,CHNUMBER
9JML LDX 4 A1+2(3)
9K7= LDX 2 5
9KLW LDX 0 A1(3)
9L6G ADX 0 FX1
9LL6 EXIT 0 0
9M5Q SLOC
9MKB #SKIP K6CHNUMCON>599-599
9N52 TRACE A1+7(3),SLOC
9NJL SMO A1+7(3)
9P4= LDX 6 Z(3) [WORD TO BE LOCATED
9PHW GETWORD 6,6,READ,,,ZBRK [GEQ ADDR OF O/P WORD INTO X6
9Q3G TESTREP2 LOADERR,UPERRC
9QH6 TESTREPNOT NOCORE,XNEXT
9QQY JANAL UPERRC [J IF STILL PROCESSING COMMAND
9R2Q ERROR GWERNO
9RGB BRN UPERRC
9S22 XNEXT TESTREPNOT RESVIOL,XOK
9S9S JANAL X237 [J IF STILL PROCESSING COMMAND
9SFL ERROR GWERRES
9S^= BRN X237
9TDW XOK
9TYG SMO 6
9WD6 LDX 6 0
9WXQ WORDFIN [TIDY UP OBJ PROG
9XCB MHUNT 2,CPB,CUNI
9XX2 MHUNTW 3,CPAR,GSTACK
9YBL STO 2 A1+1(3)
9YW= LDX 4 ANUM(2) [TOTAL NR OF CHARS TO BE CONVERTED
9^*W ANDN 4 #7777
9^TG SBX 4 A1+2(3) [SUBTRACT NR LEFT
=2*6 SRC 4 2
=2SQ ADX 2 4 [POINTS TO NEXT CHAR
=3#B LDX 4 A1+2(3) [RELOAD NR LEFT
=3S2 SMO A1+7(3)
=4?L STO 6 Z(3) [STORE VALUE
=4R= LDN 6 1
=5=W ADS 6 A1+6(3) [UPDATE POINTER TO OPERATOR
=5QG BRN POINTA
=6=6 X237 WORDFIN [TIDY UP OBJ. PROG.
=6PQ BRN UPERRC
=79B UPERR
=7P2 SMO FX2
=88L LDX 4 AWORK2
=8N= BZE 4 UPERRC [J IF NO ERROR MESSAGE REQD.
=8Y4 JANAL UPERRC [J IF STILL PROCESSING COMMAND
=97W ERROR CHNUMERR [OUTPUT ERROR MESSAGE
=9MG UPERRC SETREP CHNUMERR [SET ERROR REPLY
==76 MFREEW CPAR,GSTACK
==LQ VFREEW CPAR,GNUMCON
=?6B UP
=?L2 LDX 0 AWORK4(2)
=#5L BZE 0 NOEV
=#K= LDX 0 AWORK3(2)
=*4W STO 0 JOBEVENTS(2) [RESTORE ORIGINAL CONTENTS
=*JG UP
=B46 NOEV
=BHQ UPPLUS 1
=C3B UPERR1 GEOERR 1,NOPARA
=CH2 UPERR2 GEOERR 1,CHNUMCON
=D2L ZBRK
=DG= UP
=D^W MENDAREA 20
=FFG #END
^^^^ ...25315213000300000000