head     56.3;
access   paws bayes jws quist brad dew jwh;
symbols  ;
locks    ; strict;
comment  @# @;


56.3
date     93.01.27.13.31.52;  author jwh;  state Exp;
branches ;
next     56.2;

56.2
date     93.01.27.12.08.46;  author jwh;  state Exp;
branches ;
next     56.1;

56.1
date     91.11.05.09.29.35;  author jwh;  state Exp;
branches ;
next     55.1;

55.1
date     91.08.25.10.07.35;  author jwh;  state Exp;
branches ;
next     54.1;

54.1
date     91.03.18.15.15.59;  author jwh;  state Exp;
branches ;
next     53.1;

53.1
date     91.03.11.19.16.38;  author jwh;  state Exp;
branches ;
next     52.1;

52.1
date     91.02.19.09.01.50;  author jwh;  state Exp;
branches ;
next     51.1;

51.1
date     91.01.30.16.00.52;  author jwh;  state Exp;
branches ;
next     50.1;

50.1
date     90.10.29.16.14.35;  author jwh;  state Exp;
branches ;
next     49.1;

49.1
date     90.08.14.14.02.54;  author jwh;  state Exp;
branches ;
next     48.1;

48.1
date     90.07.26.11.08.39;  author jwh;  state Exp;
branches ;
next     47.1;

47.1
date     90.05.14.10.45.41;  author dew;  state Exp;
branches ;
next     46.1;

46.1
date     90.05.07.08.34.01;  author jwh;  state Exp;
branches ;
next     45.1;

45.1
date     90.04.19.15.40.56;  author jwh;  state Exp;
branches ;
next     44.1;

44.1
date     90.04.01.21.58.39;  author jwh;  state Exp;
branches ;
next     43.1;

43.1
date     90.03.20.13.48.28;  author jwh;  state Exp;
branches ;
next     42.1;

42.1
date     90.01.23.17.34.03;  author jwh;  state Exp;
branches ;
next     41.1;

41.1
date     89.12.22.11.16.26;  author jwh;  state Exp;
branches ;
next     40.1;

40.1
date     89.09.29.11.39.23;  author jwh;  state Exp;
branches ;
next     39.1;

39.1
date     89.09.26.16.24.44;  author dew;  state Exp;
branches ;
next     38.1;

38.1
date     89.08.29.11.14.58;  author jwh;  state Exp;
branches ;
next     37.2;

37.2
date     89.08.12.17.27.18;  author jwh;  state Exp;
branches ;
next     37.1;

37.1
date     89.05.12.11.28.12;  author dew;  state Exp;
branches ;
next     36.1;

36.1
date     89.02.06.10.07.15;  author dew;  state Exp;
branches ;
next     35.1;

35.1
date     89.02.02.13.18.01;  author dew;  state Exp;
branches ;
next     34.1;

34.1
date     89.01.23.15.53.33;  author jwh;  state Exp;
branches ;
next     33.1;

33.1
date     89.01.16.11.29.17;  author dew;  state Exp;
branches ;
next     32.1;

32.1
date     89.01.10.11.34.54;  author bayes;  state Exp;
branches ;
next     31.1;

31.1
date     88.12.14.17.55.47;  author bayes;  state Exp;
branches ;
next     30.1;

30.1
date     88.12.09.13.34.08;  author dew;  state Exp;
branches ;
next     29.1;

29.1
date     88.10.31.15.18.08;  author bayes;  state Exp;
branches ;
next     28.1;

28.1
date     88.10.06.10.48.05;  author dew;  state Exp;
branches ;
next     27.1;

27.1
date     88.09.29.11.12.43;  author bayes;  state Exp;
branches ;
next     26.1;

26.1
date     88.09.28.12.28.13;  author bayes;  state Exp;
branches ;
next     25.1;

25.1
date     88.03.02.09.06.38;  author bayes;  state Exp;
branches ;
next     24.1;

24.1
date     87.08.31.09.14.02;  author jws;  state Exp;
branches ;
next     23.1;

23.1
date     87.08.26.09.50.40;  author bayes;  state Exp;
branches ;
next     22.1;

22.1
date     87.08.17.10.30.47;  author bayes;  state Exp;
branches ;
next     21.1;

21.1
date     87.08.12.13.18.52;  author bayes;  state Exp;
branches ;
next     20.1;

20.1
date     87.07.30.10.29.06;  author bayes;  state Exp;
branches ;
next     19.1;

19.1
date     87.06.01.07.47.41;  author jws;  state Exp;
branches ;
next     18.1;

18.1
date     87.05.20.14.41.39;  author bayes;  state Exp;
branches ;
next     17.1;

17.1
date     87.04.30.09.59.18;  author jws;  state Exp;
branches ;
next     16.1;

16.1
date     87.04.26.15.14.36;  author jws;  state Exp;
branches ;
next     15.1;

15.1
date     87.04.13.08.38.49;  author jws;  state Exp;
branches ;
next     14.1;

14.1
date     87.04.01.14.33.11;  author jws;  state Exp;
branches ;
next     13.1;

13.1
date     87.02.28.18.03.37;  author jws;  state Exp;
branches ;
next     12.1;

12.1
date     87.02.02.12.49.27;  author jws;  state Exp;
branches ;
next     11.1;

11.1
date     87.01.19.09.16.20;  author jws;  state Exp;
branches ;
next     10.1;

10.1
date     86.12.24.10.22.08;  author jws;  state Exp;
branches ;
next     9.1;

9.1
date     86.12.12.13.43.01;  author bayes;  state Exp;
branches ;
next     8.1;

8.1
date     86.11.27.11.19.29;  author jws;  state Exp;
branches ;
next     7.1;

7.1
date     86.11.20.13.04.56;  author hal;  state Exp;
branches ;
next     6.1;

6.1
date     86.11.04.17.03.30;  author paws;  state Exp;
branches ;
next     5.1;

5.1
date     86.10.28.15.54.27;  author hal;  state Exp;
branches ;
next     4.1;

4.1
date     86.09.30.19.08.32;  author hal;  state Exp;
branches ;
next     3.1;

3.1
date     86.09.01.11.21.54;  author hal;  state Exp;
branches ;
next     2.1;

2.1
date     86.07.30.14.12.34;  author hal;  state Exp;
branches ;
next     1.1;

1.1
date     86.06.30.13.24.11;  author danm;  state tmp;
branches ;
next     ;


desc
@Base file for PWS 3.2 release.

@


56.3
log
@
pws2rcs automatic delta on Wed Jan 27 13:14:25 MST 1993
@
text
@			{file DUMPTREE}

implement

procedure dumpvalu (val: valu);
  var i: shortint; p: vcref;
$if bigsets$
	s : setrecptr;                  (* current set record item *)
	j : integer;                    (* simple local counter *)
	bias, rel_elem: shortint;       (* ordinal bias and relative
						element value for list *)
$end$

  begin
  with val do
    if intval then write(lp,ival:1)
    else
      with valp^ do
	case cclass of
	  reel:       write(lp,rval);
	  pset:       begin
		      write(lp,'set:');
