Tinyscheme.dll and OxygenBasic?

[Arnold]

Hi Charles,

although I managed to create a Tinyscheme DLL file (32-bit and 64-bit), unfortunately I cannot call it from Oxygenbasic. I have tried several times, and I am probably doing something fundamentally wrong. Perhaps you can help? If I would manage to solve this little example of John:

https://www.oxygenbasic.org/forum/index.php?topic=1185.msg10996#msg10996

Code: [Select]

' Tiny Scheme - extension module example

DECLARE SUB InitNew ALIAS "TS_init_new" LIB "ts"
DECLARE SUB Deinit ALIAS "TS_deinit" LIB "ts"
DECLARE SUB LoadStr ALIAS "TS_load_string" LIB "ts"

sc = InitNew()
LoadStr(sc, "(display \"Hello, world!\n\")")
Deinit(sc)

then I think I would be able to create the remaining wrapper functions of tinyscheme.dll too.

Attached is a zip file with the 32-bit tinyscheme.dll and an exe file which calls the dll, a .def file and the header files. Perhaps it is possible to wrap:
scheme_init, scheme_init_new, scheme_deinit, scheme_load_string?
The header files are very complicated and exceed my knowledge of the C language.

Currently I am exploring newLisp.dll which is much simpler to call from Oxygenbasic. The only problem at the moment is that newLisp.dll does not accept input from the console, but I can already do much more than with o2scm.o2bas. Most of the time I only need one exported function (newlispEvalStr). If it is of interest, I can post my results so far.

Roland 

[JRS]

Hi Roland,

Make sure you include a line feed character at the end of your Scheme code or TS chokes.

[Arnold]

Thank you John, for the hint. I managed to create an interpreter in O2 using newlisp.dll and I then noticed too that I will need the cr escape characters. But I forgot to try this with tinyscheme.dll also. Perhaps this will help.

Roland

[Charles Pegge]

Hi Roland,

I got access to your tinyschem.dll, but I don't know how to make it work with the console - the answer mayl be in tinysheme.c.

Code: [Select]

'#console
'$filename "t.exe"
'uses rtl32

' Tiny Scheme - extension module example

DECLARE InitNew ALIAS "scheme_init_new" LIB "tinyscheme"
DECLARE Deinit ALIAS "scheme_deinit" LIB "tinyscheme"
DECLARE LoadStr ALIAS "scheme_load_string" LIB "tinyscheme"

uses console
sys sc = InitNew()
printl sc
LoadStr(sc, `(display \"Hello, world!\n\")`)
Deinit(sc)
printl "ok"
wait


[Arnold]

Hi Charles,

thank you for looking at the example. Further research is likely to be needed, but this is not a priority at this time. Maybe the struct scheme of scheme-private.h has to be decrypted. The structure and its dependencies look really very confusing to me.

Roland

[jack]

@Arnold
there's a tool for FreeBasic to translate C headers to FB https://github.com/dkl/fbfrog it may be of some help to you.
I ran scheme-private.h through FBfrog and there was but one todo, if you are interested I can post the result, otherwise I won't clobber up this thread.

[Arnold]

Hi Jack,

thank you for your offer that I would like to accept. It would be indeed interesting to see how fbfrog converts these files. Although I do not know if I am qualified enough  to correctly evaluate the results, it would be worth trying.

Did you try to run tinyscheme.dll with Freebasic?

Roland

[jack]

Hi Arnold
no I haven't tried to interface with tinyscheme yet, a little busy at the moment, however here's the output from fbfrog
scheme-private.bi

Code: [Select]

#pragma once

#include once "crt/long.bi"
#include once "crt/stdio.bi"

extern "C"

#define _SCHEME_PRIVATE_H
#define _SCHEME_H
const STANDALONE = 1
const USE_STRCASECMP = 1
const USE_STRLWR = 1
#define SCHEME_EXPORT
#define USE_SCHEME_STACK
const USE_MATH = 1
const USE_CHAR_CLASSIFIERS = 1
const USE_ASCII_NAMES = 1
const USE_STRING_PORTS = 1
const USE_TRACING = 1
const USE_PLIST = 0
const USE_ERROR_HOOK = 1
const USE_COLON_HOOK = 1
const STDIO_ADDS_CR = 0
#define INLINE
const USE_INTERFACE = 0
const SHOW_ERROR_LINE = 1

