;;;-*- Mode: Lisp; Package: CCL -*-
;;;
;;; Copyright 1994-2009 Clozure Associates
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;;     http://www.apache.org/licenses/LICENSE-2.0
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.
(in-package "CCL")
(eval-when (:compile-toplevel :load-toplevel :execute)
  (require "BACKEND"))

(eval-when (:compile-toplevel :execute)
  (require "NXENV")
  (require "PPCENV")
  (require "PPC32-ARCH"))





(defvar *ppc32-vinsn-templates* (make-hash-table :test #'eq))




(defvar *known-ppc32-backends* ())


#+linuxppc-target
(defvar *linuxppc32-backend*
  (make-backend :lookup-opcode #'lookup-ppc-opcode
		:lookup-macro #'ppc::ppc-macro-function
		:lap-opcodes ppc::*ppc-opcodes*
                :define-vinsn 'define-ppc-vinsn
                :platform-syscall-mask (logior platform-os-linux platform-cpu-ppc)
		:p2-dispatch *ppc2-specials*
		:p2-vinsn-templates *ppc32-vinsn-templates*
		:p2-template-hash-name '*ppc32-vinsn-templates*
		:p2-compile 'ppc2-compile
		:target-specific-features
		'(:powerpc :ppc-target :eabi-target :linux-target :linuxppc-target :ppc32-target :32-bit-target :big-endian-target)
		:target-fasl-pathname (make-pathname :type "pfsl")
		:target-platform (logior platform-word-size-32
                                         platform-cpu-ppc
                                         platform-os-linux)
		:target-os :linuxppc
		:name :linuxppc32
		:target-arch-name :ppc32
		:target-foreign-type-data nil
                :target-arch ppc32::*ppc32-target-arch*))


#+darwinppc-target
(defvar *darwinppc32-backend*
  (make-backend :lookup-opcode #'lookup-ppc-opcode
		:lookup-macro #'ppc::ppc-macro-function
		:lap-opcodes ppc::*ppc-opcodes*
                :define-vinsn 'define-ppc-vinsn
                :platform-syscall-mask (logior platform-os-darwin platform-cpu-ppc)                
		:p2-dispatch *ppc2-specials*
		:p2-vinsn-templates *ppc32-vinsn-templates*
		:p2-template-hash-name '*ppc32-vinsn-templates*
		:p2-compile 'ppc2-compile
		:target-specific-features
		'(:powerpc :ppc-target :darwin-target :darwinppc-target :ppc32-target :32-bit-target :big-endian-target)
		:target-fasl-pathname (make-pathname :type "dfsl")
		:target-platform (logior platform-word-size-32
                                         platform-cpu-ppc
                                         platform-os-darwin)
		:target-os :darwinppc
		:name :darwinppc32
		:target-arch-name :ppc32
		:target-foreign-type-data nil
                :target-arch ppc32::*ppc32-target-arch*))

#+linuxppc-target
(pushnew *linuxppc32-backend* *known-ppc32-backends* :key #'backend-name)


#+darwinppc-target
(pushnew *darwinppc32-backend* *known-ppc32-backends* :key #'backend-name)

(defvar *ppc32-backend* (car *known-ppc32-backends*))

(defun fixup-ppc32-backend ()
  (dolist (b *known-ppc32-backends*)
    (setf (backend-lap-opcodes b) ppc::*ppc-opcodes*
	  (backend-p2-dispatch b) *ppc2-specials*
	  (backend-p2-vinsn-templates b)  *ppc32-vinsn-templates*)
    (or (backend-lap-macros b) (setf (backend-lap-macros b)
                                     (make-hash-table :test #'equalp)))))



(fixup-ppc32-backend)

#+ppc32-target
(setq *host-backend* *ppc32-backend* *target-backend* *ppc32-backend*)
#-ppc32-target
(unless (backend-target-foreign-type-data *ppc32-backend*)
  (let* ((ftd (make-ftd
               :interface-db-directory
               #+darwinppc-target "ccl:darwin-headers;"
               #+linuxppc-target "ccl:headers;"
               :interface-package-name
               #+darwinppc-target "DARWIN32"
               #+linuxppc-target "LINUX32"
               :attributes
               #+darwinppc-target
               '(:signed-char t
                 :struct-by-value t
                 :prepend-underscores t
                 :bits-per-word  32
                 :poweropen-alignment t)
               #+linuxppc-target
               '(:bits-per-word 32)
               :ff-call-expand-function
               #+linuxppc-target
               'linux32::expand-ff-call
               #+darwinppc-target
               'darwin32::expand-ff-call
               :ff-call-struct-return-by-implicit-arg-function
               #+linuxppc-target
               'linux32::record-type-returns-structure-as-first-arg
               #+darwinppc-target
               'darwin32::record-type-returns-structure-as-first-arg
               :callback-bindings-function
               #+linuxppc-target
               'linux32::generate-callback-bindings
               #+darwinppc-target
               'darwin32::generate-callback-bindings
               :callback-return-value-function
               #+linuxppc-target
               'linux32::generate-callback-return-value
               #+darwinppc-target
               'darwin32::generate-callback-return-value
               )))
    (install-standard-foreign-types ftd)
    (use-interface-dir :libc ftd)
    (setf (backend-target-foreign-type-data *ppc32-backend*) ftd)))


(pushnew *ppc32-backend* *known-backends* :key #'backend-name)

#+ppc32-target
(require "PPC32-VINSNS")
(provide "PPC32-BACKEND")
