suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

add AArch64 (aka Arm64) support as tarm64le

Browse Source 
original commit: 9964f27f64cc743fd1dbff7418fce940a4291b01
This commit is contained in:
Matthew Flatt 2020-07-05 16:30:59 -06:00
parent 57a2b8511d
commit b2f74f014e
24 changed files with 3718 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitignore vendored
View File

@ -18,6 +18,7 @@
/ti3osx/
/arm32le/
/tarm32le/
/tarm64le/
/ppc32le/
/tppc32le/
/xc-*/

46
c/Mf-tarm64le Normal file
View File

@ -0,0 +1,46 @@
# Mf-arm64le
# Copyright 1984-2017 Cisco Systems, Inc.
#
# 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.
m = tarm64le
Cpu = AARCH64
mdclib = -lm -ldl ${ncursesLib} -lpthread -lrt -luuid
C = ${CC} ${CPPFLAGS} -Wpointer-arith -Wextra -Werror -Wno-implicit-fallthrough -O2 ${CFLAGS}
o = o
mdsrc = arm32le.c
mdobj = arm32le.o
.SUFFIXES:
.SUFFIXES: .c .o
.c.o:
$C -c -D${Cpu} -I${Include} ${zlibInc} ${LZ4Inc} $*.c
include Mf-base
${KernelO}: ${kernelobj} ${zlibDep} ${LZ4Dep}
${LD} -r -X -o ${KernelO} ${kernelobj} ${zlibLib} ${LZ4Lib}
${KernelLib}: ${kernelobj}
${AR} ${ARFLAGS} ${KernelLib} ${kernelobj}
${Scheme}: ${Kernel} ${KernelLinkDeps} ${Main}
$C -rdynamic -o ${Scheme} ${Main} ${Kernel} ${mdclib} ${KernelLinkLibs} ${LDFLAGS}
../zlib/configure.log:
(cd ../zlib; ./configure)
../lz4/lib/liblz4.a: ${LZ4Sources}
(cd ../lz4/lib; ${MAKE} liblz4.a)

40
c/fasl.c
View File