type cell as cell_
type pointer as cell ptr
type func_alloc as function(byval as uinteger) as any ptr
type func_dealloc as sub(byval as any ptr)

union num_value
ivalue as clong
rvalue as double
end union

type num
is_fixnum as byte
value as num_value
end type

type scheme as scheme_
declare function scheme_init_new() as scheme ptr
declare function scheme_init_new_custom_alloc(byval malloc as func_alloc, byval free as func_dealloc) as scheme ptr
declare function scheme_init(byval sc as scheme ptr) as long
declare function scheme_init_custom_alloc(byval sc as scheme ptr, byval as func_alloc, byval as func_dealloc) as long
declare sub scheme_deinit(byval sc as scheme ptr)
declare sub scheme_set_input_port_file(byval sc as scheme ptr, byval fin as FILE ptr)
declare sub scheme_set_input_port_string(byval sc as scheme ptr, byval start as zstring ptr, byval past_the_end as zstring ptr)
declare sub scheme_set_output_port_file(byval sc as scheme ptr, byval fin as FILE ptr)
declare sub scheme_set_output_port_string(byval sc as scheme ptr, byval start as zstring ptr, byval past_the_end as zstring ptr)
declare sub scheme_load_file(byval sc as scheme ptr, byval fin as FILE ptr)
declare sub scheme_load_named_file(byval sc as scheme ptr, byval fin as FILE ptr, byval filename as const zstring ptr)
declare sub scheme_load_string(byval sc as scheme ptr, byval cmd as const zstring ptr)
declare function scheme_apply0(byval sc as scheme ptr, byval procname as const zstring ptr) as pointer
declare function scheme_call(byval sc as scheme ptr, byval func as pointer, byval args as pointer) as pointer
declare function scheme_eval(byval sc as scheme ptr, byval obj as pointer) as pointer
declare sub scheme_set_external_data(byval sc as scheme ptr, byval p as any ptr)
declare sub scheme_define(byval sc as scheme ptr, byval env as pointer, byval symbol as pointer, byval value as pointer)
type foreign_func as function(byval as scheme ptr, byval as pointer) as pointer
declare function _cons(byval sc as scheme ptr, byval a as pointer, byval b as pointer, byval immutable as long) as pointer
declare function mk_integer(byval sc as scheme ptr, byval num as clong) as pointer
declare function mk_real(byval sc as scheme ptr, byval num as double) as pointer
declare function mk_symbol(byval sc as scheme ptr, byval name as const zstring ptr) as pointer
declare function gensym(byval sc as scheme ptr) as pointer
declare function mk_string(byval sc as scheme ptr, byval str as const zstring ptr) as pointer
declare function mk_counted_string(byval sc as scheme ptr, byval str as const zstring ptr, byval len as long) as pointer
declare function mk_empty_string(byval sc as scheme ptr, byval len as long, byval fill as byte) as pointer
declare function mk_character(byval sc as scheme ptr, byval c as long) as pointer
declare function mk_foreign_func(byval sc as scheme ptr, byval f as foreign_func) as pointer
declare sub putstr(byval sc as scheme ptr, byval s as const zstring ptr)
declare function list_length(byval sc as scheme ptr, byval a as pointer) as long
declare function eqv(byval a as pointer, byval b as pointer) as long

type scheme_port_kind as long
enum
port_free = 0
port_file = 1
port_string = 2
port_srfi6 = 4
port_input = 16
port_output = 32
port_saw_EOF = 64
end enum

type port_rep_stdio
file as FILE ptr
closeit as long
curr_line as long
filename as zstring ptr
end type

type port_rep_string
start as zstring ptr
past_the_end as zstring ptr
curr as zstring ptr
end type

union port_rep
stdio as port_rep_stdio
string as port_rep_string
end union

type port
kind as ubyte
rep as port_rep
end type

type cell__object__string
_svalue as zstring ptr
_length as long
end type

type cell__object__cons
_car as cell ptr
_cdr as cell ptr
end type

union cell__object
_string as cell__object__string
_number as num
_port as port ptr
_ff as foreign_func
_cons as cell__object__cons
end union

type cell_
_flag as ulong
_object as cell__object
end type

