DIRECTORY
FS USING [Error],
IO USING [PutFR1, rope],
IPExecute USING [ExecutePreamble, defaultMaxStackLength],
ImagerBackdoor USING [BitmapContext, NewBitmap],
Interpress USING [LogProc],
IPInterpreter USING [Vector, Ref, Rep, StackArrayRep, topFrameSize, ZeroVec],
IPMaster USING [GetToken, GetSequenceRope, Skeleton, SkeletonRecord, Block, BlockRep, Node, NodeRep, Preamble, PreambleRecord, Instructions, InstructionsRecord, Body, Token, Error, Vector],
IPSkeleton,
Rope USING [Cat, Length, MaxLen, ROPE, Run, Size, SkipTo, Substr],
RopeFile USING [Create],
RuntimeError USING [BoundsFault];
IPSkeletonImpl:
CEDAR
PROGRAM
IMPORTS IO, Rope, RopeFile, IPMaster, RuntimeError, FS, ImagerBackdoor, IPExecute, IPInterpreter
EXPORTS IPSkeleton
~ {
ROPE: TYPE ~ Rope.ROPE;
NewEncodingProc: TYPE = PROC [bytesToCopy, bytesToSkip: INT ← 0, encodingToAppend: ROPE ← NIL] RETURNS [newEncoding: ROPE, newIndex: INT];
ReplaceEncodingProc: TYPE = PROC[newEncoding: ROPE]; -- To tell my caller what the new encoding is.
GetSkeleton: PUBLIC PROC [master: ROPE, start: INT] RETURNS [skeleton: IPMaster.Skeleton ← NIL, next: INT] ~ {
AlterMaster: ReplaceEncodingProc ~ {masterRope ← newEncoding}; -- Is this church related ???
masterRope: ROPE ← Rope.Substr[master, start];
blockStart: INT ← GetHeader[masterRope].next; -- Check and Skip Header
tokenStart: INT ← blockStart;
token: IPMaster.Token;
topFrame: IPMaster.Vector ← IPInterpreter.ZeroVec[IPInterpreter.topFrameSize]; -- Moved from IPExecuteImpl and IPExecImpl
topEnv: IPMaster.Vector ← IPInterpreter.ZeroVec[0]; -- emptyVec
SkipComments[masterRope, blockStart, AlterMaster]; -- Remove comments if there
skeleton ← NEW[IPMaster.SkeletonRecord ← [NIL, NIL, NIL -- replace Heap.Create[...] for NIL in the NS world --]];
[token, next] ← IPMaster.GetToken[masterRope, tokenStart]; -- See if Instructions exist
IF token.op = beginBody THEN {skeleton.instructions ← NEW[IPMaster.InstructionsRecord]; [skeleton.instructions.source, blockStart] ← GetBody[masterRope, tokenStart, AlterMaster]};
Execute the instructions here
[skeleton.topBlock, next] ← GetBlock[masterRope, blockStart, 0, AlterMaster,
IF skeleton.instructions=
NIL
THEN
NIL
ELSE skeleton.instructions.instructions, topFrame, topEnv]
};
GetBody:
PROC [encoding:
ROPE, start:
INT, alterEncodingProc: ReplaceEncodingProc, instructionsVector: IPInterpreter.Vector ←
NIL]
RETURNS [body: IPMaster.Body ←
NIL, next:
INT] ~ {
token: IPMaster.Token;
tokenIndex: INT ~ start;
AlterEncoding: ReplaceEncodingProc ~ {alterEncodingProc[encoding ← newEncoding]};
MakeNewEncodingProc: NewEncodingProc ~ {
IF bytesToCopy > 0
THEN {
body ← Rope.Cat[body, Rope.Substr[base: encoding, start: next, len: bytesToCopy]];
next ← next + bytesToCopy};
newIndex ← next;
IF bytesToSkip > 0 OR Rope.Length[encodingToAppend] > 0 THEN alterEncodingProc[encoding ← Rope.Cat[Rope.Substr[base: encoding, start: 0, len: next], encodingToAppend, Rope.Substr[base: encoding, start: next+bytesToSkip]]];
newEncoding ← encoding};
SkipComments[encoding, start, AlterEncoding];
[token, next] ← IPMaster.GetToken[encoding, tokenIndex];
IF token.op = beginBody
THEN {
tokenSize: INT = next-tokenIndex;
next ← tokenIndex;
next ← MakeNewEncodingProc[tokenSize, 0, NIL].newIndex; -- Push the '{' out
next ← ScanForInsertedFilesInBody[encoding, next, instructionsVector, MakeNewEncodingProc, AlterEncoding]}
ELSE ERROR IPMaster.Error[[code: $invalidSkeleton, explanation: "Missing { in skeleton."]];
};
GetBlock: PROC [encoding: ROPE, start, startingPlateNumber: INT, alterEncodingProc: ReplaceEncodingProc, instructionsVector, preambleVector, environment: IPInterpreter.Vector ← NIL] RETURNS [block: IPMaster.Block, next: INT] ~ {
token: IPMaster.Token;
firstPlate: INT ← startingPlateNumber;
totalPlates: NAT ← 0; -- how many plates this block owns
tokenStart: INT ~ start;
preamble: IPMaster.Preamble ← NEW[IPMaster.PreambleRecord ← [NIL, NIL, NIL]];
self: IPInterpreter.Ref ← NEW[IPInterpreter.Rep ← [topFrame: preambleVector, topEnv: environment, stackArray: NEW[IPInterpreter.StackArrayRep ← ALL[[zero[]]]], buffer: NEW[TEXT[200]], stackCountMax: IPExecute.defaultMaxStackLength, imager: ImagerBackdoor.BitmapContext[ImagerBackdoor.NewBitmap[16, 16]]]];
AlterEncoding: ReplaceEncodingProc ~ {alterEncodingProc[encoding ← newEncoding]};
SkipComments[encoding, start, AlterEncoding];
[token, next] ← IPMaster.GetToken[encoding, tokenStart];
IF token.op = beginBlock
THEN {
list: LIST OF IPMaster.Node ← NIL;
size: NAT ← 0; -- number of content nodes
PreambleLogProc: Interpress.LogProc ~ {
IPMaster.Error[[code: code, explanation: explanation]]
};
[preamble.source, next] ← GetBody[encoding, next, AlterEncoding, instructionsVector];
self.rope ← preamble.source;
self.index ← 0;
IPExecute.ExecutePreamble[self, preamble, self.topFrame, self.topEnv, PreambleLogProc];
preamble.initialFrame ← self.topFrame;
preamble.environment ← self.topEnv;
DO
node: IPMaster.Node ← NIL;
[node, next] ← GetNode[encoding, next, startingPlateNumber, AlterEncoding, instructionsVector, self.topFrame, self.topEnv];
IF node =
NIL
THEN {
-- Check for $endBlock
[token, next] ← IPMaster.GetToken[encoding, next];
IF token.op = endBlock THEN EXIT ELSE ERROR IPMaster.Error[[code: $invalidSkeleton, explanation: "Missing END"]]};
WITH node
SELECT
FROM
node:
REF IPMaster.NodeRep.body => {
totalPlates ← totalPlates+1;
startingPlateNumber ← startingPlateNumber+1};
node:
REF IPMaster.NodeRep.block => {
totalPlates ← totalPlates+node.block.totalPlates;
startingPlateNumber ← startingPlateNumber+node.block.totalPlates};
ENDCASE => ERROR;
list ← CONS[node, list];
size ← size+1;
ENDLOOP;
block ← NEW[IPMaster.BlockRep[size]];
block.startingPlateNumber ← firstPlate;
block.totalPlates ← totalPlates;
block.preamble ← preamble;
WHILE size>0 DO block[size ← size-1] ← list.first; list ← list.rest ENDLOOP}
ELSE
IF token.seq = sequenceInsertMaster
THEN {
fileName: ROPE ← NIL;
node: IPMaster.Node ← NIL;
[fileName, next] ← IPMaster.GetSequenceRope[encoding, next, token.len];
alterEncodingProc[encoding ← Rope.Cat[Rope.Substr[encoding, 0, tokenStart], FetchInsertedMaster[fileName, instructionsVector], Rope.Substr[encoding, next]]];
[node, next] ← GetNode[encoding, tokenStart, startingPlateNumber, AlterEncoding, instructionsVector, self.topFrame, self.topEnv];
WITH node
SELECT
FROM
node: REF IPMaster.NodeRep.body => {totalPlates ← totalPlates+1};
node: REF IPMaster.NodeRep.block => {totalPlates ← totalPlates+node.block.totalPlates};
ENDCASE => ERROR;
block ← NEW[IPMaster.BlockRep[1]];
block.startingPlateNumber ← firstPlate;
block.totalPlates ← totalPlates;
block.preamble ← preamble;
block[0] ← node}
ELSE
ERROR IPMaster.Error[[code: $invalidSkeleton, explanation: "Missing BEGIN in skeleton."]];
};
GetNode: PROC [encoding: ROPE, start, startingPlateNumber: INT, alterEncodingProc: ReplaceEncodingProc, instructionsVector, preambleVector, environment: IPInterpreter.Vector ← NIL] RETURNS [node: IPMaster.Node ← NIL, next: INT] ~ {
AlterEncoding: ReplaceEncodingProc ~ {alterEncodingProc[encoding ← newEncoding]};
contentStart: INT ← start;
token: IPMaster.Token;
contentInstructions: IPMaster.Instructions ← NEW[IPMaster.InstructionsRecord ← [NIL, instructionsVector]];
SkipComments[encoding, start, AlterEncoding];
[token, next] ← IPMaster.GetToken[encoding, contentStart];
IF token.op = contentInstructions
THEN {
[contentInstructions.source, contentStart] ← GetBody[encoding, next, AlterEncoding, instructionsVector];
*** Execute the ContentInstructions here {Uses instructionsVector and preambleVector}
[node, next] ← GetNode[encoding, contentStart, startingPlateNumber, AlterEncoding, instructionsVector, preambleVector, environment];
*** Free the old contentInstructions currently in node
node.contentInstructions ← contentInstructions;
RETURN};
SELECT token.type
FROM
seq =>
IF token.seq=sequenceInsertMaster
THEN {
block: IPMaster.Block ← NIL;
[block, next] ← GetBlock[encoding, contentStart, startingPlateNumber, AlterEncoding, instructionsVector, preambleVector, environment];
node ←
NEW[IPMaster.NodeRep.block ← [contentInstructions: contentInstructions,
content: block[block]]]}; -- caller needs to set startingPlateNumber, totalPlates;
op =>
SELECT token.op
FROM
beginBlock => {
block: IPMaster.Block ← NIL;
[block, next] ← GetBlock[encoding, contentStart, startingPlateNumber, AlterEncoding, instructionsVector, preambleVector, environment];
node ←
NEW[IPMaster.NodeRep.block ← [contentInstructions: contentInstructions,
content: block[block]]]}; -- caller needs to set startingPlateNumber, totalPlates
beginBody => {
body: IPMaster.Body ← NIL;
[body, next] ← GetBody[encoding, contentStart, AlterEncoding, instructionsVector];
node ← NEW[IPMaster.NodeRep.body ← [contentInstructions: contentInstructions, content: body[body]]]};
ENDCASE => next ← contentStart; -- This token is not for me
ENDCASE => next ← contentStart; -- This token is not for me;
};
ScanForInsertedFilesInBody:
PROC [encoding:
ROPE, startingIndex:
INT, instructions: IPInterpreter.Vector, modifyEncoding: NewEncodingProc, alterEncodingProc: ReplaceEncodingProc]
RETURNS [next:
INT] ~ {
For now, instructions are ignored and only the actually referenced name is looked up. No mapping is done {no aliasing}. When Instructions are finally installed, full lookups will be done by another procedure called TrueName which will look through the instructions vector for the name and mapping info and will find the real named referenced.
beginBodyCount: INT ← 1; -- We always start with a beginBody so the count is 1
AlterEncoding: ReplaceEncodingProc ~ {alterEncodingProc[encoding ← newEncoding]};
next ← startingIndex;
DO
token: IPMaster.Token;
last: INT ← next;
[token, next] ← IPMaster.GetToken[encoding, next ! RuntimeError.BoundsFault => ERROR IPMaster.Error[[code: $invalidSkeleton, explanation: "Missing '}' in skeleton"]]];
SELECT token.type
FROM
op =>
SELECT token.op
FROM
beginBody =>
beginBodyCount ← beginBodyCount+1;
endBody =>
SELECT (beginBodyCount ← beginBodyCount-1)
FROM
<0 => IPMaster.Error[[code: $invalidSkeleton, explanation: "Missing '{' in skeleton"]];
=0 => {[] ← modifyEncoding[next-startingIndex, 0, NIL]; EXIT};
ENDCASE => next ← next+token.len; -- >0
ENDCASE => next ← next+token.len;
seq =>
SELECT token.seq
FROM
sequenceInsertFile => {
fileName: ROPE;
[fileName, next] ← IPMaster.GetSequenceRope[encoding, next, token.len];
[encoding, startingIndex] ← modifyEncoding[last-startingIndex, next-last, FetchInsertedFile[fileName, instructions]]};
sequenceComment =>
{SkipComments[encoding, last, AlterEncoding]; next ← last};
ENDCASE => next ← next+token.len;
ENDCASE => next ← next+token.len;
ENDLOOP;
};
FetchInsertedFile:
PROC [name:
ROPE, instructions: IPInterpreter.Vector]
RETURNS [executablePart:
ROPE] ~ {
Eventually, this procedure will use the Instructions vector to do aliasing/mapping lookups. For now the name is the name and it better be there or an error will be raised.
token: IPMaster.Token;
executablePart ← RopeFile.Create[name !
FS.Error => {
SELECT error.group
FROM
ok, bug => REJECT;
lock =>
ERROR IPMaster.Error[[code: $InsertFileUnavailable, explanation: "Referenced file is LOCKed"]];
environment =>
ERROR IPMaster.Error[[code: $InsertFileUnavailable, explanation: "Environment not suitable for Fetching"]];
client =>
ERROR IPMaster.Error[[code: $InsertFileUnavailable, explanation: "Client type error"]];
user =>
SELECT error.code
FROM
$illegalName => ERROR IPMaster.Error[[code: $InsertFileUnavailable, explanation: "File/directory name/pattern has illegal syntax/characters, or is too long"]];
$unknownFile => ERROR IPMaster.Error[[code: $InsertFileUnavailable, explanation: "No such file in the implied directory"]];
$unknownServer => ERROR IPMaster.Error[[code: $InsertFileUnavailable, explanation: "Server unavailable/non-existant"]];
ENDCASE => ERROR IPMaster.Error[[code: $InsertFileUnavailable, explanation: "Unavailable"]];
ENDCASE => REJECT}];
executablePart ← Rope.Substr[executablePart, GetHeader[executablePart].next];
GetHeader will raise $invalidHeader if the header is an improper encoding.
token ← IPMaster.GetToken[executablePart, 0].token;
IF NOT (token.type=op AND token.op=beginBlock) THEN ERROR IPMaster.Error[[code: $MalformedInsertFile, explanation: "Missing BEGIN"]];
token ← IPMaster.GetToken[executablePart, Rope.Length[executablePart]-2 -- END token is 2 bytes long --].token;
IF NOT (token.type=op AND token.op=endBlock) THEN ERROR IPMaster.Error[[code: $MalformedInsertFile, explanation: "Missing END"]];
executablePart ← Rope.Substr[executablePart, 2 -- BEGIN is 2 bytes long --, Rope.Length[executablePart] - (2+2) -- END is also 2 bytes long --];
};
FetchInsertedMaster:
PROC [fileName:
ROPE, instructionsVector: IPInterpreter.Vector]
RETURNS [executablePart:
ROPE] ~ {
Eventually, this procedure will use the Instructions vector to do aliasing/mapping lookups. For now the name is the name and it better be there or an error will be raised.
token: IPMaster.Token;
NullProc: ReplaceEncodingProc ~ {};
executablePart ← RopeFile.Create[fileName !
FS.Error => {
SELECT error.group
FROM
lock =>
ERROR IPMaster.Error[[code: $InsertMasterUnavailable, explanation: "Referenced file is LOCKed"]];
environment =>
ERROR IPMaster.Error[[code: $InsertMasterUnavailable, explanation: "Environment not suitable for Fetching"]];
client =>
ERROR IPMaster.Error[[code: $InsertMasterUnavailable, explanation: "Client type error"]];
user =>
SELECT error.code
FROM
$illegalName => ERROR IPMaster.Error[[code: $InsertMasterUnavailable, explanation: "File/directory name/pattern has illegal syntax/characters, or is too long"]];
$unknownFile => ERROR IPMaster.Error[[code: $InsertMasterUnavailable, explanation: "No such file in the implied directory"]];
$unknownServer => ERROR IPMaster.Error[[code: $InsertMasterUnavailable, explanation: "Server unavailable/non-existant"]];
ENDCASE => ERROR IPMaster.Error[[code: $InsertMasterUnavailable, explanation: "Unavailable"]];
executablePart ← Rope.Substr[executablePart, GetHeader[executablePart].next];
GetHeader will raise $invalidHeader if the header is an improper encoding
token ← IPMaster.GetToken[executablePart, 0].token;
IF token.op = beginBody
THEN
-- Instructions to be ignored were found
token ← IPMaster.GetToken[executablePart ← Rope.Substr[executablePart, GetBody[executablePart, 0, NullProc, instructionsVector].next], 0].token;
IF token.op # beginBlock THEN ERROR IPMaster.Error[[code: $MalformedMasterInsertFile, explanation: "Missing BEGIN"]];
token ← IPMaster.GetToken[executablePart, Rope.Length[executablePart]-2 -- END token is 2 bytes long --].token;
IF token.op # endBlock THEN ERROR IPMaster.Error[[code: $MalformedMasterInsertFile, explanation: "Missing END"]];
};
GetHeader: PROC [master: ROPE] RETURNS [header: ROPE, next: INT] ~ {
headerPrefix: ROPE ~ "Interpress/";
prefixSize: INT ~ Rope.Size[headerPrefix];
matchSize: INT ~ Rope.Run[s1: master, s2: headerPrefix, case: TRUE];
IF matchSize<prefixSize
THEN {
ERROR IPMaster.Error[[code: $invalidHeader, explanation:
IO.PutFR1["Header does not begin with \"%g\".", IO.rope[headerPrefix]]]]}
ELSE {
spaceIndex: INT ~ Rope.SkipTo[s: master, pos: prefixSize, skip: " "];
header ← Rope.Substr[base: master, start: prefixSize, len: spaceIndex-prefixSize];
next ← spaceIndex+1};
};
SkipComments:
PROC [encoding:
ROPE, start:
INT, alterEncodingProc: ReplaceEncodingProc] ~
INLINE
-- For Speed -- {
next: INT ← start;
DO
peekToken: IPMaster.Token;
peekNext: INT;
[peekToken, peekNext] ← IPMaster.GetToken[encoding, next];
peekNext ← peekNext+peekToken.len;
SELECT peekToken.seq
FROM
sequenceComment => NULL;
sequenceContinued => IF next=start THEN EXIT;
ENDCASE => EXIT;
next ← peekNext;
ENDLOOP;
IF next # start THEN alterEncodingProc[Rope.Cat[Rope.Substr[encoding, 0, start], Rope.Substr[encoding, next]]];
};
}.