{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: SAVEDA70)}}
====== SAVEDA70 ======
(George Source)
**Macros used:** [[george:macro:CLOSE|CLOSE]], [[george:macro:COMBRKIN|COMBRKIN]], [[george:macro:ENDCOM|ENDCOM]], [[george:macro:FPCACA|FPCACA]], [[george:macro:GEOERR|GEOERR]], [[george:macro:GETWORD|GETWORD]], [[george:macro:GETWORDX|GETWORDX]], [[george:macro:HUNT2|HUNT2]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MFREE|MFREE]], [[george:macro:MHUNT|MHUNT]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:MONOUT|MONOUT]], [[george:macro:NAME|NAME]], [[george:macro:OUTPACK|OUTPACK]], [[george:macro:SCANPT|SCANPT]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:SWAPOUT|SWAPOUT]], [[george:macro:TESTREP2|TESTREP2]], [[george:macro:TESTRPN2|TESTRPN2]], [[george:macro:TRACE|TRACE]], [[george:macro:VFREEW|VFREEW]], [[george:macro:WORDFIN|WORDFIN]], [[george:macro:WRITED|WRITED]]
22FL #LIS K0SAVEDA>K0SAVE>K0COMMAND>K0ALLGEO
22^= #SEG SAVEDA70 [RUTH PORTER
23DW 8HSAVEDA
23YG #
24D6 # THIS SEGMENT COMPLETES THE SAVE COMMAND FOR DA FILES
24XQ #
25CB SEGENTRY K1SAVEDA,XK1 [ENTRY FROM SAVE
25X2 #
26BL #
26W= # THIS SUBROUTINE FORMS ORGANISATIONAL RECORD
27*W ORGR
27TG MHUNTW 1,ADATA,CSTORE [FIND POSITION FOR NEXT
28*6 LDN 0 5
28SQ LDN 3 A1(1) [ORGANISATIONAL ENTRY
29#B ADX 3 0(3)
29S2 ADS 0 A1(1)
2=?L SMO FX1
2=R= LDX 0 TYPE5 [SPECIFICATION WORD
2?=W STO 0 0(3)
2?QG LDX 0 AWORK3(2) [DESTINATION IN CORE
2#=6 STO 0 1(3)
2#PQ STO 7 2(3) [RECORD LENGTH
2*9B NGS 6 3(3) [CHECKSUM
2*P2 LDX 0 AWORK4(2) [BUCKET ADDRESS
2B8L SBX 0 A1+2(1)
2BN= STO 0 4(3)
2C7W #SKI K6SAVEDA>199-199
2CMG TRACE 4(3),SVORGBUC
2D76 LDN 6 0 [RESET CHECKSUM
2DLQ LDN 7 0 [AND RECORD LENGTH
2F6B EXIT 4 0
2FL2 WRITB [WRITE TO BUCKET SPECIFIED
2G5L SBX 4 FX1 [IN X3
2GK= WRITED 3,1
2H4W TESTRPN2 OVERFILE,SPACE
2HJG GEOERR 1,SVFULL
2J46 SPACE
2JHQ SETNCORE 128,1,FILE,FRWB
2K3B ADX 4 FX1
2KH2 EXIT 4 0
2L2L ORGB [TIDY ORGANISATIONAL BUCKET
2LG= MHUNTW 1,ADATA,CSTORE
2L^W LDN 0 1 [WHERE IS NEXT ORG BUCKET?
2MFG STO 0 A1+1(1) [TENTATIVELY,ADJACENT
2M^6 LDX 0 A1+2(1) [FIND CURRENT BUCKET
2NDQ #SKIP G4
2NYB ANDN 0 7
2PD2 #SKIP G3
2PXL ANDN 0 3
2QC= BNZ 0 ORGBX [J IF GROUP SUFFICES,ELSE
2QWW LDX 0 AWORK2(2) [FIND RELATIVE ADDRESS OF
2RBG SBX 0 A1+2(1) [NEXT QUARTET OR OCTET
2RW6 STO 0 A1+1(1)
2S*Q #SKIP G4
2STB LDN 0 8
2T*2 #SKIP G3
2TSL LDN 0 4
2W#= ADS 0 AWORK2(2) [NEXT FREE GROUP
2WRW ORGBX
2X?G LDX 0 A1+1(1) [ABSOLUTE BUCKET NUMBER +
2XR6 ADX 0 A1+2(1) [NEXT REL.=NEW ABSOLUTE
2Y=Q STO 0 AWORK3(2)
2YQB ORGBY
2^=2 LDX 2 A1(1) [DATA LENGTH
2^PL SBN 2 3
329= LDN 3 A1+3(1) [FIRST USEFUL WORD
32NW SUM 2 0(2) [CHECKSUM
338G LDX 3 A1+2(1) [DESTINATION
33N6 NGS 2 A1+2(1)
347Q EXIT 4 0
34MB NORGB [BEGIN NEW ORG BUCKET
3572 MHUNTW 1,ADATA,CSTORE
35LL LDN 0 3 [RESET POINTER
366= STO 0 A1(1)
36KW LDX 0 AWORK3(2)
375G STOZ A1+1(1) [NEXT REL BUCK
37K6 STO 0 A1+2(1) [CURRENT ORG BUCKET
384Q EXIT 4 0
38JB RENAM [SWITCH WRITE BLOCKS
3942 MHUNTW 1,ADATA,CSTORE
39HL MHUNTW 2,FILE,FRWB
3=3= NAME 2,ADATA,CSTORE
3=GW NAME 1,FILE,FRWB
3?2G LDX 2 FX2
3?G6 EXIT 4 0
3?^Q #SKIP G4
3#FB (
3#^2 #
3*DL # ROUTINE STORES NEXT TYPE 7 RECORD FROM X6+X7
3*Y= #
3BCW SV0
3BXG LDX 2 FX2
3CC6 SBX 4 FX1
3CWQ LDX 0 AWORK1(2) [JUMP UNLESS FIRST ENTRY
3DBB BNZ 0 SV1
3DW2 SETNCORE 128,1,FILE,FRWB [CREATE BLOCK
3F*L BRN SV5
3FT= SV1
3G#W MHUNTW 1,FILE,FRWB [FIND BLOCK
3GSG LDX 0 AWORK3(2)
3H#6 SBN 0 128
3HRQ BZE 0 SV3 [JUMP IF FULL
3J?B SV2
3JR2 SMO AWORK3(2) [STORE NEW PAIR
3K=L STO 6 A1(1)
3KQ= SMO AWORK3(2)
3L9W STO 7 A1+1(1)
3LPG LDN 0 2
3M96 ADS 0 AWORK3(2) [UPDATE POINTER
3MNQ LDCT 0 #40 [EXTRACT SHARED BIT
3N8B ANDX 0 6
3NN2 ADN 0 1 [GNDICATE PRESENCE OF
3P7L ORS 0 AWORK1(2) [TYPE 7 RECORDS
3PM= ADX 4 FX1
3Q6W EXIT 4 0
3QLG SV3 [FULL BUCKET ROUTINE
3R66 LDX 0 AWORK2(2)
3RKQ SBN 0 2 [FIRST TYPE 7 BUCKET?
3S5B BNZ 0 SV4
3SK2 LDN 0 3
3T4L STO 0 AWORK2(2) [SKIP BUCKET 2
3TJ= SV4
3W3W SMO FX1
3WHG LDX 0 TYPE7 [SPECIFICATION WORD
3X36 STO 0 A1(1)
3XGQ LDN 0 128 [USEFUL WORDS
3Y2B STO 0 A1+1(1)
3YG2 LDX 3 AWORK2(2) [DESTINATION BUCKET
3Y^L LDN 0 1
3^F= ADS 0 AWORK2(2) [NEW BUCKET
3^YW ADX 0 3
42DG STO 0 A1+3(1) [CHAIN ADDRESS
42Y6 LDN 1 A1(1) [CHECKSUM
43CQ SUM 0 128
43XB SBS 0 2(1)
44C2 STO 4 AWORK3(2) [PRESERVE LINK
44WL CALL 4 WRITB [WRITE AWAY BUCKET
45B= LDX 4 AWORK3(2) [RESTORE LINK
45TW SV5
46*G LDN 0 4
46T6 STO 0 AWORK3(2) [RESET POINTER
47#Q BRN SV1 [NOW STORE RECORD
47SB )
48#2 #
48RL TYPE #73230000
49?= TEB #73020003
49QW TES #73100006
4==G TURTY #74000 [MAX.RECORD SIZE 30K
4=Q6 #SKIP G4
4?9Q TYPE7 #73000007
4?PB TYPE5 #73050005 [FIRST WORD OF ORG.RECORD
4#92 TYPE2 #73020002 [FIRST WORD OF ENTRY BLOCK
4#NL XBUC1 +0 [DATA FOR FIRST BUCKET
4*8= #1000023
4*MW +8
4B7G 12HCOMPOFILE
4BM6 +0
4C6Q +1
4CLB +0
4D62 +0
4DKL +9
4F5= 12HPROGRAM [NAME TO BE ADDED FROM R/S
4FJW +2
4G4G +0 [NO.OF BUCKETS-CALCULATED
4GJ6 +0
4H3Q +1
4HHB 4HA100
4J32 #
4JGL #
4K2= # ENTRY HERE !!
4KFW #
4K^G XK1
4LF6 SWAPOUT [STABLE FOR PERM CHECKS
4LYQ
4MDB SETNCORE 128,1,ADATA,CSTORE [ORG BUCKET AREA
4MY2 LDN 0 2 [CURRENT ORG'BUCKET NUMBER
4NCL STO 0 AWORK2(2)
4NX= N1
4PBW FPCACA 1,2
4PWG #SKIP G3
4QB6 (
4QTQ LDX 6 ALIMIT(1) [PRESERVE CORE SIZE
4R*B SLC 6 9
4RT2 )
4S#L #SKIP G4
4SS= (
4T?W HUNT2 3,BSTB,BSCB,1 [FIND PROGRAM SIZE
4TRG LDX 6 AMAXSIZE(3)
4W?6 LDX 0 6
4WQQ SLC 6 12
4X=B BPZ 0 N1A [JUMP IF DENSE
4XQ2 SBN 6 #3776 [REMOVE B0,STORE BIT FOR RS
4Y9L N1A
4YP= SLC 6 7
4^8W )
4^NG LDX 7 ARM1(1)
5286 SRL 7 3
52MQ ANDN 7 7
537B HUNT2 1,AOBRES,0 [FIND REQUEST SLIP
53M2 MHUNTW 2,ADATA,CSTORE [FIND ORG.BUCKET
546L LDN 4 A1(1)
54L= LDN 5 A1+3(2)
555W LDX 3 A1(1) [FIND LENGTH OF REQUEST SLIP
55KG SRL 3 12
5656 ANDN 3 #77
56JQ MOVE 4 0(3) [REQUEST SLIP TO OUTPUT BLOCK
574B STO 6 A1+6(2)
57J2 SUM 4 0(3)
583L SBS 4 A1+16(2) [NEGATIVE CHECKSUM
58H= #SKIP G3
592W (
59GG LDX 0 ALOGLEN(1)
5=26 SBN 0 17
5=FQ BPZ 0 N2 [JUMP IF SRS
5=^B BZE 7 N3 [JUMP IF MODES ABSENT
5?F2 # FORM SUPPLEMENTARY REQUEST SLIP IF ONE IS PRESENT OR NEEDED
5?YL )
5#D= N2
5#XW LDX 1 5
5*CG ADX 1 3 [WORD AFTER REQUEST SLIP
5*X6 SMO FX1
5BBQ LDX 0 TES [STORE SPECIFYING WORD
5BWB STO 0 0(1)
5CB2 STO 7 1(1) [STORE MODES
5CTL LDN 7 2(1) [CLEAR RESERVED WORDS
5D*= LDN 0 3(1)
5DSW STOZ 2(1)
5F#G MOVE 7 4
5FS6 SUM 0 7
5G?Q NGS 0 7(1) [CHECKSUM
5GRB LDN 7 8 [LENGTH OF SRS
5H?2 N3
5HQL ADN 7 3 [1ST THREE WORDS
5J== ADX 7 3 [LENGTH OF R/S
5JPW STO 7 A1(2) [RESULT IS POINTER
5K9G #SKIP G4
5KP6 (
5L8Q #
5LNB # THIS ROUTINE STORES PERMISSIONS FOR EACH SEGMENT NOT
5M82 # HAVING NORMAL SETTINGS IN THE SWAP CONTROL BLOCK
5MML #
5N7= SW0
5NLW LDX 2 FX2
5P6G STOZ AWORK1(2)
5PL6 LDN 6 0 [START ADRESS
5Q5Q SW1
5QKB LDX 2 FX2
5R52 LDX 0 6 [TEST IF NEW WD REQUIRED
5RJL SLL 0 8 [I+E: MULTIPLE OF 8*64K
5S4= BNG 0 SW2
5SHW LDX 0 6
5T3G SRL 0 16 [FIND MULTIPLE OF 64K
5TH6 FPCACA 3,FX2 [FIND SCB
5W2Q HUNT2 3,BSTB,BSCB,3
5WGB SMO 0
5X22 LDX 0 HPERM(3)
5XFL STO 0 AWORK4(2) [SETS OF PERMISSIONS
5X^= SW2 [EXTRACT NEXT 3 BITS
5YDW LDX 0 AWORK4(2)
5YYG SLC 0 3
5^D6 STO 0 AWORK4(2)
5^XQ ERN 0 7 [INVERT
62CB ANDN 0 7
62X2 LDX 7 0 [ARRANGE FOR STORING IN
63BL SRC 7 3 [BUCKET
63W= BZE 0 SW3
64*W CALL 4 SV0 [STORE IF SPECIAL
64TG SW3
65*6 MHUNTW 3,ADATA,CSTORE [FIND TEMPORARY STORAGE
65SQ BNZ 6 SW4 [JUMP UNLESS FIRST CYCLE
66#B STOZ 4 [ZEROISE START ADRESS
66S2 FPCACA 2,FX2
67?L LDX 5 ALIMIT(2) [FIND PROGRAM LENGTH IN K
67R= SRL 5 10
68=W BRN SW5
68QG SW4
69=6 LDX 4 A1+124(3) [MOVE IN START ADDRESS
69PQ LDX 5 A1+125(3) [PROGRAM LENGTH
6=9B ADN 4 64 [UPDATE LENGTH
6=P2 SW5
6?8L LDN 0 4 [PRESERVE WITH RECORD
6?N= LDN 1 A1+124(3) [FOR SEGMENT
6#7W MOVE 0 4
6#MG FPCACA 2,FX2
6*76 SCANPT 3,SOVER,SCOOR,SGAP,ASEGTAB(2),4,5,2,3
6*LQ SCOOR
6B6B LDX 5 7 [SET PREVIOUS VALUE
6BL2 STOZ 4 [ZEROISE RECFRD LENGTH
6C5L SW6
6CK= LDX 1 0(2) [EXAMINE NEXT ENTRY
6D4W BNG 1 SW7 [JUMP UNLESS REPLACED
6DJG LDX 1 0(1)
6F46 SW7
6FHQ SRL 1 6 [EXTRACT PERMS & SHRBL BIT
6G3B ERN 1 14 [INVERT PERMISSIONS
6GH2 SLL 1 20
6H2L LDCT 0 #740
6HG= ANDX 0 5
6H^W TXU 1 0
6JFG BCC SW10 [JUMP IF SAME AS PREVIOUS
6J^6 SW8
6KDQ LDCT 0 #740
6KYB ANDX 0 5
6LD2 ADX 6 4 [FORM ADDRESSES FOR STORED
6LXL ADX 4 5 [AND NEW RECORDS
6MC= SBX 4 0
6MWW SBX 0 7
6NBG LDX 7 5 [PRESENT TO STORING ROUTINE
6NW6 LDX 5 1 [NEW VALUES FOR NEXT CYCLE
6P*Q BZE 0 SW9 [JUMP IF SAME VALUES AS SEGMENT
6PTB MHUNTW 1,ADATA,CSTORE [PRESERVE DETAILS OF SEARCH
6Q*2 LDN 0 2
6QSL LDN 1 A1+120(1)
6R#= MOVE 0 4
6RRW CALL 4 SV0 [STORE TYPE 7 RECORD
6S?G MHUNTW 1,ADATA,CSTORE
6SR6 LDN 6 A1+120(1)
6T=Q LDN 7 2
6TQB MOVE 6 4 [RESTORE DETAILS OF SEARCH
6W=2 SW9
6WPL MHUNTW 1,ADATA,CSTORE
6X9= LDX 6 A1+126(1) [RESTORE SEGMENT ADDRESS
6XNW LDX 7 A1+127(1) [AND PERMISSIONS
6Y8G SW10
6YN6 ADN 5 1024 [UPDATE RECORD LENGTH
6^7Q ADN 2 1 [UPDATE POINTER
6^MB SBN 3 1 [UPDATE COUNT
7272 BZE 3 SW8 [CLEAR LAST RECORD
72LL BPZ 3 SW6
736= SGAP
73KW ADX 6 BIT7 [ADD 64K
745G LDX 0 6
74K6 SLL 0 2
754Q BNZ 0 SW1 [JUMP UNLESS 64 ENTRIES
75JB SOVER
7642 #
76HL # CLEAR UP AFTER LAST TYPE 7 RECORD
773= #
77GW LDX 2 FX2
782G MHUNTW 1,ADATA,CSTORE [FIND BLOCK WITH R/S
78G6 LDX 5 AWORK1(2)
78^Q BZE 5 SX1 [JUMP IF NO TYPE 7 RECORDS
79FB MHUNTW 3,FILE,FRWB [FIND TYPE 7 RECORDS
79^2 LDX 0 AWORK2(2) [TEST IF FIRST TYPE 7 BUCKET
7=DL SBN 0 2
7=Y= BNZ 0 SX2 [JUMP IF NOT
7?CW LDX 0 A1(1) [POINTER TO ADATA/CSTORE
7?XG ADX 0 AWORK3(2)
7#C6 SBN 0 129 [IS THERE ROOM IN BUCKET 2?
7#WQ BPZ 0 SX2 [JUMP IF NOT
7*BB LDN 7 A1(1) [MOVE RECORDS TO BUCKET 2
7*W2 ADX 7 A1(1) [DESTINATION ADDRESS
7B*L LDN 6 A1(3) [SO4RCE ADDRESS
7BT= LDX 3 AWORK3(2)
7C#W MOVE 6 0(3)
7CSG LDN 0 3
7D#6 STO 0 AWORK2(2) [NEXT ORG.BUCKET
7DRQ LDX 2 A1(1)
7F?B ADN 2 A1-4(1) [WORD 4 OF SRS
7FR2 SMO FX1
7G=L LDX 0 TYPE7 [SPECIFICATION WORD
7GQ= STO 0 4(2)
7H9W STO 3 5(2) [LENGTH FO SPA INFORMATION
7HPG LDN 7 4(2)
7J96 STOZ 7(2)
7JNQ SUM 6 0(3)
7K8B SBS 6 6(2) [CHECSUM
7KN2
7L7L # STORE IN SRS A WORD INDICATING NO SHAREABLE AREAS,
7LM= # RESTRICTED BINARY FORMAT AND TYPE 7 RECORDS IN THIS
7M6W # BUCKET
7MLG #
7N66 LDCT 7 1 [EXTRACT SHAREABLE INDICATOR
7NKQ ERX 7 5 [AND SET BIT 5
7P5B SRL 7 1 [ELIMINATE INDICATOR
7PK2 SLL 7 4
7Q4L ADX 7 A1(1)
7QJ= STO 7 0(2) [STORE IN SRS
7R3W SBS 7 3(2)
7S36 BRN SX3
7SGQ SX1 [NO TYPE 7 RECORDS
7T2B LDX 2 A1(1) [INDICATE IN WD4 OF SRS
7TG2 ADN 2 A1-4(1)
7T^L LDCT 0 8
7WF= STO 0 0(2)
7WYW SBS 0 3(2)
7XDG BRN U0
7XY6 #
7YCQ # WRITE AWAY LAST BUCKET OF TYPE 7 RECORDS
7YXB #
7^C2 SX2
7^WL SMO FX1
82B= LDX 0 TYPE7 [SPECIFICATION WORD
82TW STO 0 A1(3)
83*G LDX 1 AWORK3(2) [STORE NO OF USEFUL WORDS
83T6 STO 1 A1+1(3)
84#Q STOZ A1+3(3) [END OF CHAIN
84SB LDN 7 A1(3)
85#2 SUM 6 0(1)
85RL SBS 6 A1+2(3) [STORE CHECKSUM
86?= LDX 3 AWORK2(2) [DESTINATION BUCKET
86QW CALL 4 WRITB [LAST TYPE7 BUCKET
87=G LDN 0 1 [NEXT ORG+BUCKET
87Q6 ADS 0 AWORK2(2)
889Q #
88PB # STORE IN SRS A WORD INDICATING NO SHAREABLE AREAS,
8992 # RESTRICTED BINARY FORMAT AND TYPE 7 RECORDS IN A
89NL # GROUP OF BUCKETS
8=8= #
8=MW MHUNTW 1,ADATA,CSTORE
8?7G LDX 3 A1(1) [FIND WD 4 OF SRS
8?M6 ADN 3 A1-4(1)
8#6Q LDCT 0 #40 [EXTRACT SHAREABLE INDICATOR
8#LB ANDX 0 AWORK1(2)
8*62 SRC 0 12
8*KL ADX 0 AWORK2(2) [NO OF BUCKETS OF TYPE 7
8B5= ADN 0 #1005 [DATA FROM BUCKET 3
8BJW SRC 0 9
8C4G STO 0 0(3)
8CJ6 SBS 0 3(3)
8D3Q SX3
8DHB SMO FX2 [STORE RELATIVE ADDRESS OF
8F32 LDX 0 AWORK2 [NEXT ORGANISATIONAL BUCKET
8FGL SBN 0 2
8G2= STO 0 A1+1(1)
8GFW CALL 4 ORGBY [TIDY AND
8G^G CALL 4 RENAM [WRITE AWAY BUCKET 2
8HF6 LDN 3 2
8HYQ CALL 4 WRITB
8JDB CALL 4 RENAM
8JY2 MFREE FILE,FRWB [FREE TYPE 7'S BUCKET AREA
8KCL MHUNT 1,ADATA,CSTORE [INITIALISE WITH NEXT
8KX= LDN 0 3 [FREE BUCKET
8LBW STO 0 A1(1) [POINTER
8LWG )
8MB6 # INITIALISE FOR MAJOR ROUTINES
8MTQ #
8N*B U0
8NT2 SETNCORE 512,1,FILE,FRWB
8P#L MHUNTW 1,ADATA,CSTORE
8PS= LDX 0 AWORK2(2)
8Q?W STO 0 A1+2(1) [CURRENT ORG'BUCKET
8QRG STOZ A1+1(1) [NEXT ORG'BUCKET
8R?6 #SKIP G4
8RQQ (
8S=B ADN 0 7 [FIND FIRST OCTET
8SQ2 ANDN 0 #7770
8T9L )
8TP= #SKIP G3
8W8W (
8WNG ADN 0 3 [FIND FIRST QUARTET
8X86 ANDN 0 #7774
8XMQ )
8Y7B ADN 0 1
8YM2 STO 0 AWORK2(2)
8^6L LDN 5 0 [O/P POINTER
8^L= U1 [NEW RECORD
925W LDN 6 0 [CHECKSUM
92KG LDN 7 0 [PECORD LENGTH
9356 U2
93JQ FPCACA 1,FX2 [TEST IF END OF O/P
944B LDN 3 512
94J2 LDX 0 ALIMIT(1)
953L SBX 0 5
95H= BZE 0 V4 [JUMP IF SO
962W #SKIP G3
96GG (
9726 SBN 0 512 [LESS THAN 512 WORDS LEFT?
97FQ BPZ 0 U2C
97^B ADX 3 0
98F2 )
98YL U2C
99D= #SKIP G4
99XW (
9=CG LDN 4 CHUSED+GREAD
9=X6 GETWORDX 5,1,4,4,3,VBIN [GET NEXT 512 WORDS
9?BQ TESTRPN2 NOTUSED,U2B [J IF NOT ACCESSED
9?WB VFREEW ADATA,ERREPLY [KEEP CORE TIDY
9#B2 LDX 1 FX1 [ON THE SAFE SIDE
9#TL LDX 3 4 [SKIP UNACCESSED AREA
9**= )
9*SW #SKIP G3
9B#G GETWORD 5,1,READ,4,3,VBIN
9BS6 #SKI ADELO
9C?Q TESTREP2 LOADERR,Y8
9CRB U2B
9D?2 BNZ 5 U2A
9DQL LDX 0 8(1) [FIND ENTRY POINT
9F== STO 0 AWORK1(2) [PRESERVE IT
9FPW U2A
9G9G ADX 5 3 [UPDATE POINTER BY RECORD LENGTH
9GP6 STO 3 ACOMMUNE1(2) [PRESERVE BLOCK LENGTH
9H8Q # NOW TEST IF BLOCK IS ENTIRELY ZERO
9HNB #SKIP G4
9J82 (
9JML ANDN 3 512 [TEST IF UNACCESSED
9K7= BZE 3 U5A
9KLW )
9L6G SUM 0 0(3) [CHECKSUM IS NEEDED ANYWAY
9LL6 ADX 6 0 [UPDATE CHECKSUM OVER RECORD
9M5Q #SKIP G4
9MKB BRN U7
9N52 #SKIP G3
9NJL (
9P4= BNZ 0 U7
9PHW U5
9Q3G ORX 0 0(1)
9QH6 BUX 1 £
9R2Q BCT 3 U5
9RGB BNZ 0 U6
9S22 )
9SFL # BLOCK IS ENTIRELY ZERO.TEST IF END OF RECORD
9S^= U5A
9TDW BZE 7 U2 [BACK IF NO RECORD PRESENT
9TYG BRN V2
9WD6 U6
9WXQ #SKIP G3
9XCB SBX 1 ACOMMUNE1(2) [RESET O/P ADDRESS
9XX2 U7
9YBL ADX 7 ACOMMUNE1(2) [UPDATE RECORD LENGTH
9YW= MHUNTW 2,FILE,FRWB
9^*W LDN 2 A1(2)
9^TG MOVE 1 512
=2*6 LDX 2 FX2
=2SQ SBSC 7 ACOMMUNE1(2) [TEST IF FIRST BUCKET OF
=3#B BCS V1 [RECORD
=3S2 # DEAL WITH FIRST BUCKET OF NEW RECORD
=4?L MHUNTW 3,ADATA,CSTORE [ORGANISATIONAL BUCKET FULL?
=4R= LDX 0 A1(3)
=5=W SBN 0 124
=5QG BNG 0 U9 [JUMP IF NOT
=6=6 U8
=6PQ CALL 4 ORGB [TIDY ORGANISATIONAL BUCKET
=79B CALL 4 RENAM
=7P2 CALL 4 WRITB [WRITE ORGANISATIONAL BUCKET
=88L CALL 4 RENAM
=8N= CALL 4 NORGB [BEGIN NEW ORG.BUCKET
=97W U9
=9MG STO 5 AWORK3(2) [STORE O/P ADDRESS
==76 SBS 7 AWORK3(2)
==LQ LDX 0 AWORK2(2) [STORE BEGINNING BUCKET
=?6B STO 0 AWORK4(2) [ADDRESS
=?L2 # DEAL WITH BUCKETS OTHER THAN THE FIRST OF A RECORD
=#5L V1
=#K= LDX 3 AWORK2(2)
=*4W SRL 3 2 [CONVERT TO BLOCK NUMBER
=*JG ADN 3 1
=B46 WRITED 3,4 [WRITE 4 BUCKETS OF PROGRAM
=BHQ TESTRPN2 OVERFILE,ROOM
=C3B GEOERR 1,SVFULL
=CH2 ROOM
=D2L SETNCORE 512,3,FILE,FRWB
=DG= LDN 0 4 [FIND NEXT QUARTET
=D^W ADS 0 AWORK2(2)
=FFG TXL 7 TURTY(1) [JUMP UNLESS RECORD IS 30K
=F^6 BCS U2 [NEXT RECORD
=GDQ V2
=GYB CALL 4 ORGR [STORE ORG.RECORD
=HD2 BRN U2
=HXL V4
=JC= BZE 7 V5
=JWW CALL 4 ORGR
=KBG # END OF OBJECT PROGRAM HAS BEEN REACHED AND LAST
=KW6 # ORGANISATIONAL RECORD HAS BEEN FORMED
=L*Q V5
=LTB MHUNTW 1,ADATA,CSTORE [TEST IF ROOM FOR ENTRY
=M*2 LDX 3 A1(1) [BLOCK
=MSL SBN 3 126
=N#= BNG 3 V6
=NRW CALL 4 ORGB [IF NOT,TIDX BUCKET
=P?G CALL 4 RENAM
=PR6 CALL 4 WRITB [AND WRITE IT
=Q=Q CALL 4 RENAM
=QQB CALL 4 NORGB [NEW BUCKET
=R=2 BRN V5 [FIND ADATA/CSTORE
=RPL V6
=S9= LDN 3 A1(1) [FIND POSITION FOR ENTRY
=SNW LDN 0 2 [UPDATE POINTER
=T8G ADX 3 0(3)
=TN6 ADS 0 A1(1)
=W7Q SMO FX1
=WMB LDX 0 TEB [STORE SPECIFICATION WORD
=X72 STO 0 0(3)
=XLL LDX 0 AWORK1(2) [STORE ENTRY WORD
=Y6= STO 0 1(3)
=YKW CALL 4 ORGBX [TIDY LAST BUCKET
=^5G CALL 4 RENAM
=^K6 MFREE ADATA,CSTORE [FREE 512 WORD BLOCK
?24Q CALL 4 WRITB [WRITE BUCKET AWAY
?2JB MHUNTW 1,FILE,FRWB [MOVE IN CONSTANT DATA
?342 LDN 4 A1(1) [FOR FIRST BUCKET
?3HL SMO FX1
?43= LDN 3 XBUC1
?4GW MOVE 3 19
?52G FPCACA 3,2 [FIND REQUEST SLIP
?5G6 HUNT2 3,AOBRES,0
?5^Q LDX 0 A1+1(3)
?6FB STO 0 A1+13(1) [STORE PROGRAM NAME
?6^2 LDX 0 AWORK2(2)
?7DL SBN 0 1
?7Y= STO 0 A1+15(1) [STORE NUMBER OF BUCKETS
?8CW LDN 3 1
?8XG CALL 4 WRITB [WRITE BUCKET 1
?9C6 MFREE FILE,FRWB
?9WQ LDN 6 0
?=BB Y4 FPCACA 2,FX2
?=W2 HUNT2 3,APERI,APERIRES,2 [X3 -> PRB
??*L SMO 6
??T= LDX 4 A1(3) [GET 1ST/NEXT PRB ENTRY
?##W BNG 4 Y7 [J IF END
?#SG OUTPACK 4,1,PERINAME [PERIPHERAL NAME -> OUTPUT BLOCK
?*#6 MONOUT JSAVE [O/P NOT SAVED MESSAGE
?*RQ BDX 6 Y4 [UPDATE PTR & GO BACK
?B?B Y7 WORDFIN [TIDY UP
?BR2 Y8
?C=L CLOSE [AND
?CQ= ENDCOM [FINISH
?D9W VBIN
?DPG WORDFIN [SIGNAL END OF GETWORDS
?F96 CLOSE
?FNQ COMBRKIN
?G8B ZERR GEOERR 1,NOIMAGE [NO CORE IMAGE
?GN2 MENDAREA 30, K100SAVEDA
?H7L #END
^^^^ ...77504164000500000000