{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: WLB867)}}
====== WLB867 ======
(George Source)
**Macros used:** [[george:macro:ABANDCOM|ABANDCOM]], [[george:macro:ACROSS|ACROSS]], [[george:macro:ALTLENG|ALTLENG]], [[george:macro:ALTLENGD|ALTLENGD]], [[george:macro:AND|AND]], [[george:macro:BS|BS]], [[george:macro:BXE|BXE]], [[george:macro:BXU|BXU]], [[george:macro:CHEKLFN2|CHEKLFN2]], [[george:macro:CHNUMCOX|CHNUMCOX]], [[george:macro:CLOSETOP|CLOSETOP]], [[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:IF|IF]], [[george:macro:JBC|JBC]], [[george:macro:JBS|JBS]], [[george:macro:JBSS|JBSS]], [[george:macro:JMBS|JMBS]], [[george:macro:MBS|MBS]], [[george:macro:MFREE|MFREE]], [[george:macro:MHUNT|MHUNT]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:MONOUTX|MONOUTX]], [[george:macro:NAMETOP|NAMETOP]], [[george:macro:OPENDIR|OPENDIR]], [[george:macro:OR|OR]], [[george:macro:OUTBLOCN|OUTBLOCN]], [[george:macro:OUTMESS|OUTMESS]], [[george:macro:OUTMESSX|OUTMESSX]], [[george:macro:OUTPARAM|OUTPARAM]], [[george:macro:PARAFREE|PARAFREE]], [[george:macro:PARALYSE|PARALYSE]], [[george:macro:PARAPASS|PARAPASS]], [[george:macro:PARFNAME|PARFNAME]], [[george:macro:PARUNACC|PARUNACC]], [[george:macro:PROPERTY|PROPERTY]], [[george:macro:PROPUNAC|PROPUNAC]], [[george:macro:REPEAT|REPEAT]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:SPARABEG|SPARABEG]], [[george:macro:SPARANOT|SPARANOT]], [[george:macro:TESTREP2|TESTREP2]], [[george:macro:TESTRPN2|TESTRPN2]], [[george:macro:THEN|THEN]], [[george:macro:TOPFCB2|TOPFCB2]], [[george:macro:UNNORM|UNNORM]], [[george:macro:VFREE|VFREE]], [[george:macro:WHILE|WHILE]]
22FL #SEG WLB [DEVT - STIG TOWNSEND
22^= #OPT K0WLB=0
23DW #LIS K0WLB>K0ALLGEO>K0GREATGEO
23YG 8HWLB
24D6 SEGENTRY K1WLB,WLBK1 [ENTRY FROM WLA AFTER INITIALISING
24XQ SEGENTRY K2WLB,WLBK2 [RETURN FROM 'PR' ANALYSIS
25CB [
25X2 [
26BL [ CODING CONVENTIONS: ONLY X1 PTS TO APERI/APROPS
26W= [ ONLY X2 PTS TO APERI/APRNUM
27*W [ APERI/CONSOLE
27TG [ CPB/CUNI
28*6 [ CPAT
28SQ [ ONLY X3 PTS TO ADATA/AWHATLIST HEAD
29#B [ (X1 MAY PT TO INNER WDS)
29S2 [
2=?L [
2=R= [ PRESET DATA
2?=W [ ===========
2?QG [
2#2# ...PSTRCURR 12HCURRENT JOB
2#=6 MAGIC 7036875
2#PQ PJWLSTOP +JWLSTOP
2*9B PJWLCHANGE +JWLCHANGE
2*P2 PJLISTSUM1 +JLISTSUM1
2B8L PJLISTSUM2 +JLISTSUM2
2BN= PSTRCOLON 4H:
2C7W PSTRSTAR 4H*
2CMG PSTRUSER 8HUSER :
2D76 PSTRFULL 8HFULL
2DLQ PSTRLIST 8HLIST
2F6B PSTRHERE 8HHERE
2FL2 PSTRDOCU 8HDOCU [ ) THESE THREE LINES
2G5L PSTRDM 8HDM [ ) MUST STAY TOGETHER
2GK= PSTRDOCUMEN 8HDOCUMENT [ ) AS A BLOCK
2H4W PSTRFILE 8HFILE
2HJG PSTRTOPR 8HTOPR
2J46 PSTRTOUR 8HTOUR
2JHQ PSTRJOB 4HJOB
2K3B PERITYPE 4HCP
2KH2 4HLP
2L2L 4HTP
2LG= PROPERTY 8HPROPERTY
2L^W PSTRPR 4HPR
2MFG PSTRJOBNO 8HJOBNO
2M^6 [
2NDQ [ THE MAXIMUM SIZE OF DETAILS THAT MAY BE GIVEN IS :-
2NYB [ (:<12 CHAR USER>, <12 CHAR JOB>, *, PR , FILE <37
2PD2 [ I.E. (ATTMAX*13) - 1 + 83 CHARS
2PXL [ HENCE NUMBER OF WORDS NEEDED TO HOLD INFO :-
2QC= #DEF MAXMESSWDS=ATTMAX*13+85/4
2QWW [ THIS #DEF MUST ALSO BE MADE IN WLA
2RBG [
2RW6 [
2S*Q [ SUBROUTINE 'TRANSFER'
2STB [ =====================
2T*2 [
2TSL [ THIS SUBROUTINE MOVES A FILE LOCAL NAME FROM A CPB/CUNI TO THE
2W#= [ ADATA/AWHATLIST BLOCK.
2WRW [
2X?G [ ENVIRONMENT REQUIRED:-
2XR6 [ X2 PTS TO /CUNI
2Y=Q [ X3 PTS TO /AWHATLIST
2YQB [
2^=2 [ ENVIRONMENT CHANGES:-
2^PL [ X1 LINK
329= [ X4,X5 DESTROYED
32NW [
338G [ PARAMETER REQUIRED:-
33N6 [ DISPLACEMENT WITHIN THE /AWHATLIST AT WHICH THE TRANSFER SHOULD
347Q [ COMMENCE
34MB [
3572 TRANSFER
35LL LDN 4 APARA(2) [X4 POINTS DIRECT TO DATA
366= LDX 5 3
36KW ADX 5 0(1) [X5 POINTS TO RECEPTION AREA
375G SMO ANUM(2)
37K6 MVCH 4 0
384Q EXIT 1 1
38JB [
3942 [
39HL [ SUBROUTINE 'SEPARATE'
3=3= [ =====================
3=GW [
3?2G [ THIS SUBROUTINE FINDS THE SELECTION DETAILS (ADATA/CREADL)
3?G6 [ BLOCK, ADDS A SEPARATOR CHARACTER AND LEAVES PTRS TO ADD THE
3?^Q [ PARAMETER ITSELF
3#FB [
3#^2 [ ENVIRONMENT REQUIRED:-
3*DL [ ADATA/CREADL EXISTS WITH PTR TO NEXT FREE CHAR IN A1+1
3*Y= [
3BCW [ ENVIRONMENT CHANGES:-
3BXG [ X0 DESTROYED
3CC6 [ X1 -> NEXT FREE CHAR
3CWQ [ X3 -> HEAD OF BLOCK
3DBB [ X7 LINK
3DW2 [
3F*L SEPARATE
3FT= MHUNT 3,ADATA,CREADL
3G#W LDX 1 A1+1(3)
3GSG SBN 1 A1+2
3H#6 IF 1,ZE [IF FIRST PARAM THEN
3HRQ THEN
3J?B LDN 0 #30 [SEPARATOR := '('
3JR2 ADN 1 A1+2(3)
3K=L ELSE [ELSE
3KQ= ADN 1 A1+2(3)
3L9W LDN 0 #34
3LPG DCH 0 0(1) [PUT IN ','
3M96 BCHX 1 £
3MNQ LDN 0 #20 [FOLLOWED BY ' '
3N8B FI
3NN2 DCH 0 0(1) [INSERT SEPARATOR
3P7L BCHX 1 £
3PM= EXIT 7 0
3Q6W [
3QLG [
3R66 [ SUBROUTINE 'SUBADDNUM'
3RKQ [ ======================
3S5B [
3SK2 [ THIS SUBROUTINE CONVERTS A BINARY NUMBER TO DECIMAL, ADDING IT
3T4L [ TO THE END OF THE SELECTION DETAILS BLOCK, STARTING WITH THE
3TJ= [ FIRST SIGNIFICANT DECIMAL DIGIT
3W3W [
3WHG [ ENVIRONMENT REQUIRED:-
3X36 [ X1,X3 AS LEFT BY 'SEPARATE'
3XGQ [ X5 CONTAINS THE NUMBER
3Y2B [
3YG2 [ ENVIRONMENT CHANGES:-
3Y^L [ X0,1,2,4,5,6 DESTROYED
3^F= [ X7 LINK
3^YW [ PTR WD OF BLOCK UPDATED
42DG [
42Y6 SUBADDNUM
43CQ SMO FX1
43XB MPY 5 MAGIC [X56 := FRACTION FOR CONVERSION
44C2 LDN 0 7
44WL MODE 1 [SUPPRESS LEADING ZEROS
45B= LDN 2 #20
45TW LDN 4 0
46*G DO [FOR ALL NON-SPACES DO
46T6 CBD 5 4
47#Q IF 4,U,2
47SB THEN
48#2 DCH 4 0(1) [PUT IN BLOCK
48RL BCHX 1 £
49?= FI
49QW REPEAT CT 0 [REPEAT
4==G SBX 1 3
4=Q6 STO 1 A1+1(3)
4?9Q EXIT 7 0
4?PB [
4#92 [
4#NL [ SUBROUTINE 'SUBADDPAR'
4*8= [ ======================
4*MW [
4B7G [ THIS SUBROUTINE ADDS THE CONTENTS OF A CPB/CUNI TO THE END OF THE
4BM6 [ SELECTION DETAILS BLOCK
4C6Q [
4CLB [ ENVIRONMENT REQUIRED:-
4D62 [ X1,X3 AS LEFT BY 'SEPARATE'
4DKL [ X2 -> CPB/CUNI WITH NON-ZERO CHAR CT
4F5= [
4FJW [ ENVIRONMENT CHANGES:-
4G4G [ X0,X1 DESTROYED
4GJ6 [ X7 LINK
4H3Q [ PTR WD OF BLOCK UPDATED
4HHB [
4J32 SUBADDPAR
4JGL LDN 0 APARA(2)
4K2= SMO ANUM(2)
4KFW MVCH 0 0
4K^G SBX 1 3
4LF6 STO 1 A1+1(3)
4LYQ EXIT 7 0
4MDB [
4MY2 [
4NCL [ SUBROUTINE 'SUBADDPROPS'
4NX= [ ========================
4PBW [
4PWG [ ADDS PROPERTY STRING TO THE ADATA-CREADL DETAILS BLOCK
4QB6 [
4QTQ [ ENVIRONMENT REQUIRED:-
4R*B [ X1, X3 AS LEFT BY 'SEPARATE'
4RT2 [ APERI/APROPS EXISTS
4S#L [
4SS= [ ENVIRONMENT CHANGES:-
4T?W [ ALL ACCUMULATORS DESTROYED
4TRG [ X7 LINK
4W?6 [
4WQQ SUBADDPROPS
4X=B SBX 7 FX1
4XQ2 MHUNT 2,APERI,APROPS
4Y9L LDN 0 A1+3(2)
4YP= LDX 6 A1+2(2)
4^8W IF 6,ZE [IF CENTRAL 1ST PROP THEN
4^NG THEN
5286 LDN 6 7 [TRUE CHARCT IS 7, NOT ZERO
52MQ FI [FI
537B SMO 6
53M2 MVCH 0 0 [PUT 1ST PROPNAME ON
546L LDX 4 A1+1(2)
54L= SBN 4 1
555W IF 4,NZ [FOR REMAINING NAMES DO
55KG THEN
5656 LDN 2 A1+6(2) [X2 -> 2ND CELL
56JQ LDN 5 #26
574B DO
57J2 DCH 5 0(1) [ADD '&'
583L BCHX 1 £
58H= LDN 0 1(2)
592W SMO 0(2)
59GG MVCH 0 0 [ADD PROPNAME
5=26 ADN 2 4
5=FQ REPEAT CT 4
5=^B FI [REPEAT
5?F2 SBX 1 3
5?YL STO 1 A1+1(3) [CLOSE DETAILS BLOCK
5#D= MHUNT 2,APERI,APROPS
5#XW IF +A1+2(2),ZE
5*CG LDX 0 A1+1(2)
5*X6 SBN 0 1
5BBQ AND 0,ZE [IF ONLY 'CENTRAL' IN APROPS THEN
5BWB THEN
5CB2 FREECORE 2 [FREE IT
5CTL FI [FI
5D*= ADX 7 FX1
5DSW EXIT 7 0
5F#G [
5FS6 [
5G?Q [ SUBROUTINE 'SUBENDETAIL'
5GRB [ ========================
5H?2 [
5HQL [ THIS SUBROUTINE CLOSES THE ADATA-CREADL DETAILS BLOCK
5J== [
5JPW [ ENVIRONMENT REQUIRED:-
5K9G [ X3 -> CREADL
5KP6 [
5L8Q [ ENVIRONMENT CHANGES:-
5LNB [ X0 DESTROYED
5M82 [ X1 := CHARCT OF MESSAGE
5MML [ X2 := LOGLEN OF BLOCK
5N7= [ X7 LINK
5NLW [
5P6G SUBENDETAIL
5PL6 LDX 1 A1+1(3)
5Q5Q LDN 0 #31
5QKB SMO 3
5R52 DCH 0 0(1) [PUT ON ')'
5RJL BCHX 1 £
5S4= SLC 1 2
5SHW SBN 1 A1+2*4
5T3G STO 1 A1(3) [STORE CHAR CT
5TH6 LDN 2 11(1) [ADD 2 WDS AND ROUND UP
5W2Q SRL 2 2
5WGB EXIT 7 0
5X22 [
5XFL [
5X^= REFIND
5YDW MHUNT 2,ADATA,CREADL
5YYG EXIT 1 0
5^D6 [
5^XQ [
62CB [
62X2 [ SUBROUTINE 'SUBPARAM'
63BL [ =====================
63W= [
64*W [ DOES A SPARABEG, HUNTS THE CUNI IN X2 AND THE
64TG [ AWHATLIST IN X3
65*6 [
65SQ [ REQUIRED:- X3 = LENGTH OF KEY
66#B [ X1 -> KEY
66S2 [ X7 LINK
67?L [
67R= [ CHANGES:- X2 -> CPB/CUNI JUST SET UP
68=W [ X3 -> ADATA/AWHATLIST
68QG [
69=6 SUBPARAM
69PQ SBX 7 FX1
6=9B SPARABEG 1,3,0(1),,0
6=P2 MHUNT 2,CPB,CUNI
6?8L MHUNTW 3,ADATA,AWHATLIST
6?N= ADX 7 FX1
6#7W EXIT 7 0
6#MG [
6*76 [
6*LQ [ SUBROUTINE 'SUBPROPUSER'
6B6B [ ========================
6BL2 [
6C5L [ APPENDS THE USERNAME FROM THE ADATA-AWHATLIST TO
6CK= [ THE DETAILS BLOCK AND ADDS A COMMA AND SPACE
6D4W [
6DJG [ REQUIRES:- X2 -> AWHATLIST
6F46 [ X1, X3 AS LEFT BY 'SEPARATE'
6FHQ [ X7 LINK
6G3B SUBPROPUSER
6GH2 LDN 0 #12
6H2L DCH 0 0(1)
6HG= BCHX 1 £
6H^W LDN 0 AWLUSERNAM(2)
6JFG SMO AWLCOUNT(2)
6J^6 MVCH 0 0
6KDQ LDN 0 #34
6KYB DCH 0 0(1)
6LD2 BCHX 1 £
6LXL LDN 0 #20
6MC= DCH 0 0(1)
6MWW BCHX 1 £
6NBG EXIT 7 0
6NW6 [
6P*Q [
6PTB [ SUBROUTINE 'SUBFNORM'
6Q*2 [ =====================
6QSL [
6R#= [ RENAMES CUNI TO FNAME AND PERFORMS THE NECESSARY
6RRW [ RITUALS AND TIDYING REQUIRED TO DO A FNORM 5
6S?G [
6SR6 [ REQUIRES:- CUNI EXISTS
6T=Q [ X7 LINK
6TQB [
6W=2 SUBFNORM
6WPL SBX 7 FX1
6X9= NAMETOP 2,FILE,FNAME [RENAME /CUNI
6XNW LDN 0 #7777
6Y8G ANDS 0 ANUM(2) [CLEARED FOR PARFNAME
6YN6 PARFNAME
6^7Q FNORM 5 [SET UP A /FABSNB
6^MB ... VFREE CPB,CMULTI
72LL ADX 7 FX1
736= EXIT 7 0
73KW [
745G [
74K6 [ SUBROUTINE 'SETWKFILE'
754Q [ ======================
75JB [
7642 [ FREES ANY ADJUNCTS BLOCK, HUNTS AWHATLIST AND FNAME,
76HL [ AND SETS WKFILE BIT (DOCUMENT IS A BETTER NAME FOR IT)
773= [
77GW [ REQUIRES:- AWHATLIST, FNAME EXIST
782G [ X7 LINK
78G6 [
78^Q [ CHANGES:- X3 -> AWHATLIST
79FB [ X2 -> FNAME
79^2 [
7=DL SETWKFILE
7=Y= SBX 7 FX1
7?CW VFREE FILE,ADJUNCTS
7?XG MHUNTW 3,ADATA,AWHATLIST
7#C6 BS 3,AWLBWKFILE [SET WORKFILE BIT
7#WQ MHUNT 2,FILE,FNAME
7*BB ADX 7 FX1
7*W2 EXIT 7 0
7B*L [
7BT= [
7C#W [ SUBROUTINE 'SUBGETSPACE'
7CSG [ ========================
7D#6 [
7DRQ [ ENSURES SUFFICIENT SPACE IN DETAILS BLOCK FOR DOCUMENT NAME
7F?B [
7FR2 [ REQUIRES:- X2 -> FNAME BLOCK (THIS IS RESTORED ON EXIT)
7G=L [ X7 LINK
7GQ= [
7H9W SUBGETSPACE
7HPG SBX 7 FX1
7J96 MHUNT 3,ADATA,CREADL
7JNQ LDX 1 A1+1(3)
7K8B SBN 1 A1+2
7KN2 SLC 1 2 [X1 := CHARCT OF DETAILS SO FAR
7L7L LDN 4 MAXMESSWDS*4
7LM= SBN 4 8(1) [X4 := CHARS LEFT FOR FILENAME
7M6W [(LEAVES SPACE FOR ', FILE )'
7MLG [ ASSUMES 'FILE' TO BE LAST
7N66 [ SELECTION PARAM TO BE LOOKED FOR
7NKQ IF 4,L,ANUM(2) [IF NOT ENOUGH SPACE THEN
7P5B THEN
7PK2 SBX 4 ANUM(2)
7Q4L NGX 4 4 [X4 := EXTRA CHARS NEEDED
7QJ= ADN 4 MAXMESSWDS*4+11
7R3W SRL 4 2 [X4 := TOTAL WDS NEEDED
7RHG ALTLENG 3,4,REFIND
7S36 MHUNT 2,FILE,FNAME
7SGQ FI [FI
7T2B ADX 7 FX1
7TG2 EXIT 7 0
7T^L [
7WF= [
7WYW [ SUBROUTINE 'SUBLOSETRAP'
7XDG [ ========================
7XY6 [
7YCQ [ FREES ALL FILE-FTRAP BLOCKS
7YXB [ LINK X7
7^C2 [
7^WL SUBLOSETRAP
82B= SBX 7 FX1
82TW WHILE TRUE [FREE ALL /FTRAPS BLOCKS
83*G HUNT 1,FILE,FTRAP
83T6 AND 1,PZ
84#Q DO
84SB FREECORE 1
85#2 REPEAT
85RL ADX 7 FX1
86?= EXIT 7 0
86QW [
87=G [
87Q6 [ WW WW W
889Q [ WW WW WW
88PB [ WW WW WWW
8992 [ WWWW WW
89NL [ WWWWW WW
8=8= [ WW WW WW
8=MW [ WW WW WW
8?7G [ WW WW WW
8?M6 [
8#6Q [
8#LB WLBK1
8*62 [
8*KL [ LOOK FOR JOBNO AS %A
8B5= [
8BJW MHUNT 2,CPB,CALAS
8C4G LDX 6 APARANUM(2)
8CJ6 IF 6,NZ
8D3Q THEN
8DHB LDX 6 APARAFIR(2)
8F32 ANDN 6 #7777 [X6 := CHARCT OF %A
8FGL IF 6,NZ
8G2= THEN
8GFW LDCH 0 APARAFIR+1(2)
8G^G SBN 0 #73
8HF6 IF EITHER,0,PZ [IF (CHAR > 'Z' ...
8HYQ ADN 0 #73-#41
8JDB OR 0,NG [... OR CHAR < 'A' )
8JY2 ADN 0 #41-#32
8KCL AND 0,NZ [AND CHAR .NE. '*'
8KX= ADN 0 #32-#12
8LBW AND 0,NZ [AND CHAR .NE. ':' THEN (JOBNO)
8LWG THEN
8MB6 SPARANOT 1
8MTQ CHNUMCOX
8N*B TESTRPN2 OK,ZENDCOM [ERRIF CONVERSION ERROR
8NT2 LDX 5 ACOMMUNE1(2)
8P#L BNG 5 ZJOBNOERR [ERRIF JOBNO NEGATIVE
8PS= BZE 5 ZJOBNOERR [ERRIF JOBNO ZERO
8Q?W MFREE CPB,CUNI [CAN FREE IT AS LAST ERRORCHECK
8QRG MHUNTW 3,ADATA,AWHATLIST
8R?6 STO 5 AWLJOBNAM(3) [REMEMBER JOBNO
8RQQ BS 3,AWLBJOBNO [SET JOBNO BIT
8S=B CALL 7 SEPARATE
8SQ2 LDX 0 FX1
8T9L ADN 0 PSTRJOBNO
8TP= MVCH 0 6
8W8W CALL 7 SUBADDNUM
8WNG FI [FI
8X86 ELSE
8XMQ PARAPASS
8Y7B BRN ZNULLPAR
8YM2 FI [FI
8^6L FI [FI
8^L= [
925W [ LOOK FOR ':USER,JOB' OR 'JOB,:USER' (MAY BE
92KG [ SEPARATED BY OTHER PARAMETERS)
9356 [
93JQ LDX 1 FX1
944B LDN 3 1
94J2 LDN 1 PSTRCOLON(1)
953L CALL 7 SUBPARAM
95H= LDX 7 ANUM(2)
962W IF 7,PZ [IF COLON PRESENT
96GG THEN
9726 JBS ZUINUCON,3,AWLBUSERCON [IF USER CONTEXT, ERR FI
97FQ JBS ZPREVJOBNO,3,AWLBJOBNO [ERRIF PREVIOUS JOBNO
97^B BZE 7 ZNULLUSER
98F2 STO 3 7 [PRESERVE PTR (X3 USED BY CHEKLNF2)
98YL CHEKLFN2 ZNVALNAM,ZNVALNAM,2 [CHECK USERNAME FORMAT
99D= LDX 3 7
99XW CALL 1 TRANSFER [COPY USERNAME TO PARAM BLOCK
9=CG +AWLUSERNAM
9=X6 BS 3,AWLBUSERNAM [SET USER BIT
9?BQ CALL 7 SEPARATE
9?WB LDN 0 #12
9#B2 DCH 0 0(1)
9#TL BCHX 1 £
9**= CALL 7 SUBADDPAR
9*SW FREECORE 2
9B#G PARUNACC [GET JOBNAME (FIRST UNACC PARAM)
9BS6 MHUNT 2,CPB,CUNI
9C?Q CHEKLFN2 ZNOJOBNAM,ZNVALNAM,2 [CHECK JOBNAME FORMAT
9CRB MHUNTW 3,ADATA,AWHATLIST
9D?2 CALL 1 TRANSFER [COPY JOBNAME TO PARAM BLOCK
9DQL +AWLJOBNAM
9F== BS 3,AWLBJOBNAM [SET JOBNAME BIT
9FPW CALL 7 SEPARATE
9G9G CALL 7 SUBADDPAR
9GP6 FI [FI
9H8Q FREECORE 2
9HNB [
9J82 [ LOOK FOR USERNAME GIVEN BY 'USER'
9JML [
9K7= LDN 3 4
9KLW LDN 1 PSTRUSER(1)
9L6G CALL 7 SUBPARAM
9LL6 LDX 1 ANUM(2)
9M5Q IF 1,PZ [IF 'USER' PRESENT THEN
9MKB THEN
9N52 JBSS Z2USERS,3,AWLBUSERNAM [IF PREVIOUS ':'
9NJL JBS Z2USERS,3,AWLBJOBNO [OR PREVIOUS JOBNO THEN ERROR
9P4= [ELSE SET USERNAME BIT
9PHW [FI
9Q3G IF 1,ZE [IF PARAM NULL THEN
9QH6 THEN
9R2Q JBC ZNULLUSER,3,AWLBUSERCON [ERRIF OPERATOR
9RGB STO 2 6
9S22 STO 3 2
9SFL CALL 7 SEPARATE
9S^= LDX 0 FX1
9TDW ADN 0 PSTRUSER
9TYG MVCH 0 6
9WD6 LDN 0 AWLUSERNAM(2)
9WXQ LDX 2 AWLCOUNT(2)
9XCB MVCH 0 0(2) [PUT USERNAME IN DETAILS
9XX2 SBX 1 3
9YBL STO 1 A1+1(3)
9YW= LDX 2 6
9^*W ELSE [ELSE
9^TG LDCH 7 APARA(2)
=2*6 SBN 7 #12
=2SQ IF 7,ZE [IF 'USER :'
=3#B THEN
=3S2 LDX 1 JPARNUM(2)
=4?L PARALYSE #12,,1 [THEN SPLIT AT COLON
=4BQ ...#UNS ANSTOOMANY
=4FW ... TESTREP2 UNPAIR,ZNVALNAM,TOOMANY,ZMAXPAR
=4K2 ...#UNS ANSTOOMANY
=4N6 ...#SKI
=4R= TESTREP2 UNPAIR,ZNVALNAM
=5=W SPARANOT 2 [GET USERNAME (2ND PARAM)
=5QG PARAFREE [FREE CMULTI
=6=6 MHUNT 2,CPB,CUNI [FI
=6PQ FI
=79B CHEKLFN2 ZNULLUSER,ZNVALNAM,2 [CHECK USERNAME FORMAT
=7P2 MHUNTW 3,ADATA,AWHATLIST
=88L IF BS,3,AWLBUSERCON [IF USER CONTEXT THEN
=8N= THEN
=97W LDX 0 AWLCOUNT(3)
=9MG BXU 0 ANUM(2),ZUINUCON [ERRIF NAME LENGTH NE %Z'S
==76 STO 2 6
==LQ STO 3 7
=?6B DO
=?L2 LDCH 4 AWLUSERNAM(3)
=#5L ... LDCH 5 APARA(2)
=#K= BXU 4 5,ZUINUCON [OR ANY CHARS DIFFER
=*4W BCHX 2 £
=*JG BCHX 3 £
=B46 REPEAT CT 0
=BHQ LDX 2 6
=C3B LDX 3 7
=CH2 FI [FI
=D2L CALL 1 TRANSFER [COPY TO PARAM BLOCK
=DG= +AWLUSERNAM [FI
=D^W CALL 7 SEPARATE
=FFG LDX 0 FX1
=F^6 ADN 0 PSTRUSER
=GDQ MVCH 0 6
=GYB CALL 7 SUBADDPAR
=HD2 FI [FI
=HXL FI
=JC= FREECORE 2
=JWW [
=KBG [ LOOK FOR JOBNAME GIVEN BY 'JOB'
=KW6 [
=L*Q LDN 3 3
=LTB LDN 1 PSTRJOB(1)
=M*2 CALL 7 SUBPARAM
=MSL LDX 7 ANUM(2)
=N#= IF 7,PZ [IF 'JOB' PRESENT
=NRW THEN
=P?G JBC ZJOBNUCON,3,AWLBUSERCON [IF NO-USER
=PR6 JBS ZPREVJOBNO,3,AWLBJOBNO [OR PREVIOUS JOBNO THEN ERROR FI
=Q=Q STO 3 7
=QQB CHEKLFN2 ZNULLJOB,ZNVALNAM,2 [CHECK JOBNAME FORMAT
=R=2 LDX 3 7
=RPL CALL 1 TRANSFER [PUT IN PARAM BLOCK
=S9= +AWLJOBNAM
=SNW MBS 3,AWLBJOBNAM,AWLBUSERNAM [SET BITS
=T8G STO 2 6 [PRESERVE CUNI PTR IN X6
=TN6 STO 3 2
=W7Q CALL 7 SEPARATE
=WMB CALL 7 SUBPROPUSER
=X72 LDX 2 6 [RESTORE CUNI PTR TO ADD PARAM
=XLL CALL 7 SUBADDPAR [ADD :USER,JOB TO DETAILS
=Y6= ELSF BS,3,AWLBUSERCON [ELSF USER CONTEXT
=YKW AND MBAC,3,AWLBJOBNO,AWLBUSERNAM [AND NO JOB DETAILS IN PARAMS
=^5G THEN
=^*# ... BS 3,AWLBJOBNO [SELECT ON JOBNO
=^K6 ... LDX 0 AWLPERI(3)
=^SY ... STO 0 AWLJOBNAM(3)
?24Q STO 2 6 [STORE CUNI PTR IN X6
?2JB STO 3 2
?342 CALL 7 SEPARATE
?3HL ... LDX 0 FX1
?43= ... ADN 0 PSTRCURR
?4GW ... MVCH 0 11 [BUT OUTPUT 'CURRENT JOB'
?5G6 SBX 1 3
?5^Q STO 1 A1+1(3) [CLOSE DETAILS BLOCK
?6FB LDX 2 6 [RESTORE CUNI PTR FOR FREECORE
?6^2 FI [FI
?7DL FREECORE 2
?7Y= [
?8CW [ ASSERTION:
?8XG [ ADDITIONAL DATA WHICH MAY NOW BE IN ADATA/AWHATLIST-
?9C6 [ A) USERNAME & FLAG
?9WQ [ B) JOBNAME & FLAG
?=BB [ N.B. A) MAY OCCUR WITHOUT B), BUT NOT IN USER CONTEXT.
?=W2 [ B) WILL NEVER OCCUR WITHOUT A).
??*L [
??T= [
?##W [ LOOK FOR '*' PARAMETER
?#SG [
?*#6 LDN 3 1
?*RQ LDN 1 PSTRSTAR(1)
?B?B CALL 7 SUBPARAM
?BH8 ... STOZ AWLPERI(3) [CLEAR OF ANY JOBNO
?BR2 LDX 7 ANUM(2)
?C=L IF 7,PZ [IF PERIPHERAL TYPE PARAM
?CQ= THEN
?D9W BZE 7 ZNULLPERI
?DC4 ... SBN 7 2
?DJ= ... BNZ 7 ZNOTPERI [MORE THAN TWO CHARS
?DPG LDX 7 APARA(2) [THEN X7 := PERIPHERAL MNEMONIC
?F96 LDN 6 4 [FOR X6:=4,2,1 DO
?FNQ DO
?G8B BXE 7 PERITYPE(1),SETPERI [IF DEVICE TYPE=X6, GOTO SETPERI
?GN2 BUX 1 £
?H7L SRL 6 1
?HM= REPEAT UNTIL,6,ZE [REPEAT
?J6W BRN ZNOTPERI [ERROR (MNEMONIC NOT FOUND)
?JLG SETPERI
?K66 BS 3,AWLBPERI [SET APPROP. BIT
?KKQ DCH 6 AWLPERI(3) [SET PERIPH. TYPE
?L5B CALL 7 SEPARATE
?LK2 LDN 0 #32
?M4L DCH 0 0(1)
?MJ= BCHX 1 £
?N3W CALL 7 SUBADDPAR
?NHG FI [FI
?P36 FREECORE 2
?PGQ [
?Q2B [ ASSERTION:
?QG2 [ ADDITIONAL DATA WHICH MAY NOW BE IN ADATA/AWHATLIST-
?Q^L [ PERIPHERAL TYPE IN B0-B5 OF AWLPERI & FLAG
?RF= [
?RYW [
?SDG [ LOOK FOR 'PR' PARAMETER
?SY6 [
?TCQ PROPUNAC NOPRPARAM,ZPRNULL [IF UNACCESSED 'PR' PARAM THEN
?TXB MHUNTW 3,ADATA,AWHATLIST
?WC2 BS 3,AWLBPRPARAM
?WWL ACROSS WLA,4 [DEAL WITH IT (RETURNS TO WLBK2)
?XB= NOPRPARAM
?XTW MHUNTW 3,ADATA,AWHATLIST
?Y*G IF BS,3,AWLBREM [ELSF REMOTE THEN
?YT6 THEN
?^#Q SETNCORE 6,1,APERI,APROPS
?^SB LDN 0 2
#2#2 STO 0 A1(1)
#2RL STOZ A1+1(1) [SET UP DUMMY PARAM BLOCK
#3?= ACROSS WLA,4 [TO COPE WITH DEFAULT
#3QW [
#4=G WLBK2
#4Q6 [
#59Q CALL 7 SEPARATE [FIND DETAILS BLOCK
#5PB LDN 0 PSTRPR
#692 ADX 0 FX1
#6NL MVCH 0 3 [PUT ON 'PR '
#78= CALL 7 SUBADDPROPS
#7MW FI [FI
#87G [
#8M6 [ ASSERTION:
#96Q [ ADDITIONAL DATA WHICH MAY NOW BE IN ADATA/AWHATLIST-
#9LB [ A) MANDATORY PROPERTY FLAG
#=62 [ B) CENTRAL PROPERTY FLAG
#=KL [ N.B. IF CENTRAL SET, REMOTE IS CLEAR AND NO OPTIONAL
#?5= [ PROPERTIES EXIST (I.E. TOTAL PROP COUNT = MANDATORY
#?JW [ PROP COUNT).
##4G [
##J6 [
#*3Q [ LOOK FOR 'FILE'
#*HB [ LEAVE NAME IN FNAME (WORKFILE) OR 10 WD FABSNB (OTHERWISE)
#B32 [
#BGL [ FNORM 5 IS SPECIAL IN THAT NO FILE/FABSNB IS SET UP IF A WORKFILE
#C2= [ DESCRIPTION IS GIVEN IN THE FILE/FNAME BLOCK. IN THAT CASE,
#CFW [ ONLY A FILE/ADJUNCTS AND REPLY 'ADJUNCTS' ARE GIVEN
#C^G [ N.B. EXTRA INFO IN FGN AND LANG WDS CAN EXIST,BUT ARE NOT
#DF6 [ GIVEN IN /FABSNB SPEC, ONLY IN GETDIR MACRO SPEC (JUL 76).
#DYQ [ THERE IS ALSO A SUSPICION THAT THE TOP BITS OF HDREC ARE
#FDB [ UNRELIABLE - HENCE LDEX RATHER THAN LDX
#FY2 [
#GCL LDX 1 FX1
#GX= LDN 3 4
#HBW LDN 1 PSTRFILE(1)
#HWG CALL 7 SUBPARAM
#JB6 IF +ANUM(2),PZ [IF 'FILE' THEN
#JTQ THEN
#K*B BZE 0 ZNULLFILE [ERRIF NULL PARAM
#KT2 LDN 0 CPREFIX
#L#L ADX 0 FX2
#LS= LDN 1 AWORK1 [PRESERVE CURR USER
#M?W ADX 1 FX2
#MRG MOVE 0 3
#N?6 IF BC,3,AWLBUSERCON [IF NOT USER CONTEXT
#NQQ LDCH 0 APARA(2)
#P=B SBN 0 #12
#PQ2 AND 0,NZ [AND NOT : FILE THEN
#Q9L THEN
#QP= JBC ZNOUSERNAM,3,AWLBUSERNAM [ERRIF NO DEFAULT USER
#R8W LDN 0 AWLUSERNAM(3)
#RNG SMO FX2
#S86 LDN 1 CPREFIX
#SMQ MOVE 0 3 [USE DEFAULT
#T7B FI [FI
#TM2 CALL 7 SUBFNORM
#W6L LDN 0 AWORK1(2)
#WL= LDN 1 CPREFIX(2)
#X5W MOVE 0 3 [RESTORE CURRENT USER
#X*N ... TESTREP2 NAMEFORM,ZENDCOM
#XKG IF REP2,ADJUNCTS [IF WORKFILE
#Y56 THEN
#YJQ CALL 7 SETWKFILE
#^4B CALL 7 SUBGETSPACE
#^J2 CALL 7 SEPARATE
*23L LDX 0 FX1
*2H= ADN 0 PSTRFILE
*32W MVCH 0 5
*3GG CALL 7 SUBADDPAR
*426 ELSE [ELSE (ELSE)
*4FQ MHUNT 2,FILE,FNAME
*4^B NAMETOP 2,CPB,CUNI
*5F2 MHUNT 3,FILE,FABSNB
*5YL JMBS ZWRFILE,3,BFABREEL,BFABTSN [ERRIF TSN, CSN OR RETENTIO
*6D= LDEX 2 HDREC(3)
*6XW SBN 2 4
*7CG BZE 2 ZWRFILE [ERRIF ONLY :USER GIVEN
*7X6 ADN 2 HDREC+2(3) [X2 -> FGN WD
*8BQ LDX 6 0(2)
*8WB LDX 7 1(2) [X67 := FGN-LANG (KEEP THEM)
*9B2 LDCT 0 #700
*9TL ANDX 0 0(2)
*=*= BNZ 0 ZFGNERR [ERRIF RELATIVE OR ZERO FGN
*=SW LDEX 0 HDREC(3)
*?#G SBN 0 10
*?S6 IF 0,NZ [IF NOT 10 WD /FABSNB
*#?Q SBN 2 10
*#RB LDX 0 0(2) [X0 := WD 0 OF PENULT NAME
**?2 ADN 0 6
**QL AND 0,U,ACES [AND ISN'T " :" THEN
*B== THEN
*BPW OPENDIR (GEOERR),READ,QUERY,ERASING
*C9G TESTRPN2 OK,ZOPENERR
*CP6 MFREE FILE,ENT
*D8Q TOPFCB2 1
*DNB ADN 1 FME1 [X1 -> USERNAME IN FCB
*F82 MHUNT 3,FILE,FABSNB
*FML LDEX 2 HDREC(3)
*G7= ADN 2 HDREC(3)
*GLW SBN 2 11 [X2 -> USERNAME AREA IN FABSNB
*H6G MOVE 1 3 [COPY USERNAME TO FABSNB
*HL6 CLOSETOP [UPDATE /FABSNB
*J5Q MHUNT 3,FILE,FABSNB
*JKB FI [FI
*K52 LDEX 0 HDREC(3)
*KJL SBN 0 10
*L4= IF 0,NZ [IF NOT 10 WDS THEN
*LHW THEN
*M3G LDEX 2 HDREC(3)
*MH6 ADN 2 HDREC(3)
*N2Q SBN 2 12 [X2 -> USERNAME CELL
*NGB LDN 4 1(2)
*P22 LDN 5 A1+1(3)
*PFL MOVE 4 3
*P^= LDN 4 6(2)
*QDW LDN 5 A1+4(3)
*QYG MOVE 4 4
*RD6 FI [FI
*RXQ STO 6 A1+8(3) [RESET SPECIFIED FGN
*SCB STO 7 A1+9(3) [AND LANG (X67 FREE)
*SX2 LDN 0 10
*TBL STO 0 HDREC(3) [COMPRESS CONTENTS
*TW= ALTLENGD 3,10 [FREE EXCESS CORE
*W*W MFREE CPB,CUNI
*WTG LDX 2 3
*X*6 CALL 7 SEPARATE
*XSQ LDX 0 FX1
*Y#B ADN 0 PSTRFILE
*YS2 MVCH 0 5
*^?L LDX 5 A1+8(2) [X5 ZERO IF NO FGN
*^R= LDX 6 A1+9(2) [X6 ZERO IF NO LANG
B2=W SBN 1 A1+2(3)
B2QG SLC 1 2
B3=6 STO 1 A1(3) [SET BLOCK INTO TRUE CREADL FORMAT
B3PQ UNNORM FULL
B49B MHUNT 3,ADATA,CREADL
B4P2 LDX 2 A1(3)
B58L IF 6,NZ [IF LANG GIVEN THEN
B5N= THEN
B67W ADN 2 (A1+2)*4
B6MG SRC 2 2 [SET PTR TO PT PAST WHOLE LOT
B776 ELSF 5,ZE [ELSF NO FGN GIVEN EITHER THEN
B7LQ THEN
B86B ADN 2 (A1+2)*4-3
B8L2 SRC 2 2 [SET PTR TO '(' [I.E. LOSE '(/)
B95L ELSE [ELSE (FGN BUT NO LANG)
B9K= ADN 2 (A1+2)*4-2 [PT X2 AT '/'
B=4W SRC 2 2
B=JG LDN 0 #31
B?46 SMO 3
B?HQ DCH 0 0(2) [OVERWRITE BY ')'
B#3B BCHX 2 £ [PT BEYOND IT
B#H2 FI [FI
B*2L STO 2 A1+1(3)
B*G= MHUNTW 3,ADATA,AWHATLIST
B*^W BS 3,AWLBFILE [SET FILENAME MARKER
BBFG FI [FI FILESTORE FILE
BB^6 CALL 7 SUBLOSETRAP
BCDQ ELSE
BCYB FREECORE 2
BDD2 FI [FI 'FILE'
BDMS ... ACROSS WLAA,1
BDXL [
C*PG [
CB96 [ ERROR LABELS
CBNQ [ ============
CC8B [
CCN2 ZNOUSERNAM
CD7L COMERR JPARMIS,JUSNA [USERNAME MISSING
CDM= ZNOJOBNAM
CF6W COMERR JPARMIS,JJOBNA [JOBNAME MISSING
CFLG ZNOSELN
CG66 COMERR JPARMIS,JSELECTION
CGKQ ZNVALNAM
CH5B COMERR JNLFNF [INVALID NAME FORMAT
CHK2 ZNULLJOB
CJ4L ZNULLUSER
CJJ= ZNULLPR
CK3W ZPRNULL
CKHG ZNULLPAR
CL36 ZNULLFILE
CLGQ ZNULLPERI
CM2B COMERR JNULLPAR [NULL PARAMETER GIVEN
CMG2 ZUINUCON
CM^L COMERR JFORMCNTXT,JCOM [FORMAT ILLEGAL IN USER CONTEXT
CNF= ZJOBNUCON
CNYW COMERR JFORMCNTXT,JDIR [FORMAT ILLEGAL IN NO-USER CONTEXT
CPDG ZNOTPERI
CPY6 COMERR JNOTAL [INVALID PERIPH TYPE
CQCQ Z2USERS
CQXB Z2JOBS
CRC2 Z2MANY
CRWL ZPREVJOBNO
CSB= COMERR ASCOMBER [ILLEGAL PARAMETER COMBINATION
CSTW ZBRKIN
CT*G ABANDCOM [ABANDONED DUE TO BREAKIN
CTT6 ZOPENERR
CW#Q MHUNT 2,CPB,CUNI [FILE DOESN'T EXIST - OUTPUT
CWSB NAMETOP 2,FILE,FNAME ['NO LISTFILES' MESSAGE
CX#2 CALL 7 SEPARATE
CXRL LDX 0 FX1
CY?= ADN 0 PSTRFILE
CYQW MVCH 0 5
C^=G CALL 7 SUBADDPAR
C^Q6 CALL 7 SUBENDETAIL
D29Q LDX 7 1
D2PB OUTBLOCN 20
D392 OUTMESS EBPNO
D3NL LDX 6 PJLISTSUM1(1)
D48= MHUNTW 3,ADATA,AWHATLIST
D4MW IF BC,3,AWLBWL
D57G THEN
D5M6 LDX 6 PJLISTSUM2(1)
D66Q LDX 5 PJWLSTOP(1)
D6LB IF BS,3,AWLBCH
D762 THEN
D7KL LDX 5 PJWLCHANGE(1)
D85= FI
D8JW OUTMESSX 5
D94G FI
D9J6 OUTPARAM 7,A1+2,ADATA,CREADL
D=3Q MONOUTX 6
D=HB ZENDCOM
D?32 ENDCOM
D?GL ZJOBNOERR
D#2= COMERR FWHSTAT
D#FW ZFGNERR
D#^G COMERR ERELZERFGN
D*F6 ZWRFILE
D*YQ COMERR ERENTTYPE
DB3* ...#UNS ANSTOOMANY
DB5Y ...(
DB8H ...ZMAXPAR
DB?6 ... COMERR JMAXPAR
DB*P ...)
DBDB #END
^^^^ ...327662140001