1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360 |
- MODULE FoxFingerprinter; (** AUTHOR "fof"; PURPOSE "Fingerprinting"; *)
- (* literature for the fingerprinting: Dissertation Crelier *)
- IMPORT SyntaxTree := FoxSyntaxTree, Basic := FoxBasic, SYSTEM, Global := FoxGlobal,Scanner := FoxScanner,
- D := Debugging, Streams;
- (** Fingerprinting
- FP(TypeDeclaration) = 0 <*> fpModeType -> Name -> Visibility <*> FP(Type).
- FP(ConstantDeclaration) = 0 <*> fpModeConstant -> Name -> Visibility <*> FP(Type) -> Basic -> Value.
- FP(VariableDeclaration) = 0 <*> fpModePar -> Name -> Visibility <*> FP(Type).
- FP(ProcedureDeclaration) = 0 <*> fpModeInlineProcedure -> Name -> Visibility <*> FP(Type) -> Code.
- | 0 <*> fpModeExportedProcedure -> Name -> Visibility <*> FP(Type)
- Name(fp,name) = fp <*> name[0] <*> ... <*> name[n].
- Visibility(fp,vis) = fp <*> fpExtern | fp <*> fpExternR | fp <*> fpOther <*> vis.
- Value(fp) = fp <*> fpTrue | fp <*> fpFalse | fp <*> integer | fp <*> intlow <*> inthigh | fp -> Name
- FP(Type) = FP(BasicType) | FP(RecordType) | FP(PointerType)
- | FP(ArrayType) | FP(MathArrayType) | FP(ProcedurType)
- FP(BasicType) = fpTypeChar8 | fpTypeChar16 | fpTypeChar32
- | fpTypeShortint | fpTypeInteger | fpTypeLongint | fpTypeHugeint
- | fpTypeReal | fpTypeLongreal
- | fpTypeSet | fpTypePointer |fpTypeString
- | fpTypeByte | fpTypeAll | fpTypeSame | fpTypeRange | fpTypeBoolean.
- PublicFP(BasicType) = FP(basicType).
- PrivateFP(BasicType) = sizeof(basicType).
- FP(RecordType) = fpTypeComposite <*> fptypeRecord
- [ -> Name(moduleName) -> Name(typeName)] [<*> FP(baseType)]
- PublicFP(RecordType) = FP(recordType) [<*> PublicFP(baseType)] {<*> FP(method) <*> methodNumber }
- {<*> PublicFP(fieldType) <*> offset(field) <*> FP(field)} <*> flags.
- PrivateFP(RecordType) = FP(recordType) [<*> PrivateFP(baseType)] {<*> FP(method) <*> methodNumber }
- {<*> PrivateFP(fieldType) <*> offset(field) <*> FP(field)}
- FP(Method) = 0 <*> fpModeMethod -> Name(methodName) -> Signature(method).
- FP(Field) = 0 <*> fpModeField -> Name(fieldName) -> Visibility [<*> fpUntraced] <*> FP(type).
- FP(PointerType) = fpTypePointer <*> fpTypeBasic -> Name <*> FP(baseType).
- PublicFP(PointerType) = 0.
- PrivateFP(PointerType) = 0.
- FP(ArrayType) = fpTypeComposite <*> (fpTypeOpenArray | fpTypeStaticArray)
- -> Name <*> FP(baseType) [<*> length].
- PublicFP(ArrayType) = FP(arrayType).
- PrivateFP(ArrayType) = FP(arrayType).
- FP(MathArrayType) = fpTypeComposite <*> (fpTypeOpenArray | fpTypeStaticArray)
- -> Name <*> FP(baseType) [<*> length].
- PublicFP(MathArrayType) = FP(arrayType).
- PrivateFP(MathArrayType) = FP(arrayType).
- FP(ProcedureType) = fpTypeProcedure <*> fpTypeBasic [<*> fpDelegate]-> Name.
- PublicFP(ProcedureType) = FP(arrayType) -> Signature(procedureType)
- PrivateFP(ProcedureType) = FP(arrayType)-> Signature(procedureType).
- Signature(f) = f <*> FP(returnType)
- { <*> (fpModeVarParameter | fpModeConstParameter | fpModePar)
- <*> FP(parameterType) [-> Name(parameterName)] }
- **)
- CONST
- (*Fingerprints/Obj Modes*)
- fpModeVar=1;
- fpModePar=1;
- fpModeVarPar=2;
- fpModeConstPar=fpModeVarPar; (*! for compatibility, must be changed *)
- fpModeConst=3;
- fpModeField=4;
- fpModeType=5;
- fpModeExportedProcedure=7;
- fpModeInlineProcedure=9;
- fpModeMethod=13;
- (*Fingerprints/Type Forms*)
- fpTypeByte = 1;
- fpTypeBoolean=2;
- fpTypeChar8=3;
- fpTypeShortint=4;
- fpTypeInteger=5;
- fpTypeLongint=6;
- fpTypeReal=7;
- fpTypeLongreal=8;
- fpTypeSet=9;
- fpTypeString=10;
- fpTypeNone = 12;
- fpTypePointer=13;
- fpTypeProcedure=14;
- fpTypeComposite=15;
- fpTypeHugeint=16;
- fpTypeChar16 = 17;
- fpTypeChar32 = 18;
- fpTypeAll = 19;
- fpTypeSame = 20;
- fpTypeRange = 21;
- fpTypeEnum = 22;
- fpTypePort = 23;
- fpTypeChannel = 23;
- fpTypeComplex = 24;
- fpTypeLongcomplex = 25;
- fpTypeModule=26;
- fpTypeSize=27;
- fpTypeAddress=28;
- fpTypeBasic=1;
- fpTypeStaticArray=2;
- fpTypeDynamicArray=4;
- fpTypeOpenArray=5;
- fpTypeRecord=6;
- fpIntern=0;
- fpExtern=1;
- fpExternR=2;
- fpOther =3;
- fpFalse=0;
- fpTrue=1;
- fpHasBody = 1;
- fpProtected =4;
- fpActive = 5;
- fpDelegate = 5;
- fpSystemType = 6;
- fpUntraced = 4;
- Trace=FALSE;
- TYPE
- Fingerprinter*= OBJECT (SyntaxTree.Visitor)
- VAR
- fp-: Basic.Fingerprint; (* temporary fingerprint for values etc. *)
- fingerprint: SyntaxTree.Fingerprint;
- deep: BOOLEAN; (* public / private field of FP needed ? *)
- traceLevel: LONGINT;
- level: LONGINT;
- PROCEDURE & InitFingerprinter*();
- BEGIN fp:= 0; deep := FALSE; traceLevel := 0;
- END InitFingerprinter;
- (** types *)
- (*
- FP(BasicType) = | fpTypeByte | fpTypeAll | fpTypeSame | fpTypeRange | fpTypeBoolean.
- | fpTypeSet | fpTypePointer
- PublicFP(BasicType) = FP(basicType).
- PrivateFP(BasicType) = sizeof(basicType).
- *)
- PROCEDURE VisitBasicType*(x: SyntaxTree.BasicType);
- BEGIN
- END VisitBasicType;
- PROCEDURE SetTypeFingerprint(x: SyntaxTree.Type; fp: Basic.Fingerprint);
- VAR fingerprint: SyntaxTree.Fingerprint;
- BEGIN
- fingerprint := x.fingerprint;
- IF ~fingerprint.shallowAvailable THEN
- fingerprint.shallow := fp;
- fingerprint.public := fp;
- fingerprint.private := fp;
- fingerprint.shallowAvailable := TRUE;
- fingerprint.deepAvailable := TRUE; (* no distinction between deep and shallow fp necessary *)
- x.SetFingerprint(fingerprint);
- END;
- SELF.fingerprint := fingerprint;
- END SetTypeFingerprint;
- PROCEDURE VisitRangeType*(x: SyntaxTree.RangeType);
- BEGIN
- SetTypeFingerprint(x,fpTypeRange);
- END VisitRangeType;
- PROCEDURE VisitBooleanType*(x: SyntaxTree.BooleanType);
- BEGIN
- SetTypeFingerprint(x,fpTypeBoolean);
- END VisitBooleanType;
- PROCEDURE VisitByteType*(x: SyntaxTree.ByteType);
- BEGIN
- SetTypeFingerprint(x,fpTypeByte)
- END VisitByteType;
- PROCEDURE VisitSetType*(x: SyntaxTree.SetType);
- BEGIN
- SetTypeFingerprint(x,fpTypeSet)
- END VisitSetType;
- PROCEDURE VisitNilType*(x: SyntaxTree.NilType);
- BEGIN
- SetTypeFingerprint(x,fpTypePointer)
- END VisitNilType;
- PROCEDURE VisitAnyType*(x: SyntaxTree.AnyType);
- BEGIN
- SetTypeFingerprint(x,fpTypePointer)
- END VisitAnyType;
- PROCEDURE VisitAddressType*(x: SyntaxTree.AddressType);
- BEGIN
- SetTypeFingerprint(x,fpTypeAddress)
- END VisitAddressType;
- PROCEDURE VisitSizeType*(x: SyntaxTree.SizeType);
- BEGIN
- SetTypeFingerprint(x, fpTypeSize);
- END VisitSizeType;
- PROCEDURE VisitObjectType*(x: SyntaxTree.ObjectType);
- BEGIN
- SetTypeFingerprint(x,fpTypePointer)
- END VisitObjectType;
- (*
- FP(BasicType) = fpTypeChar8 | fpTypeChar16 | fpTypeChar32
- PublicFP(BasicType) = FP(basicType).
- PrivateFP(BasicType) = sizeof(basicType).
- *)
- PROCEDURE VisitCharacterType*(x: SyntaxTree.CharacterType);
- BEGIN
- IF x.sizeInBits = 8 THEN SetTypeFingerprint(x,fpTypeChar8)
- ELSIF x.sizeInBits = 16 THEN SetTypeFingerprint(x,fpTypeChar16)
- ELSIF x.sizeInBits =32 THEN SetTypeFingerprint(x,fpTypeChar32)
- ELSE HALT(100)
- END;
- END VisitCharacterType;
- (*
- FP(BasicType) = fpTypeShortint | fpTypeInteger | fpTypeLongint | fpTypeLongint
- PublicFP(BasicType) = FP(basicType).
- PrivateFP(BasicType) = sizeof(basicType).
- *)
- PROCEDURE VisitIntegerType*(x: SyntaxTree.IntegerType);
- BEGIN
- IF x.sizeInBits=8 THEN SetTypeFingerprint(x,fpTypeShortint)
- ELSIF x.sizeInBits = 16 THEN SetTypeFingerprint(x,fpTypeInteger)
- ELSIF x.sizeInBits = 32 THEN SetTypeFingerprint(x,fpTypeLongint)
- ELSIF x.sizeInBits = 64 THEN SetTypeFingerprint(x,fpTypeHugeint)
- ELSE HALT(100)
- END;
- END VisitIntegerType;
- (*
- FP(BasicType) = fpTypeReal | fpTypeLongreal
- PublicFP(BasicType) = FP(basicType).
- PrivateFP(BasicType) = sizeof(basicType).
- *)
- PROCEDURE VisitFloatType*(x: SyntaxTree.FloatType);
- BEGIN
- IF x.sizeInBits = 32 THEN SetTypeFingerprint(x,fpTypeReal)
- ELSIF x.sizeInBits = 64 THEN SetTypeFingerprint(x,fpTypeLongreal)
- ELSE HALT(100)
- END;
- END VisitFloatType;
- PROCEDURE VisitComplexType*(x: SyntaxTree.ComplexType);
- BEGIN
- ASSERT(x.componentType # NIL);
- IF x.componentType.sizeInBits = 32 THEN SetTypeFingerprint(x,fpTypeComplex)
- ELSIF x.componentType.sizeInBits = 64 THEN SetTypeFingerprint(x,fpTypeLongcomplex)
- ELSE HALT(100)
- END
- END VisitComplexType;
- (*
- FP(BasicType) = fpStringType
- PublicFP(BasicType) = FP(basicType).
- PrivateFP(BasicType) = sizeof(basicType).
- *)
- PROCEDURE VisitStringType*(x: SyntaxTree.StringType);
- BEGIN
- SetTypeFingerprint(x,fpTypeString);
- END VisitStringType;
- (**
- fp enumeration type
- **)
- PROCEDURE VisitEnumerationType*(x: SyntaxTree.EnumerationType);
- VAR fingerprint: SyntaxTree.Fingerprint; enumerator: SyntaxTree.Constant; fp: Basic.Fingerprint;
- BEGIN
- fingerprint := x.fingerprint;
- IF ~fingerprint.shallowAvailable THEN
- fp := fpTypeEnum;
- IF x.enumerationBase # NIL THEN
- FPType(fp,x.enumerationBase);
- END;
- enumerator := x.enumerationScope.firstConstant;
- WHILE enumerator # NIL DO
- IF enumerator.access * SyntaxTree.Public # {} THEN
- FPName(fp,enumerator.name);
- END;
- FPValue(fp,enumerator.value);
- enumerator := enumerator.nextConstant;
- END;
- fingerprint.shallow := fp;
- fingerprint.public := fingerprint.shallow;
- fingerprint.private := fingerprint.shallow;
- fingerprint.shallowAvailable := TRUE;
- fingerprint.deepAvailable := TRUE; (* no distinction between deep and shallow fp necessary *)
- x.SetFingerprint(fingerprint);
- END;
- SELF.fingerprint := fingerprint
- (*! must be implemented
- IF x.enumerationBase # NIL THEN
- baseType := ResolveType(x.enumerationBase);
- resolved := baseType.resolved;
- enumerationBase := resolved(SyntaxTree.EnumerationType);
- baseScope := enumerationBase.enumerationScope;
- x.SetBaseValue(enumerationBase.baseValue + baseScope.numberEnumerators);
- END;
- CheckEnumerationScope(x.enumerationScope);
- x.SetState(SyntaxTree.Resolved);
- END;
- resolvedType := ResolvedType(x);
- *)
- END VisitEnumerationType;
- PROCEDURE VisitQualifiedType*(x: SyntaxTree.QualifiedType);
- BEGIN
- VType(x.resolved);
- END VisitQualifiedType;
- (*
- FP(ArrayType) = fpTypeComposite <*> (fpTypeOpenArray | fpTypeStaticArray)
- -> Name <*> FP(baseType) [<*> length].
- PublicFP(ArrayType) = FP(arrayType).
- PrivateFP(ArrayType) = FP(arrayType).
- *)
- PROCEDURE VisitArrayType*(x: SyntaxTree.ArrayType);
- VAR fingerprint: SyntaxTree.Fingerprint; deep: BOOLEAN; fp: Basic.Fingerprint;
- BEGIN
- IF Trace THEN TraceEnter("ArrayType") END;
- fingerprint := x.fingerprint;
- deep := SELF.deep;
- IF ~fingerprint.shallowAvailable THEN
- fingerprint.shallowAvailable := TRUE; (* the fingerprinting may return to itself => avoid circles *)
- SELF.deep := FALSE;
- fp := 0;
- FPNumber(fp,fpTypeComposite);
- IF x.form = SyntaxTree.Open THEN FPNumber(fp,fpTypeOpenArray)
- ELSIF x.form = SyntaxTree.Static THEN FPNumber(fp,fpTypeStaticArray)
- ELSIF x.form = SyntaxTree.SemiDynamic THEN FPNumber(fp, fpTypeDynamicArray);
- ELSE HALT(200)
- END;
- TypeName(fp,x);
- fingerprint.shallow := fp;
- x.SetFingerprint(fingerprint);
- FPType(fp,x.arrayBase.resolved);
- IF x.form = SyntaxTree.Static THEN FPNumber(fp,x.staticLength) END;
- fingerprint.shallow := fp;
- fingerprint.public := fingerprint.shallow;
- fingerprint.private := fingerprint.shallow;
- x.SetFingerprint(fingerprint);
- SELF.deep := deep;
- END;
- IF deep & ~fingerprint.deepAvailable THEN
- fingerprint.private := fingerprint.shallow;
- fingerprint.public := fingerprint.shallow;
- fingerprint.deepAvailable := TRUE; (* to avoid circles during base finger printing *)
- x.SetFingerprint(fingerprint);
- VType(x.arrayBase); (* make sure that base pointer is also deeply fped *)
- END;
- IF Trace THEN TraceExit("ArrayType",fingerprint) END;
- SELF.fingerprint := fingerprint;
- END VisitArrayType;
- (*
- FP(MathArrayType) = fpTypeComposite <*> (fpTypeOpenArray | fpTypeStaticArray)
- -> Name <*> FP(baseType) [<*> length].
- PublicFP(MathArrayType) = FP(arrayType).
- PrivateFP(MathArrayType) = FP(arrayType).
- *)
- PROCEDURE VisitMathArrayType*(x: SyntaxTree.MathArrayType);
- VAR fingerprint: SyntaxTree.Fingerprint; deep: BOOLEAN; fp: Basic.Fingerprint;
- BEGIN
- fingerprint := x.fingerprint;
- deep := SELF.deep;
- IF Trace THEN TraceEnter("MathArrayType") END;
- IF ~fingerprint.shallowAvailable THEN
- fingerprint.shallowAvailable := TRUE; (* the fingerprinting may return to itself => avoid circles *)
- SELF.deep := FALSE;
- fp := 0;
- FPNumber(fp,fpTypeComposite);
- IF x.form = SyntaxTree.Open THEN FPNumber(fp,fpTypeOpenArray)
- ELSIF x.form = SyntaxTree.Static THEN FPNumber(fp,fpTypeStaticArray)
- ELSIF x.form = SyntaxTree.Tensor THEN (* do nothing *)
- ELSE HALT(200)
- END;
- TypeName(fp,x);
- IF x.arrayBase # NIL THEN
- FPType(fp,x.arrayBase.resolved);
- END;
- IF x.form = SyntaxTree.Static THEN FPNumber(fp,x.staticLength) END;
- fingerprint.shallow := fp;
- fingerprint.public := fingerprint.shallow;
- fingerprint.private := fingerprint.shallow;
- fingerprint.shallowAvailable := TRUE;
- x.SetFingerprint(fingerprint);
- SELF.deep := deep;
- END;
- IF deep & ~fingerprint.deepAvailable THEN
- VType(x.arrayBase);
- fingerprint.private := fingerprint.shallow;
- fingerprint.public := fingerprint.shallow;
- fingerprint.deepAvailable := TRUE;
- x.SetFingerprint(fingerprint);
- END;
- IF Trace THEN TraceExit("MathArrayType",fingerprint) END;
- SELF.fingerprint := fingerprint;
- END VisitMathArrayType;
- (*
- fp = fp [ -> Name(moduleName) -> Name(typeName) ]
- *)
- PROCEDURE TypeName(VAR fp: Basic.Fingerprint; x:SyntaxTree.Type);
- VAR typeDeclaration: SyntaxTree.TypeDeclaration;
- BEGIN
- IF (x.scope # NIL) THEN
- (* only executed for imported types, reason:
- modification of a type name would result in modified fingerprint leading to modified fingerprints of using structures such as
- in the following example:
- TYPE A=ARRAY 32 OF CHAR;
- PROCEDURE P*(a:A);
- ...
- END P;
- IF name of A was changed, P would get a new fingerprint.
- Better: fingerprint of P only depends in type of A but not on its declared name.
- *)
- IF Trace THEN
- TraceIndent;
- D.Str("TypeName ");
- D.Str0(x.scope.ownerModule.name);
- END;
- typeDeclaration := x.typeDeclaration;
- IF(typeDeclaration # NIL) & (typeDeclaration.access # SyntaxTree.Hidden) THEN
- FPName(fp,x.scope.ownerModule.name);
- IF (typeDeclaration.declaredType.resolved # x) THEN
- (* in record type: pointer to type declaration of a pointer *)
- typeDeclaration := NIL
- END;
- IF (typeDeclaration # NIL) & (typeDeclaration.scope # NIL)THEN
- FPName(fp,typeDeclaration.name);
- IF Trace THEN
- D.Str(".");
- D.Str0(typeDeclaration.name);
- END;
- ELSIF (typeDeclaration # NIL) & (typeDeclaration.scope = NIL) THEN
- D.Str("typedeclaration without scope: "); D.Str0(x.typeDeclaration.name); D.Int(x.typeDeclaration.position.start,5); D.Ln;
- D.Update;
- ELSE
- FPNumber(fp,0);
- END;
- ELSE
- FPNumber(fp, 0);
- END;
- IF Trace THEN
- D.Str(", fp = "); D.Hex(fp,0); D.Ln;
- END
- END
- END TypeName;
- (*
- FP(PointerType) = fpTypePointer <*> fpTypeBasic -> Name <*> FP(baseType).
- PublicFP(PointerType) = 0.
- PrivateFP(PointerType) = 0.
- *)
- PROCEDURE VisitPointerType*(x: SyntaxTree.PointerType);
- VAR fp: Basic.Fingerprint; deep: BOOLEAN; fingerprint: SyntaxTree.Fingerprint;
- BEGIN
- IF Trace THEN TraceEnter("PointerType"); END;
- fingerprint := x.fingerprint;
- deep := SELF.deep;
- IF ~fingerprint.shallowAvailable THEN
- IF Trace THEN TraceIndent; D.Str("PointerType shallow");D.Ln; END;
- SELF.deep := FALSE;
- fp := 0;
- FPNumber(fp, fpTypePointer); FPNumber(fp, fpTypeBasic);
- TypeName(fp,x);
- FPType(fp,x.pointerBase);
- fingerprint.shallow := fp;
- fingerprint.private := fp;
- fingerprint.public := fp;
- fingerprint.shallowAvailable := TRUE;
- fingerprint.deepAvailable := TRUE;
- (*
- deep fingerprinting leads to cycles -> must be done on record type directly, if a deep FP is needed
- IF deep & ~fingerprint.deepAvailable THEN
- IF Trace THEN TraceIndent; D.Str("PointerType:deep");D.Ln; END;
- x.pointerBase.Accept(SELF);
- fingerprint.deepAvailable := TRUE;
- END;
- *)
- x.SetFingerprint(fingerprint);
- SELF.deep := deep;
- END;
- IF Trace THEN TraceExit("PointerType",fingerprint) END;
- SELF.fingerprint := fingerprint;
- END VisitPointerType;
- (*
- FP(PortType) = fpTypePort <*> fpTypeBasic -> Name <*> FP(baseType).
- PublicFP(PortType) = 0.
- PrivateFP(PortType) = 0.
- *)
- PROCEDURE VisitPortType*(x: SyntaxTree.PortType);
- VAR fingerprint: SyntaxTree.Fingerprint; fp: Basic.Fingerprint; deep: BOOLEAN;
- BEGIN
- IF Trace THEN TraceEnter("PortType"); END;
- fingerprint := x.fingerprint;
- deep := SELF.deep;
- IF ~fingerprint.shallowAvailable THEN
- IF Trace THEN TraceIndent; D.Str("PortType shallow");D.Ln; END;
- SELF.deep := FALSE;
- fp := 0;
- FPNumber(fp, fpTypePort); FPNumber(fp, fpTypeBasic);
- TypeName(fp,x);
- FPNumber(fp,x.sizeInBits);
- fingerprint.shallow := fp;
- fingerprint.private := fp;
- fingerprint.public := fp;
- fingerprint.shallowAvailable := TRUE;
- fingerprint.deepAvailable := TRUE;
- SELF.deep := deep;
- END;
- IF Trace THEN TraceExit("PortType",fingerprint) END;
- SELF.fingerprint := fingerprint;
- END VisitPortType;
- (*
- FP(Method) = 0 <*> fpModeMethod -> Name(methodName) -> Signature(method).
- *)
- PROCEDURE FPrintMethod(VAR private,public: Basic.Fingerprint; procedure,body: SyntaxTree.Procedure);
- VAR fingerprint: SyntaxTree.Fingerprint; fp: Basic.Fingerprint; name: ARRAY 256 OF CHAR;
- BEGIN
- IF Trace THEN TraceEnter("Method");
- D.Address(SYSTEM.VAL(ADDRESS,procedure));
- procedure.GetName(name);
- TraceIndent; D.Str("name = "); D.Str(name); D.Ln;
- END;
- ASSERT(deep);
- fingerprint := procedure.fingerprint;
- IF ~fingerprint.shallowAvailable THEN
- fp := 0;
- FPNumber(fp,fpModeMethod);
- Global.GetSymbolName(procedure,name);
- FPString(fp,name);
- FPSignature(fp,procedure.type(SyntaxTree.ProcedureType),procedure IS SyntaxTree.Operator );
- fingerprint.shallow := fp;
- fingerprint.public := fingerprint.shallow;
- fingerprint.private := fingerprint.shallow;
- fingerprint.shallowAvailable := TRUE;
- procedure.SetFingerprint(fingerprint)
- ELSE
- fp := fingerprint.shallow;
- END;
- IF procedure.access * SyntaxTree.Public # {} THEN (* visible method or visible supermethod *)
- IF Trace THEN D.String("fp before method number"); D.Hex(fp,0); D.Ln END;
- FPNumber(fp,procedure.methodNumber);
- IF Trace THEN D.String("fp after method number"); D.Hex(fp,0); D.Ln END;
- IF procedure # body THEN
- FPNumber(private,fp); FPNumber(public,fp);
- END;
- END;
- IF Trace THEN
- TraceIndent; D.Str("Method, fp = "); D.Hex(private,0); D.Str(" "); D.Hex(public,0); D.Ln;
- TraceExit("Method",fingerprint)
- END;
- END FPrintMethod;
- PROCEDURE VisitCellType*(x: SyntaxTree.CellType);
- VAR fingerprint: SyntaxTree.Fingerprint; fp: Basic.Fingerprint;
- BEGIN
- fingerprint := x.fingerprint;
- deep := SELF.deep;
- IF ~fingerprint.shallowAvailable THEN
- fp := 0;
- TypeName(fp,x);
- fingerprint.shallow := fp;
- fingerprint.public := fp;
- fingerprint.private := fp;
- fingerprint.deepAvailable := TRUE;
- fingerprint.shallowAvailable := TRUE;
- x.SetFingerprint(fingerprint);
- END;
- SELF.fingerprint := fingerprint
- END VisitCellType;
- (*
- FP(RecordType) = fpTypeComposite <*> fptypeRecord
- [ -> Name(moduleName) -> Name(typeName)] [<*> FP(baseType)]
- PublicFP(RecordType) = FP(recordType) [<*> PublicFP(baseType)] {<*> FP(method) <*> methodNumber }
- {<*> PublicFP(fieldType) <*> offset(field) <*> FP(field)} <*> flags.
- PrivateFP(RecordType) = FP(recordType) [<*> PrivateFP(baseType)] {<*> FP(method) <*> methodNumber }
- {<*> PrivateFP(fieldType) <*> offset(field) <*> FP(field)}
- *)
- PROCEDURE VisitRecordType*(x: SyntaxTree.RecordType);
- VAR scope: SyntaxTree.RecordScope; fp: Basic.Fingerprint; variable: SyntaxTree.Variable;
- fingerprint,variableFingerprint,variableTypeFingerprint,baseFingerprint: SyntaxTree.Fingerprint;flags: SET;
- symbol: SyntaxTree.Symbol; procedure: SyntaxTree.Procedure; baseType: SyntaxTree.Type;
- body: SyntaxTree.Body; name: ARRAY 256 OF CHAR;
- deep: BOOLEAN;
- (* for dealing with cycles the private and public fingerprint are computed here
- while FP is computed completely during call of Type0 *)
- BEGIN
- fingerprint := x.fingerprint;
- deep := SELF.deep;
- IF Trace THEN TraceEnter("Record"); END;
- IF ~fingerprint.shallowAvailable THEN
- IF Trace THEN TraceIndent; D.Str("RecordType Enter Shallow "); D.Ln; END;
- SELF.deep := FALSE;
- fp := 0;
- FPNumber(fp, fpTypeComposite); FPNumber(fp, fpTypeRecord);
- TypeName(fp,x);
- IF Trace THEN TraceIndent; D.Str("RecordType Name ");D.Hex(fp,0); D.Ln; END;
- IF (x.baseType # NIL) THEN
- baseType := x.GetBaseRecord();
- FPType(fp,baseType);
- END;
- SELF.deep := TRUE;
- (* methods, sorted *)
- scope := x.recordScope;
- symbol := scope.firstSymbol;
- WHILE symbol # NIL DO (* number and names of procedures -- method table ! *)
- IF symbol IS SyntaxTree.Procedure THEN
- procedure := symbol(SyntaxTree.Procedure);
- FPNumber(fp,fpModeMethod);
- Global.GetSymbolName(procedure,name);
- FPString(fp,name);
- IF Trace THEN TraceIndent; D.Str("RecordType Method "); TraceFP(fingerprint); D.Ln; END;
- END;
- symbol := symbol.nextSymbol
- END;
- fingerprint.shallow := fp;
- fingerprint.public := fingerprint.shallow;
- fingerprint.private := fingerprint.shallow;
- fingerprint.shallowAvailable := TRUE;
- x.SetFingerprint(fingerprint);
- SELF.deep := deep;
- IF Trace THEN TraceIndent; D.Str("RecordType Shallow Done "); TraceFP(fingerprint); D.Ln; END;
- END;
- IF deep & ~fingerprint.deepAvailable THEN
- IF Trace THEN TraceIndent; D.Str("RecordType Enter Deep "); D.Ln; END;
- fingerprint.private := fingerprint.shallow;
- fingerprint.public := fingerprint.shallow;
- (*! finger printing for interfaces omitted *)
- IF Trace THEN TraceIndent; D.Str("RecordType before basetype"); TraceFP(fingerprint); D.Ln; END;
- (* now compute base record finger prints *)
- baseType := x.GetBaseRecord();
- IF (baseType # NIL) THEN
- IF baseType IS SyntaxTree.PointerType THEN baseType := baseType(SyntaxTree.PointerType).pointerBase.resolved END;
- baseFingerprint := TypeFP(baseType); (* deep finger print *)
- FPNumber(fingerprint.private,baseFingerprint.private);
- FPNumber(fingerprint.public,baseFingerprint.public);
- END;
- scope := x.recordScope;
- IF Trace THEN TraceIndent; D.Str("RecordType before methods"); TraceFP(fingerprint); D.Ln; END;
- (* methods, sorted *)
- symbol := scope.firstSymbol;
- WHILE symbol # NIL DO
- IF symbol IS SyntaxTree.Procedure THEN
- procedure := symbol(SyntaxTree.Procedure);
- FPrintMethod(fingerprint.private, fingerprint.public, procedure, scope.bodyProcedure);
- IF Trace THEN TraceIndent; D.Str("RecordType Method "); TraceFP(fingerprint); D.Ln; END;
- END;
- symbol := symbol.nextSymbol
- END;
- IF Trace THEN TraceIndent; D.Str("RecordType after methods"); TraceFP(fingerprint); D.Ln; END;
- variable := scope.firstVariable;
- WHILE variable # NIL DO
- variableFingerprint := variable.fingerprint;
- IF variable.access * SyntaxTree.Public # {} THEN
- (* variable fp = & fpModeField & Name & Visibility [& fpUntraced] & Type *)
- fp := 0;
- FPNumber(fp,fpModeField);
- FPName(fp,variable.name);
- FPVisibility(fp,variable.access);
- IF variable.untraced THEN FPNumber(fp,fpUntraced) END;
- variableTypeFingerprint := TypeFP(variable.type); (* deep finger print *)
- FPNumber(fp,variableTypeFingerprint.shallow);
- variableFingerprint.shallow := fp;
- FPNumber(fingerprint.private,variableTypeFingerprint.private);
- FPNumber(fingerprint.private,SHORT(variable.offsetInBits DIV 8));
- FPNumber(fingerprint.private,fp);
- FPNumber(fingerprint.public,variableTypeFingerprint.public);
- FPNumber(fingerprint.public,SHORT(variable.offsetInBits DIV 8));
- FPNumber(fingerprint.public,fp);
- IF Trace THEN TraceIndent; D.Str("RecordType Field "); D.Str0(variable.name); D.Str(" "); TraceFP(fingerprint); D.Ln; END;
- ELSE
- fp := 0;
- IF variable.untraced THEN FPNumber(fp,fpUntraced) END;
- FPNumber(fingerprint.private,fp);
- IF Trace THEN TraceIndent; D.Str("RecordType InvisibleField "); TraceFP(fingerprint); D.Ln; END;
- END;
- variable := variable.nextVariable;
- END;
- FPNumber(fingerprint.private, SHORT(x.sizeInBits DIV 8));
- FPNumber(fingerprint.public, SHORT(x.sizeInBits DIV 8));
- flags := {};
- IF x.recordScope.bodyProcedure # NIL THEN
- body := x.recordScope.bodyProcedure.procedureScope.body;
- INCL(flags, fpHasBody);
- IF body # NIL THEN
- IF body.isActive THEN INCL(flags,fpActive) END;
- IF body.isExclusive THEN INCL(flags,fpProtected) END;
- END;
- IF Trace THEN TraceIndent; D.Str("RecordType Body "); TraceFP(fingerprint); D.Ln; END;
- END;
- IF x.IsProtected() THEN INCL(flags,fpProtected) END;
- FPSet(fingerprint.public, flags);
- IF Trace THEN TraceIndent; D.Str("RecordType Exit Deep "); TraceFP(fingerprint); D.Ln; END;
- (*
- ASSERT(fingerprint.private # 0,100);
- ASSERT(fingerprint.public # 0,101);
- *)
- fingerprint.deepAvailable := TRUE;
- x.SetFingerprint(fingerprint);
- END;
- SELF.fingerprint := fingerprint;
- IF Trace THEN TraceExit("Record",fingerprint); END;
- END VisitRecordType;
- (*
- FP(ProcedureType) = fpTypeProcedure <*> fpTypeBasic [<*> fpDelegate]-> Name.
- PublicFP(ProcedureType) = FP(arrayType) -> Signature(procedureType)
- PrivateFP(ProcedureType) = FP(arrayType)-> Signature(procedureType).
- *)
- PROCEDURE VisitProcedureType*(x: SyntaxTree.ProcedureType);
- VAR fingerprint: SyntaxTree.Fingerprint; deep: BOOLEAN; fp: Basic.Fingerprint;
- BEGIN
- IF Trace THEN TraceEnter("ProcedureType") END;
- fingerprint := x.fingerprint;
- deep := SELF.deep;
- IF ~fingerprint.shallowAvailable THEN
- fingerprint.shallowAvailable := TRUE; (*! to avoid circles, this is not fully clean - for paco *)
- fp := 0;
- FPNumber(fp,fpTypeProcedure);
- FPNumber(fp,fpTypeBasic);
- IF x.isDelegate THEN FPNumber(fp,fpDelegate) END;
- x.SetFingerprint(fingerprint);
- TypeName(fp,x);
- fingerprint.public := fp; fingerprint.private := fp;
- fingerprint.shallow := fp;
- FPSignature(fp,x,FALSE);
- fingerprint.public := fp; fingerprint.private := fp;
- fingerprint.shallow := fp;
- fingerprint.deepAvailable := TRUE;
- x.SetFingerprint(fingerprint);
- END;
- (*
- IF ~fingerprint.deepAvailable THEN
- SELF.deep := FALSE;
- FPSignature(fp,x,FALSE);
- SELF.deep := deep;
- fingerprint.public := fp; fingerprint.private := fp;
- fingerprint.shallow := fp;
- fingerprint.deepAvailable := TRUE;
- END;
- *)
- IF Trace THEN TraceExit("ProcedureType",fingerprint) END;
- SELF.fingerprint := fingerprint;
- END VisitProcedureType;
- (** values - used in constant symbols - effects in fingerprint modification of (object) global variable fp *)
- (* fp = fp & (fpTrue | fpFalse) *)
- PROCEDURE VisitBooleanValue*(x: SyntaxTree.BooleanValue);
- BEGIN IF x.value THEN FPNumber(SELF.fp,fpTrue) ELSE FPNumber(SELF.fp,fpFalse) END
- END VisitBooleanValue;
- (* fp = fp & (HugeInt | Number) *)
- PROCEDURE VisitIntegerValue*(x: SyntaxTree.IntegerValue);
- BEGIN FPNumber(SELF.fp,x.value)
- END VisitIntegerValue;
- (* fp = fp & (HugeInt | Number) *)
- PROCEDURE VisitEnumerationValue*(x: SyntaxTree.EnumerationValue);
- BEGIN FPNumber(SELF.fp,x.value)
- END VisitEnumerationValue;
- (* fp = fp & ORD(char) *)
- PROCEDURE VisitCharacterValue*(x: SyntaxTree.CharacterValue);
- BEGIN FPNumber(SELF.fp,ORD(x.value))
- END VisitCharacterValue;
- (* fp = fp & Set *)
- PROCEDURE VisitSetValue*(x: SyntaxTree.SetValue);
- BEGIN FPSet(SELF.fp,x.value)
- END VisitSetValue;
- PROCEDURE VisitMathArrayExpression*(x: SyntaxTree.MathArrayExpression);
- VAR element: SyntaxTree.Expression; i: LONGINT;
- BEGIN
- FOR i := 0 TO x.elements.Length()-1 DO
- element := x.elements.GetExpression(i);
- FPValue(fp, element);
- END;
- END VisitMathArrayExpression;
- (* fp = fp {& Value} *)
- PROCEDURE VisitMathArrayValue*(x: SyntaxTree.MathArrayValue);
- BEGIN
- VisitMathArrayExpression(x.array); (* do not call FPValue here, recursion possible because x.array.resolved = x *)
- END VisitMathArrayValue;
- (* fp = fp & (Real | LongReal) *)
- PROCEDURE VisitRealValue*(x: SyntaxTree.RealValue);
- BEGIN FPReal(SELF.fp,x.value);
- END VisitRealValue;
- PROCEDURE VisitComplexValue*(x: SyntaxTree.ComplexValue);
- BEGIN
- FPReal(SELF.fp,x.realValue);
- FPReal(SELF.fp,x.imagValue);
- END VisitComplexValue;
- PROCEDURE VisitNilValue*(x: SyntaxTree.NilValue);
- BEGIN FPNumber(SELF.fp, 0);
- END VisitNilValue;
- (* fp = fp & String *)
- PROCEDURE VisitStringValue*(x: SyntaxTree.StringValue);
- BEGIN FPString(SELF.fp,x.value^) END VisitStringValue;
- (* fp = fp & FP(x) *)
- PROCEDURE FPValue(VAR fp: Basic.Fingerprint; x: SyntaxTree.Expression);
- BEGIN
- SELF.fp := fp;
- IF x.resolved # NIL THEN
- VExpression(x.resolved);
- ELSE
- VExpression(x);
- END;
- fp := SELF.fp
- END FPValue;
- PROCEDURE FPType(VAR fp: Basic.Fingerprint; t: SyntaxTree.Type);
- BEGIN
- INC(level); ASSERT(level <= 100);
- IF t = NIL THEN FPNumber(fp,fpTypeNone);
- ELSE VType(t); FPNumber(fp,SELF.fingerprint.shallow);
- END;
- DEC(level);
- END FPType;
- (* Signature(f) = f <*> FP(returnType)
- { <*> (fpModeVarParameter | fpModeConstParameter | fpModePar)
- <*> FP(parameterType) [-> Name(parameterName)] }
- *)
- PROCEDURE FPSignature(VAR fp: Basic.Fingerprint; t: SyntaxTree.ProcedureType; isOperator: BOOLEAN);
- VAR par,self: SyntaxTree.Parameter; deep: BOOLEAN;
- (* fp = fp & (fpModeVarPar | fpModeConstPar | fpModePar) [ & Name ] *)
- PROCEDURE FPPar(VAR fp: Basic.Fingerprint; par: SyntaxTree.Parameter);
- VAR deep: BOOLEAN;
- BEGIN
- IF par.kind = SyntaxTree.VarParameter THEN FPNumber(fp, fpModeVarPar)
- ELSIF par.kind = SyntaxTree.ConstParameter THEN
- IF (par.type.resolved IS SyntaxTree.ArrayType) OR (par.type.resolved IS SyntaxTree.RecordType) THEN (*! compatiblity with paco *)
- FPNumber(fp,fpModeVarPar)
- ELSE
- FPNumber(fp,fpModePar)
- END;
- ELSE FPNumber(fp, fpModePar) END;
- deep := SELF.deep;
- SELF.deep := FALSE;
- FPType(fp,par.type);
- SELF.deep := deep;
- IF isOperator & ~(par.type.resolved IS SyntaxTree.BasicType) & (par.type.resolved.typeDeclaration # NIL) THEN
- FPName(fp,par.type.resolved.typeDeclaration.name);
- (* D.Str("fp "); D.Str0(par.type.resolved.typeDeclaration.name.name); D.Ln;*)
- ELSIF isOperator & (par.type.resolved IS SyntaxTree.BasicType) THEN
- FPName(fp,par.type.resolved(SyntaxTree.BasicType).name);
- (* D.Str("fpb "); D.Str0(par.type.resolved(SyntaxTree.BasicType).name.name);*)
- END;
- END FPPar;
- BEGIN
- IF Trace THEN
- TraceIndent; D.Str("FPSignature enter "); D.Hex(fp,0); D.Ln;
- END;
- deep := SELF.deep;
- SELF.deep := FALSE;
- FPType(fp,t.returnType);
- SELF.deep := deep;
- IF Trace THEN
- TraceIndent; D.Str("FPSignature after return type "); D.Hex(fp,0); D.Ln;
- END;
- IF IsOberonProcedure(t) THEN
- self := t.firstParameter;
- WHILE (self # NIL) & (self.name#Global.SelfParameterName) DO
- self := self.nextParameter;
- END;
- IF self # NIL THEN FPPar(fp,self) END; (* self parameter *)
- (*
- IF t.selfParameter # NIL THEN FPPar(fp,t.selfParameter) END; (* self parameter *)
- self := NIL;
- *)
- IF Trace THEN
- TraceIndent; D.Str("FPSignature after self "); D.Hex(fp,0); D.Ln;
- END;
- par := t.firstParameter;
- WHILE (par#self) DO (*! done as in PACO *)
- FPPar(fp, par);
- IF Trace THEN
- TraceIndent; D.Str("FPSignature par "); D.Hex(fp,0); D.Ln;
- END;
- par:=par.nextParameter;
- END;
- IF Trace THEN
- TraceIndent; D.Str("FPSignature exit "); D.Hex(fp,0); D.Ln;
- END;
- ELSE
- par := t.lastParameter;
- WHILE (par#NIL) DO (*! done as in PACO *)
- FPPar(fp, par);
- IF Trace THEN
- TraceIndent; D.Str("FPSignature par "); D.Hex(fp,0); D.Ln;
- END;
- par:=par.prevParameter;
- END;
- END;
- END FPSignature;
- (** symbols *)
- (*
- FP(TypeDeclaration) = 0 <*> fpModeType -> Name -> Visibility <*> FP(Type).
- *)
- PROCEDURE VisitTypeDeclaration*(x: SyntaxTree.TypeDeclaration);
- VAR fp: Basic.Fingerprint;
- fingerprint, typeFP: SyntaxTree.Fingerprint; deep: BOOLEAN;
- BEGIN
- fingerprint := x.fingerprint;
- IF ~fingerprint.shallowAvailable THEN
- IF Trace THEN TraceEnter("TypeDeclaration") END;
- deep := SELF.deep;
- SELF.deep := FALSE;
- fp := 0;
- FPNumber(fp, fpModeType);
- FPName(fp,x.name);
- IF Trace THEN TraceIndent; D.String("access="); D.Set(x.access); D.Ln; END;
- FPVisibility(fp, x.access);
- VType(x.declaredType);
- FPNumber(fp, SELF.fingerprint.shallow);
- fingerprint.shallow := fp;
- fingerprint.public := fp;
- fingerprint.private := fp;
- fingerprint.shallowAvailable := TRUE;
- x.SetFingerprint(fingerprint);
- SELF.deep := deep;
- IF Trace THEN TraceExit("TypeDeclaration",fingerprint) END;
- END;
- IF deep & ~fingerprint.deepAvailable THEN
- fingerprint := x.fingerprint;
- typeFP := TypeFP(x.declaredType);
- IF x.declaredType.resolved IS SyntaxTree.PointerType THEN
- typeFP := TypeFP(x.declaredType.resolved(SyntaxTree.PointerType).pointerBase);
- END;
- FPNumber(fingerprint.public, typeFP.public);
- FPNumber(fingerprint.private, typeFP.private);
- fingerprint.deepAvailable := TRUE;
- x.SetFingerprint(fingerprint);
- END;
- SELF.fingerprint := fingerprint
- END VisitTypeDeclaration;
- (*
- FP(ConstantDeclaration) = 0 <*> fpModeConstant -> Name -> Visibility <*> FP(Type) -> Basic -> Value.
- *)
- PROCEDURE VisitConstant*(x: SyntaxTree.Constant);
- VAR access: SET;
- fingerprint: SyntaxTree.Fingerprint;
- fp: Basic.Fingerprint;
- deep: BOOLEAN;
- BEGIN
- fingerprint := x.fingerprint;
- IF ~fingerprint.shallowAvailable THEN
- deep := SELF.deep;
- SELF.deep := FALSE;
- fp := 0;
- FPNumber(fp, fpModeConst);
- FPName(fp,x.name);
- (* for compatibility with old compiler: *)
- access := x.access; IF SyntaxTree.PublicRead IN access THEN INCL(access,SyntaxTree.PublicWrite) END;
- FPVisibility(fp, access);
- FPType(fp, x.type);
- FPNumber(fp, fpTypeBasic);
- FPValue(fp, x.value);
- fingerprint.shallow := fp;
- fingerprint.public := fingerprint.shallow;
- fingerprint.private := fingerprint.shallow;
- fingerprint.shallowAvailable := TRUE;
- x.SetFingerprint(fingerprint);
- SELF.deep := deep;
- END;
- SELF.fingerprint := fingerprint
- END VisitConstant;
- (*
- FP(VariableDeclaration) = 0 <*> fpModePar -> Name -> Visibility <*> FP(Type).
- *)
- PROCEDURE VisitVariable*(x: SyntaxTree.Variable);
- VAR fp: Basic.Fingerprint; fingerprint: SyntaxTree.Fingerprint; deep: BOOLEAN; name: SyntaxTree.IdentifierString;
- BEGIN
- fingerprint := x.fingerprint;
- IF ~fingerprint.shallowAvailable THEN
- deep := SELF.deep;
- SELF.deep := FALSE;
- fp := 0;
- FPNumber(fp,fpModeVar);
- Global.GetSymbolName(x,name);
- FPString(fp,name);
- FPVisibility(fp,x.access);
- VType(x.type);
- FPNumber(fp,SELF.fingerprint.shallow);
- fingerprint.shallow := fp;
- fingerprint.public := fingerprint.shallow;
- fingerprint.private := fingerprint.shallow;
- fingerprint.shallowAvailable := TRUE;
- x.SetFingerprint(fingerprint);
- SELF.deep := deep;
- END;
- SELF.fingerprint := fingerprint
- END VisitVariable;
- PROCEDURE VisitProperty*(x: SyntaxTree.Property);
- BEGIN
- VisitVariable(x);
- END VisitProperty;
- (*
- FP(ParameterDeclaration) = 0 <*> fpModePar -> Name -> Visibility <*> FP(Type).
- *)
- PROCEDURE VisitParameter*(x: SyntaxTree.Parameter);
- VAR fp: Basic.Fingerprint; fingerprint: SyntaxTree.Fingerprint; deep: BOOLEAN; name: SyntaxTree.IdentifierString;
- BEGIN
- fingerprint := x.fingerprint;
- IF ~fingerprint.shallowAvailable THEN
- deep := SELF.deep;
- SELF.deep := FALSE;
- fp := 0;
- FPNumber(fp,fpModePar);
- Global.GetSymbolName(x,name);
- FPString(fp,name);
- FPVisibility(fp,x.access);
- VType(x.type);
- FPNumber(fp,SELF.fingerprint.shallow);
- fingerprint.shallow := fp;
- fingerprint.public := fingerprint.shallow;
- fingerprint.private := fingerprint.shallow;
- fingerprint.shallowAvailable := TRUE;
- x.SetFingerprint(fingerprint);
- SELF.deep := deep;
- END;
- SELF.fingerprint := fingerprint
- END VisitParameter;
- (*
- FP(ProcedureDeclaration) = 0 <*> fpModeInlineProcedure -> Name -> Visibility <*> FP(Type) -> Code.
- | 0 <*> fpModeExportedProcedure -> Name -> Visibility <*> FP(Type)
- *)
- PROCEDURE VisitProcedure*(x: SyntaxTree.Procedure);
- VAR fp: Basic.Fingerprint; access: SET; fingerprint: SyntaxTree.Fingerprint; deep: BOOLEAN; code: SyntaxTree.Code; i: LONGINT;
- size: LONGINT; value: WORD; name: ARRAY 256 OF CHAR;
- BEGIN
- IF x.scope IS SyntaxTree.RecordScope THEN (* method *)
- FPrintMethod(fp,fp,x,NIL);
- fingerprint := x.fingerprint;
- ELSE
- fingerprint := x.fingerprint;
- IF ~fingerprint.shallowAvailable THEN
- deep := SELF.deep;
- SELF.deep := FALSE;
- (* for compatibility with old compiler: *)
- access := x.access; IF SyntaxTree.PublicRead IN access THEN INCL(access,SyntaxTree.PublicWrite) END;
- fp := 0;
- IF x.isInline THEN
- FPNumber(fp, fpModeInlineProcedure);
- FPName(fp,x.name);
- FPVisibility(fp, access);
- FPSignature(fp,x.type(SyntaxTree.ProcedureType),x IS SyntaxTree.Operator);
- IF (x.procedureScope.body # NIL) & (x.procedureScope.body.code # NIL) THEN
- code := x.procedureScope.body.code;
- IF code.inlineCode = NIL THEN
- size := 0
- ELSE
- size := code.inlineCode.GetSize() DIV 8;
- END;
- FPNumber(fp,size);
- FOR i := 0 TO size-1 DO
- value := code.inlineCode.GetBits(i*8,8);
- FPNumber(fp,value);
- END;
- END;
- ELSE
- FPNumber(fp, fpModeExportedProcedure);
- Global.GetSymbolName(x,name);
- FPString(fp,name);
- FPVisibility(fp, access);
- FPSignature(fp,x.type(SyntaxTree.ProcedureType),x IS SyntaxTree.Operator);
- END;
- fingerprint.shallow := fp;
- fingerprint.public := fingerprint.shallow;
- fingerprint.private := fingerprint.shallow;
- fingerprint.shallowAvailable := TRUE;
- x.SetFingerprint(fingerprint);
- SELF.deep := deep;
- END;
- END;
- SELF.fingerprint := fingerprint
- END VisitProcedure;
- (* cf. Procedure *)
- PROCEDURE VisitOperator*(x: SyntaxTree.Operator);
- BEGIN
- VisitProcedure(x) (* same finger print as a procedure *)
- END VisitOperator;
- PROCEDURE VisitModule*(x: SyntaxTree.Module);
- VAR fingerprint, symbolFingerprint: SyntaxTree.Fingerprint; deep: BOOLEAN; fp: Basic.Fingerprint; symbol: SyntaxTree.Symbol; scope: SyntaxTree.ModuleScope;
- BEGIN
- fingerprint := x.fingerprint;
- deep := SELF.deep;
- IF Trace THEN TraceEnter("Record"); END;
- IF ~fingerprint.shallowAvailable THEN
- IF Trace THEN TraceIndent; D.Str("Module Enter Shallow "); D.Ln; END;
- SELF.deep := FALSE;
- fp := 0;
- FPNumber(fp, fpTypeModule);
- FPName(fp,x.name);
- IF Trace THEN TraceIndent; D.Str("Module Name ");D.Hex(fp,0); D.Ln; END;
- fingerprint.shallow := fp;
- fingerprint.public := fingerprint.shallow;
- fingerprint.private := fingerprint.shallow;
- fingerprint.shallowAvailable := TRUE;
- x.SetFingerprint(fingerprint);
- SELF.deep := deep;
- IF Trace THEN TraceIndent; D.Str("Module Shallow Done "); TraceFP(fingerprint); D.Ln; END;
- END;
- IF deep & ~fingerprint.deepAvailable THEN
- IF Trace THEN TraceIndent; D.Str("Module Enter Deep "); D.Ln; END;
- fingerprint.private := fingerprint.shallow;
- fingerprint.public := fingerprint.shallow;
- scope := x.moduleScope;
- IF Trace THEN TraceIndent; D.Str("RecordType before methods"); TraceFP(fingerprint); D.Ln; END;
- symbol := scope.firstSymbol;
- WHILE symbol # NIL DO
- IF symbol.access * SyntaxTree.Public # {} THEN
- symbolFingerprint := SymbolFP(symbol);
- FPNumber(fingerprint.private,symbolFingerprint.shallow);
- FPNumber(fingerprint.public,symbolFingerprint.shallow);
- END;
- symbol := symbol.nextSymbol;
- END;
- IF Trace THEN TraceIndent; D.Str("Module Exit Deep "); TraceFP(fingerprint); D.Ln; END;
- (*
- ASSERT(fingerprint.private # 0,100);
- ASSERT(fingerprint.public # 0,101);
- *)
- fingerprint.deepAvailable := TRUE;
- x.SetFingerprint(fingerprint);
- END;
- SELF.fingerprint := fingerprint;
- IF Trace THEN TraceExit("Record",fingerprint); END;
- END VisitModule;
- PROCEDURE VisitSymbol*(x: SyntaxTree.Symbol);
- BEGIN
- fingerprint.shallow := 0;
- fingerprint.public := fingerprint.shallow;
- fingerprint.private := fingerprint.shallow;
- fingerprint.shallowAvailable := TRUE;
- x.SetFingerprint(fingerprint);
- END VisitSymbol;
- PROCEDURE TraceIndent;
- VAR i: LONGINT;
- BEGIN
- FOR i := 1 TO traceLevel DO D.Str(" "); END;
- END TraceIndent;
- PROCEDURE TraceEnter(CONST name: ARRAY OF CHAR);
- BEGIN
- INC(traceLevel); TraceIndent;
- D.Str("Enter ");
- D.Str(name);
- D.Ln;
- END TraceEnter;
- PROCEDURE TraceExit(CONST name: ARRAY OF CHAR; CONST fingerprint: SyntaxTree.Fingerprint);
- BEGIN
- TraceIndent; DEC(traceLevel);
- D.Str("Exit "); D.Str(name); D.Str(" "); TraceFP(fingerprint); D.Ln;
- END TraceExit;
- PROCEDURE TraceFP(CONST fingerprint: SyntaxTree.Fingerprint);
- BEGIN
- D.Hex(fingerprint.shallow,0); D.Str(" "); D.Hex(fingerprint.private,0);
- D.Str(" "); D.Hex(fingerprint.public,0);
- END TraceFP;
- (* returns the finger print (object) of a type *)
- PROCEDURE TypeFP*(this: SyntaxTree.Type): SyntaxTree.Fingerprint;
- VAR deep: BOOLEAN;
- BEGIN
- IF Trace THEN TraceEnter("TypeFP"); END;
- deep := SELF.deep;
- SELF.deep := TRUE;
- VType(this);
- SELF.deep := deep;
- ASSERT(fingerprint.deepAvailable,101);
- ASSERT(fingerprint.shallow #0,102);
- IF Trace THEN TraceExit("TypeFP",fingerprint); D.Ln;
- D.Ln; END;
- RETURN fingerprint
- END TypeFP;
- (* returns the finger print (object) of a symbol *)
- PROCEDURE SymbolFP*(this: SyntaxTree.Symbol): SyntaxTree.Fingerprint;
- VAR deep: BOOLEAN;
- BEGIN
- deep := SELF.deep;
- SELF.deep := TRUE;
- IF Trace THEN TraceEnter("SymbolFP");
- TraceIndent;
- D.Str("name: ");
- D.Str0(this.name); D.Ln;
- END;
- VSymbol(this);
- SELF.deep := deep;
- IF Trace THEN TraceExit("SymbolFP",fingerprint); D.Ln; END;
- RETURN fingerprint
- END SymbolFP;
- END Fingerprinter;
- (** ---------- Fingerprinting primitives -------------- *)
- PROCEDURE IsOberonProcedure(type: SyntaxTree.ProcedureType): BOOLEAN;
- BEGIN
- RETURN type.callingConvention = SyntaxTree.OberonCallingConvention
- END IsOberonProcedure;
- (* fp = fp <*> val *)
- PROCEDURE FPNumber*(VAR fp: Basic.Fingerprint; val: HUGEINT);
- BEGIN
- fp:=SYSTEM.VAL(Basic.Fingerprint, SYSTEM.VAL(SET64, ROT(fp, 7)) / SYSTEM.VAL(SET64, val))
- END FPNumber;
- (* fp = fp <*> set *)
- PROCEDURE FPSet*(VAR fp: Basic.Fingerprint; set: SET64);
- BEGIN FPNumber(fp, SYSTEM.VAL(HUGEINT, set))
- END FPSet;
- (* fp = fp <*> real *)
- PROCEDURE FPReal*(VAR fp: Basic.Fingerprint; real: LONGREAL);
- BEGIN FPNumber(fp, SYSTEM.VAL(HUGEINT, real))
- END FPReal;
- (* fp = fp -> String *)
- PROCEDURE FPName*(VAR fp: Basic.Fingerprint; x: SyntaxTree.Identifier);
- VAR name: Scanner.IdentifierString;
- BEGIN
- Basic.GetString(x,name);
- FPString(fp,name);
- END FPName;
- (* fp = fp {<*> str[i]} *)
- PROCEDURE FPString*(VAR fp: Basic.Fingerprint; CONST str: ARRAY OF CHAR);
- VAR i: INTEGER; ch: CHAR;
- BEGIN i:=0; REPEAT ch:=str[i]; FPNumber(fp, ORD(ch)); INC(i) UNTIL ch=0X
- END FPString;
- (* fp = fp <*> (fpExtern | fpExternR | fpIntern | fpOther + vis) *)
- PROCEDURE FPVisibility*(VAR fp: Basic.Fingerprint; vis: SET);
- BEGIN
- IF SyntaxTree.PublicWrite IN vis THEN FPNumber(fp, fpExtern)
- ELSIF SyntaxTree.PublicRead IN vis THEN FPNumber(fp, fpExternR)
- ELSIF SyntaxTree.Internal * vis #{} THEN FPNumber(fp, fpIntern)
- ELSE
- FPNumber(fp, fpOther + SYSTEM.VAL(WORD, vis))
- END
- END FPVisibility;
- PROCEDURE DumpFingerprint*(w: Streams.Writer; CONST fp: SyntaxTree.Fingerprint);
- BEGIN
- w.String("fingerprint: ");
- w.String("shallow = "); w.Hex(fp.shallow,0);
- w.String(", private = "); w.Hex(fp.private,0);
- w.String(", public = "); w.Hex(fp.public,0);
- w.Ln;
- END DumpFingerprint;
- END FoxFingerprinter.
|