static void ficlPrimitiveFileSize(ficlVm *vm) /* ( fileid -- ud ior ) */
{
ficlFile *ff = (ficlFile *)ficlStackPopPointer(vm->dataStack);
long ud = ficlFileSize(ff);
ficlStackPushInteger(vm->dataStack, ud);
pushIor(vm, ud != -1);
}
static void ficl_sysDcrCr0Get(ficlVm *vm)
{
uint32_t val;
FICL_STACK_CHECK(vm->dataStack,0,1);
val = sysDcrCr0Get();
ficlStackPushInteger(vm->dataStack,val);
}
static void ficl_sysDcrEbcGet(ficlVm *vm)
{
uint32_t addr, val;
FICL_STACK_CHECK(vm->dataStack,1,1);
addr = ficlStackPopInteger(vm->dataStack);
val = sysDcrEbcGet(addr);
ficlStackPushInteger(vm->dataStack,val);
}
static void pushIor(ficlVm *vm, int success)
{
int ior;
if (success)
ior = 0;
else
ior = errno;
ficlStackPushInteger(vm->dataStack, ior);
}
static void ficlPrimitiveFileStatus(ficlVm *vm) /* ( c-addr u -- x ior ) */
{
int status;
int ior;
int length = ficlStackPopInteger(vm->dataStack);
void *address = (void *)ficlStackPopPointer(vm->dataStack);
char *filename = (char *)malloc(length + 1);
memcpy(filename, address, length);
filename[length] = 0;
ior = ficlFileStatus(filename, &status);
free(filename);
ficlStackPushInteger(vm->dataStack, status);
ficlStackPushInteger(vm->dataStack, ior);
}
static void ficlPrimitiveReadFile(ficlVm *vm) /* ( c-addr u1 fileid -- u2 ior ) */
{
ficlFile *ff = (ficlFile *)ficlStackPopPointer(vm->dataStack);
int length = ficlStackPopInteger(vm->dataStack);
void *address = (void *)ficlStackPopPointer(vm->dataStack);
int result;
clearerr(ff->f);
result = fread(address, 1, length, ff->f);
ficlStackPushInteger(vm->dataStack, result);
pushIor(vm, ferror(ff->f) == 0);
}
static void ficlFileOpen(ficlVm *vm, char *writeMode) /* ( c-addr u fam -- fileid ior ) */
{
int fam = ficlStackPopInteger(vm->dataStack);
int length = ficlStackPopInteger(vm->dataStack);
void *address = (void *)ficlStackPopPointer(vm->dataStack);
char mode[4];
FILE *f;
char *filename = (char *)malloc(length + 1);
memcpy(filename, address, length);
filename[length] = 0;
*mode = 0;
switch (FICL_FAM_OPEN_MODE(fam))
{
case 0:
ficlStackPushPointer(vm->dataStack, NULL);
ficlStackPushInteger(vm->dataStack, EINVAL);
goto EXIT;
case FICL_FAM_READ:
strcat(mode, "r");
break;
case FICL_FAM_WRITE:
strcat(mode, writeMode);
break;
case FICL_FAM_READ | FICL_FAM_WRITE:
strcat(mode, writeMode);
strcat(mode, "+");
break;
}
strcat(mode, (fam & FICL_FAM_BINARY) ? "b" : "t");
f = fopen(filename, mode);
if (f == NULL)
ficlStackPushPointer(vm->dataStack, NULL);
else
{
ficlFile *ff = (ficlFile *)malloc(sizeof(ficlFile));
strcpy(ff->filename, filename);
ff->f = f;
ficlStackPushPointer(vm->dataStack, ff);
fseek(f, 0, SEEK_SET);
}
pushIor(vm, f != NULL);
EXIT:
free(filename);
}
static void ficlPrimitiveReadLine(ficlVm *vm) /* ( c-addr u1 fileid -- u2 flag ior ) */
{
ficlFile *ff = (ficlFile *)ficlStackPopPointer(vm->dataStack);
int length = ficlStackPopInteger(vm->dataStack);
char *address = (char *)ficlStackPopPointer(vm->dataStack);
int error;
int flag;
if (feof(ff->f))
{
ficlStackPushInteger(vm->dataStack, -1);
ficlStackPushInteger(vm->dataStack, 0);
ficlStackPushInteger(vm->dataStack, 0);
return;
}
clearerr(ff->f);
*address = 0;
fgets(address, length, ff->f);
error = ferror(ff->f);
if (error != 0)
{
ficlStackPushInteger(vm->dataStack, -1);
ficlStackPushInteger(vm->dataStack, 0);
ficlStackPushInteger(vm->dataStack, error);
return;
}
length = strlen(address);
flag = (length > 0);
if (length && ((address[length - 1] == '\r') || (address[length - 1] == '\n')))
length--;
ficlStackPushInteger(vm->dataStack, length);
ficlStackPushInteger(vm->dataStack, flag);
ficlStackPushInteger(vm->dataStack, 0); /* ior */
}
/*
* s e a r c h - w o r d l i s t
* SEARCH ( c-addr u wid -- 0 | xt 1 | xt -1 )
* Find the definition identified by the string c-addr u in the word list
* identified by wid. If the definition is not found, return zero. If the
* definition is found, return its execution token xt and one (1) if the
* definition is immediate, minus-one (-1) otherwise.
*/
static void
ficlPrimitiveSearchWordlist(ficlVm *vm)
{
ficlString name;
ficlUnsigned16 hashCode;
ficlWord *word;
ficlHash *hash = ficlStackPopPointer(vm->dataStack);
name.length = (ficlUnsigned8)ficlStackPopUnsigned(vm->dataStack);
name.text = ficlStackPopPointer(vm->dataStack);
hashCode = ficlHashCode(name);
ficlDictionaryLock(ficlVmGetDictionary(vm), FICL_TRUE);
word = ficlHashLookup(hash, name, hashCode);
ficlDictionaryLock(ficlVmGetDictionary(vm), FICL_FALSE);
if (word) {
ficlStackPushPointer(vm->dataStack, word);
ficlStackPushInteger(vm->dataStack,
(ficlWordIsImmediate(word) ? 1 : -1));
} else {
ficlStackPushUnsigned(vm->dataStack, 0);
}
}
FICL_PLATFORM_EXTERN void stackPushINT (ficlStack *stack, ficlInteger i) { ficlStackPushInteger(stack, i); }
/*
* Shim for taking commands from BF and passing them out to 'standard'
* argv/argc command functions.
*/
static void
bf_command(ficlVm *vm)
{
char *name, *line, *tail, *cp;
size_t len;
struct bootblk_command **cmdp;
bootblk_cmd_t *cmd;
int nstrings, i;
int argc, result;
char **argv;
/* Get the name of the current word */
name = vm->runningWord->name;
/* Find our command structure */
cmd = NULL;
SET_FOREACH(cmdp, Xcommand_set) {
if (((*cmdp)->c_name != NULL) &&
strcmp(name, (*cmdp)->c_name) == 0)
cmd = (*cmdp)->c_fn;
}
if (cmd == NULL)
panic("callout for unknown command '%s'", name);
/* Check whether we have been compiled or are being interpreted */
if (ficlStackPopInteger(ficlVmGetDataStack(vm))) {
/*
* Get parameters from stack, in the format:
* an un ... a2 u2 a1 u1 n --
* Where n is the number of strings, a/u are pairs of
* address/size for strings, and they will be concatenated
* in LIFO order.
*/
nstrings = ficlStackPopInteger(ficlVmGetDataStack(vm));
for (i = 0, len = 0; i < nstrings; i++) {
ficlStack *stack = ficlVmGetDataStack(vm);
len += ficlStackFetch(stack, i * 2).i + 1;
}
line = malloc(strlen(name) + len + 1);
strcpy(line, name);
if (nstrings)
for (i = 0; i < nstrings; i++) {
ficlStack *stack = ficlVmGetDataStack(vm);
len = ficlStackPopInteger(stack);
cp = ficlStackPopPointer(stack);
strcat(line, " ");
strncat(line, cp, len);
}
} else {
/* Get remainder of invocation */
tail = ficlVmGetInBuf(vm);
len = 0;
cp = tail;
for (; cp != vm->tib.end && *cp != 0 && *cp != '\n'; cp++)
len++;
line = malloc(strlen(name) + len + 2);
strcpy(line, name);
if (len > 0) {
strcat(line, " ");
strncat(line, tail, len);
ficlVmUpdateTib(vm, tail + len);
}
}
DPRINTF("cmd '%s'", line);
command_errmsg = command_errbuf;
command_errbuf[0] = 0;
if (!parse(&argc, &argv, line)) {
result = (cmd)(argc, argv);
free(argv);
} else {
result = BF_PARSE;
}
switch (result) {
case CMD_CRIT:
printf("%s\n", command_errmsg);
command_errmsg = NULL;
break;
case CMD_FATAL:
panic("%s", command_errmsg);
}
free(line);
/*
* If there was error during nested ficlExec(), we may no longer have
* valid environment to return. Throw all exceptions from here.
*/
if (result != CMD_OK)
ficlVmThrow(vm, result);
/* This is going to be thrown!!! */
ficlStackPushInteger(ficlVmGetDataStack(vm), result);
}
static void ficl_fifo_return_status(ficlVm *vm)
{
FICL_STACK_CHECK(vm->dataStack,0,1);
ficlStackPushInteger(vm->dataStack,fifo_status);
}
