92 lines
No EOL
5.6 KiB
OCaml
92 lines
No EOL
5.6 KiB
OCaml
(*funkcija drugega prehoda*)
|
|
open Simtab
|
|
open SemanticAnalyzer
|
|
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
|
|
| [] -> failwith "empty code"
|
|
| x :: xs -> x, xs
|
|
in
|
|
(*if Opcode == start then*)
|
|
let objectCodeList, start = (*string list ki hrani vrstice objektne kode, start se uporabi še v E zapisu*)
|
|
if prviUkaz.opcode = START then
|
|
getZaglavjeAndStart prviUkaz lenProg
|
|
else
|
|
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) (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*)
|
|
let newTextLine = instructionList_to_objectCode (List.rev instructionList) startAddr in (*naredimo novo T vrstico*)
|
|
let endLine = getEnd start in (*naredimo End zapis*)
|
|
let objectCodeList = List.rev (endLine :: newTextLine :: objectCodeList) in
|
|
objectCodeList (*vrnemo celotno objektno kodo*)
|
|
| x :: xs ->
|
|
(*pridobi začeten naslov TEXT vrstice, če je le ta prazna*)
|
|
let newStartAddress = match instructionList with
|
|
| [] -> begin match x.loc with None -> failwith "ukaz nima lokacije!" | Some l -> l end
|
|
| _ -> startAddr
|
|
in
|
|
match x.opcode with
|
|
| 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 [] base_info
|
|
| _ -> loop xs (newTextLine :: objectCodeList) newStartAddress [] base_info
|
|
end
|
|
| BYTE ->
|
|
let operand = match x.mnem with | MnemonicSd s -> s | _ -> failwith "narobe mnemType za BYTE" in
|
|
let opcode = create_opcode_byte 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*)
|
|
(print_text_line_instruction x.opcode x.mnem newTextLine;
|
|
loop xs (newTextLine :: objectCodeList) newStartAddress [] base_info)
|
|
else
|
|
(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*)
|
|
print_text_line_instruction x.opcode x.mnem opcode;
|
|
loop xs (newTextLine :: objectCodeList) newStartAddress [] base_info
|
|
else
|
|
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 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 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*)
|
|
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*)
|
|
(print_text_line_instruction x.opcode x.mnem opcode;
|
|
loop xs (newTextLine :: objectCodeList) newStartAddress [] base_info)
|
|
else
|
|
(print_text_line_instruction x.opcode x.mnem opcode;
|
|
loop xs objectCodeList newStartAddress (opcode :: instructionList) base_info)
|
|
|
|
in loop ostaliUkazi objectCodeList start instructionList {is_base=false; valueB=0} |