DIRECTORY
BasicTime, DecomposerRegistry, Imager, ImagerError, InterpressInterpreter, IO, IPAttributes, IPInstructions, ImagerSys, Prop, RefText, Rope, RuntimeError;

SimpleIPRegister: CEDAR MONITOR
IMPORTS DecomposerRegistry, Imager, ImagerError, InterpressInterpreter, IO, IPAttributes, IPInstructions, ImagerSys, Prop, RefText, Rope, RuntimeError
= BEGIN OPEN DecomposerRegistry;

Instance: TYPE = DecomposerRegistry.InstanceData;
Master: TYPE = InterpressInterpreter.Master;
ROPE: TYPE = Rope.ROPE;
STREAM: TYPE = IO.STREAM;

FileID: TYPE ~ IPAttributes.FileID;
TaggedMaster: TYPE ~ IPAttributes.TaggedMaster;

FileIDFromStream: PROC [stream: IO.STREAM] RETURNS [FileID ฌ NIL] ~ {
fileName: ROPE = ImagerSys.StreamFileName[stream];
created: BasicTime.GMT = ImagerSys.StreamCreateDate[stream];
IF fileName # NIL AND created # BasicTime.nullGMT THEN {
id: FileID ~ NEW[IPAttributes.FileIDRep ฌ [fileName: fileName, uid: created]];
RETURN [id]
};
};

FileIDEqual: PROC [a, b: FileID] RETURNS [BOOL] ~ {
RETURN [a.uid = b.uid AND Rope.Equal[a.fileName, b.fileName]]
};

CacheEntry: TYPE ~ RECORD [
fileID: FileID,
data: REF
];

cacheHead: LIST OF CacheEntry ~ LIST[[NIL, NIL]];

EnterInCache: ENTRY PROC [fileID: FileID, data: REF] ~ {
IF fileID # NIL AND data # NIL THEN {
cacheLast: LIST OF CacheEntry ฌ cacheHead;
UNTIL cacheLast.rest = NIL DO
cacheLast ฌ cacheLast.rest;
ENDLOOP;
cacheLast.rest ฌ LIST[[fileID: fileID, data: data]];
};
};

GetFromCache: ENTRY PROC [fileID: FileID] RETURNS [REF] ~ {
IF fileID = NIL THEN RETURN [NIL];
FOR tail: LIST OF CacheEntry ฌ cacheHead.rest, tail.rest UNTIL tail = NIL DO
IF FileIDEqual[fileID, tail.first.fileID] THEN {
cacheHead.rest ฌ tail.rest;
RETURN [tail.first.data];
};
ENDLOOP;
RETURN [NIL];
};
Protect: PROC [instance: Instance, inner: PROC [Instance]] RETURNS [BOOL] = {
ENABLE {
RuntimeError.Uncaught => {
info: UncaughtInfo = NEW[UncaughtInfoRep ฌ [signal: signal, parameters: parameters]];
instance.sequencer.procs.feedback[instance, $Uncaught, fatal, NIL];
GO TO fail;
};
ImagerError.Warning => {ipErrorProc[instance, error, TRUE]; RESUME};
ImagerError.Error => {ipErrorProc[instance, error, FALSE]; GO TO fail};
};
inner[instance];
RETURN [FALSE];
EXITS fail => RETURN [TRUE];
};

ipErrorProc: PROC [instance: Instance, error: ImagerError.ErrorDesc, warning: BOOL] = {
ros: STREAM = IO.ROS[];
key: ATOM ฌ $ImagerError;
severity: DecomposerRegistry.Severity ฌ error;
IF warning THEN {key ฌ $ImagerWarning; severity ฌ warning};
IF error.code # ok THEN IO.PutF1[ros, "[code: %g] ", [integer[error.code.ORD]] ];
IO.PutRope[ros, error.explanation];
Feedback[instance, key, severity, IO.RopeFromROS[ros]];
};

