IFEXPAN867
(George Source)
Macros used: ACROSS, BXU, CHAIN, CHARMOVE, CHEKLFN2, CLOSETOP, COMBRKIN, COMERR, DOWN, ENDCOM, ENDIFREC, ERROR, FINDCORE, FINDWFL, FJOCA, FNORM, FPCACA, FPERENT, FREECORE, FREELINK, FSHCODE, GEOERR, GETCORE, HUNT, HUNT2, HUNTACTF, JBS, MENDAREA, MFREE, MHUNT, MHUNTW, NAME, NAMETOP, OPENDIR, PARAFREE, PARAPASS, PARASTRING, PERCONA, SEG, SEGENTRY, SETNCORE, SPARANOT, SPARAPAS, TESTREPNOT, TRACE, UP, VFREE
- IFEXPAN867.txt
22=M ... SEG IFEXPAN,,CENT(COMMAND PROCESSOR),,G275,G400 22H# ...[ 22R^ ...[ (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD 1982 234L ...[ THIS EXCLUDES CODE UNDER #SKI G275 23*? ...[ 23KY ...#OPT G275 = 0 23WK ...#SKI G275&1 247= ...# WITH UGUG EDIT M275 (MISCELLANEOUS NEW IF CONDITIONS) 248P ...#UNS G400 24=8 ...( 24?M ...# THIS CHAPTER IS MODIFIED FOR G3PLUS-IH MK2 24*6 ...# 24BK ...) 24D6 # THIS IS THE SEGMENT FOR DEALING WITH THE IF COMMAND. 24XQ # IT PERFORMS THE MAIN ANALYSIS OF THE CONDITION & SWITCHES TO OTHER 25CB # SEGMENTS(IFXCODES & IFNUMS)TO DEAL WITH VARIOUS SIMPLE CONDITIONS 25X2 # THE COMMAND IS NON STANDARD IN A NUMBER OF WAYS 26BL # 1)IT ANALYSES THE CONDITION BY EXAMINING THE LINE BUFFER SINCE IT HA 26W= # TO RECOGNISE'AND'&'OR'&'NOT'AS SEPERATORS 27*W # 2)IT USES WORKING SPACE IN THE COM PROC ACT WHICH ARE NORMALLY USED 27TG # BY THE COMMAND PROCESSOR & PARAMETER ANALYSING ROUTINES 28*6 # 3)IT HAS A SPECIAL ENTRY POINT BACK TO THE COM PROC TO AVOID ANY 28SQ # UNACCESSED PARAMETER MESSAGES 29#B # 4)IF THE CONDITION IS TRUE THE COMMAND FOLLOWING THE COMMA IS COPIED 29S2 # INTO AN ADATA,CREADL BLOCK.THE COMMAND PROCESSOR WILL PICK THIS UP 2=?L # AS THE NEXT COMMAND TO BE OBEYED 2=R= # 5)WHERE A NUMBER LIST IS TO BE EVALUATED A CPB,CUNI BLOCK IS SET UP 2?=W # & THE LIST COPIED IN SO THAT CHNUMCON CAN BE USED 2?QG # ENTRY POINTS:- 2#=6 SEGENTRY K1IFEXPAN,XIF1 [MAIN ENTRY FROM THE COMMAND PROCESSR 2#PQ SEGENTRY K2IFEXPAN,XIF2 [IFEXPAN ENTERS ITSELF HERE WHENEVER 2*9B [THE STATE WORD IS FULL 2*P2 SEGENTRY K3IFEXPAN,XIF3 [RETURN FROM EVALN OF SIMPLE CONDN 2B8L # FORMAT OF LINE BUFFER [TYPE-CLB]:- 2BN= #DEF VSTART=CLBFIR [START OF COMMAND IN LINE BUFFER 2C7W # WORKING SPACE USED IN COMMAND PROCESSING ACTIVITY BLOCK 2CMG # AT THE MOMENT R.V.WALKER'S EXTENTION WORDS ARE USED 2D76 #DEF XLBP=EXT [PTR TO LINE BUFFER 2DLQ #DEF XCHARS=EXT+1 [NO.OF CHARS OF COMMAND LEFT TO BE RE 2F6B #DEF XCHPTR=EXT+2 [PTR. TO NEXT CHAR. TO BE READ 2FL2 #DEF XSTATE=EXT+3 [STATE OF CALCULATION 2G5L #DEF XCOUNT=EXT+4 [LEVEL OF CALCULATION 2GK= # CONSTANTS USED IN IFEXPAN 2H4W XBRA #30 2HJG XKET #31 2J46 XCOMMA #34 2JHQ XAND 4HAND 2K3B XOR 4HOR 2KH2 XELSE 4HELS 2L2L XEQ #15 2LG= XSPS #20202020 2L^W XSP #20 2MFG XMIN #41 2M^6 XMAX #73 2NDQ QMINUS1 #77777777 2NYB QMASK1 #77777776 2PD2 QMASK2 #77777774 2PXL QMASK #17777777 2QC= # SWITCH TABLE FOR BASIC CONDITIONS 2QWW # THIS IS DIVIDED INTO TWO PARTS:ONE FOR CONDITIONS THAT CAN BE DEAL 2RBG # IN THIS SEGMENT & ONE FOR THOSE REQUIRING ENTRY TO ANOTHER SEGMENT 2STB XTBASE 2T*2 4HTRU 2TSL BRN XTRUE 2W#= 4HFAL 2WRW BRN XFALSE 2X?G 4HNOT 2XR6 BRN XNOT 2Y=Q 4HCOR 2YQB BRN XCORE 2^=2 4HMOP 2^PL BRN XONLINE 329= 4HUSE 32NW BRN XUSER 338G 4HFIN 33N6 BRN XFINISH 33PH 4HBRE 33QY BRN XBREA 33S* 4HPRO 33TQ BRN XPROG 33X7 4HREM 33YJ BRN XREMO 33^^ 4HREA 343B BRN XREAD 344R 4HOPE 3468 BRN XOPER 347Q XEXI 4HEXI 34MB BRN XEXISTS 34MR ...#UNS G400 34N8 ...( 34NK ... 4HDAT 34P2 ... BRN XMTY 34PC ... 4HSYS 34PS ... BRN XSYSI 34Q9 ... 4HFST 34QL ... BRN XFST 34R3 ... 4HABA 34RD ... BRN XABD 34RT ... 4HRLT 34S= ... BRN XRLT 34SM ... 4HOLP 34T4 ... BRN XOLP 34TF ... 4HASP 34TW ... BRN XASP 34W? ...) 34WC ...#UNS FSHIFMAC [SHFS REVERSION CODE 34WH ...( 34WM ... 4HLIN 34WR ... BRN XFALSE 34WX ...) 34X8 ...XTBASE2 3535 ...#DEF VTBCOUNT1=0?-XTBASE/2 [NO ENTRIES IN 1ST PART TABLE 3572 4HHAL 35LL ACROSS IFXCODES,1 366= 4HDEL 36KW ACROSS IFXCODES,2 375G 4HDIS 37K6 ACROSS IFXCODES,3 384Q 4HFAI 38JB ACROSS IFXCODES,4 3942 4HMON 39HL ACROSS IFXCODES,5 3=3= 4HSTR 3=GW ACROSS IFXCODES,7 3?2G 4HABS 3?G6 ACROSS IFXCODES,12 3?^Q 4HPRE 3#FB ACROSS IFXCODES,13 3#^2 4HREP 3*DL ACROSS IFXCODES,14 3*Y= 4HZER 3BCW ACROSS IFNUMS,1 3BXG 4HON 3CC6 ACROSS IFNUMS,2 3CWQ 4HOFF 3DBB ACROSS IFNUMS,3 3DW2 4HMEM 3F*L ACROSS IFNUMS,4 3FT= 4HPOS 3G#W ACROSS IFNUMS,5 3GSG 4HNEG 3H#6 ACROSS IFNUMS,7 3HFY 4HRES 3HHW ACROSS IFXCODES,15 3HKS 4HGEN 3HMQ ACROSS IFXCODES,16 3HMX ...#SKI G275&1 3HN4 ...( 3HN9 ... 4HSYS 3HNB ... ACROSS ASTONIF,1 3HNH ... 4HFST 3HNN ... ACROSS ASTONIF,2 3HNT ... 4HTST 3HP2 ... ACROSS ASTONIF,3 3HP7 ... 4HOFL 3HP# ... ACROSS ASTONIF,4 3HPF ... 4HONL 3HPL ... ACROSS ASTONIF,7 3HPR ... 4HPRI 3HPY ... ACROSS ASTONIF,8 3HQ5 ...) 3HQP 4HPAR 3HR4 ACROSS IFXCODES,17 3HR7 ...#UNS FSHIFMAC [SHFS REVERSION CODE 3HR= ...( 3HR* ... 4HMAC 3HRD ... ACROSS IFXCODES,18 3HRH ...) 3HRQ # 3J3J ...#DEF VTBCOUNT2 = 0?-XTBASE2/(HLINK+2) [NO OF ENTRIES IN 2ND PART TABLE 3J?B # THIS READS THE FIRST NON SPACE INTO X6 & IF NOT A LETTER EXITS+1 3JR2 # IF A LETTER IT READS TO A NON LETTER STORING FIRST THREE IN X6 3K=L # X7=LINK X3=CHAR PTR X4=CHARS LEFT.X1=FX1 X2=FX2 X0&X5 DESTROYED 3KQ= NCHAL BCT 4 ZB1 [ERROR IF NO MORE CHARS 3L9W BRN XERROR 3LPG ZB1 LDCH 6 0(3) [PICK UP NEXT CHAR 3M96 BCHX 3 £ 3MNQ TXU 6 XSP(1) 3N8B BCC NCHAL 3NN2 TXL 6 XMIN(1) [JUMP IF NOT LETTER 3P7L BCS ZB2 3PM= TXL 6 XMAX(1) 3Q6W BCC ZB2 3QLG LDX 5 6 [INITIALISE 3R66 LDX 6 XSPS(1) 3RKQ LDN 2 6 3S5B LDN 0 3 3SK2 ZB5 DCH 5 0(2) [DUMP CHAR 3T4L BCHX 2 £ 3TJ= ZB3 BCT 4 ZB3A 3W3W BRN ZB4A 3WHG ZB3A LDCH 5 0(3) 3X36 TXL 5 XMIN(1) [JUMP IF NOT LETTER 3XGQ BCS ZB4A 3Y2B TXL 5 XMAX(1) 3YG2 BCC ZB4A 3Y^L BCHX 3 £ 3^F= BCT 0 ZB5 [REPEAT UNLESS HOLDER 3^YW LDN 0 1 [FULL IN WHICH CASE 42DG BRN ZB3 [DO NOT DUMP CHAR 42Y6 ZB4A ADN 4 1 43CQ ZB4 43XB #SKIP K6IFEXPAN>999-999 44C2 TRACE 6,IFRDALPH 44WL LDX 2 FX2 [RESET X2 45B= EXIT 7 0 45TW ZB2 46*G #SKIP K6IFEXPAN>999-999 46T6 TRACE 6,IFRDCHAR 47#Q EXIT 7 1 47SB # IFEXPAN ENTERS ITSELF HERE WHEN THE STATE WORD IS FULL 48#2 XIF2 STO 3 5 48RL #SKIP K6IFEXPAN>999-999 49?= TRACE 1,IFENTRY2 49QW HUNT 3,CLB 4==G STO 3 XLBP(2) 4=Q6 ADX 3 5 4?9Q BRN ZD1 4?PB # ENTRY FROM COMMAND PROCESSOR. 4#92 # THIS FIRST SECTION PERFORMS SOME INITIALISATION.IT SETS UP A PTR T 4#NL # THE COMMAND IN THE LINE BUFFER,SETS THE NO OF CHARS REMAINING & TH 4*8= # LOOKS FOR & IGNORES ANY LABELS & THE CHARS'IF'SETTING THE PTR TO R 4*MW # THE CONDITION PART OF THE COMMAND. 4B7G XIF1 4BM6 #SKIP K6IFEXPAN>99-99 4C6Q TRACE 1,IFENTRY 4CLB HUNT 3,CLB 4D62 STO 3 XLBP(2) 4DKL LDX 4 ANUMCHA(3) [NO. OF CHARS 4F5= ADN 3 VSTART [INIT CHAR PTR 4FJW ADN 4 1 4G4G CALL 7 NCHAL [IGNORE'IF' 4GJ6 BRN ZD2 4H3Q ZD3 BCT 4 ZD4 4HHB BRN XERROR 4J32 ZD4 LDCH 6 0(3) 4JGL BCHX 3 £ 4K2= SBN 6 #20 4KFW BNZ 6 ZD3 4K^G CALL 7 NCHAL 4LF6 ZD2 STOZ XCOUNT(2) [CLEAR COUNT & STATE 4LYQ ZD1 STOZ XSTATE(2) 4MDB ZA1A LDN 7 1 [STEP COUNT 4MY2 ADS 7 XCOUNT(2) 4NCL # 4NX= # START OF THE MAIN LOOP WE EXPECT TO FIND AN ALPHABETIC STRING INTR 4PBW # A SIMPLE CONDITION & IF SO COMPARE IT WITH THE TABLE & SWITCH TO T 4PWG # APPROP ROUTINE TO DEAL WITH IT.WE MAY ALSO FIND A BRA & IN THIS CA 4QB6 # WE HAVE TO INTRODUCE A NEW LEVEL OF CALCULATION.SINCE THE STATE OF 4QTQ # THE CALCULATION AT ANY LEVEL IS HELD IN 3 BITS WE NORMALL ONLY SHI 4R*B # THE WORD 3 PLACES LEFT BUT IF IT IS FULL THE WHOLE WORD IS SAVED B 4RT2 # PUTTING IT IN AN ACC & GOING DOWN.ITS VALUE IS RESET ON RETURN 4S#L # 4SS= ZA1 CALL 7 NCHAL [READ CHAR 4T?W BRN ZC1 [JUMP IF ALPHABETIC 4TRG TXU 6 XBRA(1) [ERROR UNLESS BRA 4W?6 BCS XERROR 4WQQ LDX 5 XCOUNT(2) [PICK UP COUNT 4X=B ANDN 5 7 [JUMP IF COUNT = 8N 4XQ2 BZE 5 ZA2 4Y9L LDX 5 XSTATE(2) [SHIFT STATE WORD 4YP= SLL 5 3 4^8W STO 5 XSTATE(2) 4^NG BRN ZA1A 5286 ZA2 LDX 5 XSTATE(2) [SAVE STATE 52MQ SBX 3 XLBP(2) [RELATIVISE CHAR PTR 537B DOWN IFEXPAN,2 [RE-ENTER IFEXPAN 53M2 LDX 7 XSTATE(2) [PICK UP RESULT 546L STO 5 XSTATE(2) [RESET STATE REG 54L= # ENTRY POINT FROM ROUTINES DEALING WITH SIMPLE CONDITIONS 555W # RESULT HELD IN X7.0-TRUE,1-FALSE.B0=1 ERROR.B1=1 ERROR ALREADY REP 55KG # IF THE RESULT INDICATES THE WAS AN ERROR WE TIDY UP & REPORT AN ER 5656 # IF THE RESULT WAS FALSE WE SWITCH THE BOTTOM BIT OF THE STATE WORD 56JQ XIF3 BNG 7 XERROR1 574B HUNTACTF CLB,3,FX2 57J2 STO 3 XLBP(2) 583L ADX 3 XCHPTR(2) 58H= LDX 4 XCHARS(2) 592W BRN ZA3 59GG XFALSE 5=26 LDN 7 1 5=FQ BRN XTRUE1 5=^B XTRUE LDN 7 0 5?F2 XTRUE1 5?YL LDX 1 FX1 5#D= LDX 2 FX2 5#XW ZA3 ERS 7 XSTATE(2) 5*CG #SKIP K6IFEXPAN>999-999 5*X6 ( 5BBQ TRACE XSTATE(2),IFSTATE 5BWB TRACE XCOUNT(2),IFCOUNT 5CB2 ) 5CTL # A SIMPLE CONDITION MAY BE FOLLOWED BY'AND' 'OR',A KET OR A COMMA 5D*= # IF A KET OR COMMA THE BOTTOM 3 BITS OF THE STATE WORD ARE EXAMINED 5DSW # SEE WHETHER THE CONDITION AT THIS LEVEL WAS TRUE OR NOT & X7 IS SE 5F#G # [B21=1 OR B21=B22=B23=0 INDICATE TRUE & OTHERS INDICATE FALSE] 5FS6 # A KET IS ONLY ALLOWED IF THERE WAS A MATCHING BRA(I.E.COUNT>1)& A 5G?Q # COMMA IF THERE ARE NO UNMATCHED BRAS(I.E COUNT=1)WHEN IT SIGNIFIES 5GRB # THE END OF THE CONDITION 5H?2 CALL 7 NCHAL 5HQL BRN ZC2 [JUMP IF LETTER 5J== LDN 7 0 [DETERMINE RESULT HELD IN 5JPW LDN 0 7 [BOTTOM OF STATE REG 5K9G ANDX 0 XSTATE(2) [ & SET X7 ACCORDINGLY 5KP6 BZE 0 ZA4 5L8Q SBN 0 4 5LNB BPZ 0 ZA4 5M82 LDN 7 1 5MML ZA4 LDX 5 XCOUNT(2) [REDUCE COUNT 5N7= BCT 5 ZA5 [JUMP UNLESS ZERO 5NLW TXU 6 XCOMMA(1) [ERROR UNLESS COMMA 5P6G BCS XERROR 5PL6 #SKIP K6IFEXPAN>99-99 5Q5Q TRACE 7,IFRESULT 5QKB LDN 5 0 5R52 ZA13 BCT 4 ZA10 5RJL BZE 5 ZA17 5S4= BPZ 5 ZERROR 5SHW BRN ZA7 5T3G ZA10 LDCH 6 0(3) 5TH6 TXU 6 XSP(1) 5W2Q BCC ZA11 5WGB BNG 5 ZA15 5X22 TXU 6 XBRA(1) 5XFL BCC ZA12 5X^= BNZ 5 ZERROR 5YDW BNZ 7 ZA7 5YYG BRN ZA8 5^D6 ZA11 BCHX 3 £ 5^XQ BRN ZA13 62CB ZA15 ADN 4 1 62X2 CALL 7 NCHAL 63BL BRN ZA16 63W= BRN ZERRORA 64*W ZA12 64TG SBX 3 XLBP(2) 65*6 PARASTRING 3,4,CLB 65SQ LDX 6 ACOMMUNE1(2) 66#B BZE 6 ZERROR 66S2 MHUNT 3,CLB 67?L STO 3 XLBP(2) 67R= ADX 3 6 68=W LDX 4 ACOMMUNE2(2) 68QG BZE 5 ZA19 69=6 BZE 4 ZA14 69FY ZASP 69PQ LDCH 6 0(3) 69S* BXU 6 XSP(1),ZANSP 69WY BCHX 3 £ 69^H BCT 4 ZASP 6=46 BRN ZA14 6=6P ZANSP 6=9B TXU 6 XCOMMA(1) 6=P2 BCS ZERROR 6?8L ZA19 BZE 7 ZA14 6?N= MFREE CPB,CMULTI 6#7W BZE 4 ZA7 6#MG ADN 4 1 6*76 NGN 5 1 6*LQ BRN ZA13 6B6B ZA16 TXU 6 XELSE(1) 6BL2 BCS ZERROR 6C5L LDN 7 0 6CK= LDN 5 1 6D4W BRN ZA13 6DJG ZA14 MHUNT 2,CPB,CMULTI 6F46 LDX 1 2 6FHQ LDX 6 APARAFIR(2) 6G3B ANDN 6 #7777 [CHAR COUNT OF COMMAND 6GH2 ADN 2 APARAFIR+1 [ADDRESS OF START OF COMMAND 6H2L ZA20 NAME 1,ADATA,CREADL 6HG= STO 6 A1(1) 6H^W BZE 6 ZA18 6JFG LDN 3 CPDATA(1) [ADDRESS OF DESTINATION OF MVCH 6J^6 #SKI JSKI02<1$1 6KDQ ( 6KYB SMO 6 6LD2 MVCH 2 0 6LXL ) 6MC= #SKI JSKI02 6MWW CHARMOVE 2,6 6NBG ZA18 MHUNT 2,CLB 6NW6 CHAIN 1,2 6P*Q ZA7 ENDIFREC 6PTB ZA17 BNZ 7 ZA7 6Q*2 SETNCORE 2,1,ADATA,CREADL 6QSL STOZ A1(1) 6R#= BRN ZA18 6RRW ZERRORA 6S?G TXU 6 XCOMMA(1) 6SR6 BCC ZA7 [NO ERROR IF 3RD PARAMETER PRESENT 6T=Q ZERROR 6TQB LDN 7 0 6W=2 SPARANOT 2,7 6WPL COMERR APFERR 6X9= # 6XNW # THIS SECTION IS ENTERED WHEN AN ERROR IS DETECTED 6Y8G # IT TIDIES UP BY GETTING RID OF ANY LINK BLOCKS MADE BY RECURSIVE E 6YN6 # TO IFEXPAN(NECESSARY IF COUNT EXCEEDS 8). 6^7Q # IT SENDS AN ERROR MESSAGE UNLESS THIS HAS ALREADY BEEN SENT(B1 OF 6^MB # 7272 XBREAK 72LL LDCT 7 #700 736= BRN XERROR1 73KW YERROR 745G LDX 7 AWORK4(2) 74K6 STO 7 XCOUNT(2) 754Q XERROR [NORMAL ILLEGAL LABEL 75JB LDCT 7 #400 [UNREPORTED ILLEGAL INDICATOR 7642 XERROR1 76HL #SKIP K6IFEXPAN>99-99 773= TRACE 3,IFERROR 77GW LDX 2 FX2 782G LDX 6 XCOUNT(2) 78G6 SBN 6 9 78^Q ZA9 BNG 6 ZA9A 79FB SBN 6 8 79^2 FREELINK 7=DL BRN ZA9 [LOOPS,FREEING LINKS,IFEXPAN HAVING 7=Y= [GONE DOWN TO ITSELF 7?CW ZA9A SLL 7 1 [JUMP IF ERROR ALREADY REPORTED 7?XG BNG 7 ZA9B 7#C6 ERROR JIFERR [REPORT ERROR 7#WQ ZA9B 7*BB SLL 7 1 7*W2 BNG 7 ZA9C 7B*L ENDCOM 7BT= ZA9C 7C#W COMBRKIN 7CSG # IF A KET FOLLOWS A SIMPLE CONDITION WE RETURN TO THE LEVEL ABOVE,W 7D#6 # X7 OR XSTATE HOLDING THE RESULT OF THE CONDITION AT THIS LEVEL 7DRQ ZA5 STO 5 XCOUNT(2) [UPDATE COUNT 7F?B TXU 6 XKET(1) [ERROR UNLESS KET 7FR2 BCS XERROR 7G=L ANDN 5 7 [JUMP IF STATE REG EMPTY 7GQ= BZE 5 ZA6 7H9W LDX 5 XSTATE(2) [SHIFT STATE REG 7HPG SRL 5 3 7J96 STO 5 XSTATE(2) 7JNQ BRN ZA3 7K8B ZA6 SBX 3 XLBP(2) [STORE RELATIVE PTR 7KN2 STO 3 XCHPTR(2) 7L7L STO 4 XCHARS(2) [STORE CHAR COUNT 7LM= STO 7 XSTATE(2) 7M6W UP [BACK UP TO IFEXPAN 7M8K ...#UNS G400 7M=# ...( 7M#3 ...# 7M*Q ...# THIS DEALS WITH IF DATA 7MCF ...# 7MF8 ...XMTY LDN 6 0 [MARK AS IF DATA 7MGX ... BRN XXMTY [CONTINUE AS IF 'IF EXISTS' 7MJL ...) 7MLG # 7N66 # THIS SECTION DEALS WITH THE 'IF EXISTS' CONDITION: 7NKQ # 7P5B # THE ENTRANT DESCRIPTION IS PARASTRINGED INTO A CPB/CMULTI BLOCK, 7PK2 # THE MACRO TAKING IT FROM BETWEEN ITS OUTERMOST BRACKETS,AND SET 7Q4L # UP FOR ANALYSIS BY FNORM.ITS EXISTENCE OR NOT IS 7QJ= # THEN CHECKED BY TESTING THE REPLY TO OPENDIR. 7R3W # 7RHG XEXISTS 7RL5 ...#UNS G400 7RNN ...( 7RR? ... LDN 6 1 [MARK AS IF EXI 7RTW ...XXMTY 7RYF ...) 7S36 LDCH 0 0(3) 7SGQ TXU 0 XSP(1) 7T2B BCS XEX1 7TG2 BCHX 3 £ 7TK6 ...#UNS G400 7TN= ... BCT 4 XXMTY 7TRB ...#UNS G400 7TWG ...#SKI 7T^L BCT 4 XEXISTS [SKIP SPACES 7WF= XEX1 TXU 0 XBRA(1) 7WYW BCS XERROR [ERROR IF NOT L.H. BRACKET 7XDG SBX 3 XLBP(2) [RELATIVISE CHAR. POINTER 7XY6 LDX 0 XSTATE(2) [STORE EXT+3,4 TO PROTECT FROM 7YCQ STO 0 AWORK3(2) 7YXB LDX 0 XCOUNT(2) [PARAMETER PASSING MACROS 7^C2 STO 0 AWORK4(2) 7^WL PARASTRING 3,4,CLB 82B= LDX 3 ACOMMUNE1(2) [ZERO REPLY? 82TW BZE 3 YERROR 83*G STO 3 AWORK2(2) [SAVE NEW RELATIVE CHAR. POINTER 83T6 LDX 4 ACOMMUNE2(2) [GET NEW CHAR. COUNT 84#Q BZE 4 YERROR 84SB STO 4 AWORK1(2) [SAVE NEW CHAR. COUNT 85#2 SPARAPAS 85RL MHUNT 3,CPB,CUNI 85TT LDX 0 CONTEXT(2) 85Y4 ANDN 0 1 862? BNZ 0 OKUSER [J IF USER CONTEXT 864G CHEKLFN2 OKUSER,OKUSER,3 [FALSE IF LOCALNAME ONLY 866P BRN XEX9 868Y OKUSER 86?= NAMETOP 3,FILE,FNAME 86QW # 87=G # THIS ENTRANT,IF A TEMPORARY FILE CAN BE A WORKFILE OR A NAMED 87Q6 # WORKTAPE. IF A WORKFILE ERROR REPORTING IS SUPRESSED 889Q # 88PB FNORM 24 8992 MFREE FILE,FNAME 89NL TESTREPN OK,XEX5 8=8= MHUNT 3,FILE,FABSNB 8=MW LDN 0 2 8?7G ANDX 0 CONTEXT(2) 8?M6 BZE 0 XEX4 8#6Q LDN 0 #1000 8#LB ANDX 0 ATYPE(3) 8*62 BNZ 0 YERROR 8*?8 LDX 0 A1+1(3) [COMMAND ERROR IF 8*DB BZE 0 YERROR [NO USER NAME 8*KL XEX4 8B5= LDN 0 #2000 8BJW ANDX 0 ATYPE(3) 8C4G BZE 0 NOTSN 8CJ6 SMO A1(3) 8D3Q LDXC 0 A1+1(3) 8DHB BCS XEX10 [J IF XENOTAPE=FALSE 8F32 NOTSN 8FGL LDN 0 #200 [TEST AND BRN IF ENTRANT IS NOT TEMP 8G2= ANDX 0 ATYPE(3) 8GFW BZE 0 XEX6 8G^G LDN 0 1 [IF ENTRANT NOT A NAMED WORKTAPE THEN 8HF6 ANDX 0 ATYPE(3) [IT MUST EXIST OTHERWISE TREAT AS 8HYQ BZE 0 XEX7 [NAMED FILE 8J8J BRN NBIT22 8JDB XEX6 8JG# ... [B2839 11-04-83 8JJ= ... LDN 0 #400 [BIT 15 REEL SEQ NO. 8JL8 ... ANDX 0 ATYPE(3) [OR RET.PERIOD 8JN6 ... BZE 0 XEX6A 8JQ4 ... LDN 0 1 [SET BIT 23 - TAPE ENTRANT 8JS2 ... BRN XEX6B [REQD. 8JTY ...XEX6A 8JY2 LDN 0 2 8K7S ...XEX6B 8KCL ORS 0 ATYPE(3) 8KMD NBIT22 8KX= OPENDIR NBRK,READ,QUERY 8LBW MFREE FILE,FABSNB 8LWG TESTREPNOT OK,XN1 8LXF ...#UNS G400 8LYD ...( 8L^C ... BNZ 6 XNMTY [JUMP NOT IF DATA 8M2B ... MHUNTW 3,FILE,ENT 8M3* ... LDX 7 EINF1(3) 8M4# ... SLL 7 7 [GET UNCLEAN OPEN BIT 8M5? ... BNG 7 XBR3 [OPEN SO GIVE TRUE REPLY 8M6= ... LDX 7 ECOPS(3) 8M79 ... SRL 7 15 8M88 ...XBR3 MFREE FILE,ENT 8M97 ... CLOSETOP 8M=6 ...XBR2 BZE 7 XEX9 [NO DATA 8M?5 ... BRN XEX8 8M#4 ...XNMTY 8M*3 ...) 8MB6 MFREE FILE,ENT 8MTQ CLOSETOP 8N*B XEX8 8NT2 LDN 7 0 8P#L XN3 PARAFREE 8PS= LDN 1 AWORK1(2) [RESTORE EXT+1,2,3,4 8Q?W LDN 2 XCHARS(2) 8QRG MOVE 1 4 8R?6 LDX 2 FX2 8RQQ MHUNT 3,CLB 8S=B STO 3 XLBP(2) [STORE NEW LINE BUFFER POINTER 8SQ2 ADX 3 XCHPTR(2) [UNRELATIVISE CHAR. POINTER 8T9L BZE 7 XTRUE 8TP= BRN XFALSE 8W8W XN1 VFREE FILE,ENT 8WNG XEX9 8X86 NGN 7 1 8XMQ BRN XN3 8Y7B XEX10 8YM2 FREECORE 3 8^6L BRN XEX9 8^L= XEX7 8^MH ...#UNS G400 8^NS ...( 8^Q5 ... BNZ 6 XBR1 [JUMP IF NOT 'IF DATA' 8^RB ... FINDWFL 3 [GET WORKFILE DETAILS 8^SM ... MFREE FILE,FABSNB 8^TY ... TESTREPNOT OK,XEX9 8^X9 ... LDX 7 FBLMOD(3) [GET NUMBER OF BLOCK IN FILE 8^YG ... SBN 7 FBLKS-A1 8^^R ... BRN XBR2 [GO BACK TO STANDARD STREAM 9234 ...XBR1 924* ...) 925W MFREE FILE,FABSNB 92KG BRN XEX8 9356 XEX5 93JQ TESTREPN NOFILE,YERROR [IF NOT NOFILE MUST BE NON 944B BRN XEX9 [EXISTANT WORK FILE 944K ...#UNS G400 944S ...( 9453 ...# IF OL/AS CONDITIONS(CF IF EXISTS) 945= ...XOLP LDN 7 0 945F ... BRN XAS1 945N ...XASP LDN 7 1 945X ...XAS1 9466 ... LDCH 0 0(3) 946* ... TXU 0 XSP(1) [SPACE 946J ... BCS XAS2 946R ... BCHX 3 £ 9472 ... BCT 4 XAS1 [SKIP SPACES 9479 ...XAS2 TXU 0 XBRA(1) 947D ... BCS XERROR [ERROR,NOT LH BRA 947M ... SBX 3 XLBP(2) 947W ... LDX 0 XSTATE(2) 9485 ... STO 0 AWORK3(2) 948# ... LDX 0 XCOUNT(2) [SAVE EXT+3,4.... 948H ... STO 0 AWORK4(2) [TO PROTECT FROM PARAM MACROS 948Q ... PARASTRING 3,4,CLB 948^ ... LDX 3 ACOMMUNE1(2) 9498 ... BZE 3 YERROR 949C ... STO 3 AWORK2(2) 949L ... LDX 4 ACOMMUNE2(2) [GET NEW CHAR CT 949T ... BZE 4 YERROR 94=4 ... STO 4 AWORK1(2) [SAVE NEW CHAR CT 94=? ... PARAPASS 94=G ... LDX 0 CONTEXT(2) 94=P ... SLL 0 14 94=Y ... BPZ 0 XASF 94?7 ... PERCONA 94?B ... LDX 4 ACOMMUNE1(2) 94?K ... TESTREPN OK,YERROR 94?S ... FPCACA 3,FX2 94#3 ... HUNT2 3,APERI,APERIRES [FIND PERI RES BK 94#= ... ADN 3 A1 94#F ... FPERENT 4,3,2,1 [FIND PRB ENTRY 94#N ... SMO FX2 94#X ... LDX 4 AWORK1 94*6 ... BNG 2 XASF [IF NOT PRESENT,FALSE 94** ... LDXC 2 1(2) [2ND WD OF PRB ENTRY 94*J ... BCS XAS3 [OFFLINE 94*R ... BZE 7 XAST [ONLINE/OL-TRUE 94B2 ... BNZ 7 XASF [ONLINE/AS-FALSE 94B9 ...XAS3 SBN 3 A1 [INITIAL PTR 94BD ...XAS5 LDX 3 FPTR(3) [NEXT BLK 94BM ... LDX 0 ATYPE(3) [TYPE OF BLK 94BW ... TXL 0 CACT 94C5 ... BCS XAS5 [J IF NOT ACTY BLK 94C# ... SRL 0 12 94CH ... SBN 0 AOLPT 94CQ ... BZE 0 XAS6 94C^ ... GEOERR 1,OLPA [FAKE OLPA 94D8 ...XAS6 BCT 1 XAS5 94DC ... LDX 0 ATMARK(3) [FOUND OLPA,LD ATMARK 94DL ... BZE 0 XAS4 [FILE 94DT ... BZE 7 XAST [ELSE TRUE-OL 94F4 ... BRN XASF [FALSE-AS 94F? ...XAS4 BZE 7 XASF [FALSE-OL 94FG ...XAST LDN 7 0 94FP ... BRN XN3 94FY ...XASF NGN 7 1 94G7 ... BRN XN3 94GB ...) 94J2 # 953L # AN ALPHABETIC STRING FOLLOWING A SIMPLE CONDITION MUST BE'AND'OR'O 95H= # WE ADJUST BOTTOM BITS OF STATE:- 962W # IF'AND':IF B23=1 THEN SET B22=1 & B23=0 ELSE NO CHANGE 96GG # IF'OR' :IF B22=B23=0 THEN SET B21=1 & B22=B23=0 ELSE CLEAR B22&B23 9726 # THEN WE JUMP BACK TO LOOK FOR THE NEXT SIMPLE CONDITION 97FQ ZC2 LDX 0 XSTATE(2) 97^B TXU 6 XAND(1) [JUMP UNLESS 'AND' 98F2 BCS ZC3 98YL ANDX 0 QMASK1(1) [IF BOTTOM BIT OF STATE IS 99D= TXU 0 XSTATE(2) ['TRUE' DO NOT ALTER STATE 99XW BCC ZA1 9=CG ORN 0 2 [OTHERWISE SET B22 BIT 9=X6 STO 0 XSTATE(2) [& CLEAR BOTTOM BIT 9?BQ BRN ZA1 9?WB ZC3 TXU 6 XOR(1) [ERROR UNLESS 'OR' 9#B2 BCS XERROR 9#TL ANDX 0 QMASK2(1) [IF BOTTOM BITS OF STATE 9**= TXU 0 XSTATE(2) [ARE'FALSE' DO NOT ALTER STATE 9*SW BCS ZC3A 9B#G ORN 0 4 [OTHERWISE SET BIT 21 & 9BS6 ZC3A 9C?Q STO 0 XSTATE(2) [ CLEAR BOTTOM BITS 9CRB BRN ZA1 9D?2 # THIS SECTION LOOKS UP AN ALPHABETIC STRING IN THE TABLE & SWITCHES 9DQL ZC1 LDN 2 XTBASE(1) [LOAD PTR & COUNT 9F== LDN 0 VTBCOUNT1 9FPW ZC1A TXU 6 0(2) [COMPARE WITH TABLE ENTRY 9G9G BCC ZC1B [& JUMP IF MATCH 9GP6 ADN 2 2 [FIRST PART OF TABLE IS FOR 9H8Q BCT 0 ZC1A [CONDS DEALT WITH IN THIS SEG 9HNB LDN 0 VTBCOUNT2 [THE SECOND PART IS FOR THOSE 9J82 ZC1D TXU 6 0(2) [WHICH INVOLVE OTHER SEGMENTS 9JML BCC ZC1C 9K7= ADN 2 2+HLINK [STEP TO NEXT ENTRY IN PT 2 OF TABLE 9KLW BCT 0 ZC1D 9L6G BRN XERROR 9LL6 ZC1B LDX 7 2 [RESET X2 & SWITCH 9M5Q SBX 7 1 9MKB LDX 2 FX2 9N52 SMO 7 9NJL BRN 1 9P4= ZC1C LDX 7 2 9PHW SBX 7 1 9Q3G LDX 2 FX2 9QH6 SBX 3 XLBP(2) 9R2Q STO 3 XCHPTR(2) 9RGB STO 4 XCHARS(2) 9S22 SMO 7 9SFL BRN 1 9S^= # IF'NOT'FOUND BEFORE SIMPLE CONDITION SWITCH B23 OF STATE & JUMP BA 9TDW XNOT LDN 7 1 9TYG ERS 7 XSTATE(2) 9WD6 #SKIP K6IFEXPAN>99-99 9WXQ TRACE XSTATE(2),IFXNOT 9XCB BRN ZA1 9XX2 # THESE NEXT SECTIONS DEAL WITH THE CONTEXT CONDITIONS 9YBL # 9YW= # IF FINISH :TRUE IF FINISH COMMAND PREVIOUSLY ISSUED. 9^*W # 9^TG XFINISH =2*6 LDX 0 FINISH =2SQ BPZ 0 XFALSE =3#B BRN XTRUE =3S2 # IF USER :TRUE IF THE JOB IS IN USER CONTEXT(I.E.AFTER JOB OR LOGIN =4?L XUSER LDN 0 1 [SET USER CONTEXT BIT =4L3 XCTXT =4YD ANDX 0 CONTEXT(2) =5=W BZE 0 XFALSE [FALSE UNLESS CONTEXT SET =5QG BRN XTRUE =5R7 ...#UNS G400 =5RS ...( =5SF ...XSYSI LDCT 0 #400 [SYSTEM ISSUED CONTEXT MASK =5T6 ... BRN XCTXT [J TO TEST =5TR ...XFST LDCT 0 1 =5WD ... SRL 0 4 [FULLY STARTED CONTEXT MASK =5X5 ... BRN XCTXT [J TO TEST =5XQ ...XABD LDCT 0 4 =5YC ... ANDX 0 JOBEVENTS(2) [ABANDONED BIT IN JOBEVENTS =5^4 ... BZE 0 XFALSE =5^P ... BRN XTRUE =62B ...XRLT SMO FX2 [TEST FOR REALTIME =633 ... LDX 0 CONTEXT =63N ... SRC 0 2 =64* ... BNG 0 XFALSE [J IF NO-USER CONTEXT =652 ... FJOCA 2 =65M ... LDN 0 #600 =66# ... ANDX 0 JMISC(2) [REALTIME BIT IN JOBQ BLOCK =66^ ... LDX 2 FX2 =67L ... BZE 0 XFALSE =68? ... BRN XTRUE =68Y ...) =6=6 # IF ONLINE:TRUE IF THE JOB IS IN ONLINE CONTEXT(I.E.FROM MOP CONSOL =6PQ XONLINE =79B LDN 0 8 [SET ONLINE CONTEXT BIT =7P2 BRN XCTXT =88L # IF CORE IMAGE OR COREIMAGE (I.E.ONE WORD OR TWO):TRUE IF THERE =8N= # IS A CORE IMAGE ASSOC WITH THE JOB. =97W XCORE STO 3 XCHPTR(2) [SAVE PTR & CHAR COUNT =9MG STO 4 XCHARS(2) ==76 CALL 7 NCHAL [READ NEXT CHARS ==LQ LDX 0 0 [(NULL INSTR 1FOR SUBR) =?6B LDN 0 #1000 [SET CORE IMAGE CONTEXT BIT =?L2 TXU 6 QIMA(1) [JUMP IF'IMAGE'. =#5L BCC XCTXT =#K= LDX 3 XCHPTR(2) [OTHERWISE RESET PTR & COUNT =*4W LDX 4 XCHARS(2) =*JG BRN XCTXT =B46 QIMA 4HIMA =B4K # IF BREAK IN OR BREAKIN (I.E. ONE WORD OR TWO) =B54 # TRUE : IF IN BREAK IN CONTEXT. =B5H XBREA STO 3 XCHPTR(2) [SAVE PTR & CHAR COUNT =B62 STO 4 XCHARS(2) =B6F CALL 7 NCHAL [READ NEXT CHARS =B6Y LDX 0 0 [(NULL INSTR 1FOR SUBR) =B7C LDN 0 1 =B7W SLL 0 14 [SET CONTEXT BIT =B8* TXU 6 QIN(1) [JUMP IF "IN" =B8S BCC XCTXT =B9? LDX 3 XCHPTR(2) [OTHERWISE RESET PTR & COUNT =B9Q LDX 4 XCHARS(2) =B=9 BRN XCTXT =B=N QIN 4HIN =B?7 # IF PROGRAM : TRUE IF PROGRAM ISSUED =B?L # =B#5 XPROG LDN 0 1 =B#J SLL 0 12 [SET CONTEXT BIT =B*3 BRN XCTXT =B*G =B*^ # IF REMOTE : TRUE IF IN REMOTE CONTEXT =BBD # =BBX XREMO LDN 0 #200 [SET CONTEXT BIT =BCB BRN XCTXT =BCT # IF READER : TRUE IF FROM A READER =BD# # =BDR XREAD LDN 0 #40 [SET CONTEXT BIT =BF= BRN XCTXT =BFP # IF OPERATOR : TRUE IF ISSUED FROM OPERATORS CONSOLE =BG8 # =BGM XOPER LDN 0 #20 [SET CONTEXT BIT =BH6 BRN XCTXT =BHQ # IF THE CONDITION IS FOUND TO BE SATISFIED(I.E.TRUE) THE COMMAND FO =C3B # THE COMMA TERMINATING THE CONDITION IS MOVED INTO A READ LINE BLOC =CH2 # SO THAT IT WILL BE OBEYED BY THE COMMAND PROCESSOR. =D2L #SKI AMK7IF =DG= ZA8 BZE 4 ZA10 =D^W #SKI AMK7IF<1$1 =FFG ZA8 BZE 4 XERROR =F^6 SBX 3 XLBP(2) [MAKE CHAR PTR RELATIVE =GDQ LDX 6 4 [NO OF CHARS LEFT =GYB ADN 4 CPDATA-A1*4+3 [ADJUSTMENT FOR START OF DATA =HD2 SRL 4 2 =HXL GETCORE 4,1 [MAKE BLOCK =JC= FINDCORE 1 =JWW MHUNT 2,CLB =KBG ADX 2 3 [ADDRESS OF START OF COMMAND =KW6 BRN ZA20 =L*Q NBRK GEOERR 1,BRKINDIR =LC7 FSHCODE AORB =LDJ ( =LF^ # =LHB # IF LINK : TRUE IF THE SHARED FILESTORE LINK IS RUNNING =LJR # =LL8 XLINK =LMK # =LP2 JBS XTRUE,,FSHRUNNING [JIF THE SHARED FILESTORE LINK IS UP =LQC BRN XFALSE [ELSE CONDITION NOT MET =LRS ) =LTB MENDAREA 50,GAPIFEXPAN =M*2 #END ^^^^ ...20425541000300000000