Trailing-Edge
-
PDP-10 Archives
-
decuslib10-05
-
43,50337/21/dbdump.sim
There is 1 other file named dbdump.sim in the archive. Click here to see a list.
BEGIN
EXTERNAL TEXT PROCEDURE conc,front,scanto,upcase,
frontstrip,rest,getitem,inline;
EXTERNAL PROCEDURE split,arrtxt;
EXTERNAL INTEGER PROCEDURE checkint,scanint,
maxint,search,splita,hash,arrlgd;
EXTERNAL CLASS dbmmin;
dbmmin ("",0,TRUE) BEGIN
REF (rspec) rtyp; REF (Outfile) utf;
TEXT rtypes,fname,t; TEXT ARRAY tnarr[1:20];
INTEGER nr,k,m,n,nrec,nfields,k1,linelgd;
PROCEDURE seqwfile(r); REF (record) r;
INSPECT utf DO
BEGIN
nrec:=nrec+1;
IF last_d_image.Length > linelgd THEN
BEGIN
Sysout.Outtext("Too long line: ");
Sysout.Outint(nrec,7); Sysout.Outimage; GOTO eof;
END ELSE
BEGIN Outtext(last_d_image); Outimage; END;
END;
! ------------ start of main -------------------------;
t:-inline("Data base file: ",Sysin);
openbase(t,68);
fname:-inline("Output file:",Sysin);
linelgd:=inline("Line length for output:",Sysin).Getint;
utf:-NEW Outfile(fname);
utf.Open(Blanks(linelgd));
utf.Outtext(backslash); utf.Outimage;
next:
rtypes:-inline("Record types: ",Sysin);
IF rtypes == NOTEXT OR rtypes = em THEN GOTO fin;
nr:=splita(rtypes,Copy(","),tnarr,20);
FOR k:=1 STEP 1 UNTIL nr DO
BEGIN
INSPECT utf DO
BEGIN
t:-tnarr(k); rtyp:-r__spec:-getrecordspec(t);
IF rtyp == NONE THEN
BEGIN
Sysout.Outtext("Undefined: "); Sysout.Outtext(t);
Sysout.Outimage;
GOTO next;
END;
nfields:=rtyp.adim;
Outtext("!!!"); Outtext(t); Outimage;
doforeach(t,seqwfile);
INSPECT Sysout DO
BEGIN
Outtext(t); Setpos(20);
Outint(nrec,5); Outimage; nrec:=0;
END;
END;
END;
nr:=0; GOTO next;
fin: eof: utf.Close;
END;
END main;