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;