Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
7
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Open sidebar
clean-and-itasks
clean-ide
Commits
3aeaf096
Commit
3aeaf096
authored
Mar 22, 2005
by
John van Groningen
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
add system dependent files for the heap profiler on the Mac
parent
699a8d9e
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
459 additions
and
0 deletions
+459
-0
HeapProfile/Mac/heap_profile_os_dependent.dcl
HeapProfile/Mac/heap_profile_os_dependent.dcl
+65
-0
HeapProfile/Mac/heap_profile_os_dependent.icl
HeapProfile/Mac/heap_profile_os_dependent.icl
+394
-0
No files found.
HeapProfile/Mac/heap_profile_os_dependent.dcl
0 → 100644
View file @
3aeaf096
definition
module
heap_profile_os_dependent
import
StdInt
,
StdBool
,
StdClass
,
StdArray
,
StdFile
;
PCorMac
pc
mac
:==
mac
;
::
Header
=
{
heap_begin
::
!
Int
,
heap_end
::
!
Int
,
heap2_begin
::
!
Int
,
heap2_end
::
!
Int
,
text_begin
::
!
Int
,
// for PowerPC
data_begin
::
!
Int
,
small_integers
::
!
Int
,
characters
::
!
Int
,
text_addresses
::
!{#
Int
}
// for 68k
};
FileExists
::
!
String
->
Bool
;
IF_BIG_ENDIAN
big
little
:==
big
;
::
Text
:==
{#
Char
};
read_application_name
::
!*
File
->
(!{#
Char
},!*
File
);
read_text_addresses
::
!*
File
->
(!{#
Int
},!*
File
);
read_application
::
!{#
Char
}
!{#
Char
}
Header
!
Files
->
(!
Bool
,!{#
Char
},!
Text
,
Header
,!
Files
);
PageNumberOffsetFromEndInFileName
:==
1
;
get_text_resource_n
address
header
text
:==
in_text_section
address
header
.
text_begin
(
size
text
);
in_text_section
::
!
Int
!
Int
!
Int
->
Int
;
long_in_text_resource
_
/*text_resource_n*/
a
header
text
:==
text
LONG
(
a
-
header
.
text_begin
);
relocate_descriptor
descriptor
header
:==
descriptor
+
header
.
data_begin
;
is_closure
descriptor
:==
(
descriptor
bitand
2
)==
0
;
non_relocated_descriptor_to_data_offset
descriptor
_
/*header*/
_
/*data*/
:==
descriptor
-2
;
relocated_descriptor_to_data_offset
descriptor
header
_
/*data*/
:==
descriptor
-2
-
header
.
data_begin
;
address_to_data_offset
a
data_begin
_
/*data*/
:==
a
-
data_begin
;
non_record_arity
::
!
Int
->
Int
;
constructor_name
data_begin
data_offset
arity
data
text
:==
constructor_name_
data_offset
arity
data
text
;
constructor_name_
::
!
Int
!
Int
!{#
Char
}
{#
Char
}
->
(!{#
Char
},!{#
Char
});
closure_text_offset
descriptor
_
/*text_resource_n*/
header
:==
descriptor
-
header
.
text_begin
-4
;
get_closure_arity
text_offset
_
/*text_resource_n*/
text
:==
text
LONG
text_offset
;
is_selector
arity
:==
arity
<
0
&&
arity
>=(
-4
);
get_closure_name
::
!
Int
.
a
.
b
.
c
!{#
Char
}
!{#
Char
}
->
.(!{#
Char
},!{#
Char
});
record_name
::
.
a
!
Int
!{#
Char
}
.
b
->
.(!{#
Char
},!{#
Char
});
(
LONG
)
::
!{#
Char
}
!
Int
->
Int
;
HeapProfile/Mac/heap_profile_os_dependent.icl
0 → 100644
View file @
3aeaf096
implementation
module
heap_profile_os_dependent
;
import
StdEnv
;
::
Header
=
{
heap_begin
::
!
Int
,
heap_end
::
!
Int
,
heap2_begin
::
!
Int
,
heap2_end
::
!
Int
,
text_begin
::
!
Int
,
// for PowerPC
data_begin
::
!
Int
,
small_integers
::
!
Int
,
characters
::
!
Int
,
text_addresses
::
!{#
Int
}
// for 68k
};
from
files
import
GetFInfo
,
NewToolbox
,::
Toolbox
;
PCorMac
pc
mac
:==
mac
;
FileExists
::
!
String
->
Bool
;
FileExists
name
=
result
==
0
;
{
(
result
,_,_)
=
GetFInfo
name
NewToolbox
;
}
/* for PowerPC */
IF_BIG_ENDIAN
big
little
:==
big
;
::
Text
:==
{#
Char
};
read_application_name
::
!*
File
->
(!{#
Char
},!*
File
);
read_application_name
file
=
freads
file
32
;
read_text_addresses
::
!*
File
->
(!{#
Int
},!*
File
);
read_text_addresses
file
=
({},
file
);
read_application
::
!{#
Char
}
!{#
Char
}
Header
!
Files
->
(!
Bool
,!{#
Char
},!
Text
,
Header
,!
Files
);
read_application
file_name
application_file_name
header
files
#
application_file_name
=
replace_file_name_in_path
file_name
application_file_name
;
#
(
ok
,
file
,
files
)
=
fopen
application_file_name
FReadData
files
;
|
not
ok
=
abort
(
"cannot open application file: "
+++
toString
application_file_name
);
#
(
ok
,
xcoff_magic
,
file
)
=
freadi
file
;
// | not ok || (xcoff_magic>>16)<>0x01DF
|
not
ok
||
xcoff_magic
<>
0x4A6F7921
=
abort
"not an application file"
;
// # (ok1,file) = fseek file 0x94 FSeekSet;
#
(
ok1
,
file
)
=
fseek
file
0x54
FSeekSet
;
(
ok2
,
data_section_size
,
file
)
=
freadi
file
;
(
ok3
,
data_section_offset
,
file
)
=
freadi
file
;
|
not
ok1
||
not
ok2
||
not
ok3
=
abort
"error reading application file"
;
#
(
ok
,
file
)
=
fseek
file
data_section_offset
FSeekSet
;
(
data
,
file
)
=
freads
file
data_section_size
;
|
not
ok
||
size
data
<>
data_section_size
=
abort
"error reading application file"
;
// # (ok1,file) = fseek file 0x6C FSeekSet;
#
(
ok1
,
file
)
=
fseek
file
0x38
FSeekSet
;
(
ok2
,
text_section_size
,
file
)
=
freadi
file
;
(
ok3
,
text_section_offset
,
file
)
=
freadi
file
;
|
not
ok1
||
not
ok2
||
not
ok3
=
abort
"error reading application file"
;
#
(
ok
,
file
)
=
fseek
file
text_section_offset
FSeekSet
;
(
text
,
file
)
=
freads
file
text_section_size
;
|
not
ok
||
size
text
<>
text_section_size
=
abort
"error reading application file"
;
#
(
ok
,
files
)
=
fclose
file
files
;
|
not
ok
=
abort
"error closing application file"
;
=
(
True
,
data
,
text
,
header
,
files
);
PageNumberOffsetFromEndInFileName
:==
1
;
get_text_resource_n
address
header
text
:==
in_text_section
address
header
.
text_begin
(
size
text
);
in_text_section
::
!
Int
!
Int
!
Int
->
Int
;
in_text_section
address
text_begin
size_text
|
address
>=
text_begin
&&
address
<
text_begin
+
size_text
=
0
;
=
-1
;
long_in_text_resource
_
/*text_resource_n*/
a
header
text
:==
text
LONG
(
a
-
header
.
text_begin
);
relocate_descriptor
descriptor
header
:==
descriptor
+
header
.
data_begin
;
is_closure
descriptor
:==
(
descriptor
bitand
2
)==
0
;
non_relocated_descriptor_to_data_offset
descriptor
_
/*header*/
_
/*data*/
:==
descriptor
-2
;
relocated_descriptor_to_data_offset
descriptor
header
_
/*data*/
:==
descriptor
-2
-
header
.
data_begin
;
address_to_data_offset
a
data_begin
_
/*data*/
:==
a
-
data_begin
;
non_record_arity
::
!
Int
->
Int
;
non_record_arity
arity
=
arity
;
constructor_name
data_begin
data_offset
arity
data
text
:==
constructor_name_
data_offset
arity
data
text
;
constructor_name_
::
!
Int
!
Int
!{#
Char
}
{#
Char
}
->
(!{#
Char
},!{#
Char
});
constructor_name_
data_offset
arity
data
text
#
descriptor_offset
=
data_offset
-(
data
WORD
(
data_offset
+2
));
descriptor_arity
=
data
WORD
(
descriptor_offset
-2
);
string_offset
=
descriptor_offset
+4
+(
descriptor_arity
<<
3
);
string_length
=
data
LONG
string_offset
;
module_name_offset
=
data
LONG
(
descriptor_offset
-12
);
module_name_length
=
data
LONG
module_name_offset
;
=
(
data
%
(
string_offset
+4
,
string_offset
+3
+
string_length
),
data
%
(
module_name_offset
+4
,
module_name_offset
+3
+
module_name_length
));
closure_text_offset
descriptor
_
/*text_resource_n*/
header
:==
descriptor
-
header
.
text_begin
-4
;
get_closure_arity
text_offset
_
/*text_resource_n*/
text
:==
text
LONG
text_offset
;
is_selector
arity
:==
arity
<
0
&&
arity
>=(
-4
);
get_closure_name
::
!
Int
.
a
.
b
.
c
!{#
Char
}
!{#
Char
}
->
.(!{#
Char
},!{#
Char
});
get_closure_name
text_offset
arity
text_resource_n
header
text
data
#
descriptor_toc_offset
=
text
WORD
(
text_offset
-
2
);
|
descriptor_toc_offset
bitand
3
<>
0
=
abort
"get_closure_name"
;
#
descriptor_offset
=
data
LONG
(
descriptor_toc_offset
-0x8000
);
descriptor_arity
=
data
WORD
(
descriptor_offset
-2
);
string_offset
=
descriptor_offset
+4
+(
descriptor_arity
<<
3
);
string_length
=(
data
LONG
string_offset
);
module_name_offset
=
data
LONG
(
descriptor_offset
-12
);
module_name_length
=
data
LONG
module_name_offset
;
=
(
data
%
(
string_offset
+4
,
string_offset
+3
+
string_length
),
data
%
(
module_name_offset
+4
,
module_name_offset
+3
+
module_name_length
));
record_name
::
.
a
!
Int
!{#
Char
}
.
b
->
.(!{#
Char
},!{#
Char
});
record_name
header
data_offset
data
text
#
string_offset
=
data
LONG
(
data_offset
-4
);
string_length
=(
data
LONG
string_offset
);
module_name_offset
=
data
LONG
(
data_offset
-8
);
module_name_length
=
data
LONG
module_name_offset
;
=
(
data
%
(
string_offset
+4
,
string_offset
+3
+
string_length
),
data
%
(
module_name_offset
+4
,
module_name_offset
+3
+
module_name_length
));
record_type
data_offset
data
text
#
type_string_offset
=
data_offset
+4
;
end_type_string_offset
=
find_zero_char
type_string_offset
data
;
=
data
%
(
type_string_offset
,
dec
end_type_string_offset
);
// end for PowerPC
/* */
// for 68k
/*
IF_BIG_ENDIAN big little :== big;
:: Text :== {!{#Char}};
read_application_name file = freads file 32;
read_text_addresses file
# (text_address_list,file) = read_text_address_list file;
with {
read_text_address_list file
# (ok,text_address,file) = freadi file;
| not ok
= abort "error reading text addresses";
| text_address==0
= ([],file);
# (text_addresses,file) = read_text_address_list file;
= ([text_address:text_addresses],file);
}
= ({ i \\ i<-text_address_list},file);
read_application :: {#Char} {#Char} Header Files -> (!{#Char},!Text,Header,!Files);
read_application file_name application_file_name header files
# application_file_name=replace_file_name_in_path file_name application_file_name;
# (ref_num,t)=HOpenResFile 0 0 application_file_name 3 0;
| ref_num==(-1)
= abort "cannot open application file";
# (code_resource_list,t)=load_code_resources 0 t;
# (res_error,_)=ResError (CloseResFile ref_num t);
| res_error<>0
= abort "error closing application file";
# code_resources = createArray (length code_resource_list) "";
code_resources = fill_array 0 code_resource_list code_resources;
with {
fill_array i [] code_resources = code_resources;
fill_array i [e:l] code_resources = fill_array (inc i) l {code_resources & [i]=e};
}
last_code_resource_n = dec (size code_resources);
last_code_resource = code_resources.[last_code_resource_n];
data_section_size = ((toInt last_code_resource.[0xfc]-0x18)<<16)
+ (toInt last_code_resource.[0xfd]<<8)
+ toInt last_code_resource.[0xfe];
data = last_code_resource % (0x101,0x100+data_section_size);
= (True,data,code_resources,header,files);
PageNumberOffsetFromEndInFileName:==1;
load_code_resources n t
# (h,t)=Get1Resource "CODE" n t;
| h==0
= ([],t);
# (s,t)=GetHandleSize h t;
(code_resource,t)=handle_to_string h s t;
(code_resources,t)=load_code_resources (inc n) t;
= ([code_resource:code_resources],t);
handle_to_string :: !Handle !Int !Toolbox -> (!{#Char},!Toolbox);
handle_to_string handle size t0
= (string,t1);
{
t1=copy_handle_data_to_string string handle size t0;
string = createArray size ' ';
}
get_text_resource_n address header text :== find_text_resource_n address header.text_addresses text;
find_text_resource_n address text_addresses text
= find_text_resource_n 0;
{
find_text_resource_n resource_n
| resource_n>=size text_addresses
= -1;
# text_address=text_addresses.[resource_n];
| address>=text_address && address<text_address+size text.[resource_n]
= resource_n;
= find_text_resource_n (inc resource_n);
}
long_in_text_resource text_resource_n a header text
:== text.[text_resource_n] LONG (a-header.text_addresses.[text_resource_n]);
relocate_descriptor descriptor header :== descriptor;
is_closure descriptor :== descriptor>=0;
non_relocated_descriptor_to_data_offset descriptor _/*header*/ data :== size data+descriptor;
relocated_descriptor_to_data_offset descriptor header data :== size data+descriptor;
address_to_data_offset a data_begin data :== a-(data_begin-size data);
non_record_arity arity = arity>>2;
constructor_name data_begin data_offset arity data text :== constructor_name_ data_begin data_offset arity data text;
constructor_name_ data_offset arity data text
# descriptor_offset=data_offset-(arity<<2);
string_jump_table_offset=data WORD (descriptor_offset-2);
= string_from_jump_table_offset string_jump_table_offset text;
string_from_jump_table_offset string_jump_table_offset text
# string_offset=(text.[0] WORD (string_jump_table_offset-18))+6;
string_resource_n=text.[0] WORD (string_jump_table_offset-14);
string_length=text.[string_resource_n] LONG (string_offset+4);
= text.[string_resource_n] % (string_offset+8,string_offset+7+string_length);
closure_text_offset descriptor text_resource_n header
:== descriptor-header.text_addresses.[text_resource_n]-2;
get_closure_arity text_offset text_resource_n text
:==text.[text_resource_n] WORD text_offset;
is_selector arity :== arity>=65532;
(SWORD) string i
| w<32768
= w;
= w-65536;
{}{
w = (string BYTE i<<8) bitor (string BYTE (i+1));
}
get_closure_name text_offset arity text_resource_n header text
# text_resource=text.[text_resource_n];
encoded_string_size=text_resource LONG (text_offset-4);
string_size=(encoded_string_size>>2) bitand 63;
| encoded_string_size==(string_size<<2) bitor (string_size<<10) bitor (string_size<<18) bitor (string_size<<26) bitor 0x00010203
# string_offset=text_offset-4-((string_size+3) bitand (-4));
= text_resource % (string_offset,string_offset+string_size-1);
# encoded_string_size2=text_resource LONG (text_offset-14);
string_size2=(encoded_string_size2>>2) bitand 63;
| (string_size bitand 0xffff)==0 && encoded_string_size2==(string_size2<<2) bitor (string_size2<<10) bitor (string_size2<<18) bitor (string_size2<<26) bitor 0x00010203
# string_offset=text_offset-14-((string_size2+3) bitand (-4));
= text_resource % (string_offset,string_offset+string_size2-1);
# next_text_offset=text_offset+2+text_resource SWORD (text_offset+4);
| text_resource WORD (text_offset+2)==0x4efa && text_resource WORD next_text_offset==arity
= get_closure_name2 next_text_offset arity text_resource_n header text;
# a5_offset=text_resource SWORD (text_offset+4);
text0=text.[0];
next_resource_offset=(text0 WORD (a5_offset-18))+2;
next_resource_n=text0 WORD (a5_offset-14);
| text_resource WORD (text_offset+2)==0x4eed && a5_offset>=16
&& text0 WORD (a5_offset-16)==0x3f3c && text0 WORD (a5_offset-12)==0xa9f0
&& text.[next_resource_n] WORD next_resource_offset==arity
= get_closure_name2 next_resource_offset arity next_resource_n header text;
= "Function"+++toString (arity);
get_closure_name2 text_offset arity text_resource_n header text
# text_resource=text.[text_resource_n];
encoded_string_size=text_resource LONG (text_offset-4);
string_size=(encoded_string_size>>2) bitand 63;
| encoded_string_size==(string_size<<2) bitor (string_size<<10) bitor (string_size<<18) bitor (string_size<<26) bitor 0x00010203
# string_offset=text_offset-4-((string_size+3) bitand (-4));
= text_resource % (string_offset,string_offset+string_size-1);
# encoded_string_size2=text_resource LONG (text_offset-14);
string_size2=(encoded_string_size2>>2) bitand 63;
| (string_size bitand 0xffff)==0 && encoded_string_size2==(string_size2<<2) bitor (string_size2<<10) bitor (string_size2<<18) bitor (string_size2<<26) bitor 0x00010203
# string_offset=text_offset-14-((string_size2+3) bitand (-4));
= text_resource % (string_offset,string_offset+string_size2-1);
= "Function"+++toString (arity);
record_name header data_offset data text
# string_jump_table_offset=data WORD (data_offset-2);
= string_from_jump_table_offset string_jump_table_offset text;
record_type data_offset data text
# type_string_offset=data_offset+4;
end_type_string_offset=find_zero_char type_string_offset data;
= data % (type_string_offset,dec end_type_string_offset);
:: Toolbox:==Int;
:: Handle:==Int;
// in resources.icl
HOpenResFile :: !Int !Int !{#Char} !Int !Toolbox -> (!Int,!Toolbox);
HOpenResFile vRefNum dirID fileName permission t
= code (vRefNum=R2W,dirID=L,fileName=S,permission=D1,t=U)(refNum=W,t2=Z){
instruction 0x1F01 | move.b d1,-(sp)
instruction 0xA81A
}
CloseResFile :: !Int !Toolbox -> Toolbox;
CloseResFile refNum t = code (refNum=W,t=U)(t2=Z){
instruction 0xA99A
}
ResError :: !Toolbox -> (!Int,!Toolbox);
ResError t = code (t=R2U)(res_error=W,t2=Z){
instruction 0xA9AF
}
Get1Resource :: !{#Char} !Int !Toolbox -> (!Handle,!Toolbox);
Get1Resource theType index t = code (theType=R4A0,index=D1,t=u)(handle=L,t2=Z){
instruction 0x2F28 0x0008 | move.l 8(a0),-(sp)
instruction 0x3F01 | move.w d1,-(sp)
instruction 0xA81F
}
// in memory.icl
GetHandleSize :: !Handle !Toolbox -> (!Int,!Toolbox);
GetHandleSize handle t = code (handle=D1,t=U)(result_code=D1,z=Z){
instruction 0x2041 || move.l d1,a0
instruction 0xA025
instruction 0x2200 || move.l d0,d1
}
copy_handle_data_to_string :: !{#Char} !Handle !Int !Toolbox -> Toolbox;
copy_handle_data_to_string string handle size t0 = code (string=A0,handle=D2,size=D1,t0=U)(t1=Z){
instruction 0x2248 || move.l a0,a1
instruction 0x2042 || move.l d2,a0
instruction 0x5089 || addq.l #8,a1
instruction 0x2050 || move.l (a0),a0
instruction 0x2001 || move.l d1,d0
instruction 0xA22E || BlockMoveData
}
*/
// end for 68k
(
BYTE
)
string
i
:==
toInt
(
string
.[
i
]);
(
WORD
)
string
i
:==
IF_BIG_ENDIAN
((
string
BYTE
i
<<
8
)
bitor
(
string
BYTE
(
i
+1
)))
((
string
BYTE
i
)
bitor
(
string
BYTE
(
i
+1
)
<<
8
));
(
LONG
)
::
!{#
Char
}
!
Int
->
Int
;
(
LONG
)
string
i
=
IF_BIG_ENDIAN
((
string
BYTE
i
<<
24
)
bitor
(
string
BYTE
(
i
+1
)<<
16
)
bitor
(
string
BYTE
(
i
+2
)<<
8
)
bitor
(
string
BYTE
(
i
+3
)))
(((
string
BYTE
i
)
bitor
(
string
BYTE
(
i
+1
)
<<
8
)
bitor
(
string
BYTE
(
i
+2
)
<<
16
)
bitor
(
string
BYTE
(
i
+3
)
<<
24
)));
find_zero_char
i
s
|
s
.[
i
]==
'\0'
=
i
;
=
find_zero_char
(
inc
i
)
s
;
replace_file_name_in_path
path
file_name
=
remove_file_name_from_path
(
size
path
-1
)+++
file_name
;
{
remove_file_name_from_path
i
|
i
<
0
=
path
;
|
path
.[
i
]==
':'
=
path
%
(
0
,
i
);
=
remove_file_name_from_path
(
i
-1
);
}
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment