DIRECTORY
FileOps,
FileWriter,
FS,
IO,
MonitoredQueue,
PrincOpsUtils,
Rope,
RopeReader;

FileWriterImpl: CEDAR MONITOR
IMPORTS IO, FS, MonitoredQueue, PrincOpsUtils, Rope
EXPORTS FileWriter
= BEGIN OPEN FileWriter;

ROPE: TYPE = Rope.ROPE;

minBlt: NAT ~ 16;

StringPointer: PROC[ref: REF READONLY TEXT]
RETURNS[LONG POINTER] = TRUSTED INLINE {
RETURN[LOOPHOLE[ref, LONG POINTER]+SIZE[TEXT[0]]];
};

StringToStringBlt: PROC [
from: REF READONLY TEXT, fromLoc: NAT,
to: REF TEXT, toLoc: NAT,
nChars: NAT] = {
nBlt: NAT ~ (IF nChars>minBlt THEN nChars-1 ELSE 0);
IF nChars=0 THEN RETURN;
FOR i: NAT IN[nBlt..nChars) DO to[toLoc+i] _ from[fromLoc+i] ENDLOOP;
IF nBlt#0 THEN TRUSTED { [] _ PrincOpsUtils.ByteBlt[
to: [blockPointer: StringPointer[to],
startIndex: toLoc, stopIndexPlusOne: toLoc+nBlt],
from: [blockPointer: StringPointer[from],
startIndex: fromLoc, stopIndexPlusOne: fromLoc+nBlt]
];
};
};

OpenC: PUBLIC PROC
[capability: FS.OpenFile, start: INT _ 0, makeControl: BOOL _ TRUE]
RETURNS [control,comment,data: Ref] = {
stream: IO.STREAM = FS.StreamFromOpenFile[capability, $write];
IO.SetLength[stream,start];
IO.SetIndex[stream,start];
[control,comment,data] _ FinishOpen[stream,FALSE,makeControl,TRUE];
};

ToRope: PUBLIC PROC [makeControl: BOOL _ TRUE]
RETURNS [control,comment,data: Ref] = {
[control,comment,data] _ FinishOpen[NIL,TRUE,makeControl,FALSE];
};

ToStream: PUBLIC PROC [stream: IO.STREAM, makeControl: BOOL _ TRUE]
RETURNS [control,comment,data: Ref] = {
[control,comment,data] _ FinishOpen[stream,FALSE,makeControl,FALSE];
};

WriteChar: PUBLIC PROC [c: CHAR, writer: Ref] = {
loc: NAT;
block: REF TEXT _ writer.block;
IF (loc_block.length) >= blockSize THEN -- buffer is full
{ block _ BumpWriter[writer]; loc _ 0 };
block[loc] _ c; block.length _ loc+1;
};

WriteRope: PUBLIC PROC [r: ROPE, size: INT, writer: Ref, reader: RopeReader.Ref] = {
cnt: NAT;
block: REF TEXT _ writer.block;
pos: INT _ 0;
UNTIL size=0 DO
IF block.length >= blockSize THEN -- buffer is full
block _ BumpWriter[writer];
cnt _ Rope.AppendChars[buffer: block, rope: r, start: pos];
pos _ pos + cnt;
size _ size-cnt;
ENDLOOP;
};

WriteText: PUBLIC PROC [txt: REF READONLY TEXT, writer: Ref] = {
cnt, loc, txtLoc: NAT;
size: NAT _ txt.length;
block: REF TEXT _ writer.block;
txtLoc _ 0;
UNTIL size=0 DO
IF (loc_block.length) >= blockSize THEN -- buffer is full
{ block _ BumpWriter[writer]; loc _ block.length };
cnt _ MIN[blockSize-loc,size];
StringToStringBlt[txt,txtLoc,block,loc,cnt];
size _ size-cnt; txtLoc _ txtLoc+cnt; block.length _ loc+cnt;
ENDLOOP;
};

