ees.p

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

	if not odd(regmask div regTable[r].maskbit) then begin
	    regmask := regmask + regTable[r].maskbit;
	end;
    end;
    if tworegs then begin
	regTable[succ(r)].state := state;
	regTable[succ(r)].eesElement := e;
	if regTable[succ(r)].maskbit <> 0 then begin
	    if not odd(regmask div regTable[succ(r)].maskbit) then begin
		regmask := regmask + regTable[succ(r)].maskbit;
	    end;
	end;
	regTable[r].regGroup := RGPAIR1;
	regTable[succ(r)].regGroup := RGPAIR2;
    end;
    AllocReg := r;
end;

procedure FreeReg{(var r : Reg)};
begin
    if not ActiveReg(r) then begin
	r := NULLREG;
    end else if regTable[r].state = REGDISP then begin
	Error('FreeReg REGDISP');
    end else if regTable[r].regGroup = RGSINGLE then begin
	regTable[r].state := REGFREE;
	regTable[r].eesElement := 0;
	r := NULLREG;
    end else begin
	if regTable[r].regGroup <> RGPAIR1 then begin
	    Error('FreeReg: error in register pairing');
	end;
	regTable[r].state := REGFREE;
	regTable[r].regGroup := RGSINGLE;
	regTable[r].eesElement := 0;
	regTable[succ(r)].state := REGFREE;
	regTable[succ(r)].regGroup := RGSINGLE;
	regTable[succ(r)].eesElement := 0;
	r := NULLREG;
    end;
end;

procedure DumpEES;
var i : integer;
begin
    writeln(output,'# EES: top=',top:1);
    for i:=top downto NUMTEMPS do begin
	if (i >= 1) or (ees[i].inUse) then begin
	    writeln(output,'# ees[',i:1,']', ', type=',ees[i].ptype:1,
		', size=',ees[i].size:1, ', kind=',ees[i].kind:1);
	    writeln(output,'#  constInt=', ees[i].constInt:1,
		', dreg=',regString[ees[i].dreg]:regStringSize[ees[i].dreg],
		', breg=',regString[ees[i].breg]:regStringSize[ees[i].breg],
		', sreg=',regString[ees[i].sreg]:regStringSize[ees[i].sreg],
		', sunits=',ees[i].sunits:1);
	    writeln(output,'#  addrLevel=',ees[i].addrLevel:1,
		', addrMemType=',ees[i].addrMemType:1,
		', addrOffset=',ees[i].addrOffset:1,
		', addrBlock=',ees[i].addrBlock:1);
	    writeln(output,'#  indirect=',ees[i].indirect:1,
		', smemoffset=',ees[i].smemoffset:1,
		', smemsize=',ees[i].smemsize:1,
		', inUse=',ees[i].inUse:1);
	end;
    end;
end;            { end of dumpeesstack }

procedure DumpReg;
var
    r : Reg;
begin
    writeln(output,'# Registers');
    for r := RETURNREG to LASTREG do begin
	write(output,'#',regString[r],' ',regTable[r].state);
	if regTable[r].state = REGDISP then begin
	    writeln(output,'l=',regTable[r].level:1,',iu=',regTable[r].inUse:1,
		'p=',regTable[r].param:1);
	end else if regTable[r].state = REGEES then begin
	    writeln(output,' ',regTable[r].eesElement:1,
		', regGroup=',regTable[r].regGroup:1);
	end else begin
	    writeln(output);
	end;
    end;
end;

function AllocDisplay{(level : integer; mt : char) : Reg};
var
    r : Reg;
    found : boolean;
begin
    if level < 0 then begin
	Error('AllocDisplay: level < 0');
    end;
    found := false;
    r := FIRSTREG;
    while not found and (r <= lastreg) do begin
	if regTable[r].state = REGDISP then begin
	    if (regTable[r].level = level) and
		(regTable[r].param = (mt = 'p'))
	    then begin
		found := true;
		regTable[r].inUse := true;
	    end;
	end;
	if not found then begin
	    r := succ(r);
	end;
    end;
    if not found then begin
	r := AllocReg(REGDISP,0,taddress);
	regTable[r].level := level;
	regTable[r].param := mt = 'p';
	regTable[r].inUse := true;
	Op('movl'); S('_runtime__display+'); I(level*4); X; R(r); L;
	if mt = 'p' then begin
	    Op('movl'); I(APOFF); C('('); R(r); C(')'); X; R(r); L;
	end;
    end;
    AllocDisplay := r;
end;

function DispReg{(level : integer; mt : char) : Reg};
var
    r : Reg;
    found : boolean;
begin
    if level < 1 then begin
	Error('DispReg: level < 1');
    end;
    found := false;
    r := FIRSTREG;
    if level = curlev then begin
	found := true;
	if mt = 'p' then begin
	    r := ap;
	end else begin
	    r := fp;
	end;
    end;
    while not found and (r <= lastreg) do begin
	if regTable[r].state = REGDISP then begin
	    found := (regTable[r].level = level)
			and (regTable[r].param = (mt = 'p'));
	end;
	if not found then begin
	    r := succ(r);
	end;
    end;
    if not found then begin
	Error('DispReg: reg not found');
    end;
    DispReg := r;
