Przeglądaj źródła

+ started implementing a win16 target :)

git-svn-id: trunk@31521 -
nickysn 10 lat temu
rodzic
commit
839ab714cc

+ 10 - 0
.gitattributes

@@ -724,6 +724,7 @@ compiler/systems/i_watcom.pas svneol=native#text/plain
 compiler/systems/i_wdosx.pas svneol=native#text/plain
 compiler/systems/i_wii.pas svneol=native#text/plain
 compiler/systems/i_win.pas svneol=native#text/plain
+compiler/systems/i_win16.pas svneol=native#text/plain
 compiler/systems/mac_crea.txt svneol=native#text/plain
 compiler/systems/t_aix.pas svneol=native#text/plain
 compiler/systems/t_amiga.pas svneol=native#text/plain
@@ -754,6 +755,7 @@ compiler/systems/t_watcom.pas svneol=native#text/plain
 compiler/systems/t_wdosx.pas svneol=native#text/plain
 compiler/systems/t_wii.pas svneol=native#text/plain
 compiler/systems/t_win.pas svneol=native#text/plain
+compiler/systems/t_win16.pas svneol=native#text/plain
 compiler/tgobj.pas svneol=native#text/plain
 compiler/tokens.pas svneol=native#text/plain
 compiler/utils/Makefile svneol=native#text/plain
@@ -9693,6 +9695,14 @@ rtl/win/wininc/unidef.inc svneol=native#text/plain
 rtl/win/wininc/unidef.sed -text
 rtl/win/wininc/unifun.inc svneol=native#text/plain
 rtl/win/winres.inc svneol=native#text/plain
+rtl/win16/prt0c.asm svneol=native#text/plain
+rtl/win16/prt0comn.asm svneol=native#text/plain
+rtl/win16/prt0h.asm svneol=native#text/plain
+rtl/win16/prt0l.asm svneol=native#text/plain
+rtl/win16/prt0m.asm svneol=native#text/plain
+rtl/win16/prt0s.asm svneol=native#text/plain
+rtl/win16/prt0t.asm svneol=native#text/plain
+rtl/win16/system.pp svneol=native#text/plain
 rtl/win32/Makefile svneol=native#text/plain
 rtl/win32/Makefile.fpc svneol=native#text/plain
 rtl/win32/buildrtl.lpi svneol=native#text/plain

+ 3 - 0
compiler/i8086/cputarg.pas

@@ -38,6 +38,9 @@ implementation
     {$ifndef NOTARGETMSDOS}
       ,t_msdos
     {$endif}