$if bigsets$
		      for j := 0 to plgth-1 do
			begin
			if (j mod 32) = 0 then
$end$
$if not bigsets$
		      for i := 0 to plgth-1 do
			begin
			if (i mod 32) = 0 then
$end$
			  begin
			  incrlinecount;
			  writeln(lp);
			  write(lp,'':2);
			  end;
 $if bigsets$
		       bias := j DIV (oldsethigh + 1);
		       rel_elem := j MOD (oldsethigh + 1);
		       s := pval;
		       for i := 1 to bias do s := s^.nxt;
		       if rel_elem in s^.val then
 $end$
 $if not bigsets$
			if i in pval then
 $end$
			  write(lp,'1')
			else write(lp,'0');
			end;
		      end;
	  paofch:     write(lp,'paofchar:',sval:slgth);
	  strng:      write(lp,'string:',sval:slgth);
	  bigpaoc:    begin
		      write(lp,'paofchar:');
		      for i := 1 to paoclgth do
			begin
			if i mod 70 = 0 then
			  begin
			  incrlinecount;
			  writeln(lp);
			  write(lp,'':9);
			  end;
			$RANGE OFF$
			write(lp,paocval[i]:1);
			$IF rangechecking$
			  $RANGE ON$
			$END$
			end;
		      end;
	  strctconst: begin
		      incrlinecount;
		      write(lp,'structured constant: ');
		      if kstruc = nil then
			writeln(lp,'value not saved')
		      else
			with kstruc^ do
			  begin writeln(lp);
			  incrlinecount;
			  if scstp^.form = arrays then writeln(lp,'array')
			  else if scstp^.form = records then
			    writeln(lp,'record');
			  p := scvcp;
			  while p <> nil do
			    begin
			    incrlinecount;
			    dumpvalu(p^.vcval);
			    writeln(lp);
			    p := p^.vcnxt;
			    end;
			  end;
		      end;
	  end; {case}
  end; {dumpvalu}
$IF FULLDUMP$
procedure dumpinfobits (inf: infobits);
  var ch: char;
  begin
  ch := '[';
  if predeclared in inf then
    begin write(lp,ch,'PDEC'); ch:=',' end;
  if mustinitialize in inf then
    begin write(lp,ch,'INIT'); ch:=',' end;
  if cantassign in inf then
    begin write(lp,ch,'NOASSGN'); ch:=',' end;
  if nonstandard in inf then
    begin write(lp,ch,'NONSTD'); ch:=',' end;
  if sysprogreq in inf then
    begin write(lp,ch,'SYSPROG'); ch:=',' end;
  if modcalreq in inf then
    begin write(lp,ch,'MODCAL'); ch:=',' end;
  if ucsdreq in inf then
    begin write(lp,ch,'UCSD'); ch:=',' end;
  if ch='[' then write(lp,ch);
  write(lp,']');
  end;
$END$
procedure writename (leadb: shortint; var str: string);
  {Write string, normalized length, at least 1 trailing blank}
  begin
  write(lp,' ':leadb,str,' ':17-strlen(str));
  end;

procedure dumpsymbol (fcp: ctp; indent: shortint); forward;

procedure dumpstruct (fsp: stp; indent: shortint);
  { Dump a structure node }
  begin
  incrlinecount;
  write(lp,' ':indent);
  if fsp = nil then writeln(lp,'NIL type')
  else with fsp^ do
    begin
    if fsp = intptr then write(lp,'integer')
    else if fsp = realptr then write(lp,'real')
    else if fsp = boolptr then write(lp,'boolean')
    else if fsp = char_ptr then write(lp,'char')
    else
      case form of
	scalar: write(lp,'scalar');
	subrange: begin
		  write(lp,'subrange min=');
		  write(lp,min:1);
		  write(lp,' max=');
		  write(lp,max:1);
		  end;
	prok: write(lp,'prok parmlc=',parmlc:1);
	funk: write(lp,'funk parmlc=',parmlc:1);
	pointer: write(lp,'pointer');
	power: write(lp,'set ',setmin:1,'..',setmax:1);
	files: write(lp,'file');
	arrays: begin
		write(lp,'array ');
		if aispackd then
		  write(lp,'elbitsize=',aelbitsize:1)
		else write(lp,'elsize=',aelsize:1);
		end;
	records: write(lp,'record');
	otherwise write(lp,'unexpected form=',ord(form))
	end; {case form}
    write(lp,' unpacksize=',unpacksize:1);
    if sizeoflo then write(lp,' (OFLO)');
    write(lp,' align=',align:1);
    if ispackable then
      begin
      write(lp,' bitsize=',bitsize:1);
      if signbit then write(lp,' signed');
      end;
    $IF FULLDUMP$
    write(lp,'   ');
    dumpinfobits(info);
    $END$
    writeln(lp);
    case form of
      records: dumpsymbol(fstfld,indent+2);
      prok:    dumpsymbol(params,indent+2);
      otherwise
      end; {2nd case form}
    end {with fsp^}
  end; {dumpstruct}

procedure dumpsymbol (*fcp: ctp; indent: shortint*);
  { Dump symbol table tree rooted at FCP }
  begin
  if fcp <> nil then
    with fcp^ do
      begin
      dumpsymbol(llink,indent);
      incrlinecount;
      writename(indent,namep^);
      case klass of
	types: write(lp,'type');
	konst: begin
	       write(lp,'konst '); dumpvalu(values);
	       end;
	routineparm,
	vars: begin
	      write(lp,'var lev=',vlev:2,' addr=',vaddr:6);
	      case vtype of
		shortvar: write(lp,' short');
		longvar:  write(lp,' long');
		relvar:   write(lp,' relative');
		localvar: if globalptr = NIL then write(lp,' local')
			  else write(lp,' globalbase = ',globalptr^);
		valparm:  write(lp,' valparm');
		refparm:  write(lp,' refparm');
	{ Added following line 8/12/89 JWH }
		boundparm : write(lp,' boundparm');
		cvalparm: write(lp,' copyparm; addr=',vptraddr:1);
		procparm: begin write(lp,' procparm');
			  dumpstruct(proktype,indent);
			  end;
		funcparm: begin write(lp,' funcparm');
			  dumpstruct(proktype,indent);
			  write(lp,'  result type:');
			  dumpstruct(idtype,indent);
			  end;
		strparm:  begin
			  write(lp,' var string',' maxlength offset:',vaddr+4:6);
			  end;
		anyvarparm:  write(lp,' anyvarparm');
		end;
	      end;
	field:  begin
		write(lp,'field offset=',fldaddr:1);
		if fispackd then write(lp,' bitoffset=',fldfbit:1);
		end;
	prox,func:
	       begin
	       if klass = prox then
		 if ismodulebody then write(lp,'module ')
				 else write(lp,'proc ')
	       else write(lp,'func ');
	       case pfdeckind of
		 special:  write(lp,'special ',ord(spkey):1,' ');
		 standard: write(lp,'standard ',ord(spkey):1,' ');
		 declared: begin
			   write(lp,'lev=',pflev:1);
			   if klass=func then write(lp,' result=',pfaddr:1);
			   if forwdecl then write(lp,' forw');
			   if extdecl  then write(lp,' ext');
			   if (klass <> prox) or not ismodulebody
			      and isdumped then
			     begin
			     incrlinecount;
			     writeln(lp);
			     incrlinecount;
			     writeln(lp,'   entry: ',
				     currentglobal^,'__BASE + ',
				     location:1);
			     incrlinecount;
			     writeln(lp,'   exit: ',
				     currentglobal^,'__BASE + ',
				     exit_location:1);
			     end;
			   end;
		 otherwise
		 end; {pfdeckind}
	       end;
	otherwise
	end; {case klass}
      $IF FULLDUMP$
      write(lp,'  ');
      dumpinfobits(info);
      $END$
      writeln(lp);
      if klass = types then dumpstruct(idtype,indent+2);
      dumpsymbol(rlink,indent);
      end; {with}
  end; {dumpsymbol}

