From b409d600ee4a8235e84f3cf4644875752cbbf274 Mon Sep 17 00:00:00 2001 From: nickysn Date: Sun, 2 Jun 2013 23:02:10 +0000 Subject: [PATCH] + implemented the tiny memory model for i8086-msdos; we now produce working dos .com files as well git-svn-id: trunk@24793 - --- .gitattributes | 1 + compiler/globals.pas | 3 + compiler/globtype.pas | 2 + compiler/msg/errore.msg | 4 + compiler/msgidx.inc | 2 +- compiler/msgtxt.inc | 51 +++++---- compiler/options.pas | 33 ++++++ compiler/systems/t_msdos.pas | 12 +- compiler/x86/agx86nsm.pas | 26 +++-- rtl/msdos/prt0t.asm | 213 +++++++++++++++++++++++++++++++++++ 10 files changed, 311 insertions(+), 36 deletions(-) create mode 100644 rtl/msdos/prt0t.asm diff --git a/.gitattributes b/.gitattributes index 356a1a14ec..33c5f31cef 100644 --- a/.gitattributes +++ b/.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 diff --git a/compiler/globals.pas b/compiler/globals.pas index bd9809559c..fd67133d71 100644 --- a/compiler/globals.pas +++ b/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)} diff --git a/compiler/globtype.pas b/compiler/globtype.pas index f98eba2593..570bb891a7 100644 --- a/compiler/globtype.pas +++ b/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 diff --git a/compiler/msg/errore.msg b/compiler/msg/errore.msg index e8e791dbe4..005844473e 100644 --- a/compiler/msg/errore.msg +++ b/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_Set memory model +8*3WmTiny_Tiny memory model +8*3WmSmall_Small memory model (default) 3*2WM_Minimum Mac OS X deployment version: 10.4, 10.5.1, ... (Darwin) 4*2WM_Minimum Mac OS X deployment version: 10.4, 10.5.1, ... (Darwin) p*2WM_Minimum Mac OS X deployment version: 10.4, 10.5.1, ... (Darwin) diff --git a/compiler/msgidx.inc b/compiler/msgidx.inc index ea6b2ebbec..ccc4bf2955 100644 --- a/compiler/msgidx.inc +++ b/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, diff --git a/compiler/msgtxt.inc b/compiler/msgtxt.inc index 7e10ec579a..8909dae6a9 100644 --- a/compiler/msgtxt.inc +++ b/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_Set memory model'#010+ + '8*3WmTiny_Tiny memory model'#010+ + '8*3WmSmall_Small memory model (default)'#010+ '3*2WM_Minimum Mac OS X deployment version: 10.4, 10.5.1, ... (Darwi'+ 'n)'#010+ '4*2WM_Minimum Mac OS X deployment version: 10.4, 10.5.1, ... (Darwi'+ - 'n)'#010+ + 'n)',#010+ 'p*2WM_Minimum Mac OS X deployment version: 10.4, 10.5.1, ... (Darwi'+ 'n)'#010+ - 'P*2WM_Minimum Mac',' OS X deployment version: 10.4, 10.5.1, ... (Dar'+ - 'win)'#010+ + 'P*2WM_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_Minimum iOS deployment version: 3.0, 5.0.1, ... (iphonesim)'#010+ - 'A*2WP','_Minimum iOS deployment version: 3.0, 5.0.1, ... (Darwin)'#010+ + 'A*2WP_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_Set the',' name of the '#039'main'#039' program routine (default'+ - ' is '#039'main'#039')'#010+ + '**2XM_Set the name of the '#039'main'#039' program routine (default i'+ + 's '#039'main'#039')'#010+ 'F*2Xp_First search for the compiler binary in the directory '#010+ - '**2XP_Prepend the binutils names with the prefix '#010+ - '**2Xr_Set the linker'#039's rlink-path to (needed for cross',' co'+ - 'mpile, see the ld manual for more information) (BeOS, Linux)'#010+ + '**2XP_Prepend the bi','nutils names with the prefix '#010+ + '**2Xr_Set the linker'#039's rlink-path to (needed for cross comp'+ + 'ile, see the ld manual for more information) (BeOS, Linux)'#010+ '**2XR_Prepend 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' diff --git a/compiler/options.pas b/compiler/options.pas index e32367e478..d6439e7df3 100644 --- a/compiler/options.pas +++ b/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 } diff --git a/compiler/systems/t_msdos.pas b/compiler/systems/t_msdos.pas index 413b71e37d..f93689ce62 100644 --- a/compiler/systems/t_msdos.pas +++ b/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 } diff --git a/compiler/x86/agx86nsm.pas b/compiler/x86/agx86nsm.pas index 49eabe86e5..f5feff4016 100644 --- a/compiler/x86/agx86nsm.pas +++ b/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} diff --git a/rtl/msdos/prt0t.asm b/rtl/msdos/prt0t.asm new file mode 100644 index 0000000000..8a50bb6b4d --- /dev/null +++ b/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