paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-15 10:40:13 +02:00
Code Issues Packages Projects Releases Wiki Activity

* go32v1, go32v2 recompiles with the new objects

Browse Source 
* remake3 works again with go32v2
  - removed some "optimizes" from daniel which were wrong
This commit is contained in:
peter 1998-05-22 00:39:22 +00:00
parent 92924c2075
commit b0b403d498
10 changed files with 1485 additions and 1680 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

739
rtl/dos/dos.pp
View File

@ -3,6 +3,8 @@
This file is part of the Free Pascal run time library.
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,
for details about the copyright.
@ -68,9 +70,7 @@ Type
{$i filerec.inc}
{$i textrec.inc}
{$PACKRECORDS 1}
DateTime = record
DateTime = packed record
Year,
Month,
Day,
@ -79,8 +79,9 @@ Type
Sec : word;
End;
{$IFDEF GO32V2}
searchrec = record
{$ifdef GO32V2}
searchrec = packed record
fill : array[1..21] of byte;
attr : byte;
time : longint;
@ -92,7 +93,8 @@ Type
Registers = Go32.Registers;
{$ELSE}
searchrec = record
searchrec = packed record
fill : array[1..21] of byte;
attr : byte;
time : longint;
@ -101,7 +103,7 @@ Type
name : string[15]; { the same size as declared by (DJ GNU C) }
end;
registers = record
registers = packed record
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);
1 : (al,ah,f9,f10,bl,bh,f11,f12,cl,ch,f13,f14,dl,dh : byte);
@ -109,8 +111,6 @@ Type
end;
{$endif GO32V1}
{$PACKRECORDS 2}
Var
DosError : integer;
@ -249,95 +249,99 @@ var
end;
{$endif GO32V2}
procedure msdos(var regs : registers);
begin
intr($21,regs);
end;
procedure msdos(var regs : registers);
begin
intr($21,regs);
end;
{******************************************************************************
--- Info / Date / Time ---
******************************************************************************}
function dosversion : word;
begin
dosregs.ax:=$3000;
msdos(dosregs);
dosversion:=dosregs.ax;
end;
function dosversion : word;
begin
dosregs.ax:=$3000;
msdos(dosregs);
dosversion:=dosregs.ax;
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);
begin
dosregs.cx:=year;
dosregs.dh:=month;
dosregs.dl:=day;
dosregs.ah:=$2b;
msdos(dosregs);
LoadDosError;
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 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);
begin
dosregs.ch:=hour;
dosregs.cl:=minute;
dosregs.dh:=second;
dosregs.dl:=sec100;
dosregs.ah:=$2d;
msdos(dosregs);
LoadDosError;
end;
procedure setdate(year,month,day : word);
begin
dosregs.cx:=year;
dosregs.dh:=month;
dosregs.dl:=day;
dosregs.ah:=$2b;
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
t.sec:=(p and 31) shl 1;
t.min:=(p shr 5) and 63;
t.hour:=(p shr 11) and 31;
t.day:=(p shr 16) and 31;
t.month:=(p shr 21) and 15;
t.year:=(p shr 25)+1980;
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);
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 ---
******************************************************************************}
var
lastdosexitcode : word;
var
lastdosexitcode : word;
{$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
Format of EXEC parameter block for AL=00h,01h,04h:
Offset Size Description
@ -350,222 +354,224 @@ var
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
INT 21 4B--
}
}
type
realptr = record
ofs,seg : word;
end;
procedure exec(const path : pathstr;const comline : comstr);
type
realptr = packed record
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
envseg : word;
comtail : realptr;
firstFCB : realptr;
secondFCB : realptr;
iniStack : realptr;
iniCSIP : realptr;
end;
function paste_to_dos(src : string) : boolean;
var
c : array[0..255] of char;
begin
paste_to_dos:=false;
if current_dos_buffer_pos+length(src)+1>transfer_buffer+tb_size then
RunError(217);
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;
function paste_to_dos(src : string) : boolean;
var c : array[0..255] of char;
begin
paste_to_dos:=false;
if current_dos_buffer_pos+length(src)+1>transfer_buffer+tb_size then
RunError(217);
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
i,la_env,la_p,la_c,la_e,fcb1_la,fcb2_la : longint;
arg_ofs : longint;
execblock : texecblock;
begin
la_env:=transfer_buffer;
while (la_env mod 16)<>0 do inc(la_env);
current_dos_buffer_pos:=la_env;
for i:=1 to envcount do
begin
paste_to_dos(envstr(i));
end;
paste_to_dos(''); { adds a double zero at the end }
{ allow slash as backslash }
for i:=1 to length(p) do
if p[i]='/' then p[i]:='\';
la_p:=current_dos_buffer_pos;
paste_to_dos(p);
la_c:=current_dos_buffer_pos;
paste_to_dos(c);
la_e:=current_dos_buffer_pos;
fcb1_la:=la_e;
la_e:=la_e+16;
fcb2_la:=la_e;
la_e:=la_e+16;
{ allocate FCB see dosexec code }
dosregs.ax:=$2901;
arg_ofs:=1;
while (c[arg_ofs]=' ') or (c[arg_ofs]=#9) do inc(arg_ofs);
dosregs.ds:=(la_c+arg_ofs) div 16;
dosregs.si:=(la_c+arg_ofs) mod 16;
dosregs.es:=fcb1_la div 16;
dosregs.di:=fcb1_la mod 16;
msdos(dosregs);
repeat
inc(arg_ofs);
until (c[arg_ofs]=' ') or
(c[arg_ofs]=#9) or
(c[arg_ofs]=#13);
if c[arg_ofs]<>#13 then
begin
inc(arg_ofs);
while (c[arg_ofs]=' ') or (c[arg_ofs]=#9) do inc(arg_ofs);
end;
{ allocate second FCB see dosexec code }
dosregs.ax:=$2901;
dosregs.ds:=(la_c+arg_ofs) div 16;
dosregs.si:=(la_c+arg_ofs) mod 16;
dosregs.es:=fcb2_la div 16;
dosregs.di:=fcb2_la mod 16;
msdos(dosregs);
with execblock do
begin
envseg:=la_env div 16;
comtail.seg:=la_c div 16;
comtail.ofs:=la_c mod 16;
firstFCB.seg:=fcb1_la div 16;
firstFCB.ofs:=fcb1_la mod 16;
secondFCB.seg:=fcb2_la div 16;
secondFCB.ofs:=fcb2_la mod 16;
end;
seg_move(get_ds,longint(@execblock),dosmemselector,la_e,sizeof(texecblock));
dosregs.edx:=la_p mod 16;
dosregs.ds:=la_p div 16;
dosregs.ebx:=la_e mod 16;
dosregs.es:=la_e div 16;
dosregs.ax:=$4b00;
msdos(dosregs);
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;
begin
{ create command line }
move(comline[0],c[1],length(comline)+1);
c[length(comline)+2]:=#13;
c[0]:=char(length(comline)+2);
{ create path }
p:=path;
for i:=1 to length(p) do
if p[i]='/' then
p[i]:='\';
{ create buffer }
la_env:=transfer_buffer;
while (la_env and 15)<>0 do
inc(la_env);
current_dos_buffer_pos:=la_env;
{ copy environment }
for i:=1 to envcount do
paste_to_dos(envstr(i));
paste_to_dos(''); { adds a double zero at the end }
{ allow slash as backslash }
la_p:=current_dos_buffer_pos;
paste_to_dos(p);
la_c:=current_dos_buffer_pos;
paste_to_dos(c);
la_e:=current_dos_buffer_pos;
fcb1_la:=la_e;
la_e:=la_e+16;
fcb2_la:=la_e;
la_e:=la_e+16;
{ allocate FCB see dosexec code }
arg_ofs:=1;
while (c[arg_ofs] in [' ',#9]) do
inc(arg_ofs);
dosregs.ax:=$2901;
dosregs.ds:=(la_c+arg_ofs) shr 4;
dosregs.esi:=(la_c+arg_ofs) and 15;
dosregs.es:=fcb1_la shr 4;
dosregs.edi:=fcb1_la and 15;
msdos(dosregs);
{ allocate second FCB see dosexec code }
repeat
inc(arg_ofs);
until (c[arg_ofs] in [' ',#9,#13]);
if c[arg_ofs]<>#13 then
begin
repeat
inc(arg_ofs);
until not (c[arg_ofs] in [' ',#9]);
end;
dosregs.ax:=$2901;
dosregs.ds:=(la_c+arg_ofs) shr 4;
dosregs.si:=(la_c+arg_ofs) and 15;
dosregs.es:=fcb2_la shr 4;
dosregs.di:=fcb2_la and 15;
msdos(dosregs);
with execblock do
begin
envseg:=la_env shr 4;
comtail.seg:=la_c shr 4;
comtail.ofs:=la_c and 15;
firstFCB.seg:=fcb1_la shr 4;
firstFCB.ofs:=fcb1_la and 15;
secondFCB.seg:=fcb2_la shr 4;
secondFCB.ofs:=fcb2_la and 15;
end;
seg_move(get_ds,longint(@execblock),dosmemselector,la_e,sizeof(texecblock));
dosregs.edx:=la_p and 15;
dosregs.ds:=la_p shr 4;
dosregs.ebx:=la_e and 15;
dosregs.es:=la_e shr 4;
dosregs.ax:=$4b00;
msdos(dosregs);
LoadDosError;
if DosError=0 then
begin
dosregs.ax:=$4d00;
msdos(dosregs);
LastDosExitCode:=DosRegs.al
end
else
LastDosExitCode:=0;
end;
{$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);
begin
asm
movl 12(%ebp),%ebx
movw $0xff07,%ax
int $0x21
movw %ax,_LASTDOSEXITCODE
end;
end;
{$endif}
var
i : longint;
execute : string;
b : array[0..255] of char;
begin
doserror:=0;
execute:=path+' '+comline;
{ allow slash as backslash for the program name only }
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;
function dosexitcode : word;
begin
dosexitcode:=lastdosexitcode;
end;
{$endif GO32V2}
function dosexitcode : word;
begin
dosexitcode:=lastdosexitcode;
end;
procedure getcbreak(var breakvalue : boolean);
begin
dosregs.ax:=$3300;
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);
begin
dosregs.ax:=$3301;
dosregs.dl:=ord(breakvalue);
msdos(dosregs);
end;
procedure setcbreak(breakvalue : boolean);
begin
dosregs.ax:=$3301;
dosregs.dl:=ord(breakvalue);
msdos(dosregs);
end;
procedure getverify(var verify : boolean);
begin
dosregs.ah:=$54;
msdos(dosregs);
verify:=dosregs.al<>0;
end;
procedure setverify(verify : boolean);
begin
dosregs.ah:=$2e;
dosregs.al:=ord(verify);
msdos(dosregs);
end;
procedure getverify(var verify : boolean);
begin
dosregs.ah:=$54;
msdos(dosregs);
verify:=dosregs.al<>0;
end;
procedure setverify(verify : boolean);
begin
dosregs.ah:=$2e;
dosregs.al:=ord(verify);
msdos(dosregs);
end;
{******************************************************************************
--- Disk ---
******************************************************************************}
function diskfree(drive : byte) : longint;
begin
dosregs.dl:=drive;
dosregs.ah:=$36;
msdos(dosregs);
if dosregs.ax<>$FFFF then
diskfree:=dosregs.ax*dosregs.bx*dosregs.cx
else
diskfree:=-1;
end;
function diskfree(drive : byte) : longint;
begin
dosregs.dl:=drive;
dosregs.ah:=$36;
msdos(dosregs);
if dosregs.ax<>$FFFF then
diskfree:=dosregs.ax*dosregs.bx*dosregs.cx
else
diskfree:=-1;
end;
function disksize(drive : byte) : longint;
begin
dosregs.dl:=drive;
dosregs.ah:=$36;
msdos(dosregs);
if dosregs.ax<>$FFFF then
disksize:=dosregs.ax*dosregs.cx*dosregs.dx
else
disksize:=-1;
end;
function disksize(drive : byte) : longint;
begin
dosregs.dl:=drive;
dosregs.ah:=$36;
msdos(dosregs);
if dosregs.ax<>$FFFF then
disksize:=dosregs.ax*dosregs.cx*dosregs.dx
else
disksize:=-1;
end;
{******************************************************************************
--- Findfirst FindNext ---
--- Findfirst FindNext ---
******************************************************************************}
procedure searchrec2dossearchrec(var f : searchrec);
@ -814,10 +820,13 @@ var
{Now remove also all references to '\..\' + of course previous dirs..}
repeat
i:=pos('\..\',pa);
if i<>0 then j:=i-1;
while (j>1) and (pa[j]<>'\') do
dec (j);
delete (pa,j,i-j+3);
if i<>0 then
begin
j:=i-1;
while (j>1) and (pa[j]<>'\') do
dec (j);
delete (pa,j,i-j+3);
end;
until i=0;
{Remove End . and \}
if (length(pa)>0) and (pa[length(pa)]='.') then
@ -866,8 +875,6 @@ var
end;
end;
{$ifdef GO32V2}
procedure getftime(var f;var time : longint);
begin
dosregs.bx:=textrec(f).handle;
@ -887,109 +894,100 @@ var
doserror:=dosregs.al;
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);
begin
copytodos(filerec(f).name,strlen(filerec(f).name)+1);
dosregs.ax:=$4301;
dosregs.edx:=transfer_buffer mod 16;
dosregs.ds:=transfer_buffer div 16;
dosregs.cx:=attr;
msdos(dosregs);
LoadDosError;
end;
procedure getfattr(var f;var attr : word);
{$ifndef GO32V2}
var
n : array[0..255] of char;
{$endif}
begin
{$ifdef GO32V2}
copytodos(filerec(f).name,strlen(filerec(f).name)+1);
dosregs.edx:=transfer_buffer and 15;
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);
var
n : array[0..255] of char;
r : registers;
begin
strpcopy(n,filerec(f).name);
dosregs.ax:=$4300;
dosregs.edx:=longint(@n);
msdos(dosregs);
LoadDosError;
attr:=dosregs.cx;
end;
procedure setfattr(var f;attr : word);
var
n : array[0..255] of char;
r : registers;
begin
strpcopy(n,filerec(f).name);
dosregs.ax:=$4301;
dosregs.edx:=longint(@n);
dosregs.cx:=attr;
msdos(dosregs);
LoadDosError;
end;
{$endif GO32V2}
procedure setfattr(var f;attr : word);
{$ifndef GO32V2}
var
n : array[0..255] of char;
{$endif}
begin
{$ifdef GO32V2}
copytodos(filerec(f).name,strlen(filerec(f).name)+1);
dosregs.edx:=transfer_buffer mod 16;
dosregs.ds:=transfer_buffer div 16;
{$else}
strpcopy(n,filerec(f).name);
dosregs.edx:=longint(@n);
{$endif}
dosregs.ax:=$4301;
dosregs.cx:=attr;
msdos(dosregs);
LoadDosError;
end;
{******************************************************************************
--- Environment ---
******************************************************************************}
function envcount : longint;
var
hp : ppchar;
begin
hp:=envp;
envcount:=0;
while assigned(hp^) do
begin
inc(envcount);
hp:=hp+4;
end;
end;
function envcount : longint;
var
hp : ppchar;
begin
hp:=envp;
envcount:=0;
while assigned(hp^) do
begin
inc(envcount);
hp:=hp+4;
end;
end;
function envstr(index : integer) : string;
begin
if (index<=0) or (index>envcount) then
begin
envstr:='';
exit;
end;
envstr:=strpas(ppchar(envp+4*(index-1))^);
end;
function envstr(index : integer) : string;
begin
if (index<=0) or (index>envcount) then
begin
envstr:='';
exit;
end;
envstr:=strpas(ppchar(envp+4*(index-1))^);
end;
Function GetEnv(envvar: string): string;
var
hp : ppchar;
hs : string;
eqpos : longint;
begin
envvar:=upcase(envvar);
hp:=envp;
getenv:='';
while assigned(hp^) do
begin
hs:=strpas(hp^);
eqpos:=pos('=',hs);
if copy(hs,1,eqpos-1)=envvar then
begin
getenv:=copy(hs,eqpos+1,255);
exit;
end;
hp:=hp+4;
end;
end;
Function GetEnv(envvar: string): string;
var
hp : ppchar;
hs : string;
eqpos : longint;
begin
envvar:=upcase(envvar);
hp:=envp;
getenv:='';
while assigned(hp^) do
begin
hs:=strpas(hp^);
eqpos:=pos('=',hs);
if copy(hs,1,eqpos-1)=envvar then
begin
getenv:=copy(hs,eqpos+1,255);
exit;
end;
hp:=hp+4;
end;
end;
{******************************************************************************
--- Not Supported ---
@ -1011,7 +1009,12 @@ End;
end.
{
$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
+ assign(pchar), assign(char), rename(pchar), rename(char)
* fixed read_text_as_array

20
rtl/dos/go32v1/makefile
View File

@ -86,13 +86,13 @@ PPI=../ppi
include $(CFG)/makefile.cfg
# Get the system independent include file names.
# This will set the following variables :
# This will set the following variables :
# SYSINCNAMES
include $(INC)/makefile.inc
SYSINCDEPS=$(addprefix $(INC)/,$(SYSINCNAMES))
# Get the processor dependent include file names.
# This will set the following variables :
# This will set the following variables :
# CPUINCNAMES
include $(PROCINC)/makefile.cpu
SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES))
@ -198,15 +198,15 @@ dos$(PPUEXT) : ../dos.pp $(INC)/filerec.inc $(INC)/textrec.inc \
go32$(PPUEXT) strings$(PPUEXT) $(SYSTEMPPU)
$(COPY) ../dos.pp .
$(PP) $(OPT) dos $(REDIR)
$(DEL) dos.pp
$(DEL) dos.pp
crt$(PPUEXT) : ../crt.pp $(INC)/textrec.inc go32$(PPUEXT) $(SYSTEMPPU)
$(COPY) ../crt.pp .
$(PP) $(OPT) crt $(REDIR)
$(DEL) crt.pp
objects$(PPUEXT) : ../objects.pp $(SYSTEMPPU)
$(COPY) ../objects.pp .
objects$(PPUEXT) : $(INC)/objects.pp objinc.inc $(SYSTEMPPU)
$(COPY) $(INC)/objects.pp .
$(PP) $(OPT) objects.pp $(REDIR)
$(DEL) objects.pp
@ -234,15 +234,15 @@ mouse$(PPUEXT) : ../mouse.pp $(SYSTEMPPU)
$(PP) $(OPT) mouse.pp $(REDIR)
$(DEL) mouse.pp
getopts$(PPUEXT) : $(PROCINC)/getopts.pp $(SYSTEMPPU)
$(COPY) $(PROCINC)/getopts.pp .
getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMPPU)
$(COPY) $(INC)/getopts.pp .
$(PP) $(OPT) getopts.pp $(REDIR)
$(DEL) getopts.pp
graph$(PPUEXT) : ../graph.pp go32$(PPUEXT) $(SYSTEMPPU) mmx$(PPUEXT) \
$(PPIDEPS)
PPIFILES:=$(wildcard $(PPI)/*.ppi)
graph$(PPUEXT) : ../graph.pp go32$(PPUEXT) $(SYSTEMPPU) mmx$(PPUEXT) $(PPIFILES)
$(COPY) ../graph.pp .
$(PP) $(OPT) -Up$(PPI) graph $(REDIR)
$(PP) $(OPT) -I$(PPI) graph $(REDIR)
$(DEL) graph.pp

28
rtl/dos/go32v1/os.inc
View File

@ -11,7 +11,7 @@
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
{$define dos}
{$define go32v1}
{$undef go32v2}
{$undef os2}
{$undef linux}
@ -19,27 +19,9 @@
{
$Log$
Revision 1.1 1998-03-25 11:18:41 root
Initial revision
Revision 1.2 1998-05-22 00:39:31 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/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
=============================================================================
}

87
rtl/dos/go32v1/prt0.as
View File

@ -3,6 +3,8 @@
# This file is part of the Free Pascal run time library.
# Copyright (c) 1993,97 by the Free Pascal development team.
#
# Go32V1 Startup code
#
# See the file COPYING.FPC, included in this distribution,
# for details about the copyright.
#
@ -11,14 +13,13 @@
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
#
# **********************************************************************
#///*
#//** Called as start(argc, argv, envp)
#//*/
#///* gs:edx points to prog_info structure. All other registers are OBSOLETE
#//** but included for backwards compatibility
#//*/
.text
#
# Called as start(argc, argv, envp)
#
# gs:edx points to prog_info structure. All other registers are OBSOLETE
# but included for backwards compatibility
#
.text
.globl _start
_start:
.globl start
@ -36,7 +37,7 @@ start:
movw %ds,%ax
cmpw %cx,%ax
je Lcopy_none
# /* set the right size */
# set the right size
movl $40,U_SYSTEM_GO32_INFO_BLOCK
movl %gs:(%edx), %ecx
@ -84,9 +85,9 @@ Lcopy_done:
movw U_SYSTEM_GO32_INFO_BLOCK+36,%ax
movw %ax,_run_mode
#/* I need a value for the stack bottom, */
#/* but I don't know how to get it from go32 */
#/* I suppose the stack is 4Ko long, is this true ? */
# I need a value for the stack bottom,
# but I don't know how to get it from go32
# I suppose the stack is 4Ko long, is this true ?
movl %esp,%eax
subl $0x4000,%eax
movl %eax,__stkbottom
@ -94,7 +95,7 @@ Lcopy_done:
movw U_SYSTEM_GO32_INFO_BLOCK+26,%ax
movw %ax,_core_selector
movl U_SYSTEM_GO32_INFO_BLOCK+28,%eax
movl %eax,U_SYSTEM_STUB_INFO
movl %eax,U_SYSTEM_STUB_INFO
xorl %esi,%esi
xorl %edi,%edi
xorl %ebp,%ebp
@ -105,15 +106,16 @@ Lcopy_done:
movl %esp,%ebx
movl 8(%ebx),%eax
movl %eax,_environ
movl %eax,U_SYSTEM_ENVIRON
movl %eax,U_SYSTEM_ENVP
movl 4(%ebx),%eax
movl %eax,_args
movl %eax,U_SYSTEM_ARGV
movl (%ebx),%eax
movl %eax,_argc
movl %eax,U_SYSTEM_ARGC
call PASCALMAIN
exit_again:
movl $0x4c00,%eax
int $0x21
@ -121,23 +123,31 @@ exit_again:
ret
.data
.data
.globl _argc
_argc:
.long 0
.globl _args
_args:
.long 0
.globl _run_mode
_run_mode:
.word 0
.globl _core_selector
_core_selector:
.word 0
.globl _environ
_environ:
.long 0
.globl __stkbottom
__stkbottom:
.long 0
.globl _run_mode
_run_mode:
.word 0
.globl _core_selector
_core_selector:
.word 0
.globl ___pid
___pid:
.long 42
@ -155,30 +165,21 @@ _ScreenSecondary:
.long 0
.globl __hard_master
.globl __hard_slave
.globl __core_select
__hard_master:
.byte 0
.globl __hard_slave
__hard_slave:
.byte 0
.globl __core_select
__core_select:
.short 0
.globl __stkbottom
__stkbottom:
.long 0
# .globl U_SYSTEM_GO32_INFO_BLOCK
# U_SYSTEM_GO32_INFO_BLOCK:
# .long __go32_end - U_SYSTEM_GO32_INFO_BLOCK #//* size */
# .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:
#
# $Log$
# Revision 1.3 1998-05-22 00:39:32 peter
# * go32v1, go32v2 recompiles with the new objects
# * remake3 works again with go32v2
# - removed some "optimizes" from daniel which were wrong
#
#

602
rtl/dos/go32v1/system.pp
View File

@ -12,30 +12,45 @@
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
{ system unit for go32v1 }
{$define DOS}
unit system;
interface
{ no stack check in system }
{$S-}
{$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
UnusedHandle=$ffff;
StdInputHandle=0;
StdOutputHandle=1;
StdErrorHandle=2;
{ Default filehandles }
UnusedHandle = $ffff;
StdInputHandle = 0;
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
{$PACKRECORDS 1}
t_stub_info = record
{ Dos Extender info }
p_stub_info = ^t_stub_info;
t_stub_info = packed record
magic : array[0..15] of char;
size : longint;
minstack : longint;
@ -50,49 +65,47 @@ type
basename : array[0..7] of char;
argv0 : array [0..15] of char;
dpmi_server : array [0..15] of char;
end;
p_stub_info = ^t_stub_info;
end;
t_go32_info_block = record
size_of_this_structure_in_bytes : longint; {offset 0}
linear_address_of_primary_screen : longint; {offset 4}
t_go32_info_block = packed record
size_of_this_structure_in_bytes : longint; {offset 0}
linear_address_of_primary_screen : longint; {offset 4}
linear_address_of_secondary_screen : longint; {offset 8}
linear_address_of_transfer_buffer : longint; {offset 12}
size_of_transfer_buffer : longint; {offset 16}
pid : longint; {offset 20}
master_interrupt_controller_base : byte; {offset 24}
slave_interrupt_controller_base : byte; {offset 25}
selector_for_linear_memory : word; {offset 26}
linear_address_of_transfer_buffer : longint; {offset 12}
size_of_transfer_buffer : longint; {offset 16}
pid : longint; {offset 20}
master_interrupt_controller_base : byte; {offset 24}
slave_interrupt_controller_base : byte; {offset 25}
selector_for_linear_memory : word; {offset 26}
linear_address_of_stub_info_structure : longint; {offset 28}
linear_address_of_original_psp : longint; {offset 32}
run_mode : word; {offset 36}
run_mode_info : word; {offset 38}
end;
{$PACKRECORDS NORMAL}
linear_address_of_original_psp : longint; {offset 32}
run_mode : word; {offset 36}
run_mode_info : word; {offset 38}
end;
var
stub_info : p_stub_info;
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-}
procedure st1(stack_size : longint);[public,alias: 'STACKCHECK'];
{ include system independent routines }
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 !! }
{$I system.inc}
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 %ebx
movl stack_size,%ebx
@ -116,88 +129,62 @@ var
{ can be usefull for error recovery !! }
popl %ebx
popl %eax
end['EAX','EBX'];
RunError(202);
{ this needs a local variable }
{ so the function called itself !! }
{ Writeln('low in stack ');
RunError(202); }
end;
end['EAX','EBX'];
RunError(202);
end;
procedure halt(errnum : byte);
begin
do_exit;
flush(stderr);
asm
movl $0x4c00,%eax
movb 8(%ebp),%al
int $0x21
end;
end;
{$I386_ATT}
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
asm
movl _args,%eax
leave
ret
end ['EAX'];
end;
function paramstr(l : longint) : string;
begin
if (l>=0) and (l+1<=argc) then
paramstr:=strpas(argv[l])
else
paramstr:='';
end;
var
p : ^pchar;
begin
if (l>=0) and (l<=paramcount) then
begin
p:=args;
paramstr:=strpas(p[l]);
end
else paramstr:='';
end;
procedure randomize;assembler;
asm
movb $0x2c,%ah
int $0x21
shll $16,%ecx
movw %dx,%cx
movl %ecx,randseed
end;
procedure randomize;
var
hl : longint;
begin
asm
movb $0x2c,%ah
int $0x21
movw %cx,-4(%ebp)
movw %dx,-2(%ebp)
end;
randseed:=hl;
end;
{*****************************************************************************
Heap Management
*****************************************************************************}
{ use standard heap management }
{ sbrk function of go32v1 }
function Sbrk(size : longint) : longint;
begin
asm
movl size,%ebx
movl $0x4a01,%eax
int $0x21
movl %eax,__RESULT
end;
end;
function Sbrk(size : longint) : longint;assembler;
asm
movl size,%ebx
movl $0x4a01,%eax
int $0x21
end;
{ include standard heap management }
{$I heap.inc}
@ -215,15 +202,13 @@ begin
end;
procedure do_close(h : longint);
begin
asm
movl 8(%ebp),%ebx
movb $0x3e,%ah
pushl %ebp
intl $0x21
popl %ebp
end;
procedure do_close(h : longint);assembler;
asm
movl h,%ebx
movb $0x3e,%ah
pushl %ebp
intl $0x21
popl %ebp
end;
@ -231,14 +216,14 @@ procedure do_erase(p : pchar);
begin
AllowSlash(p);
asm
movl 8(%ebp),%edx
movb $0x41,%ah
pushl %ebp
int $0x21
popl %ebp
jnc .LERASE1
movw %ax,U_SYSTEM_INOUTRES;
.LERASE1:
movl p,%edx
movb $0x41,%ah
pushl %ebp
int $0x21
popl %ebp
jnc .LERASE1
movw %ax,inoutres
.LERASE1:
end;
end;
@ -248,159 +233,135 @@ begin
AllowSlash(p1);
AllowSlash(p2);
asm
movl 8(%ebp),%edx
movl 12(%ebp),%edi
movb $0x56,%ah
pushl %ebp
int $0x21
popl %ebp
jnc .LRENAME1
movw %ax,U_SYSTEM_INOUTRES;
.LRENAME1:
movl p1,%edx
movl p2,%edi
movb $0x56,%ah
pushl %ebp
int $0x21
popl %ebp
jnc .LRENAME1
movw %ax,inoutres
.LRENAME1:
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
int $0x21
jnc .LDOSWRITE1
movw %ax,U_SYSTEM_INOUTRES;
.LDOSWRITE1:
movl %eax,-4(%ebp)
end;
function do_write(h,addr,len : longint) : longint;assembler;
asm
movl len,%ecx
movl addr,%edx
movl h,%ebx
movb $0x40,%ah
int $0x21
jnc .LDOSWRITE1
movw %ax,inoutres
xorl %eax,%eax
.LDOSWRITE1:
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
int $0x21
jnc .LDOSREAD1
movw %ax,U_SYSTEM_INOUTRES;
xorl %eax,%eax
.LDOSREAD1:
leave
ret $12
end;
function do_read(h,addr,len : longint) : longint;assembler;
asm
movl len,%ecx
movl addr,%edx
movl h,%ebx
movb $0x3f,%ah
int $0x21
jnc .LDOSREAD1
movw %ax,inoutres
xorl %eax,%eax
.LDOSREAD1:
end;
function do_filepos(handle : longint) : longint;
begin
asm
movb $0x42,%ah
movb $0x1,%al
movl 8(%ebp),%ebx
xorl %ecx,%ecx
xorl %edx,%edx
pushl %ebp
int $0x21
popl %ebp
jnc .LDOSFILEPOS1
movw %ax,U_SYSTEM_INOUTRES;
xorl %eax,%eax
jmp .LDOSFILEPOS2
.LDOSFILEPOS1:
shll $16,%edx
movzwl %ax,%eax
orl %edx,%eax
.LDOSFILEPOS2:
leave
ret $4
end;
function do_filepos(handle : longint) : longint;assembler;
asm
movl $0x4201,%eax
movl handle,%ebx
xorl %ecx,%ecx
xorl %edx,%edx
pushl %ebp
int $0x21
popl %ebp
jnc .LDOSFILEPOS1
movw %ax,inoutres
xorl %eax,%eax
jmp .LDOSFILEPOS2
.LDOSFILEPOS1:
shll $16,%edx
movzwl %ax,%eax
orl %edx,%eax
.LDOSFILEPOS2:
end;
procedure do_seek(handle,pos : longint);
begin
asm
movl $0x4200,%eax
movl 8(%ebp),%ebx
movl 12(%ebp),%edx
movl %edx,%ecx
shrl $16,%ecx
pushl %ebp
int $0x21
popl %ebp
jnc .LDOSSEEK1
movw %ax,U_SYSTEM_INOUTRES;
.LDOSSEEK1:
leave
ret $8
end;
procedure do_seek(handle,pos : longint);assembler;
asm
movl $0x4200,%eax
movl handle,%ebx
movl pos,%edx
movl %edx,%ecx
shrl $16,%ecx
pushl %ebp
int $0x21
popl %ebp
jnc .LDOSSEEK1
movw %ax,inoutres
.LDOSSEEK1:
end;
function do_seekend(handle : longint) : longint;
begin
asm
movl $0x4202,%eax
movl 8(%ebp),%ebx
xorl %ecx,%ecx
xorl %edx,%edx
pushl %ebp
int $0x21
popl %ebp
jnc .Lset_at_end1
movw %ax,U_SYSTEM_INOUTRES;
xorl %eax,%eax
jmp .Lset_at_end2
.Lset_at_end1:
shll $16,%edx
movzwl %ax,%eax
orl %edx,%eax
.Lset_at_end2:
leave
ret $4
end;
function do_seekend(handle : longint) : longint;assembler;
asm
movl $0x4202,%eax
movl handle,%ebx
xorl %ecx,%ecx
xorl %edx,%edx
pushl %ebp
int $0x21
popl %ebp
jnc .Lset_at_end1
movw %ax,inoutres
xorl %eax,%eax
jmp .Lset_at_end2
.Lset_at_end1:
shll $16,%edx
movzwl %ax,%eax
orl %edx,%eax
.Lset_at_end2:
end;
function do_filesize(handle : longint) : longint;
var
aktfilepos : longint;
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
movl %edx,%ecx
shrl $16,%ecx
pushl %ebp
int $0x21
popl %ebp
jc .LTruncate1
movl 8(%ebp),%ebx
movl 12(%ebp),%edx
movl %ebp,%edx
xorl %ecx,%ecx
movb $0x40,%ah
int $0x21
jnc .LTruncate2
.LTruncate1:
movw %ax,U_SYSTEM_INOUTRES;
.LTruncate2:
leave
ret $8
end;
procedure do_truncate(handle,pos : longint);assembler;
asm
movl $0x4200,%eax
movl handle,%ebx
movl pos,%edx
movl %edx,%ecx
shrl $16,%ecx
pushl %ebp
int $0x21
popl %ebp
jc .LTruncate1
movl handle,%ebx
movl %ebp,%edx
xorl %ecx,%ecx
movb $0x40,%ah
int $0x21
jnc .LTruncate2
.LTruncate1:
movw %ax,inoutres
.LTruncate2:
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)
}
var
oflags : longint;
oflags : longint;
begin
AllowSlash(p);
{ close first if opened }
@ -465,18 +426,18 @@ begin
end;
exit;
end;
asm
movl $0xff02,%ax
movl -4(%ebp),%ecx
movl 12(%ebp),%ebx
int $0x21
jnc .LOPEN1
movw %ax,U_SYSTEM_INOUTRES;
movw $0xffff,%ax
.LOPEN1:
movl 8(%ebp),%edx
movw %ax,(%edx)
end;
asm
movl $0xff02,%eax
movl oflags,%ecx
movl flags,%ebx
int $0x21
jnc .LOPEN1
movw %ax,inoutres
movw $0xffff,%ax
.LOPEN1:
movl f,%edx
movw %ax,(%edx)
end;
if (flags and $10)<>0 then
do_seekend(filerec(f).handle);
end;
@ -513,12 +474,12 @@ begin
buffer[length(s)]:=#0;
AllowSlash(pchar(@buffer));
asm
leal buffer,%edx
movb 8(%ebp),%ah
int $0x21
jnc .LDOS_DIRS1
movw %ax,U_SYSTEM_INOUTRES;
.LDOS_DIRS1:
leal buffer,%edx
movb func,%ah
int $0x21
jnc .LDOS_DIRS1
movw %ax,inoutres
.LDOS_DIRS1:
end;
end;
@ -540,9 +501,7 @@ begin
DosDir($3b,s);
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);
var
temp : array[0..255] of char;
@ -550,18 +509,16 @@ var
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... }
{ 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
int $0x21
movb drivenr,%dl
movl sof,%esi
mov $0x47,%ah
int $0x21
end;
{ Now Dir should be filled with directory in ASCIIZ, }
{ starting from dir[4] }
{ Now Dir should be filled with directory in ASCIIZ starting from dir[4] }
dir[0]:=#3;
dir[2]:=':';
dir[3]:='\';
@ -575,7 +532,7 @@ begin
dir[0]:=chr(i);
inc(i);
end;
{ upcase the string (FPKPascal function) }
{ upcase the string }
dir:=upcase(dir);
if drivenr<>0 then { Drive was supplied. We know it }
dir[1]:=chr(65+drivenr-1)
@ -584,10 +541,10 @@ 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
int $0x21
addb $65,%al
movb %al,i
movb $0x19,%ah
int $0x21
addb $65,%al
movb %al,i
end;
dir[1]:=chr(i);
end;
@ -623,60 +580,11 @@ Begin
{ Reset IO Error }
InOutRes:=0;
End.
{
$Log$
Revision 1.2 1998-03-26 12:21:02 peter
* makefile works again
* environ is now defined in system.pp (like go32v2)
Revision 1.3 1998-05-22 00:39:33 peter
* 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.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
=============================================================================
}

15
rtl/dos/go32v2/makefile
View File

@ -200,8 +200,8 @@ crt$(PPUEXT) : ../crt.pp $(INC)/textrec.inc go32$(PPUEXT) $(SYSTEMPPU)
$(PP) $(OPT) crt $(REDIR)
$(DEL) crt.pp
objects$(PPUEXT) : ../objects.pp $(SYSTEMPPU)
$(COPY) ../objects.pp .
objects$(PPUEXT) : $(INC)/objects.pp $(INC)/platform.inc objinc.inc $(SYSTEMPPU)
$(COPY) $(INC)/objects.pp .
$(PP) $(OPT) objects.pp $(REDIR)
$(DEL) objects.pp
@ -229,8 +229,8 @@ mouse$(PPUEXT) : ../mouse.pp $(SYSTEMPPU)
$(PP) $(OPT) mouse.pp $(REDIR)
$(DEL) mouse.pp
getopts$(PPUEXT) : $(PROCINC)/getopts.pp $(SYSTEMPPU)
$(COPY) $(PROCINC)/getopts.pp .
getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMPPU)
$(COPY) $(INC)/getopts.pp .
$(PP) $(OPT) getopts.pp $(REDIR)
$(DEL) getopts.pp
@ -264,7 +264,12 @@ include $(CFG)/makefile.def
#
# $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
#
#

1522
rtl/dos/go32v2/v2prt0.as
View File

File diff suppressed because it is too large Load Diff

47
rtl/dos/graph.pp
View File

@ -1,9 +1,11 @@
{
$Id$
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.
Graph unit for BP7 compatible RTL
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
@ -824,44 +826,9 @@ end.
{
$Log$
Revision 1.2 1998-03-26 10:41:15 florian
* some warnings fixed
Revision 1.3 1998-05-22 00:39:23 peter
* 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
=============================================================================
}

32
rtl/dos/mouse.pp
View File

@ -3,6 +3,8 @@
This file is part of the Free Pascal run time library.
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,
for details about the copyright.
@ -405,31 +407,9 @@ Begin
End.
{
$Log$
Revision 1.3 1998-04-05 13:56:54 peter
- fixed mouse to compile with $i386_att
+ linux crt supports redirecting (not Esc-codes anymore)
Revision 1.4 1998-05-22 00:39:25 peter
* go32v1, go32v2 recompiles with the new objects
* 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
}

73
rtl/dos/printer.pp
View File

@ -1,9 +1,11 @@
{
$Id$
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
Printer unit for BP7 compatible RTL
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
@ -12,62 +14,35 @@
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
{
History:
10.4.1994: Version 1.0
Unit is completely implemented
}
unit printer;
interface
interface
var
lst : text;
var
lst : text;
implementation
implementation
var
old_exit : pointer;
var
old_exit : pointer;
procedure printer_exit;
begin
close(lst);
exitproc:=old_exit;
end;
procedure printer_exit;
begin
assign(lst,'PRN');
rewrite(lst);
old_exit:=exitproc;
exitproc:=@printer_exit;
end.
close(lst);
exitproc:=old_exit;
end;
begin
assign(lst,'PRN');
rewrite(lst);
old_exit:=exitproc;
exitproc:=@printer_exit;
end.
{
$Log$
Revision 1.1 1998-03-25 11:18:41 root
Initial revision
Revision 1.2 1998-05-22 00:39:26 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/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
=============================================================================
}