PutFileImpl.Mesa
written by Paxton. May 1981
Last Edited by: Lamming, June 9, 1983 3:41 pm
DIRECTORY
Atom USING [GetPName],
Directory USING [GetProperty],
File USING [Capability],
FileIO USING [CapabilityFromStream, Open, StreamFromCapability],
FileWriter USING [blockSize, BumpWriter, Close, OpenC, Ref, ToRope, ToStream, WriteChar, WriteRope],
IO USING [Close, CreateOutputStreamToRope, Error, GetIndex, GetOutputStreamRope, Handle, PutChar, PutRope, SetLength],
NameSymbolTable USING [RopeFromName],
NodeProps USING [GetProp, PutProp, MapProps, GetSpecs],
Process USING [GetPriority, Priority, priorityBackground, SetPriority],
PropertyTypes USING [tCreateDate],
PutGet,
Rope USING [Fetch, Size, Substr],
RopeEdit USING [BlankChar, ROPE],
RopeIO USING [PutRope, ToFileC],
RopeReader USING [FreeRopeReader, GetRopeReader, GetString, Ref, SetPosition],
RunReader USING [FreeRunReader, GetRunReader, MergedGet, Ref, SetPosition],
System USING [GreenwichMeanTime],
T2FileOps USING [addLooksFirst, cmt, comment, default, fmt, format, heavyDuty, IntBytes, lastItem, lastLooksFirst, LengthByte, noClassData, noLooks, Op, prop, runs, startBI, startBranch, startBX, startClassData, startLI, startTI, ThirdByte],
TiogaLooks USING [Look, Looks, noLooks, Runs],
TiogaLooksOps USING [CountRuns],
TiogaBasicClass USING [BasicClass],
TiogaItemClass USING [ItemClass],
TiogaNode USING [Name, NodeProps, nullName, Offset, Ref, RefBasicNode, RefBoxNode, RefBranchNode, RefItemNode, RefListNode, RefTextNode],
TiogaNodeOps USING [BranchContents, FetchBasicClass, FetchItemClass, Forward, NarrowToTextNode, StepForwardNode];
PutFileImpl:
CEDAR PROGRAM
IMPORTS Directory, Atom, FileIO, FileWriter, IO, NameSymbolTable, NodeProps, Process, Rope, RopeEdit, RopeIO, RopeReader, RunReader, TiogaLooksOps, TiogaNodeOps
EXPORTS PutGet
SHARES RopeReader, FileWriter =
BEGIN OPEN PutGet;
ToRope:
PUBLIC
PROC [node: TiogaNode.RefBranchNode, flatten, textOnly:
BOOLEAN ←
FALSE]
RETURNS [dataLen, count: TiogaNode.Offset, output: RopeEdit.ROPE] = {
ctrl, data: FileWriter.Ref;
simple: BOOLEAN;
[output, simple] ← SimpleFile[node];
IF simple THEN { dataLen ← count ← Rope.Size[output]; RETURN };
[ctrl, data] ← FileWriter.ToRope[];
OutputStructure[ctrl, data, node, flatten];
[dataLen, count, output] ← FileWriter.Close[ctrl, data, textOnly]
};
ToStream:
PUBLIC
PROC [stream:
IO.Handle, node: TiogaNode.RefBranchNode, flatten, textOnly:
BOOLEAN ←
FALSE]
RETURNS [dataLen, count: TiogaNode.Offset] = {
ctrl, data: FileWriter.Ref;
rope: RopeEdit.ROPE;
simple: BOOLEAN;
[rope, simple] ← SimpleFile[node];
IF simple
THEN {
RopeIO.PutRope[stream, rope];
dataLen ← count ← Rope.Size[rope];
RETURN };
[ctrl, data] ← FileWriter.ToStream[stream];
OutputStructure[ctrl, data, node, flatten];
[dataLen, count, ] ← FileWriter.Close[ctrl, data, textOnly]
};
ToFile:
PUBLIC
PROC [fileName: RopeEdit.
ROPE, node: TiogaNode.RefBranchNode, start: TiogaNode.Offset ← 0, flatten, textOnly:
BOOLEAN ←
FALSE]
RETURNS [dataLen, count: TiogaNode.Offset] = {
stream: IO.Handle ← FileIO.Open[fileName, overwrite];
capability: File.Capability ← FileIO.CapabilityFromStream[stream];
IO.Close[stream]; -- need to close first or get 0 length file!
[dataLen, count] ← ToFileC[capability, node, start, flatten, textOnly]
};
ToFileC:
PUBLIC
PROC [file: File.Capability, node: TiogaNode.RefBranchNode, start: TiogaNode.Offset ← 0, flatten, textOnly:
BOOLEAN ←
FALSE]
RETURNS [dataLen, count: TiogaNode.Offset] = {
ropeToFile:
PROC [rope: RopeEdit.
ROPE] = {
RopeIO.ToFileC[file, rope, start]
};
opener:
PROC
RETURNS [ctrl, data: FileWriter.Ref] = {
[ctrl, data] ← FileWriter.OpenC[file, start]
};
[dataLen, count] ← FileIt[ropeToFile, opener, node, flatten, textOnly] ;
UpdateCreateDate[node, file]
};
UpdateCreateDate:
PROC [root: TiogaNode.RefBranchNode, file: File.Capability] =
TRUSTED {
createDate: System.GreenwichMeanTime;
prop: REF System.GreenwichMeanTime;
Directory.GetProperty[file: file, property: PropertyTypes.tCreateDate,
propertyValue: DESCRIPTOR[@createDate, SIZE[System.GreenwichMeanTime]]];
IF (prop ← NARROW[NodeProps.GetProp[root, $FileCreateDate]]) # NIL THEN prop^ ← createDate
ELSE NodeProps.PutProp[root, $FileCreateDate, NEW[System.GreenwichMeanTime ← createDate]]
};
FileIt:
PROC [ropeToFile:
PROC [RopeEdit.
ROPE], opener:
PROC
RETURNS [ctrl, data: FileWriter.Ref], node: TiogaNode.RefBranchNode, flatten, textOnly:
BOOLEAN]
RETURNS [dataLen, count: TiogaNode.Offset] =
TRUSTED {
ctrl, data: FileWriter.Ref;
rope: RopeEdit.ROPE;
simple: BOOLEAN;
priority: Process.Priority = Process.GetPriority[];
Process.SetPriority[Process.priorityBackground];
[rope, simple] ← SimpleFile[node];
IF simple
THEN {
ropeToFile[rope];
dataLen ← count ← Rope.Size[rope];
RETURN };
[ctrl, data] ← opener[];
OutputStructure[ctrl, data, node, flatten];
[dataLen, count, ] ← FileWriter.Close[ctrl, data, textOnly];
Process.SetPriority[priority]
};
SimpleFile:
PROC [root: TiogaNode.RefBranchNode]
RETURNS [rope: RopeEdit.
ROPE, simple:
BOOLEAN] = {
SimpleNode:
PROC [node: TiogaNode.RefBranchNode]
RETURNS [RopeEdit.
ROPE,
BOOLEAN] =
TRUSTED {
HasInterestingProp:
PROC
RETURNS [
BOOL] =
TRUSTED {
Check:
PROC [name:
ATOM, value:
REF]
RETURNS [
BOOLEAN] =
TRUSTED {
RETURN [
SELECT name
FROM
$Viewer, $FromTiogaFile, $DocumentLock, $FileCreateDate, $FileExtension => FALSE,
When add a new "system" property that should not go on files, add registration at end of TEditDocuments2Impl so will not copy/write the property.
ENDCASE => TRUE]
};
RETURN [NodeProps.MapProps[node, Check, FALSE, FALSE]]
};
IF node.format=TiogaNode.nullName
AND ~node.comment
AND ~HasInterestingProp[]
THEN
IF node.contents = NIL THEN RETURN [NIL, TRUE]
ELSE
WITH node.contents
SELECT
FROM
t:TiogaNode.RefTextNode =>
IF t.runs=NIL THEN RETURN [t.rope, TRUE]
ELSE
WITH r:t.runs
SELECT
FROM
base =>
IF r.length=1
AND r[0].looks=TiogaLooks.noLooks
THEN
RETURN [t.rope, TRUE];
ENDCASE;
ENDCASE;
RETURN [NIL, FALSE]
};
IF root=NIL THEN RETURN [NIL, TRUE];
[rope, simple] ← SimpleNode[root];
IF ~simple OR root.contents#NIL THEN RETURN[NIL, FALSE]; -- root must not have contents
root simple, but what about its child? NB rope must be NIL here
IF root.child=NIL THEN RETURN; -- simple root and no child
IF ~root.child.last
OR root.child.child #
NIL
THEN
RETURN [NIL, FALSE]; -- more than one child, so not simple
[rope, simple] ← SimpleNode[root.child]
};
OutputStructure:
PROC [ctrl, data: FileWriter.Ref, root: TiogaNode.RefBranchNode, flatten:
BOOLEAN] = {
CountLookBits:
PROC [lks: TiogaLooks.Looks]
RETURNS [cnt:
NAT] =
INLINE {
Count how many looks are set
cnt ← 0;
FOR c:
CHARACTER
IN TiogaLooks.Look
DO
IF lks[c] THEN cnt ← cnt+1; ENDLOOP
};
NoOfRuns:
PROCEDURE [runs:TiogaLooks.Runs, size:
INT]
RETURNS [n:
INT] =
INLINE {
Counts the number of runs in a run sequence
IF runs=NIL THEN RETURN [0];
[n, ,] ← TiogaLooksOps.CountRuns[runs, 0, size]
};
Output32:
PROC [len: TiogaNode.Offset, forwards:
BOOLEAN] = {
first, second, fourth: T2FileOps.LengthByte;
third: T2FileOps.ThirdByte;
lenBytes: T2FileOps.IntBytes ← LOOPHOLE[len];
IF lenBytes.fourth # 0
THEN {
fourth.data ← lenBytes.fourth;
first.others ← second.others ← third.others ← TRUE };
IF lenBytes.thirdTop # 0
OR lenBytes.thirdBottom # 0
THEN {
third.dataTop ← lenBytes.thirdTop;
third.dataBottom ← lenBytes.thirdBottom;
first.others ← second.others ← TRUE };
IF lenBytes.second # 0
THEN {
second.data ← lenBytes.second; first.others ← TRUE };
first.data ← lenBytes.first;
The bytes are in the right place now write them out in the appropriate order
IF forwards
THEN {
WriteChar[LOOPHOLE[first], ctrl];
IF first.others
THEN {
WriteChar[LOOPHOLE[second], ctrl];
IF second.others
THEN {
WriteChar[LOOPHOLE[third], ctrl];
IF third.others
THEN {
WriteChar[LOOPHOLE[fourth], ctrl] }}}
}
ELSE {
IF first.others
THEN {
IF second.others
THEN {
IF third.others THEN WriteChar[LOOPHOLE[fourth], ctrl];
WriteChar[LOOPHOLE[third], ctrl];
};
WriteChar[LOOPHOLE[second], ctrl];
};
WriteChar[LOOPHOLE[first], ctrl];
};
};
OutputAtom:
PROC [atom:
ATOM] =
INLINE {
Output an ATOM
OutputSymbolTableIndex[Atom.GetPName[atom]]
};
OutputB32:
PROCEDURE [len: TiogaNode.Offset] =
INLINE {
BACKWARD32 ::= 1..4 RECORD [more:BOOL, data:[0..127]]
Output32[len, FALSE];
};
OutputBranch:
PROCEDURE [branch:TiogaNode.RefBranchNode] = {
control ::= [branch | cheapBranch] ;
branch ::= optCmt {prop} optFormat {item} {child} {childHK} nchild ;
cheapBranch ::= NULL ;
A cheapBranch has no properties, format, children, comment or runs at either branch or item level in the structure. It is distinguished by the fact that it has no control information. If the data length is also zero then the branch is completely empty. If the data field is not empty, then the data forms the text of a default text item.
IsSimple:
PROCEDURE [branch:TiogaNode.RefBranchNode]
RETURNS [
BOOLEAN] = {
Only bog-standard terminal text nodes are simple
IF branch.comment THEN RETURN [FALSE];
IF branch.props#NIL THEN RETURN [FALSE];
IF branch.format#TiogaNode.nullName THEN RETURN [FALSE];
IF branch.child#NIL THEN RETURN [FALSE];
WITH branch.contents
SELECT
FROM
t:TiogaNode.RefTextNode => {
classInfo:TiogaItemClass.ItemClass ← TiogaNodeOps.FetchItemClass[t.class];
IF classInfo=NIL THEN ERROR;
IF ~t.last THEN RETURN [FALSE];
IF t.comment THEN RETURN [FALSE];
IF t.props#NIL THEN RETURN [FALSE];
IF t.format#TiogaNode.nullName THEN RETURN [FALSE];
IF classInfo.flavor#$Text THEN RETURN [FALSE];
IF t.runs#NIL THEN RETURN[FALSE];
RETURN[TRUE];
};
ENDCASE => RETURN [FALSE];
};
IF branch.externalRepValid
THEN {
If the external rep is still valid then just blatt out the orginal data and ctrl ropes unchanged
WriteRope:
PROC
[r: RopeEdit.ROPE, size: LONG INTEGER, writer: FileWriter.Ref, reader: RopeReader.Ref, start: LONG INTEGER𡤀] = {
WHILE size>0
DO
FileWriter.WriteRope[r, MIN[size, LAST[NAT]], writer, reader, start];
size ← size - LAST[NAT];
start ← start + LAST[NAT];
ENDLOOP};
brInfo:PutGet.SpanInfo ← NARROW[NARROW[NodeProps.GetProp[branch, $BranchInfo]]];
WriteRope[brInfo.externalRepRope, brInfo.charsLen, data, externRopeReader, brInfo.charsStart];
WriteRope[brInfo.externalRepRope, brInfo.ctrlLen, ctrl, externRopeReader, brInfo.ctrlStart];
}
ELSE {
IF branch.deleted THEN ERROR;
IF IsSimple[branch]
THEN {
terminal text branches simply just produce a the rope and no more
WITH branch.contents
SELECT
FROM
t:TiogaNode.RefTextNode =>
IF Rope.Size[t.rope]#0 THEN OutputRope[t.rope, data];
ENDCASE => ERROR; -- shouldn't happen for simple nodes
}
ELSE {
myCurrentBlock:OffsetBlockRef;
myNextFreeCell:INTEGER;
IF branch.comment
THEN
FileWriter.WriteChar[T2FileOps.comment, ctrl]; -- COMMENT
IF branch.props #
NIL
THEN {
node ← branch; -- make node available for property specs proc
[] ← NodeProps.MapProps[branch, OutputProperty, FALSE, FALSE] }; -- PROPERTIES
IF branch.format#TiogaNode.nullName
THEN
OutPutFormat[branch.format]; -- FORMAT
IF branch.contents #
NIL
THEN
OutputItemList[branch.contents]; -- CONTENTS
FileWriter.WriteChar[T2FileOps.lastItem, ctrl]; -- LAST ITEM
myCurrentBlock ← currentBlock; -- mark offset stream
myNextFreeCell ← nextFreeCell;
IF branch.child #
NIL
THEN
-- CHILDREN
FOR b:TiogaNode.RefBranchNode ← branch.child,
NARROW[b.next]
DO
SaveStreamOffsets[];
OutputBranch[b];
IF b.last THEN EXIT;
ENDLOOP;
OutputHK[myCurrentBlock, myNextFreeCell]; -- CHILD H.K.
currentBlock ← myCurrentBlock; -- reset offset stream to mark
nextFreeCell ← myNextFreeCell;
};
};
};
OutputContents:
PROCEDURE [c:TiogaNode.Ref] = {
contents ::= [ labelledBranch | item | basic ] ;
labelledBranch ::= startBranch dataL controlL branch
dataL ::= CONTROLINT ;
controlLength ::= CONTROLINT ;
basic ::= [basic | basicCmt ] ;
basic ::= startBI classAtom {prop} optFormat {contents} classData ;
basicCmt ::= startBICmt classAtom {prop} optFormat {contents} classData ;
OutputItemList[ref:c, contentMode:TRUE];
};
OutputControlRope:
PROC [r: RopeEdit.
ROPE] =
INLINE {
Write a rope onto the control stream preceeded by its length
OutputF32[Rope.Size[r]];
FileWriter.WriteRope[r, Rope.Size[r], ctrl, externRopeReader];
};
OutputCountRopeCR:
PROC [r: RopeEdit.
ROPE, writer: FileWriter.Ref] =
INLINE {
Output a rope onto a given stream, preceeded its length and followed by a CR
OutputF32[Rope.Size[r]];
OutputRope[r, writer];
};
OutputF32:
PROCEDURE [len: TiogaNode.Offset] =
INLINE {
FORWARD32 ::= 1..4 RECORD [more:BOOL, data:[0..127]]
Output32[len, TRUE];
};
OutPutFormat:
PROCEDURE [format:TiogaNode.Name] = {
optFormat ::= [(format symbolTableIndex) | NULL ] ;
WriteChar[T2FileOps.format, ctrl];
OutputSymbolTableIndex[NameSymbolTable.RopeFromName[format]];
};
OutputYUKBranch:
PROCEDURE [br:TiogaNode.RefBranchNode] = {
Output one of these bloody labelled branches
labelledBranch ::= startBranch dataL controlL branch
dataL ::= FORWARD32 ;
controlLength ::= FORWARD32 ;
startData:LONG CARDINAL;
saveCtrl:FileWriter.Ref ← ctrl; -- remember the control stream
dummyData:FileWriter.Ref;
controlRope:RopeEdit.ROPE;
controlRopeSize:LONG CARDINAL;
Change the control output to write to a rope. When done, discard any HK info., measure its length. Reconnect the control stream and write out the information.
startData ← data.blockCount*LONG[FileWriter.blockSize]+data.block.length;
[ctrl, dummyData] ← FileWriter.ToRope[]; -- puts two NULLS at ctrl stream head - damn it
OutputBranch[br]; -- BRANCH INFO
controlRopeSize ← (ctrl.blockCount*LONG[FileWriter.blockSize]+ctrl.block.length);
[ , , controlRope] ← FileWriter.Close[ctrl, dummyData, FALSE]; -- NB writes unreqd. junk
ctrl ← saveCtrl; -- reset control stream
WriteChar[T2FileOps.startBranch, ctrl]; -- LABELLED BRANCH TOKEN
OutputF32[(data.blockCount*LONG[FileWriter.blockSize]+data.block.length) - startData];
OutputControlRope[Rope.Substr[controlRope, 2, controlRopeSize-2]];
};
OutputItemList:
PROCEDURE [ref:TiogaNode.Ref, contentMode:
BOOLEAN←
FALSE] = {
item ::= [defaultTextItem | textItem | textItemHeavyDuty | listItem | boxItem] ;
IF ref#
NIL
THEN
DO
WITH ref
SELECT
FROM
t:TiogaNode.RefTextNode => OutputTI[t];
br:TiogaNode.RefBranchNode => OutputYUKBranch[br];
ENDCASE => OutputOther[ref, contentMode];
IF ref.last THEN RETURN
ELSE ref ← NARROW[ref.next];
ENDLOOP
};
OutputProperty:
PROC [name:
ATOM, value:
REF]
RETURNS [
BOOLEAN] = {
prop ::= prop propName specs -- as per Tioga 1
propName ::= symbolTableIndex ;
symbolTableIndex ::= FORWARD32 ;
specs ::= specsLength specsRope ;
specsLength ::= FORWARD32 ;
specsRope ::= {CHAR};
specs: RopeEdit.ROPE ← NodeProps.GetSpecs[name, value, node]; -- node set by caller
IF specs=NIL THEN RETURN [FALSE];
WriteChar[T2FileOps.prop, ctrl];
OutputAtom[name];
OutputControlRope[specs];
RETURN [FALSE]
};
OutputRope:
PROC [r: RopeEdit.
ROPE, writer: FileWriter.Ref] =
INLINE {
Output a rope to the given stream followed by a CR and preceeded by the rope's length
FileWriter.WriteRope[r, Rope.Size[r], writer, externRopeReader];
WriteChar[15C, writer]
};
OutputRuns:
PROCEDURE [runs:TiogaLooks.Runs, noOfRuns: TiogaNode.Offset]
RETURNS [loc:TiogaNode.Offset ← 0] = {
runs ::= noOfRuns {run} ;
noOfRuns ::= FORWARD32 ;
run ::= [lookSeq| noLooks] runLength ;
lookSeq ::= {addlooks} lastLooks
addlooks ::= BYTE [addLooksFirst..addLooksLast] ;
lastLooks ::= BYTE [lastLooksFirst..lastLooksLast] ;
runLength ::= FORWARD32 ;
cnt: TiogaNode.Offset ← 0;
RunReader.SetPosition[runReader, runs, 0];
** noOfRuns
OutputF32[noOfRuns];
** {run}
WHILE (cnt𡤌nt+1) <= noOfRuns
DO
-- Process each run descriptor
looks: TiogaLooks.Looks;
len: TiogaNode.Offset;
noOfLookBitsToProcess:INT;
lookIx:CARDINAL ← 0;
[len, looks] ← RunReader.MergedGet[runReader];
noOfLookBitsToProcess ← CountLookBits[looks];
IF noOfLookBitsToProcess>0
THEN {
-- ** lookSeq
** {addlooks}
WHILE noOfLookBitsToProcess>1
DO
UNTIL looks[lookIx+
FIRST[TiogaLooks.Look]]
DO
-- skip unset bits
lookIx ← lookIx + 1;
ENDLOOP;
WriteChar[T2FileOps.addLooksFirst+lookIx, ctrl];
noOfLookBitsToProcess ← noOfLookBitsToProcess - 1;
lookIx ← lookIx + 1; -- continue search with following bit
ENDLOOP;
** lastLooks
UNTIL looks[lookIx+
FIRST[TiogaLooks.Look]]
DO
-- skip unset bits
lookIx ← lookIx + 1;
ENDLOOP;
WriteChar[T2FileOps.lastLooksFirst+lookIx, ctrl];
}
ELSE
** noLooks
WriteChar[T2FileOps.noLooks, ctrl];
** runLength
OutputF32[len];
loc ← loc+len;
ENDLOOP;
};
OutputSymbolTableIndex:
PROCEDURE [rope:RopeEdit.
ROPE] =
INLINE {
Enter a rope into the symbol table and output its index
OutputControlRope[rope]; -- dummy writes rope rather tan ST index
};
OutputTI:
PROCEDURE [t:TiogaNode.RefTextNode] = {
defaultTextItem ::= [dtiFormat | dtiNoFormat];
These are text items without properties or contents but with class information = $TEXT?
dtiFormat ::= [dtiF | dtiCmtF | dtiRunsF | dtiCmtRunsF] ;
dtiNoFormat ::= [dti | dtiCmt | dtiRuns | dtiCmtRuns] ;
textItem ::= [tiFormat | tiNoFormat] ;
These are text items without propertiesor contents but with class information
tiFormat ::= [tiF | tiCmtF | tiRunsF | tiCmtRunsF]
tiNoFormat ::= [ti | tiCmt | tiRuns | tiCmtRuns]
textItemHeavyDuty ::= [tiHDFormat | tiHDNoFormat] ;
tiHDFormat ::= [tiHDF | tiCmtHDF | tiRunsHDF | tiCmtRunsHDF]
These are text items with class information and properties and/or contents
tiHDNoFormat ::= [tiHD | tiCmtHD | tiRunsHD | tiCmtRunsHD]
These are text items with class information and properties and/or contents
tiCmtRunsHD ::= startTICmtRunsHD {prop} noClassData classAtom runs textLength {CHAR} ;
HeavyDuty:
PROCEDURE []
RETURNS [
BOOLEAN] =
INLINE {
tests for properties or contents on an item
RETURN [t.props#NIL]
};
ropeSize: TiogaNode.Offset ← Rope.Size[t.rope];
noOfRuns: TiogaNode.Offset ← NoOfRuns[t.runs, ropeSize];
token:T2FileOps.Op ← T2FileOps.startTI; -- build item type token here
doFormat, doHeavyDuty, doRuns:BOOLEAN ← FALSE;
doClass:BOOLEAN ← TRUE;
classInfo: TiogaItemClass.ItemClass ← TiogaNodeOps.FetchItemClass[t.class];
Method: SCANNER inspects the node to determine what item token to emit and sets flags to steer the WRITER section
** SCANNER **
Base token is DefaultTextItem, TextItem or TextItemHeavyDuty
IF HeavyDuty[]
THEN {
token ← token + T2FileOps.heavyDuty;
doHeavyDuty ← TRUE;
};
IF classInfo.flavor=$Text
THEN {
doClass←FALSE;
token ← token + T2FileOps.default;
};
IF t.format#TiogaNode.nullName
THEN {
token ← token + T2FileOps.fmt;
doFormat ← TRUE;
};
IF noOfRuns #0
THEN {
doRuns ← TRUE;
token ← token + T2FileOps.runs;
};
IF t.comment
THEN
token ← token + T2FileOps.cmt;
** WRITER **
WriteChar[token, ctrl]; -- ITEM TOKEN
IF doHeavyDuty
THEN {
-- PROPERTIES and CONTENTS
node ← t; -- make node available for property specs proc
[] ← NodeProps.MapProps[t, OutputProperty, FALSE, FALSE];
WriteChar[T2FileOps.noClassData, ctrl]; -- property terminator
};
IF doClass
THEN
OutputAtom[classInfo.flavor]; -- CLASS ATOM
IF doRuns
THEN
-- RUNS
IF OutputRuns[t.runs, noOfRuns] # ropeSize
THEN
ERROR; -- sum of looks < rope length
IF doFormat
THEN
-- FORMAT
OutputSymbolTableIndex[NameSymbolTable.RopeFromName[t.format]];
OutputCountRopeCR[t.rope, IF t.comment THEN ctrl ELSE data]; -- TEXT
};
OutputOther:
PROCEDURE [t:TiogaNode.Ref, contentMode:
BOOLEAN] = {
doFormat, doHeavyDuty, doRuns:BOOLEAN ← FALSE;
doClass, doContents:BOOLEAN ← TRUE;
token:T2FileOps.Op; -- build item type token here
flavor: ATOM; -- save item flavor here to avoid second type discrimination
classData: RopeEdit.ROPE;
contents:TiogaNode.Ref;
Method: SCANNER inspects the node to determine what item token to emit and sets flags to steer the WRITER section
** SCANNER **
WITH t
SELECT
FROM
bs:TiogaNode.RefBasicNode => {
classInfo: TiogaBasicClass.BasicClass ← TiogaNodeOps.FetchBasicClass[bs.class];
IF ~contentMode THEN ERROR; -- basic node only allowed as contents
token ← T2FileOps.startBI;
IF bs.props#
NIL THEN {
token ← token + T2FileOps.heavyDuty;
doHeavyDuty ← TRUE;
};
IF (flavor ← classInfo.flavor) = $Basic
THEN {
doClass←FALSE;
token ← token + T2FileOps.default;
};
IF classInfo.get#
NIL
AND bs.data#
NIL THEN
classData ← NARROW[classInfo.get[bs, $Save]]; -- ELSE classData←NIL
doContents ← FALSE;
};
bx:TiogaNode.RefBoxNode => {
classInfo: TiogaItemClass.ItemClass ← TiogaNodeOps.FetchItemClass[bx.class];
token ← T2FileOps.startBX;
IF bx.contents#
NIL
OR bx.props#
NIL THEN {
token ← token + T2FileOps.heavyDuty;
doHeavyDuty ← TRUE;
};
IF (flavor ← classInfo.flavor) = $Box
THEN {
doClass←FALSE;
token ← token + T2FileOps.default;
};
IF classInfo.get#
NIL
AND bx.data#
NIL THEN
classData ← NARROW[classInfo.get[bx, $Save]]; -- ELSE classData←NIL
contents ← bx.contents;
};
li:TiogaNode.RefListNode => {
classInfo: TiogaItemClass.ItemClass ← TiogaNodeOps.FetchItemClass[li.class];
token ← T2FileOps.startLI;
IF li.contents#
NIL
OR li.props#
NIL THEN {
token ← token + T2FileOps.heavyDuty;
doHeavyDuty ← TRUE;
};
IF (flavor ← classInfo.flavor) = $List
THEN {
doClass←FALSE;
token ← token + T2FileOps.default;
};
IF classInfo.get#
NIL
AND li.data#
NIL THEN
classData ← NARROW[classInfo.get[li, $Save]]; -- ELSE classData←NIL
contents ← li.contents;
};
ENDCASE => ERROR;
IF t.format#TiogaNode.nullName
THEN {
token ← token + T2FileOps.fmt;
doFormat ← TRUE;
};
IF t.comment
THEN
token ← token + T2FileOps.cmt;
** WRITER **
WriteChar[token, ctrl]; -- ITEM TOKEN
IF doHeavyDuty
THEN {
-- PROPERTIES and CONTENTS
[] ← NodeProps.MapProps[t, OutputProperty, FALSE, FALSE];
IF doContents THEN OutputContents[contents]; -- basics have no conts.
};
output class data - mandatory
IF classData=
NIL
THEN
WriteChar[T2FileOps.noClassData, ctrl] -- TERMINATOR FOR CONTS
ELSE {
WriteChar[T2FileOps.startClassData, ctrl];
OutputControlRope[classData];
};
IF doClass
THEN
OutputAtom[flavor]; -- CLASS ATOM
IF doFormat
THEN
-- FORMAT
OutputSymbolTableIndex[NameSymbolTable.RopeFromName[t.format]];
};
WriteChar:
PROC [c:
CHARACTER, writer: FileWriter.Ref] =
INLINE {
FileWriter.WriteChar[c, writer]
};
-----------------------------------------------------
OFFSET STREAM MANAGEMENT
This section contains procedures for creating, writing and reading the offset stream. An offset stream is a linked list of blocks containing offsets - pairs of values of the form (ctrl stream offset, data stream offset). These values are used to compute the child node lengths which are output at the end of a branch.
NoOfPairs: CARDINAL = 63;
OffsetPair: TYPE = RECORD [c, d:LONG CARDINAL]; -- 8 bytes
OffsetBlockRef: TYPE = REF OffsetBlock;
OffsetBlock:
TYPE =
RECORD [
next, prev: OffsetBlockRef ← NIL, -- 8 bytes
pair: ARRAY [0..NoOfPairs) OF OffsetPair
];
offsetStreamHead: OffsetBlockRef ← NEW[OffsetBlock];
currentBlock: OffsetBlockRef ← offsetStreamHead;
nextFreeCell: INTEGER ← 0;
node: TiogaNode.Ref;
SaveStreamOffsets:
PROCEDURE [] = {
Get the current writer positions for the ctrl and data writers and save them on the offset stream. If last block of the stream is full, chain on another.
currentBlock.pair[nextFreeCell].c ← ctrl.blockCount*LONG[FileWriter.blockSize]+ctrl.block.length;
currentBlock.pair[nextFreeCell].d ← data.blockCount*LONG[FileWriter.blockSize]+data.block.length;
nextFreeCell ← nextFreeCell + 1;
IF nextFreeCell >= NoOfPairs
THEN {
IF currentBlock.next=
NIL
THEN {
currentBlock.next ← NEW[OffsetBlock];
currentBlock.next.prev ← currentBlock;
};
currentBlock ← currentBlock.next;
nextFreeCell ← 0;
};
};
OutputHK:
PROCEDURE [b: OffsetBlockRef, n:
INTEGER] = {
Output the information which describes where each child's text and control ropes start
nSibs: CARDINAL ← 0;
this: OffsetPair;
c: LONG CARDINAL ← ctrl.blockCount*LONG[FileWriter.blockSize]+ctrl.block.length;
d: LONG CARDINAL ← data.blockCount*LONG[FileWriter.blockSize]+data.block.length;
UNTIL currentBlock=b
AND nextFreeCell=n
DO
IF nextFreeCell = 0
THEN {
-- decrement pair pointer
currentBlock ← currentBlock.prev;
nextFreeCell ← NoOfPairs-1;
IF currentBlock=NIL THEN ERROR; -- unexpected end of chain
}
ELSE
nextFreeCell ← nextFreeCell - 1;
this ← currentBlock.pair[nextFreeCell];
OutputB32[c-this.c];
OutputB32[d-this.d];
c ← this.c; d ← this.d;
nSibs ← nSibs + 1;
ENDLOOP;
OutputB32[nSibs];
};
externRopeReader: RopeReader.Ref ← RopeReader.GetRopeReader[];
runReader: RunReader.Ref ← RunReader.GetRunReader[];
OutputBranch[root];
RunReader.FreeRunReader[runReader];
RopeReader.FreeRopeReader[externRopeReader];
WriteMesaFilePlain:
PUBLIC
PROC [fileName: RopeEdit.
ROPE, root: TiogaNode.RefBranchNode]={
h: IO.Handle ← FileIO.Open[fileName: fileName, accessOptions: overwrite];
WritePlain[h, root, TRUE];
IO.Close[h]
};
WriteFilePlain:
PUBLIC
PROC [fileName: RopeEdit.
ROPE, root: TiogaNode.RefBranchNode] = {
h: IO.Handle ← FileIO.Open[fileName: fileName, accessOptions: overwrite];
WritePlain[h, root];
IO.Close[h]
};
WriteFileCPlain:
PUBLIC
PROC [file: File.Capability, root: TiogaNode.RefBranchNode] = {
h: IO.Handle ← FileIO.StreamFromCapability[file];
WritePlain[h, root];
IO.Close[h]
};
WriteRopePlain:
PUBLIC
PROC [root: TiogaNode.RefBranchNode]
RETURNS [output: RopeEdit.
ROPE] = {
h: IO.Handle ← IO.CreateOutputStreamToRope[];
WritePlain[h, root];
RETURN [IO.GetOutputStreamRope[h]]
};
WritePlain:
PROC [h:
IO.Handle, root: TiogaNode.RefBranchNode, restoreDashes:
BOOL ←
FALSE] = {
HasInitialDashes:
PROC [r: RopeEdit.
ROPE]
RETURNS [
BOOL] = {
loc: INT ← 0;
size: INT = Rope.Size[r];
c: CHAR;
WHILE loc < size
AND RopeEdit.BlankChar[c ← Rope.Fetch[r, loc]]
DO
loc ← loc+1; ENDLOOP;
IF loc > size OR c # '- OR Rope.Fetch[r, loc+1] # '- THEN RETURN [FALSE];
RETURN [TRUE]
};
br: TiogaNode.RefBranchNode ← root;
node: TiogaNode.Ref;
level: INTEGER ← 0;
levelDelta: INTEGER;
first: BOOL ← TRUE;
DO
firstItem: BOOL ← TRUE;
[br, levelDelta] ← TiogaNodeOps.Forward[br];
IF br=NIL THEN EXIT;
IF first THEN first ← FALSE
ELSE IO.PutChar[h, '\n]; -- carriage returns between nodes
level ← level+levelDelta;
IF (node ← TiogaNodeOps.BranchContents[br])=NIL THEN LOOP;
THROUGH [1..level) DO IO.PutChar[h, '\t]; ENDLOOP; -- output level-1 tabs
DO
-- output the contents of the node
text: TiogaNode.RefTextNode;
IF (text ← TiogaNodeOps.NarrowToTextNode[node]) #
NIL
THEN {
IF firstItem
AND restoreDashes
AND text.comment
AND ~HasInitialDashes[text.rope]
THEN
IO.PutRope[h, "-- "]; -- restore the leading dashes for Mesa comments
IO.PutRope[h, text.rope] };
firstItem ← FALSE;
IF node.last AND node.next=br THEN EXIT; -- finished with the branch contents
node ← TiogaNodeOps.StepForwardNode[node];
ENDLOOP;
ENDLOOP;
{ ENABLE IO.Error => IF ec = NotImplementedForThisStream THEN GOTO Exit;
IO.SetLength[h, IO.GetIndex[h]] }
EXITS Exit => RETURN
};
END.