(George Source)
Macros used: ACROSS, BACKREAD, BSON, BUTTONOLE, CAFSINFO, CHAIN, CHTRAN, CONVERT, COOR3, DISENGPER, FINDBSA, FINDSU, FINDSUD, FON, FREECORE, GEOERR, HUNTW, INFORMX, JBUSY, JDED, JDISENG, JENV, JPROP, LOCK, LONGON, LPROP, LTYPE, MENDAREA, MFINDSU, MHUNTW, NAME, OUTPACK, SEG, SEGENTRY, SETNCORE, STUBASE, TAB, TICKLE, TRACE, UP
22FL SEG KARTCONT,867 22^= # 23DW # COPYRIGHT INTERNATIONAL COMPUTERS LTD 1982 23YG # 24D6 # 24XQ # SECOND HALF OF CARTRIDGE CONTROL 25CB # DEALS WITH ENGAGED DEVICES 25X2 # 26BL SEGENTRY K1KARTCONT,QK1KART [PREVIOUSLY DISENGAGED 26W= SEGENTRY K2KARTCONT,QK2KART [PREVIOUSLY ENGAGED 27*W SEGENTRY K3KARTCONT,QK3KART [PREVIOUSLY HELD 27TG # 28*6 # MESSAGE IDENTIFIERS 28SQ # 29#B XBMVRONG +BMVRONG [UNIT NN DISENGAGED-PLEASE... 29S2 XEWSYSAT +EWSYSAT [SAFE NOW TO STOP UNIT NN 2=?L XEWFAIL +EWFAIL [UNIT NN FAILED 2=R= XEWFAILT +EWFAILT [UNIT NN SU XXXXXX FAILED 2?=W XEWDUPL +EWDUPL [UNITS %A AND %B HAVE SAME SU... 2?QG XEDIFCSN +EDIFCSN [SU XXXXXX WAS LOADED ON UNIT NN 2#=6 XERONGCYL +ERONGCYL [UNIT %A SU %B HAS WRONG NO OF CYLS 2#PQ # 2*9B # 2*P2 XOCT +8 2B8L XSYF 4HSYFL 2BN= RMASK #700077 2C7W SMASK #777777 2CMG #DEF WCH=A1+17 [START OF CH IN GRUBUF 2D76 #DEF REDONBIT=#100 2DLQ # 2F6B # TABLE HOLDING MAX NO OF CYLS FOR VARIOUS TYPES 2FL2 # OF DA DEVICES 2G5L # 2GK= TAB +822 [LDC EDS 200 2H4W +806 [2900 EDS 200 2HJG +402 [EDS 100D 2J46 +803 [EDS 80 2JHQ +810 [FDS 160 2K3B +828 [FDS 640 2KH2 # 2L2L # S/R TO OUTPACK CSN PARAMETER FROM X5 2LG= XOUTCSN 2L^W SBX 7 FX1 2MFG OUTPACK 5,1,CSN 2M^6 ADX 7 FX1 2NDQ EXIT 7 0 2NYB # 2PD2 # S/R TO OUTPACK OPS NO PARAMETER 2PXL XOUTOPNO 2QC= SBX 7 FX1 2QWW OUTPACK AWORK4(2),1,GEOPER 2RBG ADX 7 FX1 2RW6 EXIT 7 0 2S*Q # 2STB # S/R TO O/P MESSAGE IN X6 2T*2 XINFORM 2TSL SBX 7 FX1 2W#= LDN 1 1 2WRW INFORMX 1,6,1 2X?G ADX 7 FX1 2XR6 EXIT 7 0 2XR^ ...# 2XSS ...# S/R TO CLEAR "WAIT FOR KARTCONT" BIT WHEN DISC ENGAGED 2XTM ...# ON DEVICE IN USE BY SYSTEM IS THE CORRECT ONE 2XWG ...# 2XX* ...# LINK X0 2XY8 ...# ON ENTRY X1 = APIA PTR 2X^3 ...# ON EXIT X2 = FX2, ALL OTHER ACCS UNCHANGED 2X^W ...# 2Y2P ...XKTWTCLEAR 2Y3J ... LDEX 1 BSUNIT(1) [BSUN 2Y4C ... FINDBSA ,1 [SETS X2 POINTING TO BSA 2Y5= ... LDN 1 BKARTWT 2Y65 ... ANDX 1 BSFAIL(2) 2Y6Y ... ERS 1 BSFAIL(2) 2Y7R ... LDX 2 FX2 2Y8L ... LDX 1 AWORK2(2) 2Y9F ... EXIT 0 0 2Y=Q # 2YQB # 2^=2 # S/R TO DISENGAGE A DISC 2^PL # X4=LINK 329= # CORRUPTS X0,X6,X7 32F4 ...# LEAVES X1 = FX1 32NW # 338G WDIS SBX 4 FX1 33N6 JDISENG AWORK3(2),WD1 [JUMP IF ALREADY DISENGAGED 347Q XBUSY JBUSY ,XBUSY 34MB JPROP AWORK3(2),MESS,MESS,MESS 3572 BRN NOMES [^ IF NOT ED80,FD160,FD640 35LL MESS CALL 7 XOUTOPNO 366= SMO FX1 [OTHERWISE OUTPUT 36KW LDX 6 XEWSYSAT [SAFE NOW TO STOP UNIT NN 375G CALL 7 XINFORM 378# ...NOMES BSON EMSBIT,NOSYS 37?6 ... LDX 1 AWORK2(2) 37*Y ... LDXC 0 BSUNIT2(1) 37DQ ... BCC NOSYS [^ IF NOT IN USE BY SYSTEM 37HJ ... LDEX 1 BSUNIT(1) 37LB ... FINDBSA ,1 [OTHERWISE SET "WAIT FOR KARTCONT" BI 37P8 ... LDN 0 BKARTWT 37S2 ... ORS 0 BSFAIL(2) 37WS ...NOSYS LDX 2 FX2 37^L ... DISENGPER AWORK3(2) 384Q LDX 1 FX1 38JB BSON EMSBIT,WD1 [BRANCH IF EMS 3942 JDED AWORK2(2),WD1 39HL LDXC 0 ETWINMK [ OR TWINNING NOT INITIALISED 3=3= BUTTONOLE AWORK4(2) [OTHERWISE TELL OTHER PROCESSOR 3=GW WD1 ADX 4 FX1 3?2G EXIT 4 0 3?G6 # 3?^Q # S/R TO TIDY UP AFTER INOP,ETC 3#FB # 3#^2 W11 FREECORE 3 [FREE GRUBUF 3*DL HUNTW 3,EWDAS,ASTUC 3*Y= BPZ 3 W11 [AND ASTUC IF IT EXISTS 3BCW LDX 1 AWORK2(2) 3BXG LDCT 0 REDONBIT 3CC6 ANDX 0 BSUNIT(1) 3CWQ BZE 0 W12 [J IF NOT REDONED 3DBB LDN 3 BACT 3DW2 LDX 4 AWORK4(2) 3F*L LDN 5 EWDAS+JETSET 3FT= SLL 5 12 3G#W LDX 0 BITS22LS 3GSG W13 LDX 3 FPTR(3) [SEARCH ACTIVITY CHAIN FOR JETSETS 3H#6 TXU 3 CXAC [WITH OUR GEOGU 3HRQ BCS W14 3J?B W12 EXIT 7 0 [EXIT IF NO MORE 3JR2 W14 TXU 4 GEOGU(3) 3K=L TXU 5 ATYPE(3) 3KQ= BCS W13 3L9W ANDS 0 ASMARK(3) [CLEAR WAKE AND FAIL BITS 3LPG BRN W13 [CARRY ON 3M96 # 3MNQ # 3N8B # S/R TO FIND ASTUC WITH GEOG NO AS IN AWORK4 3NN2 # IGNORES DEAD ASTUCS 3P7L # EXITS +0 IF NOT FOUND 3PM= # +1 IF FOUND, LEAVING PTR IN X3 3Q6W # 3QLG # 3R66 RFA 3RKQ LDN 3 BCCB [START AT BASE OF CHAIN 3S5B RFD LDX 3 FPTR(3) [NEXT 3SK2 TXU 3 CXCC 3T4L BCC RFB [J IF END OF CHAIN 3TJ= LDX 6 BACK1(3) 3W3W BNZ 6 RFC [J IF THIS IS AN ASTUC 3WHG RFB EXIT 0 0 [NOT FOUND 3X36 RFC BNG 6 RFD [J IF DEAD 3XGQ LDX 6 AWORK4(2) [GEOGRAPHICAL NUMBER 3Y2B TXL 6 GEOGU(3) 3YG2 BCS RFB [JUMP IF NOT FOUND 3Y^L TXU 6 GEOGU(3) 3^F= BCS RFD [J IF NOT THIS ONE 3^YW EXIT 0 1 [ELSE EXIT 1 WITH POINTER IN X3 42DG # 42Y6 # 43CQ # S/R TO SET UP BSTS PARAMETERS AND READ DOWN BLOCK 1 43XB # X1 PTS TO APIA 44C2 # X6 = LINK 44WL # EXITS +0 IF INOPERABLE 45B= # +1 IF TRANSFER FAIL 45TW # +2 IF CHECKSUM ERROR OR INVALID CH 46*G # +3 IF OKAY 46T6 # LEAVES X3 POINTING TO GRUBUF 47#Q # CORRUPTS ALL ACCS EXCEPT X4 47SB # 48#2 RSET 48RL SBX 6 FX1 49?= SETNCORE 140,3,EWDAS,GRUBUF 49QW LOCK 3 [SET UP EWDAS/GRUBUF AND LOCK 4==G LDN 5 128 4=Q6 STO 5 A1(3) [LENGTH 4?9Q LDX 1 AWORK2(2) [POINTER TO APIA 4?PB LDX 0 BSUNIT(1) 4#92 ANDN 0 #7777 4#NL STO 0 A1+1(3) [BSUN 4*8= LDN 0 A1+12(3) 4*MW STO 0 A1+3(3) [BUFFER ADDRESS 4B7G LDCH 0 BSUNIT1(1) 4BM6 STO 0 A1+7(3) [COUNT OF ASTUCS 4C6Q LDX 0 BSUNIT1(1) 4CLB ANDN 0 #77 [SUBTYPE 4D62 LTYPE AWORK3(2),7 4DKL SLL 7 18 4F5= ORX 7 0 [TYPE 4FJW STO 7 A1+6(3) [TYPE/SUBTYPE 4G4G LDN 5 0 4GJ6 STO 5 A1+5(3) [SAVE ASUNUM 4H3Q STUBASE 1,5,7 [BASE OF SU 4HHB STO 7 A1+8(3) 4J32 LDN 1 1 [BLOCK(SEGMENT) 1 4JGL CONVERT A1+2(3),A1+6(3),7,A1(3) [DATUMISE BS ADDRESS 4K2= BACKREAD BSET+BONL+FLAW+BLFAIL,A1(3),,A1+1(3),A1+2(3),A1+3(3) 4KFW ADX 6 FX1 4K^G CHTRAN A1+6(3),XJEX1,XJEX0 4LF6 LDN 0 1 4LYQ SBX 0 A1+12(3) 4MDB BNZ 0 XERR1 [ERROR IF NOT BLK 1 4MY2 STO 6 ACOMMUNE7(2) 4NCL LDX 0 A1+13(3) 4NX= BZE 0 XNOCH 4PBW LDN 1 A1+12(3) 4PWG SUM 0 128 4QB6 BNZ 0 XERR [OR INCORRECT CHECKSUM 4QTQ XNOCH LDX 0 A1+33(3) 4R*B SMO FX1 [OR FIRST FIP IS NOT FOR SYFLE 4RT2 TXU 0 XSYF [(I.E. POSSIBLY VME DISC) 4S#L BCS XERR 4SS= LDN 0 0 4T?W LDN 6 6 4TRG LDCT 1 #400 4W?6 ORN 1 A1+34(3) 4WQQ XLAB LDCH 5 0(1) 4X=B SMO FX1 4XQ2 TXL 5 XOCT 4Y9L BCC XERR 4YP= SLL 0 3 4^8W ADX 0 5 [OR CSNIS INVALID 4^NG BCHX 1 £ 5286 BCT 6 XLAB 52MQ LDX 6 A1+17(3) 537B SLL 6 6 53M2 SRL 6 6 546L TXU 0 6 54L= BCS XERR 555W # ALSO CHECK FOR VALID NO OF CYLINDERS IN CERTAIN CASES 55KG # 5656 LDX 6 WCH+9(3) [NO OF CYLS FROM CH 56JQ STO 3 ACOMMUNE8(2) 574B JENV XOKAY,1900 [NO CHECK NEEDED FOR 1900 57J2 SMO FX1 583L LDN 3 TAB 58H= JPROP AWORK3(2),T640,T160,T80,T100,T200,TLDC 592W BRN XOKAY [NO CHECK FOR EDS60 59GG T640 5=26 ADN 3 1 5=FQ T160 5=^B ADN 3 1 5?F2 T80 5?YL ADN 3 1 5#D= T100 5#XW ADN 3 1 5*CG T200 5*X6 ADN 3 1 5BBQ TLDC 5BWB LDX 0 0(3) 5CB2 TXL 0 6 5CTL BCS XERRA [ERROR IF TOO MANY CYLS IN CH 5D*= XOKAY LDX 6 ACOMMUNE7(2) 5DSW LDX 3 ACOMMUNE8(2) 5F#G EXIT 6 3 [TRANSFER OKAY 5FS6 XERRA LDX 3 ACOMMUNE8(2) 5G?Q LDCT 0 #400 [SET MKR FOR WRONG NO OF CYLS CASE 5GRB ORS 0 3 5H?2 XERR LDX 6 ACOMMUNE7(2) 5HQL XERR1 EXIT 6 2 [CHECKSUM FAIL OR INVALID CH 5J== XJEX1 EXIT 6 1 [TRANSFER FAIL 5JPW XJEX0 EXIT 6 0 [INOPERABLE 5K9G # 5KP6 # S/R TO SET UP AN ASTUC IN ACTIVITY CHAIN AND FILL IN 5L8Q # DETAILS FROM D.LIST AND GRUBUF 5LNB # ON ENTRY X7 PTS TO GRUBUF 5M82 # ON EXIT X3 PTS TO ASTUC 5MML # 5N7= SEWAS 5NLW SBX 6 FX1 5P6G SETNCORE HSCRATCH+4/4*4-A1,3,EWDAS,ASTUC 5PL6 LDX 2 7 [SET UP AN EWDAS/ASTUC 5Q5Q LDX 0 WCH+1(2) 5QKB STO 0 HFLAW(3) [START OF FLAW INDEX 5R52 LDN 0 WCH+5(2) [WORDS 5-10 OF HEADER 5RJL LDN 1 HUNAL(3) [(CHAIN BASES,ETC) 5S4= MOVE 0 6 5SHW STOZ CSCRATCH(3) [COUNT OF SCRATCH AREAS 5T3G LDX 0 A1+5(2) 5TH6 STO 0 ASUNUM(3) [SU NUMBER 5W2Q ... TRACE WCH(2),SEWAST [TRACE CSN 5WGB STOZ CEXTEND(3) 5X22 STOZ BACK2(3) 5XFL LDX 0 A1+1(2) 5X^= STO 0 ABSUN(3) [BSUN 5YDW STOZ ASMARK(3) 5YYG STOZ BPERN(3) [PERIPHERAL NUMBER? 5^D6 LDX 0 A1+8(2) 5^XQ STO 0 ASUBASE(3) [CYLINDER ADDRESS OF SU 62CB LDX 0 WCH(2) 62X2 STO 0 HSTUN(3) [SERIAL NO.ETC. 63BL ANDX 0 BSB18 63W= STO 0 BACK1(3) 64*W LDX 2 FX2 64TG LDX 1 AWORK2(2) [POINTER TO APIA 66#B LDX 5 BSUNIT5(1) 67?L TXU 5 0 67R= BCC RNTG3 [IF SAME CARTRIDGE OK 67XN ... LDXC 4 BSUNIT2(1) 6846 ... BCS RNTG4 [^ TO DISENG IF IN USE BY SYSTEM 688J ... STOZ BUDASELCT(1) [OTHERWISE ZEROISE ERROR LOG CT 68*2 ... BRN RNTG3 68FG ...RNTG4 BZE 5 RNTG3 [CSN IN APIA IS 0 1ST TIME 68L2 ... FREECORE 7 [FREE GRUBUF 68QG FREECORE 3 [FREE ASTUC 69=6 CALL 4 WDIS [DISENGAGE DEVICE 69PQ CALL 7 XOUTOPNO 6=9B LDX 6 5 [CSN 6=P2 CALL 7 XOUTCSN 6?8L SMO FX1 6?N= LDX 6 XBMVRONG [UNIT NN DISENGAGED-PLEASE LOAD... 6#7W CALL 7 XINFORM 6#MG RNTG1 JDISENG ,RNTG2 [WAIT FOR DISENGAGE TO BE 6*76 COOR3 #41 [IMPLEMENTED THEN GO 6*LQ BRN RNTG1 6B6B RNTG2 ACROSS CARTCONT,3 [TO PROCESS DISENGAGE 6BL2 RNTG3 STO 0 BSUNIT5(1) [REMEMBER NEW CARTRIDGE 6BTS ... CALL 0 XKTWTCLEAR [CLEAR " WAIT FOR KARTCONT" BIT 6C5L LDX 0 AWORK4(2) 6CK= STO 0 GEOGU(3) [GEOGRAPHICAL NO. 6D4W LDX 0 AWORK3(2) 6DJG STO 0 HUNIT(3) [DEVICE LIST POINTER 6F46 LDX 4 BSUNIT1(1) 6FHQ SMO FX1 6G3B ANDX 4 RMASK [SET UP DEVICE TYPE 6GH2 LTYPE AWORK3(2),5 [PROPERTIES AND 6H2L SLL 5 18 [SUBTYPE 6HG= ORX 4 5 6H^W LPROP AWORK3(2),5 6JFG SLL 5 6 6J^6 ORX 4 5 6KDQ STO 4 HTYPE(3) 6KYB ADX 6 FX1 6LD2 EXIT 6 0 6LXL # 6MC= # 6MWW # S/R TO WAKE UP REDONS,IF NECESSARY 6NBG # EXITS +1 IF NOT REDONED 6NW6 # +0 IF REDONED, HAVING SET ASMARK OF THE JETSET 6P*Q # B0=1 IF DEVICE ONLINE(ENGAGED) 6PTB # B1=1 IF DEVICE NON-UDAS 6Q*2 # ACCORDING TO VALUE OF X4 ON ENTRY 6QSL # 6R#= XXS LDCT 0 #200 [IF SUITABLE FOR REDON CLEAR CSN 6RRW ANDX 0 4 [IN APIA SO AS NOT TO CONFUSE ERROR 6S?G BZE 0 XXD [LOG BY DISC UNLOADED EARLIER 6SR6 STOZ BSUNIT5(1) 6T=Q XXD LDCT 0 REDONBIT 6TQB ANDX 0 BSUNIT(1) 6W=2 BZE 0 XXA [J IF NO REDONS OUTSTANDING 6WPL LDN 0 EWDAS+JETSET 6X9= SLL 0 12 [TYPE 6XNW LDX 6 AWORK4(2) [GEOGU 6Y8G LDN 2 BACT 6YN6 XXB LDX 2 FPTR(2) [SEARCH ACTIVITY CHAIN FOR JETSET 6^7Q TXU 2 CXAC 6^MB BCS XXC [J UNLESS END-OF-CHAIN 7272 LDX 2 FX2 [NO JETSET, 72LL XXA EXIT 7 1 [EXIT 1 736= XXC TXU 6 GEOGU(2) 73KW TXU 0 ATYPE(2) 745G BCS XXB [J UNLESS JETSET WITH RIGHT GEOG 74K6 ORS 4 ASMARK(2) [SET WAKE AND FAIL BITS 754Q LONGON #37 [WAKE UP REDON ACTIVITIES 75JB LDX 1 AWORK2(2) 7642 EXIT 7 0 [AND EXIT 0 76HL # 773= # 77GW # ENGAGED PREVIOUSLY DISENGAGED 782G # 78G6 QK1KART 78^Q LDX 1 AWORK2(2) 79FB RENDIS 79^2 ... TRACE AWORK4(2),ENDIS 7=DL SMO BSUNIT2(1) [GET COUNT OF USERS 7=Y= LDN 5 0 7?CW BZE 5 W7 [BRANCH IF NONE 7?XG CALL 4 WDIS [DISENGAGE DEVICE TO ALLOW CT OF USER 7#C6 BRN REND [BE TIDIED UP FIRST 7#WQ W7 CALL 6 RSET [READ BLOCK 1 7*BB BRN WINOP [JUMP IF INOPERABLE 7*W2 BRN WFAIL [JUMP IF TRANSFER FAIL 7B*L BRN WFAIL [JUMP IF CHECKSUM FAIL 7BT= LDX 7 3 [PTR TO GRUBUF 7C#W CALL 6 SEWAS [CREATE ASTUC 7CSG LDX 3 7 7D#6 LDCT 4 #400 [MKR=STD DISC, I.E. UNSUITABLE FOR RE 7DRQ CALL 7 XXS [WAKE ANY REDON AND SET MARKER 7F?B NULL 7FR2 BRN W1 [JOIN OTHER PATHS TO WAKE OBJ PROGS 7G=L # [AND UPDATE APIA 7GQ= # 7H9W # HERE IF TRANSFER OR CHECKSUM FAIL ON ENDIS PATH 7HPG # 7J96 WFAIL LDX 1 AWORK2(2) 7JNQ ... LDN 5 0 [X5=0 FOR NORMAL FAIL CASE 7K8B LDXC 3 3 7KN2 BCC WF1 7L7L ... LDX 5 5 [X5=1 FOR WRONG NO OF CYLS CASE 7LM= WF1 LDCT 4 #600 [MARKER=SU HAS FAILED,OK FOR REDON 7M6W CALL 7 XXS [WAKE UP ANY REDON AND SET MARKER 7MLG BRN W1 [NO FAIL MESSAGE IF REDONED 7N66 # [OTHERWISE JOIN INOP PATH 7NKQ # 7P5B # HERE IF INOPERABLE ON ENDIS PATH 7PK2 # 7Q4L WINOP CALL 7 XOUTOPNO [OUTPUT MESSAGE 7QJ= BZE 5 WIN4 7R3W LDX 5 WCH(3) 7RHG SLL 5 6 7S36 SRL 5 6 7SGQ CALL 7 XOUTCSN 7T2B SMO FX1 7TG2 ... LDX 6 XERONGCYL [UNIT NN SU XXXXXX HAS WRONG NO OF CY 7T^L ... BRN WIN5 [OR 7WF= WIN4 SMO FX1 7WYW LDX 6 XEWFAIL [UNIT NN FAILED 7XDG WIN5 CALL 7 XINFORM 7XY6 ...WIN3 CALL 7 W11 [TIDY UP BLOCKS 7YCQ ... CALL 4 WDIS [AND DISENGAGE 7YXB WIN1 JDISENG ,WIN2 7^C2 COOR3 #41 7^WL BRN WIN1 82B= WIN2 LDX 0 AWORK1(2) 82TW BPZ 0 REND [FINISH UNLESS 83*G ACROSS CARTCONT,3 [NEED TO PROCESS DISENGAGE 83T6 # 84#Q # ENGAGED PREVIOUSLY ENGAGED 84SB # 85#2 QK2KART 85RL LDX 1 AWORK2(2) [APIA PTR 86?= ...RENEN TRACE AWORK4(2),ENEN 86QW BRN W2X 87=G # 87Q6 # ENGAGED PREVIOUSLY HELD 889Q # 88PB QK3KART 8992 LDX 1 AWORK2(2) 89NL ...RENHD TRACE AWORK4(2),ENHD 8=8= LDCT 5 #040 8=MW ERS 5 BSUNIT(1) [MARK APIA ENGAGED 8?7G W2X CALL 6 RSET [READ BLOCK 1 8?M6 BRN XINOP [JUMP IF INOPERABLE 8#6Q BRN XFAIL [JUMP IF TRANSFER FAILED 8#LB BRN XFAIL [JUMP IF CHECKSUM FAIL 8*62 LDX 7 3 8*KL CALL 0 RFA [FIND ASTUC 8B5= BRN XILG 8BJW LDX 1 AWORK2(2) 8C4G LDX 0 HSTUN(3) 8CJ6 LDX 5 0 8D3Q SMO 7 8DHB ERX 0 A1+17 [CHECK TO SEE IF SAME SERIAL NUMBER 8F32 SLL 0 6 8FGL BNZ 0 RDIFN [BRANCH IF DIFFERENT SERIAL NO. 8G2= LDCT 0 #20 [IS THIS THE SPECIAL CASE WHERE 8GFW ANDX 0 ASMARK(3) [S-TRUSTED PROGRAM HAS JUST 8G^G BZE 0 W3Z [FINISHED? J IF NOT 8HF6 ERS 0 ASMARK(3) [UNSET SPECIAL MARKER 8HYQ CALL 6 SEWAS [SET UP NEW ASTUC BLOCK 8JDB FREECORE 7 [FREE GRUBUF BLOCK 8JY2 MFINDSU 1,BACK1(3) [REFIND ASTUC TO BE UPDATED 8KCL BRN Q2 [J TO UPDATE 8KX= W3Z 8LBW LDCT 0 128 8LWG ANDX 0 ASMARK(3) 8MB6 BZE 0 SNOTD [BRANCH IF NOT DISENGAGED 8MTQ ERS 0 ASMARK(3) [MAKE ENGAGED 8N87 ...SNOTD CALL 0 XKTWTCLEAR [CLEAR "WAIT FOR KARTCONT" BIT 8NGJ ... LDCT 4 #400 [WAKE-ANY-REDON-COMMANDS MARKER 8NT2 LDX 3 7 [RESET POINTER TO GRUBUF 8P#L CALL 7 XXS [WAKE ANY REDON COMMAND WITH 8PS= NULL [APPROPRIATE WAKE OR FAIL MARKER 8Q?W W1 FREECORE 3 [FREE GRUBUF 8QRG # NOW WAKE UP ANY OBJ PROGS IF NECESSARY 8R?6 LDN 3 BJOBQ 8RQQ W1AB LDX 3 FPTR(3) [GET NEXT JOBNO 8S=B TXU 3 CXJO [ANY MORE JOBS 8SQ2 BCC XHUNT 8T9L LDEX 0 JMISC(3) 8TP= ANDN 0 7 8W8W BZE 0 W1AB [BRANCH IF NO PROGRAM 8WNG TICKLE JOBNUM(3) [TICKLE ALL OBJECT PROGRAMS 8X86 BRN W1AB 8XMQ XHUNT HUNTW 3,EWDAS,ASTUC [LOOK FOR A NEW ASTUC 8Y7B BNG 3 XNOFD [BRANCH IF NONE FOUND 8YM2 FINDSU 1,BACK1(3),Q1 [LOOK FOR LIVE ASTUC OF SAME CSN 8YP9 ... LDX 0 GEOGU(1) 8YRD ... TXU 0 GEOGU(3) 8YTM ... BCS Q1A 8YXW ... FREECORE 1 8^25 ... BRN XNOFD 8^4# ...Q1A 8^6L NAME 3,EWDAS,BSTUC [IF FOUND,RENAME OURS AS BSTUC 8^L= BRN XNOFD 925W #SKI K6CARTCONT>199-199 92KG ( 9356 FINDSUD 1,BACK1(3),XHUNT 93JQ GEOERR 1,DEADASTC [IF THERE IS A DEAD ONE AS WELL 944B ) 94J2 Q1 FINDSUD 1,BACK1(3),XPS1 [LOOK FOR DEAD ONE,IF FOUND 953L [COPY OURS OVER IT 95H= Q2 962W LDX 7 ASMARK(1) 96GG STO 7 ASMARK(3) 9726 LDX 7 CEXTEND(1) 97FQ STO 7 CEXTEND(3) 97^B LDN 6 A1(3) 98F2 LDN 7 A1(1) 98YL MOVE 6 CSCRATCH-A1 [COPY OURS TO DEAD ONE 99D= FREECORE 3 99XW LDX 3 7 9=CG SBN 3 A1 [X3 IS NOW POINTER TO ASTUC 9=X6 XPS1 LDX 4 GEOGU(3) [CHAIN IN (OR RECHAIN) OUR ASTUC 9?BQ LDN 1 BCCB [IN ORDER OF GEOGU 9?WB Q3 LDX 1 FPTR(1) [NEXT BLOCK 9#B2 TXU 1 CXCC 9#TL BCC Q4 [J END OF CHAIN 9**= LDX 0 BACK1(1) 9*SW BZE 0 Q4 [J NOT AN ASTUC,IE END OF CHAIN 9B#G BNG 0 Q3 [IGNORE IF DEAD 9BS6 TXL 4 GEOGU(1) 9C?Q BCC Q3 [J IF NOT THERE YET 9CRB Q4 NGNC 0 1 [ELSE 9D?2 ANDS 0 BACK1(3) [MAKE OUR ASTUC LIVE 9DQL ... TRACE 7,CHAINAST 9F== LDX 4 BPTR(1) [GET POINTER TO PREVIOUS FOR CHAIN 9FPW TXU 4 3 9G9G BCC Q5 [J IF OURS IS ALREADY IN CORRECT PLAC 9GP6 CHAIN 3,4 [CHAIN ASTUC INTO CCB CHAIN 9H8Q Q5 LDX 1 AWORK2(2) [POINTER TO APIA 9HNB LDN 4 1 9J82 DCH 4 BSUNIT1(1) [UPDATE NUMBER OF ASTUCS 9JML XNOFD LDX 1 AWORK2(2) 9K7= LDCT 0 #200 9KLW ANDX 0 BSUNIT(1) 9L6G BNZ 0 Q6H [^ IF WAKE UP CARTCONT SET 9LL6 LDCT 0 REDONBIT 9M5Q ANDX 0 BSUNIT(1) 9MKB ERS 0 BSUNIT(1) [OTHERWISE CLEAR REDONED BIT 9N52 Q6H LDCT 4 #020 9NJL ORS 4 BSUNIT(1) [MARK ENGAGED 9P4= # 9PHW # FOR CAFS, WE HAVE TO NOTIFY THE BSA/CAFSACT OF DISC ENGAGEMENTS 9Q3G # 9QH6 CAFSINFO ENGAGE,AWORK3(2) [NOTIFY EVENT TO CAFS SUBSYSTEM 9R2Q LONGON #67 [WAKE ACTIVITIES WAITING FOR SU 9RGB HUNTW 3,EWDAS,BSTUC [SEE IF ANY BSTUCS 9S22 BNG 3 REND [IF NONE END 9SFL LDX 5 BACK1(3) [CSN 9S^= CALL 7 XOUTOPNO 9TDW FINDSU 1,5,XILG 9TYG LDX 6 GEOGU(1) 9WD6 OUTPACK 6,1,GEOPER 9WXQ CALL 7 XOUTCSN 9XCB SMO FX1 9XX2 LDX 6 XEWDUPL [UNITS %A AND %B HAVE SAME SU... 9YBL CALL 7 XINFORM 9YW= MHUNTW 3,EWDAS,BSTUC 9^*W FREECORE 3 [FREE BSTUC 9^TG CALL 4 WDIS =2*6 BRN RNTG1 =2SQ # =3#B # HERE IF INOPERABLE ON ENEN OR ENHD =3S2 XINOP =4?L CALL 7 W11 [FREE GRUBUF,ETC =4R= ACROSS CARTCONT,3 [GO TO PROCESS DISENGAGE =5=W # =5QG # HERE IF TRANSFER OR CHECKSUM FAIL ON ENEN OR ENHD =6=6 XFAIL =6PQ LDX 1 AWORK2(2) =79B LDX 7 3 [PTR TO GRUBUF =7P2 CALL 0 RFA [LOOK FOR AN EXISTING ASTUC =88L BRN XILG [J IF NONE =8N= LDX 5 BACK1(3) [GET SERIAL NO =97W LDX 3 7 [SAVE GRUBUF PTR =9MG CALL 7 XOUTOPNO ==76 CALL 7 XOUTCSN ==LQ LDXC 3 3 =?6B BCS XF1 =?L2 SMO FX1 =#5L LDX 6 XEWFAILT [UNIT NN SU XXXXXX FAILED =#K= BRN XF2 =*4W XF1 SMO FX1 =*JG LDX 6 XERONGCYL [UNIT NN SU XXXXXX HAS WRONG NO OF CY =B46 XF2 CALL 7 XINFORM =BHQ LDX 1 AWORK2(2) =C3B LDEX 0 BSUNIT2(1) =CH2 BNZ 0 Q9 [BRANCH IF SOME USERS =D2L LDCT 0 #400 =DG= ORS 0 AWORK1(2) =D^W BRN WIN3 =FFG Q9 LDCT 0 128 =F^6 ORS 0 BSUNIT(1) [SET WAKE UP CARTCONT BIT =GDQ BRN REND =GYB # =HD2 # HERE IF DIFF CSN IN EXISTING ASTUC =HXL # =JC= RDIFN LDX 1 FX1 =JWW ANDX 5 SMASK(1) [CSN =KBG SMO 7 =KW6 LDX 0 A1+17 [MOVE CSN FROM GRUBUF INTO ASTUC =L*Q ANDX 0 SMASK(1) [SO THAT GDISENGDA MESSAGE FROM =LTB STO 0 BACK1(3) [RFREEASTUC IS OKAY =M*2 CALL 4 WDIS =MSL CALL 7 XOUTCSN =N#= CALL 7 XOUTOPNO =NRW SMO FX1 =P?G LDX 6 XEDIFCSN [SU XXXXXX WAS LOADED ON UNIT NN =PR6 CALL 7 XINFORM =Q=Q BRN RNTG1 [TO DISENGAGE =QQB # =R=2 # FINISH =RPL # =S9= REND LDX 1 AWORK2(2) =SNW LDCT 5 256 =T8G ERS 5 BSUNIT(1) [UNLOCK RECORD =TN6 FON ENDGRU [WAKE UP ACTIVITIES WAITING =W7Q # [CARTCONT TO FINISH =WMB ... TRACE AWORK4(2),ENDGRUE! =X72 LDXC 5 AWORK1(2) =XLL BNZ 5 RS7 =Y6= UP [FROM K2CARTCONT =YKW RS7 ACROSS SUICIDE,1 [FROM K1CARTCONT =^5G # =^K6 XILG GEOERR 1,NOASTUC ?24Q # ?2JB MENDAREA 50,K99KARTCONT ?342 #END ^^^^ ...032247270005