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

Download this file

platform-support.lisp    179 lines (164 with data), 6.7 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
165
166
167
168
169
170
171
172
173
174
175
176
177
178
(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 release file-type os-version)
(format nil "http://prdownloads.sourceforge.net/sbcl/sbcl-~A-~A-~A~@[~A~]-binary~@[-r~A~].~A"
(string-downcase version)
(string-downcase arch)
(string-downcase os)
os-version
release
(string-downcase file-type))))
(defmacro define-port (processor system status &optional version &key
(file-type "tar.bz2")
(processor-in-link processor)
(system-in-link system)
(release nil)
(os-version)
(link (when version
(format-port-link version processor-in-link
system-in-link release file-type
os-version))))
`(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>)
(<span 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>
"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>
(<b> "Source: ")
(<a href= ,(format nil "http://prdownloads.sourceforge.net/sbcl/sbcl-~A-source.tar.bz2?download" (car *most-recent-release*))>
;; FIXME: remove the -r2 for 1.0.30, or use somethign more automagic...
"sbcl-" (car *most-recent-release*) "-source.tar.bz2"))
(<p> "The development version is available from git: ")
(<pre> "git clone git://git.code.sf.net/p/sbcl/sbcl")
(<p> (<b> "Binaries: "))
(<p> "The table below links to the latest binaries for SBCL on
each platform, where are available.")
(<p>
"After downloading SBCL, refer to the "
(<a href=,(page-link :getting-sbcl)>
"getting started")
" page for instructions on how to install the release.")
(<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") ".")
(<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)