Merge pull request #9 from fabaindaiz/dev

Compiler improvements

Dockerfile

@@ -0,0 +1,32 @@
+FROM ocaml/opam:ubuntu-20.04
+ENV SHELL=/bin/bash
+
+USER root
+
+RUN apt update && apt-get install -y
+#  nasm \
+#  clang
+# && rm -rf /var/lib/apt/lists/*
+
+USER opam
+
+# opam init -a
+RUN opam init -y
+RUN opam update
+RUN eval `opam env`
+
+# opam switch list-available
+RUN opam switch create 5.0.0
+RUN eval `opam env`
+
+RUN opam install -y \
+  dune \
+  utop \
+  merlin \
+  containers \
+  alcotest \
+  ocaml-lsp-server
+
+#RUN dune build --watch --terminal-persistence=clear-on-rebuild
+
+WORKDIR /home/opam

LANGUAGE.md

@@ -46,7 +46,6 @@ Addresing modes are used to specify how the argument is used in the instruction.
 - (Ind var) | (@ var) indirect addresing to var
 - (Dec var) | (< var) decrement var and indirect addresing to var
 - (Inc var) | (> var) indirect addresing to var and increment var
-- (instr var) | (% var) points to the instruction instead of the value
 - (store var) | (! var) store var value in this place (field is automatic)
 
 
@@ -60,8 +59,8 @@ Unary conditions are used to specify when the control flow is executed based on
 
 - (JZ x) x is zero
 - (JN x) x is not zero
-- (DZ x) decrement x and x is zero
-- (DN x) decrement x and x is not zero
+- (DZ x) decrement x and x is zero (not available on some control flows)
+- (DN x) decrement x and x is not zero (not available on some control flows)
 
 ### Binary conditions (cond2)
 
@@ -77,42 +76,58 @@ Binary conditions are used to specify when the control flow is executed based on
 
 Instructions are used to specify the operation to be performed. Instruction modifiers are automatically generated during compilation.
 
+### instructions modifiers (mod)
+
+All instruction modifiers are automatically generated, but there is an option to select one manually.
+A useful case where to declare them explicitly is when you want to target the entire instruction or both fields.
+
+- I points to the instruction instead of values
+- X points to both fields to the same fields
+- F points to both fields to the opposite fields
+
 ### redcode instructions
 
 All redcode instructions are available for direct use.
 Square brackets '[]' indicates that the argument is optional.
 
+#### Misc instructions
+
+- (DAT [arg1] [arg2]) data values (arg1 & arg2 only store data)
 - (NOP [arg1] [arg2]) no operation (arg1 & arg2 only store data)
+- (JMP arg1 [arg2]) jump to arg1 (arg2 only store data)
+- (SPL arg1 [arg2]) split to arg1 (arg2 only store data)
 
-- (DAT arg1 arg2) data values
-- (MOV arg1 arg2) move arg1 to arg2
+#### Arithmetic instructions
 
-- (ADD arg1 arg2) add arg1 to arg2
-- (SUB arg1 arg2) sub arg1 from arg2
-- (MUL arg1 arg2) mul arg1 to arg2
-- (DIV arg1 arg2) div arg1 from arg2
-- (MOD arg1 arg2) mod arg1 from arg2
+- (MOV [mod] arg1 arg2) move arg1 to arg2
+- (ADD [mod] arg1 arg2) add arg1 to arg2
+- (SUB [mod] arg1 arg2) sub arg1 from arg2
+- (MUL [mod] arg1 arg2) mul arg1 to arg2
+- (DIV [mod] arg1 arg2) div arg1 from arg2
+- (MOD [mod] arg1 arg2) mod arg1 from arg2
 
-- (JMP arg1 [arg2]) jump to arg1 (arg2 only store data)
-- (SPL arg1 [arg2]) split to arg1 (arg2 only store data)
+#### Conditional instructions
 
