+ implemented the tiny memory model for i8086-msdos; we now produce working dos .com files as well

git-svn-id: trunk@24793 -

.gitattributes

@@ -8263,6 +8263,7 @@ rtl/msdos/dos.pp svneol=native#text/plain
 rtl/msdos/msmouse.pp svneol=native#text/plain
 rtl/msdos/ports.pp svneol=native#text/plain
 rtl/msdos/prt0.asm svneol=native#text/plain
+rtl/msdos/prt0t.asm svneol=native#text/plain
 rtl/msdos/registers.inc svneol=native#text/plain
 rtl/msdos/sysdir.inc svneol=native#text/plain
 rtl/msdos/sysfile.inc svneol=native#text/plain

compiler/globals.pas

@@ -154,6 +154,8 @@ interface
 
          disabledircache : boolean;
 
+         x86memorymodel  : tx86memorymodel;
+
         { CPU targets with microcontroller support can add a controller specific unit }
 {$if defined(ARM) or defined(AVR)}
         controllertype   : tcontrollertype;
@@ -477,6 +479,7 @@ interface
         minfpconstprec : s32real;
 
         disabledircache : false;
+        x86memorymodel : mm_small;
 {$if defined(ARM) or defined(AVR)}
         controllertype : ct_none;
 {$endif defined(ARM) or defined(AVR)}

compiler/globtype.pas

@@ -669,6 +669,8 @@ interface
         state : tmsgstate;
       end;
 
+    type
+      tx86memorymodel = (mm_tiny,mm_small,mm_medium,mm_compact,mm_large,mm_huge);
 
   { hide Sysutils.ExecuteProcess in units using this one after SysUtils}
   const

compiler/msg/errore.msg

@@ -3333,6 +3333,7 @@ new features, etc.):
 #    3 = 80x86 targets
 #    4 = x86_64
 #    6 = 680x0 targets
+#    8 = 8086 (16-bit) targets
 #    A = ARM
 #    e = in extended debug mode only
 #    F = help for the 'fpc' binary (independent of the target compiler)
@@ -3630,6 +3631,9 @@ p*2Wi_Use internal resources (Darwin)
 3*2WI_Turn on/off the usage of import sections (Windows)
 4*2WI_Turn on/off the usage of import sections (Windows)
 A*2WI_Turn on/off the usage of import sections (Windows)
+8*2Wm<x>_Set memory model
+8*3WmTiny_Tiny memory model
+8*3WmSmall_Small memory model (default)
 3*2WM<x>_Minimum Mac OS X deployment version: 10.4, 10.5.1, ... (Darwin)
 4*2WM<x>_Minimum Mac OS X deployment version: 10.4, 10.5.1, ... (Darwin)
 p*2WM<x>_Minimum Mac OS X deployment version: 10.4, 10.5.1, ... (Darwin)

compiler/msgidx.inc

@@ -973,7 +973,7 @@ const
   option_info=11024;
   option_help_pages=11025;
 
-  MsgTxtSize = 68861;
+  MsgTxtSize = 68955;
 
   MsgIdxMax : array[1..20] of longint=(
     26,93,334,121,88,56,126,27,202,63,

compiler/msgtxt.inc

@@ -1,7 +1,7 @@
 {$ifdef Delphi}
-const msgtxt : array[0..000286] of string[240]=(
+const msgtxt : array[0..000287] of string[240]=(
 {$else Delphi}
-const msgtxt : array[0..000286,1..240] of char=(
+const msgtxt : array[0..000287,1..240] of char=(
 {$endif Delphi}
   '01000_T_Compiler: $1'#000+
   '01001_D_Compiler OS: $1'#000+
@@ -1531,51 +1531,54 @@ const msgtxt : array[0..000286,1..240] of char=(
   '3*2WI_Turn on/off the usage of import sections (Windows)'#010+
   '4*2WI_Turn on/off the usage of import sections (Windows)'#010+
   'A*2WI_Turn on/off the usage of import sections (Windows)',#010+
+  '8*2Wm<x>_Set memory model'#010+
+  '8*3WmTiny_Tiny memory model'#010+
+  '8*3WmSmall_Small memory model (default)'#010+
   '3*2WM<x>_Minimum Mac OS X deployment version: 10.4, 10.5.1, ... (Darwi'+
   'n)'#010+
   '4*2WM<x>_Minimum Mac OS X deployment version: 10.4, 10.5.1, ... (Darwi'+
-  'n)'#010+
+  'n)',#010+
   'p*2WM<x>_Minimum Mac OS X deployment version: 10.4, 10.5.1, ... (Darwi'+
   'n)'#010+
-  'P*2WM<x>_Minimum Mac',' OS X deployment version: 10.4, 10.5.1, ... (Dar'+
-  'win)'#010+
+  'P*2WM<x>_Minimum Mac OS X deployment version: 10.4, 10.5.1, ... (Darwi'+
+  'n)'#010+
   '3*2WN_Do not generate relocation code, needed for debugging (Windows)'#010+
-  '4*2WN_Do not generate relocation code, needed for debugging (Windows)'#010+
-  'A*2WN_Do not generate relocation code, needed f','or debugging (Windows'+
+  '4*2WN_Do not generate r','elocation code, needed for debugging (Windows'+
   ')'#010+
+  'A*2WN_Do not generate relocation code, needed for debugging (Windows)'#010+
   'A*2Wpxxxx_Specify the controller type, see fpc -i for possible values'#010+
-  'V*2Wpxxxx_Specify the controller type, see fpc -i for possible values'#010+
+  'V*2Wpxxxx_Specify the controller type, see fpc -i for',' possible value'+
+  's'#010+
   '3*2WP<x>_Minimum iOS deployment version: 3.0, 5.0.1, ... (iphonesim)'#010+
-  'A*2WP<x>','_Minimum iOS deployment version: 3.0, 5.0.1, ... (Darwin)'#010+
+  'A*2WP<x>_Minimum iOS deployment version: 3.0, 5.0.1, ... (Darwin)'#010+
   '3*2WR_Generate relocation code (Windows)'#010+
   '4*2WR_Generate relocation code (Windows)'#010+
-  'A*2WR_Generate relocation code (Windows)'#010+
+  'A*2WR_','Generate relocation code (Windows)'#010+
   'P*2WT_Specify MPW tool type application (Classic Mac OS)'#010+
-  '**','2WX_Enable executable stack (Linux)'#010+
+  '**2WX_Enable executable stack (Linux)'#010+
   '**1X_Executable options:'#010+
   '**2Xc_Pass --shared/-dynamic to the linker (BeOS, Darwin, FreeBSD, Lin'+
   'ux)'#010+
-  '**2Xd_Do not search default library path (sometimes required for cross'+
-  '-compiling when not using -XR)'#010+
-  '**2X','e_Use external linker'#010+
+  '**2Xd_Do no','t search default library path (sometimes required for cro'+
+  'ss-compiling when not using -XR)'#010+
+  '**2Xe_Use external linker'#010+
   '**2Xg_Create debuginfo in a separate file and add a debuglink section '+
   'to executable'#010+
-  '**2XD_Try to link units dynamically      (defines FPC_LINK_DYNAMIC)'#010+
+  '**2XD_Try to link units dynamically     ',' (defines FPC_LINK_DYNAMIC)'#010+
   '**2Xi_Use internal linker'#010+
   '**2Xm_Generate link map'#010+
-  '**2XM<x>_Set the',' name of the '#039'main'#039' program routine (default'+
-  ' is '#039'main'#039')'#010+
+  '**2XM<x>_Set the name of the '#039'main'#039' program routine (default i'+
+  's '#039'main'#039')'#010+
   'F*2Xp<x>_First search for the compiler binary in the directory <x>'#010+
-  '**2XP<x>_Prepend the binutils names with the prefix <x>'#010+
-  '**2Xr<x>_Set the linker'#039's rlink-path to <x> (needed for cross',' co'+
-  'mpile, see the ld manual for more information) (BeOS, Linux)'#010+
+  '**2XP<x>_Prepend the bi','nutils names with the prefix <x>'#010+
+  '**2Xr<x>_Set the linker'#039's rlink-path to <x> (needed for cross comp'+
+  'ile, see the ld manual for more information) (BeOS, Linux)'#010+
   '**2XR<x>_Prepend <x> to all linker search paths (BeOS, Darwin, FreeBSD'+
-  ', Linux, Mac OS, Solaris)'#010+
+  ', Linux, Mac',' OS, Solaris)'#010+
   '**2Xs_Strip all symbols from executable'#010+
-  '**2XS_Try to link units statically (defa','ult, defines FPC_LINK_STATIC'+
-  ')'#010+
+  '**2XS_Try to link units statically (default, defines FPC_LINK_STATIC)'#010+
   '**2Xt_Link with static libraries (-static is passed to linker)'#010+
-  '**2XX_Try to smartlink units             (defines FPC_LINK_SMART)'#010+
+  '**2XX_Try to smartlink units             (defines FPC','_LINK_SMART)'#010+
   '**1*_'#010+
   '**1?_Show this help'#010+
   '**1h_Shows this help without waiting'

compiler/options.pas

@@ -399,6 +399,9 @@ begin
 {$ifdef m68k}
       '6',
 {$endif}
+{$ifdef i8086}
+      '8',
+{$endif}
 {$ifdef arm}
       'A',
 {$endif}
@@ -1841,6 +1844,26 @@ begin
                         else
                           IllegalPara(opt);
                       end;
+                    'm':
+                      begin
+                        if (target_info.system in [system_i8086_msdos]) then
+                          begin
+                            Writeln('>', Upper(Copy(More,j+1,255)), '<');
+                            case Upper(Copy(More,j+1,255)) of
+                              'TINY':  init_settings.x86memorymodel:=mm_tiny;
+                              'SMALL': init_settings.x86memorymodel:=mm_small;
+                              'MEDIUM',
+                              'COMPACT',
+                              'LARGE',
+                              'HUGE': IllegalPara(opt); { these are not implemented yet }
+                              else
+                                IllegalPara(opt);
+                            end;
+                            break;
+                          end
+                        else
+                          IllegalPara(opt);
+                      end;
                     'M':
                       begin
                         if (target_info.system in (systems_darwin-[system_i386_iphonesim])) and
@@ -3379,6 +3402,16 @@ if (target_info.abi = abi_eabihf) then
         def_system_macro('FPC_HAS_INTERNAL_BSF');
     end;
 {$endif}
+{$if defined(i8086)}
+  case init_settings.x86memorymodel of
+    mm_tiny:    def_system_macro('FPC_MM_TINY');
+    mm_small:   def_system_macro('FPC_MM_SMALL');
+    mm_medium:  def_system_macro('FPC_MM_MEDIUM');
+    mm_compact: def_system_macro('FPC_MM_COMPACT');
+    mm_large:   def_system_macro('FPC_MM_LARGE');
+    mm_huge:    def_system_macro('FPC_MM_HUGE');
+  end;
+{$endif}
 
 
   { Section smartlinking conflicts with import sections on Windows }

compiler/systems/t_msdos.pas

@@ -246,7 +246,10 @@ begin
     DOS command line is limited to 126 characters! }
 
   { add objectfiles, start with prt0 always }
-  LinkRes.Add('file ' + maybequoted(FindObjectFile('prt0','',false)));
+  if current_settings.x86memorymodel=mm_tiny then
+    LinkRes.Add('file ' + maybequoted(FindObjectFile('prt0t','',false)))
+  else
+    LinkRes.Add('file ' + maybequoted(FindObjectFile('prt0','',false)));
   while not ObjectFiles.Empty do
   begin
     s:=ObjectFiles.GetFirst;
@@ -259,8 +262,13 @@ begin
     if s<>'' then
       LinkRes.Add('library '+MaybeQuoted(s));
   end;
-  LinkRes.Add('format dos');
+  if current_settings.x86memorymodel=mm_tiny then
+    LinkRes.Add('format dos com')
+  else
+    LinkRes.Add('format dos');
   LinkRes.Add('option dosseg');
+{  if current_settings.x86memorymodel=mm_tiny then
+    LinkRes.Add('system com');}
   LinkRes.Add('name ' + maybequoted(current_module.exefilename));
 
   { Write and Close response }

compiler/x86/agx86nsm.pas

@@ -1065,15 +1065,23 @@ interface
           internalerror(2013050101);
       end;
 
-      { NASM complains if you put a missing section in the GROUP directive, so }
-      { we add empty declarations to make sure they exist, even if empty }
-      AsmWriteLn('SECTION .rodata');
-      AsmWriteLn('SECTION .data');
-      { WLINK requires class=bss in order to leave the BSS section out of the executable }
-      AsmWriteLn('SECTION .bss class=bss');
-      { group these sections in the same segment }
-      AsmWriteLn('GROUP dgroup rodata data bss');
-      AsmWriteLn('SECTION .text');
+      if current_settings.x86memorymodel in [mm_small,mm_tiny] then
+        begin
+          { NASM complains if you put a missing section in the GROUP directive, so }
+          { we add empty declarations to make sure they exist, even if empty }
+          if current_settings.x86memorymodel=mm_tiny then
+            AsmWriteLn('SECTION .text');
+          AsmWriteLn('SECTION .rodata');
+          AsmWriteLn('SECTION .data');
+          { WLINK requires class=bss in order to leave the BSS section out of the executable }
+          AsmWriteLn('SECTION .bss class=bss');
+          { group these sections in the same segment }
+          if current_settings.x86memorymodel=mm_tiny then
+            AsmWriteLn('GROUP dgroup text rodata data bss')
+          else
+            AsmWriteLn('GROUP dgroup rodata data bss');
+          AsmWriteLn('SECTION .text');
+        end;
 {$else i8086}
       AsmWriteLn('BITS 32');
 {$endif i8086}

rtl/msdos/prt0t.asm

@@ -0,0 +1,213 @@
+; nasm -f obj -o prt0.o prt0.asm
+%define TINY
+
+        cpu 8086
+
+        segment text use16
+
+        extern PASCALMAIN
+        extern dos_psp
+        extern dos_version
+
+        extern _edata  ; defined by WLINK, indicates start of BSS
+        extern _end    ; defined by WLINK, indicates end of BSS
+
+        extern __stklen
+        extern __stkbottom
+
+        extern __nearheap_start
+        extern __nearheap_end
+
+%ifdef TINY
+        resb 0100h
+%endif
+..start:
+%ifdef TINY
+        mov bx, cs
+%else
+        ; init the stack
+        mov bx, dgroup
+        mov ss, bx
+        mov sp, stacktop
+%endif
+
+        ; zero fill the BSS section
+        mov es, bx
+        mov di, _edata wrt dgroup
+        mov cx, _end wrt dgroup
+        sub cx, di
+        jz no_bss
+        xor al, al
+        rep stosb
+no_bss:
+
+        ; save the Program Segment Prefix
+        push ds
+
+        ; init DS
+        mov ds, bx
+
+        ; pop the PSP from stack and store it in the pascal variable dos_psp
+        pop ax
+        mov word [dos_psp], ax
+
+        ; get DOS version and save it in the pascal variable dos_version
+        mov ax, 3000h
+        int 21h
+        xchg al, ah
+        mov word [dos_version], ax
+
+        ; allocate max heap
+        ; TODO: also support user specified heap size
+        ; try to resize our main DOS memory block until the end of the data segment
+%ifdef TINY
+        mov cx, cs
+        mov dx, 1000h  ; 64kb in paragraphs
+%else
+        mov dx, word [dos_psp]
+        mov cx, dx
+        sub dx, dgroup
+        neg dx  ; dx = (ds - psp) in paragraphs
+        add dx, 1000h  ; 64kb in paragraphs
+%endif
+
+         ; get our MCB size in paragraphs
+        dec cx
+        mov es, cx
+        mov bx, word [es:3]
+
+        ; is it smaller than the maximum data segment size?
+        cmp bx, dx
+        jbe skip_mem_realloc
+
+        mov bx, dx
+        inc cx
+        mov es, cx
+        mov ah, 4Ah
+        int 21h
+        jc mem_realloc_err
+
+skip_mem_realloc:
+
+        ; bx = the new size in paragraphs
+%ifndef TINY
+        add bx, word [dos_psp]
+        sub bx, dgroup
+%endif
+        mov cl, 4
+        shl bx, cl
+        sub bx, 2
+        mov sp, bx
+
+        add bx, 2
+        sub bx, word [__stklen]
+        and bl, 0FEh
+        mov word [__stkbottom], bx
+
+        cmp bx, _end wrt dgroup
+        jb not_enough_mem
+
+        ; heap is between [ds:_end wrt dgroup] and [ds:__stkbottom - 1]
+        mov word [__nearheap_start], _end wrt dgroup
+        mov bx, word [__stkbottom]
+        dec bx
+        mov word [__nearheap_end], bx
+
+        int 3
+        jmp PASCALMAIN
+
+not_enough_mem:
+        mov dx, not_enough_mem_msg
+        jmp error_msg
+
+mem_realloc_err:
+        mov dx, mem_realloc_err_msg
+error_msg:
+        mov ah, 9
+        int 21h
+        mov ax, 4CFFh
+        int 21h
+
+        global FPC_MSDOS_CARRY
+FPC_MSDOS_CARRY:
+        stc
+        global FPC_MSDOS
+FPC_MSDOS:
+        mov al, 21h  ; not ax, because only the low byte is used
+        pop dx
+        pop cx
+        push ax
+        push cx
+        push dx
+        global FPC_INTR
+FPC_INTR:
+        push bp
+        mov bp, sp
+        mov al, byte [ss:bp + 6]
+        mov byte [cs:int_number], al
+        mov si, [ss:bp + 4]
+        push ds
+        mov ax, word [si + 16]
+        mov es, ax
+        mov ax, word [si + 14]  ; ds
+        push ax
+        mov ax, word [si]
+        mov bx, word [si + 2]
+        mov cx, word [si + 4]
+        mov dx, word [si + 6]
+        mov bp, word [si + 8]
+        mov di, word [si + 12]
+        mov si, word [si + 10]
+        
+        pop ds
+        db 0CDh  ; opcode of INT xx
+int_number:
+        db 255
+        
+        pushf
+        push ds
+        push si
+        push bp
+        mov bp, sp
+        mov si, word [ss:bp + 8]
+        mov ds, si
+        mov si, word [ss:bp + 14]
+        mov word [si], ax
+        mov word [si + 2], bx
+        mov word [si + 4], cx
+        mov word [si + 6], dx
+        mov word [si + 12], di
+        mov ax, es
+        mov word [si + 16], ax
+        pop ax
+        mov word [si + 8], ax
+        pop ax
+        mov word [si + 10], ax
+        pop ax
+        mov word [si + 14], ax
+        pop ax
+        mov word [si + 18], ax
+        
+        pop ds
+        pop bp
+        ret 4
+
+        segment data
+mem_realloc_err_msg:
+        db 'Memory allocation error', 13, 10, '$'
+not_enough_mem_msg:
+        db 'Not enough memory', 13, 10, '$'
+
+        segment bss class=bss
+
+%ifndef TINY
+        segment stack stack class=stack
+        resb 256
+        stacktop:
+%endif
+
+%ifdef TINY
+        group dgroup text data bss
+%else
+        group dgroup data bss stack
+%endif