{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: WLA867)}}
====== WLA867 ======
(George Source)
**Macros used:** [[george:macro:ABANDCOM|ABANDCOM]], [[george:macro:ACROSS|ACROSS]], [[george:macro:ALTLENG|ALTLENG]], [[george:macro:AND|AND]], [[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:DX|DX]], [[george:macro:ELSE|ELSE]], [[george:macro:ELSF|ELSF]], [[george:macro:FCJOB|FCJOB]], [[george:macro:FI|FI]], [[george:macro:HUNT2J|HUNT2J]], [[george:macro:HUNTMISB|HUNTMISB]], [[george:macro:IF|IF]], [[george:macro:JBC|JBC]], [[george:macro:JBS|JBS]], [[george:macro:MFREE|MFREE]], [[george:macro:MHUNT|MHUNT]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:OPENSYS|OPENSYS]], [[george:macro:OPSCON|OPSCON]], [[george:macro:PHOTO|PHOTO]], [[george:macro:PROPERTY|PROPERTY]], [[george:macro:REPEAT|REPEAT]], [[george:macro:REWIND|REWIND]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:SETREP2|SETREP2]], [[george:macro:SETUPCORE|SETUPCORE]], [[george:macro:SPARANOX|SPARANOX]], [[george:macro:STEP|STEP]], [[george:macro:TESTRACE|TESTRACE]], [[george:macro:TESTREP2|TESTREP2]], [[george:macro:TESTRPN2|TESTRPN2]], [[george:macro:THEN|THEN]], [[george:macro:VFREE|VFREE]], [[george:macro:WHILE|WHILE]]
22FL #SEG WLA [DEVT - STIG TOWNSEND
22^= #OPT K0WLA=0
23DW #LIS K0WLA>K0ALLGEO>K0GREATGEO
23YG 8HWLA
24D6 SEGENTRY K1WLA,WLAK1 [WHATLIST COMMAND
24XQ SEGENTRY K2WLA,WLAK2 [STOPLIST COMMAND
25CB SEGENTRY K3WLA,WLAK3 [CHANGELIST COMMAND
25X2 SEGENTRY K4WLA,WLAK4 ['PR' PARAM ANALYSIS
26W= [
27*W [
27TG [ CODING CONVENTIONS: ONLY X1 PTS TO APERI/APROPS
28*6 [ ONLY X2 PTS TO APERI/APRNUM
28SQ [ APERI/CONSOLE
29#B [ CPB/CUNI
29S2 [ CPAT
2=?L [ ONLY X3 PTS TO ADATA/AWHATLIST HEAD
2=R= [ (X1 MAY PT TO INNER WDS)
2?=W [ THESE MAY NOT BE ADHERED TO IN THE SUBROUTINES
2?QG [
2#=6 [
2#PQ [ THE FOLLOWING BIT IDENTIFIERS ARE RELEVANT TO A CPAT BLOCK
2*9B [
2*P2 BITDEFS CONTEXT,19,WBUOPCON,,,WBNUCON,WBUCON
2B8L [
2BN= [ THEY ARE THE OPS' CONSOLE, NOUSER AND USER CONTEXT
2C7W [ BITS RESPECTIVELY
2CMG [
2D76 [
2DLQ [ PRESET DATA
2F6B [ ===========
2FL2 [
2L^W PVAL1 +1
2MFG PVAL2 +2
2M^6 PVAL3 +3
2NDQ PVAL4 +4
2NYB PSTRCOLON 4H:
2PD2 PSTRSTAR 4H*
2PXL PSTRUSER 8HUSER :
2QC= PSTRFULL 8HFULL
2QWW PSTRLIST 8HLIST
2RBG PSTRHERE 8HHERE
2RW6 PSTRFILE 8HFILE
2S*Q PSTRDOCU 8HDOCU
2STB PSTRTOPR 8HTOPR
2T*2 PSTRTOUR 8HTOUR
2TSL PSTRJOB 4HJOB
2W#= PERITYPE 4HCP
2WRW 4HLP
2X?G 4HTP
2XR6 PROPERTY 8HPROPERTY
2Y=Q PSTRPR 4HPR
2YQB PSTRDM 4HDM
2^=2 PCT 0
2^PL #FID CBCT,CBCT,1
329= [
32NW [
338G [ SUBROUTINE 'SUBAREPROPS'
33N6 [ ========================
347Q [
34MB [ THIS SUBROUTINE CHECKS WHETHER A GIVEN PROPERTY STRING IS DRASTICALLY
3572 [ WRONG. IF IT IS, A REPLY IS SET, ELSE AN APERI/APRNUM BLOCK IS SET UP
35LL [ CONTAINING THE PROPERTY NUMBERS(B0=>CONSOLE, B1=>PERMANENT)
366= [
36KW [ ENVIRONMENT REQUIRED:-
375G [ APERI/APROPS BLOCK EXISTS
37K6 [ ADATA/CREADL DETAILS BLOCK EXISTS
384Q [ X1=GSIGN (MUST FIND DEFAULT PROPERTY)
38JB [ 0 (DEFAULT IS CONSPROP OF PREVIOUS APROPS)
3942 [
39HL [ ENVIRONMENT CHANGES:-
3=3= [ X0 LINK - KEPT IN AWORK1 THROUGHOUT
3=GW [ X2:=FX2
3?2G [ X1,X3->X7,AWORK1->AWORK4 DESTROYED
3?G6 [ REPLY XPROP,CPROPS,MAXATT OR OK GIVEN
3?^Q [ APERI/APRNUM SET UP
3#FB [ DETAILS BLOCK UPDATED TO INCLUDE 'PR' DETAILS
3#^2 [ AWORK2 SET NON-ZERO IF BREAKIN BEFORE SYSPER OPENED
3*DL [
3*Y= PRCENTRAL 4H 001 [PROPNO WD FOR 'CENTRAL' IN SYSPROP
3BCW SUBAREPROPS
3BXG SBX 0 FX1
3CC6 ADX 0 1
3CWQ LDX 2 FX2
3DBB STO 0 AWORK1(2) [STORE LINK
3DW2 MHUNT 1,APERI,APROPS
3F*L LDX 7 A1+1(1) [X7 := CT OF PROPNAMES
3FT= STO 7 AWORK3(2) [AWORK3 := EXPECTED PROP COUNT
3G#W LDN 6 ATTMAX
3GSG SBX 6 7
3H#6 BNG 6 TOOMANYPRS [IF TOO MANY PROPNAMES, ERR FI
3HRQ ADN 7 2 [X7 := LOGLEN OF APERI/APRNUM
3J?B SETUPCORE 7,2,APERI,APRNUM
3JR2 SBN 7 2
3K=L STOZ A1(2) [COUNT OF PROPNOS := 0
3KQ= STOZ A1+1(2) [CLEAR CONSPROP WD (ASSUME NO CONSPROP)
3L9W OPENSYS UBROKEIN,PROPERTY,READ,CAREFUL
3LPG IF 7,NZ [IF PR PARAM (I.E. NOT JUST REMOTE)
3M96 THEN
3MNQ WHILE TRUE
3N8B STEP [FOR EACH :SYSTEM.PROPERTY RECORD
3NN2 MHUNT 1,APERI,APROPS
3P7L MHUNTW 2,APERI,APRNUM
3PM= AND 3,NZ
3Q6W AND +A1(2),U,A1+1(1) [UNTIL ALL REQUIRED NAMES FOUND
3QLG DO [DO
3R66 SMO FX2
3RKQ STOZ AWORK2 [ZERO => 1ST PARAM
3S5B LDX 5 APROPNAME(3)
3SK2 LDX 6 APROPNAME+1(3)
3T4L LDX 7 APROPNAME+2(3) [X5->7:=THAT PROPNAME
3TJ= LDX 4 A1+1(1) [USING X4 AS LOOP CONTROLLER,
3W3W ADN 1 A1+2 [FOR EACH NAME IN /APROPS DO
3WHG DO
3X36 TXU 5 1(1)
3XGQ TXU 6 2(1)
3Y2B TXU 7 3(1)
3YG2 IF CC [IF THAT NAME=NAME IN SYSPROP
3Y^L THEN
3^F= NGNC 5 1 [THEN DESTROY NAME IN X5->X7
3^YW ANDX 5 APROPNO(3) [SET UP NON-CONSOLE PROPNO
42DG SMO FX1
42Y6 IF 5,E,PRCENTRAL [IF CENTRAL
43CQ THEN
43XB LDX 5 GSIGN [THEN PROPNO:=JUST SIGN B
44C2 ELSF +APROPGROUP(3),NG [ELSF CONSPROP
44WL THEN
45B= ORX 5 GSIGN [THEN SET CONSOLE BIT
45TW FI [FI
46*G IF 5,NG [IF CENTRAL OR CONSPROP THEN
46T6 THEN
47#Q LDX 7 A1+1(2)
47SB BNZ 7 TWOCONSOLE [IF 2ND CONSPROP THEN ERR
48#2 STO 5 A1+1(2) [PUT CONSPROP ON /APRNUM
48RL SMO FX2
49?= IF +AWORK2,NZ [IF NOT 1ST NAME IN PARAM
49QW THEN
4==G LDX 7 1 [X7 KEEPS PTR
4=Q6 SMO FX2
4?9Q LDN 1 ACOMMUNE1
4?PB LDN 0 2
4#92 MOVE 0 6 [PRESERVE TOP 6 X'S
4#NL MHUNT 1,APERI,APROPS
4*8= LDX 0 A1+1(1)
4*MW SMO FX2
4B7G STO 0 ACOMMUNE3 [STORED X4 => 1ST PARA
4BM6 LDN 6 A1+2(1) [X6 -> START OF 1ST CE
4C6Q LDX 1 7
4CLB SBN 1 1 [X1 -> END OF PREV CEL
4D62 LDX 0 1(1) [X0 := CHARCT FOR CONS
4DKL DO [MOVE OTHER NAMES DOWN
4F5= LDX 5 0(1)
4FJW STO 5 4(1)
4G4G SBN 1 1
4GJ6 REPEAT UNTIL,1,L,6
4H3Q STO 0 1(1) [PUT CONSPROP CT IN 1S
4HHB LDN 5 APROPNAME(3)
4J32 LDN 6 2(1)
4JGL MOVE 5 3 [PUT CONSPROP NAME IN
4K2= LDN 6 A1+2(2) [X6 -> 1ST PROPNO WD
4KFW SMO FX2
4K^G LDX 1 AWORK3
4LF6 ADX 1 6
4LYQ SBX 1 4 [X1 -> CURRENT PROPNO
4MDB WHILE 6,L,1 [FOR PROPNOS ABOVE CUR
4MY2 DO
4NCL SBN 1 1
4NX= LDX 0 0(1) [SHIFT PROPNOS DOWN
4PBW STO 0 1(1)
4PWG REPEAT [REPEAT
4QB6 SMO FX2
4QTQ LDN 0 ACOMMUNE1
4R*B LDN 1 2
4RT2 MOVE 0 6 [RESTORE TOP 6 X'S
4S#L LDX 1 7 [RESTORE PTR
4SS= FI [FI FIRST NAME
4T?W FI [FI CENTRAL OR CONSPROP
4TRG LDN 6 A1+2(2) [PUT PROPNO INTO PRNUM IN ST
4W?6 SMO FX2
4WQQ ADX 6 AWORK3
4X=B SBX 6 4
4XQ2 SMO 6
4Y9L STO 5 0
4YP= LDN 4 1 [ENSURE APROPS LOOP TERMINAT
4^8W ADS 4 A1(2) [AND USE X4 TO UPDATE APRNUM
4^NG LDX 5 APROPNAME(3)
5286 LDX 6 APROPNAME+1(3)
52MQ LDX 7 APROPNAME+2(3) [RESET NAME IN X5->7
537B FI [FI
53M2 ADN 1 4
546L SMO FX2
54L= STO 1 AWORK2
555W REPEAT CT 4 [REPEAT OVER NAMES IN BLOCK
55KG REPEAT [REPEAT OVER SYSPROP RECORDS
5656 LDX 5 A1(2)
56JQ MHUNT 1,APERI,APROPS
574B BXU 5 A1+1(1),PROPUNK [IF NOT ALL NAMES FOUND,ERR FI
57J2 LDN 1 A1+2(2)
583L LDN 3 A1+2(2)
58H= LDX 5 A1(2) [FOR ALL PROPNOS DO
592W IF 5,NZ
59GG THEN
5=26 DO
5=FQ LDX 0 0(1)
5=^B IF 0,PZ [IF NON-CONSOLE THEN
5?F2 THEN
5?YL STO 0 0(3) [PUT BACK IN BLOCK
5#D= ADN 3 1
5#XW ELSE [ELSE
5*CG LDN 0 1
5*X6 SBS 0 A1(2) [CORRECT NON-CONSOLE COUNT
5BBQ FI [FI
5BWB ADN 1 1
5CB2 REPEAT CT 5
5CTL FI [REPEAT
5D*= FI [FI
5DSW MHUNTW 1,APERI,APRNUM
5F#G MHUNTW 3,ADATA,AWHATLIST
5FS6 IF +A1+1(1),ZE [IF NO CONSPROP IN PARAM
5G?Q LDX 4 AWLCONS(3)
5GRB AND 4,NZ [BUT ONE TO FIND (I.E. REMOTE)
5H?2 THEN
5HQL ANDX 4 BSP16
5J== LDCT 2 #600
5JPW ORX 2 4 [ENSURE CONSOLE, PERMANENT SET
5K9G STO 2 A1+1(1) [UPDATE PRNUM
5KP6 LDX 2 FX2
5L8Q LDX 0 AWORK1(2)
5LNB IF 0,NG [IF LOOKING FOR DEFAULT
5M82 THEN
5MML REWIND
5N7= DO
5NLW STEP
5P6G LDX 0 BSP16
5PL6 ANDX 0 APROPNO(3)
5Q5Q REPEAT UNTIL,0,E,4 [X3 -> ENTRY
5QKB LDCT 1 #600
5R52 ADN 1 APROPNAME+2(3) [X1 -> LAST CHAR OF NAME
5RJL WHILE TRUE
5S4= LDCH 0 0(1)
5SHW SBN 0 #20
5T3G AND 0,ZE
5TH6 DO
5W2Q SLC 1 2
5WGB SBN 1 1
5X22 SRC 1 2
5XFL REPEAT [X1 -> LAST NON-SPACE CHAR
5X^= SBN 1 APROPNAME(3)
5YDW SLC 1 2
5YYG LDN 4 APROPNAME(3)
5^D6 LDN 6 1(1) [X6 := CHARCT
5^XQ MHUNT 3,APERI,APROPS
62CB ELSE
62X2 MHUNT 3,APERI,APROPS
63BL HUNT2J 1,APERI,APROPS,3,(GEOERR)
63W= LDN 4 A1+3(1)
64*W LDX 6 A1+2(1)
64TG FI
65*6 SMO FX2
65SQ LDN 5 AWORK2
66#B MOVE 4 3
66S2 LDX 7 A1(3)
67?L ADN 7 4
67R= PHOTO 5
68=W ALTLENG 3,7,REFIND
68QG IF 5,U,BCOUNT
69=6 THEN
69PQ MHUNT 2,APERI,APROPS
6=9B ELSE
6=P2 LDX 2 3
6?8L FI
6?N= STO 7 A1(2) [UPDATE HDDR WD
6#7W LDX 0 A1+1(2)
6#MG SLL 0 2 [X0 := CT OF WDS TO MOVE DOWN
6*76 LDN 1 1
6*LQ ADS 1 A1+1(2) [UPDATE PROPCT WD
6B6B LDN 1 A1+1(2)
6BL2 ADX 1 0 [X1 -> LAST WD TO BE MOVED
6C5L IF 0,NZ
6CK= THEN
6D4W DO
6DJG LDX 7 0(1)
6F46 STO 7 4(1)
6FHQ SBN 1 1
6G3B REPEAT CT 0 [BLOCK MOVED DOWN
6GH2 FI
6H2L STO 6 A1+2(2)
6HG= SMO FX2
6H^W LDN 4 AWORK2
6JFG LDN 5 A1+3(2)
6J^6 MOVE 4 3 [FIRST CELL INSERTED
6KDQ ELSF +A1+1(1),E,GSIGN [ELSF 'CENTRAL' 1ST ELT THEN
6KYB THEN
6LD2 MHUNT 2,APERI,APROPS
6LXL STOZ A1+2(2) [ZERO THE CT WD
6MC= FI [FI FIND CONSPROP
6MWW CLOSE
6NBG SETREP2 OK
6NW6 BRN XITISPROP [NORMAL EXIT
6P*Q UBROKEIN
6PTB LDX 2 FX2
6Q*2 STO 2 AWORK2(2) [BREAKIN EXIT
6QSL BRN XITBROKEN
6R#= TOOMANYPRS [ERROR EXITS FOLLOW
6RRW LDX 2 FX2
6S?G SETREP2 MAXATT
6SR6 BRN XITISPROP
6T=Q TWOCONSOLE
6TQB CLOSE
6W=2 SETREP2 CPROPS
6WPL BRN XITISPROP
6X9= PROPUNK
6XNW CLOSE
6Y8G SETREP2 XPROP
6YN6 XITISPROP
6^7Q STOZ AWORK2(2)
6^MB XITBROKEN
7272 LDX 0 AWORK1(2)
72LL ADX 0 FX1
736= ANDX 0 BITS22LS
73KW EXIT 0 0
745G [
74K6 [
754Q [ SUBROUTINE 'SUBPROPOWN'
75JB [ =======================
7642 [
76HL [ THIS SUBROUTINE TESTS A CONSOLE PROPERTY NUMBER TO SEE WHETHER
773= [ IT IS ACCESSIBLE TO THE OPERATOR SOURCE REQUESTING IT.
77GW [
782G [ ENVIRONMENT REQUIRED:-
78G6 [ COMMAND PROCESSING ACTIVITY - NOT CHECKED
78^Q [ LS 15 BITS OF ACOMMUNE1 HOLD REQUESTED CONSOLE PROPERTY
79FB [ X2=FX2
79^2 [
7=DL [ ENVIRONMENT CHANGES:-
7=Y= [ X1 LINK
7?CW [ X2,X5 UNCHANGED
7?XG [ ALL OTHER ACCUMULATORS DESTROYED
7#C6 [
7#WQ [ REPLIES GIVEN:-
7*BB [ OK - PROPERTY ACCESSIBLE
7*W2 [ CANT - CAN'T USE PROPERTY
7B*L [
7BT= [ PARAMETERS REQUIRED:-
7C#W [ NONE
7CSG [
7D#6 SUBPROPOWN
7DRQ SBX 1 FX1
7F?B LDX 6 BSP16
7FR2 ANDX 6 JSOURCE3(2) [X6:=SRCE PROP
7G=L BZE 6 SUBPROK [CENTRAL SOURCE MAY USE ANY
7GQ= LDX 4 BSP16
7H9W ANDX 4 ACOMMUNE1(2) [X4:=REQUESTED PROP
7HPG BXE 6 4,SUBPROK [REMOTE MAY USE ITS OWN
7J96 HUNTMISB 3,APERI,CONSOLE
7JNQ BNG 3 SUBPROK [IF NO REAL REMOTE CONSOLES THEN
7K8B [ALL CLUSTERS USE CENTRAL, SO
7KN2 [MAY ACCESS ALL OTHERS
7L7L STOZ AWORK1(2) [REQ COMMS DEVICE:=SCANNER
7LM= STOZ AWORK2(2) [REQ PROP NOT IN /CONSOLE
7M6W STOZ AWORK3(2) [SRCE COMMS DEVICE:=SCANNER
7MLG STOZ AWORK4(2) [SRCE PROP NOT IN /CONSOLE
7N66 WHILE +A1+1(3),NZ
7NKQ DO [FOR ALL PROPS IN /CONSOLE DO
7P5B ANDX 0 BSP16 [X0:=PROPNO
7PK2 IF 0,E,4 [IF PROPNO=REQ PROP THEN
7Q4L THEN
7QJ= LDX 7 A1+1(3)
7R3W ANDX 7 GSIGN [X7:=+(SCANNER) OR -(7900)
7RHG STO 7 AWORK1(2) [SET REQ COMMS DEVICE
7S36 LDX 7 A1+2(3)
7SGQ STO 7 AWORK2(2) [SET REQ CONS IDE
7T2B ELSF 0,E,6 [ELSF PROPNO=SRCE PROP THEN
7TG2 THEN
7T^L LDX 7 A1+1(3)
7WF= ANDX 7 GSIGN
7WYW STO 7 AWORK3(2) [SET SRCE COMMS DEVICE
7XDG LDX 7 A1+2(3)
7XY6 STO 7 AWORK4(2) [SET SRCE CONS IDE
7YCQ FI [FI
7YXB REPEAT DX 3 [REPEAT
7^C2 OPSCON SUBOPCHK,SUBCOMCHK
7^WL SUBCOMCHK
82B= LDX 6 AWORK1(2) [IF OP COMMAND OR USER THEN
82TW LDX 7 AWORK2(2)
83*G TXU 6 AWORK3(2)
83T6 TXU 7 AWORK4(2) [IF AU'D CONSOLE .NE. REQ'D
84#Q BCS SUBCANT [THEN ERROR
84SB BRN SUBPROK [ELSE OK FI
85#2 SUBOPCHK
85RL LDCT 7 #200
86?= ANDX 7 JSOURCE2(2)
86QW IF +AWORK1(2),NG [ELSF REQ ON 7900 THEN
87=G THEN
87Q6 BZE 7 SUBCANT [IF SRCE NOT ON 7900, ERR FI
889Q LDX 7 JSOURCE2(2)
88PB SLL 7 12 [X7:=GEOGNO:0
8992 LDX 6 JSOURCE1(2)
89NL ANDN 6 #7777 [X6:=0:IDE
8=8= ADX 7 6 [X7:=GEOGNO:IDE (SRCE)
8=MW BXU 7 AWORK2(2),SUBCANT [IF SRCE CONSOLE .NE. REQ,ERR
8?7G ELSE [ELSE (REQ ON SCANNER)
8?M6 BNZ 7 SUBCANT [IF NOT SCANNER SRCE, ERR FI
8#6Q LDX 7 AWORK2(2)
8#LB SRL 7 12 [X7:=REQ TERM IDE
8*62 LDX 6 JSOURCE1(2)
8*KL SRL 6 6
8B5= ANDN 6 #7777 [X6:=SRCE TERMINAL IDE
8BJW BXU 6 7,SUBCANT [IF DIFFERENT THEN ERR FI
8C4G LDX 7 AWORK2(2)
8CJ6 ANDN 7 #7777 [X7:=REQ LINE NO
8D3Q LDX 6 JSOURCE2(2)
8DHB SRL 6 9
8F32 ANDN 6 #7777 [X6:=SRCE LINE NO
8FGL BXU 6 7,SUBCANT [IF DIFFERENT THEN ERR FI
8G2= FI [FI
8GFW SUBPROK [FI
8G^G SETREP2 OK [CAN USE REQ PROP
8HF6 ADX 1 FX1
8HYQ EXIT 1 0
8JDB SUBCANT
8JY2 SETREP2 CANT [CAN'T USE IT
8KCL ADX 1 FX1
8KX= EXIT 1 0
8LBW [
8LWG [
8MB6 REFIND
8MTQ MHUNT 2,APERI,APROPS
8N*B EXIT 1 0
8NT2 [
8P#L [
8PS= [ SUBROUTINE 'SUBSET'
8Q?W [ ===================
8QRG [
8R?6 [ SETS UP ADATA/CREADL AND ADATA/AWHATLIST BLOCKS
8RQQ [
8S=B [ ENVIRONMENT REQUIRED:-
8SQ2 [ ENTRY FROM COMMAND PROCESSOR
8T9L [
8TP= [ ENVIRONMENT CHANGES:-
8W8W [ BLOCKS SET UP
8WNG [ AWHATLIST INITIALISED WITH CONTEXTS AND DEFAULTS
8X86 [ X7 LINK
8XMQ [
8Y7B [ THE MAXIMUM SIZE OF DETAILS THAT MAY BE GIVEN IS :-
8YM2 [ (:<12 CHAR USER>, <12 CHAR JOB>, *, PR , FILE <37
8^6L [ I.E. (ATTMAX*13) - 1 + 83 CHARS
8^L= [ HENCE NUMBER OF WORDS NEEDED TO HOLD INFO :-
925W #DEF MAXMESSWDS=ATTMAX*13+85/4
92KG [ THIS #DEF MUST ALSO BE MADE IN WLB
9356 [
93JQ SUBSET
944B SBX 7 FX1
94J2 SETNCORE MAXMESSWDS+2,3,ADATA,CREADL
953L LDN 0 A1+2
95H= STO 0 A1+1(3) [SET PTR TO STRING START DISPLACEMENT
962W SETNCORE AWLPRNO+ATTMAX-AWLUSERNAM,3,ADATA,AWHATLIST
96GG LDX 0 ACES
9726 STO 0 AWLUSERNAM(3)
97FQ LDN 5 AWLUSERNAM(3)
97^B LDN 6 AWLUSERNAM+1(3)
98F2 MOVE 5 5 [NULL OUT THE STRING WDS
98YL STOZ AWLPERI(3)
99D= LDN 5 AWLPERI(3)
99XW LDN 6 AWLPERI+1(3)
9=CG MOVE 5 AWLPRNO+ATTMAX-AWLPERI-1 [ZERO OUT THE NUMBER WDS
9=X6 [
9?BQ [ SET CONTEXT BITS (AND JOB DETAILS IF USER CONTEXT)
9?WB [ AND SOURCE CONSOLE PROPERTY IF REMOTE
9#B2 [
9#TL OPSCON SETOPER,SETOPCOM [IF NOT (OP OR OPERATOR)
9**= JBS ZWRCNTXT,2,WBNUCON [IF NOT USER THEN ERROR
9*SW BS 3,AWLBUSERCON [ELSE SET USER CONTEXT
9B#G FCJOB 2,,,CPA [POINT X2 AT JOB BLOCK
9BS6 LDX 0 JOBNUM(2)
9C?Q STO 0 AWLPERI(3) [STORE JOBNO
9CRB LDN 4 JUSER(2)
9D?2 LDN 5 AWLUSERNAM(3)
9DQL CALL 6 SIGCHARS [STORE USERNAME
9F== STO 5 AWLCOUNT(3) [STORE COUNT
9FPW BRN NOTOP [FI
9G9G SETOPER [ELSF OPERATOR CONTEXT
9GP6 BS 3,AWLBOPER [SET OPERATOR BIT
9H8Q BRN NOTOP
9HNB SETOPCOM [ELSE
9J82 BS 3,AWLBOPCOM [SET OP COMMAND BIT
9JML NOTOP [FI
9K7= [
9KLW [ ASSERTION:
9L6G [ AN ADATA/AWHATLIST BLOCK EXISTS, IN THE FORMAT GIVEN ABOVE. THE
9LL6 [ ONLY INFORMATION IT CONTAINS IS ONE BIT SET OUT OF THE SET (USER
9M5Q [ CONTEXT , OPERATOR CONTEXT , OP COMMAND), AND IF USER CONTEXT,
9MKB [ THEN USERNAME BIT IS ALSO SET, AND THE USERNAME SET UP IN THE
9N52 [ ADATA/AWHATLIST
9NJL [
9P4= LDX 2 FX2
9PHW LDX 6 JSOURCE3(2)
9Q3G IF 6,NZ [IF NOT CENTRALLY ISSUED THEN
9QH6 THEN
9R2Q BS 3,AWLBREM [SET REMOTE CONTEXT BIT
9RGB ANDX 6 BSP16
9S22 STO 6 AWLCONS(3) [STORE CONSPROP
9SFL FI [FI
9S^= ADX 7 FX1
9TDW EXIT 7 0
9TYG [
9WD6 SIGCHARS [REQUIRES X45 SET TO MOVE A NAME
9WXQ [ LINK X6
9XCB [RETURNS LENGTH IN X5
9XX2 [
9YBL MOVE 4 3 [COPY NAME OVER
9YW= LDX 1 4
9^*W LDN 5 12 [GET NO. CHARS IN NAME
9^TG WHILE TRUE
=2*6 SLC 1 2
=2SQ SBN 1 1
=3#B SRC 1 2
=3S2 LDCH 0 3(1)
=4?L SBN 0 #20
=4R= AND 0,ZE
=5=W DO
=5QG REPEAT CT 5
=6=6 EXIT 6 0
=6PQ [
=79B [
=7P2 [ ASSERTION:
=88L [ IF THE COMMAND WAS ISSUED IN REMOTE OR CLUSTER CONTEXT THEN THE
=8N= [ REMOTE CONTEXT BIT IS SET, AND THE PROPNO ATTRIBUTED TO THAT CLUSTE
=97W [ CONSOLE IS STORED IN THE ADATA/AWHATLIST
=9MG [
==76 [
==LQ [
=?6B [ WW WW W WWWWWWWW
=?L2 [ WW WW WW WW
=#5L [ WW WW WWW WW
=#K= [ WWWW WW WWW
=*4W [ WWWWW WW WWWWWW WW
=*JG [ WW WW WW WW WW
=B46 [ WW WW WW WW WW
=BHQ [ WW WW WW WWWWWW
=C3B [
=CH2 [
=D2L WLAK1
=DG= CALL 7 SUBSET
=D^W [ENSURE THAT TRACING/REPORTING IS HIGH ENOUGH TO MAKE IT
=FFG [WORTHWHILE CARRYING ON. THE TEST IS ONLY MADE FOR 'WL',
=F^6 [SINCE FOR 'SL' OR 'CH' TO GENERATE THE MESSAGE THEY MUST
=GDQ [TRACE/REPORT NEITHER COMMENT NOR COMERR CATEGORY (THEIR
=GYB [OUTPUT MAY BE EITHER OR BOTH) - BUT IF THEY'RE NOT TRACING
=HD2 [COMERR THEN THEY WON'T GET THE MESSAGE!!!
=HXL IF BC,3,AWLBOPER [IF (OP COMMAND OR USER)
=JC= THEN
=JWW LDX 1 FX1
=KBG TESTRACE PCT(1),ZTRACEREP [ERROR IF LESS
=KW6 FI [FI
=L*Q BS 3,AWLBWL
=LTB BRN YANALYSE
=M*2 WLAK2
=MSL CALL 7 SUBSET
=N#= BS 3,AWLBSL
=NRW BRN YANALYSE
=P?G WLAK3
=PR6 CALL 7 SUBSET
=Q=Q BS 3,AWLBCH
=QQB YANALYSE
=R=2 ACROSS WLB,1
=RPL [
=S9= [
=SNW [ WW WW WW
=T8G [ WW WW WW
=TN6 [ WW WW WW
=W7Q [ WWWW WW WW
=WMB [ WWWWW WWWWWWWW
=X72 [ WW WW WW
=XLL [ WW WW WW
=Y6= [ WW WW WW
=YKW [
=^5G [
=^K6 WLAK4
?24Q [
?2JB LDX 1 GSIGN
?342 CALL 0 SUBAREPROPS
?3HL LDX 0 AWORK2(2)
?43= BNZ 0 ZBRKIN [IF BREAKIN, ABANDON COMMAND
?4GW TESTREP2 XPROP,ZNOSCHPROP [ELSF UNKNOWN PROPERTY, ERR
?52G TESTREP2 MAXATT,Z2MANYPRPS [ELSF TOO MANY PROPERTIES, ERR
?5G6 TESTREP2 CPROPS,Z2CONSOLE [ELSF TWO CONSOLE PROPERTIES, ERR
?5^Q MHUNTW 3,ADATA,AWHATLIST [FI
?6FB MHUNTW 2,APERI,APRNUM
?6^2 LDX 7 A1+1(2)
?7DL IF 7,E,GSIGN [IF 'CENTRAL' SPECIFIED THEN
?7Y= THEN
?8CW STOZ A1+1(2) [FORGET NUMBER
?8XG IF BSC,3,AWLBREM [IF REMOTE THEN
?9C6 THEN
?9WQ STOZ AWLCONS(3) [MAKE CENTRAL
?=BB JBC ZNOTOWNED,3,AWLBUSERCON [IF 'OP' OR OPERATOR, ERR FI
?=W2 FI [FI
??*L BS 3,AWLBPRCENT [SET CENTRAL BIT
??T= ELSF 7,NZ [ELSF CONSOLE PROPERTY GIVEN THEN
?##W THEN [(OTHER THAN CENTRAL (TRAPPED ABOVE))
?#SG ANDX 7 BSP16
?*#6 LDX 6 7
?*RQ BS 3,AWLBPROP [SET 'PR' BIT
?B?B IF BSC,3,AWLBREM [IF REMOTE
?BR2 AND BC,3,AWLBUSERCON [AND NOT USER THEN
?C=L THEN
?CQ= LDX 2 FX2
?D9W STO 6 ACOMMUNE1(2)
?DPG CALL 1 SUBPROPOWN [IF CAN'T USE PROPERTY
?F96 TESTRPN2 OK,ZNOTOWNED [THEN ERROR FI
?FNQ MHUNTW 2,APERI,APRNUM
?G8B MHUNTW 3,ADATA,AWHATLIST
?GN2 LDX 6 A1+1(2)
?H7L ANDX 6 BSP16
?HM= FI [FI
?J6W STO 6 AWLCONS(3) [STORE PROPERTY
?JLG FI [FI
?K66 IF BSC,3,AWLBREM
?KKQ THEN
?L5B BS 3,AWLBPROP
?LK2 FI
?M4L LDN 1 AWLPRNO(3) [X1 := PTR TO PROPS DEST'N
?MJ= LDX 6 A1(2) [X6 := COUNT OF NON-CONSOLE PROPS
?N3W IF 6,NZ [IF NON-CONSOLE PROPS REQUIRED THEN
?NHG THEN
?P36 STO 6 AWLPRCNT(3) [UPDATE TOTAL MAND PROPS
?PGQ BS 3,AWLBPROP [SET 'PR' BIT
?Q2B ADN 2 A1+2 [PT AT /APRNUM PROPNOS
?QG2 DO [COPY PROPS TO AWHATLIST
?Q^L LDX 7 0(2)
?RF= STO 7 0(1)
?RYW ADN 1 1
?SDG ADN 2 1
?SY6 REPEAT CT 6
?TCQ FI [FI
?TXB MFREE APERI,APRNUM
?WC2 VFREE CPB,CUNI
?WWL ACROSS WLB,2
CDM= [
CF6W [ ERROR LABELS
CFLG [ ============
CG66 [
CGKQ ZTRACEREP
CH5B COMERR JMTRACE
CHK2 ZNOACTION
CJ4L COMERR JPARMIS,ACTION
CJJ= ZWRQUAL
CK3W COMERR BADQUAL [ERROR IN 'LIST' QUALIFIER
CKHG ZDUFFPAR
CL36 LDX 3 2
CLGQ SPARANOX JPARNUM(3)
CM2B ZFORMERR
CMG2 ZUNRECOG
CM^L ZLISTWR
CNF= COMERR APFERR [PARAM FORMAT ERROR
CNYW ZTOURTOPR
CPDG ZHL
CPY6 ZKEYRPT
CQCQ COMERR ASCOMBER [ILLEGAL PARAMETER COMBINATION
CQXB ZBRKIN
CRC2 ABANDCOM [ABANDONED DUE TO BREAKIN
CRWL ZNOSCHPROP
CSB= COMERR JPROPUNK [UNKNOWN PROPERTY
CSTW Z2MANYPRPS
CT*G COMERR JPERR2 [TOO MANY PROPS
CTT6 Z2CONSOLE
CW#Q COMERR JPERR3 [TWO CONSOLE PROPS
CWSB ZNOTOWNED
CX#2 COMERR CONSNOTOWN [REMOTE OP ASKS ABT OTHER CONSPROP
CXRL ZURINUSER
CY?= COMERR JFORMCNTXT,JCOM
CYQW ZNULLPAR
C^=G ZPRNULL
C^Q6 COMERR JNULLPAR
D29Q ZWRCNTXT
D2PB COMERR JCONTINC,JNUNOP [NO-USER, NOT-OPERATOR
D2R^ ...#UNS ANSTOOMANY
D2WJ ...(
D2^7 ...ZMAXPAR
D33Q ... COMERR JMAXPAR
D36* ...)
D392 #END
^^^^ ...623376560001