procedure dumptree (*curbody: stptr; fprocp: ctp*);
  (* Prints statement/expression trees *)
  var
    lstate: modstateptr;
$IF FULLDUMP$ { SUPPRESS EXPR/STMT DUMP }
  procedure dumpelist (fexp: elistptr; setdeno: boolean);
    (* on entry
	 fexp points to the head of a (possibly empty) list of
	   'explist' records.
	 setdeno indicates the variant of the records.
       on exit
	 the 'enum's associated with the list have been printed to file lp.
	 NO end-of-line mark has been written to the file *)
    begin
      while fexp<>nil do
	with fexp^ do begin
	  if not setdeno then
	  if expptr = nil then write(lp,' NIL')
	  else write(lp,' ',expptr^.enum:1)
	  else write(lp,' ',lowptr^.enum:1,':',hiptr^.enum:1);
	  fexp := nextptr;
	  end;
    end (*dumpelist*);

  procedure dumpexprs;
    (* prints expression records to file lp. The expressions are printed
       as encountered on the linear list headed by firstexp^.echain and
       linked by echain fields. *)
     var lexp: exptr;

     procedure dumpoperands;
       begin
	 with lexp^ do
	   case eclass of
	     eqnode..andnode,concatnode:
	       begin
	       incrlinecount;
	       writeln(lp,'  operands: ',
		    opnd1^.enum:1,',',opnd2^.enum:1);
	       end;
	     negnode..truncnode:
	       write(lp,'  operand: ',opnd^.enum:1);
	     idnode: writename(2,symptr^.namep^);
	     subscrnode,
	     substrnode:
	       begin write(lp,'  arayp: ',arayp^.enum:1,
		     ', index: ',indxp^.enum:1);
	       if eclass = substrnode then
		 begin write(lp,', lengthp = ');
		 if lengthp = nil then write(lp,'NIL')
		 else write(lp,lengthp^.enum:1);
		 end;
	       end;
	     selnnode:    begin write(lp,'  rec: ',recptr^.enum:1,', field:');
			  writename(1,fieldptr^.namep^);
			  end;
	     unqualfldnode:
			  begin write(lp,'  withst: ',withstptr^.snum:1,
						      ', field:');
			  writename(1,fieldref^.namep^);
			  end;
	     litnode:     begin
			  incrlinecount;
			  write(lp,'  ');
			  dumpvalu(litval); writeln(lp)
			  end;
	     fcallnode:   begin
			  incrlinecount;
			  writename(2,fptr^.namep^);
			  if actualp = nil then writeln(lp,' no parms')
			  else begin
			       write(lp,' parms:');
			       dumpelist(actualp,false);
			       writeln(lp)
			       end
			  end;
	     setdenonode: begin
			  with etyptr^ do
			    begin
			    write(lp,'  unpacksize=',unpacksize:1);
			    if ispackable then write(lp,' bitsize=',bitsize:1);
			    end;
			  if setcstpart.valp <> nil then
			    begin
			    incrlinecount;
			    write(lp,', cst part: ');
			    dumpvalu(setcstpart); writeln(lp);
			    end
			  else writeln(lp,', no cst part');
			  if setvarpart<>nil then
			    begin
			    incrlinecount;
			    write(lp,'var part:':43);
			    dumpelist(setvarpart,true); writeln(lp)
			    end;
			  end;
	     otherwise    begin
			  incrlinecount;
			  writeln(lp,'???');
			  end;
	     end (*case eclass*)
       end(*dumpoperands*);

     procedure printclass (cls: exprs);
       begin
	 case cls of
	   eqnode:        write(lp,'eqnode':12);
	   nenode:        write(lp,'nenode':12);
	   ltnode:        write(lp,'ltnode':12);
	   lenode:        write(lp,'lenode':12);
	   gtnode:        write(lp,'gtnode':12);
	   genode:        write(lp,'genode':12);
	   innode:        write(lp,'innode':12);
	   subsetnode:    write(lp,'subsetnode':12);
	   supersetnode:  write(lp,'supersetnd':12);
	   concatnode:    write(lp,'concatnode':12);
	   addnode:       write(lp,'addnode':12);
	   subnode:       write(lp,'subnode':12);
	   ornode:        write(lp,'ornode':12);
	   unionnode:     write(lp,'unionnode':12);
	   diffnode:      write(lp,'diffnode':12);
	   mulnode:       write(lp,'mulnode':12);
	   divnode:       write(lp,'divnode':12);
	   modnode:       write(lp,'modnode':12);
	   andnode:       write(lp,'andnode':12);
	   intersectnode: write(lp,'intersectnd':12);
	   selnnode:      write(lp,'selnnode':12);
	   negnode:       write(lp,'negnode':12);
	   floatnode:     write(lp,'floatnode':12);
	   strlennode:    write(lp,'strlennode':12);
	   notnode:       write(lp,'notnode':12);
	   unqualfldnode: write(lp,'unqualfldnd':12);
	   derfnode:      write(lp,'derfnode':12);
	   absnode:       write(lp,'absnode':12);
	   chrnode:       write(lp,'chrnode':12);
	   oddnode:       write(lp,'oddnode':12);
	   ordnode:       write(lp,'ordnode':12);
	   roundnode:     write(lp,'roundnode':12);
	   sqrnode:       write(lp,'sqrnode':12);
	   truncnode:     write(lp,'truncnode':12);
	   fcallnode:     write(lp,'fcallnode':12);
	   setdenonode:   write(lp,'setdenonode':12);
	   subscrnode:    write(lp,'subscrnode':12);
	   substrnode:    write(lp,'substrnode':12);
	   idnode:        write(lp,'idnode':12);
	   litnode:       write(lp,'litnode':12);
	   otherwise      write(lp,' eclass is garbage: ',ord(cls):1)
	   end;
       end;

     begin (*dumpexprs*)
       lexp := firstexp^.echain;
       incrlinecount;
       if lexp = nil then writeln(lp,' no expressions')
       else begin
	 writeln(lp,'ENUM':5,'EKIND':6,'TYPE':9,'ECLASS':12);
	 repeat
	   with lexp^ do
	     begin
	     incrlinecount;
	     write(lp,enum:5);
	     case ekind of
	       cnst: write(lp,'cnst':6);
	       vrbl: write(lp,'vrbl':6);
	       xpr:  write(lp,'xpr':6)
	       end;
	     if etyptr = boolptr then write(lp,'bool':9)
	     else if etyptr = char_ptr then write(lp,'char':9)
	     else if etyptr = intptr  then write(lp,'int':9)
	     else if etyptr = shortintptr then write(lp,'shortint':9)
	     else if etyptr = realptr then write(lp,'real':9)
	     else if etyptr = nil then write(lp,'NIL':9)
	     else
	       case etyptr^.form of
		 scalar:   write(lp,'scalar':9);
		 subrange: write(lp,'subrange':9);
		 prok:     write(lp,'prok':9);
		 funk:     write(lp,'funk':9);
		 pointer:  write(lp,'pointer':9);
		 power:    write(lp,'power':9);
		 arrays:   write(lp,'arrays':9);
		 records:  write(lp,'records':9);
		 files:    write(lp,'files':9);
		 otherwise write(lp,' form=',ord(etyptr^.form):3)
		 end;
	     printclass(eclass);
	     dumpoperands;
	     end; (*with lexp^*)
	   lexp := lexp^.echain; writeln(lp);
	 until lexp = nil
       end (*lexp <> nil*)
    end (*dumpexprs*);

  procedure dumpstmts (curstmt:stptr);
    var lexp: elistptr;

    procedure namebody (name: alpha; body: stptr);
      begin
	write(lp,name);
	if body=nil then write(lp,'nil')
	else write(lp,body^.snum:1);
      end (*namebody*);

    procedure dumpbody (name: alpha; body: stptr);
      begin
      incrlinecount;
      namebody(name,body); writeln(lp);
      dumpstmts(body)
      end (*dumpbody*);

    procedure dumpcasest (curstmt: stptr);
      var lclabp: clabptr; lstmt,nextsave: stptr;
      begin
	with curstmt^ do
	  begin
	  incrlinecount;
	  writeln(lp,'casest':10,'  nrlabs: ',nrlabs:1,', nrstmts: ',nrstmts:1,
		  ', selecter: ',selecter^.enum:1);
	  write(lp,' ':40);
	  namebody('firstmt: ',firstmt);
	  namebody(', otherwyse: ',otherwyse);
	  incrlinecount;
	  writeln(lp);
	  incrlinecount;
	  writeln(lp,' ':40,'case list elements:');
	  lclabp := minlab;
	  while lclabp <> nil do
	    with lclabp^ do
	      begin
	      incrlinecount;
	      writeln(lp,' ':40,lowval:1,'..',hival:1,': ',cstmt^.snum:1);
	      lclabp := clabp
	      end;
	  lstmt := firstmt;
	  while lstmt<>nil do
	    with lstmt^ do begin
	      nextsave := next; next := nil;
	      dumpstmts(lstmt);
	      next := nextsave;
	      lstmt := nextsave
	      end;
	  dumpstmts(otherwyse)
	  end (* with curstmt^ *)
      end (*dumpcasest*);

    begin (*dumpstmts*)
      while curstmt<>nil do
	with curstmt^ do begin
	  write(lp,snum:5);
	  if next<>nil then write(lp,next^.snum:7) else write(lp,'NIL':7);
	  if labp<>nil then write(lp,labp^.labval:7) else write(lp,' ':7);
	  write(lp,lineno:7); write(lp,' ');
	  case sclass of
	    becomest: begin
		      incrlinecount;writeln(lp,'becomest':10,'  lhs: ',lhs^.enum:1,
			  ', rhs: ',rhs^.enum:1);
		      end;
	    pcallst:  begin
		      incrlinecount;
		      write(lp,'pcallst':10);
		      writename(2,psymptr^.namep^);
		      if actualp = nil then writeln(lp,' no parms')
		      else begin
			   write(lp,' parms:');
			   dumpelist(actualp,false);
			   writeln(lp)
			   end
		      end;
	    casest:   dumpcasest(curstmt);
	    compndst: begin write(lp,'compndst':10);
		      dumpbody('  cbody: ',cbody) end;
	    forst:    begin
		      incrlinecount;
		      write(lp,'forst':10);
		      writeln(lp,'  ctrl: ',ctrl^.enum:1,', init: ',init^.enum:1,
			      ', incr ',incr:1,', limit: ',limit^.enum:1);
		      write(lp,' ':40); dumpbody('fbody: ',fbody) end;
	    gotost:   begin
		      incrlinecount;
		      writeln(lp,'gotost':10,
			      '  target: ',target^.labval:1);
		      end;
	    ifst:     begin
		      incrlinecount;
		      write(lp,'ifst':10,'  ifcond: ',ifcond^.enum:1);
		      namebody(', tru: ',tru); namebody(', fals: ',fals);
		      writeln(lp); dumpstmts(tru); dumpstmts(fals)
		      end;
	    repst:    begin write(lp,'repeatst':10,'  rcond: ',rcond^.enum:1);
		      dumpbody(', rbody: ',rbody) end;
	    whilest:  begin write(lp,'whilest':10,'  rcond: ',rcond^.enum:1);
		      dumpbody(', rbody: ',rbody) end;
	    tryst:    begin
		      incrlinecount;
		      write(lp,'tryst':10); namebody('  tbody: ',tbody);
		      namebody(', recov: ',recov); writeln(lp);
		      dumpstmts(tbody); dumpstmts(recov);
		      end;
	    withst:   begin write(lp,'withst':10,'  record: ',refexpr^.enum:1);
		      dumpbody(', wbody: ',wbody) end;
	    emptyst:  begin
		      incrlinecount;
		      writeln(lp,'emptyst':10);
		      end;
	    endofbodyst: begin
			 incrlinecount;
			 writeln(lp,' endofbodyst');
			 end;
	    otherwise begin
		      incrlinecount;
		      writeln(lp,' sclass is garbage: ',ord(sclass):1)
		      end;
	    end (*case*);
	  curstmt := next
	end (*with curstmt^*)
    end (*dumpstmts*);
