Browse Source

* Updated to current compiler & rtl.

daniel 27 years ago
parent
commit
3a5a4d2509
1 changed files with 470 additions and 467 deletions
  1. 470 467
      rtl/os2/sysos2.pas

+ 470 - 467
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}
-
-type    Tos=(osDOS,osOS2,osDPMI);
-
-var     os_mode:Tos;
-        first_meg:pointer;
-
-type    Psysthreadib=^Tsysthreadib;
-        Pthreadinfoblock=^Tthreadinfoblock;
-        Pprocessinfoblock=^Tprocessinfoblock;
-
-        Tbytearray=array[0..$ffff] of byte;
-        Pbytearray=^Tbytearray;
-
-        Tsysthreadib=record
-            tid,
-            priority,
-            version:longint;
-            MCcount,
-            MCforceflag:word;
-        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;
-
-const   UnusedHandle=$ffff;
-        StdInputHandle=0;
-        StdOutputHandle=1;
-        StdErrorHandle=2;
+{$I	SYSTEMH.INC}
+{$I	heaph.inc}
+
+type	Tos=(osDOS,osOS2,osDPMI);
+
+var		os_mode:Tos;
+		first_meg:pointer;
+
+type	Psysthreadib=^Tsysthreadib;
+		Pthreadinfoblock=^Tthreadinfoblock;
+		Pprocessinfoblock=^Tprocessinfoblock;
+
+		Tbytearray=array[0..$ffff] of byte;
+		Pbytearray=^Tbytearray;
+
+		Tsysthreadib=record
+			tid,
+			priority,
+			version:longint;
+			MCcount,
+			MCforceflag:word;
+		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;
+
+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;
-
-    {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;
-
-    {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;
-
-    {Initialize the heap.}
-    initheap;
-
-    { to test stack depth }
-    loweststack:=maxlongint;
-
-    OpenStdIO(Input,fmInput,StdInputHandle);
-    OpenStdIO(Output,fmOutput,StdOutputHandle);
-    OpenStdIO(StdErr,fmOutput,StdErrorHandle);
-
-    { kein Ein- Ausgabefehler }
-    inoutres:=0;
+	{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;
+
+	{$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
+			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;
+
+	{ to test stack depth }
+	loweststack:=maxlongint;
+
+	OpenStdIO(Input,fmInput,StdInputHandle);
+	OpenStdIO(Output,fmOutput,StdOutputHandle);
+	OpenStdIO(StdErr,fmOutput,StdErrorHandle);
+
+	{ kein Ein-	Ausgabefehler }
+	inoutres:=0;
 end.