OPTIONS(/E);
COMMENT this program was originally written by Jacob Palme,
Swedish National Defense Research Institute, Stockholm, Sweden, 
in 1975;
COMMENT this file was made by Mike Soul, Institut fuehr Informatik
Hamburg, Western Germany, Oct 1976.

This file has been altered from the original STORE as supplied as follows:-

Identifier changes: "recently_used" to "last_use_of"
		"length_of_new_storeunit" to "nextlength"
		"keylength_of_newstoreunit" to "nextkeylength"

		"storebase"	deleted (not used)
		"lastvirtual"		"

layout and logic tidied up in procedures:-
	direct	(side effect on global storeimage removed)
	storefile_inimage
	open
	close
	putmessage
	getmessage
	putinstore
	lookup		(completely rewritten)

procedures deleted or transferred out of class STORE:-
	upcase (transferred)
	putsafe
	getsafe
	sixlettersordigits
	letterordigit (transferred)

My layout conventions are:-
 1) indent steps of 4 spaces,
 2) in general the key words IF, ELSE, FOR, WHILE introduce indented
blocks, BEGINs are ignored.  ELSE has an extra indent of 1 space over
the corresponding initial IF.  END is aligned with the key word starting
the block (IF, FOR, WHILE) or ignored with ELSE.

;

comment ***** MACHINE DEPENDENCIES *****
	This program assumes that 
     i) a disk file block holds 640 characters, and therefore 638
	significant characters plus cr-lf. The first 8 characters are
	used to store tree pointers, leaving 630 for messages. A
	computer with a different block size may well require all these
	constants to be changed.
    ii) In lookup there is a text value assignment between overlapping
	texts, whose result is undefined. If the instruction is compiled
	as copying from the front of the source text it will work.
;

comment variables and their use:

INTEGER virtual_size = size of virtual_memory in core blocks of 128 words, parameter of Store
INTEGER initial_memory = start size of direct_access file in core blocks,
    should not be too small or runs may become costly, parameter of Store

TEXT ARRAY virtual_memory = each element points to a disk block kept
    in core to minimise disk accesses.
INTEGER ARRAY virtual_location = disk address (location) of block in
    corresponding virtual_memory.
INTEGER ARRAY last_use_of = no of last access of this disk block, used
    to remove least recently used from virtual memory when new block
    is to be entered there.
TEXT oldfilename = previous file name when opening and closing several times.
TEXT storeimage = part of input image from DA file not yet scanned.
INTEGER hashvalue = computed from key by procedure lookup.
INTEGER location = disk address of block to be written or read to disk.
INTEGER keylength = length of key, computed in Putmessage, Getmessage and Delete.
INTEGER nextlength = length of storeunit being scanned while reading
    disk DA file.
INTEGER placelocation = location (disk address) of disk block where
    there is space enough to start to insert new message.
INTEGER placelocval = locval for the placelocation location.
INTEGER locval = hashvalue divided to get left-right decision in binary
    tree on disk.
INTEGER freeline = last written disk block in DA file plus 1.
INTEGER newlocation = next location in binary tree on disk.
INTEGER iocount = index number of virtual disk accesses.
INTEGER least_recently_used = index of least recently used virtual memory block.
BOOLEAN longmessage = true if a message too long to fit into one disk block
    is being stored.
BOOLEAN longmessfound = true when retrieving a message longer than
    one disk block.
BOOLEAN emptyline = nothing was written in last block read from disk.
BOOLEAN remove = if true previous messages with same key are removed
    to put in new messages.
BOOLEAN removing = in the act of such removing.
BOOLEAN getting = in the act of getting message through getmessage.
BOOLEAN left = go to left in binary tree on disk.

end of variable name comment;


