123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665 |
- MODULE FoxTranspilerBackend; (** AUTHOR "negelef"; PURPOSE "Oberon to C transpiler"; *)
- IMPORT Basic := FoxBasic, Global := FoxGlobal, Backend := FoxBackend, SyntaxTree := FoxSyntaxTree, Scanner := FoxScanner,
- Formats := FoxFormats, Files, Streams, Strings, Options, SymbolFileFormat := FoxTextualSymbolFile, Printout := FoxPrintout;
- CONST
- Space = ' ';
- Tab = 9X;
- Comma = ',';
- Semicolon = ';';
- LeftBrace = '{';
- RightBrace = '}';
- StructTag = "_tag";
- BaseTag = "_base";
- TypeTag = "_type";
- LenTag = "_len";
- PointerTag = "_pointer";
- DelegateTag = "_delegate";
- BaseObjectName = "BaseObject";
- TypeDescriptorTag = "_descriptor";
- DefaultStyle = 0;
- StailaStyle = 1;
- TYPE
- TYPE Style = INTEGER;
- TYPE Indent = INTEGER;
- Identifier = ARRAY Scanner.MaxIdentifierLength OF CHAR;
- TYPE Transpiler* = OBJECT (SyntaxTree.Visitor)
- VAR
- indent: Indent;
- writer: Streams.Writer;
- backend: TranspilerBackend;
- currentProcedureScope: SyntaxTree.ProcedureScope;
- initializeLocalData: BOOLEAN;
- PROCEDURE &InitTranspiler (writer: Streams.Writer; backend: TranspilerBackend; initLocalData: BOOLEAN);
- BEGIN indent := 0; SELF.writer := writer; SELF.backend := backend; currentProcedureScope := NIL; initializeLocalData:= initLocalData;
- END InitTranspiler;
- PROCEDURE DeclareModule (module: SyntaxTree.Module);
- BEGIN
- DeclareImports (module.moduleScope);
- DefineConstants (module.moduleScope);
- DefineTypes (module.moduleScope);
- DeclareVariables (module.moduleScope);
- DeclareProcedures (module.moduleScope);
- DeclareObjects (module.moduleScope);
- END DeclareModule;
- PROCEDURE DeclareImports (scope: SyntaxTree.ModuleScope);
- VAR filename: Files.FileName; import: SyntaxTree.Import;
- BEGIN
- writer.Ln; PrintInclude ("oberon.h");
- import := scope.firstImport;
- WHILE import # NIL DO
- IF ~Global.IsSystemModule (import.module) & import.direct THEN
- GetHeaderName (import.module, filename, backend.style);
- PrintInclude (filename);
- END;
- import := import.nextImport;
- END;
- END DeclareImports;
- PROCEDURE DeclareVariables (scope: SyntaxTree.Scope);
- VAR variable: SyntaxTree.Variable; name: Identifier;
- BEGIN
- variable := scope.firstVariable;
- IF scope IS SyntaxTree.ModuleScope THEN
- GetScopeName (scope, name, backend.style); writer.Ln;
- PrintIndent; writer.String ("extern "); writer.String (BaseObjectName);
- writer.Char (Space); writer.String (name); writer.String (StructTag); writer.Char (Semicolon); writer.Ln;
- ELSIF variable # NIL THEN writer.Ln END;
- WHILE variable # NIL DO
- GetSymbolName (variable, name, backend.style);
- PrintComments (variable.comment, variable);
- PrintIndent; writer.String ("extern ");
- PrintVariable (FALSE, name, variable.type); writer.Char (Semicolon);
- writer.Ln;
- IF IsDelegate (variable.type.resolved) THEN
- PrintIndent; writer.String ("extern "); writer.String (BaseObjectName); writer.Char ('*');
- writer.Char (' '); writer.String (name); writer.String (DelegateTag); writer.Char (Semicolon); writer.Ln;
- END;
- variable := variable.nextVariable;
- END;
- END DeclareVariables;
- PROCEDURE DeclareProcedures (scope: SyntaxTree.Scope);
- VAR procedure: SyntaxTree.Procedure; name: Identifier;
- BEGIN
- procedure := scope.firstProcedure;
- IF procedure # NIL THEN writer.Ln; END;
- WHILE procedure # NIL DO
- IF IsInlineAssemblyCode (procedure) THEN
- GetSymbolName (procedure, name, backend.style); writer.Ln; writer.String ("#define "); writer.String (name);
- writer.String ("() "); PrintCode (procedure.procedureScope.body.code); writer.Ln;
- ELSE
- PrintIndent; PrintProcedure (procedure); writer.Char (Semicolon); writer.Ln;
- END;
- procedure := procedure.nextProcedure;
- END;
- END DeclareProcedures;
- PROCEDURE DeclareObjects (scope: SyntaxTree.Scope);
- VAR typeDeclaration: SyntaxTree.TypeDeclaration; record: SyntaxTree.RecordType;
- BEGIN
- typeDeclaration := scope.firstTypeDeclaration;
- WHILE typeDeclaration # NIL DO
- record := GetRecord (typeDeclaration.declaredType);
- IF record # NIL THEN DeclareProcedures (record.recordScope); DeclareDescriptor (record) END;
- typeDeclaration := typeDeclaration.nextTypeDeclaration;
- END;
- END DeclareObjects;
- PROCEDURE DeclareDescriptor (record: SyntaxTree.RecordType);
- VAR name: Identifier; method: LONGINT; procedure: SyntaxTree.Procedure; procedureType: SyntaxTree.ProcedureType;
- BEGIN
- GetSymbolName (record.typeDeclaration, name, backend.style);
- writer.Ln; writer.String ("typedef struct "); writer.String (name); writer.String (TypeTag); writer.String (StructTag);
- writer.Char (Space); writer.String (name); writer.String (TypeTag); writer.Char (Semicolon); writer.Ln;
- writer.Ln; writer.String ("extern "); writer.String (name); writer.String (TypeTag); INC (indent);
- writer.Char (Space); writer.String (name); writer.String (TypeDescriptorTag); writer.Char (Semicolon); writer.Ln;
- writer.Ln; writer.String ("struct "); writer.String (name); writer.String (TypeTag); writer.String (StructTag); writer.Char (Space); writer.Char ('{'); writer.Ln;
- PrintIndent; writer.String ("void* "); writer.String (BaseTag); writer.Char (Semicolon); writer.Ln;
- FOR method := 0 TO record.recordScope.numberMethods - 1 DO
- procedure := GetRecordMethod (record, method);
- procedure.GetName(name); FixIdentifier (name, backend.style);
- procedureType := procedure.type(SyntaxTree.ProcedureType);
- PrintIndent; PrintType (TRUE, procedureType.returnType, name);
- PrintParameters (procedureType, procedure.scope);
- writer.Char (Semicolon); writer.Ln;
- END;
- DEC (indent); writer.Char ('}'); writer.Char (Semicolon); writer.Ln;
- END DeclareDescriptor;
- PROCEDURE DefineModule (module: SyntaxTree.Module);
- BEGIN
- DefineImports (module.moduleScope);
- DefineVariables (module.moduleScope);
- DefineProcedures (module.moduleScope);
- DefineObjects (module.moduleScope);
- END DefineModule;
- PROCEDURE DefineMain (module: SyntaxTree.Module);
- VAR name: Identifier;
- BEGIN
- writer.Ln; PrintIndent; writer.String ("int main ()"); writer.Ln; BeginBlock;
- IF module.moduleScope.bodyProcedure # NIL THEN
- GetSymbolName (module.moduleScope.bodyProcedure, name, backend.style);
- PrintIndent; writer.String (name); writer.String (" ();"); writer.Ln;
- END;
- EndBlock;
- END DefineMain;
- PROCEDURE DefineImports (scope: SyntaxTree.ModuleScope);
- VAR filename: Files.FileName; import: SyntaxTree.Import;
- BEGIN
- writer.Ln; PrintInclude ("oberon.h");
- GetHeaderName (scope.ownerModule, filename, backend.style); PrintInclude (filename);
- import := scope.firstImport;
- WHILE import # NIL DO
- PrintComments (import.comment, import);
- import := import.nextImport;
- END;
- END DefineImports;
- PROCEDURE DefineConstants (scope: SyntaxTree.Scope);
- VAR constant: SyntaxTree.Constant; name: Identifier;
- BEGIN
- constant := scope.firstConstant;
- IF constant # NIL THEN writer.Ln; END;
- WHILE constant # NIL DO
- GetSymbolName (constant, name, backend.style);
- PrintComments (constant.comment, constant);
- writer.String ("#define "); writer.String (name);
- writer.Char (Space); PrintExpression (constant.value);
- writer.Ln;
- constant := constant.nextConstant;
- END;
- END DefineConstants;
- PROCEDURE DefineTypes (scope: SyntaxTree.Scope);
- TYPE Types = POINTER TO ARRAY OF SyntaxTree.Type;
- VAR typeDeclaration: SyntaxTree.TypeDeclaration; types: Types; count: LONGINT;
- PROCEDURE DeclareType (type: SyntaxTree.Type);
- VAR name: Identifier;
- BEGIN
- IF type IS SyntaxTree.RecordType THEN
- GetSymbolName (type.typeDeclaration, name, backend.style);
- writer.String ("typedef struct "); writer.String (name); writer.String (StructTag);
- writer.Char (Space); writer.String (name); writer.Char (Semicolon); writer.Ln;
- ELSIF (type IS SyntaxTree.PointerType) THEN
- writer.String ("typedef struct ");
- IF type(SyntaxTree.PointerType).pointerBase.resolved IS SyntaxTree.RecordType THEN
- GetSymbolName (type(SyntaxTree.PointerType).pointerBase.resolved(SyntaxTree.RecordType).typeDeclaration, name, backend.style);
- writer.String (name);
- ELSE
- writer.String ("Array");
- END;
- writer.String (PointerTag); GetSymbolName (type.typeDeclaration, name, backend.style);
- writer.Char (Space); writer.Char ('*'); writer.String (name); writer.Char (Semicolon); writer.Ln;
- END;
- END DeclareType;
- PROCEDURE DefineType (type: SyntaxTree.Type; reference: BOOLEAN);
- VAR i: LONGINT; variable: SyntaxTree.Variable; new: Types; name: Identifier;
- BEGIN
- IF (type IS SyntaxTree.PointerType) & ~reference THEN RETURN END;
- FOR i := 0 TO count - 1 DO IF types[i] = type THEN RETURN END END;
- IF LEN (types) = count THEN NEW (new, count * 2); FOR i := 0 TO count - 1 DO new[i] := types[i] END; types := new; END;
- types[count] := type; INC (count);
- IF type.typeDeclaration # NIL THEN GetSymbolName (type.typeDeclaration, name, backend.style) END;
- IF type IS SyntaxTree.ArrayType THEN
- DefineType (type(SyntaxTree.ArrayType).arrayBase.resolved, FALSE);
- ELSIF type IS SyntaxTree.PointerType THEN
- DefineType (type(SyntaxTree.PointerType).pointerBase.resolved, TRUE);
- ELSIF type IS SyntaxTree.RecordType THEN
- IF type(SyntaxTree.RecordType).baseType # NIL THEN DefineType (type(SyntaxTree.RecordType).GetBaseRecord (), FALSE) END;
- DefineTypes (type(SyntaxTree.RecordType).recordScope);
- variable := type(SyntaxTree.RecordType).recordScope.firstVariable;
- WHILE variable # NIL DO
- DefineType (variable.type.resolved, FALSE);
- variable := variable.nextVariable;
- END;
- END;
- IF (type.typeDeclaration = NIL) OR (type.typeDeclaration.scope # scope) THEN RETURN END;
- IF type IS SyntaxTree.RecordType THEN
- writer.Ln; writer.String ("struct "); writer.String (name); writer.String (StructTag);
- writer.Char (Space); writer.Char (LeftBrace); writer.Ln; INC (indent); PrintIndent;
- IF type(SyntaxTree.RecordType).baseType # NIL THEN
- IF type(SyntaxTree.RecordType).isObject OR ~IsEmptyRecord (type(SyntaxTree.RecordType).GetBaseRecord ()) THEN
- writer.String ("struct "); PrintType (FALSE, type(SyntaxTree.RecordType).GetBaseRecord (), ""); writer.String (StructTag);
- writer.Char (Space); writer.String (BaseTag); writer.Char (Semicolon); writer.Ln;
- END;
- ELSIF type(SyntaxTree.RecordType).isObject THEN
- writer.String (BaseObjectName); writer.Char (Space); writer.String (BaseTag); writer.Char (Semicolon); writer.Ln;
- ELSIF type(SyntaxTree.RecordType).recordScope.numberVariables = 0 THEN
- writer.String ("char dummy;"); writer.Ln;
- END;
- DefineVariables (type(SyntaxTree.RecordType).recordScope);
- DEC (indent); writer.Char (RightBrace); writer.Char (Semicolon); writer.Ln;
- writer.Ln; writer.String ("struct "); writer.String (name); writer.String (PointerTag);
- writer.Char (Space); writer.Char (LeftBrace); writer.Ln; INC (indent);
- PrintIndent; writer.String ("void* "); writer.String (TypeDescriptorTag); writer.Char (Semicolon); writer.Ln;
- PrintIndent; writer.String ("struct "); PrintType (FALSE, type(SyntaxTree.RecordType), ""); writer.String (StructTag); writer.Char (Space); writer.String ("record"); writer.Char (Semicolon); writer.Ln;
- DEC (indent); writer.Char (RightBrace); writer.Char (Semicolon); writer.Ln;
- ELSIF type IS SyntaxTree.EnumerationType THEN
- writer.String ("typedef int "); PrintType (FALSE, type, ""); writer.Char (Semicolon); writer.Ln;
- ELSIF ~(type IS SyntaxTree.PointerType) OR IsStaticArray (type(SyntaxTree.PointerType).pointerBase.resolved) THEN
- writer.String ("typedef "); PrintType (FALSE, type, name); writer.Char (Semicolon); writer.Ln;
- END;
- END DefineType;
- BEGIN
- typeDeclaration := scope.firstTypeDeclaration;
- IF typeDeclaration # NIL THEN writer.Ln END;
- WHILE typeDeclaration # NIL DO
- DeclareType (typeDeclaration.declaredType);
- typeDeclaration := typeDeclaration.nextTypeDeclaration;
- END;
- NEW (types, 100); count := 0;
- typeDeclaration := scope.firstTypeDeclaration;
- WHILE typeDeclaration # NIL DO
- DefineType (typeDeclaration.declaredType, TRUE);
- typeDeclaration := typeDeclaration.nextTypeDeclaration;
- END;
- END DefineTypes;
- PROCEDURE DefineVariables (scope: SyntaxTree.Scope);
- VAR variable: SyntaxTree.Variable; name: Identifier;
- BEGIN
- variable := scope.firstVariable;
- IF scope IS SyntaxTree.ModuleScope THEN
- GetScopeName (scope, name, backend.style); writer.Ln; PrintIndent; writer.String (BaseObjectName);
- writer.Char (Space); writer.String (name); writer.String (StructTag); writer.Char (Semicolon); writer.Ln;
- ELSIF variable # NIL THEN writer.Ln END;
- WHILE variable # NIL DO
- GetSymbolName (variable, name, backend.style); PrintIndent;
- PrintVariable (FALSE, name, variable.type); writer.Char (Semicolon); writer.Ln;
- IF IsDelegate (variable.type.resolved) THEN
- PrintIndent; writer.String (BaseObjectName); writer.Char ('*'); writer.Char (' ');
- writer.String (name); writer.String (DelegateTag); writer.Char (Semicolon); writer.Ln;
- END;
- variable := variable.nextVariable;
- END;
- END DefineVariables;
- PROCEDURE DefineProcedures (scope: SyntaxTree.Scope);
- VAR procedure: SyntaxTree.Procedure;
- BEGIN
- procedure := scope.firstProcedure;
- WHILE procedure # NIL DO
- IF ~IsInlineAssemblyCode (procedure) THEN
- DefineConstants (procedure.procedureScope);
- DefineTypes (procedure.procedureScope);
- DeclareProcedures (procedure.procedureScope);
- writer.Ln; PrintComments (procedure.comment, procedure);
- PrintProcedure (procedure); writer.Ln;
- PrintBody (procedure, procedure.procedureScope.body, procedure.procedureScope.firstVariable);
- DefineProcedures (procedure.procedureScope);
- END;
- procedure := procedure.nextProcedure;
- END;
- END DefineProcedures;
- PROCEDURE DefineObjects (scope: SyntaxTree.Scope);
- VAR typeDeclaration: SyntaxTree.TypeDeclaration; record: SyntaxTree.RecordType;
- BEGIN
- typeDeclaration := scope.firstTypeDeclaration;
- WHILE typeDeclaration # NIL DO
- record := GetRecord (typeDeclaration.declaredType);
- IF record # NIL THEN DefineDescriptor (record); DefineProcedures (record.recordScope) END;
- typeDeclaration := typeDeclaration.nextTypeDeclaration;
- END;
- END DefineObjects;
- PROCEDURE DefineDescriptor (record: SyntaxTree.RecordType);
- VAR name: Identifier; method: LONGINT; procedure: SyntaxTree.Procedure;
- BEGIN
- GetSymbolName (record.typeDeclaration, name, backend.style);
- writer.Ln; writer.String (name); writer.String (TypeTag); writer.Char (Space); writer.String (name);
- writer.String (TypeDescriptorTag); INC (indent); writer.String (" = {"); writer.Ln; PrintIndent;
- IF record.baseType # NIL THEN writer.Char ('&'); PrintType (FALSE, record.baseType, ""); writer.String (TypeDescriptorTag);
- ELSIF record.isObject THEN writer.Char ('&'); writer.String (BaseObjectName); writer.String (TypeDescriptorTag);
- ELSE writer.Char ('0'); END; writer.Char (Comma); writer.Ln;
- FOR method := 0 TO record.recordScope.numberMethods - 1 DO
- procedure := GetRecordMethod (record, method);
- GetSymbolName (procedure, name, backend.style); PrintIndent; writer.String (name); writer.Char (Comma); writer.Ln;
- END;
- DEC (indent); writer.Char ('}'); writer.Char (Semicolon); writer.Ln;
- END DefineDescriptor;
- PROCEDURE BeginBlock;
- BEGIN PrintIndent; writer.Char (LeftBrace); writer.Ln; INC (indent);
- END BeginBlock;
- PROCEDURE EndBlock;
- BEGIN DEC (indent); PrintIndent; writer.Char (RightBrace); writer.Ln;
- END EndBlock;
- PROCEDURE AccessBase (record, base: SyntaxTree.RecordType);
- BEGIN
- WHILE (record # base) & (record # NIL) DO
- IF (record.baseType # NIL) OR record.isObject THEN
- writer.Char ('.'); writer.String (BaseTag);
- END;
- record := record.GetBaseRecord ();
- END;
- END AccessBase;
- PROCEDURE BeginRuntimeCall (CONST module, procedure: ARRAY OF CHAR);
- VAR identifier: Identifier;
- BEGIN
- COPY (module, identifier); FixIdentifier (identifier, backend.style); writer.String (identifier); writer.Char ('_');
- COPY (procedure, identifier); FixIdentifier (identifier, backend.style); writer.String (identifier);
- writer.Char (' '); writer.Char ('(');
- END BeginRuntimeCall;
- PROCEDURE EndRuntimeCall;
- BEGIN
- writer.Char (')'); writer.Char (';');
- END EndRuntimeCall;
- PROCEDURE Trace (expression: SyntaxTree.Expression);
- VAR name: Identifier; printer: Printout.Printer; pos: LONGINT;
- BEGIN
- BeginRuntimeCall (backend.traceModule, "String"); writer.Char ('"'); pos := writer.Pos ();
- currentProcedureScope.ownerModule.GetName (name); writer.String (name); writer.Char ('@');
- writer.Int (expression.position.start, 0); writer.Char (':'); writer.Char (' ');
- printer := Printout.NewPrinter (writer, Printout.SourceCode, FALSE);
- printer.Expression (expression); writer.Char (' '); writer.Char ('=');
- writer.Char (' '); writer.Char ('"'); writer.Char (','); writer.Char (' ');
- writer.Int (writer.Pos () - pos - 3, 0); EndRuntimeCall;
- IF (expression.type.resolved IS SyntaxTree.IntegerType) OR (expression.type.resolved IS SyntaxTree.SizeType) THEN
- BeginRuntimeCall (backend.traceModule, "Int");
- PrintExpression (expression); writer.String (", 0"); EndRuntimeCall;
- ELSIF expression.type.resolved IS SyntaxTree.BooleanType THEN
- BeginRuntimeCall (backend.traceModule, "Boolean");
- PrintExpression (expression); EndRuntimeCall;
- ELSIF expression.type.resolved IS SyntaxTree.SetType THEN
- BeginRuntimeCall (backend.traceModule, "Bits");
- PrintExpression (expression); writer.String (", 0, ");
- writer.Int (expression.type.resolved.sizeInBits, 0); EndRuntimeCall;
- ELSIF expression.type.resolved IS SyntaxTree.CharacterType THEN
- BeginRuntimeCall (backend.traceModule, "Char");
- PrintExpression (expression); EndRuntimeCall;
- ELSIF (expression.type.resolved IS SyntaxTree.AddressType) OR (expression.type.resolved IS SyntaxTree.PointerType) THEN
- BeginRuntimeCall (backend.traceModule, "Address");
- PrintExpression (expression); EndRuntimeCall;
- ELSE
- HALT (200);
- END;
- BeginRuntimeCall (backend.traceModule, "Ln"); EndRuntimeCall;
- END Trace;
- PROCEDURE Convert (expression: SyntaxTree.Expression; type: SyntaxTree.Type);
- BEGIN
- IF (expression.type.resolved # type.resolved) & (type.resolved IS SyntaxTree.PointerType) & (type.resolved(SyntaxTree.PointerType).pointerBase.resolved IS SyntaxTree.RecordType) & (expression.type.resolved IS SyntaxTree.PointerType) THEN
- writer.Char ('('); PrintType (FALSE, expression.type.resolved, ""); writer.Char (')'); writer.Char (Space);
- END;
- PrintExpression (expression);
- END Convert;
- PROCEDURE LockScope (scope: SyntaxTree.Scope);
- VAR name: Identifier;
- BEGIN
- PrintIndent; writer.String ("LockObject (&");
- IF scope IS SyntaxTree.RecordScope THEN
- PrintSelf; writer.String ("->record");
- AccessBase (scope(SyntaxTree.RecordScope).ownerRecord, NIL);
- ELSIF scope IS SyntaxTree.ModuleScope THEN
- GetScopeName (scope, name, backend.style);
- writer.String (name); writer.String (StructTag);
- END;
- writer.Char (')'); writer.Char (Semicolon); writer.Ln;
- END LockScope;
- PROCEDURE UnlockScope (scope: SyntaxTree.Scope);
- VAR name: Identifier;
- BEGIN
- IF scope IS SyntaxTree.RecordScope THEN
- PrintIndent; writer.String ("UnlockObject (&"); PrintSelf; writer.String ("->record");
- AccessBase (scope(SyntaxTree.RecordScope).ownerRecord, NIL);
- writer.Char (')'); writer.Char (Semicolon); writer.Ln;
- ELSIF scope IS SyntaxTree.ModuleScope THEN
- GetScopeName (scope, name, backend.style); PrintIndent; writer.String ("UnlockObject (&"); writer.String (name); writer.String (StructTag); writer.Char (')'); writer.Char (Semicolon); writer.Ln;
- END;
- END UnlockScope;
- PROCEDURE CompareTypeDescriptor (expression: SyntaxTree.Expression; type: SyntaxTree.Type);
- VAR name: Identifier;
- BEGIN
- writer.String ("IsBase (");
- IF expression.type.resolved IS SyntaxTree.PointerType THEN
- PrintExpression (expression); writer.String ("->"); writer.String (TypeDescriptorTag);
- IF ~type.resolved(SyntaxTree.PointerType).pointerBase.resolved(SyntaxTree.RecordType).isObject THEN
- type := type.resolved(SyntaxTree.PointerType).pointerBase.resolved;
- END;
- ELSIF (expression.type.resolved IS SyntaxTree.AnyType) THEN
- writer.String ("(*(void**) "); PrintExpression (expression); writer.Char (')');
- ELSIF expression.type.resolved IS SyntaxTree.RecordType THEN
- IF (expression IS SyntaxTree.SymbolDesignator) & (expression(SyntaxTree.SymbolDesignator).symbol IS SyntaxTree.Parameter) THEN
- GetSymbolName (expression(SyntaxTree.SymbolDesignator).symbol, name, backend.style); writer.String (name);
- ELSE
- PrintType (FALSE, expression.type, "");
- END;
- writer.String (TypeDescriptorTag);
- ELSIF expression.type.resolved IS SyntaxTree.ObjectType THEN
- PrintExpression (expression); writer.String ("->"); writer.String (TypeDescriptorTag);
- END;
- writer.String (", &"); GetSymbolName (type.resolved.typeDeclaration, name, backend.style);
- writer.String (name); writer.String (TypeDescriptorTag); writer.String (')');
- END CompareTypeDescriptor;
- PROCEDURE PrintIndent;
- VAR indent: Indent;
- BEGIN indent := SELF.indent; WHILE indent > 0 DO writer.Char (Tab); DEC (indent); END;
- END PrintIndent;
- PROCEDURE PrintInclude (CONST filename: ARRAY OF CHAR);
- BEGIN writer.String ('#include "'); writer.String (filename); writer.String ('"'); writer.Ln;
- END PrintInclude;
- PROCEDURE PrintComment (CONST comment: ARRAY OF CHAR);
- VAR i, len: LONGINT; ch: CHAR; pragma: BOOLEAN;
- BEGIN
- IF Strings.StartsWith2("#pragma", comment) THEN
- pragma := TRUE
- ELSE pragma := FALSE
- END;
- PrintIndent;
- IF ~pragma THEN writer.String("/*") END;
- i := 0; len := LEN (comment);
- LOOP
- ch := comment[i]; INC (i);
- IF (i = len) OR (ch = 0X) THEN EXIT END;
- IF ch = 0AX THEN writer.Ln; PrintIndent;
- ELSIF ch # 0DX THEN writer.Char(ch) END;
- END;
- IF ~pragma THEN writer.String("*/") END;
- writer.Ln;
- END PrintComment;
- PROCEDURE PrintComments (comment: SyntaxTree.Comment; item: OBJECT);
- BEGIN
- WHILE (comment # NIL) & (comment.item = item) DO
- PrintComment (comment.source^);
- comment := comment.nextComment;
- END;
- END PrintComments;
- PROCEDURE PrintProcedure (procedure: SyntaxTree.Procedure);
- VAR name: Identifier; procedureType: SyntaxTree.ProcedureType;
- BEGIN
- GetSymbolName (procedure, name, backend.style); procedureType := procedure.type(SyntaxTree.ProcedureType);
- PrintType (FALSE, procedureType.returnType, name);
- PrintParameters (procedureType, procedure.scope);
- ASSERT ((procedureType.returnType = NIL) OR (~IsDelegate (procedureType.returnType.resolved)));
- END PrintProcedure;
- PROCEDURE PrintParameter (symbol: SyntaxTree.Symbol; nested: BOOLEAN);
- VAR name: Identifier; type: SyntaxTree.Type; index: LONGINT;
- BEGIN
- GetSymbolName (symbol, name, backend.style); type := symbol.type;
- PrintVariable (IsVarParameter (symbol) & ~IsOpenArray (type) OR nested, name, type);
- IF type.resolved IS SyntaxTree.RecordType THEN
- writer.String (", void* "); writer.String (name); writer.String (TypeDescriptorTag);
- END;
- index := 0;
- WHILE IsOpenArray (type) DO
- writer.String (", int "); writer.String (name); writer.String (LenTag);
- writer.Int (index, 0); type := type(SyntaxTree.ArrayType).arrayBase; INC (index);
- END;
- IF IsDelegate (type.resolved) THEN
- writer.Char (Comma); writer.Char (Space); writer.String (BaseObjectName); writer.Char ('*');
- writer.Char (' '); writer.String (name); writer.String (DelegateTag);
- END;
- END PrintParameter;
- PROCEDURE PrintParameters (procedureType: SyntaxTree.ProcedureType; scope: SyntaxTree.Scope);
- VAR first: BOOLEAN; name: Identifier; outerScope: SyntaxTree.Scope;
- VAR parameter: SyntaxTree.Parameter; variable: SyntaxTree.Variable;
- BEGIN
- writer.Char (Space); writer.Char ('('); first := TRUE;
- parameter := procedureType.firstParameter;
- WHILE parameter # NIL DO
- IF first THEN first := FALSE ELSE writer.Char (Comma); writer.Char (Space); END;
- PrintParameter (parameter, FALSE);
- parameter := parameter.nextParameter;
- END;
- outerScope := scope;
- WHILE (outerScope # NIL) & (outerScope IS SyntaxTree.ProcedureScope) DO
- parameter := outerScope(SyntaxTree.ProcedureScope).ownerProcedure.type(SyntaxTree.ProcedureType).firstParameter;
- WHILE parameter # NIL DO
- IF first THEN first := FALSE ELSE writer.Char (Comma); writer.Char (Space); END;
- PrintParameter (parameter, TRUE);
- parameter := parameter.nextParameter;
- END;
- variable := outerScope.firstVariable;
- WHILE variable # NIL DO
- IF first THEN first := FALSE ELSE writer.Char (Comma); writer.Char (Space); END;
- PrintParameter (variable, TRUE);
- variable := variable.nextVariable;
- END;
- outerScope := outerScope.outerScope;
- END;
- IF IsDelegate (procedureType.resolved) & (scope = NIL) THEN
- IF first THEN first := FALSE ELSE writer.Char (Comma); writer.Char (Space); END;
- writer.String (BaseObjectName); writer.Char ('*'); writer.Char (' ');
- writer.String (name); writer.String (DelegateTag);
- END;
- WHILE scope # NIL DO
- IF scope IS SyntaxTree.RecordScope THEN
- IF first THEN first := FALSE ELSE writer.Char (Comma); writer.Char (Space); END;
- PrintType (FALSE, scope(SyntaxTree.RecordScope).ownerRecord, ""); writer.Char (Space); PrintSelf; scope := NIL;
- ELSE
- scope := scope.outerScope;
- END;
- END;
- writer.Char (')');
- END PrintParameters;
- PROCEDURE PrintArgument (argument: SyntaxTree.Expression; parameter: SyntaxTree.Symbol; nested: BOOLEAN);
- VAR argumentType, parameterType: SyntaxTree.Type; index: LONGINT; name: Identifier; isEmptyRecord: BOOLEAN;
- BEGIN
- parameterType := parameter.type; index := 0;
- IF argument = NIL THEN argumentType := parameterType.resolved ELSE argumentType := argument.type.resolved END;
- isEmptyRecord := (parameterType.resolved IS SyntaxTree.RecordType) & IsEmptyRecord (parameterType.resolved(SyntaxTree.RecordType));
- IF IsVarParameter (parameter) & ~IsOpenArray(parameterType) & ~(argumentType.resolved IS SyntaxTree.StringType) OR nested THEN
- IF isEmptyRecord THEN writer.Char ('0'); ELSE writer.Char ('&');
- END;
- ELSIF IsOpenArray (parameterType) & (parameterType(SyntaxTree.ArrayType).arrayBase.resolved IS SyntaxTree.ByteType) THEN
- writer.String ("*("); PrintType (TRUE, argumentType, ""); writer.String (") &");
- END;
- IF ~isEmptyRecord THEN
- IF argument = NIL THEN GetSymbolName (parameter, name, backend.style); writer.String (name) ELSE PrintExpression (argument) END;
- END;
- IF parameterType.resolved IS SyntaxTree.RecordType THEN
- IF ~isEmptyRecord THEN
- AccessBase (argumentType(SyntaxTree.RecordType), parameterType.resolved(SyntaxTree.RecordType));
- END;
- writer.Char (Comma); writer.Char (Space);
- IF (argument # NIL) & (argument IS SyntaxTree.SymbolDesignator) & (argument(SyntaxTree.SymbolDesignator).symbol IS SyntaxTree.Parameter) THEN
- GetSymbolName (argument(SyntaxTree.SymbolDesignator).symbol, name, backend.style);
- writer.String(name); writer.String (TypeDescriptorTag);
- ELSE
- writer.Char ('&'); PrintType (FALSE, argumentType, ""); writer.String (TypeDescriptorTag);
- END;
- END;
- WHILE IsOpenArray (parameterType) DO
- writer.Char (Comma); writer.Char (Space);
- IF argument = NIL THEN
- GetSymbolName (parameter, name, backend.style); writer.String (name);
- writer.String (LenTag); writer.Int (index, 0);
- ELSIF argumentType IS SyntaxTree.StringType THEN
- writer.Int (argumentType(SyntaxTree.StringType).length, 0);
- ELSIF parameterType(SyntaxTree.ArrayType).arrayBase.resolved IS SyntaxTree.ByteType THEN
- writer.String ("sizeof ("); PrintType (FALSE, argumentType, ""); writer.Char (')');
- ELSIF ~IsOpenArray (argumentType) THEN
- writer.Int (argumentType(SyntaxTree.ArrayType).staticLength, 0);
- ASSERT (argumentType IS SyntaxTree.ArrayType);
- ASSERT (argumentType(SyntaxTree.ArrayType).arrayBase # NIL);
- argumentType := argumentType(SyntaxTree.ArrayType).arrayBase.resolved;
- ELSIF (argument IS SyntaxTree.SymbolDesignator) & (argument(SyntaxTree.SymbolDesignator).symbol IS SyntaxTree.Parameter) THEN
- PrintExpression (argument); writer.String (LenTag); writer.Int (index, 0);
- ELSIF argument IS SyntaxTree.DereferenceDesignator THEN
- PrintExpression (argument(SyntaxTree.DereferenceDesignator).left);
- writer.String ("->length["); writer.Int (index, 0); writer.Char (']');
- END;
- parameterType := parameterType(SyntaxTree.ArrayType).arrayBase; INC (index);
- END;
- IF IsDelegate (parameterType.resolved) THEN
- writer.Char (Comma); writer.Char (Space); PrintDelegate (argument);
- END;
- END PrintArgument;
- PROCEDURE PrintArguments (arguments: SyntaxTree.ExpressionList; index, count: LONGINT; parameter: SyntaxTree.Parameter; outerScope: SyntaxTree.Scope): BOOLEAN;
- VAR first: BOOLEAN; variable: SyntaxTree.Variable;
- BEGIN
- first := TRUE;
- WHILE count # 0 DO
- IF first THEN first := FALSE ELSE writer.Char (Comma); writer.Char (Space); END;
- PrintArgument (arguments.GetExpression (index), parameter, FALSE);
- INC (index); DEC (count); parameter := parameter.nextParameter;
- END;
- WHILE (outerScope # NIL) & (outerScope IS SyntaxTree.ProcedureScope) DO
- parameter := outerScope(SyntaxTree.ProcedureScope).ownerProcedure.type(SyntaxTree.ProcedureType).firstParameter;
- WHILE parameter # NIL DO
- IF first THEN first := FALSE ELSE writer.Char (Comma); writer.Char (Space); END;
- PrintArgument (NIL, parameter, outerScope = currentProcedureScope);
- parameter := parameter.nextParameter;
- END;
- variable := outerScope.firstVariable;
- WHILE variable # NIL DO
- IF first THEN first := FALSE ELSE writer.Char (Comma); writer.Char (Space); END;
- PrintArgument (NIL, variable, outerScope = currentProcedureScope);
- variable := variable.nextVariable;
- END;
- outerScope := outerScope.outerScope;
- END;
- RETURN first;
- END PrintArguments;
- PROCEDURE PrintSelf;
- VAR self: Identifier;
- BEGIN
- IF backend.style = StailaStyle THEN writer.String ("_this");
- ELSE Basic.GetString(Global.SelfParameterName,self); FixIdentifier (self, backend.style); writer.String (self); END;
- END PrintSelf;
- PROCEDURE PrintDelegate (expression: SyntaxTree.Expression);
- VAR designator: SyntaxTree.SymbolDesignator;
- BEGIN
- IF IsDelegate (expression.type.resolved) & (expression IS SyntaxTree.SymbolDesignator) THEN
- designator := expression(SyntaxTree.SymbolDesignator);
- IF (designator.left # NIL) & (designator.symbol IS SyntaxTree.Procedure) THEN
- PrintExpression (designator.left(SyntaxTree.DereferenceDesignator).left);
- ELSE
- PrintExpression (designator); writer.String (DelegateTag);
- END;
- ELSE
- writer.Char ('0');
- END;
- END PrintDelegate;
- PROCEDURE PrintBody (procedure: SyntaxTree.Procedure; body: SyntaxTree.Body; variable: SyntaxTree.Variable);
- VAR name: Identifier;
- BEGIN
- BeginBlock;
- WHILE variable # NIL DO
- GetSymbolName (variable, name, backend.style);
- PrintIndent; PrintVariable (FALSE, name, variable.type);
- IF initializeLocalData THEN
- IF variable.type.resolved IS SyntaxTree.ArrayType THEN
- writer.String (" = {0}");
- ELSIF variable.type.resolved IS SyntaxTree.RecordType THEN
- IF ~IsEmptyRecord (variable.type.resolved(SyntaxTree.RecordType)) THEN writer.String (" = {0}") END;
- ELSE
- writer.String (" = 0");
- END;
- END;
- writer.Char (Semicolon); writer.Ln;
- IF IsDelegate (variable.type.resolved) THEN
- PrintIndent; writer.String (BaseObjectName); writer.Char ('*'); writer.Char (' ');
- writer.String (name); writer.String (DelegateTag);
- IF initializeLocalData THEN writer.String (" = 0") END;
- writer.Char (Semicolon); writer.Ln;
- END;
- variable := variable.nextVariable;
- END;
- IF body # NIL THEN
- IF body.code # NIL THEN
- PrintCode (body.code);
- ELSE
- currentProcedureScope := body.inScope;
- IF procedure = procedure.procedureScope.ownerModule.moduleScope.bodyProcedure THEN
- GetScopeName (procedure.procedureScope.ownerModule.moduleScope, name, backend.style); PrintIndent; writer.String ("InitObject (&");
- writer.String (name); writer.String (StructTag); writer.Char (')'); writer.Char (Semicolon); writer.Ln;
- END;
- PrintStatement (body);
- IF body.isActive THEN
- PrintIndent; writer.String ("Objects_Terminate ();"); writer.Ln;
- END;
- END;
- END;
- EndBlock;
- END PrintBody;
- PROCEDURE PrintType (pointer: BOOLEAN; type: SyntaxTree.Type; CONST name: ARRAY OF CHAR);
- PROCEDURE Prefix (type: SyntaxTree.Type);
- VAR temp: Identifier;
- BEGIN
- IF type = NIL THEN writer.String ("void");
- ELSIF type IS SyntaxTree.ArrayType THEN Prefix (type(SyntaxTree.ArrayType).arrayBase);
- ELSIF type IS SyntaxTree.PointerType THEN
- writer.String ("struct ");
- IF type(SyntaxTree.PointerType).pointerBase.resolved IS SyntaxTree.ArrayType THEN
- writer.String ("Array");
- ELSE
- GetSymbolName (type(SyntaxTree.PointerType).pointerBase.resolved.typeDeclaration, temp, backend.style);
- writer.String (temp);
- END;
- writer.String (PointerTag); writer.String (" (*");
- ELSIF type IS SyntaxTree.ProcedureType THEN Prefix (type(SyntaxTree.ProcedureType).returnType);
- ELSIF type.resolved.typeDeclaration # NIL THEN GetSymbolName (type.resolved.typeDeclaration, temp, backend.style); writer.String (temp);
- ELSIF type.resolved IS SyntaxTree.ObjectType THEN writer.String ("ObjectType");
- ELSE PrintBasicType (type.resolved(SyntaxTree.BasicType)); END;
- IF name # "" THEN writer.Char (Space) END;
- END Prefix;
- PROCEDURE Infix (type: SyntaxTree.Type);
- BEGIN
- IF type = NIL THEN IF pointer THEN writer.Char ('('); writer.Char ('*'); writer.String (name); writer.Char (')') ELSE writer.String (name) END
- ELSIF type IS SyntaxTree.ArrayType THEN Infix (type(SyntaxTree.ArrayType).arrayBase);
- ELSIF type IS SyntaxTree.PointerType THEN Infix (type(SyntaxTree.PointerType).pointerBase);
- ELSIF type IS SyntaxTree.ProcedureType THEN writer.Char ('('); writer.Char ('*'); IF pointer THEN writer.Char ('*') END; writer.String (name);
- ELSE IF pointer THEN writer.Char ('('); writer.Char ('*'); writer.String (name); writer.Char (')') ELSE writer.String (name) END
- END;
- END Infix;
- PROCEDURE Postfix (type: SyntaxTree.Type);
- BEGIN
- IF type = NIL THEN
- ELSIF type IS SyntaxTree.ArrayType THEN
- ASSERT (~IsDelegate (type(SyntaxTree.ArrayType).arrayBase.resolved));
- writer.Char ('['); IF type(SyntaxTree.ArrayType).staticLength # 0 THEN writer.Int (type(SyntaxTree.ArrayType).staticLength, 0); END; writer.Char (']');
- Postfix (type(SyntaxTree.ArrayType).arrayBase);
- ELSIF type IS SyntaxTree.PointerType THEN writer.Char (')');
- ELSIF type IS SyntaxTree.ProcedureType THEN writer.Char (')'); PrintParameters (type(SyntaxTree.ProcedureType), NIL);
- END;
- END Postfix;
- BEGIN
- Prefix (type); Infix (type); Postfix (type);
- END PrintType;
- PROCEDURE PrintBasicType (type: SyntaxTree.BasicType);
- VAR i: LONGINT;
- BEGIN
- IF type IS SyntaxTree.AddressType THEN
- writer.String ("size_t");
- ELSIF type IS SyntaxTree.SizeType THEN
- writer.String ("size_t");
- ELSIF type IS SyntaxTree.ByteType THEN
- IF type.sizeInBits = 8 THEN
- IF backend.style = StailaStyle THEN writer.String ("int8_t") ELSE writer.String ("Byte") END;
- ELSE
- HALT (1234);
- END;
- ELSIF type IS SyntaxTree.CharacterType THEN
- IF type.sizeInBits = 8 THEN
- IF backend.style = StailaStyle THEN writer.String ("char") ELSE writer.String ("Char") END;
- ELSE
- HALT (1234);
- END;
- ELSIF type IS SyntaxTree.BooleanType THEN
- IF backend.style = StailaStyle THEN writer.String ("bool") ELSE writer.String ("Boolean") END;
- ELSIF type IS SyntaxTree.IntegerType THEN
- IF type.sizeInBits = 8 THEN
- IF backend.style = StailaStyle THEN writer.String ("int8_t") ELSE writer.String ("ShortInt") END;
- ELSIF type.sizeInBits = 16 THEN
- IF backend.style = StailaStyle THEN writer.String ("int16_t") ELSE writer.String ("Integer") END;
- ELSIF type.sizeInBits = 32 THEN
- IF backend.style = StailaStyle THEN writer.String ("int32_t") ELSE writer.String ("LongInt") END;
- ELSIF type.sizeInBits = 64 THEN
- IF backend.style = StailaStyle THEN writer.String ("int64_t") ELSE writer.String ("HugeInt") END;
- ELSE
- HALT (1234);
- END;
- ELSIF type IS SyntaxTree.FloatType THEN
- IF type.sizeInBits = 32 THEN
- IF backend.style = StailaStyle THEN writer.String ("float") ELSE writer.String ("Real") END;
- ELSIF type.sizeInBits = 64 THEN
- IF backend.style = StailaStyle THEN writer.String ("double") ELSE writer.String ("LongReal") END;
- ELSE
- HALT (1234);
- END;
- ELSIF type IS SyntaxTree.SetType THEN
- IF type.sizeInBits = backend.addressSize THEN
- IF backend.style = StailaStyle THEN writer.String ("size_t") ELSE writer.String ("Set") END;
- ELSE
- HALT (1234);
- END;
- ELSIF type IS SyntaxTree.NilType THEN
- writer.String ("void*");
- ELSIF type IS SyntaxTree.AnyType THEN
- writer.String ("void*");
- ELSE
- HALT (1234);
- END;
- END PrintBasicType;
- PROCEDURE PrintVariable (variable: BOOLEAN; CONST name: ARRAY OF CHAR; type: SyntaxTree.Type);
- BEGIN PrintType (variable, type, name);
- END PrintVariable;
- PROCEDURE PrintCharacter (value: CHAR);
- BEGIN
- writer.Char ("'");
- IF value = "'" THEN
- writer.String ("\'");
- ELSIF (ORD (value) >= 32) & (ORD (value) < 127) THEN
- writer.Char (value);
- ELSE
- writer.String ("\x"); writer.Hex (ORD (value), 0);
- END;
- writer.Char ("'");
- END PrintCharacter;
- PROCEDURE PrintNew (arguments: SyntaxTree.ExpressionList);
- VAR designator: SyntaxTree.Expression; type: SyntaxTree.Type; name: Identifier;
- VAR procedure: SyntaxTree.Procedure; recordType: SyntaxTree.RecordType; first: BOOLEAN;
- BEGIN
- designator := arguments.GetExpression (0);
- type := designator.type.resolved(SyntaxTree.PointerType).pointerBase.resolved;
- IF (type IS SyntaxTree.ArrayType) & (arguments.Length () > 1) THEN
- ASSERT (arguments.Length () = 2);
- ASSERT (type(SyntaxTree.ArrayType).staticLength = 0);
- PrintExpression (designator); writer.String (" = ("); PrintType (FALSE, designator.type, "");
- writer.String (") calloc (1, "); PrintExpression (arguments.GetExpression (1)); writer.String (" * sizeof (");
- PrintType (FALSE, type(SyntaxTree.ArrayType).arrayBase, ""); writer.String (") + sizeof (struct Array_pointer))");
- writer.Char (Semicolon); writer.Ln; PrintIndent; PrintExpression (designator);
- writer.String ("->length[0] = "); PrintExpression (arguments.GetExpression (1)); writer.Char (Semicolon);
- ELSE
- PrintExpression (designator); writer.String (" = ("); PrintType (FALSE, designator.type, "");
- writer.String (") calloc (1, sizeof (struct "); PrintType (FALSE, type, ""); writer.String (PointerTag); writer.String ("))");
- END;
- IF type IS SyntaxTree.RecordType THEN
- recordType := type(SyntaxTree.RecordType);
- GetSymbolName (recordType.typeDeclaration, name, backend.style);
- writer.Char (Semicolon); writer.Ln; PrintIndent; PrintExpression (designator); writer.String ("->"); writer.String (TypeDescriptorTag); writer.String (" = &"); writer.String (name); writer.String (TypeDescriptorTag);
- IF recordType.isObject THEN
- writer.Char (Semicolon); writer.Ln; PrintIndent; writer.String ("InitObject (&"); PrintExpression (designator);
- writer.String ("->record"); AccessBase (recordType, NIL); writer.Char (')');
- END;
- procedure := GetConstructor (recordType);
- IF procedure # NIL THEN
- GetSymbolName (procedure, name, backend.style);
- writer.Char (Semicolon); writer.Ln; PrintIndent; writer.String (name); writer.String (" (");
- first := PrintArguments (arguments, 1, arguments.Length () - 1, procedure.type(SyntaxTree.ProcedureType).firstParameter, procedure.scope.outerScope);
- IF first THEN first := FALSE ELSE writer.String (", ") END; PrintExpression (designator); writer.Char (')');
- END;
- REPEAT
- procedure := recordType.recordScope.bodyProcedure;
- IF procedure # NIL THEN
- GetSymbolName (procedure, name, backend.style); writer.Char (Semicolon); writer.Ln; PrintIndent;
- IF procedure.procedureScope.body.isActive THEN
- writer.String ("Activate ((ObjectType) "); PrintExpression (designator);
- writer.String (", "); IF procedure.procedureScope.body.priority # NIL THEN PrintExpression (procedure.procedureScope.body.priority) ELSE writer.Char ('2') END;
- writer.String (", (void (*) (ObjectType)) "); writer.String (name); writer.Char (')');
- ELSE
- writer.String (name); writer.String (" ("); PrintExpression (designator); writer.Char (')');
- END;
- END;
- recordType := recordType.GetBaseRecord ();
- UNTIL recordType = NIL;
- END;
- END PrintNew;
- PROCEDURE PrintStatements (statements: SyntaxTree.StatementSequence);
- VAR i: LONGINT;
- BEGIN
- ASSERT (statements # NIL);
- FOR i := 0 TO statements.Length () - 1 DO PrintStatement (statements.GetStatement (i)); END;
- END PrintStatements;
- PROCEDURE PrintCode (code: SyntaxTree.Code);
- VAR text: Scanner.StringType; i: LONGINT;
- BEGIN
- PrintIndent; writer.String ("__asm ("); writer.Char ('"');
- text := code.sourceCode; i := 0;
- WHILE (text[i] # 0X) & (text[i] # 0AX) DO INC (i); END;
- IF text[i] # 0X THEN INC (i); END;
- WHILE text[i] # 0X DO
- IF text[i] = 0AX THEN
- writer.Char ('\'); writer.Char ('n'); writer.Char ('"'); writer.Char (Space);
- writer.Char ('\'); writer.Ln; INC (indent); PrintIndent; DEC (indent); writer.Char ('"');
- ELSE writer.Char (text[i]); END;
- INC (i);
- END;
- writer.Char ('"'); writer.Char (')'); writer.Char (Semicolon); writer.Ln;
- END PrintCode;
- PROCEDURE PrintIfPart (ifPart: SyntaxTree.IfPart);
- BEGIN
- ASSERT (ifPart # NIL);
- PrintComments (ifPart.comment, ifPart);
- writer.String ("if ("); PrintExpression (ifPart.condition); writer.Char (')'); writer.Ln;
- BeginBlock; PrintStatements (ifPart.statements); EndBlock;
- END PrintIfPart;
- PROCEDURE PrintStatement (statement: SyntaxTree.Statement);
- BEGIN
- ASSERT (statement # NIL);
- PrintComments (statement.comment, statement);
- statement.Accept (SELF);
- END PrintStatement;
- PROCEDURE PrintExpression (expression: SyntaxTree.Expression);
- BEGIN ASSERT (expression # NIL); expression.Accept (SELF);
- END PrintExpression;
- PROCEDURE PrintNegatedExpression (expression: SyntaxTree.Expression);
- BEGIN
- IF (expression IS SyntaxTree.UnaryExpression) & (expression(SyntaxTree.UnaryExpression).operator = Scanner.Not) THEN
- PrintExpression (expression(SyntaxTree.UnaryExpression).left);
- ELSE
- writer.Char ('!'); writer.Char ('('); PrintExpression (expression); writer.Char (')');
- END;
- END PrintNegatedExpression;
- PROCEDURE VisitAssignment* (statement: SyntaxTree.Assignment);
- BEGIN
- PrintIndent;
- IF IsEmptyString (statement.right.type) THEN
- PrintExpression (statement.left); writer.String ("[0] = 0");
- ELSIF IsStructuredType (statement.left.type) THEN
- ASSERT (~IsOpenArray (statement.left.type.resolved));
- writer.String ("memcpy (");
- IF ~(statement.left.type.resolved IS SyntaxTree.ArrayType) THEN writer.Char ('&'); END;
- PrintExpression (statement.left); writer.String (", ");
- IF ~(statement.right.type.resolved IS SyntaxTree.StringType) & ~(statement.right.type.resolved IS SyntaxTree.ArrayType) THEN writer.Char ('&'); END;
- PrintExpression (statement.right); writer.String (", sizeof ("); PrintType (FALSE, statement.left.type, ""); writer.String ("))");
- ELSE
- PrintExpression (statement.left); writer.Char (Space); writer.Char ('='); writer.Char (Space); Convert (statement.right, statement.left.type);
- END;
- writer.Char (Semicolon); writer.Ln;
- IF IsDelegate (statement.left.type.resolved) THEN
- PrintIndent; PrintExpression (statement.left); writer.String (DelegateTag);
- writer.String (" = "); PrintDelegate (statement.right); writer.Char (Semicolon); writer.Ln;
- END;
- END VisitAssignment;
- PROCEDURE VisitIfStatement* (statement: SyntaxTree.IfStatement);
- VAR i: LONGINT;
- BEGIN
- PrintIndent; PrintIfPart (statement.ifPart);
- FOR i := 0 TO statement.ElsifParts () - 1 DO
- PrintIndent; writer.String ("else "); PrintIfPart (statement.GetElsifPart (i));
- END;
- IF statement.elsePart # NIL THEN
- PrintIndent; writer.String ("else"); writer.Ln;
- BeginBlock; PrintStatements (statement.elsePart); EndBlock;
- END;
- END VisitIfStatement;
- PROCEDURE VisitWithStatement* (statement: SyntaxTree.WithStatement);
- VAR withPart: SyntaxTree.WithPart; i: LONGINT;
- BEGIN
- FOR i := 0 TO statement.WithParts () - 1 DO
- withPart := statement.GetWithPart (i); PrintIndent;
- IF i > 0 THEN writer.String ("else ") END;
- writer.String ("if ("); CompareTypeDescriptor (withPart.variable, withPart.type); writer.String (")"); writer.Ln;
- BeginBlock; PrintStatements (withPart.statements); EndBlock;
- END;
- PrintIndent;
- IF statement.elsePart = NIL THEN
- writer.String ("else ASSERT (false);"); writer.Ln;
- ELSE
- writer.String ("else"); writer.Ln;
- BeginBlock; PrintStatements (statement.elsePart); EndBlock;
- END;
- END VisitWithStatement;
- PROCEDURE VisitWhileStatement* (statement: SyntaxTree.WhileStatement);
- BEGIN
- PrintIndent; writer.String ("while ("); PrintExpression (statement.condition); writer.Char (')'); writer.Ln;
- BeginBlock; PrintStatements (statement.statements); EndBlock;
- END VisitWhileStatement;
- PROCEDURE VisitRepeatStatement* (statement: SyntaxTree.RepeatStatement);
- BEGIN
- PrintIndent; writer.String ("do"); writer.Ln;
- BeginBlock; PrintStatements (statement.statements); EndBlock;
- PrintIndent; writer.String ("while ("); PrintNegatedExpression (statement.condition); writer.String (");"); writer.Ln;
- END VisitRepeatStatement;
- PROCEDURE VisitLoopStatement* (statement: SyntaxTree.LoopStatement);
- BEGIN
- PrintIndent; writer.String ("for (;;)"); writer.Ln;
- BeginBlock; PrintStatements (statement.statements); EndBlock;
- END VisitLoopStatement;
- PROCEDURE VisitExitStatement* (statement: SyntaxTree.ExitStatement);
- BEGIN PrintIndent; writer.String ("break;"); writer.Ln;
- END VisitExitStatement;
- PROCEDURE VisitReturnStatement* (statement: SyntaxTree.ReturnStatement);
- CONST ResultVariable = "_result";
- VAR scope: SyntaxTree.ProcedureScope; locked: BOOLEAN;
- BEGIN
- scope := GetStatementProcedure (statement);
- locked := IsInExclusiveBlock (statement);
- IF statement.returnValue # NIL THEN
- IF locked THEN
- BeginBlock; PrintIndent; PrintVariable (FALSE, ResultVariable, statement.returnValue.type.resolved); writer.Char (Semicolon); writer.Ln;
- PrintIndent; writer.String (ResultVariable); writer.String (" = "); PrintExpression (statement.returnValue);
- writer.Char (Semicolon); writer.Ln; UnlockScope (scope.outerScope);
- PrintIndent; writer.String ("return "); writer.String (ResultVariable); writer.Char (Semicolon); writer.Ln; EndBlock;
- ELSE
- PrintIndent; writer.String ("return "); PrintExpression (statement.returnValue); writer.Char (Semicolon); writer.Ln;
- END
- ELSE
- IF locked THEN UnlockScope (scope.outerScope); END;
- PrintIndent; writer.String ("return"); writer.Char (Semicolon); writer.Ln;
- END;
- END VisitReturnStatement;
- PROCEDURE VisitStatementBlock* (statement: SyntaxTree.StatementBlock);
- VAR procedureScope: SyntaxTree.ProcedureScope;
- BEGIN
- procedureScope := GetStatementProcedure (statement);
- IF statement.outer # NIL THEN BeginBlock END;
- IF statement.isExclusive THEN LockScope (procedureScope.outerScope) END;
- PrintStatements (statement.statements);
- IF statement.isExclusive THEN UnlockScope (procedureScope.outerScope) END;
- IF statement.outer # NIL THEN EndBlock END;
- END VisitStatementBlock;
- PROCEDURE VisitAwaitStatement* (statement: SyntaxTree.AwaitStatement);
- VAR procedureScope: SyntaxTree.ProcedureScope; name: Identifier;
- BEGIN
- procedureScope := GetStatementProcedure (statement);
- PrintIndent; writer.String ("while ("); PrintNegatedExpression (statement.condition);
- writer.String (") "); writer.String ("AwaitCondition (&");
- IF procedureScope.outerScope IS SyntaxTree.RecordScope THEN
- PrintSelf; writer.String ("->record");
- AccessBase (procedureScope.outerScope(SyntaxTree.RecordScope).ownerRecord, NIL);
- ELSIF procedureScope.outerScope IS SyntaxTree.ModuleScope THEN
- GetScopeName (procedureScope.outerScope, name, backend.style);
- writer.String (name); writer.String (StructTag);
- END;
- writer.Char (')'); writer.Char (Semicolon); writer.Ln;
- END VisitAwaitStatement;
- PROCEDURE VisitCaseStatement* (statement: SyntaxTree.CaseStatement);
- VAR i, value: LONGINT; casePart: SyntaxTree.CasePart; caseConstant: SyntaxTree.CaseConstant;
- BEGIN
- PrintIndent; writer.String ("switch ("); PrintExpression (statement.variable); writer.Char (')'); writer.Ln;
- BeginBlock;
- FOR i := 0 TO statement.CaseParts () - 1 DO
- casePart := statement.GetCasePart (i);
- PrintComments (casePart.comment, casePart);
- caseConstant := casePart.firstConstant;
- WHILE caseConstant # NIL DO
- FOR value := caseConstant.min TO caseConstant.max DO
- IF (caseConstant = casePart.firstConstant) & (value = caseConstant.min) THEN DEC (indent); PrintIndent; INC (indent); ELSE writer.Char (Space); END;
- writer.String ("case "); writer.Int (value, 0); writer.Char (':');
- END;
- caseConstant := caseConstant.next;
- END;
- writer.Ln; PrintStatements (casePart.statements);
- PrintIndent; writer.String ("break;"); writer.Ln;
- END;
- DEC (indent); PrintIndent; INC (indent); writer.String ("default:"); writer.Ln;
- IF statement.elsePart = NIL THEN
- PrintIndent; writer.String ("ASSERT (false);"); writer.Ln;
- ELSE
- PrintStatements (statement.elsePart);
- PrintIndent; writer.String ("break;"); writer.Ln;
- END;
- EndBlock;
- END VisitCaseStatement;
- PROCEDURE VisitForStatement* (statement: SyntaxTree.ForStatement);
- BEGIN
- PrintIndent; writer.String ("for (");
- PrintExpression (statement.variable); writer.String (" = "); PrintExpression (statement.from); writer.String ("; "); PrintExpression (statement.variable);
- IF (statement.by # NIL) & (statement.by.resolved(SyntaxTree.IntegerValue).value < 0) THEN writer.String (" >= "); ELSE writer.String (" <= "); END;
- PrintExpression (statement.to); writer.String ("; "); PrintExpression (statement.variable); writer.String (" += ");
- IF statement.by = NIL THEN writer.Char ('1'); ELSE PrintExpression (statement.by); END;
- writer.Char (')'); writer.Ln; BeginBlock; PrintStatements (statement.statements); EndBlock;
- END VisitForStatement;
- PROCEDURE VisitProcedureCallStatement* (statement: SyntaxTree.ProcedureCallStatement);
- BEGIN PrintIndent; PrintExpression (statement.call); writer.Char (Semicolon); writer.Ln;
- END VisitProcedureCallStatement;
- PROCEDURE VisitSymbolDesignator* (expression: SyntaxTree.SymbolDesignator);
- VAR name: Identifier; recordType: SyntaxTree.RecordType;
- BEGIN
- recordType := NIL;
- IF (expression.left # NIL) & (expression.left.type.resolved # SyntaxTree.importType) THEN
- IF expression.left.type.resolved IS SyntaxTree.RecordType THEN
- recordType := expression.left.type.resolved(SyntaxTree.RecordType);
- IF expression.symbol IS SyntaxTree.Procedure THEN
- writer.String ("(("); GetSymbolName (recordType.typeDeclaration, name, backend.style); writer.String (name); writer.String (TypeTag); writer.String ("*) ");
- PrintExpression (expression.left(SyntaxTree.DereferenceDesignator).left); writer.String ("->"); writer.String (TypeDescriptorTag); writer.String (")->");
- expression.symbol.GetName(name); FixIdentifier (name, backend.style); writer.String (name); RETURN;
- ELSE
- PrintExpression (expression.left);
- AccessBase (recordType, expression.symbol.scope(SyntaxTree.RecordScope).ownerRecord);
- END;
- ELSE
- PrintExpression (expression.left);
- END;
- writer.Char ('.');
- END;
- GetSymbolName (expression.symbol, name, backend.style);
- IF IsVarParameter (expression.symbol) & ~IsOpenArray (expression.type) OR
- ((expression.symbol IS SyntaxTree.Parameter) OR (expression.symbol IS SyntaxTree.Variable)) &
- (expression.symbol.scope IS SyntaxTree.ProcedureScope) & (expression.symbol.scope # currentProcedureScope) THEN
- writer.Char ('('); writer.Char ('*'); writer.String (name); writer.Char (')');
- ELSE
- writer.String (name);
- END;
- END VisitSymbolDesignator;
- PROCEDURE VisitBuiltinCallDesignator* (expression: SyntaxTree.BuiltinCallDesignator);
- VAR argument: ARRAY 3 OF SyntaxTree.Expression; i: LONGINT; name: Identifier;
- position: LONGINT; typeDeclaration: SyntaxTree.TypeDeclaration;
- BEGIN
- FOR i := 0 TO LEN (argument) - 1 DO
- IF i < expression.parameters.Length () THEN argument[i] := expression.parameters.GetExpression (i); ELSE argument[i] := NIL; END;
- END;
- position := expression.position.start;
- CASE expression.id OF
- | Global.Incl: PrintExpression (argument[0]); writer.String (" |= 1 << ("); PrintExpression (argument[1]); writer.Char (')');
- | Global.Excl: PrintExpression (argument[0]); writer.String (" &= ~(1 << ("); PrintExpression (argument[1]); writer.Char (')'); writer.Char (')');
- | Global.Inc: PrintExpression (argument[0]); writer.String (" += "); PrintExpression (argument[1]);
- | Global.Dec: PrintExpression (argument[0]); writer.String (" -= "); PrintExpression (argument[1]);
- | Global.Assert: IF argument[0].resolved = NIL THEN writer.String ("ASSERT ("); PrintExpression (argument[0]); writer.Char (')') END;
- | Global.Halt, Global.systemHalt: writer.String ("ASSERT (false)");
- | Global.Ord: PrintExpression (argument[0]);
- | Global.Chr: PrintExpression (argument[0]);
- | Global.Short, Global.Long: writer.Char ('('); PrintType (FALSE, expression.type, ""); writer.Char (')'); writer.Char (Space); PrintExpression (argument[0]);
- | Global.Entier, Global.EntierH: writer.String ("floor ("); PrintExpression (argument[0]); writer.Char (')');
- | Global.Cap: writer.String ("Capitalize ("); PrintExpression (argument[0]); writer.Char (')');
- | Global.Odd: writer.Char ('('); PrintExpression (argument[0]); writer.String (" & 1)");
- | Global.Ash: writer.Char ('('); PrintExpression (argument[0]); IF IsNegative (argument[1]) THEN writer.String (" >> - ") ELSE writer.String (" << ") END; PrintExpression (argument[1]); writer.Char (')');
- | Global.Abs: IF (expression.type.resolved IS SyntaxTree.FloatType) THEN writer.Char ('f') END;
- writer.String ("abs ("); PrintExpression (argument[0]); writer.Char (')');
- | Global.Min, Global.Max: PrintExpression (expression.resolved);
- | Global.New: PrintNew (expression.parameters);
- | Global.Dispose: writer.String ("Dispose (&"); PrintExpression (argument[0]); writer.Char (')');
- | Global.Len:
- IF argument[0] IS SyntaxTree.DereferenceDesignator THEN PrintExpression (argument[0](SyntaxTree.DereferenceDesignator).left); writer.String ("->length[0]");
- ELSE PrintExpression (argument[0]); writer.String (LenTag); writer.Char ('0') END;
- | Global.Copy: writer.String ("strcpy ("); PrintExpression (argument[1]); writer.String (", "); PrintExpression (argument[0]); writer.Char (')');
- | Global.systemAdr: writer.String ("(("); PrintType (FALSE, backend.system.addressType, ""); writer.String (") &"); PrintExpression (argument[0]); writer.Char (')');
- | Global.systemGet: PrintExpression (argument[1]); writer.String (" = *(("); PrintType (TRUE, argument[1].type, ""); writer.String (") "); PrintExpression (argument[0]); writer.Char (')');
- | Global.systemGet8, Global.systemGet16, Global.systemGet32, Global.systemGet64:
- writer.String ("*(("); PrintType (TRUE, expression.type, ""); writer.String (") "); PrintExpression (argument[0]); writer.Char (')');
- | Global.systemPut, Global.systemPut8, Global.systemPut16, Global.systemPut32, Global.systemPut64:
- writer.String ("*(("); PrintType (TRUE, argument[1].type, ""); writer.String (") "); PrintExpression (argument[0]); writer.String (") = "); PrintExpression (argument[1]);
- | Global.systemMove: writer.String ("memcpy ("); PrintExpression (argument[1]); writer.String (", "); PrintExpression (argument[0]); writer.String (", "); PrintExpression (argument[2]); writer.Char (')');
- | Global.systemVal:
- IF (argument[1] IS SyntaxTree.SymbolDesignator) & (argument[1].resolved = NIL) THEN
- writer.String ("*(("); PrintType (TRUE, GetDeclaredType (argument[0]), ""); writer.String (") &"); PrintExpression (argument[1]); writer.Char (')');
- ELSE
- writer.String ("("); PrintType (FALSE, GetDeclaredType (argument[0]), ""); writer.String (") "); PrintExpression (argument[1]);
- END;
- | Global.Lsh: writer.Char ('('); PrintExpression (argument[0]); IF IsNegative (argument[1]) THEN writer.String (" >> - ") ELSE writer.String (" << ") END; PrintExpression (argument[1]); writer.Char (')');
- | Global.Rot: writer.String ("(("); PrintExpression (argument[0]); writer.String (" << "); PrintExpression (argument[1]); writer.String (") | (");
- PrintExpression (argument[0]); writer.String (" >> (sizeof ("); PrintType (FALSE, expression.type, ""); writer.String (") * 8 - "); PrintExpression (argument[1]); writer.String (")))");
- | Global.systemSize: writer.String ("sizeof ("); PrintType (FALSE, GetDeclaredType (argument[0]), ""); writer.Char (')');
- | Global.systemTypeCode: typeDeclaration := argument[0](SyntaxTree.SymbolDesignator).symbol(SyntaxTree.TypeDeclaration);
- IF typeDeclaration.declaredType.resolved IS SyntaxTree.PointerType THEN
- typeDeclaration := typeDeclaration.declaredType.resolved(SyntaxTree.PointerType).pointerBase.resolved.typeDeclaration;
- END;
- GetSymbolName (typeDeclaration, name, backend.style); writer.Char ('&'); writer.String (name); writer.String (TypeDescriptorTag);
- | Global.GetProcedure: PrintExpression (argument[2]); writer.String (" = 0");
- |Global.systemTrace: FOR i := 0 TO expression.parameters.Length () - 1 DO Trace (expression.parameters.GetExpression (i)) END;
- END;
- END VisitBuiltinCallDesignator;
- PROCEDURE VisitProcedureCallDesignator* (expression: SyntaxTree.ProcedureCallDesignator);
- VAR procedureType: SyntaxTree.ProcedureType; first: BOOLEAN;
- VAR symbolDesignator: SyntaxTree.SymbolDesignator; scope: SyntaxTree.Scope;
- BEGIN
- IF expression.left IS SyntaxTree.SymbolDesignator THEN
- symbolDesignator := expression.left(SyntaxTree.SymbolDesignator);
- IF symbolDesignator.symbol IS SyntaxTree.Procedure THEN
- scope := symbolDesignator.symbol.scope;
- END;
- ELSE
- symbolDesignator := NIL; scope := NIL;
- END;
- procedureType := expression.left.type.resolved(SyntaxTree.ProcedureType);
- PrintExpression (expression.left); writer.Char (Space); writer.Char ('(');
- first := PrintArguments (expression.parameters, 0, expression.parameters.Length (), procedureType.firstParameter, scope);
- IF (symbolDesignator # NIL) & IsMethod (symbolDesignator) THEN
- IF first THEN first := FALSE ELSE writer.String (", ") END;
- IF symbolDesignator.left # NIL THEN
- PrintExpression (symbolDesignator.left(SyntaxTree.DereferenceDesignator).left);
- ELSE
- PrintSelf;
- END;
- ELSIF expression.left IS SyntaxTree.SupercallDesignator THEN
- IF expression.parameters.Length () > 0 THEN writer.String (", ") END; PrintSelf;
- ELSIF IsDelegate (procedureType) THEN
- IF expression.parameters.Length () > 0 THEN writer.String (", ") END;
- PrintExpression (expression.left); writer.String (DelegateTag);
- END;
- writer.Char (')');
- END VisitProcedureCallDesignator;
- PROCEDURE VisitBooleanValue* (expression: SyntaxTree.BooleanValue);
- BEGIN IF expression.value THEN writer.Char ('1'); ELSE writer.Char ('0'); END;
- END VisitBooleanValue;
- PROCEDURE VisitIntegerValue* (expression: SyntaxTree.IntegerValue);
- BEGIN IF expression.value = expression.hvalue THEN writer.Int (expression.value, 0); ELSE writer.String ("0x"); writer.Hex (expression.hvalue, 0); END;
- END VisitIntegerValue;
- PROCEDURE VisitCharacterValue* (expression: SyntaxTree.CharacterValue);
- BEGIN PrintCharacter (expression.value);
- END VisitCharacterValue;
- PROCEDURE VisitSetValue* (expression: SyntaxTree.SetValue);
- VAR i: INTEGER; mask, value: HUGEINT;
- BEGIN
- mask := 1; value := 0;
- FOR i := MIN (SET) TO MAX (SET) DO IF i IN expression.value THEN INC (value, mask); END; INC (mask, mask); END;
- writer.String ("0x"); writer.Hex (value, 0);
- END VisitSetValue;
- PROCEDURE VisitRealValue* (expression: SyntaxTree.RealValue);
- BEGIN writer.FloatFix (expression.value, 0, 5, 0);
- END VisitRealValue;
- PROCEDURE VisitStringValue* (expression: SyntaxTree.StringValue);
- VAR char: CHAR; i: LONGINT;
- BEGIN
- writer.Char ('"'); i := 0;
- LOOP
- char := expression.value[i];
- IF char = 0X THEN EXIT END;
- IF char = '"' THEN writer.Char ('\') END;
- writer.Char (char); INC (i);
- END;
- writer.Char ('"');
- END VisitStringValue;
- PROCEDURE VisitNilValue* (expression: SyntaxTree.NilValue);
- BEGIN writer.Char ('0');
- END VisitNilValue;
- PROCEDURE VisitEnumerationValue* (expression: SyntaxTree.EnumerationValue);
- BEGIN writer.Int (expression.value, 0);
- END VisitEnumerationValue;
- PROCEDURE VisitUnaryExpression* (expression: SyntaxTree.UnaryExpression);
- BEGIN
- CASE expression.operator OF
- | Scanner.Plus:
- | Scanner.Minus: IF expression.type.resolved IS SyntaxTree.SetType THEN writer.Char ('~') ELSE writer.Char ('-') END;
- | Scanner.Not: writer.Char ('!');
- END;
- PrintExpression (expression.left);
- END VisitUnaryExpression;
- PROCEDURE VisitTypeGuardDesignator* (expression: SyntaxTree.TypeGuardDesignator);
- VAR isRecord: BOOLEAN;
- BEGIN
- isRecord := expression.type.resolved IS SyntaxTree.RecordType;
- IF isRecord THEN writer.String ("(*") END;
- writer.String ("(ASSERT ("); CompareTypeDescriptor (expression.left, expression.type); writer.String ("), (");
- PrintType (isRecord, expression.type, ""); writer.String (") ");
- IF isRecord THEN writer.Char ('&') END;
- PrintExpression (expression.left); writer.Char (')');
- IF isRecord THEN writer.Char (')') END;
- END VisitTypeGuardDesignator;
- PROCEDURE VisitSupercallDesignator(expression: SyntaxTree.SupercallDesignator);
- VAR name: Identifier; procedure: SyntaxTree.Procedure;
- BEGIN
- procedure := expression.left(SyntaxTree.SymbolDesignator).symbol(SyntaxTree.Procedure);
- GetSymbolName (procedure.super, name, backend.style); writer.String (name);
- END VisitSupercallDesignator;
- PROCEDURE VisitBinaryExpression* (expression: SyntaxTree.BinaryExpression);
- BEGIN
- IF expression.operator = Scanner.In THEN
- writer.String ("(("); PrintExpression (expression.right); writer.String (" >> ");
- PrintExpression (expression.left); writer.String (") & 1)"); RETURN;
- ELSIF expression.operator = Scanner.Is THEN
- CompareTypeDescriptor (expression.left, GetDeclaredType (expression.right));
- RETURN;
- END;
- writer.Char ('(');
- IF IsString (expression.left.type) THEN
- writer.String ("strcmp ("); PrintExpression (expression.left); writer.Char (Comma); writer.Char (Space); PrintExpression (expression.right); writer.Char (')');
- ELSE
- PrintExpression (expression.left);
- END;
- writer.Char (Space);
- CASE expression.operator OF
- | Scanner.Equal: writer.String ("==");
- | Scanner.Unequal: writer.String ("!=");
- | Scanner.Less: writer.String ("<");
- | Scanner.LessEqual: writer.String ("<=");
- | Scanner.Greater: writer.String (">");
- | Scanner.GreaterEqual: writer.String (">=");
- | Scanner.And: writer.String ("&&");
- | Scanner.Or: writer.String ("||");
- | Scanner.Plus: IF expression.type.resolved IS SyntaxTree.SetType THEN writer.Char ('|') ELSE writer.Char ('+') END;
- | Scanner.Minus: IF expression.type.resolved IS SyntaxTree.SetType THEN writer.Char ('&'); writer.Char ('~') ELSE writer.Char ('-') END;
- | Scanner.Times: IF expression.type.resolved IS SyntaxTree.SetType THEN writer.Char ('&') ELSE writer.Char ('*') END;
- | Scanner.Slash, Scanner.Div: IF expression.type.resolved IS SyntaxTree.SetType THEN writer.Char ('^') ELSE writer.Char ('/') END;
- | Scanner.Mod: writer.Char ('%');
- END;
- writer.Char (Space);
- IF IsString (expression.left.type) THEN writer.Char ('0'); ELSE PrintExpression (expression.right); END; writer.Char (')');
- END VisitBinaryExpression;
- PROCEDURE VisitSelfDesignator* (expression: SyntaxTree.SelfDesignator);
- BEGIN PrintSelf;
- END VisitSelfDesignator;
- PROCEDURE VisitIndexDesignator* (expression: SyntaxTree.IndexDesignator);
- VAR i: LONGINT;
- BEGIN
- PrintExpression (expression.left);
- FOR i := 0 TO expression.parameters.Length () - 1 DO
- writer.Char ('[');
- PrintExpression (expression.parameters.GetExpression (i));
- writer.Char (']');
- END;
- END VisitIndexDesignator;
- PROCEDURE VisitConversion* (expression: SyntaxTree.Conversion);
- VAR e: SyntaxTree.Expression;
- BEGIN
- IF (expression.type IS SyntaxTree.CharacterType) & (expression.expression.type IS SyntaxTree.StringType) THEN
- PrintCharacter (expression.expression.resolved(SyntaxTree.StringValue).value[0]);
- ELSE
- PrintExpression (expression.expression);
- END;
- END VisitConversion;
- PROCEDURE VisitDereferenceDesignator* (expression: SyntaxTree.DereferenceDesignator);
- BEGIN
- IF expression.type IS SyntaxTree.ArrayType THEN
- writer.String ("(*("); PrintType (TRUE, expression.type, ""); writer.String (") &");
- PrintExpression (expression.left); writer.String ("->array)");
- ELSE
- PrintExpression (expression.left); writer.String ("->record");
- END;
- END VisitDereferenceDesignator;
- PROCEDURE VisitSet* (expression: SyntaxTree.Set);
- VAR i: LONGINT; element: SyntaxTree.Expression;
- BEGIN
- IF expression.elements.Length () = 0 THEN
- writer.Char ('0');
- ELSE
- writer.Char ('(');
- FOR i := 0 TO expression.elements.Length () - 1 DO
- IF i # 0 THEN writer.String (" | "); END;
- element := expression.elements.GetExpression (i);
- IF element IS SyntaxTree.RangeExpression THEN
- writer.String ("(("); PrintType (FALSE, backend.system.setType, ""); writer.String (") - 1 << "); PrintExpression (element(SyntaxTree.RangeExpression).first);
- writer.String (" & ~(("); PrintType (FALSE, backend.system.setType, ""); writer.String (") - 2 << "); PrintExpression (element(SyntaxTree.RangeExpression).last); writer.String ("))");
- ELSE
- writer.String ("1 << "); PrintExpression (element);
- END;
- END;
- writer.Char (')');
- END;
- END VisitSet;
- END Transpiler;
- TYPE TranspilerBackend*= OBJECT (Backend.Backend)
- VAR
- defineMain, declarations, initLocalData: BOOLEAN;
- addressSize: LONGINT; style: Style;
- traceModule: Identifier;
- PROCEDURE &InitTranspilerBackend;
- BEGIN InitBackend;
- END InitTranspilerBackend;
- PROCEDURE ProcessSyntaxTreeModule* (module: SyntaxTree.Module): Formats.GeneratedModule;
- VAR filename, pathname, fullname: Files.FileName; file: Files.File; writer: Files.Writer; transpiler: Transpiler;
- BEGIN
- Files.SplitPath (module.sourceName, pathname, filename); GetHeaderName (module, filename, style);
- IF pathname = "" THEN fullname := filename ELSE Files.JoinPath (pathname, filename, fullname) END;
- file := Files.New (fullname); Files.OpenWriter (writer, file, 0);
- Replace (filename, '.', '_'); Strings.UpperCase (filename); Strings.Append (filename, "_INCLUDED");
- writer.String ("#ifndef "); writer.String (filename); writer.Ln; writer.String ("#define "); writer.String (filename); writer.Ln; writer.Ln;
- writer.String ("/* C header file generated from '"); writer.String (module.sourceName); writer.String ("' */"); writer.Ln;
- NEW (transpiler, writer, SELF, initLocalData); transpiler.DeclareModule (module);
- writer.Ln; writer.String ("#endif /* "); writer.String (filename); writer.String (" */"); writer.Ln; writer.Update; Files.Register (file);
- IF declarations THEN RETURN NIL END; GetSourceName (module, filename, style);
- IF pathname = "" THEN fullname := filename ELSE Files.JoinPath (pathname, filename, fullname) END;
- file := Files.New (fullname); Files.OpenWriter (writer, file, 0);
- writer.String ("/* C source file generated from '"); writer.String (module.sourceName); writer.String ("' */"); writer.Ln;
- NEW (transpiler, writer, SELF, initLocalData); transpiler.DefineModule (module);
- IF defineMain THEN transpiler.DefineMain (module); END; writer.Update; Files.Register (file);
- RETURN NIL;
- END ProcessSyntaxTreeModule;
- PROCEDURE DefineOptions* (options: Options.Options);
- BEGIN DefineOptions^(options);
- options.Add(0X,"defineMain", Options.Flag);
- options.Add(0X,"declarations", Options.Flag);
- options.Add(0X,"addressSize", Options.Integer);
- options.Add(0X,"style", Options.String);
- options.Add(0X,"traceModule", Options.String);
- options.Add(0X,"noLocalInit", Options.Flag);
- END DefineOptions;
- PROCEDURE GetOptions* (options: Options.Options);
- VAR styleName: ARRAY 32 OF CHAR;
- BEGIN GetOptions^(options);
- defineMain := options.GetFlag ("defineMain");
- declarations := options.GetFlag ("declarations");
- IF ~options.GetInteger ("addressSize", addressSize) THEN addressSize := 32 END;
- IF ~options.GetString ("style", styleName) OR (styleName # "staila") THEN style := DefaultStyle ELSE style := StailaStyle END;
- IF ~options.GetString ("traceModule", traceModule) THEN traceModule := "KernelLog" END;
- initLocalData := ~options.GetFlag("noLocalInit");
- END GetOptions;
- PROCEDURE DefaultSymbolFileFormat* (): Formats.SymbolFileFormat;
- BEGIN RETURN SymbolFileFormat.Get ();
- END DefaultSymbolFileFormat;
- PROCEDURE GetSystem*(): Global.System;
- VAR system: Global.System;
- BEGIN
- NEW(system, 8, 8, addressSize, 8, 32, 32, 32, 64, FALSE);
- Global.SetDefaultDeclarations(system,8);
- Global.SetDefaultOperators(system);
- RETURN system;
- END GetSystem;
- END TranspilerBackend;
- PROCEDURE AppendName (identifier: SyntaxTree.Identifier; VAR name: ARRAY OF CHAR; style: Style);
- VAR temp: Identifier;
- BEGIN Strings.Append (name, "_"); Basic.GetString(identifier,temp); Strings.Append (name, temp);
- END AppendName;
- PROCEDURE IsEmptyRecord (record: SyntaxTree.RecordType): BOOLEAN;
- BEGIN
- IF record.isObject OR (record.baseType # NIL) & ~IsEmptyRecord (record.GetBaseRecord ()) THEN RETURN FALSE END;
- RETURN record.recordScope.firstVariable = NIL;
- END IsEmptyRecord;
- PROCEDURE GetSymbolName (symbol: SyntaxTree.Symbol; VAR name: ARRAY OF CHAR; style: Style);
- BEGIN
- IF symbol IS SyntaxTree.Module THEN
- IF (symbol(SyntaxTree.Module).context # SyntaxTree.invalidIdentifier) & (symbol(SyntaxTree.Module).context # Global.A2Name) THEN
- Basic.GetString(symbol(SyntaxTree.Module).context,name); Strings.Append (name, "_"); AppendName (symbol.name, name, style);
- ELSE
- symbol.GetName(name);
- END;
- ELSIF symbol IS SyntaxTree.Parameter THEN
- symbol.GetName(name);
- ELSIF (symbol IS SyntaxTree.Variable) & ~(symbol.scope IS SyntaxTree.ModuleScope) THEN
- symbol.GetName(name);
- ELSE
- GetScopeName (symbol.scope, name, style); AppendName (symbol.name, name, style);
- END;
- FixIdentifier (name, style);
- END GetSymbolName;
- PROCEDURE GetScopeName (scope: SyntaxTree.Scope; VAR name: ARRAY OF CHAR; style: Style);
- BEGIN
- IF scope IS SyntaxTree.ProcedureScope THEN
- GetScopeName (scope.outerScope, name, style); AppendName (scope(SyntaxTree.ProcedureScope).ownerProcedure.name, name, style);
- ELSIF scope IS SyntaxTree.RecordScope THEN
- GetSymbolName (scope(SyntaxTree.RecordScope).ownerRecord.typeDeclaration, name, style);
- ELSIF scope IS SyntaxTree.ModuleScope THEN
- GetSymbolName (scope(SyntaxTree.ModuleScope).ownerModule, name, style);
- END;
- END GetScopeName;
- PROCEDURE GetSourceName (module: SyntaxTree.Module; VAR filename: Files.FileName; style: Style);
- BEGIN GetSymbolName (module, filename, style); Strings.Append (filename, ".c");
- END GetSourceName;
- PROCEDURE GetHeaderName (module: SyntaxTree.Module; VAR filename: Files.FileName; style: Style);
- BEGIN GetSymbolName (module, filename, style); Strings.Append (filename, ".h");
- END GetHeaderName;
- PROCEDURE GetConstructor (recordType: SyntaxTree.RecordType): SyntaxTree.Procedure;
- VAR constructor: SyntaxTree.Procedure; base: SyntaxTree.Type;
- BEGIN
- LOOP
- constructor := recordType.recordScope.constructor;
- IF constructor # NIL THEN RETURN constructor END;
- base := recordType.baseType;
- IF base = NIL THEN RETURN NIL END;
- IF base.resolved IS SyntaxTree.PointerType THEN
- base := base.resolved(SyntaxTree.PointerType).pointerBase;
- END;
- IF ~(base.resolved IS SyntaxTree.RecordType) THEN RETURN NIL END;
- recordType := base.resolved(SyntaxTree.RecordType);
- END;
- END GetConstructor;
- PROCEDURE GetStatementProcedure (statement: SyntaxTree.Statement): SyntaxTree.ProcedureScope;
- BEGIN WHILE statement.outer # NIL DO statement := statement.outer END; RETURN statement(SyntaxTree.Body).inScope;
- END GetStatementProcedure;
- PROCEDURE GetDeclaredType (expression: SyntaxTree.Expression): SyntaxTree.Type;
- BEGIN RETURN expression(SyntaxTree.SymbolDesignator).symbol(SyntaxTree.TypeDeclaration).declaredType;
- END GetDeclaredType;
- PROCEDURE IsMethod (expression: SyntaxTree.SymbolDesignator): BOOLEAN;
- VAR scope: SyntaxTree.Scope;
- BEGIN
- IF ~(expression.symbol IS SyntaxTree.Procedure) THEN RETURN FALSE END;
- scope := expression.symbol.scope;
- WHILE scope IS SyntaxTree.ProcedureScope DO scope := scope.outerScope END;
- RETURN scope IS SyntaxTree.RecordScope;
- END IsMethod;
- PROCEDURE IsVarParameter (symbol: SyntaxTree.Symbol): BOOLEAN;
- BEGIN RETURN (symbol IS SyntaxTree.Parameter) & ((symbol(SyntaxTree.Parameter).kind = SyntaxTree.VarParameter) OR (symbol(SyntaxTree.Parameter).kind = SyntaxTree.ConstParameter) & ~(symbol.type.resolved IS SyntaxTree.BasicType));
- END IsVarParameter;
- PROCEDURE IsInExclusiveBlock (statement: SyntaxTree.Statement): BOOLEAN;
- BEGIN
- WHILE statement # NIL DO
- IF (statement IS SyntaxTree.StatementBlock) & statement(SyntaxTree.StatementBlock).isExclusive THEN RETURN TRUE END;
- statement := statement.outer;
- END;
- RETURN FALSE;
- END IsInExclusiveBlock;
- PROCEDURE IsOpenArray (type: SyntaxTree.Type): BOOLEAN;
- BEGIN RETURN (type IS SyntaxTree.ArrayType) & (type(SyntaxTree.ArrayType).staticLength = 0);
- END IsOpenArray;
- PROCEDURE IsStaticArray (type: SyntaxTree.Type): BOOLEAN;
- BEGIN RETURN (type IS SyntaxTree.ArrayType) & (type(SyntaxTree.ArrayType).staticLength # 0);
- END IsStaticArray;
- PROCEDURE IsDelegate (type: SyntaxTree.Type): BOOLEAN;
- BEGIN RETURN (type IS SyntaxTree.ProcedureType) & type(SyntaxTree.ProcedureType).isDelegate;
- END IsDelegate;
- PROCEDURE IsStructuredType (type: SyntaxTree.Type): BOOLEAN;
- BEGIN RETURN (type.resolved IS SyntaxTree.ArrayType) OR (type.resolved IS SyntaxTree.RecordType);
- END IsStructuredType;
- PROCEDURE IsString (type: SyntaxTree.Type): BOOLEAN;
- BEGIN RETURN (type.resolved IS SyntaxTree.StringType) OR (type.resolved IS SyntaxTree.ArrayType) & (type.resolved(SyntaxTree.ArrayType).arrayBase.resolved IS SyntaxTree.CharacterType);
- END IsString;
- PROCEDURE IsEmptyString (type: SyntaxTree.Type): BOOLEAN;
- BEGIN RETURN (type.resolved IS SyntaxTree.StringType) & (type.resolved(SyntaxTree.StringType).length = 1);
- END IsEmptyString;
- PROCEDURE IsNegative (expression: SyntaxTree.Expression): BOOLEAN;
- BEGIN RETURN (expression.resolved # NIL) & (expression.resolved IS SyntaxTree.IntegerValue) & (expression.resolved(SyntaxTree.IntegerValue).value < 0);
- END IsNegative;
- PROCEDURE IsInlineAssemblyCode (procedure: SyntaxTree.Procedure): BOOLEAN;
- VAR type: SyntaxTree.ProcedureType; body: SyntaxTree.Body;
- BEGIN
- type := procedure.type(SyntaxTree.ProcedureType); body := procedure.procedureScope.body;
- RETURN (procedure.isInline) & (type.firstParameter = NIL) & (type.returnType = NIL) & (body # NIL) & (body.code # NIL);
- END IsInlineAssemblyCode;
- PROCEDURE GetRecordMethod (record: SyntaxTree.RecordType; method: LONGINT): SyntaxTree.Procedure;
- VAR base: SyntaxTree.RecordType; scope: SyntaxTree.RecordScope; procedure: SyntaxTree.Procedure;
- BEGIN
- scope := record.recordScope;
- LOOP
- procedure := scope.firstProcedure;
- WHILE (procedure # NIL) & (procedure.methodNumber #method) DO procedure := procedure.nextProcedure END;
- IF procedure # NIL THEN RETURN procedure END;
- base := scope.ownerRecord.GetBaseRecord ();
- scope := base.recordScope;
- END;
- END GetRecordMethod;
- PROCEDURE GetRecord (type: SyntaxTree.Type): SyntaxTree.RecordType;
- BEGIN
- IF type IS SyntaxTree.RecordType THEN RETURN type(SyntaxTree.RecordType)
- ELSIF type IS SyntaxTree.PointerType THEN
- type := type(SyntaxTree.PointerType).pointerBase.resolved;
- IF (type IS SyntaxTree.RecordType) & (type(SyntaxTree.RecordType).pointerType # NIL) THEN RETURN type(SyntaxTree.RecordType) END;
- END;
- RETURN NIL;
- END GetRecord;
- PROCEDURE Replace (VAR string: ARRAY OF CHAR; replace, by: CHAR);
- VAR i: LONGINT; char: CHAR;
- BEGIN
- i := 0; char := string[0];
- WHILE char # 0X DO IF char = replace THEN string[i] := by; END; INC (i); char := string[i]; END;
- END Replace;
- PROCEDURE FixStailaIdentifier (VAR identifier: ARRAY OF CHAR);
- VAR i: LONGINT; previousLower: BOOLEAN;
- BEGIN
- i := 0; previousLower := FALSE;
- WHILE identifier[i] # 0X DO
- IF (ORD (identifier[i]) >= ORD ('A')) & (ORD (identifier[i]) <= ORD ('Z')) THEN
- IF previousLower THEN Strings.Insert ("_", identifier, i); INC (i) END;
- identifier[i] := Strings.LOW (identifier[i]); previousLower := FALSE;
- ELSE
- previousLower := (ORD (identifier[i]) >= ORD ('a')) & (ORD (identifier[i]) <= ORD ('z'));
- END;
- INC (i);
- END;
- END FixStailaIdentifier;
- PROCEDURE FixIdentifier (VAR identifier: ARRAY OF CHAR; style: Style);
- CONST Tag = '_';
- BEGIN
- Replace (identifier, '$', Tag); Replace (identifier, '@', Tag);
- (* IF style = StailaStyle THEN FixStailaIdentifier (identifier) END; *)
- IF (identifier = "int") OR (identifier = "return") OR (identifier = "enum") OR
- (identifier = "char") OR (identifier = "register") OR (identifier = "continue") THEN
- Strings.Append (identifier, Tag);
- END;
- END FixIdentifier;
- PROCEDURE Get* (): Backend.Backend;
- VAR backend: TranspilerBackend;
- BEGIN NEW(backend); RETURN backend;
- END Get;
- END FoxTranspilerBackend.
- SystemTools.Free FoxTranspilerBackend ~
- Compiler.Compile -b=Transpiler Test.Mod ~
- TextCompiler.CompileSelection -b=Transpiler ~
- TextCompiler.CompileSelection -b=Transpiler --defineMain ~
- MODULE Test;
- VAR a: INTEGER;
- END Test.
- FoxTest.Compile --options="-PC -G=Transpiler" --command="WinApplications.Run --hide cl /c Test.c" Oberon.Temp.Test Oberon.Temp.TranspilerTestDiff ~
- FoxTest.Compile --options="--defineMain -PC -G=Transpiler" --command="WinApplications.Run --hide cl Test.c;WinApplications.Run --hide Test.exe" Oberon.Temp.Test Oberon.Temp.TranspilerTestDiff ~
|