add no-pie flags in lama on lama

This commit is contained in:
Danya Berezun 2023-10-02 13:28:42 +02:00
parent 7300ed72e4
commit 17cf7f4682
2 changed files with 76 additions and 76 deletions

View file

@ -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 *~

View file

@ -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
} }