CLASS store(virtual_size, initial_memory);
INTEGER virtual_size, initial_memory;
BEGIN
  REF(Directfile) storefile;
  TEXT ARRAY virtual_memory[0:virtual_size];
  INTEGER ARRAY virtual_location[0:virtual_size], last_use_of[0:virtual_size];
  TEXT oldfilename, storeimage;
  INTEGER hashvalue, location, keylength, nextlength, placelocation,
	placelocval, locval, freeline, newlocation, iocount, least_recently_used;
  BOOLEAN longmessage, longmessfound, emptyline, remove, removing,
	getting, left;
  CHARACTER altmode, carriagereturn, tab;


  PROCEDURE direct(keyprocessor);
  COMMENT to list all keys in the direct access file and apply the
  procedure keyprocessor to each key. Keys are listed through linear
  search of DA file. If multi-block long message, key is listed when the
  last block with message is read. *** WARNING keyprocessor must not
  change the values of global variables used by direct i.e. location
  (for example with keyprocessor = getmessage);
  PROCEDURE keyprocessor;
  BEGIN TEXT key, storeimage;
  INTEGER nextkeylength, nextlength;
    Location:= 1; storefile.Locate(Location);					!first block;
    WHILE NOT storefile.Endfile DO BEGIN
	storefile_inimage;							!get a block;
	IF NOT emptyline THEN BEGIN
	    storeimage:- Copy(storefile.Image.Sub(9,630));			!message part of block;
	    WHILE (IF storeimage.Length <= 8 THEN FALSE
		    ELSE storeimage.Sub(1,5) NE "     ") DO BEGIN
		nextkeylength:= storeimage.Sub(6,3).Getint;			!get lengths of unit;
		nextlength:= storeimage.Sub(1,5).Getint;
		IF nextkeylength > 0
		  AND storeimage.Length >= nextlength THEN BEGIN		!if unit doesn't overflow block;
		    key:- storeimage.Sub(9,nextkeylength);
		    keyprocessor(key,Location)
		END;
		IF storeimage.Length > nextlength + 8 THEN			!if room for another unit;
		    storeimage:- storeimage.Sub(nextlength+1,storeimage.Length-nextlength)	!move pointer;
		 ELSE storeimage:- NOTEXT;					!otherwise exit;
	    END
	END;
	Location:= Location+1;
    END;
  END of direct;

  PROCEDURE storefile_inimage;
  COMMENT will input the (location) disk block from disk. If however,
  the image is in the virtual_memory, it is input from this and not
  from disk. When a disk block is not in the virtual_memory,
  a least_recently_used block in the virtual memory is first output
  on disk to get space in the virtual memory for the new input block.
  Note that storefile_image and virtual_memory[n] are both references
  to the same object (Blanks(638)) and side-effect each other;
  BEGIN INTEGER virtloop;
    iocount:= iocount+1;
    storefile.Locate(Location);
    FOR virtloop:= 0 STEP 1 UNTIL virtual_size DO
	IF Location = virtual_location[virtloop] THEN BEGIN
	    storefile.Image:- virtual_memory[virtloop];
	    last_use_of[virtloop]:= iocount;
	    GOTO located;
	END;
    COMMENT not in virtual memory, so get from file;
    least_recently_used:= 0;
    FOR virtloop:= 1 STEP 1 UNTIL virtual_size DO
	IF last_use_of[virtloop] < last_use_of[least_recently_used] THEN
	    least_recently_used:= virtloop;
    last_use_of[least_recently_used]:= iocount;
    storefile.Image:- virtual_memory[least_recently_used];
    IF virtual_location[least_recently_used] > 0 AND
	    storefile.Image.Sub(1,2) NE "/*" THEN BEGIN
	COMMENT something stored in this block;
	storefile.Locate(virtual_location[least_recently_used]);
	storefile.Outimage;
	storefile.Locate(Location)
    END;
    IF storefile.Endfile THEN storefile.Image:= "/*"
     ELSE storefile.Inimage;
    virtual_location[least_recently_used]:= Location;
  located:
    emptyline:= storefile.Image.Sub(1,2) = "/*";
  END of storefile_inimage;

  PROCEDURE Open(filename);
  COMMENT will open the direct access file. The size of the hash table
  (initial_store_size) is read from the file if the file is old. The size
  of the file (freeline) is also read from the file, but this is checked
  to see that there really is nothing more in the file past freeline.
  This data is found in a special empty message with no key always in
  block 1 of the DA file;
  VALUE filename; TEXT filename;
  BEGIN TEXT extendedfilename; INTEGER virtloop;
    extendedfilename:- Blanks(filename.Length+4);
    extendedfilename:= filename;
    extendedfilename.Sub(filename.Length+1,4):= ".DAF";
    IF filename NE oldfilename THEN BEGIN
	storefile:- NEW Directfile(extendedfilename);
	oldfilename:- Copy(filename);
	IF oldfilename NE NOTEXT THEN
	    FOR virtloop:= 0 STEP 1 UNTIL virtual_size DO BEGIN
		virtual_memory[virtloop]:- Blanks(638);
		last_use_of[virtloop] := virtual_location[virtloop] := 0
	    END
    END;
    storefile.Open(virtual_memory[0]);
    Location:= 1; storefile_inimage;
    IF emptyline THEN BEGIN COMMENT new file;
	IF initial_memory < 1 THEN initial_memory:= 1
	 ELSE IF initial_memory > 1400 THEN initial_memory:= 1400;
	storefile.Outtext("   0   0   18  0");
	storefile.Image.Sub(17,5).Putint(initial_memory);
	freeline:= initial_memory+1;
	storefile.Image.Sub(22,5).Putint(freeline)
	END
     ELSE BEGIN COMMENT old file;
	initial_memory:= storefile.Image.Sub(17,5).Getint;
	freeline:= storefile.Image.Sub(22,5).Getint;
	Location:= freeline;
	storefile_inimage;
	WHILE NOT storefile.Endfile DO BEGIN
	    Location:= Location+1; storefile_inimage;
	    IF NOT emptyline THEN freeline:= Location+1
	END;
	Location:= 1; storefile_inimage;
	storefile.Image.Sub(22,5).Putint(freeline)
    END of old file
  END of open;

  PROCEDURE Close;
  COMMENT the DA file is closed. Important is to output all virtual
  storage disk blocks, since new info in them would otherwise be lost;
  BEGIN INTEGER virtloop;
    Location:= 1; storefile_inimage;
    storefile.Image.Sub(22,5).Putint(freeline);
    COMMENT if the above action is not done because the file is closed
    by the operating system, nothing will go wrong and the next open
    will scan for the true freeline;
    FOR virtloop:= 0 STEP 1 UNTIL virtual_size DO
	IF virtual_location[virtloop] > 0
	  AND virtual_memory[virtloop].Sub(1,2) NE "/*" THEN BEGIN
	    storefile.Locate(virtual_location[virtloop]);
	    storefile.Image:- virtual_memory[virtloop];
	    storefile.Outimage
	END;
    storefile.Close
  END;

  PROCEDURE delete(key);
  TEXT key;
  BEGIN TEXT empty;
  COMMENT deletes a key and associated message from the directfile;
    removing := TRUE; getting := FALSE;
    placelocation := 0;
    keylength := key.Length;
    lookup(key,empty)
  END of delete;


  BOOLEAN PROCEDURE putmessage(key,message);
  COMMENT the user routine to put messages into the DA file;
  TEXT key, message;
  BEGIN TEXT storeunit;
    removing:= remove; getting:= FALSE; keylength:= key.Length;
    putmessage:= TRUE;
    storeunit:- Blanks(keylength+message.Length+8);
    IF storeunit.Length > 99999 OR keylength > 400 OR keylength = 0 THEN
	putmessage:= FALSE
     ELSE BEGIN
	longmessage:= storeunit.Length > 630;
	storeunit.Sub(1,5).Putint(storeunit.Length);
	storeunit.Sub(6,3).Putint(keylength);
	storeunit.Sub(9,keylength):= key;
	storeunit.Sub(9+keylength,message.Length):= message;
	placelocation:= 0;
	IF lookup(key, storeunit) AND NOT removing THEN putmessage:= FALSE
	 ELSE putinstore(storeunit)
    END
  END of putmessage;

  TEXT PROCEDURE getmessage(key);
  COMMENT the user routine to get messages from the DA file;
  TEXT key;
  BEGIN TEXT storeunit;
    removing:= FALSE; getting:= TRUE;
    keylength:= key.Length;
    placelocation:= -1;
    IF keylength > 0 AND keylength <= 400 THEN BEGIN
	IF lookup(key, storeunit) THEN
	    getmessage:- Copy(storeunit.Sub(keylength+9,
					storeunit.Length-keylength-8))
    END
  END of getmessage;

  PROCEDURE putinstore(storeunit);
  COMMENT internal routine to put a whole storeunit, that is lengths plus key plus message, into the da file. MUST first call
  LOOKUP to see if the message is already there, and calculate hash value. Finds an empty place to put it in if LOOKUP has not
  already found such a place. Long messages are put into several blocks succeeding each other in the binary tree on disk, possibly
  with the beginning in the hash table. Note all long messages MUST start at the beginning of a block;
  TEXT storeunit;
  BEGIN COMMENT find block in table or tree;
    IF placelocation <= 0 THEN BEGIN						!entered direct from put;
	Location:= Mod(hashvalue,initial_memory)+1;
	locval:= hashvalue//initial_memory END
     ELSE BEGIN
      Location:= placelocation; locval:= placelocval				!assigned a value by lookup;
    END;

  try_another_line:
    storefile_inimage; storeimage:- storefile.Image.Sub(9,630);			!get message part of block;
    IF emptyline THEN storefile.Image.Sub(1,8):= "   0   0"
     ELSE
	WHILE (IF storeimage.Length <= 8 THEN FALSE
		 ELSE storeimage.Sub(1,5) NE "     ") DO BEGIN
	    nextlength:= storeimage.Sub(1,5).Getint;
	    storeimage:- IF nextlength >= storeimage.Length-8 THEN NOTEXT	!no room for more in this block;
			 ELSE storeimage.Sub(nextlength+1,
				storeimage.Length-nextlength);			!step on one more storeunit;
    END;
    IF storeimage.Length < storeunit.Length THEN BEGIN				!no room for unit in this block;
	IF longmessage AND storeimage.Length = 630 THEN BEGIN			!only split long messages;
	    storeimage:= storeunit.Sub(1,630);					!copy first part;
	    storeunit.Sub(1,5).Putint(storeunit.Length-630+8+keylength);	!change total length;
	    storeunit.Sub(630-keylength-7,8+keylength):=
			storeunit.Sub(1,8+keylength);				!overwrite part of message with header;
	    storeunit:- storeunit.Sub(630-keylength-7,
			storeunit.Length-630+keylength+8);			!move up the pointer;
	END;
	left:= Mod(locval,2)=0; locval:= locval//2;				!either way have no room in current block;
	newlocation:=storefile.Image.Sub((IF left THEN 1 ELSE 5),4).Getint;	!find location of next block in tree;
	IF newlocation = 0 THEN BEGIN						!sprout a branch;
	    newlocation:= freeline; freeline:= freeline+1;
	    storefile.Image.Sub((IF left THEN 1 ELSE 5),4).Putint(newlocation);
	END;
	Location:= newlocation;
	GO TO try_another_line;							!try inserting the message in the next block;
	END
     ELSE storeimage.Sub(1,storeunit.Length):= storeunit;			!the unit fits in the current block;
  END of putinstore;

  BOOLEAN PROCEDURE lookup(key, transfer_storeunit);
  COMMENT this procedure looks in the direct access data base to find a certain key given as argument. Search order is first
  hashing, if not there then binary tree as described in main documentation of this program. This procedure requires keylength to
  have been assigned to, and must be used before putinstore to calculate the hashvalue. WARNING  this procedure deletes any message
  under key when removing is true. Split messages MUST start at the beginning of a block, otherwise a preceding (short) message
  could be deleted and the long message would get moved up the block and the end of the block filled with blanks behind it. These
  blanks would be taken as part of the message(without changing the length) and so destroy the whole format;

  NAME transfer_storeunit;
  TEXT key, transfer_storeunit;
  BEGIN INTEGER nextkeylength, newpiecelength;
  TEXT storeunit, tailstoreunit;
    longmessfound:= FALSE;
    storeunit:- transfer_storeunit;
    key.Setpos(1);
    hashvalue:= 1 + 7 * keylength + 11 * Rank(key.Getchar) +			! 1 + 7*length + 11*firstch + lastch + 5*middlech;
		Rank(key.Sub(keylength,1).Getchar) +
		5 * (IF keylength > 2 THEN Rank(key.Sub(keylength//2+1,1).Getchar) ELSE 0);
    Location:= 1 + Mod(hashvalue,initial_memory);
    locval:= hashvalue//initial_memory;

    storefile_inimage;
    storeimage:- storefile.Image.Sub(9,630);					!get the relevant block;

    WHILE storeimage.Sub(1,5) NE NOTEXT AND NOT emptyline DO BEGIN
	WHILE (IF storeimage.Length <= 8 THEN FALSE
		ELSE storeimage.Sub(1,5) NE "     ") DO BEGIN			!whilst still data in this block;
	    nextlength:= storeimage.Sub(1,5).Getint;
	    nextkeylength:= storeimage.Sub(6,3).Getint;
	    IF nextkeylength = keylength THEN BEGIN				!key lengths match;
		IF storeimage.Sub(9,keylength)=key THEN BEGIN			!keys match;
		    lookup:= TRUE;
		    IF NOT (getting OR removing) THEN GOTO return_from_lookup;	!cannot put if key already there;
		    IF nextlength <= storeimage.Length THEN BEGIN		!message is all in this block;
			IF removing THEN BEGIN					!overwrite the unit with the rest;
			    storeimage:= storeimage.Sub(1+nextlength,		!***according to handbook this is unpredictable***;
						storeimage.Length-nextlength);
			    nextlength:= 0					!force to continue search past rest of block;
			    END of removing
			 ELSE BEGIN						!getting short unit or end of long;
			    IF longmessfound THEN				!copy end of message into tailstoreunit;
				tailstoreunit:= storeimage.Sub(9+keylength, tailstoreunit.Length)
			     ELSE storeunit:- storeimage.Sub(1,nextlength);	!return short unit;
			    GOTO return_from_lookup
			    END of getting
			END of non overflow
		     ELSE BEGIN							!unit continues in another block;
			IF removing THEN storeimage:= NOTEXT			!overwrite with blanks;
			 ELSE IF longmessfound THEN BEGIN			!middle piece of long unit;
			    newpiecelength:= storeimage.Length-8-keylength;
			    tailstoreunit.Sub(1,newpiecelength):=
				storeimage.Sub(9+keylength,newpiecelength);	!copy into tailstoreunit;
			    tailstoreunit :- tailstoreunit.sub(newpiecelength+1,
					tailstoreunit.length-newpiecelength)	!move pointer up;
			    END of middle piece
			 ELSE BEGIN						!start of a long unit;
			    longmessfound:= TRUE;
			    storeunit:- Blanks(nextlength);			!make text to hold unit;
			    storeunit.Sub(1,storeimage.Length):= storeimage;	!copy in first part;
			    tailstoreunit :- storeunit.sub(storeimage.Length+1,
						nextlength-storeimage.Length)	!remember pointer to rest;
			END of long message
		    END of overflow
		END of right key
	    END of right keylength;

	    IF storeimage.Length > nextlength + 8 THEN				!if room for another unit, move up pointer;
		storeimage:- storeimage.Sub(nextlength+1,
				storeimage.Length-nextlength)
	     ELSE IF storeimage.sub(1,5) NE "     " THEN storeimage:- NOTEXT;	!otherwise exit from loop;
										!if putting, storeimage is now blanks anyway;
	END of loop through storeimage for one location;

	IF placelocation = 0 THEN BEGIN						!putting or removing and just entered;
	    IF storeimage.Length >= storeunit.Length OR				!message fits in remainder of block;
		(longmessage AND storeimage.Length = 630) THEN BEGIN		!starting a long message in an empty block;
		placelocation:= Location; placelocval:= locval			!remember starting block;
	    END
	END;
	left:= Mod(locval,2)=0;
	newlocation:= storefile.Image.Sub((IF left THEN 1 ELSE 5),4).Getint;	!get next block in tree;
	IF newlocation = 0 THEN GOTO return_from_lookup;			!since there's no branch, can't be more message;
	locval:= locval//2;
	Location:= newlocation;
	storefile_inimage; storeimage:- storefile.Image.Sub(9,630);		!get next block and repeat;
    END of loop through locations;

  return_from_lookup:
    IF NOT removing THEN transfer_storeunit:- storeunit;
  END of lookup;

  carriagereturn:= Char(13); tab:= Char(9); altmode:= Char(27);

END of class store;