type scheme_
malloc as func_alloc
free as func_dealloc
retcode as long
tracing as long
alloc_seg(0 to 9) as zstring ptr
cell_seg(0 to 9) as pointer
last_cell_seg as long
args as pointer
envir as pointer
code as pointer
dump as pointer
interactive_repl as long
_sink as cell
sink as pointer
_NIL as cell
NIL as pointer
_HASHT as cell
T as pointer
_HASHF as cell
F as pointer
_EOF_OBJ as cell
EOF_OBJ as pointer
oblist as pointer
global_env as pointer
c_nest as pointer
LAMBDA as pointer
QUOTE as pointer
QQUOTE as pointer
UNQUOTE as pointer
UNQUOTESP as pointer
FEED_TO as pointer
COLON_HOOK as pointer
ERROR_HOOK as pointer
SHARP_HOOK as pointer
COMPILE_HOOK as pointer
free_cell as pointer
fcells as clong
inport as pointer
outport as pointer
save_inport as pointer
loadport as pointer
load_stack(0 to 63) as port
nesting_stack(0 to 63) as long
file_i as long
nesting as long
gc_verbose as byte
no_memory as byte
linebuff as zstring * 1024
strbuff as zstring * 256
tmpfp as FILE ptr
tok as long
print_flag as long
value as pointer
op as long
ext_data as any ptr
gensym_cnt as clong
vptr as scheme_interface ptr
dump_base as any ptr
dump_size as long
end type

const CELL_SEGSIZE = 5000
const CELL_NSEGMENT = 10
const MAXFIL = 64
const LINESIZE = 1024
const STRBUFFSIZE = 256

type scheme_opcodes as long
enum
OP_LOAD
OP_T0LVL
OP_T1LVL
OP_READ_INTERNAL
OP_GENSYM
OP_VALUEPRINT
OP_EVAL
OP_REAL_EVAL
OP_E0ARGS
OP_E1ARGS
OP_APPLY
OP_REAL_APPLY
OP_TRACING
OP_DOMACRO
OP_LAMBDA
OP_LAMBDA1
OP_MKCLOSURE
OP_QUOTE
OP_DEF0
OP_DEF1
OP_DEFP
OP_BEGIN
OP_IF0
OP_IF1
OP_SET0
OP_SET1
OP_LET0
OP_LET1
OP_LET2
OP_LET0AST
OP_LET1AST
OP_LET2AST
OP_LET0REC
OP_LET1REC
OP_LET2REC
OP_COND0
OP_COND1
OP_DELAY
OP_AND0
OP_AND1
OP_OR0
OP_OR1
OP_C0STREAM
OP_C1STREAM
OP_MACRO0
OP_MACRO1
OP_CASE0
OP_CASE1
OP_CASE2
OP_PEVAL
OP_PAPPLY
OP_CONTINUATION
OP_INEX2EX
OP_EXP
OP_LOG
OP_SIN
OP_COS
OP_TAN
OP_ASIN
OP_ACOS
OP_ATAN
OP_SQRT
OP_EXPT
OP_FLOOR
OP_CEILING
OP_TRUNCATE
OP_ROUND
OP_ADD
OP_SUB
OP_MUL
OP_DIV
OP_INTDIV
OP_REM
OP_MOD
OP_CAR
OP_CDR
OP_CONS
OP_SETCAR
OP_SETCDR
OP_CHAR2INT
OP_INT2CHAR
OP_CHARUPCASE
OP_CHARDNCASE
OP_SYM2STR
OP_ATOM2STR
OP_STR2SYM
OP_STR2ATOM
OP_MKSTRING
OP_STRLEN
OP_STRREF
OP_STRSET
OP_STRAPPEND
OP_SUBSTR
OP_VECTOR
OP_MKVECTOR
OP_VECLEN
OP_VECREF
OP_VECSET
OP_NOT
OP_BOOLP
OP_EOFOBJP
OP_NULLP
OP_NUMEQ
OP_LESS
OP_GRE
OP_LEQ
OP_GEQ
OP_SYMBOLP
OP_NUMBERP
OP_STRINGP
OP_INTEGERP
OP_REALP
OP_CHARP
OP_CHARAP
OP_CHARNP
OP_CHARWP
OP_CHARUP
OP_CHARLP
OP_PORTP
OP_INPORTP
OP_OUTPORTP
OP_PROCP
OP_PAIRP
OP_LISTP
OP_ENVP
OP_VECTORP
OP_EQ
OP_EQV
OP_FORCE
OP_SAVE_FORCED
OP_WRITE
OP_WRITE_CHAR
OP_DISPLAY
OP_NEWLINE
OP_ERR0
OP_ERR1
OP_REVERSE
OP_LIST_STAR
OP_APPEND
OP_QUIT
OP_GC
OP_GCVERB
OP_NEWSEGMENT
OP_OBLIST
OP_CURR_INPORT
OP_CURR_OUTPORT
OP_OPEN_INFILE
OP_OPEN_OUTFILE
OP_OPEN_INOUTFILE
OP_OPEN_INSTRING
OP_OPEN_INOUTSTRING
OP_OPEN_OUTSTRING
OP_GET_OUTSTRING
OP_CLOSE_INPORT
OP_CLOSE_OUTPORT
OP_INT_ENV
OP_CURR_ENV
OP_READ
OP_READ_CHAR
OP_PEEK_CHAR
OP_CHAR_READY
OP_SET_INPORT
OP_SET_OUTPORT
OP_RDSEXPR
OP_RDLIST
OP_RDDOT
OP_RDQUOTE
OP_RDQQUOTE
OP_RDQQUOTEVEC
OP_RDUNQUOTE
OP_RDUQTSP
OP_RDVEC
OP_P0LIST
OP_P1LIST
OP_PVECFROM
OP_LIST_LENGTH
OP_ASSQ
OP_GET_CLOSURE
OP_CLOSUREP
OP_MACROP
OP_MAXDEFINED
end enum

