{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: KARTCONT867)}}
====== KARTCONT867 ======
(George Source)
**Macros used:** [[george:macro:ACROSS|ACROSS]], [[george:macro:BACKREAD|BACKREAD]], [[george:macro:BSON|BSON]], [[george:macro:BUTTONOLE|BUTTONOLE]], [[george:macro:CAFSINFO|CAFSINFO]], [[george:macro:CHAIN|CHAIN]], [[george:macro:CHTRAN|CHTRAN]], [[george:macro:CONVERT|CONVERT]], [[george:macro:COOR3|COOR3]], [[george:macro:DISENGPER|DISENGPER]], [[george:macro:FINDBSA|FINDBSA]], [[george:macro:FINDSU|FINDSU]], [[george:macro:FINDSUD|FINDSUD]], [[george:macro:FON|FON]], [[george:macro:FREECORE|FREECORE]], [[george:macro:GEOERR|GEOERR]], [[george:macro:HUNTW|HUNTW]], [[george:macro:INFORMX|INFORMX]], [[george:macro:JBUSY|JBUSY]], [[george:macro:JDED|JDED]], [[george:macro:JDISENG|JDISENG]], [[george:macro:JENV|JENV]], [[george:macro:JPROP|JPROP]], [[george:macro:LOCK|LOCK]], [[george:macro:LONGON|LONGON]], [[george:macro:LPROP|LPROP]], [[george:macro:LTYPE|LTYPE]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MFINDSU|MFINDSU]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:NAME|NAME]], [[george:macro:OUTPACK|OUTPACK]], [[george:macro:SEG|SEG]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:STUBASE|STUBASE]], [[george:macro:TAB|TAB]], [[george:macro:TICKLE|TICKLE]], [[george:macro:TRACE|TRACE]], [[george:macro:UP|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