Skip to content

GitLab

Commit c0430935 authored by Dave Griffiths's avatar Dave Griffiths
Browse files

sorted out cons (converted to ifs) and added when

parent 58ea31bb
Hide whitespace changes
Inline Side-by-side
Showing with 252 additions and 64 deletions
README.md
View file @ c0430935
......@@ -52,10 +52,10 @@ The purpose of a Jellyfish Lisp program is to manipulate 3D objects in a
scene, move/rotate/scale or change vertex positions, lighting normals,
texture coords. It can also act on input from outside. It can do this
faster than in interpreted Scheme, particually on ARM devices as the VM
(written in C++) is very small and doesn't require any memory
allocation. The VM also has access to more data than a GPU shader,
although tight coupling to GPU functionality (ie running parts of the VM
on GPU cores) is planned.
(written in C++) is very small and doesn't require any memory allocation
so no garbage collection is required. The VM also has access to more
data than a GPU shader, although tight coupling to GPU functionality (ie
running parts of the VM on GPU cores) is planned.
Jellyfish Lisp programs are compiled to bytecode executed by the VM -
there is one per object potentially running in parallel threads. The
......@@ -95,20 +95,39 @@ Willdo...
(let ((name value) (name value) ...))
Note:
Scoping is not yet implemented, so all names are global.
True for function arguments also.
Normal binding of names to values. All values are vectors of lenght 3,
but can be specified as single numbers for convenience.
Tofix: Let bindings are not scoped correctly, varables can be referred
to after scope is closed and conflict with function parameters and other
let variables of the same name.
* define
(define name value)
Tofix: scoping problem same as let.
* if
(if pred true-expr false-expr)
Normal if expression - can be used as in normal scheme for example:
(define a (if (< 1 10) 100 200))
* when
(when pred do-this-block)
Returns the value of the last expression if true, zero otherwise.
* cond
(cond (pred block) (pred block) ...)
Note: currently evaluates all parts sequentially
Tofix: currently evaluates all parts sequentially, and sometimes doesn't
work remove and replace with syntatic version of 'if' forms...
* loop
* forever
......@@ -155,4 +174,4 @@ add sub mul div abs scs atn dot crs
sqr len dup drp cmp shf bld ret dbg
nrm mst mad msb swp rnd mull
jmr ldlv lensq noise lds sts mulv
synth-crt synth-con synth-ply flr
synth-crt synth-con synth-ply flr
assets/compiler.scm
View file @ c0430935
......@@ -195,22 +195,6 @@
(define (emit-addr x)
(emit (vector ldl (variable-address (cadr x)) 0)))
(define (emit-cond-part x)
(let ((block (emit-expr-list (cdr x))))
(append
(emit-expr (car x))
(emit (vector jmz (+ (length block) 1) 0))
block)))
(define (emit-cond x)
(define (_ l)
(cond
((null? l) '())
(else (append (emit-cond-part (car l))
(_ (cdr l))))))
(_ (cdr x)))
(define (emit-if x)
(let ((tblock (emit-expr (caddr x)))
(fblock (emit-expr (cadddr x))))
......@@ -221,6 +205,14 @@
(emit (vector jmr (+ (length fblock) 1) 0))
fblock)))
(define (emit-when x)
(let ((block (emit-expr-list (cddr x))))
(append
(emit-expr (cadr x))
(emit (vector jmz (+ (length block) 2) 0))
block
(emit (vector jmr 2 0))
(emit (vector ldl 0 0)))))
(define (emit-fncall x addr)
(let ((args (emit-expr-list-maintain-stack (cdr x))))
......@@ -458,8 +450,8 @@
(cond
((eq? (car x) 'let) (emit-let x))
((eq? (car x) 'define) (emit-define x))
((eq? (car x) 'cond) (emit-cond x))
((eq? (car x) 'if) (emit-if x))
((eq? (car x) 'when) (emit-when x))
((eq? (car x) 'loop) (emit-loop x))
((eq? (car x) 'do) (emit-expr-list (cdr x)))
(else (emit-procedure x)))
......@@ -554,6 +546,15 @@
(cdr x))))))))
(define (preprocess-cond-to-if x)
(define (_ l)
(cond
((null? l) 0)
((eq? (pre-process (caar l)) 'else) (cons 'do (pre-process (cdr (car l)))))
(else (list 'if (pre-process (caar l)) (cons 'do (pre-process (cdr (car l))))
(_ (cdr l))))))
(_ (cdr x)))
;; basically diy-macro from the main tinyscheme stuff
(define (pre-process s)
(cond
......@@ -571,6 +572,8 @@
((eq? (car i) '--!)
(let ((v (pre-process (cadr i))))
(list 'set! v (list '- v 1))))
((eq? (car i) 'cond)
(preprocess-cond-to-if i))
((eq? (car i) 'play-now)
(append
(list 'do)
......
assets/test.scm
View file @ c0430935
......@@ -4,9 +4,41 @@
'(let ((a 10))
(if (> a 0) (trace 1) (trace 0))
(if (< a 0) (trace 0) (trace 1))
(trace (read reg-control))
(write! 1000 (vector 999 999 999))
(trace (read reg-control))
(if (eq? (read 1000) (vector 999 999 999)) (trace 1) (trace 0))
(if (eq? (read 1000) (vector 990 999 999)) (trace 0) (trace 1))
(define zzz 99)
(when (eq? zzz 99) (trace 1))
(when (eq? zzz 88) (trace 0))
(let ((b 1))
(trace b))
(trace b) ;; <-- fixme!
(cond
((eq? 1 1) (trace 1))
((eq? 2 2) (trace 0)))
(cond
((eq? 2 1) (trace 0))
((eq? 2 2) (trace 1)))
(cond
((eq? 2 1) (trace 0))
((eq? 2 3) (trace 0))
(else (trace 1)))
(loop (< a 20)
(when (< a 15)
(write-add! 1000 1 2 3 4 5)
(trace 99)
)
(cond
((eq? 2 1) (trace 0))
((eq? 2 3) (trace 0))
(else (trace 1)))
(++! a)
)
))
(disassemble-compiled tests)
......
engine/nomadic.cpp
View file @ c0430935
......@@ -40,10 +40,13 @@ void appInit()
FILE *log_file=stdout;
scheme_set_input_port_file(sc, stdin);
#else
FILE *log_file=fopen("/sdcard/jellyfish-log.txt","w");
FILE *log_file=fopen("/sdcard/symbai/symbai-log2.txt","w");
#endif
#endif
if (log_file!=NULL) scheme_set_output_port_file(sc, log_file);
fprintf(log_file,"testing...\n");
fflush(log_file);
}
void initGL()
......
main.cpp
View file @ c0430935
......@@ -331,14 +331,14 @@ void DisplayCallback()
appRender(w, h);
glutSwapBuffers();
#endif
/*
static char fn[256];
sprintf(fn,"shot-%0.4d.jpg",frame_num);
cerr<<fn<<endl;
WriteJPG(GetScreenBuffer(0, 0, w, h, 1),
fn,"",0,0,w,h,95,1);
frame_num++;
*/
pthread_mutex_unlock(render_mutex);
} //else { printf("locked\n"); }
}
......
scheme/opdefines.h
View file @ c0430935
......@@ -196,6 +196,8 @@
_OP_DEF(opexe_6, "db-open", 1, 1, TST_NONE, OP_OPEN_DB )
_OP_DEF(opexe_6, "db-exec", 2, INF_ARG, TST_NONE, OP_EXEC_DB )
_OP_DEF(opexe_6, "db-insert", 2, INF_ARG, TST_NONE, OP_INSERT_DB )
// _OP_DEF(opexe_6, "db-insert-blob", 5, 5, TST_NONE, OP_INSERT_BLOB_DB )
// _OP_DEF(opexe_6, "db-select-blob", 5, 5, TST_NONE, OP_SELECT_BLOB_DB )
_OP_DEF(opexe_6, "db-status", 1, 1, TST_NONE, OP_STATUS_DB )
_OP_DEF(opexe_6, "time-of-day", 0, 0, TST_NONE, OP_TIME )
_OP_DEF(opexe_6, "date-time", 0, 0, TST_NONE, OP_DATETIME )
......
scheme/scheme.cpp
View file @ c0430935
......@@ -281,6 +281,9 @@ INTERFACE INLINE void setimmutable(pointer p) { typeflag(p) |= T_IMMUTABLE; }
#define cddr(p) cdr(cdr(p))
#define cadar(p) car(cdr(car(p)))
#define caddr(p) car(cdr(cdr(p)))
#define cadddr(p) car(cdr(cdr(cdr(p))))
#define caddddr(p) car(cdr(cdr(cdr(cdr(p)))))
#define cadddddr(p) car(cdr(cdr(cdr(cdr(cdr(p))))))
#define cdaar(p) cdr(car(car(p)))
#define cadaar(p) car(cdr(car(car(p))))
#define cadddr(p) car(cdr(cdr(cdr(p))))
......@@ -4279,6 +4282,118 @@ pointer db_exec(scheme* sc, db *d) {
return ret;
}
// blob stuff, unfortunately need to be prepared to match with eavdb
static int insert_blob(
sqlite3 *db, /* Database to insert data into */
const char *table, /* Null-terminated key string */
const char *key1, /* Null-terminated key string */
const char *key2, /* Null-terminated key string */
const unsigned char *blob, /* Pointer to blob of data */
int size /* Length of data pointed to by zBlob */
)
{
char sql[1024];
snprintf(sql,1024,"insert into %s_value_blob values(null, ?, ?, ?, 0)", table);
sqlite3_stmt *pStmt;
int rc;
do {
rc = sqlite3_prepare(db, sql, -1, &pStmt, 0);
if( rc!=SQLITE_OK ){
return rc;
}
sqlite3_bind_text(pStmt, 1, key1, -1, SQLITE_STATIC);
sqlite3_bind_text(pStmt, 2, key2, -1, SQLITE_STATIC);
sqlite3_bind_blob(pStmt, 3, blob, size, SQLITE_STATIC);
rc = sqlite3_step(pStmt);
rc = sqlite3_finalize(pStmt);
} while( rc==SQLITE_SCHEMA );
return rc;
}
int insert_file_blob(sqlite3 *db, const char *table, const char* key1, const char *key2, const char* filename) {
FILE *file=fopen(filename,"rb");
if (file)
{
fseek(file,0,SEEK_END);
long size=ftell(file);
fseek(file,0,SEEK_SET);
unsigned char *buffer = new unsigned char[size];
long s = (long)fread(buffer,1,size,file);
fclose(file);
insert_blob(db,table,key1,key2,buffer,size);
delete[] buffer;
return 0;
}
printf("insert_file_blob couldn't open %s\n",filename);
return -1;
}
static int select_blob(
sqlite3 *db, /* Database containing blobs table */
const char *table, /* Null-terminated key to retrieve blob for */
const char *key1, /* Null-terminated key to retrieve blob for */
const char *key2, /* Null-terminated key to retrieve blob for */
unsigned char **blob, /* Set *pzBlob to point to the retrieved blob */
int *size /* Set *pnBlob to the size of the retrieved blob */
)
{
char sql[1024];
snprintf(sql,1024,"select value from %s_value_blob where entity_id = ? and attribute_id = ?", table);
sqlite3_stmt *pStmt;
int rc;
*blob = 0;
*size = 0;
do {
/* Compile the SELECT statement into a virtual machine. */
rc = sqlite3_prepare(db, sql, -1, &pStmt, 0);
if( rc!=SQLITE_OK ){
return rc;
}
/* Bind the key to the SQL variable. */
sqlite3_bind_text(pStmt, 1, key1, -1, SQLITE_STATIC);
sqlite3_bind_text(pStmt, 1, key2, -1, SQLITE_STATIC);
rc = sqlite3_step(pStmt);
if( rc==SQLITE_ROW ){
*size = sqlite3_column_bytes(pStmt, 0);
*blob = (unsigned char *)malloc(*size);
memcpy(*blob, sqlite3_column_blob(pStmt, 0), *size);
}
rc = sqlite3_finalize(pStmt);
} while( rc==SQLITE_SCHEMA );
return rc;
}
int select_file_blob(sqlite3 *db, const char *table, const char* key1, const char *key2, const char* filename)
{
FILE *file=fopen(filename,"wb");
if (file)
{
int size;
unsigned char *blob;
select_blob(db,table,key1,key2,&blob,&size);
fwrite(blob,1,size,file);
fclose(file);
free(blob);
return 0;
}
printf("select_file_blob couldn't open %s\n",filename);
return -1;
}
#endif
static pointer opexe_6(scheme *sc, enum scheme_opcodes op) {
......@@ -4382,6 +4497,23 @@ static pointer opexe_6(scheme *sc, enum scheme_opcodes op) {
#endif
s_return(sc,sc->F);
}
/* case OP_INSERT_BLOB_DB: {
#ifndef FLX_RPI
if (is_string(car(sc->args)) &&
is_string(caddr(sc->args)) &&
is_string(cadddr(sc->args)) &&
is_string(caddddr(sc->args)) &&
is_string(cadddddr(sc->args))) {
db *d=the_db_container.get(string_value(car(sc->args)));
if (d!=NULL)
{
db_exec(sc,d);
s_return(sc,mk_integer(sc,d->last_rowid()));
}
}
#endif
s_return(sc,sc->F);
} */
case OP_STATUS_DB: {
#ifndef FLX_RPI
if (is_string(car(sc->args))) {
......
weavingcodes.scm
View file @ c0430935
......@@ -18,12 +18,13 @@
(weft-t 0)
(draft-pos 0)
(draft-size 4)
(draft 1) (d-b 0) (d-c 1) (d-d 0)
(d-e 0) (d-f 1) (d-g 0) (d-h 1)
(d-i 1) (d-j 0) (d-k 1) (d-l 0)
(d-m 0) (d-n 1) (d-o 0) (d-p 1)
(draft 1) (d-b 0) (d-c 0) (d-d 1)
(d-e 1) (d-f 1) (d-g 0) (d-h 0)
(d-i 0) (d-j 1) (d-k 1) (d-l 0)
(d-m 0) (d-n 0) (d-o 1) (d-p 1)
(weft-z (vector 0 0 0))
(weft-count 0))
(weft-count 0)
(weft-total 21))
(define read-draft
(lambda ()
......@@ -32,7 +33,7 @@
(+ (* draft-pos draft-size)
(if (> weft-direction 0)
(modulo weft-count (+ draft-size (vector 0 1 1)) )
(- draft-size (modulo weft-count (+ draft-size (vector 0 1 1)) ))))))))
(modulo (- (- weft-total 1) weft-count) (+ draft-size (vector 0 1 1)) )))))))
(define calc-weft-z
(lambda ()
......@@ -99,18 +100,17 @@
(calc-weft-z)
(set! weft-position (+ weft-position weft-direction))
;; selvedge time?
(cond
((> weft-count 21)
(set! weft-count 0)
(set! draft-pos (+ draft-pos 1))
(cond ((> draft-pos draft-size)
(set! draft-pos 0)))
(set! weft-position (- (+ weft-position (vector 0 1.5 0))
weft-direction))
(set! weft-direction (* weft-direction -1))
(cond
((> 0 weft-direction) (right-selvedge (vector 0 1.5 0)))
((< 0 weft-direction) (left-selvedge (vector 0 1.5 0))))))
(when (> weft-count weft-total)
(set! weft-count 0)
(set! draft-pos (+ draft-pos 1))
(when (> draft-pos draft-size)
(set! draft-pos 0))
(set! weft-position (- (+ weft-position (vector 0 1.5 0))
weft-direction))
(set! weft-direction (* weft-direction -1))
(if (> 0 weft-direction)
(right-selvedge (vector 0 1.5 0))
(left-selvedge (vector 0 1.5 0))))
(set! weft-t (/ weft-count 21))
......@@ -156,10 +156,10 @@
(weft-t 0)
(draft-pos 0)
(draft-size 4)
(draft 1) (d-b 0) (d-c 1) (d-d 0)
(d-e 0) (d-f 1) (d-g 0) (d-h 1)
(d-i 1) (d-j 0) (d-k 1) (d-l 0)
(d-m 0) (d-n 1) (d-o 0) (d-p 1)
(draft 1) (d-b 0) (d-c 0) (d-d 1)
(d-e 1) (d-f 1) (d-g 0) (d-h 0)
(d-i 0) (d-j 1) (d-k 1) (d-l 0)
(d-m 0) (d-n 0) (d-o 1) (d-p 1)
(last-t 0))
(define build-quad
......@@ -187,12 +187,9 @@
(vector 0 0 0))))
(set! warp-end 0)
(loop (< warp-end 20)
(if (> (read-draft) 0.5)
(+ 1 1)
;(write-sub! (- i 6) 0 v 0 0 v v
; v 0 v v)
(write-add! (- i 6) 0 v 0 0 v v
v 0 v v))
(when (< (read-draft) 0.5)
(write-add! (- i 6) 0 v 0 0 v v
v 0 v v))
(set! i (+ i 24))
(set! warp-end (+ warp-end 1)))))
......@@ -215,10 +212,10 @@
(set! vertex (+ positions-start 12))
(animate-shed vertex)
(cond ((> (- last-t weft-t) 0.1)
(set! draft-pos (+ draft-pos 1))
(cond ((> draft-pos draft-size) (set! draft-pos 0)))
(build-warp)))
(when (> (- last-t weft-t) 0.1)
(set! draft-pos (+ draft-pos 1))
(when (> draft-pos draft-size) (set! draft-pos 0))
(build-warp))
(set! last-t weft-t)
)))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment