Files
Nim/nim/rodwrite.pas
2010-02-14 00:29:35 +01:00

613 lines
17 KiB
ObjectPascal

//
//
// The Nimrod Compiler
// (c) Copyright 2008 Andreas Rumpf
//
// See the file "copying.txt", included in this
// distribution, for details about the copyright.
//
unit rodwrite;
// This module is responsible for writing of rod files. Note that writing of
// rod files is a pass, reading of rod files is not! This is why reading and
// writing of rod files is split into two different modules.
interface
{$include 'config.inc'}
uses
sysutils, nsystem, nos, options, strutils, nversion, ast, astalgo, msgs,
platform, condsyms, ropes, idents, crc, rodread, passes, importer;
function rodwritePass(): TPass;
implementation
type
TRodWriter = object(TPassContext)
module: PSym;
crc: TCrc32;
options: TOptions;
defines: PRope;
inclDeps: PRope;
modDeps: PRope;
interf: PRope;
compilerProcs: PRope;
index, imports: TIndex;
converters: PRope;
init: PRope;
data: PRope;
filename: string;
sstack: TSymSeq; // a stack of symbols to process
tstack: TTypeSeq; // a stack of types to process
files: TStringSeq;
end;
PRodWriter = ^TRodWriter;
function newRodWriter(const modfilename: string; crc: TCrc32;
module: PSym): PRodWriter; forward;
procedure addModDep(w: PRodWriter; const dep: string); forward;
procedure addInclDep(w: PRodWriter; const dep: string); forward;
procedure addInterfaceSym(w: PRodWriter; s: PSym); forward;
procedure addStmt(w: PRodWriter; n: PNode); forward;
procedure writeRod(w: PRodWriter); forward;
function encodeStr(w: PRodWriter; const s: string): PRope;
begin
result := encode(s)
end;
procedure processStacks(w: PRodWriter); forward;
function getDefines: PRope;
var
it: TTabIter;
s: PSym;
begin
s := InitTabIter(it, gSymbols);
result := nil;
while s <> nil do begin
if s.position = 1 then begin
if result <> nil then app(result, ' '+'');
app(result, s.name.s);
end;
s := nextIter(it, gSymbols);
end
end;
function fileIdx(w: PRodWriter; const filename: string): int;
var
i: int;
begin
for i := 0 to high(w.files) do begin
if w.files[i] = filename then begin result := i; exit end;
end;
result := length(w.files);
setLength(w.files, result+1);
w.files[result] := filename;
end;
function newRodWriter(const modfilename: string; crc: TCrc32;
module: PSym): PRodWriter;
begin
new(result);
{@ignore}
fillChar(result^, sizeof(result^), 0);
{@emit
result.sstack := @[];}
{@emit
result.tstack := @[];}
InitIITable(result.index.tab);
InitIITable(result.imports.tab);
result.filename := modfilename;
result.crc := crc;
result.module := module;
result.defines := getDefines();
result.options := options.gOptions;
{@emit result.files := @[];}
end;
procedure addModDep(w: PRodWriter; const dep: string);
begin
if w.modDeps <> nil then app(w.modDeps, ' '+'');
app(w.modDeps, encodeInt(fileIdx(w, dep)));
end;
const
rodNL = #10+'';
procedure addInclDep(w: PRodWriter; const dep: string);
begin
app(w.inclDeps, encodeInt(fileIdx(w, dep)));
app(w.inclDeps, ' '+'');
app(w.inclDeps, encodeInt(crcFromFile(dep)));
app(w.inclDeps, rodNL);
end;
procedure pushType(w: PRodWriter; t: PType);
var
L: int;
begin
// check so that the stack does not grow too large:
if IiTableGet(w.index.tab, t.id) = invalidKey then begin
L := length(w.tstack);
setLength(w.tstack, L+1);
w.tstack[L] := t;
end
end;
procedure pushSym(w: PRodWriter; s: PSym);
var
L: int;
begin
// check so that the stack does not grow too large:
if IiTableGet(w.index.tab, s.id) = invalidKey then begin
L := length(w.sstack);
setLength(w.sstack, L+1);
w.sstack[L] := s;
end
end;
function encodeNode(w: PRodWriter; const fInfo: TLineInfo; n: PNode): PRope;
var
i: int;
f: TNodeFlags;
begin
if n = nil then begin
// nil nodes have to be stored too:
result := toRope('()'); exit
end;
result := toRope('('+'');
app(result, encodeInt(ord(n.kind)));
// we do not write comments for now
// Line information takes easily 20% or more of the filesize! Therefore we
// omit line information if it is the same as the father's line information:
if (finfo.fileIndex <> n.info.fileIndex) then
appf(result, '?$1,$2,$3', [encodeInt(n.info.col), encodeInt(n.info.line),
encodeInt(fileIdx(w, toFilename(n.info)))])
else if (finfo.line <> n.info.line) then
appf(result, '?$1,$2', [encodeInt(n.info.col), encodeInt(n.info.line)])
else if (finfo.col <> n.info.col) then
appf(result, '?$1', [encodeInt(n.info.col)]);
// No need to output the file index, as this is the serialization of one
// file.
f := n.flags * PersistentNodeFlags;
if f <> {@set}[] then
appf(result, '$$$1', [encodeInt({@cast}int32(f))]);
if n.typ <> nil then begin
appf(result, '^$1', [encodeInt(n.typ.id)]);
pushType(w, n.typ);
end;
case n.kind of
nkCharLit..nkInt64Lit: begin
if n.intVal <> 0 then
appf(result, '!$1', [encodeInt(n.intVal)]);
end;
nkFloatLit..nkFloat64Lit: begin
if n.floatVal <> 0.0 then
appf(result, '!$1', [encodeStr(w, toStringF(n.floatVal))]);
end;
nkStrLit..nkTripleStrLit: begin
if n.strVal <> '' then
appf(result, '!$1', [encodeStr(w, n.strVal)]);
end;
nkIdent:
appf(result, '!$1', [encodeStr(w, n.ident.s)]);
nkSym: begin
appf(result, '!$1', [encodeInt(n.sym.id)]);
pushSym(w, n.sym);
end;
else begin
for i := 0 to sonsLen(n)-1 do
app(result, encodeNode(w, n.info, n.sons[i]));
end
end;
app(result, ')'+'');
end;
function encodeLoc(w: PRodWriter; const loc: TLoc): PRope;
begin
result := nil;
if loc.k <> low(loc.k) then
app(result, encodeInt(ord(loc.k)));
if loc.s <> low(loc.s) then
appf(result, '*$1', [encodeInt(ord(loc.s))]);
if loc.flags <> {@set}[] then
appf(result, '$$$1', [encodeInt({@cast}int32(loc.flags))]);
if loc.t <> nil then begin
appf(result, '^$1', [encodeInt(loc.t.id)]);
pushType(w, loc.t);
end;
if loc.r <> nil then
appf(result, '!$1', [encodeStr(w, ropeToStr(loc.r))]);
if loc.a <> 0 then
appf(result, '?$1', [encodeInt(loc.a)]);
if result <> nil then
result := ropef('<$1>', [result]);
end;
function encodeType(w: PRodWriter; t: PType): PRope;
var
i: int;
begin
if t = nil then begin
// nil nodes have to be stored too:
result := toRope('[]'); exit
end;
result := nil;
if t.kind = tyForward then InternalError('encodeType: tyForward');
app(result, encodeInt(ord(t.kind)));
appf(result, '+$1', [encodeInt(t.id)]);
if t.n <> nil then
app(result, encodeNode(w, UnknownLineInfo(), t.n));
if t.flags <> {@set}[] then
appf(result, '$$$1', [encodeInt({@cast}int32(t.flags))]);
if t.callConv <> low(t.callConv) then
appf(result, '?$1', [encodeInt(ord(t.callConv))]);
if t.owner <> nil then begin
appf(result, '*$1', [encodeInt(t.owner.id)]);
pushSym(w, t.owner);
end;
if t.sym <> nil then begin
appf(result, '&$1', [encodeInt(t.sym.id)]);
pushSym(w, t.sym);
end;
if t.size <> -1 then appf(result, '/$1', [encodeInt(t.size)]);
if t.align <> 2 then appf(result, '=$1', [encodeInt(t.align)]);
if t.containerID <> 0 then
appf(result, '@$1', [encodeInt(t.containerID)]);
app(result, encodeLoc(w, t.loc));
for i := 0 to sonsLen(t)-1 do begin
if t.sons[i] = nil then
app(result, '^()')
else begin
appf(result, '^$1', [encodeInt(t.sons[i].id)]);
pushType(w, t.sons[i]);
end
end;
end;
function encodeLib(w: PRodWriter; lib: PLib): PRope;
begin
result := nil;
appf(result, '|$1', [encodeInt(ord(lib.kind))]);
appf(result, '|$1', [encodeStr(w, ropeToStr(lib.name))]);
appf(result, '|$1', [encodeStr(w, lib.path)]);
end;
function encodeSym(w: PRodWriter; s: PSym): PRope;
var
codeAst: PNode;
col, line: PRope;
begin
codeAst := nil;
if s = nil then begin
// nil nodes have to be stored too:
result := toRope('{}'); exit
end;
result := nil;
app(result, encodeInt(ord(s.kind)));
appf(result, '+$1', [encodeInt(s.id)]);
appf(result, '&$1', [encodeStr(w, s.name.s)]);
if s.typ <> nil then begin
appf(result, '^$1', [encodeInt(s.typ.id)]);
pushType(w, s.typ);
end;
if s.info.col = int16(-1) then col := nil
else col := encodeInt(s.info.col);
if s.info.line = int16(-1) then line := nil
else line := encodeInt(s.info.line);
appf(result, '?$1,$2,$3', [col, line,
encodeInt(fileIdx(w, toFilename(s.info)))]);
if s.owner <> nil then begin
appf(result, '*$1', [encodeInt(s.owner.id)]);
pushSym(w, s.owner);
end;
if s.flags <> {@set}[] then
appf(result, '$$$1', [encodeInt({@cast}int32(s.flags))]);
if s.magic <> mNone then
appf(result, '@$1', [encodeInt(ord(s.magic))]);
if (s.ast <> nil) then begin
if not astNeeded(s) then begin
codeAst := s.ast.sons[codePos];
s.ast.sons[codePos] := nil;
end;
app(result, encodeNode(w, s.info, s.ast));
if codeAst <> nil then // restore code ast
s.ast.sons[codePos] := codeAst;
end;
if s.options <> w.options then
appf(result, '!$1', [encodeInt({@cast}int32(s.options))]);
if s.position <> 0 then
appf(result, '%$1', [encodeInt(s.position)]);
if s.offset <> -1 then
appf(result, '`$1', [encodeInt(s.offset)]);
app(result, encodeLoc(w, s.loc));
if s.annex <> nil then
app(result, encodeLib(w, s.annex));
end;
procedure addToIndex(var w: TIndex; key, val: int);
begin
if key - w.lastIdxKey = 1 then begin
// we do not store a key-diff of 1 to safe space
app(w.r, encodeInt(val - w.lastIdxVal));
app(w.r, rodNL);
end
else
appf(w.r, '$1 $2'+rodNL, [encodeInt(key - w.lastIdxKey),
encodeInt(val - w.lastIdxVal)]);
w.lastIdxKey := key;
w.lastIdxVal := val;
IiTablePut(w.tab, key, val);
end;
var
debugWritten: TIntSet;
procedure symStack(w: PRodWriter);
var
i, L: int;
s, m: PSym;
begin
i := 0;
while i < length(w.sstack) do begin
s := w.sstack[i];
if IiTableGet(w.index.tab, s.id) = invalidKey then begin
m := getModule(s);
if m = nil then InternalError('symStack: module nil: ' + s.name.s);
if (m.id = w.module.id) or (sfFromGeneric in s.flags) then begin
// put definition in here
L := ropeLen(w.data);
addToIndex(w.index, s.id, L);
//intSetIncl(debugWritten, s.id);
app(w.data, encodeSym(w, s));
app(w.data, rodNL);
if sfInInterface in s.flags then
appf(w.interf, '$1 $2'+rodNL, [encode(s.name.s), encodeInt(s.id)]);
if sfCompilerProc in s.flags then
appf(w.compilerProcs, '$1 $2'+rodNL, [encode(s.name.s), encodeInt(s.id)]);
if s.kind = skConverter then begin
if w.converters <> nil then app(w.converters, ' '+'');
app(w.converters, encodeInt(s.id))
end
end
else if IiTableGet(w.imports.tab, s.id) = invalidKey then begin
addToIndex(w.imports, s.id, m.id);
//if not IntSetContains(debugWritten, s.id) then begin
// MessageOut(w.filename);
// debug(s.owner);
// debug(s);
// InternalError('BUG!!!!');
//end
end
end;
inc(i);
end;
setLength(w.sstack, 0);
end;
procedure typeStack(w: PRodWriter);
var
i, L: int;
begin
i := 0;
while i < length(w.tstack) do begin
if IiTableGet(w.index.tab, w.tstack[i].id) = invalidKey then begin
L := ropeLen(w.data);
addToIndex(w.index, w.tstack[i].id, L);
app(w.data, encodeType(w, w.tstack[i]));
app(w.data, rodNL);
end;
inc(i);
end;
setLength(w.tstack, 0);
end;
procedure processStacks(w: PRodWriter);
begin
while (length(w.tstack) > 0) or (length(w.sstack) > 0) do begin
symStack(w);
typeStack(w);
end
end;
procedure rawAddInterfaceSym(w: PRodWriter; s: PSym);
begin
pushSym(w, s);
processStacks(w);
end;
procedure addInterfaceSym(w: PRodWriter; s: PSym);
begin
if w = nil then exit;
if [sfInInterface, sfCompilerProc] * s.flags <> [] then begin
rawAddInterfaceSym(w, s);
end
end;
procedure addStmt(w: PRodWriter; n: PNode);
begin
app(w.init, encodeInt(ropeLen(w.data)));
app(w.init, rodNL);
app(w.data, encodeNode(w, UnknownLineInfo(), n));
app(w.data, rodNL);
processStacks(w);
end;
procedure writeRod(w: PRodWriter);
var
content: PRope;
i: int;
begin
processStacks(w);
// write header:
content := toRope('NIM:');
app(content, toRope(FileVersion));
app(content, rodNL);
app(content, toRope('ID:'));
app(content, encodeInt(w.module.id));
app(content, rodNL);
app(content, toRope('CRC:'));
app(content, encodeInt(w.crc));
app(content, rodNL);
app(content, toRope('OPTIONS:'));
app(content, encodeInt({@cast}int32(w.options)));
app(content, rodNL);
app(content, toRope('DEFINES:'));
app(content, w.defines);
app(content, rodNL);
app(content, toRope('FILES('+rodNL));
for i := 0 to high(w.files) do begin
app(content, encode(w.files[i]));
app(content, rodNL);
end;
app(content, toRope(')'+rodNL));
app(content, toRope('INCLUDES('+rodNL));
app(content, w.inclDeps);
app(content, toRope(')'+rodNL));
app(content, toRope('DEPS:'));
app(content, w.modDeps);
app(content, rodNL);
app(content, toRope('INTERF('+rodNL));
app(content, w.interf);
app(content, toRope(')'+rodNL));
app(content, toRope('COMPILERPROCS('+rodNL));
app(content, w.compilerProcs);
app(content, toRope(')'+rodNL));
app(content, toRope('INDEX('+rodNL));
app(content, w.index.r);
app(content, toRope(')'+rodNL));
app(content, toRope('IMPORTS('+rodNL));
app(content, w.imports.r);
app(content, toRope(')'+rodNL));
app(content, toRope('CONVERTERS:'));
app(content, w.converters);
app(content, toRope(rodNL));
app(content, toRope('INIT('+rodNL));
app(content, w.init);
app(content, toRope(')'+rodNL));
app(content, toRope('DATA('+rodNL));
app(content, w.data);
app(content, toRope(')'+rodNL));
//MessageOut('interf ' + ToString(ropeLen(w.interf)));
//MessageOut('index ' + ToString(ropeLen(w.indexRope)));
//MessageOut('init ' + ToString(ropeLen(w.init)));
//MessageOut('data ' + ToString(ropeLen(w.data)));
writeRope(content,
completeGeneratedFilePath(changeFileExt(w.filename, 'rod')));
end;
function process(c: PPassContext; n: PNode): PNode;
var
i: int;
w: PRodWriter;
a: PNode;
s: PSym;
begin
result := n;
if c = nil then exit;
w := PRodWriter(c);
case n.kind of
nkStmtList: begin
for i := 0 to sonsLen(n)-1 do {@discard} process(c, n.sons[i]);
end;
nkTemplateDef, nkMacroDef: begin
s := n.sons[namePos].sym;
addInterfaceSym(w, s);
end;
nkProcDef, nkMethodDef, nkIteratorDef, nkConverterDef: begin
s := n.sons[namePos].sym;
if s = nil then InternalError(n.info, 'rodwrite.process');
if (n.sons[codePos] <> nil) or (s.magic <> mNone)
or not (sfForward in s.flags) then begin
addInterfaceSym(w, s);
end
end;
nkVarSection: begin
for i := 0 to sonsLen(n)-1 do begin
a := n.sons[i];
if a.kind = nkCommentStmt then continue;
if a.kind <> nkIdentDefs then InternalError(a.info, 'rodwrite.process');
addInterfaceSym(w, a.sons[0].sym);
end
end;
nkConstSection: begin
for i := 0 to sonsLen(n)-1 do begin
a := n.sons[i];
if a.kind = nkCommentStmt then continue;
if a.kind <> nkConstDef then InternalError(a.info, 'rodwrite.process');
addInterfaceSym(w, a.sons[0].sym);
end
end;
nkTypeSection: begin
for i := 0 to sonsLen(n)-1 do begin
a := n.sons[i];
if a.kind = nkCommentStmt then continue;
if a.sons[0].kind <> nkSym then
InternalError(a.info, 'rodwrite.process');
s := a.sons[0].sym;
addInterfaceSym(w, s); // this takes care of enum fields too
// Note: The check for ``s.typ.kind = tyEnum`` is wrong for enum
// type aliasing! Otherwise the same enum symbol would be included
// several times!
(*
if (a.sons[2] <> nil) and (a.sons[2].kind = nkEnumTy) then begin
a := s.typ.n;
for j := 0 to sonsLen(a)-1 do
addInterfaceSym(w, a.sons[j].sym);
end *)
end
end;
nkImportStmt: begin
for i := 0 to sonsLen(n)-1 do addModDep(w, getModuleFile(n.sons[i]));
addStmt(w, n);
end;
nkFromStmt: begin
addModDep(w, getModuleFile(n.sons[0]));
addStmt(w, n);
end;
nkIncludeStmt: begin
for i := 0 to sonsLen(n)-1 do addInclDep(w, getModuleFile(n.sons[i]));
end;
nkPragma: addStmt(w, n);
else begin end
end;
end;
function myOpen(module: PSym; const filename: string): PPassContext;
var
w: PRodWriter;
begin
if module.id < 0 then InternalError('rodwrite: module ID not set');
w := newRodWriter(filename, rodread.GetCRC(filename), module);
rawAddInterfaceSym(w, module);
result := w;
end;
function myClose(c: PPassContext; n: PNode): PNode;
var
w: PRodWriter;
begin
w := PRodWriter(c);
writeRod(w);
result := n;
end;
function rodwritePass(): TPass;
begin
initPass(result);
if optSymbolFiles in gGlobalOptions then begin
result.open := myOpen;
result.close := myClose;
result.process := process;
end
end;
initialization
IntSetInit(debugWritten);
end.