opsubs.p

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

	    offset := (WORDSIZE + offset + BYTESIZE - 1) div BYTESIZE;
	    I(size); X; I(offset); L;
	end else if stabkind = 'v' then begin
	    size := Int(opd^[5]);
	    size := (size + BYTESIZE - 1) div BYTESIZE;
	    offset := Int(opd^[7]);
	    offset := (offset + BYTESIZE - 1) div BYTESIZE;
	    block := Int(opd^[8]);
	    I(size); X; C(opd^[6][1]); I(block); C('+'); I(offset); L;
	end else if stabkind = 'F' then begin
	    size := Int(opd^[5]);
	    size := (size + BYTESIZE - 1) div BYTESIZE;
	    I(size); X; C('_'); SO(opd^[6]); L;
	end else if stabkind = 'P' then begin
	    size := Int(opd^[5]);
	    size := (size + BYTESIZE - 1) div BYTESIZE;
	    I(size); X; I(0); L;
	end else if stabkind = 'm' then begin
	    I(0); X; I(0); L;
	end else begin
	    error(502);
	    L;
	end;
    end;
end;

procedure opsysc;
begin
    CallProc(opcep,'i',WORDSIZE,2,RTSYSTEM);
end;

procedure optjpc;
begin
    if (ees[top].ptype<>tboolean) then error(2);
    if (opdcount<>1) then error(9);

    Check(top,BOOLSIZE);
    Op('bitb'); S('$1'); X; Opnd(top); L;
    Op('jneq'); writelabel(1); L;
    Pop(1);
end;

procedure optrcc;
var
    r : Reg;
begin
    if opd11 = 'r' then begin
	Eval(top);
	Op('cvtfl'); Opnd(top); X; Opnd(top); L;
	ees[top].ptype := tinteger;
    end else if opd11 = 'R' then begin
	Eval(top);
	r := AllocReg(REGEES,top,tinteger);
	Op('cvtdl'); Opnd(top); X; R(r); L;
	FreeReg(ees[top].dreg);
	ees[top].dreg := r;
	ees[top].ptype := tinteger;
	ees[top].size := WORDSIZE;
    end else begin
	Error('Bad type');
    end;
end;

procedure optypc;
var
    ptype : pcodetype;
    size : integer;
