IPCGEO8

(George Source)

Macros used: COOR3, DECLINK, DSCA, EMPTY, FINDACTFB, FINDPEREC, FREECORE, FRENO, GEOERR, GETNOG, HUNT2, HUNT2J, JDISENG, JIPCM, LTYPE, MENDAREA, MFREE, MHUNT, POP, QTASK, RINGTWO, SEG, SEGENTRY, SETNCORE, UP, UPPLUS

IPCGEO8.txt
22FL          SEG      IPCGEO,,J.R.BAILEY   
22^=    #     THIS SEGMENT DEALS WITH OPENING AND CLOSING   
23DW    #     GEORGE IPC LINKS  
23YG    #   
24D6      SEGENTRY  K1IPCGEO,X1IPCGEO   
24XQ ...  SEGENTRY  K2IPCGEO,X2IPCGEO   
25CB      SEGENTRY  K3IPCGEO,X3IPCGEO   
25X2      SEGENTRY  K4IPCGEO,X4IPCGEO   
26BL    #   
26W=    #     STORED WORDS  
27*W ...TBIT1          #21000000
27TG    VX             #63777777
28*6    #   
28SQ    #     IPCOPEN MACRO ENTRY POINT 
29#B    X1IPCGEO
29S2          STOZ     AWORK4(2)           [MARK ENTRY POINT
2=?L          LDX   0  ACOMMUNE3(2) 
2=R=          STO   0  AWORK3(2)
2?=W          LDX   7  ACOMMUNE4(2)        [DIRECTION OF LINK   
2?QG          BZE   7  P1                  [READ
2#=6          MHUNT    3,IPCD,IPCGLW       [LOCATE CONTROL BLOCK
2#PQ          BRN      P2   
2*9B    P1    MHUNT    3,IPCD,IPCGLR       [LOCATE CONTROL BLOCK
2*P2    P2    STOZ     IPCGREP(3)          [ZEROISE REPLY WORD  
2B8L          LDX   0  ACOMMUNE1(2) 
2BN=          STO   0  IPCGUN(3)
2C7W          FINDPEREC 2,APGEOG,IPCGUN(3) [FIND DEVICE LIST ENTRY  
2CMG          BPZ   2  P3   
2D76    P4    GEOERR   1,IPCOPER1   
2DLQ    P3    LTYPE    2,6                 [LOAD TYPE   
2F6B          SBN   6  28   
2FL2          BNZ   6  P4                  [NOT IPC DEVICE  
2G5L          DSCA     2,LDX,4,CHADD
2GK=          ANDX  4  BITS22LS 
2H4W          SBN   4  CHAINADD 
2HJG          GETNOG   6                   [GET LINK NUMBER 
2J46          BZE   6  PA   
2JHQ          FINDACTFB 1,FX2,IPCA,INTERN,,FPTR 
2K3B          HUNT2    1,IPCD,IPSTACK   
2KH2          LDX   5  ARINGNO(1)   
2L2L          ANDN  5  #7777               [COUNT   
2LG=          BZE   5  P4                  [NONE
2L^W    P6    TXU   6  A1+ALINUM(1) 
2MFG          BCC      P5                  [FOUND!  
2M^6          ADN   1  ARECLEN  
2NDQ          BCT   5  P6                  [TRY NEXT
2NYB          BRN      P4                  [NOT FOUND   
2PD2    P5    BZE   7  P7   
2PXL          MHUNT    3,IPCD,IPCGLW       [LOCATE CONTROL BLOCK
2QC=          BRN      P8   
2QWW    P7    MHUNT    3,IPCD,IPCGLR       [LOCATE CONTROL BLOCK
2RBG    P8    RINGTWO  A1(3),A1(1)  
2RW6          LDX   1  A1(3)
2S*Q    #     SET UP FIELDS IN RING ELEMENT 
2STB          STOZ     ATIMCT(1)
2T*2          STOZ     ASTR(1)  
2TSL          STOZ     ALENTR(1)
2W#=          STOZ     AREPPTR(1)   
2WRW          LDX   0  ACOMMUNE4(2) 
2X?G          STO   0  ALTPROG(1)   
2XR6          STOZ     ASTMEL(1)
2Y=Q          SMO      FX1  
2YQB          LDX   0  TBIT1
2^=2          STO   0  ASTATUS2(1)  
2^PL          STO   0  ASTATUS1(1)  
329=          STO   4  APTRIPB(1)   
32NW    POP 
338G          SETNCORE 2,3,IPCD,ATASK      [SET UP TASK BLOCK   
33N6          STO   6  A1(3)
347Q          LDN   0  5
34MB          STO   0  A1+1(3)  
3572          SMO      4
35LL          LDX   1  CPPTR
366=          JDISENG  1,PCX
36KW          JIPCM    DS,PCX,4 
375G          LDX   5  CPPTR(2)            [SAVE CPPTR  
37K6          STO   1  CPPTR(2) 
384Q          QTASK    3,,4                [ENQUEUE TASK
38JB          STO   5  CPPTR(2)            [RESTORE CPPTR   
3942          LDX   0  AWORK4(2)
39HL          BZE   0  PCU  
3=3=          BZE   7  V1   
3=GW          MHUNT    3,IPCD,IPCGLW
3?2G          BRN      V2   
3?G6    V1    MHUNT    3,IPCD,IPCGLR
3?^Q    V2    LDX   3  IPCRNG(3)
3#FB          LDX   0  VX(1)
3#^2          ANDS  0  ASTATUS2(3)  
3*DL          BRN      V3   
3*Y=    #     CLEAR UP FOR OPEN FAILURE OR CLOSE
3BCW    PCX   SMO      FX2  
3BXG          LDX   0  AWORK3   
3CC6          BZE   0  PC   
3CWQ          MFREE    IPCD,ATASK   
3DBB    V3    UP
3DW2    PCU 
3F*L          UPPLUS   1
3FT=    PC    MFREE    IPCD,ATASK          [THROW AWAY TASK BLOCK   
3JR2          FRENO    6
3K=L    PA    BZE   7  PA1  
3KQ=          MFREE    IPCD,IPCGLW         [THROW AWAY CONTROL BLOCK
3L9W          BRN      PA2  
3LPG    PA1   MFREE    IPCD,IPCGLR  
3M96    PA2   UP
3MNQ    #     IPCLOSE MACRO ENTRY POINT 
3N8B    X2IPCGEO
3NN2          SETNCORE 2,3,IPCD,ATASK      [SET UP TASK BLOCK   
3P7L ...      STO   3   5                 [STORE PTR TO TASK BLOCK  
3PM=          LDX   7  ACOMMUNE4(2) 
3Q6W          BZE   7  Q1   
3QLG          MHUNT    2,IPCD,IPCGLW
3R66          BRN      Q2   
3RKQ    Q1    MHUNT    2,IPCD,IPCGLR
3S5B    Q2    LDX   6  A1(2)
3S5K ...      STO   2  4            [PTR TO IPCGL   
3S5S ...      LDX   2  6               [PTR TO IPSTACK ENTRY
3S63 ...      LDX   0  ALINUM(2)
3S6= ...      STO   0  A1(3)           [LINK NO TO TASK BLOCK   
3S6F ...      LDN   0  3               [CLOSE TYPE  
3S6N ...      STO   0  A1+1(3)  
3S6X ...      LDX   2  APTRIPB(2)   
3S76 ...      LDX   3  CPPTR(2) 
3S7* ...      JDISENG   3,PIN3         [JUMP IF IPB DOWN
3S7J ...      JIPCM    DS,PIN3,2       [OR DIALOGUE SUSPENDED   
3S7R ...      LDX   2  6
3S82 ...      LDCT  0  #010 
3S89 ...      ANDX  0  ASTATUS2(2)     [LOOK IF OPEN IN PROGRESS
3S8D ...      BZE   0  PIN3 
3S8M ...      MFREE    IPCD,ATASK      [IF SO FREE CLOSE
3S8W ...      COOR3    #41             [AND LET OPEN FINISH 
3S95 ...      BRN      X2IPCGEO 
3S99 ...PIN3  LDX   2   6                  [RESTORE PTR TO IPSTACK  
3S9* ...      LDCT  0  #010 
3S9H ...      ERX   0  ASTATUS2(2)     [CLEAR OPEN IN PROGRESS  
3S9Q ...      ANDS  0  ASTATUS2(2)     [IF SET  
3S9^ ...      LDX   3  ALINUM(2)
3S=8 ...      LDX   1   APTRIPB(2)         [PTR TO IPCBX
3S=C ...PIN4  HUNT2J   1,IPCD,ATASK,,PIN5    [LOOK FOR TASK BLOCK   
3S=L ...      LDX   0  A1(1)
3S=T ...      TXU   0  3               [IS IT FOR THIS LINK 
3S?4 ...      BCS      PIN4            [NO, LOOK AGAIN  
3S?? ...      LDN   0  5
3S?G ...      TXU   0  A1+1(1)          [IS IT AN OPEN  
3S?P ...      BCS      PIN4            [NO, LOOK AGAIN  
3S?Y ...      FREECORE  1              [FOUND, SO FREE IT   
3S#7 ...PIN5  LDX   2  4               [POINTER TO IPCGL
3S*8 ...      LDX   1  A1(2)
3SK2 ...      EMPTY    FPTR(1)  
3SSS ...      EMPTY    A1(2)
3T4L          BZE   7  Y
3TJ=          MFREE    IPCD,IPCGLW  
3W3W          BRN      Z
3WHG    Y     MFREE    IPCD,IPCGLR  
3X36    Z     LDX   2  6
3^F=          LDX   0  ASTATUS2(2)  
3^YW          SLL   0  1
42Y6 ...      BNG   0  PIN2 
43CQ          LDX   2  APTRIPB(2)   
43MJ ...      DECLINK  CPPTR(2) 
43XB          LDX   4  CPPTR(2) 
44C2          JDISENG  4,PIN2              [IPB INOPERABLE  
44WL          JIPCM    DS,PIN2,2           [DIALOGUE SUSPENDED  
456D ...      LDX   3   5   
45B=          QTASK    3,,2                [ENQUEUE TASK
46*G          BRN      PA2                 [GO TO CLEAR UP  
46T6    PIN2  MFREE    IPCD,ATASK   
47#Q          LDX   2  6
47SB    YB    LDX   0  ASTATUS2(2)  
48#2          SLL   0  5
48RL          BNG   0  YBA  
49?=          FRENO    ALINUM(2)
49QW ...      BRN      PA2  
4==G ...YBA   STOZ     BPTR(2)  
4=Q6          LDX   2  FX2  
4?9Q ...      BRN      PA2  
4?PB    #     ENTRY POINTS FOR AUTOMATIC RE-ESTABLISHMENT   
4#92    X3IPCGEO
4#NL          MHUNT    3,IPCD,IPCGLR
4*8=          BRN      U1   
4*MW    #   
4B7G    X4IPCGEO
4BM6          MHUNT    3,IPCD,IPCGLW
4C6Q    R1    NGNC  7  1
4CLB    U1    LDN   7  0
4D62          LDX   3  IPCRNG(3)
4DKL          LDX   6  ALINUM(3)           [LINK IDENTIFIER 
4F5=          LDX   4  APTRIPB(3)          [GEOG NO OF IPB  
4FJW          LDN   0  1
4G4G          STO   0  AWORK3(2)
4GJ6          STO   0  AWORK4(2)           [MARK TYPE OF ENTRY  
4H3Q          LDX   0  GSIGN
4HHB          SMO      FPTR(3)  
4J32          STO   0  IPCGREP-IPCRNG   
4JGL          BRN      POP  
4K2=     MENDAREA  100,K99IPCGEO
4KFW    #END
^^^^ ...74761427001300000000