WLB867
(George Source)
Macros used: ABANDCOM, ACROSS, ALTLENG, ALTLENGD, AND, BS, BXE, BXU, CHEKLFN2, CHNUMCOX, CLOSETOP, COMERR, DO, ELSE, ELSF, ENDCOM, FI, FNORM, FREECORE, HUNT, IF, JBC, JBS, JBSS, JMBS, MBS, MFREE, MHUNT, MHUNTW, MONOUTX, NAMETOP, OPENDIR, OR, OUTBLOCN, OUTMESS, OUTMESSX, OUTPARAM, PARAFREE, PARALYSE, PARAPASS, PARFNAME, PARUNACC, PROPERTY, PROPUNAC, REPEAT, SEGENTRY, SETNCORE, SPARABEG, SPARANOT, TESTREP2, TESTRPN2, THEN, TOPFCB2, UNNORM, VFREE, WHILE
- WLB867.txt
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>, *<PERIPH>, PR <PROP&PROP..>, 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 <NAME>)' 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 '*<O/P DEVICE>' 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