diff options
Diffstat (limited to 'compiler/omfbase.pas')
-rw-r--r-- | compiler/omfbase.pas | 200 |
1 files changed, 200 insertions, 0 deletions
diff --git a/compiler/omfbase.pas b/compiler/omfbase.pas index a41766b9c4..df4b8b2339 100644 --- a/compiler/omfbase.pas +++ b/compiler/omfbase.pas @@ -160,6 +160,12 @@ interface CC_DependencyFileBorland = $E9; CC_CommandLineMicrosoft = $FF; + { CC_OmfExtension subtypes } + CC_OmfExtension_IMPDEF = $01; + CC_OmfExtension_EXPDEF = $02; + CC_OmfExtension_INCDEF = $03; + CC_OmfExtension_LNKDIR = $05; + type TOmfSegmentAlignment = ( saAbsolute = 0, @@ -324,6 +330,58 @@ interface property NoList: Boolean read GetNoList write SetNoList; end; + { TOmfRecord_COMENT_Subtype } + + TOmfRecord_COMENT_Subtype = class + public + procedure DecodeFrom(ComentRecord: TOmfRecord_COMENT);virtual;abstract; + procedure EncodeTo(ComentRecord: TOmfRecord_COMENT);virtual;abstract; + end; + + { TOmfRecord_COMENT_IMPDEF } + + TOmfRecord_COMENT_IMPDEF = class(TOmfRecord_COMENT_Subtype) + private + FImportByOrdinal: Boolean; + FInternalName: string; + FModuleName: string; + FOrdinal: Word; + FName: string; + public + procedure DecodeFrom(ComentRecord: TOmfRecord_COMENT);override; + procedure EncodeTo(ComentRecord: TOmfRecord_COMENT);override; + + property ImportByOrdinal: Boolean read FImportByOrdinal write FImportByOrdinal; + property InternalName: string read FInternalName write FInternalName; + property ModuleName: string read FModuleName write FModuleName; + property Ordinal: Word read FOrdinal write FOrdinal; + property Name: string read FName write FName; + end; + + { TOmfRecord_COMENT_EXPDEF } + + TOmfRecord_COMENT_EXPDEF = class(TOmfRecord_COMENT_Subtype) + private + FExportByOrdinal: Boolean; + FResidentName: Boolean; + FNoData: Boolean; + FParmCount: Integer; + FExportedName: string; + FInternalName: string; + FExportOrdinal: Word; + public + procedure DecodeFrom(ComentRecord: TOmfRecord_COMENT);override; + procedure EncodeTo(ComentRecord: TOmfRecord_COMENT);override; + + property ExportByOrdinal: Boolean read FExportByOrdinal write FExportByOrdinal; + property ResidentName: Boolean read FResidentName write FResidentName; + property NoData: Boolean read FNoData write FNoData; + property ParmCount: Integer read FParmCount write FParmCount; + property ExportedName: string read FExportedName write FExportedName; + property InternalName: string read FInternalName write FInternalName; + property ExportOrdinal: Word read FExportOrdinal write FExportOrdinal; + end; + { TOmfRecord_LNAMES } TOmfRecord_LNAMES = class(TOmfParsedRecord) @@ -1542,6 +1600,148 @@ implementation RawRecord.CalculateChecksumByte; end; + { TOmfRecord_COMENT_IMPDEF } + + procedure TOmfRecord_COMENT_IMPDEF.DecodeFrom(ComentRecord: TOmfRecord_COMENT); + var + InternalNameLen, ModuleNameLenIdx, ModuleNameLen, NameLenIdx, + NameLen, OrdinalIdx: Integer; + begin + if ComentRecord.CommentClass<>CC_OmfExtension then + internalerror(2019061621); + if Length(ComentRecord.CommentString)<5 then + internalerror(2019061622); + if ComentRecord.CommentString[1]<>Chr(CC_OmfExtension_IMPDEF) then + internalerror(2019061623); + ImportByOrdinal:=Ord(ComentRecord.CommentString[2])<>0; + InternalNameLen:=Ord(ComentRecord.CommentString[3]); + InternalName:=Copy(ComentRecord.CommentString,4,InternalNameLen); + ModuleNameLenIdx:=4+InternalNameLen; + if ModuleNameLenIdx>Length(ComentRecord.CommentString) then + internalerror(2019061624); + ModuleNameLen:=Ord(ComentRecord.CommentString[ModuleNameLenIdx]); + ModuleName:=Copy(ComentRecord.CommentString,ModuleNameLenIdx+1,ModuleNameLen); + if ImportByOrdinal then + begin + Name:=''; + OrdinalIdx:=ModuleNameLenIdx+1+ModuleNameLen; + if (OrdinalIdx+1)>Length(ComentRecord.CommentString) then + internalerror(2019061625); + Ordinal:=Ord(ComentRecord.CommentString[OrdinalIdx]) or + (Word(Ord(ComentRecord.CommentString[OrdinalIdx+1])) shl 8); + end + else + begin + Ordinal:=0; + NameLenIdx:=ModuleNameLenIdx+1+ModuleNameLen; + if NameLenIdx>Length(ComentRecord.CommentString) then + internalerror(2019061626); + NameLen:=Ord(ComentRecord.CommentString[NameLenIdx]); + if (NameLenIdx+NameLen)>Length(ComentRecord.CommentString) then + internalerror(2019061627); + Name:=Copy(ComentRecord.CommentString,NameLenIdx+1,NameLen); + if Name='' then + Name:=InternalName; + end; + end; + + procedure TOmfRecord_COMENT_IMPDEF.EncodeTo(ComentRecord: TOmfRecord_COMENT); + begin + ComentRecord.CommentClass:=CC_OmfExtension; + if ImportByOrdinal then + ComentRecord.CommentString:=Chr(CC_OmfExtension_IMPDEF)+#1+ + Chr(Length(InternalName))+InternalName+ + Chr(Length(ModuleName))+ModuleName+ + Chr(Ordinal and $ff)+Chr((Ordinal shr 8) and $ff) + else if InternalName=Name then + ComentRecord.CommentString:=Chr(CC_OmfExtension_IMPDEF)+#0+ + Chr(Length(InternalName))+InternalName+ + Chr(Length(ModuleName))+ModuleName+#0 + else + ComentRecord.CommentString:=Chr(CC_OmfExtension_IMPDEF)+#0+ + Chr(Length(InternalName))+InternalName+ + Chr(Length(ModuleName))+ModuleName+ + Chr(Length(Name))+Name; + end; + + { TOmfRecord_COMENT_EXPDEF } + + procedure TOmfRecord_COMENT_EXPDEF.DecodeFrom(ComentRecord: TOmfRecord_COMENT); + var + expflag: Byte; + ExportedNameLen, InternalNameLenIdx, InternalNameLen, + ExportOrdinalIdx: Integer; + begin + if ComentRecord.CommentClass<>CC_OmfExtension then + internalerror(2019061601); + if Length(ComentRecord.CommentString)<4 then + internalerror(2019061602); + if ComentRecord.CommentString[1]<>Chr(CC_OmfExtension_EXPDEF) then + internalerror(2019061603); + expflag:=Ord(ComentRecord.CommentString[2]); + ExportByOrdinal:=(expflag and $80)<>0; + ResidentName:=(expflag and $40)<>0; + NoData:=(expflag and $20)<>0; + ParmCount:=expflag and $1F; + ExportedNameLen:=Ord(ComentRecord.CommentString[3]); + ExportedName:=Copy(ComentRecord.CommentString,4,ExportedNameLen); + InternalNameLenIdx:=4+ExportedNameLen; + if InternalNameLenIdx>Length(ComentRecord.CommentString) then + internalerror(2019061604); + InternalNameLen:=Ord(ComentRecord.CommentString[InternalNameLenIdx]); + if (InternalNameLenIdx+InternalNameLen)>Length(ComentRecord.CommentString) then + internalerror(2019061605); + InternalName:=Copy(ComentRecord.CommentString,InternalNameLenIdx+1,InternalNameLen); + if ExportByOrdinal then + begin + ExportOrdinalIdx:=InternalNameLenIdx+1+InternalNameLen; + if (ExportOrdinalIdx+1)>Length(ComentRecord.CommentString) then + internalerror(2019061606); + ExportOrdinal:=Ord(ComentRecord.CommentString[ExportOrdinalIdx]) or + (Word(Ord(ComentRecord.CommentString[ExportOrdinalIdx+1])) shl 8); + end + else + ExportOrdinal:=0; + if InternalName='' then + InternalName:=ExportedName; + end; + + procedure TOmfRecord_COMENT_EXPDEF.EncodeTo(ComentRecord: TOmfRecord_COMENT); + var + expflag: Byte; + begin + ComentRecord.CommentClass:=CC_OmfExtension; + + if (ParmCount<0) or (ParmCount>31) then + internalerror(2019061504); + expflag:=ParmCount; + if ExportByOrdinal then + expflag:=expflag or $80; + if ResidentName then + expflag:=expflag or $40; + if NoData then + expflag:=expflag or $20; + + if ExportByOrdinal then + if InternalName=ExportedName then + ComentRecord.CommentString:=Chr(CC_OmfExtension_EXPDEF)+Chr(expflag)+ + Chr(Length(ExportedName))+ExportedName+#0+ + Chr(Byte(ExportOrdinal))+Chr(Byte(ExportOrdinal shr 8)) + else + ComentRecord.CommentString:=Chr(CC_OmfExtension_EXPDEF)+Chr(expflag)+ + Chr(Length(ExportedName))+ExportedName+ + Chr(Length(InternalName))+InternalName+ + Chr(Byte(ExportOrdinal))+Chr(Byte(ExportOrdinal shr 8)) + else + if InternalName=ExportedName then + ComentRecord.CommentString:=Chr(CC_OmfExtension_EXPDEF)+Chr(expflag)+ + Chr(Length(ExportedName))+ExportedName+#0 + else + ComentRecord.CommentString:=Chr(CC_OmfExtension_EXPDEF)+Chr(expflag)+ + Chr(Length(ExportedName))+ExportedName+ + Chr(Length(InternalName))+InternalName; + end; + { TOmfRecord_LNAMES } constructor TOmfRecord_LNAMES.Create; |