$END$
  begin (*dumptree*)
  if (initlistmode = listfull) and listopen then
    begin
    incrlinecount;
    writeln(lp);
    incrlinecount;
    writeln(lp,'Dump of ',fprocp^.namep^);
    with display[top] do
      begin
      if occur = MODULEscope then
	begin
	incrlinecount;
	writeln(lp,'Imported:');
	lstate := fmodule^.modinfo^.usemodule;
	  begin
	  dumpsymbol(fmodule^.modinfo^.useids,0);
	  while lstate <> nil do
	    begin
	    dumpsymbol(lstate^.defineids,0);
	    lstate := lstate^.nextmodule;
	    end;
	  end;
	incrlinecount; writeln(lp);
	incrlinecount;
	writeln(lp,'Exported:');
	lstate := fmodule;
	while lstate <> nil do
	  begin dumpsymbol(lstate^.defineids,0);
	  lstate := lstate^.contmodule;
	  end;
	incrlinecount; writeln(lp);
	incrlinecount; writeln(lp);
	end;
      dumpsymbol(fname,0);
      incrlinecount; writeln(lp)
      end;
    $IF FULLDUMP$
    incrlinecount;
    writeln(lp,' SNUM   NEXT  LABEL LINENO     SCLASS');
    dumpstmts(curbody);
    incrlinecount; writeln(lp);
    dumpexprs;
    $END$
    incrlinecount;
    writeln(lp,fprocp^.namep^,' dump complete');
    incrlinecount; writeln(lp);
    if ioresult <> ord(inoerror) then
      begin
      listabort := true;
      list := listnone;
      listopen := false;
      warning(linenumber,'Listing aborted');
      end;
    end;
  end (*dumptree*);



