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>