Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

OPTIONS(/external);
EXTERNAL TEXT PROCEDURE conc,front,scanto,upcase,
frontstrip,rest,getitem;
EXTERNAL PROCEDURE arrtxt,split;
EXTERNAL INTEGER PROCEDURE checkint,scanint,
maxint,search,splita,hash,arrlgd;
CLASS dbmmin(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;;

  TEXT 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("/*");
    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);
    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;

  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;