;		       Copyright (C) 1992 by Marc Feeley -- all rights reserved

;; "config.scm"

; Type tags

(##define-macro (type-fixnum)          0)
(##define-macro (type-special)         7)
(##define-macro (type-pair)            4)
(##define-macro (type-weak-pair)       1)
(##define-macro (type-placeholder)     5)
(##define-macro (type-subtyped)        3)
(##define-macro (type-procedure)       2)

; Subtype tags

(##define-macro (subtype-vector)       0)
(##define-macro (subtype-symbol)       1)
(##define-macro (subtype-port)         2)
(##define-macro (subtype-ratnum)       3)
(##define-macro (subtype-cpxnum)       4)
(##define-macro (subtype-frame)        5)
(##define-macro (subtype-task)         6)
(##define-macro (subtype-string)       16)
(##define-macro (subtype-bignum)       17)
(##define-macro (subtype-flonum)       18)
(##define-macro (subtype-ovector? x)   `(##fixnum.< ,x 16))

; Miscellaneous

(##define-macro (type-range)       8)
(##define-macro (subtype-range)   32)
(##define-macro (char-range)     256)
(##define-macro (char-up-to-down) 32)
(##define-macro (char-whitespace c) `(##char<=? ,c #\space))

; Special objects

(##define-macro (data-undef)     -3)
(##define-macro (data-unass)     -4)
(##define-macro (data-unbound)   -5)
(##define-macro (data-eof)       -6)

; Bignum related constants

(##define-macro (max-fixnum)        268435455)
(##define-macro (min-fixnum)       -268435456)
(##define-macro (radix)                 16384) ; must be <= sqrt(max fixnum)+1
(##define-macro (radix-width)              14)
(##define-macro (radix-minus-1)         16383)
(##define-macro (minus-radix)          -16384)
(##define-macro (min-fixnum-div-radix) -16384) ; truncate( min fixnum / radix )
(##define-macro (max-digits-for-fixnum)     3) ; bignum if > this many digits

(##define-macro (radix-log-den)      32)
(##define-macro (r.2)                16384)
(##define-macro (r-log-rad.2)        14)
(##define-macro (radix-log-r-num.2)  32)
(##define-macro (r.8)                4096)
(##define-macro (r-log-rad.8)        4)
(##define-macro (radix-log-r-num.8)  38)
(##define-macro (r.10)               10000)
(##define-macro (r-log-rad.10)       4)
(##define-macro (radix-log-r-num.10) 34)
(##define-macro (r.16)               4096)
(##define-macro (r-log-rad.16)       3)
(##define-macro (radix-log-r-num.16) 38)

; Flonum related constants

(##define-macro (flonum-m-bits)         52)
(##define-macro (flonum-e-bits)         11)
(##define-macro (flonum-sign-bit)       #x8000000000000000) ; (expt 2 (+ (flonum-e-bits) (flonum-m-bits)))
(##define-macro (flonum-m-min)          4503599627370496.0) ; (expt 2.0 (flonum-m-bits))
(##define-macro (flonum-+m-min)         4503599627370496)   ; (expt 2 (flonum-m-bits))
(##define-macro (flonum--m-min)         -4503599627370496)  ; (- (flonum-+m-min))
(##define-macro (flonum-e-bias)         1023) ; (- (expt 2 (- (flonum-e-bits) 1)) 1)
(##define-macro (flonum-e-bias-plus-1)  1024) ; (+ (flonum-e-bias) 1)
(##define-macro (flonum-e-bias-minus-1) 1022) ; (- (flonum-e-bias) 1)
(##define-macro (flonum-max-digits)     17)

(##define-macro (inexact-radix)   16384.0) ; (exact->inexact (radix))

; Dispatch for number representation

(##define-macro (number-dispatch num err fix big rat flo cpx)
  `(cond ((##fixnum? ,num)                           ,fix)
         ((##subtyped? ,num)
          (let ((##s (##subtype ,num)))
            (cond ((##fixnum.= ##s (subtype-flonum)) ,flo)
                  ((##fixnum.= ##s (subtype-bignum)) ,big)
                  ((##fixnum.= ##s (subtype-ratnum)) ,rat)
                  ((##fixnum.= ##s (subtype-cpxnum)) ,cpx)
                  (else                              ,err))))
         (else                                       ,err)))

; System procedure classes

(##define-macro (define-system form . exprs)

  (define inlinable-procs '(

##TYPE ##TYPE-CAST ##SUBTYPE ##SUBTYPE-SET!
##NOT ##NULL? ##UNASSIGNED? ##UNBOUND? ##EQ?
##FIXNUM? ##SPECIAL? ##PAIR? ##WEAK-PAIR? ##SUBTYPED? ##PROCEDURE? ##PLACEHOLDER?
##VECTOR? ##SYMBOL? ##PORT? ##RATNUM? ##CPXNUM?
##STRING? ##BIGNUM? ##FLONUM?
##CHAR?
##FIXNUM.+ ##FIXNUM.- ##FIXNUM.*
##FIXNUM.QUOTIENT ##FIXNUM.REMAINDER ##FIXNUM.MODULO
##FIXNUM.LOGIOR ##FIXNUM.LOGXOR ##FIXNUM.LOGAND ##FIXNUM.LOGNOT ##FIXNUM.ASH
##FIXNUM.ZERO? ##FIXNUM.POSITIVE? ##FIXNUM.NEGATIVE?
##FIXNUM.ODD? ##FIXNUM.EVEN?
##FIXNUM.= ##FIXNUM.< ##FIXNUM.> ##FIXNUM.<= ##FIXNUM.>=
##FLONUM.->FIXNUM ##FLONUM.<-FIXNUM
##FLONUM.+ ##FLONUM.- ##FLONUM.*  ##FLONUM./
##FLONUM.ABS ##FLONUM.TRUNCATE ##FLONUM.ROUND ##FLONUM.EXP ##FLONUM.LOG
##FLONUM.SIN ##FLONUM.COS ##FLONUM.TAN
##FLONUM.ASIN ##FLONUM.ACOS ##FLONUM.ATAN
##FLONUM.SQRT
##FLONUM.ZERO? ##FLONUM.POSITIVE? ##FLONUM.NEGATIVE?
##FLONUM.= ##FLONUM.< ##FLONUM.> ##FLONUM.<= ##FLONUM.>=
##CHAR=? ##CHAR<? ##CHAR>? ##CHAR<=? ##CHAR>=?
##CONS ##SET-CAR! ##SET-CDR! ##CAR ##CDR
##CAAR ##CADR ##CDAR ##CDDR
##CAAAR ##CAADR ##CADAR ##CADDR ##CDAAR ##CDADR ##CDDAR ##CDDDR
##CAAAAR ##CAAADR ##CAADAR ##CAADDR ##CADAAR ##CADADR ##CADDAR ##CADDDR
##CDAAAR ##CDAADR ##CDADAR ##CDADDR ##CDDAAR ##CDDADR ##CDDDAR ##CDDDDR
##WEAK-CONS ##WEAK-SET-CAR! ##WEAK-SET-CDR! ##WEAK-CAR ##WEAK-CDR
##MAKE-CELL ##CELL-REF ##CELL-SET!
##VECTOR-LENGTH ##VECTOR-REF ##VECTOR-SET! ##VECTOR-SHRINK!
##STRING-LENGTH ##STRING-REF ##STRING-SET! ##STRING-SHRINK!
##VECTOR8-LENGTH ##VECTOR8-REF ##VECTOR8-SET! ##VECTOR8-SHRINK!
##VECTOR16-LENGTH ##VECTOR16-REF ##VECTOR16-SET! ##VECTOR16-SHRINK!
##SLOT-REF ##SLOT-SET!
##PSTATE
##TOUCH

))

  (define kernel-procs '(

##MAKE-VECTOR
##MAKE-STRING
##MAKE-VECTOR16
##APPLY
##CALL-WITH-CURRENT-CONTINUATION
##GLOBAL-VAR
##GLOBAL-VAR-REF
##GLOBAL-VAR-SET!

))

  (if (memq (car form) kernel-procs)
    `(BEGIN)
    (if (and (memq (car form) inlinable-procs)
             (list? (cdr form)))
      `(DEFINE ,form ,form)
      `(DEFINE ,form ,@exprs))))