(George Source)
Macros used: BUTTONUP, CHAIN, DEDICATE, FINDPEREC, FSHCODE, FSHSKIP, GEOERR, GEOSTOP, INFORM, JENVNOT, JSHARED, JTWIN, LADDP, LGEOG, LINT, LTYPE, MENDAREA, MFREE, MFREEW, MHUNTW, MONOUTX, OR, OUTMESSX, OUTPACK, PAIR, SEGENTRY, SETNCORE, SETUPCORE, TAB, UNDEDICATE, UP, UPPLUS
22FL #SEG CDUM70 [BOB NICHOLSON 22^= #LIS K0CDUM 23DW 8HCDUM 23YG # 24D6 SEGENTRY K1CDUM,QK1TW 24XQ SEGENTRY K2CDUM,QK2TW 252W ... SEGENTRY K3CDUM 2562 ... -1 [=0 IF ALL TO BE DEDICATED 2596 ... SEGENTRY K4CDUM 25#= ... +0 [=-1 IF TRACING 25CB Q24 +24 [FOR BUTTONUP 25X2 # 26BL # 26W= # INITIAL ENTRY POINT IN EMS TO CHECK DEDICATE/UNDEDICATE MACROS 27*W # 27TG TYPE 28*6 +BSA+ENTWIN 28SQ XLINK PAIR TWINSETA,1 29#B # 29S2 XM1 #77777777 2=?L XM2 +ETBUFFLE 2=R= XBITS510 #01020000 2?=W XBIT5910 #01060000 2?GN ...XDUALCME +EDUALCME 2?QG # 2#=6 # SUBROUTINE TO COUNT NUMBER OF ENTRIES IN ARES AND AUNRES TABLE 2#PQ # 2*9B # LINK X7 X3 PTR TO START OF AREA : COUNT IN X6 NOT CLEARED ON ENT 2*P2 # 2B8L X1 LDX 0 0(3) [GET NEXT ENTRY 2BN= SMO FX1 2C7W TXU 0 XM1 [TEST IF END 2CMG BCC (7) [J IF SO 2D76 ADN 6 1 [UPDATE COUNT 2DLQ ADN 3 1 [AND PTR 2F6B BRN X1 2FL2 # 2G5L # 2GK= # SUBROUTINE TO GO THOUGH ALL UDAS DEVICES LOOKING FOR TWINNED ONES. 2H4W # 2HJG # EXITS 0 IF NO MORE; EXITS+1 WITH DEVICE LIST PTR IN X3 2J46 # 2JHQ # CAN BE RE-ENTERED BY CALL 7 X3 TO GET NEXT DEVICE THAT IS TWINNED 2K3B # 2KH2 X6 LDX 1 FX1 2L2L X4 ADN 1 1 2LG= LDX 0 TAB-1(1) [NEXT DEVICE TYPE 2L^W BNG 0 (7) [J IF NO MORE 2MFG ... FINDPEREC 3,APFOTY,TAB-1(1),X3 [GET PTR TO DEVICE LIST 2M^6 BNG 3 X4 [J IF NO MORE OF THIS TYPE 2NDQ JTWIN 3,X5 [J IF TWINNED 2NYB BRN X3 [ELSE LOOK FOR NEXT 2PD2 X5 EXIT 7 1 2PXL # 2QC= # 2QWW TAB +6 2RBG +13 2RW6 +26 2S*Q -1 2STB # 2T*2 # TABLE FOR DEDICATE MACRO 2TSL # 2W#= ... SEGENTRY ARES 2WRW -1 2X?G #REP 25 2XR6 +0 2Y=Q # 2YQB # TABLE FOR UNDEDICATE MACRO 2^=2 # 2^PL ... SEGENTRY AUNRES 329= -1 32NW #REP 25 338G +0 33N6 # 347Q # 34MB QK1TW [***** 3572 LDN 6 0 [INITIALISE COUNT OF ENTRIES 35#8 ... LDX 0 K3CDUM(1) 35FB ... BZE 0 X7 [DONT DO ANYTHING IF TWINNING OFF 35LL LDN 3 ARES(1) [PTR TO DEDICATE TABLE 366= CALL 7 X1 [GET COUNT OF DEDICATES IN X6 36KW LDX 5 6 [AND REMEMBER 375G LDN 3 AUNRES(1) [PTR TO UNDEDICATE TABLE 37K6 CALL 7 X1 [AND GET COUNT 384Q BNZ 6 X2 [J IF SOME ENTRIES 38JB CALL 7 X4 [SEE IF ANY TWINNED DEVICES 3942 BRN X7 [J IF NOT 39HL LDN 6 0 [INITIALISE COUNT OF TWINNED SPINDLES 3=3= X8 LADDP 3,2 [GET PTR TO APIA 3=GW ADN 6 1 [UPDATE COUNT 3=N4 ... FSHSKIP 3=T= ...( 3?2G SMO FX1 3?G6 LDX 0 XBITS510 3?L3 ...) 3?PY ... FSHCODE AORB 3?TT ... LDX 0 BIT10 3?^Q ORS 0 BSUNIT(2) [SET LOCKED-OUT AND SHARED BITS 3#FB CALL 7 X3 [GET NEXT TWINNED DEVICE 3#^2 BRN X9 [NO MORE 3*DL BRN X8 [GO TO CHECK THIS ONE 3*Y= # 3BCW X7 UP [NO NOTHINGS 3BXG # 3CC6 # 3CWQ # 3DBB # GETS HERE IF EITHER DEDICATE OR UNDEDICATE HAVE BEEN ISSUED 3DW2 # 3F*L X2 ADN 6 1 [AND ONE FOR -1 3FT= SETUPCORE 6,3,EWDAS,ESEND [SET UP BLOCK TO HOLD UNIT NOS 3G#W STOZ ENTRGA(3) [CLEAR OUT BLOCK 3GSG LDN 4 ENTRGA(3) 3H#6 LDN 5 ENTRGA+1(3) 3HRQ SBN 6 1 3J?B SMO 6 3JR2 MOVE 4 0 3K=L LDX 0 XM1(1) 3KQ= STO 0 ENTRGA(3) [-1 INDICATES END 3L9W LDN 3 ENTRGA(3) [PTR TO START OF DATA 3LPG LDN 6 0 [DEDICATED MARKER 3M96 LDN 1 ARES(1) [PTR TO START OF DEDICATED LIST 3MNQ STOZ AWORK1(2) [COUNTER OF NUMBER OF NON-TWINNED DEV 3N8B STOZ AWORK2(2) [COUNTER OF NUMBER OF DUPLICATES 3NN2 CALL 7 X12 [SORT OUT DEDICATED LIST 3P7L LDX 2 FX1 3PM= LDN 1 AUNRES(2) [PTR TO UNDEDICATED LIST 3Q6W LDX 6 XBIT5910(2) [MKR FOR UNDEDICATED DEVICES IN APIA 3QLG CALL 7 X12 [AND SORT THEM OUT 3R66 LDX 2 FX2 3RKQ LDX 0 AWORK1(2) 3S5B ADX 0 AWORK2(2) 3SK2 BNZ 0 X19 [J IF ANY ERRORS 3T4L MHUNTW 2,EWDAS,ESEND 3TJ= LDN 6 0 [INITIALISE COUNT 3W3W CALL 7 X6 [GET PTR TO FIRST TWINNED DEVICE 3WHG BRN XMUCK [SHOULD BE SOME 3X36 X24 LGEOG 3,7 [X7 CONTAIN GEOGRAPHICAL NO. 3XGQ ADN 6 1 [UPDATE COUNT 3Y2B LDN 4 ENTRGA(2) [START OF NUMBERS 3YG2 X26 SMO 4 3Y^L LDX 0 0 3^F= SMO FX1 3^YW TXU 0 XM1 42DG BCC X23 [J IF END OF LIST 42Y6 #SKI K6TWINSET>99-99 43CQ ( 43XB LDCT 5 #600 [CHECK NO ERROR MARK 44C2 ANDX 5 0 44WL BZE 5 X22 45B= GEOERR 1,HOOT! 45TW X22 46*G ) 46T6 TXU 7 0 47#Q BCC X25 [J IF IN LIST - ALREADY DELT WITH 47SB ADN 4 1 [UPDATE MOD 48#2 BRN X26 [GO FOR NEXT 48RL X23 LADDP 3,4 [NOT IN LIST SO MARK AS SHARED 48YS ... FSHSKIP 4962 ...( 49?= SMO FX1 49QW LDX 0 XBITS510 49WR ...) 4=2N ... FSHCODE AORB 4=6K ... LDX 0 BIT10 4==G SMO 4 4=Q6 ORS 0 BSUNIT 4?9Q X25 CALL 7 X3 [GET DL PTR TO NEXT TWINNED DEVICE 4?PB BRN X9A [NO-MORE - GO TO SET UP BSA/ENTWIN 4#92 BRN X24 [GO AND SORT OUT NEXT 4#NL # 4*8= # THIS BORING SUBROUTINE CHECKS OUT THE PARAMETERS TO THE DEDICATE 4*MW # AND UNDEDICATE MACROS. 4B7G # 4BM6 # ON ENTRY:- 4C6Q # 4CLB # X0 WHO CARES! 4D62 # X1 POINTER TO START OF DEDICATE OR UNDEDICATED LIST (ARES OR AU 4DKL # X2 WHO CARES! 4F5= # X3 NEXT FREE WORD IN EWDAS/ESEND (PTR TO) 4FJW # X4 SEE X0! 4G4G # X5 NOT USED (A RARITY) 4GJ6 # X6 MARKER =0 IF DEDICATE LIST;=#01060000 IF UNDEDICATE LIST 4H3Q # X7 ACTUAL LINK 4HHB # 4J32 # AWORK1 AND AWORK2 CONTAIN ERROR COUNTS AND ARE NOT CLEARED ON ENTR 4JGL # 4K2= # ON EXIT:- 4KFW # 4K^G # X0,X1,X2,X4 ARE ABSOLUTLY USELESS 4LF6 # X3 NEXT FREE ENTRY IN EWDAS/ESEND (NOT TO BE MUCKED UP FOR RE-E 4LYQ # X5 NOT USED 4MDB # X6 AS SET ON ENTRY 4MY2 # X7 LINK 4NCL # 4NX= # ENTRIES IN THE LIST SPECIFIED IN X1 ARE MOVED TO THE EWDAS/ESEND 4PBW # BLOCK AND CHECKS ARE MADE AS FOLLOWS:- 4PWG # 4QB6 # 1. THAT THE UNIT NO. HAS NOT ALREADY BEEN SPECIFIED. 4QTQ # 4R*B # IF IT HAS,AWORK2 IS UPDATED AND THE ENTRY HAS B1 SET 4RT2 # 4S#L # 2. THAT THE UNIT IS A TWINNED UDAS DEVICE:IF NOT B0 SET IN ENTR 4SS= # AND AWORK1 IS UPDATED. 4T?W # 4TRG X12 LDX 0 0(1) [GET FIRST/NEXT ENTRY 4W?6 SMO FX1 [CHECK IF END 4WQQ TXU 0 XM1 4X=B BCC (7) [J IF NO MORE 4XQ2 LDX 4 0(1) [UNIT NO. 4Y9L MHUNTW 2,EWDAS,ESEND 4YP= LDN 2 ENTRGA(2) [START OF DATA 4^8W X18 LDX 0 0(2) [CHECK NUMBER NOT ALREADY SPECIFIED 4^NG SMO FX1 5286 TXU 0 XM1 52MQ BCC X16 [J IF END- O.K 537B ANDX 0 BITS22LS [GET RID OF ERROR BITS IF ANY FOR TES 53M2 TXU 4 0 546L BCC X17 [J IF SPECIFIED ALREADY 54L= ADN 2 1 [UPDATE PTR 555W BRN X18 [GET NEXT ENTRY 55KG X17 LDCT 0 #200 5656 ANDX 0 0(2) 56JQ BNZ 0 X15 [J IF THIRD OR MORE REPEAT 574B LDCT 0 #200 [. 57J2 ORX 4 0 [SET ERROR FLAG 583L LDN 0 1 58H= SMO FX2 592W ADS 0 AWORK2 [UPDATE ERROR COUNT 59GG X16 LDX 0 0(3) [MOVE END MARKED DOWN ONE 5=26 STO 0 1(3) 5=FQ STO 4 0(3) [STORE NEW ENTRY 5=^B ANDX 4 BITS22LS 5?F2 ... FINDPEREC 2,APGEOG,4,,,XCME [GET PTR TO DEVICE LIST 5?YL BNG 2 X14 [J IF NON-EXISTANT 5#D= LTYPE 2,0 [ELSE CHECK IF ITS A UDAS TYPE 5#XW ANDN 0 #77 5*CG SBN 0 6 5*X6 BZE 0 X20 [J IF EDS 5BBQ SBN 0 7 5BWB BZE 0 X20 [OR FDS 5CB2 SBN 0 13 5CTL BNZ 0 X14 [J IF NOT EDS30 OR EDS 60 5D*= X20 JTWIN 2,X13 [J IF TWINNED 5DSW X14 LDCT 0 #400 [ELSE SET ERROR FLAG 5F#G ORS 0 0(3) 5FS6 LDN 0 1 5G?Q SMO FX2 5GRB ADS 0 AWORK1 [UPDATE ERROR COUNT 5H?2 BRN X15 5HQL X13 LADDP 2,2 [GET PTR TO APIA 5J== ORS 6 BSUNIT(2) [AND SET MARKERS 5JPW X15 ADN 3 1 [UPDATE MOD IN ESEND 5K9G ADN 1 1 [AND LIST 5KP6 BRN X12 [SEE IF ANY MORE 5L8Q # 5LNB # 5M82 XMUCK GEOERR 1,MUCK UP! 5MML # 5N7= # 5NLW # 5P6G # THIS ROUTINE OUTPUTS ERROR MESSAGES TO THE OPS CONSOLE 5PL6 # 5Q5Q # LINK X7 5QKB # 5R52 # 5RJL # ON ENTRY 5S4= # X4 NO. OF UNIT NUMBERS TO BE OUTPUT 5SHW # X5 MASK TO GET APPROPRIATE UNIT NUMBER 5T3G # X6 INDENTIFIER OF SUB-MESSAGE 5TH6 # 5W2Q RX25 SBX 7 FX1 [RELITAVISE LINK 5WGB ADN 4 1 [COUNT OF UNIT NOS PLUS 1 5X22 SETUPCORE 4,3,EWDAS,EGOT [SET UP BLOCK 5XFL STO 4 ENTRGA(3) [STORE COUNT FOR OUTPACK 5X^= LDN 3 ENTRGA+1(3) [NEXT VACANT HOLE 5YDW MHUNTW 1,EWDAS,ESEND [ 5YYG LDN 2 ENTRGA(1) [FIRST ENTRY 5^D6 RX24 LDX 0 0(2) [NEXT ENTRY 5^XQ SMO FX1 62CB TXU 0 XM1 62X2 BCC RX22 [J IF NO MORE ENTRIES 63BL ANDX 0 5 63W= BZE 0 RX23 [J IF THIS ENTRY NOT IN ERROR 64*W LDX 0 0(2) [MOVE UNIT NO. TO PARAMETER BLOCK 64TG ANDX 0 BITS22LS 65*6 STO 0 0(3) 65SQ ADN 3 1 [UPDATE MOD 66#B RX23 ADN 2 1 [AND AGAIN 66S2 BRN RX24 [GO FOR NEXT 67?L RX22 MHUNTW 3,EWDAS,EGOT 67R= OUTPACK ENTRGA(3),V,VARDEC,RX22 [OUTPUT PARAMETER 68=W MFREEW EWDAS,EGOT [FREE EGOT 68QG OUTMESSX 6 [OUTPUT %B 69=6 INFORM 1,ENTIN1,1 [AND ACTUALLY OUTPUT 69PQ ADX 7 FX1 6=9B EXIT 7 0 6=P2 # 6?8L # 6?N= # 6#7W # AN ERROR HAS OCCURRED 6#MG # 6*76 # THE MAIN MESSAGE IN THE MONITORING FILE IS :- 6*LQ # 6B6B # DEDICATE/UNDEDICATE MACROS: UNIT(S) %A %B 6BL2 # 6C5L # %A IS A SERIES OF UNIT NUMBERS CONVERTED BY OUTPACK 6CK= # 6D4W # %B IS A SUB-MESSAGE :- 6DJG # 6F46 XMESS1 +ENTIN2 [DOES/DO NOT REFER TO TWINNED SPINDLE 6FHQ XMESS2 +ENTIN3 [HAS/HAVE BEEN SPECIFIED MORE THAN ON 6G3B # 6GH2 # THE FORMER IS OUTPUT IF B0=1 IN ENTRIES IN EWDAS/ESEND 6H2L # THE LATER IS OUTPUT IF B1=1 IN ENTRIES IN EWDAS/ESEND 6HG= # 6H^W X19 LDX 4 AWORK1(2) [LOAD COUNT OF NON-TWINNED SPINDLES 6JFG BZE 4 X21 [J IF NONE 6J^6 LDCT 5 #400 [LOAD MASK 6KDQ LDX 1 FX1 6KYB LDX 6 XMESS1(1) [SUB-MESSAGE IDENTIFIER 6LD2 CALL 7 RX25 [OUTPUT MESSAGE 6LXL X21 LDX 4 AWORK2(2) [COUNT OF REPEATS 6MC= BZE 4 XEND [J IF NONE 6MWW LDCT 5 #200 [LOAD MASK 6NBG LDX 1 FX1 6NW6 LDX 6 XMESS2(1) [SUB-MESSAGE IDENTIFIER 6P*Q CALL 7 RX25 [OUTPUT MESSAGE 6PTB XEND GEOSTOP XMESS3(1) [AND FINISH 6Q*2 # 6QSL # 6R#= XMESS3 +45 6RRW 45H PLEASE CORRECT UNDEDICATE OR DEDICATE MACROS 6S?G # 6SR6 # 6T=Q # SET UP DETAILS FOR SETUP TO CREATE THE BSA/ENTWINE ACTIVITY 6TQB # 6W=2 # ACOMMUNE1 BLOCK TYPE 6WPL # ACOMMUNE2 LINK 6X9= # ACOMMUNE3 PAIR 6XNW # ACOMMUNE4 LENGTH 6Y8G # 6YN6 X9A MFREE EWDAS,ESEND 6^7Q X9 LDX 1 FX1 6^MB LDX 2 FX2 7272 ADN 6 2 [PLUS TWO FOR REQUEST TYPE AND TERM 72LL LDCT 0 #400 736= ORN 0 JNOCHAT+JOFR 73KW STO 0 ETWINMK [SET TWINNING NOT INITIALISED BIT 745G LDN 4 TYPE(1) 74K6 LDN 5 ACOMMUNE1(2) 754Q MOVE 4 3 [BLOCK TYPE AND LINK PAIR 75JB TXL 6 XM2(1) [WORK OUT BUFFER LENGTH 7642 BCC X10 76HL LDN 6 ETBUFFLE 773= X10 STO 6 ETNBLEN 77GW ADX 6 BSABL 782G STO 6 ACOMMUNE4(2) 787N ... JENVNOT NCME,CME [^ IF NOT CME ENVT 78#W ... LDX 1 FX1 78G4 ... MONOUTX XDUALCME(1) 78M= ...XCME GEOERR 1,NOTCME 78SD ...NCME UPPLUS 1 78^Q # 79FB # SETS ENGAGE BUTTON FOR ALL SHARED UNITS 79^2 # 7=DL QK2TW [***** 7=Y= CALL 7 X6 [PTR TO DL 7?CW BRN X7 [J IF NO MORE 7?XG XAA LADDP 3,2 7#C6 JSHARED 2,XAB [J IF SHARED 7#WQ XAC CALL 7 X3 7*MQ ... BRN X7TR 7*W2 BRN XAA 7*^F ...XAB 7B4Y ... FSHCODE AORB 7B8C ...( 7B?W ... SMO FX1 7BC* ... LDX 0 XBITS510 7BGS ... ORS 0 BSUNIT(2) 7BL? ...) 7BPQ ... LINT 3,0 [GET INTERNAL NO 7BT= SMO FX1 7C#W DVS 7 Q24 7CSG LDCT 5 #400 7D#6 SMO 7 7DRQ SRL 5 0 7F?B LDX 7 0 7FR2 BUTTONUP 5,7 [SET ENGAGE BUTTON BIT 7G=L BRN XAC 7G#* ...# 7GDF ...X7TR LDX 1 FX1 7GF7 ... LDX 0 K4CDUM(1) [DON'T SET UP TRACE BUFFER.. 7GFT ... BZE 0 X7 [..IF NO TRACING 7GGH ... SETNCORE 126,3,EWDAS,GEXD [SET UP TRACE BUFFER 7GH9 ... STOZ A1(3) 7GJY ... CHAIN 3,ENTWINPTR 7GLM ... BRN X7 7GQ= # 7H9W # 7HPG MENDAREA 100,K99CDUM 7J96 # 7JNQ #END ^^^^ ...552367020002