-- (JMZ arg1 arg2) jump to arg1 if arg2 is zero
-- (JMN arg1 arg2) jump to arg1 if arg2 is not zero
-- (DJN arg1 arg2) decrement arg2 and jump to arg1 if arg2 is not zero
+- (JMZ [mod] arg1 arg2) jump to arg1 if arg2 is zero
+- (JMN [mod] arg1 arg2) jump to arg1 if arg2 is not zero
+- (DJN [mod] arg1 arg2) decrement arg2 and jump to arg1 if arg2 is not zero
+- (SEQ [mod] arg1 arg2) skip next instruction if arg1 equals arg2
+- (SNE [mod] arg1 arg2) skip next instruction if arg1 not equals arg2
+- (SLT [mod] arg1 arg2) skip next instruction if arg1 is less than arg2
 
-- (SEQ arg1 arg2) skip next instruction if arg1 equals arg2
-- (SNE arg1 arg2) skip next instruction if arg1 not equals arg2
-- (SLT arg1 arg2) skip next instruction if arg1 is less than arg2
 
 ### Control flows
 
 Control flows are used to specify the execution order of the instructions. Use control flows generates extra instructions in the code.
 
 - (repeat body) repeat body forever (one extra instruction)
+- (if cond then) execute body if cond is true (no extra instruction + cond)
+
 - (while cond body) repeat body while cond is true (one extra instruction + cond)
-- (if cond body) execute body if cond is true (no extra instruction + cond)
 - (do-while cond body) repeat body while cond is true (no extra instruction + cond)
 
+- (if-else cond then else) execute then if cond is true, otherwise execute else (one extra instruction + cond)
+
 
 ### Other instructions
 

README.md

@@ -25,6 +25,8 @@ To execute the resulting redcode you can use one of these redcode interpreters.
 - Test all instructions modifiers and addressing modes
 - Improve control flow instructions and conditions
 
+- Reduce duplicate code reduce duplicate code
+
 ## Acknowledgements
 
 - Pleiad for [BBCTester](https://github.com/pleiad/BBCTester)

TUTORIAL.md

@@ -0,0 +1 @@
+# RED tutorial

bbctests/examples/prog1.bbc

@@ -3,10 +3,10 @@ DESCRIPTION: evaluates a function declaration
 SRC:
 (let (x dest)
   (seq
-      (MOV (Ins -1) (store x))
-      (ADD 4 x)
-      (JMP x)
-      (label dest) ))
+    (MOV I (Dir -1) (store x))
+    (ADD 4 x)
+    (JMP x)
+    (label dest) ))
 EXPECTED:
 ;redcode-94b
 

bbctests/examples/prog10.bbc

@@ -3,7 +3,7 @@ DESCRIPTION: evaluates a function declaration
 SRC:
 (let (x dest_with_some_extra_characters)
   (seq
-      (MOV (Ins -1) (store x))
+      (MOV I (Dir -1) (store x))
       (ADD 4 x)
       (JMP x)
       (label dest_with_some_extra_characters) ))

bbctests/examples/prog4.bbc

@@ -15,7 +15,7 @@ SRC:
           (label dest4)
           (JMP (Ind c))
           (label dest1)
-          (MOV (Ins 0) (Dir 1)) )))))
+          (MOV I (Dir 0) (Dir 1)) )))))
 EXPECTED:
 ;redcode-94b
 

bbctests/examples/prog6.bbc

@@ -4,7 +4,7 @@ SRC:
 (let (x (Dir 3))
     (repeat
       (seq
-        (MOV (Ins -1) (store x))
+        (MOV I (Dir -1) (store x))
         (ADD 1 x) )))
 EXPECTED:
 ;redcode-94b

bbctests/examples/prog7.bbc

@@ -6,7 +6,7 @@ SRC:
     (JMP (Dir 2))
     (DAT 0 (store x))
     (do-while (DN 100)
-      (MOV (Ins -1) (Inc x)) )))
+      (MOV I (Dir -1) (Inc x)) )))
 EXPECTED:
 ;redcode-94b
 

bbctests/examples/prog8.bbc

@@ -8,7 +8,7 @@ SRC:
       (DAT (store x) (store y))
       (while (LT y x)
         (seq
-          (MOV (Ins x) (Dec x)) )))))
+          (MOV I (Dir x) (Dec x)) )))))
 EXPECTED:
 ;redcode-94b
 

compose-dev.yaml