FinishOpen: PROC
[stream: IO.STREAM, toRope: BOOL _ FALSE, makeControl, closeStream: BOOL _ TRUE]
RETURNS [control,comment,data: Ref] = {
MakeOne: PROC [kind: OfWriter] RETURNS [writer: Ref] = {
writer _ GetFileWriter[];
writer.kind _ kind;
writer.block _ GetBLOCK[];
writer.stream _ stream;
writer.toRope _ toRope;
writer.closeStream _ closeStream };
IF makeControl THEN { -- make comment and control writers
control _ MakeOne[control];
FOR i:NAT IN [0..FileOps.fileIdSize) DO
WriteChar[FileOps.controlHeaderId[i],control]; ENDLOOP;
THROUGH [0..3] DO WriteChar[0C,control]; ENDLOOP; -- for length
comment _ MakeOne[comment];
FOR i:NAT IN [0..FileOps.fileIdSize) DO
WriteChar[FileOps.commentHeaderId[i],comment]; ENDLOOP;
THROUGH [0..3] DO WriteChar[0C,comment]; ENDLOOP; -- for length
};
data _ MakeOne[data];
IF ~toRope THEN { -- fork process to write data as it is produced
data.blockQueue _ GetMQ[];
data.consumer _ FORK Consumer[data];
};
};

q1, q2: MonitoredQueue.MQ;

GetMQ: ENTRY PROC RETURNS [q: MonitoredQueue.MQ] = {
ENABLE UNWIND => NULL;
IF q1 # NIL THEN { q _ q1; q1 _ NIL }
ELSE IF q2 # NIL THEN { q _ q2; q2 _ NIL }
ELSE q _ MonitoredQueue.Create[];
};

FreeMQ: ENTRY PROC [q: MonitoredQueue.MQ] = {
ENABLE UNWIND => NULL;
IF q=NIL THEN RETURN;
MonitoredQueue.Reset[q];
IF q1 = NIL THEN q1 _ q
ELSE IF q2 = NIL THEN q2 _ q;
};

fw1, fw2: Ref;

GetFileWriter: ENTRY PROC RETURNS [fw: Ref] = {
ENABLE UNWIND => NULL;
IF fw1 # NIL THEN { fw _ fw1; fw1 _ NIL }
ELSE IF fw2 # NIL THEN { fw _ fw2; fw2 _ NIL }
ELSE fw _ NEW[FileWriterBody];
IF fw.kind # unused THEN ERROR;
};

FreeFileWriter: ENTRY PROC [fw: Ref] = {
ENABLE UNWIND => NULL;
fw.block _ NIL;
fw.blockList _ NIL;
fw.blockQueue _ NIL;
fw.blockCount _ 0;
fw.stream _ NIL;
fw.kind _ unused;
IF fw1 = NIL THEN fw1 _ fw
ELSE IF fw2 = NIL THEN fw2 _ fw;
};

blks: NAT = 8;
BlockArray: TYPE = ARRAY [0..blks) OF REF TEXT;
blocks: REF BlockArray _ NEW[BlockArray];

GetBLOCK: ENTRY PROC RETURNS [b: REF TEXT] = {
ENABLE UNWIND => NULL;
FOR i:NAT IN [0..blks) DO
IF blocks[i] # NIL THEN { b _ blocks[i]; blocks[i] _ NIL; EXIT };
ENDLOOP;
IF b=NIL THEN b _ NEW[TEXT[blockSize]];
b.length _ 0;
};

FreeBLOCK: ENTRY PROC [b: REF TEXT] = {
ENABLE UNWIND => NULL;
FOR i:NAT IN [0..blks) DO
IF blocks[i] = NIL THEN { blocks[i] _ b; RETURN };
ENDLOOP;
};

BumpWriter: PUBLIC PROC [writer: Ref] RETURNS [block: REF TEXT] = {
writer.blockCount _ writer.blockCount+1; -- number added to queue/list
IF writer.kind=data AND ~writer.toRope THEN MonitoredQueue.Add[writer.block, writer.blockQueue]
ELSE writer.blockList _ NEW[BlockListBody _ [writer.block, writer.blockList]];
writer.block _ block _ GetBLOCK[];
};

Consumer: PROC [data: Ref] = { OPEN MonitoredQueue;
queue: MQ _ data.blockQueue;
stream: IO.STREAM _ data.stream;
DO x: REF ANY _ Remove[queue ! EndOfQueue => EXIT];
WITH x SELECT FROM
xx: REF TEXT => { IO.PutBlock[stream,xx]; FreeBLOCK[xx] };
ENDCASE => ERROR;
ENDLOOP;
};

