ImagerSysOnUXIOImpl.mesa
Copyright Ó 1988, 1989, 1990, 1991, 1992 by Xerox Corporation. All rights reserved.
from ImagerSysImpl.mesa
Michael Plass, January 29, 1993 5:23 pm PST
Tim Diebert: January 23, 1990 1:55:02 pm PST
Doug Wyatt, June 5, 1990 4:04 pm PDT
Willie-s, January 15, 1993 3:36 pm PST
DIRECTORY
Basics USING [LongNumber, RawBytes, UnsafeBlock],
BasicTime USING [GMT, nullGMT],
ImagerSwitches USING [Define],
ImagerSys USING [],
IO USING [Error, GetLength, STREAM],
Process USING [CheckForAbort],
Rope USING [ROPE],
RopeFile,
UXIO;
ImagerSysOnUXIOImpl: CEDAR PROGRAM
IMPORTS ImagerSwitches, IO, Process, RopeFile, UXIO
EXPORTS ImagerSys
~ BEGIN
ROPE: TYPE ~ Rope.ROPE;
LongNumber: TYPE ~ Basics.LongNumber;
doAbortCheck: PUBLIC BOOL ¬ TRUE;
ReallyCheckForAbort: PUBLIC PROC ~ { Process.CheckForAbort[] };
SBox: TYPE = REF SBoxRep;
SBoxRep: TYPE = ARRAY BYTE OF Basics.LongNumber;
sBox: SBox = NEW[SBoxRep ¬ [
[lc[0001B64F9H]], [lc[0CDF6FEDDH]], [lc[0F1E27C8FH]], [lc[0151411D7H]],
[lc[018D38B8CH]], [lc[0881EDDDFH]], [lc[050566EABH]], [lc[0D8E188CEH]],
[lc[089594914H]], [lc[06FD569C5H]], [lc[04F03B799H]], [lc[0EE3E0FBCH]],
[lc[049403C26H]], [lc[07E582155H]], [lc[03FC2E14BH]], [lc[0F5912E5CH]],
[lc[0F8CEDCEFH]], [lc[01648092AH]], [lc[02936BE81H]], [lc[00C6AFF7BH]],
[lc[01037D525H]], [lc[048F1AFA4H]], [lc[0C95A7DAFH]], [lc[09C3F1EA6H]],
[lc[0ABE7A417H]], [lc[0E4235890H]], [lc[070C0B0CBH]], [lc[025F7C850H]],
[lc[097E3244DH]], [lc[0595F1FF3H]], [lc[06396C4ECH]], [lc[01E175918H]],
[lc[0B477E635H]], [lc[07DBF354EH]], [lc[07753796FH]], [lc[052CC66EBH]],
[lc[0F99577C3H]], [lc[0A92732E3H]], [lc[0AED680CCH]], [lc[0E89D4E2BH]],
[lc[0BD28375BH]], [lc[03D05AD1AH]], [lc[042B32B1BH]], [lc[04C7116C4H]],
[lc[0BFA84D54H]], [lc[0DC7AE57DH]], [lc[08144EC6DH]], [lc[0046B5A71H]],
[lc[09650D822H]], [lc[08F2487FCH]], [lc[00E09CBC6H]], [lc[00366B639H]],
[lc[06092D9F7H]], [lc[0A70BD393H]], [lc[0A08A1D31H]], [lc[071C99CD9H]],
[lc[0F4455C1EH]], [lc[0B69486FAH]], [lc[04165FDB4H]], [lc[0FCBE8EAAH]],
[lc[0C6EB4BCAH]], [lc[094E5FB7AH]], [lc[0D04E5789H]], [lc[0CF35FA13H]],
[lc[08DA9236BH]], [lc[0F0004133H]], [lc[0261C6224H]], [lc[0F23BF412H]],
[lc[056A4E75EH]], [lc[021163002H]], [lc[07F1FBAF1H]], [lc[072F9D098H]],
[lc[0699CC1A3H]], [lc[002AAF1E8H]], [lc[045DC0DD1H]], [lc[0E0934FDCH]],
[lc[012F08D84H]], [lc[0F3766CD0H]], [lc[0B73D3DE6H]], [lc[0737F84BAH]],
[lc[030F2B43AH]], [lc[09F694456H]], [lc[0EACA00E4H]], [lc[0E3B0B58DH]],
[lc[013C89591H]], [lc[0FEE9D62EH]], [lc[01F839086H]], [lc[09874CED6H]],
[lc[03CEE2F79H]], [lc[01C30E857H]], [lc[065D14836H]], [lc[0B031AB07H]],
[lc[0844F914CH]], [lc[03BE815BFH]], [lc[02A9A2C3FH]], [lc[05FD49EB9H]],
[lc[0472D92E7H]], [lc[0CC5B2297H]], [lc[02782EE5FH]], [lc[0B5625377H]],
[lc[0BBCFDB8EH]], [lc[0DEDDF961H]], [lc[05C60C59BH]], [lc[0910D1BD3H]],
[lc[006AD26D2H]], [lc[014D8B285H]], [lc[06B525ECFH]], [lc[078BB7FEAH]],
[lc[079AC5048H]], [lc[0A884ED34H]], [lc[01D3C36E5H]], [lc[0741D1753H]],
[lc[0CAED8C47H]], [lc[040EF9D0AH]], [lc[0E2213145H]], [lc[0EB70DA27H]],
[lc[00BA3DF73H]], [lc[08789183CH]], [lc[0C0A6739AH]], [lc[0DFC69A58H]],
[lc[034C154B1H]], [lc[0242EAC3EH]], [lc[03902CC49H]], [lc[0DA997B2DH]],
[lc[0BC018F15H]], [lc[038C729FDH]], [lc[0318F27D5H]], [lc[0AFF5604AH]],
[lc[06818F29CH]], [lc[0A2ECC38AH]], [lc[0D4C31019H]], [lc[0936EA8FBH]],
[lc[07B3920EDH]], [lc[061190B68H]], [lc[0906F89A0H]], [lc[0829E1CC7H]],
[lc[0EF4B9952H]], [lc[09E8C850EH]], [lc[03A90CD06H]], [lc[02F8E6700H]],
[lc[08CB7CFACH]], [lc[04B11EAA2H]], [lc[04E6C988BH]], [lc[066DF46F0H]],
[lc[0EC08CA7EH]], [lc[0A664C7BBH]], [lc[017BD831DH]], [lc[075E663F5H]],
[lc[0350E9764H]], [lc[00D424787H]], [lc[0A4A2026CH]], [lc[0D5878167H]],
[lc[0ADAB61B6H]], [lc[064D2AA65H]], [lc[0237B70DAH]], [lc[0C74A25E1H]],
[lc[001A0A1C9H]], [lc[0A5DA0EB0H]], [lc[0F7417670H]], [lc[05AEA51C0H]],
[lc[0FA32933DH]], [lc[0FF1A0759H]], [lc[00AB85601H]], [lc[0CB785FDEH]],
[lc[0EDF83F32H]], [lc[0DBB9AEBEH]], [lc[0326D39F8H]], [lc[058C5D208H]],
[lc[08BE49B63H]], [lc[0C80AA572H]], [lc[0A19F28E0H]], [lc[099FC4320H]],
[lc[0C3CD3A37H]], [lc[0C585BF95H]], [lc[0C12AB392H]], [lc[007D76AA7H]],
[lc[06A6152F6H]], [lc[083B112D4H]], [lc[05B5E9643H]], [lc[0802B3E75H]],
[lc[02B333BA5H]], [lc[051A5A99FH]], [lc[0E157BDA1H]], [lc[0E70C78C2H]],
[lc[07CE0FCAEH]], [lc[02267D160H]], [lc[0AC4D2AFFH]], [lc[009474A51H]],
[lc[0B83A0AB2H]], [lc[0E5797A04H]], [lc[0FD80340DH]], [lc[0E922B916H]],
[lc[05E9BE29DH]], [lc[04AF4F562H]], [lc[0D9AF4CA9H]], [lc[02CFE6BBDH]],
[lc[0F620E3B7H]], [lc[06E07C274H]], [lc[0B9B65B42H]], [lc[019BCA069H]],
[lc[0C40FF0F2H]], [lc[07AB57221H]], [lc[09DF314C1H]], [lc[02DAEF380H]],
[lc[0BEB4E094H]], [lc[01AFFA210H]], [lc[0575D0529H]], [lc[0B27C55CDH]],
[lc[0DDB2A33BH]], [lc[0B37D6528H]], [lc[005DB740CH]], [lc[062C4E96AH]],
[lc[028464078H]], [lc[0D7066D30H]], [lc[08E2CBBF4H]], [lc[0D3DEBCE2H]],
[lc[037FA049EH]], [lc[0E63401B5H]], [lc[06D8D2D88H]], [lc[02E7E7E5AH]],
[lc[02013D741H]], [lc[00F9706E9H]], [lc[03EBAE45DH]], [lc[03386B8ADH]],
[lc[01B251305H]], [lc[053540C03H]], [lc[09B7571C8H]], [lc[0FBD0C638H]],
[lc[011A1197FH]], [lc[008FBEF0FH]], [lc[08651F844H]], [lc[095633840H]],
[lc[04443452FH]], [lc[04D555D46H]], [lc[0764C03D8H]], [lc[0D638B1B8H]],
[lc[0BA2FA70BH]], [lc[0D21094B3H]], [lc[092A7EB66H]], [lc[0C2D9D409H]],
[lc[085266883H]], [lc[08A15A6DBH]], [lc[06C98751FH]], [lc[09A88DE76H]],
[lc[04668C9EEH]], [lc[0A3731A82H]], [lc[0AA490896H]], [lc[036814223H]],
[lc[055CBF62CH]], [lc[054049F1CH]], [lc[0B15CF74FH]], [lc[04312C06EH]],
[lc[05D726FFEH]], [lc[0678B8AA8H]], [lc[0D129337CH]], [lc[0CEFD8211H]]
]];
Combine: PROC [a, b: LongNumber] RETURNS [LongNumber] = INLINE {
RETURN [[lc[a.lc+b.lc]]]
};
Hash64Bits: PROC [left, right: LongNumber] RETURNS [LongNumber, LongNumber] = {
right ¬ Combine[right, sBox[left.ll]];
left ¬ Combine[left, sBox[right.ll]];
right ¬ Combine[right, sBox[left.lh]];
left ¬ Combine[left, sBox[right.lh]];
right ¬ Combine[right, sBox[left.hh]];
left ¬ Combine[left, sBox[right.hh]];
right ¬ Combine[right, sBox[left.hl]];
left ¬ Combine[left, sBox[right.hl]];
RETURN [left, right]
};
RawHash: PUBLIC UNSAFE PROC [block: Basics.UnsafeBlock, modulus: CARDINAL] RETURNS [CARDINAL] ~ UNCHECKED {
p: LONG POINTER TO Basics.RawBytes ~ block.base;
index: NAT ¬ block.startIndex;
count: NAT ¬ block.count;
Get4: UNSAFE PROC RETURNS [LongNumber] ~ INLINE {
k: NAT ~ index; index ¬ index+4; count ¬ count-4;
RETURN [[bytes[hh: p[k], hl: p[k+1], lh: p[k+2], ll: p[k+3]]]];
};
Get1: UNSAFE PROC RETURNS [BYTE] ~ INLINE {
k: NAT ~ index; index ¬ index+1; count ¬ count-1;
RETURN [p[k]];
};
left, right: LongNumber ¬ [lc[0]];
WHILE count >= 8 DO
left ¬ Combine[left, Get4[]];
right ¬ Combine[right, Get4[]];
[left, right] ¬ Hash64Bits[left, right];
ENDLOOP;
IF count # 0 THEN {
IF count >= 4 THEN {
left ¬ Combine[left, Get4[]];
};
IF count # 0 THEN {
w: PACKED ARRAY [0..BYTES[LongNumber]) OF BYTE ¬ ALL[0];
FOR i: NAT IN [0..count) DO w[i] ¬ Get1[] ENDLOOP;
right ¬ Combine[right, LOOPHOLE[w]];
};
[left, right] ¬ Hash64Bits[left, right];
};
RETURN [
IF modulus = 0
THEN (IF BITS[CARDINAL] = BITS[CARD] THEN right.lc ELSE right.lo)
ELSE (right.lc MOD modulus)
];
};
GoodModulus: PUBLIC PROC [size: CARDINAL] RETURNS [CARDINAL] = {
v: CARDINAL ¬ size;
up: BOOL ¬ TRUE;
IF v < 2 THEN RETURN [2];
IF v >= (LAST[CARDINAL]-LAST[BYTE])/2-100 THEN {
v ¬ (LAST[CARDINAL]-LAST[BYTE])/2-1;
up ¬ FALSE;
};
IF v MOD 2 = 0 THEN v ¬ v + 1;
UNTIL Prime[v] DO IF up THEN v ¬ v + 2 ELSE v ¬ v - 2 ENDLOOP;
RETURN [v]
};
Prime: PROC [n: CARDINAL] RETURNS [BOOL] = INLINE {
k: NAT ¬ 3;
kSqr: CARDINAL ¬ 9;
kSqrDelta: CARDINAL ¬ 16;
IF n < 3 THEN RETURN [n = 2];
IF n MOD 2 = 0 THEN RETURN [FALSE];
UNTIL kSqr > n DO
IF n MOD k = 0 THEN RETURN [FALSE];
k ¬ k + 2;
kSqr ¬ kSqr + kSqrDelta;
kSqrDelta ¬ kSqrDelta + 8;
ENDLOOP;
RETURN [TRUE]
};
LongMult: PUBLIC PROC [a, b: CARDINAL] RETURNS [CARD32] = {
RETURN [CARD[a]*CARD[b]]
RETURN [Basics.LongMult[a, b]]
};
Smul: PUBLIC PROC [a: INTEGER, b: INTEGER] RETURNS [INT] = {
RETURN [INT[a]*INT[b]]
Overflow cannot happen if a and b are 16-bit
HighBit: PROC [a: INTEGER] RETURNS [[0..1]] ~ INLINE {
RETURN [LOOPHOLE[a, PACKED ARRAY [0..Basics.bitsPerWord) OF [0..1]][0]];
};
Card: PROC [i: INTEGER] RETURNS [NAT] ~ INLINE {RETURN [LOOPHOLE[i]]};
SELECT HighBit[a]*2+HighBit[b] FROM
0 => RETURN [Basics.LongMult[Card[a], Card[b]]];
1 => RETURN [-Basics.LongMult[Card[a], Card[-b]]];
2 => RETURN [-Basics.LongMult[Card[-a], Card[b]]];
3 => RETURN [Basics.LongMult[Card[-a], Card[-b]]];
ENDCASE => ERROR;
};
FileError: PUBLIC ERROR [code: ATOM, explanation: ROPE] ~ CODE;
OpenInputFile: PUBLIC PROC [fileName: ROPE] RETURNS [stream: IO.STREAM ¬ NIL] = {
stream ¬ UXIO.CreateFileStream[fileName, read !
UXIO.Error => {
IF error.group = client -- UXIO vs PFS
THEN CONTINUE
ELSE ERROR FileError[error.code, error.explanation]
};
];
};
RopeFromFile: PUBLIC PROC [fileName: ROPE] RETURNS [ROPE] = {
stream: IO.STREAM = OpenInputFile[fileName];
RETURN [IF stream = NIL THEN NIL ELSE RopeFromStream[stream]]
};
RopeFromStream: PUBLIC PROC [stream: IO.STREAM] RETURNS [ROPE] = {
RETURN [RopeFile.FromStream[stream: stream, flatten: IO.GetLength[stream] < 250000]];
};
StreamFileName: PUBLIC PROC [stream: IO.STREAM] RETURNS [fullFName: ROPE ¬ NIL] = {
ENABLE UXIO.Error, IO.Error => CONTINUE;
fullFName ¬ UXIO.GetName[UXIO.OpenFileFromStream[stream]];
};
StreamCreateDate: PUBLIC PROC [stream: IO.STREAM] RETURNS [created: BasicTime.GMT ¬ BasicTime.nullGMT] = {
ENABLE UXIO.Error, IO.Error => CONTINUE;
created ¬ UXIO.GetCreateTime[UXIO.OpenFileFromStream[stream]];
};
OpenOutputFile: PUBLIC PROC [fileName: ROPE] RETURNS [stream: IO.STREAM ¬ NIL] = {
stream ¬ UXIO.CreateFileStream[fileName, write ! UXIO.Error => ERROR FileError[error.code, error.explanation]];
};
defaultFontDir: ROPE = "/import/imagerfonts/";
fontDirSwitch: CHAR = ImagerSwitches.Define[switch: 'f, name: $fontdirectory, doc: "Path for imager font lookup (e.g. /imagerfonts/)", defaultValue: defaultFontDir];
END.