memref.p

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

		    end;
			C('$'); I(bitoff ); X; C('$');
			I(ees[e].size); X; Opnd(e); X; R(r); L;
		end;
		AddConst(e,r);
		{ now a data register }
		ees[e].kind := EESDATA;
		ees[e].constInt := 0;
		ees[e].dreg := r;
		if ees[e].ptype = tlongreal then begin
		    ees[e].size := 2*WORDSIZE;
		end else begin
		    ees[e].size := WORDSIZE;
		end;
		FreeReg(ees[e].sreg);
		FreeReg(ees[e].breg);
		ClearAddress(e);
	    end;
	end;
    end;
end;

{ ensure that e can be used as an operand }
procedure Check{(e:EESElement;size:sizerange)};
begin
    case ees[e].kind of
	EESDATA : begin
	    if ees[e].dreg <> NULLREG then begin
		if ees[e].size <> size then begin
		    if (ees[e].size = BYTESIZE) and (size = WORDSIZE) then begin
			if ees[e].ptype = tinteger then begin
			    Op('cvtbl');
			end else begin
			    Op('movzbl');
			end;
			R(ees[e].dreg); X; R(ees[e].dreg); L;
		    end;
		end;
		AddConst(e,ees[e].dreg);
	    end;
	end;
	EESADDR : begin
	    Eval(e);
	end;
	EESVAR : begin
	    if (ees[e].size <> size) or (ees[e].constInt <> 0) or
		(ees[e].addrOffset mod BYTESIZE <> 0)
	    then begin
		Eval(e);
	    end else begin
		CheckRegs(e,ees[e].size);
	    end;
	end;
    end;
end;

{ ensure that e can be used as a base address for a variable }
procedure Point{(e:EESElement)};
var
    r : Reg;
begin
    if (ees[e].kind = EESVAR) and (ees[e].size > WORDSIZE) then begin
	if IsOnlyBaseReg(e) then begin
	    { already just a base address }
	end else begin
	    r := AllocReg(REGEES,e,taddress);
	    MoveAddress(e); R(r); L;
	    { now a base register }
	    ees[e].kind := EESVAR;
	    ClearAddress(e);
	    FreeReg(ees[e].sreg);
	    FreeReg(ees[e].breg);
	    ees[e].breg := r;
	end;
    end else if (ees[e].kind = EESADDR) and AddrIsTReg(e) then begin
	{ address of t register is just the t reg }
	ees[e].kind := EESVAR;
	Error('Point: check address of t reg');
    end else begin
	Eval(e);
	if ees[e].kind = EESDATA then begin
	    ees[e].kind := EESVAR;
	    ees[e].breg := ees[e].dreg;
	    ees[e].dreg := NULLREG;
	    ClearAddress(e);
	end;
    end;
end;

procedure StoreWithConstWord(v,a:EESElement);
var
    k : integer;
begin
    { important special cases }
    k := ees[v].constInt;
    ees[v].constInt := 0;
    if (k = 0) then begin
	if (ees[v].kind = EESDATA) and (ees[v].dreg = NULLREG) then begin
	    { clear word }
	    Op('clrl'); Opnd(a); L;
	end else begin
	    { word move }
	    Op('movl'); Opnd(v); X; Opnd(a); L;
	end;
    end else if (ees[v].kind = EESDATA) and (ees[v].dreg = NULLREG) then begin
	{ constant move }
	Op('movl'); C('$'); I(k); X; Opnd(a); L;
    end else if (ees[v].kind = EESVAR) and (ees[a].kind = EESVAR)
	    and (ees[v].indirect=ees[a].indirect)
	    and (ees[v].addrOffset=ees[a].addrOffset)
	    and (ees[v].addrBlock=ees[a].addrBlock)
	    and (ees[v].addrMemType=ees[a].addrMemType)
	    and (ees[v].addrLevel=ees[a].addrLevel)
    	    and (ees[v].sreg = NULLREG) and (ees[a].sreg = NULLREG)
    	    and (ees[v].breg = NULLREG) and (ees[a].breg = NULLREG)
    then begin
	{ same variable! }
	if k = 1 then begin
	    Op('incl'); Opnd(v); L;
	end else if k = -1 then begin
	    Op('decl'); Opnd(v); L;
	end else if k > 0 then begin
	    Op('addl2'); C('$'); I(k); X; Opnd(v); L;
	end else if k < 0 then begin
	    Op('subl2'); C('$'); I(-k); X; Opnd(v); L;
	end;
    end else if k > 0 then begin
	Op('addl3'); C('$'); I(k); X; Opnd(v); X; Opnd(a); L;
    end else if k < 0 then begin
	Op('subl3'); C('$'); I(-k); X; Opnd(v); X; Opnd(a); L;
    end else begin
	Error('StoreWithConstWord: k=0?');
    end;
