add tarm32le

Besides adding supportt for `__collect-safe` and other repairs,
introduce a write-write fence with the write barrier, which is
intended to avoid one thread using an object created in another thread
before the object's initializing writes are visible.

original commit: 543bd16739c08e5a8f88c470b52db0f23a27d260

.gitignore

@@ -16,6 +16,10 @@
 /ti3le/
 /ti3nt/
 /ti3osx/
+/arm32le/
+/tarm32le/
+/ppc32le/
+/tppc32le/
 /xc-*/
 *.*run
 /csug/math/csug/

c/Mf-tarm32le

@@ -0,0 +1,46 @@
+# Mf-arm32le
+# 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 = tarm32le
+Cpu = ARMV6
+
+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)

c/vfasl.c

@@ -541,7 +541,7 @@ ptr S_vfasl(ptr bv, void *stream, iptr offset, iptr input_len)
     ptr sym_base = vspaces[vspace_symbol];
     ptr code = TYPE(vspaces[vspace_code], type_typed_object);
     ptr code_end = TYPE(VSPACE_END(vspace_code), type_typed_object);
-    S_record_code_mod(tc, (uptr)code, (uptr)code_end - (uptr)code);
+    S_record_code_mod(tc, (uptr)vspaces[vspace_code], (uptr)code_end - (uptr)code);
     while (code != code_end) {
       relink_code(code, sym_base, vspaces, vspace_offsets, to_static);
       code = ptr_add(code, size_code(CODELEN(code)));

mats/Mf-tarm32le

@@ -0,0 +1,27 @@
+# Mf-tarm32le
+# 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 = tarm32le
+
+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

s/Mf-tarm32le

@@ -0,0 +1,19 @@
+# Mf-tarm32le
+# 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 = tarm32le
+archincludes = arm32.ss
+
+include Mf-base

s/arm32.ss

@@ -842,6 +842,32 @@
          `(set! ,(make-live-info) ,ulr (asm ,null-info ,asm-kill))
          `(set! ,(make-live-info) ,z (asm ,info ,asm-get-tc ,u ,ulr))))])
 