@


56.2
log
@
pws2rcs automatic delta on Wed Jan 27 11:57:27 MST 1993
@
text
@d1 646
@


56.1
log
@Automatic bump of revision number for PWS version 3.25
@
text
@a0 646
			{file DUMPTREE}

implement

procedure dumpvalu (val: valu);
  var i: shortint; p: vcref;
$if bigsets$
	s : setrecptr;                  (* current set record item *)
	j : integer;                    (* simple local counter *)
	bias, rel_elem: shortint;       (* ordinal bias and relative
						element value for list *)
$end$

  begin
  with val do
    if intval then write(lp,ival:1)
    else
      with valp^ do
	case cclass of
	  reel:       write(lp,rval);
	  pset:       begin
		      write(lp,'set:');
$if bigsets$
		      for j := 0 to plgth-1 do
			begin
			if (j mod 32) = 0 then
$end$
$if not bigsets$
		      for i := 0 to plgth-1 do
			begin
			if (i mod 32) = 0 then
$end$
			  begin
			  incrlinecount;
			  writeln(lp);
			  write(lp,'':2);
			  end;
 $if bigsets$
		       bias := j DIV (oldsethigh + 1);
		       rel_elem := j MOD (oldsethigh + 1);
		       s := pval;
		       for i := 1 to bias do s := s^.nxt;
		       if rel_elem in s^.val then
 $end$
 $if not bigsets$
			if i in pval then
 $end$
			  write(lp,'1')
			else write(lp,'0');
			end;
		      end;
	  paofch:     write(lp,'paofchar:',sval:slgth);
	  strng:      write(lp,'string:',sval:slgth);
	  bigpaoc:    begin
		      write(lp,'paofchar:');
		      for i := 1 to paoclgth do
			begin
			if i mod 70 = 0 then
			  begin
			  incrlinecount;
			  writeln(lp);
			  write(lp,'':9);
			  end;
			$RANGE OFF$
			write(lp,paocval[i]:1);
			$IF rangechecking$
			  $RANGE ON$
			$END$
			end;
		      end;
	  strctconst: begin
		      incrlinecount;
		      write(lp,'structured constant: ');
		      if kstruc = nil then
			writeln(lp,'value not saved')
		      else
			with kstruc^ do
			  begin writeln(lp);
			  incrlinecount;
			  if scstp^.form = arrays then writeln(lp,'array')
			  else if scstp^.form = records then
			    writeln(lp,'record');
			  p := scvcp;
			  while p <> nil do
			    begin
			    incrlinecount;
			    dumpvalu(p^.vcval);
			    writeln(lp);
			    p := p^.vcnxt;
			    end;
			  end;
		      end;
	  end; {case}
  end; {dumpvalu}
$IF FULLDUMP$
procedure dumpinfobits (inf: infobits);
  var ch: char;
  begin
  ch := '[';
  if predeclared in inf then
    begin write(lp,ch,'PDEC'); ch:=',' end;
  if mustinitialize in inf then
    begin write(lp,ch,'INIT'); ch:=',' end;
  if cantassign in inf then
    begin write(lp,ch,'NOASSGN'); ch:=',' end;
  if nonstandard in inf then
    begin write(lp,ch,'NONSTD'); ch:=',' end;
  if sysprogreq in inf then
    begin write(lp,ch,'SYSPROG'); ch:=',' end;
  if modcalreq in inf then
    begin write(lp,ch,'MODCAL'); ch:=',' end;
  if ucsdreq in inf then
    begin write(lp,ch,'UCSD'); ch:=',' end;
  if ch='[' then write(lp,ch);
  write(lp,']');
  end;
$END$
procedure writename (leadb: shortint; var str: string);
  {Write string, normalized length, at least 1 trailing blank}
  begin
  write(lp,' ':leadb,str,' ':17-strlen(str));
  end;

procedure dumpsymbol (fcp: ctp; indent: shortint); forward;

procedure dumpstruct (fsp: stp; indent: shortint);
  { Dump a structure node }
  begin
  incrlinecount;
  write(lp,' ':indent);
  if fsp = nil then writeln(lp,'NIL type')
  else with fsp^ do
    begin
    if fsp = intptr then write(lp,'integer')
    else if fsp = realptr then write(lp,'real')
    else if fsp = boolptr then write(lp,'boolean')
    else if fsp = char_ptr then write(lp,'char')
    else
      case form of
	scalar: write(lp,'scalar');
	subrange: begin
		  write(lp,'subrange min=');
		  write(lp,min:1);
		  write(lp,' max=');
		  write(lp,max:1);
		  end;
	prok: write(lp,'prok parmlc=',parmlc:1);
	funk: write(lp,'funk parmlc=',parmlc:1);
	pointer: write(lp,'pointer');
	power: write(lp,'set ',setmin:1,'..',setmax:1);
	files: write(lp,'file');
	arrays: begin
		write(lp,'array ');
		if aispackd then
		  write(lp,'elbitsize=',aelbitsize:1)
		else write(lp,'elsize=',aelsize:1);
		end;
	records: write(lp,'record');
	otherwise write(lp,'unexpected form=',ord(form))
	end; {case form}
    write(lp,' unpacksize=',unpacksize:1);
    if sizeoflo then write(lp,' (OFLO)');
    write(lp,' align=',align:1);
    if ispackable then
      begin
      write(lp,' bitsize=',bitsize:1);
      if signbit then write(lp,' signed');
      end;
    $IF FULLDUMP$
    write(lp,'   ');
    dumpinfobits(info);
    $END$
    writeln(lp);
    case form of
      records: dumpsymbol(fstfld,indent+2);
      prok:    dumpsymbol(params,indent+2);
      otherwise
      end; {2nd case form}
    end {with fsp^}
  end; {dumpstruct}