Close: PUBLIC PROC [control,comment,data: Ref, textOnly: BOOL]
RETURNS [dataLen, count: INT, output: ROPE] = {
deltaBytes: PACKED ARRAY [0..3] OF CHAR; 
commentStart, commentLen, controlLen: INT _ 0;
stream: IO.STREAM _ data.stream;
len, controlBlocks, commentBlocks, dataBlocks: NAT _ 0;
toRope: BOOL _ data.toRope;
controlList,commentList,dataList: BlockList;
controlBlock,commentBlock,dataBlock: REF TEXT;

Reverse: PROC [lst: BlockList] RETURNS [prev: BlockList] = {
next: BlockList;
UNTIL lst=NIL DO
next _ lst.next; lst.next _ prev; prev _ lst; lst _ next; ENDLOOP };

LastBlock: PROC [lst: BlockList] RETURNS [block: REF TEXT] = {
FOR l: BlockList _ lst, l.next DO
IF l.next=NIL THEN RETURN [l.block];
ENDLOOP };

MakeRope: PROC [first, num: NAT] RETURNS [ROPE] = {
half: NAT;
SELECT num FROM
0 => RETURN [NIL];
1 => RETURN [Rope.FromRefText[GetChars[first]]];
ENDCASE;
half _ num/2;
RETURN [Rope.Concat[MakeRope[first,half],MakeRope[first+half,num-half]]] };

FinishWriter: PROC [writer: Ref] RETURNS [list: BlockList, block: REF TEXT] = {
list _ Reverse[writer.blockList]; block _ writer.block; FreeFileWriter[writer] };

GetChars: PROC [num: NAT] RETURNS [chars: REF TEXT] = {
GetIt: PROC [blocks: NAT, list: BlockList, block: REF TEXT]
RETURNS [ok: BOOL] = {
IF num NOT IN [0..blocks) THEN RETURN [FALSE];
FOR lst: BlockList _ list, lst.next UNTIL lst=NIL DO
IF num = 0 THEN { chars _ lst.block; RETURN [TRUE] };
num _ num-1; ENDLOOP;
IF num = 0 THEN { chars _ block; RETURN [TRUE] };
ERROR };
IF GetIt[dataBlocks,dataList,dataBlock] THEN RETURN [chars];
num _ num-dataBlocks;
IF GetIt[commentBlocks,commentList,commentBlock] THEN RETURN [chars];
num _ num-commentBlocks;
IF GetIt[controlBlocks,controlList,controlBlock] THEN RETURN [chars];
ERROR };

dataBlocks _ data.blockCount;
commentStart _ dataBlocks*LONG[blockSize];
IF (len_data.block.length) MOD 2 = 1 THEN { WriteChar[0C,data]; len _ len+1 };
commentStart _ commentStart+len;
dataBlocks _ dataBlocks+1;

IF control # NIL THEN {

IF ~textOnly THEN {
chars: REF TEXT;

WriteControlInt: PROC [int: INT] = {
deltaBytes _ LOOPHOLE[int];
FOR i:NAT IN [0..3] DO
WriteChar[deltaBytes[i],control];
ENDLOOP };

Check: PROC [writer: Ref, kind: OfWriter] = {
IF writer.kind # kind THEN ERROR;
IF writer.toRope # toRope THEN ERROR;
IF writer.closeStream # data.closeStream THEN ERROR;
IF writer.stream # data.stream THEN ERROR };

Count: PROC [list: BlockList, writer: Ref, extra: INT _ 0]
RETURNS [blocks: NAT, len: INT] = {
blocks _ writer.blockCount;
len _ LONG[blocks]*blockSize+writer.block.length+extra;
blocks _ blocks+1;
deltaBytes _ LOOPHOLE[len];
chars _ IF list=NIL THEN writer.block ELSE LastBlock[list];
FOR i:NAT IN [0..3] DO chars[FileOps.fileIdSize+i] _ deltaBytes[i]; ENDLOOP };

Check[comment,comment];
Check[control,control];


FOR i:NAT IN [0..FileOps.fileIdSize) DO -- write end trailer
WriteChar[FileOps.controlTrailerId[i],control]; ENDLOOP;

WriteControlInt[0]; -- <file-props-length> 
WriteControlInt[commentStart];

IF comment.block.length MOD 2 = 1 THEN WriteChar[0C,comment]; -- fill word

[commentBlocks,commentLen] _ Count[comment.blockList,comment];
[controlBlocks,controlLen] _ Count[control.blockList,control,4]; -- add 4 for final file length

WriteControlInt[commentStart+commentLen+controlLen];
};

[controlList,controlBlock] _ FinishWriter[control];
[commentList,commentBlock] _ FinishWriter[comment] };

IF data.kind # data THEN ERROR;
dataBlock _ data.block;
IF toRope THEN {
dataList _ Reverse[data.blockList];
output _ MakeRope[0,dataBlocks+commentBlocks+controlBlocks] } -- return a balanced rope
ELSE {
MonitoredQueue.Close[data.blockQueue];
TRUSTED {JOIN data.consumer};
FreeMQ[data.blockQueue];
IO.PutBlock[stream,dataBlock];
FreeBLOCK[dataBlock];
IF control # NIL THEN {
DoBlocks: PROC [list: BlockList, block: REF TEXT] = {
FOR lst:BlockList _ list, lst.next UNTIL lst=NIL DO
IF ~textOnly THEN IO.PutBlock[stream,lst.block];
FreeBLOCK[lst.block];
ENDLOOP;
IF ~textOnly THEN IO.PutBlock[stream,block];
FreeBLOCK[block] };
DoBlocks[commentList,commentBlock];
DoBlocks[controlList,controlBlock] }};
count _ commentStart+commentLen+controlLen;
dataLen _ commentStart;
IF data.closeStream THEN IO.Close[stream];
FreeFileWriter[data];
};

