mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-14 16:19:35 +02:00
+ implemented the tiny memory model for i8086-msdos; we now produce working dos .com files as well
git-svn-id: trunk@24793 -
This commit is contained in:
nickysn
parent
f3273fa87d
commit
b409d600ee
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -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
|
||||
|
||||
@ -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)}
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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,
|
||||
|
||||
@ -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'
|
||||
|
||||
@ -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 }
|
||||
|
||||
@ -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 }
|
||||
|
||||
@ -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}
|
||||
|
||||
213
rtl/msdos/prt0t.asm
Normal file
213
rtl/msdos/prt0t.asm
Normal file
@ -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
|
||||
Loading…
Reference in New Issue
Block a user