opsubs.p

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

    Check(top-1,size);
    Check(top,size);
    ees[top-1].size := size;
    if (size <> WORDSIZE) and (size <> BYTESIZE) then begin
	Error('opmp2: bad size');
    end;
    if opd11 = 'r' then begin
	ees[top-1].ptype := treal;
	Op('mulf2'); Opnd(top); X; Opnd(top-1); L;
    end else if opd11 = 'R' then begin
	ees[top-1].ptype := tlongreal;
	Op('muld2'); Opnd(top); X; Opnd(top-1); L;
    end else begin
	if (ees[top].kind = EESDATA) and (ees[top].dreg = NULLREG) then begin
	    { multiply by constant }
	    if ees[top].constInt = 1 then begin
		{ do nothing }
	    end else begin
		k := PowerOfTwo(ees[top].constInt);
		if k = 1 then begin
		    Op('addl2'); Opnd(top-1); X; Opnd(top-1); L;
		end else if k > 0 then begin
		    Op('ashl'); C('$'); I(k); X; Opnd(top-1); X; Opnd(top-1); L;
		end else begin
		    Op('mull2'); Opnd(top); X; Opnd(top-1); L;
		end;
	    end;
	end else begin
	    Op('mull2'); Opnd(top); X; Opnd(top-1); L;
	end;
    end;
    Pop(2);
end;

procedure opmusc;
var
    size : sizerange;
    r : Reg;
