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.
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;
Prescan Cache
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 {
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.
cacheHead.rest ¬ tail.rest;
RETURN [tail.first.data];
};
ENDLOOP;
RETURN [NIL];
};
Error logging
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] = {
I don't think this gets used, because Interpress catches the Imager signals. - MFP
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 => {
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.
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];
};
Guesser
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;
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.
RefText.ReleaseScratch[lead];
RETURN [probability];
};
Open/Clean
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 = {
[data: DecomposerData, seq: SequencerData] RETURNS [InstanceData]
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 = {
For now, nothing to clean up
};
Attributes
ipAttributesProc: AttributesProc = {
inner: PROC [inst: Instance] = {
IPAttributes.IPAttr[inst];
};
[] ¬ Protect[instance, inner];
};
Page
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 {
Image the requested page
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 {
We are requesting stuff to be NOT copy-sensitive
InterpressInterpreter.DoPage[m, page, instance.context, localLog];
}
ELSE {
We are requesting copy-sensitive imaging
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;
This is what happens when the world is closed down
};
IF Protect[instance, doPage] THEN flags.docFailed ¬ TRUE;
RETURN [flags];
};
Close
ipCloseProc: CloseProc = {
doClose: PROC [instance: Instance] = {
WITH IPAttributes.MasterFromInstance[instance] SELECT FROM
m: Master => {
Just close down the world, and remove the master so it won't get closed again.
instance.private ¬ NIL;
InterpressInterpreter.Close[m];
};
ENDCASE;
};
[] ¬ Protect[instance, doClose];
};
Clone
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 = {
[instance: InstanceData] RETURNS [InstanceData]
RETURN [Clone[instance, FALSE]]
};
Misc
ipSpecialProc: SpecialProc = {
RETURN [NIL]; -- for now, no special operations
};
Setup
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 ~ {
PROC [instr: InstPtr, default: BOOLEAN, instID: ROPE, ops: StackOps]
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 {
This selects all of the copies. Someday this should be fixed to select copies individually.
ops.pushIdentifier[copySelect];
ops.pushInteger[inst.copies];
ops.pushInteger[1];
ops.makeVec[2];
};
};
ENDCASE;
};
ENDCASE;
};
DecomposerRegistry.Register[ipDecomposerData];
END.