@@ -0,0 +1,11 @@
+services:
+  app:
+    image: ocaml-compiler
+    entrypoint:
+    - sleep
+    - infinity
+    init: true
+    volumes:
+    - type: bind
+      source: /var/run/docker.sock
+      target: /var/run/docker.sock

dev/analyse.ml

@@ -21,10 +21,12 @@ let analyse_store_cond (cond : cond) (id : string) (penv : penv) : penv =
 
 let rec analyse_store_expr (e : tag eexpr) (id : string) (penv : penv) : penv =
   match e with
-  | ELabel (_) -> penv
   | EPrim2 (_, a1, a2, _) ->
     let env' = (analyse_store_arg a1 id PA penv) in
     (analyse_store_arg a2 id PB env')
+  | EPrim2m (_, _, a1, a2, _) ->
+    let env' = (analyse_store_arg a1 id PA penv) in
+    (analyse_store_arg a2 id PB env')
   | EFlow (_, exp, _) -> (analyse_store_expr exp id penv)
   | EFlow1 (_, cond, exp, _) ->
     let env' = (analyse_store_cond cond id penv) in
@@ -35,6 +37,7 @@ let rec analyse_store_expr (e : tag eexpr) (id : string) (penv : penv) : penv =
     (analyse_store_expr exp2 id penv'')
   | ELet (_, _, exp, _) -> (analyse_store_expr exp id penv)
   | ESeq (exps, _) -> List.fold_left (fun penv' exp -> (analyse_store_expr exp id penv')) penv exps
+  | _ -> penv
 
 
 let analyse_let (id : string) (arg : arg) (body : tag eexpr) (label : string) (env : env) : env =

dev/ast.ml

@@ -12,7 +12,6 @@ type imode =
 | MIDec
 
 type mode =
-| MIns          (* Instruction *)
 | MImm          (* Immediate *)
 | MDir          (* Direct *)
 | MInd of imode (* Indirect *)
@@ -43,24 +42,38 @@ type cond =
 | Cond2 of cond2 * arg * arg
 
 
+type imod =
+| MNone
+| MA
+| MB
+| MAB
+| MBA
+| MI
+| MX
+| MF
+
 type prim2 =
 | Dat
+| Jmp
+| Spl
+| Nop
+
+type prim2m =
 | Mov
 | Add
 | Sub
 | Mul
 | Div
 | Mod
-| Jmp
-| Spl
-| Nop
-
 | Jmz
 | Jmn
 | Djn
 | Seq
 | Sne
 | Slt
+| Stp
+| Ldp
+
 
 type flow =
 | Repeat
@@ -75,17 +88,21 @@ type flow2 =
 
 
 type expr =
+| Comment of string
 | Label of string
 | Prim2 of prim2 * arg * arg
+| Prim2m of prim2m * imod * arg * arg
 | Flow of flow * expr
 | Flow1 of flow1 * cond * expr
 | Flow2 of flow2 * cond * expr * expr
 | Let of string * arg * expr
 | Seq of expr list
 
 type 'a eexpr =
+| EComment of string
 | ELabel of string * 'a
 | EPrim2 of prim2 * arg * arg * 'a
+| EPrim2m of prim2m * imod * arg * arg * 'a
 | EFlow of flow * 'a eexpr * 'a
 | EFlow1 of flow1 * cond * 'a eexpr * 'a
 | EFlow2 of flow2 * cond * 'a eexpr * 'a eexpr * 'a
@@ -97,12 +114,17 @@ type tag = int
 
 let rec tag_expr_help (e : expr) (cur : tag) : (tag eexpr * tag) =
   match e with
+  | Comment (s) ->
+    EComment (s), cur
   | Label (s) ->
     let (next_tag) = (cur + 1) in
     (ELabel (s, cur), next_tag)
   | Prim2 (op, a1, a2) ->
     let (next_tag) = (cur + 1) in
     (EPrim2 (op, a1, a2, cur), next_tag)
+  | Prim2m (op, m, a1, a2) ->
+    let (next_tag) = (cur + 1) in
+    (EPrim2m (op, m, a1, a2, cur), next_tag)
   | Flow (op, expr) ->
     let (tag_expr, next_tag) = tag_expr_help expr (cur + 1) in
     (EFlow (op, tag_expr, cur), next_tag)