FoxPrintout.Mod 54 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976
  1. MODULE FoxPrintout; (** AUTHOR "fof & fn"; PURPOSE "Oberon Compiler Module Output for SymbolFile, Pretty Printing and Testing"; *)
  2. (* (c) fof ETHZ 2009 *)
  3. IMPORT
  4. Scanner := FoxScanner, SyntaxTree := FoxSyntaxTree, Global := FoxGlobal, Basic := FoxBasic, Streams, D:=Debugging, SYSTEM;
  5. CONST
  6. (* print modes *)
  7. Exported*=0; SymbolFile*=1; SourceCode*=2; All*=3;
  8. TYPE
  9. Printer*= OBJECT (SyntaxTree.Visitor)
  10. VAR
  11. w-: Basic.Writer; mode: LONGINT; singleStatement: BOOLEAN;
  12. currentScope: SyntaxTree.Scope; ws: Streams.StringWriter;
  13. info: BOOLEAN; case: LONGINT;
  14. useCase: BOOLEAN; (* TRUE to enable case conversion in "Identifier" *)
  15. alertCount, commentCount: LONGINT;
  16. PROCEDURE Small(CONST name: ARRAY OF CHAR; VAR result: ARRAY OF CHAR);
  17. VAR ch: CHAR; i: LONGINT;
  18. BEGIN
  19. i := 0;
  20. REPEAT
  21. ch := name[i];
  22. IF (ch >= 'A') & (ch <= 'Z') THEN
  23. ch := CHR(ORD(ch)-ORD('A')+ORD('a'));
  24. END;
  25. result[i] := ch; INC(i);
  26. UNTIL ch = 0X;
  27. END Small;
  28. PROCEDURE Big(CONST name: ARRAY OF CHAR; VAR result: ARRAY OF CHAR);
  29. VAR ch: CHAR; i: LONGINT;
  30. BEGIN
  31. i := 0;
  32. REPEAT
  33. ch := name[i];
  34. IF (ch >= 'a') & (ch <= 'z') THEN
  35. ch := CHR(ORD(ch)-ORD('a')+ORD('A'));
  36. END;
  37. result[i] := ch; INC(i);
  38. UNTIL ch = 0X;
  39. END Big;
  40. PROCEDURE Keyword(CONST a: ARRAY OF CHAR);
  41. VAR str: ARRAY 64 OF CHAR;
  42. BEGIN
  43. IF case= Scanner.Lowercase THEN Small(a,str) ELSE COPY(a,str) END;
  44. w.BeginKeyword;
  45. w.String(str);
  46. w.EndKeyword;
  47. END Keyword;
  48. PROCEDURE AlertString(CONST s: ARRAY OF CHAR);
  49. BEGIN
  50. w.BeginAlert; w.String(s); w.EndAlert;
  51. END AlertString;
  52. PROCEDURE Indent;
  53. BEGIN w.Ln;
  54. END Indent;
  55. PROCEDURE Identifier*(x: SyntaxTree.Identifier);
  56. VAR str: Scanner.IdentifierString;
  57. BEGIN
  58. Basic.GetString(x,str);
  59. IF useCase THEN
  60. IF case = Scanner.Lowercase THEN Small(str,str); ELSE Big(str,str); END;
  61. END;
  62. w.String(str);
  63. END Identifier;
  64. PROCEDURE QualifiedIdentifier*(x: SyntaxTree.QualifiedIdentifier);
  65. BEGIN
  66. IF x.prefix # SyntaxTree.invalidIdentifier THEN Identifier(x.prefix); w.String("."); END;
  67. Identifier(x.suffix);
  68. END QualifiedIdentifier;
  69. PROCEDURE Type*(x: SyntaxTree.Type);
  70. BEGIN
  71. IF x= NIL THEN
  72. AlertString("nil type");
  73. ELSE
  74. x.Accept(SELF);
  75. END;
  76. END Type;
  77. PROCEDURE VisitType(x: SyntaxTree.Type);
  78. BEGIN
  79. IF x = SyntaxTree.importType THEN w.String("importType")
  80. ELSIF x = SyntaxTree.typeDeclarationType THEN w.String("typeDeclarationType");
  81. ELSE
  82. AlertString("InvalidType");
  83. END;
  84. END VisitType;
  85. PROCEDURE VisitBasicType(x: SyntaxTree.BasicType);
  86. BEGIN
  87. IF x.typeDeclaration # NIL THEN
  88. Identifier(x.typeDeclaration.name);
  89. ELSE
  90. Identifier(x.name);
  91. END
  92. END VisitBasicType;
  93. PROCEDURE VisitBooleanType(x: SyntaxTree.BooleanType);
  94. BEGIN
  95. VisitBasicType(x);
  96. END VisitBooleanType;
  97. PROCEDURE VisitSetType(x: SyntaxTree.SetType);
  98. BEGIN
  99. VisitBasicType(x);
  100. END VisitSetType;
  101. PROCEDURE VisitSizeType(x: SyntaxTree.SizeType);
  102. BEGIN
  103. VisitBasicType(x);
  104. END VisitSizeType;
  105. PROCEDURE VisitCharacterType(x: SyntaxTree.CharacterType);
  106. BEGIN
  107. VisitBasicType(x);
  108. END VisitCharacterType;
  109. PROCEDURE VisitIntegerType(x: SyntaxTree.IntegerType);
  110. BEGIN
  111. VisitBasicType(x);
  112. END VisitIntegerType;
  113. PROCEDURE VisitFloatType(x: SyntaxTree.FloatType);
  114. BEGIN
  115. VisitBasicType(x);
  116. END VisitFloatType;
  117. PROCEDURE VisitComplexType(x: SyntaxTree.ComplexType);
  118. BEGIN
  119. VisitBasicType(x);
  120. END VisitComplexType;
  121. PROCEDURE VisitByteType(x: SyntaxTree.ByteType);
  122. BEGIN
  123. VisitBasicType(x);
  124. END VisitByteType;
  125. PROCEDURE VisitQualifiedType(x: SyntaxTree.QualifiedType);
  126. BEGIN
  127. IF x.resolved = SyntaxTree.invalidType THEN
  128. AlertString("(*unresolved*)");
  129. END;
  130. IF x.qualifiedIdentifier # NIL THEN
  131. (* Problem: how to distinguish betwteen type aliases, e.g. Status = LONGINT and actual use of LONGINT?
  132. This tries to use scope level: if the type is declared in the global scope, it should be a basic type use. *)
  133. IF x.resolved # NIL THEN
  134. useCase := (x.resolved IS SyntaxTree.BasicType) & (x.scope.Level() = 0);
  135. END;
  136. QualifiedIdentifier(x.qualifiedIdentifier);
  137. useCase := FALSE;
  138. ELSE
  139. AlertString("NIL (* missing qualified identifier *)");
  140. END;
  141. END VisitQualifiedType;
  142. PROCEDURE VisitStringType(x: SyntaxTree.StringType);
  143. BEGIN
  144. w.String("STRING"); w.String("(* len = "); w.Int(x.length,1); w.String(" *)");
  145. END VisitStringType;
  146. PROCEDURE VisitEnumerationType(x: SyntaxTree.EnumerationType);
  147. VAR e: SyntaxTree.Constant; first: BOOLEAN;
  148. BEGIN
  149. Keyword("ENUM ");
  150. IF x.enumerationBase # NIL THEN
  151. w.String("(");
  152. Type(x.enumerationBase);
  153. w.String(") ");
  154. END;
  155. e := x.enumerationScope.firstConstant; first := TRUE;
  156. WHILE (e # NIL) DO
  157. IF ~first THEN w.String(", ") ELSE first := FALSE END;
  158. VisitConstant(e);
  159. e := e.nextConstant;
  160. END;
  161. Keyword(" END");
  162. END VisitEnumerationType;
  163. PROCEDURE VisitRangeType(x: SyntaxTree.RangeType);
  164. BEGIN VisitBasicType(x);
  165. END VisitRangeType;
  166. PROCEDURE VisitArrayType(x: SyntaxTree.ArrayType);
  167. BEGIN
  168. Keyword("ARRAY " );
  169. IF x.length # NIL THEN Expression(x.length);
  170. w.String( " " ); END;
  171. Keyword("OF " );
  172. Type(x.arrayBase);
  173. END VisitArrayType;
  174. PROCEDURE VisitNilType(x: SyntaxTree.NilType);
  175. BEGIN
  176. w.String("NILTYPE");
  177. END VisitNilType;
  178. PROCEDURE VisitAddressType(x: SyntaxTree.AddressType);
  179. BEGIN
  180. w.String("ADDRESSTYPE");
  181. END VisitAddressType;
  182. PROCEDURE VisitObjectType(x: SyntaxTree.ObjectType);
  183. BEGIN
  184. VisitBasicType(x);
  185. END VisitObjectType;
  186. PROCEDURE VisitAnyType(x: SyntaxTree.AnyType);
  187. BEGIN
  188. VisitBasicType(x);
  189. END VisitAnyType;
  190. PROCEDURE VisitMathArrayType(x: SyntaxTree.MathArrayType);
  191. BEGIN
  192. Keyword("ARRAY " );
  193. IF x.form = SyntaxTree.Tensor THEN w.String("[?] ");
  194. ELSE
  195. w.String("[");
  196. IF x.length = NIL THEN
  197. w.String("*")
  198. ELSE
  199. Expression(x.length);
  200. END;
  201. WHILE(x.arrayBase # NIL) & (x.arrayBase IS SyntaxTree.MathArrayType) DO
  202. x := x.arrayBase(SyntaxTree.MathArrayType);
  203. w.String(", ");
  204. IF x.length = NIL THEN
  205. w.String("*")
  206. ELSE
  207. Expression(x.length);
  208. END;
  209. END;
  210. w.String("] ");
  211. END;
  212. IF x.arrayBase # NIL THEN
  213. Keyword("OF " );
  214. Type(x.arrayBase);
  215. END;
  216. END VisitMathArrayType;
  217. PROCEDURE PointerFlags(x: SyntaxTree.PointerType);
  218. VAR first: BOOLEAN;
  219. BEGIN
  220. first := TRUE;
  221. IF x.isUnsafe THEN Flag(Global.NameUnsafe,first) END;
  222. IF x.isRealtime THEN Flag(Global.NameRealtime,first) END;
  223. IF x.isDisposable THEN Flag(Global.NameDisposable,first) END;
  224. IF x.isPlain THEN Flag(Global.NamePlain,first) END;
  225. FlagEnd(first);
  226. END PointerFlags;
  227. PROCEDURE ObjectFlags ( rec: SyntaxTree.RecordType; x: SyntaxTree.PointerType);
  228. VAR first: BOOLEAN;
  229. BEGIN
  230. first := TRUE;
  231. IF x.isUnsafe THEN Flag(Global.NameUnsafe,first) END;
  232. IF x.isRealtime THEN Flag(Global.NameRealtime,first) END;
  233. IF x.isDisposable THEN Flag(Global.NameDisposable,first) END;
  234. IF x.isPlain THEN Flag(Global.NamePlain,first) END;
  235. IF rec.IsProtected() THEN Flag(Global.NameExclusive, first) END;
  236. FlagEnd(first);
  237. END ObjectFlags;
  238. PROCEDURE VisitPointerType(x: SyntaxTree.PointerType);
  239. VAR pointerBase: SyntaxTree.Type;
  240. BEGIN
  241. IF x.pointerBase = NIL THEN
  242. w.BeginAlert; Keyword("POINTER TO NIL"); w.EndAlert;
  243. ELSE
  244. pointerBase := x.pointerBase;
  245. IF x.isHidden THEN
  246. Type(x.pointerBase);
  247. ELSIF (pointerBase IS SyntaxTree.RecordType) & (pointerBase(SyntaxTree.RecordType).isObject) THEN
  248. VisitRecordType(pointerBase(SyntaxTree.RecordType))
  249. ELSE
  250. Keyword("POINTER "); PointerFlags(x); Keyword("TO " ); Type(x.pointerBase);
  251. END;
  252. END;
  253. END VisitPointerType;
  254. PROCEDURE VisitPortType(x: SyntaxTree.PortType);
  255. BEGIN
  256. Keyword("PORT");
  257. IF x.direction = SyntaxTree.OutPort THEN
  258. Keyword(" OUT")
  259. ELSE
  260. ASSERT(x.direction = SyntaxTree.InPort);
  261. Keyword(" IN");
  262. END;
  263. IF x.sizeExpression # NIL THEN
  264. w.String(" ("); Expression(x.sizeExpression); w.String(")");
  265. END;
  266. END VisitPortType;
  267. PROCEDURE VisitCellType(x: SyntaxTree.CellType);
  268. BEGIN
  269. IF x.isCellNet THEN
  270. Keyword("CELLNET ")
  271. ELSE
  272. Keyword("CELL ");
  273. END;
  274. Modifiers(x.modifiers);
  275. IF x.firstParameter # NIL THEN ParameterList(x.firstParameter) END;
  276. Scope(x.cellScope);
  277. IF (x.cellScope IS SyntaxTree.CellScope) & (x.cellScope(SyntaxTree.CellScope).bodyProcedure # NIL) THEN
  278. Body(x.cellScope(SyntaxTree.CellScope).bodyProcedure.procedureScope.body, mode >= SourceCode)
  279. END;
  280. Indent; Keyword("END ");
  281. IF (x.typeDeclaration # NIL) THEN
  282. Identifier(x.typeDeclaration.name);
  283. END;
  284. END VisitCellType;
  285. PROCEDURE VisitRecordType(x: SyntaxTree.RecordType);
  286. VAR prevScope: SyntaxTree.Scope;
  287. BEGIN
  288. IF x.isObject THEN
  289. Keyword("OBJECT ");
  290. IF x.pointerType # NIL THEN ObjectFlags(x, x.pointerType) END;
  291. IF info THEN
  292. BeginComment; w.String("ObjectType");
  293. IF x.HasArrayStructure() THEN
  294. w.String(" (array structure: ");
  295. VisitMathArrayType(x.arrayStructure);
  296. w.String(")");
  297. END;
  298. EndComment;
  299. END;
  300. IF (x.baseType # NIL) THEN
  301. w.String( "(" );
  302. IF (x.baseType IS SyntaxTree.RecordType) & (x.baseType(SyntaxTree.RecordType).pointerType # NIL) THEN
  303. Type(x.baseType(SyntaxTree.RecordType).pointerType)
  304. ELSE
  305. Type(x.baseType);
  306. END;
  307. w.String( ")" );
  308. END;
  309. Scope(x.recordScope);
  310. IF (x.recordScope.bodyProcedure # NIL) THEN
  311. Body(x.recordScope.bodyProcedure.procedureScope.body, mode >= SourceCode)
  312. END;
  313. Indent; Keyword("END ");
  314. IF (x.pointerType # NIL) & (x.pointerType.typeDeclaration # NIL) THEN
  315. Identifier(x.pointerType.typeDeclaration.name);
  316. END;
  317. ELSE
  318. Keyword("RECORD ");
  319. IF (x.baseType # NIL) THEN
  320. w.String( "(" );
  321. IF (x.baseType IS SyntaxTree.RecordType) & (x.baseType(SyntaxTree.RecordType).pointerType # NIL) THEN
  322. Type(x.baseType(SyntaxTree.RecordType).pointerType)
  323. ELSE
  324. Type(x.baseType);
  325. END;
  326. w.String( ")" );
  327. END;
  328. prevScope := currentScope;
  329. currentScope := x.recordScope;
  330. VariableList(x.recordScope.firstVariable);
  331. currentScope := prevScope;
  332. Indent; Keyword("END" );
  333. END;
  334. END VisitRecordType;
  335. PROCEDURE Flag(identifier: SyntaxTree.Identifier; VAR first: BOOLEAN);
  336. VAR name: SyntaxTree.IdentifierString;
  337. BEGIN
  338. IF first THEN w.String("{") ELSE w.String(", ") END;
  339. first := FALSE;
  340. Basic.GetString(identifier,name);
  341. w.String(name);
  342. END Flag;
  343. PROCEDURE FlagEnd(first: BOOLEAN);
  344. BEGIN
  345. IF ~first THEN w.String("} ") END;
  346. END FlagEnd;
  347. PROCEDURE Value(identifier: SyntaxTree.Identifier; value: LONGINT; VAR first: BOOLEAN);
  348. BEGIN
  349. Flag(identifier,first);
  350. w.String("("); w.Int(value,1); w.String(")");
  351. END Value;
  352. PROCEDURE VisitProcedureType(x: SyntaxTree.ProcedureType);
  353. VAR first: BOOLEAN;
  354. BEGIN
  355. Keyword("PROCEDURE " );
  356. first := TRUE;
  357. IF x.isDelegate THEN Flag(Global.NameDelegate,first) END;
  358. IF x.isInterrupt THEN Flag(Global.NameInterrupt,first) END;
  359. IF x.noPAF THEN Flag(Global.NameNoPAF,first) END;
  360. IF x.noReturn THEN Flag(Global.NameNoReturn,first) END;
  361. IF x.callingConvention = SyntaxTree.WinAPICallingConvention THEN
  362. Flag(Global.NameWinAPI,first)
  363. ELSIF x.callingConvention = SyntaxTree.CCallingConvention THEN
  364. Flag(Global.NameC,first)
  365. END;
  366. IF x.stackAlignment > 1 THEN Value(Global.NameStackAligned,x.stackAlignment,first) END;
  367. IF ~first THEN w.String("}") END;
  368. IF (x.modifiers # NIL) & info THEN
  369. BeginComment;
  370. Modifiers(x.modifiers);
  371. EndComment;
  372. END;
  373. (*
  374. CallingConvention(x.callingConvention);
  375. IF x.isDelegate THEN w.String("{DELEGATE}") END;
  376. *)
  377. IF (x.firstParameter # NIL) OR (x.returnType # NIL) THEN
  378. ParameterList(x.firstParameter)
  379. END;
  380. IF x.returnType # NIL THEN
  381. w.String( ":" );
  382. IF x.hasUntracedReturn THEN
  383. first := TRUE;
  384. Flag(Global.NameUntraced, first);
  385. FlagEnd(first);
  386. END;
  387. Type(x.returnType)
  388. END;
  389. IF info & (x.returnParameter # NIL) THEN
  390. BeginComment;
  391. VisitParameter(x.returnParameter);
  392. EndComment;
  393. END;
  394. END VisitProcedureType;
  395. (*** expressions ****)
  396. PROCEDURE ExpressionList(x: SyntaxTree.ExpressionList);
  397. VAR i: LONGINT; expression: SyntaxTree.Expression;
  398. BEGIN
  399. FOR i := 0 TO x.Length() - 1 DO
  400. expression := x.GetExpression( i ); Expression(expression);
  401. IF i < x.Length() - 1 THEN w.String( ", " ); END;
  402. END;
  403. END ExpressionList;
  404. PROCEDURE Expression*(x: SyntaxTree.Expression);
  405. BEGIN
  406. IF x = NIL THEN
  407. AlertString("nil expression");
  408. ELSE
  409. x.Accept(SELF);
  410. IF info & (x.resolved # NIL) & (x.resolved # x) THEN
  411. BeginComment; w.String("value = "); Expression(x.resolved); EndComment;
  412. END;
  413. END;
  414. w.Update;
  415. END Expression;
  416. PROCEDURE VisitExpression(x: SyntaxTree.Expression);
  417. BEGIN
  418. AlertString("InvalidExpression");
  419. END VisitExpression;
  420. PROCEDURE VisitSet(x: SyntaxTree.Set);
  421. BEGIN
  422. w.String( "{" ); ExpressionList(x.elements); w.String( "}" );
  423. END VisitSet;
  424. PROCEDURE VisitMathArrayExpression(x: SyntaxTree.MathArrayExpression);
  425. BEGIN
  426. w.String( "[" ); ExpressionList(x.elements); w.String( "]" );
  427. END VisitMathArrayExpression;
  428. PROCEDURE VisitUnaryExpression(x: SyntaxTree.UnaryExpression);
  429. VAR identifier: SyntaxTree.Identifier;
  430. BEGIN
  431. w.String(" ");
  432. IF x.operator = Scanner.Transpose THEN
  433. identifier := Global.GetIdentifier(x.operator,case);
  434. Expression(x.left);
  435. Identifier(identifier);
  436. ELSIF (x.operator = Scanner.Address) OR (x.operator = Scanner.Size) OR (x.operator = Scanner.Alias) THEN
  437. identifier := Global.GetIdentifier(x.operator,case);
  438. Identifier(identifier);
  439. Keyword(" OF ");
  440. Expression(x.left);
  441. ELSE
  442. identifier := Global.GetIdentifier(x.operator,case);
  443. Identifier(identifier);
  444. Expression(x.left);
  445. END;
  446. END VisitUnaryExpression;
  447. PROCEDURE VisitBinaryExpression(x: SyntaxTree.BinaryExpression);
  448. VAR identifier: SyntaxTree.Identifier;
  449. BEGIN
  450. w.String( "(" );
  451. Expression(x.left);
  452. identifier := Global.GetIdentifier(x.operator,case);
  453. w.String(" "); Identifier(identifier); w.String(" ");
  454. Expression(x.right);
  455. w.String(")");
  456. END VisitBinaryExpression;
  457. PROCEDURE VisitRangeExpression(x: SyntaxTree.RangeExpression);
  458. BEGIN
  459. IF x.missingFirst & x.missingLast & x.missingStep THEN
  460. (* open range expression *)
  461. (* the surrounding spaces prevent the asterisk from being next to a parenthesis,
  462. which could be confused with the beginning or end of a comment *)
  463. w.String(" * ")
  464. ELSE
  465. IF ~x.missingFirst THEN Expression(x.first) END;
  466. w.String(" .. ");
  467. IF ~x.missingLast THEN Expression(x.last) END;
  468. IF ~x.missingStep THEN
  469. Keyword(" BY ");
  470. Expression(x.step)
  471. END
  472. END;
  473. IF info THEN
  474. BeginComment;
  475. w.String("<RangeExpression:");
  476. ShortType(x.type);
  477. w.String(">");
  478. EndComment
  479. END
  480. END VisitRangeExpression;
  481. PROCEDURE VisitTensorRangeExpression(x: SyntaxTree.TensorRangeExpression);
  482. BEGIN
  483. w.String(" ? ");
  484. END VisitTensorRangeExpression;
  485. PROCEDURE VisitConversion(x: SyntaxTree.Conversion);
  486. BEGIN
  487. IF x.typeExpression # NIL THEN Expression(x.typeExpression); w.String("(");
  488. ELSIF info THEN BeginComment; ShortType(x.type); w.String("<-"); EndComment;
  489. END;
  490. Expression(x.expression);
  491. IF x.typeExpression # NIL THEN w.String(")") END;
  492. END VisitConversion;
  493. PROCEDURE VisitDesignator(x: SyntaxTree.Designator);
  494. BEGIN
  495. AlertString("InvalidDesignator");
  496. END VisitDesignator;
  497. PROCEDURE VisitIdentifierDesignator(x: SyntaxTree.IdentifierDesignator);
  498. BEGIN
  499. IF info THEN AlertString("(*<IdentifierDesignator>*)") END;
  500. Identifier(x.identifier)
  501. END VisitIdentifierDesignator;
  502. PROCEDURE VisitSelectorDesignator(x: SyntaxTree.SelectorDesignator);
  503. BEGIN
  504. Expression(x.left);
  505. w.String(".");
  506. IF info THEN AlertString("(*<SelectorDesignator>*)") END;
  507. Identifier(x.identifier);
  508. END VisitSelectorDesignator;
  509. PROCEDURE VisitBracketDesignator(x: SyntaxTree.BracketDesignator);
  510. BEGIN
  511. Expression(x.left);
  512. IF info THEN AlertString("(*<BracketDesignator>*)") END;
  513. w.String("["); ExpressionList(x.parameters); w.String("]");
  514. END VisitBracketDesignator;
  515. PROCEDURE VisitParameterDesignator(x: SyntaxTree.ParameterDesignator);
  516. BEGIN
  517. Expression(x.left);
  518. IF info THEN AlertString("(*<ParameterDesignator>*)") END;
  519. w.String("("); ExpressionList(x.parameters); w.String(")");
  520. END VisitParameterDesignator;
  521. PROCEDURE VisitIndexDesignator(x: SyntaxTree.IndexDesignator);
  522. BEGIN
  523. Expression(x.left);
  524. w.String("["); ExpressionList(x.parameters); w.String("]");
  525. IF info THEN
  526. BeginComment;
  527. w.String("<IndexDesignator:");
  528. ShortType(x.type);
  529. w.String(">");
  530. EndComment
  531. END;
  532. END VisitIndexDesignator;
  533. PROCEDURE VisitArrowDesignator(x: SyntaxTree.ArrowDesignator);
  534. BEGIN
  535. Expression(x.left);
  536. IF info THEN AlertString("(*<ArrowDesignator>*)") END;
  537. w.String( "^" );
  538. END VisitArrowDesignator;
  539. PROCEDURE ShortType(x: SyntaxTree.Type); (* for debug information, to prevent recursion *)
  540. BEGIN
  541. IF x = NIL THEN w.String("NIL TYPE")
  542. ELSIF x IS SyntaxTree.QualifiedType THEN Type(x)
  543. ELSIF x IS SyntaxTree.BasicType THEN Type(x)
  544. ELSIF x IS SyntaxTree.ProcedureType THEN w.String("ProcedureType:");ShortType(x(SyntaxTree.ProcedureType).returnType);
  545. ELSE w.String("(other)") END;
  546. END ShortType;
  547. PROCEDURE VisitSymbolDesignator(x: SyntaxTree.SymbolDesignator);
  548. BEGIN
  549. IF (x.left # NIL) & ~x.left.isHidden THEN
  550. Expression(x.left); w.String(".");
  551. END;
  552. IF x.symbol IS SyntaxTree.Operator THEN
  553. w.String('"'); Identifier(x.symbol.name); w.String('"');
  554. ELSE
  555. useCase :=
  556. (x.symbol IS SyntaxTree.Builtin)
  557. OR ((x.symbol IS SyntaxTree.TypeDeclaration) & (x.symbol(SyntaxTree.TypeDeclaration).declaredType IS SyntaxTree.BasicType))
  558. OR (x.symbol IS SyntaxTree.Module) & ((x.symbol.name = Global.systemName) OR (x.symbol.name = Global.SystemName));
  559. Identifier(x.symbol.name);
  560. useCase := FALSE;
  561. END;
  562. IF info THEN
  563. BeginComment;
  564. w.String("<SymbolDesignator:");
  565. ShortType(x.symbol.type);
  566. w.String(">");
  567. EndComment
  568. END;
  569. END VisitSymbolDesignator;
  570. PROCEDURE VisitSupercallDesignator(x: SyntaxTree.SupercallDesignator);
  571. BEGIN
  572. Expression(x.left);
  573. w.String( "^" );
  574. IF info THEN
  575. BeginComment;
  576. w.String("<SupercallDesignator:");
  577. ShortType(x.type);
  578. w.String(">");
  579. EndComment
  580. END;
  581. END VisitSupercallDesignator;
  582. PROCEDURE VisitSelfDesignator(x: SyntaxTree.SelfDesignator);
  583. BEGIN
  584. ASSERT(x.left = NIL);
  585. IF case = Scanner.Lowercase THEN w.String("self"); ELSE w.String("SELF"); END;
  586. IF info THEN
  587. BeginComment;
  588. w.String("<SelfDesignator:");
  589. ShortType(x.type);
  590. w.String(">");
  591. EndComment
  592. END;
  593. END VisitSelfDesignator;
  594. PROCEDURE VisitResultDesignator(x: SyntaxTree.ResultDesignator);
  595. BEGIN
  596. ASSERT(x.left = NIL);
  597. w.String("RESULT");
  598. IF info THEN
  599. BeginComment;
  600. w.String("<ResultDesignator:");
  601. ShortType(x.type);
  602. w.String(">");
  603. EndComment
  604. END;
  605. END VisitResultDesignator;
  606. PROCEDURE VisitDereferenceDesignator(x: SyntaxTree.DereferenceDesignator);
  607. BEGIN
  608. Expression(x.left);
  609. w.String( "^" );
  610. IF info THEN
  611. BeginComment;
  612. w.String("<DereferenceDesignator:");
  613. ShortType(x.type);
  614. w.String(">");
  615. EndComment
  616. END;
  617. END VisitDereferenceDesignator;
  618. PROCEDURE VisitTypeGuardDesignator(x: SyntaxTree.TypeGuardDesignator);
  619. BEGIN
  620. Expression(x.left);
  621. IF info THEN
  622. BeginComment;
  623. w.String("<TypeGuardDesignator:");
  624. ShortType(x.type);
  625. w.String(">");
  626. EndComment
  627. END;
  628. w.String("(");
  629. IF x.typeExpression # NIL THEN Expression(x.typeExpression) ELSE Type(x.type) END;
  630. w.String(")");
  631. END VisitTypeGuardDesignator;
  632. PROCEDURE VisitProcedureCallDesignator(x: SyntaxTree.ProcedureCallDesignator);
  633. BEGIN
  634. Expression(x.left);
  635. IF info THEN
  636. BeginComment;
  637. w.String("<ProcedureCallDesignator:");
  638. ShortType(x.type);
  639. w.String(">");
  640. EndComment
  641. END;
  642. w.String("("); ExpressionList(x.parameters); w.String(")");
  643. END VisitProcedureCallDesignator;
  644. PROCEDURE VisitStatementDesignator(x: SyntaxTree.StatementDesignator);
  645. BEGIN
  646. Indent; Keyword("STATEMENT-DESIGNATOR ");
  647. IF x.result # NIL THEN
  648. Keyword("RETURNS ");
  649. Expression(x.result)
  650. END;
  651. Indent; Statement(x.statement);
  652. END VisitStatementDesignator;
  653. PROCEDURE VisitBuiltinCallDesignator(x: SyntaxTree.BuiltinCallDesignator);
  654. BEGIN
  655. IF x.left # NIL THEN
  656. Expression(x.left);
  657. ELSE
  658. w.String("BUILTIN(");
  659. w.Int(x.id,1);
  660. w.String(")");
  661. END;
  662. IF info THEN
  663. BeginComment;
  664. w.String("<BuiltinCallDesignator:");
  665. ShortType(x.type);
  666. w.String(">");
  667. EndComment
  668. END;
  669. w.String("("); ExpressionList(x.parameters); w.String(")");
  670. END VisitBuiltinCallDesignator;
  671. PROCEDURE VisitValue(x: SyntaxTree.Value);
  672. BEGIN
  673. AlertString("InvalidValue");
  674. END VisitValue;
  675. PROCEDURE VisitBooleanValue(x: SyntaxTree.BooleanValue);
  676. BEGIN
  677. IF Scanner.Uppercase = case THEN
  678. IF x.value THEN w.String("TRUE" ) ELSE w.String( "FALSE" ) END
  679. ELSE
  680. IF x.value THEN w.String("true" ) ELSE w.String( "false" ) END
  681. END
  682. END VisitBooleanValue;
  683. PROCEDURE Hex(x: HUGEINT);
  684. VAR i: LONGINT; a: ARRAY 20 OF CHAR; y: HUGEINT;
  685. BEGIN
  686. i := 0;
  687. REPEAT
  688. y := x MOD 10H;
  689. IF y < 10 THEN a[i] := CHR(y+ORD('0'))
  690. ELSE a[i] := CHR(y-10+ORD('A'))
  691. END;
  692. x := x DIV 10H;
  693. INC(i);
  694. UNTIL (x=0) OR (i=16);
  695. IF y >=10 THEN w.Char("0") END;
  696. REPEAT DEC( i ); w.Char( a[i] ) UNTIL i = 0
  697. END Hex;
  698. PROCEDURE VisitIntegerValue(x: SyntaxTree.IntegerValue);
  699. PROCEDURE InBounds(val: HUGEINT; bits: LONGINT): BOOLEAN;
  700. VAR m: HUGEINT;
  701. BEGIN
  702. m := ASH(HUGEINT(1),bits-1);
  703. RETURN (val < m) & (-val <= m)
  704. END InBounds;
  705. BEGIN
  706. (*! use subtype for representation form ? *)
  707. IF x.hvalue = MIN(HUGEINT) THEN
  708. (* special case: display 8000000000000000H without leading minus sign
  709. to avoid double minus sign for unary expression -8000000000000000H
  710. *)
  711. w.Char("0"); w.Hex(x.hvalue,-16); w.Char("H");
  712. ELSIF InBounds(x.hvalue,32) THEN
  713. w.Int(SHORT(x.hvalue),1);
  714. ELSE
  715. Hex(x.hvalue); w.Char("H");
  716. END;
  717. END VisitIntegerValue;
  718. PROCEDURE VisitCharacterValue(x: SyntaxTree.CharacterValue);
  719. BEGIN
  720. Hex( ORD(x.value)); w.String( "X" );
  721. END VisitCharacterValue;
  722. PROCEDURE VisitSetValue(x: SyntaxTree.SetValue);
  723. VAR i: LONGINT;
  724. BEGIN
  725. w.String("{");
  726. i := 0;
  727. WHILE (i<MAX(SET)) & ~(i IN x.value) DO
  728. INC(i);
  729. END;
  730. IF i<MAX(SET) THEN
  731. w.Int(i,1);
  732. INC(i);
  733. WHILE i < MAX(SET) DO
  734. IF i IN x.value THEN w.String(","); w.Int(i,1); END;
  735. INC(i)
  736. END
  737. END;
  738. w.String("}");
  739. END VisitSetValue;
  740. PROCEDURE VisitMathArrayValue(x: SyntaxTree.MathArrayValue);
  741. BEGIN
  742. VisitMathArrayExpression(x.array);
  743. END VisitMathArrayValue;
  744. PROCEDURE FormatedFloat(value: LONGREAL; subtype: LONGINT);
  745. VAR string: ARRAY 128 OF CHAR; i: LONGINT;
  746. BEGIN
  747. IF subtype = Scanner.Real THEN
  748. ws.SetPos(0); ws.Float(value,11(*mantissa X.XXXXXXX *)+5(*exponent E+XXX *)); ws.Get(string);
  749. i := 0;
  750. WHILE(i<LEN(string)) & (string[i] # 0X) DO
  751. IF string[i] = "D" THEN string[i] := "E" END;
  752. INC(i);
  753. END;
  754. w.String(string);
  755. ELSIF subtype = Scanner.Longreal THEN
  756. ws.SetPos(0); ws.Float(value,20(*mantissa X.X..(16)..X *)+5(*exponent E+XXX *) ); ws.Get(string);
  757. i := 0;
  758. WHILE(i<LEN(string)) & (string[i] # 0X) DO
  759. IF string[i] = "E" THEN string[i] := "D" END;
  760. INC(i);
  761. END;
  762. w.String(string);
  763. ELSE
  764. w.Float(value,64)
  765. END;
  766. END FormatedFloat;
  767. PROCEDURE VisitRealValue(x: SyntaxTree.RealValue);
  768. BEGIN FormatedFloat(x.value, x.subtype)
  769. END VisitRealValue;
  770. PROCEDURE VisitComplexValue(x: SyntaxTree.ComplexValue);
  771. BEGIN
  772. IF (x.realValue = 0) & (x.imagValue = 1) THEN
  773. w.String("IMAG")
  774. ELSE
  775. w.String("(");
  776. FormatedFloat(x.realValue, x.subtype) ;
  777. w.String(" ");
  778. IF x.imagValue > 0 THEN w.String("+") END;
  779. FormatedFloat(x.imagValue, x.subtype);
  780. w.String("*IMAG)")
  781. END
  782. END VisitComplexValue;
  783. PROCEDURE VisitStringValue(x: SyntaxTree.StringValue);
  784. VAR i: LONGINT; ch: CHAR;
  785. BEGIN
  786. i := 0;
  787. w.Char('\');
  788. w.Char('"');
  789. WHILE (i < LEN( x.value )) & (x.value[i] # 0X) DO
  790. ch := x.value[i];
  791. IF ch = Scanner.CR THEN w.String("\n")
  792. ELSIF ch = Scanner.LF THEN (* ignore *)
  793. ELSIF ch = Scanner.TAB THEN w.String("\t")
  794. ELSIF ch = '\' THEN w.String("\\")
  795. ELSIF ch = '"' THEN w.String(\"""\); (* " *)
  796. ELSE w.Char(ch)
  797. END;
  798. INC( i );
  799. END;
  800. w.Char('"');
  801. w.Char('\');
  802. END VisitStringValue;
  803. PROCEDURE VisitNilValue(x: SyntaxTree.NilValue);
  804. BEGIN IF case = Scanner.Lowercase THEN w.String( "nil" ); ELSE w.String( "NIL" ); END; IF info THEN BeginComment; Type(x.type); EndComment; END;
  805. END VisitNilValue;
  806. PROCEDURE VisitEnumerationValue(x: SyntaxTree.EnumerationValue);
  807. BEGIN w.Int(x.value,1);
  808. END VisitEnumerationValue;
  809. (**** symbols ****)
  810. PROCEDURE Symbol*(x: SyntaxTree.Symbol);
  811. BEGIN
  812. IF x = NIL THEN
  813. AlertString("nil symbol");
  814. ELSE
  815. x.Accept(SELF);
  816. END
  817. END Symbol;
  818. PROCEDURE VisitSymbol(x: SyntaxTree.Symbol);
  819. BEGIN
  820. AlertString("InvalidSymbol");
  821. END VisitSymbol;
  822. PROCEDURE Visible(symbol: SyntaxTree.Symbol): BOOLEAN;
  823. BEGIN
  824. RETURN TRUE (* (SyntaxTree.Public * symbol.access # {}) OR (mode > SymbolFile) *)
  825. (* using only exported symbols does not work since there might be dependencies ... *)
  826. END Visible;
  827. PROCEDURE PrintSymbol(x: SyntaxTree.Symbol);
  828. BEGIN
  829. IF x IS SyntaxTree.Operator THEN
  830. w.String('"');Identifier(x.name); w.String('"')
  831. ELSE
  832. Identifier(x.name)
  833. END;
  834. IF SyntaxTree.PublicWrite IN x.access THEN w.String( "*" )
  835. ELSIF SyntaxTree.PublicRead IN x.access THEN w.String( "-" )
  836. ELSIF x.access = {} THEN ASSERT(mode > SourceCode);
  837. IF info THEN BeginComment; w.String("<- hidden"); EndComment END;
  838. END;
  839. IF x.externalName # NIL THEN
  840. Keyword(" EXTERN " ); w.Char('"');
  841. w.String(x.externalName^); w.Char('"');
  842. END;
  843. IF info THEN
  844. BeginComment;
  845. w.String("access= {");
  846. Access(x.access);
  847. w.String("}");
  848. IF x.offsetInBits # MIN(LONGINT) THEN
  849. w.String("@"); w.Hex(x.offsetInBits,1);
  850. END;
  851. IF x.type # NIL THEN
  852. IF x.type.resolved.alignmentInBits >=0 THEN
  853. w.String("@@"); w.Hex(x.type.resolved.alignmentInBits,1);
  854. END;
  855. END;
  856. EndComment;
  857. END;
  858. END PrintSymbol;
  859. PROCEDURE VisitTypeDeclaration(x: SyntaxTree.TypeDeclaration);
  860. BEGIN
  861. IF Visible(x) THEN
  862. IF (x.access # SyntaxTree.Hidden) OR (mode > SourceCode) THEN
  863. Comments(x.comment,x,FALSE);
  864. PrintSymbol(x);
  865. w.String(" = ");
  866. IF x.access # SyntaxTree.Hidden THEN
  867. Type(x.declaredType);
  868. ELSE ShortType(x.declaredType)
  869. END;
  870. Comments(x.comment,x,TRUE);
  871. END;
  872. END;
  873. END VisitTypeDeclaration;
  874. PROCEDURE TypeDeclarationList(x: SyntaxTree.TypeDeclaration);
  875. BEGIN
  876. Indent;
  877. Keyword("TYPE " );
  878. w.IncIndent;
  879. WHILE(x # NIL) DO
  880. Indent;
  881. Symbol(x);
  882. w.String( "; " );
  883. x := x.nextTypeDeclaration;
  884. IF x # NIL THEN w.Ln END;
  885. END;
  886. w.DecIndent;
  887. END TypeDeclarationList;
  888. PROCEDURE VisitConstant(x: SyntaxTree.Constant);
  889. BEGIN
  890. IF Visible(x) THEN
  891. IF (mode > SourceCode) OR (x.access # SyntaxTree.Hidden) THEN
  892. Comments(x.comment,x,FALSE);
  893. PrintSymbol(x);
  894. IF x.value # NIL THEN
  895. w.String( " = " ); Expression(x.value);
  896. END;
  897. IF info THEN BeginComment; ShortType(x.type); EndComment; END;
  898. IF info & (x.value.resolved = NIL) THEN AlertString("(*NOT A CONSTANT*)") END;
  899. Comments(x.comment,x,TRUE);
  900. END;
  901. END;
  902. END VisitConstant;
  903. PROCEDURE ConstantList(x: SyntaxTree.Constant);
  904. BEGIN
  905. Indent; Keyword("CONST " );
  906. w.IncIndent;
  907. WHILE(x # NIL) DO
  908. IF (x.access # SyntaxTree.Hidden) OR (mode > SourceCode) THEN
  909. Indent;
  910. Symbol(x);
  911. w.String( "; " );
  912. END;
  913. x := x.nextConstant;
  914. END;
  915. w.DecIndent;
  916. END ConstantList;
  917. PROCEDURE VisitVariable(x: SyntaxTree.Variable);
  918. BEGIN
  919. IF Visible(x) THEN
  920. IF (x.access # SyntaxTree.Hidden) THEN
  921. Comments(x.comment,x,FALSE);
  922. PrintSymbol(x);
  923. IF x.modifiers # NIL THEN w.String(" "); Modifiers(x.modifiers); END;
  924. IF x.initializer # NIL THEN
  925. w.String( " := " ); Expression (x.initializer);
  926. END;
  927. w.String( ": " );
  928. Type(x.type);
  929. Comments(x.comment,x,TRUE);
  930. ELSIF mode>SourceCode THEN
  931. Comments(x.comment,x,FALSE);
  932. PrintSymbol(x);
  933. IF x.initializer # NIL THEN
  934. w.String( " := " ); Expression (x.initializer);
  935. END;
  936. Comments(x.comment,x,TRUE);
  937. END
  938. END;
  939. END VisitVariable;
  940. PROCEDURE VariableList(x: SyntaxTree.Variable);
  941. VAR next: SyntaxTree.Variable;
  942. PROCEDURE Flags(x: SyntaxTree.Variable);
  943. VAR first: BOOLEAN;
  944. BEGIN
  945. first := TRUE;
  946. IF x.fixed THEN
  947. Value(Global.NameFixed,x.alignment,first)
  948. ELSIF x.alignment > 1 THEN
  949. Value(Global.NameAligned,x.alignment,first)
  950. ELSIF x.fictive THEN
  951. Value(Global.NameFictive, x.fictiveOffset, first);
  952. END;
  953. IF x.untraced THEN
  954. Flag(Global.NameUntraced,first)
  955. END;
  956. FlagEnd(first);
  957. END Flags;
  958. BEGIN
  959. w.IncIndent;
  960. WHILE(x # NIL) DO
  961. next := x.nextVariable;
  962. IF (x.access # SyntaxTree.Hidden) OR (mode > SourceCode) THEN
  963. Indent;
  964. Comments(x.comment, x, FALSE);
  965. PrintSymbol(x); Flags(x);
  966. WHILE(next # NIL) & (next.type = x.type) & ((next.access # SyntaxTree.Hidden) OR (mode > SourceCode)) DO
  967. w.String(", "); PrintSymbol(next); Flags(next);
  968. next := next.nextVariable;
  969. END;
  970. IF x.access # SyntaxTree.Hidden THEN
  971. w.String(": ");
  972. Type(x.type);
  973. ELSE
  974. w.String(": ");
  975. ShortType(x.type);
  976. END;
  977. w.String("; ");
  978. Comments(x.comment,x, TRUE);
  979. END;
  980. x := next;
  981. END;
  982. w.DecIndent
  983. END VariableList;
  984. PROCEDURE VisitParameter(x: SyntaxTree.Parameter);
  985. BEGIN
  986. IF (x.access # SyntaxTree.Hidden) THEN
  987. Comments(x.comment,x,TRUE);
  988. IF x.kind = SyntaxTree.VarParameter THEN Keyword("VAR " );
  989. ELSIF x.kind = SyntaxTree.ConstParameter THEN Keyword("CONST " );
  990. END;
  991. PrintSymbol(x);
  992. IF x.modifiers # NIL THEN w.String(" "); Modifiers(x.modifiers); END;
  993. IF x.defaultValue # NIL THEN
  994. w.String("= "); Expression(x.defaultValue);
  995. END;
  996. w.String( ": " );
  997. Type(x.type);
  998. Comments(x.comment,x,TRUE);
  999. ELSIF (mode > SourceCode) THEN
  1000. Comments(x.comment,x,FALSE);
  1001. PrintSymbol(x);
  1002. Comments(x.comment,x,TRUE);
  1003. END;
  1004. END VisitParameter;
  1005. PROCEDURE ParameterList*(x: SyntaxTree.Parameter);
  1006. VAR next: SyntaxTree.Parameter; first: BOOLEAN;
  1007. PROCEDURE Flags(x: SyntaxTree.Parameter);
  1008. VAR first: BOOLEAN;
  1009. BEGIN
  1010. IF x.modifiers # NIL THEN
  1011. Modifiers(x.modifiers)
  1012. ELSE
  1013. first := TRUE;
  1014. IF x.untraced THEN
  1015. Flag(Global.NameUntraced,first)
  1016. END;
  1017. FlagEnd(first);
  1018. END;
  1019. END Flags;
  1020. BEGIN
  1021. first := TRUE;
  1022. w.String( "(" );
  1023. WHILE(x # NIL) DO
  1024. next := x.nextParameter;
  1025. IF (x.access # SyntaxTree.Hidden) OR (mode > SourceCode) THEN
  1026. IF ~first THEN w.String("; ") END;
  1027. first := FALSE;
  1028. IF x.kind = SyntaxTree.VarParameter THEN Keyword("VAR " );
  1029. ELSIF x.kind = SyntaxTree.ConstParameter THEN Keyword("CONST " );
  1030. END;
  1031. PrintSymbol(x); Flags(x);
  1032. IF x.defaultValue # NIL THEN
  1033. w.String("= "); Expression(x.defaultValue);
  1034. END;
  1035. WHILE (next # NIL) & (next.type = x.type) & (next.kind = x.kind) & ((next.access # SyntaxTree.Hidden) OR (mode > SourceCode)) DO
  1036. w.String(", ");
  1037. PrintSymbol(next); Flags(next);
  1038. IF next.defaultValue # NIL THEN
  1039. w.String("= "); Expression(next.defaultValue);
  1040. END;
  1041. next := next.nextParameter;
  1042. END;
  1043. IF x.access # SyntaxTree.Hidden THEN
  1044. w.String(": ");
  1045. Type(x.type);
  1046. ELSE
  1047. w.String(": ");
  1048. ShortType(x.type);
  1049. END;
  1050. END;
  1051. x := next;
  1052. END;
  1053. w.String( ")" );
  1054. END ParameterList;
  1055. PROCEDURE Access(access: SET);
  1056. BEGIN
  1057. IF SyntaxTree.PublicWrite IN access THEN w.String(" PublicWrite") END;
  1058. IF SyntaxTree.ProtectedWrite IN access THEN w.String(" ProtectedWrite") END;
  1059. IF SyntaxTree.InternalWrite IN access THEN w.String(" InternalWrite") END;
  1060. IF SyntaxTree.PublicRead IN access THEN w.String(" PublicRead") END;
  1061. IF SyntaxTree.ProtectedRead IN access THEN w.String(" ProtectedRead") END;
  1062. IF SyntaxTree.InternalRead IN access THEN w.String(" InternalRead") END;
  1063. END Access;
  1064. PROCEDURE VisitProcedure(x: SyntaxTree.Procedure);
  1065. VAR type: SyntaxTree.ProcedureType; first: BOOLEAN;
  1066. BEGIN
  1067. IF Visible(x) THEN
  1068. Indent;
  1069. Comments(x.comment,x,FALSE);
  1070. Keyword("PROCEDURE " );
  1071. IF (mode = SymbolFile) & ~x.isInline & ~x.isOberonInline THEN
  1072. w.String("^ ");
  1073. END;
  1074. (*
  1075. CallingConvention(x.type(SyntaxTree.ProcedureType).callingConvention);
  1076. *)
  1077. type := x.type(SyntaxTree.ProcedureType);
  1078. (*
  1079. flags := type.flags;
  1080. *)
  1081. first := TRUE;
  1082. IF type.stackAlignment > 1 THEN Value(Global.NameStackAligned,type.stackAlignment,first) END;
  1083. IF (type.isRealtime) THEN Flag(Global.NameRealtime,first) END;
  1084. IF (type.noReturn) THEN Flag(Global.NameNoReturn,first) END;
  1085. IF (x.fixed) THEN Value(Global.NameFixed, x.alignment,first)
  1086. ELSIF (x.alignment >1) THEN Value(Global.NameAligned, x.alignment, first)
  1087. END;
  1088. FlagEnd(first);
  1089. IF x.isInline OR x.isOberonInline THEN w.String(" - ") END;
  1090. IF x.isConstructor THEN w.String(" & ") END;
  1091. IF x.isFinalizer THEN w.String(" ~ ") END;
  1092. IF type.selfParameter # NIL THEN
  1093. ParameterList(type.selfParameter);
  1094. END;
  1095. IF info THEN
  1096. BeginComment;
  1097. Modifiers(x.type(SyntaxTree.ProcedureType).modifiers);
  1098. EndComment;
  1099. END;
  1100. PrintSymbol(x);
  1101. IF (type.firstParameter # NIL) OR (type.returnType # NIL ) THEN (* print parentheses only if not parameterless procedure *)
  1102. ParameterList(type.firstParameter);
  1103. END;
  1104. IF type.returnType # NIL THEN
  1105. w.String( ": " );
  1106. IF type.hasUntracedReturn THEN
  1107. first := TRUE;
  1108. Flag(Global.NameUntraced, first);
  1109. FlagEnd(first);
  1110. END;
  1111. Type(type.returnType);
  1112. END;
  1113. IF info & (type.returnParameter # NIL) THEN
  1114. BeginComment;
  1115. w.String("retPar = ");
  1116. Symbol(type.returnParameter);
  1117. EndComment;
  1118. END;
  1119. IF x.externalName = NIL THEN
  1120. IF (mode > SymbolFile) OR (mode = SymbolFile) & (x.isInline OR x.isOberonInline) THEN
  1121. w.String( ";" );
  1122. Comments(x.comment,x,TRUE);
  1123. IF (mode >= SymbolFile) OR x.isOberonInline THEN
  1124. ProcedureScope(x.procedureScope);
  1125. END;
  1126. Indent; Keyword("END " ); Identifier(x.name);
  1127. END;
  1128. END;
  1129. END;
  1130. END VisitProcedure;
  1131. PROCEDURE VisitOperator(x: SyntaxTree.Operator);
  1132. VAR type: SyntaxTree.ProcedureType;
  1133. recordType: SyntaxTree.RecordType;
  1134. i: LONGINT;
  1135. valid, first: BOOLEAN;
  1136. BEGIN
  1137. IF Visible(x) THEN
  1138. Indent;
  1139. Comments(x.comment,x,FALSE);
  1140. (* mark array access operators for array-structured object types *)
  1141. IF info THEN
  1142. IF (x.scope # NIL) & (x.scope IS SyntaxTree.RecordScope) THEN
  1143. recordType := x.scope(SyntaxTree.RecordScope).ownerRecord;
  1144. IF recordType.HasArrayStructure() THEN
  1145. BeginComment;
  1146. valid := FALSE;
  1147. IF x = recordType.arrayAccessOperators.len THEN w.String("the length operator: "); valid := TRUE;
  1148. ELSIF x = recordType.arrayAccessOperators.generalRead THEN w.String("the general read operator"); valid := TRUE;
  1149. ELSIF x = recordType.arrayAccessOperators.generalWrite THEN w.String("the general write operator"); valid := TRUE;
  1150. ELSE
  1151. FOR i := 0 TO LEN(recordType.arrayAccessOperators.read, 0) - 1 DO
  1152. IF x = recordType.arrayAccessOperators.read[i] THEN w.String("a read operator (hash="); w.Int(i, 1); w.String("):"); valid := TRUE;
  1153. ELSIF x = recordType.arrayAccessOperators.write[i] THEN w.String("a write operator (hash="); w.Int(i, 1); w.String("):"); valid := TRUE;
  1154. END
  1155. END
  1156. END;
  1157. IF ~valid THEN w.String("an invalid operator:") END;
  1158. EndComment;
  1159. w.String(" ");
  1160. END
  1161. END
  1162. END;
  1163. Keyword("OPERATOR ");
  1164. first := TRUE;
  1165. IF x.isInline OR x.isOberonInline THEN
  1166. ASSERT(~x.isDynamic);
  1167. w.String("-");
  1168. ELSE
  1169. IF mode = SymbolFile THEN w.String("^ ") END;
  1170. IF x.isDynamic THEN Flag(Global.NameDynamic, first) END;
  1171. IF ~first THEN w.String("}") END;
  1172. END;
  1173. type := x.type(SyntaxTree.ProcedureType);
  1174. PrintSymbol(x);
  1175. ParameterList(type.firstParameter);
  1176. IF type.returnType # NIL THEN
  1177. w.String( ": " );
  1178. IF type.hasUntracedReturn THEN
  1179. first := TRUE;
  1180. Flag(Global.NameUntraced, first);
  1181. FlagEnd(first);
  1182. END;
  1183. Type(type.returnType);
  1184. END;
  1185. IF info & (type.returnParameter # NIL) THEN
  1186. BeginComment;
  1187. (*w.String("retPar = ");*) (*! this is present in VisitProcedure - should it be present here as well??? *)
  1188. Symbol(type.returnParameter);
  1189. EndComment;
  1190. END;
  1191. IF x.externalName = NIL THEN
  1192. IF (mode > SymbolFile) OR (mode = SymbolFile) & (x.isInline OR x.isOberonInline) THEN
  1193. w.String( ";" );
  1194. Comments(x.comment,x,TRUE);
  1195. IF mode >= SymbolFile THEN
  1196. ProcedureScope(x.procedureScope);
  1197. END;
  1198. Indent; Keyword("END " ); w.String( '"' ); Identifier(x.name); w.String( '"' );
  1199. END;
  1200. END;
  1201. END
  1202. END VisitOperator;
  1203. PROCEDURE ProcedureList(list: SyntaxTree.ProcedureList);
  1204. VAR x: SyntaxTree.Procedure; i: LONGINT;
  1205. BEGIN
  1206. w.IncIndent;
  1207. FOR i := 0 TO list.Length()-1 DO
  1208. x := list.GetProcedure(i);
  1209. IF (x.access # SyntaxTree.Hidden) & ~(x.isBodyProcedure) OR (mode > SourceCode) THEN
  1210. Symbol(x);
  1211. w.String( "; " );
  1212. END;
  1213. IF (i# list.Length()-1) & (mode > SymbolFile) & ((x.access # SyntaxTree.Hidden) OR (mode > SourceCode)) THEN w.Ln END;
  1214. END;
  1215. w.DecIndent;
  1216. END ProcedureList;
  1217. PROCEDURE VisitImport(x: SyntaxTree.Import);
  1218. VAR context: SyntaxTree.Identifier;
  1219. BEGIN
  1220. IF x.moduleName # x.name THEN Identifier(x.name); w.String( " := " ); END;
  1221. IF (x.scope = NIL) OR (x.scope.ownerModule = NIL) THEN context := SyntaxTree.invalidIdentifier ELSE context := x.scope.ownerModule.context END;
  1222. Identifier(x.moduleName);
  1223. IF (x.context # SyntaxTree.invalidIdentifier) & (x.context#context) THEN
  1224. w.String(" IN ");
  1225. Identifier(x.context)
  1226. END;
  1227. END VisitImport;
  1228. PROCEDURE ImportList(x: SyntaxTree.Import);
  1229. VAR first: BOOLEAN;
  1230. BEGIN
  1231. first := TRUE;
  1232. WHILE(x # NIL) DO
  1233. IF x.direct & (x.module # NIL) OR (mode > SymbolFile) THEN
  1234. IF ~first THEN w.String(", ") ELSE Indent; Keyword("IMPORT "); first := FALSE END;
  1235. Symbol(x);
  1236. END;
  1237. x := x.nextImport;
  1238. END;
  1239. IF ~first THEN w.String( ";" ); END;
  1240. END ImportList;
  1241. PROCEDURE VisitBuiltin(x: SyntaxTree.Builtin);
  1242. BEGIN
  1243. Indent; Keyword("BUILTIN ");
  1244. Identifier(x.name);
  1245. END VisitBuiltin;
  1246. PROCEDURE BuiltinList(x: SyntaxTree.Builtin);
  1247. BEGIN
  1248. WHILE(x # NIL) DO
  1249. VisitBuiltin(x);
  1250. x := x.nextBuiltin;
  1251. END;
  1252. END BuiltinList;
  1253. PROCEDURE BeginComment;
  1254. BEGIN
  1255. w.BeginComment; w.String("(*");
  1256. END BeginComment;
  1257. PROCEDURE EndComment;
  1258. BEGIN
  1259. w.String("*)");w.EndComment
  1260. END EndComment;
  1261. PROCEDURE Comment(x: SyntaxTree.Comment);
  1262. VAR i: LONGINT; ch: CHAR;
  1263. BEGIN
  1264. BeginComment;
  1265. WHILE (i<LEN(x.source^)) & (x.source[i] # 0X) DO
  1266. ch := x.source[i];
  1267. IF ch = 0DX THEN w.Ln
  1268. ELSE w.Char(ch)
  1269. END;
  1270. INC(i);
  1271. END;
  1272. EndComment;
  1273. END Comment;
  1274. PROCEDURE Comments(c: SyntaxTree.Comment; x: ANY; sameLine: BOOLEAN);
  1275. BEGIN
  1276. IF mode >= SourceCode THEN
  1277. WHILE (c # NIL) & (c.item = x) DO
  1278. IF c.sameLine = sameLine THEN
  1279. Comment(c);
  1280. IF ~sameLine THEN
  1281. Indent;
  1282. END;
  1283. END;
  1284. c := c.nextComment;
  1285. END;
  1286. END;
  1287. END Comments;
  1288. PROCEDURE CommentList(x: SyntaxTree.Comment);
  1289. BEGIN
  1290. IF info THEN
  1291. WHILE (x#NIL) DO
  1292. Indent;
  1293. w.String("comment at position "); w.Int(x.position.start,1);
  1294. IF x.sameLine THEN w.String("(in line with item)") END;
  1295. IF x.item = NIL THEN w.String("(no item)"); END;
  1296. w.String(":");
  1297. Comment(x);
  1298. x := x.nextComment;
  1299. END;
  1300. END;
  1301. END CommentList;
  1302. (*** scopes ****)
  1303. PROCEDURE Scope*(x: SyntaxTree.Scope);
  1304. VAR prevScope: SyntaxTree.Scope;
  1305. BEGIN
  1306. prevScope := currentScope;
  1307. currentScope := x;
  1308. (* ASSERT(currentScope.outerScope = prevScope); (* sanity check *) *)
  1309. WITH x: SyntaxTree.CellScope DO
  1310. IF x.firstImport # NIL THEN ImportList(x.firstImport) END;
  1311. ELSE
  1312. END;
  1313. IF x.firstConstant # NIL THEN ConstantList(x.firstConstant); END;
  1314. IF x.firstTypeDeclaration # NIL THEN TypeDeclarationList(x.firstTypeDeclaration); END;
  1315. IF x.firstVariable # NIL THEN Indent; Keyword("VAR " ); VariableList(x.firstVariable); END;
  1316. IF x.procedures # NIL THEN w.Ln; ProcedureList(x.procedures) END;
  1317. currentScope := prevScope;
  1318. END Scope;
  1319. PROCEDURE ProcedureScope(x: SyntaxTree.ProcedureScope);
  1320. VAR prevScope: SyntaxTree.Scope;
  1321. BEGIN
  1322. prevScope := currentScope;
  1323. currentScope := x;
  1324. IF (mode >= SourceCode) OR (x.ownerProcedure.isInline) OR (x.ownerProcedure.isOberonInline) THEN
  1325. Scope(x);
  1326. END;
  1327. IF (mode >= SymbolFile) & (x.body # NIL) THEN Body(x.body, (mode >= SourceCode) OR (x.ownerProcedure.isInline) OR (x.ownerProcedure.isOberonInline) ) END;
  1328. currentScope := prevScope;
  1329. END ProcedureScope;
  1330. PROCEDURE Statement*(x: SyntaxTree.Statement);
  1331. BEGIN
  1332. IF x = NIL THEN
  1333. AlertString("nil statement")
  1334. ELSE
  1335. Comments(x.comment, x, FALSE);
  1336. x.Accept(SELF);
  1337. Comments(x.comment,x,TRUE);
  1338. END
  1339. END Statement;
  1340. PROCEDURE StatementSequence*(x: SyntaxTree.StatementSequence);
  1341. VAR statement: SyntaxTree.Statement; i: LONGINT;
  1342. BEGIN
  1343. IF singleStatement THEN
  1344. w.String("...")
  1345. ELSE
  1346. FOR i := 0 TO x.Length() - 1 DO
  1347. statement := x.GetStatement( i );
  1348. Indent; Statement(statement);
  1349. IF i < x.Length() - 1 THEN w.String( "; " ); END;
  1350. END;
  1351. END;
  1352. END StatementSequence;
  1353. PROCEDURE VisitStatement(x: SyntaxTree.Statement);
  1354. BEGIN
  1355. AlertString("InvalidStatement");
  1356. END VisitStatement;
  1357. PROCEDURE VisitProcedureCallStatement(x: SyntaxTree.ProcedureCallStatement);
  1358. BEGIN Expression(x.call) END VisitProcedureCallStatement;
  1359. PROCEDURE VisitAssignment(x: SyntaxTree.Assignment);
  1360. BEGIN
  1361. Expression(x.left); w.String( " := " ); Expression(x.right);
  1362. END VisitAssignment;
  1363. PROCEDURE VisitCommunicationStatement(x: SyntaxTree.CommunicationStatement);
  1364. VAR identifier: SyntaxTree.Identifier;
  1365. BEGIN
  1366. Expression(x.left);
  1367. identifier := Global.GetIdentifier(x.op,case);
  1368. w.String(" "); Identifier(identifier); w.String(" ");
  1369. Expression(x.right);
  1370. END VisitCommunicationStatement;
  1371. PROCEDURE IfPart(x: SyntaxTree.IfPart);
  1372. BEGIN
  1373. Comments(x.comment, x, FALSE);
  1374. Keyword("IF " );
  1375. Expression(x.condition);
  1376. Keyword(" THEN " );
  1377. Comments(x.comment,x,TRUE);
  1378. w.IncIndent;
  1379. StatementSequence(x.statements);
  1380. w.DecIndent;
  1381. END IfPart;
  1382. PROCEDURE VisitIfStatement(x: SyntaxTree.IfStatement);
  1383. VAR i: LONGINT; elsif: SyntaxTree.IfPart;
  1384. BEGIN
  1385. IfPart(x.ifPart);
  1386. FOR i := 0 TO x.ElsifParts() - 1 DO
  1387. elsif := x.GetElsifPart( i );
  1388. Indent; Keyword("ELS");
  1389. IfPart(elsif);
  1390. END;
  1391. IF x.elsePart # NIL THEN
  1392. Indent; Keyword("ELSE" );
  1393. w.IncIndent;
  1394. StatementSequence(x.elsePart);
  1395. w.DecIndent;
  1396. END;
  1397. Indent; Keyword("END" );
  1398. END VisitIfStatement;
  1399. PROCEDURE WithPart(x: SyntaxTree.WithPart);
  1400. BEGIN
  1401. Comments(x.comment, x, FALSE);
  1402. Expression(x.variable);
  1403. w.String(" : ");
  1404. Type(x.type);
  1405. Keyword(" DO " );
  1406. Comments(x.comment,x, TRUE);
  1407. w.IncIndent; StatementSequence(x.statements); w.DecIndent;
  1408. END WithPart;
  1409. PROCEDURE VisitWithStatement(x: SyntaxTree.WithStatement);
  1410. VAR i: LONGINT;
  1411. BEGIN
  1412. Indent; Keyword("WITH " );
  1413. WithPart(x.GetWithPart(0));
  1414. FOR i := 1 TO x.WithParts()-1 DO
  1415. Indent; w.String("| ");
  1416. WithPart(x.GetWithPart(i));
  1417. END;
  1418. IF x.elsePart # NIL THEN
  1419. Indent; w.String("ELSE ");
  1420. w.IncIndent; StatementSequence(x.elsePart); w.DecIndent;
  1421. END;
  1422. Indent; Keyword("END" );
  1423. END VisitWithStatement;
  1424. PROCEDURE CasePart(x: SyntaxTree.CasePart);
  1425. VAR case: SyntaxTree.CaseConstant;
  1426. BEGIN
  1427. Comments(x.comment, x, FALSE);
  1428. ExpressionList(x.elements);
  1429. IF info THEN
  1430. w.BeginComment;
  1431. case := x.firstConstant;
  1432. WHILE(case # NIL) DO
  1433. IF case # x.firstConstant THEN w.String(",") END;
  1434. w.Int(case.min,1); w.String(".."); w.Int(case.max,1);
  1435. case := case.next;
  1436. END;
  1437. EndComment;
  1438. END;
  1439. w.String( ":" );
  1440. Comments(x.comment,x,TRUE);
  1441. w.IncIndent; StatementSequence(x.statements); w.DecIndent;
  1442. END CasePart;
  1443. PROCEDURE VisitCaseStatement(x: SyntaxTree.CaseStatement);
  1444. VAR i: LONGINT; case: SyntaxTree.CasePart;
  1445. BEGIN
  1446. Keyword("CASE " );
  1447. Expression(x.variable);
  1448. Keyword(" OF " );
  1449. FOR i := 0 TO x.CaseParts() - 1 DO
  1450. case := x.GetCasePart( i );
  1451. Indent;
  1452. w.String( "| " );
  1453. CasePart(case);
  1454. END;
  1455. IF x.elsePart # NIL THEN
  1456. Indent;
  1457. Keyword("ELSE" );
  1458. w.IncIndent;
  1459. StatementSequence(x.elsePart);
  1460. w.DecIndent;
  1461. END;
  1462. Indent;
  1463. Keyword("END" );
  1464. END VisitCaseStatement;
  1465. PROCEDURE VisitWhileStatement(x: SyntaxTree.WhileStatement);
  1466. BEGIN
  1467. Keyword("WHILE " );
  1468. Expression(x.condition);
  1469. Keyword(" DO " );
  1470. w.IncIndent;
  1471. StatementSequence(x.statements);
  1472. w.DecIndent;
  1473. Indent;
  1474. Keyword("END" );
  1475. END VisitWhileStatement;
  1476. PROCEDURE VisitRepeatStatement(x: SyntaxTree.RepeatStatement);
  1477. BEGIN
  1478. Keyword("REPEAT " );
  1479. w.IncIndent;
  1480. StatementSequence(x.statements);
  1481. w.DecIndent;
  1482. Indent; Keyword("UNTIL " );
  1483. Expression(x.condition);
  1484. END VisitRepeatStatement;
  1485. PROCEDURE VisitForStatement(x: SyntaxTree.ForStatement);
  1486. BEGIN
  1487. Keyword("FOR " );
  1488. Expression(x.variable);
  1489. w.String( " := " );
  1490. Expression(x.from);
  1491. Keyword(" TO " );
  1492. Expression(x.to);
  1493. IF x.by # NIL THEN
  1494. Keyword(" BY " );
  1495. Expression(x.by);
  1496. END;
  1497. Keyword(" DO " );
  1498. w.IncIndent;
  1499. StatementSequence(x.statements);
  1500. w.DecIndent;
  1501. Indent;
  1502. Keyword("END" );
  1503. END VisitForStatement;
  1504. PROCEDURE VisitLoopStatement(x: SyntaxTree.LoopStatement);
  1505. BEGIN
  1506. Keyword("LOOP " );
  1507. w.IncIndent; StatementSequence(x.statements); w.DecIndent;
  1508. Indent; Keyword("END" );
  1509. END VisitLoopStatement;
  1510. PROCEDURE VisitExitableBlock(x: SyntaxTree.ExitableBlock);
  1511. BEGIN
  1512. Keyword("EXITABLE " );
  1513. w.IncIndent; StatementSequence(x.statements); w.DecIndent;
  1514. Indent; Keyword("END " );
  1515. END VisitExitableBlock;
  1516. PROCEDURE VisitExitStatement(x: SyntaxTree.ExitStatement);
  1517. BEGIN Keyword("EXIT" ) END VisitExitStatement;
  1518. PROCEDURE VisitReturnStatement(x: SyntaxTree.ReturnStatement);
  1519. BEGIN
  1520. Keyword("RETURN " );
  1521. IF x.returnValue # NIL THEN Expression(x.returnValue) END
  1522. END VisitReturnStatement;
  1523. PROCEDURE VisitAwaitStatement(x: SyntaxTree.AwaitStatement);
  1524. BEGIN
  1525. Keyword("AWAIT (" ); Expression(x.condition); w.String( ")" );
  1526. END VisitAwaitStatement;
  1527. PROCEDURE Modifiers(x: SyntaxTree.Modifier);
  1528. VAR name: Scanner.IdentifierString; first: BOOLEAN;
  1529. BEGIN
  1530. first := TRUE;
  1531. WHILE x # NIL DO
  1532. IF first THEN w.String("{"); first := FALSE ELSE w.String(", ") END;
  1533. Basic.GetString(x.identifier,name);
  1534. w.String(name);
  1535. IF x.expression # NIL THEN
  1536. w.String("(");
  1537. Expression(x.expression);
  1538. w.String(")");
  1539. END;
  1540. x := x.nextModifier;
  1541. END;
  1542. IF ~first THEN w.String("} ") END;
  1543. END Modifiers;
  1544. (*
  1545. PROCEDURE BlockModifier(x: SyntaxTree.StatementBlock);
  1546. VAR first: BOOLEAN;
  1547. PROCEDURE Comma;
  1548. BEGIN
  1549. IF first THEN first := FALSE ELSE w.String(", "); END;
  1550. END Comma;
  1551. BEGIN
  1552. first := TRUE;
  1553. IF x.flags # {} THEN
  1554. w.String("{");
  1555. IF SyntaxTree.ActiveFlag IN x.flags THEN Comma; w.String("ACTIVE") END;
  1556. IF SyntaxTree.PriorityFlag IN x.flags THEN Comma; w.String("PRIORITY("); Expression(x(SyntaxTree.Body).priority); w.String(")"); first := FALSE; END;
  1557. IF SyntaxTree.SafeFlag IN x.flags THEN Comma; w.String("SAFE") END;
  1558. IF SyntaxTree.ExclusiveFlag IN x.flags THEN Comma; w.String("EXCLUSIVE") END;
  1559. w.String("}");
  1560. END;
  1561. END BlockModifier;
  1562. *)
  1563. PROCEDURE VisitStatementBlock(x: SyntaxTree.StatementBlock);
  1564. BEGIN
  1565. Keyword("BEGIN"); Modifiers(x.blockModifiers);
  1566. w.IncIndent;
  1567. IF x.statements # NIL THEN StatementSequence(x.statements); END;
  1568. w.DecIndent;
  1569. Indent; Keyword("END");
  1570. END VisitStatementBlock;
  1571. PROCEDURE Code(x: SyntaxTree.Code);
  1572. VAR i: LONGINT; ch: CHAR; cr: BOOLEAN; procedure: SyntaxTree.Procedure; procedureType: SyntaxTree.ProcedureType;
  1573. CONST CR=0DX;
  1574. BEGIN
  1575. IF (currentScope # NIL) & (currentScope IS SyntaxTree.ProcedureScope) THEN
  1576. procedure := currentScope(SyntaxTree.ProcedureScope).ownerProcedure;
  1577. procedureType := procedure.type(SyntaxTree.ProcedureType);
  1578. END;
  1579. IF (mode >= SourceCode) OR (procedure = NIL) OR (procedure.access * SyntaxTree.Public # {}) & (procedure.isInline OR procedure.isOberonInline) THEN
  1580. (*
  1581. IF x.inlineCode # NIL THEN
  1582. unit := 8;
  1583. w.String(" D"); w.Int(unit,1);
  1584. i := 0; size := x.inlineCode.GetSize();
  1585. WHILE i < size DO
  1586. value := x.inlineCode.GetBits(i,unit);
  1587. w.String(" "); w.Int(value,1);
  1588. INC(i,unit);
  1589. END;
  1590. ELS*)
  1591. IF (x.sourceCode # NIL) THEN
  1592. i := 0;
  1593. ch := x.sourceCode[0];
  1594. WHILE (ch # 0X) DO
  1595. IF ch = CR THEN
  1596. cr := TRUE;
  1597. ELSE
  1598. IF cr THEN Indent; cr := FALSE END;
  1599. w.Char(ch);
  1600. END;
  1601. INC(i); ch := x.sourceCode[i];
  1602. END;
  1603. END;
  1604. (*
  1605. IF x.inlineCode # NIL THEN
  1606. w.String("; ");
  1607. size := x.inlineCode.GetSize() DIV 8;
  1608. FOR i := 0 TO size-1 DO
  1609. value := x.inlineCode.GetBits(i*8,8);
  1610. w.Hex(value,-2); w.String(" ");
  1611. END;
  1612. END;
  1613. *)
  1614. END;
  1615. END Code;
  1616. PROCEDURE VisitCode(x: SyntaxTree.Code);
  1617. VAR in, out: BOOLEAN;
  1618. BEGIN
  1619. Indent; Keyword("CODE");
  1620. Code(x);
  1621. in := x.inRules.Length()>0;
  1622. out := x.outRules.Length() >0;
  1623. IF in OR out THEN
  1624. Indent; Keyword("WITH ");
  1625. IF in THEN
  1626. Indent; Keyword("IN "); StatementSequence(x.inRules)
  1627. END;
  1628. IF out THEN
  1629. Indent; Keyword("OUT "); StatementSequence(x.outRules)
  1630. END;
  1631. END;
  1632. Indent; Keyword("END");
  1633. END VisitCode;
  1634. PROCEDURE Body(x: SyntaxTree.Body; implementation: BOOLEAN);
  1635. VAR
  1636. BEGIN
  1637. IF x.code # NIL THEN
  1638. Indent; Keyword("CODE");
  1639. IF implementation THEN
  1640. Code(x.code);
  1641. END;
  1642. ELSE
  1643. Indent; Keyword("BEGIN" ); Modifiers(x.blockModifiers);
  1644. IF implementation THEN
  1645. IF x.statements # NIL THEN
  1646. w.IncIndent;
  1647. StatementSequence(x.statements);
  1648. w.DecIndent;
  1649. END;
  1650. IF x.finally # NIL THEN
  1651. Indent; Keyword("FINALLY" );
  1652. w.IncIndent;
  1653. StatementSequence(x.finally);
  1654. w.DecIndent
  1655. END;
  1656. END;
  1657. END;
  1658. (* "END" written by caller *)
  1659. END Body;
  1660. PROCEDURE Module*(x: SyntaxTree.Module);
  1661. BEGIN
  1662. IF x = NIL THEN
  1663. AlertString("(* no module *)");
  1664. ELSE
  1665. case := x.case;
  1666. currentScope := x.moduleScope.outerScope;
  1667. Comments(x.comment,x,FALSE);
  1668. Keyword("MODULE ");
  1669. Identifier(x.name);
  1670. IF (x.context # SyntaxTree.invalidIdentifier) & (x.context#Global.A2Name) THEN
  1671. w.String(" IN ");
  1672. Identifier(x.context)
  1673. END;
  1674. IF (x.type IS SyntaxTree.CellType) & (x.type(SyntaxTree.CellType).firstParameter # NIL) THEN (* for actors *)
  1675. ParameterList(x.type(SyntaxTree.CellType).firstParameter);
  1676. END;
  1677. w.String(";");
  1678. Comments(x.comment,x,TRUE);
  1679. w.IncIndent;
  1680. IF x.moduleScope.firstImport # NIL THEN
  1681. ImportList(x.moduleScope.firstImport)
  1682. END;
  1683. w.DecIndent;
  1684. Scope(x.moduleScope);
  1685. IF x.moduleScope.firstBuiltin # NIL THEN
  1686. BuiltinList(x.moduleScope.firstBuiltin)
  1687. END;
  1688. IF (x.moduleScope.bodyProcedure # NIL) & (x.moduleScope.bodyProcedure.procedureScope.body # NIL) THEN
  1689. Body(x.moduleScope.bodyProcedure.procedureScope.body, mode >= SourceCode)
  1690. END;
  1691. Indent; Keyword("END "); Identifier(x.name); w.String( "." ); w.Ln; w.Update;
  1692. Comments(x.closingComment,x, FALSE);
  1693. IF (mode > SourceCode) & (x.moduleScope.firstComment # NIL) THEN w.Ln; CommentList(x.moduleScope.firstComment) END;
  1694. END
  1695. END Module;
  1696. PROCEDURE SingleStatement*(b: BOOLEAN);
  1697. BEGIN singleStatement := b
  1698. END SingleStatement;
  1699. PROCEDURE &Init*(w: Streams.Writer; mode: LONGINT; info: BOOLEAN);
  1700. BEGIN
  1701. SELF.w := Basic.GetWriter(w);
  1702. SELF.mode := mode; NEW(ws,128); SELF.info := info; case := Scanner.Uppercase;
  1703. commentCount := 0; alertCount := 0; singleStatement := FALSE;
  1704. END Init;
  1705. END Printer;
  1706. (* debugging helper *)
  1707. VAR
  1708. debug: Printer;
  1709. PROCEDURE NewPrinter*(w: Streams.Writer; mode: LONGINT; info: BOOLEAN): Printer;
  1710. VAR p: Printer;
  1711. BEGIN
  1712. NEW(p,w,mode,info); RETURN p
  1713. END NewPrinter;
  1714. PROCEDURE Info*(CONST info: ARRAY OF CHAR; a: ANY);
  1715. VAR symbol: SyntaxTree.Symbol; scope: SyntaxTree.Scope;
  1716. BEGIN
  1717. debug.w := Basic.GetWriter(D.Log);
  1718. D.Ln;
  1719. D.Str(" --------> ");
  1720. D.Str(info);
  1721. D.Str(" ");
  1722. D.Hex(SYSTEM.VAL(LONGINT,a),8);
  1723. D.Str(" : ");
  1724. IF a = NIL THEN
  1725. D.Str("NIL");
  1726. ELSIF a IS SyntaxTree.Expression THEN
  1727. debug.Expression(a(SyntaxTree.Expression));
  1728. Info("with type",a(SyntaxTree.Expression).type);
  1729. ELSIF a IS SyntaxTree.Type THEN
  1730. IF a IS SyntaxTree.QualifiedType THEN
  1731. D.Str("[QualifiedType] ");
  1732. END;
  1733. debug.Type(a(SyntaxTree.Type))
  1734. ELSIF a IS SyntaxTree.Symbol THEN
  1735. debug.Symbol(a(SyntaxTree.Symbol))
  1736. ELSIF a IS SyntaxTree.Statement THEN
  1737. debug.Statement(a(SyntaxTree.Statement))
  1738. ELSIF a IS SyntaxTree.StatementSequence THEN
  1739. debug.StatementSequence(a(SyntaxTree.StatementSequence));
  1740. ELSIF a IS SyntaxTree.Scope THEN
  1741. scope := a(SyntaxTree.Scope);
  1742. WHILE(scope # NIL) DO
  1743. D.Ln; D.Str(" ");
  1744. IF scope IS SyntaxTree.ModuleScope THEN D.Str("ModuleScope: ")
  1745. ELSIF scope IS SyntaxTree.ProcedureScope THEN D.Str("ProcedureScope: ");
  1746. ELSIF scope IS SyntaxTree.RecordScope THEN D.Str("RecordScope: ");
  1747. ELSE D.Str("Scope: ");
  1748. END;
  1749. symbol := scope.firstSymbol;
  1750. WHILE(symbol # NIL) DO
  1751. debug.Identifier(symbol.name); D.Str(" ");
  1752. symbol := symbol.nextSymbol;
  1753. END;
  1754. scope := scope.outerScope;
  1755. END;
  1756. (*
  1757. ELSIF a IS SyntaxTree.Identifier THEN
  1758. debug.Identifier(a(SyntaxTree.Identifier));
  1759. *)
  1760. ELSIF a IS SyntaxTree.QualifiedIdentifier THEN
  1761. debug.QualifiedIdentifier(a(SyntaxTree.QualifiedIdentifier));
  1762. ELSIF a IS SyntaxTree.Module THEN
  1763. debug.Module(a(SyntaxTree.Module))
  1764. ELSE
  1765. debug.w.String("unknown");
  1766. END;
  1767. D.Update();
  1768. END Info;
  1769. PROCEDURE Init;
  1770. BEGIN
  1771. NEW(debug,D.Log,All,TRUE);
  1772. debug.case := Scanner.Uppercase;
  1773. END Init;
  1774. BEGIN
  1775. Init;
  1776. END FoxPrintout.