mirror of
https://github.com/ProgramSnail/Lama.git
synced 2025-12-05 22:38:44 +00:00
add no-pie flags in lama on lama
This commit is contained in:
parent
7300ed72e4
commit
17cf7f4682
2 changed files with 76 additions and 76 deletions
|
|
@ -1,7 +1,7 @@
|
||||||
all: runtime.o
|
all: runtime.o
|
||||||
|
|
||||||
runtime.o: runtime.c
|
runtime.o: runtime.c
|
||||||
gcc -g -m32 -c runtime.c
|
gcc -g -m32 -no-pie -c runtime.c
|
||||||
|
|
||||||
clean:
|
clean:
|
||||||
rm -f *.a *.o *~
|
rm -f *.a *.o *~
|
||||||
|
|
|
||||||
|
|
@ -8,13 +8,13 @@ import Manifest;
|
||||||
import Buffer;
|
import Buffer;
|
||||||
|
|
||||||
-- Assembler language interface
|
-- Assembler language interface
|
||||||
-- The registers:
|
-- The registers:
|
||||||
var regs = ["%ebx", "%ecx", "%esi", "%edi", "%eax", "%edx", "%ebp", "%esp"];
|
var regs = ["%ebx", "%ecx", "%esi", "%edi", "%eax", "%edx", "%ebp", "%esp"];
|
||||||
|
|
||||||
-- We can not freely operate with all register; only with 4 by now
|
-- We can not freely operate with all register; only with 4 by now
|
||||||
var nRegs = regs.length - 5;
|
var nRegs = regs.length - 5;
|
||||||
|
|
||||||
-- For convenience we define the following synonyms for the registers:
|
-- For convenience we define the following synonyms for the registers:
|
||||||
var ebx = R (0),
|
var ebx = R (0),
|
||||||
ecx = R (1),
|
ecx = R (1),
|
||||||
esi = R (2),
|
esi = R (2),
|
||||||
|
|
@ -27,22 +27,22 @@ var ebx = R (0),
|
||||||
-- We need to know the word size to calculate offsets correctly
|
-- We need to know the word size to calculate offsets correctly
|
||||||
var wordSize = 4;
|
var wordSize = 4;
|
||||||
|
|
||||||
-- We need to distinguish the following operand types:
|
-- We need to distinguish the following operand types:
|
||||||
-- R (int) -- hard register
|
-- R (int) -- hard register
|
||||||
-- S (int) -- a position on the hardware stack
|
-- S (int) -- a position on the hardware stack
|
||||||
-- M (string) -- a named memory location
|
-- M (string) -- a named memory location
|
||||||
-- L (int) -- an immediate operand
|
-- L (int) -- an immediate operand
|
||||||
-- I (int, opnd) -- an indirect operand with offset
|
-- I (int, opnd) -- an indirect operand with offset
|
||||||
-- C -- saved closure
|
-- C -- saved closure
|
||||||
|
|
||||||
-- Some x86 instruction (we do not need all of them):
|
-- Some x86 instruction (we do not need all of them):
|
||||||
-- Mov (opnd, opnd) -- copies a value from the first to the second operand
|
-- Mov (opnd, opnd) -- copies a value from the first to the second operand
|
||||||
-- Lea (opnd, opnd) -- loads an address of the first operand into the second
|
-- Lea (opnd, opnd) -- loads an address of the first operand into the second
|
||||||
-- Binop (string, opnd, opnd) -- makes a binary operation; note, the first operand
|
-- Binop (string, opnd, opnd) -- makes a binary operation; note, the first operand
|
||||||
-- designates x86 operator, not the source language one
|
-- designates x86 operator, not the source language one
|
||||||
-- IDiv (opnd) -- x86 integer division, see instruction set reference
|
-- IDiv (opnd) -- x86 integer division, see instruction set reference
|
||||||
-- Cltd -- see instruction set reference
|
-- Cltd -- see instruction set reference
|
||||||
-- Set (string, string) -- sets a value from flags; the first operand is the
|
-- Set (string, string) -- sets a value from flags; the first operand is the
|
||||||
-- suffix, which determines the value being set, the
|
-- suffix, which determines the value being set, the
|
||||||
-- the second --- (sub)register name
|
-- the second --- (sub)register name
|
||||||
-- Jmp (string) -- unconditional jump to a label
|
-- Jmp (string) -- unconditional jump to a label
|
||||||
|
|
@ -55,21 +55,21 @@ var wordSize = 4;
|
||||||
-- Ret -- returns from a function
|
-- Ret -- returns from a function
|
||||||
-- Meta (string) -- metainformation (declarations, etc.)
|
-- Meta (string) -- metainformation (declarations, etc.)
|
||||||
--
|
--
|
||||||
-- Dec (opnd) -- arithmetic correction: decrement
|
-- Dec (opnd) -- arithmetic correction: decrement
|
||||||
-- Or1 (opnd) -- arithmetic correction: or 0x0001
|
-- Or1 (opnd) -- arithmetic correction: or 0x0001
|
||||||
-- Sal1 (opnd) -- arithmetic correction: shl 1
|
-- Sal1 (opnd) -- arithmetic correction: shl 1
|
||||||
-- Sar1 (opnd) -- arithmetic correction: shr 1
|
-- Sar1 (opnd) -- arithmetic correction: shr 1
|
||||||
|
|
||||||
-- Machine instruction printer
|
-- Machine instruction printer
|
||||||
fun insnString (insn) {
|
fun insnString (insn) {
|
||||||
|
|
||||||
fun binopString (op) {
|
fun binopString (op) {
|
||||||
case op of
|
case op of
|
||||||
"+" -> "addl"
|
"+" -> "addl"
|
||||||
| "-" -> "subl"
|
| "-" -> "subl"
|
||||||
| "*" -> "imull"
|
| "*" -> "imull"
|
||||||
| "&&" -> "andl"
|
| "&&" -> "andl"
|
||||||
| "!!" -> "orl"
|
| "!!" -> "orl"
|
||||||
| "^" -> "xorl"
|
| "^" -> "xorl"
|
||||||
| "cmp" -> "cmpl"
|
| "cmp" -> "cmpl"
|
||||||
esac
|
esac
|
||||||
|
|
@ -110,7 +110,7 @@ fun insnString (insn) {
|
||||||
| Dec (s) -> sprintf ("\tdecl\t%s\n", opndString (s))
|
| Dec (s) -> sprintf ("\tdecl\t%s\n", opndString (s))
|
||||||
| Or1 (s) -> sprintf ("\torl\t$0x0001,\t%s\n", opndString (s))
|
| Or1 (s) -> sprintf ("\torl\t$0x0001,\t%s\n", opndString (s))
|
||||||
| Sal1 (s) -> sprintf ("\tsall\t%s\n", opndString (s))
|
| Sal1 (s) -> sprintf ("\tsall\t%s\n", opndString (s))
|
||||||
| Sar1 (s) -> sprintf ("\tsarl\t%s\n", opndString (s))
|
| Sar1 (s) -> sprintf ("\tsarl\t%s\n", opndString (s))
|
||||||
esac
|
esac
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
@ -132,12 +132,12 @@ fun makeEnv (stack, stackSlots, globals, strings, stringIndex, barrier, stackMap
|
||||||
fun envString () {
|
fun envString () {
|
||||||
sprintf ("Stack : %s\nStackSlots: %d\nGlobals : %s\n", stack.string, stackSlots, elements (globals).string)
|
sprintf ("Stack : %s\nStackSlots: %d\nGlobals : %s\n", stack.string, stackSlots, elements (globals).string)
|
||||||
}
|
}
|
||||||
|
|
||||||
-- Allocates a new position on the symbolic stack;
|
-- Allocates a new position on the symbolic stack;
|
||||||
-- returns a pair: a location for allocated item and
|
-- returns a pair: a location for allocated item and
|
||||||
-- an updated environment
|
-- an updated environment
|
||||||
fun allocate () {
|
fun allocate () {
|
||||||
case
|
case
|
||||||
case stack of
|
case stack of
|
||||||
{} -> [ebx, 0]
|
{} -> [ebx, 0]
|
||||||
| S (n) : _ -> [S (n+1), n+2]
|
| S (n) : _ -> [S (n+1), n+2]
|
||||||
|
|
@ -172,7 +172,7 @@ fun makeEnv (stack, stackSlots, globals, strings, stringIndex, barrier, stackMap
|
||||||
fun peek () {
|
fun peek () {
|
||||||
stack.fst
|
stack.fst
|
||||||
}
|
}
|
||||||
|
|
||||||
-- Adds a global variable; returns an updated environment
|
-- Adds a global variable; returns an updated environment
|
||||||
fun addGlobal (name) {
|
fun addGlobal (name) {
|
||||||
makeEnv (stack, stackSlots, addSet (globals, globalName (name)), strings, stringIndex, barrier, stackMap, fLabel, nLocals, clo)
|
makeEnv (stack, stackSlots, addSet (globals, globalName (name)), strings, stringIndex, barrier, stackMap, fLabel, nLocals, clo)
|
||||||
|
|
@ -188,7 +188,7 @@ fun makeEnv (stack, stackSlots, globals, strings, stringIndex, barrier, stackMap
|
||||||
| Acc (i) -> I (wordSize * (i+1), edx)
|
| Acc (i) -> I (wordSize * (i+1), edx)
|
||||||
esac
|
esac
|
||||||
}
|
}
|
||||||
|
|
||||||
-- Gets a list of global variables from the environment
|
-- Gets a list of global variables from the environment
|
||||||
fun getGlobals () {
|
fun getGlobals () {
|
||||||
globals.elements
|
globals.elements
|
||||||
|
|
@ -226,12 +226,12 @@ fun makeEnv (stack, stackSlots, globals, strings, stringIndex, barrier, stackMap
|
||||||
fun dropBarrier () {
|
fun dropBarrier () {
|
||||||
makeEnv (stack, stackSlots, globals, strings, stringIndex, false, stackMap, fLabel, nLocals, clo)
|
makeEnv (stack, stackSlots, globals, strings, stringIndex, false, stackMap, fLabel, nLocals, clo)
|
||||||
}
|
}
|
||||||
|
|
||||||
-- Checks if a stack is set for a label
|
-- Checks if a stack is set for a label
|
||||||
fun hasStack (l) {
|
fun hasStack (l) {
|
||||||
compare (findMap (stackMap, l), None) != 0
|
compare (findMap (stackMap, l), None) != 0
|
||||||
}
|
}
|
||||||
|
|
||||||
-- Sets the label of current function
|
-- Sets the label of current function
|
||||||
fun enterFunction (fLabel, nL, clo) {
|
fun enterFunction (fLabel, nL, clo) {
|
||||||
makeEnv (stack, stackSlots, globals, strings, stringIndex, false, stackMap, fLabel, nL, clo)
|
makeEnv (stack, stackSlots, globals, strings, stringIndex, false, stackMap, fLabel, nL, clo)
|
||||||
|
|
@ -267,7 +267,7 @@ fun makeEnv (stack, stackSlots, globals, strings, stringIndex, barrier, stackMap
|
||||||
| c -> escaped [j] := c; j := j+1
|
| c -> escaped [j] := c; j := j+1
|
||||||
esac
|
esac
|
||||||
od;
|
od;
|
||||||
|
|
||||||
[makeEnv (stack, stackSlots, globals, addSet (strings, [name, substring (escaped, 0, j)]), stringIndex+1, false, stackMap, fLabel, nLocals, clo),
|
[makeEnv (stack, stackSlots, globals, addSet (strings, [name, substring (escaped, 0, j)]), stringIndex+1, false, stackMap, fLabel, nLocals, clo),
|
||||||
name]
|
name]
|
||||||
}
|
}
|
||||||
|
|
@ -450,7 +450,7 @@ fun initEnv () {
|
||||||
}
|
}
|
||||||
|
|
||||||
-- Codegeneration helper functions
|
-- Codegeneration helper functions
|
||||||
fun fixMain (lab) {
|
fun fixMain (lab) {
|
||||||
case lab of "L$main" -> "main" | _ -> lab esac
|
case lab of "L$main" -> "main" | _ -> lab esac
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
@ -479,7 +479,7 @@ fun prologue (env, fLabel) {
|
||||||
env.saveClosure <+
|
env.saveClosure <+
|
||||||
Push (ebp) <+
|
Push (ebp) <+
|
||||||
Mov (esp, ebp) <+
|
Mov (esp, ebp) <+
|
||||||
Binop ("-", M (sprintf ("$%s_SIZE", fixMain $ fLabel)), esp)
|
Binop ("-", M (sprintf ("$%s_SIZE", fixMain $ fLabel)), esp)
|
||||||
}
|
}
|
||||||
|
|
||||||
-- Generates function epilogue
|
-- Generates function epilogue
|
||||||
|
|
@ -499,7 +499,7 @@ fun stackOpnd (opnd) {
|
||||||
case opnd of
|
case opnd of
|
||||||
S (_) -> true
|
S (_) -> true
|
||||||
| _ -> false
|
| _ -> false
|
||||||
esac
|
esac
|
||||||
}
|
}
|
||||||
|
|
||||||
-- Checks if an operand resides in memory
|
-- Checks if an operand resides in memory
|
||||||
|
|
@ -557,11 +557,11 @@ fun call (env, fLabel, nA) {
|
||||||
esac
|
esac
|
||||||
esac
|
esac
|
||||||
}
|
}
|
||||||
|
|
||||||
case pushArgs (env, {}, nA) of
|
case pushArgs (env, {}, nA) of
|
||||||
[env, pushArgs] ->
|
[env, pushArgs] ->
|
||||||
case
|
case
|
||||||
case fLabel of
|
case fLabel of
|
||||||
"Barray" -> [{Push (L (makeBox $ nA))}, Call (fLabel), env]
|
"Barray" -> [{Push (L (makeBox $ nA))}, Call (fLabel), env]
|
||||||
| "Bsexp" -> [{Push (L (makeBox $ nA))}, Call (fLabel), env]
|
| "Bsexp" -> [{Push (L (makeBox $ nA))}, Call (fLabel), env]
|
||||||
| Closure (f) -> [{Push (M ("$" ++ f)), Push (L (makeBox $ nA))}, Call ("Bclosure"), env]
|
| Closure (f) -> [{Push (M ("$" ++ f)), Push (L (makeBox $ nA))}, Call ("Bclosure"), env]
|
||||||
|
|
@ -569,12 +569,12 @@ fun call (env, fLabel, nA) {
|
||||||
[closure@(S (_)), env] -> [{}, {Mov (closure, edx), Mov (edx, eax), CallI (eax)}, env]
|
[closure@(S (_)), env] -> [{}, {Mov (closure, edx), Mov (edx, eax), CallI (eax)}, env]
|
||||||
| [closure, env] -> [{}, {Mov (closure, edx), CallI (closure)}, env]
|
| [closure, env] -> [{}, {Mov (closure, edx), CallI (closure)}, env]
|
||||||
esac
|
esac
|
||||||
| #str -> [{}, Call (if fLabel[0] == '$'
|
| #str -> [{}, Call (if fLabel[0] == '$'
|
||||||
then "L" ++ substring (fLabel, 1, fLabel.length - 1)
|
then "L" ++ substring (fLabel, 1, fLabel.length - 1)
|
||||||
else fLabel
|
else fLabel
|
||||||
fi), env]
|
fi), env]
|
||||||
esac of
|
esac of
|
||||||
[extraArg, call, env] ->
|
[extraArg, call, env] ->
|
||||||
case env.allocate of
|
case env.allocate of
|
||||||
[y, env] ->
|
[y, env] ->
|
||||||
[env, listBuffer (deepFlatten $ {pushRegs,
|
[env, listBuffer (deepFlatten $ {pushRegs,
|
||||||
|
|
@ -595,7 +595,7 @@ fun call (env, fLabel, nA) {
|
||||||
|
|
||||||
-- Compiles stack machine code into a list of x86 instructions. Takes an environment
|
-- Compiles stack machine code into a list of x86 instructions. Takes an environment
|
||||||
-- and stack machine code, returns an updated environment and x86 code.
|
-- and stack machine code, returns an updated environment and x86 code.
|
||||||
fun compile (args, env, code) {
|
fun compile (args, env, code) {
|
||||||
fun compile (env, code) {
|
fun compile (env, code) {
|
||||||
foldl (
|
foldl (
|
||||||
fun ([env, scode], i) {
|
fun ([env, scode], i) {
|
||||||
|
|
@ -607,7 +607,7 @@ fun compile (args, env, code) {
|
||||||
-- This if removes unreachable code; otherwise
|
-- This if removes unreachable code; otherwise
|
||||||
-- the stack invariants for the symbolic interpreter
|
-- the stack invariants for the symbolic interpreter
|
||||||
-- are violated
|
-- are violated
|
||||||
if env.isBarrier
|
if env.isBarrier
|
||||||
then case i of
|
then case i of
|
||||||
LABEL (l, true) -> [env.dropBarrier, code <+ Label (fixMain $ l)]
|
LABEL (l, true) -> [env.dropBarrier, code <+ Label (fixMain $ l)]
|
||||||
| LABEL (l, _) -> if hasStack (env, l)
|
| LABEL (l, _) -> if hasStack (env, l)
|
||||||
|
|
@ -621,13 +621,13 @@ fun compile (args, env, code) {
|
||||||
READ ->
|
READ ->
|
||||||
case env.allocate of
|
case env.allocate of
|
||||||
[s, env] -> [env, code <+ Call ("Lread") <+ Mov (eax, s)]
|
[s, env] -> [env, code <+ Call ("Lread") <+ Mov (eax, s)]
|
||||||
esac
|
esac
|
||||||
| WRITE ->
|
| WRITE ->
|
||||||
case env.pop of
|
case env.pop of
|
||||||
[s, env] -> [env, code <+ Push (s) <+ Call ("Lwrite") <+ Pop (eax)]
|
[s, env] -> [env, code <+ Push (s) <+ Call ("Lwrite") <+ Pop (eax)]
|
||||||
esac
|
esac
|
||||||
(* Assignment
|
(* Assignment
|
||||||
|
|
||||||
-- Some guidelines for generating function calls:
|
-- Some guidelines for generating function calls:
|
||||||
--
|
--
|
||||||
-- 1. generate instructions to save live registers on the X86 stack (use
|
-- 1. generate instructions to save live registers on the X86 stack (use
|
||||||
|
|
@ -643,22 +643,22 @@ fun compile (args, env, code) {
|
||||||
-- 1. generate proper prologue for BEGIN instruction (use "prologue" helper); use
|
-- 1. generate proper prologue for BEGIN instruction (use "prologue" helper); use
|
||||||
-- env.enterFunction to create a proper environment;
|
-- env.enterFunction to create a proper environment;
|
||||||
-- 2. generate epilogue for END instruction.
|
-- 2. generate epilogue for END instruction.
|
||||||
|
|
||||||
| _ -> failure ("codegeneration for instruction %s is not yet implemented\n", i.string)
|
| _ -> failure ("codegeneration for instruction %s is not yet implemented\n", i.string)
|
||||||
End *)
|
End *)
|
||||||
(* Implementation *)
|
(* Implementation *)
|
||||||
| BEGIN (f, nA, nL, c) -> case env.enterFunction (f, nL, c) of
|
| BEGIN (f, nA, nL, c) -> case env.enterFunction (f, nL, c) of
|
||||||
env -> [env, code <+> prologue (env, f)]
|
env -> [env, code <+> prologue (env, f)]
|
||||||
esac
|
esac
|
||||||
|
|
||||||
| END -> case epilogue (env) of
|
| END -> case epilogue (env) of
|
||||||
[env, endCode] -> [env, code <+> endCode]
|
[env, endCode] -> [env, code <+> endCode]
|
||||||
esac
|
esac
|
||||||
|
|
||||||
| CALLC (n) -> case call (env, Closure, n) of
|
| CALLC (n) -> case call (env, Closure, n) of
|
||||||
[env, callCode] -> [env, code <+> callCode]
|
[env, callCode] -> [env, code <+> callCode]
|
||||||
esac
|
esac
|
||||||
|
|
||||||
| CLOSURE (f, n) -> case call (env, Closure (f), n) of
|
| CLOSURE (f, n) -> case call (env, Closure (f), n) of
|
||||||
[env, callCode] -> [env, code <+> callCode]
|
[env, callCode] -> [env, code <+> callCode]
|
||||||
esac
|
esac
|
||||||
|
|
@ -666,28 +666,28 @@ fun compile (args, env, code) {
|
||||||
| CALL (fLabel, nA) -> case call (env, fLabel, nA) of
|
| CALL (fLabel, nA) -> case call (env, fLabel, nA) of
|
||||||
[env, callCode] -> [env, code <+> callCode]
|
[env, callCode] -> [env, code <+> callCode]
|
||||||
esac
|
esac
|
||||||
|
|
||||||
| GLOBAL (x) -> [env.addGlobal (x), code]
|
| GLOBAL (x) -> [env.addGlobal (x), code]
|
||||||
|
|
||||||
| LABEL (l, _) -> [env, code <+ Label (fixMain $ l)]
|
| LABEL (l, _) -> [env, code <+ Label (fixMain $ l)]
|
||||||
|
|
||||||
| JMP (l) -> [setBarrier (setStack (env, l)), code <+ Jmp (l)]
|
| JMP (l) -> [setBarrier (setStack (env, l)), code <+ Jmp (l)]
|
||||||
|
|
||||||
| CJMP (s, l) ->
|
| CJMP (s, l) ->
|
||||||
case env.pop of
|
case env.pop of
|
||||||
[x, env] -> [setStack (env, l), code <+ Sar1 (x) <+ Binop ("cmp", L (0), x) <+ CJmp (s, l)]
|
[x, env] -> [setStack (env, l), code <+ Sar1 (x) <+ Binop ("cmp", L (0), x) <+ CJmp (s, l)]
|
||||||
esac
|
esac
|
||||||
|
|
||||||
| CONST (n) ->
|
| CONST (n) ->
|
||||||
case env.allocate of
|
case env.allocate of
|
||||||
[s, env] -> [env, code <+ Mov (L (makeBox $ n), s)]
|
[s, env] -> [env, code <+ Mov (L (makeBox $ n), s)]
|
||||||
esac
|
esac
|
||||||
|
|
||||||
| LD (x) ->
|
| LD (x) ->
|
||||||
case env.allocate of
|
case env.allocate of
|
||||||
[s, env] -> [env, code <+> move (env.loc (x), s)]
|
[s, env] -> [env, code <+> move (env.loc (x), s)]
|
||||||
esac
|
esac
|
||||||
|
|
||||||
| LDA (x) ->
|
| LDA (x) ->
|
||||||
case env.allocate of
|
case env.allocate of
|
||||||
[s, env] ->
|
[s, env] ->
|
||||||
|
|
@ -699,7 +699,7 @@ fun compile (args, env, code) {
|
||||||
|
|
||||||
| ST (x) ->
|
| ST (x) ->
|
||||||
[env, code <+> move (env.peek, env.loc (x))]
|
[env, code <+> move (env.peek, env.loc (x))]
|
||||||
|
|
||||||
| STI ->
|
| STI ->
|
||||||
case env.pop2 of
|
case env.pop2 of
|
||||||
[v, x, env] ->
|
[v, x, env] ->
|
||||||
|
|
@ -708,7 +708,7 @@ fun compile (args, env, code) {
|
||||||
else singletonBuffer (Mov (v, eax)) <+ Mov (eax, I (0, x)) <+ Mov (eax, x)
|
else singletonBuffer (Mov (v, eax)) <+ Mov (eax, I (0, x)) <+ Mov (eax, x)
|
||||||
fi]
|
fi]
|
||||||
esac
|
esac
|
||||||
|
|
||||||
| STA ->
|
| STA ->
|
||||||
case call (env, "Bsta", 2) of
|
case call (env, "Bsta", 2) of
|
||||||
[env, callCode] -> [env, code <+> callCode]
|
[env, callCode] -> [env, code <+> callCode]
|
||||||
|
|
@ -737,7 +737,7 @@ fun compile (args, env, code) {
|
||||||
|
|
||||||
| SEXP (t, n) ->
|
| SEXP (t, n) ->
|
||||||
case env.allocate of
|
case env.allocate of
|
||||||
[s, env] ->
|
[s, env] ->
|
||||||
case call (env, "Bsexp", n+1) of
|
case call (env, "Bsexp", n+1) of
|
||||||
[env, callCode] -> [env, code <+> move (L (makeBox (tagHash $ t)), s) <+> callCode]
|
[env, callCode] -> [env, code <+> move (L (makeBox (tagHash $ t)), s) <+> callCode]
|
||||||
esac
|
esac
|
||||||
|
|
@ -748,7 +748,7 @@ fun compile (args, env, code) {
|
||||||
[env, callCode] -> [env, code <+> callCode]
|
[env, callCode] -> [env, code <+> callCode]
|
||||||
esac
|
esac
|
||||||
|
|
||||||
| DUP ->
|
| DUP ->
|
||||||
case env.peek of
|
case env.peek of
|
||||||
x -> case env.allocate of
|
x -> case env.allocate of
|
||||||
[s, env] -> [env, code <+> move (x, s)]
|
[s, env] -> [env, code <+> move (x, s)]
|
||||||
|
|
@ -757,23 +757,23 @@ fun compile (args, env, code) {
|
||||||
|
|
||||||
| PATT (p) ->
|
| PATT (p) ->
|
||||||
case p of
|
case p of
|
||||||
Tag (t, sz) ->
|
Tag (t, sz) ->
|
||||||
case env.allocate of
|
case env.allocate of
|
||||||
[s1, env] ->
|
[s1, env] ->
|
||||||
case env.allocate of
|
case env.allocate of
|
||||||
[s2, env] ->
|
[s2, env] ->
|
||||||
case call (env, "Btag", 3) of
|
case call (env, "Btag", 3) of
|
||||||
[env, callCode] -> [env, code <+>
|
[env, callCode] -> [env, code <+>
|
||||||
move (L (makeBox $ tagHash $ t), s1) <+>
|
move (L (makeBox $ tagHash $ t), s1) <+>
|
||||||
move (L (makeBox $ sz), s2) <+>
|
move (L (makeBox $ sz), s2) <+>
|
||||||
callCode]
|
callCode]
|
||||||
esac
|
esac
|
||||||
esac
|
esac
|
||||||
esac
|
esac
|
||||||
| StrCmp ->
|
| StrCmp ->
|
||||||
case call (env, "Bstring_patt", 2) of
|
case call (env, "Bstring_patt", 2) of
|
||||||
[env, callCode] -> [env, code <+> callCode]
|
[env, callCode] -> [env, code <+> callCode]
|
||||||
esac
|
esac
|
||||||
| Array (n) ->
|
| Array (n) ->
|
||||||
case env.allocate of
|
case env.allocate of
|
||||||
[s, env] ->
|
[s, env] ->
|
||||||
|
|
@ -785,7 +785,7 @@ fun compile (args, env, code) {
|
||||||
|
|
||||||
| META (m) ->
|
| META (m) ->
|
||||||
case m of
|
case m of
|
||||||
MF ([line, col]) ->
|
MF ([line, col]) ->
|
||||||
case env.pop of
|
case env.pop of
|
||||||
[v, env] -> case env.addString (args.getInFile) of
|
[v, env] -> case env.addString (args.getInFile) of
|
||||||
[env, sym] -> [env.setBarrier, code <+
|
[env, sym] -> [env.setBarrier, code <+
|
||||||
|
|
@ -803,15 +803,15 @@ fun compile (args, env, code) {
|
||||||
case env.pop of
|
case env.pop of
|
||||||
[_, env] -> [env, code]
|
[_, env] -> [env, code]
|
||||||
esac
|
esac
|
||||||
|
|
||||||
| BINOP (op) ->
|
| BINOP (op) ->
|
||||||
infix ? after + (x, l) {
|
infix ? after + (x, l) {
|
||||||
case l of
|
case l of
|
||||||
{} -> false
|
{} -> false
|
||||||
| h : t -> if compare (x, h) == 0 then true else x ? t fi
|
| h : t -> if compare (x, h) == 0 then true else x ? t fi
|
||||||
esac
|
esac
|
||||||
}
|
}
|
||||||
|
|
||||||
case env.pop2 of
|
case env.pop2 of
|
||||||
[x, y, env] ->
|
[x, y, env] ->
|
||||||
[env.push (y),
|
[env.push (y),
|
||||||
|
|
@ -858,18 +858,18 @@ fun compile (args, env, code) {
|
||||||
Binop (op, x, eax) <+
|
Binop (op, x, eax) <+
|
||||||
Mov (L (0), eax) <+
|
Mov (L (0), eax) <+
|
||||||
Set ("ne", "%al") <+
|
Set ("ne", "%al") <+
|
||||||
|
|
||||||
Mov (y, edx) <+
|
Mov (y, edx) <+
|
||||||
Dec (edx) <+
|
Dec (edx) <+
|
||||||
Binop (op, y, edx) <+
|
Binop (op, y, edx) <+
|
||||||
Mov (L (0), edx) <+
|
Mov (L (0), edx) <+
|
||||||
Set ("ne", "%dl") <+
|
Set ("ne", "%dl") <+
|
||||||
|
|
||||||
Binop (op, edx, eax) <+
|
Binop (op, edx, eax) <+
|
||||||
Set ("ne", "%al") <+>
|
Set ("ne", "%al") <+>
|
||||||
toFixedNum (eax) <+
|
toFixedNum (eax) <+
|
||||||
Mov (eax, y)
|
Mov (eax, y)
|
||||||
|
|
||||||
| "!!" -> singletonBuffer (Mov (y, eax)) <+
|
| "!!" -> singletonBuffer (Mov (y, eax)) <+
|
||||||
Sar1 (eax) <+
|
Sar1 (eax) <+
|
||||||
Sar1 (x) <+
|
Sar1 (x) <+
|
||||||
|
|
@ -878,7 +878,7 @@ fun compile (args, env, code) {
|
||||||
Set ("ne", "%al") <+>
|
Set ("ne", "%al") <+>
|
||||||
toFixedNum (eax) <+
|
toFixedNum (eax) <+
|
||||||
Mov (eax, y)
|
Mov (eax, y)
|
||||||
|
|
||||||
| "+" -> if stackOpnd (x) && stackOpnd (y)
|
| "+" -> if stackOpnd (x) && stackOpnd (y)
|
||||||
then singletonBuffer (Mov (x, eax)) <+ Dec (eax) <+ Binop ("+", eax, y)
|
then singletonBuffer (Mov (x, eax)) <+ Dec (eax) <+ Binop ("+", eax, y)
|
||||||
else singletonBuffer (Binop (op, x, y)) <+ Dec (y)
|
else singletonBuffer (Binop (op, x, y)) <+ Dec (y)
|
||||||
|
|
@ -890,7 +890,7 @@ fun compile (args, env, code) {
|
||||||
fi
|
fi
|
||||||
esac
|
esac
|
||||||
fi]
|
fi]
|
||||||
esac
|
esac
|
||||||
(* End *)
|
(* End *)
|
||||||
esac
|
esac
|
||||||
fi
|
fi
|
||||||
|
|
@ -899,7 +899,7 @@ fun compile (args, env, code) {
|
||||||
|
|
||||||
-- printf ("%s\n", showSM (code));
|
-- printf ("%s\n", showSM (code));
|
||||||
|
|
||||||
compile (env, code)
|
compile (env, code)
|
||||||
}
|
}
|
||||||
|
|
||||||
-- A top-level codegeneration function. Takes a driver's environment and a stack machine program,
|
-- A top-level codegeneration function. Takes a driver's environment and a stack machine program,
|
||||||
|
|
@ -914,14 +914,14 @@ public fun compileX86 (args, code) {
|
||||||
esac ++ "/runtime.o";
|
esac ++ "/runtime.o";
|
||||||
|
|
||||||
fwrite (asmFile,
|
fwrite (asmFile,
|
||||||
map (insnString,
|
map (insnString,
|
||||||
getBuffer $
|
getBuffer $
|
||||||
singletonBuffer (Meta ("\t.global\tmain\n")) <+>
|
singletonBuffer (Meta ("\t.global\tmain\n")) <+>
|
||||||
dataSection (listBuffer (map (intDef , getGlobals (env))) <+>
|
dataSection (listBuffer (map (intDef , getGlobals (env))) <+>
|
||||||
listBuffer (map (stringDef, getStrings (env)))) <+>
|
listBuffer (map (stringDef, getStrings (env)))) <+>
|
||||||
codeSection (code)
|
codeSection (code)
|
||||||
).stringcat);
|
).stringcat);
|
||||||
|
|
||||||
system ({"gcc -g -m32 -o ", args.getBaseName, " ", runtime, " ", asmFile}.stringcat)
|
system ({"gcc -g -no-pie -m32 -o ", args.getBaseName, " ", runtime, " ", asmFile}.stringcat)
|
||||||
esac
|
esac
|
||||||
}
|
}
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue