コンピュータシステムの理論と実装:シンボルフリー版のアセンブラ完成

シンボルフリー版のアセンブラ完成しました。
簡単にプログラムの説明を書いておきます。

A=1
M=D

と書かれたファイルがあるとする。
このファイルをread-asmで読み込むと

("A=1" "M=1")

のようなリストが返されます。
その次に１個ずつ要素を、string->list関数で文字のリストにして
assem1関数に渡す。
例えば、

(assem1 '(#\A #\= #\1))

を実行すると、まずremove-comentとremove-spaceに渡されて、コメントとスペースが
除去される(この例ではコメントもスペースもないですが。)
その次にA命令かC命令かを判断して、parse-@関数かparse関数に渡される。
今回の例ではC命令なのでparse関数に渡されます。

;parse関数の実行結果
((#\A) (#\1) (#\n #\u #\l #\l))

parse関数でdest部、comp部、jump部に分けられます(今回の例ではjump部がないのでnullになっています。)
次にこの結果がcode関数に渡されます。

 ;code関数の実行結果
 ("0111111" "100" "000")

parse関数で分けた部分ごとに、code-dest関数、code-comp関数、code-jump関数に
それぞれ渡され対応したバイナリコードが返されます。

Gaucheで動作確認をしています。

;inにアセンブルするプログラムのファイル名
;outにアセンブルした結果を出力するファイル名
;例:(assembler "./test.asm" "./test.hack")
(define (assembler in out)
  (out-hack out 
	    (assem (read-asm in))))

;プログラムをリストに読み込む
(define  (read-asm file)
  (call-with-input-file file
    (lambda (i)
      (let loop ((c (read-line i)) (lis '()))
	(if (eof-object? c)
	    (reverse lis)
	    (loop (read-line i) (cons c lis)))))))

;ファイルに出力する
(define (out-hack file lis)
  (call-with-output-file file
    (lambda (i)
      (for-each (lambda (s) 
		  (if (not (string=? s ""))
		      (begin
			(display s i) 
			(newline i)))) lis))))


;;アセンブルする
(define (assem lis)
  (map (lambda (s) (assem1 (string->list s))) lis))

;;１行をアセンブルする    
(define (assem1 str)
  (let ((str2 (remove-space
	       (remove-coment str))))
    (if (null? str2)
	""
	(if (char=? (car str2) #\@)
	    (apply string-append (list "0" 
				   (code-@ (parse-@ str2))))
	    (apply string-append (cons "111" (code (parse str2))))))))

;スペースを除去する
(define (remove-space lis)
  (remove (lambda (s) (char=? s #\space)) lis))
;コメントを除去する
(define (remove-coment1 lis result)
  (cond ((null? lis) (reverse result))
	((char=? (car lis) #\/) (reverse result))
	(else
	 (remove-coment1 (cdr lis) (cons (car lis) result)))))

(define (remove-coment lis)
  (remove-coment1 lis '()))

;comp,dist,jumpに分ける
(define (parse str)
  (let* ((dest (parse-dest str))
	 (comp (parse-comp (cadr dest)))
	 (jump (parse-jump (cadr comp))))
    (list (car dest) (car comp) jump)))

;dest,comp,jumpのそれぞれに対応したバイナリコードを返す
(define (code nimonics);parse関数の結果を渡す
  (let ((dest (code-dest (list-ref nimonics 0)))
	(comp (code-comp (list-ref nimonics 1)))
	(jump (code-jump (list-ref nimonics 2))))
    (list comp dest jump)))

(define (parse-@ str) (cdr str))

;文字列を数値に変えてからnumber->stringで2進数の文字列を返す
(define (code-@1 nimonics) 
  (number->string 
   (string->number 
    (list->string nimonics)) 2))

(define (code-@ nimonics)
  (let ((s (code-@1 nimonics)))
    
    (string-append
     (list->string
      (make-list (- 15 (string-length s)) #\0));桁が足りない場合0を付加する
     s)
      
    )
)

(define (parse-dest1 str lis)
  (if (char=? #\= (car str))
      (list (reverse lis) (cdr str))
      (parse-dest1 (cdr str) (cons (car str) lis))))

(define (parse-dest str)
  (if (member #\= str)
      (parse-dest1 str '())
      (list (string->list "null") str)))

(define (parse-comp1 str lis)
  (if (or (null? str) (char=? #\; (car str)))
      (list (reverse lis) str)
      (parse-comp1 (cdr str) (cons (car str) lis))))

(define (parse-comp str)
  (parse-comp1 str '()))


(define (parse-jump1 str lis)
  (if (null? str)
      (reverse lis)
      (parse-jump1 (cdr str) (cons (car str) lis))))

(define (parse-jump str)
  (if (or (null? str) (null? (cdr str)))
      (string->list "null")
      (parse-jump1 (cdr str) '())))
      


(define (code-comp nimonic)
  (let1 nimostr (list->string nimonic)
	(cond ((string=? nimostr "D+1") "0011111")
	      ((string=? nimostr "0") "0101010")
	      ((string=? nimostr "1") "0111111")
	      ((string=? nimostr "-1") "0111010")
	      ((string=? nimostr "D") "0001100")
	      ((string=? nimostr "A") "0110000")
	      ((string=? nimostr "M") "1110000")
	      ((string=? nimostr "!D") "0001101")
	      ((string=? nimostr "!A") "0110001")
	      ((string=? nimostr "!M") "1110001")
	      ((string=? nimostr "-D") "0001111")
	      ((string=? nimostr "-A") "0110011")
	      ((string=? nimostr "-M") "1110011")
	      ((string=? nimostr "A+1") "0110111")
	      ((string=? nimostr "M+1") "1110111")
	      ((string=? nimostr "D-1") "0001110")
	      ((string=? nimostr "A-1") "0110010")
	      ((string=? nimostr "M-1") "1110010")
	      ((string=? nimostr "D+A") "0000010")
	      ((string=? nimostr "D+M") "1000010")
	      ((string=? nimostr "D-A") "0010011")
	      ((string=? nimostr "D-M") "1010011")
	      ((string=? nimostr "A-D") "0000111")
	      ((string=? nimostr "M-D") "1000111")
	      ((string=? nimostr "D&A") "0000000")
	      ((string=? nimostr "D&M") "1000000")
	      ((string=? nimostr "D|A") "0010101")
	      ((string=? nimostr "D|M") "1010101")
	      (else (error nimostr))


	      )))


(define (code-dest nimonic)
  (let1 nimostr (list->string nimonic)
	(cond ((string=? nimostr "null") "000")
	      ((string=? nimostr "M") "001")
	      ((string=? nimostr "D") "010")
	      ((string=? nimostr "MD") "011")
	      ((string=? nimostr "A") "100")
	      ((string=? nimostr "AM") "101")
	      ((string=? nimostr "AD") "110")
	      ((string=? nimostr "AMD") "111")
	      (else (error nimostr)))))


(define (code-jump nimonic)
  (let1 nimostr (list->string nimonic)
	(cond ((string=? nimostr "null") "000")
	      ((string=? nimostr "JGT") "001")
	      ((string=? nimostr "JEQ") "010")
	      ((string=? nimostr "JGE") "011")
	      ((string=? nimostr "JLT") "100")
	      ((string=? nimostr "JNE") "101")
	      ((string=? nimostr "JLE") "110")
	      ((string=? nimostr "JMP") "111")
	      (else (error nimostr)))))