{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: IDFPROP867)}}
====== IDFPROP867 ======
(George Source)
**Macros used:** [[george:macro:ACROSS|ACROSS]], [[george:macro:BSOFF|BSOFF]], [[george:macro:BXE|BXE]], [[george:macro:CLOSE|CLOSE]], [[george:macro:CONSOUT|CONSOUT]], [[george:macro:FREECORE|FREECORE]], [[george:macro:FWAIT|FWAIT]], [[george:macro:GEOERR|GEOERR]], [[george:macro:GEOPACK|GEOPACK]], [[george:macro:GETACT|GETACT]], [[george:macro:HUNT2|HUNT2]], [[george:macro:IDFOPEN|IDFOPEN]], [[george:macro:INFORM|INFORM]], [[george:macro:LINKSET|LINKSET]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MFREE|MFREE]], [[george:macro:MGETCELL|MGETCELL]], [[george:macro:MHUNT|MHUNT]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:OFF|OFF]], [[george:macro:ON|ON]], [[george:macro:OPEND|OPEND]], [[george:macro:OUTPACK|OUTPACK]], [[george:macro:PAIR|PAIR]], [[george:macro:READED|READED]], [[george:macro:REWIND|REWIND]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETMODE|SETMODE]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:STEP|STEP]], [[george:macro:TESTREP|TESTREP]], [[george:macro:TESTREPNOT|TESTREPNOT]]
22FL #SEG IDFPROP8 [G CONSTANTINIDES
22PD ...# COPYRIGHT INTERNATIONAL COMPUTERS 1982
22^= #OPT K0IDFPROP=0
23DW #LIS K0IDFPROP>K0ALLGEO>K0GREATGEO>K0COMMAND>K0IDF
23YG #
24D6 # THIS SEGMENT COMPARES SYSTEM.PROPERTY AND THE IDF TO MAKE SURE THAT
24XQ # THEY ARE COMPATIBLE:THE IDF IS CHANGED TO MATCH SYSTEM.PROPERTY
25CB #
25X2 #
26BL 8HIDFPROP8
26W= # ENTRY POINTS
27*W SEGENTRY K1IDFPROP,Z1IDFPROP
27TG SEGENTRY K20IDFPROP,Z20IDFPROP
28*6 SEGENTRY K30IDFPROP,Z30IDFPROP
28SQ #
29S2 MENDAREA 50,K100IDFPROP
2=?L #SKI EMSJNL<1$1
2=R= (
2?=W MSGE 32HUNIT HAS BEEN RECONSTRUCTED
2?QG 32HPLEASE REISSUE IDF COMMANDS
2#=6 )
2#PQ XPAIR PAIR IDFPROP,20
2*9B MPROP +10
2*P2 12HSYSTEM
2B8L 12HPROPERTY
2BN= +0
2C7W +1
2CMG 4HB1
2D76 XMAJ +10000
2DLQ #
2F6B #
2FL2 YREC [A NON-COORD.ROUTINE(ALL IDF IN CORE)
2G5L BPZ 3 SAME [TO FIND CELL X3 POINTS TO:X2-
2GK= YREC1 LDX 6 3 [IS POINTER TO CURRENT FILE/FRRB
2H4W SRL 6 9
2HJG ANDN 6 #7777 [RECORD NO INTO X6
2J46 LDX 2 FX2 [X1=FX2
2JHQ YR HUNT2 2,FILE,FRRB
2K3B TXU 6 A1+BRECNO(2)
2KH2 BCS YR
2L2L ADN 2 A1
2LG= SAME ANDN 3 #777 [MAKE X3 RELATIVE POINTER
2L^W ADX 3 2
2MFG EXIT 7 0
2M^6 #
2NDQ #
2NYB REC1 LDN 6 0 [FIND RECORD ZERO
2PD2 LDX 2 FX2
2PXL REC HUNT2 2,FILE,FRRB
2QC= TXU 6 A1+BRECNO(2)
2QWW BCS REC
2RBG ADN 2 A1
2RW6 EXIT 7 0
2S*Q #
2STB #
2T*2 SELL SBX 7 FX1 [ROUTINE TO FREE CELL
2TSL MFREECEL 2,3
2W#= ADX 7 FX1
2WRW EXIT 7 0
2X?G #
2XR6 #
2Y=Q ZASAT [ROUTINE TO CLEAR OUT ASSOCS & ATTS IF NECESSARY
2YQB [X2&X3(ABS.) POINT TO PARENT CELL
2^=2 [X1 POINTS TO IDF/APROPNOS BLOCK
2^PL SBX 5 FX1 [ADJUST LINK-FREECELL CO-ORDINATES
329= LDX 4 BATT(3)
32NW LDX 3 BASS(3)
338G BNZ 3 ZA1 [J.IF THERE ARE ASSOCIATIONS
33N6 BNZ 4 ZA2 [J.IF THERE ARE ATTRIBUTIONS
347Q ZAXIT ADX 5 FX1
34MB EXIT 5 0
3572 #
35LL # NOW DEAL WITH GETTING RID OF ASSOCIATIONS
366= #
36KW ZA1 CALL 7 YREC
375G LDX 7 BNO(3) [LOAD NO OF ASSOCS
37*# ... BZE 7 XA2F
37K6 SLL 7 1 [& MULT.BY 2,FOR USE AS PREMODIFIER
39HL ZA7 SMO 7
3=3= LDX 6 BNO(3) [PICK UP PROP.NO
3=GW LDX 0 6 [AND MAKE SURE IT IS IN CURRENT
3?2G ANDX 0 BITS22LS [LIMITS OF IDF/APROPNOS BLOCK
3?G6 SBX 0 A1(1)
3?^Q BNG 0 ZA4 [J.IF NOT
3#FB SBN 0 1000
3#^2 BNG 0 XA1
3*DL LDX 0 A1+1001(1)
3*Y= BNG 0 XA2
3BCW BRN ZA4
3BXG XA1
3CC6 ADN 0 1001
3CWQ SMO 0 [OTHERWISE CHECK NO.IS IN BLOCK
3DBB ERX 6 A1(1)
3DW2 ANDX 6 BITS22LS
3F*L BZE 6 ZA4 [J.IF ALL OKAY
3L9W XA2
3LPG ON G4SUDBIT [TO INDICATE"SEND MESSAGE"
3M96 LDX 0 BNO(3)
3MNQ SBN 0 1 [SUBTRACT 1 FROM NO.OF ASSOCS
3N8B BNZ 0 ZA5 [J.IF NOT ZERO AS WILL KEEP CELL
3ND8 ...XA2F
3NN2 SMO FX2
3P7L LDX 3 AWORK4
3PM= CALL 7 YREC1
3Q6W SBX 3 2
3QLG ADN 3 BASS
3R66 CALL 7 SELL [CLEAR CELL
3RKQ MHUNTW 1,IDF,APROPNOS [REHUNT IDF/APROPNOS BLOCK
3S5B BNZ 4 ZA3 [J.FOR ATTRIBUTIONS
3SK2 BRN ZAXIT [OTHERWISE EXIT
3T4L ZA5 STO 0 BNO(3) [ADJUST ASSOCS COUNT
3TJ= SMO 7
3W3W STOZ BNO-1(3) [CLEAR ASSOCS
3WHG SMO 7
3X36 STOZ BNO(3)
3XGQ ZA4 SBN 7 2
3Y2B BNZ 7 ZA7 [J.FOR NEXT ASSOCS
3YG2 #
3Y^L # NOW DEAL WITH GETTING RID OF ATTRIBUTIONS
3^F= #
3^YW BZE 4 ZAXIT
42DG ZA2
42Y6 ZA3 LDX 3 4
43CQ CALL 7 YREC1
43XB LDX 7 BNO(3) [NO.OF ATTRIBS
4478 ... BZE 7 ZA15F
45TW ZA9 SMO 7
46*G LDX 6 BTYPE(3) [PICK UP POSSIBLE ATTRIB
46T6 BZE 6 ZA8 [J.IF NULL
47#Q LDX 0 6 [OTHERWISE SEE IF NO.IN BLOCK LIMITS
47SB ANDX 0 BITS22LS
48#2 SBX 0 A1(1)
48RL BNG 0 ZA8 [J.IF NOT
49?= SBN 0 1000
49QW BNG 0 XA3
4==G LDX 0 A1+1001(1)
4=Q6 BNG 0 ZA15
4?9Q BRN ZA8
4?PB XA3
4#92 ADN 0 1001
4#NL SMO 0
4*8= LDX 0 A1(1) [PICK UP APROPRIATE BLOCK ENTRY
4*MW BZE 0 ZA15 [J.IF NON-EXISTENT:THAT IS NO PROP.
4B7G SMO 7 [OTHERWISE RE-STORE PROP.NO IN CASE
4BM6 STO 0 BTYPE(3) [PERM/TEMP/EXCL/INCL DISCREPANCY
4C6Q BRN ZA8 [J.TO LOOK AT NEXT ATTRIB IF NEC.
4CLB ZA15 ON G4SUDBIT
4D62 LDX 0 BNO(3)
4DKL SBN 0 1 [INVESTIGATE COUNT
4F5= BNZ 0 ZA10 [J.IF NO NEED TO FREE CELL
4F*4 ...ZA15F
4FJW SMO FX2 [OTHERWISE FREE CELL
4G4G LDX 3 AWORK4
4GJ6 CALL 7 YREC1
4H3Q SBX 3 2
4HHB ADN 3 BATT
4J32 CALL 7 SELL
4JGL MHUNTW 1,IDF,APROPNOS [REHUNT BLOCK & EXIT
4K2= BRN ZAXIT
4^NG ZA10 STO 0 BNO(3) [STORE ADJUSTED COUNT
5286 SMO 7
52MQ STOZ BTYPE(3) [CLEAR ATTRIBUTION
537B ZA8 SBN 7 1
53M2 BPZ 7 ZA9 [J.FOR NEXT ATTRIBUTION
546L LDX 0 BTYPE(3) [OTHERWISE BEGIN "MOVE UP"------
54L= LDX 7 BNO(3)
555W BZE 0 ZA11 [J.IF NO CONSOLE PROP
55KG SBN 7 1 [OTHERWISE ADJUST COUNT
5656 BZE 7 ZAXIT
56JQ ZA11 LDX 6 3
574B ZA14 LDX 0 BTYPE+1(3)
57J2 BNZ 0 ZA12 [J.IF FOUND A "MOVING"CANDIDATE
583L ADN 3 1
58H= BRN ZA14 [& IF NOT J.TO LOOK AGAIN IN NXT WORD
5=FQ ZA12 STOZ BTYPE+1(3) [CLEAR OLD POSITION
5=^B SMO 6
5?F2 STO 0 BTYPE+1 [AND STORE IN NEW POSITION
5?YL SBN 7 1
5#D= BZE 7 ZAXIT [J.TO EXIT IF ALL DONE
5#XW ADN 6 1
5*CG ADN 3 1
5*X6 BRN ZA14 [OTHERWISE CONTINUE MOVING
5BBQ #
5BWB #
5W2Q Z1IDFPROP
5WGB OFF G4SUDBIT [MAKE SURE SWITCH CLEAR
5X22 SETNCORE 10,3,FILE,FABSNB [TO OPEN SYSTEM.PROPERTY
5XFL LDN 4 A1(3)
5X^= LDN 3 MPROP(1)
5YDW MOVE 3 10
5YYG SETMODE 4,GENERAL,QUERY,CAREFUL [TO OPEN SYSPROP
5^D6 OPEND PCERR,4
5^XQ TESTREP OK,PC1
62CB PCERR GEOERR 1,PROPFILE
62X2 PC1 MHUNT 3,FILE,FABSNB [FREE FABSNB-NO GOOD FOR IDFOPEN
63BL FREECORE 3
63W= IDFOPEN [OPEN IDF
64*W LDN 4 2 [NOW READ WHOLE IDF INTO CORE
64TG PC2 READED 4,4
65*6 ADN 4 1
65SQ TESTREP OK,PC2 [J.TO READ NEXT BLOCK IF NECESSARY
65YM ... TESTREPNOT NORIT,PC2A
664J ... MFREE FILE,FRRB
668F ...PC2A
66#B STEP 1
66S2 BZE 3 PCERR [J.TO ERROR NO CENTRAL
67?L PC4 STEP 1
67R= BZE 3 PC3
68=W LDX 5 APROPGROUP(3)
68QG BPZ 5 PC4 [J.IF NOT CONSOLE PROP TO STEP AGAIN
69=6 LDX 5 APROPNO(3) [LOAD ACTUAL PROPERTY NUMBER
69PQ CALL 7 REC1 [FIND RECORD ZERO
6=9B LDN 4 BEXOT [IN CASE NEED TO GET NEW CELL
6=P2 LDX 3 BEXOT(2) [CONTENTS INTO X3
6?8L BZE 3 PC5 [J.IF NO CONSOLE PROPS IN IDF
6?N= PC6 LDX 4 3 [OTHERWISE SEARCH CHAIN FOR NO.IN X5
6#7W CALL 7 YREC [FIND CONSOLE CELL
6#MG LDX 0 BNO(3)
6*76 ERX 0 5
6*LQ ANDX 0 BITS22LS [COMPARE ACTUAL NOS-BOTTOM 22 BITS
6B6B BZE 0 PC15 [J.IF SAME
6BL2 LDX 3 0(3) [IF FOUND:OTHERWISE ADD ENTRY TO-
6C5L BNZ 3 PC6 [CONSOLE CHAIN WITH U0 AS CONSOLE
6CK= PC5 LDX 3 4
6D4W ANDN 3 #777
6DJG MGETCELL 2,3 [GET NEW CELL
6F46 ON G4SUDBIT [ON"MESSAGE"SWITCH
6FHQ ADX 3 2
6G3B PC15 STO 5 BNO(3) [STORE IN PROP NO(& MAKE SURE TEMP/
6GH2 BRN PC4 [PERM/INCL/EXCL)& J.FOR NXT CONS PROP
6H2L #
6HG= # NOW START INVERSE CHECKING:THAT IS REMOVE EXTRA PROPS FROM IDF.
6H^W # REMEMBER THAT PROPERTIES DO NOT HAVE TO BE IN
6JFG # ASCENDING NUMBER ORDER IN :SYSTEM.PROPERTY
6J^6 #
6KDQ PC3 REWIND 1 [PUT SYPROP BACK TO START
6KYB SETNCORE 1003,1,IDF,APROPNOS
6LD2 LDN 0 1
6LXL STO 0 A1(1)
6MC= PC22 STOZ A1+1(1) [ZEROIZE IDF/APROPNOS BLOCK
6MWW LDN 4 A1+1(1)
6NBG LDN 5 A1+2(1)
6NW6 MOVE 4 500 [TO ZEROIZE 1000 WORDS TWO "MOVES"-
6P*Q ADN 4 500 [ARE NEEDED!!
6PTB ADN 5 500
6Q*2 MOVE 4 501
6S?G PC11 STEP 1 [STEP SYSPROP
6SR6 MHUNTW 1,IDF,APROPNOS [OTHERWISE PUT ENTRY IN BLOCK IF NEC.
6T=Q BZE 3 PCX10 [J.IF ALL DONE
6TQB LDX 6 APROPNO(3)
6W=2 ANDX 6 BITS22LS [DON'T WANT TEMP/PERM BITS ETC.
6WPL SBX 6 A1(1)
6X9= BNG 6 PC11
6XNW SBN 6 1000
6Y8G BPZ 6 PCX12 [J.IF TOO BIG
6YN6 ADN 6 1000
6^7Q LDX 0 APROPNO(3)
6^MB SMO 6
7272 STO 0 A1+1(1) [OTHERWISE STORE AWAY NUMBER
72LL SBN 6 999
736= BNZ 6 PC11 [J.IF STILL MORE ROOM IN BLOCK
73KW LDX 0 A1+1002(1)
745G BNG 0 PC12
74K6 BRN PC14
7*W2 PCX10 LDX 0 A1+1002(1)
7B*L BNG 0 PC12
7BT= PC10 NGS 1 A1+1001(1) [MARK NEG TO SHOW LAST TIME THROUGH
7C#W BRN PC14
7CSG PCX12 NGS 1 A1+1002(1)
7D#6 BRN PC11
7DRQ PC12 REWIND 1 [SO THAT WE'LL GET THIS PROP NEXT GO
7F?B MHUNTW 1,IDF,APROPNOS
7FR2 #
7G=L # NOW CHECK CONSOLE PROP.CHAIN FOR SUPPOSEDLY UNKNOWN CONSOLE PROPERTIES
7GQ= #
7H9W PC14 CALL 7 REC1 [TO FIND RECORD ZERO
7HPG LDX 3 BEXOT(2)
7J96 BZE 3 MPX1 [J.IF NO CONSOLE PROPS
7JNQ LDN 4 BEXOT [KEEP PTR TO POSITION OF PTR TO CONS.
7LM= PR4 LDX 5 3 [KEEP PTR TO CURRENT CONSOLE CELL
7M6W CALL 7 YREC
7MLG PR8 LDX 0 BNO(3) [NOW CHECK NUMBER IS IN BLOCKS LIMITS
7N66 ANDX 0 BITS22LS
7NKQ SBX 0 A1(1)
7P5B BNG 0 PR1 [J.IF NOT
7PK2 SBN 0 1000
7Q4L BNG 0 XA4
7QJ= LDX 0 A1+1001(1)
7R3W BNG 0 XA5
7RHG BRN PR1
7S36 XA4
7SGQ LDX 6 BNO(3)
7T2B ADN 0 1000
7TG2 SMO 0
7T^L ERX 6 A1+1(1)
7WF= BZE 6 PR1 [J.ALL OKAY-PROP EXISTS
84SB XA5
85#2 LDX 5 BTYPE(3) [PICK UP CONSOLE POINTER
85RL LDX 0 4(3) [OTHERWISE INVESTIGATE SUBSID.CELLS
86?= BZE 0 PR2 [J.IF NONE
86QW SBX 3 2 [OTHERWISE FREE THEM ALL
87=G LDN 3 4(3)
87Q6 PR3 CALL 7 SELL
889Q SMO 2
88PB LDX 0 0(3)
8992 BNZ 0 PR3 [J.FOR NEXT SUBSID CELL
89NL PR2 [NOW FREE CONSOLE CELL ITSELF
8=8= ON G4SUDBIT
8=MW LDX 3 4 [X4 IS
8?7G CALL 7 YREC1 [COPY OF A PTR KEPT FOR THIS PURPOSE
8?M6 SBX 3 2
8#6Q CALL 7 SELL
8#LB MHUNTW 1,IDF,APROPNOS
8*62 ADX 3 2
8*KL BZE 5 PR5 [J.IF U0:NOTHING TO DO
8B5= LDX 0 0(3) [OTHERWISE KEEP PTR TO NEXT CONSOLE-
8BJW SMO FX2 [PROPERTY CELL IN AWORK4
8C4G STO 0 AWORK4
8CJ6 CALL 7 REC1 [FIND RECORD ZERO & SEARCH CONS.CHAIN
8D3Q LDX 3 BEXOT(2) [TO CHECK UNSETTING OF"THIS IS CLUST
8DHB BZE 3 PR9
8F32 PR7 CALL 7 YREC [CONSOLE" BIT
8FGL LDX 0 BTYPE(3)
8G2= ERX 0 5 [TO COMPARE CONSOLES WITH ONE IN X5
8GFW ANDX 0 BITS22LS
8G^G BZE 0 PR6 [J.AS THIS CONSOLE STILL USED
8HF6 LDX 3 0(3)
8HYQ BNZ 3 PR7 [J.FOR NEXT CONSOLE PROP
8JDB PR9 LDX 3 5 [OTHERWISE CLEAN OUT"THIS IS CLUSTER
8JY2 CALL 7 YREC1 [CONSOLE"BIT
8KCL LDCT 0 #40
8KX= ERS 0 BNUMB(3)
8MTQ PR6 SMO FX2
8N*B LDX 3 AWORK4 [GO BACK TO CONSOLE CELLS NOW
8NT2 BZE 3 MPX6 [J.NO MORE CONSOLE CELLS
8P#L LDX 5 3
8PS= CALL 7 YREC1 [& CONTINUE SEARCH
8Q?W BRN PR8
8^6L PR1 LDX 4 5 [FOR FREEING A POSIBLE CONSOLE CELL
8^L= PR5 LDX 3 0(3)
925W BNZ 3 PR4 [J.FOR NEXT CONSOLE PROP COMPARISON
92KG #
9356 # NOW CHECK 7007 CHAIN FOR ATT.& ASS.OF UNKNOWN PROPERTIES
93JQ #
944B MPX6 CALL 7 REC1 [TO FIND RECORD ZERO
94J2 MPX1 LDX 3 BUNIT(2)
953L BZE 3 TP1 [J.TO SEARCH IPB CHAIN IF NO MPX
95H= CALL 7 YREC [OTHERWISE FIND MPX/UPX CELL
962W MPX5 LDX 0 0(3)
96GG SMO FX2
9726 STO 0 AWORK1 [KEEP POINTER TO NEXT UNIT CELL
97FQ LDX 0 BLINE(3)
97^B SMO FX2
98F2 STO 0 AWORK2 [KEEP POINTER TO LINE CELL
98YL CALL 5 ZASAT [CALL"CANCEL"ROUTINE FOR UNIT
99D= MPX3 SMO FX2
99XW LDX 3 AWORK2 [PICK UP LINE CELL POINTER
9=CG BZE 3 MPX2 [J.FOR NEXT UNIT IF NO MORE LINES
9=X6 SMO FX2
9?BQ STO 3 AWORK4
9?WB CALL 7 YREC1 [OTHERWISE FIND LINE CELL
9#B2 LDX 0 0(3)
9#TL SMO FX2
9**= STO 0 AWORK2 [KEEP POINTER TO NEXT LINE
9*SW LDX 0 BLINE(3)
9B#G MPX4 SMO FX2
9BS6 STO 0 AWORK3 [& KEEP POINTER TO POSSIBLE 7020 CELL
9C?Q CALL 5 ZASAT [& "CANCEL"
9CRB SMO FX2
9D?2 LDX 3 AWORK3
9DQL BZE 3 MPX3 [J.IF NO 7020'S FOR NEXT LINE
9F== SMO FX2
9FPW STO 3 AWORK4
9G9G CALL 7 YREC1 [OTHERWISE FIND 7020 CELL
9GP6 LDX 0 0(3)
9H8Q BRN MPX4 [AND J.FOR"CANCEL"FOR 7020
9HNB MPX2 SMO FX2
9J82 LDX 3 AWORK1 [PICK UP UNIT POINTER
9JML BZE 3 TP5 [J.AS NO MORE 7007 UNITS
9K7= CALL 7 YREC1
9KLW BRN MPX5 [J.FOR NEXT 7007
9L6G #
9LL6 # NOW CHECK IPB CHAIN FOR ATT.& ASS.OF UNKNOWN PROPERTIES
9M5Q #
9MKB TP5 CALL 7 REC1 [TO FIND RECORD ZERO
9N52 TP1 LDX 3 BIPB(2)
9NJL BZE 3 PC20 [J.TO POSSIBLE REFILL ETC.OF BLOCK
9P4= CALL 7 YREC [FIND IPB CELL
9R2Q TP4 LDX 0 0(3)
9RGB SMO FX2
9S22 STO 0 AWORK1 [STORE POINTER TO NEXT IPB UNIT
9SFL LDX 0 BLINE(3)
=6=6 TP3 SMO FX2
=6PQ STO 0 AWORK2 [STORE POINTER TO IDENTIFIER
=79B CALL 5 ZASAT [&"CANCEL"
=7P2 SMO FX2
=88L LDX 3 AWORK2
=8N= BZE 3 TP2 [J.FOR NEXT IPB UNIT IF NO MORE IDENT
=97W SMO FX2
=9MG STO 3 AWORK4
==76 CALL 7 YREC1 [OTHERWISE FIND IDENTIFIER CELL
==LQ LDX 0 0(3)
=?6B BRN TP3 [J.TO"CANCEL" FOR THIS IDENTIFIER
=?L2 TP2 SMO FX2
=#5L LDX 3 AWORK1 [PICK UP NEXT IPB UNIT CELL PTR
=#K= BZE 3 PC20 [J.AS NO MORE IPB'S
=*4W CALL 7 YREC1
=*JG BRN TP4 [J.FOR NEXT IPB
=B46 BNZ 3 TP4 [& J.FOR NEXT UNIT
=BHQ PC20 LDX 0 A1+1001(1) [NOW HAVE WE FINISHED YET?
=C3B BNG 0 PC21 [J.IF YES
=CH2 LDN 0 1000
=D2L ADS 0 A1(1) [UPDATE A1 OF IDF/APROPNOS BLOCK
=DG= BRN PC22 [J.TO REFILL BLOCK
=D^W #
=FFG # SCAN OF IDF COMPLETED NOW:JUST SEE IF MESSAGE IS NEEDED
=F^6 #
=GDQ PC21 FREECORE 1 [FREE IDF/APRONOS BLOCK
=GYB BSOFF G4SUDBIT,PC23 [J.IF SWITCH IS OFF:NO MESSAGE
=HD2 GETACT GENERAL,APROPNOS [OTHERWISE CREATE ACTIVITY
=HXL LDX 2 BPTR(2)
=JC= LINKSET 2,XPAIR(1)
=JWW FWAIT #54
=KBG OFF G4SUDBIT [LEAVE SWITCH CLEAR
=KW6 PC23
=L*Q CLOSE 1
=LTB ACROSS IDFCLEAN,10
=M*2 #
=MSL #
=N#= #
=NRW #SKI EMSJNL<1$1
=P?G (
=PR6 MESS 52HSYSTEM.IDF HAS BEEN ADJUSTED TO MAKE IT COMPATIBLE W
=Q=Q 44HITH SYSTEM.PROPERTY(AN IDFLIST IS ADVISED).
=QQB )
=R=2 #
=RPL Z20IDFPROP [ENTRY POINT TO SEND MESSAGE
=S9= #SKI EMSJNL<1$1
=SNW (
=T8G SETNCORE 26,3,CONBUFF,COUT [THAT IDF HAS BEEN CHANGED
=TN6 LDN 0 25
=W7Q STO 0 A1(3)
=WMB LDN 6 MESS(1)
=X72 LDN 7 A1+1(3)
=XLL MOVE 6 24
=Y6= CONSOUT
=YKW )
=^5G #SKI EMSJNL
=^K6 INFORM 1,EMSIDF,1
?24Q XSUI ACROSS SUICIDE,1
?2JB Z30IDFPROP
?342 STOZ AWORK1(2)
?3HL XLOPP
?43= MHUNTW 3,AMXOR,AMESS [HUNT MESS BLOCK.
?4GW LDX 6 AWORK1(2)
?52G BXE 6 A1(3),XEND
?5G6 XCO
?5^Q #SKI EMSJNL
?6FB (
?6^2 SMO 6
?7DL LDX 6 A1+1(3)
?7Y= GEOPACK 5,6,1
?8CW OUTP
?8XG OUTPACK 5,1,GEOPER,OUTP
?9C6 ... INFORM 1,IDFPROP,1
?9WQ )
?=BB #SKI EMSJNL<1$1
?=W2 (
??*L SMO 6
??T= LDX 5 A1+1(3)
?##W LDN 6 0
?#SG LDN 4 4
?*#6 DVD 5 XMAJ(1) [CONVERT GEO.NO. TO PRINT FORM.
?*RQ LDX 5 6
?B?B ADN 5 1
?BR2 LDN 6 0
?C=L MODE 1
?CQ= XUSA
?D9W CBD 5 MSGE+1(1) [CONVERT GEO.NO.
?DPG BCHX 1 £
?F96 BCT 4 XUSA
?FNQ SETNCORE 17,3,CONBUFF,COUT [MOVE INFO. INTO BLK. TO BE OUTPUT
?G8B LDN 0 17
?GN2 STO 0 A1(3)
?H7L LDN 6 MSGE(1)
?HM= LDN 7 A1+1(3)
?J6W MOVE 6 16
?JLG CONSOUT [OUTPUT MESSAGE
?K66 )
?KKQ LDN 0 1
?L5B ADS 0 AWORK1(2)
?LK2 BRN XLOPP [J.BACK DEAL WITH NEXT GEO.NO.
?M4L XEND
?MJ= FREECORE 3
?N3W BRN XSUI
?NHG #END
?P36
^^^^ ...413271530002