FoxFingerprinter.Mod 45 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360
  1. MODULE FoxFingerprinter; (** AUTHOR "fof"; PURPOSE "Fingerprinting"; *)
  2. (* literature for the fingerprinting: Dissertation Crelier *)
  3. IMPORT SyntaxTree := FoxSyntaxTree, Basic := FoxBasic, SYSTEM, Global := FoxGlobal,Scanner := FoxScanner,
  4. D := Debugging, Streams;
  5. (** Fingerprinting
  6. FP(TypeDeclaration) = 0 <*> fpModeType -> Name -> Visibility <*> FP(Type).
  7. FP(ConstantDeclaration) = 0 <*> fpModeConstant -> Name -> Visibility <*> FP(Type) -> Basic -> Value.
  8. FP(VariableDeclaration) = 0 <*> fpModePar -> Name -> Visibility <*> FP(Type).
  9. FP(ProcedureDeclaration) = 0 <*> fpModeInlineProcedure -> Name -> Visibility <*> FP(Type) -> Code.
  10. | 0 <*> fpModeExportedProcedure -> Name -> Visibility <*> FP(Type)
  11. Name(fp,name) = fp <*> name[0] <*> ... <*> name[n].
  12. Visibility(fp,vis) = fp <*> fpExtern | fp <*> fpExternR | fp <*> fpOther <*> vis.
  13. Value(fp) = fp <*> fpTrue | fp <*> fpFalse | fp <*> integer | fp <*> intlow <*> inthigh | fp -> Name
  14. FP(Type) = FP(BasicType) | FP(RecordType) | FP(PointerType)
  15. | FP(ArrayType) | FP(MathArrayType) | FP(ProcedurType)
  16. FP(BasicType) = fpTypeChar8 | fpTypeChar16 | fpTypeChar32
  17. | fpTypeShortint | fpTypeInteger | fpTypeLongint | fpTypeHugeint
  18. | fpTypeReal | fpTypeLongreal
  19. | fpTypeSet | fpTypePointer |fpTypeString
  20. | fpTypeByte | fpTypeAll | fpTypeSame | fpTypeRange | fpTypeBoolean.
  21. PublicFP(BasicType) = FP(basicType).
  22. PrivateFP(BasicType) = sizeof(basicType).
  23. FP(RecordType) = fpTypeComposite <*> fptypeRecord
  24. [ -> Name(moduleName) -> Name(typeName)] [<*> FP(baseType)]
  25. PublicFP(RecordType) = FP(recordType) [<*> PublicFP(baseType)] {<*> FP(method) <*> methodNumber }
  26. {<*> PublicFP(fieldType) <*> offset(field) <*> FP(field)} <*> flags.
  27. PrivateFP(RecordType) = FP(recordType) [<*> PrivateFP(baseType)] {<*> FP(method) <*> methodNumber }
  28. {<*> PrivateFP(fieldType) <*> offset(field) <*> FP(field)}
  29. FP(Method) = 0 <*> fpModeMethod -> Name(methodName) -> Signature(method).
  30. FP(Field) = 0 <*> fpModeField -> Name(fieldName) -> Visibility [<*> fpUntraced] <*> FP(type).
  31. FP(PointerType) = fpTypePointer <*> fpTypeBasic -> Name <*> FP(baseType).
  32. PublicFP(PointerType) = 0.
  33. PrivateFP(PointerType) = 0.
  34. FP(ArrayType) = fpTypeComposite <*> (fpTypeOpenArray | fpTypeStaticArray)
  35. -> Name <*> FP(baseType) [<*> length].
  36. PublicFP(ArrayType) = FP(arrayType).
  37. PrivateFP(ArrayType) = FP(arrayType).
  38. FP(MathArrayType) = fpTypeComposite <*> (fpTypeOpenArray | fpTypeStaticArray)
  39. -> Name <*> FP(baseType) [<*> length].
  40. PublicFP(MathArrayType) = FP(arrayType).
  41. PrivateFP(MathArrayType) = FP(arrayType).
  42. FP(ProcedureType) = fpTypeProcedure <*> fpTypeBasic [<*> fpDelegate]-> Name.
  43. PublicFP(ProcedureType) = FP(arrayType) -> Signature(procedureType)
  44. PrivateFP(ProcedureType) = FP(arrayType)-> Signature(procedureType).
  45. Signature(f) = f <*> FP(returnType)
  46. { <*> (fpModeVarParameter | fpModeConstParameter | fpModePar)
  47. <*> FP(parameterType) [-> Name(parameterName)] }
  48. **)
  49. CONST
  50. (*Fingerprints/Obj Modes*)
  51. fpModeVar=1;
  52. fpModePar=1;
  53. fpModeVarPar=2;
  54. fpModeConstPar=fpModeVarPar; (*! for compatibility, must be changed *)
  55. fpModeConst=3;
  56. fpModeField=4;
  57. fpModeType=5;
  58. fpModeExportedProcedure=7;
  59. fpModeInlineProcedure=9;
  60. fpModeMethod=13;
  61. (*Fingerprints/Type Forms*)
  62. fpTypeByte = 1;
  63. fpTypeBoolean=2;
  64. fpTypeChar8=3;
  65. fpTypeShortint=4;
  66. fpTypeInteger=5;
  67. fpTypeLongint=6;
  68. fpTypeReal=7;
  69. fpTypeLongreal=8;
  70. fpTypeSet=9;
  71. fpTypeString=10;
  72. fpTypeNone = 12;
  73. fpTypePointer=13;
  74. fpTypeProcedure=14;
  75. fpTypeComposite=15;
  76. fpTypeHugeint=16;
  77. fpTypeChar16 = 17;
  78. fpTypeChar32 = 18;
  79. fpTypeAll = 19;
  80. fpTypeSame = 20;
  81. fpTypeRange = 21;
  82. fpTypeEnum = 22;
  83. fpTypePort = 23;
  84. fpTypeChannel = 23;
  85. fpTypeComplex = 24;
  86. fpTypeLongcomplex = 25;
  87. fpTypeModule=26;
  88. fpTypeSize=27;
  89. fpTypeAddress=28;
  90. fpTypeBasic=1;
  91. fpTypeStaticArray=2;
  92. fpTypeDynamicArray=4;
  93. fpTypeOpenArray=5;
  94. fpTypeRecord=6;
  95. fpIntern=0;
  96. fpExtern=1;
  97. fpExternR=2;
  98. fpOther =3;
  99. fpFalse=0;
  100. fpTrue=1;
  101. fpHasBody = 1;
  102. fpProtected =4;
  103. fpActive = 5;
  104. fpDelegate = 5;
  105. fpSystemType = 6;
  106. fpUntraced = 4;
  107. Trace=FALSE;
  108. TYPE
  109. Fingerprinter*= OBJECT (SyntaxTree.Visitor)
  110. VAR
  111. fp-: Basic.Fingerprint; (* temporary fingerprint for values etc. *)
  112. fingerprint: SyntaxTree.Fingerprint;
  113. deep: BOOLEAN; (* public / private field of FP needed ? *)
  114. traceLevel: LONGINT;
  115. level: LONGINT;
  116. PROCEDURE & InitFingerprinter*();
  117. BEGIN fp:= 0; deep := FALSE; traceLevel := 0;
  118. END InitFingerprinter;
  119. (** types *)
  120. (*
  121. FP(BasicType) = | fpTypeByte | fpTypeAll | fpTypeSame | fpTypeRange | fpTypeBoolean.
  122. | fpTypeSet | fpTypePointer
  123. PublicFP(BasicType) = FP(basicType).
  124. PrivateFP(BasicType) = sizeof(basicType).
  125. *)
  126. PROCEDURE VisitBasicType*(x: SyntaxTree.BasicType);
  127. BEGIN
  128. END VisitBasicType;
  129. PROCEDURE SetTypeFingerprint(x: SyntaxTree.Type; fp: Basic.Fingerprint);
  130. VAR fingerprint: SyntaxTree.Fingerprint;
  131. BEGIN
  132. fingerprint := x.fingerprint;
  133. IF ~fingerprint.shallowAvailable THEN
  134. fingerprint.shallow := fp;
  135. fingerprint.public := fp;
  136. fingerprint.private := fp;
  137. fingerprint.shallowAvailable := TRUE;
  138. fingerprint.deepAvailable := TRUE; (* no distinction between deep and shallow fp necessary *)
  139. x.SetFingerprint(fingerprint);
  140. END;
  141. SELF.fingerprint := fingerprint;
  142. END SetTypeFingerprint;
  143. PROCEDURE VisitRangeType*(x: SyntaxTree.RangeType);
  144. BEGIN
  145. SetTypeFingerprint(x,fpTypeRange);
  146. END VisitRangeType;
  147. PROCEDURE VisitBooleanType*(x: SyntaxTree.BooleanType);
  148. BEGIN
  149. SetTypeFingerprint(x,fpTypeBoolean);
  150. END VisitBooleanType;
  151. PROCEDURE VisitByteType*(x: SyntaxTree.ByteType);
  152. BEGIN
  153. SetTypeFingerprint(x,fpTypeByte)
  154. END VisitByteType;
  155. PROCEDURE VisitSetType*(x: SyntaxTree.SetType);
  156. BEGIN
  157. SetTypeFingerprint(x,fpTypeSet)
  158. END VisitSetType;
  159. PROCEDURE VisitNilType*(x: SyntaxTree.NilType);
  160. BEGIN
  161. SetTypeFingerprint(x,fpTypePointer)
  162. END VisitNilType;
  163. PROCEDURE VisitAnyType*(x: SyntaxTree.AnyType);
  164. BEGIN
  165. SetTypeFingerprint(x,fpTypePointer)
  166. END VisitAnyType;
  167. PROCEDURE VisitAddressType*(x: SyntaxTree.AddressType);
  168. BEGIN
  169. SetTypeFingerprint(x,fpTypeAddress)
  170. END VisitAddressType;
  171. PROCEDURE VisitSizeType*(x: SyntaxTree.SizeType);
  172. BEGIN
  173. SetTypeFingerprint(x, fpTypeSize);
  174. END VisitSizeType;
  175. PROCEDURE VisitObjectType*(x: SyntaxTree.ObjectType);
  176. BEGIN
  177. SetTypeFingerprint(x,fpTypePointer)
  178. END VisitObjectType;
  179. (*
  180. FP(BasicType) = fpTypeChar8 | fpTypeChar16 | fpTypeChar32
  181. PublicFP(BasicType) = FP(basicType).
  182. PrivateFP(BasicType) = sizeof(basicType).
  183. *)
  184. PROCEDURE VisitCharacterType*(x: SyntaxTree.CharacterType);
  185. BEGIN
  186. IF x.sizeInBits = 8 THEN SetTypeFingerprint(x,fpTypeChar8)
  187. ELSIF x.sizeInBits = 16 THEN SetTypeFingerprint(x,fpTypeChar16)
  188. ELSIF x.sizeInBits =32 THEN SetTypeFingerprint(x,fpTypeChar32)
  189. ELSE HALT(100)
  190. END;
  191. END VisitCharacterType;
  192. (*
  193. FP(BasicType) = fpTypeShortint | fpTypeInteger | fpTypeLongint | fpTypeLongint
  194. PublicFP(BasicType) = FP(basicType).
  195. PrivateFP(BasicType) = sizeof(basicType).
  196. *)
  197. PROCEDURE VisitIntegerType*(x: SyntaxTree.IntegerType);
  198. BEGIN
  199. IF x.sizeInBits=8 THEN SetTypeFingerprint(x,fpTypeShortint)
  200. ELSIF x.sizeInBits = 16 THEN SetTypeFingerprint(x,fpTypeInteger)
  201. ELSIF x.sizeInBits = 32 THEN SetTypeFingerprint(x,fpTypeLongint)
  202. ELSIF x.sizeInBits = 64 THEN SetTypeFingerprint(x,fpTypeHugeint)
  203. ELSE HALT(100)
  204. END;
  205. END VisitIntegerType;
  206. (*
  207. FP(BasicType) = fpTypeReal | fpTypeLongreal
  208. PublicFP(BasicType) = FP(basicType).
  209. PrivateFP(BasicType) = sizeof(basicType).
  210. *)
  211. PROCEDURE VisitFloatType*(x: SyntaxTree.FloatType);
  212. BEGIN
  213. IF x.sizeInBits = 32 THEN SetTypeFingerprint(x,fpTypeReal)
  214. ELSIF x.sizeInBits = 64 THEN SetTypeFingerprint(x,fpTypeLongreal)
  215. ELSE HALT(100)
  216. END;
  217. END VisitFloatType;
  218. PROCEDURE VisitComplexType*(x: SyntaxTree.ComplexType);
  219. BEGIN
  220. ASSERT(x.componentType # NIL);
  221. IF x.componentType.sizeInBits = 32 THEN SetTypeFingerprint(x,fpTypeComplex)
  222. ELSIF x.componentType.sizeInBits = 64 THEN SetTypeFingerprint(x,fpTypeLongcomplex)
  223. ELSE HALT(100)
  224. END
  225. END VisitComplexType;
  226. (*
  227. FP(BasicType) = fpStringType
  228. PublicFP(BasicType) = FP(basicType).
  229. PrivateFP(BasicType) = sizeof(basicType).
  230. *)
  231. PROCEDURE VisitStringType*(x: SyntaxTree.StringType);
  232. BEGIN
  233. SetTypeFingerprint(x,fpTypeString);
  234. END VisitStringType;
  235. (**
  236. fp enumeration type
  237. **)
  238. PROCEDURE VisitEnumerationType*(x: SyntaxTree.EnumerationType);
  239. VAR fingerprint: SyntaxTree.Fingerprint; enumerator: SyntaxTree.Constant; fp: Basic.Fingerprint;
  240. BEGIN
  241. fingerprint := x.fingerprint;
  242. IF ~fingerprint.shallowAvailable THEN
  243. fp := fpTypeEnum;
  244. IF x.enumerationBase # NIL THEN
  245. FPType(fp,x.enumerationBase);
  246. END;
  247. enumerator := x.enumerationScope.firstConstant;
  248. WHILE enumerator # NIL DO
  249. IF enumerator.access * SyntaxTree.Public # {} THEN
  250. FPName(fp,enumerator.name);
  251. END;
  252. FPValue(fp,enumerator.value);
  253. enumerator := enumerator.nextConstant;
  254. END;
  255. fingerprint.shallow := fp;
  256. fingerprint.public := fingerprint.shallow;
  257. fingerprint.private := fingerprint.shallow;
  258. fingerprint.shallowAvailable := TRUE;
  259. fingerprint.deepAvailable := TRUE; (* no distinction between deep and shallow fp necessary *)
  260. x.SetFingerprint(fingerprint);
  261. END;
  262. SELF.fingerprint := fingerprint
  263. (*! must be implemented
  264. IF x.enumerationBase # NIL THEN
  265. baseType := ResolveType(x.enumerationBase);
  266. resolved := baseType.resolved;
  267. enumerationBase := resolved(SyntaxTree.EnumerationType);
  268. baseScope := enumerationBase.enumerationScope;
  269. x.SetBaseValue(enumerationBase.baseValue + baseScope.numberEnumerators);
  270. END;
  271. CheckEnumerationScope(x.enumerationScope);
  272. x.SetState(SyntaxTree.Resolved);
  273. END;
  274. resolvedType := ResolvedType(x);
  275. *)
  276. END VisitEnumerationType;
  277. PROCEDURE VisitQualifiedType*(x: SyntaxTree.QualifiedType);
  278. BEGIN
  279. VType(x.resolved);
  280. END VisitQualifiedType;
  281. (*
  282. FP(ArrayType) = fpTypeComposite <*> (fpTypeOpenArray | fpTypeStaticArray)
  283. -> Name <*> FP(baseType) [<*> length].
  284. PublicFP(ArrayType) = FP(arrayType).
  285. PrivateFP(ArrayType) = FP(arrayType).
  286. *)
  287. PROCEDURE VisitArrayType*(x: SyntaxTree.ArrayType);
  288. VAR fingerprint: SyntaxTree.Fingerprint; deep: BOOLEAN; fp: Basic.Fingerprint;
  289. BEGIN
  290. IF Trace THEN TraceEnter("ArrayType") END;
  291. fingerprint := x.fingerprint;
  292. deep := SELF.deep;
  293. IF ~fingerprint.shallowAvailable THEN
  294. fingerprint.shallowAvailable := TRUE; (* the fingerprinting may return to itself => avoid circles *)
  295. SELF.deep := FALSE;
  296. fp := 0;
  297. FPNumber(fp,fpTypeComposite);
  298. IF x.form = SyntaxTree.Open THEN FPNumber(fp,fpTypeOpenArray)
  299. ELSIF x.form = SyntaxTree.Static THEN FPNumber(fp,fpTypeStaticArray)
  300. ELSIF x.form = SyntaxTree.SemiDynamic THEN FPNumber(fp, fpTypeDynamicArray);
  301. ELSE HALT(200)
  302. END;
  303. TypeName(fp,x);
  304. fingerprint.shallow := fp;
  305. x.SetFingerprint(fingerprint);
  306. FPType(fp,x.arrayBase.resolved);
  307. IF x.form = SyntaxTree.Static THEN FPNumber(fp,x.staticLength) END;
  308. fingerprint.shallow := fp;
  309. fingerprint.public := fingerprint.shallow;
  310. fingerprint.private := fingerprint.shallow;
  311. x.SetFingerprint(fingerprint);
  312. SELF.deep := deep;
  313. END;
  314. IF deep & ~fingerprint.deepAvailable THEN
  315. fingerprint.private := fingerprint.shallow;
  316. fingerprint.public := fingerprint.shallow;
  317. fingerprint.deepAvailable := TRUE; (* to avoid circles during base finger printing *)
  318. x.SetFingerprint(fingerprint);
  319. VType(x.arrayBase); (* make sure that base pointer is also deeply fped *)
  320. END;
  321. IF Trace THEN TraceExit("ArrayType",fingerprint) END;
  322. SELF.fingerprint := fingerprint;
  323. END VisitArrayType;
  324. (*
  325. FP(MathArrayType) = fpTypeComposite <*> (fpTypeOpenArray | fpTypeStaticArray)
  326. -> Name <*> FP(baseType) [<*> length].
  327. PublicFP(MathArrayType) = FP(arrayType).
  328. PrivateFP(MathArrayType) = FP(arrayType).
  329. *)
  330. PROCEDURE VisitMathArrayType*(x: SyntaxTree.MathArrayType);
  331. VAR fingerprint: SyntaxTree.Fingerprint; deep: BOOLEAN; fp: Basic.Fingerprint;
  332. BEGIN
  333. fingerprint := x.fingerprint;
  334. deep := SELF.deep;
  335. IF Trace THEN TraceEnter("MathArrayType") END;
  336. IF ~fingerprint.shallowAvailable THEN
  337. fingerprint.shallowAvailable := TRUE; (* the fingerprinting may return to itself => avoid circles *)
  338. SELF.deep := FALSE;
  339. fp := 0;
  340. FPNumber(fp,fpTypeComposite);
  341. IF x.form = SyntaxTree.Open THEN FPNumber(fp,fpTypeOpenArray)
  342. ELSIF x.form = SyntaxTree.Static THEN FPNumber(fp,fpTypeStaticArray)
  343. ELSIF x.form = SyntaxTree.Tensor THEN (* do nothing *)
  344. ELSE HALT(200)
  345. END;
  346. TypeName(fp,x);
  347. IF x.arrayBase # NIL THEN
  348. FPType(fp,x.arrayBase.resolved);
  349. END;
  350. IF x.form = SyntaxTree.Static THEN FPNumber(fp,x.staticLength) END;
  351. fingerprint.shallow := fp;
  352. fingerprint.public := fingerprint.shallow;
  353. fingerprint.private := fingerprint.shallow;
  354. fingerprint.shallowAvailable := TRUE;
  355. x.SetFingerprint(fingerprint);
  356. SELF.deep := deep;
  357. END;
  358. IF deep & ~fingerprint.deepAvailable THEN
  359. VType(x.arrayBase);
  360. fingerprint.private := fingerprint.shallow;
  361. fingerprint.public := fingerprint.shallow;
  362. fingerprint.deepAvailable := TRUE;
  363. x.SetFingerprint(fingerprint);
  364. END;
  365. IF Trace THEN TraceExit("MathArrayType",fingerprint) END;
  366. SELF.fingerprint := fingerprint;
  367. END VisitMathArrayType;
  368. (*
  369. fp = fp [ -> Name(moduleName) -> Name(typeName) ]
  370. *)
  371. PROCEDURE TypeName(VAR fp: Basic.Fingerprint; x:SyntaxTree.Type);
  372. VAR typeDeclaration: SyntaxTree.TypeDeclaration;
  373. BEGIN
  374. IF (x.scope # NIL) THEN
  375. (* only executed for imported types, reason:
  376. modification of a type name would result in modified fingerprint leading to modified fingerprints of using structures such as
  377. in the following example:
  378. TYPE A=ARRAY 32 OF CHAR;
  379. PROCEDURE P*(a:A);
  380. ...
  381. END P;
  382. IF name of A was changed, P would get a new fingerprint.
  383. Better: fingerprint of P only depends in type of A but not on its declared name.
  384. *)
  385. IF Trace THEN
  386. TraceIndent;
  387. D.Str("TypeName ");
  388. D.Str0(x.scope.ownerModule.name);
  389. END;
  390. typeDeclaration := x.typeDeclaration;
  391. IF(typeDeclaration # NIL) & (typeDeclaration.access # SyntaxTree.Hidden) THEN
  392. FPName(fp,x.scope.ownerModule.name);
  393. IF (typeDeclaration.declaredType.resolved # x) THEN
  394. (* in record type: pointer to type declaration of a pointer *)
  395. typeDeclaration := NIL
  396. END;
  397. IF (typeDeclaration # NIL) & (typeDeclaration.scope # NIL)THEN
  398. FPName(fp,typeDeclaration.name);
  399. IF Trace THEN
  400. D.Str(".");
  401. D.Str0(typeDeclaration.name);
  402. END;
  403. ELSIF (typeDeclaration # NIL) & (typeDeclaration.scope = NIL) THEN
  404. D.Str("typedeclaration without scope: "); D.Str0(x.typeDeclaration.name); D.Int(x.typeDeclaration.position.start,5); D.Ln;
  405. D.Update;
  406. ELSE
  407. FPNumber(fp,0);
  408. END;
  409. ELSE
  410. FPNumber(fp, 0);
  411. END;
  412. IF Trace THEN
  413. D.Str(", fp = "); D.Hex(fp,0); D.Ln;
  414. END
  415. END
  416. END TypeName;
  417. (*
  418. FP(PointerType) = fpTypePointer <*> fpTypeBasic -> Name <*> FP(baseType).
  419. PublicFP(PointerType) = 0.
  420. PrivateFP(PointerType) = 0.
  421. *)
  422. PROCEDURE VisitPointerType*(x: SyntaxTree.PointerType);
  423. VAR fp: Basic.Fingerprint; deep: BOOLEAN; fingerprint: SyntaxTree.Fingerprint;
  424. BEGIN
  425. IF Trace THEN TraceEnter("PointerType"); END;
  426. fingerprint := x.fingerprint;
  427. deep := SELF.deep;
  428. IF ~fingerprint.shallowAvailable THEN
  429. IF Trace THEN TraceIndent; D.Str("PointerType shallow");D.Ln; END;
  430. SELF.deep := FALSE;
  431. fp := 0;
  432. FPNumber(fp, fpTypePointer); FPNumber(fp, fpTypeBasic);
  433. TypeName(fp,x);
  434. FPType(fp,x.pointerBase);
  435. fingerprint.shallow := fp;
  436. fingerprint.private := fp;
  437. fingerprint.public := fp;
  438. fingerprint.shallowAvailable := TRUE;
  439. fingerprint.deepAvailable := TRUE;
  440. (*
  441. deep fingerprinting leads to cycles -> must be done on record type directly, if a deep FP is needed
  442. IF deep & ~fingerprint.deepAvailable THEN
  443. IF Trace THEN TraceIndent; D.Str("PointerType:deep");D.Ln; END;
  444. x.pointerBase.Accept(SELF);
  445. fingerprint.deepAvailable := TRUE;
  446. END;
  447. *)
  448. x.SetFingerprint(fingerprint);
  449. SELF.deep := deep;
  450. END;
  451. IF Trace THEN TraceExit("PointerType",fingerprint) END;
  452. SELF.fingerprint := fingerprint;
  453. END VisitPointerType;
  454. (*
  455. FP(PortType) = fpTypePort <*> fpTypeBasic -> Name <*> FP(baseType).
  456. PublicFP(PortType) = 0.
  457. PrivateFP(PortType) = 0.
  458. *)
  459. PROCEDURE VisitPortType*(x: SyntaxTree.PortType);
  460. VAR fingerprint: SyntaxTree.Fingerprint; fp: Basic.Fingerprint; deep: BOOLEAN;
  461. BEGIN
  462. IF Trace THEN TraceEnter("PortType"); END;
  463. fingerprint := x.fingerprint;
  464. deep := SELF.deep;
  465. IF ~fingerprint.shallowAvailable THEN
  466. IF Trace THEN TraceIndent; D.Str("PortType shallow");D.Ln; END;
  467. SELF.deep := FALSE;
  468. fp := 0;
  469. FPNumber(fp, fpTypePort); FPNumber(fp, fpTypeBasic);
  470. TypeName(fp,x);
  471. FPNumber(fp,x.sizeInBits);
  472. fingerprint.shallow := fp;
  473. fingerprint.private := fp;
  474. fingerprint.public := fp;
  475. fingerprint.shallowAvailable := TRUE;
  476. fingerprint.deepAvailable := TRUE;
  477. SELF.deep := deep;
  478. END;
  479. IF Trace THEN TraceExit("PortType",fingerprint) END;
  480. SELF.fingerprint := fingerprint;
  481. END VisitPortType;
  482. (*
  483. FP(Method) = 0 <*> fpModeMethod -> Name(methodName) -> Signature(method).
  484. *)
  485. PROCEDURE FPrintMethod(VAR private,public: Basic.Fingerprint; procedure,body: SyntaxTree.Procedure);
  486. VAR fingerprint: SyntaxTree.Fingerprint; fp: Basic.Fingerprint; name: ARRAY 256 OF CHAR;
  487. BEGIN
  488. IF Trace THEN TraceEnter("Method");
  489. D.Address(SYSTEM.VAL(ADDRESS,procedure));
  490. procedure.GetName(name);
  491. TraceIndent; D.Str("name = "); D.Str(name); D.Ln;
  492. END;
  493. ASSERT(deep);
  494. fingerprint := procedure.fingerprint;
  495. IF ~fingerprint.shallowAvailable THEN
  496. fp := 0;
  497. FPNumber(fp,fpModeMethod);
  498. Global.GetSymbolName(procedure,name);
  499. FPString(fp,name);
  500. FPSignature(fp,procedure.type(SyntaxTree.ProcedureType),procedure IS SyntaxTree.Operator );
  501. fingerprint.shallow := fp;
  502. fingerprint.public := fingerprint.shallow;
  503. fingerprint.private := fingerprint.shallow;
  504. fingerprint.shallowAvailable := TRUE;
  505. procedure.SetFingerprint(fingerprint)
  506. ELSE
  507. fp := fingerprint.shallow;
  508. END;
  509. IF procedure.access * SyntaxTree.Public # {} THEN (* visible method or visible supermethod *)
  510. IF Trace THEN D.String("fp before method number"); D.Hex(fp,0); D.Ln END;
  511. FPNumber(fp,procedure.methodNumber);
  512. IF Trace THEN D.String("fp after method number"); D.Hex(fp,0); D.Ln END;
  513. IF procedure # body THEN
  514. FPNumber(private,fp); FPNumber(public,fp);
  515. END;
  516. END;
  517. IF Trace THEN
  518. TraceIndent; D.Str("Method, fp = "); D.Hex(private,0); D.Str(" "); D.Hex(public,0); D.Ln;
  519. TraceExit("Method",fingerprint)
  520. END;
  521. END FPrintMethod;
  522. PROCEDURE VisitCellType*(x: SyntaxTree.CellType);
  523. VAR fingerprint: SyntaxTree.Fingerprint; fp: Basic.Fingerprint;
  524. BEGIN
  525. fingerprint := x.fingerprint;
  526. deep := SELF.deep;
  527. IF ~fingerprint.shallowAvailable THEN
  528. fp := 0;
  529. TypeName(fp,x);
  530. fingerprint.shallow := fp;
  531. fingerprint.public := fp;
  532. fingerprint.private := fp;
  533. fingerprint.deepAvailable := TRUE;
  534. fingerprint.shallowAvailable := TRUE;
  535. x.SetFingerprint(fingerprint);
  536. END;
  537. SELF.fingerprint := fingerprint
  538. END VisitCellType;
  539. (*
  540. FP(RecordType) = fpTypeComposite <*> fptypeRecord
  541. [ -> Name(moduleName) -> Name(typeName)] [<*> FP(baseType)]
  542. PublicFP(RecordType) = FP(recordType) [<*> PublicFP(baseType)] {<*> FP(method) <*> methodNumber }
  543. {<*> PublicFP(fieldType) <*> offset(field) <*> FP(field)} <*> flags.
  544. PrivateFP(RecordType) = FP(recordType) [<*> PrivateFP(baseType)] {<*> FP(method) <*> methodNumber }
  545. {<*> PrivateFP(fieldType) <*> offset(field) <*> FP(field)}
  546. *)
  547. PROCEDURE VisitRecordType*(x: SyntaxTree.RecordType);
  548. VAR scope: SyntaxTree.RecordScope; fp: Basic.Fingerprint; variable: SyntaxTree.Variable;
  549. fingerprint,variableFingerprint,variableTypeFingerprint,baseFingerprint: SyntaxTree.Fingerprint;flags: SET;
  550. symbol: SyntaxTree.Symbol; procedure: SyntaxTree.Procedure; baseType: SyntaxTree.Type;
  551. body: SyntaxTree.Body; name: ARRAY 256 OF CHAR;
  552. deep: BOOLEAN;
  553. (* for dealing with cycles the private and public fingerprint are computed here
  554. while FP is computed completely during call of Type0 *)
  555. BEGIN
  556. fingerprint := x.fingerprint;
  557. deep := SELF.deep;
  558. IF Trace THEN TraceEnter("Record"); END;
  559. IF ~fingerprint.shallowAvailable THEN
  560. IF Trace THEN TraceIndent; D.Str("RecordType Enter Shallow "); D.Ln; END;
  561. SELF.deep := FALSE;
  562. fp := 0;
  563. FPNumber(fp, fpTypeComposite); FPNumber(fp, fpTypeRecord);
  564. TypeName(fp,x);
  565. IF Trace THEN TraceIndent; D.Str("RecordType Name ");D.Hex(fp,0); D.Ln; END;
  566. IF (x.baseType # NIL) THEN
  567. baseType := x.GetBaseRecord();
  568. FPType(fp,baseType);
  569. END;
  570. SELF.deep := TRUE;
  571. (* methods, sorted *)
  572. scope := x.recordScope;
  573. symbol := scope.firstSymbol;
  574. WHILE symbol # NIL DO (* number and names of procedures -- method table ! *)
  575. IF symbol IS SyntaxTree.Procedure THEN
  576. procedure := symbol(SyntaxTree.Procedure);
  577. FPNumber(fp,fpModeMethod);
  578. Global.GetSymbolName(procedure,name);
  579. FPString(fp,name);
  580. IF Trace THEN TraceIndent; D.Str("RecordType Method "); TraceFP(fingerprint); D.Ln; END;
  581. END;
  582. symbol := symbol.nextSymbol
  583. END;
  584. fingerprint.shallow := fp;
  585. fingerprint.public := fingerprint.shallow;
  586. fingerprint.private := fingerprint.shallow;
  587. fingerprint.shallowAvailable := TRUE;
  588. x.SetFingerprint(fingerprint);
  589. SELF.deep := deep;
  590. IF Trace THEN TraceIndent; D.Str("RecordType Shallow Done "); TraceFP(fingerprint); D.Ln; END;
  591. END;
  592. IF deep & ~fingerprint.deepAvailable THEN
  593. IF Trace THEN TraceIndent; D.Str("RecordType Enter Deep "); D.Ln; END;
  594. fingerprint.private := fingerprint.shallow;
  595. fingerprint.public := fingerprint.shallow;
  596. (*! finger printing for interfaces omitted *)
  597. IF Trace THEN TraceIndent; D.Str("RecordType before basetype"); TraceFP(fingerprint); D.Ln; END;
  598. (* now compute base record finger prints *)
  599. baseType := x.GetBaseRecord();
  600. IF (baseType # NIL) THEN
  601. IF baseType IS SyntaxTree.PointerType THEN baseType := baseType(SyntaxTree.PointerType).pointerBase.resolved END;
  602. baseFingerprint := TypeFP(baseType); (* deep finger print *)
  603. FPNumber(fingerprint.private,baseFingerprint.private);
  604. FPNumber(fingerprint.public,baseFingerprint.public);
  605. END;
  606. scope := x.recordScope;
  607. IF Trace THEN TraceIndent; D.Str("RecordType before methods"); TraceFP(fingerprint); D.Ln; END;
  608. (* methods, sorted *)
  609. symbol := scope.firstSymbol;
  610. WHILE symbol # NIL DO
  611. IF symbol IS SyntaxTree.Procedure THEN
  612. procedure := symbol(SyntaxTree.Procedure);
  613. FPrintMethod(fingerprint.private, fingerprint.public, procedure, scope.bodyProcedure);
  614. IF Trace THEN TraceIndent; D.Str("RecordType Method "); TraceFP(fingerprint); D.Ln; END;
  615. END;
  616. symbol := symbol.nextSymbol
  617. END;
  618. IF Trace THEN TraceIndent; D.Str("RecordType after methods"); TraceFP(fingerprint); D.Ln; END;
  619. variable := scope.firstVariable;
  620. WHILE variable # NIL DO
  621. variableFingerprint := variable.fingerprint;
  622. IF variable.access * SyntaxTree.Public # {} THEN
  623. (* variable fp = & fpModeField & Name & Visibility [& fpUntraced] & Type *)
  624. fp := 0;
  625. FPNumber(fp,fpModeField);
  626. FPName(fp,variable.name);
  627. FPVisibility(fp,variable.access);
  628. IF variable.untraced THEN FPNumber(fp,fpUntraced) END;
  629. variableTypeFingerprint := TypeFP(variable.type); (* deep finger print *)
  630. FPNumber(fp,variableTypeFingerprint.shallow);
  631. variableFingerprint.shallow := fp;
  632. FPNumber(fingerprint.private,variableTypeFingerprint.private);
  633. FPNumber(fingerprint.private,SHORT(variable.offsetInBits DIV 8));
  634. FPNumber(fingerprint.private,fp);
  635. FPNumber(fingerprint.public,variableTypeFingerprint.public);
  636. FPNumber(fingerprint.public,SHORT(variable.offsetInBits DIV 8));
  637. FPNumber(fingerprint.public,fp);
  638. IF Trace THEN TraceIndent; D.Str("RecordType Field "); D.Str0(variable.name); D.Str(" "); TraceFP(fingerprint); D.Ln; END;
  639. ELSE
  640. fp := 0;
  641. IF variable.untraced THEN FPNumber(fp,fpUntraced) END;
  642. FPNumber(fingerprint.private,fp);
  643. IF Trace THEN TraceIndent; D.Str("RecordType InvisibleField "); TraceFP(fingerprint); D.Ln; END;
  644. END;
  645. variable := variable.nextVariable;
  646. END;
  647. FPNumber(fingerprint.private, SHORT(x.sizeInBits DIV 8));
  648. FPNumber(fingerprint.public, SHORT(x.sizeInBits DIV 8));
  649. flags := {};
  650. IF x.recordScope.bodyProcedure # NIL THEN
  651. body := x.recordScope.bodyProcedure.procedureScope.body;
  652. INCL(flags, fpHasBody);
  653. IF body # NIL THEN
  654. IF body.isActive THEN INCL(flags,fpActive) END;
  655. IF body.isExclusive THEN INCL(flags,fpProtected) END;
  656. END;
  657. IF Trace THEN TraceIndent; D.Str("RecordType Body "); TraceFP(fingerprint); D.Ln; END;
  658. END;
  659. IF x.IsProtected() THEN INCL(flags,fpProtected) END;
  660. FPSet(fingerprint.public, flags);
  661. IF Trace THEN TraceIndent; D.Str("RecordType Exit Deep "); TraceFP(fingerprint); D.Ln; END;
  662. (*
  663. ASSERT(fingerprint.private # 0,100);
  664. ASSERT(fingerprint.public # 0,101);
  665. *)
  666. fingerprint.deepAvailable := TRUE;
  667. x.SetFingerprint(fingerprint);
  668. END;
  669. SELF.fingerprint := fingerprint;
  670. IF Trace THEN TraceExit("Record",fingerprint); END;
  671. END VisitRecordType;
  672. (*
  673. FP(ProcedureType) = fpTypeProcedure <*> fpTypeBasic [<*> fpDelegate]-> Name.
  674. PublicFP(ProcedureType) = FP(arrayType) -> Signature(procedureType)
  675. PrivateFP(ProcedureType) = FP(arrayType)-> Signature(procedureType).
  676. *)
  677. PROCEDURE VisitProcedureType*(x: SyntaxTree.ProcedureType);
  678. VAR fingerprint: SyntaxTree.Fingerprint; deep: BOOLEAN; fp: Basic.Fingerprint;
  679. BEGIN
  680. IF Trace THEN TraceEnter("ProcedureType") END;
  681. fingerprint := x.fingerprint;
  682. deep := SELF.deep;
  683. IF ~fingerprint.shallowAvailable THEN
  684. fingerprint.shallowAvailable := TRUE; (*! to avoid circles, this is not fully clean - for paco *)
  685. fp := 0;
  686. FPNumber(fp,fpTypeProcedure);
  687. FPNumber(fp,fpTypeBasic);
  688. IF x.isDelegate THEN FPNumber(fp,fpDelegate) END;
  689. x.SetFingerprint(fingerprint);
  690. TypeName(fp,x);
  691. fingerprint.public := fp; fingerprint.private := fp;
  692. fingerprint.shallow := fp;
  693. FPSignature(fp,x,FALSE);
  694. fingerprint.public := fp; fingerprint.private := fp;
  695. fingerprint.shallow := fp;
  696. fingerprint.deepAvailable := TRUE;
  697. x.SetFingerprint(fingerprint);
  698. END;
  699. (*
  700. IF ~fingerprint.deepAvailable THEN
  701. SELF.deep := FALSE;
  702. FPSignature(fp,x,FALSE);
  703. SELF.deep := deep;
  704. fingerprint.public := fp; fingerprint.private := fp;
  705. fingerprint.shallow := fp;
  706. fingerprint.deepAvailable := TRUE;
  707. END;
  708. *)
  709. IF Trace THEN TraceExit("ProcedureType",fingerprint) END;
  710. SELF.fingerprint := fingerprint;
  711. END VisitProcedureType;
  712. (** values - used in constant symbols - effects in fingerprint modification of (object) global variable fp *)
  713. (* fp = fp & (fpTrue | fpFalse) *)
  714. PROCEDURE VisitBooleanValue*(x: SyntaxTree.BooleanValue);
  715. BEGIN IF x.value THEN FPNumber(SELF.fp,fpTrue) ELSE FPNumber(SELF.fp,fpFalse) END
  716. END VisitBooleanValue;
  717. (* fp = fp & (HugeInt | Number) *)
  718. PROCEDURE VisitIntegerValue*(x: SyntaxTree.IntegerValue);
  719. BEGIN FPNumber(SELF.fp,x.value)
  720. END VisitIntegerValue;
  721. (* fp = fp & (HugeInt | Number) *)
  722. PROCEDURE VisitEnumerationValue*(x: SyntaxTree.EnumerationValue);
  723. BEGIN FPNumber(SELF.fp,x.value)
  724. END VisitEnumerationValue;
  725. (* fp = fp & ORD(char) *)
  726. PROCEDURE VisitCharacterValue*(x: SyntaxTree.CharacterValue);
  727. BEGIN FPNumber(SELF.fp,ORD(x.value))
  728. END VisitCharacterValue;
  729. (* fp = fp & Set *)
  730. PROCEDURE VisitSetValue*(x: SyntaxTree.SetValue);
  731. BEGIN FPSet(SELF.fp,x.value)
  732. END VisitSetValue;
  733. PROCEDURE VisitMathArrayExpression*(x: SyntaxTree.MathArrayExpression);
  734. VAR element: SyntaxTree.Expression; i: LONGINT;
  735. BEGIN
  736. FOR i := 0 TO x.elements.Length()-1 DO
  737. element := x.elements.GetExpression(i);
  738. FPValue(fp, element);
  739. END;
  740. END VisitMathArrayExpression;
  741. (* fp = fp {& Value} *)
  742. PROCEDURE VisitMathArrayValue*(x: SyntaxTree.MathArrayValue);
  743. BEGIN
  744. VisitMathArrayExpression(x.array); (* do not call FPValue here, recursion possible because x.array.resolved = x *)
  745. END VisitMathArrayValue;
  746. (* fp = fp & (Real | LongReal) *)
  747. PROCEDURE VisitRealValue*(x: SyntaxTree.RealValue);
  748. BEGIN FPReal(SELF.fp,x.value);
  749. END VisitRealValue;
  750. PROCEDURE VisitComplexValue*(x: SyntaxTree.ComplexValue);
  751. BEGIN
  752. FPReal(SELF.fp,x.realValue);
  753. FPReal(SELF.fp,x.imagValue);
  754. END VisitComplexValue;
  755. PROCEDURE VisitNilValue*(x: SyntaxTree.NilValue);
  756. BEGIN FPNumber(SELF.fp, 0);
  757. END VisitNilValue;
  758. (* fp = fp & String *)
  759. PROCEDURE VisitStringValue*(x: SyntaxTree.StringValue);
  760. BEGIN FPString(SELF.fp,x.value^) END VisitStringValue;
  761. (* fp = fp & FP(x) *)
  762. PROCEDURE FPValue(VAR fp: Basic.Fingerprint; x: SyntaxTree.Expression);
  763. BEGIN
  764. SELF.fp := fp;
  765. IF x.resolved # NIL THEN
  766. VExpression(x.resolved);
  767. ELSE
  768. VExpression(x);
  769. END;
  770. fp := SELF.fp
  771. END FPValue;
  772. PROCEDURE FPType(VAR fp: Basic.Fingerprint; t: SyntaxTree.Type);
  773. BEGIN
  774. INC(level); ASSERT(level <= 100);
  775. IF t = NIL THEN FPNumber(fp,fpTypeNone);
  776. ELSE VType(t); FPNumber(fp,SELF.fingerprint.shallow);
  777. END;
  778. DEC(level);
  779. END FPType;
  780. (* Signature(f) = f <*> FP(returnType)
  781. { <*> (fpModeVarParameter | fpModeConstParameter | fpModePar)
  782. <*> FP(parameterType) [-> Name(parameterName)] }
  783. *)
  784. PROCEDURE FPSignature(VAR fp: Basic.Fingerprint; t: SyntaxTree.ProcedureType; isOperator: BOOLEAN);
  785. VAR par,self: SyntaxTree.Parameter; deep: BOOLEAN;
  786. (* fp = fp & (fpModeVarPar | fpModeConstPar | fpModePar) [ & Name ] *)
  787. PROCEDURE FPPar(VAR fp: Basic.Fingerprint; par: SyntaxTree.Parameter);
  788. VAR deep: BOOLEAN;
  789. BEGIN
  790. IF par.kind = SyntaxTree.VarParameter THEN FPNumber(fp, fpModeVarPar)
  791. ELSIF par.kind = SyntaxTree.ConstParameter THEN
  792. IF (par.type.resolved IS SyntaxTree.ArrayType) OR (par.type.resolved IS SyntaxTree.RecordType) THEN (*! compatiblity with paco *)
  793. FPNumber(fp,fpModeVarPar)
  794. ELSE
  795. FPNumber(fp,fpModePar)
  796. END;
  797. ELSE FPNumber(fp, fpModePar) END;
  798. deep := SELF.deep;
  799. SELF.deep := FALSE;
  800. FPType(fp,par.type);
  801. SELF.deep := deep;
  802. IF isOperator & ~(par.type.resolved IS SyntaxTree.BasicType) & (par.type.resolved.typeDeclaration # NIL) THEN
  803. FPName(fp,par.type.resolved.typeDeclaration.name);
  804. (* D.Str("fp "); D.Str0(par.type.resolved.typeDeclaration.name.name); D.Ln;*)
  805. ELSIF isOperator & (par.type.resolved IS SyntaxTree.BasicType) THEN
  806. FPName(fp,par.type.resolved(SyntaxTree.BasicType).name);
  807. (* D.Str("fpb "); D.Str0(par.type.resolved(SyntaxTree.BasicType).name.name);*)
  808. END;
  809. END FPPar;
  810. BEGIN
  811. IF Trace THEN
  812. TraceIndent; D.Str("FPSignature enter "); D.Hex(fp,0); D.Ln;
  813. END;
  814. deep := SELF.deep;
  815. SELF.deep := FALSE;
  816. FPType(fp,t.returnType);
  817. SELF.deep := deep;
  818. IF Trace THEN
  819. TraceIndent; D.Str("FPSignature after return type "); D.Hex(fp,0); D.Ln;
  820. END;
  821. IF IsOberonProcedure(t) THEN
  822. self := t.firstParameter;
  823. WHILE (self # NIL) & (self.name#Global.SelfParameterName) DO
  824. self := self.nextParameter;
  825. END;
  826. IF self # NIL THEN FPPar(fp,self) END; (* self parameter *)
  827. (*
  828. IF t.selfParameter # NIL THEN FPPar(fp,t.selfParameter) END; (* self parameter *)
  829. self := NIL;
  830. *)
  831. IF Trace THEN
  832. TraceIndent; D.Str("FPSignature after self "); D.Hex(fp,0); D.Ln;
  833. END;
  834. par := t.firstParameter;
  835. WHILE (par#self) DO (*! done as in PACO *)
  836. FPPar(fp, par);
  837. IF Trace THEN
  838. TraceIndent; D.Str("FPSignature par "); D.Hex(fp,0); D.Ln;
  839. END;
  840. par:=par.nextParameter;
  841. END;
  842. IF Trace THEN
  843. TraceIndent; D.Str("FPSignature exit "); D.Hex(fp,0); D.Ln;
  844. END;
  845. ELSE
  846. par := t.lastParameter;
  847. WHILE (par#NIL) DO (*! done as in PACO *)
  848. FPPar(fp, par);
  849. IF Trace THEN
  850. TraceIndent; D.Str("FPSignature par "); D.Hex(fp,0); D.Ln;
  851. END;
  852. par:=par.prevParameter;
  853. END;
  854. END;
  855. END FPSignature;
  856. (** symbols *)
  857. (*
  858. FP(TypeDeclaration) = 0 <*> fpModeType -> Name -> Visibility <*> FP(Type).
  859. *)
  860. PROCEDURE VisitTypeDeclaration*(x: SyntaxTree.TypeDeclaration);
  861. VAR fp: Basic.Fingerprint;
  862. fingerprint, typeFP: SyntaxTree.Fingerprint; deep: BOOLEAN;
  863. BEGIN
  864. fingerprint := x.fingerprint;
  865. IF ~fingerprint.shallowAvailable THEN
  866. IF Trace THEN TraceEnter("TypeDeclaration") END;
  867. deep := SELF.deep;
  868. SELF.deep := FALSE;
  869. fp := 0;
  870. FPNumber(fp, fpModeType);
  871. FPName(fp,x.name);
  872. IF Trace THEN TraceIndent; D.String("access="); D.Set(x.access); D.Ln; END;
  873. FPVisibility(fp, x.access);
  874. VType(x.declaredType);
  875. FPNumber(fp, SELF.fingerprint.shallow);
  876. fingerprint.shallow := fp;
  877. fingerprint.public := fp;
  878. fingerprint.private := fp;
  879. fingerprint.shallowAvailable := TRUE;
  880. x.SetFingerprint(fingerprint);
  881. SELF.deep := deep;
  882. IF Trace THEN TraceExit("TypeDeclaration",fingerprint) END;
  883. END;
  884. IF deep & ~fingerprint.deepAvailable THEN
  885. fingerprint := x.fingerprint;
  886. typeFP := TypeFP(x.declaredType);
  887. IF x.declaredType.resolved IS SyntaxTree.PointerType THEN
  888. typeFP := TypeFP(x.declaredType.resolved(SyntaxTree.PointerType).pointerBase);
  889. END;
  890. FPNumber(fingerprint.public, typeFP.public);
  891. FPNumber(fingerprint.private, typeFP.private);
  892. fingerprint.deepAvailable := TRUE;
  893. x.SetFingerprint(fingerprint);
  894. END;
  895. SELF.fingerprint := fingerprint
  896. END VisitTypeDeclaration;
  897. (*
  898. FP(ConstantDeclaration) = 0 <*> fpModeConstant -> Name -> Visibility <*> FP(Type) -> Basic -> Value.
  899. *)
  900. PROCEDURE VisitConstant*(x: SyntaxTree.Constant);
  901. VAR access: SET;
  902. fingerprint: SyntaxTree.Fingerprint;
  903. fp: Basic.Fingerprint;
  904. deep: BOOLEAN;
  905. BEGIN
  906. fingerprint := x.fingerprint;
  907. IF ~fingerprint.shallowAvailable THEN
  908. deep := SELF.deep;
  909. SELF.deep := FALSE;
  910. fp := 0;
  911. FPNumber(fp, fpModeConst);
  912. FPName(fp,x.name);
  913. (* for compatibility with old compiler: *)
  914. access := x.access; IF SyntaxTree.PublicRead IN access THEN INCL(access,SyntaxTree.PublicWrite) END;
  915. FPVisibility(fp, access);
  916. FPType(fp, x.type);
  917. FPNumber(fp, fpTypeBasic);
  918. FPValue(fp, x.value);
  919. fingerprint.shallow := fp;
  920. fingerprint.public := fingerprint.shallow;
  921. fingerprint.private := fingerprint.shallow;
  922. fingerprint.shallowAvailable := TRUE;
  923. x.SetFingerprint(fingerprint);
  924. SELF.deep := deep;
  925. END;
  926. SELF.fingerprint := fingerprint
  927. END VisitConstant;
  928. (*
  929. FP(VariableDeclaration) = 0 <*> fpModePar -> Name -> Visibility <*> FP(Type).
  930. *)
  931. PROCEDURE VisitVariable*(x: SyntaxTree.Variable);
  932. VAR fp: Basic.Fingerprint; fingerprint: SyntaxTree.Fingerprint; deep: BOOLEAN; name: SyntaxTree.IdentifierString;
  933. BEGIN
  934. fingerprint := x.fingerprint;
  935. IF ~fingerprint.shallowAvailable THEN
  936. deep := SELF.deep;
  937. SELF.deep := FALSE;
  938. fp := 0;
  939. FPNumber(fp,fpModeVar);
  940. Global.GetSymbolName(x,name);
  941. FPString(fp,name);
  942. FPVisibility(fp,x.access);
  943. VType(x.type);
  944. FPNumber(fp,SELF.fingerprint.shallow);
  945. fingerprint.shallow := fp;
  946. fingerprint.public := fingerprint.shallow;
  947. fingerprint.private := fingerprint.shallow;
  948. fingerprint.shallowAvailable := TRUE;
  949. x.SetFingerprint(fingerprint);
  950. SELF.deep := deep;
  951. END;
  952. SELF.fingerprint := fingerprint
  953. END VisitVariable;
  954. PROCEDURE VisitProperty*(x: SyntaxTree.Property);
  955. BEGIN
  956. VisitVariable(x);
  957. END VisitProperty;
  958. (*
  959. FP(ParameterDeclaration) = 0 <*> fpModePar -> Name -> Visibility <*> FP(Type).
  960. *)
  961. PROCEDURE VisitParameter*(x: SyntaxTree.Parameter);
  962. VAR fp: Basic.Fingerprint; fingerprint: SyntaxTree.Fingerprint; deep: BOOLEAN; name: SyntaxTree.IdentifierString;
  963. BEGIN
  964. fingerprint := x.fingerprint;
  965. IF ~fingerprint.shallowAvailable THEN
  966. deep := SELF.deep;
  967. SELF.deep := FALSE;
  968. fp := 0;
  969. FPNumber(fp,fpModePar);
  970. Global.GetSymbolName(x,name);
  971. FPString(fp,name);
  972. FPVisibility(fp,x.access);
  973. VType(x.type);
  974. FPNumber(fp,SELF.fingerprint.shallow);
  975. fingerprint.shallow := fp;
  976. fingerprint.public := fingerprint.shallow;
  977. fingerprint.private := fingerprint.shallow;
  978. fingerprint.shallowAvailable := TRUE;
  979. x.SetFingerprint(fingerprint);
  980. SELF.deep := deep;
  981. END;
  982. SELF.fingerprint := fingerprint
  983. END VisitParameter;
  984. (*
  985. FP(ProcedureDeclaration) = 0 <*> fpModeInlineProcedure -> Name -> Visibility <*> FP(Type) -> Code.
  986. | 0 <*> fpModeExportedProcedure -> Name -> Visibility <*> FP(Type)
  987. *)
  988. PROCEDURE VisitProcedure*(x: SyntaxTree.Procedure);
  989. VAR fp: Basic.Fingerprint; access: SET; fingerprint: SyntaxTree.Fingerprint; deep: BOOLEAN; code: SyntaxTree.Code; i: LONGINT;
  990. size: LONGINT; value: WORD; name: ARRAY 256 OF CHAR;
  991. BEGIN
  992. IF x.scope IS SyntaxTree.RecordScope THEN (* method *)
  993. FPrintMethod(fp,fp,x,NIL);
  994. fingerprint := x.fingerprint;
  995. ELSE
  996. fingerprint := x.fingerprint;
  997. IF ~fingerprint.shallowAvailable THEN
  998. deep := SELF.deep;
  999. SELF.deep := FALSE;
  1000. (* for compatibility with old compiler: *)
  1001. access := x.access; IF SyntaxTree.PublicRead IN access THEN INCL(access,SyntaxTree.PublicWrite) END;
  1002. fp := 0;
  1003. IF x.isInline THEN
  1004. FPNumber(fp, fpModeInlineProcedure);
  1005. FPName(fp,x.name);
  1006. FPVisibility(fp, access);
  1007. FPSignature(fp,x.type(SyntaxTree.ProcedureType),x IS SyntaxTree.Operator);
  1008. IF (x.procedureScope.body # NIL) & (x.procedureScope.body.code # NIL) THEN
  1009. code := x.procedureScope.body.code;
  1010. IF code.inlineCode = NIL THEN
  1011. size := 0
  1012. ELSE
  1013. size := code.inlineCode.GetSize() DIV 8;
  1014. END;
  1015. FPNumber(fp,size);
  1016. FOR i := 0 TO size-1 DO
  1017. value := code.inlineCode.GetBits(i*8,8);
  1018. FPNumber(fp,value);
  1019. END;
  1020. END;
  1021. ELSE
  1022. FPNumber(fp, fpModeExportedProcedure);
  1023. Global.GetSymbolName(x,name);
  1024. FPString(fp,name);
  1025. FPVisibility(fp, access);
  1026. FPSignature(fp,x.type(SyntaxTree.ProcedureType),x IS SyntaxTree.Operator);
  1027. END;
  1028. fingerprint.shallow := fp;
  1029. fingerprint.public := fingerprint.shallow;
  1030. fingerprint.private := fingerprint.shallow;
  1031. fingerprint.shallowAvailable := TRUE;
  1032. x.SetFingerprint(fingerprint);
  1033. SELF.deep := deep;
  1034. END;
  1035. END;
  1036. SELF.fingerprint := fingerprint
  1037. END VisitProcedure;
  1038. (* cf. Procedure *)
  1039. PROCEDURE VisitOperator*(x: SyntaxTree.Operator);
  1040. BEGIN
  1041. VisitProcedure(x) (* same finger print as a procedure *)
  1042. END VisitOperator;
  1043. PROCEDURE VisitModule*(x: SyntaxTree.Module);
  1044. VAR fingerprint, symbolFingerprint: SyntaxTree.Fingerprint; deep: BOOLEAN; fp: Basic.Fingerprint; symbol: SyntaxTree.Symbol; scope: SyntaxTree.ModuleScope;
  1045. BEGIN
  1046. fingerprint := x.fingerprint;
  1047. deep := SELF.deep;
  1048. IF Trace THEN TraceEnter("Record"); END;
  1049. IF ~fingerprint.shallowAvailable THEN
  1050. IF Trace THEN TraceIndent; D.Str("Module Enter Shallow "); D.Ln; END;
  1051. SELF.deep := FALSE;
  1052. fp := 0;
  1053. FPNumber(fp, fpTypeModule);
  1054. FPName(fp,x.name);
  1055. IF Trace THEN TraceIndent; D.Str("Module Name ");D.Hex(fp,0); D.Ln; END;
  1056. fingerprint.shallow := fp;
  1057. fingerprint.public := fingerprint.shallow;
  1058. fingerprint.private := fingerprint.shallow;
  1059. fingerprint.shallowAvailable := TRUE;
  1060. x.SetFingerprint(fingerprint);
  1061. SELF.deep := deep;
  1062. IF Trace THEN TraceIndent; D.Str("Module Shallow Done "); TraceFP(fingerprint); D.Ln; END;
  1063. END;
  1064. IF deep & ~fingerprint.deepAvailable THEN
  1065. IF Trace THEN TraceIndent; D.Str("Module Enter Deep "); D.Ln; END;
  1066. fingerprint.private := fingerprint.shallow;
  1067. fingerprint.public := fingerprint.shallow;
  1068. scope := x.moduleScope;
  1069. IF Trace THEN TraceIndent; D.Str("RecordType before methods"); TraceFP(fingerprint); D.Ln; END;
  1070. symbol := scope.firstSymbol;
  1071. WHILE symbol # NIL DO
  1072. IF symbol.access * SyntaxTree.Public # {} THEN
  1073. symbolFingerprint := SymbolFP(symbol);
  1074. FPNumber(fingerprint.private,symbolFingerprint.shallow);
  1075. FPNumber(fingerprint.public,symbolFingerprint.shallow);
  1076. END;
  1077. symbol := symbol.nextSymbol;
  1078. END;
  1079. IF Trace THEN TraceIndent; D.Str("Module Exit Deep "); TraceFP(fingerprint); D.Ln; END;
  1080. (*
  1081. ASSERT(fingerprint.private # 0,100);
  1082. ASSERT(fingerprint.public # 0,101);
  1083. *)
  1084. fingerprint.deepAvailable := TRUE;
  1085. x.SetFingerprint(fingerprint);
  1086. END;
  1087. SELF.fingerprint := fingerprint;
  1088. IF Trace THEN TraceExit("Record",fingerprint); END;
  1089. END VisitModule;
  1090. PROCEDURE VisitSymbol*(x: SyntaxTree.Symbol);
  1091. BEGIN
  1092. fingerprint.shallow := 0;
  1093. fingerprint.public := fingerprint.shallow;
  1094. fingerprint.private := fingerprint.shallow;
  1095. fingerprint.shallowAvailable := TRUE;
  1096. x.SetFingerprint(fingerprint);
  1097. END VisitSymbol;
  1098. PROCEDURE TraceIndent;
  1099. VAR i: LONGINT;
  1100. BEGIN
  1101. FOR i := 1 TO traceLevel DO D.Str(" "); END;
  1102. END TraceIndent;
  1103. PROCEDURE TraceEnter(CONST name: ARRAY OF CHAR);
  1104. BEGIN
  1105. INC(traceLevel); TraceIndent;
  1106. D.Str("Enter ");
  1107. D.Str(name);
  1108. D.Ln;
  1109. END TraceEnter;
  1110. PROCEDURE TraceExit(CONST name: ARRAY OF CHAR; CONST fingerprint: SyntaxTree.Fingerprint);
  1111. BEGIN
  1112. TraceIndent; DEC(traceLevel);
  1113. D.Str("Exit "); D.Str(name); D.Str(" "); TraceFP(fingerprint); D.Ln;
  1114. END TraceExit;
  1115. PROCEDURE TraceFP(CONST fingerprint: SyntaxTree.Fingerprint);
  1116. BEGIN
  1117. D.Hex(fingerprint.shallow,0); D.Str(" "); D.Hex(fingerprint.private,0);
  1118. D.Str(" "); D.Hex(fingerprint.public,0);
  1119. END TraceFP;
  1120. (* returns the finger print (object) of a type *)
  1121. PROCEDURE TypeFP*(this: SyntaxTree.Type): SyntaxTree.Fingerprint;
  1122. VAR deep: BOOLEAN;
  1123. BEGIN
  1124. IF Trace THEN TraceEnter("TypeFP"); END;
  1125. deep := SELF.deep;
  1126. SELF.deep := TRUE;
  1127. VType(this);
  1128. SELF.deep := deep;
  1129. ASSERT(fingerprint.deepAvailable,101);
  1130. ASSERT(fingerprint.shallow #0,102);
  1131. IF Trace THEN TraceExit("TypeFP",fingerprint); D.Ln;
  1132. D.Ln; END;
  1133. RETURN fingerprint
  1134. END TypeFP;
  1135. (* returns the finger print (object) of a symbol *)
  1136. PROCEDURE SymbolFP*(this: SyntaxTree.Symbol): SyntaxTree.Fingerprint;
  1137. VAR deep: BOOLEAN;
  1138. BEGIN
  1139. deep := SELF.deep;
  1140. SELF.deep := TRUE;
  1141. IF Trace THEN TraceEnter("SymbolFP");
  1142. TraceIndent;
  1143. D.Str("name: ");
  1144. D.Str0(this.name); D.Ln;
  1145. END;
  1146. VSymbol(this);
  1147. SELF.deep := deep;
  1148. IF Trace THEN TraceExit("SymbolFP",fingerprint); D.Ln; END;
  1149. RETURN fingerprint
  1150. END SymbolFP;
  1151. END Fingerprinter;
  1152. (** ---------- Fingerprinting primitives -------------- *)
  1153. PROCEDURE IsOberonProcedure(type: SyntaxTree.ProcedureType): BOOLEAN;
  1154. BEGIN
  1155. RETURN type.callingConvention = SyntaxTree.OberonCallingConvention
  1156. END IsOberonProcedure;
  1157. (* fp = fp <*> val *)
  1158. PROCEDURE FPNumber*(VAR fp: Basic.Fingerprint; val: HUGEINT);
  1159. BEGIN
  1160. fp:=SYSTEM.VAL(Basic.Fingerprint, SYSTEM.VAL(SET64, ROT(fp, 7)) / SYSTEM.VAL(SET64, val))
  1161. END FPNumber;
  1162. (* fp = fp <*> set *)
  1163. PROCEDURE FPSet*(VAR fp: Basic.Fingerprint; set: SET64);
  1164. BEGIN FPNumber(fp, SYSTEM.VAL(HUGEINT, set))
  1165. END FPSet;
  1166. (* fp = fp <*> real *)
  1167. PROCEDURE FPReal*(VAR fp: Basic.Fingerprint; real: LONGREAL);
  1168. BEGIN FPNumber(fp, SYSTEM.VAL(HUGEINT, real))
  1169. END FPReal;
  1170. (* fp = fp -> String *)
  1171. PROCEDURE FPName*(VAR fp: Basic.Fingerprint; x: SyntaxTree.Identifier);
  1172. VAR name: Scanner.IdentifierString;
  1173. BEGIN
  1174. Basic.GetString(x,name);
  1175. FPString(fp,name);
  1176. END FPName;
  1177. (* fp = fp {<*> str[i]} *)
  1178. PROCEDURE FPString*(VAR fp: Basic.Fingerprint; CONST str: ARRAY OF CHAR);
  1179. VAR i: INTEGER; ch: CHAR;
  1180. BEGIN i:=0; REPEAT ch:=str[i]; FPNumber(fp, ORD(ch)); INC(i) UNTIL ch=0X
  1181. END FPString;
  1182. (* fp = fp <*> (fpExtern | fpExternR | fpIntern | fpOther + vis) *)
  1183. PROCEDURE FPVisibility*(VAR fp: Basic.Fingerprint; vis: SET);
  1184. BEGIN
  1185. IF SyntaxTree.PublicWrite IN vis THEN FPNumber(fp, fpExtern)
  1186. ELSIF SyntaxTree.PublicRead IN vis THEN FPNumber(fp, fpExternR)
  1187. ELSIF SyntaxTree.Internal * vis #{} THEN FPNumber(fp, fpIntern)
  1188. ELSE
  1189. FPNumber(fp, fpOther + SYSTEM.VAL(WORD, vis))
  1190. END
  1191. END FPVisibility;
  1192. PROCEDURE DumpFingerprint*(w: Streams.Writer; CONST fp: SyntaxTree.Fingerprint);
  1193. BEGIN
  1194. w.String("fingerprint: ");
  1195. w.String("shallow = "); w.Hex(fp.shallow,0);
  1196. w.String(", private = "); w.Hex(fp.private,0);
  1197. w.String(", public = "); w.Hex(fp.public,0);
  1198. w.Ln;
  1199. END DumpFingerprint;
  1200. END FoxFingerprinter.