Return to support.c CVS log

Up to [gforth] / gforth / engine

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

1.1     ! anton       1: /* Gforth support functions
        !             2: 
        !             3:   Copyright (C) 1995,1996,1997,1998,2000 Free Software Foundation, Inc.
        !             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>
        !            30: 
        !            31: #ifdef HAS_FILE
        !            32: char *cstr(Char *from, UCell size, int clear)
        !            33: /* return a C-string corresponding to the Forth string ( FROM SIZE ).
        !            34:    the C-string lives until the next call of cstr with CLEAR being true */
        !            35: {
        !            36:   static struct cstr_buffer {
        !            37:     char *buffer;
        !            38:     size_t size;
        !            39:   } *buffers=NULL;
        !            40:   static int nbuffers=0;
        !            41:   static int used=0;
        !            42:   struct cstr_buffer *b;
        !            43: 
        !            44:   if (buffers==NULL)
        !            45:     buffers=malloc(0);
        !            46:   if (clear)
        !            47:     used=0;
        !            48:   if (used>=nbuffers) {
        !            49:     buffers=realloc(buffers,sizeof(struct cstr_buffer)*(used+1));
        !            50:     buffers[used]=(struct cstr_buffer){malloc(0),0};
        !            51:     nbuffers=used+1;
        !            52:   }
        !            53:   b=&buffers[used];
        !            54:   if (size+1 > b->size) {
        !            55:     b->buffer = realloc(b->buffer,size+1);
        !            56:     b->size = size+1;
        !            57:   }
        !            58:   memcpy(b->buffer,from,size);
        !            59:   b->buffer[size]='\0';
        !            60:   used++;
        !            61:   return b->buffer;
        !            62: }
        !            63: 
        !            64: char *tilde_cstr(Char *from, UCell size, int clear)
        !            65: /* like cstr(), but perform tilde expansion on the string */
        !            66: {
        !            67:   char *s1,*s2;
        !            68:   int s1_len, s2_len;
        !            69:   struct passwd *getpwnam (), *user_entry;
        !            70: 
        !            71:   if (size<1 || from[0]!='~')
        !            72:     return cstr(from, size, clear);
        !            73:   if (size<2 || from[1]=='/') {
        !            74:     s1 = (char *)getenv ("HOME");
        !            75:     if(s1 == NULL)
        !            76:       s1 = "";
        !            77:     s2 = from+1;
        !            78:     s2_len = size-1;
        !            79:   } else {
        !            80:     UCell i;
        !            81:     for (i=1; i<size && from[i]!='/'; i++)
        !            82:       ;
        !            83:     if (i==2 && from[1]=='+') /* deal with "~+", i.e., the wd */
        !            84:       return cstr(from+3, size<3?0:size-3,clear);
        !            85:     {
        !            86:       char user[i];
        !            87:       memcpy(user,from+1,i-1);
        !            88:       user[i-1]='\0';
        !            89:       user_entry=getpwnam(user);
        !            90:     }
        !            91:     if (user_entry==NULL)
        !            92:       return cstr(from, size, clear);
        !            93:     s1 = user_entry->pw_dir;
        !            94:     s2 = from+i;
        !            95:     s2_len = size-i;
        !            96:   }
        !            97:   s1_len = strlen(s1);
        !            98:   if (s1_len>1 && s1[s1_len-1]=='/')
        !            99:     s1_len--;
        !           100:   {
        !           101:     char path[s1_len+s2_len];
        !           102:     memcpy(path,s1,s1_len);
        !           103:     memcpy(path+s1_len,s2,s2_len);
        !           104:     return cstr(path,s1_len+s2_len,clear);
        !           105:   }
        !           106: }
        !           107: #endif
        !           108: 
        !           109: DCell timeval2us(struct timeval *tvp)
        !           110: {
        !           111: #ifndef BUGGY_LONG_LONG
        !           112:   return (tvp->tv_sec*(DCell)1000000)+tvp->tv_usec;
        !           113: #else
        !           114:   DCell d2;
        !           115:   DCell d1=mmul(tvp->tv_sec,1000000);
        !           116:   d2.lo = d1.lo+tvp->tv_usec;
        !           117:   d2.hi = d1.hi + (d2.lo<d1.lo);
        !           118:   return d2;
        !           119: #endif
        !           120: }
        !           121: 
        !           122: Xt *primtable(Label symbols[], Cell size)
        !           123:      /* used in primitive primtable for peephole optimization */
        !           124: {
        !           125:   Xt *xts = (Xt *)malloc(size*sizeof(Xt));
        !           126:   Cell i;
        !           127: 
        !           128:   for (i=0; i<size; i++)
        !           129:     xts[i] = &symbols[i];
        !           130:   return xts;
        !           131: }