FoxBinarySymbolFile.Mod 86 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467
  1. MODULE FoxBinarySymbolFile; (** AUTHOR "fof"; PURPOSE "Symbol File - Binary Format"; *)
  2. IMPORT
  3. Basic := FoxBasic, Scanner := FoxScanner, SyntaxTree := FoxSyntaxTree, Global := FoxGlobal,
  4. Files,Streams, Kernel, SYSTEM, D := Debugging, Diagnostics, Options, Formats := FoxFormats, InterfaceComparison := FoxInterfaceComparison
  5. ,Commands, Printout := FoxPrintout, SemanticChecker := FoxSemanticChecker,
  6. Machine
  7. ;
  8. (** Symbol File Format
  9. SymbolFile = codeOptions:RawSet
  10. Imports
  11. [sfSysFlag sysFlags:RawNum]
  12. [sfConst {Symbol Value}]
  13. [sfVar {Symbol}]
  14. [sfXProcedure {Symbol ParameterList}]
  15. [sfOperator {Symbol ParameterList [sfInline Inline]}]
  16. [sfCProcedure {Symbol ParameterList Inline}]
  17. [sfAlias {Type name:RawString}]
  18. [sfType {Type}]
  19. sfEnd.
  20. Imports = {moduleName:RawString} 0X
  21. Symbol = [sfObjFlag flag:RawNum] [sfReadOnly]
  22. Type name:RawString
  23. Value = [ RawNum | RawHInt | RawReal | RawLReal | RawString ]
  24. Type = TypeReference
  25. | BasicType
  26. | ImportedType
  27. | UserType.
  28. TypeReference = number<0:RawNum
  29. BasicType = sfTypeBoolean | .. | sfLastType.
  30. ImportedType = ModuleNumber (structName:RawString | 0X typeIndex:RawNum)
  31. ModuleNumber = sfMod1 | .. | sfModOther-1 | sfModOther moduleNumber:RawNum
  32. UserType = [sfInvisible] [sfSysFlag sysFlag:RawNum] UserType2
  33. UserType2 = sfTypeOpenArray baseType:Type name:RawString
  34. | sfTypeStaticArray baseType:Type name:RawString length:RawNum
  35. | sfTypePointer baseType:Type name:RawString
  36. | sfTypeRecord baseType:Type name:RawString Record
  37. | sfTypeProcedure baseType:Type name:RawString flags:RawNum
  38. ParameterList
  39. Record = mode:RawNum priority:Char {variable:Symbol}
  40. [sfTProcedure {Symbol [name:RawString] ParameterList [sfInline Inline]} ]
  41. sfEnd.
  42. ParameterList = {
  43. [sfObjflag ( sfCParam | sfDarwinCParam | sfWinAPIParam )]
  44. [sfVar] [sfReadOnly] Type name:RawString
  45. } sfEnd.
  46. Inline = {len:Char {c:Char}} 0X.
  47. *)
  48. CONST
  49. TraceImport=0;
  50. TraceExport=1;
  51. Trace = {} ;
  52. (* FoxProgTools.Enum --start=1 sfTypeBoolean sfTypeChar8 sfTypeChar16 sfTypeChar32
  53. sfTypeShortint sfTypeInteger sfTypeLongint sfTypeHugeint sfTypeReal sfTypeLongreal sfTypeSet
  54. sfTypeString sfTypeNoType sfTypeNilType sfTypeByte sfTypeSptr sfMod1 ~
  55. FoxProgTools.Enum --start=2DH --hex sfModOther sfTypeOpenArray sfTypeStaticArray sfTypePointer sfTypeRecord sfTypeProcedure
  56. sfSysFlag sfInvisible sfReadOnly sfObjFlag sfConst sfVar sfLProcedure sfXProcedure sfOperator sfTProcedure sfCProcedure sfAlias sfType sfEnd ~
  57. *)
  58. sfTypeBoolean= 1;
  59. sfTypeChar8= 2;
  60. sfTypeChar16= 3;
  61. sfTypeChar32= 4;
  62. sfTypeShortint= 5;
  63. sfTypeInteger= 6;
  64. sfTypeLongint= 7;
  65. sfTypeHugeint = 8;
  66. sfTypeReal = 9;
  67. sfTypeLongreal = 10;
  68. sfTypeSet = 11;
  69. sfTypeString = 12;
  70. sfTypeNoType = 13;
  71. sfTypeNilType = 14;
  72. sfTypeByte = 15;
  73. sfTypeAny = 16;
  74. sfTypeObject = 17;
  75. sfTypeAddress= 18;
  76. sfTypeSize = 19;
  77. sfTypeUnsigned8=20;
  78. sfTypeUnsigned16=21;
  79. sfTypeUnsigned32=22;
  80. sfTypeUnsigned64=23;
  81. sfLastType = 23;
  82. sfMod1 = sfLastType+1;
  83. sfModOther=2DH;
  84. sfTypeOpenArray=2EH;
  85. (*
  86. sfTypeDynamicArray=2FH;
  87. *)
  88. sfTypeStaticArray=30H;
  89. sfTypePointer=31H;
  90. sfTypeRecord=32H;
  91. sfTypeProcedure=33H;
  92. sfSysFlag=34H;
  93. sfInvisible=35H;
  94. sfReadOnly=36H;
  95. sfObjFlag = 37H; (* fof: very (!) bad idea to have same number for two type flags *)
  96. sfConst=37H;
  97. sfVar=38H;
  98. sfTypeEnumeration=39H;
  99. (*
  100. sfLProcedure=39H;
  101. *)
  102. sfXProcedure=3AH;
  103. sfOperator=3BH;
  104. sfTProcedure=3CH;
  105. sfCProcedure = sfTProcedure;
  106. sfAlias=3DH;
  107. sfType=3EH;
  108. sfEnd= 3FH;
  109. sfTypeOpenMathArray = 40H;
  110. sfTypeTensor=42H;
  111. sfTypeStaticMathArray = 43H;
  112. sfTypeAll = 44H;
  113. sfTypeRange = 45H;
  114. sfTypeComplex = 46H;
  115. sfTypeLongcomplex = 47H;
  116. (* workaround: handle inlined operators *)
  117. sfInline = 0ABH;
  118. sfProtected = 0;
  119. sfActive=1;
  120. sfSafe=2;
  121. sfClass=16;
  122. sfDelegate = 5;
  123. sfUntraced = 4;
  124. sfWinAPIParam = 13; (* ejz *)
  125. sfCParam= 14; (* fof for linux *)
  126. sfDarwinCParam= 15; (* fld for darwin *)
  127. sfRealtime= 21;
  128. sfDynamic = 22;
  129. sfUnsafe= 23;
  130. sfDisposable= 24;
  131. Undef=MIN(LONGINT);
  132. CONST
  133. FileTag = 0BBX; (* same constants are defined in Linker and AosLoader *)
  134. NoZeroCompress = 0ADX; (* do. *)
  135. FileVersion* = 0B1X; (* do. *)
  136. FileVersionOC*=0B2X;
  137. FileVersionCurrent*=0B4X;
  138. TYPE
  139. (* TypeReference provides a link between a type and a number for the purpose of late fixes while importing.
  140. When a type number is encountered while importing, a type reference will be used as a placeholder for the final type.
  141. After the import process has collected all types, the references are replaced by the referenced types (cf. Resolver Object) *)
  142. TypeReference = OBJECT (SyntaxTree.Type)
  143. VAR nr: LONGINT;
  144. PROCEDURE & InitTypeReference(nr: LONGINT);
  145. BEGIN
  146. InitType(-1); SELF.nr := nr;
  147. END InitTypeReference;
  148. END TypeReference;
  149. (* IndexToType provides a link between numbers and a type. Lists like this are typically filled while importing and provide the base
  150. for the type resolving, cf. Resolver below
  151. *)
  152. IndexToType= OBJECT(Basic.List)
  153. PROCEDURE PutType(nr: LONGINT; type: SyntaxTree.Type);
  154. BEGIN GrowAndSet(nr,type);
  155. END PutType;
  156. PROCEDURE GetType(nr: LONGINT): SyntaxTree.Type;
  157. VAR node: ANY;
  158. BEGIN node := Get(nr); IF node = NIL THEN RETURN NIL ELSE RETURN node(SyntaxTree.Type) END;
  159. END GetType;
  160. END IndexToType;
  161. LateFix= POINTER TO RECORD (* contains a late fix to be resolved in a later step: type fixes and implementations *)
  162. p: ANY; (*scope: SyntaxTree.Scope;*)
  163. next: LateFix;
  164. END;
  165. LateFixList = OBJECT (* fifo queue for items to be resolved later on - deferred fixes *)
  166. VAR first,last: LateFix;
  167. PROCEDURE & Init;
  168. BEGIN first := NIL; last := NIL;
  169. END Init;
  170. (* get and remove element from list *)
  171. PROCEDURE Get((*VAR scope: SyntaxTree.Scope*)): ANY;
  172. VAR p: ANY;
  173. BEGIN
  174. IF first # NIL THEN p := first.p; (*scope := first.scope;*) first := first.next ELSE p := NIL; END;
  175. IF first = NIL THEN last := NIL END;
  176. RETURN p;
  177. END Get;
  178. (* add unresolved type to list *)
  179. PROCEDURE Add(p: ANY (*; scope: SyntaxTree.Scope*));
  180. VAR next: LateFix;
  181. BEGIN
  182. (*ASSERT(scope # NIL);*)
  183. NEW(next); next.p := p; (* next.scope := scope;*)
  184. next.next := NIL;
  185. IF first = NIL THEN first := next; last := next;
  186. ELSE last.next := next; last := next
  187. END;
  188. END Add;
  189. END LateFixList;
  190. (*
  191. The resolver object is used to replace type references in a SyntaxTree.Module tree with the respective types from a given type list.
  192. To do so, the resolver traverses the module tree partially with direct procedural recursion and partially using the visitor pattern.
  193. *)
  194. Resolver=OBJECT (SyntaxTree.Visitor)
  195. VAR typeList: IndexToType; system: Global.System; typeFixes: LateFixList;
  196. checker: SemanticChecker.Checker;
  197. PROCEDURE & Init(system: Global.System; symbolFile: BinarySymbolFile; importCache: SyntaxTree.ModuleScope);
  198. VAR streamDiagnostics: Diagnostics.StreamDiagnostics;
  199. BEGIN
  200. typeList := NIL; SELF.system := system; NEW(typeFixes);
  201. NEW(streamDiagnostics, D.Log);
  202. checker := SemanticChecker.NewChecker(streamDiagnostics,FALSE,FALSE,TRUE,system,symbolFile,importCache);
  203. END Init;
  204. (* types that do not refer to other types *)
  205. PROCEDURE VisitType(x: SyntaxTree.Type);
  206. BEGIN END VisitType;
  207. PROCEDURE VisitBasicType(x: SyntaxTree.BasicType);
  208. BEGIN END VisitBasicType;
  209. PROCEDURE VisitByteType(x: SyntaxTree.ByteType);
  210. BEGIN END VisitByteType;
  211. PROCEDURE VisitBooleanType(x: SyntaxTree.BooleanType);
  212. BEGIN END VisitBooleanType;
  213. PROCEDURE VisitSetType(x: SyntaxTree.SetType);
  214. BEGIN END VisitSetType;
  215. PROCEDURE VisitAddressType(x: SyntaxTree.AddressType);
  216. BEGIN END VisitAddressType;
  217. PROCEDURE VisitSizeType(x: SyntaxTree.SizeType);
  218. BEGIN END VisitSizeType;
  219. PROCEDURE VisitAnyType(x: SyntaxTree.AnyType);
  220. BEGIN END VisitAnyType;
  221. PROCEDURE VisitObjectType(x: SyntaxTree.ObjectType);
  222. BEGIN END VisitObjectType;
  223. PROCEDURE VisitNilType(x: SyntaxTree.NilType);
  224. BEGIN END VisitNilType;
  225. PROCEDURE VisitCharacterType(x: SyntaxTree.CharacterType);
  226. BEGIN END VisitCharacterType;
  227. PROCEDURE VisitIntegerType(x: SyntaxTree.IntegerType);
  228. BEGIN END VisitIntegerType;
  229. PROCEDURE VisitFloatType(x: SyntaxTree.FloatType);
  230. BEGIN END VisitFloatType;
  231. PROCEDURE VisitComplexType(x: SyntaxTree.ComplexType);
  232. BEGIN END VisitComplexType;
  233. PROCEDURE VisitQualifiedType(x: SyntaxTree.QualifiedType);
  234. BEGIN
  235. x.SetResolved(ResolveType(x.resolved))
  236. END VisitQualifiedType;
  237. PROCEDURE VisitStringType(x: SyntaxTree.StringType);
  238. BEGIN END VisitStringType;
  239. PROCEDURE VisitRangeType(x: SyntaxTree.RangeType);
  240. BEGIN END VisitRangeType;
  241. (* types containing links to other types *)
  242. (**
  243. check enumeration scope: enter symbols and check for duplicate names
  244. **)
  245. PROCEDURE CheckEnumerationScope(x: SyntaxTree.EnumerationScope);
  246. VAR e: SyntaxTree.Constant; lowest, highest,value: LONGINT;
  247. BEGIN
  248. lowest := 0; highest := 0;
  249. e := x.firstConstant;
  250. WHILE (e # NIL) DO
  251. e.SetType(x.ownerEnumeration);
  252. e.SetState(SyntaxTree.Resolved);
  253. value := e.value(SyntaxTree.EnumerationValue).value;
  254. IF value < lowest THEN lowest := value END;
  255. IF value > highest THEN highest := value END;
  256. e := e.nextConstant;
  257. END;
  258. x.ownerEnumeration.SetRange(lowest,highest);
  259. END CheckEnumerationScope;
  260. (**
  261. resolve enumeration type: check enumeration scope
  262. **)
  263. PROCEDURE VisitEnumerationType(x: SyntaxTree.EnumerationType);
  264. VAR baseScope: SyntaxTree.EnumerationScope; resolved: SyntaxTree.Type; enumerationBase: SyntaxTree.EnumerationType;
  265. BEGIN
  266. x.SetEnumerationBase(ResolveType(x.enumerationBase));
  267. IF x.enumerationBase # NIL THEN
  268. resolved := x.enumerationBase.resolved;
  269. enumerationBase := resolved(SyntaxTree.EnumerationType);
  270. baseScope := enumerationBase.enumerationScope;
  271. END;
  272. CheckEnumerationScope(x.enumerationScope);
  273. x.SetState(SyntaxTree.Resolved);
  274. END VisitEnumerationType;
  275. PROCEDURE VisitArrayType(arrayType: SyntaxTree.ArrayType);
  276. BEGIN
  277. ASSERT(arrayType.arrayBase # NIL);
  278. arrayType.SetArrayBase(ResolveType(arrayType.arrayBase));
  279. arrayType.SetHasPointers(arrayType.arrayBase.resolved.hasPointers);
  280. arrayType.SetState(SyntaxTree.Resolved);
  281. END VisitArrayType;
  282. PROCEDURE VisitMathArrayType(arrayType: SyntaxTree.MathArrayType);
  283. BEGIN
  284. arrayType.SetArrayBase(ResolveType(arrayType.arrayBase));
  285. IF arrayType.form = SyntaxTree.Static THEN
  286. arrayType.SetIncrement(system.SizeOf(arrayType.arrayBase));
  287. arrayType.SetHasPointers(arrayType.arrayBase.resolved.hasPointers);
  288. ELSE
  289. arrayType.SetHasPointers(TRUE)
  290. END;
  291. arrayType.SetState(SyntaxTree.Resolved);
  292. END VisitMathArrayType;
  293. PROCEDURE VisitPointerType(pointerType: SyntaxTree.PointerType);
  294. VAR recordType: SyntaxTree.RecordType;
  295. BEGIN
  296. IF ~(SyntaxTree.Resolved IN pointerType.state) THEN
  297. typeFixes.Add(pointerType);
  298. pointerType.SetState(SyntaxTree.Resolved);
  299. END;
  300. (*
  301. pointerType.SetPointerBase(ResolveType(pointerType.pointerBase));
  302. IF pointerType.pointerBase.resolved IS SyntaxTree.RecordType THEN
  303. recordType := pointerType.pointerBase.resolved(SyntaxTree.RecordType);
  304. IF (recordType.typeDeclaration = NIL) THEN
  305. recordType.SetPointerType(pointerType);
  306. recordType.SetTypeDeclaration(pointerType.typeDeclaration)
  307. END;
  308. END;
  309. pointerType.SetState(SyntaxTree.Resolved);
  310. *)
  311. END VisitPointerType;
  312. PROCEDURE FixPointerType(pointerType: SyntaxTree.PointerType);
  313. VAR recordType: SyntaxTree.RecordType;
  314. BEGIN
  315. pointerType.SetPointerBase(ResolveType(pointerType.pointerBase));
  316. IF pointerType.pointerBase.resolved IS SyntaxTree.RecordType THEN
  317. recordType := pointerType.pointerBase.resolved(SyntaxTree.RecordType);
  318. IF (recordType.typeDeclaration = NIL) THEN
  319. recordType.SetPointerType(pointerType);
  320. recordType.SetTypeDeclaration(pointerType.typeDeclaration)
  321. END;
  322. END;
  323. END FixPointerType;
  324. PROCEDURE VisitRecordType(recordType: SyntaxTree.RecordType);
  325. VAR recordBase: SyntaxTree.RecordType; numberMethods: LONGINT; procedure,super,testsuper: SyntaxTree.Procedure; recordScope: SyntaxTree.RecordScope;
  326. pointerType: SyntaxTree.Type; typeDeclaration: SyntaxTree.TypeDeclaration; symbol: SyntaxTree.Symbol; size: HUGEINT; hasPointer: BOOLEAN;
  327. var: SyntaxTree.Variable;
  328. BEGIN
  329. recordType.SetBaseType(ResolveType(recordType.baseType));
  330. recordScope := recordType.recordScope;
  331. recordBase := recordType.GetBaseRecord();
  332. hasPointer := FALSE;
  333. IF recordBase = NIL THEN numberMethods := 0;
  334. ELSE
  335. recordBase.Accept(SELF); numberMethods := recordBase.recordScope.numberMethods;
  336. END;
  337. symbol := recordScope.firstSymbol; (* must use the sorted list here, important! *)
  338. WHILE symbol # NIL DO
  339. IF (symbol IS SyntaxTree.Procedure) THEN
  340. procedure := symbol(SyntaxTree.Procedure);
  341. IF procedure IS SyntaxTree.Operator THEN FixProcedureType(procedure.type(SyntaxTree.ProcedureType)) END;
  342. super := SemanticChecker.FindSuperProcedure(recordScope, procedure);
  343. procedure.SetSuper(super);
  344. IF super # NIL THEN
  345. procedure.SetAccess(procedure.access+super.access);
  346. END;
  347. IF procedure.super # NIL THEN
  348. procedure.SetMethodNumber(procedure.super.methodNumber)
  349. ELSE
  350. procedure.SetMethodNumber(numberMethods);
  351. INC(numberMethods);
  352. END;
  353. END;
  354. symbol := symbol.nextSymbol;
  355. END;
  356. recordScope.SetNumberMethods(numberMethods);
  357. IF (recordScope.firstProcedure # NIL) OR (recordBase # NIL) & (recordBase.isObject) THEN
  358. recordType.IsObject(TRUE)
  359. END;
  360. IF (recordBase # NIL) & recordBase.hasPointers THEN hasPointer := TRUE END;
  361. Scope(recordType.recordScope);
  362. var := recordType.recordScope.firstVariable;
  363. WHILE var # NIL DO
  364. hasPointer := hasPointer OR var.type.resolved.hasPointers & ~var.untraced;
  365. var := var.nextVariable;
  366. END;
  367. recordType.SetHasPointers(hasPointer);
  368. checker.SetCurrentScope(recordType.recordScope);
  369. checker.ResolveArrayStructure(recordType);
  370. recordType.SetState(SyntaxTree.Resolved);
  371. size := system.SizeOf(recordType); (* generate field offsets *)
  372. IF (recordType.typeDeclaration = NIL) & (recordType.pointerType # NIL) THEN
  373. pointerType := recordType.pointerType.resolved;
  374. typeDeclaration := pointerType.typeDeclaration;
  375. recordType.SetTypeDeclaration(typeDeclaration);
  376. END;
  377. END VisitRecordType;
  378. PROCEDURE VisitProcedureType(procedureType: SyntaxTree.ProcedureType);
  379. VAR parameter: SyntaxTree.Parameter;
  380. BEGIN
  381. IF ~(SyntaxTree.Resolved IN procedureType.state) THEN
  382. typeFixes.Add(procedureType);
  383. IF procedureType.isDelegate THEN
  384. procedureType.SetHasPointers(TRUE);
  385. END;
  386. procedureType.SetState(SyntaxTree.Resolved);
  387. END;
  388. END VisitProcedureType;
  389. PROCEDURE FixProcedureType(procedureType: SyntaxTree.ProcedureType);
  390. VAR parameter: SyntaxTree.Parameter; returnType: SyntaxTree.Type;
  391. BEGIN
  392. (* parameter list *)
  393. parameter := procedureType.firstParameter;
  394. WHILE(parameter # NIL) DO
  395. parameter.SetType(ResolveType(parameter.type));
  396. parameter := parameter.nextParameter;
  397. END;
  398. (* return type *)
  399. returnType := ResolveType(procedureType.returnType);
  400. procedureType.SetReturnType(ResolveType(returnType));
  401. IF returnType# NIL THEN
  402. parameter := SyntaxTree.NewParameter(-1,procedureType,Global.ReturnParameterName,SyntaxTree.VarParameter);
  403. parameter.SetType(returnType);
  404. parameter.SetState(SyntaxTree.Resolved);
  405. procedureType.SetReturnParameter(parameter);
  406. END;
  407. END FixProcedureType;
  408. (* a type reference is resolved by replacing it with the respective element of the type list, all other types remain *)
  409. PROCEDURE ResolveType(type: SyntaxTree.Type): SyntaxTree.Type;
  410. BEGIN
  411. IF type = NIL THEN RETURN NIL
  412. ELSIF (type IS TypeReference) THEN
  413. type := typeList.GetType(type(TypeReference).nr);
  414. END;
  415. IF ~(SyntaxTree.Resolved IN type.state) THEN
  416. type.Accept(SELF);
  417. type.SetState(SyntaxTree.Resolved);
  418. END;
  419. RETURN type;
  420. END ResolveType;
  421. (** resolve all pending types (late resolving).
  422. - type fixes are resolved at the end of the declaration phase
  423. - type fixes may imply new type fixes that are also entered at the end of the list
  424. **)
  425. PROCEDURE FixTypes;
  426. VAR p: ANY; prevScope: SyntaxTree.Scope;
  427. BEGIN
  428. (*prevScope := currentScope;*)
  429. p := typeFixes.Get((*currentScope*));
  430. WHILE p # NIL DO
  431. ASSERT(p IS SyntaxTree.Type);
  432. IF p IS SyntaxTree.PointerType THEN
  433. FixPointerType(p(SyntaxTree.PointerType))
  434. ELSIF p IS SyntaxTree.ProcedureType THEN
  435. FixProcedureType(p(SyntaxTree.ProcedureType))
  436. ELSE
  437. HALT(100);
  438. END;
  439. p := typeFixes.Get((*currentScope*));
  440. END;
  441. (*currentScope :=prevScope;*)
  442. END FixTypes;
  443. (* scope traversal *)
  444. PROCEDURE Scope(scope: SyntaxTree.Scope);
  445. VAR typeDeclaration: SyntaxTree.TypeDeclaration; variable: SyntaxTree.Variable; procedure: SyntaxTree.Procedure;
  446. BEGIN
  447. (* type declarations *)
  448. typeDeclaration := scope.firstTypeDeclaration;
  449. WHILE(typeDeclaration # NIL) DO
  450. typeDeclaration.SetDeclaredType(ResolveType(typeDeclaration.declaredType));
  451. IF ~(typeDeclaration.declaredType IS SyntaxTree.BasicType) THEN
  452. typeDeclaration.declaredType.SetTypeDeclaration(typeDeclaration);
  453. END;
  454. typeDeclaration := typeDeclaration.nextTypeDeclaration;
  455. END;
  456. (* variables *)
  457. variable := scope.firstVariable;
  458. WHILE(variable # NIL) DO
  459. variable.SetType(ResolveType(variable.type));
  460. ASSERT (~(variable.type IS TypeReference));
  461. ASSERT(~(variable.type.resolved IS TypeReference));
  462. variable := variable.nextVariable;
  463. END;
  464. (* procedures *)
  465. procedure := scope.firstProcedure;
  466. WHILE(procedure # NIL) DO
  467. Scope(procedure.procedureScope);
  468. procedure.SetType(ResolveType(procedure.type));
  469. procedure := procedure.nextProcedure;
  470. END;
  471. END Scope;
  472. (* replace all TypeReferences in module by referenced types in typeList *)
  473. PROCEDURE Resolve(module: SyntaxTree.Module; typeList: IndexToType);
  474. BEGIN
  475. SELF.typeList := typeList;
  476. Scope(module.moduleScope);
  477. FixTypes;
  478. module.SetState(SyntaxTree.Resolved);
  479. END Resolve;
  480. END Resolver;
  481. (*
  482. An Index is the data structure containing a number to be mapped to types via the object TypeToIndex below.
  483. Used for type enumeration when exporting.
  484. *)
  485. Index =POINTER TO RECORD tag: LONGINT END;
  486. (*
  487. The TypeToIndex object provides the link between a type and a module and type number. It is the inverse of the IndexToType and is used
  488. for exporting. It is implemented using a hash table mapping a SyntaxTree.Type to a Index object.
  489. *)
  490. TypeToIndex= OBJECT (Basic.HashTable)
  491. PROCEDURE GetIndex(type: SyntaxTree.Type): LONGINT;
  492. VAR t:ANY;
  493. BEGIN
  494. t := Get(type);
  495. IF t # NIL THEN RETURN t(Index).tag ELSE RETURN Undef END;
  496. END GetIndex;
  497. PROCEDURE PutIndex(type:SyntaxTree.Type; nr: LONGINT);
  498. VAR t: Index;
  499. BEGIN
  500. ASSERT(nr # Undef);
  501. NEW(t); t.tag := nr; Put(type,t);
  502. END PutIndex;
  503. END TypeToIndex;
  504. Attribute = OBJECT
  505. VAR
  506. numberTypes: LONGINT;
  507. indexToType: IndexToType;
  508. typeToIndex: TypeToIndex;
  509. PROCEDURE &Init;
  510. BEGIN numberTypes := 0; NEW(indexToType,16); NEW(typeToIndex,100);
  511. END Init;
  512. END Attribute;
  513. IndexToAttribute= OBJECT(Basic.List)
  514. PROCEDURE PutAttribute(nr: LONGINT; attribute: Attribute);
  515. BEGIN GrowAndSet(nr,attribute);
  516. END PutAttribute;
  517. PROCEDURE GetAttribute(nr: LONGINT): Attribute;
  518. VAR node: ANY; attribute: Attribute;
  519. BEGIN
  520. IF Length() <= nr THEN node := NIL ELSE node := Get(nr) END;
  521. IF node # NIL THEN attribute := node(Attribute)
  522. ELSE NEW(attribute); PutAttribute(nr,attribute);
  523. END;
  524. RETURN attribute
  525. END GetAttribute;
  526. END IndexToAttribute;
  527. BinarySymbolFile*=OBJECT (Formats.SymbolFileFormat)
  528. VAR file-: Files.File; extension-: Basic.FileName;
  529. noRedefinition, noModification, noInterfaceCheck: BOOLEAN;
  530. version: CHAR;
  531. (** Import - Symbol Table Loader Plugin *)
  532. PROCEDURE Import(CONST moduleName: ARRAY OF CHAR; importCache: SyntaxTree.ModuleScope): SyntaxTree.Module;
  533. VAR
  534. module: SyntaxTree.Module;
  535. moduleIdentifier,contextIdentifier: SyntaxTree.Identifier;
  536. moduleScope: SyntaxTree.ModuleScope;
  537. fileName: Files.FileName;
  538. R: Streams.Reader;
  539. tag, i: LONGINT;
  540. visibility: SET;
  541. type: SyntaxTree.Type;
  542. variable: SyntaxTree.Variable;
  543. constant: SyntaxTree.Constant;
  544. procedure: SyntaxTree.Procedure;
  545. procedureType: SyntaxTree.ProcedureType;
  546. procedureScope: SyntaxTree.ProcedureScope;
  547. typeDeclaration: SyntaxTree.TypeDeclaration;
  548. resolver: Resolver;
  549. allTypes: IndexToType; numberReimports, numberTypes : LONGINT;
  550. name: SyntaxTree.IdentifierString;
  551. value: SyntaxTree.Value;
  552. stamp: LONGINT;
  553. b: BOOLEAN;
  554. indexToAttribute: IndexToAttribute;
  555. predefType: ARRAY sfLastType+1 OF SyntaxTree.Type;
  556. PROCEDURE NewTypeReference(nr: LONGINT): SyntaxTree.Type;
  557. VAR typeReference: TypeReference;
  558. BEGIN
  559. NEW(typeReference,nr); RETURN typeReference;
  560. END NewTypeReference;
  561. (* Imports = {moduleName:RawString} 0X *)
  562. PROCEDURE Imports;
  563. VAR moduleName: SyntaxTree.IdentifierString; import: SyntaxTree.Import; importedModule: SyntaxTree.Module; moduleIdentifier,moduleContext: SyntaxTree.Identifier; b: BOOLEAN;
  564. BEGIN
  565. R.RawString(moduleName);
  566. WHILE moduleName # "" DO
  567. ASSERT(moduleName # "SYSTEM");
  568. IF TraceImport IN Trace THEN D.Str("import module: "); D.Str(moduleName); D.Ln; END;
  569. (* as the context is not encoded in the symbol file, we have to deduce it from the filename, this is ugly but necessary
  570. to keep consistency with old compiler
  571. *)
  572. Global.ContextFromName(moduleName,moduleIdentifier,moduleContext);
  573. import := importCache.ImportByModuleName(moduleIdentifier,moduleContext);
  574. IF import # NIL THEN
  575. IF import.module = NIL THEN (* has not yet been imported by parent module *)
  576. (* adjust import symbol in parent *)
  577. importedModule := Import(moduleName,importCache);
  578. import.SetModule(importedModule);
  579. ELSE
  580. (* take module from parent *)
  581. importedModule := import.module;
  582. END
  583. ELSE
  584. importedModule := Import(moduleName,importCache);
  585. IF importedModule # NIL THEN
  586. import := SyntaxTree.NewImport(-1,importedModule.name,importedModule.name,FALSE);
  587. import.SetContext(importedModule.context);
  588. import.SetModule(importedModule);
  589. import.SetState(SyntaxTree.Resolved);
  590. importCache.AddImport(import);
  591. END;
  592. END;
  593. (* create new import symbol for this module scope *)
  594. IF importedModule # NIL THEN
  595. import := SyntaxTree.NewImport(-1,moduleIdentifier,moduleIdentifier,TRUE);
  596. import.SetModule(importedModule);
  597. import.SetContext(moduleContext);
  598. import.SetState(SyntaxTree.Resolved);
  599. module.moduleScope.AddImport(import);
  600. module.moduleScope.EnterSymbol(import,b);
  601. END;
  602. R.RawString(moduleName);
  603. END
  604. END Imports;
  605. (* Value = [ RawNum | RawHInt | RawReal | RawLReal | RawString ] *)
  606. PROCEDURE Value(type: SyntaxTree.Type): SyntaxTree.Value;
  607. VAR i: LONGINT; huge: HUGEINT; r: REAL; lr: LONGREAL; string: SyntaxTree.String; length: LONGINT; set: SET;
  608. value: SyntaxTree.Value; size: LONGINT;
  609. BEGIN
  610. size := type.sizeInBits;
  611. IF type IS SyntaxTree.BooleanType THEN R.RawNum(i);
  612. IF TraceImport IN Trace THEN D.Str("InConst / Bool / "); D.Int(i,1); D.Ln; END;
  613. IF i = 0 THEN value := Global.NewBooleanValue(system,-1,FALSE) ELSE value := Global.NewBooleanValue(system,-1,TRUE) END
  614. ELSIF (type IS SyntaxTree.CharacterType) THEN
  615. IF (size=8) OR (size=16) OR (size=32) THEN
  616. R.RawNum(i);
  617. IF TraceImport IN Trace THEN D.Str("InConst / Char / "); D.Int(i,1); D.Ln; END;
  618. value := SyntaxTree.NewCharacterValue(-1,CHR(i));
  619. END;
  620. ELSIF type IS SyntaxTree.IntegerType THEN
  621. IF (size = 32) & ~type(SyntaxTree.IntegerType).signed THEN
  622. R.RawHInt(huge);
  623. IF TraceImport IN Trace THEN D.Str("InConst / Unsigned32 / "); D.Ln END;
  624. value := SyntaxTree.NewIntegerValue (-1,huge);
  625. ELSIF size <=32 THEN
  626. R.RawNum(i);
  627. IF TraceImport IN Trace THEN D.Str("InConst / Int"); D.Int(size,1); D.String(" "); D.Int(i,1); D.Ln END;
  628. value := SyntaxTree.NewIntegerValue(-1,i);
  629. ELSIF size=64 THEN
  630. R.RawHInt(huge);
  631. IF TraceImport IN Trace THEN D.Str("InConst / HInt / "); D.Ln END;
  632. value := SyntaxTree.NewIntegerValue (-1,huge);
  633. END;
  634. ELSIF type IS SyntaxTree.SetType THEN R.RawNum(SYSTEM.VAL(LONGINT, set));
  635. IF TraceImport IN Trace THEN D.Str("InConst / Set / "); D.Hex(SYSTEM.VAL(LONGINT, set),1); D.Ln END;
  636. value := SyntaxTree.NewSetValue(-1,set);
  637. ELSIF type IS SyntaxTree.FloatType THEN
  638. IF size = 32 THEN
  639. R.RawReal(r);
  640. IF TraceImport IN Trace THEN D.Str("InConst / Real / "); D.Ln END;
  641. value := SyntaxTree.NewRealValue(-1,r);
  642. ELSIF size = 64 THEN
  643. R.RawLReal(lr);
  644. IF TraceImport IN Trace THEN D.Str("InConst / LongReal / "); D.Ln END;
  645. value := SyntaxTree.NewRealValue(-1,lr);
  646. END;
  647. ELSIF type IS SyntaxTree.StringType THEN
  648. IF version <= FileVersionOC THEN NEW(string, 256)
  649. ELSE R.RawLInt(length); NEW(string, length)
  650. END;
  651. R.RawString(string^);
  652. IF TraceImport IN Trace THEN D.Str("InConst / String / "); D.Str(string^); D.Ln END;
  653. value := SyntaxTree.NewStringValue(-1,string);
  654. type(SyntaxTree.StringType).SetLength(value(SyntaxTree.StringValue).length);
  655. type.SetState(SyntaxTree.Resolved);
  656. ELSIF type IS SyntaxTree.EnumerationType THEN R.RawNum(i);
  657. IF TraceImport IN Trace THEN D.Str("InConst / LInt / "); D.Int(i,1); D.Ln END;
  658. value := SyntaxTree.NewEnumerationValue(-1,i);
  659. ELSIF type IS SyntaxTree.NilType THEN
  660. IF TraceImport IN Trace THEN D.Str("InConst / Nil"); D.Ln END;
  661. value := SyntaxTree.NewNilValue(-1);
  662. END;
  663. value.SetType(type);
  664. value.SetState(SyntaxTree.Resolved);
  665. RETURN value
  666. END Value;
  667. (* EnumerationList = {name:RawString} sfEnd *)
  668. PROCEDURE EnumerationList(enumerationScope: SyntaxTree.EnumerationScope);
  669. VAR enumerator: SyntaxTree.Constant; visibility,flags: SET; b: BOOLEAN;
  670. type: SyntaxTree.Type; name: SyntaxTree.IdentifierString; identifier: SyntaxTree.Identifier;
  671. BEGIN
  672. R.RawString(name);
  673. WHILE name # "" DO
  674. identifier := SyntaxTree.NewIdentifier(name);
  675. enumerator := SyntaxTree.NewConstant(-1,identifier);
  676. enumerationScope.AddConstant(enumerator);
  677. enumerationScope.EnterSymbol(enumerator,b);
  678. IF name # "@" THEN enumerationScope.lastConstant.SetAccess(SyntaxTree.Public+SyntaxTree.Internal+SyntaxTree.Protected)
  679. ELSE enumerationScope.lastConstant.SetAccess(SyntaxTree.Internal)
  680. END;
  681. value := Value(enumerationScope.ownerEnumeration);
  682. enumerator.SetValue(value);
  683. enumerator.SetType(enumerationScope.ownerEnumeration);
  684. R.RawString(name);
  685. END;
  686. END EnumerationList;
  687. (* ParameterList = { [sfObjflag ( sfCParam | sfDarwinCParam | sfWinAPIParam )] [sfVar] [sfReadOnly] Type name:RawString } sfEnd *)
  688. PROCEDURE ParameterList(VAR callingConvention: LONGINT; parentScope: SyntaxTree.Scope; procedureType: SyntaxTree.ProcedureType);
  689. VAR name: SyntaxTree.IdentifierString; type: SyntaxTree.Type; f: LONGINT;
  690. kind: LONGINT;
  691. parameter: SyntaxTree.Parameter;
  692. BEGIN
  693. IF TraceImport IN Trace THEN
  694. D.Str("ParameterList "); D.Ln
  695. END;
  696. callingConvention := SyntaxTree.OberonCallingConvention;
  697. R.RawNum(tag);
  698. WHILE tag#sfEnd DO
  699. IF tag = sfObjFlag THEN (*! the calling convention should not be expressed via the parameters (compatiblity with old compiler) *)
  700. R.RawNum(f);
  701. IF f = sfCParam THEN (* fof for Linux *)
  702. callingConvention := SyntaxTree.CCallingConvention
  703. ELSIF f = sfDarwinCParam THEN (* fld for darwin *)
  704. callingConvention := SyntaxTree.DarwinCCallingConvention
  705. ELSIF f=sfWinAPIParam THEN
  706. callingConvention := SyntaxTree.WinAPICallingConvention
  707. ELSE HALT(100)
  708. END;
  709. R.RawNum(tag);
  710. END;
  711. IF tag=sfVar THEN
  712. R.RawNum(tag);
  713. kind := SyntaxTree.VarParameter;
  714. ELSE
  715. kind := SyntaxTree.ValueParameter;
  716. END;
  717. IF tag = sfReadOnly THEN (* var const *)
  718. R.RawNum(tag);
  719. kind := SyntaxTree.ConstParameter;
  720. END;
  721. type := Type();
  722. R.RawString(name);
  723. parameter := SyntaxTree.NewParameter(-1,procedureType,SyntaxTree.NewIdentifier(name),kind);
  724. parameter.SetType(type);
  725. parameter.SetState(SyntaxTree.Resolved);
  726. (*! remove this after a rebuild of the release - for compatibility only *)
  727. IF (parameter.name=Global.SelfParameterName)
  728. OR (parameter.name=Global.ReturnParameterName)
  729. OR (parameter.name=Global.PointerReturnName)
  730. OR (parameter.name=Global.ResultName) THEN (* ignore *)
  731. ELSE
  732. procedureType.AddParameter(parameter);
  733. END;
  734. R.RawNum(tag)
  735. END;
  736. IF callingConvention # SyntaxTree.OberonCallingConvention THEN
  737. procedureType.RevertParameters;
  738. END;
  739. END ParameterList;
  740. (* returns the index of module importedModule in the list of module module *)
  741. PROCEDURE ModuleByIndex(module: SyntaxTree.Module; index: LONGINT): SyntaxTree.Module;
  742. VAR import: SyntaxTree.Import;
  743. BEGIN import := module.moduleScope.firstImport;
  744. WHILE (import # NIL) & (index > 0) DO
  745. IF (* (import.direct) & *) ~Global.IsSystemModule(import.module) THEN DEC(index) END;
  746. import := import.nextImport;
  747. END;
  748. ASSERT(import # NIL);
  749. (* ASSERT(import.direct); *)
  750. RETURN import.module;
  751. END ModuleByIndex;
  752. (*
  753. Record =
  754. mode:RawNum priority:Char {variable:Symbol}
  755. [sfTProcedure {Symbol [name:RawString] ParameterList [sfInline Inline]} ]
  756. sfEnd
  757. *)
  758. PROCEDURE Record(recordType: SyntaxTree.RecordType; baseType: SyntaxTree.Type);
  759. VAR
  760. mode: SET;
  761. priority: LONGINT;
  762. visibility: SET;
  763. active, safe, isOperator, isDynamic: BOOLEAN;
  764. untraced, realtime, constructor: BOOLEAN;
  765. variable: SyntaxTree.Variable;
  766. procedure: SyntaxTree.Procedure;
  767. operator: SyntaxTree.Operator;
  768. procedureType: SyntaxTree.ProcedureType;
  769. recordScope: SyntaxTree.RecordScope;
  770. recordBody: SyntaxTree.Body;
  771. name: SyntaxTree.IdentifierString;
  772. ch: CHAR;
  773. callingConvention: LONGINT;
  774. BEGIN
  775. recordScope := recordType.recordScope;
  776. R.RawNum(SYSTEM.VAL(LONGINT, mode));
  777. IF sfActive IN mode THEN active := TRUE ELSE active := FALSE END;
  778. IF sfProtected IN mode THEN recordType.SetProtected(TRUE) END;
  779. IF sfSafe IN mode THEN safe := TRUE ELSE safe := FALSE END;
  780. R.Char(ch);
  781. priority := ORD(ch); (* body priority, if active object *)
  782. IF TraceImport IN Trace THEN
  783. D.Str("Rec / Mode / "); D.Hex(SYSTEM.VAL(LONGINT, mode),1); D.Ln;
  784. D.Str("Rec / Prio / "); D.Int(priority,1); D.Ln
  785. END;
  786. R.RawNum(tag);
  787. WHILE (tag < sfTProcedure) OR (tag > sfEnd) DO (*read fields*)
  788. isOperator := FALSE;
  789. Symbol(recordScope,type,name,visibility,untraced, realtime, constructor, isOperator, isDynamic);
  790. ASSERT(type # NIL);
  791. IF name = "" THEN visibility := SyntaxTree.Internal END;
  792. variable := SyntaxTree.NewVariable(-1,SyntaxTree.NewIdentifier(name));
  793. variable.SetType(type);
  794. variable.SetUntraced(untraced);
  795. variable.SetAccess(visibility);
  796. variable.SetState(SyntaxTree.Resolved);
  797. recordScope.AddVariable(variable);
  798. recordScope.EnterSymbol(variable,b);
  799. R.RawNum(tag);
  800. END;
  801. IF tag=sfTProcedure THEN
  802. R.RawNum(tag);
  803. WHILE tag#sfEnd DO
  804. isOperator := FALSE;
  805. Symbol(recordScope,type,name, visibility,untraced, realtime, constructor, isOperator, isDynamic);
  806. IF name = "" THEN R.RawString(name) END;
  807. procedureScope := SyntaxTree.NewProcedureScope(recordScope);
  808. IF isOperator THEN
  809. operator := SyntaxTree.NewOperator(-1,SyntaxTree.NewIdentifier(name),procedureScope);
  810. procedure := operator
  811. ELSE
  812. procedure := SyntaxTree.NewProcedure(-1,SyntaxTree.NewIdentifier(name),procedureScope);
  813. END;
  814. procedureType := SyntaxTree.NewProcedureType(-1,recordScope);
  815. procedureType.SetReturnType(type);
  816. procedureType.SetRealtime(realtime);
  817. procedure.SetConstructor(constructor);
  818. procedureType.SetDelegate(TRUE);
  819. procedure.SetType(procedureType);
  820. procedure.SetAccess(visibility);
  821. procedure.SetState(SyntaxTree.Resolved);
  822. IF constructor THEN
  823. recordScope.SetConstructor(procedure); (*! redundant *)
  824. END;
  825. ParameterList(callingConvention,procedureScope,procedureType);
  826. recordScope.AddProcedure(procedure);
  827. IF isOperator THEN
  828. recordScope.AddOperator(operator);
  829. END;
  830. recordScope.EnterSymbol(procedure,b);
  831. (* This identifies a inlined Indexer *)
  832. R.RawNum(tag);
  833. IF tag = sfInline THEN
  834. Inline(procedureScope);
  835. (*
  836. INCL(flag, SyntaxTree.Inline);
  837. INCL(flag, SyntaxTree.Indexer);
  838. INCL(flag, SyntaxTree.Operator);
  839. mscope.code := Inline();
  840. *)
  841. R.RawNum(tag)
  842. END;
  843. IF (procedure.name=Global.RecordBodyName) THEN
  844. recordScope.SetBodyProcedure(procedure);
  845. recordBody := SyntaxTree.NewBody(-1,procedureScope);
  846. recordBody.SetSafe(safe);
  847. recordBody.SetActive(active);
  848. procedureScope.SetBody(recordBody);
  849. END;
  850. END
  851. ELSE ASSERT(tag = sfEnd);
  852. END;
  853. (*
  854. ASSERT((bodyFlags = {}) OR (recordScope.bodyProcedure # NIL));
  855. *)
  856. recordType.SetBaseType(baseType);
  857. END Record;
  858. (*
  859. Type =
  860. TypeReference
  861. |BasicType
  862. |ImportedType
  863. |UserType.
  864. TypeReference = number:RawNum(<0)
  865. BasicType = sfTypeBoolean | .. | sfLastType.
  866. ImportedType = ModuleNumber (structName:RawString | 0X typeIndex:RawNum)
  867. ModuleNumber = sfMod1 | .. | sfModOther-1 | sfModOther moduleNumber:RawNum
  868. UserType = [sfInvisible] [sfSysFlag sysFlag:RawNum] UserType2
  869. UserType2=
  870. sfTypeOpenArray baseType:Type name:RawString flags:RawNum
  871. |sfTypeStaticArray baseType:Type name:RawString flags:RawNum length:RawNum
  872. |sfOpenMathArray baseType:Type name:RawString
  873. |sfStaticMathArray baseType:Type name:RawString length:RawNum
  874. |sfTypeTensor baseType:Type name:RawString
  875. |sfTypePointer baseType:Type name:RawString flags:RawNum
  876. |sfTypeRecord baseType:Type name:RawString flags:RawNum Record
  877. |sfTypeProcedure baseType:Type name:RawString flags:RawNum ParameterList
  878. |sfTypeEnumeration enumerationBase:Type name:RawString
  879. *)
  880. PROCEDURE Type(): SyntaxTree.Type;
  881. VAR
  882. typtag,len: LONGINT;
  883. name: SyntaxTree.IdentifierString;
  884. type, baseType: SyntaxTree.Type;
  885. typeDeclaration: SyntaxTree.TypeDeclaration;
  886. arrayType: SyntaxTree.ArrayType;
  887. mathArrayType: SyntaxTree.MathArrayType;
  888. pointerType: SyntaxTree.PointerType;
  889. procedureType: SyntaxTree.ProcedureType;
  890. recordType: SyntaxTree.RecordType;
  891. recordScope: SyntaxTree.RecordScope;
  892. qualifiedType: SyntaxTree.QualifiedType;
  893. enumerationScope: SyntaxTree.EnumerationScope;
  894. enumerationType: SyntaxTree.EnumerationType;
  895. (*import: SyntaxTree.Import;*)
  896. importedModule: SyntaxTree.Module;
  897. identifier: SyntaxTree.Identifier;
  898. thisIndex : LONGINT;
  899. typeAdr: LONGINT;
  900. size: SyntaxTree.Value;
  901. visibility: SET;
  902. typeName: SyntaxTree.IdentifierString;
  903. sysflag: LONGINT; flags: SET;
  904. attribute: Attribute;
  905. callingConvention: LONGINT;
  906. BEGIN
  907. visibility := SyntaxTree.Public + SyntaxTree.Protected + SyntaxTree.Internal; flags := {};
  908. IF tag <= 0 THEN (* TypeReference = number:RawNum(<0) *)
  909. type := NewTypeReference(-tag);
  910. IF TraceImport IN Trace THEN
  911. D.Str("Type / OldStr "); D.Int(-tag,1); D.Ln
  912. END
  913. ELSIF tag = sfTypeString THEN
  914. type := SyntaxTree.NewStringType(-1,system.characterType,0);
  915. IF TraceImport IN Trace THEN
  916. D.Str("Type / String "); D.Int(tag,1); D.Ln
  917. END
  918. ELSIF tag <= sfLastType THEN (* BasicType = sfTypeBoolean | .. | sfLastType. *)
  919. type := predefType[tag];
  920. ASSERT((tag = sfTypeNoType) OR (type # NIL));
  921. IF TraceImport IN Trace THEN
  922. D.Str("Type / Basic "); D.Int(tag,1); D.Ln
  923. END
  924. ELSIF tag = sfTypeRange THEN
  925. type := system.rangeType;
  926. ELSIF tag = sfTypeComplex THEN
  927. type := system.complexType;
  928. ELSIF tag = sfTypeLongcomplex THEN
  929. type := system.longcomplexType;
  930. ELSIF tag <= sfModOther THEN
  931. (* ImportedType = ModuleNumber (structName:RawString | 0X typeIndex:RawNum) *)
  932. (* ModuleNumber = sfMod1 | .. | sfModOther-1 | sfModOther moduleNumber:RawNum *)
  933. IF tag = sfModOther THEN
  934. R.RawNum(tag);
  935. ASSERT(tag >= 0);
  936. ELSE
  937. tag := tag-sfMod1
  938. END; (*tag = [0 .. +oo[ *)
  939. importedModule := ModuleByIndex(module,tag);
  940. ASSERT(importedModule # NIL);
  941. R.RawString(typeName);
  942. type := NIL;
  943. attribute := indexToAttribute.GetAttribute(tag);
  944. IF typeName # "" THEN (* first import of struct *)
  945. identifier := SyntaxTree.NewIdentifier(typeName);
  946. typeDeclaration := importedModule.moduleScope.FindTypeDeclaration(identifier); (* find type in module *)
  947. IF (typeDeclaration # NIL) THEN
  948. qualifiedType := SyntaxTree.NewQualifiedType(-1,moduleScope,SyntaxTree.NewQualifiedIdentifier(-1,importedModule.name,identifier));
  949. qualifiedType.SetResolved(typeDeclaration.declaredType);
  950. qualifiedType.SetTypeDeclaration(typeDeclaration);
  951. type := qualifiedType;
  952. END;
  953. (* add reimport *)
  954. attribute.indexToType.PutType(attribute.numberTypes,type);
  955. INC(attribute.numberTypes);
  956. IF TraceImport IN Trace THEN
  957. D.Str("Type / Reimport "); D.Str(typeName); D.Str(" in "); D.Str0(importedModule.name); D.Str(":"); D.Int(tag,1-sfMod1); D.Ln;
  958. END;
  959. ELSE
  960. R.RawNum(typeAdr);
  961. type := attribute.indexToType.GetType(typeAdr);
  962. IF TraceImport IN Trace THEN
  963. D.Str("Type / Reimport "); D.Int(typeAdr,1); D.Str(" in "); D.Str0(importedModule.name); D.Str(":"); D.Int(tag,1-sfMod1); D.Ln;
  964. END;
  965. END;
  966. ELSE (* UserType = [sfInvisible] [sfSysFlag flag] UserType2 *)
  967. IF TraceImport IN Trace THEN
  968. D.Str("Type / User "); D.Str(name); D.Ln
  969. END;
  970. thisIndex := numberTypes; INC(numberTypes);
  971. IF tag = sfInvisible THEN visibility := SyntaxTree.Internal; R.RawNum(tag) END;
  972. IF tag = sfSysFlag THEN R.RawNum(sysflag); R.RawNum(tag) END;
  973. (* UserType2 *)
  974. typtag := tag;
  975. R.RawNum(tag);
  976. baseType := Type();
  977. R.RawString(name);
  978. CASE typtag OF
  979. | sfTypeOpenArray:
  980. IF TraceImport IN Trace THEN
  981. D.Str("Type / User / OpenArr "); D.Str(name); D.Ln
  982. END;
  983. ASSERT(baseType # NIL);
  984. arrayType := SyntaxTree.NewArrayType(-1,moduleScope,SyntaxTree.Open);
  985. arrayType.SetArrayBase(baseType);
  986. type := arrayType;
  987. R.RawNum(SYSTEM.VAL(LONGINT,flags));
  988. IF sfRealtime IN flags THEN type.SetRealtime(TRUE) END;
  989. | sfTypeStaticArray:
  990. IF TraceImport IN Trace THEN
  991. D.Str("Type / User / Array ");
  992. D.Int(len,1); D.Str(name); D.Ln
  993. END;
  994. ASSERT(baseType # NIL);
  995. arrayType :=SyntaxTree.NewArrayType(-1,moduleScope,SyntaxTree.Static);
  996. arrayType.SetArrayBase(baseType);
  997. type := arrayType;
  998. R.RawNum(SYSTEM.VAL(LONGINT,flags));
  999. IF sfRealtime IN flags THEN type.SetRealtime(TRUE) END;
  1000. R.RawNum(len);
  1001. size := SyntaxTree.NewIntegerValue(-1,len);
  1002. size.SetType(system.longintType);
  1003. arrayType.SetLength(size);
  1004. | sfTypeOpenMathArray:
  1005. IF TraceImport IN Trace THEN
  1006. D.Str("Type / User / MathArray (open) "); D.Str(name); D.Ln
  1007. END;
  1008. ASSERT(baseType # NIL);
  1009. mathArrayType := SyntaxTree.NewMathArrayType(-1,moduleScope,SyntaxTree.Open);
  1010. mathArrayType.SetArrayBase(baseType);
  1011. type := mathArrayType;
  1012. R.RawNum(SYSTEM.VAL(LONGINT,flags));
  1013. IF sfRealtime IN flags THEN type.SetRealtime(TRUE) END;
  1014. | sfTypeTensor:
  1015. IF TraceImport IN Trace THEN
  1016. D.Str("Type / User / Tensor "); D.Str(name); D.Ln
  1017. END;
  1018. mathArrayType := SyntaxTree.NewMathArrayType(-1,moduleScope,SyntaxTree.Tensor);
  1019. mathArrayType.SetArrayBase(baseType);
  1020. type := mathArrayType;
  1021. R.RawNum(SYSTEM.VAL(LONGINT,flags));
  1022. IF sfRealtime IN flags THEN type.SetRealtime(TRUE) END;
  1023. | sfTypeStaticMathArray:
  1024. IF TraceImport IN Trace THEN
  1025. D.Str("Type / User / MathArray (Static) ");
  1026. D.Int(len,1); D.Str(name); D.Ln
  1027. END;
  1028. ASSERT(baseType # NIL);
  1029. mathArrayType :=SyntaxTree.NewMathArrayType(-1,moduleScope,SyntaxTree.Static);
  1030. mathArrayType.SetArrayBase(baseType);
  1031. type := mathArrayType;
  1032. R.RawNum(SYSTEM.VAL(LONGINT,flags));
  1033. IF sfRealtime IN flags THEN type.SetRealtime(TRUE) END;
  1034. R.RawNum(len);
  1035. size := SyntaxTree.NewIntegerValue(-1,len);
  1036. size.SetType(system.longintType);
  1037. mathArrayType.SetLength(size);
  1038. | sfTypePointer:
  1039. IF TraceImport IN Trace THEN
  1040. D.Str("Type / User / Pointer "); D.Str(name); D.Ln
  1041. END;
  1042. pointerType := SyntaxTree.NewPointerType(-1,moduleScope);
  1043. type := pointerType;
  1044. pointerType.SetPointerBase(baseType);
  1045. R.RawNum(SYSTEM.VAL(LONGINT,flags));
  1046. WITH type: SyntaxTree.PointerType DO
  1047. IF sfUnsafe IN flags THEN type.SetUnsafe(TRUE) END;
  1048. IF sfRealtime IN flags THEN type.SetRealtime(TRUE) END;
  1049. IF sfDisposable IN flags THEN type.SetDisposable(TRUE) END;
  1050. END;
  1051. | sfTypeRecord:
  1052. IF TraceImport IN Trace THEN
  1053. D.Str("Type / User / Record "); D.Str(name); D.Ln
  1054. END;
  1055. recordScope := SyntaxTree.NewRecordScope(moduleScope);
  1056. recordType := SyntaxTree.NewRecordType(-1,moduleScope,recordScope);
  1057. type := recordType;
  1058. R.RawNum(SYSTEM.VAL(LONGINT,flags));
  1059. IF sfRealtime IN flags THEN type.SetRealtime(TRUE) END;
  1060. Record(recordType,baseType);
  1061. | sfTypeProcedure:
  1062. IF TraceImport IN Trace THEN
  1063. D.Str("Type / User / Proc "); D.Str(name); D.Ln
  1064. END;
  1065. procedureScope := SyntaxTree.NewProcedureScope(NIL);
  1066. procedureType := SyntaxTree.NewProcedureType(-1,moduleScope);
  1067. procedureType.SetReturnType(baseType);
  1068. type := procedureType;
  1069. IF sysflag = sfDelegate THEN procedureType.SetDelegate(TRUE) END;
  1070. R.RawNum(SYSTEM.VAL(LONGINT,flags));
  1071. IF sfWinAPIParam IN flags THEN procedureType.SetCallingConvention(SyntaxTree.WinAPICallingConvention)
  1072. ELSIF sfCParam IN flags THEN procedureType.SetCallingConvention(SyntaxTree.CCallingConvention)
  1073. ELSIF sfDarwinCParam IN flags THEN procedureType.SetCallingConvention(SyntaxTree.DarwinCCallingConvention)
  1074. END;
  1075. IF sfRealtime IN flags THEN procedureType.SetRealtime(TRUE) END;
  1076. ParameterList(callingConvention,procedureScope,procedureType);
  1077. | sfTypeEnumeration:
  1078. IF TraceImport IN Trace THEN
  1079. D.Str("Type / User / Enumerator "); D.Str(name); D.Ln
  1080. END;
  1081. enumerationScope := SyntaxTree.NewEnumerationScope(moduleScope);
  1082. enumerationType := SyntaxTree.NewEnumerationType(-1,moduleScope,enumerationScope);
  1083. type := enumerationType;
  1084. enumerationType.SetEnumerationBase(baseType);
  1085. EnumerationList(enumerationScope);
  1086. END;
  1087. IF name # "" THEN
  1088. typeDeclaration := SyntaxTree.NewTypeDeclaration(-1,SyntaxTree.NewIdentifier(name));
  1089. typeDeclaration.SetDeclaredType(type);
  1090. type.SetTypeDeclaration(typeDeclaration);
  1091. typeDeclaration.SetAccess(visibility);
  1092. typeDeclaration.SetState(SyntaxTree.Resolved);
  1093. qualifiedType := SyntaxTree.NewQualifiedType(-1,moduleScope, SyntaxTree.NewQualifiedIdentifier(-1,SyntaxTree.invalidIdentifier,typeDeclaration.name));
  1094. qualifiedType.SetResolved(type);
  1095. type := qualifiedType;
  1096. type.SetTypeDeclaration(typeDeclaration);
  1097. module.moduleScope.AddTypeDeclaration(typeDeclaration); (* do not replace module.moduleScope by parentScope ! *)
  1098. module.moduleScope.EnterSymbol(typeDeclaration,b);
  1099. END;
  1100. allTypes.PutType(thisIndex,type);
  1101. IF TraceImport IN Trace THEN
  1102. D.Str("resolver.AddType "); D.Str(name); D.Str(" "); D.Int(thisIndex,1); D.Str("");
  1103. D.Ln
  1104. END;
  1105. END;
  1106. RETURN type;
  1107. END Type;
  1108. (*
  1109. Inline = {len:Char {c:Char}} 0X
  1110. *)
  1111. PROCEDURE Inline(scope: SyntaxTree.ProcedureScope);
  1112. VAR ch: CHAR; pos, len: LONGINT; array: SyntaxTree.BinaryCode; newcode: SyntaxTree.Code;
  1113. body: SyntaxTree.Body;
  1114. PROCEDURE Append(ch: CHAR);
  1115. BEGIN
  1116. array.Resize(pos+8);
  1117. array.SetBits(pos,8,ORD(ch));
  1118. INC(pos,8);
  1119. END Append;
  1120. BEGIN
  1121. NEW(array,128*8);
  1122. R.Char(ch);pos := 0;
  1123. REPEAT
  1124. len := ORD(ch);
  1125. WHILE len > 0 DO R.Char(ch); Append(ch); DEC(len) END;
  1126. R.Char(ch);
  1127. UNTIL ch = 0X;
  1128. body := SyntaxTree.NewBody(-1,scope);
  1129. newcode := SyntaxTree.NewCode(-1,body);
  1130. body.SetCode(newcode);
  1131. scope.SetBody(body);
  1132. newcode.SetBinaryCode(array);
  1133. END Inline;
  1134. (* Symbol = [sfObjFlag flag:RawNum] [sfReadOnly] Type name:RawString *)
  1135. PROCEDURE Symbol(parentScope: SyntaxTree.Scope; VAR type: SyntaxTree.Type; VAR name: SyntaxTree.IdentifierString; VAR visibility: SET; VAR untraced, realtime, constructor, operator, isDynamic: BOOLEAN);
  1136. VAR f,i: LONGINT;
  1137. BEGIN
  1138. IF TraceImport IN Trace THEN
  1139. D.Str("Symbol: --> "); D.Ln
  1140. END;
  1141. untraced := FALSE; realtime := FALSE; constructor := FALSE; isDynamic := FALSE;
  1142. visibility:=SyntaxTree.Public+SyntaxTree.Protected+SyntaxTree.Internal;
  1143. WHILE tag=sfObjFlag DO
  1144. R.RawNum(f);
  1145. IF f = sfUntraced THEN untraced := TRUE
  1146. ELSIF f = sfRealtime THEN realtime := TRUE
  1147. ELSIF f = sfOperator THEN operator := TRUE;
  1148. ELSIF f = sfDynamic THEN isDynamic := TRUE;
  1149. ELSE D.Str("Object: unknown objflag"); D.Ln
  1150. END;
  1151. R.RawNum(tag);
  1152. END;
  1153. IF tag=sfReadOnly THEN visibility := visibility * SyntaxTree.ReadOnly; R.RawNum(tag) END;
  1154. type := Type();
  1155. R.RawString(name);
  1156. IF ~operator & (name[0] = "&") THEN
  1157. constructor := TRUE;
  1158. i := 0; REPEAT name[i] := name[i+1]; INC(i) UNTIL name[i] = 0X;
  1159. END;
  1160. IF name = "" THEN
  1161. visibility := visibility * SyntaxTree.Internal;
  1162. END;
  1163. IF TraceImport IN Trace THEN
  1164. D.Str("<-- "); D.Str(name); D.Ln
  1165. END;
  1166. END Symbol;
  1167. (*
  1168. SymbolFile =
  1169. coeOptions:RawSet
  1170. Imports
  1171. [sfSysFlag sysFlags:Number]
  1172. [sfConst {Symbol Value}]
  1173. [sfVar {Symbol}]
  1174. [sfXProcedure {Symbol ParameterList}]
  1175. [sfOperator {Symbol ParameterList [sfInline Inline]}]
  1176. [sfCProcedure {Symbol ParameterList Inline}]
  1177. [sfAlias {Type name:RawString}]
  1178. [sfType {Type}]
  1179. sfEnd
  1180. *)
  1181. PROCEDURE Module;
  1182. VAR flags: SET; untraced, realtime, constructor,operator, isDynamic: BOOLEAN; callingConvention: LONGINT;
  1183. BEGIN
  1184. R.RawSet(flags);
  1185. Imports;
  1186. R.RawNum(tag);
  1187. flags := {};
  1188. IF tag = sfSysFlag THEN
  1189. R.RawNum(SYSTEM.VAL(LONGINT, flags));
  1190. R.RawNum(tag);
  1191. END;
  1192. IF TraceImport IN Trace THEN D.Str("importing constants"); D.Ln; END;
  1193. IF tag=sfConst THEN R.RawNum(tag);
  1194. WHILE (tag < sfVar) OR (tag > sfEnd) DO
  1195. operator := FALSE;
  1196. Symbol(moduleScope,type,name, visibility,untraced,realtime,constructor,operator, isDynamic);
  1197. ASSERT(type # NIL);
  1198. value := Value(type);
  1199. constant := SyntaxTree.NewConstant(-1,SyntaxTree.NewIdentifier(name));
  1200. constant.SetValue(value);
  1201. constant.SetType(value.type);
  1202. constant.SetAccess(visibility);
  1203. constant.SetState(SyntaxTree.Resolved);
  1204. moduleScope.AddConstant(constant);
  1205. moduleScope.EnterSymbol(constant,b);
  1206. R.RawNum(tag)
  1207. END
  1208. END;
  1209. IF TraceImport IN Trace THEN D.Str("importing variables"); D.Ln; END;
  1210. IF tag=sfVar THEN R.RawNum(tag);
  1211. WHILE (tag < sfXProcedure) OR (tag > sfEnd) DO
  1212. operator := FALSE;
  1213. Symbol(moduleScope,type,name, visibility,untraced,realtime,constructor,operator, isDynamic);
  1214. ASSERT(type # NIL);
  1215. variable := SyntaxTree.NewVariable(-1,SyntaxTree.NewIdentifier(name));
  1216. variable.SetType(type);
  1217. variable.SetAccess(visibility);
  1218. variable.SetState(SyntaxTree.Resolved);
  1219. moduleScope.AddVariable(variable);
  1220. moduleScope.EnterSymbol(variable,b);
  1221. R.RawNum(tag)
  1222. END
  1223. END;
  1224. IF TraceImport IN Trace THEN D.Str("importing procedures"); D.Ln; END;
  1225. IF tag=sfXProcedure THEN R.RawNum(tag);
  1226. WHILE (tag < sfOperator) OR (tag > sfEnd) DO
  1227. operator := FALSE;
  1228. Symbol(moduleScope,type,name, visibility,untraced,realtime,constructor,operator, isDynamic);
  1229. ASSERT(~(constructor));
  1230. procedureScope := SyntaxTree.NewProcedureScope(moduleScope);
  1231. procedureType := SyntaxTree.NewProcedureType(-1,moduleScope);
  1232. procedureType.SetReturnType(type);
  1233. procedure := SyntaxTree.NewProcedure(-1,SyntaxTree.NewIdentifier(name),procedureScope);
  1234. procedure.SetType(procedureType);
  1235. procedure.SetAccess(visibility);
  1236. ParameterList(callingConvention,procedureScope,procedureType);
  1237. procedureType.SetRealtime(realtime);
  1238. procedure.SetState(SyntaxTree.Resolved);
  1239. procedure.SetConstructor(constructor);
  1240. moduleScope.AddProcedure(procedure);
  1241. moduleScope.EnterSymbol(procedure,b);
  1242. R.RawNum(tag)
  1243. END
  1244. END;
  1245. IF TraceImport IN Trace THEN D.Str("importing operators"); D.Ln; END;
  1246. IF tag=sfOperator THEN R.RawNum(tag);
  1247. WHILE (tag < sfCProcedure) OR (tag > sfEnd) DO
  1248. operator := TRUE;
  1249. Symbol(moduleScope,type,name, visibility,untraced,realtime,constructor,operator, isDynamic);
  1250. ASSERT(~(constructor));
  1251. procedureScope := SyntaxTree.NewProcedureScope(moduleScope);
  1252. procedureType := SyntaxTree.NewProcedureType(-1,moduleScope);
  1253. procedureType.SetReturnType(type);
  1254. procedureType.SetRealtime(realtime);
  1255. procedure := SyntaxTree.NewOperator(-1,SyntaxTree.NewIdentifier(name),procedureScope);
  1256. procedure.SetType(procedureType);
  1257. procedure.SetAccess(visibility);
  1258. procedure(SyntaxTree.Operator).SetDynamic(isDynamic);
  1259. ParameterList(callingConvention,procedureScope,procedureType);
  1260. procedureType.SetCallingConvention(callingConvention);
  1261. procedure.SetState(SyntaxTree.Resolved);
  1262. module.moduleScope.AddProcedure(procedure);
  1263. module.moduleScope.AddOperator(procedure(SyntaxTree.Operator));
  1264. module.moduleScope.EnterSymbol(procedure,b);
  1265. R.RawNum(tag);
  1266. IF tag = sfInline THEN
  1267. Inline(procedureScope);
  1268. procedure.SetInline(TRUE);
  1269. R.RawNum(tag);
  1270. END;
  1271. END
  1272. END;
  1273. IF TraceImport IN Trace THEN D.Str("importing inline procedures"); D.Ln; END;
  1274. IF tag = sfCProcedure THEN R.RawNum(tag);
  1275. WHILE (tag < sfAlias) OR (tag > sfEnd) DO
  1276. operator := FALSE;
  1277. Symbol(moduleScope,type,name, visibility,untraced, realtime, constructor,operator, isDynamic);
  1278. ASSERT(~(constructor));
  1279. procedureScope := SyntaxTree.NewProcedureScope(moduleScope);
  1280. procedureType := SyntaxTree.NewProcedureType(-1,moduleScope);
  1281. procedure := SyntaxTree.NewProcedure(-1,SyntaxTree.NewIdentifier(name),procedureScope);
  1282. procedureType.SetReturnType(type);
  1283. procedure.SetInline(TRUE);
  1284. procedure.SetType(procedureType);
  1285. procedure.SetAccess(visibility);
  1286. ParameterList(callingConvention,procedureScope,procedureType);
  1287. procedure.SetState(SyntaxTree.Resolved);
  1288. module.moduleScope.AddProcedure(procedure);
  1289. module.moduleScope.EnterSymbol(procedure,b);
  1290. Inline(procedureScope);
  1291. R.RawNum(tag);
  1292. END
  1293. END;
  1294. IF TraceImport IN Trace THEN D.Str("importing type declaration aliases"); D.Ln; END;
  1295. IF tag=sfAlias THEN R.RawNum(tag);
  1296. WHILE (tag < sfType) OR (tag > sfEnd) DO
  1297. type := Type();
  1298. R.RawString(name);
  1299. IF TraceImport IN Trace THEN D.Str("alias:"); D.Str(name); D.Ln END;
  1300. typeDeclaration := SyntaxTree.NewTypeDeclaration(-1,SyntaxTree.NewIdentifier(name));
  1301. typeDeclaration.SetDeclaredType(type);
  1302. visibility := SyntaxTree.Public+SyntaxTree.Protected+SyntaxTree.Internal;
  1303. typeDeclaration.SetAccess(visibility);
  1304. typeDeclaration.SetState(SyntaxTree.Resolved);
  1305. IF ~(type IS SyntaxTree.BasicType) THEN
  1306. type.SetTypeDeclaration(typeDeclaration);
  1307. END;
  1308. module.moduleScope.AddTypeDeclaration(typeDeclaration);
  1309. module.moduleScope.EnterSymbol(typeDeclaration,b);
  1310. R.RawNum(tag)
  1311. END
  1312. END;
  1313. IF TraceImport IN Trace THEN D.Str("importing type declaration"); D.Ln; END;
  1314. IF tag=sfType THEN
  1315. R.RawNum(tag);
  1316. WHILE tag # sfEnd DO
  1317. type := Type();
  1318. R.RawNum(tag)
  1319. END
  1320. END;
  1321. END Module;
  1322. PROCEDURE InitBasic(type: SyntaxTree.Type; tag: LONGINT);
  1323. BEGIN
  1324. predefType[tag] := type;
  1325. END InitBasic;
  1326. PROCEDURE Init;
  1327. BEGIN
  1328. (*Built-In types*)
  1329. InitBasic(system.booleanType,sfTypeBoolean);
  1330. InitBasic(system.characterType,sfTypeChar8);
  1331. InitBasic(Global.Character16,sfTypeChar16);
  1332. InitBasic(Global.Character32,sfTypeChar32);
  1333. InitBasic(system.shortintType, sfTypeShortint);
  1334. InitBasic(system.integerType, sfTypeInteger);
  1335. InitBasic(system.longintType, sfTypeLongint);
  1336. InitBasic(system.hugeintType, sfTypeHugeint);
  1337. InitBasic(Global.Unsigned8, sfTypeUnsigned8);
  1338. InitBasic(Global.Unsigned16, sfTypeUnsigned16);
  1339. InitBasic(Global.Unsigned32, sfTypeUnsigned32);
  1340. InitBasic(Global.Unsigned64, sfTypeUnsigned64);
  1341. InitBasic(Global.Float32, sfTypeReal);
  1342. InitBasic(Global.Float64, sfTypeLongreal);
  1343. InitBasic(system.setType, sfTypeSet);
  1344. InitBasic(system.anyType, sfTypeAny);
  1345. InitBasic(system.objectType, sfTypeObject);
  1346. InitBasic(system.nilType, sfTypeNilType);
  1347. InitBasic(NIL, sfTypeNoType);
  1348. InitBasic(system.byteType, sfTypeByte);
  1349. InitBasic(system.sizeType, sfTypeSize);
  1350. InitBasic(system.addressType, sfTypeAddress);
  1351. END Init;
  1352. BEGIN
  1353. Init;
  1354. i := 0; numberTypes := 0; numberReimports := 0;
  1355. COPY(moduleName,fileName);
  1356. NEW(allTypes,32); NEW(indexToAttribute,32);
  1357. ASSERT(fileName # "SYSTEM");
  1358. IF ~OpenSymFile(fileName, path, extension, R, version) THEN (*! reintroduce flexible extension *)
  1359. RETURN NIL
  1360. END;
  1361. IF TraceImport IN Trace THEN
  1362. D.Str("BINARY SYMBOL FILE IMPORT "); D.Str(moduleName); D.Ln;
  1363. END;
  1364. (* as the context is not encoded in the symbol file, we have to deduce it from the filename, this is ugly but necessary
  1365. to keep consistency with old compiler
  1366. *)
  1367. Global.ContextFromName(moduleName,moduleIdentifier,contextIdentifier);
  1368. moduleScope := SyntaxTree.NewModuleScope();
  1369. module:= SyntaxTree.NewModule(fileName,-1,moduleIdentifier,moduleScope,Scanner.Uppercase);
  1370. module.SetContext(contextIdentifier);
  1371. IF importCache = NIL THEN importCache := SyntaxTree.NewModuleScope(); END;
  1372. Module;
  1373. stamp := Kernel.GetTicks();
  1374. NEW(resolver,system,SELF,importCache);
  1375. resolver.Resolve(module,allTypes);
  1376. module.SetState(SyntaxTree.Resolved);
  1377. IF TraceImport IN Trace THEN
  1378. D.Str("BINARY SYMBOL FILE IMPORT DONE "); D.Str(moduleName); D.Ln;
  1379. END;
  1380. (* if import error then module := NIL *)
  1381. RETURN module
  1382. END Import;
  1383. PROCEDURE Export(module: SyntaxTree.Module; importCache: SyntaxTree.ModuleScope): BOOLEAN;
  1384. VAR w: Files.Writer; lookup: TypeToIndex; indexToAttribute: IndexToAttribute; numberType: LONGINT; flags: SET;
  1385. (* Imports = {moduleName:RawString} 0X *)
  1386. PROCEDURE Imports(import: SyntaxTree.Import);
  1387. VAR name: SyntaxTree.IdentifierString;
  1388. BEGIN
  1389. WHILE import # NIL DO
  1390. IF ~Global.IsSystemModule(import.module) THEN
  1391. Global.ModuleFileName(import.module.name,import.module.context,name);
  1392. (*! maybe the context and module name should be stored as different names ? *)
  1393. IF TraceExport IN Trace THEN
  1394. D.Str("import: "); D.Str(name); D.Ln;
  1395. END;
  1396. w.RawString(name);
  1397. END;
  1398. import := import.nextImport;
  1399. END;
  1400. w.RawNum(0); (* end of imports *)
  1401. END Imports;
  1402. (* Value = [RawNum | RawHInt | RawReal | RawLReal | RawString] *)
  1403. PROCEDURE Value(v: SyntaxTree.Value);
  1404. VAR type: SyntaxTree.Type;
  1405. BEGIN
  1406. type := v.type.resolved;
  1407. IF type IS SyntaxTree.BooleanType THEN w.RawNum(SYSTEM.VAL(SHORTINT,v(SyntaxTree.BooleanValue).value))
  1408. ELSIF type IS SyntaxTree.CharacterType THEN w.RawNum(ORD(v(SyntaxTree.CharacterValue).value));
  1409. (*
  1410. ELSIF type = Global.Char16 THEN w.RawNum(ORD(v(SyntaxTree.CharacterValue).value));
  1411. ELSIF type = Global.Char32 THEN w.RawNum(ORD(v(SyntaxTree.CharacterValue).value));
  1412. *)
  1413. ELSIF (type IS SyntaxTree.IntegerType) & (type.sizeInBits = 64) THEN w.RawHInt(v(SyntaxTree.IntegerValue).hvalue);
  1414. ELSIF (type IS SyntaxTree.IntegerType) & (type.sizeInBits = 32) & ~type(SyntaxTree.IntegerType).signed THEN w.RawHInt(v(SyntaxTree.IntegerValue).hvalue);
  1415. ELSIF (type IS SyntaxTree.IntegerType) & (type.sizeInBits <= 32) THEN w.RawNum(v(SyntaxTree.IntegerValue).value);
  1416. ELSIF type IS SyntaxTree.SetType THEN w.RawNum(SYSTEM.VAL(LONGINT,v(SyntaxTree.SetValue).value));
  1417. ELSIF type IS SyntaxTree.FloatType THEN
  1418. IF type.sizeInBits = 32 THEN w.RawReal(SHORT(v(SyntaxTree.RealValue).value));
  1419. ELSE w.RawLReal(v(SyntaxTree.RealValue).value);
  1420. END;
  1421. ELSIF type IS SyntaxTree.StringType THEN w.RawLInt(v(SyntaxTree.StringValue).length); w.RawString(v(SyntaxTree.StringValue).value^);
  1422. ELSIF type IS SyntaxTree.NilType THEN
  1423. ELSIF type IS SyntaxTree.ByteType THEN HALT(100)
  1424. ELSIF type IS SyntaxTree.EnumerationType THEN w.RawNum(v(SyntaxTree.EnumerationValue).value);
  1425. ELSE HALT(200);
  1426. END;
  1427. END Value;
  1428. (*
  1429. Record =
  1430. mode:RawNum priority:Char {variable:Symbol}
  1431. [sfTProcedure {Symbol [name:RawString] ParameterList [sfInline Inline]} ]
  1432. sfEnd
  1433. *)
  1434. PROCEDURE Record(record: SyntaxTree.RecordType);
  1435. VAR scope: SyntaxTree.RecordScope; variable: SyntaxTree.Variable; procedure: SyntaxTree.Procedure; name: SyntaxTree.IdentifierString; flags,mode: SET;
  1436. procedureType: SyntaxTree.ProcedureType; body: SyntaxTree.Body; first: BOOLEAN;
  1437. BEGIN
  1438. scope := record.recordScope;
  1439. IF record.recordScope.bodyProcedure # NIL THEN
  1440. body := record.recordScope.bodyProcedure.procedureScope.body;
  1441. IF body.isActive THEN INCL(mode,sfActive) END;
  1442. IF body.isSafe THEN INCL(mode,sfSafe) END;
  1443. END;
  1444. IF record.IsProtected() THEN INCL(mode,sfProtected) END;
  1445. IF record.pointerType # NIL THEN INCL(mode,sfClass) END;
  1446. w.RawNum(SYSTEM.VAL(LONGINT,mode));
  1447. w.Char(0X); (*! record priority *)
  1448. variable := scope.firstVariable;
  1449. WHILE variable # NIL DO
  1450. ASSERT(variable.type # NIL);
  1451. Symbol(variable.type,variable.name,variable.access,variable.untraced,FALSE, FALSE, FALSE, FALSE);
  1452. variable := variable.nextVariable;
  1453. END;
  1454. procedure := scope.firstProcedure;
  1455. IF procedure # NIL THEN
  1456. w.RawNum(sfTProcedure);
  1457. WHILE procedure # NIL DO
  1458. procedureType := procedure.type(SyntaxTree.ProcedureType);
  1459. IF (procedure.access * SyntaxTree.Internal = procedure.access) THEN (* not exported method *)
  1460. Symbol(procedureType.returnType,procedure.name,procedure.access,FALSE, procedureType.isRealtime,procedure.isConstructor,procedure IS SyntaxTree.Operator, FALSE);
  1461. procedure.GetName(name);
  1462. w.RawString(name);
  1463. ELSE (* exported method *)
  1464. Symbol(procedureType.returnType,procedure.name,SyntaxTree.Public (*! for compatiblity should be procedure.access *),
  1465. FALSE, procedureType.isRealtime,procedure.isConstructor, procedure IS SyntaxTree.Operator, FALSE
  1466. );
  1467. END;
  1468. ParameterList(procedure.type(SyntaxTree.ProcedureType));
  1469. (*! inline *)
  1470. procedure := procedure.nextProcedure;
  1471. END;
  1472. END;
  1473. w.RawNum(sfEnd);
  1474. END Record;
  1475. (* returns the index of module importedModule in the list of module module *)
  1476. PROCEDURE ModuleIndex(module: SyntaxTree.Module; importedModule: SyntaxTree.Module): LONGINT;
  1477. VAR import: SyntaxTree.Import; index: LONGINT;
  1478. BEGIN import := module.moduleScope.firstImport;
  1479. index := 0;
  1480. WHILE (import # NIL) & (import.module # importedModule) DO
  1481. IF (* (import.direct) & *) ~Global.IsSystemModule(import.module) THEN INC(index) END;
  1482. import := import.nextImport;
  1483. END;
  1484. ASSERT(import # NIL);
  1485. RETURN index;
  1486. END ModuleIndex;
  1487. (*
  1488. Type =
  1489. TypeReference
  1490. |BasicType
  1491. |ImportedType
  1492. |UserType.
  1493. TypeReference = number:RawNum(<0)
  1494. BasicType = sfTypeBoolean | .. | sfLastType.
  1495. ImportedType = ModuleNumber (structName:RawString | 0X typeIndex:RawNum)
  1496. ModuleNumber = sfMod1 | .. | sfModOther-1 | sfModOther moduleNumber:RawNum
  1497. UserType = [sfInvisible] [sfSysFlag sysFlag:RawNum] UserType2
  1498. UserType2=
  1499. sfTypeOpenArray baseType:Type name:RawString flags:RawNum
  1500. |sfTypeStaticArray baseType:Type name:RawString flags:RawNum length:RawNum
  1501. |sfOpenMathArray baseType:Type name:RawString
  1502. |sfStaticMathArray baseType:Type name:RawString length:RawNum
  1503. |sfTypeTensor baseType:Type name:RawString
  1504. |sfTypePointer baseType:Type name:RawString flags:RawNum
  1505. |sfTypeRecord baseType:Type name:RawString flags:RawNum Record
  1506. |sfTypeProcedure baseType:Type name:RawString flags:RawNum ParameterList
  1507. |sfTypeEnumeration enumerationBase:Type name:RawString
  1508. *)
  1509. PROCEDURE Type(type: SyntaxTree.Type);
  1510. VAR typeIndex,moduleIndex: LONGINT; name:SyntaxTree.IdentifierString; importedModule: SyntaxTree.Module; attribute: Attribute;
  1511. baseType: SyntaxTree.Type; typeDeclaration : SyntaxTree.TypeDeclaration; flags: SET; size: LONGINT;
  1512. BEGIN
  1513. IF type = NIL THEN
  1514. IF TraceExport IN Trace THEN
  1515. D.Str("Type / Basic / NIL "); D.Ln
  1516. END;
  1517. w.RawNum(sfTypeNoType); RETURN
  1518. END;
  1519. type := type.resolved;
  1520. typeDeclaration := type.typeDeclaration;
  1521. IF (typeDeclaration # NIL) & (typeDeclaration.declaredType.resolved # type) THEN typeDeclaration := NIL END;
  1522. size := type.sizeInBits;
  1523. IF type IS SyntaxTree.BasicType THEN (* BasicType *)
  1524. IF type IS SyntaxTree.BooleanType THEN w.RawNum(sfTypeBoolean);
  1525. IF TraceExport IN Trace THEN
  1526. D.Str("Type / Basic / Boolean "); D.Ln
  1527. END;
  1528. ELSIF type IS SyntaxTree.CharacterType THEN
  1529. IF size = 8 THEN
  1530. w.RawNum(sfTypeChar8);
  1531. IF TraceExport IN Trace THEN
  1532. D.Str("Type / Basic / Char8"); D.Ln
  1533. END;
  1534. ELSIF size = 16 THEN
  1535. w.RawNum(sfTypeChar16);
  1536. IF TraceExport IN Trace THEN
  1537. D.Str("Type / Basic / Char16"); D.Ln
  1538. END;
  1539. ELSIF size = 32 THEN
  1540. w.RawNum(sfTypeChar32);
  1541. IF TraceExport IN Trace THEN
  1542. D.Str("Type / Basic / Char32"); D.Ln
  1543. END;
  1544. END
  1545. ELSIF type IS SyntaxTree.IntegerType THEN
  1546. IF type(SyntaxTree.IntegerType).signed THEN
  1547. IF size = 8 THEN
  1548. w.RawNum(sfTypeShortint);
  1549. IF TraceExport IN Trace THEN
  1550. D.Str("Type / Basic / Shortint"); D.Ln
  1551. END;
  1552. ELSIF size = 16 THEN
  1553. w.RawNum(sfTypeInteger);
  1554. IF TraceExport IN Trace THEN
  1555. D.Str("Type / Basic / Integer"); D.Ln
  1556. END;
  1557. ELSIF size = 32 THEN
  1558. w.RawNum(sfTypeLongint);
  1559. IF TraceExport IN Trace THEN
  1560. D.Str("Type / Basic / Longint"); D.Ln
  1561. END;
  1562. ELSIF size = 64 THEN w.RawNum(sfTypeHugeint);
  1563. IF TraceExport IN Trace THEN
  1564. D.Str("Type / Basic / Hugeint"); D.Ln
  1565. END;
  1566. END;
  1567. ELSE
  1568. IF size = 8 THEN
  1569. w.RawNum(sfTypeUnsigned8);
  1570. IF TraceExport IN Trace THEN
  1571. D.Str("Type / Basic / Unsigned8"); D.Ln
  1572. END;
  1573. ELSIF size = 16 THEN
  1574. w.RawNum(sfTypeUnsigned16);
  1575. IF TraceExport IN Trace THEN
  1576. D.Str("Type / Basic / Unsigned16"); D.Ln
  1577. END;
  1578. ELSIF size = 32 THEN
  1579. w.RawNum(sfTypeUnsigned32);
  1580. IF TraceExport IN Trace THEN
  1581. D.Str("Type / Basic / Unsigned32"); D.Ln
  1582. END;
  1583. ELSIF size = 64 THEN w.RawNum(sfTypeUnsigned64);
  1584. IF TraceExport IN Trace THEN
  1585. D.Str("Type / Basic / Unsigned64"); D.Ln
  1586. END;
  1587. END;
  1588. END;
  1589. ELSIF type IS SyntaxTree.FloatType THEN
  1590. IF size = 32 THEN
  1591. w.RawNum(sfTypeReal);
  1592. IF TraceExport IN Trace THEN
  1593. D.Str("Type / Basic / Real"); D.Ln
  1594. END;
  1595. ELSIF size = 64 THEN
  1596. w.RawNum(sfTypeLongreal);
  1597. IF TraceExport IN Trace THEN
  1598. D.Str("Type / Basic / Longreal"); D.Ln
  1599. END;
  1600. END;
  1601. ELSIF type IS SyntaxTree.ComplexType THEN
  1602. IF size = 64 THEN
  1603. w.RawNum(sfTypeComplex);
  1604. IF TraceExport IN Trace THEN
  1605. D.Str("Type / Basic / Complex"); D.Ln
  1606. END;
  1607. ELSIF size = 128 THEN
  1608. w.RawNum(sfTypeLongcomplex);
  1609. IF TraceExport IN Trace THEN
  1610. D.Str("Type / Basic / Longcomplex"); D.Ln
  1611. END;
  1612. END;
  1613. ELSIF type IS SyntaxTree.SetType THEN
  1614. w.RawNum(sfTypeSet);
  1615. IF TraceExport IN Trace THEN
  1616. D.Str("Type / Basic / Set"); D.Ln
  1617. END;
  1618. ELSIF type IS SyntaxTree.NilType THEN w.RawNum(sfTypeNilType);
  1619. IF TraceExport IN Trace THEN
  1620. D.Str("Type / Basic / NilType"); D.Ln
  1621. END;
  1622. ELSIF type IS SyntaxTree.AnyType THEN w.RawNum(sfTypeAny);
  1623. IF TraceExport IN Trace THEN
  1624. D.Str("Type / Basic / Any"); D.Ln
  1625. END;
  1626. ELSIF type IS SyntaxTree.ObjectType THEN
  1627. w.RawNum(sfTypeObject);
  1628. IF TraceExport IN Trace THEN
  1629. D.Str("Type / Basic / Object"); D.Ln
  1630. END;
  1631. ELSIF type IS SyntaxTree.ByteType THEN
  1632. w.RawNum(sfTypeByte);
  1633. IF TraceExport IN Trace THEN
  1634. D.Str("Type / Basic / Byte"); D.Ln
  1635. END;
  1636. ELSIF type IS SyntaxTree.RangeType THEN w.RawNum(sfTypeRange);
  1637. IF TraceExport IN Trace THEN
  1638. D.Str("Type / Basic / Range"); D.Ln
  1639. END;
  1640. ELSIF type IS SyntaxTree.AddressType THEN w.RawNum(sfTypeAddress) (*! compatibility with PACO *)
  1641. ELSIF type IS SyntaxTree.SizeType THEN w.RawNum(sfTypeSize)
  1642. ELSE HALT(100)
  1643. END;
  1644. ELSIF type IS SyntaxTree.StringType THEN (* special case BasicType : StringType *)
  1645. IF TraceExport IN Trace THEN
  1646. D.Str("Type / String "); D.Ln
  1647. END;
  1648. w.RawNum(sfTypeString); (*! string length should be written here also *)
  1649. ELSIF (typeDeclaration # NIL) & (typeDeclaration.scope # NIL) & (typeDeclaration.scope.ownerModule # module) THEN (* ImportedType *)
  1650. (* imported, reexport:
  1651. ImportedType = ModuleNumber (structName:RawString | 0X typeIndex:RawNum)
  1652. ModuleNumber = sfMod1 | .. | sfModOther-1 | sfModOther moduleNumber:RawNum
  1653. *)
  1654. typeDeclaration.GetName(name);
  1655. importedModule := typeDeclaration.scope.ownerModule;
  1656. moduleIndex := ModuleIndex(module,importedModule);
  1657. ASSERT(moduleIndex >= 0);
  1658. IF moduleIndex >= sfModOther - sfMod1 THEN w.RawNum(sfModOther); w.RawNum(moduleIndex)
  1659. ELSE w.RawNum(sfMod1 + moduleIndex)
  1660. END;
  1661. attribute := indexToAttribute.GetAttribute(moduleIndex);
  1662. typeIndex := attribute.typeToIndex.GetIndex(type);
  1663. IF TraceExport IN Trace THEN
  1664. D.Str("Type / Reexport "); D.Str(name); D.Str(":"); D.Int(typeIndex,1); D.String(" in "); D.Str0(importedModule.name); D.String(":"); D.Int(moduleIndex,1);D.Ln
  1665. END;
  1666. IF typeIndex = Undef THEN (* not yet written import: structName:RawString *)
  1667. type.typeDeclaration.GetName(name);
  1668. w.RawString(name);
  1669. attribute.typeToIndex.PutIndex(type,attribute.numberTypes); INC(attribute.numberTypes);
  1670. ELSE (* previously written import: 0X typeIndex:RawNum *)
  1671. w.Char(0X); w.RawNum(typeIndex);
  1672. END;
  1673. ELSE
  1674. IF TraceExport IN Trace THEN
  1675. D.Str("Type / User "); D.Ln
  1676. END;
  1677. typeIndex := lookup.GetIndex(type);
  1678. IF typeIndex # Undef THEN (* already written: TypeReference = number:RawNum (<0)*)
  1679. IF TraceExport IN Trace THEN
  1680. D.Str("Type / User / AlreadyWritten "); D.Ln
  1681. END;
  1682. w.RawNum(-typeIndex)
  1683. ELSE (* UserType *)
  1684. IF TraceExport IN Trace THEN D.Str("Type / UserType "); D.Ln END;
  1685. lookup.PutIndex(type,numberType); INC(numberType);
  1686. name:="";
  1687. IF typeDeclaration#NIL THEN typeDeclaration.GetName(name);
  1688. IF typeDeclaration.access* SyntaxTree.Public={} THEN
  1689. w.RawNum(sfInvisible);
  1690. END;
  1691. END;
  1692. flags := {};
  1693. IF type IS SyntaxTree.RecordType THEN
  1694. IF TraceExport IN Trace THEN D.Str("Type / UserType / RecordType "); D.Str(name); D.Ln END;
  1695. WITH type: SyntaxTree.RecordType DO
  1696. w.RawNum(sfTypeRecord);
  1697. baseType := type.baseType;
  1698. Type(baseType);
  1699. w.RawString(name);
  1700. IF type.isRealtime THEN INCL(flags,sfRealtime) END;
  1701. w.RawNum(SYSTEM.VAL(LONGINT,flags));
  1702. Record(type)
  1703. END
  1704. ELSIF type IS SyntaxTree.PointerType THEN
  1705. IF TraceExport IN Trace THEN D.Str("Type / UserType / PointerType "); D.Str(name); D.Ln END;
  1706. w.RawNum(sfTypePointer);
  1707. Type(type(SyntaxTree.PointerType).pointerBase);
  1708. w.RawString(name);
  1709. WITH type: SyntaxTree.PointerType DO
  1710. IF type.isUnsafe THEN INCL(flags,sfUnsafe) END;
  1711. IF type.isRealtime THEN INCL(flags,sfRealtime) END;
  1712. IF type.isDisposable THEN INCL(flags,sfDisposable) END;
  1713. END;
  1714. w.RawNum(SYSTEM.VAL(LONGINT,flags));
  1715. ELSIF type IS SyntaxTree.ArrayType THEN
  1716. IF TraceExport IN Trace THEN D.Str("Type / UserType / ArrayType "); D.Str(name); D.Ln END;
  1717. WITH type: SyntaxTree.ArrayType DO
  1718. IF type.form = SyntaxTree.Open THEN
  1719. w.RawNum(sfTypeOpenArray)
  1720. ELSIF type.form = SyntaxTree.Static THEN
  1721. w.RawNum(sfTypeStaticArray)
  1722. ELSE HALT(100)
  1723. END;
  1724. Type(type.arrayBase);
  1725. w.RawString(name);
  1726. IF type.isRealtime THEN INCL(flags,sfRealtime) END;
  1727. w.RawNum(SYSTEM.VAL(LONGINT,flags));
  1728. IF type.form = SyntaxTree.Static THEN
  1729. w.RawNum(type.staticLength);
  1730. END;
  1731. END;
  1732. ELSIF type IS SyntaxTree.MathArrayType THEN
  1733. IF TraceExport IN Trace THEN D.Str("Type / UserType / MathArrayType "); D.Str(name); D.Ln END;
  1734. WITH type: SyntaxTree.MathArrayType DO
  1735. IF type.form = SyntaxTree.Open THEN
  1736. w.RawNum(sfTypeOpenMathArray)
  1737. ELSIF type.form = SyntaxTree.Static THEN
  1738. w.RawNum(sfTypeStaticMathArray)
  1739. ELSIF type.form = SyntaxTree.Tensor THEN
  1740. w.RawNum(sfTypeTensor)
  1741. ELSE HALT(100)
  1742. END;
  1743. Type(type.arrayBase);
  1744. w.RawString(name);
  1745. IF type.isRealtime THEN INCL(flags,sfRealtime) END;
  1746. w.RawNum(SYSTEM.VAL(LONGINT,flags));
  1747. IF type.form = SyntaxTree.Static THEN
  1748. w.RawNum(type.staticLength);
  1749. END;
  1750. END;
  1751. ELSIF type IS SyntaxTree.ProcedureType THEN
  1752. IF TraceExport IN Trace THEN D.Str("Type / UserType / ProcedureType"); D.Str(name); D.Ln END;
  1753. WITH type: SyntaxTree.ProcedureType DO
  1754. IF type.isDelegate THEN
  1755. w.RawNum(sfSysFlag); w.RawNum(sfDelegate);
  1756. END;
  1757. w.RawNum(sfTypeProcedure);
  1758. Type(type.returnType);
  1759. w.RawString(name);
  1760. IF type.callingConvention = SyntaxTree.WinAPICallingConvention THEN
  1761. INCL(flags,sfWinAPIParam);
  1762. ELSIF type.callingConvention = SyntaxTree.CCallingConvention THEN
  1763. INCL(flags,sfCParam);
  1764. ELSIF type.callingConvention = SyntaxTree.DarwinCCallingConvention THEN
  1765. INCL(flags,sfDarwinCParam);
  1766. END;
  1767. IF type.isRealtime THEN
  1768. INCL(flags,sfRealtime)
  1769. END;
  1770. w.RawNum(SYSTEM.VAL(LONGINT,flags));
  1771. ParameterList(type);
  1772. END;
  1773. ELSIF type IS SyntaxTree.EnumerationType THEN
  1774. IF TraceExport IN Trace THEN D.Str("Type / UserType / EnumerationType"); D.Str(name); D.Ln END;
  1775. WITH type: SyntaxTree.EnumerationType DO
  1776. w.RawNum(sfTypeEnumeration);
  1777. Type(type.enumerationBase);
  1778. w.RawString(name);
  1779. EnumerationList(type.enumerationScope);
  1780. END;
  1781. ELSE HALT(200)
  1782. END;
  1783. END;
  1784. END;
  1785. END Type;
  1786. (*
  1787. EnumerationList = {name:RawString} 0X;
  1788. *)
  1789. PROCEDURE EnumerationList(enumerationScope: SyntaxTree.EnumerationScope);
  1790. VAR name: SyntaxTree.IdentifierString; enumerator: SyntaxTree.Constant;
  1791. BEGIN
  1792. enumerator := enumerationScope.firstConstant;
  1793. WHILE enumerator # NIL DO
  1794. enumerator.GetName(name);
  1795. IF enumerator.access * SyntaxTree.Public = {} THEN
  1796. w.RawString("@");
  1797. ELSE
  1798. w.RawString(name);
  1799. END;
  1800. Value(enumerator.value.resolved);
  1801. enumerator := enumerator.nextConstant;
  1802. END;
  1803. w.RawString("");
  1804. END EnumerationList;
  1805. (* ParameterList =
  1806. { [sfObjFlag sfWinAPIParam | sfObjFlag sfCParam | sfObjFlag sfDarwinCParam] [sfVar] [sfReadOnly] Type name:RawString } sfEnd
  1807. *)
  1808. PROCEDURE ParameterList(procedureType: SyntaxTree.ProcedureType);
  1809. VAR flags: SET; name: SyntaxTree.IdentifierString;
  1810. PROCEDURE Parameters(parameter: SyntaxTree.Parameter; reverse: BOOLEAN);
  1811. VAR procedureType: SyntaxTree.ProcedureType;
  1812. BEGIN
  1813. WHILE parameter # NIL DO
  1814. (*! the calling convention should not be expressed via the parameters (compatiblity with old compiler) *)
  1815. procedureType := parameter.ownerType(SyntaxTree.ProcedureType);
  1816. IF procedureType.callingConvention = SyntaxTree.WinAPICallingConvention THEN
  1817. w.RawNum(sfObjFlag); w.RawNum(sfWinAPIParam);
  1818. ELSIF procedureType.callingConvention = SyntaxTree.CCallingConvention THEN
  1819. w.RawNum(sfObjFlag); w.RawNum(sfCParam);
  1820. ELSIF procedureType.callingConvention = SyntaxTree.DarwinCCallingConvention THEN
  1821. w.RawNum(sfObjFlag); w.RawNum(sfDarwinCParam);
  1822. END;
  1823. IF parameter.kind = SyntaxTree.VarParameter THEN
  1824. w.RawNum(sfVar)
  1825. ELSIF parameter.kind = SyntaxTree.ConstParameter THEN
  1826. IF (parameter.type.resolved IS SyntaxTree.ArrayType) OR (parameter.type.resolved IS SyntaxTree.RecordType) THEN
  1827. w.RawNum(sfVar);
  1828. END; (* cf. FingerPrint.FPSignature *)
  1829. w.RawNum(sfReadOnly);
  1830. END;
  1831. Type(parameter.type);
  1832. parameter.GetName(name);
  1833. w.RawString(name);
  1834. IF reverse THEN
  1835. parameter := parameter.prevParameter
  1836. ELSE
  1837. parameter := parameter.nextParameter
  1838. END;
  1839. END;
  1840. END Parameters;
  1841. BEGIN
  1842. IF procedureType.callingConvention # SyntaxTree.OberonCallingConvention THEN
  1843. (*! if a procedure has a return type, then it has a return parameter (new)
  1844. ASSERT(procedureType.returnParameter = NIL);
  1845. *)
  1846. Parameters(procedureType.lastParameter,TRUE);
  1847. ELSE
  1848. Parameters(procedureType.firstParameter,FALSE);
  1849. END;
  1850. w.RawNum(sfEnd);
  1851. END ParameterList;
  1852. PROCEDURE Inline(procedureScope: SyntaxTree.ProcedureScope);
  1853. VAR len,count,pos: LONGINT; code: SyntaxTree.Code; ch: CHAR;
  1854. BEGIN
  1855. code := procedureScope.body.code;
  1856. IF code.inlineCode # NIL THEN
  1857. len := code.inlineCode.GetSize() DIV 8;
  1858. ELSE
  1859. len := 0
  1860. END;
  1861. count := 0; pos := 0;
  1862. IF len = 0 THEN
  1863. w.Char(0X);
  1864. ELSE
  1865. WHILE pos < len DO
  1866. IF count = 0 THEN
  1867. count := 255;
  1868. IF len < 255 THEN count := len END;
  1869. w.Char(CHR(count))
  1870. END;
  1871. ch := CHR(code.inlineCode.GetBits(pos*8,8));
  1872. w.Char(ch);
  1873. INC(pos); DEC(count)
  1874. END;
  1875. END;
  1876. w.Char(0X);
  1877. END Inline;
  1878. (* Symbol =
  1879. [sfObjFlag flag:RawNum] [sfReadOnly] Type Name
  1880. *)
  1881. PROCEDURE Symbol(type: SyntaxTree.Type; name: SyntaxTree.Identifier; visibility: SET;untraced, realtime, constructor, operator, isDynamic: BOOLEAN);
  1882. VAR string,string2: SyntaxTree.IdentifierString;
  1883. BEGIN
  1884. IF TraceExport IN Trace THEN
  1885. Basic.GetString(name,string);
  1886. D.Str("Symbol "); D.Str(string); D.Ln;
  1887. END;
  1888. IF untraced THEN w.RawNum(sfObjFlag); w.RawNum(sfUntraced)
  1889. ELSIF realtime THEN w.RawNum(sfObjFlag); w.RawNum(sfRealtime)
  1890. END;
  1891. IF operator THEN w.RawNum(sfObjFlag); w.RawNum(sfOperator) END;
  1892. IF isDynamic THEN w.RawNum(sfObjFlag); w.RawNum(sfDynamic) END;
  1893. IF (SyntaxTree.PublicRead IN visibility) & ~(SyntaxTree.PublicWrite IN visibility) THEN
  1894. w.RawNum(sfReadOnly);
  1895. END;
  1896. Type(type);
  1897. IF visibility * SyntaxTree.Internal = visibility THEN
  1898. string2 := "";
  1899. IF constructor THEN string2 := "&" END;
  1900. ELSE Basic.GetString(name,string);
  1901. IF constructor THEN
  1902. Basic.Concat(string2,"&",string,"");
  1903. ELSE
  1904. string2 := string
  1905. END;
  1906. END;
  1907. w.RawString(string2);
  1908. END Symbol;
  1909. (*
  1910. SymbolFile =
  1911. flags:RawSet
  1912. Imports
  1913. [sfSysFlag flags:Number]
  1914. [sfConst {Symbol Value}]
  1915. [sfVar {Symbol}]
  1916. [sfXProcedure {Symbol ParameterList}]
  1917. [sfOperator {Symbol ParameterList [sfInline Inline]}]
  1918. [sfCProcedure {Symbol ParameterList Inline}]
  1919. [sfAlias {declaredType:Type Name}]
  1920. [sfType {declaredType:Type}]
  1921. sfEnd
  1922. *)
  1923. PROCEDURE Module(module: SyntaxTree.Module);
  1924. VAR constant: SyntaxTree.Constant; name: SyntaxTree.IdentifierString; first: BOOLEAN;
  1925. variable: SyntaxTree.Variable; typeDeclaration: SyntaxTree.TypeDeclaration; procedure: SyntaxTree.Procedure;
  1926. procedureType: SyntaxTree.ProcedureType;
  1927. BEGIN
  1928. IF TraceExport IN Trace THEN
  1929. module.GetName(name);
  1930. D.Str("BINARY SYMBOL FILE EXPORT "); D.Str(name); D.Ln;
  1931. END;
  1932. w.RawSet({}); (* compilation flags *)
  1933. (* overloading flags omitted *)
  1934. (* import section: write names of imported modules *)
  1935. Imports(module.moduleScope.firstImport);
  1936. (* constants *)
  1937. IF TraceExport IN Trace THEN
  1938. D.Str("exporting constants "); D.Ln;
  1939. END;
  1940. first :=TRUE;
  1941. constant := module.moduleScope.firstConstant;
  1942. WHILE constant # NIL DO
  1943. IF constant.access * SyntaxTree.Public # {} THEN
  1944. IF first THEN w.RawNum(sfConst); first := FALSE END;
  1945. Symbol(constant.type,constant.name,SyntaxTree.Public (*! for compatiblity should be constant.access *) ,FALSE,FALSE,FALSE,FALSE, FALSE);
  1946. constant.GetName(name);
  1947. Value(constant.value.resolved(SyntaxTree.Value))
  1948. END;
  1949. constant := constant.nextConstant;
  1950. END;
  1951. (* variables *)
  1952. IF TraceExport IN Trace THEN
  1953. D.Str("exporting variables "); D.Ln;
  1954. END;
  1955. first := TRUE;
  1956. variable := module.moduleScope.firstVariable;
  1957. WHILE variable # NIL DO
  1958. IF variable.access * SyntaxTree.Public # {} THEN
  1959. IF first THEN w.RawNum(sfVar); first := FALSE END;
  1960. Symbol(variable.type,variable.name,variable.access,variable.untraced, FALSE, FALSE, FALSE, FALSE);
  1961. END;
  1962. variable := variable.nextVariable;
  1963. END;
  1964. (* procedures: normal *)
  1965. IF TraceExport IN Trace THEN
  1966. D.Str("exporting procedures "); D.Ln;
  1967. END;
  1968. first := TRUE;
  1969. procedure := module.moduleScope.firstProcedure;
  1970. WHILE procedure # NIL DO
  1971. IF (procedure.access * SyntaxTree.Public # {}) & ~(procedure IS SyntaxTree.Operator) THEN
  1972. procedureType := procedure.type(SyntaxTree.ProcedureType);
  1973. IF ~procedure.isInline THEN
  1974. IF first THEN w.RawNum(sfXProcedure); first := FALSE END;
  1975. Symbol(procedureType.returnType,procedure.name,SyntaxTree.Public (*! for compatiblity should be procedure.access *),
  1976. FALSE, procedureType.isRealtime, procedure.isConstructor, FALSE, FALSE);
  1977. ParameterList(procedureType);
  1978. END;
  1979. END;
  1980. procedure := procedure.nextProcedure;
  1981. END;
  1982. (* procedures: operators *)
  1983. IF TraceExport IN Trace THEN
  1984. D.Str("exporting operators"); D.Ln;
  1985. END;
  1986. first := TRUE;
  1987. procedure := module.moduleScope.firstProcedure;
  1988. WHILE procedure # NIL DO
  1989. IF (procedure.access * SyntaxTree.Public # {}) & (procedure IS SyntaxTree.Operator) THEN
  1990. procedureType := procedure.type(SyntaxTree.ProcedureType);
  1991. IF first THEN w.RawNum(sfOperator); first := FALSE END;
  1992. Symbol(procedureType.returnType,procedure.name,SyntaxTree.Public (*! for compatiblity should be procedure.access *),
  1993. FALSE, procedure.isInline, procedure.isConstructor, FALSE, procedure(SyntaxTree.Operator).isDynamic);
  1994. ParameterList(procedureType);
  1995. IF procedure.isInline THEN
  1996. w.RawNum(sfInline); Inline(procedure.procedureScope);
  1997. END;
  1998. END;
  1999. procedure := procedure.nextProcedure;
  2000. END;
  2001. (* procedures: inline *)
  2002. IF TraceExport IN Trace THEN
  2003. D.Str("exporting inline procedures"); D.Ln;
  2004. END;
  2005. first := TRUE;
  2006. procedure := module.moduleScope.firstProcedure;
  2007. WHILE procedure # NIL DO
  2008. IF (procedure.access * SyntaxTree.Public # {}) & ~(procedure IS SyntaxTree.Operator) THEN
  2009. procedureType := procedure.type(SyntaxTree.ProcedureType);
  2010. IF procedure.isInline THEN
  2011. IF first THEN w.RawNum(sfCProcedure); first := FALSE END;
  2012. Symbol(procedureType.returnType,procedure.name,SyntaxTree.Public (*! for compatiblity should be procedure.access *),
  2013. FALSE, procedure.isInline, procedure.isConstructor, FALSE, FALSE);
  2014. ParameterList(procedureType);
  2015. Inline(procedure.procedureScope);
  2016. END;
  2017. END;
  2018. procedure := procedure.nextProcedure;
  2019. END;
  2020. (* type declarations: aliases *)
  2021. IF TraceExport IN Trace THEN
  2022. D.Str("exporting type declarations aliases"); D.Ln;
  2023. END;
  2024. first := TRUE;
  2025. typeDeclaration := module.moduleScope.firstTypeDeclaration;
  2026. WHILE typeDeclaration # NIL DO
  2027. IF typeDeclaration.access * SyntaxTree.Public # {} THEN
  2028. IF typeDeclaration.declaredType IS SyntaxTree.QualifiedType THEN
  2029. IF first THEN w.RawNum(sfAlias); first := FALSE END;
  2030. Type(typeDeclaration.declaredType);
  2031. typeDeclaration.GetName(name);
  2032. w.RawString(name);
  2033. END;
  2034. END;
  2035. typeDeclaration := typeDeclaration.nextTypeDeclaration;
  2036. END;
  2037. (* type declarations: declarations *)
  2038. IF TraceExport IN Trace THEN
  2039. D.Str("exporting type declarations"); D.Ln;
  2040. END;
  2041. first := TRUE;
  2042. typeDeclaration := module.moduleScope.firstTypeDeclaration;
  2043. WHILE typeDeclaration # NIL DO
  2044. IF typeDeclaration.access * SyntaxTree.Public # {} THEN
  2045. IF ~(typeDeclaration.declaredType IS SyntaxTree.QualifiedType) THEN
  2046. IF first THEN w.RawNum(sfType); first := FALSE END;
  2047. Type(typeDeclaration.declaredType);
  2048. END;
  2049. END;
  2050. typeDeclaration := typeDeclaration.nextTypeDeclaration;
  2051. END;
  2052. IF TraceExport IN Trace THEN
  2053. module.GetName(name);
  2054. D.Str("BINARY SYMBOL FILE EXPORT DONE "); D.Str(name); D.Ln;
  2055. END;
  2056. w.RawNum(sfEnd);
  2057. END Module;
  2058. BEGIN
  2059. file := Files.New("");
  2060. IF ~noInterfaceCheck THEN
  2061. InterfaceComparison.CompareThis(module,SELF,diagnostics,importCache,flags);
  2062. IF noRedefinition OR noModification THEN
  2063. IF (InterfaceComparison.Redefined IN flags) THEN
  2064. diagnostics.Error(module.sourceName,Diagnostics.Invalid,Diagnostics.Invalid," no redefinition of symbol file allowed");
  2065. RETURN FALSE;
  2066. END;
  2067. END;
  2068. IF noModification THEN
  2069. IF (InterfaceComparison.Extended IN flags) THEN
  2070. diagnostics.Error(module.sourceName,Diagnostics.Invalid,Diagnostics.Invalid," no extension of symbol file allowed");
  2071. RETURN FALSE;
  2072. END;
  2073. END;
  2074. END;
  2075. NEW(w,file,0);
  2076. NEW(lookup,100); NEW(indexToAttribute,16);
  2077. numberType := 0;
  2078. Module(module);
  2079. w.Update();
  2080. Files.Register(file);
  2081. RETURN TRUE
  2082. END Export;
  2083. PROCEDURE DefineOptions*(options: Options.Options);
  2084. BEGIN
  2085. options.Add(0X,"symbolFileExtension",Options.String);
  2086. options.Add(0X,"noRedefinition",Options.Flag);
  2087. options.Add(0X,"noModification",Options.Flag);
  2088. options.Add(0X,"noInterfaceCheck",Options.Flag);
  2089. END DefineOptions;
  2090. PROCEDURE GetOptions*(options: Options.Options);
  2091. BEGIN
  2092. IF ~options.GetString("symbolFileExtension",extension) THEN
  2093. extension := Machine.DefaultObjectFileExtension
  2094. END;
  2095. noRedefinition := options.GetFlag("noRedefinition");
  2096. noModification := options.GetFlag("noModification");
  2097. noInterfaceCheck := options.GetFlag("noInterfaceCheck");
  2098. END GetOptions;
  2099. END BinarySymbolFile;
  2100. VAR
  2101. (* move to basic *)
  2102. PROCEDURE MakeFileName(VAR file: ARRAY OF CHAR; CONST name, prefix, suffix: ARRAY OF CHAR);
  2103. VAR i, j: LONGINT;
  2104. BEGIN
  2105. i := 0; WHILE prefix[i] # 0X DO file[i] := prefix[i]; INC(i) END;
  2106. j := 0; WHILE name[j] # 0X DO file[i+j] := name[j]; INC(j) END;
  2107. INC(i, j);
  2108. j := 0; WHILE suffix[j] # 0X DO file[i+j] := suffix[j]; INC(j) END;
  2109. file[i+j] := 0X;
  2110. END MakeFileName;
  2111. (** OpenSymFile - Open a symfile for reading *)
  2112. PROCEDURE OpenSymFile(CONST name,prefix,suffix: ARRAY OF CHAR; VAR r: Streams.Reader; VAR version: CHAR): BOOLEAN;
  2113. VAR res: BOOLEAN; file: Files.FileName; f: Files.File; R: Files.Reader; dummy: LONGINT; ch: CHAR;
  2114. BEGIN
  2115. res := FALSE;
  2116. MakeFileName(file, name, prefix, suffix);
  2117. f := Files.Old(file);
  2118. IF f # NIL THEN
  2119. NEW(R,f,0);
  2120. r := R;
  2121. r.Char(ch);
  2122. IF ch = FileTag THEN
  2123. r.Char(version);
  2124. ASSERT(version = NoZeroCompress); r.Char(version);
  2125. IF version = FileVersion THEN
  2126. r.RawNum(dummy); (*skip symfile size*)
  2127. ELSIF (version >= FileVersionOC) & (version <= FileVersionCurrent) THEN
  2128. r.RawLInt(dummy); (* new in OC: symbol file size uncompressed *)
  2129. ELSE
  2130. HALT(100)
  2131. END;
  2132. res := TRUE
  2133. END
  2134. END;
  2135. RETURN res
  2136. END OpenSymFile;
  2137. PROCEDURE Get*(): Formats.SymbolFileFormat;
  2138. VAR symbolFileFormat: BinarySymbolFile;
  2139. BEGIN
  2140. NEW(symbolFileFormat); symbolFileFormat.file := Files.New(""); RETURN symbolFileFormat
  2141. END Get;
  2142. PROCEDURE Test*(context: Commands.Context);
  2143. VAR moduleName: SyntaxTree.IdentifierString; module: SyntaxTree.Module;
  2144. log2: Basic.Writer; time: LONGINT;
  2145. p: Printout.Printer;
  2146. symbolFileFormat: BinarySymbolFile;
  2147. options: Options.Options;
  2148. extension: Basic.FileName;
  2149. BEGIN
  2150. NEW(options);
  2151. NEW(symbolFileFormat);
  2152. symbolFileFormat.DefineOptions(options);
  2153. IF options.Parse(context.arg,context.error) THEN
  2154. symbolFileFormat.GetOptions(options);
  2155. context.arg.SkipWhitespace; context.arg.String(moduleName);
  2156. time := Kernel.GetTicks();
  2157. symbolFileFormat.Initialize(NIL,Global.DefaultSystem(),"");
  2158. module := symbolFileFormat.Import(moduleName,NIL);
  2159. time := Kernel.GetTicks()-time;
  2160. D.Str("importer elapsed ms: "); D.Int(time,10); D.Ln;
  2161. D.Update;
  2162. log2 := Basic.GetWriter(Basic.GetDebugWriter("SymbolFile"));
  2163. p := Printout.NewPrinter(log2,Printout.SymbolFile,FALSE);
  2164. log2.String("Interface of "); log2.String(moduleName); log2.Ln;
  2165. log2.Ln;
  2166. p.Module(module);
  2167. log2.Ln;
  2168. log2.Ln;
  2169. log2.String(" -------------------------------------------------------------- "); log2.Ln;
  2170. log2.Ln;
  2171. log2.Ln;
  2172. p := Printout.NewPrinter(log2,Printout.All,TRUE);
  2173. p.Module(module);
  2174. log2.Update;
  2175. END;
  2176. END Test;
  2177. END FoxBinarySymbolFile.
  2178. SystemTools.Free FoxBinarySymbolFile ~
  2179. FoxBinarySymbolFile.Test Visualizer ~
  2180. Compiler.Compile -PCtp Visualizer.Sym ~
  2181. FoxBinarySymbolFile.Test Oberon.Oberon ~
  2182. FoxBinarySymbolFile.Test --symbolFileExtension=".Obw" Dump ~