-\f
-;;; The loader uses this to convert alien names to the form they
-;;; occur in the symbol table.
-
-(defun extern-alien-name (name)
- (declare (type string name))
- ;; Darwin is non-ELF, and needs a _ prefix. The other (ELF) ports
- ;; currently don't need any prefix.
- (flet ((maybe-prefix (name)
- #!+darwin (concatenate 'simple-base-string "_" name)
- #!-darwin name))
- (typecase name
- (simple-base-string (maybe-prefix name))
- (base-string (coerce (maybe-prefix name) 'simple-base-string))
- (t
- (handler-case (coerce (maybe-prefix name) 'simple-base-string)
- (type-error ()
- (error "invalid external alien name: ~S" name)))))))
+
+(!def-vm-support-routine combination-implementation-style (node)
+ (declare (type sb!c::combination node))
+ (flet ((valid-funtype (args result)
+ (sb!c::valid-fun-use node
+ (sb!c::specifier-type
+ `(function ,args ,result)))))
+ (case (sb!c::combination-fun-source-name node)
+ (logtest
+ (cond
+ ((or (valid-funtype '(fixnum fixnum) '*)
+ (valid-funtype '((signed-byte 32) (signed-byte 32)) '*)
+ (valid-funtype '((unsigned-byte 32) (unsigned-byte 32)) '*))
+ (values :direct nil))
+ (t (values :default nil))))
+ (logbitp
+ (cond
+ ((or (valid-funtype '((constant-arg (integer 0 29)) fixnum) '*)
+ (valid-funtype '((constant-arg (integer 0 31)) (signed-byte 32)) '*)
+ (valid-funtype '((constant-arg (integer 0 31)) (unsigned-byte 32)) '*))
+ (values :transform '(lambda (index integer)
+ (%logbitp integer index))))
+ (t (values :default nil))))
+ ;; FIXME: can handle MIN and MAX here
+ (sb!kernel:%ldb
+ (flet ((validp (type width)
+ (and (valid-funtype `((constant-arg (integer 1 29))
+ (constant-arg (mod ,width))
+ ,type)
+ 'fixnum)
+ (destructuring-bind (size posn integer)
+ (sb!c::basic-combination-args node)
+ (declare (ignore integer))
+ (<= (+ (sb!c::lvar-value size)
+ (sb!c::lvar-value posn))
+ width)))))
+ (if (or (validp 'fixnum 29)
+ (validp '(signed-byte 32) 32)
+ (validp '(unsigned-byte 32) 32))
+ (values :transform '(lambda (size posn integer)
+ (%%ldb integer size posn)))
+ (values :default nil))))
+ (t (values :default nil)))))
+
+(defun primitive-type-indirect-cell-type (ptype)
+ (declare (ignore ptype))
+ nil)