The Lambda Lab
/
projects
/
jars.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Easier debugging of MARS.
[jars.git]
/
parser.scm
diff --git
a/parser.scm
b/parser.scm
index
7bc3f90
..
c112cf9
100644
(file)
--- a/
parser.scm
+++ b/
parser.scm
@@
-15,7
+15,7
@@
(newline-irx (irregex "^\n"))
(comma-irx (irregex "^,"))
(period-irx (irregex "^\\."))
(newline-irx (irregex "^\n"))
(comma-irx (irregex "^,"))
(period-irx (irregex "^\\."))
- (redcode-irx (irregex "^;redcode\n"))
+ (redcode-irx (irregex "^;redcode
.*
\n"))
(name-start-irx (irregex "^;[ \t]*name "))
(name-irx (irregex "^[^\n]*"))
(author-start-irx (irregex "^;[ \t]*author "))
(name-start-irx (irregex "^;[ \t]*name "))
(name-irx (irregex "^[^\n]*"))
(author-start-irx (irregex "^;[ \t]*author "))
@@
-56,6
+56,7
@@
(mode-post-indirect-A-irx (irregex "^\\}"))
(mode-post-indirect-B-irx (irregex "^>"))
(number-irx (irregex "^(\\+|-)?[0-9]+")))
(mode-post-indirect-A-irx (irregex "^\\}"))
(mode-post-indirect-B-irx (irregex "^>"))
(number-irx (irregex "^(\\+|-)?[0-9]+")))
+
(define (accept-token irx . rest)
(let ((wsmatch (irregex-search whitespace-irx (substring str idx))))
(if wsmatch
(define (accept-token irx . rest)
(let ((wsmatch (irregex-search whitespace-irx (substring str idx))))
(if wsmatch
@@
-69,6
+70,7
@@
(if mandatory
(error "Unexpected token at input string index" idx)
#f))))
(if mandatory
(error "Unexpected token at input string index" idx)
#f))))
+
(define (load-file)
(accept-token redcode-irx #t)
(let loop ((instrs '())
(define (load-file)
(accept-token redcode-irx #t)
(let loop ((instrs '())
@@
-84,28
+86,34
@@
((org) (loop instrs (cdr this-line) name author))
((instr) (loop (cons (cdr this-line) instrs) offset name author)))
(make-prog name author (reverse instrs) offset)))))
((org) (loop instrs (cdr this-line) name author))
((instr) (loop (cons (cdr this-line) instrs) offset name author)))
(make-prog name author (reverse instrs) offset)))))
+
(define (line)
(or (name-line)
(author-line)
(comment-line)
(org-line)
(instruction-line)))
(define (line)
(or (name-line)
(author-line)
(comment-line)
(org-line)
(instruction-line)))
+
(define (name-line)
(if (accept-token name-start-irx)
(cons 'name (string-trim (accept-token name-irx #t)))
#f))
(define (name-line)
(if (accept-token name-start-irx)
(cons 'name (string-trim (accept-token name-irx #t)))
#f))
+
(define (author-line)
(if (accept-token author-start-irx)
(cons 'author (string-trim (accept-token author-irx #t)))
#f))
(define (author-line)
(if (accept-token author-start-irx)
(cons 'author (string-trim (accept-token author-irx #t)))
#f))
+
(define (comment-line)
(if (accept-token comment-irx)
'(comment)
#f))
(define (comment-line)
(if (accept-token comment-irx)
'(comment)
#f))
+
(define (org-line)
(if (accept-token org-irx)
(cons 'org (string->number (accept-token number-irx #t)))
#f))
(define (org-line)
(if (accept-token org-irx)
(cons 'org (string->number (accept-token number-irx #t)))
#f))
+
(define (instruction-line)
(let ((oc (opcode)))
(if oc
(define (instruction-line)
(let ((oc (opcode)))
(if oc
@@
-119,6
+127,7
@@
(z (accept-token comment-irx #t)))
(cons 'instr (make-instr oc modif A-mode A-num B-mode B-num)))
#f)))
(z (accept-token comment-irx #t)))
(cons 'instr (make-instr oc modif A-mode A-num B-mode B-num)))
#f)))
+
(define (opcode)
(let ((res (or (accept-token opcode-DAT-irx)
(accept-token opcode-MOV-irx)
(define (opcode)
(let ((res (or (accept-token opcode-DAT-irx)
(accept-token opcode-MOV-irx)
@@
-138,6
+147,7
@@
(accept-token opcode-SPL-irx)
(accept-token opcode-NOP-irx))))
(if res (string->symbol res) #f)))
(accept-token opcode-SPL-irx)
(accept-token opcode-NOP-irx))))
(if res (string->symbol res) #f)))
+
(define (modifier)
(string->symbol
(or (accept-token modifier-AB-irx)
(define (modifier)
(string->symbol
(or (accept-token modifier-AB-irx)
@@
-147,6
+157,7
@@
(accept-token modifier-F-irx)
(accept-token modifier-X-irx)
(accept-token modifier-I-irx))))
(accept-token modifier-F-irx)
(accept-token modifier-X-irx)
(accept-token modifier-I-irx))))
+
(define (mode)
(or (mode-immediate)
(mode-direct)
(define (mode)
(or (mode-immediate)
(mode-direct)
@@
-156,28
+167,37
@@
(mode-pre-indirect-B)
(mode-post-indirect-A)
(mode-post-indirect-B)))
(mode-pre-indirect-B)
(mode-post-indirect-A)
(mode-post-indirect-B)))
+
(define (mode-immediate)
(and (accept-token mode-immediate-irx)
'immediate))
(define (mode-immediate)
(and (accept-token mode-immediate-irx)
'immediate))
+
(define (mode-direct)
(and (accept-token mode-direct-irx)
'direct))
(define (mode-direct)
(and (accept-token mode-direct-irx)
'direct))
+
(define (mode-indirect-A)
(and (accept-token mode-indirect-A-irx)
'indirect-A))
(define (mode-indirect-A)
(and (accept-token mode-indirect-A-irx)
'indirect-A))
+
(define (mode-indirect-B)
(and (accept-token mode-indirect-B-irx)
'indirect-B))
(define (mode-indirect-B)
(and (accept-token mode-indirect-B-irx)
'indirect-B))
+
(define (mode-pre-indirect-A)
(and (accept-token mode-pre-indirect-A-irx)
'pre-indirect-A))
(define (mode-pre-indirect-A)
(and (accept-token mode-pre-indirect-A-irx)
'pre-indirect-A))
+
(define (mode-pre-indirect-B)
(and (accept-token mode-pre-indirect-B-irx)
'pre-indirect-B))
(define (mode-pre-indirect-B)
(and (accept-token mode-pre-indirect-B-irx)
'pre-indirect-B))
+
(define (mode-post-indirect-A)
(and (accept-token mode-post-indirect-A-irx)
'post-indirect-A))
(define (mode-post-indirect-A)
(and (accept-token mode-post-indirect-A-irx)
'post-indirect-A))
+
(define (mode-post-indirect-B)
(and (accept-token mode-post-indirect-B-irx)
'post-indirect-B))
(define (mode-post-indirect-B)
(and (accept-token mode-post-indirect-B-irx)
'post-indirect-B))
+
(load-file))))
(load-file))))