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

sinclairql: system unit changes and improvements, patch by Marcel Kilgus in qlforum.co.uk, merged with minor tweaks

Browse Source 
git-svn-id: trunk@47562 -
This commit is contained in:
Károly Balogh 2020-11-24 19:55:13 +00:00
parent aa1bbb591c
commit f9d54b7cb7
1 changed files with 43 additions and 56 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

99
rtl/sinclairql/system.pp
View File

@ -51,7 +51,7 @@ const
DefaultTextLineBreakStyle : TTextLineBreakStyle = tlbsLF; DefaultTextLineBreakStyle : TTextLineBreakStyle = tlbsLF;
const const
UnusedHandle = $ffff; UnusedHandle = -1;
StdInputHandle: longint = UnusedHandle; StdInputHandle: longint = UnusedHandle;
StdOutputHandle: longint = UnusedHandle; StdOutputHandle: longint = UnusedHandle;
StdErrorHandle: longint = UnusedHandle; StdErrorHandle: longint = UnusedHandle;
@ -62,8 +62,6 @@ var
argv: PPChar; argv: PPChar;
envp: PPChar; envp: PPChar;
QCON: longint; // QDOS console
QSCR: longint; // QDOS screen
heapStart: pointer; heapStart: pointer;
@ -76,71 +74,61 @@ var
{$endif defined(FPUSOFT)} {$endif defined(FPUSOFT)}
implementation implementation
{$if defined(FPUSOFT)} {$if defined(FPUSOFT)}
{$define fpc_softfpu_implementation} {$define fpc_softfpu_implementation}
{$define softfpu_compiler_mul32to64} {$define softfpu_compiler_mul32to64}
{$define softfpu_inline} {$define softfpu_inline}
{$i softfpu.pp} {$i softfpu.pp}
{$undef fpc_softfpu_implementation} {$undef fpc_softfpu_implementation}
{ we get these functions and types from the softfpu code } { we get these functions and types from the softfpu code }
{$define FPC_SYSTEM_HAS_float64} {$define FPC_SYSTEM_HAS_float64}
{$define FPC_SYSTEM_HAS_float32} {$define FPC_SYSTEM_HAS_float32}
{$define FPC_SYSTEM_HAS_flag} {$define FPC_SYSTEM_HAS_flag}
{$define FPC_SYSTEM_HAS_extractFloat64Frac0} {$define FPC_SYSTEM_HAS_extractFloat64Frac0}
{$define FPC_SYSTEM_HAS_extractFloat64Frac1} {$define FPC_SYSTEM_HAS_extractFloat64Frac1}
{$define FPC_SYSTEM_HAS_extractFloat64Exp} {$define FPC_SYSTEM_HAS_extractFloat64Exp}
{$define FPC_SYSTEM_HAS_extractFloat64Sign} {$define FPC_SYSTEM_HAS_extractFloat64Sign}
{$define FPC_SYSTEM_HAS_ExtractFloat32Frac} {$define FPC_SYSTEM_HAS_ExtractFloat32Frac}
{$define FPC_SYSTEM_HAS_extractFloat32Exp} {$define FPC_SYSTEM_HAS_extractFloat32Exp}
{$define FPC_SYSTEM_HAS_extractFloat32Sign} {$define FPC_SYSTEM_HAS_extractFloat32Sign}
{$endif defined(FPUSOFT)} {$endif defined(FPUSOFT)}
{$i system.inc} {$i system.inc}
{$ifdef FPC_QL_USE_TINYHEAP} {$ifdef FPC_QL_USE_TINYHEAP}
{$i tinyheap.inc} {$i tinyheap.inc}
{$endif FPC_QL_USE_TINYHEAP} {$endif FPC_QL_USE_TINYHEAP}
function GetProcessID:SizeUInt; function GetProcessID:SizeUInt;
begin begin
GetProcessID := 1; GetProcessID := mt_inf(nil, nil);
end; end;
procedure SysInitParamsAndEnv;
begin
end;
procedure SysInitParamsAndEnv; procedure randomize;
begin begin
end; {$WARNING: randseed is uninitialized}
randseed:=0;
end;
procedure randomize;
begin
{$WARNING: randseed is uninitialized}
randseed:=0;
end;
procedure PrintStr(ch: longint; const s: shortstring); procedure PrintStr(ch: longint; const s: shortstring);
begin begin
io_sstrg(ch,-1,@s[1],ord(s[0])); io_sstrg(ch,-1,@s[1],ord(s[0]));
end; end;
procedure PrintStr2(ch: longint; const s: shortstring);
var
i: smallint;
begin
for i:=1 to ord(s[0]) do
io_sbyte(ch,-1,s[i]);
end;
procedure DebugStr(const s: shortstring); public name '_dbgstr'; procedure DebugStr(const s: shortstring); public name '_dbgstr';
var var
i: longint; i: longint;
begin begin
PrintStr($00010001,s); PrintStr(stdOutputHandle,s);
for i:=0 to 10000 do begin end; for i:=0 to 10000 do begin end;
end; end;
@ -165,17 +153,14 @@ begin
stdInputHandle:=io_open('con_',Q_OPEN); stdInputHandle:=io_open('con_',Q_OPEN);
stdOutputHandle:=stdInputHandle; stdOutputHandle:=stdInputHandle;
stdErrorHandle:=stdInputHandle; stdErrorHandle:=stdInputHandle;
QCON:=stdInputHandle;
r.q_width:=512; r.q_width:=512;
r.q_height:=256; r.q_height:=256;
r.q_x:=0; r.q_x:=0;
r.q_y:=0; r.q_y:=0;
sd_wdef(stdInputHandle,-1,0,16,@r); sd_wdef(stdInputHandle,-1,2,1,@r);
sd_clear(stdInputHandle,-1); sd_clear(stdInputHandle,-1);
// QSCR:=io_open('scr_',Q_OPEN);
end; end;
{***************************************************************************** {*****************************************************************************
@ -185,13 +170,15 @@ end;
procedure haltproc(e:longint); external name '_haltproc'; procedure haltproc(e:longint); external name '_haltproc';
procedure system_exit; procedure system_exit;
const
anyKey: string = 'Press any key to exit';
begin begin
// io_close(QCON); io_sstrg(stdOutputHandle, -1, @anyKey[1], ord(anyKey[0]));
// io_close(QSCR); io_fbyte(stdInputHandle, -1);
stdInputHandle:=UnusedHandle; stdInputHandle:=UnusedHandle;
stdOutputHandle:=UnusedHandle; stdOutputHandle:=UnusedHandle;
stdErrorHandle:=UnusedHandle; stdErrorHandle:=UnusedHandle;
haltproc(exitcode); haltproc(exitcode);
end; end;