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

BEGIN
  EXTERNAL TEXT PROCEDURE conc,front,scanto,upcase,
  frontstrip,rest,getitem,request;
  EXTERNAL PROCEDURE split,arrtxt;
  EXTERNAL INTEGER PROCEDURE checkint,scanint,
  maxint,search,splita,hash,arrlgd;
  EXTERNAL CLASS dbmmin;
  dbmmin("",0,TRUE) BEGIN
    REF (Outfile) outf;
    REF (rspec) rtyp;
    INTEGER k,m,n,max; CHARACTER c;
    TEXT t,u,v,z,t1,t2,pname,cname,rname,outfname,outbuf;
    TEXT ARRAY ta1[1:20],ta2[1:4],attrib[1:20],fields[1:20];
    TEXT ARRAY assop[0:10],assfunc[0:10];
    INTEGER ARRAY atypes[0:20],parmloc[0:20];

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

    TEXT PROCEDURE help11;
    BEGIN
      outline("Example:  PROC1,OBJECTCLASS1,RECTYPE1");
      outline("          where");
      outline("          PROC1 is a boolean procedure to be called");
      outline("          when an object of class OBJECTCLASS1 is to be created"
      );
      outline("          using information from a record of type RECTYPE1");
      outline("  Answer with return if you want to finish.");
    END of help11;

    TEXT PROCEDURE help22;
    BEGIN
      outline("Give a sequence of items");
      outline(" separated with commas:   INAME=EXTNAME");
      outline(" where INAME is the internal attribute name and EXTNAME");
      outline(" is the name of a corresponding field in the external file");
      outline(" EXAMPLE:  INAME1=XNAME1,INAME2=XNAME2,INAME3=XNAME3");
    END of help22;

    ! __________     START OF MAIN PROGRAM     __________;

    assop(1):-assop(2):-Copy(":="); assop(3):-Copy(":-");
    assfunc(1):-Copy(").getint;");
    assfunc(2):-Copy(").getreal;");
    assfunc(3):-Copy(");");
    outbuf :- Blanks(80);
    askdb: request("Data base file: ","X",t,TRUE,"",NOTEXT);
    request("Image size: ","68",z,TRUE,"",NOTEXT);
    n:=scanint(z);
    openbase(t,n);
    IF \defined__f THEN
    BEGIN outline("Base undefined !"); GOTO askdb; END;
    request("Output file (without extension):","",
    outfname,TRUE,"",
    "file for generated source code, extension=SIM always");
    outf :- NEW Outfile(conc(outfname,".sim"));
    outf.Open(outbuf);
    INSPECT outf DO
    BEGIN
      PROCEDURE outline(t);VALUE t;  TEXT t;
      BEGIN Outtext(t); Outimage; END;

      next_record:


      request("Give procedure,class,record type:",NOTEXT,
      t1,TRUE,"?",help11);
      IF t1 == NOTEXT THEN GOTO fin;
      request("Give attributes and corresponding fields: ",
      NOTEXT,t2,TRUE,"?",help22);

      splita(t1,komma,ta1,20);
      pname:-ta1(1); cname:-ta1(2); rname:-ta1(3);
      rtyp:-getrecordspec(rname);
      IF rtyp == NONE THEN INSPECT Sysout DO
      BEGIN
	Outtext("Record type undefined !");
	Outimage;
	GOTO next_record;
      END;
      max:=splita(t2,komma,ta1,20);
      FOR k:=1 STEP 1 UNTIL max DO
      BEGIN ! build arrays of attribute names and field names;
	splita(ta1(k),Copy("="),ta2,4);
	attrib(k):-ta2(1); fields(k):-ta2(2);
	parmloc(k):=n:=loctext(fields(k),rtyp.anames);
	IF n = 0 THEN INSPECT Sysout DO
	BEGIN
	  Outtext("Undefined data field: ");
	  Outtext(ta2(2));Outimage;
	  n:=1; GOTO next_record;
	END;
	atypes(k):=rtyp.atypes(n);
	IF atypes(k) > 3 THEN INSPECT Sysout DO
	BEGIN
	  Outtext("Illegal type for field: ");
	  Outtext(fields(k));Outimage;
	  Outtext("Only integer, real and text can be treated by PREP2.");
	  Outimage;
	  GOTO next_record;
	END;
      END;

      ! write next generated procedure;

      Outimage;
      Outtext("boolean procedure "); Outtext(pname);
      outline("(key,obj);");
      Outtext("value key; text key; ref ("); Outtext(cname);
      outline(") obj;");
      outline("begin ref (record) r;");
      Outtext("r:-get(key,"""); Outtext(rname); outline(""");");
      outline("if r =/= none then INSPECT OBJ DO BEGIN");
      FOR k:=1 STEP 1 UNTIL max DO
      BEGIN ! create assignments to parameters;
	Outtext(attrib(k));
	Outtext(assop(atypes(k)));
	Outtext("r.avalues("); Outint(parmloc(k),2);
	outline(assfunc(atypes(k)));
      END;
      Outtext(pname); outline(":=true;");
      outline("END;");
      Outtext("end of "); Outtext(pname); outline(";");
      Outimage;
      GOTO next_record;

      fin:
    END of inspect outf;
    fin: eof: outf.Close;
  END;
END;