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


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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

1.1
date     86.06.30.13.25.43;  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 FLOAT }
import
  sysglobals, codegen, assemble, genutils, genexprmod;

implement

  const
    float_card_base = hex('5c0000');

    { 64 and 32 bit operations base address is for F0 op F0.
      The addresses increase for other operands. }
    add_64_base = float_card_base + hex('4000');
    sub_64_base = float_card_base + hex('4020');
    mul_64_base = float_card_base + hex('4040');   {tst.w base+(source*4)+dest}
    div_64_base = float_card_base + hex('4060');
    neg_64_base = float_card_base + hex('4080');
    abs_64_base = float_card_base + hex('40a0');

    { Memory / Chip operations base addresses are for F0.
      Addresses for other register operands decrease. }

    { Chip to memory -- base-(regnum*4) }
    read_32_base = float_card_base + hex('456c');

    { Memory to chip -- base-(regnum*4) }
    write_32_base = float_card_base + hex('44fc');

    { Memory to chip -- base-(regnum*2) }
    float64_base = float_card_base + hex('452c');

  var
    maxFregused: shortint;
    Dreg: array[regrange] of regrange;
    rmask: attrtype;

    error_status_reg: regrange;

  procedure NIL_attributes(fexp: exptr);
    { Called as part of the $FLOAT TEST$ option }
    var
      ptr: elistptr;
    begin
    with fexp^ do
      begin
      attr := NIL;
      case eclass of
	eqnode, nenode, ltnode, lenode, gtnode, genode, innode, subsetnode,
	supersetnode, unionnode, diffnode, intersectnode, concatnode,
	addnode, subnode, mulnode, divnode, modnode, shftnode, ornode, andnode:
	  begin
	  NIL_attributes(opnd1);
	  NIL_attributes(opnd2);
	  end;
	negnode, notnode, floatnode, derfnode, succnode,
	bufnode, absnode, chrnode, oddnode, ordnode,
	prednode, strlennode, strmaxnode, roundnode, sqrnode, truncnode:
	  NIL_attributes(opnd);
	subscrnode:
	  begin
	  NIL_attributes(arayp);
	  NIL_attributes(indxp);
	  end;
	substrnode:
	  begin
	  NIL_attributes(arayp);
	  NIL_attributes(indxp);
	  NIL_attributes(lengthp);
	  end;
	selnnode:
	  NIL_attributes(recptr);
	fcallnode:
	  begin
	  ptr := actualp;
	  while ptr <> NIL do
	    begin
	    NIL_attributes(ptr^.expptr);
	    ptr := ptr^.nextptr;
	    end;
	  end;
	setdenonode:
	  begin
	  ptr := setvarpart;
	  while ptr <> NIL do
	    begin
	    NIL_attributes(ptr^.lowptr);
	    NIL_attributes(ptr^.hiptr);
	    ptr := ptr^.nextptr;
	    end;
	  end;
	otherwise { Terminal node }
      end; { case }
      end; { with }
    end; { NIL_attributes }

  procedure test_error;
    var
      op1,op2: attrtype;
    begin
    with op1 do
      begin
      addrmode := immediate;
      smallval := 3;
      end;
    with op2 do
      begin
      addrmode := inDreg;
      regnum := error_status_reg;
      end;
    emit2(btst,op1,op2);
    with op1 do
      begin
      offset := 6;
      storage := bytte;
      end;
    emit1(beq,op1);
    callstdproc('ASM_FLPT_ERROR');
    end;

  procedure wait;
    var
      op1,op2: attrtype;
      bogus_read1,bogus_read2: regrange;
      rt: regtype;
      rn: regrange;
    begin
    with op1 do
      begin
      addrmode := longabs;
      gloptr := NIL;
      offset := 0;
      absaddr.intval := true;
      absaddr.ival := float_card_base + 22;
      end;
    bogus_read1 := getreg(D);
    bogus_read2 := getreg(D);
    error_status_reg := getreg(D);
    with op2 do
      begin
      addrmode := multiple;
      storage := long;
      for rt := A to D do
	for rn := 0 to maxreg do
	  regs[rt,rn] := false;
      regs[D,bogus_read1] := true;
      regs[D,bogus_read2] := true;
      regs[D,error_status_reg] := true;
      end;
    emit2(movem,op1,op2);
    freeit(D,bogus_read1);
    freeit(D,bogus_read2);
    freeit(D,error_status_reg);
    end;

  procedure wait_test_error;
    begin
    wait;
    test_error;
    end;

  procedure no_wait_test_error;
    var
      op1, op2: attrtype;
    begin
    with op1 do
      begin
      addrmode := immediate;
      smallval := 3;
      end;
    with op2 do
      begin
      addrmode := longabs;
      gloptr := NIL;
      offset := 0;
      absaddr.intval := true;
      absaddr.ival := float_card_base + 33;
      storage := bytte;
      end;
    emit2(btst,op1,op2);
    with op1 do
      begin
      offset := 6;
      storage := bytte;
      end;
    emit1(beq,op1);
    callstdproc('ASM_FLPT_ERROR');
    end;

  function getregpair: regrange;
    var
      first_reg,second_reg : shortint;

    begin
    first_reg := getreg(F);
    second_reg := getreg(F);
    getregpair := first_reg;
    end;

  procedure loadrealvalue(fexp: exptr);
    { Load 64 bit real into 2 floating point registers }
    var
      op : attrtype;
    begin
    makeaddressable(fexp);
    if fexp^.attr^.addrmode <> inFreg then
      begin
      with op do
	begin
	regnum := getregpair;
	addrmode := longabs;
	offset := 0;
	storage := long;
	gloptr := NIL;
	absaddr.intval := true;
	absaddr.ival := write_32_base - regnum*4 - 4;
	end;
      with fexp^ do
	begin
	freeregs(attr);
	emit2(move,attr^,op);
	op.absaddr.ival := op.absaddr.ival + 4;
	attr^.offset := attr^.offset + 4;
	checkoffset(fexp);
	emit2(move,attr^,op);
	attr^.storage := multi;
	attr^.addrmode := inFreg;
	attr^.regnum := op.regnum;
	end; { with fexp^ }
      end;
    end;

  procedure pushrealvalue(fexp: exptr);
    { Addrmode is inFreg.  Move the 64 bit
      real number onto the stack. }
    var
      op: attrtype;
    begin
    makeaddressable(fexp);
    with op do
      begin
      addrmode := longabs;
      offset := 0;
      gloptr := NIL;
      absaddr.intval := true;
      absaddr.ival := read_32_base - fexp^.attr^.regnum*4;
      end;
    SPminus.storage := long;
    emit2(move,op,SPminus);
    op.absaddr.ival := op.absaddr.ival - 4;
    emit2(move,op,SPminus);
    freeregs(fexp^.attr);
    fexp^.attr^.addrmode := topofstack;
    end;

  procedure pushrealaddress(fexp: exptr);
    { Addrmode is inFreg. Move to a temporary.
      Push the address of the temporary.}
    var
      op1,op2: attrtype;
    begin
    makeaddressable(fexp);

    getlocstorage(8,op2);
    op2.storage := long;
    with op1 do
      begin
      addrmode := longabs;
      offset := 0;
      gloptr := NIL;
      absaddr.intval := true;
      absaddr.ival := read_32_base - (fexp^.attr^.regnum+1)*4;
      end;
    emit2(move,op1,op2);
    op1.absaddr.ival := op1.absaddr.ival + 4;
    op2.offset := op2.offset + 4;
    emit2(move,op1,op2);
    op2.offset := op2.offset - 4;
    emit1(pea,op2);
    freeregs(fexp^.attr);
    end;

  procedure moverealvalue(fexp: exptr; var at: attrtype);
    { Addrmode is inFreg.  Move 64 bit real from
      the floating point registers to the address in at. }
    var
      op: attrtype;
    begin
    makeaddressable(fexp);
    with op do
      begin
      addrmode := longabs;
      offset := 0;
      gloptr := NIL;
      absaddr.intval := true;
      absaddr.ival := read_32_base - fexp^.attr^.regnum*4 - 4;
      end;
    at.storage := long;
    emit2(move,op,at);
    op.absaddr.ival := op.absaddr.ival + 4;
    at.offset := at.offset + 4;
    emit2(move,op,at);
    at.offset := at.offset - 4;
    at.storage := multi;
    freeregs(fexp^.attr);
    end;

  procedure saverealregs;
    var
      rt: regtype; rn: regrange;
      i: shortint;
      op: attrtype;

    begin
    maxFregused := maxreg;
    while (maxFregused > 0) and
	  (reg[F,maxFregused].allocstate <> allocated) do
      maxFregused := maxFregused - 1;

    if maxFregused > 0 then
      with rmask do
	begin
	addrmode := multiple;
	storage := long;
	for rt := A to D do
	  for rn := 0 to maxreg do
	    regs[rt,rn] := false;

	for i := 0 to maxFregused do
	  begin
	  Dreg[i] := getreg(D);
	  regs[D,Dreg[i]] := true;
	  end;

	with op do
	  begin
	  addrmode := longabs;
	  storage := long;
	  offset := 0;
	  gloptr := NIL;
	  absaddr.intval := true;
	  absaddr.ival := read_32_base - 4*maxFregused;
	  end;

	emit2(movem,op,rmask);  { Load Fregs into D registers }

	op.storage := bytte;
	op.absaddr.ival := float_card_base + 33;
	emit1(clr,op);                 { reset float card state after movem }
	end;
    end;

  procedure reloadrealregs;
    var
      op: attrtype;
      i: shortint;

    begin
    if maxFregused > 0 then
      begin
      with op do
	begin
	addrmode := longabs;
	storage := long;
	offset := 0;
	gloptr := NIL;
	absaddr.intval := true;
	absaddr.ival := write_32_base - 4*maxFregused;
	end;

      emit2(movem,rmask,op);  { reload Fregs from D registers }
      for i := 0 to maxFregused do
	reg[D,Dreg[i]].allocstate := free;
      end;

    end;

  procedure realop(fexp: exptr);
    var
      op1,op2: attrtype;
    begin
    with fexp^, attr^ do
      case eclass of
	negnode,absnode,sqrnode:   { 64 bit }
	  begin
	  loadrealvalue(opnd);
	  with op1 do
	    begin
	    addrmode := longabs;
	    storage := wrd;
	    offset := 0;
	    gloptr := NIL;
	    absaddr.intval := true;
	    case eclass of
	      negnode: absaddr.ival := neg_64_base + opnd^.attr^.regnum * 5;
	      absnode: absaddr.ival := abs_64_base + opnd^.attr^.regnum * 5;
	      sqrnode: absaddr.ival := mul_64_base + opnd^.attr^.regnum * 5;
	    end; { case }
	    end;
	  emit1(tst,op1);
	  if eclass = sqrnode then wait_test_error
	  else wait;
	  addrmode := inFreg;
	  regnum := opnd^.attr^.regnum;
	  storage := multi;
	  signbit := true;
	  end;
	floatnode: { int to 64 bit }
	  begin
	  makeaddressable(opnd);
	  with op1 do
	    begin
	    addrmode := longabs;
	    storage := long;
	    offset := 0;
	    gloptr := NIL;
	    absaddr.intval := true;
	    end;
	  extend(opnd,long);
	  regnum := getregpair;
	  storage := multi;
	  op1.absaddr.ival := float64_base - regnum*2;
	  emit2(move,opnd^.attr^,op1);
	  signbit := true;
	  addrmode := inFreg;
	  freeregs(opnd^.attr);
	  wait;
	  end;
	subnode, addnode, mulnode, divnode: { 64 bit }
	  begin
	  { Evaluate a complicated operand first }
	  if opnd1^.num_ops >= opnd2^.num_ops then
	    begin loadrealvalue(opnd1); loadrealvalue(opnd2); end
	  else
	    begin loadrealvalue(opnd2); loadrealvalue(opnd1); end;
	  with op1 do
	    begin
	    addrmode := longabs;
	    offset := 0;
	    gloptr := NIL;
	    absaddr.intval := true;
	    storage := wrd;
	    case eclass of
	      subnode:  absaddr.ival := sub_64_base + opnd2^.attr^.regnum*4
						      + opnd1^.attr^.regnum;
	      addnode:  absaddr.ival := add_64_base + opnd2^.attr^.regnum*4
						      + opnd1^.attr^.regnum;
	      mulnode:  absaddr.ival := mul_64_base + opnd2^.attr^.regnum*4
						      + opnd1^.attr^.regnum;
	      divnode:  absaddr.ival := div_64_base + opnd2^.attr^.regnum*4
						      + opnd1^.attr^.regnum;
	    end; { case }
	    end; { with op1}
	  emit1(tst,op1);
	  addrmode := inFreg;
	  regnum := opnd1^.attr^.regnum;
	  signbit := true;
	  storage := opnd1^.attr^.storage;
	  freeregs(opnd2^.attr);
	  wait_test_error;
	  end;
      end; { case eclass }
    end; { realop }
