SETDISC866
(George Source)
Macros used: BXL, CHAIN, CHNUMCON, COMERR, COMERRX, COOR3, DEMAND, DISENGPER, DOWN, ENDCOM, FINDSUX, FREECORE, GEOERR, HUNTW, JDED, JDISENG, JENG, JENV, JPROP, LADDP, LGEOG, LONGOFF, LONGON, LONGSET, LPROP, LTYPE, MENDAREA, MFREEW, MHUNT, MHUNTW, NAME, OUTPARAM, PARANOT, SEG, SEGENTRY, SETNCORE, STUBASE, TAB, TESTREP, TRACE
- SETDISC866.txt
22FL ... SEG SETDISC,866 23YG # 24D6 # THIS SEGMENT IMPLEMENTS THE EXTENSION TO THE REDON COMMAND. 24XQ # IT ALLOWS NON-STANDARD AND VIRGIN UDAS DEVICES TO BE INTRODUCED 25CB # TO GEORGE SUCH THAT INITIATORS AND REFORMATTER PROGRAMS CAN BE RUN 25X2 # 26BL # 26W= SEGENTRY K1SETDISC,QK1SETDISC 27*W # 27TG # COMMAND ERROR MESSAGE IDENTIFIERS. 28*6 RMESS1 +EWSET [ERROR %B:REDON HAS BEEN OBEYED 28SQ [FOR UNIT %A 29#B RMESS2 +EWSUIT [ERROR %B:A STANDARD SU IS LOADED 29S2 [ON UNIT %A 2=?L RMESS3 +EWNSTAV [ERROR %B:NON-STANDARD SU %A IS 2=R= [NOT AVAILABLE 2?=W RMESS4 +EWDUPX [ERROR %B:SERIAL NUMBER %A IS 2?QG [ALREADY ONLINE 2#=6 RMESS5 +APFERR 2#PQ RMESS6 +JNOPER 2*9B RMESS7 +JEXCSN 2B8L RMESS8 +ENTIN34 [ERROR %B UNIT %A IS NOT DEDICATED 2BDD ...RMESS9 +BMVCG [ERROR %A CG IN PROGRESS 2BJ* ...RMESS10 +EWAITSWIT [ERROR-UNIT WAITING TO BE SW OUT 2BN= # 2BY4 ...#DEF REDONBIT=#100 2C7W # 2CMG # TABLE FOR DETERMINING VALUES FOR HBLOCK AND HCYL 2D76 # 2W=L ...#DEF NEDS=2*EDS 2W=M ...#DEF NEDS30=2*EMDS 2W=N ...#DEF NEDS200L=4*EMDS 2W=P ...#DEF NEDS200=6*EMDS 2W=Q ...#DEF NEDS100=8*EMDS 2W=R ...#DEF NEDS80=10*EMDS 2W=S ...#DEF NFDS160=12*EMDS 2W=T ...#DEF NFDS640=14*EMDS 2W=W ...TAB 2W=X ...#TRA TAB+NEDS [EDS 8 2W=Y ... +80 2W=^ ... -100 2W?2 ...#TRA TAB+NEDS30 [EDS30 2W?3 ... +296 2W?4 ... -203 2W?5 ...#TRA TAB+NEDS200L [LDC STYLE EDS 200 2W?6 ... +472 2W?7 ... +822 2W?8 ...#TRA TAB+NEDS200 [2900 TYPE EDS 200 2W?9 ... +376 2W?= ... +806 2W?? ...#TRA TAB+NEDS100 [EDS 100 2W?# ... +376 2W?* ... +402 2W?B ...#TRA TAB+NEDS80 [EDS 80 2W?C ... +144 2W?D ... +803 2W?F ...#TRA TAB+NFDS160 [FDS 160 2W?G ... +296 2W?H ... +810 2W?J ...#TRA TAB+NFDS640 [FDS 640 2W?K ... +1200 2W?L ... +828 2W?Y ...XMASK #71777777 2W#= QMASK #77777770 2WRW RMASK #777777 2X?G TMASK #700077 2XR6 TEN +10 2Y=Q T4 GEOERR 1,NOJETSET [EWDAS/JETSET NOT FOUND 2YQB T12 GEOERR 1,LONGSET [LONG WAIT BITS ALREADY SET 2^=2 T16 GEOERR 1,BREAKIN? [CAN YOU BREAK IN FROM OPS CONSOLE? 2^PL # 329= # SUBROUTINE TO FIND PLIST ENTRY AND WAIT IF B17=1 IN WORD 0. 32NW # ON ENTRY X4 CONTAINS GEOGRAPHICAL NUMBER OF DEVICE.X2=FX2 338G # ON EXIT X1 PLIST RECORD;X7=0 IF NO COORDINATION;X7=1 IF COOR 33N6 # X0 IS DESTROYED.X2=FX2. LINK STORED IN AWORK3. 347Q # 34MB RB17 SBX 0 FX1 [RELATIVISE LINK 3572 STO 0 AWORK3(2) 35LL LDN 7 0 [NO COORDINATION YET 366= RB19 LDX 1 AWORK4(2) [PTR TO AIPA 36KW LDX 0 BSUNIT(1) 375G BPZ 0 T2 [J IF GRUESOME NOT BUSY 37K6 LDN 7 1 [IF NOT SET COOR MARK 384Q ... COOR3 ENDGRU [WAIT FOR GRUESOME TO FINISH 38JB BRN RB19 [TRY AGAIN 3942 T2 LDX 0 AWORK3(2) [RESTORE LINK 39HL ADX 0 FX1 [RELATIVISE 3=3= EXIT 0 0 [EXIT 3=GW # 3?2G # 3?G6 # THE FOLLOWING SUBROUTINE DETERMINES WHETHER A 'PLEASE LOAD' 3?^Q # MESSAGE SHOULD BE OUTPUT. 3#FB # ENTRY CONDITIONS AS FOR ROUTINE RB17 3#^2 # EXIT CONDITIONS SAME AS RB17 EXCEPT EXITS 0 IF UNIT NOT ONLINE 3*DL # EXITS 1 IF UNIT ONLINE ALSO X3 EWDAS/JETSET AND X6 IS DESTROYED. 3*Y= # 3BCW RB18 NGN 7 1 [FIRST TIME THROUGH 3BXG RBA3 HUNTW 3,EWDAS,JETSET [FIND JETSET 3CC6 BNG 3 T4 [ERROR IF NOT FOUND 3CWQ LDX 0 ASMARK(3) 3DBB BPZ 0 RBA1 [J IF UNIT NOT ONLINE 3DW2 BPZ 7 RBA2 [J IF NOT FIRST TIME 3F*L SBX 6 FX1 [RELATIVISE LINK 3FT= CALL 0 RB17 [SEE IF GRUESOME FINISHED 3G#W ADX 6 FX1 [RELATIVISE LINK 3GSG BNZ 7 RBA3 [J IF COOR TO REFIND JETSET AND SEE 3H#6 [IF UNIT STILL ONLINE 3HRQ RBA2 EXIT 6 1 [UNIT ONLINE 3J?B RBA1 EXIT 6 0 [UNIT NOT ONLINE 3JR2 # 3K=L # SUBROUTINE TO CONVERT SERIAL NO IN BACK1 OF EWDAS/JETSET TO DECIMA 3KQ= # IN ACOMMUNE1 AND 2. 3L9W # ON ENTRY X2=FX2 X3 EWDAS/JETSET X5 LINK 3LPG # ON EXIT X0,X2,X5,X6 AND X7 DESTROYED 3M96 # 3MNQ T13 LDN 0 6 [NO.OF CHARACTERS 3N8B LDXC 7 BACK1(3) [SERIAL NO 3NN2 SLL 7 6 [IGNORE LEADING ZEROS 3P7L T26 LDN 6 0 3PM= SLL 67 3 [FIRST/NEXT CHARACTER IN X6 3Q6W DCH 6 ACOMMUNE1(2) 3QLG BCHX 2 £ [UPDATE MOD 3R66 BCT 0 T26 [REDUCE COUNT 3RKQ EXIT 5 0 [EXIT. 3S5B # 3SK2 # SUBROUTINE TO CONVERT GEOGRAPHICAL NO AND ASUNUM TO THE FOLLOWING 3T4L # FORMAT GEOG(ASUNUM).ASUNUM NO O/P IF COUNT OF SU'S =1 3TJ= # ON ENTRY X1 PLIST X3 JETSET X4 TO CONTAIN GEOG NO. 3W3W # ON EXIT X0,X2,X5,X6,X7 DESTROYED X1 PLIST.X3 JETSET 3WHG # 3X36 ...RY8 LDX 6 4 [GEOG NO 3XGQ LDX 2 FX2 3Y2B STO 0 AWORK1(2) [REMEMBER LINK 3YG2 CALL 0 RY7 [CONVERT GEOG NO TO DECIMAL 3Y^L LDX 0 BSUNIT1(1) 3^F= SRL 0 6 3^YW ANDN 0 #77 [COUNT OF SU'S 42DG SBN 0 1 42Y6 BZE 0 T14 [ONLY O/P GEOG IF SU COUNT=1 43CQ LDN 0 #30 [( 43XB DCH 0 ACOMMUNE3(2) [TO MESSAGE 44C2 ... LDX 6 ASUNUM(3) [SU NO. RELATIVE TO HARDWARE UNIT 44WL BCHX 2 £ [UPDATE MOD 45B= CALL 0 RY7 [CONVERT ASUNUM TO DECIMAL 45TW LDN 0 #31 [) 46*G DCH 0 ACOMMUNE3(2) [TO MESSAGE 46T6 BCHX 2 £ [UPDATE MOD 47#Q T14 SLC 2 2 [CALCULATE NO OF CHARS IN MESSAGE 47SB LDX 1 FX2 48#2 SLL 1 2 48RL SBX 2 1 49?= LDX 5 2 [X5 CONTAINS NO. OF CHARACTERS 49QW LDX 2 FX2 4==G LDX 0 AWORK1(2) [RESTORE LINK 4=Q6 EXIT 0 0 [EXIT 4?9Q RY7 SMO FX1 4?CK ... DVS 5 TEN [DIVIDE BY TEN 4?KD ... BZE 6 XC1 [J IF MOST SIG. CHARACTER ZERO 4?R? ... SMO FX1 4?^6 ... BXL 6 TEN,XC2 [^ IF MOST SIG CHAR < 10 4#6^ ... LDX 7 6 [OTHERWISE CONVERT IT 4##S ... SMO FX1 4#GM ... DVS 6 TEN 4#NL DCH 7 ACOMMUNE3(2) [DUMP MOST SIG. CHARACTER 4*8= BCHX 2 £ [UPDATE MOD 4*D4 ...XC2 DCH 6 ACOMMUNE3(2) 4*MW ... BCHX 2 £ 4*XN ...XC1 DCH 5 ACOMMUNE3(2) [DUMP LEAST SIG. CHARACTER 4B7G BCHX 2 £ [UPDATE MOD 4BM6 EXIT 0 0 4C6Q # 4CLB # ENTRY FROM REDON. 4D62 # CPAR/GNUMCON IN A TIVITY CHAIN 4DKL # 4F5= QK1SETDISC 4FJW MHUNT 3,CPAR,JSCE [LOOK FOR BLOCK CONTAINING DETAILS 4G4G #SKI K6SETDISC>99-99 4GJ6 TRACE JSCEA(3),SETDISC 4H3Q LDX 1 JSCEP(3) [GET PTR TO DEVICE LIST 4HHB STO 1 AWORK2(2) [REMEMBER PTR TO DEVICE LIST 4J32 ... LADDP 1,1 [AND GET PTR TO APIA 4JGL STO 1 AWORK4(2) [AND STORE AS WELL 4JK9 ... SMO FX1 4JMS ... LDX 0 RMESS9 4JQC ... LDX 7 BSUNIT3(1) [TEST IF CG COMMAND... 4JRN ... LDX 6 7 4JT2 ... ANDN 7 BCGCOM [..IN PROGRESS AND 4JXK ... BNZ 7 X3 [..J IF SO 4K2Q ... ANDN 6 BSWOUT 4K5X ... BZE 6 NC 4K94 ... LGEOG AWORK2(2),4 [ERROR IF WAITING TO BE SW OUT 4K#9 ... CALL 0 RY8 4KCB ... OUTPARAM 5,ACOMMUNE3 4KDY ... LDX 0 RMESS10(1) 4KGH ... BRN X3 4KKR ...NC LDX 7 BSUNIT3(1) 4KPN ... ANDN 7 #10 4KTK ... BZE 7 NB [^ IF STATUS CHANGE NOT IN PROGRESS 4K^G ... COOR3 KTSCTF 4L5C ... LDX 1 AWORK4(2) [RESTORE APIA PTR 4L9# ... BRN NC 4L*9 ...NB JDED 1,NA [OK IF DEDICATED 4LF6 LGEOG AWORK2(2),4 4LYQ CALL 0 RY8 [CONVERT UNIT NO TO DECIMAL 4MDB OUTPARAM 5,ACOMMUNE3 4MY2 LDX 0 RMESS8(1) 4NCL BRN X3 4PBW NA LDX 7 BSUNIT1(1) 4PWG SRL 7 6 4QB6 ANDN 7 #77 [COUNT OF SU'S FROM PLIST 4QTQ SBN 7 1 4R*B BRN X1C 4X=B X5 LDX 1 FX1 4XQ2 LDX 0 RMESS5(1) 53M2 X3 STO 0 AWORK2(2) 546L BRN X6 [DO COMERRX 5656 X1C LDN 5 0 56JQ X4 LDEX 4 JSCEA(3) 574B FREECORE 3 [FREE CPAR/GNUMCON 57J2 PARANOT 2 [GET 2ND PARAMETER (SUSN) 583L MHUNT 3,CPB,CUNI 58H= LDX 0 ANUM(3) 592W BZE 0 X7 [J IF NULL PARAMETER 59GG BPZ 0 X8 [J IF 2ND PARM EXISTS 5=26 X7 COMERR JPARMIS,JEXSER 5=FQ X8 CHNUMCON [CONVERT TO BINARY 5=^B TESTREP CHNUMERR,T23 [J I& ERROR 5?F2 MHUNT 3,CPAR,GNUMCON 5?YL LDX 6 A1+1(3) [SERIAL NO. IN ENGLISH NOW 5#D= FREECORE 3 [FREE CPAR/GNUMCON 5#XW MHUNT 1,CPB,CUNI 5*CG FREECORE 1 5*X6 BZE 6 X9 [ZERO SERIAL NO. ILLEGAL 5BBQ LDX 0 RMASK(1) 5BWB TXL 0 6 5CB2 BCC X10 [SERI L NO OK IF _#777777 5CTL X9 LDX 0 RMESS7(1) [ILLEGAL SERIAL NO. 5D*= BRN X3 5DSW X10 SETNCORE HSCRATCH+4/4*4-A1,3,EWDAS,JETSET [SET UP JETSET 5F#G LDN 0 A1(3) 5FS6 LDN 1 A1+1(3) 5G?Q STOZ A1(3) 5GRB MOVE 0 HSCRATCH+4/4*4-A1-1 [ZEROISE BLOCK 5H?2 STO 6 BACK1(3) [SERIAL NO TO BACK1 5HQL CALL 0 RB17 [SEE GRUESOME USING DEVICE 5J== HUNTW 3,EWDAS,JETSET [ 5JPW BNG 3 T4 [NO JETSET BLOCK 5K9G LDX 2 3 [LOOK FOR ANY OTHER JETSETS WITH 5KP6 T5 LDX 2 FPTR(2) [SAME GEOG AND ASUNUM 5L8Q LDX 0 ATYPE(2) 5LNB SRL 0 12 5M82 SBN 0 EWDAS+JETSET 5MML BNZ 0 T6 [J NOT JETSET 5N7= TXU 4 GEOGU(2) [COMPARE GEOG 5NLW TXU 5 ASUNUM(2) [AND ASUNUM 5P6G BCC T7 [J IF ANOTHER REDON FOR THIS UNIT 5PL6 T6 TXU 3 2 5Q5Q BCS T5 [J IF NOT END OF CHAIN 5QKB ... LDCT 0 REDONBIT [BEING REDONED BIT 5R52 ... ORS 0 BSUNIT(1) [BIT TO APIA 5RJL STO 4 GEOGU(3) [STORE DETAILS IN JETSET 5S4= STO 5 ASUNUM(3) 5SHW LDX 0 BACK1(3) [SERIAL NUMBER 5T3G STO 0 HSTUN(3) 5TH6 SMO FX2 5W2Q LDX 0 AWORK2 5WGB STO 0 HUNIT(3) [DEVICE LIST POINTER TO JETSET 5X22 LTYPE HUNIT(3),7 [DEVICE TYPE IN X7 5XFL SLL 7 18 5X^= LPROP HUNIT(3),0 [PROPERTIES 5YDW SLL 0 6 [TO B10-B17 5YYG ORX 7 0 5^D6 LDX 0 BSUNIT1(1) 5^XQ SMO FX1 62CB ... ANDX 0 TMASK [SUBTYPE AND B6-B8 OF APIA 62X2 ORX 7 0 63BL STO 7 HTYPE(3) [ALL TO JETSET 63W= LDX 0 BSUNIT(1) 64*W ANDN 0 #7777 64TG STO 0 ABSUN(3) [BSUN TO JETSET 65*6 STUBASE 1,ASUNUM(3),7 65SQ STO 7 ASUBASE(3) [BASE OF SU 65TR ...# 65WS ...# CODE TO DETERMINE AND STORE HBLOCK AND HCYL 65XT ...# 6QW2 ... LDX 2 FX2 6QW* ... JENV X1900,1900 [^ IF 1900 ENVT 6QWN ... LDN 4 2 6QX3 ... JPROP AWORK2(2),TFDS640,TFDS160,TEDS80,TEDS100,TEDS200,TEDSLDC 6QXB ...# HERE IF EDS 8/30/60 6QXP ...XREST LDX 4 HTYPE(3) 6QY4 ... ANDN 4 #77 6QYC ... ADX 4 4 [USE SUBTYPE AS MODIFIER 6QYQ ... BRN XBLK 6Q^5 ...X1900 LDN 4 4 6Q^D ... LPROP AWORK2(2),7 6Q^R ... SBN 7 #404 6R26 ... BZE 7 XBLK [^ IF EDS 200 UNDER 1900 6R2F ... BRN XREST 6R2S ...TFDS640 6R37 ... ADN 4 2 6R3G ...TFDS160 6R3T ... ADN 4 2 6R48 ...TEDS80 6R4H ... ADN 4 2 6R4W ...TEDS100 6R59 ... ADN 4 2 6R5J ...TEDS200 6R5X ... ADN 4 2 6R6= ...TEDSLDC 6R6G ... ADN 4 2 6R6Q ...XBLK LDX 1 4 6R72 ... SMO FX1 6R7? ... LDX 7 TAB(1) 6R7L ... STO 7 HBLOCK(3) 6R7^ ... SMO FX1 6R8# ... LDX 7 TAB+1(1) 6R8M ... BPZ 7 T10 [^ IF ENTRY OK AS IT STANDS 6R92 ... NGX 7 7 [OTHERWISE DOUBLE IF NEC 6R9* ... LDX 0 HTYPE(3) [ACCORDING TO B12 OF PROPS 6R9N ... ANDN 0 #4000 6R=3 ... BZE 0 T10 6R=B ... ADX 7 7 6R=P ...T10 STO 7 HCYL(3) 6R?C ...# 6R#= LONGSET #37,T12 6RRW ... LDX 0 HUNIT(3) [STORE D.L. PTR FOR CARTCONT 6S?G ... STO 0 AWORK3(2) 6T=Q DOWN CARTCONT,2 6WPL CALL 6 RB18 [SEE IF UNIT AVAILABLE 6X9= BRN T13Z [DEMAND MESSAGE IF NOT 6XNW LDX 6 1 6Y8G BRN T18 [OK-CARRY ON 6YN6 T13Z CALL 5 T13 [CONVERT SERIAL NO TO OCTAL IN ACOM1 6YXY ... LDX 4 GEOGU(3) 6^7Q SMO FX2 6^MB LDX 1 AWORK4 [PTR TO AIPA 7272 CALL 0 RY8 [CONVERT GEOG TO DECIMAL IN ACOMMUNE3 72LL LDN 7 6 [NO. OF CHARCATERS FOR %A 736= OUTPARAM 7,ACOMMUNE1 [%A 73KW OUTPARAM 5,ACOMMUNE3 745G DEMAND 1,EWNSTAN,T15,T16,T17,1 [PLEASE LOAD SU THING 74K6 LONGSET #37,T12 754Q CALL 6 RB18 [SEE IF UNIT ONLINE NOW 75JB BRN T17 [REPEAT DEMAND IF NOT 7642 LDX 6 1 76HL MFREEW ADATA,ADEMAND [FREE DEMAND 773= MHUNTW 1,GMON,AOUT [BLOCKS 77GW BNG 1 T18 782G FREECORE 1 78G6 T18 LONGOFF 78M# ... LDX 0 HUNIT(3) 78SG ... STO 0 AWORK3(2) 78^Q LDCT 0 #200 79FB ANDX 0 ASMARK(3) 79^2 BZE 0 TA1 [UDAS DEVICE 7=DL JENG HUNIT(3),T19 [J IF DEVICE ENGAGED 7=Y= FREECORE 3 [OTHERWISE FREE JETSET 7?CW BRN T23 [AND FINISH 7?XG T19 LDXC 7 BACK1(3) [SERIAL NO 7#C6 FINDSUX 1,7,T20 [LOOK FOR POSSIBLE ASTUC 7#WQ BRN T30 [ERROR IF ASTUC FOUND 7*BB T20 NAME 3,EWDAS,ASTUC [ASTUC NOT FOUND SO RENAME JETSET 7*W2 LDCT 0 #140 7B*L STO 0 ASMARK(3) 7BT= LDN 2 BCCB [CHAIN ASTUC IN CCB 7C#W T22 LDX 2 FPTR(2) [NEXT BLOCK 7CSG TXU 2 CXCC 7D#6 BCC T21 [END OF CHAIN 7DRQ LDX 0 BACK1(2) 7F?B BZE 0 T21 [J IF END OF ASTUCS 7FR2 BNG 0 T22 [J IF DEAD ASTUC 7G=L LDX 5 GEOGU(2) [COMPARE GEOG NOS. 7GQ= TXL 5 GEOGU(3) 7H9W BCS T22 [J NOT SAME 7HPG TXU 5 GEOGU(3) 7J96 BCS T21 [MUST BE GREATER 7JNQ LDX 5 ASUNUM(2) [ELSE CHECK ASUNUM 7K8B TXL 5 ASUNUM(3) 7KN2 BCS T22 7L7L T21 CHAIN 3,BPTR(2) 7L?H ... LDX 0 ASUNUM(3) 7LCD ... SMO 6 7LH* ... STO 0 BSUNIT5 [STORE CSN 7LM= LDCT 0 #10 7M6W SMO 6 7MLG ADS 0 BSUNIT1 7N66 LONGON #67 [WAKE UP ACTIVITES WAITING FOR SU 7NKQ T23 ENDCOM [TERMINATE COMMAND 7P5B # 7PK2 # REDON HAS BEEN OBEYED FOR THIS UNIT ALREADY 7Q4L # 7QJ= T7 STO 5 ASUNUM(3) [STORAGE UNIT SERIAL NUMBER TO JETSET 7R3W SMO FX1 7RHG LDX 0 RMESS1 [COMMAND ERROR MESSAGE IDENTIFIER 7RR# ... ORX 0 GSIGN [SET B0 SO BEING REDONED NOT CLEAR 7S36 LDX 2 FX2 7SGQ BRN RA1 [JOIN OTHER PATH 7T2B # 7TG2 # REDON ON A STANDARD SU 7T^L # 7WF= TA1 LDX 0 RMESS2(1) [COMMAND ERROR MESSAGE IDENTIFIER 7WYW LDX 1 6 [PLIST POINTER TO X1 7X8N ... LDX 4 GEOGU(3) 7XDG RA1 STO 0 AWORK2(2) [REMEMBER COMMAND ERROR IDENTIFIER 7XY6 CALL 0 RY8 [CONVERT GEOG NO ETC. TO DECIMAL 7YCQ STOZ ASUNUM(3) 7YXB STOZ GEOGU(3) 7^C2 OUTPARAM 5,ACOMMUNE3 [O/P PARAMETER 7^WL BRN RY67 82B= # 82TW # OPERATOR TYPES CANTDO LOAD 83*G # 83T6 T15 HUNTW 3,EWDAS,JETSET [REFIND JETSET 84#Q BNG 3 T4 84SB LDX 0 RMESS3(1) [COMMAND MESSAGE IDENIFIER 8548 ... STO 0 AWORK2(2) 85#2 BRN RA2 85RL # 86?= # SU ALREADY ONLINE 86QW # 87=G T30 SMO FX1 87Q6 LDX 0 RMESS4 87TF ... STO 0 AWORK2(2) 87YS ... DISENGPER AWORK3(2) 8847 ...RA2A JDISENG AWORK3(2),RA2B 887G ... COOR3 #41 88=T ... BRN RA2A 88B8 ...RA2B SMO FX1 88FH ... LDX 0 XMASK 88JW ... LDX 3 AWORK4(2) 88N9 ... ANDX 0 BSUNIT(3) 88RJ ... ERS 0 BSUNIT(3) 88WX ... HUNTW 3,EWDAS,JETSET 892= ... BNG 3 T4 895K ...RA2 CALL 5 T13 8992 STOZ ASUNUM(3) 89NL STOZ GEOGU(3) 8=8= LDN 5 6 8=MW OUTPARAM 5,ACOMMUNE1 [O/P PARAMETER 8?7G RY67 HUNTW 3,EWDAS,JETSET 8?M6 BNG 3 T4 8#6Q FREECORE 3 [FREE JETSET 8#8F ... LDCT 0 #400 8#=8 ... ANDX 0 AWORK2(2) 8#?X ... BNZ 0 X6A [^ IF REDON ALREADY IN PROGRESS 8#*L ... LDCT 0 REDONBIT 8#C* ... LDX 3 AWORK4(2) [APIA PTR 8#F4 ... ERS 0 BSUNIT(3) [CLEAR BEING REDONED BIT 8#GR ... BRN X6 8#JG ...X6A ERS 0 AWORK2(2) [CLEAR B0 OF MESS IDENTIFIER 8#LB X6 COMERRX AWORK2(2) [REPORT ERROR 8*62 MENDAREA 50,K99SETDISC 8*KL #END ^^^^ ...76361155000400000000