Changeset 13715
- Timestamp:
- May 22, 2010, 12:17:19 AM (15 years ago)
- Location:
- branches/arm/compiler/ARM
- Files:
-
- 4 edited
-
arm-arch.lisp (modified) (2 diffs)
-
arm-asm.lisp (modified) (6 diffs)
-
arm-backend.lisp (modified) (3 diffs)
-
arm-lap.lisp (modified) (5 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/arm/compiler/ARM/arm-arch.lisp
r13707 r13715 658 658 ) 659 659 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. 663 662 (define-fixedsized-object catch-frame 664 catch-tag ; #<unbound> -> unwind-protect, else catch665 663 link ; tagged pointer to next older catch frame 666 664 mvflag ; 0 if single-value, 1 if uwp or multiple-value 665 catch-tag ; #<unbound> -> unwind-protect, else catch 667 666 db-link ; value of dynamic-binding link on thread entry. 668 667 xframe ; exception-frame link … … 1290 1289 (defconstant xtype-s8 32) 1291 1290 (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 1294 1317 1295 1318 (provide "ARM-ARCH") -
branches/arm/compiler/ARM/arm-asm.lisp
r13707 r13715 604 604 (< nbits 32))) 605 605 (let* ((r (- 32 nbits)) 606 (mask (1- (ash 1 r))))606 (mask (1- (ash 1 nbits)))) 607 607 (logand #xffffffff 608 608 (logior (ash u32 nbits) … … 790 790 (error "Can't encode ARM constant ~s." value))))))) 791 791 792 (defun set- addressing-mode (instructionmode constant-index)792 (defun set-opcode-value-from-addressing-mode (opcode mode constant-index) 793 793 ;; Look at mode and set P/W/U bits. If CONSTANT-INDEX is 794 794 ;; true, the U bit depends on the sign of the constant. … … 797 797 ;; Preindexed, no writeback unless :+@! , add register operands. 798 798 (unless constant-index 799 (set -field-value instruction (byte 1 23) 1))799 (setq opcode (logior opcode (ash 1 23)))) 800 800 (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)))) 803 803 ((:-@ :-@!) 804 804 ;; Preindexed. Leave the U bit clear, maybe set W if writeback. 805 805 (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)))) 808 808 ((:@+ :@-) 809 809 ;; Postindex; writeback is implicit (and setting P and W would 810 810 ;; change the instruction.) 811 811 (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))) 813 820 814 821 ;;; "general" address operand, as used in LDR/LDRB/STR/STRB … … 886 893 (set-field-value instruction (byte 1 21) 1) 887 894 (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)))) 889 896 890 897 (defun parse-uuoA-operand (form instruction) … … 977 984 (unless template 978 985 (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))))))) 988 1001 (let* ((optypes (arm-instruction-template-operand-types template)) 989 1002 (n (length optypes))) … … 1117 1130 (ash (+ (instruction-element-address last) 1118 1131 (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 1120 1485 1121 1486 (provide "ARM-ASM") -
branches/arm/compiler/ARM/arm-backend.lisp
r13705 r13715 31 31 ;;; This defines a template. All expressions in the body must be 32 32 ;;; 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) 35 34 (let* ((opcode-vector (backend-lap-opcodes backend)) 36 35 (opcode-lookup (backend-lookup-opcode backend)) … … 99 98 (dolist (name non-hybrid-results) 100 99 (add-spec-name name))) 100 (break) 101 #+notyet 101 102 (let* ((k -1)) 102 103 (declare (fixnum k)) … … 236 237 :lookup-macro #'false 237 238 :lap-opcodes arm::*arm-instruction-table* 238 :define-vinsn ' define-arm-vinsn239 :define-vinsn '%define-arm-vinsn 239 240 :platform-syscall-mask (logior platform-os-linux platform-cpu-arm) 240 241 :p2-dispatch *arm2-specials* -
branches/arm/compiler/ARM/arm-lap.lisp
r13707 r13715 64 64 (with-dll-node-freelist (constant-pool arm::*lap-instruction-freelist*) 65 65 (let* ((arm::*lap-labels* ()) 66 (name-cell (list name)) 66 67 (arm::*arm-constants* ()) 67 68 (*arm-lap-lfun-bits* bits) … … 73 74 (dolist (form body) 74 75 (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 77 79 (arm::arm-finalize primary constant-pool) 78 80 *arm-lap-lfun-bits*))))) … … 84 86 85 87 86 (defun arm-lap-generate-code ( nameseg code-vector-size bits)88 (defun arm-lap-generate-code (seg code-vector-size bits) 87 89 (declare (fixnum code-vector-size)) 88 90 (let* ((target-backend *target-backend*) … … 90 92 (:arm (not (eq *host-backend* target-backend))) 91 93 (t t))) 92 (constants-size (+ 4(length arm::*arm-constants*)))94 (constants-size (+ 3 (length arm::*arm-constants*))) 93 95 (constants-vector (%alloc-misc 94 96 constants-size … … 113 115 (setf (uvref constants-vector (+ 2 k)) imm))) 114 116 (setf (uvref constants-vector (1- constants-size)) bits ; lfun-bits 115 (uvref constants-vector (- constants-size 2)) name116 117 (uvref constants-vector 1) code-vector) 117 118 #+arm-target (%make-code-executable code-vector)
Note:
See TracChangeset
for help on using the changeset viewer.
