version 1.23, 1995/02/22 18:40:13
|
version 1.27, 1995/06/07 10:05:04
|
Line 14
|
Line 14
|
#include <time.h> |
#include <time.h> |
#include <sys/time.h> |
#include <sys/time.h> |
#include <unistd.h> |
#include <unistd.h> |
|
#include <errno.h> |
|
#include <pwd.h> |
#include "forth.h" |
#include "forth.h" |
#include "io.h" |
#include "io.h" |
|
|
Line 22
|
Line 24
|
#define SEEK_SET 0 |
#define SEEK_SET 0 |
#endif |
#endif |
|
|
|
#define IOR(flag) ((flag)? -512-errno : 0) |
|
|
typedef union { |
typedef union { |
struct { |
struct { |
#ifdef WORDS_BIGENDIAN |
#ifdef WORDS_BIGENDIAN |
Line 123 typedef struct F83Name {
|
Line 127 typedef struct F83Name {
|
#define FTOS (fp[0]) |
#define FTOS (fp[0]) |
#endif |
#endif |
|
|
|
Cell *SP; |
|
Float *FP; |
int emitcounter; |
int emitcounter; |
#define NULLC '\0' |
#define NULLC '\0' |
|
|
Line 155 char *cstr(Char *from, UCell size, int c
|
Line 161 char *cstr(Char *from, UCell size, int c
|
return oldnextscratch; |
return oldnextscratch; |
} |
} |
|
|
|
char *tilde_cstr(Char *from, UCell size, int clear) |
|
/* like cstr(), but perform tilde expansion on the string */ |
|
{ |
|
char *s1,*s2; |
|
int s1_len, s2_len; |
|
struct passwd *getpwnam (), *user_entry; |
|
|
|
if (size<1 || from[0]!='~') |
|
return cstr(from, size, clear); |
|
if (size<2 || from[1]=='/') { |
|
s1 = (char *)getenv ("HOME"); |
|
s2 = from+1; |
|
s2_len = size-1; |
|
} else { |
|
int i; |
|
for (i=1; i<size && from[i]!='/'; i++) |
|
; |
|
{ |
|
char user[i]; |
|
memcpy(user,from+1,i-1); |
|
user[i-1]='\0'; |
|
user_entry=getpwnam(user); |
|
} |
|
if (user_entry==NULL) |
|
return cstr(from, size, clear); |
|
s1 = user_entry->pw_dir; |
|
s2 = from+i; |
|
s2_len = size-i; |
|
} |
|
s1_len = strlen(s1); |
|
if (s1_len>1 && s1[s1_len-1]=='/') |
|
s1_len--; |
|
{ |
|
char path[s1_len+s2_len]; |
|
memcpy(path,s1,s1_len); |
|
memcpy(path+s1_len,s2,s2_len); |
|
return cstr(path,s1_len+s2_len,clear); |
|
} |
|
} |
|
|
|
|
#define NEWLINE '\n' |
#define NEWLINE '\n' |
|
|
#ifndef HAVE_RINT |
#ifndef HAVE_RINT |
#define rint(x) floor((x)+0.5) |
#define rint(x) floor((x)+0.5) |
#endif |
#endif |
|
|
static char* fileattr[6]={"r","rb","r+","r+b","w+","w+b"}; |
static char* fileattr[6]={"r","rb","r+","r+b","w","wb"}; |
|
|
static Address up0=NULL; |
static Address up0=NULL; |
|
|
Line 214 Label *engine(Xt *ip0, Cell *sp0, Cell *
|
Line 261 Label *engine(Xt *ip0, Cell *sp0, Cell *
|
&&dovar, |
&&dovar, |
&&douser, |
&&douser, |
&&dodefer, |
&&dodefer, |
|
&&dostruc, |
&&dodoes, |
&&dodoes, |
&&dodoes, /* dummy for does handler address */ |
&&dodoes, /* dummy for does handler address */ |
#include "prim_labels.i" |
#include "prim_labels.i" |
Line 309 Label *engine(Xt *ip0, Cell *sp0, Cell *
|
Line 357 Label *engine(Xt *ip0, Cell *sp0, Cell *
|
cfa = *(Xt *)PFA1(cfa); |
cfa = *(Xt *)PFA1(cfa); |
NEXT1; |
NEXT1; |
|
|
|
dostruc: |
|
#ifdef DEBUG |
|
fprintf(stderr,"%08x: struc: %08x\n",(Cell)ip,(Cell)PFA1(cfa)); |
|
#endif |
|
TOS += *(Cell*)PFA1(cfa); |
|
NEXT_P0; |
|
NEXT; |
|
|
dodoes: |
dodoes: |
/* this assumes the following structure: |
/* this assumes the following structure: |
defining-word: |
defining-word: |