CLOSDEL867
(George Source)
Macros used: ANYUSERS, AUTWIN, CHUCK, CHUCKWR, CLOSEST, CLOSEWR, DOWN, EXMESS, FIPPER, FPCACA, FREECORE, GEOERR, GETWORD, ILLEGAL, KEEPMESS, LONGON, MENDAREA, MFINDEXOF, MHUNTW, MONOUT, OPENST, OUTBLOCK, OUTNUM, OUTPACK, OUTPARAM, PLOCKSU, PROGBRKIN, READSAVE, READST, RELPERENT, RELST, RUNPROG, SAVEST, SEGENTRY, SETNCORE, SMUSEST, STEPBACK, SUSEST, SXTEST, TESTREP, TESTREPNOT, TRACE, TRUSTED, TWAIT, UNLOCKSU, WORDFIN
- CLOSDEL867.txt
22FL ...#SEG CLOSDEL70 [FRANK BLUNDELL 22KH ...# 22PD ...# COPYRIGHT INTERNATIONAL COMPUTERS LTD 1982 22T* ...# 22^= #LIS K0CLOSDEL 23DW 8HCLOSDEL 23YG # 24D6 # THIS SEGMENT IMPLEMENTS MODE #1300 24XQ # ENTRY IS FROM CLOSBAC. 25CB # THE CURRENT ACTIVITY IS CPA 25X2 # AWORK1 CONTAINS MODE, AWORK2 CONTAINS ADDITIVE BITS 26BL # X7 SERIAL NUMBER 26W= # 27*W # 27TG SEGENTRY K1CLOSDEL,QK1CLOSDEL 28*6 # 28SQ # 2976 ...XTCEE +EWTCEE [TRAPS CLOSED FOR EXOFILE ENTRY 29#B XM1 #77777 29S2 XM2 #37777777 2=?L STEN +10 2=R= # 2?=W # 2?QG QK1CLOSDEL 2#=6 #SKI K6CLOSDEL>199-199 2#PQ TRACE 7,CLOSDEL 2*9B MHUNTW 3,EWDAS,GEXD 2*P2 LDN 6 5 [X6 HOLDS OBJ PROG REPLY 2B8L LDX 0 EOPMODE(3) 2BN= #SKI K6CLOSDEL>199-199 2C7W ( 2CMG SBN 0 #1600 2D76 BZE 0 XEA 2DLQ SBN 0 #100 2F6B BNZ 0 XEB 2FL2 XEA GEOERR 1,WRNGMODE [CANT DELETE IF USING SPECAIL OPEN MO 2G5L XEB LDX 0 EOPMODE(3) 2GK= ) 2H4W SBN 0 #200 2HJG BZE 0 XDA [J IF OPEN MODE READ 2J46 SBN 0 #200 2JHQ BZE 0 XDA [OR END OF FILE MODE 2K3B SBN 0 #200 2KH2 BZE 0 XDA [J IF SCRATCH FILE 2KLJ ... SXTEST 0,XES2B [J IF SECUREX NOT IN USE 2KMQ ... LDX 0 EXOTRAP(3) [EXOFILE ENTRY'S TRAPS RECORD 2KNY ... BNG 0 XES2B [J IF INSECURE 2KQ6 ... ANDN 0 CERASET 2KR# ... BNZ 0 XES2B [J IF WE HAVE ERASE TRAP 2KSG ...XES2A 2KTN ... KEEPMESS XTCEE(1),7 [TRAPS CLOSED 2KWW ... BRN XEFN 2KY4 ...XES2B 2L2L SUSEST 7,XB [GET UNIT ONLINE 2LRL ...XE PLOCKSU 7,XGA,XFA1 [GET LOCK OUT 2NDQ MHUNTW 3,EWDAS,GEXD 2NYB MFINDEXOF 1,CEFN(3) 2PD2 LDX 0 COPEN(1) 2PXL SBN 0 1 2QC= #SKI K6CLOSDEL>199-199 2QWW ( 2RBG BPZ 0 XXX 2RW6 GEOERR 1,CLOSCNT 2S*Q XXX 2STB ) 2T*2 BNZ 0 XD [JUMP IF FILE OPEN TO ANOTHER USER 2WRW LDCH 0 FIP+5(1) [GET IC 2X?G SRL 0 4 2XR6 SBN 0 1 2Y=Q BZE 0 XFB [DON'T CHECK ANY FURTHER IF IC=1 2YQB LDX 2 1 2^=2 ANYUSERS HOME(2),ASUSN(2),XGC,XD,NOC [SEE IF ANY USERS IN OTHER SI 2^PL MHUNTW 3,EWDAS,GEXD 329= MFINDEXOF 2,CEFN(3) 32NW NOC LDX 1 2 338G LDX 2 FX2 347Q XFB LDN 6 1 [OTHERWISE MODE OK 34MB LDEX 0 FIP+5(1) 3572 BNZ 0 XD [JUMP IF FILE HAS AREAS 35LL LDN 6 4 366= FPCACA 2 [FIND PCA 36KW TRUSTED 2,NOTS,S 375G BRN XH [JUMP IF S-TRUSTED 37K6 NOTS TRUSTED 2,NOTQ,Q 384Q BRN XH [JUMP IF Q-TRUSTED 38JB NOTQ 3942 LDX 0 FIP+7(1) 39HL LDX 4 0 3=3= ANDN 0 #7777 [X0=FILE DEALLOCATION 3=GW SRL 4 12 [X4=DATA RETENTION 3?2G TXL 4 0 3?G6 BCS XD 3?^Q XH OPENST 7 [OPEN UNIT FOR TRANSFERS 3#FB MFINDEXOF 2,CEFN(3) 3#^2 READSAVE HOME(2),XJ [READ AND SAVE FIP CELL 3*DL TESTREP OK,XJC 3*Y= TESTREPNOT EXFAIL,XR 3BCW BRN XFL1 [JUMP IF TRANSFER ERROR 3BXG XJC MFINDEXOF 2,CEFN(3) 3CC6 LDX 1 ECOR(3) 3CWQ XJ LDCT 0 4 [CHECK FOR S-TRUSTED 3DBB ANDX 0 EXMARK(2) 3DW2 BNZ 0 ZA [JUMP IF S-TRUSTED 3F*L #SKI K6CLOSDEL>199-199 3FT= ( 3G#W LDX 4 2(1) [CHECK FILE IDENTITY IF 3GSG LDX 5 3(1) [TRACING 3H#6 LDX 6 4(1) 3HRQ TXU 4 FIP(2) 3J?B TXU 5 FIP+1(2) 3JR2 TXU 6 FIP+2(2) 3K=L BCS XJA 3KQ= LDX 0 6(1) 3L9W ERX 0 FIP+4(2) 3LPG SRL 0 12 3M96 BZE 0 XJB 3MNQ XJA GEOERR 1,CLOSNAME 3N8B XJB 3NN2 ) 3P7L ZC 3PM= LDX 6 1 [SAVE CURRENT CORE POINTER 3Q6W LDX 4 HOME(2) [AND BS ADDRESS 3QLG LDX 2 FX2 3R66 STO 1 AWORK3(2) 3RKQ STO 4 AWORK4(2) [SAVE FIP CELL ADDRESSES 3S5B LDN 5 0 [MARKER -PREVIOUS CELL 3SK2 XP LDX 0 0(1) 3T4L BNG 0 XK [JUMP IF THIS CELL UNUSED 3TJ= SAVEST W,4 [SAVE THIS CELL 3W3W LDX 0 0(1) 3WHG SMO FX1 3X36 TXU 0 XM2 [JUMP IF END OF CHAIN OF FIPS 3XGQ BCC XL 3Y2B BZE 5 XM [JUMP IF NO CELL YET SAVED 3YG2 CHUCK W,5 [CHUCK PREVIOUS CELL 3Y^L XM LDX 5 4 3^F= LDX 6 1 [SAVE CELL POINTERS 3^YW LDX 0 0(1) 42DG BNZ 0 XN [JUMP IF NEXT CELL NOT CONTIGUOUS 42Y6 ADN 1 17 43CQ ADN 4 17 [UPDATE POINTERS 43XB BRN XP 44C2 XN LDX 4 0(1) [BS ADDRESS NEXT CELL 44WL READST 4,XP [READ CELL 45B= TESTREP OK,XQ [JUMP IF OK 45TW TESTREP EXFAIL,XFL1 [OR FAIL 46*G XR GEOERR 1,CLOSTRAN 46T6 XQ LDX 1 ECOR(3) [NEW CORE POINTER 47#Q BRN XP 47SB XK LDX 4 5 [UNUSED CELL FOUND -SET POINTERS 48#2 LDX 1 6 [TO1PREVIOUS CHAIN 48RL XL LDX 5 AWORK4(2) [X5=BS ADDRESS FIP 49?= LDX 2 AWORK3(2) [X2=CORE ADDRESS FIP 49QW TXU 1 2 4==G BCC XS [JUMP IF CELLS THE SAME 4=Q6 LDX 6 1 4?9Q ADN 2 1 4?PB ADN 1 1 4#92 MOVE 1 16 [COPY OVER OLD CELL 4#NL CHUCKWR W,5,XT [REWRITE AND CHUCK 4*8= TESTREP OK,XT 4*MW TESTREP EXFAIL,XFL1 4B7G BRN XR 4BM6 XT LDX 1 6 [RESET CORE POINTER 4C6Q LDCT 0 #400 4CLB ORS 0 0(1) [SET UNUSED BIT 4D62 STOZ 1(1) 4DKL LDN 2 2(1) 4F5= ADN 1 1 4FJW MOVE 1 15 [ZEROIZE CELL 4G4G LDN 1 BCCB [IF FILE MOVED IS OPEN, CORE COPY 4GJ6 XWA LDX 1 BPTR(1) [MUST HAVE BS HOME UPDATED 4H3Q TXU 1 CXCC 4HHB BCC XW [J IF END OF CHAIN 4J32 LDX 0 BACK2(1) 4JGL BZE 0 XW [OR NO MORE EXOFS 4K2= TXU 4 HOME(1) [JUMP IF NOT THIS ONE THAT WAS MOVED 4KFW BCS XWA 4K^G TXU 7 ASUSN(1) 4LF6 BCS XWA [ 4LYQ STO 5 HOME(1) [UPDATE BS HOME 4MDB XW CLOSEWR W,4,S [CLOSE UNIT AND REWRITE CELL(SPECAIL) 4PBW TESTREP OK,XXY 4PWG TESTREP EXFAIL,XFL1 4QB6 TESTREP INOP,XFL2 4QTQ BRN XR 4S#L XXY FIPPER 4,7,XGC,XX,XX [TELL OTHER SIDE TO RE-READ 4SS= BRN XX 4TRG XS LDCT 0 #400 [NO NEED TO MOVE ANOTHER FIP 4W?6 ORS 0 0(1) [SET UNUSED BIT 4WQQ ADN 1 1 [AND ZEROIZE 4X=B LDN 2 1(1) 4XQ2 STOZ 0(1) 4Y9L MOVE 1 15 4YP= CLOSEWR W,4 4^8W TESTREP OK,XX 4^NG TESTREP EXFAIL,XFL1 5286 BRN XR 52MQ XX EXMESS ALL [OUTPUT ANY MESSAGES 537B MHUNTW 3,EWDAS,GEXD 53M2 MFINDEXOF 1,CEFN(3) 55KG LDCT 4 #42 5656 ANDX 4 EXMARK(1) [ANYBODY WAITING? 56JQ FREECORE 1 [FREE EXOF 574B BZE 4 WA 57J2 LONGON EDFDCLS [WAKE UP ANYBODY WAITING 592W LDCT 0 #2 59GG ANDX 0 4 5=26 BZE 0 WA [J IF NOBODY WAITING IN OTHER PROC 5=FQ AUTWIN GFCLOSE [ELSE WAKE THEM UP 5?F2 WA UNLOCKSU 7 [UNLOCK AND 5?YL RELST 7 [RELEASE UNIT 5#D= MHUNTW 3,EWDAS,GEXD 5G?Q YB LDCT 4 #6 [DEVICE TYPE IN B0-B8 5GRB ORX 4 EXCHNL(3) [CHANNEL NO. IN B9-B23 5H?2 RELPERENT 4,AWORK1(2) [RELEASE CHANNEL 5J== LDN 6 0 5JPW BRN XDC [JUMP TO SET REPLIES 5K9G # 5KP6 # 5L8Q # UNIT NOT ONLINE 5LNB XB 5M82 LDN 6 6 5MML LDX 0 AWORK2(2) 5N7= ANDN 0 2 5NLW BNZ 0 XDA [JUMP IF MODE #400 IS SET 5N^= ... LDN 3 0 [MKR IN CASE OF BREAKIN 5P6G SMUSEST 7,XF,XG 5PL6 BRN XE [JUMP IF OK. 5Q5Q # 5QKB # 5R52 # 5RJL ZE GEOERR 1,TRANSFER 5S4= # 5SHW # 5T3G # UNIT IN USE BY S-TRUSTED -CHECK IF FILE MOVED AND REFIND IF NECESSARY 5TH6 # 5W2Q ZA LDX 4 2(1) [CHECK FILENAMES 5WGB LDX 5 3(1) 5X22 LDX 6 4(1) 5XFL TXU 4 FIP(2) 5X^= TXU 5 FIP+1(2) 5YDW TXU 6 FIP+2(2) 5YYG BCS ZB [JUMP IF DIFFERENT 5^D6 LDX 0 6(1) 5^XQ ERX 0 FIP+4(2) 62CB SRL 0 12 62X2 BZE 0 ZC [JUMP IF IDENTITY OK 63BL ZB [OTHERWISE FIND IT AGAIN 63W= CLOSEST ZD 64*W TESTREPNOT OK,XR 64TG ZD SETNCORE FDCELLS-A1,2,EWDAS,EXOF 65*6 MHUNTW 3,EWDAS,GEXD 65SQ MFINDEXOF 1,CEFN(3) 66#B LDX 0 BACK2(1) 66S2 STO 0 BACK2(2) [EXOFILE NUMBER 67?L ADN 1 A1 67R= ADN 2 A1 68=W ... MOVE 1 FDCELLS-A1 68QG LDN 0 BSERL+BOPEN+BSPEC+BLOCK 69=6 STO 0 EXMARK-A1(2) 69PQ DOWN EXOPEN,1 6=9B TESTREP OK,ZF 6=P2 TESTREP EXFAIL,ZG 6?8L ZH GEOERR 1,EXOREP 6?N= ZF MHUNTW 3,EWDAS,GEXD 6#7W MFINDEXOF 2,CEFN(3) 6#MG MHUNTW 1,EWDAS,EXOF 6*76 LDX 0 HOME(1) 6*LQ STO 0 HOME(2) 6B6B FREECORE 1 6BL2 BRN XH 6C5L ZG MHUNTW 3,EWDAS,GEXD 6CK= LDX 0 EMARK(3) 6D4W ANDN 0 ANFOUND+AFAIL+ARITE 6DJG BZE 0 ZH 6F46 ANDN 0 ANFOUND 6FHQ BZE 0 ZJ [JUMP IF FAIL 6G3B MHUNTW 2,EWDAS,EXOF 6GH2 FREECORE 2 6H2L BRN XP [NOT FOUND 6HG= XFL2 LDX 4 7 [CATASTROPHIC FAIL (PERHAPS?) 6H^W LDN 5 9 6JFG OUTBLOCK 5 [SET UP PARAMETER BLOCK 6J^6 ADN 2 ACOMMUNE1 6KDQ LDN 0 6 6KYB SLL 4 3 [CONVERT SERIAL NUMBER TO CHARS 6LD2 X2A SLC 4 6 6LXL DCH 4 0(2) 6MC= BCHX 2 £ 6MWW SRL 4 3 6NBG BCT 0 X2A 6NW6 LDN 4 6 6P*Q OUTPARAM 4,ACOMMUNE1 6PTB MHUNTW 3,EWDAS,GEXD 6Q*2 MFINDEXOF 1,CEFN(3) 6QSL LDX 6 FIP+4(1) [GENERATION NUMBER 6R#= LDN 4 12 6RRW ADN 1 FIP 6S?G ADN 2 ACOMMUNE1 6SR6 MOVE 1 3 [MOVE FILENAME TO ACTIVITY 6T=Q X2C LDCH 0 0(2) [COUNT CHARS 6TQB SBN 0 #20 6W=2 BZE 0 X2B 6WPL NGX 5 4 6X9= X2B BCT 4 X2C 6XNW ADN 5 13 6Y8G OUTPARAM 5,ACOMMUNE1 [OUTPUT FILE NAME 6YN6 SRL 6 12 6^7Q OUTNUM 6,0 [GENERATION NUMBER 6^MB MONOUT HYDRA [2 HEADED FILE 7272 BRN XFL1 72LL # 736= # 74K6 XGC UNLOCKSU 7 [UNLOCK 74M2 ...# 74ML ...# IPB INOP 74N= ...# 74NW ...XFA1 NGNC 3 1 74PG ...# 74Q6 ...# BREAKIN WHEN WAITING FOR IPB 74QQ ...# 74RB ...XGA LDN 3 0 74S2 ... RELST 7 74SL ...XG [BREAKIN FOR SU 74T= ... MHUNTW 1,EWDAS,GEXD [X3=0 IF BREAKIN =1 IF IPB INOP 74TW ... FREECORE 1 74WG ... STEPBACK [MOVE ONR BACK ONE 74X6 ... BZE 3 NIPB [J IF BREAKIN 74XQ ... TWAIT 7,NIPB [WAIT FOR IPB 74YB ... RUNPROG [TRY AGAIN 74^2 ...NIPB PROGBRKIN [REPORT BREAKIN 78G6 # 78^Q # 79FB # SET OBJECT PROGRAM REPLIES 79^2 XD UNLOCKSU 7 7=DL RELST 7 7=Y= XDA LDCT 0 #400 7?CW ORX 6 0 7?XG XDC MHUNTW 3,EWDAS,GEXD 7#C6 LDX 7 CNR(3) [C.A ADDRESS 7#WQ ADN 7 1 7*BB FREECORE 3 [FREE GEXD 7*W2 ... GETWORD 7,7,WRITE 7B*L ... TESTREPNOT OK,XERR1 7C#W SMO 7 7CSG STO 6 0 [SET REPLY 7D4# ... WORDFIN 7D#6 RUNPROG [RESTART PROGRAM 7DRQ # 7F?B # 7FR2 ZJ MHUNTW 2,EWDAS,EXOF 7G=L FREECORE 2 7GQ= XFL1 UNLOCKSU 7 7H9W XFA RELST 7 [RELEASE UNIT 7HFN ...XEFN 7HPG EXMESS ALL [OUTPUT MESSAGES 7J96 XF MHUNTW 3,EWDAS,GEXD 7JNQ LDX 7 CNR(3) [CA ADDRESS 7K8B ADN 7 1 7KN2 LDX 5 EXCHNL(3) [CONVERT CHANNEL NR TO DECIMAL 7L7L FREECORE 3 7LM= ... LDCT 6 6 7M6W ... ADX 5 6 [DEVICE AND CHANNEL 7MLG ...XPAR OUTPACK 5,1,PERINAME,XPAR [ONLINE *DA FAIL 7N66 ... GETWORD 7,7,WRITE 7NKQ ... TESTREPNOT OK,XERR1 7T2B LDCT 6 #440 7TG2 SMO 7 [SET FAIL REPLY 7T^L STO 6 0 7W9D ... WORDFIN 7WF= ILLEGAL PERFAIL 7WYW # 7XDG XERR1 GEOERR 1,CHECKA 7XY6 # 7YCQ MENDAREA 30,K99CLOSDEL 7YXB #END ^^^^ ...24352632000100000000