finnished ass3

ass1/test.asm

@@ -1,6 +1,6 @@
-poly     START 0
+poly START 0
-        RSUB
+        BASE 50
-        LDB x1
+        LDB 4
-         END   poly
+        NOBASE
-
 x1 WORD 1
+  END   poly

ass1/test.lst

@@ -1,5 +1,4 @@
 00000            poly  START   0    
-00000  6B2000          LDB     x1    
+00000  6B0004          LDB     4    
-00003                  END     poly    
-                  
 00003  000001    x1    WORD    1    
+00006                  END     poly    

ass1/test.obj

@@ -1,3 +1,3 @@
 Hpoly  000000000006
-T000000066B2000000001
+T000000066B0004000001
 E000000

ass3/zbirnik/lib/drugiPrehod.ml

@@ -5,6 +5,8 @@ open Encoder
 open Instruction
 open OpcodeTable
 
+(*TODO ce je prvi ukaz byte ali word moras nardit novi start za end vrstico*)
+
 let drugiPrehod (ifl : lineSemantic list) (simtab : symtab) (opcodeTab : opcodeTab) (lenProg : int) : string list = 
   let prviUkaz, ostaliUkazi = 
     match ifl with
@@ -19,7 +21,7 @@ let drugiPrehod (ifl : lineSemantic list) (simtab : symtab) (opcodeTab : opcodeT
       failwith "prvi ukaz ni START"
   in
   let instructionList : string list = [] in (*instructionList shranjuje kode ukazov pretvorjene v stringe, ko se napolni se appenda k objectCodeList*)
-  let rec loop (ostaliUkazi : lineSemantic list) (objectCodeList : string list) (startAddr : int) (instructionList : string list) : string list = 
+  let rec loop (ostaliUkazi : lineSemantic list) (objectCodeList : string list) (startAddr : int) (instructionList : string list) (base_info : base_info) : string list = 
     match ostaliUkazi with
     | [] -> failwith "no END mnemonic at the end of the code!"
     | x :: _ when x.opcode = END -> (*write last text record to object programm*)
@@ -34,13 +36,13 @@ let drugiPrehod (ifl : lineSemantic list) (simtab : symtab) (opcodeTab : opcodeT
       | _ -> startAddr
       in
       match x.opcode with
-      | COMMENT -> loop xs objectCodeList newStartAddress instructionList 
+      | COMMENT -> loop xs objectCodeList newStartAddress instructionList base_info 
       | RESB | RESW -> (*dodamo trenutno TEXT vrstico k objektni kodi in inicializiramo novo*)
         let newTextLine = instructionList_to_objectCode (List.rev instructionList) newStartAddress in (*naredimo novo T vrstico*)
         begin
         match instructionList with (*če je instructionList prazen, npr. 2 zaporedna RESB ukaza, ne dodamo te prazne T vrstice v obj kodo*)
-        | [] -> loop xs objectCodeList newStartAddress []
+        | [] -> loop xs objectCodeList newStartAddress [] base_info
-        | _ -> loop xs (newTextLine :: objectCodeList) newStartAddress []
+        | _ -> loop xs (newTextLine :: objectCodeList) newStartAddress [] base_info
         end
       | BYTE -> 
         let operand = match x.mnem with | MnemonicSd s -> s | _ -> failwith "narobe mnemType za BYTE" in
@@ -48,29 +50,43 @@ let drugiPrehod (ifl : lineSemantic list) (simtab : symtab) (opcodeTab : opcodeT
         (*dodaj opcode v line, ce ni prostora dodaj line v file in naredi novega*)
         if List.length instructionList > 25 then (*če ratuje T zapis predolg dodamo še tole in nato nadaljujemo z novim*)
           let newTextLine = instructionList_to_objectCode (List.rev (opcode :: instructionList)) newStartAddress in (*naredimo novo T vrstico*)
-          loop xs (newTextLine :: objectCodeList) newStartAddress []
+          (print_text_line_instruction x.opcode x.mnem newTextLine;
+          loop xs (newTextLine :: objectCodeList) newStartAddress [] base_info)
         else
-          loop xs objectCodeList newStartAddress (opcode :: instructionList)
+          (print_text_line_instruction x.opcode x.mnem opcode;
+          loop xs objectCodeList newStartAddress (opcode :: instructionList) base_info)
       | WORD ->
         let operand = match x.mnem with | MnemonicSd s -> s | _ -> failwith "narobe mnemType za WORD" in
         let opcode = create_opcode_word operand in
         (*dodaj opcode v line, ce ni prostora dodaj line v file in naredi novega*)
         if List.length instructionList > 25 then (*če ratuje T zapis predolg dodamo še tole in nato nadaljujemo z novim*)
           let newTextLine = instructionList_to_objectCode (List.rev (opcode :: instructionList)) newStartAddress in (*naredimo novo T vrstico*)
-          loop xs (newTextLine :: objectCodeList) newStartAddress []
+          print_text_line_instruction x.opcode x.mnem opcode;
+          loop xs (newTextLine :: objectCodeList) newStartAddress [] base_info
         else
-          loop xs objectCodeList newStartAddress (opcode :: instructionList)       
+          loop xs objectCodeList newStartAddress (opcode :: instructionList) base_info 
+      |BASE -> 
+        let operand = match x.mnem with | MnemonicDn o -> int_of_string o | _ -> failwith "narobemnemType za BASE" in
+        let base_info = {is_base = true; valueB = operand} in 
+        loop xs objectCodeList newStartAddress [] base_info
+      |NOBASE ->
+        let base_info = {is_base = false; valueB = 0} in 
+        loop xs objectCodeList newStartAddress [] base_info
       | _ -> (*if not comment or reserve*)
           (*if simbol na mestu opeanda*)
         match operand_is_symbol x with
-        | None -> loop xs objectCodeList newStartAddress instructionList (*None -> ta ukaz se ne zapiše, ga skipamo*)
+        | None -> loop xs objectCodeList newStartAddress instructionList base_info(*None -> ta ukaz se ne zapiše, ga skipamo*)
         | Some (_, operand, formatLen) -> 
-            let opcode = create_opcode simtab opcodeTab x.opcode operand formatLen x.loc in
+            let opcode = create_opcode simtab opcodeTab x.opcode operand formatLen x.loc x.x x.n x.i base_info in
+            if opcode = "" then (*če je opcode prazen ga skipamo*)
+              (loop xs objectCodeList newStartAddress instructionList base_info)
             (*dodaj opcode v line, ce ni prostora dodaj line v file in naredi novega*)
-            if List.length instructionList > 25 then (*če ratuje T zapis predolg dodamo še tole in nato nadaljujemo z novim*)
+            else if List.length instructionList > 25 then (*če ratuje T zapis predolg dodamo še tole in nato nadaljujemo z novim*)
               let newTextLine = instructionList_to_objectCode (List.rev (opcode :: instructionList)) newStartAddress in (*naredimo novo T vrstico*)
-              loop xs (newTextLine :: objectCodeList) newStartAddress []
+              (print_text_line_instruction x.opcode x.mnem opcode;
+              loop xs (newTextLine :: objectCodeList) newStartAddress [] base_info)
             else
-              loop xs objectCodeList newStartAddress (opcode :: instructionList)
+              (print_text_line_instruction x.opcode x.mnem opcode;
+              loop xs objectCodeList newStartAddress (opcode :: instructionList) base_info)
 
-  in loop ostaliUkazi objectCodeList start instructionList
+  in loop ostaliUkazi objectCodeList start instructionList {is_base=false; valueB=0}

ass3/zbirnik/lib/instruction.ml

@@ -5,6 +5,12 @@ open SemanticAnalyzer
 open Simtab
 open OpcodeTable
 
+(*podatki o base naslavljanju*)
+type base_info = {
+  is_base : bool;
+  valueB : int
+}
+
 type operand = 
   | R of register
   | RR of register * register
@@ -54,12 +60,67 @@ let int_of_reg (reg : register) : int =
 let int_to_hex_width (width : int) (n : int) : string =
   let s = Printf.sprintf "%X" n in
   let len = String.length s in
-  if len >= width then s
+  if len >= width then (String.sub s (len - width) width)
   else String.make (width - len) '0' ^ s
 
 let char_to_hex c =
   Printf.sprintf "%02X" (Char.code c)
 
+(*preveri ali laho pc relativno nasljavljas in vrni disp*)
+let is_pc_relative (loc : int) (target : int) : bool * int =
+  let pc = loc + 3 in
+  let disp = target - pc in
+  if disp >= -2048 && disp <= 2047 then
+    (true, disp)
+  else
+    (false, 0)
+
+(*preveri ali lahko bazno naslavljamo*)
+let is_base_relative (target : int) (valueB : int) : bool * int = 
+  let disp = valueB - target in
+  if disp >= 0 && disp <= 4095 then
+    (true, disp)
+  else
+    (false, 0)
+
+(*preveri ali gre v direktno naslavljanje 0 <= addr <= 4095*)    
+let is_direct (target: int) : bool * int =
+  if target >= 0 && target <= 4095 then 
+    true, target
+  else
+    false, 0 
+
+(*vrne xbpe in disp*)
+let get_xbpe_disp (x : bool) (loc : int option) (target : int) (base_info : base_info) : int * int =
+  let location = match loc with | None -> failwith "location of instructin in None" | Some i -> i in
+  (*probamo pc relativno*)
+  let p, disp = is_pc_relative location target in
+  if p then 
+    let x_int = if x then 8 else 0 in 
+    let p_int = 2 in
+    let xbpe = x_int + p_int in
+    xbpe, disp
+  (*ce je bazno omogoceno in deluje*)
+  else
+
+  let b, disp = is_base_relative base_info.valueB target in
+  if base_info.is_base && b then
+  let x_int = if x then 8 else 0 in
+  let b_int = 4 in 
+  let xbpe = x_int + b_int in 
+  xbpe, disp 
+  (*če gre direktno*)
+  else
+  let direct, disp = is_direct target in
+  if direct then
+    let x_int = if x then 8 else 0 in 
+    let xbpe = x_int in
+    xbpe, disp
+  else
+    failwith (Printf.sprintf "No adressing mode is appropriate for target %d" target) 
+
+
+
 (*naredi binaren zapis F1 oz string nibblov celotnega ukaza*)
 let get_bin_instruction_F1 (opcode : int) : string = 
   int_to_hex_width 2 opcode
@@ -73,28 +134,50 @@ let get_bin_instruction_F2 (opcode : int) (operand : operand) : string =
   | N n ->  (int_to_hex_width 2 opcode) ^ (int_to_hex_width 1 n) ^ (int_to_hex_width 1 0)
   | _ -> failwith "invalid operand type for F2 instruction"
 
-let get_bin_instruction_F3 (opcode : int) (simtab : symtab) (operand : operand) (_ : int option) : string = 
+let get_bin_instruction_F3 (opcode : int) (simtab : symtab) (operand : operand)
+   (loc : int option) (x : bool) (n : bool) (i : bool) (base_info : base_info) : string = 
+  let oppcode_with_ni = match (n, i) with
+  | (false, false) -> opcode + 0
+  | (false, true) -> opcode + 1
+  | (true, false) -> opcode + 2
+  | (true, true ) -> opcode + 3
+  in
   match operand with
-  | None -> (int_to_hex_width 2 opcode) ^ (int_to_hex_width 4 0) (*RSUB damo z disp =  0*) 
+  | None -> (int_to_hex_width 2 oppcode_with_ni) ^ (int_to_hex_width 4 0) (*RSUB damo z disp =  0*) 
-  | N n -> (*todo dodaj n_i*) (int_to_hex_width 2 opcode) ^ (*todo add xbpe*) (int_to_hex_width 1 0) ^ (int_to_hex_width 3 n)
+  | N n -> 
-  | S s -> let operand = Hashtbl.find simtab s in (int_to_hex_width 2 opcode) ^ (int_to_hex_width 1 0) ^ (int_to_hex_width 3 operand)
+    let xbpe = if x then 8 else 0 in (*ce imamo stevilsko vrednost uporabimo direktno naslavljanje*)
+    (int_to_hex_width 2 oppcode_with_ni) ^ (int_to_hex_width 1 xbpe) ^ (int_to_hex_width 3 n)
+  | S s -> 
+    (*poiscemo naslov simbola, dolocimo xbpe in disp*)
+    let operand = Hashtbl.find simtab s in
+    let xbpe, disp = get_xbpe_disp x loc operand base_info in
+    (int_to_hex_width 2 oppcode_with_ni) ^ (int_to_hex_width 1 xbpe) ^ (int_to_hex_width 3 disp)
   | _ -> ""
 
-let get_bin_instruction_F4 (opcode : int) (simtab : symtab) (operand : operand) (_ : int option) : string = 
+let get_bin_instruction_F4 (opcode : int) (simtab : symtab) (operand : operand) (x : bool) (n : bool) (i : bool) : string = 
+  let oppcode_with_ni = match (n, i) with
+  | (false, false) -> opcode + 0
+  | (false, true) -> opcode + 1
+  | (true, false) -> opcode + 2
+  | (true, true ) -> opcode + 3
+  in
+  let xbpe = if x then 9 else 1 in (*pri F4 imamo le direktno, zato je p = 0, b = 0, e=1*)
   match operand with
-  | None -> (int_to_hex_width 2 opcode) ^ (int_to_hex_width 6 0) (*RSUB damo z disp =  0*) 
+  | None -> (int_to_hex_width 2 oppcode_with_ni) ^ (int_to_hex_width 6 0) (*RSUB damo z disp =  0*) 
-  | N n -> (*todo dodaj n_i*) (int_to_hex_width 2 opcode) ^ (*todo add xbpe*) (int_to_hex_width 1 0) ^ (int_to_hex_width 5 n)
+  | N n -> (int_to_hex_width 2 oppcode_with_ni) ^ (int_to_hex_width 1 xbpe) ^ (int_to_hex_width 5 n)
-  | S s -> let operand = Hashtbl.find simtab s in (int_to_hex_width 2 opcode) ^ (int_to_hex_width 1 0) ^ (int_to_hex_width 5 operand)
+  | S s -> let operand = Hashtbl.find simtab s in (int_to_hex_width 2 oppcode_with_ni) ^ (int_to_hex_width 1 xbpe) ^ (int_to_hex_width 5 operand)
   | _ -> ""
 
-let create_opcode (simtab : symtab) (opcodeTab : opcodeTab) (opcode : mnemonic) (operand : operand) (formatLen : int) (loc : int option) : string = 
+(*vrni bin zapis instrukcij tipa F1, F2, F3, F4*)
+let create_opcode (simtab : symtab) (opcodeTab : opcodeTab) (opcode : mnemonic)
+  (operand : operand) (formatLen : int) (loc : int option) (x : bool) (n : bool) (i : bool) (base_info: base_info): string = 
   (*izberi nacin naslavljanja in naredi string ukaza*)
   match formatLen with
   | 1 -> get_bin_instruction_F1 (find_opcode opcodeTab opcode) 
   | 2 -> get_bin_instruction_F2 (find_opcode opcodeTab opcode) operand
-  | 3 -> get_bin_instruction_F3 (find_opcode opcodeTab opcode) simtab operand loc
+  | 3 -> get_bin_instruction_F3 (find_opcode opcodeTab opcode) simtab operand loc x n i base_info
-  | 4 -> get_bin_instruction_F4 (find_opcode opcodeTab opcode) simtab operand loc
+  | 4 -> get_bin_instruction_F4 (find_opcode opcodeTab opcode) simtab operand x n i
-  | _ -> failwith "invalid formatLen"
+  | _ -> ""
 
 (*opcode BYTE direktive*)
 let create_opcode_byte (operand : string) : string =
@@ -142,3 +225,6 @@ let create_opcode_word (operand : string) : string =
         let n = int_of_string operand in
         Printf.sprintf "%06X" n
 
+
+let print_text_line_instruction (opcode : mnemonic) (mnem : mnemonic_type) (newTextLine : string) : unit =
+  Printf.printf "zbirali %s, %s -> %s\n" (string_of_mnemonic opcode) (string_of_mnemonic_type mnem) newTextLine