
<<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.