(George Source)
Macros used: CLOSE, COMBRKIN, ENDCOM, FPCACA, GEOERR, GETWORD, GETWORDX, HUNT2, MENDAREA, MFREE, MHUNT, MHUNTW, MONOUT, NAME, OUTPACK, SCANPT, SEGENTRY, SETNCORE, SWAPOUT, TESTREP2, TESTRPN2, TRACE, VFREEW, WORDFIN, 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