head     1.1;
access   ;
symbols  ;
locks    ; strict;
comment  @# @;


1.1
date     89.03.08.10.59.21;  author quist;  state Exp;
branches ;
next     ;


desc
@Stream builder for coverage testing
@



1.1
log
@Initial revision
@
text
@$MODCAL$
{ STREAM BUILDER }
PROGRAM SBUILDER(INPUT,OUTPUT);
IMPORT CI;
TYPE
  string16      = string[16];
VAR
  libout        : text;
  stream_out    : text;
  inline        : string[255];
  done          : boolean;
  I,J,K         : integer;
  file_name     : string16;
  modulename    : string16;
  first         : boolean;
  c             : char;
  clrstats      : char;
  
  procedure getname(p:integer; var name : string);
    var
      done      : boolean;
      nlen,plen : integer;
    begin
      name := '';
      nlen := 0;
      plen := strlen(inline);
      done := p>plen;
      while not done do
      begin
        if inline[p]=' ' then done := true
        else
        begin
          nlen := nlen + 1;
          setstrlen(name,nlen);
          name[nlen] := inline[p];
          p := p + 1;
          done := p>plen;
        end;
      end;
    end; { getname }
  
  function getmodulename(var modulename : string):boolean;
    var
      done,
      ok         : boolean;
      i          : integer;
    begin
      ok   := false;
      done := eof(libout);
      while not done do
      begin
        readln(libout,inline);
        inline := strltrim(strrtrim(inline));
        if strlen(inline)>0 then
        begin
          i := strpos(' ',inline);
          if i>0 then
          begin
            getname(i+1,modulename);
            ok := strlen(modulename)>0;
          end;
        end;
        done := ok or eof(libout);
      end;
      getmodulename := ok;
    end; { getmodulename }
  
BEGIN
  writeln('STREAM BUILDER  V 1.1 24/FEB/89');
  reset(libout,'JUNKL.TEXT');
  rewrite(stream_out,'JUNKS.TEXT');
  write('Clear stats (Y/N) ? '); read(clrstats);
  writeln;
  { find the name of the file under test }
  done := false;
  while (not eof(libout)) and (not done) do
  begin
    readln(libout,inline);
    done := strpos('FILE DIRECTORY OF:',inline)> 0;
  end;
  if not done then escape(1);
  i := strpos('''',inline);
  getname(i,file_name);
  file_name := str(file_name,2,strlen(file_name)-2);
  
  writeln(stream_out,'* BUILD STREAM FOR TESTING ',file_name);
  { already produced are listing file & code file }
  { need to process the modules then link them back together}
  first := true;
  while getmodulename(modulename) do
  begin
    writeln(stream_out,'lpJUNK1.TEXT');
    writeln(stream_out,'i',file_name);
    writeln(stream_out,'m',modulename);
    writeln(stream_out,'utdecq');
    
    writeln(stream_out,'xSCANLIST');
    writeln(stream_out,'JUNK1.TEXT');
    if first and
       (clrstats = 'y')
       then write(stream_out,'y')
       else write(stream_out,'n');
    writeln(stream_out,'yJUNKN.TEXT');
    
    writeln(stream_out,'xOPTIMIZER');
    writeln(stream_out,'JUNKN.TEXT');
    writeln(stream_out,'JUNK1.TEXT');
    writeln(stream_out,'n');
    
    writeln(stream_out,'aJUNK1.TEXT');
    writeln(stream_out,'n');
    writeln(stream_out);
    
    writeln(stream_out,'loJUNK2.CODE');
    if not first then
    begin
      writeln(stream_out,'iJUNK2.CODE');
      writeln(stream_out,'a');
    end;
    writeln(stream_out,'iJUNK1.CODE');
    writeln(stream_out,'akq');
    first := false;
  end;
  
  writeln(stream_out,'fcJUNK2.CODE');
  writeln(stream_out,file_name);
  writeln(stream_out,'rJUNK1.TEXT');
  writeln(stream_out,'rJUNK1.CODE');
  writeln(stream_out,'rJUNKN.TEXT');
  writeln(stream_out,'rJUNKL.TEXT');
  writeln(stream_out,'rJUNKS.TEXT');
  writeln(stream_out,'q');
  close(stream_out,'SAVE');
  write('STREAM THE FILE NOW ? '); read(c);
  writeln;
  if c='Y' then startstream('JUNKS.TEXT');
END.
@