procedure dumpsymbol (*fcp: ctp; indent: shortint*);
  { Dump symbol table tree rooted at FCP }
  begin
  if fcp <> nil then
    with fcp^ do
      begin
      dumpsymbol(llink,indent);
      incrlinecount;
      writename(indent,namep^);
      case klass of
	types: write(lp,'type');
	konst: begin
	       write(lp,'konst '); dumpvalu(values);
	       end;
	routineparm,
	vars: begin
	      write(lp,'var lev=',vlev:2,' addr=',vaddr:6);
	      case vtype of
		shortvar: write(lp,' short');
		longvar:  write(lp,' long');
		relvar:   write(lp,' relative');
		localvar: if globalptr = NIL then write(lp,' local')
			  else write(lp,' globalbase = ',globalptr^);
		valparm:  write(lp,' valparm');
		refparm:  write(lp,' refparm');
	{ Added following line 8/12/89 JWH }
		boundparm : write(lp,' boundparm');
		cvalparm: write(lp,' copyparm; addr=',vptraddr:1);
		procparm: begin write(lp,' procparm');
			  dumpstruct(proktype,indent);
			  end;
		funcparm: begin write(lp,' funcparm');
			  dumpstruct(proktype,indent);
			  write(lp,'  result type:');
			  dumpstruct(idtype,indent);
			  end;
		strparm:  begin
			  write(lp,' var string',' maxlength offset:',vaddr+4:6);
			  end;
		anyvarparm:  write(lp,' anyvarparm');
		end;
	      end;
	field:  begin
		write(lp,'field offset=',fldaddr:1);
		if fispackd then write(lp,' bitoffset=',fldfbit:1);
		end;
	prox,func:
	       begin
	       if klass = prox then
		 if ismodulebody then write(lp,'module ')
				 else write(lp,'proc ')
	       else write(lp,'func ');
	       case pfdeckind of
		 special:  write(lp,'special ',ord(spkey):1,' ');
		 standard: write(lp,'standard ',ord(spkey):1,' ');
		 declared: begin
			   write(lp,'lev=',pflev:1);
			   if klass=func then write(lp,' result=',pfaddr:1);
			   if forwdecl then write(lp,' forw');
			   if extdecl  then write(lp,' ext');
			   if (klass <> prox) or not ismodulebody
			      and isdumped then
			     begin
			     incrlinecount;
			     writeln(lp);
			     incrlinecount;
			     writeln(lp,'   entry: ',
				     currentglobal^,'__BASE + ',
				     location:1);
			     incrlinecount;
			     writeln(lp,'   exit: ',
				     currentglobal^,'__BASE + ',
				     exit_location:1);
			     end;
			   end;
		 otherwise
		 end; {pfdeckind}
	       end;
	otherwise
	end; {case klass}
      $IF FULLDUMP$
      write(lp,'  ');
      dumpinfobits(info);
      $END$
      writeln(lp);
      if klass = types then dumpstruct(idtype,indent+2);
      dumpsymbol(rlink,indent);
      end; {with}
  end; {dumpsymbol}

procedure dumptree (*curbody: stptr; fprocp: ctp*);
  (* Prints statement/expression trees *)
  var
    lstate: modstateptr;
