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