'' TODO: #define _OP_DEF(A,B,C,D,E,OP) OP,
#undef _OP_DEF
#define cons(sc, a, b) _cons(sc, a, b, 0)
#define immutable_cons(sc, a, b) _cons(sc, a, b, 1)
declare function is_string(byval p as pointer) as long
declare function string_value(byval p as pointer) as zstring ptr
declare function is_number(byval p as pointer) as long
declare function nvalue(byval p as pointer) as num
declare function ivalue(byval p as pointer) as clong
declare function rvalue(byval p as pointer) as double
declare function is_integer(byval p as pointer) as long
declare function is_real(byval p as pointer) as long
declare function is_character(byval p as pointer) as long
declare function charvalue(byval p as pointer) as clong
declare function is_vector(byval p as pointer) as long
declare function is_port(byval p as pointer) as long
declare function is_pair(byval p as pointer) as long
declare function pair_car(byval p as pointer) as pointer
declare function pair_cdr(byval p as pointer) as pointer
declare function set_car(byval p as pointer, byval q as pointer) as pointer
declare function set_cdr(byval p as pointer, byval q as pointer) as pointer
declare function is_symbol(byval p as pointer) as long
declare function symname(byval p as pointer) as zstring ptr
declare function hasprop(byval p as pointer) as long
declare function is_syntax(byval p as pointer) as long
declare function is_proc(byval p as pointer) as long
declare function is_foreign(byval p as pointer) as long
declare function syntaxname(byval p as pointer) as zstring ptr
declare function is_closure(byval p as pointer) as long
declare function closure_code(byval p as pointer) as pointer
declare function closure_env(byval p as pointer) as pointer
declare function is_continuation(byval p as pointer) as long
declare function is_promise(byval p as pointer) as long
declare function is_environment(byval p as pointer) as long
declare function is_immutable(byval p as pointer) as long
declare sub setimmutable(byval p as pointer)

end extern
scheme.bi

Code: [Select]

#pragma once

#include once "crt/long.bi"
#include once "crt/stdio.bi"

extern "C"

#define _SCHEME_H
const STANDALONE = 1
const USE_STRCASECMP = 1
const USE_STRLWR = 1
#define SCHEME_EXPORT
#define USE_SCHEME_STACK
const USE_MATH = 1
const USE_CHAR_CLASSIFIERS = 1
const USE_ASCII_NAMES = 1
const USE_STRING_PORTS = 1
const USE_TRACING = 1
const USE_PLIST = 0
const USE_ERROR_HOOK = 1
const USE_COLON_HOOK = 1
const STDIO_ADDS_CR = 0
#define INLINE
const USE_INTERFACE = 0
const SHOW_ERROR_LINE = 1

