[BACK]Return to prim CVS log [TXT] [DIR] Up to [gforth] / gforth

Diff for /gforth/prim between versions 1.172 and 1.175

version 1.172, 2005/07/28 19:15:00 version 1.175, 2005/08/21 22:09:14
Line 140 Line 140
   
 \ Stack caching setup  \ Stack caching setup
   
 ifdef(`M4_ENGINE_FAST', `include(cache1.vmg)', `include(cache0.vmg)')  ifdef(`STACK_CACHE_FILE', `include(STACK_CACHE_FILE)', `include(cache0.vmg)')
   
 \ these m4 macros would collide with identifiers  \ these m4 macros would collide with identifiers
 undefine(`index')  undefine(`index')
Line 417  INST_TAIL; Line 417  INST_TAIL;
 JUMP(a_target);  JUMP(a_target);
 #else  #else
 SET_IP((Xt *)a_target);  SET_IP((Xt *)a_target);
   INST_TAIL; NEXT_P2;  
 #endif  #endif
 }  } else {
 sp--;  sp--;
 sp[0]=f;  sp[0]=f;
 SUPER_CONTINUE;  }
   
 ?dup-0=-?branch ( #a_target f -- S:... ) new    question_dupe_zero_equals_question_branch  ?dup-0=-?branch ( #a_target f -- S:... ) new    question_dupe_zero_equals_question_branch
 ""The run-time procedure compiled by @code{?DUP-0=-IF}.""  ""The run-time procedure compiled by @code{?DUP-0=-IF}.""
Line 433  if (f!=0) { Line 432  if (f!=0) {
   JUMP(a_target);    JUMP(a_target);
 #else  #else
   SET_IP((Xt *)a_target);    SET_IP((Xt *)a_target);
   NEXT;  
 #endif  #endif
 }  }
 SUPER_CONTINUE;  
   
 \+  \+
 \fhas? skiploopprims 0= [IF]  \fhas? skiploopprims 0= [IF]
Line 2491  av_longlong(alist, d); Line 2488  av_longlong(alist, d);
 av-ptr-r        ( R:c_addr -- ) gforth  av_ptr_r  av-ptr-r        ( R:c_addr -- ) gforth  av_ptr_r
 av_ptr(alist, void*, c_addr);  av_ptr(alist, void*, c_addr);
   
 av-call-void    ( -- )  gforth  av_call_void  av-call-void    ( ... -- ... )  gforth  av_call_void
 SAVE_REGS  SAVE_REGS
 av_call(alist);  av_call(alist);
 REST_REGS  REST_REGS
   
 av-call-int     ( -- w )        gforth  av_call_int  av-call-int     ( ... -- ... w )        gforth  av_call_int
 SAVE_REGS  SAVE_REGS
 av_call(alist);  av_call(alist);
 REST_REGS  REST_REGS
 w = irv;  w = irv;
   
 av-call-float   ( -- r )        gforth  av_call_float  av-call-float   ( ... -- ... r )        gforth  av_call_float
 SAVE_REGS  SAVE_REGS
 av_call(alist);  av_call(alist);
 REST_REGS  REST_REGS
 r = frv;  r = frv;
   
 av-call-double  ( -- r )        gforth  av_call_double  av-call-double  ( ... -- ... r )        gforth  av_call_double
 SAVE_REGS  SAVE_REGS
 av_call(alist);  av_call(alist);
 REST_REGS  REST_REGS
 r = drv;  r = drv;
   
 av-call-longlong        ( -- d )        gforth  av_call_longlong  av-call-longlong        ( ... -- ... d )        gforth  av_call_longlong
 SAVE_REGS  SAVE_REGS
 av_call(alist);  av_call(alist);
 REST_REGS  REST_REGS
Line 2525  DHI_IS(d, 0); Line 2522  DHI_IS(d, 0);
 d = llrv;  d = llrv;
 #endif  #endif
   
 av-call-ptr     ( -- c_addr )   gforth  av_call_ptr  av-call-ptr     ( ... -- ... c_addr )   gforth  av_call_ptr
 SAVE_REGS  SAVE_REGS
 av_call(alist);  av_call(alist);
 REST_REGS  REST_REGS
Line 2602  return 0; Line 2599  return 0;
   
 \+  \+
   
   \+LIBFFI
   
   ffi-type ( n -- a_type )        gforth ffi_type
   static void* ffi_types[] =
       { &ffi_type_void,
         &ffi_type_uint8, &ffi_type_sint8,
         &ffi_type_uint16, &ffi_type_sint16,
         &ffi_type_uint32, &ffi_type_sint32,
         &ffi_type_uint64, &ffi_type_sint64,
         &ffi_type_float, &ffi_type_double, &ffi_type_longdouble,
         &ffi_type_pointer };
   a_type = ffi_types[n];
   
   ffi-size ( n1 -- n2 )   gforth ffi_size
   static int ffi_sizes[] =
       { sizeof(ffi_cif), sizeof(ffi_closure) };
   n2 = ffi_sizes[n1];
   
   ffi-prep-cif ( a_atypes n a_rtype a_cif -- w )  gforth ffi_prep_cif
   w = ffi_prep_cif(a_cif, FFI_DEFAULT_ABI, n, a_rtype, a_atypes);
   
   ffi-call ( a_avalues a_rvalue a_ip a_cif -- )   gforth ffi_call
   ffi_call(a_cif, a_ip, a_rvalue, a_avalues);
   
   ffi-prep-closure ( a_ip a_cif a_closure -- w )  gforth ffi_prep_closure
   w = ffi_prep_closure(a_closure, a_cif, ffi_callback, a_ip);
   
   ffi-2@ ( a_addr -- d )  gforth ffi_2fetch
   #ifdef BUGGY_LONG_LONG
   DLO_IS(d, (Cell*)(*a_addr));
   DHI_IS(d, 0);
   #else
   d = *(DCell*)(*a_addr);
   #endif
   
   ffi-2! ( d a_addr -- )  gforth ffi_2store
   #ifdef BUGGY_LONG_LONG
   *(Cell*)(a_addr) = DLO(d);
   #else
   *(DCell*)(a_addr) = d;
   #endif
   
   ffi-arg-int ( -- w )    gforth ffi_arg_int
   w = *(Cell*)(*clist++);
   
   ffi-arg-longlong ( -- d )       gforth ffi_arg_longlong
   #ifdef BUGGY_LONG_LONG
   DLO_IS(d, (Cell*)(*clist++));
   DHI_IS(d, 0);
   #else
   d = *(DCell*)(*clist++);
   #endif
   
   ffi-arg-ptr ( -- c_addr )       gforth ffi_arg_ptr
   c_addr = *(char **)(*clist++);
   
   ffi-arg-float ( -- r )  gforth ffi_arg_float
   r = *(float*)(*clist++);
   
   ffi-arg-double ( -- r ) gforth ffi_arg_double
   r = *(double*)(*clist++);
   
   ffi-ret-int ( -- w )    gforth ffi_ret_int
   *(int*)(ritem) = w;
   
   ffi-ret-longlong ( -- d )       gforth ffi_ret_longlong
   #ifdef BUGGY_LONG_LONG
   *(Cell*)(ritem) = DLO(d);
   #else
   *(DCell*)(ritem) = d;
   #endif
   
   ffi-ret-ptr ( -- c_addr )       gforth ffi_ret_ptr
   *(char **)(ritem) = c_addr;
   
   ffi-ret-float ( -- r )  gforth ffi_ret_float
   *(float*)(ritem) = r;
   
   ffi-ret-double ( -- r ) gforth ffi_ret_double
   *(double*)(ritem) = r;
   
   \+
   
 \+OLDCALL  \+OLDCALL
   
 define(`uploop',  define(`uploop',
Line 2691  a_addr = groups; Line 2771  a_addr = groups;
   
 \g static_super  \g static_super
   
 ifdef(`M4_ENGINE_FAST',  ifdef(`STACK_CACHE_FILE',
 `include(peeprules.vmg)')  `include(peeprules.vmg)')
   
 \g end  \g end
Removed from v.1.172  
changed lines
  Added in v.1.175

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