Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-05 - 43,50337/21/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;