--- gforth/prim 2006/02/19 17:27:12 1.189 +++ gforth/prim 2006/04/02 09:18:56 1.192 @@ -1238,7 +1238,7 @@ useraddr ( #u -- a_addr ) new a_addr = (Cell *)(up+u); up! ( a_addr -- ) gforth up_store -gforth_UP=up=(char *)a_addr; +gforth_UP=up=(Address)a_addr; : up ! ; Variable UP @@ -1646,20 +1646,23 @@ n=1; \g hostos -key-file ( wfileid -- n ) gforth paren_key_file +key-file ( wfileid -- c ) gforth paren_key_file +""Read one character @i{c} from @i{wfileid}. "" #ifdef HAS_FILE fflush(stdout); -n = key((FILE*)wfileid); +c = key((FILE*)wfileid); #else -n = key(stdin); +c = key(stdin); #endif -key?-file ( wfileid -- n ) gforth key_q_file +key?-file ( wfileid -- f ) gforth key_q_file +""@i{f} is true if at least one character can be read from @i{wfileid} +without blocking."" #ifdef HAS_FILE fflush(stdout); -n = key_query((FILE*)wfileid); +f = key_query((FILE*)wfileid); #else -n = key_query(stdin); +f = key_query(stdin); #endif \+os @@ -1711,8 +1714,8 @@ is the host operating system's expansion environment variable does not exist, @i{c-addr2 u2} specifies a string 0 characters in length."" /* close ' to keep fontify happy */ -c_addr2 = getenv(cstr(c_addr1,u1,1)); -u2 = (c_addr2 == NULL ? 0 : strlen(c_addr2)); +c_addr2 = (Char *)getenv(cstr(c_addr1,u1,1)); +u2 = (c_addr2 == NULL ? 0 : strlen((char *)c_addr2)); open-pipe ( c_addr u wfam -- wfileid wior ) gforth open_pipe wfileid=(Cell)popen(cstr(c_addr,u,1),pfileattr[wfam]); /* ~ expansion of 1st arg? */ @@ -1788,12 +1791,12 @@ else wior = IOR(a_addr2==NULL); /* !! Define a return code */ strerror ( n -- c_addr u ) gforth -c_addr = strerror(n); -u = strlen(c_addr); +c_addr = (Char *)strerror(n); +u = strlen((char *)c_addr); strsignal ( n -- c_addr u ) gforth -c_addr = (Address)strsignal(n); -u = strlen(c_addr); +c_addr = (Char *)strsignal(n); +u = strlen((char *)c_addr); call-c ( ... w -- ... ) gforth call_c ""Call the C function pointed to by @i{w}. The C function has to @@ -1929,7 +1932,7 @@ if(dent == NULL) { u2 = 0; flag = 0; } else { - u2 = strlen(dent->d_name); + u2 = strlen((char *)dent->d_name); if(u2 > u1) { u2 = u1; wior = -512-ENAMETOOLONG; @@ -1954,9 +1957,9 @@ wior = IOR(chdir(tilde_cstr(c_addr, u, 1 get-dir ( c_addr1 u1 -- c_addr2 u2 ) gforth get_dir ""Store the current directory in the buffer specified by @{c-addr1, u1}. If the buffer size is not sufficient, return 0 0"" -c_addr2 = getcwd(c_addr1, u1); +c_addr2 = (Char *)getcwd((char *)c_addr1, u1); if(c_addr2 != NULL) { - u2 = strlen(c_addr2); + u2 = strlen((char *)c_addr2); } else { u2 = 0; } @@ -1974,7 +1977,7 @@ char newline[] = { '\r','\n' #endif }; -c_addr=newline; +c_addr=(Char *)newline; u=sizeof(newline); : "newline count ; @@ -2166,7 +2169,7 @@ sig=ecvt(r, u, &decpt, &flag); n=(r==0. ? 1 : decpt); f1=FLAG(flag!=0); f2=FLAG(isdigit((unsigned)(sig[0]))!=0); -siglen=strlen(sig); +siglen=strlen((char *)sig); if (siglen>u) /* happens in glibc-2.1.3 if 999.. is rounded up */ siglen=u; if (!f2) /* workaround Cygwin trailing 0s for Inf and Nan */ @@ -2587,69 +2590,69 @@ alloc-callback ( a_ip -- c_addr ) gforth c_addr = (char *)alloc_callback(gforth_callback, (Xt *)a_ip); va-start-void ( -- ) gforth va_start_void -va_start_void(clist); +va_start_void(gforth_clist); va-start-int ( -- ) gforth va_start_int -va_start_int(clist); +va_start_int(gforth_clist); va-start-longlong ( -- ) gforth va_start_longlong -va_start_longlong(clist); +va_start_longlong(gforth_clist); va-start-ptr ( -- ) gforth va_start_ptr -va_start_ptr(clist, (char *)); +va_start_ptr(gforth_clist, (char *)); va-start-float ( -- ) gforth va_start_float -va_start_float(clist); +va_start_float(gforth_clist); va-start-double ( -- ) gforth va_start_double -va_start_double(clist); +va_start_double(gforth_clist); va-arg-int ( -- w ) gforth va_arg_int -w = va_arg_int(clist); +w = va_arg_int(gforth_clist); va-arg-longlong ( -- d ) gforth va_arg_longlong #ifdef BUGGY_LONG_LONG -DLO_IS(d, va_arg_longlong(clist)); +DLO_IS(d, va_arg_longlong(gforth_clist)); DHI_IS(d, 0); #else -d = va_arg_longlong(clist); +d = va_arg_longlong(gforth_clist); #endif va-arg-ptr ( -- c_addr ) gforth va_arg_ptr -c_addr = (char *)va_arg_ptr(clist,char*); +c_addr = (char *)va_arg_ptr(gforth_clist,char*); va-arg-float ( -- r ) gforth va_arg_float -r = va_arg_float(clist); +r = va_arg_float(gforth_clist); va-arg-double ( -- r ) gforth va_arg_double -r = va_arg_double(clist); +r = va_arg_double(gforth_clist); va-return-void ( -- ) gforth va_return_void -va_return_void(clist); +va_return_void(gforth_clist); return 0; va-return-int ( w -- ) gforth va_return_int -va_return_int(clist, w); +va_return_int(gforth_clist, w); return 0; va-return-ptr ( c_addr -- ) gforth va_return_ptr -va_return_ptr(clist, void *, c_addr); +va_return_ptr(gforth_clist, void *, c_addr); return 0; va-return-longlong ( d -- ) gforth va_return_longlong #ifdef BUGGY_LONG_LONG -va_return_longlong(clist, d.lo); +va_return_longlong(gforth_clist, d.lo); #else -va_return_longlong(clist, d); +va_return_longlong(gforth_clist, d); #endif return 0; va-return-float ( r -- ) gforth va_return_float -va_return_float(clist, r); +va_return_float(gforth_clist, r); return 0; va-return-double ( r -- ) gforth va_return_double -va_return_double(clist, r); +va_return_double(gforth_clist, r); return 0; \+ @@ -2673,15 +2676,16 @@ static int ffi_sizes[] = 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); +w = ffi_prep_cif((ffi_cif *)a_cif, FFI_DEFAULT_ABI, n, + (ffi_type *)a_rtype, (ffi_type **)a_atypes); ffi-call ( a_avalues a_rvalue a_ip a_cif -- ) gforth ffi_call SAVE_REGS -ffi_call(a_cif, a_ip, a_rvalue, a_avalues); +ffi_call((ffi_cif *)a_cif, (void(*)())a_ip, (void *)a_rvalue, (void **)a_avalues); REST_REGS ffi-prep-closure ( a_ip a_cif a_closure -- w ) gforth ffi_prep_closure -w = ffi_prep_closure(a_closure, a_cif, gforth_callback, a_ip); +w = ffi_prep_closure((ffi_closure *)a_closure, (ffi_cif *)a_cif, gforth_callback, (void *)a_ip); ffi-2@ ( a_addr -- d ) gforth ffi_2fetch #ifdef BUGGY_LONG_LONG @@ -2699,50 +2703,50 @@ ffi-2! ( d a_addr -- ) gforth ffi_2store #endif ffi-arg-int ( -- w ) gforth ffi_arg_int -w = *(int *)(*clist++); +w = *(int *)(*gforth_clist++); ffi-arg-longlong ( -- d ) gforth ffi_arg_longlong #ifdef BUGGY_LONG_LONG -DLO_IS(d, (Cell*)(*clist++)); +DLO_IS(d, (Cell*)(*gforth_clist++)); DHI_IS(d, 0); #else -d = *(DCell*)(*clist++); +d = *(DCell*)(*gforth_clist++); #endif ffi-arg-ptr ( -- c_addr ) gforth ffi_arg_ptr -c_addr = *(char **)(*clist++); +c_addr = *(Char **)(*gforth_clist++); ffi-arg-float ( -- r ) gforth ffi_arg_float -r = *(float*)(*clist++); +r = *(float*)(*gforth_clist++); ffi-arg-double ( -- r ) gforth ffi_arg_double -r = *(double*)(*clist++); +r = *(double*)(*gforth_clist++); ffi-ret-void ( -- ) gforth ffi_ret_void return 0; ffi-ret-int ( w -- ) gforth ffi_ret_int -*(int*)(ritem) = w; +*(int*)(gforth_ritem) = w; return 0; ffi-ret-longlong ( d -- ) gforth ffi_ret_longlong #ifdef BUGGY_LONG_LONG -*(Cell*)(ritem) = DLO(d); +*(Cell*)(gforth_ritem) = DLO(d); #else -*(DCell*)(ritem) = d; +*(DCell*)(gforth_ritem) = d; #endif return 0; ffi-ret-ptr ( c_addr -- ) gforth ffi_ret_ptr -*(char **)(ritem) = c_addr; +*(Char **)(gforth_ritem) = c_addr; return 0; ffi-ret-float ( r -- ) gforth ffi_ret_float -*(float*)(ritem) = r; +*(float*)(gforth_ritem) = r; return 0; ffi-ret-double ( r -- ) gforth ffi_ret_double -*(double*)(ritem) = r; +*(double*)(gforth_ritem) = r; return 0; \+