Skip to content

Instantly share code, notes, and snippets.

@lupyuen
Last active October 13, 2023 13:48
Show Gist options
  • Save lupyuen/572e6018ed982fe42b2b5ed40ffae505 to your computer and use it in GitHub Desktop.
Save lupyuen/572e6018ed982fe42b2b5ed40ffae505 to your computer and use it in GitHub Desktop.
NuttX Scheme doesn't crash on QEMU, after increasing the App Stack Size. See https://github.com/lupyuen/nuttx-star64#scheme-interpreter-crashes-on-nuttx
Script started on Fri Oct 13 17:35:27 2023
command: qemu-system-riscv64 -semihosting -M virt,aclint=on -cpu rv64 -smp 8 -bios none -kernel nuttx -initrd initrd -nographic
ABC
NuttShell (NSH) NuttX-12.3.0-RC0
nsh> free
total used free largest nused nfree
Kmem: 2064376 25400 2038976 2038912 41 2
Page: 16777216 610304 16166912 16166912
nsh> scheme
Welcome to UMB Scheme, version 3.2 Copyright (c) 1988,1996 William R Campbell.
UMB Scheme comes with ABSOLUTELY NO WARRANTY. This is free software and
you are free to redistribute it under certain conditions.
See the UMB Scheme Release Notes for details.
Type `(exit)` or Control-d to exit.
Loading /system/bin/prelude.scheme...
(gc-messages #f)(define (caar x) (car (car x)))(define (cadr x) (car (cdr x)))(define (cdar x) (cdr (car x)))(define (cddr x) (cdr (cdr x)))(define (caaar x) (car (car (car x))))(define (caadr x) (car (car (cdr x))))(define (cadar x) (car (cdr (car x))))(define (caddr x) (car (cdr (cdr x))))(define (cdaar x) (cdr (car (car x))))(define (cdadr x) (cdr (car (cdr x))))(define (cddar x) (cdr (cdr (car x))))(define (cdddr x) (cdr (cdr (cdr x))))(define (caaaar x) (car (car (car (car x)))))(define (caaadr x) (car (car (car (cdr x)))))(define (caadar x) (car (car (cdr (car x)))))(define (caaddr x) (car (car (cdr (cdr x)))))(define (cadaar x) (car (cdr (car (car x)))))(define (cadadr x) (car (cdr (car (cdr x)))))(define (caddar x) (car (cdr (cdr (car x)))))(define (cadddr x) (car (cdr (cdr (cdr x)))))(define (cdaaar x) (cdr (car (car (car x)))))(define (cdaadr x) (cdr (car (car (cdr x)))))(define (cdadar x) (cdr (car (cdr (car x)))))(define (cdaddr x) (cdr (car (cdr (cdr x)))))(define (cddaar x) (cdr (cdr (car (car x)))))(define (cddadr x) (cdr (cdr (car (cdr x)))))(define (cdddar x) (cdr (cdr (cdr (car x)))))(define (cddddr x) (cdr (cdr (cdr (cdr x)))))(define (list . elems) elems)(define (memq obj list) (if (null? list) #f (if (not (pair? list)) (error "2nd arg to memq not a list: " list) (if (eq? obj (car list)) list (memq obj (cdr list))))))(define (memv obj list) (if (null? list) #f (if (not (pair? list)) (error "2nd arg to memv not a list: " list) (if (eqv? obj (car list)) list (memv obj (cdr list))))))(define (member obj list) (if (null? list) #f (if (not (pair? list)) (error "2nd arg to member not a list: " list) (if (equal? obj (car list)) list (member obj (cdr list))))))(define (assq obj alist) (if (null? alist) #f (if (not (pair? alist)) (error "2nd argument to assq not a list: " alist) (if (eq? (caar alist) obj) (car alist) (assq obj (cdr alist))))))(define (assv obj alist) (if (null? alist) #f (if (not (pair? alist)) (error "2nd argument to assv not a list: " alist) (if (eqv? (caar alist) obj) (car alist) (assv obj (cdr alist))))))(define (assoc obj alist) (if (null? alist) #f (if (not (pair? alist)) (error "2nd argument to assoc not a list: " alist) (if (equal? (caar alist) obj) (car alist) (assoc obj (cdr alist))))))(define (number->string num . radix) (#_number->string num (if (null? radix) 10 (car radix))))(define (string->number str . radix) (#_string->number str (if (null? radix) 0 (car radix))))(define (make-string length . fill-char) (if (null? fill-char) (#_make-string length #\space ) (#_make-string length (car fill-char))))(define (string . characters) (list->string characters))(define (make-vector length . fill) (#_make-vector length (if (null? fill) (the-undefined-symbol) (car fill))))(define (vector . elems) (list->vector elems))(define (#_collect args) (if (null? (cdr args)) (car args) (cons (car args) (#_collect (cdr args)))))(define (apply proc arg1 . args) (#_apply proc (if (null? args) arg1 (#_collect (cons arg1 args)))))(define (map fn list . lists) (if (null? lists) (#_map1 fn list) (#_mapn fn (cons list lists))))(define (#_map1 fn list) (if (null? list) (quote ()) (cons (fn (car list)) (#_map1 fn (cdr list)))))(define (#_mapn fn lists) (if (null? (car lists)) (quote ()) (cons (#_apply fn (#_map1 car lists)) (#_mapn fn (#_map1 cdr lists)))))(define (for-each proc list . lists) (if (null? lists) (#_for-each1 proc list) (#_for-eachn proc (cons list lists))))(define (#_for-each1 proc list) (if (null? list) (quote ()) (begin (proc (car list)) (#_for-each1 proc (cdr list)))))(define (#_for-eachn proc lists) (if (null? (car lists)) (quote ()) (begin (#_apply proc (#_map1 car lists)) (#_for-eachn proc (#_map1 cdr lists)))))(define (read . port) (#_read (if (null? port) (current-input-port) (car port))))(define (read-char . port) (#_read-char (if (null? port) (current-input-port) (car port))))(define (peek-char . port) (#_peek-char (if (null? port) (current-input-port) (car port))))(define (char-ready? . port) (#_char-ready? (if (null? port) (current-input-port) (car port))))(define (write obj . port) (#_write obj (if (null? port) (current-output-port) (car port))))(define (display obj . port) (#_display obj (if (null? port) (current-output-port) (car port))))(define (newline . port) (if (null? port) (write-char #\newline (current-output-port)) (write-char #\newline (car port))))(define (write-char obj . port) (#_write-char obj (if (null? port) (current-output-port) (car port))))(defmacro quasiquote (template) (#_quasiquote template))(define (#_quasiquote skel) (if (vector? skel) (list (quote list->vector) (#_quasiquote (vector->list skel))) (if (null? skel) (quote (quote ())) (if (symbol? skel) (list (quote quote) skel) (if (not (pair? skel)) skel (if (eq? (car skel) (quote unquote)) (cadr skel) (if (eq? (car skel) (quote quasiquote)) (#_quasiquote (#_quasiquote (cadr skel))) (if (if (pair? (car skel)) (eq? (caar skel) (quote unquote-splicing)) #f) (list (quote append) (cadar skel) (#_quasiquote (cdr skel))) (#_combine-skels (#_quasiquote (car skel)) (if (null? (cdr skel)) (quote ()) (#_quasiquote (cdr skel))) skel)))))))))(define (#_combine-skels lft rgt skel) (if (if (#_isconst? lft) (#_isconst? rgt) #f) (list (quote quote) skel) (if (null? rgt) (list (quote list) lft) (if (if (pair? rgt) (eq? (car rgt) (quote list)) #f) (cons (quote list) (cons lft (cdr rgt))) (list (quote cons) lft rgt)))))(define (#_isconst? obj) (if (pair? obj) (eq? (car obj) (quote quote)) #f))(defmacro let (arg1 arg2 . args) (if (symbol? arg1) (quasiquote ((letrec (((unquote arg1) (lambda (unquote (#_map1 car arg2)) (unquote-splicing args)))) (unquote arg1)) (unquote-splicing (#_map1 cadr arg2)))) (if (null? args) (quasiquote ((lambda (unquote (#_map1 car arg1)) (unquote arg2)) (unquote-splicing (#_map1 cadr arg1)))) (quasiquote ((lambda (unquote (#_map1 car arg1)) (unquote arg2) (unquote-splicing args)) (unquote-splicing (#_map1 cadr arg1)))))))(defmacro letrec (formals . body) (let ((vars (#_map1 car formals)) (temps (#_map1 (lambda (x) (gensym "_temp")) formals)) (exprs (#_map1 cadr formals))) (quasiquote (let ((unquote-splicing (#_map1 (lambda (x) (quasiquote ((unquote x) #f))) vars))) (let ((unquote-splicing (map (lambda (x y) (quasiquote ((unquote x) (unquote y)))) temps exprs))) (unquote-splicing (map (lambda (x y) (quasiquote (set! (unquote x) (unquote y)))) vars temps)) (unquote-splicing body))))))(defmacro let* (formals . body) (if (null? formals) (quasiquote (let () (unquote-splicing body))) (if (= (length formals) 1) (quasiquote (let ((unquote (car formals))) (unquote-splicing body))) (if (pair? (car formals)) (quasiquote (let ((unquote (car formals))) (let* (unquote (cdr formals)) (unquote-splicing body)))) (error "Bad let* syntax: " (quote let*) vars body)))))(defmacro and args (if (null? args) #t (if (null? (cdr args)) (car args) (let ((x (gensym "_x")) (thunk (gensym "_thunk"))) (quasiquote (let (((unquote x) (unquote (car args))) ((unquote thunk) (lambda () (and (unquote-splicing (cdr args)))))) (if (unquote x) ((unquote thunk)) (unquote x))))))))(defmacro or args (if (null? args) #f (if (null? (cdr args)) (car args) (let ((x (gensym "_x")) (thunk (gensym "_thunk"))) (quasiquote (let (((unquote x) (unquote (car args))) ((unquote thunk) (lambda () (or (unquote-splicing (cdr args)))))) (if (unquote x) (unquote x) ((unquote thunk)))))))))(defmacro cond args (if (null? args) (quote (quote ())) (let ((clause (car args))) (if (not (pair? clause)) (error "Bad cond syntax: " (quote cond) args) (if (eq? (car clause) (quote else)) (quasiquote (begin (unquote-splicing (cdr clause)))) (if (null? (cdr clause)) (quasiquote (or (unquote (car clause)) (cond (unquote-splicing (cdr args))))) (if (eq? (cadr clause) (quote =>)) (let ((t (gensym "_t")) (r (gensym "_r")) (c (gensym "_c"))) (quasiquote (let (((unquote t) (unquote (car clause))) ((unquote r) (lambda () (unquote-splicing (cddr clause)))) ((unquote c) (lambda () (cond (unquote-splicing (cdr args)))))) (if (unquote t) (((unquote r)) (unquote t)) ((unquote c)))))) (quasiquote (if (unquote (car clause)) (begin (unquote-splicing (cdr clause))) (cond (unquote-splicing (cdr args))))))))))))(defmacro case (key . clauses) (let ((keyvar (gensym "_keyvar"))) (quasiquote (let (((unquote keyvar) (unquote key))) (cond (unquote-splicing (map (lambda (clause) (if (eqv? (car clause) (quote else)) clause (quasiquote ((memv (unquote keyvar) (quote (unquote (car clause)))) (unquote-splicing (cdr clause)))))) clauses)))))))(defmacro do (vars-list test-list . cmds) (let ((loop (gensym "_loop")) (vars (map car vars-list)) (inits (map cadr vars-list)) (steps (map (lambda (l) (if (= (length l) 3) (caddr l) (car l))) vars-list)) (test (car test-list)) (seq (cdr test-list))) (quasiquote (letrec (((unquote loop) (lambda (unquote vars) (if (unquote test) (begin (unquote-splicing seq)) (begin (unquote-splicing cmds) ((unquote loop) (unquote-splicing steps))))))) ((unquote loop) (unquote-splicing inits))))))(define gentemp (lambda () (gensym "scm:G")))(define defmacro:eval eval)(define defmacro:load load)(define macroexpand-1 (lambda (quoted-calling-form) (expand1-quoted-defmacro-call quoted-calling-form)))(define (macroexpand quoted-calling-form) (if (pair? quoted-calling-form) (let ((keyword (car quoted-calling-form))) (if (defmacro? keyword) (macroexpand (macroexpand-1 quoted-calling-form)) quoted-calling-form)) quoted-calling-form))(define (defmacro:expand* quoted-calling-form) (if (pair? quoted-calling-form) (let ((keyword (car quoted-calling-form))) (if (defmacro? keyword) (defmacro:expand* (macroexpand quoted-calling-form)) (map defmacro:expand* quoted-calling-form))) quoted-calling-form))(define (list? x) (cond ((null? x) #t) ((not (pair? x)) #f) ((null? (cdr x)) #t) ((not (pair? (cdr x))) #f) (else (let loop ((fast (cddr x)) (slow (cdr x))) (cond ((null? fast) #t) ((or (not (pair? fast)) (eq? fast slow)) #f) ((null? (cdr fast)) #t) (else (loop (cddr fast) (cdr slow))))))))(define (call-with-input-file string proc) (let* ((port (open-input-file string)) (result (proc port))) (close-input-port port) result))(define (call-with-output-file string proc) (let* ((port (open-output-file string)) (result (proc port))) (close-output-port port) result))(define (with-input-from-file string thunk) (let ((save (current-input-port)) (port (open-input-file string))) (set-current-input-port! port) (let ((result (thunk))) (close-input-port port) (set-current-input-port! save) result)))(define (with-output-to-file string thunk) (let ((save (current-output-port)) (port (open-output-file string))) (set-current-output-port! port) (let ((result (thunk))) (close-output-port port) (set-current-output-port! save) result)))(defmacro break args (if (null? args) (quote (#_break)) (quasiquote (begin (display* (unquote-splicing args)) (newline) (break)))))(define (error . args) (newline) (display "Error: ") (apply display* args) (newline) (break))(define (show-env . args) (#_show-env (if (null? args) 20 (car args))))(define (where . args) (#_where (if (null? args) 20 (car args))))(define (go arg . rest) (if (null? rest) (#_go 0 arg) (#_go arg (car rest))))(defmacro how args (quasiquote (#_how (quote (unquote (car args))))))(define #_last-file-edited (quote ()))(define (edit . filestring) (if (null? filestring) (if (null? #_last-file-edited) (error "(edit) not previously applied -- no file to remember.") (#_edit #_last-file-edited)) (begin (set! #_last-file-edited (car filestring)) (#_edit (car filestring)))))(define (edits . filestring) (if (null? filestring) (if (null? #_last-file-edited) (error "(edits) not previously applied -- no file to remember.") (#_edits #_last-file-edited)) (begin (set! #_last-file-edited (car filestring)) (#_edits (car filestring)))))(define (write* first . rest) (define port (if (output-port? first) first (current-output-port))) (define (write** objs) (if (pair? objs) (begin (#_write (car objs) port) (write** (cdr objs))))) (write** (if (output-port? first) rest (cons first rest))))(define (display* first . rest) (define port (if (output-port? first) first (current-output-port))) (define (display** objs) (if (pair? objs) (begin (#_display (car objs) port) (display** (cdr objs))))) (display** (if (output-port? first) rest (cons first rest))))(defmacro cons-stream args (quasiquote (cons (unquote (car args)) (delay (unquote (cadr args))))))(define head car)(define (tail stream) (force (cdr stream)))(defmacro extend-environment args (quasiquote (let (unquote (map (lambda (defn) (if (and (list? defn) (= (length defn) 3) (eq? (car defn) (quote define))) (cdr defn) (error "Bad definition in an extend-environment form"))) args)) (current-environment))))(load "/usr/loca
Error: I can't open `/usr/local/lib/scheme/SLIB-for-umb-scheme.init' for loading.
l/lib/scheme/SLIB-for-umb-scheme.init")
xQEMU: Terminated
Script done on Fri Oct 13 17:36:28 2023
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment