QCardImpl:
CEDAR
PROGRAM
IMPORTS Basics,
IO
EXPORTS QCard =
BEGIN OPEN Basics, QCard;
QCError: PUBLIC SIGNAL[desc: IO.ROPE] = CODE;
QCFromCard:
PUBLIC
PROC[card:
CARD]
RETURNS[qcard:
QCARD] =
{t: LongNumber; t.lc ← card; qcard[3] ← t.lowbits; qcard[2] ← t.highbits};
QCToCard:
PUBLIC
PROC[qcard:
QCARD]
RETURNS[card:
CARD] = {
t: LongNumber; t.lowbits ← qcard[3]; t.highbits ← qcard[2];
IF qcard[0]#0 OR qcard[1]#0 THEN SIGNAL QCError[desc: "QCARD too large for CARD"];
RETURN[t.lc] };
QCFromRope:
PUBLIC
PROC[rope:
IO.
ROPE, base: [2..36] ← 10]
RETURNS[qcard:
QCARD] = {
in: IO.STREAM ← IO.RIS[rope];
char: CHARACTER;
val: CARDINAL ← 0;
DO
IF in.EndOf[] THEN RETURN[qcard];
SELECT char ← in.GetChar[]
FROM
IO.CR => RETURN[qcard];
IN ['0..'9] => {val ← char-'0; EXIT};
IN ['a..'z] => {val ← 10+char-'a; EXIT};
IN ['A..'Z] => {val ← 10+char-'A; EXIT};
ENDCASE => SIGNAL QCError[desc: "Rope is not a valid QCard"];
ENDLOOP;
DO
IF val NOT IN [0..base) THEN SIGNAL QCError[desc: "Digit out of range"];
qcard ← QCMul[qcard, base].prod;
qcard ← QCAdd[qcard, [0,0,0,val], 0].sum;
IF in.EndOf[] THEN EXIT;
SELECT char ← in.GetChar[]
FROM
IN ['0..'9] => {val ← char-'0};
IN ['a..'z] => {val ← 10+char-'a};
IN ['A..'Z] => {val ← 10+char-'A};
ENDCASE => EXIT;
ENDLOOP;
RETURN[qcard]};
QCToRope:
PUBLIC
PROC
[qcard: QCARD, just: Justification ← right, fieldWidth: CARDINAL ← 0, base: [2..36] ← 10]
RETURNS[rope: IO.ROPE] = {
out: IO.STREAM ← IO.ROS[];
temp: QCARD ← qcard;
val: CARDINAL;
count: CARDINAL ← 0;
chars: LIST OF CHARACTER ← NIL;
WHILE
NOT QCZero[temp]
DO
count ← count + 1;
[temp, val] ← QCDiv[temp, base];
chars ← CONS['0+val, chars];
ENDLOOP;
IF count=0 THEN {count ← 1; chars ← CONS['0, chars]};
IF just=right THEN THROUGH [count..fieldWidth) DO out.PutChar[' ] ENDLOOP;
IF just=zerofill THEN THROUGH [count..fieldWidth) DO out.PutChar['0] ENDLOOP;
FOR chars ← chars, chars.rest WHILE chars#NIL DO out.PutChar[chars.first] ENDLOOP;
IF just=left THEN THROUGH [count..fieldWidth) DO out.PutChar[' ] ENDLOOP;
RETURN[out.RopeFromROS[]]};
QCZero: PUBLIC PROC[x: QCARD] RETURNS[z: BOOL] = {RETURN[x=ALL[0]]};
QCSftLt:
PUBLIC
PROC[x:
QCARD, in, size:
CARDINAL]
RETURNS[z:
QCARD,out:
CARDINAL] ={
out ← BITSHIFT[x[0], size-16];
z[0] ← BITOR[ BITSHIFT[x[0], size], BITSHIFT[x[1], size-16]];
z[1] ← BITOR[ BITSHIFT[x[1], size], BITSHIFT[x[2], size-16]];
z[2] ← BITOR[ BITSHIFT[x[2], size], BITSHIFT[x[3], size-16]];
z[3] ← BITOR[ BITSHIFT[x[3], size], BITSHIFT[in, size-16]] };
QCSftRt:
PUBLIC
PROC[x:
QCARD, in, size:
CARDINAL]
RETURNS[z:
QCARD,out:
CARDINAL] ={
out ← BITSHIFT[x[3], 16-size];
z[3] ← BITOR[ BITSHIFT[x[3], -size], BITSHIFT[x[2], 16-size]];
z[2] ← BITOR[ BITSHIFT[x[2], -size], BITSHIFT[x[1], 16-size]];
z[1] ← BITOR[ BITSHIFT[x[1], -size], BITSHIFT[x[0], 16-size]];
z[0] ← BITOR[ BITSHIFT[x[0], -size], BITSHIFT[in, 16-size]] };
QCAdd:
PUBLIC
PROC[x, y:
QCARD, cIn:
CARDINAL]
RETURNS[cOut: CARDINAL, sum: QCARD] = {
cOut ← cIn;
FOR i:
CARD
DECREASING
IN [0..4)
DO [cOut, sum[i]] ← CARDAdd[x[i], y[i], cOut] ENDLOOP};
QCSub:
PUBLIC
PROC[x, y:
QCARD, cIn:
CARDINAL]
RETURNS[cOut: CARDINAL, dif: QCARD] = {
cOut ← (cIn+1) MOD 2;
FOR i:
CARD
DECREASING
IN [0..4)
DO [cOut, dif[i]] ← CARDAdd[x[i], BITNOT[y[i]], cOut]
ENDLOOP;
RETURN[(cOut+1) MOD 2, dif]};
QCMul:
PUBLIC
PROC[x:
QCARD, y:
CARDINAL]
RETURNS[carry: CARDINAL, prod: QCARD] = {
sum, prdt: LongNumber; sum.lc ← 0;
FOR i:
CARD
DECREASING
IN [0..4)
DO
prdt.lc ← LongMult[y, x[i]];
sum.lc ← prdt.lc + sum.lc;
prod[i] ← sum.lowbits;
sum.lc ← sum.highbits;
ENDLOOP;
RETURN[sum.highbits, prod]};
QCMulDbl:
PUBLIC
PROC[x:
QCARD, y:
QCARD]
RETURNS[prodH, prodL:
QCARD] = {
cy: CARDINAL;
sum, prod: LongNumber;
acc: ARRAY[0..8) OF CARDINAL ← ALL[0];
FOR jj:
CARDINAL
DECREASING
IN [0..4)
DO
sum.lc ← 0;
FOR ii:
CARDINAL
DECREASING
IN [0..4)
DO
prod.lc ← LongMult[y[jj], x[ii]];
sum.lc ← prod.lc + sum.lc;
prodH[ii] ← sum.lowbits;
sum.lc ← sum.highbits ENDLOOP;
cy ← 0;
FOR ii:
CARDINAL
DECREASING
IN [0..4)
DO
[cy, acc[ii+jj+1]] ← CARDAdd[acc[ii+jj+1], prodH[ii], cy] ENDLOOP;
[cy, acc[jj]] ← CARDAdd[acc[jj], sum.highbits, cy];
FOR ii:
CARDINAL
DECREASING
IN [0..jj)
WHILE cy#0
DO
[cy, acc[ii]] ← CARDAdd[acc[ii], 0, cy] ENDLOOP
ENDLOOP;
FOR jj: CARDINAL DECREASING IN [0..4) DO prodH[jj] ← acc[jj]; prodL[jj] ← acc[jj+4] ENDLOOP };
QCDivDbl:
PUBLIC
PROC[numH, numL, den:
QCARD]
RETURNS[qRes, mRes:
QCARD] = {
qq, ii: INTEGER ← 0;
nshift: CARDINAL ← 0;
cy: CARDINAL ← 0;
lprod, lsum: LongNumber;
dvsr: ARRAY[ 0..4) OF CARDINAL ← den;
rem: ARRAY[-1..8) OF CARDINAL ← ALL[0];
temp: ARRAY[-1..4) OF CARDINAL ← ALL[0];
FOR ii IN [0..4) DO rem[ii+0] ← numH[ii] ENDLOOP;
FOR ii IN [0..4) DO rem[ii+4] ← numL[ii] ENDLOOP;
IF dvsr = ALL[0] THEN SIGNAL QCError[desc: "Divide by zero"];
IF rem = ALL[0] THEN RETURN[ALL[0], ALL[0]];
WHILE dvsr[0]=000000B
DO
nshift ← nshift+16;
IF rem[-1] # 0 THEN SIGNAL QCError[desc: "Divide Overflow"];
FOR ii IN [ 0..3) DO dvsr[ii] ← dvsr[ii+1] ENDLOOP; dvsr[3] ← 0;
FOR ii IN [-1..7) DO rem[ii] ← rem[ii+1] ENDLOOP; rem[7] ← 0;
ENDLOOP;
WHILE dvsr[0]<100000B
DO
nshift ← nshift+ 1;
IF rem[-1] # 0 THEN SIGNAL QCError[desc: "Divide Overflow"];
FOR ii
IN [ 0..3)
DO dvsr[ii] ← BITOR[ BITSHIFT[dvsr[ii],1], BITSHIFT[dvsr[ii+1],-15]] ENDLOOP;
FOR ii
IN [-1..7)
DO rem[ii] ← BITOR[ BITSHIFT[rem[ii],1], BITSHIFT[rem[ii+1],-15]] ENDLOOP;
dvsr[3] ← BITSHIFT[dvsr[3],1];
rem[7] ← BITSHIFT[rem[7],1];
ENDLOOP;
FOR qq
IN [0..4)
DO
IF rem[-1] # 0 THEN SIGNAL QCError[desc: "Divide Overflow"];
FOR ii IN [-1..7) DO rem[ii] ← rem[ii+1] ENDLOOP; rem[7] ← 0;
IF rem[-1] > dvsr[0] THEN SIGNAL QCError[desc: "Divide Overflow"];
lsum.highbits ← rem[-1]; lsum.lowbits ← rem[0];
qRes[qq] ← LongDiv[lsum.lc, dvsr[0]]; -- May be too large
DO
lsum.lc ← 0;
FOR ii
DECREASING
IN [0..4)
DO
lsum.lc ← lsum.highbits;
lprod.lc ← LongMult[qRes[qq], dvsr[ii]];
lsum.lc ← lprod.lc + lsum.lc;
temp[ii] ← lsum.lowbits;
REPEAT FINISHED => temp[-1] ← lsum.highbits ENDLOOP;
FOR ii
IN [-1..4)
DO
IF rem[ii] = temp[ii] THEN LOOP;
IF rem[ii] > temp[ii] THEN EXIT;
IF rem[ii] < temp[ii] THEN {qRes[qq] ← qRes[qq]-1; LOOP};
ENDLOOP; EXIT ENDLOOP;
cy ← 1;
FOR ii
DECREASING
IN [-1..4)
DO
[cy, rem[ii]] ← CARDAdd[rem[ii], BITNOT[temp[ii]], cy] ENDLOOP;
ENDLOOP;
FOR nshift ← nshift, nshift-16
WHILE nshift > 15
DO
FOR ii DECREASING IN [0..7) DO rem[ii] ← rem[ii-1] ENDLOOP;
rem[-1] ← 0 ENDLOOP;
FOR nshift ← nshift, nshift-1
WHILE nshift > 0
DO
FOR ii
DECREASING
IN [0..7)
DO
rem[ii] ← BITOR[ BITSHIFT[rem[ii],-1], BITSHIFT[rem[ii-1],15]]; ENDLOOP;
rem[-1] ← BITSHIFT[rem[-1],-1] ENDLOOP;
FOR ii IN [0..4) DO mRes[ii] ← rem[ii] ENDLOOP };
QCDiv:
PUBLIC
PROC[num:
QCARD, den:
CARDINAL]
RETURNS[qRes: QCARD, mRes: CARDINAL] = {
long: LongNumber; mRes ← 0 ;
FOR ii:
CARDINAL
IN [0..4)
DO
long.highbits ← mRes; long.lowbits ← num[ii];
[qRes[ii], mRes] ← LongDivMod[long.lc, den];
ENDLOOP};
QCComp:
PUBLIC
PROC[x, y:
QCARD]
RETURNS[c: Compare] = {
c ← eq;
FOR i:
CARDINAL
IN [0..4)
DO
IF x[i] = y[i] THEN LOOP;
RETURN[IF x[i]>y[i] THEN gr ELSE ls] ENDLOOP };
CARDAdd:
PROC[a, b, c:
CARDINAL]
RETURNS[cy, sum:
CARDINAL] = {
ln: LongNumber;
ln.lc ← LONG[a] + LONG[b] + LONG[c];
RETURN[ln.highbits, ln.lowbits] };
END.