static void
do_encode_unit(fcode_env_t *env)
{
char enc_buf[64];
fstack_t hi, lo;
uint32_t id;
long long off;
CHECK_DEPTH(env, 2, "jupiter:encode-unit");
hi = POP(DS);
lo = POP(DS);
off = (long long)(((hi & 0x1F) << 32) | lo);
/* Convert physical address to portid */
DO_GET_IO_PORTID(env, lo, hi, id);
if (off) {
(void) sprintf(enc_buf, "%x,%llx", id, off);
} else {
(void) sprintf(enc_buf, "%x", id);
}
debug_msg(DEBUG_REG_ACCESS, "jupiter:encode_unit ( %x %x ) -> '%s'\n",
(uint32_t)hi, (uint32_t)lo, enc_buf);
push_a_string(env, STRDUP(enc_buf));
}
static void
do_decode_unit(fcode_env_t *env)
{
uint32_t hi;
long long lo;
unsigned int portid, lsb, ch;
char *buf;
CHECK_DEPTH(env, 2, "jupiter:decode-unit");
buf = pop_a_string(env, NULL);
if (sscanf(buf, "%x,%llx", &portid, &lo) != 2) {
if (sscanf(buf, "%x", &portid) != 1) {
throw_from_fclib(env, 1, "jupiter:decode_unit:%s",
buf);
}
lo = 0;
}
lsb = OPL_IO_PORTID_TO_LSB(portid);
ch = OPL_PORTID_TO_CHANNEL(portid);
hi = OPL_ADDR_HI(lsb, ch);
debug_msg(DEBUG_REG_ACCESS,
"jupiter:decode_unit ( '%s' ) -> %x %llx\n", buf, hi, lo);
PUSH(DS, (fstack_t)lo);
PUSH(DS, (fstack_t)hi);
}
void
left_parse_string(fcode_env_t *env)
{
char sep, *cptr, *lstr, *rstr;
int len, llen, rlen;
CHECK_DEPTH(env, 3, "left-parse-string");
sep = (char)POP(DS);
if (TOS == 0) {
two_dup(env);
return;
}
lstr = pop_a_string(env, &llen);
len = 0;
cptr = NULL;
while (len < llen) {
if (lstr[len] == sep) {
cptr = lstr+len;
break;
}
len++;
}
if (cptr != NULL) {
rstr = cptr+1;
rlen = lstr + llen - rstr;
llen = len;
} else {
rlen = 0;
rstr = lstr;
}
PUSH(DS, (fstack_t)rstr);
PUSH(DS, rlen);
PUSH(DS, (fstack_t)lstr);
PUSH(DS, llen);
}
static void
do_master_interrupt(fcode_env_t *env)
{
private_data_t *pdp = DEVICE_PRIVATE(env);
char *service = "master-interrupt";
int portid;
token_t xt;
int error;
fc_cell_t status;
CHECK_DEPTH(env, 2, "jupiter:master-interrupt");
portid = POP(DS);
xt = POP(DS);
/*
* Install the master interrupt handler for this port id.
*/
error = fc_run_priv(pdp->common, service, 2, 1,
fc_uint32_t2cell(portid), fc_uint32_t2cell(xt), &status);
if (error || !status)
throw_from_fclib(env, 1, "jupiter:%s: failed\n", service);
PUSH(DS, FALSE);
debug_msg(DEBUG_REG_ACCESS,
"jupiter:master-interrupt ( %x %x ) -> %x\n",
portid, xt, (int)FALSE);
}
static void
fcd_comp(fcode_env_t *env)
{
char *str1, *str2, byte1, byte2;
size_t len;
CHECK_DEPTH(env, 3, "comp");
len = (size_t)POP(DS);
str1 = (char *)POP(DS);
str2 = (char *)POP(DS);
for (; len > 0; len--, str1++, str2++) {
PUSH(DS, (fstack_t)str1);
fcd_cfetch(env);
byte1 = POP(DS);
PUSH(DS, (fstack_t)str2);
fcd_cfetch(env);
byte2 = POP(DS);
if (byte1 > byte2) {
PUSH(DS, -1);
return;
}
if (byte1 < byte2) {
PUSH(DS, 1);
return;
}
}
PUSH(DS, 0);
}
void
internal_env_fetch(fcode_env_t *env)
{
instance_t **iptr;
CHECK_DEPTH(env, 1, "internal_env_fetch");
iptr = (instance_t **)get_internal_address(env);
PUSH(DS, (fstack_t)(*iptr));
}
void
do_set_action(fcode_env_t *env)
{
acf_t a = (acf_t)TOS;
CHECK_DEPTH(env, 1, "do_set_action");
TOS += sizeof (acf_t);
(void) run_action(env, a, 1);
}
/*
* fcdriver version of xstore, replaces base 'x!'
*/
static void
fcd_xstore(fcode_env_t *env)
{
fstack_t addr = TOS;
CHECK_DEPTH(env, 2, "x!");
if (!check_address_abuse(env, addr, "x!", 0, rxstore))
xstore(env);
}
/*
* fcdriver version of xfetch, replaces base 'x@'
*/
static void
fcd_xfetch(fcode_env_t *env)
{
fstack_t addr = TOS;
CHECK_DEPTH(env, 1, "x@");
if (!check_address_abuse(env, addr, "x@", 0, rxfetch))
xfetch(env);
}
void
internal_env_store(fcode_env_t *env)
{
instance_t **iptr;
CHECK_DEPTH(env, 2, "internal_env_store");
iptr = (instance_t **)get_internal_address(env);
*iptr = (instance_t *)POP(DS);
}
void
internal_env_addr(fcode_env_t *env)
{
fstack_t d;
CHECK_DEPTH(env, 1, "internal_env_addr");
d = (fstack_t)get_internal_address(env);
PUSH(DS, d);
}
void
alloc_mem(fcode_env_t *env)
{
CHECK_DEPTH(env, 1, "alloc-mem");
TOS = (fstack_t)MALLOC((size_t)TOS);
if (!TOS) {
throw_from_fclib(env, 1, "alloc-mem failed");
}
}
static void
value_store(fcode_env_t *env)
{
variable_t *addr;
CHECK_DEPTH(env, 1, "value_store");
addr = (variable_t *)POP(DS);
*addr = (variable_t)POP(DS);
}
void
do_default_action(fcode_env_t *env)
{
acf_t a;
CHECK_DEPTH(env, 1, "do_default_action");
a = (acf_t)TOS;
(void) run_action(env, (a-1), 0);
}
/*
* value_fetch and value_store are the same as "fetch" and "store", but
* we'll leave them implemented here for now.
*/
static void
value_fetch(fcode_env_t *env)
{
variable_t *addr;
CHECK_DEPTH(env, 1, "value_fetch");
addr = (variable_t *)POP(DS);
PUSH(DS, (variable_t)*addr);
}
void
buffer_init(fcode_env_t *env)
{
token_t *d;
CHECK_DEPTH(env, 1, "buffer_init");
d = (token_t *)POP(DS);
do_buffer_data(env, d, 0);
}
static void
do_map_out(fcode_env_t *env)
{
fstack_t addr, len;
CHECK_DEPTH(env, 2, "jupiter:map-out");
len = POP(DS);
addr = POP(DS);
mem_map_out(env, addr, len);
}
static void
rwfetch(fcode_env_t *env)
{
fstack_t p;
CHECK_DEPTH(env, 1, "rw@");
p = TOS;
if (!check_address_abuse(env, p, "rw@", 1, wfetch))
TOS = (wforth_t)fc_reg_read(env, "rw@", p, NULL);
}
void
free_mem(fcode_env_t *env)
{
void *p;
CHECK_DEPTH(env, 2, "free-mem");
(void) POP(DS);
p = (void *) POP(DS);
FREE(p);
}
void *
get_internal_address(fcode_env_t *env)
{
int *ptr;
CHECK_DEPTH(env, 1, "get_internal_address");
ptr = (int *)POP(DS);
if (*ptr > 0)
return ((uchar_t *)env + *ptr);
return ((uchar_t *)MYSELF - *ptr);
}
void
rbfetch(fcode_env_t *env)
{
fstack_t p;
CHECK_DEPTH(env, 1, "rb@");
p = TOS;
if (!check_address_abuse(env, p, "rb@", 1, cfetch)) {
TOS = (uchar_t)fc_reg_read(env, "rb@", p, NULL);
}
}
static void
cpoke(fcode_env_t *env)
{
fstack_t p, d;
int error;
CHECK_DEPTH(env, 2, "cpoke");
p = POP(DS);
d = POP(DS);
fc_reg_write(env, "rb!", p, d, &error);
PUSH(DS, error ? FALSE : TRUE);
}
static void
do_map_in(fcode_env_t *env)
{
fstack_t phi, plo, len, addr;
CHECK_DEPTH(env, 3, "jupiter:map-in");
len = POP(DS);
phi = POP(DS);
plo = POP(DS);
addr = mem_map_in(env, phi, plo, len);
PUSH(DS, addr);
}
static void
rbstore(fcode_env_t *env)
{
fstack_t p, d;
CHECK_DEPTH(env, 2, "rb!");
p = TOS;
if (!check_address_abuse(env, p, "rb!", 1, cstore)) {
p = POP(DS);
d = POP(DS);
fc_reg_write(env, "rb!", p, d, NULL);
}
}
/*
* rx@ ( xa -- xv )
*/
static void
rxfetch(fcode_env_t *env)
{
fstack_t p;
xforth_t x;
CHECK_DEPTH(env, 1, "rx@");
p = TOS;
if (!check_address_abuse(env, p, "rx@", 1, xfetch)) {
p = POP(DS);
push_xforth(env, (xforth_t)fc_reg_read(env, "rx@", p, NULL));
}
}
void
get_token(fcode_env_t *env)
{
fstack_t tok;
fstack_t immediate = 0;
CHECK_DEPTH(env, 1, "get-token");
tok = POP(DS);
tok &= MAX_FCODE;
PUSH(DS, (fstack_t)env->table[tok].apf);
if (env->table[tok].flags & IMMEDIATE) immediate = 1;
PUSH(DS, immediate);
}
/*
* rx! ( xv xa -- )
*/
static void
rxstore(fcode_env_t *env)
{
fstack_t p;
xforth_t d;
CHECK_DEPTH(env, 2, "rx!");
p = TOS;
if (!check_address_abuse(env, p, "rx!", 1, xstore)) {
p = POP(DS);
d = pop_xforth(env);
fc_reg_write(env, "rx!", p, d, NULL);
}
}
static void
do_get_hwd_va(fcode_env_t *env)
{
private_data_t *pdp = DEVICE_PRIVATE(env);
char *service = "get-hwd-va";
char *buf;
uint32_t portid = 0;
int ch;
int error;
fc_cell_t status;
void *hwd_va;
CHECK_DEPTH(env, 2, "jupiter:get-hwd-va");
/* Get a portid with string format */
buf = pop_a_string(env, NULL);
/* Convert to the integer from the string */
if (sscanf(buf, "%x", &portid) != 1) {
throw_from_fclib(env, 1, "jupiter:%s: invalid portid",
service);
}
ch = OPL_PORTID_TO_CHANNEL(portid);
if (!OPL_VALID_CHANNEL(ch)) {
throw_from_fclib(env, 1, "jupiter:%s: invalid poritd",
service);
hwd_va = 0;
goto out;
}
if (ch == OPL_CMU_CHANNEL) {
hwd_va = (void *)&hwd_va_cmu;
} else {
hwd_va = (void *)&hwd_va_pci;
}
/*
* Get the virtual address of hwd specified with portid.
*/
error = fc_run_priv(pdp->common, service, 2, 1,
fc_uint32_t2cell(portid), fc_ptr2cell(hwd_va), &status);
if (error || !status)
throw_from_fclib(env, 1, "jupiter:%s: failed\n", service);
out:
PUSH(DS, (fstack_t)hwd_va);
}
/*
* (is-user-word) ( name-str name-len xt -- )
*/
void
is_user_word(fcode_env_t *env)
{
fstack_t xt;
char *name;
int len;
CHECK_DEPTH(env, 3, "(is-user-word)");
xt = POP(DS);
name = pop_a_string(env, &len);
header(env, name, len, 0);
COMPILE_TOKEN(&do_alias);
COMPILE_TOKEN(xt);
expose_acf(env, name);
}
void
perform_action(fcode_env_t *env)
{
int n;
acf_t a;
CHECK_DEPTH(env, 2, "perform_action");
n = POP(DS);
a = (acf_t)POP(DS);
PUSH(DS, (fstack_t)ACF_TO_BODY(a));
if (run_action(env, a, n)) {
system_message(env, "Bad Object action");
}
}
