Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-03 - decus/20-0078/util/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;