home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / glisp / glisp.000 / GLISP.UNIX.TAR / closunix / closnode.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-04-03  |  10.0 KB  |  448 lines
  1. /*                 GRAPHIC LISP            */
  2. /*        Scritto nel 1991-94 da Zoia Andrea Michele     */
  3. /*        Via Pergola #1 Tirano (SO) Tel. 0342-704210    */
  4. /* file closnode.c */
  5.  
  6. /* #define CLOSNODE_DEBUG */
  7.  
  8. #include "clos.h"
  9.  
  10. /* definizioni interne */
  11. #define    BYTES_IN_PAGE    60000L        /* al max 30 Mega di memoria */
  12. #define MAX_PAGES    500        /* se ne serve di più(!!) basta aumentare questo valore */
  13. #define NULLHND         Q(NULL)  /* P(NULLHND)==NULL */
  14.  
  15. /* variabili interne */
  16. node        lastalloc_node;    /* punta all' ultimo nodo allocato */
  17. node        lastlock_node;  /* punta all'ultimo nodo LOCK */
  18.  
  19. BOOL        GCInProgress;
  20. node_s          **pages_array;                /* array di pagine di memoria */
  21. unsigned int    total_pages=0;            /* pagine totali */
  22. lsiz_t        TotalNodes;            /* nodi totali */
  23.  
  24. /* funzioni interne */
  25. void node_marklist();
  26.  
  27.  
  28. int    node_malloc(num)
  29. lsiz_t    num;
  30. {
  31.  unsigned int  nodes_p,bytes_p,num_p,nodes_r,bytes_r,i,j;
  32.  node_s         *np, *prec;
  33.  int           first_flag=TRUE;
  34.  node           free_list;
  35.  
  36.  pages_array=NULL;
  37.  if(num<(lsiz_t)2)
  38.      return error(E_CHEKZ,ERR_MINTERNAL|ERR_TNORM|ERR_PVOID,NULL);
  39.  
  40.  pages_array=malloc(MAX_PAGES*sizeof(node_s*));
  41.  if(pages_array==NULL)return ERROR;
  42.  
  43.  TotalNodes=num;
  44.  nodes_p=(unsigned)(BYTES_IN_PAGE/sizeof(node_s));
  45.  bytes_p=nodes_p*sizeof(node_s);
  46.  
  47.  num_p=total_pages=(unsigned int)(num/(unsigned long int)nodes_p);
  48.  nodes_r=(unsigned int)(num%(unsigned long int)nodes_p);
  49.  bytes_r=nodes_r*sizeof(node_s);
  50.  
  51.  if(bytes_r){
  52.    num_p++;
  53.    total_pages++;
  54.  }
  55.  if(num_p>MAX_PAGES)
  56.     return error(E_PAGES,ERR_MINTERNAL|ERR_TNORM|ERR_PVOID,NULL);
  57.  
  58. #define BYTES_P  ( (!i && bytes_r) ? bytes_r: bytes_p )
  59. #define NODES_P  ( (!i && nodes_r) ? nodes_r: nodes_p )
  60.  
  61.  for(i=0;i<num_p;i++){
  62.     if((np=pages_array[i]=(node_s *)malloc(BYTES_P))==NULL){
  63.         for(j=0;j<i;j++)
  64.           free((void *)pages_array[j]);
  65.         pages_array[0]=NULL;
  66.         /* segnala che non si e' allocata la memoria */
  67.         return ERROR;
  68.     }
  69.     for(j=0;j<NODES_P;j++){
  70.         np->type=NT_NEW_NODE_T;
  71.         if(first_flag){
  72.             prec=np++;
  73.             free_list=(node)prec;
  74.             /* (node_s*)free_list=prec; */
  75.             /* P(free_list)=prec; errore di BCC2.0 BUG DEL COMPILATORE !!*/
  76.             /* P(free_list)=prec=np++; BCC2.0 da errore !?!?!?*/
  77.             first_flag=FALSE;
  78.         }else{
  79.             prec->next=Q(np++);
  80.             prec=P(prec->next);
  81.         }
  82.     }
  83.  }
  84.  prec->next=NULLHND;
  85.  
  86. #undef BYTES_P
  87. #undef NODES_P
  88.  /*
  89.    la free-list si chiude con NULLHND
  90.    e subito si alloca un nodo speciale(VOID)
  91.    in cima ala lista dei nodi
  92.  */
  93.  
  94.  lastalloc_node=VOID=free_list;         /* si assegna lastalloc_node=VOID */
  95.  
  96.  lastlock_node=VOID;            /* si assegna lock-list */
  97.  LOCK(VOID);                /* e lo si marca come bloccato */
  98.  
  99.  return OK;
  100. }
  101.  
  102. void    node_free()
  103. {
  104.  unsigned i;
  105.  if(pages_array){
  106.    /* se non si e' gia' disallocato */
  107.    for(i=0;i<total_pages;i++)
  108.      free((void *)pages_array[i]);
  109.    free(pages_array);
  110.  }
  111.  pages_array=NULL;
  112. }
  113.  
  114.  
  115. #ifdef __NOINLINE__
  116. /****************** funzioni definite INLINE in clos.h ****************/
  117. node    node_make()
  118. {
  119.  /* alloca un nodo recuperandolo dopo lastalloc_node*/
  120.  
  121.  if(!P(NEXT(lastalloc_node))){
  122.    node_gc();
  123.    if(!P(NEXT(lastalloc_node))){
  124.      error(E_NOMEMNODES,ERR_MERROR|ERR_PVOID|ERR_TCRIT,NULL);
  125.    }
  126.  }
  127.  
  128.  /*si blocca lastalloc_node e lo si mette nella lock-list*/
  129.  lastalloc_node=NEXT(lastalloc_node);
  130.  LOCK(lastalloc_node);
  131.  NEXTLOCK(lastlock_node)=lastalloc_node;
  132.  lastlock_node=lastalloc_node;
  133.  
  134.  return lastalloc_node;
  135. }
  136.  
  137. /********************** INLINE ********************/
  138. node node_getlastlock()
  139. /*  da chiamare prima di una funzione utente*/
  140. {
  141.  return lastlock_node;
  142. }
  143.  
  144. /*********************** INLINE ********************/
  145. node node_lock(n)
  146. node n;
  147. {
  148. /* blocca il nodo n e tutta la sua sottolista */
  149.  FIX(n);
  150.  if(IS_LOCK(n))return n;
  151.  LOCK(n);
  152.  NEXTLOCK(lastlock_node)=n;
  153.  return lastlock_node=n;
  154. }
  155. /*********************************************/
  156. #endif
  157.  
  158. node    node_alloc(s)
  159. char *s;
  160. {
  161.  /* ritorna un nodo di nome *s se esiste altrimenti lo alloca */
  162.  /* da non chiamare con s=NULL */
  163.  node    tmp;
  164.  hash_t h;
  165.  if( (tmp=hash_search(s,&h))==VOID ){
  166.     /* il nodo non e' mai stato allocato */
  167.     /* e node_make lo mette nella lock-list */
  168.     tmp=node_make();
  169.     NAME(tmp)=string_put(s,tmp);
  170.     HASH(tmp)=h;
  171.     TYPE(tmp)|=NT_HAS_NAME+NT_IS_NAME;
  172.     hash_put(tmp,h);
  173.     return tmp;
  174.  }
  175.  /* il nodo era gia' stato allocato */
  176.  /* se non e' nella lock-list ce lo si mette */
  177.  if(!IS_LOCK(tmp)){
  178.    LOCK(tmp);
  179.    NEXTLOCK(lastlock_node)=tmp;
  180.    lastlock_node=tmp;
  181.  }
  182.  return tmp;
  183. }
  184.  
  185.  
  186. node node_lockreset()
  187. /* distrugge la lock-list */
  188. /* e' usata solo per entrare nel main-loop */
  189. {
  190.  node punt;
  191.  
  192.  NEXTLOCK(lastlock_node)=NULLHND;
  193.  punt=NEXTLOCK(VOID);
  194.  while(P(punt)){
  195.    /* if(!IS_LOCK(punt))printf ("ERR\n"); */
  196.    UNLOCK(punt);
  197.    UNFIX(punt);
  198.    punt=NEXTLOCK(punt);
  199.  }
  200.  return lastlock_node=VOID;
  201. }
  202. void node_signal(lastlock)
  203. node lastlock;
  204. {
  205.  /* da chiamare alla fine di una funzione utente */
  206.  /* accorcia la lock-list */
  207.  NEXTLOCK(lastlock_node)=NULLHND;
  208.  lastlock_node=lastlock;
  209.  while(P(lastlock=NEXTLOCK(lastlock)))
  210.    TYPE(lastlock)&=(~(NT_IS_LOCK+NT_IS_FIX));
  211. }
  212.  
  213. void node_gc()
  214. {
  215.  static node   punt;
  216.  static node   prec_used;
  217.  static node   prec_free;
  218.  static node   free_list;
  219.  static n_type punt_type;
  220.  static node_s pfns;
  221.  
  222.  GCInProgress=TRUE;
  223.  
  224.  /* mark-phase */
  225.  if(config.gcbeep)cl_beep(500);
  226.  
  227.  /* 1) marca tutti i nodi globali */
  228.  free_list=NEXT(lastalloc_node);
  229.  NEXT(lastalloc_node)=NULLHND;
  230.  /* l'istruzione sopra stacca tutti i nodi ancora liberi */
  231.  /* per cui l'inizio della lista va salvato in free_list */
  232.  /* free_list non e' vuota solo se si invoca il gc direttamente da */
  233.  /* programma o da linea di comando */
  234.  punt=VOID;
  235.  while(P(punt=NEXT(punt)))
  236.    if(IS_NAME(punt))
  237.      if(HAS_NAME(punt))
  238.        if(HAS_SOMETHING(punt))
  239.      node_marklist(punt);
  240.  
  241.  /* 2) marca tutti i nodi FIX nella lock-list */
  242.  /* OPT 2: Quando si scorre tutta la lista dei nodi nel pezzo sopra */
  243.  /* basta controllare che si trovi un nodo FIX e recuperarlo */
  244.  /* senza scandire tutta la lock-list */
  245.  /* Pero' aggiungere un test sopra e' generalmente piu' pesante che scandire tutta*/
  246.  /* la lock-list. */
  247.  
  248.  NEXTLOCK(lastlock_node)=NULLHND;
  249.  punt=VOID;
  250.  while(P(punt=NEXTLOCK(punt)))
  251.    if(IS_FIX(punt))
  252.      node_marklist(punt);
  253.  
  254.  /* 3) marca tutti i nodi nella lock-list */
  255.  /* OPT 1:SI PUO' FAR RECUPERARE AL GC TUTTI I NODI LOCK OLTRE A QUELLI MARK */
  256.  
  257.  
  258.  /* sweep phase */
  259.  /* recupera tutti i nodi MARK */
  260.  /* e azzera il flag MARK */
  261.  if(config.gcbeep)cl_beep(250);
  262.  
  263.  punt=NEXT(VOID); /* salta VOID */
  264.  prec_used=VOID;
  265.  prec_free=Q(&pfns);
  266.  while(P(punt)){
  267.     /* scandisce tutta la lista dei nodi allocati         */
  268.     /* (e anche liberi se gc la si chiama dalla riga di comando) */
  269.     punt_type=TYPE(punt);
  270.     if(punt_type& (NT_IS_MARK+NT_IS_LOCK)){
  271.     /* salva solo i nodi che sono MARK e/o LOCK VEDI OPT 1*/
  272.     UNMARK(punt);
  273.     NEXT(prec_used)=punt;
  274.     prec_used=punt;
  275.     punt=NEXT(punt);
  276.     continue;
  277.     }
  278.     switch(punt_type&NT_IS_MASK){
  279.     case NT_IS_NAME:
  280.         if(punt_type&NT_HAS_NAME){
  281.         hash_del(HASH(punt));
  282.         string_del(NAME(punt));
  283.         }
  284.         break;
  285.     case NT_IS_VALUE:
  286.         if((punt_type&NT_MASK)==NT_STRING)
  287.         string_del(STRING(punt));
  288.         break;
  289.     }
  290.     TYPE(punt)=NT_NEW_NODE_T;
  291.     NEXT(prec_free)=punt;
  292.     prec_free=punt;
  293.     punt=NEXT(punt);
  294.  }
  295.  /* prec_used punta all' ultimo nodo allocato             */
  296.  /* prec_free punta all' ultimo nodo liberato dal GC        */
  297.  /* free_list punta al   primo  nodo libero non passato dal GC     */
  298.  /* VOID      punta al   primo  nodo allocato             */
  299.  /* pfns contiene il puntatore al primo nodo liberato dal GC     */
  300.  
  301.  /* se non si trovano nodi liberi prec_free=pfns */
  302.  /* e se free_list e' vuota allora pfns->NULL */
  303.  NEXT(prec_free)=free_list;
  304.  /* prec used e' al limite uguale a VOID */
  305.  NEXT(lastalloc_node=prec_used)=NEXT(Q(&pfns));
  306.  
  307.  
  308.  if(config.gcbeep)cl_beep(0);
  309.  GCInProgress=FALSE;
  310. #ifdef _Windows
  311.    SendMessage(hResourceWindow,WM_TIMER,1,0);
  312. #endif
  313. }
  314.  
  315.  
  316. void node_marklist(list)
  317. node list;
  318. {
  319.  if(IS_MARK(list)){return;}
  320.  MARK(list);
  321.  switch(GET_NTYPE(list)){
  322.     case NT_IS_CONS:
  323.     node_marklist(CONSLEFT(list));
  324.     node_marklist(CONSRIGHT(list));
  325.     return;
  326.     case NT_IS_VALUE:
  327.     switch(GET_VTYPE(list)){
  328.         case NT_CNAME:
  329.         node_marklist(CNAME(list));
  330.         return;
  331.         case NT_ENAME:
  332.         node_marklist(ENAME(list));
  333.         return;
  334.         case NT_METHOD:
  335.         node_marklist(METHOD(list));
  336.         return;
  337.         case NT_CLASS:
  338.         node_marklist(CLASS_INSTANCE(list));
  339.         return;
  340.         case NT_UFUNC:
  341.         case NT_MACRO:
  342.         node_marklist(UFUNC_TYPE(list));
  343.         node_marklist(UFUNC_PAR(list));
  344.         node_marklist(UFUNC_ENV(list));
  345.         node_marklist(UFUNC_SEX(list));
  346.         node_marklist(UFUNC_KEY(list));
  347.         node_marklist(UFUNC_AUX(list));
  348.         node_marklist(UFUNC_OPT(list));
  349.         node_marklist(UFUNC_REST(list));
  350.         return;
  351.     }
  352.     return;
  353.     case NT_IS_NAME:
  354.     if(HAS_VALUE(list)||HAS_BIND(list)) node_marklist(VALUE(list));
  355.     if(HAS_FUNCTION(list)) node_marklist(FUNCTION(list));
  356.     if(HAS_PLIST(list))    node_marklist(PLIST(list));
  357.     if(HAS_CLASS(list))    node_marklist(CLASS(list));
  358.     return;
  359.  }
  360.  error(E_NULLGC,ERR_MINTERNAL|ERR_TNORM|ERR_PVOID,NULL);
  361. }
  362.  
  363.  
  364.  
  365.  
  366.  
  367. node    node_scan()
  368. {
  369.  /* genera una lista di tutti i nomi che contengono qualcosa */
  370.  /* e' usata da objlist */
  371.  
  372.  node punt=NEXT(VOID); /* salta VOID */
  373.  node n=NIL;
  374.  node c;
  375.  while(P(punt)){
  376.     if(IS_NAME(punt) && HAS_NAME(punt) && HAS_SOMETHING(punt)){
  377.         c=node_make();
  378.         TYPE(c)|=NT_IS_CONS;
  379.         CONSLEFT(c)=punt;
  380.         CONSRIGHT(c)=n;
  381.         n=c;
  382.     }
  383.     punt=NEXT(punt);
  384.  }
  385.  return n;
  386. }
  387.  
  388. node    node_scan_fix()
  389. {
  390.  /* genera una lista di tutti i nodi FIX */
  391.  /* e' usata da fixlist */
  392.  
  393.  node punt=NEXT(VOID); /* salta VOID */
  394.  node n=NIL;
  395.  node c;
  396.  while(P(punt)){
  397.     if(IS_FIX(punt)){
  398.         c=node_make();
  399.         TYPE(c)|=NT_IS_CONS;
  400.         CONSLEFT(c)=punt;
  401.         CONSRIGHT(c)=n;
  402.         n=c;
  403.     }
  404.     punt=NEXT(punt);
  405.  }
  406.  return n;
  407. }
  408.  
  409.  
  410.  
  411.  
  412.  
  413.  
  414.  
  415.  
  416.  
  417.  
  418. void node_count(used,free)
  419. lsiz_t *used;
  420. lsiz_t *free;
  421. {
  422.  node n;
  423.  
  424.  *used=1;
  425.  n=VOID;
  426.  while(n!=lastalloc_node){
  427.    (*used)++;
  428.    n=NEXT(n);
  429.  }
  430.  *free=0;
  431.   n=NEXT(lastalloc_node);
  432.   while(P(n)){
  433.    (*free)++;
  434.    n=NEXT(n);
  435.  }
  436.  if((*used)+(*free) != TotalNodes)
  437.    error(E_BADNCCOUNT,ERR_MINTERNAL|ERR_TNORM|ERR_PVOID,NULL);
  438. }
  439.  
  440.  
  441. void node_criticalgc()
  442. {
  443.  if(GCInProgress){
  444.    GCInProgress=FALSE;
  445.    lisp_print_string("Stack overflow durante un GC\nUscire dall'interprete\n",stdout);
  446.  }
  447. }
  448.