From: Guillermo J. Rozas Date: Thu, 28 Oct 1993 04:45:25 +0000 (+0000) Subject: Redo "word" registers. Rather than having specific C variables, and X-Git-Tag: 20090517-FFI~7655 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=3248f7551f9d67377d2d1996a8e9df92f2ff4885;p=mit-scheme.git Redo "word" registers. Rather than having specific C variables, and casting up the wazoo, there is now a union type for pointers and word values, and components are selected as needed. --- diff --git a/v7/src/compiler/machines/C/lapgen.scm b/v7/src/compiler/machines/C/lapgen.scm index 263de01ce..0db587f2b 100644 --- a/v7/src/compiler/machines/C/lapgen.scm +++ b/v7/src/compiler/machines/C/lapgen.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: lapgen.scm,v 1.5 1993/10/26 03:02:38 jawilson Exp $ +$Id: lapgen.scm,v 1.6 1993/10/28 04:45:19 gjr Exp $ Copyright (c) 1992-1993 Massachusetts Institute of Technology @@ -52,6 +52,8 @@ MIT in each case. |# (define (type->name type) (case type + ((WORD) + "machine_word") ((SCHEME_OBJECT) "SCHEME_OBJECT") ((SCHEME_OBJECT*) @@ -70,23 +72,15 @@ MIT in each case. |# (comp-internal-error "Unknown type" 'TYPE->NAME type)))) (define (reg*type->name reg type) - (case type - ((SCHEME_OBJECT) - (string-append "Obj" (number->string reg))) - ((SCHEME_OBJECT*) - (string-append "pObj" (number->string reg))) - ((LONG) - (string-append "Lng" (number->string reg))) - ((CHAR*) - (string-append "pChr" (number->string reg))) - ((ULONG) - (string-append "uLng" (number->string reg))) - ((DOUBLE) - (string-append "Dbl" (number->string reg))) - ((DOUBLE*) - (string-append "pDbl" (number->string reg))) - (else - (comp-internal-error "Unknown type" 'REG*TYPE->NAME type)))) + (string-append + (case type + ((WORD) + (string-append "Wrd" (number->string reg))) + ((DOUBLE) + (string-append "Dbl" (number->string reg))) + (else + (comp-internal-error "Unknown type" 'REG*TYPE->NAME type))) + (number->string reg))) (define (machine-register-name reg) (cond ((eq? reg regnum:stack-pointer) @@ -106,38 +100,12 @@ MIT in each case. |# (define (machine-register-type reg) (cond ((eq? reg regnum:value) "SCHEME_OBJECT") - #| - ((eq? reg regnum:stack-pointer) - "SCHEME_OBJECT *") - ((eq? reg regnum:free) - "SCHEME_OBJECT *") - ((eq? reg regnum:regs) - "SCHEME_OBJECT *") - ((eq? reg regnum:dynamic-link) - "SCHEME_OBJECT *") - (else - (comp-internal-error "Unknown machine register" - 'MACHINE-REGISTER-TYPE reg)) - |# (else "SCHEME_OBJECT *"))) (define (machine-register-type-symbol reg) (cond ((eq? reg regnum:value) 'SCHEME_OBJECT) - #| - ((eq? reg regnum:stack-pointer) - 'SCHEME_OBJECT*) - ((eq? reg regnum:free) - 'SCHEME_OBJECT*) - ((eq? reg regnum:regs) - 'SCHEME_OBJECT*) - ((eq? reg regnum:dynamic-link) - 'SCHEME_OBJECT*) - (else - (comp-internal-error "Unknown machine register" - 'MACHINE-REGISTER-TYPE-SYMBOL reg)) - |# (else 'SCHEME_OBJECT*))) @@ -162,62 +130,79 @@ MIT in each case. |# (cadr aliases)) (else false)))))) -(define (allocate-additional-alias reg type) - ;; This is flakey. - ;; After this, there are two aliases for the same RTL register, - ;; with incompatible types. - ;; Hopefully Liar will not mix the two up. - (let ((aliases (assq reg current-register-list))) +(define (allocate-register! reg type) + (let ((name (new-register-name reg type)) + (aliases (assq reg current-register-list))) (if (not aliases) - (error "allocate-additional-alias: No previous aliases" reg) - (let ((alias (assq type (cdr aliases)))) - (if alias - (error "allocate-additional-alias: Already has alias" reg) - (let ((name (new-register-name reg type))) - ;; Kludge! This depends on having at most two! - (if (eq? type 'DOUBLE) - (set-cdr! (last-pair aliases) (list (cons type name))) - (set-cdr! aliases - (cons (cons type name) - (cdr aliases)))) - name)))))) - -(define (standard-source! reg type) - (cond ((register-is-machine-register? reg) - (let ((name (machine-register-name reg))) - (if (eq? (machine-register-type-symbol reg) type) - name - (rhs-cast name type)))) - ((find-register reg type) + (set! current-register-list + (cons (list reg (cons type name)) + current-register-list)) + (set-cdr! aliases + (cons (cons type name) (cdr aliases)))) + name)) + +(define (find-register! reg type) + (cond ((find-register reg type) => cdr) - ((find-register reg false) - => (lambda (alias) - (if (compatible/C*C? (car alias) type) - (rhs-cast (cdr alias) type) - (allocate-additional-alias reg type)))) (else - (comp-internal-error "Unallocated register" - 'STANDARD-SOURCE! reg)))) + (allocate-register! reg type)))) -(define (standard-target! reg type) - (cond ((register-is-machine-register? reg) - (if (not (compatible/C*register? type (register-type reg))) - (error "standard-target!: Incompatible type register" reg type)) - (machine-register-name reg)) - ((find-register reg type) - => cdr) - ((find-register reg false) - => (lambda (alias) - (if (compatible/C*C? (car alias) type) - (lhs-cast (cdr alias) type) - (allocate-additional-alias reg type)))) - (else - (let ((name (new-register-name reg type))) - (set! current-register-list - (cons (list reg (cons type name)) - current-register-list)) - name)))) +(define-integrable (type->canonical-C-type type) + (if (eq? type 'DOUBLE) 'DOUBLE 'WORD)) + +(define (reg-select reg type) + (string-append + reg + (case type + ((SCHEME_OBJECT) ".Obj") + ((SCHEME_OBJECT*) ".pObj") + ((LONG) ".Lng") + ((CHAR*) ".pChr") + ((ULONG) ".uLng") + ((DOUBLE*) ".pDbl") + (else + (comp-internal-error "Unknown type" 'REG-SELECT type))))) + +(define (standard-source! reg type) + (let ((type* (type->canonical-C-type type))) + (cond ((register-is-machine-register? reg) + (let ((name (machine-register-name reg))) + (if (eq? (machine-register-type-symbol reg) type) + name + (rhs-cast name type)))) + ((find-register reg type*) + => (lambda (pair) + (let ((reg (cdr pair))) + (if (eq? type* 'DOUBLE) + reg + (reg-select reg type))))) + (else + (comp-internal-error "Unallocated register" + 'STANDARD-SOURCE! reg))))) +(define (standard-target! reg type) + (let* ((type* (type->canonical-C-type type)) + (finish (lambda (reg) + (if (eq? type* 'DOUBLE) + reg + (reg-select reg type))))) + + (cond ((register-is-machine-register? reg) + (if (not (compatible/C*register? type (register-type reg))) + (error "standard-target!: Incompatible type register" reg type)) + #| + ;; This should not be necessary. + ;; We should only assign correctly typed values + ;; to dedicated machine registers. + (lhs-cast (machine-register-name reg) type) + |# + (machine-register-name reg)) + ((find-register reg type*) + => (lambda (pair) + (finish (cdr pair)))) + (else + (finish (allocate-register! reg type*)))))) + (define (new-register-name reg type) (cond ((assq reg permanent-register-list) => (lambda (aliases) @@ -244,33 +229,30 @@ MIT in each case. |# permanent-register-list)) (define (standard-move-to-target! src tgt) - ;; This is bogus but we have no more information - - (define (do-tgt src src-type) - (let ((tgt (standard-target! tgt src-type))) - (LAP ,tgt " = " ,src ";\n\t"))) - - (define (do-src tgt tgt-type) - (let ((src (standard-source! src tgt-type))) - (LAP ,tgt " = " ,src ";\n\t"))) - - (cond ((register-is-machine-register? tgt) - (do-src (machine-register-name tgt) - (machine-register-type-symbol tgt))) - ((assq tgt current-register-list) - => (lambda (aliases) - (let ((alias (cadr aliases))) - (do-src (cdr alias) (car alias))))) - ((register-is-machine-register? src) - (do-tgt (machine-register-name src) - (machine-register-type-symbol src))) - ((assq src current-register-list) - => (lambda (aliases) - (let ((alias (cadr aliases))) - (do-tgt (cdr alias) (car alias))))) - (else - (comp-internal-error "Unallocated register" - 'STANDARD-MOVE-TO-TARGET! src)))) + (let ((src-type (register-type src))) + (cond ((not (eq? (register-type tgt) src-type)) + (comp-internal-error "Incompatible registers" + 'STANDARD-MOVE-TO-TARGET! + src tgt)) + ((register-is-machine-register? tgt) + (let ((src (standard-source! src + (machine-register-type-symbol tgt)))) + (LAP ,(machine-register-name tgt) " = " ,src ";\n\t"))) + ((register-is-machine-register? src) + (let ((tgt (standard-target! tgt + (machine-register-type-symbol src)))) + (LAP ,tgt " = " ,(machine-register-name src) ";\n\t"))) + (else + (let ((reg-type + (case src-type + ((WORD) 'WORD) + ((FLOAT) 'DOUBLE) + (else + (comp-internal-error "Unknown RTL register type" + 'STANDARD-MOVE-TO-TARGET! + src-type))))) + (LAP ,(find-register! tgt reg-type) " = " + ,(find-register! src reg-type) ";\n\t")))))) ;;;; Communicate with cout.scm diff --git a/v7/src/microcode/liarc.h b/v7/src/microcode/liarc.h index d0aaa805f..7651537e0 100644 --- a/v7/src/microcode/liarc.h +++ b/v7/src/microcode/liarc.h @@ -1,6 +1,6 @@ /* -*-C-*- -$Id: liarc.h,v 1.5 1993/10/27 00:57:26 gjr Exp $ +$Id: liarc.h,v 1.6 1993/10/28 04:45:25 gjr Exp $ Copyright (c) 1992-1993 Massachusetts Institute of Technology @@ -63,12 +63,19 @@ extern PTR dstack_position; extern SCHEME_OBJECT * Free; extern SCHEME_OBJECT * Ext_Stack_Pointer; extern SCHEME_OBJECT Registers[]; - -extern void EXFUN (lose_big, (char *)); -extern int EXFUN (multiply_with_overflow, (long, long, long *)); -extern SCHEME_OBJECT * EXFUN (invoke_utility, (int, long, long, long, long)); -extern void EXFUN (error_band_already_built, (void)); +union machine_word_u +{ + SCHEME_OBJECT Obj; + SCHEME_OBJECT * pObj; + long Lng; + char * pChr; + unsigned long uLng; + double * pDbl; +}; + +typedef union machine_word_u machine_word; + #define ERROR_UNKNOWN_DISPATCH( pc ) lose_big ("Unknown tag.") #define ADDRESS_UNITS_PER_OBJECT (sizeof (SCHEME_OBJECT)) @@ -346,36 +353,6 @@ REGISTER SCHEME_OBJECT * stack_pointer = Stack_Pointer ? (- ((source1) / (- (source2)))) \ : ((- (source1)) / (- (source2))))) -extern double EXFUN (acos, (double)); -extern double EXFUN (asin, (double)); -extern double EXFUN (atan, (double)); -extern double EXFUN (ceil, (double)); -extern double EXFUN (cos, (double)); -extern double EXFUN (exp, (double)); -extern double EXFUN (floor, (double)); -extern double EXFUN (log, (double)); -extern double EXFUN (sin, (double)); -extern double EXFUN (sqrt, (double)); -extern double EXFUN (tan, (double)); -extern double EXFUN (double_truncate, (double)); - -#define DOUBLE_ACOS acos -#define DOUBLE_ASIN asin -#define DOUBLE_ATAN atan -#define DOUBLE_CEILING ceil -#define DOUBLE_COS cos -#define DOUBLE_EXP exp -#define DOUBLE_FLOOR floor -#define DOUBLE_LOG log -#define DOUBLE_ROUND(dx) (double_truncate ((dx < 0) ? (dx - 0.5) : (dx + 0.5))) -#define DOUBLE_SIN sin -#define DOUBLE_SQRT sqrt -#define DOUBLE_TAN tan -#define DOUBLE_TRUNCATE double_truncate - -extern double EXFUN (atan2, (double, double)); -#define DOUBLE_ATAN2 atan2 - #define CLOSURE_HEADER(offset) do \ { \ SCHEME_OBJECT * entry = ((SCHEME_OBJECT *) my_pc[1]); \ @@ -405,14 +382,6 @@ extern double EXFUN (atan2, (double, double)); dynamic_link); \ } while (0) -#ifdef USE_STDARG -# define RCONSM_TYPE(frob) SCHEME_OBJECT EXFUN (frob, (int, SCHEME_OBJECT DOTS)) -#else /* not USE_STDARG */ -# define RCONSM_TYPE(frob) SCHEME_OBJECT frob () -#endif /* USE_STDARG */ - -extern RCONSM_TYPE(rconsm); - struct compiled_file { int number_of_procedures; @@ -420,13 +389,6 @@ struct compiled_file void * EXFUN ((**procs), (void)); }; -extern int EXFUN (declare_compiled_code, - (char *, - void EXFUN ((*), (void)), - SCHEME_OBJECT * EXFUN ((*), (SCHEME_OBJECT *)))); -extern SCHEME_OBJECT EXFUN (initialize_subblock, (char *)); -extern void EXFUN (NO_SUBBLOCKS, (void)); - /* This does nothing in the sources. */ #ifndef COMPILE_FOR_DYNAMIC_LOADING @@ -451,6 +413,60 @@ extern void EXFUN (NO_SUBBLOCKS, (void)); #endif /* COMPILE_FOR_DYNAMIC_LOADING */ +#ifdef USE_STDARG +# define RCONSM_TYPE(frob) SCHEME_OBJECT EXFUN (frob, (int, SCHEME_OBJECT DOTS)) +#else /* not USE_STDARG */ +# define RCONSM_TYPE(frob) SCHEME_OBJECT frob () +#endif /* USE_STDARG */ + +extern RCONSM_TYPE(rconsm); + +extern int + EXFUN (declare_compiled_code, + (char *, + void EXFUN ((*), (void)), + SCHEME_OBJECT * EXFUN ((*), (SCHEME_OBJECT *)))), + EXFUN (multiply_with_overflow, (long, long, long *)); + +extern SCHEME_OBJECT + EXFUN (initialize_subblock, (char *)), + * EXFUN (invoke_utility, (int, long, long, long, long)); + +extern void + EXFUN (NO_SUBBLOCKS, (void)), + EXFUN (lose_big, (char *)), + EXFUN (error_band_already_built, (void)); + +extern double + EXFUN (acos, (double)), + EXFUN (asin, (double)), + EXFUN (atan, (double)), + EXFUN (ceil, (double)), + EXFUN (cos, (double)), + EXFUN (exp, (double)), + EXFUN (floor, (double)), + EXFUN (log, (double)), + EXFUN (sin, (double)), + EXFUN (sqrt, (double)), + EXFUN (tan, (double)), + EXFUN (double_truncate, (double)), + EXFUN (atan2, (double, double)); + +#define DOUBLE_ACOS acos +#define DOUBLE_ASIN asin +#define DOUBLE_ATAN atan +#define DOUBLE_CEILING ceil +#define DOUBLE_COS cos +#define DOUBLE_EXP exp +#define DOUBLE_FLOOR floor +#define DOUBLE_LOG log +#define DOUBLE_ROUND(dx) (double_truncate ((dx < 0) ? (dx - 0.5) : (dx + 0.5))) +#define DOUBLE_SIN sin +#define DOUBLE_SQRT sqrt +#define DOUBLE_TAN tan +#define DOUBLE_TRUNCATE double_truncate +#define DOUBLE_ATAN2 atan2 + #ifdef __GNUC__ # ifdef hp9000s800 # define BUG_GCC_LONG_CALLS @@ -485,16 +501,20 @@ extern SCHEME_OBJECT EXFUN (make_primitive, (char *, int)); extern SCHEME_OBJECT EXFUN ((* (constructor_kludge [10])), ()); #define MEMORY_TO_STRING \ - ((SCHEME_OBJECT EXFUN ((*), (long, unsigned char *))) (constructor_kludge[0])) + ((SCHEME_OBJECT EXFUN ((*), (long, unsigned char *))) \ + (constructor_kludge[0])) #define MEMORY_TO_SYMBOL \ - ((SCHEME_OBJECT EXFUN ((*), (long, unsigned char *))) (constructor_kludge[1])) + ((SCHEME_OBJECT EXFUN ((*), (long, unsigned char *))) \ + (constructor_kludge[1])) #define MAKE_VECTOR \ - ((SCHEME_OBJECT EXFUN ((*), (long, SCHEME_OBJECT, Boolean))) (constructor_kludge[2])) + ((SCHEME_OBJECT EXFUN ((*), (long, SCHEME_OBJECT, Boolean))) \ + (constructor_kludge[2])) #define CONS \ - ((SCHEME_OBJECT EXFUN ((*), (SCHEME_OBJECT, SCHEME_OBJECT))) (constructor_kludge[3])) + ((SCHEME_OBJECT EXFUN ((*), (SCHEME_OBJECT, SCHEME_OBJECT))) \ + (constructor_kludge[3])) #define RCONSM \ ((RCONSM_TYPE ((*))) (constructor_kludge[4])) @@ -506,10 +526,12 @@ extern SCHEME_OBJECT EXFUN ((* (constructor_kludge [10])), ()); ((SCHEME_OBJECT EXFUN ((*), (long))) (constructor_kludge[6])) #define DIGIT_STRING_TO_INTEGER \ - ((SCHEME_OBJECT EXFUN ((*), (Boolean, long, char *))) (constructor_kludge[7])) + ((SCHEME_OBJECT EXFUN ((*), (Boolean, long, char *))) \ + (constructor_kludge[7])) #define DIGIT_STRING_TO_BIT_STRING \ - ((SCHEME_OBJECT EXFUN ((*), (long, long, char *))) (constructor_kludge[8])) + ((SCHEME_OBJECT EXFUN ((*), (long, long, char *))) \ + (constructor_kludge[8])) #define MAKE_PRIMITIVE \ ((SCHEME_OBJECT EXFUN ((*), (char *, int))) (constructor_kludge[9])) diff --git a/v8/src/microcode/liarc.h b/v8/src/microcode/liarc.h index d0aaa805f..7651537e0 100644 --- a/v8/src/microcode/liarc.h +++ b/v8/src/microcode/liarc.h @@ -1,6 +1,6 @@ /* -*-C-*- -$Id: liarc.h,v 1.5 1993/10/27 00:57:26 gjr Exp $ +$Id: liarc.h,v 1.6 1993/10/28 04:45:25 gjr Exp $ Copyright (c) 1992-1993 Massachusetts Institute of Technology @@ -63,12 +63,19 @@ extern PTR dstack_position; extern SCHEME_OBJECT * Free; extern SCHEME_OBJECT * Ext_Stack_Pointer; extern SCHEME_OBJECT Registers[]; - -extern void EXFUN (lose_big, (char *)); -extern int EXFUN (multiply_with_overflow, (long, long, long *)); -extern SCHEME_OBJECT * EXFUN (invoke_utility, (int, long, long, long, long)); -extern void EXFUN (error_band_already_built, (void)); +union machine_word_u +{ + SCHEME_OBJECT Obj; + SCHEME_OBJECT * pObj; + long Lng; + char * pChr; + unsigned long uLng; + double * pDbl; +}; + +typedef union machine_word_u machine_word; + #define ERROR_UNKNOWN_DISPATCH( pc ) lose_big ("Unknown tag.") #define ADDRESS_UNITS_PER_OBJECT (sizeof (SCHEME_OBJECT)) @@ -346,36 +353,6 @@ REGISTER SCHEME_OBJECT * stack_pointer = Stack_Pointer ? (- ((source1) / (- (source2)))) \ : ((- (source1)) / (- (source2))))) -extern double EXFUN (acos, (double)); -extern double EXFUN (asin, (double)); -extern double EXFUN (atan, (double)); -extern double EXFUN (ceil, (double)); -extern double EXFUN (cos, (double)); -extern double EXFUN (exp, (double)); -extern double EXFUN (floor, (double)); -extern double EXFUN (log, (double)); -extern double EXFUN (sin, (double)); -extern double EXFUN (sqrt, (double)); -extern double EXFUN (tan, (double)); -extern double EXFUN (double_truncate, (double)); - -#define DOUBLE_ACOS acos -#define DOUBLE_ASIN asin -#define DOUBLE_ATAN atan -#define DOUBLE_CEILING ceil -#define DOUBLE_COS cos -#define DOUBLE_EXP exp -#define DOUBLE_FLOOR floor -#define DOUBLE_LOG log -#define DOUBLE_ROUND(dx) (double_truncate ((dx < 0) ? (dx - 0.5) : (dx + 0.5))) -#define DOUBLE_SIN sin -#define DOUBLE_SQRT sqrt -#define DOUBLE_TAN tan -#define DOUBLE_TRUNCATE double_truncate - -extern double EXFUN (atan2, (double, double)); -#define DOUBLE_ATAN2 atan2 - #define CLOSURE_HEADER(offset) do \ { \ SCHEME_OBJECT * entry = ((SCHEME_OBJECT *) my_pc[1]); \ @@ -405,14 +382,6 @@ extern double EXFUN (atan2, (double, double)); dynamic_link); \ } while (0) -#ifdef USE_STDARG -# define RCONSM_TYPE(frob) SCHEME_OBJECT EXFUN (frob, (int, SCHEME_OBJECT DOTS)) -#else /* not USE_STDARG */ -# define RCONSM_TYPE(frob) SCHEME_OBJECT frob () -#endif /* USE_STDARG */ - -extern RCONSM_TYPE(rconsm); - struct compiled_file { int number_of_procedures; @@ -420,13 +389,6 @@ struct compiled_file void * EXFUN ((**procs), (void)); }; -extern int EXFUN (declare_compiled_code, - (char *, - void EXFUN ((*), (void)), - SCHEME_OBJECT * EXFUN ((*), (SCHEME_OBJECT *)))); -extern SCHEME_OBJECT EXFUN (initialize_subblock, (char *)); -extern void EXFUN (NO_SUBBLOCKS, (void)); - /* This does nothing in the sources. */ #ifndef COMPILE_FOR_DYNAMIC_LOADING @@ -451,6 +413,60 @@ extern void EXFUN (NO_SUBBLOCKS, (void)); #endif /* COMPILE_FOR_DYNAMIC_LOADING */ +#ifdef USE_STDARG +# define RCONSM_TYPE(frob) SCHEME_OBJECT EXFUN (frob, (int, SCHEME_OBJECT DOTS)) +#else /* not USE_STDARG */ +# define RCONSM_TYPE(frob) SCHEME_OBJECT frob () +#endif /* USE_STDARG */ + +extern RCONSM_TYPE(rconsm); + +extern int + EXFUN (declare_compiled_code, + (char *, + void EXFUN ((*), (void)), + SCHEME_OBJECT * EXFUN ((*), (SCHEME_OBJECT *)))), + EXFUN (multiply_with_overflow, (long, long, long *)); + +extern SCHEME_OBJECT + EXFUN (initialize_subblock, (char *)), + * EXFUN (invoke_utility, (int, long, long, long, long)); + +extern void + EXFUN (NO_SUBBLOCKS, (void)), + EXFUN (lose_big, (char *)), + EXFUN (error_band_already_built, (void)); + +extern double + EXFUN (acos, (double)), + EXFUN (asin, (double)), + EXFUN (atan, (double)), + EXFUN (ceil, (double)), + EXFUN (cos, (double)), + EXFUN (exp, (double)), + EXFUN (floor, (double)), + EXFUN (log, (double)), + EXFUN (sin, (double)), + EXFUN (sqrt, (double)), + EXFUN (tan, (double)), + EXFUN (double_truncate, (double)), + EXFUN (atan2, (double, double)); + +#define DOUBLE_ACOS acos +#define DOUBLE_ASIN asin +#define DOUBLE_ATAN atan +#define DOUBLE_CEILING ceil +#define DOUBLE_COS cos +#define DOUBLE_EXP exp +#define DOUBLE_FLOOR floor +#define DOUBLE_LOG log +#define DOUBLE_ROUND(dx) (double_truncate ((dx < 0) ? (dx - 0.5) : (dx + 0.5))) +#define DOUBLE_SIN sin +#define DOUBLE_SQRT sqrt +#define DOUBLE_TAN tan +#define DOUBLE_TRUNCATE double_truncate +#define DOUBLE_ATAN2 atan2 + #ifdef __GNUC__ # ifdef hp9000s800 # define BUG_GCC_LONG_CALLS @@ -485,16 +501,20 @@ extern SCHEME_OBJECT EXFUN (make_primitive, (char *, int)); extern SCHEME_OBJECT EXFUN ((* (constructor_kludge [10])), ()); #define MEMORY_TO_STRING \ - ((SCHEME_OBJECT EXFUN ((*), (long, unsigned char *))) (constructor_kludge[0])) + ((SCHEME_OBJECT EXFUN ((*), (long, unsigned char *))) \ + (constructor_kludge[0])) #define MEMORY_TO_SYMBOL \ - ((SCHEME_OBJECT EXFUN ((*), (long, unsigned char *))) (constructor_kludge[1])) + ((SCHEME_OBJECT EXFUN ((*), (long, unsigned char *))) \ + (constructor_kludge[1])) #define MAKE_VECTOR \ - ((SCHEME_OBJECT EXFUN ((*), (long, SCHEME_OBJECT, Boolean))) (constructor_kludge[2])) + ((SCHEME_OBJECT EXFUN ((*), (long, SCHEME_OBJECT, Boolean))) \ + (constructor_kludge[2])) #define CONS \ - ((SCHEME_OBJECT EXFUN ((*), (SCHEME_OBJECT, SCHEME_OBJECT))) (constructor_kludge[3])) + ((SCHEME_OBJECT EXFUN ((*), (SCHEME_OBJECT, SCHEME_OBJECT))) \ + (constructor_kludge[3])) #define RCONSM \ ((RCONSM_TYPE ((*))) (constructor_kludge[4])) @@ -506,10 +526,12 @@ extern SCHEME_OBJECT EXFUN ((* (constructor_kludge [10])), ()); ((SCHEME_OBJECT EXFUN ((*), (long))) (constructor_kludge[6])) #define DIGIT_STRING_TO_INTEGER \ - ((SCHEME_OBJECT EXFUN ((*), (Boolean, long, char *))) (constructor_kludge[7])) + ((SCHEME_OBJECT EXFUN ((*), (Boolean, long, char *))) \ + (constructor_kludge[7])) #define DIGIT_STRING_TO_BIT_STRING \ - ((SCHEME_OBJECT EXFUN ((*), (long, long, char *))) (constructor_kludge[8])) + ((SCHEME_OBJECT EXFUN ((*), (long, long, char *))) \ + (constructor_kludge[8])) #define MAKE_PRIMITIVE \ ((SCHEME_OBJECT EXFUN ((*), (char *, int))) (constructor_kludge[9]))