Permalink
Switch branches/tags
Nothing to show
Find file
Fetching contributors…
Cannot retrieve contributors at this time
632 lines (589 sloc) 19.4 KB
;;;;;;;;;;
;;;*set_additional_func()
;;;;;;;;;;
*set_additional_func
mov $sarg0, "(define caar (lambda (x) (car (car x))))"
gosub *input_to_lobject
mov %arg0, %ret
mov %arg1, %global_env
gosub *eval_form
mov $sarg0, "(define cadr (lambda (x) (car (cdr x))))"
gosub *input_to_lobject
mov %arg0, %ret
mov %arg1, %global_env
gosub *eval_form
mov $sarg0, "(define cdar (lambda (x) (cdr (car x))))"
gosub *input_to_lobject
mov %arg0, %ret
mov %arg1, %global_env
gosub *eval_form
mov $sarg0, "(define cddr (lambda (x) (cdr (cdr x))))"
gosub *input_to_lobject
mov %arg0, %ret
mov %arg1, %global_env
gosub *eval_form
mov $sarg0, "(define list (lambda lst lst))"
gosub *input_to_lobject
mov %arg0, %ret
mov %arg1, %global_env
gosub *eval_form
mov $sarg0, "(define assq (lambda (key lst) (if (null? lst) nil (if (eq? key (caar lst)) (car lst) (assq key (cdr lst))))))"
gosub *input_to_lobject
mov %arg0, %ret
mov %arg1, %global_env
gosub *eval_form
mov $sarg0, "(define length (lambda (lst) (letrec ((length-iter (lambda (n lst) (if (null? lst) n (length-iter (+ n 1) (cdr lst)))))) (length-iter 0 lst))))"
gosub *input_to_lobject
mov %arg0, %ret
mov %arg1, %global_env
gosub *eval_form
mov $sarg0, "(define list-ref (lambda (lst n) (car (list-tail lst n))))"
gosub *input_to_lobject
mov %arg0, %ret
mov %arg1, %global_env
gosub *eval_form
mov $sarg0, "(define list-tail (lambda (lst n) (if (eq? n 0) lst (list-tail (cdr lst) (- n 1)))))"
gosub *input_to_lobject
mov %arg0, %ret
mov %arg1, %global_env
gosub *eval_form
mov $sarg0, "(define append (lambda (x y) (if (null? x) y (cons (car x) (append (cdr x) y)))))"
gosub *input_to_lobject
mov %arg0, %ret
mov %arg1, %global_env
gosub *eval_form
mov $sarg0, "(define map (lambda (fn lst . more) (letrec ((map1 (lambda (l) (if (null? l) nil (cons (fn (car l)) (map1 (cdr l)))))) (map-more (lambda (l m) (if (null? l) nil (cons (apply fn (car l) (map car m)) (map-more (cdr l) (map cdr m))))))) (if (null? more) (map1 lst) (map-more lst more)))))"
gosub *input_to_lobject
mov %arg0, %ret
mov %arg1, %global_env
gosub *eval_form
mov $sarg0, "(define list? (lambda (x) (if (eq? x nil) #t (if (pair? x) (list? (cdr x)) #f))))"
gosub *input_to_lobject
mov %arg0, %ret
mov %arg1, %global_env
gosub *eval_form
mov $sarg0, "(define not (lambda (x) (eq? x #f)))"
gosub *input_to_lobject
mov %arg0, %ret
mov %arg1, %global_env
gosub *eval_form
mov $sarg0, "(define memq (lambda (x lst) (if (null? lst) #f (if (eq? x (car lst)) lst (memq x (cdr lst))))))"
gosub *input_to_lobject
mov %arg0, %ret
mov %arg1, %global_env
gosub *eval_form
mov $sarg0, "(define member (lambda (x lst) (if (null? lst) #f (if (equal? x (car lst)) lst (member x (cdr lst))))))"
gosub *input_to_lobject
mov %arg0, %ret
mov %arg1, %global_env
gosub *eval_form
mov $sarg0, "(define assoc (lambda (key lst) (if (null? lst) nil (if (equal? key (caar lst)) (car lst) (assoc key (cdr lst))))))"
gosub *input_to_lobject
mov %arg0, %ret
mov %arg1, %global_env
gosub *eval_form
textclear
mov %adv_additional, 1
return
*free_mode
gosub *destroy_title
print 1
speak_mode
bgm ms_ex
mov %adv_bgm, 1
mov %adv_tmp, 0
mov %save_flag, 0 ;セーブ不能
csp SP_R : csp SP_L
r_show ari_n
mov %adv_char, 1 ;=arisa
;;ゲーム進行状況を読み込む
csvopen "arisa.szk", "rc"
csvread %adv_clear
csvclose
;;Lisp側の準備
mov %adv_rmode, 0
if %adv_additional == 0 gosub *set_additional_func
gosub *create_new_env ;自由にいじれるように新しい環境を作る
mov %arg0, %ret
mov %toplevel_env, %arg0
gosub *push ;GC対策
mov %arg1, %global_env
gosub *nconc
mov %eval_limit, 0
*fm01
mov %gc_run, 0 ;GC起動回数を初期化
mov %current_proc, %nil
mov %current_env, %toplevel_env
mov %adv_error, 0
mov $sarg0, ""
textclear
gosub *fm01_say_tab
textfield $sarg0, 30, 120, 770, 140, 10, 20, 0
getret %ret
;if %ret == 1 goto *fm01_end ;Tab
if %ret == 1 goto *fm01_menu ;Tab
if $sarg0 == "" goto *fm01
textclear
if $sarg0 == "__ex_test__" gosub *ex_test_start : goto *fm01
if $sarg0 == "__lisp_test__" gosub *lisp_test_start : goto *fm01
gosub *fm01_say_calc
repaint
gosub *check_lr_parenthesis
if %ret != 0 gosub *fm01_say_parenthesis_error : goto *fm01
gosub *input_to_lobject
mov %arg0, %ret
mov %arg1, %toplevel_env
gosub *eval_form
mov %arg0, %ret
gosub *get_tag : if %ret == TAG_ERROR mov %adv_error, 1
gosub *lobject_to_string
textclear
gosub *fm01_say_result
inc %adv_tmp ;;;?
goto *fm01
*fm01_end
gosub *pop
mov %eval_limit, DEFAULT_EVAL_LIMIT
saveon
mov %save_flag, 1 ;セーブ可能
textclear
gosub *fm01_say_goodbye
stop
csp SP_R
print E_FAST
goto *title
*fm01_menu
if %adv_clear == 0 csel "戻る", *fm01, "BGM ON/OFF", *fm01_menu_bgm, "立ち絵 ON/OFF", *fm01_menu_char, "終了", *fm01_end
csel "戻る", *fm01, "BGM ON/OFF", *fm01_menu_bgm, "立ち絵", *fm01_menu_char_change, "終了", *fm01_end
*fm01_menu_bgm
if %adv_bgm == 1 mov %adv_bgm, 0 : stop : goto *fm01
bgm ms_ex
mov %adv_bgm, 1
goto *fm01
*fm01_menu_char
if %adv_char == 1 mov %adv_char, 0 : csp SP_R : print E_FAST : goto *fm01
r_show ari_n
mov %adv_char, 1
goto *fm01
*fm01_menu_char_change
if %adv_clear <= 3 csel "立ち絵なし", *fm01_char_non, "アリサ", *fm01_char_arisa, "すずか", *fm01_char_suzuka
if %adv_clear <= 8 csel "立ち絵なし", *fm01_char_non, "アリサ", *fm01_char_arisa, "すずか", *fm01_char_suzuka, "鮫島", *fm01_char_samejima, "時空管理局局員A", *fm01_char_jiku
if %adv_clear <= 11 csel "立ち絵なし", *fm01_char_non, "アリサ", *fm01_char_arisa, "すずか", *fm01_char_suzuka, "鮫島", *fm01_char_samejima, "時空管理局局員A", *fm01_char_jiku, "時空管理局局員B", *fm01_char_jiku2
csel "立ち絵なし", *fm01_char_non, "アリサ", *fm01_char_arisa, "すずか", *fm01_char_suzuka, "鮫島", *fm01_char_samejima, "時空管理局局員A", *fm01_char_jiku, "時空管理局局員B", *fm01_char_jiku2, "なのは", *fm01_char_nanoha
*fm01_char_non
mov %adv_char, 0
csp SP_R
print E_FAST
goto *fm01
*fm01_char_arisa
mov %adv_char, 1
r_show ari_n
アリサ「さあ、やるわよ!」\
goto *fm01
*fm01_char_suzuka
mov %adv_char, 2
r_show suzur_nc
すずか「頑張ろうね」\
goto *fm01
*fm01_char_samejima
mov %adv_char, 3
r_show ":l;img/same.bmp"
鮫島「お呼びでしょうか?」\
goto *fm01
*fm01_char_jiku
mov %adv_char, 4
r_show ":l;img/jiku.bmp"
局員「は! お呼びでしょうか」\
goto *fm01
*fm01_char_jiku2
mov %adv_char, 5
r_show ":l;img/jiku2.bmp"
局員「あー、めんどくさ……」\
goto *fm01
*fm01_char_nanoha
mov %adv_char, 6
r_show ":l;img/nano.bmp"
なのは「なのっ!」\
goto *fm01
*fm01_say_goodbye
if %adv_char == 0 puttext "お疲れ様でした\"
if %adv_char == 1 puttext "アリサ「おつかれさま」\"
if %adv_char == 2 puttext "すずか「ばいば~い」\"
if %adv_char == 3 puttext "鮫島「ありがとうございました」\"
if %adv_char == 4 puttext "局員「了解しました!」\"
if %adv_char == 5 puttext "局員「ひっ、ひぃぃぃーーー!」\"
if %adv_char == 6 puttext "なのは「おわりなの」\"
mov %adv_rmode, 1
return
*fm01_say_tab
if %adv_char == 0 puttext "Tabキーでメニューが開けます"
if %adv_char == 1 puttext "アリサ「Tabキーでメニューが開けるわよ」"
if %adv_char == 2 puttext "すずか「Tabキーでメニューが開けるよ」"
if %adv_char == 3 puttext "鮫島「Tabキーでメニューが開けます」"
if %adv_char == 4 puttext "局員「Tabキーでメニューが開けます!」"
if %adv_char == 5 puttext "局員「Tabキーでメニューが開けるぞ!」"
if %adv_char == 6 puttext "なのは「Tabキーでメニューが開けるの」"
return
*fm01_say_calc
if %adv_char == 0 puttext "!s0計算中……!sd"
if %adv_char == 1 puttext "!s0アリサ「計算中……」!sd"
if %adv_char == 2 puttext "!s0すずか「計算中だよ……」!sd"
if %adv_char == 3 puttext "!s0鮫島「計算中です……」!sd"
if %adv_char == 4 puttext "!s0局員「計算中です!」!sd"
if %adv_char == 5 puttext "!s0局員「計算中だ!」!sd"
if %adv_char == 6 puttext "!s0なのは「計算中なの」!sd"
return
*fm01_say_result
if %adv_char == 0 goto *fm01_say_result0
if %adv_char == 1 goto *fm01_say_result1
if %adv_char == 2 goto *fm01_say_result2
if %adv_char == 3 goto *fm01_say_result3
if %adv_char == 4 goto *fm01_say_result4
if %adv_char == 5 goto *fm01_say_result5
if %adv_char == 6 goto *fm01_say_result6
*fm01_say_result0
if %adv_error == 1 goto *fm01_say_result0_error
『$sret』@
return
*fm01_say_result0_error
#33FF33$sret#FFFFFF@
return
*fm01_say_result1
if %adv_error == 1 goto *fm01_say_result1_error
アリサ「結果は『$sret』ね」@
return
*fm01_say_result1_error
アリサ「プログラムに誤りがあるわ」
#33FF33$sret#FFFFFF@
return
*fm01_say_result2
if %adv_error == 1 goto *fm01_say_result2_error
すずか「結果は『$sret』だよ」@
return
*fm01_say_result2_error
すずか「プログラムに誤りがあるよ」
#33FF33$sret#FFFFFF@
return
*fm01_say_result3
if %adv_error == 1 goto *fm01_say_result3_error
鮫島「結果は『$sret』でございます」@
return
*fm01_say_result3_error
鮫島「プログラムに誤りがございます」
#33FF33$sret#FFFFFF@
return
*fm01_say_result4
if %adv_error == 1 goto *fm01_say_result4_error
局員「結果は『$sret』です!」@
return
*fm01_say_result4_error
局員「プログラムに誤りがあります!」
#33FF33$sret#FFFFFF@
return
*fm01_say_result5
if %adv_error == 1 goto *fm01_say_result5_error
局員「結果は『$sret』だ!」@
return
*fm01_say_result5_error
局員「プログラムに誤りがあるぞ!」
#33FF33$sret#FFFFFF@
return
*fm01_say_result6
if %adv_error == 1 goto *fm01_say_result6_error
なのは「結果は『$sret』なの」@
return
*fm01_say_result6_error
なのは「プログラムに誤りがあるの」
#33FF33$sret#FFFFFF@
return
*fm01_say_parenthesis_error
textclear
if %adv_char == 0 puttext "括弧の開く数と、閉じる数が一致していません\"
if %adv_char == 1 goto *fm01_say_parenthesis_error_arisa
if %adv_char == 2 goto *fm01_say_parenthesis_error_suzuka
if %adv_char == 3 puttext "鮫島「括弧の開く数と、閉じる数が一致しておりません」\"
if %adv_char == 4 puttext "局員「括弧の開く数と、閉じる数が一致していません!」\"
if %adv_char == 5 puttext "局員「括弧の開く数と、閉じる数が一致していない!」\"
if %adv_char == 6 puttext "なのは「括弧の開く数と、閉じる数が一致していないの」\"
return
*fm01_say_parenthesis_error_arisa
r_show ari_die
アリサ「括弧の開く数と、閉じる数が一致していないわよ」\
r_show ari_n
return
*fm01_say_parenthesis_error_suzuka
r_show suzur_ase
すずか「括弧の開く数と、閉じる数が一致していないよ」\
r_show suzur_n
return
;;;*lisp_test_eval($form, $description)
*lisp_test_eval
!s0$sarg1!sd
!s0sp:%sp!sd
!s0ssp:%ssp!sd
len %arg0, $sarg0
gosub *push ; S(length)
gosub *spush ; SS(form)
gosub *input_to_lobject
mov %arg0, %ret
mov %arg1, %global_env
gosub *eval_form
mov %arg0, %ret ; %arg0 = result
if %ret == %sharp_f goto *lisp_test_eval_fail
!s0【#00FF00pass#FFFFFF】!sd
*lisp_test_eval_stack_check
gosub *spop ; form < SS()
len %tmp, $sret
gosub *pop ; length < S()
!s0sp:%sp!sd
!s0ssp:%ssp!sd
if %tmp != %ret gosub *lisp_test_eval_stack_error
textclear
return
*lisp_test_eval_fail
!s0【#FF0000fail#FFFFFF】!sd@
goto *lisp_test_eval_stack_check
*lisp_test_eval_stack_error
!s0#FF0000!!!stack was broken!!!#FFFFFF!sd@
return
*lisp_test_start
;; Basic tests
mov $sarg0, "(eq? 'test 'test)"
mov $sarg1, "eq?"
gosub *lisp_test_eval
mov $sarg0, "(= 1 1)"
mov $sarg1, "="
gosub *lisp_test_eval
mov $sarg0, "(not #f)"
mov $sarg1, "not"
gosub *lisp_test_eval
;; Type tests
mov $sarg0, "(boolean? #t)"
mov $sarg1, "boolean? #1"
gosub *lisp_test_eval
mov $sarg0, "(not (boolean? '()))"
mov $sarg1, "boolean? #2"
gosub *lisp_test_eval
mov $sarg0, "(symbol? 'test)"
mov $sarg1, "symbol? #1"
gosub *lisp_test_eval
mov $sarg0, "(not (symbol? 1))"
mov $sarg1, "symbol? #2"
gosub *lisp_test_eval
mov $sarg0, "(number? 1)"
mov $sarg1, "number? #1"
gosub *lisp_test_eval
mov $sarg0, "(not (number? 'test))"
mov $sarg1, "number? #2"
gosub *lisp_test_eval
mov $sarg0, "(pair? (cons 1 2))"
mov $sarg1, "pair? #1"
gosub *lisp_test_eval
mov $sarg0, "(not (pair? '()))"
mov $sarg1, "pair? #2"
gosub *lisp_test_eval
mov $sarg0, "(procedure? car)"
mov $sarg1, "procedure? #1"
gosub *lisp_test_eval
mov $sarg0, "(not (procedure? 'car))"
mov $sarg1, "procedure? #2"
gosub *lisp_test_eval
;; Numeric tests
mov $sarg0, "(= (+ 1 2 3) (+ 1 (+ 2 3)))"
mov $sarg1, "+"
gosub *lisp_test_eval
mov $sarg0, "(= (- 1 100) -99)"
mov $sarg1, "-"
gosub *lisp_test_eval
mov $sarg0, "(= (* 2 3 4) (* (* 2 3) 4))"
mov $sarg1, "*"
gosub *lisp_test_eval
mov $sarg0, "(= (/ 99 33) 3)"
mov $sarg1, "/"
gosub *lisp_test_eval
mov $sarg0, "(= (mod 13 7) 6)"
mov $sarg1, "mod"
gosub *lisp_test_eval
mov $sarg0, "(< 99 100)"
mov $sarg1, "< #1"
gosub *lisp_test_eval
mov $sarg0, "(not (< 100 100))"
mov $sarg1, "< #2"
gosub *lisp_test_eval
mov $sarg0, "(<= 99 100)"
mov $sarg1, "<= #1"
gosub *lisp_test_eval
mov $sarg0, "(<= 100 100)"
mov $sarg1, "<= #2"
gosub *lisp_test_eval
mov $sarg0, "(not (<= 101 100))"
mov $sarg1, "<= #3"
gosub *lisp_test_eval
mov $sarg0, "(> 100 99)"
mov $sarg1, "> #1"
gosub *lisp_test_eval
mov $sarg0, "(not (> 100 100))"
mov $sarg1, "> #2"
gosub *lisp_test_eval
mov $sarg0, "(not (>= 99 100))"
mov $sarg1, ">= #1"
gosub *lisp_test_eval
mov $sarg0, "(>= 100 100)"
mov $sarg1, ">= #2"
gosub *lisp_test_eval
mov $sarg0, "(>= 101 100)"
mov $sarg1, ">= #3"
gosub *lisp_test_eval
;; List tests
mov $sarg0, "(null? '())"
mov $sarg1, "null? #1"
gosub *lisp_test_eval
mov $sarg0, "(not (null? #f))"
mov $sarg1, "null? #2"
gosub *lisp_test_eval
mov $sarg0, "(list? '())"
mov $sarg1, "list? #1"
gosub *lisp_test_eval
mov $sarg0, "(not (list? (cons 1 2)))"
mov $sarg1, "list? #2"
gosub *lisp_test_eval
mov $sarg0, "(list? (cons 'a '()))"
mov $sarg1, "list? #3"
gosub *lisp_test_eval
mov $sarg0, "(equal? '() '())"
mov $sarg1, "equal? #1"
gosub *lisp_test_eval
mov $sarg0, "(equal? (cons 1 2) (cons 1 2))"
mov $sarg1, "equal? #2"
gosub *lisp_test_eval
mov $sarg0, "(not (equal? (cons 1 2) (cons 3 4)))"
mov $sarg1, "equal? #3"
gosub *lisp_test_eval
mov $sarg0, "(eq? (car (cons 'a 'b)) 'a)"
mov $sarg1, "car"
gosub *lisp_test_eval
mov $sarg0, "(eq? (cdr (cons 'a 'b)) 'b)"
mov $sarg1, "cdr"
gosub *lisp_test_eval
mov $sarg0, "(equal? (list 1 2) (cons 1 (cons 2 '())))"
mov $sarg1, "list"
gosub *lisp_test_eval
mov $sarg0, "(= (length '(a b c)) 3)"
mov $sarg1, "length"
gosub *lisp_test_eval
mov $sarg0, "(eq? (list-ref '(a b c) 1) 'b)"
mov $sarg1, "list-ref"
gosub *lisp_test_eval
mov $sarg0, "(equal? (list-tail '(a b c) 1) '(b c))"
mov $sarg1, "list-tail"
gosub *lisp_test_eval
mov $sarg0, "(equal? (append '(a) '(b c)) '(a b c))"
mov $sarg1, "append"
gosub *lisp_test_eval
mov $sarg0, "(equal? (assoc 'c '((a b) (c d))) '(c d))"
mov $sarg1, "assoc"
gosub *lisp_test_eval
mov $sarg0, "(equal? (member 'b '(a b c)) '(b c))"
mov $sarg1, "member"
gosub *lisp_test_eval
mov $sarg0, "(equal? (map list '(a b c)) '((a) (b) (c)))"
mov $sarg1, "map"
gosub *lisp_test_eval
;; Special form tests
mov $sarg0, "(= (begin 1 2 3) 3)"
mov $sarg1, "begin"
gosub *lisp_test_eval
mov $sarg0, "(and)"
mov $sarg1, "and #1"
gosub *lisp_test_eval
mov $sarg0, "(and 1 2)"
mov $sarg1, "and #2"
gosub *lisp_test_eval
mov $sarg0, "(not (and 1 2 #f))"
mov $sarg1, "and #3"
gosub *lisp_test_eval
mov $sarg0, "(not (or))"
mov $sarg1, "or #1"
gosub *lisp_test_eval
mov $sarg0, "(not (or #f))"
mov $sarg1, "or #2"
gosub *lisp_test_eval
mov $sarg0, "(or #f 1 2))"
mov $sarg1, "or #3"
gosub *lisp_test_eval
mov $sarg0, "(= (if '() 1 2) 1)"
mov $sarg1, "if #1"
gosub *lisp_test_eval
mov $sarg0, "(= (if #f 1 2) 2)"
mov $sarg1, "if #2"
gosub *lisp_test_eval
mov $sarg0, "(= (cond (#t 1 2) (else 3 4)) 2)"
mov $sarg1, "cond #1"
gosub *lisp_test_eval
mov $sarg0, "(= (cond (#f 1 2) (else 3 4)) 4)"
mov $sarg1, "cond #2"
gosub *lisp_test_eval
mov $sarg0, "(= ((lambda (x y) (+ x y)) 1 2) 3)"
mov $sarg1, "lambda"
gosub *lisp_test_eval
mov $sarg0, "(= ((let ((x 1)(y 2)) (let ((x 3) (y x)) (+ x y))) 4)"
mov $sarg1, "let"
gosub *lisp_test_eval
mov $sarg0, "(= ((let ((x 1)(y 2)) (let* ((x 3) (y x)) (+ x y))) 6)"
mov $sarg1, "let*"
gosub *lisp_test_eval
mov $sarg0, "(= (letrec ((fact (lambda (x)(if (= x 0) 1 (* x (fact (- x 1))))))) (fact 5)) 120)"
mov $sarg1, "letrec"
gosub *lisp_test_eval
;; Definition and mutation tests
mov $sarg0, "(define _x 1)"
mov $sarg1, "define #1"
gosub *lisp_test_eval
mov $sarg0, "(= _x 1)"
mov $sarg1, "define #2"
gosub *lisp_test_eval
mov $sarg0, "(= (begin (set! _x 99) _x) 99)"
mov $sarg1, "set! global"
gosub *lisp_test_eval
mov $sarg0, "(and (= (let ((_x 0)) (set! _x 551) _x) 551) (= _x 99))"
mov $sarg1, "set! local"
gosub *lisp_test_eval
mov $sarg0, "(let ((x (cons 1 2))) (set-car! x 'a) (equal? x (cons 'a 2)))"
mov $sarg1, "set-car!"
gosub *lisp_test_eval
mov $sarg0, "(let ((x (cons 1 2))) (set-cdr! x 'a) (equal? x (cons 1 'a)))"
mov $sarg1, "set-cdr!"
gosub *lisp_test_eval
;; Error tests
;; HACK: (and X (not X)) => X iff X is a error object.
mov $sarg0, "(let ((x (error 'test))) (and x (not x)))"
mov $sarg1, "error"
gosub *lisp_test_eval
mov $sarg0, "(let ((x (car))) (and x (not x)))"
mov $sarg1, "too few arguments"
gosub *lisp_test_eval
mov $sarg0, "(let ((x (car 1 2))) (and x (not x)))"
mov $sarg1, "too many arguments"
gosub *lisp_test_eval
mov $sarg0, "(let ((x (car 1))) (and x (not x)))"
mov $sarg1, "wrong type"
gosub *lisp_test_eval
mov $sarg0, "(let ((x (if))) (and x (not x)))"
mov $sarg1, "invalid if #1"
gosub *lisp_test_eval
mov $sarg0, "(let ((x (if 1 2 3 4))) (and x (not x)))"
mov $sarg1, "invalid if #2"
gosub *lisp_test_eval
mov $sarg0, "(let ((x (cond))) (and x (not x)))"
mov $sarg1, "invalid cond #1"
gosub *lisp_test_eval
mov $sarg0, "(let ((x (cond 1))) (and x (not x)))"
mov $sarg1, "invalid cond #2"
gosub *lisp_test_eval
mov $sarg0, "(let ((x (lambda))) (and x (not x)))"
mov $sarg1, "invalid lambda #1"
gosub *lisp_test_eval
mov $sarg0, "(let ((x (lambda 1 2))) (and x (not x)))"
mov $sarg1, "invalid lambda #2"
gosub *lisp_test_eval
return