{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: GOTO867)}} ====== GOTO867 ====== (George Source) **Macros used:** [[george:macro:ACROSS|ACROSS]], [[george:macro:ALTLENG|ALTLENG]], [[george:macro:BACKSPACE|BACKSPACE]], [[george:macro:BXE|BXE]], [[george:macro:BXL|BXL]], [[george:macro:CHAIN|CHAIN]], [[george:macro:CLEANUP|CLEANUP]], [[george:macro:CLEANX|CLEANX]], [[george:macro:COMERRX|COMERRX]], [[george:macro:ENDCOM|ENDCOM]], [[george:macro:ENDREC|ENDREC]], [[george:macro:FREECORE|FREECORE]], [[george:macro:GEOERR|GEOERR]], [[george:macro:HUNT|HUNT]], [[george:macro:HUNT2|HUNT2]], [[george:macro:HUNT2J|HUNT2J]], [[george:macro:HUNT2OPT|HUNT2OPT]], [[george:macro:HUNTC|HUNTC]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MHUNT|MHUNT]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:MONOUT|MONOUT]], [[george:macro:OUTEXES|OUTEXES]], [[george:macro:OUTPAR|OUTPAR]], [[george:macro:PARABEG|PARABEG]], [[george:macro:PARANUMB|PARANUMB]], [[george:macro:PARAPASS|PARAPASS]], [[george:macro:REWIND|REWIND]], [[george:macro:SEG|SEG]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:SPARANXT|SPARANXT]], [[george:macro:SPARAPAS|SPARAPAS]], [[george:macro:STEP|STEP]], [[george:macro:TAB|TAB]], [[george:macro:TESTHKN|TESTHKN]], [[george:macro:TESTREP|TESTREP]], [[george:macro:TRACE|TRACE]], [[george:macro:UP|UP]] 226R ... SEG GOTO,,CENT(COMMAND PROCESSOR),,G261,G286,G400 22?J ...[ 22D* ...[ (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD 1982 22K6 ...[ THIS EXCLUDES CODE UNDER #SKI G261 22PX ...[ AND UNDER #SKI G286 22WN ...[ 233F ...#OPT G261 = 0 238= ...#SKI G261&1 23*3 ...# WITH UGUG EDIT M261 (BACK PARAMETER IN GOTO) 23FS ...#OPT G286 = 0 23LK ...#SKI G286&1 23RB ...# WITH UGUG EDIT M286 (MULTI-COMMAND LINES) 23T4 ...#UNS G400 23WQ ...# THIS CHAPTER IS MODIFIED FOR G3PLUS-IH MK2 23YG [ THE ENTRY POINTS 24D6 [ THESE ENTRY POINTS MUST BE KEPT FIXED WITHIN THE SEGMENT 24XQ SEGENTRY K1GOTO,QENTRY1 25CB SEGENTRY K2GOTO,QENTRY2 25X2 SEGENTRY K3GOTO,QENTRY3 26BL SEGENTRY K4GOTO,QENTRY4 26LD ... SEGENTRY K30GOTO,QENTRY30 26W= [ 27*W [ 27TG [ THIS SEGMENT CONTAINS THE ENTIRE CODING FOR THE GOTO COMMAND. 28*6 [ A SEARCH IS MADE FOR THE LABEL SPECIFIED IN THE GOTO COMMAND 28SQ [ WITHIN THE CURRENT MACRO DEFINITION FILE AND IF NOT FOUND THERE 29#B [ WITHIN ANY MACRO DEFINITION FILE AT A HIGHER LEVEL.ON FINDING 29S2 [ THE LABEL ALL COMMAND PROCESSOR LEVELS BELOW THAT AT WHICH THE 2=?L [ LABEL HAS BEEN FOUND ARE DELETED AND RETURN MADE TO THE COMMAND 2=R= [ PROCESSOR(SEGMENT COMPROB) 2?=W [ 2?QG [ THIS IS THE ENTRY PT FROM COMPROB SEGMENT WHEN A COMMAND ERROR 2#=6 [ HAS BEEN FOUND BETWEEN DELIMITERS . THE CODE AT K2GOTO IS TO SKIP 2#PQ [ TO THE STOPPER. THE SEARCH TERMINATES WHEN STOPPER IS FOUND,OR 2*9B [ WHEN A RETURN IS MADE TO A MACRO LEVEL WHICH IS NOT POSITIONED 2*P2 [ BETWEEN DELIMITERS,OR WHEN A RETURN IS MADE TO A LEVEL WHICH IS 2B8L [ NOT A MACRO LEVEL 2BN= [ 2C7W QENTRY2 2CMG LDN 4 1 2D76 STO 4 AWORK1(2) [SET MKR. FOR C.P. ENTRY 2DLQ MONOUT JSTOPER [ JUMP TO STOPPER MESSAGE 2F6B BRN SKIPSTOP 2FL2 [ 2G5L QENTRY1 2GK= LDX 4 GSIGN 2GQD ...#SKI G261&1 2GXL ...RU1 2H4W STO 4 AWORK1(2) [SET GOTO MARKER 2HJG MHUNTW 2,CPB,CALAS 2J46 LDX 7 CPBFSD(2) 2JHQ BNG 7 NMDF [J IF NOT AN MDF 2K3B PARABEG 1,TO(1) [HUNT FOR 1ST PARAMETER 'TO' 2KH2 MHUNT 3,CPB,CUNI [HUNT FOR 1ST PARAM 'TO' 2L2L LDX 5 ANUM(3) 2LG= BPZ 5 PFOUND [J IF FOUND 2L^W PARAPASS 2MFG MHUNT 3,CPB,CUNI 2M^6 LDX 5 ANUM(3) 2NDQ BNG 5 NOPARAM [J IF NO PARAMETER. 2NYB PFOUND 2PD2 BZE 5 NOPARAM 2PXL LDCH 6 APARA(3) [LOAD FIRST CHAR OF LABEL 2QC= TXL 6 TEN(1) 2QWW BCC SWL [JUMP IF NOT DIGIT. 2QXK ...#SKI G261&1 2QY# ...( 2Q^3 ...# P.ABBOTT/P.DUEMPERT BRAUNSCHWEIG DEN 6 OKTOBER 1975 2Q^Q ...# CLEANED UP BY J. THOMASON, U.I.J.P.C., NOVEMBER 1976 2R2F ...# REWRITTEN BY R.DANN,READING UNIV,DECEMBER 77 2R38 ... PARABEG 1,UP(1),,,0 2R3X ... MHUNT 3,CPB,CUNI 2R4L ... LDX 5 ANUM(3) 2R5* ... BNG 5 NUP [ J IF NO UP PARA 2R64 ... LDCT 0 #100 [ FLAG PARAM PRESENT 2R6R ... ORS 0 AWORK1(2) 2R7G ...NUP FREECORE 3 2R89 ... PARABEG 1,ZBACK(1),,,0 2R8Y ... MHUNT 3,CPB,CUNI 2R9M ... LDX 6 ANUM(3) 2R=B ... BNG 6 ZFREE [ J IF NO BACK PARA 2R?5 ... LDCT 6 #200 [ FLAG PARAM PRESENT 2R?S ... ORS 6 AWORK1(2) 2R#H ...ZFREE FREECORE 3 2R*= ...) 2RBG SKIPSTOP 2RW6 LDX 4 CPLEV(2) 2S*Q STO 4 EXT(2) [STORE CURRENT CPL 2STB MHUNTW 2,CPB,CALAS [HUNT FOR /CALAS 2T*2 PEX 2TSL LDX 5 CPBPROGLEV(2) [LOAD PT OR CARDLIKE 2W#= SMO FX2 2WRW STO 5 EXT+2 [STORE IN ACTIVITY BLOCK 2X?G LDX 6 CPBSTART(2) 2XR6 SMO FX2 2Y=Q STO 6 EXT+1 2YQB LDX 6 CPBSTOP(2) 2^=2 SMO FX2 2^PL STO 6 EXT+7 329= LDX 6 CPBFSD(2) 32NW LDX 7 6 338G ANDN 6 #77 [ISOLATE FSD 33N6 ANDX 7 MASKFSD(1) [CLEAR FSD FROM X7 347Q LDX 1 FX2 34MB STO 7 AWORK4(1) 3572 NGS 6 AWORK3(1) 35LL ANDN 5 1 [ISOLATE DELIMITER BIT 366= LDX 6 AWORK1(1) [J IF NOT GOTO COMMAND 36KW BPZ 6 P1 375G STO 7 AWORK2(1) [RECORD STARTING POSITION 37K6 P1 BNZ 5 Y4 [J IF DELIMITER BIT SET 384Q BPZ 6 NOSTOP [ JUMP IF NOT GOTO. STOPPER MISSING 38JB LDX 2 FX2 38KF ...#SKI G261&1 38LJ ...( 38MM ... LDCT 0 #100 38NQ ... ANDX 0 AWORK1(2) 38PT ... ERS 0 AWORK1(2) 38QY ... BNZ 0 NEWLEV 38S3 ... LDCT 0 #200 [ SEE IF BACK 38T6 ... ANDX 0 AWORK1(2) 38W9 ... BZE 0 STEPFILE [ NO - GO ON AS NORMAL 38X# ... ERS 0 AWORK1(2) [ CLEAR FLAG FOR NEXT CPLEV SEARCHED 38YC ... BRN REWIND 38^G ...) 392K ...#SKI G261&1$1 3942 BRN STEPFILE 39HL P2 LDX 2 FX2 3=3= LDN 7 1 3=GW ANDX 7 EXT+2(2) [TEST DELIMITER BIT 3?2G BNZ 7 Y2A [SEARCH FOR STOPPER IF SET 3?G6 P2A LDX 2 FX2 3?^Q LDX 0 AWORK4(2) 3#FB TXU 0 AWORK2(2) 3#^2 BCC NEWLEV [J IF BACK TO START 3*DL STEPFILE 3*Y= LDX 1 AWORK3(2) 3BCW STEP 0(1) [POINTER TO NEXT RECORD 3BXG LDN 7 #100 3CC6 ADS 7 AWORK4(2) [UPDATE POSITION COUNT 3CWQ BZE 3 REWIND [J IF END OF FILE REACHED 3DBB LDX 4 0(3) 3DW2 SBN 4 2 3F*L SLL 4 2 3FT= LDX 6 1(3) 3G#W SRL 6 22 3GSG BZE 6 QV 3H#6 SBN 4 4 3HRQ ADX 4 6 3J?B QV 3JR2 LDN 0 1 3K=L STO 0 ACOMMUNE3(2) [MKER TO INDICATE LABEL SEARCH 3KQ= MHUNT 2,CPB,CUNI [FIND UNI BLOCK 3L9W LDX 0 ANUM(2) [LOAD NO OF CHARS IN PARAM 3LPG ANDN 0 #7777 3M96 ADN 3 2 3MNQ ADN 2 APARA [ADD POINTER TO FIRST CHAR 3N8B P3 CALL 7 PCON [CONVERT THE CHARACTER 3NN2 BRN P2 [J IF END CHAR FOUND 3P7L TXU 5 SPACE(1) 3PM= BCS SNICK [J IF NOT SPACE 3Q6W SMO FX2 3QLG STOZ ACOMMUNE3 [SET SWITCH -CANNOT BE DELIMITER 3R66 BCT 4 P3 [J IF COUNT UNEXPIRED 3RKQ BRN P2 3S5B SNICK 3SK2 TXL 4 0 3T4L BCS PSTART [J IF CANNOT BE A LABEL 3TJ= TXL 5 TEN(1) 3W3W BCC PSTART [J IF NOT A DIGIT 3WHG CALL 7 SLABEL [S/R TO CHECK IF IS MATCHING LABEL 3X36 BRN P2 [NO MATCH 3XGQ BRN TWOQL [LABEL FOUND 3Y2B CALL 7 PCON [MAY BE LABEL --- 3YG2 BRN TWOQL [TERM FOUN , THUS LABEL MATCHES 3Y^L TXU 5 SPACE(1) 3^F= BCS P2 [NOT A SPACE THUS NO MATCH 3^YW [ THIS SECTION IS ENTERED WHEN THE LABEL HAS BEEN FOUND.ALL 42DG [ COMMAND PROCESSOR LEVELS BELOW THAT AT WHICH THE LABEL HAS BEEN 42Y6 [ FOUND ARE DELETED , AND ALL MACRO DEFINITION FILES ASSOCIATED 43CQ [ WITH THESE LEVELS ARE CLOSED 43XB TWOQL 44C2 LDX 2 FX2 44WL LDX 4 EXT(2) 45B= LDX 0 AWORK4(2) 45TW BPZ 0 PLABFOUND 46*G NGNC 0 1 46T6 ANDS 0 AWORK4(2) 47#Q TXU 4 CPLEV(2) 47SB BCS PLABFOUND 48#2 MHUNTW 3,CLB 48RL ADN 3 CLBFIR 49?= LDCH 0 0(3) 49QW SBN 0 10 4==G BPZ 0 PLABFOUND 4=Q6 SMO FX1 4?9Q LDX 7 NLOOP 4?PB BRN RERR 4#92 PLABFOUND 4#NL CALL 5 SENDCOM [S/R TO CLEAR UP ETC. 4#PS ...#SKI G286&1 4#R2 ...( 4#S8 ... MHUNTW 3,CLB 4#TB ... LDX 3 FPTR(3) 4#WJ ... LDX 0 ATYPE(3) 4#XQ ... SRL 0 12 4#YY ... SBN 0 IUSER+HULL 4*26 ... BNZ 0 XCCS 4*3# ... FREECORE 3 [ IF IUSER EXISTS AT CURRENT 4*4G ... [ C P LEVEL THEN FREE IT 4*5N ...XCCS 4*6W ...) 4*8= ENDCOM 4*MW PSTART 4B7G SMO FX2 4BM6 LDX 6 ACOMMUNE3 [GET SWITCH WORD 4C6Q BZE 6 P2 [J IF RECORD CANNOT BE DELIM 4CLB LDX 2 FX2 4D62 LDN 7 1 4DKL ANDX 7 EXT+2(2) [ISOLATE DELIM. BIT 4F5= BNZ 7 PST1 [J IF DELIM BIT SET 4FJW LDN 2 EXT+1(2) [SET PTR TO STARTER 4G4G BRN PST2 4GJ6 PST1 LDN 2 EXT+7(2) [SET PTR TO STOPPER 4H3Q PST2 4HHB LDN 0 4 [SET COUNT OF STOPPER CHARS 4J32 TXL 4 0 4JGL BCS P2 [J IF CANNOT BE STARTER 4K2= CALL 7 SLABEL [S/R TO CHECK FOR STARTER 4KFW BRN P2 [NO MATCH 4K^G BRN £ [MATCH FOUND 4LF6 LDN 7 1 [ MATCH FOUND 4LYQ LDX 2 FX2 4MDB ANDX 7 EXT+2(2) 4MY2 BZE 7 PST3 [J IF DELIM BIT UNSET 4NCL LDX 7 MASKFSD(1) 4NX= ANDS 7 EXT+2(2) [CLEAR DELIM BIT + B22 4PBW BRN P2A 4PWG PST3 4QB6 LDN 7 1 4QTQ ORS 7 EXT+2(2) 4R*B BRN P2A [J TO OMIT DELIM CHECK 4RT2 # 4S#L [ THIS IS THE ENTRY FOR THE EXIT COMMAND -THIS COMMAND CAUSES THE 4SS= [ CURRENT BOTTOM MACRO TO TERMINATE.IF THE CP IS POSITIONED 4T?W [ BETWEEN DELIMITERS AT NEXT LEVEL,A SEARCH FOR THE STOPPER 4TRG [ IS MADE. 4W?6 [ THE SEARCH TERMINATES WHEN STOPPER IS FOUND,OR MACRO LEVEL NOT 4WQQ [ BETWEEN DELS. OR A LEVEL WHICH IS NOT AN MDF IS REACHED 4X=B [ 4X=Q ...#UNS G400 4X?6 ...#SKI 4X?G ...( 4X?W ...QENTRY30 4X#= ... BRN (GEOERR) 4X#L ...) 4X*2 ...#UNS G400 4X*B ...( 4X*Q ...QENTRY30 4XB6 ... TESTHKN XDSK1 4XBG ... TRACE 0(2),BEFORE 4XBW ... PARAPASS [PASS PARAMETER 4XC= ... TRACE 0(2),AFTER 4XCL ... HUNT 2,CPB,CUNI 4XD2 ... LDX 4 APARA(2) [PARAM 4XDB ... LDX 5 ANUM(2) [COUNT 4XDQ ... FREECORE 2 4XF6 ... SBN 5 2 4XFG ... BNZ 5 XDSK1 [IGNORE IF NOT 2 CHARS 4XFW ... ANDX 4 YDSK1(1) [MASK FOR FIRST TWO CHARS 4XG= ... TXU 4 YDSK2(1) 4XGL ... BCS XDSK2 [J UNLESS BA 4XH2 ... LDN 4 1 4XHB ... BRN XDSKB 4XHQ ...XDSK2 TXU 4 YDSK3(1) 4XJ6 ... BCS XDSK3 [J UNLESS BB 4XJG ... LDN 4 3 4XJW ... BRN XDSKB 4XK= ...XDSK3 TXU 4 YDSK4(1) 4XKL ... BCC XDSKC [J IF CE 4XL2 ... TXU 4 YDSK5(1) 4XLB ... BCC XDSKO [J IF OB 4XLQ ... TXU 4 YDSK6(1) 4XM6 ... BCC XDSKR [J IF RC 4XMG ... TXU 4 YDSK7(1) 4XMW ... BCC XDSKM [J IF MR 4XN= ... TXU 4 YDSK8(1) 4XNL ... BCC XDSKA [J IF AB 4XP2 ...XDSK1 4XPB ...) 4XQ2 QENTRY3 4Y9L MHUNTW 3,CPB,CALAS 4YP= LDX 7 CPBFSD(3) 4^8W BNG 7 NMDF [J IF NOT AN MDF 4^NG LDX 4 CPLEV(2) 5286 SBN 4 1 [REDUCE CURRENT CPLEVEL 52MQ HUNT2 3,CPB,CALAS [GET NEXT /CALAS 537B LDX 7 CPBFSD(3) 53M2 BPZ 7 Z1 [J IF IS A MACRO LEVEL 546L Z5 STO 4 CPLEV(2) [STORE NEW LEVEL 54L= ENDCOM [END OF EXIT COMMAND 555W Z1 LDX 5 CPBPROGLEV(3) 55KG STO 5 EXT+2(2) [COPY INF. TO CPAT 5656 ANDN 5 1 [ISOLATE DELIM BIT 56JQ BZE 5 Z5 [J IF NOT BETWEEN DELS 574B LDX 5 CPBSTOP(3) [ GOING UP A LEVEL. COPY NEW STOPPER 57J2 STO 5 EXT+7(2) [ INTO CPAT 583L CLEANUP 4,3 [DELETE CURRENT CPLEVEL 58H= MONOUT JSTOPER ["SEARCHING FOR STOPPER" 592W STOZ AWORK1(2) [MARKER FOR EXIT COMMAND 59GG STO 4 EXT(2) 5=26 LDX 5 7 5=FQ ANDN 5 #77 [ISOLATE FSD 5=^B ANDX 7 MASKFSD(1) 5?F2 STO 7 AWORK4(2) 5?YL NGS 5 AWORK3(2) 5#D= # 5#XW [ THIS IS THE ROUTINE WHICH SEARCHES FOR THE STOPPER 5*CG # 5*X6 Y2A 5BBQ LDX 2 FX2 5BWB LDX 7 AWORK1(2) 5CB2 BPZ 7 Y4 [J IF NOT GOTO COMMAND 5CTL LDX 7 AWORK4(2) 5D*= TXU 7 AWORK2(2) 5DSW BCC NEWLEV [J IF SEARCHED ALL THE FILE 5F#G Y4 5FS6 SMO FX2 5G?Q LDX 1 AWORK3 [RELOAD FSD 5GRB STEP 0(1) 5H?2 LDN 7 #100 [UPDATE RECORD COUNT 5HQL ADS 7 AWORK4(2) 5J== BZE 3 REWINDA [J IF NO STOPPER BEFORE END OF FILE 5JPW LDEX 4 0(3) 5K9G SBN 4 2 5KP6 SLL 4 2 5L8Q LDX 6 1(3) 5LNB SRL 6 22 5M82 BZE 6 Y3 5MML SBN 4 4 5N7= ADX 4 6 5NLW Y3 ADN 3 2 [SET X3 TO START OF RECORD 5P6G Y2 5PL6 SMO FX2 5Q5Q LDN 2 EXT+7 [X2 TO PT TO STOPPER 5QKB LDN 0 4 [STOPPER CHAR COUNT 5R52 TXL 4 0 5RJL BCS Y2A [J IF CANNOT BE STOPPER 5S4= CALL 7 SDELIM [S/R TO CHECK FOR STOPPER 5SHW BRN Y2A [NO MATCH 5T3G BRN £ 5TH6 LDN 7 3 5W2Q LDX 2 FX2 5WGB ORS 7 EXT+2(2) 5X22 ERS 7 EXT+2(2) [UNSET DELIMITER BITS 5XFL LDX 7 AWORK1(2) 5X^= BNG 7 P2 5YDW SKIPEND 5YYG LDX 2 FX2 5^D6 LDX 4 EXT(2) [LOAD TERM LEVEL 62CB CALL 5 SENDSKIP [CLEAN UP ETC 62X2 CALL 6 OUTPUT 636S BZE 7 X4 [J IF EXIT COMMAND 63BL UP [RETURN TO CP ERROR ROUTINE 63W= [ 64*W NOSTOP 64TG LDN 7 0 [ X7=0 => NO STOPPER FOUND 65*6 BRN SKIPEND 65SQ [ 66#B X4 69PQ LDX 0 EXT+8(2) 6=9B BNG 0 THEND 6=P2 ENDREC 6?8L [ THE FOLLOWING SUBROUTINE OUTPUTS THE STOPPER WHICH ENDED THE 6?N= [ SEARCH 6#7W OUTPUT 6#MG BZE 7 SUPPRESS [J IF STOPPER MISSING 6*76 SBX 6 FX1 6*LQ LDN 4 4 6B6B OUTEXES 4,EXT+7 6BL2 OUTPAR TIMENOW [ O/P TIME 6C5L MONOUT ACOMJT 6CK= ADX 6 FX1 6D4W SUPPRESS 6DJG EXIT 6 0 6F46 # 6FHQ [ THE FOLLOWING SUBROUTINE FINDS THE RELEVANT CALAS BLOCK 6G3B RECH LDX 2 FPTR(2) 6GH2 LDX 0 ATYPE(2) 6H2L SRL 0 12 6HG= ERN 0 CPB+CALAS 6H^W BNZ 0 RECH 6JFG LDEX 0 CPBCPLEV(2) [LOAD CP LEVEL 6J^6 TXU 0 4 6KDQ BCS RECH 6KYB EXIT 7 0 6LD2 NEWLEV 6LXL LDX 4 EXT(2) 6MC= SBN 4 1 [REDUCE CPLEVEL 6MWW STO 4 EXT(2) 6NBG CALL 7 RECH 6NHN ...#SKI G261&1 6NNW ... LDX 1 FX1 6NW6 LDX 7 CPBFSD(2) 6P*Q BPZ 7 PEX [J IF MACRO LEVEL 6PTB SMO FX2 6Q*2 LDX 5 AWORK1 6QSL BPZ 5 PEX [ STOPPER MISSING. TIDY UP AND END 6R#= LDX 1 FX1 6RRW LDX 7 NFLAB(1) 6S?G BRN RERR 6SR6 [ 6T=Q REWINDA 6TQB LDX 2 FX2 6W=2 LDX 0 AWORK1(2) 6WPL BPZ 0 NEWLEV 6X9= REWIND 6XNW STOZ AWORK4(2) [ZEROISE RUNNING COUNT 6Y8G LDX 1 AWORK3(2) 6YN6 REWIND 0(1) 6^7Q LDX 3 MASKFSD(1) 6^MB ANDS 3 EXT+2(2) [LOSE DELIMITER BITS 7272 BRN P2 72LL # 736= [ THE FOLLOWING S/R OBTAINS NEXT CHAR FROM RECORD 73KW [ AND CONVERTS IT TO PAPER TAPE IF NECESSARY 745G # 74K6 PCON 754Q LDCH 5 0(3) 75JB BCHX 3 £ 7642 TXL 5 SEVFOUR(1) 76HL BCS NORD [J IF ORDINARY CHAR 773= SMO FX2 77GW LDX 6 EXT+2 [LOAD PT OR CLIKE 782G BNG 6 NORD [J IF CARD LIKE 78G6 TXU 5 SEVSIX(1) 78^Q BCS NIGN [J IF NOT DELTA SHIFT 79FB BCT 4 WUD 79^2 BRN TERM [J IF COUNT EXPIRED 7=DL WUD LDCH 5 0(3) 7=Y= BCHX 3 £ 7?CW TXL 5 TWOSCORE(1) [J IF SMALL CHARACTER 7?XG BCS W108 7#C6 ORN 5 #14 [MAKE INTO TRUE CHARACTER 7#WQ BRN NORD 7*BB W108 7*W2 TXU 5 THIRTEEN(1) [THIS SECTION 7B*L BCC TERM [LOOKS FORM 7BT= TXU 5 TWEN4(1) [A TERMINATOR 7C#W BCC TERM 7CSG TXL 5 THIRSIX(1) 7D#6 BCC NIGN 7DRQ TXL 5 THIRTWO(1) 7F?B BCC TERM 7FR2 WOOF TXU 5 TAB(1) 7G=L BCS NIGN 7GQ= LDN 5 #20 [SET SPACE FOR TAB 7H9W NORD EXIT 7 1 7HPG NIGN BCT 4 PCON 7J96 TERM EXIT 7 0 7JNQ # 7K8B [ THE FOLLOWING S/R CHECKS RECORD AGAINST LABEL OR DELIMITER 7KN2 # 7L7L [ ENTRY POINT FOR LABEL CHECK 7LM= SLABEL 7M6W SMO FX2 7MLG STO 7 ACOMMUNE1 [STORE LINK 7N66 BRN SL1 7NKQ SDELIM 7P5B SMO FX2 7PK2 STO 7 ACOMMUNE1 7Q4L SL0 CALL 7 PCON 7QJ= BRN SL2 [J IF TERM FOUND 7R3W SL1 LDCH 6 0(2) [GET NEXT CHAR 7RHG BCHX 2 £ [UPDATE 7S36 TXU 5 6 7SGQ BCS SL2 [J IF NO MATCH 7T2B BCT 4 SL4 [COUNT UNEXP. 7TG2 BCT 0 SL2 [J IF DELIM/LAB COUNT UNEXP. 7T^L SMO FX2 7WF= LDX 7 ACOMMUNE1 [RESTORE LINK 7WYW EXIT 7 1 7XDG SL4 BCT 0 SL0 [BOTH COUNTS UNEXP. 7XY6 SMO FX2 7YCQ LDX 7 ACOMMUNE1 7YXB EXIT 7 2 7^C2 SL2 SMO FX2 7^WL LDX 7 ACOMMUNE1 82B= EXIT 7 0 82TW # 83*G [ THE FOLLOWING S/R CLEANS UP AT END OF GOTO COMMAND OR BEFORE 83T6 [ RETURNING TO CP 84#Q # 84SB SENDSKIP 85#2 LDN 6 0 [SET SWITCH 85RL BRN SCLN 86?= SENDCOM 86QW LDN 6 #100 [SET SWITCH 87=G SCLN SBX 5 FX1 87Q6 CLEANUP 4,3 889Q MHUNTW 3,CPB,CALAS 88PB LDX 0 CPBFSD(3) 8992 BNG 0 SCLN2 89NL ANDN 0 #77 [ISOLATE FSD 8=8= ORX 0 AWORK4(2) [ADD IN REC.COUNT 8=MW SBX 0 6 [ADJUST COUNT 8?7G STO 0 CPBFSD(3) [STORE BACK IN /CALAS 8?M6 LDX 0 EXT+2(2) 8#6Q STO 0 CPBPROGLEV(3) [STORE DELIM WORD ETC. 8#LB SCLN2 8*62 STO 4 CPLEV(2) [SET NEW CP LEVEL IN CPAT 8*KL BZE 6 SEND1 [J IF CP RETURN 8B5= BACKSPACE 8BJW SEND1 8C4G ADX 5 FX1 8CJ6 EXIT 5 0 8D3Q [ THIS SECTION IS THE ENTRY FOR THE BRACKETS COMMAND 8DHB [ 8F32 QENTRY4 8FGL MHUNTW 3,CPB,CALAS 8G2= LDX 7 CPBFSD(3) 8GFW BNG 7 NMDF [J IF NOT A MACRO LEVEL 8G^G LDX 6 CPBSTART(3) 8HF6 STO 6 AWORK1(2) [STORE CURRENT STARTER AND STOPPER 8HYQ LDX 6 CPBSTOP(3) [IN THE CPAT 8JDB STO 6 AWORK2(2) 8JY2 PARANUMB 6 8KCL BZE 6 THEND [J. IF NO PARS. GIVEN 8KX= ERN 6 1 8LBW BNZ 6 TWOPARS [J IF MORE THAN 1 PARAMETER 8LWG CALL 5 SR1 [S/R TO GET 1ST PAR ETC. 8MB6 BRN THEND [J. IF PAR NULL/NON-EXISTENT 8MTQ TXU 6 PHOUR(1) 8N*B BCC TBR1 [J IF ONLY 4 CHARS IN PAR. 8NT2 SRL 7 12 [MOVE PAR TYPE INTO L.S.HALF 8P#L TXL 7 TO(1) 8PS= BCS TBR1 [J.IF PAR IS NOT TYPE 2 OR 3 8Q?W STO 6 AWORK3(2) [REMEMBER CHAR COUNT 8QRG ORX 7 GSIGN [SET MKR - SPECIAL CASE WHERE CP.MAY 8R?6 [NOT HAVE NOTICED SEPARATOR (POSS.)! 8RQQ LDN 6 4 [SET CT. TO 4 8S=B TBR1 STO 3 AWORK4(2) [REMEMBER PTR. TO /CUNI 8SQ2 LDN 2 AWORK1(2) 8T9L CALL 5 SR2 [S/R TO DEPOSIT PAR INTO AWORK AREA 8TP= BPZ 7 PCHEK [J IF IS NOT SPECIAL CASE 8W8W LDX 2 FX2 8WNG LDX 6 AWORK3(2) 8X86 SBN 6 4 [NO OF CHARS LEFT OF 1ST PAR 8XMQ TBR2 LDCH 4 APARA(3) [GET NEXT CHAR FROM /CUNI 8Y7B BCHX 3 £ [& UPDATE CHAR INDEX 8YM2 TXU 4 TCOMMA(1) 8^6L BCC TBR3 [J IF COMMA DETECTED 8^L= BCT 6 TBR2 925W BRN PCHEK [J IF NO STOPPER PAR GIVEN 92KG TBR3 SBN 6 1 [REDUCE COUNT 9356 BZE 6 PCHEK [J IF NO STOPPER GIVEN 93JQ LDN 5 1 944B SMO AWORK4(2) 94J2 ADS 5 JPARNUM [INCREASE PAR NO. IN /CUNI 953L TBR4 LDCH 4 APARA(3) 95H= TXU 4 SPACE(1) 962W BCS TBR5 [J IF CHAR IS NOT A SPACE 96GG BCHX 3 £ 9726 BCT 6 TBR4 97FQ BRN PCHEK [NO STOPPER GIVEN 97^B TBR5 MHUNT 2,CPB,CUNI 98F2 LDN 4 APARA(2) 98YL ADN 3 APARA 99D= SMO 6 99XW MVCH 3 0 9=CG STO 6 ANUM(2) [STORE NEW CHAR. COUNT 9=X6 LDX 3 2 [SET X3 TO POINT TO /CUNI 9?BQ TXL 6 PHOUR(1) 9?WB BCS ZERR [J IF < 4 CHARS LEFT 9#B2 BRN TBR6 9#TL TWOPARS 9**= CALL 5 SR1 [GET 1ST PAR ETC. 9*SW BRN TBR7 [J IF PAR NULL/NON EXISTENT 9B#G LDN 6 4 [SET COUNT TO 4 9BS6 LDN 2 AWORK1(2) 9C?Q CALL 5 SR2 9CRB TBR7 9D?2 CALL 5 SR1 [GET 2ND PAR ETC 9DQL BRN PCHEK [J IF PAR NULL/NON-EXISTENT 9F== TBR6 LDN 6 4 9FPW SMO FX2 9G9G LDN 2 AWORK2 9GP6 CALL 5 SR2 9H8Q PCHEK LDX 2 FX2 9HNB LDX 4 AWORK1(2) 9J82 TXU 4 AWORK2(2) 9JML BCC ZERR1 [J IF STARTER &STOPPER ARE SAME 9K7= MHUNTW 3,CPB,CALAS 9KLW LDX 4 AWORK1(2) 9L6G STO 4 CPBSTART(3) [STORE STARTER 9LL6 LDX 4 AWORK2(2) 9M5Q STO 4 CPBSTOP(3) [STORE STOPPER 9MKB THEND 9N52 ENDCOM [ END OF COMMAND 9NJL # 9P4= [ THE FOLLOWING S/R GETS NEXT PARAMETER AND TESTS IF THE CHAR 9PHW [ COUNT FOR THIS PARAM IS <4 9Q3G # 9QH6 SR1 SBX 5 FX1 9R2Q SPARAPAS 9RGB ADX 5 FX1 9S22 MHUNT 3,CPB,CUNI [FIND /CUNI 9SFL LDX 7 ANUM(3) 9S^= BNG 7 SR1A [PARAM NON-X 9TDW BZE 7 SR1A [PARAM NULL 9TYG LDN 6 #7777 9WD6 ANDX 6 7 [ISOLATE CHAR COUNT 9WXQ TXL 6 PHOUR(1) 9XCB BCS ZERR [REPORT ERROR 9XX2 EXIT 5 1 9YBL SR1A EXIT 5 0 9YW= # 9^*W [ THE FOLLOWING S/R DEPOSITS DELIMITER IN CPAT IF THERE ARE NO 9^TG [ ERRORS IN IT =2*6 # =2SQ SR2 LDCH 4 APARA(3) [GET NEXT CHAR FROM /CUNI =3#B TXL 4 TEN(1) =3S2 BCS ZERR [J IF DIGIT =4?L TXL 4 TLHB(1) =4R= BCC SR2A =5=W TXL 4 TA(1) =5QG BCC ZERR [J IF ALPHABETIC =6=6 TXU 4 PERCENT(1) =6PQ BCC ZERR [J IF % =79B TXU 4 THASH(1) =7P2 BCC ZERR [J IF # =88L TXU 4 THYPHEN(1) =8N= BCC ZERR [J IF HYPHEN =97W TXU 4 TCOMMA(1) =9MG BCC ZERR [J IF COMMA ==76 TXU 4 SPACE(1) ==LQ BCC ZERR [J IF SPACE =?6B SR2A DCH 4 0(2) =?L2 BCHX 2 £ =#5L BCHX 3 £ =#K= BCT 6 SR2 =*4W EXIT 5 0 =*JG # =B46 [ THIS SECTION IS FOR COMMAND ERROR REPORTS =BHQ # =C3B [ COMMAND ERROR WHEN THERE IS NO LABEL PARAMETER SPECIFIED IN =CH2 [ THE GOTO COMMAND =D2L NOPARAM =DG= LDX 7 PARM(1) =D^W LDX 6 PLAB(1) =FFG BRN RERROR =F^6 [ COMMAND ERROR WHEN THE LABEL SPECIFIED IN THE GOTO COMMAND =GDQ [ DOES NOT START WITH A DIGIT =GYB SWL LDX 7 NDLAB(1) =HD2 BRN RERR =HXL [ COMMAND ERROR WHEN EITHER PARAMETER OF THE BRACKETS COMMAND HAS =JC= [ AN INCORRECT FORMAT =JWW [ THE BRACKETS COMMAND ARE THE SAME =KBG [ COMMAND ERROR WHEN THE STARTER & STOPPER GIVEN AS PARAMETERS OF =KW6 # =L*Q ZERR1 =LTB LDX 7 NSAME(1) =M*2 BRN RERR =MSL [ ERROR MESSAGE IDENTIFIERS =N#= # =NRW NFLAB +JFLAB =P?G NDLAB +JDLAB =PR6 ZERR =Q=Q LDX 7 NAPFERR(1) =QQB RERR =R=2 NGN 6 1 =RPL RERROR =S9= COMERRX 7,6 =SNW NMDF LDX 7 TMDF(1) =T8G [ BRACKETS IS NOT A MACRO DEFINITION FILE =TN6 [ COMMAND ERROR WHEN THE SOURCE OF COMMAND FOR GOTO,EXIT OR =W7Q BRN RERR =WMB NAPFERR +APFERR =X72 NSAME +HSAME =XLL TMDF +JMDF =Y6= PARM +JPARMIS =YKW PLAB +JLAB =^5G NLOOP +JCOMLOOP =^85 ...#SKI G261&1 =^=N ...( =^*? ...ZBACK 4,4HBACK =^CW ...UP +2,4HUP =^GF ...) =^K6 MASKFSD #77777700 ?24Q TLHB #73 ?2JB TA #41 ?342 PERCENT #25 ?3HL TCOMMA #34 ?43= THASH #23 ?4GW THYPHEN #35 ?52G SEVFOUR #74 ?5G6 SEVSIX #76 ?5^Q TWOSCORE #40 ?6FB THIRTEEN #13 ?6^2 TWEN4 #24 ?7DL THIRSIX #36 ?7Y= THIRTWO #32 ?8CW TAB #31 ?8XG SPACE #20 ?9C6 PHOUR +4 ?9WQ TEN +10 ?=BB TO +2 ?=W2 4HTO ?=W5 ...#UNS G400 ?=W8 ...( ?=W? ...# ?=WB ...# EXIT WITH BREAKIN ?=WF ... ?=WJ ...XDSKB SETNCORE 2,3,IUSER,G400BLK ?=WM ... STOZ A1(3) ?=WQ ... STO 4 A1+1(3) [REMEMBER EXIT FOR COMPRO ?=WT ... LDCT 0 #400 ?=WY ... ORS 0 JOBEVENTS(2) [MARK BREAKIN ?=X3 ... BRN XDSK1 ?=X6 ...# ?=X9 ...# EXIT WITH COMMAND ERROR ?=X# ...# ?=XC ...XDSKC LDCT 0 #400 ?=XG ... ORS 0 EXT+8(2) [MARK COMMAND ERROR ?=XK ... HUNTC 3,COMDAT,CWHEN,WDSK1 ?=XN ... GEOERR 0,NEVER??? ?=XR ...WDSK1 LDX 3 FPTR(3) ?=XW ... LDX 0 ATYPE(3) ?=X^ ... SRL 0 12 ?=Y4 ... SBN 0 CPB ?=Y7 ... BZE 0 XDSK1 [ J IF NEXT COMMAND LEVEL ?=Y= ... ADN 0 #4777 [ COMDAT+CWHEN-CPB ?=Y* ... BNZ 0 WDSK1 ?=YD ... FREECORE 3 ?=YH ... BRN XDSK1 ?=YL ...# ?=YP ...# EXIT OBEY COMMAND ?=YS ...# ?=YX ...XDSKO LDN 5 1 [MARK 'OBEY' ?=^2 ... BRN XDSKR1 ?=^5 ...# ?=^8 ...# EXIT WITH MONRESUM ?=^? ...# ?=^B ...XDSKM HUNT 3,IUSER,G400BLK [LOOK FOR MARKER BLK ?=^F ... BNG 3 XDSK1 ?=^J ... LDX 0 A1(3) ?=^M ... SBN 0 5 ?=^Q ... BNZ 0 XDSK1 [CONTINUE IF NO MARKER ?=^T ... NGN 0 1 ?=^Y ... STO 0 A1+1(3) [NOTE MR ??23 ... BRN XDSK1 ??26 ...# ??29 ...# EXIT ABANDON ??2# ...# ??2C ...XDSKA SETNCORE 1,3,IUSER,G400BLK ??2G ... MHUNT 2,CLB ??2K ... HUNT2OPT 2,CLB,0 ??2N ... BPZ 2 XDSKA1 ??2R ... FREECORE 3 ??2W ... BRN XDSK1 ??2^ ...XDSKA1 ??34 ... CHAIN 3,2 ??37 ... LDN 0 6 ??3= ... STO 0 A1(3) [MARKER,AB EXIT ??3* ... BRN XDSK1 [CONTINUE ??3D ...XREF MHUNT 2,CLB ??3H ... HUNT2J 2,CLB,0,,ZFAIL ??3L ... EXIT 1 0 ??3P ...# ??3S ...# EXIT REPLACE COMMAND ??3X ...# ??42 ...XDSKR LDN 5 0 [MARK 'REPLACE' ??45 ...XDSKR1 PARAPASS ??48 ... HUNT 2,CPB,CUNI ??4? ... LDX 4 ANUM(2) ??4B ... FREECORE 2 ??4F ... STO 5 AWORK1(2) ??4J ... BZE 4 ZERR ??4M ... BPZ 4 XDSKR2 ??4Q ... BZE 5 ZERR ??4T ... BRN XDSKR3 ??4Y ...XDSKR2 SRL 4 12 [ TYPE ??53 ... SBN 4 2 ??56 ... BNZ 4 ZERR [ NOT COM ??59 ... LDN 4 2 ??5# ... SPARANXT ,,4 ??5C ... TESTREP UNPAIR,ZERR ??5G ... MHUNT 3,CLB ??5K ... HUNT2J 3,CLB,0,,ZFAIL ??5N ... HUNT 2,CPB,CUNI ??5R ... LDX 7 ANUM(2) ??5W ... BZE 7 ZERR ??5^ ... ANDN 7 #777 ??64 ... LDX 6 ANUMCHA(3) ??67 ... BXE 6 7,NOCHN ??6= ... BXL 7 6,NOCHN ??6* ... SBX 7 6 ??6D ... ADN 7 3 ??6H ... SRL 7 2 [NO OF WORDS ??6L ... ADX 7 ALOGLEN(3) [NEW SIZE ??6P ... ALTLENG 3,7,XREF ??6S ... MHUNTW 3,CLB ??6X ... HUNT2J 3,CLB,0,,ZFAIL ??72 ... HUNT 2,CPB,CUNI ??75 ...NOCHN LDX 7 ANUM(2) ??78 ... ANDN 7 #777 ??7? ... STO 7 ANUMCHA(3) ??7B ... STO 7 APARANUM(3) ??7F ... LDN 4 APARA(2) ??7J ... LDN 5 CLBFIR(3) ??7M ... SMO 7 ??7Q ... MVCH 4 0 ??7T ... LDX 3 BPTR(3) ??7Y ... STOZ APARANUM(3) ??83 ... NGN 4 1 ??86 ... STO 4 APARAFIR(3) ??89 ... FREECORE 2 ??8# ...XDSKR3 ??8C ... LDX 4 CPLEV(2) ??8G ... SBN 4 1 ??8K ... STO 4 CPLEV(2) [ REDUCE CP LEVEL ??8N ... LDN 1 3 ??8R ... CLEANX 4,1 [ CLEAR UP EXIT LEVEL ??8W ... LDX 5 AWORK1(2) ??8^ ... BZE 5 XDSKR4 ??94 ... SETNCORE 1,3,IUSER,G400BLK ??97 ... LDN 0 1 ??9= ... STO 0 A1(3) ??9* ... LDN 5 0 ??9D ...XDSKR4 ??9H ... ACROSS ALASB,90 [ GO TO RELOCATE VERB ??9L ...ZFAIL GEOERR 0,BLAST ??9P ...YDSK1 #77770000 ??9S ...YDSK2 4HBA00 ??9X ...YDSK3 4HBB00 ??=2 ...YDSK4 4HCE00 ??=5 ...YDSK5 4HOB00 ??=8 ...YDSK6 4HRC00 ??=? ...YDSK7 4HMR00 ??=B ...YDSK8 4HAB00 ??=F ...) ??*L MENDAREA 50,K99GOTO ??T= #END ^^^^ ...06554212000400000000