From 1f4ad1f865215dde22e6e6c270cab8269c423d27 Mon Sep 17 00:00:00 2001 From: Jason Wilson Date: Tue, 26 Oct 1993 03:02:40 +0000 Subject: [PATCH] These changes were to bring the C backend back to life. The major changes that were made was adding direct calls for floating point operations as well as using the new rules for floating point vectors (change in RTL syntax). --- v7/src/compiler/machines/C/cout.scm | 6 +- v7/src/compiler/machines/C/lapgen.scm | 9 +- v7/src/compiler/machines/C/rules1.scm | 99 +++++++++++++++++----- v7/src/compiler/machines/C/rulflo.scm | 116 +++++++++++++++++++++++++- 4 files changed, 203 insertions(+), 27 deletions(-) diff --git a/v7/src/compiler/machines/C/cout.scm b/v7/src/compiler/machines/C/cout.scm index d06458e30..6047d67f2 100644 --- a/v7/src/compiler/machines/C/cout.scm +++ b/v7/src/compiler/machines/C/cout.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: cout.scm,v 1.4 1993/06/10 01:06:19 jawilson Exp $ +$Id: cout.scm,v 1.5 1993/10/26 03:02:37 jawilson Exp $ Copyright (c) 1992-1993 Massachusetts Institute of Technology @@ -112,7 +112,9 @@ MIT in each case. |# default (car (last-pair dir))) "_" - (pathname-name path) + (string-replace (pathname-name path) ; kludge + #\- + #\_) midfix suffix)))))) diff --git a/v7/src/compiler/machines/C/lapgen.scm b/v7/src/compiler/machines/C/lapgen.scm index 100733987..263de01ce 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.4 1993/06/10 18:07:39 gjr Exp $ +$Id: lapgen.scm,v 1.5 1993/10/26 03:02:38 jawilson Exp $ Copyright (c) 1992-1993 Massachusetts Institute of Technology @@ -64,6 +64,8 @@ MIT in each case. |# "unsigned long") ((DOUBLE) "double") + ((DOUBLE*) + "double *") (else (comp-internal-error "Unknown type" 'TYPE->NAME type)))) @@ -81,6 +83,8 @@ MIT in each case. |# (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)))) @@ -545,6 +549,9 @@ MIT in each case. |# (else (error "unable to determine register type" reg)))) +(define-integrable (word-register? reg) + (eq? (register-type reg) 'WORD)) + (define (register-types-compatible? type1 type2) (boolean=? (eq? type1 'FLOAT) (eq? type2 'FLOAT))) diff --git a/v7/src/compiler/machines/C/rules1.scm b/v7/src/compiler/machines/C/rules1.scm index 3b8d1d451..14ccb53e1 100644 --- a/v7/src/compiler/machines/C/rules1.scm +++ b/v7/src/compiler/machines/C/rules1.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: rules1.scm,v 1.1 1993/06/08 06:13:32 gjr Exp $ +$Id: rules1.scm,v 1.2 1993/10/26 03:02:39 jawilson Exp $ Copyright (c) 1992-1993 Massachusetts Institute of Technology @@ -117,9 +117,23 @@ MIT in each case. |# (standard-unary-conversion source 'SCHEME_OBJECT target 'SCHEME_OBJECT* object->address)) + +;; long the right type here??? +(define-rule statement + (ASSIGN (REGISTER (? target)) + (OFFSET-ADDRESS (REGISTER (? base)) + (REGISTER (? index)))) + (standard-binary-conversion + base 'SCHEME_OBJECT* + index 'LONG + target 'SCHEME_OBJECT* + (lambda (base index target) + (LAP ,target " = &" ,base "[" ,index "];\n\t")))) + (define-rule statement (ASSIGN (REGISTER (? target)) - (OFFSET-ADDRESS (REGISTER (? source)) (? offset))) + (OFFSET-ADDRESS (REGISTER (? source)) + (MACHINE-CONSTANT (? offset)))) (standard-unary-conversion source 'SCHEME_OBJECT* target 'SCHEME_OBJECT* (lambda (source target) @@ -127,11 +141,43 @@ MIT in each case. |# (define-rule statement (ASSIGN (REGISTER (? target)) - (BYTE-OFFSET-ADDRESS (REGISTER (? source)) (? offset))) + (BYTE-OFFSET-ADDRESS (REGISTER (? base)) + (REGISTER (? index)))) + (standard-binary-conversion + base 'CHAR* + index 'LONG + target 'CHAR* + (lambda (base index target) + (LAP ,target " = &" ,base "[" ,index "];\n\t")))) + +(define-rule statement + (ASSIGN (REGISTER (? target)) + (BYTE-OFFSET-ADDRESS (REGISTER (? source)) + (MACHINE-CONSTANT (? offset)))) (standard-unary-conversion source 'CHAR* target 'CHAR* (lambda (source target) (LAP ,target " = &" ,source "[" ,offset "];\n\t")))) + +(define-rule statement + (ASSIGN (REGISTER (? target)) + (FLOAT-OFFSET-ADDRESS (REGISTER (? base)) + (REGISTER (? index)))) + (standard-binary-conversion + base 'DOUBLE* + index 'LONG + target 'DOUBLE* + (lambda (base index target) + (LAP ,target " = &" ,base "[" ,index "];\n\t")))) + +(define-rule statement + (ASSIGN (REGISTER (? target)) + (FLOAT-OFFSET-ADDRESS (REGISTER (? source)) + (MACHINE-CONSTANT (? offset)))) + (standard-unary-conversion + source 'DOUBLE* target 'DOUBLE* + (lambda (source target) + (LAP ,target " = &" ,source "[" ,offset "];\n\t")))) ;;;; Loading of Constants @@ -217,10 +263,12 @@ MIT in each case. |# ;;;; Transfers from memory (define-rule statement - (ASSIGN (REGISTER (? target)) (OFFSET (REGISTER (? address)) (? offset))) - (standard-unary-conversion address 'SCHEME_OBJECT* target 'SCHEME_OBJECT - (lambda (address target) - (LAP ,target " = " ,address "[" ,offset "];\n\t")))) + (ASSIGN (REGISTER (? target)) + (OFFSET (REGISTER (? address)) (MACHINE-CONSTANT (? offset)))) + (standard-unary-conversion + address 'SCHEME_OBJECT* target 'SCHEME_OBJECT + (lambda (address target) + (LAP ,target " = " ,address "[" ,offset "];\n\t")))) (define-rule statement (ASSIGN (REGISTER (? target)) (POST-INCREMENT (REGISTER (? rsp)) 1)) @@ -232,8 +280,9 @@ MIT in each case. |# (define-rule statement ;; store an object in memory - (ASSIGN (OFFSET (REGISTER (? address)) (? offset)) + (ASSIGN (OFFSET (REGISTER (? address)) (MACHINE-CONSTANT (? offset))) (REGISTER (? source))) + (QUALIFIER (word-register? source)) (let* ((source (standard-source! source 'SCHEME_OBJECT)) (address (standard-source! address 'SCHEME_OBJECT*))) (LAP ,address "[" ,offset "] = " ,source ";\n\t"))) @@ -242,7 +291,8 @@ MIT in each case. |# ;; Push an object register on the heap (ASSIGN (POST-INCREMENT (REGISTER (? rfree)) 1) (REGISTER (? source))) - (QUALIFIER (= rfree regnum:free)) + (QUALIFIER (and (word-register? source) + (= rfree regnum:free))) (let ((source (standard-source! source 'SCHEME_OBJECT))) (LAP "*free_pointer++ = " ,source ";\n\t"))) @@ -250,14 +300,15 @@ MIT in each case. |# ;; Push an object register on the stack (ASSIGN (PRE-INCREMENT (REGISTER (? rsp)) -1) (REGISTER (? source))) - (QUALIFIER (= rsp regnum:stack-pointer)) + (QUALIFIER (and (word-register? source) + (= rsp regnum:stack-pointer))) (let ((source (standard-source! source 'SCHEME_OBJECT))) (LAP "*--stack_pointer = " ,source ";\n\t"))) ;; Cheaper, common patterns. (define-rule statement - (ASSIGN (OFFSET (REGISTER (? address)) (? offset)) + (ASSIGN (OFFSET (REGISTER (? address)) (MACHINE-CONSTANT (? offset))) (MACHINE-CONSTANT 0)) (let ((address (standard-source! address 'SCHEME_OBJECT*))) (LAP ,address "[" ,offset "] = ((SCHEME_OBJECT) 0);\n\t"))) @@ -269,7 +320,7 @@ MIT in each case. |# (LAP "*free_pointer++ = ((SCHEME_OBJECT) 0);\n\t")) (define-rule statement - ;; Push an object register on the stack + ;; Push 0 on the stack (ASSIGN (PRE-INCREMENT (REGISTER (? rsp)) -1) (MACHINE-CONSTANT (? const))) (QUALIFIER (= rsp regnum:stack-pointer)) @@ -280,20 +331,24 @@ MIT in each case. |# (define-rule statement ;; load char object from memory and convert to ASCII byte (ASSIGN (REGISTER (? target)) - (CHAR->ASCII (OFFSET (REGISTER (? address)) (? offset)))) - (standard-unary-conversion address 'SCHEME_OBJECT* target 'ULONG - (lambda (address target) - (LAP ,target " = (CHAR_TO_ASCII (" ,address "[" ,offset "]));\n\t")))) + (CHAR->ASCII (OFFSET (REGISTER (? address)) + (MACHINE-CONSTANT (? offset))))) + (standard-unary-conversion + address 'SCHEME_OBJECT* target 'ULONG + (lambda (address target) + (LAP ,target " = (CHAR_TO_ASCII (" ,address "[" ,offset "]));\n\t")))) (define-rule statement ;; load ASCII byte from memory (ASSIGN (REGISTER (? target)) - (BYTE-OFFSET (REGISTER (? address)) (? offset))) + (BYTE-OFFSET (REGISTER (? address)) + (MACHINE-CONSTANT (? offset)))) (standard-unary-conversion address 'CHAR* target 'ULONG (lambda (address target) (LAP ,target " = ((ulong) (((unsigned char *) " ,address ")[" ,offset "]));\n\t")))) +;* (define-rule statement ;; convert char object to ASCII byte (ASSIGN (REGISTER (? target)) @@ -302,16 +357,19 @@ MIT in each case. |# (lambda (source target) (LAP ,target " = (CHAR_TO_ASCII (" ,source "));\n\t")))) +;; is this constant correct??? (define-rule statement ;; store null byte in memory - (ASSIGN (BYTE-OFFSET (REGISTER (? address)) (? offset)) + (ASSIGN (BYTE-OFFSET (REGISTER (? address)) + (MACHINE-CONSTANT (? offset))) (CHAR->ASCII (CONSTANT #\N\TUL))) (let ((address (standard-source! address 'CHAR*))) (LAP ,address "[" ,offset "] = '\\0';\n\t"))) (define-rule statement ;; store ASCII byte in memory - (ASSIGN (BYTE-OFFSET (REGISTER (? address)) (? offset)) + (ASSIGN (BYTE-OFFSET (REGISTER (? address)) + (MACHINE-CONSTANT (? offset))) (REGISTER (? source))) (let ((address (standard-source! address 'CHAR*)) (source (standard-source! source 'ULONG))) @@ -320,7 +378,8 @@ MIT in each case. |# (define-rule statement ;; convert char object to ASCII byte and store it in memory ;; register + byte offset <- contents of register (clear top bits) - (ASSIGN (BYTE-OFFSET (REGISTER (? address)) (? offset)) + (ASSIGN (BYTE-OFFSET (REGISTER (? address)) + (MACHINE-CONSTANT (? offset))) (CHAR->ASCII (REGISTER (? source)))) (let ((address (standard-source! address 'CHAR*)) (source (standard-source! source 'SCHEME_OBJECT))) diff --git a/v7/src/compiler/machines/C/rulflo.scm b/v7/src/compiler/machines/C/rulflo.scm index b6186ab8e..0e2315903 100644 --- a/v7/src/compiler/machines/C/rulflo.scm +++ b/v7/src/compiler/machines/C/rulflo.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Id: rulflo.scm,v 1.1 1993/06/08 06:13:32 gjr Exp $ +$Id: rulflo.scm,v 1.2 1993/10/26 03:02:40 jawilson Exp $ -Copyright (c) 1992 Massachusetts Institute of Technology +Copyright (c) 1992-1993 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -37,8 +37,6 @@ MIT in each case. |# (declare (usual-integrations)) -;;;; Flonum Arithmetic - (define-rule statement ;; convert a floating-point number to a flonum object (ASSIGN (REGISTER (? target)) @@ -54,6 +52,92 @@ MIT in each case. |# (let ((target (standard-target! target 'double))) (LAP ,target " = (FLONUM_TO_DOUBLE (" ,source "));\n\t")))) +;;;; Floating-point vector support + +(define-rule statement + (ASSIGN (REGISTER (? target)) + (FLOAT-OFFSET (REGISTER (? base)) + (MACHINE-CONSTANT (? offset)))) + (standard-unary-conversion + base 'DOUBLE* + target 'DOUBLE + (lambda (target base) + (LAP ,target " = " ,base "[" ,offset "];\n\t")))) + +(define-rule statement + (ASSIGN (FLOAT-OFFSET (REGISTER (? base)) + (MACHINE-CONSTANT (? offset))) + (REGISTER (? source))) + (let ((base (standard-source! base 'DOUBLE*)) + (source (standard-source! source 'DOUBLE))) + (LAP ,base "[" ,offset "] = " ,source ";\n\t"))) + +(define-rule statement + (ASSIGN (REGISTER (? target)) + (FLOAT-OFFSET (REGISTER (? base)) (REGISTER (? index)))) + (standard-binary-conversion + base 'DOUBLE* + index 'LONG + target 'DOUBLE* + (lambda (base index target) + (LAP ,target " = " ,base "[" ,index "];\n\t")))) + +(define-rule statement + (ASSIGN (FLOAT-OFFSET (REGISTER (? base)) (REGISTER (? index))) + (REGISTER (? source))) + (let ((base (standard-source! base 'DOUBLE*)) + (source (standard-source! source 'DOUBLE)) + (index (standard-source! index 'LONG))) + (LAP ,base "[" ,index "] = " ,source ";\n\t"))) + +; this can't possibly be right +(define-rule statement + (ASSIGN (REGISTER (? target)) + (FLOAT-OFFSET (OFFSET-ADDRESS (REGISTER (? base)) + (MACHINE-CONSTANT (? w-offset))) + (MACHINE-CONSTANT (? f-offset)))) + (let* ((base (standard-source! base 'SCHEME_OBJECT*)) + (target (standard-target! target 'DOUBLE))) + (LAP ,target + " = &((double *) & (" ,base "[" ,w-offset "]))[" ,f-offset "];\n\t"))) + +; this can't possibly be right +(define-rule statement + (ASSIGN (FLOAT-OFFSET (OFFSET-ADDRESS (REGISTER (? base)) + (MACHINE-CONSTANT (? w-offset))) + (MACHINE-CONSTANT (? f-offset))) + (REGISTER (? source))) + (let ((base (standard-source! base 'SCHEME_OBJECT*)) + (source (standard-source! source 'DOUBLE))) + (LAP "((double *) & (" ,base "[" ,w-offset "]))[" ,f-offset "]" + " = " ,source ";\n\t"))) + +; this can't possibly be right +(define-rule statement + (ASSIGN (REGISTER (? target)) + (FLOAT-OFFSET (OFFSET-ADDRESS (REGISTER (? base)) + (MACHINE-CONSTANT (? w-offset))) + (REGISTER (? index)))) + (let* ((base (standard-source! base 'SCHEME_OBJECT*)) + (index (standard-source! index 'LONG)) + (target (standard-target! target 'DOUBLE))) + (LAP ,target + " = &((double *) & (" ,base "[" ,w-offset "]))[" ,index "];\n\t"))) + +; this can't possibly be right +(define-rule statement + (ASSIGN (FLOAT-OFFSET (OFFSET-ADDRESS (REGISTER (? base)) + (MACHINE-CONSTANT (? w-offset))) + (REGISTER (? index))) + (REGISTER (? source))) + (let* ((base (standard-source! base 'SCHEME_OBJECT*)) + (index (standard-source! index 'LONG)) + (source (standard-source! source 'DOUBLE))) + (LAP "((double *) & (" ,base "[" ,w-offset "]))[" ,index "]" + " = " ,source ";\n\t"))) + +;;;; Flonum Arithmetic + (define-rule statement (ASSIGN (REGISTER (? target)) (FLONUM-1-ARG (? operation) (REGISTER (? source)) (? overflow?))) @@ -78,6 +162,25 @@ MIT in each case. |# (lambda (target source) (LAP ,target " = (- " ,source ");\n\t"))) +(let ((define-use-function + (lambda (name function) + (define-arithmetic-method name flonum-methods/1-arg + (lambda (target source) + (LAP ,target " = (" ,function " (" ,source "));\n\t")))))) + (define-use-function 'FLONUM-ACOS "DOUBLE_ACOS") + (define-use-function 'FLONUM-ASIN "DOUBLE_ASIN") + (define-use-function 'FLONUM-ATAN "DOUBLE_ATAN") + (define-use-function 'FLONUM-CEILING "DOUBLE_CEILING") + (define-use-function 'FLONUM-COS "DOUBLE_COS") + (define-use-function 'FLONUM-EXP "DOUBLE_EXP") + (define-use-function 'FLONUM-FLOOR "DOUBLE_FLOOR") + (define-use-function 'FLONUM-LOG "DOUBLE_LOG") + (define-use-function 'FLONUM-ROUND "DOUBLE_ROUND") + (define-use-function 'FLONUM-SIN "DOUBLE_SIN") + (define-use-function 'FLONUM-SQRT "DOUBLE_SQRT") + (define-use-function 'FLONUM-TAN "DOUBLE_TAN") + (define-use-function 'FLONUM-TRUNCATE "DOUBLE_TRUNCATE")) + (define-rule statement (ASSIGN (REGISTER (? target)) (FLONUM-2-ARGS (? operation) @@ -110,6 +213,11 @@ MIT in each case. |# (define-flonum-operation flonum-multiply " * ") (define-flonum-operation flonum-divide " / ")) +(define-arithmetic-method 'FLONUM-ATAN2 flonum-methods/2-args + (lambda (target source1 source2) + (LAP ,target " = (DOUBLE_ATAN2 (" ,source1 ", " ,source2 + "));\n\t"))) + ;;;; Flonum Predicates (define-rule predicate -- 2.25.1