+  (define-instruction value activate-thread
+    [(op (z ur))
+     (safe-assert (eq? z %Cretval))
+     (let ([u (make-tmp 'u)] [ulr (make-precolored-unspillable 'ulr %lr)])
+       (seq
+         `(set! ,(make-live-info) ,u (asm ,null-info ,asm-kill))
+         `(set! ,(make-live-info) ,ulr (asm ,null-info ,asm-kill))
+         `(set! ,(make-live-info) ,z (asm ,info ,asm-activate-thread ,u ,ulr))))])
+
+  (define-instruction effect deactivate-thread
+    [(op)
+     (let ([u (make-tmp 'u)] [ulr (make-precolored-unspillable 'ulr %lr)])
+       (seq
+         `(set! ,(make-live-info) ,u (asm ,null-info ,asm-kill))
+         `(set! ,(make-live-info) ,ulr (asm ,null-info ,asm-kill))
+         `(asm ,info ,asm-deactivate-thread ,u ,ulr)))])
+
+  (define-instruction effect unactivate-thread
+    [(op (x ur))
+     (safe-assert (eq? x %r2))
+     (let ([u (make-tmp 'u)] [ulr (make-precolored-unspillable 'ulr %lr)])
+       (seq
+         `(set! ,(make-live-info) ,u (asm ,null-info ,asm-kill))
+         `(set! ,(make-live-info) ,ulr (asm ,null-info ,asm-kill))
+         `(asm ,info ,asm-unactivate-thread ,x ,u ,ulr)))])
+
   (define-instruction value (asmlibcall)
     [(op (z ur)) 
      (let ([u (make-tmp 'u)])
@@ -959,6 +985,10 @@
                `(set! ,(make-live-info) ,u2 (asm ,null-info ,asm-kill))
 	       `(asm ,info ,asm-cas ,r ,old ,new ,u1 ,u2)))))]))
 
+  (define-instruction effect (write-write-fence)
+    [(op)
+     `(asm ,info ,asm-write-write-fence)])
+
   (define-instruction effect (pause)
     ; NB: user sqrt or something like that?
     [(op) '()])
@@ -1003,7 +1033,7 @@
                      asm-rp-header asm-rp-compact-header
                      asm-indirect-call asm-condition-code
                      asm-fpmove-single asm-fl-cvt asm-fpt asm-fpmove asm-fpcastto asm-fpcastfrom asm-fptrunc 
-                     asm-lock asm-lock+/- asm-cas
+                     asm-lock asm-lock+/- asm-cas asm-write-write-fence
                      asm-fpop-2 asm-fpsqrt asm-c-simple-call
                      asm-save-flrv asm-restore-flrv asm-return asm-c-return asm-size
                      asm-enter asm-foreign-call asm-foreign-callable
@@ -1013,6 +1043,7 @@
                      shift-count? unsigned8? unsigned12?
                      ; threaded version specific
                      asm-get-tc
+                     asm-activate-thread asm-deactivate-thread asm-unactivate-thread
                      ; machine dependent exports
                      asm-kill
                      info-vpush-reg info-vpush-n)
@@ -1155,6 +1186,8 @@
   (define-op ldrex ldrex-op      #b00011001)
   (define-op strex strex-op      #b00011000)
 
+  (define-op dmbishst dmb-op #b1010)
+
   (define-op bnei  branch-imm-op       (ax-cond 'ne))
   (define-op brai  branch-imm-op       (ax-cond 'al))
 
@@ -1397,6 +1430,12 @@
         [4  #b1001]
         [0  (ax-ea-reg-code opnd0-ea)])))
 
+  (define dmb-op
+    (lambda (op opcode code*)
+      (emit-code (op code*)
+	[4 #b1111010101111111111100000101]
+	[0 opcode])))
+
   (define branch-imm-op
     (lambda (op cond-bits disp code*)
       (emit-code (op disp code*)
@@ -2098,6 +2137,7 @@
               [else (sorry! who "unexpected asm-swap type argument ~s" type)]))))))
 
   (define asm-lock
+    ;  tmp = 1 # in case load result is not 0
     ;  tmp2 = ldrex src
     ;  cmp tmp2, 0
     ;  bne L1 (+2)
@@ -2106,11 +2146,12 @@
     ;L1:
     (lambda (code* src tmp tmp2)
       (Trivit (src tmp tmp2)
-        (emit ldrex tmp2 src
+        (emit movi1 tmp 1
-          (emit cmpi tmp2 0
+          (emit ldrex tmp2 src
-            (emit bnei 1
+            (emit cmpi tmp2 0
-              (emit movi1 tmp2 1
+              (emit bnei 1
-                (emit strex tmp tmp2 src code*))))))))
+                (emit movi1 tmp2 1
+                  (emit strex tmp tmp2 src code*)))))))))
 
   (define-who asm-lock+/-
     ; L:
@@ -2149,6 +2190,10 @@
                 (emit cmpi tmp2 0
                    code*))))))))
 
