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. ŠQCardImpl.mesa Copyright c 1984 by Xerox Corporation. All rights reserved. Last edited by Curry, February 5, 1985 11:09:22 pm PST Ê Ù˜šÑbklÐbl ™Jšœ Ïmœ1™Jšœ;˜;Jš œ  œ  œ œ+˜RJš œ ˜—J˜š£ œ œ œ œ œ œ œ˜TJš œ œ œ œ œ˜Jšœ  œ˜Jšœ œ˜š ˜Jš œ  œ œ˜!š œ ˜Jš œ œ œ˜Jš œ# œ˜+Jš œ" œ˜*Jš œ! œ˜)Jš œ œ,˜?—Jš œ˜—š ˜Jš  œ œ œ  œ œ%˜HJšœ ˜ Jšœ)˜)Jš œ  œ œ˜š œ ˜Jš œ"˜$Jš œ!˜#Jš œ ˜"Jš œ œ˜—Jš œ˜—Jš œ ˜—J˜š£œ œ ˜Jšœ œ+ œ˜YJš œ œ œ˜Jš œ œ œ œ œ˜Jšœ œ ˜Jšœ œ˜Jšœ œ˜Jš œ œ œ  œ œ˜š œ œ ˜Jšœ˜Jšœ ˜ Jšœ œ˜Jš œ˜—Jš œ  œ œ ˜6Jš  œ  œ œ œ œ˜KJš  œ œ œ œ œ˜MJš  œ œ œ œ œ˜RJš  œ  œ œ œ œ˜Jš œ˜J˜——Jš¡œ œ œ œ œ œ œ œ˜DJ˜š¡œ œ œ œ  œ œ œ œ˜QJšœ œ˜(Jšœ œ œ œ˜=Jšœ œ œ œ˜=Jšœ œ œ œ˜=Jšœ œ œ œ˜?J˜—š¡œ œ œ œ  œ œ œ œ˜QJšœ œ˜)Jšœ œ œ œ˜>Jšœ œ œ œ˜>Jšœ œ œ œ˜>Jšœ œ œ œ˜@J˜—š ¡œ œ œ œ œ˜.Jš œ œ œ˜'Jšœ ˜ š œ œ  œ œ˜ Jš œ, œ˜7—J˜—š ¡œ œ œ œ œ˜.Jš œ œ œ˜'Jšœ œ˜š œ œ  œ œ˜ Jš œ  œ ˜5Jš œ˜—Jš œ  œ ˜—J˜š ¡œ œ œ œ œ˜)Jš œ œ œ˜)Jšœ"˜"š  œ œ  œ œ ˜#Jšœ˜Jšœ˜Jšœ˜Jšœ˜Jš œ˜—Jš œ˜J˜—š¡œ œ œ œ œ œ œ˜JJšœ œ˜ Jšœ˜Jš œ œ œ œ œ˜&š  œ œ  œ œ ˜(Jšœ ˜ š  œ œ  œ œ ˜(Jšœ!˜!Jšœ˜Jšœ˜Jšœ œ˜—Jšœ˜š  œ œ  œ œ ˜(Jšœ: œ˜B—Jšœ3˜3š  œ œ  œ œ  œ ˜4Jšœ( ˜/—Jš œ˜—Jš  œ œ  œ œ œ, œ˜^J˜—š ¡œ œ œ œ œ  œ˜MJšœ  œ˜Jšœ  œ˜Jšœ œ˜Jšœ˜J˜Jšœ œ œ œ˜%Jš œ œ œ œ œ˜'Jš œ œ œ œ œ˜(J˜Jš œ œ œ œ˜2Jš œ œ œ œ˜2Jš œ œ œ œ!˜=Jš  œ œ œ œ œ œ˜,J˜š œ ˜Jšœ˜Jš œ  œ œ"˜Jš œ˜—š œ ˜Jšœ˜Jš œ  œ œ"˜<š œ œ˜Jš  œ  œ œ œ œ˜N—š œ œ˜Jš  œ  œ œ  œ œ˜K—Jšœ  œ ˜Jšœ  œ ˜Jš œ˜—J˜š œ œ ˜Jš œ  œ œ"˜Jš œ œ œ"˜BJšœ/˜/Jšœ&Ïc˜9š ˜Jšœ ˜ š œ  œ œ ˜Jšœ˜Jšœ(˜(Jšœ˜Jšœ˜Jš œ œ œ˜4—š œ œ  ˜Jš œ œ œ˜ Jš œ œ œ˜ Jš œ œ œ˜9Jš œ œ œ˜——Jšœ˜š œ  œ œ  ˜Jšœ! œ œ˜?—Jš œ˜—J˜š œ œ  ˜3Jš  œ  œ œ œ œ˜;Jšœ  œ˜—š œ œ  ˜1š œ  œ œ ˜Jš œ  œ œ œ œ˜H—Jšœ  œ  ˜'—Jš œ œ œ œ˜1—J˜š ¡œ œ œ œ œ˜-Jš œ œ œ˜(Jšœ˜š œ œ œ ˜Jšœ-˜-Jšœ,˜,Jš œ˜ ——J˜š £œ œ œ œ œ˜8Jšœ˜š œ œ œ ˜Jš œ  œ œ˜Jš  œ œ  œ œ œ˜/——J˜š £œ œ  œ œ  œ˜?J˜Jšœ œ œ œ˜$Jš œ˜"—J˜Jš œ˜J˜—J˜—…—h(Ë