Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-03 - decus/20-0078/libsim/simdbm.sim
There is 1 other file named simdbm.sim in the archive. Click here to see a list.
OPTIONS(/external);
!.1d;
EXTERNAL REF (Infile) PROCEDURE findinfile;
EXTERNAL REF (Outfile) PROCEDURE findoutfile;
EXTERNAL CHARACTER PROCEDURE fetchar,findtrigger;
EXTERNAL TEXT PROCEDURE checkextension;
EXTERNAL INTEGER PROCEDURE ilog,checkreal;
EXTERNAL LONG REAL PROCEDURE scanreal;
EXTERNAL BOOLEAN PROCEDURE menu,puttext;
!.;
EXTERNAL TEXT PROCEDURE conc,front,scanto,upcase,
frontstrip,rest,getitem;
EXTERNAL PROCEDURE arrtxt,split;
EXTERNAL INTEGER PROCEDURE checkint,scanint,
maxint,search,splita,hash,arrlgd;
!.1d;
EXTERNAL CLASS safeio;
!.;
!.1c /safeio CLASS simdbm/CLASS dbmmin/;
safeio CLASS simdbm(load_file,imsize,autoclose);
VALUE load_file; TEXT load_file; INTEGER imsize; BOOLEAN autoclose;
VIRTUAL: PROCEDURE delstruc;
BEGIN
  CHARACTER nullc,cback,ckomma,csemikolon;
  BOOLEAN defined__f,nameonly,readonly,break_do,statist;
  BOOLEAN emptybase,newhash;
  INTEGER k__,rlength;
  REF(Directfile) d__file;
  INTEGER n__spa,oflowtop,gen_key;
  INTEGER s_size,prev_syn,pstart,pst1,maxrsize;
  INTEGER nr_record,nr_get,nr_lookup;
  INTEGER nr_load,nr_store;
  TEXT last_d_image,store_buff,blank2,komma,undefined,t_;
  TEXT em,semikolon,arrchar,backslash,synpointer;
  TEXT ARRAY typtext[1:7],noargs[1:1];
  REF (rspec) r__spec,r__s,current_spec,spec__spec;
  REF (record) refr;
  REF (rspec) recordspec,rnext;
  CLASS ilist(num,next); INTEGER num; REF (ilist) next;;
  BOOLEAN wrprotect; REF (ilist) freelist;
  PROCEDURE delstruc(r); REF (record) r;;

  !.1c /BOOLEAN/TEXT/;
  BOOLEAN PROCEDURE helpmess(t); VALUE t; TEXT t;
  INSPECT get(t,"HELPMESS") DO BEGIN
    t:-avalues(2); WHILE t.More DO
    BEGIN Outtext(scanto(t,csemikolon)); Outimage; END;
  END helpmess;

  INTEGER PROCEDURE nextfree;
  IF freelist == NONE THEN
  BEGIN nextfree:=oflowtop; oflowtop:=oflowtop+1; END ELSE
  BEGIN
    nextfree:=freelist.num; freelist:-freelist.next;
  END nextfree;

  PROCEDURE outline2(t,u); VALUE t,u; TEXT t,u;
  BEGIN t:-conc(t,u); WHILE t.Length > Length DO
    BEGIN Outtext(t.Sub(1,Length));
    t:-t.Sub(Length+1,t.Length-Length); END;
    Outtext(t); Outimage;
  END OUTLINE2;

  INTEGER PROCEDURE dbadr(t,bsize,base); TEXT t;
  INTEGER bsize,base;
  !---------------------------------------------------------
  Computing of a pseudo-adress within a database-area.
  if newhash=true then a new and better hashing algorithm
  is used, but to access existing data bases the old (and
  very bad) algorithm is kept as default alternative.
  ---------------------------------------------------------;
  BEGIN INTEGER n;
    IF newhash THEN n:=hash(t,bsize) ELSE
    BEGIN
      t.Setpos(1); IF checkint(t) > 0 THEN n:=t.Getint ELSE
      BEGIN  WHILE t.More DO n:=n+Rank(t.Getchar); END;
      n:=Mod(n,bsize);
    END;
    dbadr:=n+base;
  END of dbadr;

  INTEGER PROCEDURE loctext(t,a); TEXT t; TEXT ARRAY a;
  !---------------------------------------------------------
  Locate text t in array a, if present return index
  for it otherwise return zero. a should be logically
  ended with an ELEMENT=NOTEXT.
  ---------------------------------------------------------;
  BEGIN INTEGER n;
    FOR n:= n+1 WHILE a(n) =/= NOTEXT DO
    IF t=a(n) THEN BEGIN loctext:=n; GOTO fin; END;
  fin:  END of loctext;

  CLASS record(spec,avalues);
  REF (rspec) spec; TEXT ARRAY avalues;
  !  ---------------------------------------------------
  spec	pointer to rspec object with specification for
  this record type
  avalues	text array with attribute values
  ---------------------------------------------------------;
  VIRTUAL: TEXT PROCEDURE getkey; REF (record) PROCEDURE load;
  PROCEDURE store;
  BEGIN  INTEGER dbskey;
    TEXT syn_;
    TEXT PROCEDURE getkey;
    getkey:-frontstrip(avalues(spec.keypos));
    REF (record) PROCEDURE load(t); VALUE t; TEXT t;
    !--------------------------------------------------------
    Load elements from text T to array AVALUES.
    Elements are either numbers or text between delimiters.
    Arrays become just a single textstring.
    --------------------------------------------------------;
    BEGIN INTEGER k,max;
      max:=spec.adim;
      BEGIN TEXT ARRAY avalues(1:max+1);
	FOR k:=k+1 WHILE t.More AND k <= max DO
	avalues(k):-scanto(t,cback);
	!.1d;
	IF spec.type2 =/= NOTEXT THEN
	BEGIN REF (record) r1,refrsave; INTEGER n1,n2;
	  refrsave:-refr;
	  n1:=getrecordspec(spec.type1).adim;
	  r1:-get(frontstrip(avalues(spec.keypos2)),spec.type2);
	  refr:-refrsave; IF r1 =/= NONE THEN
	  BEGIN
	    n2:=r1.spec.adim;
	    FOR k:=1 STEP 1 UNTIL n2 DO avalues(n1+k):-r1.avalues(k);
	  END;
	END;
	!.;
	load:-NEW record(spec,avalues);
      END;
    END of load;
    PROCEDURE store;
    !--------------------------------------------------------
    Put elements from AVALUES into one single text.
    Then use STORERECORD to store total record in database.
    --------------------------------------------------------;
    BEGIN TEXT s;
      dbskey:=lookup(getkey,spec);
      IF dbskey = 0 THEN GOTO fin;
      d__file.Locate(dbskey);
      store_buff:=NOTEXT;
      k__:=arrlgd(avalues);
      IF k__ <= store_buff.Length THEN s:-store_buff.Sub(1,k__)
      ELSE s:-Blanks(k__);
      arrtxt(avalues,s,cback);
      storerecord(synpointer,s);
      fin:
    END of store;
    syn_:-Blanks(s_size);
    nr_record:=nr_record+1;
  END of record;

  record CLASS rspec(rname,key,base,size,keypos,adim,anames,atypes);
  TEXT rname,key;
  INTEGER base,size,keypos,adim;
  TEXT ARRAY anames; INTEGER ARRAY atypes;
  !  -------------------------------------------------------
  rname       	name of record
  key      	key attribute
  base       	start location for primary data area
  size       	size of primary data area
  keypos	position of key among parameters
  adim       	number of attributes
  anames	text array containing all attribute names
  atypes	integer array with types:  1=integer, 2=real, 3=text
  -----------------------------------------------------------;
  BEGIN REF (record) prototype;
    TEXT type1,type2; INTEGER keypos2; REF (rspec) next;
    REF (rspec) PROCEDURE load(t); VALUE t; TEXT t;
    !--------------------------------------------------------
    t is total record. Its elements are loaded into the
    corresponding attributes of the RSPEC object.
    --------------------------------------------------------;
    BEGIN REF (rspec) r;
      INTEGER k,n,r_adim; TEXT ARRAY avalues[1:n__spa+1];
      k:=splita(t,backslash,avalues,n__spa); r_adim:=scanint(avalues(6));
      IF r_adim <= 0 THEN r_adim:=200;
      BEGIN
	TEXT ARRAY r_anames[1:r_adim+1]; INTEGER ARRAY r_atypes[1:r_adim+1];
	n:=splita(avalues(8),komma,r_anames,r_adim);
	FOR k:=1 STEP 1 UNTIL n DO r_atypes(k):=r_anames(k).Getint;
	n:=splita(avalues(7),komma,r_anames,r_adim);
	r:-NEW rspec(spec__spec,avalues,avalues(1),avalues(2),
	avalues(3).Getint,avalues(4).Getint,avalues(5).Getint,r_adim,
	r_anames,r_atypes);
      END;
      load:-r;
    END of load;
    rnext:-recordspec; recordspec:-THIS rspec;
    recordspec.next:-rnext;
  END of rspec;

  PROCEDURE doforeach(rtyp,treat); VALUE rtyp;
  !------------------------------------------------------
  Iteration procedure used to process all records of
  a particular type, calling an arbitrary procedure
  TREAT for each record.
  ------------------------------------------------------;
  TEXT rtyp; PROCEDURE treat;
  BEGIN REF (rspec) r; INTEGER k,n,max; TEXT u;
    REF (record) p; REF (ilist) s1;
    REF (ilist) PROCEDURE merge(n,y); INTEGER n; REF (ilist) y;
    IF y == NONE THEN merge:-NEW ilist(n,NONE) ELSE
    IF n<=y.num THEN merge:-NEW ilist(n,y) ELSE
    BEGIN merge:-y;
      l1: IF y.next == NONE THEN y.next:-NEW ilist(n,NONE) ELSE
      IF n <= y.next.num THEN y.next:-NEW ilist(n,y.next) ELSE
      BEGIN y:-y.next; GOTO l1; END;
    END MERGE;

    break_do:=FALSE;
    r:-getrecordspec(rtyp); IF r == NONE THEN
    BEGIN
      outline2("ERROR: doforeach, record type undefined ",rtyp);
      GOTO fin;
    END;
    max:=r.base+r.size-1;
    FOR k:=r.base STEP 1 UNTIL max DO
    BEGIN
      refr:-r.prototype;
      n:=k; p:-getrec(n);
      IF p =/= NONE THEN
      BEGIN
	treat(p); refr:-r.prototype; IF break_do THEN GOTO fin;
	u:-p.syn_; IF u \= undefined THEN s1:-merge(u.Getint,s1);
      END;
    END;
    WHILE s1 =/= NONE DO
    BEGIN
      p:-getrec(s1.num); s1:-s1.next;
      IF p =/= NONE THEN
      BEGIN
	treat(p); refr:-r.prototype; IF break_do THEN GOTO fin;
	k:=scanint(p.syn_); IF k > 0 THEN s1:-merge(k,s1);
      END;
    END;
    fin:
  END of doforeach;

  REF (record) PROCEDURE getrec(rgetpos);
  NAME rgetpos; INTEGER rgetpos;
  !-----------------------------------------------------
  rgetpos is location for a record which is read as a
  whole and interpreted by the LOAD procedure of the
  record refr.
  NONE is returned if the record is empty or has been
  marked as deleted.
  -----------------------------------------------------;
  BEGIN TEXT link,s; REF(record) r;
    d__file.Locate(rgetpos); IF \d__file.Endfile THEN
    BEGIN
      gr1: d__file.Inimage;
      s:-d__file.Image.Strip; IF s.Length < pstart THEN GOTO fin;
      link:-Copy(s.Sub(pstart-s_size,s_size));
      IF s.Sub(1,1) = "+" THEN
      BEGIN ! record has been deleted;
	prev_syn:=rgetpos; rgetpos:=link.Getint;
	d__file.Locate(rgetpos); GOTO gr1;
      END;
      IF s.Sub(1,1) = "-" THEN GOTO fin;
      IF s.Sub(1,1).Getchar = nullc THEN GOTO fin;
      IF s.Length < rlength THEN last_d_image:-s:-
      s.Sub(pstart,s.Length-pst1) ELSE
      s:-loadrecord(s);
      r:-refr.load(s);
      INSPECT r DO BEGIN r.syn_:-link; r.dbskey:=rgetpos; END;
      getrec:-r;
    END;
    fin:
  END of getrec;

  REF (record) PROCEDURE get(rkey,rtype);
  VALUE rkey,rtype; TEXT rkey,rtype;
  !----------------------------------------------------
  Load a record with given key and type.
  Compute pseudo-adress, see if key is same as
  searched, if not follow chain of synonym records
  until found, or if not found return NONE.
  ----------------------------------------------------;
  BEGIN REF(record) r; TEXT u; INTEGER n;
    nr_get:=nr_get+1;
    prev_syn:=0;
    r__s:-IF r__spec == NONE THEN getrecordspec(rtype) ELSE r__spec;
    IF r__s == NONE THEN
    outline2("ERROR: undefined record type: ",rtype) ELSE
    BEGIN
      refr:-r__s.prototype;
      n:=dbadr(rkey,r__s.size,r__s.base);
    END;
    nextsym: r:-getrec(n);
    IF r == NONE THEN GOTO fin;
    r.dbskey:=n;
    IF rkey = r.getkey THEN BEGIN get:-r; GOTO fin; END;
    u:-r.syn_;
    IF u = undefined THEN get:-NONE ELSE
    BEGIN prev_syn:=n; n:=u.Getint; GOTO nextsym; END;
    fin:
  END of get;

  INTEGER PROCEDURE lookup(t,rtype); TEXT t;
  REF (rspec) rtype;
  !-----------------------------------------------------
  When a record is to be stored this procedure is called
  to compute a location for it.
  Analoguous to GET, but if record is NOT found a
  location to an empty place is returned as value,
  if found the location for the previous record
  is returned.
  -----------------------------------------------------;
  BEGIN INTEGER n; REF (record) r; TEXT u;
    PROCEDURE tail(n); INTEGER n;
    BEGIN TEXT u; INTEGER k;
      d__file.Locate(n); d__file.Inimage; u:-d__file.Image;
      IF u.Sub(u.Length,1) = ":" THEN
      BEGIN
	k:=u.Sub(u.Length-10,6).Getint;
	freelist:-NEW ilist(k,freelist); tail(k);
      END;
    END tail;
    nr_lookup:=nr_lookup+1;
    synpointer:=NOTEXT;
    refr:-rtype.prototype;
    n:=dbadr(t,rtype.size,rtype.base);
    nextsym: r:-getrec(n);
    IF r == NONE THEN BEGIN lookup:=n; GOTO fin; END;
    IF t = r.getkey THEN
    BEGIN COMMENT overwrite previous record;
      IF wrprotect THEN
      BEGIN outline2("Can't overwrite record: ",t); GOTO fin; END;
      IF last_d_image.Length > rlength THEN tail(n);
      synpointer.Sub(3,s_size):=r.syn_;
      lookup:=n; GOTO fin;
    END;
    u:-r.syn_; IF u = undefined THEN
    BEGIN COMMENT create one more overflow record;
      ! modify synonym pointer ;
      INTEGER newloc;
      INSPECT d__file DO
      BEGIN
	Locate(n); Inimage;
	newloc:=nextfree; r.syn_.Putint(newloc);
	Image.Sub(pstart-s_size,s_size):=r.syn_;
	Locate(n); Outimage; lookup:=newloc;
      END;
    END ELSE
    BEGIN n:=u.Getint; GOTO nextsym; END;
    fin:
  END of lookup;

  PROCEDURE defaultparms;
  !-----------------------------------------------------
  Set defaultparameters(internal for system). Create
  an RSPEC describing a recordspecification which is
  needed to load the other recordspecifications from
  file.
  -----------------------------------------------------;
  BEGIN
    INTEGER k; TEXT t,u;
    TEXT ARRAY attrarr[1:12]; INTEGER ARRAY typarr[1:12];
    komma:-Copy(","); ckomma:=','; blank2:-Copy("  ");
    semikolon:-Copy(";"); csemikolon:=';'; em:-Copy("/*");
    !.1d;
    t:-Copy("INTEGER,REAL,TEXT,INTEGER ARRAY,REAL ARRAY,TEXT ARRAY");
    splita(t,komma,typtext,6);
    !.;
    pstart:=8; pst1:=7; s_size:=5;
    synpointer:-Blanks(pst1);
    undefined:-Blanks(s_size);
    t:-Copy("RNAME,KEY,BASE,SIZE,KEYPOS,ADIM,ANAMES,ATYPES");
    n__spa:=splita(t,t.Sub(6,1),attrarr,12);
    u:-Copy("33111164 ");
    FOR k:=1 STEP 1 UNTIL n__spa DO typarr(k):=u.Sub(k,1).Getint;
    spec__spec:-NEW rspec(NONE,attrarr,Copy("RSPEC"),
    Copy("RNAME"),2,8,1,n__spa,attrarr,typarr);
    spec__spec.spec:-spec__spec;
    spec__spec.prototype:-spec__spec;
  END of defaultparms;

  REF (rspec) PROCEDURE getrecordspec(rcname); VALUE rcname; TEXT rcname;
  !-----------------------------------------------------
  Locate RSPEC object with name RCNAME in array
  RECORDSPEC where all such objects are stored
  when the system is initialized.
  -----------------------------------------------------;
  BEGIN
    rnext:-recordspec; WHILE rnext =/= NONE DO
    BEGIN
      IF rcname = rnext.rname THEN
      BEGIN getrecordspec:-rnext; GOTO fin; END;
      rnext:-rnext.next;
    END;
    fin:
  END of getrecordspec;

  TEXT PROCEDURE loadrecord(t); TEXT t;
  !----------------------------------------------------
  t is first part (image) of external record if there
  are continuations, load these recursively until
  finally the entire logical external record is returned
  as value.
  The global variable LAST_D_IMAGE is also set to
  point on this record.
  ----------------------------------------------------;
  BEGIN     TEXT tx;
    nr_load:=nr_load+1;
    IF t.Length < rlength THEN
    last_d_image:-t.Sub(pstart,t.Length-pst1).Strip ELSE
    BEGIN
      tx:-t.Sub(t.Length-10,6);
      d__file.Locate(tx.Getint);
      tx:-Copy(t.Sub(pstart,t.Length-pstart-10));
      d__file.Inimage;
      last_d_image:-conc(tx,loadrecord(d__file.Image.Strip));
    END;
    loadrecord:-last_d_image;
  END of loadrecord;

  PROCEDURE storerecord(f,t); TEXT f,t;
  !-----------------------------------------------------
  File D is located to where an external logical
  record is to start.
  Write it , and if needed write continuation records
  (recursively) in overflowarea and link
  them together.
  A continuation pointer is a number stored at the end
  of the image, and the last character is then set to ':'.
  -------------------------------------------------------;
  BEGIN INTEGER n,m,newloc; TEXT tx;
    INSPECT d__file DO
    BEGIN
      nr_store:=nr_store+1;
      Image.Sub(1,pst1):=f;
      m:=Image.Length-pst1; t:-t.Strip; n:=t.Length;
      IF n >= m THEN
      BEGIN
	newloc:=nextfree;
	Image.Sub(Image.Length-10,11):="          :";
	Image.Sub(Image.Length-10,6).Putint(newloc);
	m:=m-11;
	tx:-t.Sub(1,m);
      END ELSE tx:-t;
      Image.Sub(pstart,m):=tx; Outimage;
      IF n >= m THEN
      BEGIN
	Locate(newloc);
	storerecord(blank2,t.Sub(m+1,n-m));
      END;
    END;
  END of storerecord;

  PROCEDURE delete(r); REF (record) r;
  INSPECT r DO
  BEGIN INTEGER psave;
    psave:=prev_syn; delstruc(r); prev_syn:=psave;
    INSPECT d__file DO
    BEGIN
      IF prev_syn > 0 THEN
      BEGIN ! modify SYN pointer to point to next record;
	Locate(prev_syn); Inimage;
	IF syn_ = undefined AND Image.Sub(1,1) = "+" THEN Image:=em ELSE
	Image.Sub(pstart-s_size,s_size):=syn_;
	Locate(prev_syn); Outimage;
	freelist:-NEW ilist(dbskey,freelist);
      END ELSE
      BEGIN ! mark primary record as deleted;
	Locate(dbskey); Inimage;
	IF syn_ = undefined THEN Image:=em ELSE
	Image.Sub(1,1):="+";
	Locate(dbskey); Outimage;
      END;
    END;
  END delete;

  PROCEDURE loadspec;
  !------------------------------------------------------
  Read OFLOWTOP and GEN_KEY from first image of data base.
  Make sure that OFLOWTOP points to top of file.
  Load all record-specifications.
  They are automatically saved in array RECORDSPEC
  when an RSPEC object is created (See above class RSPEC,
  its procedure LOAD and its class body).
  ------------------------------------------------------;
  BEGIN REF (record) r; INTEGER k; TEXT t,u; BOOLEAN again;
    PROCEDURE spec_in(r); REF (rspec) r;
    r.prototype:-NEW record(r,r.anames);
    INSPECT d__file DO
    BEGIN
      Locate(1); Inimage;
      oflowtop:=Inint; gen_key:=Inint;
      t:-Image; backslash:-Copy(t.Sub(13,1));
      arrchar:-Copy(t.Sub(14,1)); cback:=t.Sub(13,1).Getchar;
      newhash:=t.Sub(20,1) = backslash;
      u:-t.Sub(15,5); k:=scanint(u);
      IF k > 0 AND k \= rlength THEN
      BEGIN ! wrong imagesize was given;
	Close;
	defined__f:=FALSE; rlength:=k; GOTO fin;
      END;
      gen_key:=gen_key+100//100*101; ! increment to next multiple of 100;
      k:=oflowtop;
      ! make sure that proper top of file is known;
      WHILE \Endfile AND Image.Strip \= em DO
      BEGIN Locate(k); Inimage; k:=k+1; END;
      IF k > oflowtop THEN oflowtop:=k-1;
    END;
    recordspec:-spec__spec;
    doforeach("RSPEC",spec_in);
    !.1d;
    ! create specifications of concatenated records;
    l1: again:=FALSE;
    rnext:-recordspec; WHILE rnext =/= NONE DO
    BEGIN REF (rspec) rs,rs1,rs2,rs3; INTEGER j,n1,n2;
      TEXT ARRAY tx[1:4];
      REF (rspec) PROCEDURE getrspec(t); TEXT t;
      BEGIN rs3:- getrecordspec(t); IF rs3 == NONE THEN
	BEGIN
	  outline2("Bad secondary rec. spec. Missing type: ",t);
	  GOTO fin;
	END ELSE getrspec:-rs3;
      END;
      rs:-rnext; IF rs.base <= 0 THEN
      BEGIN
	n1:=splita(rs.key,komma,tx,4); rs1:-getrspec(tx(1));
	rs2:-getrspec(tx(2));
	IF rs1.base <= 0 OR rs2.base <= 0 THEN again:=TRUE ELSE
	BEGIN
	  rs.keypos2:=IF n1 > 2 THEN loctext(tx(3),rs1.anames) ELSE rs1.keypos;
	  rs.keypos:=rs1.keypos;
	  rs.type1:-rs1.rname; rs.type2:-rs2.rname;
	  rs.base:=rs1.base; rs.size:=rs1.size;
	  n1:=rs1.adim; n2:=rs2.adim; rs.adim:=n1+n2;
	  u:-conc(rs2.rname,Copy("."));
	  FOR j:=1 STEP 1 UNTIL n1 DO
	  BEGIN
	    rs.anames(j):-rs1.anames(j); rs.atypes(j):=rs1.atypes(j);
	  END;
	  FOR j:=1 STEP 1 UNTIL n2 DO
	  BEGIN
	    rs.anames(n1+j):-conc(u,rs2.anames(j));
	    rs.atypes(n1+j):=rs2.atypes(j);
	  END;
	END;
      END;
      rnext:-rnext.next;
    END;
    IF again THEN GOTO l1;
    !.;
    fin:
  END of loadspec;

  PROCEDURE put_record(rtyp,r); REF (rspec) rtyp; TEXT r;
  !-------------------------------------------------------
  Store text R as an external record of type RTYP.
  Produce its key, compute its location and store by
  calling STORERECORD.
  -------------------------------------------------------;
  INSPECT rtyp DO BEGIN
    TEXT ARRAY ta[1:rtyp.adim+1]; INTEGER k;
    k:=splita(r,backslash,ta,rtyp.adim)+1; IF k < rtyp.adim THEN
    outline2("Put_record: bad record !",NOTEXT) ELSE
    BEGIN
      k:=lookup(ta(rtyp.keypos),rtyp);
      IF k = 0 THEN GOTO fin; d__file.Locate(k);
      storerecord(synpointer,r);
    END;
    fin:
  END of put_record;

  INTEGER PROCEDURE next_key;
  BEGIN ! produce next unique number;
    gen_key:=gen_key+1; next_key:=gen_key;
  END of next_key;

  PROCEDURE closebase;
  !-------------------------------------------------------
  Update first image which contains pointer to current
  top of file and current number for generated data
  base keys.
  Close file, print statistics over calls to the most
  frequent internal procedures.
  -------------------------------------------------------;
  BEGIN INTEGER n; REF (record) r;
    INSPECT d__file DO
    BEGIN
      IF \readonly THEN BEGIN
	Locate(1); Inimage;
	n:=Image.Sub(1,6).Getint;
	IF n < oflowtop THEN
	BEGIN
	  Image.Sub(1,6).Putint(oflowtop);
	  Image.Sub(7,6).Putint(gen_key); ! save current unique number;
	  Locate(1); Outimage;
	END;
      END;
      Setpos(1); Close;
    END;
    IF statist THEN BEGIN
      Outint(nr_record,5);
      Outint(nr_get,5); Outint(nr_lookup,5);
      Outint(nr_load,5); Outint(nr_store,5);
      Outimage;
    END;
  END of closebase;
  !.1d;

  BOOLEAN PROCEDURE display_records;
  BEGIN ! at ? or help display record types available;
    outline2("the following record types are defined:",NOTEXT); Outimage;
    rnext:-recordspec; WHILE rnext =/= NONE DO
    BEGIN
      Setpos(5); outline2(rnext.rname,NOTEXT);
      Setpos(15); outline2("attributes: ",rnext.avalues(7));
      rnext:-rnext.next;
    END;
  END of display;

  BOOLEAN PROCEDURE disp_types;
  BEGIN ! display parameters and their types for record type r;
    INTEGER k,adim;
    outline2("ATTRIBUTES AVAILABLE: ",NOTEXT); Outimage;
    adim:=current_spec.adim;
    FOR k:= 1 STEP 1 UNTIL adim DO
    BEGIN
      Setpos(10);
      outline2(conc(typtext(current_spec.atypes(k)),blank2),
      current_spec.anames(k));
    END;
  END of disp_types;

  PROCEDURE tabulate(r); REF (record) r;
  !------------------------------------------------------
  Type for record r either its key or all datafields
  with names and values.
  ------------------------------------------------------;
  IF r =/= NONE THEN BEGIN
    IF nameonly THEN
    outline2(r.avalues(r.spec.keypos),NOTEXT) ELSE
    BEGIN INTEGER max,k;
      Outtext("------------  ");
      outline2(r.spec.rname,"  ----------------------------");
      max:=r.spec.adim;
      FOR k:=1 STEP 1 UNTIL max DO
      BEGIN
	Outtext(r.spec.anames(k));
	IF Pos < 9 THEN Setpos(9);
	outline2(" = ",r.avalues(k));
      END;
    END;
  END of tabulate;
  !.;

  PROCEDURE openbase(load_file,imsize);
  VALUE load_file; TEXT load_file; INTEGER imsize;
  IF load_file =/= NOTEXT THEN
  BEGIN
    l1: t_:-Blanks(4); t_.Putint(imsize); t_:-frontstrip(t_);
    d__file:-NEW Directfile(conc(load_file,Copy("/i:"),t_));
    rlength:=imsize;
    maxrsize:=rlength+100; store_buff:-Blanks(maxrsize);
    d__file.Open(Blanks(rlength));
    INSPECT d__file DO
    BEGIN ! check if it is an initialized SIMDBM file;
      Locate(1); IF \Endfile THEN
      BEGIN Inimage; defined__f:=Image.Strip.Length > 13; END;
    END;
    IF defined__f THEN
    BEGIN loadspec; IF \defined__f THEN
      BEGIN imsize:=rlength; GOTO l1; END;
    END;
    IF \defined__f AND \emptybase THEN d__file.Close;
  END openbase;

  !--------------------------------------------------------
  Initiate data base file:
  set default parameters and define internal structures,
  open data base file
  if it is an old database load all record-specifications.
  --------------------------------------------------------;

  defaultparms;
  openbase(load_file,imsize);
  INNER;
  IF autoclose AND d__file.Image =/= NOTEXT THEN closebase;

END of class dbm;