Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-03 - decus/20-0078/util/transf.sim
There is 1 other file named transf.sim in the archive. Click here to see a list.
BEGIN
  EXTERNAL REF(Infile)PROCEDURE findinfile;
  EXTERNAL INTEGER PROCEDURE splita,search,checkint;
  EXTERNAL PROCEDURE split;
  EXTERNAL TEXT PROCEDURE frontstrip,conc,from,upto,front,rest,upcase;
  EXTERNAL BOOLEAN PROCEDURE change;
  REF(Infile) inf;
  REF(Outfile) outf;
  TEXT filetxt,row,comtxt,slash;
  TEXT ARRAY filearr(1:4),ch_arr(1:5),tx(1:3);
  INTEGER ant,inrec,outrec,i;

  !---ampchange byter & till semikolon;
  TEXT PROCEDURE ampchange(t); VALUE t; TEXT t;
  BEGIN CHARACTER c;
    WHILE t.More DO
    BEGIN c:=t.Getchar;
      IF c='&' THEN
      BEGIN c:=';';
	t.Setpos(t.Pos-1);
	t.Putchar(c);
      END;
    END;
    ampchange:-t;
  END of ampchange;

  !---allchange byter alla f`rekomster av oldt till newt i master;
  PROCEDURE allchange(master,oldt,newt);
  NAME master; TEXT master,oldt,newt;
  BEGIN TEXT local;
    local:-master;
    WHILE local.More DO change(local,oldt,newt);
    master:-local;
  END of allchange;

  PROCEDURE write;
  INSPECT outf DO BEGIN Outtext(row);
    Outimage; outrec:=outrec+1;
  END of write;

  PROCEDURE wrongcom;
  BEGIN Outtext("Incorrect command at line ");
    Outint(inrec,6); Outtext(":"); Outimage;
    Outtext(Blanks(5));
    Outtext(row.Strip); Outimage;
  END;

  ! ------START OF MAIN---------------------------------;

  start:
  slash:-Copy("/");
  tx(1):-Copy("!. I");
  tx(2):-Copy("!. D");
  tx(3):-Copy("!. C");
  Outtext("GIVE infile,outfile,version: ");
  Breakoutimage;
  Inimage;
  filetxt:-upcase(Copy(Sysin.Image.Strip));
  ant:=splita(filetxt,Copy(","),filearr,4);
  filearr(1):-conc(filearr(1),".SIM");
  filearr(2):-conc(filearr(2),".SIM");
  inf:-findinfile(filearr(1));
  IF inf==NONE THEN
  BEGIN Outtext(filearr(1)); Outtext(" is not found.");
    Outimage;
    GO TO start;
  END;
  inf.Open(Blanks(120));
  outf:-NEW Outfile(filearr(2));
  outf.Open(Blanks(120));
  IF checkint(filearr(3))\=1 THEN
  BEGIN Outtext("Version not an integer."); Outimage;
    GO TO start;
  END ELSE
  FOR i:=1 STEP 1 UNTIL 3 DO
  tx(i).Sub(3,1):=filearr(3);

  INSPECT inf DO
  BEGIN Inimage; inrec:=inrec+1;
    WHILE NOT Endfile DO
    BEGIN

      !---delete l{ser poster utan att skriva p} nya filen t o m !.;
      PROCEDURE delete;
      l1:
      BEGIN Inimage;
	inrec:=inrec+1;
	IF frontstrip(Image.Strip)="!.;" THEN GO TO fin
	ELSE GO TO l1;
	fin:
      END of delete;

      !---insert skriver ut poster som ska l{ggas till i nya versionen;
      PROCEDURE insert;
      BEGIN CHARACTER a;
	l1:
	Inimage; inrec:=inrec+1;
	row:-Copy(Image.Strip);
	IF frontstrip(row)="!.;" THEN GO TO fin;
	row:-ampchange(row);
	write;
	GO TO l1;
	fin:
      END of insert;

      !---comcha {ndrar i raden efter ett changekommando om kommandot
      inneh}ller;
      !---tre "/";
      PROCEDURE comcha;
      BEGIN ant:=splita(row,slash,ch_arr,5);
	IF ant\=4 THEN
	BEGIN wrongcom;
	  GO TO fin;
	END;
	ch_arr(2):-ampchange(ch_arr(2));
	ch_arr(3):-ampchange(ch_arr(3));
	Inimage;
	inrec:=inrec+1;
	row:-Copy(Image);
	allchange(row,ch_arr(2),ch_arr(3));
	outf.Outtext(row);
	outf.Outimage;
	outrec:=outrec+1;
	fin:
      END of comcha;

      row:-frontstrip(Image.Strip);
      IF row.Length < 4 THEN
      BEGIN write;
	GO TO readfile;
      END;
      IF row.Sub(1,2) \= "!." THEN
      BEGIN write; GOTO readfile; END;
      !---I comtxt l{ggs de 4 f`rsta icke-blanka tecknen i posten;
      comtxt:-upcase(Copy(row.Sub(1,4)));
      IF comtxt=tx(1) THEN
      BEGIN insert;
	GO TO readfile;
      END;
      IF comtxt=tx(2) OR comtxt.Sub(1,2)="!."
      AND comtxt.Sub(4,1)="I" THEN
      BEGIN delete;
	GO TO readfile;
      END;
      IF comtxt=tx(3) THEN
      BEGIN comcha;
	GO TO readfile;
      END;
      !---I nedanst}ende block kollas om posten {r ett change- eller;
      !---delete-kommando f`r en annan {n `nskad version. H{r kollas ocks};
      !---slutkommandot f`r ovanst}ende fall. Mellanliggande satser skrivs;
      !---of`r{ndrade i den nya versionen. Om posten b`rjar med "!." och;
      !---ej {r n}got av ovanst}ende fall skrivs felutskrift med proce-;
      !---duren wrongcom. Insert-kommando f`r annan {n `nskad version;
      !---behandlas i delcheck och delete;
      IF checkint(comtxt.Sub(3,1))=1 THEN
      BEGIN IF comtxt.Sub(4,1)="C" OR
	comtxt.Sub(4,1)="D" THEN
	GO TO readfile;
      END ELSE
      IF row.Sub(3,1)\=";" THEN wrongcom;
      readfile:
      Inimage; inrec:=inrec+1;
    END;
  END;

  Outtext(filearr(1)); Outtext(" has ");
  Outint(inrec,6); Outtext(" records."); Outimage;
  Outtext(filearr(2)); Outtext(" has ");
  Outint(outrec,6); Outtext(" records."); Outimage;
  eof: inf.Close; outf.Close;
END;