;;;-*- Mode: Lisp; Package: CCL -*-
;;;
;;; Copyright 2010 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")

;;; Some primitives for accessing Intel I/O ports from CCL.
;;; Note that port access requires special privileges which
;;; the OS may or may not provide (and generally only provides
;;; to root/privileged users if it does provide them.)
;;; Port addresses must be unsigned 16-bit integers.
;;; Values written via '%outb', '%outw', and '%outl' must be
;;; unsigned            8-bit    16-bit  or   32-bit integers
;;;
;;; (%inb port) - read an unsigned 8-bit byte from the specified I/O port
;;; (%inw port) -                  16-bit
;;; (%inl port) -                  32-bit
;;; (%outb val port) - write an unsigned 8-bit value to the specified I/O port
;;; (%outw val port) - write an unsigned 16-bit value to the specified I/O port
;;; (%outl val port) - write an unsigned 32-bit value to the specified I/O port


#+x8632-target
(progn
(defx8632lapfunction %inb ((port arg_z))
  (mark-as-imm temp1)
  (unbox-fixnum port edx)
  (:byte #xec)                          ;inb (%dx),%al
  (mark-as-node temp1)
  (movzbl (% al) (% eax))
  (box-fixnum eax arg_z)
  (single-value-return))

  
(defx8632lapfunction %inw ((port arg_z))
  (mark-as-imm temp1)
  (unbox-fixnum port edx)
  (:byte #x66) (:byte #xed)             ;inw (%dx),%ax
  (mark-as-node temp1)
  (movzwl (% ax) (% eax))
  (box-fixnum eax arg_z)
  (single-value-return))

(defx8632lapfunction %inl ((port arg_z))
  (mark-as-imm temp1)
  (unbox-fixnum port edx)
  (:byte #xed)                          ;inl (%dx),%eax
  (mark-as-node temp1)
  (jmp-subprim .SPmakeu32))


(defx8632lapfunction %outb ((val arg_y) (port arg_z))
  (unbox-fixnum val eax)
  (mark-as-imm temp1)
  (unbox-fixnum port edx)
  (:byte #xee)                          ;outb %al,(%dx)
  (mark-as-node temp1)
  (mov (% val) (% arg_z))
  (single-value-return))


(defx8632lapfunction %outw ((val arg_y) (port arg_z))
  (unbox-fixnum val eax)
  (mark-as-imm temp1)
  (unbox-fixnum port edx)
  (:byte #x66) (:byte #xef)                          ;outw %ax,(%dx)
  (mark-as-node temp1)
  (mov (% val) (% arg_z))
  (single-value-return))


(defx8632lapfunction %outl ((val arg_y) (port arg_z))
  (save-simple-frame)
  (pushl (% port))
  (movl (% val) (% arg_z))
  (call-subprim .SPgetu32)
  (popl (% temp0))
  (mark-as-imm temp1)
  (unbox-fixnum temp0 edx)
  (:byte #xef)                          ;outl %eax,(%dx)
  (mark-as-node temp1)
  (restore-simple-frame)
  (single-value-return))
)

#+x8664-target
(progn
(defx86lapfunction %inb ((port arg_z))
  (unbox-fixnum port rdx)
  (:byte #xec)                          ;inb (%dx),%al
  (movzbl (% al) (% eax))
  (box-fixnum rax arg_z)
  (single-value-return))

  
(defx86lapfunction %inw ((port arg_z))
  (unbox-fixnum port rdx)
  (:byte #x66) (:byte #xed)             ;inw (%dx),%ax
  (movzwl (% ax) (% eax))
  (box-fixnum rax arg_z)
  (single-value-return))

(defx86lapfunction %inl ((port arg_z))
  (unbox-fixnum port rdx)
  (:byte #xed)                          ;inl (%dx),%eax
  (box-fixnum rax arg_z)
  (single-value-return))


(defx86lapfunction %outb ((val arg_y) (port arg_z))
  (unbox-fixnum val rax)
  (unbox-fixnum port rdx)
  (:byte #xee)                          ;outb %al,(%dx)
  (movq (% val) (% arg_z))
  (single-value-return))


(defx86lapfunction %outw ((val arg_y) (port arg_z))
  (unbox-fixnum val rax)
  (unbox-fixnum port rdx)
  (:byte #x66) (:byte #xef)                          ;outw %ax,(%dx)
  (mov (% val) (% arg_z))
  (single-value-return))


(defx86lapfunction %outl ((val arg_y) (port arg_z))
  (unbox-fixnum val imm0)
  (unbox-fixnum port rdx)
  (:byte #xef)                          ;outl %eax,(%dx)
  (mov (% val) (% arg_z))
  (single-value-return))
)


;;; Linux provides two primitives which allow a process running as
;;; a privileged user to execute I/O instructions.

;;; #_ioperm can be used to gain/renounce access to a range if I/O
;;; ports; all ports in that range must be below #x4000.
;;; #_iopl can be used to set the calling process's privilege level
;;; to a value between 0 and 3; 0 being the level at which user code
;;; usually runs and 3 being the most privileged level.

#+(and linux-target x86-target)
(progn
(defun ioperm (enable-p first-port last-port)
  (check-type first-port (integer 0 (#x400)))
  (check-type last-port (integer 0 (#x400)))
  (unless (<= first-port last-port)
    (error "First port ~d must be <= last port ~d." first-port last-port))
  (or (eql 0
           (external-call "ioperm"
                          :unsigned-long first-port
                          :unsigned-long (1+ (- last-port first-port))
                          :int (if enable-p 1 0)
                          :int))
      (error "Error ~aing port access: ~a."
             (if enable-p "enabl" "disabl")
             (%strerror (%get-errno)))))

(defun iopl (level)
  (check-type level (integer 0 3))
  (or (eql 0 (external-call "iopl" :int level :int))
      (error "Can't set I/O privilege level to ~d: ~a."
             level
             (%strerror (%get-errno)))))
)

;;; Other OSes may provide similar functionality.

