memref.p

<B>Digital的Unix操作系统VAX 4.2源码</B>

(*#@(#)memref.p	4.1	Ultrix	7/17/90 *)
(****************************************************************************
 *									    *
 *  Copyright (c) 1984 by						    *
 *  DIGITAL EQUIPMENT CORPORATION, Maynard, Massachusetts.		    *
 *  All rights reserved.						    *
 * 									    *
 *  This software is furnished under a license and may be used and copied   *
 *  only in  accordance with  the  terms  of  such  license  and with the   *
 *  inclusion of the above copyright notice. This software or  any  other   *
 *  copies thereof may not be provided or otherwise made available to any   *
 *  other person.  No title to and ownership of  the  software is  hereby   *
 *  transferred.							    *
 * 									    *
 *  The information in this software is  subject to change without notice   *
 *  and  should  not  be  construed as  a commitment by DIGITAL EQUIPMENT   *
 *  CORPORATION.							    *
 * 									    *
 *  DIGITAL assumes no responsibility for the use  or  reliability of its   *
 *  software on equipment which is not supplied by DIGITAL.		    *
 * 									    *
 *									    *
 ****************************************************************************)
#include "globals.h"
#include "util.h"
#include "codesubs.h"

function AddrIsTReg{(e:EESElement) : boolean};
begin
    AddrIsTReg := (ees[e].addrBlock = curblockid) and
	    (ees[e].addrOffset < maxtoffset) and (ees[e].addrMemType = 't');
end;

function IsOnlyBaseReg(e:EESElement) : boolean;
begin
    IsOnlyBaseReg := (ees[e].breg <> NULLREG) and (ees[e].sreg = NULLREG)
	    and (ees[e].addrOffset = 0) and (ees[e].addrMemType = ' ')
	    and not ees[e].indirect;
end;

{ DispRef:  write out display register or global data reference }
{  level := relative display level (0 := current)               }
{  if global level, then write name of global area 'xxxxxxxx'   }
{  if not, then write name of display register '(rN)'           }
procedure DispRef{(level:integer; mt : char)};
begin
    if (level < 0) or (level > curlev) then begin
	Error('DispRef: bad level');
    end else if level = curlev then begin
	{ relative level curlev means local }
	if mt = 'p' then begin
	    write(output,'(ap)');
	end else begin
	    write(output,'(fp)');
	end;
    end else begin
	{ write register name as '(rN)' where N is the  }
	{  display register for that level }
	write(output,'(',DispReg(level,mt):1,')');
    end;
end;

procedure TRegOpnd{(var r : Reg; e : EESElement)};
var
    newr : Reg;
begin
    if r in [rt0..rt9] then begin
	newr := AllocReg(REGEES,e,ees[e].ptype);
	R(r); X; R(newr);
	r := newr;
    end else begin
	R(r); X; R(r);
    end;
end;

procedure CheckTReg{(var r : Reg; e : EESElement)};
var
    newr : Reg;
begin
    if r in [rt0..rt9] then begin
	newr := AllocReg(REGEES,e,ees[e].ptype);
	Op('movl'); R(r); X; R(newr); S(' #T'); L;
	r := newr;
    end;
end;

procedure GenAddress{(e : EESElement)};
begin
    if ees[e].addrOffset mod BYTESIZE <> 0 then begin
	Error('GenAddress: not on a byte boundary');
    end;
    if AddrIsTReg(e) then begin
	R(MemTReg(ees[e].addrOffset));
    end else if (ees[e].addrMemType = ' ') and (ees[e].addrOffset = 0)
    then begin
	{ avoid writing 0 if base reg, but write 0 if there isn't one }
	if ees[e].breg = NULLREG then begin
	    C('0');
	end;
    end else begin
	C('(');
	case ees[e].addrMemType of
	    'p': begin C('p'); I(ees[e].addrBlock); C('+'); end;
	    't': begin C('t'); I(ees[e].addrBlock); C('+'); end;
	    'm': begin C('m'); I(ees[e].addrBlock); C('+'); end;
	    's': begin C('s'); I(ees[e].addrBlock); C('+'); end;
	    'c': begin WriteName(ees[e].addrBlock); C('+'); end;
	    'k': begin C('k'); I(ees[e].addrBlock); C('+'); end;
	    ' ': begin end;
	end;
	I(ees[e].addrOffset div BYTESIZE); C(')');
	if ees[e].addrLevel <> 0 then begin
	    DispRef(ees[e].addrLevel,ees[e].addrMemType);
	end;
    end;
    if ees[e].breg <> NULLREG then begin
	C('('); R(ees[e].breg); C(')');
    end;
    if ees[e].sreg <> NULLREG then begin
	if (ees[e].breg = NULLREG) and (ees[e].addrLevel = 0) and
		(ees[e].sunits <= BYTESIZE)
	then begin
	    C('('); R(ees[e].sreg); C(')');
	end else begin
	    C('['); R(ees[e].sreg); C(']');
	end;
    end;
end;

procedure Opnd{(e : EESElement)};
begin
    case ees[e].kind of
	EESDATA : begin
	    if ees[e].indirect then begin
		Error('Indirect on DATA');
	    end;
	    if ees[e].dreg <> NULLREG then begin
		R(ees[e].dreg);
	    end else begin
		C('$'); I(ees[e].constInt);
	    end;
	end;
	EESADDR : begin
	    if ees[e].indirect then begin
		Error('Indirect on ADDR');
	    end;
	    GenAddress(e);
	end;
	EESVAR : begin
	    if ees[e].indirect then begin
		if AddrIsTReg(e) then begin
		    C('('); GenAddress(e); C(')'); 
		end else begin
		    C('*'); GenAddress(e);
		end;
	    end else begin
		GenAddress(e);
	    end;
	end;
    end;
end;

procedure CheckSub{(e:EESElement; size:sizerange)};
var
    shift : integer;
begin
    if ees[e].sreg <> NULLREG then begin
	if (ees[e].sunits mod size <> 0) then begin
	    Error('CheckSub: Unsupported array element size');
	end;
	if ees[e].sunits = size then begin
	    { already fixed up }
	end else if ees[e].sunits > size then begin
	    shift := PowerOfTwo(ees[e].sunits div size);
	    if shift = 1 then begin
		Op('addl3'); R(ees[e].sreg); X; TRegOpnd(ees[e].sreg,e); L;
	    end else if shift > 0 then begin
		Op('ashl'); C('$'); I(shift); X; TRegOpnd(ees[e].sreg,e); L;
	    end else begin
		Op('mull3'); C('$'); I(ees[e].sunits div size); X;
			TRegOpnd(ees[e].sreg,e); L;
	    end;
	    ees[e].sunits := size;
	end else begin
	    Error('CheckSub: Array element size too small');
	    Op('divl2'); C('$'); I(size div ees[e].sunits); X;
		    R(ees[e].sreg); L;
	    ees[e].sunits := size;
	end;
    end;
end;

procedure CheckRegs{(e:EESElement; size:sizerange)};
var
    r : Reg;
begin
    if ees[e].addrLevel <> 0 then begin
	NeedDisp(ees[e].addrLevel,ees[e].addrMemType);
    end;
    if ees[e].breg <> NULLREG then begin
	if ees[e].addrLevel <> 0 then begin
	    { need base reg and a display reg }
	    Op('addl3'); R(DispReg(ees[e].addrLevel,ees[e].addrMemType)); X;
		TRegOpnd(ees[e].breg,e); L;
	    ees[e].addrLevel := 0;
	end;
	Registerize(ees[e].breg);
    end;
    r := ees[e].breg;
    if ees[e].sreg <> NULLREG then begin
	Registerize(ees[e].sreg);
	CheckSub(e,size);
	Registerize(ees[e].sreg);
	if ees[e].sreg = r then begin
	    Error('CheckRegs: stole its own reg');
	end;
    end;
end;

procedure AddConst(e : EESElement; r : Reg);
begin
    if ees[e].constInt = 1 then begin
	Op('incl'); R(r); L;
    end else if ees[e].constInt = -1 then begin
	Op('decl'); R(r); L;
    end else if ees[e].constInt > 0 then begin
	Op('addl2'); C('$'); I(ees[e].constInt); X; R(r); L;
    end else if ees[e].constInt < 0 then begin
	Op('subl2'); C('$'); I(-ees[e].constInt); X; R(r); L;
    end;
    ees[e].constInt := 0;
end;

function BaseReg(e : EESElement) : Reg;
begin
    if ees[e].breg <> NULLREG then begin
	BaseReg := ees[e].breg;
    end else begin
	BaseReg := DispReg(ees[e].addrLevel,ees[e].addrMemType);
    end;
end;

procedure MoveAddress(e : EESElement);
var
    basereg, offset : boolean;
begin
    if ees[e].indirect then begin
	CheckRegs(e,WORDSIZE);
	ees[e].indirect := false;
	Op('movl'); Opnd(e); X;
    end else begin
	basereg := (ees[e].breg <> NULLREG) or (ees[e].addrLevel <> 0);
	if not basereg and (ees[e].sreg <> NULLREG) and
		(ees[e].sunits = BYTESIZE)
	then begin
	    ees[e].breg := ees[e].sreg;
	    ees[e].sreg := NULLREG;
	    basereg := true;
	end;
	offset := (ees[e].addrMemType <> ' ') or (ees[e].addrOffset <> 0);
	if ees[e].sreg = NULLREG then begin
	    CheckRegs(e,BYTESIZE);
	    if basereg then begin
		if offset then begin
		    Op('movab'); GenAddress(e); X;
		end else begin
		    Op('movl'); R(BaseReg(e)); X;
		end;
	    end else begin
		if offset then begin
		    Op('movl'); C('$'); GenAddress(e); X;
		end else begin
		    Op('clrl');
		end;
	    end;
	end else if (ees[e].sunits mod WORDSIZE) <> 0 then begin
	    CheckRegs(e,BYTESIZE);
	    { byte subscripting involved }
	    if basereg then begin
		if offset then begin
		    Op('movab'); GenAddress(e); X;
		end else begin
		    Op('addl3'); R(BaseReg(e)); X; R(ees[e].sreg); X;
		end;
	    end else begin
		ees[e].breg := ees[e].sreg;
		ees[e].sreg := NULLREG;
		if offset then begin
		    Op('movab'); GenAddress(e); X;
		end else begin
		    Op('movl'); R(ees[e].breg); X;
		end;
	    end;
	end else if ees[e].sunits = WORDSIZE then begin
	    CheckRegs(e,WORDSIZE);
	    { word subscripting involved }
	    Op('moval'); GenAddress(e); X;
	end else if ees[e].sunits = 2*WORDSIZE then begin
	    CheckRegs(e,WORDSIZE);
	    { double word subscripting involved }
	    Op('moval'); GenAddress(e); X;
	end else begin
	    { multi-word subscripting involved }
	    CheckRegs(e,BYTESIZE);
	    if basereg then begin
		if offset then begin
		    Op('movab'); GenAddress(e); X;
		end else begin
		    Op('addl3'); R(BaseReg(e)); X; R(ees[e].sreg); X;
		end;
	    end else begin
		ees[e].breg := ees[e].sreg;
		ees[e].sreg := NULLREG;
		if offset then begin
		    Op('movab'); GenAddress(e); X;
		end else begin
		    Op('movl'); R(ees[e].breg); X;
		end;
	    end;
	end;
    end;
end;

{
    The way this works:

    A stack element may be one of three things:
	DATA :	loaded or computed value
	ADDR :	address constant or expression
	VAR :	address constant or expression for a variable

    The three common routines to process these values are:
	Eval :	convert element to single register with no constant part
		if size <= WORDSIZE, make it DATA dreg
		if size > WORDSIZE, make it MultiWordTemp
	Check :	convert element to something that can appear as an operand
		if DATA, make it constant only or dreg only
		if ADDR, make it DATA dreg
		if VAR,
		    if size isn't right, do Eval
		    if size OK, fix subscript and be sure only one base reg
	Point :	like Eval, but assumes element is address and makes a var
		do Eval, if DATA dreg, make it breg
	Store :	store one element into another
		destination must be a VAR
		if size > WORDSIZE, copy from source to destination
		if sizes compatible for single instruction, do it
		if not, Eval source, then store
		
}

{ get value of e }
procedure Eval{(e:EESElement)};
var
    r : Reg;
    bitoff, mask : integer;
begin
    case ees[e].kind of
	EESDATA : begin
	    CheckRegs(e,ees[e].size);
	    { if no reg, allocate one }
	    if ees[e].dreg = NULLREG then begin
		r := AllocReg(REGEES,e,ees[e].ptype);
		Op('movl'); Opnd(e); X; R(r); L;
		ees[e].dreg := r;
	    end else begin
		AddConst(e,ees[e].dreg);
	    end;
	    ees[e].constInt := 0;
	end;
	EESADDR : begin
	    if IsOnlyBaseReg(e) then begin
		{ already just a base reg, just make it data reg }
		CheckTReg(ees[e].breg,e);
		ees[e].dreg := ees[e].breg;
		ees[e].breg := NULLREG;
	    end else begin
		{ compute address, put it in data reg }
		r := AllocReg(REGEES,e,taddress);
		MoveAddress(e); R(r); L;
		ClearAddress(e);
		FreeReg(ees[e].sreg);
		FreeReg(ees[e].breg);
		ees[e].dreg := r;
	    end;
	    ees[e].kind := EESDATA;
	    ees[e].constInt := 0;
	end;
	EESVAR : begin
	    { load variable }
	    if (ees[e].size > WORDSIZE) and (ees[e].ptype <> tlongreal)
	    then begin
		MakeMultiWordTemp(e);
	    end else begin
		CheckRegs(e,ees[e].size);
		r := AllocReg(REGEES,e,ees[e].ptype);
		{ get value in reg if less than or equal to a word }
		bitoff := ees[e].addrOffset mod BYTESIZE;
		if ees[e].ptype = tlongreal then begin
		    Op('movd'); Opnd(e); X; R(r); L;
		end else if (ees[e].size = WORDSIZE) and (bitoff = 0) then begin
		    if ees[e].constInt > 0 then begin
			Op('addl3'); C('$'); I(ees[e].constInt); X;
			ees[e].constInt := 0;
		    end else if ees[e].constInt < 0 then begin
			Op('subl3'); C('$'); I(-ees[e].constInt); X;
			ees[e].constInt := 0;
		    end else begin
			Op('movl');
		    end;
		    { ... }	Opnd(e); X; R(r); L;
		end else if (ees[e].size = BYTESIZE) and (bitoff = 0) then begin
		    if ees[e].ptype = tinteger then begin
			Op('cvtbl');
		    end else begin
			Op('movzbl');
		    end;
			Opnd(e); X; R(r); L;
		end else if (bitoff = 0) and (ees[e].sreg = NULLREG)
		    and (ees[e].ptype <> tinteger)
		then begin
			{ no subscripting, may be doing word operation on byte }
		    mask := power(2,ees[e].size);
		    if mask <> -maxint-1 then begin
			mask := -mask;
		    end;
		    Op('bicl3'); C('$'); I(mask); X; Opnd(e); X; R(r); L;
		end else begin
		    ees[e].addrOffset := ees[e].addrOffset div BYTESIZE * BYTESIZE;
		    CheckRegs(e,BYTESIZE); { instruction requires byte index }
		    if ees[e].ptype = tinteger then begin
			Op('extv');
		    end else begin
			Op('extzv');