(George Source)
Macros used: ACROSS, ALTLEN, BXU, DOWN, FINDCORE, FREECORE, GEOERR, GETCOREN, HUNT, MENDAREA, MFREE, MHUNT, NAME, PARAFREE, PARANEXT, PARANOT, PARANUMB, SEGENTRY, SETNCORE, SETREP, SPARANOX, TESTPAIR, TESTREP, TESTREP2, TRACE, UP
22FL #LIS K0DECODE>K0ALLGEO>K0GREATGEO>K0FILESTORE
22^= #SEG DECODE5 [ TONY HAMILTON
23DW 8HDECODE
23YG # THIS CHAPTER IS THE CONTROLLING ROUTINE FOR THE FNORM MACRO
24D6 # INPUT MUST BE A FILENAME PARAMETER BLOCK (FILE/FNAME) AND THE
24XQ # CORRESPONDING MULTI BLOCK AS PRODUCED BY ALAS OR PARALYSE.
25CB # IT DECODES THE FILENAME PARAMETER,USING THE PARAMETER TYPE FROM
25X2 # THE FILE/FNAME BLOCK AND GOES DOWN TO NORMALUS,WHICH SETS UP
26BL # A FILE/FABSNB.WHEN THE FILENAME IS QUALIFIED,NORMALUS GOES DOWN TO
26W= # ADJUNCTS WHICH SETS UP A FILE/ADJUNCTS BLOCK
27*W # ****
27TG [
28*6 SEGENTRY K1DECODE,XFNORM [FNORM WITH PARAMETER
28SQ SEGENTRY K2DECODE,ZFNORM [FNORM WITHOUT PARAMETER
29#B SEGENTRY K3DECODE,TIDYUP
29S2 SFNORM
2=?L #HAL FI+FNORM,0
2=R= SCUNI
2?=W #HAL CPB+CUNI,0
2?QG [
2#=6 ZFNORM
2#PQ [
2*9B STOZ ACOMMUNE9(2)
2*P2 [
2B8L XFNORM
2BN= [
2C7W ... SETNCORE 1,1,FI,FNORM [MARKER BLOCK FOR CUNI FREEING ON EX
2CMG STOZ AWORK3(2) [NO FABSNB
2D76 LDX 7 ACOMMUNE9(2)
2DBY ... STO 7 A1(1) [ PRESERVE MODE
2DLQ LDN 6 0
2F6B HUNT 3,CPB,CMULTI
2FL2 BNG 3 SERF
2G5L LDX 6 ANALEV(3)
2GK= SERF
2H4W HUNT 1,FILE,FNAME [ TO BE PASSED TO TEMP FILE ROUTINE
2HJG #SKI K6DECODE>599-599
2J46 TRACE ANUM+1(1),DECODE
2JHQ LDEX 5 ATYPE(1) [PICK UP THE PARAM NUMBER
2K3B SPARANOX 5,6 [GET PARAMETER TO BE NORMALISED
2KH2 HUNT 2,CPB,CUNI
2L2L NGX 0 ANUM(2)
2LG= BPZ 0 REPLZ [NULL & NON/E PARAMETERS WRONG
2L^W LDX 3 FX2
2MFG STO 6 AWORK1(3) [STORE IT IN THE LINK BLOCK
2M^6 LDN 0 1
2NDQ ANDX 0 7
2NYB BZE 0 XADJ [J IF NO ADJUNCTS WANTED
2PD2 LDCT 0 #400
2PXL ORS 0 AWORK1(3) [SET B0 TO REMEMBER ADJUNCTS WANTED
2QC= XADJ
2QWW LDX 1 ANUM(2)
2RBG SRL 1 12 [USE THE PARAM TYPE TO
2RW6 BZE 1 SIMPL [ J TO ROUTINE TO HANDLE THIS TYPE
2S*Q SBN 1 1
2STB BZE 1 SEUDO [J IF PSEUDO-SIMPLE
2T*2 SBN 1 1
2TSL BZE 1 POZIT [J IF COMPOSITE
2W#= SBN 1 1
2WRW BZE 1 QUALD [J IF QUALIFIED
2X?G GEOERR 1,PARTYPE? [PARAMETER TYPE EXCEEDS 3 -ILLEGAL
2XR6 SIMPL DOWN NORMALUS,1 [SET UP THE FABSNB
2Y=Q TESTREPN OK,RONG
2YQB BRN XIT
2^=2 TRONG
2^PL ACROSS NORMERR,33
329= RONG
32NW ACROSS NORMERR,32
338G XIT
33N6 HUNT 1,CPB,CUNI
347Q FREECORE 1
34MB XITA
3572 LDX 1 FX2
35LL LDX 5 EXPEDIENT(1) [KEEP TO TEST IF ADJUNCTS WANTED
366= LDEX 6 EXPEDIENT(1) [ANALYSIS LEVEL WHEN ENTERED
36KW ADN 6 1
375G ORX 6 GSIGN
37K6 ERX 6 GSIGN
384Q PARAFREE 6
38JB HUNT 1,FILE,ADJUNCTS [SEE IF AN ADJUNSTS BLOCK HAS BEEN SE
3942 BNG 1 NOADJ [J IF NOT
39HL BPZ 5 NWANT [J IF ADJUNCTS NOT WANTED
3=3= SETREP ADJUNCTS
3=GW [
3?2G TIDYUP
3?G6 [
3?^Q UP1 HUNT 2,FI,FNORM
3#FB BNG 2 UP [J IF NO FNORM BLOCK - CUNI'S FREED
3#^2 LDX 1 FX1
3*DL LDX 2 FX2
3*Y= NCUNI LDX 2 FPTR(2) [NEXT BLOCK
3BCW LDX 0 ATYPE(2)
3BXG ANDX 0 HALFTOP
3CC6 TXU 0 SFNORM(1)
3CWQ BCC UP2 [J IF FNORM - NO MORE FNORM CUNI'S
3DBB TXU 0 SCUNI(1)
3DW2 BCS NCUNI [J IF NOT A CUNI
3F*L FREECORE 2 [A CUNI CREATED BY FNORM
3FT= BRN NCUNI
3G#W UP2 FREECORE 2 [THE FNORM BLOCK
3GSG UP
3H#6 UP
3HRQ NWANT FREECORE 1 [FREE ADJUNCTS BLOCK
3J?B NOADJ
3JR2 MHUNT 1,FILE,FABSNB
3K=L LDN 0 #2000
3KQ= ANDX 0 ATYPE(1)
3L9W BZE 0 Z2
3LPG LDX 0 A1(1)
3M96 SBN 0 6
3MNQ BZE 0 SRONG4
3N8B Z2
3NN2 SETREP OK
3P7L BRN UP1
3PM= REPLY
3Q6W ACROSS NORMERR,87
3QLG REPLZ ACROSS NORMERR,63
3R66 SEUDO
3RKQ FREECORE 2
3S5B PARANEXT #33, ,5 [SPLIT THE PARAM AT +
3S*8 ... TESTREP2 TOOMANY,MESSB
3SK2 CALL 1 TESTPAIR
3T4L ADN 6 1 [INCREASE ANALYSIS LEVEL
3TJ= PARANUMB 4
3W3W SBN 4 1
3WHG BZE 4 SIMPL
3X36 [THIS SECTION WILL BE OMITTED
3XGQ [IN MARK 1 -STREAM COMMAND
3Y2B TEMPF
3YG2 ACROSS NORMERR,31 [STREAMS NOT ALLOWED
3Y^L POZIT
3^F= POZ PARANEXT #34, ,5 [REMOVE PARENTHESES & SPLIT AT COMMA
3^P4 ... TESTREP2 TOOMANY,MESSB
3^YW CALL 1 TESTPAIR
42DG ADN 6 1 [ADD 1 TO ANALYSIS LEVEL
42Y6 PARANUMB 4
43CQ SBN 4 1 [X4 WILL BE ZERO IF NO COMMA (THE BRA
43XB HUNT 1,CPB,CUNI [ WERE THEN SUPERFLUOUS)
44C2 NGX 3 ANUM(1)
44WL BPZ 3 MESSA [ERROR IF NO SERIAL NO. GIVEN
45B= LDCH 3 ANUM+1(1)
45TW SBN 3 8 [TEST IF OCTAL CHAR
46*G ... FREECORE 1
46T6 BPZ 3 MESSA [ERROR IF NOT T.S.N.
47#Q LDX 3 4
47SB ADN 3 1 [X3 = NO OF PARAMS WITHIN THE BRACKET
48#2 SPARANOX 3
48RL HUNT 1,CPB,CUNI
49?= LDCH 0 ANUM+1(1) [ & TEST IF IT BEGINS OCTAL CHAR
49QW SBN 0 10
4==G BNG 0 NONAM [IF IT DOES NO FILENAME IS SPECIFIED
4=Q6 BZE 0 NCOL [IF IT IS A COLON.
4?9Q USMT DOWN NORMALUS,1 [SET UP FABSNB USING LAST PARAMETER
4?PB TESTREPN OK,RONG [J IF ERROR IN NAME
4#92 MFREE CPB,CUNI
4#NL HUNT 3,FILE,FABSNB [EXTEND FABSNB TO HOLD TSN'S
4*8= NORET LDN 0 #2000 [SET B13 OF ATYPE IN FABSNB TO SHOW
4*MW ORS 0 ATYPE(3)
4B7G LDX 5 ALOGLEN(3)
4BM6 BXU 5 HDREC(3),RETSP [J IF RET.P IS IN FABSNB
4C6Q ADN 5 1 [ALLOW FOR EXTRA WORD
4CLB NGN 7 1 [SET SWITCH
4D62 RETSP ADX 5 4 [ADD NO OF TSN'S TO BE STORED
4DKL ALTLEN 3,5,FILE,FABSNB
4F5= BPZ 7 NAMNO [J IF RET PER IS IN
4FJW HUNT 2,FILE,FABSNB
4G4G ADX 2 HDREC(2) [X2 -> END OF BLOCK
4GJ6 STO 7 A1(2) [SET RET PER -VE
4H3Q NAMNO LDN 3 0 [MODIFIER FOR APPENDING TSN'S
4HHB SBN 4 1 [**** IN MK1
4J32 BNZ 4 TRONG1
4JGL ADN 4 1 [**** IS ALLOWED
4K2= BRN NOUNI
4KFW NXTSN HUNT 1,CPB,CUNI
4K^G FREECORE 1 [FREE LAST CUNI BLOCK
4LF6 NOUNI ADN 3 1 [INCREASE MODIFIER
4LYQ SBN 4 1
4MDB BNG 4 SERQA [J IF ALL TSN'S PROCESSED
4MY2 PARANOT 0(3),6 [PASS NEXT TSN
4NCL HUNT 1,CPB,CUNI
4NX= LDX 0 ANUM(1) [ACCESS TYPE
4PBW SRL 0 12
4PWG BNZ 0 MESSA [ERROR IF NOT SIMPLE
4QB6 CALL 5 SCOB [STORE TSN IN FABSNB
4QTQ BRN NXTSN [J TO PICK UP NEXT
4R*B XENO LDCH 2 APARA+2(1) [FOR A TSN OF 9 CHARS
4RT2 SBN 2 #70 [TEST IF 9TH CHAR IS X
4S#L BNZ 2 MESSA [ERROR IF NOT
4SS= HUNT 2,FILE,FABSNB
4T?W ADX 2 HDREC(2)
4TRG SMO 3
4W?6 STOZ A1(2)
4WQQ LDCT 0 #400 [SET B0 OF TSN WORD TO SHOW XENOTAPE
4X=B SMO 3
4XQ2 ORS 0 A1(2)
4Y9L LDEX 2 ANUM(1)
4YP= SBN 2 1 [REDUCE COUNT BY 1
4^8W BRN XENT
4^NG SCOB LDEX 2 ANUM(1) [GET COUNT OF CHARS IN TSN
5286 SBN 2 #11
52MQ BNG 2 NOTX [J IF 8 CHARS OR LESS
537B BZE 2 XENO [J IF 9 CHARS
53M2 BRN MESSA [ERROR IF GREATER
546L NOTX HUNT 2,FILE,FABSNB
54L= ADX 2 HDREC(2)
555W SMO 3
55KG STOZ A1(2) [ZEROISE TSN WORD
5656 LDEX 2 ANUM(1)
56JQ XENT LDN 7 0 [SET X7 ZERO
574B NXOCT LDCH 0 ANUM+1(1) [PICK UP NEXT CHAR
57J2 SBN 0 #10
583L BPZ 0 NXEN [J IF NOT OCTAL
58H= ADN 0 #10
592W SLL 7 3 [MOVE TO ALLOW FOR NEXT CHAR
59GG ORX 7 0 [ADD NEXT NUMBER TO X7
5=26 BCHX 1 £
5=FQ BCT 2 NXOCT [J IF MORE OCTAL CHARS
5=^B HUNT 2,FILE,FABSNB
5?F2 ADX 2 HDREC(2)
5?YL BZE 7 MESSA
5#D= BNG 7 MESSA
5#XW SMO 3
5*CG ORS 7 A1(2) [STORE TSN AT END OF FABSNB
5*X6 EXIT 5 0
5BBQ NXEN SBN 0 #60 [TEST FOR X,IF IT IS NOT
5BWB BNZ 0 MESSA [ERROR REPORTED
5CB2 SBN 2 1
5CTL BNZ 2 MESSA
5D*= HUNT 2,FILE,FABSNB
5DSW ADX 2 HDREC(2)
5F#G BZE 7 MESSA
5FS6 SMO 3
5G?Q STO 7 A1(2) [STORE TSN AT END OF FABSNB
5GRB LDCT 0 #400 [SET BO TO SHOW
5H?2 SMO 3 [XENOTAPE
5HQL ORS 0 A1(2)
5J== EXIT 5 0
5JPW NCOL FREECORE 1
5K9G PARANEXT #36,,3
5KF# ... TESTREP2 TOOMANY,MESSB
5KP6 CALL 1 TESTPAIR
5L8Q ADN 6 1
5LNB PARANUMB 5 [GET NO. PARAMS
5M82 SBN 5 1 [IF ONE,WE HAVE ONLY A
5MML BZE 5 XKT [USERNAME,ILLEGAL WITH T.S.N
5N7= PARAFREE 6 [FRRE LAST CPB,CMULTI BLOCK
5NLW SBN 6 1 [OTHERWISE FREE
5P6G HUNT 1,CPB,CUNI [CUNI BLOCK AND CONTINUE
5PL6 FREECORE 1
5Q5Q SPARANOX 3
5QKB BRN USMT
5R52 NONAM FREECORE 1 [FREE CUNI BLOCK
5RJL GETCOREN 10,1 [SET UP A FABSNB WITH USERNAME ONLY
5S4= FINDCORE 3
5SHW NAME 3,FILE,FABSNB
5T3G LDN 0 10
5TH6 STO 0 HDREC(3)
5W2Q [THE NAME OF THE CURRENT USER IS MOVE
5WGB ADN 2 CPREFIX [TO THE FABSNB
5X22 ADN 3 A1+1
5XFL MOVE 2 3
5X^= LDN 0 6 [SIX-WORD LOCALNAME IS ZEROIZED
5YDW ZELOC STOZ 3(3)
5YYG ADN 3 1
5^D6 BCT 0 ZELOC
5^XQ SBN 3 A1+7 [RESET X3 -> FABSNB
62CB ADN 4 1 [ONE MORE TSN AS THERE IS NO LOCALNAM
62X2 BRN NORET
63BL XKT HUNT 1,CPB,CUNI [ERROR CASE
63W= FREECORE 1 [ONLY USERNAME PRESENT
64*W BRN TRONG
64TG QUALD
65*6 QUAST PARANEXT #33, ,5 [SPLIT PARAM AT +
65JY ... TESTREP2 TOOMANY,MESSB
65SQ CALL 1 TESTPAIR
66#B ADN 6 1 [ADD 1 TO ANALYSIS LEVEL
66S2 PARANUMB 4 [TO TEST FOR A STREAM NAME
67?L SBN 4 1
67R= BNZ 4 TEMPF [J IF IT IS A STREAM NAME
68=W HUNT 1,CPB,CUNI
68QG LDCH 0 APARA(1) [TEST1ST CHAR FOR '(' WHICH
69=6 SBN 0 #30 [INTRODUCES A STREAM NAME
69PQ BZE 0 STREM [J IF (
6=9B NORML DOWN NORMALUS,1 [SET UP A OABSNB FOR WHAT SHOULD0 BE
6=P2 TESTREPN OK,RONG [A NORMAL QUALIFIED NAME
6?8L MFREE CPB,CUNI
6?N= BRN XIT
6#7W STREM FREECORE 1 [FREE LAST CUNI BLOCK
6#MG STREM1
6*76 LDN 5 1 [POINTER TO FIRST COMPONENT
6*LQ PARANEXT ,,5 [REMOVE PARENTHESES
6*WJ ... TESTREP2 TOOMANY,MESSB
6B6B CALL 1 TESTPAIR
6BL2 ADN 6 1 [STEP ANALYSIS LEVEL
6C5L HUNT 2,CPB,CUNI [TEST 1ST CHAR OF PARAM FOR A MUMERIC
6CK= LDX 4 ANUM(2)
6D4W BZE 4 MESSA [BRANCH IF NULL PARAMETER
6DJG LDX 4 APARA(2)
6F46 FREECORE 2
6FHQ LDN 3 0
6G3B SLL 34 6 [X3 CONTAINS FIRST CHARACTER
6GH2 SRL 4 18 [X4 CONTAINS 2ND CHARACTER
6H2L SBN 3 #12
6HG= BNG 3 POZIT [BRANCH IF SERIAL NUMBER
6H^W SBN 3 #16
6JFG BNZ 3 TRONG [MUST BE (
6J^6 SBN 4 10
6KDQ BPZ 4 MESSA [ (MUST BE FOLLOWED BY T.S.N.
6KYB BRN STREM1
6LD2 SERQA SMO FX2
6LXL LDEX 0 AWORK1
6MC= SBX 6 0
6MWW SBN 6 2
6NBG #SKI K6NORMALUS>599-599
6NW6 TRACE 6,ANALEV
6P*Q BNG 6 XIT [J TO EXIT IF NO QUALIFIERS
6PTB SMO FX2
6Q*2 LDEX 6 EXPEDIENT [ANALEV OF OUALIFIERS
6QSL ADN 6 2 [TWO HIGHER THAN THAT ON ENTRY
6R#= DOWN NORMALUS,5
6RRW TESTREP NAMEFORM,RONG [J IF ANY FORMAT ERROR
6S?G BRN XIT
6SR6 MESSA
6T=Q ACROSS NORMERR,17
6TQB TESTPAIR
6W=2 TESTREP UNPAIR,XUNPAIR
6WPL EXIT 1 0
6X9= XUNPAIR
6XNW ACROSS NORMERR,18
6Y8G TRONG1
6YN6 ACROSS NORMERR,19
6^7Q SRONG4
6^MB ACROSS NORMERR,89
6^SJ ...MESSB
6^^Q ... ACROSS NORMERR,34
7272 [
72LL MENDAREA 30,K99DECODE
736= #END
^^^^ ...01527374000200000000