FoxTranspilerBackend.Mod 78 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665
  1. MODULE FoxTranspilerBackend; (** AUTHOR "negelef"; PURPOSE "Oberon to C transpiler"; *)
  2. IMPORT Basic := FoxBasic, Global := FoxGlobal, Backend := FoxBackend, SyntaxTree := FoxSyntaxTree, Scanner := FoxScanner,
  3. Formats := FoxFormats, Files, Streams, Strings, Options, SymbolFileFormat := FoxTextualSymbolFile, Printout := FoxPrintout;
  4. CONST
  5. Space = ' ';
  6. Tab = 9X;
  7. Comma = ',';
  8. Semicolon = ';';
  9. LeftBrace = '{';
  10. RightBrace = '}';
  11. StructTag = "_tag";
  12. BaseTag = "_base";
  13. TypeTag = "_type";
  14. LenTag = "_len";
  15. PointerTag = "_pointer";
  16. DelegateTag = "_delegate";
  17. BaseObjectName = "BaseObject";
  18. TypeDescriptorTag = "_descriptor";
  19. DefaultStyle = 0;
  20. StailaStyle = 1;
  21. TYPE
  22. TYPE Style = INTEGER;
  23. TYPE Indent = INTEGER;
  24. Identifier = ARRAY Scanner.MaxIdentifierLength OF CHAR;
  25. TYPE Transpiler* = OBJECT (SyntaxTree.Visitor)
  26. VAR
  27. indent: Indent;
  28. writer: Streams.Writer;
  29. backend: TranspilerBackend;
  30. currentProcedureScope: SyntaxTree.ProcedureScope;
  31. initializeLocalData: BOOLEAN;
  32. PROCEDURE &InitTranspiler (writer: Streams.Writer; backend: TranspilerBackend; initLocalData: BOOLEAN);
  33. BEGIN indent := 0; SELF.writer := writer; SELF.backend := backend; currentProcedureScope := NIL; initializeLocalData:= initLocalData;
  34. END InitTranspiler;
  35. PROCEDURE DeclareModule (module: SyntaxTree.Module);
  36. BEGIN
  37. DeclareImports (module.moduleScope);
  38. DefineConstants (module.moduleScope);
  39. DefineTypes (module.moduleScope);
  40. DeclareVariables (module.moduleScope);
  41. DeclareProcedures (module.moduleScope);
  42. DeclareObjects (module.moduleScope);
  43. END DeclareModule;
  44. PROCEDURE DeclareImports (scope: SyntaxTree.ModuleScope);
  45. VAR filename: Files.FileName; import: SyntaxTree.Import;
  46. BEGIN
  47. writer.Ln; PrintInclude ("oberon.h");
  48. import := scope.firstImport;
  49. WHILE import # NIL DO
  50. IF ~Global.IsSystemModule (import.module) & import.direct THEN
  51. GetHeaderName (import.module, filename, backend.style);
  52. PrintInclude (filename);
  53. END;
  54. import := import.nextImport;
  55. END;
  56. END DeclareImports;
  57. PROCEDURE DeclareVariables (scope: SyntaxTree.Scope);
  58. VAR variable: SyntaxTree.Variable; name: Identifier;
  59. BEGIN
  60. variable := scope.firstVariable;
  61. IF scope IS SyntaxTree.ModuleScope THEN
  62. GetScopeName (scope, name, backend.style); writer.Ln;
  63. PrintIndent; writer.String ("extern "); writer.String (BaseObjectName);
  64. writer.Char (Space); writer.String (name); writer.String (StructTag); writer.Char (Semicolon); writer.Ln;
  65. ELSIF variable # NIL THEN writer.Ln END;
  66. WHILE variable # NIL DO
  67. GetSymbolName (variable, name, backend.style);
  68. PrintComments (variable.comment, variable);
  69. PrintIndent; writer.String ("extern ");
  70. PrintVariable (FALSE, name, variable.type); writer.Char (Semicolon);
  71. writer.Ln;
  72. IF IsDelegate (variable.type.resolved) THEN
  73. PrintIndent; writer.String ("extern "); writer.String (BaseObjectName); writer.Char ('*');
  74. writer.Char (' '); writer.String (name); writer.String (DelegateTag); writer.Char (Semicolon); writer.Ln;
  75. END;
  76. variable := variable.nextVariable;
  77. END;
  78. END DeclareVariables;
  79. PROCEDURE DeclareProcedures (scope: SyntaxTree.Scope);
  80. VAR procedure: SyntaxTree.Procedure; name: Identifier;
  81. BEGIN
  82. procedure := scope.firstProcedure;
  83. IF procedure # NIL THEN writer.Ln; END;
  84. WHILE procedure # NIL DO
  85. IF IsInlineAssemblyCode (procedure) THEN
  86. GetSymbolName (procedure, name, backend.style); writer.Ln; writer.String ("#define "); writer.String (name);
  87. writer.String ("() "); PrintCode (procedure.procedureScope.body.code); writer.Ln;
  88. ELSE
  89. PrintIndent; PrintProcedure (procedure); writer.Char (Semicolon); writer.Ln;
  90. END;
  91. procedure := procedure.nextProcedure;
  92. END;
  93. END DeclareProcedures;
  94. PROCEDURE DeclareObjects (scope: SyntaxTree.Scope);
  95. VAR typeDeclaration: SyntaxTree.TypeDeclaration; record: SyntaxTree.RecordType;
  96. BEGIN
  97. typeDeclaration := scope.firstTypeDeclaration;
  98. WHILE typeDeclaration # NIL DO
  99. record := GetRecord (typeDeclaration.declaredType);
  100. IF record # NIL THEN DeclareProcedures (record.recordScope); DeclareDescriptor (record) END;
  101. typeDeclaration := typeDeclaration.nextTypeDeclaration;
  102. END;
  103. END DeclareObjects;
  104. PROCEDURE DeclareDescriptor (record: SyntaxTree.RecordType);
  105. VAR name: Identifier; method: LONGINT; procedure: SyntaxTree.Procedure; procedureType: SyntaxTree.ProcedureType;
  106. BEGIN
  107. GetSymbolName (record.typeDeclaration, name, backend.style);
  108. writer.Ln; writer.String ("typedef struct "); writer.String (name); writer.String (TypeTag); writer.String (StructTag);
  109. writer.Char (Space); writer.String (name); writer.String (TypeTag); writer.Char (Semicolon); writer.Ln;
  110. writer.Ln; writer.String ("extern "); writer.String (name); writer.String (TypeTag); INC (indent);
  111. writer.Char (Space); writer.String (name); writer.String (TypeDescriptorTag); writer.Char (Semicolon); writer.Ln;
  112. writer.Ln; writer.String ("struct "); writer.String (name); writer.String (TypeTag); writer.String (StructTag); writer.Char (Space); writer.Char ('{'); writer.Ln;
  113. PrintIndent; writer.String ("void* "); writer.String (BaseTag); writer.Char (Semicolon); writer.Ln;
  114. FOR method := 0 TO record.recordScope.numberMethods - 1 DO
  115. procedure := GetRecordMethod (record, method);
  116. procedure.GetName(name); FixIdentifier (name, backend.style);
  117. procedureType := procedure.type(SyntaxTree.ProcedureType);
  118. PrintIndent; PrintType (TRUE, procedureType.returnType, name);
  119. PrintParameters (procedureType, procedure.scope);
  120. writer.Char (Semicolon); writer.Ln;
  121. END;
  122. DEC (indent); writer.Char ('}'); writer.Char (Semicolon); writer.Ln;
  123. END DeclareDescriptor;
  124. PROCEDURE DefineModule (module: SyntaxTree.Module);
  125. BEGIN
  126. DefineImports (module.moduleScope);
  127. DefineVariables (module.moduleScope);
  128. DefineProcedures (module.moduleScope);
  129. DefineObjects (module.moduleScope);
  130. END DefineModule;
  131. PROCEDURE DefineMain (module: SyntaxTree.Module);
  132. VAR name: Identifier;
  133. BEGIN
  134. writer.Ln; PrintIndent; writer.String ("int main ()"); writer.Ln; BeginBlock;
  135. IF module.moduleScope.bodyProcedure # NIL THEN
  136. GetSymbolName (module.moduleScope.bodyProcedure, name, backend.style);
  137. PrintIndent; writer.String (name); writer.String (" ();"); writer.Ln;
  138. END;
  139. EndBlock;
  140. END DefineMain;
  141. PROCEDURE DefineImports (scope: SyntaxTree.ModuleScope);
  142. VAR filename: Files.FileName; import: SyntaxTree.Import;
  143. BEGIN
  144. writer.Ln; PrintInclude ("oberon.h");
  145. GetHeaderName (scope.ownerModule, filename, backend.style); PrintInclude (filename);
  146. import := scope.firstImport;
  147. WHILE import # NIL DO
  148. PrintComments (import.comment, import);
  149. import := import.nextImport;
  150. END;
  151. END DefineImports;
  152. PROCEDURE DefineConstants (scope: SyntaxTree.Scope);
  153. VAR constant: SyntaxTree.Constant; name: Identifier;
  154. BEGIN
  155. constant := scope.firstConstant;
  156. IF constant # NIL THEN writer.Ln; END;
  157. WHILE constant # NIL DO
  158. GetSymbolName (constant, name, backend.style);
  159. PrintComments (constant.comment, constant);
  160. writer.String ("#define "); writer.String (name);
  161. writer.Char (Space); PrintExpression (constant.value);
  162. writer.Ln;
  163. constant := constant.nextConstant;
  164. END;
  165. END DefineConstants;
  166. PROCEDURE DefineTypes (scope: SyntaxTree.Scope);
  167. TYPE Types = POINTER TO ARRAY OF SyntaxTree.Type;
  168. VAR typeDeclaration: SyntaxTree.TypeDeclaration; types: Types; count: LONGINT;
  169. PROCEDURE DeclareType (type: SyntaxTree.Type);
  170. VAR name: Identifier;
  171. BEGIN
  172. IF type IS SyntaxTree.RecordType THEN
  173. GetSymbolName (type.typeDeclaration, name, backend.style);
  174. writer.String ("typedef struct "); writer.String (name); writer.String (StructTag);
  175. writer.Char (Space); writer.String (name); writer.Char (Semicolon); writer.Ln;
  176. ELSIF (type IS SyntaxTree.PointerType) THEN
  177. writer.String ("typedef struct ");
  178. IF type(SyntaxTree.PointerType).pointerBase.resolved IS SyntaxTree.RecordType THEN
  179. GetSymbolName (type(SyntaxTree.PointerType).pointerBase.resolved(SyntaxTree.RecordType).typeDeclaration, name, backend.style);
  180. writer.String (name);
  181. ELSE
  182. writer.String ("Array");
  183. END;
  184. writer.String (PointerTag); GetSymbolName (type.typeDeclaration, name, backend.style);
  185. writer.Char (Space); writer.Char ('*'); writer.String (name); writer.Char (Semicolon); writer.Ln;
  186. END;
  187. END DeclareType;
  188. PROCEDURE DefineType (type: SyntaxTree.Type; reference: BOOLEAN);
  189. VAR i: LONGINT; variable: SyntaxTree.Variable; new: Types; name: Identifier;
  190. BEGIN
  191. IF (type IS SyntaxTree.PointerType) & ~reference THEN RETURN END;
  192. FOR i := 0 TO count - 1 DO IF types[i] = type THEN RETURN END END;
  193. IF LEN (types) = count THEN NEW (new, count * 2); FOR i := 0 TO count - 1 DO new[i] := types[i] END; types := new; END;
  194. types[count] := type; INC (count);
  195. IF type.typeDeclaration # NIL THEN GetSymbolName (type.typeDeclaration, name, backend.style) END;
  196. IF type IS SyntaxTree.ArrayType THEN
  197. DefineType (type(SyntaxTree.ArrayType).arrayBase.resolved, FALSE);
  198. ELSIF type IS SyntaxTree.PointerType THEN
  199. DefineType (type(SyntaxTree.PointerType).pointerBase.resolved, TRUE);
  200. ELSIF type IS SyntaxTree.RecordType THEN
  201. IF type(SyntaxTree.RecordType).baseType # NIL THEN DefineType (type(SyntaxTree.RecordType).GetBaseRecord (), FALSE) END;
  202. DefineTypes (type(SyntaxTree.RecordType).recordScope);
  203. variable := type(SyntaxTree.RecordType).recordScope.firstVariable;
  204. WHILE variable # NIL DO
  205. DefineType (variable.type.resolved, FALSE);
  206. variable := variable.nextVariable;
  207. END;
  208. END;
  209. IF (type.typeDeclaration = NIL) OR (type.typeDeclaration.scope # scope) THEN RETURN END;
  210. IF type IS SyntaxTree.RecordType THEN
  211. writer.Ln; writer.String ("struct "); writer.String (name); writer.String (StructTag);
  212. writer.Char (Space); writer.Char (LeftBrace); writer.Ln; INC (indent); PrintIndent;
  213. IF type(SyntaxTree.RecordType).baseType # NIL THEN
  214. IF type(SyntaxTree.RecordType).isObject OR ~IsEmptyRecord (type(SyntaxTree.RecordType).GetBaseRecord ()) THEN
  215. writer.String ("struct "); PrintType (FALSE, type(SyntaxTree.RecordType).GetBaseRecord (), ""); writer.String (StructTag);
  216. writer.Char (Space); writer.String (BaseTag); writer.Char (Semicolon); writer.Ln;
  217. END;
  218. ELSIF type(SyntaxTree.RecordType).isObject THEN
  219. writer.String (BaseObjectName); writer.Char (Space); writer.String (BaseTag); writer.Char (Semicolon); writer.Ln;
  220. ELSIF type(SyntaxTree.RecordType).recordScope.numberVariables = 0 THEN
  221. writer.String ("char dummy;"); writer.Ln;
  222. END;
  223. DefineVariables (type(SyntaxTree.RecordType).recordScope);
  224. DEC (indent); writer.Char (RightBrace); writer.Char (Semicolon); writer.Ln;
  225. writer.Ln; writer.String ("struct "); writer.String (name); writer.String (PointerTag);
  226. writer.Char (Space); writer.Char (LeftBrace); writer.Ln; INC (indent);
  227. PrintIndent; writer.String ("void* "); writer.String (TypeDescriptorTag); writer.Char (Semicolon); writer.Ln;
  228. PrintIndent; writer.String ("struct "); PrintType (FALSE, type(SyntaxTree.RecordType), ""); writer.String (StructTag); writer.Char (Space); writer.String ("record"); writer.Char (Semicolon); writer.Ln;
  229. DEC (indent); writer.Char (RightBrace); writer.Char (Semicolon); writer.Ln;
  230. ELSIF type IS SyntaxTree.EnumerationType THEN
  231. writer.String ("typedef int "); PrintType (FALSE, type, ""); writer.Char (Semicolon); writer.Ln;
  232. ELSIF ~(type IS SyntaxTree.PointerType) OR IsStaticArray (type(SyntaxTree.PointerType).pointerBase.resolved) THEN
  233. writer.String ("typedef "); PrintType (FALSE, type, name); writer.Char (Semicolon); writer.Ln;
  234. END;
  235. END DefineType;
  236. BEGIN
  237. typeDeclaration := scope.firstTypeDeclaration;
  238. IF typeDeclaration # NIL THEN writer.Ln END;
  239. WHILE typeDeclaration # NIL DO
  240. DeclareType (typeDeclaration.declaredType);
  241. typeDeclaration := typeDeclaration.nextTypeDeclaration;
  242. END;
  243. NEW (types, 100); count := 0;
  244. typeDeclaration := scope.firstTypeDeclaration;
  245. WHILE typeDeclaration # NIL DO
  246. DefineType (typeDeclaration.declaredType, TRUE);
  247. typeDeclaration := typeDeclaration.nextTypeDeclaration;
  248. END;
  249. END DefineTypes;
  250. PROCEDURE DefineVariables (scope: SyntaxTree.Scope);
  251. VAR variable: SyntaxTree.Variable; name: Identifier;
  252. BEGIN
  253. variable := scope.firstVariable;
  254. IF scope IS SyntaxTree.ModuleScope THEN
  255. GetScopeName (scope, name, backend.style); writer.Ln; PrintIndent; writer.String (BaseObjectName);
  256. writer.Char (Space); writer.String (name); writer.String (StructTag); writer.Char (Semicolon); writer.Ln;
  257. ELSIF variable # NIL THEN writer.Ln END;
  258. WHILE variable # NIL DO
  259. GetSymbolName (variable, name, backend.style); PrintIndent;
  260. PrintVariable (FALSE, name, variable.type); writer.Char (Semicolon); writer.Ln;
  261. IF IsDelegate (variable.type.resolved) THEN
  262. PrintIndent; writer.String (BaseObjectName); writer.Char ('*'); writer.Char (' ');
  263. writer.String (name); writer.String (DelegateTag); writer.Char (Semicolon); writer.Ln;
  264. END;
  265. variable := variable.nextVariable;
  266. END;
  267. END DefineVariables;
  268. PROCEDURE DefineProcedures (scope: SyntaxTree.Scope);
  269. VAR procedure: SyntaxTree.Procedure;
  270. BEGIN
  271. procedure := scope.firstProcedure;
  272. WHILE procedure # NIL DO
  273. IF ~IsInlineAssemblyCode (procedure) THEN
  274. DefineConstants (procedure.procedureScope);
  275. DefineTypes (procedure.procedureScope);
  276. DeclareProcedures (procedure.procedureScope);
  277. writer.Ln; PrintComments (procedure.comment, procedure);
  278. PrintProcedure (procedure); writer.Ln;
  279. PrintBody (procedure, procedure.procedureScope.body, procedure.procedureScope.firstVariable);
  280. DefineProcedures (procedure.procedureScope);
  281. END;
  282. procedure := procedure.nextProcedure;
  283. END;
  284. END DefineProcedures;
  285. PROCEDURE DefineObjects (scope: SyntaxTree.Scope);
  286. VAR typeDeclaration: SyntaxTree.TypeDeclaration; record: SyntaxTree.RecordType;
  287. BEGIN
  288. typeDeclaration := scope.firstTypeDeclaration;
  289. WHILE typeDeclaration # NIL DO
  290. record := GetRecord (typeDeclaration.declaredType);
  291. IF record # NIL THEN DefineDescriptor (record); DefineProcedures (record.recordScope) END;
  292. typeDeclaration := typeDeclaration.nextTypeDeclaration;
  293. END;
  294. END DefineObjects;
  295. PROCEDURE DefineDescriptor (record: SyntaxTree.RecordType);
  296. VAR name: Identifier; method: LONGINT; procedure: SyntaxTree.Procedure;
  297. BEGIN
  298. GetSymbolName (record.typeDeclaration, name, backend.style);
  299. writer.Ln; writer.String (name); writer.String (TypeTag); writer.Char (Space); writer.String (name);
  300. writer.String (TypeDescriptorTag); INC (indent); writer.String (" = {"); writer.Ln; PrintIndent;
  301. IF record.baseType # NIL THEN writer.Char ('&'); PrintType (FALSE, record.baseType, ""); writer.String (TypeDescriptorTag);
  302. ELSIF record.isObject THEN writer.Char ('&'); writer.String (BaseObjectName); writer.String (TypeDescriptorTag);
  303. ELSE writer.Char ('0'); END; writer.Char (Comma); writer.Ln;
  304. FOR method := 0 TO record.recordScope.numberMethods - 1 DO
  305. procedure := GetRecordMethod (record, method);
  306. GetSymbolName (procedure, name, backend.style); PrintIndent; writer.String (name); writer.Char (Comma); writer.Ln;
  307. END;
  308. DEC (indent); writer.Char ('}'); writer.Char (Semicolon); writer.Ln;
  309. END DefineDescriptor;
  310. PROCEDURE BeginBlock;
  311. BEGIN PrintIndent; writer.Char (LeftBrace); writer.Ln; INC (indent);
  312. END BeginBlock;
  313. PROCEDURE EndBlock;
  314. BEGIN DEC (indent); PrintIndent; writer.Char (RightBrace); writer.Ln;
  315. END EndBlock;
  316. PROCEDURE AccessBase (record, base: SyntaxTree.RecordType);
  317. BEGIN
  318. WHILE (record # base) & (record # NIL) DO
  319. IF (record.baseType # NIL) OR record.isObject THEN
  320. writer.Char ('.'); writer.String (BaseTag);
  321. END;
  322. record := record.GetBaseRecord ();
  323. END;
  324. END AccessBase;
  325. PROCEDURE BeginRuntimeCall (CONST module, procedure: ARRAY OF CHAR);
  326. VAR identifier: Identifier;
  327. BEGIN
  328. COPY (module, identifier); FixIdentifier (identifier, backend.style); writer.String (identifier); writer.Char ('_');
  329. COPY (procedure, identifier); FixIdentifier (identifier, backend.style); writer.String (identifier);
  330. writer.Char (' '); writer.Char ('(');
  331. END BeginRuntimeCall;
  332. PROCEDURE EndRuntimeCall;
  333. BEGIN
  334. writer.Char (')'); writer.Char (';');
  335. END EndRuntimeCall;
  336. PROCEDURE Trace (expression: SyntaxTree.Expression);
  337. VAR name: Identifier; printer: Printout.Printer; pos: LONGINT;
  338. BEGIN
  339. BeginRuntimeCall (backend.traceModule, "String"); writer.Char ('"'); pos := writer.Pos ();
  340. currentProcedureScope.ownerModule.GetName (name); writer.String (name); writer.Char ('@');
  341. writer.Int (expression.position.start, 0); writer.Char (':'); writer.Char (' ');
  342. printer := Printout.NewPrinter (writer, Printout.SourceCode, FALSE);
  343. printer.Expression (expression); writer.Char (' '); writer.Char ('=');
  344. writer.Char (' '); writer.Char ('"'); writer.Char (','); writer.Char (' ');
  345. writer.Int (writer.Pos () - pos - 3, 0); EndRuntimeCall;
  346. IF (expression.type.resolved IS SyntaxTree.IntegerType) OR (expression.type.resolved IS SyntaxTree.SizeType) THEN
  347. BeginRuntimeCall (backend.traceModule, "Int");
  348. PrintExpression (expression); writer.String (", 0"); EndRuntimeCall;
  349. ELSIF expression.type.resolved IS SyntaxTree.BooleanType THEN
  350. BeginRuntimeCall (backend.traceModule, "Boolean");
  351. PrintExpression (expression); EndRuntimeCall;
  352. ELSIF expression.type.resolved IS SyntaxTree.SetType THEN
  353. BeginRuntimeCall (backend.traceModule, "Bits");
  354. PrintExpression (expression); writer.String (", 0, ");
  355. writer.Int (expression.type.resolved.sizeInBits, 0); EndRuntimeCall;
  356. ELSIF expression.type.resolved IS SyntaxTree.CharacterType THEN
  357. BeginRuntimeCall (backend.traceModule, "Char");
  358. PrintExpression (expression); EndRuntimeCall;
  359. ELSIF (expression.type.resolved IS SyntaxTree.AddressType) OR (expression.type.resolved IS SyntaxTree.PointerType) THEN
  360. BeginRuntimeCall (backend.traceModule, "Address");
  361. PrintExpression (expression); EndRuntimeCall;
  362. ELSE
  363. HALT (200);
  364. END;
  365. BeginRuntimeCall (backend.traceModule, "Ln"); EndRuntimeCall;
  366. END Trace;
  367. PROCEDURE Convert (expression: SyntaxTree.Expression; type: SyntaxTree.Type);
  368. BEGIN
  369. 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
  370. writer.Char ('('); PrintType (FALSE, expression.type.resolved, ""); writer.Char (')'); writer.Char (Space);
  371. END;
  372. PrintExpression (expression);
  373. END Convert;
  374. PROCEDURE LockScope (scope: SyntaxTree.Scope);
  375. VAR name: Identifier;
  376. BEGIN
  377. PrintIndent; writer.String ("LockObject (&");
  378. IF scope IS SyntaxTree.RecordScope THEN
  379. PrintSelf; writer.String ("->record");
  380. AccessBase (scope(SyntaxTree.RecordScope).ownerRecord, NIL);
  381. ELSIF scope IS SyntaxTree.ModuleScope THEN
  382. GetScopeName (scope, name, backend.style);
  383. writer.String (name); writer.String (StructTag);
  384. END;
  385. writer.Char (')'); writer.Char (Semicolon); writer.Ln;
  386. END LockScope;
  387. PROCEDURE UnlockScope (scope: SyntaxTree.Scope);
  388. VAR name: Identifier;
  389. BEGIN
  390. IF scope IS SyntaxTree.RecordScope THEN
  391. PrintIndent; writer.String ("UnlockObject (&"); PrintSelf; writer.String ("->record");
  392. AccessBase (scope(SyntaxTree.RecordScope).ownerRecord, NIL);
  393. writer.Char (')'); writer.Char (Semicolon); writer.Ln;
  394. ELSIF scope IS SyntaxTree.ModuleScope THEN
  395. GetScopeName (scope, name, backend.style); PrintIndent; writer.String ("UnlockObject (&"); writer.String (name); writer.String (StructTag); writer.Char (')'); writer.Char (Semicolon); writer.Ln;
  396. END;
  397. END UnlockScope;
  398. PROCEDURE CompareTypeDescriptor (expression: SyntaxTree.Expression; type: SyntaxTree.Type);
  399. VAR name: Identifier;
  400. BEGIN
  401. writer.String ("IsBase (");
  402. IF expression.type.resolved IS SyntaxTree.PointerType THEN
  403. PrintExpression (expression); writer.String ("->"); writer.String (TypeDescriptorTag);
  404. IF ~type.resolved(SyntaxTree.PointerType).pointerBase.resolved(SyntaxTree.RecordType).isObject THEN
  405. type := type.resolved(SyntaxTree.PointerType).pointerBase.resolved;
  406. END;
  407. ELSIF (expression.type.resolved IS SyntaxTree.AnyType) THEN
  408. writer.String ("(*(void**) "); PrintExpression (expression); writer.Char (')');
  409. ELSIF expression.type.resolved IS SyntaxTree.RecordType THEN
  410. IF (expression IS SyntaxTree.SymbolDesignator) & (expression(SyntaxTree.SymbolDesignator).symbol IS SyntaxTree.Parameter) THEN
  411. GetSymbolName (expression(SyntaxTree.SymbolDesignator).symbol, name, backend.style); writer.String (name);
  412. ELSE
  413. PrintType (FALSE, expression.type, "");
  414. END;
  415. writer.String (TypeDescriptorTag);
  416. ELSIF expression.type.resolved IS SyntaxTree.ObjectType THEN
  417. PrintExpression (expression); writer.String ("->"); writer.String (TypeDescriptorTag);
  418. END;
  419. writer.String (", &"); GetSymbolName (type.resolved.typeDeclaration, name, backend.style);
  420. writer.String (name); writer.String (TypeDescriptorTag); writer.String (')');
  421. END CompareTypeDescriptor;
  422. PROCEDURE PrintIndent;
  423. VAR indent: Indent;
  424. BEGIN indent := SELF.indent; WHILE indent > 0 DO writer.Char (Tab); DEC (indent); END;
  425. END PrintIndent;
  426. PROCEDURE PrintInclude (CONST filename: ARRAY OF CHAR);
  427. BEGIN writer.String ('#include "'); writer.String (filename); writer.String ('"'); writer.Ln;
  428. END PrintInclude;
  429. PROCEDURE PrintComment (CONST comment: ARRAY OF CHAR);
  430. VAR i, len: LONGINT; ch: CHAR; pragma: BOOLEAN;
  431. BEGIN
  432. IF Strings.StartsWith2("#pragma", comment) THEN
  433. pragma := TRUE
  434. ELSE pragma := FALSE
  435. END;
  436. PrintIndent;
  437. IF ~pragma THEN writer.String("/*") END;
  438. i := 0; len := LEN (comment);
  439. LOOP
  440. ch := comment[i]; INC (i);
  441. IF (i = len) OR (ch = 0X) THEN EXIT END;
  442. IF ch = 0AX THEN writer.Ln; PrintIndent;
  443. ELSIF ch # 0DX THEN writer.Char(ch) END;
  444. END;
  445. IF ~pragma THEN writer.String("*/") END;
  446. writer.Ln;
  447. END PrintComment;
  448. PROCEDURE PrintComments (comment: SyntaxTree.Comment; item: OBJECT);
  449. BEGIN
  450. WHILE (comment # NIL) & (comment.item = item) DO
  451. PrintComment (comment.source^);
  452. comment := comment.nextComment;
  453. END;
  454. END PrintComments;
  455. PROCEDURE PrintProcedure (procedure: SyntaxTree.Procedure);
  456. VAR name: Identifier; procedureType: SyntaxTree.ProcedureType;
  457. BEGIN
  458. GetSymbolName (procedure, name, backend.style); procedureType := procedure.type(SyntaxTree.ProcedureType);
  459. PrintType (FALSE, procedureType.returnType, name);
  460. PrintParameters (procedureType, procedure.scope);
  461. ASSERT ((procedureType.returnType = NIL) OR (~IsDelegate (procedureType.returnType.resolved)));
  462. END PrintProcedure;
  463. PROCEDURE PrintParameter (symbol: SyntaxTree.Symbol; nested: BOOLEAN);
  464. VAR name: Identifier; type: SyntaxTree.Type; index: LONGINT;
  465. BEGIN
  466. GetSymbolName (symbol, name, backend.style); type := symbol.type;
  467. PrintVariable (IsVarParameter (symbol) & ~IsOpenArray (type) OR nested, name, type);
  468. IF type.resolved IS SyntaxTree.RecordType THEN
  469. writer.String (", void* "); writer.String (name); writer.String (TypeDescriptorTag);
  470. END;
  471. index := 0;
  472. WHILE IsOpenArray (type) DO
  473. writer.String (", int "); writer.String (name); writer.String (LenTag);
  474. writer.Int (index, 0); type := type(SyntaxTree.ArrayType).arrayBase; INC (index);
  475. END;
  476. IF IsDelegate (type.resolved) THEN
  477. writer.Char (Comma); writer.Char (Space); writer.String (BaseObjectName); writer.Char ('*');
  478. writer.Char (' '); writer.String (name); writer.String (DelegateTag);
  479. END;
  480. END PrintParameter;
  481. PROCEDURE PrintParameters (procedureType: SyntaxTree.ProcedureType; scope: SyntaxTree.Scope);
  482. VAR first: BOOLEAN; name: Identifier; outerScope: SyntaxTree.Scope;
  483. VAR parameter: SyntaxTree.Parameter; variable: SyntaxTree.Variable;
  484. BEGIN
  485. writer.Char (Space); writer.Char ('('); first := TRUE;
  486. parameter := procedureType.firstParameter;
  487. WHILE parameter # NIL DO
  488. IF first THEN first := FALSE ELSE writer.Char (Comma); writer.Char (Space); END;
  489. PrintParameter (parameter, FALSE);
  490. parameter := parameter.nextParameter;
  491. END;
  492. outerScope := scope;
  493. WHILE (outerScope # NIL) & (outerScope IS SyntaxTree.ProcedureScope) DO
  494. parameter := outerScope(SyntaxTree.ProcedureScope).ownerProcedure.type(SyntaxTree.ProcedureType).firstParameter;
  495. WHILE parameter # NIL DO
  496. IF first THEN first := FALSE ELSE writer.Char (Comma); writer.Char (Space); END;
  497. PrintParameter (parameter, TRUE);
  498. parameter := parameter.nextParameter;
  499. END;
  500. variable := outerScope.firstVariable;
  501. WHILE variable # NIL DO
  502. IF first THEN first := FALSE ELSE writer.Char (Comma); writer.Char (Space); END;
  503. PrintParameter (variable, TRUE);
  504. variable := variable.nextVariable;
  505. END;
  506. outerScope := outerScope.outerScope;
  507. END;
  508. IF IsDelegate (procedureType.resolved) & (scope = NIL) THEN
  509. IF first THEN first := FALSE ELSE writer.Char (Comma); writer.Char (Space); END;
  510. writer.String (BaseObjectName); writer.Char ('*'); writer.Char (' ');
  511. writer.String (name); writer.String (DelegateTag);
  512. END;
  513. WHILE scope # NIL DO
  514. IF scope IS SyntaxTree.RecordScope THEN
  515. IF first THEN first := FALSE ELSE writer.Char (Comma); writer.Char (Space); END;
  516. PrintType (FALSE, scope(SyntaxTree.RecordScope).ownerRecord, ""); writer.Char (Space); PrintSelf; scope := NIL;
  517. ELSE
  518. scope := scope.outerScope;
  519. END;
  520. END;
  521. writer.Char (')');
  522. END PrintParameters;
  523. PROCEDURE PrintArgument (argument: SyntaxTree.Expression; parameter: SyntaxTree.Symbol; nested: BOOLEAN);
  524. VAR argumentType, parameterType: SyntaxTree.Type; index: LONGINT; name: Identifier; isEmptyRecord: BOOLEAN;
  525. BEGIN
  526. parameterType := parameter.type; index := 0;
  527. IF argument = NIL THEN argumentType := parameterType.resolved ELSE argumentType := argument.type.resolved END;
  528. isEmptyRecord := (parameterType.resolved IS SyntaxTree.RecordType) & IsEmptyRecord (parameterType.resolved(SyntaxTree.RecordType));
  529. IF IsVarParameter (parameter) & ~IsOpenArray(parameterType) & ~(argumentType.resolved IS SyntaxTree.StringType) OR nested THEN
  530. IF isEmptyRecord THEN writer.Char ('0'); ELSE writer.Char ('&');
  531. END;
  532. ELSIF IsOpenArray (parameterType) & (parameterType(SyntaxTree.ArrayType).arrayBase.resolved IS SyntaxTree.ByteType) THEN
  533. writer.String ("*("); PrintType (TRUE, argumentType, ""); writer.String (") &");
  534. END;
  535. IF ~isEmptyRecord THEN
  536. IF argument = NIL THEN GetSymbolName (parameter, name, backend.style); writer.String (name) ELSE PrintExpression (argument) END;
  537. END;
  538. IF parameterType.resolved IS SyntaxTree.RecordType THEN
  539. IF ~isEmptyRecord THEN
  540. AccessBase (argumentType(SyntaxTree.RecordType), parameterType.resolved(SyntaxTree.RecordType));
  541. END;
  542. writer.Char (Comma); writer.Char (Space);
  543. IF (argument # NIL) & (argument IS SyntaxTree.SymbolDesignator) & (argument(SyntaxTree.SymbolDesignator).symbol IS SyntaxTree.Parameter) THEN
  544. GetSymbolName (argument(SyntaxTree.SymbolDesignator).symbol, name, backend.style);
  545. writer.String(name); writer.String (TypeDescriptorTag);
  546. ELSE
  547. writer.Char ('&'); PrintType (FALSE, argumentType, ""); writer.String (TypeDescriptorTag);
  548. END;
  549. END;
  550. WHILE IsOpenArray (parameterType) DO
  551. writer.Char (Comma); writer.Char (Space);
  552. IF argument = NIL THEN
  553. GetSymbolName (parameter, name, backend.style); writer.String (name);
  554. writer.String (LenTag); writer.Int (index, 0);
  555. ELSIF argumentType IS SyntaxTree.StringType THEN
  556. writer.Int (argumentType(SyntaxTree.StringType).length, 0);
  557. ELSIF parameterType(SyntaxTree.ArrayType).arrayBase.resolved IS SyntaxTree.ByteType THEN
  558. writer.String ("sizeof ("); PrintType (FALSE, argumentType, ""); writer.Char (')');
  559. ELSIF ~IsOpenArray (argumentType) THEN
  560. writer.Int (argumentType(SyntaxTree.ArrayType).staticLength, 0);
  561. ASSERT (argumentType IS SyntaxTree.ArrayType);
  562. ASSERT (argumentType(SyntaxTree.ArrayType).arrayBase # NIL);
  563. argumentType := argumentType(SyntaxTree.ArrayType).arrayBase.resolved;
  564. ELSIF (argument IS SyntaxTree.SymbolDesignator) & (argument(SyntaxTree.SymbolDesignator).symbol IS SyntaxTree.Parameter) THEN
  565. PrintExpression (argument); writer.String (LenTag); writer.Int (index, 0);
  566. ELSIF argument IS SyntaxTree.DereferenceDesignator THEN
  567. PrintExpression (argument(SyntaxTree.DereferenceDesignator).left);
  568. writer.String ("->length["); writer.Int (index, 0); writer.Char (']');
  569. END;
  570. parameterType := parameterType(SyntaxTree.ArrayType).arrayBase; INC (index);
  571. END;
  572. IF IsDelegate (parameterType.resolved) THEN
  573. writer.Char (Comma); writer.Char (Space); PrintDelegate (argument);
  574. END;
  575. END PrintArgument;
  576. PROCEDURE PrintArguments (arguments: SyntaxTree.ExpressionList; index, count: LONGINT; parameter: SyntaxTree.Parameter; outerScope: SyntaxTree.Scope): BOOLEAN;
  577. VAR first: BOOLEAN; variable: SyntaxTree.Variable;
  578. BEGIN
  579. first := TRUE;
  580. WHILE count # 0 DO
  581. IF first THEN first := FALSE ELSE writer.Char (Comma); writer.Char (Space); END;
  582. PrintArgument (arguments.GetExpression (index), parameter, FALSE);
  583. INC (index); DEC (count); parameter := parameter.nextParameter;
  584. END;
  585. WHILE (outerScope # NIL) & (outerScope IS SyntaxTree.ProcedureScope) DO
  586. parameter := outerScope(SyntaxTree.ProcedureScope).ownerProcedure.type(SyntaxTree.ProcedureType).firstParameter;
  587. WHILE parameter # NIL DO
  588. IF first THEN first := FALSE ELSE writer.Char (Comma); writer.Char (Space); END;
  589. PrintArgument (NIL, parameter, outerScope = currentProcedureScope);
  590. parameter := parameter.nextParameter;
  591. END;
  592. variable := outerScope.firstVariable;
  593. WHILE variable # NIL DO
  594. IF first THEN first := FALSE ELSE writer.Char (Comma); writer.Char (Space); END;
  595. PrintArgument (NIL, variable, outerScope = currentProcedureScope);
  596. variable := variable.nextVariable;
  597. END;
  598. outerScope := outerScope.outerScope;
  599. END;
  600. RETURN first;
  601. END PrintArguments;
  602. PROCEDURE PrintSelf;
  603. VAR self: Identifier;
  604. BEGIN
  605. IF backend.style = StailaStyle THEN writer.String ("_this");
  606. ELSE Basic.GetString(Global.SelfParameterName,self); FixIdentifier (self, backend.style); writer.String (self); END;
  607. END PrintSelf;
  608. PROCEDURE PrintDelegate (expression: SyntaxTree.Expression);
  609. VAR designator: SyntaxTree.SymbolDesignator;
  610. BEGIN
  611. IF IsDelegate (expression.type.resolved) & (expression IS SyntaxTree.SymbolDesignator) THEN
  612. designator := expression(SyntaxTree.SymbolDesignator);
  613. IF (designator.left # NIL) & (designator.symbol IS SyntaxTree.Procedure) THEN
  614. PrintExpression (designator.left(SyntaxTree.DereferenceDesignator).left);
  615. ELSE
  616. PrintExpression (designator); writer.String (DelegateTag);
  617. END;
  618. ELSE
  619. writer.Char ('0');
  620. END;
  621. END PrintDelegate;
  622. PROCEDURE PrintBody (procedure: SyntaxTree.Procedure; body: SyntaxTree.Body; variable: SyntaxTree.Variable);
  623. VAR name: Identifier;
  624. BEGIN
  625. BeginBlock;
  626. WHILE variable # NIL DO
  627. GetSymbolName (variable, name, backend.style);
  628. PrintIndent; PrintVariable (FALSE, name, variable.type);
  629. IF initializeLocalData THEN
  630. IF variable.type.resolved IS SyntaxTree.ArrayType THEN
  631. writer.String (" = {0}");
  632. ELSIF variable.type.resolved IS SyntaxTree.RecordType THEN
  633. IF ~IsEmptyRecord (variable.type.resolved(SyntaxTree.RecordType)) THEN writer.String (" = {0}") END;
  634. ELSE
  635. writer.String (" = 0");
  636. END;
  637. END;
  638. writer.Char (Semicolon); writer.Ln;
  639. IF IsDelegate (variable.type.resolved) THEN
  640. PrintIndent; writer.String (BaseObjectName); writer.Char ('*'); writer.Char (' ');
  641. writer.String (name); writer.String (DelegateTag);
  642. IF initializeLocalData THEN writer.String (" = 0") END;
  643. writer.Char (Semicolon); writer.Ln;
  644. END;
  645. variable := variable.nextVariable;
  646. END;
  647. IF body # NIL THEN
  648. IF body.code # NIL THEN
  649. PrintCode (body.code);
  650. ELSE
  651. currentProcedureScope := body.inScope;
  652. IF procedure = procedure.procedureScope.ownerModule.moduleScope.bodyProcedure THEN
  653. GetScopeName (procedure.procedureScope.ownerModule.moduleScope, name, backend.style); PrintIndent; writer.String ("InitObject (&");
  654. writer.String (name); writer.String (StructTag); writer.Char (')'); writer.Char (Semicolon); writer.Ln;
  655. END;
  656. PrintStatement (body);
  657. IF body.isActive THEN
  658. PrintIndent; writer.String ("Objects_Terminate ();"); writer.Ln;
  659. END;
  660. END;
  661. END;
  662. EndBlock;
  663. END PrintBody;
  664. PROCEDURE PrintType (pointer: BOOLEAN; type: SyntaxTree.Type; CONST name: ARRAY OF CHAR);
  665. PROCEDURE Prefix (type: SyntaxTree.Type);
  666. VAR temp: Identifier;
  667. BEGIN
  668. IF type = NIL THEN writer.String ("void");
  669. ELSIF type IS SyntaxTree.ArrayType THEN Prefix (type(SyntaxTree.ArrayType).arrayBase);
  670. ELSIF type IS SyntaxTree.PointerType THEN
  671. writer.String ("struct ");
  672. IF type(SyntaxTree.PointerType).pointerBase.resolved IS SyntaxTree.ArrayType THEN
  673. writer.String ("Array");
  674. ELSE
  675. GetSymbolName (type(SyntaxTree.PointerType).pointerBase.resolved.typeDeclaration, temp, backend.style);
  676. writer.String (temp);
  677. END;
  678. writer.String (PointerTag); writer.String (" (*");
  679. ELSIF type IS SyntaxTree.ProcedureType THEN Prefix (type(SyntaxTree.ProcedureType).returnType);
  680. ELSIF type.resolved.typeDeclaration # NIL THEN GetSymbolName (type.resolved.typeDeclaration, temp, backend.style); writer.String (temp);
  681. ELSIF type.resolved IS SyntaxTree.ObjectType THEN writer.String ("ObjectType");
  682. ELSE PrintBasicType (type.resolved(SyntaxTree.BasicType)); END;
  683. IF name # "" THEN writer.Char (Space) END;
  684. END Prefix;
  685. PROCEDURE Infix (type: SyntaxTree.Type);
  686. BEGIN
  687. IF type = NIL THEN IF pointer THEN writer.Char ('('); writer.Char ('*'); writer.String (name); writer.Char (')') ELSE writer.String (name) END
  688. ELSIF type IS SyntaxTree.ArrayType THEN Infix (type(SyntaxTree.ArrayType).arrayBase);
  689. ELSIF type IS SyntaxTree.PointerType THEN Infix (type(SyntaxTree.PointerType).pointerBase);
  690. ELSIF type IS SyntaxTree.ProcedureType THEN writer.Char ('('); writer.Char ('*'); IF pointer THEN writer.Char ('*') END; writer.String (name);
  691. ELSE IF pointer THEN writer.Char ('('); writer.Char ('*'); writer.String (name); writer.Char (')') ELSE writer.String (name) END
  692. END;
  693. END Infix;
  694. PROCEDURE Postfix (type: SyntaxTree.Type);
  695. BEGIN
  696. IF type = NIL THEN
  697. ELSIF type IS SyntaxTree.ArrayType THEN
  698. ASSERT (~IsDelegate (type(SyntaxTree.ArrayType).arrayBase.resolved));
  699. writer.Char ('['); IF type(SyntaxTree.ArrayType).staticLength # 0 THEN writer.Int (type(SyntaxTree.ArrayType).staticLength, 0); END; writer.Char (']');
  700. Postfix (type(SyntaxTree.ArrayType).arrayBase);
  701. ELSIF type IS SyntaxTree.PointerType THEN writer.Char (')');
  702. ELSIF type IS SyntaxTree.ProcedureType THEN writer.Char (')'); PrintParameters (type(SyntaxTree.ProcedureType), NIL);
  703. END;
  704. END Postfix;
  705. BEGIN
  706. Prefix (type); Infix (type); Postfix (type);
  707. END PrintType;
  708. PROCEDURE PrintBasicType (type: SyntaxTree.BasicType);
  709. VAR i: LONGINT;
  710. BEGIN
  711. IF type IS SyntaxTree.AddressType THEN
  712. writer.String ("size_t");
  713. ELSIF type IS SyntaxTree.SizeType THEN
  714. writer.String ("size_t");
  715. ELSIF type IS SyntaxTree.ByteType THEN
  716. IF type.sizeInBits = 8 THEN
  717. IF backend.style = StailaStyle THEN writer.String ("int8_t") ELSE writer.String ("Byte") END;
  718. ELSE
  719. HALT (1234);
  720. END;
  721. ELSIF type IS SyntaxTree.CharacterType THEN
  722. IF type.sizeInBits = 8 THEN
  723. IF backend.style = StailaStyle THEN writer.String ("char") ELSE writer.String ("Char") END;
  724. ELSE
  725. HALT (1234);
  726. END;
  727. ELSIF type IS SyntaxTree.BooleanType THEN
  728. IF backend.style = StailaStyle THEN writer.String ("bool") ELSE writer.String ("Boolean") END;
  729. ELSIF type IS SyntaxTree.IntegerType THEN
  730. IF type.sizeInBits = 8 THEN
  731. IF backend.style = StailaStyle THEN writer.String ("int8_t") ELSE writer.String ("ShortInt") END;
  732. ELSIF type.sizeInBits = 16 THEN
  733. IF backend.style = StailaStyle THEN writer.String ("int16_t") ELSE writer.String ("Integer") END;
  734. ELSIF type.sizeInBits = 32 THEN
  735. IF backend.style = StailaStyle THEN writer.String ("int32_t") ELSE writer.String ("LongInt") END;
  736. ELSIF type.sizeInBits = 64 THEN
  737. IF backend.style = StailaStyle THEN writer.String ("int64_t") ELSE writer.String ("HugeInt") END;
  738. ELSE
  739. HALT (1234);
  740. END;
  741. ELSIF type IS SyntaxTree.FloatType THEN
  742. IF type.sizeInBits = 32 THEN
  743. IF backend.style = StailaStyle THEN writer.String ("float") ELSE writer.String ("Real") END;
  744. ELSIF type.sizeInBits = 64 THEN
  745. IF backend.style = StailaStyle THEN writer.String ("double") ELSE writer.String ("LongReal") END;
  746. ELSE
  747. HALT (1234);
  748. END;
  749. ELSIF type IS SyntaxTree.SetType THEN
  750. IF type.sizeInBits = backend.addressSize THEN
  751. IF backend.style = StailaStyle THEN writer.String ("size_t") ELSE writer.String ("Set") END;
  752. ELSE
  753. HALT (1234);
  754. END;
  755. ELSIF type IS SyntaxTree.NilType THEN
  756. writer.String ("void*");
  757. ELSIF type IS SyntaxTree.AnyType THEN
  758. writer.String ("void*");
  759. ELSE
  760. HALT (1234);
  761. END;
  762. END PrintBasicType;
  763. PROCEDURE PrintVariable (variable: BOOLEAN; CONST name: ARRAY OF CHAR; type: SyntaxTree.Type);
  764. BEGIN PrintType (variable, type, name);
  765. END PrintVariable;
  766. PROCEDURE PrintCharacter (value: CHAR);
  767. BEGIN
  768. writer.Char ("'");
  769. IF value = "'" THEN
  770. writer.String ("\'");
  771. ELSIF (ORD (value) >= 32) & (ORD (value) < 127) THEN
  772. writer.Char (value);
  773. ELSE
  774. writer.String ("\x"); writer.Hex (ORD (value), 0);
  775. END;
  776. writer.Char ("'");
  777. END PrintCharacter;
  778. PROCEDURE PrintNew (arguments: SyntaxTree.ExpressionList);
  779. VAR designator: SyntaxTree.Expression; type: SyntaxTree.Type; name: Identifier;
  780. VAR procedure: SyntaxTree.Procedure; recordType: SyntaxTree.RecordType; first: BOOLEAN;
  781. BEGIN
  782. designator := arguments.GetExpression (0);
  783. type := designator.type.resolved(SyntaxTree.PointerType).pointerBase.resolved;
  784. IF (type IS SyntaxTree.ArrayType) & (arguments.Length () > 1) THEN
  785. ASSERT (arguments.Length () = 2);
  786. ASSERT (type(SyntaxTree.ArrayType).staticLength = 0);
  787. PrintExpression (designator); writer.String (" = ("); PrintType (FALSE, designator.type, "");
  788. writer.String (") calloc (1, "); PrintExpression (arguments.GetExpression (1)); writer.String (" * sizeof (");
  789. PrintType (FALSE, type(SyntaxTree.ArrayType).arrayBase, ""); writer.String (") + sizeof (struct Array_pointer))");
  790. writer.Char (Semicolon); writer.Ln; PrintIndent; PrintExpression (designator);
  791. writer.String ("->length[0] = "); PrintExpression (arguments.GetExpression (1)); writer.Char (Semicolon);
  792. ELSE
  793. PrintExpression (designator); writer.String (" = ("); PrintType (FALSE, designator.type, "");
  794. writer.String (") calloc (1, sizeof (struct "); PrintType (FALSE, type, ""); writer.String (PointerTag); writer.String ("))");
  795. END;
  796. IF type IS SyntaxTree.RecordType THEN
  797. recordType := type(SyntaxTree.RecordType);
  798. GetSymbolName (recordType.typeDeclaration, name, backend.style);
  799. writer.Char (Semicolon); writer.Ln; PrintIndent; PrintExpression (designator); writer.String ("->"); writer.String (TypeDescriptorTag); writer.String (" = &"); writer.String (name); writer.String (TypeDescriptorTag);
  800. IF recordType.isObject THEN
  801. writer.Char (Semicolon); writer.Ln; PrintIndent; writer.String ("InitObject (&"); PrintExpression (designator);
  802. writer.String ("->record"); AccessBase (recordType, NIL); writer.Char (')');
  803. END;
  804. procedure := GetConstructor (recordType);
  805. IF procedure # NIL THEN
  806. GetSymbolName (procedure, name, backend.style);
  807. writer.Char (Semicolon); writer.Ln; PrintIndent; writer.String (name); writer.String (" (");
  808. first := PrintArguments (arguments, 1, arguments.Length () - 1, procedure.type(SyntaxTree.ProcedureType).firstParameter, procedure.scope.outerScope);
  809. IF first THEN first := FALSE ELSE writer.String (", ") END; PrintExpression (designator); writer.Char (')');
  810. END;
  811. REPEAT
  812. procedure := recordType.recordScope.bodyProcedure;
  813. IF procedure # NIL THEN
  814. GetSymbolName (procedure, name, backend.style); writer.Char (Semicolon); writer.Ln; PrintIndent;
  815. IF procedure.procedureScope.body.isActive THEN
  816. writer.String ("Activate ((ObjectType) "); PrintExpression (designator);
  817. writer.String (", "); IF procedure.procedureScope.body.priority # NIL THEN PrintExpression (procedure.procedureScope.body.priority) ELSE writer.Char ('2') END;
  818. writer.String (", (void (*) (ObjectType)) "); writer.String (name); writer.Char (')');
  819. ELSE
  820. writer.String (name); writer.String (" ("); PrintExpression (designator); writer.Char (')');
  821. END;
  822. END;
  823. recordType := recordType.GetBaseRecord ();
  824. UNTIL recordType = NIL;
  825. END;
  826. END PrintNew;
  827. PROCEDURE PrintStatements (statements: SyntaxTree.StatementSequence);
  828. VAR i: LONGINT;
  829. BEGIN
  830. ASSERT (statements # NIL);
  831. FOR i := 0 TO statements.Length () - 1 DO PrintStatement (statements.GetStatement (i)); END;
  832. END PrintStatements;
  833. PROCEDURE PrintCode (code: SyntaxTree.Code);
  834. VAR text: Scanner.StringType; i: LONGINT;
  835. BEGIN
  836. PrintIndent; writer.String ("__asm ("); writer.Char ('"');
  837. text := code.sourceCode; i := 0;
  838. WHILE (text[i] # 0X) & (text[i] # 0AX) DO INC (i); END;
  839. IF text[i] # 0X THEN INC (i); END;
  840. WHILE text[i] # 0X DO
  841. IF text[i] = 0AX THEN
  842. writer.Char ('\'); writer.Char ('n'); writer.Char ('"'); writer.Char (Space);
  843. writer.Char ('\'); writer.Ln; INC (indent); PrintIndent; DEC (indent); writer.Char ('"');
  844. ELSE writer.Char (text[i]); END;
  845. INC (i);
  846. END;
  847. writer.Char ('"'); writer.Char (')'); writer.Char (Semicolon); writer.Ln;
  848. END PrintCode;
  849. PROCEDURE PrintIfPart (ifPart: SyntaxTree.IfPart);
  850. BEGIN
  851. ASSERT (ifPart # NIL);
  852. PrintComments (ifPart.comment, ifPart);
  853. writer.String ("if ("); PrintExpression (ifPart.condition); writer.Char (')'); writer.Ln;
  854. BeginBlock; PrintStatements (ifPart.statements); EndBlock;
  855. END PrintIfPart;
  856. PROCEDURE PrintStatement (statement: SyntaxTree.Statement);
  857. BEGIN
  858. ASSERT (statement # NIL);
  859. PrintComments (statement.comment, statement);
  860. statement.Accept (SELF);
  861. END PrintStatement;
  862. PROCEDURE PrintExpression (expression: SyntaxTree.Expression);
  863. BEGIN ASSERT (expression # NIL); expression.Accept (SELF);
  864. END PrintExpression;
  865. PROCEDURE PrintNegatedExpression (expression: SyntaxTree.Expression);
  866. BEGIN
  867. IF (expression IS SyntaxTree.UnaryExpression) & (expression(SyntaxTree.UnaryExpression).operator = Scanner.Not) THEN
  868. PrintExpression (expression(SyntaxTree.UnaryExpression).left);
  869. ELSE
  870. writer.Char ('!'); writer.Char ('('); PrintExpression (expression); writer.Char (')');
  871. END;
  872. END PrintNegatedExpression;
  873. PROCEDURE VisitAssignment* (statement: SyntaxTree.Assignment);
  874. BEGIN
  875. PrintIndent;
  876. IF IsEmptyString (statement.right.type) THEN
  877. PrintExpression (statement.left); writer.String ("[0] = 0");
  878. ELSIF IsStructuredType (statement.left.type) THEN
  879. ASSERT (~IsOpenArray (statement.left.type.resolved));
  880. writer.String ("memcpy (");
  881. IF ~(statement.left.type.resolved IS SyntaxTree.ArrayType) THEN writer.Char ('&'); END;
  882. PrintExpression (statement.left); writer.String (", ");
  883. IF ~(statement.right.type.resolved IS SyntaxTree.StringType) & ~(statement.right.type.resolved IS SyntaxTree.ArrayType) THEN writer.Char ('&'); END;
  884. PrintExpression (statement.right); writer.String (", sizeof ("); PrintType (FALSE, statement.left.type, ""); writer.String ("))");
  885. ELSE
  886. PrintExpression (statement.left); writer.Char (Space); writer.Char ('='); writer.Char (Space); Convert (statement.right, statement.left.type);
  887. END;
  888. writer.Char (Semicolon); writer.Ln;
  889. IF IsDelegate (statement.left.type.resolved) THEN
  890. PrintIndent; PrintExpression (statement.left); writer.String (DelegateTag);
  891. writer.String (" = "); PrintDelegate (statement.right); writer.Char (Semicolon); writer.Ln;
  892. END;
  893. END VisitAssignment;
  894. PROCEDURE VisitIfStatement* (statement: SyntaxTree.IfStatement);
  895. VAR i: LONGINT;
  896. BEGIN
  897. PrintIndent; PrintIfPart (statement.ifPart);
  898. FOR i := 0 TO statement.ElsifParts () - 1 DO
  899. PrintIndent; writer.String ("else "); PrintIfPart (statement.GetElsifPart (i));
  900. END;
  901. IF statement.elsePart # NIL THEN
  902. PrintIndent; writer.String ("else"); writer.Ln;
  903. BeginBlock; PrintStatements (statement.elsePart); EndBlock;
  904. END;
  905. END VisitIfStatement;
  906. PROCEDURE VisitWithStatement* (statement: SyntaxTree.WithStatement);
  907. VAR withPart: SyntaxTree.WithPart; i: LONGINT;
  908. BEGIN
  909. FOR i := 0 TO statement.WithParts () - 1 DO
  910. withPart := statement.GetWithPart (i); PrintIndent;
  911. IF i > 0 THEN writer.String ("else ") END;
  912. writer.String ("if ("); CompareTypeDescriptor (withPart.variable, withPart.type); writer.String (")"); writer.Ln;
  913. BeginBlock; PrintStatements (withPart.statements); EndBlock;
  914. END;
  915. PrintIndent;
  916. IF statement.elsePart = NIL THEN
  917. writer.String ("else ASSERT (false);"); writer.Ln;
  918. ELSE
  919. writer.String ("else"); writer.Ln;
  920. BeginBlock; PrintStatements (statement.elsePart); EndBlock;
  921. END;
  922. END VisitWithStatement;
  923. PROCEDURE VisitWhileStatement* (statement: SyntaxTree.WhileStatement);
  924. BEGIN
  925. PrintIndent; writer.String ("while ("); PrintExpression (statement.condition); writer.Char (')'); writer.Ln;
  926. BeginBlock; PrintStatements (statement.statements); EndBlock;
  927. END VisitWhileStatement;
  928. PROCEDURE VisitRepeatStatement* (statement: SyntaxTree.RepeatStatement);
  929. BEGIN
  930. PrintIndent; writer.String ("do"); writer.Ln;
  931. BeginBlock; PrintStatements (statement.statements); EndBlock;
  932. PrintIndent; writer.String ("while ("); PrintNegatedExpression (statement.condition); writer.String (");"); writer.Ln;
  933. END VisitRepeatStatement;
  934. PROCEDURE VisitLoopStatement* (statement: SyntaxTree.LoopStatement);
  935. BEGIN
  936. PrintIndent; writer.String ("for (;;)"); writer.Ln;
  937. BeginBlock; PrintStatements (statement.statements); EndBlock;
  938. END VisitLoopStatement;
  939. PROCEDURE VisitExitStatement* (statement: SyntaxTree.ExitStatement);
  940. BEGIN PrintIndent; writer.String ("break;"); writer.Ln;
  941. END VisitExitStatement;
  942. PROCEDURE VisitReturnStatement* (statement: SyntaxTree.ReturnStatement);
  943. CONST ResultVariable = "_result";
  944. VAR scope: SyntaxTree.ProcedureScope; locked: BOOLEAN;
  945. BEGIN
  946. scope := GetStatementProcedure (statement);
  947. locked := IsInExclusiveBlock (statement);
  948. IF statement.returnValue # NIL THEN
  949. IF locked THEN
  950. BeginBlock; PrintIndent; PrintVariable (FALSE, ResultVariable, statement.returnValue.type.resolved); writer.Char (Semicolon); writer.Ln;
  951. PrintIndent; writer.String (ResultVariable); writer.String (" = "); PrintExpression (statement.returnValue);
  952. writer.Char (Semicolon); writer.Ln; UnlockScope (scope.outerScope);
  953. PrintIndent; writer.String ("return "); writer.String (ResultVariable); writer.Char (Semicolon); writer.Ln; EndBlock;
  954. ELSE
  955. PrintIndent; writer.String ("return "); PrintExpression (statement.returnValue); writer.Char (Semicolon); writer.Ln;
  956. END
  957. ELSE
  958. IF locked THEN UnlockScope (scope.outerScope); END;
  959. PrintIndent; writer.String ("return"); writer.Char (Semicolon); writer.Ln;
  960. END;
  961. END VisitReturnStatement;
  962. PROCEDURE VisitStatementBlock* (statement: SyntaxTree.StatementBlock);
  963. VAR procedureScope: SyntaxTree.ProcedureScope;
  964. BEGIN
  965. procedureScope := GetStatementProcedure (statement);
  966. IF statement.outer # NIL THEN BeginBlock END;
  967. IF statement.isExclusive THEN LockScope (procedureScope.outerScope) END;
  968. PrintStatements (statement.statements);
  969. IF statement.isExclusive THEN UnlockScope (procedureScope.outerScope) END;
  970. IF statement.outer # NIL THEN EndBlock END;
  971. END VisitStatementBlock;
  972. PROCEDURE VisitAwaitStatement* (statement: SyntaxTree.AwaitStatement);
  973. VAR procedureScope: SyntaxTree.ProcedureScope; name: Identifier;
  974. BEGIN
  975. procedureScope := GetStatementProcedure (statement);
  976. PrintIndent; writer.String ("while ("); PrintNegatedExpression (statement.condition);
  977. writer.String (") "); writer.String ("AwaitCondition (&");
  978. IF procedureScope.outerScope IS SyntaxTree.RecordScope THEN
  979. PrintSelf; writer.String ("->record");
  980. AccessBase (procedureScope.outerScope(SyntaxTree.RecordScope).ownerRecord, NIL);
  981. ELSIF procedureScope.outerScope IS SyntaxTree.ModuleScope THEN
  982. GetScopeName (procedureScope.outerScope, name, backend.style);
  983. writer.String (name); writer.String (StructTag);
  984. END;
  985. writer.Char (')'); writer.Char (Semicolon); writer.Ln;
  986. END VisitAwaitStatement;
  987. PROCEDURE VisitCaseStatement* (statement: SyntaxTree.CaseStatement);
  988. VAR i, value: LONGINT; casePart: SyntaxTree.CasePart; caseConstant: SyntaxTree.CaseConstant;
  989. BEGIN
  990. PrintIndent; writer.String ("switch ("); PrintExpression (statement.variable); writer.Char (')'); writer.Ln;
  991. BeginBlock;
  992. FOR i := 0 TO statement.CaseParts () - 1 DO
  993. casePart := statement.GetCasePart (i);
  994. PrintComments (casePart.comment, casePart);
  995. caseConstant := casePart.firstConstant;
  996. WHILE caseConstant # NIL DO
  997. FOR value := caseConstant.min TO caseConstant.max DO
  998. IF (caseConstant = casePart.firstConstant) & (value = caseConstant.min) THEN DEC (indent); PrintIndent; INC (indent); ELSE writer.Char (Space); END;
  999. writer.String ("case "); writer.Int (value, 0); writer.Char (':');
  1000. END;
  1001. caseConstant := caseConstant.next;
  1002. END;
  1003. writer.Ln; PrintStatements (casePart.statements);
  1004. PrintIndent; writer.String ("break;"); writer.Ln;
  1005. END;
  1006. DEC (indent); PrintIndent; INC (indent); writer.String ("default:"); writer.Ln;
  1007. IF statement.elsePart = NIL THEN
  1008. PrintIndent; writer.String ("ASSERT (false);"); writer.Ln;
  1009. ELSE
  1010. PrintStatements (statement.elsePart);
  1011. PrintIndent; writer.String ("break;"); writer.Ln;
  1012. END;
  1013. EndBlock;
  1014. END VisitCaseStatement;
  1015. PROCEDURE VisitForStatement* (statement: SyntaxTree.ForStatement);
  1016. BEGIN
  1017. PrintIndent; writer.String ("for (");
  1018. PrintExpression (statement.variable); writer.String (" = "); PrintExpression (statement.from); writer.String ("; "); PrintExpression (statement.variable);
  1019. IF (statement.by # NIL) & (statement.by.resolved(SyntaxTree.IntegerValue).value < 0) THEN writer.String (" >= "); ELSE writer.String (" <= "); END;
  1020. PrintExpression (statement.to); writer.String ("; "); PrintExpression (statement.variable); writer.String (" += ");
  1021. IF statement.by = NIL THEN writer.Char ('1'); ELSE PrintExpression (statement.by); END;
  1022. writer.Char (')'); writer.Ln; BeginBlock; PrintStatements (statement.statements); EndBlock;
  1023. END VisitForStatement;
  1024. PROCEDURE VisitProcedureCallStatement* (statement: SyntaxTree.ProcedureCallStatement);
  1025. BEGIN PrintIndent; PrintExpression (statement.call); writer.Char (Semicolon); writer.Ln;
  1026. END VisitProcedureCallStatement;
  1027. PROCEDURE VisitSymbolDesignator* (expression: SyntaxTree.SymbolDesignator);
  1028. VAR name: Identifier; recordType: SyntaxTree.RecordType;
  1029. BEGIN
  1030. recordType := NIL;
  1031. IF (expression.left # NIL) & (expression.left.type.resolved # SyntaxTree.importType) THEN
  1032. IF expression.left.type.resolved IS SyntaxTree.RecordType THEN
  1033. recordType := expression.left.type.resolved(SyntaxTree.RecordType);
  1034. IF expression.symbol IS SyntaxTree.Procedure THEN
  1035. writer.String ("(("); GetSymbolName (recordType.typeDeclaration, name, backend.style); writer.String (name); writer.String (TypeTag); writer.String ("*) ");
  1036. PrintExpression (expression.left(SyntaxTree.DereferenceDesignator).left); writer.String ("->"); writer.String (TypeDescriptorTag); writer.String (")->");
  1037. expression.symbol.GetName(name); FixIdentifier (name, backend.style); writer.String (name); RETURN;
  1038. ELSE
  1039. PrintExpression (expression.left);
  1040. AccessBase (recordType, expression.symbol.scope(SyntaxTree.RecordScope).ownerRecord);
  1041. END;
  1042. ELSE
  1043. PrintExpression (expression.left);
  1044. END;
  1045. writer.Char ('.');
  1046. END;
  1047. GetSymbolName (expression.symbol, name, backend.style);
  1048. IF IsVarParameter (expression.symbol) & ~IsOpenArray (expression.type) OR
  1049. ((expression.symbol IS SyntaxTree.Parameter) OR (expression.symbol IS SyntaxTree.Variable)) &
  1050. (expression.symbol.scope IS SyntaxTree.ProcedureScope) & (expression.symbol.scope # currentProcedureScope) THEN
  1051. writer.Char ('('); writer.Char ('*'); writer.String (name); writer.Char (')');
  1052. ELSE
  1053. writer.String (name);
  1054. END;
  1055. END VisitSymbolDesignator;
  1056. PROCEDURE VisitBuiltinCallDesignator* (expression: SyntaxTree.BuiltinCallDesignator);
  1057. VAR argument: ARRAY 3 OF SyntaxTree.Expression; i: LONGINT; name: Identifier;
  1058. position: LONGINT; typeDeclaration: SyntaxTree.TypeDeclaration;
  1059. BEGIN
  1060. FOR i := 0 TO LEN (argument) - 1 DO
  1061. IF i < expression.parameters.Length () THEN argument[i] := expression.parameters.GetExpression (i); ELSE argument[i] := NIL; END;
  1062. END;
  1063. position := expression.position.start;
  1064. CASE expression.id OF
  1065. | Global.Incl: PrintExpression (argument[0]); writer.String (" |= 1 << ("); PrintExpression (argument[1]); writer.Char (')');
  1066. | Global.Excl: PrintExpression (argument[0]); writer.String (" &= ~(1 << ("); PrintExpression (argument[1]); writer.Char (')'); writer.Char (')');
  1067. | Global.Inc: PrintExpression (argument[0]); writer.String (" += "); PrintExpression (argument[1]);
  1068. | Global.Dec: PrintExpression (argument[0]); writer.String (" -= "); PrintExpression (argument[1]);
  1069. | Global.Assert: IF argument[0].resolved = NIL THEN writer.String ("ASSERT ("); PrintExpression (argument[0]); writer.Char (')') END;
  1070. | Global.Halt, Global.systemHalt: writer.String ("ASSERT (false)");
  1071. | Global.Ord: PrintExpression (argument[0]);
  1072. | Global.Chr: PrintExpression (argument[0]);
  1073. | Global.Short, Global.Long: writer.Char ('('); PrintType (FALSE, expression.type, ""); writer.Char (')'); writer.Char (Space); PrintExpression (argument[0]);
  1074. | Global.Entier, Global.EntierH: writer.String ("floor ("); PrintExpression (argument[0]); writer.Char (')');
  1075. | Global.Cap: writer.String ("Capitalize ("); PrintExpression (argument[0]); writer.Char (')');
  1076. | Global.Odd: writer.Char ('('); PrintExpression (argument[0]); writer.String (" & 1)");
  1077. | Global.Ash: writer.Char ('('); PrintExpression (argument[0]); IF IsNegative (argument[1]) THEN writer.String (" >> - ") ELSE writer.String (" << ") END; PrintExpression (argument[1]); writer.Char (')');
  1078. | Global.Abs: IF (expression.type.resolved IS SyntaxTree.FloatType) THEN writer.Char ('f') END;
  1079. writer.String ("abs ("); PrintExpression (argument[0]); writer.Char (')');
  1080. | Global.Min, Global.Max: PrintExpression (expression.resolved);
  1081. | Global.New: PrintNew (expression.parameters);
  1082. | Global.Dispose: writer.String ("Dispose (&"); PrintExpression (argument[0]); writer.Char (')');
  1083. | Global.Len:
  1084. IF argument[0] IS SyntaxTree.DereferenceDesignator THEN PrintExpression (argument[0](SyntaxTree.DereferenceDesignator).left); writer.String ("->length[0]");
  1085. ELSE PrintExpression (argument[0]); writer.String (LenTag); writer.Char ('0') END;
  1086. | Global.Copy: writer.String ("strcpy ("); PrintExpression (argument[1]); writer.String (", "); PrintExpression (argument[0]); writer.Char (')');
  1087. | Global.systemAdr: writer.String ("(("); PrintType (FALSE, backend.system.addressType, ""); writer.String (") &"); PrintExpression (argument[0]); writer.Char (')');
  1088. | Global.systemGet: PrintExpression (argument[1]); writer.String (" = *(("); PrintType (TRUE, argument[1].type, ""); writer.String (") "); PrintExpression (argument[0]); writer.Char (')');
  1089. | Global.systemGet8, Global.systemGet16, Global.systemGet32, Global.systemGet64:
  1090. writer.String ("*(("); PrintType (TRUE, expression.type, ""); writer.String (") "); PrintExpression (argument[0]); writer.Char (')');
  1091. | Global.systemPut, Global.systemPut8, Global.systemPut16, Global.systemPut32, Global.systemPut64:
  1092. writer.String ("*(("); PrintType (TRUE, argument[1].type, ""); writer.String (") "); PrintExpression (argument[0]); writer.String (") = "); PrintExpression (argument[1]);
  1093. | Global.systemMove: writer.String ("memcpy ("); PrintExpression (argument[1]); writer.String (", "); PrintExpression (argument[0]); writer.String (", "); PrintExpression (argument[2]); writer.Char (')');
  1094. | Global.systemVal:
  1095. IF (argument[1] IS SyntaxTree.SymbolDesignator) & (argument[1].resolved = NIL) THEN
  1096. writer.String ("*(("); PrintType (TRUE, GetDeclaredType (argument[0]), ""); writer.String (") &"); PrintExpression (argument[1]); writer.Char (')');
  1097. ELSE
  1098. writer.String ("("); PrintType (FALSE, GetDeclaredType (argument[0]), ""); writer.String (") "); PrintExpression (argument[1]);
  1099. END;
  1100. | Global.Lsh: writer.Char ('('); PrintExpression (argument[0]); IF IsNegative (argument[1]) THEN writer.String (" >> - ") ELSE writer.String (" << ") END; PrintExpression (argument[1]); writer.Char (')');
  1101. | Global.Rot: writer.String ("(("); PrintExpression (argument[0]); writer.String (" << "); PrintExpression (argument[1]); writer.String (") | (");
  1102. PrintExpression (argument[0]); writer.String (" >> (sizeof ("); PrintType (FALSE, expression.type, ""); writer.String (") * 8 - "); PrintExpression (argument[1]); writer.String (")))");
  1103. | Global.systemSize: writer.String ("sizeof ("); PrintType (FALSE, GetDeclaredType (argument[0]), ""); writer.Char (')');
  1104. | Global.systemTypeCode: typeDeclaration := argument[0](SyntaxTree.SymbolDesignator).symbol(SyntaxTree.TypeDeclaration);
  1105. IF typeDeclaration.declaredType.resolved IS SyntaxTree.PointerType THEN
  1106. typeDeclaration := typeDeclaration.declaredType.resolved(SyntaxTree.PointerType).pointerBase.resolved.typeDeclaration;
  1107. END;
  1108. GetSymbolName (typeDeclaration, name, backend.style); writer.Char ('&'); writer.String (name); writer.String (TypeDescriptorTag);
  1109. | Global.GetProcedure: PrintExpression (argument[2]); writer.String (" = 0");
  1110. |Global.systemTrace: FOR i := 0 TO expression.parameters.Length () - 1 DO Trace (expression.parameters.GetExpression (i)) END;
  1111. END;
  1112. END VisitBuiltinCallDesignator;
  1113. PROCEDURE VisitProcedureCallDesignator* (expression: SyntaxTree.ProcedureCallDesignator);
  1114. VAR procedureType: SyntaxTree.ProcedureType; first: BOOLEAN;
  1115. VAR symbolDesignator: SyntaxTree.SymbolDesignator; scope: SyntaxTree.Scope;
  1116. BEGIN
  1117. IF expression.left IS SyntaxTree.SymbolDesignator THEN
  1118. symbolDesignator := expression.left(SyntaxTree.SymbolDesignator);
  1119. IF symbolDesignator.symbol IS SyntaxTree.Procedure THEN
  1120. scope := symbolDesignator.symbol.scope;
  1121. END;
  1122. ELSE
  1123. symbolDesignator := NIL; scope := NIL;
  1124. END;
  1125. procedureType := expression.left.type.resolved(SyntaxTree.ProcedureType);
  1126. PrintExpression (expression.left); writer.Char (Space); writer.Char ('(');
  1127. first := PrintArguments (expression.parameters, 0, expression.parameters.Length (), procedureType.firstParameter, scope);
  1128. IF (symbolDesignator # NIL) & IsMethod (symbolDesignator) THEN
  1129. IF first THEN first := FALSE ELSE writer.String (", ") END;
  1130. IF symbolDesignator.left # NIL THEN
  1131. PrintExpression (symbolDesignator.left(SyntaxTree.DereferenceDesignator).left);
  1132. ELSE
  1133. PrintSelf;
  1134. END;
  1135. ELSIF expression.left IS SyntaxTree.SupercallDesignator THEN
  1136. IF expression.parameters.Length () > 0 THEN writer.String (", ") END; PrintSelf;
  1137. ELSIF IsDelegate (procedureType) THEN
  1138. IF expression.parameters.Length () > 0 THEN writer.String (", ") END;
  1139. PrintExpression (expression.left); writer.String (DelegateTag);
  1140. END;
  1141. writer.Char (')');
  1142. END VisitProcedureCallDesignator;
  1143. PROCEDURE VisitBooleanValue* (expression: SyntaxTree.BooleanValue);
  1144. BEGIN IF expression.value THEN writer.Char ('1'); ELSE writer.Char ('0'); END;
  1145. END VisitBooleanValue;
  1146. PROCEDURE VisitIntegerValue* (expression: SyntaxTree.IntegerValue);
  1147. BEGIN IF expression.value = expression.hvalue THEN writer.Int (expression.value, 0); ELSE writer.String ("0x"); writer.Hex (expression.hvalue, 0); END;
  1148. END VisitIntegerValue;
  1149. PROCEDURE VisitCharacterValue* (expression: SyntaxTree.CharacterValue);
  1150. BEGIN PrintCharacter (expression.value);
  1151. END VisitCharacterValue;
  1152. PROCEDURE VisitSetValue* (expression: SyntaxTree.SetValue);
  1153. VAR i: INTEGER; mask, value: HUGEINT;
  1154. BEGIN
  1155. mask := 1; value := 0;
  1156. FOR i := MIN (SET) TO MAX (SET) DO IF i IN expression.value THEN INC (value, mask); END; INC (mask, mask); END;
  1157. writer.String ("0x"); writer.Hex (value, 0);
  1158. END VisitSetValue;
  1159. PROCEDURE VisitRealValue* (expression: SyntaxTree.RealValue);
  1160. BEGIN writer.FloatFix (expression.value, 0, 5, 0);
  1161. END VisitRealValue;
  1162. PROCEDURE VisitStringValue* (expression: SyntaxTree.StringValue);
  1163. VAR char: CHAR; i: LONGINT;
  1164. BEGIN
  1165. writer.Char ('"'); i := 0;
  1166. LOOP
  1167. char := expression.value[i];
  1168. IF char = 0X THEN EXIT END;
  1169. IF char = '"' THEN writer.Char ('\') END;
  1170. writer.Char (char); INC (i);
  1171. END;
  1172. writer.Char ('"');
  1173. END VisitStringValue;
  1174. PROCEDURE VisitNilValue* (expression: SyntaxTree.NilValue);
  1175. BEGIN writer.Char ('0');
  1176. END VisitNilValue;
  1177. PROCEDURE VisitEnumerationValue* (expression: SyntaxTree.EnumerationValue);
  1178. BEGIN writer.Int (expression.value, 0);
  1179. END VisitEnumerationValue;
  1180. PROCEDURE VisitUnaryExpression* (expression: SyntaxTree.UnaryExpression);
  1181. BEGIN
  1182. CASE expression.operator OF
  1183. | Scanner.Plus:
  1184. | Scanner.Minus: IF expression.type.resolved IS SyntaxTree.SetType THEN writer.Char ('~') ELSE writer.Char ('-') END;
  1185. | Scanner.Not: writer.Char ('!');
  1186. END;
  1187. PrintExpression (expression.left);
  1188. END VisitUnaryExpression;
  1189. PROCEDURE VisitTypeGuardDesignator* (expression: SyntaxTree.TypeGuardDesignator);
  1190. VAR isRecord: BOOLEAN;
  1191. BEGIN
  1192. isRecord := expression.type.resolved IS SyntaxTree.RecordType;
  1193. IF isRecord THEN writer.String ("(*") END;
  1194. writer.String ("(ASSERT ("); CompareTypeDescriptor (expression.left, expression.type); writer.String ("), (");
  1195. PrintType (isRecord, expression.type, ""); writer.String (") ");
  1196. IF isRecord THEN writer.Char ('&') END;
  1197. PrintExpression (expression.left); writer.Char (')');
  1198. IF isRecord THEN writer.Char (')') END;
  1199. END VisitTypeGuardDesignator;
  1200. PROCEDURE VisitSupercallDesignator(expression: SyntaxTree.SupercallDesignator);
  1201. VAR name: Identifier; procedure: SyntaxTree.Procedure;
  1202. BEGIN
  1203. procedure := expression.left(SyntaxTree.SymbolDesignator).symbol(SyntaxTree.Procedure);
  1204. GetSymbolName (procedure.super, name, backend.style); writer.String (name);
  1205. END VisitSupercallDesignator;
  1206. PROCEDURE VisitBinaryExpression* (expression: SyntaxTree.BinaryExpression);
  1207. BEGIN
  1208. IF expression.operator = Scanner.In THEN
  1209. writer.String ("(("); PrintExpression (expression.right); writer.String (" >> ");
  1210. PrintExpression (expression.left); writer.String (") & 1)"); RETURN;
  1211. ELSIF expression.operator = Scanner.Is THEN
  1212. CompareTypeDescriptor (expression.left, GetDeclaredType (expression.right));
  1213. RETURN;
  1214. END;
  1215. writer.Char ('(');
  1216. IF IsString (expression.left.type) THEN
  1217. writer.String ("strcmp ("); PrintExpression (expression.left); writer.Char (Comma); writer.Char (Space); PrintExpression (expression.right); writer.Char (')');
  1218. ELSE
  1219. PrintExpression (expression.left);
  1220. END;
  1221. writer.Char (Space);
  1222. CASE expression.operator OF
  1223. | Scanner.Equal: writer.String ("==");
  1224. | Scanner.Unequal: writer.String ("!=");
  1225. | Scanner.Less: writer.String ("<");
  1226. | Scanner.LessEqual: writer.String ("<=");
  1227. | Scanner.Greater: writer.String (">");
  1228. | Scanner.GreaterEqual: writer.String (">=");
  1229. | Scanner.And: writer.String ("&&");
  1230. | Scanner.Or: writer.String ("||");
  1231. | Scanner.Plus: IF expression.type.resolved IS SyntaxTree.SetType THEN writer.Char ('|') ELSE writer.Char ('+') END;
  1232. | Scanner.Minus: IF expression.type.resolved IS SyntaxTree.SetType THEN writer.Char ('&'); writer.Char ('~') ELSE writer.Char ('-') END;
  1233. | Scanner.Times: IF expression.type.resolved IS SyntaxTree.SetType THEN writer.Char ('&') ELSE writer.Char ('*') END;
  1234. | Scanner.Slash, Scanner.Div: IF expression.type.resolved IS SyntaxTree.SetType THEN writer.Char ('^') ELSE writer.Char ('/') END;
  1235. | Scanner.Mod: writer.Char ('%');
  1236. END;
  1237. writer.Char (Space);
  1238. IF IsString (expression.left.type) THEN writer.Char ('0'); ELSE PrintExpression (expression.right); END; writer.Char (')');
  1239. END VisitBinaryExpression;
  1240. PROCEDURE VisitSelfDesignator* (expression: SyntaxTree.SelfDesignator);
  1241. BEGIN PrintSelf;
  1242. END VisitSelfDesignator;
  1243. PROCEDURE VisitIndexDesignator* (expression: SyntaxTree.IndexDesignator);
  1244. VAR i: LONGINT;
  1245. BEGIN
  1246. PrintExpression (expression.left);
  1247. FOR i := 0 TO expression.parameters.Length () - 1 DO
  1248. writer.Char ('[');
  1249. PrintExpression (expression.parameters.GetExpression (i));
  1250. writer.Char (']');
  1251. END;
  1252. END VisitIndexDesignator;
  1253. PROCEDURE VisitConversion* (expression: SyntaxTree.Conversion);
  1254. VAR e: SyntaxTree.Expression;
  1255. BEGIN
  1256. IF (expression.type IS SyntaxTree.CharacterType) & (expression.expression.type IS SyntaxTree.StringType) THEN
  1257. PrintCharacter (expression.expression.resolved(SyntaxTree.StringValue).value[0]);
  1258. ELSE
  1259. PrintExpression (expression.expression);
  1260. END;
  1261. END VisitConversion;
  1262. PROCEDURE VisitDereferenceDesignator* (expression: SyntaxTree.DereferenceDesignator);
  1263. BEGIN
  1264. IF expression.type IS SyntaxTree.ArrayType THEN
  1265. writer.String ("(*("); PrintType (TRUE, expression.type, ""); writer.String (") &");
  1266. PrintExpression (expression.left); writer.String ("->array)");
  1267. ELSE
  1268. PrintExpression (expression.left); writer.String ("->record");
  1269. END;
  1270. END VisitDereferenceDesignator;
  1271. PROCEDURE VisitSet* (expression: SyntaxTree.Set);
  1272. VAR i: LONGINT; element: SyntaxTree.Expression;
  1273. BEGIN
  1274. IF expression.elements.Length () = 0 THEN
  1275. writer.Char ('0');
  1276. ELSE
  1277. writer.Char ('(');
  1278. FOR i := 0 TO expression.elements.Length () - 1 DO
  1279. IF i # 0 THEN writer.String (" | "); END;
  1280. element := expression.elements.GetExpression (i);
  1281. IF element IS SyntaxTree.RangeExpression THEN
  1282. writer.String ("(("); PrintType (FALSE, backend.system.setType, ""); writer.String (") - 1 << "); PrintExpression (element(SyntaxTree.RangeExpression).first);
  1283. writer.String (" & ~(("); PrintType (FALSE, backend.system.setType, ""); writer.String (") - 2 << "); PrintExpression (element(SyntaxTree.RangeExpression).last); writer.String ("))");
  1284. ELSE
  1285. writer.String ("1 << "); PrintExpression (element);
  1286. END;
  1287. END;
  1288. writer.Char (')');
  1289. END;
  1290. END VisitSet;
  1291. END Transpiler;
  1292. TYPE TranspilerBackend*= OBJECT (Backend.Backend)
  1293. VAR
  1294. defineMain, declarations, initLocalData: BOOLEAN;
  1295. addressSize: LONGINT; style: Style;
  1296. traceModule: Identifier;
  1297. PROCEDURE &InitTranspilerBackend;
  1298. BEGIN InitBackend;
  1299. END InitTranspilerBackend;
  1300. PROCEDURE ProcessSyntaxTreeModule* (module: SyntaxTree.Module): Formats.GeneratedModule;
  1301. VAR filename, pathname, fullname: Files.FileName; file: Files.File; writer: Files.Writer; transpiler: Transpiler;
  1302. BEGIN
  1303. Files.SplitPath (module.sourceName, pathname, filename); GetHeaderName (module, filename, style);
  1304. IF pathname = "" THEN fullname := filename ELSE Files.JoinPath (pathname, filename, fullname) END;
  1305. file := Files.New (fullname); Files.OpenWriter (writer, file, 0);
  1306. Replace (filename, '.', '_'); Strings.UpperCase (filename); Strings.Append (filename, "_INCLUDED");
  1307. writer.String ("#ifndef "); writer.String (filename); writer.Ln; writer.String ("#define "); writer.String (filename); writer.Ln; writer.Ln;
  1308. writer.String ("/* C header file generated from '"); writer.String (module.sourceName); writer.String ("' */"); writer.Ln;
  1309. NEW (transpiler, writer, SELF, initLocalData); transpiler.DeclareModule (module);
  1310. writer.Ln; writer.String ("#endif /* "); writer.String (filename); writer.String (" */"); writer.Ln; writer.Update; Files.Register (file);
  1311. IF declarations THEN RETURN NIL END; GetSourceName (module, filename, style);
  1312. IF pathname = "" THEN fullname := filename ELSE Files.JoinPath (pathname, filename, fullname) END;
  1313. file := Files.New (fullname); Files.OpenWriter (writer, file, 0);
  1314. writer.String ("/* C source file generated from '"); writer.String (module.sourceName); writer.String ("' */"); writer.Ln;
  1315. NEW (transpiler, writer, SELF, initLocalData); transpiler.DefineModule (module);
  1316. IF defineMain THEN transpiler.DefineMain (module); END; writer.Update; Files.Register (file);
  1317. RETURN NIL;
  1318. END ProcessSyntaxTreeModule;
  1319. PROCEDURE DefineOptions* (options: Options.Options);
  1320. BEGIN DefineOptions^(options);
  1321. options.Add(0X,"defineMain", Options.Flag);
  1322. options.Add(0X,"declarations", Options.Flag);
  1323. options.Add(0X,"addressSize", Options.Integer);
  1324. options.Add(0X,"style", Options.String);
  1325. options.Add(0X,"traceModule", Options.String);
  1326. options.Add(0X,"noLocalInit", Options.Flag);
  1327. END DefineOptions;
  1328. PROCEDURE GetOptions* (options: Options.Options);
  1329. VAR styleName: ARRAY 32 OF CHAR;
  1330. BEGIN GetOptions^(options);
  1331. defineMain := options.GetFlag ("defineMain");
  1332. declarations := options.GetFlag ("declarations");
  1333. IF ~options.GetInteger ("addressSize", addressSize) THEN addressSize := 32 END;
  1334. IF ~options.GetString ("style", styleName) OR (styleName # "staila") THEN style := DefaultStyle ELSE style := StailaStyle END;
  1335. IF ~options.GetString ("traceModule", traceModule) THEN traceModule := "KernelLog" END;
  1336. initLocalData := ~options.GetFlag("noLocalInit");
  1337. END GetOptions;
  1338. PROCEDURE DefaultSymbolFileFormat* (): Formats.SymbolFileFormat;
  1339. BEGIN RETURN SymbolFileFormat.Get ();
  1340. END DefaultSymbolFileFormat;
  1341. PROCEDURE GetSystem*(): Global.System;
  1342. VAR system: Global.System;
  1343. BEGIN
  1344. NEW(system, 8, 8, addressSize, 8, 32, 32, 32, 64, FALSE);
  1345. Global.SetDefaultDeclarations(system,8);
  1346. Global.SetDefaultOperators(system);
  1347. RETURN system;
  1348. END GetSystem;
  1349. END TranspilerBackend;
  1350. PROCEDURE AppendName (identifier: SyntaxTree.Identifier; VAR name: ARRAY OF CHAR; style: Style);
  1351. VAR temp: Identifier;
  1352. BEGIN Strings.Append (name, "_"); Basic.GetString(identifier,temp); Strings.Append (name, temp);
  1353. END AppendName;
  1354. PROCEDURE IsEmptyRecord (record: SyntaxTree.RecordType): BOOLEAN;
  1355. BEGIN
  1356. IF record.isObject OR (record.baseType # NIL) & ~IsEmptyRecord (record.GetBaseRecord ()) THEN RETURN FALSE END;
  1357. RETURN record.recordScope.firstVariable = NIL;
  1358. END IsEmptyRecord;
  1359. PROCEDURE GetSymbolName (symbol: SyntaxTree.Symbol; VAR name: ARRAY OF CHAR; style: Style);
  1360. BEGIN
  1361. IF symbol IS SyntaxTree.Module THEN
  1362. IF (symbol(SyntaxTree.Module).context # SyntaxTree.invalidIdentifier) & (symbol(SyntaxTree.Module).context # Global.A2Name) THEN
  1363. Basic.GetString(symbol(SyntaxTree.Module).context,name); Strings.Append (name, "_"); AppendName (symbol.name, name, style);
  1364. ELSE
  1365. symbol.GetName(name);
  1366. END;
  1367. ELSIF symbol IS SyntaxTree.Parameter THEN
  1368. symbol.GetName(name);
  1369. ELSIF (symbol IS SyntaxTree.Variable) & ~(symbol.scope IS SyntaxTree.ModuleScope) THEN
  1370. symbol.GetName(name);
  1371. ELSE
  1372. GetScopeName (symbol.scope, name, style); AppendName (symbol.name, name, style);
  1373. END;
  1374. FixIdentifier (name, style);
  1375. END GetSymbolName;
  1376. PROCEDURE GetScopeName (scope: SyntaxTree.Scope; VAR name: ARRAY OF CHAR; style: Style);
  1377. BEGIN
  1378. IF scope IS SyntaxTree.ProcedureScope THEN
  1379. GetScopeName (scope.outerScope, name, style); AppendName (scope(SyntaxTree.ProcedureScope).ownerProcedure.name, name, style);
  1380. ELSIF scope IS SyntaxTree.RecordScope THEN
  1381. GetSymbolName (scope(SyntaxTree.RecordScope).ownerRecord.typeDeclaration, name, style);
  1382. ELSIF scope IS SyntaxTree.ModuleScope THEN
  1383. GetSymbolName (scope(SyntaxTree.ModuleScope).ownerModule, name, style);
  1384. END;
  1385. END GetScopeName;
  1386. PROCEDURE GetSourceName (module: SyntaxTree.Module; VAR filename: Files.FileName; style: Style);
  1387. BEGIN GetSymbolName (module, filename, style); Strings.Append (filename, ".c");
  1388. END GetSourceName;
  1389. PROCEDURE GetHeaderName (module: SyntaxTree.Module; VAR filename: Files.FileName; style: Style);
  1390. BEGIN GetSymbolName (module, filename, style); Strings.Append (filename, ".h");
  1391. END GetHeaderName;
  1392. PROCEDURE GetConstructor (recordType: SyntaxTree.RecordType): SyntaxTree.Procedure;
  1393. VAR constructor: SyntaxTree.Procedure; base: SyntaxTree.Type;
  1394. BEGIN
  1395. LOOP
  1396. constructor := recordType.recordScope.constructor;
  1397. IF constructor # NIL THEN RETURN constructor END;
  1398. base := recordType.baseType;
  1399. IF base = NIL THEN RETURN NIL END;
  1400. IF base.resolved IS SyntaxTree.PointerType THEN
  1401. base := base.resolved(SyntaxTree.PointerType).pointerBase;
  1402. END;
  1403. IF ~(base.resolved IS SyntaxTree.RecordType) THEN RETURN NIL END;
  1404. recordType := base.resolved(SyntaxTree.RecordType);
  1405. END;
  1406. END GetConstructor;
  1407. PROCEDURE GetStatementProcedure (statement: SyntaxTree.Statement): SyntaxTree.ProcedureScope;
  1408. BEGIN WHILE statement.outer # NIL DO statement := statement.outer END; RETURN statement(SyntaxTree.Body).inScope;
  1409. END GetStatementProcedure;
  1410. PROCEDURE GetDeclaredType (expression: SyntaxTree.Expression): SyntaxTree.Type;
  1411. BEGIN RETURN expression(SyntaxTree.SymbolDesignator).symbol(SyntaxTree.TypeDeclaration).declaredType;
  1412. END GetDeclaredType;
  1413. PROCEDURE IsMethod (expression: SyntaxTree.SymbolDesignator): BOOLEAN;
  1414. VAR scope: SyntaxTree.Scope;
  1415. BEGIN
  1416. IF ~(expression.symbol IS SyntaxTree.Procedure) THEN RETURN FALSE END;
  1417. scope := expression.symbol.scope;
  1418. WHILE scope IS SyntaxTree.ProcedureScope DO scope := scope.outerScope END;
  1419. RETURN scope IS SyntaxTree.RecordScope;
  1420. END IsMethod;
  1421. PROCEDURE IsVarParameter (symbol: SyntaxTree.Symbol): BOOLEAN;
  1422. 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));
  1423. END IsVarParameter;
  1424. PROCEDURE IsInExclusiveBlock (statement: SyntaxTree.Statement): BOOLEAN;
  1425. BEGIN
  1426. WHILE statement # NIL DO
  1427. IF (statement IS SyntaxTree.StatementBlock) & statement(SyntaxTree.StatementBlock).isExclusive THEN RETURN TRUE END;
  1428. statement := statement.outer;
  1429. END;
  1430. RETURN FALSE;
  1431. END IsInExclusiveBlock;
  1432. PROCEDURE IsOpenArray (type: SyntaxTree.Type): BOOLEAN;
  1433. BEGIN RETURN (type IS SyntaxTree.ArrayType) & (type(SyntaxTree.ArrayType).staticLength = 0);
  1434. END IsOpenArray;
  1435. PROCEDURE IsStaticArray (type: SyntaxTree.Type): BOOLEAN;
  1436. BEGIN RETURN (type IS SyntaxTree.ArrayType) & (type(SyntaxTree.ArrayType).staticLength # 0);
  1437. END IsStaticArray;
  1438. PROCEDURE IsDelegate (type: SyntaxTree.Type): BOOLEAN;
  1439. BEGIN RETURN (type IS SyntaxTree.ProcedureType) & type(SyntaxTree.ProcedureType).isDelegate;
  1440. END IsDelegate;
  1441. PROCEDURE IsStructuredType (type: SyntaxTree.Type): BOOLEAN;
  1442. BEGIN RETURN (type.resolved IS SyntaxTree.ArrayType) OR (type.resolved IS SyntaxTree.RecordType);
  1443. END IsStructuredType;
  1444. PROCEDURE IsString (type: SyntaxTree.Type): BOOLEAN;
  1445. BEGIN RETURN (type.resolved IS SyntaxTree.StringType) OR (type.resolved IS SyntaxTree.ArrayType) & (type.resolved(SyntaxTree.ArrayType).arrayBase.resolved IS SyntaxTree.CharacterType);
  1446. END IsString;
  1447. PROCEDURE IsEmptyString (type: SyntaxTree.Type): BOOLEAN;
  1448. BEGIN RETURN (type.resolved IS SyntaxTree.StringType) & (type.resolved(SyntaxTree.StringType).length = 1);
  1449. END IsEmptyString;
  1450. PROCEDURE IsNegative (expression: SyntaxTree.Expression): BOOLEAN;
  1451. BEGIN RETURN (expression.resolved # NIL) & (expression.resolved IS SyntaxTree.IntegerValue) & (expression.resolved(SyntaxTree.IntegerValue).value < 0);
  1452. END IsNegative;
  1453. PROCEDURE IsInlineAssemblyCode (procedure: SyntaxTree.Procedure): BOOLEAN;
  1454. VAR type: SyntaxTree.ProcedureType; body: SyntaxTree.Body;
  1455. BEGIN
  1456. type := procedure.type(SyntaxTree.ProcedureType); body := procedure.procedureScope.body;
  1457. RETURN (procedure.isInline) & (type.firstParameter = NIL) & (type.returnType = NIL) & (body # NIL) & (body.code # NIL);
  1458. END IsInlineAssemblyCode;
  1459. PROCEDURE GetRecordMethod (record: SyntaxTree.RecordType; method: LONGINT): SyntaxTree.Procedure;
  1460. VAR base: SyntaxTree.RecordType; scope: SyntaxTree.RecordScope; procedure: SyntaxTree.Procedure;
  1461. BEGIN
  1462. scope := record.recordScope;
  1463. LOOP
  1464. procedure := scope.firstProcedure;
  1465. WHILE (procedure # NIL) & (procedure.methodNumber #method) DO procedure := procedure.nextProcedure END;
  1466. IF procedure # NIL THEN RETURN procedure END;
  1467. base := scope.ownerRecord.GetBaseRecord ();
  1468. scope := base.recordScope;
  1469. END;
  1470. END GetRecordMethod;
  1471. PROCEDURE GetRecord (type: SyntaxTree.Type): SyntaxTree.RecordType;
  1472. BEGIN
  1473. IF type IS SyntaxTree.RecordType THEN RETURN type(SyntaxTree.RecordType)
  1474. ELSIF type IS SyntaxTree.PointerType THEN
  1475. type := type(SyntaxTree.PointerType).pointerBase.resolved;
  1476. IF (type IS SyntaxTree.RecordType) & (type(SyntaxTree.RecordType).pointerType # NIL) THEN RETURN type(SyntaxTree.RecordType) END;
  1477. END;
  1478. RETURN NIL;
  1479. END GetRecord;
  1480. PROCEDURE Replace (VAR string: ARRAY OF CHAR; replace, by: CHAR);
  1481. VAR i: LONGINT; char: CHAR;
  1482. BEGIN
  1483. i := 0; char := string[0];
  1484. WHILE char # 0X DO IF char = replace THEN string[i] := by; END; INC (i); char := string[i]; END;
  1485. END Replace;
  1486. PROCEDURE FixStailaIdentifier (VAR identifier: ARRAY OF CHAR);
  1487. VAR i: LONGINT; previousLower: BOOLEAN;
  1488. BEGIN
  1489. i := 0; previousLower := FALSE;
  1490. WHILE identifier[i] # 0X DO
  1491. IF (ORD (identifier[i]) >= ORD ('A')) & (ORD (identifier[i]) <= ORD ('Z')) THEN
  1492. IF previousLower THEN Strings.Insert ("_", identifier, i); INC (i) END;
  1493. identifier[i] := Strings.LOW (identifier[i]); previousLower := FALSE;
  1494. ELSE
  1495. previousLower := (ORD (identifier[i]) >= ORD ('a')) & (ORD (identifier[i]) <= ORD ('z'));
  1496. END;
  1497. INC (i);
  1498. END;
  1499. END FixStailaIdentifier;
  1500. PROCEDURE FixIdentifier (VAR identifier: ARRAY OF CHAR; style: Style);
  1501. CONST Tag = '_';
  1502. BEGIN
  1503. Replace (identifier, '$', Tag); Replace (identifier, '@', Tag);
  1504. (* IF style = StailaStyle THEN FixStailaIdentifier (identifier) END; *)
  1505. IF (identifier = "int") OR (identifier = "return") OR (identifier = "enum") OR
  1506. (identifier = "char") OR (identifier = "register") OR (identifier = "continue") THEN
  1507. Strings.Append (identifier, Tag);
  1508. END;
  1509. END FixIdentifier;
  1510. PROCEDURE Get* (): Backend.Backend;
  1511. VAR backend: TranspilerBackend;
  1512. BEGIN NEW(backend); RETURN backend;
  1513. END Get;
  1514. END FoxTranspilerBackend.
  1515. SystemTools.Free FoxTranspilerBackend ~
  1516. Compiler.Compile -b=Transpiler Test.Mod ~
  1517. TextCompiler.CompileSelection -b=Transpiler ~
  1518. TextCompiler.CompileSelection -b=Transpiler --defineMain ~
  1519. MODULE Test;
  1520. VAR a: INTEGER;
  1521. END Test.
  1522. FoxTest.Compile --options="-PC -G=Transpiler" --command="WinApplications.Run --hide cl /c Test.c" Oberon.Temp.Test Oberon.Temp.TranspilerTestDiff ~
  1523. 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 ~