fixed ass2

This commit is contained in:
Jaka Furlan 2025-12-08 12:08:50 +01:00
parent c707e3253c
commit 1bbc80de29
37 changed files with 753 additions and 18 deletions

View file

@ -1,5 +1,3 @@
arith START 0
start LDA x

21
ass1/fact.log Normal file
View file

@ -0,0 +1,21 @@
***** Section <default> *****
Stats: size=3127 blocks=3127 symbols=10 literals=0 relocations=0
Blocks
name start size #ins #dir #sto
<default> 00000 00C37 41 4 1
Symbols
name hex dec scope kind type description
fact 00000C 12 local relative code label
halt 000009 9 local relative code label
prog 000000 0 exported relative code label
rec 000018 24 local relative code label
sinit 000046 70 local relative code label
spop 000067 103 local relative code label
spush 000055 85 local relative code label
stkA 00007C 124 local relative data label
stkRESW 00007F 127 local relative data label
stkp 000079 121 local relative data label
Literals
label definition
Relocations
address length flag symbol

66
ass1/fact.lst Normal file
View file

@ -0,0 +1,66 @@
00000 prog START 0
00000 4B2043 JSUB sinit
00003 010005 LDA #5
00006 4B2003 JSUB fact
00009 3F2FFD halt J halt
. fakulteta
0000C 290001 fact COMP #1
0000F 372006 JGT rec
00012 010001 LDA #1 . base case
00015 4F0000 RSUB
00018 16205E rec STL @stkp
0001B 4B2037 JSUB spush
0001E 0E2058 STA @stkp
00021 4B2031 JSUB spush
00024 7A2052 STB @stkp
00027 4B202B JSUB spush
0002A AC03 RMO A,B . shrani n v B
0002C 1D0001 SUB #1 . n-1
0002F 4B2FDA JSUB fact . fact(n-1)
00032 9830 MULR B,A . n * fact(n-1)
00034 4B2030 JSUB spop
00037 6A203F LDB @stkp
0003A 4B202A JSUB spop
. LDA @stkp da ne povozimo odgovora?
0003D 4B2027 JSUB spop
00040 0A2036 LDL @stkp
00043 4F0000 RSUB
. rutine za sklad
00046 0F2033 sinit STA stkA
00049 012033 LDA #stkRESW . inicializiraj stkp
0004C 0F202A STA stkp
0004F 03202A LDA stkA
00052 4F0000 RSUB
00055 0F2024 spush STA stkA
00058 03201E LDA stkp . poveca stkp za 3
0005B 190003 ADD #3
0005E 0F2018 STA stkp
00061 032018 LDA stkA
00064 4F0000 RSUB
00067 0F2012 spop STA stkA
0006A 03200C LDA stkp . zmanjsa stkp za 3
0006D 1D0003 SUB #3
00070 0F2006 STA stkp
00073 032006 LDA stkA
00076 4F0000 RSUB
. podatki za sklad
00079 000000 stkp WORD 0
0007C 000000 stkA WORD 0
0007F 00....00 stkRESW RESW 1000
00C37 END prog

7
ass1/fact.obj Normal file
View file

@ -0,0 +1,7 @@
Hprog 000000000C37
T0000001E4B20430100054B20033F2FFD2900013720060100014F000016205E4B2037
T00001E1E0E20584B20317A20524B202BAC031D00014B2FDA98304B20306A203F4B20
T00003C1E2A4B20270A20364F00000F20330120330F202A03202A4F00000F20240320
T00005A1E1E1900030F20180320184F00000F201203200C1D00030F20060320064F00
T0000780700000000000000
E000000

View file

@ -17,7 +17,7 @@ start LDT x4
MULR S, A
ADDR T, A .do sedaj izračunano (((1x+2)x + 3)x + 4)x + 5
.fullline comment
STA rez
halt J halt

View file

@ -9,7 +9,7 @@ let state = Processor.{regs; memory}
let test_runner () =
let khz = 0.001 in
Processor.print_memory state 80;
Loader.load_object_file state "/mnt/c/Programiranje/SPO/ass1/arithr.obj";
Loader.load_object_file state "/mnt/c/Programiranje/SPO/ass1/fact.obj";
Processor.print_memory state 80;
Printf.printf "\n\n---Starting execution!---\n\n";
Pogajalnik.run state khz

View file

