FoxTranspilerBackend.Mod 78 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664
  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. VStatement(statement);
  861. END PrintStatement;
  862. PROCEDURE PrintExpression (expression: SyntaxTree.Expression);
  863. BEGIN ASSERT (expression # NIL);
  864. VExpression(expression);
  865. END PrintExpression;
  866. PROCEDURE PrintNegatedExpression (expression: SyntaxTree.Expression);
  867. BEGIN
  868. IF (expression IS SyntaxTree.UnaryExpression) & (expression(SyntaxTree.UnaryExpression).operator = Scanner.Not) THEN
  869. PrintExpression (expression(SyntaxTree.UnaryExpression).left);
  870. ELSE
  871. writer.Char ('!'); writer.Char ('('); PrintExpression (expression); writer.Char (')');
  872. END;
  873. END PrintNegatedExpression;
  874. PROCEDURE VisitAssignment* (statement: SyntaxTree.Assignment);
  875. BEGIN
  876. PrintIndent;
  877. IF IsEmptyString (statement.right.type) THEN
  878. PrintExpression (statement.left); writer.String ("[0] = 0");
  879. ELSIF IsStructuredType (statement.left.type) THEN
  880. ASSERT (~IsOpenArray (statement.left.type.resolved));
  881. writer.String ("memcpy (");
  882. IF ~(statement.left.type.resolved IS SyntaxTree.ArrayType) THEN writer.Char ('&'); END;
  883. PrintExpression (statement.left); writer.String (", ");
  884. IF ~(statement.right.type.resolved IS SyntaxTree.StringType) & ~(statement.right.type.resolved IS SyntaxTree.ArrayType) THEN writer.Char ('&'); END;
  885. PrintExpression (statement.right); writer.String (", sizeof ("); PrintType (FALSE, statement.left.type, ""); writer.String ("))");
  886. ELSE
  887. PrintExpression (statement.left); writer.Char (Space); writer.Char ('='); writer.Char (Space); Convert (statement.right, statement.left.type);
  888. END;
  889. writer.Char (Semicolon); writer.Ln;
  890. IF IsDelegate (statement.left.type.resolved) THEN
  891. PrintIndent; PrintExpression (statement.left); writer.String (DelegateTag);
  892. writer.String (" = "); PrintDelegate (statement.right); writer.Char (Semicolon); writer.Ln;
  893. END;
  894. END VisitAssignment;
  895. PROCEDURE VisitIfStatement* (statement: SyntaxTree.IfStatement);
  896. VAR i: LONGINT;
  897. BEGIN
  898. PrintIndent; PrintIfPart (statement.ifPart);
  899. FOR i := 0 TO statement.ElsifParts () - 1 DO
  900. PrintIndent; writer.String ("else "); PrintIfPart (statement.GetElsifPart (i));
  901. END;
  902. IF statement.elsePart # NIL THEN
  903. PrintIndent; writer.String ("else"); writer.Ln;
  904. BeginBlock; PrintStatements (statement.elsePart); EndBlock;
  905. END;
  906. END VisitIfStatement;
  907. PROCEDURE VisitWithStatement* (statement: SyntaxTree.WithStatement);
  908. VAR withPart: SyntaxTree.WithPart; i: LONGINT;
  909. BEGIN
  910. FOR i := 0 TO statement.WithParts () - 1 DO
  911. withPart := statement.GetWithPart (i); PrintIndent;
  912. IF i > 0 THEN writer.String ("else ") END;
  913. writer.String ("if ("); CompareTypeDescriptor (statement.variable, withPart.type); writer.String (")"); writer.Ln;
  914. BeginBlock; PrintStatements (withPart.statements); EndBlock;
  915. END;
  916. PrintIndent;
  917. IF statement.elsePart = NIL THEN
  918. writer.String ("else ASSERT (false);"); writer.Ln;
  919. ELSE
  920. writer.String ("else"); writer.Ln;
  921. BeginBlock; PrintStatements (statement.elsePart); EndBlock;
  922. END;
  923. END VisitWithStatement;
  924. PROCEDURE VisitWhileStatement* (statement: SyntaxTree.WhileStatement);
  925. BEGIN
  926. PrintIndent; writer.String ("while ("); PrintExpression (statement.condition); writer.Char (')'); writer.Ln;
  927. BeginBlock; PrintStatements (statement.statements); EndBlock;
  928. END VisitWhileStatement;
  929. PROCEDURE VisitRepeatStatement* (statement: SyntaxTree.RepeatStatement);
  930. BEGIN
  931. PrintIndent; writer.String ("do"); writer.Ln;
  932. BeginBlock; PrintStatements (statement.statements); EndBlock;
  933. PrintIndent; writer.String ("while ("); PrintNegatedExpression (statement.condition); writer.String (");"); writer.Ln;
  934. END VisitRepeatStatement;
  935. PROCEDURE VisitLoopStatement* (statement: SyntaxTree.LoopStatement);
  936. BEGIN
  937. PrintIndent; writer.String ("for (;;)"); writer.Ln;
  938. BeginBlock; PrintStatements (statement.statements); EndBlock;
  939. END VisitLoopStatement;
  940. PROCEDURE VisitExitStatement* (statement: SyntaxTree.ExitStatement);
  941. BEGIN PrintIndent; writer.String ("break;"); writer.Ln;
  942. END VisitExitStatement;
  943. PROCEDURE VisitReturnStatement* (statement: SyntaxTree.ReturnStatement);
  944. CONST ResultVariable = "_result";
  945. VAR scope: SyntaxTree.ProcedureScope; locked: BOOLEAN;
  946. BEGIN
  947. scope := GetStatementProcedure (statement);
  948. locked := IsInExclusiveBlock (statement);
  949. IF statement.returnValue # NIL THEN
  950. IF locked THEN
  951. BeginBlock; PrintIndent; PrintVariable (FALSE, ResultVariable, statement.returnValue.type.resolved); writer.Char (Semicolon); writer.Ln;
  952. PrintIndent; writer.String (ResultVariable); writer.String (" = "); PrintExpression (statement.returnValue);
  953. writer.Char (Semicolon); writer.Ln; UnlockScope (scope.outerScope);
  954. PrintIndent; writer.String ("return "); writer.String (ResultVariable); writer.Char (Semicolon); writer.Ln; EndBlock;
  955. ELSE
  956. PrintIndent; writer.String ("return "); PrintExpression (statement.returnValue); writer.Char (Semicolon); writer.Ln;
  957. END
  958. ELSE
  959. IF locked THEN UnlockScope (scope.outerScope); END;
  960. PrintIndent; writer.String ("return"); writer.Char (Semicolon); writer.Ln;
  961. END;
  962. END VisitReturnStatement;
  963. PROCEDURE VisitStatementBlock* (statement: SyntaxTree.StatementBlock);
  964. VAR procedureScope: SyntaxTree.ProcedureScope;
  965. BEGIN
  966. procedureScope := GetStatementProcedure (statement);
  967. IF statement.outer # NIL THEN BeginBlock END;
  968. IF statement.isExclusive THEN LockScope (procedureScope.outerScope) END;
  969. PrintStatements (statement.statements);
  970. IF statement.isExclusive THEN UnlockScope (procedureScope.outerScope) END;
  971. IF statement.outer # NIL THEN EndBlock END;
  972. END VisitStatementBlock;
  973. PROCEDURE VisitAwaitStatement* (statement: SyntaxTree.AwaitStatement);
  974. VAR procedureScope: SyntaxTree.ProcedureScope; name: Identifier;
  975. BEGIN
  976. procedureScope := GetStatementProcedure (statement);
  977. PrintIndent; writer.String ("while ("); PrintNegatedExpression (statement.condition);
  978. writer.String (") "); writer.String ("AwaitCondition (&");
  979. IF procedureScope.outerScope IS SyntaxTree.RecordScope THEN
  980. PrintSelf; writer.String ("->record");
  981. AccessBase (procedureScope.outerScope(SyntaxTree.RecordScope).ownerRecord, NIL);
  982. ELSIF procedureScope.outerScope IS SyntaxTree.ModuleScope THEN
  983. GetScopeName (procedureScope.outerScope, name, backend.style);
  984. writer.String (name); writer.String (StructTag);
  985. END;
  986. writer.Char (')'); writer.Char (Semicolon); writer.Ln;
  987. END VisitAwaitStatement;
  988. PROCEDURE VisitCaseStatement* (statement: SyntaxTree.CaseStatement);
  989. VAR i: LONGINT; value: Basic.Integer; casePart: SyntaxTree.CasePart; caseConstant: SyntaxTree.CaseConstant;
  990. BEGIN
  991. PrintIndent; writer.String ("switch ("); PrintExpression (statement.variable); writer.Char (')'); writer.Ln;
  992. BeginBlock;
  993. FOR i := 0 TO statement.CaseParts () - 1 DO
  994. casePart := statement.GetCasePart (i);
  995. PrintComments (casePart.comment, casePart);
  996. caseConstant := casePart.firstConstant;
  997. WHILE caseConstant # NIL DO
  998. FOR value := caseConstant.min TO caseConstant.max DO
  999. IF (caseConstant = casePart.firstConstant) & (value = caseConstant.min) THEN DEC (indent); PrintIndent; INC (indent); ELSE writer.Char (Space); END;
  1000. writer.String ("case "); writer.Int (value, 0); writer.Char (':');
  1001. END;
  1002. caseConstant := caseConstant.next;
  1003. END;
  1004. writer.Ln; PrintStatements (casePart.statements);
  1005. PrintIndent; writer.String ("break;"); writer.Ln;
  1006. END;
  1007. DEC (indent); PrintIndent; INC (indent); writer.String ("default:"); writer.Ln;
  1008. IF statement.elsePart = NIL THEN
  1009. PrintIndent; writer.String ("ASSERT (false);"); writer.Ln;
  1010. ELSE
  1011. PrintStatements (statement.elsePart);
  1012. PrintIndent; writer.String ("break;"); writer.Ln;
  1013. END;
  1014. EndBlock;
  1015. END VisitCaseStatement;
  1016. PROCEDURE VisitForStatement* (statement: SyntaxTree.ForStatement);
  1017. BEGIN
  1018. PrintIndent; writer.String ("for (");
  1019. PrintExpression (statement.variable); writer.String (" = "); PrintExpression (statement.from); writer.String ("; "); PrintExpression (statement.variable);
  1020. IF (statement.by # NIL) & (statement.by.resolved(SyntaxTree.IntegerValue).value < 0) THEN writer.String (" >= "); ELSE writer.String (" <= "); END;
  1021. PrintExpression (statement.to); writer.String ("; "); PrintExpression (statement.variable); writer.String (" += ");
  1022. IF statement.by = NIL THEN writer.Char ('1'); ELSE PrintExpression (statement.by); END;
  1023. writer.Char (')'); writer.Ln; BeginBlock; PrintStatements (statement.statements); EndBlock;
  1024. END VisitForStatement;
  1025. PROCEDURE VisitProcedureCallStatement* (statement: SyntaxTree.ProcedureCallStatement);
  1026. BEGIN PrintIndent; PrintExpression (statement.call); writer.Char (Semicolon); writer.Ln;
  1027. END VisitProcedureCallStatement;
  1028. PROCEDURE VisitSymbolDesignator* (expression: SyntaxTree.SymbolDesignator);
  1029. VAR name: Identifier; recordType: SyntaxTree.RecordType;
  1030. BEGIN
  1031. recordType := NIL;
  1032. IF (expression.left # NIL) & (expression.left.type.resolved # SyntaxTree.importType) THEN
  1033. IF expression.left.type.resolved IS SyntaxTree.RecordType THEN
  1034. recordType := expression.left.type.resolved(SyntaxTree.RecordType);
  1035. IF expression.symbol IS SyntaxTree.Procedure THEN
  1036. writer.String ("(("); GetSymbolName (recordType.typeDeclaration, name, backend.style); writer.String (name); writer.String (TypeTag); writer.String ("*) ");
  1037. PrintExpression (expression.left(SyntaxTree.DereferenceDesignator).left); writer.String ("->"); writer.String (TypeDescriptorTag); writer.String (")->");
  1038. expression.symbol.GetName(name); FixIdentifier (name, backend.style); writer.String (name); RETURN;
  1039. ELSE
  1040. PrintExpression (expression.left);
  1041. AccessBase (recordType, expression.symbol.scope(SyntaxTree.RecordScope).ownerRecord);
  1042. END;
  1043. ELSE
  1044. PrintExpression (expression.left);
  1045. END;
  1046. writer.Char ('.');
  1047. END;
  1048. GetSymbolName (expression.symbol, name, backend.style);
  1049. IF IsVarParameter (expression.symbol) & ~IsOpenArray (expression.type) OR
  1050. ((expression.symbol IS SyntaxTree.Parameter) OR (expression.symbol IS SyntaxTree.Variable)) &
  1051. (expression.symbol.scope IS SyntaxTree.ProcedureScope) & (expression.symbol.scope # currentProcedureScope) THEN
  1052. writer.Char ('('); writer.Char ('*'); writer.String (name); writer.Char (')');
  1053. ELSE
  1054. writer.String (name);
  1055. END;
  1056. END VisitSymbolDesignator;
  1057. PROCEDURE VisitBuiltinCallDesignator* (expression: SyntaxTree.BuiltinCallDesignator);
  1058. VAR argument: ARRAY 3 OF SyntaxTree.Expression; i: LONGINT; name: Identifier;
  1059. position: LONGINT; typeDeclaration: SyntaxTree.TypeDeclaration;
  1060. BEGIN
  1061. FOR i := 0 TO LEN (argument) - 1 DO
  1062. IF i < expression.parameters.Length () THEN argument[i] := expression.parameters.GetExpression (i); ELSE argument[i] := NIL; END;
  1063. END;
  1064. position := expression.position.start;
  1065. CASE expression.id OF
  1066. | Global.Incl: PrintExpression (argument[0]); writer.String (" |= 1 << ("); PrintExpression (argument[1]); writer.Char (')');
  1067. | Global.Excl: PrintExpression (argument[0]); writer.String (" &= ~(1 << ("); PrintExpression (argument[1]); writer.Char (')'); writer.Char (')');
  1068. | Global.Inc: PrintExpression (argument[0]); writer.String (" += "); PrintExpression (argument[1]);
  1069. | Global.Dec: PrintExpression (argument[0]); writer.String (" -= "); PrintExpression (argument[1]);
  1070. | Global.Assert: IF argument[0].resolved = NIL THEN writer.String ("ASSERT ("); PrintExpression (argument[0]); writer.Char (')') END;
  1071. | Global.Halt, Global.systemHalt: writer.String ("ASSERT (false)");
  1072. | Global.Ord: PrintExpression (argument[0]);
  1073. | Global.Chr: PrintExpression (argument[0]);
  1074. | Global.Short, Global.Long: writer.Char ('('); PrintType (FALSE, expression.type, ""); writer.Char (')'); writer.Char (Space); PrintExpression (argument[0]);
  1075. | Global.Entier, Global.EntierH: writer.String ("floor ("); PrintExpression (argument[0]); writer.Char (')');
  1076. | Global.Cap: writer.String ("Capitalize ("); PrintExpression (argument[0]); writer.Char (')');
  1077. | Global.Odd: writer.Char ('('); PrintExpression (argument[0]); writer.String (" & 1)");
  1078. | Global.Ash: writer.Char ('('); PrintExpression (argument[0]); IF IsNegative (argument[1]) THEN writer.String (" >> - ") ELSE writer.String (" << ") END; PrintExpression (argument[1]); writer.Char (')');
  1079. | Global.Abs: IF (expression.type.resolved IS SyntaxTree.FloatType) THEN writer.Char ('f') END;
  1080. writer.String ("abs ("); PrintExpression (argument[0]); writer.Char (')');
  1081. | Global.Min, Global.Max: PrintExpression (expression.resolved);
  1082. | Global.New: PrintNew (expression.parameters);
  1083. | Global.Dispose: writer.String ("Dispose (&"); PrintExpression (argument[0]); writer.Char (')');
  1084. | Global.Len:
  1085. IF argument[0] IS SyntaxTree.DereferenceDesignator THEN PrintExpression (argument[0](SyntaxTree.DereferenceDesignator).left); writer.String ("->length[0]");
  1086. ELSE PrintExpression (argument[0]); writer.String (LenTag); writer.Char ('0') END;
  1087. | Global.Copy: writer.String ("strcpy ("); PrintExpression (argument[1]); writer.String (", "); PrintExpression (argument[0]); writer.Char (')');
  1088. | Global.systemAdr: writer.String ("(("); PrintType (FALSE, backend.system.addressType, ""); writer.String (") &"); PrintExpression (argument[0]); writer.Char (')');
  1089. | Global.systemGet: PrintExpression (argument[1]); writer.String (" = *(("); PrintType (TRUE, argument[1].type, ""); writer.String (") "); PrintExpression (argument[0]); writer.Char (')');
  1090. | Global.systemGet8, Global.systemGet16, Global.systemGet32, Global.systemGet64:
  1091. writer.String ("*(("); PrintType (TRUE, expression.type, ""); writer.String (") "); PrintExpression (argument[0]); writer.Char (')');
  1092. | Global.systemPut, Global.systemPut8, Global.systemPut16, Global.systemPut32, Global.systemPut64:
  1093. writer.String ("*(("); PrintType (TRUE, argument[1].type, ""); writer.String (") "); PrintExpression (argument[0]); writer.String (") = "); PrintExpression (argument[1]);
  1094. | Global.systemMove: writer.String ("memcpy ("); PrintExpression (argument[1]); writer.String (", "); PrintExpression (argument[0]); writer.String (", "); PrintExpression (argument[2]); writer.Char (')');
  1095. | Global.systemVal:
  1096. IF (argument[1] IS SyntaxTree.SymbolDesignator) & (argument[1].resolved = NIL) THEN
  1097. writer.String ("*(("); PrintType (TRUE, GetDeclaredType (argument[0]), ""); writer.String (") &"); PrintExpression (argument[1]); writer.Char (')');
  1098. ELSE
  1099. writer.String ("("); PrintType (FALSE, GetDeclaredType (argument[0]), ""); writer.String (") "); PrintExpression (argument[1]);
  1100. END;
  1101. | Global.Lsh: writer.Char ('('); PrintExpression (argument[0]); IF IsNegative (argument[1]) THEN writer.String (" >> - ") ELSE writer.String (" << ") END; PrintExpression (argument[1]); writer.Char (')');
  1102. | Global.Rot: writer.String ("(("); PrintExpression (argument[0]); writer.String (" << "); PrintExpression (argument[1]); writer.String (") | (");
  1103. PrintExpression (argument[0]); writer.String (" >> (sizeof ("); PrintType (FALSE, expression.type, ""); writer.String (") * 8 - "); PrintExpression (argument[1]); writer.String (")))");
  1104. | Global.systemSize: writer.String ("sizeof ("); PrintType (FALSE, GetDeclaredType (argument[0]), ""); writer.Char (')');
  1105. | Global.systemTypeCode: typeDeclaration := argument[0](SyntaxTree.SymbolDesignator).symbol(SyntaxTree.TypeDeclaration);
  1106. IF typeDeclaration.declaredType.resolved IS SyntaxTree.PointerType THEN
  1107. typeDeclaration := typeDeclaration.declaredType.resolved(SyntaxTree.PointerType).pointerBase.resolved.typeDeclaration;
  1108. END;
  1109. GetSymbolName (typeDeclaration, name, backend.style); writer.Char ('&'); writer.String (name); writer.String (TypeDescriptorTag);
  1110. | Global.GetProcedure: PrintExpression (argument[2]); writer.String (" = 0");
  1111. |Global.systemTrace: FOR i := 0 TO expression.parameters.Length () - 1 DO Trace (expression.parameters.GetExpression (i)) END;
  1112. END;
  1113. END VisitBuiltinCallDesignator;
  1114. PROCEDURE VisitProcedureCallDesignator* (expression: SyntaxTree.ProcedureCallDesignator);
  1115. VAR procedureType: SyntaxTree.ProcedureType; first: BOOLEAN;
  1116. VAR symbolDesignator: SyntaxTree.SymbolDesignator; scope: SyntaxTree.Scope;
  1117. BEGIN
  1118. IF expression.left IS SyntaxTree.SymbolDesignator THEN
  1119. symbolDesignator := expression.left(SyntaxTree.SymbolDesignator);
  1120. IF symbolDesignator.symbol IS SyntaxTree.Procedure THEN
  1121. scope := symbolDesignator.symbol.scope;
  1122. END;
  1123. ELSE
  1124. symbolDesignator := NIL; scope := NIL;
  1125. END;
  1126. procedureType := expression.left.type.resolved(SyntaxTree.ProcedureType);
  1127. PrintExpression (expression.left); writer.Char (Space); writer.Char ('(');
  1128. first := PrintArguments (expression.parameters, 0, expression.parameters.Length (), procedureType.firstParameter, scope);
  1129. IF (symbolDesignator # NIL) & IsMethod (symbolDesignator) THEN
  1130. IF first THEN first := FALSE ELSE writer.String (", ") END;
  1131. IF symbolDesignator.left # NIL THEN
  1132. PrintExpression (symbolDesignator.left(SyntaxTree.DereferenceDesignator).left);
  1133. ELSE
  1134. PrintSelf;
  1135. END;
  1136. ELSIF expression.left IS SyntaxTree.SupercallDesignator THEN
  1137. IF expression.parameters.Length () > 0 THEN writer.String (", ") END; PrintSelf;
  1138. ELSIF IsDelegate (procedureType) THEN
  1139. IF expression.parameters.Length () > 0 THEN writer.String (", ") END;
  1140. PrintExpression (expression.left); writer.String (DelegateTag);
  1141. END;
  1142. writer.Char (')');
  1143. END VisitProcedureCallDesignator;
  1144. PROCEDURE VisitBooleanValue* (expression: SyntaxTree.BooleanValue);
  1145. BEGIN IF expression.value THEN writer.Char ('1'); ELSE writer.Char ('0'); END;
  1146. END VisitBooleanValue;
  1147. PROCEDURE VisitIntegerValue* (expression: SyntaxTree.IntegerValue);
  1148. BEGIN writer.Int (expression.value, 0);
  1149. END VisitIntegerValue;
  1150. PROCEDURE VisitCharacterValue* (expression: SyntaxTree.CharacterValue);
  1151. BEGIN PrintCharacter (expression.value);
  1152. END VisitCharacterValue;
  1153. PROCEDURE VisitSetValue* (expression: SyntaxTree.SetValue);
  1154. VAR i: INTEGER; mask, value: HUGEINT;
  1155. BEGIN
  1156. mask := 1; value := 0;
  1157. FOR i := MIN (SET) TO MAX (SET) DO IF i IN expression.value THEN INC (value, mask); END; INC (mask, mask); END;
  1158. writer.String ("0x"); writer.Hex (value, 0);
  1159. END VisitSetValue;
  1160. PROCEDURE VisitRealValue* (expression: SyntaxTree.RealValue);
  1161. BEGIN writer.FloatFix (expression.value, 0, 5, 0);
  1162. END VisitRealValue;
  1163. PROCEDURE VisitStringValue* (expression: SyntaxTree.StringValue);
  1164. VAR char: CHAR; i: LONGINT;
  1165. BEGIN
  1166. writer.Char ('"'); i := 0;
  1167. LOOP
  1168. char := expression.value[i];
  1169. IF char = 0X THEN EXIT END;
  1170. IF char = '"' THEN writer.Char ('\') END;
  1171. writer.Char (char); INC (i);
  1172. END;
  1173. writer.Char ('"');
  1174. END VisitStringValue;
  1175. PROCEDURE VisitNilValue* (expression: SyntaxTree.NilValue);
  1176. BEGIN writer.Char ('0');
  1177. END VisitNilValue;
  1178. PROCEDURE VisitEnumerationValue* (expression: SyntaxTree.EnumerationValue);
  1179. BEGIN writer.Int (expression.value, 0);
  1180. END VisitEnumerationValue;
  1181. PROCEDURE VisitUnaryExpression* (expression: SyntaxTree.UnaryExpression);
  1182. BEGIN
  1183. CASE expression.operator OF
  1184. | Scanner.Plus:
  1185. | Scanner.Minus: IF expression.type.resolved IS SyntaxTree.SetType THEN writer.Char ('~') ELSE writer.Char ('-') END;
  1186. | Scanner.Not: writer.Char ('!');
  1187. END;
  1188. PrintExpression (expression.left);
  1189. END VisitUnaryExpression;
  1190. PROCEDURE VisitTypeGuardDesignator* (expression: SyntaxTree.TypeGuardDesignator);
  1191. VAR isRecord: BOOLEAN;
  1192. BEGIN
  1193. isRecord := expression.type.resolved IS SyntaxTree.RecordType;
  1194. IF isRecord THEN writer.String ("(*") END;
  1195. writer.String ("(ASSERT ("); CompareTypeDescriptor (expression.left, expression.type); writer.String ("), (");
  1196. PrintType (isRecord, expression.type, ""); writer.String (") ");
  1197. IF isRecord THEN writer.Char ('&') END;
  1198. PrintExpression (expression.left); writer.Char (')');
  1199. IF isRecord THEN writer.Char (')') END;
  1200. END VisitTypeGuardDesignator;
  1201. PROCEDURE VisitSupercallDesignator*(expression: SyntaxTree.SupercallDesignator);
  1202. VAR name: Identifier; procedure: SyntaxTree.Procedure;
  1203. BEGIN
  1204. procedure := expression.left(SyntaxTree.SymbolDesignator).symbol(SyntaxTree.Procedure);
  1205. GetSymbolName (procedure.super, name, backend.style); writer.String (name);
  1206. END VisitSupercallDesignator;
  1207. PROCEDURE VisitBinaryExpression* (expression: SyntaxTree.BinaryExpression);
  1208. BEGIN
  1209. IF expression.operator = Scanner.In THEN
  1210. writer.String ("(("); PrintExpression (expression.right); writer.String (" >> ");
  1211. PrintExpression (expression.left); writer.String (") & 1)"); RETURN;
  1212. ELSIF expression.operator = Scanner.Is THEN
  1213. CompareTypeDescriptor (expression.left, GetDeclaredType (expression.right));
  1214. RETURN;
  1215. END;
  1216. writer.Char ('(');
  1217. IF IsString (expression.left.type) THEN
  1218. writer.String ("strcmp ("); PrintExpression (expression.left); writer.Char (Comma); writer.Char (Space); PrintExpression (expression.right); writer.Char (')');
  1219. ELSE
  1220. PrintExpression (expression.left);
  1221. END;
  1222. writer.Char (Space);
  1223. CASE expression.operator OF
  1224. | Scanner.Equal: writer.String ("==");
  1225. | Scanner.Unequal: writer.String ("!=");
  1226. | Scanner.Less: writer.String ("<");
  1227. | Scanner.LessEqual: writer.String ("<=");
  1228. | Scanner.Greater: writer.String (">");
  1229. | Scanner.GreaterEqual: writer.String (">=");
  1230. | Scanner.And: writer.String ("&&");
  1231. | Scanner.Or: writer.String ("||");
  1232. | Scanner.Plus: IF expression.type.resolved IS SyntaxTree.SetType THEN writer.Char ('|') ELSE writer.Char ('+') END;
  1233. | Scanner.Minus: IF expression.type.resolved IS SyntaxTree.SetType THEN writer.Char ('&'); writer.Char ('~') ELSE writer.Char ('-') END;
  1234. | Scanner.Times: IF expression.type.resolved IS SyntaxTree.SetType THEN writer.Char ('&') ELSE writer.Char ('*') END;
  1235. | Scanner.Slash, Scanner.Div: IF expression.type.resolved IS SyntaxTree.SetType THEN writer.Char ('^') ELSE writer.Char ('/') END;
  1236. | Scanner.Mod: writer.Char ('%');
  1237. END;
  1238. writer.Char (Space);
  1239. IF IsString (expression.left.type) THEN writer.Char ('0'); ELSE PrintExpression (expression.right); END; writer.Char (')');
  1240. END VisitBinaryExpression;
  1241. PROCEDURE VisitSelfDesignator* (expression: SyntaxTree.SelfDesignator);
  1242. BEGIN PrintSelf;
  1243. END VisitSelfDesignator;
  1244. PROCEDURE VisitIndexDesignator* (expression: SyntaxTree.IndexDesignator);
  1245. VAR i: LONGINT;
  1246. BEGIN
  1247. PrintExpression (expression.left);
  1248. FOR i := 0 TO expression.parameters.Length () - 1 DO
  1249. writer.Char ('[');
  1250. PrintExpression (expression.parameters.GetExpression (i));
  1251. writer.Char (']');
  1252. END;
  1253. END VisitIndexDesignator;
  1254. PROCEDURE VisitConversion* (expression: SyntaxTree.Conversion);
  1255. VAR e: SyntaxTree.Expression;
  1256. BEGIN
  1257. IF (expression.type IS SyntaxTree.CharacterType) & (expression.expression.type IS SyntaxTree.StringType) THEN
  1258. PrintCharacter (expression.expression.resolved(SyntaxTree.StringValue).value[0]);
  1259. ELSE
  1260. PrintExpression (expression.expression);
  1261. END;
  1262. END VisitConversion;
  1263. PROCEDURE VisitDereferenceDesignator* (expression: SyntaxTree.DereferenceDesignator);
  1264. BEGIN
  1265. IF expression.type IS SyntaxTree.ArrayType THEN
  1266. writer.String ("(*("); PrintType (TRUE, expression.type, ""); writer.String (") &");
  1267. PrintExpression (expression.left); writer.String ("->array)");
  1268. ELSE
  1269. PrintExpression (expression.left); writer.String ("->record");
  1270. END;
  1271. END VisitDereferenceDesignator;
  1272. PROCEDURE VisitSet* (expression: SyntaxTree.Set);
  1273. VAR i: LONGINT; element: SyntaxTree.Expression;
  1274. BEGIN
  1275. IF expression.elements.Length () = 0 THEN
  1276. writer.Char ('0');
  1277. ELSE
  1278. writer.Char ('(');
  1279. FOR i := 0 TO expression.elements.Length () - 1 DO
  1280. IF i # 0 THEN writer.String (" | "); END;
  1281. element := expression.elements.GetExpression (i);
  1282. IF element IS SyntaxTree.RangeExpression THEN
  1283. writer.String ("(("); PrintType (FALSE, backend.system.setType, ""); writer.String (") - 1 << "); PrintExpression (element(SyntaxTree.RangeExpression).first);
  1284. writer.String (" & ~(("); PrintType (FALSE, backend.system.setType, ""); writer.String (") - 2 << "); PrintExpression (element(SyntaxTree.RangeExpression).last); writer.String ("))");
  1285. ELSE
  1286. writer.String ("1 << "); PrintExpression (element);
  1287. END;
  1288. END;
  1289. writer.Char (')');
  1290. END;
  1291. END VisitSet;
  1292. END Transpiler;
  1293. TYPE TranspilerBackend*= OBJECT (Backend.Backend)
  1294. VAR
  1295. defineMain, declarations, initLocalData: BOOLEAN;
  1296. addressSize: LONGINT; style: Style;
  1297. traceModule: Identifier;
  1298. PROCEDURE &InitTranspilerBackend;
  1299. BEGIN InitBackend;
  1300. END InitTranspilerBackend;
  1301. PROCEDURE ProcessSyntaxTreeModule* (module: SyntaxTree.Module): Formats.GeneratedModule;
  1302. VAR filename, pathname, fullname: Files.FileName; file: Files.File; writer: Files.Writer; transpiler: Transpiler;
  1303. BEGIN
  1304. Files.SplitPath (module.sourceName, pathname, filename); GetHeaderName (module, filename, style);
  1305. IF pathname = "" THEN fullname := filename ELSE Files.JoinPath (pathname, filename, fullname) END;
  1306. file := Files.New (fullname); Files.OpenWriter (writer, file, 0);
  1307. Replace (filename, '.', '_'); Strings.UpperCase (filename); Strings.Append (filename, "_INCLUDED");
  1308. writer.String ("#ifndef "); writer.String (filename); writer.Ln; writer.String ("#define "); writer.String (filename); writer.Ln; writer.Ln;
  1309. writer.String ("/* C header file generated from '"); writer.String (module.sourceName); writer.String ("' */"); writer.Ln;
  1310. NEW (transpiler, writer, SELF, initLocalData); transpiler.DeclareModule (module);
  1311. writer.Ln; writer.String ("#endif /* "); writer.String (filename); writer.String (" */"); writer.Ln; writer.Update; Files.Register (file);
  1312. IF declarations THEN RETURN NIL END; GetSourceName (module, filename, style);
  1313. IF pathname = "" THEN fullname := filename ELSE Files.JoinPath (pathname, filename, fullname) END;
  1314. file := Files.New (fullname); Files.OpenWriter (writer, file, 0);
  1315. writer.String ("/* C source file generated from '"); writer.String (module.sourceName); writer.String ("' */"); writer.Ln;
  1316. NEW (transpiler, writer, SELF, initLocalData); transpiler.DefineModule (module);
  1317. IF defineMain THEN transpiler.DefineMain (module); END; writer.Update; Files.Register (file);
  1318. RETURN NIL;
  1319. END ProcessSyntaxTreeModule;
  1320. PROCEDURE DefineOptions* (options: Options.Options);
  1321. BEGIN DefineOptions^(options);
  1322. options.Add(0X,"defineMain", Options.Flag);
  1323. options.Add(0X,"declarations", Options.Flag);
  1324. options.Add(0X,"addressSize", Options.Integer);
  1325. options.Add(0X,"style", Options.String);
  1326. options.Add(0X,"traceModule", Options.String);
  1327. options.Add(0X,"noLocalInit", Options.Flag);
  1328. END DefineOptions;
  1329. PROCEDURE GetOptions* (options: Options.Options);
  1330. VAR styleName: ARRAY 32 OF CHAR;
  1331. BEGIN GetOptions^(options);
  1332. defineMain := options.GetFlag ("defineMain");
  1333. declarations := options.GetFlag ("declarations");
  1334. IF ~options.GetInteger ("addressSize", addressSize) THEN addressSize := 32 END;
  1335. IF ~options.GetString ("style", styleName) OR (styleName # "staila") THEN style := DefaultStyle ELSE style := StailaStyle END;
  1336. IF ~options.GetString ("traceModule", traceModule) THEN traceModule := "KernelLog" END;
  1337. initLocalData := ~options.GetFlag("noLocalInit");
  1338. END GetOptions;
  1339. PROCEDURE DefaultSymbolFileFormat* (): Formats.SymbolFileFormat;
  1340. BEGIN RETURN SymbolFileFormat.Get ();
  1341. END DefaultSymbolFileFormat;
  1342. PROCEDURE GetSystem*(): Global.System;
  1343. VAR system: Global.System;
  1344. BEGIN
  1345. NEW(system, 8, 8, addressSize, 8, 32, 32, 32, 64, FALSE);
  1346. Global.SetDefaultDeclarations(system,8);
  1347. Global.SetDefaultOperators(system);
  1348. RETURN system;
  1349. END GetSystem;
  1350. END TranspilerBackend;
  1351. PROCEDURE AppendName (identifier: SyntaxTree.Identifier; VAR name: ARRAY OF CHAR; style: Style);
  1352. VAR temp: Identifier;
  1353. BEGIN Strings.Append (name, "_"); Basic.GetString(identifier,temp); Strings.Append (name, temp);
  1354. END AppendName;
  1355. PROCEDURE IsEmptyRecord (record: SyntaxTree.RecordType): BOOLEAN;
  1356. BEGIN
  1357. IF record.isObject OR (record.baseType # NIL) & ~IsEmptyRecord (record.GetBaseRecord ()) THEN RETURN FALSE END;
  1358. RETURN record.recordScope.firstVariable = NIL;
  1359. END IsEmptyRecord;
  1360. PROCEDURE GetSymbolName (symbol: SyntaxTree.Symbol; VAR name: ARRAY OF CHAR; style: Style);
  1361. BEGIN
  1362. IF symbol IS SyntaxTree.Module THEN
  1363. IF (symbol(SyntaxTree.Module).context # SyntaxTree.invalidIdentifier) & (symbol(SyntaxTree.Module).context # Global.A2Name) THEN
  1364. Basic.GetString(symbol(SyntaxTree.Module).context,name); Strings.Append (name, "_"); AppendName (symbol.name, name, style);
  1365. ELSE
  1366. symbol.GetName(name);
  1367. END;
  1368. ELSIF symbol IS SyntaxTree.Parameter THEN
  1369. symbol.GetName(name);
  1370. ELSIF (symbol IS SyntaxTree.Variable) & ~(symbol.scope IS SyntaxTree.ModuleScope) THEN
  1371. symbol.GetName(name);
  1372. ELSE
  1373. GetScopeName (symbol.scope, name, style); AppendName (symbol.name, name, style);
  1374. END;
  1375. FixIdentifier (name, style);
  1376. END GetSymbolName;
  1377. PROCEDURE GetScopeName (scope: SyntaxTree.Scope; VAR name: ARRAY OF CHAR; style: Style);
  1378. BEGIN
  1379. IF scope IS SyntaxTree.ProcedureScope THEN
  1380. GetScopeName (scope.outerScope, name, style); AppendName (scope(SyntaxTree.ProcedureScope).ownerProcedure.name, name, style);
  1381. ELSIF scope IS SyntaxTree.RecordScope THEN
  1382. GetSymbolName (scope(SyntaxTree.RecordScope).ownerRecord.typeDeclaration, name, style);
  1383. ELSIF scope IS SyntaxTree.ModuleScope THEN
  1384. GetSymbolName (scope(SyntaxTree.ModuleScope).ownerModule, name, style);
  1385. END;
  1386. END GetScopeName;
  1387. PROCEDURE GetSourceName (module: SyntaxTree.Module; VAR filename: Files.FileName; style: Style);
  1388. BEGIN GetSymbolName (module, filename, style); Strings.Append (filename, ".c");
  1389. END GetSourceName;
  1390. PROCEDURE GetHeaderName (module: SyntaxTree.Module; VAR filename: Files.FileName; style: Style);
  1391. BEGIN GetSymbolName (module, filename, style); Strings.Append (filename, ".h");
  1392. END GetHeaderName;
  1393. PROCEDURE GetConstructor (recordType: SyntaxTree.RecordType): SyntaxTree.Procedure;
  1394. VAR constructor: SyntaxTree.Procedure; base: SyntaxTree.Type;
  1395. BEGIN
  1396. LOOP
  1397. constructor := recordType.recordScope.constructor;
  1398. IF constructor # NIL THEN RETURN constructor END;
  1399. base := recordType.baseType;
  1400. IF base = NIL THEN RETURN NIL END;
  1401. IF base.resolved IS SyntaxTree.PointerType THEN
  1402. base := base.resolved(SyntaxTree.PointerType).pointerBase;
  1403. END;
  1404. IF ~(base.resolved IS SyntaxTree.RecordType) THEN RETURN NIL END;
  1405. recordType := base.resolved(SyntaxTree.RecordType);
  1406. END;
  1407. END GetConstructor;
  1408. PROCEDURE GetStatementProcedure (statement: SyntaxTree.Statement): SyntaxTree.ProcedureScope;
  1409. BEGIN WHILE statement.outer # NIL DO statement := statement.outer END; RETURN statement(SyntaxTree.Body).inScope;
  1410. END GetStatementProcedure;
  1411. PROCEDURE GetDeclaredType (expression: SyntaxTree.Expression): SyntaxTree.Type;
  1412. BEGIN RETURN expression(SyntaxTree.SymbolDesignator).symbol(SyntaxTree.TypeDeclaration).declaredType;
  1413. END GetDeclaredType;
  1414. PROCEDURE IsMethod (expression: SyntaxTree.SymbolDesignator): BOOLEAN;
  1415. VAR scope: SyntaxTree.Scope;
  1416. BEGIN
  1417. IF ~(expression.symbol IS SyntaxTree.Procedure) THEN RETURN FALSE END;
  1418. scope := expression.symbol.scope;
  1419. WHILE scope IS SyntaxTree.ProcedureScope DO scope := scope.outerScope END;
  1420. RETURN scope IS SyntaxTree.RecordScope;
  1421. END IsMethod;
  1422. PROCEDURE IsVarParameter (symbol: SyntaxTree.Symbol): BOOLEAN;
  1423. 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));
  1424. END IsVarParameter;
  1425. PROCEDURE IsInExclusiveBlock (statement: SyntaxTree.Statement): BOOLEAN;
  1426. BEGIN
  1427. WHILE statement # NIL DO
  1428. IF (statement IS SyntaxTree.StatementBlock) & statement(SyntaxTree.StatementBlock).isExclusive THEN RETURN TRUE END;
  1429. statement := statement.outer;
  1430. END;
  1431. RETURN FALSE;
  1432. END IsInExclusiveBlock;
  1433. PROCEDURE IsOpenArray (type: SyntaxTree.Type): BOOLEAN;
  1434. BEGIN RETURN (type IS SyntaxTree.ArrayType) & (type(SyntaxTree.ArrayType).staticLength = 0);
  1435. END IsOpenArray;
  1436. PROCEDURE IsStaticArray (type: SyntaxTree.Type): BOOLEAN;
  1437. BEGIN RETURN (type IS SyntaxTree.ArrayType) & (type(SyntaxTree.ArrayType).staticLength # 0);
  1438. END IsStaticArray;
  1439. PROCEDURE IsDelegate (type: SyntaxTree.Type): BOOLEAN;
  1440. BEGIN RETURN (type IS SyntaxTree.ProcedureType) & type(SyntaxTree.ProcedureType).isDelegate;
  1441. END IsDelegate;
  1442. PROCEDURE IsStructuredType (type: SyntaxTree.Type): BOOLEAN;
  1443. BEGIN RETURN (type.resolved IS SyntaxTree.ArrayType) OR (type.resolved IS SyntaxTree.RecordType);
  1444. END IsStructuredType;
  1445. PROCEDURE IsString (type: SyntaxTree.Type): BOOLEAN;
  1446. BEGIN RETURN (type.resolved IS SyntaxTree.StringType) OR (type.resolved IS SyntaxTree.ArrayType) & (type.resolved(SyntaxTree.ArrayType).arrayBase.resolved IS SyntaxTree.CharacterType);
  1447. END IsString;
  1448. PROCEDURE IsEmptyString (type: SyntaxTree.Type): BOOLEAN;
  1449. BEGIN RETURN (type.resolved IS SyntaxTree.StringType) & (type.resolved(SyntaxTree.StringType).length = 1);
  1450. END IsEmptyString;
  1451. PROCEDURE IsNegative (expression: SyntaxTree.Expression): BOOLEAN;
  1452. BEGIN RETURN (expression.resolved # NIL) & (expression.resolved IS SyntaxTree.IntegerValue) & (expression.resolved(SyntaxTree.IntegerValue).value < 0);
  1453. END IsNegative;
  1454. PROCEDURE IsInlineAssemblyCode (procedure: SyntaxTree.Procedure): BOOLEAN;
  1455. VAR type: SyntaxTree.ProcedureType; body: SyntaxTree.Body;
  1456. BEGIN
  1457. type := procedure.type(SyntaxTree.ProcedureType); body := procedure.procedureScope.body;
  1458. RETURN (procedure.isInline) & (type.firstParameter = NIL) & (type.returnType = NIL) & (body # NIL) & (body.code # NIL);
  1459. END IsInlineAssemblyCode;
  1460. PROCEDURE GetRecordMethod (record: SyntaxTree.RecordType; method: LONGINT): SyntaxTree.Procedure;
  1461. VAR base: SyntaxTree.RecordType; scope: SyntaxTree.RecordScope; procedure: SyntaxTree.Procedure;
  1462. BEGIN
  1463. scope := record.recordScope;
  1464. LOOP
  1465. procedure := scope.firstProcedure;
  1466. WHILE (procedure # NIL) & (procedure.methodNumber #method) DO procedure := procedure.nextProcedure END;
  1467. IF procedure # NIL THEN RETURN procedure END;
  1468. base := scope.ownerRecord.GetBaseRecord ();
  1469. scope := base.recordScope;
  1470. END;
  1471. END GetRecordMethod;
  1472. PROCEDURE GetRecord (type: SyntaxTree.Type): SyntaxTree.RecordType;
  1473. BEGIN
  1474. IF type IS SyntaxTree.RecordType THEN RETURN type(SyntaxTree.RecordType)
  1475. ELSIF type IS SyntaxTree.PointerType THEN
  1476. type := type(SyntaxTree.PointerType).pointerBase.resolved;
  1477. IF (type IS SyntaxTree.RecordType) & (type(SyntaxTree.RecordType).pointerType # NIL) THEN RETURN type(SyntaxTree.RecordType) END;
  1478. END;
  1479. RETURN NIL;
  1480. END GetRecord;
  1481. PROCEDURE Replace (VAR string: ARRAY OF CHAR; replace, by: CHAR);
  1482. VAR i: LONGINT; char: CHAR;
  1483. BEGIN
  1484. i := 0; char := string[0];
  1485. WHILE char # 0X DO IF char = replace THEN string[i] := by; END; INC (i); char := string[i]; END;
  1486. END Replace;
  1487. PROCEDURE FixStailaIdentifier (VAR identifier: ARRAY OF CHAR);
  1488. VAR i: LONGINT; previousLower: BOOLEAN;
  1489. BEGIN
  1490. i := 0; previousLower := FALSE;
  1491. WHILE identifier[i] # 0X DO
  1492. IF (ORD (identifier[i]) >= ORD ('A')) & (ORD (identifier[i]) <= ORD ('Z')) THEN
  1493. IF previousLower THEN Strings.Insert ("_", identifier, i); INC (i) END;
  1494. identifier[i] := Strings.LOW (identifier[i]); previousLower := FALSE;
  1495. ELSE
  1496. previousLower := (ORD (identifier[i]) >= ORD ('a')) & (ORD (identifier[i]) <= ORD ('z'));
  1497. END;
  1498. INC (i);
  1499. END;
  1500. END FixStailaIdentifier;
  1501. PROCEDURE FixIdentifier (VAR identifier: ARRAY OF CHAR; style: Style);
  1502. CONST Tag = '_';
  1503. BEGIN
  1504. Replace (identifier, '$', Tag); Replace (identifier, '@', Tag);
  1505. (* IF style = StailaStyle THEN FixStailaIdentifier (identifier) END; *)
  1506. IF (identifier = "int") OR (identifier = "return") OR (identifier = "enum") OR
  1507. (identifier = "char") OR (identifier = "register") OR (identifier = "continue") THEN
  1508. Strings.Append (identifier, Tag);
  1509. END;
  1510. END FixIdentifier;
  1511. PROCEDURE Get* (): Backend.Backend;
  1512. VAR backend: TranspilerBackend;
  1513. BEGIN NEW(backend); RETURN backend;
  1514. END Get;
  1515. END FoxTranspilerBackend.
  1516. System.Free FoxTranspilerBackend ~
  1517. Compiler.Compile -b=Transpiler Test.Mod ~
  1518. TextCompiler.CompileSelection -b=Transpiler ~
  1519. TextCompiler.CompileSelection -b=Transpiler --defineMain ~
  1520. MODULE Test;
  1521. VAR a: INTEGER;
  1522. END Test.
  1523. FoxTest.Compile --options="-PC -G=Transpiler" --command="WinApplications.Run --hide cl /c Test.c" Oberon.Temp.Test Oberon.Temp.TranspilerTestDiff ~
  1524. 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 ~