Merge pull request #56 from zilch-lang/develop

Stabilize features for the v2.2.0

emacs-mode/nstar-mode.el

@@ -0,0 +1,76 @@
+;;; nstar-mode.el --- Major mode for N*
+;; SPDX-License-Identifier: BSD3 License
+
+;;; Commentary:
+
+;; A major mode providing some syntax highlighting for the typed assembly language N*.
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Dependency
+
+;;; Code:
+
+(defgroup nstar nil
+  "Major mode for editing N* code."
+  :link '(custom-group-link :tag "Font lock faces group" font-lock-faces)
+  :group 'languages)
+
+(defconst nstar-font-lock-keywords
+  '(
+    ("^\\([ \t]*\\)\\(\\(\\sw\\|\\s_\\)+\\):"
+     2 font-lock-function-name-face)
+    ;; function definition
+    ("\\b\\(forall\\|unsafe\\|section\\|include\\)\\b"
+     1 font-lock-keyword-face)
+    ;; keywords
+    ("%r[0-5]" .
+     font-lock-variable-name-face)
+    ;; registers
+    ("\\b\\(mv\\|st\\|ld\\|salloc\\|sld\\|sst\\|call\\|ret\\|jmp\\|jz\\|dec\\|inc\\|sfree\\|mul\\|nop\\|sref\\)\\b"
+     1 font-lock-builtin-face)
+    ;; instructions
+    ("\\b\\(T\\(a\\|c\\|s\\|[0-9]+\\)\\|s\\(8\\|16\\|32\\|64\\)\\|u\\(8\\|16\\|32\\|64\\)\\)\\b"
+     1 font-lock-type-face)
+    ;; builtin types
+    )
+  "Additional expressions to highlight in N* mode.")
+
+(defvar nstar-mode-syntax-table
+  (let ((st (make-syntax-table)))
+    (modify-syntax-entry ?\n "> b" st)
+    (modify-syntax-entry ?/  ". 124b" st)
+    (modify-syntax-entry ?*  ". 23" st)
+    (modify-syntax-entry ?#  "< b" st)
+    (modify-syntax-entry ?_  "w" st)
+    (modify-syntax-entry ?\" "|" st)
+    (modify-syntax-entry ?'  "|" st)
+    st)
+  "Syntax table used while in N* mode.")
+
+;;;###autoload
+(add-to-list 'auto-mode-alist '("\\.nst\\'" . nstar-mode))
+;;;###autoload
+(modify-coding-system-alist 'file "\\.nst\\'" 'utf-8)
+;;;###autoload
+(define-derived-mode nstar-mode prog-mode "N*"
+  "Major mode for editing simple N* source files.
+
+Only provides syntax highlighting."
+
+  (setq-local font-lock-defaults '(nstar-font-lock-keywords))
+  (set-syntax-table (make-syntax-table nstar-mode-syntax-table))
+
+  (setq-local comment-start "#")
+  (setq-local comment-add 1)
+  (setq-local comment-end "")
+
+  (setq-local comment-start-skip "\\(?:\\s<+\\|/[/*]+\\)[ \t]*")
+  (setq-local comment-end-skip "[ \t]*\\(\\s>\\|\\*+/\\)")
+
+  (setq-local comment-multi-line 1)
+  )
+
+
+(provide 'nstar-mode)
+
+;;; nstar-mode.el ends here

examples/amd64-driver.nst

@@ -1,3 +1,5 @@
+# -*- nstar -*-
+
 ### x86-amd64 code driver
 
 section code {

examples/fact.nst

@@ -1,3 +1,5 @@
+# -*- nstar -*-
+
 section code {
   fact: forall(s: Ts, e: Tc).{ %r5: forall().{ %r0: u64 | s -> e }, %r1: u64 | s -> %r5 }
       = jz %r1, fact_0<s, e>, fact_N<s, e>

examples/hello_world.nst

@@ -0,0 +1,27 @@
+# -*- nstar -*-
+
+section extern.code {
+  puts: forall(s: Ts, e: Tc).{ %r4: !, %r5: *s64 | forall().{ %r0: u64 | s -> e }::s -> 0 }
+}
+
+include {
+  "amd64-driver.nst"
+}
+
+section data {
+  test_str: *s8 = # [ 'H' 'e' 'l' 'l' 'o' ',' ' ' 'w' 'o' 'r' 'l' 'd' '!' '\0' ]
+                   "Hello, world!"
+}
+
+section code {
+  _main: forall(s: Ts, e: Tc).{ %r5: forall().{ %r0: u64 | s -> e } | s -> %r5 }
+       = mv %r5, %r3
+       ; mv puts_ret<s, e>, %r5
+       ; salloc forall().{ %r0: !, %r3: forall().{ %r0: u64 | s -> e } | s -> %r3 }
+       ; sst %r5, 0
+       ; mv test_str, %r5
+       ; call puts<s, %r3>
+  puts_ret: forall(s: Ts, e: Tc).{ %r3: forall().{ %r0: u64 | s -> e } | s -> %r3 }
+          = mv 0, %r0
+          ; ret
+}

examples/true.nst

@@ -1,3 +1,5 @@
+# -*- nstar -*-
+
 include {
     "amd64-driver.nst"
 }

lib/elfgen/cbits/elf64/fix.c

@@ -500,11 +500,29 @@ void fix_relocation_symbols_addresses(elf_object const *obj, Elf64_Object *targe
         elf_relocation_symbol const *abstract_symbol = symbols[i];
         Elf64_Rela *concrete_symbol = target->relocations[i];
 
-        int section_index = find_section_index_by_name(obj->sections, obj->sections_len, abstract_symbol->origin->data.origin_section.section_name);
-        int ssymbol_index = find_section_symbol_by_index(target->symbols, target->symbols_len, section_index);
+        switch (abstract_symbol->origin->type)
+        {
+            case ORIGIN_SECTION:
+            {
+                char const *sect_name = abstract_symbol->origin->data.origin_section.section_name;
+                int section_index = find_section_index_by_name(obj->sections, obj->sections_len, sect_name);
+                int ssymbol_index = find_section_symbol_by_index(target->symbols, target->symbols_len, section_index);
 
-        concrete_symbol->r_info = ELF64_R_INFO(ssymbol_index, ELF64_R_TYPE(concrete_symbol->r_info));
-        concrete_symbol->r_addend = abstract_symbol->origin->data.origin_section.offset;
+                concrete_symbol->r_info = ELF64_R_INFO(ssymbol_index, ELF64_R_TYPE(concrete_symbol->r_info));
+                concrete_symbol->r_addend = abstract_symbol->origin->data.origin_section.offset;
+                break;
+            }
+            case ORIGIN_FUNCTION:
+            {
+                int symtab_index = find_section_index_by_name(obj->sections, obj->sections_len, ".symtab");
+                elf_section_header const *symtab = obj->sections[symtab_index];
+                int symbol_index = find_symbol_index_by_name(symtab->data.s_symtab.symbols, symtab->data.s_symtab.symbols_len, abstract_symbol->origin->data.origin_function.symbol_name);
+
+                concrete_symbol->r_info = ELF64_R_INFO(symbol_index, ELF64_R_TYPE(concrete_symbol->r_info));
+                concrete_symbol->r_addend = -4;
+                break;
+            }
+        }
     }
 
     free(symbols);

lib/elfgen/cbits/elf64/internal_fix.c

@@ -2,6 +2,7 @@
 
 #include <stddef.h>
 #include <string.h>
+#include <stdio.h>
 
 char const *get_section_name(elf_section_header const *section)
 {
@@ -56,3 +57,15 @@ int find_section_symbol_by_index(Elf64_Sym **symtab, unsigned int size, int sect
 
     return index;
 }
+
+int find_symbol_index_by_name(elf_symbol **symtab, unsigned int size, char const *symbol_name)
+{
+    int index = -1;
+
+    for (size_t i = 0; index == -1 && i < size; ++i)
+    {
+        if (strcmp(symtab[i]->name, symbol_name) == 0) index = (int) i;
+    }
+
+    return index;
+}

lib/elfgen/cbits/include/elf64/internal_fix.h

@@ -38,4 +38,17 @@ int find_section_index_by_name(elf_section_header const **sections, unsigned int
  * */
 int find_section_symbol_by_index(Elf64_Sym **symtab, unsigned int symtab_len, int section_index);
 
+/**
+ * @brief Frinds the index of a symbol knowing its name.
+ *
+ * @param symtab The symbol table (`.symtab` section)
+ *
+ * @param symtab_len The length of the symbol table
+ *
+ * @param symbol_name The name of the symbol we want the index of
+ *
+ * @return `-1` if no symbol has been found with this name, else the symbol index in the symbol table
+ * */
+int find_symbol_index_by_name(elf_symbol **symtab, unsigned int symtab_len, char const *symbol_name);
+
 #endif

lib/elfgen/cbits/include/symbol.h

@@ -87,7 +87,8 @@ typedef struct
     {
         enum relocation_origin_type
         {
-            ORIGIN_SECTION   //!< The symbol originates form a section
+            ORIGIN_SECTION,   //!< The symbol originates form a section
+            ORIGIN_FUNCTION   //!< The symbol is a simple label
         } type;   //!< The type of origin for the symbol.
 
         union
@@ -97,6 +98,10 @@ typedef struct
                 char const *section_name;   //!< The name of the section it originates from
                 uint64_t offset;            //!< The computed offset in the section
             } origin_section;
+            struct
+            {
+                char const *symbol_name;    //!< The name of the function
+            } origin_function;
         } data;
     } *origin;  //!< The origin of the relocation symbol.
 
@@ -105,7 +110,8 @@ typedef struct
         RT_X86_64_NONE = R_X86_64_NONE,   //!< No relocation
         RT_X86_64_32 = R_X86_64_32,       //!< Direct 32 bit zero extended address
         RT_X86_64_32S = R_X86_64_32S,     //!< Direct 32 bit sign extended address
-        RT_X86_64_64 = R_X86_64_64        //!< Direct 64 bit address
+        RT_X86_64_64 = R_X86_64_64,       //!< Direct 64 bit address
+        RT_X86_64_PLT32 = R_X86_64_PLT32  //!< 32-bit PLT address
     } reloc_type;  //!< The type of relocation for the symbol.
 
     uint64_t offset;  //!< The offset where to relocate data in the section of the relocation table.

lib/elfgen/elfgen.cabal

@@ -1,6 +1,6 @@
 cabal-version: 1.12
 
--- This file has been generated from package.yaml by hpack version 0.34.2.
+-- This file has been generated from package.yaml by hpack version 0.34.4.
 --
 -- see: https://github.com/sol/hpack
 
@@ -40,7 +40,20 @@ library
   hs-source-dirs:
       src
       cbits
-  default-extensions: LambdaCase BinaryLiterals BlockArguments TypeApplications DataKinds FlexibleInstances MultiParamTypeClasses ScopedTypeVariables TypeFamilies FlexibleContexts UndecidableInstances StandaloneDeriving AllowAmbiguousTypes
+  default-extensions:
+      LambdaCase
+      BinaryLiterals
+      BlockArguments
+      TypeApplications
+      DataKinds
+      FlexibleInstances
+      MultiParamTypeClasses
+      ScopedTypeVariables
+      TypeFamilies
+      FlexibleContexts
+      UndecidableInstances
+      StandaloneDeriving
+      AllowAmbiguousTypes
   ghc-options: -Wall -Wextra -Wno-name-shadowing -Wno-unused-matches
   cc-options: -Wall -Wextra
   include-dirs:

lib/elfgen/src/Data/Elf/Symbol.chs

@@ -198,28 +198,36 @@ data RelocationOrigin
   = SectionReloc
       String        -- ^ Section name
       Integer       -- ^ Offset from beginning of section
+  | FunctionReloc
+      String        -- ^ Symbol name
   deriving (Eq, Ord, Generic)
 
 -- | Symbol relocation type
-{#enum symbol_relocation_type as RelocationType {RT_X86_64_NONE as R_x86_64_None, RT_X86_64_32 as R_x86_64_32, RT_X86_64_32S as R_x86_64_32s, RT_X86_64_64 as R_x86_64_64} deriving (Eq, Ord, Generic)#}
+{#enum symbol_relocation_type as RelocationType {RT_X86_64_NONE as R_x86_64_None, RT_X86_64_32 as R_x86_64_32, RT_X86_64_32S as R_x86_64_32s, RT_X86_64_64 as R_x86_64_64, RT_X86_64_PLT32 as R_x86_64_PLT32} deriving (Eq, Ord, Generic)#}
 
-{#enum relocation_origin_type as RelocType {ORIGIN_SECTION as OrigSection}#}
+{#enum relocation_origin_type as RelocType {ORIGIN_SECTION as OrigSection, ORIGIN_FUNCTION as OrigFunction}#}
 
 data C_RelocationOrigin
   = OriginSection
       CString
       Word64
+  | OriginFunction
+      CString
 
 instance Storable C_RelocationOrigin where
   sizeOf _ = {#sizeof relocation_origin#}
   alignment _ = {#alignof relocation_origin#}
   peek ptr = (toEnum . fromIntegral <$> {#get struct relocation_origin->type#} ptr) >>= \ case
     OrigSection -> OriginSection <$> {#get struct relocation_origin->data.origin_section.section_name#} ptr
                                  <*> (fromIntegral <$> {#get struct relocation_origin->data.origin_section.offset#} ptr)
+    OrigFunction -> OriginFunction <$> {#get struct relocation_origin->data.origin_function.symbol_name#} ptr
   poke ptr (OriginSection n o) = do
     {#set struct relocation_origin->type#} ptr (fromIntegral $ fromEnum OrigSection)
     {#set struct relocation_origin->data.origin_section.section_name#} ptr n
     {#set struct relocation_origin->data.origin_section.offset#} ptr (fromIntegral o)
+  poke ptr (OriginFunction s)  = do
+    {#set struct relocation_origin->type#} ptr (fromIntegral $ fromEnum OrigFunction)
+    {#set struct relocation_origin->data.origin_function.symbol_name#} ptr s
 
 newRelocationOrigin :: RelocationOrigin -> IO (Ptr C_RelocationOrigin)
 newRelocationOrigin rel = do
@@ -228,18 +236,23 @@ newRelocationOrigin rel = do
     SectionReloc name offset -> do
       str <- newCString name
       poke ptr $ OriginSection str (fromIntegral offset)
+    FunctionReloc sym        -> do
+      str <- newCString sym
+      poke ptr $ OriginFunction str
   pure ptr
 
 peekRelocationOrigin :: Ptr C_RelocationOrigin -> IO RelocationOrigin
 peekRelocationOrigin ptr = do
   peek ptr >>= \ case
     OriginSection n o -> SectionReloc <$> peekCString n
                                       <*> pure (fromIntegral o)
+    OriginFunction n  -> FunctionReloc <$> peekCString n
 
 freeRelocationOrigin :: Ptr C_RelocationOrigin -> IO ()
 freeRelocationOrigin ptr = do
   peek ptr >>= \ case
     OriginSection n o -> free n
+    OriginFunction n  -> free n
   free ptr
 
 data C_RelocationSymbol (n :: Size)

lib/nsc-codegen/nsc-codegen.cabal

@@ -1,6 +1,6 @@
 cabal-version: 1.12
 
--- This file has been generated from package.yaml by hpack version 0.34.2.
+-- This file has been generated from package.yaml by hpack version 0.34.4.
 --
 -- see: https://github.com/sol/hpack
 
@@ -30,6 +30,7 @@ library
       Language.NStar.CodeGen.Machine.X64.Salloc
       Language.NStar.CodeGen.Machine.X64.Sfree
       Language.NStar.CodeGen.Machine.X64.Sld
+      Language.NStar.CodeGen.Machine.X64.Sref
       Language.NStar.CodeGen.Machine.X64.Sst
       Language.NStar.CodeGen.Machine.X64.St
       Language.NStar.CodeGen.PreProcessor
@@ -38,7 +39,12 @@ library
       Paths_nsc_codegen
   hs-source-dirs:
       src
-  default-extensions: BlockArguments LambdaCase BinaryLiterals ImplicitParams OverloadedStrings
+  default-extensions:
+      BlockArguments
+      LambdaCase
+      BinaryLiterals
+      ImplicitParams
+      OverloadedStrings
   ghc-options: -Wall -Wextra -Wno-name-shadowing -Wno-unused-matches -Wno-overlapping-patterns
   build-depends:
       base >=4.7 && <5

lib/nsc-codegen/src/Language/NStar/CodeGen/Compiler.hs

@@ -22,7 +22,7 @@ instance Monoid MachineInfo where
   mempty = MInfo mempty mempty mempty mempty
 
 data SymbolType'
-  = Function Integer
+  = Function Integer Bool
   | Object Integer
 
 data DataTable