IDFPROP867

(George Source)

Macros used: ACROSS, BSOFF, BXE, CLOSE, CONSOUT, FREECORE, FWAIT, GEOERR, GEOPACK, GETACT, HUNT2, IDFOPEN, INFORM, LINKSET, MENDAREA, MFREE, MGETCELL, MHUNT, MHUNTW, OFF, ON, OPEND, OUTPACK, PAIR, READED, REWIND, SEGENTRY, SETMODE, SETNCORE, STEP, TESTREP, TESTREPNOT

IDFPROP867.txt
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
  • Last modified: 17/01/2024 11:55
  • by 127.0.0.1