### Diff for /gforth/prim between versions 1.107 and 1.111

version 1.107, 2002/12/19 23:23:49 version 1.111, 2002/12/30 22:41:07
Line 105 Line 105
\E   \E
\E set-current  \E set-current
\E store-optimization on  \E store-optimization on
\E ' noop tail-nextp2 ! \ now INST_TAIL just stores, but does not jump

\   \
\   \
Line 817  lshift ( u1 n -- u2 )  core l_shift Line 818  lshift ( u1 n -- u2 )  core l_shift
:  :
0 ?DO 2* LOOP ;      0 ?DO 2* LOOP ;

\g compare

\ comparisons(prefix, args, prefix, arg1, arg2, wordsets...)  \ comparisons(prefix, args, prefix, arg1, arg2, wordsets...)
define(comparisons,  define(comparisons,
\$1=     ( \$2 -- f )             \$6      \$3equals  \$1=     ( \$2 -- f )             \$6      \$3equals
Line 938  f = FLAG(u1-u2 < u3-u2); Line 941  f = FLAG(u1-u2 < u3-u2);
:  :
over - >r - r> u< ;   over - >r - r> u< ;

\g internal

sp@     ( -- a_addr )           gforth          sp_fetch  sp@     ( -- a_addr )           gforth          sp_fetch

Line 1090  w = sp[u+1]; Line 1091  w = sp[u+1];

\ toggle is high-level: 0.11/0.42%  \ toggle is high-level: 0.11/0.42%

\g memory

@       ( a_addr -- w )         core    fetch  @       ( a_addr -- w )         core    fetch
""@i{w} is the cell stored at @i{a_addr}.""  ""@i{w} is the cell stored at @i{a_addr}.""
:  :
dup 1+ swap c@ ;   dup 1+ swap c@ ;

\g compiler

(f83find)       ( c_addr u f83name1 -- f83name2 )       new     paren_f83find  (f83find)       ( c_addr u f83name1 -- f83name2 )       new     paren_f83find
for (; f83name1 != NULL; f83name1 = (struct F83Name *)(f83name1->next))  for (; f83name1 != NULL; f83name1 = (struct F83Name *)(f83name1->next))
if ((UCell)F83NAME_COUNT(f83name1)==u &&    if ((UCell)F83NAME_COUNT(f83name1)==u &&
Line 1605  wior = IOR(rename(tilde_cstr(c_addr1, u1 Line 1610  wior = IOR(rename(tilde_cstr(c_addr1, u1

file-position   ( wfileid -- ud wior )  file    file_position  file-position   ( wfileid -- ud wior )  file    file_position
/* !! use tell and lseek? */  /* !! use tell and lseek? */
ud = LONG2UD(ftell((FILE *)wfileid));  ud = OFF2UD(ftello((FILE *)wfileid));
wior = IOR(UD2LONG(ud)==-1);  wior = IOR(UD2OFF(ud)==-1);

reposition-file ( ud wfileid -- wior )  file    reposition_file  reposition-file ( ud wfileid -- wior )  file    reposition_file
wior = IOR(fseek((FILE *)wfileid, UD2LONG(ud), SEEK_SET)==-1);  wior = IOR(fseeko((FILE *)wfileid, UD2OFF(ud), SEEK_SET)==-1);

file-size       ( wfileid -- ud wior )  file    file_size  file-size       ( wfileid -- ud wior )  file    file_size
struct stat buf;  struct stat buf;
wior = IOR(fstat(fileno((FILE *)wfileid), &buf)==-1);  wior = IOR(fstat(fileno((FILE *)wfileid), &buf)==-1);
ud = LONG2UD(buf.st_size);  ud = OFF2UD(buf.st_size);

resize-file     ( ud wfileid -- wior )  file    resize_file  resize-file     ( ud wfileid -- wior )  file    resize_file
wior = IOR(ftruncate(fileno((FILE *)wfileid), UD2LONG(ud))==-1);  wior = IOR(ftruncate(fileno((FILE *)wfileid), UD2OFF(ud))==-1);

/* !! fread does not guarantee enough */  /* !! fread does not guarantee enough */
\+  \+
\+glocals  \+glocals

\g locals

@local# ( #noffset -- w )       gforth  fetch_local_number  @local# ( #noffset -- w )       gforth  fetch_local_number
w = *(Cell *)(lp+noffset);  w = *(Cell *)(lp+noffset);

Line 2093  r = fp[u+1]; /* +1, because update of fp Line 2100  r = fp[u+1]; /* +1, because update of fp

\+OS  \+OS

\g syslib

define(`uploop',  define(`uploop',
`pushdef(`\$1', `\$2')_uploop(`\$1', `\$2', `\$3', `\$4', `\$5')`'popdef(`\$1')')         `pushdef(`\$1', `\$2')_uploop(`\$1', `\$2', `\$3', `\$4', `\$5')`'popdef(`\$1')')
define(`_uploop',  define(`_uploop',
Line 2528  SUPER_CONTINUE; Line 2537  SUPER_CONTINUE;
acondbranch(a?branch,f --,f83   aquestion_branch,  acondbranch(a?branch,f --,f83   aquestion_branch,
,if (f==0) {  ,if (f==0) {
,:  ,:
0= dup     \ !f !f \ !! still uses relative addresses   0= dup 0=          \ !f f
r> dup @   \ !f !f IP branchoffset   r> tuck cell+      \ !f branchoffset f IP+
rot and +  \ !f IP|IP+branchoffset   and -rot @ and or  \ f&IP+|!f&branch
swap 0= cell and + \ IP''
>r ;)   >r ;)

\ we don't need an lp_plus_store version of the ?dup-stuff, because it  \ we don't need an lp_plus_store version of the ?dup-stuff, because it
Line 2782  a_prim = decompile_code(a_code); Line 2790  a_prim = decompile_code(a_code);

include(peeprules.vmg)  include(peeprules.vmg)

\g end

\+  \+

 Removed from v.1.107 changed lines Added in v.1.111

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