[f3064f]: platform-support.lisp Maximize Restore History

Download this file

platform-support.lisp    165 lines (150 with data), 6.3 kB

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
(in-package :sbcl-page)
(defparameter *processors* nil)
(defparameter *systems* nil)
(defparameter *statuses* nil)
(defparameter *ports* nil)
(defmacro define-processor (keyword abbreviation name)
`(progn
(setf *processors* (remove ,keyword *processors* :key #'car))
(push-end (list ,keyword ,abbreviation ,name) *processors*)))
(defmacro define-system (keyword name &rest processors)
`(progn
(setf *systems* (remove ,keyword *systems* :key #'car))
(push-end (list ,keyword ,name ,@processors) *systems*)))
(defmacro define-status (keyword class name abbrev)
`(progn
(setf *statuses* (remove ,keyword *statuses* :key #'car))
(push-end (list ,keyword ,class ,name ,abbrev) *statuses*)))
(eval-when (:compile-toplevel :load-toplevel :execute)
(defun format-port-link (version arch os file-type)
(format nil "http://prdownloads.sourceforge.net/sbcl/sbcl-~A-~A-~A-binary.~A"
(string-downcase version)
(string-downcase arch)
(string-downcase os)
(string-downcase file-type))))
(defmacro define-port (processor system status version &key
(file-type "tar.bz2")
(processor-in-link processor)
(system-in-link system)
(link (when version
(format-port-link version processor-in-link
system-in-link file-type))))
`(progn
(setf *ports* (remove-if #'(lambda (e)
(and (eql (first e) ,processor)
(eql (second e) ,system))) *ports*))
(push-end (list ,processor ,system ,status ,link ,version) *ports*)))
(defun port-status (proc system)
(let ((status (find-if (lambda (e)
(and (eq (first e) proc)
(eq (second e) system))) *ports*)))
(if status
(third status)
(if (find proc (cddr (find system *systems* :key #'car)))
:not-available
:not-applicable))))
(defun table-cell-for-status (status &key header link version)
(let ((status (second (assoc status *statuses*))))
(funcall
(if header
<th class=,status>
<td class=,status>)
(funcall
(if link
<a href=,link>
<span>)
(<div class= "big-height">
(<span class= "hide-me">
(fourth (assoc status *statuses*)))
" "
(or version "")
(if (equal version (car *most-recent-release*))
(<i> " newest")
""))))))
(defun port-link (proc system)
(fourth (find-if #'(lambda (e)
(and (eq (first e) proc)
(eq (second e) system))) *ports*)))
(defun port-version (proc system)
(fifth (find-if (lambda (e)
(and (eq (first e) proc)
(eq (second e) system))) *ports*)))
(defun port-xml ()
(<table class= "port-table">
(<tr class= "processor-header">
<th/>
(loop for processor in *processors*
collect (<th> (second processor))))
(loop for system in *systems*
collect
(<tr class= "system-header">
(<th> (second system))
(loop for proc in *processors*
collect (table-cell-for-status
(port-status (first proc)
(first system))
:link
(port-link (first proc)
(first system))
:version
(port-version (first proc)
(first system))))))))
(defun port-page ()
(list
(<p>
"SBCL runs on many Unix and Unix-like systems. The following table summarizes what systems SBCL runs on, and what it could run on but currently does not. The table also contains links to the latest binaries for SBCL on each platform, when they are available.")
(<p>
"The most recent version of SBCL is "
(first *most-recent-release*)
", released "
(second *most-recent-release*)
". The release notes are available on the "
(<a href= ,(concatenate 'string (page-link :news) "#" (car *most-recent-release*))>
"news page")
".")
(<p>
"If a binary of this version of SBCL is not available for your platform, or if you'd like to customize the binary, download "
(<a href= ,(format nil "http://prdownloads.sourceforge.net/sbcl/sbcl-~A-source.tar.bz2?download" (car *most-recent-release*))>
"the source")
" and follow the directions for "
(<a href= ,(page-link :getting-sbcl)>
"compiling it") ".")
(<p>
(<b> "Source code: ")
(<a href= ,(format nil "http://prdownloads.sourceforge.net/sbcl/sbcl-~A-source.tar.bz2?download" (car *most-recent-release*))>
"sbcl-" (car *most-recent-release*) "-source.tar.bz2"))
(<div class= "left-floater">
(port-xml))
(<table class= "key">
(<tr>
(<td> "")
(<td>
(<h1> "Key")))
(loop for s in *statuses*
collecting
(<tr class= "key-blob">
(table-cell-for-status (car s) :header t)
(<td> (third s)))))
<p/>
(<table class= "key">
(<tr>
(<td> "")
(<td>
(<h1> "Processors")))
(loop for processor in *processors*
collecting
(<tr>
(<th> (<b> (second processor)))
(<td> (third processor)))))
(<p>
"Historically SBCL also ran on "
(<a href= "http://en.wikipedia.org/wiki/PA-RISC"> "HP PA-RISC")
" processors under Linux and on Alpha processors under "
(<a href= "http://en.wikipedia.org/wiki/Tru64_UNIX"> "Tru64")
", but this support has not been maintained.")
(<p>
"Older binaries and source releases are available on the SourceForge "
(<a href= "http://sourceforge.net/project/showfiles.php?group_id=1373">
"File Releases")
" page.")))
(define-page :ports "Download" "platform-table" port-page)