{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: WLE862)}}
====== WLE862 ======
(George Source)
**Macros used:** [[george:macro:ALTLEN|ALTLEN]], [[george:macro:AND|AND]], [[george:macro:BACKSPACE|BACKSPACE]], [[george:macro:BC|BC]], [[george:macro:BITDEFS|BITDEFS]], [[george:macro:BS|BS]], [[george:macro:DELETE|DELETE]], [[george:macro:DO|DO]], [[george:macro:DOWN|DOWN]], [[george:macro:ELSE|ELSE]], [[george:macro:ELSF|ELSF]], [[george:macro:FI|FI]], [[george:macro:FREECORE|FREECORE]], [[george:macro:HUNT2|HUNT2]], [[george:macro:HUNTW|HUNTW]], [[george:macro:IF|IF]], [[george:macro:INSERT|INSERT]], [[george:macro:LFCHAIN|LFCHAIN]], [[george:macro:MFREE|MFREE]], [[george:macro:MHUNT|MHUNT]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:NAME|NAME]], [[george:macro:NAMETOP|NAMETOP]], [[george:macro:OR|OR]], [[george:macro:OUTPACK|OUTPACK]], [[george:macro:REPEAT|REPEAT]], [[george:macro:REPLACE|REPLACE]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:SETREP|SETREP]], [[george:macro:SETREP2|SETREP2]], [[george:macro:STARTACT|STARTACT]], [[george:macro:STEP|STEP]], [[george:macro:STEPAGAIN|STEPAGAIN]], [[george:macro:STEPWRITE|STEPWRITE]], [[george:macro:THEN|THEN]], [[george:macro:UP|UP]], [[george:macro:UPPLUS|UPPLUS]], [[george:macro:VFREE|VFREE]], [[george:macro:WHILE|WHILE]], [[george:macro:WRONG|WRONG]]
22FL #OPT K0WLE = 0
22^= #LIS K0WLE
23DW #SEG WLE
23YG 8HWLE
24D6 [
24XQ SEGENTRY K1WLE,WLEK1 [ CHANGELIST PROPERTY ACTION
25CB [
25X2 [
26BL [************************************************************
26W= [
27*W [ PRESET DATA
27TG [
28*6 [************************************************************
28SQ [
29#B BITDEFS CLONG1,2,WBMESSBLK [ USED BY MESSAGE SYSTEM TO INDICATE PR
29S2 [ OF GMON/ASET BLOCK
2=?L PERPERNA +JPERNA [ PERIPHERAL TYPE NOT AVAILABLE
2=R= PERNOPROP +JPROPSNA [ PROPERTY NOT AVAILABLE
2?=W PEREXCL +JNAVEXC [ DUE TO PERMANENT EXCLUSIVE PROPERTIES
2?QG PERTMANY +JPERR2 [ TOO MANY PROPERTIES
2#=6 PERTMCONS +JPERR3 [ TOO MANY CONSOLE PROPERTIES
2#PQ [
2*9B [************************************************************
2*P2 [
2B8L SPRSPLIT
2BN= [
2C7W [************************************************************
2CMG [
2D76 [
2DLQ [ SPLIT PROERTY NAMES IN & FORMAT INTO APERI/APROPS FORMAT
2F6B [
2FL2 [
2G5L [ X1 - BLOCK TO COPY INTO
2GK= [ X2 - LENGTH OF PROPERTY NAMES
2H4W [ X3 - PROPERTY NAMES
2HJG [ X6 - LINK
2J46 [
2JHQ [ ALL ACCUMULATORS EXCEPT X7 DESTROYED
2K3B [
2KH2 LDN 0 ATTMAX
2L2L STO 0 0(1) [ NO. OF NAMES
2LG= ADN 1 1 [ X1 - POSITION FOR NEXT CHAR OF PROPERTY NAME
2L^W STO 1 4 [ X4 - POSITION FOR LENGTH OF NAME
2MFG ADN 1 1
2M^6 LDN 5 0 [ X5 - LENGTH OF NAME
2NDQ WHILE 2,NZ [ CHARACTER LEFT IN NAMES
2NYB DO [ SPLIT AT &
2PD2 LDCH 0 0(3)
2PXL SBN 0 #26
2QC= IF 0,ZE [ &
2QWW THEN
2RBG LDX 1 4
2RW6 STO 5 0(1) [ LENGTH OF NAME
2S*Q ADN 1 5 [ POSITION FOR NEXT NAME
2STB ADN 4 4
2T*2 LDN 5 0
2TSL ELSE
2W#= ADN 0 #26
2WRW DCH 0 0(1) [ COPY CHAR
2X?G BCHX 1 £
2XR6 ADN 5 1
2Y=Q FI
2YQB SBN 2 1
2^=2 BCHX 3 £
2^PL REPEAT
329= SMO 4
32NW STO 5 0 [ LENGTH OF LAST NAME
338G EXIT 6 0
33N6 [
347Q [
34MB [************************************************************
3572 [
35LL SPRREMOVE
366= [
36KW [************************************************************
375G [
37K6 [
384Q [ REMOVE COMMON NAMES BETWEEN NEW PROPERTY RECORD /APROPS AND
38JB [ SELECTION /APROPS FROM NEW
3942 [
39HL [ X0 - DISPLACEMENT DOWN NEW /APROPS
3=3= [ LINK X6 - SAVED IN ACOMMUNE2
3=GW [
3?2G [ X0 -> X5 , AWORK3 & AWORK4 DESTROYED
3?G6 [
3?^Q LDX 2 FX2
3#FB STO 0 ACOMMUNE1(2)
3#^2 STO 6 ACOMMUNE2(2)
3*DL MHUNTW 2,APERI,APROPS [ NEW PROPERTY RECORD
3*Y= HUNT2 1,APERI,APROPS,2 [ ACTION
3BCW HUNT2 1,APERI,APROPS [ SELECTION
3BXG LDX 6 A1+1(1) [ NO. OF NAMES IN SELECTION
3CC6 ADN 1 A1+2
3CWQ DO [ REMOVE SELECTION NAMES FROM NEW RECORD
3DBB MHUNTW 2,APERI,APROPS [ NEW PROPERTY RECORD
3DW2 SMO FX2
3F*L ADX 2 ACOMMUNE1 [ DISPLACEMENT TO BLOCK OF NAMES
3FT= SMO FX2
3G#W STO 1 AWORK3
3GSG LDN 5 ATTMAX [ NAMES IN NEW ( MAX. POSSIBLE )
3H#6 DO
3HRQ IF +0(1),NZ [ NAMES NOT NULL
3J?B AND +0(2),NZ
3JR2 LDX 0 0(1)
3K=L AND 0,E,0(2) [ LENGTHS SAME
3KQ= THEN
3L9W SMO FX2
3LPG STO 2 AWORK4
3M96 WHILE TRUE
3MNQ LDCH 3 1(1)
3N8B LDCH 4 1(2)
3NN2 AND 3,E,4
3P7L DO
3PM= BCHX 1 £
3Q6W BCHX 2 £
3QLG REPEAT CT 0
3R66 SMO FX2
3RKQ LDX 2 AWORK4
3S5B IF 0,ZE [ NAMES SAME
3SK2 THEN
3T4L STOZ 0(2) [ DELETE NAME FROM NEW PROPERTY RECORD
3TJ= FI
3W3W FI
3WHG ADN 2 4 [ NEXT NAME - NEW
3WNN ... SMO FX2
3WTW ... LDX 1 AWORK3
3X36 REPEAT CT 5
3YG2 ADN 1 4 [ NEXT NAME - SELECTION
3Y^L REPEAT CT 6
3^F= SMO FX2
3^YW LDX 6 ACOMMUNE2
42DG EXIT 6 0
42Y6 [
43CQ [************************************************************
43XB [
44C2 SPRJOIN
44WL [
45B= [************************************************************
45TW [
46*G [
46T6 [ JOIN PROPERTY NAMES IN APERI/APROPS FORMAT INTO & FORMAT
47#Q [
47SB [ X2 - OUTPUT AREA
48#2 [ X3 - -> COUNT OF PROPERTY NAMES IN APERI/APROPS
48RL [
49?= [ RESULT X4 - LENGTH OF NAMES + TRAILING &
49QW [ - MUST HAVE BEEN EXTERNALLY
4==G [
4=Q6 [ ALL ACCS USED EXCEPT X7 - LINK X6
4?9Q [
4?PB LDX 5 0(3) [ NO OF NAMES
4#92 ADN 3 1 [ -> LENGTH OF NAME
4#NL WHILE 5,NZ [ MORE PROPERTIES
4*8= DO
4*MW LDX 0 0(3)
4B7G IF 0,NZ [ NON NULL NAME
4BM6 THEN
4C6Q LDN 1 1(3)
4CLB SMO 0
4D62 MVCH 1 0 [ COPY NAME
4DKL ADX 4 0 [ UPDATE COUNT
4F5= ADN 4 1
4FJW LDN 0 #26
4G4G DCH 0 0(2) [ INSERT &
4GJ6 BCHX 2 £
4H3Q FI
4HHB ADN 3 4
4J32 REPEAT CT 5
4JGL EXIT 6 0
4K2= [
4KFW [
4K^G [************************************************************
4LF6 [
4LYQ SPROPNOS
4MDB [
4MY2 [************************************************************
4NCL [
4NX= #DEF WOLDPERM = A1+1
4PBW #DEF WOLDTEMP = ATTMAX*4+2 + WOLDPERM
4PWG #DEF WACTPERM = ATTMAX*4+2 + WOLDTEMP
4QB6 #DEF WACTTEMP = ATTMAX*4+2 + WACTPERM
4QTQ [
4R*B [ SET UP APERI/APROPNOS BLOCK FOR NEW COMBINATION OF PROPERTIES
4RT2 [
4S#L [ ALL ACCUMULATORS USED - LINK X7
4SS= [
4T?W SBX 7 FX1
4TRG SETNCORE ATTMAX*4+2*4,1,APERI,APROPS [ FOR NAMES OF NEW COMBINATION
4W?6 STOZ WOLDPERM(1) [ INITIALISE BLOCK - NO. OF NAMES = 0
4WQQ STOZ WOLDTEMP(1)
4X=B STOZ WACTPERM(1)
4XQ2 STOZ WACTTEMP(1)
4Y9L LDN 6 ATTMAX
4YP= DO [ INITIALISE BLOCK - LENGTH OF ALL NAMES = 0
4^8W STOZ WOLDPERM+1(1)
4^NG STOZ WOLDTEMP+1(1)
5286 STOZ WACTPERM+1(1)
52MQ STOZ WACTTEMP+1(1)
537B ADN 1 4
53M2 REPEAT CT 6
546L SETNCORE ATTMAX*17+4/4+7,1,APERI,APROPNOS [ FOR NEW COMBINATION
54L= STOZ CPROPNO(1) [ INITIALISE - NO PROPERTIES
555W STOZ BPROPCNT(1)
55KG LDN 6 ATTMAX
5656 DO [ INITIALISE - ALL PROPERTY NO.S = 0
56JQ STOZ BPROPS(1)
574B ADN 1 1
57J2 REPEAT CT 6
583L MHUNTW 2,ADATA,AWHATLIST
58H= IF BS,2,AWLBPRPARAM [ SELECTION PROPERTY PARAMETER
592W STEPAGAIN
59GG AND BS,3,BLFRPROPREC [ PROPERTY RECORD
5=26 THEN
5=FQ STEP
5=^B MHUNTW 2,ADATA,AWHATLIST
5?F2 MHUNTW 1,APERI,APROPNOS
5?YL LDN 5 0 [ NO. OF PROPERTY NO.S RETAINED FOR NEW
5#D= LDN 6 0
5#XW WHILE 6,L,BPROPCNT-A1(3) [ MORE PROPERTIES IN ORIGINAL
5*CG DO [ COPY RELEVENT PROPERTY NO.S INTO /APROPNOS
5*X6 SMO 6
5BBQ LDX 4 BPROPS-A1(3)
5BWB LDX 0 AWLPRCNT(2)
5CB2 WHILE 0,NZ
5CTL SMO 0
5D*= AND 4,U,AWLPRNO-1(2)
5DSW DO
5F#G REPEAT CT 0
5FS6 IF 0,ZE [ NUMBER NOT ONE SELECTION PROPERTIES
5G?Q LDX 0 4
5GRB ANDX 0 BSP16
5H?2 AND 0,U,AWLCONS(2)
5HQL THEN [ COPY INTO NEW
5J== SMO 5
5JPW STO 4 BPROPS(1)
5K9G ADN 5 1
5KP6 FI
5L8Q ADN 6 1
5LNB REPEAT
5M82 STO 5 BPROPCNT(1)
5MML IF +AWLCONS(2),ZE [ NO CONSOLE PROPERTY IN SELECTION
5N7= THEN
5NLW LDX 0 CPROPNO-A1(3) [ COPY IN CONSOLE PROPERTY
5P6G STO 0 CPROPNO(1)
5PL6 FI
5Q5Q [ SPLIT NAMES AND COPY INTO APERI/APROPS
5QKB MHUNTW 1,APERI,APROPS
5R52 ADN 1 WOLDPERM
5RJL LDX 2 CHPERM-A1(3)
5S4= ADX 3 ADPERM-A1(3)
5SHW SBN 3 A1
5T3G CALL 6 SPRSPLIT
5TH6 STEPAGAIN
5W2Q MHUNTW 1,APERI,APROPS
5WGB ADN 1 WOLDTEMP
5X22 LDX 2 CHTEMP-A1(3)
5XFL ADX 3 ADTEMP-A1(3)
5X^= SBN 3 A1
5YDW CALL 6 SPRSPLIT
5YYG BACKSPACE
5^D6 [ REMOVE NAMES NOT REQUIRED IN NEW
5^XQ MHUNTW 2,ADATA,AWHATLIST
62CB IF BS,2,AWLBPROP [ SELECTION PROPERTIES OTHER THAN CENTRAL
62X2 THEN
63BL LDN 0 WOLDPERM+1
63W= CALL 6 SPRREMOVE
64*W LDN 0 WOLDTEMP+1
64TG CALL 6 SPRREMOVE
65*6 FI
65SQ FI
66#B [ ACTION CONSOLE PROPERTY NUMBER AND NAME INTO NEW RECORD
66S2 LDN 0 A1+2 [ DISPLACEMENT FOR NON-CONSOLE
67?L SMO FX2 [ PROPERTY NAMES
67R= STO 0 AWORK1 [ IN ACTION /APROPS
68=W MHUNTW 2,APERI,APRNUM
68QG IF +A1+1(2),NZ [ ACTION CONSOLE PROPERTY
69=6 THEN
69B3 ... LDN 0 4
69FY ... SMO FX2
69KT ... ADS 0 AWORK1 [INCREMENT DISPLACEMENT
69PQ MHUNTW 1,APERI,APROPNOS
6=9B IF +CPROPNO(1),ZE [ NO UNSELECTED CONSOLE PROPERTY
6=P2 THEN [ COPY ACTION CONSOLE PROP INTO NEW
6?8L LDXC 0 A1+1(2)
6?N= BCS £
6#7W STO 0 CPROPNO(1)
6#MG IF 0,NZ [ NOT CENTRAL
6*76 THEN
6*LQ SMO BPROPCNT(1)
6B6B STO 0 BPROPS(1)
6BL2 LDN 0 1
6C5L ADS 0 BPROPCNT(1)
6CK= MHUNTW 3,APERI,APROPS [ NEW
6D4W HUNT2 2,APERI,APROPS,3 [ ACTION
6DJG LDN 0 1
6F46 STO 0 WACTPERM(3)
6FHQ ADN 2 A1+2
6G3B ADN 3 WACTPERM+1
6GH2 MOVE 2 4
6H2L FI
6J^6 ELSF TRUE [ UNSELECTED CONSOLE PROP
6KDQ LDXC 0 A1+1(2)
6KYB BCS £
6LD2 AND 0,U,CPROPNO(1) [ UNEQUAL TO ACTION CONSOLE PROP
6LXL THEN
6MC= MFREE APERI,APROPNOS
6MWW MFREE APERI,APROPS
6NBG CALL 7 SOUTNULL [ NULL COMMAND IDENTIFICATION PARAMETERS
6NW6 CALL 7 SOUTNULL
6P*Q MHUNT 3,GMON,ASET
6PTB NAMETOP 3,ADATA,CSTORE [ SAVE MESSAGE BLOCK
6Q*2 BC 2,CLONG1*BITMULT+2
6QSL LDX 0 PERTMCONS(1) [ ERROR - TOO MANY CONSOLE PROPERTIES
6R#= STO 0 ACOMMUNE1(2)
6RRW SETREP2 WRONG
6S?G UPPLUS 1
6SR6 [------------
6T=Q FI
6TQB FI
6W=2 [ ACTION NON-CONSOLE PROPERTIES INTO NEW RECORD IF NOT ALREADY THERE
6WPL MHUNTW 2,APERI,APROPNOS
6X9= MHUNTW 1,APERI,APRNUM
6XNW LDN 6 0
6Y8G WHILE 6,L,A1(1) [ MORE ACTION PROPERTIES
6YN6 DO
6^7Q SMO 6
6^MB LDX 4 A1+2(1) [ ACTION NUMBER
7272 LDX 5 BPROPCNT(2) [ NO OF PROPERTIES ALREADY IN NEW
72LL WHILE 5,NZ [ MORE NEW PROPERTIES
736= SMO 5
73KW AND 4,U,BPROPS-1(2) [ PROPERTY NO.S UNEQUAL
745G DO
74K6 REPEAT CT 5
754Q IF 5,ZE [ NOT ALREADY IN NEW RECORD
75JB THEN
7642 LDX 0 BPROPCNT(2)
76HL SBN 0 ATTMAX
773= IF 0,PZ [ ALREADY ATTMAX PROPERTIES IN NEW
77GW THEN
782G MFREE APERI,APROPNOS
78G6 MFREE APERI,APROPS
78^Q CALL 7 SOUTNULL [ NULL COMMAND IDENTIFICATION PARAMETERS
79FB CALL 7 SOUTNULL
79^2 MHUNT 3,GMON,ASET
7=DL NAMETOP 3,ADATA,CSTORE [ SAVE MESSAGE BLOCK
7=Y= BC 2,CLONG1*BITMULT+2
7?CW LDX 0 PERTMANY(1) [ ERROR - TOO MANY PROPERTIES
7?XG STO 0 ACOMMUNE1(2)
7#C6 SETREP2 WRONG
7#WQ UPPLUS 1
7*BB [------------
7*W2 ELSE
7B*L SMO BPROPCNT(2)
7BT= STO 4 BPROPS(2)
7C#W LDN 0 1
7CSG ADS 0 BPROPCNT(2)
7D#6 STO 2 5 [ SAVE -> /APROPNOS
7DRQ MHUNTW 3,APERI,APROPS [ NEW
7F?B HUNT2 2,APERI,APROPS,3 [ ACTION
7FR2 SLL 4 1
7G=L IF 4,NG [ PERMANENT PROPERTY
7GQ= THEN
7H9W LDX 0 WACTPERM(3)
7HPG ADN 0 1
7J96 STO 0 WACTPERM(3)
7JNQ SLL 0 2
7K8B ADN 0 WACTPERM-3
7KN2 ELSE
7L7L LDX 0 WACTTEMP(3)
7LM= ADN 0 1
7M6W STO 0 WACTTEMP(3)
7MLG SLL 0 2
7N66 ADN 0 WACTTEMP-3
7NKQ FI
7P5B ADX 3 0
7PK2 LDX 0 6
7Q4L SLL 0 2
7QJ= ADX 2 0
7R3W SMO FX2
7RHG ADX 2 AWORK1 [ ADD DISPLACEMENT TO ALLOW FOR CONSOLE PR
7S36 MOVE 2 4 [ COPY PROPERTY NAME INTO NEW
7SGQ LDX 2 5 [ RESET -> /APROPNOS
7T2B FI
7TG2 FI
7T^L ADN 6 1
7WF= REPEAT
7WYW [ PUT NAMES INTO /APROPNOS
7XDG MHUNTW 2,APERI,APROPNOS
7XY6 LDX 0 BPROPCNT(2)
7YCQ IF 0,ZE [ /APROPNOS NULL
7YXB THEN
7^C2 FREECORE 2 [ FREE IT
7^WL ELSE
82B= MHUNTW 3,APERI,APROPS [ COPY PROPERTY NAMES IN
82TW SMO FX2
83*G STO 2 AWORK3
83T6 SMO FX2
84#Q STO 3 AWORK4
84SB [ PERMANENT
85#2 LDX 4 BPROPCNT(2)
85RL ADN 4 BPROPS
86?= STO 4 ADPERM(2) [ POINTERS TO PERMANENT NAMES
86QW ADX 2 4
87=G ADN 3 WOLDPERM
87Q6 STOZ 4 [ LENGTH OF JOINED NAMES
889Q CALL 6 SPRJOIN
88PB SMO FX2
8992 LDX 3 AWORK4
89NL ADN 3 WACTPERM
8=8= CALL 6 SPRJOIN
8=MW SMO FX2
8?7G LDX 2 AWORK3
8?M6 SBN 4 1
8#6Q IF 4,NG [ NO PERMANENT PROPERTIES
8#LB THEN
8*62 STOZ CHPERM(2)
8*KL STOZ ADPERM(2)
8B5= ELSE
8BJW STO 4 CHPERM(2) [ LENGTH OF NAMES
8C4G FI
8CJ6 [ TEMPORARY
8D3Q ADN 4 BPROPS*4+3
8DHB SRL 4 2
8F32 ADX 4 BPROPCNT(2)
8FGL STO 4 ADTEMP(2) [ POINTERS TO TEMPORARY NAMES
8G2= ADX 2 4
8GFW SMO FX2
8G^G LDX 3 AWORK4
8HF6 ADN 3 WOLDTEMP
8HYQ STOZ 4 [ LENGTH OF JOINED NAMES
8JDB CALL 6 SPRJOIN
8JY2 SMO FX2
8KCL LDX 3 AWORK4
8KX= ADN 3 WACTTEMP
8LBW CALL 6 SPRJOIN
8LWG SMO FX2
8MB6 LDX 2 AWORK3
8MTQ SBN 4 1
8N*B IF 4,NG [ NO TEMPORARY PROPERTIES
8NT2 THEN
8P#L STOZ CHTEMP(2)
8PS= STOZ ADTEMP(2)
8Q?W ELSE
8QRG STO 4 CHTEMP(2) [ LENGTH OF NAMES
8R?6 FI
8RQQ [ CONTRACT /APROPNOS
8S=B LDX 0 CHPERM(2)
8SQ2 ADN 0 3
8T9L SRL 0 2
8TP= LDX 6 0
8W8W LDX 0 CHTEMP(2)
8WNG ADN 0 3
8X86 SRL 0 2
8XMQ ADX 6 0
8Y7B ADX 6 BPROPCNT(2)
8YM2 ADN 6 BPROPS-A1
8^6L STO 6 A1(2) [ RECORD HEADER
8^L= ADN 6 A1
925W ALTLEN 2,6
92KG FI
9356 MFREE APERI,APROPS [ NEW /APROPS
93JQ ADX 7 FX1
944B EXIT 7 0
94J2 [
953L [************************************************************
95H= [
962W STEPWRITE
96GG [
9726 [************************************************************
97FQ [
97^B [
98F2 [ ENSURE ALTERED RECORD IN :SYSTEM.OUTPUT IS WRITTEN AWAY
98YL [
99D= [ X3 -> ALTERED RECORD
99XW [ ACCS X0,X1,X2 USED - LINK X5
9=CG [
9=X6 SBX 5 FX1
9?BQ STEPWRITE
9?WB ADX 5 FX1
9#B2 EXIT 5 0
9#TL [
9**= [************************************************************
9*SW [
9B#G SOUTNULL
9BS6 [
9C?Q [************************************************************
9CRB [
9D?2 [
9DQL [ OUTPUT NULL PARAMETER TO MEESSAGE BLOCK
9F== [
9FPW [ LINK X7
9G9G [
9GF# ... SBX 7 FX1
9GP6 OUTPACK 7,0,NULL
9GYY ... ADX 7 FX1
9H8Q EXIT 7 0
9HNB [
9J82 [************************************************************
9JML [
9K7= SPERI
9KLW [
9L6G [************************************************************
9LL6 [
9M5Q [
9MKB [ CHECK IF PERIPHERAL WITH REQUISITE PROPERTIES IS AVAILABLE
9N52 [ IF YES THEN PUT GOUT/CHANGE BLOCK ON LFCHAIN
9NJL [ AND PUT NEW PROPERTY RECORD IN ENTRY
9P4= [
9PHW [ ALL ACCS USED - LINK X7
9Q3G [
9QH6 SBX 7 FX1
9R2Q STEPAGAIN
9RGB LDX 0 GOPTY-A1(3)
9S22 STO 0 ACOMMUNE7(2) [ PERIPHERAL TYPE REQUIRED
9SFL DOWN GETFREE,11 [ "ISPER"
9S^= UP [ BREAKIN
9TDW NULL
9TYG IF REP2,OK [ REPLY OK
9WD6 THEN
9WXQ STEPAGAIN
9XCB IF MBAC,3,BLFRNAV,BLFRSETNAV [ REQUEST IS IMPLEMENTABLE
9XX2 THEN
9YBL BS 3,BLFRPFREE [ REPLY TO ISPER WAS OK
9YW= SETNCORE 2,1,GOUT,CHLIST
9^*W STEPAGAIN
9^TG MHUNTW 1,GOUT,CHLIST
=2*6 LDX 0 GOUTKEY1-A1(3)
=2SQ STO 0 A1(1)
=3#B LDX 0 GOUTKEY2-A1(3)
=3S2 STO 0 A1+1(1)
=4?L LFCHAIN GOUT,CHLIST
=4R= STARTACT OUT
=5=W FI
=5QG CALL 6 SPROPREC [ PUT PROPERTY RECORD IN ENTRY
=6=6 ELSF RPN2,NOTAV [ REPLY NOT NOTAV
=6PQ AND RPN2,WRNG [ REPLY NOT WRNG
=79B THEN
=7P2 [
=88L SEGENTRY K90WLE [ LFDBAID
=8N= [
=97W LDN 0 1 [ 1 = OFF 0 = ON
=9MG IF 0,ZE [ LFDBAID ON
==76 THEN
==LQ IF EITHER,REP2,NOPROP [ REPLY NOPROP
=?6B OR REP2,PERMEXCL [ REPLY PERMEXCL
=?L2 THEN
=#5L HUNTW 3,APERI,APROPNOS
=#K= IF EITHER,3,NG [ NO CONSOLE PROPERTY
=*4W OR +CPROPNO(3),ZE
=*JG THEN
=B46 LDN 0 0
=BHQ ELSE
=C3B LDN 0 1
=CH2 FI
=D2L ELSE
=DG= LDN 0 1
=D^W FI
=FFG FI
=F^6 IF 0,ZE [ LFDBAID ON AND REPLY ( NOPROP OR PERMEXCL ) AND
=GDQ THEN
=GYB CALL 6 SPROPREC [ PUT NEW PROPERTY RECORD IN ENTRY
=HD2 ELSE
=HXL IF REP2,NOPROP
=JC= THEN
=JWW OUTPACK ACOMMUNE8(2),1,PROPS
=KBG LDX 6 PERNOPROP(1)
=KW6 ELSF REP2,NOPER
=L*Q THEN
=LTB CALL 7 SOUTNULL
=M*2 LDX 6 PERPERNA(1)
=MSL ELSE [ ASSUME REPLY = PERMEXCL
=N#= LDX 6 PEREXCL(1)
=NRW FI
=P?G CALL 7 SOUTNULL [ NULL COMMAND IDENTIFICATION PARAMETERS
=PR6 CALL 7 SOUTNULL
=Q=Q MHUNT 1,GMON,ASET
=QQB NAMETOP 1,ADATA,CSTORE [ SAVE MESSAGE BLOCK
=R=2 BC 2,CLONG1*BITMULT+2
=RPL VFREE APERI,APROPNOS [ FREE ERRONEOUS /APROPNOS ( IF EXIST
=S9= STO 6 ACOMMUNE1(2)
=SNW SETREP WRONG
=T8G UPPLUS 1
=TN6 [-------
=W7Q FI
=WMB ELSE
=X72 CALL 6 SPROPREC [ PUT PROPERTY RECORD IN ENTRY
=XLL FI
=Y6= ADX 7 FX1
=YKW EXIT 7 0
=^5G [
=^K6 [************************************************************
?24Q [
?2JB SPROPREC
?342 [
?3HL [************************************************************
?43= [
?4GW [
?52G [ PUT NEW PROPERTY RECORD IN ENTRY
?5G6 [
?5^Q [ ALL ACCS USED EXCEPT X4,X7 - LINK X6
?6FB [ :SYSTEM.OUTPUT LEFT AT FIRST RECORD OF ENTRY
?6^2 [
?7DL SBX 6 FX1
?7Y= STEPAGAIN
?8CW HUNTW 2,APERI,APROPNOS
?8XG IF 2,PZ [ NEW PROPERTY RECORD
?9C6 THEN
?9WQ NAME 2,FILE,FWB
?=96 ... CALL 5 STEPWRITE [ ENSURE BLOCK WRITTEN AWAY
?=?Q ... STOZ GCOUNT-A1(3) [ CLEAR WAIT AFTER CD ATTRIBUTE
?=BB IF BS,3,BLFRPROPREC [PROPERTY RECORD
?=W2 THEN
??*L STEP [ TO PROPERTY RECORD
??T= REPLACE [ IT
?##W ELSE
?#SG BS 3,BLFRPROPREC [ SET PROPERTY RECORD IN ENTRY
?*RQ STEP [ BEYOND PLACE FOR PROPERTY RECORD
?B?B INSERT [ PROPERTY RECORD
?BR2 BACKSPACE
?C=L FI
?CQ= MHUNTW 2,FILE,FWB
?D9W NAME 2,APERI,APROPNOS [ SAVE BLOCK IN CASE CAN BE USED FOR N
?DPG BACKSPACE
?F96 ELSF BS,3,BLFRPROPREC [ PROPERTY RECORD IN ENTRY
?FNQ THEN
?GN2 CALL 5 STEPWRITE [ ENSURE BLOCK WRITTEN AWAY
?GT8 ... BC 3,BLFRPROPREC [ CLEAR PROPERTY RECORD IN ENTRY
?H2B ... STOZ GCOUNT-A1(3) [ CLEAR WAIT AFTER CD ATTRIBUTE
?H7L STEP [ TO PROPERTY RECORD
?HM= DELETE [ IT
?J6W FI
?JLG ADX 6 FX1
?K66 EXIT 6 0
?KKQ [
?L5B [
?LK2 [ WW WW W
?M4L [ WW WW WW
?MJ= [ WW WW WWW
?N3W [ WWWW WW
?NHG [ WWWWW WW
?P36 [ WW WW WW
?PGQ [ WW WW WW
?Q2B [ WW WW WW
?QG2 [
?Q^L [
?RF= WLEK1
?RYW [
?SDG [************************************************************
?SY6 [
?TCQ [ CHANGELIST PROPERTY ACTION - CALLED BY WLD
?TXB [
?WC2 [************************************************************
?WWL [
?XB= [
?XTW MHUNTW 2,ADATA,AWHATLIST
?Y*G IF BS,2,AWLBPRPARAM [ SELECTION PROPERTY PARAMETER
?YT6 THEN
?^#Q CALL 7 SPROPNOS [ SETUP APERI/APROPNOS BLOCK
?^SB CALL 7 SPERI [ CHECK IF PERIPHERAL AVAILABLE
#2#2 [ AND UPDATE PROPERTY RECORD
#2RL VFREE APERI,APROPNOS
#3?= ELSE
#3QW HUNTW 1,APERI,APROPNOS
#4=G IF 1,PZ [ APERI/APROPNOS ALREADY SET UP
#4Q6 THEN
#59Q IF BC,2,AWLBPERI [ MAY BE FOR DIFFERENT PERI TYPE
#5PB THEN
#692 CALL 7 SPERI [ CHECK IF PERIPHERAL AVAILABLE
#6NL [ AND UPDATE PROPERTY RECORD
#78= ELSE
#7MW CALL 6 SPROPREC [ UPDATE PROPERTY RECORD
#87G FI
#8M6 ELSE
#96Q IF TRUE
#9LB MHUNTW 1,APERI,APRNUM
#=62 AND EITHER,+A1+1(1),U,GSIGN [ ACTION PROPERTIES OTHER TH
#=KL OR +A1(1),NZ
#?5= THEN
#?JW CALL 7 SPROPNOS [ SETUP APERI/APROPNOS BLOCK
##4G FI
##J6 CALL 7 SPERI [ CHECK IF PERIPHERAL AVAILABLE
#*3Q [ AND UPDATE PROPERTY RECORD
#*HB FI
#B32 FI
#B=S ... SETREP OK
#BGL UPPLUS 1
#C2= [
#CFW #END
^^^^ ...014726700007