type pointer as cell ptr
type func_alloc as function(byval as uinteger) as any ptr
type func_dealloc as sub(byval as any ptr)

union num_value
ivalue as clong
rvalue as double
end union

type num
is_fixnum as byte
value as num_value
end type

declare function scheme_init_new() as scheme ptr
declare function scheme_init_new_custom_alloc(byval malloc as func_alloc, byval free as func_dealloc) as scheme ptr
declare function scheme_init(byval sc as scheme ptr) as long
declare function scheme_init_custom_alloc(byval sc as scheme ptr, byval as func_alloc, byval as func_dealloc) as long
declare sub scheme_deinit(byval sc as scheme ptr)
declare sub scheme_set_input_port_file(byval sc as scheme ptr, byval fin as FILE ptr)
declare sub scheme_set_input_port_string(byval sc as scheme ptr, byval start as zstring ptr, byval past_the_end as zstring ptr)
declare sub scheme_set_output_port_file(byval sc as scheme ptr, byval fin as FILE ptr)
declare sub scheme_set_output_port_string(byval sc as scheme ptr, byval start as zstring ptr, byval past_the_end as zstring ptr)
declare sub scheme_load_file(byval sc as scheme ptr, byval fin as FILE ptr)
declare sub scheme_load_named_file(byval sc as scheme ptr, byval fin as FILE ptr, byval filename as const zstring ptr)
declare sub scheme_load_string(byval sc as scheme ptr, byval cmd as const zstring ptr)
declare function scheme_apply0(byval sc as scheme ptr, byval procname as const zstring ptr) as pointer
declare function scheme_call(byval sc as scheme ptr, byval func as pointer, byval args as pointer) as pointer
declare function scheme_eval(byval sc as scheme ptr, byval obj as pointer) as pointer
declare sub scheme_set_external_data(byval sc as scheme ptr, byval p as any ptr)
declare sub scheme_define(byval sc as scheme ptr, byval env as pointer, byval symbol as pointer, byval value as pointer)
type foreign_func as function(byval as scheme ptr, byval as pointer) as pointer
declare function _cons(byval sc as scheme ptr, byval a as pointer, byval b as pointer, byval immutable as long) as pointer
declare function mk_integer(byval sc as scheme ptr, byval num as clong) as pointer
declare function mk_real(byval sc as scheme ptr, byval num as double) as pointer
declare function mk_symbol(byval sc as scheme ptr, byval name as const zstring ptr) as pointer
declare function gensym(byval sc as scheme ptr) as pointer
declare function mk_string(byval sc as scheme ptr, byval str as const zstring ptr) as pointer
declare function mk_counted_string(byval sc as scheme ptr, byval str as const zstring ptr, byval len as long) as pointer
declare function mk_empty_string(byval sc as scheme ptr, byval len as long, byval fill as byte) as pointer
declare function mk_character(byval sc as scheme ptr, byval c as long) as pointer
declare function mk_foreign_func(byval sc as scheme ptr, byval f as foreign_func) as pointer
declare sub putstr(byval sc as scheme ptr, byval s as const zstring ptr)
declare function list_length(byval sc as scheme ptr, byval a as pointer) as long
declare function eqv(byval a as pointer, byval b as pointer) as long

end extern


[jack]

Arnold
here's a patched scheme.bi and a tiny example that compiles and runs ok in FB using your dll

scheme.bi

Code: [Select]

#pragma once

#include once "crt/long.bi"
#include once "crt/stdio.bi"
#inclib "tinyscheme"

extern "C"

#define _SCHEME_H
const STANDALONE = 1
const USE_STRCASECMP = 1
const USE_STRLWR = 1
#define SCHEME_EXPORT
#define USE_SCHEME_STACK
const USE_MATH = 1
const USE_CHAR_CLASSIFIERS = 1
const USE_ASCII_NAMES = 1
const USE_STRING_PORTS = 1
const USE_TRACING = 1
const USE_PLIST = 0
const USE_ERROR_HOOK = 1
const USE_COLON_HOOK = 1
const STDIO_ADDS_CR = 0
#define INLINE
const USE_INTERFACE = 0
const SHOW_ERROR_LINE = 1

