// (term-prinl ['num 'num] 'any ..) -> any
any plisp_term_prinl(any ex) {
any x, y;
long n1, n2;
// if number of args > 1, we accept
// a min of 3 args - x, y and the value
// to print.
if (plen(ex) > 1 && isNum(cadr(ex)) && isNum(caddr(ex))) {
x = cdr(ex), y = EVAL(car(x));
NeedNum(ex, y);
n1 = unBox(y); // we get x here.
x = cdr(x), y = EVAL(car(x));
NeedNum(ex, y);
n2 = unBox(y); // we get y here.
term_gotoxy(n1, n2);
// now, get the rest of the params
// and prinl.
while (isCell(x = cdr(x)))
ptermh_prin(y = EVAL(car(x)));
} else {
// We don't have the coordinates.
// we just print the first value
// in the list (including NIL).
x = cdr(ex), y = EVAL(car(x));
ptermh_prin(y);
while (isCell(x = cdr(x)))
ptermh_prin(y = EVAL(car(x)));
}
newline();
return y;
}
// (adc-setclock 'num 'num 'num) -> num
any plisp_adc_setclock(any ex) {
s32 sfreq; // signed version for negative checking.
u32 freq;
unsigned id, timer_id = 0;
any x, y;
x = cdr(ex);
NeedNum(ex, y = EVAL(car(x)));
id = unBox(y); // get adc id.
MOD_CHECK_ID(ex, adc, id);
x = cdr(x);
NeedNum(ex, y = EVAL(car(x)));
sfreq = unBox(y); // get frequency.
if (sfreq < 0)
err(ex, y, "frequency must be 0 or positive");
freq = (u32) sfreq;
if (freq > 0) {
x = cdr(x);
NeedNum(ex, y = EVAL(car(x)));
timer_id = unBox(y); // get timer id.
MOD_CHECK_ID(ex, timer, timer_id);
MOD_CHECK_RES_ID(ex, adc, id, timer, timer_id);
}
platform_adc_set_timer(id, timer_id);
freq = platform_adc_set_clock(id, freq);
return box(freq);
}
// (tmr-delay ['num] 'num) -> Nil
any tmr_delay(any ex) {
timer_data_type period;
unsigned id = PLATFORM_TIMER_SYS_ID;
any x, y;
x = cdr(ex), y = EVAL(car(x));
if (plen(ex) == 1) {
// We only have 1 parameter. Assume
// *tmr-sys-timer* and get the time
// period.
NeedNum(ex, y);
period = (timer_data_type)unBox(y);
} else {
// Minimum 2 args required here - the
// id and the period. Ignore the others.
NeedNum(ex, y);
id = unBox(y);
MOD_CHECK_TIMER(ex, id);
x = cdr(x), y = EVAL(car(x));
NeedNum(ex, y);
period = unBox(y);
}
platform_timer_delay(id, period);
return Nil;
}
// (term-moveto 'num 'num) -> Nil
any plisp_term_moveto(any ex) {
any x, y;
long n1, n2;
x = cdr(ex), y = EVAL(car(x));
NeedNum(ex, y);
n1 = unBox(y);
x = cdr(x), y = EVAL(car(x));
NeedNum(ex, y);
n2 = unBox(y);
term_gotoxy(n1, n2);
return Nil;
}
// (adc-setblocking 'num 'num) -> Nil
any plisp_adc_setblocking(any ex) {
unsigned id, mode;
any x, y;
x = cdr(ex);
NeedNum(ex, y = EVAL(car(x)));
id = unBox(y); // get id.
MOD_CHECK_ID(ex, adc, id);
x = cdr(x);
NeedNum(ex, y = EVAL(car(x)));
mode = unBox(y); // get mode.
platform_adc_set_blocking(id, mode);
return Nil;
}
// (tmr-getdiffnow 'num 'num) -> num
any tmr_getdiffnow(any ex) {
timer_data_type start, res;
unsigned id;
any x, y;
x = cdr(ex), y = EVAL(car(x));
NeedNum(ex, y);
id = unBox(y); // get id.
MOD_CHECK_TIMER(ex, id);
x = cdr(x), y = EVAL(car(x));
NeedNum(ex, y);
start = unBox(y); // get start.
res = platform_timer_get_diff_crt(id, start);
return box(res);
}
// (tmr-setclock 'num 'num) -> num
any tmr_setclock(any ex) {
u32 clock;
unsigned id;
any x, y;
x = cdr(ex), y = EVAL(car(x));
NeedNum(ex, y);
id = unBox(y); // get id.
MOD_CHECK_TIMER(ex, id);
x = cdr(x), y = EVAL(car(x));
NeedNum(ex, y);
clock = unBox(y); // get clock.
clock = platform_timer_op(id, PLATFORM_TIMER_OP_SET_CLOCK, clock);
return box(clock);
}
// (adc-sample 'num 'num) -> Nil
any plisp_adc_sample(any ex) {
unsigned id, count = 0, nchans = 1;
int res, i;
any x, y, s;
// get count value, the second parameter
// in the picoLisp function call.
s = cdr(ex), y = EVAL(car(s)); s = cdr(s);
NeedNum(ex, y = EVAL(car(s)));
count = unBox(y);
// validate count.
if ((count == 0) || count & (count - 1))
err(ex, y, "count must be power of 2 and > 0");
// get first parameter in the function
// call.
x = cdr(ex), y = EVAL(car(x));
// If first parameter is a table,
// extract channel list.
if (isCell(y)) {
nchans = length(y);
for (i = 0; i < nchans; i++) {
NeedNum(y, car(y));
id = unBox(car(y));
MOD_CHECK_ID(ex, adc, id);
res = adc_setup_channel(id, intlog2(count));
if (res != PLATFORM_OK)
err(ex, y, "sampling setup failed");
}
// initiate sampling.
platform_adc_start_sequence();
} else if (isNum(y)) {
NeedNum(ex, y);
id = unBox(y);
MOD_CHECK_ID(ex, adc, id);
res = adc_setup_channel(id, intlog2(count));
if (res != PLATFORM_OK)
err(ex, y, "sampling setup failed");
platform_adc_start_sequence();
} else {
err(ex, y, "invalid channel selection");
}
return Nil;
}
// (term-movedown 'num) -> Nil
any plisp_term_movedown(any ex) {
any x, y;
long n;
x = cdr(ex), y = EVAL(car(x));
NeedNum(ex, y);
n = unBox(y);
term_down(n);
return Nil;
}
// (spi-ssoff 'num) -> Nil
any plisp_spi_ssoff(any ex) {
unsigned id;
any x, y;
x = cdr(ex);
NeedNum(ex, y = EVAL(car(x)));
id = unBox(y); // get id.
MOD_CHECK_ID(ex, spi, id);
platform_spi_select(id, PLATFORM_SPI_SELECT_OFF);
return Nil;
}
// (adc-isdone) -> T | Nil
any plisp_adc_isdone(any ex) {
unsigned id;
any x, y;
x = cdr(ex);
NeedNum(ex, y = EVAL(car(x)));
id = unBox(y); // get id.
MOD_CHECK_ID(ex, adc, id);
return platform_adc_is_done(id) == 0 ?
T : Nil;
}
// (tmr-gettimediff 'num 'num 'num) -> num
any tmr_gettimediff(any ex) {
timer_data_type start, end, res;
unsigned id = PLATFORM_TIMER_SYS_ID;
any x, y;
x = cdr(ex), y = EVAL(car(x));
NeedNum(ex, y);
id = unBox(y); // get id.
MOD_CHECK_TIMER(ex, id);
x = cdr(x), y = EVAL(car(x));
NeedNum(ex, y);
start = unBox(y); // get start.
x = cdr(x), y = EVAL(car(x));
NeedNum(ex, y);
end = unBox(y); // get end.
res = platform_timer_get_diff_us(id, start, end);
return box(res);
}
// (adc-maxval 'num) -> num
any plisp_adc_maxval(any ex) {
unsigned id;
u32 res;
any x, y;
x = cdr(ex);
NeedNum(ex, y = EVAL(car(x)));
id = unBox(y); // get id.
MOD_CHECK_ID(ex, adc, id);
res = platform_adc_get_maxval(id);
return box(res);
}
// (adc-setsmoothing 'num 'num) -> num
any plisp_adc_setsmoothing(any ex) {
unsigned id, length, res;
any x, y;
x = cdr(ex);
NeedNum(ex, y = EVAL(car(x)));
id = unBox(y); // get id.
MOD_CHECK_ID(ex, adc, id);
x = cdr(x);
NeedNum(ex, y = EVAL(car(x)));
length = unBox(y); // get length.
if (!(length & (length - 1))) {
res = platform_adc_set_smoothing(id, length);
if (res == PLATFORM_ERR)
err(ex, NULL, "Buffer allocation failed.");
else
return box(res);
} else {
err(ex, y, "Length must be power of 2");
}
}
// (spi-write 'num 'any) -> any
any plisp_spi_write(any ex) {
unsigned id;
any x, y;
x = cdr(ex);
NeedNum(ex, y = EVAL(car(x)));
id = unBox(y); // get id.
MOD_CHECK_ID(ex, spi, id);
x = cdr(x), y = EVAL(car(x));
plisp_spih_prin(id, y);
return y;
}
// (adc-getsamples 'num ['num]) -> lst
any plisp_adc_getsamples(any ex) {
#ifdef BUF_ENABLE_ADC
unsigned id, i;
u16 bcnt, count = 0;
any x, y;
cell c1;
x = cdr(ex);
NeedNum(ex, y = EVAL(car(x)));
id = unBox(y); // get id
MOD_CHECK_ID(ex, adc, id);
if (plen(ex) >= 2) {
x = cdr(x);
NeedNum(ex, y = EVAL(car(x)));
count = (u16)unBox(y); // get count
}
bcnt = adc_wait_samples(id, count);
// If count is zero, grab all samples
if (count == 0)
count = bcnt;
// Don't pull more samples than are available
if (count > bcnt)
count = bcnt;
// Make the list of adc samples
Push(c1, y = cons(box(adc_get_processed_sample(id)), Nil));
for (i = 1; i < count - 1; i++)
Push(c1, y = cons(box(adc_get_processed_sample(id)), y));
return Pop(c1);
#else
err(NULL, NULL, "BUF_ENABLE_ADC not defined");
#endif
}
// (adc-insertsamples 'num 'lst 'num 'num) -> lst
any plisp_adc_insertsamples(any ex) {
#ifdef BUF_ENABLE_ADC
unsigned id, i, startidx;
u16 bcnt, count;
any x, y, tab;
x = cdr(ex);
NeedNum(ex, y = EVAL(car(x)));
id = unBox(y); // get id
MOD_CHECK_ID(ex, adc, id);
// get the list of samples
x = cdr(x);
NeedLst(ex, y = EVAL(car(x)));
tab = y;
x = cdr(x);
NeedNum(ex, y = EVAL(car(x)));
startidx = unBox(y); // get startidx
if (startidx <= 0)
err(ex, y, "idx must be > 0");
x = cdr(x);
NeedNum(ex, y = EVAL(car(x)));
count = unBox(y); // get count
if (count == 0)
err(ex, y, "count must be > 0");
bcnt = adc_wait_samples(id, count);
for (i = startidx; i < (count + startidx); i++)
tab = ins_element(tab, i, adc_get_processed_sample(id));
return tab;
#else
err(NULL, NULL, "BUF_ENABLE_ADC not defined");
#endif
}
// (tmr-getclock ['num]) -> num
any tmr_getclock(any ex) {
timer_data_type res;
unsigned id = PLATFORM_TIMER_SYS_ID;
any x, y;
x = cdr(ex), y = EVAL(car(x));
if (plen(ex) > 0) {
NeedNum(ex, y);
id = unBox(y);
MOD_CHECK_TIMER(ex, id);
}
res = platform_timer_op(id, PLATFORM_TIMER_OP_GET_CLOCK, 0);
return box(res);
}
// (tmr-start ['num]) -> num
any tmr_start(any ex) {
unsigned id = PLATFORM_TIMER_SYS_ID;
timer_data_type res;
any x, y;
x = cdr(ex), y = EVAL(car(x));
if (plen(ex) > 0) {
NeedNum(ex, y);
id = unBox(y);
MOD_CHECK_TIMER(ex, id);
}
res = platform_timer_op(id, PLATFORM_TIMER_OP_START, 0);
return box(res);
}
// (adc-getsample 'num) -> num
any plisp_adc_getsample(any ex) {
unsigned id;
any x, y;
x = cdr(ex);
NeedNum(ex, y = EVAL(car(x)));
id = unBox(y); // get id.
MOD_CHECK_ID(ex, adc, id);
// If we have at least one sample, return it.
if (adc_wait_samples(id, 1) >= 1)
return box(adc_get_processed_sample(id));
return Nil;
}
// (term-getchar ['sym]) -> num
any plisp_term_getchar(any ex) {
any x, y;
int temp = TERM_INPUT_WAIT, ret;
// if number of args is > 0
// get value; else getchar()
// will wait.
if (plen(ex) > 0) {
x = cdr(ex);
NeedNum(ex, y = EVAL(car(x)));
return ((ret = term_getch(temp = unBox(y))) == -1?
Nil : box(ret));
}
return ((ret = term_getch(temp)) == -1?
Nil : box(ret));
}
static void plisp_spih_prin(unsigned id, any x) {
if (!isNil(x)) {
if (isNum(x))
outNum_spi(id, unBox(x));
else if (isSym(x)) {
int i, c;
word w;
u8 byte;
for (x = name(x), c = getByte1(&i, &w, &x); c; c = getByte(&i, &w, &x)) {
if (c != '^') {
byte = c;
platform_spi_send_recv(id, byte);
}
else if (!(c = getByte(&i, &w, &x))) {
byte = '^';
platform_spi_send_recv(id, byte);
}
else if (c == '?') {
byte = 127;
platform_spi_send_recv(id, byte);
}
else {
c &= 0x1F;
byte = (u8)c;
platform_spi_send_recv(id, byte);
}
}
}
else {
while (plisp_spih_prin(id, car(x)), !isNil(x = cdr(x))) {
if (!isCell(x)) {
plisp_spih_prin(id, x);
break;
}
}
}
}
}
static void ptermh_prin(any x) {
if (!isNil(x)) {
if (isNum(x))
outNum_term(unBox(x));
else if (isSym(x)) {
int i, c;
word w;
u8 byte;
for (x = name(x), c = getByte1(&i, &w, &x); c; c = getByte(&i, &w, &x)) {
if (c != '^') {
byte = c;
term_putch(byte);
}
else if (!(c = getByte(&i, &w, &x))) {
byte = '^';
term_putch(byte);
}
else if (c == '?') {
byte = 127;
term_putch(byte);
}
else {
c &= 0x1F;
byte = (u8)c;
term_putch(byte);
}
}
}
else {
while (ptermh_prin(car(x)), !isNil(x = cdr(x))) {
if (!isCell(x)) {
ptermh_prin(x);
break;
}
}
}
}
}
// (spi-setup 'num 'num 'num 'num 'num 'num) -> num
any plisp_spi_setup(any ex) {
unsigned id, cpol, cpha, is_master, databits;
u32 clock, res;
any x, y;
x = cdr(ex);
NeedNum(ex, y = EVAL(car(x)));
id = unBox(y); // get id.
MOD_CHECK_ID(ex, spi, id);
x = cdr(x);
NeedNum(ex, y = EVAL(car(x)));
is_master = unBox(y); // get type.
if (!is_master)
err(ex, y, "invalid type - only *spi-master* is supported");
x = cdr(x);
NeedNum(ex, y = EVAL(car(x)));
clock = unBox(y); // get clock.
x = cdr(x);
NeedNum(ex, y = EVAL(car(x)));
cpol = unBox(y); // clock polarity.
if ((cpol != 0) && (cpol != 1))
err(ex, y, "invalid clock polarity.");
x = cdr(x);
NeedNum(ex, y = EVAL(car(x)));
cpha = unBox(y); // clock phase.
if ((cpha != 0) && (cpha != 1))
err(ex, y, "invalid clock phase.");
x = cdr(x);
NeedNum(ex, y = EVAL(car(x)));
databits = unBox(y); // get databits.
res = platform_spi_setup(id,
is_master,
clock,
cpol,
cpha,
databits);
return box(res);
}
// (gc ['num]) -> num | NIL
any doGc(any x) {
x = cdr(x);
gc(isNum(x = EVAL(car(x)))? CELLS*unBox(x) : CELLS);
return x;
}
// (eval 'any ['cnt ['lst]]) -> any
any doEval(any x) {
any y;
cell c1;
bindFrame *p;
x = cdr(x), Push(c1, EVAL(car(x))), x = cdr(x);
if (!isNum(y = EVAL(car(x))) || !(p = Env.bind))
data(c1) = EVAL(data(c1));
else {
int cnt, n, i, j;
struct { // bindFrame
struct bindFrame *link;
int i, cnt;
struct {any sym; any val;} bnd[length(x)];
} f;
x = cdr(x), x = EVAL(car(x));
j = cnt = (int)unBox(y);
n = f.i = f.cnt = 0;
do {
++n;
if ((i = p->i) <= 0 && (p->i -= cnt, i == 0)) {
for (i = 0; i < p->cnt; ++i) {
y = val(p->bnd[i].sym);
val(p->bnd[i].sym) = p->bnd[i].val;
p->bnd[i].val = y;
}
if (p->cnt && p->bnd[0].sym == At && !--j)
break;
}
} while (p = p->link);
while (isCell(x)) {
for (p = Env.bind, j = n; ; p = p->link) {
if (p->i < 0)
for (i = 0; i < p->cnt; ++i) {
if (p->bnd[i].sym == car(x)) {
f.bnd[f.cnt].val = val(f.bnd[f.cnt].sym = car(x));
val(car(x)) = p->bnd[i].val;
++f.cnt;
goto next;
}
}
if (!--j)
break;
}
next: x = cdr(x);
}
f.link = Env.bind, Env.bind = (bindFrame*)&f;
data(c1) = EVAL(data(c1));
while (--f.cnt >= 0)
val(f.bnd[f.cnt].sym) = f.bnd[f.cnt].val;
Env.bind = f.link;
do {
for (p = Env.bind, i = n; --i; p = p->link);
if (p->i < 0 && (p->i += cnt) == 0)
for (i = p->cnt; --i >= 0;) {
y = val(p->bnd[i].sym);
val(p->bnd[i].sym) = p->bnd[i].val;
p->bnd[i].val = y;
}
} while (--n);
}
return Pop(c1);
}
