{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: IFEXPAN867)}}
====== IFEXPAN867 ======
(George Source)
**Macros used:** [[george:macro:ACROSS|ACROSS]], [[george:macro:BXU|BXU]], [[george:macro:CHAIN|CHAIN]], [[george:macro:CHARMOVE|CHARMOVE]], [[george:macro:CHEKLFN2|CHEKLFN2]], [[george:macro:CLOSETOP|CLOSETOP]], [[george:macro:COMBRKIN|COMBRKIN]], [[george:macro:COMERR|COMERR]], [[george:macro:DOWN|DOWN]], [[george:macro:ENDCOM|ENDCOM]], [[george:macro:ENDIFREC|ENDIFREC]], [[george:macro:ERROR|ERROR]], [[george:macro:FINDCORE|FINDCORE]], [[george:macro:FINDWFL|FINDWFL]], [[george:macro:FJOCA|FJOCA]], [[george:macro:FNORM|FNORM]], [[george:macro:FPCACA|FPCACA]], [[george:macro:FPERENT|FPERENT]], [[george:macro:FREECORE|FREECORE]], [[george:macro:FREELINK|FREELINK]], [[george:macro:FSHCODE|FSHCODE]], [[george:macro:GEOERR|GEOERR]], [[george:macro:GETCORE|GETCORE]], [[george:macro:HUNT|HUNT]], [[george:macro:HUNT2|HUNT2]], [[george:macro:HUNTACTF|HUNTACTF]], [[george:macro:JBS|JBS]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MFREE|MFREE]], [[george:macro:MHUNT|MHUNT]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:NAME|NAME]], [[george:macro:NAMETOP|NAMETOP]], [[george:macro:OPENDIR|OPENDIR]], [[george:macro:PARAFREE|PARAFREE]], [[george:macro:PARAPASS|PARAPASS]], [[george:macro:PARASTRING|PARASTRING]], [[george:macro:PERCONA|PERCONA]], [[george:macro:SEG|SEG]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:SPARANOT|SPARANOT]], [[george:macro:SPARAPAS|SPARAPAS]], [[george:macro:TESTREPNOT|TESTREPNOT]], [[george:macro:TRACE|TRACE]], [[george:macro:UP|UP]], [[george:macro:VFREE|VFREE]]
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