Retropikzel
/
foreign-c-libraries
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Bugfixes to c-stdio

This commit is contained in:
retropikzel 2026-02-27 10:28:17 +02:00
parent a2ac0c10b2
commit 0951c240bc
2 changed files with 20 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
Makefile
View File

@ -35,7 +35,7 @@ init-venv: build
rm -rf venv
scheme-venv ${SCHEME} ${RNRS} venv
echo "(import (scheme base) (scheme write) (scheme read) (scheme char) (scheme file) (scheme process-context) (srfi 64) (retropikzel ${LIBRARY}))" > venv/test.scm
printf "#!r6rs\n(import (rnrs) (srfi :64) (retropikzel ${LIBRARY}))" > venv/test.sps
printf "#!r6rs\n(import (except (rnrs) remove) (srfi :64) (retropikzel ${LIBRARY}))" > venv/test.sps
cat ${TESTFILE} >> venv/test.scm
cat ${TESTFILE} >> venv/test.sps
if [ "${RNRS}" = "r6rs" ]; then if [ -d ../foreign-c ]; then cp -r ../foreign-c/foreign venv/lib/; fi; fi
@ -73,7 +73,7 @@ example-r7rs: example.scm
./example
test-r6rs:
echo "(import (rnrs) (foreign c) (retropikzel ${LIBRARY}) (srfi :64))" > test-r6rs.sps
echo "(import (except (rnrs) remove) (foreign c) (retropikzel ${LIBRARY}) (srfi :64))" > test-r6rs.sps
cat retropikzel/${LIBRARY}/test.scm >> test-r6rs.sps
akku install chez-srfi akku-r7rs
COMPILE_R7RS=${SCHEME} timeout 60 compile-scheme -I .akku/lib -o test-r6rs test-r6rs.sps

36
retropikzel/c-stdio.scm
View File

@ -1,22 +1,22 @@
(define-c-library libc '("stdio.h") #f '())
(define-c-procedure fopen libc 'fopen 'pointer '(pointer pointer))
(define-c-procedure fclose libc 'fclose 'int '(pointer))
(define-c-procedure feof 'feof 'int '(pointer))
(define-c-procedure ferror 'ferror 'int '(pointer))
(define-c-procedure fgetc 'fgetc 'int '(pointer))
(define-c-procedure fgetcs 'fgetcs 'pointer '(pointer int pointer))
(define-c-procedure fputc 'fputc 'int '(int pointer))
(define-c-procedure fputs 'fputs 'int '(pointer pointer))
(define-c-procedure fread 'fread 'int '(pointer int int pointer))
(define-c-procedure fseek 'fseek 'int '(pointer long int))
(define-c-procedure ftell 'ftell 'long '(pointer))
(define-c-procedure fwrite 'fwrite 'int '(pointer int int pointer))
(define-c-procedure getc 'fwrite 'int '(pointer))
(define-c-procedure getchar 'getchar 'int '())
(define-c-procedure putc 'putc 'int '(int pointer))
(define-c-procedure putchar 'putchar 'int '(int))
(define-c-procedure puts 'puts 'int '(pointer))
(define-c-procedure remove 'remove 'int '(pointer))
(define-c-procedure rename 'rename 'int '(pointer pointer))
(define-c-procedure rewind 'rewind 'int '(pointer))
(define-c-procedure feof libc 'feof 'int '(pointer))
(define-c-procedure ferror libc 'ferror 'int '(pointer))
(define-c-procedure fgetc libc 'fgetc 'int '(pointer))
(define-c-procedure fgets libc 'fgets 'pointer '(pointer int pointer))
(define-c-procedure fputc libc 'fputc 'int '(int pointer))
(define-c-procedure fputs libc 'fputs 'int '(pointer pointer))
(define-c-procedure fread libc 'fread 'int '(pointer int int pointer))
(define-c-procedure fseek libc 'fseek 'int '(pointer long int))
(define-c-procedure ftell libc 'ftell 'long '(pointer))
(define-c-procedure fwrite libc 'fwrite 'int '(pointer int int pointer))
(define-c-procedure getc libc 'getc 'int '(pointer))
(define-c-procedure getchar libc 'getchar 'int '())
(define-c-procedure putc libc 'putc 'int '(int pointer))
(define-c-procedure putchar libc 'putchar 'int '(int))
(define-c-procedure puts libc 'puts 'int '(pointer))
(define-c-procedure remove libc 'remove 'int '(pointer))
(define-c-procedure rename libc 'rename 'int '(pointer pointer))
(define-c-procedure rewind libc 'rewind 'void '(pointer))