IPBCONS867

(George Source)

Macros used: ACROSS, ALTLEN, ALTLENG, BBUS, BXE, CCERROR, CHAIN, CHANG, COOR1, DOWN, FPUT, FREECORE, GEOERR, GEOPACK, GETACT, HUNTW, IDFTPSCN, INFORM, LGEOG, LINKSET, MENDAREA, MFREEW, MHUNTW, NAME, OFF, OUTBLOCN, OUTNUM, OUTPACKC, PAIR, SEGENTRY, SETIDENT, SETUPCORE, SLEEP, SUICIDE, WHICHCON

IPBCONS867.txt
22FL    #SEG  IPBCONS8                     [R.WEYAND
22^=    #LIS  K0IPBCONS>K0IPB>K0ALLGEO  
23DW                   8HIPBCONS
23YG    #   
24D6          SEGENTRY K1IPBCONS,SK1IPBCONS 
24XQ    # THIS SEGMENT CONTROLS A 7023 (REMOTE CONSOLE) CONNECTED VIA AN IPB :  
25CB    # EACH OUTPUT MESSAGE MUST BE ON THE CONSOLE BEFORE THE NEXT IS OUTPUT ;
25X2    # A CPAT IS SET UP TO DEAL WITH ANY DATA INPUT ; WHEN WOKEN , CHECK FOR 
26BL    # SUPERVISORY INPUT , OUTPUT , DATA INPUT & SUP. INPUT AGAIN BEFORE COOR
26W=    #   
27*W    NL             #76327620
27KN ...SM16           #77777577
27TG    SHIFT          #74  
28*6 ...PROLINK PAIR   COMPROA,1
28SQ    SUPCL          #01260000           [CLOSE   
29#B    SUPSEG         #01240000
29S2    XADCB   
2=?L    #HAL  AMXOR+ADCB,0  
2=R=    XIDATSG 
2?=W    #HAL  AMXOR+IDATSG,0
2?QG    OFFMES         #44000070,#76327627,#76277627
2#=6                   36H^'THIS TERMINAL HAS BEEN MOPPED OFF   
2#PQ                   #76277627,#76277627,#76327632
2*9B    OFFEND  
2*P2    OLMESS         #44000040,#76327627,#76273220
2B8L                   16HYOU ARE ONLINED   
2BN=                   #32207627,#76277632  
2C7W    OLEND   
2C7^ ...TLFAILMESS     #44000070,#76327627,#76273220
2C84 ...               32HTHIS TERMINAL/LINE FAILED AT ___  
2C87 ...TIME           8H00.00.00   
2C8= ...               #20327627,#76277632  
2C8* ...TLFEND  
2C8G ...#UNS  CLSKI 
2C96 ...(   
2C9S ...NLAHMK         #56757777             [FOR UNSETTING ATTACH BITS 
2C?Q ...VRDCB                              [DERING AND FREE DCB 
2C*N ...      LDX   1  A1+FPTR(3)          [ADEVS ENTRY 
2CCL ...      STOZ     BPTR(1)  
2CFJ ...      STOZ     A1+BPTR(3)   
2CHG ...      FREECORE 3
2CKD ...      EXIT  5  0
2CLF ...)   
2CMG    #   
2C^X ...#     WAIT FOR SUPERVISORY REPLY BEFORE CLOSING DOWN OR RESTARTING  
2D## ...#     OUTPUT(AFTER A LINE/TERMINAL FAIL) : CLOSE DOWN IF IPB
2DLQ    #     INOPERABLE ; EXIT IF IDENT. INOPERABLE ; EXIT+1 IF SUPERVISORY SEG
2F6B    #   
2FL2    REWA  MHUNTW   3,AMXOR,ADCB 
2G5L          SMO      IADIN(3) 
2G9W ...      LDX   2  IPBRING  
2GB6 ...      LDCT  0  #420 
2GGB ...      ANDX  0  IPBSW-IPBRING(2) 
2GLL ...      BNZ   0  SUC  
2GQW ...      LDCT  0  #100 
2GX6 ...      SMO      A1+FPTR(3)   
2H3B ...      ANDX  0  FOURTHWD 
2H7L ...      SLL   0  1
2H?W ...      ANDX  0  IPBSW-IPBRING(2) 
2HD6 ...      BNZ   0  SUC  
2HJG          LDXC  4  ISTATUS(3)   
2J46          BCS      (7)                 [IDENTIFIER INOPERABLE : EXIT
2JHQ    RESL  LDCT  0  #400 
2K3B          SBX   7  FX1  
2KH2          ORS   0  IWAIT(3) 
2L2L          COOR1 
2LG=          ADX   7  FX1  
2LQ4 ...REHU  LDX   1  ACTRING(2)          [CHECK FOR SUPERVISORY REPLY 
2L^W ...      SBN   1  ACTRING             [(OLDEST) SUPER REPLY WILL BE BEFORE 
2M4F ...      MHUNTW   3,AMXOR,ADCB 
2M74 ...RNEX
2M9N ...      LDX   1  BPTR(1)             [NEXT ACTIVITY   
2M*K ...      BXE   1  3,REWA   
2MFG ...      LDX   0  ATYPE(1) 
2MP# ...      SMO      FX1  
2M^6 ...      TXU   0  XIDATSG  
2N8Y ...      BCS      RNEX                [NO SUPERVISORY REPLY YET
2NDQ          LDX   3  A1+2(1)  
2NYB          FREECORE 1
2PXL          SRL   3  12   
2QC=          ANDN  3  #77                 [ISOLATE CODE
2QWW          EXIT  7  1
2RBG    #   
2RW6    #     RING AMXOR/IOUT BLOCK AFTER IPBOUT AND PUT IT ON THE LIST 
2S*Q    #     NEEDS ADDRESS OF AMXOR/IOUT IN X1 AND ADDRESS OF AMXOR/ADCB IN X3 
2STB    #   
2T*2    RINGO LDX   2  IADIN(3)            [ADDRESS OF IPBIN ACTIVITY   
2TSL          LDX   3  IPBRING(2)   
2W#=          SBN   3  IPBRING             [ADDRESS OF IPBOUT ACTIVITY  
2WRW          LDX   2  ACTRING(3)   
2X?G          SBN   2  ACTRING             [ACTIVITY AFTER IPBOUT   
2XR6          CHAIN    1,BPTR(2)
2Y=Q          LDCT  0  #100 
2YQB          ANDX  0  IPBSW(3)            [B2 SET IF IPBOUT ASLEEP 
2^=2          BZE   0  WAKE 
2^PL          ERS   0  IPBSW(3) 
329=          LDX   2  3
32NW          FPUT  
338G    WAKE  EXIT  7  0
33N6    #   
347Q    #     TEST WHETHER 'CLOSE IDENTIFIER' RECEIVED FOR ONLINE-T&ST REQUEST :
34MB    #     SEND 'CLOSE' AND WAIT FOR 'CLOSE IMPLEMENTED' REPLY ; CALL ON X5  
3572    #   
35LL    OLTE  LDX   0  IWAIT(3) 
366=          SMO      A1+FPTR(3)   
36KW          LDX   4  FOURTHWD 
375G          ANDN  0  #40  
37K6          ANDX  4  BIT9 
384Q          BZE   0  (5)                 [TEST NOT REQUESTED  
38JB          BNZ   4  (5)                 [ALREADY CLOSED  
3942    SECL  LDN   4  3
39HL          SBX   5  FX1  
3=3=          LDCT  6  #400 
3=GW          CALL  7  SETU                [GET IOUT BLOCK FOR 'CLOSE'  
3?2G          ADX   4  SUPCL(1) 
3?G6          STO   4  IPBIDE(2)
3?^Q          LDX   1  2
3#FB          CALL  7  RINGO               [OUTPUT 'CLOSE'  
3#^2          CALL  7  REWA                [WAIT FOR CLOSE IMPLEMENTED  
3*DL          BRN      RESL                [I KNOW IT'S INOPERABLE !
3*Y=          ERN   3  #66  
3BCW          BNZ   3  REHU                [NOT CLOSE IMPLEMENTED   
3BXG          ADX   5  FX1  
3CC6          LDX   0  AWORK2(2)
3CWQ          BZE   0  (5)                 [NO OUTPUT IN PROGRESS   
3DBB          STOZ     AWORK2(2)
3DW2          MFREEW   CONBUFF,IREMTW      [OUTPUT SENT WILL HAVE BEEN DISCARDED
3F*L          EXIT  5  0
3FT=    #   
3G#W    #     GET AMXOR/IOUT BLOCK : LENGTH IN X4 ; BLOCK STATUS WORD IN X6 
3GSG    #   
3H#6    SETU  SBX   7  FX1  
3HRQ ...      SETUPCORE 4,2,AMXOR,IOUT  
3J?B          ADX   7  FX1  
3JR2          STO   6  IBSW(2)             [BLOCK STATUS WORD   
3K=L          MHUNTW   3,AMXOR,ADCB 
3KQ=          LDX   4  IDENTNO(3)   
3L9W          EXIT  7  0
3LPG    #   
3M96    #     LOOK FOR 'SUCCESS' OR 'FAIL' REPORT ON PREVIOUS OUTPUT ; IF FAIL ,
3MNQ    #     REPORT INOPERABILITY OR REPEAT OUTPUT ; IF SUCCESS , PROCEED WITH 
3N8B    #     NEXT OUTPUT AND/OR DEAL WITH ANY INPUT ; IF NEITHER & IDLE , COOR1
3NN2    #   
3P7L    SK1IPBCONS  
3PM=          STOZ     AWORK2(2)           [INITIALISE 'OUTPUT IN PROGRESS' AND 
3Q6W    WASID LDN   7  0                   ['IDLE' MARKERS  
3QLG    SKSUP LDX   3  ACTRING(2)          [ENTRY WHEN NO INPUT OR OUTPUT TO DO 
3R66          SBN   3  ACTRING             [ADDRESS OF NEXT ACTIVITY
3RKQ    NEB   LDX   3  BPTR(3)             [SEARCH BACK FOR SUPERVISORY SEGMENT 
3S5B          LDX   0  ATYPE(3) 
3SK2          TXU   0  XADCB(1)            [IF DCB ENCOUNTERED FIRST , THEN 
3T4L          BCC      NOSUP               [NO SUPERVISORY SEGMENTS WAITING 
3TJ=          TXU   0  XIDATSG(1)   
3W3W          BCS      NEB  
3WHG          BCHX  3  £
3X36          LDCH  4  A1+2(3)             [CODE OF SUPERVISORY SEGMENT 
3XGQ          ANDX  3  BITS22LS 
3Y2B          FREECORE 3
3Y7J ...#UNS  CCERROR   
3Y#Q ...      LDX   0  4
3YG2          SBN   4  53   
3Y^L          BZE   4  REPFL               ['FAIL' REPORTED 
3^F=          SBN   4  7                   [CODE 60 = OUTPUT SUCCESSFUL 
3^YW          BZE   4  NOGE                [SUCCESS : READY FOR MORE OUTPUT 
42DG          ADN   4  2
42Y6          BZE   4  REPFL               [CODE 58 : UNAVAILABLE = 7020 INOP   
43CQ          ADN   4  10   
43FD ...      BNZ   4  SKSUP
43H6 ...      MHUNTW   3,AMXOR,ADCB 
43H^ ...      LDX   0  IMDNPU(3)
43JS ...      ANDX  0  BSP16               [ISOLATE NPU RECEIVED IN ID OPENED SE
43KM ...      BNZ   0  SUNAV               [J IF VALID  
43LG ...[                                   VIRTUAL 7900 MAY SEND ZERO NPUSIZE  
43M* ...[                                   INDICATES IT IS IRRELEVANT- USE OLD 
43N8 ...      SMO      FX2  
43P3 ...      LDX   0  AWORK1   
43PW ...      STO   0  IMDNPU(3)
43Q8 ...SUNAV   
43QG ...      LDXC  0  ISTATUS(3)   
43QS ...      BCS      REPFL               [J. IDENT OPENED BUT UNAVAILABLE 
43R6 ...      BRN      SKSUP
43RJ ...ZERRJ   
444J ...#UNS  CCERROR   
449Q ...#SKI
44C2          GEOERR   1,WRONGSUP   
44F9 ...#UNS  CCERROR   
44HD ...(   
44KM ...      LDX   4  0
44MW ...      CCERROR  CCWRONGSUP,4 
44Q5 ...      BRN      SUC  
44S# ...)   
44WL    NOGE  LDX   0  AWORK2(2)
45B=          BZE   0  SKSUP               [NO OUTPUT IN PROGRESS : IGNORE  
45TW          MFREEW   CONBUFF,IREMTW      [FREE OUTPUT BLOCK   
46*G          BRN      SK1IPBCONS   
46T6    #   
47#Q    NOSUP BZE   7  NOTID               [NON-ZERO IF IDLE
47SB    SLEEP LDX   1  A1+FPTR(3)          [POINT TO ADEVS ENTRY
48#2          LDCT  0  #101                [B8 SET IF ONLINING CONCEPTUAL   
48RL          LDCT  4  #100 
49?=          ANDX  0  FOURTHWD(1)         [B2 SET IF BEING MOPPED OFF  
49QW          ANDX  4  FINISH              [B2 SET IF 'FINISH NOW' COMMAND GIVEN
4==G          SLL   0  2
4=Q6          BNG   0  OPOF 
4?9Q          BNZ   4  OFFI 
4?PB          BNZ   0  ONLI 
4?QF ...SLEEP1  
4?Y3 ...      LDX   0  IMDNPU(3)
4#2= ...      SMO      FX2  
4#4F ...      STO   0  AWORK1              [SAVE NPU IN CASE GOES ON TEST   
4#92          CALL  5  OLTE                [TEST WHETHER ONLINE-TEST REQUESTED  
4#NL          MHUNTW   3,AMXOR,ADCB 
4*8=          LDCT  7  #400 
4*MW          ORS   7  IWAIT(3)            [SET B0 TO INDICATE 'ASLEEP' IN DCB  
4B7G          COOR1 
4BM6          MHUNTW   3,AMXOR,ADCB 
4C6Q          LDCT  0  #100 
4CLB          ANDX  0  ISTATUS(3)   
4D62          BNZ   0  SLEEP [IF IDENTIFIER CLOSED(ON TEST),GO BACK TO SLEEP
4DKL          BRN      WASID
4F5=    #   
4FJW    NOTID LDX   0  AWORK2(2)
4G4G          BNZ   0  SKIN                [OUTPUT IN PROGRESS : LOOK FOR INPUT 
4G6D ...      LDX   4  ISTATUS(3)   
4G8B ...      SLC   4  6
4G=# ...      BNG   4  SENDFAILMES         ['SEND FAIL MESS TO TERMINAL' FLAG   
4G#= ...#   
4GB8 ...#     LOOK FOR CONSOLE OUTPUT   
4GD6 ...#   
4GG4 ...SKOUT   
4GJ6          HUNTW    1,CONBUFF,IREMTW    [NO OUTPUT IN PROGRESS   
4H3Q          BNG   1  SKIN                [NO OUTPUT WAITING   
4HHB          LDCT  0  #400 
4J32          ANDX  0  ISTATUS(3)   
4JGL          BNZ   0  SETFL               [INOPERABLE OR FAIL BIT SET  
4K2=          LDEX  0  ICHARS(3)           [LENGTH OF CONSOLE LINE  
4KFW          STO   0  ACOMMUNE1(2) 
4K^G    #   
4LF6    #     CONVERT OUTPUT INTO LINE FORM AND ENLIST IPBOUT TO OUTPUT IT  
4LYQ    #   
4MDB          LDX   3  IMDNPU(3)
4MY2          ANDN  3  #7777               [NPU. SIZE ON THIS IDENTIFIER
4NCL          LDN   4  IPBIDE-A1(3) 
4NX=          LDN   6  0
4PBW          CALL  7  SETU 
4PWG          STO   4  IPBIDE(2)           [IDENTIFIER NUMBER   
4QB6          LDCT  0  #440 
4QTQ          LDX   6  IMDNPU(3)
4R*B          ANDN  6  #7777               [NPU SIZE ON THIS IDENTIFIER 
4RT2          STO   0  IPBIDE+1(2)         [B0 : ETX ; B3 : REPORT SUCCESS/FAIL 
4S#L          SLL   6  2
4SS=          LDN   0  1
4T?W          SBN   6  4                   [SAFETY MARGIN   
4TRG          STO   0  IMOPTY(2)           [WAKE CONSA AFTER OUTPUT SENT
4W?6          ADN   2  IDATA
4WQQ          MHUNTW   3,CONBUFF,IREMTW 
4X=B          LDEX  7  A1(3)
4XQ2          SLL   7  2                   [CONVERT WORD COUNT INTO CHARS   
4Y9L          BZE   7  STNL                [NULL OUTPUT : NEWLINE ONLY  
4YP=          LDN   4  #76  
4^8W          ADN   3  ICBUFF   
4^NG    STMOR SMO      FX2  
5286          LDX   5  ACOMMUNE1           [CONSOLE WIDTH   
52MQ          SBX   5  7
537B          BNG   5  OVEL                [MORE THAN ONE LINE  
53M2          LDN   5  0                   [ONLY ONE LINE   
546L          BRN      WLOOP
54L=    OVEL  ADX   7  5                   [CONSOLE WIDTH IN X7 
555W          NGX   5  5                   [REMAINDER COUNT IN X5   
55KG    WLOOP LDCH  0  0(3) 
5656          BCHX  3  £
56JQ          TXL   0  SHIFT(1)            [#74 
574B          BCS      WLOP 
57J2          SBN   6  1
583L          BZE   6  STNL                [NPU FULL : TRUNCATE MESS. IF NEC.   
58H=          DCH   4  0(2)                [TRANSLATE #74-#76 INTO LINE CODE
592W          BCHX  2  £
59GG          SBN   0  #10  
5=26    WLOP  DCH   0  0(2) 
5=FQ          BCHX  2  £
5=^B          SBN   6  1
5?F2          BZE   6  STNL                [NPU FULL
5?YL          BCT   7  WLOOP
5#D=          ADS   5  7                   [COUNT OF CHARS STILL TO CONVERT 
5#XW    STNL  LDX   0  NL(1)               [#76327620 : NEWLINE 
5*CG          LDN   1  0
5*X6          MVCH  1  4
5BBQ          SBN   6  4
5BWB          LDX   1  FX1  
5CB2          BNG   6  NFUL                [NPU FULL : OUTPUT BLOCK 
5CTL          BZE   6  NFUL                [AND TRUNCATE MESSAGE
5D*=          BNZ   7  STMOR               [END OF LINE BUT MORE TO COME
5DSW    #   
5F#G    NFUL  MHUNTW   3,AMXOR,ADCB 
5FS6          LDX   4  IMDNPU(3)
5G?Q          ANDN  4  #7777               [NPU SIZE
5GRB          SLL   4  2
5H?2          SBN   4  4                   [SAFETY MARGIN   
5HQL          SBX   4  6                   [SUBTRACT REMAINDER COUNT
5J==          SMO      FX2  
5JPW          LDX   2  FPTR 
5K9G          DSA   4  IPBIDE+1(2)         [COUNT OF CHARS. IN MESSAGE  
5KP6          ADN   4  IDATA-A1*4+3 
5L8Q          SRL   4  2
5LNB          ALTLEN   2,4                 [ALTER TO CORRECT LENGTH 
5M82          MHUNTW   3,AMXOR,ADCB 
5MML          MHUNTW   1,AMXOR,IOUT 
5N7=          CALL  7  RINGO               [ENLIST IPBOUT TO OUTPUT BLOCK   
5NLW          LDN   0  1
5P6G          STO   0  AWORK2(2)           [SET 'OUTPUT IN PROGRESS' MARKER 
5PL6    #   
5Q5Q    #     LOOK FOR CONSOLE INPUT , CONVERT FROM LINE CODE AND SET UP CPAT TO
5QKB    #     DEAL WITH IT ; IDATSG BEFORE DCB IS INPUT & AFTER DCB IS SUP. SEG.
5R52    #   
5RJL    SKIN  LDX   1  FX1  
5S4=          LDCT  7  #400 
5SHW    NINT  LDX   3  FX2  
5T3G    NIB   LDX   3  FPTR(3)             [LOOK FORWARDS FOR NORMAL INPUT  
5TH6          LDX   0  ATYPE(3) 
5W2Q          TXU   0  XADCB(1)            [NONE IF DCB MET FIRST   
5WGB          BCC      SKSUP               [NOW LOOK FOR SUP. SEG.  
5X22          TXU   0  XIDATSG(1)   
5XFL          BCS      NIB                 [NO AMXOR/IDATSG FOUND YET   
5XHN ...      HUNTW    1,FILE,FRB   
5XKQ ...      BNG   1  NOLON               [NOT SECOND PART OF LONG INPUT   
5XMS ...      LDX   5  A1(1)               [COUNT OF FIRST PART 
5XPW ...      LDX   3  A1(3)
5XRY ...      ADS   3  A1(1)
5XW2 ...      ANDN  3  #7777               [COUNT OF SECOND PART
5XY4 ...      LDN   4  CPDATA-A1*4+3(3) 
5Y26 ...      ADX   4  5
5Y48 ...      LDX   6  1
5Y6= ...      SRL   4  2
5Y8# ...      ALTLENG  6,4,RIOT            [LENGTHEN FILE/FRB   
5Y=B ...      MHUNTW   1,AMXOR,IDATSG   
5Y#D ...      SRC   5  2
5YBG ...      MHUNTW   2,FILE,FRB   
5YDJ ...      LDN   4  CPDATA(1)
5YGL ...      ADN   5  CPDATA(2)
5YJN ...      BZE   3  PASSA               [J IF ZERO MESSAGE COUNT 
5YLQ ...      MVCH  4  0(3)                [APPEND SECOND PART OF MESSAGE   
5YNS ...PASSA LDX   3  2
5YQW ...      FREECORE 1
5YSY ...      BRN      ZTES 
5YX2 ...RIOT  MHUNTW   2,FILE,FRB          [RE-FIND IF CORE MOVES DURING ALTLENG
5Y^4 ...      EXIT  1  0
5^36 ...NOLON NAME     3,FILE,FRB   
5^58 ...      LDX   1  FX1  
5^7= ...ZTES  LDX   6  A1(3)
5^9# ...      LDN   0  #7777
5^?B ...      ANDS  0  A1(3)               [ISOLATE CHARACTER COUNT 
5^*D ...      BPZ   6  RECK                [NOT EOM:WAIT FOR REST OF INPUT MESS 
5^D6          CHANG                        [CONVERT BACK FROM LINE CODE 
5^XQ          GETACT   CPAT 
62CB          LDX   3  BPTR(2)  
62X2          LINKSET  3,PROLINK(1)        [LINK TO K1COMPRO
63BL          LDN   0  #222 
63W=          LDN   4  #61  
64*W          STO   0  CONTEXT(3)          [SET REMOTE/NO-USER/OPERATOR CONTEXT 
64TG          STO   4  AMXMSK(3)           [SET MONITORING FILE MASK
65*6          LDN   4  AWORK3(2)           [AWORK3-4 SET UP BY IPBSCAN  
65SQ          LDN   5  JSOURCE1(3)  
66#B          MOVE  4  2
66J7 ...      LDX  0  CPPTR(2)             [LD CPPTR FROM CONSA/I7023   
66LQ ...      STO  0  CPPTR(3)             [ST IN NEW CPAT  
66S2          MHUNTW   1,FILE,FRB   
67?L          CHAIN    1,3                 [CHAIN INPUT AFTER NEW CPAT  
67R=          LDX   2  3
68=W          FPUT                         [ACTIVATE NEW CPAT   
68GN ...RECK
68QG          LDN   7  0                   [CHECK EVERYTHING AGAIN BEFORE COOR1 
69=6          BRN      NINT 
69PQ    #   
6=9B    #     MOP OFF IN PROGRESS : STOP INPUT AND CLEAR , THEN CLEAR UP
6=P2    #   
6?8L ...OPOF  LDN   4  OFFEND-OFFMES+IDATA-A1-1 
6?N=          LDN   6  0                   ['MOP OFF' INDICATOR 
6#7W          LDXC  0  ISTATUS(3)   
6#MG          BCC      OFT                 [IDENT OPERABLE : SEND MESSAGE   
6*76    OFFI  LDN   4  3
6*LQ          LDCT  6  #400                ['FINISH NOW' INDICATOR  
6B6B    OFT   SMO      IADIN(3)            [ACCESS AMOP/IPBOUT  
6BL2          LDX   1  IPBRING  
6C5L          LDCT  0  #620                [B0 : INOP ; B1 : SYS OVERLOAD   
6CK= ...      LDCT  5  #100 
6D4W          ANDX  0  IPBSW-IPBRING(1)    [B4 : MOP OFF,PM 
6DJG ...      ANDX  5  ISTATUS(3)   
6F46          BNZ   0  SUC                 [SEND NO OUTPUT  
6FHQ          BNZ   5  SUC                 [CLOSED ALREADY : WAS ON TEST
6G3B          CALL  7  SETU                [GET IOUT BLOCK  
6G?8 ...      STOZ     IMOPTY(2)           [DON'T WAKE AFTER OUTPUT 
6GH2          LDX   0  IDENTNO(3)   
6H2L          BNG   6  OFIN                [NO MESSAGE IF FINISHING 
6HG= ...      STO   0  IPBIDE(2)         [IDENTIFIER FOR DATA PORTION   
6JFG          LDN   4  OFFMES(1)
6J^6 ...      LDN   5  IPBIDE+1(2)  
6KDQ          MOVE  4  OFFEND-OFFMES       [MOP OFF MESSAGE : DATA PORTION  
6KGF ...      LDX   1  2
6KJ8 ...      CALL  7  RINGO               [SEND MESSAGE
6KKX ...      LDN   4  IPBIDE+1-A1  
6KML ...      CALL  7  SETU                [SET UP NEW BLOCK FOR STOP INPUT SEG 
6KP* ...      LDCT  0  #400 
6KR4 ...      STO   0  IBSW(2)             [NO DATA SEG 
6KSR ...      STOZ     IMOPTY(2)           [DONT WAKE AFTER OUTPUT  
6KWG ...      LDX   0  4                   [IDENT NUMBER
6KYB    OFIN  ADX   0  SUPSEG(1)           [WORD COUNT + 'STOP INPUT' CODE  
6LD2          STO   0  IPBIDE(2)
6LXL          LDX   1  2
6MC=          CALL  7  RINGO
6MWW          CALL  7  REWA 
6NBG          BRN      SUC                 [IDENT INOP : CLEAR UP   
6NW6          ERN   3  #74  
6P*Q          BZE   3  SUC                 ['SUCCESS'   
6PTB          ERN   3  #64$#74  
6Q*2 ...      BZE   3  SUC  
6QSL          BNG   6  SUC                 [NO 'SUCCESS' EXPECTED IF FINISHING  
6R#=          LDN   5  0
6RRW          BRN      REHU 
6TQB    SUC   MHUNTW   3,AMXOR,ADCB 
6W=2          LDX   1  A1+FPTR(3)   
6WPL          STOZ     BPTR(1)             [CLEAR ADEVS POINTER 
6X9=          STOZ     A1+BPTR(3)   
6XNW          SUICIDE   
6Y8G    #   
6YN6    #     CONCEPTUAL BEING ONLINED : OUTPUT ONLINED MESSAGE AND CLOSE   
6^7Q    #   
6^#Y ...ONLI
6^G6 ...      LDCT  0  #200                [TEST BIT 1 - ATTACH 
6^M# ...      ANDX  0  FOURTHWD(1)  
6^SG ...      BZE   0  SLEEP1                 [J IF NOT ATTACHED
6^^N ...      SMO      IADIN(3) 
7272          LDXC  0  IPBSW
72LL          BCS      SETOL               [IPB INOP : CLEAR UP 
736=          LDXC  0  ISTATUS(3)   
73KW          BCS      NOWC                [IDENTIFIER INOP : NO MESSAGE
745G ...      SLL   0  2
74K6 ...      BNG   0  SETOL               [CLOSED ALREADY : WAS ON TEST
754Q          LDN   4  OLEND-OLMESS+IDATA-A1-1  
75JB          LDN   6  0
7642          CALL  7  SETU 
76HL          STO   4  IDENTNO(2)   
773=          STOZ     IMOPTY(2)
77GW          LDN   4  OLMESS(1)
782G          LDN   5  IPBIDE+1(2)  
78G6          MOVE  4  OLEND-OLMESS 
78^Q          LDX   1  2
79FB          CALL  7  RINGO
79^2          CALL  7  REWA 
7=DL          BRN      NOWC                [IDENTIFIER INOPERABLE   
7=Y=          ERN   3  #74  
7?CW          BZE   3  NOWC                [SUCCESS 
7#WQ          BRN      REHU 
7*BB    NOWC  MHUNTW   3,AMXOR,ADCB 
7*W2          CALL  5  SECL                [SEND 'CLOSE'
7B*L    SETOL MHUNTW   3,AMXOR,ADCB 
7B*R ...#UNS  CLSKI 
7B*Y ...(   
7BB7 ...      LDX   7  IDENTNO(3)   
7BBN ...      LDX   1  A1+FPTR(3)   
7BC9 ...      LDCT  0  #200 
7BCQ ...      ANDX  0  FOURTHWD(1)  
7BD? ...      BZE   0  NLAH                [J IF NO LONGER ATTACHED 
7BDS ...      LDX   0  BIT10
7BF* ...      ANDX  0  FOURTHWD(1)  
7BFW ...      BZE   0  SLONL               [J IF ONLINE ACT STILL RUNNING   
7BGC ...      ERS   0  FOURTHWD(1)  
7BGY ...      SMO      IADIN(3) 
7BHF ...      LDX   6  CPPTR               [DEV LIST ADDR   
7BJ2 ...      WHICHCON (GEOERR),NLAH,6,7            [FIND OUT WHICH CONCEPTUAL  
7BJH ...      MHUNTW   3,AMXOR,ADCB 
7BK4 ...      LDCT  0  #10  
7BKK ...      SMO      A1+FPTR(3)   
7BL6 ...      ORS   0  FOURTHWD 
7BLM ...      CALL  5  VRDCB               [FREE DCB
7BM8 ...      ACROSS   ATTACHB,4           [GO TO COMPLETE ATTACHMENT   
7BMP ...NLAH  MHUNTW   3,AMXOR,ADCB 
7BN= ...      SMO      FX1  
7BNR ...      LDX   0  NLAHMK   
7BP# ...      SMO      A1+FPTR(3)   
7BPT ...      ANDS  0  FOURTHWD            [UNSET ATTACHED MARKERS IN ADEVS 
7BQB ...      LDX   4  IADIN(3)            [AMOP ADDRESS
7BQX ...      CALL  5  VRDCB               [FREE DCB
7BRD ...      SETIDENT 4,7                 [REINITIALISE IDENT  
7BR^ ...      SUICIDE   
7BSG ...SLONL   
7BSW ...)   
7BT=          LDCT  0  #10  
7C#W          SMO      A1+FPTR(3)   
7CSG          ORS   0  FOURTHWD            [SET 'ONLINE' BIT IN ADEVS ENTRY 
7D#6          BRN      SUC  
7D#L ...#   
7D*6 ...#     REPORT TERMINAL/LINE FAILURE TO TERMINAL OPERATOR IF RE-OPERABLE  
7D*L ...#   
7DB6 ...SENDFAILMES 
7DBL ...      SRC   4  6
7DC6 ...      BNG   4  SKOUT               [IDENTIFIER STILL INOPERABLE 
7DCL ...      LDN   4  TLFEND-TLFAILMESS+IDATA-A1-1 
7DD6 ...      LDN   6  0
7DDL ...      CALL  7  SETU 
7DF6 ...      STO   4  IDENTNO(2)   
7DFL ...      STOZ     IMOPTY(2)
7DG6 ...      LDN   4  TLFAILMESS(1)       [MOVE IN FAIL MESSAGE
7DGL ...      LDN   5  IPBIDE+1(2)  
7DH6 ...      MOVE  4  TLFEND-TLFAILMESS
7DHL ...      LDX   1  2
7DJ6 ...      SMO      FX2  
7DJL ...      LDN   4  CPRW1               [INSERT TIME OF FAIL 
7DK6 ...      ADN   5  TIME-TLFAILMESS  
7DKL ...      MOVE  4  2
7DL6 ...      CALL  7  RINGO               [Q MESSAGE   
7DLL ...      CALL  7  REWA                [AWAIT REPLY 
7DM6 ...      BRN      SKOUT               [IDENTIFIER INOPERABLE   
7DML ...      LDX   4  3
7DN6 ...      MHUNTW   3,AMXOR,ADCB 
7DNL ...      ERN   4  #74  
7DP6 ...      BNZ   4  SKOUT               [NOT OUTPUT SENT : DON'T UNSET FLAG  
7DPL ...      LDCT  0  4                   [OK : UNSET 'SEND FAIL MESS TO   
7DQ6 ...      ERS   0  ISTATUS(3)          [TERMINAL' FLAG  
7DQL ...      BRN      SKOUT
7DRQ    #   
7F67 ...#     INOPERABLE : 7020 INOPERABLE IF LINE/TERMINAL FAIL
7FDJ ...#                  7023 INOPERABLE IF UNAVAILABLE OR DEVICE FAIL
7FR2    #   
7G=L    REPFL STOZ     AWORK2(2)           [NO OUTPUT NOW IN PROGRESS   
7GQ=          MHUNTW   3,AMXOR,ADCB 
7H9W          LDX   5  ISTATUS(3)   
7HPG          LDN   7  0
7J96          BPZ   5  NOTID               [CONSOLE OPERABLE : REPEAT OUTPUT
7J9W ...      LDX   2  IADIN(3) 
7J=L ...      LDX   0  IPBSW(2) 
7J?B ...      SLL   0  9
7J#6 ...      BPZ   0  NOTFR
7J#^ ...      LDX   2  A1+FPTR(3)   
7JB= ...      BBUS     16,FOURTHWD(2),NOTFR     [7023 FREED IF BIT 16 IS SET
7JCH ...      SMO      FX1  
7JDS ...      LDX   0  SM16 
7JG5 ...      ANDS  0  FOURTHWD(2)      [UNSET BIT 16   
7JGG ...      LDX   0  BIT11
7JGX ...      ORS   0  FOURTHWD(2)  
7JHB ...      LDX   2  FX2  
7JJM ...      BRN      NINT 
7JKY ...NOTFR   
7JNQ          LDX   4  IDENTNO(3)          [IDENTIFIER NUMBER   
7K8B          SLL   5  5
7KN2          LDX   2  IADIN(3)            [ADDRESS OF AMOP/IPBIN   
7L7L          LGEOG    ,6   
7LM=          BPZ   5  NOLIF               [J IF NOT LINE FAILURE   
7LX4 ...      IDFTPSCN XBI,SKIN,CPPTR(2),4 [GET 7020 LINE NUMBER ; J IF MOPOFF  
7MLG          LDX   4  ACOMMUNE3(2)        [LINE NUMBER 
7N66    NOLIF OUTBLOCN 4
7NKQ          GEOPACK  6,6,6
7P5B          OUTPACKC 6,1,GEOPER   
7PK2          OUTNUM   4,0  
7Q4L          BPZ   5  RELIF
7QJ=          INFORM   1,JINOP,1           [LINE INOPERABLE 
7R3W          MHUNTW   3,AMXOR,ADCB 
7R5? ...      LDCT  0  4
7R6N ...      ANDX  0  ISTATUS(3)   
7R85 ...      BNZ   0  SETFL               ['SEND FAIL MESS TO TERMINAL' FLAG   
7R9G ...                                   [SET, IE A PREVIOUS TERMINAL/LINE
7R=X ...                                   [FAIL NOT YET REPORTED TO TERMINAL.  
7R## ...      LDCT  0  4
7R*P ...      ERS   0  ISTATUS(3)          [FLAG NOT SET : SET IT AND RECORD
7RC6 ...      LDN   4  FTIME               [TIME OF FAIL IN THIS ACTIVITY'S 
7RDH ...      LDN   5  CPRW1(2)            [UNUSED WORDS:- CPRW1 & CPRW2
7RFY ...      MOVE  4  2
7RHG    SETFL CALL  5  OLTE                [TEST WHETHER ONLINE-TEST REQUESTED  
7S36    NOREQ DOWN     CONSROOT,2          [RE-ROUTE OUTPUT IF REQUIRED 
7SGQ          LDN   7  0                   [CHECK EVERYTHING AGAIN BEFORE COOR1 
7T2B          BRN      NINT                [LOOK FOR INPUT FIRST
7TG2    RELIF INFORM   1,HINOP,1           [IDENTIFIER INOPERABLE   
7T^L          BRN      NINT                [LOOK FOR UNPROCESSED INPUT  
7W5G ...XBI   GEOERR   1,BREAKIN!          [CANT HAVE BREAK-IN  
7WF=          MENDAREA 50,K100IPBCONS   
7WYW    #END
^^^^ ...33504325000600000000
  • Last modified: 17/01/2024 11:55
  • by 127.0.0.1