<> <> <> <<>> <> 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]}; <> [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] ~ { <> 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] ~ { <> <<>> 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]; <> 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] ~ { <> <<>> token: IPMaster.Token; NullProc: ReplaceEncodingProc ~ {}; executablePart _ RopeFile.Create[fileName ! FS.Error => { SELECT error.group FROM ok, bug => REJECT; 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"]]; ENDCASE => REJECT}]; executablePart _ Rope.Substr[executablePart, GetHeader[executablePart].next]; <> 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 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]]]; }; }.