ipLogProc: PROC [instance: Instance, class: INT, code: ImagerError.ErrorCode, explanation: ROPE, propList: Prop.PropList] = {
out: STREAM = IO.ROS[];
key: ATOM ~ SELECT class FROM
>= InterpressInterpreter.classComment => $InterpressComment,
>= InterpressInterpreter.classAppearanceWarning => $ImagerWarning,
>= InterpressInterpreter.classAppearanceError => $ImagerError,
>= InterpressInterpreter.classMasterWarning => $InterpressWarning,
>= InterpressInterpreter.classMasterError => $InterpressError,
ENDCASE => $InterpressError;
severity: DecomposerRegistry.Severity ~ SELECT class FROM
>= InterpressInterpreter.classComment => $comment,
>= InterpressInterpreter.classAppearanceWarning => $warning,
>= InterpressInterpreter.classAppearanceError => $warning,
>= InterpressInterpreter.classMasterWarning => $warning,
>= InterpressInterpreter.classMasterError => $error,
ENDCASE => $error;
IF class # 0 THEN IO.PutF1[out, "[class: %g] ", [integer[class]] ];
IF code # ok THEN IO.PutF[out, "[code: %g(%g)] ", [atom[ImagerError.AtomFromErrorCode[code]]], [integer[code.ORD]] ];
IO.PutRope[out, explanation];
Feedback[instance, key, severity, IO.RopeFromROS[out]];
};

Feedback: PROC [instance: DecomposerRegistry.InstanceData, key: ATOM, severity: DecomposerRegistry.Severity, info: REF] ~ {
WITH instance.private SELECT FROM
tm: TaggedMaster => {
IF Prop.Get[tm.propList, $GeneratedFeedback] = NIL THEN {
tm.propList ฌ Prop.Put[tm.propList, $GeneratedFeedback, $TRUE];
};
};
ENDCASE;
instance.sequencer.procs.feedback[instance, key, severity, info];
};

ipGuessProc: GuessProc = {
probability: REAL ฌ 0.0;
lead: REF TEXT ฌ RefText.ObtainScratch[26];
init: INT = IO.GetIndex[seq.in];
lead.length ฌ IO.GetBlock[seq.in, lead, 0, 26];
IO.SetIndex[seq.in, init];
IF RefText.Match["Interpress/Xerox/* *\240\152*", lead, FALSE] THEN probability ฌ 0.999;
RefText.ReleaseScratch[lead];
RETURN [probability];
};

GetCopies: PROC [instance: Instance] RETURNS [copies: CARDINAL ฌ 0] ~ {
values: DecomposerRegistry.ValueSeq _ instance.sequencer.procs.getAttr[instance.sequencer, $CopyCount];
IF values # NIL AND values.len > 0 THEN WITH values[0] SELECT FROM
iv: REF DecomposerRegistry.ValueRep.integer => copies _ MAX[iv.integer, 0];
cv: REF DecomposerRegistry.ValueRep.cardinal => copies _ cv.cardinal;
ENDCASE;
IF copies > 20000 THEN {
ipLogProc[instance, InterpressInterpreter.classMasterWarning, $bounds, "Copy count truncated to 20000", NIL];
copies _ 20000;
};
};

ipOpenProc: OpenProc = {
fileID: FileID ~ FileIDFromStream[seq.in];
WITH GetFromCache[fileID] SELECT FROM
instance: Instance => {
IO.Close[seq.in]; -- already have contents
instance.sequencer ฌ seq;
instance.copies _ GetCopies[instance];
instance.flags.reverse ฌ instance.sequencer.flags.reverse;
RETURN [instance];
};
ENDCASE => {
instance: Instance = NEW[InstanceDataRep ฌ [
decomposer: data,
sequencer: seq,
pages: -1,
procs: ipInstanceProcs,
private: NIL
]];
localLog: InterpressInterpreter.LogProc = {
ipLogProc[instance, class, code, explanation, propList];
};
doOpen: PROC [instance: Instance] = {
reverse: BOOL = instance.sequencer.flags.reverse;
credentials: REF ฌ NIL;  -- eventually get from the properties
externalInstructions: REF ฌ MakeInstructions[instance];
defaultInstructions: REF ฌ NIL;  -- eventually get from the properties
master: Master = InterpressInterpreter.FromStream[
stream: seq.in, log: localLog,
credentials: credentials,
externalInstructions: externalInstructions,
defaultInstructions: defaultInstructions];
instance.private ฌ NEW[IPAttributes.TaggedMasterRep ฌ [fileID, master]];
instance.pages ฌ master.pages;
instance.flags ฌ [reverse: reverse, randomAccess: TRUE, pageContext: FALSE];
};
instance.copies _ GetCopies[instance];
[] ฌ Protect[instance, doOpen];
IF fileID # NIL THEN EnterInCache[fileID, Clone[instance, TRUE]];
RETURN [instance];
};
};

ipCleanProc: CleanProc = {
};