END.


ΈFileWriterImpl.mesa
Copyright c 1985 by Xerox Corporation.  All rights reserved.
written by Paxton.  March 1981
McGregor. September 10, 1982 1:15 pm
Maxwell, January 5, 1983 12:50 pm
Russ Atkinson, September 26, 1983 1:17 pm
Plass, March 1, 1985 5:43:21 pm PST
Doug Wyatt, March 3, 1985 4:36:49 pm PST
always transfer the last byte with an assignment, to get the bounds check
-- this is the place to write out the file props, if any
Κž˜
codeš
œ™Kšœ
Οm
œ1™<Kš
œ™Kš
œ$™$K™!K™)K™#K™(K˜—š
Οk	˜	Kš
œ˜Kš
œ˜Kšžœ
˜Kšžœ
˜K˜K˜K˜K˜—K˜KšΠblœžœ
ž˜Kšžœ
žœžœ%˜3Kšžœ˜Kšœžœ
žœ˜K˜Kšžœžœžœ
˜K˜šœžœ˜K˜—š
Οn
œžœžœ
žœ
žœ
˜+Kš
žœ
žœ
žœžœ
žœ˜(Kšžœ
žœžœ
žœžœ
žœ˜2K˜K˜—š œžœ˜Kš	œžœ
žœ
žœžœ
˜&Kšœžœ
žœ	žœ
˜Kšœžœ˜Kš	œžœžœžœ
žœ˜4Kšžœ
žœ
žœ
˜š
žœžœ
žœžœžœ
˜EK™I—šžœžœ
žœ˜4š
œ%˜%Kš
œ1˜1—š
œ)˜)Kš
œ4˜4—Kš
œ˜Kš
œ˜—K˜K˜—š œžœ
ž˜Kš	œ
žœžœžœžœ
˜CKšžœ ˜'Kšœžœ
žœžœ(˜>Kšžœ˜Kšžœ˜Kšœ+žœ
žœ˜CKš
œ˜K˜—š
 œžœ
žœžœžœ
˜.Kšžœ ˜'Kšœ$žœ
žœ
žœ˜@Kš
œ˜K˜—š œžœ
žœ
žœ
žœžœžœ
˜Cšžœ ˜'Kšœ+žœ
žœ˜D—š
œ˜K˜——š 	œžœ
žœžœ˜1Kšœžœ
˜	Kšœžœ
žœ˜šžœ!žœ
Οc˜9K˜(—K˜%K˜K˜—š
 	œžœ
žœžœžœ*˜TKšœžœ
˜	Kšœžœ
žœ˜Kšœžœ˜
šžœž˜šžœžœ
‘˜3K˜—Kš
œ;˜;Kš
œ˜K˜Kšžœ
˜—Kš
œ˜K˜—š 	œžœ
žœžœ
žœ
žœ˜@Kšœžœ
˜Kšœžœ˜Kšœžœ
žœ˜K˜šžœž˜šžœ!žœ
‘˜9K˜3—Kšœžœ˜K˜,K˜=Kšžœ
˜—š
œ˜K˜——š 
œž˜Kš
œ	žœ
žœ
žœžœžœžœ
˜PKšžœ ˜'š œžœžœ˜8K˜K˜K˜K˜K˜Kš
œ#˜#—šžœ
žœ‘#˜9K˜šžœžœ
žœž˜'Kšœ/žœ
˜7—Kšžœžœžœ‘
˜?K˜šžœžœ
žœž˜'Kšœ/žœ
˜7—šžœžœžœ‘
˜?K˜——K˜šžœ	žœ‘/˜AK˜Kšœžœ˜$Kš
œ˜Kš
œ˜K˜——Kšœžœ
˜K˜š
 œžœ
žœ
žœžœ˜4Kšžœ
žœžœ
˜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˜—Kšœžœ˜Kšœžœžœžœ
žœ
žœ
˜/Kšœžœžœ
˜)K˜š œžœ
žœ
žœžœ
žœ˜.Kšžœ
žœžœ
˜šžœžœ
žœž˜Kš
žœ
žœ
žœžœžœ˜AKšžœ
˜—Kš
žœžœ
žœžœ
žœ
˜'K˜
K˜K˜—š
 	œžœ
žœžœ
žœ˜'Kšžœ
žœžœ
˜šžœžœ
žœž˜Kšžœ
žœ
žœžœ˜2Kšžœ
˜Kš
œ˜K˜——š 
œžœ
žœžœ	žœ
žœ˜CKšœ)‘˜FKšžœžœžœ4˜_Kšžœžœ3˜NK˜"K˜K˜—š œžœžœ˜3Kšœžœ˜Kšœžœ
žœ˜ šžœžœ
žœ žœ˜3Kšžœžœ
ž˜Kšœžœ
žœžœ&˜:Kšžœžœ
˜Kšžœ
˜Kš
œ˜K˜——š œžœ
žœ'žœ
˜>Kšžœžœ
žœ˜/Kš	œžœ
žœžœ
žœ˜)Kšœ&žœ˜.Kšœžœ
žœ˜ Kšœ/žœ˜7Kšœžœ˜K˜,Kšœ%žœ
žœ
˜.K˜š œžœžœ˜<K˜šžœžœ
ž˜Kšœ:žœ˜DK˜——š
 	œžœžœ	žœ
