JavaUtil.cp 78 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387
  1. (* ============================================================ *)
  2. (* JavaUtil is the module which writes java classs file *)
  3. (* structures *)
  4. (* Copyright (c) John Gough 1999, 2000. *)
  5. (* Modified DWC September, 2000. *)
  6. (* ============================================================ *)
  7. MODULE JavaUtil;
  8. IMPORT
  9. GPCPcopyright,
  10. RTS,
  11. Console,
  12. JavaBase,
  13. Hsh := NameHash,
  14. CSt := CompState,
  15. Psr := CPascalP,
  16. Jvm := JVMcodes,
  17. Sym := Symbols,
  18. Blt := Builtin,
  19. Id := IdDesc,
  20. Xp := ExprDesc,
  21. Ty := TypeDesc,
  22. St := StatDesc,
  23. L := LitValue;
  24. (* ============================================================ *)
  25. CONST
  26. initStr* = "<init>";
  27. classPrefix* = "CP";
  28. retMarker* = -1; (* ==> out param is func-return *)
  29. StrCmp* = 1; (* indexes for rts procs *)
  30. StrToChrOpen* = 2;
  31. StrToChrs* = 3;
  32. ChrsToStr* = 4;
  33. StrCheck* = 5;
  34. StrLen* = 6;
  35. ToUpper* = 7;
  36. DFloor* = 8;
  37. ModI* = 9;
  38. ModL* = 10;
  39. DivI* = 11;
  40. DivL* = 12;
  41. StrCatAA* = 13;
  42. StrCatSA* = 14;
  43. StrCatAS* = 15;
  44. StrCatSS* = 16;
  45. StrLP1* = 17;
  46. StrVal* = 18;
  47. SysExit* = 19;
  48. LoadTp1* = 20; (* getClassByOrd *)
  49. LoadTp2* = 21; (* getClassByName *)
  50. GetTpM* = 22;
  51. (* ============================================================ *)
  52. CONST (* Label attributes *)
  53. unfixed* = 0; (* attr can be unfixed or posFixed *)
  54. posFixed* = 1;
  55. forceEmit* = 2; (* label is emitted, even if ~jumpSeen *)
  56. forceEmpty* = 3;
  57. assertEmpty* = 4;
  58. jumpSeen* = 5;
  59. (* ============================================================ *)
  60. TYPE JavaFile* = POINTER TO ABSTRACT RECORD
  61. theP* : Id.Procs;
  62. END;
  63. (* ============================================================ *)
  64. TYPE Label* = POINTER TO EXTENSIBLE RECORD
  65. defIx* : INTEGER;
  66. attr* : SET;
  67. END;
  68. (* ============================================================ *)
  69. VAR
  70. typeRetn- : ARRAY 16 OF INTEGER;
  71. typeLoad- : ARRAY 16 OF INTEGER;
  72. typeStore- : ARRAY 16 OF INTEGER;
  73. typePutE- : ARRAY 16 OF INTEGER;
  74. typeGetE- : ARRAY 16 OF INTEGER;
  75. VAR nmArray* : L.CharOpenSeq;
  76. fmArray* : L.CharOpenSeq;
  77. VAR semi-,comma-,colon-,lPar-,rPar-,rParV-,
  78. brac-,lCap-, void-,lowL-,dlar-,slsh-,prfx- : L.CharOpen;
  79. (* ============================================================ *)
  80. VAR xhrIx : INTEGER;
  81. xhrDl : L.CharOpen;
  82. xhrMk : L.CharOpen;
  83. xhrPtr : Sym.Type; (* = CSt.rtsXHR *)
  84. xhrRec : Ty.Record; (* = xhrPtr.boundRecTp() *)
  85. VAR invokeHash : INTEGER;
  86. ptvIx : INTEGER; (* Index number for procedure type literals *)
  87. procLitPrefix : L.CharOpen;
  88. (* ============================================================ *)
  89. VAR boxTp : ARRAY Ty.metaN + 1 OF Sym.Type;
  90. (* ============================================================ *)
  91. VAR vecBlkId : Id.BlkId;
  92. vecBase : Id.TypId;
  93. vecTypes : ARRAY Ty.anyPtr+1 OF Id.TypId;
  94. vecTide : Id.FldId;
  95. vecElms : ARRAY Ty.anyPtr+1 OF Id.FldId;
  96. vecExpnd : ARRAY Ty.anyPtr+1 OF Id.MthId;
  97. (* ============================================================ *)
  98. PROCEDURE (lb : Label)Str*() : L.CharOpen,NEW,EXTENSIBLE;
  99. BEGIN RETURN BOX("?") END Str;
  100. PROCEDURE (lb : Label)JumpSeen*() : BOOLEAN,NEW;
  101. BEGIN RETURN jumpSeen IN lb.attr END JumpSeen;
  102. PROCEDURE (jf : JavaFile)StartModClass*(mod : Id.BlkId),NEW,ABSTRACT;
  103. PROCEDURE (jf : JavaFile)StartRecClass*(rec : Ty.Record),NEW,ABSTRACT;
  104. PROCEDURE (jf : JavaFile)StartProc*(proc : Id.Procs),NEW,ABSTRACT;
  105. PROCEDURE (jf : JavaFile)EndProc*(),NEW,EMPTY;
  106. PROCEDURE (jf : JavaFile)isAbstract*():BOOLEAN,NEW,ABSTRACT;
  107. PROCEDURE (jf : JavaFile)getScope*():Sym.Scope,NEW,ABSTRACT;
  108. PROCEDURE (jf : JavaFile) EmitField*(field : Id.AbVar),NEW,ABSTRACT;
  109. PROCEDURE (jf : JavaFile)MkNewRecord*(typ : Ty.Record),NEW,ABSTRACT;
  110. PROCEDURE (jf : JavaFile)MkNewFixedArray*(topE : Sym.Type;
  111. len0 : INTEGER),NEW,ABSTRACT;
  112. PROCEDURE (jf : JavaFile)MkNewOpenArray*(arrT : Ty.Array;
  113. dims : INTEGER),NEW,ABSTRACT;
  114. PROCEDURE (jf : JavaFile)MkArrayCopy*(arrT : Ty.Array),NEW,ABSTRACT;
  115. (*
  116. * Managing temporary variable allocations. As of version
  117. * 1.4.01 release of locals is strictly first-in, first-out.
  118. * The new*Local methods return an integer, since the code
  119. * generator needs to refer to the local by index. However
  120. * the old ReleaseLocal( i ) method is replaced by no-arg Pop()
  121. *)
  122. PROCEDURE (jf : JavaFile)newLocal*( type : Sym.Type ) : INTEGER,NEW,ABSTRACT;
  123. PROCEDURE (jf : JavaFile)newLongLocal*( type : Sym.Type ) : INTEGER,NEW,ABSTRACT;
  124. PROCEDURE (jf : JavaFile)PopLocal*(),NEW,ABSTRACT;
  125. PROCEDURE (jf : JavaFile)PopLongLocal*(),NEW,ABSTRACT;
  126. PROCEDURE (jf : JavaFile)ReleaseAll*(m : INTEGER),NEW,ABSTRACT;
  127. PROCEDURE (jf : JavaFile)markTop*() : INTEGER,NEW,ABSTRACT;
  128. PROCEDURE (jf : JavaFile)getDepth*() : INTEGER,NEW,ABSTRACT;
  129. PROCEDURE (jf : JavaFile)setDepth*(i : INTEGER),NEW,ABSTRACT;
  130. PROCEDURE (jf : JavaFile)newLabel*() : Label,NEW,ABSTRACT;
  131. PROCEDURE (jf : JavaFile)getLabelRange*(VAR labs:ARRAY OF Label),NEW,ABSTRACT;
  132. PROCEDURE (jf : JavaFile)AddSwitchLab*(lab : Label;
  133. pos : INTEGER),NEW,ABSTRACT;
  134. (*
  135. * Emitters which create stack frames can be simpler if it is
  136. * known that certain labels always have an empty eval stack.
  137. *)
  138. PROCEDURE (jf : JavaFile)newEmptystackLabel*() : Label,NEW,EXTENSIBLE;
  139. BEGIN
  140. RETURN jf.newLabel();
  141. END newEmptystackLabel;
  142. PROCEDURE (jf : JavaFile)newLoopheaderLabel*() : Label,NEW,EXTENSIBLE;
  143. BEGIN
  144. RETURN jf.newLabel();
  145. END newLoopheaderLabel;
  146. PROCEDURE (jf : JavaFile)LoadLocal*(ord : INTEGER; typ : Sym.Type),NEW,ABSTRACT;
  147. PROCEDURE (jf : JavaFile)StoreLocal*(ord : INTEGER; typ : Sym.Type),NEW,ABSTRACT;
  148. PROCEDURE (jf : JavaFile)Comment*(IN msg : ARRAY OF CHAR),NEW,EMPTY;
  149. PROCEDURE (jf : JavaFile)Header*(IN str : ARRAY OF CHAR),NEW,EMPTY;
  150. PROCEDURE (jf : JavaFile)Code*(code : INTEGER),NEW,ABSTRACT;
  151. PROCEDURE (jf : JavaFile)CodeI*(code,val : INTEGER),NEW,ABSTRACT;
  152. PROCEDURE (jf : JavaFile)CodeL*(code : INTEGER; num : LONGINT),NEW,ABSTRACT;
  153. PROCEDURE (jf : JavaFile)CodeC*(code : INTEGER;
  154. IN str : ARRAY OF CHAR),NEW,ABSTRACT;
  155. PROCEDURE (jf : JavaFile)CodeR*(code : INTEGER;
  156. num : REAL; short : BOOLEAN),NEW,ABSTRACT;
  157. PROCEDURE (jf : JavaFile)CodeLb*(code : INTEGER; lab : Label),NEW,ABSTRACT;
  158. PROCEDURE (jf : JavaFile)LstDef*(l : Label),NEW,EMPTY;
  159. PROCEDURE (jf : JavaFile)DefLab*(lab : Label),NEW,ABSTRACT;
  160. PROCEDURE (jf : JavaFile)DefLabC*(lab : Label;
  161. IN c : ARRAY OF CHAR),NEW,ABSTRACT;
  162. PROCEDURE (jf : JavaFile)CodeInc*(localIx,incVal : INTEGER),NEW,ABSTRACT;
  163. PROCEDURE (jf : JavaFile)CodeT*(code : INTEGER; ty : Sym.Type),NEW,ABSTRACT;
  164. PROCEDURE (jf : JavaFile)CodeSwitch*(low,high : INTEGER;
  165. defLab : Label),NEW,ABSTRACT;
  166. PROCEDURE (jf : JavaFile)CodeSwitchEnd*(low,high : INTEGER;
  167. defLab : Label),NEW,EMPTY;
  168. PROCEDURE (jf : JavaFile)PushStr*(IN str : L.CharOpen),NEW,ABSTRACT;
  169. PROCEDURE (jf : JavaFile)LoadConst*(num : INTEGER),NEW,ABSTRACT;
  170. PROCEDURE (jf : JavaFile)CallGetClass*(),NEW,ABSTRACT;
  171. PROCEDURE (jf : JavaFile)CallRTS*(ix,args,ret : INTEGER),NEW,ABSTRACT;
  172. PROCEDURE (jf : JavaFile)CallIT*(code : INTEGER;
  173. proc : Id.Procs;
  174. type : Ty.Procedure),NEW,ABSTRACT;
  175. PROCEDURE (jf : JavaFile)ClinitHead*(),NEW,ABSTRACT;
  176. PROCEDURE (jf : JavaFile)MainHead*(),NEW,ABSTRACT;
  177. PROCEDURE (jf : JavaFile)VoidTail*(),NEW,ABSTRACT;
  178. PROCEDURE (jf : JavaFile)ModNoArgInit*(),NEW,ABSTRACT;
  179. PROCEDURE (jf : JavaFile)RecMakeInit*(rec : Ty.Record;
  180. prc : Id.PrcId),NEW,ABSTRACT;
  181. PROCEDURE (jf : JavaFile)CallSuperCtor*(rec : Ty.Record;
  182. pTy : Ty.Procedure),NEW,ABSTRACT;
  183. PROCEDURE (jf : JavaFile)CopyProcHead*(rec : Ty.Record),NEW,ABSTRACT;
  184. PROCEDURE (jf : JavaFile)ValRecCopy*(typ : Ty.Record),NEW,ABSTRACT;
  185. PROCEDURE (jf : JavaFile)InitFields*(num : INTEGER),NEW,EMPTY;
  186. PROCEDURE (jf : JavaFile)InitMethods*(num : INTEGER),NEW,EMPTY;
  187. PROCEDURE (jf : JavaFile)Try*(),NEW,ABSTRACT;
  188. PROCEDURE (jf : JavaFile)Catch*(prc : Id.Procs),NEW,ABSTRACT;
  189. PROCEDURE (jf : JavaFile)MkNewException*(),NEW,ABSTRACT;
  190. PROCEDURE (jf : JavaFile)InitException*(),NEW,ABSTRACT;
  191. PROCEDURE (jf : JavaFile)Dump*(),NEW,ABSTRACT;
  192. (* ============================================================ *)
  193. PROCEDURE (jf : JavaFile)PutGetS*(code : INTEGER; (* static field *)
  194. blk : Id.BlkId;
  195. fld : Id.VarId),NEW,ABSTRACT;
  196. PROCEDURE (jf : JavaFile)PutGetF*(code : INTEGER; (* instance field *)
  197. rec : Ty.Record;
  198. fld : Id.AbVar),NEW,ABSTRACT;
  199. (* ============================================================ *)
  200. PROCEDURE (jf : JavaFile)Alloc1d*(elTp : Sym.Type),NEW,ABSTRACT;
  201. PROCEDURE (jf : JavaFile)VarInit*(var : Sym.Idnt),NEW,ABSTRACT;
  202. PROCEDURE (jf : JavaFile)Trap*(IN str : ARRAY OF CHAR),NEW,ABSTRACT;
  203. PROCEDURE (jf : JavaFile)CaseTrap*(i : INTEGER),NEW,ABSTRACT;
  204. PROCEDURE (jf : JavaFile)WithTrap*(id : Sym.Idnt),NEW,ABSTRACT;
  205. PROCEDURE (jf : JavaFile)Line*(nm : INTEGER),NEW,ABSTRACT;
  206. (* ============================================================ *)
  207. (* Some XHR utilities *)
  208. (* ============================================================ *)
  209. PROCEDURE^ (jf : JavaFile)PutUplevel*(var : Id.LocId),NEW;
  210. PROCEDURE^ (jf : JavaFile)GetUplevel*(var : Id.LocId),NEW;
  211. PROCEDURE^ (jf : JavaFile)PushInt*(num : INTEGER),NEW;
  212. PROCEDURE^ (jf : JavaFile)PutElement*(typ : Sym.Type),NEW;
  213. PROCEDURE^ (jf : JavaFile)GetElement*(typ : Sym.Type),NEW;
  214. PROCEDURE^ (jf : JavaFile)ConvertDn*(inT, outT : Sym.Type),NEW;
  215. PROCEDURE^ cat2*(i,j : L.CharOpen) : L.CharOpen;
  216. PROCEDURE^ MkVecName*(typ : Ty.Vector);
  217. PROCEDURE^ MkProcTypeName*(typ : Ty.Procedure);
  218. PROCEDURE^ MkRecName*(typ : Ty.Record);
  219. PROCEDURE^ MkProcName*(proc : Id.Procs);
  220. PROCEDURE^ NumberParams(pIdn : Id.Procs; pTyp : Ty.Procedure);
  221. PROCEDURE^ typeToChOpen(typ : Sym.Type) : L.CharOpen;
  222. (* ============================================================ *)
  223. PROCEDURE DiagS*(IN s : ARRAY OF CHAR);
  224. BEGIN
  225. Console.WriteString(s); Console.WriteLn;
  226. END DiagS;
  227. PROCEDURE DiagSI*(IN s : ARRAY OF CHAR; n : INTEGER);
  228. BEGIN
  229. Console.WriteString(s); Console.WriteInt(n,0); Console.WriteLn;
  230. END DiagSI;
  231. PROCEDURE DiagSS*(IN p : ARRAY OF CHAR; IN s : ARRAY OF CHAR);
  232. BEGIN
  233. Console.WriteString(p); Console.WriteString(s); Console.WriteLn;
  234. END DiagSS;
  235. (* ============================================================ *)
  236. PROCEDURE i2CO*( i : INTEGER ) : L.CharOpen;
  237. VAR cArr : ARRAY 16 OF CHAR;
  238. BEGIN
  239. RTS.IntToStr( i, cArr );
  240. RETURN BOX(cArr);
  241. END i2CO;
  242. PROCEDURE b2CO*( i : BOOLEAN ) : L.CharOpen;
  243. VAR cArr : ARRAY 16 OF CHAR;
  244. BEGIN
  245. IF i THEN RETURN BOX("TRUE") ELSE RETURN BOX("FALSE") END;
  246. END b2CO;
  247. PROCEDURE k2CO*( k : INTEGER ) : L.CharOpen;
  248. VAR cArr : ARRAY 8 OF CHAR;
  249. BEGIN
  250. CASE k OF
  251. | St.emptyS : cArr := "Empty";
  252. | St.assignS : cArr := "Assign";
  253. | St.procCall : cArr := "Call";
  254. | St.ifStat : cArr := "IF";
  255. | St.caseS : cArr := "CASE";
  256. | St.whileS : cArr := "WHILE";
  257. | St.repeatS : cArr := "REPEAT";
  258. | St.forStat : cArr := "FOR";
  259. | St.loopS : cArr := "LOOP";
  260. | St.withS : cArr := "WITH";
  261. | St.exitS : cArr := "EXIT";
  262. | St.returnS : cArr := "RETURN";
  263. | St.blockS : cArr := "Block";
  264. END;
  265. RETURN BOX( cArr );
  266. END k2CO;
  267. (* ============================================================ *)
  268. PROCEDURE (jf : JavaFile)AloadLocal*(ord : INTEGER;
  269. typ : Sym.Type),NEW,EXTENSIBLE;
  270. (* typ is only required for back-ends generating StackFrames *)
  271. BEGIN
  272. IF ord < 4 THEN
  273. jf.Code( Jvm.opc_aload_0 + ord );
  274. ELSE
  275. jf.CodeI( Jvm.opc_aload, ord );
  276. END;
  277. END AloadLocal;
  278. (* ============================================================ *)
  279. PROCEDURE xhrCount(tgt, ths : Id.Procs) : INTEGER;
  280. VAR count : INTEGER;
  281. BEGIN
  282. IF ths.lxDepth = 0 THEN RETURN 0 END;
  283. (*
  284. * "ths" is the calling procedure.
  285. * "tgt" is the procedure with the uplevel data.
  286. *)
  287. count := 0;
  288. REPEAT
  289. ths := ths.dfScp(Id.Procs);
  290. IF Id.hasXHR IN ths.pAttr THEN INC(count) END;
  291. UNTIL (ths.lxDepth = 0) OR
  292. ((ths.lxDepth <= tgt.lxDepth) & (Id.hasXHR IN ths.pAttr));
  293. RETURN count;
  294. END xhrCount;
  295. (* ============================================================ *)
  296. (* Generate a new XHR record name, unique within this module *)
  297. (* ============================================================ *)
  298. PROCEDURE newXHR() : L.CharOpen;
  299. BEGIN
  300. INC(xhrIx);
  301. RETURN cat2(xhrDl, L.intToCharOpen(xhrIx));
  302. END newXHR;
  303. (* ============================================================ *)
  304. (* Generate XHR class for this proc, chained to uplevel XHRs *)
  305. (* ============================================================ *)
  306. PROCEDURE MkXHR(scp : Id.Procs);
  307. VAR typId : Id.TypId;
  308. recTp : Ty.Record;
  309. index : INTEGER;
  310. locVr : Id.LocId;
  311. fldVr : Id.FldId;
  312. BEGIN
  313. Blt.MkDummyClass(newXHR(), CSt.thisMod, Ty.noAtt, typId);
  314. typId.SetMode(Sym.prvMode);
  315. scp.xhrType := typId.type;
  316. recTp := typId.type.boundRecTp()(Ty.Record);
  317. recTp.baseTp := xhrRec;
  318. INCL(recTp.xAttr, Sym.noCpy);
  319. FOR index := 0 TO scp.locals.tide-1 DO
  320. locVr := scp.locals.a[index](Id.LocId);
  321. IF Id.uplevA IN locVr.locAtt THEN
  322. fldVr := Id.newFldId();
  323. fldVr.hash := locVr.hash;
  324. fldVr.type := locVr.type;
  325. fldVr.recTyp := recTp;
  326. fldVr.fldNm := Sym.getName.ChPtr( locVr );
  327. Sym.AppendIdnt(recTp.fields, fldVr);
  328. END;
  329. END;
  330. END MkXHR;
  331. (* ============================================================ *)
  332. (* Some vector utilities *)
  333. (* ============================================================ *)
  334. (* -------------------------------------------------- *)
  335. (* Map vector element type to host-ord, taking into *)
  336. (* account the type erasure for all non-basic types. *)
  337. (* -------------------------------------------------- *)
  338. PROCEDURE mapVecElTp(typ : Sym.Type) : INTEGER;
  339. BEGIN
  340. WITH typ : Ty.Base DO
  341. CASE typ.tpOrd OF
  342. | Ty.sChrN : RETURN Ty.charN;
  343. | Ty.boolN, Ty.byteN, Ty.sIntN, Ty.setN, Ty.uBytN : RETURN Ty.intN;
  344. | Ty.charN, Ty.intN, Ty.lIntN, Ty.sReaN, Ty.realN : RETURN typ.tpOrd;
  345. ELSE RETURN Ty.anyPtr;
  346. END;
  347. ELSE RETURN Ty.anyPtr;
  348. END;
  349. END mapVecElTp;
  350. (* -------------------------------------------------- *)
  351. (* Map vector host-ord to host type, *)
  352. (* pseudo-inverse of mapVecElTp() *)
  353. (* -------------------------------------------------- *)
  354. PROCEDURE mapOrdRepT(ord : INTEGER) : Sym.Type;
  355. BEGIN
  356. CASE ord OF
  357. | Ty.charN : RETURN Blt.charTp;
  358. | Ty.intN : RETURN Blt.intTp;
  359. | Ty.lIntN : RETURN Blt.lIntTp;
  360. | Ty.sReaN : RETURN Blt.sReaTp;
  361. | Ty.realN : RETURN Blt.realTp;
  362. | Ty.anyPtr : RETURN Blt.anyPtr;
  363. END;
  364. END mapOrdRepT;
  365. (* ------------------------------------------------------------ *)
  366. PROCEDURE InitVecDescriptors;
  367. VAR i : INTEGER;
  368. BEGIN
  369. vecBlkId := NIL;
  370. vecBase := NIL;
  371. vecTide := NIL;
  372. FOR i := 0 TO Ty.anyPtr DO
  373. vecTypes[i] := NIL;
  374. vecElms[i] := NIL;
  375. vecExpnd[i] := NIL;
  376. END;
  377. END InitVecDescriptors;
  378. PROCEDURE vecModId() : Id.BlkId;
  379. BEGIN
  380. IF vecBlkId = NIL THEN
  381. Blt.MkDummyImport("$CPJvec$", "CP.CPJvec", vecBlkId);
  382. Blt.MkDummyClass("VecBase", vecBlkId, Ty.noAtt, vecBase);
  383. (*
  384. * Initialize vecTide while we are at it ...
  385. *)
  386. vecTide := Id.newFldId();
  387. vecTide.hash := Hsh.enterStr("tide");
  388. vecTide.fldNm := BOX("tide");
  389. vecTide.dfScp := vecBlkId;
  390. vecTide.recTyp := vecBase.type.boundRecTp();
  391. vecTide.type := Blt.intTp;
  392. MkRecName(vecTide.recTyp(Ty.Record));
  393. END;
  394. RETURN vecBlkId;
  395. END vecModId;
  396. PROCEDURE vecClsTyId(ord : INTEGER) : Id.TypId;
  397. VAR str : ARRAY 8 OF CHAR;
  398. tId : Id.TypId;
  399. rcT : Ty.Record;
  400. BEGIN
  401. IF vecTypes[ord] = NIL THEN
  402. CASE ord OF
  403. | Ty.charN : str := "VecChr";
  404. | Ty.intN : str := "VecI32";
  405. | Ty.lIntN : str := "VecI64";
  406. | Ty.sReaN : str := "VecR32";
  407. | Ty.realN : str := "VecR64";
  408. | Ty.anyPtr : str := "VecRef";
  409. END;
  410. Blt.MkDummyClass(str, vecModId(), Ty.noAtt, tId);
  411. rcT := tId.type.boundRecTp()(Ty.Record);
  412. rcT.baseTp := vecTide.recTyp;
  413. vecTypes[ord] := tId;
  414. END;
  415. RETURN vecTypes[ord];
  416. END vecClsTyId;
  417. PROCEDURE vecRecTyp(ord : INTEGER) : Ty.Record;
  418. BEGIN
  419. RETURN vecClsTyId(ord).type.boundRecTp()(Ty.Record);
  420. END vecRecTyp;
  421. PROCEDURE vecArrFldId(ord : INTEGER) : Id.FldId;
  422. VAR fld : Id.FldId;
  423. BEGIN
  424. IF vecElms[ord] = NIL THEN
  425. fld := Id.newFldId();
  426. fld.hash := Hsh.enterStr("elms");
  427. fld.fldNm := BOX("elms");
  428. fld.dfScp := vecModId();
  429. fld.recTyp := vecRecTyp(ord);
  430. fld.type := Ty.mkArrayOf(mapOrdRepT(ord));
  431. vecElms[ord] := fld;
  432. END;
  433. RETURN vecElms[ord];
  434. END vecArrFldId;
  435. (* ------------------------------------------------------------ *)
  436. PROCEDURE (jf : JavaFile)MkVecRec*(elTp : Sym.Type),NEW;
  437. VAR ord : INTEGER;
  438. BEGIN
  439. ord := mapVecElTp(elTp);
  440. jf.MkNewRecord(vecRecTyp(ord));
  441. END MkVecRec;
  442. (* ------------------------------- *)
  443. PROCEDURE (jf : JavaFile)MkVecArr*(eTp : Sym.Type),NEW;
  444. VAR ord : INTEGER;
  445. vTp : Sym.Type;
  446. BEGIN
  447. ord := mapVecElTp(eTp);
  448. jf.Alloc1d(mapOrdRepT(ord));
  449. jf.PutGetF(Jvm.opc_putfield, vecRecTyp(ord), vecArrFldId(ord));
  450. END MkVecArr;
  451. (* ------------------------------------------------------------ *)
  452. PROCEDURE (jf : JavaFile)GetVecArr*(eTp : Sym.Type),NEW;
  453. VAR ord : INTEGER;
  454. fId : Id.FldId;
  455. BEGIN
  456. ord := mapVecElTp(eTp);
  457. fId := vecArrFldId(ord);
  458. jf.PutGetF(Jvm.opc_getfield, fId.recTyp(Ty.Record), fId);
  459. END GetVecArr;
  460. (* ------------------------------- *)
  461. PROCEDURE (jf : JavaFile)GetVecLen*(),NEW;
  462. BEGIN
  463. jf.PutGetF(Jvm.opc_getfield, vecTide.recTyp(Ty.Record), vecTide);
  464. END GetVecLen;
  465. (* ------------------------------- *)
  466. PROCEDURE (jf : JavaFile)PutVecLen*(),NEW;
  467. BEGIN
  468. jf.PutGetF(Jvm.opc_putfield, vecTide.recTyp(Ty.Record), vecTide);
  469. END PutVecLen;
  470. (* ------------------------------- *)
  471. PROCEDURE (jf : JavaFile)InvokeExpand*(eTp : Sym.Type),NEW;
  472. VAR ord : INTEGER;
  473. mth : Id.MthId;
  474. typ : Ty.Procedure;
  475. BEGIN
  476. ord := mapVecElTp(eTp);
  477. IF vecExpnd[ord] = NIL THEN
  478. mth := Id.newMthId();
  479. mth.hash := Blt.xpndBk;
  480. mth.dfScp := vecModId();
  481. typ := Ty.newPrcTp();
  482. typ.idnt := mth;
  483. typ.receiver := vecClsTyId(ord).type;
  484. mth.bndType := typ.receiver.boundRecTp();
  485. MkProcName(mth);
  486. NumberParams(mth, typ);
  487. mth.type := typ;
  488. vecExpnd[ord] := mth;
  489. ELSE
  490. mth := vecExpnd[ord];
  491. typ := mth.type(Ty.Procedure);
  492. END;
  493. jf.CallIT(Jvm.opc_invokevirtual, mth, typ);
  494. END InvokeExpand;
  495. (* ------------------------------- *)
  496. PROCEDURE (jf : JavaFile)PutVecElement*(eTp : Sym.Type),NEW;
  497. BEGIN
  498. jf.PutElement(mapOrdRepT(mapVecElTp(eTp)));
  499. END PutVecElement;
  500. (* ------------------------------- *)
  501. PROCEDURE (jf : JavaFile)GetVecElement*(eTp : Sym.Type),NEW;
  502. VAR rTp : Sym.Type; (* representation type *)
  503. BEGIN
  504. rTp := mapOrdRepT(mapVecElTp(eTp));
  505. (*
  506. * If rTp and eTp are not equal, then must restore erased type
  507. *)
  508. jf.GetElement(rTp);
  509. IF rTp # eTp THEN
  510. IF rTp = Blt.anyPtr THEN
  511. jf.CodeT(Jvm.opc_checkcast, eTp);
  512. ELSE
  513. jf.ConvertDn(rTp, eTp);
  514. END;
  515. END;
  516. END GetVecElement;
  517. (* ============================================================ *)
  518. (* Some static utilities *)
  519. (* ============================================================ *)
  520. PROCEDURE jvmSize*(t : Sym.Type) : INTEGER;
  521. BEGIN
  522. IF t.isLongType() THEN RETURN 2 ELSE RETURN 1 END;
  523. END jvmSize;
  524. (* ------------------------------------------------------------ *)
  525. PROCEDURE newAnonLit() : L.CharOpen;
  526. BEGIN
  527. INC(ptvIx);
  528. RETURN cat2(procLitPrefix, L.intToCharOpen(ptvIx));
  529. END newAnonLit;
  530. (* ------------------------------------------------------------ *)
  531. PROCEDURE needsBox*(i : Id.ParId) : BOOLEAN;
  532. (* A parameter needs to be boxed if it has non-reference *)
  533. (* representation in the JVM, and is OUT or VAR mode. *)
  534. BEGIN
  535. (* EXPERIMENTAL, 26-Oct-2016 *)
  536. IF i.type IS Ty.Opaque THEN i.type := i.type(Ty.Opaque).resolved END;
  537. RETURN ((i.parMod = Sym.var) OR (i.parMod = Sym.out)) &
  538. i.type.isScalarType();
  539. END needsBox;
  540. PROCEDURE EnsureTypName( typ : Sym.Type );
  541. BEGIN
  542. IF typ.xName # NIL THEN RETURN END;
  543. WITH typ : Ty.Record DO
  544. MkRecName( typ );
  545. | typ : Ty.Vector DO
  546. MkVecName( typ );
  547. | typ : Ty.Array DO
  548. EnsureTypName( typ.elemTp );
  549. typ.xName := cat2( brac, typ.elemTp.xName );
  550. | typ : Ty.Pointer DO
  551. EnsureTypName( typ.boundTp );
  552. typ.xName := typ.boundTp.xName;
  553. | typ : Ty.Procedure DO
  554. MkProcTypeName( typ );
  555. | typ : Ty.Opaque DO
  556. typ.xName := typ.resolved.xName;
  557. ELSE
  558. THROW( "Can't make TypName" );
  559. END;
  560. END EnsureTypName;
  561. PROCEDURE TypeOfBox*(t : Sym.Type) : Sym.Type;
  562. BEGIN
  563. WITH t : Ty.Base DO
  564. RETURN boxTp[ t.tpOrd ];
  565. | t : Ty.Pointer DO
  566. (* could memoize these values ... in t.tgXtn? *)
  567. RETURN Ty.mkArrayOf( t );
  568. | t : Ty.Opaque DO
  569. RETURN TypeOfBox(t.resolved);
  570. ELSE
  571. EnsureTypName( t );
  572. THROW ( "TypeOfBox of non-base type: " + t.xName^ );
  573. END;
  574. END TypeOfBox;
  575. (* ============================================================ *)
  576. PROCEDURE cat2*(i,j : L.CharOpen) : L.CharOpen;
  577. BEGIN
  578. L.ResetCharOpenSeq(nmArray);
  579. L.AppendCharOpen(nmArray, i);
  580. L.AppendCharOpen(nmArray, j);
  581. RETURN L.arrayCat(nmArray);
  582. END cat2;
  583. PROCEDURE cat3*(i,j,k : L.CharOpen) : L.CharOpen;
  584. BEGIN
  585. L.ResetCharOpenSeq(nmArray);
  586. L.AppendCharOpen(nmArray, i);
  587. L.AppendCharOpen(nmArray, j);
  588. L.AppendCharOpen(nmArray, k);
  589. RETURN L.arrayCat(nmArray);
  590. END cat3;
  591. (* ------------------------------------------------------------ *)
  592. PROCEDURE MkBlkName*(mod : Id.BlkId);
  593. VAR mNm : L.CharOpen;
  594. (* -------------------------------------------------- *)
  595. PROCEDURE dotToSlash(arr : L.CharOpen) : L.CharOpen;
  596. VAR ix : INTEGER;
  597. BEGIN
  598. FOR ix := 0 TO LEN(arr)-1 DO
  599. IF arr[ix] = "." THEN arr[ix] := "/" END;
  600. END;
  601. RETURN arr;
  602. END dotToSlash;
  603. (* -------------------------------------------------- *)
  604. BEGIN
  605. IF mod.xName # NIL THEN RETURN END;
  606. mNm := Sym.getName.ChPtr(mod);
  607. IF mod.scopeNm # NIL THEN
  608. mod.scopeNm := dotToSlash(mod.scopeNm);
  609. ELSE
  610. mod.scopeNm := cat3(prfx, slsh, mNm); (* "CP/<modname>" *)
  611. END;
  612. IF ~CSt.doCode (* Only doing Jasmin output *)
  613. OR CSt.doJsmn (* Forcing assembly via Jasmin *)
  614. OR (mod.scopeNm[0] = 0X) (* Explicitly forcing no package! *) THEN
  615. mod.xName := mNm;
  616. ELSE (* default case *)
  617. mod.xName := cat3(mod.scopeNm, slsh, mNm);
  618. END;
  619. (*
  620. CSt.Message( "made scope name " + mod.scopeNm^ );
  621. CSt.Message( "made block name " + mod.xName^ );
  622. CSt.Message( "made mNm name " + mNm^ );
  623. *)
  624. END MkBlkName;
  625. (* ------------------------------------------------------------ *)
  626. PROCEDURE scopeName(scp : Sym.Scope) : L.CharOpen;
  627. BEGIN
  628. WITH scp : Id.BlkId DO
  629. IF scp.xName = NIL THEN MkBlkName(scp) END;
  630. IF CSt.doCode & ~CSt.doJsmn THEN
  631. RETURN Sym.getName.ChPtr(scp);
  632. ELSE
  633. RETURN scp.xName;
  634. END;
  635. | scp : Id.Procs DO
  636. IF scp.prcNm = NIL THEN MkProcName(scp) END;
  637. RETURN scp.prcNm;
  638. END;
  639. END scopeName;
  640. (* ------------------------------------------------------------ *)
  641. PROCEDURE qualScopeName(scp : Sym.Scope) : L.CharOpen;
  642. BEGIN
  643. WITH scp : Id.BlkId DO
  644. IF scp.xName = NIL THEN MkBlkName(scp) END;
  645. RETURN scp.scopeNm;
  646. | scp : Id.Procs DO
  647. IF scp.prcNm = NIL THEN MkProcName(scp) END;
  648. RETURN scp.scopeNm;
  649. END;
  650. END qualScopeName;
  651. (* ------------------------------------------------------------ *)
  652. PROCEDURE newMthId*(IN name : ARRAY OF CHAR; dfScp : Id.BlkId; bndTp : Sym.Type) : Id.MthId;
  653. VAR rslt : Id.MthId;
  654. BEGIN
  655. rslt := Id.newMthId();
  656. rslt.SetKind(Id.conMth);
  657. rslt.hash := Hsh.enterStr(name);
  658. rslt.dfScp := dfScp;
  659. rslt.bndType := bndTp;
  660. rslt.rcvFrm := Id.newParId();
  661. rslt.rcvFrm.type := bndTp;
  662. IF bndTp IS Ty.Record THEN rslt.rcvFrm.parMod := Sym.var END;
  663. RETURN rslt;
  664. END newMthId;
  665. (* ------------------------------------------------------------ *)
  666. (* Generate all naming strings for this record type, and put *)
  667. (* a corresponding emitter record on the work list. *)
  668. (* ------------------------------------------------------------ *)
  669. PROCEDURE MkRecName*(typ : Ty.Record);
  670. VAR mNm : L.CharOpen;
  671. qNm : L.CharOpen;
  672. rNm : L.CharOpen;
  673. tId : Sym.Idnt;
  674. BEGIN
  675. (* ###################################### *)
  676. IF typ.xName # NIL THEN RETURN END;
  677. (* ###################################### *)
  678. IF typ.bindTp # NIL THEN (* Synthetically named rec'd *)
  679. tId := typ.bindTp.idnt;
  680. ELSE (* Normal, named record type *)
  681. IF typ.idnt = NIL THEN (* Anonymous record type *)
  682. typ.idnt := Id.newAnonId(typ.serial);
  683. END;
  684. tId := typ.idnt;
  685. END;
  686. IF tId.dfScp = NIL THEN tId.dfScp := CSt.thisMod END;
  687. rNm := Sym.getName.ChPtr(tId);
  688. mNm := scopeName(tId.dfScp);
  689. qNm := qualScopeName(tId.dfScp);
  690. (*
  691. * At this point:
  692. * rNm holds the simple record name
  693. * mNm holds the qualifying module name
  694. * qNm holds the qualifying scope name
  695. * If extrnNm = NIL, the default mangling is used.
  696. * At exit we want:
  697. * xName to hold the fully qualified name
  698. * extrnNm to hold the simple name
  699. * scopeNm to hold the "L<qualid>;" name
  700. *)
  701. IF typ.extrnNm # NIL THEN
  702. typ.extrnNm := rNm;
  703. ELSE
  704. typ.extrnNm := cat3(mNm, lowL, rNm);
  705. END;
  706. IF qNm[0] # 0X THEN
  707. typ.xName := cat3(qNm, slsh, typ.extrnNm);
  708. ELSE
  709. typ.xName := typ.extrnNm;
  710. END;
  711. typ.scopeNm := cat3(lCap, typ.xName, semi);
  712. (*
  713. * It is at this point that we link records into the
  714. * class-emission worklist.
  715. *)
  716. IF tId.dfScp.kind # Id.impId THEN
  717. JavaBase.worklist.AddNewRecEmitter(typ);
  718. END;
  719. END MkRecName;
  720. (* ============================================================ *)
  721. (* Some Procedure Variable utilities *)
  722. (* ============================================================ *)
  723. PROCEDURE getProcWrapperInvoke*(typ : Ty.Record) : Id.MthId;
  724. VAR idnt : Sym.Idnt;
  725. BEGIN
  726. (*
  727. * We could get the method descriptor more cheaply by
  728. * indexing into the symbol table, but this would be
  729. * very fragile against future code changes.
  730. *)
  731. idnt := typ.symTb.lookup(invokeHash);
  732. RETURN idnt(Id.MthId);
  733. END getProcWrapperInvoke;
  734. PROCEDURE getProcVarInvoke*(typ : Ty.Procedure) : Id.MthId;
  735. BEGIN
  736. IF (typ = NIL) OR (typ.hostClass = NIL) THEN RETURN NIL;
  737. ELSE RETURN getProcWrapperInvoke(typ.hostClass);
  738. END;
  739. END getProcVarInvoke;
  740. (* ------------------------------------------------------------ *)
  741. (*
  742. * Copy the formals from the template procedure type descriptor
  743. * to the type descriptor for the method 'scp'. Change the
  744. * dfScp of the params (and receiver) to be local to scp.
  745. * Also, in the case of methods imported without parameter
  746. * names, generate synthetic names for the formals.
  747. *)
  748. PROCEDURE RescopeFormals(template : Ty.Procedure; scp : Id.MthId);
  749. VAR param : Id.ParId;
  750. index : INTEGER;
  751. synthH : INTEGER;
  752. newTyp : Ty.Procedure;
  753. BEGIN
  754. newTyp := scp.type(Ty.Procedure);
  755. newTyp.retType := template.retType;
  756. FOR index := 0 TO template.formals.tide -1 DO
  757. param := Id.cloneParInScope(template.formals.a[index], scp);
  758. IF param.hash = 0 THEN
  759. synthH := Hsh.enterStr("p" + L.intToCharOpen(index)^);
  760. template.formals.a[index].hash := synthH;
  761. param.hash := synthH;
  762. END;
  763. IF ~Sym.refused(param, scp) THEN
  764. Id.AppendParam(newTyp.formals, param);
  765. Sym.AppendIdnt(scp.locals, param);
  766. END;
  767. END;
  768. END RescopeFormals;
  769. (* ------------------------------------------------------------ *)
  770. (* Generate all naming strings for this procedure type, and *)
  771. (* put a corresponding emitter record on the work list. *)
  772. (* ------------------------------------------------------------ *)
  773. PROCEDURE MkProcTypeName*(typ : Ty.Procedure);
  774. VAR tIdent : Sym.Idnt;
  775. hostTp : Ty.Record;
  776. (* invoke : Id.MthId; *)
  777. rNm, mNm, qNm : L.CharOpen;
  778. BEGIN
  779. (* ###################################### *)
  780. IF typ.xName # NIL THEN RETURN END;
  781. (* ###################################### *)
  782. IF typ.idnt = NIL THEN (* Anonymous procedure type *)
  783. typ.idnt := Id.newAnonId(typ.serial);
  784. typ.idnt.type := typ;
  785. END;
  786. tIdent := typ.idnt;
  787. IF tIdent.dfScp = NIL THEN tIdent.dfScp := CSt.thisMod END;
  788. (*
  789. * if we want to select on kind, we
  790. * must ALWAYS use the newXxxTp calls
  791. *)
  792. hostTp := Ty.newRecTp();
  793. rNm := Sym.getName.ChPtr(tIdent);
  794. mNm := scopeName(tIdent.dfScp);
  795. qNm := qualScopeName(tIdent.dfScp);
  796. (*
  797. * At this point:
  798. * rNm holds the simple record name
  799. * mNm holds the qualifying module name
  800. * qNm holds the qualifying scope name
  801. * At exit we want:
  802. * xName to hold the fully qualified name
  803. *)
  804. hostTp.extrnNm := cat3(mNm, lowL, rNm);
  805. hostTp.xName := cat3(qNm, slsh, hostTp.extrnNm);
  806. hostTp.scopeNm := cat3(lCap, hostTp.xName, semi);
  807. typ.hostClass := hostTp;
  808. Blt.MkDummyMethodAndInsert("Invoke", Ty.newPrcTp(), hostTp, CSt.thisMod, Sym.pubMode, Sym.var, Id.isAbs);
  809. RescopeFormals(typ, getProcVarInvoke(typ));
  810. typ.xName := hostTp.xName;
  811. (*
  812. * It is at this point that we link records into the
  813. * class-emission worklist.
  814. *)
  815. IF tIdent.dfScp.kind # Id.impId THEN
  816. JavaBase.worklist.AddNewProcTypeEmitter(typ);
  817. END;
  818. END MkProcTypeName;
  819. (* ------------------------------------------------------------ *)
  820. (* Generate the body statement sequence for the proc-type *)
  821. (* wrapper class to invoke the encapsulated procedure literal. *)
  822. (* ------------------------------------------------------------ *)
  823. PROCEDURE procLitBodyStatement(targetId : Sym.Idnt; thisMth : Id.MthId) : Sym.Stmt;
  824. VAR text : L.CharOpenSeq;
  825. mthTp : Ty.Procedure;
  826. param : Id.ParId;
  827. index : INTEGER;
  828. (* ###################################### *)
  829. PROCEDURE textName(trgt : Sym.Idnt) : L.CharOpen;
  830. VAR simple : L.CharOpen;
  831. BEGIN
  832. simple := trgt.name();
  833. IF trgt.dfScp = CSt.thisMod THEN
  834. RETURN simple;
  835. ELSE
  836. RETURN BOX(trgt.dfScp.name()^ + '.' + simple^);
  837. END;
  838. END textName;
  839. (* ###################################### *)
  840. BEGIN
  841. mthTp := thisMth.type(Ty.Procedure);
  842. IF mthTp.retType # NIL THEN L.AppendCharOpen(text, BOX("RETURN ")) END;
  843. L.AppendCharOpen(text, textName(targetId));
  844. L.AppendCharOpen(text, lPar);
  845. FOR index := 0 TO mthTp.formals.tide - 1 DO
  846. IF index # 0 THEN L.AppendCharOpen(text, comma) END;
  847. param := mthTp.formals.a[index];
  848. L.AppendCharOpen(text, param.name());
  849. END;
  850. L.AppendCharOpen(text, rPar);
  851. L.AppendCharOpen(text, BOX("END"));
  852. RETURN Psr.parseTextAsStatement(text.a, thisMth);
  853. END procLitBodyStatement;
  854. (* ------------------------------------------------------------ *)
  855. (* Every value of procedure type is represented by a singleton *)
  856. (* class derived from the abstract host type of the proc-type. *)
  857. (* ------------------------------------------------------------ *)
  858. PROCEDURE newProcLitWrapperClass(exp : Sym.Expr; typ : Ty.Procedure) : Ty.Record;
  859. VAR singleton : Id.TypId;
  860. hostClass : Ty.Record;
  861. newInvoke : Id.MthId;
  862. BEGIN
  863. ASSERT(exp IS Xp.IdLeaf);
  864. Blt.MkDummyClass(newAnonLit(), CSt.thisMod, Ty.noAtt, singleton);
  865. hostClass := singleton.type.boundRecTp()(Ty.Record);
  866. Blt.MkDummyMethodAndInsert("Invoke", Ty.newPrcTp(), hostClass, CSt.thisMod, Sym.pubMode, Sym.var, {});
  867. MkRecName(hostClass); (* Add this class to the emission work-list *)
  868. newInvoke := getProcWrapperInvoke(hostClass);
  869. RescopeFormals(typ, newInvoke);
  870. newInvoke.body := procLitBodyStatement(exp(Xp.IdLeaf).ident, newInvoke);
  871. RETURN hostClass;
  872. END newProcLitWrapperClass;
  873. (* ------------------------------------------------------------ *)
  874. (* ------------------------------------------------------------ *)
  875. PROCEDURE getHostRecTp*( typ : Ty.Vector ) : Ty.Record;
  876. BEGIN
  877. RETURN vecRecTyp( mapVecElTp( typ.elemTp ) );
  878. END getHostRecTp;
  879. PROCEDURE MkVecName*(typ : Ty.Vector);
  880. VAR ord : INTEGER;
  881. rTp : Ty.Record;
  882. BEGIN
  883. rTp := getHostRecTp( typ );
  884. (*
  885. ord := mapVecElTp(typ.elemTp);
  886. rTp := vecRecTyp(ord);
  887. *)
  888. IF rTp.xName = NIL THEN MkRecName(rTp) END;
  889. typ.xName := rTp.scopeNm; (* signature of typ *)
  890. END MkVecName;
  891. (* ------------------------------------------------------------ *)
  892. PROCEDURE MkProcName*(proc : Id.Procs);
  893. VAR pNm : L.CharOpen;
  894. res : Id.Procs;
  895. scp : Sym.Scope;
  896. bTp : Ty.Record;
  897. (* -------------------------------------------------- *)
  898. PROCEDURE clsNmFromRec(typ : Sym.Type) : L.CharOpen;
  899. BEGIN
  900. IF CSt.doCode & ~CSt.doJsmn THEN
  901. RETURN typ(Ty.Record).xName;
  902. ELSE
  903. RETURN typ(Ty.Record).extrnNm;
  904. END;
  905. END clsNmFromRec;
  906. (* -------------------------------------------------- *)
  907. PROCEDURE className(p : Id.Procs) : L.CharOpen;
  908. BEGIN
  909. WITH p : Id.PrcId DO RETURN p.clsNm;
  910. | p : Id.MthId DO RETURN clsNmFromRec(p.bndType);
  911. END;
  912. END className;
  913. (* -------------------------------------------------- *)
  914. PROCEDURE GetClassName(pr : Id.PrcId; bl : Id.BlkId);
  915. VAR nm : L.CharOpen;
  916. BEGIN
  917. nm := Sym.getName.ChPtr(pr);
  918. IF pr.bndType = NIL THEN (* normal case *)
  919. pr.clsNm := bl.xName;
  920. IF pr.prcNm = NIL THEN pr.prcNm := nm END;
  921. ELSE (* static method *)
  922. IF pr.bndType.xName = NIL THEN MkRecName(pr.bndType(Ty.Record)) END;
  923. pr.clsNm := clsNmFromRec(pr.bndType);
  924. IF pr.prcNm = NIL THEN
  925. pr.prcNm := nm;
  926. ELSIF pr.prcNm^ = initStr THEN
  927. pr.SetKind(Id.ctorP);
  928. END;
  929. END;
  930. END GetClassName;
  931. (* -------------------------------------------------- *)
  932. PROCEDURE MkPrcNm(prc : Id.PrcId);
  933. VAR res : Id.PrcId;
  934. scp : Sym.Scope;
  935. blk : Id.BlkId;
  936. rTp : Ty.Record;
  937. BEGIN
  938. IF prc.scopeNm # NIL THEN RETURN;
  939. ELSIF prc.kind = Id.fwdPrc THEN
  940. res := prc.resolve(Id.PrcId); MkPrcNm(res);
  941. prc.prcNm := res.prcNm;
  942. prc.clsNm := res.clsNm;
  943. prc.scopeNm := res.scopeNm;
  944. ELSIF prc.kind = Id.conPrc THEN
  945. scp := prc.dfScp;
  946. WITH scp : Id.BlkId DO
  947. IF scp.xName = NIL THEN MkBlkName(scp) END;
  948. IF Sym.isFn IN scp.xAttr THEN
  949. GetClassName(prc, scp);
  950. ELSE
  951. prc.clsNm := scp.xName;
  952. IF prc.prcNm = NIL THEN prc.prcNm := Sym.getName.ChPtr(prc) END;
  953. END;
  954. | scp : Id.Procs DO
  955. MkProcName(scp);
  956. prc.clsNm := className(scp);
  957. prc.prcNm := cat3(Sym.getName.ChPtr(prc), dlar, scp.prcNm);
  958. END;
  959. prc.scopeNm := scp.scopeNm;
  960. ELSE (* prc.kind = Id.ctorP *)
  961. blk := prc.dfScp(Id.BlkId);
  962. rTp := prc.type.returnType().boundRecTp()(Ty.Record);
  963. IF blk.xName = NIL THEN MkBlkName(blk) END;
  964. IF rTp.xName = NIL THEN MkRecName(rTp) END;
  965. prc.clsNm := clsNmFromRec(rTp);
  966. prc.prcNm := L.strToCharOpen(initStr);
  967. prc.scopeNm := blk.scopeNm;
  968. END;
  969. END MkPrcNm;
  970. (* -------------------------------------------------- *)
  971. PROCEDURE MkMthNm(mth : Id.MthId);
  972. VAR res : Id.MthId;
  973. scp : Id.BlkId;
  974. typ : Sym.Type;
  975. BEGIN
  976. IF mth.scopeNm # NIL THEN RETURN;
  977. ELSIF mth.kind = Id.fwdMth THEN
  978. res := mth.resolve(Id.MthId); MkMthNm(res);
  979. mth.prcNm := res.prcNm; mth.scopeNm := res.scopeNm;
  980. ELSE
  981. scp := mth.dfScp(Id.BlkId);
  982. typ := mth.bndType;
  983. IF typ.xName = NIL THEN MkRecName(typ(Ty.Record)) END;
  984. IF scp.xName = NIL THEN MkBlkName(scp) END;
  985. mth.scopeNm := scp.scopeNm;
  986. IF mth.prcNm = NIL THEN mth.prcNm := Sym.getName.ChPtr(mth) END;
  987. END;
  988. END MkMthNm;
  989. (* -------------------------------------------------- *)
  990. BEGIN (* MkProcName *)
  991. WITH proc : Id.MthId DO MkMthNm(proc);
  992. | proc : Id.PrcId DO MkPrcNm(proc);
  993. END;
  994. END MkProcName;
  995. (* ------------------------------------------------------------ *)
  996. PROCEDURE MkAliasName*(typ : Ty.Opaque);
  997. VAR mNm : L.CharOpen;
  998. rNm : L.CharOpen;
  999. sNm : L.CharOpen;
  1000. BEGIN
  1001. (*
  1002. * This was almost certainly broken,
  1003. * at least for foreign explicit names
  1004. *)
  1005. IF typ.xName # NIL THEN RETURN END;
  1006. rNm := Sym.getName.ChPtr(typ.idnt);
  1007. (*
  1008. * old code --
  1009. * mNm := scopeName(typ.idnt.dfScp);
  1010. * sNm := cat3(mNm, lowL, rNm);
  1011. * typ.xName := cat3(qualScopeName(typ.idnt.dfScp), slsh, sNm);
  1012. *
  1013. * replaced by ...
  1014. *)
  1015. typ.xName := cat3(qualScopeName(typ.idnt.dfScp), slsh, rNm);
  1016. (* end *)
  1017. typ.scopeNm := cat3(lCap, typ.xName, semi);
  1018. END MkAliasName;
  1019. (* ------------------------------------------------------------ *)
  1020. PROCEDURE MkVarName*(var : Id.VarId);
  1021. VAR mod : Id.BlkId;
  1022. BEGIN
  1023. IF var.varNm # NIL THEN RETURN END;
  1024. mod := var.dfScp(Id.BlkId);
  1025. var.varNm := Sym.getName.ChPtr(var);
  1026. IF var.recTyp = NIL THEN (* normal case *)
  1027. var.clsNm := mod.xName;
  1028. ELSE (* static field *)
  1029. IF var.recTyp.xName = NIL THEN MkRecName(var.recTyp(Ty.Record)) END;
  1030. var.clsNm := var.recTyp(Ty.Record).extrnNm;
  1031. END;
  1032. END MkVarName;
  1033. (* ------------------------------------------------------------ *)
  1034. PROCEDURE NumberParams(pIdn : Id.Procs; pTyp : Ty.Procedure);
  1035. VAR parId : Id.ParId;
  1036. index : INTEGER;
  1037. count : INTEGER;
  1038. retTp : Sym.Type;
  1039. (* ----------------------------------------- *)
  1040. PROCEDURE AppendTypeName(VAR lst : L.CharOpenSeq; typ : Sym.Type);
  1041. BEGIN
  1042. WITH typ : Ty.Base DO
  1043. L.AppendCharOpen(lst, typ.xName);
  1044. | typ : Ty.Vector DO
  1045. IF typ.xName = NIL THEN MkVecName(typ) END;
  1046. L.AppendCharOpen(lst, typ.xName);
  1047. | typ : Ty.Array DO
  1048. L.AppendCharOpen(lst, brac);
  1049. AppendTypeName(lst, typ.elemTp);
  1050. | typ : Ty.Record DO
  1051. IF typ.xName = NIL THEN MkRecName(typ) END;
  1052. L.AppendCharOpen(lst, typ.scopeNm);
  1053. | typ : Ty.Enum DO
  1054. AppendTypeName(lst, Blt.intTp);
  1055. | typ : Ty.Pointer DO
  1056. AppendTypeName(lst, typ.boundTp);
  1057. | typ : Ty.Opaque DO
  1058. IF typ.xName = NIL THEN MkAliasName(typ) END;
  1059. L.AppendCharOpen(lst, typ.scopeNm);
  1060. | typ : Ty.Procedure DO
  1061. IF typ.xName = NIL THEN MkProcTypeName(typ) END;
  1062. L.AppendCharOpen(lst, typ.hostClass.scopeNm);
  1063. END;
  1064. END AppendTypeName;
  1065. (* ----------------------------------------- *)
  1066. BEGIN
  1067. (*
  1068. * The parameter numbering scheme tries to use the return
  1069. * value for the first OUT or VAR parameter. The variable
  1070. * 'hasRt' notes whether this possibility has been used up. If
  1071. * this is a value returning function hasRt is true at entry.
  1072. *)
  1073. count := pIdn.rtsFram;
  1074. retTp := pTyp.retType;
  1075. IF pIdn.kind = Id.ctorP THEN
  1076. INC(count);
  1077. ELSIF retTp # NIL THEN (* and not a constructor... *)
  1078. pTyp.retN := jvmSize(pTyp.retType);
  1079. END;
  1080. L.ResetCharOpenSeq(fmArray);
  1081. L.AppendCharOpen(fmArray, lPar);
  1082. IF pIdn.lxDepth > 0 THEN
  1083. L.AppendCharOpen(fmArray, xhrMk); INC(count);
  1084. END;
  1085. FOR index := 0 TO pTyp.formals.tide-1 DO
  1086. parId := pTyp.formals.a[index];
  1087. IF needsBox(parId) THEN
  1088. IF parId.parMod = Sym.var THEN (* pass value as well *)
  1089. parId.varOrd := count;
  1090. INC(count, jvmSize(parId.type));
  1091. AppendTypeName(fmArray, parId.type);
  1092. END;
  1093. IF retTp = NIL THEN
  1094. (*
  1095. * Return slot is not already used, use it now.
  1096. *)
  1097. parId.boxOrd := retMarker;
  1098. pTyp.retN := jvmSize(parId.type);
  1099. retTp := parId.type;
  1100. ELSE
  1101. (*
  1102. * Return slot is already used, use a boxed variable.
  1103. *)
  1104. parId.boxOrd := count;
  1105. INC(count);
  1106. L.AppendCharOpen(fmArray, brac);
  1107. AppendTypeName(fmArray, parId.type);
  1108. END;
  1109. ELSE (* could be two slots ... *)
  1110. parId.varOrd := count;
  1111. INC(count, jvmSize(parId.type));
  1112. AppendTypeName(fmArray, parId.type);
  1113. END;
  1114. END;
  1115. L.AppendCharOpen(fmArray, rPar);
  1116. IF (retTp = NIL) OR (pIdn.kind = Id.ctorP) THEN
  1117. L.AppendCharOpen(fmArray, void);
  1118. ELSIF (pIdn IS Id.MthId) & (Id.covar IN pIdn(Id.MthId).mthAtt) THEN
  1119. (*
  1120. * This is a method with a covariant return type. We must
  1121. * erase the declared type, substituting the non-covariant
  1122. * upper-bound. Calls will cast the result to the real type.
  1123. *)
  1124. AppendTypeName(fmArray, pIdn.retTypBound());
  1125. ELSE
  1126. AppendTypeName(fmArray, retTp);
  1127. END;
  1128. pTyp.xName := L.arrayCat(fmArray);
  1129. (*
  1130. * We must now set the argsize and retsize.
  1131. * The current info.lNum (before the locals
  1132. * have been added) is the argsize.
  1133. *)
  1134. pTyp.argN := count;
  1135. pIdn.rtsFram := count;
  1136. END NumberParams;
  1137. (* ------------------------------------------------------------ *)
  1138. (* Proxies are the local variables corresponding to boxed *)
  1139. (* arguments that are not also passed by value, for example, *)
  1140. (* an OUT mode argument returned as the function return. . *)
  1141. (* ------------------------------------------------------------ *)
  1142. PROCEDURE NumberProxies(pIdn : Id.Procs; IN pars : Id.ParSeq);
  1143. VAR parId : Id.ParId;
  1144. index : INTEGER;
  1145. BEGIN
  1146. (* ------------------ *
  1147. * Allocate an activation record slot for the XHR,
  1148. * if this is needed. The XHR reference will be local
  1149. * number pIdn.type.argN.
  1150. * ------------------ *)
  1151. IF Id.hasXHR IN pIdn.pAttr THEN MkXHR(pIdn); INC(pIdn.rtsFram) END;
  1152. FOR index := 0 TO pars.tide-1 DO
  1153. parId := pars.a[index];
  1154. IF parId.parMod # Sym.var THEN
  1155. IF needsBox(parId) THEN
  1156. parId.varOrd := pIdn.rtsFram;
  1157. INC(pIdn.rtsFram, jvmSize(parId.type));
  1158. END;
  1159. END;
  1160. END;
  1161. END NumberProxies;
  1162. (* ------------------------------------------------------------ *)
  1163. PROCEDURE NumberLocals(pIdn : Id.Procs; IN locs : Sym.IdSeq);
  1164. VAR ident : Sym.Idnt;
  1165. index : INTEGER;
  1166. count : INTEGER;
  1167. BEGIN
  1168. count := pIdn.rtsFram;
  1169. FOR index := 0 TO locs.tide-1 DO
  1170. ident := locs.a[index];
  1171. WITH ident : Id.ParId DO (* skip *)
  1172. | ident : Id.LocId DO
  1173. ident.varOrd := count;
  1174. INC(count, jvmSize(ident.type));
  1175. END;
  1176. END;
  1177. pIdn.rtsFram := count;
  1178. END NumberLocals;
  1179. (* ------------------------------------------------------------ *)
  1180. PROCEDURE MkCallAttr*(pIdn : Sym.Idnt; pTyp : Ty.Procedure);
  1181. BEGIN
  1182. WITH pIdn : Id.MthId DO
  1183. IF ~needsBox(pIdn.rcvFrm) THEN
  1184. pIdn.rtsFram := 1; (* count one for "this" *)
  1185. ELSE
  1186. pIdn.rtsFram := 2; (* this plus the retbox *)
  1187. END;
  1188. MkProcName(pIdn);
  1189. NumberParams(pIdn, pTyp);
  1190. | pIdn : Id.PrcId DO
  1191. pIdn.rtsFram := 0;
  1192. MkProcName(pIdn);
  1193. NumberParams(pIdn, pTyp);
  1194. END;
  1195. END MkCallAttr;
  1196. (* ------------------------------------------------------------ *)
  1197. PROCEDURE RenumberLocals*(prcId : Id.Procs);
  1198. VAR parId : Id.ParId;
  1199. frmTp : Ty.Procedure;
  1200. funcT : BOOLEAN;
  1201. BEGIN
  1202. (*
  1203. * Rules:
  1204. * (i) The receiver (if any) must be #0
  1205. * (ii) Params are #1 .. #N, or #0 .. for statics
  1206. * (iii) Locals are #(N+1) ...
  1207. * (iv) doubles and longs take two slots.
  1208. *
  1209. * This procedure computes the number of local slots. It
  1210. * renumbers the varOrd fields, and initializes rtsFram.
  1211. * The procedure also computes the formal name for the JVM.
  1212. *)
  1213. prcId.rtsFram := 0;
  1214. frmTp := prcId.type(Ty.Procedure);
  1215. funcT := (frmTp.retType # NIL);
  1216. WITH prcId : Id.MthId DO
  1217. parId := prcId.rcvFrm;
  1218. parId.varOrd := 0;
  1219. prcId.rtsFram := 1; (* count one for "this" *)
  1220. ASSERT(~needsBox(parId));
  1221. (*
  1222. * Receivers are never boxed in Component Pascal
  1223. *
  1224. * IF needsBox(parId) THEN
  1225. * parId.boxOrd := 1;
  1226. * prcId.rtsFram := 2; (* count one for retbox *)
  1227. * END;
  1228. *)
  1229. ELSE (* skip static procedures *)
  1230. END;
  1231. (*
  1232. * Assert: params do not appear in the local array.
  1233. * Count params (and boxes if needed).
  1234. *)
  1235. NumberParams(prcId, frmTp);
  1236. NumberProxies(prcId, frmTp.formals);
  1237. NumberLocals(prcId, prcId.locals);
  1238. END RenumberLocals;
  1239. (* ------------------------------------------------------------ *)
  1240. (* ------------------------------------------------------------ *)
  1241. PROCEDURE (jf : JavaFile)MakeAndPushProcLitValue*(exp : Sym.Expr; typ : Ty.Procedure),NEW;
  1242. VAR singleton : Id.TypId;
  1243. hostClass : Ty.Record;
  1244. BEGIN
  1245. MkProcTypeName(typ);
  1246. hostClass := newProcLitWrapperClass(exp, typ);
  1247. hostClass.baseTp := typ.hostClass;
  1248. jf.MkNewRecord(hostClass);
  1249. END MakeAndPushProcLitValue;
  1250. (* ------------------------------------------------------------ *)
  1251. (* ---------------------------------------------------- *)
  1252. PROCEDURE (jf : JavaFile)GetLocal*(var : Id.LocId),NEW;
  1253. BEGIN
  1254. IF Id.uplevA IN var.locAtt THEN jf.GetUplevel(var);
  1255. ELSE jf.LoadLocal(var.varOrd, var.type);
  1256. END;
  1257. END GetLocal;
  1258. (* ---------------------------------------------------- *)
  1259. PROCEDURE typeToChOpen*(typ : Sym.Type) : L.CharOpen;
  1260. (* --------------------------------------------- *)
  1261. PROCEDURE slashToDot(a : L.CharOpen) : L.CharOpen;
  1262. VAR nw : L.CharOpen; ix : INTEGER; ch : CHAR;
  1263. BEGIN
  1264. NEW(nw, LEN(a));
  1265. FOR ix := 0 TO LEN(a)-1 DO
  1266. ch := a[ix]; IF ch = "/" THEN nw[ix] := "." ELSE nw[ix] := ch END;
  1267. END;
  1268. RETURN nw;
  1269. END slashToDot;
  1270. (* --------------------------------------------- *)
  1271. PROCEDURE typeTag(typ : Sym.Type) : L.CharOpen;
  1272. BEGIN
  1273. WITH typ : Ty.Base DO
  1274. RETURN typ.xName;
  1275. | typ : Ty.Array DO
  1276. RETURN cat2(brac, typeTag(typ.elemTp));
  1277. | typ : Ty.Record DO
  1278. IF typ.xName = NIL THEN MkRecName(typ) END;
  1279. RETURN slashToDot(typ.scopeNm);
  1280. | typ : Ty.Enum DO
  1281. RETURN Blt.intTp.xName;
  1282. | typ : Ty.Pointer DO
  1283. RETURN typeTag(typ.boundTp);
  1284. | typ : Ty.Opaque DO
  1285. IF typ.xName = NIL THEN MkAliasName(typ) END;
  1286. RETURN slashToDot(typ.scopeNm);
  1287. END;
  1288. END typeTag;
  1289. (* --------------------------------------------- *)
  1290. BEGIN
  1291. WITH typ : Ty.Base DO
  1292. RETURN typeTag(typ);
  1293. | typ : Ty.Array DO
  1294. RETURN cat2(brac, typeTag(typ.elemTp));
  1295. | typ : Ty.Record DO
  1296. IF typ.xName = NIL THEN MkRecName(typ) END;
  1297. RETURN slashToDot(typ.xName);
  1298. | typ : Ty.Pointer DO
  1299. RETURN typeToChOpen(typ.boundTp);
  1300. | typ : Ty.Opaque DO
  1301. IF typ.xName = NIL THEN MkAliasName(typ) END;
  1302. RETURN slashToDot(typ.xName);
  1303. END;
  1304. END typeToChOpen;
  1305. (* ---------------------------------------------------- *)
  1306. PROCEDURE (jf : JavaFile)LoadType*(id : Sym.Idnt),NEW;
  1307. VAR tp : Sym.Type;
  1308. BEGIN
  1309. ASSERT(id IS Id.TypId);
  1310. tp := id.type;
  1311. WITH tp : Ty.Base DO
  1312. jf.PushInt(tp.tpOrd);
  1313. jf.CallRTS(LoadTp1, 1, 1);
  1314. ELSE
  1315. (*
  1316. * First we get the string-name of the
  1317. * type, and then we push the string.
  1318. *)
  1319. jf.PushStr(typeToChOpen(id.type));
  1320. (*
  1321. * Then we call getClassByName
  1322. *)
  1323. jf.CallRTS(LoadTp2, 1, 1);
  1324. END;
  1325. END LoadType;
  1326. (* ---------------------------------------------------- *)
  1327. PROCEDURE (jf : JavaFile)GetVar*(id : Sym.Idnt),NEW;
  1328. VAR var : Id.AbVar;
  1329. scp : Sym.Scope;
  1330. BEGIN
  1331. var := id(Id.AbVar);
  1332. IF var.kind = Id.conId THEN
  1333. jf.GetLocal(var(Id.LocId));
  1334. ELSE
  1335. scp := var.dfScp;
  1336. WITH scp : Id.BlkId DO
  1337. jf.PutGetS(Jvm.opc_getstatic, scp, var(Id.VarId));
  1338. ELSE (* must be local *)
  1339. jf.GetLocal(var(Id.LocId));
  1340. END;
  1341. END;
  1342. END GetVar;
  1343. (* ------------------------------------------------------------ *)
  1344. (* ---------------------------------------------------- *)
  1345. PROCEDURE (jf : JavaFile)PutLocal*(var : Id.LocId),NEW;
  1346. BEGIN
  1347. IF Id.uplevA IN var.locAtt THEN jf.PutUplevel(var);
  1348. ELSE jf.StoreLocal(var.varOrd, var.type);
  1349. END;
  1350. END PutLocal;
  1351. (* ---------------------------------------------------- *)
  1352. PROCEDURE (jf : JavaFile)PutVar*(id : Sym.Idnt),NEW;
  1353. VAR var : Id.AbVar;
  1354. scp : Sym.Scope;
  1355. BEGIN
  1356. var := id(Id.AbVar);
  1357. scp := var.dfScp;
  1358. WITH scp : Id.BlkId DO
  1359. jf.PutGetS(Jvm.opc_putstatic, scp, var(Id.VarId));
  1360. ELSE (* could be in an XHR *)
  1361. jf.PutLocal(var(Id.LocId));
  1362. END;
  1363. END PutVar;
  1364. (* ------------------------------------------------------------ *)
  1365. PROCEDURE (jf : JavaFile)PutElement*(typ : Sym.Type),NEW;
  1366. VAR code : INTEGER;
  1367. BEGIN
  1368. IF (typ # NIL) & (typ IS Ty.Base) THEN
  1369. code := typePutE[typ(Ty.Base).tpOrd];
  1370. ELSE
  1371. code := Jvm.opc_aastore;
  1372. END;
  1373. jf.Code(code);
  1374. END PutElement;
  1375. (* ------------------------------------------------------------ *)
  1376. PROCEDURE (jf : JavaFile)GetElement*(typ : Sym.Type),NEW;
  1377. VAR code : INTEGER;
  1378. BEGIN
  1379. IF (typ # NIL) & (typ IS Ty.Base) THEN
  1380. code := typeGetE[typ(Ty.Base).tpOrd];
  1381. ELSE
  1382. code := Jvm.opc_aaload;
  1383. END;
  1384. jf.Code(code);
  1385. END GetElement;
  1386. (* ------------------------------------------------------------ *)
  1387. PROCEDURE (jf : JavaFile)PushInt*(num : INTEGER),NEW;
  1388. VAR
  1389. conIx : INTEGER;
  1390. BEGIN
  1391. IF (num >= MIN(BYTE)) & (num <= MAX(BYTE)) THEN
  1392. CASE num OF
  1393. | -1 : jf.Code(Jvm.opc_iconst_m1);
  1394. | 0 : jf.Code(Jvm.opc_iconst_0);
  1395. | 1 : jf.Code(Jvm.opc_iconst_1);
  1396. | 2 : jf.Code(Jvm.opc_iconst_2);
  1397. | 3 : jf.Code(Jvm.opc_iconst_3);
  1398. | 4 : jf.Code(Jvm.opc_iconst_4);
  1399. | 5 : jf.Code(Jvm.opc_iconst_5);
  1400. ELSE
  1401. jf.CodeI(Jvm.opc_bipush, num);
  1402. END;
  1403. ELSE
  1404. jf.LoadConst(num);
  1405. END;
  1406. END PushInt;
  1407. (* ------------------------------------------------------------ *)
  1408. PROCEDURE (jf : JavaFile)PushLong*(num : LONGINT),NEW;
  1409. BEGIN
  1410. IF num = 0 THEN
  1411. jf.Code(Jvm.opc_lconst_0);
  1412. ELSIF num = 1 THEN
  1413. jf.Code(Jvm.opc_lconst_1);
  1414. ELSIF (num >= MIN(INTEGER)) & (num <= MAX(INTEGER)) THEN
  1415. jf.PushInt(SHORT(num));
  1416. jf.Code(Jvm.opc_i2l);
  1417. ELSE
  1418. jf.CodeL(Jvm.opc_ldc2_w, num);
  1419. END;
  1420. END PushLong;
  1421. (* ------------------------------------------------------------ *)
  1422. PROCEDURE (jf : JavaFile)PushReal*(num : REAL),NEW;
  1423. BEGIN
  1424. IF num = 0.0 THEN
  1425. jf.Code(Jvm.opc_dconst_0);
  1426. ELSIF num = 1.0 THEN
  1427. jf.Code(Jvm.opc_dconst_1);
  1428. ELSE
  1429. jf.CodeR(Jvm.opc_ldc2_w, num, FALSE);
  1430. END;
  1431. END PushReal;
  1432. (* ------------------------------------------------------------ *)
  1433. PROCEDURE (jf : JavaFile)PushSReal*(num : REAL),NEW;
  1434. VAR
  1435. conIx : INTEGER;
  1436. BEGIN
  1437. IF num = 0.0 THEN
  1438. jf.Code(Jvm.opc_fconst_0);
  1439. ELSIF num = 1.0 THEN
  1440. jf.Code(Jvm.opc_fconst_1);
  1441. ELSIF num = 2.0 THEN
  1442. jf.Code(Jvm.opc_fconst_2);
  1443. ELSE
  1444. jf.CodeR(Jvm.opc_ldc, num, TRUE);
  1445. END;
  1446. END PushSReal;
  1447. (* ------------------------------------------------------------ *)
  1448. (* ------------------------------------------------------------ *
  1449. * A note on static links and the XHR system.
  1450. *
  1451. *
  1452. *
  1453. *
  1454. *
  1455. *
  1456. * ------------------------------------------------------------ *)
  1457. (* ------------------------------------------------------------ *)
  1458. (* ------------------------------------------------------------ *)
  1459. (* Pass the XHR reference as arg-0 to nested procedure tgt *)
  1460. (* ------------------------------------------------------------ *)
  1461. PROCEDURE (jf : JavaFile)PushStaticLink*(tgt : Id.Procs),NEW;
  1462. VAR lxDel : INTEGER;
  1463. clr : Id.Procs;
  1464. pTp : Ty.Procedure;
  1465. BEGIN
  1466. clr := jf.theP; (* calling procedure *)
  1467. lxDel := tgt.lxDepth - clr.lxDepth; (* lex-level delta *)
  1468. pTp := clr.type(Ty.Procedure); (* caller proc-type *)
  1469. CASE lxDel OF
  1470. | 0 : (*
  1471. * tgt depth = clr depth, this case
  1472. * arises, for example with a recursive call.
  1473. * The incoming XHR ref must be chained on.
  1474. *)
  1475. jf.AloadLocal( 0, xhrPtr );
  1476. | 1 : (*
  1477. * If caller has uplevel-addressed locals,
  1478. * then pass a reference to the XHR which
  1479. * is held in local slot pTp.argN
  1480. *)
  1481. IF Id.hasXHR IN clr.pAttr THEN
  1482. jf.AloadLocal( pTp.argN, xhrPtr ); (* type is xhrPtr *)
  1483. (*
  1484. * Else if caller is at lexical level-0 then
  1485. * "locals" are static fields of the module.
  1486. *)
  1487. ELSIF clr.lxDepth = 0 THEN
  1488. jf.Code(Jvm.opc_aconst_null);
  1489. (*
  1490. * Else incoming XHR is in arg-0
  1491. *)
  1492. ELSE
  1493. jf.AloadLocal( 0, xhrPtr );
  1494. END;
  1495. ELSE (*
  1496. * This case arises if the target procedure
  1497. * is global relative to the caller. In this
  1498. * case the chain of XHRs must be followed
  1499. * until the incoming XHR for tgt is found.
  1500. *)
  1501. jf.AloadLocal( 0, xhrPtr );
  1502. REPEAT
  1503. clr := clr.dfScp(Id.Procs);
  1504. IF Id.hasXHR IN clr.pAttr THEN
  1505. (* get XHR field "prev" *)
  1506. jf.PutGetF(Jvm.opc_getfield, xhrRec, CSt.xhrId);
  1507. END;
  1508. UNTIL clr.lxDepth = tgt.lxDepth;
  1509. END;
  1510. END PushStaticLink;
  1511. (* ------------------------------------------------------------ *)
  1512. (* Load the reference to record holding the datum requested *)
  1513. (* ------------------------------------------------------------ *)
  1514. PROCEDURE (jf : JavaFile)GetXHR(var : Id.LocId),NEW;
  1515. VAR scp : Id.Procs; (* the scope holding the datum *)
  1516. clr : Id.Procs; (* the scope making the call *)
  1517. pTp : Ty.Procedure;
  1518. xTp : Sym.Type;
  1519. del : INTEGER;
  1520. BEGIN
  1521. scp := var.dfScp(Id.Procs);
  1522. clr := jf.theP;
  1523. pTp := clr.type(Ty.Procedure);
  1524. (*
  1525. * Check if this is an own local
  1526. *)
  1527. IF scp = clr THEN
  1528. jf.AloadLocal( pTp.argN, xhrPtr );
  1529. ELSE
  1530. del := xhrCount(scp, clr);
  1531. (*
  1532. * First, load the static link
  1533. *)
  1534. jf.AloadLocal( 0, xhrPtr );
  1535. (*
  1536. * Next, load the XHR pointer.
  1537. * Step getfield "prev" of the XHR
  1538. * until lexical level is bridged.
  1539. *)
  1540. WHILE del > 1 DO
  1541. jf.PutGetF( Jvm.opc_getfield, xhrRec, CSt.xhrId );
  1542. DEC(del);
  1543. END;
  1544. (*
  1545. * Finally, cast to concrete type
  1546. *)
  1547. jf.CodeT(Jvm.opc_checkcast, scp.xhrType);
  1548. END;
  1549. END GetXHR;
  1550. (* ------------------------------------------------------------ *)
  1551. (* Get variable with local Id "var" after XHR is loaded *)
  1552. (* ------------------------------------------------------------ *)
  1553. PROCEDURE (jf : JavaFile)PutGetX*(cde : INTEGER; var : Id.LocId),NEW;
  1554. VAR pTyp : Sym.Type;
  1555. BEGIN
  1556. pTyp := var.dfScp(Id.Procs).xhrType;
  1557. jf.PutGetF(cde, pTyp.boundRecTp()(Ty.Record), var);
  1558. END PutGetX;
  1559. (* ------------------------------------------------------------ *)
  1560. PROCEDURE (jf : JavaFile)XhrHandle*(var : Id.LocId),NEW;
  1561. BEGIN
  1562. jf.GetXHR(var);
  1563. END XhrHandle;
  1564. (* ------------------------------------------------------------ *)
  1565. PROCEDURE (jf : JavaFile)GetUplevel*(var : Id.LocId),NEW;
  1566. BEGIN
  1567. jf.GetXHR(var);
  1568. jf.PutGetX(Jvm.opc_getfield, var);
  1569. END GetUplevel;
  1570. (* ------------------------------------------------------------ *)
  1571. PROCEDURE (jf : JavaFile)PutUplevel*(var : Id.LocId),NEW;
  1572. BEGIN
  1573. jf.PutGetX(Jvm.opc_putfield, var);
  1574. END PutUplevel;
  1575. (* ------------------------------------------------------------ *)
  1576. PROCEDURE (jf : JavaFile)ConvertUp*(inT, outT : Sym.Type),NEW;
  1577. (* Conversion "up" is always safe at runtime. Many are nop. *)
  1578. VAR inB, outB, code : INTEGER;
  1579. BEGIN
  1580. inB := inT(Ty.Base).tpOrd;
  1581. outB := outT(Ty.Base).tpOrd;
  1582. IF inB = outB THEN RETURN END; (* PREMATURE RETURN! *)
  1583. CASE outB OF
  1584. | Ty.realN :
  1585. IF inB = Ty.sReaN THEN code := Jvm.opc_f2d;
  1586. ELSIF inB = Ty.lIntN THEN code := Jvm.opc_l2d;
  1587. ELSE code := Jvm.opc_i2d;
  1588. END;
  1589. | Ty.sReaN :
  1590. IF inB = Ty.lIntN THEN code := Jvm.opc_l2f;
  1591. ELSE code := Jvm.opc_i2f;
  1592. END;
  1593. | Ty.lIntN :
  1594. code := Jvm.opc_i2l;
  1595. ELSE RETURN; (* PREMATURE RETURN! *)
  1596. END;
  1597. jf.Code(code);
  1598. END ConvertUp;
  1599. (* ------------------------------------------------------------ *)
  1600. PROCEDURE (jf : JavaFile)ConvertDn*(inT, outT : Sym.Type),NEW;
  1601. (* Conversion "down" often needs a runtime check. *)
  1602. VAR inB, outB, code : INTEGER;
  1603. BEGIN
  1604. inB := inT(Ty.Base).tpOrd;
  1605. outB := outT(Ty.Base).tpOrd;
  1606. IF inB = outB THEN RETURN END; (* PREMATURE RETURN! *)
  1607. CASE outB OF
  1608. | Ty.realN : RETURN; (* PREMATURE RETURN! *)
  1609. | Ty.sReaN :
  1610. code := Jvm.opc_d2f;
  1611. | Ty.lIntN :
  1612. IF inB = Ty.realN THEN code := Jvm.opc_d2l;
  1613. ELSIF inB = Ty.sReaN THEN code := Jvm.opc_f2l;
  1614. ELSE RETURN; (* PREMATURE RETURN! *)
  1615. END;
  1616. | Ty.intN :
  1617. IF inB = Ty.realN THEN code := Jvm.opc_d2i;
  1618. ELSIF inB = Ty.sReaN THEN code := Jvm.opc_f2i;
  1619. ELSIF inB = Ty.lIntN THEN
  1620. (* jf.RangeCheck(...); STILL TO DO *)
  1621. code := Jvm.opc_l2i;
  1622. ELSE RETURN; (* PREMATURE RETURN! *)
  1623. END;
  1624. | Ty.sIntN :
  1625. jf.ConvertDn(inT, Blt.intTp);
  1626. (* jf.RangeCheck(...); STILL TO DO *)
  1627. code := Jvm.opc_i2s;
  1628. | Ty.uBytN :
  1629. jf.ConvertDn(inT, Blt.intTp);
  1630. (* jf.RangeCheck(...); STILL TO DO *)
  1631. jf.PushInt(255);
  1632. code := Jvm.opc_iand;
  1633. | Ty.byteN :
  1634. jf.ConvertDn(inT, Blt.intTp);
  1635. (* jf.RangeCheck(...); STILL TO DO *)
  1636. code := Jvm.opc_i2b;
  1637. | Ty.setN :
  1638. jf.ConvertDn(inT, Blt.intTp); RETURN; (* PREMATURE RETURN! *)
  1639. | Ty.charN :
  1640. jf.ConvertDn(inT, Blt.intTp);
  1641. (* jf.RangeCheck(...); STILL TO DO *)
  1642. code := Jvm.opc_i2c;
  1643. | Ty.sChrN :
  1644. jf.ConvertDn(inT, Blt.intTp);
  1645. (* jf.RangeCheck(...); STILL TO DO *)
  1646. jf.PushInt(255);
  1647. code := Jvm.opc_iand;
  1648. END;
  1649. jf.Code(code);
  1650. END ConvertDn;
  1651. (* ------------------------------------------------------------ *)
  1652. PROCEDURE (jf : JavaFile)EmitOneRange*
  1653. (var : INTEGER; (* local variable index *)
  1654. loC : INTEGER; (* low-value of range *)
  1655. hiC : INTEGER; (* high-value of range *)
  1656. min : INTEGER; (* minimun selector val *)
  1657. max : INTEGER; (* maximum selector val *)
  1658. def : Label; (* default code label *)
  1659. target : Label),NEW;
  1660. (* ---------------------------------------------------------- *
  1661. * The selector value is known to be in the range min .. max *
  1662. * and we wish to send values between loC and hiC to the *
  1663. * target code label. All otherwise go to def. *
  1664. * A range is "compact" if it is hard against min/max limits *
  1665. * ---------------------------------------------------------- *)
  1666. BEGIN
  1667. (*
  1668. * Deal with several special cases...
  1669. *)
  1670. IF (min = loC) & (max = hiC) THEN (* fully compact: just GOTO *)
  1671. jf.CodeLb(Jvm.opc_goto, target);
  1672. ELSE
  1673. jf.LoadLocal(var, Blt.intTp);
  1674. IF loC = hiC THEN (* a singleton *)
  1675. jf.PushInt(loC);
  1676. jf.CodeLb(Jvm.opc_if_icmpeq, target);
  1677. ELSIF min = loC THEN (* compact at low end only *)
  1678. jf.PushInt(hiC);
  1679. jf.CodeLb(Jvm.opc_if_icmple, target);
  1680. ELSIF max = hiC THEN (* compact at high end only *)
  1681. jf.PushInt(loC);
  1682. jf.CodeLb(Jvm.opc_if_icmpge, target);
  1683. ELSE (* Shucks! The general case *)
  1684. jf.PushInt(loC);
  1685. jf.CodeLb(Jvm.opc_if_icmplt, def);
  1686. jf.LoadLocal(var, Blt.intTp);
  1687. jf.PushInt(hiC);
  1688. jf.CodeLb(Jvm.opc_if_icmple, target);
  1689. END;
  1690. jf.CodeLb(Jvm.opc_goto, def);
  1691. END;
  1692. END EmitOneRange;
  1693. (* ------------------------------------------------------------ *)
  1694. PROCEDURE (jf : JavaFile)Return*(ret : Sym.Type),NEW;
  1695. BEGIN
  1696. IF ret = NIL THEN
  1697. jf.Code(Jvm.opc_return);
  1698. ELSIF ret IS Ty.Base THEN
  1699. jf.Code(typeRetn[ret(Ty.Base).tpOrd]);
  1700. ELSE
  1701. jf.Code(Jvm.opc_areturn);
  1702. END;
  1703. END Return;
  1704. (* ------------------------------------------------------------ *)
  1705. PROCEDURE (jf : JavaFile)FixPar(par : Id.ParId),NEW;
  1706. BEGIN
  1707. (*
  1708. * Load up the actual into boxVar[0];
  1709. *)
  1710. jf.LoadLocal( par.boxOrd, TypeOfBox( par.type ) );
  1711. jf.Code(Jvm.opc_iconst_0);
  1712. (*
  1713. * The param might be an XHR field, so
  1714. * jf.LoadLocal(par.varOrd, par.type) breaks.
  1715. *)
  1716. jf.GetLocal(par);
  1717. jf.PutElement(par.type);
  1718. END FixPar;
  1719. (* ------------------------------------------------------------ *)
  1720. PROCEDURE (jf : JavaFile)FixOutPars*(pId : Id.Procs; OUT ret : Sym.Type),NEW;
  1721. VAR frm : Ty.Procedure;
  1722. par : Id.ParId;
  1723. idx : INTEGER;
  1724. BEGIN
  1725. ret := NIL;
  1726. (*
  1727. * Receivers are never boxed in Component Pascal.
  1728. *
  1729. * WITH pId : Id.MthId DO
  1730. * par := pId.rcvFrm;
  1731. * IF par.boxOrd # 0 THEN jf.FixPar(par) END;
  1732. * ELSE (* nothing *)
  1733. * END;
  1734. *)
  1735. frm := pId.type(Ty.Procedure);
  1736. FOR idx := 0 TO frm.formals.tide-1 DO
  1737. par := frm.formals.a[idx];
  1738. IF par.boxOrd = retMarker THEN
  1739. ret := par.type;
  1740. (*
  1741. * The param might be an XHR field, so
  1742. * jf.LoadLocal(par.varOrd, ret) breaks.
  1743. *)
  1744. jf.GetLocal(par);
  1745. ELSIF needsBox(par) THEN
  1746. jf.FixPar(par);
  1747. END;
  1748. END;
  1749. (*
  1750. * If ret is still NIL, then either there is an explicit
  1751. * return type, or there was no OUT or VAR parameters here.
  1752. * So...
  1753. *)
  1754. IF (ret = NIL) & (pId.kind # Id.ctorP) THEN ret := frm.retType END;
  1755. END FixOutPars;
  1756. (* ------------------------------------------------------------ *)
  1757. PROCEDURE (jf : JavaFile)PushJunkAndReturn*(),NEW;
  1758. VAR frm : Ty.Procedure;
  1759. ret : Sym.Type;
  1760. idx : INTEGER;
  1761. par : Id.ParId;
  1762. BEGIN
  1763. (*
  1764. * This procedure pushes a dummy return value
  1765. * if that is necessary, and calls return.
  1766. *)
  1767. ret := NIL;
  1768. IF jf.theP = NIL THEN RETURN END; (* PREMATURE EXIT FOR MOD BODY *)
  1769. frm := jf.theP.type(Ty.Procedure);
  1770. (*
  1771. * First, we must find the (jvm) return type.
  1772. * It would have been nice to store this in out.info!
  1773. *)
  1774. FOR idx := 0 TO frm.formals.tide-1 DO
  1775. par := frm.formals.a[idx];
  1776. IF par.boxOrd = retMarker THEN ret := par.type END;
  1777. END;
  1778. IF ret = NIL THEN ret := frm.retType END;
  1779. (*
  1780. * Now push a "zero" if necessary, then return.
  1781. * If this is a void function in the JVM, then we
  1782. * may safely leave things to the fall through return.
  1783. *)
  1784. IF ret # NIL THEN
  1785. WITH ret : Ty.Base DO
  1786. CASE ret.tpOrd OF
  1787. | Ty.boolN .. Ty.intN : jf.Code(Jvm.opc_iconst_0);
  1788. | Ty.lIntN : jf.Code(Jvm.opc_lconst_0);
  1789. | Ty.sReaN : jf.Code(Jvm.opc_fconst_0);
  1790. | Ty.realN : jf.Code(Jvm.opc_dconst_0);
  1791. ELSE jf.Code(Jvm.opc_aconst_null);
  1792. END;
  1793. ELSE
  1794. jf.Code(Jvm.opc_aconst_null);
  1795. END;
  1796. jf.Return(ret);
  1797. END;
  1798. END PushJunkAndReturn;
  1799. (* ------------------------------------------------------------ *)
  1800. PROCEDURE (jf : JavaFile)Init1dArray*(elTp : Sym.Type; leng : INTEGER),NEW;
  1801. CONST inlineLimit = 4;
  1802. VAR indx : INTEGER;
  1803. labl : Label;
  1804. arrT : Ty.Array;
  1805. BEGIN
  1806. (*
  1807. * Precondition: elTp is either a record or fixed array.
  1808. * At entry stack is (top) arrayRef, unchanged at exit.
  1809. * (len == 0) ==> take length from runtime descriptor.
  1810. *)
  1811. IF (leng < 4) & (leng # 0) & (elTp.kind = Ty.recTp) THEN
  1812. (*
  1813. * Do a compile-time loop ...
  1814. *)
  1815. FOR indx := 0 TO leng-1 DO
  1816. jf.Code(Jvm.opc_dup);
  1817. jf.PushInt(indx);
  1818. jf.MkNewRecord(elTp(Ty.Record));
  1819. jf.Code(Jvm.opc_aastore);
  1820. END;
  1821. ELSE
  1822. (* ------------------------------------------------------ *
  1823. * Do a runtime loop ...
  1824. *
  1825. * push-len> ; (top) len, ref,...
  1826. * loop:
  1827. * iconst_1 ; (top) 1, len, ref,...
  1828. * isub ; (top) len*, ref,...
  1829. * dup2 ; (top) len*, ref, len*, ref,...
  1830. * <newElem> ; (top) new, len*, ref, len*, ref,...
  1831. * aastore ; (top) len*, ref,...
  1832. * dup ; (top) len*, len*, ref,...
  1833. * ifne loop ; (top) len*, ref,...
  1834. * pop ; (top) ref, ...
  1835. * ------------------------------------------------------ *)
  1836. IF leng = 0 THEN (* find the length from the descriptor *)
  1837. jf.Code(Jvm.opc_dup);
  1838. jf.Code(Jvm.opc_arraylength);
  1839. ELSE
  1840. jf.PushInt(leng);
  1841. END;
  1842. labl := jf.newLoopheaderLabel();
  1843. jf.DefLabC(labl, "1-d init loop");
  1844. jf.Code(Jvm.opc_iconst_1);
  1845. jf.Code(Jvm.opc_isub);
  1846. jf.Code(Jvm.opc_dup2);
  1847. IF elTp.kind = Ty.recTp THEN
  1848. jf.MkNewRecord(elTp(Ty.Record));
  1849. ELSE
  1850. arrT := elTp(Ty.Array);
  1851. jf.MkNewFixedArray(arrT.elemTp, arrT.length);
  1852. END;
  1853. jf.Code(Jvm.opc_aastore);
  1854. jf.Code(Jvm.opc_dup);
  1855. jf.CodeLb(Jvm.opc_ifne, labl);
  1856. jf.CodeC(Jvm.opc_pop, " ; end 1-d loop");
  1857. END;
  1858. END Init1dArray;
  1859. (* ============================================================ *)
  1860. PROCEDURE (jf : JavaFile)InitNdArray*(desc : Sym.Type; elTp : Sym.Type),NEW;
  1861. VAR labl : Label;
  1862. BEGIN
  1863. (* ------------------------------------------------------ *
  1864. * Initialize multi-dimensional array, using
  1865. * the runtime array descriptors to generate lengths.
  1866. * Here, desc is the outer element type; elTp
  1867. * most nested type.
  1868. *
  1869. * At entry stack is (top) arrayRef, unchanged at exit.
  1870. *
  1871. * dup ; (top) ref,ref...
  1872. * arraylength ; (top) len,ref...
  1873. * loop:
  1874. * iconst_1 ; (top) 1,len,ref...
  1875. * isub ; (top) len',ref...
  1876. * dup2 ; (top) hi,ref,hi,ref...
  1877. * if (desc == elTp)
  1878. * <eleminit> ; (top) rec,ref[i],hi,ref...
  1879. * aastore ; (top) hi,ref...
  1880. * else
  1881. * aaload ; (top) ref[i],hi,ref...
  1882. * <recurse> ; (top) ref[i],hi,ref...
  1883. * pop ; (top) hi,ref...
  1884. * endif
  1885. * dup ; (top) hi,hi,ref...
  1886. * ifne loop ; (top) hi,ref...
  1887. * pop ; (top) ref...
  1888. * ------------------------------------------------------ *)
  1889. labl := jf.newLoopheaderLabel();
  1890. jf.Code(Jvm.opc_dup);
  1891. jf.Code(Jvm.opc_arraylength);
  1892. jf.DefLabC(labl, "Element init loop");
  1893. jf.Code(Jvm.opc_iconst_1);
  1894. jf.Code(Jvm.opc_isub);
  1895. jf.Code(Jvm.opc_dup2);
  1896. IF desc = elTp THEN
  1897. (*
  1898. * This is the innermost loop!
  1899. *)
  1900. WITH elTp : Ty.Array DO
  1901. (*
  1902. * Must be switching from open to fixed arrays...
  1903. *)
  1904. jf.MkNewFixedArray(elTp.elemTp, elTp.length);
  1905. | elTp : Ty.Record DO
  1906. (*
  1907. * Element type is some record type.
  1908. *)
  1909. jf.MkNewRecord(elTp);
  1910. END;
  1911. jf.Code(Jvm.opc_aastore);
  1912. ELSE
  1913. (*
  1914. * There are more dimensions to go ... so recurse down.
  1915. *)
  1916. jf.Code(Jvm.opc_aaload);
  1917. jf.InitNdArray(desc(Ty.Array).elemTp, elTp);
  1918. jf.Code(Jvm.opc_pop);
  1919. END;
  1920. jf.Code(Jvm.opc_dup);
  1921. jf.CodeLb(Jvm.opc_ifne, labl);
  1922. jf.CodeC(Jvm.opc_pop, " ; end loop");
  1923. END InitNdArray;
  1924. (* ============================================================ *)
  1925. PROCEDURE (jf : JavaFile)ValArrCopy*(typ : Ty.Array),NEW;
  1926. VAR local : INTEGER;
  1927. sTemp : INTEGER;
  1928. label : Label;
  1929. elTyp : Sym.Type;
  1930. BEGIN
  1931. (*
  1932. * Stack at entry is (top) srcRef, dstRef...
  1933. *)
  1934. label := jf.newLoopheaderLabel();
  1935. local := jf.newLocal( Blt.intTp );
  1936. IF typ.length = 0 THEN (* open array, get length from source desc *)
  1937. jf.Code(Jvm.opc_dup);
  1938. jf.Code(Jvm.opc_arraylength);
  1939. ELSE
  1940. jf.PushInt(typ.length);
  1941. END;
  1942. jf.StoreLocal(local, Blt.intTp);
  1943. (*
  1944. * <get length> ; (top) n,rr,lr...
  1945. * store(n) ; (top) rr,lr...
  1946. * lab:
  1947. * dup2 ; (top) rr,lr,rr,lr...
  1948. * iinc n -1 ; (top) rr,lr...
  1949. * load(n) ; (top) n,rr,lr,rr,lr...
  1950. * dup_x1 ; (top) n,rr,n,lr,rr,lr...
  1951. * <doassign> ; (top) rr,lr
  1952. * load(n) ; (top) n,rr,lr...
  1953. * ifne lab ; (top) rr,lr...
  1954. * pop2 ; (top) ...
  1955. *)
  1956. jf.DefLab(label); (* *)
  1957. jf.Code(Jvm.opc_dup2);
  1958. jf.CodeInc(local, -1);
  1959. jf.LoadLocal(local, Blt.intTp);
  1960. jf.Code(Jvm.opc_dup_x1);
  1961. (*
  1962. * Assign the element
  1963. *)
  1964. elTyp := typ.elemTp;
  1965. jf.GetElement(elTyp); (* (top) r[n],n,lr,rr,lr... *)
  1966. IF (elTyp.kind = Ty.arrTp) OR
  1967. (elTyp.kind = Ty.recTp) THEN
  1968. sTemp := jf.newLocal( elTyp );
  1969. jf.StoreLocal(sTemp, elTyp); (* (top) n,lr,rr,lr... *)
  1970. jf.GetElement(elTyp); (* (top) l{n],rr,lr... *)
  1971. jf.LoadLocal(sTemp, elTyp); (* (top) r[n],l[n],rr,lr... *)
  1972. jf.PopLocal();
  1973. WITH elTyp : Ty.Record DO
  1974. jf.ValRecCopy(elTyp);
  1975. | elTyp : Ty.Array DO
  1976. jf.ValArrCopy(elTyp);
  1977. END;
  1978. ELSE
  1979. jf.PutElement(elTyp);
  1980. END;
  1981. (*
  1982. * stack is (top) rr,lr...
  1983. *)
  1984. jf.LoadLocal(local, Blt.intTp);
  1985. jf.CodeLb(Jvm.opc_ifne, label);
  1986. jf.Code(Jvm.opc_pop2);
  1987. jf.PopLocal();
  1988. END ValArrCopy;
  1989. (* ============================================================ *)
  1990. PROCEDURE (jf : JavaFile)InitVars*(scp : Sym.Scope),NEW;
  1991. VAR index : INTEGER;
  1992. xhrNo : INTEGER;
  1993. scalr : BOOLEAN;
  1994. ident : Sym.Idnt;
  1995. xhrTp : Sym.Type;
  1996. xhrRc : Ty.Record;
  1997. BEGIN
  1998. xhrNo := 0;
  1999. xhrTp := NIL; (* To shut up the default-warning *)
  2000. (*
  2001. * Create the explicit activation record, if needed.
  2002. *)
  2003. WITH scp : Id.Procs DO
  2004. IF Id.hasXHR IN scp.pAttr THEN
  2005. xhrNo := scp.type(Ty.Procedure).argN;
  2006. xhrTp := scp.xhrType;
  2007. jf.Comment("create XHR record");
  2008. jf.MkNewRecord(xhrTp.boundRecTp()(Ty.Record));
  2009. IF scp.lxDepth > 0 THEN
  2010. xhrRc := xhrTp.boundRecTp()(Ty.Record);
  2011. jf.Code(Jvm.opc_dup);
  2012. jf.AloadLocal( 0, xhrTp );
  2013. jf.PutGetF( Jvm.opc_putfield, xhrRc, CSt.xhrId );
  2014. END;
  2015. jf.StoreLocal(xhrNo, NIL); (* ==> use astore *)
  2016. END;
  2017. ELSE (* skip *)
  2018. END;
  2019. (*
  2020. * Initialize local fields, if needed
  2021. *)
  2022. FOR index := 0 TO scp.locals.tide-1 DO
  2023. ident := scp.locals.a[index];
  2024. scalr := ident.type.isScalarType();
  2025. WITH ident : Id.ParId DO
  2026. (*
  2027. * If any args are uplevel addressed, they must
  2028. * be copied to the correct field of the XHR.
  2029. * The test "varOrd < xhrNo" excludes out params.
  2030. *)
  2031. IF (Id.uplevA IN ident.locAtt) & (ident.varOrd < xhrNo) THEN
  2032. jf.LoadLocal(xhrNo, xhrTp);
  2033. jf.LoadLocal(ident.varOrd, ident.type);
  2034. jf.PutGetX(Jvm.opc_putfield, ident);
  2035. END;
  2036. | ident : Id.LocId DO
  2037. IF ~scalr THEN
  2038. IF Id.uplevA IN ident.locAtt THEN jf.LoadLocal(xhrNo, xhrTp) END;
  2039. jf.VarInit(ident);
  2040. jf.PutLocal(ident);
  2041. END;
  2042. | ident : Id.VarId DO
  2043. IF ~scalr THEN
  2044. jf.VarInit(ident);
  2045. jf.PutGetS(Jvm.opc_putstatic, scp(Id.BlkId), ident);
  2046. END;
  2047. END;
  2048. END;
  2049. END InitVars;
  2050. (* ============================================================ *)
  2051. PROCEDURE Init*();
  2052. BEGIN
  2053. xhrIx := 0;
  2054. InitVecDescriptors();
  2055. END Init;
  2056. (* ============================================================ *)
  2057. (* ============================================================ *)
  2058. BEGIN
  2059. invokeHash := Hsh.enterStr("Invoke");
  2060. L.InitCharOpenSeq(fmArray, 8);
  2061. L.InitCharOpenSeq(nmArray, 8);
  2062. typeRetn[ Ty.boolN] := Jvm.opc_ireturn;
  2063. typeRetn[ Ty.sChrN] := Jvm.opc_ireturn;
  2064. typeRetn[ Ty.charN] := Jvm.opc_ireturn;
  2065. typeRetn[ Ty.byteN] := Jvm.opc_ireturn;
  2066. typeRetn[ Ty.sIntN] := Jvm.opc_ireturn;
  2067. typeRetn[ Ty.intN] := Jvm.opc_ireturn;
  2068. typeRetn[ Ty.lIntN] := Jvm.opc_lreturn;
  2069. typeRetn[ Ty.sReaN] := Jvm.opc_freturn;
  2070. typeRetn[ Ty.realN] := Jvm.opc_dreturn;
  2071. typeRetn[ Ty.setN] := Jvm.opc_ireturn;
  2072. typeRetn[Ty.anyPtr] := Jvm.opc_areturn;
  2073. typeRetn[ Ty.uBytN] := Jvm.opc_ireturn;
  2074. typeLoad[ Ty.boolN] := Jvm.opc_iload;
  2075. typeLoad[ Ty.sChrN] := Jvm.opc_iload;
  2076. typeLoad[ Ty.charN] := Jvm.opc_iload;
  2077. typeLoad[ Ty.byteN] := Jvm.opc_iload;
  2078. typeLoad[ Ty.sIntN] := Jvm.opc_iload;
  2079. typeLoad[ Ty.intN] := Jvm.opc_iload;
  2080. typeLoad[ Ty.lIntN] := Jvm.opc_lload;
  2081. typeLoad[ Ty.sReaN] := Jvm.opc_fload;
  2082. typeLoad[ Ty.realN] := Jvm.opc_dload;
  2083. typeLoad[ Ty.setN] := Jvm.opc_iload;
  2084. typeLoad[Ty.anyPtr] := Jvm.opc_aload;
  2085. typeLoad[Ty.anyRec] := Jvm.opc_aload;
  2086. typeLoad[ Ty.uBytN] := Jvm.opc_iload;
  2087. typeStore[ Ty.boolN] := Jvm.opc_istore;
  2088. typeStore[ Ty.sChrN] := Jvm.opc_istore;
  2089. typeStore[ Ty.charN] := Jvm.opc_istore;
  2090. typeStore[ Ty.byteN] := Jvm.opc_istore;
  2091. typeStore[ Ty.sIntN] := Jvm.opc_istore;
  2092. typeStore[ Ty.intN] := Jvm.opc_istore;
  2093. typeStore[ Ty.lIntN] := Jvm.opc_lstore;
  2094. typeStore[ Ty.sReaN] := Jvm.opc_fstore;
  2095. typeStore[ Ty.realN] := Jvm.opc_dstore;
  2096. typeStore[ Ty.setN] := Jvm.opc_istore;
  2097. typeStore[Ty.anyPtr] := Jvm.opc_astore;
  2098. typeStore[Ty.anyRec] := Jvm.opc_astore;
  2099. typeStore[ Ty.uBytN] := Jvm.opc_istore;
  2100. typePutE[ Ty.boolN] := Jvm.opc_bastore;
  2101. typePutE[ Ty.sChrN] := Jvm.opc_castore;
  2102. typePutE[ Ty.charN] := Jvm.opc_castore;
  2103. typePutE[ Ty.byteN] := Jvm.opc_bastore;
  2104. typePutE[ Ty.sIntN] := Jvm.opc_sastore;
  2105. typePutE[ Ty.intN] := Jvm.opc_iastore;
  2106. typePutE[ Ty.lIntN] := Jvm.opc_lastore;
  2107. typePutE[ Ty.sReaN] := Jvm.opc_fastore;
  2108. typePutE[ Ty.realN] := Jvm.opc_dastore;
  2109. typePutE[ Ty.setN] := Jvm.opc_iastore;
  2110. typePutE[Ty.anyPtr] := Jvm.opc_aastore;
  2111. typePutE[Ty.anyRec] := Jvm.opc_aastore;
  2112. typePutE[ Ty.uBytN] := Jvm.opc_bastore;
  2113. typeGetE[ Ty.boolN] := Jvm.opc_baload;
  2114. typeGetE[ Ty.sChrN] := Jvm.opc_caload;
  2115. typeGetE[ Ty.charN] := Jvm.opc_caload;
  2116. typeGetE[ Ty.byteN] := Jvm.opc_baload;
  2117. typeGetE[ Ty.sIntN] := Jvm.opc_saload;
  2118. typeGetE[ Ty.intN] := Jvm.opc_iaload;
  2119. typeGetE[ Ty.lIntN] := Jvm.opc_laload;
  2120. typeGetE[ Ty.sReaN] := Jvm.opc_faload;
  2121. typeGetE[ Ty.realN] := Jvm.opc_daload;
  2122. typeGetE[ Ty.setN] := Jvm.opc_iaload;
  2123. typeGetE[Ty.anyPtr] := Jvm.opc_aaload;
  2124. typeGetE[Ty.anyRec] := Jvm.opc_aaload;
  2125. typeGetE[ Ty.uBytN] := Jvm.opc_baload;
  2126. boxTp[ Ty.boolN ] := Ty.mkArrayOf( Blt.boolTp );
  2127. boxTp[ Ty.sChrN ] := Ty.mkArrayOf( Blt.charTp );
  2128. boxTp[ Ty.charN ] := boxTp[Ty.sChrN];
  2129. boxTp[ Ty.byteN ] := Ty.mkArrayOf( Blt.byteTp );
  2130. boxTp[ Ty.sIntN ] := Ty.mkArrayOf( Blt.sIntTp );
  2131. boxTp[ Ty.intN ] := Ty.mkArrayOf( Blt.intTp );
  2132. boxTp[ Ty.lIntN ] := Ty.mkArrayOf( Blt.lIntTp );
  2133. boxTp[ Ty.sReaN ] := Ty.mkArrayOf( Blt.sReaTp );
  2134. boxTp[ Ty.realN ] := Ty.mkArrayOf( Blt.realTp );
  2135. boxTp[ Ty.setN ] := boxTp[Ty.intN];
  2136. boxTp[ Ty.anyRec ] := NIL;
  2137. boxTp[ Ty.anyPtr ] := NIL;
  2138. boxTp[ Ty.strN ] := NIL;
  2139. boxTp[ Ty.sStrN ] := NIL;
  2140. boxTp[ Ty.uBytN ] := Ty.mkArrayOf( Blt.uBytTp );
  2141. boxTp[ Ty.metaN ] := NIL;
  2142. semi := L.strToCharOpen(";");
  2143. comma := L.strToCharOpen(",");
  2144. colon := L.strToCharOpen(":");
  2145. lPar := L.strToCharOpen("(");
  2146. rPar := L.strToCharOpen(")");
  2147. brac := L.strToCharOpen("[");
  2148. lCap := L.strToCharOpen("L");
  2149. void := L.strToCharOpen("V");
  2150. rParV:= L.strToCharOpen(")V");
  2151. lowL := L.strToCharOpen("_");
  2152. slsh := L.strToCharOpen("/");
  2153. dlar := L.strToCharOpen("$");
  2154. prfx := L.strToCharOpen(classPrefix);
  2155. xhrDl := L.strToCharOpen("XHR$");
  2156. xhrMk := L.strToCharOpen("LCP/CPJrts/XHR;");
  2157. xhrPtr := CSt.rtsXHR;
  2158. xhrRec := xhrPtr.boundRecTp()(Ty.Record);
  2159. procLitPrefix := L.strToCharOpen("Proc$Lit$");
  2160. Blt.setTp.xName := L.strToCharOpen("I");
  2161. Blt.intTp.xName := L.strToCharOpen("I");
  2162. Blt.boolTp.xName := L.strToCharOpen("Z");
  2163. Blt.byteTp.xName := L.strToCharOpen("B");
  2164. Blt.uBytTp.xName := L.strToCharOpen("B"); (* same as BYTE *)
  2165. Blt.charTp.xName := L.strToCharOpen("C");
  2166. Blt.sChrTp.xName := L.strToCharOpen("C");
  2167. Blt.sIntTp.xName := L.strToCharOpen("S");
  2168. Blt.lIntTp.xName := L.strToCharOpen("J");
  2169. Blt.realTp.xName := L.strToCharOpen("D");
  2170. Blt.sReaTp.xName := L.strToCharOpen("F");
  2171. Blt.anyRec.xName := L.strToCharOpen("Ljava/lang/Object;");
  2172. Blt.anyPtr.xName := Blt.anyRec.xName;
  2173. END JavaUtil.
  2174. (* ============================================================ *)
  2175. (* ============================================================ *)