1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
|
{
This file is part of the Free Pascal run time library.
Copyright (c) 2005 Karoly Balogh
abox.lib implementation for MorphOS/PowerPC
MorphOS port was done on a free Pegasos II/G4 machine
provided by Genesi S.a.r.l. <www.genesi.lu>
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
unit aboxlib;
interface
function DoMethod(obj : longword; msg : array of LongWord): longword;
function DoMethod(obj : pointer; msg : array of LongWord): longword; inline;
function DoMethodA(obj : longword; msg1 : Pointer): longword; assembler;
function DoSuperMethod(class_: longword; obj : longword; msg : array of LongWord): longword;
function DoSuperMethodA(class_: longword; obj : longword; msg1 : Pointer): longword; assembler;
function DoSuperMethodA(class_: pointer; obj : pointer; msg1 : Pointer): longword; inline;
function DoSuperNew(class_: pointer; obj: pointer; tags: array of LongWord): longword;
// This procedure is used to pop dispatcher args from emulstruc
procedure DISPATCHERARG(var cl; var obj; var msg); assembler;
implementation
uses intuition;
function DoMethodA(obj : longword; msg1 : Pointer): longword; assembler;
asm
mflr r31
lwz r9,-4(r3)
stw r9,32(r2)
stw r4,36(r2)
stw r3,40(r2)
lwz r11,104(r2)
lwz r3,8(r9)
mtlr r11
blrl
mtlr r31
end ['R31'];
function DoMethod(obj : longword; msg : array of LongWord): longword;
begin
DoMethod:=DoMethodA(obj, @msg);
end;
function DoMethod(obj : pointer; msg : array of LongWord): longword; inline;
begin
DoMethod:=DoMethodA(DWord(obj), @msg);
end;
function DoSuperMethodA(class_: longword; obj : longword; msg1 : Pointer): longword; assembler;
asm
mflr r31
lwz r9,24(r3)
stw r9,32(r2)
stw r5,36(r2)
stw r4,40(r2)
lwz r11,104(r2)
lwz r3,8(r9)
mtlr r11
blrl
mtlr r31
end ['R31'];
function DoSuperMethodA(class_: pointer; obj : pointer; msg1 : Pointer): longword; inline;
begin
DoSuperMethodA:=DoSuperMethodA(DWord(class_),DWord(obj),msg1);
end;
function DoSuperMethod(class_: longword; obj : longword; msg : array of LongWord): longword;
begin
DoSuperMethod:=DoSuperMethodA(class_, obj, @msg);
end;
function DoSuperNew(class_: pointer; obj: pointer; tags: array of LongWord): longword;
var opSet: topSet;
begin
opSet.MethodID := OM_NEW;
opSet.ops_AttrList := @tags;
opSet.ops_GInfo := nil;
DoSuperNew:=DoSuperMethodA(class_,obj,@opset);
end;
// This procedure is used to pop dispatcher args from emulstruc
procedure DISPATCHERARG(var cl; var obj; var msg); assembler;
asm
lwz r6,32(r2) // REG_a0
stw r6,(r3) // cl
lwz r6,40(r2) // REG_a2
stw r6,(r4) // obj
lwz r6,36(r2) // REG_a1
stw r6,(r5) // msg
end;
end.
|
