{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: WLAA867)}}
====== WLAA867 ======
(George Source)
**Macros used:** [[george:macro:ABANDCOM|ABANDCOM]], [[george:macro:ACROSS|ACROSS]], [[george:macro:ALTLENG|ALTLENG]], [[george:macro:AND|AND]], [[george:macro:BC|BC]], [[george:macro:BITDEFS|BITDEFS]], [[george:macro:BS|BS]], [[george:macro:BXE|BXE]], [[george:macro:BXU|BXU]], [[george:macro:CLOSE|CLOSE]], [[george:macro:COMERR|COMERR]], [[george:macro:DO|DO]], [[george:macro:ELSE|ELSE]], [[george:macro:ELSF|ELSF]], [[george:macro:ENDCOM|ENDCOM]], [[george:macro:FI|FI]], [[george:macro:FNORM|FNORM]], [[george:macro:FREECORE|FREECORE]], [[george:macro:HUNT|HUNT]], [[george:macro:HUNT2J|HUNT2J]], [[george:macro:IF|IF]], [[george:macro:IFR|IFR]], [[george:macro:JBC|JBC]], [[george:macro:JBS|JBS]], [[george:macro:JMBAC|JMBAC]], [[george:macro:MBS|MBS]], [[george:macro:MFREE|MFREE]], [[george:macro:MHUNT|MHUNT]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:NAMETOP|NAMETOP]], [[george:macro:OPENSYS|OPENSYS]], [[george:macro:OR|OR]], [[george:macro:PARABEG|PARABEG]], [[george:macro:PARAFREE|PARAFREE]], [[george:macro:PARALYSE|PARALYSE]], [[george:macro:PARANUMB|PARANUMB]], [[george:macro:PARFNAME|PARFNAME]], [[george:macro:PARUNACC|PARUNACC]], [[george:macro:PHOTO|PHOTO]], [[george:macro:PROPERTY|PROPERTY]], [[george:macro:PROPUNAC|PROPUNAC]], [[george:macro:REPEAT|REPEAT]], [[george:macro:REWIND|REWIND]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETREP2|SETREP2]], [[george:macro:SETUPCORE|SETUPCORE]], [[george:macro:SPARABEG|SPARABEG]], [[george:macro:SPARANOX|SPARANOX]], [[george:macro:STEP|STEP]], [[george:macro:TESTREP2|TESTREP2]], [[george:macro:THEN|THEN]], [[george:macro:VFREE|VFREE]], [[george:macro:WHILE|WHILE]]
22FL #SEG WLAA
22^= #OPT K0WLAA=0
23DW #LIS K0WLAA>K0ALLGEO>K0GREATGEO
23YG 8HWLAA
24D6 SEGENTRY K1WLAA,WLAAK1 [ROUTING AND LEVEL ANALYSIS
24XQ [
25CB [
25X2 [ CODING CONVENTIONS: ONLY X1 PTS TO APERI/APROPS
26BL [ ONLY X2 PTS TO APERI/APRNUM
26W= [ APERI/CONSOLE
27*W [ CPB/CUNI
27TG [ CPAT
28*6 [ ONLY X3 PTS TO ADATA/AWHATLIST HEAD
28SQ [ (X1 MAY PT TO INNER WDS)
29#B [ THESE MAY NOT BE ADHERED TO IN THE SUBROUTINES
29S2 [
2=?L [
2=R= [ THE FOLLOWING BIT IDENTIFIERS ARE RELEVANT TO A CPAT BLOCK
2?=W [
2?QG BITDEFS CONTEXT,19,WBUOPCON,,,WBNUCON,WBUCON
2#=6 [
2#PQ [ THEY ARE THE OPS' CONSOLE, NOUSER AND USER CONTEXT
2*9B [ BITS RESPECTIVELY
2*P2 [
2B8L [
2BN= [ PRESET DATA
2C7W [ ===========
2CMG [
2D76 SEGENTRY K90WLAA [AMENDED BY 'USERCHURGE'
2DLQ PUSERSTOP +1 [STOP USER 'TOUR' 1 => TRUE
2F6B [
2FL2 SEGENTRY K91WLAA [AMENDED BY 'WLNARROW'
2G5L PNARROW +2 [ 2 => NARROW IF CENTRAL OPERATOR'S
2GK= [ CONSOLE UNDER EMULATION
2H4W [ 1 => NARROW IF CENTRAL OPERATOR'S
2HJG [ CONSOLE
2J46 [ 0 => OFF - NEVER NARROW
2JHQ [ -VE => ALL - ALWAYS NARROW
2K3B PVAL1 +1
2KH2 PVAL2 +2
2L2L PVAL3 +3
2LG= PVAL4 +4
2L^W MAGIC 7036875
2MFG PSTRCOLON 4H:
2M^6 PSTRSTAR 4H*
2NDQ PSTRUSER 8HUSER :
2NYB PSTRFULL 8HFULL
2PD2 PSTRLIST 8HLIST
2PXL PSTRHERE 8HHERE
2QC= PSTRFILE 8HFILE
2QWW PSTRDOCU 8HDOCU
2RBG PSTRDM 8HDM
2RW6 PSTRDOCUMEN 8HDOCUMENT
2S*Q PSTRTOPR 8HTOPR
2STB PSTRTOUR 8HTOUR
2T*2 PSTRJOB 4HJOB
2TSL PERITYPE 4HCP
2W#= 4HLP
2WRW 4HTP
2X?G PROPERTY 8HPROPERTY
2XR6 PSTRPR 4HPR
2Y=Q PCT 0
2YQB #FID CBCT,CBCT,1
2^=2 [
2^PL [
329= [ SUBROUTINE 'SUBAREPROPS'
32NW [ ========================
338G [
33N6 [ THIS SUBROUTINE CHECKS WHETHER A GIVEN PROPERTY STRING IS DRASTICALLY
347Q [ WRONG. IF IT IS, A REPLY IS SET, ELSE AN APERI/APRNUM BLOCK IS SET UP
34MB [ CONTAINING THE PROPERTY NUMBERS(B0=>CONSOLE, B1=>PERMANENT)
3572 [
35LL [ ENVIRONMENT REQUIRED:-
366= [ APERI/APROPS BLOCK EXISTS
36KW [ ADATA/CREADL DETAILS BLOCK EXISTS
375G [ X1=GSIGN (MUST FIND DEFAULT PROPERTY)
37K6 [ 0 (DEFAULT IS CONSPROP OF PREVIOUS APROPS)
384Q [
38JB [ ENVIRONMENT CHANGES:-
3942 [ X0 LINK - KEPT IN AWORK1 THROUGHOUT
39HL [ X2:=FX2
3=3= [ X1,X3->X7,AWORK1->AWORK4 DESTROYED
3=GW [ REPLY XPROP,CPROPS,MAXATT OR OK GIVEN
3?2G [ APERI/APRNUM SET UP
3?G6 [ DETAILS BLOCK UPDATED TO INCLUDE 'PR' DETAILS
3?^Q [ AWORK2 SET NON-ZERO IF BREAKIN BEFORE SYSPER OPENED
3#FB [
3#^2 PRCENTRAL 4H 001 [PROPNO WD FOR 'CENTRAL' IN SYSPROP
3*DL SUBAREPROPS
3*Y= SBX 0 FX1
3BCW ADX 0 1
3BXG LDX 2 FX2
3CC6 STO 0 AWORK1(2) [STORE LINK
3CWQ MHUNT 1,APERI,APROPS
3DBB LDX 7 A1+1(1) [X7 := CT OF PROPNAMES
3DW2 STO 7 AWORK3(2) [AWORK3 := EXPECTED PROP COUNT
3F*L LDN 6 ATTMAX
3FT= SBX 6 7
3G#W BNG 6 TOOMANYPRS [IF TOO MANY PROPNAMES, ERR FI
3GSG ADN 7 2 [X7 := LOGLEN OF APERI/APRNUM
3H#6 SETUPCORE 7,2,APERI,APRNUM
3HRQ SBN 7 2
3J?B STOZ A1(2) [COUNT OF PROPNOS := 0
3JR2 STOZ A1+1(2) [CLEAR CONSPROP WD (ASSUME NO CONSPROP)
3K=L OPENSYS UBROKEIN,PROPERTY,READ,CAREFUL
3KQ= IF 7,NZ [IF PR PARAM (I.E. NOT JUST REMOTE)
3L9W THEN
3LPG WHILE TRUE
3M96 STEP [FOR EACH :SYSTEM.PROPERTY RECORD
3MNQ MHUNT 1,APERI,APROPS
3N8B MHUNTW 2,APERI,APRNUM
3NN2 AND 3,NZ
3P7L AND +A1(2),U,A1+1(1) [UNTIL ALL REQUIRED NAMES FOUND
3PM= DO [DO
3Q6W SMO FX2
3QLG STOZ AWORK2 [ZERO => 1ST PARAM
3R66 LDX 5 APROPNAME(3)
3RKQ LDX 6 APROPNAME+1(3)
3S5B LDX 7 APROPNAME+2(3) [X5->7:=THAT PROPNAME
3SK2 LDX 4 A1+1(1) [USING X4 AS LOOP CONTROLLER,
3T4L ADN 1 A1+2 [FOR EACH NAME IN /APROPS DO
3TJ= DO
3W3W TXU 5 1(1)
3WHG TXU 6 2(1)
3X36 TXU 7 3(1)
3XGQ IF CC [IF THAT NAME=NAME IN SYSPROP
3Y2B THEN
3YG2 NGNC 5 1 [THEN DESTROY NAME IN X5->X7
3Y^L ANDX 5 APROPNO(3) [SET UP NON-CONSOLE PROPNO
3^F= SMO FX1
3^YW IF 5,E,PRCENTRAL [IF CENTRAL
42DG THEN
42Y6 LDX 5 GSIGN [THEN PROPNO:=JUST SIGN B
43CQ ELSF +APROPGROUP(3),NG [ELSF CONSPROP
43XB THEN
44C2 ORX 5 GSIGN [THEN SET CONSOLE BIT
44WL FI [FI
45B= IF 5,NG [IF CENTRAL OR CONSPROP THEN
45TW THEN
46*G LDX 7 A1+1(2)
46T6 BNZ 7 TWOCONSOLE [IF 2ND CONSPROP THEN ERR
47#Q STO 5 A1+1(2) [PUT CONSPROP ON /APRNUM
47SB SMO FX2
48#2 IF +AWORK2,NZ [IF NOT 1ST NAME IN PARAM
48RL THEN
49?= LDX 7 1 [X7 KEEPS PTR
49QW SMO FX2
4==G LDN 1 ACOMMUNE1
4=Q6 LDN 0 2
4?9Q MOVE 0 6 [PRESERVE TOP 6 X'S
4?PB MHUNT 1,APERI,APROPS
4#92 LDX 0 A1+1(1)
4#NL SMO FX2
4*8= STO 0 ACOMMUNE3 [STORED X4 => 1ST PARA
4*MW LDN 6 A1+2(1) [X6 -> START OF 1ST CE
4B7G LDX 1 7
4BM6 SBN 1 1 [X1 -> END OF PREV CEL
4C6Q LDX 0 1(1) [X0 := CHARCT FOR CONS
4CLB DO [MOVE OTHER NAMES DOWN
4D62 LDX 5 0(1)
4DKL STO 5 4(1)
4F5= SBN 1 1
4FJW REPEAT UNTIL,1,L,6
4G4G STO 0 1(1) [PUT CONSPROP CT IN 1S
4GJ6 LDN 5 APROPNAME(3)
4H3Q LDN 6 2(1)
4HHB MOVE 5 3 [PUT CONSPROP NAME IN
4J32 LDN 6 A1+2(2) [X6 -> 1ST PROPNO WD
4JGL SMO FX2
4K2= LDX 1 AWORK3
4KFW ADX 1 6
4K^G SBX 1 4 [X1 -> CURRENT PROPNO
4LF6 WHILE 6,L,1 [FOR PROPNOS ABOVE CUR
4LYQ DO
4MDB SBN 1 1
4MY2 LDX 0 0(1) [SHIFT PROPNOS DOWN
4NCL STO 0 1(1)
4NX= REPEAT [REPEAT
4PBW SMO FX2
4PWG LDN 0 ACOMMUNE1
4QB6 LDN 1 2
4QTQ MOVE 0 6 [RESTORE TOP 6 X'S
4R*B LDX 1 7 [RESTORE PTR
4RT2 FI [FI FIRST NAME
4S#L FI [FI CENTRAL OR CONSPROP
4SS= LDN 6 A1+2(2) [PUT PROPNO INTO PRNUM IN ST
4T?W SMO FX2
4TRG ADX 6 AWORK3
4W?6 SBX 6 4
4WQQ SMO 6
4X=B STO 5 0
4XQ2 LDN 4 1 [ENSURE APROPS LOOP TERMINAT
4Y9L ADS 4 A1(2) [AND USE X4 TO UPDATE APRNUM
4YP= LDX 5 APROPNAME(3)
4^8W LDX 6 APROPNAME+1(3)
4^NG LDX 7 APROPNAME+2(3) [RESET NAME IN X5->7
5286 FI [FI
52MQ ADN 1 4
537B SMO FX2
53M2 STO 1 AWORK2
546L REPEAT CT 4 [REPEAT OVER NAMES IN BLOCK
54L= REPEAT [REPEAT OVER SYSPROP RECORDS
555W LDX 5 A1(2)
55KG MHUNT 1,APERI,APROPS
5656 BXU 5 A1+1(1),PROPUNK [IF NOT ALL NAMES FOUND,ERR FI
56JQ LDN 1 A1+2(2)
574B LDN 3 A1+2(2)
57J2 LDX 5 A1(2) [FOR ALL PROPNOS DO
583L IF 5,NZ
58H= THEN
592W DO
59GG LDX 0 0(1)
5=26 IF 0,PZ [IF NON-CONSOLE THEN
5=FQ THEN
5=^B STO 0 0(3) [PUT BACK IN BLOCK
5?F2 ADN 3 1
5?YL ELSE [ELSE
5#D= LDN 0 1
5#XW SBS 0 A1(2) [CORRECT NON-CONSOLE COUNT
5*CG FI [FI
5*X6 ADN 1 1
5BBQ REPEAT CT 5
5BWB FI [REPEAT
5CB2 FI [FI
5CTL MHUNTW 1,APERI,APRNUM
5D*= MHUNTW 3,ADATA,AWHATLIST
5DSW IF +A1+1(1),ZE [IF NO CONSPROP IN PARAM
5F#G LDX 4 AWLCONS(3)
5FS6 AND 4,NZ [BUT ONE TO FIND (I.E. REMOTE)
5G?Q THEN
5GRB ANDX 4 BSP16
5H?2 LDCT 2 #600
5HQL ORX 2 4 [ENSURE CONSOLE, PERMANENT SET
5J== STO 2 A1+1(1) [UPDATE PRNUM
5JPW LDX 2 FX2
5K9G LDX 0 AWORK1(2)
5KP6 IF 0,NG [IF LOOKING FOR DEFAULT
5L8Q THEN
5LNB REWIND
5M82 DO
5MML STEP
5N7= LDX 0 BSP16
5NLW ANDX 0 APROPNO(3)
5P6G REPEAT UNTIL,0,E,4 [X3 -> ENTRY
5PL6 LDCT 1 #600
5Q5Q ADN 1 APROPNAME+2(3) [X1 -> LAST CHAR OF NAME
5QKB WHILE TRUE
5R52 LDCH 0 0(1)
5RJL SBN 0 #20
5S4= AND 0,ZE
5SHW DO
5T3G SLC 1 2
5TH6 SBN 1 1
5W2Q SRC 1 2
5WGB REPEAT [X1 -> LAST NON-SPACE CHAR
5X22 SBN 1 APROPNAME(3)
5XFL SLC 1 2
5X^= LDN 4 APROPNAME(3)
5YDW LDN 6 1(1) [X6 := CHARCT
5YYG MHUNT 3,APERI,APROPS
5^D6 ELSE
5^XQ MHUNT 3,APERI,APROPS
62CB HUNT2J 1,APERI,APROPS,3,(GEOERR)
62X2 LDN 4 A1+3(1)
63BL LDX 6 A1+2(1)
63W= FI
64*W SMO FX2
64TG LDN 5 AWORK2
65*6 MOVE 4 3
65SQ LDX 7 A1(3)
66#B ADN 7 4
66S2 PHOTO 5
67?L ALTLENG 3,7,REFIND
67R= IF 5,U,BCOUNT
68=W THEN
68QG MHUNT 2,APERI,APROPS
69=6 ELSE
69PQ LDX 2 3
6=9B FI
6=P2 STO 7 A1(2) [UPDATE HDDR WD
6?8L LDX 0 A1+1(2)
6?N= SLL 0 2 [X0 := CT OF WDS TO MOVE DOWN
6#7W LDN 1 1
6#MG ADS 1 A1+1(2) [UPDATE PROPCT WD
6*76 LDN 1 A1+1(2)
6*LQ ADX 1 0 [X1 -> LAST WD TO BE MOVED
6B6B IF 0,NZ
6BL2 THEN
6C5L DO
6CK= LDX 7 0(1)
6D4W STO 7 4(1)
6DJG SBN 1 1
6F46 REPEAT CT 0 [BLOCK MOVED DOWN
6FHQ FI
6G3B STO 6 A1+2(2)
6GH2 SMO FX2
6H2L LDN 4 AWORK2
6HG= LDN 5 A1+3(2)
6H^W MOVE 4 3 [FIRST CELL INSERTED
6JFG ELSF +A1+1(1),E,GSIGN [ELSF 'CENTRAL' 1ST ELT THEN
6J^6 THEN
6KDQ MHUNT 2,APERI,APROPS
6KYB STOZ A1+2(2) [ZERO THE CT WD
6LD2 FI [FI FIND CONSPROP
6LXL CLOSE
6MC= SETREP2 OK
6MWW BRN XITISPROP [NORMAL EXIT
6NBG UBROKEIN
6NW6 LDX 2 FX2
6P*Q STO 2 AWORK2(2) [BREAKIN EXIT
6PTB BRN XITBROKEN
6Q*2 TOOMANYPRS [ERROR EXITS FOLLOW
6QSL LDX 2 FX2
6R#= SETREP2 MAXATT
6RRW BRN XITISPROP
6S?G TWOCONSOLE
6SR6 CLOSE
6T=Q SETREP2 CPROPS
6TQB BRN XITISPROP
6W=2 PROPUNK
6WPL CLOSE
6X9= SETREP2 XPROP
6XNW XITISPROP
6Y8G STOZ AWORK2(2)
6YN6 XITBROKEN
6^7Q LDX 0 AWORK1(2)
6^MB ADX 0 FX1
7272 ANDX 0 BITS22LS
72LL EXIT 0 0
736= [
73KW [
745G [ THE MAXIMUM SIZE OF DETAILS THAT MAY BE GIVEN IS :-
74K6 [ (:<12 CHAR USER>, <12 CHAR JOB>, *, PR , FILE <37
754Q [ I.E. (ATTMAX*13) - 1 + 83 CHARS
75JB [ HENCE NUMBER OF WORDS NEEDED TO HOLD INFO :-
7642 #DEF MAXMESSWDS=ATTMAX*13+85/4
76HL [ THIS #DEF MUST ALSO BE MADE IN WLA & WLB
773= [
77GW [
782G [ SUBROUTINE 'SEPARATE'
78G6 [ =====================
78^Q [
79FB [ THIS SUBROUTINE FINDS THE SELECTION DETAILS (ADATA/CREADL)
79^2 [ BLOCK, ADDS A SEPARATOR CHARACTER AND LEAVES PTRS TO ADD THE
7=DL [ PARAMETER ITSELF
7=Y= [
7?CW [ ENVIRONMENT REQUIRED:-
7?XG [ ADATA/CREADL EXISTS WITH PTR TO NEXT FREE CHAR IN A1+1
7#C6 [
7#WQ [ ENVIRONMENT CHANGES:-
7*BB [ X0 DESTROYED
7*W2 [ X1 -> NEXT FREE CHAR
7B*L [ X3 -> HEAD OF BLOCK
7BT= [ X7 LINK
7C#W [
7CSG SEPARATE
7D#6 MHUNT 3,ADATA,CREADL
7DRQ LDX 1 A1+1(3)
7F?B SBN 1 A1+2
7FR2 IF 1,ZE [IF FIRST PARAM THEN
7G=L THEN
7GQ= LDN 0 #30 [SEPARATOR := '('
7H9W ADN 1 A1+2(3)
7HPG ELSE [ELSE
7J96 ADN 1 A1+2(3)
7JNQ LDN 0 #34
7K8B DCH 0 0(1) [PUT IN ','
7KN2 BCHX 1 £
7L7L LDN 0 #20 [FOLLOWED BY ' '
7LM= FI
7M6W DCH 0 0(1) [INSERT SEPARATOR
7MLG BCHX 1 £
7N66 EXIT 7 0
7NKQ [
7P5B [
7PK2 [ SUBROUTINE 'SUBADDPAR'
7Q4L [ ======================
7QJ= [
7R3W [ THIS SUBROUTINE ADDS THE CONTENTS OF A CPB/CUNI TO THE END OF THE
7RHG [ SELECTION DETAILS BLOCK
7S36 [
7SGQ [ ENVIRONMENT REQUIRED:-
7T2B [ X1,X3 AS LEFT BY 'SEPARATE'
7TG2 [ X2 -> CPB/CUNI WITH NON-ZERO CHAR CT
7T^L [
7WF= [ ENVIRONMENT CHANGES:-
7WYW [ X0,X1 DESTROYED
7XDG [ X7 LINK
7XY6 [ PTR WD OF BLOCK UPDATED
7YCQ [
7YXB SUBADDPAR
7^C2 LDN 0 APARA(2)
7^WL SMO ANUM(2)
82B= MVCH 0 0
82TW SBX 1 3
83*G STO 1 A1+1(3)
83T6 EXIT 7 0
84#Q [
84SB [
85#2 [ SUBROUTINE 'SUBENDETAIL'
85RL [ ========================
86?= [
86QW [ THIS SUBROUTINE CLOSES THE ADATA-CREADL DETAILS BLOCK
87=G [
87Q6 [ ENVIRONMENT REQUIRED:-
889Q [ X3 -> CREADL
88PB [
8992 [ ENVIRONMENT CHANGES:-
89NL [ X0 DESTROYED
8=8= [ X1 := CHARCT OF MESSAGE
8=MW [ X2 := LOGLEN OF BLOCK
8?7G [ X7 LINK
8?M6 [
8#6Q SUBENDETAIL
8#LB LDX 1 A1+1(3)
8*62 LDN 0 #31
8*KL SMO 3
8B5= DCH 0 0(1) [PUT ON ')'
8BJW BCHX 1 £
8C4G SLC 1 2
8CJ6 SBN 1 A1+2*4
8D3Q STO 1 A1(3) [STORE CHAR CT
8DHB LDN 2 11(1) [ADD 2 WDS AND ROUND UP
8F32 SRL 2 2
8FGL EXIT 7 0
8G2= [
8GFW [
8G^G REFIND
8H5C ... MHUNT 2,APERI,APROPS
8H9# ... EXIT 1 0
8H*9 ...REFINDC
8HF6 MHUNT 2,ADATA,CREADL
8HYQ EXIT 1 0
8JDB [
8JY2 [
8KCL [
8KX= [ SUBROUTINE 'SUBPARAM'
8LBW [ =====================
8LWG [
8MB6 [ DOES A SPARABEG, HUNTS THE CUNI IN X2 AND THE
8MTQ [ AWHATLIST IN X3
8N*B [
8NT2 [ REQUIRED:- X3 = LENGTH OF KEY
8P#L [ X1 -> KEY
8PS= [ X7 LINK
8Q?W [
8QRG [ CHANGES:- X2 -> CPB/CUNI JUST SET UP
8R?6 [ X3 -> ADATA/AWHATLIST
8RQQ [
8S=B SUBPARAM
8SQ2 SBX 7 FX1
8T9L SPARABEG 1,3,0(1),,0
8TP= MHUNT 2,CPB,CUNI
8W8W MHUNTW 3,ADATA,AWHATLIST
8WNG ADX 7 FX1
8X86 EXIT 7 0
8XMQ [
8Y7B [ SUBROUTINE 'SUBFNORM'
8YM2 [ =====================
8^6L [
8^L= [ RENAMES CUNI TO FNAME AND PERFORMS THE NECESSARY
925W [ RITUALS AND TIDYING REQUIRED TO DO A FNORM 5
92KG [
9356 [ REQUIRES:- CUNI EXISTS
93JQ [ X7 LINK
944B [
94J2 SUBFNORM
953L SBX 7 FX1
95H= NAMETOP 2,FILE,FNAME [RENAME /CUNI
962W LDN 0 #7777
96GG ANDS 0 ANUM(2) [CLEARED FOR PARFNAME
9726 PARFNAME
97FQ FNORM 5 [SET UP A /FABSNB
97^B VFREE CPB,CMULTI
98F2 ADX 7 FX1
98YL EXIT 7 0
99D= [
99XW [
9=CG [ SUBROUTINE 'SETWKFILE'
9=X6 [ ======================
9?BQ [
9?WB [ FREES ANY ADJUNCTS BLOCK, HUNTS AWHATLIST AND FNAME,
9#B2 [ AND SETS WKFILE BIT (DOCUMENT IS A BETTER NAME FOR IT)
9#TL [
9**= [ REQUIRES:- AWHATLIST, FNAME EXIST
9*SW [ X7 LINK
9B#G [
9BS6 [ CHANGES:- X3 -> AWHATLIST
9C?Q [ X2 -> FNAME
9CRB [
9D?2 SETWKFILE
9DQL SBX 7 FX1
9F== VFREE FILE,ADJUNCTS
9FPW MHUNTW 3,ADATA,AWHATLIST
9G9G BS 3,AWLBWKFILE [SET WORKFILE BIT
9GP6 MHUNT 2,FILE,FNAME
9H8Q ADX 7 FX1
9HNB EXIT 7 0
9J82 [
9JML [
9K7= [ SUBROUTINE 'SUBGETSPACE'
9KLW [ ========================
9L6G [
9LL6 [ ENSURES SUFFICIENT SPACE IN DETAILS BLOCK FOR DOCUMENT NAME
9M5Q [
9MKB [ REQUIRES:- X2 -> FNAME BLOCK (THIS IS RESTORED ON EXIT)
9N52 [ X7 LINK
9NJL [
9P4= SUBGETSPACE
9PHW SBX 7 FX1
9Q3G MHUNT 3,ADATA,CREADL
9QH6 LDX 1 A1+1(3)
9R2Q SBN 1 A1+2
9RGB SLC 1 2 [X1 := CHARCT OF DETAILS SO FAR
9S22 LDN 4 MAXMESSWDS*4
9SFL SBN 4 8(1) [X4 := CHARS LEFT FOR FILENAME
9S^= [(LEAVES SPACE FOR ', FILE )'
9TDW [ ASSUMES 'FILE' TO BE LAST
9TYG [ SELECTION PARAM TO BE LOOKED FOR
9WD6 IF 4,L,ANUM(2) [IF NOT ENOUGH SPACE THEN
9WXQ THEN
9XCB SBX 4 ANUM(2)
9XX2 NGX 4 4 [X4 := EXTRA CHARS NEEDED
9YBL ADN 4 MAXMESSWDS*4+11
9YW= SRL 4 2 [X4 := TOTAL WDS NEEDED
9^*W ... ALTLENG 3,4,REFINDC
9^TG MHUNT 2,FILE,FNAME
=2*6 FI [FI
=2SQ ADX 7 FX1
=3#B EXIT 7 0
=3S2 [
=4?L [
=4R= [ SUBROUTINE 'SUBLOSETRAP'
=5=W [ ========================
=5QG [
=6=6 [ FREES ALL FILE-FTRAP BLOCKS
=6PQ [ LINK X7
=79B [
=7P2 SUBLOSETRAP
=88L SBX 7 FX1
=8N= WHILE TRUE [FREE ALL /FTRAPS BLOCKS
=97W HUNT 1,FILE,FTRAP
=9MG AND 1,PZ
==76 DO
==LQ FREECORE 1
=?6B REPEAT
=?L2 ADX 7 FX1
=#5L EXIT 7 0
=#K= [
=*4W [
=*JG [ WW WW W
=B46 [ WW WW WW
=BHQ [ WW WW WWW
=C3B [ WWWW WW
=CH2 [ WWWWW WW
=D2L [ WW WW WW
=DG= [ WW WW WW
=D^W [ WW WW WW
=FFG [
=F^6 [
=GDQ WLAAK1
=GYB [ LOOK FOR 'DOCU'
=HD2 [
=HXL LDX 1 FX1
=JC= LDN 6 8
=JWW WHILE TRUE
=KBG LDX 3 6
=KW6 ADN 1 PSTRDOCUMEN
=L*Q CALL 7 SUBPARAM
=LTB AND +ANUM(2),NG
=M*2 DO
=MSL FREECORE 2
=N#= SRL 6 1
=NRW SBX 1 6
=P?G REPEAT UNTIL,6,ZE [TRY FOR 'DOCUMENT', 'DOCU' OR 'DM'
=PR6 IF 6,NZ [IF ANY FOUND THEN
=Q=Q THEN
=QQB BZE 0 ZNULLPAR
=R=2 JBS Z2MANY,3,AWLBFILE
=RPL JMBAC ZNOUSERNAM,3,AWLBUSERNAM,AWLBJOBNO
=S9= CALL 7 SUBFNORM [CHECK NAME FORMAT
=SNW TESTREP2 NAMEFORM,ZENDCOM
=T8G IF REP2,OK [IF FABSNB SET UP THEN
=TN6 THEN
=W7Q MFREE FILE,FABSNB [FREE IT
=WMB FI [FI
=X72 CALL 7 SETWKFILE [SET WORKFILE BIT
=XLL CALL 7 SUBGETSPACE [PUT DOCUMENT NAME IN DETAILS
=Y6= CALL 7 SEPARATE
=YKW LDX 0 FX1
=^5G ADN 0 PSTRDM
=^K6 MVCH 0 3
?24Q CALL 7 SUBADDPAR
?2JB CALL 7 SUBLOSETRAP
?342 FI [FI
?3HL [
?43= [ CLOSE DETAILS BLOCK
?4GW [
?52G MHUNT 3,ADATA,CREADL
?5G6 LDX 1 A1+1(3)
?5^Q SBN 1 A1+2
?6FB IF 1,ZE [IF NO PARAMS THEN
?6^2 THEN
?7DL FREECORE 3 [LOSE BLOCK
?7Y= ELSE [ELSE
?8CW CALL 7 SUBENDETAIL
?8XG ALTLENG 3,2
?9C6 FI [FI
?9WQ [
?=BB [ ASSERTION:
?=W2 [ ADDITIONAL DATA WHICH MAY NOW BE IN ADATA/AWHATLIST:-
??*L [ FILE BIT (WHEN FILE/FABSNB CHAINED), OR
??T= [ WKFILE BIT (WHEN FILE/FNAME CHAINED)
?##W MHUNTW 3,ADATA,AWHATLIST
?#SG IF MBAC,3,AWLBWL,AWLBUSERCON
?*#6 THEN [IF SL OR CH IN OP FORMAT THEN
?*RQ JMBAC ZNOSELN,3,AWLBUSERNAM,AWLBJOBNO,AWLBPERI,AWLBPRPARAM,AWL-
?B?B BFILE,AWLBWKFILE [ERRIF NO SELECTION PARAMS
?BR2 FI [FI
?C=L [
?CQ= [ LOOK FOR 'HERE'
?D9W PARABEG 1,PVAL4(1),PSTRHERE(1),,0
?DPG MHUNT 2,CPB,CUNI
?F96 IF +ANUM(2),PZ [IF 'HERE' PRESENT
?FNQ THEN
?G8B BNZ 0 ZDUFFPAR
?GN2 MHUNTW 3,ADATA,AWHATLIST
?H7L BS 3,AWLBHERE [THEN SET HERE BIT
?HM= FI [FI
?J6W FREECORE 2
?JLG [
?K66 [ LOOK FOR 'LIST' PARAMETER
?KKQ [ LEAVE %(PR) IN ONLY CUNI WHEN GO ACROSS
?L5B [ TO WHATLISA, OR NO CUNI IF NO QUALIFIER TO 'LIST'
?LK2 [
?M4L SPARABEG 1,PVAL4(1),PSTRLIST(1),,0
?MJ= MHUNT 2,CPB,CUNI
?N3W LDX 7 ANUM(2)
?NHG IF 7,PZ [IF 'LIST' PRESENT
?P36 THEN
?PGQ MHUNTW 3,ADATA,AWHATLIST
?Q2B JBS ZHL,3,AWLBHERE [THEN IF LIST + HERE, ERR FI
?QG2 MBS 3,AWLBFULL,AWLBLIST [SET FULL & LIST BITS
?Q^L IF 7,NZ [IF PROPERTY STRING
?RF= THEN
?RYW LDX 3 JPARNUM(2)
?SDG PARALYSE ,,3 [THEN SPLIT INTO "LIST" AND (PR PA
?SY6 #UNS ANSTOOMANY
?TCQ (
?TXB TESTREP2 UNPAIR,ZLISTWR,TOOMANY,ZMAXPAR
?WC2 )
?WWL #UNS ANSTOOMANY
?XB= #SKI
?XTW TESTREP2 UNPAIR,ZLISTWR [IF UNPAIRED DELIM, ERR FI
?Y*G PARANUMB 4
?YT6 BXU 4 PVAL2(1),ZLISTWR [IF NOT TWO PARAMS, ERR FI
?^#Q LDN 1 2
?^SB PARALYSE ,,1 [STRIP BRACKETS OFF PARAM 2
#2#2 #UNS ANSTOOMANY
#2RL TESTREP2 TOOMANY,ZMAXPAR
#3?= LDN 7 8
#3QW DO
#4=G SPARABEG 1,7,PROPERTY(1) [LOOK FOR 'PR' PARAM
#4Q6 MHUNT 2,CPB,CUNI
#59Q LDX 6 ANUM(2)
#5PB IF 6,PZ [IF PR PARAM FOUND
#692 THEN
#6NL BNZ 6 NXTLISFND [EXIT IF OK
#78= BRN ZWRQUAL [ERROR IF NULL
#7MW FI
#87G FREECORE 2 [ELSE
#8M6 SRL 7 2 [TRY AGAIN FI
#96Q BZE 7 ZWRQUAL [IF NO 'PR...' FOUND , ERROR FI
#9LB REPEAT
#=62 NXTLISFND
#=KL HUNT2J 2,CPB,CUNI,,(GEOERR) [FIND 'LIST' CUNI
#?5= FREECORE 2 [FREE IT (KEPT IN CASE OF ERR MESS
#?JW MHUNTW 3,ADATA,AWHATLIST
##4G BS 3,AWLBLISTPR [SET PROPERTY BIT
##J6 PARAFREE [FREE CMULTI ANYWAY
#*3Q BRN NOTLIST
#*HB FI [FI
#B32 FI [FI
#BGL FREECORE 2
#C2= NOTLIST
#CFW [
#C^G [ LOOK FOR 'FULL'
#DF6 [
#DYQ PARABEG 1,PVAL4(1),PSTRFULL(1),,0
#FDB MHUNT 2,CPB,CUNI
#FY2 MHUNTW 3,ADATA,AWHATLIST
#GCL IF +ANUM(2),PZ [IF 'FULL' PRESENT THEN
#GX= THEN
#HBW BNZ 0 ZDUFFPAR
#HWG BS 3,AWLBFULL [SET 'FULL'
#JB6 IF MBAC,3,AWLBLIST,AWLBHERE [IF NO ROUTING GIVEN
#JTQ THEN
#K*B IF BC,3,AWLBUSERCON [IF OPERATOR OR OP COMMAND
#KT2 THEN
#L#L BS 3,AWLBLIST [SET 'LIST'
#LS= ELSE [ ELSE (USER)
#M?W BS 3,AWLBHERE [SET 'HERE'
#MRG FI [FI
#N?6 FI [FI
#NQQ ELSE [ELSE
#P=B BC 3,AWLBHERE [ENSURE 'HERE' NOT SET WITHOUT 'FULL'
#PQ2 FI [FI
#Q9L FREECORE 2
#QP= [
#R8W [ ASSERTION:
#RNG [ ADDITIONAL DATA WHICH MAY NOW BE IN ADATA/AWHATLIST-
#S86 [ A) FULL FLAG
#SMQ [ B) ONE OF LIST AND HERE FLAGS - MANDATORY
#T7B [ C) QUALIFIER FLAG (IN WHICH CASE A CPB/CUNI
#TM2 [ CONTAINING THE QUALIFIER STRING EXISTS).
#W6L [
#WL= MHUNTW 3,ADATA,AWHATLIST
#X5W IF BS,3,AWLBCH [IF CHANGELIST THEN
#XKG THEN
#Y56 [
#YJQ [ LOOK FOR 'TOUR' IF CHANGELIST
#^4B [
#^J2 SPARABEG 1,PVAL4(1),PSTRTOUR(1),,0
*23L MHUNT 2,CPB,CUNI
*2H= LDX 7 ANUM(2)
*32W IF 7,PZ
*3GG THEN
*426 MHUNTW 3,ADATA,AWHATLIST
*4FQ IF +PUSERSTOP(1),NZ [IF USER 'TOUR' STOPPED THEN
*4^B THEN
*5F2 JBS ZURINUSER,3,AWLBUSERCON [ERRIF URGE IN USER CONTEXT
*5YL FI [FI
*6D= BZE 7 ZNULLPAR [ERRIF NULL
*6XW SBN 7 1
*7CG BNZ 7 ZFORMERR [ERRIF MORE THAN ONE CHAR
*7X6 LDCH 7 APARA(2)
*8BQ SBN 7 #73
*8WB BPZ 7 ZFORMERR [ERRIF > 'Z'
*9B2 ADN 7 #73-#41
*9TL BNG 7 ZFORMERR [ERRIF < 'A'
*=*= ADN 7 #41
*=SW STO 7 AWLURGE(3)
*?#G BS 3,AWLBURGE
*?S6 FI
*#?Q FREECORE 2
*#RB [
**?2 [ LOOK FOR 'TOPR' IF CHANGELIST
**QL [
*B== PROPUNAC NOPRPARAM,ZPRNULL,PVAL4(1),PSTRTOPR(1)
*BPW LDN 1 0
*C9G CALL 0 SUBAREPROPS
*CP6 LDX 0 AWORK2(2)
*D8Q BNZ 0 ZBRKIN [IF BREAKIN, ABANDON COMMAND
*DNB TESTREP2 XPROP,ZNOSCHPROP [ELSF UNKNOWN PROPERTY, ERR
*F82 TESTREP2 MAXATT,Z2MANYPRPS [ELSF TOO MANY PROPERTIES, ERR
*FML TESTREP2 CPROPS,Z2CONSOLE [ELSF TWO CONSOLE PROPERTIES, ERR
*G7= MHUNTW 3,ADATA,AWHATLIST [FI
*GLW JBS ZTOURTOPR,3,AWLBURGE [ERRIF URGE GIVEN TOO
*H6G MFREE CPB,CUNI
*HL6 BRN TOPRDONE
*J5Q NOPRPARAM
*JKB MHUNTW 3,ADATA,AWHATLIST
*K52 JBC ZNOACTION,3,AWLBURGE
*KJL TOPRDONE
*L4= FI [FI
*LHW [
*M3G [ ERROR IF ANY UNACCESSED PARAMETERS
*MH6 [
*N2Q PARUNACC
*NGB MHUNT 2,CPB,CUNI
*P22 LDX 7 ANUM(2)
*PFL IF 7,PZ
*P^= THEN
*QDW BZE 7 ZNULLPAR [IF PARAM NULL THEN ERR FI
*QYG LDX 7 APARA(2) [(ELSE REPEATED OR UNKNOWN)
*RD6 MHUNTW 3,ADATA,AWHATLIST
*RXQ LDN 6 PSTRTOPR-PSTRUSER/2 [TEST 4-CHAR KEY REPETITION
*SCB IF BS,3,AWLBCH
*SX2 THEN
*TBL LDN 6 PSTRJOB-PSTRUSER/2
*TW= FI
*W*W DO
*WTG BXE 7 PSTRUSER(1),ZKEYRPT
*X*6 ADN 1 2
*XSQ REPEAT CT 6
*Y#B LDX 1 FX1
*YS2 NGN 6 1
*^?L SLL 6 6
*^R= ANDX 7 6
B2=W ADN 7 #20
B2QG BXE 7 PSTRJOB(1),ZKEYRPT [ONLY 3-CHAR KEY IS 'JOB'
B3=6 SLL 6 6
B3PQ ANDX 7 6
B49B ADN 7 #2020
B4P2 BXE 7 PSTRPR(1),ZKEYRPT [ONLY 2-CHAR KEYS ARE 'PR'
B58L BXE 7 PSTRDM(1),ZKEYRPT [AND 'DM'
B5N= SLL 6 6
B67W ANDX 7 6
B6MG LDX 5 ACES
B776 SRL 5 6
B7LQ ADX 7 5
B86B BXE 7 PSTRCOLON(1),ZKEYRPT [TEST ONE-CHAR KEYS
B8L2 BXE 7 PSTRSTAR(1),ZKEYRPT
B95L BRN ZUNRECOG [UNKNOWN PARAM SINCE NOT REPEATED KEY
B9K= FI
B=4W FREECORE 2 [KEEP 'LIST(PR)' STR AS ONLY CUNI
B=JG [
B?46 [ CHECK WHETHER NARROW FORMAT TO BE USED
B?HQ [
B#3B MHUNTW 3,ADATA,AWHATLIST [X3 -> ADATA/AWHATLIST
B#H2 LDX 4 PNARROW(1) [X4 = CODE VALUE FOR WHEN TO USE NARROW
B*2L LDN 5 0 [X5 SET NZ IF TO USE NARROW FORMAT
B*G= IF 4,NZ [IF NARROW NOT TOTALLY SUPPRESSED
B*^W AND BS,3,AWLBFULL [AND FULL OUTPUT LEVEL IS TO BE USED
BBFG THEN [THEN (CODE IS 1,2 OR -VE AT THIS POINT)
BB^6 IF 4,NG [IF CODE = ALL (-VE)
BCDQ THEN [THEN
BCYB LDN 5 1 [WILL USE NARROW FORMAT
BDD2 ELSE [ELSE (CODE IS 1 OR 2)
BDXL [THESE CODES ONLY LEAD TO NARROW
BFC= [FORMAT FOR CENTRAL OPERATOR
BFWW [COMMANDS WITH "FULL,HERE"
BGBG [IF CENTRAL OPERATOR FULL,HERE
BGW6 IF MBAS,3,AWLBOPER,AWLBHERE
BH*Q AND +JSOURCE3(2),ZE [(AWLBREM CLEARED BETWEEN K4-K5)
BHTB THEN [THEN
BJ*2 SBN 4 1
BJSL IFR 4,ZE [IF CODE=1 (OPERATOR)
BK#= OR ENVNOT,1900 [OR EMUL'N (AND CODE=2)
BKRW THEN [THEN
BL?G LDN 5 1 [WILL USE NARROW FORMAT
BLR6 FI [FI
BM=Q FI [FI CENTRAL OPERATOR FULL,HERE
BMQB FI [FI CODE = ALL
BN=2 FI [FI FULL LEVEL AND NARROW POSSIBLE
BNPL [
BP9= IF 5,NZ
BPNW THEN
BQ8G BS 3,AWLBNARROW
BQN6 FI
BR7Q [
BRMB [
BS72 [
BSLL ACROSS WLC,1
BT6= [
BTKW [ ERROR LABELS
BW5G [ ============
BWK6 [
BX4Q ZNOUSERNAM
BXJB ... COMERR JPARMIS,JUSNA [USER NAME MISSING
BY42 ZNOSELN
BYHL ... COMERR JPARMIS,JSELECTION
B^3= ZENDCOM
B^GW ENDCOM
C22G ZTRACEREP
C2G6 COMERR JMTRACE
C2^Q ZNOACTION
C3FB COMERR JPARMIS,ACTION
C3^2 ZWRQUAL
C4DL COMERR BADQUAL [ERROR IN 'LIST' QUALIFIER
C4Y= ZDUFFPAR
C5CW LDX 3 2
C5XG SPARANOX JPARNUM(3)
C6C6 ZFORMERR
C6WQ ZUNRECOG
C7BB ZLISTWR
C7W2 COMERR APFERR [PARAM FORMAT ERROR
C8*L ZTOURTOPR
C8T= Z2MANY
C9#W ZHL
C9SG ZKEYRPT
C=#6 COMERR ASCOMBER [ILLEGAL PARAMETER COMBINATION
C=RQ ZBRKIN
C??B ABANDCOM [ABANDONED DUE TO BREAKIN
C?R2 ZNOSCHPROP
C#=L COMERR JPROPUNK [UNKNOWN PROPERTY
C#Q= Z2MANYPRPS
C*9W COMERR JPERR2 [TOO MANY PROPS
C*PG Z2CONSOLE
CB96 COMERR JPERR3 [TWO CONSOLE PROPS
CBNQ ZNOTOWNED
CC8B COMERR CONSNOTOWN [REMOTE OP ASKS ABT OTHER CONSPROP
CCN2 ZURINUSER
CD7L COMERR JFORMCNTXT,JCOM
CDM= ZNULLPAR
CF6W ZPRNULL
CFLG COMERR JNULLPAR
CG66 ZWRCNTXT
CGKQ COMERR JCONTINC,JNUNOP [NO-USER, NOT-OPERATOR
CH5B #UNS ANSTOOMANY
CHK2 (
CJ4L ZMAXPAR
CJJ= COMERR JMAXPAR
CK3W )
CKHG #END
^^^^ ...014140770002