int rs232_OpenComport (U1 *pthreads_ptr, U1 *varlist_ptr, U1 *vm_mem_ptr, S4 threadnum, S8 stacksize)
{
S8 portnumber, baudrate;
S8 retvar_index;
U1 mode[256];
S8 ret;
struct pthreads *pthreads;
struct varlist *varlist;
struct vm_mem *vm_mem;
pthreads = (struct pthreads *) pthreads_ptr;
varlist = (struct varlist *) varlist_ptr;
vm_mem = (struct vm_mem *) vm_mem_ptr;
if (stpull_l (threadnum, pthreads, stacksize, &retvar_index) != ERR_STACK_OK) printf ("rs232_OpenComport: retvar stack error!\n");
if (stpull_s (threadnum, pthreads, stacksize, mode) != ERR_STACK_OK) printf ("rs232_OpenComport: mode stack error!\n");
if (stpull_l (threadnum, pthreads, stacksize, &baudrate) != ERR_STACK_OK) printf ("rs232_OpenComport: baudrate stack error!\n");
if (stpull_l (threadnum, pthreads, stacksize, &portnumber) != ERR_STACK_OK) printf ("rs232_OpenComport: portnumber stack error!\n");
ret = RS232_OpenComport (portnumber, baudrate, mode);
var_lock (varlist, retvar_index);
if (! let_2array_qint (varlist, vm_mem, ret, retvar_index, 0)) printf ("rs232_OpenComport: return value array overflow!\n");
var_unlock (varlist, retvar_index);
return (0);
}
int rs232_SendByte (U1 *pthreads_ptr, U1 *varlist_ptr, U1 *vm_mem_ptr, S4 threadnum, S8 stacksize)
{
S8 portnumber;
S8 retvar_index;
S8 ret;
S8 byte;
U1 byte_b;
struct pthreads *pthreads;
struct varlist *varlist;
struct vm_mem *vm_mem;
pthreads = (struct pthreads *) pthreads_ptr;
varlist = (struct varlist *) varlist_ptr;
vm_mem = (struct vm_mem *) vm_mem_ptr;
if (stpull_l (threadnum, pthreads, stacksize, &retvar_index) != ERR_STACK_OK) printf ("rs232_SendByte: stack error!\n");
if (stpull_l (threadnum, pthreads, stacksize, &byte) != ERR_STACK_OK) printf ("rs232_SendByte: stack error!\n");
if (stpull_l (threadnum, pthreads, stacksize, &portnumber) != ERR_STACK_OK) printf ("rs232_SendByte stack error!\n");
byte_b = byte;
ret = RS232_SendByte (portnumber, byte_b);
var_lock (varlist, retvar_index);
if (! let_2array_qint (varlist, vm_mem, ret, retvar_index, 0)) printf ("rs232_SendByte: return value array overflow!\n");
var_unlock (varlist, retvar_index);
return (0);
}
void undump(char *s)
{
at *atf = OPEN_READ(s,0);
FILE *f = Gptr(atf);
int magic = readmagic32(f);
int version = read32(f);
if ( magic != DUMPMAGIC )
error(NIL, "incorrect dump file format", NIL);
if ( version > DUMPVERSION )
error(NIL, "dump file format version not supported", NIL);
/* The macro character map */
size_t sr = fread(char_map,1,256,f);
if (sr < 256 || feof(f) || ferror(f))
error(NIL, "corrupted dump file (1)",NIL);
/* The unified list */
at *val, *sym, *p = bread(f, NIL);
while (CONSP(p)) {
if (CONSP(Car(p))) {
sym = Caar(p);
val = Cdar(p);
ifn (SYMBOLP(sym))
error(NIL, "corrupted dump file (4)", NIL);
var_SET(sym, val);
} else if (SYMBOLP(Car(p)))
var_lock(Car(p));
val = p;
p = Cdr(p);
Cdr(val) = NIL;
}
/* define special symbols */
at_NULL = var_get(named("NULL"));
}
int rs232_SendBuf (U1 *pthreads_ptr, U1 *varlist_ptr, U1 *vm_mem_ptr, S4 threadnum, S8 stacksize)
{
S8 portnumber, size, i;
S8 retvar_index;
S8 ret;
S8 bvar_index;
S8 byte_b;
U1 buf[4096];
struct pthreads *pthreads;
struct varlist *varlist;
struct vm_mem *vm_mem;
pthreads = (struct pthreads *) pthreads_ptr;
varlist = (struct varlist *) varlist_ptr;
vm_mem = (struct vm_mem *) vm_mem_ptr;
if (stpull_l (threadnum, pthreads, stacksize, &retvar_index) != ERR_STACK_OK) printf ("rs232_SendBuf: stack error!\n");
if (stpull_l (threadnum, pthreads, stacksize, &size) != ERR_STACK_OK) printf ("rs232_SendBuf: stack error!\n");
if (stpull_l (threadnum, pthreads, stacksize, &bvar_index) != ERR_STACK_OK) printf ("rs232_SendBuf: stack error!\n");
if (stpull_l (threadnum, pthreads, stacksize, &portnumber) != ERR_STACK_OK) printf ("rs232_SendBuf: stack error!\n");
var_lock (varlist, bvar_index);
for (i = 0; i < size; i++)
{
if (! let_array2_byte (varlist, vm_mem, bvar_index, i, &byte_b)) printf ("rs232_SendBuf: value array overflow!\n");
buf[i] = byte_b;
}
var_unlock (varlist, bvar_index);
ret = RS232_SendBuf (portnumber, buf, size);
var_lock (varlist, retvar_index);
if (! let_2array_qint (varlist, vm_mem, ret, retvar_index, 0)) printf ("rs232_SendBuf: return value array overflow!\n");
var_unlock (varlist, retvar_index);
return (0);
}
void init_storage()
{
assert(ST_FIRST==0);
assert(sizeof(char)==sizeof(uchar));
#ifdef HAVE_MMAP
size_t storage_size = offsetof(storage_t, mmap_addr);
#else
size_t storage_size = sizeof(storage_t);
#endif
mt_storage = MM_REGTYPE("storage", storage_size,
clear_storage, mark_storage, 0);
/* set up storage_classes */
abstract_storage_class = new_builtin_class(NIL);
class_define("storage", abstract_storage_class);
Generic_storage_class_init(ST_BOOL, Bool);
Generic_storage_class_init(ST_AT, Atom);
Generic_storage_class_init(ST_FLOAT, Float);
Generic_storage_class_init(ST_DOUBLE, Double);
Generic_storage_class_init(ST_INT, Int);
Generic_storage_class_init(ST_SHORT, Short);
Generic_storage_class_init(ST_CHAR, Char);
Generic_storage_class_init(ST_UCHAR, UChar);
Generic_storage_class_init(ST_GPTR, Gptr);
Generic_storage_class_init(ST_MPTR, Mptr);
at *p = var_define("storage-classes");
at *l = NIL;
for (storage_type_t st=ST_FIRST; st<ST_LAST; st++)
l = new_cons(storage_class[st]->backptr, l);
var_set(p, reverse(l));
var_lock(p);
dx_define("new-storage", xnew_storage);
dx_define("new-storage/managed", xnew_storage_managed);
dx_define("new-storage/foreign", xnew_storage_foreign);
#ifdef HAVE_MMAP
dx_define("new-storage/mmap",xnew_storage_mmap);
#endif
dx_define("storage-alloc",xstorage_alloc);
dx_define("storage-realloc",xstorage_realloc);
dx_define("storage-clear",xstorage_clear);
dx_define("storagep",xstoragep);
dx_define("storage-readonlyp",xstorage_readonlyp);
dx_define("storage-set-readonly", xstorage_set_readonly);
dx_define("storage-load",xstorage_load);
dx_define("storage-save",xstorage_save);
dx_define("storage-nelems",xstorage_nelems);
dx_define("storage-nbytes",xstorage_nbytes);
}