begin
    if (opdcount<>1) then error(9);
    if (opdsizes^[1]<>1) then error(1);

    ptype := associatedType[opd11];
    size := datasize(ptype,ees[top].size);
    if (ees[top].kind in [EESDATA,EESVAR]) and
	    (size = ees[top].size)
	    { Experiment: only worry about size 
	    and (ees[top].ptype in [tinteger,tcardinal,taddress])
	    and (ptype in [tinteger,tcardinal,taddress])
	    }
    then begin
	{ don't need to eval }
    end else begin
	Eval(top);
    end;
    ees[top].ptype := ptype;
    ees[top].size := datasize(ees[top].ptype,ees[top].size);
end;

procedure opujpc;
begin
    if opdcount<>1 then error(9);
    Op('jbr'); writelabel(1); L;
end;

procedure opunic;
var
    wordsize : sizerange;
begin
    check2(2,[tset]);

    if ees[top].size <= WORDSIZE then begin
	TwoOrThree('bislN',top,top-1,tset,WORDSIZE);
    end else begin
	wordsize := (ees[top].size + WORDSIZE-1) div WORDSIZE;
	Eval(top-1);
	Push(EESDATA);
	ees[top].ptype := tinteger;
	ees[top].size := WORDSIZE;
	ees[top].constInt := wordsize;
	MultiWordBinOp('bisl2',top-1,top-2);
    end;
    Pop(1);
end;

procedure opxjpc;
var
    lb, ub : integer;
begin
    if not (ees[top].ptype in [tinteger,tcardinal,tchar]) then
	error(2);

    lb := Int(opd^[3]);
    ub := Int(opd^[4]);
    Eval(top);
    Op('cmpl'); Opnd(top); X; C('$'); I(lb); L;
    Op('jlss'); writelabel(2); L;
    Op('cmpl'); Opnd(top); X; C('$'); I(ub); L;
    Op('jgtr'); writelabel(2); L;
    Op('movl'); C('('); I(-lb*4); C('+'); writelabel(1); S(')[');
		    Opnd(top); C(']'); X; Opnd(top); L;
    Op('jmp'); C('('); Opnd(top); C(')'); L;
    Pop(1);
end;

procedure opzerc;
var
    size : sizerange;
begin
    Push(EESDATA);
    ees[top].ptype := tinteger;
    ees[top].size := WORDSIZE;
    size := Int(opd^[1]);
    if (opdcount<>1) then error(9);
    if ((size mod WORDSIZE)<>0) then error(1);

    ees[top].constInt := size div WORDSIZE;
    MultiWordUnOp('clrl',top-1);
    Pop(1);
end;

procedure opsavc;
var
    e : EESElement;
begin
    e := -Int(opd^[1])-1;
    if ees[e].inUse and (opd^[2][1] <> 'r') then begin
	Error('sav: in use');
    end;
    if not ees[e].inUse and (opd^[2][1] = 'r') then begin
	Error('sav r: in use');
    end;
    if opd^[2][1] = 'r' then begin
	{ replace a value already there }
	if ees[e].size <= WORDSIZE then begin
	    Eval(top);
	    Op('movl'); Opnd(top); X; Opnd(e); L;
	end else begin
	    Store(top,e);
	end;
	Pop(1);
    end else if opd^[2][1] = 'm' then begin
	{ move a value }
	Eval(top);
	SwapEES(top,e);
	Pop(1);
    end else if opd^[2][1] = 'c' then begin
	if ees[top].kind = EESDATA then begin
	    { ok value to save }
	end else if (ees[top].kind = EESADDR) and (ees[top].sreg = NULLREG) and
	    not ees[top].indirect
	then begin
	    { ok value to save }
	end else begin
	    Eval(top);
	end;
	SwapEES(top,e);
	{ copy stack element }
	ees[top] := ees[e];
	{ deallocate memory (temp has it) }
	ees[top].smemoffset := 0;
	ees[top].smemsize := 0;
	{ reallocate and copy register }
	if ees[top].dreg <> NULLREG then begin
	    ees[top].dreg := AllocReg(REGEES,top,ees[top].ptype);
	    Op('movl'); R(ees[e].dreg); X; R(ees[top].dreg); L;
	end;
	if ees[top].breg <> NULLREG then begin
	    ees[top].breg := AllocReg(REGEES,top,taddress);
	    Op('movl'); R(ees[e].breg); X; R(ees[top].breg); L;
	end;
    end else begin
	Error('sav: not r, c or m');
    end;
end;

procedure opusec;
var
    e : EESElement;
begin
    e := -Int(opd^[1])-1;
    if not ees[e].inUse then begin
	Error('use: not in use');
    end;
    Push(EESDATA);
    if opd^[2][1] = 'c' then begin
	{ copy stack element (will get type, etc., from saved element }
	ees[top] := ees[e];
	{ deallocate memory (temp has it) }
	ees[top].smemoffset := 0;
	ees[top].smemsize := 0;
	{ reallocate and copy register }
	if ees[top].dreg <> NULLREG then begin
	    ees[top].dreg := AllocReg(REGEES,top,ees[top].ptype);
	    Op('movl'); R(ees[e].dreg); X; R(ees[top].dreg); L;
	end;
	if ees[top].breg <> NULLREG then begin
	    ees[top].breg := AllocReg(REGEES,top,taddress);
	    Op('movl'); R(ees[e].breg); X; R(ees[top].breg); L;
	end;
    end else if opd^[2][1] = 'm' then begin
	SwapEES(e,top);
	ClearEES(e);
    end else if opd^[2][1] = 'd' then begin
	SwapEES(e,top);
	ClearEES(e);
	Pop(1);
    end else begin
	Error('use: not c, m or d');
    end;
end;

procedure opparc;
begin
end;

procedure opcjpc;
begin
    Op('.long'); writelabel(1); L;
end;

procedure opvinc;
var
    size : integer;
begin
    size := Int(opd^[1]);
    MakeVariable(top-1);
    ees[top-1].size := size;
    ees[top-1].ptype := tinteger;
    Check(top-1,size);
    Check(top,size);
    if (ees[top].kind = EESDATA) and (ees[top].dreg = NULLREG) and
	    (ees[top].constInt = 1)
    then begin
	if size = BYTESIZE then begin
	    Op('incb'); Opnd(top-1); L;
	end else if size = WORDSIZE then begin
	    Op('incl'); Opnd(top-1); L;
	end else begin
	    Error('opvinc: not BYTESIZE or WORDSIZE');
	end;
    end else begin
	if size = BYTESIZE then begin
	    Op('addb2');
	end else if size = WORDSIZE then begin
	    Op('addl2');
	end else begin
	    Error('opvinc: not BYTESIZE or WORDSIZE');
	end;
	Opnd(top); X; Opnd(top-1); L;
    end;
    Pop(2);
end;

procedure opvdec;
var
    size : integer;
begin
    size := Int(opd^[1]);
    MakeVariable(top-1);
    ees[top-1].size := size;
    ees[top-1].ptype := tinteger;
    Check(top-1,size);
    Check(top,size);
    if (ees[top].kind = EESDATA) and (ees[top].dreg = NULLREG) and
	    (ees[top].constInt = 1)
    then begin
	if size = BYTESIZE then begin
	    Op('decb'); Opnd(top-1); L;
	end else if size = WORDSIZE then begin
	    Op('decl'); Opnd(top-1); L;
	end else begin
	    Error('opdecc: not BYTESIZE or WORDSIZE');
	end;
    end else begin
	if size = BYTESIZE then begin
	    Op('subb2');
	end else if size = WORDSIZE then begin
	    Op('subl2');
	end else begin
	    Error('opdecc: not BYTESIZE or WORDSIZE');
	end;
	Opnd(top); X; Opnd(top-1); L;
    end;
    Pop(2);
end;

procedure opsinc;
var
    mask, size : integer;
begin
    if (ees[top-1].ptype<>taddress) then error(2);
    if not (ees[top].ptype in [tinteger,tcardinal,tchar]) then begin
	error(4);
    end;
    size := Int(opd^[1]);
    MakeVariable(top-1);
    ees[top-1].size := size;
    ees[top-1].ptype := tset;
    if ees[top-1].addrOffset mod BYTESIZE <> 0 then begin
	Eval(top);
	ees[top].constInt := ees[top].constInt +
			(ees[top-1].addrOffset mod BYTESIZE);
	ees[top-1].addrOffset :=
			(ees[top-1].addrOffset div BYTESIZE) * BYTESIZE;
    end else begin
	Check(top,WORDSIZE);
    end;
    Check(top-1,ees[top-1].size);
    if (ees[top-1].size <= WORDSIZE) and (ees[top].kind = EESDATA) and
	    (ees[top].dreg = NULLREG)
    then begin
	mask := power(2,ees[top].constInt);
	if ees[top-1].size <= BYTESIZE then begin
	    Op('bisb2'); C('$'); I(mask); X; Opnd(top-1); L;
	end else begin
	    Op('bisl2'); C('$'); I(mask); X; Opnd(top-1); L;
	end;
    end else begin
	CheckRegs(top-1,BYTESIZE);	{ instruction requires byte index }
	Op('insv'); S('$1'); X; Opnd(top); X; S('$1'); X; Opnd(top-1); L;
    end;
    Pop(2);
end;

procedure opsexc;
var
    mask, size : integer;
begin
    if (ees[top-1].ptype<>taddress) then error(2);
    if not (ees[top].ptype in [tinteger,tcardinal,tchar]) then begin
	error(4);
    end;
    size := Int(opd^[1]);
    MakeVariable(top-1);
    ees[top-1].size := size;
    ees[top-1].ptype := tset;
    if ees[top-1].addrOffset mod BYTESIZE <> 0 then begin
	Eval(top);
	ees[top].constInt := ees[top].constInt +
			(ees[top-1].addrOffset mod BYTESIZE);
	ees[top-1].addrOffset :=
			(ees[top-1].addrOffset div BYTESIZE) * BYTESIZE;
    end else begin
	Check(top,WORDSIZE);
    end;
    Check(top-1,ees[top-1].size);
    if (ees[top-1].size <= WORDSIZE) and (ees[top].kind = EESDATA) and
	    (ees[top].dreg = NULLREG)
    then begin
	mask := power(2,ees[top].constInt);
	if ees[top-1].size <= BYTESIZE then begin
	    Op('bicb2'); C('$'); I(mask); X; Opnd(top-1); L;
	end else begin
	    Op('bicl2'); C('$'); I(mask); X; Opnd(top-1); L;
	end;
    end else begin
	Check(top,WORDSIZE);
	CheckRegs(top-1,BYTESIZE);	{ instruction requires byte index }
	Op('insv'); S('$0'); X; Opnd(top); X; S('$1'); X; Opnd(top-1); L;
    end;
    Pop(2);
end;

procedure opforc;
var
    size : integer;
    ptype : pcodetype;
    downward : boolean;
    r : Reg;
begin
    ptype := associatedType[opd11];
    size := Int(opd^[2]);
    MakeVariable(top-2);	{ loop index }
    ees[top-2].size := size;
    ees[top-2].ptype := ptype;
    Check(top-2,size);
    Check(top,WORDSIZE);
    if (ees[top-1].kind = EESADDR) and (ptype = taddress) then begin
	if (ees[top-1].addrMemType <> ' ') or (ees[top-1].breg <> NULLREG)
	    or (ees[top-1].sreg <> NULLREG)
	    or (ees[top-1].addrOffset mod BYTESIZE <> 0)
	then begin
	    Error('opforc: non-constant address increment');
	end else begin
	    ees[top-1].kind := EESDATA;
	    ees[top-1].constInt := ees[top-1].addrOffset div BYTESIZE;
	    ClearAddress(top-1);
	end;
    end;
    if (ees[top-1].kind <> EESDATA) or (ees[top-1].dreg <> NULLREG) then begin
	Error('opforc: non-constant increment');
    end;
    downward := ees[top-1].constInt < 0;
    if size = WORDSIZE then begin
	if downward then begin
	    if ees[top-1].constInt = -1 then begin
		Op('decl'); Opnd(top-2); L;
	    end else begin
		ees[top-1].constInt := -ees[top-1].constInt;
		Op('subl2'); Opnd(top-1); X; Opnd(top-2); L;
	    end;
	end else begin
	    if ees[top-1].constInt = 1 then begin
		Op('incl'); Opnd(top-2); L;
	    end else begin
		Op('addl2'); Opnd(top-1); X; Opnd(top-2); L;
	    end;
	end;
	if (ees[top].kind = EESDATA) and (ees[top].dreg = NULLREG) and
	    (ees[top].constInt = 0)
	then begin
	    { no need to do compare }
	end else begin
	    Op('cmpl'); Opnd(top-2); X; Opnd(top); L;
	end;
	if downward then begin
	    Op('jgeq'); writelabel(3); L;
	end else begin
	    Op('jleq'); writelabel(3); L;
	end;
	{*** slower! should be generated only for variable increments
	    Op('acbl'); Opnd(top); X; Opnd(top-1); X; Opnd(top-2); X; 
			    writelabel(3); L;
	***}
    end else if size = BYTESIZE then begin
	{ do byte arithmetic as word to avoid overflow problems }
	r := AllocReg(REGTEMP,0,tinteger);
	if ptype in [tcardinal,tchar] then begin
	    Op('movzbl'); Opnd(top-2); X; R(r); L;
	end else begin
	    Op('cvtbl'); Opnd(top-2); X; R(r); L;
	end;
	Op('addl2'); Opnd(top-1); X; R(r); L;
	Op('movb'); R(r); X; Opnd(top-2); L;
	Op('cmpl'); R(r); X; Opnd(top); L;
	if downward then begin
	    Op('jgequ'); writelabel(3); L;
	end else begin
	    Op('jlequ'); writelabel(3); L;
	end;
    end else begin
	Error('opforc: not BYTESIZE or WORDSIZE');
    end;
    Pop(3);
end;

procedure opmaxc;
var lab : LabelNumber;
begin
    check2(1,[tinteger,tcardinal,treal,tlongreal]);

    Eval(top-1);
    lab := NewLabel;
    if opd11 = 'r' then begin
	Check(top,WORDSIZE);
	Op('cmpf'); Opnd(top-1); X; Opnd(top); L;
	Op('jgeq'); Lab(lab); L;
	Op('movf'); Opnd(top); X; Opnd(top-1); L;
    end else if opd11 = 'R' then begin
	Check(top,2*WORDSIZE);
	Op('cmpd'); Opnd(top-1); X; Opnd(top); L;
	Op('jgeq'); Lab(lab); L;
	Op('movd'); Opnd(top); X; Opnd(top-1); L;
    end else begin
	Check(top,WORDSIZE);
	Op('cmpl'); Opnd(top-1); X; Opnd(top); L;
	Op('jgeq'); Lab(lab); L;
	Op('movl'); Opnd(top); X; Opnd(top-1); L;