Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-05 - 43,50337/21/storeu.sim
There is 1 other file named storeu.sim in the archive. Click here to see a list.
00100	OPTIONS(/l/s:"libsim[13,255]");
00200	OPTIONS(/l/s:"libsim[13,134]");
00300	OPTIONS(/l/s:"libsim[13,201]");
00400	BEGIN
00500	EXTERNAL REF (Infile) PROCEDURE findinfile;
00600	EXTERNAL REF (Outfile) PROCEDURE findoutfile;
00700	EXTERNAL TEXT PROCEDURE conc,upcase,frontstrip,rest,checkextension;
00800	EXTERNAL CHARACTER PROCEDURE fetchar,findtrigger;
00900	EXTERNAL LONG REAL PROCEDURE scanreal;
01000	EXTERNAL INTEGER PROCEDURE checkreal,checkint,scanint,ilog;
01100	EXTERNAL BOOLEAN PROCEDURE menu;
01200	  EXTERNAL CLASS store;
01300	  EXTERNAL CLASS safeio;
01400	  INTEGER initial_storebase, virtual_memory; BOOLEAN debug;
01500	  initial_storebase:= 8; virtual_memory:= 0;
01600	
01700	
01800	  INSPECT NEW safeio(NOTEXT,"English") DO
01900	  INSPECT NEW store(virtual_memory, initial_storebase) DO
02000	  BEGIN
02100	    TEXT filename, action, key, message;
02200	    BOOLEAN stop, put, dir;
02300	
02400	   procedure keyprocessor(key, location);
02500	   text key; integer location;
02600	   textout(key);
02700	
02800	    PROCEDURE textout(t); VALUE t; TEXT t;
02900	    IF t =/= NOTEXT THEN
03000	    BEGIN
03100	      TEXT oldimage; CHARACTER c;
03200	      c:= t.sub(1,1).getchar;
03300	      IF c < ' ' OR c > '}' THEN
03400	      BEGIN
03500	        Outint(Rank(c),5); Outimage;
03600	      END;
03700	      oldimage:- Sysout.Image;
03800	      Sysout.Image:- t; Outimage;
03900	      Sysout.Image:- oldimage;
04000	    END;
04100	
04200	    BOOLEAN PROCEDURE actionhelp;
04300	    BEGIN
04400	      Outtext("PUT = store message under key in store,"); Outimage;
04500	      Outtext("GET = get message under key from store,"); Outimage;
04600	      Outtext("REPLACE = store message and replace previous message");
04700	      Outimage; Outtext(" with the same key,"); Outimage;
04800	      Outtext("DIRECT = list all keys in the store,"); Outimage;
04900	      Outtext("STOP = stop the execution and close the store file.");
05000	      Outimage;
05100	    END;
05200	
05300	    BOOLEAN PROCEDURE allowed_action;
05400	    BEGIN
05500	      allowed_action:= TRUE; dir:= FALSE;
05600	      action:- upcase(action);
05700	      IF action = "DIRECT" OR action = "DI" OR action = "D" THEN
05800	      dir:= TRUE ELSE
05900	      IF action = "PUT" OR action = "PU" OR action = "P"
06000	      THEN
06100	      BEGIN
06200	        put:= TRUE; remove:= FALSE;
06300	      END ELSE
06400	      IF action = "R" OR action = "RE" OR action = "REP" OR action = "REPLACE"
06500	      THEN
06600	      BEGIN put:= TRUE; remove:= TRUE;
06700	      END ELSE
06800	      IF action = "GET" OR action = "GE" OR action = "G"
06900	      THEN put:= FALSE ELSE
07000	      IF action = "STOP" OR action = "STO" OR action = "ST" OR action = "S"
07100	      THEN stop:= TRUE ELSE
07200	      allowed_action:= FALSE;
07300	    END;
07400	
07500	    margin:= 38;
07600	    Sysin.Image:- blanks(1000); Sysout.Image:- Blanks(1000);
07700	    request("Give filename without extension of direct access file: ",
07800	    "storeu",textinput(filename,true),
07900	     "Should be 1-6 letters or digits.",nohelp);
08000	    Open(filename);
08100	    ask_user_for_action:
08200	    request("Put, Replace, Get, Direct or Stop? ",nodefault,
08300	    textinput(action,allowed_action),
08400	    "Answer one of the four commands only.",
08500	    actionhelp);
08600	    IF NOT stop THEN
08700	    BEGIN
08800	      IF dir THEN direct(keyprocessor) ELSE
08900	      BEGIN
09000	        request("Give storage key: ",nodefault,
09100	        textinput(key, key.length >= 0),
09200	        "Key must be non-empty.",
09300	        nohelp);
09400	        key:- upcase(key);
09500	        IF put THEN
09600	        BEGIN
09700	          request("Input text to be stored: ",NOTEXT,
09800	          textinput(message,
09900	          message.length >= 0),
10000	          "Message must be non-empty.",
10100	          nohelp);
10200	        IF message.sub(message.length,1).getchar = '~' THEN
10300	        BEGIN
10400	          CHARACTER c;
10500	          message.setpos(1);
10600	          IF checkint(message) >= 0 AND checkint(message) >= 0 THEN
10700	          BEGIN
10800	            message.setpos(1); c:= char(message.getint);
10900	            message:- blanks(rest(message).getint);
11000	            WHILE message.more DO message.putchar(c);
11100	          END;
11200	        END;
11300	          IF debug THEN
11400	          BEGIN COMMENT debug;
11500	            INTEGER i, size;
11600	            size:= message.Getint;
11700	            message:- Blanks(size);
11800	            WHILE message.More DO
11900	            BEGIN i:= i+1;
12000	              IF Mod(i,
12100	              81) NE 0 THEN message.Putchar('_') ELSE message.Putchar('*');;
12200	              IF Mod(i,10)=0 THEN message.Sub(message.Pos-5,5).Putint(i);
12300	            END;
12400	            IF size < 129 THEN message.Sub(1,1).Putchar(Char(size-1));
12500	          END;
12600	          IF putmessage(key,message) THEN
12700	          Outtext("MESSAGE HAS BEEN STORED") ELSE
12800	          Outtext("KEY ALREADY HAS A VALUE OR MESSAGE TOO LONG");
12900	          Outimage;
13000	        END ELSE
13100	        BEGIN COMMENT get;
13200	          Outtext("MESSAGE RETRIEVED: "); Outimage;
13300	
13400	          textout(getmessage(key));
13500	        END;
13600	      END;
13700	      GO TO ask_user_for_action;
13800	    END;
13900	
14000	    Close;
14100	    recordclose; WHILE currentitem.file =/= SYSIN DO
14200	    currentitem.down;
14300	  END of inspect of safeio;
14400	END;