summaryrefslogtreecommitdiff
path: root/emit.fun
blob: 05e84f00ef28cc860edaf170cbad4f51a237d157 (plain)
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
137
138
139
140
functor Emit(I: IL) = struct
  structure I = I

  structure P = I.P
  structure D = P.D
  structure PP = P.P

  val file = ref NONE

  local
    fun output s =
    let
      val outstream = valOf $ !file
    in
      TextIO.output (outstream, s)
    end

    val ctx = ((false, makePrintfBase output),
      fn (_: bool * ((string -> unit) * (unit -> unit))) => ())
  in
    fun fprint g = Fold.fold ctx g
  end

  fun fprintt g = fprint `"\t" g

  fun fprinttn g =
    fprintt (fn (a, _) => g (a, fn (_, out) => (Printf out `"\n" %)))

  fun handleBSS objsZI =
  let
    val () = fprint `"section .bss\n" %

    fun handleObj (id, _, t, _, _) =
    let
      val align = P.alignOfType t
      val size = P.sizeOfType t
    in
      fprinttn `"align\t" W align %;
      fprint PP.? id `":\tresb " W size `"\n" %
    end
  in
    List.app handleObj objsZI
  end

  fun dd size w =
  let
    val cmd =
      case size of
        0w1 => "db"
      | 0w2 => "dw"
      | 0w4 => "dd"
      | 0w8 => "dq"
      | _ => raise Unreachable
  in
    fprint `cmd `" " W w %
  end

  fun emitAggrLayout id =
  let
    val (_, size, layout) = D.get P.iniLayouts id

    val () = fprint `"\n" %

    fun getPadding offset t [] = size - (offset + P.sizeOfType t)
      | getPadding offset t ({ offset = offset', ... } :: _) =
        offset' - (offset + P.sizeOfType t)

    fun emitScalars ({ offset, t, value } :: tail) =
    let
      val () = fprint `"\t" %
      val () = dd (P.sizeOfType t) value
      val padding = getPadding offset t tail
    in
      if padding > 0w0 then
        fprint `"\n\tresb " W padding `"\n" %
      else
        fprint `"\n" %;
      emitScalars tail
    end
      | emitScalars [] = ()
  in
    emitScalars layout
  end

  fun handleData objs =
  let
    val () = fprint `"section .data\n" %

    fun emitLayout (id, _, t, ini, _) =
    let
      val align = P.alignOfType t
      val () = fprinttn `"align\t" W align %
      val () = fprint PP.? id `":" %
    in
      case ini of
        P.CiniLayout id => emitAggrLayout id
      | P.CiniExpr _ => raise Unreachable
    end
  in
    List.app emitLayout objs
  end

  fun handleStrlits strlits =
  let
    fun f id = fprint `".S" I id `":\tdb " `(PP.?? id) `", 0\n" %
  in
    fprint `"\n" %;
    List.app f strlits
  end

  fun handleLocalIniLayouts () =
  let
    fun f (_, (true, _, _)) = ()
      | f (n, (false, _, _)) = (
        fprint `"\talign 16\n" %;
        fprint `".I" I n `":" %;
        emitAggrLayout n
      )
  in
    D.appi f P.iniLayouts
  end

  fun openFile fname = file := SOME (TextIO.openOut fname)

  fun emit fname
    (I.Ctx { globSyms, extSyms, objsZI, objs, strlits, ... }) =
  let
    val () = openFile fname

    val () = List.app (fn gs => fprint `"global " PP.? gs `"\n" %) globSyms
    val () = List.app (fn es => fprint `"extern " PP.? es `"\n" %) extSyms

    val () = handleBSS objsZI
    val () = handleData objs
    val () = handleStrlits strlits
    val () = handleLocalIniLayouts ()
  in
    ()
  end
end