summaryrefslogtreecommitdiff
path: root/module/language/sassy/flat-bin.scm
blob: 410f4573b78288f20e0a8f759ed7ec40b32d9b18 (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
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
; flat-bin.scm - create bin files from Sassy's output
; Copyright (C) 2005 Jonathan Kraut

; This library is free software; you can redistribute it and/or
; modify it under the terms of the GNU Lesser General Public
; License as published by the Free Software Foundation; either
; version 2.1 of the License, or (at your option) any later version.

; This library is distributed in the hope that it will be useful,
; but WITHOUT ANY WARRANTY; without even the implied warranty of
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
; Lesser General Public License for more details.

; You should have received a copy of the GNU Lesser General Public
; License along with this library; if not, write to the Free Software
; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA

; Contact:
; Jonathan Kraut
; 4130 43 ST #C2
; Sunnyside, NY 11104
; jak76@columbia.edu

; see file COPYING in the top of Sassy's distribution directory


; module flat-bin
; import api
; export all



; This is a good demonstration of how to use the output API, and we
; should probably include it in chapter 7 of the docs.

; usage:

; procedure:
; (sassy-make-bin output-file sassy-output opts ...) => unspecified

; Combines the text and data sections of sassy-output and writes a
; flat binary file to output-file. If the file already exists it is
; deleted. Any (org) directive is taken into account, and relocations
; are performed on absolute references in the data section. The data
; segment is placed (and aligned properly) immediately after the text
; segment.

; opts can be none, one or both of the following quoted symbols:

; 'boot : Make the file be an x86 boot-sector. That is, zero-fill the
;         remainder of the file to 510 bytes, and add the x86 boot-sector
;         signature #x55aa to bytes 511 and 512.

; 'stats :  Display some stats about the output.



(define (sassy-make-bin output-file sassy-output . opts)

  (define boot-sector? (memq 'boot opts))
  (define stats?       (memq 'stats opts))

  (define data? (not (zero? (sassy-data-size sassy-output))))

  ; Grap some info for printout stats later.

  (define text-size (sassy-text-size sassy-output))
  (define data-size (sassy-data-size sassy-output))
  (define text-pad  0)

  (define (display-stat . itms)
    (for-each display itms)
    (newline))

  (define (needed-reloc? x)
    (and (eq? 'abs (sassy-reloc-type x))
	 (let ((name (sassy-reloc-name x)))
	   (if name
	       (let ((symbol (sassy-symbol-exists? sassy-output name)))
		 (and (eq? 'data (sassy-symbol-section symbol))
		      (not (eq? 'import (sassy-symbol-scope symbol)))))
	       (eq? 'data (sassy-reloc-section x))))))

  ; Align the end of the text-section to the align of the data section.
  ; The data section will begin at this point in the file.
  ; (nop) is used as the filler.

  (when data?
	(push-stack-align (sassy-text-stack sassy-output)
			  (sassy-data-align sassy-output)
			  #x90))

  (set! text-pad (- (sassy-text-size sassy-output) text-size))

  ; Since the text-section is going to be loaded at whatever the given
  ; (org) was, all absolute relocations in the text section that refer
  ; to other locations in the text section already have the offset of
  ; (org) added to them, so we don't have to apply relocations to
  ; those. And we don't need to relocate relative addresses in the
  ; text section (and relative relocations aren't allowed in the data
  ; section).

  ; So, we only need to relocate references to symbols defined in the data
  ; section, or anonymous relocs in the data section

  ; Also, we need to grab all those references both from the
  ; text-section _and_ the _data_ section
  
  (when data?
	(let ((data-relocs-to-do
	       (filter needed-reloc? (sassy-reloc-list sassy-output))))

    ; Now we get ready to apply the relocations taking into account the new
    ; end of the text-section (or beginning of the data-section).

    ; For each reloc-to-do, we're going to apply it's patcher
    ; to the the data-offset plus the value already there

	  (let* ((text-offset (sassy-text-org sassy-output))
		 (data-offset (+ text-offset (sassy-text-size sassy-output))))
	    (for-each (lambda (reloc)
			((sassy-reloc-patcher reloc)
			 (+ data-offset (sassy-reloc-value reloc))))
		      data-relocs-to-do))

      ; Now all we have to to is append the data to the text, mark it as
      ; a boot sectior, and spit it out.

      ; The fastest way to tack a data section on to a text section is
      ; the following
      ; !!!!NOTE: This actually alters the text section (append!)
	  (push-stack-append! (sassy-text-stack sassy-output)
			      (sassy-data-stack sassy-output))))
      
      (when boot-sector?
	    ; sanity check
	    (if (> (sassy-text-size sassy-output) 510)
		(error "segment too big for a boot sector")
		(begin
 		; mark it as a boot sector
		  (push-stack-align (sassy-text-stack sassy-output) 510 0)
		  (push-stack-push (sassy-text-stack sassy-output)
				   (list #x55 #xaa)))))

      ; dump to file
      (when (file-exists? output-file)
	    (delete-file  output-file))
      (with-output-to-file output-file
	(lambda ()
	  (for-each write-byte (sassy-text-list sassy-output))))

    (when stats?
	  (display-stat "Text size: "    text-size " bytes")
	  (display-stat "Data size: "    data-size " bytes")
	  (display-stat "Data align: "
			(sassy-data-align sassy-output)
			" byte boundary")
	  (display-stat
	   "Total size: "
	   (+ text-size data-size text-pad)
	   " bytes, with " text-pad " bytes of padding in the text section.")
	  (when boot-sector?
		(display-stat "Made a boot sector"))))