+    {$ifndef NOTARGETWIN}
+      ,t_win16
+    {$endif}
 
 {**************************************
              Assemblers

+ 1 - 1
compiler/options.pas

@@ -2221,7 +2221,7 @@ begin
                     'm':
                       begin
 {$if defined(i8086)}
-                        if (target_info.system in [system_i8086_msdos]) then
+                        if (target_info.system in [system_i8086_msdos,system_i8086_win16]) then
                           begin
                             case Upper(Copy(More,j+1,255)) of
                               'TINY':    init_settings.x86memorymodel:=mm_tiny;

+ 9 - 23
compiler/ppc8086.lpi

@@ -28,7 +28,7 @@
         <LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
       </local>
     </RunParams>
-    <Units Count="237">
+    <Units Count="239">
       <Unit0>
         <Filename Value="pp.pas"/>
         <IsPartOfProject Value="True"/>
@@ -96,12 +96,10 @@
       <Unit16>
         <Filename Value="x86\cgx86.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="cgx86"/>
       </Unit16>
       <Unit17>
         <Filename Value="x86\agx86nsm.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="agx86nsm"/>
       </Unit17>
       <Unit18>
         <Filename Value="x86\nx86set.pas"/>
@@ -118,7 +116,6 @@
       <Unit21>
         <Filename Value="x86\cpubase.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="cpubase"/>
       </Unit21>
       <Unit22>
         <Filename Value="x86\nx86mem.pas"/>
@@ -151,7 +148,6 @@
       <Unit29>
         <Filename Value="x86\aasmcpu.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="aasmcpu"/>
       </Unit29>
       <Unit30>
         <Filename Value="x86\agx86int.pas"/>
@@ -197,12 +193,10 @@
       <Unit40>
         <Filename Value="systems\i_msdos.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="i_msdos"/>
       </Unit40>
       <Unit41>
         <Filename Value="systems\t_msdos.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="t_msdos"/>
       </Unit41>
       <Unit42>
         <Filename Value="i8086\n8086mem.pas"/>
@@ -303,7 +297,6 @@
       <Unit66>
         <Filename Value="aasmtai.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="aasmtai"/>
       </Unit66>
       <Unit67>
         <Filename Value="dbgdwarf.pas"/>
@@ -312,12 +305,10 @@
       <Unit68>
         <Filename Value="symdef.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="symdef"/>
       </Unit68>
       <Unit69>
         <Filename Value="ogcoff.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="ogcoff"/>
       </Unit69>
       <Unit70>
         <Filename Value="psystem.pas"/>
@@ -410,7 +401,6 @@
       <Unit92>
         <Filename Value="cgbase.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="cgbase"/>
       </Unit92>
       <Unit93>
         <Filename Value="ncgcnv.pas"/>
@@ -431,7 +421,6 @@
       <Unit97>
         <Filename Value="aasmbase.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="aasmbase"/>
       </Unit97>
       <Unit98>
         <Filename Value="aasmdata.pas"/>
@@ -468,7 +457,6 @@
       <Unit106>
         <Filename Value="assemble.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="assemble"/>
       </Unit106>
       <Unit107>
         <Filename Value="browcol.pas"/>
@@ -585,7 +573,6 @@
       <Unit135>
         <Filename Value="fppu.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="fppu"/>
       </Unit135>
       <Unit136>
         <Filename Value="gendef.pas"/>
@@ -614,7 +601,6 @@
       <Unit142>
         <Filename Value="link.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="link"/>
       </Unit142>
       <Unit143>
         <Filename Value="macho.pas"/>
@@ -707,12 +693,10 @@
       <Unit165>
         <Filename Value="ogbase.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="ogbase"/>
       </Unit165>
       <Unit166>
         <Filename Value="ogelf.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="ogelf"/>
       </Unit166>
       <Unit167>
         <Filename Value="oglx.pas"/>
@@ -765,12 +749,10 @@
       <Unit179>
         <Filename Value="owar.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="owar"/>
       </Unit179>
       <Unit180>
         <Filename Value="owbase.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="owbase"/>
       </Unit180>
       <Unit181>
         <Filename Value="parser.pas"/>
@@ -847,7 +829,6 @@
       <Unit199>
         <Filename Value="rasm.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="rasm"/>
       </Unit199>
       <Unit200>
         <Filename Value="rautils.pas"/>
@@ -964,12 +945,10 @@
       <Unit228>
         <Filename Value="ogomf.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="ogomf"/>
       </Unit228>
       <Unit229>
         <Filename Value="omfbase.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="omfbase"/>
       </Unit229>
       <Unit230>
         <Filename Value="aasmcnst.pas"/>
@@ -998,8 +977,15 @@
       <Unit236>
         <Filename Value="owomflib.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="owomflib"/>
       </Unit236>
+      <Unit237>
+        <Filename Value="systems\i_win16.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit237>
+      <Unit238>
+        <Filename Value="systems\t_win16.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit238>
     </Units>
   </ProjectOptions>
   <CompilerOptions>

+ 3 - 1
compiler/systems.inc

@@ -170,7 +170,8 @@
              system_x86_64_dragonfly,   { 85 }
              system_aarch64_darwin,     { 86 }
              system_x86_64_iphonesim,   { 87 }
-             system_aarch64_linux       { 88 }
+             system_aarch64_linux,      { 88 }
+             system_i8086_win16         { 89 }
        );
 
      type
@@ -249,6 +250,7 @@
              ld_wdosx,
              ld_wii,
              ld_windows,
+             ld_win16,
              ld_int_go32v2,    { implemented internal linkers }
              ld_int_linux,
              ld_int_nativent,

+ 115 - 0
compiler/systems/i_win16.pas

