TSObjectImpl.mesa
Michael Plass, November 12, 1982 9:33 am
Last Edited by: Beach, May 24, 1983 9:10 am
DIRECTORY
Rope,
SafeStorage,
TSTypes,
TSGlue,
TSFont,
TSGraphic,
TSObject;
TSObjectImpl: CEDAR MONITOR IMPORTS SafeStorage, TSObject, TSFont, TSTypes EXPORTS TSObject =
BEGIN OPEN TSObject;
qZone: PUBLIC ZONE ← SafeStorage.NewZone[quantized];
pZone: PUBLIC ZONE ← SafeStorage.NewZone[prefixed];
InitiallyZeroInt: TYPE = INT ← 0;
forceStats:
RECORD [
tagRecEnd: INT ← 0,
ignore: INT ← 0,
produce: INT ← 0,
exception: INT ← 0,
font: INT ← 0,
rope: INT ← 0,
offset: INT ← 0,
parameter: ARRAY ParameterType OF InitiallyZeroInt,
listParameter: ARRAY ListParameterType OF InitiallyZeroInt,
end: INT ← 0
];
ClearForceStats: PROC = {forceStats ← []};
ForceCurrentItem:
PROCEDURE [self: ListReader] = {
IF self.tagOffset >= tagRecSize
THEN {
self.itemList.tagList ← self.itemList.tagList.rest;
self.tagOffset ← 0;
FS forceStats.tagRecEnd ← forceStats.tagRecEnd + 1;
};
SELECT self.itemList.tagList.first[self.tagOffset]
FROM
ignore => {
self.Next[];
FS forceStats.ignore ← forceStats.ignore + 1;
};
produce => {
self.itemList.listWriter.producer[self.itemList.listWriter];
ForceCurrentItem[self];
FS forceStats.produce ← forceStats.produce + 1;
};
exception => {
t: REF ANY;
FS forceStats.exception ← forceStats.exception + 1;
self.itemList.exceptionList ← self.itemList.exceptionList.rest;
t ← self.itemList.exceptionList.first;
SELECT
TRUE
FROM
ISTYPE[t, TSObject.Font] => {
self.currentFont ← NARROW[t];
self.Next[];
FS forceStats.font ← forceStats.font + 1;
};
ISTYPE[t,
ROPE] => {
self.baseRope ← NARROW[t];
self.ropeOffset ← 0;
self.Next[];
FS forceStats.rope ← forceStats.rope + 1;
};
ISTYPE[t, TSObject.RopeOffset] => {
self.ropeOffset ← NARROW[t,RopeOffset]^.ropeOffset;
self.Next[];
FS forceStats.offset ← forceStats.offset + 1;
};
ISTYPE[t, TSObject.Parameter] => {
p: TSObject.Parameter ← NARROW[t];
self.parameter[p.parameterType] ← p.parameter;
FS forceStats.parameter[p.parameterType] ← forceStats.parameter[p.parameterType] + 1;
};
ISTYPE[t, TSObject.ListParameter] => {
p: TSObject.ListParameter ← NARROW[t];
self.listParameter[p.listParameterType] ← p.listParameter;
FS forceStats.listParameter[p.listParameterType] ← forceStats.listParameter[p.listParameterType] + 1;
};
ENDCASE => {};
};
end => {
IF self.itemList.successor = NIL THEN RETURN
ELSE {
self.itemList ← self.itemList.successor^;
self.tagOffset ← 0;
ForceCurrentItem[self];
};
FS forceStats.end ← forceStats.end + 1;
};
ENDCASE => {};
};
Next:
PUBLIC
PROCEDURE [self: ListReader] = {
SELECT self.itemList.tagList.first[self.tagOffset]
FROM
char, space, ignore => self.ropeOffset ← self.ropeOffset + 1;
exception, hyphen => {};
ENDCASE => ERROR;
self.tagOffset ← self.tagOffset + 1;
IF self.tagOffset >= tagRecSize THEN ForceCurrentItem[self]
ELSE
SELECT self.itemList.tagList.first[self.tagOffset]
FROM
ignore, produce, exception, end => ForceCurrentItem[self];
ENDCASE => {};
};
CreateItemList:
PUBLIC
PROCEDURE [
producer: ProducerProc,
writerData: REF ANY ← NIL
] RETURNS [new: ItemList] = {
new ← pZone.NEW[ItemListRec];
new.listWriter ← pZone.NEW[ListWriterRec];
new.listWriter.producer ← producer;
new.listWriter.parameter ← [TSTypes.zeroDimn, TSTypes.zeroDimn, TSTypes.zeroDimn, TSTypes.zeroDimn, TSTypes.zeroDimn, TSTypes.zeroDimn, TSTypes.zeroDimn, TSTypes.zeroDimn, TSTypes.zeroDimn, TSTypes.zeroDimn];
new.listWriter.writerData ← writerData;
new.tagList ← new.listWriter.tagList ← qZone.LIST[produceArray];
new.exceptionList ← new.listWriter.exceptionList ← qZone.LIST[NIL];
stats.newListsCreated ← stats.newListsCreated + 1;
};
SingletonList:
PUBLIC
PROCEDURE [item:
REF
ANY]
RETURNS [new: ItemList] = {
new ← CreateItemList[producer: NIL];
new.listWriter.ProduceItem[item];
new.listWriter.ProduceEnd[];
new.listWriter ← NIL;
};
ItemListFromExplicitList:
PUBLIC
PROCEDURE [explicitList:
LIST
OF
REF
ANY ←
NIL]
RETURNS [new: ItemList] = {
new ← CreateItemList[producer: NIL];
WHILE explicitList #
NIL
DO
new.listWriter.ProduceItem[explicitList.first];
explicitList ← explicitList.rest;
ENDLOOP;
new.listWriter.ProduceEnd[];
new.listWriter ← NIL;
};
Copy:
PUBLIC
PROCEDURE [self: ItemList]
RETURNS [new: ItemList] = {
new ← pZone.NEW[ItemListRec ← self^];
stats.newListsCreated ← stats.newListsCreated + 1;
IF self.successor # NIL THEN new.successor ← self.successor.Copy[];
};
Concat:
PUBLIC
PROCEDURE [a, b: TSObject.ItemList] = {
WHILE a.successor # NIL DO a ← a.successor ENDLOOP;
a.successor ← b;
};
listReaderCacheSize: NAT = 30;
listReaderCache: ARRAY [0..listReaderCacheSize) OF ListReader;
listReaderCacheFront, listReaderCacheRear: [0..listReaderCacheSize] ← 0;
CreateReader:
PUBLIC
PROCEDURE [list: ItemList]
RETURNS [reader: ListReader] = {
reader ← GetReader[];
reader.itemList ← list^;
FOR t: TSObject.ParameterType
IN TSObject.ParameterType
DO
reader.parameter[t] ← TSTypes.zeroDimn
ENDLOOP;
ForceCurrentItem[reader];
};
CopyReader:
PUBLIC
PROCEDURE [reader: ListReader]
RETURNS [copy: ListReader] = {
copy ← GetReader[];
copy^ ← reader^;
};
GetReader:
ENTRY
PROCEDURE
RETURNS [reader: ListReader] =
INLINE {
ENABLE UNWIND => NULL;
IF listReaderCacheFront = listReaderCacheRear
THEN {
reader ← NEW[ListReaderRec];
stats.readersCreated ← stats.readersCreated + 1;
}
ELSE {
listReaderCacheFront ← listReaderCacheFront + 1;
IF listReaderCacheFront = listReaderCacheSize THEN listReaderCacheFront ← 0;
reader ← listReaderCache[listReaderCacheFront];
listReaderCache[listReaderCacheFront] ← NIL;
};
stats.listReadersStarted ← stats.listReadersStarted + 1;
};
DestroyReader:
PUBLIC
ENTRY
PROCEDURE [reader: ListReader] = {
ENABLE UNWIND => NULL;
t: [0..listReaderCacheSize] ← listReaderCacheRear + 1;
IF t = listReaderCacheSize THEN t ← 0;
IF reader.itemList.tagList = NIL THEN ERROR; -- This has already been destroyed!
reader^ ← [itemList: [], parameter: [TSTypes.zeroDimn, TSTypes.zeroDimn, TSTypes.zeroDimn, TSTypes.zeroDimn, TSTypes.zeroDimn, TSTypes.zeroDimn, TSTypes.zeroDimn, TSTypes.zeroDimn, TSTypes.zeroDimn, TSTypes.zeroDimn]];
IF t # listReaderCacheFront
THEN {
listReaderCacheRear ← t;
listReaderCache[t] ← reader;
};
Otherwise let the collector get it.
};
Expand:
PUBLIC
PROCEDURE [self: ListReader]
RETURNS [explicitList: LIST OF REF ANY ← NIL] = {
p: REF ANY;
IF self.End[] THEN RETURN;
SELECT self.CurrentTag
FROM
char => {
p ← pZone.
NEW[BoxRec ← [
self.currentFont.CharDimensions[self.CurrentChar[]],
char [self.currentFont, self.CurrentChar[]]
]];
};
space => {
p ← pZone.NEW[TSGlue.Glue ← self.currentFont.SpaceGlue[]];
};
exception => {
p ← self.CurrentItem[];
IF
ISTYPE[p, Kerf]
THEN {
t: Kerf ← NARROW[p];
IF t.join # NIL THEN p ← t.join.first; -- not quite right, but should be good enough
};
};
ENDCASE;
self.Next[];
explicitList ←
IF p=
NIL
THEN self.Expand[]
ELSE qZone.CONS[p, self.Expand[]];
};
Extend:
PUBLIC
PROCEDURE [self: ListWriter] = {
self.tagList.rest ← qZone.LIST[produceArray];
self.tagList ← self.tagList.rest;
self.tagOffset ← 0;
stats.extentsCreated ← stats.extentsCreated + 1;
};
produceArray: TagRec = [
produce, produce, produce, produce, produce,
produce, produce, produce, produce, produce,
produce, produce, produce, produce, produce,
produce, produce, produce, produce, produce,
produce, produce, produce, produce, produce,
produce, produce, produce, produce, produce,
produce, produce, produce, produce, produce,
produce, produce, produce, produce, produce,
produce, produce, produce, produce, produce,
produce, produce, produce, produce, produce,
produce, produce, produce, produce, produce,
produce, produce, produce, produce, produce,
produce, produce, produce, produce, produce,
produce, produce, produce, produce, produce,
produce, produce, produce, produce, produce,
produce, produce, produce, produce, produce,
produce, produce, produce, produce, produce,
produce, produce, produce, produce, produce,
produce, produce, produce, produce, produce,
produce, produce, produce, produce, produce
];
ProduceParameter:
PUBLIC
PROCEDURE [
self: ListWriter,
parameterType: ParameterType,
parameterValue: Dimn
] = {
IF self.parameter[parameterType] # parameterValue
THEN {
p: Parameter ← pZone.
NEW[ParameterRec ← [
parameterType: parameterType,
parameter: parameterValue
]];
self.ProduceItem[p];
self.parameter[parameterType] ← parameterValue;
};
};
MakeGlue:
PUBLIC
PROCEDURE [space, plus, minus: Dimn ← TSTypes.zeroDimn]
RETURNS [p: REF ANY] = {
IF plus = TSTypes.zeroDimn
AND minus = TSTypes.zeroDimn
THEN {
kern: TSObject.Kern ← pZone.NEW[Dimn ← space];
p ← kern;
}
ELSE {
glue: TSObject.Glue ← pZone.NEW[TSGlue.Glue ← [space, plus, minus]];
p ← glue;
}
};
MakeKerf:
PUBLIC
PROCEDURE [prebreak, join, postbreak:
LIST
OF
REF
ANY ←
NIL, penalty: TSTypes.Penalty ← 0]
RETURNS [p: TSObject.Kerf] = {
p ← pZone.NEW[TSObject.KerfRec];
p.prebreak ← prebreak;
p.join ← join;
p.postbreak ← postbreak;
p.penalty ← penalty;
};
stats:
RECORD [
newListsCreated: INT ← 0,
readersCreated: INT ← 0,
listReadersStarted: INT ← 0,
extentsCreated: INT ← 0
];
fillGlue: PUBLIC REF ANY = MakeGlue[plus: TSGlue.fill];
filGlue: PUBLIC REF ANY = MakeGlue[plus: TSGlue.fil];
bigGlue: PUBLIC REF ANY = MakeGlue[space: TSTypes.IntDimn[1000, TSTypes.mm]];
END.
Michael Plass, September 1, 1982 9:03 pm: Added qZone.
Michael Plass, September 15, 1982 10:59 am: ENABLE UNWIND.
Michael Plass, November 2, 1982 10:26 am. CEDARized.
Michael Plass, November 12, 1982 9:33 am: Added pZone.