EU2ArithImpl.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Louis Monier April 1, 1986 2:00:01 pm PST
McCreight, April 1, 1986 11:21:51 am PST
DIRECTORY Basics, BitHacks, Dragon, DragOpsCross, DragOpsCrossUtils, EU2Arith, EU2Utils, Rope;
EU2ArithImpl: CEDAR PROGRAM
IMPORTS Basics, DragOpsCrossUtils, EU2Utils
EXPORTS EU2Arith =
BEGIN OPEN EU2Arith, EU2Utils;
-- Conversion between CARD and Word must always be done through the following procs
CToW: PROC [c: CARD] RETURNS [Word] ={
w: Word ← DragOpsCrossUtils.CardToWord[c];
RETURN [w]; -- was DragOpsCrossUtils.SwapHalves[w] (EMM)
};
WToC: PROC [w: Word] RETURNS [CARD] ={
w ← DragOpsCrossUtils.SwapHalves[w]; (EMM)
RETURN [DragOpsCrossUtils.WordToCard[w]];
};
-- Field extractions: bit 0 is the high-order bit
EBFLC: PUBLIC PROC [c: CARD, index: [0..32)] RETURNS [BOOL] = {
w: Word ← DragOpsCrossUtils.CardToWord[c];
RETURN[w[index]]};
EBFLC: PUBLIC PROC [c: CARD, index: [0..32)] RETURNS [BOOL] = {
RETURN [BitHacks.XthBitOfN[32-index, c]]};
EByteFLC: PUBLIC PROC [c: CARD, index: [0..4)] RETURNS[CARDINAL] = {
b: Byte ← DragOpsCrossUtils.WordToBytes[CToW[c]][index];
RETURN [DragOpsCrossUtils.ByteToCard[b]]};
-- Mask generation: mask[i] has "i" ones in the low-order bits region
mask: ARRAY [0..32] OF CARD = [
0B,
1B,  3B,  7B, 
17B,  37B,  77B,
177B,  377B,  777B, 
1777B,  3777B,  7777B,
17777B,  37777B,  77777B, 
177777B,  377777B,  777777B,
1777777B,  3777777B,  7777777B, 
17777777B,  37777777B,  77777777B,
177777777B,  377777777B,  777777777B, 
1777777777B, 3777777777B, 7777777777B,
17777777777B, 37777777777B];
-- Logical operations: order of bits is irrelevant
LC: PROC [n: Basics.LongNumber] RETURNS[CARD] ~ {RETURN[n.lc]};
LN: PROC [n: CARD] RETURNS[Basics.LongNumber] ~ {RETURN[[lc[n]]]};
WordNot: PUBLIC PROC [c: CARD] RETURNS [CARD] ~ {
RETURN [LC[Basics.DoubleNot[LN[c]]]]};
WordAnd: PUBLIC PROC [a, b: CARD] RETURNS [CARD] ~ {
RETURN [LC[Basics.DoubleAnd[LN[a], LN[b]]]]};
WordOr: PUBLIC PROC [a, b: CARD] RETURNS [CARD] ~ {
RETURN [LC[Basics.DoubleOr[LN[a], LN[b]]]]};
WordXor: PUBLIC PROC [a, b: CARD] RETURNS [CARD] ~ {
RETURN [LC[Basics.DoubleXor[LN[a], LN[b]]]]};
-- Move bits [ns..ns+w) of source CARD into bits [nd..nd+w) of destination CARD
MLCtoLC: PROC [source, destination: CARD, ns, nd, w: CARDINAL] RETURNS [c: CARD] ~ {
sWord: Word ← CToW[source];
nWord: Word ← CToW[destination];
IF w=0 THEN RETURN [destination];
FOR i: NAT IN [0..w) DO
nWord[nd+i] ← sWord[ns+i];
ENDLOOP;
RETURN [WToC[nWord]];
};
-- Arithmetical operations on signed numbers
-- Returns a+b+carry and c32, where a and b are considered to be signed numbers
LispTest: PUBLIC PROC [c: CARD] RETURNS [bogus: BOOL] ~ {
bogus ← HighHalf[c]/8192 IN [1..6];
};
LowHalf: PROC [a: CARD] RETURNS [CARD] ~ {RETURN [a MOD 65536]};
HighHalf: PROC [a: CARD] RETURNS [CARD] ~ {RETURN [a / 65536]};
DoubleADD: PUBLIC PROC [a, b: CARD, carry: BOOL] RETURNS [s: CARD, c32: BOOL] = {
ls: CARD ← LowHalf[a]+LowHalf[b]+(IF carry THEN 1 ELSE 0);
c: CARD ← HighHalf[ls]; -- half-carry
hs: CARD ← HighHalf[a]+HighHalf[b]+c;
IF c>1 THEN ERROR;
c32 ← HighHalf[hs]>0;
s ← 65536*LowHalf[hs]+LowHalf[ls];
};
-- Returns a-b-carry and c32, implemented as a+(~b)+1+(~carry)
DoubleSUB: PROC [a, b: CARD, carry: BOOL] RETURNS [dif: CARD, c32: BOOL] = {
[dif, c32] ← DoubleADD[a, WordNot[b], NOT carry]};
-- This proc mimics the hardware; it is also easier to understand
FieldOp: PUBLIC PROC [left, right, fieldDesc: CARD] RETURNS [result: CARD] = {
fd: DragOpsCross.FieldDescriptor ← DragOpsCrossUtils.CardToFieldDescriptor[fieldDesc MOD 65536];
shiftout, mask1, mask2, maskWithHole, background: CARD;
-- Assert[(fd.shift < 33) AND (fd.mask < 33)];
mask1 ← mask[fd.mask]; -- fd.mask ones on the low-order side
mask2 ← mask[fd.shift]; -- fd.shift ones on the low-order side
SELECT fd.shift FROM
0   => shiftout ← left; -- no shift
32   => shiftout ← right; -- full shift
ENDCASE => { -- Make shiftout with the 32-fd.shift low bits of aluLeft (high) and the fd.shift high bits of aluRight (low)
shiftout ← MLCtoLC[left, shiftout, fd.shift, 0, 32-fd.shift];
shiftout ← MLCtoLC[right, shiftout, 0, 32-fd.shift, fd.shift]
};
maskWithHole ← IF fd.insert THEN WordXor[mask1, mask2] ELSE mask1;
background ← IF fd.insert THEN right ELSE 0;
result ← WordOr[
WordAnd[shiftout, maskWithHole],      -- central portion
WordAnd[background, WordNot[maskWithHole]] -- both sides
];
};
-- Behaviour of pieces
ApplyAluOp: PUBLIC PROC [op: ALUOpcode, a, b: CARD, carryIn: BOOL] RETURNS [res: CARD, c32: BOOL] ~ {
SELECT op FROM
add => [res, c32]DoubleADD[a, b, carryIn];
and => {res WordAnd[a, b]; c32 ← carryIn};
or => {res WordOr[a, b]; c32 ← carryIn};
xor => {res WordXor[a, b]; c32 ← carryIn};
ENDCASE => ERROR;
};
OpToResult: PUBLIC PROC [op: Dragon.ALUOps, a, b: CARD, carryIn: BOOL] RETURNS [res: CARD, c32: BOOL] ~ {
IF aluOps[op].invertB THEN {b ← WordNot[b]; carryIn ← NOT carryIn};
[res, c32] ← ApplyAluOp[aluOps[op].op, a, b, carryIn];
};
OpToCarryOut: PUBLIC PROC [op: Dragon.ALUOps, computedC, prevC: BOOL] RETURNS [nextC: BOOL] ~ {
nextC ← SELECT aluOps[op].cOut FROM
prev => prevC,
zero => FALSE,
comp => computedC,
ncomp => ~computedC,
ENDCASE => ERROR;
};
OpToCarryIn: PUBLIC PROC [op: Dragon.ALUOps, c: BOOL] RETURNS [BOOL] ~ {
RETURN [SELECT aluOps[op].cIn FROM
zero => FALSE,
one => TRUE,
prev => c,
nprev => ~c,
ENDCASE => ERROR]
};
-- Mimicks the behaviour of the ALU
ALUOperation: PUBLIC PROC [aluOp: Dragon.ALUOps, a, b: CARD, prevC: BOOL] RETURNS [res: CARD, c32, nextC: BOOL] ~ {
carryIn: BOOL ← OpToCarryIn[aluOp, prevC];
IF aluOps[aluOp].invertB THEN b ← WordNot[b];
[res, c32]ApplyAluOp[aluOps[aluOp].op, a, b, carryIn];
nextC ← OpToCarryOut[aluOp, c32, prevC];
IF aluOps[aluOp].invertB THEN c32 ← NOT c32;
};
-- Explodes a 32-bit word in ram addresses and control bits; check format with IFU
ExplodeKReg: PUBLIC PROC [k: CARD] RETURNS
[a, b, c: CARD, st3AIsC: BOOL, lSrc, rSrc, stSrc: NAT] ~ {
n: CARDINAL;
a ← EByteFLC[k, 0];
b ← EByteFLC[k, 1];
c ← EByteFLC[k, 2];
n ← EByteFLC[k, 3];
stSrc ← n MOD 4;  n ← n/4;
rSrc ← n MOD 8;   n ← n/8;
lSrc ← n MOD 4;   n ← n/4;
st3AIsC ← n#0;
};
END.