769 |
;;; Local entry |
;;; Local entry |
770 |
(analyze-regs (cadr lambda-expr) 0) |
(analyze-regs (cadr lambda-expr) 0) |
771 |
(t3defun-aux 't3defun-local-entry |
(t3defun-aux 't3defun-local-entry |
772 |
(case (caddr inline-info) |
(case (promoted-c-type (caddr inline-info)) |
773 |
(fixnum 'return-fixnum) |
(fixnum 'return-fixnum) |
774 |
(character 'return-character) |
(character 'return-character) |
775 |
(long-float 'return-long-float) |
(long-float 'return-long-float) |
776 |
(short-float 'return-short-float) |
(short-float 'return-short-float) |
777 |
(otherwise 'return-object)) |
(otherwise 'return-object)) |
778 |
fname cfun lambda-expr sp inline-info |
fname cfun lambda-expr sp inline-info |
779 |
)) |
)) |
780 |
((vararg-p fname) |
((vararg-p fname) |
802 |
(push (cons (car vl) (var-loc (car vl))) specials)) |
(push (cons (car vl) (var-loc (car vl))) specials)) |
803 |
(t |
(t |
804 |
(setf (var-kind (car vl)) |
(setf (var-kind (car vl)) |
805 |
(case (car types) |
(case (promoted-c-type (car types)) |
806 |
(fixnum 'FIXNUM) |
(fixnum 'FIXNUM) |
807 |
(character 'CHARACTER) |
(character 'CHARACTER) |
808 |
(long-float 'LONG-FLOAT) |
(long-float 'LONG-FLOAT) |
1325 |
(wt-nl1 "{ register object *base=vs_base;") |
(wt-nl1 "{ register object *base=vs_base;") |
1326 |
(when (or *safe-compile* *compiler-check-args*) |
(when (or *safe-compile* *compiler-check-args*) |
1327 |
(wt-nl "check_arg(" (length arg-types) ");")) |
(wt-nl "check_arg(" (length arg-types) ");")) |
1328 |
(wt-nl "base[0]=" (case return-type |
(wt-nl "base[0]=" (case (promoted-c-type return-type) |
1329 |
(fixnum (if (zerop *space*) |
(fixnum (if (zerop *space*) |
1330 |
"CMPmake_fixnum" |
"CMPmake_fixnum" |
1331 |
"make_fixnum")) |
"make_fixnum")) |
1338 |
(n 0 (1+ n))) |
(n 0 (1+ n))) |
1339 |
((endp types)) |
((endp types)) |
1340 |
(declare (object types) (fixnum n)) |
(declare (object types) (fixnum n)) |
1341 |
(wt (case (car types) |
(wt (case (promoted-c-type (car types)) |
1342 |
(fixnum "fix") |
(fixnum "fix") |
1343 |
(character "char_code") |
(character "char_code") |
1344 |
(long-float "lf") |
(long-float "lf") |
1352 |
) |
) |
1353 |
|
|
1354 |
(defun rep-type (type) |
(defun rep-type (type) |
1355 |
(case type |
(case (promoted-c-type type) |
1356 |
(fixnum "long ") |
(fixnum "long ") |
1357 |
(integer "GEN ") |
(integer "GEN ") |
1358 |
(character "unsigned char ") |
(character "unsigned char ") |
1359 |
(short-float "float ") |
(short-float "float ") |
1360 |
(long-float "double ") |
(long-float "double ") |
1361 |
(otherwise "object "))) |
(otherwise "object "))) |
1362 |
|
|
1363 |
|
|
1364 |
(defun t1defmacro (args) |
(defun t1defmacro (args) |