scsh-0.5/vm/prescheme.scm

48 lines
1.1 KiB
Scheme
Raw Normal View History

1995-10-13 23:34:21 -04:00
; Stuff in Pre-Scheme that is not in Scheme.
(define (ps-read-char port char-cont eof-cont)
(let ((next (read-char port)))
(if (eof-object? next)
(eof-cont)
(char-cont next))))
(define ashl arithmetic-shift)
(define (ashr i n)
(arithmetic-shift i (- 0 n)))
(define small* *) ; could do a range check
; What we will get in C.
(define pre-scheme-integer-size 32)
(define int-mask (- (arithmetic-shift 1 pre-scheme-integer-size) 1))
(define (lshr i n)
(if (>= i 0)
(arithmetic-shift i (- 0 n))
(arithmetic-shift (bitwise-and i int-mask) (- 0 n))))
(define (deallocate x) #f)
(define unassigned unspecific)
(define (write-string str port)
(do ((i 0 (+ i 1)))
((>= i (string-length str)))
(write-char (string-ref str i) port)))
(define-syntax goto
(lambda (exp rename compare)
(cdr exp)))
(define (null-port? x)
#f) ; no null-ports in Scheme
(define (call-external-value proc nargs pointer-to-args)
(error "~S" (list 'call-external-value proc nargs pointer-to-args)))
(define-syntax external
(lambda (exp rename compare)
(error "(EXTERNAL ...) can only be compiled" exp)))