Back to index

plt-scheme  4.2.1
AmigaOS.c
Go to the documentation of this file.
00001 
00002 
00003 /******************************************************************
00004 
00005   AmigaOS-spesific routines for GC.
00006   This file is normally included from os_dep.c
00007 
00008 ******************************************************************/
00009 
00010 
00011 #if !defined(GC_AMIGA_DEF) && !defined(GC_AMIGA_SB) && !defined(GC_AMIGA_DS) && !defined(GC_AMIGA_AM)
00012 # include "gc_priv.h"
00013 # include <stdio.h>
00014 # include <signal.h>
00015 # define GC_AMIGA_DEF
00016 # define GC_AMIGA_SB
00017 # define GC_AMIGA_DS
00018 # define GC_AMIGA_AM
00019 #endif
00020 
00021 
00022 #ifdef GC_AMIGA_DEF
00023 
00024 # ifndef __GNUC__
00025 #   include <exec/exec.h>
00026 # endif
00027 # include <proto/exec.h>
00028 # include <proto/dos.h>
00029 # include <dos/dosextens.h>
00030 # include <workbench/startup.h>
00031 
00032 #endif
00033 
00034 
00035 
00036 
00037 #ifdef GC_AMIGA_SB
00038 
00039 /******************************************************************
00040    Find the base of the stack.
00041 ******************************************************************/
00042 
00043 ptr_t GC_get_stack_base()
00044 {
00045     struct Process *proc = (struct Process*)SysBase->ThisTask;
00046  
00047     /* Reference: Amiga Guru Book Pages: 42,567,574 */
00048     if (proc->pr_Task.tc_Node.ln_Type==NT_PROCESS
00049         && proc->pr_CLI != NULL) {
00050        /* first ULONG is StackSize */
00051        /*longPtr = proc->pr_ReturnAddr;
00052        size = longPtr[0];*/
00053 
00054        return (char *)proc->pr_ReturnAddr + sizeof(ULONG);
00055     } else {
00056        return (char *)proc->pr_Task.tc_SPUpper;
00057     }
00058 }
00059 
00060 #if 0 /* old version */
00061 ptr_t GC_get_stack_base()
00062 {
00063     extern struct WBStartup *_WBenchMsg;
00064     extern long __base;
00065     extern long __stack;
00066     struct Task *task;
00067     struct Process *proc;
00068     struct CommandLineInterface *cli;
00069     long size;
00070 
00071     if ((task = FindTask(0)) == 0) {
00072        GC_err_puts("Cannot find own task structure\n");
00073        ABORT("task missing");
00074     }
00075     proc = (struct Process *)task;
00076     cli = BADDR(proc->pr_CLI);
00077 
00078     if (_WBenchMsg != 0 || cli == 0) {
00079        size = (char *)task->tc_SPUpper - (char *)task->tc_SPLower;
00080     } else {
00081        size = cli->cli_DefaultStack * 4;
00082     }
00083     return (ptr_t)(__base + GC_max(size, __stack));
00084 }
00085 #endif
00086 
00087 
00088 #endif
00089 
00090 
00091 #ifdef GC_AMIGA_DS
00092 /******************************************************************
00093    Register data segments.
00094 ******************************************************************/
00095 
00096    void GC_register_data_segments()
00097    {
00098      struct Process  *proc;
00099      struct CommandLineInterface *cli;
00100      BPTR myseglist;
00101      ULONG *data;
00102  
00103      int      num;
00104 
00105 
00106 #    ifdef __GNUC__
00107         ULONG dataSegSize;
00108         GC_bool found_segment = FALSE;
00109        extern char __data_size[];
00110 
00111        dataSegSize=__data_size+8;
00112        /* Can`t find the Location of __data_size, because
00113            it`s possible that is it, inside the segment. */
00114 
00115 #     endif
00116 
00117        proc= (struct Process*)SysBase->ThisTask;
00118 
00119        /* Reference: Amiga Guru Book Pages: 538ff,565,573
00120                    and XOper.asm */
00121        if (proc->pr_Task.tc_Node.ln_Type==NT_PROCESS) {
00122          if (proc->pr_CLI == NULL) {
00123            myseglist = proc->pr_SegList;
00124          } else {
00125            /* ProcLoaded    'Loaded as a command: '*/
00126            cli = BADDR(proc->pr_CLI);
00127            myseglist = cli->cli_Module;
00128          }
00129        } else {
00130          ABORT("Not a Process.");
00131        }
00132 
00133        if (myseglist == NULL) {
00134            ABORT("Arrrgh.. can't find segments, aborting");
00135        }
00136 
00137        /* xoper hunks Shell Process */
00138 
00139        num=0;
00140         for (data = (ULONG *)BADDR(myseglist); data != NULL;
00141              data = (ULONG *)BADDR(data[0])) {
00142          if (((ULONG) GC_register_data_segments < (ULONG) &data[1]) ||
00143              ((ULONG) GC_register_data_segments > (ULONG) &data[1] + data[-1])) {
00144 #             ifdef __GNUC__
00145               if (dataSegSize == data[-1]) {
00146                 found_segment = TRUE;
00147               }
00148 #            endif
00149              GC_add_roots_inner((char *)&data[1],
00150                              ((char *)&data[1]) + data[-1], FALSE);
00151           }
00152           ++num;
00153         } /* for */
00154 #      ifdef __GNUC__
00155           if (!found_segment) {
00156             ABORT("Can`t find correct Segments.\nSolution: Use an newer version of ixemul.library");
00157           }
00158 #      endif
00159   }
00160 
00161 #if 0 /* old version */
00162   void GC_register_data_segments()
00163   {
00164     extern struct WBStartup *_WBenchMsg;
00165     struct Process   *proc;
00166     struct CommandLineInterface *cli;
00167     BPTR myseglist;
00168     ULONG *data;
00169 
00170     if ( _WBenchMsg != 0 ) {
00171        if ((myseglist = _WBenchMsg->sm_Segment) == 0) {
00172            GC_err_puts("No seglist from workbench\n");
00173            return;
00174        }
00175     } else {
00176        if ((proc = (struct Process *)FindTask(0)) == 0) {
00177            GC_err_puts("Cannot find process structure\n");
00178            return;
00179        }
00180        if ((cli = BADDR(proc->pr_CLI)) == 0) {
00181            GC_err_puts("No CLI\n");
00182            return;
00183        }
00184        if ((myseglist = cli->cli_Module) == 0) {
00185            GC_err_puts("No seglist from CLI\n");
00186            return;
00187        }
00188     }
00189 
00190     for (data = (ULONG *)BADDR(myseglist); data != 0;
00191          data = (ULONG *)BADDR(data[0])) {
00192 #        ifdef AMIGA_SKIP_SEG
00193            if (((ULONG) GC_register_data_segments < (ULONG) &data[1]) ||
00194            ((ULONG) GC_register_data_segments > (ULONG) &data[1] + data[-1])) {
00195 #       else
00196           {
00197 #       endif /* AMIGA_SKIP_SEG */
00198           GC_add_roots_inner((char *)&data[1],
00199                           ((char *)&data[1]) + data[-1], FALSE);
00200          }
00201     }
00202   }
00203 #endif /* old version */
00204 
00205 
00206 #endif
00207 
00208 
00209 
00210 #ifdef GC_AMIGA_AM
00211 
00212 #ifndef GC_AMIGA_FASTALLOC
00213 
00214 void *GC_amiga_allocwrapper(size_t size,void *(*AllocFunction)(size_t size2)){
00215        return (*AllocFunction)(size);
00216 }
00217 
00218 void *(*GC_amiga_allocwrapper_do)(size_t size,void *(*AllocFunction)(size_t size2))
00219        =GC_amiga_allocwrapper;
00220 
00221 #else
00222 
00223 
00224 
00225 
00226 void *GC_amiga_allocwrapper_firsttime(size_t size,void *(*AllocFunction)(size_t size2));
00227 
00228 void *(*GC_amiga_allocwrapper_do)(size_t size,void *(*AllocFunction)(size_t size2))
00229        =GC_amiga_allocwrapper_firsttime;
00230 
00231 
00232 /******************************************************************
00233    Amiga-spesific routines to obtain memory, and force GC to give
00234    back fast-mem whenever possible.
00235        These hacks makes gc-programs go many times faster when
00236    the amiga is low on memory, and are therefore strictly necesarry.
00237 
00238    -Kjetil S. Matheussen, 2000.
00239 ******************************************************************/
00240 
00241 
00242 
00243 /* List-header for all allocated memory. */
00244 
00245 struct GC_Amiga_AllocedMemoryHeader{
00246        ULONG size;
00247        struct GC_Amiga_AllocedMemoryHeader *next;
00248 };
00249 struct GC_Amiga_AllocedMemoryHeader *GC_AMIGAMEM=(struct GC_Amiga_AllocedMemoryHeader *)(int)~(NULL);
00250 
00251 
00252 
00253 /* Type of memory. Once in the execution of a program, this might change to MEMF_ANY|MEMF_CLEAR */
00254 
00255 ULONG GC_AMIGA_MEMF = MEMF_FAST | MEMF_CLEAR;
00256 
00257 
00258 /* Prevents GC_amiga_get_mem from allocating memory if this one is TRUE. */
00259 #ifndef GC_AMIGA_ONLYFAST
00260 BOOL GC_amiga_dontalloc=FALSE;
00261 #endif
00262 
00263 #ifdef GC_AMIGA_PRINTSTATS
00264 int succ=0,succ2=0;
00265 int nsucc=0,nsucc2=0;
00266 int nullretries=0;
00267 int numcollects=0;
00268 int chipa=0;
00269 int allochip=0;
00270 int allocfast=0;
00271 int cur0=0;
00272 int cur1=0;
00273 int cur10=0;
00274 int cur50=0;
00275 int cur150=0;
00276 int cur151=0;
00277 int ncur0=0;
00278 int ncur1=0;
00279 int ncur10=0;
00280 int ncur50=0;
00281 int ncur150=0;
00282 int ncur151=0;
00283 #endif
00284 
00285 /* Free everything at program-end. */
00286 
00287 void GC_amiga_free_all_mem(void){
00288        struct GC_Amiga_AllocedMemoryHeader *gc_am=(struct GC_Amiga_AllocedMemoryHeader *)(~(int)(GC_AMIGAMEM));
00289        struct GC_Amiga_AllocedMemoryHeader *temp;
00290 
00291 #ifdef GC_AMIGA_PRINTSTATS
00292        printf("\n\n"
00293               "%d bytes of chip-mem, and %d bytes of fast-mem where allocated from the OS.\n",
00294               allochip,allocfast
00295        );
00296        printf(
00297               "%d bytes of chip-mem were returned from the GC_AMIGA_FASTALLOC supported allocating functions.\n",
00298               chipa
00299        );
00300        printf("\n");
00301        printf("GC_gcollect was called %d times to avoid returning NULL or start allocating with the MEMF_ANY flag.\n",numcollects);
00302        printf("%d of them was a success. (the others had to use allocation from the OS.)\n",nullretries);
00303        printf("\n");
00304        printf("Succeded forcing %d gc-allocations (%d bytes) of chip-mem to be fast-mem.\n",succ,succ2);
00305        printf("Failed forcing %d gc-allocations (%d bytes) of chip-mem to be fast-mem.\n",nsucc,nsucc2);
00306        printf("\n");
00307        printf(
00308               "Number of retries before succeding a chip->fast force:\n"
00309               "0: %d, 1: %d, 2-9: %d, 10-49: %d, 50-149: %d, >150: %d\n",
00310               cur0,cur1,cur10,cur50,cur150,cur151
00311        );
00312        printf(
00313               "Number of retries before giving up a chip->fast force:\n"
00314               "0: %d, 1: %d, 2-9: %d, 10-49: %d, 50-149: %d, >150: %d\n",
00315               ncur0,ncur1,ncur10,ncur50,ncur150,ncur151
00316        );
00317 #endif
00318 
00319        while(gc_am!=NULL){
00320               temp=gc_am->next;
00321               FreeMem(gc_am,gc_am->size);
00322               gc_am=(struct GC_Amiga_AllocedMemoryHeader *)(~(int)(temp));
00323        }
00324 }
00325 
00326 #ifndef GC_AMIGA_ONLYFAST
00327 
00328 /* All memory with address lower than this one is chip-mem. */
00329 
00330 char *chipmax;
00331 
00332 
00333 /*
00334  * Allways set to the last size of memory tried to be allocated.
00335  * Needed to ensure allocation when the size is bigger than 100000.
00336  *
00337  */
00338 size_t latestsize;
00339 
00340 #endif
00341 
00342 
00343 /*
00344  * The actual function that is called with the GET_MEM macro.
00345  *
00346  */
00347 
00348 void *GC_amiga_get_mem(size_t size){
00349        struct GC_Amiga_AllocedMemoryHeader *gc_am;
00350 
00351 #ifndef GC_AMIGA_ONLYFAST
00352        if(GC_amiga_dontalloc==TRUE){
00353 //            printf("rejected, size: %d, latestsize: %d\n",size,latestsize);
00354               return NULL;
00355        }
00356 
00357        // We really don't want to use chip-mem, but if we must, then as little as possible.
00358        if(GC_AMIGA_MEMF==(MEMF_ANY|MEMF_CLEAR) && size>100000 && latestsize<50000) return NULL;
00359 #endif
00360 
00361        gc_am=AllocMem((ULONG)(size + sizeof(struct GC_Amiga_AllocedMemoryHeader)),GC_AMIGA_MEMF);
00362        if(gc_am==NULL) return NULL;
00363 
00364        gc_am->next=GC_AMIGAMEM;
00365        gc_am->size=size + sizeof(struct GC_Amiga_AllocedMemoryHeader);
00366        GC_AMIGAMEM=(struct GC_Amiga_AllocedMemoryHeader *)(~(int)(gc_am));
00367 
00368 //     printf("Allocated %d (%d) bytes at address: %x. Latest: %d\n",size,tot,gc_am,latestsize);
00369 
00370 #ifdef GC_AMIGA_PRINTSTATS
00371        if((char *)gc_am<chipmax){
00372               allochip+=size;
00373        }else{
00374               allocfast+=size;
00375        }
00376 #endif
00377 
00378        return gc_am+1;
00379 
00380 }
00381 
00382 
00383 
00384 
00385 #ifndef GC_AMIGA_ONLYFAST
00386 
00387 /* Tries very hard to force GC to find fast-mem to return. Done recursively
00388  * to hold the rejected memory-pointers reachable from the collector in an
00389  * easy way.
00390  *
00391  */
00392 #ifdef GC_AMIGA_RETRY
00393 void *GC_amiga_rec_alloc(size_t size,void *(*AllocFunction)(size_t size2),const int rec){
00394        void *ret;
00395 
00396        ret=(*AllocFunction)(size);
00397 
00398 #ifdef GC_AMIGA_PRINTSTATS
00399        if((char *)ret>chipmax || ret==NULL){
00400               if(ret==NULL){
00401                      nsucc++;
00402                      nsucc2+=size;
00403                      if(rec==0) ncur0++;
00404                      if(rec==1) ncur1++;
00405                      if(rec>1 && rec<10) ncur10++;
00406                      if(rec>=10 && rec<50) ncur50++;
00407                      if(rec>=50 && rec<150) ncur150++;
00408                      if(rec>=150) ncur151++;
00409               }else{
00410                      succ++;
00411                      succ2+=size;
00412                      if(rec==0) cur0++;
00413                      if(rec==1) cur1++;
00414                      if(rec>1 && rec<10) cur10++;
00415                      if(rec>=10 && rec<50) cur50++;
00416                      if(rec>=50 && rec<150) cur150++;
00417                      if(rec>=150) cur151++;
00418               }
00419        }
00420 #endif
00421 
00422        if (((char *)ret)<=chipmax && ret!=NULL && (rec<(size>500000?9:size/5000))){
00423               ret=GC_amiga_rec_alloc(size,AllocFunction,rec+1);
00424 //            GC_free(ret2);
00425        }
00426 
00427        return ret;
00428 }
00429 #endif
00430 
00431 
00432 /* The allocating-functions defined inside the amiga-blocks in gc.h is called
00433  * via these functions.
00434  */
00435 
00436 
00437 void *GC_amiga_allocwrapper_any(size_t size,void *(*AllocFunction)(size_t size2)){
00438        void *ret,*ret2;
00439 
00440        GC_amiga_dontalloc=TRUE;    // Pretty tough thing to do, but its indeed necesarry.
00441        latestsize=size;
00442 
00443        ret=(*AllocFunction)(size);
00444 
00445        if(((char *)ret) <= chipmax){
00446               if(ret==NULL){
00447                      //Give GC access to allocate memory.
00448 #ifdef GC_AMIGA_GC
00449                      if(!GC_dont_gc){
00450                             GC_gcollect();
00451 #ifdef GC_AMIGA_PRINTSTATS
00452                             numcollects++;
00453 #endif
00454                             ret=(*AllocFunction)(size);
00455                      }
00456 #endif
00457                      if(ret==NULL){
00458                             GC_amiga_dontalloc=FALSE;
00459                             ret=(*AllocFunction)(size);
00460                             if(ret==NULL){
00461                                    WARN("Out of Memory!  Returning NIL!\n", 0);
00462                             }
00463                      }
00464 #ifdef GC_AMIGA_PRINTSTATS
00465                      else{
00466                             nullretries++;
00467                      }
00468                      if(ret!=NULL && (char *)ret<=chipmax) chipa+=size;
00469 #endif
00470               }
00471 #ifdef GC_AMIGA_RETRY
00472               else{
00473                      /* We got chip-mem. Better try again and again and again etc., we might get fast-mem sooner or later... */
00474                      /* Using gctest to check the effectiviness of doing this, does seldom give a very good result. */
00475                      /* However, real programs doesn't normally rapidly allocate and deallocate. */
00476 //                   printf("trying to force... %d bytes... ",size);
00477                      if(
00478                             AllocFunction!=GC_malloc_uncollectable
00479 #ifdef ATOMIC_UNCOLLECTABLE
00480                             && AllocFunction!=GC_malloc_atomic_uncollectable
00481 #endif
00482                      ){
00483                             ret2=GC_amiga_rec_alloc(size,AllocFunction,0);
00484                      }else{
00485                             ret2=(*AllocFunction)(size);
00486 #ifdef GC_AMIGA_PRINTSTATS
00487                             if((char *)ret2<chipmax || ret2==NULL){
00488                                    nsucc++;
00489                                    nsucc2+=size;
00490                                    ncur0++;
00491                             }else{
00492                                    succ++;
00493                                    succ2+=size;
00494                                    cur0++;
00495                             }
00496 #endif
00497                      }
00498                      if(((char *)ret2)>chipmax){
00499 //                          printf("Succeeded.\n");
00500                             GC_free(ret);
00501                             ret=ret2;
00502                      }else{
00503                             GC_free(ret2);
00504 //                          printf("But did not succeed.\n");
00505                      }
00506               }
00507 #endif
00508        }
00509 
00510        GC_amiga_dontalloc=FALSE;
00511 
00512        return ret;
00513 }
00514 
00515 
00516 
00517 void (*GC_amiga_toany)(void)=NULL;
00518 
00519 void GC_amiga_set_toany(void (*func)(void)){
00520        GC_amiga_toany=func;
00521 }
00522 
00523 #endif // !GC_AMIGA_ONLYFAST
00524 
00525 
00526 void *GC_amiga_allocwrapper_fast(size_t size,void *(*AllocFunction)(size_t size2)){
00527        void *ret;
00528 
00529        ret=(*AllocFunction)(size);
00530 
00531        if(ret==NULL){
00532               // Enable chip-mem allocation.
00533 //            printf("ret==NULL\n");
00534 #ifdef GC_AMIGA_GC
00535               if(!GC_dont_gc){
00536                      GC_gcollect();
00537 #ifdef GC_AMIGA_PRINTSTATS
00538                      numcollects++;
00539 #endif
00540                      ret=(*AllocFunction)(size);
00541               }
00542 #endif
00543               if(ret==NULL){
00544 #ifndef GC_AMIGA_ONLYFAST
00545                      GC_AMIGA_MEMF=MEMF_ANY | MEMF_CLEAR;
00546                      if(GC_amiga_toany!=NULL) (*GC_amiga_toany)();
00547                      GC_amiga_allocwrapper_do=GC_amiga_allocwrapper_any;
00548                      return GC_amiga_allocwrapper_any(size,AllocFunction);
00549 #endif
00550               }
00551 #ifdef GC_AMIGA_PRINTSTATS
00552               else{
00553                      nullretries++;
00554               }
00555 #endif
00556        }
00557 
00558        return ret;
00559 }
00560 
00561 void *GC_amiga_allocwrapper_firsttime(size_t size,void *(*AllocFunction)(size_t size2)){
00562        atexit(&GC_amiga_free_all_mem);
00563        chipmax=(char *)SysBase->MaxLocMem;              // For people still having SysBase in chip-mem, this might speed up a bit.
00564        GC_amiga_allocwrapper_do=GC_amiga_allocwrapper_fast;
00565        return GC_amiga_allocwrapper_fast(size,AllocFunction);
00566 }
00567 
00568 
00569 #endif //GC_AMIGA_FASTALLOC
00570 
00571 
00572 
00573 /*
00574  * The wrapped realloc function.
00575  *
00576  */
00577 void *GC_amiga_realloc(void *old_object,size_t new_size_in_bytes){
00578 #ifndef GC_AMIGA_FASTALLOC
00579        return GC_realloc(old_object,new_size_in_bytes);
00580 #else
00581        void *ret;
00582        latestsize=new_size_in_bytes;
00583        ret=GC_realloc(old_object,new_size_in_bytes);
00584        if(ret==NULL && GC_AMIGA_MEMF==(MEMF_FAST | MEMF_CLEAR)){
00585               /* Out of fast-mem. */
00586 #ifdef GC_AMIGA_GC
00587               if(!GC_dont_gc){
00588                      GC_gcollect();
00589 #ifdef GC_AMIGA_PRINTSTATS
00590                      numcollects++;
00591 #endif
00592                      ret=GC_realloc(old_object,new_size_in_bytes);
00593               }
00594 #endif
00595               if(ret==NULL){
00596 #ifndef GC_AMIGA_ONLYFAST
00597                      GC_AMIGA_MEMF=MEMF_ANY | MEMF_CLEAR;
00598                      if(GC_amiga_toany!=NULL) (*GC_amiga_toany)();
00599                      GC_amiga_allocwrapper_do=GC_amiga_allocwrapper_any;
00600                      ret=GC_realloc(old_object,new_size_in_bytes);
00601 #endif
00602               }
00603 #ifdef GC_AMIGA_PRINTSTATS
00604               else{
00605                      nullretries++;
00606               }
00607 #endif
00608        }
00609        if(ret==NULL){
00610               WARN("Out of Memory!  Returning NIL!\n", 0);
00611        }
00612 #ifdef GC_AMIGA_PRINTSTATS
00613        if(((char *)ret)<chipmax && ret!=NULL){
00614               chipa+=new_size_in_bytes;
00615        }
00616 #endif
00617        return ret;
00618 #endif
00619 }
00620 
00621 #endif //GC_AMIGA_AM
00622 
00623