mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-17 14:31:35 +02:00
* go32v1, go32v2 recompiles with the new objects
* remake3 works again with go32v2 - removed some "optimizes" from daniel which were wrong
This commit is contained in:
peter
parent
92924c2075
commit
b0b403d498
739
rtl/dos/dos.pp
739
rtl/dos/dos.pp
@ -3,6 +3,8 @@
|
|||||||
This file is part of the Free Pascal run time library.
|
This file is part of the Free Pascal run time library.
|
||||||
Copyright (c) 1993,97 by the Free Pascal development team.
|
Copyright (c) 1993,97 by the Free Pascal development team.
|
||||||
|
|
||||||
|
Dos unit for BP7 compatible RTL
|
||||||
|
|
||||||
See the file COPYING.FPC, included in this distribution,
|
See the file COPYING.FPC, included in this distribution,
|
||||||
for details about the copyright.
|
for details about the copyright.
|
||||||
|
|
||||||
@ -68,9 +70,7 @@ Type
|
|||||||
{$i filerec.inc}
|
{$i filerec.inc}
|
||||||
{$i textrec.inc}
|
{$i textrec.inc}
|
||||||
|
|
||||||
{$PACKRECORDS 1}
|
DateTime = packed record
|
||||||
|
|
||||||
DateTime = record
|
|
||||||
Year,
|
Year,
|
||||||
Month,
|
Month,
|
||||||
Day,
|
Day,
|
||||||
@ -79,8 +79,9 @@ Type
|
|||||||
Sec : word;
|
Sec : word;
|
||||||
End;
|
End;
|
||||||
|
|
||||||
{$IFDEF GO32V2}
|
{$ifdef GO32V2}
|
||||||
searchrec = record
|
|
||||||
|
searchrec = packed record
|
||||||
fill : array[1..21] of byte;
|
fill : array[1..21] of byte;
|
||||||
attr : byte;
|
attr : byte;
|
||||||
time : longint;
|
time : longint;
|
||||||
@ -92,7 +93,8 @@ Type
|
|||||||
Registers = Go32.Registers;
|
Registers = Go32.Registers;
|
||||||
|
|
||||||
{$ELSE}
|
{$ELSE}
|
||||||
searchrec = record
|
|
||||||
|
searchrec = packed record
|
||||||
fill : array[1..21] of byte;
|
fill : array[1..21] of byte;
|
||||||
attr : byte;
|
attr : byte;
|
||||||
time : longint;
|
time : longint;
|
||||||
@ -101,7 +103,7 @@ Type
|
|||||||
name : string[15]; { the same size as declared by (DJ GNU C) }
|
name : string[15]; { the same size as declared by (DJ GNU C) }
|
||||||
end;
|
end;
|
||||||
|
|
||||||
registers = record
|
registers = packed record
|
||||||
case i : integer of
|
case i : integer of
|
||||||
0 : (ax,f1,bx,f2,cx,f3,dx,f4,bp,f5,si,f51,di,f6,ds,f7,es,f8,flags,fs,gs : word);
|
0 : (ax,f1,bx,f2,cx,f3,dx,f4,bp,f5,si,f51,di,f6,ds,f7,es,f8,flags,fs,gs : word);
|
||||||
1 : (al,ah,f9,f10,bl,bh,f11,f12,cl,ch,f13,f14,dl,dh : byte);
|
1 : (al,ah,f9,f10,bl,bh,f11,f12,cl,ch,f13,f14,dl,dh : byte);
|
||||||
@ -109,8 +111,6 @@ Type
|
|||||||
end;
|
end;
|
||||||
{$endif GO32V1}
|
{$endif GO32V1}
|
||||||
|
|
||||||
{$PACKRECORDS 2}
|
|
||||||
|
|
||||||
Var
|
Var
|
||||||
DosError : integer;
|
DosError : integer;
|
||||||
|
|
||||||
@ -249,95 +249,99 @@ var
|
|||||||
end;
|
end;
|
||||||
{$endif GO32V2}
|
{$endif GO32V2}
|
||||||
|
|
||||||
procedure msdos(var regs : registers);
|
procedure msdos(var regs : registers);
|
||||||
begin
|
begin
|
||||||
intr($21,regs);
|
intr($21,regs);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
{******************************************************************************
|
{******************************************************************************
|
||||||
--- Info / Date / Time ---
|
--- Info / Date / Time ---
|
||||||
******************************************************************************}
|
******************************************************************************}
|
||||||
|
|
||||||
function dosversion : word;
|
function dosversion : word;
|
||||||
begin
|
begin
|
||||||
dosregs.ax:=$3000;
|
dosregs.ax:=$3000;
|
||||||
msdos(dosregs);
|
msdos(dosregs);
|
||||||
dosversion:=dosregs.ax;
|
dosversion:=dosregs.ax;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure getdate(var year,month,mday,wday : word);
|
|
||||||
begin
|
|
||||||
dosregs.ax:=$2a00;
|
|
||||||
msdos(dosregs);
|
|
||||||
wday:=dosregs.al;
|
|
||||||
year:=dosregs.cx;
|
|
||||||
month:=dosregs.dh;
|
|
||||||
mday:=dosregs.dl;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure setdate(year,month,day : word);
|
procedure getdate(var year,month,mday,wday : word);
|
||||||
begin
|
begin
|
||||||
dosregs.cx:=year;
|
dosregs.ax:=$2a00;
|
||||||
dosregs.dh:=month;
|
msdos(dosregs);
|
||||||
dosregs.dl:=day;
|
wday:=dosregs.al;
|
||||||
dosregs.ah:=$2b;
|
year:=dosregs.cx;
|
||||||
msdos(dosregs);
|
month:=dosregs.dh;
|
||||||
LoadDosError;
|
mday:=dosregs.dl;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure gettime(var hour,minute,second,sec100 : word);
|
|
||||||
begin
|
|
||||||
dosregs.ah:=$2c;
|
|
||||||
msdos(dosregs);
|
|
||||||
hour:=dosregs.ch;
|
|
||||||
minute:=dosregs.cl;
|
|
||||||
second:=dosregs.dh;
|
|
||||||
sec100:=dosregs.dl;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure settime(hour,minute,second,sec100 : word);
|
procedure setdate(year,month,day : word);
|
||||||
begin
|
begin
|
||||||
dosregs.ch:=hour;
|
dosregs.cx:=year;
|
||||||
dosregs.cl:=minute;
|
dosregs.dh:=month;
|
||||||
dosregs.dh:=second;
|
dosregs.dl:=day;
|
||||||
dosregs.dl:=sec100;
|
dosregs.ah:=$2b;
|
||||||
dosregs.ah:=$2d;
|
msdos(dosregs);
|
||||||
msdos(dosregs);
|
LoadDosError;
|
||||||
LoadDosError;
|
end;
|
||||||
end;
|
|
||||||
|
|
||||||
Procedure packtime(var t : datetime;var p : longint);
|
|
||||||
Begin
|
|
||||||
p:=(t.sec shr 1)+(t.min shl 5)+(t.hour shl 11)+(t.day shl 16)+(t.month shl 21)+((t.year-1980) shl 25);
|
|
||||||
End;
|
|
||||||
|
|
||||||
Procedure unpacktime(p : longint;var t : datetime);
|
procedure gettime(var hour,minute,second,sec100 : word);
|
||||||
Begin
|
begin
|
||||||
t.sec:=(p and 31) shl 1;
|
dosregs.ah:=$2c;
|
||||||
t.min:=(p shr 5) and 63;
|
msdos(dosregs);
|
||||||
t.hour:=(p shr 11) and 31;
|
hour:=dosregs.ch;
|
||||||
t.day:=(p shr 16) and 31;
|
minute:=dosregs.cl;
|
||||||
t.month:=(p shr 21) and 15;
|
second:=dosregs.dh;
|
||||||
t.year:=(p shr 25)+1980;
|
sec100:=dosregs.dl;
|
||||||
End;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure settime(hour,minute,second,sec100 : word);
|
||||||
|
begin
|
||||||
|
dosregs.ch:=hour;
|
||||||
|
dosregs.cl:=minute;
|
||||||
|
dosregs.dh:=second;
|
||||||
|
dosregs.dl:=sec100;
|
||||||
|
dosregs.ah:=$2d;
|
||||||
|
msdos(dosregs);
|
||||||
|
LoadDosError;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
Procedure packtime(var t : datetime;var p : longint);
|
||||||
|
Begin
|
||||||
|
p:=(t.sec shr 1)+(t.min shl 5)+(t.hour shl 11)+(t.day shl 16)+(t.month shl 21)+((t.year-1980) shl 25);
|
||||||
|
End;
|
||||||
|
|
||||||
|
|
||||||
|
Procedure unpacktime(p : longint;var t : datetime);
|
||||||
|
Begin
|
||||||
|
with t do
|
||||||
|
begin
|
||||||
|
sec:=(p and 31) shl 1;
|
||||||
|
min:=(p shr 5) and 63;
|
||||||
|
hour:=(p shr 11) and 31;
|
||||||
|
day:=(p shr 16) and 31;
|
||||||
|
month:=(p shr 21) and 15;
|
||||||
|
year:=(p shr 25)+1980;
|
||||||
|
end;
|
||||||
|
End;
|
||||||
|
|
||||||
|
|
||||||
{******************************************************************************
|
{******************************************************************************
|
||||||
--- Exec ---
|
--- Exec ---
|
||||||
******************************************************************************}
|
******************************************************************************}
|
||||||
|
|
||||||
var
|
var
|
||||||
lastdosexitcode : word;
|
lastdosexitcode : word;
|
||||||
|
|
||||||
{$ifdef GO32V2}
|
{$ifdef GO32V2}
|
||||||
|
|
||||||
{ this code is just the most basic part of dosexec.c from
|
{
|
||||||
the djgpp code }
|
|
||||||
|
|
||||||
procedure exec(const path : pathstr;const comline : comstr);
|
|
||||||
|
|
||||||
procedure do_system(p,c : string);
|
|
||||||
|
|
||||||
{
|
|
||||||
Table 0931
|
Table 0931
|
||||||
Format of EXEC parameter block for AL=00h,01h,04h:
|
Format of EXEC parameter block for AL=00h,01h,04h:
|
||||||
Offset Size Description
|
Offset Size Description
|
||||||
@ -350,222 +354,224 @@ var
|
|||||||
0Eh DWORD (AL=01h) will hold subprogram's initial SS:SP on return
|
0Eh DWORD (AL=01h) will hold subprogram's initial SS:SP on return
|
||||||
12h DWORD (AL=01h) will hold entry point (CS:IP) on return
|
12h DWORD (AL=01h) will hold entry point (CS:IP) on return
|
||||||
INT 21 4B--
|
INT 21 4B--
|
||||||
}
|
}
|
||||||
|
|
||||||
type
|
procedure exec(const path : pathstr;const comline : comstr);
|
||||||
realptr = record
|
type
|
||||||
ofs,seg : word;
|
realptr = packed record
|
||||||
end;
|
ofs,seg : word;
|
||||||
|
end;
|
||||||
|
texecblock = packed record
|
||||||
|
envseg : word;
|
||||||
|
comtail : realptr;
|
||||||
|
firstFCB : realptr;
|
||||||
|
secondFCB : realptr;
|
||||||
|
iniStack : realptr;
|
||||||
|
iniCSIP : realptr;
|
||||||
|
end;
|
||||||
|
var
|
||||||
|
current_dos_buffer_pos,
|
||||||
|
arg_ofs,
|
||||||
|
i,la_env,
|
||||||
|
la_p,la_c,la_e,
|
||||||
|
fcb1_la,fcb2_la : longint;
|
||||||
|
execblock : texecblock;
|
||||||
|
c,p : string;
|
||||||
|
|
||||||
texecblock = record
|
function paste_to_dos(src : string) : boolean;
|
||||||
envseg : word;
|
var
|
||||||
comtail : realptr;
|
c : array[0..255] of char;
|
||||||
firstFCB : realptr;
|
begin
|
||||||
secondFCB : realptr;
|
paste_to_dos:=false;
|
||||||
iniStack : realptr;
|
if current_dos_buffer_pos+length(src)+1>transfer_buffer+tb_size then
|
||||||
iniCSIP : realptr;
|
RunError(217);
|
||||||
end;
|
move(src[1],c[0],length(src));
|
||||||
|
c[length(src)]:=#0;
|
||||||
|
seg_move(get_ds,longint(@c),dosmemselector,current_dos_buffer_pos,length(src)+1);
|
||||||
|
current_dos_buffer_pos:=current_dos_buffer_pos+length(src)+1;
|
||||||
|
paste_to_dos:=true;
|
||||||
|
end;
|
||||||
|
|
||||||
var current_dos_buffer_pos : longint;
|
begin
|
||||||
function paste_to_dos(src : string) : boolean;
|
{ create command line }
|
||||||
var c : array[0..255] of char;
|
move(comline[0],c[1],length(comline)+1);
|
||||||
begin
|
c[length(comline)+2]:=#13;
|
||||||
paste_to_dos:=false;
|
c[0]:=char(length(comline)+2);
|
||||||
if current_dos_buffer_pos+length(src)+1>transfer_buffer+tb_size then
|
{ create path }
|
||||||
RunError(217);
|
p:=path;
|
||||||
move(src[1],c[0],length(src));
|
for i:=1 to length(p) do
|
||||||
c[length(src)]:=#0;
|
if p[i]='/' then
|
||||||
seg_move(get_ds,longint(@c),dosmemselector,current_dos_buffer_pos,length(src)+1);
|
p[i]:='\';
|
||||||
current_dos_buffer_pos:=current_dos_buffer_pos+length(src)+1;
|
{ create buffer }
|
||||||
paste_to_dos:=true;
|
la_env:=transfer_buffer;
|
||||||
end;
|
while (la_env and 15)<>0 do
|
||||||
var
|
inc(la_env);
|
||||||
i,la_env,la_p,la_c,la_e,fcb1_la,fcb2_la : longint;
|
current_dos_buffer_pos:=la_env;
|
||||||
arg_ofs : longint;
|
{ copy environment }
|
||||||
execblock : texecblock;
|
for i:=1 to envcount do
|
||||||
|
paste_to_dos(envstr(i));
|
||||||
begin
|
paste_to_dos(''); { adds a double zero at the end }
|
||||||
la_env:=transfer_buffer;
|
{ allow slash as backslash }
|
||||||
while (la_env mod 16)<>0 do inc(la_env);
|
la_p:=current_dos_buffer_pos;
|
||||||
current_dos_buffer_pos:=la_env;
|
paste_to_dos(p);
|
||||||
for i:=1 to envcount do
|
la_c:=current_dos_buffer_pos;
|
||||||
begin
|
paste_to_dos(c);
|
||||||
paste_to_dos(envstr(i));
|
la_e:=current_dos_buffer_pos;
|
||||||
end;
|
fcb1_la:=la_e;
|
||||||
paste_to_dos(''); { adds a double zero at the end }
|
la_e:=la_e+16;
|
||||||
{ allow slash as backslash }
|
fcb2_la:=la_e;
|
||||||
for i:=1 to length(p) do
|
la_e:=la_e+16;
|
||||||
if p[i]='/' then p[i]:='\';
|
{ allocate FCB see dosexec code }
|
||||||
la_p:=current_dos_buffer_pos;
|
arg_ofs:=1;
|
||||||
paste_to_dos(p);
|
while (c[arg_ofs] in [' ',#9]) do
|
||||||
la_c:=current_dos_buffer_pos;
|
inc(arg_ofs);
|
||||||
paste_to_dos(c);
|
dosregs.ax:=$2901;
|
||||||
la_e:=current_dos_buffer_pos;
|
dosregs.ds:=(la_c+arg_ofs) shr 4;
|
||||||
fcb1_la:=la_e;
|
dosregs.esi:=(la_c+arg_ofs) and 15;
|
||||||
la_e:=la_e+16;
|
dosregs.es:=fcb1_la shr 4;
|
||||||
fcb2_la:=la_e;
|
dosregs.edi:=fcb1_la and 15;
|
||||||
la_e:=la_e+16;
|
msdos(dosregs);
|
||||||
{ allocate FCB see dosexec code }
|
{ allocate second FCB see dosexec code }
|
||||||
dosregs.ax:=$2901;
|
repeat
|
||||||
arg_ofs:=1;
|
inc(arg_ofs);
|
||||||
while (c[arg_ofs]=' ') or (c[arg_ofs]=#9) do inc(arg_ofs);
|
until (c[arg_ofs] in [' ',#9,#13]);
|
||||||
dosregs.ds:=(la_c+arg_ofs) div 16;
|
if c[arg_ofs]<>#13 then
|
||||||
dosregs.si:=(la_c+arg_ofs) mod 16;
|
begin
|
||||||
dosregs.es:=fcb1_la div 16;
|
repeat
|
||||||
dosregs.di:=fcb1_la mod 16;
|
inc(arg_ofs);
|
||||||
msdos(dosregs);
|
until not (c[arg_ofs] in [' ',#9]);
|
||||||
repeat
|
end;
|
||||||
inc(arg_ofs);
|
dosregs.ax:=$2901;
|
||||||
until (c[arg_ofs]=' ') or
|
dosregs.ds:=(la_c+arg_ofs) shr 4;
|
||||||
(c[arg_ofs]=#9) or
|
dosregs.si:=(la_c+arg_ofs) and 15;
|
||||||
(c[arg_ofs]=#13);
|
dosregs.es:=fcb2_la shr 4;
|
||||||
if c[arg_ofs]<>#13 then
|
dosregs.di:=fcb2_la and 15;
|
||||||
begin
|
msdos(dosregs);
|
||||||
inc(arg_ofs);
|
with execblock do
|
||||||
while (c[arg_ofs]=' ') or (c[arg_ofs]=#9) do inc(arg_ofs);
|
begin
|
||||||
end;
|
envseg:=la_env shr 4;
|
||||||
{ allocate second FCB see dosexec code }
|
comtail.seg:=la_c shr 4;
|
||||||
dosregs.ax:=$2901;
|
comtail.ofs:=la_c and 15;
|
||||||
dosregs.ds:=(la_c+arg_ofs) div 16;
|
firstFCB.seg:=fcb1_la shr 4;
|
||||||
dosregs.si:=(la_c+arg_ofs) mod 16;
|
firstFCB.ofs:=fcb1_la and 15;
|
||||||
dosregs.es:=fcb2_la div 16;
|
secondFCB.seg:=fcb2_la shr 4;
|
||||||
dosregs.di:=fcb2_la mod 16;
|
secondFCB.ofs:=fcb2_la and 15;
|
||||||
msdos(dosregs);
|
end;
|
||||||
with execblock do
|
seg_move(get_ds,longint(@execblock),dosmemselector,la_e,sizeof(texecblock));
|
||||||
begin
|
dosregs.edx:=la_p and 15;
|
||||||
envseg:=la_env div 16;
|
dosregs.ds:=la_p shr 4;
|
||||||
comtail.seg:=la_c div 16;
|
dosregs.ebx:=la_e and 15;
|
||||||
comtail.ofs:=la_c mod 16;
|
dosregs.es:=la_e shr 4;
|
||||||
firstFCB.seg:=fcb1_la div 16;
|
dosregs.ax:=$4b00;
|
||||||
firstFCB.ofs:=fcb1_la mod 16;
|
msdos(dosregs);
|
||||||
secondFCB.seg:=fcb2_la div 16;
|
LoadDosError;
|
||||||
secondFCB.ofs:=fcb2_la mod 16;
|
if DosError=0 then
|
||||||
end;
|
begin
|
||||||
seg_move(get_ds,longint(@execblock),dosmemselector,la_e,sizeof(texecblock));
|
dosregs.ax:=$4d00;
|
||||||
dosregs.edx:=la_p mod 16;
|
msdos(dosregs);
|
||||||
dosregs.ds:=la_p div 16;
|
LastDosExitCode:=DosRegs.al
|
||||||
dosregs.ebx:=la_e mod 16;
|
end
|
||||||
dosregs.es:=la_e div 16;
|
else
|
||||||
dosregs.ax:=$4b00;
|
LastDosExitCode:=0;
|
||||||
msdos(dosregs);
|
end;
|
||||||
LoadDosError;
|
|
||||||
if DosError=0 then
|
|
||||||
begin
|
|
||||||
dosregs.ax:=$4d00;
|
|
||||||
msdos(dosregs);
|
|
||||||
LastDosExitCode:=DosRegs.al
|
|
||||||
end
|
|
||||||
else
|
|
||||||
LastDosExitCode:=0;
|
|
||||||
end;
|
|
||||||
|
|
||||||
{ var
|
|
||||||
p,c : array[0..255] of char; }
|
|
||||||
var c : string;
|
|
||||||
begin
|
|
||||||
doserror:=0;
|
|
||||||
{ move(path[1],p,length(path));
|
|
||||||
p[length(path)]:=#0; }
|
|
||||||
move(comline[0],c[1],length(comline)+1);
|
|
||||||
c[length(comline)+2]:=#13;
|
|
||||||
c[0]:=char(length(comline)+2);
|
|
||||||
do_system(path,c);
|
|
||||||
end;
|
|
||||||
|
|
||||||
{$else GO32V2}
|
{$else GO32V2}
|
||||||
|
|
||||||
procedure exec(const path : pathstr;const comline : comstr);
|
procedure exec(const path : pathstr;const comline : comstr);
|
||||||
|
var
|
||||||
|
i : longint;
|
||||||
|
b : array[0..255] of char;
|
||||||
|
begin
|
||||||
|
doserror:=0;
|
||||||
|
for i:=1to length(path) do
|
||||||
|
if path[i]='/' then
|
||||||
|
b[i-1]:='\'
|
||||||
|
else
|
||||||
|
b[i-1]:=path[i];
|
||||||
|
b[i]:=' ';
|
||||||
|
inc(i);
|
||||||
|
move(comline[1],b[i],length(comline));
|
||||||
|
inc(i,length(comline));
|
||||||
|
b[i]:=#0;
|
||||||
|
asm
|
||||||
|
leal b,%ebx
|
||||||
|
movw $0xff07,%ax
|
||||||
|
int $0x21
|
||||||
|
movw %ax,_LASTDOSEXITCODE
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
procedure do_system(p : pchar);
|
{$endif}
|
||||||
begin
|
|
||||||
asm
|
|
||||||
movl 12(%ebp),%ebx
|
|
||||||
movw $0xff07,%ax
|
|
||||||
int $0x21
|
|
||||||
movw %ax,_LASTDOSEXITCODE
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
var
|
|
||||||
i : longint;
|
|
||||||
execute : string;
|
|
||||||
b : array[0..255] of char;
|
|
||||||
|
|
||||||
begin
|
function dosexitcode : word;
|
||||||
doserror:=0;
|
begin
|
||||||
execute:=path+' '+comline;
|
dosexitcode:=lastdosexitcode;
|
||||||
{ allow slash as backslash for the program name only }
|
end;
|
||||||
for i:=1 to length(path) do
|
|
||||||
if execute[i]='/' then execute[i]:='\';
|
|
||||||
move(execute[1],b,length(execute));
|
|
||||||
b[length(execute)]:=#0;
|
|
||||||
do_system(b);
|
|
||||||
end;
|
|
||||||
|
|
||||||
{$endif GO32V2}
|
|
||||||
|
|
||||||
function dosexitcode : word;
|
procedure getcbreak(var breakvalue : boolean);
|
||||||
begin
|
begin
|
||||||
dosexitcode:=lastdosexitcode;
|
dosregs.ax:=$3300;
|
||||||
end;
|
msdos(dosregs);
|
||||||
|
breakvalue:=dosregs.dl<>0;
|
||||||
|
end;
|
||||||
|
|
||||||
procedure getcbreak(var breakvalue : boolean);
|
|
||||||
begin
|
|
||||||
dosregs.ax:=$3300;
|
|
||||||
msdos(dosregs);
|
|
||||||
breakvalue:=dosregs.dl<>0;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure setcbreak(breakvalue : boolean);
|
procedure setcbreak(breakvalue : boolean);
|
||||||
begin
|
begin
|
||||||
dosregs.ax:=$3301;
|
dosregs.ax:=$3301;
|
||||||
dosregs.dl:=ord(breakvalue);
|
dosregs.dl:=ord(breakvalue);
|
||||||
msdos(dosregs);
|
msdos(dosregs);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure getverify(var verify : boolean);
|
|
||||||
begin
|
|
||||||
dosregs.ah:=$54;
|
|
||||||
msdos(dosregs);
|
|
||||||
verify:=dosregs.al<>0;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure setverify(verify : boolean);
|
procedure getverify(var verify : boolean);
|
||||||
begin
|
begin
|
||||||
dosregs.ah:=$2e;
|
dosregs.ah:=$54;
|
||||||
dosregs.al:=ord(verify);
|
msdos(dosregs);
|
||||||
msdos(dosregs);
|
verify:=dosregs.al<>0;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure setverify(verify : boolean);
|
||||||
|
begin
|
||||||
|
dosregs.ah:=$2e;
|
||||||
|
dosregs.al:=ord(verify);
|
||||||
|
msdos(dosregs);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
{******************************************************************************
|
{******************************************************************************
|
||||||
--- Disk ---
|
--- Disk ---
|
||||||
******************************************************************************}
|
******************************************************************************}
|
||||||
|
|
||||||
function diskfree(drive : byte) : longint;
|
function diskfree(drive : byte) : longint;
|
||||||
begin
|
begin
|
||||||
dosregs.dl:=drive;
|
dosregs.dl:=drive;
|
||||||
dosregs.ah:=$36;
|
dosregs.ah:=$36;
|
||||||
msdos(dosregs);
|
msdos(dosregs);
|
||||||
if dosregs.ax<>$FFFF then
|
if dosregs.ax<>$FFFF then
|
||||||
diskfree:=dosregs.ax*dosregs.bx*dosregs.cx
|
diskfree:=dosregs.ax*dosregs.bx*dosregs.cx
|
||||||
else
|
else
|
||||||
diskfree:=-1;
|
diskfree:=-1;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function disksize(drive : byte) : longint;
|
|
||||||
|
|
||||||
begin
|
function disksize(drive : byte) : longint;
|
||||||
dosregs.dl:=drive;
|
begin
|
||||||
dosregs.ah:=$36;
|
dosregs.dl:=drive;
|
||||||
msdos(dosregs);
|
dosregs.ah:=$36;
|
||||||
if dosregs.ax<>$FFFF then
|
msdos(dosregs);
|
||||||
disksize:=dosregs.ax*dosregs.cx*dosregs.dx
|
if dosregs.ax<>$FFFF then
|
||||||
else
|
disksize:=dosregs.ax*dosregs.cx*dosregs.dx
|
||||||
disksize:=-1;
|
else
|
||||||
end;
|
disksize:=-1;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
{******************************************************************************
|
{******************************************************************************
|
||||||
--- Findfirst FindNext ---
|
--- Findfirst FindNext ---
|
||||||
******************************************************************************}
|
******************************************************************************}
|
||||||
|
|
||||||
procedure searchrec2dossearchrec(var f : searchrec);
|
procedure searchrec2dossearchrec(var f : searchrec);
|
||||||
@ -814,10 +820,13 @@ var
|
|||||||
{Now remove also all references to '\..\' + of course previous dirs..}
|
{Now remove also all references to '\..\' + of course previous dirs..}
|
||||||
repeat
|
repeat
|
||||||
i:=pos('\..\',pa);
|
i:=pos('\..\',pa);
|
||||||
if i<>0 then j:=i-1;
|
if i<>0 then
|
||||||
while (j>1) and (pa[j]<>'\') do
|
begin
|
||||||
dec (j);
|
j:=i-1;
|
||||||
delete (pa,j,i-j+3);
|
while (j>1) and (pa[j]<>'\') do
|
||||||
|
dec (j);
|
||||||
|
delete (pa,j,i-j+3);
|
||||||
|
end;
|
||||||
until i=0;
|
until i=0;
|
||||||
{Remove End . and \}
|
{Remove End . and \}
|
||||||
if (length(pa)>0) and (pa[length(pa)]='.') then
|
if (length(pa)>0) and (pa[length(pa)]='.') then
|
||||||
@ -866,8 +875,6 @@ var
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{$ifdef GO32V2}
|
|
||||||
|
|
||||||
procedure getftime(var f;var time : longint);
|
procedure getftime(var f;var time : longint);
|
||||||
begin
|
begin
|
||||||
dosregs.bx:=textrec(f).handle;
|
dosregs.bx:=textrec(f).handle;
|
||||||
@ -887,109 +894,100 @@ var
|
|||||||
doserror:=dosregs.al;
|
doserror:=dosregs.al;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure getfattr(var f;var attr : word);
|
|
||||||
begin
|
|
||||||
copytodos(filerec(f).name,strlen(filerec(f).name)+1);
|
|
||||||
dosregs.ax:=$4300;
|
|
||||||
dosregs.edx:=transfer_buffer and 15;
|
|
||||||
dosregs.ds:=transfer_buffer shr 4;
|
|
||||||
msdos(dosregs);
|
|
||||||
LoadDosError;
|
|
||||||
Attr:=dosregs.cx;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure setfattr(var f;attr : word);
|
procedure getfattr(var f;var attr : word);
|
||||||
begin
|
{$ifndef GO32V2}
|
||||||
copytodos(filerec(f).name,strlen(filerec(f).name)+1);
|
var
|
||||||
dosregs.ax:=$4301;
|
n : array[0..255] of char;
|
||||||
dosregs.edx:=transfer_buffer mod 16;
|
{$endif}
|
||||||
dosregs.ds:=transfer_buffer div 16;
|
begin
|
||||||
dosregs.cx:=attr;
|
{$ifdef GO32V2}
|
||||||
msdos(dosregs);
|
copytodos(filerec(f).name,strlen(filerec(f).name)+1);
|
||||||
LoadDosError;
|
dosregs.edx:=transfer_buffer and 15;
|
||||||
end;
|
dosregs.ds:=transfer_buffer shr 4;
|
||||||
|
{$else}
|
||||||
|
strpcopy(n,filerec(f).name);
|
||||||
|
dosregs.edx:=longint(@n);
|
||||||
|
{$endif}
|
||||||
|
dosregs.ax:=$4300;
|
||||||
|
msdos(dosregs);
|
||||||
|
LoadDosError;
|
||||||
|
Attr:=dosregs.cx;
|
||||||
|
end;
|
||||||
|
|
||||||
{$else GO32V2}
|
|
||||||
|
|
||||||
procedure getfattr(var f;var attr : word);
|
procedure setfattr(var f;attr : word);
|
||||||
var
|
{$ifndef GO32V2}
|
||||||
n : array[0..255] of char;
|
var
|
||||||
r : registers;
|
n : array[0..255] of char;
|
||||||
begin
|
{$endif}
|
||||||
strpcopy(n,filerec(f).name);
|
begin
|
||||||
dosregs.ax:=$4300;
|
{$ifdef GO32V2}
|
||||||
dosregs.edx:=longint(@n);
|
copytodos(filerec(f).name,strlen(filerec(f).name)+1);
|
||||||
msdos(dosregs);
|
dosregs.edx:=transfer_buffer mod 16;
|
||||||
LoadDosError;
|
dosregs.ds:=transfer_buffer div 16;
|
||||||
attr:=dosregs.cx;
|
{$else}
|
||||||
end;
|
strpcopy(n,filerec(f).name);
|
||||||
|
dosregs.edx:=longint(@n);
|
||||||
procedure setfattr(var f;attr : word);
|
{$endif}
|
||||||
var
|
dosregs.ax:=$4301;
|
||||||
n : array[0..255] of char;
|
dosregs.cx:=attr;
|
||||||
r : registers;
|
msdos(dosregs);
|
||||||
begin
|
LoadDosError;
|
||||||
strpcopy(n,filerec(f).name);
|
end;
|
||||||
dosregs.ax:=$4301;
|
|
||||||
dosregs.edx:=longint(@n);
|
|
||||||
dosregs.cx:=attr;
|
|
||||||
msdos(dosregs);
|
|
||||||
LoadDosError;
|
|
||||||
end;
|
|
||||||
|
|
||||||
{$endif GO32V2}
|
|
||||||
|
|
||||||
|
|
||||||
{******************************************************************************
|
{******************************************************************************
|
||||||
--- Environment ---
|
--- Environment ---
|
||||||
******************************************************************************}
|
******************************************************************************}
|
||||||
|
|
||||||
function envcount : longint;
|
function envcount : longint;
|
||||||
var
|
var
|
||||||
hp : ppchar;
|
hp : ppchar;
|
||||||
begin
|
begin
|
||||||
hp:=envp;
|
hp:=envp;
|
||||||
envcount:=0;
|
envcount:=0;
|
||||||
while assigned(hp^) do
|
while assigned(hp^) do
|
||||||
begin
|
begin
|
||||||
inc(envcount);
|
inc(envcount);
|
||||||
hp:=hp+4;
|
hp:=hp+4;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
function envstr(index : integer) : string;
|
function envstr(index : integer) : string;
|
||||||
begin
|
begin
|
||||||
if (index<=0) or (index>envcount) then
|
if (index<=0) or (index>envcount) then
|
||||||
begin
|
begin
|
||||||
envstr:='';
|
envstr:='';
|
||||||
exit;
|
exit;
|
||||||
end;
|
end;
|
||||||
envstr:=strpas(ppchar(envp+4*(index-1))^);
|
envstr:=strpas(ppchar(envp+4*(index-1))^);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
Function GetEnv(envvar: string): string;
|
Function GetEnv(envvar: string): string;
|
||||||
var
|
var
|
||||||
hp : ppchar;
|
hp : ppchar;
|
||||||
hs : string;
|
hs : string;
|
||||||
eqpos : longint;
|
eqpos : longint;
|
||||||
begin
|
begin
|
||||||
envvar:=upcase(envvar);
|
envvar:=upcase(envvar);
|
||||||
hp:=envp;
|
hp:=envp;
|
||||||
getenv:='';
|
getenv:='';
|
||||||
while assigned(hp^) do
|
while assigned(hp^) do
|
||||||
begin
|
begin
|
||||||
hs:=strpas(hp^);
|
hs:=strpas(hp^);
|
||||||
eqpos:=pos('=',hs);
|
eqpos:=pos('=',hs);
|
||||||
if copy(hs,1,eqpos-1)=envvar then
|
if copy(hs,1,eqpos-1)=envvar then
|
||||||
begin
|
begin
|
||||||
getenv:=copy(hs,eqpos+1,255);
|
getenv:=copy(hs,eqpos+1,255);
|
||||||
exit;
|
exit;
|
||||||
end;
|
end;
|
||||||
hp:=hp+4;
|
hp:=hp+4;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
{******************************************************************************
|
{******************************************************************************
|
||||||
--- Not Supported ---
|
--- Not Supported ---
|
||||||
@ -1011,7 +1009,12 @@ End;
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.3 1998-05-21 19:30:47 peter
|
Revision 1.4 1998-05-22 00:39:22 peter
|
||||||
|
* go32v1, go32v2 recompiles with the new objects
|
||||||
|
* remake3 works again with go32v2
|
||||||
|
- removed some "optimizes" from daniel which were wrong
|
||||||
|
|
||||||
|
Revision 1.3 1998/05/21 19:30:47 peter
|
||||||
* objects compiles for linux
|
* objects compiles for linux
|
||||||
+ assign(pchar), assign(char), rename(pchar), rename(char)
|
+ assign(pchar), assign(char), rename(pchar), rename(char)
|
||||||
* fixed read_text_as_array
|
* fixed read_text_as_array
|
||||||
|
|||||||
@ -205,8 +205,8 @@ crt$(PPUEXT) : ../crt.pp $(INC)/textrec.inc go32$(PPUEXT) $(SYSTEMPPU)
|
|||||||
$(PP) $(OPT) crt $(REDIR)
|
$(PP) $(OPT) crt $(REDIR)
|
||||||
$(DEL) crt.pp
|
$(DEL) crt.pp
|
||||||
|
|
||||||
objects$(PPUEXT) : ../objects.pp $(SYSTEMPPU)
|
objects$(PPUEXT) : $(INC)/objects.pp objinc.inc $(SYSTEMPPU)
|
||||||
$(COPY) ../objects.pp .
|
$(COPY) $(INC)/objects.pp .
|
||||||
$(PP) $(OPT) objects.pp $(REDIR)
|
$(PP) $(OPT) objects.pp $(REDIR)
|
||||||
$(DEL) objects.pp
|
$(DEL) objects.pp
|
||||||
|
|
||||||
@ -234,15 +234,15 @@ mouse$(PPUEXT) : ../mouse.pp $(SYSTEMPPU)
|
|||||||
$(PP) $(OPT) mouse.pp $(REDIR)
|
$(PP) $(OPT) mouse.pp $(REDIR)
|
||||||
$(DEL) mouse.pp
|
$(DEL) mouse.pp
|
||||||
|
|
||||||
getopts$(PPUEXT) : $(PROCINC)/getopts.pp $(SYSTEMPPU)
|
getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMPPU)
|
||||||
$(COPY) $(PROCINC)/getopts.pp .
|
$(COPY) $(INC)/getopts.pp .
|
||||||
$(PP) $(OPT) getopts.pp $(REDIR)
|
$(PP) $(OPT) getopts.pp $(REDIR)
|
||||||
$(DEL) getopts.pp
|
$(DEL) getopts.pp
|
||||||
|
|
||||||
graph$(PPUEXT) : ../graph.pp go32$(PPUEXT) $(SYSTEMPPU) mmx$(PPUEXT) \
|
PPIFILES:=$(wildcard $(PPI)/*.ppi)
|
||||||
$(PPIDEPS)
|
graph$(PPUEXT) : ../graph.pp go32$(PPUEXT) $(SYSTEMPPU) mmx$(PPUEXT) $(PPIFILES)
|
||||||
$(COPY) ../graph.pp .
|
$(COPY) ../graph.pp .
|
||||||
$(PP) $(OPT) -Up$(PPI) graph $(REDIR)
|
$(PP) $(OPT) -I$(PPI) graph $(REDIR)
|
||||||
$(DEL) graph.pp
|
$(DEL) graph.pp
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
@ -11,7 +11,7 @@
|
|||||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
||||||
|
|
||||||
**********************************************************************}
|
**********************************************************************}
|
||||||
{$define dos}
|
{$define go32v1}
|
||||||
{$undef go32v2}
|
{$undef go32v2}
|
||||||
{$undef os2}
|
{$undef os2}
|
||||||
{$undef linux}
|
{$undef linux}
|
||||||
@ -19,27 +19,9 @@
|
|||||||
|
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.1 1998-03-25 11:18:41 root
|
Revision 1.2 1998-05-22 00:39:31 peter
|
||||||
Initial revision
|
* go32v1, go32v2 recompiles with the new objects
|
||||||
|
* remake3 works again with go32v2
|
||||||
|
- removed some "optimizes" from daniel which were wrong
|
||||||
|
|
||||||
Revision 1.3 1998/01/26 11:57:08 michael
|
|
||||||
+ Added log at the end
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
Working file: rtl/dos/go32v1/os.inc
|
|
||||||
description:
|
|
||||||
----------------------------
|
|
||||||
revision 1.2
|
|
||||||
date: 1997/12/01 12:24:05; author: michael; state: Exp; lines: +13 -0
|
|
||||||
+ added copyright reference in header.
|
|
||||||
----------------------------
|
|
||||||
revision 1.1
|
|
||||||
date: 1997/11/27 08:33:53; author: michael; state: Exp;
|
|
||||||
Initial revision
|
|
||||||
----------------------------
|
|
||||||
revision 1.1.1.1
|
|
||||||
date: 1997/11/27 08:33:53; author: michael; state: Exp; lines: +0 -0
|
|
||||||
FPC RTL CVS start
|
|
||||||
=============================================================================
|
|
||||||
}
|
}
|
||||||
|
|||||||
@ -3,6 +3,8 @@
|
|||||||
# This file is part of the Free Pascal run time library.
|
# This file is part of the Free Pascal run time library.
|
||||||
# Copyright (c) 1993,97 by the Free Pascal development team.
|
# Copyright (c) 1993,97 by the Free Pascal development team.
|
||||||
#
|
#
|
||||||
|
# Go32V1 Startup code
|
||||||
|
#
|
||||||
# See the file COPYING.FPC, included in this distribution,
|
# See the file COPYING.FPC, included in this distribution,
|
||||||
# for details about the copyright.
|
# for details about the copyright.
|
||||||
#
|
#
|
||||||
@ -11,14 +13,13 @@
|
|||||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
||||||
#
|
#
|
||||||
# **********************************************************************
|
# **********************************************************************
|
||||||
#///*
|
#
|
||||||
#//** Called as start(argc, argv, envp)
|
# Called as start(argc, argv, envp)
|
||||||
#//*/
|
#
|
||||||
#///* gs:edx points to prog_info structure. All other registers are OBSOLETE
|
# gs:edx points to prog_info structure. All other registers are OBSOLETE
|
||||||
#//** but included for backwards compatibility
|
# but included for backwards compatibility
|
||||||
#//*/
|
#
|
||||||
|
.text
|
||||||
.text
|
|
||||||
.globl _start
|
.globl _start
|
||||||
_start:
|
_start:
|
||||||
.globl start
|
.globl start
|
||||||
@ -36,7 +37,7 @@ start:
|
|||||||
movw %ds,%ax
|
movw %ds,%ax
|
||||||
cmpw %cx,%ax
|
cmpw %cx,%ax
|
||||||
je Lcopy_none
|
je Lcopy_none
|
||||||
# /* set the right size */
|
# set the right size
|
||||||
movl $40,U_SYSTEM_GO32_INFO_BLOCK
|
movl $40,U_SYSTEM_GO32_INFO_BLOCK
|
||||||
|
|
||||||
movl %gs:(%edx), %ecx
|
movl %gs:(%edx), %ecx
|
||||||
@ -84,9 +85,9 @@ Lcopy_done:
|
|||||||
|
|
||||||
movw U_SYSTEM_GO32_INFO_BLOCK+36,%ax
|
movw U_SYSTEM_GO32_INFO_BLOCK+36,%ax
|
||||||
movw %ax,_run_mode
|
movw %ax,_run_mode
|
||||||
#/* I need a value for the stack bottom, */
|
# I need a value for the stack bottom,
|
||||||
#/* but I don't know how to get it from go32 */
|
# but I don't know how to get it from go32
|
||||||
#/* I suppose the stack is 4Ko long, is this true ? */
|
# I suppose the stack is 4Ko long, is this true ?
|
||||||
movl %esp,%eax
|
movl %esp,%eax
|
||||||
subl $0x4000,%eax
|
subl $0x4000,%eax
|
||||||
movl %eax,__stkbottom
|
movl %eax,__stkbottom
|
||||||
@ -94,7 +95,7 @@ Lcopy_done:
|
|||||||
movw U_SYSTEM_GO32_INFO_BLOCK+26,%ax
|
movw U_SYSTEM_GO32_INFO_BLOCK+26,%ax
|
||||||
movw %ax,_core_selector
|
movw %ax,_core_selector
|
||||||
movl U_SYSTEM_GO32_INFO_BLOCK+28,%eax
|
movl U_SYSTEM_GO32_INFO_BLOCK+28,%eax
|
||||||
movl %eax,U_SYSTEM_STUB_INFO
|
movl %eax,U_SYSTEM_STUB_INFO
|
||||||
xorl %esi,%esi
|
xorl %esi,%esi
|
||||||
xorl %edi,%edi
|
xorl %edi,%edi
|
||||||
xorl %ebp,%ebp
|
xorl %ebp,%ebp
|
||||||
@ -105,15 +106,16 @@ Lcopy_done:
|
|||||||
movl %esp,%ebx
|
movl %esp,%ebx
|
||||||
movl 8(%ebx),%eax
|
movl 8(%ebx),%eax
|
||||||
movl %eax,_environ
|
movl %eax,_environ
|
||||||
movl %eax,U_SYSTEM_ENVIRON
|
movl %eax,U_SYSTEM_ENVP
|
||||||
movl 4(%ebx),%eax
|
movl 4(%ebx),%eax
|
||||||
movl %eax,_args
|
movl %eax,_args
|
||||||
|
movl %eax,U_SYSTEM_ARGV
|
||||||
movl (%ebx),%eax
|
movl (%ebx),%eax
|
||||||
movl %eax,_argc
|
movl %eax,_argc
|
||||||
|
movl %eax,U_SYSTEM_ARGC
|
||||||
|
|
||||||
call PASCALMAIN
|
call PASCALMAIN
|
||||||
|
|
||||||
|
|
||||||
exit_again:
|
exit_again:
|
||||||
movl $0x4c00,%eax
|
movl $0x4c00,%eax
|
||||||
int $0x21
|
int $0x21
|
||||||
@ -121,23 +123,31 @@ exit_again:
|
|||||||
|
|
||||||
ret
|
ret
|
||||||
|
|
||||||
.data
|
.data
|
||||||
.globl _argc
|
.globl _argc
|
||||||
_argc:
|
_argc:
|
||||||
.long 0
|
.long 0
|
||||||
|
|
||||||
.globl _args
|
.globl _args
|
||||||
_args:
|
_args:
|
||||||
.long 0
|
.long 0
|
||||||
.globl _run_mode
|
|
||||||
_run_mode:
|
|
||||||
.word 0
|
|
||||||
.globl _core_selector
|
|
||||||
_core_selector:
|
|
||||||
.word 0
|
|
||||||
.globl _environ
|
.globl _environ
|
||||||
_environ:
|
_environ:
|
||||||
.long 0
|
.long 0
|
||||||
|
|
||||||
|
.globl __stkbottom
|
||||||
|
__stkbottom:
|
||||||
|
.long 0
|
||||||
|
|
||||||
|
.globl _run_mode
|
||||||
|
_run_mode:
|
||||||
|
.word 0
|
||||||
|
|
||||||
|
.globl _core_selector
|
||||||
|
_core_selector:
|
||||||
|
.word 0
|
||||||
|
|
||||||
.globl ___pid
|
.globl ___pid
|
||||||
___pid:
|
___pid:
|
||||||
.long 42
|
.long 42
|
||||||
@ -155,30 +165,21 @@ _ScreenSecondary:
|
|||||||
.long 0
|
.long 0
|
||||||
|
|
||||||
.globl __hard_master
|
.globl __hard_master
|
||||||
.globl __hard_slave
|
|
||||||
.globl __core_select
|
|
||||||
__hard_master:
|
__hard_master:
|
||||||
.byte 0
|
.byte 0
|
||||||
|
|
||||||
|
.globl __hard_slave
|
||||||
__hard_slave:
|
__hard_slave:
|
||||||
.byte 0
|
.byte 0
|
||||||
|
|
||||||
|
.globl __core_select
|
||||||
__core_select:
|
__core_select:
|
||||||
.short 0
|
.short 0
|
||||||
.globl __stkbottom
|
#
|
||||||
__stkbottom:
|
# $Log$
|
||||||
.long 0
|
# Revision 1.3 1998-05-22 00:39:32 peter
|
||||||
# .globl U_SYSTEM_GO32_INFO_BLOCK
|
# * go32v1, go32v2 recompiles with the new objects
|
||||||
# U_SYSTEM_GO32_INFO_BLOCK:
|
# * remake3 works again with go32v2
|
||||||
# .long __go32_end - U_SYSTEM_GO32_INFO_BLOCK #//* size */
|
# - removed some "optimizes" from daniel which were wrong
|
||||||
# .long 0 #//* offs 4 linear_address_of_primary_screen; */
|
#
|
||||||
# .long 0 #//* offs 8 linear_address_of_secondary_screen; */
|
#
|
||||||
# .long 0 #//* offs 12 linear_address_of_transfer_buffer; */
|
|
||||||
# .long 0 #//* offs 16 size_of_transfer_buffer; >= 4k */
|
|
||||||
# .long 0 #//* offs 20 pid; */
|
|
||||||
# .byte 0 #//* offs 24 u_char master_interrupt_controller_base; */
|
|
||||||
# .byte 0 #//* offs 25 u_char slave_interrupt_controller_base; */
|
|
||||||
# .word 0 #//* offs 26 u_short selector_for_linear_memory; */
|
|
||||||
# .long 0 #//* offs 28 u_long linear_address_of_stub_info_structure; */
|
|
||||||
# .long 0 #//* offs 32 u_long linear_address_of_original_psp; */
|
|
||||||
# .word 0 #//* offs 36 u_short run_mode; */
|
|
||||||
# .word 0 #//* offs 38 u_short run_mode_info; */
|
|
||||||
#__go32_end:
|
|
||||||
|
|||||||
@ -12,30 +12,45 @@
|
|||||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
||||||
|
|
||||||
**********************************************************************}
|
**********************************************************************}
|
||||||
|
|
||||||
{ system unit for go32v1 }
|
|
||||||
{$define DOS}
|
|
||||||
unit system;
|
unit system;
|
||||||
|
interface
|
||||||
|
|
||||||
|
{ no stack check in system }
|
||||||
|
{$S-}
|
||||||
|
|
||||||
{$I os.inc}
|
{$I os.inc}
|
||||||
|
|
||||||
interface
|
{ include system-independent routine headers }
|
||||||
|
|
||||||
{ die betriebssystemunabhangigen Deklarationen einfuegen: }
|
{$I systemh.inc}
|
||||||
|
|
||||||
{$I systemh.inc}
|
{ include heap support headers }
|
||||||
|
|
||||||
{$I heaph.inc}
|
{$I heaph.inc}
|
||||||
|
|
||||||
const
|
const
|
||||||
UnusedHandle=$ffff;
|
{ Default filehandles }
|
||||||
StdInputHandle=0;
|
UnusedHandle = $ffff;
|
||||||
StdOutputHandle=1;
|
StdInputHandle = 0;
|
||||||
StdErrorHandle=2;
|
StdOutputHandle = 1;
|
||||||
|
StdErrorHandle = 2;
|
||||||
|
|
||||||
|
{ Default memory segments (Tp7 compatibility) }
|
||||||
|
seg0040 = $0040;
|
||||||
|
segA000 = $A000;
|
||||||
|
segB000 = $B000;
|
||||||
|
segB800 = $B800;
|
||||||
|
|
||||||
|
var
|
||||||
|
{ C-compatible arguments and environment }
|
||||||
|
argc : longint;
|
||||||
|
argv : ppchar;
|
||||||
|
envp : ppchar;
|
||||||
|
|
||||||
type
|
type
|
||||||
{$PACKRECORDS 1}
|
{ Dos Extender info }
|
||||||
t_stub_info = record
|
p_stub_info = ^t_stub_info;
|
||||||
|
t_stub_info = packed record
|
||||||
magic : array[0..15] of char;
|
magic : array[0..15] of char;
|
||||||
size : longint;
|
size : longint;
|
||||||
minstack : longint;
|
minstack : longint;
|
||||||
@ -50,49 +65,47 @@ type
|
|||||||
basename : array[0..7] of char;
|
basename : array[0..7] of char;
|
||||||
argv0 : array [0..15] of char;
|
argv0 : array [0..15] of char;
|
||||||
dpmi_server : array [0..15] of char;
|
dpmi_server : array [0..15] of char;
|
||||||
end;
|
end;
|
||||||
p_stub_info = ^t_stub_info;
|
|
||||||
|
|
||||||
t_go32_info_block = record
|
t_go32_info_block = packed record
|
||||||
size_of_this_structure_in_bytes : longint; {offset 0}
|
size_of_this_structure_in_bytes : longint; {offset 0}
|
||||||
linear_address_of_primary_screen : longint; {offset 4}
|
linear_address_of_primary_screen : longint; {offset 4}
|
||||||
linear_address_of_secondary_screen : longint; {offset 8}
|
linear_address_of_secondary_screen : longint; {offset 8}
|
||||||
linear_address_of_transfer_buffer : longint; {offset 12}
|
linear_address_of_transfer_buffer : longint; {offset 12}
|
||||||
size_of_transfer_buffer : longint; {offset 16}
|
size_of_transfer_buffer : longint; {offset 16}
|
||||||
pid : longint; {offset 20}
|
pid : longint; {offset 20}
|
||||||
master_interrupt_controller_base : byte; {offset 24}
|
master_interrupt_controller_base : byte; {offset 24}
|
||||||
slave_interrupt_controller_base : byte; {offset 25}
|
slave_interrupt_controller_base : byte; {offset 25}
|
||||||
selector_for_linear_memory : word; {offset 26}
|
selector_for_linear_memory : word; {offset 26}
|
||||||
linear_address_of_stub_info_structure : longint; {offset 28}
|
linear_address_of_stub_info_structure : longint; {offset 28}
|
||||||
linear_address_of_original_psp : longint; {offset 32}
|
linear_address_of_original_psp : longint; {offset 32}
|
||||||
run_mode : word; {offset 36}
|
run_mode : word; {offset 36}
|
||||||
run_mode_info : word; {offset 38}
|
run_mode_info : word; {offset 38}
|
||||||
end;
|
end;
|
||||||
{$PACKRECORDS NORMAL}
|
|
||||||
|
|
||||||
var
|
var
|
||||||
stub_info : p_stub_info;
|
stub_info : p_stub_info;
|
||||||
go32_info_block : t_go32_info_block;
|
go32_info_block : t_go32_info_block;
|
||||||
environ : ppchar;
|
|
||||||
|
|
||||||
implementation
|
{ Needed for CRT unit }
|
||||||
|
function do_read(h,addr,len : longint) : longint;
|
||||||
|
|
||||||
{ include system independent routines }
|
|
||||||
|
|
||||||
{$I system.inc}
|
implementation
|
||||||
|
|
||||||
{$S-}
|
{ include system independent routines }
|
||||||
procedure st1(stack_size : longint);[public,alias: 'STACKCHECK'];
|
|
||||||
|
|
||||||
begin
|
{$I system.inc}
|
||||||
{ called when trying to get local stack }
|
|
||||||
{ if the compiler directive $S is set }
|
|
||||||
{ this function must preserve esi !!!! }
|
|
||||||
{ because esi is set by the calling }
|
|
||||||
{ proc for methods }
|
|
||||||
{ it must preserve all registers !! }
|
|
||||||
|
|
||||||
asm
|
procedure int_stackcheck(stack_size:longint);[public,alias: 'STACKCHECK'];
|
||||||
|
begin
|
||||||
|
{ called when trying to get local stack
|
||||||
|
if the compiler directive $S is set
|
||||||
|
this function must preserve esi !!!!
|
||||||
|
because esi is set by the calling
|
||||||
|
proc for methods
|
||||||
|
it must preserve all registers !! }
|
||||||
|
asm
|
||||||
pushl %eax
|
pushl %eax
|
||||||
pushl %ebx
|
pushl %ebx
|
||||||
movl stack_size,%ebx
|
movl stack_size,%ebx
|
||||||
@ -116,88 +129,62 @@ var
|
|||||||
{ can be usefull for error recovery !! }
|
{ can be usefull for error recovery !! }
|
||||||
popl %ebx
|
popl %ebx
|
||||||
popl %eax
|
popl %eax
|
||||||
end['EAX','EBX'];
|
end['EAX','EBX'];
|
||||||
RunError(202);
|
RunError(202);
|
||||||
{ this needs a local variable }
|
end;
|
||||||
{ so the function called itself !! }
|
|
||||||
{ Writeln('low in stack ');
|
|
||||||
RunError(202); }
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure halt(errnum : byte);
|
|
||||||
|
|
||||||
begin
|
{$I386_ATT}
|
||||||
do_exit;
|
|
||||||
flush(stderr);
|
|
||||||
asm
|
|
||||||
movl $0x4c00,%eax
|
|
||||||
movb 8(%ebp),%al
|
|
||||||
int $0x21
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
function paramcount : longint;
|
procedure halt(errnum : byte);
|
||||||
|
begin
|
||||||
|
do_exit;
|
||||||
|
flush(stderr);
|
||||||
|
asm
|
||||||
|
movl $0x4c00,%eax
|
||||||
|
movb errnum,%al
|
||||||
|
int $0x21
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
begin
|
|
||||||
asm
|
|
||||||
movl _argc,%eax
|
|
||||||
decl %eax
|
|
||||||
leave
|
|
||||||
ret
|
|
||||||
end ['EAX'];
|
|
||||||
end;
|
|
||||||
|
|
||||||
function paramstr(l : longint) : string;
|
function paramcount : longint;
|
||||||
|
begin
|
||||||
|
paramcount := argc - 1;
|
||||||
|
end;
|
||||||
|
|
||||||
function args : pointer;
|
|
||||||
|
|
||||||
begin
|
function paramstr(l : longint) : string;
|
||||||
asm
|
begin
|
||||||
movl _args,%eax
|
if (l>=0) and (l+1<=argc) then
|
||||||
leave
|
paramstr:=strpas(argv[l])
|
||||||
ret
|
else
|
||||||
end ['EAX'];
|
paramstr:='';
|
||||||
end;
|
end;
|
||||||
|
|
||||||
var
|
|
||||||
p : ^pchar;
|
|
||||||
|
|
||||||
begin
|
procedure randomize;assembler;
|
||||||
if (l>=0) and (l<=paramcount) then
|
asm
|
||||||
begin
|
movb $0x2c,%ah
|
||||||
p:=args;
|
int $0x21
|
||||||
paramstr:=strpas(p[l]);
|
shll $16,%ecx
|
||||||
end
|
movw %dx,%cx
|
||||||
else paramstr:='';
|
movl %ecx,randseed
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure randomize;
|
|
||||||
|
|
||||||
var
|
{*****************************************************************************
|
||||||
hl : longint;
|
Heap Management
|
||||||
begin
|
*****************************************************************************}
|
||||||
asm
|
|
||||||
movb $0x2c,%ah
|
|
||||||
int $0x21
|
|
||||||
movw %cx,-4(%ebp)
|
|
||||||
movw %dx,-2(%ebp)
|
|
||||||
end;
|
|
||||||
randseed:=hl;
|
|
||||||
end;
|
|
||||||
|
|
||||||
{ use standard heap management }
|
function Sbrk(size : longint) : longint;assembler;
|
||||||
{ sbrk function of go32v1 }
|
asm
|
||||||
function Sbrk(size : longint) : longint;
|
movl size,%ebx
|
||||||
|
movl $0x4a01,%eax
|
||||||
begin
|
int $0x21
|
||||||
asm
|
end;
|
||||||
movl size,%ebx
|
|
||||||
movl $0x4a01,%eax
|
|
||||||
int $0x21
|
|
||||||
movl %eax,__RESULT
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
{ include standard heap management }
|
||||||
{$I heap.inc}
|
{$I heap.inc}
|
||||||
|
|
||||||
|
|
||||||
@ -215,15 +202,13 @@ begin
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
procedure do_close(h : longint);
|
procedure do_close(h : longint);assembler;
|
||||||
begin
|
asm
|
||||||
asm
|
movl h,%ebx
|
||||||
movl 8(%ebp),%ebx
|
movb $0x3e,%ah
|
||||||
movb $0x3e,%ah
|
pushl %ebp
|
||||||
pushl %ebp
|
intl $0x21
|
||||||
intl $0x21
|
popl %ebp
|
||||||
popl %ebp
|
|
||||||
end;
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
@ -231,14 +216,14 @@ procedure do_erase(p : pchar);
|
|||||||
begin
|
begin
|
||||||
AllowSlash(p);
|
AllowSlash(p);
|
||||||
asm
|
asm
|
||||||
movl 8(%ebp),%edx
|
movl p,%edx
|
||||||
movb $0x41,%ah
|
movb $0x41,%ah
|
||||||
pushl %ebp
|
pushl %ebp
|
||||||
int $0x21
|
int $0x21
|
||||||
popl %ebp
|
popl %ebp
|
||||||
jnc .LERASE1
|
jnc .LERASE1
|
||||||
movw %ax,U_SYSTEM_INOUTRES;
|
movw %ax,inoutres
|
||||||
.LERASE1:
|
.LERASE1:
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -248,159 +233,135 @@ begin
|
|||||||
AllowSlash(p1);
|
AllowSlash(p1);
|
||||||
AllowSlash(p2);
|
AllowSlash(p2);
|
||||||
asm
|
asm
|
||||||
movl 8(%ebp),%edx
|
movl p1,%edx
|
||||||
movl 12(%ebp),%edi
|
movl p2,%edi
|
||||||
movb $0x56,%ah
|
movb $0x56,%ah
|
||||||
pushl %ebp
|
pushl %ebp
|
||||||
int $0x21
|
int $0x21
|
||||||
popl %ebp
|
popl %ebp
|
||||||
jnc .LRENAME1
|
jnc .LRENAME1
|
||||||
movw %ax,U_SYSTEM_INOUTRES;
|
movw %ax,inoutres
|
||||||
.LRENAME1:
|
.LRENAME1:
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
function do_write(h,addr,len : longint) : longint;
|
function do_write(h,addr,len : longint) : longint;assembler;
|
||||||
begin
|
asm
|
||||||
asm
|
movl len,%ecx
|
||||||
movl 16(%ebp),%ecx
|
movl addr,%edx
|
||||||
movl 12(%ebp),%edx
|
movl h,%ebx
|
||||||
movl 8(%ebp),%ebx
|
movb $0x40,%ah
|
||||||
movb $0x40,%ah
|
int $0x21
|
||||||
int $0x21
|
jnc .LDOSWRITE1
|
||||||
jnc .LDOSWRITE1
|
movw %ax,inoutres
|
||||||
movw %ax,U_SYSTEM_INOUTRES;
|
xorl %eax,%eax
|
||||||
.LDOSWRITE1:
|
.LDOSWRITE1:
|
||||||
movl %eax,-4(%ebp)
|
|
||||||
end;
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
function do_read(h,addr,len : longint) : longint;
|
function do_read(h,addr,len : longint) : longint;assembler;
|
||||||
begin
|
asm
|
||||||
asm
|
movl len,%ecx
|
||||||
movl 16(%ebp),%ecx
|
movl addr,%edx
|
||||||
movl 12(%ebp),%edx
|
movl h,%ebx
|
||||||
movl 8(%ebp),%ebx
|
movb $0x3f,%ah
|
||||||
movb $0x3f,%ah
|
int $0x21
|
||||||
int $0x21
|
jnc .LDOSREAD1
|
||||||
jnc .LDOSREAD1
|
movw %ax,inoutres
|
||||||
movw %ax,U_SYSTEM_INOUTRES;
|
xorl %eax,%eax
|
||||||
xorl %eax,%eax
|
.LDOSREAD1:
|
||||||
.LDOSREAD1:
|
|
||||||
leave
|
|
||||||
ret $12
|
|
||||||
end;
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
function do_filepos(handle : longint) : longint;
|
function do_filepos(handle : longint) : longint;assembler;
|
||||||
begin
|
asm
|
||||||
asm
|
movl $0x4201,%eax
|
||||||
movb $0x42,%ah
|
movl handle,%ebx
|
||||||
movb $0x1,%al
|
xorl %ecx,%ecx
|
||||||
movl 8(%ebp),%ebx
|
xorl %edx,%edx
|
||||||
xorl %ecx,%ecx
|
pushl %ebp
|
||||||
xorl %edx,%edx
|
int $0x21
|
||||||
pushl %ebp
|
popl %ebp
|
||||||
int $0x21
|
jnc .LDOSFILEPOS1
|
||||||
popl %ebp
|
movw %ax,inoutres
|
||||||
jnc .LDOSFILEPOS1
|
xorl %eax,%eax
|
||||||
movw %ax,U_SYSTEM_INOUTRES;
|
jmp .LDOSFILEPOS2
|
||||||
xorl %eax,%eax
|
.LDOSFILEPOS1:
|
||||||
jmp .LDOSFILEPOS2
|
shll $16,%edx
|
||||||
.LDOSFILEPOS1:
|
movzwl %ax,%eax
|
||||||
shll $16,%edx
|
orl %edx,%eax
|
||||||
movzwl %ax,%eax
|
.LDOSFILEPOS2:
|
||||||
orl %edx,%eax
|
|
||||||
.LDOSFILEPOS2:
|
|
||||||
leave
|
|
||||||
ret $4
|
|
||||||
end;
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
procedure do_seek(handle,pos : longint);
|
procedure do_seek(handle,pos : longint);assembler;
|
||||||
begin
|
asm
|
||||||
asm
|
movl $0x4200,%eax
|
||||||
movl $0x4200,%eax
|
movl handle,%ebx
|
||||||
movl 8(%ebp),%ebx
|
movl pos,%edx
|
||||||
movl 12(%ebp),%edx
|
movl %edx,%ecx
|
||||||
movl %edx,%ecx
|
shrl $16,%ecx
|
||||||
shrl $16,%ecx
|
pushl %ebp
|
||||||
pushl %ebp
|
int $0x21
|
||||||
int $0x21
|
popl %ebp
|
||||||
popl %ebp
|
jnc .LDOSSEEK1
|
||||||
jnc .LDOSSEEK1
|
movw %ax,inoutres
|
||||||
movw %ax,U_SYSTEM_INOUTRES;
|
.LDOSSEEK1:
|
||||||
.LDOSSEEK1:
|
|
||||||
leave
|
|
||||||
ret $8
|
|
||||||
end;
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
function do_seekend(handle : longint) : longint;
|
function do_seekend(handle : longint) : longint;assembler;
|
||||||
begin
|
asm
|
||||||
asm
|
movl $0x4202,%eax
|
||||||
movl $0x4202,%eax
|
movl handle,%ebx
|
||||||
movl 8(%ebp),%ebx
|
xorl %ecx,%ecx
|
||||||
xorl %ecx,%ecx
|
xorl %edx,%edx
|
||||||
xorl %edx,%edx
|
pushl %ebp
|
||||||
pushl %ebp
|
int $0x21
|
||||||
int $0x21
|
popl %ebp
|
||||||
popl %ebp
|
jnc .Lset_at_end1
|
||||||
jnc .Lset_at_end1
|
movw %ax,inoutres
|
||||||
movw %ax,U_SYSTEM_INOUTRES;
|
xorl %eax,%eax
|
||||||
xorl %eax,%eax
|
jmp .Lset_at_end2
|
||||||
jmp .Lset_at_end2
|
.Lset_at_end1:
|
||||||
.Lset_at_end1:
|
shll $16,%edx
|
||||||
shll $16,%edx
|
movzwl %ax,%eax
|
||||||
movzwl %ax,%eax
|
orl %edx,%eax
|
||||||
orl %edx,%eax
|
.Lset_at_end2:
|
||||||
.Lset_at_end2:
|
|
||||||
leave
|
|
||||||
ret $4
|
|
||||||
end;
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
function do_filesize(handle : longint) : longint;
|
function do_filesize(handle : longint) : longint;
|
||||||
var
|
var
|
||||||
aktfilepos : longint;
|
aktfilepos : longint;
|
||||||
begin
|
begin
|
||||||
aktfilepos:=do_filepos(handle);
|
aktfilepos:=do_filepos(handle);
|
||||||
do_filesize:=do_seekend(handle);
|
do_filesize:=do_seekend(handle);
|
||||||
do_seek(handle,aktfilepos);
|
do_seek(handle,aktfilepos);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
procedure do_truncate(handle,pos : longint);
|
procedure do_truncate(handle,pos : longint);assembler;
|
||||||
begin
|
asm
|
||||||
asm
|
movl $0x4200,%eax
|
||||||
movl $0x4200,%eax
|
movl handle,%ebx
|
||||||
movl 8(%ebp),%ebx
|
movl pos,%edx
|
||||||
movl 12(%ebp),%edx
|
movl %edx,%ecx
|
||||||
movl %edx,%ecx
|
shrl $16,%ecx
|
||||||
shrl $16,%ecx
|
pushl %ebp
|
||||||
pushl %ebp
|
int $0x21
|
||||||
int $0x21
|
popl %ebp
|
||||||
popl %ebp
|
jc .LTruncate1
|
||||||
jc .LTruncate1
|
movl handle,%ebx
|
||||||
movl 8(%ebp),%ebx
|
movl %ebp,%edx
|
||||||
movl 12(%ebp),%edx
|
xorl %ecx,%ecx
|
||||||
movl %ebp,%edx
|
movb $0x40,%ah
|
||||||
xorl %ecx,%ecx
|
int $0x21
|
||||||
movb $0x40,%ah
|
jnc .LTruncate2
|
||||||
int $0x21
|
.LTruncate1:
|
||||||
jnc .LTruncate2
|
movw %ax,inoutres
|
||||||
.LTruncate1:
|
.LTruncate2:
|
||||||
movw %ax,U_SYSTEM_INOUTRES;
|
|
||||||
.LTruncate2:
|
|
||||||
leave
|
|
||||||
ret $8
|
|
||||||
end;
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
@ -413,7 +374,7 @@ procedure do_open(var f;p:pchar;flags:longint);
|
|||||||
when (flags and $1000) there is no check for close (needed for textfiles)
|
when (flags and $1000) there is no check for close (needed for textfiles)
|
||||||
}
|
}
|
||||||
var
|
var
|
||||||
oflags : longint;
|
oflags : longint;
|
||||||
begin
|
begin
|
||||||
AllowSlash(p);
|
AllowSlash(p);
|
||||||
{ close first if opened }
|
{ close first if opened }
|
||||||
@ -465,18 +426,18 @@ begin
|
|||||||
end;
|
end;
|
||||||
exit;
|
exit;
|
||||||
end;
|
end;
|
||||||
asm
|
asm
|
||||||
movl $0xff02,%ax
|
movl $0xff02,%eax
|
||||||
movl -4(%ebp),%ecx
|
movl oflags,%ecx
|
||||||
movl 12(%ebp),%ebx
|
movl flags,%ebx
|
||||||
int $0x21
|
int $0x21
|
||||||
jnc .LOPEN1
|
jnc .LOPEN1
|
||||||
movw %ax,U_SYSTEM_INOUTRES;
|
movw %ax,inoutres
|
||||||
movw $0xffff,%ax
|
movw $0xffff,%ax
|
||||||
.LOPEN1:
|
.LOPEN1:
|
||||||
movl 8(%ebp),%edx
|
movl f,%edx
|
||||||
movw %ax,(%edx)
|
movw %ax,(%edx)
|
||||||
end;
|
end;
|
||||||
if (flags and $10)<>0 then
|
if (flags and $10)<>0 then
|
||||||
do_seekend(filerec(f).handle);
|
do_seekend(filerec(f).handle);
|
||||||
end;
|
end;
|
||||||
@ -513,12 +474,12 @@ begin
|
|||||||
buffer[length(s)]:=#0;
|
buffer[length(s)]:=#0;
|
||||||
AllowSlash(pchar(@buffer));
|
AllowSlash(pchar(@buffer));
|
||||||
asm
|
asm
|
||||||
leal buffer,%edx
|
leal buffer,%edx
|
||||||
movb 8(%ebp),%ah
|
movb func,%ah
|
||||||
int $0x21
|
int $0x21
|
||||||
jnc .LDOS_DIRS1
|
jnc .LDOS_DIRS1
|
||||||
movw %ax,U_SYSTEM_INOUTRES;
|
movw %ax,inoutres
|
||||||
.LDOS_DIRS1:
|
.LDOS_DIRS1:
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -540,9 +501,7 @@ begin
|
|||||||
DosDir($3b,s);
|
DosDir($3b,s);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{ thanks to Michael Van Canneyt <michael@tfdec1.fys.kuleuven.ac.be>, }
|
|
||||||
{ who writes this code }
|
|
||||||
{ her is a problem if the getdir is called with a pathstr var in dos.pp }
|
|
||||||
procedure getdir(drivenr : byte;var dir : string);
|
procedure getdir(drivenr : byte;var dir : string);
|
||||||
var
|
var
|
||||||
temp : array[0..255] of char;
|
temp : array[0..255] of char;
|
||||||
@ -550,18 +509,16 @@ var
|
|||||||
i : byte;
|
i : byte;
|
||||||
begin
|
begin
|
||||||
sof:=pchar(@dir[4]);
|
sof:=pchar(@dir[4]);
|
||||||
{ dir[1..3] will contain '[drivenr]:\', but is not }
|
{ dir[1..3] will contain '[drivenr]:\', but is not supplied by DOS,
|
||||||
{ supplied by DOS, so we let dos string start at }
|
so we let dos string start at dir[4]
|
||||||
{ dir[4] }
|
Get dir from drivenr : 0=default, 1=A etc }
|
||||||
{ Get dir from drivenr : 0=default, 1=A etc... }
|
|
||||||
asm
|
asm
|
||||||
movb drivenr,%dl
|
movb drivenr,%dl
|
||||||
movl sof,%esi
|
movl sof,%esi
|
||||||
mov $0x47,%ah
|
mov $0x47,%ah
|
||||||
int $0x21
|
int $0x21
|
||||||
end;
|
end;
|
||||||
{ Now Dir should be filled with directory in ASCIIZ, }
|
{ Now Dir should be filled with directory in ASCIIZ starting from dir[4] }
|
||||||
{ starting from dir[4] }
|
|
||||||
dir[0]:=#3;
|
dir[0]:=#3;
|
||||||
dir[2]:=':';
|
dir[2]:=':';
|
||||||
dir[3]:='\';
|
dir[3]:='\';
|
||||||
@ -575,7 +532,7 @@ begin
|
|||||||
dir[0]:=chr(i);
|
dir[0]:=chr(i);
|
||||||
inc(i);
|
inc(i);
|
||||||
end;
|
end;
|
||||||
{ upcase the string (FPKPascal function) }
|
{ upcase the string }
|
||||||
dir:=upcase(dir);
|
dir:=upcase(dir);
|
||||||
if drivenr<>0 then { Drive was supplied. We know it }
|
if drivenr<>0 then { Drive was supplied. We know it }
|
||||||
dir[1]:=chr(65+drivenr-1)
|
dir[1]:=chr(65+drivenr-1)
|
||||||
@ -584,10 +541,10 @@ begin
|
|||||||
{ We need to get the current drive from DOS function 19H }
|
{ We need to get the current drive from DOS function 19H }
|
||||||
{ because the drive was the default, which can be unknown }
|
{ because the drive was the default, which can be unknown }
|
||||||
asm
|
asm
|
||||||
movb $0x19,%ah
|
movb $0x19,%ah
|
||||||
int $0x21
|
int $0x21
|
||||||
addb $65,%al
|
addb $65,%al
|
||||||
movb %al,i
|
movb %al,i
|
||||||
end;
|
end;
|
||||||
dir[1]:=chr(i);
|
dir[1]:=chr(i);
|
||||||
end;
|
end;
|
||||||
@ -623,60 +580,11 @@ Begin
|
|||||||
{ Reset IO Error }
|
{ Reset IO Error }
|
||||||
InOutRes:=0;
|
InOutRes:=0;
|
||||||
End.
|
End.
|
||||||
|
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.2 1998-03-26 12:21:02 peter
|
Revision 1.3 1998-05-22 00:39:33 peter
|
||||||
* makefile works again
|
* go32v1, go32v2 recompiles with the new objects
|
||||||
* environ is now defined in system.pp (like go32v2)
|
* remake3 works again with go32v2
|
||||||
|
- removed some "optimizes" from daniel which were wrong
|
||||||
|
|
||||||
Revision 1.1.1.1 1998/03/25 11:18:41 root
|
|
||||||
* Restored version
|
|
||||||
|
|
||||||
Revision 1.9 1998/02/14 01:41:35 peter
|
|
||||||
* fixed unusedhandle bug which was -1
|
|
||||||
|
|
||||||
Revision 1.8 1998/01/26 11:57:03 michael
|
|
||||||
+ Added log at the end
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
Working file: rtl/dos/go32v1/system.pp
|
|
||||||
description:
|
|
||||||
----------------------------
|
|
||||||
revision 1.7
|
|
||||||
date: 1998/01/25 21:53:22; author: peter; state: Exp; lines: +12 -8
|
|
||||||
+ Universal Handles support for StdIn/StdOut/StdErr
|
|
||||||
* Updated layout of sysamiga.pas
|
|
||||||
----------------------------
|
|
||||||
revision 1.6
|
|
||||||
date: 1998/01/16 23:10:50; author: florian; state: Exp; lines: +2 -2
|
|
||||||
+ some tobject stuff
|
|
||||||
----------------------------
|
|
||||||
revision 1.5
|
|
||||||
date: 1998/01/11 02:47:31; author: michael; state: Exp; lines: +384 -507
|
|
||||||
* Changed files to use the new filestructure in /inc directory.
|
|
||||||
(By Peter Vreman)
|
|
||||||
----------------------------
|
|
||||||
revision 1.4
|
|
||||||
date: 1998/01/07 00:05:04; author: michael; state: Exp; lines: +189 -184
|
|
||||||
+ Final adjustments for a uniform file handling interface.
|
|
||||||
(From Peter Vreman)
|
|
||||||
----------------------------
|
|
||||||
revision 1.3
|
|
||||||
date: 1998/01/05 16:51:04; author: michael; state: Exp; lines: +18 -46
|
|
||||||
+ Moved init of heap to heap.inc: INITheap() (From Peter Vreman)
|
|
||||||
----------------------------
|
|
||||||
revision 1.2
|
|
||||||
date: 1997/12/01 12:24:06; author: michael; state: Exp; lines: +12 -3
|
|
||||||
+ added copyright reference in header.
|
|
||||||
----------------------------
|
|
||||||
revision 1.1
|
|
||||||
date: 1997/11/27 08:33:53; author: michael; state: Exp;
|
|
||||||
Initial revision
|
|
||||||
----------------------------
|
|
||||||
revision 1.1.1.1
|
|
||||||
date: 1997/11/27 08:33:53; author: michael; state: Exp; lines: +0 -0
|
|
||||||
FPC RTL CVS start
|
|
||||||
=============================================================================
|
|
||||||
}
|
}
|
||||||
|
|||||||
@ -200,8 +200,8 @@ crt$(PPUEXT) : ../crt.pp $(INC)/textrec.inc go32$(PPUEXT) $(SYSTEMPPU)
|
|||||||
$(PP) $(OPT) crt $(REDIR)
|
$(PP) $(OPT) crt $(REDIR)
|
||||||
$(DEL) crt.pp
|
$(DEL) crt.pp
|
||||||
|
|
||||||
objects$(PPUEXT) : ../objects.pp $(SYSTEMPPU)
|
objects$(PPUEXT) : $(INC)/objects.pp $(INC)/platform.inc objinc.inc $(SYSTEMPPU)
|
||||||
$(COPY) ../objects.pp .
|
$(COPY) $(INC)/objects.pp .
|
||||||
$(PP) $(OPT) objects.pp $(REDIR)
|
$(PP) $(OPT) objects.pp $(REDIR)
|
||||||
$(DEL) objects.pp
|
$(DEL) objects.pp
|
||||||
|
|
||||||
@ -229,8 +229,8 @@ mouse$(PPUEXT) : ../mouse.pp $(SYSTEMPPU)
|
|||||||
$(PP) $(OPT) mouse.pp $(REDIR)
|
$(PP) $(OPT) mouse.pp $(REDIR)
|
||||||
$(DEL) mouse.pp
|
$(DEL) mouse.pp
|
||||||
|
|
||||||
getopts$(PPUEXT) : $(PROCINC)/getopts.pp $(SYSTEMPPU)
|
getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMPPU)
|
||||||
$(COPY) $(PROCINC)/getopts.pp .
|
$(COPY) $(INC)/getopts.pp .
|
||||||
$(PP) $(OPT) getopts.pp $(REDIR)
|
$(PP) $(OPT) getopts.pp $(REDIR)
|
||||||
$(DEL) getopts.pp
|
$(DEL) getopts.pp
|
||||||
|
|
||||||
@ -264,7 +264,12 @@ include $(CFG)/makefile.def
|
|||||||
|
|
||||||
#
|
#
|
||||||
# $Log$
|
# $Log$
|
||||||
# Revision 1.8 1998-05-06 11:53:40 peter
|
# Revision 1.9 1998-05-22 00:39:36 peter
|
||||||
|
# * go32v1, go32v2 recompiles with the new objects
|
||||||
|
# * remake3 works again with go32v2
|
||||||
|
# - removed some "optimizes" from daniel which were wrong
|
||||||
|
#
|
||||||
|
# Revision 1.8 1998/05/06 11:53:40 peter
|
||||||
# * update
|
# * update
|
||||||
#
|
#
|
||||||
#
|
#
|
||||||
|
|||||||
File diff suppressed because it is too large
Load Diff
@ -1,9 +1,11 @@
|
|||||||
{
|
{
|
||||||
$Id$
|
$Id$
|
||||||
This file is part of the Free Pascal run time library.
|
This file is part of the Free Pascal run time library.
|
||||||
Copyright (c) 1993,97 by Florian klaempf & Gernot Tenchio
|
Copyright (c) 1993-98 by Florian Klaempf & Gernot Tenchio
|
||||||
members of the Free Pascal development team.
|
members of the Free Pascal development team.
|
||||||
|
|
||||||
|
Graph unit for BP7 compatible RTL
|
||||||
|
|
||||||
See the file COPYING.FPC, included in this distribution,
|
See the file COPYING.FPC, included in this distribution,
|
||||||
for details about the copyright.
|
for details about the copyright.
|
||||||
|
|
||||||
@ -824,44 +826,9 @@ end.
|
|||||||
|
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.2 1998-03-26 10:41:15 florian
|
Revision 1.3 1998-05-22 00:39:23 peter
|
||||||
* some warnings fixed
|
* go32v1, go32v2 recompiles with the new objects
|
||||||
|
* remake3 works again with go32v2
|
||||||
|
- removed some "optimizes" from daniel which were wrong
|
||||||
|
|
||||||
Revision 1.1.1.1 1998/03/25 11:18:41 root
|
|
||||||
* Restored version
|
|
||||||
|
|
||||||
Revision 1.7 1998/03/03 22:48:41 florian
|
|
||||||
+ graph.drawpoly procedure
|
|
||||||
+ putimage with xorput uses mmx if available
|
|
||||||
|
|
||||||
Revision 1.6 1998/03/02 00:17:26 carl
|
|
||||||
+GraphErrorMsg function implemented
|
|
||||||
|
|
||||||
Revision 1.5 1998/02/25 17:08:07 jonas
|
|
||||||
* change interface definition of SetGraphMode to match the implementation
|
|
||||||
|
|
||||||
Revision 1.4 1998/01/26 11:56:33 michael
|
|
||||||
+ Added log at the end
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
Working file: rtl/dos/graph.pp
|
|
||||||
description:
|
|
||||||
----------------------------
|
|
||||||
revision 1.3
|
|
||||||
date: 1997/12/03 15:24:19; author: florian; state: Exp; lines: +38 -11
|
|
||||||
Graph.SetGraphMode for DOS added
|
|
||||||
----------------------------
|
|
||||||
revision 1.2
|
|
||||||
date: 1997/12/01 12:15:46; author: michael; state: Exp; lines: +15 -73
|
|
||||||
+ added copyright reference in header.
|
|
||||||
----------------------------
|
|
||||||
revision 1.1
|
|
||||||
date: 1997/11/27 08:33:50; author: michael; state: Exp;
|
|
||||||
Initial revision
|
|
||||||
----------------------------
|
|
||||||
revision 1.1.1.1
|
|
||||||
date: 1997/11/27 08:33:50; author: michael; state: Exp; lines: +0 -0
|
|
||||||
FPC RTL CVS start
|
|
||||||
=============================================================================
|
|
||||||
}
|
}
|
||||||
|
|||||||
@ -3,6 +3,8 @@
|
|||||||
This file is part of the Free Pascal run time library.
|
This file is part of the Free Pascal run time library.
|
||||||
Copyright (c) 1993,97 by the Free Pascal development team
|
Copyright (c) 1993,97 by the Free Pascal development team
|
||||||
|
|
||||||
|
Mouse unit containing allmost all interrupt 33h functions
|
||||||
|
|
||||||
See the file COPYING.FPC, included in this distribution,
|
See the file COPYING.FPC, included in this distribution,
|
||||||
for details about the copyright.
|
for details about the copyright.
|
||||||
|
|
||||||
@ -405,31 +407,9 @@ Begin
|
|||||||
End.
|
End.
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.3 1998-04-05 13:56:54 peter
|
Revision 1.4 1998-05-22 00:39:25 peter
|
||||||
- fixed mouse to compile with $i386_att
|
* go32v1, go32v2 recompiles with the new objects
|
||||||
+ linux crt supports redirecting (not Esc-codes anymore)
|
* remake3 works again with go32v2
|
||||||
|
- removed some "optimizes" from daniel which were wrong
|
||||||
|
|
||||||
Revision 1.2 1998/03/26 12:25:22 peter
|
|
||||||
* integrated both mouse units
|
|
||||||
|
|
||||||
Revision 1.1.1.1 1998/03/25 11:18:41 root
|
|
||||||
* Restored version
|
|
||||||
|
|
||||||
Revision 1.4 1998/03/24 15:53:12 peter
|
|
||||||
* cleanup and doesn't give warnings when compiling
|
|
||||||
|
|
||||||
Revision 1.3 1998/01/26 11:56:24 michael
|
|
||||||
+ Added log at the end
|
|
||||||
|
|
||||||
Revision 1.2
|
|
||||||
date: 1997/12/01 12:15:45; author: michael; state: Exp; lines: +14 -12
|
|
||||||
+ added copyright reference in header.
|
|
||||||
|
|
||||||
Revision 1.1
|
|
||||||
date: 1997/11/27 08:33:49; author: michael; state: Exp;
|
|
||||||
Initial revision
|
|
||||||
|
|
||||||
Revision 1.1.1.1
|
|
||||||
date: 1997/11/27 08:33:49; author: michael; state: Exp; lines: +0 -0
|
|
||||||
FPC RTL CVS start
|
|
||||||
}
|
}
|
||||||
|
|||||||
@ -1,9 +1,11 @@
|
|||||||
{
|
{
|
||||||
$Id$
|
$Id$
|
||||||
This file is part of the Free Pascal run time library.
|
This file is part of the Free Pascal run time library.
|
||||||
Copyright (c) 1993,97 by Florian Klaempfl
|
Copyright (c) 1993,98 by Florian Klaempfl
|
||||||
member of the Free Pascal development team
|
member of the Free Pascal development team
|
||||||
|
|
||||||
|
Printer unit for BP7 compatible RTL
|
||||||
|
|
||||||
See the file COPYING.FPC, included in this distribution,
|
See the file COPYING.FPC, included in this distribution,
|
||||||
for details about the copyright.
|
for details about the copyright.
|
||||||
|
|
||||||
@ -12,62 +14,35 @@
|
|||||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
||||||
|
|
||||||
**********************************************************************}
|
**********************************************************************}
|
||||||
|
|
||||||
{
|
|
||||||
History:
|
|
||||||
10.4.1994: Version 1.0
|
|
||||||
Unit is completely implemented
|
|
||||||
}
|
|
||||||
|
|
||||||
unit printer;
|
unit printer;
|
||||||
|
interface
|
||||||
|
|
||||||
interface
|
var
|
||||||
|
lst : text;
|
||||||
|
|
||||||
var
|
implementation
|
||||||
lst : text;
|
|
||||||
|
|
||||||
implementation
|
var
|
||||||
|
old_exit : pointer;
|
||||||
|
|
||||||
var
|
procedure printer_exit;
|
||||||
old_exit : pointer;
|
begin
|
||||||
|
close(lst);
|
||||||
|
exitproc:=old_exit;
|
||||||
|
end;
|
||||||
|
|
||||||
procedure printer_exit;
|
|
||||||
|
|
||||||
begin
|
|
||||||
close(lst);
|
|
||||||
exitproc:=old_exit;
|
|
||||||
end;
|
|
||||||
|
|
||||||
begin
|
begin
|
||||||
assign(lst,'PRN');
|
assign(lst,'PRN');
|
||||||
rewrite(lst);
|
rewrite(lst);
|
||||||
old_exit:=exitproc;
|
old_exit:=exitproc;
|
||||||
exitproc:=@printer_exit;
|
exitproc:=@printer_exit;
|
||||||
end.
|
end.
|
||||||
|
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.1 1998-03-25 11:18:41 root
|
Revision 1.2 1998-05-22 00:39:26 peter
|
||||||
Initial revision
|
* go32v1, go32v2 recompiles with the new objects
|
||||||
|
* remake3 works again with go32v2
|
||||||
|
- removed some "optimizes" from daniel which were wrong
|
||||||
|
|
||||||
Revision 1.3 1998/01/26 11:56:59 michael
|
|
||||||
+ Added log at the end
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
Working file: rtl/dos/printer.pp
|
|
||||||
description:
|
|
||||||
----------------------------
|
|
||||||
revision 1.2
|
|
||||||
date: 1997/12/01 12:15:48; author: michael; state: Exp; lines: +13 -6
|
|
||||||
+ added copyright reference in header.
|
|
||||||
----------------------------
|
|
||||||
revision 1.1
|
|
||||||
date: 1997/11/27 08:33:50; author: michael; state: Exp;
|
|
||||||
Initial revision
|
|
||||||
----------------------------
|
|
||||||
revision 1.1.1.1
|
|
||||||
date: 1997/11/27 08:33:50; author: michael; state: Exp; lines: +0 -0
|
|
||||||
FPC RTL CVS start
|
|
||||||
=============================================================================
|
|
||||||
}
|
}
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user