Skip to content

Commit

Permalink
Add testing infrastructure and some rudimentary tests
Browse files Browse the repository at this point in the history
- Add a compiler mode to dump all registers at the end,
  rather than loop forever (by providing a custom epilog,
  borrowed from http://www.fysnet.net/yourhelp.htm).
- Extend the assembler to be able to assemble that epilog
  (some opcodes were missing).
- Add a compiler driver that:
  - compiles and assembles the program to DOS .COM as usual;
  - copies the binary and the bundled CAPTURE.COM (from
    http://www.pc-tools.net/dos/dosutils/) to the same
    directory;
  - runs them with DOSBox via a generated batch file;
  - parses the resulting textual screen dump to get the
    CPU register values.
- Add some tests that compile an expression and check AX
  for the expected result.
- Update README.md to cater for licenses of bundled
  assembly code that is not mine.
- Move some code around.
  • Loading branch information
nathell committed Sep 25, 2021
1 parent 11ff46e commit 27563b3
Show file tree
Hide file tree
Showing 7 changed files with 173 additions and 37 deletions.
24 changes: 24 additions & 0 deletions README.md
Original file line number Diff line number Diff line change
Expand Up @@ -22,6 +22,10 @@ In the REPL:

# License

Unless otherwise noted, code in this repository is copyright by
Daniel Janus and released under the MIT license:

```
Copyright 2012–2021 Daniel Janus
Permission is hereby granted, free of charge, to any person obtaining
Expand All @@ -42,6 +46,26 @@ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
```

The file `resources/capture.com` comes from the DOS Utilities Collection as obtained
from http://www.pc-tools.net/dos/dosutils/, is copyright by Jem Berkes, and carries the
following copyright notice:

```
You may use and share the programs in this freeware package. However,
remember that YOU MAY NOT MODIFY THESE PROGRAMS IN ANY WAY. They are
NOT PUBLIC DOMAIN, but rather COPYRIGHTED FREEWARE.
I, the author, take NO RESPONSIBILITY for any damage that may result
from using any of these programs.
Jem Berkes <jberkes@pc-tools.net>
```

The assembly code in `register-dump` is a s-expression version of a snippet
that comes from http://www.fysnet.net/yourhelp.htm and is copyright by
Forever Young Software.

[1]: https://blog.danieljanus.pl/2012/05/14/lithium/
[2]: http://scheme2006.cs.uchicago.edu/11-ghuloum.pdf
Binary file added resources/capture.com
Binary file not shown.
41 changes: 22 additions & 19 deletions src/lithium/assembler.clj
Original file line number Diff line number Diff line change
Expand Up @@ -70,17 +70,27 @@
[:xor rm16 reg16] [0x31 :r]
[:push reg16] [[:r+ 0x50]]
[:pop reg16] [[:r+ 0x58]]
[:push :cs] [0x0e]
[:pushf] [0x9c]
[:pusha] [0x60]
[:stosb] [0xaa]
[:stosw] [0xab]
[:movsw] [0xa5]
[:rol rm16 imm8] [0xc1 :0 :ib]
[:daa] [0x27]
[:ret] [0xc3]
[:cli] [0xfa]
[:inc reg16] [[:r+ 0x40]]
[:inc rm8] [0xfe :0]
[:dec reg16] [[:r+ 0x48]]
[:dec rm8] [0xfe :1]
[:cmp :al imm8] [0x3c :ib]
[:cmp :ax imm16] [0x3d :iw]
[:cmp rm8 imm8] [0x80 :7 :ib]
[:cmp rm16 imm16] [0x81 :7 :iw]
[:cmp reg8 rm8] [0x3a :r]
[:cmp reg16 rm16] [0x3b :r]
[:adc :al imm8] [0x14 :ib]
[:add rm8 reg8] [0x00 :r]
[:add rm16 reg16] [0x01 :r]
[:add reg8 rm8] [0x02 :r]
Expand Down Expand Up @@ -197,10 +207,14 @@
[(+ (second byte-desc) (-> instr (extract-cc instr-template) +condition-codes+))])))

(defn assemble-instruction [instr]
(let [[template parts] (find-template instr)]
(when-not template (throw (Exception. (str "Could not assemble instruction: " (pr-str instr)))))
(let [assembled-parts (map (partial parse-byte instr template) parts)]
(apply concat assembled-parts))))
(cond
(= (first instr) 'string) (map int (second instr))
(= (first instr) 'bytes) (second instr)
:otherwise
(let [[template parts] (find-template instr)]
(when-not template (throw (Exception. (str "Could not assemble instruction: " (pr-str instr)))))
(let [assembled-parts (map (partial parse-byte instr template) parts)]
(apply concat assembled-parts)))))

;; This is the value added to absolute addresses of labels, telling
;; the assembler where the code starts from. Defaults to 0x100 for
Expand Down Expand Up @@ -233,18 +247,7 @@
cnt (count assembled)]
(recur (next prog) (into code assembled) (+ pc cnt) labels)))))))

