diff options
| -rw-r--r-- | Worksheet | 28 | ||||
| -rw-r--r-- | mcon.c | 1670 | ||||
| -rw-r--r-- | mcon.h | 16 | ||||
| -rw-r--r-- | mfileIO3.c | 2718 | ||||
| -rw-r--r-- | mwrite_heap.c | 237 | ||||
| -rw-r--r-- | pcompact.a | 1762 | ||||
| -rw-r--r-- | pcopy.a | 1000 | ||||
| -rw-r--r-- | pfileIO3.a | 1428 | ||||
| -rw-r--r-- | pmacros.a | 54 | ||||
| -rw-r--r-- | pmark.a | 2316 | ||||
| -rw-r--r-- | pprofile.a | 1407 | ||||
| -rw-r--r-- | pstartup.a | 6085 | ||||
| -rw-r--r-- | ptrace.a | 676 |
13 files changed, 19397 insertions, 0 deletions
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 @@ -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 <stdio.h> +#include <stdlib.h> +#include <string.h> +#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 <quickdraw.h> +#include <fonts.h> +#include <events.h> +#include <windows.h> +#ifndef NEW_HEADERS +# include <desk.h> +#endif +#include <memory.h> +#include <resources.h> +#include <menus.h> +#include <OSUtils.h> +#ifndef NEW_HEADERS +# include <OSEvents.h> +#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; y<n_lines; ++y,screen_y_pos+=char_height){ + char *line_chars,*c_p; + int line_length; + + MoveTo (0,screen_y_pos); + line_chars=chars[y]; + + line_length=0; + c_p=line_chars; + while (*c_p++!=NEWLINE_CHAR) + ++line_length; + DrawText (line_chars,0,line_length); + } + + MoveTo (g_cur_x,MULW (cur_y,char_height)+char_asc_lead); + + SetPort (old_port); + EndUpdate (window); +} + +static void select_window (WindowPtr window) +{ + if (window!=c_window && window!=e_window) + return; + + SelectWindow (window); +} + +static int c_window_width,c_window_height,e_window_width,e_window_height; + +static Rect c_window_rect,e_window_rect; +static Rect c_local_window_rect,e_local_window_rect; + +static void scroll_window (WindowPtr window,SCREEN_LINE_CHARS *chars,int n_lines) +{ + RgnHandle erase_region; +#ifdef MACOSX + Rect rect; +#endif + + add_execute_time(); + + erase_region=NewRgn(); + +#ifdef MACOSX + GetPortBounds (GetWindowPort (window),&rect); + ScrollRect (&rect,0,-char_height,erase_region); +#else + ScrollRect (&window->portRect,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<c_window_width && cur_x+length<MAX_N_COLUMNS){ + char *screen_char; + int n; + + screen_char=&screen_chars[cur_y][cur_x]; + for (n=0; n<length; ++n) + *screen_char++=s[n]; + *screen_char=NEWLINE_CHAR; + DrawText (s,0,length); + g_cur_x+=text_length; + cur_x+=length; + } else + for (n=0; n<length; ++n) + window_print_char (s[n]); +} + +void w_print_text (char *s,unsigned long length) +{ + 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 (length!=0){ + while (length!=0 && (c=*end_s,c!=NEWLINE_CHAR)){ + ++end_s; + --length; + } + w_print_text_without_newlines (s,end_s-s); + if (length==0) + return; + print_newline(); + --length; + s=++end_s; + } + +#ifndef MACOSX + if (port!=NULL) +#endif + SetPort (port); +} + +static void e_print_newline() +{ + e_screen_chars[e_cur_y][e_cur_x]=NEWLINE_CHAR; + ++e_cur_y; + e_cur_x=0; + e_g_cur_x=0; + if (e_cur_y>=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_length<e_window_width && e_cur_x+length<MAX_N_COLUMNS){ + char *screen_char; + int n; + + screen_char=&e_screen_chars[e_cur_y][e_cur_x]; + for (n=0; n<length; ++n) + *screen_char++=s[n]; + *screen_char=NEWLINE_CHAR; + DrawText (s,0,length); + e_g_cur_x+=text_length; + e_cur_x+=length; + } else + for (n=0; n<length; ++n) + e_print_char (s[n]); +} + +static void e_print_text (char *s,unsigned long length) +{ + char *end_s,c; + + end_s=s; + while (length!=0){ + while (length!=0 && (c=*end_s,c!=NEWLINE_CHAR)){ + ++end_s; + --length; + } + e_print_text_without_newlines (s,end_s-s); + if (length==0) + return; + e_print_newline(); + --length; + s=++end_s; + } +} + +void ew_print_text (char *s,unsigned long length) +{ + 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_text (s,length); + +#ifndef MACOSX + if (port!=NULL) +#endif + SetPort (port); +} + +static void w_show_cursor() +{ + int y; + + y=MULW(cur_y,char_height); + MoveTo (g_cur_x,y+char_height); + LineTo (g_cur_x,y+1); + MoveTo (g_cur_x,y+char_asc_lead); +} + +static void w_remove_cursor() +{ + PenMode (patBic); + w_show_cursor(); + PenMode (patCopy); +} + +static void w_remove_char (int w) +{ + Rect r; + int y; + + y=MULW(cur_y,char_height); + + r.bottom=y+char_height; + r.top=y+1; + r.left=g_cur_x; + r.right=g_cur_x+w-1; + + EraseRect (&r); +} + +void handle_update_or_mouse_down_event (EventRecord *event_p) +{ + if (event_p->what==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+1<n_screen_lines) + print_newline(); + else + if (b_cur_y>0){ + --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+1<n_screen_lines) + print_newline(); + else + if (b_cur_y>0){ + --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<n_screen_lines; ++n) + screen_chars[n][0]=NEWLINE_CHAR; + + e_screen_chars=(SCREEN_LINE_CHARS*) NewPtr (n_e_screen_lines * (MAX_N_COLUMNS+1)); + if (e_screen_chars==NULL) + return 0; + + for (n=0; n<n_e_screen_lines; ++n) + e_screen_chars[n][0]=NEWLINE_CHAR; + + input_buffer=(char*) NewPtr (n_screen_lines * MAX_N_COLUMNS+1); + if (input_buffer==NULL) + return 0; + + input_buffer_length=0; + + return 1; +} + +static void wait_key() +{ + while (1){ +#ifndef MACOSX + SystemTask(); +#endif + if (!GetNextEvent (everyEvent,&my_event)) + continue; + switch (my_event.what){ + case keyDown: + return; + case updateEvt: + case mouseDown: + handle_update_or_mouse_down_event (&my_event); + break; + } + } +} + +#define VOID void + +void wait_for_key_press (VOID) +{ +#if 1 + SetWTitle (flags & 16 ? e_window : c_window,"\ppress any key to exit"); +#endif + wait_key(); +} + +static void exit_terminal() +{ + DisposeWindow (c_window); + DisposeWindow (e_window); +/* + CloseWindow (c_window); + CloseWindow (e_window); +*/ +} + +static void get_font_number (char *font_name) +{ + char system_font_name[256]; + + GetFNum ((unsigned char*)font_name,&font_id); + + if (font_id==0){ + char *s1,*s2; + + GetFontName (0,(unsigned char*)system_font_name); + + s1=system_font_name; + s2=font_name; + while (*s1==*s2 && *s1!='\0'){ + ++s1; + ++s2; + } + if (*s1 || *s2) + font_id=-1; + } +} + +#ifdef PARALLEL +void load_code_segments (VOID) +{ + int n_code_resources,resource_number; + + n_code_resources=Count1Resources ('CODE'); + + for (resource_number=1; resource_number<=n_code_resources; ++resource_number){ + Handle resource; + + SetResLoad (1); + + resource=Get1Resource ('CODE',resource_number); + if (resource!=NULL && !ResError()){ + MoveHHi (resource); + HLock (resource); + } + } +} +#endif + +#ifndef G_POWER + extern int target_processor; +#endif + +#ifdef SIMULATE + extern int n_processors,processor_table_size; + extern int processor_table,end_processor_table; +#endif + +SysEnvRec system_environment; +int wait_next_event_available; + +#include <types.h> + +#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_multiple<MINIMUM_HEAP_SIZE_MULTIPLE) + heap_size_multiple=MINIMUM_HEAP_SIZE_MULTIPLE; + if (heap_size_multiple>MAXIMUM_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; n<cur_ap_name_length; ++n) + profile_file_name[8+n]=cur_ap_name[n]; + + profile_file_name_length=cur_ap_name_length+13; + if (profile_file_name_length>31) + 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 @@ -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 <Traps.h> +#endif +#include <Memory.h> +#include <Files.h> +#include <Errors.h> +#include <Script.h> + +#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; n<number_of_files; ++n) + if (file_table[n].file_mode!=0 && + file_table[n].file_number==*file_number_p && + file_table[n].file_volume_number==*volume_number_p) + { + return n; + } + + return -1; +} + +#define FILE_IO_BUFFER_SIZE (4*1024) + +#define F_READ_TEXT 0 +#define F_WRITE_TEXT 1 +#define F_APPEND_TEXT 2 +#define F_READ_DATA 3 +#define F_WRITE_DATA 4 +#define F_APPEND_DATA 5 + +#define ERROR_FILE ((struct file*)-(long)&file_table[2]) + +static char file_permission[] ={ fsRdPerm,fsWrPerm,fsWrPerm,fsRdPerm,fsWrPerm,fsWrPerm }; + +OSType new_file_creator='3PRM'; + +struct file *open_file (struct clean_string *file_name,unsigned int file_mode) +{ + unsigned char p_file_name[MAX_FILE_NAME_LENGTH+1]; + char *file_name_s; + int fn,existing_fn; + struct file *f; + long file_length; + long file_number; + unsigned char *buffer; + short file_refnum,volume_number; + 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>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; ++fn) + if (file_table[fn].file_mode==0) + break; + + if (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_mode) & ((1<<F_WRITE_TEXT)|(1<<F_WRITE_DATA)))){ + pb_NamePtr=p_file_name; + pb_VRefNum=0; + pb_DirID=0; + + /* may be use HCreate, which also sets creator and filetype ? */ + + error=PBHCreateSync ((void*)&pb); + if (error!=noErr){ + free_memory (file_name_s); + return ERROR_FILE; + } + + 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; + if ((1<<file_mode) & (1<<F_WRITE_TEXT)) + 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){ + 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 ("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; + + 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_mode) | (buffer_mask & ~255); + f->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_mode); + f->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<<F_WRITE_TEXT)|(1<<F_WRITE_DATA)|(1<<F_APPEND_TEXT)|(1<<F_APPEND_DATA))){ + unsigned char *buffer; + + buffer=f->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_mode) | (buffer_mask & ~255); + f->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<<F_READ_TEXT) | (1<<F_READ_DATA)))) + IO_error ("freadc: read from an output file"); + + return char_from_new_buffer (f); + } + } +} + +#define is_digit(n) ((unsigned)((n)-'0')<(unsigned)10) + +int file_read_int (struct file *f,int *i_p) +{ + if (is_special_file (f)){ + if (f==file_table) + IO_error ("freadi: can't read from stderr"); + else if (f==&file_table[1]) + return w_get_int (i_p); + else + IO_error ("freadi: can't open this file"); + } else { + *i_p=0; + + if (f->file_mode & (1<<F_READ_DATA)){ + int i; + + if ((i=read_char (f))==EOF){ + f->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<<F_READ_TEXT)){ + int c,negative,result; + + result=-1; + + while ((c=read_char (f))==' ' || c=='\t' || c=='\n' || c=='\r') + ; + + negative=0; + if (c=='+') + c=read_char (f); + else + if (c=='-'){ + c=read_char (f); + negative=1; + } + + if (!is_digit (c)){ + result=0; + f->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<<F_READ_DATA)){ + int n; + + for (n=0; n<8; ++n){ + int i; + + if ((i=read_char (f))==EOF){ + f->file_error=-1; + return 0; + } + ((char*)r_p)[n]=i; + } + } else if (f->file_mode & (1<<F_READ_TEXT)){ + int c,dot,digits,result,n; + char s[256+1]; + + n=0; + + while ((c=read_char (f))==' ' || c=='\t' || c=='\n' || c=='\r') + ; + + if (c=='+') + c=read_char (f); + else + if (c=='-'){ + s[n++]=c; + c=read_char (f); + } + + 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=read_char (f); + } + + result=0; + if (digits) + if (dot==2 || ! (c=='e' || c=='E')) + result=-1; + else { + if (n<256) + s[n++]=c; + c=read_char (f); + + if (c=='+') + c=read_char (f); + else + if (c=='-'){ + if (n<256) + s[n++]=c; + c=read_char (f); + } + + if (is_digit (c)){ + do { + if (n<256) + s[n++]=c; + c=read_char (f); + } while (is_digit (c)); + + result=-1; + } + } + + if (n>=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<<F_READ_TEXT) | (1<<F_READ_DATA)))) + IO_error ("freads: read from an output file"); + +#if OLD_READ_STRING + string=s->characters; +#else + string=s; +#endif + begin_string=string; + end_string=string+max_length; + + while (string<end_string){ + if (f->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-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<<F_READ_TEXT)){ + while (string<end_string){ + if (f->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<<F_READ_DATA)){ + while (string<end_string){ + if (f->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 (string<end_string){ + *string++='\xa'; + f->file_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 (string<end_string){ + if (c=='\xa') + *string++=c; + else + if (f->file_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<<F_WRITE_TEXT)|(1<<F_WRITE_DATA)|(1<<F_APPEND_TEXT)|(1<<F_APPEND_DATA)))) + IO_error ("fwritec: write to an input file"); + + char_to_new_buffer (c,f); + } +} + +#if !USE_CLIB +extern char *convert_int_to_string (char *string,int i); +extern char *convert_real_to_string (char *string,double *r_p); +#endif + +void file_write_int (int i,struct file *f) +{ + if (is_special_file (f)){ + if (f==file_table){ + ew_print_int (i); + + 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_int (i); + return; + } else { + IO_error ("fwritei: can't open this file"); + return; + } + } + + if (! (f->file_mode & ((1<<F_WRITE_TEXT)|(1<<F_WRITE_DATA)|(1<<F_APPEND_TEXT)|(1<<F_APPEND_DATA)))) + IO_error ("fwritei: write to an input file"); + + if (f->file_mode & ((1<<F_WRITE_DATA)|(1<<F_APPEND_DATA))){ +#if defined (powerc) + /* work around bug in apple compiler for power macintosh */ + write_char (i>>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<<F_WRITE_TEXT)|(1<<F_WRITE_DATA)|(1<<F_APPEND_TEXT)|(1<<F_APPEND_DATA)))) + IO_error ("fwriter: write to an input file"); + + if (f->file_mode & ((1<<F_WRITE_DATA)|(1<<F_APPEND_DATA))){ +#ifdef powerc + /* work around bug in apple compiler for power macintosh */ + int i1,i2; + + i1=((int*)&r)[0]; + i2=((int*)&r)[1]; + + write_char (i1>>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<<F_WRITE_TEXT)|(1<<F_WRITE_DATA)|(1<<F_APPEND_TEXT)|(1<<F_APPEND_DATA)))) + IO_error ("fwrites: write to an input file"); + +#if OLD_WRITE_STRING + p=s->characters; + end_p=p+s->length; +#else + end_p=p+length; +#endif + + while (p<end_p){ + if (f->file_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<<F_READ_TEXT) | (1<<F_READ_DATA)))) + IO_error ("fend: not allowed for output files"); + + if (f->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<<F_READ_TEXT) | (1<<F_READ_DATA))) + position=f->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<<F_READ_TEXT) | (1<<F_READ_DATA))){ + current_position=f->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<<file_mode)) + IO_error ("sfopen: file already open in another file mode"); + + free_memory (file_name_s); + + return &file_table[existing_fn]; + } + + fn=number_of_files; + if (fn>=MAX_N_FILES){ + for (fn=FIRST_REAL_FILE; fn<MAX_N_FILES; ++fn) + if (file_table[fn].file_mode==0) + break; + + if (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_mode) | (buffer_mask & ~255); + f->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<<F_READ_DATA)){ + int i; + + if ((i=read_char (f))==EOF){ + f->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<<F_READ_TEXT)){ + int c,negative,n_characters; + + n_characters=-1; + ++n_characters; + while ((c=read_char (f))==' ' || c=='\t' || c=='\n' || c=='\r') + ++n_characters; + + negative=0; + if (c=='+'){ + c=read_char (f); + ++n_characters; + } else + if (c=='-'){ + c=read_char (f); + ++n_characters; + negative=1; + } + + if (!is_digit (c)){ + f->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<<F_READ_DATA)){ + int n; + + result=-1; + for (n=0; n<8; ++n){ + int i; + + if ((i=read_char (f))==EOF){ + f->file_error=-1; + result=0; + break; + } + ((char*)r_p)[n]=i; + } + + position+=n; + } else if (f->file_mode & (1<<F_READ_TEXT)){ + int c,dot,digits,result,n,n_characters; + char s[256+1]; + + n_characters=-1; + + n=0; + + ++n_characters; + while ((c=read_char (f))==' ' || c=='\t' || c=='\n' || c=='\r') + ++n_characters; + + if (c=='+'){ + c=read_char (f); + ++n_characters; + } else + if (c=='-'){ + s[n++]=c; + c=read_char (f); + ++n_characters; + } + + 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=read_char (f); + ++n_characters; + } + + result=0; + if (digits) + if (dot==2 || ! (c=='e' || c=='E')) + result=-1; + else { + if (n<256) + s[n++]=c; + c=read_char (f); + ++n_characters; + + if (c=='+'){ + c=read_char (f); + ++n_characters; + } else + if (c=='-'){ + if (n<256) + s[n++]=c; + c=read_char (f); + ++n_characters; + } + + if (is_digit (c)){ + do { + if (n<256) + s[n++]=c; + c=read_char (f); + ++n_characters; + } while (is_digit (c)); + + result=-1; + } + } + + if (n>=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<<F_READ_TEXT))) + IO_error ("sfreadline: read from a data 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 ("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<<F_READ_TEXT) | (1<<F_READ_DATA)))) + IO_error ("sfend: not allowed for output files"); + + if (f->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<<F_READ_TEXT) | (1<<F_READ_DATA))) + position=f->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 (p<end_p){ + if (f->file_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 <Traps.h> +#include <Memory.h> +#include <Files.h> +#include <Errors.h> +#include <Script.h> +#include <Resources.h> +#include <LowMem.h> + +#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; n<application_name_length; ++n) + heap_file_name[1+n]=application_name[n]; + + heap_file_name_length=application_name_length+14; + if (heap_file_name_length>31) + 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 @@ -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 @@ -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 |