RELIEF866

(George Source)

Macros used: ACROSS, ALTLEN, BUTTONUP, CHAIN, FINDPEREC, FINDSUX, FREECORE, GEOERR, HUNT2J, INFORMX, IPCSTATE, LADDP, LINT, MENDAREA, MHUNTW, OUTPACK, READ, SEGENTRY, SETNCORE, SETUPCORE, TRACE, TWTRACE, UP, UPPLUS

RELIEF866.txt
22FL    #SEG  RELIEF70                     [BOB NICHOLSON   
22^=    #LIS  K0TWINSET>K0RELIEF
23DW          8HRELIEF  
23YG    #   
24D6    #     THIS SEGMENT DEALS WITH HOLD ,SH, DE AND UN MESSAGES RECEIVED FROM
24XQ    #     THE OTHER PROCESSOR VIA TWINSETA.ALSO SET ENGAGE BUTTONS IF STATE 
25CB    #     OF EDS60 HAS CHANGED I.E.ENGAGED TO DISENGAGED.   
25X2    #     1PCSTATE SUBROUTINES ARE ALSO CONTAINED IN THIS SEGMENT   
26BL    #   
26W=          SEGENTRY K1RELIEF,YGHOLD     [HOLD MESSAGE RECEIVED FROM OTHER SID
27*W          SEGENTRY K2RELIEF,YGBOLE     [SET ENGAGE BUTTON   
27TG          SEGENTRY K3RELIEF,QK3        [STATUS CHANGE ISSUED IN OTHER PROCES
28*6          SEGENTRY K4RELIEF,QK4        [IPCSTATE
28SQ          SEGENTRY K5RELIEF,QK5        [RECEIVES LIST OF SCRATCH AREAS  
29#B          SEGENTRY K7RELIEF,QK7        [SENDS LIST OF SCRATCH AREAS 
29S2          SEGENTRY K8RELIEF 
2=?L                   +0                  [=-1 IF TRACING  
2=R=          SEGENTRY K9RELIEF,QK9        [REPLY TO STATUS CHANGE FROM OTHER PR
2?=W    #   
2?QG    #     CONSTANTS 
2#=6    #   
2#PQ    XBIT5910       #01060000
2*9B    XM5            #76027777
2*P2    XM6            #76007777
2B8L    Q24            +24                 [FOR BUTTON UP   
2BN=    XSHARE         +ENTIN16            [UNIT N SHARED   
2C7W    XDED           +ENTIN18             [UNIT N IS DEDICATED
2CMG    XUNDED         +ENTIN20             [UNIT N IS UNDEDICATED  
2D76    #   
2DLQ    #   
2F6B    #     ROUTINE TO FIND DEVICE LIST  X5=GEOG NO   
2FL2    #   
2G5L    XFINDL  
2GK=          STO   0  EX4                 [STORE LINK  
2H4W          FINDPEREC 1,APGEOG,5,,,XCME   
2HJG          BRN      (EX4)
2J46    #   
2JHQ    [   
2K3B    [     ROUTINE TO OUTPUT MESSAGE ON CONSOLE FOR A DEVICE 
2KH2    [     ON ENTRY X4=UNIT NO. X5=MESSAGE IDENTIFIER X7=LINK
2L2L    [   
2LG=    OUTPUT  
2L^W          SBX   7  FX1  
2MFG          OUTPACK  4,1,VARDEC          [CONVERT TO ENGLISH  
2M^6          LDN   1  1                   [CONSOLE 
2NDQ          INFORMX  1,5,1               [OUTPUT  
2NYB          ADX   7  FX1  
2PD2          EXIT  7  0
2PXL    [   
2QC=    T2    ACROSS   TWINSETA,2   
2QWW    #   
2RBG    #   
2RW6    #     SUBROUTINE TO FIND EWDAS/ENLINK ON JOBRING
2S*Q    #   
2STB    #     ON ENTRY X6=REQUEST TYPE X5=NUMBER X7 LINK
2T*2    #   
2TSL    #     ON EXIT X2=FX2 X3=PTR TO ENLINK IF EXIT1 ELSE EXIT 0 X3=RUBBISH   
2W#=    #   
2WRW    XLOOK LDX   2  FX2  
2X?G          LDX   3  ETFRING(2)          [PTR TO FIRST ENLINK 
2XR6    RA    LDN   0  ETFRING(2)          [BASE OF ENTWIN'S JOBRING
2Y=Q          TXU   0  3
2YQB          BCC      (7)                 [J IF END OF CHAIN   
2^=2          SBN   3  ENLA                [PTR TO START OF ENLINK  
2^PL          TXU   6  ENRQ(3)             [
329=          TXU   5  ENBR(3)             [COMPARE 
32NW          BCC      RB                  [..AND J IF ENLINK FOUND 
338G          LDX   3  ENLA(3)             [ELSE GET PTR TO NEXT
33N6          BRN      RA   
347Q    RB    EXIT  7  1                   [EXIT FOUND  
34MB    #   
3572    #     SUBROUTINE TO FIND EWDAS/ITCH WITH SPECIFIED NUMBER IN ETBUFS+1   
35LL    #   
366=    #     X7 LINK  NO SPECIAL ENTRY CONDITIONS  
36KW    #   
375G    #     ON EXIT X3 PTR TO ITCH IF EXIT 1 ELSE EXIT 0 NOT FOUND
37K6    #   
384Q    XITCH LDX   3  FX2  
38JB    NG3   HUNT2J   3,EWDAS,ITCH,,NG9
3942          SMO      FX2  
39HL          LDX   0  ETBUFS+1            [GET NO. 
3=3=          TXU   0  ENSTART(3)          [COMPARE 
3=GW          BCS      NG3                 [J IF DIFFER 
3?2G          EXIT  7  1                   [FOUND   
3?G6    NG9   EXIT  7  0                   [NOT FOUND   
3?^Q    #   
3#FB    #     SUBROUTINE TO CHAIN BLOCK POINTED TO BY X1 ON END OF BSA/ENTWIN   
3#^2    #   
3*DL    #     ACTIVITY.  LINK X0  ON EXIT X0=RUBBISH X1=FX1 X2=FX2  
3*Y=    #   
3BCW    R23   STO   0  EX4                 [SAVE LINK   
3BXG          SMO      FX2  
3CC6          LDX   2  ACTRING  
3CWQ          SBN   2  ACTRING             [PTR TO NEXT ACTIVITY
3DBB          LDX   2  BPTR(2)             [PREVIOUS BLOCK  
3DW2          CHAIN    1,2  
3F*L          BRN      (EX4)
3FT=    #   
3G#W    #   
3GSG    #     HOLD BUTTON EVENT RECEIVED
3H#6    #   
3HRQ    YGHOLD  
3J?B          LDX   5  ETBUFS+1(2)  
3JR2          CALL  0  XFINDL              [GET PTR TO DL   
3K=L          LADDP    1,1                 [AND APIA
3KQ=          LDX   0  BSUNIT3(1)   
3L9W          ANDN  0  4
3LPG          BZE   0  U9                      [J IF WE HAVEN'T GOT  THE RIGHT  
3M96          LDX   0  BIT11
3MNQ          ORS   0  BSUNIT(1)
3N8B          CALL  7  OLE                 [SET ENGAGE BUTTON   
3NN2          BRN      T2   
3P7L    U9    GEOERR   1,HOLD UP
3PM=    #   
3Q6W    #   
3QLG    #     ENGAGE BUTTON 
3R66    #   
3RKQ    YGBOLE  
3S5B          CALL  7  OLE                 [SET ENGAGE BUTTON   
3SK2          BRN      T2   
3T4L    #   
3TJ=    #     SET ENGAGE BUTTON 
3W3W    #   
3WHG    OLE   LDX   5  ETBUFS+1(2)  
3X36          CALL  0  XFINDL              [GET PTR TO DL   
3XGQ          LINT     1,5                 [GET INTERNAL NO.
3Y2B          SMO      FX1  
3YG2          DVS   4  Q24                 [GET WORD AND BIT IN EBA 
3Y^L          LDCT  6  #400 
3^F=          SMO      4
3^YW          SRL   6  0
42DG          BUTTONUP 6,5  
42Y6          EXIT  7  0
43CQ    [   
43XB    [     REPLY RECEIVED FROM OTHER MACHINE FOR STATUS CHANGE   
44C2    [     IF REPLY OK THE APIA IS ALTERED AND MESSAGE OUTPUT HERE OTHERWISE 
44WL    [     THE COMMAND ACTIVITY REPORTS ERROR.   
45B=    [     THE COMMAND ACTIVITY USED TO ALTER APIA BUT AS THE OTHER PROCESSOR
45TW    [     COULD GET IN WITH LOCK OUT REQUEST BEFORE TWINSET WAS ENTERED 
46*G    [     IT IS ALTERED HERE.   
46T6    [   
47#Q    QK9   LDX   5  ETBUFS+4(2)         [REPLY   
47SB          BPZ   5  TUP                 [J IF NOT OK 
48#2          LDX   5  ETBUFS+1(2)         [GEOG NUMBER 
48RL          CALL  0  XFINDL              [GET DL PTR IN X1
49?=          LADDP    1,3                 [APIA PTR TO X3  
49QW          LDX   1  FX1  
4==G          LDX   5  BSUNIT(3)
4=Q6          LDX   0  XM6(1)               [UNSET BITS 5-11
4?9Q          ANDS  0  BSUNIT(3)
4?PB          LDX   0  ETBUFS(2)
4#92          SBN   0  GDEDR
4#NL          BZE   0  XD1                  [^ IF DEDICATE REPLY
4*8=          BPZ   0  XD2                  [^ IF UNDEDICATE REPLY  
4*MW          ANDX  5  BIT9                 [IF REPLY TO SHARE LEAVE LOCK-OUT   
4B7G          SLL   5  4                    [IN PROCESSOR IN WHICH IT WAS   
4BM6          ORX   5  BIT10                [PREVIOUSLY DEDICATED AND SET   
4C6Q          ORS   5  BSUNIT(3)            [SHARED BIT 
4CLB    XD1   LDN   0  4
4D62          ORS   0  BSUNIT3(3)           [SET DISENGAGE RIGHTS BIT   
4DKL          CALL  7  OLE                  [SET ENGAGE BUTTON EVENT
4F5=          LDX   1  FX1  
4FJW          LDX   5  XSHARE(1)
4G4G          LDX   0  ETBUFS(2)
4GJ6          SBN   0  GSHARER              [SET APPROPRIATE MESSAGE IDENTIFIER 
4H3Q          BZE   0  XD3  
4HHB          LDX   5  XDED(1)  
4J32          BRN      XD3  
4JGL    XD2   CALL  6  RUNDED   
4K2=    XD3   LDX   4  ETBUFS+1(2)                   [UNIT NO   
4KFW          CALL  7  OUTPUT              [MESSAGE TO CONSOLE  
4K^G          BRN      TUP  
4LF6    #   
4LYQ    #    S/R TO MAKE DRIVE UNDEDICATED. IT FREES EWDAS/ASTUC IF IT  
4MDB    #    EXISTS, SETS RELEVANT BITS IN APIA AND SETS UP 
4MY2    #    MESSAGE IDENTIFIER.
4NCL    #   
4NX=    RUNDED  
4PBW          LDX   0  ETBUFS+1(2)          [UNIT NO
4PWG          LDN   1  BCCB 
4QB6    RF1   LDX   1  FPTR(1)  
4QTQ          TXU   1  CXCC 
4R*B          BCC      RF2                  [^ IF END OF CHAIN  
4RT2          LDX   7  BACK1(1) 
4S#L          BZE   7  RF2                  [^ IF EXOF  
4SS=          TXU   0  GEOGU(1) 
4T?W          BCS      RF1                  [^ IF NOT THIS UNIT NO  
4TRG          LDCH  0  BSUNIT1(3)   
4W?6          SBN   0  1
4WQQ          DCH   0  BSUNIT1(3)           [DECREMENT CT OF SUS
4X=B          FREECORE 1                    [FREE ASTUC 
4XQ2    RF2   LDX   1  FX1  
4Y9L          LDX   0  XBIT5910(1)  
4YP=          ORS   0  BSUNIT(3)
4^8W          LDX   5  XUNDED(1)
4^NG          EXIT  6  0
5286    #   
52MQ    #   
537B    #     SHARE, DEDICATE OR UNDEDICATE 
53M2    #   
546L    QK3 
54L=          LDX   5  ETBUFS+1(2)  
555W          CALL  0  XFINDL              [PTR TO DL   
55KG          LADDP    1,3                 [PTR TO APIA 
5656          LDN   5  1
56JQ    #UNS ATBDG  
574B          BRN      UD1  
57J2          LDX   0  BSUNIT3(3)   
583L          ANDN  0  #10  
58H=          BNZ   0  UA                  [J IF STATUS CHANGE IN PROGRESS  
592W    UD1   LDN   5  5
59GG          LDXC  6  BSUNIT2(3)   
5=26          BCS      UA                      [^ IF IN USE BY SYSTEM   
5=FQ          ADX   6  BSUNIT4(3)   
5=^B          BNZ   6  UA                  [ERROR IF IN USE 
5?F2          LDN   1  BCCB                [SEARCH FOR POSSIBLE ASTUC   
5?YL    UD    LDX   1  FPTR(1)  
5#D=          TXU   1  CXCC 
5#XW          BCC      UC                  [J IF END OF CCB 
5*CG          LDX   0  BACK1(1)            [SERIAL NUMBER   
5*X6          BZE   0  UC                  [J IF NO MORE ASTUCS 
5BBQ          LDX   4  ETBUFS+1(2)         [GEOG NO 
5BWB          TXU   4  GEOGU(1) 
5CB2          BCS      UD   
5CTL          LDX   0  BSUNIT3(3)   
5D*=          ANDN  0  BCGCOM   
5DSW          BNZ   0  UA                   [^ IF CG IN PROGRESS
5F#G          LDX   0  BACK1(1)            [SUSN FROM ASTUC 
5FS6          LDN   1  BCCB                [SEARCH FOR AS  EXOF 
5G?Q    NEXF  LDX   1  BPTR(1)  
5GRB          TXU   1  CXCC 
5H?2          BCC      UC                  [J IF END OF CHAIN   
5HQL          LDX   7  BACK2(1) 
5J==          BZE   7  UC                  [ J IF NOT AN EXOF   
5JPW          TXU   0  ASUSN(1) 
5K9G          BCC      UA   
5KP6          LDEX  7  FIP+5(1)            [CUONT OF AREAS  
5L8Q          LDN   4  0
5LNB    NEXS  BZE   7  NEXF                [J IF NO MORE AREAS  
5M82          SBN   7  1
5MML          ADN   4  6
5N7=          SMO   4   
5NLW          TXU   0  FDCELLS-6(1) 
5P6G          BCS   NEXS                   [J IF AREA UNIT DIFFERS  
5PL6          BRN      UA   
5Q5Q    UC  
5QKB    #UNS ATBDG                           [DONT DO ANY CHANGES IN TESTING MOD
5R52    #SKI
5RJL    (   
5S4=          LDX   1  FX1  
5SHW          LDX   5  BSUNIT(3)
5T3G          LDX   0  XM6(1)   
5TH6          ANDS  0  BSUNIT(3)            [UNSET BITS 5-11
5W2Q          LDX   0  ETBUFS(2)
5WGB          SBN   0  GDED 
5X22          BZE   0  UC3                  [^ IF DEDICATE I.E. MAKE UNDEDICATED
5XFL          BPZ   0  UC1                  [^ IF UNDEDICATE I.E. MAKE DEDICATED
5X^=          ANDX  5  BIT9               [IF SHARE LEAVE LOCK-OUT IN   
5YDW          SLL   5  4                    [PROCESSOR WHERE IT WAS PREVIOUSLY  
5YYG          ORX   5  BIT10                [DEDICATED AND SET  
5^D6          ORS   5  BSUNIT(3)            [SHARED BIT 
5^XQ          NGN   0  5
62CB          ANDS  0  BSUNIT3(3)           [UNSET DISENGAGE RIGHTS BIT 
62X2          BRN      UC2  
63BL    UC1   LDN   0  4
63W=          ORS   0  BSUNIT3(3)           [SET DISENGAGE RIGHTS BIT   
64*W ...UC2   LDX   1  FX1  
65*6          LDX   5  XSHARE(1)
65SQ          LDX   0  ETBUFS(2)
66#B          SBN   0  GSHARE   
66S2          BZE   0  UC4                   [SET APPROPRIATE MESSAGE IDENTIFIER
67?L          LDX   5  XDED(1)  
67R=          BRN      UC4  
68=W    UC3   CALL  6  RUNDED              [MAKE UNDEDICATED
68QG    UC4   LDX   4  ETBUFS+1(2)  
69=6          CALL  7  OUTPUT   
69FY ...      CALL  7  OLE  
69PQ    )   
6=9B          LDCT  5  #400                  [OKAY REPLY
6=P2    UA    LDX   6  ETBUFS(2)
6?8L          ADN   6  1                     [SET UP REPLY IDENTIFIER   
6?N=          ACROSS   TWINSETA,5   
6#7W    #   
6#MG    #     IPCSTATE ROUTINE  
6*76    #     ON ENTRY ACOMMUNE1 CONTAINS MODE (READ OR WRITE)  
6*LQ    #     ON EXIT ACOMMUNE1 CONTAINS THE REPLY  
6B6B    #   
6BL2    QK4   LDX   0  ACOMMUNE1(2) 
6C5L          STO   0  ACOMMUNE3(2)        [STORE MODE FOR TRACING  
6CK=          BPZ   0  READ                [J IF IPCSTATE FOR READ LINK 
6D4W          IPCSTATE W,3                 [ELSE WRITE  
6DJG          BRN      XIT  
6F46    READ  IPCSTATE R,3  
6FHQ    XIT   STO   3  ACOMMUNE1(2)        [STORE REPLY 
6G3B          SMO   FX1 
6GH2          LDX   0  K8RELIEF 
6H2L          BZE   0  NTRACE              [J IF NO TRACING 
6HG=          STO   3  ACOMMUNE2(2) 
6H^W          LDN   0  #6364               [ST  
6JFG          STO   0  ACOMMUNE1(2) 
6J^6          LDX   0  ETWINMK  
6KDQ          STO   0  ACOMMUNE4(2) 
6KYB          STO   7  ACOMMUNE5(2)        [USUALLY AN INTERNAL LINK
6LD2          TWTRACE   
6LXL          STO   3  ACOMMUNE1(2) 
6MC=    NTRACE  
6MWW          UP
6NBG    #   
6NW6    #   
6P*Q    #   
6PTB    QK5 
6Q*2    #   
6QSL    #     SERVICES INCOMING GCHAR MESSAGES FROM OTHER PROCESSOR 
6R#=    #   
6RRW          LDCT  7  #200 
6S?G          ANDX  7  ETBUFS(2)
6SR6          BNZ   7  NG2                 [J IF CONTINUATION BLOCK 
6T=Q          SETNCORE ESENDLEN,3,EWDAS,ITCH [SET UP BUFFER 
6TQB          LDN   1  ETBUFS(2)
6W=2          LDN   2  ENMARK(3)
6WPL          MOVE  1  ETBUFFLE            [MOVE READ INFO TO BUFFER
6X9=    NG6   LDX   2  FX2  
6XNW          LDXC  0  ETBUFS(2)
6Y8G          BCS      TUP                 [J IF NOT LAST TRANSFER  
6YN6          LDX   5  BITS22LS 
6^7Q          ANDS  5  ENMARK(3)             [CLEAR B0+B1-NOT IN CHECKSUM   
6^MB          LDN   5  ENMARK(3)           [ELSE CHECK CHECKSUM 
7272          SMO      ENCT(3)  
72LL          SUM   4  0
736=          BZE   4  NG7                 [J IF CHECKSUM OK
73KW          GEOERR   1,CHECKSUM   
745G    NG7   LDN   6  GCHA 
74K6          LDX   5  ENSTART(3)   
754Q          TRACE    ENCT(3),SCRCT
75JB          LDX   0  ENCT(3)             [IF NO SCRATCH AREAS IN USE..
7642          SBN   0  ENAR-ENMARK         [..IN OTHER MACHINE..
76HL          BNZ   0  NG1  
773=          FREECORE 3                   [..FREE ITCH BLOCK   
77GW          BRN      NG5  
782G    NG1   CALL  7  XLOOK               [FIND ENLINK 
78G6          BRN      NG8                 [NOT FOUND   
78^Q          LDX   2  3                   [SAVE ENLINK PTR 
79FB          CALL  7  XITCH               [FIND EWDAS/ITCH 
79^2          BRN      NG4                 [NOT FOUND   
7=DL          CHAIN    3,2                 [CHAIN ITCH AFTER ESEND  
7=Y=    NG5   UPPLUS   1
7?CW    NG4   GEOERR   1,LOST IT
7?XG    #   
7#C6    #     ENLINK NOT FOUND AS JOB HAS PROBABLY BROKEN IN
7#WQ    #   
7*BB    NG8   CALL  7  XITCH
7*W2          BRN      TUP  
7B*L          FREECORE 3                   [FREE ITCH   
7BT=    TUP   UP
7C#W    #   
7CSG    #     CONTINUATION BLOCK
7D#6    #   
7DRQ    NG2   CALL  7  XITCH               [FIND EWDAS/ITCH 
7F?B          BRN      TUP                 [NOT FOUND   
7FR2          LDX   4  ALOGLEN(3)   
7G=L          LDX   5  4                   [REMEMBER ORIGINAL LENGTH
7GQ=          ADN   4  ETBUFFLE-2          [NEW LENGTH  
7H9W          ALTLEN   3,4                 [EXTEND ITCH 
7HPG          CALL  7  XITCH               [FIND ITCH   
7J96          BRN      NG4  
7JNQ          LDN   1  ETBUFS+2(2)         [START OF SCRATCH FAC
7K8B          LDN   2  ENTRGA(3)
7KN2          ADX   2  5                   [PTR TO NEXT FREE WORD IN ITCH   
7L7L          MOVE  1  ETBUFFLE-2   
7LM=          BRN      NG6                 [FINISH  
7M6W    #   
7MLG    #     RECEIVES GCHA FROM OTHER PROCESSOR
7N66    #   
7NKQ    #     SINCE THE INFO TO BE SENT MAY BE LONGER THAN THE READ BUFFER  
7P5B    #     IT HAS TO BE SENT IN CHUNCKS.A NUMBER OF ESENDS MAY BE SET UP 
7PK2    #     THE FIRST ALWAYS HAS STANDARD FORMAT THE REST HAVE REQUEST TYPE   
7Q4L    #     IN ENMARK AND A UNIQUE NUMBER IN ENSTART. B0 AND B1 ARE SET AS
7QJ=    #     FOLLOWS B0=1 MEANS ANOTHER TRANSFER COMING
7R3W    #             B1=1 NON STANDARD FORMAT  
7RHG    #   
7S36    QK7   LDN   7  0                   [NUMBER OF ESENDS
7SGQ          LDN   6  0                  [DEFAULT IN CASE SU OFFLINE   
7T2B          FINDSUX  1,ETBUFS+3(2),NE3   [FIND ASTUC  
7TG2          LDXC  7  CSCRATCH(1)  
7T^L          BZE   7  NE1                 [J IF NO SCRATCH AREAS   
7WF=          LDN   5  ETBUFFLE-2          [HOW MANY FACS/TRANSFER  
7WYW          DVS   6  5                   [X7=ANSWER X6=REM X7=NO OF ESENDS
7XDG          BZE   6  NE1                 [J IF NO REM 
7XY6          ADN   7  1                   [OTHERWISE IT NEEDS ANOTHER ESEND
7YCQ    NE1   LDXC  6  CSCRATCH(1)  
7YXB          BCS      £
7^C2    NE3   ADN   7  1                    [PLUS ONE FOR 1ST TRANSFER  
7^WL          ADN   6  ETBUFFLE            [X6=COUNT FOR CHECKSUM   
82B=          LDX   4  6
82TW          ADN   4  ESENDLEN-ETBUFFLE   [ROUND UP TO MULTIPLE OF BUFFER SIZE 
83*G          SETUPCORE 4,3,EWDAS,GEXD     [ASSEMBLE EVERYTHING IN HERE FIRST   
83T6          LDN   0  1
84#Q          TXU   0  7
84SB          BCC      NE4                 [J IF NO SCRATCH AREAS OR NOT... 
85#2                                       [..PREVIOUSLY ONLINE 
85RL          FINDSUX  1,ETBUFS+3(2),NE2
86?=          LDXC  4  CSCRATCH(1)  
86QW          BCS      £
87=G          BZE   4  NE4                 [J IF NO SCRATCH AREAS   
87Q6          LDN   1  HSCRATCH(1)         [START OF LIST   
889Q          LDN   2  ENMARK+ETBUFFLE(3)  [POSITION IN GEXD
88PB          SMO      4
8992          MOVE  1  0                   [SHIFT SCRATCH AREAS TO GEXD 
89NL    #     NOW THE RED TAPE  
8=8=    NE4   STO   6  ENCT(3)             [NO OF WORDS 
8=MW          LDCT  0  #400 
8?7G          STO   0  ESREP(3)            [OK REPLY
8?M6          LDX   2  FX2  
8#6Q          LDX   0  ETBUFS+3(2)  
8#LB          STO   0  ENSUSN(3)           [SERIAL NUMBER   
8*62          STOZ     ENHOME(3)           [NO HOME 
8*KL          LDX   6  ETBUFS+1(2)  
8B5=          STO   6  ENSTART(3)          [UNIQUE NO.  
8BJW          LDN   0  GCHAR
8C4G          STO   0  ENMARK(3)           [MESSAGE/REQUEST TYPE
8CJ6          STOZ     ENCK(3)             [CHECKSUM
8D3Q          LDN   5  ENMARK(3)
8DHB          SMO      ENCT(3)  
8F32          SUM   4  0                   [FORM CHECKSUM   
8FGL          SBS   4  ENCK(3)  
8G2=          LDX   4  7                   [REMEMBER NO OF ESENDS NEEDED
8GFW          LDN   6  0                   [B0 AND B1 MARKERS   
8G^G          LDN   5  0                   [MOD TO GEXD 
8HF6    #     SET UP ESEND LOOP 
8HYQ    NE9   SETNCORE ESENDLEN,1,EWDAS,ESEND,,1
8JDB          LDN   0  ENTRGA(1)
8JY2          STO   0  ENTRGA(1)
8KCL          STO   0  ENTRGA+1(1)         [EMPTY RING  
8KX=          MHUNTW   3,EWDAS,GEXD 
8LBW          SMO      5
8LWG          LDN   2  ENMARK(3)           [POSITION IN GEXD
8MB6          LDN   3  ENMARK(1)           [POSITION IN ESEND   
8MTQ          BNZ   5  NE10                [J IF NOT FIRST TIME 
8N*B          MOVE  2  ETBUFFLE            [SHIFT RED TAPE  
8NT2          SBN   4  1
8P#L          BZE   4  NE8                 [J IF ONLY ONE ESEND TO SEND 
8PS=          LDCT  6  #400                [SET NOT LAST BIT
8Q?W          ADN   5  2                   [PTR MOVES UP 7 FIRST TIME   
8QRG          BRN      NE11 
8R?6    NE10  LDN   0  GCHAR               [NON STANDARD FORMAT 
8RQQ          STO   0  0(3) 
8S=B          SMO      FX2  
8SQ2          LDX   0  ETBUFS+1 
8T9L          STO   0  1(3)                [UNIQUE NO   
8TP=          ADN   3  2
8W8W          MOVE  2  ETBUFFLE-2          [MOVE IN SCRATCH AREAS   
8WNG          LDCT  0  #200 
8X86          ORS   0  6                   [SET NON STANDARD MKR
8XMQ    NE11  ORS   6  ENMARK(1)           [SET B0 AND B1 AS APPROPRIATE
8Y7B          LDX   3  1
8YM2          CALL  0  R23                 [CHAIN ESEND ON TWINNING Q   
8^6L          ADN   5  ETBUFFLE-2          [UPDATE GEXD MOD 
8^L=          BCT   7  NE9  
925W          LDXC  0  ENMARK(3)
92KG          BCS      £
9356          STO   0  ENMARK(3)           [CLEAR B0-INDICATES LAST ONE 
93JQ          BRN      NE12 
944B    NE8   CALL  0  R23                 [QUEUE FIRST ESEND (AND LAST)
94J2    NE12  MHUNTW   1,EWDAS,GEXD 
953L          FREECORE 1
95H=          UP
962W    NE2   FREECORE 3                   [FREE GEXD   
96GG          BRN      QK7                 [START AGAIN 
9726    #   
97FQ    XCME  GEOERR   1,NOTCME 
97^B    #   
98F2          MENDAREA 100,K99RELIEF
98YL    #END
^^^^ ...403547410002