Skip to content

Commit

Permalink
adds several new Primus Lisp primitives and new instructions
Browse files Browse the repository at this point in the history
This commit adds three new primitives that could be used in definition
instruction semantics:

 - invoke-subroutine, especially useful for intrinsic calls
 - empty, which denotes empty semantics, useful for nops
 - special to denote special semantics, like `hlt`

It also implements semantics for several missing semantics (detected
with `--print-missing`), mostly nops, but there's one significant
finding - the `popa` (POPA32 in llvm parlance) instruction from x86,
which was surprisingly missing.
  • Loading branch information
ivg committed Jan 21, 2022
1 parent b80212b commit 97426ff
Show file tree
Hide file tree
Showing 5 changed files with 46 additions and 5 deletions.
1 change: 1 addition & 0 deletions oasis/powerpc
Original file line number Diff line number Diff line change
Expand Up @@ -40,6 +40,7 @@ Library powerpc_plugin
Powerpc_shift,
Powerpc_store,
Powerpc_sub
DataFiles: semantics/*.lisp ($datadir/bap/primus/semantics)
XMETAExtraLines: tags="powerpc, lifter"

Library powerpc_test
Expand Down
1 change: 1 addition & 0 deletions oasis/x86
Original file line number Diff line number Diff line change
Expand Up @@ -75,6 +75,7 @@ Library x86_plugin
X86_legacy_fp_lifter,
X86_legacy_bil_register,
X86_legacy_operands
DataFiles: semantics/*.lisp ($datadir/bap/primus/semantics)
XMETAExtraLines: tags="disassembler, lifter, x86, abi"

Library x86_test
Expand Down
7 changes: 7 additions & 0 deletions plugins/arm/semantics/aarch64.lisp
Original file line number Diff line number Diff line change
Expand Up @@ -250,3 +250,10 @@
(defun Bcc (cnd off)
(when (condition-holds cnd)
(relative-jump off)))

(defun HINT (_)
(empty))


(defun UDF (exn)
(special :undefined-instruction))
35 changes: 30 additions & 5 deletions plugins/primus_lisp/primus_lisp_semantic_primitives.ml
Original file line number Diff line number Diff line change
Expand Up @@ -144,7 +144,10 @@ let export = Primus.Lisp.Type.Spec.[
machine word.";

"exec-addr", one int @-> any,
"(exec-addr ADDR) transfers control flow to ADDR.";
"(exec-addr ADDR) transfers control to ADDR.";

"invoke-subroutine", one sym @-> any,
"(invoke-subroutine NAME) passes control to the subroutine NAME.";

"goto-subinstruction", one int @-> any,
"(goto-subinstruction N) transfers control flow to a
Expand Down Expand Up @@ -188,7 +191,7 @@ let export = Primus.Lisp.Type.Spec.[
"get-current-program-counter", unit @-> int,
"(get-current-program-counter) is an alias to (get-program-counter)";

"set-symbol-value", tuple [int; a] @-> a,
"set-symbol-value", tuple [any; a] @-> a,
"(set-symbol-value S X) sets the value of the symbol S to X.
Returns X";

Expand Down Expand Up @@ -229,6 +232,11 @@ let export = Primus.Lisp.Type.Spec.[
"nth", (one any @-> bool),
"(nth N X) returns the Nth bit of X. N must be static. \
The function is equivalent to (select N X)";
"empty", (unit @-> any),
"(empty) denotes an instruction that does nothing, i.e., a nop.";
"special", (one sym @-> any),
"(special :NAME) produces a special effect denoted by the keyword :NAME.
The effect will be reified into the to the special:name subroutine. ";
]

type KB.conflict += Illformed of string
Expand Down Expand Up @@ -433,6 +441,9 @@ module Primitives(CT : Theory.Core)(T : Target) = struct
let memory eff res =
full CT.(blk null (perform eff) skip) res

let nop () =
CT.perform Theory.Effect.Sort.bot

let loads = memory Theory.Effect.Sort.rmem
let stores = memory Theory.Effect.Sort.wmem
let loads = pure
Expand Down Expand Up @@ -620,6 +631,20 @@ module Primitives(CT : Theory.Core)(T : Target) = struct
| Some _ -> true_
| _ -> false_

let is_keyword = String.is_prefix ~prefix:":"

let special dst =
require_symbol dst @@ fun dst ->
if is_keyword dst then
let* dst = Theory.Label.for_name ("special"^dst) in
CT.goto dst
else illformed "special requires a keyword as the tag, e.g., :hlt"

let invoke_subroutine dst =
require_symbol dst @@ fun dst ->
let* dst = Theory.Label.for_name dst in
CT.goto dst

let mk_cast t cast xs =
binary xs @@ fun sz x ->
to_sort sz >>= fun s ->
Expand Down Expand Up @@ -784,12 +809,12 @@ module Primitives(CT : Theory.Core)(T : Target) = struct
| "extract",xs -> pure@@extract xs
| "concat", xs -> pure@@concat xs
| ("select"|"nth"),xs -> pure@@select s xs
| "empty",[] -> nop ()
| "special",[dst] -> ctrl@@special dst
| "invoke-subroutine",[dst] -> ctrl@@invoke_subroutine dst
| _ -> !!nothing
end




module Lisp = Primus.Lisp.Semantics

let provide () =
Expand Down
7 changes: 7 additions & 0 deletions plugins/riscv/semantics/riscv.lisp
Original file line number Diff line number Diff line change
Expand Up @@ -214,3 +214,10 @@

(defun C_BNEZ (rs1 off)
(conditional-jump (not (is-zero rs1)) off))


(defun C_NOP ()
(empty))

(defun NOP ()
(empty))

0 comments on commit 97426ff

Please sign in to comment.