type pointer_ as cell ptr
type func_alloc as function(byval as uinteger) as any ptr
type func_dealloc as sub(byval as any ptr)

union num_value
ivalue as clong
rvalue as double
end union

type num
is_fixnum as byte
value as num_value
end type

type scheme as scheme_
declare function scheme_init_new() as scheme ptr
declare function scheme_init_new_custom_alloc(byval malloc as func_alloc, byval free as func_dealloc) as scheme ptr
declare function scheme_init(byval sc as scheme ptr) as long
declare function scheme_init_custom_alloc(byval sc as scheme ptr, byval as func_alloc, byval as func_dealloc) as long
declare sub scheme_deinit(byval sc as scheme ptr)
declare sub scheme_set_input_port_file(byval sc as scheme ptr, byval fin as FILE ptr)
declare sub scheme_set_input_port_string(byval sc as scheme ptr, byval start as zstring ptr, byval past_the_end as zstring ptr)
declare sub scheme_set_output_port_file(byval sc as scheme ptr, byval fin as FILE ptr)
declare sub scheme_set_output_port_string(byval sc as scheme ptr, byval start as zstring ptr, byval past_the_end as zstring ptr)
declare sub scheme_load_file(byval sc as scheme ptr, byval fin as FILE ptr)
declare sub scheme_load_named_file(byval sc as scheme ptr, byval fin as FILE ptr, byval filename as const zstring ptr)
declare sub scheme_load_string(byval sc as scheme ptr, byval cmd as const zstring ptr)
declare function scheme_apply0(byval sc as scheme ptr, byval procname as const zstring ptr) as pointer_
declare function scheme_call(byval sc as scheme ptr, byval func as pointer_, byval args as pointer_) as pointer_
declare function scheme_eval(byval sc as scheme ptr, byval obj as pointer_) as pointer_
declare sub scheme_set_external_data(byval sc as scheme ptr, byval p as any ptr)
declare sub scheme_define(byval sc as scheme ptr, byval env as pointer_, byval symbol as pointer_, byval value as pointer_)
type foreign_func as function(byval as scheme ptr, byval as pointer_) as pointer_
declare function _cons(byval sc as scheme ptr, byval a as pointer_, byval b as pointer_, byval immutable as long) as pointer_
declare function mk_integer(byval sc as scheme ptr, byval num as clong) as pointer_
declare function mk_real(byval sc as scheme ptr, byval num as double) as pointer_
declare function mk_symbol(byval sc as scheme ptr, byval name as const zstring ptr) as pointer_
declare function gensym(byval sc as scheme ptr) as pointer_
declare function mk_string(byval sc as scheme ptr, byval str as const zstring ptr) as pointer_
declare function mk_counted_string(byval sc as scheme ptr, byval str as const zstring ptr, byval len as long) as pointer_
declare function mk_empty_string(byval sc as scheme ptr, byval len as long, byval fill as byte) as pointer_
declare function mk_character(byval sc as scheme ptr, byval c as long) as pointer_
declare function mk_foreign_func(byval sc as scheme ptr, byval f as foreign_func) as pointer_
declare sub putstr(byval sc as scheme ptr, byval s as const zstring ptr)
declare function list_length(byval sc as scheme ptr, byval a as pointer_) as long
declare function eqv_(byval a as pointer_, byval b as pointer_) as long