@@ -0,0 +1,115 @@
+{
+    Copyright (c) 1998-2002 by Peter Vreman
+
+    This unit implements support information structures for Win16
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    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.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ ****************************************************************************
+}
+{ This unit implements support information structures for go32v2. }
+unit i_win16;
+
+{$i fpcdefs.inc}
+
+{$ifdef go32v2}
+  { As wlib uses a different Dos-Extender, long-command line
+    encoding for DJGPP does not work here.
+    Put all inside a script file instead }
+  {$define USE_SCRIPTED_WLIB}
+{$endif}
+
+  interface
+
+    uses
+       systems;
+
+    const
+       system_i8086_win16_info : tsysteminfo =
+          (
+            system       : system_i8086_win16;
+            name         : 'Win16 for x86';
+            shortname    : 'Win16';
+            flags        : [tf_use_8_3,tf_smartlink_library,
+                            tf_no_objectfiles_when_smartlinking,tf_cld];
+            cpu          : cpu_i8086;
+            unit_env     : 'WIN16UNITS';
+            extradefines : 'MSWINDOWS;WINDOWS';
+            exeext       : '.exe';
+            defext       : '.def';
+            scriptext    : '.bat';
+            smartext     : '.sl';
+            unitext      : '.ppu';
+            unitlibext   : '.ppl';
+            asmext       : '.s';
+            objext       : '.o';
+            resext       : '.res';
+            resobjext    : '.or';
+            sharedlibext : '';
+            staticlibext : '.a';
+            staticlibprefix : '';
+            sharedlibprefix : '';
+            sharedClibext : '.dll';
+            staticClibext : '.a';
+            staticClibprefix : 'lib';
+            sharedClibprefix : '';
+            importlibprefix : '';
+            importlibext : '.al';
+            Cprefix      : '_';
+            newline      : #13#10;
+            dirsep       : '\';
+            assem        : as_i8086_nasmobj;
+            assemextern  : as_i8086_nasmobj;
+            link         : ld_win16;
+            linkextern   : ld_win16;
+{$ifdef USE_SCRIPTED_WLIB}
+            ar           : ar_watcom_wlib_omf_scripted;
+{$else}
+            ar           : ar_watcom_wlib_omf;
+{$endif}
+            res          : res_none;
+            dbg          : dbg_dwarf2;
+            script       : script_dos;
+            endian       : endian_little;
+            alignment    :
+              (
+                procalign       : 1;
+                loopalign       : 1;
+                jumpalign       : 0;
+                constalignmin   : 0;
+                constalignmax   : 2;
+                varalignmin     : 0;
+                varalignmax     : 2;
+                localalignmin   : 0;
+                localalignmax   : 2;
+                recordalignmin  : 0;
+                recordalignmax  : 2;
+                maxCrecordalign : 2
+              );
+            first_parm_offset : 4;
+            stacksize    : 0;
+            stackalign   : 2;
+            abi          : abi_default;
+            llvmdatalayout : 'todo';
+          );
+
+  implementation
+
+initialization
+{$ifdef cpu8086}
+  {$ifdef win16}
+    set_source_info(system_i8086_win16_info);
+  {$endif win16}
+{$endif cpu8086}
+end.

+ 199 - 0
compiler/systems/t_win16.pas

