paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-04 03:19:47 +01:00
Code Issues Packages Projects Releases Wiki Activity

sinclairql: have a max. 48 char buffer for job name. set the job name to the program name by default on system unit init

Browse Source 
git-svn-id: trunk@49190 -
This commit is contained in:
Károly Balogh 2021-04-12 11:58:14 +00:00
parent b5216a1990
commit 3280ec3220
2 changed files with 65 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
rtl/sinclairql/si_prc.pp
View File

@ -37,8 +37,19 @@ asm
bra @start
dc.l $0
dc.w $4afb
dc.w 3
dc.l $46504300 { Job name, just FPC for now }
dc.w 8
dc.l $4650435f { Job name buffer. FPC_PROG by default, can be overridden }
dc.l $50524f47 { the startup code will inject the main program name here }
dc.l $00000000 { user codes is free to use the SetQLJobName() function }
dc.l $00000000 { max. length: 48 characters }
dc.l $00000000
dc.l $00000000
dc.l $00000000
dc.l $00000000
dc.l $00000000
dc.l $00000000
dc.l $00000000
dc.l $00000000
@start:
{ relocation code }

52
rtl/sinclairql/system.pp
View File

@ -70,6 +70,9 @@ var
{$endif defined(FPUSOFT)}
function SetQLJobName(const s: string): longint;
function GetQLJobName: string;
implementation
@ -190,6 +193,11 @@ begin
randseed:=mt_rclck;
end;
{*****************************************************************************
Platform specific custom calls
*****************************************************************************}
procedure PrintStr(ch: longint; const s: shortstring);
begin
io_sstrg(ch,-1,@s[1],ord(s[0]));
@ -204,11 +212,53 @@ begin
end;
var
start_proc: byte; external name '_start';
{ WARNING! if you change this value, make sure there's enough
buffer space for the job name in the startup code! }
const
JOB_NAME_MAX_LEN = 48;
function SetQLJobName(const s: string): longint;
var
len: longint;
begin
SetQLJobName:=-1;
if pword(@start_proc)[3] = $4afb then
begin
len:=length(s);
if len > JOB_NAME_MAX_LEN then
len:=JOB_NAME_MAX_LEN;
Move(s[1],pword(@start_proc)[5],len);
pword(@start_proc)[4]:=len;
SetQLJobName:=len;
end;
end;
function GetQLJobName: string;
var
len: longint;
begin
GetQLJobName:='';
if pword(@start_proc)[3] = $4afb then
begin
len:=pword(@start_proc)[4];
if len <= JOB_NAME_MAX_LEN then
begin
SetLength(GetQLJobName,len);
Move(pword(@start_proc)[5],GetQLJobName[1],len);
end;
end;
end;
{*****************************************************************************
System Dependent Entry code
*****************************************************************************}
var
jobStackDataPtr: pointer; external name '__job_stack_data_ptr';
program_name: shortstring; external name '__fpc_program_name';
{ QL/QDOS specific startup }
procedure SysInitQDOS;
@ -220,6 +270,8 @@ begin
QL_CommandLineLen:=pword(@QL_ChannelIDs[QL_ChannelIDNum])[0];
QL_CommandLine:=@pword(@QL_ChannelIDs[QL_ChannelIDNum])[1];
SetQLJobName(program_name);
stdInputHandle:=io_open('con_',Q_OPEN);
stdOutputHandle:=stdInputHandle;
stdErrorHandle:=stdInputHandle;