@ -85,7 +85,7 @@ let getOperandF3 (state : Processor.state) (nixbpe : nixbpe) (disp : int) : int
(*pridobi operand*)
let value =
if nixbpe.n = 1 && nixbpe.i = 1 then Processor.readMemAddr state ea (*direktno*)
else if nixbpe.n = 0 && nixbpe.i = 1 then disp (* immediate value *)
else if nixbpe.n = 0 && nixbpe.i = 1 then ea (* immediate value *)
else if nixbpe.n = 1 && nixbpe.i = 0 then Processor.readMemAddr state (Processor.readMemAddr state ea) (* indirect *)
else failwith "Invalid addressing mode"
in
@ -102,7 +102,7 @@ let getOperandF4 (state : Processor.state) (nixbpe : nixbpe) (disp : int) : int
(*pridobi operand*)
let value =
if nixbpe.n = 1 && nixbpe.i = 1 then Processor.readMemAddr state ea (*direktno*)
else if nixbpe.n = 0 && nixbpe.i = 1 then disp (* immediate value *)
else if nixbpe.n = 0 && nixbpe.i = 1 then ea (* immediate value *)
else if nixbpe.n = 1 && nixbpe.i = 0 then Processor.readMemAddr state (Processor.readMemAddr state ea) (* indirect *)
else failwith "Invalid addressing mode"
in
@ -191,9 +191,9 @@ let executeFormat3 (state : Processor.state) (nixbpe : nixbpe) (mnemonic: Opcode
| LDT -> IzvajalnikF3.ldt state operand
| LDX -> IzvajalnikF3.ldx state operand
| LPS -> notImplemented "LPS4"
| STA -> IzvajalnikF3.sta state operand
| STB -> IzvajalnikF3.stb state operand
| STCH -> IzvajalnikF3.stch state operand
| STA -> IzvajalnikF3.sta state ea
| STB -> IzvajalnikF3.stb state ea
| STCH -> IzvajalnikF3.stch state ea
| STF -> notImplemented "STF4"
| STL -> IzvajalnikF3.stl state ea
| STS -> IzvajalnikF3.sts state ea
@ -208,7 +208,7 @@ let executeFormat3 (state : Processor.state) (nixbpe : nixbpe) (mnemonic: Opcode
let executeFormat4 (state : Processor.state) (nixbpe : nixbpe) (mnemonic: OpcodeTable.mnemonic): unit =
let address = readAddress state in
let _, operand = getOperandF4 state nixbpe address in
let ea, operand = getOperandF4 state nixbpe address in
(*debugging*)
Printf.printf "[Izvajalnik/executeFormat4] Mnemonic: %s, nixbpe: %s, operand: %d = 0x%02X\n"
(string_of_mnemonic mnemonic) (string_of_nixbpe nixbpe) operand operand;
@ -246,15 +246,15 @@ let executeFormat4 (state : Processor.state) (nixbpe : nixbpe) (mnemonic: Opcode
| LDT -> IzvajalnikF4.ldt state operand
| LDX -> IzvajalnikF4.ldx state operand
| LPS -> notImplemented "LPS4"
| STA -> IzvajalnikF4.sta state operand
| STB -> IzvajalnikF4.stb state operand
| STA -> IzvajalnikF4.sta state ea
| STB -> IzvajalnikF4.stb state ea
| STCH -> notImplemented "STCH4"
| STF -> notImplemented "STF4"
| STL -> IzvajalnikF4.stl state operand
| STS -> IzvajalnikF4.sts state operand
| STSW -> IzvajalnikF4.stsw state operand
| STT -> IzvajalnikF4.stt state operand
| STX -> IzvajalnikF4.stx state operand
| STL -> IzvajalnikF4.stl state ea
| STS -> IzvajalnikF4.sts state ea
| STSW -> IzvajalnikF4.stsw state ea
| STT -> IzvajalnikF4.stt state ea
| STX -> IzvajalnikF4.stx state ea
(* Control / IO *)
| TIX -> IzvajalnikF3.tix state operand

View file

@ -10,7 +10,8 @@ let run (state : Processor.state) (khz : float) : unit =
(*printni stanje*)
Printf.printf "After execution:\n";
Processor.print_regs state;
Processor.print_memory state 80;
Processor.print_memory_pretty state 160;
Printf.printf "-----------------------------------\n";
flush stdout;
(*spi*)

View file

@ -98,6 +98,27 @@ let print_memory (state : state) (n : int) : unit =
done;
Printf.printf "\n"
let print_memory_pretty (state : state) (n : int) : unit =
let mem = state.memory in
let len = Bytes.length mem in
let limit = min n len in
Printf.printf "Memory dump (first %d bytes):\n" limit;
for i = 0 to limit - 1 do
(* Print address at the start of each row *)
if i mod 16 = 0 then
Printf.printf "%04X: " i;
let byte = Char.code (Bytes.get mem i) in
Printf.printf "%02X " byte;
(* Newline after 16 bytes *)
if (i + 1) mod 16 = 0 then Printf.printf "\n";
done;
(* Final newline if last line was incomplete *)
if limit mod 16 <> 0 then Printf.printf "\n"
let print_regs state : unit =
let regs = state.regs in
Printf.printf "A: %06X\n" regs.a;

Binary file not shown.

View file

@ -0,0 +1,28 @@
Clflags.include_dirs :=
[ "/home/jaka/.opam/default/lib/bytes"
; "/home/jaka/.opam/default/lib/findlib"
; "/home/jaka/.opam/default/lib/lambda-term"
; "/home/jaka/.opam/default/lib/logs"
; "/home/jaka/.opam/default/lib/logs/lwt"
; "/home/jaka/.opam/default/lib/lwt"
; "/home/jaka/.opam/default/lib/lwt/unix"
; "/home/jaka/.opam/default/lib/lwt_react"
; "/home/jaka/.opam/default/lib/mew"
; "/home/jaka/.opam/default/lib/mew_vi"
; "/home/jaka/.opam/default/lib/ocplib-endian"
; "/home/jaka/.opam/default/lib/ocplib-endian/bigstring"
; "/home/jaka/.opam/default/lib/react"
; "/home/jaka/.opam/default/lib/result"
; "/home/jaka/.opam/default/lib/trie"
; "/home/jaka/.opam/default/lib/uchar"
; "/home/jaka/.opam/default/lib/utop"
; "/home/jaka/.opam/default/lib/uucp"
; "/home/jaka/.opam/default/lib/uuseg"
; "/home/jaka/.opam/default/lib/uutf"
; "/home/jaka/.opam/default/lib/xdg"
; "/home/jaka/.opam/default/lib/zed"
; "/usr/lib/ocaml/compiler-libs"
; "/usr/lib/ocaml/threads"
; "/mnt/c/Programiranje/SPO/ass3/zbirnik/_build/default/lib/.zbirnik.objs/byte"
];
UTop_main.main ();

Binary file not shown.

View file

@ -0,0 +1 @@
lib/semanticAnalyzer.ml: List Parser Printf String

View file

@ -0,0 +1,291 @@
(*prebere parsano kodo in izvede semantično analizo*)
type register = | A | X | L | B | S | T | F | PC | SW
let parse_register = function
| "A" -> A | "X" -> X | "L" -> L | "B" -> B
| "S" -> S | "T" -> T | "F" -> F | "PC" -> PC | "SW" -> SW
| r -> failwith ("Unknown register: " ^ r)
type mnemonic_type =
| MnemonicD (* direktiva brez operandov (NOBASE, LTORG) *)
| MnemonicDn of string (* direktiva z enim številskim operandom (lahko tudi simbol) (START, END, ORG, EQU) *)
| MnemonicF1 (* ukaza formata 1 (brez operandov) (FIX, FLOAT, ...) *)
| MnemonicF2n of int (* F2 z enim številskim operandom (SVC) *)
| MnemonicF2r of register (* F2 z enim registrskim operandom (CLEAR, TIXR) *)
| MnemonicF2rn of register * int (* F2 z enim registrskim in enim številskim operandom (SHIFTL, SHIFTR) *)
| MnemonicF2rr of register * register(* F2 z dvema registrskima operandoma (ADDR, SUBR, ...) *)
| MnemonicF3 (* F3 brez operandov (RSUB) *)
| MnemonicF3m of string(* F3 z enim operandom (LDA, STA, ...) *)
| MnemonicF4m of string (* F4 z enim operandom (+LDA, +STA, ...) *)
| MnemonicSd of string (* pomnilniška direktiva s podatki (BYTE, WORD) *)
| MnemonicSn of int(* pomnilniška direktiva za rezervacijo (RESB, RESW) *)
| COMMENT
(* Print mnemonic_type as string *)
let string_of_mnemonic_type = function
| MnemonicD -> "MnemonicD"
| MnemonicDn s -> "MnemonicDn(" ^ s ^ ")"
| MnemonicF1 -> "MnemonicF1"
| MnemonicF2n n -> "MnemonicF2n(" ^ string_of_int n ^ ")"
| MnemonicF2r _ -> "MnemonicF2r"
| MnemonicF2rn (_, _) -> "MnemonicF2rn"
| MnemonicF2rr (_, _) -> "MnemonicF2rr"
| MnemonicF3 -> "MnemonicF3"
| MnemonicF3m s -> "MnemonicF3m(" ^ s ^ ")"
| MnemonicF4m s -> "MnemonicF4m(" ^ s ^ ")"
| MnemonicSd s -> "MnemonicSd(" ^ s ^ ")"
| MnemonicSn n -> "MnemonicSn(" ^ string_of_int n ^ ")"
| COMMENT -> "Comment"
let get_string_from_mnemType (m : mnemonic_type) : string option =
match m with
| MnemonicDn s
| MnemonicF3m s
| MnemonicF4m s
| MnemonicSd s -> Some s
| _ -> None
type mnemonic =
(* ------------------- Format 1 instructions ------------------- *)
| FIX | FLOAT | HIO | NORM | SIO | TIO
(* ------------------- Format 2 instructions ------------------- *)
| ADDR | CLEAR | COMPR | DIVR | MULR | RMO
| SHIFTL | SHIFTR | SUBR | SVC | TIXR
(* ------------------- Format 3/4 instructions ------------------- *)
| ADD | ADDF | AND | COMP | COMPF | DIV
| J | JEQ | JGT | JLT | JSUB | LDA | LDB | LDCH | LDF
| LDL | LDS | LDT | LDX | LPS | MUL | OR | RD
| RSUB | STA | STB | STCH | STF | STL | STS | STSW
| STT | STX | SUB | SUBF | TD | TIX | WD
(* ------------------- SIC/XE Directives ------------------- *)
| START (* Set program starting address *)
| END (* End of program *)
| ORG (* Set location counter *)
| EQU (* Define a symbol *)
| BASE (* Set base register *)
| NOBASE (* Clear base register *)
| LTORG (* Literal pool *)
| RESW (* Reserve words *)
| RESB (* Reserve bytes *)
| WORD (* Define a word *)
| BYTE (* Define a byte or character constant *)
(*comment -> for ignoring full line comments*)
|COMMENT
let string_of_mnemonic = function
(* ------------------- Format 1 instructions ------------------- *)
| FIX -> "FIX" | FLOAT -> "FLOAT" | HIO -> "HIO" | NORM -> "NORM"
| SIO -> "SIO" | TIO -> "TIO"
(* ------------------- Format 2 instructions ------------------- *)
| ADDR -> "ADDR" | CLEAR -> "CLEAR" | COMPR -> "COMPR" | DIVR -> "DIVR"
| MULR -> "MULR" | RMO -> "RMO" | SHIFTL -> "SHIFTL" | SHIFTR -> "SHIFTR"
| SUBR -> "SUBR" | SVC -> "SVC" | TIXR -> "TIXR"
(* ------------------- Format 3/4 instructions ------------------- *)
| ADD -> "ADD" | ADDF -> "ADDF" | AND -> "AND" | COMP -> "COMP"
| COMPF -> "COMPF" | DIV -> "DIV" | J -> "J" | JEQ -> "JEQ" | JGT -> "JGT"
| JLT -> "JLT" | JSUB -> "JSUB" | LDA -> "LDA" | LDB -> "LDB" | LDCH -> "LDCH"
| LDF -> "LDF" | LDL -> "LDL" | LDS -> "LDS" | LDT -> "LDT" | LDX -> "LDX"
| LPS -> "LPS" | MUL -> "MUL" | OR -> "OR" | RD -> "RD" | RSUB -> "RSUB"
| STA -> "STA" | STB -> "STB" | STCH -> "STCH" | STF -> "STF" | STL -> "STL"
| STS -> "STS" | STSW -> "STSW" | STT -> "STT" | STX -> "STX" | SUB -> "SUB"
| SUBF -> "SUBF" | TD -> "TD" | TIX -> "TIX" | WD -> "WD"
(* ------------------- SIC/XE Directives ------------------- *)
| START -> "START" | END -> "END" | ORG -> "ORG" | EQU -> "EQU"
| BASE -> "BASE" | NOBASE -> "NOBASE" | LTORG -> "LTORG"
| RESW -> "RESW" | RESB -> "RESB" | WORD -> "WORD" | BYTE -> "BYTE"
(*comment*)
| COMMENT -> "COMMENT"
type lineSemantic = {
line_no : int;
label : string option;
ext : bool; (*za razlikovanje med F3 in F4*)
opcode : mnemonic;
mnem : mnemonic_type;
comment : string option;
len : int; (*dolžina, pove za koliko moramo povečati locctr*)
mutable loc : int option; (* assigned in pass1 *)
}
open Parser
let getMnem (opcode : string) : mnemonic * bool =
(*preveri če gre za ext in odstrani +*)
let opcode, ext = if opcode.[0] = '+' then String.sub opcode 1 (String.length opcode - 1), true else opcode, false in
let o =
match opcode with
(* ------------------- Format 1 instructions ------------------- *)
| "FIX" -> FIX
| "FLOAT" -> FLOAT
| "HIO" -> HIO
| "NORM" -> NORM
| "SIO" -> SIO
| "TIO" -> TIO
(* ------------------- Format 2 instructions ------------------- *)
| "ADDR" -> ADDR
| "CLEAR" -> CLEAR
| "COMPR" -> COMPR
| "DIVR" -> DIVR
| "MULR" -> MULR
| "RMO" -> RMO
| "SHIFTL" -> SHIFTL
| "SHIFTR" -> SHIFTR
| "SUBR" -> SUBR
| "SVC" -> SVC
| "TIXR" -> TIXR
(* ------------------- Format 3/4 instructions ------------------- *)
| "ADD" -> ADD
| "ADDF" -> ADDF
| "AND" -> AND
| "COMP" -> COMP
| "COMPF" -> COMPF
| "DIV" -> DIV
| "J" -> J
| "JEQ" -> JEQ
| "JGT" -> JGT
| "JLT" -> JLT
| "JSUB" -> JSUB
| "LDA" -> LDA
| "LDB" -> LDB
| "LDCH" -> LDCH
| "LDF" -> LDF
| "LDL" -> LDL
| "LDS" -> LDS
| "LDT" -> LDT
| "LDX" -> LDX
| "LPS" -> LPS
| "MUL" -> MUL
| "OR" -> OR
| "RD" -> RD
| "RSUB" -> RSUB
| "STA" -> STA
| "STB" -> STB
| "STCH" -> STCH
| "STF" -> STF
| "STL" -> STL
| "STS" -> STS
| "STSW" -> STSW
| "STT" -> STT
| "STX" -> STX
| "SUB" -> SUB
| "SUBF" -> SUBF
| "TD" -> TD
| "TIX" -> TIX
| "WD" -> WD
(* ------------------- SIC/XE Directives ------------------- *)
| "START" -> START
| "END" -> END
| "ORG" -> ORG
| "EQU" -> EQU
| "BASE" -> BASE
| "NOBASE" -> NOBASE
| "LTORG" -> LTORG
| "RESW" -> RESW
| "RESB" -> RESB
| "WORD" -> WORD
| "BYTE" -> BYTE
(*comment*)
| "COMMENT" -> COMMENT
| _ -> failwith ("Unknown opcode: " ^ opcode)
in
o, ext (*vrnemo opcode in extended*)
let getMnemType (opcode : mnemonic) (ext : bool) (operand : string list) : mnemonic_type =
match opcode, operand with
|COMMENT, _ -> COMMENT
(* ------------------- Format 1 ------------------- *)
| (FIX | FLOAT | HIO | NORM | SIO | TIO), [] ->
MnemonicF1
| (FIX | FLOAT | HIO | NORM | SIO | TIO), _ ->
failwith (Printf.sprintf "%s takes no operands, but got %d"
(string_of_mnemonic opcode) (List.length operand))
(* ------------------- Format 2 ------------------- *)
| (SVC), [n] ->
MnemonicF2n (int_of_string n)
| SVC, _ -> failwith "SVC requires exactly 1 numeric operand"
| (CLEAR | TIXR), [r] ->
MnemonicF2r (parse_register r)
| (CLEAR | TIXR), _ -> failwith (Printf.sprintf "%s requires 1 register" (string_of_mnemonic opcode))
| (SHIFTL | SHIFTR), [r; n] ->
MnemonicF2rn (parse_register r, int_of_string n)
| (SHIFTL | SHIFTR), _ -> failwith "SHIFTL/SHIFTR require 2 operands: reg, number"
| (ADDR | COMPR | DIVR | MULR | RMO | SUBR), [r1; r2] ->
MnemonicF2rr (parse_register r1, parse_register r2)
| (ADDR | COMPR | DIVR | MULR | RMO | SUBR), _ ->
failwith (Printf.sprintf "%s requires 2 registers" (string_of_mnemonic opcode))
(* ------------------- Directives ------------------- *)
| (START | END | ORG | EQU), [opd] -> MnemonicDn opd
| (START | END | ORG | EQU), _ ->
failwith (Printf.sprintf "%s requires exactly 1 operand" (string_of_mnemonic opcode))
| (NOBASE | LTORG), [] -> MnemonicD
| (NOBASE | LTORG), _ ->
failwith (Printf.sprintf "%s takes no operands" (string_of_mnemonic opcode))
| (BASE), [opd] -> MnemonicDn opd
| BASE, _ ->
failwith "BASE directive requires exactly 1 operand"
| (RESB | RESW), [n] -> MnemonicSn (int_of_string n)
| (RESB | RESW), _ ->
failwith (Printf.sprintf "%s requires exactly 1 numeric operand" (string_of_mnemonic opcode))
| (WORD | BYTE), [opd] -> MnemonicSd opd
| (WORD | BYTE), _ ->
failwith (Printf.sprintf "%s requires exactly 1 operand" (string_of_mnemonic opcode))
(* ------------------- Format 4 (extended) ------------------- *)
| (ADD | ADDF | AND | COMP | COMPF | DIV
| J | JEQ | JGT | JLT | JSUB | LDA | LDB | LDCH | LDF
| LDL | LDS | LDT | LDX | LPS | MUL | OR | RD
| STA | STB | STCH | STF | STL | STS | STSW
| STT | STX | SUB | SUBF | TD | TIX | WD), [opd] when ext ->
MnemonicF4m opd
(* ------------------- Format 3 ------------------- *)
| RSUB, [] -> MnemonicF3
| RSUB, _ -> failwith "RSUB takes no operands"
| (ADD | ADDF | AND | COMP | COMPF | DIV
| J | JEQ | JGT | JLT | JSUB | LDA | LDB | LDCH | LDF
| LDL | LDS | LDT | LDX | LPS | MUL | OR | RD
| STA | STB | STCH | STF | STL | STS | STSW
| STT | STX | SUB | SUBF | TD | TIX | WD), [opd] ->
MnemonicF3m opd
| _, _ -> failwith (Printf.sprintf "Invalid operands for opcode %s: %d operands"
(string_of_mnemonic opcode) (List.length operand))
let getLen (mnem : mnemonic) (ext : bool) (mnemType : mnemonic_type) : int =
42 (*TODO*)
let checkLineSemantic (line : line) : lineSemantic =
let mnem, ext = getMnem line.opcode in
let mnemType = getMnemType mnem ext line.operand in
let dolzina = getLen mnem ext mnemType in
{line_no = line.line_no; label = line.label; ext = ext; opcode = mnem; mnem = mnemType; comment = line.comment; len = dolzina; loc = line.loc}
let checkLineSemanticOfCode (code : line list) : lineSemantic list =
List.map (checkLineSemantic) code

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

View file

@ -0,0 +1,8 @@
lib: [
"_build/install/default/lib/zbirnik/META"
"_build/install/default/lib/zbirnik/dune-package"
"_build/install/default/lib/zbirnik/opam"
]
bin: [
"_build/install/default/bin/zbirnik"
]

View file

@ -0,0 +1 @@
../../../default/bin/main.exe

View file

@ -0,0 +1,291 @@
(*prebere parsano kodo in izvede semantično analizo*)
type register = | A | X | L | B | S | T | F | PC | SW
let parse_register = function
| "A" -> A | "X" -> X | "L" -> L | "B" -> B
| "S" -> S | "T" -> T | "F" -> F | "PC" -> PC | "SW" -> SW
| r -> failwith ("Unknown register: " ^ r)
type mnemonic_type =
| MnemonicD (* direktiva brez operandov (NOBASE, LTORG) *)
| MnemonicDn of string (* direktiva z enim številskim operandom (lahko tudi simbol) (START, END, ORG, EQU) *)
| MnemonicF1 (* ukaza formata 1 (brez operandov) (FIX, FLOAT, ...) *)
| MnemonicF2n of int (* F2 z enim številskim operandom (SVC) *)
| MnemonicF2r of register (* F2 z enim registrskim operandom (CLEAR, TIXR) *)
| MnemonicF2rn of register * int (* F2 z enim registrskim in enim številskim operandom (SHIFTL, SHIFTR) *)
| MnemonicF2rr of register * register(* F2 z dvema registrskima operandoma (ADDR, SUBR, ...) *)
| MnemonicF3 (* F3 brez operandov (RSUB) *)
| MnemonicF3m of string(* F3 z enim operandom (LDA, STA, ...) *)
| MnemonicF4m of string (* F4 z enim operandom (+LDA, +STA, ...) *)
| MnemonicSd of string (* pomnilniška direktiva s podatki (BYTE, WORD) *)
| MnemonicSn of int(* pomnilniška direktiva za rezervacijo (RESB, RESW) *)
| COMMENT
(* Print mnemonic_type as string *)
let string_of_mnemonic_type = function
| MnemonicD -> "MnemonicD"
| MnemonicDn s -> "MnemonicDn(" ^ s ^ ")"
| MnemonicF1 -> "MnemonicF1"
| MnemonicF2n n -> "MnemonicF2n(" ^ string_of_int n ^ ")"
| MnemonicF2r _ -> "MnemonicF2r"
| MnemonicF2rn (_, _) -> "MnemonicF2rn"
| MnemonicF2rr (_, _) -> "MnemonicF2rr"
| MnemonicF3 -> "MnemonicF3"
| MnemonicF3m s -> "MnemonicF3m(" ^ s ^ ")"
| MnemonicF4m s -> "MnemonicF4m(" ^ s ^ ")"
| MnemonicSd s -> "MnemonicSd(" ^ s ^ ")"
| MnemonicSn n -> "MnemonicSn(" ^ string_of_int n ^ ")"
| COMMENT -> "Comment"
let get_string_from_mnemType (m : mnemonic_type) : string option =
match m with
| MnemonicDn s
| MnemonicF3m s
| MnemonicF4m s
| MnemonicSd s -> Some s
| _ -> None
type mnemonic =
(* ------------------- Format 1 instructions ------------------- *)
| FIX | FLOAT | HIO | NORM | SIO | TIO
(* ------------------- Format 2 instructions ------------------- *)
| ADDR | CLEAR | COMPR | DIVR | MULR | RMO
| SHIFTL | SHIFTR | SUBR | SVC | TIXR
(* ------------------- Format 3/4 instructions ------------------- *)
| ADD | ADDF | AND | COMP | COMPF | DIV
| J | JEQ | JGT | JLT | JSUB | LDA | LDB | LDCH | LDF
| LDL | LDS | LDT | LDX | LPS | MUL | OR | RD
| RSUB | STA | STB | STCH | STF | STL | STS | STSW
| STT | STX | SUB | SUBF | TD | TIX | WD
(* ------------------- SIC/XE Directives ------------------- *)
| START (* Set program starting address *)
| END (* End of program *)
| ORG (* Set location counter *)
| EQU (* Define a symbol *)
| BASE (* Set base register *)
| NOBASE (* Clear base register *)
| LTORG (* Literal pool *)
| RESW (* Reserve words *)
| RESB (* Reserve bytes *)
| WORD (* Define a word *)
| BYTE (* Define a byte or character constant *)
(*comment -> for ignoring full line comments*)
|COMMENT
let string_of_mnemonic = function
(* ------------------- Format 1 instructions ------------------- *)
| FIX -> "FIX" | FLOAT -> "FLOAT" | HIO -> "HIO" | NORM -> "NORM"
| SIO -> "SIO" | TIO -> "TIO"
(* ------------------- Format 2 instructions ------------------- *)
| ADDR -> "ADDR" | CLEAR -> "CLEAR" | COMPR -> "COMPR" | DIVR -> "DIVR"
| MULR -> "MULR" | RMO -> "RMO" | SHIFTL -> "SHIFTL" | SHIFTR -> "SHIFTR"
| SUBR -> "SUBR" | SVC -> "SVC" | TIXR -> "TIXR"
(* ------------------- Format 3/4 instructions ------------------- *)
| ADD -> "ADD" | ADDF -> "ADDF" | AND -> "AND" | COMP -> "COMP"
| COMPF -> "COMPF" | DIV -> "DIV" | J -> "J" | JEQ -> "JEQ" | JGT -> "JGT"
| JLT -> "JLT" | JSUB -> "JSUB" | LDA -> "LDA" | LDB -> "LDB" | LDCH -> "LDCH"
| LDF -> "LDF" | LDL -> "LDL" | LDS -> "LDS" | LDT -> "LDT" | LDX -> "LDX"
| LPS -> "LPS" | MUL -> "MUL" | OR -> "OR" | RD -> "RD" | RSUB -> "RSUB"
| STA -> "STA" | STB -> "STB" | STCH -> "STCH" | STF -> "STF" | STL -> "STL"
| STS -> "STS" | STSW -> "STSW" | STT -> "STT" | STX -> "STX" | SUB -> "SUB"
| SUBF -> "SUBF" | TD -> "TD" | TIX -> "TIX" | WD -> "WD"
(* ------------------- SIC/XE Directives ------------------- *)
| START -> "START" | END -> "END" | ORG -> "ORG" | EQU -> "EQU"
| BASE -> "BASE" | NOBASE -> "NOBASE" | LTORG -> "LTORG"
| RESW -> "RESW" | RESB -> "RESB" | WORD -> "WORD" | BYTE -> "BYTE"
(*comment*)
| COMMENT -> "COMMENT"
type lineSemantic = {
line_no : int;
label : string option;
ext : bool; (*za razlikovanje med F3 in F4*)
opcode : mnemonic;
mnem : mnemonic_type;
comment : string option;
len : int; (*dolžina, pove za koliko moramo povečati locctr*)
mutable loc : int option; (* assigned in pass1 *)
}
open Parser
let getMnem (opcode : string) : mnemonic * bool =
(*preveri če gre za ext in odstrani +*)
let opcode, ext = if opcode.[0] = '+' then String.sub opcode 1 (String.length opcode - 1), true else opcode, false in
let o =
match opcode with
(* ------------------- Format 1 instructions ------------------- *)
| "FIX" -> FIX
| "FLOAT" -> FLOAT
| "HIO" -> HIO
| "NORM" -> NORM
| "SIO" -> SIO
| "TIO" -> TIO
(* ------------------- Format 2 instructions ------------------- *)
| "ADDR" -> ADDR
| "CLEAR" -> CLEAR
| "COMPR" -> COMPR
| "DIVR" -> DIVR
| "MULR" -> MULR
| "RMO" -> RMO
| "SHIFTL" -> SHIFTL
| "SHIFTR" -> SHIFTR
| "SUBR" -> SUBR
| "SVC" -> SVC
| "TIXR" -> TIXR
(* ------------------- Format 3/4 instructions ------------------- *)
| "ADD" -> ADD
| "ADDF" -> ADDF
| "AND" -> AND
| "COMP" -> COMP
| "COMPF" -> COMPF
| "DIV" -> DIV
| "J" -> J
| "JEQ" -> JEQ
| "JGT" -> JGT
| "JLT" -> JLT
| "JSUB" -> JSUB
| "LDA" -> LDA
| "LDB" -> LDB
| "LDCH" -> LDCH
| "LDF" -> LDF
| "LDL" -> LDL
| "LDS" -> LDS
| "LDT" -> LDT
| "LDX" -> LDX
| "LPS" -> LPS
| "MUL" -> MUL
| "OR" -> OR
| "RD" -> RD
| "RSUB" -> RSUB
| "STA" -> STA
| "STB" -> STB
| "STCH" -> STCH
| "STF" -> STF
| "STL" -> STL
| "STS" -> STS
| "STSW" -> STSW
| "STT" -> STT
| "STX" -> STX
| "SUB" -> SUB
| "SUBF" -> SUBF
| "TD" -> TD
| "TIX" -> TIX
| "WD" -> WD
(* ------------------- SIC/XE Directives ------------------- *)
| "START" -> START
| "END" -> END
| "ORG" -> ORG
| "EQU" -> EQU
| "BASE" -> BASE
| "NOBASE" -> NOBASE
| "LTORG" -> LTORG
| "RESW" -> RESW
| "RESB" -> RESB
| "WORD" -> WORD
| "BYTE" -> BYTE
(*comment*)
| "COMMENT" -> COMMENT
| _ -> failwith ("Unknown opcode: " ^ opcode)
in
o, ext (*vrnemo opcode in extended*)
let getMnemType (opcode : mnemonic) (ext : bool) (operand : string list) : mnemonic_type =
match opcode, operand with
|COMMENT, _ -> COMMENT
(* ------------------- Format 1 ------------------- *)
| (FIX | FLOAT | HIO | NORM | SIO | TIO), [] ->
MnemonicF1
| (FIX | FLOAT | HIO | NORM | SIO | TIO), _ ->
failwith (Printf.sprintf "%s takes no operands, but got %d"
(string_of_mnemonic opcode) (List.length operand))
(* ------------------- Format 2 ------------------- *)
| (SVC), [n] ->
MnemonicF2n (int_of_string n)
| SVC, _ -> failwith "SVC requires exactly 1 numeric operand"
| (CLEAR | TIXR), [r] ->
MnemonicF2r (parse_register r)
| (CLEAR | TIXR), _ -> failwith (Printf.sprintf "%s requires 1 register" (string_of_mnemonic opcode))
| (SHIFTL | SHIFTR), [r; n] ->
MnemonicF2rn (parse_register r, int_of_string n)
| (SHIFTL | SHIFTR), _ -> failwith "SHIFTL/SHIFTR require 2 operands: reg, number"
| (ADDR | COMPR | DIVR | MULR | RMO | SUBR), [r1; r2] ->
MnemonicF2rr (parse_register r1, parse_register r2)
| (ADDR | COMPR | DIVR | MULR | RMO | SUBR), _ ->
failwith (Printf.sprintf "%s requires 2 registers" (string_of_mnemonic opcode))
(* ------------------- Directives ------------------- *)
| (START | END | ORG | EQU), [opd] -> MnemonicDn opd
| (START | END | ORG | EQU), _ ->
failwith (Printf.sprintf "%s requires exactly 1 operand" (string_of_mnemonic opcode))
| (NOBASE | LTORG), [] -> MnemonicD
| (NOBASE | LTORG), _ ->
failwith (Printf.sprintf "%s takes no operands" (string_of_mnemonic opcode))
| (BASE), [opd] -> MnemonicDn opd
| BASE, _ ->
failwith "BASE directive requires exactly 1 operand"
| (RESB | RESW), [n] -> MnemonicSn (int_of_string n)
| (RESB | RESW), _ ->
failwith (Printf.sprintf "%s requires exactly 1 numeric operand" (string_of_mnemonic opcode))
| (WORD | BYTE), [opd] -> MnemonicSd opd
| (WORD | BYTE), _ ->
failwith (Printf.sprintf "%s requires exactly 1 operand" (string_of_mnemonic opcode))
(* ------------------- Format 4 (extended) ------------------- *)
| (ADD | ADDF | AND | COMP | COMPF | DIV
| J | JEQ | JGT | JLT | JSUB | LDA | LDB | LDCH | LDF
| LDL | LDS | LDT | LDX | LPS | MUL | OR | RD
| STA | STB | STCH | STF | STL | STS | STSW
| STT | STX | SUB | SUBF | TD | TIX | WD), [opd] when ext ->
MnemonicF4m opd
(* ------------------- Format 3 ------------------- *)
| RSUB, [] -> MnemonicF3
| RSUB, _ -> failwith "RSUB takes no operands"
| (ADD | ADDF | AND | COMP | COMPF | DIV
| J | JEQ | JGT | JLT | JSUB | LDA | LDB | LDCH | LDF
| LDL | LDS | LDT | LDX | LPS | MUL | OR | RD
| STA | STB | STCH | STF | STL | STS | STSW
| STT | STX | SUB | SUBF | TD | TIX | WD), [opd] ->
MnemonicF3m opd
| _, _ -> failwith (Printf.sprintf "Invalid operands for opcode %s: %d operands"
(string_of_mnemonic opcode) (List.length operand))
let getLen (mnem : mnemonic) (ext : bool) (mnemType : mnemonic_type) : int =
42 (*TODO*)
let checkLineSemantic (line : line) : lineSemantic =
let mnem, ext = getMnem line.opcode in
let mnemType = getMnemType mnem ext line.operand in
let dolzina = getLen mnem ext mnemType in
{line_no = line.line_no; label = line.label; ext = ext; opcode = mnem; mnem = mnemType; comment = line.comment; len = dolzina; loc = line.loc}
let checkLineSemanticOfCode (code : line list) : lineSemantic list =
List.map (checkLineSemantic) code