paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-15 12:49:45 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Restored working version

Browse Source
This commit is contained in:
carl 1998-07-29 12:30:40 +00:00
parent cd2659ce93
commit d35acfdaf1
1 changed files with 372 additions and 339 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

705
rtl/dos/crt.pp
View File

@ -12,107 +12,131 @@
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************} **********************************************************************}
{
history:
29th may 1994: version 1.0
unit is completed
14th june 1994: version 1.01
the address from which startaddr was read wasn't right; fixed
18th august 1994: version 1.1
the upper left corner of winmin is now 0,0
19th september 1994: version 1.11
keypressed handles extended keycodes false; fixed
27th february 1995: version 1.12
* crtinoutfunc didn't the line wrap in the right way;
fixed
20th january 1996: version 1.13
- unused variables removed
21th august 1996: version 1.14
* adapted to newer FPKPascal versions
* make the comments english
6th november 1996: version 1.49
* some stuff for DPMI adapted
15th november 1996: version 1.5
* bug in screenrows fixed
13th november 1997: removed textrec definition, is now included from
textrec.inc
}
unit crt; unit crt;
interface
{$I os.inc} {$I os.inc}
{$I386_ATT} interface
const uses
{ CRT modes } go32;
BW40 = 0; { 40x25 B/W on Color Adapter }
CO40 = 1; { 40x25 Color on Color Adapter }
BW80 = 2; { 80x25 B/W on Color Adapter }
CO80 = 3; { 80x25 Color on Color Adapter }
Mono = 7; { 80x25 on Monochrome Adapter }
Font8x8 = 256; { Add-in for ROM font }
{ Mode constants for 3.0 compatibility } const
C40 = CO40; { screen modes }
C80 = CO80; bw40 = 0;
co40 = 1;
bw80 = 2;
co80 = 3;
mono = 7;
font8x8 = 256;
{ Foreground and background color constants } { screen color, fore- and background }
Black = 0; black = 0;
Blue = 1; blue = 1;
Green = 2; green = 2;
Cyan = 3; cyan = 3;
Red = 4; red = 4;
Magenta = 5; magenta = 5;
Brown = 6; brown = 6;
LightGray = 7; lightgray = 7;
{ Foreground color constants } { only foreground }
DarkGray = 8; darkgray = 8;
LightBlue = 9; lightblue = 9;
LightGreen = 10; lightgreen = 10;
LightCyan = 11; lightcyan = 11;
LightRed = 12; lightred = 12;
LightMagenta = 13; lightmagenta = 13;
Yellow = 14; yellow = 14;
White = 15; white = 15;
{ Add-in for blinking } { blink flag }
Blink = 128; blink = $80;
var const
{$ifndef GO32V2}
directvideo:boolean=true;
{$else GO32V2}
{ direct video generates a GPF in DPMI of setcursor }
directvideo:boolean=false;
{$endif GO32V2}
{ Interface variables } var
CheckBreak: Boolean; { Enable Ctrl-Break } { for compatibility }
CheckEOF: Boolean; { Enable Ctrl-Z } checkbreak,checkeof,checksnow : boolean;
DirectVideo: Boolean; { Enable direct video addressing }
CheckSnow: Boolean; { Enable snow filtering }
LastMode: Word; { Current text mode }
TextAttr: Byte; { Current text attribute }
WindMin: Word; { Window upper left coordinates }
WindMax: Word; { Window lower right coordinates }
{ Interface procedures } lastmode : word; { screen mode}
procedure AssignCrt(var F: Text); textattr : byte; { current text attribute }
function KeyPressed: Boolean; windmin : word; { upper right corner of the CRT window }
function ReadKey: Char; windmax : word; { lower left corner of the CRT window }
procedure TextMode(Mode: Integer);
procedure Window(X1,Y1,X2,Y2: Byte);
procedure GotoXY(X,Y: Byte);
function WhereX: Byte;
function WhereY: Byte;
procedure ClrScr;
procedure ClrEol;
procedure InsLine;
procedure DelLine;
procedure TextColor(Color: Byte);
procedure TextBackground(Color: Byte);
procedure LowVideo;
procedure HighVideo;
procedure NormVideo;
procedure Delay(MS: Word);
procedure Sound(Hz: Word);
procedure NoSound;
{Extra Functions} function keypressed : boolean;
procedure cursoron; function readkey : char;
procedure cursoroff; procedure gotoxy(x,y : byte);
procedure cursorbig; procedure window(left,top,right,bottom : byte);
procedure clrscr;
procedure textcolor(color : byte);
procedure textbackground(color : byte);
procedure assigncrt(var f : text);
function wherex : byte;
function wherey : byte;
procedure delline;
procedure delline(line : byte);
procedure clreol;
procedure insline;
procedure cursoron;
procedure cursoroff;
procedure cursorbig;
procedure lowvideo;
procedure highvideo;
procedure nosound;
procedure sound(hz : word);
procedure delay(ms : longint);
procedure textmode(mode : integer);
procedure normvideo;
implementation
implementation var
maxcols,maxrows : longint;
uses { definition of textrec is in textrec.inc}
go32;
var {$i textrec.inc}
startattrib : byte;
col,row,
maxcols,maxrows : longint;
{ { low level routines }
definition of textrec is in textrec.inc
}
{$i textrec.inc}
{**************************************************************************** function getscreenmode : byte;
Low level Routines
****************************************************************************} begin
dosmemget($40,$49,getscreenmode,1);
end;
procedure setscreenmode(mode : byte); procedure setscreenmode(mode : byte);
@ -134,37 +158,59 @@ var
end; end;
function screenrows : byte; function screenrows : byte;
begin begin
dosmemget($40,$84,screenrows,1); dosmemget($40,$84,screenrows,1);
{ don't forget this: }
inc(screenrows); inc(screenrows);
end; end;
function screencols : byte; function screencols : byte;
begin begin
dosmemget($40,$4a,screencols,1); dosmemget($40,$4a,screencols,1);
end; end;
function get_addr(row,col : byte) : word; function get_addr(row,col : byte) : word;
begin begin
get_addr:=((row-1)*maxcols+(col-1))*2; get_addr:=((row-1)*maxcols+(col-1))*2;
end; end;
procedure screensetcursor(row,col : longint); procedure screensetcursor(row,col : longint);
{$ifdef GO32V2}
var var
cols : byte;
pos : word;
{$ifdef GO32V2}
regs : trealregs; regs : trealregs;
{$endif GO32V2} {$endif GO32V2}
begin begin
if directvideo then
begin
{ set new position for the BIOS }
dosmemput($40,$51,row,1);
dosmemput($40,$50,col,1);
{ calculates screen position }
dosmemget($40,$4a,cols,1);
{ FPKPascal calculates with 32 bit }
pos:=row*cols+col;
{ direct access to the graphics card registers }
outportb($3d4,$0e);
outportb($3d5,hi(pos));
outportb($3d4,$0f);
outportb($3d5,lo(pos));
end
else
{$ifndef GO32V2} {$ifndef GO32V2}
asm asm
movb $0x02,%ah movb $0x02,%ah
movb $0,%bh movb $0,%bh
movb row,%dh movb row,%dh
movb col,%dl movb col,%dl
subw $0x0101,%dx
pushl %ebp pushl %ebp
int $0x10 int $0x10
popl %ebp popl %ebp
@ -172,22 +218,20 @@ var
{$else GO32V2} {$else GO32V2}
regs.realeax:=$0200; regs.realeax:=$0200;
regs.realebx:=0; regs.realebx:=0;
regs.realedx:=(row-1)*$100+(col-1); regs.realedx:=row*$100+col;
realintr($10,regs); realintr($10,regs);
{$endif GO32V2} {$endif GO32V2}
end; end;
procedure screengetcursor(var row,col : longint); procedure screengetcursor(var row,col : longint);
begin begin
col:=0; col:=0;
row:=0; row:=0;
dosmemget($40,$50,col,1); dosmemget($40,$50,col,1);
dosmemget($40,$51,row,1); dosmemget($40,$51,row,1);
inc(col);
inc(row);
end; end;
{ exported routines } { exported routines }
procedure cursoron; procedure cursoron;
@ -235,9 +279,9 @@ var
end; end;
procedure cursorbig; procedure cursorbig;
{$ifdef GO32V2} {$ifdef GO32V2}
var var regs : trealregs;
regs : trealregs;
{$endif GO32V2} {$endif GO32V2}
begin begin
{$ifdef GO32V2} {$ifdef GO32V2}
@ -258,15 +302,17 @@ var
var var
is_last : boolean; is_last : boolean;
last : char; last : char;
function readkey : char; function readkey : char;
var var
char2 : char; char2 : char;
char1 : char; char1 : char;
{$ifdef GO32V2} {$ifdef GO32V2}
regs : trealregs; var regs : trealregs;
{$endif GO32V2} {$endif GO32V2}
begin begin
if is_last then if is_last then
begin begin
@ -279,15 +325,14 @@ var
regs.realeax:=$0000; regs.realeax:=$0000;
realintr($16,regs); realintr($16,regs);
byte(char1):=regs.realeax and $ff; byte(char1):=regs.realeax and $ff;
byte(char2):=(regs.realeax and $ff00) shr 8; byte(char2):=(regs.realeax and $ff00) div $100;
{$else GO32V2} {$else GO32V2}
asm asm
movb $0,%ah movb $0,%ah
pushl %ebp pushl %ebp
int $0x16 int $0x16
popl %ebp popl %ebp
movb %al,char1 movw %ax,-2(%ebp)
movb %ah,char2
end; end;
{$endif GO32V2} {$endif GO32V2}
if char1=#0 then if char1=#0 then
@ -342,7 +387,7 @@ var
y:=hi(windmax)-hi(windmin)+1; y:=hi(windmax)-hi(windmin)+1;
if x+lo(windmin)-2>=lo(windmax) then if x+lo(windmin)-2>=lo(windmax) then
x:=lo(windmax)-lo(windmin)+1; x:=lo(windmax)-lo(windmin)+1;
screensetcursor(y+hi(windmin),x+lo(windmin)); screensetcursor(y+hi(windmin)-1,x+lo(windmin)-1);
end; end;
function wherex : byte; function wherex : byte;
@ -352,7 +397,7 @@ var
begin begin
screengetcursor(row,col); screengetcursor(row,col);
wherex:=col-lo(windmin); wherex:=col-lo(windmin)+1;
end; end;
function wherey : byte; function wherey : byte;
@ -362,24 +407,29 @@ var
begin begin
screengetcursor(row,col); screengetcursor(row,col);
wherey:=row-hi(windmin); wherey:=row-hi(windmin)+1;
end; end;
procedure Window(X1,Y1,X2,Y2: Byte); procedure window(left,top,right,bottom : byte);
begin begin
if (x1<1) or (x2>screencols) or (y2>screenrows) or if (left<1) or
(x1>x2) or (y1>y2) then (right>screencols) or
exit; (bottom>screenrows) or
windmin:=(x1-1) or ((x1-1) shl 8); (left>right) or
windmax:=(x2-1) or ((y2-1) shl 8); (top>bottom) then
exit;
windmin:=(left-1) or ((top-1) shl 8);
windmax:=(right-1) or ((bottom-1) shl 8);
gotoxy(1,1); gotoxy(1,1);
end; end;
procedure clrscr; procedure clrscr;
var var
fil : word; fil : word;
row : longint; row : longint;
begin begin
fil:=32 or (textattr shl 8); fil:=32 or (textattr shl 8);
for row:=hi(windmin) to hi(windmax) do for row:=hi(windmin) to hi(windmax) do
@ -387,41 +437,45 @@ var
gotoxy(1,1); gotoxy(1,1);
end; end;
procedure textcolor(color : Byte); procedure textcolor(color : Byte);
begin begin
textattr:=(textattr and $70) or color; textattr:=(textattr and $70) or color;
end; end;
procedure lowvideo; procedure lowvideo;
begin begin
textattr:=textattr and $f7; textattr:=textattr and $f7;
end; end;
procedure highvideo; procedure highvideo;
begin begin
textattr:=textattr or $08; textattr:=textattr or $08;
end; end;
procedure textbackground(color : Byte); procedure textbackground(color : Byte);
begin begin
textattr:=(textattr and $8f) or ((color and $7) shl 4); textattr:=(textattr and $8f) or ((color and $7) shl 4);
end; end;
var
startattrib : byte;
procedure normvideo; procedure normvideo;
begin begin
textattr:=startattrib; textattr:=startattrib;
end; end;
procedure delline(line : byte);
procedure removeline(line : byte);
var var
row,left,right,bot : longint; row,left,right,bot : longint;
fil : word; fil : word;
begin begin
row:=line+hi(windmin); row:=line+hi(windmin);
left:=lo(windmin)+1; left:=lo(windmin)+1;
@ -436,10 +490,10 @@ var
dosmemfillword($b800,get_addr(bot,left),right-left+1,fil); dosmemfillword($b800,get_addr(bot,left),right-left+1,fil);
end; end;
procedure delline; procedure delline;
begin begin
removeline(wherey); delline(wherey);
end; end;
procedure insline; procedure insline;
@ -463,19 +517,128 @@ var
dosmemfillword($b800,get_addr(row,left),right-left+1,fil); dosmemfillword($b800,get_addr(row,left),right-left+1,fil);
end; end;
procedure clreol; procedure clreol;
var var
row,col : longint; row,col : longint;
fil : word; fil : word;
begin begin
screengetcursor(row,col); screengetcursor(row,col);
inc(row);
inc(col);
fil:=32 or (textattr shl 8); fil:=32 or (textattr shl 8);
dosmemfillword($b800,get_addr(row,col),lo(windmax)-col+2,fil); dosmemfillword($b800,get_addr(row,col),lo(windmax)-col+2,fil);
end; end;
Function CrtWrite(var f : textrec):integer;
var
i,col,row : longint;
c : char;
va,sa : word;
begin
screengetcursor(row,col);
inc(row);
inc(col);
va:=get_addr(row,col);
for i:=0 to f.bufpos-1 do
begin
c:=f.buffer[i];
case ord(c) of
10 : begin
inc(row);
va:=va+maxcols*2;
end;
13 : begin
col:=lo(windmin)+1;
va:=get_addr(row,col);
end;
8 : if col>lo(windmin)+1 then
begin
dec(col);
va:=va-2;
end;
7 : begin
{ beep }
end;
else
begin
sa:=textattr shl 8 or ord(c);
dosmemput($b800,va,sa,sizeof(sa));
inc(col);
va:=va+2;
end;
end;
if col>lo(windmax)+1 then
begin
col:=lo(windmin)+1;
inc(row);
{ it's easier to calculate the new address }
{ it don't spend much time }
va:=get_addr(row,col);
end;
while row>hi(windmax)+1 do
begin
delline(1);
dec(row);
va:=va-maxcols*2;
end;
end;
f.bufpos:=0;
screensetcursor(row-1,col-1);
CrtWrite:=0;
end;
Function CrtClose(Var F: TextRec): Integer;
Begin
F.Mode:=fmClosed;
CrtClose:=0;
End;
Function CrtOpen(Var F: TextRec): Integer;
Begin
If F.Mode = fmOutput Then
CrtOpen:=0
Else
CrtOpen:=5;
End;
Function CrtRead(Var F: TextRec): Integer;
Begin
{$IFDEF GO32V2}
f.bufend:=do_read(f.handle,longint(f.bufptr),f.bufsize);
{$ENDIF}
f.bufpos:=0;
CrtRead:=0;
End;
Function CrtInOut(Var F: TextRec): Integer;
Begin
Case F.Mode of
fmInput: CrtInOut:=CrtRead(F);
fmOutput: CrtInOut:=CrtWrite(F);
End;
End;
procedure assigncrt(var f : text);
begin
TextRec(F).Mode:=fmClosed;
TextRec(F).BufSize:=SizeOf(TextBuf);
TextRec(F).BufPtr:=@TextRec(F).Buffer;
TextRec(F).BufPos:=0;
TextRec(F).OpenFunc:=@CrtOpen;
TextRec(F).InOutFunc:=@CrtInOut;
TextRec(F).FlushFunc:=@CrtInOut;
TextRec(F).CloseFunc:=@CrtClose;
TextRec(F).Name[0]:='.';
TextRec(F).Name[1]:=#0;
end;
procedure sound(hz : word); procedure sound(hz : word);
begin begin
if hz=0 then if hz=0 then
begin begin
@ -485,7 +648,7 @@ var
asm asm
movzwl hz,%ecx movzwl hz,%ecx
movl $1193046,%eax movl $1193046,%eax
cdq cdq
divl %ecx divl %ecx
movl %eax,%ecx movl %eax,%ecx
movb $0xb6,%al movb $0xb6,%al
@ -513,35 +676,42 @@ var
var var
calibration : longint; calibration : longint;
function get_ticks:longint; procedure delay(ms : longint);
begin
dosmemget($40,$6c,get_ticks,4);
end;
procedure Delay(MS: Word);
var var
i,j : longint; i,j : longint;
begin begin
for i:=1 to ms do for i:=1 to ms do
for j:=1 to calibration do; for j:=1 to calibration do
begin
end;
end; end;
function get_ticks:longint;
begin
dosmemget($40,$6c,get_ticks,4);
end;
procedure initdelay; procedure initdelay;
{ From the mailling list,
by Jonathan Anderson (sarlok@geocities.com) } { From the mailling list,
by Jonathan Anderson (sarlok@geocities.com) }
const const
threshold=7; threshold=3;
{ Raise this to increase speed but decrease accuracy } { Raise this to increase speed but decrease accuracy }
{ currently the calibration will be no more than 7 off } { currently the calibration will be no more than 7 off }
{ and shave a few ticks off the most accurate setting of 0 } { and shave a few ticks off the most accurate setting of 0 }
{ The best values to pick are powers of 2-1 (0,1,3,7,15...) } { The best values to pick are powers of 2-1 (0,1,3,7,15...) }
{ but any non-negative value will work. } { but any non-negative value will work. }
var var
too_small : boolean; too_small : boolean;
first, first,
incval : longint; incval : longint;
begin begin
calibration:=0; calibration:=0;
{ wait for new tick } { wait for new tick }
@ -555,11 +725,13 @@ var
while get_ticks=first do while get_ticks=first do
inc(calibration); inc(calibration);
{$ifdef GO32V2} { calculate this to ms }
calibration:=calibration div 55; { calibration:=calibration div 70; }
{$else} { this is a very bad estimation because }
{ the loop above calls a function }
{ and the dealy loop does not }
calibration:=calibration div 3; calibration:=calibration div 3;
{$endif}
{ The ideal guess value is about half of the real value } { The ideal guess value is about half of the real value }
{ although a value lower than that take a large performance } { although a value lower than that take a large performance }
{ hit compared to a value higher than that because it has to } { hit compared to a value higher than that because it has to }
@ -570,8 +742,9 @@ var
{ If calibration is not at least this value, an } { If calibration is not at least this value, an }
{ infinite loop will result. } { infinite loop will result. }
repeat repeat
incval:=calibration div 4; incval:=calibration;
if calibration<0 then if calibration<0 then
begin begin
calibration:=$7FFFFFFF; calibration:=$7FFFFFFF;
@ -598,7 +771,9 @@ var
first:=get_ticks; first:=get_ticks;
delay(55); delay(55);
if first=get_ticks then if first=get_ticks then
calibration:=calibration+incval begin
calibration:=calibration+incval;
end
else else
begin begin
calibration:=calibration-incval; calibration:=calibration-incval;
@ -613,8 +788,10 @@ var
procedure textmode(mode : integer); procedure textmode(mode : integer);
var var
set_font8x8 : boolean; set_font8x8 : boolean;
begin begin
lastmode:=mode; lastmode:=mode;
set_font8x8:=(mode and font8x8)<>0; set_font8x8:=(mode and font8x8)<>0;
@ -626,187 +803,8 @@ var
maxrows:=screenrows; maxrows:=screenrows;
end; end;
var
{***************************************************************************** col,row : longint;
Read and Write routines
*****************************************************************************}
Procedure WriteChar(c:char);
var
regs : trealregs;
chattr : word;
begin
case c of
#10 : inc(row);
#13 : col:=lo(windmin)+1;
#8 : begin
if col>lo(windmin)+1 then
dec(col);
end;
#7 : begin { beep }
{$ifdef GO32V2}
regs.dl:=7;
regs.ah:=2;
realintr($21,regs);
{$endif}
end;
else
begin
chattr:=(textattr shl 8) or byte(c);
dosmemput($b800,get_addr(row,col),chattr,2);
inc(col);
end;
end;
if col>lo(windmax)+1 then
begin
col:=lo(windmin)+1;
inc(row);
end;
while row>hi(windmax)+1 do
begin
removeline(1);
dec(row);
end;
end;
Function CrtWrite(var f : textrec):integer;
var
i : longint;
begin
screengetcursor(row,col);
for i:=0 to f.bufpos-1 do
WriteChar(f.buffer[i]);
f.bufpos:=0;
screensetcursor(row,col);
CrtWrite:=0;
end;
Function CrtRead(Var F: TextRec): Integer;
procedure BackSpace;
begin
if (f.bufpos>0) and (f.bufpos=f.bufend) then
begin
WriteChar(#8);
WriteChar(' ');
WriteChar(#8);
dec(f.bufpos);
dec(f.bufend);
end;
end;
var
ch : Char;
Begin
f.bufpos:=0;
f.bufend:=0;
repeat
if f.bufpos>f.bufend then
f.bufend:=f.bufpos;
screensetcursor(row,col);
ch:=readkey;
case ch of
#0 : case readkey of
#71 : while f.bufpos>0 do
begin
dec(f.bufpos);
WriteChar(#8);
end;
#75 : if f.bufpos>0 then
begin
dec(f.bufpos);
WriteChar(#8);
end;
#77 : if f.bufpos<f.bufend then
begin
WriteChar(f.bufptr^[f.bufpos]);
inc(f.bufpos);
end;
#79 : while f.bufpos<f.bufend do
begin
WriteChar(f.bufptr^[f.bufpos]);
inc(f.bufpos);
end;
end;
^S,
#8 : BackSpace;
^Y,
#27 : begin
f.bufpos:=f.bufend;
while f.bufend>0 do
BackSpace;
end;
#13 : begin
WriteChar(#13);
WriteChar(#10);
f.bufptr^[f.bufend]:=#13;
f.bufptr^[f.bufend+1]:=#10;
inc(f.bufend,2);
break;
end;
#26 : if CheckEOF then
begin
f.bufptr^[f.bufend]:=#26;
inc(f.bufend);
break;
end;
else
begin
if f.bufpos<f.bufsize-2 then
begin
f.buffer[f.bufpos]:=ch;
inc(f.bufpos);
WriteChar(ch);
end;
end;
end;
until false;
f.bufpos:=0;
screensetcursor(row,col);
CrtRead:=0;
End;
Function CrtReturn:Integer;
Begin
CrtReturn:=0;
end;
Function CrtClose(Var F: TextRec): Integer;
Begin
F.Mode:=fmClosed;
CrtClose:=0;
End;
Function CrtOpen(Var F: TextRec): Integer;
Begin
If F.Mode=fmOutput Then
begin
TextRec(F).InOutFunc:=@CrtWrite;
TextRec(F).FlushFunc:=@CrtWrite;
end
Else
begin
F.Mode:=fmInput;
TextRec(F).InOutFunc:=@CrtRead;
TextRec(F).FlushFunc:=@CrtReturn;
end;
TextRec(F).CloseFunc:=@CrtClose;
CrtOpen:=0;
End;
procedure AssignCrt(var F: Text);
begin
Assign(F,'');
TextRec(F).OpenFunc:=@CrtOpen;
end;
begin begin
is_last:=false; is_last:=false;
@ -820,17 +818,17 @@ begin
{ save the current settings to restore the old state after the exit } { save the current settings to restore the old state after the exit }
screengetcursor(row,col); screengetcursor(row,col);
dosmemget($b800,get_addr(row,col)+1,startattrib,1); dosmemget($b800,get_addr(row+1,col+1)+1,startattrib,1);
dosmemget($40,$49,lastmode,1); lastmode:=getscreenmode;
textattr:=startattrib; textattr:=startattrib;
{ redirect the standard output } { redirect the standard output }
assigncrt(Output); assigncrt(Output);
Rewrite(Output); TextRec(Output).mode:=fmOutput;
TextRec(Output).Handle:=StdOutputHandle; {$IFDEF GO32V2}
assigncrt(Input); assigncrt(Input);
Reset(Input); TextRec(Input).mode:=fmInput;
TextRec(Input).Handle:=StdInputHandle; {$ENDIF GO32V2}
{ calculates delay calibration } { calculates delay calibration }
initdelay; initdelay;
@ -838,24 +836,59 @@ end.
{ {
$Log$ $Log$
Revision 1.6 1998-07-07 12:26:42 carl Revision 1.7 1998-07-29 12:30:40 carl
* now compiles under fpc v0.99.5, so don't modify!!!! * Restored working version
Revision 1.5 1998/05/31 14:18:12 peter Revision 1.1.1.1 1998/03/25 11:18:41 root
* force att or direct assembling * Restored version
* cleanup of some files
Revision 1.4 1998/05/28 10:21:38 pierre Revision 1.8 1998/01/26 11:56:39 michael
* Handles of input and output restored + Added log at the end
Revision 1.3 1998/05/27 00:19:16 peter
* fixed crt input
Revision 1.2 1998/05/21 19:30:46 peter
* objects compiles for linux Working file: rtl/dos/crt.pp
+ assign(pchar), assign(char), rename(pchar), rename(char) description:
* fixed read_text_as_array ----------------------------
+ read_text_as_pchar which was not yet in the rtl revision 1.7
date: 1998/01/07 09:24:18; author: michael; state: Exp; lines: +7 -2
* Bug fixed in initdelay, avoiding possible infiniteloop.
----------------------------
revision 1.6
date: 1998/01/06 00:29:28; author: michael; state: Exp; lines: +2 -2
Implemented a system independent sequence of reset/rewrite/append fileopenfunc etc system \n (from Peter Vreman)
----------------------------
revision 1.5
date: 1998/01/05 16:52:15; author: michael; state: Exp; lines: +7 -3
+ Minor change making use of new GO32V2 feature (From Peter Vreman)
----------------------------
revision 1.4
date: 1998/01/05 13:47:01; author: michael; state: Exp; lines: +199 -127
* Bug fixes by Peter Vreman (pfv@worldonline.nl), discovered
when writing CRT examples.
Bug fix from mailing list also applied.
----------------------------
revision 1.3
date: 1997/12/12 13:14:36; author: pierre; state: Exp; lines: +33 -12
+ added handling of swap_vectors if under exceptions
i.e. swapvector is not dummy under go32v2
* bug in output, exceptions where not allways reset correctly
now the code in dpmiexcp is called from v2prt0.as exit routine
* in crt.pp corrected init_delay calibration loop
and added it for go32v2 also (was disabled before due to crashes !!)
the previous code did a wrong assumption on the time need to call
get_ticks compared to an internal loop without call
----------------------------
revision 1.2
date: 1997/12/01 12:15:44; author: michael; state: Exp; lines: +11 -5
+ 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
=============================================================================
} }