+ moved compiler utils

compiler/readme → compiler/README

@@ -40,4 +40,7 @@ Changes in the syntax or semantic of FPC:
   27/04/99   New unit format PPU016, you need to recompile all older units
   01/05/99   Internal assembler. Assembler readers now support MMX,KNI
              instructions.
-	     
+  12/05/99   rtl/utils/ directory moved to utils/. Moved the utils only needed
+             for compiler development to compiler/utils/
+	     
+ 

compiler/cws.txt

@@ -1 +0,0 @@
-All stuff of this document is moved to docs\internal.tex.

compiler/utils/README

@@ -0,0 +1,11 @@
+This dirctory contains some utilities that are used during the
+development of the Free Pascal Compiler.
+
+msg2inc  : Convert a compiler message file (errorX.msg) to .inc files to
+           include it as the default language in the compiler. It can
+	   also convert the .msg to .tex for inclusion the documentation
+	  
+nasmconv : Convert a Nasm insns.dat to i386tab.inc so it can be used with
+           the compiler
+
+makecfg  : This script will make the samplecfg for linux installations

compiler/utils/makecfg

@@ -0,0 +1,218 @@
+#!/bin/sh
+#
+#   $Id$
+#   This file is part of the Free Pascal run time library.
+#   Copyright (c) 1996-98 by Michael van Canneyt and Peter Vreman
+#
+#   Generate a configuration creationfile which will create /etc/ppc386.cfg
+#
+#   Need 1 Arguments:
+#    $1 = filename to create
+#
+if [ $# != 1 ]; then
+  echo 'Usage :'
+  echo 'makecfg filename'
+  echo 'filename   = filename to create'
+  exit 1
+fi
+cat <<EOFCREATE >$1
+#!/bin/sh
+#
+#  Generate Free Pascal configuration file
+#
+if [ \$# != 2 ]; then
+  echo 'Usage :'
+  echo 'samplecfg basepath libgccpath'
+  echo 'basepath   = Path where FPC is installed'
+  echo 'libgccpath = Path to the GCC lib'
+  exit 1
+fi
+if [ -f /etc/ppc386.cfg ] ; then
+  mv /etc/ppc386.cfg /etc/ppc386.orig  >/dev/null 2>&1
+  if [ \$? == 0 ]; then
+    echo Saved old config to /etc/ppc386.orig
+  else
+    echo Could not save old config. Bailing out...
+  fi
+fi
+echo Writing sample configuration file to /etc/ppc386.cfg
+cat <<EOFCFG > /etc/ppc386.cfg
+#
+# Example ppc386.cfg for Free Pascal Compiler Version 0.99.11
+#
+
+# ----------------------
+# Defines (preprocessor)
+# ----------------------
+
+#
+# nested #IFNDEF, #IFDEF, #ENDIF, #ELSE, #DEFINE, #UNDEF are allowed
+#
+# -d is the same as #DEFINE
+# -u is the same as #UNDEF
+#
+
+# When not m68k is defined at the commandline, define i386
+#IFNDEF m68k
+  #DEFINE i386
+#ENDIF
+
+#
+# Some examples (for switches see below, and the -? helppages)
+#
+# Try compiling with the -dRELEASE or -dDEBUG on the commandline
+#
+
+# For a release compile with optimizes and strip debuginfo
+#IFDEF RELEASE
+  -OG2p2
+  -Xs
+  #WRITE Compiling Release Version
+#ENDIF
+
+# For a debug version compile with debuginfo and all codegeneration checks on
+#IFDEF DEBUG
+  -g
+  -Crtoi
+  #WRITE Compiling Debug Version
+#ENDIF
+
+# ----------------
+# Parsing switches
+# ----------------
+
+# All assembler blocks are intel styled by default
+#-Rintel
+
+# All assembler blocks are AT&T styled by default
+#-Ratt
+
+# Semantic checking
+# -S2   switch some Delphi 2 extension on
+# -Sc   supports operators like C (*=,+=,/= and -=)
+# -Sg   allows LABEL and GOTO
+# -Si   support C++ stlyed INLINE
+# -Sm   support macros like C (global)
+# -So   tries to be TP/BP 7.0 compatible
+# -Ss   constructor name must be init (destructor must be done)
+# -St   allows static keyword in objects
+
+# Allow goto, inline, C-operators, C-vars
+-Sgic
+
+# ---------------
+# Code generation
+# ---------------
+
+# Uncomment the next line if you always want static/dynamic units by default
+# (can be overruled with -CD, -CS at the commandline)
+#-CS
+#-CD
+
+# Set the default heapsize to 8Mb
+#-Ch8000000
+
+# Set default codegeneration checks (iocheck, overflow, range, stack)
+#-Ci
+#-Co
+#-Cr
+#-Ct
+
+# Optimizer switches
+# -Og        generate smaller code
+# -OG        generate faster code (default)
+# -Or        keep certain variables in registers (still BUGGY!!!)
+# -Ou        enable uncertain optimizations (see docs)
+# -O1        level 1 optimizations (quick optimizations)
+# -O2        level 2 optimizations (-O1 + slower optimizations)
+# -O3        level 3 optimizations (same as -O2u)
+# -Op        target processor
+#     -Op1  set target processor to 386/486
+#     -Op2  set target processor to Pentium/PentiumMMX (tm)
+#     -Op3  set target processor to PPro/PII/c6x86/K6 (tm)
+
+# Optimize always for Size and Pentium
+#-OG2p2
+
+
+# -----------------------
+# Set Filenames and Paths
+# -----------------------
+
+# Slashes are also allowed under dos
+
+# path to the messagefile, not necessary anymore but can be used to override
+# the default language
+#-Fr\$1/msg/errore.msg
+#-Fr\$1/msg/errorn.msg
+
+# path to the gcclib
+-Fg\$2
+
+# searchpath for includefiles
+#-Fi/pp/inc;/pp/rtl/inc
+
+# searchpath for units (does the same as -Up)
+# For statically, smartlinked units
+#IFDEF FPC_LINK_STATIC
+-Fu\$1/rtl/static
+-Fu\$1/units/static
+#ENDIF
+# For Dynamically linked units
+#IFDEF FPC_LINK_DYNAMIC
+-Fu\$1/rtl/shared
+-Fu\$1/units/shared
+#ENDIF
+# For normal units
+-Fu\$1/rtl
+-Fu\$1/units
+#-Fu/pp/units;/pp/rtl/dos/go32v2
+#-Fu/usr/lib/ppc/units;/usr/lib/ppc/linuxunits
+
+# searchpath for libraries
+#-Fl/pp/lib
+#-Fl/lib;/usr/lib
+
+
+# -------------
+# Linking
+# -------------
+
+# generate always debugging information for GDB (slows down the compiling
+# process)
+#-g
+
+# always pass an option to the linker
+#-k-s
+
+# Always strip debuginfo from the executable
+-Xs
+
+
+# -------------
+# Miscellaneous
+# -------------
+
+# Write always a nice FPC logo ;)
+-l
+
+# Verbosity
+# e : Show errors (default)       d : Show debug info
+# w : Show warnings               u : Show used files
+# n : Show notes                  t : Show tried files
+# h : Show hints                  m : Show defined macros
+# i : Show general info           p : Show compiled procedures
+# l : Show linenumbers            c : Show conditionals
+# a : Show everything             0 : Show nothing (except errors)
+
+# Display Info, Warnings, Notes and Hints
+-viwnh
+# If you don't want so much verbosity use
+#-vw
+
+#
+# That's all folks
+#
+EOFCFG
+EOFCREATE
+chmod 755 $1

compiler/utils/msg2inc.pp

@@ -0,0 +1,810 @@
+{
+    $Id$
+    This program is part of the Free Pascal run time library.
+    Copyright (c) 1998 by Peter Vreman
+
+    Convert a .msg file to an .inc file with a const array of char
+    And for the lazy docwriters it can also generate some TeX output
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+program msg2inc;
+uses strings;
+
+const
+  version='0.99.12';
+{$ifdef linux}
+  eollen=1;
+{$else}
+  eollen=2;
+{$endif}
+type
+  TMode=(M_Char,M_Tex,M_Intel,M_String,M_Renumber);
+var
+  InFile,
+  OutFile,
+  OutName    : string;
+  Mode       : TMode;
+  TexOption,
+  TexHeader,
+  TexError   : boolean;
+
+  MsgTxt     : pchar;
+  EnumTxt    : pchar;
+  enumsize,
+  msgsize    : longint;
+
+function XlatString(Var S : String):boolean;
+{
+  replaces \xxx in string S with #x, and \\ with \ (escaped)
+  which can reduce size of string.
+  Returns false when an error in the line exists
+}
+  Function GetNumber(Position:longint):longint;
+  var
+    C,Value,i : longint;
+  begin
+    I:=0;
+    Value:=0;
+    while i<3 do
+     begin
+       C:=ord(S[Position+I]);
+       if (C>47) and (C<56) then
+        dec(C,48)
+       else
+        begin
+          GetNumber:=-1;
+          exit;
+        end;
+       if I=0 then
+        C:=C shl 6;
+       if I=1 then
+        C:=C SHL 3;
+       inc(Value,C);
+       inc(I);
+     end;
+    GetNumber:=Value;
+  end;
+
+var
+  S2 : String;
+  A,B,Value : longint;
+begin
+  A:=1;
+  B:=1;
+  while A<=Length(S) do
+   begin
+     if (S[A]='\') and (a<length(s)) then
+      begin
+        if S[A+1]='\' then
+         begin
+           S2[B]:='\';
+           Inc(A,2);
+           Inc(B);
+         end
+        else
+         begin
+           Value:=GetNumber(A+1);
+           if Value=-1 then
+            begin
+              XlatString:=false;
+              exit;
+            end;
+           S2[B]:=Chr(Value);
+           inc(B);
+           inc(A,4);
+         end;
+      end
+     else
+      begin
+        S2[B]:=S[A];
+        inc(A);
+        inc(B);
+      end;
+   end;
+  S2[0]:=Chr(B-1);
+  S:=S2;
+  XlatString:=true;
+end;
+
+
+procedure LoadMsgFile(const fn:string);
+var
+  f       : text;
+  line,i  : longint;
+  ptxt,
+  penum   : pchar;
+  s,s1    : string;
+begin
+  Writeln('Loading messagefile ',fn);
+{Read the message file}
+  assign(f,fn);
+  {$I-}
+   reset(f);
+  {$I+}
+  if ioresult<>0 then
+   begin
+     WriteLn('*** message file '+fn+' not found ***');
+     exit;
+   end;
+{ First parse the file and count bytes needed }
+  line:=0;
+  msgsize:=0;
+  while not eof(f) do
+   begin
+     readln(f,s);
+     inc(line);
+     if not XlatString(S) then
+      S:='';
+     if (s<>'') and not(s[1] in ['#',';','%']) then
+      begin
+        i:=pos('=',s);
+        if i>0 then
+         begin
+           inc(msgsize,length(s)-i+1);
+           inc(enumsize,i);
+         end
+        else
+         writeln('error in line: ',line,' skipping');
+      end;
+   end;
+{ now read the buffer in mem }
+  getmem(msgtxt,msgsize);
+  ptxt:=msgtxt;
+  getmem(enumtxt,enumsize);
+  penum:=enumtxt;
+  reset(f);
+  while not eof(f) do
+   begin
+     readln(f,s);
+     inc(line);
+     if not XlatString(S) then
+      S[0]:=#0;
+     if (s<>'') and not(s[1] in ['#',';','%']) then
+      begin
+        i:=pos('=',s);
+        if i>0 then
+         begin
+           {txt}
+           s1:=Copy(s,i+1,255);
+           { support <lf> for empty lines }
+           if s1='<lf>' then
+            begin
+              s1:='';
+              { update the msgsize also! }
+              dec(msgsize,4);
+            end;
+           move(s1[1],ptxt^,length(s1));
+           inc(ptxt,length(s1));
+           ptxt^:=#0;
+           inc(ptxt);
+           {enum}
+           move(s[1],penum^,i-1);
+           inc(penum,i-1);
+           penum^:=#0;
+           inc(penum);
+         end;
+      end;
+   end;
+  close(f);
+end;
+
+
+{*****************************************************************************
+                               WriteEnumFile
+*****************************************************************************}
+
+procedure WriteEnumFile(const fn,typename:string);
+var
+  t : text;
+  i : longint;
+  p : pchar;
+  start : boolean;
+begin
+  writeln('Writing enumfile '+fn);
+{Open textfile}
+  assign(t,fn);
+  rewrite(t);
+  writeln(t,'type t',typename,'=(');
+{Parse buffer in msgbuf and create indexs}
+  p:=enumtxt;
+  start:=true;
+  for i:=1to enumsize do
+   begin
+     if start then
+      begin
+        write(t,'  ');
+        start:=false;
+      end;
+     if p^=#0 then
+      begin
+        writeln(t,',');
+        start:=true;
+      end
+     else
+      write(t,p^);
+     inc(p);
+   end;
+  writeln(t,'end',typename);
+  writeln(t,');');
+  close(t);
+end;
+
+
+{*****************************************************************************
+                               WriteStringFile
+*****************************************************************************}
+
+procedure WriteStringFile(const fn,constname:string);
+const
+  maxslen=240; { to overcome aligning problems }
+
+  function l0(l:longint):string;
+  var
+    s : string[16];
+  begin
+    str(l,s);
+    while (length(s)<5) do
+     s:='0'+s;
+    l0:=s;
+  end;
+
+var
+  t      : text;
+  f      : file;
+  slen,
+  len,i  : longint;
+  p      : pchar;
+  s      : string;
+  start,
+  quote  : boolean;
+begin
+  writeln('Writing stringfile ',fn);
+{Open textfile}
+  assign(t,fn);
+  rewrite(t);
+  writeln(t,'{$ifdef Delphi}');
+  writeln(t,'const '+constname+' : array[0..000000] of string[',maxslen,']=(');
+  writeln(t,'{$else Delphi}');
+  writeln(t,'const '+constname+' : array[0..000000,1..',maxslen,'] of char=(');
+  write(t,'{$endif Delphi}');
+{Parse buffer in msgbuf and create indexs}
+  p:=msgtxt;
+  slen:=0;
+  len:=0;
+  quote:=false;
+  start:=true;
+  for i:=1 to msgsize do
+   begin
+     if slen>=maxslen then
+      begin
+        if quote then
+         begin
+           write(t,'''');
+           quote:=false;
+         end;
+        write(t,',');
+        slen:=0;
+        inc(len);
+      end;
+     if (len>70) or (start) then
+      begin
+        if quote then
+         begin
+           write(t,'''');
+           quote:=false;
+         end;
+        if slen>0 then
+          writeln(t,'+')
+        else
+          writeln(t);
+        len:=0;
+        start:=false;
+      end;
+     if (len=0) then
+      write(t,'  ');
+     if (ord(p^)>=32) and (p^<>#39) then
+      begin
+        if not quote then
+         begin
+           write(t,'''');
+           quote:=true;
+           inc(len);
+         end;
+        write(t,p^);
+        inc(len);
+      end
+     else
+      begin
+        if quote then
+         begin
+           write(t,'''');
+           inc(len);
+           quote:=false;
+         end;
+        write(t,'#'+chr(ord(p^) div 100+48)+chr((ord(p^) mod 100) div 10+48)+chr(ord(p^) mod 10+48));
+        inc(len,3);
+      end;
+     if p^=#0 then
+      start:=true;
+     inc(slen);
+     inc(p);
+   end;
+  if quote then
+   write(t,'''');
+  writeln(t,'');
+  writeln(t,');');
+  close(t);
+{update arraysize}
+  s:=l0(msgsize div maxslen); { we start with 0 }
+  assign(f,fn);
+  reset(f,1);
+  seek(f,34+eollen+length(constname));
+  blockwrite(f,s[1],5);
+  seek(f,90+3*eollen+2*length(constname));
+  blockwrite(f,s[1],5);
+  close(f);
+end;
+
+
+{*****************************************************************************
+                               WriteCharFile
+*****************************************************************************}
+
+procedure WriteCharFile(const fn,constname:string);
+
+  function l0(l:longint):string;
+  var
+    s : string[16];
+  begin
+    str(l,s);
+    while (length(s)<5) do
+     s:='0'+s;
+    l0:=s;
+  end;
+
+  function createconst(b:byte):string;
+  begin
+    if (b in [32..127]) and (b<>39) then
+     createconst:=''''+chr(b)+''''
+    else
+     createconst:='#'+chr(b div 100+48)+chr((b mod 100) div 10+48)+chr(b mod 10+48)
+  end;
+
+var
+  t       : text;
+  f       : file;
+  cidx,i  : longint;
+  p       : pchar;
+  s       : string;
+begin
+  writeln('Writing charfile '+fn);
+{Open textfile}
+  assign(t,fn);
+  rewrite(t);
+  writeln(t,'const ',constname,' : array[1..00000] of char=(');
+{Parse buffer in msgbuf and create indexs}
+  p:=msgtxt;
+  cidx:=0;
+  for i:=1to msgsize do
+   begin
+     if cidx=15 then
+      begin
+        if cidx>0 then
+         writeln(t,',')
+        else
+         writeln(t,'');
+        write(t,'  ');
+        cidx:=0;
+      end
+     else
+      if cidx>0 then
+        write(t,',')
+      else
+        write(t,'  ');
+     write(t,createconst(ord(p^)));
+     inc(cidx);
+     inc(p);
+   end;
+  writeln(t,');');
+  close(t);
+{update arraysize}
+  s:=l0(msgsize);
+  assign(f,fn);
+  reset(f,1);
+  seek(f,18+length(constname));
+  blockwrite(f,s[1],5);
+  close(f);
+end;
+
+
+{*****************************************************************************
+                               WriteIntelFile
+*****************************************************************************}
+
+procedure WriteIntelFile(const fn,constname:string);
+var
+  t      : text;
+  len,i  : longint;
+  p      : pchar;
+  start,
+  quote  : boolean;
+begin
+  writeln('Writing Intelfile ',fn);
+{Open textfile}
+  assign(t,fn);
+  rewrite(t);
+  writeln(t,'procedure '+constname+';assembler;');
+  writeln(t,'asm');
+{Parse buffer in msgbuf and create indexs}
+  p:=msgtxt;
+  len:=0;
+  start:=true;
+  quote:=false;
+  for i:=1to msgsize do
+   begin
+     if len>70 then
+      begin
+        if quote then
+         begin
+           write(t,'''');
+           quote:=false;
+         end;
+        writeln(t,'');
+        start:=true;
+      end;
+     if start then
+      begin
+        write(t,'  db ''');
+        len:=0;
+        quote:=true;
+      end;
+     if (ord(p^)>=32) and (p^<>#39) then
+      begin
+        if not quote then
+         begin
+           write(t,',''');
+           quote:=true;
+           inc(len);
+         end;
+        write(t,p^);
+        inc(len);
+      end
+     else
+      begin
+        if quote then
+         begin
+           write(t,'''');
+           inc(len);
+           quote:=false;
+         end;
+        write(t,','+chr(ord(p^) div 100+48)+chr((ord(p^) mod 100) div 10+48)+chr(ord(p^) mod 10+48));
+        inc(len,4);
+      end;
+     inc(p);
+   end;
+  if quote then
+   write(t,'''');
+  writeln(t,'');
+  writeln(t,'end;');
+  close(t);
+end;
+
+
+{*****************************************************************************
+                                RenumberFile
+*****************************************************************************}
+
+procedure RenumberFile(const fn,name:string);
+var
+  f,t  : text;
+  i    : longint;
+  s,s1 : string;
+begin
+  Writeln('Renumbering ',fn);
+{Read the message file}
+  assign(f,fn);
+  {$I-}
+   reset(f);
+  {$I+}
+  if ioresult<>0 then
+   begin
+     WriteLn('*** message file '+fn+' not found ***');
+     exit;
+   end;
+  assign(t,'msg2inc.$$$');
+  rewrite(t);
+  i:=0;
+  while not eof(f) do
+   begin
+     readln(f,s);
+     if (copy(s,1,length(Name))=Name) and (s[3] in ['0'..'9']) then
+      begin
+        inc(i);
+        str(i,s1);
+        while length(s1)<3 do
+         s1:='0'+s1;
+        writeln(t,Name+s1+Copy(s,6,255));
+      end
+     else
+      writeln(t,s);
+   end;
+  close(t);
+  close(f);
+{ rename new file }
+  erase(f);
+  rename(t,fn);
+end;
+
+
+{*****************************************************************************
+                                WriteTexFile
+*****************************************************************************}
+
+Function EscapeString (Const S : String) : String;
+Var
+  I  : longint;
+  hs : string;
+begin
+  hs:='';
+  for i:=1 to length(s) do
+    if S[i]='$' then
+      hs:=hs+'arg'
+    else
+      hs:=hs+s[i];
+  EscapeString:=hs;
+end;
+
+procedure WriteTexFile(const infn,outfn:string);
+var
+  t,f   : text;
+  line,
+  i,k   : longint;
+  s,s1  : string;
+  texoutput : boolean;
+begin
+  Writeln('Loading messagefile ',infn);
+  writeln('Writing TeXfile ',outfn);
+{ Open infile }
+  assign(f,infn);
+  {$I-}
+   reset(f);
+  {$I+}
+  if ioresult<>0 then
+   begin
+     WriteLn('*** message file '+infn+' not found ***');
+     exit;
+   end;
+{ Open outfile }
+  assign(t,outfn);
+  rewrite(t);
+  If texheader then
+    begin
+    writeln (t,'\documentclass{article}');
+    writeln (t,'\usepackage{html}');
+    writeln (t,'\usepackage{fpcman}');
+    writeln (t,'\begin{document}');
+    end;
+{ Parse }
+  line:=0;
+  TexOutput:=False;
+  while not eof(f) do
+   begin
+     readln(f,s);
+     inc(line);
+     If Pos ('# BeginOfTeX',S)=1 then
+       TexOutPut:=True
+     else if pos ('# EndOfTeX',S)=1 then
+       TexOutPut:=False;
+     if (s<>'') and not(s[1] in ['#',';']) and TeXOutPut then
+      begin
+        if s[1]='%' then
+         begin
+           Delete(s,1,1);
+           writeln(t,s);
+         end
+        else
+         begin
+           i:=pos('=',s);
+           if i>0 then
+            begin
+              inc(i);
+              s1:='';
+              k:=0;
+              while (k<5) and (s[i+k]<>'_') do
+               begin
+                 case s[i+k] of
+                  'W' : s1:='Warning: ';
+                  'E' : s1:='Error: ';
+                  'F' : s1:='Fatal: ';
+                  'N' : s1:='Note: ';
+                  'I' : s1:='Info: ';
+                  'H' : s1:='Hint: ';
+                 end;
+                 inc(k);
+               end;
+              if s[i+k]='_' then
+               inc(i,k+1);
+              writeln(t,'\item ['+s1+escapestring(Copy(s,i,255))+']');
+            end
+           else
+            writeln('error in line: ',line,' skipping');
+         end;
+      end;
+   end;
+  If TexHeader then
+    writeln (t,'\end{document}');
+  close(t);
+  close(f);
+end;
+
+
+{*****************************************************************************
+                                Main Program
+*****************************************************************************}
+
+procedure getpara;
+var
+  ch      : char;
+  para    : string;
+  files,i : word;
+
+  procedure helpscreen;
+  begin
+    writeln('usage : msg2inc [Options] <msgfile> <incfile> <constname>');
+    writeln('<Options> can be : -TE    Create .doc TeX file (error style)');
+    writeln('                   -TO    Create .doc TeX file (options style)');
+    writeln('                   -TS    Create .doc TeX file (stand-alone)');
+    writeln('                   -I     Intel style asm output');
+    writeln('                   -S     array of string');
+    writeln('                   -C     array of char');
+    writeln('                   -R     renumber section <incfile>');
+    writeln('                   -V     Show version');
+    writeln('             -? or -H     This HelpScreen');
+    halt(1);
+  end;
+
+begin
+  Mode:=M_String;
+  FIles:=0;
+  for i:=1to paramcount do
+   begin
+     para:=paramstr(i);
+     if (para[1]='-') then
+      begin
+        ch:=upcase(para[2]);
+        delete(para,1,2);
+        case ch of
+         'T' : begin
+                 case upcase(para[1]) of
+                  'O' : TexOption:=true;
+                  'E' : TexError:=true;
+                  'S' : TexHeader:=True;
+                 end;
+                 Mode:=M_Tex;
+               end;
+         'I' : Mode:=M_Intel;
+         'S' : Mode:=M_String;
+         'C' : Mode:=M_Char;
+         'R' : Mode:=M_Renumber;
+         'V' : begin
+                 Writeln('Msg2Inc ',version,' for Free Pascal (C) 1998 Peter Vreman');
+                 Writeln;
+                 Halt;
+               end;
+     '?','H' : helpscreen;
+        end;
+     end
+    else
+     begin
+       inc(Files);
+       if Files>3 then
+        HelpScreen;
+       case Files of
+        1 : InFile:=Para;
+        2 : OutFile:=Para;
+        3 : OutName:=Para;
+       end;
+     end;
+   end;
+  case Mode of
+   M_Renumber,
+        M_Tex : if Files<2 then
+                 Helpscreen;
+  else
+   if FIles<3 then
+    HelpScreen;
+  end;
+end;
+
+
+begin
+  GetPara;
+  case Mode of
+   M_Renumber : begin
+                  Renumberfile(Infile,OutFile);
+                end;
+        M_Tex : begin
+                  WriteTexFile(InFile,OutFile+'.tex');
+                end;
+      M_Intel : begin
+                  Loadmsgfile(InFile);
+                  WriteEnumFile(OutFile+'idx.inc',OutName+'const');
+                  WriteIntelFile(OutFile+'txt.inc',OutName+'txt');
+                end;
+     M_String : begin
+                  Loadmsgfile(InFile);
+                  WriteEnumFile(OutFile+'idx.inc',OutName+'const');
+                  WriteStringFile(OutFile+'txt.inc',OutName+'txt');
+                end;
+       M_Char : begin
+                  Loadmsgfile(InFile);
+                  WriteEnumFile(OutFile+'idx.inc',OutName+'const');
+                  WriteCharFile(OutFile+'txt.inc',OutName+'txt');
+                end;
+  end;
+end.
+{
+  $Log$
+  Revision 1.1  1999-05-12 16:08:27  peter
+    + moved compiler utils
+
+  Revision 1.18  1999/05/06 09:06:27  peter
+    * eollen constant
+
+  Revision 1.17  1999/05/06 00:08:20  pierre
+   two character newline problem fixed
+
+  Revision 1.16  1999/05/05 22:37:52  peter
+    * fixed offset patching
+
+  Revision 1.15  1999/05/05 09:20:09  florian
+    * another fix for delphi: it doesn't like the array [...,...] of char
+      threaded as strings
+
+  Revision 1.14  1998/10/29 23:07:46  peter
+    + \xxx support
+
+  Revision 1.13  1998/10/21 14:09:05  florian
+    * the leading + in the message array isn't longer generated
+
+  Revision 1.12  1998/09/24 23:22:51  peter
+    * compiles with tp
+
+  Revision 1.11  1998/09/13 12:36:36  michael
+  + Corrected TeX output
+
+  Revision 1.10  1998/09/12 15:20:56  peter
+    * TeX writing fixed
+
+  Revision 1.9  1998/09/11 15:55:29  michael
+  first fix for TeX output
+
+  Revision 1.8  1998/09/09 20:21:52  peter
+    * updated to support <lf> for empty lines
+
+  Revision 1.7  1998/08/29 13:46:53  peter
+    + new messagefile format
+    + renumbering of enums (-r)
+
+  Revision 1.6  1998/08/18 13:58:33  carl
+    * Arglu... i forgot a line when changing to bugfix!
+
+  Revision 1.5  1998/08/18 13:34:30  carl
+    * forgot to fix one bugcrash with string output
+
+  Revision 1.4  1998/08/17 12:22:19  carl
+    * crash bugfix (was reading one char too much)
+
+  Revision 1.3  1998/08/11 14:00:42  peter
+    + string and intel db output
+
+  Revision 1.2  1998/03/30 12:06:17  peter
+    + support for tex output for the lazy docwriter ;)
+}

compiler/utils/nasmconv.pas

@@ -0,0 +1,301 @@
+{
+    $Id$
+    Copyright (c) 1999 by Peter Vreman and Florian Klaempfl
+
+    Convert insns.dat from Nasm to a .inc file for usage with
+    the Free pascal compiler
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+program msg2inc;
+program nasmconv;
+
+var
+   infile,outfile : text;
+   s : string;
+   i : longint;
+
+
+      function Replace(var s:string;const s1,s2:string):boolean;
+      var
+        i  : longint;
+      begin
+        i:=pos(s1,s);
+        if i>0 then
+         begin
+           Delete(s,i,length(s1));
+           Insert(s2,s,i);
+           Replace:=true;
+         end
+        else
+         Replace:=false;
+      end;
+
+
+function formatop(s:string):string;
+   const
+     replaces=19;
+     replacetab : array[1..replaces,1..2] of string[32]=(
+       (':',' or ot_colon'),
+       ('mem8','mem or ot_bits8'),
+       ('mem16','mem or ot_bits16'),
+       ('mem32','mem or ot_bits32'),
+       ('mem64','mem or ot_bits64'),
+       ('mem80','mem or ot_bits80'),
+       ('mem','memory'),
+       ('memory_offs','mem_offs'),
+       ('imm8','imm or ot_bits8'),
+       ('imm16','imm or ot_bits16'),
+       ('imm32','imm or ot_bits32'),
+       ('imm64','imm or ot_bits64'),
+       ('imm80','imm or ot_bits80'),
+       ('imm','immediate'),
+       ('rm8','regmem or ot_bits8'),
+       ('rm16','regmem or ot_bits16'),
+       ('rm32','regmem or ot_bits32'),
+       ('rm64','regmem or ot_bits64'),
+       ('rm80','regmem or ot_bits80')
+     );
+  var
+    i : longint;
+  begin
+    for i:=1to replaces do
+     replace(s,replacetab[i,1],replacetab[i,2]);
+    formatop:=s;
+  end;
+
+
+procedure maybe_newline;
+
+  begin
+     if s[i]=#10 then
+       begin
+          readln(infile,s);
+          i:=1;
+       end;
+     while s[1]=';' do
+       begin
+          readln(infile,s);
+          i:=1;
+       end;
+  end;
+
+function readnumber : longint;
+
+  var
+     base : longint;
+     result : longint;
+
+  begin
+     result:=0;
+     if s[i]='\' then
+       begin
+          base:=8;
+          inc(i);
+          if s[i]='x' then
+            begin
+               base:=16;
+               inc(i);
+            end;
+       end
+     else
+       base:=10;
+     s[i]:=upcase(s[i]);
+     while s[i] in ['0'..'9','A'..'F'] do
+       begin
+          case s[i] of
+             '0'..'9':
+               result:=result*base+ord(s[i])-ord('0');
+
+             'A'..'F':
+               result:=result*base+ord(s[i])-ord('A')+10;
+          end;
+          inc(i);
+       end;
+     readnumber:=result;
+  end;
+
+function tostr(l : longint) : string;
+
+  var
+     hs : string;
+
+  begin
+     str(l,hs);
+     tostr:=hs;
+  end;
+
+function readstr : string;
+
+  var
+     result : string;
+
+  begin
+     result:='';
+     while (s[i] in ['0'..'9','A'..'Z','a'..'z','_']) and (i<=length(s)) do
+       begin
+          result:=result+s[i];
+          inc(i);
+       end;
+     readstr:=result;
+  end;
+
+procedure skipspace;
+
+  begin
+     while (s[i] in [' ',#9]) do
+       inc(i);
+  end;
+
+var
+   hs : string;
+   j : longint;
+   first : boolean;
+   maxinfolen,
+   code : byte;
+   insns : longint;
+   { instruction fields }
+   last,
+   ops    : longint;
+   opcode,
+   codes,
+   flags   : string;
+   optypes : array[1..3] of string;
+begin
+   writeln('Nasm Instruction Table Converter Version 0.99.11');
+   insns:=0;
+   assign(infile,'insns.dat');
+   reset(infile);
+   assign(outfile,'i386tab.inc');
+   rewrite(outfile);
+   writeln(outfile,'(');
+   first:=true;
+   while not(eof(infile)) do
+     begin
+        { handle comment }
+        readln(infile,s);
+        if s[1]=';' then
+          continue;
+        { clear }
+        opcode:='';
+        ops:=0;
+        optypes[1]:='';
+        optypes[2]:='';
+        optypes[3]:='';
+        codes:='';
+        flags:='';
+        { opcode }
+        opcode:='A_';
+        i:=1;
+        while not(s[i] in [' ',#9]) do
+          begin
+            opcode:=opcode+s[i];
+            inc(i);
+          end;
+        skipspace;
+        { ops and optypes }
+        repeat
+          hs:=readstr;
+          if (hs='void') or (hs='ignore') then
+            break;
+          inc(ops);
+          optypes[ops]:=optypes[ops]+'ot_'+formatop(hs);
+          if s[i]=':' then
+            begin
+               inc(i);
+               optypes[ops]:=optypes[ops]+' or ot_'+formatop(readstr);
+            end;
+          while s[i]='|' do
+            begin
+               inc(i);
+               optypes[ops]:=optypes[ops]+' or ot_'+formatop(readstr);
+            end;
+          if s[i]=',' then
+            inc(i)
+          else
+            break;
+        until false;
+        for j:=1 to 3-ops do
+          optypes[3-j+1]:='ot_none';
+        { codes }
+        skipspace;
+        j:=0;
+        last:=0;
+        if s[i] in ['\','0'..'9'] then
+          begin
+             while not(s[i] in [' ',#9]) do
+               begin
+                 code:=readnumber;
+                 { for some codes we want also to change the optypes, but not
+                   if the last byte was a 1 then this byte belongs to a direct
+                   copy }
+                 if last<>1 then
+                  begin
+                    case code of
+                      12,13,14 :
+                        optypes[code-11]:=optypes[code-11]+' or ot_signed';
+                    end;
+                  end;
+                 codes:=codes+'#'+tostr(code);
+                 last:=code;
+                 inc(j);
+               end;
+          end
+        else
+          codes:='#0';
+        if j>maxinfolen then
+         maxinfolen:=j;
+        { flags }
+        skipspace;
+        while not(s[i] in [' ',#9,#13,#10]) and (i<=length(s)) do
+          begin
+             hs:=readstr;
+             if hs='ignore' then
+              begin
+                flags:='0';
+                break;
+              end;
+             if hs<>'ND' then
+              begin
+                if flags<>'' then
+                 flags:=flags+' or ';
+                flags:=flags+'if_'+hs;
+              end;
+             if (s[i]=',') and (i<=length(s)) then
+              inc(i)
+             else
+              break;
+          end;
+      { write instruction }
+        if not(first) then
+          writeln(outfile,',')
+        else
+          first:=false;
+        writeln(outfile,'  (');
+        writeln(outfile,'    opcode  : ',opcode,';');
+        writeln(outfile,'    ops     : ',ops,';');
+        writeln(outfile,'    optypes : (',optypes[1],',',optypes[2],',',optypes[3],');');
+        writeln(outfile,'    code    : ',codes,';');
+        writeln(outfile,'    flags   : ',flags);
+        write(outfile,'  )');
+        maybe_newline;
+        inc(insns);
+     end;
+   writeln(outfile);
+   writeln(outfile,');');
+   close(infile);
+   close(outfile);
+   writeln(insns,' nodes procesed (maxinfolen=',maxinfolen,')');
+end.
+{
+  $Log$
+  Revision 1.1  1999-05-12 16:08:27  peter
+    + moved compiler utils
+
+}