$IF FULLDUMP$ { SUPPRESS EXPR/STMT DUMP }
  procedure dumpelist (fexp: elistptr; setdeno: boolean);
    (* on entry
	 fexp points to the head of a (possibly empty) list of
	   'explist' records.
	 setdeno indicates the variant of the records.
       on exit
	 the 'enum's associated with the list have been printed to file lp.
	 NO end-of-line mark has been written to the file *)
    begin
      while fexp<>nil do
	with fexp^ do begin
	  if not setdeno then
	  if expptr = nil then write(lp,' NIL')
	  else write(lp,' ',expptr^.enum:1)
	  else write(lp,' ',lowptr^.enum:1,':',hiptr^.enum:1);
	  fexp := nextptr;
	  end;
    end (*dumpelist*);

  procedure dumpexprs;
    (* prints expression records to file lp. The expressions are printed
       as encountered on the linear list headed by firstexp^.echain and
       linked by echain fields. *)
     var lexp: exptr;

     procedure dumpoperands;
       begin
	 with lexp^ do
	   case eclass of
	     eqnode..andnode,concatnode:
	       begin
	       incrlinecount;
	       writeln(lp,'  operands: ',
		    opnd1^.enum:1,',',opnd2^.enum:1);
	       end;
	     negnode..truncnode:
	       write(lp,'  operand: ',opnd^.enum:1);
	     idnode: writename(2,symptr^.namep^);
	     subscrnode,
	     substrnode:
	       begin write(lp,'  arayp: ',arayp^.enum:1,
		     ', index: ',indxp^.enum:1);
	       if eclass = substrnode then
		 begin write(lp,', lengthp = ');
		 if lengthp = nil then write(lp,'NIL')
		 else write(lp,lengthp^.enum:1);
		 end;
	       end;
	     selnnode:    begin write(lp,'  rec: ',recptr^.enum:1,', field:');
			  writename(1,fieldptr^.namep^);
			  end;
	     unqualfldnode:
			  begin write(lp,'  withst: ',withstptr^.snum:1,
						      ', field:');
			  writename(1,fieldref^.namep^);
			  end;
	     litnode:     begin
			  incrlinecount;
			  write(lp,'  ');
			  dumpvalu(litval); writeln(lp)
			  end;
	     fcallnode:   begin
			  incrlinecount;
			  writename(2,fptr^.namep^);
			  if actualp = nil then writeln(lp,' no parms')
			  else begin
			       write(lp,' parms:');
			       dumpelist(actualp,false);
			       writeln(lp)
			       end
			  end;
	     setdenonode: begin
			  with etyptr^ do
			    begin
			    write(lp,'  unpacksize=',unpacksize:1);
			    if ispackable then write(lp,' bitsize=',bitsize:1);
			    end;
			  if setcstpart.valp <> nil then
			    begin
			    incrlinecount;
			    write(lp,', cst part: ');
			    dumpvalu(setcstpart); writeln(lp);
			    end
			  else writeln(lp,', no cst part');
			  if setvarpart<>nil then
			    begin
			    incrlinecount;
			    write(lp,'var part:':43);
			    dumpelist(setvarpart,true); writeln(lp)
			    end;
			  end;
	     otherwise    begin
			  incrlinecount;
			  writeln(lp,'???');
			  end;
	     end (*case eclass*)
       end(*dumpoperands*);

     procedure printclass (cls: exprs);
       begin
	 case cls of
	   eqnode:        write(lp,'eqnode':12);
	   nenode:        write(lp,'nenode':12);
	   ltnode:        write(lp,'ltnode':12);
	   lenode:        write(lp,'lenode':12);
	   gtnode:        write(lp,'gtnode':12);
	   genode:        write(lp,'genode':12);
	   innode:        write(lp,'innode':12);
	   subsetnode:    write(lp,'subsetnode':12);
	   supersetnode:  write(lp,'supersetnd':12);
	   concatnode:    write(lp,'concatnode':12);
	   addnode:       write(lp,'addnode':12);
	   subnode:       write(lp,'subnode':12);
	   ornode:        write(lp,'ornode':12);
	   unionnode:     write(lp,'unionnode':12);
	   diffnode:      write(lp,'diffnode':12);
	   mulnode:       write(lp,'mulnode':12);
	   divnode:       write(lp,'divnode':12);
	   modnode:       write(lp,'modnode':12);
	   andnode:       write(lp,'andnode':12);
	   intersectnode: write(lp,'intersectnd':12);
	   selnnode:      write(lp,'selnnode':12);
	   negnode:       write(lp,'negnode':12);
	   floatnode:     write(lp,'floatnode':12);
	   strlennode:    write(lp,'strlennode':12);
	   notnode:       write(lp,'notnode':12);
	   unqualfldnode: write(lp,'unqualfldnd':12);
	   derfnode:      write(lp,'derfnode':12);
	   absnode:       write(lp,'absnode':12);
	   chrnode:       write(lp,'chrnode':12);
	   oddnode:       write(lp,'oddnode':12);
	   ordnode:       write(lp,'ordnode':12);
	   roundnode:     write(lp,'roundnode':12);
	   sqrnode:       write(lp,'sqrnode':12);
	   truncnode:     write(lp,'truncnode':12);
	   fcallnode:     write(lp,'fcallnode':12);
	   setdenonode:   write(lp,'setdenonode':12);
	   subscrnode:    write(lp,'subscrnode':12);
	   substrnode:    write(lp,'substrnode':12);
	   idnode:        write(lp,'idnode':12);
	   litnode:       write(lp,'litnode':12);
	   otherwise      write(lp,' eclass is garbage: ',ord(cls):1)
	   end;
       end;

     begin (*dumpexprs*)
       lexp := firstexp^.echain;
       incrlinecount;
       if lexp = nil then writeln(lp,' no expressions')
       else begin
	 writeln(lp,'ENUM':5,'EKIND':6,'TYPE':9,'ECLASS':12);
	 repeat
	   with lexp^ do
	     begin
	     incrlinecount;
	     write(lp,enum:5);
	     case ekind of
	       cnst: write(lp,'cnst':6);
	       vrbl: write(lp,'vrbl':6);
	       xpr:  write(lp,'xpr':6)
	       end;
	     if etyptr = boolptr then write(lp,'bool':9)
	     else if etyptr = char_ptr then write(lp,'char':9)
	     else if etyptr = intptr  then write(lp,'int':9)
	     else if etyptr = shortintptr then write(lp,'shortint':9)
	     else if etyptr = realptr then write(lp,'real':9)
	     else if etyptr = nil then write(lp,'NIL':9)
	     else
	       case etyptr^.form of
		 scalar:   write(lp,'scalar':9);
		 subrange: write(lp,'subrange':9);
		 prok:     write(lp,'prok':9);
		 funk:     write(lp,'funk':9);
		 pointer:  write(lp,'pointer':9);
		 power:    write(lp,'power':9);
		 arrays:   write(lp,'arrays':9);
		 records:  write(lp,'records':9);
		 files:    write(lp,'files':9);
		 otherwise write(lp,' form=',ord(etyptr^.form):3)
		 end;
	     printclass(eclass);
	     dumpoperands;
	     end; (*with lexp^*)
	   lexp := lexp^.echain; writeln(lp);
	 until lexp = nil
       end (*lexp <> nil*)
    end (*dumpexprs*);

  procedure dumpstmts (curstmt:stptr);
    var lexp: elistptr;

    procedure namebody (name: alpha; body: stptr);
      begin
	write(lp,name);
	if body=nil then write(lp,'nil')
	else write(lp,body^.snum:1);
      end (*namebody*);

    procedure dumpbody (name: alpha; body: stptr);
      begin
      incrlinecount;
      namebody(name,body); writeln(lp);
      dumpstmts(body)
      end (*dumpbody*);

    procedure dumpcasest (curstmt: stptr);
      var lclabp: clabptr; lstmt,nextsave: stptr;
      begin
	with curstmt^ do
	  begin
	  incrlinecount;
	  writeln(lp,'casest':10,'  nrlabs: ',nrlabs:1,', nrstmts: ',nrstmts:1,
		  ', selecter: ',selecter^.enum:1);
	  write(lp,' ':40);
	  namebody('firstmt: ',firstmt);
	  namebody(', otherwyse: ',otherwyse);
	  incrlinecount;
	  writeln(lp);
	  incrlinecount;
	  writeln(lp,' ':40,'case list elements:');
	  lclabp := minlab;
	  while lclabp <> nil do
	    with lclabp^ do
	      begin
	      incrlinecount;
	      writeln(lp,' ':40,lowval:1,'..',hival:1,': ',cstmt^.snum:1);
	      lclabp := clabp
	      end;
	  lstmt := firstmt;
	  while lstmt<>nil do
	    with lstmt^ do begin
	      nextsave := next; next := nil;
	      dumpstmts(lstmt);
	      next := nextsave;
	      lstmt := nextsave
	      end;
	  dumpstmts(otherwyse)
	  end (* with curstmt^ *)
      end (*dumpcasest*);

    begin (*dumpstmts*)
      while curstmt<>nil do
	with curstmt^ do begin
	  write(lp,snum:5);
	  if next<>nil then write(lp,next^.snum:7) else write(lp,'NIL':7);
	  if labp<>nil then write(lp,labp^.labval:7) else write(lp,' ':7);
	  write(lp,lineno:7); write(lp,' ');
	  case sclass of
	    becomest: begin
		      incrlinecount;writeln(lp,'becomest':10,'  lhs: ',lhs^.enum:1,
			  ', rhs: ',rhs^.enum:1);
		      end;
	    pcallst:  begin
		      incrlinecount;
		      write(lp,'pcallst':10);
		      writename(2,psymptr^.namep^);
		      if actualp = nil then writeln(lp,' no parms')
		      else begin
			   write(lp,' parms:');
			   dumpelist(actualp,false);
			   writeln(lp)
			   end
		      end;
	    casest:   dumpcasest(curstmt);
	    compndst: begin write(lp,'compndst':10);
		      dumpbody('  cbody: ',cbody) end;
	    forst:    begin
		      incrlinecount;
		      write(lp,'forst':10);
		      writeln(lp,'  ctrl: ',ctrl^.enum:1,', init: ',init^.enum:1,
			      ', incr ',incr:1,', limit: ',limit^.enum:1);
		      write(lp,' ':40); dumpbody('fbody: ',fbody) end;
	    gotost:   begin
		      incrlinecount;
		      writeln(lp,'gotost':10,
			      '  target: ',target^.labval:1);
		      end;
	    ifst:     begin
		      incrlinecount;
		      write(lp,'ifst':10,'  ifcond: ',ifcond^.enum:1);
		      namebody(', tru: ',tru); namebody(', fals: ',fals);
		      writeln(lp); dumpstmts(tru); dumpstmts(fals)
		      end;
	    repst:    begin write(lp,'repeatst':10,'  rcond: ',rcond^.enum:1);
		      dumpbody(', rbody: ',rbody) end;
	    whilest:  begin write(lp,'whilest':10,'  rcond: ',rcond^.enum:1);
		      dumpbody(', rbody: ',rbody) end;
	    tryst:    begin
		      incrlinecount;
		      write(lp,'tryst':10); namebody('  tbody: ',tbody);
		      namebody(', recov: ',recov); writeln(lp);
		      dumpstmts(tbody); dumpstmts(recov);
		      end;
	    withst:   begin write(lp,'withst':10,'  record: ',refexpr^.enum:1);
		      dumpbody(', wbody: ',wbody) end;
	    emptyst:  begin
		      incrlinecount;
		      writeln(lp,'emptyst':10);
		      end;
	    endofbodyst: begin
			 incrlinecount;
			 writeln(lp,' endofbodyst');
			 end;
	    otherwise begin
		      incrlinecount;
		      writeln(lp,' sclass is garbage: ',ord(sclass):1)
		      end;
	    end (*case*);
	  curstmt := next
	end (*with curstmt^*)
    end (*dumpstmts*);
