Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
Zach Beane
zacl
Commits
9e668d38
Commit
9e668d38
authored
Oct 17, 2018
by
Dave Cooper
Browse files
Updated to track latest AllegroServe. Bumped purported ACL version to 10.1
parent
1ed48f83
Changes
5
Hide whitespace changes
Inline
Side-by-side
.gitignore
0 → 100644
View file @
9e668d38
# Output
*.fasl
*.dx64fsl
*.wx64fsl
*.lx64fsl
package-excl.lisp
View file @
9e668d38
...
...
@@ -543,3 +543,130 @@ values otherwise."
(
defun
excl:fasl-read
(
file
)
(
with-open-file
(
stream
file
:element-type
'
(
unsigned-byte
8
))
(
restore
stream
)))
;;; BASE64
(
defun
excl:base64-string-to-string
(
string
)
;;
;; given a base64 string, return it decoded.
;; beware: the result will not be a simple string
;;
(
let
((
res
(
make-array
(
length
string
)
:element-type
'character
:fill-pointer
0
:adjustable
t
))
(
arr
*base64-decode*
))
(
declare
(
type
(
simple-array
(
unsigned-byte
8
)
(
128
))
arr
))
(
do
((
i
0
(
+
i
4
))
(
cha
)
(
chb
))
((
>=
i
(
length
string
)))
; for multiline decoding, ignore cr and lfs
(
loop
(
let
((
ch
(
char
string
i
)))
(
if*
(
or
(
eq
ch
#\linefeed
)
(
eq
ch
#\return
))
then
(
incf
i
)
(
if*
(
>=
i
(
length
string
))
then
(
return-from
excl:base64-string-to-string
))
else
(
return
))))
(
let
((
val
(
+
(
ash
(
aref
arr
(
char-code
(
char
string
i
)))
18
)
(
ash
(
aref
arr
(
char-code
(
char
string
(
+
i
1
))))
12
)
(
ash
(
aref
arr
(
char-code
(
setq
cha
(
char
string
(
+
i
2
)))))
6
)
(
aref
arr
(
char-code
(
setq
chb
(
char
string
(
+
i
3
))))))))
(
vector-push-extend
(
code-char
(
ash
val
-16
))
res
)
;; when the original size wasn't a mult of 3 there may be
;; non-characters left over
(
if*
(
not
(
eq
cha
#\=
))
then
(
vector-push-extend
(
code-char
(
logand
#xff
(
ash
val
-8
)))
res
))
(
if*
(
not
(
eq
chb
#\=
))
then
(
vector-push-extend
(
code-char
(
logand
#xff
val
))
res
))))
res
))
(
defun
excl:string-to-base64-string
(
str
)
;;
;; take the given string and encode as a base64 string
;; beware: the result will not be a simple string
;;
(
let
((
output
(
make-array
(
ceiling
(
*
1.3
(
length
str
)))
:element-type
'character
:fill-pointer
0
:adjustable
t
))
v1
v2
v3
eol
(
from
0
)
(
max
(
length
str
))
)
(
loop
(
if*
(
>=
from
max
)
then
(
return
))
(
setq
v1
(
char-code
(
schar
str
from
)))
(
incf
from
)
(
if*
(
>=
from
max
)
then
(
setq
v2
0
eol
t
)
else
(
setq
v2
(
char-code
(
schar
str
from
))))
(
incf
from
)
; put out first char of encoding
(
vector-push-extend
(
schar
*base64-encode*
(
logand
#x3f
(
ash
v1
-2
)))
output
)
; put out second char of encoding
(
vector-push-extend
(
schar
*base64-encode*
(
+
(
ash
(
logand
3
v1
)
4
)
(
logand
#xf
(
ash
v2
-4
))))
output
)
(
if*
eol
then
; two pads
(
vector-push-extend
#\=
output
)
(
vector-push-extend
#\=
output
)
(
return
))
(
if*
(
>=
from
max
)
then
(
setq
v3
0
eol
t
)
else
(
setq
v3
(
char-code
(
schar
str
from
))))
(
incf
from
)
; put out third char of encoding
(
vector-push-extend
(
schar
*base64-encode*
(
+
(
ash
(
logand
#xf
v2
)
2
)
(
logand
3
(
ash
v3
-6
))))
output
)
(
if*
eol
then
(
vector-push-extend
#\=
output
)
(
return
))
; put out fourth char of encoding
(
vector-push-extend
(
schar
*base64-encode*
(
logand
#x3f
v3
))
output
))
output
))
;;; Microtime
(
defconstant
excl::base-for-internal-real-time
-455615030
)
(
defun
excl::acl-internal-real-time
()
(
values
(
-
(
get-universal-time
)
4165516800
)
(
/
(
local-time:nsec-of
(
local-time:now
))
1000
)))
package.lisp
View file @
9e668d38
...
...
@@ -231,7 +231,10 @@
#:stream-error-identifier
#:stream-error-code
)
(
:export
#:sm
#:errorset
))
#:errorset
)
(
:export
#:string-to-base64-string
#:base64-string-to-string
))
(
defpackage
#:ff
(
:use
)
...
...
reader.lisp
View file @
9e668d38
...
...
@@ -5,7 +5,7 @@
(
defparameter
*allegro-feature-symbols*
'
(
"VERSION>="
"VERSION="
))
(
defparameter
*allegro-version-feature*
:zacl-allegro-10-
0
)
(
defparameter
*allegro-version-feature*
:zacl-allegro-10-
1
)
(
defparameter
*allegro-latest-feature*
:zacl-latest-allegro
)
(
defun
allegro-conditional-p
(
expression
)
...
...
zacl.asd
View file @
9e668d38
...
...
@@ -19,7 +19,8 @@
#:cl-store
#:alexandria
#:md5
#:cl+ssl
)
#:cl+ssl
#:local-time
)
:serial
t
:components
((
:file
"package"
)
#+
clozure
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment