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

qlunits: really add the a new example missed from the previous commit

Browse Source 
git-svn-id: trunk@49311 -
This commit is contained in:
Károly Balogh 2021-05-01 13:25:30 +00:00
parent 8c1ebd8353
commit 6a35227a50
2 changed files with 54 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -8814,6 +8814,7 @@ packages/pxlib/src/pxlib.pp svneol=native#text/plain
packages/qlunits/Makefile svneol=native#text/plain
packages/qlunits/Makefile.fpc svneol=native#text/plain
packages/qlunits/README.txt svneol=native#text/plain
packages/qlunits/examples/mtinf.pas svneol=native#text/plain
packages/qlunits/examples/qlcube.pas svneol=native#text/plain
packages/qlunits/fpmake.pp svneol=native#text/plain
packages/qlunits/src/qdos.pas svneol=native#text/plain

53
packages/qlunits/examples/mtinf.pas Normal file
View File

@ -0,0 +1,53 @@
{
Copyright (c) 2021 Karoly Balogh
System info/System variables access on a Sinclair QL
Example program for Free Pascal's Sinclair QL support
This example program is in the Public Domain under the terms of
Unlicense: http://unlicense.org/
**********************************************************************}
program mtinf;
uses
qdos;
type
Tver = array[0..3] of char;
var
job_id: longint;
ver_ascii: longint;
system_vars: pbyte;
function get_id_str(const id: dword): string;
const
QDOS = $D2540000;
SMS = $53324154; { S2AT }
SMSQ = $534D5351; { SMSQ }
ARGOS_THOR = $DC010000;
begin
case id of
QDOS: get_id_str:='QDOS';
SMS: get_id_str:='SMS';
SMSQ: get_id_str:='SMSQ';
ARGOS_THOR: get_id_str:='Thor (ARGOS)';
else
get_id_str:='unknown ($'+hexstr(id,8)+')';
end;
end;
begin
job_id:=mt_inf(@system_vars,@ver_ascii);
writeln('Job ID:',lo(job_id),' Tag:',hi(job_id));
writeln('Identification: ',get_id_str(pdword(@system_vars[SV_IDENT])^));
writeln('Version: ',Tver(ver_ascii));
writeln('System vars are at: $',hexstr(system_vars));
writeln('Processor type: 680',hexstr(system_vars[SV_PTYP],2));
writeln('Monitor mode: ',system_vars[SV_TVMOD]);
writeln('Random number: ',pword(@system_vars[SV_RAND])^);
end.