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


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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

38.1
date     89.08.29.11.10.41;  author jwh;  state Exp;
branches ;
next     37.1;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

14.1
date     87.04.01.14.05.36;  author jws;  state Exp;
branches ;
next     13.2;

13.2
date     87.03.23.14.26.53;  author larry;  state Exp;
branches ;
next     13.1;

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

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

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

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

9.1
date     86.12.12.13.22.14;  author bayes;  state Exp;
branches ;
next     8.2;

8.2
date     86.12.09.11.32.47;  author jws;  state Exp;
branches ;
next     8.1;

8.1
date     86.11.27.11.03.14;  author jws;  state Exp;
branches ;
next     7.2;

7.2
date     86.11.25.14.48.14;  author jws;  state Exp;
branches ;
next     7.1;

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

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

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

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

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

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

1.1
date     86.06.30.12.58.57;  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
@$if mc68881$

procedure pass2fpops;

  function getsysflags( var opd : operand ) : boolean;
    begin
      getsysflags := false;
      if not ((sizesuffix = ' ') or (sizesuffix = 'L')) then
	error( errbadsize );
      sizesuffix := 'L';
      size := 4;
      if setfpsysflag( opd, true, fpsysflag ) then
	begin
	  getsysflags := true;
	  if line[ curcol ] = '/' then
	    begin
	      curcol := curcol + 1;
	      parseoperand( opd );
	      if not setfpsysflag( opd, true, fpsysflag ) then
		getsysflags := false
	      else
		if line[ curcol ] = '/' then
		 begin
		   curcol := curcol + 1;
		   parseoperand( opd );
		   if not setfpsysflag( opd, true, fpsysflag ) then
		     getsysflags := false;
		 end;
	    end;
	end;
    end;        (* getsysflags *)

  procedure fpmoves;
    begin                       (* currop.class = (fpbase+0) assumed *)

	    if currop.name[ 6 ] = 'M' then
	      begin                                             (* FMOVEM *)
	      TRY
		if operand1.mode = 9 then
		  begin                         (* source system regs *)
		    if not getsysflags( operand1 ) then
		      escape( badops );
		    if line[ curcol ] <> ',' then
		      begin
			error( errcommaexp );
			escape( badops );
		      end;
		    curcol := curcol + 1;
		    parseoperand( operand2 );
		    if not (memalt( operand2 ) or
			    ((fpsysflag=1) and (operand2.mode<=1)) or
			    ((fpsysflag=2) and (operand2.mode =0)) or
			    ((fpsysflag=4) and (operand2.mode =0))
			   ) then
		      begin
			error( errbadmode );
			escape( badops );
		      end;
		  end                           (* source system regs *)
		else
		  if operand1.mode = 8 then
		    begin                       (* source FPi regs *)
		      if not ((sizesuffix = ' ') or
				(sizesuffix = 'X') ) then
			begin
			  error( errbadsize );
			end;
		      sizesuffix := 'X';
		      size := 12;
		      fpmovem( true, true );
		    end                         (* source FPi regs *)
		  else
		    if operand1.mode = 0 then
		      begin                     (* Dn,<ea> *)
			if not ((sizesuffix = ' ') or
				(sizesuffix = 'X')) then
			  begin
			    error( errbadsize );
			  end;
			sizesuffix := 'X';
			size := 12;
			if line[ curcol ] <> ',' then
			  begin
			    error( errcommaexp );
			    escape( badops );
			  end;
			curcol := curcol + 1;
			parseoperand( operand2 );
			if not ( (controlmode( operand2 ) and
					alterable( operand2 ) )
				or (operand2.mode = 4) ) then
			  begin
			    error( errbadmode );
			    escape( badops );
			  end;
		      end                       (* Dn,<ea> *)
		    else
		      begin                     (* source <ea> *)
			if line[ curcol ] <> ',' then
			  begin
			    error( errcommaexp );
			    escape( badops );
			  end;
			curcol := curcol + 1;
			parseoperand( operand2 );
			if operand2.mode = 9 then
			  begin                 (* destination system regs *)
			    if not getsysflags( operand2 ) then
			      escape( badops );
			    if not (memmode( operand1 ) { or
				    this needs to be included, but the syntax
				    confusion between

				       FMOVEM Dn,FPCONTROL
					     and
				       FMOVEM Dn,<ea>

				    needs to be fixed first

				    ((fpsysflag=1) and (operand1.mode<=1)) or
				    ((fpsysflag=2) and (operand1.mode =0)) or
				    ((fpsysflag=4) and (operand1.mode =0))
				   {*}
				   ) then
			      begin
				error( errbadmode );
				escape( badops );
			      end;
			    if (operand1.mode = 7) and (operand1.reg = 4) then
				operand1.size := 4;
			  end                   (* destination system regs *)
			else
			  if operand2.mode = 0 then
			    begin                       (* <ea>,Dn *)
			      if not ((sizesuffix = ' ') or
					(sizesuffix = 'X')) then
				begin
				  error( errbadsize );
				end;
			      sizesuffix := 'X';
			      size := 12;
			      if not ( controlmode( operand1 ) or
					(operand1.mode = 3) ) then
				begin
				  error( errbadmode );
				  escape( badops );
				end;
			    end                         (* <ea>,Dn *)
			  else
			    begin               (* destination FPi regs *)
			      if not ((sizesuffix = ' ') or
					(sizesuffix = 'X')) then
				error( errbadsize );
			      sizesuffix := 'X';
			      size := 12;
			      if not ( controlmode( operand1 )
					or (operand1.mode = 3) ) then
				begin
				  error( errbadmode );
				  escape( badops );
				end;
			      fpmovem( false, true );
			    end;                (* destination FPi regs *)
		      end;                      (* source <ea> *)
		escape( opsok );
	      RECOVER
		if escapecode = badops then
		  begin
		    operand1.mode := 0;
		    operand1.reg := 0;
		    operand1.size := 0;
		    operand2.mode := 2;
		    operand2.reg := 0;
		    operand2.size := 0;
		  end
		else if escapecode <> opsok then
		  escape( escapecode );
		locctb.longint := locctb.longint
					 + operand1.size + operand2.size;
	      end                                               (* FMOVEM *)
	    else
	      if (currop.name[ 6 ] = 'C') and (currop.name[ 7 ] = 'R') then
		begin                                           (* FMOVECR *)
		TRY
		  if not ((sizesuffix = ' ') or (sizesuffix = 'X')) then
		    error( errbadsize );
		  sizesuffix := 'X';
		  size := 12;
		  if not ((operand1.mode = 7) and (operand1.reg = 4)) then
		    begin
		      error( errbadmode );
		      escape( badops );
		    end;
		  if (operand1.value.offset.longint < 0) or
			(operand1.value.offset.longint > fpromconstmax)
			then
		    begin
		      error( errfpromconst );
		      operand1.value.offset.longint := 0;
		    end;
		  if line[ curcol ] <> ',' then
		    begin
		      error( errcommaexp );
		      escape( badops );
		    end;
		  curcol := curcol + 1;
		  parseoperand( operand2 );
		  if operand2.mode <> 8 then
		    begin
		      error( errfpregneeded );
		      escape( badops );
		    end;
		  escape( opsok );
		RECOVER
		  if escapecode = badops then
		    begin
		      operand1.mode := 7;
		      operand1.reg := 4;
		      operand1.size := 2;
		      operand1.value.offset.longint := 0;
		      operand2.mode := 8;
		      operand2.reg := 0;
		      operand2.size := 0;
		    end
		  else
		    if escapecode <> opsok then
		      escape( escapecode );
		end                                             (* FMOVECR *)
	      else
		begin                                           (* FMOVE *)
		TRY
		  if line[ curcol ] <> ',' then
		    begin
		      error( errcommaexp );
		      escape( badops );
		    end;
		  curcol := curcol + 1;
		  parseoperand( operand2 );
		  if (operand1.mode = 9) or (operand2.mode = 9) then
		    begin                               (* system reg(s) *)
		      if not ((sizesuffix = ' ') or (sizesuffix = 'L')) then
			 error( errbadsize );
		      sizesuffix := 'L';
		      size := 4;
		      if operand1.mode = 9 then
			begin                   (* source system reg *)
			  if operand1.reg < 2 then
			    begin       (* CONTROL or STATUS *)
			      if not datalterable( operand2 ) then
				begin
				  error( errbadmode );
				  escape( badops );
				end;
			    end
			  else
			    begin       (* IADDR *)
			      if not alterable( operand2 ) then
				begin
				  error( errbadmode );
				  escape( badops );
				end;
			    end;
			  if not setfpsysflag(operand1,true,fpsysflag) then
			    escape( badops );
			end
		      else
			begin           (* destination system reg *)
			  if operand2.reg < 2 then
			    begin       (* CONTROL or STATUS *)
			      if not datamode( operand1 ) then
				begin
				  error( errbadmode );
				  escape( badops );
				end;
			    end;
			  if (operand1.mode = 7) and (operand1.reg = 4) then
			    operand1.size := 4;
			  if not setfpsysflag(operand2,true,fpsysflag) then
			    escape( badops );
			end;
		    end                         (* system reg(s) *)
		  else
		    begin                       (* not system reg(s) *)
		      if operand1.mode = 8 then
			begin                           (* source FPn *)
			  if (line[ curcol ] = '{') or
			      (sizesuffix = 'P') then
			    begin       (* FPn,<ea>(#k) or FPn,<ea>(Dn) *)
			      if not memalt( operand2 ) then
				begin
				  error( errbadmode );
				  escape( badops );
				end;
			      if not ((sizesuffix = ' ') or
					(sizesuffix = 'P')) then
				begin
				  error( errbadsize );
				  escape( badops );
				end;
			      sizesuffix := 'P';
			      size := 12;
			      if line[ curcol ] = '{' then
				begin                   (* explicit k *)
				  curcol := curcol + 1;
				  parseoperand( operand3 );
				  if (operand3.mode = 7) and
					(operand3.reg = 4) then
				    begin                    (* static k *)
				      if not ((operand3.value.offset.longint
					      > -64) or
					    (operand3.value.offset.longint
						< 17)) then
					begin
					  error( errbadfpk );
					  operand3.value.offset.longint := -16;
					end;
				    end
				  else
				    if operand3.mode <> 0 then
				      begin          (* dynamic k *)
					error( errbadfpk );
					escape( badops );
				      end;
				  if line[ curcol ] <> '}' then
				    begin
				      error( errbadsyntax );
				      escape( badops );
				    end;
				  curcol := curcol + 1;
				end                     (* explicit k *)
			      else
				begin                   (* default (#k) *)
				  operand3.mode := 7;
				  operand3.reg := 4;
				  operand3.size := 2;
				  operand3.value.offset.longint := -16;
				end;
			    end         (* FPn,<ea>(#k) or FPn,<ea>(Dn) *)
			  else
			    begin
			      if operand2.mode = 8 then
				begin                           (* FPn,FPm *)
				  if not ((sizesuffix = ' ') or
					(sizesuffix = 'X')) then
				    error( errbadsize );
				  sizesuffix := 'X';
				  size := 12;
				  if operand1.reg = operand2.reg then
				    begin
				      error( errdifffpregneeded );
				      escape( badops );
				    end;
				end
			      else
				begin                   (* FPn,<ea> *)
				  if (sizesuffix = 'D') or
					(sizesuffix = 'X') then
				    begin
				      if not memalt( operand2 ) then
					begin
					  error( errbadmode );
					  escape( badops );
					end;
				    end
				  else
				    begin
				      if not datalterable( operand2 ) then
					begin
					  error( errbadmode );
					  escape( badops );
					end;
				    end;
				end;
			    end;
			end                     (* source FPn *)
		      else
			if operand2.mode = 8 then
			  begin                 (* destination FPn *)
			    if (sizesuffix = 'D') or
				(sizesuffix = 'X') or
				(sizesuffix = 'P') then
			      begin
				if not memmode( operand1 ) then
				  begin
				    error( errbadmode );
				    escape( badops );
				  end;
			      end
			    else
			      begin
				if not datamode( operand1 ) then
				  begin
				    error( errbadmode );
				    escape( badops );
				  end;
			      end;
			  end                   (* destination FPn *)
			else
			  begin
			    error( errfpregneeded );
			    escape( badops );
			  end;
		    end;                         (* not system reg(s) *)
		  escape( opsok );
		RECOVER
		  if escapecode = badops then
		    begin
		      operand1.mode := 2;
		      operand1.reg := 0;
		      operand1.size := 0;
		      operand2.mode := 8;
		      operand2.reg := 0;
		      operand2.size := 0;
		    end
		  else if escapecode <> opsok then
		    escape( escapecode );
		  locctb.longint := locctb.longint
					 + operand1.size + operand2.size;
		end;                                    (* FMOVE *)
    end;  (* fpmoves *)



begin   (* pass2fpops *)

  allowfpopds := true;

  if (currop.class >= fpbase) and (currop.class <= fpgentop) then
    begin                         (* "general class" instructions *)
	fpsysflag := 0;
	with operand3 do
	  begin
	    mode := 1;          (* acts as no-op flag for fpcodegen() *)
	    reg := 0;
	    size := 0;
	  end;
	locctb.longint := locctr.longint + 4;
      TRY
	parseoperand( operand1 );
	if currop.class = ( fpbase + 0 ) then
	  fpmoves
	else
	  if currop.class = fpbase + 48 then
	    begin                                       (* FSINCOS *)
	    TRY
	      if line[ curcol ] <> ',' then
		begin
		  error( errbadsyntax );
		  escape( badops );
		end;
	      curcol := curcol + 1;
	      fpreadmode := true;
	      parseoperand( operand2 );
	      fpreadmode := false;
	      if line[ curcol ] <> ':' then
		begin
		  error( errbadsyntax );
		  escape( badops );
		end;
	      curcol := curcol + 1;
	      parseoperand( operand3 );
	      if (operand2.mode <> 8) or (operand3.mode <> 8) then
		begin
		  error( errfpregneeded );
		  escape( badops );
		end;
	      if operand2.reg = operand3.reg then
		begin
		  error( errdifffpregneeded );
		  escape( badops );
		end;
	      if operand1.mode = 8 then
		begin
		  if (sizesuffix <> ' ') and (sizesuffix <> 'X') then
		    error( errbadsize );
		  sizesuffix := 'X';
		  size := 12;
		end
	      else
		if sizesuffix in [ 'D', 'X', 'P' ] then
		  begin
		    if not memmode( operand1 ) then
		      begin
			error( errbadmode );
			escape( badops );
		      end;
		  end
		else
		  if not datamode( operand1 ) then
		    begin
		      error( errbadmode );
		      escape( badops );
		    end;
	      escape( opsok );
	    RECOVER
	      if escapecode = badops then
		begin
		  operand1.mode := 8;
		  operand1.reg := 0;
		  operand1.size := 0;
		  operand2.mode := 8;
		  operand2.reg := 1;
		  operand2.size := 0;
		  operand3.mode := 8;
		  operand3.reg := 2;
		  operand3.size := 0;
		end
	      else
		if escapecode <> opsok then
		  escape( escapecode );
	      locctb.longint := locctb.longint + operand1.size;
	    end                                         (* FSINCOS *)
	  else
	    begin                               (* F<mop>s, F<dops>s *)
	      if line[ curcol ] = ',' then
		begin                                   (* two operands *)
		  if currop.class = (fpbase + 58) then
		    begin               (* FTEST *)
		      error( errbadsyntax );
		      escape( badops );
		    end;
		  curcol := curcol + 1;
		  parseoperand( operand2 );
		  if operand1.mode = 8 then
		    begin                       (* source FPn *)
		      if operand2.mode = 8 then
			 begin                  (* FPn, FPm *)
		   (* I think this code is wrong.  LAF 850714
			   if not ((currop.class > (fpbase+0)) and
				(currop.class < (fpbase+32))) then
			     begin              (* not monadic op * )
			       if operand1.reg = operand2.reg then
				 begin
				   error( errdifffpregneeded );
				   escape( badops );
				 end;
			     end;
		   (**)
			   if (currop.class = (fpbase+36))
			       or (currop.class = (fpbase+39)) then
			     begin      (* FSGLDIV or FSGLMUL *)
			       if not ( (sizesuffix = ' ') or
				     (* LAF 870320 default/allowed should
					be X, not S *)
				     (* (sizesuffix = 'S') ) then *)
					(sizesuffix = 'X') ) then
				 error( errbadsize );
			    (* LAF 870320 *)
			    (* sizesuffix := 'S'; *)
			       sizesuffix := 'X';
			       size := 12;
			     end
			   else
			     begin
				if not ((sizesuffix = ' ') or
					(sizesuffix = 'X')) then
				  error( errbadsize );
			       sizesuffix := 'X';
			       size := 12;
			     end;
			 end                    (* FPn,FPm *)
			else
			  begin
			    error( errfpregneeded );
			    escape( badops );
			  end;
		    end                         (* source FPn *)
		  else
		    if operand2.mode = 8 then
		      begin                     (* <ea>, FPn *)
			if (currop.class = (fpbase+36)) or
				(currop.class = (fpbase+39)) then
			  begin                 (* fsglmul or fsgldiv *)
      (* ??? see pgs 62, 248, and 253 of
	 prelim. 881 manual, may be only 'S' is
	 allowed *) (* LAF 861120 FSDlg00784
			    if (sizesuffix = 'D') or
					(sizesuffix = 'X') then
			      begin
				error( errbadsize );
				sizesuffix := 'S';
				size := 4;
			      end;
      *)
			  end;
			if (sizesuffix = 'D') or (sizesuffix = 'X')
				or (sizesuffix = 'P') then
			  begin
			    if not memmode( operand1 ) then
			      begin
				error( errbadmode );
				escape( badops );
			      end;
			  end
			else if not datamode( operand1 ) then
			  begin
			    error( errbadmode );
			    escape( badops );
			  end;
		      end                       (* <ea>,FPn *)
		    else
		      begin
			error( errfpregneeded );
			escape( badops );
		      end;
		end                                     (* two operands *)
	      else
		begin                                   (* one operand *)
		 if currop.class = (fpbase+58) then
		  begin                         (* FTEST *)
		    if operand1.mode = 9 then
		      begin
			error( errbadmode );
			escape( badops );
		      end
		    else
		      if operand1.mode = 8 then
			begin
			  operand2 := operand1;   (* makes fpcodegen() work *)
			  if (sizesuffix <> ' ') and (sizesuffix <> 'X') then
			    error( errbadsize );
			  sizesuffix := 'X';
			  size := 12;
			end
		      else
			begin
			  operand2.mode := 8;
			  operand2.reg := 6;  (* FPn makes fpcodegen work *)
			  operand2.size := 0;
			  if sizesuffix in [ 'D', 'X', 'P' ] then
			    begin
			      if not memmode( operand1 ) then
				begin
				  error( errbadmode );
				  escape( badops );
				end;
			    end
			  else
			    if not datamode( operand1 ) then
			      begin
				error( errbadmode );
				escape( badops );
			      end;
			end;
		  end                           (* FTEST *)
		 else
		  begin                         (* not FTEST *)
		    if operand1.mode <> 8 then
		      begin
			error( errfpregneeded );
			escape( badops );
		      end;
		    if not ( (currop.class > (fpbase + 0))
			    and (currop.class < (fpbase + 32)) ) then
		      begin                     (* not monadic op *)
			error( errfpmonadicneeded );
			escape( badops );
		      end;
		    operand2 := operand1;
		    if (sizesuffix <> ' ') and (sizesuffix <> 'X') then
		      error( errbadsize );
		    sizesuffix := 'X';
		    size := 12;
		  end;                            (* not FTEST *)
		end;                                    (* one operand *)
	      locctb.longint := locctb.longint + operand1.size + operand2.size;
	    end;                                        (* F<mop>s, F<dops>s *)

	if line[ curcol ] <> ' ' then error( erreolexp );
	escape( opsok );
      RECOVER
	if escapecode = badops then
	  begin
	    if currop.class = (fpbase+58) then
	      begin             (* ftest *)
		operand1.mode := 2;
		operand1.reg := 0;
	      end
	    else
	      begin
		operand1.mode := 8;
		operand1.reg := 0;
	      end;
	    operand1.size := 0;
	    operand2.mode := 8;
	    operand2.reg := 1;
	    operand2.size := 0;
	    (* LAF 870320 default should be X
	    if (currop.class = (fpbase+36)) or
		(currop.class = (fpbase+39)) then
	      begin                     (* fsgldiv or fsglmul * )
		sizesuffix := 'S';
		size := 4;
	      end
	    else
	    *)
	      begin
		sizesuffix := 'X';
		size := 12;
	      end;
	  end
	else if escapecode <> opsok then escape( escapecode );
	codegen;
	listinst( 1 );
	locctr.longint := locctb.longint;
    end                            (* "general class" instructions *)

  else if (currop.class >= (fpbase+fpbrbase))
	and (currop.class <= (fpbase+fpbrbase+31)) then

    begin                       (* FDBcc, FScc, FTcc, and FTPcc *)
     if currop.code = -4024 then                (* FDBcc *)
       begin
       TRY
	 parseoperand( operand1 );
	 if operand1.mode <> 0 then
	   begin
	     error( errbadmode );
	     escape(badops );
	   end;
	 if line[ curcol ] <> ',' then
	   begin
	     error( errcommaexp );
	     escape( badops );
	   end;
	 curcol := curcol + 1;
	 express( true, evalok, evalue, curcol );

	 (* ??? must be relative, as opposed to absolute ? *)

	 evalue.offset.longint := evalue.offset.longint
					- ( 4 + locctr.longint );
	 operand2.value := evalue;
	 if ( evalue.exprefs = NIL ) and
		(not fitsin16( evalue.offset ) ) then
	   error( errfieldoflo );
	 if line[ curcol ] <> ' ' then error( erreolexp );
	 escape( opsok );
       RECOVER
	 if escapecode = badops then
	   begin
	     operand1.mode := 0;
	     operand1.reg := 0;
	     operand1.size := 0;
	     operand2.value.offset := zero32;
	     operand2.value.exprefs := NIL;
	   end
	 else if escapecode <> opsok then
	   escape( escapecode );
	 codegen;
	 listinst( 1 );
	 locctr.longint := locctr.longint + 6;
       end
     else if currop.code = -4032 then           (* FScc *)
       begin
       TRY
	 parseoperand( operand1 );
	 if not datalterable( operand1 ) then
	   begin
	     error( errbadmode );
	     escape( badops );
	   end;
	 if line[ curcol ] <> ' ' then
	   error( erreolexp );
	 escape( opsok );
       RECOVER
	 if escapecode = badops then
	   begin
	     operand1.mode := 2;
	     operand1.reg := 0;
	     operand1.size := 0;
	   end
	 else if escapecode <> opsok then
	   escape( escapecode );
	 codegen;
	 listinst( 1 );
	 locctr.longint := locctr.longint + 4 + operand1.size;
       end
     else if currop.code = -3972 then           (* FTcc *)
       begin
	 codegen;
	 listinst( 1 );
	 locctr.longint := locctr.longint + 4;
       end
     else if currop.code = -3974 then           (* FTPcc *)
       begin
       TRY
	 parseoperand( operand1 );
	 if not ( (operand1.mode = 7) and (operand1.reg = 4) ) then
	   begin
	     error( errbadmode );
	     escape( badops );
	   end;
	 if line[ curcol ] <> ' ' then
	   error( erreolexp );
	 escape( opsok );
       RECOVER
	 if escapecode = badops then
	   begin
	     operand1.mode := 7;
	     operand1.reg := 4;
	     operand1.size := 2;
	     operand1.value.offset := zero32;
	   end
	 else if escapecode <> opsok then
	   escape( escapecode );
	 codegen;
	 listinst( 1 );
	 locctr.longint := locctr.longint + 4 + operand1.size;
       end
     else
       error( errfpinternalerr );
    end                         (* FDBcc, FScc, FTcc, and FTPcc *)

  else if currop.class = (fpbase+fpbrbase+32) then
    begin                                               (* FBcc *)
   TRY
     express( true, evalok, evalue, curcol );

     (* ??? must be relative, as opposed to absolute ? *)

     evalue.offset.longint := evalue.offset.longint
					- ( 2 + locctr.longint );
     if (sizesuffix = 'W') or (sizesuffix = ' ') then
       begin
	 if (evalue.exprefs = NIL)
		and not ( (evalue.base=absolut) and (pcmode = rel) )
		and not ( (evalue.base=relative) and (pcmode=abs) )
		and not fitsin16( evalue.offset ) then
	   begin
	     operand1.size := 4;
	     if sizesuffix = 'W' then
	       error( errfieldoflo );
	   end
	 else
	   operand1.size := 2;
       end
     else
       operand1.size := 4;
     escape( opsok );
   RECOVER
    if ( escapecode <> badops ) and ( escapecode <> opsok ) then
	escape( escapecode )
    else
      if escapecode = opsok then
	if line[curcol ] <> ' ' then
	  error( erreolexp );
    operand1.value := evalue;
    codegen;
    listinst( 1 );
    locctr.longint := locctr.longint + 2 + operand1.size;
   end                                                  (* FBcc *)

 else if (currop.class = (fpbase+fpbrbase+33))
	or (currop.class = (fpbase+fpbrbase+34)) then
   begin                                        (* FSAVE or FRESTORE *)
   TRY
     size := 2;
     parseoperand( operand1 );
     if ( (currop.class = (fpbase+fpbrbase+33)) and       (* save *)
	  not ( (controlmode( operand1 ) and alterable( operand1))
		 or (operand1.mode = 4) ) )             (* restore *)
	or ( (currop.class = (fpbase+fpbrbase+34)) and
	     not (controlmode( operand1 ) or (operand1.mode = 3)) ) then
      begin
	error( errbadmode );
	escape( badops );
      end;
     if line[ curcol ] <> ' ' then error( erreolexp );
     escape( opsok );
   RECOVER
     if escapecode = badops then
       begin
	 operand1.mode := 2;
	 operand1.reg := 0;
	 operand1.size := 0;
       end
     else if escapecode <> opsok then
       escape( escapecode );
     codegen;
     listinst( 1 );
     locctr.longint := locctr.longint + 2 + operand1.size;
   end                                          (* FSAVE or FRESTORE *)

 else if currop.class = (fpbase+fpbrbase+35) then
   begin                                                (* FNOP *)
     size := 4;
     codegen;
     listinst( 1 );
     locctr.longint := locctr.longint + 4;
   end                                                  (* FNOP *)

  else
    error( errfpinternalerr );

  allowfpopds := false;

end;    (* pass2fpops *)
$end$

@


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


56.1
log
@Automatic bump of revision number for PWS version 3.25
@
text
@a0 900
$if mc68881$

procedure pass2fpops;

  function getsysflags( var opd : operand ) : boolean;
    begin
      getsysflags := false;
      if not ((sizesuffix = ' ') or (sizesuffix = 'L')) then
	error( errbadsize );
      sizesuffix := 'L';
      size := 4;
      if setfpsysflag( opd, true, fpsysflag ) then
	begin
	  getsysflags := true;
	  if line[ curcol ] = '/' then
	    begin
	      curcol := curcol + 1;
	      parseoperand( opd );
	      if not setfpsysflag( opd, true, fpsysflag ) then
		getsysflags := false
	      else
		if line[ curcol ] = '/' then
		 begin
		   curcol := curcol + 1;
		   parseoperand( opd );
		   if not setfpsysflag( opd, true, fpsysflag ) then
		     getsysflags := false;
		 end;
	    end;
	end;
    end;        (* getsysflags *)

  procedure fpmoves;
    begin                       (* currop.class = (fpbase+0) assumed *)

	    if currop.name[ 6 ] = 'M' then
	      begin                                             (* FMOVEM *)
	      TRY
		if operand1.mode = 9 then
		  begin                         (* source system regs *)
		    if not getsysflags( operand1 ) then
		      escape( badops );
		    if line[ curcol ] <> ',' then
		      begin
			error( errcommaexp );
			escape( badops );
		      end;
		    curcol := curcol + 1;
		    parseoperand( operand2 );
		    if not (memalt( operand2 ) or
			    ((fpsysflag=1) and (operand2.mode<=1)) or
			    ((fpsysflag=2) and (operand2.mode =0)) or
			    ((fpsysflag=4) and (operand2.mode =0))
			   ) then
		      begin
			error( errbadmode );
			escape( badops );
		      end;
		  end                           (* source system regs *)
		else
		  if operand1.mode = 8 then
		    begin                       (* source FPi regs *)
		      if not ((sizesuffix = ' ') or
				(sizesuffix = 'X') ) then
			begin
			  error( errbadsize );
			end;
		      sizesuffix := 'X';
		      size := 12;
		      fpmovem( true, true );
		    end                         (* source FPi regs *)
		  else
		    if operand1.mode = 0 then
		      begin                     (* Dn,<ea> *)
			if not ((sizesuffix = ' ') or
				(sizesuffix = 'X')) then
			  begin
			    error( errbadsize );
			  end;
			sizesuffix := 'X';
			size := 12;
			if line[ curcol ] <> ',' then
			  begin
			    error( errcommaexp );
			    escape( badops );
			  end;
			curcol := curcol + 1;
			parseoperand( operand2 );
			if not ( (controlmode( operand2 ) and
					alterable( operand2 ) )
				or (operand2.mode = 4) ) then
			  begin
			    error( errbadmode );
			    escape( badops );
			  end;
		      end                       (* Dn,<ea> *)
		    else
		      begin                     (* source <ea> *)
			if line[ curcol ] <> ',' then
			  begin
			    error( errcommaexp );
			    escape( badops );
			  end;
			curcol := curcol + 1;
			parseoperand( operand2 );
			if operand2.mode = 9 then
			  begin                 (* destination system regs *)
			    if not getsysflags( operand2 ) then
			      escape( badops );
			    if not (memmode( operand1 ) { or
				    this needs to be included, but the syntax
				    confusion between

				       FMOVEM Dn,FPCONTROL
					     and
				       FMOVEM Dn,<ea>

				    needs to be fixed first

				    ((fpsysflag=1) and (operand1.mode<=1)) or
				    ((fpsysflag=2) and (operand1.mode =0)) or
				    ((fpsysflag=4) and (operand1.mode =0))
				   {*}
				   ) then
			      begin
				error( errbadmode );
				escape( badops );
			      end;
			    if (operand1.mode = 7) and (operand1.reg = 4) then
				operand1.size := 4;
			  end                   (* destination system regs *)
			else
			  if operand2.mode = 0 then
			    begin                       (* <ea>,Dn *)
			      if not ((sizesuffix = ' ') or
					(sizesuffix = 'X')) then
				begin
				  error( errbadsize );
				end;
			      sizesuffix := 'X';
			      size := 12;
			      if not ( controlmode( operand1 ) or
					(operand1.mode = 3) ) then
				begin
				  error( errbadmode );
				  escape( badops );
				end;
			    end                         (* <ea>,Dn *)
			  else
			    begin               (* destination FPi regs *)
			      if not ((sizesuffix = ' ') or
					(sizesuffix = 'X')) then
				error( errbadsize );
			      sizesuffix := 'X';
			      size := 12;
			      if not ( controlmode( operand1 )
					or (operand1.mode = 3) ) then
				begin
				  error( errbadmode );
				  escape( badops );
				end;
			      fpmovem( false, true );
			    end;                (* destination FPi regs *)
		      end;                      (* source <ea> *)
		escape( opsok );
	      RECOVER
		if escapecode = badops then
		  begin
		    operand1.mode := 0;
		    operand1.reg := 0;
		    operand1.size := 0;
		    operand2.mode := 2;
		    operand2.reg := 0;
		    operand2.size := 0;
		  end
		else if escapecode <> opsok then
		  escape( escapecode );
		locctb.longint := locctb.longint
					 + operand1.size + operand2.size;
	      end                                               (* FMOVEM *)
	    else
	      if (currop.name[ 6 ] = 'C') and (currop.name[ 7 ] = 'R') then
		begin                                           (* FMOVECR *)
		TRY
		  if not ((sizesuffix = ' ') or (sizesuffix = 'X')) then
		    error( errbadsize );
		  sizesuffix := 'X';
		  size := 12;
		  if not ((operand1.mode = 7) and (operand1.reg = 4)) then
		    begin
		      error( errbadmode );
		      escape( badops );
		    end;
		  if (operand1.value.offset.longint < 0) or
			(operand1.value.offset.longint > fpromconstmax)
			then
		    begin
		      error( errfpromconst );
		      operand1.value.offset.longint := 0;
		    end;
		  if line[ curcol ] <> ',' then
		    begin
		      error( errcommaexp );
		      escape( badops );
		    end;
		  curcol := curcol + 1;
		  parseoperand( operand2 );
		  if operand2.mode <> 8 then
		    begin
		      error( errfpregneeded );
		      escape( badops );
		    end;
		  escape( opsok );
		RECOVER
		  if escapecode = badops then
		    begin
		      operand1.mode := 7;
		      operand1.reg := 4;
		      operand1.size := 2;
		      operand1.value.offset.longint := 0;
		      operand2.mode := 8;
		      operand2.reg := 0;
		      operand2.size := 0;
		    end
		  else
		    if escapecode <> opsok then
		      escape( escapecode );
		end                                             (* FMOVECR *)
	      else
		begin                                           (* FMOVE *)
		TRY
		  if line[ curcol ] <> ',' then
		    begin
		      error( errcommaexp );
		      escape( badops );
		    end;
		  curcol := curcol + 1;
		  parseoperand( operand2 );
		  if (operand1.mode = 9) or (operand2.mode = 9) then
		    begin                               (* system reg(s) *)
		      if not ((sizesuffix = ' ') or (sizesuffix = 'L')) then
			 error( errbadsize );
		      sizesuffix := 'L';
		      size := 4;
		      if operand1.mode = 9 then
			begin                   (* source system reg *)
			  if operand1.reg < 2 then
			    begin       (* CONTROL or STATUS *)
			      if not datalterable( operand2 ) then
				begin
				  error( errbadmode );
				  escape( badops );
				end;
			    end
			  else
			    begin       (* IADDR *)
			      if not alterable( operand2 ) then
				begin
				  error( errbadmode );
				  escape( badops );
				end;
			    end;
			  if not setfpsysflag(operand1,true,fpsysflag) then
			    escape( badops );
			end
		      else
			begin           (* destination system reg *)
			  if operand2.reg < 2 then
			    begin       (* CONTROL or STATUS *)
			      if not datamode( operand1 ) then
				begin
				  error( errbadmode );
				  escape( badops );
				end;
			    end;
			  if (operand1.mode = 7) and (operand1.reg = 4) then
			    operand1.size := 4;
			  if not setfpsysflag(operand2,true,fpsysflag) then
			    escape( badops );
			end;
		    end                         (* system reg(s) *)
		  else
		    begin                       (* not system reg(s) *)
		      if operand1.mode = 8 then
			begin                           (* source FPn *)
			  if (line[ curcol ] = '{') or
			      (sizesuffix = 'P') then
			    begin       (* FPn,<ea>(#k) or FPn,<ea>(Dn) *)
			      if not memalt( operand2 ) then
				begin
				  error( errbadmode );
				  escape( badops );
				end;
			      if not ((sizesuffix = ' ') or
					(sizesuffix = 'P')) then
				begin
				  error( errbadsize );
				  escape( badops );
				end;
			      sizesuffix := 'P';
			      size := 12;
			      if line[ curcol ] = '{' then
				begin                   (* explicit k *)
				  curcol := curcol + 1;
				  parseoperand( operand3 );
				  if (operand3.mode = 7) and
					(operand3.reg = 4) then
				    begin                    (* static k *)
				      if not ((operand3.value.offset.longint
					      > -64) or
					    (operand3.value.offset.longint
						< 17)) then
					begin
					  error( errbadfpk );
					  operand3.value.offset.longint := -16;
					end;
				    end
				  else
				    if operand3.mode <> 0 then
				      begin          (* dynamic k *)
					error( errbadfpk );
					escape( badops );
				      end;
				  if line[ curcol ] <> '}' then
				    begin
				      error( errbadsyntax );
				      escape( badops );
				    end;
				  curcol := curcol + 1;
				end                     (* explicit k *)
			      else
				begin                   (* default (#k) *)
				  operand3.mode := 7;
				  operand3.reg := 4;
				  operand3.size := 2;
				  operand3.value.offset.longint := -16;
				end;
			    end         (* FPn,<ea>(#k) or FPn,<ea>(Dn) *)
			  else
			    begin
			      if operand2.mode = 8 then
				begin                           (* FPn,FPm *)
				  if not ((sizesuffix = ' ') or
					(sizesuffix = 'X')) then
				    error( errbadsize );
				  sizesuffix := 'X';
				  size := 12;
				  if operand1.reg = operand2.reg then
				    begin
				      error( errdifffpregneeded );
				      escape( badops );
				    end;
				end
			      else
				begin                   (* FPn,<ea> *)
				  if (sizesuffix = 'D') or
					(sizesuffix = 'X') then
				    begin
				      if not memalt( operand2 ) then
					begin
					  error( errbadmode );
					  escape( badops );
					end;
				    end
				  else
				    begin
				      if not datalterable( operand2 ) then
					begin
					  error( errbadmode );
					  escape( badops );
					end;
				    end;
				end;
			    end;
			end                     (* source FPn *)
		      else
			if operand2.mode = 8 then
			  begin                 (* destination FPn *)
			    if (sizesuffix = 'D') or
				(sizesuffix = 'X') or
				(sizesuffix = 'P') then
			      begin
				if not memmode( operand1 ) then
				  begin
				    error( errbadmode );
				    escape( badops );
				  end;
			      end
			    else
			      begin
				if not datamode( operand1 ) then
				  begin
				    error( errbadmode );
				    escape( badops );
				  end;
			      end;
			  end                   (* destination FPn *)
			else
			  begin
			    error( errfpregneeded );
			    escape( badops );
			  end;
		    end;                         (* not system reg(s) *)
		  escape( opsok );
		RECOVER
		  if escapecode = badops then
		    begin
		      operand1.mode := 2;
		      operand1.reg := 0;
		      operand1.size := 0;
		      operand2.mode := 8;
		      operand2.reg := 0;
		      operand2.size := 0;
		    end
		  else if escapecode <> opsok then
		    escape( escapecode );
		  locctb.longint := locctb.longint
					 + operand1.size + operand2.size;
		end;                                    (* FMOVE *)
    end;  (* fpmoves *)



begin   (* pass2fpops *)

  allowfpopds := true;

  if (currop.class >= fpbase) and (currop.class <= fpgentop) then
    begin                         (* "general class" instructions *)
	fpsysflag := 0;
	with operand3 do
	  begin
	    mode := 1;          (* acts as no-op flag for fpcodegen() *)
	    reg := 0;
	    size := 0;
	  end;
	locctb.longint := locctr.longint + 4;
      TRY
	parseoperand( operand1 );
	if currop.class = ( fpbase + 0 ) then
	  fpmoves
	else
	  if currop.class = fpbase + 48 then
	    begin                                       (* FSINCOS *)
	    TRY
	      if line[ curcol ] <> ',' then
		begin
		  error( errbadsyntax );
		  escape( badops );
		end;
	      curcol := curcol + 1;
	      fpreadmode := true;
	      parseoperand( operand2 );
	      fpreadmode := false;
	      if line[ curcol ] <> ':' then
		begin
		  error( errbadsyntax );
		  escape( badops );
		end;
	      curcol := curcol + 1;
	      parseoperand( operand3 );
	      if (operand2.mode <> 8) or (operand3.mode <> 8) then
		begin
		  error( errfpregneeded );
		  escape( badops );
		end;
	      if operand2.reg = operand3.reg then
		begin
		  error( errdifffpregneeded );
		  escape( badops );
		end;
	      if operand1.mode = 8 then
		begin
		  if (sizesuffix <> ' ') and (sizesuffix <> 'X') then
		    error( errbadsize );
		  sizesuffix := 'X';
		  size := 12;
		end
	      else
		if sizesuffix in [ 'D', 'X', 'P' ] then
		  begin
		    if not memmode( operand1 ) then
		      begin
			error( errbadmode );
			escape( badops );
		      end;
		  end
		else
		  if not datamode( operand1 ) then
		    begin
		      error( errbadmode );
		      escape( badops );
		    end;
	      escape( opsok );
	    RECOVER
	      if escapecode = badops then
		begin
		  operand1.mode := 8;
		  operand1.reg := 0;
		  operand1.size := 0;
		  operand2.mode := 8;
		  operand2.reg := 1;
		  operand2.size := 0;
		  operand3.mode := 8;
		  operand3.reg := 2;
		  operand3.size := 0;
		end
	      else
		if escapecode <> opsok then
		  escape( escapecode );
	      locctb.longint := locctb.longint + operand1.size;
	    end                                         (* FSINCOS *)
	  else
	    begin                               (* F<mop>s, F<dops>s *)
	      if line[ curcol ] = ',' then
		begin                                   (* two operands *)
		  if currop.class = (fpbase + 58) then
		    begin               (* FTEST *)
		      error( errbadsyntax );
		      escape( badops );
		    end;
		  curcol := curcol + 1;
		  parseoperand( operand2 );
		  if operand1.mode = 8 then
		    begin                       (* source FPn *)
		      if operand2.mode = 8 then
			 begin                  (* FPn, FPm *)
		   (* I think this code is wrong.  LAF 850714
			   if not ((currop.class > (fpbase+0)) and
				(currop.class < (fpbase+32))) then
			     begin              (* not monadic op * )
			       if operand1.reg = operand2.reg then
				 begin
				   error( errdifffpregneeded );
				   escape( badops );
				 end;
			     end;
		   (**)
			   if (currop.class = (fpbase+36))
			       or (currop.class = (fpbase+39)) then
			     begin      (* FSGLDIV or FSGLMUL *)
			       if not ( (sizesuffix = ' ') or
				     (* LAF 870320 default/allowed should
					be X, not S *)
				     (* (sizesuffix = 'S') ) then *)
					(sizesuffix = 'X') ) then
				 error( errbadsize );
			    (* LAF 870320 *)
			    (* sizesuffix := 'S'; *)
			       sizesuffix := 'X';
			       size := 12;
			     end
			   else
			     begin
				if not ((sizesuffix = ' ') or
					(sizesuffix = 'X')) then
				  error( errbadsize );
			       sizesuffix := 'X';
			       size := 12;
			     end;
			 end                    (* FPn,FPm *)
			else
			  begin
			    error( errfpregneeded );
			    escape( badops );
			  end;
		    end                         (* source FPn *)
		  else
		    if operand2.mode = 8 then
		      begin                     (* <ea>, FPn *)
			if (currop.class = (fpbase+36)) or
				(currop.class = (fpbase+39)) then
			  begin                 (* fsglmul or fsgldiv *)
      (* ??? see pgs 62, 248, and 253 of
	 prelim. 881 manual, may be only 'S' is
	 allowed *) (* LAF 861120 FSDlg00784
			    if (sizesuffix = 'D') or
					(sizesuffix = 'X') then
			      begin
				error( errbadsize );
				sizesuffix := 'S';
				size := 4;
			      end;
      *)
			  end;
			if (sizesuffix = 'D') or (sizesuffix = 'X')
				or (sizesuffix = 'P') then
			  begin
			    if not memmode( operand1 ) then
			      begin
				error( errbadmode );
				escape( badops );
			      end;
			  end
			else if not datamode( operand1 ) then
			  begin
			    error( errbadmode );
			    escape( badops );
			  end;
		      end                       (* <ea>,FPn *)
		    else
		      begin
			error( errfpregneeded );
			escape( badops );
		      end;
		end                                     (* two operands *)
	      else
		begin                                   (* one operand *)
		 if currop.class = (fpbase+58) then
		  begin                         (* FTEST *)
		    if operand1.mode = 9 then
		      begin
			error( errbadmode );
			escape( badops );
		      end
		    else
		      if operand1.mode = 8 then
			begin
			  operand2 := operand1;   (* makes fpcodegen() work *)
			  if (sizesuffix <> ' ') and (sizesuffix <> 'X') then
			    error( errbadsize );
			  sizesuffix := 'X';
			  size := 12;
			end
		      else
			begin
			  operand2.mode := 8;
			  operand2.reg := 6;  (* FPn makes fpcodegen work *)
			  operand2.size := 0;
			  if sizesuffix in [ 'D', 'X', 'P' ] then
			    begin
			      if not memmode( operand1 ) then
				begin
				  error( errbadmode );
				  escape( badops );
				end;
			    end
			  else
			    if not datamode( operand1 ) then
			      begin
				error( errbadmode );
				escape( badops );
			      end;
			end;
		  end                           (* FTEST *)
		 else
		  begin                         (* not FTEST *)
		    if operand1.mode <> 8 then
		      begin
			error( errfpregneeded );
			escape( badops );
		      end;
		    if not ( (currop.class > (fpbase + 0))
			    and (currop.class < (fpbase + 32)) ) then
		      begin                     (* not monadic op *)
			error( errfpmonadicneeded );
			escape( badops );
		      end;
		    operand2 := operand1;
		    if (sizesuffix <> ' ') and (sizesuffix <> 'X') then
		      error( errbadsize );
		    sizesuffix := 'X';
		    size := 12;
		  end;                            (* not FTEST *)
		end;                                    (* one operand *)
	      locctb.longint := locctb.longint + operand1.size + operand2.size;
	    end;                                        (* F<mop>s, F<dops>s *)

	if line[ curcol ] <> ' ' then error( erreolexp );
	escape( opsok );
      RECOVER
	if escapecode = badops then
	  begin
	    if currop.class = (fpbase+58) then
	      begin             (* ftest *)
		operand1.mode := 2;
		operand1.reg := 0;
	      end
	    else
	      begin
		operand1.mode := 8;
		operand1.reg := 0;
	      end;
	    operand1.size := 0;
	    operand2.mode := 8;
	    operand2.reg := 1;
	    operand2.size := 0;
	    (* LAF 870320 default should be X
	    if (currop.class = (fpbase+36)) or
		(currop.class = (fpbase+39)) then
	      begin                     (* fsgldiv or fsglmul * )
		sizesuffix := 'S';
		size := 4;
	      end
	    else
	    *)
	      begin
		sizesuffix := 'X';
		size := 12;
	      end;
	  end
	else if escapecode <> opsok then escape( escapecode );
	codegen;
	listinst( 1 );
	locctr.longint := locctb.longint;
    end                            (* "general class" instructions *)

  else if (currop.class >= (fpbase+fpbrbase))
	and (currop.class <= (fpbase+fpbrbase+31)) then

    begin                       (* FDBcc, FScc, FTcc, and FTPcc *)
     if currop.code = -4024 then                (* FDBcc *)
       begin
       TRY
	 parseoperand( operand1 );
	 if operand1.mode <> 0 then
	   begin
	     error( errbadmode );
	     escape(badops );
	   end;
	 if line[ curcol ] <> ',' then
	   begin
	     error( errcommaexp );
	     escape( badops );
	   end;
	 curcol := curcol + 1;
	 express( true, evalok, evalue, curcol );

	 (* ??? must be relative, as opposed to absolute ? *)

	 evalue.offset.longint := evalue.offset.longint
					- ( 4 + locctr.longint );
	 operand2.value := evalue;
	 if ( evalue.exprefs = NIL ) and
		(not fitsin16( evalue.offset ) ) then
	   error( errfieldoflo );
	 if line[ curcol ] <> ' ' then error( erreolexp );
	 escape( opsok );
       RECOVER
	 if escapecode = badops then
	   begin
	     operand1.mode := 0;
	     operand1.reg := 0;
	     operand1.size := 0;
	     operand2.value.offset := zero32;
	     operand2.value.exprefs := NIL;
	   end
	 else if escapecode <> opsok then
	   escape( escapecode );
	 codegen;
	 listinst( 1 );
	 locctr.longint := locctr.longint + 6;
       end
     else if currop.code = -4032 then           (* FScc *)
       begin
       TRY
	 parseoperand( operand1 );
	 if not datalterable( operand1 ) then
	   begin
	     error( errbadmode );
	     escape( badops );
	   end;
	 if line[ curcol ] <> ' ' then
	   error( erreolexp );
	 escape( opsok );
       RECOVER
	 if escapecode = badops then
	   begin
	     operand1.mode := 2;
	     operand1.reg := 0;
	     operand1.size := 0;
	   end
	 else if escapecode <> opsok then
	   escape( escapecode );
	 codegen;
	 listinst( 1 );
	 locctr.longint := locctr.longint + 4 + operand1.size;
       end
     else if currop.code = -3972 then           (* FTcc *)
       begin
	 codegen;
	 listinst( 1 );
	 locctr.longint := locctr.longint + 4;
       end
     else if currop.code = -3974 then           (* FTPcc *)
       begin
       TRY
	 parseoperand( operand1 );
	 if not ( (operand1.mode = 7) and (operand1.reg = 4) ) then
	   begin
	     error( errbadmode );
	     escape( badops );
	   end;
	 if line[ curcol ] <> ' ' then
	   error( erreolexp );
	 escape( opsok );
       RECOVER
	 if escapecode = badops then
	   begin
	     operand1.mode := 7;
	     operand1.reg := 4;
	     operand1.size := 2;
	     operand1.value.offset := zero32;
	   end
	 else if escapecode <> opsok then
	   escape( escapecode );
	 codegen;
	 listinst( 1 );
	 locctr.longint := locctr.longint + 4 + operand1.size;
       end
     else
       error( errfpinternalerr );
    end                         (* FDBcc, FScc, FTcc, and FTPcc *)

  else if currop.class = (fpbase+fpbrbase+32) then
    begin                                               (* FBcc *)
   TRY
     express( true, evalok, evalue, curcol );

     (* ??? must be relative, as opposed to absolute ? *)

     evalue.offset.longint := evalue.offset.longint
					- ( 2 + locctr.longint );
     if (sizesuffix = 'W') or (sizesuffix = ' ') then
       begin
	 if (evalue.exprefs = NIL)
		and not ( (evalue.base=absolut) and (pcmode = rel) )
		and not ( (evalue.base=relative) and (pcmode=abs) )
		and not fitsin16( evalue.offset ) then
	   begin
	     operand1.size := 4;
	     if sizesuffix = 'W' then
	       error( errfieldoflo );
	   end
	 else
	   operand1.size := 2;
       end
     else
       operand1.size := 4;
     escape( opsok );
   RECOVER
    if ( escapecode <> badops ) and ( escapecode <> opsok ) then
	escape( escapecode )
    else
      if escapecode = opsok then
	if line[curcol ] <> ' ' then
	  error( erreolexp );
    operand1.value := evalue;
    codegen;
    listinst( 1 );
    locctr.longint := locctr.longint + 2 + operand1.size;
   end                                                  (* FBcc *)

 else if (currop.class = (fpbase+fpbrbase+33))
	or (currop.class = (fpbase+fpbrbase+34)) then
   begin                                        (* FSAVE or FRESTORE *)
   TRY
     size := 2;
     parseoperand( operand1 );
     if ( (currop.class = (fpbase+fpbrbase+33)) and       (* save *)
	  not ( (controlmode( operand1 ) and alterable( operand1))
		 or (operand1.mode = 4) ) )             (* restore *)
	or ( (currop.class = (fpbase+fpbrbase+34)) and
	     not (controlmode( operand1 ) or (operand1.mode = 3)) ) then
      begin
	error( errbadmode );
	escape( badops );
      end;
     if line[ curcol ] <> ' ' then error( erreolexp );
     escape( opsok );
   RECOVER
     if escapecode = badops then
       begin
	 operand1.mode := 2;
	 operand1.reg := 0;
	 operand1.size := 0;
       end
     else if escapecode <> opsok then
       escape( escapecode );
     codegen;
     listinst( 1 );
     locctr.longint := locctr.longint + 2 + operand1.size;
   end                                          (* FSAVE or FRESTORE *)

 else if currop.class = (fpbase+fpbrbase+35) then
   begin                                                (* FNOP *)
     size := 4;
     codegen;
     listinst( 1 );
     locctr.longint := locctr.longint + 4;
   end                                                  (* FNOP *)

  else
    error( errfpinternalerr );

  allowfpopds := false;

end;    (* pass2fpops *)
$end$

@


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.1
log
@Automatic bump of revision number for PWS version 3.3a
@
text
@@


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.2
log
@fixed allowed and default sizes of FSGLDIV & FSGLMUL
default was S, is now X
X and D are now allowed
@
text
@@


13.1
log
@Automatic bump of revision number for PWS version 3.2F
@
text
@d543 4
a546 1
					(sizesuffix = 'S') ) then
d548 4
a551 2
			       sizesuffix := 'S';
			       size := 4;
d688 1
d691 1
a691 1
	      begin                     (* fsgldiv or fsglmul *)
d696 1
@


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.2
log
@bugs 682 & 784: add FINTRZ, add D & X to FSGLDIV & MUL,
  change FTcc & FTPcc to FTRAPcc
@
text
@@


8.1
log
@Automatic bump of revision number for PWS version 3.2A
@
text
@d571 1
a571 1
	 allowed *)
d579 1
@


7.2
log
@Fixes for SSS
@
text
@@


7.1
log
@Automatic bump of revision number for PWS version 3.2l
@
text
@d528 1
d531 1
a531 1
			     begin              (* not monadic op *)
d538 1
@


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
@@
