mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-09 10:48:30 +02:00
atari: add nf_ops unit to access NatFeats from emulators
This commit is contained in:
Thorsten Otto
Charlie Balogh
parent
46ab8d79a2
commit
a79aa87272
@ -36,6 +36,7 @@ begin
|
||||
T:=P.Targets.AddUnit('aes.pas');
|
||||
T:=P.Targets.AddUnit('gem.pas');
|
||||
T:=P.Targets.AddUnit('gemcommon.pas');
|
||||
T:=P.Targets.AddUnit('nf_ops.pas');
|
||||
|
||||
P.ExamplePath.Add('examples');
|
||||
T:=P.Targets.AddExampleProgram('higem.pas');
|
||||
|
||||
231
packages/tosunits/src/nf_ops.pas
Normal file
231
packages/tosunits/src/nf_ops.pas
Normal file
@ -0,0 +1,231 @@
|
||||
{$X+}
|
||||
{$I-}
|
||||
{$Q-}
|
||||
{$R-}
|
||||
{$S-}
|
||||
{$B-}
|
||||
|
||||
unit NF_OPS;
|
||||
|
||||
interface
|
||||
|
||||
const
|
||||
NF_ID_NAME : pchar = 'NF_NAME';
|
||||
NF_ID_VERSION : pchar = 'NF_VERSION';
|
||||
NF_ID_STDERR : pchar = 'NF_STDERR';
|
||||
NF_ID_SHUTDOWN : pchar = 'NF_SHUTDOWN';
|
||||
NF_ID_EXIT : pchar = 'NF_EXIT';
|
||||
NF_ID_DEBUG : pchar = 'DEBUGPRINTF';
|
||||
NF_ID_ETHERNET : pchar = 'ETHERNET';
|
||||
NF_ID_HOSTFS : pchar = 'HOSTFS';
|
||||
NF_ID_AUDIO : pchar = 'AUDIO';
|
||||
NF_ID_BOOTSTRAP : pchar = 'BOOTSTRAP';
|
||||
NF_ID_CDROM : pchar = 'CDROM';
|
||||
NF_ID_CLIPBRD : pchar = 'CLIPBRD';
|
||||
NF_ID_JPEG : pchar = 'JPEG';
|
||||
NF_ID_OSMESA : pchar = 'OSMESA';
|
||||
NF_ID_PCI : pchar = 'PCI';
|
||||
NF_ID_FVDI : pchar = 'fVDI';
|
||||
NF_ID_USBHOST : pchar = 'USBHOST';
|
||||
NF_ID_XHDI : pchar = 'XHDI';
|
||||
NF_ID_SCSI : pchar = 'NF_SCSIDRV';
|
||||
NF_ID_HOSTEXEC : pchar = 'HOSTEXEC';
|
||||
NF_ID_CONFIG : pchar = 'NF_CONFIG';
|
||||
|
||||
(*
|
||||
* return the NF id to use for feature_name,
|
||||
* or zero when not available.
|
||||
*)
|
||||
function nf_get_id(feature_name: pchar): longint;
|
||||
|
||||
(*
|
||||
* return the version of the NatFeat implementation,
|
||||
* or zero when not available.
|
||||
*)
|
||||
function nf_version: longint;
|
||||
|
||||
(*
|
||||
* return the name of the NatFeat implementor,
|
||||
* or NULL when not available.
|
||||
*)
|
||||
procedure nf_get_name(buf: Pchar; bufsize: longint);
|
||||
|
||||
(*
|
||||
* return the full name of the NatFeat implementor,
|
||||
* or NULL when not available.
|
||||
*)
|
||||
procedure nf_get_fullname(buf: Pchar; bufsize: longint);
|
||||
|
||||
(*
|
||||
* Write a string to the host's terminal.
|
||||
* returns TRUE when available, FALSE otherwise.
|
||||
*)
|
||||
function nf_debug(const s: string): boolean;
|
||||
|
||||
(*
|
||||
* Shutdown the emulator.
|
||||
* May only be called from Supervisor.
|
||||
*)
|
||||
function nf_shutdown(mode: integer): longint;
|
||||
|
||||
(*
|
||||
* Shutdown the emulator.
|
||||
* May be called from user mode.
|
||||
*)
|
||||
function nf_exit(exitcode: integer): longint;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
xbios;
|
||||
|
||||
const
|
||||
NATFEAT_ID = $7300;
|
||||
NATFEAT_CALL = $7301;
|
||||
|
||||
var
|
||||
nf_available: boolean;
|
||||
nf_inited: boolean;
|
||||
nf_stderr: longint;
|
||||
|
||||
type
|
||||
Tnf_id = function(id: Pchar): longint; cdecl;
|
||||
Tnf_call = function(id: longint): longint; cdecl; varargs;
|
||||
|
||||
var cnf_call: Tnf_call;
|
||||
|
||||
var ps: array[0..255] of char;
|
||||
|
||||
const nf_id_opcodes: array[0..1] of word = (NATFEAT_ID, $4e75);
|
||||
nf_call_opcodes: array[0..1] of word = (NATFEAT_CALL, $4e75);
|
||||
|
||||
function nf_id(id: Pchar): longint;
|
||||
var cnf_id: Tnf_id;
|
||||
begin
|
||||
cnf_id := Tnf_id(@nf_id_opcodes);
|
||||
nf_id := cnf_id(id);
|
||||
end;
|
||||
|
||||
|
||||
const nf_version_str: array[0..11] of char = 'NF_VERSION';
|
||||
|
||||
function nf_detect: longint; assembler; nostackframe;
|
||||
asm
|
||||
{$IFDEF CPUCFV4E}
|
||||
(*
|
||||
* on ColdFire, the NATFEAT_ID opcode is actually
|
||||
* "mvs.b d0,d1".
|
||||
* But since there is no emulator that emulates a ColdFire,
|
||||
* this feature isn't available.
|
||||
*)
|
||||
moveq #0,d0
|
||||
{$ELSE}
|
||||
pea nf_version_str
|
||||
moveq #0,d0 (* assume no NatFeats available *)
|
||||
move.l d0,-(sp)
|
||||
lea @nf_illegal,a1
|
||||
move.l $0010,a0 (* illegal instruction vector *)
|
||||
move.l a1,$0010
|
||||
move.l sp,a1 (* save the ssp *)
|
||||
|
||||
nop (* flush pipelines (for 68040+) *)
|
||||
|
||||
dc.w NATFEAT_ID (* Jump to NATFEAT_ID *)
|
||||
tst.l d0
|
||||
beq.s @nf_illegal
|
||||
moveq #1,d0 (* NatFeats detected *)
|
||||
move.l d0,(sp)
|
||||
|
||||
@nf_illegal:
|
||||
move.l a1,sp
|
||||
move.l a0,$0010
|
||||
nop (* flush pipelines (for 68040+) *)
|
||||
move.l (sp)+,d0
|
||||
addq.l #4,sp (* pop nf_version argument *)
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
function nf_init: boolean;
|
||||
var ret: longint;
|
||||
begin
|
||||
if not nf_inited then
|
||||
begin
|
||||
ret := xbios_supexec(@nf_detect);
|
||||
nf_available := ret <> 0;
|
||||
nf_inited := true;
|
||||
cnf_call := Tnf_call(@nf_call_opcodes);
|
||||
end;
|
||||
nf_init := nf_available;
|
||||
end;
|
||||
|
||||
|
||||
function nf_get_id(feature_name: pchar): longint;
|
||||
begin
|
||||
nf_get_id := 0;
|
||||
if nf_init then
|
||||
nf_get_id := nf_id(feature_name);
|
||||
end;
|
||||
|
||||
function nf_version: longint;
|
||||
var id: longint;
|
||||
begin
|
||||
nf_version := 0;
|
||||
id := nf_get_id(NF_ID_VERSION);
|
||||
if id <> 0 then
|
||||
nf_version := cnf_call(id);
|
||||
end;
|
||||
|
||||
procedure nf_get_name(buf: Pchar; bufsize: longint);
|
||||
var id: longint;
|
||||
begin
|
||||
id := nf_get_id(NF_ID_NAME);
|
||||
if id <> 0 then
|
||||
cnf_call(id or 0, buf, bufsize)
|
||||
else
|
||||
buf^ := #0;
|
||||
end;
|
||||
|
||||
procedure nf_get_fullname(buf: Pchar; bufsize: longint);
|
||||
var id: longint;
|
||||
begin
|
||||
id := nf_get_id(NF_ID_NAME);
|
||||
if id <> 0 then
|
||||
cnf_call(id or 1, buf, bufsize)
|
||||
else
|
||||
buf^ := #0;
|
||||
end;
|
||||
|
||||
function nf_debug(const s: string): boolean;
|
||||
begin
|
||||
ps := s;
|
||||
nf_debug := false;
|
||||
if nf_stderr = 0 then
|
||||
nf_stderr := nf_get_id(NF_ID_STDERR);
|
||||
if nf_stderr <> 0 then
|
||||
begin
|
||||
cnf_call(nf_stderr, Addr(ps[0]));
|
||||
nf_debug := true;
|
||||
end;
|
||||
end;
|
||||
|
||||
function nf_shutdown(mode: integer): longint;
|
||||
var id: longint;
|
||||
begin
|
||||
nf_shutdown := 0;
|
||||
id := nf_get_id(NF_ID_SHUTDOWN);
|
||||
if id <> 0 then
|
||||
nf_shutdown := cnf_call(id or mode);
|
||||
end;
|
||||
|
||||
function nf_exit(exitcode: integer): longint;
|
||||
var id: longint;
|
||||
begin
|
||||
nf_exit := 0;
|
||||
id := nf_get_id(NF_ID_EXIT);
|
||||
if id <> 0 then
|
||||
nf_exit := cnf_call(id or 0, longint(exitcode));
|
||||
end;
|
||||
|
||||
begin
|
||||
end.
|
||||
Loading…
Reference in New Issue
Block a user