end;

procedure StoreWithConstByte(v,a:EESElement);
var
    k : integer;
begin
    { important special cases }
    k := ees[v].constInt;
    ees[v].constInt := 0;
    if (k = 0) then begin
	if (ees[v].kind = EESDATA) and (ees[v].dreg = NULLREG) then begin
	    { clear word }
	    Op('clrb'); Opnd(a); L;
	end else begin
	    { word move }
	    Op('movb'); Opnd(v); X; Opnd(a); L;
	end;
    end else if (ees[v].kind = EESDATA) and (ees[v].dreg = NULLREG) then begin
	{ constant move }
	Op('movb'); C('$'); I(k); X; Opnd(a); L;
    end else if (ees[v].kind = EESVAR) and (ees[a].kind = EESVAR)
	    and (ees[v].indirect=ees[a].indirect)
	    and (ees[v].addrOffset=ees[a].addrOffset)
	    and (ees[v].addrBlock=ees[a].addrBlock)
	    and (ees[v].addrMemType=ees[a].addrMemType)
	    and (ees[v].addrLevel=ees[a].addrLevel)
    	    and (ees[v].sreg = NULLREG) and (ees[a].sreg = NULLREG)
    	    and (ees[v].breg = NULLREG) and (ees[a].breg = NULLREG)
    then begin
	{ same variable! }
	if k = 1 then begin
	    Op('incb'); Opnd(v); L;
	end else if k = -1 then begin
	    Op('decb'); Opnd(v); L;
	end else if k > 0 then begin
	    Op('addb2'); C('$'); I(k); X; Opnd(v); L;
	end else if k < 0 then begin
	    Op('subb2'); C('$'); I(-k); X; Opnd(v); L;
	end;
    end else if k > 0 then begin
	Op('addb3'); C('$'); I(k); X; Opnd(v); X; Opnd(a); L;
    end else if k < 0 then begin
	Op('subb3'); C('$'); I(-k); X; Opnd(v); X; Opnd(a); L;
    end else begin
	Error('StoreWithConstByte: k=0?');
    end;
end;

procedure Store{(v,a:EESElement)};
var
    bitoffa, bitoffv, bitsize : integer;
    done : boolean;
    lab : LabelNumber;
