Changeset 13715


Ignore:
Timestamp:
May 22, 2010, 7:17:19 AM (9 years ago)
Author:
gb
Message:

And we need to continue to tweak those mechanisms.

Location:
branches/arm/compiler/ARM
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • branches/arm/compiler/ARM/arm-arch.lisp

    r13707 r13715  
    658658)
    659659
    660 ;;; Catch frames go on the tstack; they point to a minimal lisp-frame
    661 ;;; on the cstack.  (The catch/unwind-protect PC is on the cstack, where
    662 ;;; the GC expects to find it.)
     660;;; Catch frames go on the cstack, below a lisp frame whose savelr
     661;;; field references the catch exit point/unwind-protect cleanup code.
    663662(define-fixedsized-object catch-frame
    664   catch-tag                             ; #<unbound> -> unwind-protect, else catch
    665663  link                                  ; tagged pointer to next older catch frame
    666664  mvflag                                ; 0 if single-value, 1 if uwp or multiple-value
     665  catch-tag                             ; #<unbound> -> unwind-protect, else catch
    667666  db-link                               ; value of dynamic-binding link on thread entry.
    668667  xframe                                ; exception-frame link
     
    12901289(defconstant xtype-s8  32)
    12911290(defconstant xtype-u8  36)
    1292 (defconstant xtype-bit  40)                               
    1293 
     1291(defconstant xtype-bit  40)
     1292(defconstant xtype-rational 44)
     1293(defconstant xtype-real 48)
     1294(defconstant xtype-number 52)
     1295(defconstant xtype-char-code 56)
     1296
     1297;;; Condition field values.
     1298(ccl::defenum (:prefix "ARM-COND-")
     1299  eq
     1300  ne
     1301  hs
     1302  lo
     1303  mi
     1304  pl
     1305  vs
     1306  vc
     1307  hi
     1308  ls
     1309  ge
     1310  lt
     1311  gt
     1312  le
     1313  al)
     1314
     1315(defconstant arm-cond-eq 0)
     1316(def
    12941317 
    12951318(provide "ARM-ARCH")
  • branches/arm/compiler/ARM/arm-asm.lisp

    r13707 r13715  
    604604               (< nbits 32)))
    605605  (let* ((r (- 32 nbits))
    606          (mask (1- (ash 1 r))))
     606         (mask (1- (ash 1 nbits))))
    607607    (logand #xffffffff
    608608            (logior (ash u32 nbits)
     
    790790                (error "Can't encode ARM constant ~s." value)))))))
    791791
    792 (defun set-addressing-mode (instruction mode constant-index)
     792(defun set-opcode-value-from-addressing-mode (opcode mode constant-index)
    793793  ;; Look at mode and set P/W/U bits.  If CONSTANT-INDEX is
    794794  ;; true, the U bit depends on the sign of the constant.
     
    797797     ;; Preindexed, no writeback unless :+@! , add register operands.
    798798     (unless constant-index
    799        (set-field-value instruction (byte 1 23) 1))
     799       (setq opcode (logior opcode (ash 1 23))))
    800800     (when (eq mode :+@!)
    801        (set-field-value instruction (byte 1 21) 1))
    802      (set-field-value instruction (byte 1 24) 1))
     801       (setq opcode (logior opcode (ash 1 21))))
     802     (setq opcode (logior opcode (ash 1 24))))
    803803    ((:-@ :-@!)
    804804     ;; Preindexed. Leave the U bit clear, maybe set W if writeback.
    805805     (when (eq mode :-@!)
    806        (set-field-value instruction (byte 1 21) 1))
    807      (set-field-value instruction (byte 1 24) 1))
     806       (setq opcode (logior opcode (ash 1 21))))
     807     (setq opcode (logior opcode (ash 1 24))))
    808808    ((:@+ :@-)
    809809     ;; Postindex; writeback is implicit (and setting P and W would
    810810     ;; change the instruction.)
    811811     (unless (or (eq mode :@-) constant-index)
    812        (set-field-value instruction (byte 1 23) 1)))))
     812       (setq opcode (logior opcode (ash 1 23))))))
     813  opcode)
     814
     815
     816(defun set-addressing-mode (instruction mode constant-index)
     817  (setf (lap-instruction-opcode instruction)
     818        (set-opcode-value-from-addressing-mode
     819         (lap-instruction-opcode instruction) mode constant-index)))
    813820
    814821;;; "general" address operand, as used in LDR/LDRB/STR/STRB
     
    886893        (set-field-value instruction (byte 1 21) 1)
    887894        (set-field-value instruction (byte 4 16) (need-arm-gpr rn)))
    888       (error "Unrecognize writeback indicator in ~s." form))))
     895      (error "Unrecognized writeback indicator in ~s." form))))
    889896
    890897(defun parse-uuoA-operand (form instruction)
     
    977984        (unless template
    978985          (error "Unknown ARM instruction - ~s" form))
    979         (when (and (consp (car opvals))
    980                    (eq (keywordize (caar opvals)) :?))
    981           (let* ((condform (pop opvals)))
    982             (destructuring-bind (q cond-name) condform
    983               (declare (ignore q))
    984               (let* ((c (need-arm-condition-name cond-name)))
    985                 (if (and explicit-cond (not (eql c cond)))
    986                   (error "Can't use explicit condition and :? : ~s" condform)
    987                   (setq cond c))))))
     986        (let* ((cond-indicator (and (consp (car opvals))
     987                                    (keywordize (caar opvals)))))
     988          (when (or (eq cond-indicator :?)
     989                    (eq cond-indicator :~))
     990            (let* ((condform (pop opvals)))
     991              (destructuring-bind (q cond-name) condform
     992                (declare (ignore q))
     993                (let* ((c (need-arm-condition-name cond-name)))
     994                  (when (eq cond-indicator :~)
     995                    (if (< c 14)
     996                      (setq c (logxor c 1))
     997                      (error "Invalid explicit condition ~s." condform)))
     998                  (if (and explicit-cond (not (eql c cond)))
     999                    (error "Can't use explicit condition and :? : ~s" condform)
     1000                    (setq cond c)))))))
    9881001        (let* ((optypes (arm-instruction-template-operand-types template))
    9891002               (n (length optypes)))
     
    11171130    (ash (+ (instruction-element-address last)
    11181131            (instruction-element-size last)) -2)))
    1119      
     1132
     1133;;; We want to be able to write vinsn templates using a (mostly) LAP-like
     1134;;; syntax, but ideally don't want to have to repeatedly expand those
     1135;;; vinsn-definition-time-invariant elements of that syntax.
     1136;;;
     1137;;; For example, if DEST is a vinsn parameter and the vinsn body
     1138;;; contains:
     1139;;;
     1140;;;   (ldr DEST (:@ rcontext (:$ arm::tcr.db-link)))
     1141;;;
     1142;;; then we know at definition time:
     1143;;;  1) the opcode of the LDR instruction (obviously)
     1144;;;  2) the fact that the LDR's :mem12 operand uses indexed
     1145;;;     addressing with an immediate operand and no writeback
     1146;;;  3) in this example, we also know the value of the RB field
     1147;;;     and the value of the immediate operand, which happens
     1148;;;     to be positive (setting the U bit).
     1149;;;
     1150;;;  We can apply this knowledge at definition time, and set
     1151;;;  the appropriate bits (U, RN, IMM12) in the opcode.
     1152;;;
     1153;;;  We don't, of course, know the value of DEST at vinsn-definition
     1154;;;  time, but we do know that it's the Nth vinsn parameter, so we
     1155;;;  can turn this example into something like:
     1156;;;
     1157;;;  `(,(augmented-opcode-for-LDR) #(rd-field) #(index-of-DEST)
     1158;;;
     1159;;; This is defined here (rather than in the compiler backend) since
     1160;;; it needs to know a lot about ARM instruction encoding.
     1161
     1162(defstruct (arm-vinsn-instruction (:constructor %make-arm-vinsn-instruction)
     1163                                  (:conc-name avi-))
     1164  head
     1165  tail)
     1166
     1167(defun make-arm-vinsn-instruction (opcode)
     1168  (let* ((head (list opcode)))
     1169    (%make-arm-vinsn-instruction :head head :tail head)))
     1170
     1171(defun add-avi-operand (instruction field-type value)
     1172  (let* ((tail (avi-tail instruction)))
     1173    (setf (avi-tail instruction)
     1174          (cdr (rplacd tail (cons (cons field-type value) nil))))))
     1175
     1176(defun avi-opcode (avi)
     1177  (car (avi-head avi)))
     1178
     1179(defun (setf avi-opcode) (new avi)
     1180  (setf (car (avi-head avi)) new))
     1181
     1182(defun set-avi-opcode-field (avi bytespec value)
     1183  (setf (avi-opcode avi)
     1184        (dpb value bytespec (avi-opcode avi)))
     1185  value)
     1186
     1187
     1188(defparameter *vinsn-field-types*
     1189  #(:cond
     1190    :negated-cond
     1191    :rn
     1192    :rd
     1193    :rm
     1194    :rs
     1195    :alu-constant
     1196    :shift-count                        ;shift type is always explicit
     1197    :mem12-offset
     1198    :mem8-offset
     1199    :reglist-bit
     1200    :uuoA
     1201    :uuo-unary
     1202    :uuoB
     1203    :label
     1204    :subprim
     1205    :application
     1206    :local-label
     1207    ))
     1208
     1209(defmacro encode-vinsn-field-type (name)
     1210  (or (position name *vinsn-field-types*)
     1211      (error "Unknown vinsn-field-type name ~s." name)))
     1212
     1213(defparameter *arm-vinsn-operand-parsers*
     1214    #(vinsn-parse-rd-operand
     1215      vinsn-parse-rn-operand
     1216      vinsn-parse-shifter-operand
     1217      vinsn-parse-m12-operand
     1218      vinsn-parse-reglist-operand
     1219      vinsn-parse-rnw-operand
     1220      vinsn-parse-uuoa-operand
     1221      vinsn-parse-uuo-unary-operand
     1222      vinsn-parse-uuob-operand
     1223      vinsn-parse-rm-operand
     1224      vinsn-parse-b-operand
     1225      vinsn-parse-subprim-operand
     1226      vinsn-parse-m8-operand
     1227      ))
     1228
     1229(defun vinsn-arg-or-gpr (avi form vinsn-params encoded-type bytespec)
     1230  (let* ((p (position form vinsn-params)))
     1231    (cond (p
     1232           (add-avi-operand avi encoded-type p)
     1233           nil)
     1234          (t           
     1235           (set-avi-opcode-field avi bytespec (need-arm-gpr form))))))
     1236
     1237(defun vinsn-arg-or-constant (avi form vinsn-params encoded-type bytespec)
     1238  (let* ((p (position form vinsn-params)))
     1239    (cond (p
     1240           (add-avi-operand avi encoded-type p)
     1241           nil)
     1242          ((and (consp form) (eq (car form) :apply))
     1243           (add-avi-operand avi encoded-type (simplify-application form vinsn-params))
     1244           nil)
     1245          (t
     1246           (let* ((val (eval form)))
     1247             (when bytespec
     1248               (set-avi-opcode-field avi bytespec val))
     1249             val)))))
     1250
     1251
     1252
     1253(defun vinsn-parse-rd-operand (avi value vinsn-params)
     1254  (vinsn-arg-or-gpr avi value vinsn-params (encode-vinsn-field-type :rd) (byte 4 12)))
     1255
     1256(defun vinsn-parse-rn-operand (avi value vinsn-params)
     1257  (vinsn-arg-or-gpr avi value vinsn-params (encode-vinsn-field-type :rn) (byte 4 16)))
     1258
     1259(defun vinsn-parse-shifter-operand (avi value vinsn-params)
     1260  (if (atom value)
     1261    (vinsn-arg-or-gpr avi value vinsn-params (encode-vinsn-field-type :rm) (byte 4 0))
     1262    (ecase (car value)
     1263      (:$
     1264       (destructuring-bind (v) (cdr value)
     1265         (let* ((val (vinsn-arg-or-constant avi v vinsn-params (encode-vinsn-field-type :alu-constant) nil)))
     1266           (when val
     1267             (let* ((constant (encode-arm-immediate val)))
     1268               (if constant
     1269                 (set-avi-opcode-field avi (byte 1 25) 1)
     1270                 (let* ((op (ldb (byte 4 21) (avi-opcode avi)))
     1271                        (newop nil))
     1272                   (if (or (and (setq constant (encode-arm-immediate (lognot val)))
     1273                                (setq newop (svref *equivalent-complemented-opcodes* op)))
     1274                           (and (setq constant (encode-arm-immediate (- val)))
     1275                                (setq newop (svref *equivalent-negated-opcodes* op))))
     1276                     (progn
     1277                       (set-avi-opcode-field avi (byte 1 25) 1)
     1278                       (set-avi-opcode-field avi (byte 4 21) newop)
     1279                       (set-avi-opcode-field avi (byte 12 0) constant))
     1280                     
     1281                     (error "Can't encode ARM constant ~s." value)))))))))
     1282      (:rrx
     1283       (destructuring-bind (rm) (cdr value)
     1284         (vinsn-arg-or-gpr avi rm vinsn-params (encode-vinsn-field-type :rm) (byte 4 0))
     1285         (set-avi-opcode-field avi (byte 2 5) 3)))
     1286      ((:lsl :lsr :asr :ror)
     1287       (destructuring-bind (rm count) (cdr value)
     1288         (set-avi-opcode-field avi (byte 2 5) (encode-arm-shift-type (car value)))
     1289         (vinsn-arg-or-gpr avi rm vinsn-params (encode-vinsn-field-type :rm) (byte 4 0))
     1290         (cond
     1291           ((atom count)
     1292            (set-avi-opcode-field avi (byte 1 4) 1)
     1293            (vinsn-arg-or-gpr avi count vinsn-params (encode-vinsn-field-type :rs) (byte 4 8)))
     1294           (t
     1295            (unless (eq (car count) :$)
     1296              (error "Invalid shift count: ~s" count)
     1297              (destructuring-bind (countval) (cdr count)
     1298                (vinsn-arg-or-constant avi countval vinsn-params (encode-vinsn-field-type :shift-count) (byte 5 7)))))))))))
     1299
     1300(defun vinsn-parse-m12-operand (avi value vinsn-params)
     1301  (destructuring-bind (op rn index) value     ; no (:@ reg) sugar
     1302    (vinsn-arg-or-gpr avi rn vinsn-params (encode-vinsn-field-type :rn) (byte 4 16))
     1303    (let* ((constant-index (and (consp index) (eq (car index) :$))))
     1304      (unless constant-index
     1305        (set-avi-opcode-field avi (byte 1 25) 1))
     1306      (cond
     1307        ((atom index)
     1308         (vinsn-arg-or-gpr avi index vinsn-params (encode-vinsn-field-type :rm) (byte 4 0)))
     1309        (constant-index
     1310         (destructuring-bind (constform) (cdr index)
     1311           (let* ((constval
     1312                   (vinsn-arg-or-constant avi constform vinsn-params (encode-vinsn-field-type :mem12-offset) nil)))
     1313             (when constval
     1314               (if (< constval 0)
     1315                 (setq constval (- constval))
     1316                 (set-avi-opcode-field avi (byte 1 23) 1))
     1317               (unless (typep constval '(unsigned-byte 12))
     1318                 (warn "constant offset too large : ~s" constval))
     1319               (set-avi-opcode-field avi (byte 12 0) constval)))))
     1320        ((eq (car index) :rrx)
     1321         (destructuring-bind (rm) (cdr index)
     1322           (vinsn-arg-or-gpr avi rm vinsn-params (encode-vinsn-field-type :rm) (byte 4 0))
     1323           (set-avi-opcode-field avi (byte 2 5) 3)))
     1324        (t
     1325         (destructuring-bind (shift-op rm shift-count) index
     1326           (vinsn-arg-or-gpr avi rm vinsn-params (encode-vinsn-field-type :rm) (byte 4 0))
     1327           (set-avi-opcode-field avi (byte 2 5) (encode-arm-shift-type shift-op))
     1328
     1329           (unless (and (consp shift-count)
     1330                        (eq (car shift-count) :$))
     1331             (error "Invalid shift-count: ~s" shift-count))
     1332           (destructuring-bind (shift-count-form) (cdr shift-count)
     1333             (vinsn-arg-or-constant avi shift-count-form vinsn-params (encode-vinsn-field-type :shift-count) (byte 5 7))))))
     1334      (setf (avi-opcode avi)
     1335            (set-opcode-value-from-addressing-mode (avi-opcode avi) op constant-index)))))
     1336
     1337(defun vinsn-parse-reglist-operand (avi value vinsn-params)
     1338  (dolist (r value)
     1339    (let* ((p (position r vinsn-params)))
     1340      (if p
     1341        (progn
     1342          (vector-push-extend (encode-vinsn-field-type :reglist-bit)
     1343                              field-types)
     1344          (vector-push-extend p field-values))
     1345        (let* ((bit (need-arm-gpr r)))
     1346          (setq opcode (logior opcode (ash 1 bit))))))))
     1347
     1348(defun vinsn-parse-rnw-operand (avi value vinsn-params)
     1349  (let* ((rn (if (atom value)
     1350               value
     1351               (destructuring-bind (marker reg) value
     1352                 (if (eq marker :!)
     1353                   (set-avi-opcode-field avi (byte 1 21) 1))
     1354                   (error "Unrecognized writeback indicator in ~s." value)
     1355                 reg))))
     1356    (vinsn-arg-or-gpr avi rn vinsn-params  (encode-vinsn-field-type :rn) (byte 4 16))))
     1357
     1358(defun vinsn-parse-uuoA-operand (avi value vinsn-params)
     1359  (vinsn-arg-or-gpr avi value vinsn-params (encode-vinsn-field-type :uuoA) (byte 4 8)))
     1360
     1361(defun vinsn-parse-uuo-unary-operand (avi value vinsn-params)
     1362  (when (or (atom value)
     1363          (not (eq (car value) :$)))
     1364    (error "Invalid constant syntax in ~s." value))
     1365  (destructuring-bind (valform) (cdr value)
     1366    (vinsn-arg-or-constant avi valform vinsn-params (encode-vinsn-field-type :uuo-unary) (byte 8 12))))
     1367
     1368(defun vinsn-parse-uuoB-operand (avi value vinsn-params)
     1369  (vinsn-arg-or-gpr avi value vinsn-params (encode-vinsn-field-type :uuoB) (byte 4 12)))
     1370
     1371(defun vinsn-parse-rm-operand (avi value vinsn-params)
     1372  (vinsn-arg-or-gpr avi value vinsn-params (encode-vinsn-field-type :rm) (byte 4 0)))
     1373
     1374(defun vinsn-parse-b-operand (avi value vinsn-params)
     1375  ;; Pretty much has to be a param or a local label what else would we b to ?
     1376  (let* ((p (position value vinsn-params)))
     1377    (cond (p
     1378           (add-avi-operand avi (encode-vinsn-field-type :label) p))
     1379          ((typep value 'keyword)
     1380           (add-avi-operand avi (encode-vinsn-field-type :local-label) value))
     1381          (t
     1382           (error "Unknown branch target: ~s." value)))))
     1383
     1384;;; This can only appear in a BA (mov PC,(:$ addr)) instruction, which
     1385;;; already has bit 25 set.
     1386(defun vinsn-parse-subprim-operand (avi value vinsn-params)
     1387  (let* ((p (position value vinsn-params)))
     1388    (if p
     1389      (add-avi-operand avi (encode-vinsn-field-type :subprim) p)
     1390      (let* ((addr (or (arm-subprimitive-address value)
     1391                   (and (typep value 'integer)
     1392                        (>= value #x4000)
     1393                        (< value #x10000)
     1394                        (not (logtest #x7f value))))))
     1395        (unless addr
     1396          (error "Unknown ARM subprimitive address: ~s." addr))
     1397        (set-avi-opcode-field avi (byte 12 0) (encode-arm-immediate addr))))))
     1398
     1399(defun vinsn-parse-m8-operand (avi value vinsn-params)
     1400  (if (atom value)
     1401    (error "Invalid memory operand ~s." value)
     1402    (destructuring-bind (mode rn index) value
     1403      (vinsn-arg-or-gpr avi rn vinsn-params (encode-vinsn-field-type :rn) (byte 4 16))
     1404      (let* ((constant-index (and (consp index) (eq (car index) :$))))
     1405        (unless constant-index
     1406          (set-avi-opcode-field avi (byte 25 1) 1))
     1407        (cond ((atom index)
     1408               (vinsn-arg-or-gpr avi index vinsn-params (encode-vinsn-field-type :rm) (byte 4 0)))
     1409              (constant-index
     1410               (destructuring-bind (constform) (cdr index)
     1411                 (let* ((constval
     1412                         (vinsn-arg-or-constant avi constform vinsn-params (encode-vinsn-field-type :mem8-offset) nil)))
     1413                   (when constval
     1414                     (if (< constval 0)
     1415                       (setq constval (- constval))
     1416                       (set-avi-opcode-field avi (byte 1 23) 1))
     1417                     (unless (typep constval '(unsigned-byte 8))
     1418                       (warn "constant offset too large : ~s" constval))
     1419                     (set-avi-opcode-field avi (byte 4 0) (ldb (byte 4 0) constval))
     1420                     (set-avi-opcode-field avi (byte 4 8) (ldb (byte 4 4) constval))))))
     1421              ((eq (car index) :rrx)
     1422               (destructuring-bind (rm) (cdr index)
     1423                 (vinsn-arg-or-gpr avi rm vinsn-params (encode-vinsn-field-type :rm) (byte 4 0))
     1424                 (set-avi-opcode-field avi (byte 2 5) 3)))
     1425              (t
     1426               (destructuring-bind (shift-op rm shift-count) index
     1427                 (vinsn-arg-or-gpr avi rm vinsn-params (encode-vinsn-field-type :rm) (byte 4 0))
     1428                 (set-avi-opcode-field avi (byte 2 5) (encode-arm-shift-type shift-op))
     1429                 (unless (and (consp shift-count)
     1430                              (eq (car shift-count) :$))
     1431                   (error "Invalid shift-count: ~s" shift-count))
     1432                 (destructuring-bind (shift-count-form) (cdr shift-count)
     1433                   (vinsn-arg-or-constant avi shift-count-form vinsn-params (encode-vinsn-field-type :shift-count) (byte 5 7))))))
     1434        (setf (avi-opcode avi)
     1435              (set-opcode-value-from-addressing-mode (avi-opcode avi) mode constant-index))))))
     1436
     1437             
     1438
     1439
     1440                                     
     1441(defun vinsn-simplify-instruction (form vinsn-params)
     1442  (destructuring-bind (name . opvals) form
     1443    (multiple-value-bind (template cond explicit-cond) (lookup-arm-instruction name)
     1444      (unless template
     1445        (error "Unknown ARM instruction - ~s" form))
     1446      (let* ((cond-indicator (and (consp (car opvals))
     1447                                  (keywordize (caar opvals))))
     1448             (avi (make-arm-vinsn-instruction (arm-instruction-template-val template))))
     1449        (when (or (eq cond-indicator :?)
     1450                  (eq cond-indicator :~))
     1451          (let* ((condform (pop opvals)))
     1452            (destructuring-bind (cond-name) (cdr condform)
     1453              (let* ((p (position cond-name vinsn-params)))
     1454                (if p
     1455                  (if explicit-cond
     1456                    (error "Can't use ~s with explicit condition name." condform)
     1457                    (progn
     1458                      (add-avi-operand avi (if (eq cond-indicator :?)
     1459                                             (encode-vinsn-field-type :cond)
     1460                                             (encode-vinsn-field-type :negated-cond))
     1461                                       p)
     1462                      (setq cond nil)))
     1463                  (let* ((c (need-arm-condition-name cond-name)))
     1464                    (when (eq cond-indicator :~)
     1465                      (if (< c 14)
     1466                        (setq c (logxor c 1))
     1467                        (error "Invalid explicit condition ~s." condform)))
     1468                    (if (and explicit-cond (not (eql c cond)))
     1469                      (error "Can't use explicit condition and :? : ~s" condform)
     1470                      (setq cond c))))))))
     1471        (let* ((optypes (arm-instruction-template-operand-types template))
     1472               (n (length optypes)))
     1473          (unless (= n (length opvals))
     1474            (error "ARM ~a instructions require ~d operands, but ~d were provided in ~s." (arm-instruction-template-name template) n (length opvals) form))
     1475          (dotimes (i n)
     1476            (let* ((optype (pop optypes))
     1477                   (opval (pop opvals)))
     1478              (funcall (svref *arm-vinsn-operand-parsers* optype)
     1479                       avi opval vinsn-params)))
     1480          (when cond
     1481            (set-avi-opcode-field avi (byte 4 28) cond))
     1482          (avi-head avi))))))
     1483         
     1484
    11201485
    11211486(provide "ARM-ASM")
  • branches/arm/compiler/ARM/arm-backend.lisp

    r13705 r13715  
    3131;;; This defines a template.  All expressions in the body must be
    3232;;; evaluable at macroexpansion time.
    33 #+notyet
    34 (defun define-arm-vinsn (backend vinsn-name results args temps body)
     33(defun %define-arm-vinsn (backend vinsn-name results args temps body)
    3534  (let* ((opcode-vector (backend-lap-opcodes backend))
    3635         (opcode-lookup (backend-lookup-opcode backend))
     
    9998        (dolist (name non-hybrid-results)
    10099          (add-spec-name name)))
     100      (break)
     101      #+notyet
    101102      (let* ((k -1))
    102103        (declare (fixnum k))
     
    236237                :lookup-macro #'false
    237238                :lap-opcodes arm::*arm-instruction-table*
    238                 :define-vinsn 'define-arm-vinsn
     239                :define-vinsn '%define-arm-vinsn
    239240                :platform-syscall-mask (logior platform-os-linux platform-cpu-arm)
    240241                :p2-dispatch *arm2-specials*
  • branches/arm/compiler/ARM/arm-lap.lisp

    r13707 r13715  
    6464    (with-dll-node-freelist (constant-pool arm::*lap-instruction-freelist*)
    6565      (let* ((arm::*lap-labels* ())
     66             (name-cell (list name))
    6667             (arm::*arm-constants* ())
    6768             (*arm-lap-lfun-bits* bits)
     
    7374        (dolist (form body)
    7475          (setq current (arm-lap-form form current sections)))
    75         (arm-lap-generate-code name
    76                                primary
     76        (rplacd name-cell (length arm::*arm-constants*))
     77        (push name-cell arm::*arm-constants*)
     78        (arm-lap-generate-code primary
    7779                               (arm::arm-finalize primary  constant-pool)
    7880                               *arm-lap-lfun-bits*)))))
     
    8486
    8587
    86 (defun arm-lap-generate-code (name seg code-vector-size bits)
     88(defun arm-lap-generate-code (seg code-vector-size bits)
    8789  (declare (fixnum code-vector-size))
    8890  (let* ((target-backend *target-backend*)
     
    9092                           (:arm (not (eq *host-backend* target-backend)))
    9193                           (t t)))
    92          (constants-size (+ 4 (length arm::*arm-constants*)))
     94         (constants-size (+ 3 (length arm::*arm-constants*)))
    9395         (constants-vector (%alloc-misc
    9496                            constants-size
     
    113115          (setf (uvref constants-vector (+ 2 k)) imm)))
    114116      (setf (uvref constants-vector (1- constants-size)) bits ; lfun-bits
    115             (uvref constants-vector (- constants-size 2)) name
    116117            (uvref constants-vector 1) code-vector)
    117118      #+arm-target (%make-code-executable code-vector)
Note: See TracChangeset for help on using the changeset viewer.