type scheme_interface
scheme_define as sub(byval sc as scheme ptr, byval env as pointer_, byval symbol as pointer_, byval value as pointer_)
cons as function(byval sc as scheme ptr, byval a as pointer_, byval b as pointer_) as pointer_
immutable_cons as function(byval sc as scheme ptr, byval a as pointer_, byval b as pointer_) as pointer_
reserve_cells as function(byval sc as scheme ptr, byval n as long) as pointer_
mk_integer as function(byval sc as scheme ptr, byval num as clong) as pointer_
mk_real as function(byval sc as scheme ptr, byval num as double) as pointer_
mk_symbol as function(byval sc as scheme ptr, byval name as const zstring ptr) as pointer_
gensym as function(byval sc as scheme ptr) as pointer_
mk_string as function(byval sc as scheme ptr, byval str as const zstring ptr) as pointer_
mk_counted_string as function(byval sc as scheme ptr, byval str as const zstring ptr, byval len as long) as pointer_
mk_character as function(byval sc as scheme ptr, byval c as long) as pointer_
mk_vector as function(byval sc as scheme ptr, byval len as long) as pointer_
mk_foreign_func as function(byval sc as scheme ptr, byval f as foreign_func) as pointer_
putstr as sub(byval sc as scheme ptr, byval s as const zstring ptr)
putcharacter as sub(byval sc as scheme ptr, byval c as long)
is_string as function(byval p as pointer_) as long
string_value as function(byval p as pointer_) as zstring ptr
is_number as function(byval p as pointer_) as long
nvalue as function(byval p as pointer_) as num
ivalue as function(byval p as pointer_) as clong
rvalue as function(byval p as pointer_) as double
is_integer as function(byval p as pointer_) as long
is_real as function(byval p as pointer_) as long
is_character as function(byval p as pointer_) as long
charvalue as function(byval p as pointer_) as clong
is_list as function(byval sc as scheme ptr, byval p as pointer_) as long
is_vector as function(byval p as pointer_) as long
list_length as function(byval sc as scheme ptr, byval vec as pointer_) as long
vector_length as function(byval vec as pointer_) as clong
fill_vector as sub(byval vec as pointer_, byval elem as pointer_)
vector_elem as function(byval vec as pointer_, byval ielem as long) as pointer_
set_vector_elem as function(byval vec as pointer_, byval ielem as long, byval newel as pointer_) as pointer_
is_port as function(byval p as pointer_) as long
is_pair as function(byval p as pointer_) as long
pair_car as function(byval p as pointer_) as pointer_
pair_cdr as function(byval p as pointer_) as pointer_
set_car as function(byval p as pointer_, byval q as pointer_) as pointer_
set_cdr as function(byval p as pointer_, byval q as pointer_) as pointer_
is_symbol as function(byval p as pointer_) as long
symname as function(byval p as pointer_) as zstring ptr
is_syntax as function(byval p as pointer_) as long
is_proc as function(byval p as pointer_) as long
is_foreign as function(byval p as pointer_) as long
syntaxname as function(byval p as pointer_) as zstring ptr
is_closure as function(byval p as pointer_) as long
is_macro as function(byval p as pointer_) as long
closure_code as function(byval p as pointer_) as pointer_
closure_env as function(byval p as pointer_) as pointer_
is_continuation as function(byval p as pointer_) as long
is_promise as function(byval p as pointer_) as long
is_environment as function(byval p as pointer_) as long
is_immutable as function(byval p as pointer_) as long
setimmutable as sub(byval p as pointer_)
load_file as sub(byval sc as scheme ptr, byval fin as FILE ptr)
load_string as sub(byval sc as scheme ptr, byval input as const zstring ptr)
end type

end extern
tiny-example.bas

Code: [Select]

#include "scheme.bi"

dim env as scheme ptr
dim as file ptr fptr
env = scheme_init_new()
scheme_set_output_port_file(env, stdout)
fptr = fopen("init.scm", "r")
scheme_load_file(env, fptr)
fclose(fptr)
fptr = fopen("tiny-scheme-example.scm", "r")
scheme_load_file(env, fptr)
fclose(fptr)
scheme_deinit(env)
tiny-scheme-example.scm

Code: [Select]

(display "hello world!")
(newline)

output

Code: [Select]

hello world!
edit
the example posted by John here https://www.oxygenbasic.org/forum/index.php?topic=1185.msg11033#msg11033 works also.

[jack]

minimalist example

Code: [Select]

#include once "crt/stdio.bi"
#inclib "tinyscheme"

type scheme as scheme_
extern "C"
declare function scheme_init_new() as scheme ptr
declare sub scheme_set_output_port_file(byval sc as scheme ptr, byval fin as FILE ptr)
declare sub scheme_load_file(byval sc as scheme ptr, byval fin as FILE ptr)
declare sub scheme_deinit(byval sc as scheme ptr)
end extern

dim env as scheme ptr
dim as file ptr fptr
env = scheme_init_new()
scheme_set_output_port_file(env, stdout)
fptr = fopen("init.scm", "r")
scheme_load_file(env, fptr)
fclose(fptr)
fptr = fopen("tiny-scheme-example.scm", "r")
scheme_load_file(env, fptr)
fclose(fptr)
scheme_deinit(env)


