Skip to content

Instantly share code, notes, and snippets.

@adolfopa

adolfopa/asm-1-notests.rkt

Last active Aug 29, 2015
Embed
What would you like to do?
#lang racket/base
;;; Solution to
;;; http://programmingpraxis.com/2014/04/15/assembler-part-1
;;;
;;; adolfo.pa@gmail.com
(require racket/dict
racket/match
racket/sequence
racket/set
racket/string)
(define instructions
(hash "const" 00
"get" 01
"put" 02
"ld" 03
"st" 04
"add" 05
"sub" 06
"jpos" 07
"jz" 08
"j" 09
"halt" 10))
(define instr-regexp
(string-join (map regexp-quote
(sort (hash-keys instructions) > #:key string-length))
"|"
#:before-first "("
#:after-last ")"))
(define stmt-regexp
(pregexp
(string-append "[ \t]*" ; leading whitespace
"(?:" ; (1)
"(?:(\\w+)[ \t]+)??" ; optional label
instr-regexp ; instruction mnemonic
"(?:[ \t]+(\\d+|\\w+))?" ; optional argument
")?" ; (1)
"(?:#.*)?"))) ; optional comment
(struct stmt (label op arg) #:transparent)
(define (read-stmt line)
(match (regexp-match stmt-regexp line)
[(list _ fst snd thd)
(when (and snd (not (dict-ref instructions snd #f)))
(error "syntax error: unknown mnemonic" line))
(and (or fst snd thd)
(stmt fst snd thd))]
[#f
(error "syntax error: ill formed statement" line)]))
(define (read-asm in)
(for*/list ([line (in-lines in)]
[st (in-value (read-stmt line))]
#:when st)
st))
(define (make-symbol-table xs)
(for/hash ([x xs]
[n (in-naturals)]
#:when (stmt-label x))
(values (stmt-label x) n)))
(define (resolve arg labels)
(cond [(not arg) 0]
[(regexp-match #px"^\\d+$" arg)
(string->number arg)]
[else
(dict-ref labels arg)]))
(define (encode op arg labels)
(+ (* (dict-ref instructions op) 1000)
(if arg (resolve arg labels) 0)))
(define (assemble prog [mem (make-vector 1000 0)])
(define stmts (read-asm prog))
(define labels
(make-symbol-table stmts))
(for ([x stmts]
[i (in-naturals)])
(match x
[(stmt _ "const" arg)
(vector-set! mem i (resolve arg labels))]
[(stmt _ op arg)
(vector-set! mem i (encode op arg labels))]))
mem)
#lang racket/base
;;; Solution to
;;; http://programmingpraxis.com/2014/04/15/assembler-part-1
;;;
;;; adolfo.pa@gmail.com
(require racket/dict
racket/match
racket/sequence
racket/set
racket/string)
(module+ test
(require rackunit))
(define instructions
(hash "const" 00
"get" 01
"put" 02
"ld" 03
"st" 04
"add" 05
"sub" 06
"jpos" 07
"jz" 08
"j" 09
"halt" 10))
(define instr-regexp
(string-join (map regexp-quote
(sort (hash-keys instructions) > #:key string-length))
"|"
#:before-first "("
#:after-last ")"))
(define stmt-regexp
(pregexp
(string-append "[ \t]*" ; leading whitespace
"(?:" ; (1)
"(?:(\\w+)[ \t]+)??" ; optional label
instr-regexp ; instruction mnemonic
"(?:[ \t]+(\\d+|\\w+))?" ; optional argument
")?" ; (1)
"(?:#.*)?"))) ; optional comment
(struct stmt (label op arg) #:transparent)
(define (read-stmt line)
(match (regexp-match stmt-regexp line)
[(list _ fst snd thd)
(when (and snd (not (dict-ref instructions snd #f)))
(error "syntax error: unknown mnemonic" line))
(and (or fst snd thd)
(stmt fst snd thd))]
[#f
(error "syntax error: ill formed statement" line)]))
(module+ test
;; instruction, argument and comment
(check-equal? (read-stmt "ld zero # initialize sum to zero")
(stmt #f "ld" "zero"))
;; instruction and argument
(check-equal? (read-stmt "st sum")
(stmt #f "st" "sum"))
;; lone instruction
(check-equal? (read-stmt "get") (stmt #f "get" #f))
;; label, instruction, argument and comment
(check-equal? (read-stmt "done ld sum # print sum")
(stmt "done" "ld" "sum"))
;; label, instruction and comment
(check-equal? (read-stmt "loop get # read a number")
(stmt "loop" "get" #f))
;; lone comment
(check-equal? (read-stmt "# foo") #f)
;; empty statement
(check-equal? (read-stmt "") #f))
(define (read-asm in)
(for*/list ([line (in-lines in)]
[st (in-value (read-stmt line))]
#:when st)
st))
(module+ test
(define program #<<EOS
# print sum of input numbers (terminated by zero)
ld zero # initialize sum to zero
st sum
loop get # read a number
jz done # no more input if number is zero
add sum # add input to accumulated sum
st sum # store new value back in sum
j loop # go back and read another number
done ld sum # print sum
put
halt
zero const 0
sum const
EOS
)
(check-equal? (read-asm (open-input-string program))
(list (stmt #f "ld" "zero")
(stmt #f "st" "sum")
(stmt "loop" "get" #f)
(stmt #f "jz" "done")
(stmt #f "add" "sum")
(stmt #f "st" "sum")
(stmt #f "j" "loop")
(stmt "done" "ld" "sum")
(stmt #f "put" #f)
(stmt #f "halt" #f)
(stmt "zero" "const" "0")
(stmt "sum" "const" #f))))
(define (make-symbol-table xs)
(for/hash ([x xs]
[n (in-naturals)]
#:when (stmt-label x))
(values (stmt-label x) n)))
(module+ test
(let ([labels
(make-symbol-table
(read-asm
(open-input-string program)))])
(check-equal? labels (hash "loop" 2
"done" 7
"zero" 10
"sum" 11))))
(define (resolve arg labels)
(cond [(not arg) 0]
[(regexp-match #px"^\\d+$" arg)
(string->number arg)]
[else
(dict-ref labels arg)]))
(define (encode op arg labels)
(+ (* (dict-ref instructions op) 1000)
(if arg (resolve arg labels) 0)))
(define (assemble prog [mem (make-vector 1000 0)])
(define stmts (read-asm prog))
(define labels
(make-symbol-table stmts))
(for ([x stmts]
[i (in-naturals)])
(match x
[(stmt _ "const" arg)
(vector-set! mem i (resolve arg labels))]
[(stmt _ op arg)
(vector-set! mem i (encode op arg labels))]))
mem)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.