ipAttributesProc: AttributesProc = {
inner: PROC [inst: Instance] = {
IPAttributes.IPAttr[inst];
};
[] ฌ Protect[instance, inner];
};
ipPageProc: PageProc = {
flags: PageFlags ฌ [];
doPage: PROC [instance: Instance] = {
WITH IPAttributes.MasterFromInstance[instance] SELECT FROM
m: Master => {
flags.allCopies ฌ TRUE;
IF INT[page] >= m.pages THEN flags.last ฌ TRUE;
IF INT[page] IN [1..m.pages] THEN {
localLog: InterpressInterpreter.LogProc = {
IF code = $copySensitive
THEN { flags.allCopies ฌ FALSE }
ELSE {
explanation ฌ IO.PutFR["(page %g of copy %g) %g", [integer[page]], [integer[copy]], [rope[explanation]]];
ipLogProc[instance, class, code, explanation, propList];
};
};
IF instance.flags.reverse THEN page ฌ m.pages - page + 1;
flags.imaged ฌ TRUE;
flags.allCopies ฌ TRUE;
instance.sequencer.procs.feedback[instance, $ipPageProc, comment,
IO.PutFR["page %g, copy %g", [integer[page]], [integer[copy]] ]];
IF copy = 0
THEN {
InterpressInterpreter.DoPage[m, page, instance.context, localLog];
}
ELSE {
outputPosition: CARDINAL ฌ 0;
mediaOffset: CARDINAL ฌ 0;
[selected: flags.imaged, index: mediaOffset, offset: outputPosition] ฌ IPInstructions.GetDecodedInstructions[m, copy, page];
IF flags.imaged
THEN {
ctx: Imager.Context = instance.context;
[] ฌ InterpressInterpreter.DoPageWithInstructions[
m, page, ctx, localLog, copy];
WITH Imager.GetProp[ctx, $OutputBin] SELECT FROM
rc: REF CARDINAL => rc^ ฌ outputPosition;
ENDCASE => Imager.PutProp[ctx, $OutputBin,
NEW[CARDINAL ฌ outputPosition]];
}
ELSE
instance.sequencer.procs.feedback[
instance, $ipPageProc, comment, "not imaged"];
};
};
};
ENDCASE => flags.docFailed ฌ TRUE;
};
IF Protect[instance, doPage] THEN flags.docFailed ฌ TRUE;
RETURN [flags];
};

ipCloseProc: CloseProc = {
doClose: PROC [instance: Instance] = {
WITH IPAttributes.MasterFromInstance[instance] SELECT FROM
m: Master => {
instance.private ฌ NIL;
InterpressInterpreter.Close[m];
};
ENDCASE;
};
[] ฌ Protect[instance, doClose];
};

Clone: PROC [instance: InstanceData, clean: BOOL] RETURNS [InstanceData] ~ {
IF instance # NIL THEN WITH instance.private SELECT FROM
tm: TaggedMaster => IF tm.master # NIL AND tm.propList = NIL THEN {
new: InstanceData ฌ NEW[InstanceDataRep ฌ instanceญ];
new.private ฌ NEW[IPAttributes.TaggedMasterRep ฌ [tm.fileID, InterpressInterpreter.FromMaster[tm.master]]];
IF clean THEN new.sequencer ฌ NIL;
RETURN [new];
};
ENDCASE;
RETURN [NIL];
};

ipCloneProc: CloneProc = {
RETURN [Clone[instance, FALSE]]
};

ipSpecialProc: SpecialProc = {
RETURN [NIL];	-- for now, no special operations
};

ipInstanceProcs: REF InstanceProcs = NEW[InstanceProcs ฌ [
attributes: ipAttributesProc,
page: ipPageProc,
close: ipCloseProc,
clone: ipCloneProc,
special: ipSpecialProc
]];

ipDecomposerProcs: REF DecomposerProcs ฌ NEW[DecomposerProcs ฌ [
guess: ipGuessProc,
open: ipOpenProc,
clean: ipCleanProc
]];

ipDecomposerPrivate: REF ฌ NIL;

ipDecomposerData: DecomposerData = NEW[DecomposerDataRep ฌ [
key: $IP,
doc: "Interpress 3.1",
procs: ipDecomposerProcs,
private: ipDecomposerPrivate
]];

MakeInstructions: PROC [inst: Instance] RETURNS [IPInstructions.Instructions] ~ {
instructions: IPInstructions.Instructions ~ NEW[IPInstructions.InstructionsRecord ฌ [instr: inst, inputProc: FillInstructionsVector]];
RETURN [instructions];
};

FillInstructionsVector: IPInstructions.InputProc ~ {
copySelect: ROPE ~ IPInstructions.NameRopeFromName[$copySelect];
WITH instr SELECT FROM
inst: Instance => {
SELECT TRUE FROM
Rope.Equal[instID, copySelect, FALSE] => {
msg: ROPE = IO.PutFR1["copies: %g", [integer[inst.copies]] ];
inst.sequencer.procs.feedback[inst, $FillInstructionsVector, comment, msg];
IF inst.copies > 0 THEN {
ops.pushIdentifier[copySelect];
ops.pushInteger[inst.copies];
ops.pushInteger[1];
ops.makeVec[2];
};
};
ENDCASE;
};
ENDCASE;
};

DecomposerRegistry.Register[ipDecomposerData];

END.


SimpleIPRegister.mesa
Copyright ำ 1992, 1993 by Xerox Corporation.  All rights reserved.
Russ Atkinson (RRA) December 15, 1992 1:54 pm PST
Kenneth A. Pier, January 31, 1992 11:37 am PST
Michael Plass, July 6, 1993 10:05 am PDT
This is a simple form of registered decomposer.  We use Interpress, since it is the simplest real decomposer we have.  We also ignore errors except for ImagerError, hoping that the caller will handle UNCAUGHT.


Prescan Cache
We remove all the entries that are older than the matching one, so that we don't accumulate junk.  This means we'll re-skeletonize when we print things in a different order than pre-scan, but this is just an optimization, anyway.
Error logging
I don't think this gets used, because Interpress catches the Imager signals.  - MFP
This records the fact that some feedback happened; this is used to inhibit the prescan cache when feedback (such as font substitution) happened early on, so that the messages won't get lost.
Guesser
The pattern may end of the matching either the start of the preamble, or the instructions.  The limited length should avoid a false hit against an FIS font master, or RES file, or a SIF or other Interpress fragment.
Open/Clean
[data: DecomposerData, seq: SequencerData] RETURNS [InstanceData]
For now, nothing to clean up
Attributes
Page
Image the requested page
We are requesting stuff to be NOT copy-sensitive
We are requesting copy-sensitive imaging
This is what happens when the world is closed down
Close
Just close down the world, and remove the master so it won't get closed again.
Clone
[instance: InstanceData] RETURNS [InstanceData]
Misc
Setup
PROC [instr: InstPtr, default: BOOLEAN, instID: ROPE, ops: StackOps]
This selects all of the copies.  Someday this should be fixed to select copies individually.
ส,•NewlineDelimiter

