diff --git a/rtl/inc/lineinfo.pp b/rtl/inc/lineinfo.pp index 87754cb538..6fe8b52055 100644 --- a/rtl/inc/lineinfo.pp +++ b/rtl/inc/lineinfo.pp @@ -551,6 +551,136 @@ end; {$endif beos} +{$ifdef netware} +{the nlm format is not documented but we have the sources for + binutils ;-) } +function LoadNlmNetware:boolean; +type str255 = string [255]; +Const NLM_FileBegin = 'NetWare Loadable Module'#$1A; + NLM_InternalFixedHdrSize = 130; + NLM_InternalVersionHdrSize = 32; + NLM_InternalExtHdrSize = 124; +var HdrChk : string[24]; + name : string [30]; + valid : boolean; + dataOffset,align:longint; + + function getByte : byte; + var b : byte; + begin + blockread (f, b, 1); + getByte := b; + end; + + procedure skip (bytes : integer); + begin + seek (f, filepos (f)+bytes); + end; + + procedure skipLString; + begin + skip (getByte+1); + end; + + function getNullString : str255; + var c : char; + s : str255; + begin + s := ''; + c := char (getbyte); + while (c <> #0) do + begin + s := s + c; + c := char (getbyte); + end; + getNullString := s; + end; + + function getFixString (Len : byte) : str255; + var i : byte; + s : string; + begin + s := ''; + for i := 1 to Len do + s := s + char (getbyte); + getFixString := s; + end; + + procedure getLongint (var l : longint); + begin + blockread (f, l, 4); + end; + +begin + LoadNlmNetware:=false; + stabofs:=-1; + stabstrofs:=-1; + processaddress := System.NetwareCodeStartAddress; + setlength(HdrChk,24); + blockread (f,HdrChk[1],24); + if HdrChk <> NLM_FileBegin then exit; + Seek (f, NLM_InternalFixedHdrSize); + + {Read the Variable header} + skipLString; {Description} + skip (4 {Stacksize} + 4{Reserved} +5{oldThreadName}); + + skipLString; {ScreenName} + skipLString; {threadName} + + dataOffset := 0; + + valid := true; + repeat + name := getFixString (8); + if (name = 'VeRsIoN#') then + Skip (NLM_InternalVersionHdrSize-8) + else + if (name = 'CoPyRiGh') then + begin + skip(2); // T= + skipLString; {Copyright} + end else + if (name = 'MeSsAgEs') then + skip (NLM_InternalExtHdrSize - 8) + else + if (name = 'CuStHeAd') then + begin + Skip(4); {hdrLength} + getLongint (dataOffset); + Skip(4+8); {dataLength(4), dataStamp(8) or hdrLength-4 ?} + valid := false; + end else + Valid := false; + until not valid; + + if dataOffset = 0 then exit; + + Seek (F, dataOffset); + Repeat + Name := GetNullString; + align := 4 - ((length (Name) + 1) MOD 4); + Skip (align); + if (Name = '.stab') then + begin + getLongint (stabofs); + getLongint (stabcnt); {stabLength} + stabcnt:=stabcnt div sizeof(tstab); + end else + if (Name = '.stabstr') then + begin + getLongint (stabStrOfs); + Skip (4); {stabStrLength} + if stabofs <> 0 then name := ''; {skip other sections} + end else + Skip (8); + until Name = ''; + LoadNlmNetware := (stabofs<>-1) and (stabstrofs<>-1); +end; +{$endif} + + + {**************************************************************************** Executable Open/Close ****************************************************************************} @@ -611,6 +741,13 @@ begin OpenStabs:=true; exit; end; +{$endif} +{$ifdef netware} + if LoadNlmNetware then + begin + OpenStabs := true; + exit; + end; {$endif} CloseStabs; end; @@ -773,6 +910,7 @@ end; initialization BackTraceStrFunc:=@StabBackTraceStr; + opened := false; finalization if opened then @@ -781,7 +919,11 @@ finalization end. { $Log$ - Revision 1.16 2003-03-17 14:30:11 peter + Revision 1.17 2003-03-17 15:30:06 armin + + netware support + + opened was not initialized + + Revision 1.16 2003/03/17 14:30:11 peter * changed address parameter/return values to pointer instead of longint @@ -808,3 +950,4 @@ end. * more Renamefest } +