žœ˜>šžœž˜!Kšžœžœ
žœ
žœ˜$Kšžœ˜
K˜——š
 œžœžœžœžœ˜3Kšœžœ
˜
šžœž˜Kšœžœžœ˜Kšœžœ%˜0Kšžœ
˜—K˜
KšžœE˜KK˜—š
 œžœžœžœ
žœ˜OK˜QK˜—š œžœžœžœ	žœ
žœ˜7š
 œžœ
žœžœ
žœ
˜;Kšžœžœ˜Kšžœžœ
žœ
žœ
žœžœ˜.šžœ!žœžœ
ž˜4Kšžœ	žœžœžœ˜5Kšœ
žœ
˜—Kšžœ	žœžœžœ˜1Kšžœ˜—Kšžœ&žœ
žœ	˜<K˜Kšžœ/žœ
žœ	˜EK˜Kšžœ/žœ
žœ	˜EKšžœ˜K˜—K˜Kšœžœ˜*Kšžœžœžœ%˜NK˜ K˜K˜Kšžœžœ
žœ˜˜šžœžœ˜Kšœžœ
žœ
˜K˜š œžœžœ˜$Kšœ
žœ˜šžœžœ
žœž˜K˜!Kšžœ˜
K˜——š œžœ"˜-Kšžœžœ
žœ
˜!Kšžœžœ
žœ
˜%Kšžœ'žœ
žœ
˜4Kšžœžœ
žœ˜,K˜—š œžœ'žœ˜:Kšžœ
žœžœ˜#K˜Kšœžœ-˜7K˜Kšœ
žœ˜Kš	œžœžœ
žœžœ˜;Kš
žœžœ
žœžœ.žœ˜NK˜—K˜K˜K˜Kš
œ8™8K˜š	žœžœ
žœžœ
‘˜<Kšœ0žœ
˜8K˜—Kšœ‘˜+K˜K˜Kšžœžœžœ‘˜JK˜K˜>KšœA‘˜_K˜K˜4K˜K˜—K˜3K˜5K˜—Kšžœžœ
žœ
˜K˜šžœžœ˜K˜#Kšœ>‘˜W—šžœ˜K˜&Kšžœžœ˜K˜Kšžœ˜K˜šžœžœ
žœ˜š œžœžœ
žœ˜5šžœ žœžœ
ž˜3Kšžœžœ
žœ˜0K˜Kšžœ
˜—Kšžœžœ
žœ˜,K˜—K˜#K˜&——K˜+K˜Kšžœžœ
žœ˜*K˜K˜K˜—Kšžœ
˜K˜—…—&6r