Annotation of gforth/engine/support.c, revision 1.3

1.1       anton       1: /* Gforth support functions
                      2: 
1.3     ! pazsan      3:   Copyright (C) 1995-2003 Free Software Foundation, Inc.
1.1       anton       4: 
                      5:   This file is part of Gforth.
                      6: 
                      7:   Gforth is free software; you can redistribute it and/or
                      8:   modify it under the terms of the GNU General Public License
                      9:   as published by the Free Software Foundation; either version 2
                     10:   of the License, or (at your option) any later version.
                     11: 
                     12:   This program is distributed in the hope that it will be useful,
                     13:   but WITHOUT ANY WARRANTY; without even the implied warranty of
                     14:   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     15:   GNU General Public License for more details.
                     16: 
                     17:   You should have received a copy of the GNU General Public License
                     18:   along with this program; if not, write to the Free Software
                     19:   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA.
                     20: */
                     21: 
                     22: #include "config.h"
                     23: #include "forth.h"
                     24: #include <stdlib.h>
                     25: #include <string.h>
                     26: #include <sys/time.h>
                     27: #include <unistd.h>
                     28: #include <pwd.h>
                     29: #include <dirent.h>
1.2       anton      30: #include <math.h>
1.1       anton      31: 
                     32: #ifdef HAS_FILE
                     33: char *cstr(Char *from, UCell size, int clear)
                     34: /* return a C-string corresponding to the Forth string ( FROM SIZE ).
                     35:    the C-string lives until the next call of cstr with CLEAR being true */
                     36: {
                     37:   static struct cstr_buffer {
                     38:     char *buffer;
                     39:     size_t size;
                     40:   } *buffers=NULL;
                     41:   static int nbuffers=0;
                     42:   static int used=0;
                     43:   struct cstr_buffer *b;
                     44: 
                     45:   if (buffers==NULL)
                     46:     buffers=malloc(0);
                     47:   if (clear)
                     48:     used=0;
                     49:   if (used>=nbuffers) {
                     50:     buffers=realloc(buffers,sizeof(struct cstr_buffer)*(used+1));
                     51:     buffers[used]=(struct cstr_buffer){malloc(0),0};
                     52:     nbuffers=used+1;
                     53:   }
                     54:   b=&buffers[used];
                     55:   if (size+1 > b->size) {
                     56:     b->buffer = realloc(b->buffer,size+1);
                     57:     b->size = size+1;
                     58:   }
                     59:   memcpy(b->buffer,from,size);
                     60:   b->buffer[size]='\0';
                     61:   used++;
                     62:   return b->buffer;
                     63: }
                     64: 
                     65: char *tilde_cstr(Char *from, UCell size, int clear)
                     66: /* like cstr(), but perform tilde expansion on the string */
                     67: {
                     68:   char *s1,*s2;
                     69:   int s1_len, s2_len;
                     70:   struct passwd *getpwnam (), *user_entry;
                     71: 
                     72:   if (size<1 || from[0]!='~')
                     73:     return cstr(from, size, clear);
                     74:   if (size<2 || from[1]=='/') {
                     75:     s1 = (char *)getenv ("HOME");
                     76:     if(s1 == NULL)
                     77:       s1 = "";
                     78:     s2 = from+1;
                     79:     s2_len = size-1;
                     80:   } else {
                     81:     UCell i;
                     82:     for (i=1; i<size && from[i]!='/'; i++)
                     83:       ;
                     84:     if (i==2 && from[1]=='+') /* deal with "~+", i.e., the wd */
                     85:       return cstr(from+3, size<3?0:size-3,clear);
                     86:     {
                     87:       char user[i];
                     88:       memcpy(user,from+1,i-1);
                     89:       user[i-1]='\0';
                     90:       user_entry=getpwnam(user);
                     91:     }
                     92:     if (user_entry==NULL)
                     93:       return cstr(from, size, clear);
                     94:     s1 = user_entry->pw_dir;
                     95:     s2 = from+i;
                     96:     s2_len = size-i;
                     97:   }
                     98:   s1_len = strlen(s1);
                     99:   if (s1_len>1 && s1[s1_len-1]=='/')
                    100:     s1_len--;
                    101:   {
                    102:     char path[s1_len+s2_len];
                    103:     memcpy(path,s1,s1_len);
                    104:     memcpy(path+s1_len,s2,s2_len);
                    105:     return cstr(path,s1_len+s2_len,clear);
                    106:   }
                    107: }
                    108: #endif
                    109: 
                    110: DCell timeval2us(struct timeval *tvp)
                    111: {
                    112: #ifndef BUGGY_LONG_LONG
                    113:   return (tvp->tv_sec*(DCell)1000000)+tvp->tv_usec;
                    114: #else
                    115:   DCell d2;
                    116:   DCell d1=mmul(tvp->tv_sec,1000000);
                    117:   d2.lo = d1.lo+tvp->tv_usec;
                    118:   d2.hi = d1.hi + (d2.lo<d1.lo);
                    119:   return d2;
                    120: #endif
                    121: }
                    122: 
                    123: Xt *primtable(Label symbols[], Cell size)
                    124:      /* used in primitive primtable for peephole optimization */
                    125: {
                    126:   Xt *xts = (Xt *)malloc(size*sizeof(Xt));
                    127:   Cell i;
                    128: 
                    129:   for (i=0; i<size; i++)
                    130:     xts[i] = &symbols[i];
                    131:   return xts;
1.2       anton     132: }
                    133: 
                    134: DCell double2ll(Float r)
                    135: {
                    136: #ifndef BUGGY_LONG_LONG
                    137:   return (DCell)(r);
                    138: #else
                    139:   double ldexp(double x, int exp);
                    140:   DCell d;
                    141:   if (r<0) {
                    142:     d.hi = ldexp(-r,-(int)(CELL_BITS));
                    143:     d.lo = (-r)-ldexp((Float)d.hi,CELL_BITS);
                    144:     return dnegate(d);
                    145:   }
                    146:   d.hi = ldexp(r,-(int)(CELL_BITS));
                    147:   d.lo = r-ldexp((Float)d.hi,CELL_BITS);
                    148:   return d;
                    149: #endif
1.1       anton     150: }

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>