Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-05 - 43,50337/21/load.sim
There is 1 other file named load.sim in the archive. Click here to see a list.
BEGIN
  EXTERNAL TEXT PROCEDURE conc,front,scanto,upcase,
  frontstrip,rest,getitem,request;
  EXTERNAL LONG REAL PROCEDURE scanreal;
  EXTERNAL PROCEDURE split,arrtxt;
  EXTERNAL INTEGER PROCEDURE checkreal,checkint,scanint,
  maxint,search,splita,hash,arrlgd;
  EXTERNAL CLASS dbmmin;
  dbmmin ("",68,TRUE) BEGIN
    INTEGER k,n,l,max,smax,npost,typen;
    TEXT t,u,xx,ltt,tzero;
    BOOLEAN typ2;
    REF (record) r; REF (rspec) rtyp;
    REF (Infile) inf;
    TEXT ARRAY opa[0:6],fixtext[0:30];
    REF (fspec) ARRAY specif[0:140];

    TEXT PROCEDURE intput(n); INTEGER n;
    BEGIN xx.Putint(n); intput:-frontstrip(xx); END;

    CLASS fspec(anummer,fieldpos,fieldlength,fieldtype,special);
    INTEGER anummer,fieldpos,fieldlength,fieldtype,special;;

    PROCEDURE outline(t); VALUE t; TEXT t;
    BEGIN Outtext(t); Outimage; END;

    TEXT PROCEDURE help2;
    BEGIN
      outline("Specify data fields.");
      outline("Format of specification:"); Outimage;
      outline("pos,length"); Outimage;
      outline("pos = start position for field on input");
      outline("length = length of field on input");
    END;

    ! START OF MAIN  ________________________________________;

    xx:-Blanks(15); tzero:-Copy("0");
    top:
    request("Data base: ","",t,TRUE,"","");
    openbase(t,imsize);
    IF \defined__f THEN
    BEGIN outline("Undefined base !"); GOTO top; END;

    request("input file: ","",t,TRUE,"","");
    inf:- NEW Infile(t.Strip);
    request("image size: ","80",ltt,TRUE,"","");
    l:=ltt.Getint;
    inf.Open(Blanks(l));
    getrect: request("record type: ","",t,TRUE,"","");
    rtyp:-getrecordspec(t.Strip);
    IF rtyp == NONE THEN
    BEGIN
      outline("Record type not in data base !");
      GOTO getrect;
    END;
    current_spec:-rtyp;

    nextspec:
    outline("Give STARTPOS,LENGTH  for each field !");
    n:=rtyp.adim;
    FOR k:=1 STEP 1 UNTIL n DO
    BEGIN
      u:-conc(rtyp.anames(k)," :");
      omt:
      request(u,"",t,TRUE,"",help2);
      l:=splita(t,komma,opa,3);
      IF l<2 THEN
      BEGIN outline("too few arguments."); GOTO omt; END;
      smax:=smax+1;
      specif(smax):-NEW fspec(k,opa(1).Getint,
      opa(2).Getint,rtyp.atypes(k),0);
    END;
    endspec:

    nextrec:

    inf.Inimage; IF inf.Endfile THEN GOTO finish;
    BEGIN TEXT ARRAY rval[1:rtyp.adim];
      n:=rtyp.adim;
      FOR k:=1 STEP 1 UNTIL n DO
      IF rtyp.atypes(k) = 1 THEN rval(k):-tzero ELSE
      rval(k):-Copy(" ");
      npost:=npost+1;
      IF Mod(npost,50) = 0 THEN
      BEGIN
	Outtext("Antal lagrade poster = ");
	Outint(npost,4); Outimage;
      END;
      r:-NEW record(rtyp,rval);
      FOR k:=1 STEP 1 UNTIL smax DO
      BEGIN
	INSPECT specif(k) DO
	BEGIN
	  IF fieldpos = 0 THEN t:-tzero ELSE
	  IF fieldpos = -1 THEN t:-intput(npost) ELSE
	  BEGIN
	    IF inf.Image.Sub(fieldpos,fieldlength) = " "
	    THEN t:-NOTEXT ELSE
	    t:-inf.Image.Sub(fieldpos,fieldlength).Strip;
	    IF fieldtype = 1 THEN
	    BEGIN ! check that it really is numeric field;
	      t:-frontstrip(t);
	      IF checkint(t) < 0 THEN
	      BEGIN
		outline("Illegal numeric field !");
		outline(inf.Image);
		Outtext("Field nr: "); Outint(k,3); Outimage; GOTO nextrec;
	      END ELSE IF t == NOTEXT THEN t:-tzero
	      ELSE t:-intput(t.Getint);
	    END;
	    IF t == NOTEXT THEN
	    BEGIN IF fieldtype = 3 THEN t:-Copy(" ") ELSE t:-tzero; END;
	  END;
	  rval(anummer):-Copy(t);
	END;
      END;
      r.store;
      GOTO nextrec;
    END;

    finish:

    Outtext("Antal poster = "); Outint(npost,5);
    Outimage;
    inf.Close;
  END;
END;