(George Source)
Macros used: ALTLEN, BXL, BXU, ERROR, FINDCORE, FREECORE, GEOERR, GETCORE, GETCOREN, GETWORD, HUNT, JANAL, MASK, MENDAREA, MFREEW, MHUNT, MHUNTW, NAME, OR, OVER, RESET, SEG, SEGENTRY, SETREP, TESTREP2, TESTREPNOT, TRACE, UP, UPPLUS, VFREEW, 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