void tcsipcall_hangup(struct tcsipcall*call) {
if(call->sess) call->sess = mem_deref(call->sess);
if(!call->reason && (call->cstate & CSTATE_EST)==CSTATE_EST)
call->reason = CEND_OK;
if(!call->reason && (call->cstate & CSTATE_EST)==0)
call->reason = CEND_HANG;
DROP(call->cstate, CSTATE_ALIVE);
DROP(call->cstate, CSTATE_EST);
/*
* Call terminated
* Remote party dropped something heavy
* on red button
* */
if(call->media) {
tcmedia_stop(call->media);
call->media = mem_deref(call->media);
}
call->handler(call, call->handler_arg);
tcsipcall_remove(call);
mem_deref(call);
}
int main()
{
START_MACHINE;
JUMP(CONTINUE);
#include "char.lib"
#include "io.lib"
#include "math.lib"
#include "string.lib"
#include "system.lib"
#include "scheme.lib"
CONTINUE:
/* initialize the 4 singletons */
PUSH(IMM(1));
CALL(MAKE_SOB_BOOL); /* define SOB_BOOL_TRUE in mem[1]*/
DROP(1);
PUSH(IMM(0));
CALL(MAKE_SOB_BOOL); /* define SOB_BOOL_FALSE in mem[3]*/
DROP(1);
CALL(MAKE_SOB_NIL); /* define nil in mem[5] */
CALL(MAKE_SOB_VOID); /* define #Void in mem[6] */
/* start of code */
/* CALL(MAKE_SOB_NIL); */
/* MOV(R0, IND(IMM(4))); */
MOV(R0, IMM(5));
PUSH(R0);
CALL(IS_SOB_TRUE);
CMP(R0, IMM(1)); /* 1 means R0 was true, 0 means it
was #f */
JUMP_EQ(Lelse1);
PUSH(IMM(1));
CALL(MAKE_SOB_BOOL);
JUMP(Lexit1);
Lelse1:
PUSH(IMM(0));
CALL(MAKE_SOB_BOOL);
Lexit1:
PUSH(R0);
CALL(WRITE_SOB);
/* newline and stop machine */
PUSH(IMM('\n'));
CALL(PUTCHAR);
STOP_MACHINE;
return 0;
}
/*
- p_bre - BRE parser top level, anchoring and concatenation
* Giving end1 as OUT essentially eliminates the end1/end2 check.
*
* This implementation is a bit of a kludge, in that a trailing $ is first
* taken as an ordinary character and then revised to be an anchor. The
* only undesirable side effect is that '$' gets included as a character
* category in such cases. This is fairly harmless; not worth fixing.
* The amount of lookahead needed to avoid this kludge is excessive.
*/
static void
p_bre(struct parse *p,
int end1, /* first terminating character */
int end2) /* second terminating character */
{
sopno start = HERE();
int first = 1; /* first subexpression? */
int wasdollar = 0;
if (EAT('^')) {
EMIT(OBOL, 0);
p->g->iflags |= USEBOL;
p->g->nbol++;
}
while (MORE() && !SEETWO(end1, end2)) {
wasdollar = p_simp_re(p, first);
first = 0;
}
if (wasdollar) { /* oops, that was a trailing anchor */
DROP(1);
EMIT(OEOL, 0);
p->g->iflags |= USEEOL;
p->g->neol++;
}
REQUIRE(HERE() != start, REG_EMPTY); /* require nonempty */
}
void mu_set_termios_even_parity()
{
struct termios *pti = (struct termios *) TOP;
pti->c_cflag |= (PARENB); /* enable parity */
pti->c_cflag &= ~(PARODD); /* even parity */
DROP(1);
}
/* find ( a u chain - a u 0 | code -1) */
void mu_find()
{
char *token = (char *) ST2;
cell length = ST1;
struct dict_entry *pde = (struct dict_entry *)TOP;
/*
* Only search if length < 128. This prevents us from matching hidden
* entries!
*/
if (length < 128)
{
while ((pde = (struct dict_entry *)pde->n.link) != NULL)
{
/* for speed, don't test anything else unless lengths match */
if (pde->n.length != length) continue;
/* lengths match - compare strings */
if ((*match)(pde->n.suffix + SUFFIX_LEN - length, token, length) != 0)
continue;
/* found: drop token, push code address and true flag */
DROP(1);
ST1 = (addr)&pde->code;
TOP = -1;
return;
}
}
/* not found: leave token, push false */
TOP = 0;
}
/* (name) ( link a u hidden - 'suffix) */
void mu_name_()
{
struct dict_name *pnm = new_name(
(struct dict_name *)ST3, (char *)ST2, ST1, TOP);
DROP(3);
TOP = (addr)pnm;
}
/*
* usb-find-device (vendor-id product-id -- handle -1 | 0)
*/
void mu_usb_find_device()
{
int matched;
/* Enumerate USB device tree, looking for a match */
matched = enumerate_devices(ST1, TOP);
/*
* enumerate_devices only returns failure (-1) if it found a match but
* couldn't open the device for read & write. Tell the user about the
* error.
*/
if (matched < 0) return abort_strerror();
if (matched == 0)
{
/* No match found */
DROP(1);
TOP = 0;
}
else
{
/* Matched; return the device's _open_ file descriptor */
ST1 = matched;
TOP = -1;
}
}
/*
* This is bogus, ridiculously dangerous and unportable, and for testing
* only. But here it is: A generic ioctl interface!
*/
void mu_ioctl() /* fd ioctl arg */
{
if (ioctl(ST2, ST1, TOP) == -1)
return abort_strerror();
DROP(3);
}
/*
* usb-control (bmRequestType bRequest wValue wIndex wLength 'buffer device - count)
*/
void mu_usb_control()
{
struct usb_ctl_request ucr;
int fd;
#define req ucr.ucr_request
req.bmRequestType = SP[6];
req.bRequest = SP[5];
USETW(req.wValue, SP[4]);
USETW(req.wIndex, ST3);
USETW(req.wLength, ST2);
ucr.ucr_data = (void *)ST1;
ucr.ucr_addr = 0;
ucr.ucr_flags = (req.bmRequestType == UT_READ_DEVICE)
? USBD_SHORT_XFER_OK : 0;
fd = TOP;
DROP(6);
if (ioctl(fd, USB_DO_REQUEST, &ucr) == -1)
{
TOP = 0; /* count of bytes transferred */
return abort_strerror();
}
TOP = ucr.ucr_actlen; /* actual length transferred */
}
void mu_do_() /* (do) ( limit start) */
{
RPUSH((addr)_STAR(IP++)); /* push following branch address for (leave) */
RPUSH(ST1); /* limit */
RPUSH(TOP - ST1); /* index = start - limit */
DROP(2);
}
/*
* mu_read_file mmaps the file and returns its contents as a string
*/
void mu_read_file() /* fd - addr len */
{
char *p = NULL;
struct stat s;
int fd;
fd = TOP;
if (fstat(fd, &s) == -1)
{
close(fd);
return abort_strerror();
}
/* If size of file is zero, don't try to mmap; it will fail and error
* out. Instead, simply return a buffer starting at address 0, of
* length 0.
*/
if (s.st_size != 0)
{
p = (char *) mmap(0, s.st_size, PROT_READ, MAP_PRIVATE, fd, 0);
if (p == MAP_FAILED)
{
close(fd);
return abort_strerror();
}
}
DROP(-1);
ST1 = (addr) p;
TOP = s.st_size;
}
/* stack: ( fd termios - sizeof(termios) ) */
void mu_get_termios()
{
tcgetattr(ST1, (struct termios *)TOP);
DROP(1);
TOP = sizeof(struct termios);
}
/* stack: ( speed termios - ) */
void mu_set_termios_speed()
{
struct termios *pti = (struct termios *) TOP;
#define BPS(x) case x: ST1 = B ## x; break
switch(ST1)
{
BPS( 4800);
BPS( 9600);
BPS( 19200);
BPS( 38400);
BPS( 57600);
BPS(115200);
BPS(230400);
default:
return abort_zmsg("Unsupported speed");
}
#ifdef __CYGWIN__
/* Cygwin lacks cfsetspeed, so do it by hand. */
pti->c_ospeed = pti->c_ispeed = ST1;
#else
cfsetspeed(pti, ST1);
#endif
DROP(2);
}
void mu_interpret()
{
source.start = (char *)ST1;
source.end = (char *)ST1 + TOP;
DROP(2);
first = source.start;
for (;;)
{
mu_token();
if (TOP == 0) break;
consume();
mu_qstack();
}
DROP(2);
}
/* stack: ( fd termios - ) */
void mu_set_termios()
{
/* drain out, flush in, set */
if (tcsetattr(ST1, TCSAFLUSH, (struct termios *)TOP) == -1)
return abort_strerror();
DROP(2);
}
void mu_close_file()
{
while (close(TOP) == -1)
{
if (errno == EINTR) continue;
return abort_strerror();
}
DROP(1);
}
int main()
{
START_MACHINE;
JUMP(CONTINUE);
#include "char.lib"
#include "io.lib"
#include "math.lib"
#include "string.lib"
#include "system.lib"
#include "scheme.lib"
CONTINUE:
PUSH(IMM(64));
CALL(MALLOC);
SHOW("MALLOC RETURNED ", R0);
DROP(1);
PUSH(R0);
OUT(IMM(2), IMM('?'));
OUT(IMM(2), IMM(' '));
CALL(READLINE);
SHOW("READ IN STRING AT ADDRESS ", R0);
PUSH(R0);
CALL(STRING_TO_NUMBER);
DROP(1);
SHOW("READ IN ", R0);
MUL(R0, R0);
SHOW("SQUARE IS ", R0);
PUSH(R0);
CALL(NUMBER_TO_STRING);
DROP(1);
PUSH(R0);
SHOW("STR[0] = ", INDD(R0, 0));
SHOW("STR[1] = ", INDD(R1, 0));
SHOW("STR[2] = ", INDD(R2, 0));
SHOW("STR[3] = ", INDD(R3, 0));
CALL(WRITELN);
DROP(1);
STOP_MACHINE;
return 0;
}
void mu_set_termios_target_raw()
{
struct termios *pti = (struct termios *) TOP;
set_termios_raw(pti);
pti->c_cflag &= ~(CRTSCTS); /* no handshaking */
pti->c_cflag |= (CLOCAL); /* no modem signalling */
pti->c_cc[VMIN] = 0; /* return even if no chars avail */
pti->c_cc[VTIME] = 20; /* timeout in decisecs */
DROP(1);
}
void mu_set_termios_user_raw()
{
struct termios *pti = (struct termios *) TOP;
set_termios_raw(pti);
pti->c_oflag |= (OPOST); /* set opost, so newlines become CR/LF */
pti->c_lflag |= (ISIG); /* accept special chars and gen signals */
pti->c_cc[VMIN] = 1;
pti->c_cc[VTIME] = 0;
DROP(1);
}
/*
* This version of interpret is -not- exported to Forth! We are going to
* re-define it in Forth so it executes as "pure" Forth, and we can use
* Forth-side, return-stack-based exception handling!
*
* Oddly enough, the Forth implementation will be be *exactly* the same!
* The only difference is that it will be executing in Forth, so we can use
* R stack tricks to change its behaviour.
*/
static void muboot_interpret()
{
for (;;)
{
mu_token();
if (TOP == 0) break;
mu_consume();
muboot_show_stack();
}
DROP(2);
}
void mu_plus_loop_() /* (+loop) ( incr) */
{
cell rtop = RP[0];
cell prev = rtop;
rtop += TOP; /* increment index */
if ((rtop ^ prev) < 0) /* current & prev index have opposite signs */
{ IP++; RP += 3; } /* skip branch, pop R stack */
else
{ RP[0] = rtop; BRANCH; } /* update index, branch back */
DROP(1);
}
/* time and date */
static void push_forth_time_from_libc_time (struct tm *ptm, char *tz)
{
DROP(-8);
TOP = strlen (tz);
ST1 = (addr) tz;
ST2 = ptm->tm_sec;
ST3 = ptm->tm_min;
SP[4] = ptm->tm_hour;
SP[5] = ptm->tm_yday; /* 0 to 365 */
SP[6] = ptm->tm_mday;
SP[7] = ptm->tm_mon; /* 0 to 11 */
SP[8] = ptm->tm_year + 1900;
}
/*
* We need a way to do short sleeps for talking to sensitive hardware
* targets (like the Freescale HC908 series). I'm not getting good data
* from the bootloader, and wondering if some short pauses would help.
*/
void mu_nanosleep()
{
struct timespec ts;
ts.tv_sec = ST1;
ts.tv_nsec = TOP;
while (nanosleep(&ts, &ts) == -1)
{
if (errno == EINTR) continue;
return abort_strerror();
}
DROP(2);
}
void ZBRANCH()
{
SWAP();
if (pop(PSP) == 0)
{
BRANCH();
}
else
{
DROP();
}
}
/* This is for testing - to see what libc considers raw mode. */
void mu_raw_termios()
{
struct termios before;
struct termios after;
int i;
ioctl(0, TIOCGETA, &before);
ioctl(0, TIOCGETA, &after);
cfmakeraw(&after);
for (i = 0; i < 4; i++)
STK(-i-1) = ((uint *)&before)[i] ^ ((uint *)&after)[i];
DROP(-4);
}
static void mu_open_file() /* C-string-name flags - fd */
{
int fd;
char pathbuf[1024];
char *path = abs_path((char *)ST1, pathbuf, 1024);
if (path == NULL)
return abort_zmsg("path too long");
fd = open(path, TOP);
if (fd == -1)
return abort_strerror();
DROP(1);
TOP = fd;
}
Cell translate(Cell t)
{
if (!ispair(t))
return t;
if (car(t) == LAMBDA)
return unabstract(translate(cdr(t)));
else {
Cell s;
PUSH(cdr(t));
PUSH(translate(car(t)));
s = translate(PUSHED(1));
s = pair(TOP, s);
DROP(2);
return s;
}
}
static void mu_return_token(char *last, int trailing)
{
/* Get address and length of the token */
parsed.data = first;
parsed.length = last - first;
/* Account for characters processed, return token */
first = last + trailing;
DROP(-2);
ST1 = (addr) parsed.data;
TOP = parsed.length;
#ifdef DEBUG_TOKEN
/* Without these casts, this doesn't work! */
fprintf(stderr, "%.*s\n", (int)TOP, (char *)ST1);
#endif
}
void mu_read_carefully() /* fd buffer len -- #read */
{
int fd;
char *buffer;
size_t len;
ssize_t count;
fd = ST2;
buffer = (char *) ST1;
len = TOP;
DROP(2);
while((count = read(fd, buffer, len)) == -1)
{
if (errno == EINTR) continue;
return abort_strerror();
}
TOP = count;
}
/*
* usb-request (bmRequestType bRequest wValue wIndex wLength 'buffer device)
* XXX should return actual length of transfer?
*/
void mu_usb_request()
{
struct usb_ctl_request ucr;
int fd;
#define req ucr.ucr_request
req.bmRequestType = SP[6];
req.bRequest = SP[5];
USETW(req.wValue, SP[4]);
USETW(req.wIndex, ST3);
USETW(req.wLength, ST2);
ucr.ucr_data = (void *)ST1;
ucr.ucr_addr = 0;
ucr.ucr_flags = (req.bmRequestType == UT_READ_DEVICE)
? USB_SHORT_XFER_OK : 0;
fd = TOP;
DROP(7);
if (ioctl(fd, USB_DO_REQUEST, &ucr) == -1) return abort_strerror();
}
