From c45cc0d5012345ea137f1e2012f85dbd09e4f5a1 Mon Sep 17 00:00:00 2001 From: John van Groningen Date: Tue, 6 May 2003 14:27:29 +0000 Subject: macintosh files --- Worksheet | 28 + mcon.c | 1670 ++++++++++++++++ mcon.h | 16 + mfileIO3.c | 2718 ++++++++++++++++++++++++++ mwrite_heap.c | 237 +++ pcompact.a | 1762 +++++++++++++++++ pcopy.a | 1000 ++++++++++ pfileIO3.a | 1428 ++++++++++++++ pmacros.a | 54 + pmark.a | 2316 ++++++++++++++++++++++ pprofile.a | 1407 +++++++++++++ pstartup.a | 6085 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ptrace.a | 676 +++++++ 13 files changed, 19397 insertions(+) create mode 100644 Worksheet create mode 100644 mcon.c create mode 100644 mcon.h create mode 100644 mfileIO3.c create mode 100644 mwrite_heap.c create mode 100644 pcompact.a create mode 100644 pcopy.a create mode 100644 pfileIO3.a create mode 100644 pmacros.a create mode 100644 pmark.a create mode 100644 pprofile.a create mode 100644 pstartup.a create mode 100644 ptrace.a diff --git a/Worksheet b/Worksheet new file mode 100644 index 0000000..5ddf528 --- /dev/null +++ b/Worksheet @@ -0,0 +1,28 @@ + +Set -e CIncludes 'Programs:Metrowerks CodeWarrior 6.0:Metrowerks CodeWarrior:Carbon Support:Universal Interfaces:CIncludes,Programs:MPW:Interfaces:CIncludes' + +mrc -w off -sym off -d POWER -d G_POWER -d WRITE_HEAP mcon.c -o mcon.c.x +mrc -sym off -d POWER -d G_POWER mwrite_heap.c -o mwrite_heap.c.x +ppcasm -sym off -d PROFILE=0 -d LINUX=0 -typecheck pstartup.a -o pstartup.a.o +PPCLink -sym off -xm library mcon.c.x mwrite_heap.c.x pstartup.a.o -o _startup.o +setfile -t CgOb -c 3PRM _startup.o + +mrc -w off -sym off -d POWER -d G_POWER -d WRITE_HEAP -d TIME_PROFILE -d LINUX=0 mcon.c -o mcon.c.x +ppcasm -sym off -d PROFILE=1 -d LINUX=0 -typecheck pstartup.a -o pstartup.a.o +ppcasm -d POWER601=0 -d LINUX=0 -sym off -typecheck pprofile.a -o pprofile.a.o +PPCLink -sym off -xm library mcon.c.x mwrite_heap.c.x pprofile.a.o pstartup.a.o -o _startupProfile.o +setfile -t CgOb -c 3PRM _startupProfile.o + +ppcasm -d POWER601=1 -sym off -typecheck pprofile.a -o pprofile.a.o +PPCLink -sym off -xm library mcon.c.x mwrite_heap.c.x pprofile.a.o pstartup.a.o -o _startupProfile601.o +setfile -t CgOb -c 3PRM _startupProfile601.o + +ppcasm -sym off -typecheck ptrace.a -o ptrace.a.o +PPCLink -sym off -xm library mcon.c.x mwrite_heap.c.x ptrace.a.o pstartup.a.o -o _startupTrace.o +setfile -t CgOb -c 3PRM _startupTrace.o + + +mrc -typecheck relaxed -w off -sym off -d POWER -d G_POWER mfileIO3.c +ppcasm -sym off -typecheck pfileIO3.a -o pfileIO3.a.o +PPCLink -sym off -xm library pfileIO3.a.o mfileIO3.c.o -o _library.o +setfile -t CgOb -c 3PRM _library.o diff --git a/mcon.c b/mcon.c new file mode 100644 index 0000000..add8c69 --- /dev/null +++ b/mcon.c @@ -0,0 +1,1670 @@ +/* + File: mcon.c + Written by: John van Groningen +*/ + +#define MACOSX +#define NEW_HEADERS +#define G_POWER +#define FLUSH_PORT_BUFFER + +#ifdef MACHO +# define NEWLINE_CHAR '\r' +#else +# define NEWLINE_CHAR '\n' +#endif + +#ifdef NEW_HEADERS +# define TARGET_API_MAC_CARBON 1 +#endif + +#ifndef NEW_HEADERS +#include +#include +#include +#else +# ifndef MACHO +extern void sprintf (char *,...); +# endif +#endif + +#define MULW(a,b) ((int)((short)(a)*(short)(b))) +#define UDIVW(a,b) ((unsigned short)((unsigned short)(a)/(unsigned short)(b))) + +#include +#include +#include +#include +#ifndef NEW_HEADERS +# include +#endif +#include +#include +#include +#include +#ifndef NEW_HEADERS +# include +#endif + +#ifdef MACOSX +# undef GetWindowPort +#endif + +#undef PARALLEL +#undef SIMULATE +#undef COMMUNICATION + +#include "mcon.h" +#ifdef COMMUNICATION +# include "mcom.h" +#endif + +#ifdef G_POWER +void first_function (void) +{ +} +#endif + +extern void *abc_main(); + +extern void add_IO_time(),add_execute_time(); + +#define CONSOLE_WINDOW_ID 128 +#define ERROR_WINDOW_ID 129 + +static int cur_y,cur_x; +static int g_cur_x; +static int n_screen_lines; + +static int e_cur_y,e_cur_x; +static int e_g_cur_x; +static int n_e_screen_lines; + +static int char_height,char_ascent,char_descent,char_leading,char_asc_lead; + +#define MAX_N_COLUMNS 160 + +typedef char SCREEN_LINE_CHARS [MAX_N_COLUMNS+1]; +static SCREEN_LINE_CHARS *screen_chars,*e_screen_chars; + +static char *input_buffer; +static int input_buffer_pos,input_buffer_length; + +static WindowPtr c_window,e_window; + +static int error_window_visible; +static int console_window_visible; + +static EventRecord my_event; + +static void update_window (WindowPtr window,SCREEN_LINE_CHARS *chars,int n_lines,int g_cur_x,int cur_y) +{ + int y,screen_y_pos; + GrafPtr old_port; + + BeginUpdate (window); + GetPort(&old_port); + +#ifdef MACOSX + SetPort (GetWindowPort (window)); + { + RgnHandle visible_region; + + visible_region=NewRgn(); + GetPortVisibleRegion (GetWindowPort (window),visible_region); + EraseRgn (visible_region); + DisposeRgn (visible_region); + } +#else + SetPort (window); + EraseRgn (window->visRgn); +#endif + + for (y=0,screen_y_pos=char_asc_lead; yportRect,0,-char_height,erase_region); +#endif + + EraseRgn (erase_region); + DisposeRgn (erase_region); + + BlockMove ((char*)chars[1],(char*)chars,(MAX_N_COLUMNS+1)*(n_lines-1)); + chars[n_lines-1][0]=NEWLINE_CHAR; + +#ifdef FLUSH_PORT_BUFFER + QDFlushPortBuffer (GetWindowPort (window),NULL); +#endif + + add_IO_time(); +} + +static void print_newline() +{ + screen_chars[cur_y][cur_x]=NEWLINE_CHAR; + ++cur_y; + cur_x=0; + g_cur_x=0; + if (cur_y>=n_screen_lines){ + cur_y=n_screen_lines-1; + scroll_window (c_window,screen_chars,n_screen_lines); + } +#ifdef FLUSH_PORT_BUFFER + else + QDFlushPortBuffer (GetWindowPort (c_window),NULL); +#endif + MoveTo (0,MULW(cur_y,char_height)+char_asc_lead); +} + +static void window_print_char (char c) +{ + if (c==NEWLINE_CHAR) + print_newline(); + else { + char *screen_char; + int w; + + w=CharWidth (c); + if (g_cur_x+w>=c_window_width || cur_x+1>=MAX_N_COLUMNS) + print_newline(); + g_cur_x+=w; + + screen_char=&screen_chars[cur_y][cur_x]; + *screen_char=c; + screen_char[1]=NEWLINE_CHAR; + DrawChar (c); + ++cur_x; + } +} + +static void make_error_window_visible () +{ + if (!error_window_visible){ + add_execute_time(); + ShowWindow (e_window); +#ifdef MACOSX + ValidWindowRect (e_window,&e_local_window_rect); +#else + ValidRect (&e_local_window_rect); +#endif + add_IO_time(); + error_window_visible=1; + } +} + +static void make_console_window_visible () +{ + if (!console_window_visible){ + add_execute_time(); + + ShowWindow (c_window); + +#ifdef MACOSX + ValidWindowRect (c_window,&c_local_window_rect); +#else + ValidRect (&c_local_window_rect); +#endif + add_IO_time(); + console_window_visible=1; + } +} + +/* + #ifdef powerc + QDGlobals qd; + #endif +**/ + +#ifndef MACOSX + +#ifdef NO_INIT +extern QDGlobals qd; +#else +QDGlobals qd; +#endif + +#endif + +void w_print_char (char c) +{ + GrafPtr port; + +#ifdef MACOSX + GetPort (&port); + SetPort (GetWindowPort (c_window)); +#else + port=NULL; + if (qd.thePort!=c_window){ + port=qd.thePort; + SetPort (c_window); + } +#endif + + if (!console_window_visible) + make_console_window_visible(); + + window_print_char (c); + +#ifndef MACOSX + if (port!=NULL) +#endif + SetPort (port); +} + +static void w_print_text_without_newlines (char *s,unsigned long length) +{ + unsigned long text_length,n; + + text_length=TextWidth (s,0,length); + if (g_cur_x+text_length=n_e_screen_lines){ + e_cur_y=n_e_screen_lines-1; + scroll_window (e_window,e_screen_chars,n_e_screen_lines); + } +#ifdef FLUSH_PORT_BUFFER + else + QDFlushPortBuffer (GetWindowPort (e_window),NULL); +#endif + MoveTo (0,MULW(e_cur_y,char_height)+char_asc_lead); +} + +static void e_print_char (char c) +{ + if (c==NEWLINE_CHAR) + e_print_newline(); + else { + char *screen_char; + int w; + + w=CharWidth (c); + if (e_g_cur_x+w>=e_window_width || e_cur_x+1>=MAX_N_COLUMNS) + e_print_newline(); + e_g_cur_x+=w; + + screen_char=&e_screen_chars[e_cur_y][e_cur_x]; + *screen_char=c; + screen_char[1]=NEWLINE_CHAR; + DrawChar (c); + ++e_cur_x; + } +} + +void ew_print_char (char c) +{ + GrafPtr port; + +#ifdef MACOSX + GetPort (&port); + SetPort (GetWindowPort (e_window)); +#else + port=NULL; + if (qd.thePort!=e_window){ + port=qd.thePort; + SetPort (e_window); + } +#endif + + if (!error_window_visible) + make_error_window_visible(); + + e_print_char (c); + +#ifndef MACOSX + if (port!=NULL) +#endif + SetPort (port); +} + +static void e_print_text_without_newlines (char *s,unsigned long length) +{ + unsigned long text_length,n; + + text_length=TextWidth (s,0,length); + if (e_g_cur_x+text_lengthwhat==updateEvt){ + if ((WindowPtr)event_p->message==c_window){ + w_remove_cursor(); + update_window (c_window,screen_chars,n_screen_lines,g_cur_x,cur_y); + w_show_cursor(); + } else if ((WindowPtr)event_p->message==e_window) + update_window (e_window,e_screen_chars,n_e_screen_lines,e_g_cur_x,e_cur_y); + } else if (event_p->what==mouseDown){ + WindowPtr window; + + if (FindWindow (event_p->where,&window)==inContent) + select_window (window); + } +} + +static int w_read_char() +{ + add_execute_time(); + + while (1){ +#ifndef MACOSX + SystemTask(); +#endif + if (!GetNextEvent (everyEvent,&my_event)) + continue; + switch (my_event.what){ + case keyDown: + case autoKey: + { + int c; + + c=my_event.message & 0xff; + + add_IO_time(); + + return c; + } + case updateEvt: + case mouseDown: + handle_update_or_mouse_down_event (&my_event); + break; + } + } +} + +static void w_read_line() +{ + int b_cur_x,b_cur_y,n_chars_read,c; + + n_chars_read=0; + b_cur_x=cur_x; + b_cur_y=cur_y; + + do { + w_show_cursor(); + c=w_read_char(); + w_remove_cursor(); + if (c=='\b'){ + if (n_chars_read>0){ + while (cur_x==0){ + int line_length,x,c; + char *screen_line; + + --cur_y; + screen_line=screen_chars[cur_y]; + + line_length=0; + x=0; + while (c=screen_line[line_length],c!=NEWLINE_CHAR){ + ++line_length; + x+=CharWidth (c); + } + cur_x=line_length; + g_cur_x=x; + } + if (cur_x>0){ + int w; + char *screen_char; + + --cur_x; + screen_char=&screen_chars[cur_y][cur_x]; + w=CharWidth (*screen_char); + *screen_char=NEWLINE_CHAR; + g_cur_x-=w; + --n_chars_read; + w_remove_char (w); + } + } + } else { + if (c==NEWLINE_CHAR){ + if (cur_y+10){ + --b_cur_y; + print_newline(); + } + } else { + char *screen_char; + int w; + + w=CharWidth (c); + if (g_cur_x+w>=c_window_width || cur_x+1>=MAX_N_COLUMNS) + if (cur_y+10){ + --b_cur_y; + print_newline(); + } else + continue; + g_cur_x+=w; + + screen_char=&screen_chars[cur_y][cur_x]; + *screen_char=c; + screen_char[1]=NEWLINE_CHAR; + DrawChar (c); + ++cur_x; + ++n_chars_read; + } + } + } while (c!=NEWLINE_CHAR); + + { + char *char_p,*screen_p; + + input_buffer_length=n_chars_read+1; + input_buffer_pos=0; + + char_p=input_buffer; + screen_p=&screen_chars[b_cur_y][b_cur_x]; + while (n_chars_read!=0){ + int c; + + while (c=*screen_p++,c==NEWLINE_CHAR){ + ++b_cur_y; + screen_p=screen_chars[b_cur_y]; + } + *char_p++=c; + --n_chars_read; + } + *char_p++=NEWLINE_CHAR; + } +} + +int w_get_char() +{ + int c; + + if (input_buffer_length==0){ + GrafPtr port; + +#ifdef MACOSX + GetPort (&port); + SetPort (GetWindowPort (c_window)); +#else + port=NULL; + if (qd.thePort!=c_window){ + port=qd.thePort; + SetPort (c_window); + } +#endif + + if (!console_window_visible) + make_console_window_visible(); + + w_read_line(); + +#ifndef MACOSX + if (port!=NULL) +#endif + SetPort (port); + } + + c=input_buffer[input_buffer_pos] & 0xff; + ++input_buffer_pos; + --input_buffer_length; + + return c; +} + +#define is_digit(n) ((unsigned)((n)-'0')<(unsigned)10) + +int w_get_int (int *i_p) +{ + int c,negative; + unsigned int i; + + c=w_get_char(); + while (c==' ' || c=='\t' || c==NEWLINE_CHAR) + c=w_get_char(); + + negative=0; + if (c=='+') + c=w_get_char(); + else + if (c=='-'){ + c=w_get_char(); + negative=1; + } + + if (!is_digit (c)){ + --input_buffer_pos; + ++input_buffer_length; + + *i_p=0; + return 0; + } + + i=c-'0'; + while (c=w_get_char(),is_digit (c)){ + i+=i<<2; + i+=i; + i+=c-'0'; + }; + + if (negative) + i=-i; + + --input_buffer_pos; + ++input_buffer_length; + + *i_p=i; + return -1; +} + +int w_get_real (double *r_p) +{ + char s[256+1]; + int c,dot,digits,result,n; + + n=0; + + c=w_get_char(); + while (c==' ' || c=='\t' || c==NEWLINE_CHAR) + c=w_get_char(); + + if (c=='+') + c=w_get_char(); + else + if (c=='-'){ + s[n++]=c; + c=w_get_char(); + } + + dot=0; + digits=0; + + while (is_digit (c) || c=='.'){ + if (c=='.'){ + if (dot){ + dot=2; + break; + } + dot=1; + } else + digits=-1; + if (n<256) + s[n++]=c; + c=w_get_char(); + } + + result=0; + if (digits) + if (dot==2 || ! (c=='e' || c=='E')) + result=-1; + else { + if (n<256) + s[n++]=c; + c=w_get_char(); + + if (c=='+') + c=w_get_char(); + else + if (c=='-'){ + if (n<256) + s[n++]=c; + c=w_get_char(); + } + + if (is_digit (c)){ + do { + if (n<256) + s[n++]=c; + c=w_get_char(); + } while (is_digit (c)); + + result=-1; + } + } + + if (n>=256) + result=0; + + --input_buffer_pos; + ++input_buffer_length; + + *r_p=0.0; + + if (result){ + s[n]='\0'; + +#if !defined (G_POWER) + result=convert_string_to_real (s,r_p); +#else + if (sscanf (s,"%lg",r_p)!=1) + result=0; +#endif + } + + return result; +} + +unsigned long w_get_text (char *string,unsigned long max_length) +{ + unsigned long length,l; + char *sp,*dp; + GrafPtr port; + +#ifdef MACOSX + GetPort (&port); + SetPort (GetWindowPort (c_window)); +#else + port=NULL; + if (qd.thePort!=c_window){ + port=qd.thePort; + SetPort (c_window); + } +#endif + + if (!console_window_visible) + make_console_window_visible(); + + if (input_buffer_length==0) + w_read_line(); + length=input_buffer_length; + if (length>max_length) + length=max_length; + + for (l=length,sp=&input_buffer[input_buffer_pos],dp=string; l!=0; --l) + *dp++=*sp++; + + input_buffer_pos+=length; + input_buffer_length-=length; + +#ifndef MACOSX + if (port!=NULL) +#endif + SetPort (port); + + return length; +} + +void w_print_string (char *s) +{ + char *end_s,c; + GrafPtr port; + +#ifdef MACOSX + GetPort (&port); + SetPort (GetWindowPort (c_window)); +#else + port=NULL; + if (qd.thePort!=c_window){ + port=qd.thePort; + SetPort (c_window); + } +#endif + + if (!console_window_visible) + make_console_window_visible(); + + end_s=s; + while (*s!='\0'){ + while (c=*end_s,c!='\0' && c!=NEWLINE_CHAR) + ++end_s; + w_print_text_without_newlines (s,end_s-s); + if (*end_s=='\0') + break; + print_newline(); + s=++end_s; + } + +#ifndef MACOSX + if (port!=NULL) +#endif + SetPort (port); +} + +void ew_print_string (char *s) +{ + char *end_s,c; + GrafPtr port; + +#ifdef MACOSX + GetPort (&port); + SetPort (GetWindowPort (e_window)); +#else + port=NULL; + if (qd.thePort!=e_window){ + port=qd.thePort; + SetPort (e_window); + } +#endif + + if (!error_window_visible) + make_error_window_visible(); + + end_s=s; + while (*s!='\0'){ + while (c=*end_s,c!='\0' && c!=NEWLINE_CHAR) + ++end_s; + e_print_text_without_newlines (s,end_s-s); + if (*end_s=='\0') + break; + e_print_newline(); + s=++end_s; + } + +#ifndef MACOSX + if (port!=NULL) +#endif + SetPort (port); +} + +#if !defined (G_POWER) +extern char *convert_int_to_string (char *string,int i); +extern char *convert_real_to_string (char *string,double *r_p); +extern int convert_string_to_real (char *string,double *r_p); +#endif + +void w_print_int (int n) +{ + char int_string [32]; + GrafPtr port; + +#ifdef MACOSX + GetPort (&port); + SetPort (GetWindowPort (c_window)); +#else + port=NULL; + if (qd.thePort!=c_window){ + port=qd.thePort; + SetPort (c_window); + } +#endif + + if (!console_window_visible) + make_console_window_visible(); + +#if !defined (G_POWER) + { + char *end_p; + + end_p=convert_int_to_string (int_string,n); + w_print_text_without_newlines (int_string,end_p-int_string); + } +#else + sprintf (int_string,"%d",n); + { + int string_length; + char *p; + + string_length=0; + for (p=int_string; *p; ++p) + ++string_length; + + w_print_text_without_newlines (int_string,string_length); + } +#endif + +#ifndef MACOSX + if (port!=NULL) +#endif + SetPort (port); +} + +void ew_print_int (int n) +{ + char int_string [32]; + GrafPtr port; + +#ifdef MACOSX + GetPort (&port); + SetPort (GetWindowPort (e_window)); +#else + port=NULL; + if (qd.thePort!=e_window){ + port=qd.thePort; + SetPort (e_window); + } +#endif + + if (!error_window_visible) + make_error_window_visible(); + +#if !defined (G_POWER) + { + char *end_p; + + end_p=convert_int_to_string (int_string,n); + e_print_text_without_newlines (int_string,end_p-int_string); + } +#else + sprintf (int_string,"%d",n); + { + int string_length; + char *p; + + string_length=0; + for (p=int_string; *p; ++p) + ++string_length; + + e_print_text_without_newlines (int_string,string_length); + } +#endif + +#ifndef MACOSX + if (port!=NULL) +#endif + SetPort (port); +} + +void w_print_real (double r) +{ + char real_string [40]; + GrafPtr port; + +#ifdef MACOSX + GetPort (&port); + SetPort (GetWindowPort (c_window)); +#else + port=NULL; + if (qd.thePort!=c_window){ + port=qd.thePort; + SetPort (c_window); + } +#endif + + if (!console_window_visible) + make_console_window_visible(); + +#if !defined (G_POWER) + { + char *end_p; + + end_p=convert_real_to_string (real_string,&r); + w_print_text_without_newlines (real_string,end_p-real_string); + } +#else + sprintf (real_string,"%.15g",r); + { + int string_length; + char *p; + + string_length=0; + for (p=real_string; *p; ++p) + ++string_length; + + w_print_text_without_newlines (real_string,string_length); + } +#endif + +#ifndef MACOSX + if (port!=NULL) +#endif + SetPort (port); +} + +void ew_print_real (double r) +{ + char real_string [40]; + GrafPtr port; + +#ifdef MACOSX + GetPort (&port); + SetPort (GetWindowPort (e_window)); +#else + port=NULL; + if (qd.thePort!=e_window){ + port=qd.thePort; + SetPort (e_window); + } +#endif + + if (!error_window_visible) + make_error_window_visible(); + +#if !defined (G_POWER) + { + char *end_p; + + end_p=convert_real_to_string (real_string,&r); + e_print_text_without_newlines (real_string,end_p-real_string); + } +#else + sprintf (real_string,"%.15g",r); + { + int string_length; + char *p; + + string_length=0; + for (p=real_string; *p; ++p) + ++string_length; + + e_print_text_without_newlines (real_string,string_length); + } +#endif + +#ifndef MACOSX + if (port!=NULL) +#endif + SetPort (port); +} + +static FontInfo font_info; +static short font_id,font_size; + +long stack_size,heap_size,flags; +#ifdef WRITE_HEAP +long min_write_heap_size=0; +#endif; +#ifdef G_POWER +long heap_size_multiple; +long initial_heap_size; +#endif + +static int init_terminal() +{ + int n; + int screen_top,screen_left,screen_bottom,screen_right; + int screen_width,screen_height,left_right_free,top_bottom_free; + + int three,ten; + +#ifndef NO_INIT +# ifndef MACOSX + InitGraf (&qd.thePort); + InitFonts(); +# endif + FlushEvents (everyEvent,0); +# ifndef MACOSX + InitWindows(); +# endif + InitCursor(); +# ifndef MACOSX + InitMenus(); +# endif +#endif + + three=3; ten=10; /* to get a divw instead of a divl */ + +#ifdef MACOSX + { + BitMap bit_map; + + GetQDGlobalsScreenBits (&bit_map); + + screen_top=bit_map.bounds.top; + screen_left=bit_map.bounds.left; + screen_bottom=bit_map.bounds.bottom; + screen_right=bit_map.bounds.right; + } +#else + screen_top=qd.thePort->portRect.top; + screen_left=qd.thePort->portRect.left; + screen_bottom=qd.thePort->portRect.bottom; + screen_right=qd.thePort->portRect.right; +#endif + + screen_top+=15; /* menu bar height */ + + screen_width=screen_right-screen_left+1; + screen_height=screen_bottom-screen_top+1; + + left_right_free=UDIVW (screen_width>>2,three); /* /12 */ + top_bottom_free=12; + + c_window_rect.left=screen_left+left_right_free; + c_window_rect.right=screen_right-left_right_free; + + c_window_rect.top=screen_top+20+top_bottom_free; + c_window_rect.bottom=screen_top+UDIVW (screen_height*7,ten)-6; + + c_local_window_rect.left=0; + c_local_window_rect.right=c_window_rect.right-c_window_rect.left; + + c_local_window_rect.top=0; + c_local_window_rect.bottom=c_window_rect.bottom-c_window_rect.top; + + e_window_rect.left=screen_left+left_right_free; + e_window_rect.right=screen_right-left_right_free; + + e_window_rect.top=screen_top+20+UDIVW (screen_height*7,ten)+6; + e_window_rect.bottom=screen_bottom-top_bottom_free; + + e_local_window_rect.left=0; + e_local_window_rect.right=e_window_rect.right-e_window_rect.left; + + e_local_window_rect.top=0; + e_local_window_rect.bottom=e_window_rect.bottom-e_window_rect.top; + + c_window_width=c_window_rect.right-c_window_rect.left+1; + c_window_height=c_window_rect.bottom-c_window_rect.top+1; + + e_window_width=c_window_rect.right-e_window_rect.left+1; + e_window_height=e_window_rect.bottom-e_window_rect.top+1; + + error_window_visible=0; + + console_window_visible=flags & 16 ? 0 : 1; + + c_window=NewWindow (NULL,&c_window_rect,"\pConsole",console_window_visible,0,(WindowPtr)-1,0,CONSOLE_WINDOW_ID); + if (c_window==NULL) + return 0; + + e_window=NewWindow (NULL,&e_window_rect,"\pMessages",0,0,(WindowPtr)-1,0,ERROR_WINDOW_ID); + if (e_window==NULL) + return 0; + +#ifdef MACOSX + SetPort (GetWindowPort (e_window)); +#else + SetPort (e_window); +#endif + TextFont (font_id); + TextSize (font_size); + + GetFontInfo (&font_info); + char_ascent=font_info.ascent; + char_descent=font_info.descent; + char_leading=font_info.leading; + char_asc_lead=char_ascent+char_leading; + char_height=char_asc_lead+char_descent; + + e_cur_y=0; + e_cur_x=0; + e_g_cur_x=0; + n_e_screen_lines=UDIVW (e_window_height,char_height); + + MoveTo (0,char_asc_lead); + +#ifdef MACOSX + SetPort (GetWindowPort (c_window)); +#else + SetPort (c_window); +#endif + + TextFont (font_id); + TextSize (font_size); + + cur_y=0; + cur_x=0; + g_cur_x=0; + n_screen_lines=UDIVW (c_window_height,char_height); + + MoveTo (0,char_asc_lead); + + if (console_window_visible){ + SelectWindow (c_window); +#ifdef MACOSX + ValidWindowRect (c_window,&c_local_window_rect); +#else + ValidRect (&c_local_window_rect); +#endif +} + + screen_chars=(SCREEN_LINE_CHARS*) NewPtr (n_screen_lines * (MAX_N_COLUMNS+1)); + if (screen_chars==NULL) + return 0; + + for (n=0; n + +#ifndef powerc +#pragma parameter __D0 MySysEnvirons (__D0, __A0) +extern pascal OSErr MySysEnvirons(short versionRequested, SysEnvRec *theWorld) + ONEWORDINLINE(0xA090); +#else +#define MySysEnvirons SysEnvirons +#endif + +#define MINIMUM_HEAP_SIZE_MULTIPLE ((2*256)+128) +#define MAXIMUM_HEAP_SIZE_MULTIPLE (100*256) + +void (*exit_tcpip_function) (void); +#ifndef MACHO +extern void my_pointer_glue (void (*function) (void)); +#endif + +int execution_aborted; + +int main (void) +{ + Handle stack_handle,font_handle; +#ifdef WRITE_HEAP + Handle profile_handle; +#endif + long *stack_p; + + exit_tcpip_function=NULL; + execution_aborted=0; + +#ifdef WRITE_HEAP + profile_handle=GetResource ('PRFL',128); + if (profile_handle!=NULL && *profile_handle!=NULL) + min_write_heap_size=**(long**)profile_handle; +#endif + +#ifdef G_POWER + stack_handle=GetResource ('STHP',0); +#else + stack_handle=GetResource ('STCK',0); +#endif + stack_p=*(long**)stack_handle; + + stack_size=(stack_p[0]+3) & ~3; + heap_size=(stack_p[2]+7) & ~7; + flags=stack_p[3]; + +#ifdef SIMULATE + n_processors=stack_p[1]; + if (n_processors<1) + n_processors=1; + if (n_processors>1024) + n_processors=1024; +#else +# ifdef G_POWER + heap_size_multiple=stack_p[1]; + if (heap_size_multipleMAXIMUM_HEAP_SIZE_MULTIPLE) + heap_size_multiple=MAXIMUM_HEAP_SIZE_MULTIPLE; + initial_heap_size=(stack_p[4]+7) & ~7; +# endif +#endif + +#ifndef MACOSX +# ifndef PARALLEL + SetApplLimit (GetApplLimit()-stack_size-1024); +# else + SetApplLimit (GetApplLimit()-heap_size-stack_size-1024); +# endif + if (MemError()!=0) + return 0; +#endif + +#ifdef PARALLEL + load_code_segments(); +#endif + + font_id=-1; + + font_handle=GetResource ('Font',128); + if (font_handle!=NULL){ + get_font_number ((char*)((*(short **)font_handle)+1)); + font_size=**(short**)font_handle; + } + + if (font_id==-1){ +#ifdef NEW_HEADERS + font_id=kFontIDMonaco; +#else + font_id=monaco; +#endif + font_size=9; + } + + if (!init_terminal()) + return 1; + +/* srand (TickCount()); */ + +#ifdef G_POWER + wait_next_event_available=1; +#else +# ifdef powerc + if (NGetTrapAddress (0xA860,ToolTrap)!=GetTrapAddress (0xA89F)) +# else + if (GetToolTrapAddress (0xA860)!=GetTrapAddress (0xA89F)) +# endif + wait_next_event_available=-1; + else + wait_next_event_available=0; +#endif + +#ifndef MACOSX + if (MySysEnvirons (1,&system_environment)==noErr){ +# ifndef G_POWER + switch (target_processor){ + case 2: + if (system_environment.processor==env68000 || + system_environment.processor==env68010 || + system_environment.hasFPU==0) + { + ew_print_string ("This program requires a MC68020 processor with MC68881 coprocessor or better\n"); + + wait_for_key_press(); + exit_terminal(); + return 0; + } + break; + case 1: + if (system_environment.processor==env68000 || + system_environment.processor==env68010) + { + ew_print_string ("This program requires a MC68020 processor or better\n"); + + wait_for_key_press(); + exit_terminal(); + return 0; + } + } +# endif + } +#endif + +#ifdef SIMULATE + processor_table_size=n_processors*64; + processor_table=(int) NewPtr (processor_table_size); + end_processor_table=processor_table+processor_table_size; +#endif + +#ifdef COMMUNICATION + if (init_communication()) +#endif + + abc_main(); + +#ifdef COMMUNICATION + exit_communication(); +#endif + + if (exit_tcpip_function!=NULL) +#ifdef MACHO + exit_tcpip_function(); +#else + my_pointer_glue (exit_tcpip_function); +#endif + + if (!(flags & 16) || (flags & 8) || execution_aborted!=0){ +#ifdef COMMUNICATION + if (my_processor_id==0) +#endif + wait_for_key_press(); + } + exit_terminal(); + +#ifdef G_POWER + first_function(); +#endif + + return 0; +} + +#ifdef TIME_PROFILE +void create_profile_file_name (unsigned char *profile_file_name) +{ + unsigned char *cur_ap_name,*end_profile_file_name; + int cur_ap_name_length,profile_file_name_length,n; + + cur_ap_name=(unsigned char *)LMGetCurApName(); + cur_ap_name_length=cur_ap_name[0]; + ++cur_ap_name; + + for (n=0; n31) + profile_file_name_length=31; + + *((unsigned int*)&profile_file_name[4])=profile_file_name_length; + + end_profile_file_name=&profile_file_name[8+profile_file_name_length]; + + end_profile_file_name[-13]=' '; + end_profile_file_name[-12]='T'; + end_profile_file_name[-11]='i'; + end_profile_file_name[-10]='m'; + end_profile_file_name[-9]='e'; + end_profile_file_name[-8]=' '; + end_profile_file_name[-7]='P'; + end_profile_file_name[-6]='r'; + end_profile_file_name[-5]='o'; + end_profile_file_name[-4]='f'; + end_profile_file_name[-3]='i'; + end_profile_file_name[-2]='l'; + end_profile_file_name[-1]='e'; +} +#endif + +#if defined(G_POWER) +static void my_user_item_proc (DialogPtr dialog_p,int the_item) +{ + short item_type; + Handle item_handle; + Rect item_rect; + PenState pen_state; + + GetDialogItem (dialog_p,the_item,&item_type,&item_handle,&item_rect); + + GetPenState (&pen_state); + PenNormal(); + PenSize (3,3); + InsetRect (&item_rect,-4,-4); + FrameRoundRect (&item_rect,16,16); + SetPenState (&pen_state); +} + +#if defined (MACOSX) && !defined (NEW_HEADERS) +extern UserItemUPP NewUserItemUPP (ProcPtr); +#endif + +#ifdef NEW_HEADERS +int +#else +UserItemUPP +#endif + myoutlinebuttonfunction (void) +{ +#ifdef MACOSX + return NewUserItemUPP (my_user_item_proc); +#else + return NewUserItemProc (my_user_item_proc); +#endif +} + +#ifndef NEW_HEADERS +QDGlobals *qdglobals (void) +{ + return &qd; +} +#endif + +#endif diff --git a/mcon.h b/mcon.h new file mode 100644 index 0000000..1a17c38 --- /dev/null +++ b/mcon.h @@ -0,0 +1,16 @@ +extern int w_get_char(); +extern int w_get_int (int *i_p); +extern int w_get_real (double *r_p); +extern unsigned long w_get_text (char *string,unsigned long max_length); +extern void w_print_char (char c); +extern void w_print_int (int i); +extern void w_print_real (double r); +extern void w_print_string (char *s); +extern void w_print_text (char *s,unsigned long length); +extern void ew_print_char (char c); +extern void ew_print_int (int i); +extern void ew_print_real (double r); +extern void ew_print_string (char *s); +extern void ew_print_text (char *s,unsigned long length); +extern void init_fileIO(); +extern void exit_fileIO(); diff --git a/mfileIO3.c b/mfileIO3.c new file mode 100644 index 0000000..413469e --- /dev/null +++ b/mfileIO3.c @@ -0,0 +1,2718 @@ +/* + File: mfileIO3.c + Written by: John van Groningen + At: University of Nijmegen +*/ + +#define MAC + +#if defined(powerc) || defined (MACHO) +# define USE_CLIB 1 +#else +# define USE_CLIB 0 +#endif + +#define NEWLINE_CHAR '\015' + +#include "mcon.h" + +extern void IO_error (char*); + +#ifndef MACHO +# include +#endif +#include +#include +#include +#include + +#define EOF (-1) + +#define MAX_N_FILES 20 + +#define MAX_FILE_NAME_LENGTH 255 + +#define FIRST_REAL_FILE 4 + +#define F_SEEK_SET 0 +#define F_SEEK_CUR 1 +#define F_SEEK_END 2 + +#define pb_RefNum (((HIOParam*)&pb)->ioRefNum) +#define pb_Permssn (((HIOParam*)&pb)->ioPermssn) +#define pb_Misc (((HIOParam*)&pb)->ioMisc) +#define pb_PosMode (((HIOParam*)&pb)->ioPosMode) +#define pb_PosOffset (((HIOParam*)&pb)->ioPosOffset) +#define pb_Buffer (((HIOParam*)&pb)->ioBuffer) +#define pb_NamePtr (((HIOParam*)&pb)->ioNamePtr) +#define pb_VRefNum (((HIOParam*)&pb)->ioVRefNum) +#define pb_DirID (((HFileParam*)&pb)->ioDirID) +#define pb_FDirIndex (((HFileParam*)&pb)->ioFDirIndex) +#define pb_FlFndrInfo (((HFileParam*)&pb)->ioFlFndrInfo) +#define pb_ReqCount (((HIOParam*)&pb)->ioReqCount) +#define pb_ActCount (((HIOParam*)&pb)->ioActCount) + +struct file { /* 48 bytes */ + unsigned char * file_read_p; /* offset 0 */ + unsigned char * file_write_p; /* offset 4 */ + unsigned char * file_end_buffer_p; /* offset 8 */ + unsigned short file_mode; /* offset 12 */ + char file_unique; /* offset 14 */ + char file_error; /* offset 15 */ + + unsigned char * file_buffer_p; + + unsigned long file_offset; + unsigned long file_length; + + char * file_name; + long file_number; + unsigned long file_position; + unsigned long file_position_2; + + short file_refnum; + short file_volume_number; +}; + +struct clean_string { + long length; +#if (defined (powerc) && !defined (__MRC__)) || defined (MACHO) + char characters[0]; +#else + char characters[]; +#endif +}; + +#ifdef MAC +#define allocate_memory NewPtr +#define free_memory DisposePtr +#else +#define allocate_memory malloc +#define free_memory free +#endif + +static struct file file_table[MAX_N_FILES]; + +static int number_of_files=FIRST_REAL_FILE; + +#define is_special_file(f) ((long)(f)<(long)(&file_table[3])) + +static char *clean_to_c_string (struct clean_string *cs) +{ + int l; + char *cp,*s; + + cp=cs->characters; + l=cs->length; + + s=allocate_memory (l+1); + + if (s!=NULL){ + register char *sp; + + for (sp=s; l!=0; --l) + *sp++=*cp++; + *sp='\0'; + } + + return s; +} + +static void copy_c_to_p_string (unsigned char *ps,char *cs,int max_length) +{ + unsigned char *p,*max_p; + char c; + + p=ps+1; + + max_p=p+max_length; + + while ((c=*cs++)!=0){ + if (p>=max_p){ + *ps=0; + return; + } + *p++ = c; + } + + *ps=p-(ps+1); +} + +static int get_file_number (char *file_name,long *file_number_p) +{ + unsigned char file_name_s[MAX_FILE_NAME_LENGTH+1]; + HFileParam fileParam; + + copy_c_to_p_string (file_name_s,file_name,MAX_FILE_NAME_LENGTH); + if (file_name_s[0]==0) + return 0; + + fileParam.ioFDirIndex=0; + fileParam.ioNamePtr=file_name_s; + fileParam.ioVRefNum=0; + fileParam.ioFDirIndex=-1; + fileParam.ioDirID=0; + + if (PBHGetFInfoSync ((HParmBlkPtr)&fileParam)!=noErr) + return 0; + + *file_number_p= fileParam.ioDirID; + return 1; +} + +static int get_volume_number (char *file_name,short *volume_number_p) +{ + HVolumeParam volumeParam; + unsigned char file_name_s[MAX_FILE_NAME_LENGTH+1]; + + copy_c_to_p_string (file_name_s,file_name,MAX_FILE_NAME_LENGTH); + if (*file_name_s==0) + return 0; + + volumeParam.ioVolIndex=-1; + volumeParam.ioNamePtr=file_name_s; + volumeParam.ioVRefNum=0; + + if (PBHGetVInfoSync ((HParmBlkPtr)&volumeParam)!=noErr) + return 0; + + *volume_number_p=volumeParam.ioVRefNum; + return 1; +} + +static int file_exists (char *file_name,long *file_number_p,short *volume_number_p) +{ + int n; + + *volume_number_p=0; + + if (!get_file_number (file_name,file_number_p)) + return -2; + + if (!get_volume_number (file_name,volume_number_p)) + IO_error ("can't determine volume number while opening file"); + + for (n=FIRST_REAL_FILE; n65535) + buffer_mask=65535; + else { + buffer_mask |= buffer_mask>>8; + buffer_mask |= buffer_mask>>4; + buffer_mask |= buffer_mask>>2; + buffer_mask |= buffer_mask>>1; + buffer_mask = (buffer_mask>>1) | 4095; + } + + file_mode &= 255; + + if (file_mode>5) + IO_error ("fopen: invalid file mode"); + + file_name_s=clean_to_c_string (file_name); + if (file_name_s==NULL){ + IO_error ("fopen: out of memory"); + return ERROR_FILE; + } + + existing_fn=file_exists (file_name_s,&file_number,&volume_number); + + if (existing_fn>=0){ + free_memory (file_name_s); + return ERROR_FILE; +/* IO_error ("fopen: file already open"); */ + } + + fn=number_of_files; + if (fn>=MAX_N_FILES){ + for (fn=FIRST_REAL_FILE; fn=MAX_N_FILES){ + free_memory (file_name_s); + IO_error ("fopen: too many files"); + } + } + + f=&file_table[fn]; + + f->file_number=file_number; + f->file_volume_number=volume_number; + + copy_c_to_p_string (p_file_name,file_name_s,MAX_FILE_NAME_LENGTH); + + if (existing_fn==-2 && ((1<file_buffer_p=buffer; + f->file_end_buffer_p=buffer; + f->file_read_p=buffer; + f->file_write_p=buffer; + + f->file_offset=0; + + switch (file_mode){ + case F_WRITE_TEXT: + case F_WRITE_DATA: + pb_RefNum=file_refnum; + pb_Misc=(Ptr)0; + + error=PBSetEOFSync ((ParmBlkPtr)&pb); + + if (error!=noErr){ + free_memory (file_name_s); + free_memory (buffer); + pb_RefNum=file_refnum; + PBCloseSync ((ParmBlkPtr)&pb); + IO_error ("fopen: can't set eof"); + } + + file_length=0; + break; + case F_APPEND_TEXT: + case F_APPEND_DATA: + pb_RefNum=file_refnum; + pb_PosMode=fsFromLEOF; + pb_PosOffset=0; + + error=PBSetFPosSync ((ParmBlkPtr)&pb); + + if (error!=noErr){ + free_memory (file_name_s); + free_memory (buffer); + pb_RefNum=file_refnum; + PBCloseSync ((ParmBlkPtr)&pb); + IO_error ("fopen: can't seek to eof"); + } + + file_length=pb_PosOffset; + f->file_offset=file_length; + + break; + default: + pb_RefNum=file_refnum; + + error=PBGetEOFSync ((ParmBlkPtr)&pb); + + file_length=(long)pb_Misc; + + if (error!=noErr){ + free_memory (file_name_s); + free_memory (buffer); + pb_RefNum=file_refnum; + PBCloseSync ((ParmBlkPtr)&pb); + IO_error ("fopen: can't get eof"); + } + } + + f->file_mode=(1<file_unique=1; + f->file_error=0; + + f->file_name=file_name_s; + f->file_length=file_length; + f->file_position=-2; + f->file_position_2=-1; + f->file_refnum=file_refnum; + + if (fn>=number_of_files) + number_of_files=fn+1; + + return f; +} + +static int stdio_open=0; + +struct file *open_stdio (void) +{ + if (stdio_open) + IO_error ("stdio: already open"); + + stdio_open=1; + return &file_table[1]; +} + +static int open_stderr_file_failed=0; + +static int open_stderr_file (void) +{ + unsigned char p_file_name[MAX_FILE_NAME_LENGTH+1]; + char *file_name_s; + int existing_fn; + struct file *f; + long file_length; + long file_number; + unsigned char *buffer; + short file_refnum,volume_number; + OSErr error; + unsigned int file_mode; + HParamBlockRec pb; + + file_name_s="Messages"; + + file_mode=F_WRITE_TEXT; + + if (!get_file_number (file_name_s,&file_number)) + existing_fn=-2; + else { + if (!get_volume_number (file_name_s,&volume_number)) + IO_error ("can't determine volume number while opening file"); + + existing_fn=-1; + } + + f=&file_table[3]; + f->file_number=file_number; + f->file_volume_number=volume_number; + + copy_c_to_p_string (p_file_name,file_name_s,MAX_FILE_NAME_LENGTH); + + if (existing_fn==-2){ + pb_NamePtr=p_file_name; + pb_VRefNum=0; + pb_DirID=0; + + error=PBHCreateSync ((void*)&pb); + if (error!=noErr){ + open_stderr_file_failed=1; + return 0; + } + + pb_VRefNum=0; + pb_DirID=0; + pb_FDirIndex=0; + + if (PBHGetFInfoSync ((void*)&pb)==noErr){ + pb_VRefNum=0; + pb_DirID=0; + pb_FlFndrInfo.fdCreator=new_file_creator; + pb_FlFndrInfo.fdType='TEXT'; + PBHSetFInfoSync ((void*)&pb); + } + } + + pb_NamePtr=p_file_name; + pb_VRefNum=0; + pb_DirID=0; + pb_Misc=(Ptr)0; + pb_Permssn=file_permission[file_mode]; + + error=PBHOpenSync ((void*)&pb); + if (error!=noErr){ + open_stderr_file_failed=1; + return 0; + } + + file_refnum=pb_RefNum; + + buffer=allocate_memory (4096); + if (buffer==NULL){ + pb_RefNum=file_refnum; + PBCloseSync ((ParmBlkPtr)&pb); + IO_error ("fopen: out of memory"); + } + + f->file_buffer_p=buffer; + f->file_end_buffer_p=buffer; + f->file_read_p=buffer; + f->file_write_p=buffer; + f->file_offset=0; + + pb_RefNum=file_refnum; + pb_Misc=(Ptr)0; + + error=PBSetEOFSync ((ParmBlkPtr)&pb); + + if (error!=noErr){ + free_memory (buffer); + pb_RefNum=file_refnum; + PBCloseSync ((ParmBlkPtr)&pb); + IO_error ("fopen: can't set eof"); + } + + file_length=0; + + f->file_mode=(1<file_unique=1; + f->file_error=0; + + f->file_name=file_name_s; + f->file_length=file_length; + f->file_position=-2; + f->file_position_2=-1; + f->file_refnum=file_refnum; + + return 1; +} + +extern long flags; + +struct file *open_stderr (void) +{ + if ((flags & 128) && file_table[3].file_mode==0 && !open_stderr_file_failed) + open_stderr_file(); + + return file_table; +} + +static int flush_write_buffer (struct file *f) +{ + if (f->file_mode & ((1<file_buffer_p; + if (buffer!=f->file_end_buffer_p){ + OSErr error; + long count; + + count=f->file_write_p-buffer; + + if (count==0) + error=0; + else { + HParamBlockRec pb; + + pb_RefNum=f->file_refnum; + pb_Buffer=buffer; + pb_ReqCount=count; + + pb_PosMode=fsAtMark; + pb_PosOffset=0; + + error=PBWriteSync ((ParmBlkPtr)&pb); + + count=pb_ActCount; + + f->file_offset = pb_PosOffset; + } + + if (f->file_offset > f->file_length) + f->file_length=f->file_offset; + + f->file_end_buffer_p=buffer; + f->file_read_p=buffer; + + if (error!=noErr || count!=f->file_write_p-buffer){ + f->file_write_p=buffer; + f->file_error=-1; + return 0; + } + + f->file_write_p=buffer; + } + } + + return 1; +} + +int close_file (struct file *f) +{ + if (is_special_file (f)){ + if (f==&file_table[1]){ + if (!stdio_open) + IO_error ("fclose: file not open (stdio)"); + stdio_open=0; + } + return -1; + } else { + HParamBlockRec pb; + int result; + + if (f->file_mode==0) + IO_error ("fclose: file not open"); + + result=-1; + + if (f->file_error) + result=0; + + if (! flush_write_buffer (f)) + result=0; + + pb_RefNum=f->file_refnum; + if (PBCloseSync ((ParmBlkPtr)&pb)!=0) + result=0; + + free_memory (f->file_name); + free_memory (f->file_buffer_p); + + f->file_mode=0; + + return result; + } +} + +void close_stderr_file (void) +{ + if ((flags & 128) && file_table[3].file_mode!=0){ + HParamBlockRec pb; + struct file *f; + + f=&file_table[3]; + + flush_write_buffer (f); + + pb_RefNum=f->file_refnum; + PBCloseSync ((ParmBlkPtr)&pb); + + free_memory (f->file_buffer_p); + + f->file_mode=0; + } +} + +int re_open_file (struct file *f,unsigned int file_mode) +{ + HParamBlockRec pb; + unsigned int buffer_mask; + + buffer_mask = file_mode & ~255; + if (buffer_mask<8192) + buffer_mask=4095; + else if (buffer_mask>65535) + buffer_mask=65535; + else { + buffer_mask |= buffer_mask>>8; + buffer_mask |= buffer_mask>>4; + buffer_mask |= buffer_mask>>2; + buffer_mask |= buffer_mask>>1; + buffer_mask = (buffer_mask>>1) | 4095; + } + + file_mode &= 255; + + if (file_mode>5) + IO_error ("freopen: invalid file mode"); + + if (is_special_file (f)){ + if (f==file_table && (file_mode==F_READ_TEXT || file_mode==F_READ_DATA)) + IO_error ("freopen: stderr can't be opened for reading"); + if (f==&file_table[2]) + IO_error ("freopen: file not open"); + return -1; + } else { + long file_length; + unsigned char p_file_name[MAX_FILE_NAME_LENGTH+1]; + int result; + unsigned char *buffer; + short file_refnum; + OSErr error; + + result=-1; + + if (f->file_mode!=0){ + flush_write_buffer (f); + + pb_RefNum=f->file_refnum; + PBCloseSync ((ParmBlkPtr)&pb); + + if ((f->file_mode | 255)!=buffer_mask){ + free_memory (f->file_buffer_p); + + buffer=allocate_memory (buffer_mask+1); + if (buffer==NULL) + IO_error ("freopen: out of memory"); + f->file_buffer_p=buffer; + } + } else { + buffer=allocate_memory (buffer_mask+1); + if (buffer==NULL) + IO_error ("freopen: out of memory"); + f->file_buffer_p=buffer; + } + + f->file_mode=0; + + copy_c_to_p_string (p_file_name,f->file_name,MAX_FILE_NAME_LENGTH); + + pb_NamePtr=p_file_name; + pb_VRefNum=0; + pb_DirID=0; + pb_Misc=(Ptr)0; + pb_Permssn=file_permission[file_mode]; + + error=PBHOpenSync ((void*)&pb); + if (error!=noErr){ + free_memory (f->file_name); + free_memory (f->file_buffer_p); + return 0; + } + + file_refnum=pb_RefNum; + + f->file_offset=0; + + switch (file_mode){ + case F_WRITE_TEXT: + case F_WRITE_DATA: + pb_RefNum=file_refnum; + pb_Misc=(Ptr)0; + + error=PBSetEOFSync ((ParmBlkPtr)&pb); + + if (error!=noErr){ + free_memory (f->file_name); + free_memory (f->file_buffer_p); + pb_RefNum=file_refnum; + PBCloseSync ((ParmBlkPtr)&pb); + IO_error ("freopen: can't set eof"); + } + + file_length=0; + break; + case F_APPEND_TEXT: + case F_APPEND_DATA: + pb_RefNum=file_refnum; + pb_PosMode=fsFromLEOF; + pb_PosOffset=0; + + error=PBSetFPosSync ((ParmBlkPtr)&pb); + + if (error!=noErr){ + free_memory (f->file_name); + free_memory (f->file_buffer_p); + pb_RefNum=file_refnum; + PBCloseSync ((ParmBlkPtr)&pb); + IO_error ("freopen: can't seek to eof"); + } + + file_length=pb_PosOffset; + f->file_offset=file_length; + break; + default: + pb_RefNum=file_refnum; + + error=PBGetEOFSync ((ParmBlkPtr)&pb); + + file_length=(long)pb_Misc; + + if (error!=noErr){ + free_memory (f->file_name); + free_memory (f->file_buffer_p); + pb_RefNum=file_refnum; + PBCloseSync ((ParmBlkPtr)&pb); + IO_error ("freopen: can't get eof"); + } + } + + f->file_refnum=file_refnum; + f->file_mode= (1<file_length=file_length; + f->file_position=-2; + f->file_position_2=-1; + f->file_error=0; + + buffer=f->file_buffer_p; + f->file_end_buffer_p=buffer; + f->file_read_p=buffer; + f->file_write_p=buffer; + + return result; + } +} + +static void char_to_new_buffer (int c,struct file *f) +{ + long count; + unsigned char *buffer; + + flush_write_buffer (f); + + count=((f->file_mode | 255)+1) - (f->file_offset & (f->file_mode | 255)); + buffer=f->file_buffer_p; + + *buffer=c; + f->file_write_p=buffer+1; + buffer+=count; + f->file_end_buffer_p=buffer; + f->file_read_p=buffer; +} + +#if defined (__MWERKS__) || defined (powerc) +#define write_char(c,f) if ((f)->file_write_p<(f)->file_end_buffer_p) \ + *((f)->file_write_p)++=(c); \ + else \ + char_to_new_buffer((c),(f)) +#else +#define write_char(c,f) ((f)->file_write_p<(f)->file_end_buffer_p ? (*((f)->file_write_p)++=(c)) : char_to_new_buffer((c),(f))) +#endif + +static int char_from_new_buffer (struct file *f) +{ + OSErr error; + long count; + unsigned char *buffer; + HParamBlockRec pb; + int c; + + count=((f->file_mode | 255)+1) - (f->file_offset & (f->file_mode | 255)); + buffer=f->file_buffer_p; + + pb_RefNum=f->file_refnum; + pb_Buffer=buffer; + pb_ReqCount=count; + + pb_PosMode=fsAtMark; + pb_PosOffset=0; + + error=PBReadSync ((ParmBlkPtr)&pb); + if (error==eofErr) + error=noErr; + + count=pb_ActCount; + + f->file_offset = pb_PosOffset; + + if (error!=noErr) + f->file_error=-1; + + if (error!=noErr || count==0){ + f->file_end_buffer_p=buffer; + f->file_read_p=buffer; + f->file_write_p=buffer; + return EOF; + } + + c=*buffer; + f->file_read_p=buffer+1; + buffer+=count; + f->file_end_buffer_p=buffer; + f->file_write_p=buffer; + + return c; +} + +#define read_char(f) ((f)->file_read_p<(f)->file_end_buffer_p ? *((f)->file_read_p)++ : char_from_new_buffer(f)) + +int file_read_char (struct file *f) +{ + if (f->file_read_p < f->file_end_buffer_p) + return *(f->file_read_p)++; + else { + if (is_special_file (f)){ + if (f==file_table) + IO_error ("freadc: can't read from stderr"); + else if (f==&file_table[1]) + return w_get_char(); + else + IO_error ("freadc: can't open this file"); + } else { + if (! (f->file_mode & ((1<file_mode & (1<file_error=-1; + return 0; + } + ((char*)i_p)[0]=i; + if ((i=read_char (f))==EOF){ + f->file_error=-1; + return 0; + } + ((char*)i_p)[1]=i; + if ((i=read_char (f))==EOF){ + f->file_error=-1; + return 0; + } + ((char*)i_p)[2]=i; + if ((i=read_char (f))==EOF){ + f->file_error=-1; + return 0; + } + ((char*)i_p)[3]=i; + } else if (f->file_mode & (1<file_error=-1; + } else { + unsigned int i; + + i=c-'0'; + + while (is_digit (c=read_char (f))){ + i+=i<<2; + i+=i; + i+=c-'0'; + }; + + if (negative) + i=-i; + + *i_p=i; + } + + if (f->file_read_p > f->file_buffer_p) + --f->file_read_p; + + return result; + } else + IO_error ("freadi: read from an output file"); + + return -1; + } +} + +int file_read_real (struct file *f,double *r_p) +{ + if (is_special_file (f)){ + if (f==file_table) + IO_error ("freadr: can't read from stderr"); + else if (f==&file_table[1]) + return w_get_real (r_p); + else + IO_error ("freadr: can't open this file"); + } else { + *r_p=0.0; + + if (f->file_mode & (1<file_error=-1; + return 0; + } + ((char*)r_p)[n]=i; + } + } else if (f->file_mode & (1<=256) + result=0; + + if (f->file_read_p > f->file_buffer_p) + --f->file_read_p; + + *r_p=0.0; + + if (result){ + s[n]='\0'; +#if USE_CLIB + if (sscanf (s,"%lg",r_p)!=1) + result=0; + else + result=-1; +#else + result=convert_string_to_real (s,r_p); +#endif + } + + if (!result) + f->file_error=-1; + + return result; + } else + IO_error ("freadr: read from an output file"); + + return -1; + } +} + +#define OLD_READ_STRING 0 +#define OLD_WRITE_STRING 0 + +#if OLD_READ_STRING +unsigned long file_read_string (struct file *f,unsigned long max_length,struct clean_string *s) +{ +#else +unsigned long file_read_characters (struct file *f,unsigned long *length_p,char *s) +{ + unsigned long max_length; + + max_length=*length_p; +#endif + if (is_special_file (f)){ + if (f==file_table) + IO_error ("freads: can't read from stderr"); + else if (f==&file_table[1]){ + char *string; + unsigned long length; + + length=0; + +#if OLD_READ_STRING + string=s->characters; +#else + string=s; +#endif + while (length!=max_length){ + *string++=w_get_char(); + ++length; + } + +#if OLD_READ_STRING + s->length=length; +#else + *length_p=length; +#endif + return length; + } else + IO_error ("freads: can't open this file"); + } else { + unsigned char *string,*end_string,*begin_string; + + if (! (f->file_mode & ((1<characters; +#else + string=s; +#endif + begin_string=string; + end_string=string+max_length; + + while (stringfile_read_p < f->file_end_buffer_p){ + unsigned char *read_p; + long n; + + read_p=f->file_read_p; + + n=f->file_end_buffer_p-read_p; + if (n > end_string-string) + n=end_string-string; + + do { + *string++ = *read_p++; + } while (--n); + + f->file_read_p=read_p; + } else { + unsigned long align_buffer_mask; + + /* (unsigned long) cast added to prevent apple mpw c compiler from generating incorrect code */ + align_buffer_mask=~((unsigned long)f->file_mode | 255); + + if ((f->file_offset+(end_string-string) & align_buffer_mask) != (f->file_offset & align_buffer_mask)){ +/* if (end_string-string>=FILE_IO_BUFFER_SIZE && (f->file_offset & (FILE_IO_BUFFER_SIZE-1))==0){ */ + OSErr error; + long count; + unsigned char *buffer; + HParamBlockRec pb; + + count=end_string-string; + + if (f->file_offset+count < f->file_length) + count = (f->file_offset+count & align_buffer_mask) - f->file_offset; +/* count &= ~(FILE_IO_BUFFER_SIZE-1); */ + + pb_RefNum=f->file_refnum; + pb_Buffer=string; + pb_ReqCount=count; + + pb_PosMode=fsAtMark; + pb_PosOffset=0; + + error=PBReadSync ((ParmBlkPtr)&pb); + if (error==eofErr) + error=noErr; + + count=pb_ActCount; + + f->file_offset = pb_PosOffset; + + if (error!=noErr) + f->file_error=-1; + + buffer=f->file_buffer_p; + f->file_end_buffer_p=buffer; + f->file_read_p=buffer; + f->file_write_p=buffer; + + string+=count; + + if (error!=noErr || count==0) +#if OLD_READ_STRING + return (s->length=string-begin_string); +#else + return (*length_p=string-begin_string); +#endif + } else { + int c; + + c=char_from_new_buffer (f); + if (c==EOF) + break; + *string++=c; + } + } + } + +#if OLD_READ_STRING + return (s->length=string-begin_string); +#else + return (*length_p=string-begin_string); +#endif + } +} + +unsigned long file_read_line (struct file *f,unsigned long max_length,char *string) +{ + if (is_special_file (f)){ + if (f==file_table) + IO_error ("freadline: can't read from stderr"); + else if (f==&file_table[1]){ + unsigned long length; + + length=0; + + while (length!=max_length){ + int c; + + c=w_get_char(); + *string++=c; + ++length; + if (c==NEWLINE_CHAR) + return length; + } + + return -1; + } else + IO_error ("freadline: can't open this file"); + } else { + unsigned char *end_string,*begin_string; + int c; + + begin_string=string; + end_string=string+max_length; + + c=0; + + if (f->file_mode & (1<file_read_p < f->file_end_buffer_p){ + unsigned char *read_p; + long n; + + read_p=f->file_read_p; + + n=f->file_end_buffer_p-read_p; + if (n > end_string-(unsigned char*)string) + n=end_string-(unsigned char*)string; + + do { + char ch; + + ch=*read_p++; + *string++=ch; + if (ch==NEWLINE_CHAR){ + f->file_read_p=read_p; + return (unsigned char*)string-begin_string; + } + } while (--n); + + c=0; + f->file_read_p=read_p; + } else { + c=char_from_new_buffer(f); + if (c==EOF) + break; + + *string++=c; + if (c==NEWLINE_CHAR) + return (unsigned char*)string-begin_string; + } + } + } else if (f->file_mode & (1<file_read_p < f->file_end_buffer_p){ + unsigned char *read_p; + long n; + + read_p=f->file_read_p; + + n=f->file_end_buffer_p-read_p; + if (n > end_string-(unsigned char*)string) + n=end_string-(unsigned char*)string; + do { + char ch; + + ch=*read_p++; + + *string++=ch; + if (ch=='\xd'){ + if (n>1){ + if (*read_p=='\xa'){ + *string++='\xa'; + ++read_p; + } + f->file_read_p=read_p; + return (unsigned char*)string-begin_string; + } else if (read_p < f->file_end_buffer_p){ + f->file_read_p=read_p; + if (*read_p!='\xa'){ + return (unsigned char*)string-begin_string; + } else { + return -1; /* return \xd, read \xa next time */ + } + } else { + int c; + + f->file_read_p=read_p; + c=char_from_new_buffer(f); + read_p=f->file_read_p; + + if (c!='\xa'){ + if (read_p > f->file_buffer_p) + --read_p; + + f->file_read_p=read_p; + return (unsigned char*)string-begin_string; + } else { + if (stringfile_read_p=read_p; + return (unsigned char*)string-begin_string; + } else { + if (read_p > f->file_buffer_p) + --read_p; + + f->file_read_p=read_p; + return -1; /* return \xd, read \xa next time */ + } + } + } + } else if (ch=='\xa'){ + f->file_read_p=read_p; + return (unsigned char*)string-begin_string; + } + } while (--n); + + c=0; + f->file_read_p=read_p; + } else { + c=char_from_new_buffer(f); + if (c==EOF) + break; + + *string++=c; + + if (c=='\xd'){ + c = read_char (f); + if (stringfile_read_p > f->file_buffer_p) + --f->file_read_p; + } else { + if (f->file_read_p > f->file_buffer_p) + --f->file_read_p; + + if (c=='\xa') + return -1; + } + + return (unsigned char*)string-begin_string; + } else if (c=='\xa') + return (unsigned char*)string-begin_string; + } + } + } else + IO_error ("freadline: read from an output file"); + + if (c!=EOF) + return -1; + + return (unsigned char*)string-begin_string; + } +} + +void file_write_char (int c,struct file *f) +{ + if (f->file_write_p < f->file_end_buffer_p) + *(f->file_write_p)++=c; + else { + if (is_special_file (f)){ + if (f==file_table){ + ew_print_char (c); + + if (!(flags & 128)) + return; + + f=&file_table[3]; + if (f->file_mode==0){ + if (open_stderr_file_failed || !open_stderr_file()) + return; + } + + if (f->file_write_p < f->file_end_buffer_p) + *(f->file_write_p)++=c; + else + char_to_new_buffer (c,f); + + return; + } else if (f==&file_table[1]){ + w_print_char (c); + return; + } else { + IO_error ("fwritec: can't open this file"); + return; + } + } + + if (! (f->file_mode & ((1<file_mode==0){ + if (open_stderr_file_failed || !open_stderr_file()) + return; + } + } else if (f==&file_table[1]){ + w_print_int (i); + return; + } else { + IO_error ("fwritei: can't open this file"); + return; + } + } + + if (! (f->file_mode & ((1<file_mode & ((1<>24,f); + write_char (i>>16,f); + write_char (i>>8,f); + write_char (i,f); +#else + int v=i; + + write_char (((char*)&v)[0],f); + write_char (((char*)&v)[1],f); + write_char (((char*)&v)[2],f); + write_char (((char*)&v)[3],f); +#endif + } else { + unsigned char string[24],*end_p,*s; + int length; + +#if USE_CLIB + sprintf (string,"%d",i); + { + char *p; + + length=0; + for (p=string; *p; ++p) + ++length; + } +#else + end_p=convert_int_to_string (string,i); + length=end_p-string; +#endif + + s=string; + do { + write_char (*s++,f); + } while (--length); + } +} + +void file_write_real (double r,struct file *f) +{ + if (is_special_file (f)){ + if (f==file_table){ + ew_print_real (r); + + if (!(flags & 128)) + return; + + f=&file_table[3]; + if (f->file_mode==0){ + if (open_stderr_file_failed || !open_stderr_file()) + return; + } + } else if (f==&file_table[1]){ + w_print_real (r); + return; + } else { + IO_error ("fwriter: can't open this file"); + return; + } + } + + if (! (f->file_mode & ((1<file_mode & ((1<>24,f); + write_char (i1>>16,f); + write_char (i1>>8,f); + write_char (i1,f); + write_char (i2>>24,f); + write_char (i2>>16,f); + write_char (i2>>8,f); + write_char (i2,f); +#else + double v=r; + + write_char (((char*)&v)[0],f); + write_char (((char*)&v)[1],f); + write_char (((char*)&v)[2],f); + write_char (((char*)&v)[3],f); + write_char (((char*)&v)[4],f); + write_char (((char*)&v)[5],f); + write_char (((char*)&v)[6],f); + write_char (((char*)&v)[7],f); +#endif + } else { + unsigned char string[32],*end_p,*s; + int length; + +#if USE_CLIB + sprintf (string,"%.15g",r); + { + char *p; + + length=0; + for (p=string; *p; ++p) + ++length; + } +#else + end_p=convert_real_to_string (string,&r); + length=end_p-string; +#endif + s=string; + do { + write_char (*s++,f); + } while (--length); + } +} + +#if OLD_WRITE_STRING +void file_write_string (struct clean_string *s,struct file *f) +#else +void file_write_characters (unsigned char *p,int length,struct file *f) +#endif +{ + if (is_special_file (f)){ + if (f==file_table){ +#if OLD_WRITE_STRING + ew_print_text (s->characters,s->length); +#else + ew_print_text (p,length); +#endif + if (!(flags & 128)) + return; + + f=&file_table[3]; + if (f->file_mode==0){ + if (open_stderr_file_failed || !open_stderr_file()) + return; + } + } else if (f==&file_table[1]){ +#if OLD_WRITE_STRING + w_print_text (s->characters,s->length); +#else + w_print_text (p,length); +#endif + return; + } else { + IO_error ("fwrites: can't open this file"); + return; + } + } + + { +#if OLD_WRITE_STRING + unsigned char *p,*end_p; +#else + unsigned char *end_p; +#endif + if (! (f->file_mode & ((1<characters; + end_p=p+s->length; +#else + end_p=p+length; +#endif + + while (pfile_write_p < f->file_end_buffer_p){ + unsigned char *write_p; + long n; + + write_p=f->file_write_p; + + n=f->file_end_buffer_p-write_p; + if (n>end_p-p) + n=end_p-p; + + do { + *write_p++ = *p++; + } while (--n); + + f->file_write_p=write_p; + } else + char_to_new_buffer (*p++,f); + } + } +} + +int file_end (struct file *f) +{ + if (f->file_read_p < f->file_end_buffer_p) + return 0; + + if (is_special_file (f)){ + if (f==file_table || f==&file_table[1]) + IO_error ("fend: not allowed for stdio and stderr"); + else + IO_error ("fend: can't open file"); + } else { + if (! (f->file_mode & ((1<file_offset < f->file_length) + return 0; + + return -1; + } +} + +int file_error (struct file *f) +{ + if (is_special_file (f)){ + if (f==file_table || f==&file_table[1]) + return 0; + else + return -1; + } else + return f->file_error; +} + +unsigned long file_position (struct file *f) +{ + if (is_special_file (f)){ + if (f==file_table || f==&file_table[1]) + IO_error ("fposition: not allowed for stdio and stderr"); + else + IO_error ("fposition: can't open file"); + } else { + unsigned long position; + + if (f->file_mode & ((1<file_offset - (f->file_end_buffer_p - f->file_read_p); + else + position=f->file_offset + (f->file_write_p - f->file_buffer_p); + + return position; + } +} + +int file_seek (struct file *f,unsigned long position,unsigned long seek_mode) +{ + HParamBlockRec pb; + + if (is_special_file (f)){ + if (seek_mode>(unsigned)2) + IO_error ("fseek: invalid mode"); + + if (f==file_table || f==&file_table[1]) + IO_error ("fseek: can't seek on stdio and stderr"); + else + IO_error ("fseek: can't open file"); + } else { + long current_position; + unsigned long buffer_size; + + if (f->file_mode & ((1<file_offset - (f->file_end_buffer_p - f->file_read_p); + + switch (seek_mode){ + case F_SEEK_SET: + break; + case F_SEEK_CUR: + position+=current_position; + break; + case F_SEEK_END: + position=f->file_length-position; + break; + default: + IO_error ("fseek: invalid mode"); + } + + buffer_size=f->file_end_buffer_p - f->file_buffer_p; + if ((unsigned long)(position - (f->file_offset-buffer_size)) < buffer_size){ + f->file_read_p = f->file_buffer_p + (position - (f->file_offset-buffer_size)); + + return -1; + } else { + unsigned char *buffer; + OSErr error; + + if (position<0 || position>f->file_length){ + f->file_error=-1; + return 0; + } + + buffer=f->file_buffer_p; + f->file_end_buffer_p=buffer; + f->file_read_p=buffer; + f->file_write_p=buffer; + + pb_RefNum=f->file_refnum; + pb_PosMode=fsFromStart; + pb_PosOffset=position; + + error=PBSetFPosSync ((ParmBlkPtr)&pb); + + f->file_offset=pb_PosOffset; + + if (error!=noErr){ + f->file_error=-1; + return 0; + } + + return -1; + } + } else { + OSErr error; + int result; + + result=-1; + + current_position=f->file_offset + (f->file_write_p - f->file_buffer_p); + + if (current_position > f->file_length) + f->file_length=current_position; + + switch (seek_mode){ + case F_SEEK_SET: + break; + case F_SEEK_CUR: + position+=current_position; + break; + case F_SEEK_END: + position=f->file_length-position; + break; + default: + IO_error ("fseek: invalid mode"); + } + + if (position==current_position) + return -1; + + if (! flush_write_buffer (f)){ + f->file_error=-1; + result=0; + } + + if (position<0 || position>f->file_length){ + f->file_error=-1; + return 0; + } + + pb_RefNum=f->file_refnum; + pb_PosMode=fsFromStart; + pb_PosOffset=position; + + error=PBSetFPosSync ((ParmBlkPtr)&pb); + + f->file_offset=pb_PosOffset; + + if (error!=noErr){ + f->file_error=-1; + result=0; + } + + return result; + } + } +} + +struct file *open_s_file (struct clean_string *file_name,unsigned int file_mode) +{ + unsigned char p_file_name[MAX_FILE_NAME_LENGTH+1]; + int fn,existing_fn; + char *file_name_s; + struct file *f; + long file_length; + long file_number; + short volume_number,file_refnum; + unsigned char *buffer; + OSErr error; + HParamBlockRec pb; + unsigned int buffer_mask; + + buffer_mask = file_mode & ~255; + if (buffer_mask<8192) + buffer_mask=4095; + else if (buffer_mask>65535) + buffer_mask=65535; + else { + buffer_mask |= buffer_mask>>8; + buffer_mask |= buffer_mask>>4; + buffer_mask |= buffer_mask>>2; + buffer_mask |= buffer_mask>>1; + buffer_mask = (buffer_mask>>1) | 4095; + } + + file_mode &= 255; + + if (file_mode!=F_READ_TEXT && file_mode!=F_READ_DATA) + IO_error ("sfopen: invalid file mode"); + + file_name_s=clean_to_c_string (file_name); + if (file_name_s==NULL){ + IO_error ("sfopen: out of memory"); + return ERROR_FILE; + } + + existing_fn=file_exists (file_name_s,&file_number,&volume_number); + + if (existing_fn>=0){ + if (file_table[existing_fn].file_unique) + IO_error ("sfopen: file already opened by fopen"); + + if ((file_table[existing_fn].file_mode & 255)!=(1<=MAX_N_FILES){ + for (fn=FIRST_REAL_FILE; fn=MAX_N_FILES) + IO_error ("sfopen: too many files"); + } + f=&file_table[fn]; + + f->file_number=file_number; + f->file_volume_number=volume_number; + + copy_c_to_p_string (p_file_name,file_name_s,MAX_FILE_NAME_LENGTH); + + pb_NamePtr=p_file_name; + pb_VRefNum=0; + pb_DirID=0; + pb_Misc=(Ptr)0; + pb_Permssn=file_permission[file_mode]; + + error=PBHOpenSync ((void*)&pb); + if (error!=noErr){ + free_memory (file_name_s); + return ERROR_FILE; + } + + file_refnum=pb_RefNum; + + buffer=allocate_memory (buffer_mask+1); + if (buffer==NULL){ + free_memory (file_name_s); + pb_RefNum=file_refnum; + PBCloseSync ((ParmBlkPtr)&pb); + IO_error ("sfopen: out of memory"); + } + + f->file_buffer_p=buffer; + f->file_end_buffer_p=buffer; + f->file_read_p=buffer; + f->file_write_p=buffer; + + f->file_offset=0; + + pb_RefNum=file_refnum; + + error=PBGetEOFSync ((ParmBlkPtr)&pb); + + file_length=(long)pb_Misc; + + if (error!=noErr){ + free_memory (file_name_s); + free_memory ((char*)buffer); + pb_RefNum=file_refnum; + PBCloseSync ((ParmBlkPtr)&pb); + IO_error ("sfopen: can't get eof"); + } + + f->file_refnum=file_refnum; + f->file_mode= (1<file_unique=0; + f->file_error=0; + + f->file_name=file_name_s; + f->file_length=file_length; + f->file_position=-2; + f->file_position_2=-1; + + if (fn>=number_of_files) + number_of_files=fn+1; + + return f; +} + +void file_share (struct file *f) +{ + f->file_unique=0; +} + +static int simple_seek (struct file *f,long position) +{ + int result; + long buffer_size; + HParamBlockRec pb; + + result=1; + + buffer_size=f->file_end_buffer_p - f->file_buffer_p; + if ((unsigned long)(position - (f->file_offset-buffer_size)) < buffer_size){ + f->file_read_p = f->file_buffer_p + (position - (f->file_offset-buffer_size)); + f->file_position=position; + } else { + unsigned char *buffer; + OSErr error; + + if (position<0 || position>f->file_length){ + f->file_error=-1; + result=0; + } else { + buffer=f->file_buffer_p; + f->file_end_buffer_p=buffer; + f->file_read_p=buffer; + f->file_write_p=buffer; + + pb_RefNum=f->file_refnum; + pb_PosMode=fsFromStart; + pb_PosOffset=position; + + error=PBSetFPosSync ((ParmBlkPtr)&pb); + + f->file_offset=pb_PosOffset; + + if (error!=noErr){ + f->file_error=-1; + result=0; + } + f->file_position=position; + } + } + + return result; +} + +int file_read_s_char (struct file *f,unsigned long *position_p) +{ + if (is_special_file (f)){ + if (f==file_table) + IO_error ("sfreadc: can't read from stderr"); + else if (f==&file_table[1]) + IO_error ("sfreadc: can't read from stdio, use freadc"); + else + IO_error ("sfreadc: can't open this file"); + } else { + int c; + unsigned long position; + + position=*position_p; + + if (f->file_position!=position){ + if (f->file_unique) + IO_error ("sfreadc: can't read from a unique file"); + + switch (position){ + case -1l: + if (position!=f->file_position_2) + position=f->file_position_2; + else { + position=f->file_offset + (f->file_write_p - f->file_buffer_p); + f->file_position_2=position; + break; + } + default: + if (!simple_seek (f,position)) + IO_error ("sfreadc: seek failed"); + } + } + + if (f->file_read_p < f->file_end_buffer_p){ + c=*f->file_read_p++; + ++position; + } else { + c=char_from_new_buffer(f); + if (c!=EOF) + ++position; + } + + f->file_position=position; + *position_p=position; + + return c; + } +} + +int file_read_s_int (struct file *f,int *i_p,unsigned long *position_p) +{ + if (is_special_file (f)){ + if (f==file_table) + IO_error ("sfreadi: can't read from stderr"); + else if (f==&file_table[1]) + IO_error ("sfreadi: can't read from stdio, use freadi"); + else + IO_error ("sfreadi: can't open this file"); + } else { + int result; + unsigned long position; + + position=*position_p; + + if (f->file_position!=position){ + if (f->file_unique) + IO_error ("sfreadi: can't read from a unique file"); + + switch (position){ + case -1l: + if (position!=f->file_position_2) + position=f->file_position_2; + else { + position=position=f->file_offset + (f->file_write_p - f->file_buffer_p); + f->file_position_2=position; + break; + } + default: + if (!simple_seek (f,position)) + IO_error ("sfreadi: seek failed"); + } + } + + *i_p=0; + + result=-1; + if (f->file_mode & (1<file_error=-1; + result=0; + } else { + ((char*)i_p)[0]=i; + if ((i=read_char (f))==EOF){ + ++position; + f->file_error=-1; + result=0; + } else { + ((char*)i_p)[1]=i; + if ((i=read_char (f))==EOF){ + position+=2; + f->file_error=-1; + result=0; + } else { + ((char*)i_p)[2]=i; + if ((i=read_char (f))==EOF){ + position+=3; + f->file_error=-1; + result=0; + } else { + ((char*)i_p)[3]=i; + position+=4; + } + } + } + } + } else if (f->file_mode & (1<file_error=-1; + result=0; + } else { + unsigned int i; + + i=c-'0'; + + ++n_characters; + while (is_digit (c=read_char (f))){ + i+=i<<2; + i+=i; + i+=c-'0'; + ++n_characters; + }; + + if (negative) + i=-i; + + *i_p=i; + } + + position+=n_characters; + + if (f->file_read_p > f->file_buffer_p) + --f->file_read_p; + } + + f->file_position=position; + *position_p=position; + + return result; + } +} + +int file_read_s_real (struct file *f,double *r_p,unsigned long *position_p) +{ + if (is_special_file (f)){ + if (f==file_table) + IO_error ("sfreadr: can't read from stderr"); + else if (f==&file_table[1]) + IO_error ("sfreadr: can't read from stdio, use freadr"); + else + IO_error ("sfreadr: can't open this file"); + } else { + int result; + unsigned long position; + + position=*position_p; + if (f->file_position!=position){ + if (f->file_unique) + IO_error ("sfreadr: can't read from a unique file"); + + switch (position){ + case -1l: + if (position!=f->file_position_2) + position=f->file_position_2; + else { + position=position=f->file_offset + (f->file_write_p - f->file_buffer_p); + f->file_position_2=position; + break; + } + default: + if (!simple_seek (f,position)) + IO_error ("sfreadr: seek failed"); + } + } + + *r_p=0.0; + + if (f->file_mode & (1<file_error=-1; + result=0; + break; + } + ((char*)r_p)[n]=i; + } + + position+=n; + } else if (f->file_mode & (1<=256) + result=0; + + position+=n_characters; + + if (f->file_read_p > f->file_buffer_p) + --f->file_read_p; + + *r_p=0.0; + + if (result){ + s[n]='\0'; +#if USE_CLIB + if (sscanf (s,"%lg",r_p)!=1) + result=0; + else + result=-1; +#else + result=convert_string_to_real (s,r_p); +#endif + } + + if (!result) + f->file_error=-1; + } + + f->file_position=position; + *position_p=position; + + return result; + } +} + +unsigned long file_read_s_string + (struct file *f,unsigned long max_length,struct clean_string *s,unsigned long *position_p) +{ + unsigned long length; + + if (is_special_file (f)){ + if (f==file_table) + IO_error ("sfreads: can't read from stderr"); + else if (f==&file_table[1]) + IO_error ("sfreads: can't read from stdio, use freads"); + else + IO_error ("sfreads: can't open this file"); + } else { + unsigned long position; + char *string; + int c; + + position=*position_p; + if (f->file_position!=position){ + if (f->file_unique) + IO_error ("sfreads: can't read from a unique file"); + + switch (position){ + case -1l: + if (position!=f->file_position_2) + position=f->file_position_2; + else { + position=f->file_offset + (f->file_write_p - f->file_buffer_p); + f->file_position_2=position; + break; + } + default: + if (!simple_seek (f,position)) + IO_error ("sfreads: seek failed"); + } + } + + length=0; + string=s->characters; + + while (length!=max_length && ((c=read_char (f))!=EOF)){ + *string++=c; + ++length; + } + + s->length=length; + + position+=length; + + f->file_position=position; + *position_p=position; + + return length; + } +} + +unsigned long file_read_s_line + (struct file *f,unsigned long max_length,char *string,unsigned long *position_p) +{ + unsigned long length; + + if (is_special_file (f)){ + if (f==file_table) + IO_error ("sfreadline: can't read from stderr"); + else if (f==&file_table[1]) + IO_error ("sfreadline: can't read from stdio, use freadline"); + else + IO_error ("sfreadline: can't open this file"); + } else { + unsigned long position; + int c; + + position=*position_p; + if (f->file_position!=position){ + if (f->file_unique) + IO_error ("sfreadline: can't read from a unique file"); + + if (! (f->file_mode & (1<file_position_2) + position=f->file_position_2; + else { + position=f->file_offset + (f->file_write_p - f->file_buffer_p); + f->file_position_2=position; + break; + } + default: + if (!simple_seek (f,position)) + IO_error ("sfreadline: seek failed"); + } + } + + length=0; + + c=0; + while (length!=max_length && ((c=read_char (f))!=EOF)){ + *string++=c; + ++length; + if (c==NEWLINE_CHAR) + break; + } + + position+=length; + + f->file_position=position; + *position_p=position; + + if (c!=NEWLINE_CHAR && c!=EOF) + return -1; + + return length; + } +} + +int file_s_end (struct file *f,unsigned long position) +{ + if (is_special_file (f)){ + if (f==file_table || f==&file_table[1]) + IO_error ("sfend: not allowed for stdio and stderr"); + else + IO_error ("sfend: can't open file"); + } else { + if (f->file_unique){ + if (! (f->file_mode & ((1<file_read_p < f->file_end_buffer_p) + return 0; + + if (f->file_offset < f->file_length) + return 0; + + return -1; + } else { + if (position==-1l){ + if (f->file_position_2!=-1l) + position=f->file_position_2; + else { + position=f->file_offset + (f->file_end_buffer_p - f->file_read_p); + f->file_position=position; + f->file_position_2=position; + } + } + + return (position==f->file_length) ? -1 : 0; + } + } +} + +unsigned long file_s_position (struct file *f,unsigned long position) +{ + if (is_special_file (f)){ + if (f==file_table || f==&file_table[1]) + IO_error ("sfposition: not allowed for stdio and stderr"); + else + IO_error ("sfposition: can't open file"); + } else { + if (f->file_unique){ + if (f->file_mode & ((1<file_offset - (f->file_end_buffer_p - f->file_read_p); + else + position=f->file_offset + (f->file_write_p - f->file_buffer_p); + + return position; + } else { + if (position==-1l){ + if (f->file_position_2!=-1l) + return f->file_position_2; + else { + position=f->file_offset - (f->file_end_buffer_p - f->file_read_p); + + f->file_position=position; + f->file_position_2=position; + } + } + + return position; + } + } +} + +#define F_SEEK_SET 0 +#define F_SEEK_CUR 1 +#define F_SEEK_END 2 + +int file_s_seek (struct file *f,unsigned long position,unsigned long seek_mode,unsigned long *position_p) +{ + HParamBlockRec pb; + + if (is_special_file (f)){ + if (seek_mode>(unsigned)2) + IO_error ("sfseek: invalid mode"); + + if (f==file_table) + IO_error ("sfseek: can't seek on stdio"); + else if (f==&file_table[1]) + IO_error ("sfseek: can't seek on stderr"); + else + IO_error ("sfseek: can't open file"); + } else { + long current_position,buffer_size; + int result; + + result=-1; + + if (f->file_unique) + IO_error ("sfseek: can't seek on a unique file"); + + current_position=f->file_offset - (f->file_end_buffer_p - f->file_read_p); + + if (*position_p==-1l){ + if (f->file_position_2!=-1l) + *position_p=f->file_position_2; + else { + f->file_position_2=current_position; + *position_p=current_position; + } + } + + switch (seek_mode){ + case F_SEEK_SET: + break; + case F_SEEK_CUR: + position+=*position_p; + break; + case F_SEEK_END: + position=f->file_length+position; + break; + default: + IO_error ("sfseek: invalid mode"); + } + + buffer_size=f->file_end_buffer_p - f->file_buffer_p; + if ((unsigned long)(position - (f->file_offset-buffer_size)) < buffer_size){ + f->file_read_p = f->file_buffer_p + (position - (f->file_offset-buffer_size)); + f->file_position=position; + } else { + unsigned char *buffer; + OSErr error; + + if (position<0 || position>f->file_length){ + f->file_error=-1; + result=0; + f->file_position=current_position; + } else { + buffer=f->file_buffer_p; + f->file_end_buffer_p=buffer; + f->file_read_p=buffer; + f->file_write_p=buffer; + + pb_RefNum=f->file_refnum; + pb_PosMode=fsFromStart; + pb_PosOffset=position; + + error=PBSetFPosSync ((ParmBlkPtr)&pb); + + f->file_offset=pb_PosOffset; + + if (error!=noErr){ + f->file_error=-1; + result=0; + } + + f->file_position=position; + } + } + + *position_p=position; + + return result; + } +} + +void er_print_char (char c) +{ + ew_print_char (c); + + if (flags & 128){ + struct file *f; + + f=&file_table[3]; + if (f->file_mode==0){ + if (open_stderr_file_failed || !open_stderr_file()) + return; + } + + if (f->file_write_p < f->file_end_buffer_p) + *(f->file_write_p)++=c; + else + char_to_new_buffer (c,f); + } +} + +void er_print_int (int i) +{ + ew_print_int (i); + + if (flags & 128){ + if (file_table[3].file_mode==0){ + if (open_stderr_file_failed || !open_stderr_file()) + return; + } + + file_write_int (i,&file_table[3]); + } +} + +static void write_chars (unsigned char *p,unsigned char *end_p,struct file *f) +{ + while (pfile_write_p < f->file_end_buffer_p){ + unsigned char *write_p; + long n; + + write_p=f->file_write_p; + + n=f->file_end_buffer_p-write_p; + if (n>end_p-p) + n=end_p-p; + + do { + *write_p++ = *p++; + } while (--n); + + f->file_write_p=write_p; + } else + char_to_new_buffer (*p++,f); + } +} + +void er_print_text (char *s,unsigned long length) +{ + ew_print_text (s,length); + + if (flags & 128){ + struct file *f; + + f=&file_table[3]; + if (f->file_mode==0){ + if (open_stderr_file_failed || !open_stderr_file()) + return; + } + + write_chars (s,s+length,f); + } +} + +void er_print_string (char *s) +{ + ew_print_string (s); + + if (flags & 128){ + unsigned char *end_p; + struct file *f; + + f=&file_table[3]; + if (f->file_mode==0){ + if (open_stderr_file_failed || !open_stderr_file()) + return; + } + + end_p=s; + while (*end_p) + ++end_p; + + write_chars (s,end_p,f); + } +} diff --git a/mwrite_heap.c b/mwrite_heap.c new file mode 100644 index 0000000..ce2f2c3 --- /dev/null +++ b/mwrite_heap.c @@ -0,0 +1,237 @@ + +#include +#include +#include +#include +#include +#include +#include + +#define pb_RefNum (((HIOParam*)&pb)->ioRefNum) +#define pb_Permssn (((HIOParam*)&pb)->ioPermssn) +#define pb_Misc (((HIOParam*)&pb)->ioMisc) +#define pb_PosMode (((HIOParam*)&pb)->ioPosMode) +#define pb_PosOffset (((HIOParam*)&pb)->ioPosOffset) +#define pb_Buffer (((HIOParam*)&pb)->ioBuffer) +#define pb_NamePtr (((HIOParam*)&pb)->ioNamePtr) +#define pb_VRefNum (((HIOParam*)&pb)->ioVRefNum) +#define pb_DirID (((HFileParam*)&pb)->ioDirID) +#define pb_FDirIndex (((HFileParam*)&pb)->ioFDirIndex) +#define pb_FlFndrInfo (((HFileParam*)&pb)->ioFlFndrInfo) +#define pb_ReqCount (((HIOParam*)&pb)->ioReqCount) +#define pb_ActCount (((HIOParam*)&pb)->ioActCount) + +struct heap_info { + int *heap1_begin; + int *heap1_end; + int *heap2_begin; + int *heap2_end; + int *stack_begin; + int *stack_end; + int *text_begin; + int *data_begin; + int *small_integers; + int *characters; + int int_descriptor; + int char_descriptor; + int real_descriptor; + int bool_descriptor; + int string_descriptor; + int array_descriptor; +}; + +static int heap_written_count=0; + +#define MAX_N_HEAPS 10 + +void write_heap (struct heap_info *h) +{ + HParamBlockRec pb; + OSErr error; + Str32 application_name,heap_file_name; + int application_name_length; + + if (heap_written_count>=MAX_N_HEAPS) + return; + + { + unsigned char *s; + int n; + + s=LMGetCurApName(); + application_name_length=*s++; + + for (n=0; n<32; ++n){ + if (n>=application_name_length) + application_name[n]='\0'; + else { + application_name[n]=*s; + if (*s!='\0') + ++s; + } + } + } + + { + char *end_heap_file_name_p; + int n,heap_file_name_length; + + for (n=0; n31) + heap_file_name_length=31; + heap_file_name[0]=heap_file_name_length; + + end_heap_file_name_p=(char*)&heap_file_name[1+heap_file_name_length]; + + end_heap_file_name_p[-14]=' '; + end_heap_file_name_p[-13]='H'; + end_heap_file_name_p[-12]='e'; + end_heap_file_name_p[-11]='a'; + end_heap_file_name_p[-10]='p'; + end_heap_file_name_p[-9]=' '; + end_heap_file_name_p[-8]='P'; + end_heap_file_name_p[-7]='r'; + end_heap_file_name_p[-6]='o'; + end_heap_file_name_p[-5]='f'; + end_heap_file_name_p[-4]='i'; + end_heap_file_name_p[-3]='l'; + end_heap_file_name_p[-2]='e'; + end_heap_file_name_p[-1]='0'+heap_written_count++; + } + + pb_NamePtr=heap_file_name; + pb_VRefNum=0; + pb_DirID=0; + + error=PBHCreateSync ((void*)&pb); + if (error!=noErr && error!=-48/* dupFNErr*/){ + heap_written_count=MAX_N_HEAPS; + return; + } + + pb_VRefNum=0; + pb_DirID=0; + pb_FDirIndex=0; + + if (PBHGetFInfoSync ((void*)&pb)==noErr){ + pb_VRefNum=0; + pb_DirID=0; + pb_FlFndrInfo.fdCreator='PRHP'; + pb_FlFndrInfo.fdType='PRHP'; + PBHSetFInfoSync ((void*)&pb); + } + + pb_NamePtr=heap_file_name; + pb_VRefNum=0; + pb_DirID=0; + pb_Misc=(Ptr)0; + pb_Permssn=fsWrPerm; + + error=PBHOpenSync ((void*)&pb); + if (error!=noErr){ + heap_written_count=MAX_N_HEAPS; + return; + } + + pb_Buffer=(char*)application_name; + pb_ReqCount=32; + + pb_PosMode=fsAtMark; + pb_PosOffset=0; + + error=PBWriteSync ((ParmBlkPtr)&pb); + if (error!=noErr){ + PBCloseSync ((ParmBlkPtr)&pb); + heap_written_count=MAX_N_HEAPS; + return; + } + + pb_Buffer=(char*)h; + pb_ReqCount=sizeof (struct heap_info); + + pb_PosMode=fsAtMark; + pb_PosOffset=0; + + error=PBWriteSync ((ParmBlkPtr)&pb); + if (error!=noErr){ + PBCloseSync ((ParmBlkPtr)&pb); + heap_written_count=MAX_N_HEAPS; + return; + } + +#if 0 + { + int n; + Handle h; + + n=0; + do { + h=Get1Resource ('CODE',n); + + if (h!=NULL) + pb_Buffer=(char*)h; + else + pb_Buffer=(char*)&h; + pb_ReqCount=sizeof (Ptr); + + pb_PosMode=fsAtMark; + pb_PosOffset=0; + + error=PBWriteSync ((ParmBlkPtr)&pb); + if (error!=noErr){ + PBCloseSync ((ParmBlkPtr)&pb); + heap_written_count=MAX_N_HEAPS; + return; + } + + ++n; + } while (h!=NULL); + } +#endif + + pb_Buffer=(char*)h->stack_begin; + pb_ReqCount=(int)(h->stack_end) - (int)(h->stack_begin); + + pb_PosMode=fsAtMark; + pb_PosOffset=0; + + error=PBWriteSync ((ParmBlkPtr)&pb); + if (error!=noErr){ + PBCloseSync ((ParmBlkPtr)&pb); + heap_written_count=MAX_N_HEAPS; + return; + } + + pb_Buffer=(char*)h->heap1_begin; + pb_ReqCount=(int)(h->heap1_end) - (int)(h->heap1_begin); + + pb_PosMode=fsAtMark; + pb_PosOffset=0; + + error=PBWriteSync ((ParmBlkPtr)&pb); + if (error!=noErr){ + PBCloseSync ((ParmBlkPtr)&pb); + heap_written_count=MAX_N_HEAPS; + return; + } + + if (h->heap2_begin!=h->heap2_end){ + pb_Buffer=(char*)h->heap2_begin; + pb_ReqCount=(int)(h->heap2_end) - (int)(h->heap2_begin); + + pb_PosMode=fsAtMark; + pb_PosOffset=0; + + error=PBWriteSync ((ParmBlkPtr)&pb); + if (error!=noErr){ + PBCloseSync ((ParmBlkPtr)&pb); + heap_written_count=MAX_N_HEAPS; + return; + } + } + + PBCloseSync ((ParmBlkPtr)&pb); +} diff --git a/pcompact.a b/pcompact.a new file mode 100644 index 0000000..ee55b11 --- /dev/null +++ b/pcompact.a @@ -0,0 +1,1762 @@ + +; mark used nodes and pointers in argument parts and link backward pointers + + + lea o0,heap_size_33 + lwz d7,0(o0) + + lea o0,caf_list + slwi d7,d7,5 + lwz d0,0(o0) + + stwu a4,-4(sp) + li g3,128 + + cmpwi 0,d0,0 + beq end_mark_cafs + +mark_cafs_lp: + lwz d1,0(d0) + lwz o5,-4(d0) + addi a2,d0,4 + slwi d0,d1,2 + add a4,a2,d0 + + bl mark_stack_nodes + + addic. d0,o5,0 + bne mark_cafs_lp + +end_mark_cafs: + + lea o0,stack_p + lwz a4,0(sp) + lwz a2,0(o0) + addi sp,sp,4 + + bl mark_stack_nodes + + if MEASURE_GC + stwu o4,-4(sp) + bl .add_mark_compact_garbage_collect_time + + lwz o4,0(sp) + li g3,128 + baddi sp,4 + endif + + b compact_heap + +mark_stack_nodes3: + stw a0,-4(a2) + b mark_stack_nodes + +mark_stack_nodes2: + lwz g1,0(a0) + addi d0,a2,1-4 + stw g1,-4(a2) + stw d0,0(a0) + +mark_stack_nodes: + cmpw 0,a4,a2 + beq end_mark_nodes + + lwz a0,0(a2) + addi a2,a2,4 + + sub d0,a0,d6 + if SHARE_CHAR_INT + cmplw 0,d0,d7 + bge- mark_stack_nodes + endif + + srwi o0,d0,5 + lbzx o1,o4,o0 + rlwinm o2,d0,32-2,29,31 + rlwnm. r0,o1,o2,24,24 + bne- mark_stack_nodes2 + + li d3,0 + li d5,1 + +mark_arguments: + lwz d0,0-NODE_POINTER_OFFSET(a0) + srw o3,g3,o2 + + or o1,o1,o3 + + andi. r0,d0,2 + lha d2,-2(d0) + + stbx o1,o4,o0 + + cmpwi 6,d2,0 + beq mark_lazy_node + + beq 6,mark_hnf_0 + + cmplwi 0,d2,256 + addi a0,a0,4 + bge mark_record + + subic. d2,d2,2 + beq mark_hnf_2 + blt mark_hnf_1 + +mark_hnf_3: + lwz a1,4-NODE_POINTER_OFFSET(a0) +mark_hnf_3_: + sub d0,a1,d6 + srwi o0,d0,5 + lbzx o1,o4,o0 + rlwinm o2,d0,32-2,29,31 + srw o3,g3,o2 + and. r0,o1,o3 + bne shared_argument_part + + or o1,o1,o3 + stbx o1,o4,o0 + +no_shared_argument_part: + lwz o0,0-NODE_POINTER_OFFSET(a0) + or d3,d3,d5 + ori o0,o0,2 + stw o0,0-NODE_POINTER_OFFSET(a0) + stwu d3,4-NODE_POINTER_OFFSET(a0) + + lwz o0,0-NODE_POINTER_OFFSET(a1) + slwi d2,d2,2 + ori o0,o0,1 + stw o0,0-NODE_POINTER_OFFSET(a1) + + lwzux d2,a1,d2 + li d5,0 + stw a0,0-NODE_POINTER_OFFSET(a1) + mr d3,a1 + mr a0,d2 + b mark_node + +shared_argument_part: + cmplw 0,a1,a0 + bgt mark_hnf_1 + + lwz o0,0-NODE_POINTER_OFFSET(a1) + addi d0,a0,4+2+1 + stw d0,0-NODE_POINTER_OFFSET(a1) + stw o0,4-NODE_POINTER_OFFSET(a0) + b mark_hnf_1 + +mark_lazy_node_1: +; remove if no selectors: + bne mark_selector_node_1 +mark_hnf_1: + lwz d2,0-NODE_POINTER_OFFSET(a0) + or d3,d3,d5 + stw d3,0-NODE_POINTER_OFFSET(a0) + mr d3,a0 + li d5,2 + mr a0,d2 + b mark_node + +mark_selector_node_1: + baddicc d2,3 + lwz a1,0-NODE_POINTER_OFFSET(a0) + beq mark_indirection_node + + addic. d2,d2,1 + sub o2,a1,d6 + ble mark_record_selector_node_1 + + srwi d2,o2,5 + lbzx g1,o4,d2 + rlwinm g2,o2,32-2,29,31 + rlwnm. r0,g1,g2,24,24 + bne mark_hnf_1 + + lwz d2,0-NODE_POINTER_OFFSET(a1) + andi. r0,d2,2 + beq mark_hnf_1 + + lha g1,-2(d2) + cmplwi 0,g1,2 + ble small_tuple_or_record + +large_tuple_or_record: + lwz d1,8-NODE_POINTER_OFFSET(a1) + + sub o2,d1,d6 + srwi d2,o2,5 + lbzx g1,o4,d2 + rlwinm g2,o2,32-2,29,31 + rlwnm. r0,g1,g2,24,24 + bne mark_hnf_1 + +small_tuple_or_record: + if LINUX + lwz g1,-8(d0) + mflr r0 + else + lha g1,-6(d0) + mflr r0 + lwzx g1,rtoc,g1 + endif + andc o1,o1,o3 + + lwz g1,4(g1) + subi d2,a0,4 + + mtlr g1 + stbx o1,o4,o0 + mr a0,a1 + stwu r0,-4(sp) + blrl + mtlr r0 + + lea g1,__indirection + stw a0,4-NODE_POINTER_OFFSET(d2) + stw g1,0-NODE_POINTER_OFFSET(d2) + b mark_node + +mark_record_selector_node_1: + srwi d2,o2,5 + lbzx g1,o4,d2 + rlwinm g2,o2,32-2,29,31 + beq mark_strict_record_selector_node_1 + + rlwnm. r0,g1,g2,24,24 + bne mark_hnf_1 + + lwz d2,0-NODE_POINTER_OFFSET(a1) + andi. r0,d2,2 + beq mark_hnf_1 + + lha g1,-2(d2) + cmplwi 0,g1,258 + ble small_tuple_or_record + b large_tuple_or_record + +mark_strict_record_selector_node_1: + rlwnm. r0,g1,g2,24,24 + bne mark_hnf_1 + + lwz d2,0-NODE_POINTER_OFFSET(a1) + andi. r0,d2,2 + beq mark_hnf_1 + + lha g1,-2(d2) + cmplwi 0,g1,258 + ble select_from_small_record + + lwz d1,8-NODE_POINTER_OFFSET(a1) + sub o2,d1,d6 + + srwi d2,o2,5 + lbzx g1,o4,d2 + rlwinm g2,o2,32-2,29,31 + rlwnm. r0,g1,g2,24,24 + bne mark_hnf_1 + +select_from_small_record: + if LINUX + lwz g1,-8(d0) + mflr r0 + else + lha g1,-6(d0) + mflr r0 + lwzx g1,rtoc,g1 + endif + subi a0,a0,4 + lwz g1,4(g1) + + mtlr g1 + stwu r0,-4(sp) + blrl + mtlr r0 + + b mark_next_node + +mark_indirection_node: + andc o1,o1,o3 + stbx o1,o4,o0 + + mr a0,a1 + b mark_node + +mark_hnf_2: + lwz o0,0-NODE_POINTER_OFFSET(a0) + or d3,d3,d5 + ori o0,o0,2 + stw o0,0-NODE_POINTER_OFFSET(a0) + lwzu d2,4-NODE_POINTER_OFFSET(a0) + stw d3,0-NODE_POINTER_OFFSET(a0) + mr d3,a0 + li d5,0 + mr a0,d2 + +mark_node: + sub d0,a0,d6 + if SHARE_CHAR_INT + cmplw 0,d0,d7 + bge- mark_next_node_after_static + endif + srwi o0,d0,5 + lbzx o1,o4,o0 + rlwinm o2,d0,32-2,29,31 + rlwnm. r0,o1,o2,24,24 + beq+ mark_arguments + +mark_next_node: + cmpwi 0,d5,0 + bne mark_parent + + lwzu d2,-4-NODE_POINTER_OFFSET(d3) + lwz o0,4-NODE_POINTER_OFFSET(d3) + andi. d5,d2,3 + + cmpwi 0,d5,3 + beq argument_part_cycle1 + + stw o0,0-NODE_POINTER_OFFSET(d3) + +c_argument_part_cycle1: + cmplw 0,a0,d3 + bgt no_reverse_1 + + lwz o0,0-NODE_POINTER_OFFSET(a0) + addi d0,d3,4+1 + stw o0,4-NODE_POINTER_OFFSET(d3) + stw d0,0-NODE_POINTER_OFFSET(a0) + clrrwi a0,d2,2 + b mark_node + +no_reverse_1: + stw a0,4-NODE_POINTER_OFFSET(d3) + clrrwi a0,d2,2 + b mark_node + +mark_lazy_node: + beq 6,mark_next_node + + bsubicc d2,1 + baddi a0,4 + ble mark_lazy_node_1 + + cmplwi 0,d2,255 + bge mark_closure_with_unboxed_arguments + +mark_closure_with_unboxed_arguments_: + lwz o0,0-NODE_POINTER_OFFSET(a0) + slwi d2,d2,2 + ori o0,o0,2 + stw o0,0(a0) + + lwzux d2,a0,d2 + or d3,d3,d5 + stw d3,0-NODE_POINTER_OFFSET(a0) + mr d3,a0 + li d5,0 + mr a0,d2 + b mark_node + +mark_closure_with_unboxed_arguments: +; baddi d2,1 + srwi d0,d2,8 + bandic d2,255 +; bsub d2,d0 + bsubc d2,d0 +; bsubicc d2,1 + bgt mark_closure_with_unboxed_arguments_ + beq mark_hnf_1 + bsubi a0,4 + b mark_next_node + +mark_hnf_0: + if SHARE_CHAR_INT + cmpw d0,int_reg + bne no_int_3 + + lwz d2,4-NODE_POINTER_OFFSET(a0) + cmplwi 0,d2,33 + bge mark_next_node + + andc o1,o1,o3 + stbx o1,o4,o0 + + lea a0,small_integers + slwi d2,d2,3 + add a0,a0,d2 + b mark_next_node_after_static + +no_int_3: + cmplw d0,char_reg + bne no_char_3 + + andc o1,o1,o3 + stbx o1,o4,o0 + + lbz d2,7-NODE_POINTER_OFFSET(a0) + lea a0,static_characters + slwi d2,d2,3 + add a0,a0,d2 + b mark_next_node_after_static + +no_char_3: + blt no_normal_hnf_0 + + subi a0,d0,2-ZERO_ARITY_DESCRIPTOR_OFFSET + + andc o1,o1,o3 + stbx o1,o4,o0 + b mark_next_node_after_static + +no_normal_hnf_0: + endif + + lea o0,__ARRAY__2 + cmplw 0,d0,o0 + bne+ mark_next_node + b mark_array + +mark_record: + subic. d2,d2,258 + beq mark_record_2 + blt mark_record_1 + +mark_record_3: + lhz d2,-2+2(d0) + lwz a1,4-NODE_POINTER_OFFSET(a0) + subic. d2,d2,1 + blt mark_record_3_bb + + beq mark_record_3_ab + + subic. d2,d2,1 + beq mark_record_3_aab + + b mark_hnf_3_ + +mark_record_3_bb: + subi a0,a0,4 + + sub d0,a1,d6 + setmbit o4,d0,d1,o0,o1,o2,2 + + cmplw a1,a0 + bgt mark_next_node + + srwi. o0,o0,1 + + lwz o2,0-NODE_POINTER_OFFSET(a1) + addi d0,a0,8+2+1 + stw o2,8-NODE_POINTER_OFFSET(a0) + stw d0,0-NODE_POINTER_OFFSET(a1) + + bne+ not_next_byte_1 + + addi d1,d1,1 + lbzx o1,o4,d1 + li o0,128 +not_next_byte_1: + and. r0,o1,o0 + beq+ not_yet_linked_bb + + sub d0,a0,d6 + addi d0,d0,8 + setmbit o4,d0,d1,o0,o1,o2,2 + b mark_next_node + +not_yet_linked_bb: + or o1,o1,o0 + stbx o1,o4,d1 + b mark_next_node + +mark_record_3_ab: + sub d0,a1,d6 + setmbit o4,d0,d1,o0,o1,o2,2 + + cmplw 0,a1,a0 + bgt mark_hnf_1 + + srwi. o0,o0,1 + + lwz o2,0-NODE_POINTER_OFFSET(a1) + addi d0,a0,4+2+1 + stw o2,4-NODE_POINTER_OFFSET(a0) + stw d0,0-NODE_POINTER_OFFSET(a1) + + bne+ not_next_byte_2 + + addi d1,d1,1 + lbzx o1,o4,d1 + li o0,128 +not_next_byte_2: + and. r0,o1,o0 + beq+ not_yet_linked_ab + + sub d0,a0,d6 + addi d0,d0,4 + setmbit o4,d0,d1,o0,o1,o2,2 + b mark_hnf_1 + +not_yet_linked_ab: + or o1,o1,o0 + stbx o1,o4,d1 + b mark_hnf_1 + +mark_record_3_aab: + sub d0,a1,d6 + + tstmbit o4,d0,d1,o0,o1,o2,2 + bne shared_argument_part + + srw o0,g3,o2 + or o1,o1,o0 + stbx o1,o4,d1 + + lwz o0,0-NODE_POINTER_OFFSET(a0) + or d3,d3,d5 + ori o0,o0,2 + stw o0,0-NODE_POINTER_OFFSET(a0) + stwu d3,4-NODE_POINTER_OFFSET(a0) + + lwz d2,0-NODE_POINTER_OFFSET(a1) + li d5,1 + stw a0,0-NODE_POINTER_OFFSET(a1) + mr d3,a1 + mr a0,d2 + b mark_node + +mark_record_2: + lhz g1,-2+2(d0) + cmplwi g1,1 + bgt mark_hnf_2 + beq mark_hnf_1 + + subi a0,a0,4 + b mark_next_node + +mark_record_1: + lhz g1,-2+2(d0) + tst g1 + bne mark_hnf_1 + + subi a0,a0,4 + b mark_next_node + +mark_array: + lwz d1,8-NODE_POINTER_OFFSET(a0) + tst d1 + beq mark_lazy_array + + lhz d0,-2(d1) + tst d0 + beq mark_b_record_array + + lhz d1,-2+2(d1) + tst d1 + beq mark_b_record_array + + subi d0,d0,256 + cmpw 0,d0,d1 + beq mark_a_record_array + +mark_ab_record_array: + mr o2,d2 + mr o3,d3 + stw d5,-4(sp) + + lwz d2,4-NODE_POINTER_OFFSET(a0) + addi a0,a0,8 + stw a0,-8(sp) + + slwi d2,d2,2 + mullw a1,d2,d0 + + sub d0,d0,d1 + addi a0,a0,4 + add a1,a1,a0 + + mflr r0 + stw r0,-12(sp) + bl reorder + lwz r0,-12(sp) + + lwz a0,-8(sp) + mtlr r0 + + lwz d0,-4(a0) + mullw d0,d0,d1 + + lwz d5,-4(sp) + mr d3,o3 + mr d2,o2 + b mark_lr_array + +mark_b_record_array: + sub d0,a0,d6 + addi d0,d0,4 + setmbit o4,d0,d1,o0,o1,o2,2 + b mark_next_node + +mark_a_record_array: + lwz d0,4-NODE_POINTER_OFFSET(a0) + addi a0,a0,8 + mullw d0,d0,d1 + b mark_lr_array + +mark_lazy_array: + lwz d0,4-NODE_POINTER_OFFSET(a0) + addi a0,a0,8 +mark_lr_array: + sub d1,a0,d6 + srwi d1,d1,2 + add d1,d1,d0 + setmbit o4,d1,d2,o0,o1,o2,0 + + cmplwi 0,d0,1 + ble mark_array_length_0_1 + + mr a1,a0 + slwi d0,d0,2 + add a0,a0,d0 + + lwz d2,0-NODE_POINTER_OFFSET(a0) + lwz o0,0-NODE_POINTER_OFFSET(a1) + stw d2,0-NODE_POINTER_OFFSET(a1) + stw o0,0-NODE_POINTER_OFFSET(a0) + + lwzu d2,-4-NODE_POINTER_OFFSET(a0) + lwzu o0,-4-NODE_POINTER_OFFSET(a1) + addi d2,d2,2 + stw o0,0-NODE_POINTER_OFFSET(a0) + stw d2,0-NODE_POINTER_OFFSET(a1) + + lwzu d2,-4-NODE_POINTER_OFFSET(a0) + or d3,d3,d5 + stw d3,0-NODE_POINTER_OFFSET(a0) + mr d3,a0 + li d5,0 + mr a0,d2 + b mark_node + +mark_array_length_0_1: + subi a0,a0,8 + blt mark_next_node + + lwz d1,12-NODE_POINTER_OFFSET(a0) + lwz o0,8-NODE_POINTER_OFFSET(a0) + lwz o1,4-NODE_POINTER_OFFSET(a0) + stw o0,12-NODE_POINTER_OFFSET(a0) + stw o1,8-NODE_POINTER_OFFSET(a0) + stwu d1,4-NODE_POINTER_OFFSET(a0) + b mark_hnf_1 + + +mark_parent: + tst d3 + beq mark_stack_nodes2 + + subic. d5,d5,1 + beq argument_part_parent + + cmplw a0,d3 + lwz d2,0-NODE_POINTER_OFFSET(d3) + bgt no_reverse_2 + + mr a1,a0 + addi d0,d3,1 + lwz a0,0-NODE_POINTER_OFFSET(a1) + stw d0,0-NODE_POINTER_OFFSET(a1) + +no_reverse_2: + stw a0,0-NODE_POINTER_OFFSET(d3) + subi a0,d3,4 + andi. d5,d2,3 + clrrwi d3,d2,2 + b mark_next_node + +argument_part_parent: + mr a1,d3 + mr d3,a0 + + lwz d2,0-NODE_POINTER_OFFSET(a1) + + mr a0,a1 + +skip_upward_pointers: + andi. d0,d2,3 + cmpwi 0,d0,3 + bne no_upward_pointer + + clrrwi a1,d2,2 + lwz d2,0-NODE_POINTER_OFFSET(a1) + b skip_upward_pointers + +no_upward_pointer: + cmplw 0,d3,a0 + bgt no_reverse_3 + + mr a6,d3 + lwz d3,0-NODE_POINTER_OFFSET(d3) + addi d0,a0,1 + stw d0,0-NODE_POINTER_OFFSET(a6) + +no_reverse_3: + stw d3,0-NODE_POINTER_OFFSET(a1) + + clrrwi d3,d2,2 + + lwzu d2,-4-NODE_POINTER_OFFSET(d3) + + cmplw 6,a0,d3 + + lwz o0,4-NODE_POINTER_OFFSET(d3) + andi. d5,d2,3 + stw o0,0-NODE_POINTER_OFFSET(d3) + + bgt 6,no_reverse_4 + + lwz o0,0-NODE_POINTER_OFFSET(a0) + stw o0,4-NODE_POINTER_OFFSET(d3) + addi d0,d3,4+2+1 + stw d0,0-NODE_POINTER_OFFSET(a0) + clrrwi a0,d2,2 + b mark_node + +no_reverse_4: + stw a0,4-NODE_POINTER_OFFSET(d3) + clrrwi a0,d2,2 + b mark_node + +argument_part_cycle1: + mr d1,a1 + +skip_pointer_list1: + clrrwi a1,d2,2 + lwz d2,0-NODE_POINTER_OFFSET(a1) + andi. d5,d2,3 + cmpwi 0,d5,3 + beq skip_pointer_list1 + + stw o0,0-NODE_POINTER_OFFSET(a1) + mr a1,d1 + b c_argument_part_cycle1 + + if SHARE_CHAR_INT +mark_next_node_after_static: + cmpwi 0,d5,0 + bne mark_parent_after_static + + lwzu d2,-4-NODE_POINTER_OFFSET(d3) + lwz o0,4-NODE_POINTER_OFFSET(d3) + andi. d5,d2,3 + + cmpwi 0,d5,3 + beq argument_part_cycle2 + + stw o0,0-NODE_POINTER_OFFSET(d3) + +c_argument_part_cycle2: + stw a0,4-NODE_POINTER_OFFSET(d3) + clrrwi a0,d2,2 + b mark_node + +mark_parent_after_static: + cmpwi 0,d3,0 + beq mark_stack_nodes3 + + subic. d5,d5,1 + beq argument_part_parent_after_static + + lwz d2,0-NODE_POINTER_OFFSET(d3) + stw a0,0-NODE_POINTER_OFFSET(d3) + subi a0,d3,4 + andi. d5,d2,3 + clrrwi d3,d2,2 + b mark_next_node + +argument_part_parent_after_static: + mr a1,d3 + mr d3,a0 + + lwz d2,0-NODE_POINTER_OFFSET(a1) + + mr a0,a1 + +skip_upward_pointers_2: + andi. d0,d2,3 + cmpwi 0,d0,3 + bne no_reverse_3 + + clrrwi a1,d2,2 + lwz d2,0-NODE_POINTER_OFFSET(a1) + b skip_upward_pointers_2 + +argument_part_cycle2: + mr d1,a1 + +skip_pointer_list2: + clrrwi a1,d2,2 + lwz d2,0-NODE_POINTER_OFFSET(a1) + andi. d5,d2,3 + cmpwi 0,d5,3 + beq skip_pointer_list2 + + stw o0,0-NODE_POINTER_OFFSET(a1) + mr a1,d1 + b c_argument_part_cycle2 + endif + +end_mark_nodes: + addi a2,a2,4 + blr + + +; compact the heap + +compact_heap: + + if FINALIZERS + lea a0,finalizer_list + lea a1,free_finalizer_list + + lwz a2,0(a0) +determine_free_finalizers_after_compact1: + lea o0,__Nil_m8 + cmplw o0,a2 + beq end_finalizers_after_compact1 + + sub d1,a2,d6 + rlwinm o0,d1,32-5,5,29 + lwzx o1,o4,o0 + rlwinm d1,d1,32-2,27,31 + rlwnm. r0,o1,d1,0,0 + beq finalizer_not_used_after_compact1 + + lwz d0,0(a2) + mr a3,a2 + b finalizer_find_descriptor + +finalizer_find_descriptor_lp: + clrrwi d0,d0,2 + mr a3,d0 + lwz d0,0(d0) +finalizer_find_descriptor: + andi. r0,d0,1 + bne finalizer_find_descriptor_lp + + lea o0,e____system__kFinalizerGCTemp_2 + stw o0,0(a3) + + cmplw a2,a0 + bgt finalizer_no_reverse + + lwz d0,0(a2) + addi a3,a0,1 + stw a3,0(a2) + stw d0,0(a0) + +finalizer_no_reverse: + addi a0,a2,4 + lwz a2,4(a2) + b determine_free_finalizers_after_compact1 + +finalizer_not_used_after_compact1: + lea o0,e____system__kFinalizerGCTemp_2 + stw o0,0(a2) + + stw a2,0(a1) + addi a1,a2,4 + + lwz a2,4(a2) + stw a2,0(a0) + b determine_free_finalizers_after_compact1 + +end_finalizers_after_compact1: + stw a2,0(a1) + + lea o1,finalizer_list + lwz a0,0(o1) + lea o0,__Nil_m8 + cmplw o0,a0 + beq finalizer_list_empty + andi. r0,a0,3 + bne finalizer_list_already_reversed + lwz d0,0(a0) + addi o0,o1,1 + stw o0,0(a0) + stw d0,0(o1) +finalizer_list_already_reversed: +finalizer_list_empty: + + lea a2,free_finalizer_list + lea o0,__Nil_m8 + lwz o1,0(a2) + cmplw o0,o1 + beq free_finalizer_list_empty + + stwu a4,-4(sp) + addi a4,a2,4 + bl mark_stack_nodes + lwz a4,0(sp) + addi sp,sp,4 + +free_finalizer_list_empty: + endif + + lea o0,heap_size_33 + lwz d5,0(o0) + slwi d2,d5,5 + + if SHARE_CHAR_INT + add d2,d2,d6 + endif + + addi d5,d5,3 + srwi. d5,d5,2 + + mr a2,o4 + mr a6,d6 + li d4,0 + + beq end_compact_heap + + mtctr d5 +skip_zeros_2: + lwz d4,0(a2) + baddi a2,4 + cmpwi 0,d4,0 + bne end_skip_zeros +find_non_zero_long_2: + bdnz skip_zeros_2 + + b end_compact_heap + +end_skip_zeros: + sub d7,a2,o4 + subi d7,d7,4 + slwi d7,d7,5 + add d7,d7,d6 + +skip_zero_bits: + cntlzw d1,d4 + cmpwi 0,d1,32 + beq- find_non_zero_long_2 + + addi d1,d1,1 + slw d4,d4,d1 + slwi d1,d1,2 + add d7,d7,d1 + + lwz d0,-4(d7) + mr a0,d7 + + andi. r0,d0,2 + clrrwi d0,d0,2 + beq+ begin_update_list_2 + + lwz d3,-8(d0) + mr a1,d0 + andi. r0,d3,1 + beq end_list_2 +find_descriptor_2: + clrrwi a1,d3,2 + lwz d3,0(a1) + andi. r0,d3,1 + bne find_descriptor_2 +end_list_2: + lhz d1,-2(d3) + + cmplwi 0,d1,256 + blt no_record_arguments + + lhz d3,-2+2(d3) + subic. d3,d3,2 + bge copy_record_arguments_aa + + subi d1,d1,256+3 + +copy_record_arguments_all_b: + mr g2,d1 + +update_up_list_1r: + mr a1,d0 + sub d0,d0,d6 + + tstmbit o4,d0,d1,o0,o1,o2,2 + beq copy_argument_part_1r + + lwz d0,0(a1) + stw a6,0(a1) + subi d0,d0,3 + b update_up_list_1r + +copy_argument_part_1r: + lwz d0,0(a1) + stw a6,0(a1) + stw d0,0(a6) + addi a6,a6,4 + + mr d1,g2 + +copy_b_record_argument_part_arguments: + lwz o0,0(a0) + + subic. d1,d1,1 + + addi a0,a0,4 + stw o0,0(a6) + addi a6,a6,4 + bge copy_b_record_argument_part_arguments + + sub o0,a2,o4 + slwi o0,o0,5 + add o0,o0,d6 + + cmpw 0,o0,d7 + addi d7,d7,4 + slwi d4,d4,1 + bne skip_zero_bits + + bdz end_compact_heap + + lwz d4,0(a2) + lis o1,0x8000 + andc d4,d4,o1 + b skip_zeros_2+4 + +copy_record_arguments_aa: + subi d1,d1,256+2 + sub d1,d1,d3 + mr g2,d1 + +update_up_list_2r: + mr a1,d0 + lwz d0,0(a1) + andi. d1,d0,3 + subic. d1,d1,3 + stw a6,0(a1) + bne copy_argument_part_2r + + subi d0,d0,3 + b update_up_list_2r + +copy_argument_part_2r: + cmplw 0,d0,a0 + blt copy_record_argument_2 + if SHARE_CHAR_INT + cmplw 0,d0,d2 + bge copy_record_argument_2 + endif + mr a1,d0 + lwz d0,0(a1) + addi d1,a6,1 + stw d1,0(a1) +copy_record_argument_2: + stw d0,0(a6) + addi a6,a6,4 + + subic. d3,d3,1 + blt no_pointers_in_record +copy_record_pointers: + lwz a1,0(a0) + addi a0,a0,4 + cmplw 0,a1,a0 + blt copy_record_pointers_2 + if SHARE_CHAR_INT + cmplw 0,a1,d2 + bge copy_record_pointers_2 + endif + lwz d1,0(a1) + addi d0,a6,1 + stw d0,0(a1) + mr a1,d1 +copy_record_pointers_2: + stw a1,0(a6) + subic. d3,d3,1 + addi a6,a6,4 + bge copy_record_pointers + +no_pointers_in_record: + cmpwi 0,g2,0 + subi d1,g2,1 + beq no_non_pointers_in_record + +copy_non_pointers_in_record: + lwz o0,0(a0) + addi a0,a0,4 + stw o0,0(a6) +# subi. d2,d2,1 + subic. d1,d1,1 + addi a6,a6,4 + bge copy_non_pointers_in_record + +no_non_pointers_in_record: + b skip_zero_bits + +no_record_arguments: + subi d1,d1,3 +update_up_list_2: + mr a1,d0 + lwz d0,0(a1) + andi. d3,d0,3 + cmpwi 0,d3,3 + bne copy_argument_part_2 + + stw a6,0(a1) + clrrwi d0,d0,2 + b update_up_list_2 + +copy_argument_part_2: + stw a6,0(a1) + + cmplw 0,d0,a0 + addi a6,a6,4 + blt copy_arguments_1 + + if SHARE_CHAR_INT + cmplw 0,d0,d2 + bge copy_arguments_1 + endif + mr a1,d0 + lwz d0,0(a1) + addi d3,a6,1-4 + stw d3,0(a1) +copy_arguments_1: + stw d0,-4(a6) + +copy_argument_part_arguments: + lwz a1,0(a0) + addi a0,a0,4 + cmplw 0,a1,a0 + blt copy_arguments_2 + if SHARE_CHAR_INT + cmplw 0,a1,d2 + bge copy_arguments_2 + endif + ori d0,a6,1 + lwz d3,0(a1) + stw d0,0(a1) + mr a1,d3 + +copy_arguments_2: + stw a1,0(a6) + subic. d1,d1,1 + addi a6,a6,4 + bge copy_argument_part_arguments + + b skip_zero_bits + +update_list_2: + stw a6,0(a1) +begin_update_list_2: + mr a1,d0 + lwz d0,0(a1) +update_list__2: + andi. r0,d0,1 + beq end_update_list_2 + andi. r0,d0,2 + clrrwi d0,d0,2 + beq update_list_2 + mr a1,d0 + lwz d0,0(a1) + b update_list__2 + +end_update_list_2: + stw a6,0(a1) + + andi. r0,d0,2 + stw d0,0(a6) + beq move_lazy_node + + lhz d1,-2(d0) + baddi a6,4 + cmpwi 0,d1,0 + beq move_hnf_0 + + cmplwi 0,d1,256 + bge move_record + + subic. d1,d1,2 + blt move_hnf_1 + beq move_hnf_2 + +move_hnf_3: + lwz a1,0(a0) + addi a0,a0,4 +move_hnf_3_: + cmplw 0,a1,a0 + blt copy_hnf_3_1 + if SHARE_CHAR_INT + cmplw 0,a1,d2 + bge copy_hnf_3_1 + endif + ori d0,a6,1 + lwz d1,0(a1) + stw d0,0(a1) + mr a1,d1 +copy_hnf_3_1: + stw a1,0(a6) + + lwz a1,0(a0) + addi a0,a0,4 + cmplw 0,a1,a0 + blt copy_hnf_3_2 + if SHARE_CHAR_INT + cmplw 0,a1,d2 + bge copy_hnf_3_2 + endif + addi d0,a6,4+2+1 + lwz d1,0(a1) + stw d0,0(a1) + mr a1,d1 +copy_hnf_3_2: + stw a1,4(a6) + addi a6,a6,8 + b skip_zero_bits + +move_hnf_2: + lwz a1,0(a0) + addi a0,a0,4 + cmplw 0,a1,a0 + blt copy_hnf_2_1 + if SHARE_CHAR_INT + cmplw 0,a1,d2 + bge copy_hnf_2_1 + endif + ori d0,a6,1 + lwz d1,0(a1) + stw d0,0(a1) + mr a1,d1 +copy_hnf_2_1: + stw a1,0(a6) + + lwz a1,0(a0) + addi a0,a0,4 + cmplw 0,a1,a0 + blt copy_hnf_2_2 + if SHARE_CHAR_INT + cmplw 0,a1,d2 + bge copy_hnf_2_2 + endif + addi d0,a6,4+1 + lwz d1,0(a1) + stw d0,0(a1) + mr a1,d1 +copy_hnf_2_2: + stw a1,4(a6) + addi a6,a6,8 + b skip_zero_bits + +move_hnf_1: + lwz a1,0(a0) + addi a0,a0,4 + cmplw 0,a1,a0 + blt move_hnf_1_ + if SHARE_CHAR_INT + cmplw 0,a1,d2 + bge move_hnf_1_ + endif + ori d0,a6,1 + lwz d1,0(a1) + stw d0,0(a1) + mr a1,d1 +move_hnf_1_: + stw a1,0(a6) + addi a6,a6,4 + b skip_zero_bits + +move_real_or_file: + lwz o0,0(a0) + lwz o1,4(a0) + stw o0,0(a6) + stw o1,4(a6) + addi a6,a6,8 + b skip_zero_bits + +move_int_bool_or_char: + lwz o0,0(a0) + addi a6,a6,4 + stw o0,-4(a6) +copy_normal_hnf_0: + b skip_zero_bits + +move_hnf_0: + cmplw 0,d0,int_reg + blt move_real_file_string_or_array + + cmplw 0,d0,char_reg + ble move_int_bool_or_char + +; b,a copy_normal_hnf_0 + b skip_zero_bits + +move_real_file_string_or_array: + lea o0,__STRING__2 + cmplw 0,d0,o0 + bgt move_real_or_file + + bne move_array + + lwz d0,0(a0) + addi d0,d0,3 + srwi d0,d0,2 + +cp_s_arg_lp3: + lwz o0,0(a0) + subic. d0,d0,1 + stw o0,0(a6) + blt end_cp_s_lp3 + +cp_s_lp3: + lwzu o0,4(a0) + subic. d0,d0,1 + stwu o0,4(a6) + bge cp_s_lp3 + +end_cp_s_lp3: + addi a6,a6,4 + b skip_zero_bits + +move_record: + bsubicc d1,258 + blt move_record_1 + beq move_record_2 + +move_record_3: + lhz d1,-2+2(d0) + + lwz a1,0(a0) + + bsubicc d1,1 + + baddi a0,4 + + bgt move_hnf_3_ + + blt move_record_3_1b + +move_record_3_1a: + cmplw 0,a1,a0 + blt move_record_3_1b + if SHARE_CHAR_INT + cmplw 0,a1,d2 + bge move_record_3_1b + endif + addi d0,a6,1 + lwz d1,0(a1) + stw d0,0(a1) + mr a1,d1 +move_record_3_1b: + stw a1,0(a6) + addi a6,a6,4 + + lwz a1,0(a0) + addi a0,a0,4 + cmplw 0,a1,a0 + blt move_record_3_2 + if SHARE_CHAR_INT + cmplw 0,a1,d2 + bge move_record_3_2 + endif + sub d0,a1,d6 + addi d0,d0,4 + + tstmbit o4,d0,d1,o0,o1,o2,2 + beq not_linked_record_argument_part_3_b + + sub d0,a6,d6 + setmbit o4,d0,d1,o0,o1,o2,2 + b linked_record_argument_part_3_b + +not_linked_record_argument_part_3_b: + srw o0,g3,o2 + or o1,o1,o0 + stbx o1,o4,d1 + + sub d0,a6,d6 + clrmbit o4,d0,d1,o0,o1,o2,2 + +linked_record_argument_part_3_b: + lwz d1,0(a1) + addi d0,a6,2+1 + stw d0,0(a1) + mr a1,d1 +move_record_3_2: + stw a1,0(a6) + addi a6,a6,4 + + sub o0,a2,o4 + slwi o0,o0,5 + add o0,o0,d6 + + addi d7,d7,4 + cmpw 0,d7,o0 + + addi d7,d7,4 + slwi d4,d4,2 + blt skip_zero_bits + bgt bits_in_next_long + + lis o1,0x80000000>>16 + b one_bit_in_next_long + +bits_in_next_long: + lis o1,0xc0000000>>16 +one_bit_in_next_long: + bdz end_compact_heap + + lwz d4,0(a2) + andc d4,d4,o1 + b skip_zeros_2+4 + +move_record_2: + lhz g1,-2+2(d0) + cmplwi 0,g1,1 + bgt move_hnf_2 + blt move_real_or_file + +move_record_2_ab: + lwz a1,0(a0) + lwzu o0,4(a0) + cmplw 0,a1,a0 + blt move_record_2_1 + if SHARE_CHAR_INT + cmplw 0,a1,d2 + addi d0,a6,1 + bge move_record_2_1 + endif + lwz d1,0(a1) + stw d0,0(a1) + mr a1,d1 +move_record_2_1: + stw a1,0(a6) + stw o0,4(a6) + addi a6,a6,8 + b skip_zero_bits + +move_record_1: + lhz g1,-2+2(d0) + cmpwi 0,g1,0 + bne move_hnf_1 + + b move_int_bool_or_char + +skip_zeros_2_a: + lwz d4,0(a2) + bdz- out_of_memory_4 + cmpwi 0,d4,0 + addi a2,a2,4 + beq skip_zeros_2_a + +end_skip_zeros_a: + sub d7,a2,o4 + subi d7,d7,4 + slwi d7,d7,5 + add d7,d7,d6 + +move_array: +skip_zero_bits_a: + cntlzw d1,d4 + cmpwi 0,d1,32 + beq skip_zeros_2_a + + slw d4,d4,d1 + slwi d4,d4,1 + + slwi d1,d1,2 + add d7,d7,d1 + + cmpw 0,d7,a0 + mr d1,d7 + addi d7,d7,4 + bne move_a_array + +move_b_array: + lwz a1,0(a0) + lwzu d1,4(a0) + stw a1,0(a6) + lhz d0,-2(d1) + + addi a6,a6,4 + + cmpwi 0,d0,0 + beq move_strict_basic_array + + subi d1,d0,256 + mullw d0,a1,d1 + b cp_s_arg_lp3 + +move_strict_basic_array: + cmpw 0,d1,int_reg + mr d0,a1 + beq cp_s_arg_lp3 + + cmpw 0,d1,bool_reg + beq move_bool_array + + add d0,d0,d0 + b cp_s_arg_lp3 + +move_bool_array: + addi d0,d0,3 + srwi d0,d0,2 + b cp_s_arg_lp3 + +move_a_array: + mr a1,d1 + sub d1,d1,a0 + srwi d1,d1,2 + subic. d1,d1,1 + blt skip_zero_bits + if 0 + cmpwi d1,1 + ble move_a_array_size_0_1 + endif + +; first swap second last element of array and second last element of header + lwz o0,0(a0) + lwz d0,-4(a1) + stw o0,-4(a1) + stw d0,0(a6) + +; then swap last element of array and last element of header +; this also works for length 0 and 1 ! + + lwz d0,0(a1) + lwz o0,4(a0) + stw o0,0(a1) + addi a0,a0,8 + if 0 + c_move_array_size_1: + endif + + cmpwi 0,d0,0 + stw d0,4(a6) + addi a6,a6,8 + beq st_move_array_lp + + lhz d3,-2+2(d0) + lhz d0,-2(d0) + subi d0,d0,256 + cmpw 0,d0,d3 + beq st_move_array_lp + +move_array_ab: + mr o2,d4 + mr o3,d5 + + mr g2,d2 + stw a0,-4(sp) + + lwz d2,-8(a6) + mr d1,d3 + + mr d3,d0 + slwi d2,d2,2 + mullw a1,d2,d3 + + sub d0,d0,d1 + add a1,a1,a0 + + mflr r0 + stw r0,-8(sp) + + bl reorder + + lwz r0,-8(sp) + lwz d3,-8(a6) + mtlr r0 + + lwz a0,-4(sp) + mr d2,g2 + subi d1,d1,1 + subi d0,d0,1 + b st_move_array_lp_ab + +move_array_ab_lp1: + mr d4,d1 +move_array_ab_a_elements: + lwz d5,0(a0) + addi a0,a0,4 + cmplw 0,d5,a0 + blt move_array_element_ab + if SHARE_CHAR_INT + cmplw 0,d5,d2 + bge move_array_element_ab + endif + mr a1,d5 + lwz d5,0(a1) + addi o0,a6,1 + stw o0,0(a1) +move_array_element_ab: + subic. d4,d4,1 + stw d5,0(a6) + addi a6,a6,4 + bge move_array_ab_a_elements + + mr d4,d0 +move_array_ab_b_elements: + lwz o0,0(a0) + subic. d4,d4,1 + addi a0,a0,4 + stw o0,0(a6) + addi a6,a6,4 + bge move_array_ab_b_elements +st_move_array_lp_ab: + subic. d3,d3,1 + bge move_array_ab_lp1 + + mr d5,o3 + mr d4,o2 + b skip_zero_bits + +st_move_array_lp: + subic. d1,d1,1 + subi a6,a6,4 + bge+ move_lazy_node_arguments + addi a6,a6,4 + b skip_zero_bits + if 0 + move_a_array_size_0_1: + lwz o0,0(a0) + lwz d0,4(a0) + blt move_array_size_0 + + stw d0,0(a6) + lwz d0,8(a0) + stwu o0,8(a0) + b c_move_array_size_1 + + move_array_size_0: + stw o0,0(a6) + stw d0,4(a6) + addi a6,a6,8 + b skip_zero_bits + endif + +move_lazy_node: + lha d1,-2(d0) + mr a1,d0 + cmpwi 0,d1,0 + beq move_lazy_node_0 + + bsubicc d1,1 + ble move_lazy_node_1 + + cmplwi 0,d1,256 + bge move_closure_with_unboxed_arguments + +move_lazy_node_arguments: + lwz a1,0(a0) + baddi a0,4 + cmplw 0,a1,a0 + blt move_lazy_node_arguments_ + if SHARE_CHAR_INT + cmplw 0,a1,d2 + bge move_lazy_node_arguments_ + endif + lwz o0,0(a1) + + bsubicc d1,1 + + stwu o0,4(a6) + addi d0,a6,1 + stw d0,0(a1) + bge move_lazy_node_arguments + + baddi a6,4 + b skip_zero_bits + +move_lazy_node_arguments_: + bsubicc d1,1 + stwu a1,4(a6) + bge move_lazy_node_arguments + + baddi a6,4 + b skip_zero_bits + +move_lazy_node_1: + lwz a1,0(a0) + baddi a0,4 + cmplw 0,a1,a0 + blt move_lazy_node_1_ + if SHARE_CHAR_INT + cmplw 0,a1,d2 + bge move_lazy_node_1_ + endif + addi d0,a6,4+1 + lwz d1,0(a1) + stw d0,0(a1) + mr a1,d1 +move_lazy_node_1_: + stw a1,4(a6) +move_lazy_node_0: + baddi a6,12 + b skip_zero_bits + +move_closure_with_unboxed_arguments: + baddi d1,1 + srwi d0,d1,8 + beq move_closure_with_unboxed_arguments_1 + bandic d1,255 + bsubc d1,d0 + beq copy_non_pointers_of_closure + +move_pointers_in_closure: + lwz a1,0(a0) + baddi a0,4 + cmplw 6,a1,a0 + + bsubicc d1,1 + + blt 6,move_pointers_in_closure_ + if SHARE_CHAR_INT + cmplw 6,a1,d2 + bge 6,move_pointers_in_closure_ + endif + lwz o0,0(a1) + addi o1,a6,4+1 + stw o1,0(a1) + mr a1,o0 + +move_pointers_in_closure_: + stwu a1,4(a6) + bne move_pointers_in_closure + +copy_non_pointers_of_closure: + bsubicc d0,1 + + lwz d1,0(a0) + baddi a0,4 + stwu d1,4(a6) + + bne copy_non_pointers_of_closure + + baddi a6,4 + b skip_zero_bits + +move_closure_with_unboxed_arguments_1: + lwz d0,0(a0) + baddi a6,12 + stw d0,4-12(a6) + b skip_zero_bits + +end_compact_heap: + + if FINALIZERS + lea a0,finalizer_list + lwz a0,0(a0) + +restore_finalizer_descriptors: + lea o0,__Nil_m8 + cmplw o0,a0 + beq end_restore_finalizer_descriptors + + lea o0,e____system__kFinalizer_2 + stw o0,0(a0) + lwz a0,4(a0) + b restore_finalizer_descriptors + +end_restore_finalizer_descriptors: + endif diff --git a/pcopy.a b/pcopy.a new file mode 100644 index 0000000..fcf61c1 --- /dev/null +++ b/pcopy.a @@ -0,0 +1,1000 @@ + +NODE_POINTER_OFFSET set 0 + + lea o0,heap_p2 + lea o1,stack_p + lwz a6,0(o0) + lwz a2,0(o1) + + if COPIED_VECTOR + lea o0,heap_size_129 + lwz d7,0(o0) + lea o0,heap_p1 + slwi d7,d7,6 + lwz a3,0(o0) + else + lea o0,heap_size + lwz d7,0(o0) + srwi d7,d7,1 + endif + add o4,a6,d7 + + if WRITE_HEAP + lea o0,heap2_begin_and_end + stw o4,4(o0) + endif + + lea o0,caf_list + + if USE_DCBZ + li g3,32 + li o3,-32 + endif + lwz d0,0(o0) + cmpwi 0,d0,0 + beq end_copy_cafs + +copy_cafs_lp: + lwz o5,-4(d0) + lwz d5,0(d0) + addi a2,d0,4 + subi d5,d5,1 + bl copy_lp2 + + addic. d0,o5,0 + bne copy_cafs_lp + +end_copy_cafs: + + lea o0,stack_p + lwz a2,0(o0) + + sub d5,a4,a2 + subic. d5,d5,4 + srwi d5,d5,2 + + bgel copy_lp2 + + lea o0,heap_p2 + lwz a2,0(o0) + +; +; Copy all referenced nodes to the other semi space +; + + lea g2,copy_lp1 + +copy_lp1: + cmplw 0,a2,a6 + bge end_copy1 + + lwz d0,0(a2) + mtlr g2 + + baddi a2,4 + andi. o0,d0,2 + + lha d5,-2(d0) + + beq not_in_hnf_1 + +in_hnf_1: + cmpwi 0,d5,0 + beq copy_array_21 + + cmpwi 0,d5,2 + ble b_copy_lp2 + + cmplwi 0,d5,256 + bge copy_record_1 + + lwz o0,4(a2) + mr d6,d5 + + andi. r0,o0,1 + bne node_without_arguments_part + + li d5,0 + bl copy_lp2 + + mtlr g2 + + baddi a2,4 + subi d5,d6,2 + b copy_lp2 + +node_without_arguments_part: + clrrwi o0,o0,1 + stw o0,4(a2) + li d5,0 + bl copy_lp2 + + baddi a2,4 + b copy_lp1 + +copy_record_1: + subic. d5,d5,258 + bgt copy_record_arguments_3 + + lhz d5,-2+2(d0) + blt copy_record_arguments_1 + + subic. d5,d5,1 + bgt copy_lp2 + + beq- copy_node_arity1 + + baddi a2,8 + b copy_lp1 + +copy_record_arguments_1: + cmpwi d5,0 + li d5,0 + bne copy_lp2 + baddi a2,4 + b copy_lp1 + +copy_record_arguments_3: + if COPIED_VECTOR + lwz o1,4(a2) + andi. r0,o1,1 + lhz d1,-2+2(d0) + cmpwi 6,d1,0 + bne record_node_without_arguments_part + else + lhz d1,-2+2(d0) + cmpwi 6,,d1,0 + endif + baddi d5,2+1 + beq 6,copy_record_arguments_3b + + subic. d6,d1,1 + beq copy_record_arguments_3abb + + slwi d5,d5,2 + add d4,a2,d5 + + li d5,0 + bl copy_lp2 + + baddi a2,4 + subi d5,d6,1 + bl copy_lp2 + + mr a2,d4 + b copy_lp1 + +copy_record_arguments_3abb: + subi d5,d5,1 + slwi d6,d5,2 + li d5,0 + bl copy_lp2 + + add a2,a2,d6 + b copy_lp1 + +copy_record_arguments_3b: + slwi d5,d5,2 + add a2,a2,d5 + b copy_lp1 + + if COPIED_VECTOR +record_node_without_arguments_part: + clrrwi o1,o1,1 + stw o1,4(a2) + + baddi a2,8 + beq 6,copy_lp1 + + subi a2,a2,8 + li d5,0 + bl copy_lp2 + + baddi a2,4 + b copy_lp1 + endif + +not_in_hnf_1: + cmpwi 0,d5,257 + bge copy_unboxed_closure_arguments + + subic. d5,d5,1 + bgt copy_lp2 + +copy_node_arity1: + li d5,0 + bl copy_lp2 + + baddi a2,4 + b copy_lp1 + +copy_unboxed_closure_arguments: + srwi d4,d5,8 + rlwinm d5,d5,0,24,31 + + beq copy_unboxed_closure_arguments1 + + bsubc d5,d4 + bsubi d5,1 + bnel+ copy_lp2 + + slwi d4,d4,2 + badd a2,d4 + b copy_lp1 + +copy_unboxed_closure_arguments1: + baddi a2,8 + b copy_lp1 + +copy_array_21: + lwz d1,4(a2) + cmpwi 0,d1,0 + + lwz d5,0(a2) + baddi a2,8 + beq copy_array_21_a + + lhz d0,-2(d1) + subi d0,d0,256 + + lhz d1,-2+2(d1) + cmpwi 0,d1,0 + beq copy_array_21_b + + cmpw 0,d0,d1 + beq copy_array_21_r_a + +copy_array_21_ab: + subic. d5,d5,1 + blt copy_lp1 + + sub d0,d0,d1 + slwi d0,d0,2 + subi d1,d1,1 + + mr d6,d5 + stw d1,-4(sp) + stwu d0,-8(sp) + +copy_array_21_lp_ab: + lwz d5,4(sp) + bl copy_lp2 + + lwz o1,0(sp) + subic. d6,d6,1 + add a2,a2,o1 + bge copy_array_21_lp_ab + + baddi sp,8 + b copy_lp1 + +copy_array_21_b: + mullw d2,d5,d0 + slwi d2,d2,2 + add a2,a2,d2 + b copy_lp1 + +copy_array_21_r_a: + mullw d2,d5,d0 + mr d5,d2 +copy_array_21_a: + subic. d5,d5,1 + bge copy_lp2 + + b copy_lp1 + +; +; Copy root nodes to the other semi-space +; + +b_copy_lp2: + bsubi d5,1 +copy_lp2: + lwz a1,0(a2) + baddi a2,4 + + lwz d0,0-NODE_POINTER_OFFSET(a1) + bsubi d5,1 + +continue_after_selector_2: + andi. r0,d0,2 + beq not_in_hnf_2 + +in_hnf_2: lhz d2,-2(d0) + cmpwi 5,d5,0 + + cmpwi 0,d2,0 + beq copy_arity_0_node2 + + cmplwi 6,d2,256 + if NODE_POINTER_OFFSET==0 + stw a6,-4(a2) + endif + stw d0,0(a6) + bge 6,copy_record_2 + + subic. d2,d2,2 + lwz o0,4-NODE_POINTER_OFFSET(a1) + + addi a0,a6,1+NODE_POINTER_OFFSET + stw a0,0-NODE_POINTER_OFFSET(a1) + + blt copy_hnf_node2_1 + bgt copy_hnf_node2_3 + + lwz o1,8-NODE_POINTER_OFFSET(a1) + + stw o0,4(a6) + if NODE_POINTER_OFFSET==0 + stw o1,8(a6) + stw a6,-4(a2) + baddi a6,12 + else + stwu o1,8(a6) + stw a6,-4(a2) + baddi a6,4 + endif + bge 5,copy_lp2 + blr + +copy_hnf_node2_1: + stw o0,4(a6) + baddi a6,8 + if NODE_POINTER_OFFSET + stw a6,-4(a2) + endif + bge 5,copy_lp2 + blr + +copy_hnf_node2_3: + lwz a0,8-NODE_POINTER_OFFSET(a1) + baddi a6,12 + + stw o0,4-12(a6) + if NODE_POINTER_OFFSET + addi a1,a6,NODE_POINTER_OFFSET + endif + lwz d1,0-NODE_POINTER_OFFSET(a0) + + andi. r0,d1,1 + bne arguments_already_copied_2 + + if NODE_POINTER_OFFSET==0 + stw a6,-4(a6) + ori a1,a6,1 + stw d1,0(a6) + else + stwu a1,-4(a6) + ori a1,a1,1 + stw a6,-4(a2) + stwu d1,4(a6) + endif + stw a1,0-NODE_POINTER_OFFSET(a0) + +cp_hnf_arg_lp2: + if NODE_POINTER_OFFSET + lwz o0,4-NODE_POINTER_OFFSET(a0) + baddi a0,4 + else + lwzu o0,4(a0) + endif + subic. d2,d2,1 + stwu o0,4(a6) + bgt cp_hnf_arg_lp2 + + baddi a6,4 + + bge 5,copy_lp2 + blr + +arguments_already_copied_2: + stw d1,-4(a6) + if NODE_POINTER_OFFSET + addi a1,a6,-4 + stw a1,-4(a2) + endif + bge 5,copy_lp2 + blr + +copy_arity_0_node2: + cmplw d0,int_reg + blt copy_real_file_or_string_2 + + cmplw d0,char_reg + bgt copy_normal_hnf_0_2 + +copy_int_bool_or_char_2: + if SHARE_CHAR_INT + bne no_char_2 + + lbz d2,7-NODE_POINTER_OFFSET(a1) + if NODE_POINTER_OFFSET + lea a0,static_characters8 + else + lea a0,static_characters + endif + slwi d2,d2,3 + add a0,a0,d2 + stw a0,-4(a2) + + bge 5,copy_lp2 + blr + +no_char_2: + cmpw int_reg,d0 + lwz o0,4-NODE_POINTER_OFFSET(a1) + bne no_small_int_or_char_2 + + cmplwi 0,o0,33 + slwi d2,o0,3 + bge no_small_int_or_char_2 + + if NODE_POINTER_OFFSET + lea a0,small_integers8 + else + lea a0,small_integers + endif + add a0,a0,d2 + stw a0,-4(a2) + + bge 5,copy_lp2 + blr + +no_small_int_or_char_2: + else +no_small_int_or_char_2: + lwz o0,4-NODE_POINTER_OFFSET(a1) + endif + + if NODE_POINTER_OFFSET + ori d2,o4,1 + stw o4,-4(a2) + stw d2,0-NODE_POINTER_OFFSET(a1) + endif + + stwu d0,-8(o4) + stw o0,4(o4) + + if NODE_POINTER_OFFSET==0 + ori d2,o4,1 + stw o4,-4(a2) + stw d2,0-NODE_POINTER_OFFSET(a1) + endif + + bge 5,copy_lp2 + blr + +copy_normal_hnf_0_2: + subi a0,d0,2-ZERO_ARITY_DESCRIPTOR_OFFSET-NODE_POINTER_OFFSET + stw a0,-4(a2) + bge 5,copy_lp2 + blr + +copy_real_file_or_string_2: + lea o0,__STRING__2 + cmplw 0,d0,o0 + ble copy_string_or_array_2 + +copy_real_or_file_2: + if NODE_POINTER_OFFSET==0 + stwu d0,-12(o4) + lwz o0,4-NODE_POINTER_OFFSET(a1) + + addi d2,o4,1 + stw d2,0-NODE_POINTER_OFFSET(a1) + + lwz o1,8-NODE_POINTER_OFFSET(a1) + + stw o0,4(o4) + stw o1,8(o4) + stw o4,-4(a2) + else + lwz o1,8-NODE_POINTER_OFFSET(a1) + lwz o0,4-NODE_POINTER_OFFSET(a1) + stwu o1,-4(o4) + stw o4,-4(a2) + addi d2,o4,1 + stw d2,0-NODE_POINTER_OFFSET(a1) + stw o0,-4(o4) + stwu d0,-8(o4) + endif + bge 5,copy_lp2 + blr + +already_copied_2: + cmpwi 5,d5,0 +already_copied_2_: + subi d0,d0,1 + stw d0,-4(a2) + + bge 5,copy_lp2 + blr + +; to do: copy strict basic records to end of heap + +copy_record_2: + subic. d2,d2,258 + lwz o0,4-NODE_POINTER_OFFSET(a1) + + addi a0,a6,1+NODE_POINTER_OFFSET + stw a0,0-NODE_POINTER_OFFSET(a1) + + blt copy_record_node2_1 + bgt copy_record_node2_3 + + lwz o1,8-NODE_POINTER_OFFSET(a1) + + stw o0,4(a6) + if NODE_POINTER_OFFSET==0 + stw o1,8(a6) + baddi a6,12 + else + stwu o1,8(a6) + stw a6,-4(a2) + baddi a6,4 + endif + bge 5,copy_lp2 + blr + +copy_record_node2_1: + stw o0,4-NODE_POINTER_OFFSET(a6) + baddi a6,8 + if NODE_POINTER_OFFSET + stw a6,-4(a2) + endif + bge 5,copy_lp2 + blr + +copy_record_node2_3: + lwz a0,8-NODE_POINTER_OFFSET(a1) + stw o0,4(a6) + + if COPIED_VECTOR + lea a1,heap_copied_vector + sub d0,a0,a3 + lwz a1,0(a1) + + tstmbit a1,d0,d1,o0,o1,o2,3 + bne record_arguments_already_copied_2 + + li o0,128 + srw o0,o0,o2 + or o1,o1,o0 + stbx o1,a1,d1 + endif + if NODE_POINTER_OFFSET==0 + addi a1,a6,12 + stw a1,8(a6) + else + addi a1,a6,12+NODE_POINTER_OFFSET + stwu a1,8(a6) + stw a6,-4(a2) + endif + lwz o1,0-NODE_POINTER_OFFSET(a0) + addi a1,a1,1 + stw a1,0-NODE_POINTER_OFFSET(a0) + if NODE_POINTER_OFFSET==0 + stwu o1,12(a6) + else + stwu o1,4(a6) + endif + subi d2,d2,1 + +cp_record_arg_lp2: + if NODE_POINTER_OFFSET + lwz o1,4-NODE_POINTER_OFFSET(a0) + baddi a0,4 + else + lwzu o1,4(a0) + endif + subic. d2,d2,1 + stwu o1,4(a6) + bge cp_record_arg_lp2 + + addi a6,a6,4 + + bge 5,copy_lp2 + blr + + if COPIED_VECTOR +record_arguments_already_copied_2: + lwz o0,0-NODE_POINTER_OFFSET(a0) + if NODE_POINTER_OFFSET==0 + addi a6,a6,12 + + stw o0,-4(a6) + else + stwu o0,8(a6) + stw a6,-4(a2) + addi a6,a6,4 + endif + bge 5,copy_lp2 + blr + endif + +not_in_hnf_2: + andi. r0,d0,1 + bne- already_copied_2 + + lwz d2,-4-NODE_POINTER_OFFSET(d0) + cmpwi 5,d5,0 + + extsb. d2,d2 + beq copy_arity_0_node2_ + +copy_node2_1_: + subic. d2,d2,2 + blt copy_arity_1_node2 + +copy_node2_3: + if NODE_POINTER_OFFSET==0 + stw a6,-4(a2) + endif + stw d0,0(a6) + addi a0,a6,1+NODE_POINTER_OFFSET + stw a0,0-NODE_POINTER_OFFSET(a1) + lwzu o0,4-NODE_POINTER_OFFSET(a1) + if NODE_POINTER_OFFSET + addi o1,a6,8 + stw o1,-4(a2) + endif + stwu o0,4(a6) +cp_arg_lp2: + lwzu o0,4(a1) + subic. d2,d2,1 + stwu o0,4(a6) + bge cp_arg_lp2 + + addi a6,a6,4 + bge 5,copy_lp2 + blr + +copy_arity_1_node2: + cmpwi 0,d2,-1-2 + ble copy_selector_2 + +copy_arity_1_node2_: + if NODE_POINTER_OFFSET==0 + stw a6,-4(a2) + endif + lwz o0,4-NODE_POINTER_OFFSET(a1) + addi a0,a6,1+NODE_POINTER_OFFSET + stw a0,0-NODE_POINTER_OFFSET(a1) + if NODE_POINTER_OFFSET + addi o1,a6,8 + stw o1,-4(a2) + endif + stw d0,0(a6) + stw o0,4(a6) + addi a6,a6,12 + + bge 5,copy_lp2 + blr + +copy_indirection_2: + mr d1,a1 + lwz a1,4-NODE_POINTER_OFFSET(a1) + + lwz d0,0-NODE_POINTER_OFFSET(a1) + + andi. r0,d0,2 + bne in_hnf_2 + + andi. r0,d0,1 + bne already_copied_2_ + + lwz d2,-4(d0) + + extsb. d2,d2 + beq copy_arity_0_node2_ + + cmpwi 0,d2,-2 + bne copy_node2_1_ + +skip_indirections_2: + lwz a1,4-NODE_POINTER_OFFSET(a1) + lwz d0,0-NODE_POINTER_OFFSET(a1) + + andi. r0,d0,3 + bne update_indirection_list_2 + + lwz o0,-4(d0) + mr a0,d0 + cmpwi 0,o0,-2 + beq skip_indirections_2 + +update_indirection_list_2: + addi a0,d1,4 + lwz d1,0-NODE_POINTER_OFFSET(a0) + stw a1,0-NODE_POINTER_OFFSET(a0) + cmpw 0,a1,d1 + bne update_indirection_list_2 + + lwz d0,0-NODE_POINTER_OFFSET(a1) + b continue_after_selector_2 + +copy_selector_2: + cmpwi 0,d2,-2-2 + beq copy_indirection_2 + + mr a0,d0 + +; if no selectors +; b copy_arity_1_node2_ + + blt copy_record_selector_2 + + if LINUX + lwz d2,-8(a0) + else + lha d2,-6(a0) + endif + lwz a0,4-NODE_POINTER_OFFSET(a1) + lwz d1,0-NODE_POINTER_OFFSET(a0) + andi. r0,d1,2 + beq copy_arity_1_node2_ + + lha g1,-2(d1) + cmplwi 0,g1,2 + ble copy_selector_2_ + + lwz g1,8-NODE_POINTER_OFFSET(a0) + lwz g1,0-NODE_POINTER_OFFSET(g1) + andi. r0,g1,1 + bne copy_arity_1_node2_ + +copy_selector_2_: + if LINUX + else + lwzx d2,rtoc,d2 + endif + lwz g1,4(d2) + + mtctr g1 + + mr d2,a1 + + mflr r0 + stwu r0,-4(sp) + bctrl + mtlr r0 + + lea g1,__indirection + stw a0,4-NODE_POINTER_OFFSET(d2) + stw g1,0-NODE_POINTER_OFFSET(d2) + + mr a1,a0 + lwz d0,0-NODE_POINTER_OFFSET(a1) + b continue_after_selector_2 + +copy_record_selector_2: + cmpwi 0,d2,-2-3 + if LINUX + lwz d2,-8(a0) + else + lha d2,-6(a0) + endif + beq copy_strict_record_selector_2 + + lwz a0,4-NODE_POINTER_OFFSET(a1) + lwz d1,0-NODE_POINTER_OFFSET(a0) + andi. r0,d1,2 + beq copy_arity_1_node2_ + + lha g1,-2(d1) + cmplwi 0,g1,258 + ble copy_selector_2_ + + if COPIED_VECTOR + lea g1,heap_copied_vector + lwz g0,8-NODE_POINTER_OFFSET(a0) + lwz g1,0(g1) + sub g0,g0,a3 + + tstmbit g1,g0,d1,o0,o1,o2,3 + bne copy_arity_1_node2_ + endif + b copy_selector_2_ + +copy_strict_record_selector_2: + lwz a0,4-NODE_POINTER_OFFSET(a1) + lwz d1,0-NODE_POINTER_OFFSET(a0) + andi. r0,d1,2 + beq copy_arity_1_node2_ + + lha g1,-2(d1) + cmplwi 0,g1,258 + ble copy_strict_record_selector_2_ + + if COPIED_VECTOR + lea g1,heap_copied_vector + lwz g0,8-NODE_POINTER_OFFSET(a0) + lwz g1,0(g1) + sub g0,g0,a3 + + tstmbit g1,g0,d1,o0,o1,o2,3 + bne copy_arity_1_node2_ + endif + +copy_strict_record_selector_2_: + if LINUX + else + lwzx d2,rtoc,d2 + endif + mr d0,a1 + lwz g1,4(d2) + mr a1,a0 + mtctr g1 + + mr a0,d0 + + mflr r0 + stwu r0,-4(sp) + bctrl + mtlr r0 + + lwz d0,0-NODE_POINTER_OFFSET(a0) + mr a1,a0 + b in_hnf_2 + +copy_arity_0_node2_: + if NODE_POINTER_OFFSET==0 + stwu d0,-12(o4) + stw o4,-4(a2) + ori d2,o4,1 + else + addi o1,o4,-4 + stwu d0,-12(o4) + ori d2,o1,1 + stw o1,-4(a2) + endif + stw d2,0-NODE_POINTER_OFFSET(a1) + bge 5,copy_lp2 + blr + +copy_string_or_array_2: + bne copy_array_2 + + sub d1,a1,a3 + cmplw 0,d1,d7 + bge copy_string_constant + + lwz d2,4-NODE_POINTER_OFFSET(a1) + mr a0,a1 + + lwz o0,0-NODE_POINTER_OFFSET(a0) + addi d2,d2,3 + srwi d2,d2,2 + + slwi d1,d2,2 + subi a1,o4,8-NODE_POINTER_OFFSET + sub a1,a1,d1 + + stw a1,-4(a2) + ori d0,a1,1 + + subi o4,a1,NODE_POINTER_OFFSET + if NODE_POINTER_OFFSET + stwu d0,0-NODE_POINTER_OFFSET(a0) + stwu o0,0-NODE_POINTER_OFFSET(a1) + else + stw d0,0-NODE_POINTER_OFFSET(a0) + stw o0,0(a1) + endif + +cp_s_arg_lp2: + lwzu o0,4(a0) + subic. d2,d2,1 + stwu o0,4(a1) + bge cp_s_arg_lp2 + + bge 5,copy_lp2 + blr + +copy_string_constant: + stw a1,-4(a2) + bge 5,copy_lp2 + blr + +copy_array_2: + mr a0,a1 + + lwz d0,8-NODE_POINTER_OFFSET(a0) + lwz d2,4-NODE_POINTER_OFFSET(a0) + cmpwi 0,d0,0 + beq copy_array_a2 + + lhz d1,-2(d0) + cmpwi 0,d1,0 + beq copy_strict_basic_array_2 + + subi d0,d1,256 + mullw d2,d2,d0 + +copy_array_a2: + addi a1,a6,-NODE_POINTER_OFFSET + + slwi d1,d2,2 + add a6,a6,d1 + addi a6,a6,12 + + stw a1,-4(a2) + addi d0,a1,1 + + lwz o0,0-NODE_POINTER_OFFSET(a0) + if NODE_POINTER_OFFSET + stwu d0,0-NODE_POINTER_OFFSET(a0) + addi d2,d2,1 + stwu o0,0-NODE_POINTER_OFFSET(a1) + else + stw d0,0-NODE_POINTER_OFFSET(a0) + addi d2,d2,1 + stw o0,0(a1) + endif + b cp_s_arg_lp2 + +copy_strict_basic_array_2: + cmplw d0,int_reg + beq copy_int_array_2 + cmpw bool_reg,d0 + beq copy_bool_array_2 + add d2,d2,d2 +copy_int_array_2: + slwi d1,d2,2 + subi a1,o4,12-NODE_POINTER_OFFSET + + sub a1,a1,d1 + lwz o0,0-NODE_POINTER_OFFSET(a0) + + stw a1,-4(a2) + addi d0,a1,1 + + subi o4,a1,NODE_POINTER_OFFSET + if NODE_POINTER_OFFSET + stwu d0,0-NODE_POINTER_OFFSET(a0) + addi d2,d2,1 + stw o0,0-NODE_POINTER_OFFSET(a1) + else + stw d0,0-NODE_POINTER_OFFSET(a0) + addi d2,d2,1 + stw o0,0(a1) + endif + b cp_s_arg_lp2 + +copy_bool_array_2: + addi d2,d2,3 + srwi d2,d2,2 + b copy_int_array_2 + +end_copy1: + + if FINALIZERS + lea a0,finalizer_list + lea a1,free_finalizer_list + lwz a2,0(a0) + +determine_free_finalizers_after_copy: + lwz d0,0(a2) + andi. o0,d0,1 + beq finalizer_not_used_after_copy + + lwz a2,4(a2) + subi d0,d0,1 + stw d0,0(a0) + addi a0,d0,4 + b determine_free_finalizers_after_copy + +finalizer_not_used_after_copy: + lea o0,__Nil_m8 + cmplw a2,o0 + beq end_finalizers_after_copy + + stw a2,0(a1) + addi a1,a2,4 + lwz a2,4(a2) + b determine_free_finalizers_after_copy + +end_finalizers_after_copy: + stw a2,0(a0) + stw a2,0(a1) + endif diff --git a/pfileIO3.a b/pfileIO3.a new file mode 100644 index 0000000..8bf0571 --- /dev/null +++ b/pfileIO3.a @@ -0,0 +1,1428 @@ +; File: pfileIO3.s +; Copyright: University of Nijmegen +; Written by: John van Groningen +; Machine: Power Macintosh + + string asis + +MACOSX set 1 + +d0: set r24 +d1: set r25 +d2: set r26 +d3: set r27 +d4: set r28 +d5: set r29 +d6: set r30 +d7: set r31 +a0: set r23 +a1: set r22 +a2: set r21 +a3: set r20 +a4: set r19 +a5: set r18 +a6: set r17 + +o0: set r3 +o1: set r4 +o2: set r5 +o3: set r6 +o4: set r7 +o5: set r8 + +g0: set r11 +g1: set r12 +g2: set r13 +g3: set r14 +g4: set r15 +g5: set r16 + + include 'pmacros.a' + + csect data{RW} + align 3 +tmp_real: dc.d "0.0" +freadstring_error: + dc.b 'Error in freadsubstring parameters.' + dc.b 13,0 + dc.b 0,0,0 +fwritestring_error: + dc.b 'Error in fwritesubstring parameters.' + dc.b 13,0 + dc.b 0,0 + + csect text{PR} + + export stdioF + export stderrF + export openF + export closeF + export reopenF + export readFC + export readFI + export readFR + export readFS + export readFString + export readLineF + export writeFC + export writeFI + export writeFR + export writeFS + export writeFString + export __endF=>'endF' + export errorF + export positionF + export seekF + export shareF + + export openSF + export readSFC + export readSFI + export readSFR + export readSFS + export readLineSF + export endSF + export positionSF + export seekSF + + import collect_0 + import collect_1 + import __STRING__ + + csect .stdioF{PR} + import .open_stdio +stdioF: mflr r0 + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + stw r0,60(sp) + else + stw r0,-4(sp) + stwu sp,-64(sp) + endif + bl .open_stdio + lwz r0,60(sp) + if MACOSX + lwz sp,0(sp) + else + addi sp,sp,64 + endif + mtlr r0 + + mr d1,r3 + li d0,-1 + + lwz r0,0(sp) + addi sp,sp,4 + blr + + csect .stderrF{PR} + import .open_stderr +stderrF: mflr r0 + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + stw r0,60(sp) + else + stw r0,-4(sp) + stwu sp,-64(sp) + endif + bl .open_stderr + lwz r0,60(sp) + if MACOSX + lwz sp,0(sp) + else + addi sp,sp,64 + endif + mtlr r0 + + mr d1,r3 + li d0,-1 + + lwz r0,0(sp) + addi sp,sp,4 + blr + + csect .openF{PR} + import .open_file +openF: mr o1,d0 + addi o0,a0,4 + + mflr r0 + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + stw r0,60(sp) + else + stw r0,-4(sp) + stwu sp,-64(sp) + endif + bl .open_file + lwz r0,60(sp) + if MACOSX + lwz sp,0(sp) + else + addi sp,sp,64 + endif + mtlr r0 + + addic. d1,o0,0 + li d0,-1 + blt openF_1 + li d2,-1 + lwz r0,0(sp) + addi sp,sp,4 + blr + +openF_1: + li d2,0 + lwz r0,0(sp) + neg d1,d1 + addi sp,sp,4 + blr + + csect .closeF{PR} + import .close_file +closeF: mr o0,d1 + + mflr r0 + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + stw r0,60(sp) + else + stw r0,-4(sp) + stwu sp,-64(sp) + endif + bl .close_file + lwz r0,60(sp) + if MACOSX + lwz sp,0(sp) + else + addi sp,sp,64 + endif + mtlr r0 + + mr d0,o0 + + lwz r0,0(sp) + addi sp,sp,4 + blr + + csect .reopenF{PR} + import .re_open_file +reopenF: + mr o0,d2 + mr o1,d0 + + mflr r0 + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + stw r0,60(sp) + else + stw r0,-4(sp) + stwu sp,-64(sp) + endif + bl .re_open_file + lwz r0,60(sp) + if MACOSX + lwz sp,0(sp) + else + addi sp,sp,64 + endif + mtlr r0 + + mr d1,d2 + mr d2,o0 + li d0,-1 + + lwz r0,0(sp) + addi sp,sp,4 + blr + + csect .readFC{PR} + import .file_read_char +readFC: + mr o0,d1 + + mflr r0 + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + stw r0,60(sp) + else + stw r0,-4(sp) + stwu sp,-64(sp) + endif + bl .file_read_char + lwz r0,60(sp) + if MACOSX + lwz sp,0(sp) + else + addi sp,sp,64 + endif + mtlr r0 + + mr d2,o0 + cmpwi 0,o0,-1 + li d0,-1 + beq readFC_eof + + li d3,-1 + + lwz r0,0(sp) + addi sp,sp,4 + blr + +readFC_eof: + li d2,0 + li d3,0 + + lwz r0,0(sp) + addi sp,sp,4 + blr + + csect .readFI{PR} + import .file_read_int +readFI: + subi sp,sp,4 + mr o1,sp + mr o0,d1 + + mflr r0 + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + stw r0,60(sp) + else + stw r0,-4(sp) + stwu sp,-64(sp) + endif + bl .file_read_int + lwz r0,60(sp) + if MACOSX + lwz sp,0(sp) + else + addi sp,sp,64 + endif + mtlr r0 + + lwz d2,0(sp) + li d0,-1 + mr d3,o0 + lwz r0,4(sp) + addi sp,sp,8 + blr + + csect .readFR{PR} + import .file_read_real +readFR: + lea o1,tmp_real + mr o0,d1 + + mflr r0 + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + stw r0,60(sp) + else + stw r0,-4(sp) + stwu sp,-64(sp) + endif + bl .file_read_real + lwz r0,60(sp) + if MACOSX + lwz sp,0(sp) + else + addi sp,sp,64 + endif + mtlr r0 + + lea o1,tmp_real + mr d2,o0 + lfd f14,0(o1) + li d0,-1 + + lwz r0,0(sp) + addi sp,sp,4 + blr + + + + + + csect .readFString{PR} + import .file_read_characters + import print_error +readFString: + lwz d4,4(a0) + cmplw 0,d3,d4 + bge readFString_error + + sub o0,d4,d3 + cmplw 0,d2,o0 + bgt readFString_error + + addi o2,a0,8 + stwu d2,-4(sp) + add o2,o2,d3 + mr o1,sp + mr o0,d1 + + mflr r0 + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + stw r0,60(sp) + else + stw r0,-4(sp) + stwu sp,-64(sp) + endif + bl .file_read_characters + lwz r0,60(sp) + if MACOSX + lwz sp,0(sp) + else + addi sp,sp,64 + endif + mtlr r0 + + mr d2,o0 + li d0,-1 + + lwz r0,4(sp) + addi sp,sp,8 + blr + +readFString_error: + lea o0,freadstring_error + b print_error + + csect .readFS{PR} + if 0 + import .file_read_string + else + import .file_read_characters + endif +readFS: + addi d5,d0,8+3 + srwi d5,d5,2 + sub. d7,d7,d5 + blt readFS_gc +readFS_r_gc: + add d7,d7,d5 + mr d4,d2 + + lea o0,__STRING__2 + addi d3,a6,4 + stwu o0,4(a6) + if 0 + addi o2,a6,4 + mr o1,d0 + else + addi o2,a6,8 + stw d0,4(a6) + addi o1,a6,4 + endif + mr o0,d2 + + mflr r0 + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + stw r0,60(sp) + else + stw r0,-4(sp) + stwu sp,-64(sp) + endif + if 0 + bl .file_read_string + else + bl .file_read_characters + endif + lwz r0,60(sp) + if MACOSX + lwz sp,0(sp) + else + addi sp,sp,64 + endif + mtlr r0 + +readFS_end: + addi d0,o0,3 + clrrwi d0,d0,2 + addi a6,a6,4 + add a6,a6,d0 + srwi d0,d0,2 + baddi d0,2 + bsub d7,d0 + + mr a0,d3 + mr d1,d4 + li d0,-1 + + lwz r0,0(sp) + addi sp,sp,4 + blr + +readFS_gc: + mflr r0 + bl collect_0 + b readFS_r_gc + + csect .readLineF{PR} + import .file_read_line +readLineF: + li d5,32+2 + cmpw 0,d7,d5 + blt readLineF_gc + +readLineF_r_gc: + mr d4,d1 + + lea o0,__STRING__2 + addi d3,a6,4 + stwu o0,4(a6) + + addi o2,a6,8 + subi o1,d7,2 + slwi o1,o1,2 + mr o0,d4 + + mflr r0 + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + stw r0,60(sp) + else + stw r0,-4(sp) + stwu sp,-64(sp) + endif + bl .file_read_line + lwz r0,60(sp) + if MACOSX + lwz sp,0(sp) + else + addi sp,sp,64 + endif + mtlr r0 + + addic. d0,o0,0 + stw d0,4(a6) + bge readFS_end + + subi d0,d7,2 + slwi d0,d0,2 + stwu d0,4(a6) + +readLineF_lp: + add a6,a6,d0 + + lwz d5,4(d3) + mr a0,d3 + srwi d5,d5,2 + addi d5,d5,2+32 + neg d7,d5 + + mflr r0 + bl collect_1 + + mr a1,a0 + add d7,d7,d5 + lwzu d0,4(a1) + addi d1,d0,3 + srwi d1,d1,2 + subi d7,d7,2 + sub d7,d7,d1 + + lea o0,__STRING__2 + subic. d1,d1,1 + + addi d3,a6,4 + stw o0,4(a6) + stwu d0,8(a6) + blt end_copy_string1 + +copy_st_lp1: + lwzu g1,4(a1) + subic. d1,d1,1 + stwu g1,4(a6) + bge copy_st_lp1 +end_copy_string1: + + addi o2,a6,4 + slwi o1,d7,2 + mr o0,d4 + + mflr r0 + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + stw r0,60(sp) + else + stw r0,-4(sp) + stwu sp,-64(sp) + endif + bl .file_read_line + lwz r0,60(sp) + if MACOSX + lwz sp,0(sp) + else + addi sp,sp,64 + endif + mtlr r0 + + addic. d0,o0,0 + lwz g1,4(d3) + blt readLineF_again + + mr a0,d3 + add g1,g1,d0 + stw g1,4(d3) + + addi d1,d0,3 + srwi d1,d1,2 + sub d7,d7,d1 + slwi d1,d1,2 + add a6,a6,d1 + + mr d1,d4 + li d0,-1 + + lwz r0,0(sp) + addi sp,sp,4 + blr + +readLineF_gc: + sub d7,d7,d5 + mflr r0 + bl collect_0 + add d7,d7,d5 + b readLineF_r_gc + +readLineF_again: + slwi d0,d7,2 + add g1,g1,d0 + stw g1,4(d3) + b readLineF_lp + + csect .writeFC{PR} + import .file_write_char +writeFC: + mr o1,d1 + mr o0,d2 + + mflr r0 + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + stw r0,60(sp) + else + stw r0,-4(sp) + stwu sp,-64(sp) + endif + bl .file_write_char + lwz r0,60(sp) + if MACOSX + lwz sp,0(sp) + else + addi sp,sp,64 + endif + mtlr r0 + + li d0,-1 + + lwz r0,0(sp) + addi sp,sp,4 + blr + + csect .writeFI{PR} + import .file_write_int +writeFI: + mr o1,d1 + mr o0,d2 + + mflr r0 + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + stw r0,60(sp) + else + stw r0,-4(sp) + stwu sp,-64(sp) + endif + bl .file_write_int + lwz r0,60(sp) + if MACOSX + lwz sp,0(sp) + else + addi sp,sp,64 + endif + mtlr r0 + + li d0,-1 + + lwz r0,0(sp) + addi sp,sp,4 + blr + + csect .writeFR{PR} + import .file_write_real +writeFR: + mr o2,d1 + fmr f1,f14 + + mflr r0 + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + stw r0,60(sp) + else + stw r0,-4(sp) + stwu sp,-64(sp) + endif + bl .file_write_real + lwz r0,60(sp) + if MACOSX + lwz sp,0(sp) + else + addi sp,sp,64 + endif + mtlr r0 + + li d0,-1 + + lwz r0,0(sp) + addi sp,sp,4 + blr + + csect .writeFS{PR} + if 0 + import .file_write_string + else + import .file_write_characters + endif +writeFS: + if 0 + mr o1,d1 + addi o0,a0,4 + else + lwz o1,4(a0) + mr o2,d1 + addi o0,a0,8 + endif + mflr r0 + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + stw r0,60(sp) + else + stw r0,-4(sp) + stwu sp,-64(sp) + endif + if 0 + bl .file_write_string + else + bl .file_write_characters + endif + lwz r0,60(sp) + if MACOSX + lwz sp,0(sp) + else + addi sp,sp,64 + endif + mtlr r0 + + li d0,-1 + + lwz r0,0(sp) + addi sp,sp,4 + blr + + if 1 + csect .writeFString{PR} + import .file_write_characters + import print_error +writeFString: + lwz d4,4(a0) + cmplw 0,d3,d4 + bge writeFString_error + + sub o0,d4,d3 + cmplw 0,d2,o0 + bgt writeFString_error + + mr o2,d1 + addi o0,a0,8 + mr o1,d2 + add o0,o0,d3 + + mflr r0 + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + stw r0,60(sp) + else + stw r0,-4(sp) + stwu sp,-64(sp) + endif + bl .file_write_characters + lwz r0,60(sp) + if MACOSX + lwz sp,0(sp) + else + addi sp,sp,64 + endif + mtlr r0 + + li d0,-1 + + lwz r0,0(sp) + addi sp,sp,4 + blr + +writeFString_error: + lea o0,fwritestring_error + b print_error + endif + + csect .__endF{PR} + import .file_end +__endF: + mr o0,d1 + + mflr r0 + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + stw r0,60(sp) + else + stw r0,-4(sp) + stwu sp,-64(sp) + endif + bl .file_end + lwz r0,60(sp) + if MACOSX + lwz sp,0(sp) + else + addi sp,sp,64 + endif + mtlr r0 + + li d0,-1 + mr d2,o0 + + lwz r0,0(sp) + addi sp,sp,4 + blr + + csect .errorF{PR} + import .file_error +errorF: + mr o0,d1 + + mflr r0 + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + stw r0,60(sp) + else + stw r0,-4(sp) + stwu sp,-64(sp) + endif + bl .file_error + lwz r0,60(sp) + if MACOSX + lwz sp,0(sp) + else + addi sp,sp,64 + endif + mtlr r0 + + mr d2,o0 + li d0,-1 + + lwz r0,0(sp) + addi sp,sp,4 + blr + + csect .positionF{PR} + import .file_position +positionF: + mr o0,d1 + + mflr r0 + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + stw r0,60(sp) + else + stw r0,-4(sp) + stwu sp,-64(sp) + endif + bl .file_position + lwz r0,60(sp) + if MACOSX + lwz sp,0(sp) + else + addi sp,sp,64 + endif + mtlr r0 + + mr d2,o0 + li d0,-1 + + lwz r0,0(sp) + addi sp,sp,4 + blr + + csect .seekF{PR} + import .file_seek +seekF: + mr o2,d0 + mr o1,d1 + mr o0,d3 + mr d1,d3 + + mflr r0 + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + stw r0,60(sp) + else + stw r0,-4(sp) + stwu sp,-64(sp) + endif + bl .file_seek + lwz r0,60(sp) + if MACOSX + lwz sp,0(sp) + else + addi sp,sp,64 + endif + mtlr r0 + + mr d2,o0 + li d0,-1 + + lwz r0,0(sp) + addi sp,sp,4 + blr + + csect .shareF{PR} + import .file_share +shareF: + mr o0,d1 + + mflr r0 + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + stw r0,60(sp) + else + stw r0,-4(sp) + stwu sp,-64(sp) + endif + bl .file_share + lwz r0,60(sp) + if MACOSX + lwz sp,0(sp) + else + addi sp,sp,64 + endif + mtlr r0 + + li d0,-1 + + lwz r0,0(sp) + addi sp,sp,4 + blr + + csect .openSF{PR} + import .open_s_file +openSF: + mr o1,d0 + addi o0,a0,4 + + mflr r0 + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + stw r0,60(sp) + else + stw r0,-4(sp) + stwu sp,-64(sp) + endif + bl .open_s_file + lwz r0,60(sp) + if MACOSX + lwz sp,0(sp) + else + addi sp,sp,64 + endif + mtlr r0 + + addic. d1,o0,0 + li d0,0 + blt openSF_1 + li d2,-1 + lwz r0,0(sp) + addi sp,sp,4 + blr + +openSF_1: + li d2,0 + lwz r0,0(sp) + neg d1,d1 + addi sp,sp,4 + blr + + csect .readSFC{PR} + import .file_read_s_char +readSFC: + stwu d0,-4(sp) + mr o1,sp + mr o0,d1 + + mflr r0 + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + stw r0,60(sp) + else + stw r0,-4(sp) + stwu sp,-64(sp) + endif + bl .file_read_s_char + lwz r0,60(sp) + if MACOSX + lwz sp,0(sp) + else + addi sp,sp,64 + endif + mtlr r0 + + mr d2,o0 + cmpwi 0,o0,-1 + lwz d0,0(sp) + beq readSFC_eof + + li d3,-1 + lwz r0,4(sp) + addi sp,sp,8 + blr + +readSFC_eof: + li d2,0 + li d3,0 + lwz r0,4(sp) + addi sp,sp,8 + blr + + csect .readSFI{PR} + import .file_read_s_int +readSFI: + stwu d0,-4(sp) + mr o2,sp + subi sp,sp,4 + mr o1,sp + mr o0,d1 + + mflr r0 + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + stw r0,60(sp) + else + stw r0,-4(sp) + stwu sp,-64(sp) + endif + bl .file_read_s_int + lwz r0,60(sp) + if MACOSX + lwz sp,0(sp) + else + addi sp,sp,64 + endif + mtlr r0 + + lwz d2,0(sp) + lwz d0,4(sp) + mr d3,o0 + + lwz r0,8(sp) + addi sp,sp,12 + blr + + csect .readSFR{PR} + import .file_read_s_real +readSFR: + stwu d0,-4(sp) + mr o2,sp + lea o1,tmp_real + mr o0,d1 + + mflr r0 + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + stw r0,60(sp) + else + stw r0,-4(sp) + stwu sp,-64(sp) + endif + bl .file_read_s_real + lwz r0,60(sp) + if MACOSX + lwz sp,0(sp) + else + addi sp,sp,64 + endif + mtlr r0 + + lea g1,tmp_real + lwz d0,0(sp) + lfd f14,0(g1) + mr d2,o0 + lwz r0,4(sp) + addi sp,sp,8 + blr + + csect .readSFS{PR} + import .file_read_s_string +readSFS: + addi d5,d0,8+3 + srwi d5,d5,2 + sub. d7,d7,d5 + blt readSFS_gc +readSFS_r_gc: + add d7,d7,d5 + mr d4,d2 + + lea o0,__STRING__2 + addi d3,a6,4 + stwu o0,4(a6) + + stwu d1,-4(sp) + mr o3,sp + addi o2,a6,4 + mr o1,d0 + mr o0,d2 + + mflr r0 + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + stw r0,60(sp) + else + stw r0,-4(sp) + stwu sp,-64(sp) + endif + bl .file_read_s_string + lwz r0,60(sp) + if MACOSX + lwz sp,0(sp) + else + addi sp,sp,64 + endif + mtlr r0 + +readSFS_end: + addi d0,d0,3 + clrrwi d0,d0,2 + addi a6,a6,4 + add a6,a6,d0 + srwi d0,d0,2 + baddi d0,2 + bsub d7,d0 + + mr a0,d3 + mr d1,d4 + lwz d0,0(sp) + lwz r0,4(sp) + addi sp,sp,8 + blr + +readSFS_gc: + mflr r0 + bl collect_0 + b readSFS_r_gc + + csect .readLineSF{PR} + import .file_read_s_line +readLineSF: + li d5,32+2 + cmpw 0,d7,d5 + blt readLineSF_gc + +readLineSF_r_gc: + stwu d0,-4(sp) + mr d4,d1 + + lea o0,__STRING__2 + addi d3,a6,4 + stwu o0,4(a6) + + mr o3,sp + addi o2,a6,8 + subi o1,d7,2 + slwi o1,o1,2 + mr o0,d4 + + mflr r0 + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + stw r0,60(sp) + else + stw r0,-4(sp) + stwu sp,-64(sp) + endif + bl .file_read_s_line + lwz r0,60(sp) + if MACOSX + lwz sp,0(sp) + else + addi sp,sp,64 + endif + mtlr r0 + + addic. d0,o0,0 + stw d0,4(a6) + bge readSFS_end + + subi d0,d7,2 + slwi d0,d0,2 + stwu d0,4(a6) + +readLineSF_lp: + add a6,a6,d0 + + lwz d5,4(d3) + mr a0,d3 + srwi d5,d5,2 + addi d5,d5,2+32 + neg d7,d5 + + mflr r0 + bl collect_1 + + mr a1,a0 + add d7,d7,d5 + lwzu d0,4(a1) + addi d1,d0,3 + srwi d1,d1,2 + subi d7,d7,2 + sub d7,d7,d1 + + lea o0,__STRING__2 + subic. d1,d1,1 + + addi d3,a6,4 + stw o0,4(a6) + stwu d0,8(a6) + blt end_copy_string2 + +copy_st_lp2: + lwzu g1,4(a1) + subic. d1,d1,1 + stwu g1,4(a6) + bge copy_st_lp2 +end_copy_string2: + + mr o3,sp + addi o2,a6,4 + slwi o1,d7,2 + mr o0,d4 + + mflr r0 + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + stw r0,60(sp) + else + stw r0,-4(sp) + stwu sp,-64(sp) + endif + bl .file_read_s_line + lwz r0,60(sp) + if MACOSX + lwz sp,0(sp) + else + addi sp,sp,64 + endif + mtlr r0 + + addic. d0,o0,0 + lwz g1,4(d3) + blt readLineSF_again + + mr a0,d3 + add g1,g1,d0 + stw g1,4(d3) + + addi d1,d0,3 + srwi d1,d1,2 + sub d7,d7,d1 + slwi d1,d1,2 + add a6,a6,d1 + + lwz d0,0(sp) + mr d1,d4 + lwz r0,4(sp) + addi sp,sp,8 + blr + +readLineSF_gc: + sub d7,d7,d5 + mflr r0 + bl collect_0 + add d7,d7,d5 + b readLineSF_r_gc + +readLineSF_again: + slwi d0,d7,2 + add g1,g1,d0 + stw g1,4(d3) + b readLineSF_lp + + csect .endSF{PR} + import .file_s_end +endSF: + mr o1,d0 + mr o0,d1 + + mflr r0 + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + stw r0,60(sp) + else + stw r0,-4(sp) + stwu sp,-64(sp) + endif + bl .file_s_end + lwz r0,60(sp) + if MACOSX + lwz sp,0(sp) + else + addi sp,sp,64 + endif + mtlr r0 + + mr d0,o0 + + lwz r0,0(sp) + addi sp,sp,4 + blr + + csect .positionSF{PR} + import .file_s_position +positionSF: + mr o1,d0 + mr o0,d1 + + mflr r0 + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + stw r0,60(sp) + else + stw r0,-4(sp) + stwu sp,-64(sp) + endif + bl .file_s_position + lwz r0,60(sp) + if MACOSX + lwz sp,0(sp) + else + addi sp,sp,64 + endif + mtlr r0 + + mr d0,o0 + + lwz r0,0(sp) + addi sp,sp,4 + blr + + csect .seekSF{PR} + import .file_s_seek +seekSF: + stwu d2,-4(sp) + mr o3,sp + + mr o2,d0 + mr o1,d1 + mr o0,d3 + mr d1,d3 + + mflr r0 + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + stw r0,60(sp) + else + stw r0,-4(sp) + stwu sp,-64(sp) + endif + bl .file_s_seek + lwz r0,60(sp) + if MACOSX + lwz sp,0(sp) + else + addi sp,sp,64 + endif + mtlr r0 + + lwz d0,0(sp) + mr d2,o0 + + lwz r0,4(sp) + addi sp,sp,8 + blr + + macro + te &address + tc &address{TC},&address + endm + + toc + + te tmp_real + te freadstring_error + te fwritestring_error + tc __STRING__2{TC},__STRING__+2 diff --git a/pmacros.a b/pmacros.a new file mode 100644 index 0000000..f18e8af --- /dev/null +++ b/pmacros.a @@ -0,0 +1,54 @@ + macro + lea &r,&a + lwz &r,&a{TC}(RTOC) + endm + + macro + tst &r + cmpwi 0,&r,0 + endm + + macro + badd &rd,&rs + add &rd,&rd,&rs + endm + + macro + baddi &rd,&i + addi &rd,&rd,&i + endm + + macro + baddicc &r,&i + addic. &r,&r,&i + endm + + macro + bandic &r,&i + andi. &r,&r,&i + endm + + macro + bsub &rd,&rs + sub &rd,&rd,&rs + endm + + macro + bsubc &rd,&rs + sub. &rd,&rd,&rs + endm + + macro + bsubi &r,&i + subi &r,&r,&i + endm + + macro + bsubicc &r,&i + subic. &r,&r,&i + endm + + macro + bor &rd,&rs + or &rd,&rd,&rs + endm diff --git a/pmark.a b/pmark.a new file mode 100644 index 0000000..99272cd --- /dev/null +++ b/pmark.a @@ -0,0 +1,2316 @@ + +COUNT_GARBAGE_COLLECTIONS set 0 +MARK_USING_REVERSAL set 0 +REMOVE_INDIRECTION_LISTS set 0 + + if 0 + subi sp,sp,256 + stmw r3,68(sp) + mflr r3 + stw r3,64(sp) + bl .Debugger + nop + lwz r3,64(sp) + mtlr r3 + lmw r3,68(sp) + baddi sp,256 + endif + + lea d7,heap_size_33 + lea o0,lazy_array_list + lwz d7,0(d7) + li d4,0 + stw d4,0(o0) + + lis g3,32768 + + subi a3,sp,2000 + + lea d0,caf_list + slwi d7,d7,5 + lwz d0,0(d0) + + stwu a4,-4(sp) + + tst d0 + beq _end_mark_cafs + +_mark_cafs_lp: + lwz d1,0(d0) + lwz o5,-4(d0) + addi a2,d0,4 + slwi d0,d1,2 + add a4,a2,d0 + bl _mark_stack_nodes + + addic. d0,o5,0 + bne _mark_cafs_lp + +_end_mark_cafs: + lea a2,stack_p + lwz a4,0(sp) + lwz a2,0(a2) + baddi sp,4 + + bl _mark_stack_nodes + + lea a0,lazy_array_list + lwz a0,0(a0) + + tst a0 + beq end_restore_arrays + +restore_arrays: + lwz d3,0(a0) ; size + lwz d1,4(a0) ; second last element + cmplwi 0,d3,1 + + lea o0,__ARRAY__2 + lwz d2,8(a0) ; last element + stw o0,0(a0) + beq restore_array_size_1 + + slwi a1,d3,2 + add a1,a0,a1 + + lwz d0,8(a1) ; descriptor + + tst d0 + beq restore_lazy_array + + lhz o0,-2+2(d0) + divwu d3,d3,o0 + +restore_lazy_array: + stw d3,4(a0) + lwz a3,4(a1) ; next + stw d0,8(a0) + + stw d1,4(a1) + stw d2,8(a1) + + tst d0 + beq no_reorder_array + + lhz o1,-2(d0) + subi o1,o1,256 + cmpw 0,o1,o0 + beq no_reorder_array + + mr d0,o1 + mr d1,o0 + slwi d3,d3,2 + mullw d3,d3,d0 + baddi a0,12 + add a1,a0,d3 + sub d0,d0,d1 + + mr g1,d4 + + bl reorder + + mr d4,g1 + +no_reorder_array: + addic. a0,a3,0 + bne restore_arrays + + b end_restore_arrays + +restore_array_size_1: + stw d3,4(a0) + lwz a3,12(a0) ; descriptor + + stw d1,12(a0) + stw a3,8(a0) + + addic. a0,d2,0 + bne restore_arrays + +end_restore_arrays: + + if FINALIZERS + lea a0,finalizer_list + lea a1,free_finalizer_list + + lwz a2,0(a0) +determine_free_finalizers_after_mark: + lea o0,__Nil_m8 + cmplw o0,a2 + beq end_finalizers_after_mark + + sub d1,a2,d6 + rlwinm o0,d1,32-5,5,29 + lwzx o1,o4,o0 + rlwinm d1,d1,32-2,27,31 + rlwnm. r0,o1,d1,0,0 + beq finalizer_not_used_after_mark + + addi a0,a2,4 + lwz a2,4(a2) + b determine_free_finalizers_after_mark + +finalizer_not_used_after_mark: + stw a2,0(a1) + addi a1,a2,4 + + lwz a2,4(a2) + stw a2,0(a0) + b determine_free_finalizers_after_mark + +end_finalizers_after_mark: + stw a2,0(a1) + endif + + stwu o4,-4(sp) + + bl .add_garbage_collect_time + + lwz o4,0(sp) + baddi sp,4 + + if ADJUST_HEAP_SIZE + lea o0,bit_vector_size + lea d2,alloc_size + lwz d0,0(o0) + else + lea o0,heap_size_33 + lea d2,alloc_size + lwz d0,0(o0) + slwi d0,d0,3 + endif + lwz d2,0(d2) + slwi d4,d4,2 + slwi d2,d2,2 + add d2,d2,d4 + + if ADJUST_HEAP_SIZE + lea d1,heap_size_multiple + slwi o1,d0,2 + lwz o2,0(d1) + + mullw d1,d2,o2 + mulhwu o2,d2,o2 + srwi d1,d1,8 + rlwimi d1,o2,32-8,0,7 + srwi. o2,o2,8 + beq+ not_largest_heap + + lea d1,heap_size_33 + lwz d1,0(d1) + slwi d1,d1,5 + +not_largest_heap: + cmpw d1,o1 + ble no_larger_heap + + lea o1,heap_size_33 + lwz o1,0(o1) + slwi o1,o1,5 + cmpw d1,o1 + ble not_larger_then_heap + mr d1,o1 +not_larger_then_heap: + srwi d0,d1,2 + stw d0,0(o0) +no_larger_heap: + endif + + andi. r0,d0,31 + + srwi d5,d0,5 + + beq no_extra_word + + rlwinm d1,d0,32-3,3,29 + li g0,0 + stwx g0,o4,d1 + +no_extra_word: + + lea o0,last_heap_free + slwi d0,d0,2 + sub d0,d0,d4 + stw d0,0(o0) + + if COUNT_GARBAGE_COLLECTIONS + lea o1,n_garbage_collections + lwz o2,0(o1) + addi o2,o2,1 + endif + lea o0,flags + lwz o0,0(o0) + andi. r0,o0,2 + if COUNT_GARBAGE_COLLECTIONS + stw o2,0(o1) + endif + beq+ _no_heap_use_message2 + + stwu o4,-4(sp) + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + else + stwu sp,-64(sp) + endif + + lea o0,marked_gc_string_1 + if STDERR_TO_FILE + bl .er_print_string + else + bl .ew_print_string + endif + + mr o0,d4 + if STDERR_TO_FILE + bl .er_print_int + else + bl .ew_print_int + endif + lea o0,heap_use_after_gc_string_2 + if STDERR_TO_FILE + bl .er_print_string + else + bl .ew_print_string + endif + + if MACOSX + lwz sp,0(sp) + lwzu o4,0(sp) + else + lwzu o4,64(sp) + endif + baddi sp,4 + +_no_heap_use_message2: + if FINALIZERS + bl call_finalizers + lea o4,heap_vector + lwz o4,0(o4) + endif + lea d2,alloc_size + + mtctr d5 + + lwz d2,0(d2) + mr a0,o4 + + lea o0,free_after_mark + li g0,0 + stw g0,0(o0) + +_scan_bits: + lwz o0,0(a0) + baddi a0,4 + cmpwi o0,0 + beq _zero_bits + stw g0,-4(a0) + bdnz _scan_bits + + b _end_scan + +_zero_bits: + mr a1,a0 + bdnz _skip_zero_bits_lp+4 + b _end_bits + +_skip_zero_bits_lp: + bne _end_zero_bits + lwz d1,0(a0) + baddi a0,4 + tst d1 + bdnz _skip_zero_bits_lp + + beq _end_bits + stw g0,-4(a0) + sub d1,a0,a1 + b _end_bits2 + +_end_zero_bits: + lea o0,free_after_mark + + sub d1,a0,a1 + slwi d1,d1,3 + + cmplw 0,d1,d2 + + lwz o1,0(o0) + stw g0,-4(a0) + + add o1,o1,d1 + stw o1,0(o0) + blt _scan_bits + +_found_free_memory: + mfctr d0 + lea o0,bit_counter + lea o1,bit_vector_p + stw d0,0(o0) + stw a0,0(o1) + + sub d7,d1,d2 + + subi d0,a1,4 + sub d0,d0,o4 + slwi d0,d0,5 + add a6,d0,d6 + + slwi d1,d1,2 + lea o0,heap_end_after_gc + add d0,a6,d1 + stw d0,0(o0) + + lwz d0,0(sp) + lwz d1,4(sp) + lwz d2,8(sp) + lwz d3,12(sp) + lwz d4,16(sp) + lwz d5,20(sp) + lwz d6,24(sp) + + lwz r0,28(sp) + mtlr r0 + + subi a6,a6,4 + baddi sp,32 + blr + +_end_bits: + sub d1,a0,a1 + baddi d1,4 +_end_bits2: + lea o0,free_after_mark + + slwi d1,d1,3 + + lwz o1,0(o0) + cmplw 0,d1,d2 + + add o1,o1,d1 + stw o1,0(o0) + bge _found_free_memory + +_end_scan: + lea o0,bit_counter + mfctr d0 + stw d0,0(o0) + b compact_gc + + + csect .mark_gc + export _mark_stack_nodes + +; a0,a1,a2,a3,a4 +; d0,d1,d2,d3,d4,d5,d6,d7 +; o0,o1,o2,o3,o4,o5 +; g0,g1,g2 + +; g3 = 0x80000000 + +; o3 = bit mask +; o4 = heap_vector +; o5 = next_caf + +; d3,d5 = used during pointer reversal +; d4 = n_marked_words +; d6 = heap_p3 +; d7 = 32*heap_size_33 + +; a2 = pointer to next node on stack +; a3 = end_stack +; a4 = end_vector + +; a5 = not used, __cycle__in__spine +; a6 = not used, hp + +_mark_stack_nodes: + cmpw a4,a2 + beqlr + +_mark_stack_nodes_: + lwz a0,0(a2) + addi a2,a2,4 + + sub d1,a0,d6 + if SHARE_CHAR_INT + cmplw d1,d7 + bge- _mark_stack_nodes + endif + + rlwinm o0,d1,32-5,5,29 + lwzx o1,o4,o0 + rlwinm d1,d1,32-2,27,31 + rlwnm. r0,o1,d1,0,0 + bne- _mark_stack_nodes + + if MARK_USING_REVERSAL + addi o0,a2,-4 + stwu o0,-4(sp) + li d3,0 + li d5,1 + b __mark__node + +_mark_next_node: + b _mark_stack_nodes + + else + li g0,0 + stwu g0,-4(sp) + + b _mark_arguments + +_mark_hnf_2: + cmplwi 0,o3,4 + bor o1,o3 + stwx o1,o4,o0 + bge+ fits_in_word_6 + + baddi o0,4 + lwzx o1,o4,o0 + bor o1,g3 + stwx o1,o4,o0 + +fits_in_word_6: + baddi d4,3 + +_mark_record_2_c: + lwz o0,4-NODE_POINTER_OFFSET(a0) + cmplw 0,sp,a3 + + stwu o0,-4(sp) + blt __mark_using_reversal + +_mark_node2: + lwz a0,0-NODE_POINTER_OFFSET(a0) + +_mark_node: + sub d1,a0,d6 + if SHARE_CHAR_INT + cmplw d1,d7 + bge _mark_next_node + endif + rlwinm o0,d1,32-5,5,29 + lwzx o1,o4,o0 + rlwinm d1,d1,32-2,27,31 + rlwnm. r0,o1,d1,0,0 + bne _mark_next_node + +_mark_arguments: + lwz d0,0-NODE_POINTER_OFFSET(a0) + + srw o3,g3,d1 + + andi. r0,d0,2 + lha d2,-2(d0) + beq _mark_lazy_node + +_no_mark_lazy_node: + tst d2 + beq _mark_hnf_0 + + cmplwi 0,d2,256 + baddi a0,4 + bge _mark_record + + subic. d2,d2,2 + beq _mark_hnf_2 + blt _mark_hnf_1 + +_mark_hnf_3: + cmplwi 0,o3,4 + + lwz a1,4-NODE_POINTER_OFFSET(a0) + bor o1,o3 + stwx o1,o4,o0 + + bge+ fits_in_word_1 + + baddi o0,4 + lwzx o1,o4,o0 + bor o1,g3 + stwx o1,o4,o0 + +fits_in_word_1: + sub d0,a1,d6 + + rlwinm o0,d0,32-5,5,29 + lwzx o1,o4,o0 + rlwinm d0,d0,32-2,27,31 + srw o3,g3,d0 + + and. r0,o1,o3 + baddi d4,3 + bne _shared_argument_part + + if 0 + srwi o2,a0,6 + srwi g1,a1,6 + cmpw g1,o2 + lea o2,page_hit_counters + beq same_cache_line_1 + baddi o2,4 +same_cache_line_1: + lwz g1,0(o2) + baddi g1,1 + stw g1,0(o2) + endif + +_no_shared_argument_part: + slwi o2,d2,2 + add a1,a1,o2 + + addi d2,d2,1 + + add o2,d0,d2 + cmplwi 0,o2,32 + + add d4,d4,d2 + + bor o1,o3 + stwx o1,o4,o0 + ble+ fits_in_word_2 + + baddi o0,4 + lwzx o1,o4,o0 + bor o1,g3 + stwx o1,o4,o0 + +fits_in_word_2: + if NODE_POINTER_OFFSET + lwzu o0,0-NODE_POINTER_OFFSET(a1) + else + lwz o0,0-NODE_POINTER_OFFSET(a1) + endif + subi d2,d2,2 + stwu o0,-4(sp) + +_push_hnf_args: + cmplw 6,sp,a3 + +_push_hnf_args_lp: + lwzu o0,-4(a1) + subic. d2,d2,1 + stwu o0,-4(sp) + bge _push_hnf_args_lp + + bge 6,_mark_node2 + + b __mark_using_reversal + +_mark_hnf_1: + cmplwi 0,o3,2 + bor o1,o3 + stwx o1,o4,o0 + bge+ fits_in_word_4 + + baddi o0,4 + lwzx o1,o4,o0 + bor o1,g3 + stwx o1,o4,o0 + +fits_in_word_4: + baddi d4,2 + +_shared_argument_part: + lwz a0,0-NODE_POINTER_OFFSET(a0) + b _mark_node + +_mark_lazy_node_1: + cmplwi 6,o3,4 + + bor o1,o3 + baddi a0,4 + stwx o1,o4,o0 + + bge+ 6,fits_in_word_3 + + baddi o0,4 + lwzx o1,o4,o0 + bor o1,g3 + stwx o1,o4,o0 + +fits_in_word_3: +; tst d2 + baddi d4,3 + beq _mark_node2 + +_mark_selector_node_1: + baddicc d2,2 + lwz a1,0-NODE_POINTER_OFFSET(a0) + beq _mark_indirection_node + + sub d1,a1,d6 + + baddicc d2,1 + + rlwinm o0,d1,32-5,5,29 + lwzx o1,o4,o0 + rlwinm d1,d1,32-2,27,31 + + ble _mark_record_selector_node_1 + + rlwnm. r0,o1,d1,0,0 + bne _mark_node3 + + lwz d2,0-NODE_POINTER_OFFSET(a1) + andi. r0,d2,2 + beq _mark_node3 + + lhz g1,-2(d2) + cmplwi 0,g1,2 + ble _small_tuple_or_record + +_large_tuple_or_record: + lwz d1,8(a1) + + sub d1,d1,d6 + rlwinm o0,d1,32-5,5,29 + lwzx g1,o4,o0 + rlwinm d1,d1,32-2,27,31 + rlwnm. r0,g1,d1,0,0 + bne _mark_node3 + +_small_tuple_or_record: + if LINUX + lwz g1,-8(d0) + else + lha g1,-6(d0) + endif + subi d2,a0,4 + if LINUX + else + lwzx g1,rtoc,g1 + endif + mr a0,a1 + lwz g1,4(g1) + + mtctr g1 + mflr r0 + stwu r0,-4(sp) + bctrl + mtlr r0 + + lea g1,__indirection + stw a0,4-NODE_POINTER_OFFSET(d2) + stw g1,0-NODE_POINTER_OFFSET(d2) + if REMOVE_INDIRECTION_LISTS + addi g2,d2,4 + b __mark_node + else + b _mark_node + endif + +_mark_record_selector_node_1: + beq _mark_strict_record_selector_node_1 + + rlwnm. r0,o1,d1,0,0 + bne _mark_node3 + + lwz d2,0-NODE_POINTER_OFFSET(a1) + andi. r0,d2,2 + beq _mark_node3 + + lhz g1,-2(d2) + cmplwi 0,g1,258 + ble _small_tuple_or_record + b _large_tuple_or_record + +_mark_strict_record_selector_node_1: + rlwnm. r0,o1,d1,0,0 + bne _mark_node3 + +_no_mark_strict_record_selector_node_1: + lwz d2,0-NODE_POINTER_OFFSET(a1) + andi. r0,d2,2 + beq _mark_node3 + + lhz g1,-2(d2) + cmplwi 0,g1,258 + ble _select_from_small_record + + lwz d1,8-NODE_POINTER_OFFSET(a1) + + sub d1,d1,d6 + rlwinm o0,d1,32-5,5,29 + lwzx g1,o4,o0 + rlwinm d1,d1,32-2,27,31 + rlwnm. r0,g1,d1,0,0 + bne _mark_node3 + +_select_from_small_record: + if LINUX + lwz g1,-8(d0) + else + lha g1,-6(d0) + endif + subi a0,a0,4 + if LINUX + else + lwzx g1,rtoc,g1 + endif + lwz g1,4(g1) + + mtctr g1 + mflr r0 + stwu r0,-4(sp) + bctrl + mtlr r0 + + b _mark_next_node + +_mark_indirection_node: + + + if REMOVE_INDIRECTION_LISTS + mr g2,a0 +__mark_indirection_node: + mr a0,a1 +__mark_node: + sub d1,a0,d6 + if SHARE_CHAR_INT + cmplw d1,d7 + bge- __mark_next_node + endif + rlwinm o0,d1,32-5,5,29 + lwzx o1,o4,o0 + rlwinm d1,d1,32-2,27,31 + rlwnm. r0,o1,d1,0,0 + beq __mark_arguments + +__mark_next_node: + + lwz g1,0-NODE_POINTER_OFFSET(g2) + cmpw g1,a0 + beq __end_indirection_list1 +__update_indirection_list1: + stw a0,0-NODE_POINTER_OFFSET(g2) + addi g2,g1,4 + lwz g1,4-NODE_POINTER_OFFSET(g1) + cmplw g1,a0 + bne __update_indirection_list1 +__end_indirection_list1: + + b _mark_next_node + +__mark_arguments: + lwz d0,0-NODE_POINTER_OFFSET(a0) + + srw o3,g3,d1 + + andi. r0,d0,2 + lha d2,-2(d0) + beq __mark_lazy_node + + lwz g1,0-NODE_POINTER_OFFSET(g2) + cmpw g1,a0 + beq __end_indirection_list2 +__update_indirection_list2: + stw a0,0-NODE_POINTER_OFFSET(g2) + addi g2,g1,4 + lwz g1,4-NODE_POINTER_OFFSET(g1) + cmplw g1,a0 + bne __update_indirection_list2 +__end_indirection_list2: + + b _no_mark_lazy_node + +__mark_lazy_node: + tst d2 + blt __mark_lazy_node_lt0 + + lwz g1,0-NODE_POINTER_OFFSET(g2) + cmpw g1,a0 + beq __end_indirection_list3 +__update_indirection_list3: + stw a0,0-NODE_POINTER_OFFSET(g2) + addi g2,g1,4 + lwz g1,4(g1) + cmplw g1,a0 + bne __update_indirection_list3 +__end_indirection_list3: + + b _mark_lazy_node + +__mark_lazy_node_lt0: + baddicc d2,2 + lwz a1,4-NODE_POINTER_OFFSET(a0) + beq __mark_indirection_node + + sub d1,a1,d6 + + baddicc d2,1 + + rlwinm g0,d1,32-5,5,29 + lwzx g1,o4,g0 + rlwinm d1,d1,32-2,27,31 + + ble __mark_record_selector_node_1 + + rlwnm. r0,g1,d1,0,0 + bne __mark_node3 + + lwz d2,0-NODE_POINTER_OFFSET(a1) + andi. r0,d2,2 + beq __mark_node3 + + lhz g1,-2(d2) + cmplwi 0,g1,2 + ble __small_tuple_or_record + +__large_tuple_or_record: + lwz d1,8-NODE_POINTER_OFFSET(a1) + + sub d1,d1,d6 + rlwinm g0,d1,32-5,5,29 + lwzx g1,o4,g0 + rlwinm d1,d1,32-2,27,31 + rlwnm. r0,g1,d1,0,0 + bne __mark_node3 + +__small_tuple_or_record: + if LINUX + lwz g1,-8(d0) + else + lha g1,-6(d0) + endif + mr d2,a0 + if LINUX + else + lwzx g1,rtoc,g1 + endif + mr a0,a1 + lwz g1,4(g1) + + mtctr g1 + mflr r0 + stwu r0,-4(sp) + bctrl + mtlr r0 + + lea g1,__indirection + stw a0,4-NODE_POINTER_OFFSET(d2) + stw g1,0-NODE_POINTER_OFFSET(d2) + b __mark_node + +__mark_record_selector_node_1: + beq __mark_strict_record_selector_node_1 + + rlwnm. r0,g1,d1,0,0 + bne __mark_node3 + + lwz d2,0-NODE_POINTER_OFFSET(a1) + andi. r0,d2,2 + beq __mark_node3 + + lhz g1,-2(d2) + cmplwi 0,g1,258 + ble __small_tuple_or_record + b __large_tuple_or_record + +__mark_node3: + cmplwi 6,o3,4 + + bor o1,o3 + stwx o1,o4,o0 + + bge+ 6,_fits_in_word_3 + + baddi o0,4 + lwzx o1,o4,o0 + bor o1,g3 + stwx o1,o4,o0 + +_fits_in_word_3: + baddi d4,3 + + lwz g1,0-NODE_POINTER_OFFSET(g2) + cmpw g1,a0 + beq __end_indirection_list4 +__update_indirection_list4: + stw a0,0-NODE_POINTER_OFFSET(g2) + addi g2,g1,4 + lwz g1,4-NODE_POINTER_OFFSET(g1) + cmplw g1,a0 + bne __update_indirection_list4 +__end_indirection_list4: + + mr a0,a1 + b _mark_node + +__mark_strict_record_selector_node_1: + rlwnm. r0,g1,d1,0,0 + bne __mark_node3 + + cmplwi 6,o3,4 + + bor o1,o3 + stwx o1,o4,o0 + + bge+ 6,_fits_in_word_3_ + + baddi o0,4 + lwzx o1,o4,o0 + bor o1,g3 + stwx o1,o4,o0 + +_fits_in_word_3_: + baddi d4,3 + + lwz g1,0-NODE_POINTER_OFFSET(g2) + cmpw g1,a0 + beq __end_indirection_list5 +__update_indirection_list5: + stw a0,0-NODE_POINTER_OFFSET(g2) + addi g2,g1,4 + lwz g1,4-NODE_POINTER_OFFSET(g1) + cmplw g1,a0 + bne __update_indirection_list5 +__end_indirection_list5: + + baddi a0,4 + b _no_mark_strict_record_selector_node_1 + endif + +_mark_node3: + mr a0,a1 + b _mark_node + +_mark_next_node: + lwz a0,0(sp) + baddi sp,4 + tst a0 + bne _mark_node + + cmpw a4,a2 + bne _mark_stack_nodes_ + +_end_mark_nodes: + blr + +_mark_lazy_node: + tst d2 + beq _mark_real_or_file + + cmpwi 0,d2,1 + ble _mark_lazy_node_1 + + cmplwi 0,d2,256 + bge _mark_closure_with_unboxed_arguments + baddi d2,1 + + add o2,d1,d2 + cmpwi 0,o2,32 + + add d4,d4,d2 + bor o1,o3 + stwx o1,o4,o0 + + ble+ fits_in_word_7 + + baddi o0,4 + lwzx o1,o4,o0 + bor o1,g3 + stwx o1,o4,o0 + +fits_in_word_7: + slwi g2,d2,2 + add a0,a0,g2 + + cmplw 6,sp,a3 + + subi d2,d2,3 +_push_lazy_args: + lwzu o0,-4(a0) + subic. d2,d2,1 + stwu o0,-4(sp) + bge _push_lazy_args + + bsubi a0,4 + + bge 6,_mark_node2 + + b __mark_using_reversal + +_mark_closure_with_unboxed_arguments: + srwi g2,d2,8 + bandic d2,255 + + bsubicc d2,1 + beq _mark_real_or_file + + baddi d2,2 + + add o2,d1,d2 + cmpwi 0,o2,32 + + badd d4,d2 + bor o1,o3 + stwx o1,o4,o0 + + ble+ fits_in_word_7_ + + baddi o0,4 + lwzx o1,o4,o0 + bor o1,g3 + stwx o1,o4,o0 + +fits_in_word_7_: + bsub d2,g2 + slwi g2,d2,2 + + bsubicc d2,2 + blt- _mark_next_node + + badd a0,g2 + + cmplw 6,sp,a3 + bne _push_lazy_args + +_mark_closure_with_one_boxed_argument: + lwz a0,-4(a0) + b _mark_node + +_mark_hnf_0: + cmplw 0,d0,int_reg + blt _mark_real_file_or_string + + cmplw d0,char_reg + bgt _mark_normal_hnf_0 + +_mark_bool_or_small_string: + cmplwi 0,o3,2 + bor o1,o3 + + stwx o1,o4,o0 + baddi d4,2 + + bge+ _mark_next_node + + baddi o0,4 + lwzx o1,o4,o0 + bor o1,g3 + stwx o1,o4,o0 + b _mark_next_node + +_mark_normal_hnf_0: + bor o1,o3 + baddi d4,1 + stwx o1,o4,o0 + b _mark_next_node + +_mark_real_file_or_string: + lea g1,__STRING__2 + cmplw 0,d0,g1 + ble _mark_string_or_array + +_mark_real_or_file: + cmplwi 0,o3,4 + bor o1,o3 + + stwx o1,o4,o0 + baddi d4,3 + + bge+ _mark_next_node + + baddi o0,4 + lwzx o1,o4,o0 + bor o1,g3 + stwx o1,o4,o0 + b _mark_next_node + +_mark_record: + subic. d2,d2,258 + beq _mark_record_2 + blt _mark_record_1 + +_mark_record_3: + cmplwi 0,o3,4 + + lhz d1,-2+2(d0) + + bor o1,o3 + stwx o1,o4,o0 + baddi d4,3 + + bge+ fits_in_word_13 + + baddi o0,4 + lwzx o1,o4,o0 + bor o1,g3 + stwx o1,o4,o0 +fits_in_word_13: + + lwz a1,4-NODE_POINTER_OFFSET(a0) + + subic. d1,d1,1 + + sub d0,a1,d6 + rlwinm o0,d0,32-5,5,29 + lwzx o1,o4,o0 + rlwinm d0,d0,32-2,27,31 + srw o3,g3,d0 + + blt _mark_record_3_bb + + and. r0,o3,o1 + bne _mark_node2 + + addi d2,d2,1 + + add o2,d0,d2 + cmplwi 0,o2,32 + + add d4,d4,d2 + + bor o1,o3 + stwx o1,o4,o0 + ble+ _push_record_arguments + + baddi o0,4 + lwzx o1,o4,o0 + bor o1,g3 + stwx o1,o4,o0 + +_push_record_arguments: + subic. d2,d1,1 + + slwi d1,d1,2 + add a1,a1,d1 + if NODE_POINTER_OFFSET + bsubi a1,NODE_POINTER_OFFSET + endif + bge _push_hnf_args + + b _mark_node2 + +_mark_record_3_bb: + and. r0,o3,o1 + bne _mark_next_node + + addi d2,d2,1 + + add o2,d0,d2 + cmplwi 0,o2,32 + + add d4,d4,d2 + + bor o1,o3 + stwx o1,o4,o0 + ble _mark_next_node + + baddi o0,4 + lwzx o1,o4,o0 + bor o1,g3 + stwx o1,o4,o0 + b _mark_next_node + +_mark_record_2: + cmplwi 0,o3,4 + + lhz g1,-2+2(d0) + bor o1,o3 + + cmplwi 6,g1,1 + + stwx o1,o4,o0 + bge+ fits_in_word_12 + + baddi o0,4 + lwzx o1,o4,o0 + bor o1,g3 + stwx o1,o4,o0 + +fits_in_word_12: + baddi d4,3 + + bgt 6,_mark_record_2_c + beq 6,_mark_node2 + b _mark_next_node + +_mark_record_1: + lhz g1,-2+2(d0) + tst g1 + bne _mark_hnf_1 + + b _mark_bool_or_small_string + +_mark_string_or_array: + beq _mark_string_ + +_mark_array: + lwz d1,8-NODE_POINTER_OFFSET(a0) + tst d1 + beq _mark_lazy_array + + lhz d0,-2(d1) + tst d0 + beq _mark_strict_basic_array + + lhz d1,-2+2(d1) + tst d1 + beq _mark_b_record_array + + cmplw 0,sp,a3 + blt __mark_array_using_reversal + + subi d3,d0,256 + lwz d2,4-NODE_POINTER_OFFSET(a0) + + cmplw 0,d1,d3 + bor o1,o3 + + stwx o1,o4,o0 + baddi d4,1 + + mullw d0,d2,d3 + + beq _mark_lazy_or_a_record_array + +_mark_ab_record_array: + baddi d0,3-1 + + badd d4,d0 + slwi d0,d0,2 + + badd d0,a0 + + sub d0,d0,d6 + rlwinm d0,d0,32-5,5,29 + + cmplw 0,o0,d0 + bge _end_set_ab_array_bits + + baddi o0,4 + cmplw 0,o0,d0 + bge _last_ab_array_bits + +_mark_ab_array_lp: + stwx g3,o4,o0 + baddi o0,4 + cmplw 0,o0,d0 + blt _mark_ab_array_lp + +_last_ab_array_bits: + lwzx o1,o4,o0 + bor o1,g3 + stwx o1,o4,o0 + +_end_set_ab_array_bits: + mflr o1 + stw a2,-8(sp) + + stw a4,-4(sp) + slwi d3,d3,2 + + addi a2,a0,12-NODE_POINTER_OFFSET + stw d3,-20(sp) + + slwi d1,d1,2 + stw d1,-16(sp) + + cmplwi 0,d2,0 + + stw o1,-12(sp) + subi sp,sp,28 + + beq _mark_ab_array_0 + +_mark_ab_array: + lwz d1,12(sp) + stw d2,4(sp) + stw a2,0(sp) + + add a4,a2,d1 + bl _mark_stack_nodes + + lwz d2,4(sp) + lwz a2,0(sp) + subic. d2,d2,1 + lwz d3,8(sp) + add a2,a2,d3 + bne _mark_ab_array + +_mark_ab_array_0: + lwz o1,16(sp) + baddi sp,28 + + lwz a2,-8(sp) + mtlr o1 + lwz a4,-4(sp) + b _mark_next_node + +_mark_lazy_array: + cmplw 0,sp,a3 + blt __mark_array_using_reversal + + lwz d0,4-NODE_POINTER_OFFSET(a0) + bor o1,o3 + + stwx o1,o4,o0 + baddi d4,1 + +_mark_lazy_or_a_record_array: + mr d2,d0 + baddi d0,3-1 + + badd d4,d0 + slwi d0,d0,2 + + badd d0,a0 + + sub d0,d0,d6 + rlwinm d0,d0,32-5,5,29 + + cmplw 0,o0,d0 + bge _end_set_lazy_array_bits + + baddi o0,4 + cmplw 0,o0,d0 + bge _last_lazy_array_bits + +_mark_lazy_array_lp: + stwx g3,o4,o0 + baddi o0,4 + cmplw 0,o0,d0 + blt _mark_lazy_array_lp + +_last_lazy_array_bits: + lwzx o1,o4,o0 + bor o1,g3 + stwx o1,o4,o0 + +_end_set_lazy_array_bits: + mflr d1 + stw a2,-8(sp) + + addi a2,a0,12--NODE_POINTER_OFFSET + stw a4,-4(sp) + + slwi d2,d2,2 + stwu d1,-12(sp) + + add a4,a2,d2 + bl _mark_stack_nodes + + lwz d1,0(sp) + baddi sp,12 + + lwz a2,-8(sp) + mtlr d1 + + lwz a4,-4(sp) + b _mark_next_node + +__mark_array_using_reversal: + li d3,0 + stwu d3,-4(sp) + li d5,1 + b __mark__node + +_mark_strict_basic_array: + lwz d0,4-NODE_POINTER_OFFSET(a0) + cmplw 0,d1,int_reg + beq _mark_strict_int_array + cmplw 0,d1,bool_reg + beq _mark_strict_bool_array +_mark_strict_real_array: + badd d0,d0 +_mark_strict_int_array: + addi d0,d0,3 + b _mark_basic_array_ +_mark_strict_bool_array: + addi d0,d0,12+3 + srwi d0,d0,2 + b _mark_basic_array_ + +_mark_b_record_array: + lwz d1,4-NODE_POINTER_OFFSET(a0) + subi d0,d0,256 + mullw d0,d0,d1 + addi d0,d0,3 + b _mark_basic_array_ + +_mark_string_: + lwz d0,4-NODE_POINTER_OFFSET(a0) + addi d0,d0,8+3 + srwi d0,d0,2 + +_mark_basic_array_: + bor o1,o3 + stwx o1,o4,o0 + + add d4,d4,d0 + + slwi d0,d0,2 + badd d0,a0 + subi d0,d0,4 + + sub d0,d0,d6 + rlwinm d0,d0,32-5,5,29 + + cmplw 0,o0,d0 + bge _mark_next_node + + baddi o0,4 + cmplw 0,o0,d0 + bge _last_string_bits + +_mark_string_lp: + stwx g3,o4,o0 + baddi o0,4 + cmplw 0,o0,d0 + blt _mark_string_lp + +_last_string_bits: + lwzx o1,o4,o0 + bor o1,g3 + stwx o1,o4,o0 + b _mark_next_node + endif + + + +__end__mark__using__reversal: + lwz a1,0(sp) + baddi sp,4 + tst a1 + beq _mark_next_node + stw a0,0(a1) + b _mark_next_node + +__end__mark__using__reversal__after__static: + lwz a1,0(sp) + baddi sp,4 + stw a0,0(a1) + b _mark_next_node + +__mark_using_reversal: + stwu a0,-4(sp) + li d3,0 + lwz a0,0(a0) + li d5,1 + b __mark__node + +__mark__arguments: + lwz d0,0-NODE_POINTER_OFFSET(a0) + srw o3,g3,d1 + + andi. r0,d0,2 + lha d2,-2(d0) + + beq __mark__lazy__node + + tst d2 + beq __mark__hnf__0 + + cmplwi 0,d2,256 + baddi a0,4 + bge __mark__record + + subic. d2,d2,2 + beq __mark__hnf__2 + blt __mark__hnf__1 + +__mark__hnf__3: + cmplwi 0,o3,4 + + lwz a1,4-NODE_POINTER_OFFSET(a0) + bor o1,o3 + stwx o1,o4,o0 + + bge+ fits__in__word__1 + + baddi o0,4 + lwzx o1,o4,o0 + bor o1,g3 + stwx o1,o4,o0 + +fits__in__word__1: + sub d0,a1,d6 + + rlwinm o0,d0,32-5,5,29 + lwzx o1,o4,o0 + rlwinm d0,d0,32-2,27,31 + srw o3,g3,d0 + + and. r0,o1,o3 + baddi d4,3 + bne __shared__argument__part + +__no__shared__argument__part: + or d3,d3,d5 + stwu d3,4-NODE_POINTER_OFFSET(a0) + + lwz g1,0-NODE_POINTER_OFFSET(a1) + slwi d1,d2,2 + + addi d2,d2,1 + add o2,d0,d2 + cmplwi o2,32 + + ori g1,g1,1 + stw g1,0(a1) + + add d4,d4,d2 + + bor o1,o3 + stwx o1,o4,o0 + + ble+ fits__in__word__2 + + baddi o0,4 + lwzx o1,o4,o0 + bor o1,g3 + stwx o1,o4,o0 + +fits__in__word__2: + lwzux d2,a1,d1 + li d5,0 + stw a0,0-NODE_POINTER_OFFSET(a1) + mr d3,a1 + mr a0,d2 + b __mark__node + +__mark__lazy__node__1: + bne __mark__selector__node__1 + +__mark__selector__1: + cmplwi 0,o3,4 + bor o1,o3 + stwx o1,o4,o0 + baddi d4,3 + bge+ __shared__argument__part + + baddi o0,4 + lwzx o1,o4,o0 + bor o1,g3 + stwx o1,o4,o0 + b __shared__argument__part + +__mark__hnf__1: + cmplwi 0,o3,2 + + bor o1,o3 + stwx o1,o4,o0 + baddi d4,2 + + bge+ __shared__argument__part + + baddi o0,4 + lwzx o1,o4,o0 + bor o1,g3 + stwx o1,o4,o0 + +__shared__argument__part: + lwz d2,0-NODE_POINTER_OFFSET(a0) + bor d3,d5 + stw d3,0-NODE_POINTER_OFFSET(a0) + mr d3,a0 + li d5,2 + mr a0,d2 + b __mark__node + +__mark__selector__node__1: + baddicc d2,2 + lwz a1,0-NODE_POINTER_OFFSET(a0) + beq __mark__indirection__node + + sub o2,a1,d6 + + addic. d2,d2,1 + + rlwinm d2,o2,32-5,5,29 + lwzx g1,o4,d2 + rlwinm o2,o2,32-2,27,31 + + ble __mark__record__selector__node__1 + + rlwnm. r0,g1,o2,0,0 + bne- __mark__selector__1 + + lwz d2,0-NODE_POINTER_OFFSET(a1) + andi. r0,d2,2 + beq- __mark__selector__1 + + lha g1,-2(d2) + cmplwi 0,g1,2 + ble __small__tuple__or__record + +__large__tuple__or__record: + lwz o2,8-NODE_POINTER_OFFSET(a1) + sub o2,o2,d6 + + rlwinm d2,o2,32-5,5,29 + lwzx g1,o4,d2 + rlwinm o2,o2,32-2,27,31 + srw g2,g3,o2 + + and. r0,g2,g1 + bne- __mark__selector__1 + +__small__tuple__or__record: + if LINUX + lwz g1,-8(d0) + else + lha g1,-6(d0) + endif + subi d2,a0,4 + if LINUX + else + lwzx g1,rtoc,g1 + endif + mr a0,a1 + lwz g1,4(g1) + + mtctr g1 + mflr r0 + stwu r0,-4(sp) + bctrl + mtlr r0 + + lea g1,__indirection + stw a0,4-NODE_POINTER_OFFSET(d2) + stw g1,0-NODE_POINTER_OFFSET(d2) + b __mark__node + +__mark__record__selector__node__1: + beq __mark__strict__record__selector__node__1 + + rlwnm. r0,g1,o2,0,0 + bne- __mark__selector__1 + + lwz d2,0(a1) + andi. r0,d2,2 + beq- __mark__selector__1 + + lhz g1,-2(d2) + cmplwi 0,g1,258 + ble __small__tuple__or__record + b __large__tuple__or__record + +__mark__strict__record__selector__node__1: + rlwnm. r0,g1,o2,0,0 + bne- __mark__selector__1 + + lwz d2,0-NODE_POINTER_OFFSET(a1) + andi. r0,d2,2 + beq- __mark__selector__1 + + lhz g1,-2(d2) + cmplwi 0,g1,258 + ble __select__from__small__record + + lwz o2,8-NODE_POINTER_OFFSET(a1) + sub o2,o2,d6 + + rlwinm d2,o2,32-5,5,29 + lwzx g1,o4,d2 + rlwinm o2,o2,32-2,27,31 + rlwnm. r0,g1,o2,0,0 + bne- __mark__selector__1 + +__select__from__small__record: + if LINUX + lwz g1,-8(d0) + else + lha g1,-6(d0) + endif + subi a0,a0,4 + if LINUX + else + lwzx g1,rtoc,g1 + endif + lwz g1,4(g1) + + mtctr g1 + mflr r0 + stwu r0,-4(sp) + bctrl + mtlr r0 + + b __mark__node + +__mark__indirection__node: + mr a0,a1 + b __mark__node + +__mark__hnf__2: + cmplwi 0,o3,4 + + bor o1,o3 + stwx o1,o4,o0 + baddi d4,3 + + bge+ fits__in__word__6 + + baddi o0,4 + lwzx o1,o4,o0 + bor o1,g3 + stwx o1,o4,o0 +fits__in__word__6: + +__mark__record__2__c: + lwz o0,0-NODE_POINTER_OFFSET(a0) + or d3,d3,d5 + ori o0,o0,2 + stw o0,0-NODE_POINTER_OFFSET(a0) + lwzu d2,4-NODE_POINTER_OFFSET(a0) + stw d3,0-NODE_POINTER_OFFSET(a0) + mr d3,a0 + li d5,0 + mr a0,d2 + +__mark__node: + sub d1,a0,d6 + if SHARE_CHAR_INT + cmplw d1,d7 + bge- __mark__next__node__after__static + endif + + rlwinm o0,d1,32-5,5,29 + lwzx o1,o4,o0 + rlwinm d1,d1,32-2,27,31 + rlwnm. r0,o1,d1,0,0 + beq __mark__arguments + +__mark__next__node: + tst d5 + bne __mark__parent + +__mark__next__node2: + lwzu d2,-4-NODE_POINTER_OFFSET(d3) + lwz o0,4-NODE_POINTER_OFFSET(d3) + andi. d5,d2,3 + + stw o0,0-NODE_POINTER_OFFSET(d3) + + stw a0,4-NODE_POINTER_OFFSET(d3) + clrrwi a0,d2,2 + b __mark__node + +__mark__lazy__node: + tst d2 + beq __mark__real__or__file + + cmpwi 0,d2,1 + baddi a0,4 + ble __mark__lazy__node__1 + + cmplwi 0,d2,256 + bge __mark_closure_with_unboxed_arguments + baddi d2,1 + + add o2,d1,d2 + cmplwi 0,o2,32 + + add d4,d4,d2 + + bor o1,o3 + stwx o1,o4,o0 + ble+ fits__in__word__7 + + baddi o0,4 + lwzx o1,o4,o0 + bor o1,g3 + stwx o1,o4,o0 + +fits__in__word__7: + subi d2,d2,2 + +__mark_closure_with_unboxed_arguments__2: + lwz o0,0-NODE_POINTER_OFFSET(a0) + slwi d2,d2,2 + ori o0,o0,2 + stw o0,0-NODE_POINTER_OFFSET(a0) + + lwzux d2,a0,d2 + or d3,d3,d5 + stw d3,0-NODE_POINTER_OFFSET(a0) + mr d3,a0 + li d5,0 + mr a0,d2 + b __mark__node + +__mark_closure_with_unboxed_arguments: + srwi d0,d2,8 + bandic d2,255 + + bsubicc d2,1 + beq __mark_closure_1_with_unboxed_argument + + baddi d2,2 + add o2,d1,d2 + cmplwi 0,o2,32 + + badd d4,d2 + + bor o1,o3 + stwx o1,o4,o0 + ble+ fits__in__word__7_ + + baddi o0,4 + lwzx o1,o4,o0 + bor o1,g3 + stwx o1,o4,o0 + +fits__in__word__7_: + bsub d2,d0 + bsubicc d2,2 + bgt __mark_closure_with_unboxed_arguments__2 + beq __shared__argument__part + bsubi a0,4 + b __mark__next__node + +__mark_closure_1_with_unboxed_argument: + bsubi a0,4 + b __mark__real__or__file + +__mark__hnf__0: + cmplw d0,int_reg + bne __no__int__3 + + lwz d2,4-NODE_POINTER_OFFSET(a0) + cmplwi 0,d2,33 + slwi d2,d2,3 + blt ____small____int + +__mark__bool__or__small__string: + cmplwi 0,o3,2 + + bor o1,o3 + stwx o1,o4,o0 + baddi d4,2 + + bge+ __mark__next__node + + baddi o0,4 + lwzx o1,o4,o0 + bor o1,g3 + stwx o1,o4,o0 + b __mark__next__node + +____small____int: + lea a0,small_integers + add a0,a0,d2 + b __mark__next__node__after__static + +__no__int__3: + blt __mark__real__file__or__string + + cmplw 0,d0,char_reg + bne __no__char__3 + + lbz d2,7-NODE_POINTER_OFFSET(a0) + lea a0,static_characters + slwi d2,d2,3 + add a0,a0,d2 + b __mark__next__node__after__static + +__no__char__3: + blt __mark__bool__or__small__string + + subi a0,d0,2-ZERO_ARITY_DESCRIPTOR_OFFSET + b __mark__next__node__after__static + +__mark__real__file__or__string: + lea g1,__STRING__2 + cmplw 0,d0,g1 + ble __mark__string__or__array + +__mark__real__or__file: + cmplwi 0,o3,4 + bor o1,o3 + stwx o1,o4,o0 + baddi d4,3 + bge+ __mark__next__node + + baddi o0,4 + lwzx o1,o4,o0 + bor o1,g3 + stwx o1,o4,o0 + b __mark__next__node + +__mark__record: + subic. d2,d2,258 + beq __mark__record__2 + blt __mark__record__1 + +__mark__record__3: + cmplwi 0,o3,4 + + bor o1,o3 + stwx o1,o4,o0 + baddi d4,3 + + lwz a1,4-NODE_POINTER_OFFSET(a0) + + bge+ fits__in__word__13 + + baddi o0,4 + lwzx o1,o4,o0 + bor o1,g3 + stwx o1,o4,o0 +fits__in__word__13: + + lhz d1,-2+2(d0) + + sub d0,a1,d6 + rlwinm o0,d0,32-5,5,29 + lwzx o1,o4,o0 + rlwinm d0,d0,32-2,27,31 + srw o3,g3,d0 + + and. r0,o3,o1 + bne __shared__record__argument__part + + addi d2,d2,1 + + add o2,d0,d2 + cmplwi 6,o2,32 + + add d4,d4,d2 + + subic. d1,d1,1 + + bor o1,o3 + stwx o1,o4,o0 + ble+ 6,fits__in__word__14 + + baddi o0,4 + lwzx o1,o4,o0 + bor o1,g3 + stwx o1,o4,o0 + +fits__in__word__14: + blt __mark__record__3__bb + beq __shared__argument__part + + subic. d1,d1,1 + or d3,d3,d5 + stwu d3,4-NODE_POINTER_OFFSET(a0) + + beq __mark__record__3__aab + + lwz g1,0-NODE_POINTER_OFFSET(a1) + slwi d1,d1,2 + ori g1,g1,1 + stw g1,0-NODE_POINTER_OFFSET(a1) + + lwzux d2,a1,d1 + li d5,0 + stw a0,0-NODE_POINTER_OFFSET(a1) + mr d3,a1 + mr a0,d2 + b __mark__node + +__mark__record__3__bb: + subi a0,a0,4 + b __mark__next__node + +__mark__record__3__aab: + lwz d2,0-NODE_POINTER_OFFSET(a1) + stw a0,0-NODE_POINTER_OFFSET(a1) + mr d3,a1 + li d5,1 + mr a0,d2 + b __mark__node + +__shared__record__argument__part: + tst d1 + bne __shared__argument__part + subi a0,a0,4 + b __mark__next__node + +__mark__record__2: + cmplwi 0,o3,4 + + lhz g1,-2+2(d0) + bor o1,o3 + + cmplwi 6,g1,1 + baddi d4,3 + + stwx o1,o4,o0 + bge+ fits__in__word_12 + + baddi o0,4 + lwzx o1,o4,o0 + bor o1,g3 + stwx o1,o4,o0 + +fits__in__word_12: + bgt 6,__mark__record__2__c + beq 6,__shared__argument__part + subi a0,a0,4 + b __mark__next__node + +__mark__record__1: + lhz g1,-2+2(d0) + tst g1 + bne __mark__hnf__1 + subi a0,a0,4 + b __mark__bool__or__small__string + +__mark__string__or__array: + beq __mark__string__ + +__mark__array: + lwz d1,8-NODE_POINTER_OFFSET(a0) + tst d1 + beq __mark__lazy__array + + lhz d0,-2(d1) + tst d0 + beq __mark__strict__basic__array + + lhz d1,-2+2(d1) + tst d1 + beq __mark__b__record__array + + subi d0,d0,256 + cmpw 0,d0,d1 + beq __mark__a__record__array + +__mark__ab__record__array: + mr o2,d2 + mr g0,d3 + mr g1,d4 + mr g2,d5 + + lwz d2,4-NODE_POINTER_OFFSET(a0) + baddi a0,8 + stw a0,-4(sp) + + slwi d2,d2,2 + mullw a1,d2,d0 + + sub d0,d0,d1 + baddi a0,4 + add a1,a0,a1 + + mflr r0 + stw o0,-8(sp) + stw o1,-12(sp) + stw r0,-16(sp) + + bl reorder + + lwz o0,-8(sp) + lwz o1,-12(sp) + lwz r0,-16(sp) + + lwz a0,-4(sp) + mtlr r0 + + mr d5,g2 + mr d4,g1 + mr d3,g0 + mr d2,o2 + + lwz g1,-4(a0) + mr a1,d0 + mullw d0,d1,g1 + mullw d1,a1,g1 + badd d4,d1 + badd d1,d0 + +; to do add n b elements to d4 + + slwi d1,d1,2 + add d1,a0,d1 + sub d1,d1,d6 + + slwi a1,d0,2 + add a1,a0,a1 + b __mark__r__array + +__mark__a__record__array: + lwz g1,4-NODE_POINTER_OFFSET(a0) + baddi a0,8 + mullw d0,d0,g1 + b __mark__lr__array + +__mark__lazy__array: + lwz d0,4-NODE_POINTER_OFFSET(a0) + baddi a0,8 + +__mark__lr__array: + slwi a1,d0,2 + add a1,a0,a1 + + sub d1,a1,d6 +__mark__r__array: + rlwinm d1,d1,32-5,5,29 + + cmplw 0,o0,d1 + + bor o1,o3 + stwx o1,o4,o0 + + bge __skip__mark__lazy__array__bits + +__mark__lazy__array__bits: + baddi o0,4 + lwzx o1,o4,o0 + cmplw 0,o0,d1 + bor o1,g3 + stwx o1,o4,o0 + blt __mark__lazy__array__bits + +__skip__mark__lazy__array__bits: + cmplwi d0,1 + + baddi d4,3 + add d4,d4,d0 + lea o2,lazy_array_list + + ble __mark__array__length__0__1 + + lwz d2,0-NODE_POINTER_OFFSET(a1) + lwz o0,0-NODE_POINTER_OFFSET(a0) + stw d2,0-NODE_POINTER_OFFSET(a0) + stw o0,0-NODE_POINTER_OFFSET(a1) + + lwzu d2,-4-NODE_POINTER_OFFSET(a1) + lwz o1,0(o2) + addi d2,d2,2 + stw o1,0-NODE_POINTER_OFFSET(a1) + stw d2,-4-NODE_POINTER_OFFSET(a0) + stwu d0,-8-NODE_POINTER_OFFSET(a0) + stw a0,0(o2) + + lwzu d2,-4-NODE_POINTER_OFFSET(a1) + or d3,d3,d5 + stw d3,0-NODE_POINTER_OFFSET(a1) + mr d3,a1 + li d5,0 + mr a0,d2 + b __mark__node + +__mark__array__length__0__1: + subi a0,a0,8 + blt __mark__next__node + + lwz d1,12-NODE_POINTER_OFFSET(a0) ; element + lwz o0,8-NODE_POINTER_OFFSET(a0) ; element descriptor + lwz o3,0(o2) + stw o0,12-NODE_POINTER_OFFSET(a0) + stw o3,8-NODE_POINTER_OFFSET(a0) + stw d0,0-NODE_POINTER_OFFSET(a0) + + stw a0,0(o2) + stwu d1,4-NODE_POINTER_OFFSET(a0) + + lwz d2,0-NODE_POINTER_OFFSET(a0) + or d3,d3,d5 + stw d3,0-NODE_POINTER_OFFSET(a0) + mr d3,a0 + li d5,2 + mr a0,d2 + b __mark__node + +__mark__b__record__array: + lwz d1,4-NODE_POINTER_OFFSET(a0) + subi d0,d0,256 + mullw d0,d0,d1 + addi d0,d0,3 + b __mark__basic__array + +__mark__strict__basic__array: + lwz d0,4-NODE_POINTER_OFFSET(a0) + cmplw 0,d1,int_reg + beq __mark__strict__int__array + cmplw 0,d1,bool_reg + beq __mark__strict__bool__array +__mark__strict__real__array: + badd d0,d0 +__mark__strict__int__array: + addi d0,d0,3 + b __mark__basic__array +__mark__strict__bool__array: + addi d0,d0,12+3 + srwi d0,d0,2 + b __mark__basic__array + +__mark__string__: + lwz d0,4-NODE_POINTER_OFFSET(a0) + addi d0,d0,8+3 + srwi d0,d0,2 + +__mark__basic__array: + bor o1,o3 + stwx o1,o4,o0 + + add d4,d4,d0 + + slwi d0,d0,2 + badd d0,a0 + subi d0,d0,4 + + sub d0,d0,d6 + rlwinm d0,d0,32-5,5,29 + + cmplw 0,o0,d0 + bge __mark__next__node + + baddi o0,4 + cmplw 0,o0,d0 + bge __last__string__bits + +__mark__string__lp: + stwx g3,o4,o0 + baddi o0,4 + cmplw 0,o0,d0 + blt __mark__string__lp + +__last__string__bits: + lwzx o1,o4,o0 + bor o1,g3 + stwx o1,o4,o0 + b __mark__next__node + +__mark__parent: + tst d3 + beq __end__mark__using__reversal + + subic. d5,d5,1 + lwz d2,0-NODE_POINTER_OFFSET(d3) + stw a0,0-NODE_POINTER_OFFSET(d3) + beq __argument__part__parent + + subi a0,d3,4 + andi. d5,d2,3 + clrrwi d3,d2,2 + b __mark__next__node + +__argument__part__parent: + mr a1,d3 + + clrrwi d3,d2,2 + + lwzu a0,-4-NODE_POINTER_OFFSET(d3) + lwz o0,4-NODE_POINTER_OFFSET(d3) + li d5,2 + stw o0,0-NODE_POINTER_OFFSET(d3) + stw a1,4-NODE_POINTER_OFFSET(d3) + b __mark__node + +__mark__next__node__after__static: + tst d5 + beq __mark__next__node2 + + tst d3 + beq __end__mark__using__reversal__after__static + + subic. d5,d5,1 + lwz d2,0-NODE_POINTER_OFFSET(d3) + stw a0,0-NODE_POINTER_OFFSET(d3) + beq __argument__part__parent + + subi a0,d3,4 + andi. d5,d2,3 + clrrwi d3,d2,2 + b __mark__next__node + + csect text{PR} diff --git a/pprofile.a b/pprofile.a new file mode 100644 index 0000000..7adc9f2 --- /dev/null +++ b/pprofile.a @@ -0,0 +1,1407 @@ + + string asis + + macro + lea &r,&a + lwz &r,&a{TC}(RTOC) + endm + +MACOSX set 1 +; POWER601 set 1 +ALLOCATION_PROFILE set 1 +USE_TEMPORARY_MEMORY set 1 +CHECK_STACK_OVERFLOWS set 0 +MODULE_NAMES set 1 + + if POWER601 + macro + time_hi &r + dialect Power + mfrtcu &r + dialect PowerPC + endm + + macro + time_lo &r + dialect Power + mfrtcl &r + dialect PowerPC + endm + else + macro + time_hi &r + mftbu &r + endm + + macro + time_lo &r + mftb &r + endm + endif + +d0: set r24 +d1: set r25 +d2: set r26 +d3: set r27 +d4: set r28 +d5: set r29 +d6: set r30 +d7: set r31 + +a0: set r23 +a1: set r22 +a2: set r21 +a3: set r20 +a4: set r19 +a5: set r18 +a6: set r17 + +o0: set r3 +o1: set r4 +o2: set r5 +o3: set r6 +o4: set r7 +o5: set r8 + +g2: set r9 +g3: set r10 + +g0: set r11 +g1: set r12 + +int_reg set r16 +char_reg set r15 +real_reg set r14 +bool_reg set r13 + + if POWER601 +lo1e9 set 1000000000 % 65536 +hi1e9 set (1000000000 / 65536)+1 + endif + + export init_profiler + export profile_r + export profile_l + export profile_l2 + export profile_n + export profile_n2 + export profile_s + export profile_s2 + export profile_t + export profile_ti + export write_profile_information + export write_profile_stack + + if USE_TEMPORARY_MEMORY + import .TempNewHandle + import .TempHLock + import .TempHUnlock + import .TempDisposeHandle + else + import .NewPtr + endif + import .Gestalt + import __STRING__ + import openF + import closeF + import writeFC + import writeFI + import print_error + import new_file_creator + import stack_size + import .er_print_string + import .er_print_char + import .create_profile_file_name + if CHECK_STACK_OVERFLOWS + import .Debugger + endif + +FunctionProfile: record +next: ds.l 1 +time_hi: ds.l 1 +time_lo: ds.l 1 +n_profiler_calls: ds.l 1 +n_strict_calls: ds.l 1 +n_lazy_calls: ds.l 1 +n_curried_calls: ds.l 1 +n_words_allocated: ds.l 1 +name: ds.l 1 + endr + + csect .profile_t +profile_ti: +@read_clock: + time_hi r9 + time_lo r10 + time_hi r4 + cmpw 0,r4,r9 + bne- @read_clock + + lea r5,profile_globals + b profile_t_ + +profile_t: +@read_clock: + time_hi r9 + time_lo r10 + time_hi r4 + cmpw 0,r4,r9 + bne- @read_clock + + mflr r12 + lea r5,profile_globals + mtctr r12 + mtlr r0 +profile_t_: + lwz r6,Globals.stack_pointer(r5) + + lwz r7,Globals.time_hi(r5) + lwz r8,Globals.time_lo(r5) + + lwzu r4,-4(r6) + stw r6,Globals.stack_pointer(r5) + stw r4,Globals.last_tail_call(r5) + + if POWER601 + sub. r10,r10,r8 + sub r9,r9,r7 + bge+ @no_borrow + addis r10,r10,hi1e9 + addi r10,r10,lo1e9 + subi r9,r9,1 +@no_borrow: + else + subc r10,r10,r8 + subfe r9,r7,r9 + endif + lwz r8,FunctionProfile.time_lo(r4) + lwz r7,FunctionProfile.time_hi(r4) + + if POWER601 + add r8,r8,r10 + add r7,r7,r9 + + subis r9,r8,hi1e9 + cmpwi 0,r9,lo1e9 + + lwz r6,FunctionProfile.n_profiler_calls(r4) + + blt+ @no_carry + + subi r8,r9,lo1e9 + addi r7,r7,1 + +@no_carry: + else + addc r8,r8,r10 + lwz r6,FunctionProfile.n_profiler_calls(r4) + adde r7,r7,r9 + endif + addi r6,r6,1 + stw r7,FunctionProfile.time_hi(r4) + stw r8,FunctionProfile.time_lo(r4) + stw r6,FunctionProfile.n_profiler_calls(r4) + + if ALLOCATION_PROFILE + lwz r11,Globals.n_words_free(r5) + stw d7,Globals.n_words_free(r5) + lwz r12,FunctionProfile.n_words_allocated(r4) + sub r11,r11,d7 + add r12,r12,r11 + stw r12,FunctionProfile.n_words_allocated(r4) + endif + +@store_clock: + time_hi r9 + stw r9,Globals.time_hi(r5) + time_lo r10 + time_hi r4 + stw r10,Globals.time_lo(r5) + cmpw 0,r4,r9 + beqctr+ + + b @store_clock + + csect .profile_r +profile_r: +@read_clock: + time_hi r9 + time_lo r10 + time_hi r4 + cmpw 0,r4,r9 + bne- @read_clock + + lea r5,profile_globals + + lwz r6,Globals.stack_pointer(r5) + + lwz r7,Globals.time_hi(r5) + lwz r8,Globals.time_lo(r5) + + lwzu r4,-4(r6) + li r3,0 + stw r6,Globals.stack_pointer(r5) + stw r3,Globals.last_tail_call(r5) + + if POWER601 + sub. r10,r10,r8 + sub r9,r9,r7 + bge+ @no_borrow + addis r10,r10,hi1e9 + addi r10,r10,lo1e9 + subi r9,r9,1 +@no_borrow: + else + subc r10,r10,r8 + subfe r9,r7,r9 + endif + + lwz r8,FunctionProfile.time_lo(r4) + lwz r7,FunctionProfile.time_hi(r4) + + if POWER601 + add r8,r8,r10 + add r7,r7,r9 + + subis r9,r8,hi1e9 + cmpwi 0,r9,lo1e9 + + lwz r6,FunctionProfile.n_profiler_calls(r4) + + blt+ @no_carry + + subi r8,r9,lo1e9 + addi r7,r7,1 + +@no_carry: + else + addc r8,r8,r10 + lwz r6,FunctionProfile.n_profiler_calls(r4) + adde r7,r7,r9 + endif + + addi r6,r6,1 + stw r7,FunctionProfile.time_hi(r4) + stw r8,FunctionProfile.time_lo(r4) + stw r6,FunctionProfile.n_profiler_calls(r4) + + if ALLOCATION_PROFILE + lwz r11,Globals.n_words_free(r5) + stw d7,Globals.n_words_free(r5) + lwz r12,FunctionProfile.n_words_allocated(r4) + sub r11,r11,d7 + add r12,r12,r11 + stw r12,FunctionProfile.n_words_allocated(r4) + endif + +@store_clock: + time_hi r9 + stw r9,Globals.time_hi(r5) + time_lo r10 + time_hi r4 + stw r10,Globals.time_lo(r5) + cmpw 0,r4,r9 + beqlr+ + + b @store_clock + + csect .profile_l +profile_l: +@read_clock: + time_hi r9 + time_lo r10 + time_hi r4 + cmpw 0,r4,r9 + bne- @read_clock + + mflr r12 + lea r5,profile_globals + lwz r4,0(r3) + mtctr r12 + + cmpwi 0,r4,0 + beql allocate_function_profile_record + + lwz r3,Globals.last_tail_call(r5) + lwz r6,Globals.stack_pointer(r5) + cmpwi 0,r3,0 + + lwz r7,Globals.time_hi(r5) + lwz r8,Globals.time_lo(r5) + + bne @use_tail_calling_function + + lwz r3,-4(r6) +@c_use_tail_calling_function: + + stw r4,0(r6) + addi r6,r6,4 + if CHECK_STACK_OVERFLOWS + lwz r12,Globals.end_profile_stack(r5) + endif + stw r6,Globals.stack_pointer(r5) + if CHECK_STACK_OVERFLOWS + cmpw r6,r12 + bge profile_stack_overflow + endif + lwz r6,FunctionProfile.n_curried_calls(r4) + mtlr r0 + addi r6,r6,1 + stw r6,FunctionProfile.n_curried_calls(r4) + b profile_n_ + +@use_tail_calling_function: + li r12,0 + stw r12,Globals.last_tail_call(r5) + b @c_use_tail_calling_function + + csect .profile_l2 +profile_l2: +@read_clock: + time_hi r9 + time_lo r10 + time_hi r4 + cmpw 0,r4,r9 + bne- @read_clock + + mflr r12 + lea r5,profile_globals + lwz r4,0(r3) + mtctr r12 + + cmpwi 0,r4,0 + beql allocate_function_profile_record + + lwz r3,Globals.last_tail_call(r5) + lwz r6,Globals.stack_pointer(r5) + cmpwi 0,r3,0 + + lwz r7,Globals.time_hi(r5) + lwz r8,Globals.time_lo(r5) + + bne @use_tail_calling_function + + lwz r3,-4(r6) +@c_use_tail_calling_function: + + stw r4,0(r6) + stw r4,4(r6) + addi r6,r6,8 + if CHECK_STACK_OVERFLOWS + lwz r12,Globals.end_profile_stack(r5) + endif + stw r6,Globals.stack_pointer(r5) + if CHECK_STACK_OVERFLOWS + cmpw r6,r12 + bge profile_stack_overflow + endif + + lwz r6,FunctionProfile.n_curried_calls(r4) + mtlr r0 + addi r6,r6,1 + stw r6,FunctionProfile.n_curried_calls(r4) + b profile_n_ + +@use_tail_calling_function: + li r12,0 + stw r12,Globals.last_tail_call(r5) + b @c_use_tail_calling_function + + csect .profile_n +profile_n: +@read_clock: + time_hi r9 + time_lo r10 + time_hi r4 + cmpw 0,r4,r9 + bne- @read_clock + + mflr r12 + lea r5,profile_globals + lwz r4,0(r3) + mtctr r12 + + cmpwi 0,r4,0 + beql allocate_function_profile_record + + lwz r3,Globals.last_tail_call(r5) + lwz r6,Globals.stack_pointer(r5) + cmpwi 0,r3,0 + + lwz r7,Globals.time_hi(r5) + lwz r8,Globals.time_lo(r5) + + bne @use_tail_calling_function + + lwz r3,-4(r6) +@c_use_tail_calling_function: + + stw r4,0(r6) + addi r6,r6,4 + if CHECK_STACK_OVERFLOWS + lwz r12,Globals.end_profile_stack(r5) + endif + stw r6,Globals.stack_pointer(r5) + if CHECK_STACK_OVERFLOWS + cmpw r6,r12 + bge profile_stack_overflow + endif + + lwz r6,FunctionProfile.n_lazy_calls(r4) + mtlr r0 + addi r6,r6,1 + stw r6,FunctionProfile.n_lazy_calls(r4) + b profile_n_ + +@use_tail_calling_function: + li r12,0 + stw r12,Globals.last_tail_call(r5) + b @c_use_tail_calling_function + + csect .profile_n2 +profile_n2: +@read_clock: + time_hi r9 + time_lo r10 + time_hi r4 + cmpw 0,r4,r9 + bne- @read_clock + + mflr r12 + lea r5,profile_globals + lwz r4,0(r3) + mtctr r12 + + cmpwi 0,r4,0 + beql allocate_function_profile_record + + lwz r3,Globals.last_tail_call(r5) + lwz r6,Globals.stack_pointer(r5) + cmpwi 0,r3,0 + + lwz r7,Globals.time_hi(r5) + lwz r8,Globals.time_lo(r5) + + bne @use_tail_calling_function + + lwz r3,-4(r6) +@c_use_tail_calling_function: + + stw r4,0(r6) + stw r4,4(r6) + addi r6,r6,8 + if CHECK_STACK_OVERFLOWS + lwz r12,Globals.end_profile_stack(r5) + endif + stw r6,Globals.stack_pointer(r5) + if CHECK_STACK_OVERFLOWS + cmpw r6,r12 + bge profile_stack_overflow + endif + + lwz r6,FunctionProfile.n_lazy_calls(r4) + mtlr r0 + addi r6,r6,1 + stw r6,FunctionProfile.n_lazy_calls(r4) + b profile_n_ + +@use_tail_calling_function: + li r12,0 + stw r12,Globals.last_tail_call(r5) + b @c_use_tail_calling_function + + csect .profile_s2 +profile_s2: +@read_clock: + time_hi r9 + time_lo r10 + time_hi r4 + cmpw 0,r4,r9 + bne- @read_clock + + mflr r12 + lea r5,profile_globals + lwz r4,0(r3) + mtctr r12 + + cmpwi 0,r4,0 + beql allocate_function_profile_record + + lwz r3,Globals.last_tail_call(r5) + lwz r6,Globals.stack_pointer(r5) + cmpwi 0,r3,0 + + lwz r7,Globals.time_hi(r5) + lwz r8,Globals.time_lo(r5) + + bne @use_tail_calling_function + + lwz r3,-4(r6) +@c_use_tail_calling_function: + + stw r4,0(r6) + stw r4,4(r6) + addi r6,r6,8 + if CHECK_STACK_OVERFLOWS + lwz r12,Globals.end_profile_stack(r5) + endif + stw r6,Globals.stack_pointer(r5) + if CHECK_STACK_OVERFLOWS + cmpw r6,r12 + bge profile_stack_overflow + endif + b profile_s_ + +@use_tail_calling_function: + li r12,0 + stw r12,Globals.last_tail_call(r5) + b @c_use_tail_calling_function + + csect .profile_s +profile_s: +@read_clock: + time_hi r9 + time_lo r10 + time_hi r4 + cmpw 0,r4,r9 + bne- @read_clock + + mflr r12 + lea r5,profile_globals + lwz r4,0(r3) + mtctr r12 + + cmpwi 0,r4,0 + beql allocate_function_profile_record + + lwz r3,Globals.last_tail_call(r5) + lwz r6,Globals.stack_pointer(r5) + cmpwi 0,r3,0 + + lwz r7,Globals.time_hi(r5) + lwz r8,Globals.time_lo(r5) + + bne use_tail_calling_function0 + + lwz r3,-4(r6) +c_use_tail_calling_function0: + + stw r4,0(r6) + addi r6,r6,4 + if CHECK_STACK_OVERFLOWS + lwz r12,Globals.end_profile_stack(r5) + endif + stw r6,Globals.stack_pointer(r5) + if CHECK_STACK_OVERFLOWS + cmpw r6,r12 + bge profile_stack_overflow + endif + +profile_s_: + lwz r6,FunctionProfile.n_strict_calls(r4) + mtlr r0 + addi r6,r6,1 + stw r6,FunctionProfile.n_strict_calls(r4) + +profile_n_: + if POWER601 + sub. r10,r10,r8 + sub r9,r9,r7 + bge+ @no_borrow + addis r10,r10,hi1e9 + addi r10,r10,lo1e9 + subi r9,r9,1 +@no_borrow: + else + subc r10,r10,r8 + subfe r9,r7,r9 + endif + + lwz r8,FunctionProfile.time_lo(r3) + lwz r7,FunctionProfile.time_hi(r3) + + if POWER601 + add r8,r8,r10 + add r7,r7,r9 + + subis r9,r8,hi1e9 + cmpwi 0,r9,lo1e9 + + lwz r6,FunctionProfile.n_profiler_calls(r4) + + blt+ @no_carry + + subi r8,r9,lo1e9 + addi r7,r7,1 + +@no_carry: + else + addc r8,r8,r10 + lwz r6,FunctionProfile.n_profiler_calls(r4) + adde r7,r7,r9 + endif + addi r6,r6,1 + stw r7,FunctionProfile.time_hi(r3) + stw r8,FunctionProfile.time_lo(r3) + stw r6,FunctionProfile.n_profiler_calls(r4) + + if ALLOCATION_PROFILE + lwz r11,Globals.n_words_free(r5) + stw d7,Globals.n_words_free(r5) + lwz r12,FunctionProfile.n_words_allocated(r3) + sub r11,r11,d7 + add r12,r12,r11 + stw r12,FunctionProfile.n_words_allocated(r3) + endif + +@store_clock: + time_hi r9 + stw r9,Globals.time_hi(r5) + time_lo r10 + time_hi r4 + stw r10,Globals.time_lo(r5) + cmpw 0,r4,r9 + beqctr+ + + b @store_clock + +use_tail_calling_function0: + li r12,0 + stw r12,Globals.last_tail_call(r5) + b c_use_tail_calling_function0 + +allocate_function_profile_record: + lwz r6,Globals.n_free_records_in_block(r5) + lwz r4,Globals.last_allocated_block(r5) + cmpwi 0,r6,0 + bne+ no_alloc + + stw r0,-4(sp) + stw r3,-8(sp) + stw r9,-12(sp) + stw r10,-16(sp) + mfctr r11 + stw r11,-20(sp) + mflr r12 + stw r12,-24(sp) + + if USE_TEMPORARY_MEMORY + li r3,(128*FunctionProfile)+4 + else + li r3,128*FunctionProfile + endif + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+32+28)(sp) + else + stwu sp,-(64+32)(sp) + endif + if USE_TEMPORARY_MEMORY + bl allocate_temp_memory_handle + else + bl .NewPtr + nop + endif + if MACOSX + lwz sp,0(sp) + else + addi sp,sp,64+32 + endif + and. r4,r3,r3 + + lwz r12,-24(sp) + lwz r11,-20(sp) + mtlr r12 + lwz r10,-16(sp) + mtctr r11 + lwz r9,-12(sp) + lwz r3,-8(sp) + lwz r0,-4(sp) + + lea r5,profile_globals + + beq profiler_memory_error + + if USE_TEMPORARY_MEMORY + lwz r6,Globals.temp_handle_list(r5) + stw r4,Globals.temp_handle_list(r5) + lwz r4,0(r4) + stw r6,0(r4) + addi r4,r4,4 + endif + li r6,128 + stw r4,Globals.last_allocated_block(r5) + +no_alloc: + subi r6,r6,1 + stw r6,Globals.n_free_records_in_block(r5) + addi r7,r4,FunctionProfile + stw r7,Globals.last_allocated_block(r5) + + lwz r6,Globals.profile_records(r5) + li r8,0 + stw r8,FunctionProfile.time_hi(r4) + stw r8,FunctionProfile.time_lo(r4) + stw r8,FunctionProfile.n_profiler_calls(r4) + stw r8,FunctionProfile.n_strict_calls(r4) + stw r8,FunctionProfile.n_lazy_calls(r4) + stw r8,FunctionProfile.n_curried_calls(r4) + stw r8,FunctionProfile.n_words_allocated(r4) + stw r6,FunctionProfile.next(r4) + stw r4,Globals.profile_records(r5) + stw r3,FunctionProfile.name(r4) + + stw r4,0(r3) + blr + + csect .write_profile_information +write_profile_information: + lea o0,profile_file_name + + mflr r0 + stwu r0,-4(sp) + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + else + stwu sp,-64(sp) + endif + bl .create_profile_file_name + nop + if MACOSX + lwz sp,0(sp) + lwz r0,0(sp) + addi sp,sp,4 + else + lwz r0,64(sp) + addi sp,sp,68 + endif + mtlr r0 + + lea d3,new_file_creator + li d5,'T'*256+'I' + lwz d4,0(d3) + addis d5,d5,'P'*256+'R' + stw d5,0(d3) + + li d0,1 + lea a0,profile_file_name + + mflr r0 + stwu r0,-4(sp) + bl openF + mtlr r0 + + stw d4,0(d3) + + cmpwi 0,d2,0 + beq cannot_open + + mflr r0 + li d3,0 + stw r0,-4(sp) + stwu d3,-8(sp) + + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + else + stwu sp,-64(sp) + endif + stw d3,64(sp) + li r3,'u'*256+'t' + addi r4,sp,64 + addis r3,r3,'c'*256+'p' + bl .Gestalt + nop + + lwz d2,64(sp) + stwu r0,-4(sp) + bl writeFI_space + mtlr r0 + + stw d3,64(sp) + li r3,'l'*256+'k' + addi r4,sp,64 + addis r3,r3,'p'*256+'c' + bl .Gestalt + nop + + lwz d2,64(sp) + stwu r0,-4(sp) + bl writeFI_space + mtlr r0 + + stw d3,64(sp) + li r3,'l'*256+'k' + addi r4,sp,64 + addis r3,r3,'b'*256+'c' + bl .Gestalt + nop + + lwz d2,64(sp) + stwu r0,-4(sp) + bl writeFI + mtlr r0 + + li d2,13 + stwu r0,-4(sp) + bl writeFC + mtlr r0 + + if MACOSX + lwz sp,0(sp) + lwz r0,4(sp) + addi sp,sp,8 + else + lwz r0,68(sp) + addi sp,sp,72 + endif + mtlr r0 + + lea d2,profile_globals + lwz d2,Globals.profile_records(d2) + +write_profile_lp: + cmpwi 0,d2,0 + beq end_list + + lwz d3,FunctionProfile.name(d2) + stwu d2,-4(sp) + +#if MODULE_NAMES + stwu d3,-4(sp) + + lwz d3,-4(d3) + lwz d2,0(d3) + addi d3,d3,3 + +write_module_name_lp: + subic. d2,d2,1 + blt end_module_name + + stw d2,-4(sp) + lbzu d2,1(d3) + + mflr r0 + + stw d3,-8(sp) + + stwu r0,-12(sp) + bl writeFC + mtlr r0 + + lwz d2,4(sp) + lwz d3,0(sp) + addi sp,sp,8 + b write_module_name_lp + +end_module_name: + li d2,' ' + + mflr r0 + stwu r0,-4(sp) + bl writeFC + mtlr r0 + + lwz d3,0(sp) + addi sp,sp,4 +#endif + + addi d3,d3,3 + +write_function_name_lp: + lbzu d2,1(d3) + cmpwi 0,d2,0 + beq end_function_name + + stw d3,-4(sp) + + mflr r0 + stwu r0,-8(sp) + bl writeFC + mtlr r0 + + lwz d3,0(sp) + addi sp,sp,4 + b write_function_name_lp + +end_function_name: + li d2,' ' + + mflr r0 + stwu r0,-4(sp) + bl writeFC + + lwz d2,0(sp) + lwz d2,FunctionProfile.n_strict_calls(d2) + stwu r0,-4(sp) + bl writeFI_space + + lwz d2,0(sp) + lwz d2,FunctionProfile.n_lazy_calls(d2) + stwu r0,-4(sp) + bl writeFI_space + + lwz d2,0(sp) + lwz d2,FunctionProfile.n_curried_calls(d2) + stwu r0,-4(sp) + bl writeFI_space + + lwz d2,0(sp) + lwz d2,FunctionProfile.n_profiler_calls(d2) + stwu r0,-4(sp) + bl writeFI_space + + lwz d2,0(sp) + lwz d2,FunctionProfile.n_words_allocated(d2) + stwu r0,-4(sp) + bl writeFI_space + + lwz d2,0(sp) + lwz d2,FunctionProfile.time_hi(d2) + stwu r0,-4(sp) + bl writeFI_space + + lwz d2,0(sp) + lwz d2,FunctionProfile.time_lo(d2) + stwu r0,-4(sp) + bl writeFI + + li d2,13 + stwu r0,-4(sp) + bl writeFC + mtlr r0 + + lwz d2,0(sp) + addi sp,sp,4 + lwz d2,FunctionProfile.next(d2) + b write_profile_lp + +writeFI_space: + mflr r0 + stwu r0,-4(sp) + bl writeFI + mtlr r0 + + li d2,' ' + b writeFC + +end_list: + mflr r0 + stwu r0,-4(sp) + bl closeF + mtlr r0 + +cannot_open: + + if USE_TEMPORARY_MEMORY + mflr r0 + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(96+28)(sp) + else + stwu sp,-96(sp) + endif + stw r0,96-4(sp) + lea r5,profile_globals + lwz r3,Globals.profile_stack_handle(r5) + bl free_temp_memory_handle + + lea r5,profile_globals + + stw r31,96-8(sp) + + lwz r31,Globals.temp_handle_list(r5) + b free_temp_handles + +free_temp_handles_lp: + mr r3,r31 + lwz r31,0(r31) + lwz r31,0(r31) + bl free_temp_memory_handle + +free_temp_handles: + cmpwi 0,r31,0 + bne free_temp_handles_lp + + lwz r31,96-8(sp) + + lwz r0,96-4(sp) + if MACOSX + lwz sp,0(sp) + else + addi sp,sp,96 + endif + mtlr r0 + endif + lwz r0,0(sp) + addi sp,sp,4 + blr + + csect .write_profile_stack +write_profile_stack: + mflr r0 + lea d0,profile_globals + stwu r0,-4(sp) + lwz d0,Globals.stack_pointer(d0) + + cmpwi 0,d0,0 + beq @stack_not_initialised + + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + else + stwu sp,-64(sp) + endif + lea o0,stack_trace_string + bl .er_print_string + nop + if MACOSX + lwz sp,0(sp) + else + addi sp,sp,64 + endif + + if 1 + li d2,12 + else + li d2,24 + endif +@write_functions_on_stack + lwzu d1,-4(d0) + cmpwi 0,d1,0 + beq @end_profile_stack + + lwz o0,FunctionProfile.name(d1) + + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + else + stwu sp,-64(sp) + endif + addi o0,o0,4 + bl .er_print_string + nop + li o0,13 + bl .er_print_char + nop + if MACOSX + lwz sp,0(sp) + else + addi sp,sp,64 + endif + + subic. d2,d2,1 + if 0 + b @write_functions_on_stack + else + bne @write_functions_on_stack + endif + +@end_profile_stack: +@stack_not_initialised: + lwz r0,0(sp) + mtlr r0 + lwz r0,4(sp) + addi sp,sp,8 + blr + + csect .init_profiler +init_profiler: + if 0 + mflr r0 + stw r0,-4(sp) + stwu sp,-64(sp) + + bl .Debugger + nop + + lwz r0,64-4(sp) + addi sp,sp,64 + mtlr r0 + endif + + mflr r0 + stwu r0,-4(sp) + + if MACOSX + subi sp,sp,8 + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + else + stwu sp,-72(sp) + endif + li r3,0 + addi r4,sp,64 + stw r3,64(sp) + li r3,'u'*256+'t' + addis r3,r3,'c'*256+'p' + bl .Gestalt + nop + lwz r3,64(sp) + if MACOSX + lwz sp,0(sp) + addi sp,sp,8 + else + addi sp,sp,72 + endif + + cmpwi 0,r3,257 + if POWER601 + bne init_profiler_error1 + else + beq init_profiler_error1 + endif + + if 1 + lea r3,stack_size + lwz r3,0(r3) + else + li r3, (512*1024) % 65536 + addis r3,r3,(512*1024) / 65536 + endif + + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + else + stwu sp,-64(sp) + endif + if USE_TEMPORARY_MEMORY + bl allocate_temp_memory_handle + else + bl .NewPtr + nop + endif + if MACOSX + lwz sp,0(sp) + else + addi sp,sp,64 + endif + lea r5,profile_globals + + and. r9,r3,r3 + beq init_profiler_error + + if USE_TEMPORARY_MEMORY + stw r9,Globals.profile_stack_handle(r5) + lwz r9,0(r9) + li r0,0 + stw r0,Globals.temp_handle_list(r5) + endif + if CHECK_STACK_OVERFLOWS + if 1 + lea r3,stack_size + lwz r3,0(r3) + else + li r3, (512*1024) % 65536 + addis r3,r3,(512*1024) / 65536 + endif + add r3,r3,r9 + stw r3,Globals.end_profile_stack(r5) + endif + lea r3,start_string + bl allocate_function_profile_record + + lwz r0,0(sp) + addi sp,sp,4 + mtlr r0 + + li r0,0 + stw r4,4(r9) + stw r0,0(r9) + addi r9,r9,8 + stw r9,Globals.stack_pointer(r5) + stw r0,Globals.last_tail_call(r5) + stw d7,Globals.n_words_free(r5) + + lwz r0,0(sp) + addi sp,sp,4 + +@store_clock: + time_hi r9 + stw r9,Globals.time_hi(r5) + time_lo r10 + time_hi r4 + stw r10,Globals.time_lo(r5) + cmpw 0,r4,r9 + beqlr+ + + b @store_clock + + if USE_TEMPORARY_MEMORY +allocate_temp_memory_handle: + mflr r0 + stw r31,-4(sp) + stw r0,8(sp) + stwu sp,-96(sp) + + addi r4,sp,56 + bl .TempNewHandle + nop + + mr. r31,r3 + beq return_r31 + + addi r4,sp,56 + bl .TempHLock + nop + + lha r0,56(sp) + cmpwi r0,0 + beq+ return_r31 + + mr r3,r31 + addi r4,sp,56 + bl .TempDisposeHandle + nop + + li r31,0 +return_r31: + lwz r0,104(sp) + mr r3,r31 + mtlr r0 + addi sp,sp,96 + lwz r31,-4(sp) + blr + +free_temp_memory_handle: + mflr r0 + stw r3,-4(sp) + stw r0,8(sp) + stwu sp,-96(sp) + + addi r4,sp,56 + bl .TempHUnlock + nop + + lwz r3,96-4(sp) + addi r4,sp,56 + bl .TempDisposeHandle + nop + + lwz r0,104(sp) + addi sp,sp,96 + mtlr r0 + blr + endif + +init_profiler_error1: + lea o0,wrong_processor + lea r5,profile_globals + li r4,0 + stw r4,Globals.stack_pointer(r5) + b print_error +init_profiler_error: + lea o0,not_enough_memory_for_profile_stack + lea r5,profile_globals + li r4,0 + stw r4,Globals.stack_pointer(r5) + b print_error +profiler_memory_error: + lea o0,not_enough_memory_for_profiler + b print_error + if CHECK_STACK_OVERFLOWS +profile_stack_overflow: + mflr r0 + stw r0,-4(sp) + stwu sp,-64(sp) + + bl .Debugger + nop + + lwz r0,64-4(sp) + addi sp,sp,64 + mtlr r0 + b profile_stack_overflow + endif + + + csect data{RW} +Globals: record +n_free_records_in_block:ds.l 1 ; 0 n free records in block +last_allocated_block: ds.l 1 ; 4 latest allocated block +profile_records: ds.l 1 ; 8 profile record list +time_hi: ds.l 1 ; 12 clock +time_lo: ds.l 1 +stack_pointer: ds.l 1 ; 20 stack pointer +last_tail_call ds.l 1 ; 24 last tail calling function +n_words_free: ds.l 1 + if USE_TEMPORARY_MEMORY +temp_handle_list ds.l 1 +profile_stack_handle ds.l 1 + endif + if CHECK_STACK_OVERFLOWS +end_profile_stack ds.l 1 + endif + endr + + align 2 +profile_globals: ds Globals + +profile_file_name: + dc.l __STRING__+2 + dc.l 0 + ds.b 32 + align 2 + if MODULE_NAMES +m_system: + dc.l 6 + dc.b 'System' + dc.b 0,0 + dc.l m_system + endif +start_string: + dc.l 0 + dc.b 'start' + dc.b 0 + align 2 +not_enough_memory_for_profile_stack: + dc.b 'not enough memory for profile stack' + dc.b 13 + dc.b 0 +not_enough_memory_for_profiler: + dc.b 'not enough memory for profiler' + dc.b 13 + dc.b 0 +wrong_processor: + if POWER601 + dc.b 'Not a PowerPC601 processor (don''t use profiling option for 601)' + else + dc.b 'This is a PowerPC601 processor (use profiling option for 601)' + endif + dc.b 13 + dc.b 0 +stack_trace_string: + dc.b 'Stack trace:' + dc.b 13 + dc.b 0 + align 2 + + macro + te &address + tc &address{TC},&address + endm + + toc + + te profile_globals + te profile_file_name + te not_enough_memory_for_profile_stack + te not_enough_memory_for_profiler + te wrong_processor + te start_string + te stack_trace_string + te new_file_creator + te stack_size diff --git a/pstartup.a b/pstartup.a new file mode 100644 index 0000000..49a1dd8 --- /dev/null +++ b/pstartup.a @@ -0,0 +1,6085 @@ +; +; File: pstartup.a +; Author: John van Groningen +; Machine: power macintosh + + string asis + + macro + setmbit &vector,&bit_n,&byte_offset,&bit,&byte,&scratch,&shift + rlwinm &byte_offset,&bit_n,32-&shift-3,3+&shift,31 + lbzx &byte,&vector,&byte_offset + rlwinm &scratch,&bit_n,(32-&shift) & 31,29,31 + srw &bit,g3,&scratch + or &byte,&byte,&bit + stbx &byte,&vector,&byte_offset + endm + + macro + tstmbit &vector,&bit_n,&byte_offset,&bit,&byte,&bit_n_in_byte,&shift + rlwinm &byte_offset,&bit_n,32-&shift-3,3+&shift,31 + lbzx &byte,&vector,&byte_offset + rlwinm &bit_n_in_byte,&bit_n,32-&shift,29,31 + rlwnm. &bit,&byte,&bit_n_in_byte,24,24 + endm + + macro + clrmbit &vector,&bit_n,&byte_offset,&bit,&byte,&scratch,&shift + rlwinm &byte_offset,&bit_n,32-&shift-3,3+&shift,31 + lbzx &byte,&vector,&byte_offset + rlwinm &scratch,&bit_n,32-&shift,29,31 + srw &bit,g3,&scratch + andc &byte,&byte,&bit + stbx &byte,&vector,&byte_offset + endm + + include 'pmacros.a' + +d0: set r24 +d1: set r25 +d2: set r26 +d3: set r27 +d4: set r28 +d5: set r29 +d6: set r30 +d7: set r31 + +a0: set r23 +a1: set r22 +a2: set r21 +a3: set r20 +a4: set r19 +a5: set r18 +a6: set r17 + +o0: set r3 +o1: set r4 +o2: set r5 +o3: set r6 +o4: set r7 +o5: set r8 + +g2: set r9 +g3: set r10 + +g0: set r11 +g1: set r12 + +int_reg set r16 +char_reg set r15 +real_reg set r14 +bool_reg set r13 + +MACOSX set 1 + +SHARE_CHAR_INT set 1 +MY_ITOS set 1 +FINALIZERS set 1 +MEASURE_GC set 0 + +COPIED_VECTOR set 1 +USE_DCBZ set 0 +COMPACT_GC_ONLY set 0 + +ADJUST_HEAP_SIZE set 1 +MARK_GC set 1 +MARK_AND_COPY_GC set 1 + + if LINUX +STDERR_TO_FILE set 0 +WRITE_HEAP set 0 + else +WRITE_HEAP set 1 +STDERR_TO_FILE set 1 + endif +;PROFILE set 1 +UNBOXED_CLOSURES set 1 + +MODULE_NAMES_IN_TIME_PROFILER set 1 + +EXCEPTIONS set 0 + +MINIMUM_HEAP_SIZE set 8000 + + if 1 +DESCRIPTOR_ARITY_OFFSET set (-2) +ZERO_ARITY_DESCRIPTOR_OFFSET set (-8) + else +DESCRIPTOR_ARITY_OFFSET set (-8) +ZERO_ARITY_DESCRIPTOR_OFFSET set (-12) + endif + + export r_to_i_buffer + comm r_to_i_buffer,8 + comm heap_mbp,4 + comm heap_p,4 + comm heap_p1,4 + comm heap_p2,4 + comm heap_size_33,4 + if COPIED_VECTOR + comm heap_size_129,4 + comm heap_copied_vector,4 + comm heap_copied_vector_size,4 + comm heap_end_after_copy_gc,4 + endif + comm extra_heap,4 + comm extra_heap_size,4 + comm stack_p,4 + if MACOSX + comm end_a_stack,4 + comm end_b_stack,4 + endif + comm halt_sp,4 +; number of long words requested from the garbage collector + comm alloc_size,4 + comm basic_only,4 + comm last_time,4 + comm execute_time,4 + comm garbage_collect_time,4 + comm IO_time,4 + if MEASURE_GC + comm compact_garbage_collect_time,4 + comm mark_compact_garbage_collect_time,4 + endif + export saved_heap_p + comm saved_heap_p,8 + + export saved_a_stack_p + comm saved_a_stack_p,4 + + comm sprintf_buffer,32 + comm sprintf_time_buffer,20 + + export small_integers + comm small_integers,33*8 + export static_characters + comm static_characters,256*8 + + if EXCEPTIONS + comm exception_info,12 + endif + + comm caf_list,4 + export caf_listp + comm caf_listp,4 + + csect data{RW} + +heap_p3: dc.l 0 +heap_vector:dc.l 0 +heap_end_after_gc: dc.l 0 + + if MARK_GC +bit_counter: + dc.l 0 +bit_vector_p: + dc.l 0 +zero_bits_before_mark: + dc.l 1 +free_after_mark: + dc.l 1000 +last_heap_free: + dc.l 0 +lazy_array_list: + dc.l 0 + if ADJUST_HEAP_SIZE +bit_vector_size: + dc.l 0 ; in bits + endif + endif + + align 2 +zero_length_string: + dc.l __STRING__+2 + dc.l 0 +true_string: + dc.l __STRING__+2 + dc.l 4 +true_c_string: + dc.b 'True' + dc.b 0,0,0,0 +false_string: + dc.l __STRING__+2 + dc.l 5 +false_c_string: + dc.b 'False' + dc.b 0,0,0 +file_c_string: + dc.b 'File' + dc.b 0,0,0,0 + +; -1: compact or mark, no extra heap +; 0: copy, no extra heap +; 1: compact, extra heap +; 2: copy, extra heap +garbage_collect_flag: + dc.b 0 + dc.b 0,0,0 + +out_of_memory_string_1: + dc.b 'Not enough memory to allocate heap and stack' + dc.b 13,0 +printf_int_string: + dc.b '%d' + dc.b 0 +printf_real_string: + dc.b '%g' + dc.b 0 +printf_string_string: + dc.b '%s' + dc.b 0 +printf_char_string: + dc.b '%c' + dc.b 0 +garbage_collect_string_1: + dc.b 'A stack: ' + dc.b 0 +garbage_collect_string_2: + dc.b ' bytes. BC stack: ' + dc.b 0 +garbage_collect_string_3: + dc.b ' bytes.' + dc.b 13,0 +heap_use_after_gc_string_1: + dc.b 'Heap use after garbage collection: ' + dc.b 0 +heap_use_after_gc_string_2: + dc.b ' Bytes.' + dc.b 13,0 +stack_overflow_string: + dc.b 'Stack overflow.' + dc.b 13,0 +out_of_memory_string_4: + dc.b 'Heap full.' + dc.b 13,0 +time_string_1: + dc.b 'Execution: ' + dc.b 0 +time_string_2: + dc.b ' Garbage collection: ' + dc.b 0 + if MEASURE_GC +time_string_2a: + dc.b ' ' + dc.b 0 + endif +time_string_3: + dc.b ' IO: ' + dc.b 0 +time_string_4: + dc.b ' Total: ' + dc.b 0 +high_index_string: + dc.b 'Index too high in UPDATE string.' + dc.b 13,0 +low_index_string: + dc.b 'Index negative in UPDATE string.' + dc.b 13,0 +IO_error_string: + dc.b 'IO error: ' + dc.b 0 +new_line_string: + dc.b 13,0 + +sprintf_time_string: + dc.b '%d.%02d' + dc.b 0 + + if MARK_GC +marked_gc_string_1: + dc.b 'Marked: ' + dc.b 0 + endif + if PROFILE + align 2 + if MODULE_NAMES_IN_TIME_PROFILER +m_system: + dc.l 6 + dc.b 'System' + dc.b 0,0 + dc.l m_system + endif +garbage_collector_name: + dc.l 0 + dc.b 'garbage_collector' + dc.b 0 + align 2 + endif + if WRITE_HEAP + comm heap2_begin_and_end,8 + endif + + align 3 +entier_constants_and_buffers: + dc.d "0.0" + dc.d "0.0" + dc.l 0x43300000 + dc.l 0x00000000 + dc.l 0x43300000 + dc.l 0x80000000 + + if FINALIZERS + import __Nil + import e____system__kFinalizer + import e____system__kFinalizerGCTemp + export finalizer_list + comm finalizer_list,4 + export free_finalizer_list + comm free_finalizer_list,4 + endif + + align 1 + + csect text{PR} + if LINUX + export abc_main + else + export .abc_main + endif + export print_ + export print_char + export print_int + export print_real + export print_sc + export print_symbol + export print_symbol_sc + export print__string__ + export print__chars__sc + export printD + + export eprint__ + export eprint__string__ + export eprintD + + export push_t_r_args + export push_a_r_args + export halt + + export catAC + export sliceAC + export updateAC + export eqAC + export cmpAC + + export string_to_string_node + + export create_array + export create_arrayB + export create_arrayC + export create_arrayI + export create_arrayR + export create_R_array + + export _create_arrayB + export _create_arrayC + export _create_arrayI + export _create_arrayR + export _create_r_array + + export BtoAC + export DtoAC + export ItoAC + export RtoAC + export eqD + + export collect_0,collect_1,collect_2,collect_3 + export collect_00,collect_01,collect_02,collect_03 + + export eval_01,eval_11,eval_02,eval_12,eval_22 + + import e__system__AP + + export e__system__sAP + export yet_args_needed,yet_args_needed_0,yet_args_needed_1 + export yet_args_needed_2,yet_args_needed_3,yet_args_needed_4 + + export _c3,_c4,_c5,_c6,_c7,_c8,_c9,_c10,_c11,_c12 + export _c13,_c14,_c15,_c16,_c17,_c18,_c19,_c20,_c21,_c22 + export _c23,_c24,_c25,_c26,_c27,_c28,_c29,_c30,_c31,_c32 + + export __indirection,__eaind,eval_fill + export eval_upd_0,eval_upd_1,eval_upd_2,eval_upd_3,eval_upd_4 + export eval_upd_5,eval_upd_6,eval_upd_7,eval_upd_8,eval_upd_9 + export eval_upd_10,eval_upd_11,eval_upd_12,eval_upd_13,eval_upd_14 + export eval_upd_15,eval_upd_16,eval_upd_17,eval_upd_18,eval_upd_19 + export eval_upd_20,eval_upd_21,eval_upd_22,eval_upd_23,eval_upd_24 + export eval_upd_25,eval_upd_26,eval_upd_27,eval_upd_28,eval_upd_29 + export eval_upd_30,eval_upd_31,eval_upd_32 + + export repl_args_b + export push_arg_b + export del_args + if 0 + export o__S_P2 + export ea__S_P2 + endif + export .add_IO_time + export .add_execute_time + + export .IO_error + export print_error + export stack_overflow + + export out_of_memory_4 + + export acos_real + export asin_real + export atan_real + export cos_real + export sin_real + export tan_real + export ln_real + export log10_real + export exp_real + export sqrt_real + export pow_real + export entier_real + if LINUX + else + export .my_pointer_glue{PR} + endif + if EXCEPTIONS + export e__Exceptions__scatch__exception + export e__Exceptions__sraise__exception + endif + if LINUX + import __start + else + import _start + endif + export __driver + + +; from system.abc: + import INT + import CHAR + import BOOL + import REAL + import __STRING<='STRING' + import FILE + import __STRING__ + import __ARRAY__ + import __cycle__in__spine + import __print__graph + import __eval__to__nf + + if STDERR_TO_FILE + import .close_stderr_file + endif + +; from cgcon.c: + import .w_print_char + import .w_print_text + import .w_print_int + import .w_print_real + import .w_print_string + + if STDERR_TO_FILE + import .er_print_char + import .er_print_string + import .er_print_int + import .er_print_text + else + import .ew_print_char + import .ew_print_string + import .ew_print_int + endif + if 0 + + import .wait_for_key_press + else + import execution_aborted + endif + import stack_size + import heap_size + import flags + if ADJUST_HEAP_SIZE + import heap_size_multiple + import initial_heap_size + endif + +; from standard c library: + import .sprintf + if LINUX + import malloc + import free + else + import .NewPtr + import .DisposePtr + import .TickCount + if 0 + import .Debugger + endif + endif + import .acos + import .asin + import .atan + import .cos + import .sin + import .tan + import .log + import .log10 + import .exp + import .sqrt + import .pow + + if PROFILE + import init_profiler + import profile_s,profile_n,profile_r,profile_ti + import write_profile_information,write_profile_stack + endif + + if LINUX +abc_main: + else +.abc_main: + endif + mflr r0 + stwu r0,-4(sp) + stmw r13,-76(sp) + subi sp,sp,76 + + lea o0,flags + lwz d0,0(o0) + lea o0,basic_only + andi. d0,d0,1 + stw d0,0(o0) + + lea o0,heap_size + lwz d0,0(o0) + subi o0,d0,3 + li o1,33 + divwu o0,o0,o1 + lea o1,heap_size_33 + stw o0,0(o1) + + if COPIED_VECTOR + lea o0,heap_size + li o1,129 + lwz d0,0(o0) + subi o0,d0,7 + divwu o0,o0,o1 + lea o1,heap_size_129 + stw o0,0(o1) + addi o0,o0,3 + lea o1,heap_copied_vector_size + clrrwi o0,o0,2 + stw o0,0(o1) + + lea o1,heap_end_after_copy_gc + li g0,0 + stw g0,0(o1) + endif + + lea o1,heap_size + lwz o0,0(o1) + addi o0,o0,7 + clrrwi o0,o0,3 + stw o0,0(o1) + addi o0,o0,3+4 + + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + else + stwu sp,-64(sp) + endif + + if LINUX + bl malloc + else + bl .NewPtr + endif + nop + if MACOSX + lwz sp,0(sp) + else + addi sp,sp,64 + endif + cmpwi 0,o0,0 + beq no_memory_1 + + lea o1,heap_mbp + stw o0,0(o1) + + addi o0,o0,3 + clrrwi a6,o0,2 + + lea o0,heap_p + lea o1,heap_p1 + stw a6,0(o0) + stw a6,0(o1) + if MACOSX + lea o0,stack_size + lwz o0,0(o0) + + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + + bl .NewPtr + nop + + lwz sp,0(sp) + + cmpwi 0,o0,0 + beq no_memory_1 + + mr a4,o0 + lea o0,stack_p + stw a4,0(o0) + + lea o0,stack_size + addi d0,sp,128 + lwz d1,0(o0) + + lea o0,end_a_stack + sub d0,d0,d1 + add d1,a4,d1 + stw d1,0(o0) + + lea o0,end_b_stack + stw d0,0(o0) + else + lea o0,stack_size + addi d0,sp,-128 + lwz o0,0(o0) + sub a4,d0,o0 + + lea o0,stack_p + stw a4,0(o0) + endif + lea a0,small_integers + li d0,0 + lea d1,INT2 +make_small_integers_lp: + stw d1,0(a0) + stw d0,4(a0) + addi d0,d0,1 + cmpwi 0,d0,33 + addi a0,a0,8 + bne make_small_integers_lp + + lea a0,static_characters + li d0,0 + lea d1,CHAR2 +make_static_characters_lp: + stw d1,0(a0) + stw d0,4(a0) + addi d0,d0,1 + cmpwi 0,d0,256 + addi a0,a0,8 + bne make_static_characters_lp + + lea o0,caf_listp + if LINUX + lea a0,caf_list+4 + else + lea a0,caf_list4 + endif + stw a0,0(o0) + li g0,0 + stw g0,-4(a0) + + if FINALIZERS + lea o0,finalizer_list + lea o1,free_finalizer_list + lea a0,__Nil_m8 + stw a0,0(o0) + stw a0,0(o1) + endif + + if COPIED_VECTOR + lea o0,heap_size_129 + lwz d1,0(o0) + slwi d7,d1,6-2 + slwi d1,d1,6 + lea o0,heap_copied_vector + add d0,a6,d1 + lea o1,heap_copied_vector_size + stw d0,0(o0) + lwz o1,0(o1) + lea o0,heap_p2 + add d0,d0,o1 + stw d0,0(o0) + else + lea o0,heap_size + lwz d1,0(o0) + lea o0,heap_p2 + srwi d1,d1,1 + add d0,a6,d1 + srwi d7,d1,2 + stw d0,0(o0) + endif + + lea o0,garbage_collect_flag + li g0,0 + stb g0,0(o0) + + if MARK_AND_COPY_GC + lea o0,flags + lwz o0,0(o0) + andi. r0,o0,64 + beq no_mark1 + endif + + if MARK_GC || COMPACT_GC_ONLY + lea o0,heap_size_33 + lea o1,heap_vector + lwz d0,0(o0) + stw a6,0(o1) + slwi d7,d0,3 + add a6,a6,d0 + addi a6,a6,3 + lea o0,heap_p3 + clrrwi a6,a6,2 + stw a6,0(o0) + lea o0,garbage_collect_flag + li d0,-1 + stb d0,0(o0) + endif + + if MARK_AND_COPY_GC +no_mark1: + endif + + if ADJUST_HEAP_SIZE + lea d0,initial_heap_size + lea o0,flags + lwz d0,0(d0) + if MARK_AND_COPY_GC + lwz o0,0(o0) + li d1,MINIMUM_HEAP_SIZE/2 + andi. r0,o0,64 + bne no_mark9 + add d1,d1,d1 +no_mark9: + else + if MARK_GC || COMPACT_GC_ONLY + li d1,MINIMUM_HEAP_SIZE + else + li d1,MINIMUM_HEAP_SIZE/2 + endif + endif + cmpw d0,d1 + ble too_large_or_too_small + srwi d0,d0,2 + cmpw d0,d7 + bge too_large_or_too_small + mr d7,d0 +too_large_or_too_small: + endif + + if MARK_AND_COPY_GC + lea o0,flags + lwz o0,0(o0) + andi. r0,o0,64 + beq no_mark2 + endif + + if MARK_GC && ADJUST_HEAP_SIZE + lea o0,bit_vector_size + stw d7,0(o0) + endif + + if MARK_AND_COPY_GC +no_mark2: + endif + + lea o0,heap_end_after_gc + slwi d0,d7,2 + add d0,a6,d0 + stw d0,0(o0) + + lea o0,halt_sp + stw sp,0(o0) + + if EXCEPTIONS + lea o0,exception_info + li o1,0 + stw o1,0(o0) + endif + bl _init_timer + + + lea a5,__cycle__in__spine + lea int_reg,INT2 + lea char_reg,CHAR2 + lea real_reg,REAL2 + lea bool_reg,BOOL2 + + if USE_DCBZ + subi d7,d7,15 + li g2,32 + endif + + li r0,-1 + if PROFILE + stwu r0,-4(sp) + bl init_profiler + endif + stwu r0,-4(sp) + + if 0 + stwu sp,-64(sp) + bl .Debugger + nop + addi sp,sp,64 + endif + + subi a6,a6,4 + + if LINUX + bl __start + else + bl _start + endif + nop + +exit: + bl .add_execute_time + + lea o0,flags + lwz d0,0(o0) + andi. g0,d0,8 + beq no_print_execution_time + + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + else + stwu sp,-64(sp) + endif + + lea o0,time_string_1 + if STDERR_TO_FILE + bl .er_print_string + else + bl .ew_print_string + endif + nop + + lea a0,execute_time + lwz d0,0(a0) + bl _print_time + + lea o0,time_string_2 + if STDERR_TO_FILE + bl .er_print_string + else + bl .ew_print_string + endif + + lea a0,garbage_collect_time + lwz d0,0(a0) + bl _print_time + + if MEASURE_GC + lea o0,time_string_2a + if STDERR_TO_FILE + bl .er_print_string + else + bl .ew_print_string + endif + lea a0,mark_compact_garbage_collect_time + lwz d0,0(a0) + bl _print_time + + lea o0,time_string_2a + if STDERR_TO_FILE + bl .er_print_string + else + bl .ew_print_string + endif + lea a0,compact_garbage_collect_time + lwz d0,0(a0) + bl _print_time + endif + + lea o0,time_string_3 + if STDERR_TO_FILE + bl .er_print_string + else + bl .ew_print_string + endif + + lea a0,IO_time + lwz d0,0(a0) + bl _print_time + + lea o0,time_string_4 + if STDERR_TO_FILE + bl .er_print_string + else + bl .ew_print_string + endif + + lea a0,execute_time + lwz d0,0(a0) + lea a0,garbage_collect_time + lwz d2,0(a0) + add d0,d0,d2 + if MEASURE_GC + lea a0,mark_compact_garbage_collect_time + lwz d2,0(a0) + add d0,d0,d2 + lea a0,compact_garbage_collect_time + lwz d2,0(a0) + add d0,d0,d2 + endif + lea a0,IO_time + lwz d2,0(a0) + add d0,d0,d2 + + bl _print_time + + li o0,13 + if STDERR_TO_FILE + bl .er_print_char + else + bl .ew_print_char + endif + nop + + if MACOSX + lwz sp,0(sp) + else + addi sp,sp,64 + endif +no_print_execution_time: + +exit_3: +exit_2: + lea o0,heap_mbp + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + else + stwu sp,-64(sp) + endif + lwz o0,0(o0) + if LINUX + bl free + else + bl .DisposePtr + endif + nop + if MACOSX + lwz sp,0(sp) + else + addi sp,sp,64 + endif + +exit_1: + if STDERR_TO_FILE + lea o0,flags + lwz d0,0(o0) + andi. g0,d0,128 + beq no_close_stderr_file + + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + else + stwu sp,-64(sp) + endif + bl .close_stderr_file + nop + if MACOSX + lwz sp,0(sp) + else + addi sp,sp,64 + endif + +no_close_stderr_file: + endif + if PROFILE + mflr r0 + stwu r0,-4(sp) + bl write_profile_information + endif + + lwz r0,76(sp) + mtlr r0 + lmw r13,0(sp) + addi sp,sp,80 + blr + +__driver: + lea o1,flags + lwz o0,0(o1) + andi. r0,o0,16 + bne _eval__to__nf + b __print__graph +_eval__to__nf: + b __eval__to__nf + +_print_time: + mflr r0 + stwu r0,-4(sp) + + if LINUX + li o1,100 + else + li o1,60 + endif + divwu o2,d0,o1 + + if LINUX + mulli o3,o2,100 + sub o3,d0,o3 + else + mulli o3,o2,60 + sub o3,d0,o3 + mulli o3,o3,5 + li o1,3 + divwu o3,o3,o1 + endif + lea o1,sprintf_time_string + lea o0,sprintf_time_buffer + + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + else + stwu sp,-64(sp) + endif + bl .sprintf + nop + + lea o0,sprintf_time_buffer + if STDERR_TO_FILE + bl .er_print_string + else + bl .ew_print_string + endif + nop + if MACOSX + lwz sp,0(sp) + else + addi sp,sp,64 + endif + lwz r0,0(sp) + addi sp,sp,4 + mtlr r0 + + blr + +no_memory_1: + lea o0,out_of_memory_string_1 + + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + else + stwu sp,-64(sp) + endif + if STDERR_TO_FILE + bl .er_print_string + else + bl .ew_print_string + endif + nop + if MACOSX + lwz sp,0(sp) + else + addi sp,sp,64 + endif + b exit_1 + +print_sc: + lea o0,basic_only + lwz o1,0(o0) + cmpwi 0,o1,0 + bne end_print +print_: + mr o0,d0 + +print_string_o0_and_return: + mflr r0 + stwu r0,-4(sp) + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + else + stwu sp,-64(sp) + endif + bl .w_print_string +#ifdef USE_DCBZ + li g2,32 +#endif + if MACOSX + lwz sp,0(sp) + lwz r0,0(sp) + addi sp,sp,8 + else + lwz r0,64(sp) + addi sp,sp,72 + endif + mtlr r0 + lwz r0,-4(sp) + blr + +end_print: + lwz r0,0(sp) + addi sp,sp,4 + blr + +printD: andi. r0,d0,2 + bne printD_ + + mr a2,d0 + b print_string_a2 + +print_symbol: + li d1,0 + b print_symbol_2 + +print_symbol_sc: + lea o0,basic_only + lwz d1,0(o0) +print_symbol_2: + lwz d0,0(a0) + + cmpw 0,int_reg,d0 + beq print_int_node + + cmpw 0,char_reg,d0 + beq print_char_node + + cmpw 0,bool_reg,d0 + beq print_bool + + cmpw 0,real_reg,d0 + beq print_real_node + + cmpwi 0,d1,0 + bne end_print_symbol + +printD_: lha d1,-2(d0) + addi a2,d0,-2 + + cmplwi 0,d1,256 + bge print_record + + slwi d1,d1,3 + sub a2,a2,d1 + + lhz d1,DESCRIPTOR_ARITY_OFFSET(a2) + addi a2,a2,4 + slwi d1,d1,3 + add a2,a2,d1 + b print_string_a2 + +print_record: + lwz a2,-4(a2) + b print_string_a2 + +end_print_symbol: + lwz r0,0(sp) + addi sp,sp,4 + blr + +print_int_node: + lwz o0,4(a0) +print_int2: + mflr r0 + stwu r0,-4(sp) + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + else + stwu sp,-64(sp) + endif + bl .w_print_int +#ifdef USE_DCBZ + li g2,32 +#endif + if MACOSX + lwz sp,0(sp) + lwz r0,0(sp) + addi sp,sp,8 + else + lwz r0,64(sp) + addi sp,sp,72 + endif + mtlr r0 + lwz r0,-4(sp) + blr + +print_int: + mr o0,d0 + b print_int2 + +print_char: + lea o0,basic_only + lwz d1,0(o0) + cmpwi 0,d1,0 + bne print_char_node_bo + + b print_char_node_sc + +print_char_node: + cmpwi 0,d1,0 + lwz d0,4(a0) + bne print_char_node_sc +print_char_node_bo: + mflr r0 + stwu r0,-4(sp) + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + else + stwu sp,-64(sp) + endif + li o0,0x27 + bl .w_print_char + + mr o0,d0 + bl .w_print_char + + li o0,0x27 + bl .w_print_char +#ifdef USE_DCBZ + li g2,32 +#endif + if MACOSX + lwz sp,0(sp) + lwz r0,0(sp) + addi sp,sp,8 + else + lwz r0,64(sp) + addi sp,sp,72 + endif + mtlr r0 + lwz r0,-4(sp) + blr + +print_char_node_sc: + mr o0,d0 + + mflr r0 + stwu r0,-4(sp) + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + else + stwu sp,-64(sp) + endif + bl .w_print_char +#ifdef USE_DCBZ + li g2,32 +#endif + if MACOSX + lwz sp,0(sp) + lwz r0,0(sp) + addi sp,sp,8 + else + lwz r0,64(sp) + addi sp,sp,72 + endif + mtlr r0 + lwz r0,-4(sp) + blr + +print_bool: + lbz o0,7(a0) + cmpwi 0,o0,0 + beq print_false + +print_true: + lea o0,true_c_string + b print_string_o0_and_return + +print_false: + lea o0,false_c_string + b print_string_o0_and_return + +print_real: + fmr f1,f14 + b print_real_ +print_real_node: + lfd f1,4(a0) +print_real_: + mflr r0 + stwu r0,-4(sp) + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + else + stwu sp,-64(sp) + endif + bl .w_print_real +#ifdef USE_DCBZ + li g2,32 +#endif + if MACOSX + lwz sp,0(sp) + lwz r0,0(sp) + addi sp,sp,8 + else + lwz r0,64(sp) + addi sp,sp,72 + endif + mtlr r0 + lwz r0,-4(sp) + blr + +print_string_a2: + lwz o1,0(a2) + addi o0,a2,4 + + mflr r0 + stwu r0,-4(sp) + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + else + stwu sp,-64(sp) + endif + bl .w_print_text +#ifdef USE_DCBZ + li g2,32 +#endif + if MACOSX + lwz sp,0(sp) + lwz r0,0(sp) + addi sp,sp,8 + else + lwz r0,64(sp) + addi sp,sp,72 + endif + mtlr r0 + lwz r0,-4(sp) + blr + +print__chars__sc: + lea o0,basic_only + lwz d1,0(o0) + cmpwi 0,d1,0 + bne no_print_chars + +print__string__: + lwz o1,4(a0) + addi o0,a0,8 + + mflr r0 + stwu r0,-4(sp) + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + else + stwu sp,-64(sp) + endif + bl .w_print_text +#ifdef USE_DCBZ + li g2,32 +#endif + if MACOSX + lwz sp,0(sp) + lwz r0,0(sp) + addi sp,sp,8 + else + lwz r0,64(sp) + addi sp,sp,72 + endif + mtlr r0 + lwz r0,-4(sp) + blr + +no_print_chars: + lwz r0,0(sp) + addi sp,sp,4 + blr + + csect .eprint__ +eprint__: + mr o0,d0 + + mflr r0 + stwu r0,-4(sp) + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + else + stwu sp,-64(sp) + endif + if STDERR_TO_FILE + bl .er_print_string + else + bl .ew_print_string + endif +#ifdef USE_DCBZ + li g2,32 +#endif + if MACOSX + lwz sp,0(sp) + lwz r0,0(sp) + addi sp,sp,8 + else + lwz r0,64(sp) + addi sp,sp,72 + endif + mtlr r0 + lwz r0,-4(sp) + blr + + csect .eprint__string__ +eprint__string__: + lwz o1,4(a0) + addi o0,a0,8 + + mflr r0 + stwu r0,-4(sp) + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + else + stwu sp,-64(sp) + endif + if STDERR_TO_FILE + bl .er_print_text + else + bl .ew_print_text + endif +#ifdef USE_DCBZ + li g2,32 +#endif + if MACOSX + lwz sp,0(sp) + lwz r0,0(sp) + addi sp,sp,8 + else + lwz r0,64(sp) + addi sp,sp,72 + endif + mtlr r0 + lwz r0,-4(sp) + blr + + csect .eprintD +eprintD: andi. r0,d0,2 + bne eprintD_ + + mr a2,d0 + b eprint_string_a2 + +eprintD_: lha d1,-2(d0) + addi a2,d0,-2 + + cmplwi 0,d1,256 + bge eprint_record + + slwi d1,d1,3 + sub a2,a2,d1 + + lhz d1,DESCRIPTOR_ARITY_OFFSET(a2) + addi a2,a2,4 + slwi d1,d1,3 + add a2,a2,d1 + b eprint_string_a2 + +eprint_record: + lwz a2,-4(a2) + +eprint_string_a2: + lwz o1,0(a2) + addi o0,a2,4 + + mflr r0 + stwu r0,-4(sp) + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + else + stwu sp,-64(sp) + endif + if STDERR_TO_FILE + bl .er_print_text + else + bl .ew_print_text + endif +#ifdef USE_DCBZ + li g2,32 +#endif + if MACOSX + lwz sp,0(sp) + lwz r0,0(sp) + addi sp,sp,8 + else + lwz r0,64(sp) + addi sp,sp,72 + endif + mtlr r0 + lwz r0,-4(sp) + blr + + csect .DtoAC + +DtoAC: lha d1,-2(d0) + addi a0,d0,-2 + + cmplwi 0,d1,256 + bge DtoAC_record + + slwi d1,d1,3 + bsub a0,d1 + if 1 + lhz d1,DESCRIPTOR_ARITY_OFFSET(a0) + baddi a0,4 + slwi d1,d1,3 + badd a0,d1 + endif +DtoAC_a0: + lwz d2,0(a0) + mr a2,a0 + + addi d3,d2,3 + bsubi d7,2 + + srwi d3,d3,2 + sub. d7,d7,d3 + blt DtoAC_gc +DtoAC_r_gc: + lea o1,__STRING__2 + + subic. d3,d3,1 + + addi a0,a6,4 + stw o1,4(a6) + stwu d2,8(a6) + blt DtoAC_copy + +DtoAC_copy_lp: + lwzu o0,4(a2) + subic. d3,d3,1 + stwu o0,4(a6) + bge DtoAC_copy_lp +DtoAC_copy: + + lwz r0,0(sp) + baddi sp,4 + blr + +DtoAC_gc: mflr r0 + mr d0,a0 + bl collect_0 + mr a2,d0 + b DtoAC_r_gc + +DtoAC_record: + lwz a0,-4(a0) + b DtoAC_a0 + + csect .push_a_r_args +push_a_r_args: + lwz a1,8(a0) + subi a1,a1,2 + lhz d3,0(a1) + subi d3,d3,256 + lhz d1,2(a1) + addi a1,a1,4 + sub d2,d3,d1 + slwi d0,d0,2 + + mullw d4,d0,d3 + addi a0,a0,12 + add a0,a0,d4 + + lwz r0,0(sp) + addi sp,sp,4 + + slwi o0,d1,2 + add a0,a0,o0 + mr a3,a0 + b push_a_elements + +push_a_elements_lp: + lwzu o0,-4(a3) + addi a4,a4,4 + stw o0,-4(a4) +push_a_elements: + subic. d1,d1,1 + bge push_a_elements_lp + + slwi o0,d2,2 + add a0,a0,o0 + b push_b_elements + +push_b_elements_lp: + lwzu o0,-4(a0) + stwu o0,-4(sp) +push_b_elements: + subic. d2,d2,1 + bge push_b_elements_lp + + mr d0,a1 + blr + +push_t_r_args: + lwz a1,0(a0) + addi a0,a0,4 + subi a1,a1,2 + lhz d3,0(a1) + lhz d1,2(a1) + subi d3,d3,256 + addi d0,a1,4 + sub d2,d3,d1 + + slwi d4,d3,2 + cmplwi 0,d3,2 + add a1,a0,d4 + ble small_record + + lwz a1,4(a0) + subi a1,a1,4 + add a1,a1,d4 +small_record: + lwz r0,0(sp) + addi sp,sp,4 + b push_r_b_elements + +push_r_b_elements_lp: + subic. d3,d3,1 + bne not_first_arg_b + + lwz o0,0(a0) + stwu o0,-4(sp) + b push_r_b_elements +not_first_arg_b: + lwzu o0,-4(a1) + stwu o0,-4(sp) +push_r_b_elements: + subic. d2,d2,1 + bge push_r_b_elements_lp + + b push_r_a_elements + +push_r_a_elements_lp: + subic. d3,d3,1 + addi a4,a4,4 + bne not_first_arg_a + + lwz o0,0(a0) + stw o0,-4(a4) + b push_r_a_elements + +not_first_arg_a: + lwzu o0,-4(a1) + stw o0,-4(a4) +push_r_a_elements: + subic. d1,d1,1 + bge push_r_a_elements_lp + + blr + + csect .BtoAC +BtoAC: + andi. d0,d0,255 + beq BtoAC_false +BtoAC_true: + lea a0,true_string + lwz r0,0(sp) + addi sp,sp,4 + blr +BtoAC_false: + lea a0,false_string + lwz r0,0(sp) + addi sp,sp,4 + blr + + csect .RtoAC +RtoAC: + if LINUX + fmr f1,f14 + else + stfd f14,-8(sp) + endif + lea o1,printf_real_string + lea o0,sprintf_buffer + if LINUX + creqv 6,6,6 + else + lwz o2,-8(sp) + lwz o3,-4(sp) + endif + mflr r0 + if MACOSX + stwu r0,-4(sp) + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + else + stw r0,-4(sp) + stwu sp,-64(sp) + endif + bl .sprintf + nop + if MACOSX + lwz sp,0(sp) + lwz r0,0(sp) + addi sp,sp,4 + else + lwz r0,60(sp) + addi sp,sp,64 + endif + mtlr r0 + + b return_sprintf_buffer_string + + csect .ItoAC +ItoAC: + if MY_ITOS + lea a0,sprintf_buffer + cmpwi 0,d0,0 + bge no_minus + + li o0,45 + stb o0,0(a0) + addi a0,a0,1 + li g0,0 + sub d0,g0,d0 +no_minus: + addi a2,a0,12 + beq zero_digit + +calculate_digits: + cmplwi 0,d0,10 + blt last_digit + + li o1,10 + divwu o0,d0,o1 + + mullw a1,o0,o1 + sub a1,d0,a1 + addi a1,a1,48 + + stb a1,0(a2) + addi a2,a2,1 + + mr d0,o0 + b calculate_digits + +last_digit: + cmpwi 0,d0,0 + beq no_zero +zero_digit: + addi d0,d0,48 + stb d0,0(a2) + addi a2,a2,1 +no_zero: + addi a1,a0,12 + +reverse_digits: + lbzu d1,-1(a2) + cmpw 0,a2,a1 + stb d1,0(a0) + addi a0,a0,1 + bne reverse_digits + + li g0,0 + lea d0,sprintf_buffer + + stb g0,0(a0) + sub d0,a0,d0 + b sprintf_buffer_to_string + + else + mr o2,d0 + lea o1,printf_int_string + lea o0,sprintf_buffer + + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + else + stwu sp,-64(sp) + endif + bl .sprintf + nop + if MACOSX + lwz sp,0(sp) + else + addi sp,sp,64 + endif + endif + +return_sprintf_buffer_string: + lea o0,sprintf_buffer + li d0,-1 + subi o0,o0,1 + +count_chars_in_c_string: + lbzu d1,1(o0) + addi d0,d0,1 + cmpwi d1,0 + bne count_chars_in_c_string + + if MY_ITOS +sprintf_buffer_to_string: + endif + addi d1,d0,3 + srwi d1,d1,2 + subi d7,d7,2 + sub. d7,d7,d1 + bge+ D_to_S_no_gc + + mflr r0 + bl collect_0 + +D_to_S_no_gc: + lea a0,sprintf_buffer + lea o0,__STRING__2 + addi d2,a6,4 + stw o0,4(a6) + stwu d0,8(a6) + b D_to_S_cp_str_2 + +D_to_S_cp_str_1: + lwz o0,0(a0) + addi a0,a0,4 + stwu o0,4(a6) +D_to_S_cp_str_2: + subic. d1,d1,1 + bge D_to_S_cp_str_1 + + mr a0,d2 + lwz r0,0(sp) + addi sp,sp,4 +#ifdef USE_DCBZ + li g2,32 +#endif + blr + + csect .eqD +eqD: lwz d0,0(a0) + lwz o0,0(a1) + cmpw 0,d0,o0 + bne eqD_false + + cmpw 0,d0,int_reg + beq eqD_INT + + cmpw 0,d0,char_reg + beq eqD_CHAR + + cmpw 0,d0,bool_reg + beq eqD_BOOL + + cmpw 0,d0,real_reg + beq eqD_REAL + + li d0,-1 + + lwz r0,0(sp) + addi sp,sp,4 + blr + +eqD_CHAR: +eqD_INT: lwz d1,4(a0) + lwz o0,4(a1) + li d0,0 + cmpw 0,d1,o0 + + mfcr d0 + srwi d0,d0,31-2 + andi. d0,d0,1 + + lwz r0,0(sp) + addi sp,sp,4 + blr + +eqD_BOOL: lbz d1,7(a0) + lbz o0,7(a1) + li d0,0 + cmpw 0,d1,o0 + + mfcr d0 + srwi d0,d0,31-2 + andi. d0,d0,1 + + lwz r0,0(sp) + addi sp,sp,4 + blr + +eqD_REAL: lfd f0,4(a0) + lfd f1,4(a1) + + fcmpo 0,f0,f1 + + mfcr d0 + srwi d0,d0,31-2 + andi. d0,d0,1 + + lwz r0,0(sp) + addi sp,sp,4 + blr + +eqD_false: + li d0,0 + + lwz r0,0(sp) + addi sp,sp,4 + blr + +; +; the timer +; + +_init_timer: + mflr r0 + stwu r0,-4(sp) + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + else + stwu sp,-64(sp) + endif + if LINUX + addi o0,sp,8 + bl times + lwz o0,8(sp) + else + bl .TickCount + nop + endif + if MACOSX + lwz sp,0(sp) + else + addi sp,sp,64 + endif + lwz r0,0(sp) + addi sp,sp,4 + mtlr r0 + + lea o1,last_time + stw o0,0(o1) + + lea o1,execute_time + li o0,0 + stw o0,0(o1) + + lea o1,garbage_collect_time + stw o0,0(o1) + if MEASURE_GC + lea o1,mark_compact_garbage_collect_time + stw o0,0(o1) + + lea o1,compact_garbage_collect_time + stw o0,0(o1) + endif + lea o1,IO_time + stw o0,0(o1) + + blr + +_get_time_diff: + mflr r0 + stwu r0,-4(sp) + + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + else + stwu sp,-64(sp) + endif + if LINUX + addi o0,sp,8 + bl times + lwz o0,8(sp) + else + bl .TickCount + nop + endif + if MACOSX + lwz sp,0(sp) + else + addi sp,sp,64 + endif + lea o2,last_time + + lwz r0,0(sp) + addi sp,sp,4 + mtlr r0 + + lwz o1,0(o2) + stw o0,0(o2) + sub o0,o0,o1 + + blr + +.add_execute_time: + mflr r0 + stwu r0,-4(sp) + + bl _get_time_diff + + lea o2,execute_time + + lwz r0,0(sp) + addi sp,sp,4 + mtlr r0 + + lwz o1,0(o2) + add o1,o1,o0 + stw o1,0(o2) + + blr + +.add_garbage_collect_time: + mflr r0 + stwu r0,-4(sp) + + bl _get_time_diff + + lea o2,garbage_collect_time + + lwz r0,0(sp) + addi sp,sp,4 + mtlr r0 + + lwz o1,0(o2) + add o1,o1,o0 + stw o1,0(o2) + + blr + +.add_IO_time: + mflr r0 + stwu r0,-4(sp) + + bl _get_time_diff + + lea o2,IO_time + + lwz r0,0(sp) + addi sp,sp,4 + mtlr r0 + + lwz o1,0(o2) + add o1,o1,o0 + stw o1,0(o2) + + blr + + if MEASURE_GC +.add_mark_compact_garbage_collect_time: + mflr r0 + stwu r0,-4(sp) + + bl _get_time_diff + + lea o2,mark_compact_garbage_collect_time + + lwz r0,0(sp) + addi sp,sp,4 + mtlr r0 + + lwz o1,0(o2) + add o1,o1,o0 + stw o1,0(o2) + + blr + +.add_compact_garbage_collect_time: + mflr r0 + stwu r0,-4(sp) + + bl _get_time_diff + + lea o2,compact_garbage_collect_time + + lwz r0,0(sp) + addi sp,sp,4 + mtlr r0 + + lwz o1,0(o2) + add o1,o1,o0 + stw o1,0(o2) + + blr + endif +; +; the garbage collector +; + + csect .collect_3 +collect_3: + stwu r0,-4(sp) + if PROFILE + lea r3,garbage_collector_name + mflr r0 + bl profile_s + endif + stw a0,0(a4) + stw a1,4(a4) + stw a2,8(a4) + addi a4,a4,12 + + mflr r0 + bl collect_ + + lwz a2,-4(a4) + lwz a1,-8(a4) + lwzu a0,-12(a4) + + lwz r0,0(sp) + mtctr r0 + lwz r0,4(sp) + mtlr r0 + addi sp,sp,8 + if PROFILE + b profile_ti + else + bctr + endif + + csect .collect_2 +collect_2: + stwu r0,-4(sp) + if PROFILE + lea r3,garbage_collector_name + mflr r0 + bl profile_s + endif + stw a0,0(a4) + stw a1,4(a4) + addi a4,a4,8 + + mflr r0 + bl collect_ + + lwz a1,-4(a4) + lwzu a0,-8(a4) + + lwz r0,0(sp) + mtctr r0 + lwz r0,4(sp) + mtlr r0 + addi sp,sp,8 + if PROFILE + b profile_ti + else + bctr + endif + + csect .collect_1 +collect_1: + stwu r0,-4(sp) + if PROFILE + lea r3,garbage_collector_name + mflr r0 + bl profile_s + endif + stw a0,0(a4) + addi a4,a4,4 + + mflr r0 + bl collect_ + + lwzu a0,-4(a4) + + lwz r0,0(sp) + mtctr r0 + lwz r0,4(sp) + mtlr r0 + addi sp,sp,8 + if PROFILE + b profile_ti + else + bctr + endif + + csect .collect_0 +collect_0: + stwu r0,-4(sp) + if PROFILE + lea r3,garbage_collector_name + mflr r0 + bl profile_s + endif + mflr r0 + bl collect_ + + lwz r0,0(sp) + mtctr r0 + lwz r0,4(sp) + mtlr r0 + addi sp,sp,8 + if PROFILE + b profile_ti + else + bctr + endif + + csect .collect_03 +collect_03: + stwu r0,-4(sp) + if PROFILE + lea r3,garbage_collector_name + mflr r0 + bl profile_s + endif + stw a0,0(a4) + stw a1,4(a4) + stw a2,8(a4) + addi a4,a4,12 + + mflr r0 + bl collect_ + + lwz a2,-4(a4) + lwz a1,-8(a4) + lwzu a0,-12(a4) + + lwz r0,0(sp) + mtctr r0 + lwz r0,4(sp) + addi sp,sp,8 + if PROFILE + b profile_ti + else + bctr + endif + + csect .collect_02 +collect_02: + stwu r0,-4(sp) + if PROFILE + lea r3,garbage_collector_name + mflr r0 + bl profile_s + endif + stw a0,0(a4) + stw a1,4(a4) + addi a4,a4,8 + + mflr r0 + bl collect_ + + lwz a1,-4(a4) + lwzu a0,-8(a4) + + lwz r0,0(sp) + mtctr r0 + lwz r0,4(sp) + addi sp,sp,8 + if PROFILE + b profile_ti + else + bctr + endif + + csect .collect_01 +collect_01: + stwu r0,-4(sp) + if PROFILE + lea r3,garbage_collector_name + mflr r0 + bl profile_s + endif + stw a0,0(a4) + addi a4,a4,4 + + mflr r0 + bl collect_ + + lwzu a0,-4(a4) + + lwz r0,0(sp) + mtctr r0 + lwz r0,4(sp) + addi sp,sp,8 + if PROFILE + b profile_ti + else + bctr + endif + + csect .collect_00 +collect_00: + stwu r0,-4(sp) + if PROFILE + lea r3,garbage_collector_name + mflr r0 + bl profile_s + endif + mflr r0 + bl collect_ + + lwz r0,0(sp) + mtctr r0 + lwz r0,4(sp) + addi sp,sp,8 + if PROFILE + b profile_ti + else + bctr + endif + + + csect ._collect_ +collect_: + stwu r0,-4(sp) + + addi a6,a6,4 + if USE_DCBZ + addi d7,d7,15 + endif + + if MARK_AND_COPY_GC + lea o0,flags + lwz o0,0(o0) + andi. r0,o0,64 + beq no_mark3 + endif + + if MARK_GC + lea g1,bit_counter + lwz o2,0(g1) + li g0,0 + + tst o2 + beq no_scan + + mtctr o2 + + lea o4,heap_end_after_gc + lea a0,bit_vector_p + lwz o4,0(o4) + lwz a0,0(a0) + sub o4,o4,a6 + srwi o4,o4,2 + sub o4,o4,d7 + +scan_bits: + lwz o0,0(a0) + addi a0,a0,4 + cmpwi o0,0 + beq zero_bits + stw g0,-4(a0) + bdnz scan_bits + + b end_scan + +zero_bits: + mr a1,a0 + bdnz skip_zero_bits_lp+4 + b end_bits + +skip_zero_bits_lp: + bne end_zero_bits + lwz o3,0(a0) + addi a0,a0,4 + tst o3 + bdnz skip_zero_bits_lp + + beq end_bits + stw g0,-4(a0) + sub o3,a0,a1 + b end_bits2 + +end_zero_bits: + lea g1,free_after_mark + + sub o3,a0,a1 + slwi o3,o3,3 + + cmplw 0,o3,o4 + + lwz o1,0(g1) + stw g0,-4(a0) + + add o1,o1,o3 + stw o1,0(g1) + blt scan_bits + +found_free_memory: + mfctr o2 + lea o1,bit_counter + lea g1,bit_vector_p + stw o2,0(o1) + stw a0,0(g1) + + lea o1,heap_vector + sub d7,o3,o4 + + lwz o1,0(o1) + subi o2,a1,4 + lea g1,heap_p3 + sub o2,o2,o1 + lwz o1,0(g1) + slwi o2,o2,5 + + add a6,o2,o1 + + slwi o3,o3,2 + lea g1,heap_end_after_gc + add o2,a6,o3 + stw o2,0(g1) + + if USE_DCBZ + subi d7,d7,15 + li g2,32 + endif + subi a6,a6,4 + blr + +end_bits: + sub o3,a0,a1 + addi o3,o3,4 +end_bits2: + lea g1,free_after_mark + + slwi o3,o3,3 + + lwz o1,0(g1) + cmplw 0,o3,o4 + add o1,o1,o3 + stw o1,0(g1) + bge found_free_memory + +end_scan: + mfctr o2 + lea g1,bit_counter + stw o2,0(g1) +no_scan: + endif + + if MARK_AND_COPY_GC +no_mark3: + endif + mflr r0 + stwu r0,-4(sp) + + subi sp,sp,28 + stw d0,0(sp) + stw d1,4(sp) + stw d2,8(sp) + stw d3,12(sp) + stw d4,16(sp) + + lea g1,garbage_collect_flag + + stw d5,20(sp) + + lbz o0,0(g1) + + stw d6,24(sp) + + extsb o0,o0 + cmpwi 0,o0,0 + ble collect + + subi o0,o0,2 + stb o0,0(g1) + + lea o0,heap_end_after_gc + lwz d0,0(o0) + sub d0,d0,a6 + srwi d0,d0,2 + lea o0,extra_heap_size + sub d0,d0,d7 + lwz d1,0(o0) + cmplw 0,d0,d1 + bgt collect + + lea o0,extra_heap_size + lwz d1,0(o0) + + lea o0,extra_heap + + sub d7,d1,d0 + + lwz a6,0(o0) + slwi d1,d1,2 + lea o0,heap_end_after_gc + add d1,d1,a6 + stw d1,0(o0) + + lwz d0,0(sp) + lwz d1,4(sp) + lwz d2,8(sp) + lwz d3,12(sp) + lwz d4,16(sp) + lwz d5,20(sp) + lwz d6,24(sp) + + lwz r0,28(sp) + mtlr r0 + + if USE_DCBZ + subi d7,d7,15 + li g2,32 + endif + subi a6,a6,4 + + addi sp,sp,32 + blr + +collect: + bl .add_execute_time + + lea o1,flags + lwz o0,0(o1) + andi. r0,o0,4 + beq no_print_stack_sizes + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + else + stwu sp,-64(sp) + endif + lea o0,garbage_collect_string_1 + if STDERR_TO_FILE + bl .er_print_string + else + bl .ew_print_string + endif + nop + + lea o0,stack_p + lwz a0,0(o0) + sub o0,a4,a0 + if MACOSX + lea o1,halt_sp + lwz d0,0(o1) + else + lea o1,stack_size + lwz o2,0(o1) + add d0,a0,o2 + endif + sub d0,d0,sp + if STDERR_TO_FILE + bl .er_print_int + else + bl .ew_print_int + endif + nop + + lea o0,garbage_collect_string_2 + if STDERR_TO_FILE + bl .er_print_string + else + bl .ew_print_string + endif + nop + + mr o0,d0 + if STDERR_TO_FILE + bl .er_print_int + else + bl .ew_print_int + endif + nop + + lea o0,garbage_collect_string_3 + if STDERR_TO_FILE + bl .er_print_string + else + bl .ew_print_string + endif + nop + if MACOSX + lwz sp,0(sp) + else + addi sp,sp,64 + endif +no_print_stack_sizes: + cmplw 0,a4,sp + bgt stack_overflow + + if MARK_AND_COPY_GC + lea o0,flags + lwz o0,0(o0) + andi. r0,o0,64 + bne compacting_collector + else + if MARK_GC + b compacting_collector + endif + endif + + if MARK_AND_COPY_GC || !MARK_GC + lea o0,garbage_collect_flag + lbz o1,0(o0) + extsb. o1,o1 + bne compacting_collector + + if COPIED_VECTOR + lea o1,heap_end_after_copy_gc + li g0,0 + lwz a1,0(o1) + lea a2,heap_copied_vector + tst a1 + + lea o0,heap_copied_vector_size + lwz a2,0(a2) + lwz d1,0(o0) + + beq zero_all + + lea o0,heap_p1 + stw g0,0(o1) + lwz a0,0(o0) + sub d0,a6,a0 + addi d0,d0,63*4 + srwi d0,d0,8 + bl zero_bit_vector + + sub d2,a1,a0 + lea a2,heap_copied_vector + clrrwi d2,d2,8 + lwz a2,0(a2) + srwi d2,d2,6 + add a2,a2,d2 + + sub d0,d1,d2 + srwi d0,d0,2 + bl zero_bit_vector + + b end_zero_bit_vector + +zero_all: + srwi d0,d1,2 + bl zero_bit_vector + +end_zero_bit_vector: + endif + +; calculate alloc_size + lea o0,heap_end_after_gc + lwz d0,0(o0) + lea o1,alloc_size + sub d0,d0,a6 + srwi d0,d0,2 + sub d0,d0,d7 + stw d0,0(o1) + + include 'pcopy.a' + + if WRITE_HEAP + lea o0,heap2_begin_and_end + stw o4,0(o0) + endif + + lea o0,heap_end_after_gc + stw o4,0(o0) + + sub d7,o4,a6 + srwi d7,d7,2 + + bl .add_garbage_collect_time + + lea o0,alloc_size + lwz o1,0(o0) + sub. d7,d7,o1 + blt switch_to_mark_scan +; bneg out_of_memory_4 + + slwi d0,d7,2 + add d0,d0,d7 + slwi d0,d0,5 + lea o0,heap_size + lwz d2,0(o0) + slwi d1,d2,2 + add d1,d1,d2 + slwi d1,d1,1 + add d1,d1,d2 + cmplw 0,d0,d1 + bge no_mark_scan +; b no_mark_scan + +switch_to_mark_scan: + lea o0,heap_size_33 + lwz d0,0(o0) + slwi d0,d0,5 + lea o0,heap_p + lwz d1,0(o0) + + lea o0,heap_p1 + lwz d2,0(o0) + lea o0,heap_p2 + lwz o1,0(o0) + cmplw 0,d2,o1 + blt vector_at_begin + +vector_at_end: + lea o0,heap_p3 + stw d1,0(o0) + add d1,d1,d0 + lea o0,heap_vector + stw d1,0(o0) + + lea o0,heap_p1 + lwz d0,0(o0) + lea o0,extra_heap + stw d0,0(o0) + sub d1,d1,d0 + srwi d1,d1,2 + lea o0,extra_heap_size + stw d1,0(o0) + b switch_to_mark_scan_2 + +vector_at_begin: + lea o0,heap_vector + stw d1,0(o0) + lea o1,heap_size + lwz o0,0(o1) + add d1,d1,o0 + sub d1,d1,d0 + lea o0,heap_p3 + stw d1,0(o0) + + lea o0,extra_heap + stw d1,0(o0) + lea o0,heap_p2 + lwz d2,0(o0) + sub d2,d2,d1 + srwi d2,d2,2 + lea o0,extra_heap_size + stw d2,0(o0) + +switch_to_mark_scan_2: + lea o0,heap_size + lwz d0,0(o0) + srwi d0,d0,3 + sub d0,d0,d7 + slwi d0,d0,2 + + lea o0,garbage_collect_flag + li o1,1 + stb o1,0(o0) + + cmpwi 0,d7,0 + bge end_garbage_collect + + li o1,-1 + stb o1,0(o0) + + lea o0,extra_heap_size + lea o1,alloc_size + lwz d1,0(o0) + lwz d7,0(o1) + sub. d7,d1,d7 + blt out_of_memory_4 + + lea o0,extra_heap + lea o1,heap_end_after_gc + if WRITE_HEAP + mr d2,a6 + endif + lwz a6,0(o0) + slwi d1,d1,2 + add d1,d1,a6 + stw d1,0(o1) + if WRITE_HEAP + li d3,1 + b end_garbage_collect_ + else + b end_garbage_collect + endif + +no_mark_scan: +; exchange the semi_spaces + + lea o0,heap_p1 + lea o1,heap_p2 + lwz d0,0(o0) + lwz d1,0(o1) + stw d0,0(o1) + stw d1,0(o0) + + if COPIED_VECTOR + lea o0,heap_size_129 + lwz d1,0(o0) + slwi d1,d1,6-2 + else + lea o0,heap_size + lwz d1,0(o0) + srwi d1,d1,3 + endif + sub d0,d1,d7 + + if ADJUST_HEAP_SIZE + lea o0,heap_size_multiple + lwz o0,0(o0) + + mullw d2,d0,o0 + mulhwu o0,d0,o0 + + rlwinm d2,d2,32-9,9,31-2 +; srwi d2,d2,9 + + rlwimi d2,o0,32-9,0,8 + srwi. o0,o0,9 + bne no_small_heap1 + + cmplwi d2,MINIMUM_HEAP_SIZE/2 + bge not_too_small1 + li d2,MINIMUM_HEAP_SIZE/2 +not_too_small1: + + sub. d2,d1,d2 + blt no_small_heap1 + + sub d7,d7,d2 + lea o0,heap_end_after_gc + slwi d2,d2,2 + lwz d1,0(o0) + sub d2,d1,d2 + lea o1,heap_end_after_copy_gc + stw d2,0(o0) + stw d1,0(o1) + +no_small_heap1: + endif + + slwi d0,d0,2 + endif + +end_garbage_collect: + if WRITE_HEAP + mr d2,a6 + li d3,0 +end_garbage_collect_: + endif + lea o0,flags + lwz o1,0(o0) + andi. r0,o1,2 + beq+ no_heap_use_message + + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + else + stwu sp,-64(sp) + endif + lea o0,heap_use_after_gc_string_1 + if STDERR_TO_FILE + bl .er_print_string + else + bl .ew_print_string + endif + + mr o0,d0 + if STDERR_TO_FILE + bl .er_print_int + else + bl .ew_print_int + endif + + lea o0,heap_use_after_gc_string_2 + if STDERR_TO_FILE + bl .er_print_string + else + bl .ew_print_string + endif + + if MACOSX + lwz sp,0(sp) + else + addi sp,sp,64 + endif + +no_heap_use_message: + if FINALIZERS + bl call_finalizers + endif + + if WRITE_HEAP + import first_function{DS} + import .write_heap + import min_write_heap_size + + lea o0,flags + lea o1,min_write_heap_size + + lwz o0,0(o0) + lwz o1,0(o1) + + andi. r0,o0,32 + beq no_write_heap + + cmplw 0,d0,o1 + blt no_write_heap + + subi sp,sp,64 + + lea r3,garbage_collect_flag + cmpwi d3,0 + + lea r7,heap2_begin_and_end + lbz r3,0(r3) + lwz r5,0(r7) + bne copy_to_compact_with_alloc_in_extra_heap + + extsb. r3,r3 + lwz r6,4(r7) + + lea r4,heap_p1 + beq gc0 + lea r4,heap_p2 + bgt gc1 + lea r4,heap_p3 + li r5,0 + li r6,0 +gc0: +gc1: + lwz r4,0(r4) + mr r10,sp + stw r4,0(r10) + stw d2,4(r10) + stw r5,8(r10) + stw r6,12(r10) + + lea r6,stack_p + lea r8,first_function + lwz r6,0(r6) + if LINUX + li r9,0 + else + addi r9,rtoc,-32768 + endif + lwz r8,0(r8) + + stw r6,16(r10) + stw a4,20(r10) + stw r8,24(r10) + stw r9,28(r10) + + lea r4,small_integers + lea r5,static_characters + stw r4,32(r10) + stw r5,36(r10) + + stw r16,40(r10) + stw r15,44(r10) + stw r14,48(r10) + stw r13,52(r10) + lea d0,__STRING__2 + lea d1,__ARRAY__2 + stw d0,56(r10) + stw d1,60(r10) + + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + else + stwu sp,-64(sp) + endif + + mr r3,r10 + bl .write_heap + nop + + if MACOSX + lwz sp,0(sp) + addi sp,sp,64 + else + addi sp,sp,128 + endif +no_write_heap: + + endif + + lwz d0,0(sp) + lwz d1,4(sp) + lwz d2,8(sp) + lwz d3,12(sp) + lwz d4,16(sp) + lwz d5,20(sp) + lwz d6,24(sp) + + lwz r0,28(sp) + mtlr r0 + + if USE_DCBZ + subi d7,d7,15 + li g2,32 + endif + subi a6,a6,4 + + addi sp,sp,32 + blr + + if FINALIZERS +call_finalizers: + lea d0,free_finalizer_list + lwz d0,0(d0) + +call_finalizers_lp: + lea o0,__Nil_m8 + cmplw d0,o0 + beq end_call_finalizers + + lwz d1,8(d0) + lwz d0,4(d0) + mflr d2 + + lwz r12,0(d1) + lwz r3,4(d1) + + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + else + stwu sp,-64(sp) + endif + + lwz r0,0(r12) + stw RTOC,20(SP) + mtctr r0 + lwz RTOC,4(r12) + bctrl + lwz RTOC,20(sp) + + if MACOSX + lwz sp,0(sp) + else + addi sp,sp,64 + endif + + mtlr d2 + b call_finalizers_lp +end_call_finalizers: + lea d0,free_finalizer_list + stw o0,0(d0) + blr + endif + + if WRITE_HEAP +copy_to_compact_with_alloc_in_extra_heap: + lwz r6,4(r7) + lea r4,heap_p2 + b gc1 + endif + +out_of_memory_4: + bl .add_garbage_collect_time + + lea o0,out_of_memory_string_4 + b print_error + + csect .zero_bit_vector +; d0 = n words +; a2 = address +; g0 = 0 +zero_bit_vector: + andi. r0,d0,1 + srwi d0,d0,1 + beq zero_bits1_1 + + stw g0,0(a2) + addi a2,a2,4 +zero_bits1_1: + andi. r0,d0,1 + srwi d0,d0,1 + beq zero_bits1_5 + + subi a2,a2,8 + b zero_bits1_2 + +zero_bits1_4: + stw g0,0(a2) + stw g0,4(a2) +zero_bits1_2: + stw g0,8(a2) + stw g0,12(a2) + addi a2,a2,16 +zero_bits1_5: + subic. d0,d0,1 + bge zero_bits1_4 + + blr + + csect .reorder +reorder: + mr d2,d0 + mr d3,d1 + slwi d4,d0,2 + slwi d5,d1,2 + add a0,a0,d5 + sub a1,a1,d4 + b st_reorder_lp + +reorder_lp: + lwzu o0,-4(a1) + subic. d2,d2,1 + + lwz o1,0(a0) + stw o0,0(a0) + addi a0,a0,4 + + bne+ next_b_in_element + mr d2,d0 + add a0,a0,d5 +next_b_in_element: + + subic. d3,d3,1 + stw o1,0(a1) + + bne+ next_a_in_element + mr d3,d1 + sub a1,a1,d4 +next_a_in_element: + +st_reorder_lp: + cmplw 1,a1,a0 + bgt 1,reorder_lp + + blr + +; +; the sliding compacting garbage collector +; + + csect text{PR} +compacting_collector: + +; zero all mark bits + + lea o0,heap_p3 + lea o1,heap_vector + lwz d6,0(o0) + lea o0,heap_end_after_gc + lwz o4,0(o1) + lwz d5,0(o0) + sub d5,d5,a6 + srwi d5,d5,2 + + lea o0,alloc_size + sub d5,d5,d7 + stw d5,0(o0) + + if MARK_GC + if MARK_AND_COPY_GC + lea o0,flags + lwz o0,0(o0) + andi. r0,o0,64 + beq no_mark4 + endif + + lea o0,zero_bits_before_mark + li g0,0 + lwz o1,0(o0) + cmpwi 0,o1,0 + beq no_zero_bits + + stw g0,0(o0) + + if MARK_AND_COPY_GC +no_mark4: + endif + endif + + lea o0,heap_size_33 + mr a2,o4 + lwz d0,0(o0) + addi d0,d0,3 + srwi d0,d0,2 + + li o0,0 + + andi. r0,d0,1 + srwi d0,d0,1 + beq zero_bits_1 + + stw o0,0(a2) + addi a2,a2,4 +zero_bits_1: + + andi. r0,d0,1 + srwi d0,d0,1 + beq zero_bits_5 + + subi a2,a2,8 + b zero_bits_2 + +zero_bits_4: + stw o0,0(a2) + stw o0,4(a2) +zero_bits_2: + stw o0,8(a2) + stw o0,12(a2) + addi a2,a2,16 +zero_bits_5: + subic. d0,d0,1 + bge zero_bits_4 + + if MARK_GC + if MARK_AND_COPY_GC + lea o0,flags + lwz o0,0(o0) + andi. r0,o0,64 + beq no_mark5 + endif + +no_zero_bits: + lea o0,last_heap_free + lea o1,free_after_mark + lwz d0,0(o0) + lwz d1,0(o1) + slwi d1,d1,2 + + slwi d2,d1,3 + add d2,d2,d1 + srwi d2,d2,2 + + cmplw d0,d2 + bgt compact_gc + + if ADJUST_HEAP_SIZE + lea o0,bit_vector_size + lwz d1,0(o0) + lea o0,heap_size_multiple + slwi d1,d1,2 + lwz o0,0(o0) + sub o2,d1,d0 + + mullw o1,o2,o0 + mulhwu o2,o2,o0 + + rlwinm o1,o1,32-7,7,31-2 +; srwi o1,o1,7 + + rlwimi o1,o2,32-7,0,6 + srwi. o2,o2,7 + bne no_smaller_heap + + cmplw o1,d1 + bge no_smaller_heap + + cmplwi d1,MINIMUM_HEAP_SIZE + ble no_smaller_heap + + b compact_gc + +no_smaller_heap: + endif + include 'pmark.a' + +compact_gc: + lea o0,zero_bits_before_mark + li d0,1 + stw d0,0(o0) + lea o0,last_heap_free + li g0,0 + stw g0,0(o0) + lea o0,free_after_mark + li o1,1000 + stw o1,0(o0) + endif + + if MARK_AND_COPY_GC +no_mark5: + endif + + + include 'pcompact.a' + + lea o0,heap_size_33 + lwz d7,0(o0) + lea o0,heap_end_after_gc + slwi d7,d7,5 + add d7,d7,d6 + stw d7,0(o0) + + lea o0,alloc_size + sub d7,d7,a6 + lwz d1,0(o0) + srwi d7,d7,2 + sub. d7,d7,d1 + blt out_of_memory_4 + + slwi d0,d7,2 + lea o0,heap_size + add d0,d0,d7 + lwz o1,0(o0) + slwi d0,d0,3 + cmplw 0,d0,o1 + blt out_of_memory_4 + + if MARK_GC || COMPACT_GC_ONLY + if MARK_GC && ADJUST_HEAP_SIZE + if MARK_AND_COPY_GC + lea o0,flags + lwz o0,0(o0) + andi. r0,o0,64 + beq no_mark6 + endif + + sub d0,a6,d6 + lea o0,heap_size_multiple + slwi d1,d1,2 + lwz o0,0(o0) + add o2,d0,d1 + + lea d1,heap_size_33 + lwz d1,0(d1) + slwi d1,d1,5 + + mullw d0,o2,o0 + mulhwu o0,o2,o0 + + rlwinm d0,d0,32-8,8,31-2 +; srwi d0,d0,8 + rlwimi d0,o0,32-8,0,7 +; clrrwi d0,d0,2 + + srwi. o0,o0,8 + bne no_small_heap2 + + cmplwi d0,MINIMUM_HEAP_SIZE + bge not_too_small2 + li d0,MINIMUM_HEAP_SIZE +not_too_small2: + + sub. d2,d1,d0 + blt no_small_heap2 + + lea o1,heap_end_after_gc + srwi o0,d2,2 + lwz d1,0(o1) + sub d7,d7,o0 + sub d1,d1,d2 + stw d1,0(o1) + + mr d1,d0 + +no_small_heap2: + lea o0,bit_vector_size + srwi d1,d1,2 + stw d1,0(o0) + + if MARK_AND_COPY_GC +no_mark6: + endif + endif + b no_copy_garbage_collection + else + lea o0,heap_size + slwi d0,d0,2 + lwz d1,0(o0) + lwz o1,0(o0) + slwi d1,d1,5 + sub d1,d1,o1 + cmpw 0,d0,d1 + + ble no_copy_garbage_collection +; b no_copy_garbage_collection + + lea o0,heap_p + lwz d0,0(o0) + lea o0,heap_p1 + stw d0,0(o0) + if COPIED_VECTOR + lea o0,heap_size_129 + lwz d1,0(o0) + slwi d1,d1,6 + add d0,d0,d1 + lea o0,heap_copied_vector + lea o1,heap_end_after_gc + stw d0,0(o0) + lea o0,heap_copied_vector_size + stw d0,0(o1) + lwz d1,0(o0) + lea o0,heap_p2 + add d1,d1,d0 + stw d1,0(o0) + else + lea o0,heap_size + lwz d1,0(o0) + srwi d1,d1,1 + add d0,d0,d1 + lea o0,heap_p2 + stw d0,0(o0) + lea o0,heap_end_after_gc + stw d0,0(o0) + endif + sub d0,d0,a6 + srwi d0,d0,2 + mr d7,d0 + lea o0,alloc_size + lwz o1,0(o0) + sub d7,d7,o1 + + lea o0,heap_p3 + lwz d0,0(o0) + lea o0,heap_vector + lwz o1,0(o0) + cmpw 0,d0,o1 + ble vector_at_end_2 + + lea o0,heap_vector + lwz d1,0(o0) + lea o0,extra_heap + stw d1,0(o0) + sub d0,d0,d1 + srwi d0,d0,2 + lea o0,extra_heap_size + stw d0,0(o0) + + lea o0,garbage_collect_flag + li o1,2 + stb o1,0(o0) + + b no_copy_garbage_collection + +vector_at_end_2: + lea o0,garbage_collect_flag + li o1,0 + stb o1,0(o0) + endif + +no_copy_garbage_collection: + if MEASURE_GC + bl .add_compact_garbage_collect_time + else + bl .add_garbage_collect_time + endif + lea o0,alloc_size + sub d0,a6,d6 + lwz d1,0(o0) + slwi d1,d1,2 + + add d0,d0,d1 + b end_garbage_collect + +stack_overflow: + bl .add_execute_time + + lea o0,stack_overflow_string + b print_error + +.IO_error: + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(128+28)(sp) + else + stwu sp,-128(sp) + endif + stw o0,124(sp) + + lea o0,IO_error_string + if STDERR_TO_FILE + bl .er_print_string + else + bl .ew_print_string + endif + + lwz o0,124(sp) + + if STDERR_TO_FILE + bl .er_print_string + else + bl .ew_print_string + endif + + lea o0,new_line_string + if STDERR_TO_FILE + bl .er_print_string + else + bl .ew_print_string + endif + + if MACOSX + lwz sp,0(sp) + else + addi sp,sp,128 + endif + b halt + +print_error: + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + else + stwu sp,-64(sp) + endif + if STDERR_TO_FILE + bl .er_print_string + else + bl .ew_print_string + endif + if MACOSX + lwz sp,0(sp) + else + addi sp,sp,64 + endif +halt: + + if PROFILE + mflr r0 + stwu r0,-4(sp) + bl write_profile_stack + mtlr r0 + endif + + if EXCEPTIONS + lea o0,exception_info + lwz o0,0(o0) + cmpwi 0,o0,0 + bne e__Exceptions__sraise__exception + endif + + lea o0,halt_sp + lwz sp,0(o0) + if 0 + lea o0,flags + lwz d0,0(o0) + andi. r0,d0,8 + bne exit + + andi. r0,d0,16 + beq exit + + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + else + stwu sp,-64(sp) + endif + bl .wait_for_key_press + if MACOSX + lwz sp,0(sp) + else + addi sp,sp,64 + endif + else + lea o0,execution_aborted + li d0,1 + stw d0,0(o0) + endif + b exit + + if EXCEPTIONS +e__Exceptions__scatch__exception: + lea o0,exception_info + mflr d0 + stw a4,0(o0) + stw sp,4(o0) + stw d0,8(o0) + + li d0,0 + + lwz r0,0(sp) + addi sp,sp,4 + blr + +e__Exceptions__sraise__exception: + lea o0,exception_info + li d0,-1 + + lwz o1,8(o0) + lwz sp,4(o0) + mtlr o1 + lwz a4,0(o0) + + li o1,0 + stw o1,0(o0) + + lwz r0,0(sp) + addi sp,sp,4 + blr + endif + + csect .eval_01 +eval_01: + stw a1,0(a4) + addi a4,a4,4 + bctr + + csect .eval_11 +eval_11: + stw a0,0(a4) + mr a0,a1 + addi a4,a4,4 + bctr + + csect .eval_02 +eval_02: + stw a2,0(a4) + addi a4,a4,8 + stw a1,4-8(a4) + bctr + + csect .eval_12 +eval_12: + stw a0,4(a4) + mr a0,a1 + stw a2,0(a4) + addi a4,a4,8 + bctr + + csect .eval_22 +eval_22: + stw a0,4(a4) + mr a0,a2 + stw a1,0(a4) + addi a4,a4,8 + bctr + +__eaind: +eval_fill: + stw a0,0(a4) + mr a0,a1 + lwz a1,0-NODE_POINTER_OFFSET(a1) + addi a4,a4,4 + + mtctr a1 + mflr r0 + stwu r0,-4(sp) + bctrl + mtlr r0 + + mr a1,a0 + lwzu a0,-4(a4) + + lwz g0,0-NODE_POINTER_OFFSET(a1) + lwz g1,4-NODE_POINTER_OFFSET(a1) + stw g0,0-NODE_POINTER_OFFSET(a0) + lwz g0,8-NODE_POINTER_OFFSET(a1) + stw g1,4-NODE_POINTER_OFFSET(a0) + stw g0,8-NODE_POINTER_OFFSET(a0) + + lwz r0,0(sp) + addi sp,sp,4 + blr + + b eval_fill + nop + nop + if LINUX + nop + nop + endif + dc.l 0 + dc.l -2 +__indirection: + lwz a1,4(a0) + lwz d0,0(a1) + andi. r0,d0,2 + if MARK_GC + beq eval_fill2 + else + beq _cycle__in__spine + endif + stw d0,0(a0) + lwz g0,4(a1) + lwz g1,8(a1) + stw g0,4(a0) + stw g1,8(a0) + + lwz r0,0(sp) + addi sp,sp,4 + blr + +_cycle__in__spine: + b __cycle__in__spine + + if MARK_GC + csect .eval_fill2 +eval_fill2: + if MARK_AND_COPY_GC + lea o0,flags + stw a5,0-NODE_POINTER_OFFSET(a0) + lwz o0,0(o0) + stw a0,0(a4) + andi. r0,o0,64 + beq _cycle__in__spine + else + stw a5,0-NODE_POINTER_OFFSET(a0) + stw a0,0(a4) + endif + addi a4,a4,4 + mr a0,a1 + + mtctr d0 + mflr r0 + stwu r0,-4(sp) + bctrl + mtlr r0 + + lwzu a1,-4(a4) + lwz o0,0-NODE_POINTER_OFFSET(a0) + lwz o1,4-NODE_POINTER_OFFSET(a0) + stw o0,0-NODE_POINTER_OFFSET(a1) + lwz o0,8-NODE_POINTER_OFFSET(a0) + stw o1,4-NODE_POINTER_OFFSET(a1) + stw o0,8-NODE_POINTER_OFFSET(a1) + mr a0,a1 + + lwz r0,0(sp) + addi sp,sp,4 + blr + endif + + csect .eval_upd_0 + if PROFILE + mflr r0 + bl profile_n + endif +eval_upd_0: + lea a3,__indirection + mtctr a2 + stw a0,4-NODE_POINTER_OFFSET(a1) + stw a3,0-NODE_POINTER_OFFSET(a1) + bctr + + csect .eval_upd_1 + if PROFILE + mflr r0 + bl profile_n + endif +eval_upd_1: + lea a3,__indirection + mtctr a2 + lwz d0,4-NODE_POINTER_OFFSET(a1) + stw a3,0-NODE_POINTER_OFFSET(a1) + stw a0,4-NODE_POINTER_OFFSET(a1) + mr a1,d0 + bctr + + csect .eval_upd_2 + if PROFILE + mflr r0 + bl profile_n + endif +eval_upd_2: + mtctr a2 + lea a2,__indirection + stw a2,0-NODE_POINTER_OFFSET(a1) + lwz a2,4-NODE_POINTER_OFFSET(a1) + stw a0,4-NODE_POINTER_OFFSET(a1) + lwz a1,8-NODE_POINTER_OFFSET(a1) + bctr + + csect .eval_upd_3 + if PROFILE + mflr r0 + bl profile_n + endif +eval_upd_3: + mtctr a2 + lea a2,__indirection + stw a0,0(a4) + stw a2,0-NODE_POINTER_OFFSET(a1) + lwz a2,4-NODE_POINTER_OFFSET(a1) + stw a0,4-NODE_POINTER_OFFSET(a1) + addi a4,a4,4 + lwz a0,12-NODE_POINTER_OFFSET(a1) + lwz a1,8-NODE_POINTER_OFFSET(a1) + bctr + + csect .eval_upd_4 + if PROFILE + mflr r0 + bl profile_n + endif +eval_upd_4: + mtctr a2 + lea a2,__indirection + stw a0,0(a4) + stw a2,0-NODE_POINTER_OFFSET(a1) + lwz a2,4-NODE_POINTER_OFFSET(a1) + stw a0,4-NODE_POINTER_OFFSET(a1) + lwz g1,16-NODE_POINTER_OFFSET(a1) + lwz a0,12-NODE_POINTER_OFFSET(a1) + stw g1,4(a4) + addi a4,a4,8 + lwz a1,8-NODE_POINTER_OFFSET(a1) + bctr + + csect .eval_upd_5 + if PROFILE + mflr r0 + bl profile_n + endif +eval_upd_5: + mtctr a2 + lea a2,__indirection + stw a0,0(a4) + stw a2,0-NODE_POINTER_OFFSET(a1) + lwz a2,4-NODE_POINTER_OFFSET(a1) + stw a0,4-NODE_POINTER_OFFSET(a1) + lwz g1,20-NODE_POINTER_OFFSET(a1) + lwz a0,12-NODE_POINTER_OFFSET(a1) + stw g1,4(a4) + lwz g1,16-NODE_POINTER_OFFSET(a1) + lwz a1,8-NODE_POINTER_OFFSET(a1) + stw g1,8(a4) + addi a4,a4,12 + bctr + + csect .eval_upd_6 + if PROFILE + mflr r0 + bl profile_n + endif +eval_upd_6: + mtctr a2 + lea a2,__indirection + stw a0,0(a4) + stw a2,0-NODE_POINTER_OFFSET(a1) + lwz a2,4-NODE_POINTER_OFFSET(a1) + stw a0,4-NODE_POINTER_OFFSET(a1) + lwz g1,24-NODE_POINTER_OFFSET(a1) + lwz a0,12-NODE_POINTER_OFFSET(a1) + stw g1,4(a4) + lwz g1,20-NODE_POINTER_OFFSET(a1) + stw g1,8(a4) + lwz g1,16-NODE_POINTER_OFFSET(a1) + lwz a1,8-NODE_POINTER_OFFSET(a1) + stw g1,12(a4) + addi a4,a4,16 + bctr + + csect .eval_upd_n + if PROFILE + mflr r0 + bl profile_n + endif +eval_upd_7: + li d0,0 + li d1,20 +eval_upd_n: + mtctr a2 + lea a2,__indirection + stw a0,0(a4) + stw a2,0-NODE_POINTER_OFFSET(a1) + lwz a2,4-NODE_POINTER_OFFSET(a1) + stw a0,4-NODE_POINTER_OFFSET(a1) + add a1,a1,d1 + lwz g1,8-NODE_POINTER_OFFSET(a1) + stw g1,4(a4) + lwz g1,4-NODE_POINTER_OFFSET(a1) + stw g1,8(a4) + lwz g1,0-NODE_POINTER_OFFSET(a1) + stw g1,12(a4) + addi a4,a4,16 +eval_upd_n_lp: + lwz g1,-4-NODE_POINTER_OFFSET(a1) + subi a1,a1,4 + stw g1,0(a4) + subic. d0,d0,1 + addi a4,a4,4 + bge eval_upd_n_lp + + lwz a0,-4-NODE_POINTER_OFFSET(a1) + lwz a1,-8-NODE_POINTER_OFFSET(a1) + bctr + + if PROFILE + mflr r0 + bl profile_n + endif +eval_upd_8: + li d0,1 + li d1,24 + b eval_upd_n + if PROFILE + mflr r0 + bl profile_n + endif +eval_upd_9: + li d0,2 + li d1,28 + b eval_upd_n + if PROFILE + mflr r0 + bl profile_n + endif +eval_upd_10: + li d0,3 + li d1,32 + b eval_upd_n + if PROFILE + mflr r0 + bl profile_n + endif +eval_upd_11: + li d0,4 + li d1,36 + b eval_upd_n + if PROFILE + mflr r0 + bl profile_n + endif +eval_upd_12: + li d0,5 + li d1,40 + b eval_upd_n + if PROFILE + mflr r0 + bl profile_n + endif +eval_upd_13: + li d0,6 + li d1,44 + b eval_upd_n + if PROFILE + mflr r0 + bl profile_n + endif +eval_upd_14: + li d0,7 + li d1,48 + b eval_upd_n + if PROFILE + mflr r0 + bl profile_n + endif +eval_upd_15: + li d0,8 + li d1,52 + b eval_upd_n + if PROFILE + mflr r0 + bl profile_n + endif +eval_upd_16: + li d0,9 + li d1,56 + b eval_upd_n + if PROFILE + mflr r0 + bl profile_n + endif +eval_upd_17: + li d0,10 + li d1,60 + b eval_upd_n + if PROFILE + mflr r0 + bl profile_n + endif +eval_upd_18: + li d0,11 + li d1,64 + b eval_upd_n + if PROFILE + mflr r0 + bl profile_n + endif +eval_upd_19: + li d0,12 + li d1,68 + b eval_upd_n + if PROFILE + mflr r0 + bl profile_n + endif +eval_upd_20: + li d0,13 + li d1,72 + b eval_upd_n + if PROFILE + mflr r0 + bl profile_n + endif +eval_upd_21: + li d0,14 + li d1,76 + b eval_upd_n + if PROFILE + mflr r0 + bl profile_n + endif +eval_upd_22: + li d0,15 + li d1,80 + b eval_upd_n + if PROFILE + mflr r0 + bl profile_n + endif +eval_upd_23: + li d0,16 + li d1,84 + b eval_upd_n + if PROFILE + mflr r0 + bl profile_n + endif +eval_upd_24: + li d0,17 + li d1,88 + b eval_upd_n + if PROFILE + mflr r0 + bl profile_n + endif +eval_upd_25: + li d0,18 + li d1,92 + b eval_upd_n + if PROFILE + mflr r0 + bl profile_n + endif +eval_upd_26: + li d0,19 + li d1,96 + b eval_upd_n + if PROFILE + mflr r0 + bl profile_n + endif +eval_upd_27: + li d0,20 + li d1,100 + b eval_upd_n + if PROFILE + mflr r0 + bl profile_n + endif +eval_upd_28: + li d0,21 + li d1,104 + b eval_upd_n + if PROFILE + mflr r0 + bl profile_n + endif +eval_upd_29: + li d0,22 + li d1,108 + b eval_upd_n + if PROFILE + mflr r0 + bl profile_n + endif +eval_upd_30: + li d0,23 + li d1,112 + b eval_upd_n + if PROFILE + mflr r0 + bl profile_n + endif +eval_upd_31: + li d0,24 + li d1,116 + b eval_upd_n + if PROFILE + mflr r0 + bl profile_n + endif +eval_upd_32: + li d0,25 + li d1,120 + b eval_upd_n + +; +; STRINGS +; + csect .catAC +catAC: + if NODE_POINTER_OFFSET==0 + lwzu d0,4(a0) + lwzu d1,4(a1) + else + lwz d0,4-NODE_POINTER_OFFSET(a0) + baddi a0,4 + lwz d1,4-NODE_POINTER_OFFSET(a1) + baddi a1,4 + endif + add d2,d0,d1 + addi d5,d2,3+8 + srwi d5,d5,2 + sub. d7,d7,d5 +; reserve one word extra, because +; word after the string may change + addi d6,d2,3 + ble gc_3 +gc_r_3: + + lea o1,__STRING__2 + addi d3,a6,4+NODE_POINTER_OFFSET + stw o1,4(a6) + stwu d2,8(a6) + +; copy string 1 + + addi d2,d1,3 + srwi d2,d2,2 + mr a2,a6 + + subic. d2,d2,1 + blt cat_string_4 +cat_string_3: + if NODE_POINTER_OFFSET==0 + lwzu o0,4(a1) + else + lwz o0,4-NODE_POINTER_OFFSET(a1) + baddi a1,4 + endif + subic. d2,d2,1 + stwu o0,4(a2) + bge cat_string_3 +cat_string_4: + +; copy string 2 + + addi d0,d0,3 + srwi d0,d0,2 + subic. d0,d0,1 + add a2,a6,d1 + blt cat_string_1 + +cat_string_0: + if NODE_POINTER_OFFSET==0 + lwzu o0,4(a0) + else + lwz o0,4-NODE_POINTER_OFFSET(a0) + baddi a0,4 + endif + subic. d0,d0,1 + stwu o0,4(a2) + bge cat_string_0 +cat_string_1: + + clrrwi d6,d6,2 + mr a0,d3 + add a6,a6,d6 + + lwz r0,0(sp) + addi sp,sp,4 + blr + +gc_3: subi d7,d7,1 + subi a0,a0,4 + subi a1,a1,4 + mflr r0 + bl collect_2 + addi a0,a0,4 + addi a1,a1,4 + addi d7,d7,1 + b gc_r_3 + + csect .sliceAC +empty_string: + lea a0,zero_length_string + lwz r0,0(sp) + addi sp,sp,4 + blr + +sliceAC: + lwz d2,4-NODE_POINTER_OFFSET(a0) + addi a2,a0,4-NODE_POINTER_OFFSET + cmpwi 0,d1,0 + bge slice_string_1 + + li d1,0 + +slice_string_1: + cmpw 0,d1,d2 + bge empty_string + cmpw 0,d0,d1 + addi d0,d0,1 + blt empty_string + + cmpw 0,d0,d2 + ble slice_string_2 + + mr d0,d2 + +slice_string_2: + sub d0,d0,d1 + + subi d7,d7,2 + + addi d2,d0,3 + srwi d2,d2,2 + + sub. d7,d7,d2 + blt gc_4 +r_gc_4: + lea o1,__STRING__2 + addi a0,a6,4+NODE_POINTER_OFFSET + stw o1,4(a6) + stwu d0,8(a6) + + add a2,a2,d1 + subic. d2,d2,1 + blt slice_string__1 + +slice_string__0: + lwzu o0,4(a2) + subic. d2,d2,1 + stwu o0,4(a6) + bge slice_string__0 +slice_string__1: + + lwz r0,0(sp) + addi sp,sp,4 + blr + +gc_4: mflr r0 + bl collect_1 + addi a2,a0,4-NODE_POINTER_OFFSET + b r_gc_4 + + csect .updateAC +updateAC: + lwz d2,4-NODE_POINTER_OFFSET(a0) + addi a2,a0,4-NODE_POINTER_OFFSET + cmplw 0,d1,d2 + bge update_string_error + + addi d3,d2,3 + subi d7,d7,2 + + srwi d3,d3,2 + sub. d7,d7,d3 + blt gc_5 +r_gc_5: + lea o1,__STRING__2 + + subic. d3,d3,1 + + addi a0,a6,4+NODE_POINTER_OFFSET + stw o1,4(a6) + stwu d2,8(a6) + blt update_string_5 + +update_string_4: + lwzu o0,4(a2) + subic. d3,d3,1 + stwu o0,4(a6) + bge update_string_4 +update_string_5: + + addi d1,d1,8 + lwz r0,0(sp) + stbx d0,a0,d1 + addi sp,sp,4 + blr + +gc_5: mflr r0 + bl collect_1 + addi a2,a0,4-NODE_POINTER_OFFSET + b r_gc_5 + + +update_string_error: + lea o0,high_index_string + cmpwi 0,d1,0 + bge print_error + + lea o0,low_index_string +update_string_error_2: + b print_error + + csect .eqAC +eqAC: + lwzu d0,4-NODE_POINTER_OFFSET(a0) + lwzu o0,4-NODE_POINTER_OFFSET(a1) + cmpw 0,d0,o0 + bne equal_string_ne + + andi. d1,d0,3 + srwi d0,d0,2 + subic. d0,d0,1 + blt equal_string_b + +equal_string_1: + lwzu o0,4(a1) + lwzu o1,4(a0) + + cmpw o1,o0 + bne equal_string_ne + + subic. d0,d0,1 + bge equal_string_1 + +equal_string_b: + subic. d1,d1,1 + blt equal_string_eq + +equal_string_2: + lbz o0,4(a1) + addi a1,a1,1 + lbz o1,4(a0) + addi a0,a0,1 + cmpw o1,o0 + bne equal_string_ne + + subic. d1,d1,1 + bge equal_string_2 + +equal_string_eq: + li d0,-1 + + lwz r0,0(sp) + addi sp,sp,4 + blr +equal_string_ne: + li d0,0 + + lwz r0,0(sp) + addi sp,sp,4 + blr + + csect .cmpAC +cmpAC: + lwzu d1,4-NODE_POINTER_OFFSET(a0) + lwzu d2,4-NODE_POINTER_OFFSET(a1) + + cmplw 0,d2,d1 + blt cmp_string_less + + li d0,0 + beq cmp_string_chars + + li d0,1 + b cmp_string_chars + +cmp_string_less: + li d0,-1 + mr d1,d2 +cmp_string_chars: + andi. d2,d1,3 + srwi d1,d1,2 + subic. d1,d1,1 + blt cmp_string_b + +cmp_string_1: + lwzu o0,4(a0) + lwzu o1,4(a1) + + cmplw 0,o1,o0 + bne cmp_string_ne + + subic. d1,d1,1 + bge cmp_string_1 + +cmp_string_b: + subic. d2,d2,1 + blt cmp_string_eq + +cmp_string_2: + lbz o0,4(a0) + lbz o1,4(a1) + addi a0,a0,1 + + cmplw 0,o1,o0 + addi a1,a1,1 + bne cmp_string_ne + + subic. d2,d2,1 + bge cmp_string_2 + +cmp_string_eq: + lwz r0,0(sp) + addi sp,sp,4 + blr + +cmp_string_ne: + bgt cmp_string_r1 + + li d0,-1 + + lwz r0,0(sp) + addi sp,sp,4 + blr +cmp_string_r1: + li d0,1 + + lwz r0,0(sp) + addi sp,sp,4 + blr + + csect .string_to_string_node +string_to_string_node: + lwz d0,0(a0) + addi a0,a0,4 + + addi d1,d0,3 + srwi d1,d1,2 + + subi d7,d7,2 + sub. d7,d7,d1 + blt string_to_string_node_gc + +string_to_string_node_r: + lea o0,__STRING__2 + stw o0,4(a6) + addi d2,a6,4+NODE_POINTER_OFFSET + stwu d0,8(a6) + b string_to_string_node_4 + +string_to_string_node_2: + lwz o0,0(a0) + addi a0,a0,4 + stwu o0,4(a6) +string_to_string_node_4: + subic. d1,d1,1 + bge string_to_string_node_2 + + mr a0,d2 + + lwz r0,0(sp) + addi sp,sp,4 + blr + +string_to_string_node_gc: + mflr r0 + stwu a0,-4(sp) + bl collect_0 + + lwz a0,0(sp) + addi sp,sp,4 + b string_to_string_node_r + + csect _cn + dc.l 3 +_c3: b __cycle__in__spine + dc.l 4 +_c4: b __cycle__in__spine + dc.l 5 +_c5: b __cycle__in__spine + dc.l 6 +_c6: b __cycle__in__spine + dc.l 7 +_c7: b __cycle__in__spine + dc.l 8 +_c8: b __cycle__in__spine + dc.l 9 +_c9: b __cycle__in__spine + dc.l 10 +_c10: b __cycle__in__spine + dc.l 11 +_c11: b __cycle__in__spine + dc.l 12 +_c12: b __cycle__in__spine + dc.l 13 +_c13: b __cycle__in__spine + dc.l 14 +_c14: b __cycle__in__spine + dc.l 15 +_c15: b __cycle__in__spine + dc.l 16 +_c16: b __cycle__in__spine + dc.l 17 +_c17: b __cycle__in__spine + dc.l 18 +_c18: b __cycle__in__spine + dc.l 19 +_c19: b __cycle__in__spine + dc.l 20 +_c20: b __cycle__in__spine + dc.l 21 +_c21: b __cycle__in__spine + dc.l 22 +_c22: b __cycle__in__spine + dc.l 23 +_c23: b __cycle__in__spine + dc.l 24 +_c24: b __cycle__in__spine + dc.l 25 +_c25: b __cycle__in__spine + dc.l 26 +_c26: b __cycle__in__spine + dc.l 27 +_c27: b __cycle__in__spine + dc.l 28 +_c28: b __cycle__in__spine + dc.l 29 +_c29: b __cycle__in__spine + dc.l 30 +_c30: b __cycle__in__spine + dc.l 31 +_c31: b __cycle__in__spine + dc.l 32 +_c32: b __cycle__in__spine + +; +; ARRAYS +; + + csect .create_arrayB +create_arrayB: + mr d2,d1 + addi d1,d1,3 + srwi d1,d1,2 + subi d7,d7,3 + sub. d7,d7,d1 + bge+ no_collect_4575 + + mflr r0 + bl collect_0 + +no_collect_4575: + slwi d3,d0,8 + or d0,d0,d3 + slwi d3,d0,16 + or d0,d0,d3 + lea o0,__ARRAY__2 + addi a0,a6,4+NODE_POINTER_OFFSET + stw o0,4(a6) + stw d2,8(a6) + stwu bool_reg,12(a6) + b create_arrayBCI + + csect .create_arrayC +create_arrayC: + mr d2,d1 + addi d1,d1,3 + srwi d1,d1,2 + subi d7,d7,2 + sub. d7,d7,d1 + bge+ no_collect_4578 + + mflr r0 + bl collect_0 + +no_collect_4578: + slwi d3,d0,8 + or d0,d0,d3 + slwi d3,d0,16 + or d0,d0,d3 + lea o0,__STRING__2 + addi a0,a6,4+NODE_POINTER_OFFSET + stw o0,4(a6) + stwu d2,8(a6) + b create_arrayBCI + + csect .create_arrayI +create_arrayI: + subi d7,d7,3 + sub. d7,d7,d1 + bge+ no_collect_4577 + + mflr r0 + bl collect_0 + +no_collect_4577: + lea o0,__ARRAY__2 + addi a0,a6,4+NODE_POINTER_OFFSET + stw o0,4(a6) + stw d1,8(a6) + stwu int_reg,12(a6) + +create_arrayBCI: + andi. o0,d1,1 + beq st_filli_array + + stwu d0,4(a6) + +st_filli_array: + srwi. d1,d1,1 + beq skip_filli_array + + mtctr d1 +filli_array: + stw d0,4(a6) + stwu d0,8(a6) + bdnz filli_array + +skip_filli_array: + lwz r0,0(sp) + addi sp,sp,4 + blr + + csect .create_arrayR +create_arrayR: + stfd f14,-8(sp) + sub d7,d7,d0 + + lwz d1,-8(sp) + subi d7,d7,3+1 + + lwz d2,-4(sp) + sub. d7,d7,d0 + bge+ no_collect_4579 + + mflr r0 + bl collect_0 + +no_collect_4579: + addi a6,a6,4 + + rlwinm d3,a6,32-2,31,31 + lea o0,__ARRAY__2 + + rlwinm a6,a6,0,0,31-3 + add d7,d7,d3 + + addi a0,a6,4+NODE_POINTER_OFFSET + stw o0,4(a6) + + cmpwi 0,d0,0 + + stw d0,8(a6) + stwu real_reg,12(a6) + beq skip_fillr_array + + mtctr d0 +fillr_array: + stw d1,4(a6) + stwu d2,8(a6) + bdnz fillr_array + +skip_fillr_array: + lwz r0,0(sp) + addi sp,sp,4 + blr + + csect .create_array +create_array: + subi d7,d7,3 + sub. d7,d7,d0 + bge+ no_collect_4576 + + mflr r0 + bl collect_1 + +no_collect_4576: + mr d1,a0 + lea o0,__ARRAY__2 + addi a0,a6,4+NODE_POINTER_OFFSET + stw o0,4(a6) + stw d0,8(a6) + li g0,0 + stwu g0,12(a6) + lwz r0,0(sp) + addi sp,sp,4 + b fillr1_array + +create_R_array: + subic. d2,d2,2 + blt create_R_array_1 + beq create_R_array_2 + subic. d2,d2,2 + blt create_R_array_3 + beq create_R_array_4 + b create_R_array_5 + +create_R_array_1: + subi d7,d7,3 + sub. d7,d7,d0 + bge+ no_collect_4581 + + mflr r0 + bl collect_0 + +no_collect_4581: + lea o0,__ARRAY__2 + addi a0,a6,4+NODE_POINTER_OFFSET + stw o0,4(a6) + stw d0,8(a6) + stwu d1,12(a6) + cmpwi 0,d3,0 + + lwz r0,0(sp) + addi sp,sp,4 + beq r_array_1_b + + lwz d1,-4(a4) + b fillr1_array + +r_array_1_b: + lwz d1,0(sp) + +fillr1_array: + andi. o0,d0,1 + beq st_fillr1_array_1 + + stwu d1,4(a6) +st_fillr1_array_1: + srwi. d0,d0,1 + beq skip_fillr1_array_lp + + mtctr d0 +fillr1_array_lp: + stw d1,4(a6) + stwu d1,8(a6) + bdnz fillr1_array_lp + +skip_fillr1_array_lp: + blr + +create_R_array_2: + subi d7,d7,3 + sub d7,d7,d0 + sub. d7,d7,d0 + bge+ no_collect_4582 + + mflr r0 + bl collect_0 + +no_collect_4582: + lea o0,__ARRAY__2 + addi a0,a6,4+NODE_POINTER_OFFSET + stw o0,4(a6) + stw d0,8(a6) + stwu d1,12(a6) + + lwz r0,0(sp) + addi sp,sp,4 + + subic. d3,d3,1 + blt r_array_2_bb + beq r_array_2_ab +r_array_2_aa: + lwz d1,-4(a4) + lwz d2,-8(a4) + b st_fillr2_array +r_array_2_ab: + lwz d1,-4(a4) + lwz d2,0(sp) + b st_fillr2_array +r_array_2_bb: + lwz d1,0(sp) + lwz d2,4(sp) + b st_fillr2_array + +st_fillr2_array: + cmpwi 0,d0,0 + beq skip_fillr2_array_1 + + mtctr d0 +fillr2_array_1: + stw d1,4(a6) + stwu d2,8(a6) + bdnz fillr2_array_1 + +skip_fillr2_array_1: + blr + +create_R_array_3: + subi d7,d7,3 + sub d7,d7,d0 + sub d7,d7,d0 + sub. d7,d7,d0 + bge+ no_collect_4583 + + mflr r0 + bl collect_0 + +no_collect_4583: + lea o0,__ARRAY__2 + addi a0,a6,4+NODE_POINTER_OFFSET + stw o0,4(a6) + stw d0,8(a6) + stwu d1,12(a6) + + cmpwi 0,d3,0 + + lwz r0,0(sp) + addi a2,sp,4 + addi sp,sp,4 + + beq r_array_3 + + slwi d4,d3,2 + sub a3,a4,d4 + subi d3,d3,1 + +copy_a_to_b_lp3: + subic. d3,d3,1 + + lwz o0,0(a3) + addi a3,a3,4 + stwu o0,-4(sp) + bge copy_a_to_b_lp3 + +r_array_3: + lwz d1,0(sp) + cmpwi 0,d0,0 + + lwz d2,4(sp) + lwz d3,8(sp) + mr sp,a2 + + beq skip_fillr3_array + + mtctr d0 +fillr3_array_1: + stw d1,4(a6) + stw d2,8(a6) + stwu d3,12(a6) + bdnz fillr3_array_1 + +skip_fillr3_array: + blr + +create_R_array_4: + subi d7,d7,3 + slwi d2,d0,2 + sub. d7,d7,d2 + bge+ no_collect_4584 + + mflr r0 + bl collect_0 + +no_collect_4584: + lea o1,__ARRAY__2 + addi a0,a6,4+NODE_POINTER_OFFSET + stw o1,4(a6) + stw d0,8(a6) + stwu d1,12(a6) + + cmpwi 0,d3,0 + + lwz r0,0(sp) + addi a2,sp,4 + addi sp,sp,4 + + beq r_array_4 + + slwi d4,d3,2 + sub a3,a4,d4 + subi d3,d3,1 + +copy_a_to_b_lp4: + subic. d3,d3,1 + lwz o1,0(a3) + addi a3,a3,4 + stwu o1,-4(sp) + bge copy_a_to_b_lp4 + +r_array_4: + lwz d1,0(sp) + lwz d2,4(sp) + cmpwi 0,d0,0 + + lwz d3,8(sp) + lwz d4,12(sp) + mr sp,a2 + beq skip_fillr4_array + + mtctr d0 +fillr4_array: + stw d1,4(a6) + stw d2,8(a6) + stw d3,12(a6) + stwu d4,16(a6) + bdnz fillr4_array + +skip_fillr4_array: + blr + +create_R_array_5: + subi d7,d7,3 + slwi d4,d0,2 + sub d7,d7,d4 + mr d5,d2 +sub_size_lp: + subic. d5,d5,1 + sub d7,d7,d0 + bgt sub_size_lp + + tst d7 + bge+ no_collect_4585 + + mflr r0 + bl collect_0 + +no_collect_4585: + lea o0,__ARRAY__2 + addi a0,a6,4+NODE_POINTER_OFFSET + stw o0,4(a6) + stw d0,8(a6) + stwu d1,12(a6) + + cmpwi 0,d3,0 + + lwz r0,0(sp) + addi a2,sp,4 + addi sp,sp,4 + mr d5,d2 + + beq r_array_5 + + slwi d4,d3,2 + sub a3,a4,d4 + subi d3,d3,1 + +copy_a_to_b_lp5: + subic. d3,d3,1 + + lwz o0,0(a3) + addi a3,a3,4 + stwu o0,-4(sp) + bge copy_a_to_b_lp5 + +r_array_5: + lwz d1,0(sp) + lwz d2,4(sp) + lwz d3,8(sp) + lwz d4,12(sp) + b st_fillr5_array + +fillr5_array_1: + stw d1,4(a6) + stw d2,8(a6) + mtctr d5 + stw d3,12(a6) + addi a3,sp,16 + stwu d4,16(a6) + +copy_elem_lp5: + lwz o0,0(a3) + addi a3,a3,4 + stwu o0,4(a6) + bdnz copy_elem_lp5 + +st_fillr5_array: + subic. d0,d0,1 + bge fillr5_array_1 + + mr sp,a2 + blr + + csect .e__system__sAP +e__system__sAP: + lwz a2,0(a1) + lwz a2,4-2(a2) + mtctr a2 + bctr + +; _ARRAYS + + csect ._create_arrayB +_create_arrayB: + mr d1,d0 + addi d0,d0,3 + srwi d0,d0,2 + subi d7,d7,3 + sub. d7,d7,d0 + bge+ no_collect_3575 + + mflr r0 + bl collect_0 + +no_collect_3575: + lea o0,__ARRAY__2 + addi a0,a6,4+NODE_POINTER_OFFSET + stw o0,4(a6) + stw d1,8(a6) + stwu bool_reg,12(a6) + slwi d0,d0,2 + add a6,a6,d0 + lwz r0,0(sp) + addi sp,sp,4 + blr + + csect ._create_arrayC +_create_arrayC: + mr d1,d0 + addi d0,d0,3 + srwi d0,d0,2 + subi d7,d7,2 + sub. d7,d7,d0 + bge+ no_collect_3578 + + mflr r0 + bl collect_0 + +no_collect_3578: + lea o0,__STRING__2 + addi a0,a6,4+NODE_POINTER_OFFSET + stw o0,4(a6) + stwu d1,8(a6) + slwi d0,d0,2 + add a6,a6,d0 + lwz r0,0(sp) + addi sp,sp,4 + blr + + csect ._create_arrayI +_create_arrayI: + subi d7,d7,3 + sub. d7,d7,d0 + bge+ no_collect_3577 + + mflr r0 + bl collect_0 + +no_collect_3577: + lea o0,__ARRAY__2 + addi a0,a6,4+NODE_POINTER_OFFSET + stw o0,4(a6) + stw d0,8(a6) + stwu int_reg,12(a6) + slwi d0,d0,2 + add a6,a6,d0 + lwz r0,0(sp) + addi sp,sp,4 + blr + + csect ._create_arrayR +_create_arrayR: + sub d7,d7,d0 + subi d7,d7,3+1 + sub. d7,d7,d0 + bge+ no_collect_3579 + + mflr r0 + bl collect_0 + +no_collect_3579: + addi a6,a6,4 + + lea o0,__ARRAY__2 + rlwinm d3,a6,32-2,31,31 + + rlwinm a6,a6,0,0,31-3 + add d7,d7,d3 + + addi a0,a6,4+NODE_POINTER_OFFSET + stw o0,4(a6) + stw d0,8(a6) + slwi d0,d0,3 + stwu real_reg,12(a6) + add a6,a6,d0 + lwz r0,0(sp) + addi sp,sp,4 + blr + +; d0: number of elements, d1: element descriptor, d2: element size, +; d3: element a size a0: a_element -> a0: array + + csect ._create_r_array +_create_r_array: + subi d7,d7,3 + mr d5,d2 +sub_size_lp2: + subic. d5,d5,1 + sub d7,d7,d0 + bgt sub_size_lp2 + + tst d7 + bge+ no_collect_3585 + + mflr r0 + bl collect_1 + +no_collect_3585: + lea o0,__ARRAY__2 + mr d4,a0 + addi a0,a6,4+NODE_POINTER_OFFSET + stw o0,4(a6) + stw d0,8(a6) + stwu d1,12(a6) + + tst d3 + lwz r0,0(sp) + addi sp,sp,4 + beq _create_r_array_0 + subic. d3,d3,2 + blt _create_r_array_1 + beq _create_r_array_2 + subic. d3,d3,2 + blt _create_r_array_3 + beq _create_r_array_4 + b _create_r_array_5 + +_create_r_array_0: + tst d2 + mtctr d2 + slwi d0,d0,2 + beq _skip_fillr0_array_lp +_fillr0_array_1: + add a6,a6,d0 + bdnz _fillr0_array_1 +_skip_fillr0_array_lp: + blr + +_create_r_array_1: + tst d0 + mtctr d0 + slwi d2,d2,2 + beq _skip_fillr1_array_lp +_fillr1_array_lp: + stw d4,4(a6) + add a6,a6,d2 + bdnz _fillr1_array_lp +_skip_fillr1_array_lp: + blr + +_create_r_array_2: + tst d0 + mtctr d0 + slwi d2,d2,2 + beq _skip_fillr2_array_1 +_fillr2_array_1: + stw d4,4(a6) + stw d4,8(a6) + add a6,a6,d2 + bdnz _fillr2_array_1 +_skip_fillr2_array_1: + blr + +_create_r_array_3: + tst d0 + mtctr d0 + slwi d2,d2,2 + beq _skip_fillr3_array +_fillr3_array_1: + stw d4,4(a6) + stw d4,8(a6) + stw d4,12(a6) + add a6,a6,d2 + bdnz _fillr3_array_1 +_skip_fillr3_array: + blr + +_create_r_array_4: + tst d0 + mtctr d0 + slwi d2,d2,2 + beq _skip_fillr4_array +_fillr4_array: + stw d4,4(a6) + stw d4,8(a6) + stw d4,12(a6) + stw d4,16(a6) + add a6,a6,d2 + bdnz _fillr4_array +_skip_fillr4_array: + blr + +_create_r_array_5: + mr d1,d3 + subi d2,d2,4 + sub d2,d2,d3 + slwi d2,d2,2 + b _st_fillr5_array + +_fillr5_array_1: + stw d4,4(a6) + stw d4,8(a6) + mtctr d1 + stw d4,12(a6) + stwu d4,16(a6) + +_copy_elem_lp5: + stwu d4,4(a6) + bdnz _copy_elem_lp5 + add a6,a6,d2 +_st_fillr5_array: + subic. d0,d0,1 + bge _fillr5_array_1 + blr + + csect .yet_args_needed +yet_args_needed: +; for more than 4 arguments + lwz d1,0(a1) + lhz d0,-2(d1) + subi d7,d7,3 + sub. d7,d7,d0 + blt gc_1 + +gc_r_1: lwz d3,4(a1) + subi d0,d0,1+4 + lwz a1,8(a1) + addi d2,a6,4 + lwz o0,0(a1) + lwz o1,4(a1) + stw o0,4(a6) + lwz o2,8(a1) + stw o1,8(a6) + addi a1,a1,12 + stwu o2,12(a6) + +cp_a: lwz o0,0(a1) + addi a1,a1,4 + stwu o0,4(a6) + subic. d0,d0,1 + bge cp_a + + stw a0,4(a6) + addi d1,d1,8 + stw d1,8(a6) + addi a0,a6,8 + stw d3,12(a6) + stwu d2,16(a6) + + lwz r0,0(sp) + addi sp,sp,4 + blr + +gc_1: mflr r0 + bl collect_2 + b gc_r_1 + + csect .yet_args_needed_0 +yet_args_needed_0: + subic. d7,d7,2 + blt gc_20 +gc_r_20: stwu a0,8(a6) + lwz d0,0(a1) + addi a0,a6,4-8 + addi d0,d0,8 + stw d0,4-8(a6) + + lwz r0,0(sp) + addi sp,sp,4 + blr + +gc_20: mflr r0 + bl collect_2 + b gc_r_20 + + csect .yet_args_needed_1 +yet_args_needed_1: + subic. d7,d7,3 + blt gc_21 +gc_r_21: stwu a0,12(a6) + lwz d0,0(a1) + addi a0,a6,4-12 + addi d0,d0,8 + stw d0,4-12(a6) + lwz d1,4(a1) + stw d1,8-12(a6) + + lwz r0,0(sp) + addi sp,sp,4 + blr + +gc_21: mflr r0 + bl collect_2 + b gc_r_21 + + csect .yet_args_needed_2 +yet_args_needed_2: + subic. d7,d7,5 + blt gc_22 +gc_r_22: + lwz d0,0(a1) + stw a0,8(a6) + addi d0,d0,8 + lwz d2,4(a1) + stw d0,12(a6) + addi a0,a6,12 + lwz o0,8(a1) + stw d2,16(a6) + stwu o0,4(a6) + stwu a6,16(a6) + + lwz r0,0(sp) + addi sp,sp,4 + blr + +gc_22: mflr r0 + bl collect_2 + b gc_r_22 + + csect .yet_args_needed_3 +yet_args_needed_3: + subic. d7,d7,6 + blt gc_23 +gc_r_23: + lwz d0,0(a1) + stw a0,12(a6) + addi d0,d0,8 + lwz d2,4(a1) + stw d0,16(a6) + lwz a1,8(a1) + stw d2,20(a6) + lwz o0,0(a1) + lwz o1,4(a1) + stwu o0,4(a6) + stwu a6,20(a6) + addi a0,a6,16-24 + stw o1,8-24(a6) + + lwz r0,0(sp) + addi sp,sp,4 + blr + +gc_23: mflr r0 + bl collect_2 + b gc_r_23 + + csect .yet_args_needed_4 +yet_args_needed_4: + subic. d7,d7,7 + blt gc_24 +gc_r_24: + lwz d0,0(a1) + stw a0,16(a6) + addi d0,d0,8 + lwz d2,4(a1) + stw d0,20(a6) + lwz a1,8(a1) + stw d2,24(a6) + lwz o0,0(a1) + lwz o1,4(a1) + stwu o0,4(a6) + stwu a6,24(a6) + addi a0,a6,20-28 + lwz o2,8(a1) + stw o1,8-28(a6) + stw o2,12-28(a6) + + lwz r0,0(sp) + addi sp,sp,4 + blr + +gc_24: mflr r0 + bl collect_2 + b gc_r_24 + + csect .repl_args_b +repl_args_b: + cmpwi 0,d0,0 + ble repl_args_b_1 + + subic. d0,d0,1 + beq repl_args_b_4 + + lwz a1,8(a0) + subic. d1,d1,2 + bne repl_args_b_2 + + stw a1,0(a4) + addi a4,a4,4 + b repl_args_b_4 + +repl_args_b_2: + slwi d1,d0,2 + add a1,a1,d1 + subi d0,d0,1 +repl_args_b_3: + lwzu o0,-4(a1) + addi a4,a4,4 + stw o0,0-4(a4) + cmpwi 0,d0,0 + subi d0,d0,1 + bne repl_args_b_3 +repl_args_b_4: + lwz o0,4(a0) + addi a4,a4,4 + stw o0,0-4(a4) +repl_args_b_1: + lwz r0,0(sp) + addi sp,sp,4 + blr + + csect .push_arg_b +push_arg_b: + cmplwi 0,d1,2 + blt push_arg_b_1 + bne push_arg_b_2 + + cmpw 0,d1,d0 + beq push_arg_b_1 +push_arg_b_2: + lwz a0,8(a0) + subi d1,d1,2 +push_arg_b_1: + slwi d1,d1,2 + lwzx a0,a0,d1 + + lwz r0,0(sp) + addi sp,sp,4 + blr + + csect .del_args +del_args: + lwz d1,0(a0) + sub d1,d1,d0 + lhz d0,-2(d1) + subic. d0,d0,2 + bge del_args_2 + + lwz o0,4(a0) + stw d1,0(a1) + lwz o1,8(a0) + stw o0,4(a1) + stw o1,8(a1) + + lwz r0,0(sp) + addi sp,sp,4 + blr + +del_args_2: + bne del_args_3 + + lwz o0,4(a0) + stw d1,0(a1) + lwz o1,8(a0) + stw o0,4(a1) + lwz o1,0(o1) + stw o1,8(a1) + + lwz r0,0(sp) + addi sp,sp,4 + blr + +del_args_3: + sub. d7,d7,d0 + blt del_args_gc +del_args_r_gc: + stw d1,0(a1) + lwz o0,4(a0) + stw a6,8(a1) + lwz a0,8(a0) + stw o0,4(a1) + +del_args_copy_args: + lwz o0,0(a0) + addi a0,a0,4 + stw o0,0(a6) + addi a6,a6,4 + subic. d0,d0,1 + bgt del_args_copy_args + + lwz r0,0(sp) + addi sp,sp,4 + blr + +del_args_gc: + mflr r0 + bl collect_2 + b del_args_r_gc + + if 0 + csect .o__S_P2 +o__S_P2: + lwz d0,0(a0) + lha d0,-2(d0) + cmpwi 0,d0,2 + lwz a0,8(a0) + beq o__S_P2_2 + lwz a0,0(a0) +o__S_P2_2: + lwz r0,0(sp) + addi sp,sp,4 + blr + + csect .ea__S_P2 +ea__S_P2: + lea a2,__indirection + lwz d0,4(a1) + stw a2,0(a1) + stw a0,4(a1) + mr a1,d0 + lwz d0,0(a1) + andi. r0,d0,2 + bne ea__S_P2_1 + + stw a0,0(a4) + addi a4,a4,4 + + mtctr d0 + + mr a0,a1 + + mflr r0 + stwu r0,-4(sp) + bctrl + mtlr r0 + + mr a1,a0 + lwzu a0,-4(a4) + +ea__S_P2_1: + lwz d0,0(a1) + lha d0,-2(d0) + lwz a1,8(a1) + cmpwi 0,d0,2 + beq ea__S_P2_2 + lwz a1,0(a1) +ea__S_P2_2: + lwz d0,0(a1) + andi. r0,d0,2 + bne ea__S_P2_3 + + subi d0,d0,20 + mtctr d0 + bctr + +ea__S_P2_3: + stw d0,0(a0) + lwz g1,4(a1) + stw g1,4(a0) + lwz g1,8(a1) + stw g1,8(a0) + + lwz r0,0(sp) + addi sp,sp,4 + blr + endif + + csect .acos_real{PR} +acos_real: + mflr r0 + stwu r0,-4(sp) + fmr f1,f14 + + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + else + stwu sp,-64(sp) + endif + bl .acos + nop +#ifdef USE_DCBZ + li g2,32 +#endif + if MACOSX + lwz sp,0(sp) + lwz r0,0(sp) + else + lwz r0,64(sp) + endif + fmr f14,f1 + mtlr r0 + if MACOSX + lwz r0,4(sp) + addi sp,sp,8 + else + lwz r0,68(sp) + addi sp,sp,72 + endif + blr + + csect .asin_real{PR} +asin_real: + mflr r0 + stwu r0,-4(sp) + fmr f1,f14 + + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + else + stwu sp,-64(sp) + endif + bl .asin + nop +#ifdef USE_DCBZ + li g2,32 +#endif + if MACOSX + lwz sp,0(sp) + lwz r0,0(sp) + else + lwz r0,64(sp) + endif + fmr f14,f1 + mtlr r0 + if MACOSX + lwz r0,4(sp) + addi sp,sp,8 + else + lwz r0,68(sp) + addi sp,sp,72 + endif + blr + + csect .atan_real{PR} +atan_real: + mflr r0 + stwu r0,-4(sp) + fmr f1,f14 + + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + else + stwu sp,-64(sp) + endif + bl .atan + nop +#ifdef USE_DCBZ + li g2,32 +#endif + if MACOSX + lwz sp,0(sp) + lwz r0,0(sp) + else + lwz r0,64(sp) + endif + fmr f14,f1 + mtlr r0 + if MACOSX + lwz r0,4(sp) + addi sp,sp,8 + else + lwz r0,68(sp) + addi sp,sp,72 + endif + blr + + csect .cos_real{PR} +cos_real: + mflr r0 + stwu r0,-4(sp) + fmr f1,f14 + + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + else + stwu sp,-64(sp) + endif + bl .cos + nop +#ifdef USE_DCBZ + li g2,32 +#endif + if MACOSX + lwz sp,0(sp) + lwz r0,0(sp) + else + lwz r0,64(sp) + endif + fmr f14,f1 + mtlr r0 + if MACOSX + lwz r0,4(sp) + addi sp,sp,8 + else + lwz r0,68(sp) + addi sp,sp,72 + endif + blr + + csect .sin_real{PR} +sin_real: + mflr r0 + stwu r0,-4(sp) + fmr f1,f14 + + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + else + stwu sp,-64(sp) + endif + bl .sin + nop +#ifdef USE_DCBZ + li g2,32 +#endif + if MACOSX + lwz sp,0(sp) + lwz r0,0(sp) + else + lwz r0,64(sp) + endif + fmr f14,f1 + mtlr r0 + if MACOSX + lwz r0,4(sp) + addi sp,sp,8 + else + lwz r0,68(sp) + addi sp,sp,72 + endif + blr + + csect .tan_real{PR} +tan_real: + mflr r0 + stwu r0,-4(sp) + fmr f1,f14 + + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + else + stwu sp,-64(sp) + endif + bl .tan + nop +#ifdef USE_DCBZ + li g2,32 +#endif + if MACOSX + lwz sp,0(sp) + lwz r0,0(sp) + else + lwz r0,64(sp) + endif + fmr f14,f1 + mtlr r0 + if MACOSX + lwz r0,4(sp) + addi sp,sp,8 + else + lwz r0,68(sp) + addi sp,sp,72 + endif + blr + + csect .ln_real{PR} +ln_real: + mflr r0 + stwu r0,-4(sp) + fmr f1,f14 + + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + else + stwu sp,-64(sp) + endif + bl .log + nop +#ifdef USE_DCBZ + li g2,32 +#endif + if MACOSX + lwz sp,0(sp) + lwz r0,0(sp) + else + lwz r0,64(sp) + endif + fmr f14,f1 + mtlr r0 + if MACOSX + lwz r0,4(sp) + addi sp,sp,8 + else + lwz r0,68(sp) + addi sp,sp,72 + endif + blr + + csect .log10_real{PR} +log10_real: + mflr r0 + stwu r0,-4(sp) + fmr f1,f14 + + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + else + stwu sp,-64(sp) + endif + bl .log10 + nop +#ifdef USE_DCBZ + li g2,32 +#endif + if MACOSX + lwz sp,0(sp) + lwz r0,0(sp) + else + lwz r0,64(sp) + endif + fmr f14,f1 + mtlr r0 + if MACOSX + lwz r0,4(sp) + addi sp,sp,8 + else + lwz r0,68(sp) + addi sp,sp,72 + endif + blr + + csect .exp_real{PR} +exp_real: + mflr r0 + stwu r0,-4(sp) + fmr f1,f14 + + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + else + stwu sp,-64(sp) + endif + bl .exp + nop +#ifdef USE_DCBZ + li g2,32 +#endif + if MACOSX + lwz sp,0(sp) + lwz r0,0(sp) + else + lwz r0,64(sp) + endif + fmr f14,f1 + mtlr r0 + if MACOSX + lwz r0,4(sp) + addi sp,sp,8 + else + lwz r0,68(sp) + addi sp,sp,72 + endif + blr + + csect .sqrt_real{PR} +sqrt_real: + mflr r0 + stwu r0,-4(sp) + fmr f1,f14 + + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + else + stwu sp,-64(sp) + endif + bl .sqrt + nop +#ifdef USE_DCBZ + li g2,32 +#endif + if MACOSX + lwz sp,0(sp) + lwz r0,0(sp) + else + lwz r0,64(sp) + endif + fmr f14,f1 + mtlr r0 + if MACOSX + lwz r0,4(sp) + addi sp,sp,8 + else + lwz r0,68(sp) + addi sp,sp,72 + endif + blr + + csect .pow_real{PR} +pow_real: + mflr r0 + stwu r0,-4(sp) + fmr f2,f14 + fmr f1,f15 + + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + else + stwu sp,-64(sp) + endif + bl .pow + nop +#ifdef USE_DCBZ + li g2,32 +#endif + if MACOSX + lwz sp,0(sp) + lwz r0,0(sp) + else + lwz r0,64(sp) + endif + fmr f14,f1 + mtlr r0 + if MACOSX + lwz r0,4(sp) + addi sp,sp,8 + else + lwz r0,68(sp) + addi sp,sp,72 + endif + blr + + csect .entier_real{PR} +entier_real: + lea o0,entier_constants_and_buffers + fctiwz f2,f14 + lfd f1,0(o0) + stfd f2,8(o0) + fcmpo 0,f14,f1 + lwz d0,12(o0) + bge+ entier_real_2 + + lfd f31,24(o0) + xoris o1,d0,0x8000 + stw o1,20(o0) + lfd f1,16(o0) + fsub f1,f1,f31 + fcmpo 0,f14,f1 + beq entier_real_2 + + subi d0,d0,1 +entier_real_2: + lwz r0,0(sp) + addi sp,sp,4 + blr + + csect .my_pointer_glue{PR} + lwz r0,0(r3) + stw RTOC,20(SP) + mtctr r0 + lwz RTOC,4(r3) + bctr + + + macro + te &address + tc &address{TC},&address + endm + + toc + + tc INT2{TC},INT+2 + tc CHAR2{TC},CHAR+2 + tc BOOL2{TC},BOOL+2 + tc REAL2{TC},REAL+2 + tc __STRING__2{TC},__STRING__+2 + tc __ARRAY__2{TC},__ARRAY__+2 + + tc small_integers{TC},small_integers{BS} + if 1 + tc small_integers8{TC},small_integers{BS}+8 + endif + tc stack_p{TC},stack_p{BS} + if MACOSX + tc end_a_stack{TC},end_a_stack{BS} + tc end_b_stack{TC},end_b_stack{BS} + endif + tc static_characters{TC},static_characters{BS} + if 1 + tc static_characters8{TC},static_characters{BS}+8 + endif + tc sprintf_time_buffer{TC},sprintf_time_buffer{BS} + tc sprintf_buffer{TC},sprintf_buffer{BS} + tc last_time{TC},last_time{BS} + tc heap_size_33{TC},heap_size_33{BS} + tc heap_size_129{TC},heap_size_129{BS} + tc heap_p{TC},heap_p{BS} + tc heap_p1{TC},heap_p1{BS} + tc heap_p2{TC},heap_p2{BS} + tc heap_mbp{TC},heap_mbp{BS} + tc heap_copied_vector_size{TC},heap_copied_vector_size{BS} + tc heap_copied_vector{TC},heap_copied_vector{BS} + tc halt_sp{TC},halt_sp{BS} + tc garbage_collect_time{TC},garbage_collect_time{BS} + tc extra_heap{TC},extra_heap{BS} + tc extra_heap_size{TC},extra_heap_size{BS} + tc execute_time{TC},execute_time{BS} + tc basic_only{TC},basic_only{BS} + tc alloc_size{TC},alloc_size{BS} + tc IO_time{TC},IO_time{BS} + if MEASURE_GC + tc compact_garbage_collect_time{TC},compact_garbage_collect_time{BS} + tc mark_compact_garbage_collect_time{TC},mark_compact_garbage_collect_time{BS} + endif + tc heap_end_after_copy_gc{TC},heap_end_after_copy_gc{BS} + tc caf_listp{TC},caf_listp{BS} + tc caf_list{TC},caf_list{BS} + tc caf_list4{TC},caf_list{BS}+4 + + if EXCEPTIONS + tc exception_info{TC},exception_info{BS} + endif + if FINALIZERS + tc finalizer_list{TC},finalizer_list{BS} + tc free_finalizer_list{TC},free_finalizer_list{BS} + tc __Nil_m8{TC},__Nil-8 + tc e____system__kFinalizer_2{TC},e____system__kFinalizer+2 + tc e____system__kFinalizerGCTemp_2{TC},e____system__kFinalizerGCTemp+2 + endif + if MARK_GC + te last_heap_free + te free_after_mark + te bit_counter + te zero_bits_before_mark + te bit_vector_p + te marked_gc_string_1 + te lazy_array_list + if ADJUST_HEAP_SIZE + te bit_vector_size + te heap_size_multiple + te initial_heap_size + endif + endif + if MARK_AND_COPY_GC || !MARK_GC + te copy_lp1 + endif + te IO_error_string + te __cycle__in__spine + te __indirection + te stack_size + te flags + te execution_aborted + te heap_size + te false_c_string + te false_string + te file_c_string + te garbage_collect_string_1 + te garbage_collect_string_2 + te garbage_collect_string_3 + te heap_end_after_gc + te heap_p3 + te heap_use_after_gc_string_1 + te heap_use_after_gc_string_2 + te heap_vector + te high_index_string + te low_index_string + te new_line_string + te out_of_memory_string_1 + te out_of_memory_string_4 + te print_ + te printf_int_string + te printf_real_string + te sprintf_time_string + te stack_overflow_string + te time_string_1 + te time_string_2 + if MEASURE_GC + te time_string_2a + endif + te time_string_3 + te time_string_4 + te true_c_string + te true_string + te zero_length_string + te garbage_collect_flag + te entier_constants_and_buffers + + if WRITE_HEAP + tc first_function{TC},first_function{DS} + tc heap2_begin_and_end{TC},heap2_begin_and_end{BS} + te min_write_heap_size + endif + if PROFILE + te garbage_collector_name + endif diff --git a/ptrace.a b/ptrace.a new file mode 100644 index 0000000..e7f5e63 --- /dev/null +++ b/ptrace.a @@ -0,0 +1,676 @@ + + string asis + + macro + lea &r,&a + lwz &r,&a{TC}(RTOC) + endm + +MACOSX set 1 +USE_TEMPORARY_MEMORY set 1 +CHECK_STACK_OVERFLOWS set 0 +MODULE_NAMES set 1 + +d0: set r24 +d1: set r25 +d2: set r26 +d3: set r27 +d4: set r28 +d5: set r29 +d6: set r30 +d7: set r31 + +a0: set r23 +a1: set r22 +a2: set r21 +a3: set r20 +a4: set r19 +a5: set r18 +a6: set r17 + +o0: set r3 +o1: set r4 +o2: set r5 +o3: set r6 +o4: set r7 +o5: set r8 + +g2: set r9 +g3: set r10 + +g0: set r11 +g1: set r12 + +int_reg set r16 +char_reg set r15 +real_reg set r14 +bool_reg set r13 + + export init_profiler + export profile_r + export profile_l + export profile_l2 + export profile_n + export profile_n2 + export profile_s + export profile_s2 + export profile_t + export profile_ti + export write_profile_information + export write_profile_stack + + if USE_TEMPORARY_MEMORY + import .TempNewHandle + import .TempHLock + import .TempHUnlock + import .TempDisposeHandle + else + import .NewPtr + endif + import __STRING__ + import writeFC + import writeFI + import print_error + import stack_size + import .er_print_string + import .er_print_char + if CHECK_STACK_OVERFLOWS + import .Debugger + endif + +FunctionProfile: record +next: ds.l 1 +name: ds.l 1 + endr + + csect .profile_t +profile_ti: + lea r5,profile_globals + b profile_t_ + +profile_t: + mflr r12 + lea r5,profile_globals + mtctr r12 + mtlr r0 +profile_t_: + lwz r6,Globals.stack_pointer(r5) + lwzu r4,-4(r6) + stw r6,Globals.stack_pointer(r5) + bctr + + csect .profile_r +profile_r: + lea r5,profile_globals + lwz r6,Globals.stack_pointer(r5) + lwzu r4,-4(r6) + stw r6,Globals.stack_pointer(r5) + blr + + csect .profile_l +profile_l: + mflr r12 + lea r5,profile_globals + lwz r4,0(r3) + mtctr r12 + + cmpwi 0,r4,0 + beql allocate_function_profile_record + + lwz r6,Globals.stack_pointer(r5) + stw r4,0(r6) + addi r6,r6,4 + if CHECK_STACK_OVERFLOWS + lwz r12,Globals.end_profile_stack(r5) + endif + stw r6,Globals.stack_pointer(r5) + if CHECK_STACK_OVERFLOWS + cmpw r6,r12 + bge profile_stack_overflow + endif + mtlr r0 + bctr + + csect .profile_l2 +profile_l2: + mflr r12 + lea r5,profile_globals + lwz r4,0(r3) + mtctr r12 + + cmpwi 0,r4,0 + beql allocate_function_profile_record + + lwz r6,Globals.stack_pointer(r5) + stw r4,0(r6) + stw r4,4(r6) + addi r6,r6,8 + if CHECK_STACK_OVERFLOWS + lwz r12,Globals.end_profile_stack(r5) + endif + stw r6,Globals.stack_pointer(r5) + if CHECK_STACK_OVERFLOWS + cmpw r6,r12 + bge profile_stack_overflow + endif + + mtlr r0 + bctr + + csect .profile_n +profile_n: + mflr r12 + lea r5,profile_globals + lwz r4,0(r3) + mtctr r12 + + cmpwi 0,r4,0 + beql allocate_function_profile_record + + lwz r6,Globals.stack_pointer(r5) + stw r4,0(r6) + addi r6,r6,4 + if CHECK_STACK_OVERFLOWS + lwz r12,Globals.end_profile_stack(r5) + endif + stw r6,Globals.stack_pointer(r5) + if CHECK_STACK_OVERFLOWS + cmpw r6,r12 + bge profile_stack_overflow + endif + mtlr r0 + bctr + + csect .profile_n2 +profile_n2: + mflr r12 + lea r5,profile_globals + lwz r4,0(r3) + mtctr r12 + + cmpwi 0,r4,0 + beql allocate_function_profile_record + + lwz r6,Globals.stack_pointer(r5) + stw r4,0(r6) + stw r4,4(r6) + addi r6,r6,8 + if CHECK_STACK_OVERFLOWS + lwz r12,Globals.end_profile_stack(r5) + endif + stw r6,Globals.stack_pointer(r5) + if CHECK_STACK_OVERFLOWS + cmpw r6,r12 + bge profile_stack_overflow + endif + mtlr r0 + bctr + + csect .profile_s2 +profile_s2: + mflr r12 + lea r5,profile_globals + lwz r4,0(r3) + mtctr r12 + + cmpwi 0,r4,0 + beql allocate_function_profile_record + + lwz r6,Globals.stack_pointer(r5) + stw r4,0(r6) + stw r4,4(r6) + addi r6,r6,8 + if CHECK_STACK_OVERFLOWS + lwz r12,Globals.end_profile_stack(r5) + endif + stw r6,Globals.stack_pointer(r5) + if CHECK_STACK_OVERFLOWS + cmpw r6,r12 + bge profile_stack_overflow + endif + mtlr r0 + bctr + + csect .profile_s +profile_s: + mflr r12 + lea r5,profile_globals + lwz r4,0(r3) + mtctr r12 + + cmpwi 0,r4,0 + beql allocate_function_profile_record + + lwz r6,Globals.stack_pointer(r5) + + stw r4,0(r6) + addi r6,r6,4 + if CHECK_STACK_OVERFLOWS + lwz r12,Globals.end_profile_stack(r5) + endif + stw r6,Globals.stack_pointer(r5) + if CHECK_STACK_OVERFLOWS + cmpw r6,r12 + bge profile_stack_overflow + endif + mtlr r0 + bctr + +allocate_function_profile_record: + lwz r6,Globals.n_free_records_in_block(r5) + lwz r4,Globals.last_allocated_block(r5) + cmpwi 0,r6,0 + bne+ no_alloc + + stw r0,-4(sp) + stw r3,-8(sp) + stw r9,-12(sp) + stw r10,-16(sp) + mfctr r11 + stw r11,-20(sp) + mflr r12 + stw r12,-24(sp) + + if USE_TEMPORARY_MEMORY + li r3,(512*FunctionProfile)+4 + else + li r3,512*FunctionProfile + endif + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+32+28)(sp) + else + stwu sp,-(64+32)(sp) + endif + if USE_TEMPORARY_MEMORY + bl allocate_temp_memory_handle + else + bl .NewPtr + nop + endif + if MACOSX + lwz sp,0(sp) + else + addi sp,sp,64+32 + endif + and. r4,r3,r3 + + lwz r12,-24(sp) + lwz r11,-20(sp) + mtlr r12 + lwz r10,-16(sp) + mtctr r11 + lwz r9,-12(sp) + lwz r3,-8(sp) + lwz r0,-4(sp) + + lea r5,profile_globals + + beq profiler_memory_error + + if USE_TEMPORARY_MEMORY + lwz r6,Globals.temp_handle_list(r5) + stw r4,Globals.temp_handle_list(r5) + lwz r4,0(r4) + stw r6,0(r4) + addi r4,r4,4 + endif + li r6,512 + stw r4,Globals.last_allocated_block(r5) + +no_alloc: + subi r6,r6,1 + stw r6,Globals.n_free_records_in_block(r5) + addi r7,r4,FunctionProfile + stw r7,Globals.last_allocated_block(r5) + + lwz r6,Globals.profile_records(r5) + li r8,0 + stw r6,FunctionProfile.next(r4) + stw r4,Globals.profile_records(r5) + stw r3,FunctionProfile.name(r4) + + stw r4,0(r3) + blr + + csect .write_profile_information +write_profile_information: + if USE_TEMPORARY_MEMORY + mflr r0 + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(96+28)(sp) + else + stwu sp,-96(sp) + endif + stw r0,96-4(sp) + lea r5,profile_globals + lwz r3,Globals.profile_stack_handle(r5) + bl free_temp_memory_handle + + lea r5,profile_globals + + stw r31,96-8(sp) + + lwz r31,Globals.temp_handle_list(r5) + b free_temp_handles + +free_temp_handles_lp: + mr r3,r31 + lwz r31,0(r31) + lwz r31,0(r31) + bl free_temp_memory_handle + +free_temp_handles: + cmpwi 0,r31,0 + bne free_temp_handles_lp + + lwz r31,96-8(sp) + + lwz r0,96-4(sp) + if MACOSX + lwz sp,0(sp) + else + addi sp,sp,96 + endif + mtlr r0 + endif + lwz r0,0(sp) + addi sp,sp,4 + blr + + csect .write_profile_stack +write_profile_stack: + mflr r0 + lea d0,profile_globals + stwu r0,-4(sp) + lwz d0,Globals.stack_pointer(d0) + + cmpwi 0,d0,0 + beq @stack_not_initialised + + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + else + stwu sp,-64(sp) + endif + lea o0,stack_trace_string + bl .er_print_string + if MACOSX + lwz sp,0(sp) + else + addi sp,sp,64 + endif + + li d2,12 +@write_functions_on_stack + lwzu d1,-4(d0) + cmpwi 0,d1,0 + beq @end_profile_stack + + lwz o0,FunctionProfile.name(d1) + + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + else + stwu sp,-64(sp) + endif + addi o0,o0,4 + bl .er_print_string + nop + li o0,13 + bl .er_print_char + nop + if MACOSX + lwz sp,0(sp) + else + addi sp,sp,64 + endif + + subic. d2,d2,1 + if 0 + b @write_functions_on_stack + else + bne @write_functions_on_stack + endif + +@end_profile_stack: +@stack_not_initialised: + lwz r0,0(sp) + mtlr r0 + lwz r0,4(sp) + addi sp,sp,8 + blr + + csect .init_profiler +init_profiler: + if 0 + mflr r0 + stw r0,-4(sp) + stwu sp,-64(sp) + + bl .Debugger + nop + + lwz r0,64-4(sp) + addi sp,sp,64 + mtlr r0 + endif + + mflr r0 + stwu r0,-4(sp) + + if 1 + lea r3,stack_size + lwz r3,0(r3) + else + li r3, (512*1024) % 65536 + addis r3,r3,(512*1024) / 65536 + endif + + if MACOSX + mr g0,sp + ori sp,sp,28 + stwu g0,-(64+28)(sp) + else + stwu sp,-64(sp) + endif + if USE_TEMPORARY_MEMORY + bl allocate_temp_memory_handle + else + bl .NewPtr + nop + endif + if MACOSX + lwz sp,0(sp) + else + addi sp,sp,64 + endif + lea r5,profile_globals + + and. r9,r3,r3 + beq init_profiler_error + + if USE_TEMPORARY_MEMORY + stw r9,Globals.profile_stack_handle(r5) + lwz r9,0(r9) + li r0,0 + stw r0,Globals.temp_handle_list(r5) + endif + if CHECK_STACK_OVERFLOWS + if 1 + lea r3,stack_size + lwz r3,0(r3) + else + li r3, (512*1024) % 65536 + addis r3,r3,(512*1024) / 65536 + endif + add r3,r3,r9 + stw r3,Globals.end_profile_stack(r5) + endif + lea r3,start_string + bl allocate_function_profile_record + + lwz r0,0(sp) + addi sp,sp,4 + mtlr r0 + + li r0,0 + stw r4,4(r9) + stw r0,0(r9) + addi r9,r9,8 + stw r9,Globals.stack_pointer(r5) + stw d7,Globals.n_words_free(r5) + + lwz r0,0(sp) + addi sp,sp,4 + + blr + + if USE_TEMPORARY_MEMORY +allocate_temp_memory_handle: + mflr r0 + stw r31,-4(sp) + stw r0,8(sp) + stwu sp,-96(sp) + + addi r4,sp,56 + bl .TempNewHandle + nop + + mr. r31,r3 + beq return_r31 + + addi r4,sp,56 + bl .TempHLock + nop + + lha r0,56(sp) + cmpwi r0,0 + beq+ return_r31 + + mr r3,r31 + addi r4,sp,56 + bl .TempDisposeHandle + nop + + li r31,0 +return_r31: + lwz r0,104(sp) + mr r3,r31 + mtlr r0 + addi sp,sp,96 + lwz r31,-4(sp) + blr + +free_temp_memory_handle: + mflr r0 + stw r3,-4(sp) + stw r0,8(sp) + stwu sp,-96(sp) + + addi r4,sp,56 + bl .TempHUnlock + nop + + lwz r3,96-4(sp) + addi r4,sp,56 + bl .TempDisposeHandle + nop + + lwz r0,104(sp) + addi sp,sp,96 + mtlr r0 + blr + endif + +init_profiler_error: + lea o0,not_enough_memory_for_profile_stack + lea r5,profile_globals + li r4,0 + stw r4,Globals.stack_pointer(r5) + b print_error +profiler_memory_error: + lea o0,not_enough_memory_for_profiler + b print_error + if CHECK_STACK_OVERFLOWS +profile_stack_overflow: + mflr r0 + stw r0,-4(sp) + stwu sp,-64(sp) + + bl .Debugger + nop + + lwz r0,64-4(sp) + addi sp,sp,64 + mtlr r0 + b profile_stack_overflow + endif + + + csect data{RW} +Globals: record +n_free_records_in_block:ds.l 1 ; 0 n free records in block +last_allocated_block: ds.l 1 ; 4 latest allocated block +profile_records: ds.l 1 ; 8 profile record list +stack_pointer: ds.l 1 ; 12 stack pointer +n_words_free: ds.l 1 + if USE_TEMPORARY_MEMORY +temp_handle_list ds.l 1 +profile_stack_handle ds.l 1 + endif + if CHECK_STACK_OVERFLOWS +end_profile_stack ds.l 1 + endif + endr + + align 2 +profile_globals: ds Globals + + align 2 + if MODULE_NAMES +m_system: + dc.l 6 + dc.b 'System' + dc.b 0,0 + dc.l m_system + endif +start_string: + dc.l 0 + dc.b 'start' + dc.b 0 + align 2 +not_enough_memory_for_profile_stack: + dc.b 'not enough memory for profile stack' + dc.b 13 + dc.b 0 +not_enough_memory_for_profiler: + dc.b 'not enough memory for profiler' + dc.b 13 + dc.b 0 +stack_trace_string: + dc.b 'Stack trace:' + dc.b 13 + dc.b 0 + align 2 + + macro + te &address + tc &address{TC},&address + endm + + toc + + te profile_globals + te not_enough_memory_for_profile_stack + te not_enough_memory_for_profiler + te start_string + te stack_trace_string + te stack_size -- cgit v1.2.3