{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: CLOSDEL867)}}
====== CLOSDEL867 ======
(George Source)
**Macros used:** [[george:macro:ANYUSERS|ANYUSERS]], [[george:macro:AUTWIN|AUTWIN]], [[george:macro:CHUCK|CHUCK]], [[george:macro:CHUCKWR|CHUCKWR]], [[george:macro:CLOSEST|CLOSEST]], [[george:macro:CLOSEWR|CLOSEWR]], [[george:macro:DOWN|DOWN]], [[george:macro:EXMESS|EXMESS]], [[george:macro:FIPPER|FIPPER]], [[george:macro:FPCACA|FPCACA]], [[george:macro:FREECORE|FREECORE]], [[george:macro:GEOERR|GEOERR]], [[george:macro:GETWORD|GETWORD]], [[george:macro:ILLEGAL|ILLEGAL]], [[george:macro:KEEPMESS|KEEPMESS]], [[george:macro:LONGON|LONGON]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MFINDEXOF|MFINDEXOF]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:MONOUT|MONOUT]], [[george:macro:OPENST|OPENST]], [[george:macro:OUTBLOCK|OUTBLOCK]], [[george:macro:OUTNUM|OUTNUM]], [[george:macro:OUTPACK|OUTPACK]], [[george:macro:OUTPARAM|OUTPARAM]], [[george:macro:PLOCKSU|PLOCKSU]], [[george:macro:PROGBRKIN|PROGBRKIN]], [[george:macro:READSAVE|READSAVE]], [[george:macro:READST|READST]], [[george:macro:RELPERENT|RELPERENT]], [[george:macro:RELST|RELST]], [[george:macro:RUNPROG|RUNPROG]], [[george:macro:SAVEST|SAVEST]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:SMUSEST|SMUSEST]], [[george:macro:STEPBACK|STEPBACK]], [[george:macro:SUSEST|SUSEST]], [[george:macro:SXTEST|SXTEST]], [[george:macro:TESTREP|TESTREP]], [[george:macro:TESTREPNOT|TESTREPNOT]], [[george:macro:TRACE|TRACE]], [[george:macro:TRUSTED|TRUSTED]], [[george:macro:TWAIT|TWAIT]], [[george:macro:UNLOCKSU|UNLOCKSU]], [[george:macro:WORDFIN|WORDFIN]]
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