opsubs.p

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

	MultiWordBinOp('bicl2',top-1,top-2);
    end;
    Pop(1);
end;

procedure opiorc;
begin
    check2(2,[tboolean]);

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

procedure opixac;
var
    sunits : sizerange;
    done : boolean;
begin
    if opdcount<>1 then error(9);

    done := false;
    sunits := Int(opd^[1]);
    if ees[top-1].indirect or (ees[top-1].kind in [EESDATA,EESVAR]) then begin
	{ get data value and make it a base reg }
	Eval(top-1);
	ees[top-1].breg := ees[top-1].dreg;
	ees[top-1].dreg := NULLREG;
	ees[top-1].kind := EESADDR;
	ees[top-1].size := WORDSIZE;
	ees[top-1].ptype := taddress;
	ClearAddress(top-1);
    end;
    { definitely have an address now }
    if ees[top].kind in [EESDATA,EESVAR] then begin
	{ fix up constant part }
	ees[top-1].addrOffset := ees[top-1].addrOffset
					+ sunits * ees[top].constInt;
	ees[top].constInt := 0;
	{ if only a constant, all done }
	done := (ees[top].kind = EESDATA) and (ees[top].dreg = NULLREG);
    end;
    if done then begin
	{ do nothing }
    end else begin
	if (ees[top].kind = EESVAR) and AddrIsTReg(top)
		and not ees[top].indirect
	then begin
	    { make it dreg: will become sreg below }
	    ees[top].dreg := MemTReg(ees[top].addrOffset);
	    ClearAddress(top);
	end else begin
	    Eval(top);
	end;
	if ees[top-1].sreg <> NULLREG then begin
	    { already a subscript, scale and add this one }
	    CheckSub(top-1,sunits);
	    Op('addl3'); R(ees[top].dreg); X;
		    TRegOpnd(ees[top-1].sreg,top-1); L;
	end else begin
	    { make this the subscript }
	    ees[top-1].sreg := ees[top].dreg;
	    MoveReg(top-1,ees[top].dreg);
	    ees[top].dreg := NULLREG;
	end;
	ees[top-1].sunits := sunits;
    end;
    Pop(1);
end;

procedure opinxc;
begin
end;

procedure oplabc;
var
    i : integer;
begin
    if pclbsize=0 then error(19);
    for i := 1 to pclbsize do opd^[1][i]:=pclabel[i];
    opdsizes^[1] := pclbsize;
    if opd11 = 'l' then begin
    end;
    writelabel(1); C(':'); L;
    ClearDisp;
end;

procedure oplaoc;
begin
    Push(EESADDR);
    ees[top].ptype := taddress;
    ees[top].size := ADDRSIZE;
    ees[top].addrLevel := 0;
    ees[top].addrMemType := opd^[2][1];
    ees[top].addrOffset := Int(opd^[3]);
    ees[top].addrBlock := Int(opd^[4]);
end;

procedure opldac;
begin
    Push(EESADDR);
    ees[top].ptype := taddress;
    ees[top].size := ADDRSIZE;
    ees[top].addrLevel := curlev - Int(opd^[2]);
    ees[top].addrMemType := opd^[3][1];
    ees[top].addrOffset := Int(opd^[4]);
    ees[top].addrBlock := Int(opd^[5]);
end;

procedure oplcac;
var
    allowable : boolean;
    size : sizerange;
    constlab : integer;
    i : integer;
    numChar : integer;
    c : char;
