CompiledViewImpl.mesa
Copyright Ó 1990, 1991, 1992 by Xerox Corporation. All rights reserved.
Michael Plass, April 13, 1992 1:35 pm PDT
DIRECTORY Atom, Basics, BasicTime, Commander, CommanderOps, Convert, IO, List, PFS, PFSBackdoor, PFSClass, PFSNames, Process, ProcessProps, RefText, Rope, SymTab, UXStrings;
CompiledViewImpl: CEDAR PROGRAM
IMPORTS Atom, Basics, BasicTime, Commander, CommanderOps, Convert, IO, List, PFS, PFSBackdoor, PFSClass, PFSNames, Process, ProcessProps, RefText, Rope, SymTab, UXStrings
~ BEGIN
Types
CString: TYPE ~ POINTER TO Basics.RawChars;
ROPE: TYPE ~ Rope.ROPE;
PATH: TYPE ~ PFSNames.PATH;
FSHandle: TYPE ~ PFSClass.FSHandle;
UniqueID: TYPE ~ PFS.UniqueID;
OpenFile: TYPE ~ PFSClass.OpenFile;
Data: TYPE ~ REF DataRep;
DataRep: TYPE ~ RECORD [
nBytes: NAT,
uniqueID: PFS.UniqueID,
base: LONG POINTER TO Basics.RawBytes,
ref: REF ¬ NIL
];
Debugging
debug: BOOL ~ FALSE;
DebugPrint: PROC [what: ROPE, ref: REF] ~ {
WITH ProcessProps.GetProp[$ErrOut] SELECT FROM
stream: IO.STREAM => {
IO.PutRope[stream, what];
IO.PutRope[stream, ": "];
WITH ref SELECT FROM
text: REF TEXT => IO.PutBlock[stream, text];
rope: ROPE => IO.PutRope[stream, Convert.RopeFromRope[rope]];
path: PATH => IO.PutRope[stream, PFS.RopeFromPath[path]];
tab: SymTab.Ref => {
EachPair: SymTab.EachPairAction ~ {
IO.PutRope[stream, " "];
DebugPrint[key, val];
IO.PutRope[stream, " "];
};
IO.PutRope[stream, "["];
[] ¬ SymTab.Pairs[tab, EachPair];
IO.PutRope[stream, "]"];
};
ENDCASE => IO.Put1[stream, [refAny[ref]]];
};
ENDCASE;
};
Semantics
NotApplicable: PROC [what: ROPE] ~ {
PFSBackdoor.ProduceError[code: notImplemented, explanation: Rope.Concat[what, " not implemented for -compiled: view."]]
};
NameToData: PROC [h: FSHandle, fileName: ROPE] RETURNS [Data] ~ {
IF debug THEN DebugPrint["\nNameToData.h", h];
IF debug THEN DebugPrint["\nNameToData.h.data", h.data];
IF debug THEN DebugPrint["\nNameToData.fileName", fileName];
RETURN [NARROW[SymTab.Fetch[NARROW[h.data], fileName].val]]
};
StoreData: PROC [h: FSHandle, shortName: ROPE, val: Data] RETURNS [BOOL] ~ {
RETURN [SymTab.Store[NARROW[h.data], shortName, val]];
};
Class procs
compiledFlavor: ATOM ~ $compiled;
CompiledMaintenanceProcs: PFSClass.MaintenanceProcs ~ NEW[PFSClass.MaintenanceProcsObject ¬ [
sweep: CompiledSweep,
validate: CompiledValidate
]];
CompiledSweep: PFSClass.SweepProc ~ {
PROC [h: FSHandle, seconds: CARD]
};
me: REF TEXT ~ "CompiledViewImpl";
CompiledValidate: PFSClass.ValidateProc ~ {
PROC [h: FSHandle] RETURNS [obsolete: BOOL, downMsg: ROPE]
last: REF ~ Atom.GetProp[$CompiledViewImpl, $LastRegistered];
RETURN [obsolete: last # NIL AND last # me, downMsg: NIL]
};
CompiledFileManipulationProcs: PFSClass.FileManipulationProcs ~ NEW[PFSClass.FileManipulationProcsObject ¬ [
delete: CompiledDelete,
enumerateForInfo: CompiledEnumerateForInfo,
enumerateForNames: CompiledEnumerateForNames,
fileInfo: CompiledFileInfo,
lookupName: CompiledLookupName,
rename: CompiledRename,
copy: CompiledCopy,
setAttributes: CompiledSetAttributes,
setByteCountAndUniqueID: CompiledSetByteCountAndUniqueID,
setClientProperty: CompiledSetClientProperty,
getClientProperty: CompiledGetClientProperty,
enumerateClientProperties: CompiledEnumerateClientProperties,
read: CompiledRead,
write: CompiledWrite,
open: CompiledOpen,
close: CompiledClose,
store: CompiledStore,
retrieve: CompiledRetrieve,
attach: CompiledAttach,
getInfo: CompiledGetInfo,
pfsNameToUnixName: CompiledPFSNameToUnixName,
caseSensitive: CompiledCaseSensitive
]];
CompiledDelete: PFSClass.DeleteProc ~ {
PROC [h: FSHandle, file: PATH, wantedUniqueID: UniqueID, proc: PFS.NameConfirmProc]
NotApplicable["Delete"];
};
GetNames: PROC [h: FSHandle, pattern: PATH] RETURNS [LIST OF REF --ROPE--] ~ {
patternSans: PATH ~ IF PFSNames.ShortName[pattern].version.versionKind = numeric THEN pattern ELSE PFSNames.StripVersionNumber[pattern];
pat: ROPE ~ PFS.RopeFromPath[patternSans];
tab: SymTab.Ref ~ NARROW[h.data];
list: LIST OF REF ¬ NIL;
EachPair: SymTab.EachPairAction ~ {
PROC [key: Key, val: Val] RETURNS [quit: BOOLFALSE]
IF Rope.Match[pattern: pat, object: key, case: FALSE] THEN { list ¬ CONS[key, list] };
};
[] ¬ SymTab.Pairs[tab, EachPair];
list ¬ List.Sort[list];
RETURN [list]
};
CompiledEnumerateForInfo: PFSClass.EnumerateForInfoProc ~ {
PROC [h: FSHandle, pattern: PATH, proc: PFS.InfoProc, lbound: PATH, hbound: PATH]
tab: SymTab.Ref ~ NARROW[h.data];
list: LIST OF REF ~ GetNames[h, pattern];
FOR tail: LIST OF REF ¬ list, tail.rest UNTIL tail = NIL DO
key: ROPE ~ NARROW[tail.first];
data: Data ~ NARROW[SymTab.Fetch[tab, key].val];
IF NOT proc[fullFName: PFS.PathFromRope[key], attachedTo: NIL, uniqueID: data.uniqueID, bytes: data.nBytes, mutability: immutable, fileType: PFS.tUnspecified].continue THEN EXIT;
ENDLOOP;
};
CompiledEnumerateForNames: PFSClass.EnumerateForNamesProc ~ {
PROC [h: FSHandle, pattern: PATH, proc: PFS.NameProc, lbound: PATH, hbound: PATH]
tab: SymTab.Ref ~ NARROW[h.data];
list: LIST OF REF ~ GetNames[h, pattern];
FOR tail: LIST OF REF ¬ list, tail.rest UNTIL tail = NIL DO
key: ROPE ~ NARROW[tail.first];
data: Data ~ NARROW[SymTab.Fetch[tab, key].val];
IF NOT proc[PFS.PathFromRope[key]].continue THEN EXIT;
ENDLOOP;
};
CompiledFileInfo: PFSClass.FileInfoProc ~ {
PROC [h: FSHandle, file: PATH, wantedUniqueID: UniqueID] RETURNS [version: Version, attachedTo: PATH, bytes: INT, uniqueID: UniqueID, mutability: PFS.Mutability, fileType: PFS.FileType]
data: Data ¬ NameToData[h, PFS.RopeFromPath[file]];
IF data = NIL THEN PFSBackdoor.ProduceError[unknownFile, Rope.Concat[PFS.RopeFromPath[file], " not found."], file];
RETURN [
version: [none],
attachedTo: NIL,
uniqueID: data.uniqueID,
bytes: data.nBytes,
mutability: immutable,
fileType: PFS.tUnspecified
]
};
CompiledLookupName: PFSClass.LookupNameProc ~ {
PROC [h: FSHandle, file: PATH] RETURNS[PATH]
data: Data ¬ NameToData[h, PFS.RopeFromPath[file]];
IF data = NIL THEN PFSBackdoor.ProduceError[unknownFile, Rope.Concat[PFS.RopeFromPath[file], " not found."], file];
RETURN [file]
};
CompiledRename: PFSClass.RenameProc ~ {
PROC [h: FSHandle, fromFile: PATH, wantedUniqueID: UniqueID, toFile: PATH, createOptions: PFS.CreateOptions, proc: PFS.NameConfirmProc] RETURNS [done: BOOL ← FALSE]
RETURN [FALSE]
};
CompiledCopy: PFSClass.CopyProc ~ {
PROC [h: FSHandle, fromFile: PATH, wantedUniqueID: UniqueID, toFile: PATH, createOptions: PFS.CreateOptions, proc: PFS.NameConfirmProc] RETURNS [done: BOOL ← FALSE]
RETURN [FALSE]
};
CompiledSetAttributes: PFSClass.SetAttributesProc ~ {
PROC [h: FSHandle, file: OpenFile, attributes: PFS.CreateOptions]
NotApplicable["SetAttributes"];
};
CompiledSetByteCountAndUniqueID: PFSClass.SetByteCountAndUniqueIDProc ~ {
PROC [h: FSHandle, file: OpenFile, propertyName: ROPE, propertyValue: ROPE]
NotApplicable["SetByteCountAndUniqueID"];
};
CompiledSetClientProperty: PFSClass.SetClientPropertyProc ~ {
PROC [h: FSHandle, file: OpenFile, propertyName: ROPE, propertyValue: ROPE]
NotApplicable["SetClientProperty"];
};
CompiledGetClientProperty: PFSClass.GetClientPropertyProc ~ {
PROC [h: FSHandle, file: OpenFile, propertyName: ROPE] RETURNS [propertyValue: ROPE]
RETURN [NIL]
};
CompiledEnumerateClientProperties: PFSClass.EnumerateClientPropertiesProc ~ {
PROC [h: FSHandle, file: OpenFile, proc: PFS.PropProc]
};
CompiledRead: UNSAFE PROC [h: FSHandle, file: OpenFile, filePosition, nBytes: CARD, toPtr: LONG POINTER, toStart: CARD] RETURNS [bytesRead: INT] ~ UNCHECKED {
data: Data ~ NARROW[file.data];
bytesRead ¬ 0;
IF filePosition > data.nBytes
THEN PFSBackdoor.ProduceError[positionNotInFile, "positionNotInFile", file]
ELSE bytesRead ¬ Basics.ByteBlt[to: [blockPointer: toPtr, startIndex: toStart, stopIndexPlusOne: toStart+nBytes], from: [blockPointer: data.base, startIndex: filePosition, stopIndexPlusOne: data.nBytes]]
};
CompiledWrite: PROC [h: FSHandle, file: OpenFile, filePosition, nBytes: CARD, fromPtr: LONG POINTER, fromStart: CARD] RETURNS [bytesWritten: INT] ~ {
bytesWritten ¬ 0;
NotApplicable["Write"];
};
CompiledOpen: PFSClass.OpenProc ~ {
PROC [h: FSHandle, file: PATH, wantedUniqueID: UniqueID, access: PFS.AccessOptions, checkFileType: BOOL, fileType: PFS.FileType, createOptions: PFS.CreateOptions] RETURNS [OpenFile]
IF access = read
THEN {
data: Data ¬ NameToData[h, PFS.RopeFromPath[file]];
IF debug THEN DebugPrint[what: "\nOpen.file", ref: file];
IF data = NIL OR (wantedUniqueID # PFS.nullUniqueID AND wantedUniqueID # data.uniqueID)
THEN { PFSBackdoor.ProduceError[unknownFile, Rope.Concat[PFS.RopeFromPath[file], " not found."], file] }
ELSE {
RETURN [NEW[PFSClass.OpenFileObject ¬ [
fs: h,
fullFName: NIL,
attachedTo: NIL,
uniqueID: data.uniqueID,
bytes: data.nBytes,
mutability: immutable,
fileType: PFS.tUnspecified,
access: access,
state: open,
data: data
]]]
};
}
ELSE {
NotApplicable["non-read Open"];
};
ERROR;
};
CompiledClose: PFSClass.CloseProc ~ {
PROC [h: FSHandle, file: OpenFile]
};
CompiledStore: PFSClass.StoreProc ~ {
PROC [h: FSHandle, file: PATH, wantedUniqueID: UniqueID, str: IO.STREAM, proc: PFS.StoreConfirmProc, createOptions: PFS.CreateOptions]
NotApplicable["Store"];
};
CompiledRetrieve: PFSClass.RetrieveProc ~ {
PROC [h: FSHandle, file: PATH, wantedUniqueID: UniqueID, proc: PFS.RetrieveConfirmProc, checkFileType: BOOL ← FALSE, fileType: PFS.FileType]
NotApplicable["Retrieve"];
};
CompiledAttach: PFSClass.AttachProc ~ {
PROC [h: FSHandle, file: PATH, to: PATH, keep: CARDINAL, wantedUniqueID: UniqueID, remoteCheck: BOOL ← TRUE] RETURNS [toFName: PATH]
NotApplicable["Attach"];
};
CompiledGetInfo: PFSClass.GetInfoProc ~ {
PROC [h: FSHandle, file: OpenFile] RETURNS [fullFName, attachedTo: PATH, uniqueID: UniqueID, bytes: INT, mutability: PFS.Mutability, fileType: PFS.FileType]
data: Data ~ NARROW[file.data];
RETURN [fullFName: file.fullFName, attachedTo: file.attachedTo, uniqueID: file.uniqueID, bytes: data.nBytes, mutability: file.mutability, fileType: file.fileType]
};
CompiledPFSNameToUnixName: PFSClass.PFSNameToUnixNameProc ~ {
PROC [h: FSHandle, file: PATH] RETURNS [ROPE]
RETURN [NIL]
};
CompiledCaseSensitive: PFSClass.CaseSensitiveProc ~ {
PROC [h: FSHandle, file: PATH] RETURNS [BOOL]
RETURN [FALSE]
};
fsToTable: SymTab.Ref ~ SymTab.Create[case: FALSE];
CompiledGetHandle: PFSClass.GetHandleProc ~ {
PROC [fs: ROPE, flavorSpecified: BOOL] RETURNS [h: FSHandle, downMsg: ROPE]
nameToData: SymTab.Ref;
DoUpdate: SymTab.UpdateAction ~ {
PROC [found: BOOL, val: Val] RETURNS [op: UpdateOperation ← none, new: Val ← NIL];
IF found
THEN nameToData ¬ NARROW[val]
ELSE { op ¬ store; new ¬ nameToData ¬ SymTab.Create[case: FALSE] };
};
SymTab.Update[fsToTable, fs, DoUpdate];
downMsg ¬ NIL;
IF debug THEN DebugPrint[what: "\nCompiledGetHandle.fs", ref: fs];
IF debug THEN DebugPrint[what: "\nCompiledGetHandle.flavorSpecified", ref: IF flavorSpecified THEN "TRUE" ELSE "FALSE"];
IF debug THEN DebugPrint[what: "\nCompiledGetHandle.nameToData", ref: nameToData];
h ¬ NEW [PFSClass.FSObject ¬ [
flavor: compiledFlavor,
name: fs,
maintenanceProcs: CompiledMaintenanceProcs,
procs: CompiledFileManipulationProcs,
data: nameToData
]];
};
Creation
CreateFromRope: PROC [name, contents: ROPE] ~ TRUSTED {
h: FSHandle ~ CompiledGetHandle["", FALSE].h;
string: CString ~ UXStrings.Create[contents];
data: Data ~ NEW[DataRep ¬ [
nBytes: Rope.Size[contents],
uniqueID: [egmt: LOOPHOLE[BasicTime.ExtendedNow[]]],
base: LOOPHOLE[string],
ref: LOOPHOLE[string]
]];
[] ¬ StoreData[h, PFS.RopeFromPath[PFSNames.EnsureAbsolute[PFS.PathFromRope[name]]], data];
};
CreateDataCompiledFile: UNSAFE PROC [name: CString, created: BasicTime.GMT, contents: CString, bytes: CARD] ~ UNCHECKED {
sanityCheck: CHAR[0C..0C] ~ contents[bytes]; -- check for trailing null byte to make sure the length is reasonable.
h: FSHandle ~ CompiledGetHandle["", FALSE].h;
data: Data ~ NEW[DataRep ¬ [
nBytes: bytes,
uniqueID: [egmt: [gmt: created, usecs: 0]],
base: LOOPHOLE[contents],
ref: NIL
]];
[] ¬ StoreData[h, PFS.RopeFromPath[PFSNames.EnsureAbsolute[PFS.PathFromRope[UXStrings.ToRope[name]]]], data];
};
DumpTab: PROC ~ {
DebugPrint["fsToTable", fsToTable];
};
Compiler
FlushBuf: PROC [out: IO.STREAM, buf: REF TEXT, len: CARDINAL] RETURNS [zero: [0..0] ¬ 0] ~ {
buf.length ¬ len;
IO.PutBlock[out, buf];
};
CreateLiteral: PROC [in, out: IO.STREAM, scr1, scr2: REF TEXT] RETURNS [length: INT ¬ 0] ~ {
inbuf: REF TEXT ~ scr1;
outbuf: REF TEXT ~ scr2;
max: CARDINAL ~ outbuf.maxLength;
outp: CARDINAL ¬ 0;
PutC: PROC [c: CHAR] ~ INLINE {
IF outp = max THEN { outp ¬ FlushBuf[out, outbuf, outp] };
outbuf[outp] ¬ c;
outp ¬ outp + 1;
};
inbuf.length ¬ 0;
PutC['"];
DO
bytes: NAT ~ IO.GetBlock[in, inbuf];
IF bytes = 0 THEN EXIT;
FOR i: NAT IN [0..bytes) DO
c: CHAR ¬ inbuf[i];
IF c = '" OR c='\\ THEN PutC['\\];
IF c IN [' .. '~]
THEN PutC[c]
ELSE {
PutC['\\];
PutC['0+ORD[c]/100B];
PutC['0+(ORD[c]/10B MOD 10B)];
PutC['0+(ORD[c] MOD 10B)];
};
length ¬ length + 1;
ENDLOOP;
ENDLOOP;
PutC['"];
outp ¬ FlushBuf[out, outbuf, outp];
IO.Close[in];
};
CreateDecimalLiteral: PROC [nWords: CARD, in, out: IO.STREAM, outbuf: REF TEXT] ~ {
i: CARD ¬ 0;
WHILE i < nWords DO
Words: TYPE ~ PACKED ARRAY [0..4) OF CARD32;
words: Words ¬ ALL[0];
outbuf.length ¬ 0;
TRUSTED {
[] ¬ IO.UnsafeGetBlock[in, [LOOPHOLE[@words], 0, BYTES[Words]]];
};
FOR k: [0..LENGTH[words]) IN [0..LENGTH[words]) DO
outbuf ¬ RefText.AppendChar[outbuf, ' ];
outbuf ¬ Convert.AppendCard[outbuf, words[k]];
i ¬ i + 1;
IF i = nWords THEN EXIT;
outbuf ¬ RefText.Append[outbuf, ", "];
ENDLOOP;
outbuf ¬ RefText.Append[outbuf, "\n"];
IO.PutBlock[out, outbuf];
Process.CheckForAbort[];
ENDLOOP;
IO.Close[in];
};
DataCompileCCommand: Commander.CommandProc ~ {
ENABLE PFS.Error => CommanderOps.Failed[error.explanation];
cFileName: ROPE ~ CommanderOps.NextArgument[cmd];
ris: IO.STREAM ¬ NIL;
IF cFileName = NIL
THEN CommanderOps.Failed[cmd.procData.doc]
ELSE {
scr1: REF TEXT ¬ NEW[TEXT[2000]];
scr2: REF TEXT ¬ NEW[TEXT[8000]];
moduleName: ROPE ~ cFileName.Substr[0, cFileName.Index[s2: "."]];
out: IO.STREAM ~ PFS.StreamOpen[PFS.PathFromRope[cFileName], create];
{ENABLE ABORTED => { out.Close[abort: TRUE ! UNCAUGHT => CONTINUE] };
directory: PATH ¬ PFS.PathFromRope["/"];
body: IO.STREAM ¬ IO.ROS[];
seq: CARD ¬ 0;
IO.PutF[out, "/* %g, created %g by DataCompile */\L", [rope[cFileName]], [time[BasicTime.Now[]]]];
IO.PutRope[out, "void CompiledView𡤌reateDataCompiledFile();\L"];
FOR inPattern: ROPE ¬ CommanderOps.NextArgument[cmd], CommanderOps.NextArgument[cmd] UNTIL inPattern = NIL DO
path: PATH ~ PFS.PathFromRope[inPattern];
n: INT ¬ 0;
Enter: PFS.InfoProc ~ {
PROC [fullFName, attachedTo: PATH, uniqueID: UniqueID, bytes: INT, mutability: Mutability, fileType: FileType] RETURNS [continue: BOOLTRUE];
IF fileType # PFS.tDirectory THEN {
in: IO.STREAM ¬ PFS.StreamOpen[fileName: fullFName, accessOptions: read, streamOptions: [includeFormatting: TRUE, closeFSOpenFileOnClose: TRUE]];
nWords: NAT ¬ (bytes+1+3)/4; -- add one null byte and round up.
IO.PutRope[body, externCreateDataCompiledFile];
IO.PutRope[body, "(\L "];
Process.CheckForAbort[];
[] ¬ CreateLiteral[
ris ¬ IO.RIS[rope:
PFS.RopeFromPath[directory.Cat[PFS.PathFromRope[PFSNames.ShortName[fullFName].ComponentRope]]],
oldStream: ris],
body, scr1, scr2];
IO.PutF1[body, ",\L %g", [cardinal[LOOPHOLE[uniqueID.egmt.gmt]]]];
IO.PutRope[body, ", /* "];
IO.Put1[body, [time[uniqueID.egmt.gmt]]];
IO.PutRope[body, " */\L"];
IO.PutF[out, "static struct { unsigned int foo [%g];} lit%g = {\L", [cardinal[nWords]], [cardinal[seq]]];
CreateDecimalLiteral[nWords, in, out, scr2];
IO.PutRope[out, " };\L"];
IO.PutF1[body, " &lit%g, ", [cardinal[seq]]];
seq ¬ seq + 1;
IO.Put1[body, [cardinal[bytes]]];
IO.PutRope[body, ");\L"];
n ¬ n + 1;
};
};
IF PFSNames.IsADirectory[path]
THEN {
IF NOT PFSNames.IsAbsolute[path] THEN CommanderOps.Failed[Rope.Concat[inPattern, " not absolute"]];
directory ¬ path;
}
ELSE {
Process.CheckForAbort[];
PFS.EnumerateForInfo[path, Enter];
IF n = 0 THEN {
cmd.err.PutRope["No files matching "];
cmd.err.PutRope[inPattern];
cmd.err.PutRope["\n"];
};
};
ENDLOOP;
IO.PutF1[out, "extern void XR←install←%g() {}\L", [rope[moduleName]]];
IO.PutF1[out, "extern void XR←run←%g() {\L", [rope[moduleName]]];
IO.PutRope[out, IO.RopeFromROS[body]];
IO.PutRope[out, "}\L"];
};
IO.Close[out];
};
};
DataCompileMesaCommand: Commander.CommandProc ~ {
ENABLE PFS.Error => CommanderOps.Failed[error.explanation];
mesaFileName: ROPE ~ CommanderOps.NextArgument[cmd];
ris: IO.STREAM ¬ NIL;
IF mesaFileName = NIL
THEN CommanderOps.Failed[cmd.procData.doc]
ELSE {
scr1: REF TEXT ¬ NEW[TEXT[2000]];
scr2: REF TEXT ¬ NEW[TEXT[8000]];
moduleName: ROPE ~ mesaFileName.Substr[0, mesaFileName.Index[s2: "."]];
out: IO.STREAM ~ PFS.StreamOpen[PFS.PathFromRope[mesaFileName], create];
directory: PATH ¬ PFS.PathFromRope["/"];
seq: INT ¬ 0;
IO.PutF[out, "-- %g, created %g by DataCompile --\n", [rope[mesaFileName]], [time[BasicTime.Now[]]]];
IO.PutRope[out, moduleName];
IO.PutRope[out, ": PROGRAM = {\n"];
IO.PutRope[out, "CreateDataCompiledFile: PROC [name: POINTER TO CHAR, created: WORD, contents: POINTER TO CHAR, bytes: CARD] ~ MACHINE CODE {\"CompiledView𡤌reateDataCompiledFile\"};\n"];
IO.PutRope[out, "DefineFile: PROC [name: STRING, created: WORD, contents: STRING, bytes: CARD] RETURNS [INT:=0] = INLINE {CreateDataCompiledFile[LOOPHOLE[name, POINTER TO CHAR] + SIZE[StringBody[0]], created, LOOPHOLE[contents, POINTER TO CHAR] + SIZE[StringBody[0]], bytes]};\n"];
FOR inPattern: ROPE ¬ CommanderOps.NextArgument[cmd], CommanderOps.NextArgument[cmd] UNTIL inPattern = NIL DO
path: PATH ~ PFS.PathFromRope[inPattern];
n: INT ¬ 0;
Enter: PFS.InfoProc ~ {
PROC [fullFName, attachedTo: PATH, uniqueID: UniqueID, bytes: INT, mutability: Mutability, fileType: FileType] RETURNS [continue: BOOLTRUE];
IF fileType # PFS.tDirectory THEN {
in: IO.STREAM ¬ PFS.StreamOpen[fileName: fullFName, accessOptions: read, streamOptions: [includeFormatting: TRUE, closeFSOpenFileOnClose: TRUE]];
len: NAT ¬ 0;
seq ¬ seq + 1;
IO.PutF1[out, "name%g: STRING = ", [cardinal[seq]]];
Process.CheckForAbort[];
[] ¬ CreateLiteral[
ris ¬ IO.RIS[rope:
PFS.RopeFromPath[directory.Cat[PFS.PathFromRope[PFSNames.ShortName[fullFName].ComponentRope]]],
oldStream: ris],
out, scr1, scr2];
IO.PutRope[out, "; -- "];
IO.Put1[out, [time[uniqueID.egmt.gmt]]];
IO.PutRope[out, " --\n"];
IO.PutF1[out, "contents%g: STRING = ", [cardinal[seq]]];
[] ¬ CreateLiteral[in, out, scr1, scr2];
IO.PutRope[out, ";\n"];
IO.PutFL[out, "def%g: INT ~ DefineFile[name%g, %g, contents%g, contents%g.length];\n\n", LIST[
[cardinal[seq]],
[cardinal[seq]],
[cardinal[LOOPHOLE[uniqueID.egmt.gmt]]],
[cardinal[seq]],
[cardinal[seq]]
]];
n ¬ n + 1;
};
};
IF PFSNames.IsADirectory[path]
THEN {
IF NOT PFSNames.IsAbsolute[path] THEN CommanderOps.Failed[Rope.Concat[inPattern, " not absolute"]];
directory ¬ path;
}
ELSE {
Process.CheckForAbort[];
PFS.EnumerateForInfo[path, Enter];
IF n = 0 THEN {
cmd.err.PutRope["No files matching "];
cmd.err.PutRope[inPattern];
cmd.err.PutRope["\n"];
};
};
ENDLOOP;
IO.PutRope[out, "}..."];
IO.Close[out];
};
};
ExternalNames: PROC = TRUSTED MACHINE CODE {
"^ExternalNames\n";
"CreateDataCompiledFile CompiledView𡤌reateDataCompiledFile\n";
};
externCreateDataCompiledFile: ROPE ~ "CompiledView𡤌reateDataCompiledFile";
Registration
ExternalNames[];
PFSClass.Register[flavor: compiledFlavor, getHandle: CompiledGetHandle];
Atom.PutProp[$CompiledViewImpl, $LastRegistered, me];
CreateFromRope["/ThisIsATest", "This is the test data."];
CreateFromRope["/ThisIsAnotherTest", "This is more test data."];
Commander.Register["DataCompileC", DataCompileCCommand, "Turn files into c-code\nargs: outname { directory | pattern }*\nexample: DataCompile myfiles.c /myfiles/ *.datafile"];
Commander.Register["DataCompileMesa", DataCompileMesaCommand, "Turn files into mesa-code\nargs: outname { directory | pattern }*\nexample: DataCompile myfiles.mesa /myfiles/ *.datafile"];
END.