end;

procedure NeedDisp{(level : integer; mt : char)};
var
    r : Reg;
begin
    if level < 0 then begin
	Error('NeedDisp: level < 0');
    end;
    if (level >= 0) and (level < curlev) then begin
	r := AllocDisplay(level,mt);
    end;
end;

procedure FreeDisp;
var
    r : Reg;
begin
    for r := FIRSTREG to lastreg do begin
	if regTable[r].state = REGDISP then begin
	    regTable[r].inUse := false;
	end;
    end;
end;

procedure ClearDisp;
var
    r : Reg;
begin
    for r := FIRSTREG to lastreg do begin
	if regTable[r].state = REGDISP then begin
	    regTable[r].state := REGFREE;
	end;
    end;
end;

procedure ClearReg;
begin
    InitReg;
end;

procedure Registerize{(var r : Reg)};
var
    realr : Reg;
begin
    if r in [rt0..rt9] then begin
	{ nothing to do }
    end else begin
	if r in [RETURNREG..LASTREG] then begin
	    regTable[r].state := REGREG;
	    if regTable[r].regGroup = RGPAIR1 then begin
		if regTable[succ(r)].regGroup <> RGPAIR2 then begin
		    Error('Registerize: bad register pairing');
		end;
		regTable[succ(r)].state := REGREG;
	    end;
	end else if regTable[r].regGroup <> RGSINGLE then begin
	    realr := AllocReg(REGREG,0,tlongreal);
	    Op('movq'); R(r); X; R(realr); L;
	    FreeReg(r);
	    r := realr;
	end else begin
	    realr := AllocReg(REGREG,0,taddress);
	    Op('movl'); R(r); X; R(realr); L;
	    FreeReg(r);
	    r := realr;
	end;
	if regTable[r].state <> REGREG then begin
	    Error('Registerize: failed');
	end;
    end;
end;

procedure SaveRegs{(below : EESElement)};
var
    e : EESElement;
begin
    for e := below downto 1 do begin
	if ActiveReg(ees[e].sreg) then begin
	    Op('pushl'); R(ees[e].sreg); L;
	    FreeReg(ees[e].sreg);
	    ees[e].sreg := SAVEDREG;
	end;
	if ActiveReg(ees[e].breg) then begin
	    Op('pushl'); R(ees[e].breg); L;
	    FreeReg(ees[e].breg);
	    ees[e].breg := SAVEDREG;
	end;
	if ActiveReg(ees[e].dreg) then begin
	    if regTable[ees[e].dreg].regGroup <> RGSINGLE then begin
		Op('pushl'); R(succ(ees[e].dreg)); L;
		Op('pushl'); R(ees[e].dreg); L;
		FreeReg(ees[e].dreg);
		ees[e].dreg := SAVED2REG;
	    end else begin
		Op('pushl'); R(ees[e].dreg); L;
		FreeReg(ees[e].dreg);
		ees[e].dreg := SAVEDREG;
	    end;
	end;
    end;
    for e := -1 downto NUMTEMPS do begin
	if ees[e].inUse then begin
	    Error('Temp in use on SaveRegs');
	end;
    end;
end;

procedure RestoreRegs{(below : EESElement)};
var
    e : EESElement;
begin
    for e := 1 to below do begin
	if ees[e].sreg = SAVEDREG then begin
	    ees[e].sreg := AllocReg(REGEES,e,taddress);
	    Op('movl'); S('(sp)+'); X; R(ees[e].sreg); L;
	end;
	if ees[e].breg = SAVEDREG then begin
	    ees[e].breg := AllocReg(REGEES,e,taddress);
	    Op('movl'); S('(sp)+'); X; R(ees[e].breg); L;
	end;
	if ees[e].dreg = SAVEDREG then begin
	    ees[e].dreg := AllocReg(REGEES,e,tinteger);
	    Op('movl'); S('(sp)+'); X; R(ees[e].dreg); L;
	end else if ees[e].dreg = SAVED2REG then begin
	    ees[e].dreg := AllocReg(REGEES,e,tlongreal);
	    Op('movq'); S('(sp)+'); X; R(ees[e].dreg); L;
	end;
    end;
end;

{ MoveReg: reassign reg r to element e }
procedure MoveReg{(e : EESElement; r : Reg)};
begin
    if ActiveReg(r) then begin
	regTable[r].eesElement := e;
	if regTable[r].regGroup <> RGSINGLE then begin
	    if regTable[r].regGroup <> RGPAIR1 then begin
		Error('MoveReg: error in register pairing');
	    end;
	    regTable[succ(r)].eesElement := e;
	end;
    end;
end;

procedure SwapEES{(a,b : EESElement)};
var
    tmp : EESRecord;
begin
    { reassign regs }
    MoveReg(a,ees[b].dreg);
    MoveReg(a,ees[b].breg);
    MoveReg(a,ees[b].sreg);
    MoveReg(b,ees[a].dreg);
    MoveReg(b,ees[a].breg);
    MoveReg(b,ees[a].sreg);
    tmp := ees[a];
    ees[a] := ees[b];
    ees[b] := tmp;
end;