(defn hexdump [prog]
(string/join " " (map #(format "%02x" %) (asm prog))))

(defn assemble-file [prog out]
(let [assembled (asm (if (string? prog) (read-string (str "[" (slurp prog) "]")) prog))
byte-arr (into-array Byte/TYPE (map #(byte (if (>= % 128) (- % 256) %)) assembled))]
(with-open [f (java.io.FileOutputStream. out)]
(.write f (into-array Byte/TYPE (map #(byte (if (>= % 128) (- % 256) %)) assembled)))
nil)))

(defn run-program! [prog]
(let [filename "/tmp/a.com"]
(assemble-file prog filename)
(sh "dosbox" filename)
nil))
(defn assemble [prog]
(asm (if (string? prog)
(read-string (str "[" (slurp prog) "]"))
prog)))
77 changes: 62 additions & 15 deletions src/lithium/compiler.clj
Original file line number Diff line number Diff line change
Expand Up @@ -4,14 +4,59 @@
[lithium.compiler.code :refer [codeseq compile-expr genkey]]
[lithium.compiler.primitives :as primitives]
[lithium.compiler.repr :as repr]
[lithium.driver :as driver]
[lithium.utils :refer [read-all]]))

(def prolog [['cli]
['mov :bp :sp]
['mov :si :heap-start]
['add :si 7]
['and :si 0xfff8]])
(def epilog [:forever ['jmp :forever] :heap-start])
(def prolog
[['cli]
['mov :bp :sp]
['mov :si :heap-start]
['add :si 7]
['and :si 0xfff8]])

(def endless-loop-epilog
[:forever
['jmp :forever]])

(def register-dump
;; taken from http://www.fysnet.net/yourhelp.htm
[['pushf]
['pusha]
['push :cs]
['mov :di :buff]
['mov :si :msg1]
['mov :cx 10]
:loop1
['movsw]
['mov :al (int \=)]
['stosb]
['pop :ax]
['mov :bx 4]
:ploop
['rol :ax 4]
['push :ax]
['and :al 0x0f]
['daa]
['add :al 0xf0]
['adc :al 0x40]
['stosb]
['pop :ax]
['dec :bx]
['jnz :ploop]
['mov :ax 0x0d0a]
['stosw]
['loop :loop1]
['mov :al 0x24]
['stosb]
['mov :dx :buff]
['mov :ah 9]
['int 0x21]
['mov :ah 0x4c]
['int 0x21]
:msg1
['string "CSDISIBPSPBXDXCXAXFL"]
:buff
['bytes (repeat 100 0)]])

(defn primcall? [x]
(or (list? x) (seq? x)))
Expand Down Expand Up @@ -224,15 +269,17 @@
sexps))

(defn compile-program
[sexps]
[prog & [{:keys [epilog]
:or {epilog endless-loop-epilog}}]]
(concat prolog
(:code (compile-program* sexps))
epilog))

(defn compile-file
[f]
(compile-program (read-all f)))
(:code (compile-program* (read-all prog)))
epilog
[:heap-start]))

(defn compile-and-run!
[f]
(assembler/run-program! (compile-file f)))
([f] (compile-and-run! f true))
([f wait?]
(-> f
(compile-program {:epilog (if wait? endless-loop-epilog register-dump)})
assembler/assemble
(driver/run-program! wait?))))
42 changes: 42 additions & 0 deletions src/lithium/driver.clj
Original file line number Diff line number Diff line change
@@ -0,0 +1,42 @@
(ns lithium.driver
(:require [clojure.java.io :as io]
[clojure.java.shell :refer [sh]]
[clojure.string :as string]))

(defn run-and-wait! [prog]
(let [binary "/tmp/runwait.com"]
(with-open [f (java.io.FileOutputStream. binary)]
(.write f (byte-array prog))
(sh "dosbox" binary)
nil)))

(defn parse-registers [str]
(->> (string/split str #"\r\n")
(map string/trim)
(filter seq)
(map (fn [s]
(let [[reg val] (string/split s #"=")]
[(keyword (string/lower-case reg))
(Long/parseLong val 16)])))
(into {})))

(defn run-and-capture-registers! [prog]
(let [tmpdir "/tmp"
binary (str tmpdir "/runcapt.com")
batch (str tmpdir "/run.bat")
screen-grab (str tmpdir "/TEXT.VID")]
(when (.exists (io/file screen-grab))
(io/delete-file screen-grab))
(with-open [f (java.io.FileOutputStream. binary)]
(.write f (byte-array prog)))
(with-open [in (io/input-stream (io/resource "capture.com"))]
(io/copy in (io/file (str tmpdir "/capture.com"))))
(spit batch "@cls\n@runcapt.com\n@capture.com t\n@exit\n")
(sh "dosbox" batch :env {"SDL_VIDEODRIVER" "dummy"})
(parse-registers (slurp screen-grab))))

(defn run-program! [prog wait?]
((if wait? run-and-wait! run-and-capture-registers!) prog))

(defn hexdump [bytes]
(string/join " " (map #(format "%02x" %) bytes)))
8 changes: 5 additions & 3 deletions src/lithium/utils.clj
Original file line number Diff line number Diff line change
Expand Up @@ -4,6 +4,8 @@

(defn read-all
[input]
(with-open [f (java.io.PushbackReader. (io/reader input))]
(let [eof (Object.)]
(doall (take-while #(not= % eof) (repeatedly #(read f false eof)))))))
(if (or (string? input) (instance? java.io.File input))
(with-open [f (java.io.PushbackReader. (io/reader input))]
(let [eof (Object.)]
(doall (take-while #(not= % eof) (repeatedly #(read f false eof))))))
input))
18 changes: 18 additions & 0 deletions test/lithium/compiler_test.clj
Original file line number Diff line number Diff line change
@@ -0,0 +1,18 @@
(ns lithium.compiler-test
(:require [lithium.compiler :as compiler]
[lithium.compiler.repr :as repr]
[clojure.test :refer [deftest are]]))

(deftest test-compiler
(are [expr expected-result] (let [{:keys [ax]} (compiler/compile-and-run! [expr] false)]
(= ax (repr/immediate expected-result)))
'(+ 3 4) 7
'(< 10 15) true
'(if true 3 4) 3
'(if (< 15 10) 3 4) 4
'(let [x 2 y (+ x 3)]
(+ x y)) 7
'(let [x 2
f (fn [y]
(+ x y))]
(f 3)) 5))

0 comments on commit 27563b3

Please sign in to comment.