|
@@ -0,0 +1,1665 @@
|
|
|
|
+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, 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;
|
|
|
|
+ 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,0, 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 ~
|
|
|
|
+
|
|
|
|
+
|