CC/codefragments.ml at master · RSAsterix/CC · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
open Printf
open Types
open String
open Typechecker_types


let empty_fun = {id="henkst";bound=SS.empty;t=Void;locals=Env_var.empty}

let heapstart = 2000
let truenr =(-1)

let pointlabel l = l^": "
let brf l = "brf "^l^" \n"
let endiflabel fid i = sprintf "endif%s%i" fid i
let bra l = "bra "^l^" \n"
let endelselabel fid i = sprintf "endelse%s%i" fid i
let startwhilelabel fid i= sprintf "startwhile%s%i" fid i
let brt l = "brt "^l^" \n"
let endwhilelabel fid i = (sprintf "endwhile%s%i" fid i)


let reservelocalcode i = sprintf "link %i \n" i

let rec reservecode i =
"ldr HP \n"^
(sprintf "ldc %i \n" i)^
"add \n"^
"str HP \n"

type idstruct = {
	global: bool;
	vartype: types;
	id: string;
	index: int;
	}

let empty_idstruct = {global=false;vartype=Int;id="henkst";index=20}

let code_set id =
	if id.global then
		(sprintf "ldc %i \n" heapstart)^
		(sprintf "sta %i \n" id.index)
	else
		sprintf "stl %i \n" id.index

let code_get id =
	if id.global then
		(sprintf "ldc %i \n" heapstart)^
		(sprintf "lda %i \n" id.index)
	else
		sprintf "ldl %i \n" id.index

let return_some_code =
  "str RR \n"^
	"unlink \n"^
	"ret \n"

let return_none_code  =
  "unlink \n"^
	"ret \n"

(* De nieuwe headwaarde en de oude listpointer staan al op de stack *)
(* returnt de nieuwe listpointer *)
let listappendcode = "stmh 2 \n"

let create_tuplecode ="stmh 2 \n"

let ldc x = sprintf "ldc %i \n" x

let lda x = sprintf "lda %i \n" x

let sta x = sprintf "sta %i \n" x

let op1code  = function
	| Not -> "not \n"
	| Neg -> "neg \n"

let some_funcallcode id arglength=
"bsr "^id^" \n"^
(sprintf "ajs -%i \n" arglength)^
"ldr RR \n"

let none_funcallcode id arglength=
"bsr "^id^" \n"^
(sprintf "ajs -%i \n" arglength)

let op2code = function
	| Listop ->  listappendcode
	| Logop And -> "and \n"
	| Logop Or -> "or \n"
	| Eqop Eq -> "eq \n"
	| Eqop Neq -> "ne \n"
	| Compop Less -> "lt \n"
	| Compop Greater -> "gt \n"
	| Compop LeEq -> "le \n"
	| Compop GrEq -> "ge \n"
	| Strongop Times -> "mul \n"
	| Strongop Divide -> "div \n"
	| Strongop Modulo -> "mod \n"
	| Weakop Plus -> "add \n"
	| Weakop Minus -> "sub \n"

let end_code =
"ldr RR \n"^
"trap 0 \n"^
"halt \n"

let read_code =
"read: link 0 \n"^
"trap 10 \n"^
"str RR \n"^
"unlink \n"^
"ret \n"

let write_code =
"write: link 0 \n"^
"ldl -2 \n"^
"trap 0 \n"^
"unlink \n"^
"ret \n"

let isempty_code =
"isEmpty: link 0 \n"^
"ldc 0 \n"^
"ldl -2 \n"^
"eq \n"^
"brf endifisempty \n"^
(sprintf "ldc %i \n" truenr)^
"str RR \n"^
"unlink \n"^
"ret \n"^
"endifisempty: ldc 0 \n"^
"str RR \n"^
"unlink \n"^
"ret \n"