  program reference (input,output,mcr,mapfile,rfile,cfile,reffile);

  (*         PROGRAM TO READ THE TASK BUILDER GLOBAL CROSS REFERENCE MAP
   AND GENERATE THE INVERSE (IE. REFERENCE MAP).
   *)

CONST

  createdby='CREATED BY';
  b6='      ';
  delimiter='-';

TYPE

  linetype=PACKED ARRAY [1..132] OF char;
  stringtype=PACKED ARRAY [1..6] OF char;
  keytype=PACKED ARRAY [1..10] OF char;
  nametype=PACKED ARRAY [1..30] OF char;

VAR

  separator:linetype;
  inname,outname:nametype;
  line:linetype;
  title,string0,string1,string2:stringtype;
  keystring:keytype;
  mapfile,rfile,cfile,reffile,mcr,atdot:text;
  okay,done,crefflag,refflag,spoolflag,sysflag,treeflag,delflag,odlflag:boolean;
  pagecount,linecount,lindex,index,i,count:integer;
  formfeed:char;


  PROCEDURE suspnd;FORTRAN;

  PROCEDURE spwnit;FORTRAN;

  PROCEDURE countline(VAR lindex:integer);

  CONST

    b1=' ';

   BEGIN
     lindex:=133;

      REPEAT

       lindex:=lindex - 1;

      UNTIL line[lindex]<>b1;

   END;




  PROCEDURE detach;FORTRAN;



  PROCEDURE getinput;

  VAR

    i,j:integer;
    status:boolean;

   BEGIN

     crefflag:=true;
     refflag:=true;
     spoolflag:=false;
     sysflag:=false;
     treeflag:=false;
     delflag:=true;
     odlflag:=false;
     writeln('Global Reference Program    V1.0');
     write('*');
     readln(line);
     i:=1;
     WHILE line[i]<>'=' DO
      BEGIN
	outname[i]:=line[i];
	i:=i + 1;
      END;
     i:=i + 1;
     j:=1;
     WHILE (  (line[i]<>' ') AND (line[i]<>'/')  ) DO
      BEGIN
	inname[j]:=line[i];
	i:=i + 1;
	j:=j + 1;
      END;
     WHILE line[i]='/' DO
      BEGIN
	i:=i + 1;
	status:=true;
	IF line[i]='-'
	 THEN
	  BEGIN
	    i:=i + 1;
	    status:=false;
	  END;
	IF line[i] IN ['C','D','R','S','$','T','O']
	 THEN
	 CASE line[i] OF
	   'C':crefflag:=true AND status;
	   'D':delflag:=true AND status;
	   'R':refflag:=true AND status;
	   '$':sysflag:=true AND status;
	   'S':spoolflag:=true AND status;
	   'T':treeflag:=true AND status;
	   'O':odlflag:=true AND status;
	  END
	 ELSE
	  BEGIN
	    writeln('INVALID SWITCH : ',line[i],' . [C,D,R,S,$,T,O] ONLY.');
	    EXIT;
	  END;
	 REPEAT
	  i:=i + 1;
	 UNTIL line[i] IN [' ','/'];
      END (*  WHILE line  *);
   END;




  PROCEDURE page;

   BEGIN
     IF pagecount<>1
      THEN write(reffile,formfeed);
     write(reffile,title,'  GLOBAL REFERENCE/CROSS REFERENCE');
     writeln(reffile,b6,b6,b6,'PAGE',pagecount);
     writeln(reffile);
     writeln(reffile);
     writeln(reffile,'SYMBOL            REFERENCES...');
     writeln(reffile,separator);
     pagecount:=pagecount + 1;
     linecount:=5;
   END;



  PROCEDURE parse (line:linetype; VAR index:integer; VAR string:stringtype);

  VAR

    i1,i2:integer;

   BEGIN

     FOR i1:=1 TO 6 DO
      BEGIN
	i2:=index - 1 + i1;
	IF line[i2] IN ['A'..'Z','$',' ','.','0'..'9']
	 THEN
	 string[i1]:=line[i2]
	 ELSE
	 string[i1]:=' ';
      END;
     index:=i2 + 1;
   END;




  PROCEDURE printref;

    (*         ROUTINE TO WRITE REF/CREF TO FILE *.REF                   *)

  CONST

    calls='  CALLS     ';
    called='  CALLED BY ';
    main='MAIN PROGRAM OR UNREFERENCED SYMBOL/ENTRY-POINT';
    b6='      ';
    b4='    ';


  VAR

    stringr1,stringr2,stringc1,stringc2:stringtype;
    i,count:integer;


   BEGIN
     IF (refflag OR crefflag)=true
      THEN
       BEGIN
	 count:=0;
	 readln(cfile,stringc1,stringc2);
	 readln(rfile,stringr1,stringr2);

	  REPEAT

	   string0:=stringr1;
	   write(reffile,string0);
	   IF refflag
	    THEN
	    write(reffile,calls);

	    REPEAT
	     IF refflag
	      THEN
	       BEGIN

		 IF stringr2<>string0
		  THEN
		   BEGIN
		     write(reffile,b4,stringr2);
		     count:=count + 1;
		   END;
		 IF count=10
		  THEN
		   BEGIN
		     writeln(reffile);
		     linecount:=linecount + 1;
		     write(reffile,b6,b6,b6);
		     count:=0;
		   END;
	       END (* IF refflag  *);
	     readln(rfile,stringr1,stringr2);
	     IF eof(rfile)
	      THEN stringr1:=b6;

	    UNTIL stringr1<>string0;

	   IF refflag
	    THEN
	     BEGIN
	       writeln(reffile);
	       linecount:=linecount + 1;
	       IF count<>0
		THEN
		 BEGIN
		   writeln(reffile);
		   linecount:=linecount + 1;
		 END;
	       count:=0;
	     END (*  IF refflag  *);

	   IF NOT eof(cfile)
	    THEN
	     BEGIN
	       IF stringc1=string0
		THEN
		 BEGIN
		   IF crefflag
		    THEN
		     BEGIN
		       write(reffile,b6);
		       write(reffile,called);

			REPEAT

			 IF stringc2<>string0
			  THEN
			   BEGIN
			     write(reffile,b4,stringc2);
			     count:=count +1;
			   END;
			 IF count=10
			  THEN
			   BEGIN
			     writeln(reffile);
			     linecount:=linecount + 1;
			     write(reffile,b6,b6,b6);
			     count:=0;
			   END;
			 readln(cfile,stringc1,stringc2);
			 IF eof(cfile)
			  THEN stringc1:=b6;

			UNTIL stringc1<>string0;

		       writeln(reffile);
		       linecount:=linecount + 1;
		     END (*  IF crefflag  *);

		   writeln(reffile,separator);
		   linecount:=linecount + 1;
		   count:=0;
		 END
		ELSE
		 BEGIN
		   IF crefflag
		    THEN
		     BEGIN
		       writeln(reffile,b6,main);
		       linecount:=linecount + 1;
		     END;
		   writeln(reffile,separator);
		   linecount:=linecount + 1;
		 END;
	     END;

	   IF (linecount+8)>64
	    THEN page;
	  UNTIL eof(rfile);

       END;
   END (*  printref  *);



  FUNCTION user(string:stringtype):boolean;

  VAR

    i:integer;

   BEGIN
     user:=true;
     IF sysflag=false
      THEN
      IF string<>'.MAIN.'
       THEN
       FOR i:=1 TO 6 DO
       IF string[i] IN ['$','.']
	THEN user:=false;
   END;




 BEGIN  (*  reference  *)

   detach;
   done:=false;
   okay:=true;
   getinput;
   reset(mapfile,inname,'.MAP');
   rewrite(rfile,'SY:ZZREF.RTP');
   rewrite(cfile,'SY:ZZREF.CTP');
   rewrite(reffile,outname,'.REF');
   FOR i:=1 TO 132 DO separator[i]:=delimiter;
   pagecount:=1;
   page;

    REPEAT

     readln(mapfile,line);
     IF NOT eof(mapfile)
      THEN
       BEGIN
	 IF line[13]='C'
	  THEN
	   BEGIN
	     FOR i:=1 TO 10 DO
	      BEGIN
		index:=12 + i;
		keystring[i]:=line[index];
	      END;
	     IF keystring=createdby
	      THEN
	       BEGIN
		 done:=true;
		 FOR i:=1 TO 6 DO
		  BEGIN
		    index:=1 + i;
		    title[i]:=line[index];
		  END;
	       END;
	   END;
       END
      ELSE
       BEGIN
	 okay:=false;
	 done:=true;
       END;

    UNTIL done;


   IF NOT okay
    THEN writeln('NO CREF FOUND ON MAPFILE')
    ELSE
     BEGIN
       formfeed:=chr(12);
       FOR i:=1 TO 2 DO readln(mapfile);
       done:=false;

       WHILE NOT done DO
	BEGIN
	  readln(mapfile,line);
	  IF eof(mapfile)
	   THEN done:=true;
	  IF line[1]=formfeed
	   THEN
	    BEGIN
	      readln(mapfile,line);
	      IF line[1]='S'
	       THEN done:=true;
	      readln(mapfile,line);
	      readln(mapfile,line);
	    END;
	  IF NOT done
	   THEN
	    BEGIN
	      countline(lindex);
	      index:=1;
	      parse(line,index,string0) (*  INDEX = INDEX + 6  *);
	      IF string0=b6
	       THEN index:=index + 10
	       ELSE
		BEGIN
		  index:=index + 9;
		  string1:=string0;
		END;
	      index:=index + 4;
	      parse(line,index,string2);
	      IF user(string1)
	       THEN
		BEGIN
		  writeln(cfile,string1,string1);
		  writeln(rfile,string1,string1);
		END;

	       REPEAT
		IF (user(string1) AND user(string2))
		 THEN
		  BEGIN
		    writeln(cfile,string1,string2);
		    writeln(rfile,string2,string1);
		  END;
		index:=index + 4;
		IF index<128
		 THEN parse(line,index,string2);
	       UNTIL index>lindex;

	    END (*  IF NOT done  *);

	END (*  WHILE NOT done  *);


       close(rfile);
       close(cfile);
       count:=30;
       WHILE outname[count]=chr(0) DO
       count:=count - 1;
       rewrite(atdot,'SY:ZZREF.CMD');
       writeln(atdot,'.ENABLE QUIET');
       writeln(atdot,'SRT SY:ZZREF.CTP=SY:ZZREF.CTP/FO:FIXED:12/KE:1.12');
       writeln(atdot,'.WAIT SRT');
       writeln(atdot,'SRT SY:ZZREF.RTP=SY:ZZREF.RTP/FO:FIXED:12/KE:1.12');
       writeln(atdot,'.WAIT SRT');
       writeln(atdot,'RESUME');
       IF treeflag OR odlflag
	THEN
	 BEGIN
	   writeln(atdot,'.WAIT');
	   writeln(atdot,'TREE');
	   writeln(atdot,'.WAIT');
	   IF treeflag OR odlflag
	    THEN
	     BEGIN
	       write(atdot,'PIP ');
	       FOR i:=1 TO count DO write(atdot,outname[i]);
	       writeln(atdot,'.TRE/NV/RE=ZZREF.TRE');
	     END;
	   IF odlflag
	    THEN
	     BEGIN
	       write(atdot,'PIP ');
	       FOR i:=1 TO count DO write(atdot,outname[i]);
	       writeln(atdot,'.ODL/NV/RE=ZZREF.ODL');
	     END;
	 END;
       IF spoolflag
	THEN
	 BEGIN
	   write(atdot,'PRINT ');
	   FOR i:=1 TO count DO write(atdot,outname[i]);
	   writeln(atdot,'.REF');
	   writeln(atdot,'.WAIT PRI');
	   IF treeflag OR odlflag
	    THEN
	     BEGIN
	       write(atdot,'PRINT ');
	       FOR i:=1 TO count DO write(atdot,outname[i]);
	       writeln(atdot,'.TRE');
	       writeln(atdot,'.WAIT PRI');
	     END;
	   IF odlflag
	    THEN
	     BEGIN
	       write(atdot,'PRINT ');
	       FOR i:=1 TO count DO write(atdot,outname[i]);
	       writeln(atdot,'.ODL');
	       writeln(atdot,'.WAIT PRI');
	     END;
	 END;
       IF delflag
	THEN
	writeln(atdot,'PIP ZZREF.CTP;*/DE,ZZREF.RTP;*/DE');
       IF (refflag AND crefflag)=false
	THEN
	 BEGIN
	   write(atdot,'PIP ');
	   FOR i:=1 TO count DO write(atdot,outname[i]);
	   writeln(atdot,'.REF;0/DE');
	 END;
       writeln(atdot,'PIP ZZREF.CMD;*/DE');
       close(atdot);
(*     rewrite(mcr,'MC:');
       writeln(mcr,'@ZZREF');   *)
	SPWNIT;
       suspnd;
(*     close(mcr);      *)
       reset(rfile,'SY:ZZREF.RTP');
       reset(cfile,'SY:ZZREF.CTP');
       printref;
       close(reffile);
       writeln;
       IF (refflag OR crefflag)=true
	THEN
	writeln(pagecount-1, '  PAGE(S) OF REFERENCE OUTPUT.');
       IF treeflag OR odlflag
	THEN
	 BEGIN
	   writeln;
	   writeln('PROCESSING TREE..........(WAIT FOR <EOF>)')
	 END
     END (*  ELSE  *)
 END.
