{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: RELIEF866)}}
====== RELIEF866 ======
(George Source)
**Macros used:** [[george:macro:ACROSS|ACROSS]], [[george:macro:ALTLEN|ALTLEN]], [[george:macro:BUTTONUP|BUTTONUP]], [[george:macro:CHAIN|CHAIN]], [[george:macro:FINDPEREC|FINDPEREC]], [[george:macro:FINDSUX|FINDSUX]], [[george:macro:FREECORE|FREECORE]], [[george:macro:GEOERR|GEOERR]], [[george:macro:HUNT2J|HUNT2J]], [[george:macro:INFORMX|INFORMX]], [[george:macro:IPCSTATE|IPCSTATE]], [[george:macro:LADDP|LADDP]], [[george:macro:LINT|LINT]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:OUTPACK|OUTPACK]], [[george:macro:READ|READ]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:SETUPCORE|SETUPCORE]], [[george:macro:TRACE|TRACE]], [[george:macro:TWTRACE|TWTRACE]], [[george:macro:UP|UP]], [[george:macro:UPPLUS|UPPLUS]]
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