[Arnold]

Hi Jack,

thank you for this great work. I had not yet the chance to investigate the bi files, but I was able to compile and run your examples right out of the box. That is really great! Now that you proved that tinyscheme can be run with Freebasic, I am quite sure that it will work with Oxygenbasic too.

Roland

[Arnold]

This is only a proof of the concept which I would not have found without the help of Jack. The file should be copied into the created folder from my first message. It will run ascii_mandel.scm and kings_reward.scm.

As I was able to compile tinyscheme to a 64-bit dll too, it should be possible to use it in 64-bit mode also. But I have not yet tested this.

I used the approach of Mike and Charles to make I/O work with msvcrt.dll. Probably some more work will be necessary to get the most benefit from the collaboration between O2 and Tinyscheme. But at the moment I am exploring newLisp which is a very fascinating language.

tiny-test.o2bas:

Code: [Select]

$ filename "tiny-test.exe"
'uses rtl32

uses corewin
uses console

indexbase 0

' msvcrt.dll additions
'-------------------------------------------
type FILE
   char* _ptr
   int   _cnt
   char* _base
   int   _flag
   int   _file
   int   _charbuf
   int   _bufsiz
   char* _tmpfname
end type

% _IONBF        0x4
% _O_TEXT       0x4000
% STDIN_FILENO  0
% STDOUT_FILENO 1
% STDERR_FILENO 2

#ifndef mode64bit
   FILE* _iob = __p__iob()
#else
   FILE* _iob = __iob_func()
#endif

sys stdin  = @_iob(STDIN_FILENO)
sys stdout = @_iob(STDOUT_FILENO)
sys stderr = @_iob(STDERR_FILENO)

sys hCrt = _open_osfhandle(ConsIn, _O_TEXT)
sys hf   = _fdopen(hCrt, "r")
memcpy  stdin, hf, sizeof(FILE)
setvbuf stdin, NULL, _IONBF, 0

hCrt = _open_osfhandle(ConsOut, _O_TEXT)
hf   = _fdopen(hCrt, "w")
memcpy  stdout, hf, sizeof(FILE)
setvbuf stdout, NULL, _IONBF, 0

ConsErr = GetStdHandle STD_ERROR_HANDLE // not gotten in Console.inc!!!
hCrt = _open_osfhandle(ConsErr, _O_TEXT)
hf   = _fdopen(hCrt, "w")
memcpy  stderr, hf, sizeof(FILE)
setvbuf stderr, NULL, _IONBF, 0
'-------------------------------------------


! scheme_init     lib "tinyscheme.dll"
! scheme_init_new lib "tinyscheme.dll"
! scheme_deinit   lib "tinyscheme.dll"
! scheme_load_string          lib "tinyscheme.dll"
! scheme_set_output_port_file lib "tinyscheme.dll"
! scheme_load_file lib "tinyscheme.dll"


typedef sys scheme

sys env
sys fptr

env = scheme_init_new()

cls
printl "Wait..."

scheme_set_output_port_file(env, stdout)
fptr = fopen("init.scm", "r")
scheme_load_file(env, fptr)
fclose(fptr)

fptr = fopen("ascii_mandel.scm", "r")
scheme_load_file(env, fptr)
fclose(fptr)

printl "Enter ..."
waitkey

cls
fptr = fopen("kings_reward.scm", "r")
scheme_load_file(env, fptr)
fclose(fptr)

scheme_deinit(env)

printl "Enter ..."
waitkey


[Charles Pegge]

NewLisp seems to be more developed than Scheme

http://www.newlisp.org/

[Arnold]

newLISP is a lispish-like language, not a real Lisp or Scheme. But it is much easier to understand and to learn. The app is available for several OS's, as an executable and also as a shared library, which works very well together with Oxygenbasic. I was able to create an interpreter in Oxygen (without the command-line options) which works almost the same way like the executable. This allows me to learn and test the possibilities of the language. One problem with newlisp.dll was using read-line and read-key in the console. This could be solved with the same msvcrt helper routines of tiny-test.o2bas. Many built-in functions are provided which would be much work to develop them in O2, though it is probably makeable.

There is one function which I need to test for possible use - newLispCallback. After that I will be ready to use O2 and newLisp for real tasks.