$END$
  begin (*dumptree*)
  if (initlistmode = listfull) and listopen then
    begin
    incrlinecount;
    writeln(lp);
    incrlinecount;
    writeln(lp,'Dump of ',fprocp^.namep^);
    with display[top] do
      begin
      if occur = MODULEscope then
	begin
	incrlinecount;
	writeln(lp,'Imported:');
	lstate := fmodule^.modinfo^.usemodule;
	  begin
	  dumpsymbol(fmodule^.modinfo^.useids,0);
	  while lstate <> nil do
	    begin
	    dumpsymbol(lstate^.defineids,0);
	    lstate := lstate^.nextmodule;
	    end;
	  end;
	incrlinecount; writeln(lp);
	incrlinecount;
	writeln(lp,'Exported:');
	lstate := fmodule;
	while lstate <> nil do
	  begin dumpsymbol(lstate^.defineids,0);
	  lstate := lstate^.contmodule;
	  end;
	incrlinecount; writeln(lp);
	incrlinecount; writeln(lp);
	end;
      dumpsymbol(fname,0);
      incrlinecount; writeln(lp)
      end;
    $IF FULLDUMP$
    incrlinecount;
    writeln(lp,' SNUM   NEXT  LABEL LINENO     SCLASS');
    dumpstmts(curbody);
    incrlinecount; writeln(lp);
    dumpexprs;
    $END$
    incrlinecount;
    writeln(lp,fprocp^.namep^,' dump complete');
    incrlinecount; writeln(lp);
    if ioresult <> ord(inoerror) then
      begin
      listabort := true;
      list := listnone;
      listopen := false;
      warning(linenumber,'Listing aborted');
      end;
    end;
  end (*dumptree*);



@


55.1
log
@Automatic bump of revision number for PWS version 3.25A
@
text
@@


54.1
log
@Automatic bump of revision number for PWS version 3.24
@
text
@@


53.1
log
@Automatic bump of revision number for PWS version 3.24B
@
text
@@


52.1
log
@Automatic bump of revision number for PWS version 3.24A
@
text
@@


51.1
log
@Automatic bump of revision number for PWS version 3.24d
@
text
@@


50.1
log
@Automatic bump of revision number for PWS version 3.23c
@
text
@@


49.1
log
@Automatic bump of revision number for PWS version 3.24b
@
text
@@


48.1
log
@Automatic bump of revision number for PWS version 3.24a
@
text
@@


47.1
log
@Automatic bump of revision number for PWS version 3.23
@
text
@@


46.1
log
@Automatic bump of revision number for PWS version 3.23
@
text
@@


45.1
log
@Automatic bump of revision number for PWS version 3.23C
@
text
@@


44.1
log
@Automatic bump of revision number for PWS version 3.23B
@
text
@@


43.1
log
@Automatic bump of revision number for PWS version 3.23aA
@
text
@@


42.1
log
@Automatic bump of revision number for PWS version 3.23e
@
text
@@


41.1
log
@Automatic bump of revision number for PWS version 3.23d
@
text
@@


40.1
log
@Automatic bump of revision number for PWS version 3.23c
@
text
@@


39.1
log
@Automatic bump of revision number for PWS version 3.23b
@
text
@@


38.1
log
@Automatic bump of revision number for PWS version 3.23a
@
text
@@


37.2
log
@
 Modified file DUMPTREE at line 206 to repair a defect in the compilers
 listing mechanism.
@
text
@@


37.1
log
@Automatic bump of revision number for PWS version 3.3a
@
text
@d207 2
@


36.1
log
@Automatic bump of revision number for PWS version 3.22
@
text
@@


35.1
log
@Automatic bump of revision number for PWS version 3.22
@
text
@@


34.1
log
@Automatic bump of revision number for PWS version 3.22
@
text
@@


33.1
log
@Automatic bump of revision number for PWS version 3.22D
@
text
@@


32.1
log
@Automatic bump of revision number for PWS version 3.22C
@
text
@@


31.1
log
@Automatic bump of revision number for PWS version 3.22B
@
text
@@


30.1
log
@Automatic bump of revision number for PWS version 3.22A
@
text
@@


29.1
log
@Automatic bump of revision number for PWS version 3.22b
@
text
@@


28.1
log
@Automatic bump of revision number for PWS version 3.3b
@
text
@@


27.1
log
@Automatic bump of revision number for PWS version 3.3a
@
text
@@


26.1
log
@Automatic bump of revision number for PWS version 3.3 Synch
@
text
@@


25.1
log
@Automatic bump of revision number for PWS version 3.2Y
@
text
@@


24.1
log
@Automatic bump of revision number for PWS version 3.2
@
text
@@


23.1
log
@Automatic bump of revision number for PWS version 3.2P
@
text
@@


22.1
log
@Automatic bump of revision number for PWS version 3.2N
@
text
@@


21.1
log
@Automatic bump of revision number for PWS version 3.2M
@
text
@@


20.1
log
@Automatic bump of revision number for PWS version 3.2L
@
text
@@


19.1
log
@Automatic bump of revision number for PWS version 3.2K
@
text
@@


18.1
log
@Automatic bump of revision number for PWS version 3.2J
@
text
@@


17.1
log
@Automatic bump of revision number for PWS version 3.2I+
@
text
@@


16.1
log
@Automatic bump of revision number for PWS version 3.2I
@
text
@@


15.1
log
@Automatic bump of revision number for PWS version 3.2H
@
text
@@


14.1
log
@Automatic bump of revision number for PWS version 3.2G
@
text
@@


13.1
log
@Automatic bump of revision number for PWS version 3.2F
@
text
@@


12.1
log
@Automatic bump of revision number for PWS version 3.2E
@
text
@@


11.1
log
@Automatic bump of revision number for PWS version 3.2D
@
text
@@


10.1
log
@Automatic bump of revision number for PWS version 3.2C
@
text
@@


9.1
log
@Automatic bump of revision number for PWS version 3.2B
@
text
@@


8.1
log
@Automatic bump of revision number for PWS version 3.2A
@
text
@@


7.1
log
@Automatic bump of revision number for PWS version 3.2l
@
text
@@


6.1
log
@Automatic bump of revision number for PWS version 3.2k
@
text
@@


5.1
log
@Automatic bump of revision number for PWS version 3.2j
@
text
@@


4.1
log
@Automatic bump of revision number for PWS version 3.2i
@
text
@@


3.1
log
@Automatic bump of revision number for PWS version 3.2h
@
text
@@


2.1
log
@Auto bump rev number to 2.1 for sys 3.2e.
@
text
@@


1.1
log
@Initial revision
@
text
@@
