moved lisp files to src dir. As with armish, should have done this with darcs, but to bad. Adjusted some directory searching code to be more flexible (uses asdf) and to let it work with the dir change
Mon Oct 15 02:18:05 PDT 2007 Ties Stuij <ties@stuij.se>
* moved lisp files to src dir. As with armish, should have done this with darcs, but to bad. Adjusted some directory searching code to be more flexible (uses asdf) and to let it work with the dir change
diff -rN -u old-liards/crc.lisp new-liards/crc.lisp
--- old-liards/crc.lisp 2014-08-01 15:31:58.000000000 -0700
+++ new-liards/crc.lisp 1969-12-31 16:00:00.000000000 -0800
@@ -1,45 +0,0 @@
-(in-package :liards)
-
-(defvar *crc16-table*
- (make-array 256 :initial-contents
- '(#x0000 #xC0C1 #xC181 #x0140 #xC301 #x03C0 #x0280 #xC241
- #xC601 #x06C0 #x0780 #xC741 #x0500 #xC5C1 #xC481 #x0440
- #xCC01 #x0CC0 #x0D80 #xCD41 #x0F00 #xCFC1 #xCE81 #x0E40
- #x0A00 #xCAC1 #xCB81 #x0B40 #xC901 #x09C0 #x0880 #xC841
- #xD801 #x18C0 #x1980 #xD941 #x1B00 #xDBC1 #xDA81 #x1A40
- #x1E00 #xDEC1 #xDF81 #x1F40 #xDD01 #x1DC0 #x1C80 #xDC41
- #x1400 #xD4C1 #xD581 #x1540 #xD701 #x17C0 #x1680 #xD641
- #xD201 #x12C0 #x1380 #xD341 #x1100 #xD1C1 #xD081 #x1040
- #xF001 #x30C0 #x3180 #xF141 #x3300 #xF3C1 #xF281 #x3240
- #x3600 #xF6C1 #xF781 #x3740 #xF501 #x35C0 #x3480 #xF441
- #x3C00 #xFCC1 #xFD81 #x3D40 #xFF01 #x3FC0 #x3E80 #xFE41
- #xFA01 #x3AC0 #x3B80 #xFB41 #x3900 #xF9C1 #xF881 #x3840
- #x2800 #xE8C1 #xE981 #x2940 #xEB01 #x2BC0 #x2A80 #xEA41
- #xEE01 #x2EC0 #x2F80 #xEF41 #x2D00 #xEDC1 #xEC81 #x2C40
- #xE401 #x24C0 #x2580 #xE541 #x2700 #xE7C1 #xE681 #x2640
- #x2200 #xE2C1 #xE381 #x2340 #xE101 #x21C0 #x2080 #xE041
- #xA001 #x60C0 #x6180 #xA141 #x6300 #xA3C1 #xA281 #x6240
- #x6600 #xA6C1 #xA781 #x6740 #xA501 #x65C0 #x6480 #xA441
- #x6C00 #xACC1 #xAD81 #x6D40 #xAF01 #x6FC0 #x6E80 #xAE41
- #xAA01 #x6AC0 #x6B80 #xAB41 #x6900 #xA9C1 #xA881 #x6840
- #x7800 #xB8C1 #xB981 #x7940 #xBB01 #x7BC0 #x7A80 #xBA41
- #xBE01 #x7EC0 #x7F80 #xBF41 #x7D00 #xBDC1 #xBC81 #x7C40
- #xB401 #x74C0 #x7580 #xB541 #x7700 #xB7C1 #xB681 #x7640
- #x7200 #xB2C1 #xB381 #x7340 #xB101 #x71C0 #x7080 #xB041
- #x5000 #x90C1 #x9181 #x5140 #x9301 #x53C0 #x5280 #x9241
- #x9601 #x56C0 #x5780 #x9741 #x5500 #x95C1 #x9481 #x5440
- #x9C01 #x5CC0 #x5D80 #x9D41 #x5F00 #x9FC1 #x9E81 #x5E40
- #x5A00 #x9AC1 #x9B81 #x5B40 #x9901 #x59C0 #x5880 #x9841
- #x8801 #x48C0 #x4980 #x8941 #x4B00 #x8BC1 #x8A81 #x4A40
- #x4E00 #x8EC1 #x8F81 #x4F40 #x8D01 #x4DC0 #x4C80 #x8C41
- #x4400 #x84C1 #x8581 #x4540 #x8701 #x47C0 #x4680 #x8641
- #x8201 #x42C0 #x4380 #x8341 #x4100 #x81C1 #x8081 #x4040)))
-
-(defun crc16 (data)
- (let ((crc #xFFFF))
- (dotimes (byte-nr (length data) (make-array 2 :initial-contents `(,(logand crc #xff) ,(ash crc -8))))
- (setf crc (logxor (logand (ash crc -8) #xFFFF)
- (aref *crc16-table*
- (logand (logxor crc
- (nth byte-nr data))
- #xFF)))))))
\ No newline at end of file
diff -rN -u old-liards/file-stitch.lisp new-liards/file-stitch.lisp
--- old-liards/file-stitch.lisp 2014-08-01 15:31:58.000000000 -0700
+++ new-liards/file-stitch.lisp 1969-12-31 16:00:00.000000000 -0800
@@ -1,61 +0,0 @@
-(in-package :liards)
-
-(defvar *rom-dir* (append (pathname-directory *load-truename*)
- (list "roms")))
-
-(defun rom-location (&optional (rom-name "my.nds") (rom-dir *rom-dir*))
- (concatenate 'string (namestring (make-pathname :directory rom-dir)) rom-name))
-
-(defun write-rom (rom &key (file "my.nds") (dir *rom-dir*))
- (with-open-file (s (rom-location file dir) :direction :output :element-type '(unsigned-byte 8) :if-exists :supersede)
- (write-sequence rom s)))
-
-(defun nds-compile (arm9-code arm7-code &optional (file "my.nds") (dir *rom-dir*))
- (let* ((header-class (make-instance 'nds-header))
- (header (make-list #x200 :initial-element 0))
- (arm9-code-size (length arm9-code))
- (arm9-aligned (align arm9-code))
- (arm7-code-size (length arm7-code))
- (arm7-rom-offset (+ (length arm9-aligned) (length header)))
- (filename-table-offset (+ arm7-rom-offset arm7-code-size))
- (filename-table-aligned (align (make-list 9 :initial-element 0)))
- (fat-offset (+ filename-table-offset (length filename-table-aligned)))
- (application-end-offset fat-offset)
- (logo-crc16 (crc16 *logo*)))
- ;; make a correct header
- (macrolet ((write-and-seal-headers (header-list)
- (let ((res-list '(progn)))
- (dolist (header-name header-list)
- (setf res-list
- (append res-list
- `((write-header-item-and-seal (,header-name header-class)
- (nr-to-big-endian-word-byte-list ,header-name))))))
- res-list)))
- (write-and-seal-headers (arm9-code-size
- arm7-code-size
- arm7-rom-offset
- filename-table-offset
- fat-offset
- application-end-offset)))
- (write-header-item-and-seal (logo-crc16 header-class) logo-crc16)
- (write-header-to-list header-class header)
- (write-header-item-and-seal (header-crc16 header-class) (crc16 (subseq header 0 #x15E)))
- (write-header-item-to-list (header-crc16 header-class) header)
- ;; append the lot
- (write-rom (append header arm9-aligned arm7-code filename-table-aligned) :file file :dir dir)))
-
-#|
-these should be calculated dynamically:
-device-cap - not yet implemented
-arm-9-code-size
-arm7-rom-offset
-arm7-code-size
-filename-table-offset
-fat-offset
-application-end-offset
-logo-crc16
-header-crc16
-
-It would be nice if a few more, like romsize and fat-size, are also calculated on the fly,
-for elegance sake, but hey.
-|#
diff -rN -u old-liards/hardware-layout.lisp new-liards/hardware-layout.lisp
--- old-liards/hardware-layout.lisp 2014-08-01 15:31:58.000000000 -0700
+++ new-liards/hardware-layout.lisp 1969-12-31 16:00:00.000000000 -0800
@@ -1,58 +0,0 @@
-(in-package :liards)
-
-(defmacro def-mem-layout (list)
- (let ((const-list '(progn)))
- (dolist (const-pair list const-list)
- (if (typep const-pair 'list)
- (setf const-list (append const-list `((defconstant ,(car const-pair) ,(cadr const-pair)))))))))
-
-;; expects name, start address, end adress and bus-width
-;; just now just using name and start address
-(def-mem-layout
- ("mem-blocks"
-
- "- shared"
- "-- all-purpose"
- (main-ram #x02000000 #x023FFFFF 16)
- (protection #x04000308 #x0400030C :?) ;; got no clue what this does (write-once sadly) \f libnds
- (shared-wram-bank-0 #x03000000 #x03003FFF 32) ;; check it, ambigious info. this one from dovotos tutorial
- (shared-wram-bank-1 #x03004000 #x03007FFF 32) ;; idem
- (gba-rom #x08000000 #x09FFFFFF 16)
- (gba-sram #x0A000000 #x0A00FFFF 8)
-
- "-- video"
- "--- banks"
- (bank-a #x06800000 #x0681FFFF 16)
- (bank-b #x06820000 #x0683FFFF 16)
- (bank-c #x06840000 #x0685FFFF 16)
- (bank-d #x06860000 #x0687FFFF 16)
- (bank-e #x06880000 #x0688FFFF 16)
- (bank-f #x06890000 #x06983FFF 16)
- (bank-g #x06894000 #x06897FFF 16)
- (bank-h #x06898000 #x0689FFFF 16)
- (bank-i #x068A0000 #x068A3FFF 16)
-
- "--- virtual"
- (main-background #x06000000 #x0607FFFF 16)
- (sub-background #x06200000 #x0621FFFF 16)
- (main-sprite #x06400000 #x0643FFFF 16)
- (sub-sprite #x06600000 #x0661FFFF 16)
-
- "- arm7 reachable"
- (arm7-bios #x00000000 #x00003FFF :?)
- (arm7-iwram #x03800000 #x0380FFFF 32)
- (wifi-mac-mem #x04804000 #x04805FFF 16)
-
-
- "- arm9 reachable"
- (bios #xFFFF0000 #xFFFF7FFF :?)
-
- "-- fast"
- (itcm #x00000000 #x00007FFF 32)
- (dtcm #x0B000000 #x0B003FFF 32)
-
- "-- graphics"
- (palette-ram #x05000000 #x050003FF 16)
- (sub-palette-ram #x05000400 #x050007FF 16)
- (oam-main #x07000000 #x070003FF 32)
- (oam-sub #x07000400 #x070007FF 32)))
\ No newline at end of file
diff -rN -u old-liards/header-helpers.lisp new-liards/header-helpers.lisp
--- old-liards/header-helpers.lisp 2014-08-01 15:31:58.000000000 -0700
+++ new-liards/header-helpers.lisp 1969-12-31 16:00:00.000000000 -0800
@@ -1,49 +0,0 @@
-(in-package :liards)
-
-(defclass header-item-base ()
- ((no-bytes :accessor no-bytes :initarg :no-bytes)
- (header-pos :accessor header-pos :initarg :header-pos)
- (value :accessor value :initarg :value :type (array (unsigned-byte 8)))
- (setp :accessor setp :initarg :setp :initform nil)))
-
-(defun make-header-slot-class (slot)
- `(defclass ,(first slot) (header-item-base) ()))
-
-(defun header-item-slot (header-slot)
- (let ((slot-name (first header-slot))
- (header-pos (second header-slot))
- (no-bytes (third header-slot))
- (value (fourth header-slot)))
- `(,slot-name :accessor ,slot-name
- :initform (make-instance ',slot-name
- :no-bytes ,no-bytes
- :header-pos ,header-pos
- :value (value-handler ,no-bytes ,value)
- ,@(if value '(:setp t))))))
-
-
-(defun value-handler (no-bytes value)
- (let ((value-arr (make-list no-bytes :initial-element 0)))
- (if (and value (not (eql value :nil)))
- (write-header-item value-arr value)
- value-arr)))
-
-
-(defun write-header-item (dest-lst source-lst)
- (let ((src-lst-ln (length source-lst))
- (dst-lst-ln (length dest-lst)))
- (if (not (= src-lst-ln dst-lst-ln))
- (error "size of destination list (~D) doesnt match that of the source list (~D) ... scoundrel ..." dst-lst-ln src-lst-ln)
- (replace dest-lst source-lst))))
-
-(defun write-header-item-and-seal (header-item source-lst)
- (write-header-item (value header-item) source-lst)
- (setf (setp header-item) t))
-
-(defun write-header-item-to-list (header-item list)
- (let ((pos (header-pos header-item)))
- (setf (subseq list pos (+ pos (no-bytes header-item))) (value header-item))))
-
-(defun write-header-to-list (header-class list)
- (dolist (item (instance-slot-names header-class))
- (write-header-item-to-list (slot-value header-class item) list)))
diff -rN -u old-liards/header.lisp new-liards/header.lisp
--- old-liards/header.lisp 2014-08-01 15:31:58.000000000 -0700
+++ new-liards/header.lisp 1969-12-31 16:00:00.000000000 -0800
@@ -1,92 +0,0 @@
-(in-package :liards)
-
-(defvar *logo*
- '(200 96 79 226 1 112 143 226 23 255 47 225 18 79 17 72 18 76 32 96 100 96 124
- 98 48 28 57 28 16 74 0 240 20 248 48 106 128 25 177 106 242 106 0 240 11 248
- 48 107 128 25 177 107 242 107 0 240 8 248 112 106 119 107 7 76 96 96 56 71 7
- 75 210 24 154 67 7 75 146 8 210 24 12 223 247 70 4 240 31 229 0 254 127 2 240
- 255 127 2 240 1 0 0 255 1 0 0 0 0 0 4 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
- 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
- "seems to be startup code for one or the other `thing'. Damn you homebrew, and your hackerish ways")
-
-(defmacro def-nds-header (slot-list)
- "Expects the layout of the nds header, so not much wiggle room here. it expects three or four values per header section.
- from left to right: the name of the section, the position of the section, the amount of bytes it wants to write and as a fourth an optional
- standard value as a vector, fill in :nil to default to zero bits and flag that it doesn't need to be touched anymore.
- Def-nds-header builds a class with the names as slots. In those slots it builds appropriate classes with
- the same name who's value slot (an array) shares it's structure with it's rightfull place on the *header* array, so we won't have to write
- that stuff in explicitely all the time. The sections that actually have to do some specialized stuff, mostly determine the position for this
- and that in the actual nds file, do so when they are called with header-item-handler. def-nds-header and header-item-handler should
- together cover the creation of a correct header (== *header*). After which two crc checks will really finish it off with icecream on top."
- `(progn
- ,@(mapcar #'make-header-slot-class slot-list)
- (defclass nds-header ()
- ,(mapcar #'header-item-slot slot-list))))
-
-(def-nds-header
- ((game-title #x000 12 '(#x2E 00 00 #xEA 00 00 00 00 00 00 00 00))
- ;; yes well... this should be the the game title but according to the ndstool
- ;; c++ file this info is needed for "PassMe's that start @ 0x08000000"
- (game-code #x00c 4 '(35 35 35 35)) ;; f\ndstool "####"
- (maker-code #x010 2 :nil)
- (unit-code #x012 1 :nil)
- (device-type #x013 1 :nil)
- (device-cap #x014 1)
- (reserved-1 #x015 8 :nil) ;; was cardinfo
- (rom-version #x01e 1 :nil)
- (flags #x01f 1 '(#x04)) ;; flags c\autostart f\ndstool
- (arm9-rom-offset #x020 4 '(0 2 0 0))
- (arm9-entry-addr #x024 4 '(0 0 0 2))
- (arm9-ram-addr #x028 4 '(0 0 0 2))
- (arm9-code-size #x02c 4)
- (arm7-rom-offset #x030 4)
- (arm7-entry-addr #x034 4 '(0 0 128 3))
- (arm7-ram-addr #x038 4 '(0 0 128 3))
- (arm7-code-size #x03c 4)
- (filename-table-offset #x040 4)
- (filename-table-size #x044 4 '(9 0 0 0)) ;; ? idem
- (fat-offset #x048 4)
- (fat-size #x04c 4 :nil)
- (arm9-overlay-offset #x050 4 :nil)
- (arm9-overlay-size #x054 4 :nil)
- (arm7-overlay-offset #x058 4 :nil)
- (arm7-overlay-size #x05c 4 :nil)
- (rom-ctrl-info-1 #x060 4 '(#x00 #x60 #x58 #x00)) ;; ctrl-reg-flags-read f\ndstool used in modes 1/3 \f libnds
- (rom-ctrl-info-2 #x064 4 '(#xF8 #x08 #x18 #x00)) ;; ctrl-reg-flags-init f\ndstool used in mode 2 \f libnds
- (banner-offset #x068 4 :nil) ;; icon/title-offs
- (secure-area-crc16 #x06c 2 :nil)
- (rom-ctrl-info-3 #x06e 2 '(30 5)) ;; rom-timeout. most have it on 30 5, but why?
- (arm-9-? #x070 4 :nil)
- (arm-7-? #x074 4 :nil)
- (magic #x078 8 :nil)
- (application-end-offset #x080 4) ;; rom-size
- (rom-header-size #x084 4 '(0 2 0 0))
- (unknown-5 #x088 24 :nil) ;; was 56, is still kinda... in total... bit useless this entry; just for bw-compatibility
- (sram-backup #x0a0 9 (string-to-octets "SRAM_V110" :utf-8))
- (auto-flashme-start #x0ac 7 (concatenate 'vector (string-to-octets "PASS01" :utf-8) '(#x96)))
- ;; f\ndstool "automatically start with FlashMe, make it look more like a GBA rom"
- (logo #x0c0 156 *logo*)
- (logo-crc16 #x15c 2)
- (header-crc16 #x15e 2)
- (reserved #x160 160 :nil)))
-
-
-;; phased out:
-#-(and) (defgeneric header-item-handler (header-item-base)
- (:documentation "handles non-constant header items")
- ;; game-title - just make sure there's a name in *game-title* if you want to change the default
- ;; commented out right now because appearantly the info that the name info is stepping on is needed for passme devices
- #-(and)(:method ((title game-title))
- (let ((array (make-array (no-bytes title))))
- ;; there's a bit to much array replacing going on between this function and write-header-item,
- ;; but somehow i think it's more elegant
- (if (write-header-item (value title) (replace array (string-to-octets *game-title* :utf-8)))
- (setf (setp title) t)
- (error "stuff went wrong writing game title")))))
-#-(and) (defun process-leftover-headers (h)
- "makes sure the non-constant header items are processed correctly so we have a fully filled out and correct nds header...
- except for the crcs"
- (dolist (item (instance-slot-names h))
- (let ((item-class (slot-value h item)))
- (if (not (or (setp item-class) (eq item 'logo-crc16 ) (eq item 'header-crc16)))
- (header-item-handler item-class)))))
diff -rN -u old-liards/helpers.lisp new-liards/helpers.lisp
--- old-liards/helpers.lisp 2014-08-01 15:31:58.000000000 -0700
+++ new-liards/helpers.lisp 1969-12-31 16:00:00.000000000 -0800
@@ -1,12 +0,0 @@
-(in-package :liards)
-
-;; got from symbolics code somewhere (hope they don't sue)
-(defmethod instance-slot-names ((instance standard-object))
- "Given an INSTANCE, returns a list of the slots in the instance's class."
- (mapcar #'mopp:slot-definition-name
- (mopp:class-direct-slots (class-of instance))))
-
-(defun class-slot-names (class-name)
- "Given a CLASS-NAME, returns a list of the slots in the class."
- (mapcar #'mopp:slot-definition-name
- (mopp:class-direct-slots (find-class class-name))))
diff -rN -u old-liards/liards.asd new-liards/liards.asd
--- old-liards/liards.asd 2014-08-01 15:31:58.000000000 -0700
+++ new-liards/liards.asd 2014-08-01 15:31:58.000000000 -0700
@@ -4,15 +4,20 @@
(in-package :liards.system)
(defsystem liards
- :version "0.0.1"
- :author "Ties Stuij"
- :depends-on (:arnesi :split-sequence :armish)
- :components ((:file "packages")
- (:file "helpers" :depends-on ("packages"))
- (:file "registers" :depends-on ("helpers"))
- (:file "hardware-layout" :depends-on ("helpers"))
- (:file "crc" :depends-on ("helpers"))
- (:file "header-helpers" :depends-on ("helpers"))
- (:file "header" :depends-on ("header-helpers"))
- (:file "file-stitch" :depends-on ("registers" "hardware-layout" "crc" "header"))
- (:file "test" :depends-on ("file-stitch"))))
\ No newline at end of file
+ :author "Ties Stuij <ties@stuij.se"
+ :depends-on (:arnesi :umpa-lumpa :split-sequence :armish)
+ :components
+ ((:module :src
+ :components
+ ((:file "packages")
+ (:file "helpers" :depends-on ("packages"))
+ (:file "registers" :depends-on ("helpers"))
+ (:file "hardware-layout" :depends-on ("helpers"))
+ (:file "crc" :depends-on ("helpers"))
+ (:file "header-helpers" :depends-on ("helpers"))
+ (:file "header" :depends-on ("header-helpers"))
+ (:file "file-stitch" :depends-on ("registers"
+ "hardware-layout"
+ "crc"
+ "header"))
+ (:file "test" :depends-on ("file-stitch"))))))
\ No newline at end of file
diff -rN -u old-liards/packages.lisp new-liards/packages.lisp
--- old-liards/packages.lisp 2014-08-01 15:31:58.000000000 -0700
+++ new-liards/packages.lisp 1969-12-31 16:00:00.000000000 -0800
@@ -1,9 +0,0 @@
-(in-package :cl-user)
-
-(defpackage :liards
- (:use :common-lisp
- :armish
- :it.bese.arnesi
- :split-sequence)
- (:shadowing-import-from :it.bese.arnesi :partition)
- (:export :nds-compile))
\ No newline at end of file
diff -rN -u old-liards/registers.lisp new-liards/registers.lisp
--- old-liards/registers.lisp 2014-08-01 15:31:58.000000000 -0700
+++ new-liards/registers.lisp 1969-12-31 16:00:00.000000000 -0800
@@ -1,175 +0,0 @@
-(in-package :liards)
-
-(defmacro def-registers (list)
- (let ((const-list '(progn)))
- (dolist (const-pair list const-list)
- (if (typep const-pair 'list)
- (setf const-list (append const-list `((defconstant ,(car const-pair) ,(cadr const-pair)))))))))
-
-(def-registers
- ("define registers and their bit mnemonics"
- "setup/general"
-
- (reg-ex-mem-ctrl #x04000204
- ((ram-region-access-cycle-ctrl :arm9 0 1)
- (rom-1st-access-cycle-ctrl :arm9 2 3)
- (rom-2nd-access-cycle-ctrl :arm9 4)
- (phi-terminal-output-ctrl :arm9 5 6)
- (cartridge-access-right :arm9 7)
- (card-access-right :arm9 11)
- (main-mem-iface-priority :arm9 14)
- (main-mem-priority :arm9 15)))
-
- (reg-pow-ctrl #x04000304
- ((snd-speakers-pwr :arm7 0)
- (wifi-pwr :arm7 1)
- (lcd-screens-pow :arm9 0)
- (2d-core-a-pow :arm9 1)
- (3d-render-core-pow :arm9 2)
- (3d-geometry-core-pow :arm9 3)
- (2d-core-b-pow :arm9 4)
- (lcd-swap :arm9 15)))
-
- (reg-halt-ctrl #x04000300
- ((check :both 0)
- (pause-mode :both 14 15)))
-
- "display"
- (reg-disp-ctrl #x4000000
- ((bg-mode :both 0 2)
- (reserved-for-bios :none 3)
- (disp-frame-select :both 4)
- (h-blank-interval-free :both 5)
- (obj-char-disp-mapping :both 6)
- (forced-blank :both 7)
- (screen-disp-bg-0 :both 8)
- (screen-disp-bg-1 :both 9)
- (screen-disp-bg-2 :both 10)
- (screen-disp-bg-3 :both 11)
- (screen-disp-obj :both 12)
- (window-0-disp-flag :both 13)
- (window-1-disp-flag :both 14)
- (obj-window-disp-flag :both 15)))
-
- (reg-disp-stat #x4000004
- ((disp-in-vblank :both 0)
- (disp-in-hblank :both 1)
- (disp-vcount-flag :both 2)
- (disp-vblank-irq :both 3)
- (disp-hblank-irq :both 4)
- (disp-vcount-irq :both 5)
- (disp-vcount-match :both 7 15)))
-
- (reg-vcount #x4000006
- ((curr-scanline :both 0 9)))
-
- (reg-vram-ctrl-a #x04000240
- ((alloc-options :arm9 0 1)
- (offset :arm9 3 4)
- (enable :arm9 7)))
-
- (reg-vram-ctrl-b #x04000241
- reg-vram-ctrl-a)
-
- (reg-vram-ctrl-c #x04000242
- ((alloc-options :arm9 0 2)
- (offset :arm9 3 4)
- (enable :arm9 7)))
-
- (reg-vram-ctrl-d #x04000243
- reg-vram-ctrl-b)
-
- (reg-vram-ctrl-e #x04000244
- reg-vram-ctrl-b)
-
- (reg-vram-ctrl-f #x04000245
- reg-vram-ctrl-b)
-
- (reg-vram-ctrl-g #x04000246
- reg-vram-ctrl-b)
-
- (reg-vram-ctrl-h #x04000248
- reg-vram-ctrl-b)
-
- (reg-vram-ctrl-i #x04000249
- ((alloc-options :arm9 0 1)
- (enable :arm9 7)))
-
- (reg-wram-ctrl #x04000247
- ((bank-specification :arm9 0 1)))
-
- (reg-wvram-stat #x04000240
- ((vram-c-setting :arm7 0)
- (vram-d-setting :arm7 1)
- (wram-0-setting :arm7 8)
- (wram-1-setting :arm7 9)))
-
- "dma"
- (reg-dma-0-source-addr #x040000B0)
- (reg-dma-1-source-addr #x040000BC)
- (reg-dma-2-source-addr #x040000C8)
- (reg-dma-3-source-addr #x040000D4)
-
- (reg-dma-0-dest-addr #x040000B4)
- (reg-dma-1-dest-addr #x040000C0)
- (reg-dma-2-dest-addr #x040000CC)
- (reg-dma-3-dest-addr #x040000D8)
-
- (reg-dma-0-ctrl #x040000B8
- ((size-count :arm7 0 15)
- (dest-addr-ctrl :arm7 21 22)
- (source-addr-ctrl :arm7 23 24)
- (dma-repeat :arm7 25)
- (dma-transfer-type :arm7 26)
- (dma-start-timing :arm7 28 29)
- (dma-irq-on-size-count-end :arm7 30)
- (dma-enable :arm7 31)))
-
- (reg-dma-1-ctrl #x040000C4
- reg-dma-0-ctrl)
-
- (reg-dma-2-ctrl #x040000D0
- reg-dma-0-ctrl)
-
- (reg-dma-3-ctrl #x040000DC
- reg-dma-0-ctrl)
-
- "keys"
- (reg-key-status #x04000130
- ((button-a :both 0)
- (button-b :both 1)
- (select :both 2)
- (start :both 3)
- (right :both 4)
- (left :both 5)
- (up :both 6)
- (down :both 7)
- (button-r :both 8)
- (button-l :both 9)))
-
- (reg-key-xy #x04000136
- ((button-x :arm7 0)
- (button-y :arm7 1)
- (touchpad :arm7 6)
- (screen-status :arm7 7)))
-
- "interprocessor communication"
- (reg-ipc-sync #x04000180
- ((ipc-remote-status :both 0 3)
- (ipc-local-status :both 8 11)
- (ipc-irq-req :both 13)
- (ipc-irq-enable :both 14)))
-
- (reg-ipc-recieve-fifo #x04100000)
- (reg-ipc-send-fifo #x04000188)
-
- (reg-ipc-fifo-ctrl #x04000184
- ((send-fifo-empty-status :both 0)
- (send-fifo-full-status :both 1)
- (send-fifo-irq-enable :both 2)
- (send-fifo-clear :both 3)
- (receive-fifo-empty :both 8)
- (recieve-fifo-full :both 9)
- (recieve-fifo-irq-enable :both 10)
- (fifo-error :both 14)
- (enable-fifo :both 15)))))
\ No newline at end of file
diff -rN -u old-liards/src/crc.lisp new-liards/src/crc.lisp
--- old-liards/src/crc.lisp 1969-12-31 16:00:00.000000000 -0800
+++ new-liards/src/crc.lisp 2014-08-01 15:31:58.000000000 -0700
@@ -0,0 +1,45 @@
+(in-package :liards)
+
+(defvar *crc16-table*
+ (make-array 256 :initial-contents
+ '(#x0000 #xC0C1 #xC181 #x0140 #xC301 #x03C0 #x0280 #xC241
+ #xC601 #x06C0 #x0780 #xC741 #x0500 #xC5C1 #xC481 #x0440
+ #xCC01 #x0CC0 #x0D80 #xCD41 #x0F00 #xCFC1 #xCE81 #x0E40
+ #x0A00 #xCAC1 #xCB81 #x0B40 #xC901 #x09C0 #x0880 #xC841
+ #xD801 #x18C0 #x1980 #xD941 #x1B00 #xDBC1 #xDA81 #x1A40
+ #x1E00 #xDEC1 #xDF81 #x1F40 #xDD01 #x1DC0 #x1C80 #xDC41
+ #x1400 #xD4C1 #xD581 #x1540 #xD701 #x17C0 #x1680 #xD641
+ #xD201 #x12C0 #x1380 #xD341 #x1100 #xD1C1 #xD081 #x1040
+ #xF001 #x30C0 #x3180 #xF141 #x3300 #xF3C1 #xF281 #x3240
+ #x3600 #xF6C1 #xF781 #x3740 #xF501 #x35C0 #x3480 #xF441
+ #x3C00 #xFCC1 #xFD81 #x3D40 #xFF01 #x3FC0 #x3E80 #xFE41
+ #xFA01 #x3AC0 #x3B80 #xFB41 #x3900 #xF9C1 #xF881 #x3840
+ #x2800 #xE8C1 #xE981 #x2940 #xEB01 #x2BC0 #x2A80 #xEA41
+ #xEE01 #x2EC0 #x2F80 #xEF41 #x2D00 #xEDC1 #xEC81 #x2C40
+ #xE401 #x24C0 #x2580 #xE541 #x2700 #xE7C1 #xE681 #x2640
+ #x2200 #xE2C1 #xE381 #x2340 #xE101 #x21C0 #x2080 #xE041
+ #xA001 #x60C0 #x6180 #xA141 #x6300 #xA3C1 #xA281 #x6240
+ #x6600 #xA6C1 #xA781 #x6740 #xA501 #x65C0 #x6480 #xA441
+ #x6C00 #xACC1 #xAD81 #x6D40 #xAF01 #x6FC0 #x6E80 #xAE41
+ #xAA01 #x6AC0 #x6B80 #xAB41 #x6900 #xA9C1 #xA881 #x6840
+ #x7800 #xB8C1 #xB981 #x7940 #xBB01 #x7BC0 #x7A80 #xBA41
+ #xBE01 #x7EC0 #x7F80 #xBF41 #x7D00 #xBDC1 #xBC81 #x7C40
+ #xB401 #x74C0 #x7580 #xB541 #x7700 #xB7C1 #xB681 #x7640
+ #x7200 #xB2C1 #xB381 #x7340 #xB101 #x71C0 #x7080 #xB041
+ #x5000 #x90C1 #x9181 #x5140 #x9301 #x53C0 #x5280 #x9241
+ #x9601 #x56C0 #x5780 #x9741 #x5500 #x95C1 #x9481 #x5440
+ #x9C01 #x5CC0 #x5D80 #x9D41 #x5F00 #x9FC1 #x9E81 #x5E40
+ #x5A00 #x9AC1 #x9B81 #x5B40 #x9901 #x59C0 #x5880 #x9841
+ #x8801 #x48C0 #x4980 #x8941 #x4B00 #x8BC1 #x8A81 #x4A40
+ #x4E00 #x8EC1 #x8F81 #x4F40 #x8D01 #x4DC0 #x4C80 #x8C41
+ #x4400 #x84C1 #x8581 #x4540 #x8701 #x47C0 #x4680 #x8641
+ #x8201 #x42C0 #x4380 #x8341 #x4100 #x81C1 #x8081 #x4040)))
+
+(defun crc16 (data)
+ (let ((crc #xFFFF))
+ (dotimes (byte-nr (length data) (make-array 2 :initial-contents `(,(logand crc #xff) ,(ash crc -8))))
+ (setf crc (logxor (logand (ash crc -8) #xFFFF)
+ (aref *crc16-table*
+ (logand (logxor crc
+ (nth byte-nr data))
+ #xFF)))))))
\ No newline at end of file
diff -rN -u old-liards/src/file-stitch.lisp new-liards/src/file-stitch.lisp
--- old-liards/src/file-stitch.lisp 1969-12-31 16:00:00.000000000 -0800
+++ new-liards/src/file-stitch.lisp 2014-08-01 15:31:58.000000000 -0700
@@ -0,0 +1,61 @@
+(in-package :liards)
+
+(defvar *rom-dir* (merge-pathnames #p"roms"
+ (asdf:component-pathname (asdf:find-system :liards))))
+
+(defun rom-location (&optional (rom-name "my.nds") (rom-dir *rom-dir*))
+ (concatenate 'string (namestring rom-dir) "/" rom-name))
+
+(defun write-rom (rom &key (file "my.nds") (dir *rom-dir*))
+ (with-open-file (s (rom-location file dir) :direction :output :element-type '(unsigned-byte 8) :if-exists :supersede)
+ (write-sequence rom s)))
+
+(defun nds-compile (arm9-code arm7-code &optional (file "my.nds") (dir *rom-dir*))
+ (let* ((header-class (make-instance 'nds-header))
+ (header (make-list #x200 :initial-element 0))
+ (arm9-code-size (length arm9-code))
+ (arm9-aligned (align arm9-code))
+ (arm7-code-size (length arm7-code))
+ (arm7-rom-offset (+ (length arm9-aligned) (length header)))
+ (filename-table-offset (+ arm7-rom-offset arm7-code-size))
+ (filename-table-aligned (align (make-list 9 :initial-element 0)))
+ (fat-offset (+ filename-table-offset (length filename-table-aligned)))
+ (application-end-offset fat-offset)
+ (logo-crc16 (crc16 *logo*)))
+ ;; make a correct header
+ (macrolet ((write-and-seal-headers (header-list)
+ (let ((res-list '(progn)))
+ (dolist (header-name header-list)
+ (setf res-list
+ (append res-list
+ `((write-header-item-and-seal (,header-name header-class)
+ (nr-to-big-endian-word-byte-list ,header-name))))))
+ res-list)))
+ (write-and-seal-headers (arm9-code-size
+ arm7-code-size
+ arm7-rom-offset
+ filename-table-offset
+ fat-offset
+ application-end-offset)))
+ (write-header-item-and-seal (logo-crc16 header-class) logo-crc16)
+ (write-header-to-list header-class header)
+ (write-header-item-and-seal (header-crc16 header-class) (crc16 (subseq header 0 #x15E)))
+ (write-header-item-to-list (header-crc16 header-class) header)
+ ;; append the lot
+ (write-rom (append header arm9-aligned arm7-code filename-table-aligned) :file file :dir dir)))
+
+#|
+these should be calculated dynamically:
+device-cap - not yet implemented
+arm-9-code-size
+arm7-rom-offset
+arm7-code-size
+filename-table-offset
+fat-offset
+application-end-offset
+logo-crc16
+header-crc16
+
+It would be nice if a few more, like romsize and fat-size, are also calculated on the fly,
+for elegance sake, but hey.
+|#
diff -rN -u old-liards/src/hardware-layout.lisp new-liards/src/hardware-layout.lisp
--- old-liards/src/hardware-layout.lisp 1969-12-31 16:00:00.000000000 -0800
+++ new-liards/src/hardware-layout.lisp 2014-08-01 15:31:58.000000000 -0700
@@ -0,0 +1,61 @@
+(in-package :liards)
+
+(defmacro def-mem-layout (list)
+ (let ((const-list '(progn)))
+ (dolist (const-pair list const-list)
+ (if (typep const-pair 'list)
+ (setf const-list
+ (append const-list
+ `((defconstant ,(car const-pair) ,(cadr const-pair)))))))))
+
+;; expects name, start address, end adress and bus-width
+;; just now just using name and start address
+;; nuthin wrong with literary coding
+(def-mem-layout
+ ("mem-blocks"
+
+ "- shared"
+ "-- all-purpose"
+ (+main-ram+ #x02000000 #x023FFFFF 16)
+ (+protection+ #x04000308 #x0400030C :?) ;; got no clue what this does (write-once sadly) \f libnds
+ (+shared-wram-bank-0+ #x03000000 #x03003FFF 32) ;; check it, ambigious info. this one from dovotos tutorial
+ (+shared-wram-bank-1+ #x03004000 #x03007FFF 32) ;; idem
+ (+gba-rom+ #x08000000 #x09FFFFFF 16)
+ (+gba-sram+ #x0A000000 #x0A00FFFF 8)
+
+ "-- video"
+ "--- banks"
+ (+bank-a+ #x06800000 #x0681FFFF 16)
+ (+bank-b+ #x06820000 #x0683FFFF 16)
+ (+bank-c+ #x06840000 #x0685FFFF 16)
+ (+bank-d+ #x06860000 #x0687FFFF 16)
+ (+bank-e+ #x06880000 #x0688FFFF 16)
+ (+bank-f+ #x06890000 #x06983FFF 16)
+ (+bank-g+ #x06894000 #x06897FFF 16)
+ (+bank-h+ #x06898000 #x0689FFFF 16)
+ (+bank-i+ #x068A0000 #x068A3FFF 16)
+
+ "--- virtual"
+ (+main-background+ #x06000000 #x0607FFFF 16)
+ (+sub-background+ #x06200000 #x0621FFFF 16)
+ (+main-sprite+ #x06400000 #x0643FFFF 16)
+ (+sub-sprite+ #x06600000 #x0661FFFF 16)
+
+ "- arm7 reachable"
+ (+arm7-bios+ #x00000000 #x00003FFF :?)
+ (+arm7-iwram+ #x03800000 #x0380FFFF 32)
+ (+wifi-mac-mem+ #x04804000 #x04805FFF 16)
+
+
+ "- arm9 reachable"
+ (+bios+ #xFFFF0000 #xFFFF7FFF :?)
+
+ "-- fast"
+ (+itcm+ #x00000000 #x00007FFF 32)
+ (+dtcm+ #x0B000000 #x0B003FFF 32)
+
+ "-- graphics"
+ (+palette-ram+ #x05000000 #x050003FF 16)
+ (+sub-palette-ram+ #x05000400 #x050007FF 16)
+ (+oam-main+ #x07000000 #x070003FF 32)
+ (+oam-sub+ #x07000400 #x070007FF 32)))
\ No newline at end of file
diff -rN -u old-liards/src/header-helpers.lisp new-liards/src/header-helpers.lisp
--- old-liards/src/header-helpers.lisp 1969-12-31 16:00:00.000000000 -0800
+++ new-liards/src/header-helpers.lisp 2014-08-01 15:31:58.000000000 -0700
@@ -0,0 +1,49 @@
+(in-package :liards)
+
+(defclass header-item-base ()
+ ((no-bytes :accessor no-bytes :initarg :no-bytes)
+ (header-pos :accessor header-pos :initarg :header-pos)
+ (value :accessor value :initarg :value :type (array (unsigned-byte 8)))
+ (setp :accessor setp :initarg :setp :initform nil)))
+
+(defun make-header-slot-class (slot)
+ `(defclass ,(first slot) (header-item-base) ()))
+
+(defun header-item-slot (header-slot)
+ (let ((slot-name (first header-slot))
+ (header-pos (second header-slot))
+ (no-bytes (third header-slot))
+ (value (fourth header-slot)))
+ `(,slot-name :accessor ,slot-name
+ :initform (make-instance ',slot-name
+ :no-bytes ,no-bytes
+ :header-pos ,header-pos
+ :value (value-handler ,no-bytes ,value)
+ ,@(if value '(:setp t))))))
+
+
+(defun value-handler (no-bytes value)
+ (let ((value-arr (make-list no-bytes :initial-element 0)))
+ (if (and value (not (eql value :nil)))
+ (write-header-item value-arr value)
+ value-arr)))
+
+
+(defun write-header-item (dest-lst source-lst)
+ (let ((src-lst-ln (length source-lst))
+ (dst-lst-ln (length dest-lst)))
+ (if (not (= src-lst-ln dst-lst-ln))
+ (error "size of destination list (~D) doesnt match that of the source list (~D) ... scoundrel ..." dst-lst-ln src-lst-ln)
+ (replace dest-lst source-lst))))
+
+(defun write-header-item-and-seal (header-item source-lst)
+ (write-header-item (value header-item) source-lst)
+ (setf (setp header-item) t))
+
+(defun write-header-item-to-list (header-item list)
+ (let ((pos (header-pos header-item)))
+ (setf (subseq list pos (+ pos (no-bytes header-item))) (value header-item))))
+
+(defun write-header-to-list (header-class list)
+ (dolist (item (instance-slot-names header-class))
+ (write-header-item-to-list (slot-value header-class item) list)))
diff -rN -u old-liards/src/header.lisp new-liards/src/header.lisp
--- old-liards/src/header.lisp 1969-12-31 16:00:00.000000000 -0800
+++ new-liards/src/header.lisp 2014-08-01 15:31:58.000000000 -0700
@@ -0,0 +1,92 @@
+(in-package :liards)
+
+(defvar *logo*
+ '(200 96 79 226 1 112 143 226 23 255 47 225 18 79 17 72 18 76 32 96 100 96 124
+ 98 48 28 57 28 16 74 0 240 20 248 48 106 128 25 177 106 242 106 0 240 11 248
+ 48 107 128 25 177 107 242 107 0 240 8 248 112 106 119 107 7 76 96 96 56 71 7
+ 75 210 24 154 67 7 75 146 8 210 24 12 223 247 70 4 240 31 229 0 254 127 2 240
+ 255 127 2 240 1 0 0 255 1 0 0 0 0 0 4 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
+ "seems to be startup code for one or the other `thing'. Damn you homebrew, and your hackerish ways")
+
+(defmacro def-nds-header (slot-list)
+ "Expects the layout of the nds header, so not much wiggle room here. it expects three or four values per header section.
+ from left to right: the name of the section, the position of the section, the amount of bytes it wants to write and as a fourth an optional
+ standard value as a vector, fill in :nil to default to zero bits and flag that it doesn't need to be touched anymore.
+ Def-nds-header builds a class with the names as slots. In those slots it builds appropriate classes with
+ the same name who's value slot (an array) shares it's structure with it's rightfull place on the *header* array, so we won't have to write
+ that stuff in explicitely all the time. The sections that actually have to do some specialized stuff, mostly determine the position for this
+ and that in the actual nds file, do so when they are called with header-item-handler. def-nds-header and header-item-handler should
+ together cover the creation of a correct header (== *header*). After which two crc checks will really finish it off with icecream on top."
+ `(progn
+ ,@(mapcar #'make-header-slot-class slot-list)
+ (defclass nds-header ()
+ ,(mapcar #'header-item-slot slot-list))))
+
+(def-nds-header
+ ((game-title #x000 12 '(#x2E 00 00 #xEA 00 00 00 00 00 00 00 00))
+ ;; yes well... this should be the the game title but according to the ndstool
+ ;; c++ file this info is needed for "PassMe's that start @ 0x08000000"
+ (game-code #x00c 4 '(35 35 35 35)) ;; f\ndstool "####"
+ (maker-code #x010 2 :nil)
+ (unit-code #x012 1 :nil)
+ (device-type #x013 1 :nil)
+ (device-cap #x014 1)
+ (reserved-1 #x015 8 :nil) ;; was cardinfo
+ (rom-version #x01e 1 :nil)
+ (flags #x01f 1 '(#x04)) ;; flags c\autostart f\ndstool
+ (arm9-rom-offset #x020 4 '(0 2 0 0))
+ (arm9-entry-addr #x024 4 '(0 0 0 2))
+ (arm9-ram-addr #x028 4 '(0 0 0 2))
+ (arm9-code-size #x02c 4)
+ (arm7-rom-offset #x030 4)
+ (arm7-entry-addr #x034 4 '(0 0 128 3))
+ (arm7-ram-addr #x038 4 '(0 0 128 3))
+ (arm7-code-size #x03c 4)
+ (filename-table-offset #x040 4)
+ (filename-table-size #x044 4 '(9 0 0 0)) ;; ? idem
+ (fat-offset #x048 4)
+ (fat-size #x04c 4 :nil)
+ (arm9-overlay-offset #x050 4 :nil)
+ (arm9-overlay-size #x054 4 :nil)
+ (arm7-overlay-offset #x058 4 :nil)
+ (arm7-overlay-size #x05c 4 :nil)
+ (rom-ctrl-info-1 #x060 4 '(#x00 #x60 #x58 #x00)) ;; ctrl-reg-flags-read f\ndstool used in modes 1/3 \f libnds
+ (rom-ctrl-info-2 #x064 4 '(#xF8 #x08 #x18 #x00)) ;; ctrl-reg-flags-init f\ndstool used in mode 2 \f libnds
+ (banner-offset #x068 4 :nil) ;; icon/title-offs
+ (secure-area-crc16 #x06c 2 :nil)
+ (rom-ctrl-info-3 #x06e 2 '(30 5)) ;; rom-timeout. most have it on 30 5, but why?
+ (arm-9-? #x070 4 :nil)
+ (arm-7-? #x074 4 :nil)
+ (magic #x078 8 :nil)
+ (application-end-offset #x080 4) ;; rom-size
+ (rom-header-size #x084 4 '(0 2 0 0))
+ (unknown-5 #x088 24 :nil) ;; was 56, is still kinda... in total... bit useless this entry; just for bw-compatibility
+ (sram-backup #x0a0 9 (string-to-octets "SRAM_V110" :utf-8))
+ (auto-flashme-start #x0ac 7 (concatenate 'vector (string-to-octets "PASS01" :utf-8) '(#x96)))
+ ;; f\ndstool "automatically start with FlashMe, make it look more like a GBA rom"
+ (logo #x0c0 156 *logo*)
+ (logo-crc16 #x15c 2)
+ (header-crc16 #x15e 2)
+ (reserved #x160 160 :nil)))
+
+
+;; phased out:
+#-(and) (defgeneric header-item-handler (header-item-base)
+ (:documentation "handles non-constant header items")
+ ;; game-title - just make sure there's a name in *game-title* if you want to change the default
+ ;; commented out right now because appearantly the info that the name info is stepping on is needed for passme devices
+ #-(and)(:method ((title game-title))
+ (let ((array (make-array (no-bytes title))))
+ ;; there's a bit to much array replacing going on between this function and write-header-item,
+ ;; but somehow i think it's more elegant
+ (if (write-header-item (value title) (replace array (string-to-octets *game-title* :utf-8)))
+ (setf (setp title) t)
+ (error "stuff went wrong writing game title")))))
+#-(and) (defun process-leftover-headers (h)
+ "makes sure the non-constant header items are processed correctly so we have a fully filled out and correct nds header...
+ except for the crcs"
+ (dolist (item (instance-slot-names h))
+ (let ((item-class (slot-value h item)))
+ (if (not (or (setp item-class) (eq item 'logo-crc16 ) (eq item 'header-crc16)))
+ (header-item-handler item-class)))))
diff -rN -u old-liards/src/helpers.lisp new-liards/src/helpers.lisp
--- old-liards/src/helpers.lisp 1969-12-31 16:00:00.000000000 -0800
+++ new-liards/src/helpers.lisp 2014-08-01 15:31:58.000000000 -0700
@@ -0,0 +1 @@
+(in-package :liards)
diff -rN -u old-liards/src/packages.lisp new-liards/src/packages.lisp
--- old-liards/src/packages.lisp 1969-12-31 16:00:00.000000000 -0800
+++ new-liards/src/packages.lisp 2014-08-01 15:31:58.000000000 -0700
@@ -0,0 +1,47 @@
+(in-package :cl-user)
+
+(defpackage :liards
+ (:use :common-lisp
+ :armish
+ :umpa-lumpa
+ :it.bese.arnesi
+ :split-sequence)
+ (:shadowing-import-from :it.bese.arnesi :partition)
+ (:export
+
+ ;; file stitch
+ :nds-compile
+
+ ;; hardware-layout
+ :+main-ram+
+ :+protection+
+ :+shared-wram-bank-0+
+ :+shared-wram-bank-1+
+ :+gba-rom+
+ :+gba-sram+
+
+ :+bank-a+
+ :+bank-b+
+ :+bank-c+
+ :+bank-d+
+ :+bank-e+
+ :+bank-f+
+ :+bank-g+
+ :+bank-h+
+ :+bank-i+
+
+ :+main-background+
+ :+sub-background+
+ :+main-sprite+
+ :+sub-sprite+
+
+ :+arm7-bios+
+ :+arm7-iwram+
+ :+wifi-mac-mem+
+
+ :+bios+
+ :+itcm+
+ :+dtcm+
+ :+palette-ram+
+ :+sub-palette-ram+
+ :+oam-main+))
\ No newline at end of file
diff -rN -u old-liards/src/registers.lisp new-liards/src/registers.lisp
--- old-liards/src/registers.lisp 1969-12-31 16:00:00.000000000 -0800
+++ new-liards/src/registers.lisp 2014-08-01 15:31:58.000000000 -0700
@@ -0,0 +1,175 @@
+(in-package :liards)
+
+(defmacro def-registers (list)
+ (let ((const-list '(progn)))
+ (dolist (const-pair list const-list)
+ (if (typep const-pair 'list)
+ (setf const-list (append const-list `((defconstant ,(car const-pair) ,(cadr const-pair)))))))))
+
+(def-registers
+ ("define registers and their bit mnemonics"
+ "setup/general"
+
+ (reg-ex-mem-ctrl #x04000204
+ ((ram-region-access-cycle-ctrl :arm9 0 1)
+ (rom-1st-access-cycle-ctrl :arm9 2 3)
+ (rom-2nd-access-cycle-ctrl :arm9 4)
+ (phi-terminal-output-ctrl :arm9 5 6)
+ (cartridge-access-right :arm9 7)
+ (card-access-right :arm9 11)
+ (main-mem-iface-priority :arm9 14)
+ (main-mem-priority :arm9 15)))
+
+ (reg-pow-ctrl #x04000304
+ ((snd-speakers-pwr :arm7 0)
+ (wifi-pwr :arm7 1)
+ (lcd-screens-pow :arm9 0)
+ (2d-core-a-pow :arm9 1)
+ (3d-render-core-pow :arm9 2)
+ (3d-geometry-core-pow :arm9 3)
+ (2d-core-b-pow :arm9 4)
+ (lcd-swap :arm9 15)))
+
+ (reg-halt-ctrl #x04000300
+ ((check :both 0)
+ (pause-mode :both 14 15)))
+
+ "display"
+ (reg-disp-ctrl #x4000000
+ ((bg-mode :both 0 2)
+ (reserved-for-bios :none 3)
+ (disp-frame-select :both 4)
+ (h-blank-interval-free :both 5)
+ (obj-char-disp-mapping :both 6)
+ (forced-blank :both 7)
+ (screen-disp-bg-0 :both 8)
+ (screen-disp-bg-1 :both 9)
+ (screen-disp-bg-2 :both 10)
+ (screen-disp-bg-3 :both 11)
+ (screen-disp-obj :both 12)
+ (window-0-disp-flag :both 13)
+ (window-1-disp-flag :both 14)
+ (obj-window-disp-flag :both 15)))
+
+ (reg-disp-stat #x4000004
+ ((disp-in-vblank :both 0)
+ (disp-in-hblank :both 1)
+ (disp-vcount-flag :both 2)
+ (disp-vblank-irq :both 3)
+ (disp-hblank-irq :both 4)
+ (disp-vcount-irq :both 5)
+ (disp-vcount-match :both 7 15)))
+
+ (reg-vcount #x4000006
+ ((curr-scanline :both 0 9)))
+
+ (reg-vram-ctrl-a #x04000240
+ ((alloc-options :arm9 0 1)
+ (offset :arm9 3 4)
+ (enable :arm9 7)))
+
+ (reg-vram-ctrl-b #x04000241
+ reg-vram-ctrl-a)
+
+ (reg-vram-ctrl-c #x04000242
+ ((alloc-options :arm9 0 2)
+ (offset :arm9 3 4)
+ (enable :arm9 7)))
+
+ (reg-vram-ctrl-d #x04000243
+ reg-vram-ctrl-b)
+
+ (reg-vram-ctrl-e #x04000244
+ reg-vram-ctrl-b)
+
+ (reg-vram-ctrl-f #x04000245
+ reg-vram-ctrl-b)
+
+ (reg-vram-ctrl-g #x04000246
+ reg-vram-ctrl-b)
+
+ (reg-vram-ctrl-h #x04000248
+ reg-vram-ctrl-b)
+
+ (reg-vram-ctrl-i #x04000249
+ ((alloc-options :arm9 0 1)
+ (enable :arm9 7)))
+
+ (reg-wram-ctrl #x04000247
+ ((bank-specification :arm9 0 1)))
+
+ (reg-wvram-stat #x04000240
+ ((vram-c-setting :arm7 0)
+ (vram-d-setting :arm7 1)
+ (wram-0-setting :arm7 8)
+ (wram-1-setting :arm7 9)))
+
+ "dma"
+ (reg-dma-0-source-addr #x040000B0)
+ (reg-dma-1-source-addr #x040000BC)
+ (reg-dma-2-source-addr #x040000C8)
+ (reg-dma-3-source-addr #x040000D4)
+
+ (reg-dma-0-dest-addr #x040000B4)
+ (reg-dma-1-dest-addr #x040000C0)
+ (reg-dma-2-dest-addr #x040000CC)
+ (reg-dma-3-dest-addr #x040000D8)
+
+ (reg-dma-0-ctrl #x040000B8
+ ((size-count :arm7 0 15)
+ (dest-addr-ctrl :arm7 21 22)
+ (source-addr-ctrl :arm7 23 24)
+ (dma-repeat :arm7 25)
+ (dma-transfer-type :arm7 26)
+ (dma-start-timing :arm7 28 29)
+ (dma-irq-on-size-count-end :arm7 30)
+ (dma-enable :arm7 31)))
+
+ (reg-dma-1-ctrl #x040000C4
+ reg-dma-0-ctrl)
+
+ (reg-dma-2-ctrl #x040000D0
+ reg-dma-0-ctrl)
+
+ (reg-dma-3-ctrl #x040000DC
+ reg-dma-0-ctrl)
+
+ "keys"
+ (reg-key-status #x04000130
+ ((button-a :both 0)
+ (button-b :both 1)
+ (select :both 2)
+ (start :both 3)
+ (right :both 4)
+ (left :both 5)
+ (up :both 6)
+ (down :both 7)
+ (button-r :both 8)
+ (button-l :both 9)))
+
+ (reg-key-xy #x04000136
+ ((button-x :arm7 0)
+ (button-y :arm7 1)
+ (touchpad :arm7 6)
+ (screen-status :arm7 7)))
+
+ "interprocessor communication"
+ (reg-ipc-sync #x04000180
+ ((ipc-remote-status :both 0 3)
+ (ipc-local-status :both 8 11)
+ (ipc-irq-req :both 13)
+ (ipc-irq-enable :both 14)))
+
+ (reg-ipc-recieve-fifo #x04100000)
+ (reg-ipc-send-fifo #x04000188)
+
+ (reg-ipc-fifo-ctrl #x04000184
+ ((send-fifo-empty-status :both 0)
+ (send-fifo-full-status :both 1)
+ (send-fifo-irq-enable :both 2)
+ (send-fifo-clear :both 3)
+ (receive-fifo-empty :both 8)
+ (recieve-fifo-full :both 9)
+ (recieve-fifo-irq-enable :both 10)
+ (fifo-error :both 14)
+ (enable-fifo :both 15)))))
\ No newline at end of file
diff -rN -u old-liards/src/test.lisp new-liards/src/test.lisp
--- old-liards/src/test.lisp 1969-12-31 16:00:00.000000000 -0800
+++ new-liards/src/test.lisp 2014-08-01 15:31:58.000000000 -0700
@@ -0,0 +1,153 @@
+(in-package :liards)
+
+;;; make a queryable rom
+;; globals in abun' make the coders testing fun
+(defvar *ref-rom-dir* (merge-pathnames #p"reference-roms"
+ (asdf:component-pathname (asdf:find-system :liards))))
+
+(defvar *test-rom-dir* (merge-pathnames #p"test-roms"
+ (asdf:component-pathname (asdf:find-system :liards))))
+
+(defvar *arm7-bin* '(#xFE #xFF #xFF #xEA)) ; sets core in eternal loop
+
+(defvar *arm9-bin* '(#x01 #x03 #xA0 #xE3 #x03 #x10 #xA0 #xE3 #x02 #x28 #xA0 #xE3 #x80 #x30 #xA0 #xE3
+ #x04 #x13 #x80 #xE5 #x00 #x20 #x80 #xE5 #x40 #x32 #x80 #xE5 #x1A #x05 #xA0 #xE3
+ #x1F #x10 #xA0 #xE3 #x03 #x29 #xA0 #xE3 #xB2 #x10 #xC0 #xE0 #x01 #x20 #x52 #xE2
+ #xFC #xFF #xFF #x1A #xFE #xFF #xFF #xEA)) ;; branch to thumb code and switch to thumb state
+
+(defparameter *header-class* (make-instance 'nds-header))
+(defparameter *header* (make-list #x200 :initial-element 0))
+(defparameter *query-rom* '())
+
+(defun nds-test-compile (arm9-bin arm7-bin &optional (file "test.nds") (dir *test-rom-dir*))
+ (let* ((arm9-code-size (length arm9-bin))
+ (arm9-aligned (align arm9-bin))
+ (arm7-code-size (length arm7-bin))
+ (arm7-rom-offset (+ (length arm9-aligned) (length *header*)))
+ (filename-table-offset (+ arm7-rom-offset arm7-code-size))
+ (filename-table-aligned (align (make-list 9 :initial-element 0)))
+ (fat-offset (+ filename-table-offset (length filename-table-aligned)))
+ (application-end-offset fat-offset)
+ (logo-crc16 (crc16 *logo*)))
+ ;; make a correct header
+ (macrolet ((write-and-seal-headers (header-list)
+ (let ((res-list '(progn)))
+ (dolist (header-name header-list)
+ (setf res-list (append res-list
+ `((write-header-item-and-seal (,header-name *header-class*)
+ (nr-to-big-endian-word-byte-list ,header-name))))))
+ res-list)))
+ (write-and-seal-headers (arm9-code-size arm7-code-size arm7-rom-offset filename-table-offset fat-offset application-end-offset)))
+ (write-header-item-and-seal (logo-crc16 *header-class*) logo-crc16)
+ (write-header-to-list *header-class* *header*)
+ (write-header-item-and-seal (header-crc16 *header-class*) (crc16 (subseq *header* 0 #x15E)))
+ (write-header-item-to-list (header-crc16 *header-class*) *header*)
+ ;; append the lot
+ (setf *query-rom* (append *header* arm9-aligned arm7-bin filename-table-aligned))
+ (write-rom *query-rom* :file file :dir dir)))
+
+;; test test-compiler
+;; (nds-test-compile *arm9-bin* *arm7-bin*)
+;; and load your favorite .nds sourcecode debugger. freeware-wise i think you're limited to dsemu
+
+;;;; query a number of headers
+;; the functions and macros that make it happen
+
+(defmacro create-empty-headers (name-list)
+ (let* ((header-list '()))
+ `(progn ,@(dolist (name name-list header-list)
+ (setf header-list
+ (append header-list
+ `((progn ,`(defparameter ,name
+ (list "name" (make-list #x200 :initial-element 0)))
+ ,name))))))))
+
+(defun read-headers (file-list headers)
+ (mapc #'read-logo file-list headers))
+
+(defun read-logo (filename sequence)
+ (with-open-file (s (rom-location (cadr filename) *ref-rom-dir*) :element-type 'unsigned-byte)
+ (read-sequence (second sequence) s)
+ (setf (car sequence) (car filename))))
+
+(defun header-info (slot-name header)
+ (let ((slot (slot-value *header-class* slot-name)))
+ (subseq header (header-pos slot) (+ (header-pos slot) (no-bytes slot)))))
+
+(defun header-info-batch (slot-name headers)
+ (let ((headers-plus (append `(("mine" ,*header*)) headers)))
+ (format t "~%you asked for the bytes of ~d?:~%~%" slot-name)
+ (map nil #'(lambda (header)
+ (format t "~d: ~d~%" (car header) (header-info slot-name (cadr header))))
+ headers-plus)))
+
+
+;; initialize
+(create-empty-headers (*data1* *data2* *data3* *data4*))
+(defparameter *header* (make-list #x200 :initial-element 0))
+(defparameter *valid-headers* (list *data1* *data2* *data3* *data4*))
+
+;; fill in a list of lists with in the front the name that you want to see printed and in the back the
+;; real file-name under the test-roms dir. Get some DS homebrew from the net is my advice.
+(read-headers '(("red" "red.nds")
+ ("red" "red.nds")
+ ("red" "red.nds")
+ ("red" "red.nds"))
+ *valid-headers*)
+
+;; test headers
+;; (header-info-batch 'rom-ctrl-info-1 *valid-headers*)
+
+
+;;; testing the assembly facilities
+
+(defun initialize-and-make-red ()
+ (assemble arm9 arm
+ (blx :main)
+
+ code16
+
+ :main
+ (ldr r0 #x04000000) ; hardware-registers offset and address of reg-disp-ctrl
+ (mov r1 #x3) ; both screens on bits
+ (ldr r2 #x00020000) ; framebuffer mode bits
+ (mov r3 #x80) ; vram bank a enabled, lcd bits
+ (ldr r4 #x04000304) ; reg-power-ctrl
+ (mov r5 r4) ; see below
+ (sub r5 #xC4) ; 0x04000240 == reg-vram-ctrl-a
+
+ (str r1 (r4 0))
+ (str r2 (r0 0))
+ (str r3 (r5 0))
+
+ (ldr r0 #x06800000)
+ (mov r1 #x31)
+ (ldr r2 #xC000)
+
+ :write-screen-red
+ (strh r1 (r0 0))
+ (add r0 #x2)
+ (sub r2 r2 #x1)
+ (bne :write-screen-red)
+
+ :loop
+ (b :loop)))
+
+(defun arm7-loop ()
+ (assemble arm7 arm
+ :loop
+ (b :loop)))
+
+(defun testerdetest ()
+ (assemble arm9 arm
+ (adr r3 :main)
+ (mov r3 r4)
+ (mov r5 r6)
+ :main))
+
+;; test - for testing
+;; (nds-test-compile (initialize-and-make-red) (arm7-loop) "red-test.nds")
+;; (nds-test-compile (testerdetest) (arm7-loop) "test.nds")
+
+;; test - normal usage
+;; (nds-compile (initialize-and-make-red) (arm7-loop) "red.nds")
\ No newline at end of file
diff -rN -u old-liards/test.lisp new-liards/test.lisp
--- old-liards/test.lisp 2014-08-01 15:31:58.000000000 -0700
+++ new-liards/test.lisp 1969-12-31 16:00:00.000000000 -0800
@@ -1,153 +0,0 @@
-(in-package :liards)
-
-;;; make a queryable rom
-;; globals in abun' make the coders testing fun
-(defvar *ref-rom-dir* (append (pathname-directory *load-truename*)
- (list "reference-roms")))
-
-(defvar *test-rom-dir* (append (pathname-directory *load-truename*)
- (list "test-roms")))
-
-(defvar *arm7-bin* '(#xFE #xFF #xFF #xEA)) ; sets core in eternal loop
-
-(defvar *arm9-bin* '(#x01 #x03 #xA0 #xE3 #x03 #x10 #xA0 #xE3 #x02 #x28 #xA0 #xE3 #x80 #x30 #xA0 #xE3
- #x04 #x13 #x80 #xE5 #x00 #x20 #x80 #xE5 #x40 #x32 #x80 #xE5 #x1A #x05 #xA0 #xE3
- #x1F #x10 #xA0 #xE3 #x03 #x29 #xA0 #xE3 #xB2 #x10 #xC0 #xE0 #x01 #x20 #x52 #xE2
- #xFC #xFF #xFF #x1A #xFE #xFF #xFF #xEA)) ;; branch to thumb code and switch to thumb state
-
-(defparameter *header-class* (make-instance 'nds-header))
-(defparameter *header* (make-list #x200 :initial-element 0))
-(defparameter *query-rom* '())
-
-(defun nds-test-compile (arm9-bin arm7-bin &optional (file "test.nds") (dir *test-rom-dir*))
- (let* ((arm9-code-size (length arm9-bin))
- (arm9-aligned (align arm9-bin))
- (arm7-code-size (length arm7-bin))
- (arm7-rom-offset (+ (length arm9-aligned) (length *header*)))
- (filename-table-offset (+ arm7-rom-offset arm7-code-size))
- (filename-table-aligned (align (make-list 9 :initial-element 0)))
- (fat-offset (+ filename-table-offset (length filename-table-aligned)))
- (application-end-offset fat-offset)
- (logo-crc16 (crc16 *logo*)))
- ;; make a correct header
- (macrolet ((write-and-seal-headers (header-list)
- (let ((res-list '(progn)))
- (dolist (header-name header-list)
- (setf res-list (append res-list
- `((write-header-item-and-seal (,header-name *header-class*)
- (nr-to-big-endian-word-byte-list ,header-name))))))
- res-list)))
- (write-and-seal-headers (arm9-code-size arm7-code-size arm7-rom-offset filename-table-offset fat-offset application-end-offset)))
- (write-header-item-and-seal (logo-crc16 *header-class*) logo-crc16)
- (write-header-to-list *header-class* *header*)
- (write-header-item-and-seal (header-crc16 *header-class*) (crc16 (subseq *header* 0 #x15E)))
- (write-header-item-to-list (header-crc16 *header-class*) *header*)
- ;; append the lot
- (setf *query-rom* (append *header* arm9-aligned arm7-bin filename-table-aligned))
- (write-rom *query-rom* :file file :dir dir)))
-
-;; test test-compiler
-;; (nds-test-compile *arm9-bin* *arm7-bin*)
-;; and load your favorite .nds sourcecode debugger. freeware-wise i think you're limited to dsemu
-
-;;;; query a number of headers
-;; the functions and macros that make it happen
-
-(defmacro create-empty-headers (name-list)
- (let* ((header-list '()))
- `(progn ,@(dolist (name name-list header-list)
- (setf header-list
- (append header-list
- `((progn ,`(defparameter ,name
- (list "name" (make-list #x200 :initial-element 0)))
- ,name))))))))
-
-(defun read-headers (file-list headers)
- (mapc #'read-logo file-list headers))
-
-(defun read-logo (filename sequence)
- (with-open-file (s (rom-location (cadr filename) *ref-rom-dir*) :element-type 'unsigned-byte)
- (read-sequence (second sequence) s)
- (setf (car sequence) (car filename))))
-
-(defun header-info (slot-name header)
- (let ((slot (slot-value *header-class* slot-name)))
- (subseq header (header-pos slot) (+ (header-pos slot) (no-bytes slot)))))
-
-(defun header-info-batch (slot-name headers)
- (let ((headers-plus (append `(("mine" ,*header*)) headers)))
- (format t "~%you asked for the bytes of ~d?:~%~%" slot-name)
- (map nil #'(lambda (header)
- (format t "~d: ~d~%" (car header) (header-info slot-name (cadr header))))
- headers-plus)))
-
-
-;; initialize
-(create-empty-headers (*data1* *data2* *data3* *data4*))
-(defparameter *header* (make-list #x200 :initial-element 0))
-(defparameter *valid-headers* (list *data1* *data2* *data3* *data4*))
-
-;; fill in a list of lists with in the front the name that you want to see printed and in the back the
-;; real file-name under the test-roms dir. Get some DS homebrew from the net is my advice.
-(read-headers '(("red" "red.nds")
- ("red" "red.nds")
- ("red" "red.nds")
- ("red" "red.nds"))
- *valid-headers*)
-
-;; test headers
-;; (header-info-batch 'rom-ctrl-info-1 *valid-headers*)
-
-
-;;; testing the assembly facilities
-
-(defun initialize-and-make-red ()
- (assemble arm9 arm
- (blx :main)
-
- code16
-
- :main
- (ldr r0 #x04000000) ; hardware-registers offset and address of reg-disp-ctrl
- (mov r1 #x3) ; both screens on bits
- (ldr r2 #x00020000) ; framebuffer mode bits
- (mov r3 #x80) ; vram bank a enabled, lcd bits
- (ldr r4 #x04000304) ; reg-power-ctrl
- (mov r5 r4) ; see below
- (sub r5 #xC4) ; 0x04000240 == reg-vram-ctrl-a
-
- (str r1 (r4 0))
- (str r2 (r0 0))
- (str r3 (r5 0))
-
- (ldr r0 #x06800000)
- (mov r1 #x31)
- (ldr r2 #xC000)
-
- :write-screen-red
- (strh r1 (r0 0))
- (add r0 #x2)
- (sub r2 r2 #x1)
- (bne :write-screen-red)
-
- :loop
- (b :loop)))
-
-(defun arm7-loop ()
- (assemble arm7 arm
- :loop
- (b :loop)))
-
-(defun testerdetest ()
- (assemble arm9 arm
- (adr r3 :main)
- (mov r3 r4)
- (mov r5 r6)
- :main))
-
-;; test - for testing
-;; (nds-test-compile (initialize-and-make-red) (arm7-loop) "red-test.nds")
-;; (nds-test-compile (testerdetest) (arm7-loop) "test.nds")
-
-;; test - normal usage
-;; (nds-compile (initialize-and-make-red) (arm7-loop) "red.nds")
\ No newline at end of file