@ -235,6 +235,10 @@ static uptr arm32_get_abs PROTO((void *address));
static void arm32_set_jump PROTO((void *address, uptr item, IBOOL callp));
static uptr arm32_get_jump PROTO((void *address));
#endif /* ARMV6 */
#ifdef AARCH64
static void arm64_set_abs PROTO((void *address, uptr item));
static uptr arm64_get_abs PROTO((void *address));
#endif /* AARCH64 */
#ifdef PPC32
static void ppc32_set_abs PROTO((void *address, uptr item));
static uptr ppc32_get_abs PROTO((void *address));
@ -1297,6 +1301,13 @@ void S_set_code_obj(who, typ, p, n, x, o) char *who; IFASLCODE typ; iptr n, o; p
arm32_set_jump(address, item, 1);
break;
#endif /* ARMV6 */
#ifdef AARCH64
case reloc_arm64_abs:
case reloc_arm64_jump:
case reloc_arm64_call:
arm64_set_abs(address, item);
break;
#endif /* AARCH64 */
#ifdef PPC32
case reloc_ppc32_abs:
ppc32_set_abs(address, item);
@ -1375,6 +1386,13 @@ ptr S_get_code_obj(typ, p, n, o) IFASLCODE typ; iptr n, o; ptr p; {
item = arm32_get_jump(address);
break;
#endif /* ARMV6 */
#ifdef AARCH64
case reloc_arm64_abs:
case reloc_arm64_jump:
case reloc_arm64_call:
item = arm64_get_abs(address);
break;
#endif /* AARCH64 */
#ifdef PPC32
case reloc_ppc32_abs:
item = ppc32_get_abs(address);
@ -1482,6 +1500,28 @@ static uptr arm32_get_jump(void *address) {
}
#endif /* ARMV6 */
#ifdef AARCH64
/* Address pieces in a movz,movk,movk,movk sequence are at its 5-20 */
#define ADDRESS_BITS_SHIFT 5
#define ADDRESS_BITS_MASK ((U32)0x1fffe0)
static void arm64_set_abs(void *address, uptr item) {
((U32 *)address)[0] = ((((U32 *)address)[0] & ~ADDRESS_BITS_MASK) | ((item & 0xFFFF) << ADDRESS_BITS_SHIFT));
((U32 *)address)[1] = ((((U32 *)address)[1] & ~ADDRESS_BITS_MASK) | (((item >> 16) & 0xFFFF) << ADDRESS_BITS_SHIFT));
((U32 *)address)[2] = ((((U32 *)address)[2] & ~ADDRESS_BITS_MASK) | (((item >> 32) & 0xFFFF) << ADDRESS_BITS_SHIFT));
((U32 *)address)[3] = ((((U32 *)address)[3] & ~ADDRESS_BITS_MASK) | (((item >> 48) & 0xFFFF) << ADDRESS_BITS_SHIFT));
}
static uptr arm64_get_abs(void *address) {
return ((uptr)((((U32 *)address)[0] & ADDRESS_BITS_MASK) >> ADDRESS_BITS_SHIFT)
| ((uptr)((((U32 *)address)[1] & ADDRESS_BITS_MASK) >> ADDRESS_BITS_SHIFT) << 16)
| ((uptr)((((U32 *)address)[2] & ADDRESS_BITS_MASK) >> ADDRESS_BITS_SHIFT) << 32)
| ((uptr)((((U32 *)address)[3] & ADDRESS_BITS_MASK) >> ADDRESS_BITS_SHIFT) << 48));
}
#endif /* AARCH64 */
#ifdef PPC32
#define UPDATE_ADDIS(item, instr) (((instr) & ~0xFFFF) | (((item) >> 16) & 0xFFFF))

4
c/thread.c
View File

@ -349,9 +349,11 @@ void S_mutex_release(m) scheme_mutex_t *m; {
if ((count = m->count) == 0 || !s_thread_equal(m->owner, self))
S_error1("mutex-release", "thread does not own mutex ~s", m);
if ((m->count = count - 1) == 0)
if ((m->count = count - 1) == 0) {
m->owner = 0; /* needed for a memory model like ARM, for example */
if ((status = s_thread_mutex_unlock(&m->pmutex)) != 0)
S_error1("mutex-release", "failed: ~a", S_strerror(status));
}
}
s_thread_cond_t *S_make_condition() {

2
c/vfasl.c
View File

@ -1094,6 +1094,8 @@ static IFASLCODE abs_reloc_variant(IFASLCODE type) {
return reloc_abs;
#elif defined(ARMV6)
return reloc_arm32_abs;
#elif defined(AARCH64)
return reloc_arm64_abs;
#elif defined(PPC32)
if (type == reloc_ppc32_abs)
return reloc_ppc32_abs;

7
configure vendored
View File

@ -82,6 +82,11 @@ case "${CONFIG_UNAME}" in
m64=""
tm32=tppc32le
tm64=""
elif uname -a | egrep 'armv|aarch64' > /dev/null 2>&1 ; then
m32=arm32le
m64=arm64le
tm32=tarm32le
tm64=tarm64le
fi
installprefix=/usr
installmansuffix=share/man
@ -303,7 +308,7 @@ while [ $# != 0 ] ; do
done
if [ "$bits" = "" ] ; then
if uname -a | egrep 'amd64|x86_64' > /dev/null 2>&1 ; then
if uname -a | egrep 'amd64|x86_64|aarch64' > /dev/null 2>&1 ; then
bits=64
else
bits=32

27
mats/Mf-tarm64le Normal file
View File

@ -0,0 +1,27 @@
# Mf-tarm64le
# Copyright 1984-2017 Cisco Systems, Inc.
#
# 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.
m = tarm64le
fsrc = foreign1.c foreign2.c foreign3.c foreign4.c
fobj = foreign1.so
include Mf-base
foreign1.so: ${fsrc} ../boot/$m/scheme.h
cc -fPIC -shared -I${Include} -o foreign1.so ${fsrc}
cat_flush: cat_flush.c
cc -o cat_flush cat_flush.c

5
mats/bytevector.ms
View File

@ -20,7 +20,10 @@
(and (memq (native-endianness) '(big little)) #t)
(eq? (native-endianness)
(case (machine-type)
[(i3le ti3le i3nt ti3nt a6nt ta6nt i3ob ti3ob i3fb ti3fb i3nb ti3nb i3osx ti3osx a6le ta6le a6nb ta6nb a6osx ta6osx a6fb ta6fb a6ob ta6ob a6s2 ta6s2 i3s2 ti3s2 i3qnx ti3qnx arm32le tarm32le) 'little]
[(i3le ti3le i3nt ti3nt a6nt ta6nt i3ob ti3ob i3fb ti3fb i3nb ti3nb i3osx ti3osx a6le ta6le a6nb ta6nb
a6osx ta6osx a6fb ta6fb a6ob ta6ob a6s2 ta6s2 i3s2 ti3s2 i3qnx ti3qnx
arm32le tarm32le arm64le tarm64le)
'little]
[(ppc32le tppc32le) 'big]
[else (errorf #f "unrecognized machine type")]))
)

4
mats/foreign.ms
View File

@ -184,7 +184,7 @@
(error? (load-shared-object 3))
)
]
[(i3le ti3le a6le ta6le arm32le tarm32le ppc32le tppc32le)
[(i3le ti3le a6le ta6le arm32le tarm32le arm64le tarm64le ppc32le tppc32le)
(mat load-shared-object
(file-exists? "foreign1.so")
(begin (load-shared-object "./foreign1.so") #t)
@ -2725,7 +2725,7 @@
(machine-case
[(i3ob ti3ob a6ob ta6ob a6s2 ta6s2 i3s2 ti3s2 i3qnx ti3qnx i3nb ti3nb a6nb ta6nb)
'(load-shared-object "libc.so")]
[(i3le ti3le a6le ta6le arm32le tarm32le ppc32le tppc32le)
[(i3le ti3le a6le ta6le arm32le tarm32le arm64le tarm64le ppc32le tppc32le)
'(load-shared-object "libc.so.6")]
[(i3fb ti3fb a6fb ta6fb)
'(load-shared-object "libc.so.7")]

2
mats/ftype.ms
View File

@ -560,7 +560,7 @@
(system (format "set cl= && ..\\c\\vs.bat amd64 && cl /DWIN32 /Fe~a /LD /MD /nologo ~a" testfile.so testfile.c))]
[(i3nt ti3nt)
(system (format "set cl= && ..\\c\\vs.bat x86 && cl /DWIN32 /Fe~a /LD /MD /nologo ~a" testfile.so testfile.c))]
[(arm32le tarm32le)
[(arm32le tarm32le arm64le tarm64le)
(system (format "cc -fPIC -shared -o ~a ~a" testfile.so testfile.c))]
[else ; this should work for most intel-based systems that use gcc...
(if (> (fixnum-width) 32)

2
mats/misc.ms
View File

@ -4694,7 +4694,7 @@
(#2%display 1))))
)
(unless (memq (machine-type) '(arm32le tarm32le)) ; timestamp counter tends to be priviledged on arm32le
(unless (memq (machine-type) '(arm32le tarm32le arm64le tarm64le)) ; timestamp counter tends to be priviledged on Arm
(mat $read-time-stamp-counter
(let ([t (#%$read-time-stamp-counter)])

4
s/5_3.ss
View File

@ -2624,9 +2624,7 @@
(set-who! fxbit-count
(lambda (n)
(unless (fixnum? n) ($oops who "~s is not a fixnum" n))
(if (fx< n 0)
(fxnot ($fxbit-count (fxnot n)))
($fxbit-count n))))
($fxbit-count n)))
(set-who! bitwise-bit-count
(lambda (n)
(cond

19
s/Mf-tarm64le Normal file
View File

@ -0,0 +1,19 @@
# Mf-tarm64le
# Copyright 1984-2017 Cisco Systems, Inc.
#
# 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.
m = tarm64le
archincludes = arm64.ss
include Mf-base

10
s/arm32.ss
View File

@ -622,7 +622,7 @@
(define-instruction value (move)
[(op (z mem) (x ur))
`(set! ,(make-live-info) ,z ,x)]
[(op (z ur) (x ur mem imm))
[(op (z ur) (x ur mem imm-constant))
`(set! ,(make-live-info) ,z ,x)])
(define-instruction value lea1
@ -1806,14 +1806,6 @@
(fold-right cons #'(aop-cons* `(asm ,op ,opnd ...) ?code*)
#'((build long (byte-fields chunk ...))))])))
(define-who ax-size-code
(lambda (x)
(case x
[(byte) 0]
[(word) 1]
[(long) 1]
[else (sorry! who "invalid size ~s" x)])))
(define-syntax build
(syntax-rules ()
[(_ x e)

3392
s/arm64.ss Normal file
View File

File diff suppressed because it is too large Load Diff

2
s/cmacros.ss
View File

@ -363,6 +363,7 @@
i3qnx ti3qnx
arm32le tarm32le
ppc32le tppc32le
arm64le tarm64le
)
(include "machine.def")
@ -519,6 +520,7 @@
(ppc reloc-ppccall reloc-ppcload)
(x86_64 reloc-x86_64-call reloc-x86_64-jump reloc-x86_64-popcount)
(arm32 reloc-arm32-abs reloc-arm32-call reloc-arm32-jump)
(arm64 reloc-arm64-abs reloc-arm64-call reloc-arm64-jump)
(ppc32 reloc-ppc32-abs reloc-ppc32-call reloc-ppc32-jump))
(constant-case ptr-bits

37
s/compile.ss
View File

@ -177,6 +177,24 @@
(let ([r ($reloc (constant reloc-arm32-jump) n (fx- a1 ra))])
(mkc0 (cdr c*) a (cons r r*) a1 x*))))]
[else (c-assembler-output-error c)])]
[(arm64)
(record-case c
[(arm64-abs) (n x)
(let ([a1 (fx- a 16)]) ; movz, movk, movk, movk
(let ([x* (cons (mkcode x) x*)])
(let ([r ($reloc (constant reloc-arm64-abs) n (fx- a1 ra))])
(mkc0 (cdr c*) a (cons r r*) a1 x*))))]
[(arm64-call) (n x)
(let ([a1 (fx- a 20)]) ; movz, movk, movk, movk, bl
(let ([x* (cons (mkcode x) x*)])
(let ([r ($reloc (constant reloc-arm64-call) n (fx- a1 ra))])
(mkc0 (cdr c*) a (cons r r*) a1 x*))))]
[(arm64-jump) (n x)
(let ([a1 (fx- a 20)]) ; movz, movk, movk, movk, b
(let ([x* (cons (mkcode x) x*)])
(let ([r ($reloc (constant reloc-arm64-jump) n (fx- a1 ra))])
(mkc0 (cdr c*) a (cons r r*) a1 x*))))]
[else (c-assembler-output-error c)])]
[(ppc32)
(record-case c
[(ppc32-abs) (n x)
@ -269,6 +287,10 @@
(record-case x
[(arm32-abs arm32-call arm32-jump) (n x) (build x d)]
[else (void)])]
[(arm64)
(record-case x
[(arm64-abs arm64-call arm64-jump) (n x) (build x d)]
[else (void)])]
[(ppc32)
(record-case x
[(ppc32-abs ppc32-call ppc32-jump) (n x) (build x d)]
@ -396,6 +418,21 @@
(let ([r ($reloc (constant reloc-arm32-jump) n (fx- a1 ra))])
(prf0 (cdr c*) a (cons r r*) a1 (cons x x*))))]
[else (c-assembler-output-error c)])]
[(arm64)
(record-case c
[(arm64-abs) (n x)
(let ([a1 (fx- a 16)]) ; movz, movk, movk, movk
(let ([r ($reloc (constant reloc-arm64-abs) n (fx- a1 ra))])
(prf0 (cdr c*) a (cons r r*) a1 (cons x x*))))]
[(arm64-call) (n x)
(let ([a1 (fx- a 20)]) ; movz, movk, movk, movk, bl
(let ([r ($reloc (constant reloc-arm64-call) n (fx- a1 ra))])
(prf0 (cdr c*) a (cons r r*) a1 (cons x x*))))]
[(arm64-jump) (n x)
(let ([a1 (fx- a 20)]) ; movz, movk, movk, movk, b
(let ([r ($reloc (constant reloc-arm64-jump) n (fx- a1 ra))])
(prf0 (cdr c*) a (cons r r*) a1 (cons x x*))))]
[else (c-assembler-output-error c)])]
[(ppc32)
(record-case c
[(ppc32-abs) (n x)

11
s/cpnanopass.ss
View File

@ -3706,7 +3706,7 @@
(lambda (e)
(if-feature pthreads
(constant-case architecture
[(arm32) `(seq ,(%inline write-write-fence) ,e)]
[(arm32 arm64) `(seq ,(%inline write-write-fence) ,e)]
[else e])
e)))
(define build-dirty-store
@ -7644,7 +7644,7 @@
(define-inline 3 flsqrt
[(e)
(constant-case architecture
[(x86 x86_64 arm32) (build-fp-op-1 %fpsqrt e)]
[(x86 x86_64 arm32 arm64) (build-fp-op-1 %fpsqrt e)]
[(ppc32) (build-fl-call (lookup-c-entry flsqrt) e)])])
(define-inline 3 flabs
@ -7988,7 +7988,7 @@
(build-checked-fp-op e
(lambda (e)
(constant-case architecture
[(x86 x86_64 arm32) (build-fp-op-1 %fpsqrt e)]
[(x86 x86_64 arm32 arm64) (build-fp-op-1 %fpsqrt e)]
[(ppc32) (build-fl-call (lookup-c-entry flsqrt) e)]))
(lambda (e)
(build-libcall #t src sexpr flsqrt e)))])
@ -10646,6 +10646,7 @@
(%inline logor ,(%inline sll ,%rdx (immediate 32)) ,%rax)
64))]
[(arm32) (unsigned->ptr (%inline read-time-stamp-counter) 32)]
[(arm64) (unsigned->ptr (%inline read-time-stamp-counter) 64)]
[(ppc32)
(let ([t-hi (make-tmp 't-hi)])
`(let ([,t-hi (inline ,(make-info-kill* (reg-list %real-zero))
@ -10665,7 +10666,8 @@
,(unsigned->ptr
(%inline logor ,(%inline sll ,%rdx (immediate 32)) ,%rax)
64))]
[(arm32 ppc32) (unsigned->ptr (%inline read-performance-monitoring-counter ,(build-unfix e)) 32)])])
[(arm32 ppc32) (unsigned->ptr (%inline read-performance-monitoring-counter ,(build-unfix e)) 32)]
[(arm64) (unsigned->ptr (%inline read-performance-monitoring-counter ,(build-unfix e)) 64)])])
)) ; expand-primitives module
@ -17461,6 +17463,7 @@
(let ([spillable-live (live-info-live live-info)])
(if (unspillable? x)
(let ([unspillable* (remq x unspillable*)])
(unless (uvar-seen? x) (#%printf ">> ~s\n" x))
(safe-assert (uvar-seen? x))
(uvar-seen! x #f)
(if (and (var? rhs) (var-index rhs))

87
s/mkheader.ss
View File

@ -656,8 +656,8 @@
(pr " \"cmp r12, #0\\n\\t\"\\~%")
(pr " \"bne 1f\\n\\t\"\\~%")
(pr " \"mov r12, #1\\n\\t\"\\~%")
(pr " \"strex r7, r12, [%0]\\n\\t\"\\~%")
(pr " \"cmp r7, #0\\n\\t\"\\~%")
(pr " \"strex x7, r12, [%0]\\n\\t\"\\~%")
(pr " \"cmp x7, #0\\n\\t\"\\~%")
(pr " \"beq 2f\\n\\t\"\\~%")
(pr " \"1:\\n\\t\"\\~%")
(pr " \"ldr r12, [%0, #0]\\n\\t\"\\~%")
@ -667,7 +667,7 @@
(pr " \"2:\\n\\t\"\\~%")
(pr " : \\~%")
(pr " : \"r\" (addr)\\~%")
(pr " : \"cc\", \"memory\", \"r12\", \"r7\")~%")
(pr " : \"cc\", \"memory\", \"r12\", \"x7\")~%")
(nl)
(pr "#define UNLOCK(addr) \\~%")
@ -683,14 +683,14 @@
(pr " \"0:\\n\\t\"\\~%")
(pr " \"ldrex r12, [%1, #0]\\n\\t\"\\~%")
(pr " \"add r12, r12, #1\\n\\t\"\\~%")
(pr " \"strex r7, r12, [%1]\\n\\t\"\\~%")
(pr " \"cmp r7, #0\\n\\t\"\\~%")
(pr " \"strex x7, r12, [%1]\\n\\t\"\\~%")
(pr " \"cmp x7, #0\\n\\t\"\\~%")
(pr " \"bne 0b\\n\\t\"\\~%")
(pr " \"cmp r12, #0\\n\\t\"\\~%")
(pr " \"moveq %0, #1\\n\\t\"\\~%")
(pr " : \"=&r\" (ret)\\~%")
(pr " : \"r\" (addr)\\~%")
(pr " : \"cc\", \"memory\", \"r12\", \"r7\")~%")
(pr " : \"cc\", \"memory\", \"r12\", \"x7\")~%")
(nl)
(pr "#define LOCKED_DECR(addr, ret) \\~%")
@ -698,14 +698,83 @@
(pr " \"0:\\n\\t\"\\~%")
(pr " \"ldrex r12, [%1, #0]\\n\\t\"\\~%")
(pr " \"sub r12, r12, #1\\n\\t\"\\~%")
(pr " \"strex r7, r12, [%1]\\n\\t\"\\~%")
(pr " \"cmp r7, #0\\n\\t\"\\~%")
(pr " \"strex x7, r12, [%1]\\n\\t\"\\~%")
(pr " \"cmp x7, #0\\n\\t\"\\~%")
(pr " \"bne 0b\\n\\t\"\\~%")
(pr " \"cmp r12, #0\\n\\t\"\\~%")
(pr " \"moveq %0, #1\\n\\t\"\\~%")
(pr " : \"=&r\" (ret)\\~%")
(pr " : \"r\" (addr)\\~%")
(pr " : \"cc\", \"memory\", \"r12\", \"r7\")~%")]
(pr " : \"cc\", \"memory\", \"r12\", \"x7\")~%")]
[(arm64)
(pr "#define INITLOCK(addr) \\~%")
(pr " __asm__ __volatile__ (\"mov x12, #0\\n\\t\"\\~%")
(pr " \"str x12, [%0, #0]\\n\\t\"\\~%")
(pr " : \\~%")
(pr " : \"r\" (addr)\\~%")
(pr " :\"memory\", \"x12\")~%")
(nl)
(pr "#define SPINLOCK(addr) \\~%")
(pr " __asm__ __volatile__ (\"0:\\n\\t\"\\~%")
(pr " \"ldxr x12, [%0, #0]\\n\\t\"\\~%")
(pr " \"cmp x12, #0\\n\\t\"\\~%")
(pr " \"bne 1f\\n\\t\"\\~%")
(pr " \"mov x12, #1\\n\\t\"\\~%")
(pr " \"stxr w7, x12, [%0]\\n\\t\"\\~%")
(pr " \"cmp w7, #0\\n\\t\"\\~%")
(pr " \"beq 2f\\n\\t\"\\~%")
(pr " \"1:\\n\\t\"\\~%")
(pr " \"ldr x12, [%0, #0]\\n\\t\"\\~%")
(pr " \"cmp x12, #0\\n\\t\"\\~%")
(pr " \"beq 0b\\n\\t\"\\~%")
(pr " \"b 1b\\n\\t\"\\~%")
(pr " \"2:\\n\\t\"\\~%")
(pr " : \\~%")
(pr " : \"r\" (addr)\\~%")
(pr " : \"cc\", \"memory\", \"x12\", \"x7\")~%")
(nl)
(pr "#define UNLOCK(addr) \\~%")
(pr " __asm__ __volatile__ (\"mov x12, #0\\n\\t\"\\~%")
(pr " \"str x12, [%0, #0]\\n\\t\"\\~%")
(pr " : \\~%")
(pr " : \"r\" (addr)\\~%")
(pr " :\"memory\", \"x12\")~%")
(nl)
(pr "#define LOCKED_INCR(addr, ret) \\~%")
(pr " __asm__ __volatile__ (\"mov %0, #0\\n\\t\"\\~%")
(pr " \"0:\\n\\t\"\\~%")
(pr " \"ldxr x12, [%1, #0]\\n\\t\"\\~%")
(pr " \"add x12, x12, #1\\n\\t\"\\~%")
(pr " \"stxr w7, x12, [%1]\\n\\t\"\\~%")
(pr " \"cmp w7, #0\\n\\t\"\\~%")
(pr " \"bne 0b\\n\\t\"\\~%")
(pr " \"cmp x12, #0\\n\\t\"\\~%")
(pr " \"bne 1f\\n\\t\"\\~%")
(pr " \"mov %0, #1\\n\\t\"\\~%")
(pr " \"1:\\n\\t\"\\~%")
(pr " : \"=&r\" (ret)\\~%")
(pr " : \"r\" (addr)\\~%")
(pr " : \"cc\", \"memory\", \"x12\", \"x7\")~%")
(nl)
(pr "#define LOCKED_DECR(addr, ret) \\~%")
(pr " __asm__ __volatile__ (\"mov %0, #0\\n\\t\"\\~%")
(pr " \"0:\\n\\t\"\\~%")
(pr " \"ldxr x12, [%1, #0]\\n\\t\"\\~%")
(pr " \"sub x12, x12, #1\\n\\t\"\\~%")
(pr " \"stxr w7, x12, [%1]\\n\\t\"\\~%")
(pr " \"cmp w7, #0\\n\\t\"\\~%")
(pr " \"bne 0b\\n\\t\"\\~%")
(pr " \"cmp x12, #0\\n\\t\"\\~%")
(pr " \"bne 1f\\n\\t\"\\~%")
(pr " \"mov %0, #1\\n\\t\"\\~%")
(pr " \"1:\\n\\t\"\\~%")
(pr " : \"=&r\" (ret)\\~%")
(pr " : \"r\" (addr)\\~%")
(pr " : \"cc\", \"memory\", \"x12\", \"x7\")~%")]
[else
($oops who "asm locking code is not yet defined for ~s" (constant architecture))]))))

6
s/np-languages.ss
View File

@ -558,8 +558,10 @@
(declare-primitive store-double->single effect #f)
(declare-primitive store-with-update effect #f) ; ppc
(declare-primitive unactivate-thread effect #f) ; threaded version only
(declare-primitive vpush-multiple effect #f) ; arm
(declare-primitive vpop-multiple effect #f) ; arm
(declare-primitive vpush-multiple effect #f) ; arm32
(declare-primitive vpop-multiple effect #f) ; arm32
(declare-primitive push-fpmultiple effect #f) ; arm64
(declare-primitive pop-fpmultiple effect #f) ; arm64
(declare-primitive cas effect #f)
(declare-primitive write-write-fence effect #f)

3
s/setup.ss
View File

@ -15,6 +15,7 @@
(include "debug.ss")
(unless (getenv "DEBUGNOW")
(base-exception-handler
(lambda (c)
(fresh-line)
@ -26,3 +27,5 @@
(lambda ()
(display "interrupted---aborting\n")
(reset)))
)

2
s/tarm32le.def
View File

@ -1,4 +1,4 @@
;;; arm32le.def
;;; tarm32le.def
;;; Copyright 1984-2017 Cisco Systems, Inc.
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");

39
s/tarm64le.def Normal file
View File

@ -0,0 +1,39 @@
;;; tarm64le.def
(define-constant machine-type (constant machine-type-tarm64le))
(define-constant architecture 'arm64)
(define-constant address-bits 64)
(define-constant ptr-bits 64)
(define-constant int-bits 32)
(define-constant short-bits 16)
(define-constant long-bits 64)
(define-constant long-long-bits 64)
(define-constant size_t-bits 64)
(define-constant ptrdiff_t-bits 64)
(define-constant wchar-bits 32)
(define-constant time-t-bits 64)
(define-constant max-float-alignment 8)
(define-constant max-integer-alignment 8)
(define-constant asm-arg-reg-max 9)
(define-constant asm-arg-reg-cnt 3)
(define-constant asm-fpreg-max 2)
(define-constant typedef-ptr "void *")
(define-constant typedef-iptr "long")
(define-constant typedef-uptr "unsigned long")
(define-constant typedef-i8 "char")
(define-constant typedef-u8 "unsigned char")
(define-constant typedef-i16 "short")
(define-constant typedef-u16 "unsigned short")
(define-constant typedef-i32 "int")
(define-constant typedef-u32 "unsigned int")
(define-constant typedef-i64 "long")
(define-constant typedef-u64 "unsigned long")
(define-constant typedef-string-char "unsigned int")
(define-constant native-endianness 'little)
(define-constant unaligned-floats #f)
(define-constant unaligned-integers #t)
(define-constant integer-divide-instruction #f)
(define-constant popcount-instruction #f)
(define-constant software-floating-point #f)
(define-constant segment-table-levels 3)
(features iconv expeditor pthreads)

1
workarea
View File

@ -56,6 +56,7 @@ case "$M" in
ta6osx) ;;
ta6s2) ;;
tarm32le) ;;
tarm64le) ;;
ti3fb) ;;
ti3le) ;;
ti3nb) ;;