|
|
Z80アセンブラについて |
|
ポケコンジャーナル(PJ'90No2)にAI-1000+増設メモリRP-33で、 ------ASM-Z80.LSP------
(defun asm(filn)
(let(s1)
(print "reading mn-tbl")
(setq s1(open "MN-TBL"))
(set 's-mnc(read s1))
(close s1)
(print "reading program")
(setq s1(open filn))
(set 's-asm(read s1))
(close s1)
(pass-1)(pass-2)
(set 's-mnc nil)
(set 's-asm nil)
(print 'reverse-flat)
(set 'n-mcn(rflt s-mcn)) ))
(defun pass-1()
(print 'pass-1)
(set 's-tbl ())(set 's-cnt 0)
(do((lin)(mcn)(mn)
(asm s-asm(cdr asm)) )
((endp asm)t)
(setq lin(car asm))
(setq mn(car lin))
(cond
((eq mn 'org)(set 's-cnt(cadr lin)))
((eq mn 'equ)nil)
((eq mn 'lbl)(set 's-tbl(acons(cadr lin)s-cnt s-tbl)))
((eq mn 'db)(set 's-cnt(+ s-cnt(length(rflt(exp-db(cdr lin)))))))
((eq mn 'dw)(set 's-cnt(+ s-cnt(* 2(length(cdr lin))))))
((eq mn 'ds)(set 's-cnt(+ s-cnt(cadr lin))))
(t(setq mcn(assoc mn s-mnc))
(print mcn)
(if(null mcn)(progn(beep 1)(beep 1)))
(set 's-cnt(+ s-cnt(length(cdr mcn)))) ))))
(defun pass-2()
(print 'pass-2)
(set 's-mcn())(set 's-cnt 0)
(do((lin)(mcn)(mn)(asm s-asm(cdr asm)))
((endp asm)t)
(princ "*")
(setq lin(car asm))(setq mn(car lin))
(cond
((eq mn 'org)(set 's-cnt(cadr lin))
(set 's-mcn(cons(list s-cnt '@)s-mcn)) )
((eq mn 'equ)(set 's-tbl(acons(cadr lin)(caddr lin)s-tbl)))
((eq mn 'lbl)nil)
((eq mn 'db)
(let((opr(rflt(exp-db(cdr lin)))))
(set 's-cnt(+ s-cnt(length opr)))(set 's-mcn(cons opr s-mcn)) ))
((eq mn 'dw)(set 's-cnt(+ s-cnt(* 2(length(cdr lin)))))
(set 's-mcn(cons(exp-dw(cdr lin))s-mcn)) )
((eq mn 'ds)(set 's-cnt(+ s-cnt(cadr lin)))
(set 's-mcn(cons(list s-cnt '@)s-mcn)) )
(t(setq mcn(assoc mn s-mnc))
(set 's-cnt(+ s-cnt(length(cdr mcn))))
(set 's-mcn(cons(exp-l(cdr mcn)(cdr lin))s-mcn)) ))))
(defun exp-l(mcn opr)
(do((pat)(acm()))
((or(null mcn)(null(car mcn)))acm)
(setq pat(car mcn))(setq mcn(cdr mcn))
(cond
((numberp pat)(setq acm(cons pat acm)))
(t(setq acm(cons(eval-o(car opr)pat)acm))
(setq opr(cdr opr)) ))))
(defun eval-o(opr pat)
(let((expd(eval(sub-t opr))))
(cond
((eq pat 'n)(mod expd 256))
((eq pat 'd)(mod expd 256))
((eq pat 'nn)(list(mod(floor expd 256)256)(mod expd 256)))
((eq pat 'r)(mod(- expd s-cnt)256)) )))
(defun sub-t(opr)
(cond
((null opr)())
((stringp opr)(char-code opr))
((symbolp opr)
(let((sym(assoc opr s-tbl)))
(if(null sym)opr(sub-t(cdr sym))) ))
((atom opr)opr)
(t(cons(sub-t(car opr))(sub-t(cdr opr)))) ))
(defun exp-db(oprs)
(cond((endp oprs)())
(t(let((opr(car oprs)))
(cond
((stringp opr)
(cons(mapcar #'(lambda(x)(char-code(symbol-name x)))
(explode(intern opr)) )(exp-db(cdr oprs)) ))
(t(cons(eval(sub-t opr))(exp-db(cdr oprs)))) )))))
(defun exp-dw(opr)
(cond((atom opr)nil)
(t(exp-dw1 opr())) ))
(defun exp-dw1(opr acm)
(cond((endp opr)acm)
(t(let((top(eval(sub-t(car opr)))))
(exp-dw1(cdr opr)
(cons(list(mod(floor top 256)256)(mod top 256))acm) )))))
(defun rflt(lst)
(cond((atom lst)lst)
(t(flat1 lst())) ))
(defun flat1(lst acm)
(do((hed))((endp lst)acm)
(setq hed(car lst))
(setq lst(cdr lst))
(cond
((atom hed)
(setq acm(cons hed acm)) )
(t(setq acm(flat1 hed acm))) )))
------ここまで------
------MN-TBL.LSP------
((nop 0)(halt #x76)
(ld-a-b #x78)(ld-a-h #x7c)(ld-a-l #x7d)
(ld-a@hl #x7e)(ld-a@bc 10)(ld-a@nn #x3a nn nil)(ld-a-n #x3e n)
(ld-b-a #x47)(ld-b-n 6 n)(ld-c-a #x4f)(ld-d-b #x50)(ld-e-a #x5f)
(ld@de-a #x12)(ld@nn-a #x32 nn nil)
(ld-bc-nn 1 nn nil)(ld-de-nn 17 nn nil)(ld-hl-nn 33 nn nil)
(push-af #xf5)(pop-af #xf1)(push-bc #xc5)(pop-bc #xc1)
(push-de #xd5)(pop-de #xd1)(push-hl #xe5)(pop-hl #xe1)
(ex-de-hl #xeb)
(sub-n #xd6 n)(sbc-a-n #xde n)
(and-a #xa7)(and-n #xe6 n)(xor-a #xaf)(or-a #xb7)
(cp-n #xfe n)(dec-c #x0d)
(daa #x27)(ccf #x3f)(scf #x37)
(add-hl-bc #x09)(add-hl-hl #x29)(sbc-hl-de #xed #x52)
(inc-bc 3)(inc-de 19)(inc-hl 35)
(rrca #x0f)
(res-5-a #xcb #xaf)
(jrz 40 r)(jrnz #x28 r)(jr 24 r)(djnz 16 r)(jrc 56 r)(jrnc 48 r)
(call #xcd nn nil)(callnc #xd4 nn nil)
(ret #xc9)(retc #xd8)(retnc #xd0)(retz #xc8)
(jpc #xda nn nil))
------ここまで------
------TEST1.LSP------
((equ disa #x1075)(equ getln #x28f9)(equ message #x30cf)
(equ kyscan #x0fbc)(equ basic #x00ea)(equ inch #xfa18)
(org #xc500)
(lbl start)(ld-hl-nn title)(call message)
(lbl dump)(ld-hl-nn msg1)(call message)(call getln)(jpc basic)
(inc-hl)(call xtob)(jrc dp1)
(push-de)(ld-hl-nn msg2)(call message)(call getln)(pop-de)(jrc dump)
(push-de)(inc-hl)(call xtob)(ex-de-hl)(pop-de)
(callnc chlde)(ex-de-hl)(jrnc dp2)
(lbl dp1)(ld-hl-nn msg3)(call message)(jr dump)
(lbl dp2)(ld-b-n 8)(call d4hx)
(lbl dp3)(ld-a-n " ")(call disa)(ld-a@hl)(call d2hx)(call chlde)
(inc-hl)(jrz dp4)(djnz dp3)
(call crlf)(call break)(jrnc dp2)(jr dump)
(lbl dp4)(call crlf)(jr dump)
(lbl title)(db 12 "* MEMORY DUMP *")(db 13 10 0)
(lbl msg1)(db 13 10 "TOP? " 0)
(lbl msg2)(db "END? " 0)
(lbl msg3)(db "ERROR" 7 13 10 0)
(lbl chlde)(push-hl)(or-a)(sbc-hl-de)(pop-hl)(ret)
(lbl crlf)(ld-a-n 13)(call disa)(ld-a-n 10)(call disa)(ret)
(lbl d4hx)(ld-a-h)(call d2hx)(ld-a-l)
(lbl d2hx)(push-af)(rrca)(rrca)(rrca)(rrca)(call d1hx)(pop-af)
(lbl d1hx)(and-n #x0f)(cp-n 10)(sbc-a-n #x69)(daa)(call disa)(ret)
(lbl xtob)(call hexa)(retc)(ld-a@hl)(or-a)(retz)(scf)(ret)
(lbl hexa)(ld-bc-nn 3)(ld-a@hl)(call tstnm)(retc)(ld-d-b)(ld-e-a)
(lbl hx1)(inc-hl)(ld-a@hl)(call hxtb)(retnc)
(dec-c)(jrnz hx1)(inc-hl)(ld-a@hl)(call tstnm)(ccf)(ret)
(lbl hxtb)(call tstnm)(ccf)(retnc)
(ex-de-hl)(add-hl-hl)(add-hl-hl)(add-hl-hl)(add-hl-hl)
(push-bc)(ld-b-n 0)(ld-c-a)(add-hl-bc)(ex-de-hl)(pop-bc)(scf)(ret)
(lbl tstnm)(cp-n "0")(retc)(cp-n (+ "9" 1))(jrnc tn1)(sub-n "0")(ret)
(lbl tn1)(res-5-a)(cp-n "A")(retc)
(cp-n (+ "F" 1))(ccf)(retc)(sub-n #x37)(ret)
(lbl break)(ld-a@nn inch)(or-a)(retz)
(push-bc)(ld-b-a)(call kyscan)(xor-a)(ld@nn-a inch)(ld-a-b)(pop-bc)
(cp-n #x1b)(jrnz br1)
(lbl br2)(call kyscan)(jrz br2)(jr break)
(lbl br1)(cp-n 3)(scf)(retz)(or-a)(ret)
(ds 0))
------ここまで------
------TEST.LSP------
((org #x100)
(lbl start)(ld-bc-nn titile)(ld-de-nn(+ 2 dest))
(lbl l1)(ld-a@bc)(and-a)(ld@de-a)(inc-bc)(inc-de)(jzr l1)
(lbl end1)(jr end1)
(lbl title)(db "abcde" 0)
(lbl dest)(db 13 10)(ds 10)
(lbl end))
------ここまで------
|
|
|
メールはこちらまで |
