source: release/1.6/source/library/intel-io.lisp @ 14493

Last change on this file since 14493 was 13378, checked in by gb, 10 years ago

Low-level Intel I/O primitives and some Linux-specific support.
(Kids, don't try this at home.)

File size: 5.6 KB
Line 
1;;;-*- Mode: Lisp; Package: CCL -*-
2;;;
3;;;   Copyright (C) 2010 Clozure Associates and contributors.
4;;;   This file is part of Clozure CL. 
5;;;
6;;;   Clozure CL is licensed under the terms of the Lisp Lesser GNU Public
7;;;   License , known as the LLGPL and distributed with Clozure CL as the
8;;;   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
9;;;   which is distributed with Clozure CL as the file "LGPL".  Where these
10;;;   conflict, the preamble takes precedence. 
11;;;
12;;;   Clozure CL is referenced in the preamble as the "LIBRARY."
13;;;
14;;;   The LLGPL is also available online at
15;;;   http://opensource.franz.com/preamble.html
16
17(in-package "CCL")
18
19;;; Some primitives for accessing Intel I/O ports from CCL.
20;;; Note that port access requires special privileges which
21;;; the OS may or may not provide (and generally only provides
22;;; to root/privileged users if it does provide them.)
23;;; Port addresses must be unsigned 16-bit integers.
24;;; Values written via '%outb', '%outw', and '%outl' must be
25;;; unsigned            8-bit    16-bit  or   32-bit integers
26;;;
27;;; (%inb port) - read an unsigned 8-bit byte from the specified I/O port
28;;; (%inw port) -                  16-bit
29;;; (%inl port) -                  32-bit
30;;; (%outb val port) - write an unsigned 8-bit value to the specified I/O port
31;;; (%outw val port) - write an unsigned 16-bit value to the specified I/O port
32;;; (%outl val port) - write an unsigned 32-bit value to the specified I/O port
33
34
35#+x8632-target
36(progn
37(defx8632lapfunction %inb ((port arg_z))
38  (mark-as-imm temp1)
39  (unbox-fixnum port edx)
40  (:byte #xec)                          ;inb (%dx),%al
41  (mark-as-node temp1)
42  (movzbl (% al) (% eax))
43  (box-fixnum eax arg_z)
44  (single-value-return))
45
46 
47(defx8632lapfunction %inw ((port arg_z))
48  (mark-as-imm temp1)
49  (unbox-fixnum port edx)
50  (:byte #x66) (:byte #xed)             ;inw (%dx),%ax
51  (mark-as-node temp1)
52  (movzwl (% ax) (% eax))
53  (box-fixnum eax arg_z)
54  (single-value-return))
55
56(defx8632lapfunction %inl ((port arg_z))
57  (mark-as-imm temp1)
58  (unbox-fixnum port edx)
59  (:byte #xed)                          ;inl (%dx),%eax
60  (mark-as-node temp1)
61  (jmp-subprim .SPmakeu32))
62
63
64(defx8632lapfunction %outb ((val arg_y) (port arg_z))
65  (unbox-fixnum val eax)
66  (mark-as-imm temp1)
67  (unbox-fixnum port edx)
68  (:byte #xee)                          ;outb %al,(%dx)
69  (mark-as-node temp1)
70  (mov (% val) (% arg_z))
71  (single-value-return))
72
73
74(defx8632lapfunction %outw ((val arg_y) (port arg_z))
75  (unbox-fixnum val eax)
76  (mark-as-imm temp1)
77  (unbox-fixnum port edx)
78  (:byte #x66) (:byte #xef)                          ;outw %ax,(%dx)
79  (mark-as-node temp1)
80  (mov (% val) (% arg_z))
81  (single-value-return))
82
83
84(defx8632lapfunction %outl ((val arg_y) (port arg_z))
85  (save-simple-frame)
86  (pushl (% port))
87  (movl (% val) (% arg_z))
88  (call-subprim .SPgetu32)
89  (popl (% temp0))
90  (mark-as-imm temp1)
91  (unbox-fixnum temp0 edx)
92  (:byte #xef)                          ;outl %eax,(%dx)
93  (mark-as-node temp1)
94  (restore-simple-frame)
95  (single-value-return))
96)
97
98#+x8664-target
99(progn
100(defx86lapfunction %inb ((port arg_z))
101  (unbox-fixnum port rdx)
102  (:byte #xec)                          ;inb (%dx),%al
103  (movzbl (% al) (% eax))
104  (box-fixnum rax arg_z)
105  (single-value-return))
106
107 
108(defx86lapfunction %inw ((port arg_z))
109  (unbox-fixnum port rdx)
110  (:byte #x66) (:byte #xed)             ;inw (%dx),%ax
111  (movzwl (% ax) (% eax))
112  (box-fixnum rax arg_z)
113  (single-value-return))
114
115(defx86lapfunction %inl ((port arg_z))
116  (unbox-fixnum port rdx)
117  (:byte #xed)                          ;inl (%dx),%eax
118  (box-fixnum rax arg_z)
119  (single-value-return))
120
121
122(defx86lapfunction %outb ((val arg_y) (port arg_z))
123  (unbox-fixnum val rax)
124  (unbox-fixnum port rdx)
125  (:byte #xee)                          ;outb %al,(%dx)
126  (movq (% val) (% arg_z))
127  (single-value-return))
128
129
130(defx86lapfunction %outw ((val arg_y) (port arg_z))
131  (unbox-fixnum val rax)
132  (unbox-fixnum port rdx)
133  (:byte #x66) (:byte #xef)                          ;outw %ax,(%dx)
134  (mov (% val) (% arg_z))
135  (single-value-return))
136
137
138(defx86lapfunction %outl ((val arg_y) (port arg_z))
139  (unbox-fixnum val imm0)
140  (unbox-fixnum port rdx)
141  (:byte #xef)                          ;outl %eax,(%dx)
142  (mov (% val) (% arg_z))
143  (single-value-return))
144)
145
146
147;;; Linux provides two primitives which allow a process running as
148;;; a privileged user to execute I/O instructions.
149
150;;; #_ioperm can be used to gain/renounce access to a range if I/O
151;;; ports; all ports in that range must be below #x4000.
152;;; #_iopl can be used to set the calling process's privilege level
153;;; to a value between 0 and 3; 0 being the level at which user code
154;;; usually runs and 3 being the most privileged level.
155
156#+(and linux-target x86-target)
157(progn
158(defun ioperm (enable-p first-port last-port)
159  (check-type first-port (integer 0 (#x400)))
160  (check-type last-port (integer 0 (#x400)))
161  (unless (<= first-port last-port)
162    (error "First port ~d must be <= last port ~d." first-port last-port))
163  (or (eql 0
164           (external-call "ioperm"
165                          :unsigned-long first-port
166                          :unsigned-long (1+ (- last-port first-port))
167                          :int (if enable-p 1 0)
168                          :int))
169      (error "Error ~aing port access: ~a."
170             (if enable-p "enabl" "disabl")
171             (%strerror (%get-errno)))))
172
173(defun iopl (level)
174  (check-type level (integer 0 3))
175  (or (eql 0 (external-call "iopl" :int level :int))
176      (error "Can't set I/O privilege level to ~d: ~a."
177             level
178             (%strerror (%get-errno)))))
179)
180
181;;; Other OSes may provide similar functionality.
182
Note: See TracBrowser for help on using the repository browser.