{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: CLOSBAC867)}}
====== CLOSBAC867 ======
(George Source)
**Macros used:** [[george:macro:ACROSS|ACROSS]], [[george:macro:ALTLEN|ALTLEN]], [[george:macro:AUTWIN|AUTWIN]], [[george:macro:CAFSINFO|CAFSINFO]], [[george:macro:CAPCA|CAPCA]], [[george:macro:CHAIN|CHAIN]], [[george:macro:CHECKEXT|CHECKEXT]], [[george:macro:COOR3|COOR3]], [[george:macro:DOWN|DOWN]], [[george:macro:EXMESS|EXMESS]], [[george:macro:FADDRESS|FADDRESS]], [[george:macro:FINDSU|FINDSU]], [[george:macro:FIPPER|FIPPER]], [[george:macro:FREECORE|FREECORE]], [[george:macro:GEOERR|GEOERR]], [[george:macro:GETWORD|GETWORD]], [[george:macro:ILLEGAL|ILLEGAL]], [[george:macro:JCAFSNBS|JCAFSNBS]], [[george:macro:LADDP|LADDP]], [[george:macro:LGEOG|LGEOG]], [[george:macro:LONGON|LONGON]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MFINDEXOF|MFINDEXOF]], [[george:macro:MFINDSUX|MFINDSUX]], [[george:macro:MFREE|MFREE]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:MURDER|MURDER]], [[george:macro:OUTPACK|OUTPACK]], [[george:macro:PAIR|PAIR]], [[george:macro:PLOCKSU|PLOCKSU]], [[george:macro:PROGBRKIN|PROGBRKIN]], [[george:macro:RELPERENT|RELPERENT]], [[george:macro:RELST|RELST]], [[george:macro:REPMON|REPMON]], [[george:macro:RUNPROG|RUNPROG]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:SMUSEST|SMUSEST]], [[george:macro:STEPBACK|STEPBACK]], [[george:macro:SUSEST|SUSEST]], [[george:macro:TESTMON|TESTMON]], [[george:macro:TESTREP|TESTREP]], [[george:macro:TESTREPNOT|TESTREPNOT]], [[george:macro:TOPCA1|TOPCA1]], [[george:macro:TWAIT|TWAIT]], [[george:macro:UNLOCKSU|UNLOCKSU]], [[george:macro:UNPLUG|UNPLUG]], [[george:macro:UP|UP]], [[george:macro:WORDFIN|WORDFIN]]
22FL ...#SEG CLOSBAC82 [FRANK BLUNDELL
22KH ...#
22PD ...# COPYRIGHT INTERNATIONAL COMPUTERS LTD 1982
22T* ...#
22^= #LIS K0CLOSBAC
23DW 8HCLOSBAC
23YG #
24D6 # THIS SEGMENT IMPLEMENTS MODES #1000 AND #1300 ENTRY POINT
24XQ # IS K1CLOSBAC
25CB #
25X2 # ON ENTRY XCA CONTAINS CONTROL AREA ADDRESS
26BL # AND CURRENT ACTIVITY IS THE AOLPT
26W= # X5 CONTAINS CLOSE MODE
27*W # X6 CONTAINS ADDITIVE MODES (B22=1,#4000 B23=1,#2000
27TG #
28*6 # K1CLOSBAC EVENTUALLY OBEYS RELPERENT MACRO. THIS GOES DOWN TO
28SQ # K2CLOSBAC TO RELEASE THE CHANNEL.
29#B #
29S2 #
2=?L SEGENTRY K1CLOSBAC,QK1CLOSBAC
2=R= SEGENTRY K2CLOSBAC,QK2CLOSBAC
2?=W SEGENTRY CLOSTART [ SET BY NOINTEG MACRO
2?QG +0
2#=6 #
2#PQ XLINK PAIR PERION,1
2*9B XM1 #77777
2*P2 XM2 #37777777
2B8L XM3 #63777777
2BN= STEN +10
2C7W #
2CMG #
2D76 XRV TOPCA1 XLINK(1) [GO TO PCA
2DLQ UNPLUG [UNPLUG PROGRAM.
2F6B ILLEGAL NOCA
2FL2 #
2G5L XERR1 GEOERR 1,RESVIOL
2GK= #
2H4W #DEF XCA=EVENT2
2HJG #
2J46 #
2JHQ #SKI BMONITOR
2K3B (
2KH2 XMON LDX 7 XCA(2) [CONTROL AREA ADDRESS
2L2L TOPCA1 XLINK(1)
2LG= REPMON 1
2L^W )
2MFG #
2M^6 #
2NDQ XC FREECORE 3 [FREE GEXD
2PD2 ILLEGAL MODE
2PXL #
2QC= QK1CLOSBAC
2QWW LDN 7 5 [CHECK 5 WORDS OF CONTROL AREA
2RBG CHECKEXT XCA(2),7,XRV,APETADDR(2),W,XA,HLOCK1
2RW6 XA
2S*Q #SKI BMONITOR
2STB (
2T*2 LDX 7 6 [SAVE X6
2TSL LDX 4 5 [AND X5
32NW LDCT 6 #6 [DEVICE TYPE B0-B8
338G ORX 6 EWCHAN(2) [CHANNEL IN B9-B23
347Q LDN 5 BBCLOSE
34MB TESTMON APETADDR(2),5,6,XMON
3572 LDX 6 7 [RESTORE X6
35LL LDX 5 4 [AND X5
366= )
36KW LDX 3 XCA(2)
375G LDX 1 APETADDR(2)
37K6 ADN 3 2
384Q FADDRESS 1,3,HLOCK1 [GET ADDRESS OF EOF UPDATE
38JB LDX 4 0(3)
3942 [START PACKING DATA INTO ACCS
39HL LDX 3 EXNUM(2) [EXOFILE NUMBER
3=3= SLL 5 12
3=GW ORX 5 EXMODE(2) [OPENING MODE
3?2G SLL 6 22
3?G6 ORX 6 EWCHAN(2) [CHANNEL NUMBER
3?^Q LDX 7 XCA(2) [CONTROL AREA ADDRESS
3#3X ... SETNCORE GEXDLEN,1,EWDAS,GEXD
3#4L ... STOZ A1(1)
3#5* ... LDN 0 A1(1)
3#64 ... ADN 1 A1+1
3#6R ... MOVE 0 GEXDLEN-1 [ZEROISE DATA BLOCK
3#7G ... SBN 1 A1+1
3#89 ... STO 3 CEFN(1) [UNPACK AND STORE DATA.
3#8Y ... LDX 3 1
3#9M ... STO 4 CEOF(3) [END OF FILE UPDATE
3#=B ... STO 7 CNR(3) [CA ADDRESS
3#?5 ... DEX 6 EXCHNL(3)
3#?S ... SRL 6 22
3##H ... DSA 5 EOPMODE(3) [OPENING MODE
3#*= ... SRL 5 12
3#*^ ... LDX 0 EXTRAPS(2) [EXOFILE ENTRY'S TRAPS RECORD
3#BN ... STO 0 EXOTRAP(3) [TRANSFER TO GEXD
3#CC ... CHAIN 3,APETADDR(2)
3#FB LDX 1 FX1
3#^2 TOPCA1 XLINK(1) [GO TOPCA
3*DL UNPLUG
3*KR ... CAPCA EWDAS,GEXD [TO CPA WITH GEXD
3*MG ... MHUNTW 3,EWDAS,GEXD
3K=L STO 5 AWORK1(2) [CLOSE MODE
3KQ= STO 6 AWORK2(2) [ADDITIVE BITS
3L9W MFINDEXOF 1,CEFN(3) [FIND EXOF FOR FILE
3LPG LDX 7 ASUSN(1)
3M96 STO 7 ESERL(3) [SERIAL NO. FOR EXOPEN
3MHG ... STO 7 EWORK1(2) [SERIAL NO FOR RELPER
3MNQ SBN 5 #1000
3N8B BZE 5 YA [JUMP IF CLOSE MODE =#1000
3NN2 ACROSS CLOSDEL,1 [MODE #1300 -DELETE
3P7L #
3PM= #
3Q6W YA LDX 4 CEOF(3)
3QLG BZE 4 YB [JUMP IF NO UPDATE
3R66 LDX 0 EOPMODE(3)
3RKQ SBN 0 #200 [OR OPEN FOR READING
3S5B BZE 0 YB
3SK2 SBN 0 #1500 [OR MODE #1700
3T4L BZE 0 YB
3TJ= ADN 0 #100
3W3W BZE 0 YB [OR #1600
3WHG ADN 0 #1000
3X36 BZE 0 YB [OR SCRATCH FILE
3XGQ ADX 4 FIP+10(1)
3Y2B ADN 0 #200
3YG2 BZE 0 YC [JUMP IF END OF FILE MODE (400)
3Y^L BNG 4 YD
3^F= BNZ 4 YE
3^YW YD LDN 4 1 [EOF =1 IF <1 ORIGINALLY
42DG BRN YE
42Y6 YC TXL 4 FIP+10(1)
43CQ BCC YE
43XB LDX 4 FIP+10(1) [CURRENT EOF FOR MODE 400
44C2 YE TXU 4 FIP+10(1)
44WL BCC YB [JUMP IF UPDATE AS CURRENTLY
45B= SUSEST 7,YF
467= ...YFA PLOCKSU 7,XGA,XFL3 [GET LOCK OUT
47SB SETNCORE FDCELLS-A1,2,EWDAS,EXOF
48#2 MHUNTW 3,EWDAS,GEXD
48RL MFINDEXOF 1,CEFN(3)
49?= LDX 0 BACK2(1)
49QW STO 0 BACK2(2) [EXOFILE NUMBER
4==G ADN 1 A1
4=Q6 ADN 2 A1
4?9Q MOVE 1 FDCELLS-A1
4?PB LDN 0 BSERL+BSPEC+BRITE+BLOCK
4#92 STO 0 EXMARK-A1(2) [OPERATION MARKERS
4#NL LDX 5 FIP+10-A1(1) [SAVE OLD EOF
4*8= STO 4 FIP+10-A1(1) [NEW EOF
4*MW ... DOWN WRITEFIP,1
4B7G TESTREP OK,YG
4BM6 TESTREP EXFAIL,YH
4C6Q SA GEOERR 1,EXOREP1
4CLB YG MHUNTW 2,EWDAS,EXOF
4D62 ... FIPPER HOME(2),ASUSN(2),XGB,YGA,NOC [TELL OTHER SIDE TO RE-READ
4DKL ...YGA
4FJW MHUNTW 2,EWDAS,EXOF
4G4G NOC
4H3Q FREECORE 2 [FREE SPARE EXOF
4HHB EXMESS ALL [OUTPUT MESSAGES
4J32 WA UNLOCKSU 7 [UNLOCK UNIT
4JGL RELST 7 [AND RELEASE
4K2= MHUNTW 3,EWDAS,GEXD
4R*B YB LDCT 4 #6 [DEVICE TYPE B0-B8
4RT2 ORX 4 EXCHNL(3) [CHANNEL IN B9-B23
4S#L RELPERENT 4,AWORK1(2) [RELEASE CHANNEL
4T?W LDN 6 0
4TRG BRN XDA [GO TO SET REPLIES
4W?6 #
4WQQ # GET UNIT ONLINE
4X=B #
4XD8 ...YF LDN 3 0 [MKR IF BREAKIN
4XG6 ... SMUSEST 7,XF,XG
4Y9L BRN YFA
4YP= #
5286 XGB MFREE EWDAS,EXOF
52MQ UNLOCKSU 7
52PH ...#
52Q6 ...# IPB FAIL FOR LOCKOUT
52QP ...#
52R# ...XFL3 NGNC 3 1
52RX ...#
52SG ...# BREAKIN WHILE WAITING FOR IPB
52T5 ...#
52TN ...XGA LDN 3 0
52W? ... RELST 7 [RELEASE UNIT
52WW ...#
52XF ...# BREAKIN WHILE WAITING FOR DISC
52Y4 ...#
52YM ...XG MHUNTW 1,EWDAS,GEXD [X3=0 IF BREAKIN =1 IF IPB FAIL
52^= ... FREECORE 1
52^T ... STEPBACK [STEP ONR BACK
532D ... BZE 3 NIPB [J IF BREAKIN
5333 ... TWAIT 7,NIPB [WAIT FOR IPB
533L ... RUNPROG [TRY AGAIN
5349 ...NIPB PROGBRKIN [REPORT BREAKIN
56JQ #
574B #
57J2 # SET OBJECT PROGRAM REPLIES
583L XD LDCT 0 #400
58H= ORX 6 0 [FAIL REPLIES
592W UNLOCKSU 7
59GG RELST 7 [GET RID OF UNIT
5=26 XDA MHUNTW 3,EWDAS,GEXD
5=FQ LDX 7 CNR(3) [C.A ADDRESS
5=^B ADN 7 1
5?F2 FREECORE 3 [FREE GEXD
5?YL ... GETWORD 7,7,WRITE
5#D= ... TESTREPNOT OK,XERR1
5*CG SMO 7
5*X6 STO 6 0 [SET REPLY
5B6Y ... WORDFIN
5BBQ RUNPROG [RESTART PROGRAM
5BWB #
5CB2 #
5CTL # TRANSFER FAIL,OR NOT FOUND
5D*= #
5DSW YH MHUNTW 3,EWDAS,GEXD
5F#G LDX 0 EMARK(3)
5FS6 ANDN 0 ARITE+AFAIL+ANFOUND
5G?Q BZE 0 SA
5GRB ANDN 0 ANFOUND
5H?2 BZE 0 SB
5HQL [JUMP IF FAIL
5J== MFINDEXOF 1,CEFN(3)
5JPW LDCT 0 4
5K9G ANDX 0 EXMARK(1)
5KP6 BNZ 0 YG [JUMP IF S-TRUSTED
5L8Q GEOERR 1,NOT-S?
5LNB SB MFINDEXOF 1,CEFN(3)
5M82 STO 5 FIP+10(1) [RESET EOF
5MML ZJ MHUNTW 2,EWDAS,EXOF
5N7= FREECORE 2
5NLW XFL1 UNLOCKSU 7
5P6G XFL2 RELST 7
5PL6 EXMESS ALL [OUTPUT MESSAGES
5Q5Q XF MHUNTW 3,EWDAS,GEXD
5QKB LDX 7 CNR(3) [CA ADDRESS
5R52 ADN 7 1
5RJL LDX 5 EXCHNL(3) [CONVERT CHANNEL NR TO DECIMAL
5S4= FREECORE 3
5SHW ... LDCT 6 6
5T3G ... ADX 5 6 [CHANNEL AND DEVICE
5TH6 ...XPAR OUTPACK 5,1,PERINAME,XPAR
5W2Q ... GETWORD 7,7,WRITE
5WGB ... TESTREPNOT OK,XERR1
62X2 LDCT 6 #440
63BL SMO 7 [SET FAIL REPLY
63W= STO 6 0
6464 ... WORDFIN
64*W ILLEGAL PERFAIL
64TG #
65*6 # ENTRY FROM RELPERENT, ACOMMUNE9 CONTAINS (1) ZERO IF RELEASE COMMAND
65SQ # (2) #1000 ) MODE OF
66#B # (3) #1300 ) CLOSE PERI
66S2 # X3 POINTS TO AOLPT
67?L #
67R= #
68=W QK2CLOSBAC
68?= ...#UNS CAFSINT
68?L ...(
68#2 ...# FOR THE CAFS INTERFACE IN GEORGE, WE HAVE TO BE SURE THAT
68#B ...# THERE ARE NO CAFS ORDERS OUTSTANDING WHEN WE CLOSE DOWN A UDAS
68#Q ...# CHANNEL. WE ALSO HAVE TO INFORM CAFS IF THE FILE IS BING CLOSED
68*6 ...# FROM WRITING.
68*G ...#
68*W ... JCAFSNBS 3,XNOCAFSTRNS [JIF NO CAFS ORDERS OUTSTANDING
68B= ... COOR3 #41 [ELSE WAIT A WHILE
68BL ... BRN QK2CLOSBAC [AND TRY AGAIN
68C2 ...#
68CB ...XNOCAFSTRNS
68CQ ... LDX 0 EXMODE(3) [NOW CHECK OPENING MODE OF FILE
68D6 ... SBN 0 #200
68DG ... BZE 0 XOFR [JIF FILE OPEN FOR READING
68DW ... SBN 0 #400
68F= ... BZE 0 XOFR [TREAT SCRATCH FILES AS OPEN FOR READ
68FL ... SBN 0 #1100
68G2 ... BZE 0 XOFR [JIF Q-TRUSTED READING
68GB ...#
68GQ ... LDX 0 ACOMMUNE9(2) [WE DON'T INFORM CAFS IF FILE IS
68H6 ... SBN 0 #1300 [BEING DE-ALLOCATED BY CLOSE
68HG ... BZE 0 XOFR [JIF MODE #1300 CLOSE
68HW ...#
68J= ... CAFSINFO CLOSEFILE,EXNUM(3) [TELL CAFS WE ARE CLOSING AFTER WRITE
68JL ...#
68K2 ...XOFR
68KB ...#
68KQ ...# THE CHANNEL MAY HAVE 'CAFS BIT MAPS' ALLOCATED TO IT. IF IT DOES
68L6 ...# WE MUST RELEASE THEM.
68LG ...#
68LW ... LDCT 7 #70 [BIT MAP ALLOCATION IS RECORDED IN
68M= ... ANDX 7 CFRDBITS(3) [B3-5 OF CFRDBITS IN THE OLPA
68ML ... BZE 7 NOBITMAPS [JIF NO BIT MAPS BELONGING TO OLPA
68N2 ...#
68N8 ... SLC 7 6 [FORM BIT MAPS MASK FOR CAFSINFO
68NB ... CAFSINFO BITMAPS,7 [TELL CAFS SUBSYSTEM TO FREE BIT MAPS
68NQ ...#
68P6 ...NOBITMAPS
68PG ...)
68QG LDCT 0 #200
69=6 ANDX 0 EXMAYBE(3)
69PQ BNZ 0 QA [JUMP IF S-TRUSTED
6=9B LDX 0 EXMODE(3)
6=P2 SBN 0 #600
6?8L BZE 0 TA [JUMP IF SCRATCH FILE
6?N= LDX 0 ACOMMUNE9(2)
6#7W SBN 0 #1300
6#MG BZE 0 TB
6*76 #SKI K6CLOSBAC>199-199
6*LQ (
6B6B ADN 0 #300
6BL2 BZE 0 TK
6C5L ADN 0 #1000
6CK= BZE 0 TK
6D4W GEOERR 1,K2CLOMOD
6DJG TK
6F46 )
6FHQ LDN 7 0 [MARKER FOR STORAGE UNIT ONLINE
6G3B MFINDEXOF 1,EXNUM(3)
6GH2 LDX 4 ASUSN(1)
6GTB ... STO 4 EWORK1(3) [SUSN FOR HLS PURPOSES INRELPER
6H2L SUSEST 4,TC [KEEP UNIT ONLINE IF ALREADY THERE
6HSK ... LDN 7 1 [IN CASE OF IPB FAIL
6J5= ...XGC PLOCKSU 4,XGC,TC [GET LOCK OUT IF WE CAN
6MWW NGN 7 1 [RESET MARKER
6NBG TC MFINDEXOF 1,EXNUM(3)
6NW6 LDX 0 EXMODE(3)
6P*Q SBN 0 #200
6PTB BZE 0 TD [JUMP IF READ
6Q*2 SBN 0 #1500
6QSL BZE 0 TD [OR Q-TRUSTED READ
6R#= ... LDCT 0 #400
79FB #SKI K6CLOSBAC>199-199
79^2 (
7=DL ANDX 0 EXMARK(1)
7=Y= BNZ 0 TE
7?CW GEOERR 1,CLOSWRIT [ERROR IF WRITE BIT NOT SET
7?XG TE
7#C6 )
7#WQ ERS 0 EXMARK(1) [UNSET WRITE BIT
7*BB TD LDX 5 COPEN(1)
7*W2 SBN 5 1 [UPDATE COUNT OF OPENS
7B*L #SKI K6CLOSBAC>199-199
7BT= (
7C#W BPZ 5 TF
7CSG GEOERR 1,ZEROCLOS
7D#6 TF
7DRQ )
7F?B STO 5 COPEN(1)
7H9W LDCT 6 #42
7HPG ANDX 6 EXMARK(1) [WAITING BIT
7J96 BNZ 5 TG [JUMP IF OTHER USERS
7JNQ FREECORE 1 [OTHERWISE FREE EXOF
7K8B TG BZE 6 TH [JUMP IF NOBODY WAITING
7KN2 LONGON EDFDCLS [WAKE THEM UP
7M6W LDCT 0 #2
7MLG ANDX 0 6
7N66 BZE 0 TH [J IF OTHER PROC NOT WAITING
7NKQ AUTWIN GFCLOSE [TELL HIM WE HAVE CLOSED
7PK2 TH BZE 7 TB [JUMP IF UNIT NOT LOCKED
7PMH ... LDX 6 EWORK1(3) [SUSN
7PNB ... MURDER 3 [KIL AOLPT
7PXB ... BPZ 7 TBR [J IF IPB FAIL-JUST RELST
7Q4L UNLOCKSU 4 [UNLOCK
7QC2 ...TBR
7QJ= RELST 4 [AND RELEASE
7QKL ... BRN TDUN
7QL# ...TB
7QSG ... LDX 6 EWORK1(3) [SUSN
7QT8 ... MURDER 3 [KILL THE AOLPT
7QTW ...TDUN
7QWJ ... STO 6 ACOMMUNE8(2) [STORE FOR HLS PURPOSES
7QYL ... STOZ ACOMMUNE9(2) [ZEROISE GEOG UNIT NO
7R2N ... BZE 6 TKILL [NO SUSN - NO GEOG UNIT NO
7R4Q ... FINDSU 1,6,TKILL [LOOK FOR ASTUC
7R6S ... LDX 4 HUNIT(1) [DL POINTER
7R8W ... LGEOG 4,4 [GET GEOG UNIT NO
7R=Y ... STO 4 ACOMMUNE9(2) [STORE FOR HLS PURPOSES
7R*2 ...TKILL
7RHG UP
7S36 # CLOSE SCRATCH FILE
7SGQ #
7T2B TA MFINDEXOF 1,EXNUM(3)
7T#Q ... STOZ EWORK1(3) [SUSN - ZERO IN CASE NO FILE AREAS
7TG2 LDEX 4 FIP+5(1)
7T^L BZE 4 NK [JUMP IF NO FILE AREAS
7WF= LDN 5 FDCELLS
7WYW NH SMO 5
7XDG LDX 6 0(1) [SERIAL NUMBER FOR THIS AREA
7XQW ... STO 6 EWORK1(3) [SUSN FOR HLS PURPOSES
7XY6 NB MFINDSUX 2,6 [FIND ASTUC
7YCQ LDXC 0 CSCRATCH(2)
7YXB BCC NA [JUMP IF NOT LOCKED
7^C2 ... COOR3 #41
7^WL MFINDEXOF 1,EXNUM(3) [REFIND EXOF
82B= ... BRN NB [CHECK AGAIN IF LOCKED
82TW NA SMO 5
83*G LDX 6 1(1) [CALCULATE BLOCK NUMBER FOR THIS AREA
83T6 MPY 6 HBLOCK(2)
84#Q SMO 5
84SB ADX 7 2(1)
85#2 LDN 6 HSCRATCH(2)
85RL #SKI K6CLOSBAC>199-199
86?= (
86QW BNZ 0 NJ [ERROR IF NO SCRATCH AREAS
87=G GEOERR 1,SCRATCHC
87Q6 NJ
889Q )
88PB ND SMO 6
8992 TXU 7 0
89NL BCC NC [JUMP IF ENTRY FOUND
8=8= ADN 6 1 [UPDATE POINTER
8=MW BCT 0 ND
8?7G GEOERR 1,LOSTSCRA
8?M6 NC SBN 0 1
8#6Q BZE 0 XEA [J IF NO ENTRIES TO MOVE UP
8#LB NE SMO 6
8*62 LDX 7 1 [MOVE UP REST OF LIST
8*KL SMO 6
8B5= STO 7 0
8BJW ADN 6 1
8C4G BCT 0 NE
8CJ6 XEA
8D3Q LDX 0 CSCRATCH(2)
8DHB SBN 0 1
8F32 STO 0 CSCRATCH(2) [UPDATE SCRATCH COUNT
8FGL LDX 6 BACK1(2)
8G2= BPZ 6 NF [JUMP IF NOT DEAD
8GFW BNZ 0 NF [OR STILL HAS SCRATCH AREAS
8G^G FREECORE 2 [FREE ASTUC
8HF6 MFINDEXOF 1,EXNUM(3)
8HYQ BRN NG
8JDB NF LDN 6 HSCRATCH+8-A1
8JY2 ADX 6 CSCRATCH(2)
8KCL TXL 6 ALOGLEN(2)
8KKW ... BCC NG [J IF NOT TO BE ALTLENED
8LBW SBN 6 8
8LWG LDX 7 2
8MB6 LDCT 0 #400
8MTQ ORS 0 CSCRATCH(2) [SET LOCKOUT BIT
8N*B ALTLEN 7,6 [ALTER LENGTH OF BLOCK
8NT2 MFINDEXOF 1,EXNUM(3)
8P#L SMO 5
8PS= LDX 6 0(1)
8Q?W MFINDSUX 2,6 [FIND ASTUC
8QRG LDCT 0 #400
8R?6 ERS 0 CSCRATCH(2) [UNSET LOCK BIT
8RQQ NG ADN 5 6
8S=B BCT 4 NH
8SQ2 NK FREECORE 1 [FREE EXOF
8T9L BRN TB
8TP= #
8W8W #
8WNG #
8X86 Q24 +24
8XMQ #
8Y7B #
8YM2 QA MFINDEXOF 1,EXNUM(3) [FIND EXOF FOR FILE
8^6L LDX 6 ASUSN(1)
8^F2 ... STO 6 EWORK1(3) [SUSN FOR HLS PURPOSES
8^YL ...QB FINDSU 2,6,QBXX [FIND ASTUC IF ONE EXISTS
9CRB LADDP HUNIT(2),1 [GET POINTER TO AUXILARY PERIPHERAL I
9D?2 LDX 0 BSUNIT(1)
9DQL BPZ 0 QBX [J IF NOT BEING GRUESOMED
9F== ... COOR3 ENDGRU [ELSE WAIT
9FPW BRN QB [AND TRY AGAIN
9G9G ...QBX SMO FX1
9Q6S ... LDX 0 XM3
9Q8F ... ANDS 0 ASMARK(2)
9Q=8 ... LDCT 0 #20 [SET B4 IN ASTUC SO THAT
9QDW ... ORS 0 ASMARK(2) [KARTCONT WILLL OVERWRITE OLD
9QJ9 ... LDX 0 HUNIT(2)
9QMJ ... SMO FX2 [INFO WITH NEWLY READ INFO
9QW= ... STO 0 AWORK3 [STORE D.L. PTR FOR CARTCONT
9R4Y ... DOWN CARTCONT,2
9TNN ...QBXX
9TYG MFINDEXOF 1,EXNUM(3)
9WD6 QE
9WXQ #SKI K6CLOSBAC>199-199
9XCB (
9XX2 LDX 0 COPEN(1)
9YBL SBN 0 1
9YW= BZE 0 QD
9^*W GEOERR 1,CLOSSCNT
9^TG QD
=2*6 )
=2SQ FREECORE 1 [FREE EXOF
=3#B LONGON #71
=3FJ ... BRN TB
=4R= #
=5=W #
=5QG MENDAREA 30,K99CLOSBAC
=6=6 #END
^^^^ ...251614350002