(define remove-foreign-entry)

(define load-shared-object)

(define foreign-entry?)

(let ()

(define $foreign-address-name

(foreign-procedure "(cs)foreign_address_name" (void*)

string))

(define $remove-foreign-entry

(foreign-procedure "(cs)remove_foreign_entry"

(string) scheme-object))

(set! $foreign-entries

(foreign-procedure "(cs)foreign_entries" ()

scheme-object))

(set! remove-foreign-entry

(lambda (entry)

(unless (string? entry)

($oops 'remove-foreign-entry "~s is not a string" entry))

(unless ($remove-foreign-entry entry)

($oops 'remove-foreign-entry "no entry for ~s" entry))))

(let ()

(define lookup

(foreign-procedure "(cs)lookup_foreign_entry" (string)

void*))

(set-who! foreign-entry?

(lambda (str)

(unless (string? str) ($oops who "~s is not a string" str))

(if (eqv? (lookup str) 0) #f #t)))

(set-who! foreign-entry

(lambda (str)

(unless (string? str) ($oops who "~s is not a string" str))

(let ([x (lookup str)])

(when (eqv? x 0) ($oops who "no entry for ~s" str))

x))))

(set-who! foreign-address-name

(lambda (n)

(define void*?

(constant-case ptr-bits

[(32) $integer-32?]

[(64) $integer-64?]))

(unless (void*? n) ($oops who "~s is not a valid address" n))

($foreign-address-name n)))

(set! load-shared-object

(if (foreign-entry? "(cs)load_shared_object")

(let ()

(define lso

(foreign-procedure "(cs)load_shared_object"

(string)

void))

(lambda (x)

(unless (or (string? x) (eq? x #f))

($oops 'load-shared-object "invalid path ~s" x))

(lso x)))

(lambda args

($oops 'load-shared-object "not supported"))))

) ;let