Trailing-Edge
-
PDP-10 Archives
-
decuslib20-03
-
decus/20-0078/util/spec.sim
There is 1 other file named spec.sim in the archive. Click here to see a list.
BEGIN
EXTERNAL REF (Infile) PROCEDURE findinfile;
EXTERNAL REF (Outfile) PROCEDURE findoutfile;
EXTERNAL TEXT PROCEDURE conc,upcase,frontstrip,rest,checkextension;
EXTERNAL INTEGER PROCEDURE arrlgd;
EXTERNAL PROCEDURE arrtxt;
EXTERNAL TEXT PROCEDURE front,scanto,getitem;
EXTERNAL INTEGER PROCEDURE maxint,search,splita,hash;
EXTERNAL PROCEDURE split;
EXTERNAL BOOLEAN PROCEDURE puttext;
EXTERNAL CHARACTER PROCEDURE fetchar,findtrigger;
EXTERNAL LONG REAL PROCEDURE scanreal;
EXTERNAL INTEGER PROCEDURE checkreal,checkint,scanint,ilog;
EXTERNAL BOOLEAN PROCEDURE menu;
EXTERNAL CLASS safeio,simdbm;
simdbm("spclog.tmp","english","",0,TRUE) BEGIN
REF (rspec) rs; REF (record) r;
TEXT ARRAY tset[1:5],rnamn[1:3],opa[1:41],ops[1:30];
TEXT ARRAY fields[1:200]; INTEGER ARRAY types[1:200];
TEXT key,cms,cm,t,tt,u,v,tstring,nstring,optext;
TEXT rname,delims,sizespec;
CHARACTER c;
INTEGER nr,nspecrec,olimit;
INTEGER dataloc,size,cnum,k,n,m,nfields,keypos,adim,base;
INTEGER startloc,ns,nplus;
INTEGER ARRAY sizes[1:8];
BOOLEAN edit,addspec,edt,setfails;
BOOLEAN PROCEDURE helpdelim;
BEGIN
outline("Give two numbers with space between them:");
outline("They are the ASCII codes (decimal) for two delimiters");
outline("used in the internal data base representation");
outline(
"Those characters may never occur in texts stored in the data base.");
outline("Recommended: 23 24");
outline("However, as default two printable characters \ and ]");
outline("Makes it easier to examine the internal representation");
outline("during test.");
outline("These characters are stored in the first record");
outline("of the data base, and may not be changed without reloading");
END helpdelim;
BOOLEAN PROCEDURE chelp;
BEGIN
outline("Command format: COMMAND,op1,op2,op3, ...");
outline(
"The following commands are available: (short forms in parenthesis)");
Outimage;
outline("NAME,recordname (N) Name of record type");
outline("KEY,keyfieldname (K) Name of key field");
outline("SIZE,nrec (S) Size of area reserved for records of this type"
);
outline("RECORD (REC) To store complete record definition in data base");
outline("EXIT (EX) To exit from SPEC program");
outline("SET,setname,owner,member To define a set");
outline("TYPE,field1,field2,field3, ...");
outline(" where type is either: INTEGER,REAL,TEXT,INTEGER ARRAY,");
outline(" REAL ARRAY or TEXT ARRAY. (Short forms: I,R,T,IA,RA,TA.");
outline("The fields occur in the record in the same order as the");
outline(" corresponding TYPE declarations are given to SPEC");
END;
PROCEDURE error1(t); VALUE t; TEXT t;
BEGIN outline(t); GOTO next; END;
BOOLEAN PROCEDURE check;
BEGIN ! subdivide command string, check if valid;
nr:=splita(cms,komma,opa,40); cm:-upcase(opa(1));
cnum:=loctext(cm,ops); IF cnum > 15 THEN cnum:=cnum-15;
check:=cnum > 0;
END check;
BOOLEAN PROCEDURE getspec;
BEGIN
IF rname == NOTEXT THEN getspec:=TRUE ELSE
BEGIN
r:-getrecordspec(rname); IF r == NONE THEN addspec:=TRUE;
END;
END;
PROCEDURE safestore(r); REF (record) r;
BEGIN
r.store;
IF \defined__f AND oflowtop >= olimit THEN
BEGIN ! allocate new space for overflow;
oflowtop:=dataloc;
dataloc:=olimit:=dataloc+20;
END;
END of safestore;
REF (record) PROCEDURE specrec(t1,t2,n3,n4,n5,n6,t7,t8);
TEXT t1,t2,t7,t8; INTEGER n3,n4,n5,n6;
BEGIN TEXT ARRAY ta[1:n__spa];
ta(1):-t1; ta(2):-t2; ta(7):-t7; ta(8):-t8;
ta(3):-intput(n3); ta(4):-intput(n4); ta(5):-intput(n5);
ta(6):-intput(n6);
specrec:-NEW record(spec__spec,ta);
END specrec;
PROCEDURE new_spec(sname,sparm,types);
VALUE sname,sparm,types;
TEXT sname,sparm,types;
BEGIN IF sizes(ns) > 0 THEN
BEGIN
INTEGER n,k; TEXT ARRAY ta[1:7];
REF (record) r;
n:=splita(sparm,komma,ta,7);
r:-specrec(sname,ta(1),olimit,sizes(ns),1,n,sparm,types);
olimit:=olimit+sizes(ns);
r.store;
END; ns:=ns+1;
END of new_spec;
BOOLEAN PROCEDURE scheck;
BEGIN INTEGER n,k; TEXT ARRAY ta[1:8];
n:=splita(sizespec,komma,ta,7);
FOR k:=1 STEP 1 UNTIL n DO
BEGIN
sizes(k):=scanint(ta(k));
IF sizes(k)<0 THEN GO TO fin;
END;
scheck:=TRUE;
fin:
IF sizes(1) < 16 THEN sizes(1):=16;
END of scheck;
PROCEDURE ccheck(t); TEXT t;
BEGIN
tset(k):-t; IF k = 2 OR k = 3 THEN
BEGIN
IF getrecordspec(t) == NONE THEN
BEGIN
Outtext("Record type not defined: "); outline(t);
setfails:=TRUE;
END
END;
END ccheck;
BOOLEAN PROCEDURE shelp;
BEGIN
outline("Give 7 numbers n1,n2,n3,n4,n5,n6,n7 where:");
outline("n1 = size of area for RSPEC");
outline("n2 = size of area for STRUKTUR");
outline("n3 = size of area for SETSPEC");
outline("n4 = size of area for INDEXFILE");
outline("n5 = size of area for TABLE");
outline("n6 = size of area for command procedures");
outline("n7 = size of area for help messages");
outline("n1 should always be > 15");
outline("n2 and n3 should be > 0 only when sets are to be used");
outline("n4 and n5 should be > 0 if the corresponding facilities");
outline("in the program FETCH are to be used.");
outline("n6 > 0 only when command procedures are used");
outline("in the programs FETCH or GEMIC.");
outline("n7 > 0 when the procedure HELPMESS is used to");
outline("issue help information for SAFEIO calls.");
END of shelp;
! START OF MAIN PROGRAM _______________________________;
newhash:=TRUE;
margin:=0; emptybase:=TRUE;
request("Data base file: ","tmp.tmp",textinput(tt,TRUE),"",nohelp);
t:-scanto(tt,ckomma); IF tt.More THEN newhash:=FALSE;
request("Image size: ","68",intinput(n,n>30),
"Must be > 30",nohelp);
IF n < 50 THEN nplus:=16; ! to ensure room for standard
record types;
openbase(t,n);
OPTIONS(/-W);
optext:-Copy("I,R,T,IA,RA,TA,N,K,S,REC,EX,SET,Z,Z,Z,"
"INTEGER,REAL,TEXT,INTEGER ARRAY,REAL ARRAY,"
"TEXT ARRAY,NAME,KEY,SIZE,RECORD,EXIT");
OPTIONS(/W);
n:=splita(optext,komma,ops,30);
IF defined__f THEN
BEGIN
request("Is an old file to be edited ?",
"yes",boolinput(edt),"?",help(
"If not , please exit and delete this file first"));
IF edt THEN GOTO next;
END;
d__file.Locate(1);
request("Delimiters ","92,93",textinput(delims,TRUE),"",
helpdelim);
t:-d__file.Image;
backslash:-Blanks(1); arrchar:-Blanks(1);
u:-scanto(delims,','); v:-rest(delims);
cback:=Char(scanint(u)); c:=Char(scanint(v));
backslash.Putchar(cback); arrchar.Putchar(c);
t.Sub(13,1):=backslash; t.Sub(14,1):=arrchar;
t.Sub(15,5).Putint(rlength);
IF newhash THEN t.Sub(20,1):=backslash;
d__file.Outimage;
request("System area sizes ","20,10,10,10,10,10,10",
textinput(sizespec,scheck),
"Give SIX positive numbers separated by commas",shelp);
displaydefault:=FALSE; oflowtop:=10;
olimit:=sizes(1)+2+nplus; ns:=2;
new_spec("INDEXFILE","NAMN,ANTAL,TYP,COND,REMARK,INDEX",
"3,1,3,3,3,4");
new_spec("SETSPEC","NAMN,OWNER,MEMBERS,REMARK","3,3,3,3");
new_spec("TABLE","NAMN,FIELDS,COLUMNS,SUMS,REMARK","3,3,3,3,3");
new_spec("STRUKTUR","NAMN,OSETS,MSETS","3,3,3");
new_spec("CPROC","NAMN,BODY,DESCR","3,3,3");
new_spec("HELPMESS","MNAME,MESS","3,3");
dataloc:=startloc:=olimit;
next:! ******* treat next command from user ****;
IF defined__f THEN dataloc:=oflowtop; displaydefault:=FALSE;
request("*","",textinput(cms,check),"Illegal keyword, try again.",
chelp);
IF cnum = 10 THEN GOTO build; IF cnum = 11 THEN GOTO fin;
IF cnum = 12 THEN
BEGIN
IF defined__f THEN
BEGIN ! store a record of type SETSPEC;
setfails:=FALSE;
FOR k:=1 STEP 1 UNTIL 4 DO ccheck(opa(k+1));
IF setfails THEN GOTO next;
r:-NEW record(getrecordspec("SETSPEC"),tset); r.store;
END ELSE outline("May not be used on initial creation !");
GOTO next;
END;
IF cnum < 7 THEN
BEGIN ! treat a type declaration ----------;
FOR k:=2 STEP 1 UNTIL nr DO
BEGIN
t:-opa(k); n:=loctext(t,fields);
IF n > 0 THEN types(n):=cnum ELSE
BEGIN
nfields:=nfields+1;
fields(nfields):-t; types(nfields):=cnum;
END;
END;
END ELSE rnamn(cnum-6):-opa(2);
IF cnum = 7 THEN
BEGIN
rs:-getrecordspec(rnamn(1));
IF rs =/= NONE THEN
BEGIN
IF nfields > 0 THEN
error1("OLd name. Try again with another name!");
rnamn(2):-rs.key; edit:=TRUE;
rnamn(3):-intput(rs.size);
nfields:=rs.adim;
FOR k:=1 STEP 1 UNTIL nfields DO
BEGIN
fields(k):-rs.anames(k); types(k):=rs.atypes(k);
END;
END;
END;
GOTO next;
build:
! make sure that NAMN,KEY and SIZE are defined properly;
FOR k:=1 STEP 1 UNTIL 3 DO
BEGIN
IF rnamn(k) == NOTEXT THEN
request(conc(ops(k+21),": "),"",textinput(rnamn(k),TRUE),"",nohelp);
END;
keypos:=loctext(rnamn(2),fields);
IF keypos = 0 THEN error1("Specify name of key");
size:=scanint(rnamn(3));
IF size <= 0 THEN error1("Size should be >= 0, Specify size!");
tstring:-intput(types(1)); nstring:-fields(1);
FOR k:=2 STEP 1 UNTIL nfields DO
BEGIN
t:-intput(types(k));
tstring:-conc(tstring,komma,t);
nstring:-conc(nstring,komma,fields(k));
END;
IF edit THEN k:=rs.base ELSE
BEGIN
k:=dataloc; dataloc:=dataloc+size;
IF edt THEN oflowtop:=dataloc;
END;
r:-specrec(rnamn(1),rnamn(2),k,size,keypos,nfields,nstring,tstring);
safestore(r);
outline("Record OK. Specify next record or type EX to finish.");
FOR k:=1 STEP 1 UNTIL nfields DO fields(k):-NOTEXT;
nfields:=0; edit:=FALSE;
FOR k:=1 STEP 1 UNTIL 3 DO rnamn(k):-NOTEXT;
GOTO next;
fin:
INSPECT d__file DO
BEGIN
! store current OFLOWTOP and GEN_KEY values in first line;
IF \defined__f THEN oflowtop:=dataloc;
Locate(1); Inimage; Locate(1);
Setpos(1); Outint(oflowtop,6);
Outint(gen_key,6);
Outimage;
END;
END;
END;