* Initial versions

utils/dxegen/Makefile.fpc

@@ -0,0 +1,28 @@
+#
+#   Makefile.fpc for Free Pascal Utils
+#
+
+[package]
+name=dxegen
+version=1.05
+
+[target]
+dirs=fpcm tply h2pas fprcp
+programs_go32v2=dxegen
+
+[clean]
+units=coff
+
+[install]
+fpcpackage=y
+
+[default]
+fpcdir=../..
+
+[rules]
+
+dxegen$(EXEEXT): dxegen.pp coff$(PPUEXT)
+
+coff$(PPUEXT)  : coff.pp
+
+

utils/dxegen/coff.pp

@@ -0,0 +1,375 @@
+{ Copyright (C) 1995 DJ Delorie, see COPYING.DJ for details
+
+ ( MvdV: GPL/LGPL, I can't exactly make out from that file what this is, and
+   it doesn't matter for me, since FPC is also GPL/LGPL)
+
+   FPC Pascal conversion by Marco van de Voort (C) 2001.
+}
+
+Unit coff;
+
+
+interface
+
+{$packrecords C}
+
+type cushort =word;
+     culong  =cardinal;
+     cshort  =integer;
+     cuchar  =byte;
+
+{** coff information for Intel 386/486.  }
+
+{********************* FILE HEADER *********************}
+
+TYPE External_FileHDR  = Record
+			f_magic  : cushort;  { magic number			}
+			f_nscns  : cushort;  { number of sections		}
+			f_timdat : culong;  { time & date stamp		}
+			f_symptr : culong;  { file pointer to symtab	}
+			f_nsyms  : culong;  { number of symtab entries	}
+			f_opthdr : cushort;  { sizeof(optional hdr)		}
+	             	f_flags  : cushort;  { flags			}
+			end;
+
+
+{ Bits for f_flags:
+ *	F_RELFLG	relocation info stripped from file
+ *	F_EXEC		file is executable (no unresolved external references)
+ *	F_LNNO		line numbers stripped from file
+ *	F_LSYMS		local symbols stripped from file
+ *	F_AR32WR	file has byte ordering of an AR32WR machine (e.g. vax)
+ }
+
+	FILHDR	 = external_filehdr;
+
+
+Const
+        F_RELFLG	=00001;
+        F_EXEC		=00002;
+        F_LNNO		=00004;
+        F_LSYMS		=00008;
+
+
+	I386MAGIC	=$14c;
+        I386AIXMAGIC	=$175;
+//        I386BADMAG(x) (((x).f_magic!=I386MAGIC) && (x).f_magic!=I386AIXMAGIC)
+
+
+	FILHSZ	= sizeof(FILHDR);
+
+
+{********************* AOUT "OPTIONAL HEADER" *********************}
+
+
+TYPE AOUTHDR = Record
+
+   	        magic      : cushort;		{ type of file				}
+ 	        vstamp     : cushort;		{ version stamp			}
+  	        tsize	   : culong;		{ text size in bytes, padded to FW bdry}
+ 	        dsize	   : culong;		{ initialized data "  "		}
+ 	        bsize	   : culong;		{ uninitialized data "   "		}
+  	        entry	   : culong;		{ entry pt.				}
+  	        text_start : culong;	{ base of text used for this file }
+	        data_start : culong;	{ base of data used for this file }
+               end;
+
+   gnu_aout = Record
+	        info,
+	        tsize,
+	        dsize,
+	        bsize,
+	        symsize,
+	        entry,
+	        txrel,
+	        dtrel     : culong;
+	end;
+
+const
+    AOUTSZ =sizeof(AOUTHDR);
+
+	OMAGIC          =0404;    { object files, eg as output }
+	ZMAGIC          =0413;    { demand load format, eg normal ld output }
+	STMAGIC		=0401;	{ target shlib }
+	SHMAGIC		=0443;	{ host   shlib }
+
+
+{********************* SECTION HEADER *********************}
+
+
+type  external_scnhdr = Record
+			s_name    : array[0..7] OF CHAR;	{ section name			}
+			s_paddr,	        { physical address, aliased s_nlib }
+			s_vaddr,	        { virtual address		}
+			s_size,		        { section size			}
+			s_scnptr,	        { file ptr to raw data for section }
+			s_relptr,	        { file ptr to relocation	}
+			s_lnnoptr : culong;	{ file ptr to line numbers	}
+			s_nreloc,	        { number of relocation entries	}
+			s_nlnno   : cushort;	{ number of line number entries}
+			s_flags   : culong;	{ flags			}
+				end;
+	SCNHDR = external_scnhdr;
+
+const SCNHSZ=sizeof(SCNHDR);
+
+
+{
+ * names of "special" sections
+ }
+
+CONST
+	special_TEXT	='.text';
+	special_DATA	='.data';
+	special_BSS	='.bss';
+	special_COMMENT ='.comment';
+	special_LIB 	='.lib';
+
+{
+ * s_flags "type"
+ }
+	STYP_TEXT	 =$20;	{ section contains text only }
+	STYP_DATA	 =$40;	{ section contains data only }
+	STYP_BSS	 =$80; 	{ section contains bss only }
+
+{********************* LINE NUMBERS *********************}
+
+{ 1 line number entry for every "breakpointable" source line in a section.
+ * Line numbers are grouped on a per function basis; first entry in a function
+ * grouping will have l_lnno = 0 and in place of physical address will be the
+ * symbol table index of the function name.
+ }
+
+type aux_lineno = Packed Record
+		 case boolean of
+		   false:( l_symndx:culong); { function name symbol index, iff l_lnno == 0 }
+		   true:(  l_paddr :culong); { (physical) address of line number }
+		end;
+
+     external_lineno  = packed record 			{should be 6 bytes, check!}
+		 l_addr : aux_lineno;
+		 l_lnno : cushort;		{ line number }
+		 end;
+
+     lineno=external_lineno;
+
+
+const	LINESZ	=sizeof(LINENO);
+
+
+{********************* SYMBOLS *********************}
+
+	E_SYMNMLEN	=8;	{ # characters in a symbol name	}
+	E_FILNMLEN	=14;	{ # characters in a file name		}
+	E_DIMNUM	=4;	{ # array dimensions in auxiliary entry }
+
+
+
+type aux_aux_external_syment = packed record
+				 e_zeroes : culong;
+				 e_offset : culong;
+				end;
+     aux_external_syment = packed record
+			     case boolean of
+				false: (e_name : array[0..E_SYMNMLEN-1] OF Char);
+			   	true : (e:aux_aux_external_syment);
+			     end;
+
+     external_syment 	 = packed record		{packed, check if necessary!}
+			     e          : aux_external_syment;
+			     e_value    : culong;
+			     e_scnum    : cshort;
+			     e_type     : cushort;
+			     e_sclass   : cuchar;
+			     e_numaux   : cuchar;
+			    end;
+
+
+CONST
+	N_BTMASK	=$F;
+	N_TMASK		=$30;
+	N_BTSHFT	=$4;
+	N_TSHIFT	=$2;
+
+
+type tx_lnsz 	    = packed record
+			   	 x_lnno,
+				 x_size   :  cushort;
+				end;
+
+     tx_misc	    = packed record
+				case boolean of
+				 false    : (x_lnsz  : tx_lnsz);
+				 true     : (x_fsize : culong);
+				end;
+
+     tx_fcn	    = packed record
+				 x_lnnoptr,
+				 x_endndx   : culong;
+				end;
+
+     tx_ary	    = packed record
+				 x_dimen  : array[0..E_DIMNUM-1] OF cushort;
+				end;
+
+     tx_fcnary	    = packed record
+				case boolean of
+				 false : ( x_fcn : tx_fcn);
+				 true  : ( x_ary : tx_ary);
+				end;
+
+
+
+     tx_sym	    = packed record
+			       x_tagndx  : culong;
+			       x_misc    : tx_misc;
+			       x_fcnary  : tx_fcnary;
+			       x_tvndx   : cushort;
+			      end;
+
+     tx_n	    = packed record
+				x_zeroes,
+				x_offset : culong;
+				end;
+     tx_file	    = packed record
+			      case boolean of
+			     	false: ( x_fname : array [0..E_FILNMLEN-1] of char);
+			       	true : (x_n : tx_n);
+			       end;
+     tx_scn	    = packed record
+			       x_scnlen : culong;
+			       x_nreloc,
+			       x_nlinno : cushort;
+			      end;
+     tx_tv	    = packed record
+			       x_tvfill  : culong;
+			       x_tvlen   : cushort;
+			       x_tvran   : array[0..1] of cushort;
+			      end;
+
+     external_auxent = packed record
+			  case byte of
+			   0: (x_sym : tx_sym);
+			   1: (x_file: tx_file);
+			   2: (x_scn : tx_scn);
+			   3: (x_tv  : tx_tv);
+			  end;
+   SYMENT= external_syment;
+   AUXENT= external_auxent;
+
+const
+   SYMESZ = SIZEOF(SYMENT);
+   AUXESZ = SIZEOF(AUXENT);
+
+{	define _ETEXT	"etext"}
+
+{ Relocatable symbols have number of the section in which they are defined,
+   or one of the following: }
+
+        N_UNDEF	        = 0;	{ undefined symbol }
+        N_ABS		=-1;	{ value of symbol is absolute }
+        N_DEBUG		=-2;	{ debugging symbol -- value is meaningless }
+        N_TV		=-3;	{ indicates symbol needs preload transfer vector }
+        P_TV		=-4;	{ indicates symbol needs postload transfer vector}
+
+{
+ * Type of a symbol, in low N bits of the word
+ }
+        T_NULL		=0;
+        T_VOID		=1;	{ function argument (only used by compiler) }
+        T_CHAR		=2;	{ character		}
+        T_SHORT		=3;	{ short integer	}
+        T_INT		=4;	{ integer		}
+        T_LONG		=5;	{ long integer		}
+        T_FLOAT		=6;	{ floating point	}
+        T_DOUBLE	=7;	{ double word		}
+        T_STRUCT	=8;	{ structure 		}
+        T_UNION		=9;	{ union 		}
+        T_ENUM		=10;	{ enumeration 		}
+        T_MOE		=11;	{ member of enumeration}
+        T_UCHAR		=12;	{ unsigned character	}
+        T_USHORT	=13;	{ unsigned short	}
+        T_UINT		=14;	{ unsigned integer	}
+        T_ULONG		=15;	{ unsigned long	}
+        T_LNGDBL	=16;	{ long double		}
+
+{
+ * derived types, in n_type
+}
+        DT_NON		=0;	{ no derived type }
+        DT_PTR		=1;	{ pointer }
+        DT_FCN		=2;	{ function }
+        DT_ARY		=3;	{ array }
+
+{
+\\        BTYPE(x)	((x) & N_BTMASK)
+
+\\        ISPTR(x)	(((x) & N_TMASK) == (DT_PTR << N_BTSHFT))
+\\        ISFCN(x)	(((x) & N_TMASK) == (DT_FCN << N_BTSHFT))
+\\        ISARY(x)	(((x) & N_TMASK) == (DT_ARY << N_BTSHFT))
+\\        ISTAG(x)	((x)==C_STRTAG||(x)==C_UNTAG||(x)==C_ENTAG)
+\\        DECREF(x) ((((x)>>N_TSHIFT)&~N_BTMASK)|((x)&N_BTMASK))
+}
+{********************* STORAGE CLASSES *********************}
+
+{ This used to be defined as -1, but now n_sclass is unsigned.  }
+        C_EFCN		=$ff;	{ physical end of function	}
+        C_NULL		=0;
+        C_AUTO		=1;	{ automatic variable		}
+        C_EXT		=2;	{ external symbol		}
+        C_STAT		=3;	{ static			}
+        C_REG		=4;	{ register variable		}
+        C_EXTDEF	=5;	{ external definition		}
+        C_LABEL		=6;	{ label			}
+        C_ULABEL	=7;	{ undefined label		}
+        C_MOS		=8;	{ member of structure		}
+        C_ARG		=9;	{ function argument		}
+        C_STRTAG	=10;	{ structure tag		}
+        C_MOU		=11;	{ member of union		}
+        C_UNTAG		=12;	{ union tag			}
+        C_TPDEF		=13;	{ type definition		}
+        C_USTATIC	=14;	{ undefined static		}
+        C_ENTAG		=15;	{ enumeration tag		}
+        C_MOE		=16;	{ member of enumeration	}
+        C_REGPARM	=17;	{ register parameter		}
+        C_FIELD		=18;	{ bit field			}
+        C_AUTOARG	=19;	{ auto argument		}
+        C_LASTENT	=20;	{ dummy entry (end of block)	}
+        C_BLOCK		=100;	{ ".bb" or ".eb"		}
+        C_FCN		=101;	{ ".bf" or ".ef"		}
+        C_EOS		=102;	{ end of structure		}
+        C_FILE		=103;	{ file name			}
+        C_LINE		=104;	{ line # reformatted as symbol table entry }
+        C_ALIAS	 	=105;	{ duplicate tag		}
+        C_HIDDEN	=106;	{ ext symbol in dmert public lib }
+
+{********************* RELOCATION DIRECTIVES *********************}
+
+
+type external_reloc = packed record
+			 r_vaddr,
+			 r_symndx : culong;
+			 r_type   : cushort;
+			end;
+
+
+
+        RELOC = external_reloc;
+	PRELOC= ^RELOC;			{not in original header}
+const
+        RELSZ =sizeof(RELOC);
+
+        RELOC_REL32	=20;	{ 32-bit PC-relative address }
+        RELOC_ADDR32	=6;	{ 32-bit absolute address }
+
+        DEFAULT_DATA_SECTION_ALIGNMENT =4;
+        DEFAULT_BSS_SECTION_ALIGNMENT =4;
+        DEFAULT_TEXT_SECTION_ALIGNMENT =4;
+
+{ For new sections we havn't heard of before }
+
+        DEFAULT_SECTION_ALIGNMENT =4;
+
+Implementation
+
+end.

utils/dxegen/dxegen.pp

@@ -0,0 +1,320 @@
+{
+   $Id$
+   Copyright (C) 1995 Charles Sandmann ([email protected])
+   This software may be freely distributed with above copyright, no warranty.
+   Based on code by DJ Delorie, it's really his, enhanced, bugs fixed.
+
+   DXEGEN converts COFF object files to .DXE files that can be loaded and
+   relocated runtime. See (1.0.6+) manual for more details.
+
+   Pascal translation, improvements, enhancements
+                   (C) 2001 by Marco van de Voort (Free Pascal member).
+
+}
+
+Uses Strings,DxeLoad,Coff,Dos;
+
+{$ifdef Linux}              {Fix for 1.0.x}
+ {$Define Unix}
+{$endif}
+
+Const
+{$ifdef Unix}
+  DirSep  = '/';
+{$else}
+  DirSep  = '\';
+{$endif}
+  Tempname= 'dxe__tmp.o';
+
+{ This next function is needed for cross-compiling when the machine
+   isn't little-endian like the i386 }
+
+Type csize_t = cardinal;
+
+Procedure dosswap(vdata:pointer;Const pattern:String);
+
+{ interpretive way of changing structures to bigendian.
+ Pattern contains the structures. l (32-bit) and s (16-bit) will be swapped,
+ a char between 1 and 9 skips that much bytes)
+
+Excellent candidate to be converted to something generic that inlines and
+isn't interpretive. Until generics, this is the only reusable way.
+
+}
+
+{$ifdef BigEndian}
+Var data : pbyte;
+    c    : byte;
+    i,j  : longint;
+{$endif}
+
+Begin
+
+ {$ifdef BigEndian}
+  I := 1;
+  j := length(pattern);
+  data := pbyte(vdata);
+  while I< = j Do
+             Begin
+               Case Pattern[i] Of
+                 '1'..'9' : inc(data,ord(pattern[i])-ord('0'));
+                 's'      :
+                            Begin
+                              c := data[1];
+                              data[1] := data[0];
+                              data[0] := c;
+                              inc(data,2);
+                            End;
+                 'l'      :
+                            Begin
+                              c := data[3];
+                              data[3] := data[0];
+                              data[0] := c;
+                              c := data[1];
+                              data[1] := data[2];
+                              data[2] := c;
+                              inc(data,4);
+                              // bswap (Data) ?
+                            End
+                            Else
+                              inc(data);
+               End;
+               inc(i);
+             End;
+ {$endif}
+End;
+
+Var blaat : pointer;
+
+Procedure exit_cleanup;
+
+Var f: file;
+
+Begin
+  assign(f,tempname);
+  {$I-}
+  erase(f);
+  {$I+}
+  exitproc := blaat;
+End;
+
+Var
+  Errors        : Longint;
+  Bss_start     : Cardinal;  {type "unsigned" ?}
+  fh            : FILHDR;
+  Input_f,
+  Output_F      : file;
+  Sc            : SCNHDR;
+  Data,
+  Strngs        : PChar; {strings is not reserved, but not wise to use in C translations}
+  Sym           : ^SYMENT;
+  Relocs        : pRELOC;
+  Strsz         : Longint;
+  I             : csize_t;
+  Dh            : dxe_header;
+  Command,
+  Param,
+  Libdir        : ansistring;
+  Name          : pchar;
+  Tmp           : array[0..8] Of char;
+  Written       : Word;
+
+Function fixrelocs(i:longint): preloc; inline;
+
+Begin
+  fixrelocs := preloc(longint(relocs)+i*SIZEOF(reloc));
+End;
+
+Begin
+  Errors   := 0;
+  Bss_start := 0;
+
+  If paramcount<3 Then
+    Begin
+      Writeln('Usage: dxegen output.dxe symbol input.o [input2.o ... -lgcc -lc]');
+      Halt(1);
+    End;
+  Assign (input_f,paramstr(3));
+  Filemode := 0;
+  {$I-}
+  Reset(input_f,1);
+  {$I+}
+  If IOResult<>0 Then
+    Begin
+      Writeln('File: ',ParamStr(3),' couldn''t be opened');
+      halt(1);
+    End;
+
+  {Read the COFF .O fileheader}
+
+  Blockread(input_f,fh,FILHSZ);
+
+  dosswap(@fh,'sslllss');
+  If (fh.f_nscns <>1) And (paramcount>3) Then
+    Begin
+      Close(input_f);
+{$ifdef DXE_LD}
+      command := DXE_LD;
+{$else}
+      command := 'ld';
+{$endif}
+      param := '-X -S -r -o '+tempname+' -L';
+      libdir := getenv('DXE_LD_LIBRARY_PATH');
+      If libdir<>'' Then
+        param := param+libdir
+      Else
+        Begin
+          libdir := getenv('DJDIR'); {FPCDIR ?}
+          If libdir='' Then
+            Begin
+              Writeln('Error: neither DXE_LD_LIBRARY_PATH nor DJDIR are set in environment');
+              Halt(1);
+            End;
+          param := param+libdir+dirsep+'lib';
+        End;
+
+      For i:= 3 To ParamCount Do
+        param := param+' '+paramstr(i);
+
+      param := param+' -T dxe.ld ';
+      Writeln('Executing: "',Command,' ',param,'"');
+      Exec(Command,Param);
+      Errors := DosExitCode;
+      If Errors<>0 Then
+        Begin
+          Writeln('Dos returned errorcode: ',Errors);
+          Halt(Errors);
+        End;
+
+      Assign(input_f,tempname);
+      FileMode := 0;
+    {$I-}
+      Reset(Input_f,1);
+    {$I+}
+      If IOresult<>0 Then
+        Begin
+          Close(input_f);
+          Writeln('couldn''t open file: '+tempname);
+          halt(1);
+        End
+      Else
+        Begin
+          blaat := exitproc;
+          exitproc := @exit_cleanup;
+        End;
+
+      blockread(input_f,fh,FILHSZ);
+      dosswap(@fh, 'sslllss');
+      If (fh.f_nscns <>1) Then
+        Begin
+          Close(input_f);
+          Writeln('Error: input file has more than one section; use -M for map');
+          halt(1);
+        End;
+    End;
+
+  seek(input_f,FilePos(Input_f)+fh.f_opthdr);
+  BlockRead(input_f,sc,SCNHSZ);
+  dosswap(@sc, '8llllllssl');
+  dh.magic         := DXE_MAGIC;
+  dh.symbol_offset := -1;
+  dh.element_size  := sc.s_size;
+  dh.nrelocs       := sc.s_nreloc;
+  Getmem(Data,sc.s_size);
+  Seek(input_f,sc.s_scnptr);
+  BlockRead(input_f,data^, sc.s_size);
+  Getmem(sym,sizeof(SYMENT)*fh.f_nsyms);
+  Seek(input_f,fh.f_symptr);
+  Blockread(input_f,sym^,fh.f_nsyms*SYMESZ);
+  Blockread(input_f,strsz,4);
+  Dosswap(@strsz,'l');
+  Getmem(Strngs,strsz);
+  Blockread(input_f,strngs[4],strsz-4);
+
+  plongint(strsz)[0] := 0;  // {?}
+  For i:=0 To fh.f_nsyms-1 Do
+    Begin
+      If (sym[i].e.e.e_zeroes<>0) Then
+        Begin
+          dosswap(@sym[i], '8lscc');
+          move(sym[i].e.e_name,tmp,8);
+          tmp[8] := #0;
+          name := @tmp;
+        End
+      Else
+        Begin
+          dosswap(@sym[i], 'lllscc');
+          name := strngs + sym[i].e.e.e_offset;
+        End;
+
+      If (sym[i].e_scnum = 0) Then
+        Begin
+          Writeln('Error: object contains unresolved external symbols (', name,')');
+          inc(errors);
+        End;
+      If (strlcomp(name, argv[2], strlen(argv[2])) = 0) Then
+        Begin
+          If (dh.symbol_offset <> -1) Then
+            Begin
+              Writeln('Error: multiple symbols that start with ',paramstr(2),' (',name,
+              ')!');
+              Inc(errors);
+            End;
+          dh.symbol_offset := sym[i].e_value;
+        End
+      Else If (strcomp(name, '.bss') = 0) And  (bss_start=0) Then
+             Begin
+               bss_start := sym[i].e_value;
+               Fillchar(data[bss_start], sc.s_size - bss_start,#0);
+             End;
+      Inc(i,sym[i].e_numaux);
+    End;
+
+  If (dh.symbol_offset = -1) Then
+    Begin
+      Writeln('Error: symbol ',argv[2],' not found!');
+      Inc(Errors);
+    End;
+
+  Getmem(Relocs,sizeof(RELOC)*sc.s_nreloc);
+  seek(input_f, sc.s_relptr);
+  Blockread (input_f,relocs^,sc.s_nreloc*RELSZ);;
+
+  Close(input_f);
+  If errors>0 Then
+    Begin
+      Writeln(' Errors: ',Errors);
+      Halt(Errors);
+    End;
+
+  Assign(Output_F,argv[1]);
+ {$I-}
+  Rewrite(output_f,1);
+ {$I+}
+  If Ioresult<>0 Then
+    Begin
+      Writeln('can''t write file ',argv[1]);
+      Halt(1);
+    End;
+  If sc.s_nreloc<>0 Then
+    For I:=0 To sc.s_nreloc-1 Do
+      Begin
+        If (fixrelocs(i)^.r_type And 255)=$14 Then
+          Dec(dh.nrelocs); { Don't do these, they are relative }
+      End;
+  Dosswap(@dh,'llll');
+  Dosswap(@dh, 'llll');
+  BlockWrite(output_f,dh,sizeof(dh));
+  Blockwrite(output_f,data^,sc.s_size,I);
+  If sc.s_nreloc<>0 Then
+    For I:=0 To sc.s_nreloc-1 Do
+      Begin
+        If (fixrelocs(i)^.r_type And 255)<>$14 Then
+          blockwrite(output_f,fixrelocs(i)^.r_vaddr , 4,written);
+      End;
+  Close(output_f);
+End.
+{
+ $Log:
+
+}