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;