begin
    allowable := false;
    size := Int(opd^[2]);
    checkconstant(size);
    case opd11 of
	's': begin
	    eliminatequotes(3);
	    constlab := currentConstant;
	    currentConstant := currentConstant + 1;
	    Op('.data'); I(1); L;
	    Op('.align'); I(2); L;
	    C('k'); I(constlab); C(':'); L;
	    numChar := opdsizes^[3];
	    for i := 0 to numChar-1 do begin
		if i mod 8 = 0 then begin
		    Op('.byte');
		end;
		c := opd^[3][i+1];
		if c in [' '..'~'] then begin
		    C(''''); C(c);
		end else begin
		    I(ord(c));
		end;
		if (i mod 8 = 7) or (i = numChar-1) then begin
		    L;
		end else begin
		    C(',');
		end;
	    end;
	    Op('.space'); I((size+BYTESIZE-1) div BYTESIZE - numChar + 1); L;
	    Op('.text'); L;
	    Push(EESADDR);
	    ees[top].ptype := taddress;
	    ees[top].size := ADDRSIZE;
	    ees[top].addrMemType := 'k';
	    ees[top].addrBlock := constlab;
	    allowable := true;
	end;
	'S': begin
	    Push(EESADDR);
	    ees[top].ptype := taddress;
	    ees[top].size := ADDRSIZE;
	    SetConst(size,top);
	    allowable := true;
	end;
    end;
    if not allowable then error(1);
end;

procedure opldcc;
var
    allowable : boolean;
    size : sizerange;
    i : integer;
    numChar : integer;
    bits, bitpos : integer;
begin
    allowable := false;
    size := Int(opd^[2]);
    checkconstant(size);
    case opd11 of
	'a': begin
	    Push(EESADDR);
	    ees[top].ptype := taddress;
	    ees[top].size := ADDRSIZE;
	    ees[top].addrOffset := Int(opd^[3]);
	    allowable := true;
	end;
	'b': begin
	    Push(EESDATA);
	    ees[top].ptype := tboolean;
	    ees[top].size := BOOLSIZE;
	    ees[top].constInt := Int(opd^[3]);
	    allowable := true;
	end;
	'c': begin
	    eliminatequotes(3);
	    Push(EESDATA);
	    ees[top].ptype := tchar;
	    ees[top].size := BYTESIZE;
	    ees[top].constInt := ord(opd^[3][1]);
	    allowable := true;
	end;
	'i': begin
	    Push(EESDATA);
	    ees[top].ptype := tinteger;
	    ees[top].size := WORDSIZE;
	    ees[top].constInt := Int(opd^[3]);
	    allowable := true;
	end;
	'j': begin
	    Push(EESDATA);
	    ees[top].ptype := tinteger;
	    ees[top].size := WORDSIZE;
	    ees[top].constInt := Int(opd^[3]);
	    allowable := true;
	end;
	'n': begin
	    Push(EESDATA);
	    ees[top].ptype := taddress;
	    ees[top].size := WORDSIZE;
	    ees[top].constInt := 0;
	    allowable := true;
	end;
	'p': begin
	    Push(EESDATA);
	    ees[top].ptype := tproc;
	    ees[top].size := WORDSIZE;
	    ees[top].dreg := AllocReg(REGEES,top,taddress);
	    Op('movab'); C('_'); SO(opd^[3]); X; Opnd(top); L;
	    allowable := true;
	    end;
	'r': begin
	    Push(EESDATA);
	    ees[top].ptype := treal;
	    ees[top].size := WORDSIZE;
	    ees[top].dreg := AllocReg(REGEES,top,treal);
	    Op('movf'); S('$0f'); SO(opd^[3]); X; Opnd(top); L;
	    allowable := true;
	end;
	'R': begin
	    Push(EESDATA);
	    ees[top].ptype := tlongreal;
	    ees[top].size := 2*WORDSIZE;
	    ees[top].dreg := AllocReg(REGEES,top,tlongreal);
	    Op('movd'); S('$0f'); SO(opd^[3]); X; Opnd(top); L;
	    allowable := true;
	end;
	's': begin
	    { do same thing as lca, except make it a variable }
	    oplcac;
	    ees[top].kind := EESVAR;
	    ees[top].size := Int(opd^[2]);
	    ees[top].ptype := tstring;
	    allowable := true;
	end;
	'S': begin
	    if size > WORDSIZE then begin
		{ do same thing as lca, except make it a variable }
		oplcac;
		ees[top].kind := EESVAR;
		ees[top].size := Int(opd^[2]);
	    end else begin
		numChar := Int(opd^[3]);
		bits := 0;
		bitpos := 1;
		for i := 1 to numChar do begin
		    if opd^[4][i] = '1' then begin
			bits := bits + bitpos;
		    end;
		    bitpos := Mult(bitpos,2);
		end;
		Push(EESDATA);
		ees[top].constInt := bits;
		ees[top].kind := EESDATA;
		ees[top].size := WORDSIZE;
	    end;
	    ees[top].ptype := tset;
	    allowable := true;
	end;
    end;
    if not allowable then error(1);
end;

procedure opldoc;
begin
    Push(EESVAR);
    ees[top].ptype := associatedType[opd11];
    ees[top].size := Int(opd^[2]);
    ees[top].addrLevel := 0;
    ees[top].addrMemType := opd^[3][1];
    ees[top].addrOffset := Int(opd^[4]);
    ees[top].addrBlock := Int(opd^[5]);
end;

procedure opleqc;
begin
    Compare(associatedType[opd11],Int(opd^[2]));
    if opd11 in ['c','j'] then begin
	nextjump := jcleu;	{ set up to do leu jump }
    end else begin
	nextjump := jcle;	{ set up to do le jump }
    end;
end;

procedure oplesc;
begin
    Compare(associatedType[opd11],Int(opd^[2]));
    if opd11 in ['c','j'] then begin
	nextjump := jcltu;	{ set up to do ltu jump }
    end else begin
	nextjump := jclt;	{ set up to do lt jump }
    end;
end;

procedure oplocc;
begin
    DumpEES;
end; 

procedure oplodc;
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]);
end;

procedure opmodc;
var
    r : Reg;
    k : integer;
    done : boolean;
begin
    done := false;
    if (ees[top].kind = EESDATA) and (ees[top].dreg = NULLREG) then begin
	k := PowerOfTwo(ees[top].constInt);
	if k > 0 then begin
	    Eval(top-1);
	    { just mask off high order bits }
	    { (because value is a power of 2, -value is correct mask) }
	    Op('bicl2'); C('$'); I(-ees[top].constInt); X; Opnd(top-1); L;
	    Pop(1);
	    done := true;
	end;
    end;
    if done then begin
	{ all done }
    end else begin
	if opd11 = 'j' then begin
	    CallProc(opcep,'i',WORDSIZE,2,RTLONGMOD);
	end else begin
	    Check(top,WORDSIZE);
	    Eval(top-1);
	    r := AllocReg(REGTEMP,0,tinteger);
	    Op('divl3'); Opnd(top); X; Opnd(top-1); X; R(r); L;
	    Op('mull2'); Opnd(top); X; R(r); L;
	    Op('subl2'); R(r); X; Opnd(top-1); L;
	    FreeReg(r);
	    Pop(1);
	end;
    end;
end;

procedure opmvnc;
var
    size : sizerange;
begin
    if (opdcount<>1) then error(9);
    size := Int(opd^[1]);
    Eval(top);
    Op('mull2'); C('$'); I(size); X; Opnd(top); L;
    Op('addl2'); C('$'); I(WORDSIZE div BYTESIZE - 1); X; Opnd(top); L;
    Op('divl2'); C('$'); I(WORDSIZE div BYTESIZE); X; Opnd(top); L;
    MultiWordBinOp('movl',top-1,top-2);
    Pop(2);
end;

procedure opmovc;
begin
    if (opdcount<>1) then error(9);
    Push(EESDATA);
    ees[top].ptype := tinteger;
    ees[top].size := WORDSIZE;
    ees[top].constInt := (Int(opd^[1]) + WORDSIZE-1) div WORDSIZE;
    MultiWordBinOp('movl',top-1,top-2);
    Pop(2);
end;
procedure opmstc;
begin
end;

procedure opmupc;
var
    k, saveconst : integer;
begin
    if opd11 = 'r' then begin
	TwoOrThree('mulfN',top,top-1,treal,WORDSIZE);
    end else if opd11 = 'R' then begin
	TwoOrThree('muldN',top,top-1,tlongreal,2*WORDSIZE);
    end else if opd11 = 'a' then begin
	if (ees[top].kind = EESDATA) and (ees[top].dreg = NULLREG)
	    and (ees[top-1].kind = EESADDR) and (ees[top-1].breg = NULLREG)
	    and (ees[top-1].addrMemType = ' ') and (ees[top-1].sreg = NULLREG)
	then begin
	    { both operands are constant, top-1 is address }
	    ees[top-1].addrOffset := ees[top-1].addrOffset * ees[top].constInt;
	end else if (ees[top-1].kind = EESDATA) and (ees[top-1].dreg = NULLREG)
	    and (ees[top].kind = EESADDR) and (ees[top].breg = NULLREG)
	    and (ees[top].addrMemType = ' ') and (ees[top].sreg = NULLREG)
	then begin
	    { both operands are constant, top is address }
	    SwapEES(top,top-1);
	    ees[top-1].addrOffset := ees[top-1].addrOffset * ees[top].constInt;
	end else begin
	    if (ees[top-1].kind = EESADDR) and (ees[top-1].breg = NULLREG)
	    and (ees[top-1].addrMemType = ' ') and (ees[top-1].sreg = NULLREG)
	    then begin
		{ top-1 is constant }
		SwapEES(top,top-1);	{ make top constant }
	    end;
	    if (ees[top].kind <> EESADDR) or (ees[top].breg <> NULLREG)
		or (ees[top].addrMemType <> ' ') or (ees[top].sreg <> NULLREG)
		or (ees[top-1].kind = EESADDR)
	    then begin
		Error('opmupc: multiply by variable address');
	    end else begin
		if ees[top].constInt = BYTESIZE then begin
		    { do nothing }
		end else begin
		    saveconst := Mult(ees[top].addrOffset,ees[top-1].constInt);
		    ees[top-1].constInt := 0;
		    if (ees[top-1].kind = EESVAR) and not ees[top-1].indirect
			    and AddrIsTReg(top-1)
		    then begin
			{ make it dreg: will become sreg below }
			ees[top-1].dreg := MemTReg(ees[top-1].addrOffset);
			ClearAddress(top-1);
		    end else begin
			Eval(top-1);
		    end;
		    ees[top-1].kind := EESADDR;
		    ees[top-1].sunits := ees[top].addrOffset;
		    ees[top-1].sreg := ees[top-1].dreg;
		    ees[top-1].dreg := NULLREG;
		    ees[top-1].addrOffset := saveconst;
		end;
	    end;
	end;
	ees[top-1].ptype := taddress;
	ees[top-1].size := WORDSIZE;
    { else not address }
    end else if (ees[top].kind = EESDATA) and (ees[top].dreg = NULLREG)
        and (ees[top-1].kind = EESDATA) and (ees[top-1].dreg = NULLREG)
    then begin
	{ both operands are constant }
	ees[top-1].constInt := Mult(ees[top-1].constInt,ees[top].constInt);
    end else begin
	if (ees[top-1].kind = EESDATA) and (ees[top-1].dreg = NULLREG)
	then begin
	    { top-1 is constant }
	    SwapEES(top,top-1);	{ make top constant }
	end;
	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
		{ do constant part }
		saveconst := Mult(ees[top].constInt,ees[top-1].constInt);
		ees[top-1].constInt := 0;
		k := PowerOfTwo(ees[top].constInt);
		if k = 1 then begin
		    TwoOrThree('addlN',top-1,top-1,tinteger,WORDSIZE);
		end else if k = 2 then begin
		    Eval(top-1);
		    Op('moval'); S('0['); Opnd(top-1); C(']'); X;
			    Opnd(top-1); L;
		end else if k > 0 then begin
		    Eval(top-1);
		    Op('ashl'); C('$'); I(k); X; Opnd(top-1); X; Opnd(top-1); L;
		end else begin
		    TwoOrThree('mullN',top,top-1,tinteger,WORDSIZE);
		end;
		ees[top-1].constInt := saveconst;
	    end;
	end else begin
	    TwoOrThree('mullN',top,top-1,tinteger,WORDSIZE);
	end;
    end;
    Pop(1);
end;

procedure opmp2c;
var
    size, k : integer;
begin
    size := Int(opd^[2]);
    MakeVariable(top-1);