+  (define asm-write-write-fence
+    (lambda (code*)
+      (emit dmbishst code*)))
+
   (define asm-fp-relop
     (lambda (info)
       (lambda (l1 l2 offset x y)
@@ -2292,6 +2337,21 @@
       (lambda (code* dest jmp-tmp . ignore) ; dest is ignored, since it is always Cretval
         (asm-helper-call code* target #f jmp-tmp))))
 
+  (define asm-activate-thread
+    (let ([target `(arm32-call 0 (entry ,(lookup-c-entry activate-thread)))])
+      (lambda (code* dest jmp-tmp . ignore)
+        (asm-helper-call code* target #t jmp-tmp))))
+
+  (define asm-deactivate-thread
+    (let ([target `(arm32-call 0 (entry ,(lookup-c-entry deactivate-thread)))])
+      (lambda (code* jmp-tmp . ignore)
+        (asm-helper-call code* target #f jmp-tmp))))
+
+  (define asm-unactivate-thread
+    (let ([target `(arm32-call 0 (entry ,(lookup-c-entry unactivate-thread)))])
+      (lambda (code* arg-reg jmp-tmp . ignore)
+        (asm-helper-call code* target #f jmp-tmp))))
+
   (define-who asm-return-address
     (lambda (dest l incr-offset next-addr)
       (make-rachunk dest l incr-offset next-addr
@@ -2552,6 +2612,35 @@
     (define num-dbl-regs 8) ; number of `double` registers normally usd by the ABI
     (define sgl-regs (lambda () (list %Cfparg1 %Cfparg1b %Cfparg2 %Cfparg2b %Cfparg3 %Cfparg3b %Cfparg4 %Cfparg4b
 				      %Cfparg5 %Cfparg5b %Cfparg6 %Cfparg6b %Cfparg7 %Cfparg7b %Cfparg8 %Cfparg8b)))
+    (define save-and-restore
+      (lambda (regs e)
+        (safe-assert (andmap reg? regs))
+	(with-output-language (L13 Effect)
+          (let ([save-and-restore-gp
+		 (lambda (regs e)
+                   (let* ([regs (filter (lambda (r) (not (eq? (reg-type r) 'fp))) regs)]
+                          [regs (if (fxodd? (length regs))
+                                    (cons %tc regs) ; keep doubleword aligned
+                                    regs)])
+                     (cond
+                      [(null? regs) e]
+                      [else
+                       (%seq
+			(inline ,(make-info-kill*-live* '() regs) ,%push-multiple)
+			,e
+			(inline ,(make-info-kill*-live* regs '()) ,%pop-multiple))])))]
+		[save-and-restore-fp
+		 (lambda (regs e)
+                   (let ([fp-regs (filter (lambda (r) (eq? (reg-type r) 'fp)) regs)])
+                     (cond
+                      [(null? fp-regs) e]
+                      [else
+                       (let ([info (make-info-vpush (car fp-regs) (length fp-regs))])
+                         (%seq
+			  (inline ,info ,%vpush-multiple)
+			  ,e
+			  (inline ,info ,%vpop-multiple)))])))])
+            (save-and-restore-gp regs (save-and-restore-fp regs e))))))
     (define-who asm-foreign-call
       (with-output-language (L13 Effect)
         (define int-regs (lambda () (list %Carg1 %Carg2 %Carg3 %Carg4)))
@@ -2708,12 +2797,12 @@
 				     [(and doubles?
 					   (fx>= (length sgl*) (fx* 2 num-members)))
 				      ;; Allocate each double to a register
-				      (let dbl-loop ([size size] [offset 0] [sgl* sgl*] [loc #f])
+				      (let dbl-loop ([size size] [offset 0] [live* live*] [sgl* sgl*] [loc #f])
 					(cond
 					 [(fx= size 0)
 					  (loop (cdr types) (cons loc locs) live* int* sgl* #f isp)]
 					 [else
-					  (dbl-loop (fx- size 8) (fx+ offset 8) (cddr sgl*)
+					  (dbl-loop (fx- size 8) (fx+ offset 8) (cons (car sgl*) live*) (cddr sgl*)
 						    (combine-loc loc (load-boxed-double-reg (car sgl*) offset)))]))]
 				     [else
 				      ;; General case; for non-doubles, use integer registers while available,
@@ -2853,14 +2942,49 @@
                        (case bits
                          [(64) (list %r1 %Cretval)]
                          [else (list %Cretval)])]
-                      [else (list %r0)]))])
+		      [(fp-ftd& ,ftd)
+		       (let* ([members ($ftd->members ftd)]
+			      [num-members (length members)])
+			 (cond
+			  [(and (fx<= num-members 4)
+				(or (andmap double-member? members)
+				    (andmap float-member? members)))
+			   ;; double/float results are in floating-point registers
+			   (let ([double? (and (pair? members) (double-member? (car members)))])
+			     (let loop ([members members] [sgl* (sgl-regs)])
+			       (cond
+				[(null? members) '()]
+				[double?
+				 (cons (car sgl*) (loop (cdr members) (cddr sgl*)))]
+				[else
+				 (cons (car sgl*) (if (null? (cdr members))
+						      '()
+						      (loop (cddr members) (cddr sgl*))))])))]
+			    [else
+			     ;; result is in %Cretval and maybe %r1
+			     (case ($ftd-size ftd)
+			       [(8) (list %Cretval %r1)]
+			       [else (list %Cretval)])]))]
+                      [else (list %r0)]))]
+                 [add-deactivate
+                  (lambda (adjust-active? t0 live* result-live* k)
+                    (cond
+                      [adjust-active?
+                       (%seq
+			(set! ,%ac0 ,t0)
+                        ,(save-and-restore live* (%inline deactivate-thread))
+                        ,(k %ac0)
+                        ,(save-and-restore result-live* `(set! ,%Cretval ,(%inline activate-thread))))]
+                      [else (k t0)]))])
           (lambda (info)
             (safe-assert (reg-callee-save? %tc)) ; no need to save-restore
             (let* ([arg-type* (info-foreign-arg-type* info)]
-                   [varargs? (memq 'varargs (info-foreign-conv* info))]
+                   [conv* (info-foreign-conv* info)]
+                   [varargs? (memq 'varargs conv*)]
 		   [result-type (info-foreign-result-type info)]
                    [result-reg* (get-result-regs result-type varargs?)]
-		   [fill-result-here? (indirect-result-that-fits-in-registers? result-type)])
+		   [fill-result-here? (indirect-result-that-fits-in-registers? result-type)]
+                   [adjust-active? (if-feature pthreads (memq 'adjust-active conv*) #f)])
               (with-values (do-args (if fill-result-here? (cdr arg-type*) arg-type*)
                                     varargs?)
                 (lambda (args-frame-size locs live*)
@@ -2883,7 +3007,9 @@
 			 [else locs]))
                       (lambda (t0 not-varargs?)
 			(add-fill-result fill-result-here? result-type args-frame-size
-			  `(inline ,(make-info-kill*-live* (add-caller-save-registers result-reg*) live*) ,%c-call ,t0)))
+                         (add-deactivate adjust-active? t0 live* result-reg*
+			  (lambda (t0)
+ 			    `(inline ,(make-info-kill*-live* (add-caller-save-registers result-reg*) live*) ,%c-call ,t0)))))
                       (nanopass-case (Ltype Type) result-type
                         [(fp-double-float)
                          (if varargs?
@@ -2948,9 +3074,9 @@
                    |      &-return space       | up to 8 words
           sp+52+R: |                           |
                    +---------------------------+<- 8-byte boundary
-                   |                           | 
+                   |     activatation state    | 
-                   |   pad word if necessary   | 0-1 words
+                   |          and/or           | 0-2 words
-            sp+52: |                           |
+            sp+52: |   pad word if necessary   |
                    +---------------------------+
                    |                           |
                    |   callee-save regs + lr   | 13 words
@@ -3233,7 +3359,14 @@
                                                `(set! ,(car sgl*) ,(%mref ,%sp ,%zero ,offset fp))
                                                `(set! ,(car sgl*) ,(%inline load-single ,(%mref ,%sp ,%zero ,offset fp))))])
 				      (if e `(seq ,e ,new-e) new-e)))]))))
-		      '()
+		      (let ([double? (and (pair? members) (double-member? (car members)))])
+			(let loop ([members members] [sgl* (sgl-regs)] [aligned? #t])
+			  (cond
+			   [(null? members) '()]
+			   [else (let ([regs (loop (cdr members)
+						   (if double? (cddr sgl*) (cdr sgl*))
+						   (or double? (not aligned?)))])
+				   (if aligned? (cons (car sgl*) regs) regs))])))
 		      ($ftd-size ftd))]
 		    [else
 		     (case ($ftd-size ftd)
@@ -3316,12 +3449,16 @@
                                            (memq r callee-save-regs+lr))))
                                  (vector->list regvec)))
             (let* ([arg-type* (info-foreign-arg-type* info)]
-		   [varargs? (memq 'varargs (info-foreign-conv* info))]
+                   [conv* (info-foreign-conv* info)]
+		   [varargs? (memq 'varargs conv*)]
 		   [result-type (info-foreign-result-type info)]
-                   [synthesize-first? (indirect-result-that-fits-in-registers? result-type)])
+                   [synthesize-first? (indirect-result-that-fits-in-registers? result-type)]
+                   [adjust-active? (if-feature pthreads (memq 'adjust-active conv*) #f)])
               (let-values ([(iint idbl) (count-reg-args arg-type* synthesize-first? varargs?)])
                 (let ([saved-reg-bytes (fx+ (fx* isaved 4) (fx* fpsaved 8))]
-                      [pre-pad-bytes (if (fxeven? isaved) 0 4)]
+                      [pre-pad-bytes (if (fxeven? isaved) 
+                                         (if adjust-active? 8 0)
+                                         4)]
                       [int-reg-bytes (fx* iint 4)]
                       [post-pad-bytes (if (fxeven? iint) 0 4)]
                       [float-reg-bytes (fx* idbl 8)])
@@ -3343,6 +3480,12 @@
                             ; save the callee save registers & return address
                             (inline ,(make-info-kill*-live* '() callee-save-regs+lr) ,%push-multiple)
                             (inline ,(make-info-vpush (car callee-save-fpregs) fpsaved) ,%vpush-multiple)
+                            ; maybe activate
+                            ,(if adjust-active?
+                                 `(seq
+                                   (set! ,%Cretval ,(%inline activate-thread))
+                                   (set! ,(%mref ,%sp ,saved-reg-bytes) ,%Cretval))
+                                 `(nop))
                             ; set up tc for benefit of argument-conversion code, which might allocate
                             ,(if-feature pthreads
                                (%seq 
@@ -3357,6 +3500,11 @@
                         (lambda ()
                           (in-context Tail
                             (%seq
+                              ,(if adjust-active?
+                                   `(seq
+                                     (set! ,%r2 ,(%mref ,%sp ,saved-reg-bytes))
+                                     ,(save-and-restore result-regs (%inline unactivate-thread ,%r2)))
+                                   `(nop))
                               ; restore the callee save registers
                               (inline ,(make-info-vpush (car callee-save-fpregs) fpsaved) ,%vpop-multiple)
                               (inline ,(make-info-kill* callee-save-regs+lr) ,%pop-multiple)

s/cpnanopass.ss

@@ -3702,12 +3702,19 @@
               ,(%inline sll ,e
                  (immediate ,(fx- (constant char-data-offset) (constant fixnum-offset))))
               ,(%constant type-char))))
+	(define add-write-fence
+	  (lambda (e)
+            (if-feature pthreads
+	      (constant-case architecture
+	        [(arm32) `(seq ,(%inline write-write-fence) ,e)]
+                [else e])
+              e)))
         (define build-dirty-store
           (case-lambda
             [(base offset e) (build-dirty-store base %zero offset e)]
             [(base index offset e) (build-dirty-store base index offset e
                                      (lambda (base index offset e) `(set! ,(%mref ,base ,index ,offset) ,e))
-                                     (lambda (s r) `(seq ,s ,r)))]
+                                     (lambda (s r) (add-write-fence `(seq ,s ,r))))]
             [(base index offset e build-assign build-seq)
              (if (nanopass-case (L7 Expr) e
                    [(quote ,d) (ptr->imm d)]
@@ -3730,7 +3737,7 @@
                        (bind #t ([e e])
                          ; eval a second so the address is not live across any calls
                          (bind #t ([a a])
-                           (build-seq
+			   (build-seq
                              (build-assign a %zero 0 e)
                              `(if ,(%type-check mask-fixnum type-fixnum ,e)
                                   ,(%constant svoid)
@@ -3743,9 +3750,10 @@
                 (inline ,(make-info-condition-code 'eq? #f #t) ,%condition-code)))))
         (define build-cas-seq
           (lambda (cas remember)
-            `(if ,cas
+	    (add-write-fence
-                 (seq ,remember ,(%constant strue))
+             `(if ,cas
-                 ,(%constant sfalse))))
+                  (seq ,remember ,(%constant strue))
+                  ,(%constant sfalse)))))
         (define build-$record
           (lambda (tag args)
             (bind #f (tag)

s/np-languages.ss

@@ -561,7 +561,8 @@
   (declare-primitive vpush-multiple effect #f) ; arm
   (declare-primitive vpop-multiple effect #f) ; arm
   (declare-primitive cas effect #f)
-
+  (declare-primitive write-write-fence effect #f)
+  
   (declare-primitive < pred #t)
   (declare-primitive <= pred #t)
   (declare-primitive > pred #t)

s/tarm32le.def

@@ -0,0 +1,52 @@
+;;; arm32le.def
+;;; 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.
+
+(define-constant machine-type (constant machine-type-tarm32le))
+(define-constant architecture 'arm32)
+(define-constant address-bits 32)
+(define-constant ptr-bits 32)
+(define-constant int-bits 32)
+(define-constant short-bits 16)
+(define-constant long-bits 32)
+(define-constant long-long-bits 64)
+(define-constant size_t-bits 32)
+(define-constant ptrdiff_t-bits 32)
+(define-constant wchar-bits 32)
+(define-constant time-t-bits 32)
+(define-constant max-float-alignment 8)
+(define-constant max-integer-alignment 8)
+(define-constant asm-arg-reg-max 5)
+(define-constant asm-arg-reg-cnt 3)
+(define-constant asm-fpreg-max 2)
+(define-constant typedef-ptr "void *")
+(define-constant typedef-iptr "int")
+(define-constant typedef-uptr "unsigned int")
+(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 long")
+(define-constant typedef-u64 "unsigned long 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 1)
+(features iconv expeditor pthreads)