begin
    size := Int(opd^[1]);
    if (opdcount<>1) then error(9);
    if not (ees[top].ptype in [tinteger,tcardinal,tchar]) then
	error(2);
    if ees[top-1].ptype<>ees[top].ptype
	then error(4);
    if size <= WORDSIZE then begin
	Check(top-1,WORDSIZE);
	Eval(top);
	{ top-1 is start bit, top is stop bit }
	{ make top be count (stop-start+1) }
	Op('subl2'); Opnd(top-1); X; Opnd(top); L;
	Op('incl2'); Opnd(top); L;
	r := AllocReg(REGEES,top-1,tset);
	{ clear result reg }
	Op('clrl'); R(r); L;
	{ select range from all 1's    start pos      count bits    result }
	Op('insv'); C('$'); I(-1); X; Opnd(top-1); X; Opnd(top); X; R(r); L;
        Pop(2);
	Push(EESDATA);
	ees[top].size := size;
	ees[top].ptype := tset;
	ees[top].dreg := r;
    end else begin
      { call routine to generate set }
      CallProc (opcep, 'S', size, 3, RTMAKESET);
    end;
end;

procedure opnamc;
begin
    DumpReg;
end;

procedure opnegc;
begin
    Eval(top);
    if opd11 = 'r' then begin
	Op('mnegf'); Opnd(top); X; Opnd(top); L;
    end else if opd11 = 'R' then begin
	Op('mnegd'); Opnd(top); X; Opnd(top); L;
    end else begin
	Op('mnegl'); Opnd(top); X; Opnd(top); L;
    end;
end;

procedure opneqc;
begin
    Compare(associatedType[opd11],Int(opd^[2]));
    nextjump := jcne;       { set up for ne jump }
end;

procedure opnewc;
var size : sizerange;
begin
    if (ees[top].ptype<>tinteger) then error(2);
    if (opdcount<>1) then error(9);

    size := (Int(opd^[1]) + WORDSIZE-1) div WORDSIZE;
    if (ees[top].kind = EESDATA) and (ees[top].dreg = NULLREG) then begin
	{ constant size }
	ees[top].constInt := ees[top].constInt * size;
    end else begin
	{ compute size }
	Eval(top);
	Op('mull2'); C('$'); I(size); X; Opnd(top); L;
    end;
    CallProc(opcep,'a',ADDRSIZE,1,RTNEW);
end;

procedure opnotc;
begin
    check1(1,[tboolean]);

    PushConst(tboolean,BOOLSIZE,1);
    TwoOrThree('xorbN',top,top-1,tboolean,BOOLSIZE);
    Pop(1);
end;

procedure opoddc;
begin
    check1(0,[tinteger,tcardinal]);

    PushConst(tinteger,WORDSIZE,-2);
    TwoOrThree('biclN',top,top-1,tboolean,WORDSIZE);
    Pop(1);
    ees[top].ptype := tboolean;
    ees[top].size := BOOLSIZE;
end;

procedure opordc;
begin
    ees[top].ptype := tcardinal;
end;

procedure opretc;
var
    r : Reg;
    off : integer;
begin
    if (opdcount<>1) then error(9);
    if (opdsizes^[1]<>1) then error(1);
    if ((opd11='p') and (top<>0)) or
	 (opd11<>'p') and (top<>1)
    then begin
	Error('Inconsistent stack on return');
    end;
    if (opd11<>'p') then begin
	if ees[top].ptype = tlongreal then begin
	    Check(top,2*WORDSIZE);
	    if (ees[top].kind <> EESDATA) or (ees[top].dreg <> RETURNREG)
	    then begin
		r := AllocReg(REGRETURN,0,ees[top].ptype);
		Op('movq'); Opnd(top); X; R(r); L;
		FreeReg(r);
	    end;
	end else if ees[top].size > WORDSIZE then begin
	    Point(top);
	    if ees[top].breg <> RETURNREG then begin
		r := AllocReg(REGRETURN,0,taddress);
		Op('movl'); R(ees[top].breg); X; R(r); L;
		FreeReg(r);
	    end;
	end else begin
	    Check(top,WORDSIZE);
	    if (ees[top].kind <> EESDATA) or (ees[top].dreg <> RETURNREG)
	    then begin
		r := AllocReg(REGRETURN,0,ees[top].ptype);
		Op('movl'); Opnd(top); X; R(r); L;
		FreeReg(r);
	    end;
	end;
	Pop(1);
    end;
    if not nodisplay then begin
	{ restore display }
	Op('movl'); I(DISPOFF); C('('); R(fp); C(')'); X;
		S('_runtime__display+'); I(curlev*4); L;
    end;
    if curblockid = mainprogblockid then begin
	Op('pushl'); S('$0'); L;
	Op('calls'); S('$1,_exit'); L;
    end else if not internal then begin
	Op('ret'); L;
    end else begin
	if firsttreg <> NULLREG then begin
	    off := 4;
	    { restore regs from after end of activation record }
	    {  (-arsize-4)(fp), (-arsize-8)(fp), etc. }
	    for r := firsttreg to LASTREG do begin
		Op('movl'); S('(-a'); I(curblockid); C('-'); I(off);
			S(')(fp)'); X; R(r); L;
		off := off + 4;
	    end;
	end;
	Op('movl'); S('8(fp)'); X; R(ap); L;
	Op('movab'); S('16(fp)'); X; R(sp); L;
	Op('movl'); S('12(fp)'); X; R(fp); L;
	Op('rsb'); L;
    end;
    top := 0;
end;

procedure opsalc;
var
    size : integer;
begin
    if (opdcount<>1) then error(9);
    size := Int(opd^[1]);
    if size <= 8 then begin
	size := 1;
    end else begin
	{ round to words, units of bytes }
	size := (size+WORDSIZE-1) div WORDSIZE * (WORDSIZE div BYTESIZE);
    end;

    { stack starts out top=<number of elements>, top-1=<address of pointer> }

    { multiply unit size by number on top of stack }
    Eval(top);
    Op('mull2'); C('$'); I(size); X; Opnd(top); L;

    { round up to words (in units of bytes) }
    Op('addl2'); C('$'); I(WORDSIZE div BYTESIZE - 1); X; Opnd(top); L;
    Op('bicl2'); C('$'); I(WORDSIZE div BYTESIZE - 1); X; Opnd(top); L;

    { subtract this amount from sp to allocate }
    Op('subl2'); Opnd(top); X; R(sp); L;

    { convert bytes to words }
    Op('divl2'); C('$'); I(WORDSIZE div BYTESIZE); X; Opnd(top); L;

    { get two elements for pointers }
    PushReg(taddress,WORDSIZE,AllocReg(REGREG,0,taddress));
    PushReg(taddress,WORDSIZE,AllocReg(REGREG,0,taddress));

    { top=<reg> top-1=<reg> top-2=<length> top-3=<address of pointer> }
    SwapEES(top,top-2);
    { top=<length> top-1=<reg> top-2=<reg> top-3=<address of pointer> }

    { address of data pointer }
    ees[top-3].kind := EESVAR;

    { source of data }
    Op('movl'); Opnd(top-3); X; Opnd(top-1); L;
    { destination of data }
    Op('movl'); R(sp); X; Opnd(top-2); L;

    { top=<length> top-1=<pointer> top-2=<new area> top-3=<address of pointer> }
    { copy data }
    MultiWordBinOp('movl',top-1,top-2);

    { top=<pointer> top-1=<new area> top-2=<address of pointer> }

    { set pointer to point to new area }
    Op('movl'); R(sp); X; Opnd(top-2); L;

    Pop(3);
end;

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

    if ees[top].size <= WORDSIZE then begin
	TwoOrThree('xorlN',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('xorl2',top-1,top-2);
    end;
    Pop(1);
end;

procedure opsgsc;
var
    size : sizerange;
    r : Reg;
begin
    size := Int(opd^[1]);
    if (ees[top].ptype<>tinteger) and (ees[top].ptype<>tchar) then
	error(2);
    if (opdcount<>1) then error(9);

    if size <= WORDSIZE then begin
	Check(top,WORDSIZE);
	r := AllocReg(REGEES,top,tset);
	Op('clrl'); R(r); L;
	Op('insv'); S('$1'); X; Opnd(top); X; S('$1'); X; R(r); L;
	Pop(1);
	Push(EESDATA);
	ees[top].ptype := tset;
	ees[top].size := size;
	ees[top].dreg := r;
    end else begin
	{ allocate space }
	PushMultiWordTemp(tset,size);
	{ clear it out }
	Push(EESDATA);
	ees[top].ptype := tinteger;
	ees[top].size := WORDSIZE;
	ees[top].constInt := (size + WORDSIZE-1) div WORDSIZE;
	MultiWordUnOp('clrl',top-1);

	{ element to add }
	Eval(top-1);
	Op('insv'); S('$1'); X; Opnd(top-1); X; S('$1'); X; Opnd(top); L;

	{ get rid of top-1 }
	SwapEES(top,top-1);
	Pop(1);
    end;
end;

procedure opsmlc;
var
    r : Reg;
begin
    if (opdcount<>0) then error(9);
    if (ees[top].ptype<>tset) then error(2);

    if (ees[top].size>WORDSIZE) then begin
	Push(EESDATA);
	ees[top].ptype := tinteger;
	ees[top].size := WORDSIZE;
	ees[top].constInt := ees[top].size;
	CallProc(opcep,'i',WORDSIZE,2,RTSMALLEST);
    end else begin
	Eval(top); { instruction requires register }
	r := AllocReg(REGEES,top,tinteger);
	Op('ffs'); S('$0'); X; C('$'); I(ees[top].size); X; Opnd(top);
			    X; R(r); L;
	Pop(1);
	Push(EESDATA);
	ees[top].ptype := tinteger;
	ees[top].size := WORDSIZE;
	ees[top].dreg := r;
    end;
end;

procedure opsroc;
var
    ptype : pcodetype;
    size : sizerange;
begin
    ptype := associatedType[opd11];
    size := Int(opd^[2]);
    Push(EESVAR);
    ees[top].ptype := ptype;
    ees[top].size := size;
    ees[top].addrLevel := 0;
    ees[top].addrMemType := opd^[3][1];
    ees[top].addrOffset := Int(opd^[4]);
    ees[top].addrBlock := Int(opd^[5]);
    Store(top-1,top);
    Pop(2);
end;

procedure opstnc;
begin
    Push(EESVAR);
    ees[top].ptype := associatedType[opd11];
    ees[top].size := Int(opd^[2]);
    ees[top].addrLevel := curlev - Int(opd^[3]);
    ees[top].addrMemType := opd^[4][1];
    ees[top].addrOffset := Int(opd^[5]);
    ees[top].addrBlock := Int(opd^[6]);
    if AddrIsTReg(top) then begin
	{ store into t reg }
	Store(top-1,top);
	{ use t reg as value on top of stack }
	SwapEES(top-1,top);
    end else begin
	{ force Eval of value to keep put it in a register }
	Eval(top-1);
	Store(top-1,top);
    end;
    Pop(1);
end;

procedure opstoc;
begin
    MakeVariable(top);
    ees[top].ptype := associatedType[opd11];
    ees[top].size := Int(opd^[2]);
    Store(top-1,top);
    Pop(2);
end;

procedure opstpc;
begin
    if (opdcount<>0) then error(9);
    if (top<>0) then error(24);
end;

procedure opstrc;
begin
    Push(EESVAR);
    ees[top].ptype := associatedType[opd11];
    ees[top].size := Int(opd^[2]);
    ees[top].addrLevel := curlev - Int(opd^[3]);
    ees[top].addrMemType := opd^[4][1];
    ees[top].addrOffset := Int(opd^[5]);
    ees[top].addrBlock := Int(opd^[6]);
    Store(top-1,top);
    Pop(2);
end;

procedure opsubc;
begin
    if opd11 = 'r' then begin
	TwoOrThree('subfN',top,top-1,treal,WORDSIZE);
    end else if opd11 = 'R' then begin
	TwoOrThree('subdN',top,top-1,tlongreal,2*WORDSIZE);
    end else if (ees[top].kind = EESDATA) and (ees[top].dreg = NULLREG)
	and (ees[top-1].kind in [EESDATA,EESVAR])
    then begin
	{ top is constant }
	ees[top-1].constInt := ees[top-1].constInt - ees[top].constInt;
    end else begin
	TwoOrThree('sublN',top,top-1,tinteger,WORDSIZE);
    end;
    Pop(1);
end;

procedure opsb2c;
var
    size : integer;
begin
    size := Int(opd^[2]);
    MakeVariable(top-1);
    Check(top-1,size);
    Check(top,size);
    ees[top-1].size := size;
    if (size <> WORDSIZE) and (size <> BYTESIZE) then begin
	Error('opsb2: bad size');
    end;
    if opd11 = 'r' then begin
	ees[top-1].ptype := treal;
	Op('subf2'); Opnd(top); X; Opnd(top-1); L;
    end else if opd11 = 'R' then begin
	ees[top-1].ptype := tlongreal;
	Op('subd2'); Opnd(top); X; Opnd(top-1); L;
    end else begin
	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 begin
		Op('decl'); Opnd(top-1); L;
	    end;
	end else begin
	    if size = BYTESIZE then begin
		Op('subb2');
	    end else begin
		Op('subl2');
	    end;
	    Opnd(top); X; Opnd(top-1); L;
	end;
    end;
    Pop(2);
end;

procedure opsymc;
var
    size, offset, block  : integer;
    stabkind : char;
begin
    stabkind := opd11;
    if stabkind = 'l' then begin
	if opdcount <> 4 then begin
	    error(501);
	end;
	Op('.stabd'); SO(opd^[2]); X; SO(opd^[3]); X; SO(opd^[4]); L;
    end else if stabkind = 'X' then begin
	eliminatequotes(2);
	Op('.stabs'); C('"'); SOEscape(opd^[2],opdsizes^[2]); C('"'); X;
		SO(opd^[3]); X; SO(opd^[4]); X; I(0); X; I(0); L;
    end else begin
	eliminatequotes(2);
	Op('.stabs'); C('"'); SOEscape(opd^[2],opdsizes^[2]); C('"'); X;
		SO(opd^[3]); X; SO(opd^[4]); X;
	if stabkind = 's' then begin
	    SO(opd^[5]); X; writelabel(6); L;
	end else if stabkind in ['t','G'] then begin
	    size := Int(opd^[5]);
	    size := (size + BYTESIZE - 1) div BYTESIZE;
	    I(size); X; SO(opd^[6]); L;
	end else if stabkind = 'p' then begin
	    size := Int(opd^[5]);
	    size := (size + BYTESIZE - 1) div BYTESIZE;
	    offset := Int(opd^[7]);