diff --git a/rtl/os2/sysos2.pas b/rtl/os2/sysos2.pas index 96546b11bc..266b9f9173 100644 --- a/rtl/os2/sysos2.pas +++ b/rtl/os2/sysos2.pas @@ -1,9 +1,9 @@ {**************************************************************************** - FPK-Pascal -- OS/2 runtime library + FPK-Pascal -- OS/2 runtime library - Copyright (c) 1993,95 by Florian Kl„mpfl - Copyright (c) 1997 by Dani‰l Mantione + Copyright (c) 1993,95 by Florian Kl„mpfl + Copyright (c) 1997 by Dani‰l Mantione FPK-Pascal is distributed under the GNU Public License v2. So is this unit. The GNU Public License requires you to distribute the source code of this @@ -32,19 +32,19 @@ unit sysos2; {Changelog: - People: + People: - DM - Dani‰l Mantione + DM - Dani‰l Mantione - Date: Description of change: Changed by: + Date: Description of change: Changed by: - - First released version 0.1. DM + - First released version 0.1. DM Coding style: - My coding style is a bit unusual for Pascal. Nevertheless I friendly ask - you to try to make your changes not look all to different. In general, - set your IDE to use tab characters, optimal fill on and a tabsize of 4.} + My coding style is a bit unusual for Pascal. Nevertheless I friendly ask + you to try to make your changes not look all to different. In general, + set your IDE to use tab characters, optimal fill on and a tabsize of 4.} {$I os.inc} @@ -53,66 +53,67 @@ interface {Link the startup code.} {$l prt1.oo2} -{$I SYSTEMH.INC} -{$I heaph.inc} +{$I SYSTEMH.INC} +{$I heaph.inc} -type Tos=(osDOS,osOS2,osDPMI); +type Tos=(osDOS,osOS2,osDPMI); -var os_mode:Tos; - first_meg:pointer; +var os_mode:Tos; + first_meg:pointer; -type Psysthreadib=^Tsysthreadib; - Pthreadinfoblock=^Tthreadinfoblock; - Pprocessinfoblock=^Tprocessinfoblock; +type Psysthreadib=^Tsysthreadib; + Pthreadinfoblock=^Tthreadinfoblock; + Pprocessinfoblock=^Tprocessinfoblock; - Tbytearray=array[0..$ffff] of byte; - Pbytearray=^Tbytearray; + Tbytearray=array[0..$ffff] of byte; + Pbytearray=^Tbytearray; - Tsysthreadib=record - tid, - priority, - version:longint; - MCcount, - MCforceflag:word; - end; + Tsysthreadib=record + tid, + priority, + version:longint; + MCcount, + MCforceflag:word; + end; - Tthreadinfoblock=record - pexchain, - stack, - stacklimit:pointer; - tib2:Psysthreadib; - version, - ordinal:longint; - end; + Tthreadinfoblock=record + pexchain, + stack, + stacklimit:pointer; + tib2:Psysthreadib; + version, + ordinal:longint; + end; - Tprocessinfoblock=record - pid, - parentpid, - hmte:longint; - cmd, - env:Pbytearray; - flstatus, - ttype:longint; - end; + Tprocessinfoblock=record + pid, + parentpid, + hmte:longint; + cmd, + env:Pbytearray; + flstatus, + ttype:longint; + end; -const UnusedHandle=$ffff; - StdInputHandle=0; - StdOutputHandle=1; - StdErrorHandle=2; +const UnusedHandle=$ffff; + StdInputHandle=0; + StdOutputHandle=1; + StdErrorHandle=2; implementation -{ die betriebssystemunabhangigen Implementationen einfuegen: } - -{$I SYSTEM.INC} +{$I SYSTEM.INC} procedure dosgetinfoblocks(var Atib:Pthreadinfoblock; - var Apib:Pprocessinfoblock); - external 'DOSCALLS' index 312; + var Apib:Pprocessinfoblock); + external 'DOSCALLS' index 312; + +{This is the correct way to call external assembler procedures.} +procedure syscall;external name '___SYSCALL'; {*************************************************************************** - Runtime error checking related routines. + Runtime error checking related routines. ***************************************************************************} @@ -120,106 +121,106 @@ procedure dosgetinfoblocks(var Atib:Pthreadinfoblock; procedure st1(stack_size:longint);[public,alias: 'STACKCHECK']; begin - { called when trying to get local stack } - { if the compiler directive $S is set } - asm - movl stack_size,%ebx - movl %esp,%eax - subl %ebx,%eax + { called when trying to get local stack } + { if the compiler directive $S is set } + asm + movl stack_size,%ebx + movl %esp,%eax + subl %ebx,%eax {$ifdef SYSTEMDEBUG} - movl U_SYSOS2_LOWESTSTACK,%ebx - cmpl %eax,%ebx - jb _is_not_lowest - movl %eax,U_SYSOS2_LOWESTSTACK - _is_not_lowest: + movl U_SYSOS2_LOWESTSTACK,%ebx + cmpl %eax,%ebx + jb .Lis_not_lowest + movl %eax,U_SYSOS2_LOWESTSTACK + .Lis_not_lowest: {$endif SYSTEMDEBUG} - cmpb $2,U_SYSOS2_OS_MODE - jne _running_in_dos - movl U_SYSOS2_STACKBOTTOM,%ebx - jmp _running_in_os2 - _running_in_dos: - movl __heap_brk,%ebx - _running_in_os2: - cmpl %eax,%ebx - jae __short_on_stack - leave - ret $4 - __short_on_stack: - end ['EAX','EBX']; - { this needs a local variable } - { so the function called itself !! } - { Writeln('low in stack ');} - RunError(202); + cmpb $2,U_SYSOS2_OS_MODE + jne .Lrunning_in_dos + movl U_SYSOS2_STACKBOTTOM,%ebx + jmp .Lrunning_in_os2 + .Lrunning_in_dos: + movl __heap_brk,%ebx + .Lrunning_in_os2: + cmpl %eax,%ebx + jae .Lshort_on_stack + leave + ret $4 + .Lshort_on_stack: + end ['EAX','EBX']; + { this needs a local variable } + { so the function called itself !! } + { Writeln('low in stack ');} + RunError(202); end; {no stack check in system } {**************************************************************************** - Miscelleanious related routines. + Miscelleanious related routines. ****************************************************************************} procedure halt(errnum:byte); begin - asm - movb $0x4c,%ah - movb errnum,%al - call ___SYSCALL - end; + asm + movb $0x4c,%ah + movb errnum,%al + call syscall + end; end; function paramcount:longint; begin - asm - movl _argc,%eax - decl %eax - leave - ret - end ['EAX']; + asm + movl _argc,%eax + decl %eax + leave + ret + end ['EAX']; end; function paramstr(l:longint):string; - function args:pointer; + function args:pointer; - begin - asm - movl _argv,%eax - leave - ret - end ['EAX']; - end; + begin + asm + movl _argv,%eax + leave + ret + end ['EAX']; + end; -var p:^Pchar; +var p:^Pchar; begin - if (l>=0) and (l<=paramcount) then - begin - p:=args; - paramstr:=strpas(p[l]); - end - else paramstr:=''; + if (l>=0) and (l<=paramcount) then + begin + p:=args; + paramstr:=strpas(p[l]); + end + else paramstr:=''; end; procedure randomize; -var hl:longint; +var hl:longint; begin - asm - movb $0x2c,%ah - call ___SYSCALL - movw %cx,-4(%ebp) - movw %dx,-2(%ebp) - end; - randseed:=hl; + asm + movb $0x2c,%ah + call syscall + movw %cx,-4(%ebp) + movw %dx,-2(%ebp) + end; + randseed:=hl; end; {**************************************************************************** - Heap management releated routines. + Heap management releated routines. ****************************************************************************} @@ -230,29 +231,29 @@ syscall $7f00 resizes the brk area} function sbrk(size:longint):longint; begin - asm - movl size,%edx - movw $0x7f00,%ax - call ___SYSCALL - movl %eax,__RESULT - end; + asm + movl size,%edx + movw $0x7f00,%ax + call syscall + movl %eax,__RESULT + end; end; function getheapstart:pointer; begin - asm - movl __heap_base,%eax - leave - ret - end ['EAX']; + asm + movl __heap_base,%eax + leave + ret + end ['EAX']; end; -{$i heap.inc} +{$i heap.inc} {**************************************************************************** - Low Level File Routines + Low Level File Routines ****************************************************************************} @@ -260,169 +261,169 @@ procedure allowslash(p:Pchar); {Allow slash as backslash.} -var i:longint; +var i:longint; begin - for i:=0 to strlen(p) do - if p[i]='/' then p[i]:='\'; + for i:=0 to strlen(p) do + if p[i]='/' then p[i]:='\'; end; procedure do_close(h:longint); begin - asm - movb $0x3e,%ah - mov h,%ebx - call ___SYSCALL - end; + asm + movb $0x3e,%ah + mov h,%ebx + call syscall + end; end; procedure do_erase(p:Pchar); begin - allowslash(p); - asm - movl 8(%ebp),%edx - movb $0x41,%ah - call ___SYSCALL - jnc LERASE1 - movw %ax,U_SYSOS2_INOUTRES; - LERASE1: - end; + allowslash(p); + asm + movl 8(%ebp),%edx + movb $0x41,%ah + call syscall + jnc .LERASE1 + movw %ax,inoutres; + .LERASE1: + end; end; procedure do_rename(p1,p2:Pchar); begin - allowslash(p1); - allowslash(p2); - asm - movl 8(%ebp),%edx - movl 12(%ebp),%edi - movb $0x56,%ah - call ___SYSCALL - jnc LRENAME1 - movw %ax,U_SYSOS2_INOUTRES; - LRENAME1: - end; + allowslash(p1); + allowslash(p2); + asm + movl 8(%ebp),%edx + movl 12(%ebp),%edi + movb $0x56,%ah + call syscall + jnc .LRENAME1 + movw %ax,inoutres; + .LRENAME1: + end; end; function do_read(h,addr,len:longint):longint; begin - asm - movl 16(%ebp),%ecx - movl 12(%ebp),%edx - movl 8(%ebp),%ebx - movb $0x3f,%ah - call ___SYSCALL - jnc LDOSREAD1 - movw %ax,U_SYSOS2_INOUTRES; - xorl %eax,%eax - LDOSREAD1: - leave - ret $12 - end; + asm + movl 16(%ebp),%ecx + movl 12(%ebp),%edx + movl 8(%ebp),%ebx + movb $0x3f,%ah + call syscall + jnc .LDOSREAD1 + movw %ax,inoutres; + xorl %eax,%eax + .LDOSREAD1: + leave + ret $12 + end; end; function do_write(h,addr,len:longint) : longint; begin - asm - movl 16(%ebp),%ecx - movl 12(%ebp),%edx - movl 8(%ebp),%ebx - movb $0x40,%ah - call ___SYSCALL - jnc LDOSWRITE1 - movw %ax,U_SYSOS2_INOUTRES; - LDOSWRITE1: - movl %eax,-4(%ebp) - end; + asm + movl 16(%ebp),%ecx + movl 12(%ebp),%edx + movl 8(%ebp),%ebx + movb $0x40,%ah + call syscall + jnc .LDOSWRITE1 + movw %ax,inoutres; + .LDOSWRITE1: + movl %eax,-4(%ebp) + end; end; function do_filepos(handle:longint):longint; begin - asm - movw $0x4201,%ax - movl 8(%ebp),%ebx - xorl %edx,%edx - call ___SYSCALL - jnc LDOSFILEPOS - movw %ax,U_SYSOS2_INOUTRES; - xorl %eax,%eax - LDOSFILEPOS: - leave - ret $4 - end; + asm + movw $0x4201,%ax + movl 8(%ebp),%ebx + xorl %edx,%edx + call syscall + jnc .LDOSFILEPOS + movw %ax,inoutres; + xorl %eax,%eax + .LDOSFILEPOS: + leave + ret $4 + end; end; procedure do_seek(handle,pos:longint); begin - asm - movw $0x4200,%ax - movl 8(%ebp),%ebx - movl 12(%ebp),%edx - call ___SYSCALL - jnc .LDOSSEEK1 - movw %ax,U_SYSOS2_INOUTRES; - .LDOSSEEK1: - leave - ret $8 - end; + asm + movw $0x4200,%ax + movl 8(%ebp),%ebx + movl 12(%ebp),%edx + call syscall + jnc .LDOSSEEK1 + movw %ax,inoutres; + .LDOSSEEK1: + leave + ret $8 + end; end; function do_seekend(handle:longint):longint; begin - asm - movw $0x4202,%ax - movl 8(%ebp),%ebx - xorl %edx,%edx - call ___SYSCALL - jnc .Lset_at_end1 - movw %ax,U_SYSOS2_INOUTRES; - xorl %eax,%eax - .Lset_at_end1: - leave - ret $4 - end; + asm + movw $0x4202,%ax + movl 8(%ebp),%ebx + xorl %edx,%edx + call syscall + jnc .Lset_at_end1 + movw %ax,inoutres; + xorl %eax,%eax + .Lset_at_end1: + leave + ret $4 + end; end; function do_filesize(handle:longint):longint; -var aktfilepos:longint; +var aktfilepos:longint; begin - aktfilepos:=do_filepos(handle); - do_filesize:=do_seekend(handle); - do_seek(handle,aktfilepos); + aktfilepos:=do_filepos(handle); + do_filesize:=do_seekend(handle); + do_seek(handle,aktfilepos); end; procedure do_truncate(handle,pos:longint); begin - asm - movl $0x4200,%eax - movl 8(%ebp),%ebx - movl 12(%ebp),%edx - call ___SYSCALL - jc .LTruncate1 - movl 8(%ebp),%ebx - movl 12(%ebp),%edx - movl %ebp,%edx - xorl %ecx,%ecx - movb $0x40,%ah - call ___SYSCALL - jnc .LTruncate2 - .LTruncate1: - movw %ax,U_SYSOS2_INOUTRES; - .LTruncate2: - leave - ret $8 - end; + asm + movl $0x4200,%eax + movl 8(%ebp),%ebx + movl 12(%ebp),%edx + call syscall + jc .LTruncate1 + movl 8(%ebp),%ebx + movl 12(%ebp),%edx + movl %ebp,%edx + xorl %ecx,%ecx + movb $0x40,%ah + call syscall + jnc .LTruncate2 + .LTruncate1: + movw %ax,inoutres; + .LTruncate2: + leave + ret $8 + end; end; procedure do_open(var f;p:pchar;flags:longint); @@ -435,92 +436,92 @@ procedure do_open(var f;p:pchar;flags:longint); when (flags and $1000) there is no check for close (needed for textfiles) } -var oflags:byte; +var oflags:byte; begin - allowslash(p); - { close first if opened } - if ((flags and $1000)=0) then - begin - case filerec(f).mode of - fminput,fmoutput,fminout : Do_Close(filerec(f).handle); - fmclosed:; - else - begin - inoutres:=102; {not assigned} - exit; - end; - end; - end; - { reset file handle } - filerec(f).handle:=high(word); - oflags:=2; - { convert filemode to filerec modes } - case (flags and 3) of - 0 : begin - filerec(f).mode:=fminput; - oflags:=0; - end; - 1 : filerec(f).mode:=fmoutput; - 2 : filerec(f).mode:=fminout; - end; - if (flags and $100)<>0 then - begin - filerec(f).mode:=fmoutput; - oflags:=2; - end - else - if (flags and $10)<>0 then - begin - filerec(f).mode:=fmoutput; - oflags:=2; - end; - { empty name is special } - if p[0]=#0 then - begin - case filerec(f).mode of - fminput:filerec(f).handle:=StdInputHandle; - fmappend,fmoutput : begin - filerec(f).handle:=StdOutputHandle; - filerec(f).mode:=fmoutput; {fool fmappend} - end; - end; - exit; - end; - if (flags and $100)<>0 then - {Use create function.} - asm - movb $0x3c,%ah - movl p,%edx - xorw %cx,%cx - call ___SYSCALL - jnc LOPEN1 - movw %ax,U_SYSOS2_INOUTRES; - movw $0xffff,%ax - LOPEN1: - movl f,%edx - movw %ax,(%edx) - end - else - {Use open function.} - asm - movb $0x3d,%ah - movb oflags,%al - movl p,%edx - call ___SYSCALL - jnc LOPEN2 - movw %ax,U_SYSOS2_INOUTRES; - movw $0xffff,%ax - LOPEN2: - movl f,%edx - movw %ax,(%edx) - end; - if (flags and $10)<>0 then - do_seekend(filerec(f).handle); + allowslash(p); + { close first if opened } + if ((flags and $1000)=0) then + begin + case filerec(f).mode of + fminput,fmoutput,fminout : Do_Close(filerec(f).handle); + fmclosed:; + else + begin + inoutres:=102; {not assigned} + exit; + end; + end; + end; + { reset file handle } + filerec(f).handle:=high(word); + oflags:=2; + { convert filemode to filerec modes } + case (flags and 3) of + 0 : begin + filerec(f).mode:=fminput; + oflags:=0; + end; + 1 : filerec(f).mode:=fmoutput; + 2 : filerec(f).mode:=fminout; + end; + if (flags and $100)<>0 then + begin + filerec(f).mode:=fmoutput; + oflags:=2; + end + else + if (flags and $10)<>0 then + begin + filerec(f).mode:=fmoutput; + oflags:=2; + end; + { empty name is special } + if p[0]=#0 then + begin + case filerec(f).mode of + fminput:filerec(f).handle:=StdInputHandle; + fmappend,fmoutput : begin + filerec(f).handle:=StdOutputHandle; + filerec(f).mode:=fmoutput; {fool fmappend} + end; + end; + exit; + end; + if (flags and $100)<>0 then + {Use create function.} + asm + movb $0x3c,%ah + movl p,%edx + xorw %cx,%cx + call syscall + jnc .LOPEN1 + movw %ax,inoutres; + movw $0xffff,%ax + .LOPEN1: + movl f,%edx + movw %ax,(%edx) + end + else + {Use open function.} + asm + movb $0x3d,%ah + movb oflags,%al + movl p,%edx + call syscall + jnc .LOPEN2 + movw %ax,inoutres; + movw $0xffff,%ax + .LOPEN2: + movl f,%edx + movw %ax,(%edx) + end; + if (flags and $10)<>0 then + do_seekend(filerec(f).handle); end; {***************************************************************************** - UnTyped File Handling + UnTyped File Handling *****************************************************************************} {$i file.inc} @@ -541,192 +542,194 @@ end; {**************************************************************************** - Directory related routines. + Directory related routines. ****************************************************************************} {***************************************************************************** - Directory Handling + Directory Handling *****************************************************************************} procedure dosdir(func:byte;const s:string); -var buffer:array[0..255] of char; +var buffer:array[0..255] of char; begin - move(s[1],buffer,length(s)); - buffer[length(s)]:=#0; - allowslash(Pchar(@buffer)); - asm - leal buffer,%edx - movb 8(%ebp),%ah - call ___SYSCALL - jnc .LDOS_DIRS1 - movw %ax,U_SYSOS2_INOUTRES; - .LDOS_DIRS1: - end; + move(s[1],buffer,length(s)); + buffer[length(s)]:=#0; + allowslash(Pchar(@buffer)); + asm + leal buffer,%edx + movb 8(%ebp),%ah + call syscall + jnc .LDOS_DIRS1 + movw %ax,inoutres; + .LDOS_DIRS1: + end; end; procedure mkdir(const s : string); begin - DosDir($39,s); + DosDir($39,s); end; procedure rmdir(const s : string); begin - DosDir($3a,s); + DosDir($3a,s); end; procedure chdir(const s : string); begin - DosDir($3b,s); + DosDir($3b,s); end; procedure getdir(drivenr : byte;var dir : string); {Written by Michael Van Canneyt.} -var temp:array[0..255] of char; - sof:Pchar; - i:byte; +var temp:array[0..255] of char; + sof:Pchar; + i:byte; begin - sof:=pchar(@dir[4]); - { dir[1..3] will contain '[drivenr]:\', but is not } - { supplied by DOS, so we let dos string start at } - { dir[4] } - { Get dir from drivenr : 0=default, 1=A etc... } - asm - movb drivenr,%dl - movl sof,%esi - mov $0x47,%ah - call ___SYSCALL - end; - { Now Dir should be filled with directory in ASCIIZ, } - { starting from dir[4] } - dir[0]:=#3; - dir[2]:=':'; - dir[3]:='\'; - i:=4; - {Conversion to Pascal string } - while (dir[i]<>#0) do - begin - { convert path name to DOS } - if dir[i]='/' then - dir[i]:='\'; - dir[0]:=char(i); - inc(i); - end; - { upcase the string (FPKPascal function) } - dir:=upcase(dir); - if drivenr<>0 then { Drive was supplied. We know it } - dir[1]:=char(65+drivenr-1) - else - begin - { We need to get the current drive from DOS function 19H } - { because the drive was the default, which can be unknown } - asm - movb $0x19,%ah - call ___SYSCALL - addb $65,%al - movb %al,i - end; - dir[1]:=char(i); - end; + sof:=pchar(@dir[4]); + { dir[1..3] will contain '[drivenr]:\', but is not } + { supplied by DOS, so we let dos string start at } + { dir[4] } + { Get dir from drivenr : 0=default, 1=A etc... } + asm + movb drivenr,%dl + movl sof,%esi + mov $0x47,%ah + call syscall + end; + { Now Dir should be filled with directory in ASCIIZ, } + { starting from dir[4] } + dir[0]:=#3; + dir[2]:=':'; + dir[3]:='\'; + i:=4; + {Conversion to Pascal string } + while (dir[i]<>#0) do + begin + { convert path name to DOS } + if dir[i]='/' then + dir[i]:='\'; + dir[0]:=char(i); + inc(i); + end; + { upcase the string (FPKPascal function) } + dir:=upcase(dir); + if drivenr<>0 then { Drive was supplied. We know it } + dir[1]:=char(65+drivenr-1) + else + begin + { We need to get the current drive from DOS function 19H } + { because the drive was the default, which can be unknown } + asm + movb $0x19,%ah + call syscall + addb $65,%al + movb %al,i + end; + dir[1]:=char(i); + end; end; {**************************************************************************** - System unit initialization. + System unit initialization. ****************************************************************************} procedure OpenStdIO(var f:text;mode:word;hdl:longint); begin - Assign(f,''); - TextRec(f).Handle:=hdl; - TextRec(f).Mode:=mode; - TextRec(f).InOutFunc:=@FileInOutFunc; - TextRec(f).FlushFunc:=@FileInOutFunc; - TextRec(f).Closefunc:=@fileclosefunc; + Assign(f,''); + TextRec(f).Handle:=hdl; + TextRec(f).Mode:=mode; + TextRec(f).InOutFunc:=@FileInOutFunc; + TextRec(f).FlushFunc:=@FileInOutFunc; + TextRec(f).Closefunc:=@fileclosefunc; end; -var pib:Pprocessinfoblock; - tib:Pthreadinfoblock; +var pib:Pprocessinfoblock; + tib:Pthreadinfoblock; begin - {Determine the operating system we are running on.} - asm - movw $0x7f0a,%ax - call ___SYSCALL - test $512,%bx {Bit 9 is OS/2 flag.} - setnzb U_SYSOS2_OS_MODE - test $4096,%bx - jz _noRSX - movb $2,U_SYSOS2_OS_MODE - _noRSX: - end; + {Determine the operating system we are running on.} + asm + movw $0x7f0a,%ax + call syscall + testw $512,%bx {Bit 9 is OS/2 flag.} + setnzl os_mode + testw $4096,%bx + jz .LnoRSX + movl $2,os_mode + .LnoRSX: + end; - {Enable the brk area by initializing it with the initial heap size.} - asm - mov $0x7f01,%ax - movl HEAPSIZE,%edx - addl __heap_base,%edx - call ___SYSCALL - cmpl $-1,%eax - jnz _heapok - pushl $204 - call _SYSOS2$$_RUNERROR$WORD - _heapok: - end; + {$ASMMODE DIRECT} + {Enable the brk area by initializing it with the initial heap size.} + asm + movw $0x7f01,%ax + movl HEAPSIZE,%edx + addl __heap_base,%edx + call ___SYSCALL + cmpl $-1,%eax + jnz Lheapok + pushl $204 + {call RUNERROR$$WORD} + Lheapok: + end; + {$ASMMODE ATT} - {Now request, if we are running under DOS, - read-access to the first meg. of memory.} - if os_mode in [osDOS,osDPMI] then - asm - mov $0x7f13,%ax - xor %ebx,%ebx - mov $0xfff,%ecx - xor %edx,%edx - call ___SYSCALL - mov %eax,U_SYSOS2_FIRST_MEG - end - else - first_meg:=nil; - {At 0.9.2, case for enumeration does not work.} - case os_mode of - osDOS: - stackbottom:=0; {In DOS mode, heap_brk is also the - stack bottom.} - osOS2: - begin - dosgetinfoblocks(tib,pib); - stackbottom:=longint(tib^.stack); - end; - osDPMI: - stackbottom:=0; {Not sure how to get it, but seems to be - always zero.} - end; - exitproc:=nil; + {Now request, if we are running under DOS, + read-access to the first meg. of memory.} + if os_mode in [osDOS,osDPMI] then + asm + movw $0x7f13,%ax + xorl %ebx,%ebx + movl $0xfff,%ecx + xorl %edx,%edx + call syscall + movl %eax,first_meg + end + else + first_meg:=nil; + {At 0.9.2, case for enumeration does not work.} + case os_mode of + osDOS: + stackbottom:=0; {In DOS mode, heap_brk is also the + stack bottom.} + osOS2: + begin + dosgetinfoblocks(tib,pib); + stackbottom:=longint(tib^.stack); + end; + osDPMI: + stackbottom:=0; {Not sure how to get it, but seems to be + always zero.} + end; + exitproc:=nil; - {Initialize the heap.} - initheap; + {Initialize the heap.} + initheap; - { to test stack depth } - loweststack:=maxlongint; + { to test stack depth } + loweststack:=maxlongint; - OpenStdIO(Input,fmInput,StdInputHandle); - OpenStdIO(Output,fmOutput,StdOutputHandle); - OpenStdIO(StdErr,fmOutput,StdErrorHandle); + OpenStdIO(Input,fmInput,StdInputHandle); + OpenStdIO(Output,fmOutput,StdOutputHandle); + OpenStdIO(StdErr,fmOutput,StdErrorHandle); - { kein Ein- Ausgabefehler } - inoutres:=0; + { kein Ein- Ausgabefehler } + inoutres:=0; end.