@


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


56.1
log
@Automatic bump of revision number for PWS version 3.25
@
text
@a0 461
			     { file FLOAT }
import
  sysglobals, codegen, assemble, genutils, genexprmod;

implement

  const
    float_card_base = hex('5c0000');

    { 64 and 32 bit operations base address is for F0 op F0.
      The addresses increase for other operands. }
    add_64_base = float_card_base + hex('4000');
    sub_64_base = float_card_base + hex('4020');
    mul_64_base = float_card_base + hex('4040');   {tst.w base+(source*4)+dest}
    div_64_base = float_card_base + hex('4060');
    neg_64_base = float_card_base + hex('4080');
    abs_64_base = float_card_base + hex('40a0');

    { Memory / Chip operations base addresses are for F0.
      Addresses for other register operands decrease. }

    { Chip to memory -- base-(regnum*4) }
    read_32_base = float_card_base + hex('456c');

    { Memory to chip -- base-(regnum*4) }
    write_32_base = float_card_base + hex('44fc');

    { Memory to chip -- base-(regnum*2) }
    float64_base = float_card_base + hex('452c');

  var
    maxFregused: shortint;
    Dreg: array[regrange] of regrange;
    rmask: attrtype;

    error_status_reg: regrange;

  procedure NIL_attributes(fexp: exptr);
    { Called as part of the $FLOAT TEST$ option }
    var
      ptr: elistptr;
    begin
    with fexp^ do
      begin
      attr := NIL;
      case eclass of
	eqnode, nenode, ltnode, lenode, gtnode, genode, innode, subsetnode,
	supersetnode, unionnode, diffnode, intersectnode, concatnode,
	addnode, subnode, mulnode, divnode, modnode, shftnode, ornode, andnode:
	  begin
	  NIL_attributes(opnd1);
	  NIL_attributes(opnd2);
	  end;
	negnode, notnode, floatnode, derfnode, succnode,
	bufnode, absnode, chrnode, oddnode, ordnode,
	prednode, strlennode, strmaxnode, roundnode, sqrnode, truncnode:
	  NIL_attributes(opnd);
	subscrnode:
	  begin
	  NIL_attributes(arayp);
	  NIL_attributes(indxp);
	  end;
	substrnode:
	  begin
	  NIL_attributes(arayp);
	  NIL_attributes(indxp);
	  NIL_attributes(lengthp);
	  end;
	selnnode:
	  NIL_attributes(recptr);
	fcallnode:
	  begin
	  ptr := actualp;
	  while ptr <> NIL do
	    begin
	    NIL_attributes(ptr^.expptr);
	    ptr := ptr^.nextptr;
	    end;
	  end;
	setdenonode:
	  begin
	  ptr := setvarpart;
	  while ptr <> NIL do
	    begin
	    NIL_attributes(ptr^.lowptr);
	    NIL_attributes(ptr^.hiptr);
	    ptr := ptr^.nextptr;
	    end;
	  end;
	otherwise { Terminal node }
      end; { case }
      end; { with }
    end; { NIL_attributes }

  procedure test_error;
    var
      op1,op2: attrtype;
    begin
    with op1 do
      begin
      addrmode := immediate;
      smallval := 3;
      end;
    with op2 do
      begin
      addrmode := inDreg;
      regnum := error_status_reg;
      end;
    emit2(btst,op1,op2);
    with op1 do
      begin
      offset := 6;
      storage := bytte;
      end;
    emit1(beq,op1);
    callstdproc('ASM_FLPT_ERROR');
    end;

  procedure wait;
    var
      op1,op2: attrtype;
      bogus_read1,bogus_read2: regrange;
      rt: regtype;
      rn: regrange;
    begin
    with op1 do
      begin
      addrmode := longabs;
      gloptr := NIL;
      offset := 0;
      absaddr.intval := true;
      absaddr.ival := float_card_base + 22;
      end;
    bogus_read1 := getreg(D);
    bogus_read2 := getreg(D);
    error_status_reg := getreg(D);
    with op2 do
      begin
      addrmode := multiple;
      storage := long;
      for rt := A to D do
	for rn := 0 to maxreg do
	  regs[rt,rn] := false;
      regs[D,bogus_read1] := true;
      regs[D,bogus_read2] := true;
      regs[D,error_status_reg] := true;
      end;
    emit2(movem,op1,op2);
    freeit(D,bogus_read1);
    freeit(D,bogus_read2);
    freeit(D,error_status_reg);
    end;

  procedure wait_test_error;
    begin
    wait;
    test_error;
    end;

  procedure no_wait_test_error;
    var
      op1, op2: attrtype;
    begin
    with op1 do
      begin
      addrmode := immediate;
      smallval := 3;
      end;
    with op2 do
      begin
      addrmode := longabs;
      gloptr := NIL;
      offset := 0;
      absaddr.intval := true;
      absaddr.ival := float_card_base + 33;
      storage := bytte;
      end;
    emit2(btst,op1,op2);
    with op1 do
      begin
      offset := 6;
      storage := bytte;
      end;
    emit1(beq,op1);
    callstdproc('ASM_FLPT_ERROR');
    end;

  function getregpair: regrange;
    var
      first_reg,second_reg : shortint;

    begin
    first_reg := getreg(F);
    second_reg := getreg(F);
    getregpair := first_reg;
    end;

  procedure loadrealvalue(fexp: exptr);
    { Load 64 bit real into 2 floating point registers }
    var
      op : attrtype;
    begin
    makeaddressable(fexp);
    if fexp^.attr^.addrmode <> inFreg then
      begin
      with op do
	begin
	regnum := getregpair;
	addrmode := longabs;
	offset := 0;
	storage := long;
	gloptr := NIL;
	absaddr.intval := true;
	absaddr.ival := write_32_base - regnum*4 - 4;
	end;
      with fexp^ do
	begin
	freeregs(attr);
	emit2(move,attr^,op);
	op.absaddr.ival := op.absaddr.ival + 4;
	attr^.offset := attr^.offset + 4;
	checkoffset(fexp);
	emit2(move,attr^,op);
	attr^.storage := multi;
	attr^.addrmode := inFreg;
	attr^.regnum := op.regnum;
	end; { with fexp^ }
      end;
    end;

  procedure pushrealvalue(fexp: exptr);
    { Addrmode is inFreg.  Move the 64 bit
      real number onto the stack. }
    var
      op: attrtype;
    begin
    makeaddressable(fexp);
    with op do
      begin
      addrmode := longabs;
      offset := 0;
      gloptr := NIL;
      absaddr.intval := true;
      absaddr.ival := read_32_base - fexp^.attr^.regnum*4;
      end;
    SPminus.storage := long;
    emit2(move,op,SPminus);
    op.absaddr.ival := op.absaddr.ival - 4;
    emit2(move,op,SPminus);
    freeregs(fexp^.attr);
    fexp^.attr^.addrmode := topofstack;
    end;

  procedure pushrealaddress(fexp: exptr);
    { Addrmode is inFreg. Move to a temporary.
      Push the address of the temporary.}
    var
      op1,op2: attrtype;
    begin
    makeaddressable(fexp);

    getlocstorage(8,op2);
    op2.storage := long;
    with op1 do
      begin
      addrmode := longabs;
      offset := 0;
      gloptr := NIL;
      absaddr.intval := true;
      absaddr.ival := read_32_base - (fexp^.attr^.regnum+1)*4;
      end;
    emit2(move,op1,op2);
    op1.absaddr.ival := op1.absaddr.ival + 4;
    op2.offset := op2.offset + 4;
    emit2(move,op1,op2);
    op2.offset := op2.offset - 4;
    emit1(pea,op2);
    freeregs(fexp^.attr);
    end;

  procedure moverealvalue(fexp: exptr; var at: attrtype);
    { Addrmode is inFreg.  Move 64 bit real from
      the floating point registers to the address in at. }
    var
      op: attrtype;
    begin
    makeaddressable(fexp);
    with op do
      begin
      addrmode := longabs;
      offset := 0;
      gloptr := NIL;
      absaddr.intval := true;
      absaddr.ival := read_32_base - fexp^.attr^.regnum*4 - 4;
      end;
    at.storage := long;
    emit2(move,op,at);
    op.absaddr.ival := op.absaddr.ival + 4;
    at.offset := at.offset + 4;
    emit2(move,op,at);
    at.offset := at.offset - 4;
    at.storage := multi;
    freeregs(fexp^.attr);
    end;

  procedure saverealregs;
    var
      rt: regtype; rn: regrange;
      i: shortint;
      op: attrtype;

    begin
    maxFregused := maxreg;
    while (maxFregused > 0) and
	  (reg[F,maxFregused].allocstate <> allocated) do
      maxFregused := maxFregused - 1;

    if maxFregused > 0 then
      with rmask do
	begin
	addrmode := multiple;
	storage := long;
	for rt := A to D do
	  for rn := 0 to maxreg do
	    regs[rt,rn] := false;

	for i := 0 to maxFregused do
	  begin
	  Dreg[i] := getreg(D);
	  regs[D,Dreg[i]] := true;
	  end;

	with op do
	  begin
	  addrmode := longabs;
	  storage := long;
	  offset := 0;
	  gloptr := NIL;
	  absaddr.intval := true;
	  absaddr.ival := read_32_base - 4*maxFregused;
	  end;

	emit2(movem,op,rmask);  { Load Fregs into D registers }

	op.storage := bytte;
	op.absaddr.ival := float_card_base + 33;
	emit1(clr,op);                 { reset float card state after movem }
	end;
    end;

  procedure reloadrealregs;
    var
      op: attrtype;
      i: shortint;

    begin
    if maxFregused > 0 then
      begin
      with op do
	begin
	addrmode := longabs;
	storage := long;
	offset := 0;
	gloptr := NIL;
	absaddr.intval := true;
	absaddr.ival := write_32_base - 4*maxFregused;
	end;

      emit2(movem,rmask,op);  { reload Fregs from D registers }
      for i := 0 to maxFregused do
	reg[D,Dreg[i]].allocstate := free;
      end;

    end;

  procedure realop(fexp: exptr);
    var
      op1,op2: attrtype;
    begin
    with fexp^, attr^ do
      case eclass of
	negnode,absnode,sqrnode:   { 64 bit }
	  begin
	  loadrealvalue(opnd);
	  with op1 do
	    begin
	    addrmode := longabs;
	    storage := wrd;
	    offset := 0;
	    gloptr := NIL;
	    absaddr.intval := true;
	    case eclass of
	      negnode: absaddr.ival := neg_64_base + opnd^.attr^.regnum * 5;
	      absnode: absaddr.ival := abs_64_base + opnd^.attr^.regnum * 5;
	      sqrnode: absaddr.ival := mul_64_base + opnd^.attr^.regnum * 5;
	    end; { case }
	    end;
	  emit1(tst,op1);
	  if eclass = sqrnode then wait_test_error
	  else wait;
	  addrmode := inFreg;
	  regnum := opnd^.attr^.regnum;
	  storage := multi;
	  signbit := true;
	  end;
	floatnode: { int to 64 bit }
	  begin
	  makeaddressable(opnd);
	  with op1 do
	    begin
	    addrmode := longabs;
	    storage := long;
	    offset := 0;
	    gloptr := NIL;
	    absaddr.intval := true;
	    end;
	  extend(opnd,long);
	  regnum := getregpair;
	  storage := multi;
	  op1.absaddr.ival := float64_base - regnum*2;
	  emit2(move,opnd^.attr^,op1);
	  signbit := true;
	  addrmode := inFreg;
	  freeregs(opnd^.attr);
	  wait;
	  end;
	subnode, addnode, mulnode, divnode: { 64 bit }
	  begin
	  { Evaluate a complicated operand first }
	  if opnd1^.num_ops >= opnd2^.num_ops then
	    begin loadrealvalue(opnd1); loadrealvalue(opnd2); end
	  else
	    begin loadrealvalue(opnd2); loadrealvalue(opnd1); end;
	  with op1 do
	    begin
	    addrmode := longabs;
	    offset := 0;
	    gloptr := NIL;
	    absaddr.intval := true;
	    storage := wrd;
	    case eclass of
	      subnode:  absaddr.ival := sub_64_base + opnd2^.attr^.regnum*4
						      + opnd1^.attr^.regnum;
	      addnode:  absaddr.ival := add_64_base + opnd2^.attr^.regnum*4
						      + opnd1^.attr^.regnum;
	      mulnode:  absaddr.ival := mul_64_base + opnd2^.attr^.regnum*4
						      + opnd1^.attr^.regnum;
	      divnode:  absaddr.ival := div_64_base + opnd2^.attr^.regnum*4
						      + opnd1^.attr^.regnum;
	    end; { case }
	    end; { with op1}
	  emit1(tst,op1);
	  addrmode := inFreg;
	  regnum := opnd1^.attr^.regnum;
	  signbit := true;
	  storage := opnd1^.attr^.storage;
	  freeregs(opnd2^.attr);
	  wait_test_error;
	  end;
      end; { case eclass }
    end; { realop }
@


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