PGSupportImpl.mesa
Copyright © 1985, 1986 by Xerox Corporation. All rights reserved.
Written by Bill Paxton, January 1981
Paxton. October 18, 1982 11:28 am
Russ Atkinson, July 25, 1983 2:37 pm
Michael Plass, March 29, 1985 2:06:49 pm PST format
Rick Beach, March 28, 1985 9:43:10 am PST
Doug Wyatt, September 22, 1986 1:24:39 pm PDT
DIRECTORY
Atom USING [EmptyAtom],
Basics USING [BITXOR, LowHalf],
PGSupport USING [FormatHashIndex, formatHashSize, LooksHashIndex, looksHashSize, noLooks, PGF, PGFBody, PropHashIndex, propHashSize],
PrincOps USING [zXOR],
TextLooks USING [Looks, LooksBytes, noLooks],
TiogaFile USING [FileId, fileIdSize, FormatIndex, IntBytes, LengthByte, LooksIndex, numFormats, numLooks, numProps, PropIndex, ThirdByte, trailerLengthSize];
PGSupportImpl: CEDAR MONITOR
IMPORTS Atom, Basics
EXPORTS PGSupport
= BEGIN OPEN PGSupport;
Looks: TYPE ~ TextLooks.Looks;
noLooks: Looks ~ TextLooks.noLooks;
PropIndex: TYPE ~ TiogaFile.PropIndex;
FormatIndex: TYPE ~ TiogaFile.FormatIndex;
LooksIndex: TYPE ~ TiogaFile.LooksIndex;
-- PGF is the file-level structure for put/get
CreatePGF:
PUBLIC
PROC
RETURNS [pgf:
PGF] = {
pgf ← AllocPGF[];
pgf.looksTable[0] ← TextLooks.noLooks;
pgf.looksNext ← 1; -- reserve 0 for noLooks
FOR i:LooksHashIndex
IN LooksHashIndex
DO
pgf.looksHashKeys[i].looks ← TextLooks.noLooks; ENDLOOP;
pgf.formatTable[0] ← NIL;
FOR i:FormatHashIndex
IN FormatHashIndex
DO
pgf.formatHashKeys[i].formatName ← NIL; ENDLOOP;
pgf.formatNext ← 1; -- reserve 0 for null formatname
pgf.propNext ← 1; --reserve 0 for NIL
FOR i:PropHashIndex
IN PropHashIndex
DO
pgf.propHashKeys[i].propname ← NIL; ENDLOOP;
[] ← EnterProp[$Prefix, pgf]; -- preload system atoms
[] ← EnterProp[$Postfix, pgf];
};
pgf1, pgf2, pgf3: PGF ← NIL;
AllocPGF:
ENTRY
PROC
RETURNS [pgf:
PGF] = {
ENABLE UNWIND => NULL;
IF pgf3 # NIL THEN { pgf ← pgf3; pgf3 ← NIL }
ELSE IF pgf2 # NIL THEN { pgf ← pgf2; pgf2 ← NIL }
ELSE IF pgf1 # NIL THEN { pgf ← pgf1; pgf1 ← NIL }
ELSE pgf ← NEW[PGFBody] };
FreePGF:
PUBLIC
ENTRY
PROC [pgf:
PGF] = {
ENABLE UNWIND => NULL;
IF pgf3 = pgf OR pgf2 = pgf OR pgf1 = pgf THEN ERROR;
IF pgf3 = NIL THEN pgf3 ← pgf
ELSE IF pgf2 = NIL THEN pgf2 ← pgf
ELSE IF pgf1 = NIL THEN pgf1 ← pgf };
BadIndex:
PUBLIC
ERROR =
CODE;
RetrieveFormatName:
PUBLIC
PROC [index: FormatIndex, pgf:
PGF]
RETURNS [formatName:
ATOM]
= {
IF index >= pgf.formatNext
THEN
ERROR BadIndex;
RETURN [pgf.formatTable[index]] };
RetrieveLooks:
PUBLIC
PROC [index: LooksIndex, pgf:
PGF]
RETURNS [looks: Looks]
= { IF index >= pgf.looksNext THEN ERROR BadIndex; RETURN [pgf.looksTable[index]] };
RetrieveProp:
PUBLIC
PROC [index: PropIndex, pgf:
PGF]
RETURNS [propname:
ATOM]
= { IF index >= pgf.propNext THEN ERROR BadIndex; RETURN [pgf.propTable[index]] };
Munch:
PROC [key:
ATOM]
RETURNS [
CARDINAL] =
TRUSTED
MACHINE
CODE {
PrincOps.zXOR;
};
true:
BOOL[
TRUE..
TRUE] ~ (
SIZE[
ATOM]-
SIZE[
CARDINAL] = 1);
EnterFormatName:
PUBLIC
PROC [formatName:
ATOM, pgf:
PGF]
RETURNS [ok:
BOOL, index: TiogaFile.FormatIndex] = {
next: NAT ← pgf.formatNext;
initloc, loc: NAT;
IF formatName = NIL OR formatName = Atom.EmptyAtom[] THEN RETURN [TRUE, 0]; -- reserved
loc ← initloc ← Munch[formatName] MOD formatHashSize;
DO
SELECT pgf.formatHashKeys[loc].formatName
FROM
formatName => RETURN [TRUE, pgf.formatHashVals[loc].index];
NIL => EXIT; -- this is an unused entry
ENDCASE;
SELECT (loc ← loc+1)
FROM
formatHashSize => IF (loc ← 0)=initloc THEN ERROR;
initloc => ERROR; -- should never have full table
ENDCASE;
ENDLOOP;
IF next < TiogaFile.numFormats
THEN
-- room left in table
BEGIN
pgf.formatTable[next] ← formatName;
pgf.formatNext ← next+1;
pgf.formatHashKeys[loc].formatName ← formatName;
pgf.formatHashVals[loc].index ← LOOPHOLE[next];
END;
RETURN [FALSE, 0] }; -- index irrelevant in this case
EnterLooks:
PUBLIC
PROC [looks: TextLooks.Looks, pgf:
PGF]
RETURNS [ok:
BOOL, index: TiogaFile.LooksIndex] = {
next: NAT ← pgf.looksNext;
initloc, loc: NAT;
IF looks = TextLooks.noLooks THEN RETURN [TRUE, 0]; -- reserved
loc ← initloc ←
LOOPHOLE[
Basics.
BITXOR[
LOOPHOLE[looks, TextLooks.LooksBytes].byte0,
Basics.
BITXOR[
LOOPHOLE[looks, TextLooks.LooksBytes].byte1,
LOOPHOLE[looks, TextLooks.LooksBytes].byte2]],NAT]
MOD looksHashSize;
DO
SELECT pgf.looksHashKeys[loc].looks
FROM
looks => RETURN [TRUE, pgf.looksHashVals[loc].index];
TextLooks.noLooks => EXIT; -- this is an unused entry
ENDCASE;
SELECT (loc ← loc+1)
FROM
looksHashSize => IF (loc ← 0)=initloc THEN ERROR;
initloc => ERROR; -- should never have full table
ENDCASE;
ENDLOOP;
IF next < TiogaFile.numLooks
THEN
-- room left in table
BEGIN
pgf.looksTable[next] ← looks;
pgf.looksNext ← next+1;
pgf.looksHashKeys[loc].looks ← looks;
pgf.looksHashVals[loc].index ← LOOPHOLE[next];
END;
RETURN [FALSE, 0] }; -- index irrelevant in this case
EnterProp:
PUBLIC
PROC [propname:
ATOM, pgf:
PGF]
RETURNS [ok:
BOOL, index: TiogaFile.PropIndex] = {
next: NAT ← pgf.propNext;
initloc, loc: NAT;
IF propname = NIL THEN RETURN [TRUE, 0]; -- reserved
loc ← initloc ← (LOOPHOLE[Basics.LowHalf[LOOPHOLE[propname]],NAT] / 16) MOD propHashSize;
DO
SELECT pgf.propHashKeys[loc].propname
FROM
propname => RETURN [TRUE, pgf.propHashVals[loc].index];
NIL => EXIT; -- this is an unused entry
ENDCASE;
SELECT (loc ← loc+1)
FROM
propHashSize => IF (loc ← 0)=initloc THEN ERROR;
initloc => ERROR; -- should never have full table
ENDCASE;
ENDLOOP;
IF next < TiogaFile.numProps
THEN
-- room left in table
BEGIN
pgf.propTable[next] ← propname;
pgf.propNext ← next+1;
pgf.propHashKeys[loc].propname ← propname;
pgf.propHashVals[loc].index ← LOOPHOLE[next];
END;
RETURN [FALSE, 0] }; -- index irrelevant in this case
PutLength:
PUBLIC
PROC [put:
PROC [
CHAR], len:
INT] = {
first, second, fourth: TiogaFile.LengthByte;
third: TiogaFile.ThirdByte;
intBytes: TiogaFile.IntBytes ← LOOPHOLE[len];
IF intBytes.fourth#0
THEN {
fourth.data ← intBytes.fourth;
first.others ← second.others ← third.others ← TRUE
};
IF intBytes.thirdTop#0
OR intBytes.thirdBottom#0
THEN {
third.dataTop ← intBytes.thirdTop;
third.dataBottom ← intBytes.thirdBottom;
first.others ← second.others ← TRUE;
};
IF intBytes.second#0
THEN {
second.data ← intBytes.second;
first.others ← TRUE;
};
first.data ← intBytes.first;
put[LOOPHOLE[first]];
IF first.others
THEN {
put[LOOPHOLE[second]];
IF second.others
THEN {
put[LOOPHOLE[third]];
IF third.others
THEN {
put[LOOPHOLE[fourth]];
};
};
};
};
GetLength:
PUBLIC
PROC [get:
PROC
RETURNS [
CHAR]]
RETURNS [
INT] ~ {
first, second, fourth: TiogaFile.LengthByte;
third: TiogaFile.ThirdByte;
intBytes: TiogaFile.IntBytes ← [];
first ← LOOPHOLE[get[]];
intBytes.first ← first.data;
IF NOT first.others THEN RETURN [LOOPHOLE[intBytes]];
second ← LOOPHOLE[get[]];
intBytes.second ← second.data;
IF NOT second.others THEN RETURN [LOOPHOLE[intBytes]];
third ← LOOPHOLE[get[]];
intBytes.thirdBottom ← third.dataBottom;
intBytes.thirdTop ← third.dataTop;
IF NOT third.others THEN RETURN [LOOPHOLE[intBytes]];
fourth ← LOOPHOLE[get[]];
intBytes.fourth ← fourth.data;
RETURN [LOOPHOLE[intBytes]];
};
fileIdSize: INT ~ TiogaFile.fileIdSize;
FileIdIndex:
TYPE ~ [0..TiogaFile.fileIdSize);
PutFileId:
PUBLIC
PROC [put:
PROC [
CHAR], id: TiogaFile.FileId] ~ {
FOR i: FileIdIndex IN FileIdIndex DO put[id[i]] ENDLOOP;
};
GetFileId:
PUBLIC
PROC [get:
PROC
RETURNS [
CHAR]]
RETURNS [id: TiogaFile.FileId] ~ {
FOR i: FileIdIndex IN FileIdIndex DO id[i] ← get[] ENDLOOP;
};
lenSize: INT ~ TiogaFile.trailerLengthSize;
LenIndex: TYPE ~ [0..lenSize);
LenBytes:
TYPE ~
PACKED
ARRAY LenIndex
OF
CHAR;
PutTrailerLength:
PUBLIC
PROC [put:
PROC [
CHAR], len:
INT] ~ {
FOR i: LenIndex IN LenIndex DO put[LOOPHOLE[len, LenBytes][i]] ENDLOOP;
};
GetTrailerLength:
PUBLIC
PROC [get:
PROC
RETURNS [
CHAR]]
RETURNS [len:
INT] ~ {
FOR i: LenIndex IN LenIndex DO LOOPHOLE[len, LenBytes][i] ← get[] ENDLOOP;
};
END.