@@ -0,0 +1,199 @@
+{
+    Copyright (c) 1998-2002 by Peter Vreman
+
+    This unit implements support import,export,link routines
+    for the (i8086) Win16 target
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    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.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+unit t_win16;
+
+{$i fpcdefs.inc}
+
+interface
+
+
+implementation
+
+    uses
+       SysUtils,
+       cutils,cfileutl,cclasses,
+       globtype,globals,systems,verbose,script,
+       import,fmodule,i_win16,
+       link,aasmbase,cpuinfo,
+       omfbase,ogbase,ogomf,owomflib;
+
+    type
+
+      { TImportLibWin16 }
+
+      TImportLibWin16=class(timportlib)
+      public
+        procedure generatelib;override;
+      end;
+
+      { the (Open) Watcom linker }
+      TExternalLinkerWin16WLink=class(texternallinker)
+      private
+         Function  WriteResponseFile(isdll:boolean) : Boolean;
+      public
+         constructor Create;override;
+         procedure SetDefaultInfo;override;
+         function  MakeExecutable:boolean;override;
+      end;
+
+    var
+      importlist: array of string;
+
+{****************************************************************************
+                               TImportLibWin16
+****************************************************************************}
+
+
+procedure TImportLibWin16.generatelib;
+var
+  i: Integer;
+  j: Integer;
+  ImportLibrary: TImportLibrary;
+  ImportSymbol: TImportSymbol;
+begin
+  for i:=0 to current_module.ImportLibraryList.Count-1 do
+    begin
+      ImportLibrary:=TImportLibrary(current_module.ImportLibraryList[i]);
+      for j:=0 to ImportLibrary.ImportSymbolList.Count-1 do
+        begin
+          ImportSymbol:=TImportSymbol(ImportLibrary.ImportSymbolList[j]);
+          SetLength(importlist, Length(importlist)+1);
+          WriteStr(importlist[high(importlist)],'import ',ImportSymbol.Name,' ',ImportLibrary.Name);
+        end;
+    end;
+end;
+
+
+{****************************************************************************
+                               TExternalLinkerWin16WLink
+****************************************************************************}
+
+function TExternalLinkerWin16WLink.WriteResponseFile(isdll: boolean): Boolean;
+Var
+  linkres  : TLinkRes;
+  s        : string;
+  i: Integer;
+begin
+  WriteResponseFile:=False;
+
+  { Open link.res file }
+  LinkRes:=TLinkRes.Create(outputexedir+Info.ResName,true);
+
+  { Add all options to link.res instead of passing them via command line:
+    DOS command line is limited to 126 characters! }
+
+  LinkRes.Add('option quiet');
+
+  if target_dbg.id in [dbg_dwarf2,dbg_dwarf3,dbg_dwarf4] then
+    LinkRes.Add('debug dwarf');
+
+  { add objectfiles, start with prt0 always }
+  case current_settings.x86memorymodel of
+    mm_tiny:    LinkRes.Add('file ' + maybequoted(FindObjectFile('prt0t','',false)));
+    mm_small:   LinkRes.Add('file ' + maybequoted(FindObjectFile('prt0s','',false)));
+    mm_medium:  LinkRes.Add('file ' + maybequoted(FindObjectFile('prt0m','',false)));
+    mm_compact: LinkRes.Add('file ' + maybequoted(FindObjectFile('prt0c','',false)));
+    mm_large:   LinkRes.Add('file ' + maybequoted(FindObjectFile('prt0l','',false)));
+    mm_huge:    LinkRes.Add('file ' + maybequoted(FindObjectFile('prt0h','',false)));
+  end;
+  while not ObjectFiles.Empty do
+  begin
+    s:=ObjectFiles.GetFirst;
+    if s<>'' then
+      LinkRes.Add('file ' + maybequoted(s));
+  end;
+  while not StaticLibFiles.Empty do
+  begin
+    s:=StaticLibFiles.GetFirst;
+    if s<>'' then
+      LinkRes.Add('library '+MaybeQuoted(s));
+  end;
+  LinkRes.Add('format windows');
+  if (cs_link_map in current_settings.globalswitches) then
+    LinkRes.Add('option map='+maybequoted(ChangeFileExt(current_module.exefilename,'.map')));
+  LinkRes.Add('name ' + maybequoted(current_module.exefilename));
+
+{  LinkRes.Add('import InitTask KERNEL');
+  LinkRes.Add('import WaitEvent KERNEL');
+  LinkRes.Add('import InitApp USER');}
+  for i:=low(importlist) to high(importlist) do
+    LinkRes.Add(importlist[i]);
+
+  { Write and Close response }
+  linkres.writetodisk;
+  LinkRes.Free;
+
+  WriteResponseFile:=True;
+end;
+
+constructor TExternalLinkerWin16WLink.Create;
+begin
+  Inherited Create;
+  { allow duplicated libs (PM) }
+  SharedLibFiles.doubles:=true;
+  StaticLibFiles.doubles:=true;
+end;
+
+procedure TExternalLinkerWin16WLink.SetDefaultInfo;
+begin
+  with Info do
+   begin
+     ExeCmd[1]:='wlink $OPT $RES';
+   end;
+end;
+
+function TExternalLinkerWin16WLink.MakeExecutable: boolean;
+var
+  binstr,
+  cmdstr  : TCmdStr;
+  success : boolean;
+begin
+  if not(cs_link_nolink in current_settings.globalswitches) then
+    Message1(exec_i_linking,current_module.exefilename);
+
+  { Write used files and libraries and our own tlink script }
+  WriteResponsefile(false);
+
+  { Call linker }
+  SplitBinCmd(Info.ExeCmd[1],binstr,cmdstr);
+  Replace(cmdstr,'$RES','@'+maybequoted(outputexedir+Info.ResName));
+  Replace(cmdstr,'$OPT',Info.ExtraOptions);
+  success:=DoExec(FindUtil(utilsprefix+BinStr),cmdstr,true,false);
+
+  { Remove ReponseFile }
+  if (success) and not(cs_link_nolink in current_settings.globalswitches) then
+    DeleteFile(outputexedir+Info.ResName);
+
+  MakeExecutable:=success;   { otherwise a recursive call to link method }
+end;
+
+
+{*****************************************************************************
+                                     Initialize
+*****************************************************************************}
+
+initialization
+  RegisterLinker(ld_win16,TExternalLinkerWin16WLink);
+  RegisterImport(system_i8086_win16,TImportLibWin16);
+  RegisterTarget(system_i8086_win16_info);
+end.

+ 3 - 0
rtl/win16/prt0c.asm

@@ -0,0 +1,3 @@
+; nasm -f obj -o prt0c.o prt0c.asm
+%define __COMPACT__
+%include "prt0comn.asm"

+ 66 - 0
rtl/win16/prt0comn.asm

@@ -0,0 +1,66 @@
+; common startup code for all the memory models
+
+%ifdef __TINY__
+        %define __NEAR_CODE__
+        %define __NEAR_DATA__
+%elifdef __SMALL__
+        %define __NEAR_CODE__
+        %define __NEAR_DATA__
+%elifdef __MEDIUM__
+        %define __FAR_CODE__
+        %define __NEAR_DATA__
+%elifdef __COMPACT__
+        %define __NEAR_CODE__
+        %define __FAR_DATA__
+%elifdef __LARGE__
+        %define __FAR_CODE__
+        %define __FAR_DATA__
+%elifdef __HUGE__
+        %define __FAR_CODE__
+        %define __FAR_DATA__
+%else
+        %fatal "Memory model not defined."
+%endif
+
+        cpu 8086
+        segment _TEXT use16 class=CODE align=1
+
+        extern PASCALMAIN
+
+        extern InitTask
+        extern WaitEvent
+        extern InitApp
+
+..start:
+        call far InitTask
+        test ax, ax
+        jz error
+
+        mov [hInst], di
+
+        xor ax, ax
+        push ax
+        call far WaitEvent
+        push word [hInst]
+        call far InitApp
+        test ax, ax
+        jz error
+
+%ifdef __FAR_CODE__
+        jmp far PASCALMAIN
+%else
+        jmp PASCALMAIN
+%endif
+
+error:
+        mov ax, 4cffh
+        int 21h
+
+
+        segment _DATA use16 class=DATA align=2
+        dw 0,0,5,0,0,0,0,0
+hInst:  dw 0
+
+        segment _STACK stack class=STACK align=16
+
+        group DGROUP _DATA _STACK

+ 3 - 0
rtl/win16/prt0h.asm

@@ -0,0 +1,3 @@
+; nasm -f obj -o prt0h.o prt0h.asm
+%define __HUGE__
+%include "prt0comn.asm"

+ 3 - 0
rtl/win16/prt0l.asm

@@ -0,0 +1,3 @@
+; nasm -f obj -o prt0l.o prt0l.asm
+%define __LARGE__
+%include "prt0comn.asm"

+ 3 - 0
rtl/win16/prt0m.asm

@@ -0,0 +1,3 @@
+; nasm -f obj -o prt0m.o prt0m.asm
+%define __MEDIUM__
+%include "prt0comn.asm"

+ 3 - 0
rtl/win16/prt0s.asm

@@ -0,0 +1,3 @@
+; nasm -f obj -o prt0s.o prt0s.asm
+%define __SMALL__
+%include "prt0comn.asm"

+ 3 - 0
rtl/win16/prt0t.asm

@@ -0,0 +1,3 @@
+; nasm -f obj -o prt0t.o prt0t.asm
+%define __TINY__
+%include "prt0comn.asm"

+ 32 - 0
rtl/win16/system.pp

@@ -0,0 +1,32 @@
+unit system;
+
+interface
+
+type
+  HResult=word;
+  LPCTSTR=^char;far;
+
+procedure fpc_InitializeUnits;compilerproc;
+procedure fpc_do_exit;compilerproc;
+
+procedure InitTask;external 'KERNEL';
+procedure WaitEvent;external 'KERNEL';
+procedure InitApp;external 'USER';
+procedure MessageBox(hWnd: word; lpText, lpCaption: LPCTSTR; uType: word);external 'USER';
+
+implementation
+
+procedure fpc_InitializeUnits;[public,alias:'FPC_INITIALIZEUNITS'];compilerproc;
+begin
+  MessageBox(0, 'Hello, world!', 'yo', 0);
+end;
+
+procedure fpc_do_exit;[public,alias:'FPC_DO_EXIT'];compilerproc;
+begin
+  asm
+    mov ax, 4c00h
+    int 21h
+  end;
+end;
+
+end.