–
(cedarcode) style™
codeš
œ™Kšœ
ฯe
œ7™BK™1K™.K™(—˜Kšœศ
ฯkœ
™ั
K™K™š
ž	˜	KšœKžœM˜š
K˜——šฯnœžœ
ž˜KšžœAžœL˜–
Kšœžœ
žœ˜ K˜Kšœ
žœ#˜1Kšœžœ ˜,Kšžœžœžœ
˜Kšžœžœžœ
žœ
˜—K˜
head™
Kšœžœ˜#šœžœ˜/K˜—šŸœžœ
žœ
žœžœžœ˜EKšœ
žœ$˜2Kšœžœ&˜<šžœžœ
žœžœ˜8Kšœ
žœ>˜NKšžœ˜Kš
œ˜—Kš
œ˜K˜—šŸœžœžœžœ˜3Kšžœžœ$˜=Kš
œ˜K˜—šœžœžœ˜J˜Kšœž˜	Kš
œ˜K˜—Kšœžœ
žœžœžœ
žœ˜1K˜šŸœžœ
žœžœ˜8š
žœ
žœ
žœžœ
žœ˜%Kšœžœ
žœ˜*šžœžœ
ž˜K˜Kšžœ
˜—Kšœžœ˜4Kš
œ˜—Kš
œ˜K˜—š
Ÿœžœ
žœžœžœ˜;Kš
žœ
žœ
žœ
žœžœ˜"šžœžœ
žœ(žœžœ
ž˜Lšžœ(žœ˜0K™ๅ
K˜Kšžœ˜K˜—Kšžœ
˜—Kšžœžœ˜
K˜——™
š
Ÿœžœžœ
žœžœ˜Mšžœ˜˜Kšœžœ=˜UKšœ>žœ˜CKšžœ
žœ˜K˜—Kšœ5žœžœ˜DKšœ3žœžœ
žœ˜GK˜—Kš
œ˜Kšžœžœ˜Kšžœ	žœžœ˜K˜K˜—šœ
žœ=žœ˜WK™SKšœžœžœ
žœ˜Kšœžœ˜K˜.Kšžœ	žœ,˜;Kšžœžœ
žœ/žœ˜QKšžœ!˜#Kšœ"žœ˜7K˜K˜—šœžœžœ,žœ˜}Kšœžœžœ
žœ˜šœžœžœž˜K˜<K˜BK˜>K˜BK˜>Kšžœ˜—šœ(žœž˜9K˜2K˜<K˜:K˜8K˜4Kšžœ˜—Kšžœžœ
žœ/˜CKšžœžœ
žœYžœ˜uKšžœ˜Kšœ"žœ˜7K˜K˜—šŸœžœ2žœ/žœ˜{šžœžœ
ž˜!˜K™พ
šžœ-žœ
žœ˜9K˜?Kš
œ˜—K˜—Kšžœ
˜—J˜AKš
œ˜K˜——™š
œ˜Kšœ
žœ˜Kšœžœ
žœ˜+Kšœžœžœ˜ Kšœžœ˜/Kšžœ˜šžœ6žœžœ˜XK™ื
—Kš
œ˜Kšžœ˜K˜K˜——™
šŸ	œžœžœ
žœ	˜GK˜gš
žœ
žœ
žœžœ
žœžœ
ž˜BKšœžœ1žœ˜KKšœžœ>˜EKšžœ
˜—šžœžœ˜Kšœhžœ˜mK˜K˜—Kš
œ˜K˜—˜Kšœ+žœ™AK˜*šžœžœ
ž˜%˜Kšžœฯc˜*K˜K˜&K˜:Kšžœ˜K˜—šžœ˜šœžœ˜,Kš
œ˜Kš
œ˜Kš
œ
˜
Kš
œ˜Kšœ	ž˜Kš
œ˜—˜+Kš
œ8˜8K˜—šœžœ˜%Kšœ	žœ$˜1Kšœ
žœžœ %˜>Kšœžœ˜7Kšœžœžœ %˜FKš
œย
˜ย
Kšœžœ2˜HK˜Kšœ2žœžœ˜LK˜—K˜&K˜Kšžœ
žœ
žœ&žœ˜AKšžœ˜K˜——K˜K˜—š
œ˜K™K˜K˜——™
š
œ$˜$šœžœ˜ K˜K˜—K˜K˜——™š
œ˜K˜šœžœ˜%šžœ+žœ
ž˜:š
œ˜Kšœžœ
˜Kšžœ
žœžœžœ
˜/šžœ
žœžœžœ˜#K™š
œ+˜+šžœ˜Kšžœžœ˜ šžœ˜KšœžœY˜iKš
œ8˜8K˜——K˜—Kšžœžœ˜9Kšœžœ
˜Kšœžœ
˜KšœBžœ?˜ƒ
šžœ	˜šžœ˜K™0Kš
œB˜BK˜
—šžœ˜K™(Kšœžœ˜Kšœ
žœ˜K˜|šžœ
˜šžœ˜K˜'K˜Qšžœ!žœ
ž˜0Kšœžœ
žœ˜)Kšžœ$žœ
žœ˜K—K˜
—š
ž˜K˜Q——K˜——K˜—K˜—šžœžœ
˜"K™2——K˜—Kšžœžœžœ
˜9Kšžœ	˜K˜K˜——™š
œ˜šœ	žœ˜&šžœ+žœ
ž˜:˜K™NKšœžœ
˜Kš
œ˜K˜—Kšžœ
˜—K˜—K˜ K˜K˜——™šŸœžœ!žœžœ˜Lšžœžœ
žœ
žœžœ
ž˜8šœžœ
žœ
žœžœ
žœ˜CKšœžœ˜5KšœžœZ˜kKšžœžœžœ
˜"Kšžœ˜
K˜—Kšžœ
˜—Kšžœžœ˜
Kš
œ˜K˜—˜Kšœžœ™/Kšžœžœ˜K˜K˜——™š
œ˜Kšžœžœ !˜/K˜K˜——™šœžœžœ˜:Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜K˜K˜—šœžœžœ˜@Kš
œ˜Kš
œ˜K˜K˜K˜—šœžœžœ
˜K˜—šœ#žœ˜<Kš
œ	˜	K˜Kš
œ˜K˜K˜K˜—šŸœžœžœ"˜QKšœ,žœW˜†
Kšžœ˜K˜K˜—šŸœ˜4Kšžœžœ
žœ™DKšœžœ0˜@šžœžœ
ž˜š
œ˜šžœ
žœ
ž˜šœžœ˜*Kšœžœžœ/˜=K˜Kšžœžœ˜K™\K˜Kš
œ˜Kš
œ˜Kš
œ˜K˜—Kš
œ˜—Kšžœ
˜—K˜—Kšžœ
˜—Kš
œ˜K˜—Kš
œ.˜.—K˜Kšžœ
˜K˜—…—(š;า