<> <> <> DIRECTORY Basics, IO, QCard; 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.