begin
    done := false;
    if ees[a].kind <> EESVAR then begin
	Error('Store: address not a var');
    end;
    if ees[v].size <= WORDSIZE then begin
	{ make sure regs are OK }
	CheckRegs(a,ees[a].size);
	{ if destination is a variable, may be able to do it neatly }
	if ees[v].kind in [EESVAR,EESDATA] then begin
	    CheckRegs(v,ees[v].size);
	    bitoffa := ees[a].addrOffset mod BYTESIZE;
	    if ees[v].kind = EESDATA then begin
		bitoffv := 0;
	    end else begin
		bitoffv := ees[v].addrOffset mod BYTESIZE;
	    end;
	    if (bitoffa <> 0) or (bitoffv <> 0) then begin
		{ cannot handle as special case }
	    end else if (ees[a].size = WORDSIZE) and (ees[v].size = WORDSIZE)
	    then begin
		{ handle important special cases }
		StoreWithConstWord(v,a);
		done := true;
	    end else if (ees[a].size = BYTESIZE) and (ees[v].size = BYTESIZE)
	    then begin
		{ handle important special cases }
		StoreWithConstByte(v,a);
		done := true;
	    end else if ees[v].constInt <> 0 then begin
		{ cannot handle constant and different sizes, too }
	    end else if (ees[v].size = BYTESIZE) and (ees[a].size = WORDSIZE)
	    then begin
		{ byte to long, convert it }
		if ees[v].ptype = tinteger then begin
		    Op('cvtbl');
		end else begin
		    Op('movzbl');
		end;
		Opnd(v); X; Opnd(a); L;
		done := true;
	    end else if (ees[a].size = BYTESIZE) and (ees[v].size = WORDSIZE)
	    then begin
		{ long to byte, convert it }
		Op('cvtlb'); Opnd(v); X; Opnd(a); L;
		done := true;
	    end;
	end else if ees[v].kind = EESADDR then begin
	    { address is always a word and word aligned }
	    MoveAddress(v); Opnd(a); L;
	    done := true;
	end;
	if not done then begin
	    { couldn't do it the easy way, evaluate source }
	    Eval(v);
	    bitoffa := ees[a].addrOffset mod BYTESIZE;
	    if (ees[a].size = WORDSIZE) and (bitoffa = 0) then begin
		{ store it in a word }
		Op('movl'); Opnd(v); X; Opnd(a); L;
	    end else if (ees[a].size = BYTESIZE) and (bitoffa = 0) then begin
		{ store it in a byte }
		Op('cvtlb'); Opnd(v); X; Opnd(a); L;
	    end else begin
		ees[a].addrOffset := ees[a].addrOffset div BYTESIZE * BYTESIZE;
		CheckRegs(a,BYTESIZE); { instruction requires byte index }
		Op('insv'); Opnd(v); X; C('$'); I(bitoffa); X; C('$');
		    I(ees[a].size); X; Opnd(a); L;
	    end;
	end;
    end else if (ees[v].size = 2*WORDSIZE) and (ees[v].size = ees[a].size)
	    and (ees[v].kind in [EESVAR,EESDATA])
	    and (ees[v].sunits mod (2*WORDSIZE) = 0)
	    and (ees[a].sunits mod (2*WORDSIZE) = 0)
    then begin
	{ two word variable, do it neatly }
	{ make sure regs are OK }
	CheckRegs(v,ees[v].size);
	CheckRegs(a,ees[v].size);
	Op('movq'); Opnd(v); X; Opnd(a); L;
    end else begin
	{ multi-word, do a copy }
	Push(EESDATA);
	ees[top].size := WORDSIZE;
	ees[top].ptype := tinteger;
	ees[top].constInt := ees[v].size div WORDSIZE;
	Eval(top);
	Point(v);
	Point(a);
	lab := NewLabel;
	Lab(lab); C(':'); Op('movl'); Opnd(v); C('+'); X; Opnd(a); C('+'); L;
	Op('sobgtr'); Opnd(top); X; Lab(lab); L;
	Pop(1);
	bitsize := ees[v].size mod WORDSIZE;
	if bitsize <> 0 then begin
	    { some leftovers at the end }
	    { make vars of right size and recurse to move it }
	    ees[v].size := bitsize;
	    ees[a].size := bitsize;
	    ees[v].kind := EESVAR;
	    ees[v].kind := EESVAR;
	    Store(v,a);
	end;
    end;
end;

procedure ClearStack;
begin
    new(stackMem);
    stackMem^.offset := -1;
    stackMem^.size := 0;
    stackMem^.next := stackMem;
    stackMem^.prev := stackMem;
    stackMemSize := 0;
end;

procedure RemoveFromList(sm : StackMemNode);
begin
    sm^.next^.prev := sm^.prev;
    sm^.prev^.next := sm^.next;
    dispose(sm);
end;

function AllocStack(size : sizerange) : sizerange;
var
    sm : StackMemNode;
    found : boolean;
    offset : sizerange;
begin
    size := (size + WORDSIZE-1) div WORDSIZE;
    sm := stackMem^.next;
    found := false;
    while (sm <> stackMem) and not found do begin
	if size <= sm^.size then begin
	    found := true;
	end else begin
	    sm := sm^.next;
	end;
    end;
    if found then begin
	if size = sm^.size then begin
	    { take whole area }
	    offset := sm^.offset;
	    RemoveFromList(sm);
	end else begin
	    { take beginning, leave rest }
	    offset := sm^.offset;
	    sm^.offset := sm^.offset + size;
	    sm^.size := sm^.size - size;
	end;
    end else begin
	{ need to take more space }
	offset := stackMemSize;
	stackMemSize := stackMemSize + size;
    end;
    AllocStack := offset * WORDSIZE;
end;

procedure FreeStack{(offset, size : sizerange)};
var
    sm, nextsm : StackMemNode;
    found : boolean;
begin
    size := (size + WORDSIZE-1) div WORDSIZE;
    sm := stackMem^.next;
    found := false;
    while not found and (sm <> stackMem) do begin
	if (offset > sm^.offset) and (offset < sm^.offset+sm^.size) then begin
	    Error('FreeStack: stack screwed up');
	end;
	if (offset+size > sm^.offset) and (offset+size < sm^.offset+sm^.size)
	then begin
	    Error('FreeStack: stack screwed up');
	end;
	if (offset = sm^.offset+sm^.size) or (offset+size = sm^.offset)
		or (offset < sm^.offset)
	then begin
	    found := true;
	end else begin
	    sm := sm^.next;
	end;
	if offset+size = sm^.offset then begin
	    { add to beginning of area }
	    sm^.offset := sm^.offset - size;
	    sm^.size := sm^.size + size;
	end else if offset = sm^.offset+sm^.size then begin
	    { add to end of area }
	    sm^.size := sm^.size + size;
	    { check for plugging a hole }
	    if sm^.offset+sm^.size = sm^.next^.offset then begin
		sm^.size := sm^.size + sm^.next^.size;
		RemoveFromList(sm^.next);
	    end;
	end else begin
	    { no neighbors, add a new node }
	    nextsm := sm;
	    new(sm);
	    sm^.offset := offset;
	    sm^.size := size;
	    sm^.next := nextsm;
	    sm^.prev := nextsm^.prev;
	    sm^.prev^.next := sm;
	    nextsm^.prev := sm;
	end;
    end;
end;

procedure PushMultiWordTemp{(ptype:pcodetype;size : sizerange)};
var
    offset : sizerange;
begin
    Push(EESVAR);
    { allocate temp }
    offset := AllocStack(size);
    ees[top].smemoffset := offset;
    ees[top].smemsize := size;
    ees[top].size := size;
    ees[top].ptype := ptype;

    { make element point to temp }
    ees[top].addrLevel := curlev;
    ees[top].addrMemType := 's';
    ees[top].addrOffset := offset;
    ees[top].addrBlock := curblockid;
end;

procedure MakeMultiWordTemp{(e : EESElement)};
begin
    if ees[e].smemsize <> 0 then begin
	{ already a temp }
    end else begin
	{ get temp }
	PushMultiWordTemp(ees[e].ptype,ees[e].size);

	{ swap top and element }
	SwapEES(e,top);

	{ store old element into temp }
	Push(EESDATA);
	ees[top].ptype := tinteger;
	ees[top].size := WORDSIZE;
	ees[top].constInt := (ees[e].size + WORDSIZE-1) div WORDSIZE;
	MultiWordBinOp('movl',top-1,e);

	{ pop element }
	Pop(1);
    end;
end;