Skip to content

GitLab

Commit 3aeaf096 authored by John van Groningen's avatar John van Groningen
Browse files
Options

add system dependent files for the heap profiler on the Mac

parent 699a8d9e
Hide whitespace changes
Inline Side-by-side
Showing with 459 additions and 0 deletions
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);
}
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment