From a1e806d8bc27f3878828568e33ea1bd73cc3c974 Mon Sep 17 00:00:00 2001 From: John Sonchack Date: Wed, 20 May 2026 19:45:36 -0400 Subject: [PATCH 01/49] tuple type parens syntax --- src/lib/frontend/Parser.mly | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/src/lib/frontend/Parser.mly b/src/lib/frontend/Parser.mly index 3943a41e..9b36f712 100644 --- a/src/lib/frontend/Parser.mly +++ b/src/lib/frontend/Parser.mly @@ -263,9 +263,18 @@ poly: single_poly: | LESS size MORE { Span.extend $1 $3, snd $2 } -ty_or_empty_tuple: +ty_or_empty_tuple: | ty { $1 } | LPAREN RPAREN { ty_sp (TTuple([])) (Span.extend $1 $2) } + /* Parenthesized comma-form tuple type, e.g. `(int<48>, int<32>)`. Only + legal inside `<<...>>` slots (Table.t key/data/arg/ret) because that's + the only place `ty_or_empty_tuple` is used. Requires at least two + element types so `(t)` continues to mean a parenthesized single ty, + not a 1-tuple. Avoids the lexer-greedy `>>` issue that `tuple<<...>>` + runs into when the inner type ends in `>`. */ + | LPAREN ty COMMA tys RPAREN { + let raw_tys = List.map (fun ty -> ty.raw_ty) ($2 :: (snd $4)) in + ty_sp (TTuple raw_tys) (Span.extend $1 $5) } ty_polys: | ty_or_empty_tuple { [$1] } From 70f170217ec6d45da0f8a71c226f6917f0fd6886 Mon Sep 17 00:00:00 2001 From: John Sonchack Date: Sat, 23 May 2026 16:03:51 -0400 Subject: [PATCH 02/49] added first draft of bmv2 example ports --- examples/p4_bmv2_examples/Lucid-overview.md | 495 ++++++++++++++++++ examples/p4_bmv2_examples/README.md | 21 + examples/p4_bmv2_examples/basic/README.md | 113 ++++ examples/p4_bmv2_examples/basic/basic.dpt | 115 ++++ examples/p4_bmv2_examples/basic/basic.json | 89 ++++ .../p4_bmv2_examples/basic_tunnel/README.md | 62 +++ .../basic_tunnel/basic_tunnel.dpt | 168 ++++++ .../basic_tunnel/basic_tunnel.json | 95 ++++ examples/p4_bmv2_examples/calc/README.md | 72 +++ examples/p4_bmv2_examples/calc/calc.dpt | 102 ++++ examples/p4_bmv2_examples/calc/calc.json | 62 +++ examples/p4_bmv2_examples/calc/gen_spec.py | 87 +++ examples/p4_bmv2_examples/ecn/README.md | 82 +++ examples/p4_bmv2_examples/ecn/ecn.dpt | 164 ++++++ examples/p4_bmv2_examples/ecn/ecn.json | 165 ++++++ examples/p4_bmv2_examples/ecn/gen_spec.py | 89 ++++ examples/p4_bmv2_examples/flowcache/README.md | 61 +++ .../p4_bmv2_examples/flowcache/flowcache.dpt | 167 ++++++ .../p4_bmv2_examples/flowcache/flowcache.json | 80 +++ .../p4_bmv2_examples/flowcache/gen_spec.py | 105 ++++ .../p4_bmv2_examples/link_monitor/README.md | 64 +++ .../p4_bmv2_examples/link_monitor/gen_spec.py | 177 +++++++ .../link_monitor/link_monitor.dpt | 212 ++++++++ .../link_monitor/link_monitor.json | 358 +++++++++++++ .../p4_bmv2_examples/load_balance/README.md | 77 +++ .../p4_bmv2_examples/load_balance/gen_spec.py | 166 ++++++ .../load_balance/load_balance.dpt | 224 ++++++++ .../load_balance/load_balance.json | 313 +++++++++++ examples/p4_bmv2_examples/mri/README.md | 42 ++ examples/p4_bmv2_examples/mri/gen_spec.py | 193 +++++++ examples/p4_bmv2_examples/mri/mri.dpt | 349 ++++++++++++ examples/p4_bmv2_examples/mri/mri.json | 299 +++++++++++ examples/p4_bmv2_examples/multicast/README.md | 54 ++ .../p4_bmv2_examples/multicast/gen_spec.py | 98 ++++ .../p4_bmv2_examples/multicast/multicast.dpt | 73 +++ .../p4_bmv2_examples/multicast/multicast.json | 115 ++++ examples/p4_bmv2_examples/p4runtime/README.md | 73 +++ .../p4_bmv2_examples/p4runtime/controller.py | 198 +++++++ .../p4_bmv2_examples/p4runtime/p4runtime.dpt | 113 ++++ .../p4_bmv2_examples/p4runtime/p4runtime.json | 4 + examples/p4_bmv2_examples/qos/README.md | 32 ++ examples/p4_bmv2_examples/qos/gen_spec.py | 72 +++ examples/p4_bmv2_examples/qos/qos.dpt | 138 +++++ examples/p4_bmv2_examples/qos/qos.json | 68 +++ .../p4_bmv2_examples/source_routing/README.md | 64 +++ .../source_routing/gen_spec.py | 131 +++++ .../source_routing/source_routing.dpt | 202 +++++++ .../source_routing/source_routing.json | 91 ++++ 48 files changed, 6394 insertions(+) create mode 100644 examples/p4_bmv2_examples/Lucid-overview.md create mode 100644 examples/p4_bmv2_examples/README.md create mode 100644 examples/p4_bmv2_examples/basic/README.md create mode 100644 examples/p4_bmv2_examples/basic/basic.dpt create mode 100644 examples/p4_bmv2_examples/basic/basic.json create mode 100644 examples/p4_bmv2_examples/basic_tunnel/README.md create mode 100644 examples/p4_bmv2_examples/basic_tunnel/basic_tunnel.dpt create mode 100644 examples/p4_bmv2_examples/basic_tunnel/basic_tunnel.json create mode 100644 examples/p4_bmv2_examples/calc/README.md create mode 100644 examples/p4_bmv2_examples/calc/calc.dpt create mode 100644 examples/p4_bmv2_examples/calc/calc.json create mode 100644 examples/p4_bmv2_examples/calc/gen_spec.py create mode 100644 examples/p4_bmv2_examples/ecn/README.md create mode 100644 examples/p4_bmv2_examples/ecn/ecn.dpt create mode 100644 examples/p4_bmv2_examples/ecn/ecn.json create mode 100644 examples/p4_bmv2_examples/ecn/gen_spec.py create mode 100644 examples/p4_bmv2_examples/flowcache/README.md create mode 100644 examples/p4_bmv2_examples/flowcache/flowcache.dpt create mode 100644 examples/p4_bmv2_examples/flowcache/flowcache.json create mode 100644 examples/p4_bmv2_examples/flowcache/gen_spec.py create mode 100644 examples/p4_bmv2_examples/link_monitor/README.md create mode 100644 examples/p4_bmv2_examples/link_monitor/gen_spec.py create mode 100644 examples/p4_bmv2_examples/link_monitor/link_monitor.dpt create mode 100644 examples/p4_bmv2_examples/link_monitor/link_monitor.json create mode 100644 examples/p4_bmv2_examples/load_balance/README.md create mode 100644 examples/p4_bmv2_examples/load_balance/gen_spec.py create mode 100644 examples/p4_bmv2_examples/load_balance/load_balance.dpt create mode 100644 examples/p4_bmv2_examples/load_balance/load_balance.json create mode 100644 examples/p4_bmv2_examples/mri/README.md create mode 100644 examples/p4_bmv2_examples/mri/gen_spec.py create mode 100644 examples/p4_bmv2_examples/mri/mri.dpt create mode 100644 examples/p4_bmv2_examples/mri/mri.json create mode 100644 examples/p4_bmv2_examples/multicast/README.md create mode 100644 examples/p4_bmv2_examples/multicast/gen_spec.py create mode 100644 examples/p4_bmv2_examples/multicast/multicast.dpt create mode 100644 examples/p4_bmv2_examples/multicast/multicast.json create mode 100644 examples/p4_bmv2_examples/p4runtime/README.md create mode 100644 examples/p4_bmv2_examples/p4runtime/controller.py create mode 100644 examples/p4_bmv2_examples/p4runtime/p4runtime.dpt create mode 100644 examples/p4_bmv2_examples/p4runtime/p4runtime.json create mode 100644 examples/p4_bmv2_examples/qos/README.md create mode 100644 examples/p4_bmv2_examples/qos/gen_spec.py create mode 100644 examples/p4_bmv2_examples/qos/qos.dpt create mode 100644 examples/p4_bmv2_examples/qos/qos.json create mode 100644 examples/p4_bmv2_examples/source_routing/README.md create mode 100644 examples/p4_bmv2_examples/source_routing/gen_spec.py create mode 100644 examples/p4_bmv2_examples/source_routing/source_routing.dpt create mode 100644 examples/p4_bmv2_examples/source_routing/source_routing.json diff --git a/examples/p4_bmv2_examples/Lucid-overview.md b/examples/p4_bmv2_examples/Lucid-overview.md new file mode 100644 index 00000000..709881e8 --- /dev/null +++ b/examples/p4_bmv2_examples/Lucid-overview.md @@ -0,0 +1,495 @@ +Lucid is an event-based data-plane language. It is imperative and syntax is similar to c++ or rust. It has domain-specific constructs inspired by P4, but is higher level, more expressive, and simpler. + +*Advice for agents programming in Lucid.* When developing in Lucid, work incrementally. Write the program first and type-check it, then fix errors, then generate a test spec (consider using a Python helper script if it is complicated). Do not try to plan or pre-compute the complete solution. + +## Contents +- [Basic features](#basic-features) — the core primitives, with a complete small example +- [Key constraints](#key-constraints) — non-obvious rules; read before writing event handlers +- [Parser constraints](#parser-constraints) — rules specific to parsers +- [Common gotchas](#common-gotchas) — surface-level things that trip up newcomers +- [Running a program](#running-a-program) — interpreter, software switch, Tofino compiler +- [Additional language features](#additional-language-features) + - [Builtins](#builtins) — types, `ingress_port`, `hash`, `Array`, `generate*`, `read` + - [Externs](#externs) + - [Tables](#tables) — match-action tables, actions, lookup, install + - [Functions](#functions) + - [Sizes, vectors, and loops](#sizes-vectors-and-loops) + - [Polymorphism](#polymorphism) + - [Modules and constructors](#modules-and-constructors) + - [Multicast](#multicast) + - [Tuples](#tuples) +- [Interpreter](#interpreter) — JSON spec file format + - [Event inputs](#event-inputs) + - [Unparsed packet events](#unparsed-packet-events) + - [Control command events](#control-command-events) — `Array.get`/`set`, `Table.install` + - [Network topology](#network-topology) + - [Other specification fields](#other-specification-fields) + - [Interpreter output](#interpreter-output) +- [End-to-end interpreter workflow example](#end-to-end-interpreter-workflow-example) — program + spec + annotated output +- [The Lucid virtual switch](#the-lucid-virtual-switch) +- [The Tofino compiler](#the-tofino-compiler) + +## Basic features +The core primitives of a Lucid program are events, handlers, globals, memops, parsers, and records. + +Events abstract packets, asynchronous operations, and message passing between distributed components. + +Handlers are imperative functions that process events, perform operations on global state, and generate more events. + +Globals can be read or written by handlers and persist across handler execution. They are constructed and operated on by helpers in the builtin Array and Table modules. + +Memops are special functions passed to Array methods to operate on globals. They are restricted so they can compile to an atomic instruction: a memop may only include a return statement, or an if/else with a return statement in each branch. Expressions in the return and if/else statements can use each memop argument at most once, plus an unlimited number of constants. + +Parsers are functions from unparsed packets to events. Events dispatched by parsers should be labeled as "packet" events and contain a final argument of type "Payload.t". + +Records are type declarations with fields separated and terminated by `;`, like structs. + +Events are dispatched by one of three statements: `generate(e)` enqueues `e` for asynchronous handling on this switch; `generate_port(p, e)` emits packet event `e` out port `p`; `generate_ports(g, e)` emits `e` out every port in multicast group `g` (see Multicast). + +Here is a simple lucid example of an ethernet packet counter and reflector: +``` +const int seed = 12345; + +type eth_hdr_t = {int<48> dmac; int<48> smac; int<16> ety;} + +global Array.t<32> cts = Array.create(1024); // Create an array holding 1024 32-bit ints. + +event print_count(int<16> idx, int<32> ct); +packet event eth_pkt(eth_hdr_t eth_hdr, Payload.t pl); + +memop memval(int mv, int unused) { + return mv; +} +memop incr(int mv, int incrby) { + return mv + incrby; +} + +handle eth_pkt(eth_hdr_t eth_hdr, Payload.t pl) { + int<10> idx = hash<10>(seed, eth_hdr#dmac, eth_hdr#smac); // take the hash of the ethernet flow key. + // Array.update(arr, idx, get_memop, get_arg, set_memop, set_arg): + // the get_memop computes the return value, the set_memop computes the new cell value. + // idx can be any int size; out-of-bounds indices wrap with a modulo. + int ct = Array.update(cts, idx, memval, 0, incr, 1); + // Equivalent to (atomically): + // ct = memval(cts[idx], 0); + // cts[idx] = incr(cts[idx], 1); + generate(print_count((int<16>)idx, ct)); // generate print_count to handle asynchronously. + generate_port(ingress_port, eth_pkt(eth_hdr, pl)); // generate eth_pkt out of the port it arrived on. ingress_port is a builtin. +} + +handle print_count(int<16> idx, int<32> ct) { + printf("index: %d, count: %d", idx, ct); +} + +// a parser maps unparsed bitstrings to packet events. +// parsers for regular (non packet) events are generated by the compiler. +parser main(bitstring pkt) { + eth_hdr_t eth_hdr = read(pkt); + match eth_hdr#ety with + | LUCID_ETHERTY -> { + // a parser must begin by extracting some form of an ethernet header, matching on the LUCID_ETHERTY builtin, and calling do_lucid_parsing in that branch. + do_lucid_parsing(pkt); + } + | 0x0800 -> { drop; } // match branches can use integer literals, formatted as decimal or hex + | _ -> { + generate(eth_pkt(eth_hdr, Payload.parse(pkt))); + } +} +``` + + +## Key constraints +A handful of rules shape how Lucid programs are written. Lucid's type checker enforces these rules and provides reasonable error messages if you make a mistake. + +- **Within any execution path, globals may only be accessed in declaration order.** Any path may skip any global entirely — the ordering rule only applies to accesses that do occur. Two branches may perform different operations on the same global, or one branch may access a global while the other skips it completely. You can also revisit a global by generating another event to do it asynchronously. Lucid's type checker will tell you which global operations are misordered if you make a mistake. +- **Functions are non-recursive.** Recursion is only possible via events (a handler may generate its own event). +- **Sizes are compile-time only.** A `size` is not a runtime value. `size_to_int` converts a size to an int; there is no reverse. +- **Memops compile to atomic instructions.** They take exactly two int parameters (the current memory value and one runtime argument) and have a restricted expression grammar — no calls to other functions, no loops. + +## Parser constraints +Parsers have a few additional constraints: + +- **Parsers must begin with an ethernet header and branch on `LUCID_ETHERTY`.** The `LUCID_ETHERTY` branch must call `do_lucid_parsing(pkt)`; other branches generate user-defined packet events. +- **Parsers must terminate explicitly.** Every branch of a parser must terminate by either: a) generating an event; b) calling another parser; or c) calling "drop;", a builtin *statement* to drop the packet. Note that "drop" cannot be called from a handler, where dropping is the default behavior when no events are generated. +- **Other parser restrictions.** Other parser restrictions are similar to P4. A parser cannot access globals, use if/else statements, perform arithmetic or boolean operations, and can only match on one variable at a time. Note that nested match statements are supported. Also, match statements can also be used in handlers, with the same syntax as in parsers and with support for multiple variables. + +## Tips + +- Overall, Lucid is designed to make data-plane programming more like conventional programming. When uncertain about whether something is valid, the most effective approach is to just write it and run the type checker — it will give precise, actionable error messages. Don't reason from first principles about what might be allowed; write your best guess and iterate. +- Nested matches are allowed in parsers. +- Read operations in the parser do not add padding (e.g., between fields). +- Take advantage of the type checker to help you reason about global ordering. +- Handlers can generate multiple events. +- **Reach for `packet event` only when the protocol talks to non-Lucid endpoints.** A `packet event` is bound to a wire format: it goes through a parser on ingress and the auto-deparser on egress, which imposes real constraints (no variable-length stacks, every positional arg must occupy a distinct hardware slot, etc.). For *control protocols* that originate and terminate inside Lucid, or at Lucid-aware endpoints — probes, telemetry, distributed coordination, scheduling messages — declare a regular `event` instead. Regular events have no wire format, no parser constraints, no slot-analysis restrictions; they can carry vectors and records freely, and `generate_port` still ferries them between switches in the simulator. The data-plane semantics are identical; you only give up the ability to interoperate with non-Lucid senders/receivers, which most internal protocols don't need. +- You can also model complicated data plane programs with regular events first, to make testing easier, and then add packet events in later. +- Recursive events are good for housekeeping and data structure maintenence. The handler of a recursive event will execute periodically, like a background thread waking up to perform a task. + +## Common gotchas +Surface-level things that trip up newcomers: + +- `int`s in Lucid are **unsigned**. There are currently no signed ints. +- `#` is used for both record field access (`eth_hdr#dmac`) and tuple indexing (`pair#0`). +- `hash(seed, ...)` requires a seed as the first argument; the `N` in angle brackets is the output bit-width. +- For a table with no runtime argument (`arg_ty = ()`), pass `()` explicitly: `Table.lookup(tbl, key, ())`. +- Polymorphic identifiers begin with a tick: `'a`, `'n`. Use `auto` only when the type checker should infer a single hole. +- `size` values cannot be used where an `int` is expected — convert with `size_to_int`. There is no `int_to_size`. +- `printf` is interpreter-only; it does not appear in compiled Tofino programs. Its format string supports `%d` only — `%x`, `%s`, etc. fail at parse time. +- Bitwise XOR is `^^`. Single `^` is bitstring concatenation. +- Casts use C-style syntax: `(int<16>)idx` and truncate the higher-order bits. Cast binds tighter than `#` (record field access), so use `(int)(rec#field)`. Also, bare `int` does not work in a cast. +- A bare `int`, used as a type with no widths, means `int<32>` by default. Note that int literal *values*, such as in match arms and assignments, are inferred to the surrounding context's width. +- Record field names are resolved globally. So two different record types cannot have a field with the same name. +- JSON interpreter spec entries cannot carry comments. + +## Running a program +There are three stages, from fastest feedback to most realistic. Most development happens in stages 1 and 2. + +**1. Type-check and simulate with the interpreter (`dpt`).** Run `./dpt foo.dpt` for a quick type-check (errors print with file:line locations), or `./dpt foo.dpt --spec foo.json` to simulate a JSON-described trace of input events against an optional topology. The interpreter prints `printf` output, generated events, and a final state summary. This is the fastest loop — see the [Interpreter](#interpreter) section for spec file details. + +**2. Run live on the Lucid virtual switch (`lucidSwitch`).** `./lucidSwitch foo.dpt --interface 0:veth0 --interface 1:veth1` runs the program against real (low-rate, ~1 Gbps) traffic on raw socket interfaces, similar in spirit to an OVS switch. This is the intended target for live testing and is where most development will stop. See [The Lucid virtual switch](#the-lucid-virtual-switch). + +**3. (Optional) Compile to Tofino (`dptc`).** `./dptc foo.dpt` compiles to P4 for the Intel Tofino. Only relevant if you are specifically targeting that hardware; there are additional resource and language restrictions — see the tutorials. + +## Additional language features + +### Builtins +- `int` : integer type of width `W` +- `bool` : boolean type +- `bitstring` : the type of an unparsed packet. May only be used in parsers. +- `Payload.t` : the type of an unparsed packet payload. +- `Payload.parse(pkt)` : converts pkt (of type `bitstring`) into a `Payload.t`. Should only be used in generate statements inside of a parser. +- `ingress_port`: the port a packet arrived on. Type depends on the target, in the interpreter and software switch, it is an `int<32>`. In the Tofino, it is an `int<9>`. +- `self`: the id of the switch (in a multi-node simulation) +- `Sys.time()`: the timestamp of the current event's arrival, in nanoseconds +- `Sys.random()`: returns a random 32-bit integer +- `v = hash(seed, arg, [arg...])`: hash the argument list to an `int`, using the given seed. +- `generate(e)`: statement that generates event e +- `generate_port(p, e)`: statement that generates an event e and emits it out of port p. The type of `p` depends on the target, in the interpreter it is an `int<32>` and in the Tofino it is an `int<9>`. +- `v = Array.get(array, idx)`: returns `array[idx]` to `v` +- `Array.set(array, idx, v)`: sets `array[idx] = v` +- `v = Array.getm(array, idx, fget, arg)`: returns `fget(array[idx], arg)` to `v` +- `Array.setm(array, idx, fset, arg)`: sets `array[idx] = fset(array[idx], arg)` +- `v = Array.update(array, idx, fget, getarg, fset, setarg)` : returns `fget(array[idx], getarg)` to `v` and, in parallel, sets `array[idx] = fset(array[idx], setarg)` +- `t v = read(pkt)` : a read statement, only available in the parser. Requires `pkt` to be of type `bitstring`.Extracts a value of type `t` from the `pkt` and increments its cursor by the appropriate number of bits. +- `printf(str, args, ...)` : prints a string, which may include any number of "%d" format specifiers and a matching number of int args. + + +### Externs +Top-level variables can be declared as externs, which are assigned values by the compiler or interpreter: `extern int foo;` + +### Tables +Match-action tables map keys to action functions. Their primary operations are lookup and install. + +#### Declaration +`Table.create` creates a table. The declaration: + +`global Table.t<> tbl = Table.create(sz, actions, default_action, default_data);` + +Creates the table `tbl` of type `Table.t<>`, with `sz` entries. Each entry stores a key, data, and action function of type `data_ty -> arg_ty -> ret_ty`. The table will also have a default entry `default_action` and `default_data`, which is applied on `Table.lookup` if no other entries match. All of a table's actions must have the same data, arg, and return types. + +#### Actions +Actions are pure functions only used by tables. They have two sets of parameters, the first corresponds to `data_ty` in a table declaration, and is passed the install-time entry parameter. The second set of parameters correspond to `action_ty`, and are passed arguments when a table lookup is called. + +The grammar is: +``` +action "name"()()"{"return "}" +``` + +``` +action int plus(int p1)(int p2) { + return p1 + p2; +} +``` + +#### Table lookup +```ret_ty result = Table.lookup(tbl, key, arg);``` + +This finds the first entry in the table with a matching key and executes it, passing in the entry's data and arg as the two sets of action parameters. The action's result is returned as Table.lookup's output. + +This executes, as psuedocode: +``` +def lookup(tbl, key, arg): + for i in range(len(tbl.records)): + entry = tbl.records[i] + if (key == entry.key): # match! + data = entry.data + action = entry.action + return action(data, arg) + # no matches, run default action + return tbl.default_action(tbl.default_data, arg) +``` + +If the table has no runtime argument, pass `()` as arg. + +#### Table install + +```Table.install(tbl, key, acn, data);``` + +This installs an entry into `tbl` that matches on `key` and calls `acn` with first argument `data`. + +```Table.install_ternary(tbl, key, mask, acn, data);``` +This installs a masked entry into `tbl`. A masked entry only considers the masked bits of the key at lookup time. In other words, if `Table.lookup(tbl, k, arg);` is called, the masked entry installed above will match when `key && mask == k && mask`. + +### Functions +Lucid programs can declare and use non-recursive functions. Functions can do everything a handler does, including declaring and mutating locally-scoped variables. +``` +fun bool check_tcp_flag(tcp_t tcp, int<8> flagval) { + return tcp#flags == flagval; +} +``` + +### Sizes, vectors, and loops +Sizes are a kind of integer used only to specify compile-time data structure sizes. Their primary use is for int widths and vectors of globals. For example: +``` +size n_bits = 10; +size n_cols = 4; +const int foo = 1023; +// a vector of n_cols arrays that each have cells of size n_bits +global Array.t[n_cols] my_arrs = [Array.create(1024) for i < n_cols]; + +fun void print_vals(int[n_cols] idxs) { + for (i < n_cols) { + int v = Array.get(my_arrs[i], idxs[i]); + int ival = size_to_int(i); // a builtin to convert a size to an int, note the reverse operation is not possible. + printf("my_arrs[%d][%d] = %d", ival, idxs[i], v); + } +} + +``` + +### Polymorphism +Types and sizes can be polymorphic. Use the "auto" keyword in place of a type or size parameter, or a polymorphic identifier, which begins with a "'" (tick mark) and represents a "hole" that the type checker will attempt to fill. For example, a function add that works for any sized int: +``` +fun int<'a> add1(int<'a> x) { return x + 1; } +``` + +### Modules and constructors +Modules in Lucid work similar to basic OCaml modules. A module has an interface and an implementation. The interface declares datatypes, constructors, functions, and events that client code may access, the implementation defines them and other private internal components. Types declared in a module interface may be tagged as "global", indicating they can only be used for global variables. For example: + +``` +module Array32Vec : { + global type t<'n>; + constr t<'n> create(int<32> array_length); + + fun void print_vals(t<'n> self, int<32>['n] idxs); + + event update(t<'n> self, int<32>['n] idxs, int<32>['n] vals); +} +// implementation +{ + type t<'n> = {Array.t<32>['n] arrs} + constr t<'n> create(int<32> array_length) = { arrs=[Array.create(array_length) for i < 'n] }; + fun void print_vals(t<'n> self, int<32>['n] idxs) { + for (i < 'n) { + int<32> v = Array.get(self#arrs[i], idxs[i]); + int ival = size_to_int(i); // a builtin to convert a size to an int, note the reverse operation is not possible. + printf("self#arrs[%d][%d] = %d", ival, idxs[i], v); + } + } +} +``` + +### Multicast +Multicast groups are sets of ports which are used in the `generate_ports` statement. There are two ways to define a multicast group: +* The expression `{0,4,7}` specifies a group value with the entries 0, 4 and 7. Any number of entries are allowed, but all entries must be constant integers (i.e. the syntax `{0, 4, port_id}` is not allowed) +* The expression `flood x` takes an integer `x` and generates a group corresponding to every port _except_ x. Unlike group value expressions, `x` is allowed to be computed dynamically (i.e. `flood port_id` is allowed). + +For example, this: `generate_ports(flood(ingress_port), my_event);` generates my_event to all ports except ingress_port. + +### Tuples +Lucid also supports tuples, for example: +``` +tuple<> my_tup = (1, 2, 3); + +fun int add(auto pair) { + return pair#0 + pair#1 + pair#2; +} +``` + +## Interpreter +The interpreter runs a Lucid program on an event input trace in a simulated network. The trace and network are defined in a json specification file. + +### Event inputs +The "events" field is a list of events to input to the simulator. Each event is a dictionary that defines a single event value, plus metadata about when and where it arrives to the network. For example: + +``` +{ + "events": [ + {"name":"my_event", "args":[1], "locations": ["0:1"], "timestamp": 1000}, + {"name":"my_event", "args":[2], "locations": ["0:2"], "timestamp": 2000} + ] +} +``` +This event trace contains two instances of the event "my_event", the first with an argument of 1, arriving at switch 0 port 1 at time 1000. + +### Unparsed packet events +The interpreter also supports "packet" events that contain only an unparsed bytestring. Packet events are how you invoke the parser of a lucid program in the interpreter. The json record for a packet event has the following form: `{"type":"packet", "bytes": HEX_STRING}`. + +For example: `{"type":"packet", "bytes":"0000000000030000000000040800", "locations": ["0:1"], "timestamp": 1000}` +This is a 14 byte packet (an ethernet header with dst_mac = 3, src_mac = 4, and ether_type = 0x0800). + +The hex bytes in a packet event are interpreted in raw network-order, i.e., left-to-right. + +### Control command events +Control commands read and write globals from the control plane. They model the control program that manages a Lucid data plane. There are a few predefined control events: "Array.get", "Array.set", and "Table.install". The json formats are: + +#### Array.get + +`{"type": "command", "name":"Array.get", "args":{"array":"myarr", "index":0}}` + +This fetches the value stored at index `0` of `myarr`, i.e., it is the equivalent of `Array.get(myarr, 0);` in a Lucid program. + +#### "Array.set" + +`{"type": "command", "name":"Array.set", "args":{"array":"A", "index":n, "value":[v]}}` + +sets `A[n]` to `v`. Note that the value field takes a _list_ containing a single integer. + +#### "Table.install" +Given a table: + +``` +global Table.t<> tbl = Table.create(sz, actions, default_action, default_data); +``` + +The table install command has the syntax: +```json +{"type": "command", "name":"Table.install", "args":{"table":"tbl", "key":[v0, v1, ..., vn], "mask":[m0, m1, ..., mn], "action":"tbl.acn_foo", "args":[arg1, ..., argl]}} +``` +This command installs an entry into `tbl` where the entry key is defined by `[v0, v1, ..., vn]` with mask `[m0, m1, ..., mn]`. Key and mask values are either ints (which are parsed as int<32>) or width-tagged int strings, e.g., "1<<8>>" for 1 as an 8-bit int. Note that "mask" is optional. + +The action is named "acn_foo", which must appear in the Table.create action list. Note that the action must be prefixed by the table name. + +### Network topology +By default, the interpreter runs a single switch that can receive and generate events for any port. In other words, `generate_port(3, ...)` will work even if port 3 is not declared anywhere. The interpreter can also simulate a multi-node topology by including a topology block. A topology consists of nodes and links. + +#### Nodes and links +The nodes block maps node ids to configurations. Node IDs must be contiguous starting from 0. Each node contains "ports" and "externs" fields. There are 3 kinds of ports: "link" ports, which may connect to other nodes inside the simulator, "recirc" ports, where an event to that port will recirculate to the same node, and "interface" ports, which connect to posix interfaces outside of the simulator. + +The "links" field of "topology" is a dictionary of bidirectional links, e.g., `links : {"0:1" : "1:0", "1:1" : "2:1"}` connects switch 0 port 1 with switch 1 port 0, and switch 1 port 1 with switch 2 port 1. + +An example of a complete specification using a topology block is below: + +```json +{ + "topology": { + "nodes": { + "0": { + "externs":{"foo":0}, + "ports": { + "0" : {"type": "link"}, + "1" : {"type": "link"}, + "2" : {"type": "recirc"}, + "3" : {"type": "interface", "ifname":"veth0"} + } + }, + "1": { + "externs":{"foo":1}, + "ports": { + "0" : {"type": "link"}, + "1" : {"type": "link"}, + "2" : {"type": "recirc"} + } + } + }, + "links": [ + {"0:1": "1:0"} + ] + }, + "events": [ + {"name":"my_event", "args":[1], "locations": ["0:0"], "timestamp": 1000}, + {"name":"my_event", "args":[2], "locations": ["1:1"], "timestamp": 1200} + ] +} +``` + +### Other specification fields +`"default_input_gap": N` controls the amount of time between events in the simulation. Defaults to 1000. +`"random_seed": N` controls the seed of the RNG, defaults to random based on current system time. +`"max time": N` controls how long the simulation runs, defaults to 10000. + +### Interpreter output +The interpreter outputs a timestampped log of events received by nodes and printfs. At the end of execution, the interpreter prints: 1) a list of exit events at node, which are events generated to ports (with `generate_port`) not connected to other nodes or interfaces; 2) the final state of all globals in each node. + +## End-to-end interpreter workflow example +A small but complete example: a per-port packet counter that also reflects each packet back out its ingress port. Shows how a program, its spec file, and the interpreter's output line up. + +**Program** (`portct.dpt`): +``` +type eth_hdr_t = {int<48> dmac; int<48> smac; int<16> ety;} + +global Array.t<32> port_cts = Array.create(8); + +memop incr(int mv, int by) { return mv + by; } + +packet event eth_pkt(eth_hdr_t eth, Payload.t pl); + +handle eth_pkt(eth_hdr_t eth, Payload.t pl) { + Array.setm(port_cts, ingress_port, incr, 1); + printf("port %d saw a packet (smac=%d)", ingress_port, eth#smac); + generate_port(ingress_port, eth_pkt(eth, pl)); +} + +parser main(bitstring pkt) { + eth_hdr_t eth = read(pkt); + match eth#ety with + | LUCID_ETHERTY -> { do_lucid_parsing(pkt); } + | _ -> { generate(eth_pkt(eth, Payload.parse(pkt))); } +} +``` + +**Spec** (`portct.json`) — three 14-byte ethernet packets arriving on ports 1, 2, and 1: +```json +{ + "events": [ + {"type": "packet", "bytes": "0000000000020000000000010800", "locations": ["0:1"], "timestamp": 1000}, + {"type": "packet", "bytes": "0000000000010000000000020800", "locations": ["0:2"], "timestamp": 2000}, + {"type": "packet", "bytes": "0000000000020000000000010800", "locations": ["0:1"], "timestamp": 3000} + ] +} +``` + +**Run** with `./dpt portct.dpt --spec portct.json --silent`. The output (trimmed) is: +``` +t=1000: Parsing packet 0000000000020000000000010800 at switch 0, port 1 # <- parser invoked +t=1000: Handling packet event eth_pkt(2,1,2048,) at switch 0, port 1 # <- handler invoked; args = (dmac, smac, ety, payload) +port 1 saw a packet (smac=1) # <- printf from the handler +t=2000: Parsing packet 0000000000010000000000020800 at switch 0, port 2 +t=2000: Handling packet event eth_pkt(1,2,2048,) at switch 0, port 2 +port 2 saw a packet (smac=2) +t=3000: Parsing packet 0000000000020000000000010800 at switch 0, port 1 +t=3000: Handling packet event eth_pkt(2,1,2048,) at switch 0, port 1 +port 1 saw a packet (smac=1) +dpt: Final State: +Switch 0 : { + Pipeline : [ + port_cts(0) : [0u32; 2u32; 1u32; 0u32; 0u32; 0u32; 0u32; 0u32] # <- final value of port_cts: index 1 saw 2 pkts, index 2 saw 1 + ] + Events : [ ] # <- in-flight non-packet events (none) + Exits : [ + bytes(0000000000020000000000010800) at port 1, t=1600 # <- generate_port emits go here when the port isn't connected + bytes(0000000000010000000000020800) at port 2, t=2600 + bytes(0000000000020000000000010800) at port 1, t=3600 + ] + Drops : [ ] + packet events handled: 3 + total events handled: 3 +} +``` + +A few things to recognize: +- The `Handling packet event ...(2,1,2048,)` line shows the *handler's view* of the event — record fields are flattened into positional arguments in declaration order (`dmac=2, smac=1, ety=0x800`), and the trailing empty entry is the (empty) `Payload.t`. +- `printf` output appears inline at the timestamp it fired. +- `port_cts(0)` is the final value of the array on switch `0`. Indices that were never written stay at 0. +- The **Exits** list is the data-plane output: bytes emitted via `generate_port` to a port not connected to another node or interface. Verifying the right packets came out the right ports usually means scanning this list. Each row is `bytes(...) at port P, t=T` — note `T` is later than the input timestamp by the per-event processing delay (~600 in this run). +- **Drops** lists packets explicitly dropped by a parser `drop;`. Handlers that just don't generate anything do *not* appear here — they silently produce no output. + + +## The Lucid virtual switch +The lucidSwitch binary uses the Lucid interpreter to run a virtual switch that operates only on interface ports. Instead of taking a config file, lucidSwitch is configured by the per-port "interface" argument. *Note that lucidSwitch uses system time for timestamps, which are taken when the interpreter fetches an event from the interface's input queue.* +```bash +./lucidSwitch prog.dpt --interface 0:veth0 --interface 1:veth1 +``` + +## The Tofino compiler +The dptc binary compiles a Lucid program to a P4-tofino program. See the tutorials or run `./dptc --help` for more information about arguments. + diff --git a/examples/p4_bmv2_examples/README.md b/examples/p4_bmv2_examples/README.md new file mode 100644 index 00000000..56ff48a5 --- /dev/null +++ b/examples/p4_bmv2_examples/README.md @@ -0,0 +1,21 @@ +# Example ports: P4 BMv2 tutorials → Lucid + +12 [P4 BMv2 tutorial examples](https://github.com/p4lang/tutorials) +as of 05/2026, ported to Lucid. Each port contains: a Lucid +program, an interpreter spec (some generated by a Python helper), +and a README. + +| Example | Notes | +|------------------|-------| +| basic | LPM forwarding, 4-switch pod-topo, IPv4 csum recompute + verify | +| basic_tunnel | Adds MyTunnel header + a second (exact-match) table; tunneled packets ride through unmodified | +| calc | Custom L2 protocol, in-network arithmetic; first example with a `gen_spec.py` (scapy) | +| load_balance | 3-table pipeline (ecmp_group + ecmp_nhop + send_frame), TCP 5-tuple hash splits magic-IP flows across 2 hosts | +| source_routing | Header stack via unrolled parser chain + per-depth events (`sr1`..`sr4`); no tables | +| mri | Push-stack telemetry header, per-depth events `mri_0`..`mri_3`; `swid=self`, `qdepth=0` (interp doesn't model queues) | +| link_monitor | Probes carried as **regular events** (not packet events) — single handler, vector args; per-port byte_cnt + last_time arrays | +| flowcache | Exact-match `(proto, src, dst)` cache; miss → `packet_in` regular-event to controller exit port; spec acts as the controller | +| qos | basic-style forwarding + per-protocol DSCP marking; splits IPv4 TOS into diffserv:6 + ecn:2 | +| multicast | L2 learn/forward + `flood ingress_port` for unknown/broadcast; "flood except ingress" is a single built-in | +| p4runtime | Dynamic controller via `dpt --interactive` + a Python `controller.py`; same packet_in/install loop as flowcache but driven live | +| ecn | Synthetic queue depth (1-cell array) + recursive `queue_decr` event; ECN-mark / drop thresholds on the synthesized signal | diff --git a/examples/p4_bmv2_examples/basic/README.md b/examples/p4_bmv2_examples/basic/README.md new file mode 100644 index 00000000..a2635fcc --- /dev/null +++ b/examples/p4_bmv2_examples/basic/README.md @@ -0,0 +1,113 @@ +# `basic` + +IPv4 forwarding via a control-plane-populated longest-prefix-match table. +On a table hit the switch rewrites the ethernet MACs, decrements the IPv4 TTL, +and emits the packet out the matched port. On a miss the default action drops +the packet. + +## Files +- [basic.dpt](basic.dpt) — the Lucid program. +- [basic.json](basic.json) — interpreter spec: 4-switch pod-topo + per-switch + `Table.install` commands (translating the P4 tutorial's `sX-runtime.json` + files) + three test packets. + +## Running +```bash +../../../sources/lucid/dpt basic.dpt --spec basic.json --silent +``` + +## Topology +A simple pod topology. Node IDs in the spec map to `s1..s4` as +`0..3`. Host-facing ports (s1 ports 1–2, s2 ports 1–2) are deliberately left +undeclared so forwarded packets show up in each node's `Exits` list, which is +what to scan to verify correct delivery. + +``` + h1 -- 1 [s1=0] 3 -------- 1 [s3=2] 2 -------- 4 [s2=1] 1 -- h3 + h2 -- 2 4 -------- 2 [s4=3] 1 -------- 3 2 -- h4 +``` + +## Test cases (in `basic.json`) +1. **h1 → h2** (intra-s1). Exits at `0:2` with dmac `08:00:00:00:02:22`, + smac `08:00:00:00:01:00`, ttl `63`, recomputed csum `0x64e8`. Input csum + is `0` so the handler logs a "bad input csum" line. +2. **h1 → h3** (3-hop: s1 → s3 → s2). Exits at `1:1` with dmac + `08:00:00:00:03:33`, smac `08:00:00:00:02:00`, ttl `61` (decremented at + each hop), csum `0x65e7`. Input has `csum=0` at s1, but each + intermediate hop produces a *valid* csum, so s3 and s2 do not log a + verify error. +3. **h1 → 10.99.99.99** (no route). Drops at s1 via the default action; no + exit packets, "drop" line in the log. +4. **h1 → h2 with a correct input csum** (`0x63e8`). Same forwarding + behavior as test 1, but no "bad input csum" line — confirms the + verify-side hash returns `0` for a well-formed packet. + +## Verifying the IPv4 checksum + +`hash(checksum, ...)` is a magic form: when the seed is the builtin +`checksum`, the interpreter routes the call to a real one's-complement +IPv4 checksum ([sources/lucid/src/lib/midend/interpreter/InterpCore.ml:180-212](../../../sources/lucid/src/lib/midend/interpreter/InterpCore.ml#L180-L212)) +instead of the normal hash function. The Tofino backend lowers the same +form to a P4 `Checksum()` extern, so the two targets agree. + +The handler uses this twice: + +- **Compute**: `{new_ip with hdr_csum = hash<16>(checksum, new_ip)}`, + with `new_ip.hdr_csum` pre-zeroed. +- **Verify**: `hash<16>(checksum, ip)` — hashing the *whole* + header including its existing csum. For a well-formed packet this must + return `0`, per RFC 1071. + +### Smoking-gun test (worked example) + +Test 1 input is the h1→h2 packet at `ttl=64`, `csum=0`. By hand, summing +the IP header's 16-bit words (with csum=0): +``` +0x4500 + 0x0014 + 0x0000 + 0x0000 + 0x4000 + + 0x0000 + 0x0A00 + 0x0101 + 0x0A00 + 0x0202 += 0x9C17 +~0x9C17 = 0x63E8 ← csum the input *should* have carried +``` +After s1 decrements TTL, the `(ttl,proto)` word drops from `0x4000` to +`0x3F00` (Δ = −0x100), so the new csum is `0x63E8 + 0x100 = 0x64E8`. +The interpreter prints exactly this in the exit packet: +``` +bytes(...3f0064e80a0001010a000202) at port 2 + ^^^^ + csum +``` + +Test 4 confirms the verify side: we hand it the same packet but with +`csum=0x63e8` (the value we just derived as "correct"). The handler's +verify call returns 0, so no "bad input csum" line is logged. + +### How to extend +- To exercise the verify path on a *malformed* packet, send any packet + with a wrong (non-zero, non-matching) csum and confirm the handler + prints `bad input csum (verify=...)` with the residual sum. +- Generating real test vectors by hand is tedious — a small Python script + using `scapy.IP(...).chksum` next to `basic.json` would be the obvious + next step. We did not add one yet to keep the example self-contained. + +## Notable design choices +- **LPM via `Table.install` masks.** The P4 program uses a `lpm` key; the + Lucid interpreter implements equivalent semantics through + `Table.install_ternary` (which also backs the JSON `Table.install` command + when a `mask` field is provided). The current spec uses /32 host routes + with the default (exact) mask. For real prefixes, add a `"mask":[...]` + entry to the install command and install longer prefixes first — the + interpreter matches entries in install order. +- **Install-time data is a tuple `(int<48>, int<32>)`.** The two action + install args (`dmac`, `port`) are declared positionally on the actions and + the table's data_ty reflects that as a tuple. The JSON `Table.install` + command's `args` list maps positionally onto the tuple fields + (`["<48>", "<32>"]`). +- **Distinct record field names across the program.** Lucid resolves record + field names globally (a `eth#dmac` reference is unified against any record + type that has a `dmac` field), so `fwd_t` uses prefixed names + (`fwd_dmac`/`fwd_port`/`fwd_hit`) to avoid clashing with `eth_hdr_t.dmac`. + +## Known caveats +- **No ARP / no host MAC learning.** Exactly like the P4 tutorial, ARP + resolution is assumed to have already been done; the control plane + installs the next-hop MAC alongside the egress port. diff --git a/examples/p4_bmv2_examples/basic/basic.dpt b/examples/p4_bmv2_examples/basic/basic.dpt new file mode 100644 index 00000000..95ead4de --- /dev/null +++ b/examples/p4_bmv2_examples/basic/basic.dpt @@ -0,0 +1,115 @@ +// IPv4 longest-prefix-match forwarding. +// The control plane (basic.json) installs one entry per known /32 host into +// `ipv4_lpm`. On a hit, the handler rewrites the ethernet src/dst MACs, +// decrements ttl, and emits the packet out the matching port. On a miss the +// default action drops the packet (handler returns without generating). + +const int<16> ETY_IPV4 = 0x0800; + +type eth_hdr_t = { + int<48> dmac; + int<48> smac; + int<16> ety; +} + +type ipv4_t = { + int<4> version; + int<4> ihl; + int<8> diffserv; + int<16> total_len; + int<16> id; + int<3> flags; + int<13> frag_offset; + int<8> ttl; + int<8> protocol; + int<16> hdr_csum; + int<32> src; + int<32> dst; +} + +// Result of a routing-table lookup. `fwd_hit=false` means "no entry matched, +// drop". Field names are prefixed so they don't collide with `eth_hdr_t` +// fields — Lucid resolves record fields by name across the whole program. +type fwd_t = { + int<48> fwd_dmac; + int<32> fwd_port; + bool fwd_hit; +} + +action fwd_t ipv4_forward(int<48> dmac, int<32> port)() { + return {fwd_dmac = dmac; fwd_port = port; fwd_hit = true}; +} + +// Must share the install-time data type with ipv4_forward to live in the +// same table; the install args are ignored. +action fwd_t ipv4_drop(int<48> _dmac, int<32> _port)() { + return {fwd_dmac = 0; fwd_port = 0; fwd_hit = false}; +} + +// Match-action table keyed on the IPv4 destination address. Entries are +// installed via Table.install commands in the JSON spec (use a /32 mask for +// host routes, or a shorter mask for prefix routes; longer prefixes should be +// installed first since the interpreter matches in install order). The +// data_ty `(int<48>, int<32>)` carries the next-hop MAC and egress port as +// the actions' install-time arguments. +global Table.t<, (int<48>, int<32>), (), fwd_t>> ipv4_lpm = + Table.create(1024, [ipv4_forward; ipv4_drop], ipv4_drop, (0, 0)); + +packet event ipv4_pkt(eth_hdr_t eth, ipv4_t ip, Payload.t pl); + +handle ipv4_pkt(eth_hdr_t eth, ipv4_t ip, Payload.t pl) { + // Verify-side checksum: hashing all IP header fields (csum included) should + // yield 0 for a well-formed packet, per RFC 1071. Anything else means the + // input csum was wrong — we log but still forward. + int<16> verify = hash<16>(checksum, ip); + if (verify != 0) { + printf("sw %d port %d : bad input csum (verify=%d) dst=%d", + self, ingress_port, verify, ip#dst); + } + + fwd_t d = Table.lookup(ipv4_lpm, ip#dst, ()); + if (d#fwd_hit) { + eth_hdr_t new_eth = { + dmac = d#fwd_dmac; + smac = eth#dmac; + ety = eth#ety + }; + // Recompute the IPv4 header checksum after the TTL decrement. We zero + // hdr_csum *before* the hash call below — RFC 1071 says compute the sum + // with the checksum field set to zero, then write the one's complement + // back into it. The `{new_ip with hdr_csum = ...}` at the generate site + // does step 2+3 in one shot, but only works because new_ip.hdr_csum is + // already 0 at that moment. Do not move/remove the `hdr_csum = 0;` line. + ipv4_t new_ip = { + version = ip#version; + ihl = ip#ihl; + diffserv = ip#diffserv; + total_len = ip#total_len; + id = ip#id; + flags = ip#flags; + frag_offset = ip#frag_offset; + ttl = ip#ttl - 1; + protocol = ip#protocol; + hdr_csum = 0; + src = ip#src; + dst = ip#dst + }; + printf("sw %d port %d -> %d : dst=%d ttl=%d", + self, ingress_port, d#fwd_port, ip#dst, new_ip#ttl); + generate_port(d#fwd_port, ipv4_pkt(new_eth, {new_ip with hdr_csum = hash<16>(checksum, new_ip)}, pl)); + } else { + printf("sw %d port %d : drop dst=%d (no route)", + self, ingress_port, ip#dst); + } +} + +parser main(bitstring pkt) { + eth_hdr_t eth = read(pkt); + match eth#ety with + | LUCID_ETHERTY -> { do_lucid_parsing(pkt); } + | 0x0800 -> { + ipv4_t ip = read(pkt); + generate(ipv4_pkt(eth, ip, Payload.parse(pkt))); + } + | _ -> { drop; } +} diff --git a/examples/p4_bmv2_examples/basic/basic.json b/examples/p4_bmv2_examples/basic/basic.json new file mode 100644 index 00000000..9c35ae19 --- /dev/null +++ b/examples/p4_bmv2_examples/basic/basic.json @@ -0,0 +1,89 @@ +{ + "max time": 20000, + "default_input_gap": 100, + + "topology": { + "nodes": { + "0": { "ports": { "3": {"type": "link"}, "4": {"type": "link"} } }, + "1": { "ports": { "3": {"type": "link"}, "4": {"type": "link"} } }, + "2": { "ports": { "1": {"type": "link"}, "2": {"type": "link"} } }, + "3": { "ports": { "1": {"type": "link"}, "2": {"type": "link"} } } + }, + "links": [ + {"0:3": "2:1"}, + {"0:4": "3:2"}, + {"1:3": "3:1"}, + {"1:4": "2:2"} + ] + }, + + "events": [ + {"type":"command","name":"Table.install","locations":[0], + "args":{"table":"ipv4_lpm","key":["167772417<32>"], + "action":"ipv4_lpm.ipv4_forward","args":["8796093022481<48>", "1<32>"]}}, + {"type":"command","name":"Table.install","locations":[0], + "args":{"table":"ipv4_lpm","key":["167772674<32>"], + "action":"ipv4_lpm.ipv4_forward","args":["8796093022754<48>", "2<32>"]}}, + {"type":"command","name":"Table.install","locations":[0], + "args":{"table":"ipv4_lpm","key":["167772931<32>"], + "action":"ipv4_lpm.ipv4_forward","args":["8796093022464<48>", "3<32>"]}}, + {"type":"command","name":"Table.install","locations":[0], + "args":{"table":"ipv4_lpm","key":["167773188<32>"], + "action":"ipv4_lpm.ipv4_forward","args":["8796093022720<48>", "4<32>"]}}, + + {"type":"command","name":"Table.install","locations":[1], + "args":{"table":"ipv4_lpm","key":["167772417<32>"], + "action":"ipv4_lpm.ipv4_forward","args":["8796093022464<48>", "4<32>"]}}, + {"type":"command","name":"Table.install","locations":[1], + "args":{"table":"ipv4_lpm","key":["167772674<32>"], + "action":"ipv4_lpm.ipv4_forward","args":["8796093022720<48>", "3<32>"]}}, + {"type":"command","name":"Table.install","locations":[1], + "args":{"table":"ipv4_lpm","key":["167772931<32>"], + "action":"ipv4_lpm.ipv4_forward","args":["8796093023027<48>", "1<32>"]}}, + {"type":"command","name":"Table.install","locations":[1], + "args":{"table":"ipv4_lpm","key":["167773188<32>"], + "action":"ipv4_lpm.ipv4_forward","args":["8796093023300<48>", "2<32>"]}}, + + {"type":"command","name":"Table.install","locations":[2], + "args":{"table":"ipv4_lpm","key":["167772417<32>"], + "action":"ipv4_lpm.ipv4_forward","args":["8796093022464<48>", "1<32>"]}}, + {"type":"command","name":"Table.install","locations":[2], + "args":{"table":"ipv4_lpm","key":["167772674<32>"], + "action":"ipv4_lpm.ipv4_forward","args":["8796093022464<48>", "1<32>"]}}, + {"type":"command","name":"Table.install","locations":[2], + "args":{"table":"ipv4_lpm","key":["167772931<32>"], + "action":"ipv4_lpm.ipv4_forward","args":["8796093022720<48>", "2<32>"]}}, + {"type":"command","name":"Table.install","locations":[2], + "args":{"table":"ipv4_lpm","key":["167773188<32>"], + "action":"ipv4_lpm.ipv4_forward","args":["8796093022720<48>", "2<32>"]}}, + + {"type":"command","name":"Table.install","locations":[3], + "args":{"table":"ipv4_lpm","key":["167772417<32>"], + "action":"ipv4_lpm.ipv4_forward","args":["8796093022464<48>", "2<32>"]}}, + {"type":"command","name":"Table.install","locations":[3], + "args":{"table":"ipv4_lpm","key":["167772674<32>"], + "action":"ipv4_lpm.ipv4_forward","args":["8796093022464<48>", "2<32>"]}}, + {"type":"command","name":"Table.install","locations":[3], + "args":{"table":"ipv4_lpm","key":["167772931<32>"], + "action":"ipv4_lpm.ipv4_forward","args":["8796093022720<48>", "1<32>"]}}, + {"type":"command","name":"Table.install","locations":[3], + "args":{"table":"ipv4_lpm","key":["167773188<32>"], + "action":"ipv4_lpm.ipv4_forward","args":["8796093022720<48>", "1<32>"]}}, + + {"type":"packet", + "bytes":"08000000010008000000011108004500001400000000400000000a0001010a000202", + "locations":["0:1"], "timestamp":5000}, + + {"type":"packet", + "bytes":"08000000010008000000011108004500001400000000400000000a0001010a000303", + "locations":["0:1"], "timestamp":10000}, + + {"type":"packet", + "bytes":"08000000010008000000011108004500001400000000400000000a0001010a636363", + "locations":["0:1"], "timestamp":15000}, + + {"type":"packet", + "bytes":"08000000010008000000011108004500001400000000400063e80a0001010a000202", + "locations":["0:1"], "timestamp":18000} + ] +} diff --git a/examples/p4_bmv2_examples/basic_tunnel/README.md b/examples/p4_bmv2_examples/basic_tunnel/README.md new file mode 100644 index 00000000..365a4f9f --- /dev/null +++ b/examples/p4_bmv2_examples/basic_tunnel/README.md @@ -0,0 +1,62 @@ +# `basic_tunnel` + +Extends [`basic`](../basic/) with a custom on-top "MyTunnel" header. The +switch program has two tables and two parse branches: + +- **`ipv4_lpm`**: same as `basic` — plain IPv4 packets (ety `0x0800`) get + MAC rewrite, TTL decrement, and checksum recompute. +- **`myTunnel_exact`**: tunneled packets (ety `0x1212`) carry a 4-byte + tunnel header `(proto_id, dst_id)` between ethernet and IPv4, and are + forwarded purely by `dst_id`. No MAC rewrite, no TTL touch, no checksum + recompute — the encapsulated IPv4 rides through unchanged. + +## Files +- [basic_tunnel.dpt](basic_tunnel.dpt) — the Lucid program. +- [basic_tunnel.json](basic_tunnel.json) — interpreter spec: 3-switch + triangle topology, `Table.install` commands for both tables on all + switches, four test packets. + +## Running +```bash +../../../sources/lucid/dpt basic_tunnel.dpt --spec basic_tunnel.json --silent +``` + +## Topology +A 3-switch triangle (matches the P4 tutorial's `topology.json`). Lucid +node IDs map to `s1..s3` as `0..2`. Host-facing ports (`s1:1`, `s2:1`, +`s3:1`) are deliberately undeclared so packets show up in `Exits` for +verification. + +``` + h1 + | + 1 + [s1=0] 2 ------- 2 [s2=1] 1 -- h2 + 3 3 + | | + 2 3 + [s3=2] 1 -- h3 +``` + +## Test cases +1. **Plain IPv4 h1 → h2** (csum=0 on input). Two hops s1 → s2. Logs a + "bad input csum" warning at s1; s2 forwards cleanly because s1's + recompute produced a valid csum. Exits at `1:1` with `ttl=62`, + `csum=0x65e8`, `dmac=08:00:00:00:02:22`. +2. **Plain IPv4 h1 → h3 with a correct input csum** (`0x62e7`). Two hops + s1 → s3. No verify warnings. Exits at `2:1` with `ttl=62`, + `csum=0x64e7`, `dmac=08:00:00:00:03:33`. +3. **Tunneled h1 → h3** with `dst_id=3`. Two hops s1 → s3 via the + tunnel table. **Exit bytes are byte-identical to the input** (only + the egress port changes between hops) — the smoking-gun that the + tunnel path performs no rewrites. +4. **Tunneled with bad dst_id=9**. Drops at s1 via `myTunnel_exact`'s + default action; no exit packet. + +## Notable design choices +- **Two packet events, not one.** `ipv4_pkt(eth, ip, pl)` and + `tunnel_pkt(eth, tun, ip, pl)` are separate events; the parser + dispatches based on ethertype. This is cleaner than a single event + with an optional tunnel field because each handler only deals with + what its packet actually contains. The Tofino backend would lower the + two events to the equivalent P4 conditional-emit on parse outcomes. \ No newline at end of file diff --git a/examples/p4_bmv2_examples/basic_tunnel/basic_tunnel.dpt b/examples/p4_bmv2_examples/basic_tunnel/basic_tunnel.dpt new file mode 100644 index 00000000..1c64d4d0 --- /dev/null +++ b/examples/p4_bmv2_examples/basic_tunnel/basic_tunnel.dpt @@ -0,0 +1,168 @@ +// Extends the basic L3 forwarding example with a custom on-top tunnel header. +// +// ether (dmac, smac, ety) | optional MyTunnel (proto_id, dst_id) | IPv4 | payload +// +// Packets with ety = 0x1212 carry a MyTunnel header and are forwarded purely +// by the tunnel's `dst_id` — no MAC rewrite, no TTL decrement, no checksum +// touch. Packets with ety = 0x0800 are plain IPv4 and forwarded as in the +// `basic` example. Two tables, two packet events; the parser picks which. +// +// Simplification vs the P4 program: we only support MyTunnel packets whose +// inner proto_id is 0x0800. The original P4 parser accepts tunnel-only +// packets too (proto_id != IPv4), but that path is exercised by no test in +// the upstream tutorial and modeling it would just be a third event for no +// new behavior. + +const int<16> ETY_IPV4 = 0x0800; +const int<16> ETY_TUNNEL = 0x1212; + +type eth_hdr_t = { + int<48> dmac; + int<48> smac; + int<16> ety; +} + +type tun_hdr_t = { + int<16> proto_id; + int<16> dst_id; +} + +type ipv4_t = { + int<4> version; + int<4> ihl; + int<8> diffserv; + int<16> total_len; + int<16> id; + int<3> flags; + int<13> frag_offset; + int<8> ttl; + int<8> protocol; + int<16> hdr_csum; + int<32> src; + int<32> dst; +} + +// -------- ipv4_lpm: IPv4 forwarding table (same shape as `basic`) -------- + +type fwd_t = { + int<48> fwd_dmac; + int<32> fwd_port; + bool fwd_hit; +} + +action fwd_t ipv4_forward(int<48> dmac, int<32> port)() { + return {fwd_dmac = dmac; fwd_port = port; fwd_hit = true}; +} + +action fwd_t ipv4_drop(int<48> _dmac, int<32> _port)() { + return {fwd_dmac = 0; fwd_port = 0; fwd_hit = false}; +} + +global Table.t<, (int<48>, int<32>), (), fwd_t>> ipv4_lpm = + Table.create(1024, [ipv4_forward; ipv4_drop], ipv4_drop, (0, 0)); + +// -------- myTunnel_exact: tunnel-switching table ------------------------- + +// Tunnel forwarding only sets an egress port; no MAC/TTL rewrite happens. +// `tfwd_*` field names are deliberately distinct from `fwd_*` (and any other +// record's fields) — Lucid resolves record field references globally. +type tfwd_t = { + int<32> tfwd_port; + bool tfwd_hit; +} + +action tfwd_t mytun_forward(int<32> port)() { + return {tfwd_port = port; tfwd_hit = true}; +} + +action tfwd_t mytun_drop(int<32> _port)() { + return {tfwd_port = 0; tfwd_hit = false}; +} + +global Table.t<, int<32>, (), tfwd_t>> myTunnel_exact = + Table.create(1024, [mytun_forward; mytun_drop], mytun_drop, 0); + +// -------- events --------------------------------------------------------- + +packet event ipv4_pkt(eth_hdr_t eth, ipv4_t ip, Payload.t pl); +packet event tunnel_pkt(eth_hdr_t eth, tun_hdr_t tun, ipv4_t ip, Payload.t pl); + +// -------- handlers ------------------------------------------------------- + +handle ipv4_pkt(eth_hdr_t eth, ipv4_t ip, Payload.t pl) { + // Verify-side IPv4 checksum (see basic/README for details). + int<16> verify = hash<16>(checksum, ip); + if (verify != 0) { + printf("sw %d port %d : bad input csum (verify=%d) dst=%d", + self, ingress_port, verify, ip#dst); + } + + fwd_t d = Table.lookup(ipv4_lpm, ip#dst, ()); + if (d#fwd_hit) { + eth_hdr_t new_eth = { + dmac = d#fwd_dmac; + smac = eth#dmac; + ety = eth#ety + }; + // Zero hdr_csum *before* the recompute call below. + ipv4_t new_ip = { + version = ip#version; + ihl = ip#ihl; + diffserv = ip#diffserv; + total_len = ip#total_len; + id = ip#id; + flags = ip#flags; + frag_offset = ip#frag_offset; + ttl = ip#ttl - 1; + protocol = ip#protocol; + hdr_csum = 0; + src = ip#src; + dst = ip#dst + }; + printf("sw %d port %d -> %d : ipv4 dst=%d ttl=%d", + self, ingress_port, d#fwd_port, ip#dst, new_ip#ttl); + generate_port(d#fwd_port, + ipv4_pkt(new_eth, + {new_ip with hdr_csum = hash<16>(checksum, new_ip)}, // "with" makes a copy with a new hdr_csum field + pl)); + } else { + printf("sw %d port %d : drop ipv4 dst=%d (no route)", + self, ingress_port, ip#dst); + } +} + +handle tunnel_pkt(eth_hdr_t eth, tun_hdr_t tun, ipv4_t ip, Payload.t pl) { + // Tunneled packets are switched solely on dst_id. No header rewrite, no + // TTL/csum touch — the encapsulated IPv4 rides through unchanged. + tfwd_t t = Table.lookup(myTunnel_exact, tun#dst_id, ()); + if (t#tfwd_hit) { + printf("sw %d port %d -> %d : tunnel dst_id=%d", + self, ingress_port, t#tfwd_port, tun#dst_id); + generate_port(t#tfwd_port, tunnel_pkt(eth, tun, ip, pl)); + } else { + printf("sw %d port %d : drop tunnel dst_id=%d (no route)", + self, ingress_port, tun#dst_id); + } +} + +// -------- parser --------------------------------------------------------- + +parser main(bitstring pkt) { + eth_hdr_t eth = read(pkt); + match eth#ety with + | LUCID_ETHERTY -> { do_lucid_parsing(pkt); } + | 0x1212 -> { + tun_hdr_t tun = read(pkt); + match tun#proto_id with + | 0x0800 -> { + ipv4_t ip = read(pkt); + generate(tunnel_pkt(eth, tun, ip, Payload.parse(pkt))); + } + | _ -> { drop; } + } + | 0x0800 -> { + ipv4_t ip = read(pkt); + generate(ipv4_pkt(eth, ip, Payload.parse(pkt))); + } + | _ -> { drop; } +} diff --git a/examples/p4_bmv2_examples/basic_tunnel/basic_tunnel.json b/examples/p4_bmv2_examples/basic_tunnel/basic_tunnel.json new file mode 100644 index 00000000..10287069 --- /dev/null +++ b/examples/p4_bmv2_examples/basic_tunnel/basic_tunnel.json @@ -0,0 +1,95 @@ +{ + "max time": 20000, + "default_input_gap": 100, + + "topology": { + "nodes": { + "0": { "ports": { "2": {"type": "link"}, "3": {"type": "link"} } }, + "1": { "ports": { "2": {"type": "link"}, "3": {"type": "link"} } }, + "2": { "ports": { "2": {"type": "link"}, "3": {"type": "link"} } } + }, + "links": [ + {"0:2": "1:2"}, + {"0:3": "2:2"}, + {"1:3": "2:3"} + ] + }, + + "events": [ + {"type":"command","name":"Table.install","locations":[0], + "args":{"table":"ipv4_lpm","key":["167772417<32>"], + "action":"ipv4_lpm.ipv4_forward","args":["8796093022481<48>", "1<32>"]}}, + {"type":"command","name":"Table.install","locations":[0], + "args":{"table":"ipv4_lpm","key":["167772674<32>"], + "action":"ipv4_lpm.ipv4_forward","args":["8796093022720<48>", "2<32>"]}}, + {"type":"command","name":"Table.install","locations":[0], + "args":{"table":"ipv4_lpm","key":["167772931<32>"], + "action":"ipv4_lpm.ipv4_forward","args":["8796093022976<48>", "3<32>"]}}, + + {"type":"command","name":"Table.install","locations":[1], + "args":{"table":"ipv4_lpm","key":["167772417<32>"], + "action":"ipv4_lpm.ipv4_forward","args":["8796093022464<48>", "2<32>"]}}, + {"type":"command","name":"Table.install","locations":[1], + "args":{"table":"ipv4_lpm","key":["167772674<32>"], + "action":"ipv4_lpm.ipv4_forward","args":["8796093022754<48>", "1<32>"]}}, + {"type":"command","name":"Table.install","locations":[1], + "args":{"table":"ipv4_lpm","key":["167772931<32>"], + "action":"ipv4_lpm.ipv4_forward","args":["8796093022976<48>", "3<32>"]}}, + + {"type":"command","name":"Table.install","locations":[2], + "args":{"table":"ipv4_lpm","key":["167772417<32>"], + "action":"ipv4_lpm.ipv4_forward","args":["8796093022464<48>", "2<32>"]}}, + {"type":"command","name":"Table.install","locations":[2], + "args":{"table":"ipv4_lpm","key":["167772674<32>"], + "action":"ipv4_lpm.ipv4_forward","args":["8796093022720<48>", "3<32>"]}}, + {"type":"command","name":"Table.install","locations":[2], + "args":{"table":"ipv4_lpm","key":["167772931<32>"], + "action":"ipv4_lpm.ipv4_forward","args":["8796093023027<48>", "1<32>"]}}, + + {"type":"command","name":"Table.install","locations":[0], + "args":{"table":"myTunnel_exact","key":["1<16>"], + "action":"myTunnel_exact.mytun_forward","args":["1<32>"]}}, + {"type":"command","name":"Table.install","locations":[0], + "args":{"table":"myTunnel_exact","key":["2<16>"], + "action":"myTunnel_exact.mytun_forward","args":["2<32>"]}}, + {"type":"command","name":"Table.install","locations":[0], + "args":{"table":"myTunnel_exact","key":["3<16>"], + "action":"myTunnel_exact.mytun_forward","args":["3<32>"]}}, + + {"type":"command","name":"Table.install","locations":[1], + "args":{"table":"myTunnel_exact","key":["1<16>"], + "action":"myTunnel_exact.mytun_forward","args":["2<32>"]}}, + {"type":"command","name":"Table.install","locations":[1], + "args":{"table":"myTunnel_exact","key":["2<16>"], + "action":"myTunnel_exact.mytun_forward","args":["1<32>"]}}, + {"type":"command","name":"Table.install","locations":[1], + "args":{"table":"myTunnel_exact","key":["3<16>"], + "action":"myTunnel_exact.mytun_forward","args":["3<32>"]}}, + + {"type":"command","name":"Table.install","locations":[2], + "args":{"table":"myTunnel_exact","key":["1<16>"], + "action":"myTunnel_exact.mytun_forward","args":["2<32>"]}}, + {"type":"command","name":"Table.install","locations":[2], + "args":{"table":"myTunnel_exact","key":["2<16>"], + "action":"myTunnel_exact.mytun_forward","args":["3<32>"]}}, + {"type":"command","name":"Table.install","locations":[2], + "args":{"table":"myTunnel_exact","key":["3<16>"], + "action":"myTunnel_exact.mytun_forward","args":["1<32>"]}}, + + {"type":"packet", + "bytes":"08000000010008000000011108004500001400000000400000000a0001010a000202", + "locations":["0:1"], "timestamp":5000}, + + {"type":"packet", + "bytes":"08000000010008000000011108004500001400000000400062e70a0001010a000303", + "locations":["0:1"], "timestamp":8000}, + + {"type":"packet", + "bytes":"0800000001000800000001111212080000034500001400000000400000000a0001010a000303", + "locations":["0:1"], "timestamp":11000}, + + {"type":"packet", + "bytes":"0800000001000800000001111212080000094500001400000000400000000a0001010a000303", + "locations":["0:1"], "timestamp":14000} + ] +} diff --git a/examples/p4_bmv2_examples/calc/README.md b/examples/p4_bmv2_examples/calc/README.md new file mode 100644 index 00000000..970a2e05 --- /dev/null +++ b/examples/p4_bmv2_examples/calc/README.md @@ -0,0 +1,72 @@ +# `calc` + +A host sends a packet with ethertype `0x1234` and a 16-byte calculator +header `(P, 4, ver, op, operand_a, operand_b, res)`. The switch performs +the requested arithmetic on `(operand_a, operand_b)`, writes the result +into `res`, swaps the source/destination MAC addresses, and reflects the +packet back out the ingress port. Malformed packets (bad magic, unknown +op) are silently dropped. + +## Files +- [calc.dpt](calc.dpt) — the Lucid program. +- [gen_spec.py](gen_spec.py) — scapy-based generator that materializes + [calc.json](calc.json). Edit the `TESTS` list to add cases; do **not** + hand-edit `calc.json`. +- [calc.json](calc.json) — committed for reproducibility, regenerated by + `gen_spec.py`. + +## Running +```bash +/opt/anaconda3/bin/python3 gen_spec.py # if you changed TESTS +../../../sources/lucid/dpt calc.dpt --spec calc.json --silent +``` + +`gen_spec.py` needs scapy (`pip install scapy`). + +## Test cases (defined in `gen_spec.py`) +| Input | Expected `res` in reflected packet | +|----------------|------------------------------------| +| `5 + 3` | `8` | +| `10 - 4` | `6` | +| `0xF & 0xA` | `0xA` | +| `5 \| 3` | `7` | +| `5 ^ 3` | `6` | +| `1 * 1` (bad op `'*'`) | dropped, no exit | +| `1 + 1` with `p='Q'` (bad magic) | dropped, no exit | + +Each reflected packet should appear in `Exits` at port 1 with the +ethernet src/dst swapped relative to the input. + +## Notable design choices +- **No table for op dispatch.** The P4 program uses a const-entries + match-action table to dispatch on `op` because P4 doesn't have a + general `switch`/`case` inside actions. Lucid does (`match`), so we + use it directly. Tables in Lucid are reserved for state the control + plane mutates at runtime; the calc program has none. +- **Bitwise XOR is `^^`.** Single `^` in Lucid is bitstring concat (so + beware of the shape `a ^ b` ever silently meaning the wrong thing). +- **No `lookahead` in the parser.** P4 peeks the first three bytes to + validate the magic before fully extracting; Lucid has no lookahead, + so we extract first and validate in the handler. Same net behavior, + one extra parse on malformed packets. +- **No early `return` from handlers.** Lucid handlers don't support + early-exit, so the "drop on bad input" path is expressed by nested + if/else with an `ok` flag rather than `if (bad) return;`. +- **`printf` only supports `%d`.** No `%x`, no `%s`. Op bytes are + printed in decimal — `+` shows as `43`, `-` as `45`, etc. + +## Generating spec files with scapy + +This is the first example using a Python generator. The pattern: + +1. Define each header type as a tiny scapy `Packet` subclass with + `fields_desc` whose field widths exactly mirror the Lucid `type` + declarations. +2. Construct test packets by composing `Ether() / MyHeader(...)` and + calling `bytes(...).hex()`. +3. Drop the resulting hex strings into the `events` list and + `json.dump` to `.json`. + +The wins, especially as headers stack up (`mri`, `source_routing`): +scapy keeps field order/width honest, and there's no opportunity to +miscount an "extra `0000`" between fields in a hex blob. diff --git a/examples/p4_bmv2_examples/calc/calc.dpt b/examples/p4_bmv2_examples/calc/calc.dpt new file mode 100644 index 00000000..539bc3ee --- /dev/null +++ b/examples/p4_bmv2_examples/calc/calc.dpt @@ -0,0 +1,102 @@ +// Lucid port of the P4 "calc" tutorial: an in-network calculator. +// +// A host sends a packet with a custom ether type (0x1234) and a 16-byte +// calculator header carrying (P, 4, version, op, operand_a, operand_b, res). +// The switch performs the requested arithmetic on (operand_a, operand_b), +// writes the result into `res`, swaps src/dst MACs, and reflects the packet +// back out the port it arrived on. Malformed packets (bad magic, unknown op) +// are silently dropped. +// +// Where this differs from the P4 program: +// * The P4 program dispatches on `op` via a const-entries match-action +// table. Lucid has a native `match` statement, so we use that — tables +// are reserved for state the control plane *changes at runtime*. +// * The P4 parser uses `lookahead` to validate the magic before fully +// extracting the calc header; Lucid has no lookahead, so we extract +// and then validate inside the handler. Same net behavior, one tiny +// wasted parse on malformed packets. + +const int<16> ETY_CALC = 0x1234; +const int<8> CALC_P = 0x50; // 'P' +const int<8> CALC_4 = 0x34; // '4' +const int<8> CALC_VER = 0x01; // protocol version +const int<8> OP_PLUS = 0x2b; // '+' +const int<8> OP_MINUS = 0x2d; // '-' +const int<8> OP_AND = 0x26; // '&' +const int<8> OP_OR = 0x7c; // '|' +const int<8> OP_XOR = 0x5e; // '^' + +type eth_hdr_t = { + int<48> dmac; + int<48> smac; + int<16> ety; +} + +// 16-byte calculator header. Field widths are bit-exact with the P4 layout +// so a `read` off the wire decodes byte-for-byte. +type calc_t = { + int<8> p; + int<8> four; + int<8> ver; + int<8> op; + int<32> operand_a; + int<32> operand_b; + int<32> res; +} + +packet event calc_pkt(eth_hdr_t eth, calc_t calc, Payload.t pl); + +handle calc_pkt(eth_hdr_t eth, calc_t calc, Payload.t pl) { + // Magic check. If any of (p, four, ver) is wrong, silently drop. + if (calc#p == CALC_P && calc#four == CALC_4 && calc#ver == CALC_VER) { + // Compute the result. `ok` lets us silently drop on an unknown op + // without needing an early return (handlers don't support one). + int<32> result = 0; + bool ok = true; + match calc#op with + | OP_PLUS -> { result = calc#operand_a + calc#operand_b; } + | OP_MINUS -> { result = calc#operand_a - calc#operand_b; } + | OP_AND -> { result = calc#operand_a & calc#operand_b; } + | OP_OR -> { result = calc#operand_a | calc#operand_b; } + | OP_XOR -> { result = calc#operand_a ^^ calc#operand_b; } + | _ -> { ok = false; } + + if (ok) { + printf("sw %d port %d : %d op=%d %d = %d (reflect)", + self, ingress_port, + calc#operand_a, calc#op, calc#operand_b, result); + eth_hdr_t new_eth = { + dmac = eth#smac; + smac = eth#dmac; + ety = eth#ety + }; + calc_t new_calc = { + p = calc#p; + four = calc#four; + ver = calc#ver; + op = calc#op; + operand_a = calc#operand_a; + operand_b = calc#operand_b; + res = result + }; + generate_port(ingress_port, calc_pkt(new_eth, new_calc, pl)); + } else { + printf("sw %d port %d : unknown op %d - drop", + self, ingress_port, calc#op); + } + } else { + printf("sw %d port %d : bad magic (p=%d four=%d ver=%d) - drop", + self, ingress_port, calc#p, calc#four, calc#ver); + } +} + +parser main(bitstring pkt) { + eth_hdr_t eth = read(pkt); + match eth#ety with + | LUCID_ETHERTY -> { do_lucid_parsing(pkt); } + | 0x1234 -> { + calc_t calc = read(pkt); + generate(calc_pkt(eth, calc, Payload.parse(pkt))); + } + | _ -> { drop; } +} diff --git a/examples/p4_bmv2_examples/calc/calc.json b/examples/p4_bmv2_examples/calc/calc.json new file mode 100644 index 00000000..4ebc6483 --- /dev/null +++ b/examples/p4_bmv2_examples/calc/calc.json @@ -0,0 +1,62 @@ +{ + "max time": 20000, + "default_input_gap": 100, + "events": [ + { + "type": "packet", + "bytes": "08000000010208000000010112345034012b000000050000000300000000", + "locations": [ + "0:1" + ], + "timestamp": 1000 + }, + { + "type": "packet", + "bytes": "08000000010208000000010112345034012d0000000a0000000400000000", + "locations": [ + "0:1" + ], + "timestamp": 2000 + }, + { + "type": "packet", + "bytes": "0800000001020800000001011234503401260000000f0000000a00000000", + "locations": [ + "0:1" + ], + "timestamp": 3000 + }, + { + "type": "packet", + "bytes": "08000000010208000000010112345034017c000000050000000300000000", + "locations": [ + "0:1" + ], + "timestamp": 4000 + }, + { + "type": "packet", + "bytes": "08000000010208000000010112345034015e000000050000000300000000", + "locations": [ + "0:1" + ], + "timestamp": 5000 + }, + { + "type": "packet", + "bytes": "08000000010208000000010112345034012a000000010000000100000000", + "locations": [ + "0:1" + ], + "timestamp": 6000 + }, + { + "type": "packet", + "bytes": "08000000010208000000010112345134012b000000010000000100000000", + "locations": [ + "0:1" + ], + "timestamp": 7000 + } + ] +} diff --git a/examples/p4_bmv2_examples/calc/gen_spec.py b/examples/p4_bmv2_examples/calc/gen_spec.py new file mode 100644 index 00000000..b2aaf8a2 --- /dev/null +++ b/examples/p4_bmv2_examples/calc/gen_spec.py @@ -0,0 +1,87 @@ +#!/usr/bin/env python3 +"""Generate calc.json: the interpreter spec for the Lucid calc example. + +Run with `python gen_spec.py`. Overwrites calc.json next to this script. +Edit the `TESTS` list below to add or change test cases — packet bytes +and the spec scaffolding are generated from those entries, so there is +no opportunity for hand-counted hex strings to drift out of sync with +the program's record layout. +""" + +import json +from pathlib import Path + +from scapy.all import Ether, Packet, ByteField, IntField, bind_layers + +# ---- protocol layout ------------------------------------------------------ + +ETY_CALC = 0x1234 + +# 16-byte calc header — must match the `calc_t` record in calc.dpt +# (p, four, ver, op, operand_a, operand_b, res), all big-endian on the wire. +class P4Calc(Packet): + name = "P4Calc" + fields_desc = [ + ByteField("p", ord("P")), + ByteField("four", ord("4")), + ByteField("ver", 0x01), + ByteField("op", 0), + IntField("operand_a", 0), + IntField("operand_b", 0), + IntField("res", 0), + ] + +bind_layers(Ether, P4Calc, type=ETY_CALC) + +# ---- test scaffolding ----------------------------------------------------- + +H1_MAC = "08:00:00:00:01:01" +H2_MAC = "08:00:00:00:01:02" + +OP = {c: ord(c) for c in "+-&|^"} + +def calc_bytes(op, a, b, *, + src=H1_MAC, dst=H2_MAC, + p=ord("P"), four=ord("4"), ver=0x01): + """Construct a calc packet on the wire and return its hex string.""" + eth = Ether(dst=dst, src=src, type=ETY_CALC) + body = P4Calc(p=p, four=four, ver=ver, op=op, + operand_a=a, operand_b=b, res=0) + return bytes(eth / body).hex() + +# Each entry: (label, op-byte, operand_a, operand_b, kwargs) +TESTS = [ + ("5 + 3 = 8", OP["+"], 5, 3, {}), + ("10 - 4 = 6", OP["-"], 10, 4, {}), + ("0xF & 0xA = 0xA", OP["&"], 0xF, 0xA, {}), + ("5 | 3 = 7", OP["|"], 5, 3, {}), + ("5 ^ 3 = 6", OP["^"], 5, 3, {}), + ("bad op '*' (drop)", ord("*"), 1, 1, {}), + ("bad magic p='Q'", OP["+"], 1, 1, {"p": ord("Q")}), +] + +# ---- spec assembly -------------------------------------------------------- + +events = [] +ts = 1000 +for _label, op, a, b, kw in TESTS: + events.append({ + "type": "packet", + "bytes": calc_bytes(op, a, b, **kw), + "locations": ["0:1"], + "timestamp": ts, + }) + ts += 1000 + +spec = { + "max time": 20000, + "default_input_gap": 100, + "events": events, +} + +out = Path(__file__).with_name("calc.json") +out.write_text(json.dumps(spec, indent=2) + "\n") + +print(f"wrote {out} with {len(events)} packet events") +for (label, *_), ev in zip(TESTS, events): + print(f" t={ev['timestamp']:>5} {label}") diff --git a/examples/p4_bmv2_examples/ecn/README.md b/examples/p4_bmv2_examples/ecn/README.md new file mode 100644 index 00000000..5ddb049d --- /dev/null +++ b/examples/p4_bmv2_examples/ecn/README.md @@ -0,0 +1,82 @@ +# `ecn` + +ECN-marks (and drops) IPv4 packets based on a synthesized queue-depth +signal. We also implement a basic queue model: + +- A 1-cell `queuedepth` array stands in for the per-port queue. +- Every IPv4 packet bumps the cell atomically and reads back the new + depth. +- A self-recursive `queue_decr` event drains the cell by 1 each time + it fires. We launch it once from the spec; the handler re-arms + itself via `generate(queue_decr())` for the rest of the simulation. + +Three regimes: + +| Depth (post-incr) | Action | +|-------------------|-------------------------| +| `<= ECN_THRESHOLD` | forward unchanged | +| `<= DROP_THRESHOLD` | forward with ECN = 0b11 | +| `> DROP_THRESHOLD` | drop (no generate) | + +With `ECN_THRESHOLD = 4` and `DROP_THRESHOLD = 8`, a burst of 14 +back-to-back packets cleanly walks the queue through all three. + +## Files +- [ecn.dpt](ecn.dpt) — the Lucid program. +- [gen_spec.py](gen_spec.py) — scapy generator. +- [ecn.json](ecn.json) — generated artifact. + +## Running +```bash +/opt/anaconda3/bin/python3 gen_spec.py +../../../sources/lucid/dpt ecn.dpt --spec ecn.json --silent +``` + +## Expected trace + +``` +sw 0 : OK dst=... depth=1 -> port 2 +sw 0 : OK dst=... depth=2 -> port 2 +sw 0 : OK dst=... depth=3 -> port 2 +sw 0 : OK dst=... depth=4 -> port 2 +sw 0 : MARK dst=... depth=5 (>4) -> ecn=11 +sw 0 : MARK dst=... depth=6 (>4) -> ecn=11 +sw 0 : MARK dst=... depth=7 (>4) -> ecn=11 +sw 0 : MARK dst=... depth=8 (>4) -> ecn=11 +sw 0 : DROP dst=... (depth=9 > 8) +sw 0 : DROP dst=... (depth=10 > 8) +... +sw 0 : OK dst=... depth=1 -> port 2 # trailing packets after drain +``` + +Exit packets confirm the marking in the wire bytes — the TOS byte +flips from `0x01` (ECT(1) preserved) to `0x03` (CE marked) right at +the ECN threshold, and the IPv4 checksum updates accordingly. + +## Notable Lucid details + +- **Recursive event for the drain.** A recursive event can be used to implement a background thread -- a handler that executes periodically over time. `queue_decr`'s handler is: + ``` + handle queue_decr() { + Array.setm(queuedepth, 0, sub1_floor, 0); + generate(queue_decr()); + } + ``` + The delay between `generate(e)` and `e`'s arrival and handler execution is the drain rate. +- **Memops are restricted enough to be just-barely-enough.** The + drain uses `sub1_floor`: + ``` + memop sub1_floor(int mv, int unused) { + if (mv == 0) { return 0; } + else { return mv - 1; } + } + ``` + Each branch uses `mv` at most once (in the if condition or in the + return), which keeps the memop within the "compiles to one atomic + instruction" budget. +- **`Array.update` with the same memop on both sides** is the + standard "atomic increment-and-fetch" idiom — get-side returns + `mv+1`, set-side writes `mv+1`. The returned new depth is what we + branch on. +- **Drop = don't generate.** No special "drop" call from a handler. + Just skip the `generate_port` and the packet vanishes. diff --git a/examples/p4_bmv2_examples/ecn/ecn.dpt b/examples/p4_bmv2_examples/ecn/ecn.dpt new file mode 100644 index 00000000..a0abdb70 --- /dev/null +++ b/examples/p4_bmv2_examples/ecn/ecn.dpt @@ -0,0 +1,164 @@ +// Lucid port of the P4 "ecn" tutorial. +// +// The upstream P4 program marks ECN on a packet when the egress +// queue depth exceeds a threshold. Lucid's interpreter doesn't model +// queues, so we *synthesize* a queue depth signal: +// +// - A 1-cell `queuedepth` array stands in for the per-port queue. +// - Every IPv4 packet bumps the cell on its way through. +// - A self-recursive `queue_decr` event drains the cell by 1 each +// time it fires. We launch it once from the spec; it loops on +// itself for the rest of the simulation. +// +// Marking policy: +// - depth <= ECN_THRESHOLD → forward unchanged +// - ECN_THRESHOLD < depth <= DROP_THRESHOLD → forward with ECN bits = 0b11 (CE) +// - depth > DROP_THRESHOLD → drop (no generate) +// +// In a real implementation the queue would be per-egress-port and the +// depth would be sampled from hardware metadata at egress. The +// "one-cell + recursive drain" approximation is enough to demonstrate +// the three regimes (clean / marked / dropped) end to end. + +const int ECN_THRESHOLD = 4; +const int DROP_THRESHOLD = 8; + +const int<16> ETY_IPV4 = 0x0800; + +type eth_hdr_t = { + int<48> dmac; + int<48> smac; + int<16> ety; +} + +type ipv4_t = { + int<4> version; + int<4> ihl; + int<6> diffserv; + int<2> ecn; + int<16> total_len; + int<16> id; + int<3> flags; + int<13> frag_offset; + int<8> ttl; + int<8> protocol; + int<16> hdr_csum; + int<32> src; + int<32> dst; +} + +// -------- forwarding table (same shape as basic) ------------------------ + +type fwd_t = { + int<48> fwd_dmac; + int<32> fwd_port; + bool fwd_hit; +} + +action fwd_t ipv4_forward(int<48> dmac, int<32> port)() { + return {fwd_dmac = dmac; fwd_port = port; fwd_hit = true}; +} + +action fwd_t ipv4_drop(int<48> _d, int<32> _p)() { + return {fwd_dmac = 0; fwd_port = 0; fwd_hit = false}; +} + +global Table.t<, (int<48>, int<32>), (), fwd_t>> ipv4_lpm = + Table.create(1024, [ipv4_forward; ipv4_drop], ipv4_drop, (0, 0)); + +// -------- synthetic queue depth ---------------------------------------- + +global Array.t<32> queuedepth = Array.create(1); + +// get_memop returns the *new* (post-increment) value so the handler can +// branch on it; set_memop also writes the new value into the cell. +// Using the same memop for both sides is the standard Lucid idiom for +// "atomic increment-and-fetch". +memop add1(int mv, int unused) { return mv + 1; } + +// floor at 0 so the drain doesn't run negative. +memop sub1_floor(int mv, int unused) { + if (mv == 0) { return 0; } + else { return mv - 1; } +} + +// -------- events -------------------------------------------------------- + +packet event ipv4_pkt(eth_hdr_t eth, ipv4_t ip, Payload.t pl); + +// Background drain. Each tick: decrement queuedepth by 1 (floored at 0) +// and re-arm itself by generating another queue_decr. Launched from the +// spec exactly once. +event queue_decr(); + +// -------- handlers ------------------------------------------------------ + +handle ipv4_pkt(eth_hdr_t eth, ipv4_t ip, Payload.t pl) { + fwd_t d = Table.lookup(ipv4_lpm, ip#dst, ()); + if (d#fwd_hit) { + // Atomically bump the queue and read the new depth. + int new_depth = Array.update(queuedepth, 0, add1, 0, add1, 0); + + if (new_depth > DROP_THRESHOLD) { + printf("sw %d : DROP dst=%d (depth=%d > %d)", + self, ip#dst, new_depth, DROP_THRESHOLD); + // No generate → packet is dropped. queuedepth still got bumped; + // the drain will catch up. + } else { + // Decide whether to ECN-mark. + int<2> new_ecn = ip#ecn; + if (new_depth > ECN_THRESHOLD) { + new_ecn = 3; // 0b11 = CE (Congestion Experienced) + printf("sw %d : MARK dst=%d depth=%d (>%d) -> ecn=11", + self, ip#dst, new_depth, ECN_THRESHOLD); + } else { + printf("sw %d : OK dst=%d depth=%d -> port %d", + self, ip#dst, new_depth, d#fwd_port); + } + + eth_hdr_t new_eth = { + dmac = d#fwd_dmac; + smac = eth#dmac; + ety = eth#ety + }; + ipv4_t new_ip = { + version = ip#version; + ihl = ip#ihl; + diffserv = ip#diffserv; + ecn = new_ecn; + total_len = ip#total_len; + id = ip#id; + flags = ip#flags; + frag_offset = ip#frag_offset; + ttl = ip#ttl - 1; + protocol = ip#protocol; + hdr_csum = 0; + src = ip#src; + dst = ip#dst + }; + generate_port(d#fwd_port, + ipv4_pkt(new_eth, + {new_ip with hdr_csum = hash<16>(checksum, new_ip)}, + pl)); + } + } else { + printf("sw %d : no route for dst=%d", self, ip#dst); + } +} + +handle queue_decr() { + Array.setm(queuedepth, 0, sub1_floor, 0); + // Self-recurse so the drain keeps running. + generate(queue_decr()); +} + +parser main(bitstring pkt) { + eth_hdr_t eth = read(pkt); + match eth#ety with + | LUCID_ETHERTY -> { do_lucid_parsing(pkt); } + | 0x0800 -> { + ipv4_t ip = read(pkt); + generate(ipv4_pkt(eth, ip, Payload.parse(pkt))); + } + | _ -> { drop; } +} diff --git a/examples/p4_bmv2_examples/ecn/ecn.json b/examples/p4_bmv2_examples/ecn/ecn.json new file mode 100644 index 00000000..3f627c99 --- /dev/null +++ b/examples/p4_bmv2_examples/ecn/ecn.json @@ -0,0 +1,165 @@ +{ + "max time": 40000, + "default_input_gap": 50, + "events": [ + { + "type": "command", + "name": "Table.install", + "args": { + "table": "ipv4_lpm", + "key": [ + "167772674<32>" + ], + "action": "ipv4_lpm.ipv4_forward", + "args": [ + "8796093022722<48>", + "2<32>" + ] + } + }, + { + "name": "queue_decr", + "args": [], + "locations": [ + "0:0" + ], + "timestamp": 100 + }, + { + "type": "packet", + "bytes": "08000000010008000000010108004501001400000000400063e70a0001010a000202", + "locations": [ + "0:1" + ], + "timestamp": 200 + }, + { + "type": "packet", + "bytes": "08000000010008000000010108004501001400000000400063e70a0001010a000202", + "locations": [ + "0:1" + ], + "timestamp": 200 + }, + { + "type": "packet", + "bytes": "08000000010008000000010108004501001400000000400063e70a0001010a000202", + "locations": [ + "0:1" + ], + "timestamp": 200 + }, + { + "type": "packet", + "bytes": "08000000010008000000010108004501001400000000400063e70a0001010a000202", + "locations": [ + "0:1" + ], + "timestamp": 200 + }, + { + "type": "packet", + "bytes": "08000000010008000000010108004501001400000000400063e70a0001010a000202", + "locations": [ + "0:1" + ], + "timestamp": 200 + }, + { + "type": "packet", + "bytes": "08000000010008000000010108004501001400000000400063e70a0001010a000202", + "locations": [ + "0:1" + ], + "timestamp": 200 + }, + { + "type": "packet", + "bytes": "08000000010008000000010108004501001400000000400063e70a0001010a000202", + "locations": [ + "0:1" + ], + "timestamp": 200 + }, + { + "type": "packet", + "bytes": "08000000010008000000010108004501001400000000400063e70a0001010a000202", + "locations": [ + "0:1" + ], + "timestamp": 200 + }, + { + "type": "packet", + "bytes": "08000000010008000000010108004501001400000000400063e70a0001010a000202", + "locations": [ + "0:1" + ], + "timestamp": 200 + }, + { + "type": "packet", + "bytes": "08000000010008000000010108004501001400000000400063e70a0001010a000202", + "locations": [ + "0:1" + ], + "timestamp": 200 + }, + { + "type": "packet", + "bytes": "08000000010008000000010108004501001400000000400063e70a0001010a000202", + "locations": [ + "0:1" + ], + "timestamp": 200 + }, + { + "type": "packet", + "bytes": "08000000010008000000010108004501001400000000400063e70a0001010a000202", + "locations": [ + "0:1" + ], + "timestamp": 200 + }, + { + "type": "packet", + "bytes": "08000000010008000000010108004501001400000000400063e70a0001010a000202", + "locations": [ + "0:1" + ], + "timestamp": 200 + }, + { + "type": "packet", + "bytes": "08000000010008000000010108004501001400000000400063e70a0001010a000202", + "locations": [ + "0:1" + ], + "timestamp": 200 + }, + { + "type": "packet", + "bytes": "08000000010008000000010108004501001400000000400063e70a0001010a000202", + "locations": [ + "0:1" + ], + "timestamp": 30000 + }, + { + "type": "packet", + "bytes": "08000000010008000000010108004501001400000000400063e70a0001010a000202", + "locations": [ + "0:1" + ], + "timestamp": 30100 + }, + { + "type": "packet", + "bytes": "08000000010008000000010108004501001400000000400063e70a0001010a000202", + "locations": [ + "0:1" + ], + "timestamp": 30200 + } + ] +} diff --git a/examples/p4_bmv2_examples/ecn/gen_spec.py b/examples/p4_bmv2_examples/ecn/gen_spec.py new file mode 100644 index 00000000..f0bb7ca4 --- /dev/null +++ b/examples/p4_bmv2_examples/ecn/gen_spec.py @@ -0,0 +1,89 @@ +#!/usr/bin/env python3 +"""Generate ecn.json for the Lucid ecn example. + +Plan: + 1. Install a forwarding rule for h2's IP. + 2. Kick off the recursive queue_decr drain at t=0. + 3. Burst of IPv4 packets at densely-packed timestamps so the queue + depth climbs faster than the drain can keep up. + 4. Long enough pause + a few more packets to confirm the drain + brings the depth back below threshold. + +Tuning notes: + - `default_input_gap` is the per-event timestamp spacing applied + when an event's `timestamp` is omitted. For the burst phase we + give every packet the *same* explicit timestamp so they all hit + the queue within one simulator window (depth ramps up cleanly). + - The drain rate is whatever generate(queue_decr()) -> self-handler + decides — empirically about one tick per ~600 simulator units in + the default config, which is plenty slow that a tight packet + burst will overrun it. +""" + +import ipaddress +import json +from pathlib import Path + +from scapy.all import Ether, IP + +def ipv4_int(s): return int(ipaddress.IPv4Address(s)) +def mac_int(s): return int(s.replace(":", ""), 16) + +H1_MAC = "08:00:00:00:01:01" +H2_MAC = "08:00:00:00:02:02" +S1_MAC = "08:00:00:00:01:00" + +def install_lpm(dst_ip, dmac, port): + return { + "type": "command", "name": "Table.install", + "args": { + "table": "ipv4_lpm", + "key": [f"{ipv4_int(dst_ip)}<32>"], + "action": "ipv4_lpm.ipv4_forward", + "args": [f"{mac_int(dmac)}<48>", f"{port}<32>"], + }, + } + +def ipv4(src_ip="10.0.1.1", dst_ip="10.0.2.2", + src_mac=H1_MAC, dst_mac=S1_MAC, ttl=64, + ecn=1): # ECT(1): ECN-capable transport + p = (Ether(dst=dst_mac, src=src_mac, type=0x0800) / + IP(src=src_ip, dst=dst_ip, ttl=ttl, id=0, flags=0, frag=0, + tos=ecn, len=20)) + return bytes(p).hex() + +events = [ + install_lpm("10.0.2.2", H2_MAC, port=2), + # Kick off the drain — single event, the handler recurses. + {"name": "queue_decr", "args": [], "locations": ["0:0"], "timestamp": 100}, +] + +# A burst of 14 packets all at t=200 — they get processed in succession +# by the interpreter before any queue_decr tick fires. +for i in range(14): + events.append({ + "type": "packet", + "bytes": ipv4(), + "locations": ["0:1"], + "timestamp": 200, + }) + +# A long pause then a couple of trailing packets — by now the drain +# should have caught up, so these should be back in the "OK" regime. +for i in range(3): + events.append({ + "type": "packet", + "bytes": ipv4(), + "locations": ["0:1"], + "timestamp": 30000 + i * 100, + }) + +spec = { + "max time": 40000, + "default_input_gap": 50, + "events": events, +} + +out = Path(__file__).with_name("ecn.json") +out.write_text(json.dumps(spec, indent=2) + "\n") +print(f"wrote {out} with {len(events)} events") diff --git a/examples/p4_bmv2_examples/flowcache/README.md b/examples/p4_bmv2_examples/flowcache/README.md new file mode 100644 index 00000000..16e2f1f6 --- /dev/null +++ b/examples/p4_bmv2_examples/flowcache/README.md @@ -0,0 +1,61 @@ +# `flowcache` + +An exact-match flow cache keyed on `(protocol, src_ip, dst_ip)`. On a +hit, the cached `(dmac, port)` is used to forward. On a miss, the +switch emits a **PacketIn** control event to the controller and drops +the original packet; the controller is expected to install a matching +rule (via `Table.install`) and from then on packets in that flow are +forwarded by the data plane. + +## Files +- [flowcache.dpt](flowcache.dpt) — the Lucid program. +- [gen_spec.py](gen_spec.py) — scapy generator. +- [flowcache.json](flowcache.json) — generated artifact. + +## Running +```bash +/opt/anaconda3/bin/python3 gen_spec.py +../../../sources/lucid/dpt flowcache.dpt --spec flowcache.json --silent +``` + +## The "controller" is the JSON spec + +Lucid's interpreter lets test specifications be used to model the controller. + +- The data plane emits PacketIn events to a designated controller port + (`CONTROLLER_PORT = 99`). The port has no link, so the events land + in the `Exits` list — observable by the test. +- The spec mixes packet events with `Table.install` commands. A typical + flow: + 1. Send a burst of packets in flow A → they miss → PacketIn events + show up in Exits. + 2. The spec issues `Table.install` for flow A. + 3. Subsequent flow-A packets hit the cache and forward. + + +## Test timeline (in `gen_spec.py`) + +| `t` | Event | Expected | +|----------|------------------------------------------------|----------| +| 1000–1400 | 3 × TCP flow-A packets `10.0.1.1 → 10.0.2.2` | 3 MISS, 3 `packet_in` in Exits | +| 1600 | `Table.install flow_cache key=(6, 10.0.1.1, 10.0.2.2)` | — | +| 1800–2200 | 3 × TCP flow-A packets, same key | 3 HIT, 3 forwarded out port 2 | +| 2400 | 1 × TCP flow-B packet `10.0.1.1 → 10.0.3.3` | MISS, 1 more `packet_in` in Exits | + +End-state counters: +- `hit_count[2] = 3` (low nibble of `0x0a000202` = 2) +- `miss_count[2] = 3` +- `miss_count[3] = 1` + +## Notable Lucid details + +- **Record-typed table key.** `Table.t<>` works + cleanly with a record as the key type. In the JSON + `Table.install`, the record is flattened to a list of width-tagged + values: `"key": ["6<8>", "<32>", "<32>"]` — in declaration + order of the record's fields. Same flattening you'd see for record + *data* (already used in `basic`, `basic_tunnel`, etc.). +- **PacketIn is a regular event with `{skip;}` body.** No wire format, + no parser, no handler — it exists purely to be `generate_port`'d out + the controller port so the test can observe its arguments in the + Exits list. Same pattern as `link_monitor`. diff --git a/examples/p4_bmv2_examples/flowcache/flowcache.dpt b/examples/p4_bmv2_examples/flowcache/flowcache.dpt new file mode 100644 index 00000000..63259864 --- /dev/null +++ b/examples/p4_bmv2_examples/flowcache/flowcache.dpt @@ -0,0 +1,167 @@ +// Lucid port of the P4 "flowcache" tutorial. +// +// The data plane has an exact-match table keyed on the 3-tuple +// (protocol, src_ip, dst_ip). On a hit, the cached action forwards the +// packet. On a miss the switch (a) silently drops the original packet +// and (b) emits a `packet_in` *control event* containing the flow key +// + ingress port. In the upstream P4 this is the PacketIn message to +// the P4Runtime controller; here we send it to an unconnected "CPU +// port" so it lands in the `Exits` list for the test to inspect. +// +// The "controller" is the JSON spec: it observes the PacketIn (in the +// Exits list) and issues a `Table.install` command at a later timestamp. +// Subsequent packets in the same flow then hit the cache. +// +// Two design choices vs the upstream: +// * **PacketIn is a regular event, not a packet event.** Same play we +// made in `link_monitor` — the controller is internal to the +// simulator, no wire format needed, no parser for the punt path. +// * **No idle timeout.** Lucid handlers cannot install or remove +// table entries (`Table.install` is a control-plane command only), +// so there's no way to express an in-data-plane TTL on cache +// entries. The control plane (whoever writes the JSON spec) is the +// only entity that can mutate the table. Documented in the README. + +const int<32> CONTROLLER_PORT = 99; +const int<16> ETY_IPV4 = 0x0800; + +type eth_hdr_t = { + int<48> dmac; + int<48> smac; + int<16> ety; +} + +type ipv4_t = { + int<4> version; + int<4> ihl; + int<8> diffserv; + int<16> total_len; + int<16> id; + int<3> flags; + int<13> frag_offset; + int<8> ttl; + int<8> protocol; + int<16> hdr_csum; + int<32> src; + int<32> dst; +} + +// 3-tuple flow key. The cache is exact-match on all three fields. +type flow_key_t = { + int<8> fk_proto; + int<32> fk_src; + int<32> fk_dst; +} + +// Lookup result. Two values from the install: next-hop MAC and egress port. +type fwd_t = { + int<48> fwd_dmac; + int<32> fwd_port; + bool fwd_hit; +} + +action fwd_t cached_action(int<48> dmac, int<32> port)() { + return {fwd_dmac = dmac; fwd_port = port; fwd_hit = true}; +} + +action fwd_t flow_unknown(int<48> _d, int<32> _p)() { + return {fwd_dmac = 0; fwd_port = 0; fwd_hit = false}; +} + +// Match-action table: (proto, src, dst) -> (dmac, port). Default = miss. +global Table.t<, int<32>), (), fwd_t>> flow_cache = + Table.create(1024, [cached_action; flow_unknown], flow_unknown, (0, 0)); + +// Per-(low-nibble-of-dst) counters. Stand-ins for the P4 program's +// ingressPktOutCounter / egressPktInCounter — see README for the +// not-quite-correspondence. +global Array.t<32> hit_count = Array.create(16); +global Array.t<32> miss_count = Array.create(16); + +memop incr(int mv, int by) { return mv + by; } + +// -------- events -------------------------------------------------------- + +packet event ipv4_pkt(eth_hdr_t eth, ipv4_t ip, Payload.t pl); + +// PacketIn control event: emitted to the controller port on cache miss. +// `{skip;}` means "no handler" — it just lands in `Exits` for the test +// to observe. +event packet_in(int<8> fk_proto, int<32> fk_src, int<32> fk_dst, + int<32> ingress) {skip;} + +// -------- handler ------------------------------------------------------ + +handle ipv4_pkt(eth_hdr_t eth, ipv4_t ip, Payload.t pl) { + // Verify-side IPv4 checksum (same pattern as basic). + int<16> verify = hash<16>(checksum, ip); + if (verify != 0) { + printf("sw %d port %d : bad input csum (verify=%d) dst=%d", + self, ingress_port, verify, ip#dst); + } + + flow_key_t key = { + fk_proto = ip#protocol; + fk_src = ip#src; + fk_dst = ip#dst + }; + fwd_t d = Table.lookup(flow_cache, key, ()); + + // Low nibble of the destination address is the counter bucket. Cheap + // and good enough for a small example; the upstream's bit<32> dstAddr[5:0] + // does the same (6-bit) slice. + int<32> bucket = ip#dst & 0xf; + + if (d#fwd_hit) { + Array.setm(hit_count, bucket, incr, 1); + + eth_hdr_t new_eth = { + dmac = d#fwd_dmac; + smac = eth#dmac; + ety = eth#ety + }; + ipv4_t new_ip = { + version = ip#version; + ihl = ip#ihl; + diffserv = ip#diffserv; + total_len = ip#total_len; + id = ip#id; + flags = ip#flags; + frag_offset = ip#frag_offset; + ttl = ip#ttl - 1; + protocol = ip#protocol; + hdr_csum = 0; + src = ip#src; + dst = ip#dst + }; + printf("sw %d : cache HIT proto=%d src=%d dst=%d -> port=%d ttl=%d", + self, ip#protocol, ip#src, ip#dst, d#fwd_port, new_ip#ttl); + generate_port(d#fwd_port, + ipv4_pkt(new_eth, + {new_ip with hdr_csum = hash<16>(checksum, new_ip)}, + pl)); + } else { + Array.setm(miss_count, bucket, incr, 1); + + printf("sw %d : cache MISS proto=%d src=%d dst=%d ingress=%d -> PacketIn(controller)", + self, ip#protocol, ip#src, ip#dst, ingress_port); + generate_port(CONTROLLER_PORT, + packet_in(ip#protocol, ip#src, ip#dst, ingress_port)); + // Original packet is dropped (no further generate). Upstream P4 + // also drops; the controller is expected to send a PacketOut if it + // wants this specific buffered packet forwarded — out of scope here. + } +} + +// -------- parser ------------------------------------------------------- + +parser main(bitstring pkt) { + eth_hdr_t eth = read(pkt); + match eth#ety with + | LUCID_ETHERTY -> { do_lucid_parsing(pkt); } + | 0x0800 -> { + ipv4_t ip = read(pkt); + generate(ipv4_pkt(eth, ip, Payload.parse(pkt))); + } + | _ -> { drop; } +} diff --git a/examples/p4_bmv2_examples/flowcache/flowcache.json b/examples/p4_bmv2_examples/flowcache/flowcache.json new file mode 100644 index 00000000..8315bf4c --- /dev/null +++ b/examples/p4_bmv2_examples/flowcache/flowcache.json @@ -0,0 +1,80 @@ +{ + "max time": 10000, + "default_input_gap": 100, + "events": [ + { + "type": "packet", + "bytes": "08000000010008000000010108004500002800000000400663ce0a0001010a00020204570050000000000000000050000000943b0000", + "locations": [ + "0:1" + ], + "timestamp": 1000 + }, + { + "type": "packet", + "bytes": "08000000010008000000010108004500002800000000400663ce0a0001010a00020204570050000000000000000050000000943b0000", + "locations": [ + "0:1" + ], + "timestamp": 1200 + }, + { + "type": "packet", + "bytes": "08000000010008000000010108004500002800000000400663ce0a0001010a00020204570050000000000000000050000000943b0000", + "locations": [ + "0:1" + ], + "timestamp": 1400 + }, + { + "type": "command", + "name": "Table.install", + "args": { + "table": "flow_cache", + "key": [ + "6<8>", + "167772417<32>", + "167772674<32>" + ], + "action": "flow_cache.cached_action", + "args": [ + "8796093022722<48>", + "2<32>" + ] + }, + "timestamp": 1600 + }, + { + "type": "packet", + "bytes": "08000000010008000000010108004500002800000000400663ce0a0001010a00020204570050000000000000000050000000943b0000", + "locations": [ + "0:1" + ], + "timestamp": 1800 + }, + { + "type": "packet", + "bytes": "08000000010008000000010108004500002800000000400663ce0a0001010a00020204570050000000000000000050000000943b0000", + "locations": [ + "0:1" + ], + "timestamp": 2000 + }, + { + "type": "packet", + "bytes": "08000000010008000000010108004500002800000000400663ce0a0001010a00020204570050000000000000000050000000943b0000", + "locations": [ + "0:1" + ], + "timestamp": 2200 + }, + { + "type": "packet", + "bytes": "08000000010008000000010108004500002800000000400662cd0a0001010a00030304570050000000000000000050000000933a0000", + "locations": [ + "0:1" + ], + "timestamp": 2400 + } + ] +} diff --git a/examples/p4_bmv2_examples/flowcache/gen_spec.py b/examples/p4_bmv2_examples/flowcache/gen_spec.py new file mode 100644 index 00000000..ae17dca0 --- /dev/null +++ b/examples/p4_bmv2_examples/flowcache/gen_spec.py @@ -0,0 +1,105 @@ +#!/usr/bin/env python3 +"""Generate flowcache.json for the Lucid flowcache example. + +Single switch (no topology block — default 1-switch sim is fine). The +test traces a typical flowcache lifecycle: + + 1. A burst of packets in flow A arrives; the cache is empty, all miss + and produce PacketIn events that show up in `Exits`. + 2. The "controller" (this JSON spec) installs a flow_cache entry for + flow A. + 3. A second burst of flow-A packets arrives — they hit the cache and + get forwarded. + 4. A packet in flow B arrives — still misses (no rule installed). +""" + +import ipaddress +import json +from pathlib import Path + +from scapy.all import Ether, IP, TCP + +# ---- helpers ------------------------------------------------------------ + +def ipv4_int(s): return int(ipaddress.IPv4Address(s)) +def mac_int(s): return int(s.replace(":", ""), 16) + +H1_MAC = "08:00:00:00:01:01" +H2_MAC = "08:00:00:00:02:02" +S1_MAC = "08:00:00:00:01:00" + +def ipv4_tcp(src_ip, dst_ip, sport=1111, dport=80, + src_mac=H1_MAC, dst_mac=S1_MAC, ttl=64): + p = (Ether(dst=dst_mac, src=src_mac, type=0x0800) / + IP(src=src_ip, dst=dst_ip, ttl=ttl, id=0, flags=0, frag=0, + tos=0, len=40) / + TCP(sport=sport, dport=dport, seq=0, ack=0, dataofs=5, + reserved=0, flags=0, window=0, urgptr=0)) + return bytes(p).hex() + +def install_flow(key_proto, key_src, key_dst, dmac, port): + """Install a flow_cache entry. Key is the (proto, src, dst) record.""" + return { + "type": "command", "name": "Table.install", + "args": { + "table": "flow_cache", + "key": [f"{key_proto}<8>", + f"{ipv4_int(key_src)}<32>", + f"{ipv4_int(key_dst)}<32>"], + "action": "flow_cache.cached_action", + "args": [f"{mac_int(dmac)}<48>", f"{port}<32>"], + }, + } + +PROTO_TCP = 6 +FLOW_A = (PROTO_TCP, "10.0.1.1", "10.0.2.2") +FLOW_B = (PROTO_TCP, "10.0.1.1", "10.0.3.3") + +# ---- timeline ---------------------------------------------------------- + +events = [] +ts = 1000 + +# (1) initial burst: 3 packets in flow A, cache is empty → all miss +for _ in range(3): + events.append({ + "type": "packet", + "bytes": ipv4_tcp(FLOW_A[1], FLOW_A[2]), + "locations": ["0:1"], + "timestamp": ts, + }) + ts += 200 + +# (2) controller installs the rule for flow A +events.append({**install_flow(FLOW_A[0], FLOW_A[1], FLOW_A[2], + dmac=H2_MAC, port=2), + "timestamp": ts}) +ts += 200 + +# (3) second burst on flow A — should hit +for _ in range(3): + events.append({ + "type": "packet", + "bytes": ipv4_tcp(FLOW_A[1], FLOW_A[2]), + "locations": ["0:1"], + "timestamp": ts, + }) + ts += 200 + +# (4) a single packet in flow B — still misses +events.append({ + "type": "packet", + "bytes": ipv4_tcp(FLOW_B[1], FLOW_B[2]), + "locations": ["0:1"], + "timestamp": ts, +}) + +spec = { + "max time": 10000, + "default_input_gap": 100, + "events": events, +} + +out = Path(__file__).with_name("flowcache.json") +out.write_text(json.dumps(spec, indent=2) + "\n") +print(f"wrote {out} with {len(events)} events") diff --git a/examples/p4_bmv2_examples/link_monitor/README.md b/examples/p4_bmv2_examples/link_monitor/README.md new file mode 100644 index 00000000..80faaed5 --- /dev/null +++ b/examples/p4_bmv2_examples/link_monitor/README.md @@ -0,0 +1,64 @@ +# `link_monitor` + +Per-egress-port telemetry collected by probe packets that traverse a +source-routed path. Each switch maintains two arrays: + +- `byte_cnt_reg[port]` — packets sent out that port since the last probe. +- `last_time_reg[port]` — timestamp of the last probe through that port. + +When a probe egresses a port, it atomically samples-and-resets the byte +counter, samples-and-updates the last_time, and pushes a tuple +`(swid=self, port, byte_cnt, last_time, cur_time)` onto its accumulated +chain. The receiver of the probe (a host, or in our case a printf at the +last hop) reads the full hop list. + +## Files +- [link_monitor.dpt](link_monitor.dpt) — the Lucid program. +- [gen_spec.py](gen_spec.py) — scapy generator. Builds IPv4 traffic and + probe events. +- [link_monitor.json](link_monitor.json) — generated artifact. + +## Running +```bash +/opt/anaconda3/bin/python3 gen_spec.py +../../../sources/lucid/dpt link_monitor.dpt --spec link_monitor.json --silent +``` + +## Test cases (driven by `gen_spec.py`) + +1. **3 IPv4 packets h1→h2.** Each forwards through s1 (egress port 2) + then s2 (egress port 1), bumping `byte_cnt_reg` at both ports. +2. **Probe along [2, 1].** Walks s1:p2 → s2:p1. Expected telemetry: + - hop[0] (s2:p1): `bc=3`, `last=0` + - hop[1] (s1:p2): `bc=3`, `last=0` +3. **2 more IPv4 packets h1→h2.** Both counters now sit at 2. +4. **Probe along [2, 1] again.** Telemetry: + - hop[0] (s2:p1): `bc=2`, `last=` probe 2's `cur` at s2 (6200) + - hop[1] (s1:p2): `bc=2`, `last=` probe 2's `cur` at s1 (5600) +5. **3-hop detour probe along [3, 3, 1]** (s1:p3 → s3:p3 → s2:p1). + All `bc=0` because no IPv4 traffic ever traversed s1:p3 or s3:p3. + `last` for s2:p1 is non-zero (set by probe 4). + +The `printf` `probe DONE` block at the final hop dumps the full chain +in push-front order (most recent first). + +## Notable Lucid details + +- The `probe` event is just a regular Lucid event with vector args + carrying both stacks as fixed-size `int<32>[4]` arrays, so we don't need + a parser. This treats probes as a *control protocol* rather than a wire-format + packet. If you ever need a real wire format (to talk to non-Lucid endpoints), + you'd recover the per-depth event variant approach from `source_routing`/`mri`. +- Probes are injected via the JSON spec's `"events"` list — same way you'd + inject any non-packet event in any other Lucid program. `generate_port` + ferries them between switches at runtime. At the last hop the event is + emitted out a host port and lands in the `Exits` list. +- **Global declaration order matters across handlers.** + `ipv4_lpm → byte_cnt_reg → last_time_reg`. Both handlers (`ipv4_pkt` + and `probe`) access only some of these but in declaration order, so + the typechecker is happy. The `probe` handler skips `ipv4_lpm` + (allowed); the `ipv4_pkt` handler skips `last_time_reg` (allowed). +- **`Array.update(arr, idx, get_val, _, set_to_arg, now)`** is the + natural Lucid idiom for "atomically read the old value and write a + new value." We use it for both sample-and-reset (`zero_out` as the + set memop) and sample-and-replace (`set_to_arg`). diff --git a/examples/p4_bmv2_examples/link_monitor/gen_spec.py b/examples/p4_bmv2_examples/link_monitor/gen_spec.py new file mode 100644 index 00000000..53e545c2 --- /dev/null +++ b/examples/p4_bmv2_examples/link_monitor/gen_spec.py @@ -0,0 +1,177 @@ +#!/usr/bin/env python3 +"""Generate link_monitor.json for the Lucid link_monitor example. + +Probe events are regular (non-packet) Lucid events: we inject them +directly from the spec rather than building wire-format packets and +running them through a parser. IPv4 packets are still real on-the-wire +packets (built with scapy). +""" + +import ipaddress +import json +from pathlib import Path + +from scapy.all import Ether, IP + +# ---- topology (same triangle as source_routing / mri) ------------------- + +TOPOLOGY = { + "nodes": { + "0": {"ports": {"2": {"type": "link"}, "3": {"type": "link"}}}, + "1": {"ports": {"2": {"type": "link"}, "3": {"type": "link"}}}, + "2": {"ports": {"2": {"type": "link"}, "3": {"type": "link"}}}, + }, + "links": [ + {"0:2": "1:2"}, + {"0:3": "2:2"}, + {"1:3": "2:3"}, + ], +} + +# ---- helpers ------------------------------------------------------------ + +def ipv4_int(s): return int(ipaddress.IPv4Address(s)) +def mac_int(s): return int(s.replace(":", ""), 16) + +H1_MAC = "08:00:00:00:01:01" +H2_MAC = "08:00:00:00:02:02" +H3_MAC = "08:00:00:00:03:03" +S1_MAC = "08:00:00:00:01:00" +S2_MAC = "08:00:00:00:02:00" +S3_MAC = "08:00:00:00:03:00" + +def install_lpm(node, dst_ip, dmac, port): + return { + "type": "command", "name": "Table.install", "locations": [node], + "args": { + "table": "ipv4_lpm", + "key": [f"{ipv4_int(dst_ip)}<32>"], + "action": "ipv4_lpm.ipv4_forward", + "args": [f"{mac_int(dmac)}<48>", f"{port}<32>"], + }, + } + +def ipv4_packet(src_ip, dst_ip, ttl=64, src_mac=H1_MAC, dst_mac=S1_MAC): + p = (Ether(dst=dst_mac, src=src_mac, type=0x0800) / + IP(src=src_ip, dst=dst_ip, ttl=ttl, id=0, flags=0, frag=0, + tos=0, len=20)) + return bytes(p).hex() + +def probe_event(route, n_data=0, + swids=(0,)*4, ports=(0,)*4, + byte_cnts=(0,)*4, last_times=(0,)*4, cur_times=(0,)*4, + location_node=0, location_port=1, timestamp=None): + """Build a probe event for the JSON spec. + + `route` is a list of upcoming egress ports (max 4 entries). It's + zero-padded on the right. + """ + assert 1 <= len(route) <= 4 + route_padded = list(route) + [0] * (4 - len(route)) + n_route = len(route) + args = ( + [n_route, n_data] + + list(route_padded) + + list(swids) + + list(ports) + + list(byte_cnts) + + list(last_times) + + list(cur_times) + ) + ev = { + "name": "probe", + "args": args, + "locations": [f"{location_node}:{location_port}"], + } + if timestamp is not None: + ev["timestamp"] = timestamp + return ev + +# ---- control plane: ipv4_lpm install on all 3 switches ------------------ + +events = [] + +# s1 (node 0) +events += [ + install_lpm(0, "10.0.1.1", H1_MAC, port=1), + install_lpm(0, "10.0.2.2", S2_MAC, port=2), + install_lpm(0, "10.0.3.3", S3_MAC, port=3), +] +# s2 (node 1) +events += [ + install_lpm(1, "10.0.1.1", S1_MAC, port=2), + install_lpm(1, "10.0.2.2", H2_MAC, port=1), + install_lpm(1, "10.0.3.3", S3_MAC, port=3), +] +# s3 (node 2) +events += [ + install_lpm(2, "10.0.1.1", S1_MAC, port=2), + install_lpm(2, "10.0.2.2", S2_MAC, port=3), + install_lpm(2, "10.0.3.3", H3_MAC, port=1), +] + +# ---- traffic + probes --------------------------------------------------- +# +# Plan: +# 1. Send a handful of IPv4 packets h1→h2 to bump byte_cnt on s1:p2 and +# s2:p1. Each ipv4_pkt forward at egress port P increments +# byte_cnt_reg[P] by 1. +# 2. Send a probe along the same path (s1:p2 → s2:p1). It should sample +# the accumulated counts, reset them, and emit a DONE log with the +# telemetry at the end. +# 3. Send a second probe along the same path. byte_cnt was reset, so its +# captured values should be near 0. +# 4. Send a 3-hop probe through s1, s3, s2. + +# (1) some IPv4 traffic +ts = 5000 +for _ in range(3): + events.append({ + "type": "packet", + "bytes": ipv4_packet("10.0.1.1", "10.0.2.2"), + "locations": ["0:1"], + "timestamp": ts, + }) + ts += 200 + +# (2) probe along s1→s2 (route = [2, 1]) +events.append(probe_event(route=[2, 1], location_node=0, location_port=1, + timestamp=ts)) +ts += 500 + +# small spacer + a few more IPv4 packets (these only refill byte_cnt on +# s1:p2 — not on s2:p1, because the probe already reset s2:p1 *after* +# they would have passed through; but the probe runs *after* these, so +# they do count for s2:p1 too). +for _ in range(2): + events.append({ + "type": "packet", + "bytes": ipv4_packet("10.0.1.1", "10.0.2.2"), + "locations": ["0:1"], + "timestamp": ts, + }) + ts += 200 + +# (3) second probe along the same route. byte_cnt should be small (only +# the 2 packets since the first probe). +events.append(probe_event(route=[2, 1], location_node=0, location_port=1, + timestamp=ts)) +ts += 500 + +# (4) 3-hop probe through s1, s3, s2 (route = [3, 3, 1]). +# s1 → port 3 (s3 link) +# s3 → port 3 (s2 link) +# s2 → port 1 (host h2) +events.append(probe_event(route=[3, 3, 1], location_node=0, location_port=1, + timestamp=ts)) + +spec = { + "max time": 30000, + "default_input_gap": 100, + "topology": TOPOLOGY, + "events": events, +} + +out = Path(__file__).with_name("link_monitor.json") +out.write_text(json.dumps(spec, indent=2) + "\n") +print(f"wrote {out} with {len(events)} events") diff --git a/examples/p4_bmv2_examples/link_monitor/link_monitor.dpt b/examples/p4_bmv2_examples/link_monitor/link_monitor.dpt new file mode 100644 index 00000000..7fef04e5 --- /dev/null +++ b/examples/p4_bmv2_examples/link_monitor/link_monitor.dpt @@ -0,0 +1,212 @@ +// Lucid port of the P4 "link_monitor" tutorial. +// +// Each switch keeps per-egress-port telemetry in two arrays: +// byte_cnt_reg[port] — packets sent out that port since the last probe. +// Incremented on every IPv4 forward; sampled and +// reset to 0 when a probe egresses the port. +// last_time_reg[port] — timestamp of the last probe through that port. +// Sampled and rewritten to "now" on each probe. +// +// A probe is a source-routed packet that walks the network collecting +// (swid, port, byte_cnt, last_time, cur_time) telemetry tuples at every +// hop. The receiving host reads the full chain. +// +// Big design pivot from the upstream P4: **probes are regular Lucid +// events, not packet events.** The upstream tutorial puts the route + +// telemetry stacks on the wire as variable-length P4 header stacks, +// which would force us through the same per-depth-event explosion we +// saw in `source_routing` and `mri`. A regular Lucid event has no wire +// format and no auto-deparser, so we can carry the stacks as plain +// `int<32>[4]` vectors and a single handler does the whole +// pop-route + push-telemetry transition. This treats the probe as a +// "control protocol" injected at the source and consumed at the sink, +// which is faithful to its purpose — what gets on the wire to a real +// host is a separate concern outside the scope of this example. + +// MAX_HOPS = 4 (encoded as the literal `4` throughout — vector sizes and +// for-loop bounds need a concrete literal, and naming this via `size` ran +// into "Cannot unify 4 with MAX_HOPS" mismatches between vector-typed +// fields and loop indices). +const int N_PORTS = 8; // arrays sized to fit our triangle's ports + +const int<16> ETY_IPV4 = 0x0800; + +type eth_hdr_t = { + int<48> dmac; + int<48> smac; + int<16> ety; +} + +type ipv4_t = { + int<4> version; + int<4> ihl; + int<8> diffserv; + int<16> total_len; + int<16> id; + int<3> flags; + int<13> frag_offset; + int<8> ttl; + int<8> protocol; + int<16> hdr_csum; + int<32> src; + int<32> dst; +} + +// -------- IPv4 forwarding table (same shape as basic) -------------------- + +type fwd_t = { + int<48> fwd_dmac; + int<32> fwd_port; + bool fwd_hit; +} + +action fwd_t ipv4_forward(int<48> dmac, int<32> port)() { + return {fwd_dmac = dmac; fwd_port = port; fwd_hit = true}; +} + +action fwd_t ipv4_drop(int<48> _dmac, int<32> _port)() { + return {fwd_dmac = 0; fwd_port = 0; fwd_hit = false}; +} + +global Table.t<, (int<48>, int<32>), (), fwd_t>> ipv4_lpm = + Table.create(1024, [ipv4_forward; ipv4_drop], ipv4_drop, (0, 0)); + +// -------- per-port telemetry arrays -------------------------------------- +// +// Declaration order matters: every execution path must access these in +// declaration order. ipv4_lpm comes first, then byte_cnt_reg, then +// last_time_reg. + +global Array.t<32> byte_cnt_reg = Array.create(N_PORTS); +global Array.t<32> last_time_reg = Array.create(N_PORTS); + +memop get_val(int mv, int unused) { return mv; } +memop zero_out(int mv, int unused) { return 0; } +memop incr_by(int mv, int by) { return mv + by; } +memop set_to_arg(int mv, int arg) { return arg; } + +// -------- events --------------------------------------------------------- + +packet event ipv4_pkt(eth_hdr_t eth, ipv4_t ip, Payload.t pl); + +// Probe event. Not a packet event — there's no wire format to parse, and +// `generate_port` carries it between switches as a typed Lucid value. +// +// n_route — labels remaining in the route (0..MAX_HOPS) +// n_data — telemetry tuples accumulated so far (0..MAX_HOPS) +// route[] — upcoming egress ports; route[0] is "this hop" +// swids/ports/byte_cnts/last_times/cur_times — push-front telemetry, +// index 0 = most recent hop +event probe(int<8> n_route, int<8> n_data, + int<32>[4] route, + int<32>[4] swids, + int<32>[4] ports, + int<32>[4] byte_cnts, + int<32>[4] last_times, + int<32>[4] cur_times); + +// -------- handlers ------------------------------------------------------- + +handle ipv4_pkt(eth_hdr_t eth, ipv4_t ip, Payload.t pl) { + fwd_t d = Table.lookup(ipv4_lpm, ip#dst, ()); + if (d#fwd_hit) { + // Count this packet against the egress port's byte_cnt. + Array.setm(byte_cnt_reg, d#fwd_port, incr_by, 1); + + eth_hdr_t new_eth = { + dmac = d#fwd_dmac; + smac = eth#dmac; + ety = eth#ety + }; + ipv4_t new_ip = { + version = ip#version; + ihl = ip#ihl; + diffserv = ip#diffserv; + total_len = ip#total_len; + id = ip#id; + flags = ip#flags; + frag_offset = ip#frag_offset; + ttl = ip#ttl - 1; + protocol = ip#protocol; + hdr_csum = 0; + src = ip#src; + dst = ip#dst + }; + printf("sw %d port %d -> %d : ipv4 dst=%d ttl=%d", + self, ingress_port, d#fwd_port, ip#dst, new_ip#ttl); + generate_port(d#fwd_port, + ipv4_pkt(new_eth, {new_ip with hdr_csum = hash<16>(checksum, new_ip)}, pl)); + } else { + printf("sw %d port %d : drop ipv4 dst=%d (no route)", + self, ingress_port, ip#dst); + } +} + +handle probe(int<8> n_route, int<8> n_data, + int<32>[4] route, + int<32>[4] swids, + int<32>[4] ports, + int<32>[4] byte_cnts, + int<32>[4] last_times, + int<32>[4] cur_times) { + // We always reach this handler with n_route >= 1: the previous hop's + // generate_port either delivered to the next switch (route still has + // entries) or to an unconnected host port (where it appears in + // `Exits`). The very-end "probe DONE" view is therefore printed + // *here* at the last hop, just before the egress. + int<32> egress = route[0]; + + // Sample-and-reset byte counter, then sample-and-update last_time. + int<32> bc = Array.update(byte_cnt_reg, egress, get_val, 0, zero_out, 0); + int<32> now = Sys.time(); + int<32> lt = Array.update(last_time_reg, egress, get_val, 0, set_to_arg, now); + + // Pop the head of the route (shift left, pad with 0). + int<32>[4] new_route = [route[1]; route[2]; route[3]; 0]; + + // Push the new telemetry tuple onto the FRONT of each accumulator + // (index 0 = "this hop", n_data grows by 1). + int<32>[4] new_swids = [self; swids[0]; swids[1]; swids[2]]; + int<32>[4] new_ports = [egress; ports[0]; ports[1]; ports[2]]; + int<32>[4] new_byte_cnts = [bc; byte_cnts[0]; byte_cnts[1]; byte_cnts[2]]; + int<32>[4] new_last_times = [lt; last_times[0]; last_times[1]; last_times[2]]; + int<32>[4] new_cur_times = [now; cur_times[0]; cur_times[1]; cur_times[2]]; + + int<8> nr_out = n_route - 1; + int<8> nd_out = n_data + 1; + + printf("sw %d port %d -> %d : probe push (route_left=%d data=%d bc=%d lt=%d now=%d)", + self, ingress_port, egress, nr_out, nd_out, bc, lt, now); + + if (nr_out == 0) { + // Last hop — also print the accumulated chain so the test output + // shows the full telemetry sequence. + printf("sw %d : probe DONE, n_data=%d (most-recent-first)", self, nd_out); + for (i < 4) { + int<32> idx = size_to_int(i); + if (idx < (int<32>)nd_out) { + printf(" hop[%d]: sw=%d port=%d byte_cnt=%d cur=%d last=%d", + idx, new_swids[i], new_ports[i], new_byte_cnts[i], + new_cur_times[i], new_last_times[i]); + } + } + } + + // Emit the (possibly final) probe. If route_left=0 the port is a host + // port and the event lands in `Exits`. + generate_port(egress, probe(nr_out, nd_out, + new_route, + new_swids, new_ports, + new_byte_cnts, new_last_times, new_cur_times)); +} + +parser main(bitstring pkt) { + eth_hdr_t eth = read(pkt); + match eth#ety with + | LUCID_ETHERTY -> { do_lucid_parsing(pkt); } + | 0x0800 -> { + ipv4_t ip = read(pkt); + generate(ipv4_pkt(eth, ip, Payload.parse(pkt))); + } + | _ -> { drop; } +} diff --git a/examples/p4_bmv2_examples/link_monitor/link_monitor.json b/examples/p4_bmv2_examples/link_monitor/link_monitor.json new file mode 100644 index 00000000..1b2d5dd7 --- /dev/null +++ b/examples/p4_bmv2_examples/link_monitor/link_monitor.json @@ -0,0 +1,358 @@ +{ + "max time": 30000, + "default_input_gap": 100, + "topology": { + "nodes": { + "0": { + "ports": { + "2": { + "type": "link" + }, + "3": { + "type": "link" + } + } + }, + "1": { + "ports": { + "2": { + "type": "link" + }, + "3": { + "type": "link" + } + } + }, + "2": { + "ports": { + "2": { + "type": "link" + }, + "3": { + "type": "link" + } + } + } + }, + "links": [ + { + "0:2": "1:2" + }, + { + "0:3": "2:2" + }, + { + "1:3": "2:3" + } + ] + }, + "events": [ + { + "type": "command", + "name": "Table.install", + "locations": [ + 0 + ], + "args": { + "table": "ipv4_lpm", + "key": [ + "167772417<32>" + ], + "action": "ipv4_lpm.ipv4_forward", + "args": [ + "8796093022465<48>", + "1<32>" + ] + } + }, + { + "type": "command", + "name": "Table.install", + "locations": [ + 0 + ], + "args": { + "table": "ipv4_lpm", + "key": [ + "167772674<32>" + ], + "action": "ipv4_lpm.ipv4_forward", + "args": [ + "8796093022720<48>", + "2<32>" + ] + } + }, + { + "type": "command", + "name": "Table.install", + "locations": [ + 0 + ], + "args": { + "table": "ipv4_lpm", + "key": [ + "167772931<32>" + ], + "action": "ipv4_lpm.ipv4_forward", + "args": [ + "8796093022976<48>", + "3<32>" + ] + } + }, + { + "type": "command", + "name": "Table.install", + "locations": [ + 1 + ], + "args": { + "table": "ipv4_lpm", + "key": [ + "167772417<32>" + ], + "action": "ipv4_lpm.ipv4_forward", + "args": [ + "8796093022464<48>", + "2<32>" + ] + } + }, + { + "type": "command", + "name": "Table.install", + "locations": [ + 1 + ], + "args": { + "table": "ipv4_lpm", + "key": [ + "167772674<32>" + ], + "action": "ipv4_lpm.ipv4_forward", + "args": [ + "8796093022722<48>", + "1<32>" + ] + } + }, + { + "type": "command", + "name": "Table.install", + "locations": [ + 1 + ], + "args": { + "table": "ipv4_lpm", + "key": [ + "167772931<32>" + ], + "action": "ipv4_lpm.ipv4_forward", + "args": [ + "8796093022976<48>", + "3<32>" + ] + } + }, + { + "type": "command", + "name": "Table.install", + "locations": [ + 2 + ], + "args": { + "table": "ipv4_lpm", + "key": [ + "167772417<32>" + ], + "action": "ipv4_lpm.ipv4_forward", + "args": [ + "8796093022464<48>", + "2<32>" + ] + } + }, + { + "type": "command", + "name": "Table.install", + "locations": [ + 2 + ], + "args": { + "table": "ipv4_lpm", + "key": [ + "167772674<32>" + ], + "action": "ipv4_lpm.ipv4_forward", + "args": [ + "8796093022720<48>", + "3<32>" + ] + } + }, + { + "type": "command", + "name": "Table.install", + "locations": [ + 2 + ], + "args": { + "table": "ipv4_lpm", + "key": [ + "167772931<32>" + ], + "action": "ipv4_lpm.ipv4_forward", + "args": [ + "8796093022979<48>", + "1<32>" + ] + } + }, + { + "type": "packet", + "bytes": "08000000010008000000010108004500001400000000400063e80a0001010a000202", + "locations": [ + "0:1" + ], + "timestamp": 5000 + }, + { + "type": "packet", + "bytes": "08000000010008000000010108004500001400000000400063e80a0001010a000202", + "locations": [ + "0:1" + ], + "timestamp": 5200 + }, + { + "type": "packet", + "bytes": "08000000010008000000010108004500001400000000400063e80a0001010a000202", + "locations": [ + "0:1" + ], + "timestamp": 5400 + }, + { + "name": "probe", + "args": [ + 2, + 0, + 2, + 1, + 0, + 0, + 0, + 0, + 0, + 0, + 0, + 0, + 0, + 0, + 0, + 0, + 0, + 0, + 0, + 0, + 0, + 0, + 0, + 0, + 0, + 0 + ], + "locations": [ + "0:1" + ], + "timestamp": 5600 + }, + { + "type": "packet", + "bytes": "08000000010008000000010108004500001400000000400063e80a0001010a000202", + "locations": [ + "0:1" + ], + "timestamp": 6100 + }, + { + "type": "packet", + "bytes": "08000000010008000000010108004500001400000000400063e80a0001010a000202", + "locations": [ + "0:1" + ], + "timestamp": 6300 + }, + { + "name": "probe", + "args": [ + 2, + 0, + 2, + 1, + 0, + 0, + 0, + 0, + 0, + 0, + 0, + 0, + 0, + 0, + 0, + 0, + 0, + 0, + 0, + 0, + 0, + 0, + 0, + 0, + 0, + 0 + ], + "locations": [ + "0:1" + ], + "timestamp": 6500 + }, + { + "name": "probe", + "args": [ + 3, + 0, + 3, + 3, + 1, + 0, + 0, + 0, + 0, + 0, + 0, + 0, + 0, + 0, + 0, + 0, + 0, + 0, + 0, + 0, + 0, + 0, + 0, + 0, + 0, + 0 + ], + "locations": [ + "0:1" + ], + "timestamp": 7000 + } + ] +} diff --git a/examples/p4_bmv2_examples/load_balance/README.md b/examples/p4_bmv2_examples/load_balance/README.md new file mode 100644 index 00000000..28c72ec6 --- /dev/null +++ b/examples/p4_bmv2_examples/load_balance/README.md @@ -0,0 +1,77 @@ +# `load_balance` + +Hash-based ECMP forwarding across a 3-switch triangle. The trick: the +*magic IP* `10.0.0.1` indicates "load-balance across {h2, h3} by 5-tuple +hash." s1 is the load balancer; s2 and s3 are plain forwarders for their +own attached hosts. The rewrite happens at s1: the destination IP is +replaced with the chosen host's real IP (`10.0.2.2` or `10.0.3.3`) +before the packet is forwarded, so downstream switches see a normal +unicast packet. + +## Files +- [load_balance.dpt](load_balance.dpt) — the Lucid program. +- [gen_spec.py](gen_spec.py) — scapy-based generator. Builds the + topology block, the table-install events, and the test packets (with + valid IPv4 checksums) in one place. +- [load_balance.json](load_balance.json) — committed artifact, regenerate + with `python gen_spec.py`. + +## Running +```bash +/opt/anaconda3/bin/python3 gen_spec.py +../../../sources/lucid/dpt load_balance.dpt --spec load_balance.json --silent +``` + +## Topology +3-switch triangle, one host per switch. Node IDs map `s1..s3 → 0..2`. + +``` + h1 h2 + | | + 1 1 + [s1=0] 2 --------- 2 [s2=1] 3 + 3 | + | 3 + 2 | + [s3=2] 1 -- h3 -------- (via s2:3 ↔ s3:3) +``` + +## Pipeline +The handler walks three tables in series for every TCP packet: + +1. **`ecmp_group`** (LPM on `ip#dst`) returns `(grp_base, grp_count, hit)`. + `count` must be a power of 2 (1 or 2 here). On miss, drop. +2. The handler hashes the 5-tuple + `(ip#src, ip#dst, ip#protocol, tcp#src_port, tcp#dst_port)` to a + 14-bit value and computes `select = base + (hash & (count-1))`. Lucid + has no `%` operator, so the count must be a power of two and we use + bitwise AND. +3. **`ecmp_nhop`** (exact on `select`) returns + `(nh_dmac, nh_dstip, nh_port, hit)`. The dst-IP rewrite lives here — + for s1, `nh_dstip` is `10.0.2.2` or `10.0.3.3`, never the original + `10.0.0.1`. +4. **`send_frame`** (exact on `nh_port`) returns `(fr_smac, fr_hit)`. + On miss, the input smac is preserved (matches P4's NoAction default). + +The handler then rewrites the ethernet header, decrements TTL, and +recomputes the IPv4 checksum (same `hash<16>(checksum, new_ip)` pattern +as `basic` and `basic_tunnel`). + +## Test cases (defined in `gen_spec.py`) +- Six TCP flows from `h1 → 10.0.0.1` with different source ports + (1111…6666). All 6 hit s1's `ecmp_group` entry for 10.0.0.1 and split + across `{select=0 → h2, select=1 → h3}` based on hash. Expected: both + buckets exercised across the run; exact split depends on the seed. +- One direct packet `h1 → 10.0.2.2`. s1 has no `ecmp_group` entry for + 10.0.2.2 (only for 10.0.0.1), so this drops at s1. Confirms s1 is + *only* a load balancer, not a general router for these hosts. +- One unroutable packet `h1 → 10.99.99.99`. Drops at s1. + +After a run, scan the `Exits` list and confirm packets show up at both +`1:1` (h2's port) and `2:1` (h3's port). + +## Notable design choices +- **`(int)(rec#field)` not `(int)rec#field`.** Casts bind tighter + than `#` in Lucid, so the field-access has to be parenthesized. +- **gen_spec.py emits the whole spec.** topology + 11 `Table.install` + events + 8 packet events. \ No newline at end of file diff --git a/examples/p4_bmv2_examples/load_balance/gen_spec.py b/examples/p4_bmv2_examples/load_balance/gen_spec.py new file mode 100644 index 00000000..b23392bf --- /dev/null +++ b/examples/p4_bmv2_examples/load_balance/gen_spec.py @@ -0,0 +1,166 @@ +#!/usr/bin/env python3 +"""Generate load_balance.json for the Lucid load_balance example. + +Run with `python gen_spec.py`. Overwrites load_balance.json next to this +script. Scapy builds the wire-format packets (ethernet/IPv4/TCP with valid +checksums); this file also generates the topology block and the table +install events (a lot of repetition is easier to maintain in Python). +""" + +import ipaddress +import json +from pathlib import Path + +from scapy.all import Ether, IP, TCP + +# ---- topology ------------------------------------------------------------ +# +# Node IDs map: 0=s1, 1=s2, 2=s3. Host-facing ports (each switch's port 1) +# are left undeclared so forwarded packets show up in Exits. + +TOPOLOGY = { + "nodes": { + "0": {"ports": {"2": {"type": "link"}, "3": {"type": "link"}}}, + "1": {"ports": {"2": {"type": "link"}, "3": {"type": "link"}}}, + "2": {"ports": {"2": {"type": "link"}, "3": {"type": "link"}}}, + }, + "links": [ + {"0:2": "1:2"}, + {"0:3": "2:2"}, + {"1:3": "2:3"}, + ], +} + +# ---- helpers ------------------------------------------------------------- + +def ipv4_int(s): + return int(ipaddress.IPv4Address(s)) + +def mac_int(s): + return int(s.replace(":", ""), 16) + +def install_ecmp_group(node, dst_ip_str, base, count, action="ecmp_group.set_ecmp_params"): + return { + "type": "command", "name": "Table.install", "locations": [node], + "args": { + "table": "ecmp_group", + "key": [f"{ipv4_int(dst_ip_str)}<32>"], + "action": action, + "args": [f"{base}<16>", f"{count}<32>"], + }, + } + +def install_ecmp_nhop(node, select, dmac_str, nhop_ip_str, port): + return { + "type": "command", "name": "Table.install", "locations": [node], + "args": { + "table": "ecmp_nhop", + "key": [f"{select}<16>"], + "action": "ecmp_nhop.set_nhop", + "args": [f"{mac_int(dmac_str)}<48>", + f"{ipv4_int(nhop_ip_str)}<32>", + f"{port}<32>"], + }, + } + +def install_send_frame(node, port, smac_str): + return { + "type": "command", "name": "Table.install", "locations": [node], + "args": { + "table": "send_frame", + "key": [f"{port}<32>"], + "action": "send_frame.rewrite_mac", + "args": [f"{mac_int(smac_str)}<48>"], + }, + } + +def tcp_packet_bytes(src_ip, dst_ip, src_port, dst_port, + src_mac="08:00:00:00:01:01", # h1 + dst_mac="08:00:00:00:01:00", # h1's gateway (s1) + ttl=64, seq=0): + """Build a TCP packet on the wire, with a valid IPv4 checksum.""" + p = (Ether(dst=dst_mac, src=src_mac, type=0x0800) / + IP(src=src_ip, dst=dst_ip, ttl=ttl, id=0, flags=0, frag=0, + tos=0, len=40) / + TCP(sport=src_port, dport=dst_port, seq=seq, ack=0, + dataofs=5, reserved=0, flags=0, window=0, urgptr=0)) + # Force scapy to compute the IPv4 checksum. + raw = bytes(p) + return raw.hex() + +# ---- control events: table installs ------------------------------------- + +events = [] + +# s1 (node 0): load-balance 10.0.0.1 across {h2, h3}. +events += [ + install_ecmp_group(0, "10.0.0.1", base=0, count=2), + install_ecmp_nhop(0, select=0, dmac_str="08:00:00:00:02:02", + nhop_ip_str="10.0.2.2", port=2), + install_ecmp_nhop(0, select=1, dmac_str="08:00:00:00:03:03", + nhop_ip_str="10.0.3.3", port=3), + install_send_frame(0, port=2, smac_str="08:00:00:00:01:00"), + install_send_frame(0, port=3, smac_str="08:00:00:00:01:00"), +] + +# s2 (node 1): trivial single-path to h2. +events += [ + install_ecmp_group(1, "10.0.2.2", base=0, count=1), + install_ecmp_nhop(1, select=0, dmac_str="08:00:00:00:02:02", + nhop_ip_str="10.0.2.2", port=1), + install_send_frame(1, port=1, smac_str="08:00:00:00:02:00"), +] + +# s3 (node 2): trivial single-path to h3. +events += [ + install_ecmp_group(2, "10.0.3.3", base=0, count=1), + install_ecmp_nhop(2, select=0, dmac_str="08:00:00:00:03:03", + nhop_ip_str="10.0.3.3", port=1), + install_send_frame(2, port=1, smac_str="08:00:00:00:03:00"), +] + +# ---- test packets -------------------------------------------------------- +# +# Several flows from h1 → 10.0.0.1 with different TCP src ports. The +# expectation is that s1's hash splits these across (h2, h3); we cannot +# control which port any individual flow lands on, but with enough flows we +# should see both buckets exercised. + +TESTS = [ + ("flow A: h1->10.0.0.1, sport=1111", "10.0.1.1", "10.0.0.1", 1111, 80), + ("flow B: h1->10.0.0.1, sport=2222", "10.0.1.1", "10.0.0.1", 2222, 80), + ("flow C: h1->10.0.0.1, sport=3333", "10.0.1.1", "10.0.0.1", 3333, 80), + ("flow D: h1->10.0.0.1, sport=4444", "10.0.1.1", "10.0.0.1", 4444, 80), + ("flow E: h1->10.0.0.1, sport=5555", "10.0.1.1", "10.0.0.1", 5555, 80), + ("flow F: h1->10.0.0.1, sport=6666", "10.0.1.1", "10.0.0.1", 6666, 80), + ("direct: h1->h2 (s1 has no entry for 10.0.2.2 -> drop)", + "10.0.1.1", "10.0.2.2", 1000, 80), + ("unroutable: h1->10.99.99.99 (drop at ecmp_group)", + "10.0.1.1", "10.99.99.99", 1000, 80), +] + +ts = 5000 +for label, src, dst, sport, dport in TESTS: + events.append({ + "type": "packet", + "bytes": tcp_packet_bytes(src, dst, sport, dport), + "locations": ["0:1"], + "timestamp": ts, + }) + ts += 500 + +# ---- assemble + write --------------------------------------------------- + +spec = { + "max time": 30000, + "default_input_gap": 100, + "topology": TOPOLOGY, + "events": events, +} + +out = Path(__file__).with_name("load_balance.json") +out.write_text(json.dumps(spec, indent=2) + "\n") +print(f"wrote {out} with {len(events)} events " + f"(installs + {len(TESTS)} packets)") +for label, *_ in TESTS: + print(f" - {label}") diff --git a/examples/p4_bmv2_examples/load_balance/load_balance.dpt b/examples/p4_bmv2_examples/load_balance/load_balance.dpt new file mode 100644 index 00000000..5b6ff5aa --- /dev/null +++ b/examples/p4_bmv2_examples/load_balance/load_balance.dpt @@ -0,0 +1,224 @@ +// Lucid port of the P4 "load_balance" tutorial: hash-based ECMP forwarding +// across 3 switches in a triangle, with one host per switch. +// +// The setup is asymmetric: s1 acts as a *load balancer* and treats the +// magic destination IP 10.0.0.1 as "split this flow across {h2, h3} based +// on its TCP 5-tuple." s2 and s3 act as plain forwarders for their own +// hosts (count=1 entries — the ECMP machinery still runs but trivially). +// +// Three tables, applied in series in a single handler: +// 1. ecmp_group — LPM on hdr.ipv4.dst → (base, count, hit). The action +// hashes the 5-tuple and returns `base + (hash & (count-1))`, +// i.e., it picks an ECMP index. Requires `count` to be a +// power of two (1 or 2 in this example). +// 2. ecmp_nhop — exact on the ECMP index → (next-hop dmac, dst-IP rewrite, +// egress port). The dst-IP rewrite is what turns "10.0.0.1" +// into the actual host IP (10.0.2.2 or 10.0.3.3) for the +// downstream switch. +// 3. send_frame — exact on egress port → src MAC for the outgoing frame. +// In P4 this lives in MyEgress; here it's just a third +// Table.lookup at the end of the same handler. +// +// Non-TCP packets are dropped at the parser — the 5-tuple hash needs TCP +// ports, and the upstream P4 program's "use undefined port fields" behavior +// isn't a meaningful semantic in Lucid. + +const int SEED = 0xC0FFEE; + +const int<16> ETY_IPV4 = 0x0800; +const int<8> PROTO_TCP = 6; + +type eth_hdr_t = { + int<48> dmac; + int<48> smac; + int<16> ety; +} + +type ipv4_t = { + int<4> version; + int<4> ihl; + int<8> diffserv; + int<16> total_len; + int<16> id; + int<3> flags; + int<13> frag_offset; + int<8> ttl; + int<8> protocol; + int<16> hdr_csum; + int<32> src; + int<32> dst; +} + +type tcp_t = { + int<16> src_port; + int<16> dst_port; + int<32> seq_no; + int<32> ack_no; + int<4> data_offset; + int<3> tcp_res; + int<3> ecn; + int<6> ctrl; + int<16> window; + int<16> tcp_csum; + int<16> urgent_ptr; +} + +// -------- ecmp_group: LPM on dst IP -> (base, count) -------------------- +// +// install-time data is (base, count) where count must be a power of 2. +// The action just hands those back; the handler then hashes the 5-tuple +// and computes `select = base + (hash & (count-1))`. Putting the hash in +// the handler rather than the action keeps the table's runtime-arg type +// trivial (passing the 5-tuple as a tuple arg trips a type-checker +// occurs-check) and makes the ECMP math visible at the call site. + +type grp_t = { + int<16> grp_base; + int<32> grp_count; + bool grp_hit; +} + +action grp_t set_ecmp_params(int<16> base, int<32> count)() { + return {grp_base = base; grp_count = count; grp_hit = true}; +} + +action grp_t group_drop(int<16> _base, int<32> _count)() { + return {grp_base = 0; grp_count = 0; grp_hit = false}; +} + +global Table.t<, (int<16>, int<32>), (), grp_t>> + ecmp_group = + Table.create(1024, [set_ecmp_params; group_drop], group_drop, (0, 1)); + +// -------- ecmp_nhop: exact on ECMP index -> (dmac, dst_ip, port) --------- + +type nh_t = { + int<48> nh_dmac; + int<32> nh_dstip; + int<32> nh_port; + bool nh_hit; +} + +action nh_t set_nhop(int<48> dmac, int<32> dst_ip, int<32> port)() { + return {nh_dmac = dmac; nh_dstip = dst_ip; nh_port = port; nh_hit = true}; +} + +action nh_t nhop_drop(int<48> _d, int<32> _ip, int<32> _p)() { + return {nh_dmac = 0; nh_dstip = 0; nh_port = 0; nh_hit = false}; +} + +global Table.t<, (int<48>, int<32>, int<32>), (), nh_t>> + ecmp_nhop = + Table.create(64, [set_nhop; nhop_drop], nhop_drop, (0, 0, 0)); + +// -------- send_frame: exact on egress port -> src MAC ------------------- + +type frame_t = { + int<48> fr_smac; + bool fr_hit; +} + +action frame_t rewrite_mac(int<48> smac)() { + return {fr_smac = smac; fr_hit = true}; +} + +// On miss the input smac is preserved (the P4 default is NoAction, i.e. +// "leave smac alone"). The default action returns `fr_hit=false`; the +// handler then skips the smac rewrite. +action frame_t frame_pass(int<48> _smac)() { + return {fr_smac = 0; fr_hit = false}; +} + +global Table.t<, int<48>, (), frame_t>> + send_frame = + Table.create(64, [rewrite_mac; frame_pass], frame_pass, 0); + +// -------- events --------------------------------------------------------- + +packet event tcp_pkt(eth_hdr_t eth, ipv4_t ip, tcp_t tcp, Payload.t pl); + +// -------- handler -------------------------------------------------------- + +handle tcp_pkt(eth_hdr_t eth, ipv4_t ip, tcp_t tcp, Payload.t pl) { + // Verify-side IPv4 checksum (same pattern as basic / basic_tunnel). + int<16> verify = hash<16>(checksum, ip); + if (verify != 0) { + printf("sw %d port %d : bad input csum (verify=%d) dst=%d", + self, ingress_port, verify, ip#dst); + } + + grp_t g = Table.lookup(ecmp_group, ip#dst, ()); + if (g#grp_hit) { + // 5-tuple hash → bucket index. `count` must be a power of two; we + // mask with (count-1) instead of doing a modulo (Lucid has no `%`). + int<14> h = hash<14>(SEED, ip#src, ip#dst, ip#protocol, + tcp#src_port, tcp#dst_port); + int<16> select = g#grp_base + (int<16>)(h & ((int<14>)(g#grp_count) - 1)); + nh_t n = Table.lookup(ecmp_nhop, select, ()); + if (n#nh_hit) { + // Apply MAC + dst-IP rewrites and decrement TTL. The src MAC is + // patched up below after the send_frame lookup. + eth_hdr_t mid_eth = { + dmac = n#nh_dmac; + smac = eth#smac; + ety = eth#ety + }; + ipv4_t new_ip = { + version = ip#version; + ihl = ip#ihl; + diffserv = ip#diffserv; + total_len = ip#total_len; + id = ip#id; + flags = ip#flags; + frag_offset = ip#frag_offset; + ttl = ip#ttl - 1; + protocol = ip#protocol; + hdr_csum = 0; + src = ip#src; + dst = n#nh_dstip + }; + + frame_t f = Table.lookup(send_frame, n#nh_port, ()); + int<48> chosen_smac = mid_eth#smac; + if (f#fr_hit) { chosen_smac = f#fr_smac; } + eth_hdr_t new_eth = { + dmac = mid_eth#dmac; + smac = chosen_smac; + ety = mid_eth#ety + }; + + printf("sw %d port %d -> %d : select=%d dst(rewrite)=%d ttl=%d", + self, ingress_port, n#nh_port, + select, n#nh_dstip, new_ip#ttl); + + generate_port(n#nh_port, + tcp_pkt(new_eth, + {new_ip with hdr_csum = hash<16>(checksum, new_ip)}, + tcp, pl)); + } else { + printf("sw %d port %d : ecmp_nhop miss select=%d - drop", + self, ingress_port, select); + } + } else { + printf("sw %d port %d : ecmp_group miss dst=%d - drop", + self, ingress_port, ip#dst); + } +} + +// -------- parser --------------------------------------------------------- + +parser main(bitstring pkt) { + eth_hdr_t eth = read(pkt); + match eth#ety with + | LUCID_ETHERTY -> { do_lucid_parsing(pkt); } + | 0x0800 -> { + ipv4_t ip = read(pkt); + match ip#protocol with + | PROTO_TCP -> { + tcp_t tcp = read(pkt); + generate(tcp_pkt(eth, ip, tcp, Payload.parse(pkt))); + } + | _ -> { drop; } + } + | _ -> { drop; } +} diff --git a/examples/p4_bmv2_examples/load_balance/load_balance.json b/examples/p4_bmv2_examples/load_balance/load_balance.json new file mode 100644 index 00000000..53e3f8c6 --- /dev/null +++ b/examples/p4_bmv2_examples/load_balance/load_balance.json @@ -0,0 +1,313 @@ +{ + "max time": 30000, + "default_input_gap": 100, + "topology": { + "nodes": { + "0": { + "ports": { + "2": { + "type": "link" + }, + "3": { + "type": "link" + } + } + }, + "1": { + "ports": { + "2": { + "type": "link" + }, + "3": { + "type": "link" + } + } + }, + "2": { + "ports": { + "2": { + "type": "link" + }, + "3": { + "type": "link" + } + } + } + }, + "links": [ + { + "0:2": "1:2" + }, + { + "0:3": "2:2" + }, + { + "1:3": "2:3" + } + ] + }, + "events": [ + { + "type": "command", + "name": "Table.install", + "locations": [ + 0 + ], + "args": { + "table": "ecmp_group", + "key": [ + "167772161<32>" + ], + "action": "ecmp_group.set_ecmp_params", + "args": [ + "0<16>", + "2<32>" + ] + } + }, + { + "type": "command", + "name": "Table.install", + "locations": [ + 0 + ], + "args": { + "table": "ecmp_nhop", + "key": [ + "0<16>" + ], + "action": "ecmp_nhop.set_nhop", + "args": [ + "8796093022722<48>", + "167772674<32>", + "2<32>" + ] + } + }, + { + "type": "command", + "name": "Table.install", + "locations": [ + 0 + ], + "args": { + "table": "ecmp_nhop", + "key": [ + "1<16>" + ], + "action": "ecmp_nhop.set_nhop", + "args": [ + "8796093022979<48>", + "167772931<32>", + "3<32>" + ] + } + }, + { + "type": "command", + "name": "Table.install", + "locations": [ + 0 + ], + "args": { + "table": "send_frame", + "key": [ + "2<32>" + ], + "action": "send_frame.rewrite_mac", + "args": [ + "8796093022464<48>" + ] + } + }, + { + "type": "command", + "name": "Table.install", + "locations": [ + 0 + ], + "args": { + "table": "send_frame", + "key": [ + "3<32>" + ], + "action": "send_frame.rewrite_mac", + "args": [ + "8796093022464<48>" + ] + } + }, + { + "type": "command", + "name": "Table.install", + "locations": [ + 1 + ], + "args": { + "table": "ecmp_group", + "key": [ + "167772674<32>" + ], + "action": "ecmp_group.set_ecmp_params", + "args": [ + "0<16>", + "1<32>" + ] + } + }, + { + "type": "command", + "name": "Table.install", + "locations": [ + 1 + ], + "args": { + "table": "ecmp_nhop", + "key": [ + "0<16>" + ], + "action": "ecmp_nhop.set_nhop", + "args": [ + "8796093022722<48>", + "167772674<32>", + "1<32>" + ] + } + }, + { + "type": "command", + "name": "Table.install", + "locations": [ + 1 + ], + "args": { + "table": "send_frame", + "key": [ + "1<32>" + ], + "action": "send_frame.rewrite_mac", + "args": [ + "8796093022720<48>" + ] + } + }, + { + "type": "command", + "name": "Table.install", + "locations": [ + 2 + ], + "args": { + "table": "ecmp_group", + "key": [ + "167772931<32>" + ], + "action": "ecmp_group.set_ecmp_params", + "args": [ + "0<16>", + "1<32>" + ] + } + }, + { + "type": "command", + "name": "Table.install", + "locations": [ + 2 + ], + "args": { + "table": "ecmp_nhop", + "key": [ + "0<16>" + ], + "action": "ecmp_nhop.set_nhop", + "args": [ + "8796093022979<48>", + "167772931<32>", + "1<32>" + ] + } + }, + { + "type": "command", + "name": "Table.install", + "locations": [ + 2 + ], + "args": { + "table": "send_frame", + "key": [ + "1<32>" + ], + "action": "send_frame.rewrite_mac", + "args": [ + "8796093022976<48>" + ] + } + }, + { + "type": "packet", + "bytes": "08000000010008000000010108004500002800000000400665cf0a0001010a00000104570050000000000000000050000000963c0000", + "locations": [ + "0:1" + ], + "timestamp": 5000 + }, + { + "type": "packet", + "bytes": "08000000010008000000010108004500002800000000400665cf0a0001010a00000108ae005000000000000000005000000091e50000", + "locations": [ + "0:1" + ], + "timestamp": 5500 + }, + { + "type": "packet", + "bytes": "08000000010008000000010108004500002800000000400665cf0a0001010a0000010d0500500000000000000000500000008d8e0000", + "locations": [ + "0:1" + ], + "timestamp": 6000 + }, + { + "type": "packet", + "bytes": "08000000010008000000010108004500002800000000400665cf0a0001010a000001115c005000000000000000005000000089370000", + "locations": [ + "0:1" + ], + "timestamp": 6500 + }, + { + "type": "packet", + "bytes": "08000000010008000000010108004500002800000000400665cf0a0001010a00000115b3005000000000000000005000000084e00000", + "locations": [ + "0:1" + ], + "timestamp": 7000 + }, + { + "type": "packet", + "bytes": "08000000010008000000010108004500002800000000400665cf0a0001010a0000011a0a005000000000000000005000000080890000", + "locations": [ + "0:1" + ], + "timestamp": 7500 + }, + { + "type": "packet", + "bytes": "08000000010008000000010108004500002800000000400663ce0a0001010a00020203e8005000000000000000005000000094aa0000", + "locations": [ + "0:1" + ], + "timestamp": 8000 + }, + { + "type": "packet", + "bytes": "080000000100080000000101080045000028000000004006020a0a0001010a63636303e8005000000000000000005000000032e60000", + "locations": [ + "0:1" + ], + "timestamp": 8500 + } + ] +} diff --git a/examples/p4_bmv2_examples/mri/README.md b/examples/p4_bmv2_examples/mri/README.md new file mode 100644 index 00000000..586b733b --- /dev/null +++ b/examples/p4_bmv2_examples/mri/README.md @@ -0,0 +1,42 @@ +# `mri` + +Per-hop telemetry: every switch that handles a packet pushes a +`(swid, qdepth)` swtrace onto a stack inside the IPv4 options. The +destination host receives a packet whose option-bearing IPv4 header +contains the full hop chain (most-recent first). + +## Files +- [mri.dpt](mri.dpt) — the Lucid program. +- [gen_spec.py](gen_spec.py) — scapy generator, builds topology + table + installs + initial (count=0) test packets. +- [mri.json](mri.json) — generated artifact. + +## Running +```bash +/opt/anaconda3/bin/python3 gen_spec.py +../../../sources/lucid/dpt mri.dpt --spec mri.json --silent +``` + +## Wire layout + +``` +[ eth | ipv4 (ihl≥6) | opt (4 B) | mri(count) | N × swtrace | payload ] + ↑ each 8 B (swid + qdepth) +``` + +Sender always emits packets with `ihl=6`, `opt_len=4`, `count=0` (no +swtraces yet). Each switch adds 8 bytes per swtrace: `ihl += 2`, +`opt_len += 8`, `total_len += 8`, `count += 1`. The IPv4 header +checksum is recomputed (over the 20-byte ipv4 only, matching the P4 +program's `update_checksum` invocation). + +## Test cases +| # | Route | Expected swtraces in exit packet | Exit | +|---|--------------------------|----------------------------------|------| +| 1 | h1 → h2 direct (s1, s2) | `[s2, s1]` | 1:1 | +| 2 | h1 → h3 direct (s1, s3) | `[s3, s1]` | 2:1 | +| 3 | h1 → h2 detour (s1, s3, s2) — `10.0.99.99` is routed through s3 | `[s2, s3, s1]` | 1:1 | +| 4 | h1 → 10.99.99.99 (no route) | drop at s1 | — | + +Swtraces appear in *push-front order* in the wire packet, so the +most-recent hop is at swtrace[0] and the oldest is at swtrace[N-1]. diff --git a/examples/p4_bmv2_examples/mri/gen_spec.py b/examples/p4_bmv2_examples/mri/gen_spec.py new file mode 100644 index 00000000..207dd836 --- /dev/null +++ b/examples/p4_bmv2_examples/mri/gen_spec.py @@ -0,0 +1,193 @@ +#!/usr/bin/env python3 +"""Generate mri.json for the Lucid MRI example. + +MRI packets are IPv4 with `ihl > 5`, a 4-byte option (option=MRI), an +mri header (count), and `count` 8-byte swtrace entries. Each Lucid switch +pushes a fresh (swid=self, qdepth=0) swtrace as the packet leaves it. + +`gen_spec.py` only needs to emit the *initial* packet with count=0; +intermediate hops grow the stack inside the Lucid program. +""" + +import ipaddress +import json +from pathlib import Path + +from scapy.all import ( + Ether, IP, Packet, ByteField, ShortField, IntField, bind_layers, +) + +IPV4_OPT_MRI = 31 + +# ---- wire-format scapy layers -------------------------------------------- +# +# IPOption_MRI: 4 bytes — (copy:1, class:2, number:5) + length + count(16). +# Wraps the (option header + mri header) into a single 4-byte block. +# We omit a swtrace layer entirely; senders always start with count=0 so +# the initial packet has no swtraces. Intermediate hops fill them in. + +class IPOption_MRI(Packet): + name = "IPOption_MRI" + fields_desc = [ + # IPv4 option header (2 bytes): copy(1)+class(2)+number(5) + length + ByteField("opt_type", 0b00000000 | IPV4_OPT_MRI), # copy=0, class=0, number=31 + ByteField("opt_len", 4), # 2 bytes opt header + 2 bytes mri count + # MRI header (2 bytes): count of trailing swtraces + ShortField("count", 0), + ] + +# Bind option after IP when ihl > 5. scapy doesn't do this automatically; +# we'll just build the packet as Ether/IP/IPOption_MRI/Raw(). + +# ---- topology ------------------------------------------------------------ +# Same triangle as source_routing: 0=s1, 1=s2, 2=s3. Hosts on port 1 of +# each switch (undeclared, packets exit there). + +TOPOLOGY = { + "nodes": { + "0": {"ports": {"2": {"type": "link"}, "3": {"type": "link"}}}, + "1": {"ports": {"2": {"type": "link"}, "3": {"type": "link"}}}, + "2": {"ports": {"2": {"type": "link"}, "3": {"type": "link"}}}, + }, + "links": [ + {"0:2": "1:2"}, # s1:p2 <-> s2:p2 + {"0:3": "2:2"}, # s1:p3 <-> s3:p2 + {"1:3": "2:3"}, # s2:p3 <-> s3:p3 + ], +} + +# ---- helpers ------------------------------------------------------------- + +def ipv4_int(s): + return int(ipaddress.IPv4Address(s)) + +def mac_int(s): + return int(s.replace(":", ""), 16) + +def install_lpm(node, dst_ip, dmac, port): + return { + "type": "command", "name": "Table.install", "locations": [node], + "args": { + "table": "ipv4_lpm", + "key": [f"{ipv4_int(dst_ip)}<32>"], + "action": "ipv4_lpm.ipv4_forward", + "args": [f"{mac_int(dmac)}<48>", f"{port}<32>"], + }, + } + +H1_MAC = "08:00:00:00:01:01" +H2_MAC = "08:00:00:00:02:02" +H3_MAC = "08:00:00:00:03:03" +S1_MAC = "08:00:00:00:01:00" +S2_MAC = "08:00:00:00:02:00" +S3_MAC = "08:00:00:00:03:00" + +# ---- table installs ------------------------------------------------------ +# +# Each switch has two routing modes: +# - "shortest" prefix (10.0.X.X) — direct route to the destination host. +# - "detour" prefix (10.0.99.X) — route via s3 first to force a longer +# path; lets us exercise the 3-hop mri_2 case. +# +# Concretely, packets to 10.0.99.99 traverse s1 -> s3 -> s2 -> h2. + +events = [] + +# s1 (node 0): standard direct routes +events += [ + install_lpm(0, "10.0.1.1", H1_MAC, port=1), + install_lpm(0, "10.0.2.2", S2_MAC, port=2), + install_lpm(0, "10.0.3.3", S3_MAC, port=3), + # detour route: send via s3 even though dst is on s2's side + install_lpm(0, "10.0.99.99", S3_MAC, port=3), +] + +# s2 (node 1) +events += [ + install_lpm(1, "10.0.1.1", S1_MAC, port=2), + install_lpm(1, "10.0.2.2", H2_MAC, port=1), + install_lpm(1, "10.0.3.3", S3_MAC, port=3), + install_lpm(1, "10.0.99.99", H2_MAC, port=1), # detour terminates here +] + +# s3 (node 2) +events += [ + install_lpm(2, "10.0.1.1", S1_MAC, port=2), + install_lpm(2, "10.0.2.2", S2_MAC, port=3), + install_lpm(2, "10.0.3.3", H3_MAC, port=1), + install_lpm(2, "10.0.99.99", S2_MAC, port=3), # forward detour traffic to s2 +] + +# ---- helpers: build the initial MRI packet ------------------------------ + +def mri_packet(dst_ip="10.0.2.2", src_ip="10.0.1.1", + src=H1_MAC, dst=S1_MAC, ttl=64): + """Build an IPv4 packet with the MRI option header, count=0. + + Total IP header length = 24 bytes (20 + 4 option-and-mri header). + """ + ip = IP(src=src_ip, dst=dst_ip, ttl=ttl, id=0, flags=0, frag=0, + tos=0, len=24, ihl=6) + opt = IPOption_MRI(count=0) + pkt = (Ether(dst=dst, src=src, type=0x0800) / ip / opt) + # scapy doesn't recompute checksum once we hand it a custom option + # layer, so re-blat the raw bytes through IP() to force re-checksum. + raw = bytes(pkt) + # Recompute IPv4 checksum manually over the 24-byte header + eth_bytes = raw[:14] + ip_bytes = bytearray(raw[14:14+24]) + ip_bytes[10:12] = b"\x00\x00" # zero csum + s = 0 + for i in range(0, 24, 2): + s += (ip_bytes[i] << 8) | ip_bytes[i + 1] + while s >> 16: + s = (s & 0xFFFF) + (s >> 16) + csum = (~s) & 0xFFFF + ip_bytes[10:12] = csum.to_bytes(2, "big") + return (eth_bytes + bytes(ip_bytes) + raw[14+24:]).hex() + +# ---- test packets -------------------------------------------------------- + +TESTS = [ + # 2-hop route: h1 -> s1 -> s2 -> h2. Should accumulate 2 swtraces + # (swid=0 from s1, swid=1 from s2). Exit at 1:1, count=2. + ("h1->h2 (2 hops, expect swtraces s1, s2)", + mri_packet(dst_ip="10.0.2.2")), + + # 2-hop route: h1 -> s1 -> s3 -> h3. Swtraces s1, s3. + ("h1->h3 (2 hops, expect swtraces s1, s3)", + mri_packet(dst_ip="10.0.3.3")), + + # 3-hop detour: h1 -> s1 -> s3 -> s2 -> h2 (10.0.99.99 is steered + # through s3 instead of direct s2). Swtraces s1, s3, s2. + ("h1->h2 detour via s3 (3 hops, expect swtraces s1, s3, s2)", + mri_packet(dst_ip="10.0.99.99")), + + # Unroutable: no entry for 10.99.99.99. Drops at s1. + ("h1->10.99.99.99 (unroutable, drop)", + mri_packet(dst_ip="10.99.99.99")), +] + +ts = 5000 +for label, bytes_hex in TESTS: + events.append({ + "type": "packet", + "bytes": bytes_hex, + "locations": ["0:1"], + "timestamp": ts, + }) + ts += 1000 + +spec = { + "max time": 20000, + "default_input_gap": 100, + "topology": TOPOLOGY, + "events": events, +} + +out = Path(__file__).with_name("mri.json") +out.write_text(json.dumps(spec, indent=2) + "\n") +print(f"wrote {out} with {len(events)} events " + f"({len(events) - len(TESTS)} installs + {len(TESTS)} packets)") +for (label, _), ev in zip(TESTS, events[-len(TESTS):]): + print(f" t={ev['timestamp']:>5} {label}") diff --git a/examples/p4_bmv2_examples/mri/mri.dpt b/examples/p4_bmv2_examples/mri/mri.dpt new file mode 100644 index 00000000..63fbd65b --- /dev/null +++ b/examples/p4_bmv2_examples/mri/mri.dpt @@ -0,0 +1,349 @@ +// Lucid port of the P4 "mri" tutorial: per-hop telemetry that pushes a +// (swid, qdepth) record onto a stack inside the IPv4 options as the +// packet traverses the network. The receiver sees the full hop list. +// +// Structure mirrors `source_routing` because the same three Lucid +// constraints apply (see source_routing/README.md for the deep-dive): +// +// 1. Parsers are non-recursive → manually unroll the count-keyed +// swtrace-stack parse as a `match` over count. +// 2. Auto-deparser emits every event field → one event per stack +// depth (`mri_0`..`mri_3`), and the handler pushes by re-emitting +// as the next-larger variant. +// 3. Parser slot analysis requires distinct variables per arg +// position → distinct names for every swtrace's `swid`/`qdepth`. +// +// Substantive differences from the upstream P4: +// * `qdepth` (egress queue depth) isn't modeled by the Lucid +// interpreter; we push 0 in its place. Documented in the README. +// * `swid` is sourced from the `self` builtin rather than from a +// control-plane `Table.install` on a separate egress table. The +// P4 program has one entry per switch with `swid: N` baked in, +// which is what `self` already provides — so we skip the table. +// * Only MRI-flagged IPv4 packets are handled. Plain IPv4 (ihl=5, +// no option) is dropped at the parser. + +const int<16> ETY_IPV4 = 0x0800; +const int<5> IPV4_OPT_MRI = 31; + +type eth_hdr_t = { + int<48> dmac; + int<48> smac; + int<16> ety; +} + +type ipv4_t = { + int<4> version; + int<4> ihl; + int<8> diffserv; + int<16> total_len; + int<16> id; + int<3> flags; + int<13> frag_offset; + int<8> ttl; + int<8> protocol; + int<16> hdr_csum; + int<32> src; + int<32> dst; +} + +// 2-byte IPv4 option header. P4's `ipv4_option_t`. +type opt_t = { + int<1> opt_copy; + int<2> opt_class; + int<5> opt_num; + int<8> opt_len; +} + +// 2-byte MRI header (just a count of trailing swtraces). +type mri_hdr_t = { + int<16> mri_count; +} + +// -------- forwarding table (same shape as basic) ------------------------ + +type fwd_t = { + int<48> fwd_dmac; + int<32> fwd_port; + bool fwd_hit; +} + +action fwd_t ipv4_forward(int<48> dmac, int<32> port)() { + return {fwd_dmac = dmac; fwd_port = port; fwd_hit = true}; +} + +action fwd_t ipv4_drop(int<48> _dmac, int<32> _port)() { + return {fwd_dmac = 0; fwd_port = 0; fwd_hit = false}; +} + +global Table.t<, (int<48>, int<32>), (), fwd_t>> ipv4_lpm = + Table.create(1024, [ipv4_forward; ipv4_drop], ipv4_drop, (0, 0)); + +// -------- events -------------------------------------------------------- +// +// One event per stack depth 0..MAX_HOPS=3. Each adds two scalar fields +// per swtrace (swid + qdepth). Beyond mri_3 the stack saturates: mri_3's +// handler still forwards but does not push another entry. + +packet event mri_0(eth_hdr_t eth, ipv4_t ip, opt_t opt, mri_hdr_t m, + Payload.t pl); + +packet event mri_1(eth_hdr_t eth, ipv4_t ip, opt_t opt, mri_hdr_t m, + int<32> swid0, int<32> qdepth0, + Payload.t pl); + +packet event mri_2(eth_hdr_t eth, ipv4_t ip, opt_t opt, mri_hdr_t m, + int<32> swid0, int<32> qdepth0, + int<32> swid1, int<32> qdepth1, + Payload.t pl); + +packet event mri_3(eth_hdr_t eth, ipv4_t ip, opt_t opt, mri_hdr_t m, + int<32> swid0, int<32> qdepth0, + int<32> swid1, int<32> qdepth1, + int<32> swid2, int<32> qdepth2, + Payload.t pl); + +// -------- helpers shared across handlers -------------------------------- +// +// Most of each handler is identical (forward + rewrite eth + bump ihl / +// total_len / opt_len / count + recompute IPv4 csum). The differences +// are only the swtrace fields ferried through, so we keep them inline +// rather than abstracted into a function — Lucid functions don't return +// records by reference, and the explicit form here exactly matches the +// upstream P4's egress logic. + +// -------- handlers ------------------------------------------------------ + +handle mri_0(eth_hdr_t eth, ipv4_t ip, opt_t opt, mri_hdr_t m, Payload.t pl) { + fwd_t d = Table.lookup(ipv4_lpm, ip#dst, ()); + if (d#fwd_hit) { + eth_hdr_t new_eth = { + dmac = d#fwd_dmac; + smac = eth#dmac; + ety = eth#ety + }; + // Push the first swtrace: count 0 → 1, ihl +2, opt_len +8, total_len +8. + ipv4_t new_ip = { + version = ip#version; + ihl = ip#ihl + 2; + diffserv = ip#diffserv; + total_len = ip#total_len + 8; + id = ip#id; + flags = ip#flags; + frag_offset = ip#frag_offset; + ttl = ip#ttl - 1; + protocol = ip#protocol; + hdr_csum = 0; + src = ip#src; + dst = ip#dst + }; + opt_t new_opt = { + opt_copy = opt#opt_copy; + opt_class = opt#opt_class; + opt_num = opt#opt_num; + opt_len = opt#opt_len + 8 + }; + mri_hdr_t new_m = {mri_count = m#mri_count + 1}; + int<32> new_swid = self; + int<32> new_qdepth = 0; + printf("sw %d port %d -> %d : mri push (now n=1) dst=%d ttl=%d", + self, ingress_port, d#fwd_port, ip#dst, new_ip#ttl); + generate_port(d#fwd_port, + mri_1(new_eth, + {new_ip with hdr_csum = hash<16>(checksum, new_ip)}, + new_opt, new_m, + new_swid, new_qdepth, + pl)); + } else { + printf("sw %d port %d : drop mri (no route) dst=%d", + self, ingress_port, ip#dst); + } +} + +handle mri_1(eth_hdr_t eth, ipv4_t ip, opt_t opt, mri_hdr_t m, + int<32> swid0, int<32> qdepth0, Payload.t pl) { + fwd_t d = Table.lookup(ipv4_lpm, ip#dst, ()); + if (d#fwd_hit) { + eth_hdr_t new_eth = { + dmac = d#fwd_dmac; + smac = eth#dmac; + ety = eth#ety + }; + ipv4_t new_ip = { + version = ip#version; + ihl = ip#ihl + 2; + diffserv = ip#diffserv; + total_len = ip#total_len + 8; + id = ip#id; + flags = ip#flags; + frag_offset = ip#frag_offset; + ttl = ip#ttl - 1; + protocol = ip#protocol; + hdr_csum = 0; + src = ip#src; + dst = ip#dst + }; + opt_t new_opt = { + opt_copy = opt#opt_copy; + opt_class = opt#opt_class; + opt_num = opt#opt_num; + opt_len = opt#opt_len + 8 + }; + mri_hdr_t new_m = {mri_count = m#mri_count + 1}; + int<32> new_swid = self; + int<32> new_qdepth = 0; + printf("sw %d port %d -> %d : mri push (now n=2) dst=%d ttl=%d", + self, ingress_port, d#fwd_port, ip#dst, new_ip#ttl); + generate_port(d#fwd_port, + mri_2(new_eth, + {new_ip with hdr_csum = hash<16>(checksum, new_ip)}, + new_opt, new_m, + new_swid, new_qdepth, + swid0, qdepth0, + pl)); + } else { + printf("sw %d port %d : drop mri (no route) dst=%d", + self, ingress_port, ip#dst); + } +} + +handle mri_2(eth_hdr_t eth, ipv4_t ip, opt_t opt, mri_hdr_t m, + int<32> swid0, int<32> qdepth0, + int<32> swid1, int<32> qdepth1, Payload.t pl) { + fwd_t d = Table.lookup(ipv4_lpm, ip#dst, ()); + if (d#fwd_hit) { + eth_hdr_t new_eth = { + dmac = d#fwd_dmac; + smac = eth#dmac; + ety = eth#ety + }; + ipv4_t new_ip = { + version = ip#version; + ihl = ip#ihl + 2; + diffserv = ip#diffserv; + total_len = ip#total_len + 8; + id = ip#id; + flags = ip#flags; + frag_offset = ip#frag_offset; + ttl = ip#ttl - 1; + protocol = ip#protocol; + hdr_csum = 0; + src = ip#src; + dst = ip#dst + }; + opt_t new_opt = { + opt_copy = opt#opt_copy; + opt_class = opt#opt_class; + opt_num = opt#opt_num; + opt_len = opt#opt_len + 8 + }; + mri_hdr_t new_m = {mri_count = m#mri_count + 1}; + int<32> new_swid = self; + int<32> new_qdepth = 0; + printf("sw %d port %d -> %d : mri push (now n=3) dst=%d ttl=%d", + self, ingress_port, d#fwd_port, ip#dst, new_ip#ttl); + generate_port(d#fwd_port, + mri_3(new_eth, + {new_ip with hdr_csum = hash<16>(checksum, new_ip)}, + new_opt, new_m, + new_swid, new_qdepth, + swid0, qdepth0, + swid1, qdepth1, + pl)); + } else { + printf("sw %d port %d : drop mri (no route) dst=%d", + self, ingress_port, ip#dst); + } +} + +// MAX_HOPS reached. Forward but do *not* push another swtrace — the +// stack is saturated. TTL still decrements, ihl/total_len/opt_len/count +// don't change, csum still gets recomputed because TTL did. +handle mri_3(eth_hdr_t eth, ipv4_t ip, opt_t opt, mri_hdr_t m, + int<32> swid0, int<32> qdepth0, + int<32> swid1, int<32> qdepth1, + int<32> swid2, int<32> qdepth2, Payload.t pl) { + fwd_t d = Table.lookup(ipv4_lpm, ip#dst, ()); + if (d#fwd_hit) { + eth_hdr_t new_eth = { + dmac = d#fwd_dmac; + smac = eth#dmac; + ety = eth#ety + }; + ipv4_t new_ip = { + version = ip#version; + ihl = ip#ihl; + diffserv = ip#diffserv; + total_len = ip#total_len; + id = ip#id; + flags = ip#flags; + frag_offset = ip#frag_offset; + ttl = ip#ttl - 1; + protocol = ip#protocol; + hdr_csum = 0; + src = ip#src; + dst = ip#dst + }; + printf("sw %d port %d -> %d : mri stack saturated, forward only dst=%d ttl=%d", + self, ingress_port, d#fwd_port, ip#dst, new_ip#ttl); + generate_port(d#fwd_port, + mri_3(new_eth, + {new_ip with hdr_csum = hash<16>(checksum, new_ip)}, + opt, m, + swid0, qdepth0, + swid1, qdepth1, + swid2, qdepth2, + pl)); + } else { + printf("sw %d port %d : drop mri (no route) dst=%d", + self, ingress_port, ip#dst); + } +} + +// -------- parser -------------------------------------------------------- + +parser main(bitstring pkt) { + eth_hdr_t eth = read(pkt); + match eth#ety with + | LUCID_ETHERTY -> { do_lucid_parsing(pkt); } + | 0x0800 -> { + ipv4_t ip = read(pkt); + opt_t opt = read(pkt); + mri_hdr_t m = read(pkt); + // Dispatch by count. Each branch reads exactly `count` swtraces + // off the wire and generates the matching event variant. + match m#mri_count with + | 0 -> { + Payload.t pl = Payload.parse(pkt); + generate(mri_0(eth, ip, opt, m, pl)); + } + | 1 -> { + int<32> swid0 = read(pkt); + int<32> qdepth0 = read(pkt); + Payload.t pl = Payload.parse(pkt); + generate(mri_1(eth, ip, opt, m, swid0, qdepth0, pl)); + } + | 2 -> { + int<32> swid0 = read(pkt); + int<32> qdepth0 = read(pkt); + int<32> swid1 = read(pkt); + int<32> qdepth1 = read(pkt); + Payload.t pl = Payload.parse(pkt); + generate(mri_2(eth, ip, opt, m, swid0, qdepth0, swid1, qdepth1, pl)); + } + | 3 -> { + int<32> swid0 = read(pkt); + int<32> qdepth0 = read(pkt); + int<32> swid1 = read(pkt); + int<32> qdepth1 = read(pkt); + int<32> swid2 = read(pkt); + int<32> qdepth2 = read(pkt); + Payload.t pl = Payload.parse(pkt); + generate(mri_3(eth, ip, opt, m, + swid0, qdepth0, swid1, qdepth1, swid2, qdepth2, + pl)); + } + | _ -> { drop; } + } + | _ -> { drop; } +} diff --git a/examples/p4_bmv2_examples/mri/mri.json b/examples/p4_bmv2_examples/mri/mri.json new file mode 100644 index 00000000..20749cbf --- /dev/null +++ b/examples/p4_bmv2_examples/mri/mri.json @@ -0,0 +1,299 @@ +{ + "max time": 20000, + "default_input_gap": 100, + "topology": { + "nodes": { + "0": { + "ports": { + "2": { + "type": "link" + }, + "3": { + "type": "link" + } + } + }, + "1": { + "ports": { + "2": { + "type": "link" + }, + "3": { + "type": "link" + } + } + }, + "2": { + "ports": { + "2": { + "type": "link" + }, + "3": { + "type": "link" + } + } + } + }, + "links": [ + { + "0:2": "1:2" + }, + { + "0:3": "2:2" + }, + { + "1:3": "2:3" + } + ] + }, + "events": [ + { + "type": "command", + "name": "Table.install", + "locations": [ + 0 + ], + "args": { + "table": "ipv4_lpm", + "key": [ + "167772417<32>" + ], + "action": "ipv4_lpm.ipv4_forward", + "args": [ + "8796093022465<48>", + "1<32>" + ] + } + }, + { + "type": "command", + "name": "Table.install", + "locations": [ + 0 + ], + "args": { + "table": "ipv4_lpm", + "key": [ + "167772674<32>" + ], + "action": "ipv4_lpm.ipv4_forward", + "args": [ + "8796093022720<48>", + "2<32>" + ] + } + }, + { + "type": "command", + "name": "Table.install", + "locations": [ + 0 + ], + "args": { + "table": "ipv4_lpm", + "key": [ + "167772931<32>" + ], + "action": "ipv4_lpm.ipv4_forward", + "args": [ + "8796093022976<48>", + "3<32>" + ] + } + }, + { + "type": "command", + "name": "Table.install", + "locations": [ + 0 + ], + "args": { + "table": "ipv4_lpm", + "key": [ + "167797603<32>" + ], + "action": "ipv4_lpm.ipv4_forward", + "args": [ + "8796093022976<48>", + "3<32>" + ] + } + }, + { + "type": "command", + "name": "Table.install", + "locations": [ + 1 + ], + "args": { + "table": "ipv4_lpm", + "key": [ + "167772417<32>" + ], + "action": "ipv4_lpm.ipv4_forward", + "args": [ + "8796093022464<48>", + "2<32>" + ] + } + }, + { + "type": "command", + "name": "Table.install", + "locations": [ + 1 + ], + "args": { + "table": "ipv4_lpm", + "key": [ + "167772674<32>" + ], + "action": "ipv4_lpm.ipv4_forward", + "args": [ + "8796093022722<48>", + "1<32>" + ] + } + }, + { + "type": "command", + "name": "Table.install", + "locations": [ + 1 + ], + "args": { + "table": "ipv4_lpm", + "key": [ + "167772931<32>" + ], + "action": "ipv4_lpm.ipv4_forward", + "args": [ + "8796093022976<48>", + "3<32>" + ] + } + }, + { + "type": "command", + "name": "Table.install", + "locations": [ + 1 + ], + "args": { + "table": "ipv4_lpm", + "key": [ + "167797603<32>" + ], + "action": "ipv4_lpm.ipv4_forward", + "args": [ + "8796093022722<48>", + "1<32>" + ] + } + }, + { + "type": "command", + "name": "Table.install", + "locations": [ + 2 + ], + "args": { + "table": "ipv4_lpm", + "key": [ + "167772417<32>" + ], + "action": "ipv4_lpm.ipv4_forward", + "args": [ + "8796093022464<48>", + "2<32>" + ] + } + }, + { + "type": "command", + "name": "Table.install", + "locations": [ + 2 + ], + "args": { + "table": "ipv4_lpm", + "key": [ + "167772674<32>" + ], + "action": "ipv4_lpm.ipv4_forward", + "args": [ + "8796093022720<48>", + "3<32>" + ] + } + }, + { + "type": "command", + "name": "Table.install", + "locations": [ + 2 + ], + "args": { + "table": "ipv4_lpm", + "key": [ + "167772931<32>" + ], + "action": "ipv4_lpm.ipv4_forward", + "args": [ + "8796093022979<48>", + "1<32>" + ] + } + }, + { + "type": "command", + "name": "Table.install", + "locations": [ + 2 + ], + "args": { + "table": "ipv4_lpm", + "key": [ + "167797603<32>" + ], + "action": "ipv4_lpm.ipv4_forward", + "args": [ + "8796093022720<48>", + "3<32>" + ] + } + }, + { + "type": "packet", + "bytes": "08000000010008000000010108004600001800000000400043e00a0001010a0002021f040000", + "locations": [ + "0:1" + ], + "timestamp": 5000 + }, + { + "type": "packet", + "bytes": "08000000010008000000010108004600001800000000400042df0a0001010a0003031f040000", + "locations": [ + "0:1" + ], + "timestamp": 6000 + }, + { + "type": "packet", + "bytes": "080000000100080000000101080046000018000000004000e27e0a0001010a0063631f040000", + "locations": [ + "0:1" + ], + "timestamp": 7000 + }, + { + "type": "packet", + "bytes": "080000000100080000000101080046000018000000004000e21b0a0001010a6363631f040000", + "locations": [ + "0:1" + ], + "timestamp": 8000 + } + ] +} diff --git a/examples/p4_bmv2_examples/multicast/README.md b/examples/p4_bmv2_examples/multicast/README.md new file mode 100644 index 00000000..f94ae66f --- /dev/null +++ b/examples/p4_bmv2_examples/multicast/README.md @@ -0,0 +1,54 @@ +# `multicast` — Lucid port of the P4 multicast / L2-flooding tutorial + +An L2 switch with four host ports. + +- **Known dst MAC** → unicast to its specific port. +- **Unknown dst MAC** → flood to every port except the ingress port. + +## Files +- [multicast.dpt](multicast.dpt) — the Lucid program. +- [gen_spec.py](gen_spec.py) — scapy generator. +- [multicast.json](multicast.json) — generated artifact. + +## Running +```bash +/opt/anaconda3/bin/python3 gen_spec.py +../../../sources/lucid/dpt multicast.dpt --spec multicast.json --silent +``` + +## Test cases (in `gen_spec.py`) + +All packets originate at h1 (port 1). The `mac_lookup` table has +entries for h1–h4 installed before the burst. + +| Input | Expected `Exits` | +|----------------------------------|---------------------------------| +| h1 → h2 (known) | port 2 only | +| h1 → h3 (known) | port 3 only | +| h1 → `00:00:00:00:00:99` (unknown) | ports 2, 3, 4 | +| h1 → `ff:ff:ff:ff:ff:ff` (bcast) | ports 2, 3, 4 | + +The flood cases also produce an abstract `eth_pkt(...) at port -2` +entry. That's the interpreter's internal record of the flood action +itself — `-2` decodes as `-(ingress + 1)`, i.e., "flood excluding +port 1". It's *not* a duplicate copy of the packet, just metadata. + +## How `flood` works + +`flood ` is a built-in expression that constructs a multicast +group of every declared port on the switch *except* ``. +`generate_ports(flood ingress_port, ev)` then sends `ev` to each port +in that group. + +For the example to behave as expected, the topology block has to +declare all four host ports — `flood` enumerates the switch's declared +ports, not "every conceivable port number." We use four `link`-type +ports with no `links` entries; the interpreter picks them up in +the flood enumeration. Packets emitted to them land in `Exits`. + +## Notable Lucid details +- **Default action returns the "flood" sentinel.** Rather than calling + flood from inside the action (actions can't generate events), the + default action returns a `fwd_t` with `fwd_flood = true`, and the + handler then decides between `generate_port` and `generate_ports`. + Same pattern we used for `fwd_hit` in earlier examples. diff --git a/examples/p4_bmv2_examples/multicast/gen_spec.py b/examples/p4_bmv2_examples/multicast/gen_spec.py new file mode 100644 index 00000000..a065cb4d --- /dev/null +++ b/examples/p4_bmv2_examples/multicast/gen_spec.py @@ -0,0 +1,98 @@ +#!/usr/bin/env python3 +"""Generate multicast.json for the Lucid multicast example. + +Single switch, four host ports. All four ports are declared in the +topology block (as `link` type with no actual link) so that the +`flood ingress_port` builtin can enumerate them on a cache miss. +Unlinked declared ports produce exit events on emission — the test +inspects Exits to confirm fan-out. +""" + +import json +from pathlib import Path + +from scapy.all import Ether + +H1, H2, H3, H4 = ( + "08:00:00:00:01:11", + "08:00:00:00:02:22", + "08:00:00:00:03:33", + "08:00:00:00:04:44", +) +HOSTS = [("h1", H1, 1), ("h2", H2, 2), ("h3", H3, 3), ("h4", H4, 4)] +BCAST = "ff:ff:ff:ff:ff:ff" +UNKNOWN = "00:00:00:00:00:99" # not in the install list + +def mac_int(s): return int(s.replace(":", ""), 16) + +def install_mac(mac, port): + return { + "type": "command", "name": "Table.install", + "args": { + "table": "mac_lookup", + "key": [f"{mac_int(mac)}<48>"], + "action": "mac_lookup.mac_forward", + "args": [f"{port}<32>"], + }, + } + +def eth_packet(src_mac, dst_mac, payload_hex="cafebabe"): + pkt = Ether(dst=dst_mac, src=src_mac, type=0x9999) # arbitrary non-IP + return (bytes(pkt) + bytes.fromhex(payload_hex)).hex() + +# Declare all 4 host ports as link-type (with no actual links) so flood +# enumerates them. The simulator emits exit events on unlinked declared +# ports, which is exactly what we want for the test. +TOPOLOGY = { + "nodes": { + "0": { + "ports": { + "1": {"type": "link"}, + "2": {"type": "link"}, + "3": {"type": "link"}, + "4": {"type": "link"}, + } + } + }, + "links": [], +} + +events = [] + +# Install entries for h1..h4. +for _name, mac, port in HOSTS: + events.append(install_mac(mac, port)) + +# Test packets, all originating at h1 (port 1): +TESTS = [ + # Known dst → unicast. + ("h1 → h2 (known unicast, expect Exit at port 2)", H1, H2), + ("h1 → h3 (known unicast, expect Exit at port 3)", H1, H3), + # Unknown dst → flood except ingress (ports 2, 3, 4). + ("h1 → 00:..:99 (unknown, expect Exits at 2, 3, 4)", H1, UNKNOWN), + # Broadcast → also unknown → flood. + ("h1 → ff:ff:ff:ff:ff:ff (bcast, expect Exits at 2, 3, 4)", H1, BCAST), +] + +ts = 5000 +for label, src, dst in TESTS: + events.append({ + "type": "packet", + "bytes": eth_packet(src, dst), + "locations": ["0:1"], + "timestamp": ts, + }) + ts += 1000 + +spec = { + "max time": 15000, + "default_input_gap": 100, + "topology": TOPOLOGY, + "events": events, +} + +out = Path(__file__).with_name("multicast.json") +out.write_text(json.dumps(spec, indent=2) + "\n") +print(f"wrote {out} with {len(events)} events ({len(HOSTS)} installs + {len(TESTS)} packets)") +for label, *_ in TESTS: + print(f" - {label}") diff --git a/examples/p4_bmv2_examples/multicast/multicast.dpt b/examples/p4_bmv2_examples/multicast/multicast.dpt new file mode 100644 index 00000000..b8be2ce9 --- /dev/null +++ b/examples/p4_bmv2_examples/multicast/multicast.dpt @@ -0,0 +1,73 @@ +// Lucid port of the P4 "multicast" tutorial. +// +// Classic L2 learning switch (almost — the *learn* part is delegated to +// the control plane via `Table.install`). One switch, four host ports. +// +// * Known dst MAC → forward to its specific port (`mac_forward`). +// * Unknown dst MAC → flood to all ports except the ingress port. +// +// The upstream P4 implements the "flood except ingress" rule by +// (a) setting a multicast group at ingress, (b) replicating the packet +// to every member of the group in the bmv2 packet replication engine, +// and (c) explicitly dropping the copy that would head back out the +// ingress port at egress. Lucid bundles all of that into a single +// builtin — `flood ` constructs a multicast group of every +// declared port *except* ``, and `generate_ports` emits the +// event to all of them. +// +// One caveat: `flood` only enumerates ports that the topology block +// has declared. That's why the spec (gen_spec.py) declares all four +// host ports explicitly as `link` type, even though none is linked to +// another node — the simulator treats unlinked declared ports as +// exits, which gives us the 4-host fan-out we want. + +type eth_hdr_t = { + int<48> dmac; + int<48> smac; + int<16> ety; +} + +// Result of a mac_lookup. `fwd_flood = true` means "no specific port; +// fan out via `flood`". This corresponds to the upstream's +// `multicast()` action that sets `mcast_grp = 1`. +type fwd_t = { + int<32> fwd_port; + bool fwd_flood; +} + +action fwd_t mac_forward(int<32> port)() { + return {fwd_port = port; fwd_flood = false}; +} + +// Default action: unknown MAC → flood. install-time arg is ignored. +action fwd_t mcast_action(int<32> _unused)() { + return {fwd_port = 0; fwd_flood = true}; +} + +global Table.t<, int<32>, (), fwd_t>> mac_lookup = + Table.create(1024, [mac_forward; mcast_action], mcast_action, 0); + +packet event eth_pkt(eth_hdr_t eth, Payload.t pl); + +handle eth_pkt(eth_hdr_t eth, Payload.t pl) { + fwd_t d = Table.lookup(mac_lookup, eth#dmac, ()); + if (d#fwd_flood) { + printf("sw %d port %d : flood unknown dst=%d", + self, ingress_port, eth#dmac); + // `flood ingress_port` = every declared port on this switch except + // ingress_port. The "except ingress" piece is the upstream + // egress-side drop, baked into the builtin. + generate_ports(flood ingress_port, eth_pkt(eth, pl)); + } else { + printf("sw %d port %d -> %d : unicast dst=%d", + self, ingress_port, d#fwd_port, eth#dmac); + generate_port(d#fwd_port, eth_pkt(eth, pl)); + } +} + +parser main(bitstring pkt) { + eth_hdr_t eth = read(pkt); + match eth#ety with + | LUCID_ETHERTY -> { do_lucid_parsing(pkt); } + | _ -> { generate(eth_pkt(eth, Payload.parse(pkt))); } +} diff --git a/examples/p4_bmv2_examples/multicast/multicast.json b/examples/p4_bmv2_examples/multicast/multicast.json new file mode 100644 index 00000000..f90fa85a --- /dev/null +++ b/examples/p4_bmv2_examples/multicast/multicast.json @@ -0,0 +1,115 @@ +{ + "max time": 15000, + "default_input_gap": 100, + "topology": { + "nodes": { + "0": { + "ports": { + "1": { + "type": "link" + }, + "2": { + "type": "link" + }, + "3": { + "type": "link" + }, + "4": { + "type": "link" + } + } + } + }, + "links": [] + }, + "events": [ + { + "type": "command", + "name": "Table.install", + "args": { + "table": "mac_lookup", + "key": [ + "8796093022481<48>" + ], + "action": "mac_lookup.mac_forward", + "args": [ + "1<32>" + ] + } + }, + { + "type": "command", + "name": "Table.install", + "args": { + "table": "mac_lookup", + "key": [ + "8796093022754<48>" + ], + "action": "mac_lookup.mac_forward", + "args": [ + "2<32>" + ] + } + }, + { + "type": "command", + "name": "Table.install", + "args": { + "table": "mac_lookup", + "key": [ + "8796093023027<48>" + ], + "action": "mac_lookup.mac_forward", + "args": [ + "3<32>" + ] + } + }, + { + "type": "command", + "name": "Table.install", + "args": { + "table": "mac_lookup", + "key": [ + "8796093023300<48>" + ], + "action": "mac_lookup.mac_forward", + "args": [ + "4<32>" + ] + } + }, + { + "type": "packet", + "bytes": "0800000002220800000001119999cafebabe", + "locations": [ + "0:1" + ], + "timestamp": 5000 + }, + { + "type": "packet", + "bytes": "0800000003330800000001119999cafebabe", + "locations": [ + "0:1" + ], + "timestamp": 6000 + }, + { + "type": "packet", + "bytes": "0000000000990800000001119999cafebabe", + "locations": [ + "0:1" + ], + "timestamp": 7000 + }, + { + "type": "packet", + "bytes": "ffffffffffff0800000001119999cafebabe", + "locations": [ + "0:1" + ], + "timestamp": 8000 + } + ] +} diff --git a/examples/p4_bmv2_examples/p4runtime/README.md b/examples/p4_bmv2_examples/p4runtime/README.md new file mode 100644 index 00000000..0e26017b --- /dev/null +++ b/examples/p4_bmv2_examples/p4runtime/README.md @@ -0,0 +1,73 @@ +# `p4runtime` + +This port uses Lucid's **interpreter interactive mode** to support a dynamic controller in Python. + +- `dpt --interactive` reads JSON events on stdin and writes exit + events as JSON on stdout (one record per line). +- `controller.py` launches the interpreter as a subprocess, feeds it + packets, reads `packet_in` records, and writes back + `Table.install` commands in response. + +The data plane is a flow cache: misses generate `packet_in`; hits +forward. Same shape as [`flowcache`](../flowcache/), but instead of +the controller being a static JSON spec, it's a live Python process. + +## Files +- [p4runtime.dpt](p4runtime.dpt) — the Lucid program. +- [p4runtime.json](p4runtime.json) — a near-empty spec + (`"events": []`). Everything happens via stdin. +- [controller.py](controller.py) — the dynamic controller. + +## Running +```bash +/opt/anaconda3/bin/python3 controller.py +``` + +That single command runs the whole demo — it spawns dpt, sends a few +test packets, reacts to packet_in's by installing rules, and prints +the interleaved transcript on stderr. + +Sample transcript (abridged): +``` +>>> h1->h2 #1 (expect MISS + controller install) + dpt: { "printf": "sw 0 : MISS dst=167772674 src=167772417 ingress=1 -> PacketIn(controller)", ... } + dpt: {"name":"packet_in","args":[167772417,167772674,1],"locations":["0:99"],...} + controller: learned 10.0.2.2 -> port 2 (dmac 08:00:00:00:02:02) + controller -> dpt: {"type": "command", "name": "Table.install", ...} + +>>> h1->h2 #2 (expect HIT) + dpt: { "printf": "sw 0 : HIT dst=167772674 src=167772417 -> port 2 ttl=63", ... } + dpt: {"type":"packet","bytes":"080000000202080000000100...","locations":["0:2"], ...} +``` + +## How interactive mode works + +> - **Input**: every event is a JSON dict on its own line. Reads from +> stdin until EOF. +> - **Output**: each exit event is a single-line JSON record on +> stdout. Printf output goes to stdout (as `{"printf": "...", "switch": N}`). +> - **Lifecycle**: starts polling stdin after the spec's `max_time` +> has elapsed; events arriving on stdin execute at +> `max(current_ts, event.timestamp)`. + +The `dpt --interactive` flag turns the simulator into a long-running +server that can be driven from any process that speaks line-delimited +JSON. + +## Notable details + +- **The "controller" is just a Python process** that does JSON in, + JSON out. The controller's policy logic + (`react_to_packet_in` in `controller.py`) is plain Python that + decides what rule to install based on the packet_in's fields. +- **Bidirectional channel from one stdin/stdout pair.** Each event / + command is one line of JSON. The same channel carries packet + events, `Table.install` commands, and the `packet_in` notifications + in the other direction. Adding a new control protocol over this + channel is just adding a new event type to the Lucid program. +- **Shutdown is messy.** Closing stdin causes the interpreter to + exit with a `Fatal error: ... stdin eof`. The controller catches + the error stream and the run is complete by that point, but it's + noise. Worth filing as a small interpreter cleanup — + `load_new_events`'s non-blocking-poll branch should handle EOF as + a clean shutdown signal instead of `error "stdin eof"`. diff --git a/examples/p4_bmv2_examples/p4runtime/controller.py b/examples/p4_bmv2_examples/p4runtime/controller.py new file mode 100644 index 00000000..e047022d --- /dev/null +++ b/examples/p4_bmv2_examples/p4runtime/controller.py @@ -0,0 +1,198 @@ +#!/usr/bin/env python3 +"""Dynamic controller for the Lucid p4runtime example. + +Spawns `dpt --interactive`, injects test packets on stdin, watches for +`packet_in` notifications on stdout, and installs flow-cache rules in +response. Implements a small "learn from src" policy: when we see a +packet_in with src S arriving on port P, we install a rule that +forwards future packets to S out port P. Subsequent packets in either +direction then hit the cache. + +This is the Lucid analog of `advanced_tunnel.p4` + `mycontroller.py` +from the upstream P4 tutorial — same architecture (data-plane miss +notifies the controller, controller installs a rule, data plane +forwards on hit), but the channel is stdin/stdout JSON rather than +P4Runtime gRPC. +""" + +import ipaddress +import json +import os +import select +import subprocess +import sys +import time +from pathlib import Path + +from scapy.all import Ether, IP + +HERE = Path(__file__).parent +DPT = HERE / "../../../sources/lucid/dpt" +PROG = HERE / "p4runtime.dpt" +SPEC = HERE / "p4runtime.json" + +H1_MAC = "08:00:00:00:01:01" +H2_MAC = "08:00:00:00:02:02" +H3_MAC = "08:00:00:00:03:03" +S1_MAC = "08:00:00:00:01:00" + +HOST_BY_IP = { + "10.0.1.1": {"mac": H1_MAC, "port": 1}, + "10.0.2.2": {"mac": H2_MAC, "port": 2}, + "10.0.3.3": {"mac": H3_MAC, "port": 3}, +} + +def ipv4_int(s): return int(ipaddress.IPv4Address(s)) +def mac_int(s): return int(s.replace(":", ""), 16) + +def build_ipv4(src_ip, dst_ip, src_mac=H1_MAC, dst_mac=S1_MAC, ttl=64): + p = (Ether(dst=dst_mac, src=src_mac, type=0x0800) / + IP(src=src_ip, dst=dst_ip, ttl=ttl, id=0, flags=0, frag=0, + tos=0, len=20)) + return bytes(p).hex() + +# ---- JSON helpers -------------------------------------------------------- + +def pkt_event(src_ip, dst_ip, ingress_port=1, ts=None): + ev = { + "type": "packet", + "bytes": build_ipv4(src_ip, dst_ip), + "locations": [f"0:{ingress_port}"], + } + if ts is not None: + ev["timestamp"] = ts + return ev + +def install_rule(dst_ip, dmac, port): + return { + "type": "command", "name": "Table.install", + "args": { + "table": "ipv4_lpm", + "key": [f"{ipv4_int(dst_ip)}<32>"], + "action": "ipv4_lpm.cached_action", + "args": [f"{mac_int(dmac)}<48>", f"{port}<32>"], + }, + } + +# ---- subprocess plumbing ------------------------------------------------- + +def drain(fd, timeout=0.3): + """Read everything available on `fd` within `timeout` seconds.""" + out = b"" + while True: + r, _, _ = select.select([fd], [], [], timeout) + if not r: + break + chunk = fd.read(4096) + if not chunk: + break + out += chunk + return out.decode(errors="replace") + +def send(p, ev): + line = json.dumps(ev) + "\n" + p.stdin.write(line.encode()) + p.stdin.flush() + +def parse_stdout(text): + """Parse each non-empty line of `text` as JSON; return the records.""" + records = [] + for line in text.splitlines(): + line = line.strip() + if not line: + continue + try: + records.append(json.loads(line)) + except json.JSONDecodeError: + # printf records etc. — we already saw them via stderr or as + # text; skip for the structured-record pass. + pass + return records + +# ---- "policy" ------------------------------------------------------------ + +def react_to_packet_in(rec, installed): + """If this is a packet_in event, decide what (if anything) to install. + + Policy: when we see flow (src -> dst), install a forwarding rule for + `dst` based on a static IP→host map. We could be smarter (e.g., + learn the egress port from the ingress side), but in this 3-host + setup the topology is small enough that the static map is fine. + Returns the install command, or None. + """ + if rec.get("name") != "packet_in": + return None + src_int, dst_int, ingress = rec["args"] + src_ip = str(ipaddress.IPv4Address(src_int)) + dst_ip = str(ipaddress.IPv4Address(dst_int)) + if dst_ip in installed: + return None + host = HOST_BY_IP.get(dst_ip) + if host is None: + print(f" controller: no host info for {dst_ip}, ignoring", file=sys.stderr) + return None + print(f" controller: learned {dst_ip} -> port {host['port']} (dmac {host['mac']})", + file=sys.stderr) + installed.add(dst_ip) + return install_rule(dst_ip, host["mac"], host["port"]) + +# ---- main loop ----------------------------------------------------------- + +def main(): + p = subprocess.Popen( + [str(DPT), str(PROG), "--spec", str(SPEC), "--interactive"], + stdin=subprocess.PIPE, stdout=subprocess.PIPE, stderr=subprocess.PIPE, + bufsize=0, + ) + installed = set() + ts = 1000 + + def cycle(label, ev): + nonlocal ts + print(f"\n>>> {label}", file=sys.stderr) + ev_with_ts = dict(ev, timestamp=ts) + send(p, ev_with_ts) + ts += 500 + time.sleep(0.3) + out = drain(p.stdout) + for line in out.splitlines(): + print(f" dpt: {line}", file=sys.stderr) + for rec in parse_stdout(out): + rule = react_to_packet_in(rec, installed) + if rule is not None: + rule_with_ts = dict(rule, timestamp=ts) + ts += 500 + print(f" controller -> dpt: {json.dumps(rule)}", file=sys.stderr) + send(p, rule_with_ts) + time.sleep(0.2) + # drain again — but installs don't produce stdout records + drain(p.stdout) + + # Scenario: + # 1. h1→h2: MISS → controller installs rule for 10.0.2.2. + # 2. h1→h2: HIT now that the rule is in. + # 3. h1→h3: MISS → controller installs rule for 10.0.3.3. + # 4. h1→h3: HIT. + cycle("h1->h2 #1 (expect MISS + controller install)", + pkt_event("10.0.1.1", "10.0.2.2")) + cycle("h1->h2 #2 (expect HIT)", + pkt_event("10.0.1.1", "10.0.2.2")) + cycle("h1->h3 #1 (expect MISS + controller install)", + pkt_event("10.0.1.1", "10.0.3.3")) + cycle("h1->h3 #2 (expect HIT)", + pkt_event("10.0.1.1", "10.0.3.3")) + + # Done — close stdin and let the subprocess exit. The "stdin eof" + # error on stderr is benign; the run is complete. + time.sleep(0.3) + print("\n--- final stderr from dpt: ---", file=sys.stderr) + print(drain(p.stderr, 0.5), file=sys.stderr) + p.stdin.close() + p.terminate() + try: + p.wait(timeout=1) + except subprocess.TimeoutExpired: + p.kill() + +if __name__ == "__main__": + main() diff --git a/examples/p4_bmv2_examples/p4runtime/p4runtime.dpt b/examples/p4_bmv2_examples/p4runtime/p4runtime.dpt new file mode 100644 index 00000000..c71e0802 --- /dev/null +++ b/examples/p4_bmv2_examples/p4runtime/p4runtime.dpt @@ -0,0 +1,113 @@ +// Lucid port of the P4 "p4runtime" tutorial — really a demo of +// **dynamic control via the interpreter's interactive mode**. +// +// The data plane is a small flow cache (same shape as `flowcache`): +// hits forward, misses generate a `packet_in` control event and drop +// the original packet. What makes this example different is *how* the +// control plane is connected: +// +// * `dpt --interactive` reads JSON events on stdin and emits exit +// events as JSON on stdout (one record per line). +// * `controller.py` launches the interpreter as a subprocess, reads +// packet_in records off stdout, decides what to install (here: +// learn the dst port from the ingress port the packet arrived on), +// and writes `Table.install` commands back on stdin. +// +// The lifecycle — cold cache → miss → notify → install → hit — plays +// out in real time across the two processes. This is the same idea +// the upstream `advanced_tunnel.p4` + `mycontroller.py` pair +// demonstrates with P4Runtime, just sized to fit the simulator. + +const int<32> CONTROLLER_PORT = 99; + +type eth_hdr_t = { + int<48> dmac; + int<48> smac; + int<16> ety; +} + +type ipv4_t = { + int<4> version; + int<4> ihl; + int<8> diffserv; + int<16> total_len; + int<16> id; + int<3> flags; + int<13> frag_offset; + int<8> ttl; + int<8> protocol; + int<16> hdr_csum; + int<32> src; + int<32> dst; +} + +type fwd_t = { + int<48> fwd_dmac; + int<32> fwd_port; + bool fwd_hit; +} + +action fwd_t cached_action(int<48> dmac, int<32> port)() { + return {fwd_dmac = dmac; fwd_port = port; fwd_hit = true}; +} + +action fwd_t flow_unknown(int<48> _d, int<32> _p)() { + return {fwd_dmac = 0; fwd_port = 0; fwd_hit = false}; +} + +global Table.t<, (int<48>, int<32>), (), fwd_t>> ipv4_lpm = + Table.create(1024, [cached_action; flow_unknown], flow_unknown, (0, 0)); + +packet event ipv4_pkt(eth_hdr_t eth, ipv4_t ip, Payload.t pl); + +// PacketIn control event. {skip;} = no handler — the event is only +// emitted to the controller port so it surfaces on the interpreter's +// stdout (interactive mode) as a JSON record the controller can read. +event packet_in(int<32> src_ip, int<32> dst_ip, int<32> ingress) {skip;} + +handle ipv4_pkt(eth_hdr_t eth, ipv4_t ip, Payload.t pl) { + fwd_t d = Table.lookup(ipv4_lpm, ip#dst, ()); + if (d#fwd_hit) { + eth_hdr_t new_eth = { + dmac = d#fwd_dmac; + smac = eth#dmac; + ety = eth#ety + }; + ipv4_t new_ip = { + version = ip#version; + ihl = ip#ihl; + diffserv = ip#diffserv; + total_len = ip#total_len; + id = ip#id; + flags = ip#flags; + frag_offset = ip#frag_offset; + ttl = ip#ttl - 1; + protocol = ip#protocol; + hdr_csum = 0; + src = ip#src; + dst = ip#dst + }; + printf("sw %d : HIT dst=%d src=%d -> port %d ttl=%d", + self, ip#dst, ip#src, d#fwd_port, new_ip#ttl); + generate_port(d#fwd_port, + ipv4_pkt(new_eth, + {new_ip with hdr_csum = hash<16>(checksum, new_ip)}, + pl)); + } else { + printf("sw %d : MISS dst=%d src=%d ingress=%d -> PacketIn(controller)", + self, ip#dst, ip#src, ingress_port); + generate_port(CONTROLLER_PORT, + packet_in(ip#src, ip#dst, ingress_port)); + } +} + +parser main(bitstring pkt) { + eth_hdr_t eth = read(pkt); + match eth#ety with + | LUCID_ETHERTY -> { do_lucid_parsing(pkt); } + | 0x0800 -> { + ipv4_t ip = read(pkt); + generate(ipv4_pkt(eth, ip, Payload.parse(pkt))); + } + | _ -> { drop; } +} diff --git a/examples/p4_bmv2_examples/p4runtime/p4runtime.json b/examples/p4_bmv2_examples/p4runtime/p4runtime.json new file mode 100644 index 00000000..95831511 --- /dev/null +++ b/examples/p4_bmv2_examples/p4runtime/p4runtime.json @@ -0,0 +1,4 @@ +{ + "max time": 0, + "events": [] +} diff --git a/examples/p4_bmv2_examples/qos/README.md b/examples/p4_bmv2_examples/qos/README.md new file mode 100644 index 00000000..9dabef59 --- /dev/null +++ b/examples/p4_bmv2_examples/qos/README.md @@ -0,0 +1,32 @@ +# `qos` + +Plain IPv4 forwarding (same as `basic`) plus a per-protocol DSCP +marking step applied before the table lookup: + +| L4 protocol | Action | DSCP value | +|-------------|------------------------------|------------| +| UDP (17) | Expedited Forwarding | 46 | +| TCP (6) | Voice Admit | 44 | +| anything else | leave diffserv unchanged | — | + +## Files +- [qos.dpt](qos.dpt) — the Lucid program. +- [gen_spec.py](gen_spec.py) — scapy generator. +- [qos.json](qos.json) — generated artifact. + +## Running +```bash +/opt/anaconda3/bin/python3 gen_spec.py +../../../sources/lucid/dpt qos.dpt --spec qos.json --silent +``` + +## Test cases (in `gen_spec.py`) + +Each packet is `h1 → h2` over a single switch. + +| Input | Expected `dscp` | TOS byte in exit | +|--------------------|-----------------|------------------| +| UDP, input `tos=0` | 46 | `0xb8` (46<<2 \| 0) | +| TCP, input `tos=0` | 44 | `0xb0` (44<<2 \| 0) | +| ICMP, input `tos=0`| 0 (unchanged) | `0x00` | +| UDP, input `tos=0xfc` (dscp=63, ecn=00) | 46 | `0xb8` (dscp rewritten, ecn preserved) | diff --git a/examples/p4_bmv2_examples/qos/gen_spec.py b/examples/p4_bmv2_examples/qos/gen_spec.py new file mode 100644 index 00000000..7aa00ee1 --- /dev/null +++ b/examples/p4_bmv2_examples/qos/gen_spec.py @@ -0,0 +1,72 @@ +#!/usr/bin/env python3 +"""Generate qos.json for the Lucid qos example. + +Single switch (default 1-switch sim). Sends three packets in different +L4 protocols and checks the diffserv field is rewritten according to +the per-protocol policy: + UDP → diffserv = 46 (EF) + TCP → diffserv = 44 (Voice Admit) + ICMP → unchanged +""" + +import ipaddress +import json +from pathlib import Path + +from scapy.all import Ether, IP, TCP, UDP, ICMP + +def ipv4_int(s): return int(ipaddress.IPv4Address(s)) +def mac_int(s): return int(s.replace(":", ""), 16) + +H1_MAC = "08:00:00:00:01:01" +H2_MAC = "08:00:00:00:02:02" +S1_MAC = "08:00:00:00:01:00" + +def install_lpm(dst_ip, dmac, port): + return { + "type": "command", "name": "Table.install", + "args": { + "table": "ipv4_lpm", + "key": [f"{ipv4_int(dst_ip)}<32>"], + "action": "ipv4_lpm.ipv4_forward", + "args": [f"{mac_int(dmac)}<48>", f"{port}<32>"], + }, + } + +def packet(l4, dst_ip="10.0.2.2", src_ip="10.0.1.1", tos=0): + """Build h1→h2 packet with the given L4 layer. `tos` is the full + 8-bit TOS byte (diffserv:6 + ecn:2).""" + ip = IP(src=src_ip, dst=dst_ip, ttl=64, id=0, flags=0, frag=0, + tos=tos, len=20 + len(bytes(l4))) + return bytes(Ether(dst=S1_MAC, src=H1_MAC, type=0x0800) / ip / l4).hex() + +events = [ + install_lpm("10.0.2.2", H2_MAC, port=2), + install_lpm("10.0.1.1", H1_MAC, port=1), +] + +ts = 5000 +for label, pkt in [ + ("UDP h1→h2 (expect dscp=46)", packet(UDP(sport=1111, dport=80))), + ("TCP h1→h2 (expect dscp=44)", packet(TCP(sport=2222, dport=80))), + ("ICMP h1→h2 (dscp unchanged=0)", packet(ICMP())), + ("UDP h1→h2 with tos=0xfc (preserve ecn=00, mark dscp=46)", + packet(UDP(sport=3333, dport=80), tos=0xfc)), +]: + events.append({ + "type": "packet", + "bytes": pkt, + "locations": ["0:1"], + "timestamp": ts, + }) + ts += 1000 + +spec = { + "max time": 15000, + "default_input_gap": 100, + "events": events, +} + +out = Path(__file__).with_name("qos.json") +out.write_text(json.dumps(spec, indent=2) + "\n") +print(f"wrote {out} with {len(events)} events") diff --git a/examples/p4_bmv2_examples/qos/qos.dpt b/examples/p4_bmv2_examples/qos/qos.dpt new file mode 100644 index 00000000..9255f350 --- /dev/null +++ b/examples/p4_bmv2_examples/qos/qos.dpt @@ -0,0 +1,138 @@ +// Lucid port of the P4 "qos" tutorial. +// +// Plain IPv4 forwarding (same shape as `basic`), plus per-protocol DSCP +// marking before the table lookup: +// * UDP packets → diffserv = 46 (Expedited Forwarding) +// * TCP packets → diffserv = 44 (Voice Admit) +// * everything else → diffserv unchanged +// +// The upstream P4 program also defines a bunch of AF_xy actions +// (Assured Forwarding classes) but never invokes them in the apply +// block, so they're dead code we don't bother replicating. +// +// One small difference from the previous examples: the IPv4 header +// splits the TOS byte into `diffserv:6 + ecn:2`, matching the actual +// IPv4 wire format. Earlier examples kept it as a single `diffserv:8` +// since they never read or wrote those bits. The checksum recompute +// covers both halves (one's-complement sum is bit-position-agnostic +// within each 16-bit word). + +const int<16> ETY_IPV4 = 0x0800; +const int<8> PROTO_TCP = 6; +const int<8> PROTO_UDP = 17; + +// DSCP codepoints (each is the 6-bit value; not shifted). +const int<6> DSCP_EF = 46; // Expedited Forwarding +const int<6> DSCP_VA = 44; // Voice Admit + +type eth_hdr_t = { + int<48> dmac; + int<48> smac; + int<16> ety; +} + +type ipv4_t = { + int<4> version; + int<4> ihl; + int<6> diffserv; + int<2> ecn; + int<16> total_len; + int<16> id; + int<3> flags; + int<13> frag_offset; + int<8> ttl; + int<8> protocol; + int<16> hdr_csum; + int<32> src; + int<32> dst; +} + +// -------- forwarding table (same shape as basic) ------------------------ + +type fwd_t = { + int<48> fwd_dmac; + int<32> fwd_port; + bool fwd_hit; +} + +action fwd_t ipv4_forward(int<48> dmac, int<32> port)() { + return {fwd_dmac = dmac; fwd_port = port; fwd_hit = true}; +} + +action fwd_t ipv4_drop(int<48> _d, int<32> _p)() { + return {fwd_dmac = 0; fwd_port = 0; fwd_hit = false}; +} + +global Table.t<, (int<48>, int<32>), (), fwd_t>> ipv4_lpm = + Table.create(1024, [ipv4_forward; ipv4_drop], ipv4_drop, (0, 0)); + +// -------- events -------------------------------------------------------- + +packet event ipv4_pkt(eth_hdr_t eth, ipv4_t ip, Payload.t pl); + +// -------- handler ------------------------------------------------------- + +handle ipv4_pkt(eth_hdr_t eth, ipv4_t ip, Payload.t pl) { + // Verify-side IPv4 checksum. + int<16> verify = hash<16>(checksum, ip); + if (verify != 0) { + printf("sw %d port %d : bad input csum (verify=%d) dst=%d", + self, ingress_port, verify, ip#dst); + } + + // Pick a DSCP based on the L4 protocol. Match falls through to "leave + // diffserv as-is" for non-TCP/UDP traffic. + int<6> new_dscp = ip#diffserv; + match ip#protocol with + | PROTO_UDP -> { new_dscp = DSCP_EF; } + | PROTO_TCP -> { new_dscp = DSCP_VA; } + | _ -> { new_dscp = ip#diffserv; } // keep existing dscp + + fwd_t d = Table.lookup(ipv4_lpm, ip#dst, ()); + if (d#fwd_hit) { + eth_hdr_t new_eth = { + dmac = d#fwd_dmac; + smac = eth#dmac; + ety = eth#ety + }; + // Zero hdr_csum before the `with`-form recompute (see basic README). + ipv4_t new_ip = { + version = ip#version; + ihl = ip#ihl; + diffserv = new_dscp; + ecn = ip#ecn; + total_len = ip#total_len; + id = ip#id; + flags = ip#flags; + frag_offset = ip#frag_offset; + ttl = ip#ttl - 1; + protocol = ip#protocol; + hdr_csum = 0; + src = ip#src; + dst = ip#dst + }; + printf("sw %d port %d -> %d : ipv4 dst=%d proto=%d dscp=%d ttl=%d", + self, ingress_port, d#fwd_port, + ip#dst, ip#protocol, new_dscp, new_ip#ttl); + generate_port(d#fwd_port, + ipv4_pkt(new_eth, + {new_ip with hdr_csum = hash<16>(checksum, new_ip)}, + pl)); + } else { + printf("sw %d port %d : drop ipv4 dst=%d (no route)", + self, ingress_port, ip#dst); + } +} + +// -------- parser -------------------------------------------------------- + +parser main(bitstring pkt) { + eth_hdr_t eth = read(pkt); + match eth#ety with + | LUCID_ETHERTY -> { do_lucid_parsing(pkt); } + | 0x0800 -> { + ipv4_t ip = read(pkt); + generate(ipv4_pkt(eth, ip, Payload.parse(pkt))); + } + | _ -> { drop; } +} diff --git a/examples/p4_bmv2_examples/qos/qos.json b/examples/p4_bmv2_examples/qos/qos.json new file mode 100644 index 00000000..d31f9579 --- /dev/null +++ b/examples/p4_bmv2_examples/qos/qos.json @@ -0,0 +1,68 @@ +{ + "max time": 15000, + "default_input_gap": 100, + "events": [ + { + "type": "command", + "name": "Table.install", + "args": { + "table": "ipv4_lpm", + "key": [ + "167772674<32>" + ], + "action": "ipv4_lpm.ipv4_forward", + "args": [ + "8796093022722<48>", + "2<32>" + ] + } + }, + { + "type": "command", + "name": "Table.install", + "args": { + "table": "ipv4_lpm", + "key": [ + "167772417<32>" + ], + "action": "ipv4_lpm.ipv4_forward", + "args": [ + "8796093022465<48>", + "1<32>" + ] + } + }, + { + "type": "packet", + "bytes": "08000000010008000000010108004500001c00000000401163cf0a0001010a000202045700500008e434", + "locations": [ + "0:1" + ], + "timestamp": 5000 + }, + { + "type": "packet", + "bytes": "08000000010008000000010108004500002800000000400663ce0a0001010a00020208ae00500000000000000000500220006fe20000", + "locations": [ + "0:1" + ], + "timestamp": 6000 + }, + { + "type": "packet", + "bytes": "08000000010008000000010108004500001c00000000400163df0a0001010a0002020800f7ff00000000", + "locations": [ + "0:1" + ], + "timestamp": 7000 + }, + { + "type": "packet", + "bytes": "080000000100080000000101080045fc001c00000000401162d30a0001010a0002020d0500500008db86", + "locations": [ + "0:1" + ], + "timestamp": 8000 + } + ] +} diff --git a/examples/p4_bmv2_examples/source_routing/README.md b/examples/p4_bmv2_examples/source_routing/README.md new file mode 100644 index 00000000..0bf3b74d --- /dev/null +++ b/examples/p4_bmv2_examples/source_routing/README.md @@ -0,0 +1,64 @@ +# `source_routing` + +Packets with ether-type `0x1234` carry a *stack* of `(bos:1, port:15)` labels +between ethernet and IPv4. Each switch on the route reads the top label, +forwards on the encoded port, and pops the label. Whichever label has +`bos=1` marks the *last* hop — that switch strips the source-route header +entirely and emits the inner IPv4 packet plain. + +No tables. No control plane. The source route is in the packet. + +## Files +- [source_routing.dpt](source_routing.dpt) — the Lucid program. +- [gen_spec.py](gen_spec.py) — scapy generator. Topology + test packets. +- [source_routing.json](source_routing.json) — committed artifact; regenerate + with `python gen_spec.py`. + +## Running +```bash +/opt/anaconda3/bin/python3 gen_spec.py +../../../sources/lucid/dpt source_routing.dpt --spec source_routing.json --silent +``` + +## Test cases (defined in `gen_spec.py`) +| # | Route | Labels | Expected exit | +|---|-----------------------------------------|--------------|---------------| +| 1 | h1 → h2 via s1, s2 | `[2, 1]` | `1:1` | +| 2 | h1 → h3 via s1, s3 | `[3, 1]` | `2:1` | +| 3 | h1 → h2 indirect via s1, s3, s2 | `[3, 3, 1]` | `1:1` | +| 4 | h1 → h2 via s1, s2, s3, s2 (MAX_HOPS) | `[2, 3, 3, 1]`| `1:1` | +| 5 | stack overflow (5 labels, no bos=1) | — | drop | + +The exit packets are byte-identical (eth dst/src/ety, plain IPv4) — all the +stack handling is the parser/handler's work; the final wire packet has no +source-route header. + +## Topology +3-switch triangle, one host per switch. Same shape as `load_balance`. + +``` + h1 - 1 [s1=0] 2 ---------- 2 [s2=1] 1 - h2 + 3 3 + | | + 2 3 + [s3=2] 1 - h3 ---------- +``` + +## Lucid notes +- **Parser slot analysis** requires that each positional event arg + resolve to a *distinct* variable. Passing the same literal/variable to + two arg positions in `generate(...)` is rejected with an error of the + form "Parameter `pX` and `pY` ... must share the same slot." + Specifically, sharing a single `zero` variable across two padding slots + in an event constructor doesn't compile — each slot needs its own + named local. (This was a 30-minute mystery the first time.) +- **Parser event args must be bare variables (or `Payload.parse(pkt)`).** + Literals, vector expressions, and record constructors in a parser-side + `generate(...)` all get rejected. Hoist them into locals first. + Discovered while trying to pass `[p0; p1; 0; 0]` as a single event arg. +- **Vectors in packet-event args don't survive slot analysis.** A field + of type `int<15>[4]` on a `packet event` lowers through vector→tuple→ + flat-args, and the analyzer trips on the flattened literal-zero + positions. Use explicit scalar fields instead. (Non-packet events + appear to handle vector args fine — see + `sources/lucid/examples/publications/popl22/starflow.dpt`.) \ No newline at end of file diff --git a/examples/p4_bmv2_examples/source_routing/gen_spec.py b/examples/p4_bmv2_examples/source_routing/gen_spec.py new file mode 100644 index 00000000..abc6e965 --- /dev/null +++ b/examples/p4_bmv2_examples/source_routing/gen_spec.py @@ -0,0 +1,131 @@ +#!/usr/bin/env python3 +"""Generate source_routing.json for the Lucid source_routing example. + +Run with `python gen_spec.py`. Builds the topology, table-free spec +(this example has no control-plane state), and source-routed test +packets via scapy. +""" + +import json +from pathlib import Path + +from scapy.all import ( + Ether, IP, Packet, BitField, bind_layers, +) + +ETY_SRC_ROUTE = 0x1234 + +# 16-bit per-hop label: bos (1 bit) + port (15 bits). Same on-wire layout +# as the P4 tutorial's `srcRoute_t`. +class SR(Packet): + name = "SR" + fields_desc = [ + BitField("bos", 0, 1), + BitField("port", 0, 15), + ] + +bind_layers(Ether, SR, type=ETY_SRC_ROUTE) +bind_layers(SR, SR, bos=0) +bind_layers(SR, IP, bos=1) + +# ---- topology ------------------------------------------------------------ +# Node IDs: 0=s1, 1=s2, 2=s3. Triangle, one host per switch on port 1 +# (undeclared → exits there). + +TOPOLOGY = { + "nodes": { + "0": {"ports": {"2": {"type": "link"}, "3": {"type": "link"}}}, + "1": {"ports": {"2": {"type": "link"}, "3": {"type": "link"}}}, + "2": {"ports": {"2": {"type": "link"}, "3": {"type": "link"}}}, + }, + "links": [ + {"0:2": "1:2"}, # s1:p2 <-> s2:p2 + {"0:3": "2:2"}, # s1:p3 <-> s3:p2 + {"1:3": "2:3"}, # s2:p3 <-> s3:p3 + ], +} + +# ---- helpers ------------------------------------------------------------- + +H1_MAC = "08:00:00:00:01:01" +S1_MAC = "08:00:00:00:01:00" + +def sr_packet(labels, ipv4_dst="10.0.2.2", ipv4_src="10.0.1.1", + src=H1_MAC, dst=S1_MAC, ttl=64): + """Build a source-routed packet. + + `labels` is a list of egress ports. Each is wrapped in a 16-bit + SR label; the last one gets bos=1 (the hop that strips the header). + """ + assert 1 <= len(labels) <= 4 + layers = [ + SR(bos=(1 if i == len(labels) - 1 else 0), port=p) + for i, p in enumerate(labels) + ] + stack = layers[0] + for layer in layers[1:]: + stack = stack / layer + pkt = (Ether(dst=dst, src=src, type=ETY_SRC_ROUTE) / + stack / + IP(src=ipv4_src, dst=ipv4_dst, ttl=ttl, id=0, flags=0, frag=0, + tos=0, len=20)) + return bytes(pkt).hex() + +def overflow_packet(n=5, src=H1_MAC, dst=S1_MAC): + """Build a packet whose SR stack has n labels with no bos=1 in + the first `min(n, 4)` — used to confirm the MAX_HOPS=4 overflow drop.""" + stack = None + for i in range(n): + layer = SR(bos=0, port=i + 1) + stack = layer if stack is None else stack / layer + pkt = (Ether(dst=dst, src=src, type=ETY_SRC_ROUTE) / stack) + return bytes(pkt).hex() + +# ---- test scenarios ----------------------------------------------------- + +TESTS = [ + # h1 → h2 via s1, s2. Two labels. + # s1 reads (bos=0,port=2): pop, forward port 2 → enters s2:2. + # s2 reads (bos=1,port=1): last hop, strip SR, exit port 1 (h2). + ("h1→h2 via s1,s2 (2 labels)", sr_packet([2, 1], ipv4_dst="10.0.2.2")), + + # h1 → h3 via s1, s3. + ("h1→h3 via s1,s3 (2 labels)", sr_packet([3, 1], ipv4_dst="10.0.3.3")), + + # h1 → h2 via the LONG path s1, s3, s2. Three labels. + # s1 → port 3 (s3:2). s3 → port 3 (s2:3). s2 → port 1 (h2). + ("h1→h2 via s1,s3,s2 (3 labels)", sr_packet([3, 3, 1], + ipv4_dst="10.0.2.2")), + + # 4-label route exercising MAX_HOPS exactly: h1 → s1 → s2 → s3 → s2 → h2. + # Loops back through s2 unnecessarily, but lets us hit the sr4 path. + ("h1→h2 via s1,s2,s3,s2 (4 labels, MAX_HOPS)", + sr_packet([2, 3, 3, 1], ipv4_dst="10.0.2.2")), + + # Stack overflow: 5 labels, none bos=1 in first 4 — sr_chain_3 drops. + ("stack overflow at MAX_HOPS=4", overflow_packet(5)), +] + +events = [] +ts = 5000 +for label, bytes_hex in TESTS: + events.append({ + "type": "packet", + "bytes": bytes_hex, + "locations": ["0:1"], + "timestamp": ts, + }) + ts += 1000 + +spec = { + "max time": 20000, + "default_input_gap": 100, + "topology": TOPOLOGY, + "events": events, +} + +out = Path(__file__).with_name("source_routing.json") +out.write_text(json.dumps(spec, indent=2) + "\n") +print(f"wrote {out} with {len(events)} packet events") +for (label, _), ev in zip(TESTS, events): + print(f" t={ev['timestamp']:>5} {label}") diff --git a/examples/p4_bmv2_examples/source_routing/source_routing.dpt b/examples/p4_bmv2_examples/source_routing/source_routing.dpt new file mode 100644 index 00000000..cfec0289 --- /dev/null +++ b/examples/p4_bmv2_examples/source_routing/source_routing.dpt @@ -0,0 +1,202 @@ +// Lucid port of the P4 "source_routing" tutorial. +// +// Packets with ether-type 0x1234 carry a *stack* of (bos:1, port:15) labels +// between ethernet and IPv4. Each switch on the route reads the top label, +// forwards on the encoded port, and pops the label. Whichever label has +// bos=1 marks the *last* hop — that switch strips the source-route header +// and emits the inner IPv4 packet plain. +// +// Three structural differences from the P4 upstream: +// +// 1. **Non-recursive parsers.** Lucid parsers cannot self-call (see +// sources/lucid/src/lib/frontend/transformations/MonomorphicEventArgs.ml:253), +// so the P4 `parse_srcRouting → parse_srcRouting` self-loop is +// manually unrolled as a chain `sr_chain_0` .. `sr_chain_3`. MAX_HOPS +// is therefore a compile-time constant (here, 4) rather than runtime. +// +// 2. **No arithmetic in parsers.** We cannot `read` a 16-bit label and +// then mask off the bos bit inside the parser. Instead each label is +// split at the wire boundary: a 1-bit `read` for bos and a 15-bit +// `read` for port. Wire format is identical (16 bits per label, bos +// in the top bit). +// +// 3. **One event per stack depth.** Lucid's auto-deparser emits the +// event's full field list on egress, with no way to make the output +// length depend on a runtime value. So a single `sr_pkt(... ports[4], +// n_labels)` event can't produce a variable-length wire packet. We +// define `sr1`..`sr4`, one per supported depth, and the handler +// "pops" by re-emitting as the next-smaller variant. The terminal +// case (`sr1`) strips the source-route header entirely and emits a +// plain `ipv4_pkt` instead. + +const int<16> ETY_SRC_ROUTE = 0x1234; +const int<16> ETY_IPV4 = 0x0800; + +type eth_hdr_t = { + int<48> dmac; + int<48> smac; + int<16> ety; +} + +type ipv4_t = { + int<4> version; + int<4> ihl; + int<8> diffserv; + int<16> total_len; + int<16> id; + int<3> flags; + int<13> frag_offset; + int<8> ttl; + int<8> protocol; + int<16> hdr_csum; + int<32> src; + int<32> dst; +} + +// -------- events --------------------------------------------------------- +// +// One sr event per stack depth (1..4). The wire layout of each event is +// exactly (bos:1 + port:15) per label, then the IPv4 header and payload. +// b_i is always 0 except for the *last* label in each event, which has +// b_i = 1 (per the protocol). + +packet event sr1(eth_hdr_t eth, + int<1> b0, int<15> p0, + ipv4_t ip, Payload.t pl); +packet event sr2(eth_hdr_t eth, + int<1> b0, int<15> p0, + int<1> b1, int<15> p1, + ipv4_t ip, Payload.t pl); +packet event sr3(eth_hdr_t eth, + int<1> b0, int<15> p0, + int<1> b1, int<15> p1, + int<1> b2, int<15> p2, + ipv4_t ip, Payload.t pl); +packet event sr4(eth_hdr_t eth, + int<1> b0, int<15> p0, + int<1> b1, int<15> p1, + int<1> b2, int<15> p2, + int<1> b3, int<15> p3, + ipv4_t ip, Payload.t pl); + +// Final-hop emission: plain IPv4 packet with the source-route header +// stripped. `{skip;}` means "no handler" — the event is only used as the +// output of generate_port. +packet event ipv4_pkt(eth_hdr_t eth, ipv4_t ip, Payload.t pl) {skip;} + +// -------- handlers ------------------------------------------------------- +// +// Each handler pops the head label (b0, p0). For sr1 we're at the last +// hop: rewrite ethertype, emit plain ipv4_pkt. For srN (N > 1), emit +// srN-1 with the remaining labels. + +handle sr1(eth_hdr_t eth, int<1> b0, int<15> p0, + ipv4_t ip, Payload.t pl) { + int<32> port = (int<32>)p0; + eth_hdr_t new_eth = { + dmac = eth#dmac; + smac = eth#smac; + ety = ETY_IPV4 + }; + printf("sw %d port %d -> %d : sr_pop (last, strip header) ttl=%d", + self, ingress_port, port, ip#ttl); + generate_port(port, ipv4_pkt(new_eth, ip, pl)); +} + +handle sr2(eth_hdr_t eth, int<1> b0, int<15> p0, + int<1> b1, int<15> p1, + ipv4_t ip, Payload.t pl) { + int<32> port = (int<32>)p0; + printf("sw %d port %d -> %d : sr_pop (remaining=1) ttl=%d", + self, ingress_port, port, ip#ttl); + generate_port(port, sr1(eth, b1, p1, ip, pl)); +} + +handle sr3(eth_hdr_t eth, int<1> b0, int<15> p0, + int<1> b1, int<15> p1, + int<1> b2, int<15> p2, + ipv4_t ip, Payload.t pl) { + int<32> port = (int<32>)p0; + printf("sw %d port %d -> %d : sr_pop (remaining=2) ttl=%d", + self, ingress_port, port, ip#ttl); + generate_port(port, sr2(eth, b1, p1, b2, p2, ip, pl)); +} + +handle sr4(eth_hdr_t eth, int<1> b0, int<15> p0, + int<1> b1, int<15> p1, + int<1> b2, int<15> p2, + int<1> b3, int<15> p3, + ipv4_t ip, Payload.t pl) { + int<32> port = (int<32>)p0; + printf("sw %d port %d -> %d : sr_pop (remaining=3) ttl=%d", + self, ingress_port, port, ip#ttl); + generate_port(port, sr3(eth, b1, p1, b2, p2, b3, p3, ip, pl)); +} + +// -------- parser chain --------------------------------------------------- +// +// Each step reads one (bos, port) label and either finalises (bos=1, +// generate srN where N is the number of labels accumulated so far + 1) +// or recurses into the next step. + +parser sr_chain_3(bitstring pkt, eth_hdr_t eth, + int<1> b0, int<15> q0, + int<1> b1, int<15> q1, + int<1> b2, int<15> q2) { + int<1> bos3 = read(pkt); + int<15> q3 = read(pkt); + match bos3 with + | 1 -> { + ipv4_t ip = read(pkt); + Payload.t pl = Payload.parse(pkt); + generate(sr4(eth, b0, q0, b1, q1, b2, q2, bos3, q3, ip, pl)); + } + | _ -> { drop; } +} + +parser sr_chain_2(bitstring pkt, eth_hdr_t eth, + int<1> b0, int<15> q0, + int<1> b1, int<15> q1) { + int<1> bos2 = read(pkt); + int<15> q2 = read(pkt); + match bos2 with + | 1 -> { + ipv4_t ip = read(pkt); + Payload.t pl = Payload.parse(pkt); + generate(sr3(eth, b0, q0, b1, q1, bos2, q2, ip, pl)); + } + | _ -> { sr_chain_3(pkt, eth, b0, q0, b1, q1, bos2, q2); } +} + +parser sr_chain_1(bitstring pkt, eth_hdr_t eth, + int<1> b0, int<15> q0) { + int<1> bos1 = read(pkt); + int<15> q1 = read(pkt); + match bos1 with + | 1 -> { + ipv4_t ip = read(pkt); + Payload.t pl = Payload.parse(pkt); + generate(sr2(eth, b0, q0, bos1, q1, ip, pl)); + } + | _ -> { sr_chain_2(pkt, eth, b0, q0, bos1, q1); } +} + +parser sr_chain_0(bitstring pkt, eth_hdr_t eth) { + int<1> bos0 = read(pkt); + int<15> q0 = read(pkt); + match bos0 with + | 1 -> { + ipv4_t ip = read(pkt); + Payload.t pl = Payload.parse(pkt); + generate(sr1(eth, bos0, q0, ip, pl)); + } + | _ -> { sr_chain_1(pkt, eth, bos0, q0); } +} + +parser main(bitstring pkt) { + eth_hdr_t eth = read(pkt); + match eth#ety with + | LUCID_ETHERTY -> { do_lucid_parsing(pkt); } + | 0x1234 -> { sr_chain_0(pkt, eth); } + | _ -> { drop; } +} diff --git a/examples/p4_bmv2_examples/source_routing/source_routing.json b/examples/p4_bmv2_examples/source_routing/source_routing.json new file mode 100644 index 00000000..6fc56b6c --- /dev/null +++ b/examples/p4_bmv2_examples/source_routing/source_routing.json @@ -0,0 +1,91 @@ +{ + "max time": 20000, + "default_input_gap": 100, + "topology": { + "nodes": { + "0": { + "ports": { + "2": { + "type": "link" + }, + "3": { + "type": "link" + } + } + }, + "1": { + "ports": { + "2": { + "type": "link" + }, + "3": { + "type": "link" + } + } + }, + "2": { + "ports": { + "2": { + "type": "link" + }, + "3": { + "type": "link" + } + } + } + }, + "links": [ + { + "0:2": "1:2" + }, + { + "0:3": "2:2" + }, + { + "1:3": "2:3" + } + ] + }, + "events": [ + { + "type": "packet", + "bytes": "0800000001000800000001011234000280014500001400000000400063e80a0001010a000202", + "locations": [ + "0:1" + ], + "timestamp": 5000 + }, + { + "type": "packet", + "bytes": "0800000001000800000001011234000380014500001400000000400062e70a0001010a000303", + "locations": [ + "0:1" + ], + "timestamp": 6000 + }, + { + "type": "packet", + "bytes": "08000000010008000000010112340003000380014500001400000000400063e80a0001010a000202", + "locations": [ + "0:1" + ], + "timestamp": 7000 + }, + { + "type": "packet", + "bytes": "080000000100080000000101123400020003000380014500001400000000400063e80a0001010a000202", + "locations": [ + "0:1" + ], + "timestamp": 8000 + }, + { + "type": "packet", + "bytes": "080000000100080000000101123400010002000300040005", + "locations": [ + "0:1" + ], + "timestamp": 9000 + } + ] +} From 9bc20fddab6132103894effb8c9df32fb3a35459 Mon Sep 17 00:00:00 2001 From: John Sonchack Date: Mon, 25 May 2026 08:42:28 -0400 Subject: [PATCH 03/49] support recursive monomorphization --- .../transformations/MonomorphicEventArgs.ml | 54 +++++++++++++------ 1 file changed, 39 insertions(+), 15 deletions(-) diff --git a/src/lib/frontend/transformations/MonomorphicEventArgs.ml b/src/lib/frontend/transformations/MonomorphicEventArgs.ml index 75d6541f..bf6b200e 100644 --- a/src/lib/frontend/transformations/MonomorphicEventArgs.ml +++ b/src/lib/frontend/transformations/MonomorphicEventArgs.ml @@ -148,7 +148,7 @@ let update_calls emap ds : event_decl IdMap.t * decls = and we will need to replace it with the appropriate monomorphic instance later *) let args_are_polymorphic = List.exists (fun arg -> is_polymorphic_ty (Option.get arg.ety)) args in if args_are_polymorphic then ( - print_endline ("[event_ctor_replacer] arguments are polymorphic, so we will not replace this call with a monomorphic one..."); + (* print_endline ("[event_ctor_replacer] arguments are polymorphic, so we will not replace this call with a monomorphic one..."); *) super#visit_exp () exp ) else ( @@ -471,23 +471,36 @@ let monomorphize_parsers builtin_tys ds = ds ;; -let eliminate_prog builtin_tys ds = - let ds = RefreshTypes.refresh_prog ds in - let ds = Typer.infer_prog builtin_tys ds in - - (* monomorphize parsers first, so that any polymorphic events referenced by - parser bodies get concrete arg types in the duplicated parser copies *) - let ds = monomorphize_parsers builtin_tys ds in +let monomorphize_events builtin_tys ds = + let max_iters = 100 in + (* replace polymorphic declarations with monomorphic copies *) + let rec loop emap ds iter = + if iter > max_iters + then + failwith + (Printf.sprintf + "[MonomorphicEventArgs] parser monomorphization did not converge in \ + %d iterations" + max_iters); + let emap', ds = update_calls emap ds in + if IdMap.equal event_decl_equal emap emap' then ds + else + let ds = update_decls emap' ds in + (* type check to infer all the polymorphic args inside of event calls *) + let ds = RefreshTypes.refresh_prog ds in + let ds = Typer.infer_prog builtin_tys ds in + loop emap' ds (iter + 1) + in + let ds = loop IdMap.empty ds 0 in + (* one-pass monomorphizer *) + (* (* collect monomorphic calls (and replace their event names) *) let emap, ds = update_calls IdMap.empty ds in - (* replace polymorphic declarations with monomorphic copies *) let ds = update_decls emap ds in - (* type check to infer all the polymorphic args inside of event calls *) let ds = RefreshTypes.refresh_prog ds in let ds = Typer.infer_prog builtin_tys ds in - (* run the call collector / updator again, for all the calls in the monomorphic generated handlers, which are no longer polymorphic *) (* print_endline "------ Monomorphization second pass -------"; *) @@ -502,6 +515,7 @@ let eliminate_prog builtin_tys ds = failwith "[MonomorphicEventArgs] elimination of polymorphic event encountered\ transitive polymorphism that requires more than 2 passes. This is not yet supported."; ignore emap'; + *) (* print_endline "-------- program at debug point --------"; *) (* Printing.decls_to_string ds |> print_endline; *) @@ -512,6 +526,20 @@ let eliminate_prog builtin_tys ds = (* reset event numbers *) let ds = EventFormat.set_event_nums ds in + ds +;; + + + +let eliminate_prog builtin_tys ds = + let ds = RefreshTypes.refresh_prog ds in + let ds = Typer.infer_prog builtin_tys ds in + + (* monomorphize parsers first, so that any polymorphic events referenced by + parser bodies get concrete arg types in the duplicated parser copies *) + let ds = monomorphize_parsers builtin_tys ds in + + let ds = monomorphize_events builtin_tys ds in (* ensure all names are unique (TODO: should be taken care of inside the event / handler copying function) *) let renaming, ds = Renaming.rename ds in @@ -519,10 +547,6 @@ let eliminate_prog builtin_tys ds = let ds = Typer.infer_prog builtin_tys ds in let ds = RefreshTypes.refresh_prog ds in - (* print_endline "---------- Output decls -----------"; - Printing.decls_to_string ds |> print_endline; - print_endline "---------- Output decls -----------"; *) - (* exit 1; *) renaming, ds ;; From 3a98f3a2c44130c954a5ccbb5668ba72a5505c1e Mon Sep 17 00:00:00 2001 From: John Sonchack Date: Mon, 25 May 2026 09:20:43 -0400 Subject: [PATCH 04/49] clean up source routing example --- .../p4_bmv2_examples/source_routing/README.md | 32 ++- .../source_routing/source_routing.dpt | 196 ++++++------------ 2 files changed, 81 insertions(+), 147 deletions(-) diff --git a/examples/p4_bmv2_examples/source_routing/README.md b/examples/p4_bmv2_examples/source_routing/README.md index 0bf3b74d..2d28b60f 100644 --- a/examples/p4_bmv2_examples/source_routing/README.md +++ b/examples/p4_bmv2_examples/source_routing/README.md @@ -1,12 +1,10 @@ # `source_routing` -Packets with ether-type `0x1234` carry a *stack* of `(bos:1, port:15)` labels -between ethernet and IPv4. Each switch on the route reads the top label, -forwards on the encoded port, and pops the label. Whichever label has -`bos=1` marks the *last* hop — that switch strips the source-route header -entirely and emits the inner IPv4 packet plain. - -No tables. No control plane. The source route is in the packet. +Packets with ether-type 0x1234 carry a stack of {bos:1, port:15} labels +between ethernet and IPv4. Each switch on the route pops the top label +and forwards on the encoded port. The label with bos=1 marks the +last hop, which strips the source-route header and emits the inner +IPv4 packet plain. ## Files - [source_routing.dpt](source_routing.dpt) — the Lucid program. @@ -16,8 +14,8 @@ No tables. No control plane. The source route is in the packet. ## Running ```bash -/opt/anaconda3/bin/python3 gen_spec.py -../../../sources/lucid/dpt source_routing.dpt --spec source_routing.json --silent +python3 gen_spec.py +../../../dpt source_routing.dpt --spec source_routing.json --silent ``` ## Test cases (defined in `gen_spec.py`) @@ -52,13 +50,11 @@ source-route header. Specifically, sharing a single `zero` variable across two padding slots in an event constructor doesn't compile — each slot needs its own named local. (This was a 30-minute mystery the first time.) -- **Parser event args must be bare variables (or `Payload.parse(pkt)`).** +- **Parser event args must be bare variables, `Payload.parse(pkt)`, or tuples.** Literals, vector expressions, and record constructors in a parser-side - `generate(...)` all get rejected. Hoist them into locals first. - Discovered while trying to pass `[p0; p1; 0; 0]` as a single event arg. -- **Vectors in packet-event args don't survive slot analysis.** A field - of type `int<15>[4]` on a `packet event` lowers through vector→tuple→ - flat-args, and the analyzer trips on the flattened literal-zero - positions. Use explicit scalar fields instead. (Non-packet events - appear to handle vector args fine — see - `sources/lucid/examples/publications/popl22/starflow.dpt`.) \ No newline at end of file + `generate(...)` all get rejected for now. +- **Polymorphic tuples for generic handlers.** The combination of handlers + with polymorphic arguments and tuples make it clean to express + handlers that are generic to parts of the header stack. +- **Vectors in packet-event args do not currently work.** Use scalar + fields instead. Note: non-packet events handle vector args fine. \ No newline at end of file diff --git a/examples/p4_bmv2_examples/source_routing/source_routing.dpt b/examples/p4_bmv2_examples/source_routing/source_routing.dpt index cfec0289..a7159a6a 100644 --- a/examples/p4_bmv2_examples/source_routing/source_routing.dpt +++ b/examples/p4_bmv2_examples/source_routing/source_routing.dpt @@ -1,33 +1,25 @@ // Lucid port of the P4 "source_routing" tutorial. // -// Packets with ether-type 0x1234 carry a *stack* of (bos:1, port:15) labels -// between ethernet and IPv4. Each switch on the route reads the top label, -// forwards on the encoded port, and pops the label. Whichever label has -// bos=1 marks the *last* hop — that switch strips the source-route header -// and emits the inner IPv4 packet plain. +// Packets with ether-type 0x1234 carry a stack of {bos:1, port:15} labels +// between ethernet and IPv4. Each switch on the route pops the top label +// and forwards on the encoded port. The label with bos=1 marks the +// last hop, which strips the source-route header and emits the inner +// IPv4 packet plain. // -// Three structural differences from the P4 upstream: -// -// 1. **Non-recursive parsers.** Lucid parsers cannot self-call (see -// sources/lucid/src/lib/frontend/transformations/MonomorphicEventArgs.ml:253), -// so the P4 `parse_srcRouting → parse_srcRouting` self-loop is -// manually unrolled as a chain `sr_chain_0` .. `sr_chain_3`. MAX_HOPS -// is therefore a compile-time constant (here, 4) rather than runtime. +// This example shows: // +// 1. **Non-recursive parsers.** Lucid does not allow recursion in parsers, +// so parse_more_sr is unrolled manually. Note that we can take +// advantage of the fact that Lucid supports parser redeclarations +// to make unrolling (mostly) a copy-paste process. // 2. **No arithmetic in parsers.** We cannot `read` a 16-bit label and -// then mask off the bos bit inside the parser. Instead each label is -// split at the wire boundary: a 1-bit `read` for bos and a 15-bit -// `read` for port. Wire format is identical (16 bits per label, bos -// in the top bit). -// -// 3. **One event per stack depth.** Lucid's auto-deparser emits the -// event's full field list on egress, with no way to make the output -// length depend on a runtime value. So a single `sr_pkt(... ports[4], -// n_labels)` event can't produce a variable-length wire packet. We -// define `sr1`..`sr4`, one per supported depth, and the handler -// "pops" by re-emitting as the next-smaller variant. The terminal -// case (`sr1`) strips the source-route header entirely and emits a -// plain `ipv4_pkt` instead. +// then mask off the bos bit inside the parser. Instead, we read +// the structured wire format. +// 3. **Polymorphic tuples in packet events.** sr_in and sr_pkt +// use polymorphic tuple arguments ("auto sr_tail") to +// carry the tail of the the source routing header chain. +// This allows them to be generic with respect to all of the +// chain except the first record. const int<16> ETY_SRC_ROUTE = 0x1234; const int<16> ETY_IPV4 = 0x0800; @@ -53,36 +45,24 @@ type ipv4_t = { int<32> dst; } +type sr_t = { + int<1> bos; + int<15> p; +} + // -------- events --------------------------------------------------------- // -// One sr event per stack depth (1..4). The wire layout of each event is -// exactly (bos:1 + port:15) per label, then the IPv4 header and payload. -// b_i is always 0 except for the *last* label in each event, which has -// b_i = 1 (per the protocol). - -packet event sr1(eth_hdr_t eth, - int<1> b0, int<15> p0, - ipv4_t ip, Payload.t pl); -packet event sr2(eth_hdr_t eth, - int<1> b0, int<15> p0, - int<1> b1, int<15> p1, - ipv4_t ip, Payload.t pl); -packet event sr3(eth_hdr_t eth, - int<1> b0, int<15> p0, - int<1> b1, int<15> p1, - int<1> b2, int<15> p2, - ipv4_t ip, Payload.t pl); -packet event sr4(eth_hdr_t eth, - int<1> b0, int<15> p0, - int<1> b1, int<15> p1, - int<1> b2, int<15> p2, - int<1> b3, int<15> p3, - ipv4_t ip, Payload.t pl); + +packet event sr_bos(eth_hdr_t eth, sr_t sr, ipv4_t ip, Payload.t pl); +packet event sr_in(eth_hdr_t eth, sr_t sr, auto sr_tail, ipv4_t ip, Payload.t pl); // Final-hop emission: plain IPv4 packet with the source-route header // stripped. `{skip;}` means "no handler" — the event is only used as the // output of generate_port. packet event ipv4_pkt(eth_hdr_t eth, ipv4_t ip, Payload.t pl) {skip;} +// Intermediate hop emission: first sr shim popped off +packet event sr_pkt(eth_hdr_t eth, auto sr_tail, ipv4_t ip, Payload.t pl) {skip;} + // -------- handlers ------------------------------------------------------- // @@ -90,9 +70,8 @@ packet event ipv4_pkt(eth_hdr_t eth, ipv4_t ip, Payload.t pl) {skip;} // hop: rewrite ethertype, emit plain ipv4_pkt. For srN (N > 1), emit // srN-1 with the remaining labels. -handle sr1(eth_hdr_t eth, int<1> b0, int<15> p0, - ipv4_t ip, Payload.t pl) { - int<32> port = (int<32>)p0; +handle sr_bos(eth_hdr_t eth, sr_t sr, ipv4_t ip, Payload.t pl) { + int<32> port = (int<32>)(sr#p); eth_hdr_t new_eth = { dmac = eth#dmac; smac = eth#smac; @@ -100,103 +79,62 @@ handle sr1(eth_hdr_t eth, int<1> b0, int<15> p0, }; printf("sw %d port %d -> %d : sr_pop (last, strip header) ttl=%d", self, ingress_port, port, ip#ttl); + ipv4_t ip = {ip with ttl = ip#ttl - 1}; generate_port(port, ipv4_pkt(new_eth, ip, pl)); } -handle sr2(eth_hdr_t eth, int<1> b0, int<15> p0, - int<1> b1, int<15> p1, - ipv4_t ip, Payload.t pl) { - int<32> port = (int<32>)p0; - printf("sw %d port %d -> %d : sr_pop (remaining=1) ttl=%d", - self, ingress_port, port, ip#ttl); - generate_port(port, sr1(eth, b1, p1, ip, pl)); -} -handle sr3(eth_hdr_t eth, int<1> b0, int<15> p0, - int<1> b1, int<15> p1, - int<1> b2, int<15> p2, - ipv4_t ip, Payload.t pl) { - int<32> port = (int<32>)p0; - printf("sw %d port %d -> %d : sr_pop (remaining=2) ttl=%d", - self, ingress_port, port, ip#ttl); - generate_port(port, sr2(eth, b1, p1, b2, p2, ip, pl)); +handle sr_in(eth_hdr_t eth, sr_t sr, auto sr_tail, ipv4_t ip, Payload.t pl) { + int<32> port = (int<32>)(sr#p); + printf("sw %d port %d -> %d : sr_pop ttl=%d", + self, ingress_port, sr#p, ip#ttl); + ipv4_t ip = {ip with ttl = ip#ttl - 1}; + generate_port(port, sr_pkt(eth, sr_tail, ip, pl)); } -handle sr4(eth_hdr_t eth, int<1> b0, int<15> p0, - int<1> b1, int<15> p1, - int<1> b2, int<15> p2, - int<1> b3, int<15> p3, - ipv4_t ip, Payload.t pl) { - int<32> port = (int<32>)p0; - printf("sw %d port %d -> %d : sr_pop (remaining=3) ttl=%d", - self, ingress_port, port, ip#ttl); - generate_port(port, sr3(eth, b1, p1, b2, p2, b3, p3, ip, pl)); -} // -------- parser chain --------------------------------------------------- // -// Each step reads one (bos, port) label and either finalises (bos=1, -// generate srN where N is the number of labels accumulated so far + 1) -// or recurses into the next step. - -parser sr_chain_3(bitstring pkt, eth_hdr_t eth, - int<1> b0, int<15> q0, - int<1> b1, int<15> q1, - int<1> b2, int<15> q2) { - int<1> bos3 = read(pkt); - int<15> q3 = read(pkt); - match bos3 with - | 1 -> { - ipv4_t ip = read(pkt); - Payload.t pl = Payload.parse(pkt); - generate(sr4(eth, b0, q0, b1, q1, b2, q2, bos3, q3, ip, pl)); - } - | _ -> { drop; } +parser parse_ip(bitstring pkt, eth_hdr_t eth, sr_t sr_top, auto sr_tail) { + ipv4_t ip = read(pkt); + Payload.t pl = Payload.parse(pkt); + generate(sr_in(eth, sr_top, sr_tail, ip, pl)); } -parser sr_chain_2(bitstring pkt, eth_hdr_t eth, - int<1> b0, int<15> q0, - int<1> b1, int<15> q1) { - int<1> bos2 = read(pkt); - int<15> q2 = read(pkt); - match bos2 with - | 1 -> { - ipv4_t ip = read(pkt); - Payload.t pl = Payload.parse(pkt); - generate(sr3(eth, b0, q0, b1, q1, bos2, q2, ip, pl)); - } - | _ -> { sr_chain_3(pkt, eth, b0, q0, b1, q1, bos2, q2); } +parser parse_more_sr(bitstring pkt, eth_hdr_t eth, sr_t sr_top, auto sr_tail) { + sr_t sr = read(pkt); + match sr#bos with + | 1 -> { parse_ip(pkt, eth, sr_top, (sr_tail, sr)); } + | 0 -> { drop; } } - -parser sr_chain_1(bitstring pkt, eth_hdr_t eth, - int<1> b0, int<15> q0) { - int<1> bos1 = read(pkt); - int<15> q1 = read(pkt); - match bos1 with - | 1 -> { - ipv4_t ip = read(pkt); - Payload.t pl = Payload.parse(pkt); - generate(sr2(eth, b0, q0, bos1, q1, ip, pl)); - } - | _ -> { sr_chain_2(pkt, eth, b0, q0, bos1, q1); } +parser parse_more_sr(bitstring pkt, eth_hdr_t eth, sr_t sr_top, auto sr_tail) { + sr_t sr = read(pkt); + match sr#bos with + | 1 -> { parse_ip(pkt, eth, sr_top, (sr_tail, sr)); } + | 0 -> { parse_more_sr(pkt, eth, sr_top, (sr_tail, sr)); } +} +parser parse_more_sr(bitstring pkt, eth_hdr_t eth, sr_t sr_top, auto sr_tail) { + sr_t sr = read(pkt); + match sr#bos with + | 1 -> { parse_ip(pkt, eth, sr_top, (sr_tail, sr)); } + | 0 -> { parse_more_sr(pkt, eth, sr_top, (sr_tail, sr)); } } +parser parse_sr(bitstring pkt, eth_hdr_t eth) { // eth | sr + sr_t sr = read(pkt); + match sr#bos with + | 1 -> { + ipv4_t ip = read(pkt); + Payload.t pl = Payload.parse(pkt); + generate(sr_bos(eth, sr, ip, pl)); + } + | _ -> { parse_more_sr(pkt, eth, sr, ()); } -parser sr_chain_0(bitstring pkt, eth_hdr_t eth) { - int<1> bos0 = read(pkt); - int<15> q0 = read(pkt); - match bos0 with - | 1 -> { - ipv4_t ip = read(pkt); - Payload.t pl = Payload.parse(pkt); - generate(sr1(eth, bos0, q0, ip, pl)); - } - | _ -> { sr_chain_1(pkt, eth, bos0, q0); } } parser main(bitstring pkt) { eth_hdr_t eth = read(pkt); match eth#ety with | LUCID_ETHERTY -> { do_lucid_parsing(pkt); } - | 0x1234 -> { sr_chain_0(pkt, eth); } + | 0x1234 -> { parse_sr(pkt, eth); } | _ -> { drop; } } From 3c56ab61c8c0c4ed90499a0d1bcb008018c7d48f Mon Sep 17 00:00:00 2001 From: John Sonchack Date: Tue, 26 May 2026 09:18:16 -0400 Subject: [PATCH 05/49] clean up ETuple global typing and source routing example --- .../source_routing/source_routing.dpt | 19 ++-- src/lib/frontend/typing/Typer.ml | 104 ++++++------------ 2 files changed, 45 insertions(+), 78 deletions(-) diff --git a/examples/p4_bmv2_examples/source_routing/source_routing.dpt b/examples/p4_bmv2_examples/source_routing/source_routing.dpt index a7159a6a..3ae18594 100644 --- a/examples/p4_bmv2_examples/source_routing/source_routing.dpt +++ b/examples/p4_bmv2_examples/source_routing/source_routing.dpt @@ -30,6 +30,11 @@ type eth_hdr_t = { int<16> ety; } +type sr_t = { + int<1> bos; + int<15> p; +} + type ipv4_t = { int<4> version; int<4> ihl; @@ -45,10 +50,6 @@ type ipv4_t = { int<32> dst; } -type sr_t = { - int<1> bos; - int<15> p; -} // -------- events --------------------------------------------------------- // @@ -66,10 +67,8 @@ packet event sr_pkt(eth_hdr_t eth, auto sr_tail, ipv4_t ip, Payload.t pl) {skip; // -------- handlers ------------------------------------------------------- // -// Each handler pops the head label (b0, p0). For sr1 we're at the last -// hop: rewrite ethertype, emit plain ipv4_pkt. For srN (N > 1), emit -// srN-1 with the remaining labels. +// Bottom of stack: decap IP packet and forward handle sr_bos(eth_hdr_t eth, sr_t sr, ipv4_t ip, Payload.t pl) { int<32> port = (int<32>)(sr#p); eth_hdr_t new_eth = { @@ -83,8 +82,8 @@ handle sr_bos(eth_hdr_t eth, sr_t sr, ipv4_t ip, Payload.t pl) { generate_port(port, ipv4_pkt(new_eth, ip, pl)); } - -handle sr_in(eth_hdr_t eth, sr_t sr, auto sr_tail, ipv4_t ip, Payload.t pl) { +// Not bottom of stack: pop first source route hdr and forward +handle sr_intermediate(eth_hdr_t eth, sr_t sr, auto sr_tail, ipv4_t ip, Payload.t pl) { int<32> port = (int<32>)(sr#p); printf("sw %d port %d -> %d : sr_pop ttl=%d", self, ingress_port, sr#p, ip#ttl); @@ -93,7 +92,7 @@ handle sr_in(eth_hdr_t eth, sr_t sr, auto sr_tail, ipv4_t ip, Payload.t pl) { } -// -------- parser chain --------------------------------------------------- +// -------- parsers ------------------------------------------------------- // parser parse_ip(bitstring pkt, eth_hdr_t eth, sr_t sr_top, auto sr_tail) { ipv4_t ip = read(pkt); diff --git a/src/lib/frontend/typing/Typer.ml b/src/lib/frontend/typing/Typer.ml index bb17eea7..d33ce8d3 100644 --- a/src/lib/frontend/typing/Typer.ml +++ b/src/lib/frontend/typing/Typer.ml @@ -154,26 +154,8 @@ let rec infer_exp (env : env) (e : exp) : env * exp = @@ !(fty.constraints) in new_env, { e with e = ECall (f, inferred_args, unordered); ety = Some fty.ret_ty } - (* Special case for action constructor. TODO: make actions constructors just be functions *) | TActionConstr(_) -> ( failwith "TActionConstr is not expected to ever be reached" - (* let env, inferred_args = infer_exps env args in - let fty : acn_ctor_ty = - { aconst_param_tys = List.map (fun arg -> Option.get arg.ety) inferred_args - ; aacn_ty = { - aarg_tys = List.init (List.length acn_ctor_ty.aacn_ty.aarg_tys) (fun _ -> fresh_type ()); - aret_tys = List.init (List.length acn_ctor_ty.aacn_ty.aret_tys) (fun _ -> fresh_type ());} - } - in - unify_raw_ty e.espan (TActionConstr fty) inferred_fty.raw_ty; - let aacn_ty = { - aarg_tys = List.map strip_links fty.aacn_ty.aarg_tys; - aret_tys = List.map strip_links fty.aacn_ty.aret_tys; - } - in - let acn_ty = ty@@TAction (aacn_ty) in - let acn_ty = strip_links acn_ty in - env, { e with e = ECall (f, inferred_args, unordered); ety = Some (acn_ty) } *) ) | _ -> error_sp e.espan "Cannot call non-function" ) @@ -204,6 +186,9 @@ let rec infer_exp (env : env) (e : exp) : env * exp = else inst ty | None -> error_sp e.espan @@ "Unknown label " ^ List.hd labels ^" in record exp: "^(Printing.exp_to_string e) in + (* mk_ty wraps the type with a fresh, unconstrained effect, + which is fine because there are no effectful globals + (would produce an error in expected_ty above) *) let inf_ety = TRecord (List.map2 (fun l e -> l, (Option.get e.ety).raw_ty) labels inf_es) @@ -248,66 +233,49 @@ let rec infer_exp (env : env) (e : exp) : env * exp = inf_entries; env, { e with e = EWith (inf_base, inf_entries); ety = Some expected_ty } | ETuple es -> - let env, inf_es = infer_exps env es in + let env, inf_es = infer_exps env es in (* infer the types and effects of each inner element of the tuple*) + (* form check *) + List.iter + (fun e' -> + if (not env.in_global_def) && is_global (Option.get e'.ety) + then error_sp e'.espan "Cannot dynamically create tuples containing global types") + inf_es; + (* effect unification *) + (* This is a vestigial. *) + (* It checks that effect ordering is preserved internally, + which only blocks programs with global tuples constructed + from other globals in the rhs constructor expression. + But this is not the right place to catch such programs, e.g., + the ERecord and EVector cases let them through anyways. *) let tuple_eff = fresh_effect () in List.iteri (fun i e' -> - if (not env.in_global_def) && is_global (Option.get e'.ety) - then - error_sp - e'.espan - "Cannot dynamically create tuples containing global types" - else ( - (* This commented out code was a workaround to get unification to work - for tuple expressions that contained elements from other tuples. - The problem was that: tup foo = (bar.1, bar.2) failed to unify, - because it tried to unify the effect of foo.0 with bar.1, causing - it to attempt unification of FSucc(FProj()) with FProj(). - The workaround is to use the effect of the gotten index, rather - than the index written to. That is acceptable because - it is illegal to dynamically construct tuples of global types, - which are the only tuples with effects that matter. - - An attempted alternative solution was to add a case in TyperUnify.try_unify_effect: - | FProj(FVar(tqv)), eff | eff, FProj(FVar(tqv)) -> ... - I thought this solved the problem because in such a case, one of the sides - is going to be a variable. And it is safe because projecting - does not have an effect itself. - However, that change did not solve the problem, so the workaround remains. - *) - let expected = match (e'.e) with - | EOp(TGet(_, idx), _) -> wrap_effect tuple_eff [None, 0; None, idx] - | _ -> wrap_effect tuple_eff [None, 0; None, i] - in - (* let expected = wrap_effect tuple_eff [None, 0; None, i] in *) - let derived = (Option.get e'.ety).teffect in - unify_effect e.espan expected derived - ) - ) - inf_es; + if is_global (Option.get e'.ety) then ( + let expected = wrap_effect tuple_eff [None, 0; None, i] in + unify_effect e.espan expected (Option.get e'.ety).teffect)) + inf_es; let final_ety = - ty_eff (TTuple (List.map (fun e -> (Option.get e.ety).raw_ty) inf_es)) tuple_eff + TTuple (List.map (fun e -> (Option.get e.ety).raw_ty) inf_es) |> mk_ty in env, { e with e = ETuple inf_es; ety = Some final_ety } - - | EVector es -> let env, inf_es = infer_exps env es in - let ety = fresh_type () in - List.iteri - (fun i e' -> + (* form check *) + List.iter + (fun e' -> if (not env.in_global_def) && is_global (Option.get e'.ety) - then - error_sp - e'.espan - "Cannot dynamically create vectors containing global types" - else ( - let expected = - { ety with teffect = wrap_effect ety.teffect [None, 0; None, i] } - in - unify_ty e.espan expected (Option.get e'.ety))) + then error_sp e'.espan "Cannot dynamically create vectors containing global types") inf_es; - let final_ety = TVector (ety.raw_ty, IConst (List.length es)) |> mk_ty in + (* type unification *) + let fresh_ety = fresh_type () in + List.iteri + (fun i e' -> + let expected = + { fresh_ety with teffect = wrap_effect fresh_ety.teffect [None, 0; None, i] } + in + unify_ty e.espan expected (Option.get e'.ety)) + inf_es; + let final_ety = TVector (fresh_ety.raw_ty, IConst (List.length es)) |> mk_ty in env, { e with e = EVector inf_es; ety = Some final_ety } | EIndex (e1, IUser (Id idx)) -> let env, inf_e1, inf_e1ty = infer_exp env e1 |> textract in From 8f70aaa2352e540284608df5b71a72e3e456864f Mon Sep 17 00:00:00 2001 From: John Sonchack Date: Sat, 6 Jun 2026 15:41:23 -0400 Subject: [PATCH 06/49] clean up tuple type syntax; add simple 'rec' parser replicating annotation/macro --- .../misc/regression/global_containers.dpt | 26 ++++++ .../source_routing/source_routing.dpt | 30 ++----- src/lib/dune | 1 + src/lib/frontend/FrontendPipeline.ml | 2 + src/lib/frontend/Lexer.mll | 7 +- src/lib/frontend/Parser.mly | 64 ++++--------- .../transformations/UnrollRecursiveParsers.ml | 89 +++++++++++++++++++ 7 files changed, 143 insertions(+), 76 deletions(-) create mode 100644 examples/misc/regression/global_containers.dpt create mode 100644 src/lib/frontend/transformations/UnrollRecursiveParsers.ml diff --git a/examples/misc/regression/global_containers.dpt b/examples/misc/regression/global_containers.dpt new file mode 100644 index 00000000..f1e3123f --- /dev/null +++ b/examples/misc/regression/global_containers.dpt @@ -0,0 +1,26 @@ +// test aliasing globals in various containers (records, vectors, tuples) +type my_t = { + Array.t<32> x; + Array.t<32> y; +} +global my_t rec_arrs1 = {x = Array.create(8); y = Array.create(8)}; +global Array.t<32>[auto] arrs1 = [Array.create(8); Array.create(8)]; +global (Array.t<32>, Array.t<32>) tup_arrs1 = (Array.create(8), Array.create(8)); +global Array.t<32> garr1 = Array.create(8); + +event main(int x, int y) { + auto foo1 = rec_arrs1#x; + Array.set(foo1, 0, 0); + auto foo2 = rec_arrs1#y; + Array.set(foo2, 0, 0); + auto foo3 = arrs1[0]; + Array.set(foo3, 0, 0); + auto foo4 = arrs1[1]; + Array.set(foo4, 0, 0); + auto foo5 = tup_arrs1#0; + Array.set(foo5, 0, 0); + auto foo6 = tup_arrs1#1; + Array.set(foo6, 0, 0); + auto foo7 = garr1; + Array.set(foo7, 0, 0); +} diff --git a/examples/p4_bmv2_examples/source_routing/source_routing.dpt b/examples/p4_bmv2_examples/source_routing/source_routing.dpt index 3ae18594..35d60283 100644 --- a/examples/p4_bmv2_examples/source_routing/source_routing.dpt +++ b/examples/p4_bmv2_examples/source_routing/source_routing.dpt @@ -54,8 +54,8 @@ type ipv4_t = { // -------- events --------------------------------------------------------- // -packet event sr_bos(eth_hdr_t eth, sr_t sr, ipv4_t ip, Payload.t pl); -packet event sr_in(eth_hdr_t eth, sr_t sr, auto sr_tail, ipv4_t ip, Payload.t pl); +packet event sr_last(eth_hdr_t eth, sr_t sr, ipv4_t ip, Payload.t pl); +packet event sr_hop(eth_hdr_t eth, sr_t sr, auto sr_tail, ipv4_t ip, Payload.t pl); // Final-hop emission: plain IPv4 packet with the source-route header // stripped. `{skip;}` means "no handler" — the event is only used as the @@ -69,7 +69,7 @@ packet event sr_pkt(eth_hdr_t eth, auto sr_tail, ipv4_t ip, Payload.t pl) {skip; // // Bottom of stack: decap IP packet and forward -handle sr_bos(eth_hdr_t eth, sr_t sr, ipv4_t ip, Payload.t pl) { +handle sr_last(eth_hdr_t eth, sr_t sr, ipv4_t ip, Payload.t pl) { int<32> port = (int<32>)(sr#p); eth_hdr_t new_eth = { dmac = eth#dmac; @@ -83,7 +83,7 @@ handle sr_bos(eth_hdr_t eth, sr_t sr, ipv4_t ip, Payload.t pl) { } // Not bottom of stack: pop first source route hdr and forward -handle sr_intermediate(eth_hdr_t eth, sr_t sr, auto sr_tail, ipv4_t ip, Payload.t pl) { +handle sr_hop(eth_hdr_t eth, sr_t sr, auto sr_tail, ipv4_t ip, Payload.t pl) { int<32> port = (int<32>)(sr#p); printf("sw %d port %d -> %d : sr_pop ttl=%d", self, ingress_port, sr#p, ip#ttl); @@ -91,40 +91,28 @@ handle sr_intermediate(eth_hdr_t eth, sr_t sr, auto sr_tail, ipv4_t ip, Payload. generate_port(port, sr_pkt(eth, sr_tail, ip, pl)); } - // -------- parsers ------------------------------------------------------- // parser parse_ip(bitstring pkt, eth_hdr_t eth, sr_t sr_top, auto sr_tail) { ipv4_t ip = read(pkt); Payload.t pl = Payload.parse(pkt); - generate(sr_in(eth, sr_top, sr_tail, ip, pl)); -} - -parser parse_more_sr(bitstring pkt, eth_hdr_t eth, sr_t sr_top, auto sr_tail) { - sr_t sr = read(pkt); - match sr#bos with - | 1 -> { parse_ip(pkt, eth, sr_top, (sr_tail, sr)); } - | 0 -> { drop; } + generate(sr_hop(eth, sr_top, sr_tail, ip, pl)); } -parser parse_more_sr(bitstring pkt, eth_hdr_t eth, sr_t sr_top, auto sr_tail) { - sr_t sr = read(pkt); - match sr#bos with - | 1 -> { parse_ip(pkt, eth, sr_top, (sr_tail, sr)); } - | 0 -> { parse_more_sr(pkt, eth, sr_top, (sr_tail, sr)); } -} -parser parse_more_sr(bitstring pkt, eth_hdr_t eth, sr_t sr_top, auto sr_tail) { +// unroll 3 times, with the base case invoking drop +@rec(3, drop) parser parse_more_sr(bitstring pkt, eth_hdr_t eth, sr_t sr_top, auto sr_tail) { sr_t sr = read(pkt); match sr#bos with | 1 -> { parse_ip(pkt, eth, sr_top, (sr_tail, sr)); } | 0 -> { parse_more_sr(pkt, eth, sr_top, (sr_tail, sr)); } } + parser parse_sr(bitstring pkt, eth_hdr_t eth) { // eth | sr sr_t sr = read(pkt); match sr#bos with | 1 -> { ipv4_t ip = read(pkt); Payload.t pl = Payload.parse(pkt); - generate(sr_bos(eth, sr, ip, pl)); + generate(sr_last(eth, sr, ip, pl)); } | _ -> { parse_more_sr(pkt, eth, sr, ()); } diff --git a/src/lib/dune b/src/lib/dune index 8f8c18ef..14dd3a2c 100644 --- a/src/lib/dune +++ b/src/lib/dune @@ -56,6 +56,7 @@ memops wellformed eventFormat + unrollRecursiveParsers functionInlining tableInlining sizeInlining diff --git a/src/lib/frontend/FrontendPipeline.ml b/src/lib/frontend/FrontendPipeline.ml index 7df265f9..6d532190 100644 --- a/src/lib/frontend/FrontendPipeline.ml +++ b/src/lib/frontend/FrontendPipeline.ml @@ -24,6 +24,7 @@ let process_prog ?(opts=def_opts) builtin_tys ds = Wellformed.pre_typing_checks ~handlers:opts.match_event_handlers ds; print_if_debug ds; let ds = EventFormat.set_event_nums ds in + let ds = UnrollRecursiveParsers.apply ds in print_if_verbose "---------typing1---------"; let ds = Typer.infer_prog builtin_tys ds in let ds = GlobalConstructorTagging.annotate ds in @@ -119,6 +120,7 @@ let process_prog ?(opts=def_opts) builtin_tys ds = let ds = Typer.infer_prog builtin_tys ds in print_if_verbose "-------Eliminating tuples-------"; let ds = TupleElimination.eliminate_prog ds in + let ds = RefreshTypes.refresh_prog ds in print_if_debug ds; print_if_verbose "---------------typing9-------------"; let ds = Typer.infer_prog builtin_tys ds in diff --git a/src/lib/frontend/Lexer.mll b/src/lib/frontend/Lexer.mll index 7069bd8e..5c1b09e0 100644 --- a/src/lib/frontend/Lexer.mll +++ b/src/lib/frontend/Lexer.mll @@ -50,7 +50,6 @@ rule token = parse | "else" { ELSE (position lexbuf) } | "int" { TINT (position lexbuf) } | "bool" { TBOOL (position lexbuf) } - | "tuple" { TUPLE (position lexbuf) } | "event" { EVENT (position lexbuf) } | "generate" { GENERATE (position lexbuf) } | "generate_switch" { SGENERATE (position lexbuf) } @@ -75,16 +74,12 @@ rule token = parse | "@egress" { EGRESS (position lexbuf) } | "@"(num as n) { ANNOT (position lexbuf, Int.of_string n) } | "@main" { MAIN (position lexbuf) } + | "@rec" { REC (position lexbuf) } | "packet" { PACKET (position lexbuf) } | "match" { MATCH (position lexbuf) } | "with" { WITH (position lexbuf) } | "type" { TYPE (position lexbuf) } | "noinline" { NOINLINE (position lexbuf) } - - | "table_type" { TABLE_TYPE (position lexbuf) } - | "key_type:" { KEY_TYPE (position lexbuf) } - | "arg_type:" { ARG_TYPE (position lexbuf) } - | "ret_type:" { RET_TYPE (position lexbuf) } | "action_constr" { ACTION_CONSTR (position lexbuf) } | "action" { ACTION (position lexbuf) } | "table_create" { TABLE_CREATE (position lexbuf) } diff --git a/src/lib/frontend/Parser.mly b/src/lib/frontend/Parser.mly index 9b36f712..d6acb4b6 100644 --- a/src/lib/frontend/Parser.mly +++ b/src/lib/frontend/Parser.mly @@ -120,7 +120,7 @@ %token COMMA %token DOT %token TBOOL -%token TUPLE +// %token TUPLE %token EVENT %token GENERATE %token SGENERATE @@ -137,6 +137,7 @@ %token EGRESS %token MAIN %token PACKET +%token REC %token ANNOT %token MATCH %token WITH @@ -146,10 +147,6 @@ %token TYPE %token NOINLINE -%token TABLE_TYPE -%token KEY_TYPE -%token ARG_TYPE -%token RET_TYPE %token ACTION %token ACTION_CONSTR %token TABLE_CREATE @@ -200,10 +197,8 @@ %right NOT FLOOD BITNOT RPAREN %right LBRACKET /* highest precedence */ - /* FIXME: the RPAREN thing is a hack to make casting work, and I'm not even sure it's correct Same with LBRACKET. */ - %% ty: @@ -213,10 +208,9 @@ ty: | QID { ty_sp (TQVar (QVar (snd $1))) (fst $1) } | AUTO { ty_sp (TQVar (QVar (fresh_auto ()))) $1 } | cid { ty_sp (TName (snd $1, [], true)) (fst $1) } - | TUPLE ty_poly { - let raw_tys = List.map (fun ty -> ty.raw_ty) (snd $2) in - ty_sp (TTuple (raw_tys)) (Span.extend $1 (fst $2)) } - + // | TUPLE ty_poly { + // let raw_tys = List.map (fun ty -> ty.raw_ty) (snd $2) in + // ty_sp (TTuple (raw_tys)) (Span.extend $1 (fst $2)) } | cid poly { ty_sp (TName (snd $1, snd $2, true)) (fst $1) } | cid ty_poly { @@ -230,6 +224,10 @@ ty: | LBRACE record_def RBRACE { ty_sp (mk_trecord $2) (Span.extend $1 $3) } | ty LBRACKET size RBRACKET { ty_sp (TVector ($1.raw_ty, snd $3)) (Span.extend $1.tspan $4) } | BITSTRING { ty_sp TBitstring ($1)} + | LPAREN RPAREN { ty_sp (TTuple([])) (Span.extend $1 $2) } + | LPAREN ty COMMA tys RPAREN { + let raw_tys = List.map (fun ty -> ty.raw_ty) ($2 :: (snd $4)) in + ty_sp (TTuple raw_tys) (Span.extend $1 $5) } tys: | ty { $1.tspan, [ $1 ] } @@ -263,27 +261,8 @@ poly: single_poly: | LESS size MORE { Span.extend $1 $3, snd $2 } -ty_or_empty_tuple: - | ty { $1 } - | LPAREN RPAREN { ty_sp (TTuple([])) (Span.extend $1 $2) } - /* Parenthesized comma-form tuple type, e.g. `(int<48>, int<32>)`. Only - legal inside `<<...>>` slots (Table.t key/data/arg/ret) because that's - the only place `ty_or_empty_tuple` is used. Requires at least two - element types so `(t)` continues to mean a parenthesized single ty, - not a 1-tuple. Avoids the lexer-greedy `>>` issue that `tuple<<...>>` - runs into when the inner type ends in `>`. */ - | LPAREN ty COMMA tys RPAREN { - let raw_tys = List.map (fun ty -> ty.raw_ty) ($2 :: (snd $4)) in - ty_sp (TTuple raw_tys) (Span.extend $1 $5) } - -ty_polys: - | ty_or_empty_tuple { [$1] } - | ty_or_empty_tuple COMMA ty_polys { $1::$3 } - ty_poly: - | LSHIFT ty_polys RSHIFT { Span.extend $1 $3, $2 } - - + | LSHIFT tys RSHIFT { $2 } paren_args: | LPAREN RPAREN { Span.extend $1 $2, [] } @@ -467,22 +446,6 @@ tyname_def: | ID { snd $1, [] } | ID poly { snd $1, snd $2} -ty_args: - | LPAREN tys RPAREN { (Span.extend $1 $3, snd $2) } - | LPAREN RPAREN { (Span.extend $1 $2, []) } - | ty { ($1.tspan, [ $1 ]) } - -dt_table: - | ID ASSIGN LBRACE - KEY_TYPE ty_args - ARG_TYPE ty_args - RET_TYPE ty RBRACE - { duty_sp - (snd $1) - [] - (mk_t_table (snd $5) (snd $7) [$9] (Span.extend $3 $10)) - (Span.extend (fst $1) $10) } - // an expression that can appear as the lhs of an assign in the parser lexp: | cid { var_sp (snd $1) (fst $1) } @@ -553,9 +516,12 @@ decl: | GLOBAL ty ID ASSIGN exp SEMI { [dglobal_sp (snd $3) $2 $5 (Span.extend $1 $6)] } - | TABLE_TYPE dt_table { [$2] } + // | TABLE_TYPE dt_table { [$2] } | PARSER ID paramsdef LBRACE parser_block RBRACE { [mk_dparser (snd $2) $3 $5 (Span.extend $1 $6)] } - + | REC LPAREN NUM COMMA DROP RPAREN decl + { match $7 with + | [d] -> [{ d with dpragmas = Pragma.sprag "rec" [Z.to_string (snd $3); "drop"] :: d.dpragmas }] + | _ -> error "parsing error: invalid use of @rec" } decls: | decl { $1 } diff --git a/src/lib/frontend/transformations/UnrollRecursiveParsers.ml b/src/lib/frontend/transformations/UnrollRecursiveParsers.ml new file mode 100644 index 00000000..9d9a4f69 --- /dev/null +++ b/src/lib/frontend/transformations/UnrollRecursiveParsers.ml @@ -0,0 +1,89 @@ +open Batteries +open Syntax +open SyntaxUtils +open Collections + +(* Unroll recursive parsers: + @rec(2, drop) parser foo... + becomes + parser foo ... { drop; } + parser foo ... { foo; } + parser foo ... { foo; } + placed one after another, which works fine in the rest of the pipeline +*) + + + + +let replacer = + object (self) + inherit [_] s_map as super + + val mutable new_pre_decls = [] (* new decls to add before current *) + + method! visit_decl env decl = + (* check if it is a parser with the recursive pragma *) + match decl.d, Pragma.find_sprag "rec" decl.dpragmas with + | DParser (id, params, _), Some (_, [n_str; fcn_name]) -> + (* @rec(n, fcn_name) on parser [id]: the two args are + n_str -- the recursion count, as a string (e.g. "3") + fcn_name -- base case -- must be id "drop" for now *) + let n = int_of_string n_str in + if (not (fcn_name = "drop")) then + failwith + (Printf.sprintf + "@rec annotation on parser %s expects base case to be 'drop', but got '%s'" + (Id.name id) + (fcn_name)); + (* the unrolled parsers are no longer recursive, so drop the @rec pragma + (keeping any other pragmas the original carried) *) + let strip_rec d = + { d with + dpragmas = + List.filter (fun p -> not (Pragma.exists_sprag "rec" [p])) d.dpragmas } + in + (* 1. base case parser: same signature, body is just `drop;`. Goes first. *) + let base_block = ([], (PDrop, decl.dspan)) in + let base_decl = { (strip_rec decl) with d = DParser (id, params, base_block) } in + (* 2. n-1 verbatim copies of the original parser, after the base case *) + let copies = List.init (max 0 (n - 1)) (fun _ -> strip_rec decl) in + new_pre_decls <- base_decl :: copies; + (* 3. original parser, with @rec removed *) + strip_rec decl + | DParser (id, _, _), Some (_, args) -> + (* malformed @rec: expected exactly (int, identifier) *) + failwith + (Printf.sprintf + "@rec on parser %s expects (int, identifier), but got %d args" + (Id.name id) + (List.length args)) + | _ -> super#visit_decl env decl + + + method! visit_decls env ds = + match ds with + | [] -> [] + | d :: rest -> + new_pre_decls <- []; + let d' = self#visit_decl env d in + let pre = new_pre_decls in + new_pre_decls <- []; + let rest' = self#visit_decls env rest in + pre @ (d' :: rest') + + (* method! visit_DSize env id sz = + let sz = Option.get sz in + let sz = self#visit_size env sz in + env := CidMap.add (Id id) sz !env; + (* We will filter this declaration later *) + DSize (id, Some sz) + + method! visit_IUser env cid = + match CidMap.find_opt cid !env with + | Some sz -> sz + | None -> IUser cid *) + end +;; + +let apply ds = replacer#visit_decls () ds +;; From 39e795d1aa2e8165f7840c08d617f7de38a9a319 Mon Sep 17 00:00:00 2001 From: John Sonchack Date: Sat, 6 Jun 2026 15:52:29 -0400 Subject: [PATCH 07/49] remove a number of depreciated table-related builtins from the parser --- examples/interp_tests/control_commands.dpt | 25 +++------- src/lib/frontend/Lexer.mll | 5 -- src/lib/frontend/Parser.mly | 54 ---------------------- 3 files changed, 6 insertions(+), 78 deletions(-) diff --git a/examples/interp_tests/control_commands.dpt b/examples/interp_tests/control_commands.dpt index 7de55605..fd1af1ea 100644 --- a/examples/interp_tests/control_commands.dpt +++ b/examples/interp_tests/control_commands.dpt @@ -8,30 +8,17 @@ type res_t = { bool is_hit; } -// action res_t hit_acn(int x)(int a) { -// return {val = x; is_hit = true}; -// } - -action_constr hit_acn(int x) = { - return action res_t anon(int a) { - return {val = x; is_hit = true}; - }; -}; - -// action res_t miss_acn(int x)(int a) { -// return {val = x; is_hit = false}; -// } +action res_t hit_acn(int x)(int a) { + return {val = x; is_hit = true}; +} -action_constr miss_acn(int x) = { - return action res_t anon(int a) { - return {val = x; is_hit = false}; - }; -}; +action res_t miss_acn(int x)(int a) { + return {val = x; is_hit = false}; +} // extend parsing to not need parens around single element tuples global Table.t<> ftbl = Table.create(1024, [hit_acn; miss_acn], miss_acn, 0); - event pktin(int src, int dst) { Array.set(myarr, 0, dst); res_t tbl_result = Table.lookup(ftbl, dst, 1234); diff --git a/src/lib/frontend/Lexer.mll b/src/lib/frontend/Lexer.mll index 5c1b09e0..87bf6231 100644 --- a/src/lib/frontend/Lexer.mll +++ b/src/lib/frontend/Lexer.mll @@ -80,12 +80,7 @@ rule token = parse | "with" { WITH (position lexbuf) } | "type" { TYPE (position lexbuf) } | "noinline" { NOINLINE (position lexbuf) } - | "action_constr" { ACTION_CONSTR (position lexbuf) } | "action" { ACTION (position lexbuf) } - | "table_create" { TABLE_CREATE (position lexbuf) } - | "table_match" { TABLE_MATCH (position lexbuf) } - | "table_install" { TABLE_INSTALL (position lexbuf) } - | "table_multi_install" { TABLE_MULTI_INSTALL (position lexbuf) } | "parser" { PARSER (position lexbuf) } | "read" { READ (position lexbuf) } diff --git a/src/lib/frontend/Parser.mly b/src/lib/frontend/Parser.mly index d6acb4b6..92bb6b79 100644 --- a/src/lib/frontend/Parser.mly +++ b/src/lib/frontend/Parser.mly @@ -148,11 +148,6 @@ %token NOINLINE %token ACTION -%token ACTION_CONSTR -%token TABLE_CREATE -%token TABLE_MATCH -%token TABLE_INSTALL -%token TABLE_MULTI_INSTALL %token PATAND %token PARSER @@ -208,10 +203,6 @@ ty: | QID { ty_sp (TQVar (QVar (snd $1))) (fst $1) } | AUTO { ty_sp (TQVar (QVar (fresh_auto ()))) $1 } | cid { ty_sp (TName (snd $1, [], true)) (fst $1) } - // | TUPLE ty_poly { - // let raw_tys = List.map (fun ty -> ty.raw_ty) (snd $2) in - // ty_sp (TTuple (raw_tys)) (Span.extend $1 (fst $2)) } - | cid poly { ty_sp (TName (snd $1, snd $2, true)) (fst $1) } | cid ty_poly { let raw_tys = List.map (fun ty -> ty.raw_ty) (snd $2) in @@ -320,8 +311,6 @@ exp: | SUB exp { op_sp Neg [$2] (Span.extend $1 $2.espan) } | BITNOT exp { op_sp BitNot [$2] (Span.extend $1 $2.espan) } | HASH single_poly LPAREN args RPAREN { hash_sp (snd $2) $4 (Span.extend $1 $5) } - - | PATCAST LPAREN exp RPAREN { op_sp PatExact [$3] (Span.extend $1 $4)} @@ -341,17 +330,6 @@ exp: | SIZECAST single_poly LPAREN size RPAREN { szcast_sp (snd $2) (snd $4) (Span.extend $1 $5) } | FLOOD exp { flood_sp $2 (Span.extend $1 $2.espan) } | LBRACE args RBRACE { make_group $2 (Span.extend $1 $3) } - | TABLE_CREATE LESS tbl_ty=ty MORE LPAREN - actions=exp COMMA - n_entries=exp COMMA - default_action_call=exp // default action initialized with compile time arguments - RPAREN - { make_create_table tbl_ty (unpack_tuple actions) (n_entries) (default_action_call) (Span.extend $1 $11) } - | TABLE_MATCH - LPAREN tbl=exp COMMA - keys=exp COMMA - args=exp - RPAREN { tblmatch_sp tbl (unpack_tuple keys) (unpack_tuple args) (Span.extend $1 $8)} | paren_exp { $1 } // an expression with a parenthesis is a tuple, unless its a single-element tuple, in which case its just the element. @@ -383,10 +361,6 @@ args: | exp { [$1] } | exp COMMA args { $1::$3 } -opt_args: - | LPAREN args RPAREN { Span.extend $1 $3, $2} - | LPAREN RPAREN { Span.extend $1 $2, []} - paramsdef: | LPAREN RPAREN { [] } | LPAREN params RPAREN { $2 } @@ -496,8 +470,6 @@ decl: { match $2 with | [decl] -> [{decl with dpragmas = [Pragma.sprag "main" []]}] | _ -> error "parsing error: invalid use of @main"} - | ACTION_CONSTR ID constr_params=paramsdef ASSIGN LBRACE RETURN ACTION ty=ty ID acn_params=paramsdef LBRACE acn_body=statement RBRACE SEMI RBRACE SEMI - { [mk_daction_ctor (snd $2) [ty] constr_params acn_params acn_body (Span.extend $1 $16)]} | ACTION ty=ty ID install_params=paramsdef match_params=paramsdef LBRACE acn_body=statement RBRACE { [mk_daction_ctor (snd $3) [ty] install_params match_params acn_body (Span.extend $1 $8)]} @@ -563,28 +535,6 @@ branches: | branch { fst $1, [snd $1] } | branch branches { Span.extend (fst $1) (fst $2), (snd $1::snd $2) } -table_entry: - (* an entry with no priority *) - | pats=opt_args ARROW ID args=opt_args - { - let pats_span, pats = pats in - let pats = List.map cast_int_pats pats in - Span.extend (pats_span) (fst args), - mk_entry 50 (pats) (snd $3) (snd args) (Span.extend (pats_span) (fst args)) - } - (* an entry with a priority *) - | LBRACKET NUM RBRACKET pats=opt_args ARROW ID args=opt_args - { - let _, pats = pats in - let pats = List.map cast_int_pats pats in - Span.extend $1 (fst args), - mk_entry (snd $2 |> Z.to_int) (pats) (snd $6) (snd args) (Span.extend $1 (fst args)) - } - -table_entries: - | table_entry { fst $1, [snd $1] } - | table_entry SEMI table_entries { Span.extend (fst $1) (fst $3), (snd $1::snd $3)} - // TODO: remove multiargs for match statements -- no need to suport match x, y, ... with syntax (no parens for multiple args) multiargs: | exp COMMA args { $1::$3 } @@ -608,10 +558,6 @@ statement1: | PRINTF LPAREN STRING RPAREN SEMI { sprintf_sp (snd $3) [] (Span.extend $1 $5) } | PRINTF LPAREN STRING COMMA args RPAREN SEMI { sprintf_sp (snd $3) $5 (Span.extend $1 $7) } | FOR LPAREN ID LESS size RPAREN LBRACE statement RBRACE { loop_sp $8 (snd $3) (snd $5) (Span.extend $1 $9) } - | TABLE_MULTI_INSTALL LPAREN tbl=exp COMMA - LBRACE tbl_entries=table_entries RBRACE RPAREN SEMI {tblinstall_sp (tbl) (snd tbl_entries) (Span.extend $1 $9)} - | TABLE_INSTALL LPAREN tbl=exp COMMA - LBRACE tbl_entries=table_entries RBRACE RPAREN SEMI {mk_tblinstall_single (tbl) (snd tbl_entries) (Span.extend $1 $9)} includes: | INCLUDE STRING {[(snd $2)]} | INCLUDE STRING includes {(snd $2)::$3} From 795636b67b17c25d70a0085183c5a4b90fbfbabd Mon Sep 17 00:00:00 2001 From: John Sonchack Date: Sat, 6 Jun 2026 16:46:08 -0400 Subject: [PATCH 08/49] fix >> parsing to end type args --- src/lib/frontend/Lexer.mll | 1 - src/lib/frontend/Parser.mly | 20 ++++++++++++++++---- 2 files changed, 16 insertions(+), 5 deletions(-) diff --git a/src/lib/frontend/Lexer.mll b/src/lib/frontend/Lexer.mll index 87bf6231..0ee610ed 100644 --- a/src/lib/frontend/Lexer.mll +++ b/src/lib/frontend/Lexer.mll @@ -114,7 +114,6 @@ rule token = parse | "==" { EQ (position lexbuf) } | "!=" { NEQ (position lexbuf)} | "<<" { LSHIFT (position lexbuf) } - | ">>" { RSHIFT (position lexbuf) } | "<=" { LEQ (position lexbuf) } | ">=" { GEQ (position lexbuf) } | "<" { LESS (position lexbuf) } diff --git a/src/lib/frontend/Parser.mly b/src/lib/frontend/Parser.mly index 92bb6b79..8678156a 100644 --- a/src/lib/frontend/Parser.mly +++ b/src/lib/frontend/Parser.mly @@ -164,7 +164,6 @@ %token GEQ %token COLON %token LSHIFT -%token RSHIFT %token END %token FOR %token SIZECAST @@ -186,7 +185,7 @@ %nonassoc LESS EQ MORE NEQ LEQ GEQ %left PLUS SUB SATSUB SATPLUS %left CONCAT -%left BITAND BITXOR PIPE LSHIFT RSHIFT +%left BITAND BITXOR PIPE LSHIFT %left PATAND %nonassoc PROJ %right NOT FLOOD BITNOT RPAREN @@ -253,12 +252,25 @@ single_poly: | LESS size MORE { Span.extend $1 $3, snd $2 } ty_poly: - | LSHIFT tys RSHIFT { $2 } + | LSHIFT tys MORE MORE { $2 } paren_args: | LPAREN RPAREN { Span.extend $1 $2, [] } | LPAREN args RPAREN { Span.extend $1 $3, $2 } +// special rshift rule constructed from two +// back-to-back "MORE"s +// we removed RSHIFT from the lexer to +// avoid parsing confusion for type argument lists +// ending in a parametric type e.g., (<>>) +rshift: + MORE MORE { + let adjacent (s1 : Span.t) (s2 : Span.t) = s1.finish = s2.start in + if not (adjacent $1 $2) + then Console.error_position (Span.extend $1 $2) "spurious whitespace in '>>' operator"; + RShift + } + binop: | exp PLUS exp { op_sp Plus [$1; $3] (Span.extend $1.espan $3.espan) } | exp SUB exp { op_sp Sub [$1; $3] (Span.extend $1.espan $3.espan) } @@ -277,7 +289,7 @@ binop: | exp PIPE exp { op_sp BitOr [$1; $3] (Span.extend $1.espan $3.espan) } | exp CONCAT exp { op_sp Conc [$1; $3] (Span.extend $1.espan $3.espan) } | exp LSHIFT exp { op_sp LShift [$1; $3] (Span.extend $1.espan $3.espan) } - | exp RSHIFT exp { op_sp RShift [$1; $3] (Span.extend $1.espan $3.espan) } + | exp rshift exp %prec LSHIFT { op_sp RShift [$1; $3] (Span.extend $1.espan $3.espan) } | exp PATAND exp { op_sp PatMask [$1; $3] (Span.extend $1.espan $3.espan) } // unordered call. put here to avoid conflict with exp LESS exp | exp LESS UNORDERED MORE paren_args { From 94ea1a88670d6a449f65c909d7ff0e2555852332 Mon Sep 17 00:00:00 2001 From: John Sonchack Date: Sat, 6 Jun 2026 18:52:58 -0400 Subject: [PATCH 09/49] cleanup --- examples/p4_bmv2_examples/basic/README.md | 65 ++++------------------- examples/p4_bmv2_examples/basic/basic.dpt | 11 +--- 2 files changed, 12 insertions(+), 64 deletions(-) diff --git a/examples/p4_bmv2_examples/basic/README.md b/examples/p4_bmv2_examples/basic/README.md index a2635fcc..c79232c1 100644 --- a/examples/p4_bmv2_examples/basic/README.md +++ b/examples/p4_bmv2_examples/basic/README.md @@ -16,7 +16,7 @@ the packet. ../../../sources/lucid/dpt basic.dpt --spec basic.json --silent ``` -## Topology +## Topology (in basic.json) A simple pod topology. Node IDs in the spec map to `s1..s4` as `0..3`. Host-facing ports (s1 ports 1–2, s2 ports 1–2) are deliberately left undeclared so forwarded packets show up in each node's `Exits` list, which is @@ -27,7 +27,7 @@ what to scan to verify correct delivery. h2 -- 2 4 -------- 2 [s4=3] 1 -------- 3 2 -- h4 ``` -## Test cases (in `basic.json`) +## Test cases (in basic.json) 1. **h1 → h2** (intra-s1). Exits at `0:2` with dmac `08:00:00:00:02:22`, smac `08:00:00:00:01:00`, ttl `63`, recomputed csum `0x64e8`. Input csum is `0` so the handler logs a "bad input csum" line. @@ -44,59 +44,19 @@ what to scan to verify correct delivery. ## Verifying the IPv4 checksum -`hash(checksum, ...)` is a magic form: when the seed is the builtin -`checksum`, the interpreter routes the call to a real one's-complement -IPv4 checksum ([sources/lucid/src/lib/midend/interpreter/InterpCore.ml:180-212](../../../sources/lucid/src/lib/midend/interpreter/InterpCore.ml#L180-L212)) -instead of the normal hash function. The Tofino backend lowers the same -form to a P4 `Checksum()` extern, so the two targets agree. - +`hash(checksum, ...)` calculates a one's-complement IPv4 checksum. The handler uses this twice: +- **Verify**: `hash<16>(checksum, ip)` — hashing the *whole* + header including its existing csum. - **Compute**: `{new_ip with hdr_csum = hash<16>(checksum, new_ip)}`, with `new_ip.hdr_csum` pre-zeroed. -- **Verify**: `hash<16>(checksum, ip)` — hashing the *whole* - header including its existing csum. For a well-formed packet this must - return `0`, per RFC 1071. - -### Smoking-gun test (worked example) - -Test 1 input is the h1→h2 packet at `ttl=64`, `csum=0`. By hand, summing -the IP header's 16-bit words (with csum=0): -``` -0x4500 + 0x0014 + 0x0000 + 0x0000 + 0x4000 - + 0x0000 + 0x0A00 + 0x0101 + 0x0A00 + 0x0202 -= 0x9C17 -~0x9C17 = 0x63E8 ← csum the input *should* have carried -``` -After s1 decrements TTL, the `(ttl,proto)` word drops from `0x4000` to -`0x3F00` (Δ = −0x100), so the new csum is `0x63E8 + 0x100 = 0x64E8`. -The interpreter prints exactly this in the exit packet: -``` -bytes(...3f0064e80a0001010a000202) at port 2 - ^^^^ - csum -``` -Test 4 confirms the verify side: we hand it the same packet but with -`csum=0x63e8` (the value we just derived as "correct"). The handler's -verify call returns 0, so no "bad input csum" line is logged. - -### How to extend -- To exercise the verify path on a *malformed* packet, send any packet - with a wrong (non-zero, non-matching) csum and confirm the handler - prints `bad input csum (verify=...)` with the residual sum. -- Generating real test vectors by hand is tedious — a small Python script - using `scapy.IP(...).chksum` next to `basic.json` would be the obvious - next step. We did not add one yet to keep the example self-contained. - -## Notable design choices -- **LPM via `Table.install` masks.** The P4 program uses a `lpm` key; the - Lucid interpreter implements equivalent semantics through - `Table.install_ternary` (which also backs the JSON `Table.install` command - when a `mask` field is provided). The current spec uses /32 host routes - with the default (exact) mask. For real prefixes, add a `"mask":[...]` - entry to the install command and install longer prefixes first — the - interpreter matches entries in install order. +## Notes +- **LPM via `Table.install` masks.** Lucid's `Table.install_ternary` + (which also backs the JSON `Table.install` command + when a `mask` field is provided) supports ordered rules with wildcard + bits. This example uses it for LPM. - **Install-time data is a tuple `(int<48>, int<32>)`.** The two action install args (`dmac`, `port`) are declared positionally on the actions and the table's data_ty reflects that as a tuple. The JSON `Table.install` @@ -106,8 +66,3 @@ verify call returns 0, so no "bad input csum" line is logged. field names globally (a `eth#dmac` reference is unified against any record type that has a `dmac` field), so `fwd_t` uses prefixed names (`fwd_dmac`/`fwd_port`/`fwd_hit`) to avoid clashing with `eth_hdr_t.dmac`. - -## Known caveats -- **No ARP / no host MAC learning.** Exactly like the P4 tutorial, ARP - resolution is assumed to have already been done; the control plane - installs the next-hop MAC alongside the egress port. diff --git a/examples/p4_bmv2_examples/basic/basic.dpt b/examples/p4_bmv2_examples/basic/basic.dpt index 95ead4de..c6a28485 100644 --- a/examples/p4_bmv2_examples/basic/basic.dpt +++ b/examples/p4_bmv2_examples/basic/basic.dpt @@ -46,10 +46,7 @@ action fwd_t ipv4_drop(int<48> _dmac, int<32> _port)() { return {fwd_dmac = 0; fwd_port = 0; fwd_hit = false}; } -// Match-action table keyed on the IPv4 destination address. Entries are -// installed via Table.install commands in the JSON spec (use a /32 mask for -// host routes, or a shorter mask for prefix routes; longer prefixes should be -// installed first since the interpreter matches in install order). The +// Match-action table keyed on the IPv4 destination address. The // data_ty `(int<48>, int<32>)` carries the next-hop MAC and egress port as // the actions' install-time arguments. global Table.t<, (int<48>, int<32>), (), fwd_t>> ipv4_lpm = @@ -75,11 +72,7 @@ handle ipv4_pkt(eth_hdr_t eth, ipv4_t ip, Payload.t pl) { ety = eth#ety }; // Recompute the IPv4 header checksum after the TTL decrement. We zero - // hdr_csum *before* the hash call below — RFC 1071 says compute the sum - // with the checksum field set to zero, then write the one's complement - // back into it. The `{new_ip with hdr_csum = ...}` at the generate site - // does step 2+3 in one shot, but only works because new_ip.hdr_csum is - // already 0 at that moment. Do not move/remove the `hdr_csum = 0;` line. + // hdr_csum *before* the hash call below as defined in the standards. ipv4_t new_ip = { version = ip#version; ihl = ip#ihl; From d1d95c9b5a17a23f2986281b403be32cf332ea58 Mon Sep 17 00:00:00 2001 From: John Sonchack Date: Sat, 6 Jun 2026 19:02:06 -0400 Subject: [PATCH 10/49] cleanup --- examples/p4_bmv2_examples/calc/README.md | 40 +++++++++--------------- examples/p4_bmv2_examples/calc/calc.dpt | 10 +----- 2 files changed, 15 insertions(+), 35 deletions(-) diff --git a/examples/p4_bmv2_examples/calc/README.md b/examples/p4_bmv2_examples/calc/README.md index 970a2e05..aa93fedf 100644 --- a/examples/p4_bmv2_examples/calc/README.md +++ b/examples/p4_bmv2_examples/calc/README.md @@ -9,16 +9,15 @@ op) are silently dropped. ## Files - [calc.dpt](calc.dpt) — the Lucid program. -- [gen_spec.py](gen_spec.py) — scapy-based generator that materializes +- [gen_spec.py](gen_spec.py) — scapy-based test case generator, produces [calc.json](calc.json). Edit the `TESTS` list to add cases; do **not** hand-edit `calc.json`. -- [calc.json](calc.json) — committed for reproducibility, regenerated by - `gen_spec.py`. +- [calc.json](calc.json) — committed for reproducibility. ## Running ```bash -/opt/anaconda3/bin/python3 gen_spec.py # if you changed TESTS -../../../sources/lucid/dpt calc.dpt --spec calc.json --silent +./gen_spec.py # if you changed TESTS +dpt calc.dpt --spec calc.json --silent ``` `gen_spec.py` needs scapy (`pip install scapy`). @@ -37,36 +36,25 @@ op) are silently dropped. Each reflected packet should appear in `Exits` at port 1 with the ethernet src/dst swapped relative to the input. -## Notable design choices -- **No table for op dispatch.** The P4 program uses a const-entries - match-action table to dispatch on `op` because P4 doesn't have a - general `switch`/`case` inside actions. Lucid does (`match`), so we - use it directly. Tables in Lucid are reserved for state the control - plane mutates at runtime; the calc program has none. +## Notes - **Bitwise XOR is `^^`.** Single `^` in Lucid is bitstring concat (so beware of the shape `a ^ b` ever silently meaning the wrong thing). -- **No `lookahead` in the parser.** P4 peeks the first three bytes to - validate the magic before fully extracting; Lucid has no lookahead, - so we extract first and validate in the handler. Same net behavior, - one extra parse on malformed packets. +- **No `lookahead` in the parser.** Lucid has no lookahead, + so we extract first and validate in the handler. - **No early `return` from handlers.** Lucid handlers don't support - early-exit, so the "drop on bad input" path is expressed by nested - if/else with an `ok` flag rather than `if (bad) return;`. -- **`printf` only supports `%d`.** No `%x`, no `%s`. Op bytes are + early-exit, so we use a flag and `if/else`. +- **`printf` only supports `%d`.** Op bytes are printed in decimal — `+` shows as `43`, `-` as `45`, etc. ## Generating spec files with scapy -This is the first example using a Python generator. The pattern: - +This example uses a Python script to generate the test json. +The pattern: 1. Define each header type as a tiny scapy `Packet` subclass with - `fields_desc` whose field widths exactly mirror the Lucid `type` - declarations. + `fields_desc` whose field widths match the Lucid `type` declarations. 2. Construct test packets by composing `Ether() / MyHeader(...)` and calling `bytes(...).hex()`. -3. Drop the resulting hex strings into the `events` list and +3. Append the resulting strings into the `events` list and `json.dump` to `.json`. -The wins, especially as headers stack up (`mri`, `source_routing`): -scapy keeps field order/width honest, and there's no opportunity to -miscount an "extra `0000`" between fields in a hex blob. +This helps with more complicated programs and tests. \ No newline at end of file diff --git a/examples/p4_bmv2_examples/calc/calc.dpt b/examples/p4_bmv2_examples/calc/calc.dpt index 539bc3ee..45272f6a 100644 --- a/examples/p4_bmv2_examples/calc/calc.dpt +++ b/examples/p4_bmv2_examples/calc/calc.dpt @@ -70,15 +70,7 @@ handle calc_pkt(eth_hdr_t eth, calc_t calc, Payload.t pl) { smac = eth#dmac; ety = eth#ety }; - calc_t new_calc = { - p = calc#p; - four = calc#four; - ver = calc#ver; - op = calc#op; - operand_a = calc#operand_a; - operand_b = calc#operand_b; - res = result - }; + calc_t new_calc = {calc with res = result}; generate_port(ingress_port, calc_pkt(new_eth, new_calc, pl)); } else { printf("sw %d port %d : unknown op %d - drop", From a6da89d6945387f18f417854441526ad7688d911 Mon Sep 17 00:00:00 2001 From: John Sonchack Date: Sat, 6 Jun 2026 19:12:44 -0400 Subject: [PATCH 11/49] cleanup --- examples/p4_bmv2_examples/ecn/README.md | 34 +++++++++--------- examples/p4_bmv2_examples/ecn/ecn.dpt | 46 +++++++++---------------- 2 files changed, 35 insertions(+), 45 deletions(-) diff --git a/examples/p4_bmv2_examples/ecn/README.md b/examples/p4_bmv2_examples/ecn/README.md index 5ddb049d..4ef0a54b 100644 --- a/examples/p4_bmv2_examples/ecn/README.md +++ b/examples/p4_bmv2_examples/ecn/README.md @@ -1,19 +1,18 @@ # `ecn` -ECN-marks (and drops) IPv4 packets based on a synthesized queue-depth +ECN-marks (and drops) IPv4 packets based on a queue-depth signal. We also implement a basic queue model: - A 1-cell `queuedepth` array stands in for the per-port queue. -- Every IPv4 packet bumps the cell atomically and reads back the new - depth. +- Every IPv4 packet increments the depth. - A self-recursive `queue_decr` event drains the cell by 1 each time it fires. We launch it once from the spec; the handler re-arms itself via `generate(queue_decr())` for the rest of the simulation. Three regimes: -| Depth (post-incr) | Action | -|-------------------|-------------------------| +| Depth (post-incr) | Action | +|---------------------|-------------------------| | `<= ECN_THRESHOLD` | forward unchanged | | `<= DROP_THRESHOLD` | forward with ECN = 0b11 | | `> DROP_THRESHOLD` | drop (no generate) | @@ -28,8 +27,8 @@ back-to-back packets cleanly walks the queue through all three. ## Running ```bash -/opt/anaconda3/bin/python3 gen_spec.py -../../../sources/lucid/dpt ecn.dpt --spec ecn.json --silent +./gen_spec.py +dpt ecn.dpt --spec ecn.json --silent ``` ## Expected trace @@ -53,18 +52,20 @@ Exit packets confirm the marking in the wire bytes — the TOS byte flips from `0x01` (ECT(1) preserved) to `0x03` (CE marked) right at the ECN threshold, and the IPv4 checksum updates accordingly. -## Notable Lucid details +## Notes -- **Recursive event for the drain.** A recursive event can be used to implement a background thread -- a handler that executes periodically over time. `queue_decr`'s handler is: +- **Background threads.** A recursive event can be used to implement a + background thread -- a handler that executes periodically over time. + `queue_decr`'s handler is a simple example: ``` handle queue_decr() { Array.setm(queuedepth, 0, sub1_floor, 0); generate(queue_decr()); } ``` - The delay between `generate(e)` and `e`'s arrival and handler execution is the drain rate. -- **Memops are restricted enough to be just-barely-enough.** The - drain uses `sub1_floor`: + The delay between `generate(e)` and `e`'s arrival and + handler execution is the drain rate. +- **Memops are restrictive but capable.** The drain uses `sub1_floor`: ``` memop sub1_floor(int mv, int unused) { if (mv == 0) { return 0; } @@ -72,11 +73,12 @@ the ECN threshold, and the IPv4 checksum updates accordingly. } ``` Each branch uses `mv` at most once (in the if condition or in the - return), which keeps the memop within the "compiles to one atomic - instruction" budget. + return), which keeps the memop within the footprint of a single + atomic instruction (on the Tofino). - **`Array.update` with the same memop on both sides** is the standard "atomic increment-and-fetch" idiom — get-side returns `mv+1`, set-side writes `mv+1`. The returned new depth is what we branch on. -- **Drop = don't generate.** No special "drop" call from a handler. - Just skip the `generate_port` and the packet vanishes. +- **Explicit packet generation.** If a handler doesn't + generate a packet event with `generate_port`, it is equivalent + to dropping the packet. \ No newline at end of file diff --git a/examples/p4_bmv2_examples/ecn/ecn.dpt b/examples/p4_bmv2_examples/ecn/ecn.dpt index a0abdb70..54cbb13f 100644 --- a/examples/p4_bmv2_examples/ecn/ecn.dpt +++ b/examples/p4_bmv2_examples/ecn/ecn.dpt @@ -1,24 +1,23 @@ -// Lucid port of the P4 "ecn" tutorial. -// -// The upstream P4 program marks ECN on a packet when the egress -// queue depth exceeds a threshold. Lucid's interpreter doesn't model -// queues, so we *synthesize* a queue depth signal: -// -// - A 1-cell `queuedepth` array stands in for the per-port queue. -// - Every IPv4 packet bumps the cell on its way through. -// - A self-recursive `queue_decr` event drains the cell by 1 each -// time it fires. We launch it once from the spec; it loops on -// itself for the rest of the simulation. -// -// Marking policy: +// ecn marking example. +// ECN (Explicit Congestion Notification) is a mechanism for end-to-end +// congestion signaling. It allows a switch to mark a packet instead of +// dropping it when the queue is congested, so the sender can react by +// reducing its sending rate before packets start getting dropped. + +// This example implements a simple ECN marking policy: // - depth <= ECN_THRESHOLD → forward unchanged // - ECN_THRESHOLD < depth <= DROP_THRESHOLD → forward with ECN bits = 0b11 (CE) // - depth > DROP_THRESHOLD → drop (no generate) // -// In a real implementation the queue would be per-egress-port and the -// depth would be sampled from hardware metadata at egress. The -// "one-cell + recursive drain" approximation is enough to demonstrate -// the three regimes (clean / marked / dropped) end to end. +// For this example, we model queue rates as follows: +// +// - A 1-cell `queuedepth` array counts packets per egress port. +// - Every IPv4 packet increments its cell before forwarding. +// - A self-recursive `queue_decr` event drains the cell by 1 each +// time it fires, representing a queue that drains at a constant rate. +// +// In a full implementation queue depth could also be updated by +// an egress handler thread, as it is often only observable there in hardware. const int ECN_THRESHOLD = 4; const int DROP_THRESHOLD = 8; @@ -121,20 +120,9 @@ handle ipv4_pkt(eth_hdr_t eth, ipv4_t ip, Payload.t pl) { smac = eth#dmac; ety = eth#ety }; - ipv4_t new_ip = { - version = ip#version; - ihl = ip#ihl; - diffserv = ip#diffserv; - ecn = new_ecn; - total_len = ip#total_len; - id = ip#id; - flags = ip#flags; - frag_offset = ip#frag_offset; + ipv4_t new_ip = {ip with ttl = ip#ttl - 1; - protocol = ip#protocol; hdr_csum = 0; - src = ip#src; - dst = ip#dst }; generate_port(d#fwd_port, ipv4_pkt(new_eth, From 6c5739ea1b6719ac9413073a20a58d14f8053fe8 Mon Sep 17 00:00:00 2001 From: John Sonchack Date: Sat, 6 Jun 2026 19:18:07 -0400 Subject: [PATCH 12/49] cleanup --- examples/p4_bmv2_examples/flowcache/README.md | 32 +++++++------------ 1 file changed, 11 insertions(+), 21 deletions(-) diff --git a/examples/p4_bmv2_examples/flowcache/README.md b/examples/p4_bmv2_examples/flowcache/README.md index 16e2f1f6..e5b2e3ab 100644 --- a/examples/p4_bmv2_examples/flowcache/README.md +++ b/examples/p4_bmv2_examples/flowcache/README.md @@ -2,10 +2,9 @@ An exact-match flow cache keyed on `(protocol, src_ip, dst_ip)`. On a hit, the cached `(dmac, port)` is used to forward. On a miss, the -switch emits a **PacketIn** control event to the controller and drops +switch emits a **PacketIn** event to the controller and drops the original packet; the controller is expected to install a matching -rule (via `Table.install`) and from then on packets in that flow are -forwarded by the data plane. +rule (via `Table.install`) to forward the rest of the packets in the flow. ## Files - [flowcache.dpt](flowcache.dpt) — the Lucid program. @@ -14,23 +13,17 @@ forwarded by the data plane. ## Running ```bash -/opt/anaconda3/bin/python3 gen_spec.py -../../../sources/lucid/dpt flowcache.dpt --spec flowcache.json --silent +./gen_spec.py +dpt flowcache.dpt --spec flowcache.json --silent ``` ## The "controller" is the JSON spec - -Lucid's interpreter lets test specifications be used to model the controller. +Test specifications can model controller operations. - The data plane emits PacketIn events to a designated controller port (`CONTROLLER_PORT = 99`). The port has no link, so the events land - in the `Exits` list — observable by the test. -- The spec mixes packet events with `Table.install` commands. A typical - flow: - 1. Send a burst of packets in flow A → they miss → PacketIn events - show up in Exits. - 2. The spec issues `Table.install` for flow A. - 3. Subsequent flow-A packets hit the cache and forward. + in the `Exits` list of interpreter output. +- `Table.install` commands in the test spec model controller actions. ## Test timeline (in `gen_spec.py`) @@ -47,15 +40,12 @@ End-state counters: - `miss_count[2] = 3` - `miss_count[3] = 1` -## Notable Lucid details +## Notes - **Record-typed table key.** `Table.t<>` works cleanly with a record as the key type. In the JSON `Table.install`, the record is flattened to a list of width-tagged values: `"key": ["6<8>", "<32>", "<32>"]` — in declaration - order of the record's fields. Same flattening you'd see for record - *data* (already used in `basic`, `basic_tunnel`, etc.). -- **PacketIn is a regular event with `{skip;}` body.** No wire format, - no parser, no handler — it exists purely to be `generate_port`'d out - the controller port so the test can observe its arguments in the - Exits list. Same pattern as `link_monitor`. + order of the record's fields. +- **PacketIn is a regular event with `{skip;}` body.** It exists + purely to be `generate_port`'d out the controller port. \ No newline at end of file From 462f4a325c309e6dad58d390eed21ca55de18e51 Mon Sep 17 00:00:00 2001 From: John Sonchack Date: Sat, 6 Jun 2026 19:21:00 -0400 Subject: [PATCH 13/49] cleanup --- .../p4_bmv2_examples/flowcache/flowcache.dpt | 27 +++++-------------- 1 file changed, 7 insertions(+), 20 deletions(-) diff --git a/examples/p4_bmv2_examples/flowcache/flowcache.dpt b/examples/p4_bmv2_examples/flowcache/flowcache.dpt index 63259864..52fe5324 100644 --- a/examples/p4_bmv2_examples/flowcache/flowcache.dpt +++ b/examples/p4_bmv2_examples/flowcache/flowcache.dpt @@ -1,26 +1,13 @@ -// Lucid port of the P4 "flowcache" tutorial. +// A simple flow cache // // The data plane has an exact-match table keyed on the 3-tuple // (protocol, src_ip, dst_ip). On a hit, the cached action forwards the -// packet. On a miss the switch (a) silently drops the original packet -// and (b) emits a `packet_in` *control event* containing the flow key -// + ingress port. In the upstream P4 this is the PacketIn message to -// the P4Runtime controller; here we send it to an unconnected "CPU -// port" so it lands in the `Exits` list for the test to inspect. -// -// The "controller" is the JSON spec: it observes the PacketIn (in the -// Exits list) and issues a `Table.install` command at a later timestamp. -// Subsequent packets in the same flow then hit the cache. -// -// Two design choices vs the upstream: -// * **PacketIn is a regular event, not a packet event.** Same play we -// made in `link_monitor` — the controller is internal to the -// simulator, no wire format needed, no parser for the punt path. -// * **No idle timeout.** Lucid handlers cannot install or remove -// table entries (`Table.install` is a control-plane command only), -// so there's no way to express an in-data-plane TTL on cache -// entries. The control plane (whoever writes the JSON spec) is the -// only entity that can mutate the table. Documented in the README. +// packet. On a miss, the original packet gets dropped and a PacketIn +// event gets emitted to the controller's port. +// In the test, the controller port is not connected, so the PacketIn +// goes to the `Exits` list in the interpreter's output. +// There is no controller, the JSON spec test case models its +// actions by issuing `Table.install` commands. const int<32> CONTROLLER_PORT = 99; const int<16> ETY_IPV4 = 0x0800; From 0ff0697c3b5993a0fc23830e25b8ef5ffd606624 Mon Sep 17 00:00:00 2001 From: John Sonchack Date: Sat, 6 Jun 2026 19:26:53 -0400 Subject: [PATCH 14/49] cleanup --- .../p4_bmv2_examples/link_monitor/README.md | 23 ++++++++----------- .../p4_bmv2_examples/link_monitor/gen_spec.py | 7 +----- .../link_monitor/link_monitor.dpt | 13 +---------- 3 files changed, 12 insertions(+), 31 deletions(-) diff --git a/examples/p4_bmv2_examples/link_monitor/README.md b/examples/p4_bmv2_examples/link_monitor/README.md index 80faaed5..3507088a 100644 --- a/examples/p4_bmv2_examples/link_monitor/README.md +++ b/examples/p4_bmv2_examples/link_monitor/README.md @@ -20,11 +20,11 @@ last hop) reads the full hop list. ## Running ```bash -/opt/anaconda3/bin/python3 gen_spec.py -../../../sources/lucid/dpt link_monitor.dpt --spec link_monitor.json --silent +./gen_spec.py +dpt link_monitor.dpt --spec link_monitor.json --silent ``` -## Test cases (driven by `gen_spec.py`) +## Test cases 1. **3 IPv4 packets h1→h2.** Each forwards through s1 (egress port 2) then s2 (egress port 1), bumping `byte_cnt_reg` at both ports. @@ -42,23 +42,20 @@ last hop) reads the full hop list. The `printf` `probe DONE` block at the final hop dumps the full chain in push-front order (most recent first). -## Notable Lucid details +## Notes - The `probe` event is just a regular Lucid event with vector args carrying both stacks as fixed-size `int<32>[4]` arrays, so we don't need - a parser. This treats probes as a *control protocol* rather than a wire-format - packet. If you ever need a real wire format (to talk to non-Lucid endpoints), - you'd recover the per-depth event variant approach from `source_routing`/`mri`. -- Probes are injected via the JSON spec's `"events"` list — same way you'd - inject any non-packet event in any other Lucid program. `generate_port` - ferries them between switches at runtime. At the last hop the event is - emitted out a host port and lands in the `Exits` list. + a parser. +- Probes are injected via the JSON spec's `"events"` list and `generate_port` + moves them between switches at runtime. At the last hop the event is + emitted out a non-connected host port (so ends up in the `Exits` list). - **Global declaration order matters across handlers.** `ipv4_lpm → byte_cnt_reg → last_time_reg`. Both handlers (`ipv4_pkt` and `probe`) access only some of these but in declaration order, so - the typechecker is happy. The `probe` handler skips `ipv4_lpm` + the type system is happy. The `probe` handler skips `ipv4_lpm` (allowed); the `ipv4_pkt` handler skips `last_time_reg` (allowed). - **`Array.update(arr, idx, get_val, _, set_to_arg, now)`** is the natural Lucid idiom for "atomically read the old value and write a new value." We use it for both sample-and-reset (`zero_out` as the - set memop) and sample-and-replace (`set_to_arg`). + set memop) and sample-and-replace (`set_to_arg`). \ No newline at end of file diff --git a/examples/p4_bmv2_examples/link_monitor/gen_spec.py b/examples/p4_bmv2_examples/link_monitor/gen_spec.py index 53e545c2..285b62bd 100644 --- a/examples/p4_bmv2_examples/link_monitor/gen_spec.py +++ b/examples/p4_bmv2_examples/link_monitor/gen_spec.py @@ -1,10 +1,5 @@ #!/usr/bin/env python3 """Generate link_monitor.json for the Lucid link_monitor example. - -Probe events are regular (non-packet) Lucid events: we inject them -directly from the spec rather than building wire-format packets and -running them through a parser. IPv4 packets are still real on-the-wire -packets (built with scapy). """ import ipaddress @@ -112,7 +107,7 @@ def probe_event(route, n_data=0, # ---- traffic + probes --------------------------------------------------- # -# Plan: +# Approach: # 1. Send a handful of IPv4 packets h1→h2 to bump byte_cnt on s1:p2 and # s2:p1. Each ipv4_pkt forward at egress port P increments # byte_cnt_reg[P] by 1. diff --git a/examples/p4_bmv2_examples/link_monitor/link_monitor.dpt b/examples/p4_bmv2_examples/link_monitor/link_monitor.dpt index 7fef04e5..be20ec32 100644 --- a/examples/p4_bmv2_examples/link_monitor/link_monitor.dpt +++ b/examples/p4_bmv2_examples/link_monitor/link_monitor.dpt @@ -1,4 +1,4 @@ -// Lucid port of the P4 "link_monitor" tutorial. +// a link monitor example // // Each switch keeps per-egress-port telemetry in two arrays: // byte_cnt_reg[port] — packets sent out that port since the last probe. @@ -11,17 +11,6 @@ // (swid, port, byte_cnt, last_time, cur_time) telemetry tuples at every // hop. The receiving host reads the full chain. // -// Big design pivot from the upstream P4: **probes are regular Lucid -// events, not packet events.** The upstream tutorial puts the route + -// telemetry stacks on the wire as variable-length P4 header stacks, -// which would force us through the same per-depth-event explosion we -// saw in `source_routing` and `mri`. A regular Lucid event has no wire -// format and no auto-deparser, so we can carry the stacks as plain -// `int<32>[4]` vectors and a single handler does the whole -// pop-route + push-telemetry transition. This treats the probe as a -// "control protocol" injected at the source and consumed at the sink, -// which is faithful to its purpose — what gets on the wire to a real -// host is a separate concern outside the scope of this example. // MAX_HOPS = 4 (encoded as the literal `4` throughout — vector sizes and // for-loop bounds need a concrete literal, and naming this via `size` ran From e3f4f0efc3b32903319780355c507c4d36299b4f Mon Sep 17 00:00:00 2001 From: John Sonchack Date: Sat, 6 Jun 2026 19:29:01 -0400 Subject: [PATCH 15/49] cleanup --- examples/p4_bmv2_examples/load_balance/README.md | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/examples/p4_bmv2_examples/load_balance/README.md b/examples/p4_bmv2_examples/load_balance/README.md index 28c72ec6..92f8a125 100644 --- a/examples/p4_bmv2_examples/load_balance/README.md +++ b/examples/p4_bmv2_examples/load_balance/README.md @@ -18,8 +18,8 @@ unicast packet. ## Running ```bash -/opt/anaconda3/bin/python3 gen_spec.py -../../../sources/lucid/dpt load_balance.dpt --spec load_balance.json --silent +./gen_spec.py +dpt load_balance.dpt --spec load_balance.json --silent ``` ## Topology @@ -53,11 +53,9 @@ The handler walks three tables in series for every TCP packet: 4. **`send_frame`** (exact on `nh_port`) returns `(fr_smac, fr_hit)`. On miss, the input smac is preserved (matches P4's NoAction default). -The handler then rewrites the ethernet header, decrements TTL, and -recomputes the IPv4 checksum (same `hash<16>(checksum, new_ip)` pattern -as `basic` and `basic_tunnel`). +The handler then rewrites/updates headers and generates the packet event. -## Test cases (defined in `gen_spec.py`) +## Test cases - Six TCP flows from `h1 → 10.0.0.1` with different source ports (1111…6666). All 6 hit s1's `ecmp_group` entry for 10.0.0.1 and split across `{select=0 → h2, select=1 → h3}` based on hash. Expected: both @@ -70,7 +68,7 @@ as `basic` and `basic_tunnel`). After a run, scan the `Exits` list and confirm packets show up at both `1:1` (h2's port) and `2:1` (h3's port). -## Notable design choices +## Notes - **`(int)(rec#field)` not `(int)rec#field`.** Casts bind tighter than `#` in Lucid, so the field-access has to be parenthesized. - **gen_spec.py emits the whole spec.** topology + 11 `Table.install` From 1e0d839c30dcb39ba1f92a0bab12bfd69e8d188d Mon Sep 17 00:00:00 2001 From: John Sonchack Date: Sat, 6 Jun 2026 19:34:14 -0400 Subject: [PATCH 16/49] cleanup --- .../load_balance/load_balance.dpt | 37 +++++-------------- 1 file changed, 10 insertions(+), 27 deletions(-) diff --git a/examples/p4_bmv2_examples/load_balance/load_balance.dpt b/examples/p4_bmv2_examples/load_balance/load_balance.dpt index 5b6ff5aa..ef9a81d8 100644 --- a/examples/p4_bmv2_examples/load_balance/load_balance.dpt +++ b/examples/p4_bmv2_examples/load_balance/load_balance.dpt @@ -1,10 +1,8 @@ -// Lucid port of the P4 "load_balance" tutorial: hash-based ECMP forwarding -// across 3 switches in a triangle, with one host per switch. +// hash-based ECMP load balancing example. +// Topology is a triangle of 3 switches, with one host per switch. // -// The setup is asymmetric: s1 acts as a *load balancer* and treats the -// magic destination IP 10.0.0.1 as "split this flow across {h2, h3} based -// on its TCP 5-tuple." s2 and s3 act as plain forwarders for their own -// hosts (count=1 entries — the ECMP machinery still runs but trivially). +// Switch s1 acts as a load balancer, splitting traffic to 10.0.0.1 +// across h2 and h3 based on a hash of the TCP 5-tuple. // // Three tables, applied in series in a single handler: // 1. ecmp_group — LPM on hdr.ipv4.dst → (base, count, hit). The action @@ -19,9 +17,7 @@ // In P4 this lives in MyEgress; here it's just a third // Table.lookup at the end of the same handler. // -// Non-TCP packets are dropped at the parser — the 5-tuple hash needs TCP -// ports, and the upstream P4 program's "use undefined port fields" behavior -// isn't a meaningful semantic in Lucid. +// Non-TCP packets are dropped at the parser. const int SEED = 0xC0FFEE; @@ -66,12 +62,8 @@ type tcp_t = { // -------- ecmp_group: LPM on dst IP -> (base, count) -------------------- // // install-time data is (base, count) where count must be a power of 2. -// The action just hands those back; the handler then hashes the 5-tuple -// and computes `select = base + (hash & (count-1))`. Putting the hash in -// the handler rather than the action keeps the table's runtime-arg type -// trivial (passing the 5-tuple as a tuple arg trips a type-checker -// occurs-check) and makes the ECMP math visible at the call site. - +// The action just hands those back for the handler to +// calculate the output port as `select = base + (hash & (count-1))`. type grp_t = { int<16> grp_base; int<32> grp_count; @@ -122,9 +114,8 @@ action frame_t rewrite_mac(int<48> smac)() { return {fr_smac = smac; fr_hit = true}; } -// On miss the input smac is preserved (the P4 default is NoAction, i.e. -// "leave smac alone"). The default action returns `fr_hit=false`; the -// handler then skips the smac rewrite. +// On miss the input smac is preserved. The default action returns +// `fr_hit=false`; the handler then skips the smac rewrite. action frame_t frame_pass(int<48> _smac)() { return {fr_smac = 0; fr_hit = false}; } @@ -163,18 +154,10 @@ handle tcp_pkt(eth_hdr_t eth, ipv4_t ip, tcp_t tcp, Payload.t pl) { smac = eth#smac; ety = eth#ety }; - ipv4_t new_ip = { - version = ip#version; - ihl = ip#ihl; - diffserv = ip#diffserv; - total_len = ip#total_len; - id = ip#id; - flags = ip#flags; - frag_offset = ip#frag_offset; + ipv4_t new_ip = { ip with ttl = ip#ttl - 1; protocol = ip#protocol; hdr_csum = 0; - src = ip#src; dst = n#nh_dstip }; From dfef5ea470faba2e492260e8c719417c8035c44c Mon Sep 17 00:00:00 2001 From: John Sonchack Date: Sat, 6 Jun 2026 19:38:03 -0400 Subject: [PATCH 17/49] cleanup --- examples/p4_bmv2_examples/Lucid-overview.md | 2 +- examples/p4_bmv2_examples/mri/mri.dpt | 23 +-------------------- 2 files changed, 2 insertions(+), 23 deletions(-) diff --git a/examples/p4_bmv2_examples/Lucid-overview.md b/examples/p4_bmv2_examples/Lucid-overview.md index 709881e8..962e16aa 100644 --- a/examples/p4_bmv2_examples/Lucid-overview.md +++ b/examples/p4_bmv2_examples/Lucid-overview.md @@ -1,6 +1,6 @@ Lucid is an event-based data-plane language. It is imperative and syntax is similar to c++ or rust. It has domain-specific constructs inspired by P4, but is higher level, more expressive, and simpler. -*Advice for agents programming in Lucid.* When developing in Lucid, work incrementally. Write the program first and type-check it, then fix errors, then generate a test spec (consider using a Python helper script if it is complicated). Do not try to plan or pre-compute the complete solution. +*Advice for programming in Lucid.* When developing in Lucid, work incrementally. Write the program first and type-check it, then fix errors, then generate a test spec (consider using a Python helper script if it is complicated). Do not try to plan or pre-compute the complete solution. ## Contents - [Basic features](#basic-features) — the core primitives, with a complete small example diff --git a/examples/p4_bmv2_examples/mri/mri.dpt b/examples/p4_bmv2_examples/mri/mri.dpt index 63fbd65b..fe22d2ae 100644 --- a/examples/p4_bmv2_examples/mri/mri.dpt +++ b/examples/p4_bmv2_examples/mri/mri.dpt @@ -1,27 +1,6 @@ -// Lucid port of the P4 "mri" tutorial: per-hop telemetry that pushes a +// per-hop telemetry that pushes a // (swid, qdepth) record onto a stack inside the IPv4 options as the // packet traverses the network. The receiver sees the full hop list. -// -// Structure mirrors `source_routing` because the same three Lucid -// constraints apply (see source_routing/README.md for the deep-dive): -// -// 1. Parsers are non-recursive → manually unroll the count-keyed -// swtrace-stack parse as a `match` over count. -// 2. Auto-deparser emits every event field → one event per stack -// depth (`mri_0`..`mri_3`), and the handler pushes by re-emitting -// as the next-larger variant. -// 3. Parser slot analysis requires distinct variables per arg -// position → distinct names for every swtrace's `swid`/`qdepth`. -// -// Substantive differences from the upstream P4: -// * `qdepth` (egress queue depth) isn't modeled by the Lucid -// interpreter; we push 0 in its place. Documented in the README. -// * `swid` is sourced from the `self` builtin rather than from a -// control-plane `Table.install` on a separate egress table. The -// P4 program has one entry per switch with `swid: N` baked in, -// which is what `self` already provides — so we skip the table. -// * Only MRI-flagged IPv4 packets are handled. Plain IPv4 (ihl=5, -// no option) is dropped at the parser. const int<16> ETY_IPV4 = 0x0800; const int<5> IPV4_OPT_MRI = 31; From 1a133d3aafb19c1153a153ab81f5be5bc4d92b49 Mon Sep 17 00:00:00 2001 From: John Sonchack Date: Sat, 6 Jun 2026 22:34:27 -0400 Subject: [PATCH 18/49] polymorphic events --- examples/p4_bmv2_examples/mri/mri.dpt | 266 +++++--------------------- 1 file changed, 48 insertions(+), 218 deletions(-) diff --git a/examples/p4_bmv2_examples/mri/mri.dpt b/examples/p4_bmv2_examples/mri/mri.dpt index fe22d2ae..19ac621b 100644 --- a/examples/p4_bmv2_examples/mri/mri.dpt +++ b/examples/p4_bmv2_examples/mri/mri.dpt @@ -1,9 +1,14 @@ // per-hop telemetry that pushes a // (swid, qdepth) record onto a stack inside the IPv4 options as the // packet traverses the network. The receiver sees the full hop list. +// polymorphic events make bounded recursion relatively clean. +// This example shows how in packet events, tuples and events serialize +// in the same way, so we can use polymorphic tuples to carry the "tail" of the stack +// without needing to know how many hops there are -- a powerful design pattern. const int<16> ETY_IPV4 = 0x0800; const int<5> IPV4_OPT_MRI = 31; +const int<16> MAX_HOPS = 3; // max number of swtraces we can push before saturating the stack. type eth_hdr_t = { int<48> dmac; @@ -34,12 +39,18 @@ type opt_t = { int<8> opt_len; } -// 2-byte MRI header (just a count of trailing swtraces). +// number of mri headers type mri_hdr_t = { int<16> mri_count; } -// -------- forwarding table (same shape as basic) ------------------------ +type sw_state_t = { + int<32> swid; + int<32> qdepth; +} + + +// -------- forwarding table ------------------------ type fwd_t = { int<48> fwd_dmac; @@ -59,189 +70,15 @@ global Table.t<, (int<48>, int<32>), (), fwd_t>> ipv4_lpm = Table.create(1024, [ipv4_forward; ipv4_drop], ipv4_drop, (0, 0)); // -------- events -------------------------------------------------------- -// -// One event per stack depth 0..MAX_HOPS=3. Each adds two scalar fields -// per swtrace (swid + qdepth). Beyond mri_3 the stack saturates: mri_3's -// handler still forwards but does not push another entry. - -packet event mri_0(eth_hdr_t eth, ipv4_t ip, opt_t opt, mri_hdr_t m, - Payload.t pl); -packet event mri_1(eth_hdr_t eth, ipv4_t ip, opt_t opt, mri_hdr_t m, - int<32> swid0, int<32> qdepth0, - Payload.t pl); +packet event mri(eth_hdr_t eth, ipv4_t ip, opt_t opt, mri_hdr_t m, + auto sws, Payload.t pl); -packet event mri_2(eth_hdr_t eth, ipv4_t ip, opt_t opt, mri_hdr_t m, - int<32> swid0, int<32> qdepth0, - int<32> swid1, int<32> qdepth1, - Payload.t pl); - -packet event mri_3(eth_hdr_t eth, ipv4_t ip, opt_t opt, mri_hdr_t m, - int<32> swid0, int<32> qdepth0, - int<32> swid1, int<32> qdepth1, - int<32> swid2, int<32> qdepth2, - Payload.t pl); - -// -------- helpers shared across handlers -------------------------------- -// -// Most of each handler is identical (forward + rewrite eth + bump ihl / -// total_len / opt_len / count + recompute IPv4 csum). The differences -// are only the swtrace fields ferried through, so we keep them inline -// rather than abstracted into a function — Lucid functions don't return -// records by reference, and the explicit form here exactly matches the -// upstream P4's egress logic. // -------- handlers ------------------------------------------------------ -handle mri_0(eth_hdr_t eth, ipv4_t ip, opt_t opt, mri_hdr_t m, Payload.t pl) { - fwd_t d = Table.lookup(ipv4_lpm, ip#dst, ()); - if (d#fwd_hit) { - eth_hdr_t new_eth = { - dmac = d#fwd_dmac; - smac = eth#dmac; - ety = eth#ety - }; - // Push the first swtrace: count 0 → 1, ihl +2, opt_len +8, total_len +8. - ipv4_t new_ip = { - version = ip#version; - ihl = ip#ihl + 2; - diffserv = ip#diffserv; - total_len = ip#total_len + 8; - id = ip#id; - flags = ip#flags; - frag_offset = ip#frag_offset; - ttl = ip#ttl - 1; - protocol = ip#protocol; - hdr_csum = 0; - src = ip#src; - dst = ip#dst - }; - opt_t new_opt = { - opt_copy = opt#opt_copy; - opt_class = opt#opt_class; - opt_num = opt#opt_num; - opt_len = opt#opt_len + 8 - }; - mri_hdr_t new_m = {mri_count = m#mri_count + 1}; - int<32> new_swid = self; - int<32> new_qdepth = 0; - printf("sw %d port %d -> %d : mri push (now n=1) dst=%d ttl=%d", - self, ingress_port, d#fwd_port, ip#dst, new_ip#ttl); - generate_port(d#fwd_port, - mri_1(new_eth, - {new_ip with hdr_csum = hash<16>(checksum, new_ip)}, - new_opt, new_m, - new_swid, new_qdepth, - pl)); - } else { - printf("sw %d port %d : drop mri (no route) dst=%d", - self, ingress_port, ip#dst); - } -} - -handle mri_1(eth_hdr_t eth, ipv4_t ip, opt_t opt, mri_hdr_t m, - int<32> swid0, int<32> qdepth0, Payload.t pl) { - fwd_t d = Table.lookup(ipv4_lpm, ip#dst, ()); - if (d#fwd_hit) { - eth_hdr_t new_eth = { - dmac = d#fwd_dmac; - smac = eth#dmac; - ety = eth#ety - }; - ipv4_t new_ip = { - version = ip#version; - ihl = ip#ihl + 2; - diffserv = ip#diffserv; - total_len = ip#total_len + 8; - id = ip#id; - flags = ip#flags; - frag_offset = ip#frag_offset; - ttl = ip#ttl - 1; - protocol = ip#protocol; - hdr_csum = 0; - src = ip#src; - dst = ip#dst - }; - opt_t new_opt = { - opt_copy = opt#opt_copy; - opt_class = opt#opt_class; - opt_num = opt#opt_num; - opt_len = opt#opt_len + 8 - }; - mri_hdr_t new_m = {mri_count = m#mri_count + 1}; - int<32> new_swid = self; - int<32> new_qdepth = 0; - printf("sw %d port %d -> %d : mri push (now n=2) dst=%d ttl=%d", - self, ingress_port, d#fwd_port, ip#dst, new_ip#ttl); - generate_port(d#fwd_port, - mri_2(new_eth, - {new_ip with hdr_csum = hash<16>(checksum, new_ip)}, - new_opt, new_m, - new_swid, new_qdepth, - swid0, qdepth0, - pl)); - } else { - printf("sw %d port %d : drop mri (no route) dst=%d", - self, ingress_port, ip#dst); - } -} - -handle mri_2(eth_hdr_t eth, ipv4_t ip, opt_t opt, mri_hdr_t m, - int<32> swid0, int<32> qdepth0, - int<32> swid1, int<32> qdepth1, Payload.t pl) { - fwd_t d = Table.lookup(ipv4_lpm, ip#dst, ()); - if (d#fwd_hit) { - eth_hdr_t new_eth = { - dmac = d#fwd_dmac; - smac = eth#dmac; - ety = eth#ety - }; - ipv4_t new_ip = { - version = ip#version; - ihl = ip#ihl + 2; - diffserv = ip#diffserv; - total_len = ip#total_len + 8; - id = ip#id; - flags = ip#flags; - frag_offset = ip#frag_offset; - ttl = ip#ttl - 1; - protocol = ip#protocol; - hdr_csum = 0; - src = ip#src; - dst = ip#dst - }; - opt_t new_opt = { - opt_copy = opt#opt_copy; - opt_class = opt#opt_class; - opt_num = opt#opt_num; - opt_len = opt#opt_len + 8 - }; - mri_hdr_t new_m = {mri_count = m#mri_count + 1}; - int<32> new_swid = self; - int<32> new_qdepth = 0; - printf("sw %d port %d -> %d : mri push (now n=3) dst=%d ttl=%d", - self, ingress_port, d#fwd_port, ip#dst, new_ip#ttl); - generate_port(d#fwd_port, - mri_3(new_eth, - {new_ip with hdr_csum = hash<16>(checksum, new_ip)}, - new_opt, new_m, - new_swid, new_qdepth, - swid0, qdepth0, - swid1, qdepth1, - pl)); - } else { - printf("sw %d port %d : drop mri (no route) dst=%d", - self, ingress_port, ip#dst); - } -} - -// MAX_HOPS reached. Forward but do *not* push another swtrace — the -// stack is saturated. TTL still decrements, ihl/total_len/opt_len/count -// don't change, csum still gets recomputed because TTL did. -handle mri_3(eth_hdr_t eth, ipv4_t ip, opt_t opt, mri_hdr_t m, - int<32> swid0, int<32> qdepth0, - int<32> swid1, int<32> qdepth1, - int<32> swid2, int<32> qdepth2, Payload.t pl) { +handle mri(eth_hdr_t eth, ipv4_t ip, opt_t opt, mri_hdr_t m, + auto sws, Payload.t pl) { fwd_t d = Table.lookup(ipv4_lpm, ip#dst, ()); if (d#fwd_hit) { eth_hdr_t new_eth = { @@ -249,31 +86,35 @@ handle mri_3(eth_hdr_t eth, ipv4_t ip, opt_t opt, mri_hdr_t m, smac = eth#dmac; ety = eth#ety }; - ipv4_t new_ip = { - version = ip#version; - ihl = ip#ihl; - diffserv = ip#diffserv; - total_len = ip#total_len; - id = ip#id; - flags = ip#flags; - frag_offset = ip#frag_offset; + ipv4_t new_ip = {ip with ttl = ip#ttl - 1; - protocol = ip#protocol; hdr_csum = 0; - src = ip#src; - dst = ip#dst }; printf("sw %d port %d -> %d : mri stack saturated, forward only dst=%d ttl=%d", self, ingress_port, d#fwd_port, ip#dst, new_ip#ttl); + if (m#mri_count == MAX_HOPS) { generate_port(d#fwd_port, - mri_3(new_eth, + mri(new_eth, {new_ip with hdr_csum = hash<16>(checksum, new_ip)}, - opt, m, - swid0, qdepth0, - swid1, qdepth1, - swid2, qdepth2, - pl)); - } else { + opt, m, sws, pl)); + } else { + opt_t new_opt = {opt with + opt_len = opt#opt_len + 8 + }; + mri_hdr_t new_m = {mri_count = m#mri_count + 1}; + int<32> new_swid = self; + int<32> new_qdepth = 0; + sw_state_t new_sw0 = {swid = new_swid; qdepth = new_qdepth}; + printf("sw %d port %d -> %d : mri push (now n=3) dst=%d ttl=%d", + self, ingress_port, d#fwd_port, ip#dst, new_ip#ttl); + generate_port(d#fwd_port, + mri(new_eth, + {new_ip with hdr_csum = hash<16>(checksum, new_ip)}, + new_opt, new_m, + (new_sw0, sws), pl)); + } + } + else { printf("sw %d port %d : drop mri (no route) dst=%d", self, ingress_port, ip#dst); } @@ -290,39 +131,28 @@ parser main(bitstring pkt) { opt_t opt = read(pkt); mri_hdr_t m = read(pkt); // Dispatch by count. Each branch reads exactly `count` swtraces - // off the wire and generates the matching event variant. + // off the wire and generates the same polymorphic event. match m#mri_count with | 0 -> { Payload.t pl = Payload.parse(pkt); - generate(mri_0(eth, ip, opt, m, pl)); + generate(mri(eth, ip, opt, m, (), pl)); } | 1 -> { - int<32> swid0 = read(pkt); - int<32> qdepth0 = read(pkt); + sw_state_t sw0 = read(pkt); Payload.t pl = Payload.parse(pkt); - generate(mri_1(eth, ip, opt, m, swid0, qdepth0, pl)); + generate(mri(eth, ip, opt, m, sw0, pl)); } | 2 -> { - int<32> swid0 = read(pkt); - int<32> qdepth0 = read(pkt); - int<32> swid1 = read(pkt); - int<32> qdepth1 = read(pkt); + sw_state_t[2] sws = read(pkt); Payload.t pl = Payload.parse(pkt); - generate(mri_2(eth, ip, opt, m, swid0, qdepth0, swid1, qdepth1, pl)); + generate(mri(eth, ip, opt, m, sws, pl)); } | 3 -> { - int<32> swid0 = read(pkt); - int<32> qdepth0 = read(pkt); - int<32> swid1 = read(pkt); - int<32> qdepth1 = read(pkt); - int<32> swid2 = read(pkt); - int<32> qdepth2 = read(pkt); + sw_state_t[3] sws = read(pkt); Payload.t pl = Payload.parse(pkt); - generate(mri_3(eth, ip, opt, m, - swid0, qdepth0, swid1, qdepth1, swid2, qdepth2, - pl)); + generate(mri(eth, ip, opt, m, sws, pl)); } | _ -> { drop; } } - | _ -> { drop; } + | _ -> { drop; } } From 6bb759ebb42136c18f655fe6cfee36ce5a0e2921 Mon Sep 17 00:00:00 2001 From: John Sonchack Date: Sat, 6 Jun 2026 22:40:53 -0400 Subject: [PATCH 19/49] cleanup --- examples/p4_bmv2_examples/multicast/README.md | 27 +++++++++---------- .../p4_bmv2_examples/multicast/multicast.dpt | 22 ++++----------- 2 files changed, 17 insertions(+), 32 deletions(-) diff --git a/examples/p4_bmv2_examples/multicast/README.md b/examples/p4_bmv2_examples/multicast/README.md index f94ae66f..76614146 100644 --- a/examples/p4_bmv2_examples/multicast/README.md +++ b/examples/p4_bmv2_examples/multicast/README.md @@ -1,4 +1,4 @@ -# `multicast` — Lucid port of the P4 multicast / L2-flooding tutorial +# `multicast` An L2 switch with four host ports. @@ -12,8 +12,8 @@ An L2 switch with four host ports. ## Running ```bash -/opt/anaconda3/bin/python3 gen_spec.py -../../../sources/lucid/dpt multicast.dpt --spec multicast.json --silent +./gen_spec.py +dpt multicast.dpt --spec multicast.json --silent ``` ## Test cases (in `gen_spec.py`) @@ -40,15 +40,12 @@ group of every declared port on the switch *except* ``. `generate_ports(flood ingress_port, ev)` then sends `ev` to each port in that group. -For the example to behave as expected, the topology block has to -declare all four host ports — `flood` enumerates the switch's declared -ports, not "every conceivable port number." We use four `link`-type -ports with no `links` entries; the interpreter picks them up in -the flood enumeration. Packets emitted to them land in `Exits`. - -## Notable Lucid details -- **Default action returns the "flood" sentinel.** Rather than calling - flood from inside the action (actions can't generate events), the - default action returns a `fwd_t` with `fwd_flood = true`, and the - handler then decides between `generate_port` and `generate_ports`. - Same pattern we used for `fwd_hit` in earlier examples. +Flood only considers declared ports, so the topology block +of the interpreter spec declares all 4 host ports as link ports, +even though they are not connected in the links block. + +## Notes +- **Default action returns the "flood" sentinel.** Actions can't +generate events, so the default action returns a `fwd_t` with +`fwd_flood = true`, and the handler then decides between +`generate_port` and `generate_ports`. diff --git a/examples/p4_bmv2_examples/multicast/multicast.dpt b/examples/p4_bmv2_examples/multicast/multicast.dpt index b8be2ce9..a130f1da 100644 --- a/examples/p4_bmv2_examples/multicast/multicast.dpt +++ b/examples/p4_bmv2_examples/multicast/multicast.dpt @@ -1,25 +1,13 @@ -// Lucid port of the P4 "multicast" tutorial. -// +// Dataplane component of an L2 learning switch. // Classic L2 learning switch (almost — the *learn* part is delegated to // the control plane via `Table.install`). One switch, four host ports. // // * Known dst MAC → forward to its specific port (`mac_forward`). // * Unknown dst MAC → flood to all ports except the ingress port. -// -// The upstream P4 implements the "flood except ingress" rule by -// (a) setting a multicast group at ingress, (b) replicating the packet -// to every member of the group in the bmv2 packet replication engine, -// and (c) explicitly dropping the copy that would head back out the -// ingress port at egress. Lucid bundles all of that into a single -// builtin — `flood ` constructs a multicast group of every -// declared port *except* ``, and `generate_ports` emits the -// event to all of them. -// -// One caveat: `flood` only enumerates ports that the topology block -// has declared. That's why the spec (gen_spec.py) declares all four -// host ports explicitly as `link` type, even though none is linked to -// another node — the simulator treats unlinked declared ports as -// exits, which gives us the 4-host fan-out we want. +// In Lucid, flood(port) multicasts a packet to every declared +// port except `port`. Note that ports must be declared in the +// topology block for `flood` to work correctly, that's why the spec +// declares all four host ports explicitly as `link` type. type eth_hdr_t = { int<48> dmac; From 7c644e84fc45f56c53c1a7170c8c4a7cb6e76337 Mon Sep 17 00:00:00 2001 From: John Sonchack Date: Sat, 6 Jun 2026 22:50:48 -0400 Subject: [PATCH 20/49] cleanup --- examples/p4_bmv2_examples/p4runtime/README.md | 34 +++++++++---------- .../p4_bmv2_examples/p4runtime/controller.py | 8 +---- .../p4_bmv2_examples/p4runtime/p4runtime.dpt | 14 ++++---- 3 files changed, 23 insertions(+), 33 deletions(-) mode change 100644 => 100755 examples/p4_bmv2_examples/p4runtime/controller.py diff --git a/examples/p4_bmv2_examples/p4runtime/README.md b/examples/p4_bmv2_examples/p4runtime/README.md index 0e26017b..f9affb55 100644 --- a/examples/p4_bmv2_examples/p4runtime/README.md +++ b/examples/p4_bmv2_examples/p4runtime/README.md @@ -1,6 +1,6 @@ # `p4runtime` -This port uses Lucid's **interpreter interactive mode** to support a dynamic controller in Python. +This uses Lucid's **interpreter interactive mode** to support a dynamic controller in Python. - `dpt --interactive` reads JSON events on stdin and writes exit events as JSON on stdout (one record per line). @@ -10,7 +10,7 @@ This port uses Lucid's **interpreter interactive mode** to support a dynamic con The data plane is a flow cache: misses generate `packet_in`; hits forward. Same shape as [`flowcache`](../flowcache/), but instead of -the controller being a static JSON spec, it's a live Python process. +the controller being a static JSON spec, it's a Python program. ## Files - [p4runtime.dpt](p4runtime.dpt) — the Lucid program. @@ -20,12 +20,12 @@ the controller being a static JSON spec, it's a live Python process. ## Running ```bash -/opt/anaconda3/bin/python3 controller.py +./controller.py ``` -That single command runs the whole demo — it spawns dpt, sends a few -test packets, reacts to packet_in's by installing rules, and prints -the interleaved transcript on stderr. +The above command spawns the controller, interpreter, sends a few +test packets, reacts to the packet_ins, and prints the +interleaved transcript on stderr. Sample transcript (abridged): ``` @@ -42,6 +42,9 @@ Sample transcript (abridged): ## How interactive mode works +The `dpt --interactive` flag turns the interpreter into a long-running +server that can be driven from any process with line-delimited JSON. + > - **Input**: every event is a JSON dict on its own line. Reads from > stdin until EOF. > - **Output**: each exit event is a single-line JSON record on @@ -50,24 +53,19 @@ Sample transcript (abridged): > has elapsed; events arriving on stdin execute at > `max(current_ts, event.timestamp)`. -The `dpt --interactive` flag turns the simulator into a long-running -server that can be driven from any process that speaks line-delimited -JSON. -## Notable details +## Notes -- **The "controller" is just a Python process** that does JSON in, - JSON out. The controller's policy logic - (`react_to_packet_in` in `controller.py`) is plain Python that +- **The "controller" is just a Python program** with JSON in, + JSON out. The controller's logic + (`react_to_packet_in` in `controller.py`) reads packet_ins and decides what rule to install based on the packet_in's fields. - **Bidirectional channel from one stdin/stdout pair.** Each event / command is one line of JSON. The same channel carries packet events, `Table.install` commands, and the `packet_in` notifications in the other direction. Adding a new control protocol over this channel is just adding a new event type to the Lucid program. -- **Shutdown is messy.** Closing stdin causes the interpreter to +- **Shutdown is currently messy.** Closing stdin causes the interpreter to exit with a `Fatal error: ... stdin eof`. The controller catches - the error stream and the run is complete by that point, but it's - noise. Worth filing as a small interpreter cleanup — - `load_new_events`'s non-blocking-poll branch should handle EOF as - a clean shutdown signal instead of `error "stdin eof"`. + the error stream and the run is complete by that point, so it is just + annoying. diff --git a/examples/p4_bmv2_examples/p4runtime/controller.py b/examples/p4_bmv2_examples/p4runtime/controller.py old mode 100644 new mode 100755 index e047022d..3cf20b38 --- a/examples/p4_bmv2_examples/p4runtime/controller.py +++ b/examples/p4_bmv2_examples/p4runtime/controller.py @@ -7,12 +7,6 @@ packet_in with src S arriving on port P, we install a rule that forwards future packets to S out port P. Subsequent packets in either direction then hit the cache. - -This is the Lucid analog of `advanced_tunnel.p4` + `mycontroller.py` -from the upstream P4 tutorial — same architecture (data-plane miss -notifies the controller, controller installs a rule, data plane -forwards on hit), but the channel is stdin/stdout JSON rather than -P4Runtime gRPC. """ import ipaddress @@ -27,7 +21,7 @@ from scapy.all import Ether, IP HERE = Path(__file__).parent -DPT = HERE / "../../../sources/lucid/dpt" +DPT = HERE / "../../../dpt" PROG = HERE / "p4runtime.dpt" SPEC = HERE / "p4runtime.json" diff --git a/examples/p4_bmv2_examples/p4runtime/p4runtime.dpt b/examples/p4_bmv2_examples/p4runtime/p4runtime.dpt index c71e0802..af2b2a3e 100644 --- a/examples/p4_bmv2_examples/p4runtime/p4runtime.dpt +++ b/examples/p4_bmv2_examples/p4runtime/p4runtime.dpt @@ -1,6 +1,9 @@ -// Lucid port of the P4 "p4runtime" tutorial — really a demo of -// **dynamic control via the interpreter's interactive mode**. -// +// This example is called "p4runtime" because it mimics +// the behavior of the P4Runtime tutorial example from BMv2. +// This example shows how to use the interpreter's interactive mode to +// support an interactive control plane in Python that interacts with +// the data plane in real time using JSON events and commands. +// // The data plane is a small flow cache (same shape as `flowcache`): // hits forward, misses generate a `packet_in` control event and drop // the original packet. What makes this example different is *how* the @@ -12,11 +15,6 @@ // packet_in records off stdout, decides what to install (here: // learn the dst port from the ingress port the packet arrived on), // and writes `Table.install` commands back on stdin. -// -// The lifecycle — cold cache → miss → notify → install → hit — plays -// out in real time across the two processes. This is the same idea -// the upstream `advanced_tunnel.p4` + `mycontroller.py` pair -// demonstrates with P4Runtime, just sized to fit the simulator. const int<32> CONTROLLER_PORT = 99; From b8cc6cb97b68590f07fb8f11d6e7ceb8879142fe Mon Sep 17 00:00:00 2001 From: John Sonchack Date: Sat, 6 Jun 2026 22:52:11 -0400 Subject: [PATCH 21/49] cleanup --- examples/p4_bmv2_examples/qos/README.md | 4 ++-- examples/p4_bmv2_examples/qos/qos.dpt | 13 ------------- 2 files changed, 2 insertions(+), 15 deletions(-) diff --git a/examples/p4_bmv2_examples/qos/README.md b/examples/p4_bmv2_examples/qos/README.md index 9dabef59..587f91fc 100644 --- a/examples/p4_bmv2_examples/qos/README.md +++ b/examples/p4_bmv2_examples/qos/README.md @@ -16,8 +16,8 @@ marking step applied before the table lookup: ## Running ```bash -/opt/anaconda3/bin/python3 gen_spec.py -../../../sources/lucid/dpt qos.dpt --spec qos.json --silent +python3 gen_spec.py +dpt qos.dpt --spec qos.json --silent ``` ## Test cases (in `gen_spec.py`) diff --git a/examples/p4_bmv2_examples/qos/qos.dpt b/examples/p4_bmv2_examples/qos/qos.dpt index 9255f350..9bffc83f 100644 --- a/examples/p4_bmv2_examples/qos/qos.dpt +++ b/examples/p4_bmv2_examples/qos/qos.dpt @@ -1,21 +1,8 @@ -// Lucid port of the P4 "qos" tutorial. -// // Plain IPv4 forwarding (same shape as `basic`), plus per-protocol DSCP // marking before the table lookup: // * UDP packets → diffserv = 46 (Expedited Forwarding) // * TCP packets → diffserv = 44 (Voice Admit) // * everything else → diffserv unchanged -// -// The upstream P4 program also defines a bunch of AF_xy actions -// (Assured Forwarding classes) but never invokes them in the apply -// block, so they're dead code we don't bother replicating. -// -// One small difference from the previous examples: the IPv4 header -// splits the TOS byte into `diffserv:6 + ecn:2`, matching the actual -// IPv4 wire format. Earlier examples kept it as a single `diffserv:8` -// since they never read or wrote those bits. The checksum recompute -// covers both halves (one's-complement sum is bit-position-agnostic -// within each 16-bit word). const int<16> ETY_IPV4 = 0x0800; const int<8> PROTO_TCP = 6; From fbd1b2e048d4cbd6ac6d29914619958bbe318bf0 Mon Sep 17 00:00:00 2001 From: John Sonchack Date: Sat, 6 Jun 2026 23:21:34 -0400 Subject: [PATCH 22/49] bmv2 examples integrates into test harnesses --- examples/p4_bmv2_examples/README.md | 5 +- examples/p4_bmv2_examples/basic/basic.json | 1 + .../basic_tunnel/basic_tunnel.json | 1 + examples/p4_bmv2_examples/calc/calc.json | 1 + examples/p4_bmv2_examples/ecn/ecn.json | 1 + .../p4_bmv2_examples/flowcache/flowcache.json | 1 + .../link_monitor/link_monitor.json | 1 + .../load_balance/load_balance.json | 1 + examples/p4_bmv2_examples/mri/mri.json | 1 + .../p4_bmv2_examples/multicast/multicast.json | 1 + .../p4_bmv2_examples/p4runtime/p4runtime.json | 1 + examples/p4_bmv2_examples/qos/qos.json | 1 + .../source_routing/source_routing.json | 1 + examples/p4_bmv2_examples/test.py | 184 ++++++++++++++++++ test/runtests.py | 11 +- 15 files changed, 208 insertions(+), 4 deletions(-) create mode 100755 examples/p4_bmv2_examples/test.py diff --git a/examples/p4_bmv2_examples/README.md b/examples/p4_bmv2_examples/README.md index 56ff48a5..9751b412 100644 --- a/examples/p4_bmv2_examples/README.md +++ b/examples/p4_bmv2_examples/README.md @@ -1,9 +1,8 @@ # Example ports: P4 BMv2 tutorials → Lucid -12 [P4 BMv2 tutorial examples](https://github.com/p4lang/tutorials) -as of 05/2026, ported to Lucid. Each port contains: a Lucid +This directory contains 12 [P4 BMv2 tutorial examples](https://github.com/p4lang/tutorials) ported to Lucid. Each port contains: a Lucid program, an interpreter spec (some generated by a Python helper), -and a README. +and a README. The examples demonstrate a number of design patterns in Lucid. | Example | Notes | |------------------|-------| diff --git a/examples/p4_bmv2_examples/basic/basic.json b/examples/p4_bmv2_examples/basic/basic.json index 9c35ae19..953887d6 100644 --- a/examples/p4_bmv2_examples/basic/basic.json +++ b/examples/p4_bmv2_examples/basic/basic.json @@ -1,4 +1,5 @@ { + "random seed": 1, "max time": 20000, "default_input_gap": 100, diff --git a/examples/p4_bmv2_examples/basic_tunnel/basic_tunnel.json b/examples/p4_bmv2_examples/basic_tunnel/basic_tunnel.json index 10287069..696da3bb 100644 --- a/examples/p4_bmv2_examples/basic_tunnel/basic_tunnel.json +++ b/examples/p4_bmv2_examples/basic_tunnel/basic_tunnel.json @@ -1,4 +1,5 @@ { + "random seed": 1, "max time": 20000, "default_input_gap": 100, diff --git a/examples/p4_bmv2_examples/calc/calc.json b/examples/p4_bmv2_examples/calc/calc.json index 4ebc6483..983ecf51 100644 --- a/examples/p4_bmv2_examples/calc/calc.json +++ b/examples/p4_bmv2_examples/calc/calc.json @@ -1,4 +1,5 @@ { + "random seed": 1, "max time": 20000, "default_input_gap": 100, "events": [ diff --git a/examples/p4_bmv2_examples/ecn/ecn.json b/examples/p4_bmv2_examples/ecn/ecn.json index 3f627c99..c1929269 100644 --- a/examples/p4_bmv2_examples/ecn/ecn.json +++ b/examples/p4_bmv2_examples/ecn/ecn.json @@ -1,4 +1,5 @@ { + "random seed": 1, "max time": 40000, "default_input_gap": 50, "events": [ diff --git a/examples/p4_bmv2_examples/flowcache/flowcache.json b/examples/p4_bmv2_examples/flowcache/flowcache.json index 8315bf4c..ca04da2f 100644 --- a/examples/p4_bmv2_examples/flowcache/flowcache.json +++ b/examples/p4_bmv2_examples/flowcache/flowcache.json @@ -1,4 +1,5 @@ { + "random seed": 1, "max time": 10000, "default_input_gap": 100, "events": [ diff --git a/examples/p4_bmv2_examples/link_monitor/link_monitor.json b/examples/p4_bmv2_examples/link_monitor/link_monitor.json index 1b2d5dd7..b16fe826 100644 --- a/examples/p4_bmv2_examples/link_monitor/link_monitor.json +++ b/examples/p4_bmv2_examples/link_monitor/link_monitor.json @@ -1,4 +1,5 @@ { + "random seed": 1, "max time": 30000, "default_input_gap": 100, "topology": { diff --git a/examples/p4_bmv2_examples/load_balance/load_balance.json b/examples/p4_bmv2_examples/load_balance/load_balance.json index 53e3f8c6..031fadcb 100644 --- a/examples/p4_bmv2_examples/load_balance/load_balance.json +++ b/examples/p4_bmv2_examples/load_balance/load_balance.json @@ -1,4 +1,5 @@ { + "random seed": 1, "max time": 30000, "default_input_gap": 100, "topology": { diff --git a/examples/p4_bmv2_examples/mri/mri.json b/examples/p4_bmv2_examples/mri/mri.json index 20749cbf..c225ec23 100644 --- a/examples/p4_bmv2_examples/mri/mri.json +++ b/examples/p4_bmv2_examples/mri/mri.json @@ -1,4 +1,5 @@ { + "random seed": 1, "max time": 20000, "default_input_gap": 100, "topology": { diff --git a/examples/p4_bmv2_examples/multicast/multicast.json b/examples/p4_bmv2_examples/multicast/multicast.json index f90fa85a..6f461b06 100644 --- a/examples/p4_bmv2_examples/multicast/multicast.json +++ b/examples/p4_bmv2_examples/multicast/multicast.json @@ -1,4 +1,5 @@ { + "random seed": 1, "max time": 15000, "default_input_gap": 100, "topology": { diff --git a/examples/p4_bmv2_examples/p4runtime/p4runtime.json b/examples/p4_bmv2_examples/p4runtime/p4runtime.json index 95831511..7f9a17ba 100644 --- a/examples/p4_bmv2_examples/p4runtime/p4runtime.json +++ b/examples/p4_bmv2_examples/p4runtime/p4runtime.json @@ -1,4 +1,5 @@ { + "random seed": 1, "max time": 0, "events": [] } diff --git a/examples/p4_bmv2_examples/qos/qos.json b/examples/p4_bmv2_examples/qos/qos.json index d31f9579..16d5088f 100644 --- a/examples/p4_bmv2_examples/qos/qos.json +++ b/examples/p4_bmv2_examples/qos/qos.json @@ -1,4 +1,5 @@ { + "random seed": 1, "max time": 15000, "default_input_gap": 100, "events": [ diff --git a/examples/p4_bmv2_examples/source_routing/source_routing.json b/examples/p4_bmv2_examples/source_routing/source_routing.json index 6fc56b6c..59a8e91b 100644 --- a/examples/p4_bmv2_examples/source_routing/source_routing.json +++ b/examples/p4_bmv2_examples/source_routing/source_routing.json @@ -1,4 +1,5 @@ { + "random seed": 1, "max time": 20000, "default_input_gap": 100, "topology": { diff --git a/examples/p4_bmv2_examples/test.py b/examples/p4_bmv2_examples/test.py new file mode 100755 index 00000000..046bbca1 --- /dev/null +++ b/examples/p4_bmv2_examples/test.py @@ -0,0 +1,184 @@ +#!/usr/bin/env python3 +"""Run the P4-BMv2 Lucid example tests and check each against expected output. + +Each example is run by invoking the Lucid interpreter (`dpt`) on its program +and committed interpreter spec, then comparing the interpreter's stdout against +a stored "expected output" trace. The specs all set `"random seed": 1` so the +output is deterministic across runs. + +Usage: + python test.py # run every example, compare vs expected/ + python test.py basic calc # run only the named examples + python test.py --expected # (re)generate expected_output/.out for all + python test.py --expected calc # regenerate expected output for one example + +Exit status is non-zero if any test fails. +""" + +import argparse +import subprocess +import sys +from pathlib import Path + +# Resolve everything relative to this script so it works from any CWD. +HERE = Path(__file__).resolve().parent # examples/p4_bmv2_examples +REPO_ROOT = HERE.parent.parent # repo root (holds the dpt binary) +DPT = REPO_ROOT / "dpt" +EXPECTED_DIR = HERE / "expected_output" + +PER_TEST_TIMEOUT = 120 # seconds; a generous ceiling so a hang can't wedge CI + +# Every example below runs the same way: `dpt .dpt --spec .json +# --silent`, executed from the example's own directory, with stdout being the +# trace we compare. They differ only in the program/spec they point at, so we +# just list the names. (To cover an example with a different command, switch +# this to a list of dicts carrying a per-example `cmd`.) +EXAMPLES = [ + "basic", + "basic_tunnel", + "calc", + "ecn", + "flowcache", + "link_monitor", + "load_balance", + "mri", + "multicast", + "qos", + "source_routing", +] + + +def run_example(name): + """Run one example and return (stdout, stderr, returncode).""" + workdir = HERE / name + cmd = [str(DPT), f"{name}.dpt", "--spec", f"{name}.json", "--silent"] + proc = subprocess.run( + cmd, + cwd=workdir, + capture_output=True, + text=True, + timeout=PER_TEST_TIMEOUT, + ) + return proc.stdout, proc.stderr, proc.returncode + + +def expected_path(name): + return EXPECTED_DIR / f"{name}.out" + + +def generate_expected(names): + """Run each example and save its stdout as the expected output trace.""" + EXPECTED_DIR.mkdir(exist_ok=True) + for name in names: + try: + stdout, stderr, rc = run_example(name) + except subprocess.TimeoutExpired: + print(f" TIMEOUT {name} (exceeded {PER_TEST_TIMEOUT}s) -- not saved") + continue + if rc != 0: + # Don't enshrine a broken run as the expected output. + print(f" ERROR {name} (dpt exit {rc}) -- not saved") + if stderr.strip(): + print(_indent(stderr.strip())) + continue + expected_path(name).write_text(stdout) + print(f" wrote expected/{name}.out ({_line_count(stdout)} lines)") + + +def check_example(name): + """Run one example and compare to its expected trace. Returns True on pass.""" + exp_file = expected_path(name) + if not exp_file.exists(): + print(f" MISSING {name} (no expected/{name}.out -- run with --expected)") + return False + try: + stdout, stderr, rc = run_example(name) + except subprocess.TimeoutExpired: + print(f" TIMEOUT {name} (exceeded {PER_TEST_TIMEOUT}s)") + return False + + expected = exp_file.read_text() + if stdout == expected: + print(f" PASS {name}") + return True + + print(f" FAIL {name} (output differs from expected/{name}.out)") + if rc != 0: + print(f" dpt exited non-zero ({rc})") + if stderr.strip(): + print(_indent(stderr.strip())) + _print_diff(expected, stdout) + return False + + +def _print_diff(expected, actual, max_lines=40): + import difflib + + diff = list( + difflib.unified_diff( + expected.splitlines(), + actual.splitlines(), + fromfile="expected", + tofile="actual", + lineterm="", + ) + ) + shown = diff[:max_lines] + print(_indent("\n".join(shown))) + if len(diff) > max_lines: + print(f" ... ({len(diff) - max_lines} more diff lines)") + + +def _indent(text, prefix=" | "): + return "\n".join(prefix + line for line in text.splitlines()) + + +def _line_count(text): + return text.count("\n") + (0 if text.endswith("\n") or not text else 1) + + +def main(): + parser = argparse.ArgumentParser( + description="Run the P4-BMv2 Lucid example tests against expected output." + ) + parser.add_argument( + "--expected", + action="store_true", + help="(re)generate the expected output files instead of checking", + ) + parser.add_argument( + "names", + nargs="*", + help="examples to run (default: all)", + ) + args = parser.parse_args() + + if not DPT.exists(): + sys.exit(f"error: dpt binary not found at {DPT}") + + if args.names: + unknown = [n for n in args.names if n not in EXAMPLES] + if unknown: + sys.exit( + f"error: unknown example(s): {', '.join(unknown)}\n" + f"known examples: {', '.join(EXAMPLES)}" + ) + names = args.names + else: + names = EXAMPLES + + if args.expected: + print(f"Generating expected output for {len(names)} example(s):") + generate_expected(names) + return + + print(f"Running {len(names)} example test(s):") + results = [check_example(name) for name in names] + passed = sum(results) + failed = len(results) - passed + print(f"\n{passed} passed, {failed} failed, {len(results)} total") + sys.exit(1 if failed else 0) + + +if __name__ == "__main__": + main() diff --git a/test/runtests.py b/test/runtests.py index 0c28c127..22c0e8cb 100644 --- a/test/runtests.py +++ b/test/runtests.py @@ -1,4 +1,4 @@ -import subprocess, os, filecmp +import subprocess, os, filecmp, sys """ This script is a simple test harness for the lucid interpreter and lucidcc compiler. @@ -174,11 +174,20 @@ def lucidcc_test(n_tests, i, fullfile, args): print("--- application tests ---") for file in appfiles: interp_test(file, []) + print("--- p4 bmv2 example tests ---") + bmv2_test = "examples/p4_bmv2_examples/test.py" + bmv2_ret = subprocess.run([sys.executable, bmv2_test]) + if bmv2_ret.returncode != 0: + diffs.append("p4_bmv2_examples") + print("Diffs:", diffs) print("Unexpected error:", errors) print("Unexpected success:", bad_successes) + + + elif (test_tgt == "lucidcc"): if not (os.path.isdir("test/ccoutput")): os.mkdir("test/ccoutput") From 8f515b9f3ddbb2b2769a2387dabb10746b6a4404 Mon Sep 17 00:00:00 2001 From: John Sonchack Date: Sat, 6 Jun 2026 23:26:50 -0400 Subject: [PATCH 23/49] notes --- examples/p4_bmv2_examples/README.md | 22 ++++++++++++---------- 1 file changed, 12 insertions(+), 10 deletions(-) diff --git a/examples/p4_bmv2_examples/README.md b/examples/p4_bmv2_examples/README.md index 9751b412..04aa96b8 100644 --- a/examples/p4_bmv2_examples/README.md +++ b/examples/p4_bmv2_examples/README.md @@ -1,20 +1,22 @@ # Example ports: P4 BMv2 tutorials → Lucid -This directory contains 12 [P4 BMv2 tutorial examples](https://github.com/p4lang/tutorials) ported to Lucid. Each port contains: a Lucid -program, an interpreter spec (some generated by a Python helper), +This directory contains 12 [P4 BMv2 tutorial examples](https://github.com/p4lang/tutorials) ported to Lucid. +Each port contains: a Lucid program, an interpreter spec (some generated by a Python helper), and a README. The examples demonstrate a number of design patterns in Lucid. +The `test.py` script runs all examples besides "p4runtime" in one shot. + | Example | Notes | |------------------|-------| | basic | LPM forwarding, 4-switch pod-topo, IPv4 csum recompute + verify | | basic_tunnel | Adds MyTunnel header + a second (exact-match) table; tunneled packets ride through unmodified | | calc | Custom L2 protocol, in-network arithmetic; first example with a `gen_spec.py` (scapy) | -| load_balance | 3-table pipeline (ecmp_group + ecmp_nhop + send_frame), TCP 5-tuple hash splits magic-IP flows across 2 hosts | -| source_routing | Header stack via unrolled parser chain + per-depth events (`sr1`..`sr4`); no tables | -| mri | Push-stack telemetry header, per-depth events `mri_0`..`mri_3`; `swid=self`, `qdepth=0` (interp doesn't model queues) | -| link_monitor | Probes carried as **regular events** (not packet events) — single handler, vector args; per-port byte_cnt + last_time arrays | -| flowcache | Exact-match `(proto, src, dst)` cache; miss → `packet_in` regular-event to controller exit port; spec acts as the controller | -| qos | basic-style forwarding + per-protocol DSCP marking; splits IPv4 TOS into diffserv:6 + ecn:2 | -| multicast | L2 learn/forward + `flood ingress_port` for unknown/broadcast; "flood except ingress" is a single built-in | +| load_balance | 3-table pipeline (ecmp_group + ecmp_nhop + send_frame), TCP 5-tuple hash splits flows across 2 next hops | +| source_routing | Header stack routing and polymorphic events | +| mri | Push-stack telemetry header, more polymorphic events | +| link_monitor | Probes as events, vector event args; per-port byte_cnt + last_time arrays | +| flowcache | Exact-match `(proto, src, dst)` cache; miss → `packet_in` event to controller; testing control in an interp input file | +| qos | basic-style forwarding + per-protocol DSCP marking | +| multicast | L2 learn/forward + `flood ingress_port` for unknown/broadcast | | p4runtime | Dynamic controller via `dpt --interactive` + a Python `controller.py`; same packet_in/install loop as flowcache but driven live | -| ecn | Synthetic queue depth (1-cell array) + recursive `queue_decr` event; ECN-mark / drop thresholds on the synthesized signal | +| ecn | Fixed-rate queue model using recursive `queue_decr` event; ECN-mark / drop thresholds on the synthesized signal | From 54a179834ea6c4890b2f48c93dd280e0d4d8a163 Mon Sep 17 00:00:00 2001 From: John Sonchack Date: Sun, 7 Jun 2026 08:39:39 -0400 Subject: [PATCH 24/49] removed a lot of dead code from frontend, relating to the old specialized / builtin tables --- src/lib/dune | 1 - src/lib/frontend/FrontendPipeline.ml | 3 - src/lib/frontend/Parser.mly | 7 - src/lib/frontend/Printing.ml | 49 +-- src/lib/frontend/Syntax.ml | 47 +-- src/lib/frontend/SyntaxUtils.ml | 37 -- .../analysis/GlobalConstructorTagging.ml | 24 -- .../analysis/SyntaxGlobalDirectory.ml | 17 - src/lib/frontend/analysis/Wellformed.ml | 2 - .../BuiltinsTupleElimination.ml | 5 - .../transformations/EStmtElimination.ml | 34 -- .../transformations/ModuleElimination.ml | 39 -- .../frontend/transformations/RefreshTypes.ml | 2 +- src/lib/frontend/transformations/Renaming.ml | 16 - .../frontend/transformations/TableInlining.ml | 176 --------- .../transformations/TupleElimination.ml | 50 +-- src/lib/frontend/typing/Typer.ml | 343 ------------------ src/lib/frontend/typing/TyperUnify.ml | 14 +- src/lib/midend/SourceTracking.ml | 14 +- .../midend/transformations/SyntaxToCore.ml | 194 +--------- 20 files changed, 13 insertions(+), 1061 deletions(-) delete mode 100644 src/lib/frontend/transformations/TableInlining.ml diff --git a/src/lib/dune b/src/lib/dune index 14dd3a2c..53ad5d15 100644 --- a/src/lib/dune +++ b/src/lib/dune @@ -58,7 +58,6 @@ eventFormat unrollRecursiveParsers functionInlining - tableInlining sizeInlining builtinsTupleElimination renaming diff --git a/src/lib/frontend/FrontendPipeline.ml b/src/lib/frontend/FrontendPipeline.ml index 6d532190..cb584b39 100644 --- a/src/lib/frontend/FrontendPipeline.ml +++ b/src/lib/frontend/FrontendPipeline.ml @@ -60,9 +60,6 @@ let process_prog ?(opts=def_opts) builtin_tys ds = print_if_verbose "-----------inlining functions-----------"; let ds = FunctionInlining.inline_prog ds in print_if_debug ds; - print_if_verbose "-----------inlining tables-----------"; - let ds = TableInlining.eliminate_prog ds in - print_if_debug ds; print_if_verbose "---------Eliminating events with global arguments----------"; let ds = GlobalArgElimination.eliminate_prog ds in print_if_debug ds; diff --git a/src/lib/frontend/Parser.mly b/src/lib/frontend/Parser.mly index 8678156a..da0705b9 100644 --- a/src/lib/frontend/Parser.mly +++ b/src/lib/frontend/Parser.mly @@ -14,10 +14,6 @@ let mk_trecord lst = TRecord (List.map (fun (id, ty) -> Id.name id, ty.raw_ty) lst) - let mk_t_table tkey_sizes tparam_tys tret_tys span = - Config.base_cfg.show_tvar_links <- true; - ty_sp (TTable({tkey_sizes; tparam_tys; tret_tys})) span - let mk_tmemop span n sizes = match sizes with | [s1] -> TMemop (n, s1) @@ -52,9 +48,6 @@ in value_sp (VGroup locs) span |> value_to_exp - let make_create_table tty tactions tsize tdefault span = - exp_sp (ETableCreate({tty; tactions; tsize; tdefault})) span - let mk_fty tspan params = let start_eff = FVar (QVar (Id.fresh "eff")) in let ret_ty = ty_sp TVoid tspan in diff --git a/src/lib/frontend/Printing.ml b/src/lib/frontend/Printing.ml index ca7c98f8..be020f2a 100644 --- a/src/lib/frontend/Printing.ml +++ b/src/lib/frontend/Printing.ml @@ -154,15 +154,6 @@ let rec raw_ty_to_string t = | TVector (ty, size) -> Printf.sprintf "%s[%s]" (raw_ty_to_string ty) (size_to_string size) | TTuple tys -> "(" ^ concat_map " * " raw_ty_to_string tys ^ ")" - | TTable t -> - " table_type {" - ^ "\n\tkey_size: " - ^ comma_sep ty_to_string t.tkey_sizes - ^ "\n\targ_ty: " - ^ comma_sep ty_to_string t.tparam_tys - ^ "\n\tret_ty: " - ^ comma_sep ty_to_string t.tret_tys - ^ "}\n" | TActionConstr a -> Printf.sprintf "(ACTION CTOR : (%s) -> (%s) -> (%s))" @@ -343,17 +334,6 @@ and e_to_string e = Printf.sprintf "to_int<<%s>>(%s)" (size_to_string sz1) (size_to_string sz2) | EStmt (s, e) -> Printf.sprintf "{%s; return %s}" (stmt_to_string s) (exp_to_string e) - | ETableCreate t -> - Printf.sprintf - "table_create<%s>((%s),%s, %s)" - (ty_to_string t.tty) - (concat_map "," exp_to_string t.tactions) - (exp_to_string t.tsize) - (exp_to_string t.tdefault) - (* (cid_to_string (fst t.tdefault)) - (comma_sep exp_to_string (snd t.tdefault)) *) - | ETableMatch tr -> - Printf.sprintf "table_match(%s);" (comma_sep exp_to_string tr.args) (* | EPatWild _ -> "_" *) and exp_to_string exp = @@ -379,14 +359,7 @@ and action_to_string (name, (ps, stmt)) = (params_to_string ps) (stmt_to_string stmt) -and entry_to_string entry = - Printf.sprintf - "[%s](%s) -> %s;" - (string_of_int entry.eprio) - (comma_sep exp_to_string entry.ematch) - (exp_to_string entry.eaction) - -and s_to_string s = +and s_to_string s = match s with | SAssign (i, e) -> id_to_string i ^ " = " ^ exp_to_string e ^ ";" | SNoop -> "skip;" @@ -455,26 +428,6 @@ and s_to_string s = (id_to_string i) (size_to_string k) (stmt_to_string s) - | STableMatch tbl_rec -> - if tbl_rec.out_tys <> None - then - Printf.sprintf - "%s %s = table_match(%s, (%s), (%s));" - (comma_sep ty_to_string (Option.get tbl_rec.out_tys)) - (comma_sep id_to_string tbl_rec.outs) - (exp_to_string tbl_rec.tbl) - (comma_sep exp_to_string tbl_rec.keys) - (comma_sep exp_to_string tbl_rec.args) - else - Printf.sprintf - "%s = table_match(%s);" - (comma_sep id_to_string tbl_rec.outs) - (comma_sep exp_to_string ((tbl_rec.tbl :: tbl_rec.keys) @ tbl_rec.args)) - | STableInstall (id, entries) -> - Printf.sprintf - "table_install(%s, {\n\t%s\n\t}\n);" - (exp_to_string id) - (List.map entry_to_string entries |> String.concat "\n") and stmt_to_string stmt = let s_str = s_to_string stmt.s in let prag_str = match stmt.spragmas with diff --git a/src/lib/frontend/Syntax.ml b/src/lib/frontend/Syntax.ml index 941950eb..c5ee9dd4 100644 --- a/src/lib/frontend/Syntax.ml +++ b/src/lib/frontend/Syntax.ml @@ -57,20 +57,13 @@ and raw_ty = | TRecord of (string * raw_ty) list | TVector of raw_ty * size | TTuple of raw_ty list - | TTable of tbl_ty | TBuiltin of cid * (raw_ty list) * bool (* new named builtin types. Table.t<>*) | TAction of acn_ty | TActionConstr of acn_ctor_ty | TPat of size (* number of bits *) | TBitstring -and tbl_ty = - { tkey_sizes : ty list - ; tparam_tys : ty list - ; tret_tys : ty list - } - -and acn_ty = +and acn_ty = { aarg_tys : tys; aret_tys : tys; @@ -179,13 +172,6 @@ and e = | EComp of exp * id * size (* Vector comprehension *) | EIndex of exp * size | ETuple of exp list - | ETableCreate of - { tty : ty - ; tactions : exp list - ; tsize : exp - ; tdefault : exp; (* ECall(default_acn_id, default_installtime_args) *) - } - | ETableMatch of tbl_match and exp = { e : e @@ -216,8 +202,6 @@ and s = | SSeq of statement * statement | SMatch of exp list * branch list | SLoop of statement * id * size - | STableMatch of tbl_match - | STableInstall of exp * tbl_entry list and tuple_assign = { ids : id list; @@ -225,27 +209,6 @@ and tuple_assign = { exp : exp; } -and tbl_match = - { tbl : exp - ; keys : exp list - ; args : exp list - ; outs : id list - ; out_tys : ty list option - } -(* out_tys is populated for statements that create new vars *) - -(* entries are like branches in match statements, except instead of - a statement there is a call to an action (really an action generator) *) - -(* notes on entry priorities: - 1. Lower priorities are checked first. - 2. Priorities should be a bounded size, under 24 bits for tof. *) -and tbl_entry = - { eprio : int - ; ematch : exp list (*expresisons because some patterns are given as mask operations *) - ; eaction : exp (* ecall(action id, action args) *) - } - and statement = { s : s ; sspan : sp @@ -488,10 +451,6 @@ let tuple_sp_ty es span = let ty = ty (TTuple tys) in aexp (ETuple es) (Some ty) span ;; -let tblmatch_sp tbl keys args span = - let t = { tbl; keys; args; outs = []; out_tys = None } in - exp_sp (ETableMatch t) span -;; (* declarations *) let decl d = { d; dspan = Span.default; dpragmas = []; } @@ -566,10 +525,6 @@ let sexp_sp e span = statement_sp (SUnit e) span let scall_sp cid es span = sexp_sp (call_sp cid es span) span let sucall_sp cid es span = sexp_sp (ucall_sp cid es span) span -let tblinstall_sp tbl entries span = - statement_sp (STableInstall (tbl, entries)) span -;; - let noinline stmt = { stmt with spragmas = (Pragma.sprag "noinline" [])::stmt.spragmas } (* Interface spefications *) diff --git a/src/lib/frontend/SyntaxUtils.ml b/src/lib/frontend/SyntaxUtils.ml index d4d991e1..6b518ffb 100644 --- a/src/lib/frontend/SyntaxUtils.ml +++ b/src/lib/frontend/SyntaxUtils.ml @@ -67,7 +67,6 @@ let rec is_global_rty rty = | TTuple lst -> List.exists is_global_rty lst | TRecord lst -> List.exists (fun (_, rty) -> is_global_rty rty) lst | TVector (t, _) -> is_global_rty t - | TTable _ -> true | TActionConstr _ -> false | TAction _ -> false | TBitstring -> false @@ -86,7 +85,6 @@ let rec is_not_global_rty rty = | TTuple lst -> List.for_all is_not_global_rty lst | TRecord lst -> List.for_all (fun (_, rty) -> is_not_global_rty rty) lst | TVector (t, _) -> is_not_global_rty t - | TTable _ -> false | TActionConstr _ -> true | TAction _ -> true | TBitstring -> true @@ -277,10 +275,6 @@ let rec is_polymorphic_raw_ty rty = | TRecord fields -> List.exists (fun (_, rty) -> is_polymorphic_raw_ty rty) fields | TVector (rty, sz) -> is_polymorphic_raw_ty rty || is_polymorphic_size sz | TTuple rtys -> List.exists is_polymorphic_raw_ty rtys - | TTable tbl -> - List.exists is_polymorphic_ty tbl.tkey_sizes - || List.exists is_polymorphic_ty tbl.tparam_tys - || List.exists is_polymorphic_ty tbl.tret_tys | TBuiltin (_, rtys, _) -> List.exists is_polymorphic_raw_ty rtys | TAction acn -> List.exists is_polymorphic_ty acn.aarg_tys @@ -344,10 +338,6 @@ let rec equiv_raw_ty ?(ignore_effects = false) ?(qvars_wild = false) ?(ignore_qv if List.length lst1 <> List.length lst2 then false else List.for_all2 equiv_raw_ty lst1 lst2 - | TTable t1, TTable t2 -> - List.for_all2 equiv_ty t1.tkey_sizes t2.tkey_sizes - && List.for_all2 equiv_ty t1.tparam_tys t2.tparam_tys - && List.for_all2 equiv_ty t1.tret_tys t2.tret_tys | TBitstring, TBitstring -> true | ( (TBitstring | TBool @@ -365,7 +355,6 @@ let rec equiv_raw_ty ?(ignore_effects = false) ?(qvars_wild = false) ?(ignore_qv | TAbstract _ | TActionConstr _ | TAction _ - | TTable _ | TBuiltin _) , _ ) -> false @@ -409,7 +398,6 @@ let default_expression ty = | TFun _ -> failwith "Cannot create default expression for function" | TActionConstr _ -> failwith "Cannot create default expression for action" | TAction _ -> failwith "Cannot create default expression for action" - | TTable _ -> failwith "Cannot create default expression for table" | TQVar _ -> failwith "Cannot create default expression for type variable" | TBitstring -> failwith "Cannot create default expression for bitstring" @@ -428,8 +416,6 @@ let rec is_compound e = match e.e with | EInt _ | EVal _ | EVar _ | ESizeCast _ -> false | EHash _ | EOp _ | ECall _ | EStmt _ -> true - | ETableCreate _ -> true - | ETableMatch _ -> true | EComp (e, _, _) | EIndex (e, _) | EProj (e, _) | EGet (e, _) | EFlood e -> is_compound e | EVector entries | ETuple entries -> List.exists is_compound entries | ERecord entries -> List.exists (is_compound % snd) entries @@ -544,19 +530,6 @@ let mk_daction_ctor id rty cp p body span = let mk_daction id rty p body span = decl_sp (DAction (id, rty, (p, extract_action_body body))) span -let mk_entry prio pats acn args span = - { eprio = prio; ematch = pats; eaction = Syntax.ucall_sp (Cid.id acn) args span;} -;; - -let mk_tblinstall_single tbl entries span = - if List.length entries > 1 - then - Console.error_position - span - "table_install can only install one entry at a time." - else tblinstall_sp tbl entries span -;; - let unpack_tuple (e : exp) = match e.e with | ETuple lst -> lst @@ -584,13 +557,6 @@ let rec flatten_size size = ;; -let unpack_default_action e = - match e with - | ECall(cid, args, flag) -> cid, args, flag - | _ -> error "default table action must be a expression" -;; - - let cid_of_exp (ex : exp) : Cid.t = match ex.e with | EVar n -> n @@ -677,7 +643,6 @@ let raw_ty_to_constr_str raw_ty = | TRecord (_) -> "record" | TVector (_) -> "vector" | TTuple (_) -> "tuple" - | TTable (_) -> "table" | TActionConstr (_) -> "action" | TPat (_) -> "pat" | TQVar (_) -> "qvar" @@ -733,8 +698,6 @@ let e_to_constr_str e = match e with | EComp (_) -> "comp" | EIndex (_) -> "index" | ETuple (_) -> "tuple" -| ETableCreate (_) -> "tablecreate" -| ETableMatch (_) -> "tablematch" (* | EPatWild (_) -> "patwild" *) ;; diff --git a/src/lib/frontend/analysis/GlobalConstructorTagging.ml b/src/lib/frontend/analysis/GlobalConstructorTagging.ml index 2c082f78..1cc77cd4 100644 --- a/src/lib/frontend/analysis/GlobalConstructorTagging.ml +++ b/src/lib/frontend/analysis/GlobalConstructorTagging.ml @@ -34,7 +34,6 @@ let gty_to_tag ty = match (TyTQVar.strip_links ty.raw_ty) with (* error ("[gty_to_tag] unknown global constructor type: "^(Printing.ty_to_string ty)) *) ) - | TTable _ -> (tabletag) | TActionConstr _ -> (actiontag) | TRecord _ -> (recordtag) | TVector _ -> (tupletag) @@ -133,21 +132,6 @@ let rec globals_of_econstr user_constrs parent_tcid var_tcid constr_exp : (exp) (* note that we give back the original constructor with the new annotations *) {constr_exp with espan=annotated_inner_econstr.espan;} )) - | ETableCreate(tbl) -> ( - (* print_endline ("[globals_of_econstr.ETableCreate]"); *) - (* annotate the table constructor just like an array *) - (* let fully_qualified_cid = cid_concats (var_path@[var_cid]) in *) - (* but also, annotate the action references with their source names. - Note that action names are not type fields, but declared in - modules, like functions. (So var_path is not relevant) *) - let tactions' = List.map - (fun action -> - annotate_espan action None (SyntaxUtils.cid_of_exp action |> cid)) - tbl.tactions - in - let e' = ETableCreate({tbl with tactions = tactions';}) in - annotate_espan {constr_exp with e=e'} parent_tcid var_tcid - ) | ERecord(fields) -> ( (* print_endline ("[globals_of_econstr.ERecord]"); print_endline ("[globals_of_econstr.INPUT] "^(annotated_exp_to_string annotated_constr_exp)); *) @@ -399,14 +383,6 @@ let debug_tagged_global_names decls = in name_map := action_names@(!name_map); ); - method! visit_ETableCreate () _ tbl_action_exps _ _ = - let action_names = List.map - (fun eaction -> - SyntaxUtils.cid_of_exp eaction, Option.get eaction.espan.global_created_in_src) - tbl_action_exps - in - - name_map := action_names@(!name_map); end in v#visit_decls () decls; diff --git a/src/lib/frontend/analysis/SyntaxGlobalDirectory.ml b/src/lib/frontend/analysis/SyntaxGlobalDirectory.ml index 1a324b23..cb9577d0 100644 --- a/src/lib/frontend/analysis/SyntaxGlobalDirectory.ml +++ b/src/lib/frontend/analysis/SyntaxGlobalDirectory.ml @@ -88,7 +88,6 @@ let exp_to_tblmeta id exp = {aid; acompiled_id; arg_sizes} in let keys = match TyTQVar.strip_links ((Option.get exp.ety).raw_ty) with - | TTable(tty) -> (List.map user_key tty.tkey_sizes)@[priority_key] | TName(_, sizes, _) -> let key_sz = List.nth sizes 0 in let key_sizes = SyntaxUtils.flatten_size key_sz in @@ -101,13 +100,6 @@ let exp_to_tblmeta id exp = | raw_ty -> error@@"[exp_to_tblmeta] expression is not a table type ("^(Printing.raw_ty_to_string raw_ty)^")" in let actions, length = match exp.e with - | ETableCreate(tbl) -> ( - List.map evar_to_action tbl.tactions, - match tbl.tsize.e with - | EVal({v=VInt(z); _}) -> - Integer.to_int z - | EInt(z, _) -> Z.to_int z - | _ -> error "[exp_to_tblmeta] table size expression is not an EVal(EInt(...))") | ECall(_, [len_exp; acns_exp; _], _) | ECall(_, [len_exp; acns_exp; _; _], _) -> ( List.map evar_to_action (SyntaxUtils.flatten_exp acns_exp), @@ -170,9 +162,6 @@ let core_exp_to_tblmeta id (exp : C.exp) = | TName(_, sizes) -> let key_sizes = CoreSyntax.size_to_ints (List.hd sizes) in (List.map user_key key_sizes)@[priority_key] - (* | TTable(tty) -> - let key_sizes = List.map (fun sz -> match sz with | C.Sz sz -> sz | _ -> error "need singleton size") tty.tkey_sizes in - (List.map user_key key_sizes)@[priority_key] *) | _ -> error "[exp_to_tblmeta] expression is not a table type" in let actions, length = match exp.e with @@ -186,12 +175,6 @@ let core_exp_to_tblmeta id (exp : C.exp) = | EVal({v=VInt(z); _}) -> Integer.to_int z | _ -> error "[exp_to_tblmeta] table size expression is not an EVal(EInt(...))" ) - (* | ETableCreate(tbl) -> ( - List.map evar_to_action tbl.tactions, - match tbl.tsize.e with - | EVal({v=VInt(z); _}) -> - Integer.to_int z - | _ -> error "[exp_to_tblmeta] table size expression is not an EVal(EInt(...))") *) | _ -> error "[exp_to_tblmeta] expression is not a table create" in let compiled_cid = (Cid.id id) in diff --git a/src/lib/frontend/analysis/Wellformed.ml b/src/lib/frontend/analysis/Wellformed.ml index 266e969d..f1daf900 100644 --- a/src/lib/frontend/analysis/Wellformed.ml +++ b/src/lib/frontend/analysis/Wellformed.ml @@ -483,8 +483,6 @@ let basic_qvar_checker = span <- ty.tspan; super#visit_ty env ty - (* table types are always allowed to have QVars *) - method! visit_TTable _ _ = () method! visit_exp _ _ = () method! visit_decl env d = diff --git a/src/lib/frontend/transformations/BuiltinsTupleElimination.ml b/src/lib/frontend/transformations/BuiltinsTupleElimination.ml index 0690e487..94fd6e5e 100644 --- a/src/lib/frontend/transformations/BuiltinsTupleElimination.ml +++ b/src/lib/frontend/transformations/BuiltinsTupleElimination.ml @@ -102,9 +102,6 @@ let rec eliminate_exp e = let stmt, e' = eliminate_exp e in stmt, { e with e = EComp (e', id, size) } (* | EPatWild _ -> snoop, e *) - | ETableMatch _ -> snoop, e - | ETableCreate _ -> snoop, e - (* error "special table syntax is depreciated" *) and eliminate_exps exps = let acc = @@ -179,8 +176,6 @@ and eliminate_stmt stmt = | SLoop (stmt, id, size) -> { stmt with s = SLoop (eliminate_stmt stmt, id, size) } | STupleAssign _ -> stmt (* noop for tuple assignments *) - | STableMatch _ -> stmt - | STableInstall _ -> stmt ;; let eliminator = diff --git a/src/lib/frontend/transformations/EStmtElimination.ml b/src/lib/frontend/transformations/EStmtElimination.ml index 2c9bed30..36f8673c 100644 --- a/src/lib/frontend/transformations/EStmtElimination.ml +++ b/src/lib/frontend/transformations/EStmtElimination.ml @@ -50,27 +50,8 @@ let rec inline_exp e = | ETuple es -> let stmt, es' = inline_exps es in stmt, { e with e = ETuple es' } - | ETableCreate tc -> - let acn_stmt, tactions = inline_exps tc.tactions in - let def_cid, def_args, def_flag = unpack_default_action tc.tdefault.e in - let def_stmt, def_args = inline_exps def_args in - let tdefault = {tc.tdefault with e = ECall(def_cid, def_args, def_flag)} in - sseq - acn_stmt def_stmt - ,{e with e = ETableCreate({tc with tactions; tdefault})} - | ETableMatch(tm) -> - let stmt, tm' = inline_tbl_match tm in - stmt, {e with e = ETableMatch(tm')} (* | EPatWild _ -> snoop, e *) -and inline_tbl_match tm = - let tbl_stmt, tbl = inline_exp tm.tbl in - let keys_stmt, keys = inline_exps tm.keys in - let args_stmt, args = inline_exps tm.args in - sseq tbl_stmt (sseq keys_stmt args_stmt), - {tm with tbl; keys; args} - - and inline_exps es = List.fold_right (fun e (acc_s, acc_es) -> @@ -113,21 +94,6 @@ and inline_stmt s = let branches' = List.map (fun (p, stmt) -> p, inline_stmt stmt) branches in sseq s' { s with s = SMatch (es', branches') } | SLoop (s1, id, sz) -> { s with s = SLoop (inline_stmt s1, id, sz) } - | STableMatch(tm) -> - let pre_s, tm' = inline_tbl_match tm in - sseq pre_s {s with s=STableMatch(tm')} - | STableInstall(tbl_id, entries) -> - let stmt, entries_rev = List.fold_left - (fun (s,entries) entry -> - let acn_cid, eargs, flag = unpack_default_action entry.eaction.e in - let a_s, eargs = inline_exps eargs in - let entry = {entry with eaction = {entry.eaction with e = ECall(acn_cid, eargs, flag)}} in - sseq a_s s, entry::entries) - (snoop, []) - entries - in - let entries = List.rev entries_rev in - sseq stmt {s with s=STableInstall(tbl_id, entries)} ;; let eliminator = diff --git a/src/lib/frontend/transformations/ModuleElimination.ml b/src/lib/frontend/transformations/ModuleElimination.ml index fab6a78e..154dd834 100644 --- a/src/lib/frontend/transformations/ModuleElimination.ml +++ b/src/lib/frontend/transformations/ModuleElimination.ml @@ -40,45 +40,6 @@ let subst = in TName (cid, sizes, b) - method! visit_ETableCreate env tty tactions tsize tdefault = - let tactions = List.map (self#visit_exp env) tactions in - let tdefault_cid, tdefault_args, flag = match tdefault.e with - | ECall(tdefault_cid, tdefault_args, flag) -> tdefault_cid, tdefault_args, flag - | _ -> error "internal error: default table action in constructor is not a call" - in - - let tdefault_args = - List.map (self#visit_exp env) tdefault_args - in - (* rename the default action cid *) - let tdefault_cid = - match CidMap.find_opt tdefault_cid env.vars with - | None -> tdefault_cid - | Some tdefault_cid' -> Id tdefault_cid' - in - ETableCreate - { tty; tactions; tsize; tdefault = {tdefault with e=ECall(tdefault_cid, tdefault_args, flag)}} - - method! visit_STableInstall env etbl entries = - let etbl = self#visit_exp env etbl in - let entries = - List.map - (fun entry -> - { entry with - ematch = List.map (self#visit_exp env) entry.ematch - ; eaction = - let action_cid, action_args, flag = unpack_default_action entry.eaction.e in - let action_cid = match CidMap.find_opt action_cid env.vars with - | None -> action_cid - | Some new_action_id -> (Cid.id new_action_id) - in - let action_args = List.map (self#visit_exp env) action_args in - { entry.eaction with e = ECall(action_cid, action_args, flag) } - }) - entries - in - STableInstall (etbl, entries) - method! visit_ECall env x args u = let args = List.map (self#visit_exp env) args in let x = diff --git a/src/lib/frontend/transformations/RefreshTypes.ml b/src/lib/frontend/transformations/RefreshTypes.ml index b3018383..a200057f 100644 --- a/src/lib/frontend/transformations/RefreshTypes.ml +++ b/src/lib/frontend/transformations/RefreshTypes.ml @@ -1,6 +1,6 @@ (* Reset effect annotations on types inside handler and function bodies. This is a temporary patch / hack for type checking to work in - certain phases of the frontend (from TableInlining to MonomorphicEventArgs), + certain phases of the frontend (from function inlining to MonomorphicEventArgs), After a typing pass, types in handler bodies carry resolved effects with specific index variable IDs. These conflict with fresh variables created by a subsequent typing pass. This pass replaces those teffect fields with diff --git a/src/lib/frontend/transformations/Renaming.ml b/src/lib/frontend/transformations/Renaming.ml index 3e0f7e2a..cb2b7101 100644 --- a/src/lib/frontend/transformations/Renaming.ml +++ b/src/lib/frontend/transformations/Renaming.ml @@ -232,22 +232,6 @@ let rename prog = let new_exp = self#visit_exp dummy exp in PLocal (new_x, new_ty, new_exp) - method! visit_STableMatch dummy tm = - let tbl = self#visit_exp dummy tm.tbl in - let keys = List.map (self#visit_exp dummy) tm.keys in - let args = List.map (self#visit_exp dummy) tm.args in - (* rename if the variables are declared here *) - let outs, out_tys = - match tm.out_tys with - | None -> - (* must visit outs because they have been renamed too. *) - List.map (self#visit_id dummy) tm.outs, None - | Some out_tys -> - ( List.map self#freshen_var tm.outs - , Some (List.map (self#visit_ty dummy) out_tys) ) - in - STableMatch { tbl; keys; args; outs; out_tys } - method! visit_body dummy (params, body) = let old_env = env in let new_params = diff --git a/src/lib/frontend/transformations/TableInlining.ml b/src/lib/frontend/transformations/TableInlining.ml deleted file mode 100644 index 3b7a66db..00000000 --- a/src/lib/frontend/transformations/TableInlining.ml +++ /dev/null @@ -1,176 +0,0 @@ -(* This pass translates ETableMatches into STableMatches *) - -open Syntax -open SyntaxUtils -open Collections -module CMap = Collections.CidMap - -let fresh_intermediate () = Id.fresh "tbl_ret" - -(* eliminate table expression in an expression *) -let rec eliminate_exp e = - match e.e with - | ETableMatch tr -> - (* replace table apply expression with: - 1. an intermediate variable that gets set in a pre statement - 2. an evar of the intermediate *) - let outvar = fresh_intermediate () in - let outvar_ty = Option.get e.ety in - let args_pre_stmt, args' = eliminate_exps tr.args in - let new_tr = - { tr with outs = [outvar]; out_tys = Some [outvar_ty]; args = args' } - in - let sapply = - statement_sp (STableMatch(new_tr)) Span.default - (* { s = STableMatch new_tr; sspan = Span.default; noinline = false } *) - in - sseq args_pre_stmt sapply, { e with e = EVar (Cid.id outvar) } - (* all other cases just recurse *) - | EStmt (s1, e1) -> - let s1' = eliminate_stmt s1 in - let e1s', e1' = eliminate_exp e1 in - e1s', { e with e = EStmt (s1', e1') } - | EVal _ | EInt _ | EVar _ | ESizeCast _ -> snoop, e - | EOp (op, es) -> - let stmt, es' = eliminate_exps es in - stmt, { e with e = EOp (op, es') } - | ECall (cid, es, u) -> - let stmt, es' = eliminate_exps es in - stmt, { e with e = ECall (cid, es', u) } - | EHash (sz, es) -> - let stmt, es' = eliminate_exps es in - stmt, { e with e = EHash (sz, es') } - | EFlood e -> - let stmt, e' = eliminate_exp e in - stmt, { e with e = EFlood e' } - | ERecord lst -> - let strs, es = List.split lst in - let stmt, es = eliminate_exps es in - stmt, { e with e = ERecord (List.combine strs es) } - | EWith (e1, lst) -> - let stmt1, e1' = eliminate_exp e1 in - let strs, es = List.split lst in - let stmt2, es = eliminate_exps es in - sseq stmt1 stmt2, { e with e = EWith (e1', List.combine strs es) } - | EProj (e1, str) -> - let stmt, e1' = eliminate_exp e1 in - stmt, { e with e = EProj (e1', str) } - | EGet (e1, str) -> - let stmt, e1' = eliminate_exp e1 in - stmt, { e with e = EGet (e1', str) } - | EVector es -> - let stmt, es' = eliminate_exps es in - stmt, { e with e = EVector es' } - | EIndex (e1, sz) -> - let stmt, e1' = eliminate_exp e1 in - stmt, { e with e = EIndex (e1', sz) } - | ETuple es -> - let stmt, es' = eliminate_exps es in - stmt, { e with e = ETuple es' } - (* table apply can't appear in a table create expression *) - | ETableCreate _ -> snoop, e - | EComp (e, id, size) -> - let stmt, e' = eliminate_exp e in - stmt, { e with e = EComp (e', id, size) } - (* | EPatWild _ -> snoop, e *) - -(* eliminate table expressions in a list of expressions *) -and eliminate_exps exps = - let acc = - List.fold_left - (fun (pre_stmt, exps) exp -> - match eliminate_exp exp with - | { s = SNoop }, exp' -> pre_stmt, exp' :: exps - | stmt, exp' -> sseq pre_stmt stmt, exp' :: exps) - (snoop, []) - exps - in - let pre_stmt, args' = fst acc, List.rev (snd acc) in - pre_stmt, args' - -(* eliminate table expression in a statement. - SAssign and SLocal with rhs of ETableMatch are translated directly - for all other statements, recurse on inner components to generate - pre-compute statement, then return {pre-compute statement; statement;} *) -and eliminate_stmt stmt = - match stmt.s with - (* locals and assigns get special cased to avoid copy overhead *) - | SAssign (id, { e = ETableMatch tr }) -> - let pre_stmt, args' = eliminate_exps tr.args in - let new_tr = { tr with args = args'; outs = [id]; out_tys = None } in - sseq pre_stmt { stmt with s = STableMatch new_tr } - | SLocal (id, ty, { e = ETableMatch tr }) -> - (* I think we can throw away the local's type because its - in the table type *) - let pre_stmt, args' = eliminate_exps tr.args in - let new_tr = { tr with args = args'; outs = [id]; out_tys = Some [ty] } in - sseq pre_stmt { stmt with s = STableMatch new_tr } - (* everything else is just recursing *) - | SNoop -> stmt - | SUnit exp -> - let pre_stmt, exp' = eliminate_exp exp in - sseq pre_stmt { stmt with s = SUnit exp' } - | SLocal (id, ty, exp) -> - let pre_stmt, exp' = eliminate_exp exp in - sseq pre_stmt { stmt with s = SLocal (id, ty, exp') } - | SAssign (id, exp) -> - let pre_stmt, exp' = eliminate_exp exp in - sseq pre_stmt { stmt with s = SAssign (id, exp') } - | SPrintf (str, exps) -> - let pre_stmt, exps' = eliminate_exps exps in - sseq pre_stmt { stmt with s = SPrintf (str, exps') } - | SIf (exp, s1, s2) -> - let pre_stmt, exp' = eliminate_exp exp in - let s1', s2' = eliminate_stmt s1, eliminate_stmt s2 in - sseq pre_stmt { stmt with s = SIf (exp', s1', s2') } - | SGen (gty, exp) -> - let pre_stmt, exp = eliminate_exp exp in - sseq pre_stmt { stmt with s = SGen (gty, exp) } - | SRet None -> stmt - | SRet (Some exp) -> - let pre_stmt, exp = eliminate_exp exp in - sseq pre_stmt { stmt with s = SRet (Some exp) } - | SSeq (s1, s2) -> - { stmt with s = SSeq (eliminate_stmt s1, eliminate_stmt s2) } - | SMatch (exps, branches) -> - let pre_stmt, exps = eliminate_exps exps in - let branches = - List.map - (fun (pats, statement) -> pats, eliminate_stmt statement) - branches - in - sseq pre_stmt { stmt with s = SMatch (exps, branches) } - | SLoop (stmt, id, size) -> - { stmt with s = SLoop (eliminate_stmt stmt, id, size) } - | STupleAssign _ -> error "Table inlining should not be necessary once tuple assignment is implemented..." - | STableMatch t -> - let pre_tble, tbl = eliminate_exp t.tbl in - let pre_key, keys = eliminate_exps t.keys in - let pre_aargs, args = eliminate_exps t.args in - let pre_stmt = sseq (sseq pre_tble pre_key) pre_aargs in - let t' = { t with tbl; keys; args } in - sseq pre_stmt { stmt with s = STableMatch t' } - | STableInstall (tbl_id, entries) -> - let pre_stmt, entries_rev = - List.fold_left - (fun (pre_stmt, entries') entry -> - let action_cid, eargs, flag = unpack_default_action entry.eaction.e in - let args_stmt, eargs = eliminate_exps eargs in - let entry = { entry with eaction = {entry.eaction with e = ECall(action_cid, eargs, flag)}} in - sseq pre_stmt args_stmt, entry :: entries') - (snoop, []) - entries - in - sseq pre_stmt { stmt with s = STableInstall (tbl_id, List.rev entries_rev) } -;; - -let eliminator = - object - inherit [_] s_map as super - method! visit_statement _ s = eliminate_stmt s - (* notice that we don't recurse, so this will be - the first statement of every declaration *) - end -;; - -let eliminate_prog (ds : decl list) = eliminator#visit_decls () ds diff --git a/src/lib/frontend/transformations/TupleElimination.ml b/src/lib/frontend/transformations/TupleElimination.ml index a88c6581..5498f871 100644 --- a/src/lib/frontend/transformations/TupleElimination.ml +++ b/src/lib/frontend/transformations/TupleElimination.ml @@ -150,17 +150,7 @@ let replacer = object (self) inherit [_] s_map as super - (* Table extensions -- types *) - method! visit_TTable _ tbl_ty = - (* flatten param and return types *) - let tbl_ty' = - { tbl_ty with - tparam_tys = flatten_tys tbl_ty.tparam_tys - ; tret_tys = flatten_tys tbl_ty.tret_tys - } - in - TTable tbl_ty' - method! visit_TBuiltin _ cid raw_tys bool = + method! visit_TBuiltin _ cid raw_tys bool = (* Builtins may carry tuples, but singleton tuples must be unpacked. *) let raw_tys' = List.map ( @@ -217,39 +207,6 @@ let replacer = let ids' = List.map lookup_flat_ids tuple_assign.ids |> List.flatten in STupleAssign { tuple_assign with ids = ids' } - (* Table extensions -- statements *) - method! visit_STableMatch env tblmatch = - (* recurse on inner components *) - let tblmatch = self#visit_tbl_match env tblmatch in - match tblmatch.out_tys with - (* the match table creates new variables, which - we must flatten *) - | Some out_tys -> - let var_defs = List.combine tblmatch.outs out_tys in - let env', new_var_defs = flatten_params !env var_defs in - let outs', out_tys' = List.split new_var_defs in - (* update the environment with the new ids *) - env := env'; - (* return apply table statement with updates *) - STableMatch { tblmatch with outs = outs'; out_tys = Some out_tys' } - | None -> - (* the match table writes existing variables, we must - find their flattened id *) - let rec lookup_flat_ids id : id list = - match IdMap.find_opt id !env with - | None -> [id] (* not a tuple *) - | Some ids_tys -> - List.map lookup_flat_ids (List.split ids_tys |> fst) |> List.flatten - in - let outs' = List.map lookup_flat_ids tblmatch.outs |> List.flatten in - STableMatch { tblmatch with outs = outs' } - - method! visit_ETableMatch _ tblmatch = - Console.error_position - tblmatch.tbl.espan - "Table apply expressions should be converted to statements before \ - tuple elim." - (* Split into a bunch of variable definitions, one for each tuple element. *) method! visit_SLocal env id ty exp = @@ -579,10 +536,7 @@ let rec replace_decl (env : env) d = es in replace_decls env new_ds - (* The tuple types inside of a table types must be flattened *) - | TTable _ -> - env, [{ d with d = DGlobal (id, replace_ty ty, replace_exp env exp) }] - | TName _ -> + | TName _ -> env, [{ d with d = DGlobal (id, replace_ty ty, replace_exp env exp) }] | TBuiltin _-> env, [{ d with d = DGlobal (id, replace_ty ty, replace_exp env exp) }] diff --git a/src/lib/frontend/typing/Typer.ml b/src/lib/frontend/typing/Typer.ml index d33ce8d3..efdc8b2f 100644 --- a/src/lib/frontend/typing/Typer.ml +++ b/src/lib/frontend/typing/Typer.ml @@ -452,106 +452,6 @@ let rec infer_exp (env : env) (e : exp) : env * exp = let env, inf_s = infer_statement env s in let env, inf_e1, inf_e1ty = infer_exp env e1 |> textract in env, { e with e = EStmt (inf_s, inf_e1); ety = Some inf_e1ty } - | ETableCreate ecreate -> - let env, inf_tsize = infer_exp env ecreate.tsize in - let unify_arg_tys sp msg tys1 tys2 = - if List.length tys1 <> List.length tys2 - then error_sp sp ("wrong number of match-time arguments " ^ msg); - List.iter2 (unify_ty e.espan) tys1 tys2 - in - (* for actions, we check the action args and return types *) - (* expected types come from table type *) - let exp_atys, exp_rty = - match ecreate.tty.raw_ty with - | TTable trec -> trec.tparam_tys, trec.tret_tys - | _ -> error "expected table type" - in - (* inferred types come from actions passed as arguments *) - let env, inf_acns = infer_exps env ecreate.tactions in - let check_acn_ctor_ty e_inf_acn = - let inf_atys, inf_rty = - match (Option.get e_inf_acn.ety).raw_ty with - | TActionConstr {aacn_ty = {aarg_tys; aret_tys} } -> aarg_tys, aret_tys - | _ -> error "not an action" - in - (* unify runtime arg and return types *) - unify_arg_tys - e_inf_acn.espan - "in action assigned to table" - exp_atys - inf_atys; - unify_arg_tys - e_inf_acn.espan - "in return of action assigned to table" - exp_rty - inf_rty - in - List.iter check_acn_ctor_ty inf_acns; - (* infer types of default action args *) - let def_cid, def_args, flag = unpack_default_action ecreate.tdefault.e in - let env, inf_def_args = infer_exps env def_args in - (* type check the default action's const args *) - let expected_def_arg_tys = - match (lookup_var e.espan env def_cid).raw_ty with - | TActionConstr a -> a.aconst_param_tys - | _ -> error_sp e.espan "the default action does not have type TActionConstr" - in - let inf_def_arg_tys = - List.map (fun exp -> Option.get exp.ety) inf_def_args - in - unify_arg_tys - e.espan - ("provided to default action \"" ^ Printing.cid_to_string def_cid ^ "\"") - expected_def_arg_tys - inf_def_arg_tys; - (* check that the default action is one of the table's actions *) - let tbl_acn_cids = - List.map - (fun exp -> - match exp.e with - | EVar cid -> cid - | _ -> error_sp exp.espan "table actions must be a list of action ids") - inf_acns - in - if not (List.exists (Cid.equal def_cid) tbl_acn_cids) - then - error_sp - e.espan - ("default action (" - ^ Printing.cid_to_string def_cid - ^ ") is not an action assigned to the table."); - (* The constructor expression must have an unbound effect, or it may not - unify with the type of the declaration. Note that, we cannot infer the - full table type from the constructor expression, because the constructor - expression doesn't know what the table keys are. *) - let ety = { ecreate.tty with teffect = fresh_effect () } in - (* return typed table with typed action args *) - ( env - , { e with - e = - ETableCreate - { ecreate with - tactions = inf_acns - ; tsize = inf_tsize - (* note that the default action expression is currently typed as TVoid, because the type - never matters except for earlier in this checking branch, where it is obtained from elsewhere *) - ; tdefault = {ecreate.tdefault with e=ECall(def_cid, inf_def_args, flag); ety=Some(ty TVoid)} - } - ; ety = Some ety - } ) - | ETableMatch tr -> - let new_env, new_tr, ret_ty = infer_tblmatch env tr e.espan in - let ret_ty = - match ret_ty with - | [ret_ty] -> ret_ty - | _ -> - error - "table apply expression has multiple return types. This should be \ - impossible." - in - let new_e = ETableMatch new_tr in - new_env, { e with e = new_e; ety = Some ret_ty } - and infer_op env span op args = let env, ty, new_args = @@ -701,132 +601,6 @@ and infer_exps env es = in env, List.rev es' -and infer_action_args env sp (acn_args : exp list) (expected_arg_tys : ty list) = - let _, inf_acn_args = infer_exps env acn_args in - List.iter2 - (fun inf_e expect_ty -> - match inf_e.ety with - | Some ty -> try_unify_ty sp ty expect_ty - | None -> error_sp sp "could not infer type of action argument") - inf_acn_args - expected_arg_tys; - inf_acn_args - -and infer_keys env sp (inf_keysizes : ty list) keys = - let inf_keys = List.map (infer_exp env) keys |> List.split |> snd in - if List.length inf_keysizes <> List.length keys - then error_sp sp "Key has incorrect number of fields for table_type."; - List.iter2 - (fun key_exp inf_keysz -> - let keysz = - match key_exp.ety with - | None -> error_sp key_exp.espan "Could not infer type" - | Some ty -> ty - in - unify_ty sp keysz inf_keysz) - inf_keys - inf_keysizes; - inf_keys - -(* for table return types *) -and tup_of_tys tys = - match tys with - | [t] -> t.raw_ty - | _ -> TTuple (List.map (fun ty -> ty.raw_ty) tys) - -and infer_tblmatch (env : env) (tr : tbl_match) sp : env * tbl_match * ty list = - let etbl = tr.tbl in - (* infer table type, which looks it up from context *) - let _, inf_etbl = infer_exp env etbl in - let tblty = Option.get inf_etbl.ety in - (* try_unify_rty sp ((Option.get inf_etbl.ety).raw_ty) tr.tty.raw_ty; *) - (* get information from inferred table type *) - let inf_keysize, inf_arg_rtys, inf_ret_ty = - match inf_etbl.ety with - | Some ty -> - (match TyTQVar.strip_links ty.raw_ty with - | TTable trec -> - trec.tkey_sizes, trec.tparam_tys, tup_of_tys trec.tret_tys - | t -> - error_sp - sp - ("table_match arg is not a table: " ^ Printing.raw_ty_to_string t)) - | _ -> error_sp sp "table_match 1st arg has no type" - in - let key_args, acn_args = tr.keys, tr.args in - (* type check key args *) - let inf_keys = infer_keys env sp inf_keysize key_args in - (* type check action args *) - let inf_acn_args = infer_action_args env sp acn_args inf_arg_rtys in - (* the actions and case statements have already been type checked at creation time.*) - - (* check effects *) - (* inferred type of the match statement -- - a function call with: - 1st arg is declared table type. - next args are key types, remaining args are action arg types. - start effect is fresh, table arg effect is fresh, end effect is table arg effect+1, - constraints are that start effect is equal to table arg effect. *) - let base_apply_fty = - let tbl_eff = FVar (QVar (Id.fresh "eff")) in - let start_eff = FVar (QVar (Id.fresh "eff")) in - let base_tblty = ty_eff tblty.raw_ty tbl_eff in - (* note: its okay to use inferred keys/acn args because they have been - checked against inferred table, which has been checked against declared table. *) - let base_key_tys = List.map (fun ekey -> Option.get ekey.ety) inf_keys in - let base_arg_tys = - List.map (fun earg -> Option.get earg.ety) inf_acn_args - in - (* hack: put return types at end of arg types *) - { arg_tys = (base_tblty :: base_key_tys) @ base_arg_tys - ; ret_ty = ty inf_ret_ty - ; start_eff - ; end_eff = FSucc tbl_eff - ; constraints = ref [CLeq (start_eff, tbl_eff)] - } - in - (* the inferred type is a copy of the base type. *) - let inf_apply_fty = - instantiator#visit_ty (fresh_maps ()) (ty (TFun base_apply_fty)) - in - (* the actual type is a call with 1st arg of INFERRED type of the table variable. - This is important because the inferred type will have the concrete effect corresponding - to where the variable was declared. *) - (* this can be cleaner. inferred type should come entirely from inferred variables. - declared / expected type should come entirely (modulo key types) from declared type. - but this seems correct for now. *) - let base_key_tys = List.map (fun ekey -> Option.get ekey.ety) inf_keys in - let base_arg_tys = List.map (fun earg -> Option.get earg.ety) inf_acn_args in - let expected_fty = - { (* hack: put return types at end of arg types *) - arg_tys = (Option.get inf_etbl.ety :: base_key_tys) @ base_arg_tys - ; ret_ty = ty inf_ret_ty - ; start_eff = env.current_effect - ; end_eff = fresh_effect () - ; constraints = ref [] - } - in - (* unify inferred and actual types *) - unify_raw_ty sp (TFun expected_fty) inf_apply_fty.raw_ty; - let new_env = - check_constraints sp "Table match" env expected_fty.end_eff - @@ !(expected_fty.constraints) - in - let new_tr = - { tbl = inf_etbl - ; keys = inf_keys - ; args = inf_acn_args - ; outs = tr.outs - ; out_tys = tr.out_tys - } - in - let ret_tys = - match expected_fty.ret_ty.raw_ty with - | TTuple raw_tys -> List.map ty raw_tys - | _ -> [expected_fty.ret_ty] - in - new_env, new_tr, ret_tys - and infer_statement (env : env) (s : statement) : env * statement = (*(match s.s with | SSeq _ | SNoop -> () @@ -1001,23 +775,6 @@ and infer_statement (env : env) (s : statement) : env * statement = bs in env, SMatch (inf_es, inf_bs) - | STableMatch tm -> - let new_env, new_tm, _ = infer_tblmatch env tm s.sspan in - let new_env = - match new_tm.out_tys with - | Some out_tys -> - (* table_match declares new locals *) - add_locals new_env (List.combine new_tm.outs out_tys) - | None -> new_env - in - new_env, STableMatch new_tm - | STableInstall (etbl, entries) -> - (* infer table type, which looks it up from context *) - let _, inf_etbl = infer_exp env etbl in - let env, inf_entries = - infer_entries env s.sspan (Option.get inf_etbl.ety) entries - in - env, STableInstall (inf_etbl, inf_entries) | SLoop (s1, idx, sz) -> validate_size s.sspan env sz; let renamed_idx = Id.freshen idx in @@ -1075,74 +832,6 @@ and infer_statement (env : env) (s : statement) : env * statement = in env, { s with s = stmt } -(* check / infer types of entries in a table install statement *) -and infer_entries (env : env) sp tbl_ty entries = - (* get key sizes *) - let key_sizes = - match (TyTQVar.strip_links tbl_ty.raw_ty) with - | TTable tbl_ty -> tbl_ty.tkey_sizes - | _ -> error_sp sp ("first argument to table_install is not a table:\n"^(Printing.raw_ty_to_string tbl_ty.raw_ty)) - in - let ty_to_size (ty : ty) = - match ty.raw_ty with - | TInt(sz) -> sz - | TBool -> IConst(1) - | _ -> error_sp sp "[ty_to_size] expected an int or bool, but got something else" - in - let expected_pat_rawtys = List.map (fun sz -> TPat (ty_to_size sz)) key_sizes in - (* do inference and checks for a single entry *) - let infer_entry env entry = - (* type the patterns *) - let env, inf_ematch = - if List.length entry.ematch <> List.length expected_pat_rawtys - then - error_sp - sp - "an entry has the wrong number of patterns based on this table's key." - else ( - let env, inf_epats_rev = - List.fold_left - (fun (env, inf_epats_rev) (epat, expected_epat_rawty) -> - (* infer the expression's type *) - let env, inf_epat, inf_epat_ty = infer_exp env epat |> textract in - (* unify that type with the expected type *) - unify_raw_ty epat.espan expected_epat_rawty inf_epat_ty.raw_ty; - (* return the new environment and pat *) - env, inf_epat :: inf_epats_rev) - (env, []) - (List.combine entry.ematch expected_pat_rawtys) - in - env, List.rev inf_epats_rev) - in - (* type the constant action parameters *) - let action_cid, action_args, flag = unpack_default_action entry.eaction.e in - let param_tys = - match (lookup_var sp env action_cid).raw_ty with - | TActionConstr acn_ctor_ty -> acn_ctor_ty.aconst_param_tys - | _ -> error_sp sp "table entry does not refer to an action." - in - (* infer types of action args *) - let env, inf_eargs = infer_exps env action_args in - let inf_arg_tys = List.map (fun arg -> Option.get arg.ety) inf_eargs in - (* "unify", inferred args with params (make sure they are equiv) *) - List.iter2 (unify_ty sp) inf_arg_tys param_tys; - (* return new env and entry with typed patterns and args *) - (* note that the action call's type is not currently checked *) - let eaction = {entry.eaction with e=ECall(action_cid, inf_eargs, flag); ety = Some(ty TVoid)} in - let entry = {entry with ematch = inf_ematch; eaction;} in - env, entry - in - let env', entries_rev = - List.fold_left - (fun (env, entries_rev) entry -> - let env', entry' = infer_entry env entry in - env', entry' :: entries_rev) - (env, []) - entries - in - let entries = List.rev entries_rev in - env', entries - and infer_branches (env : env) s etys branches = let drop_constraints = drop_constraints env in let drop_ret_effects = drop_ret_effects env in @@ -1620,38 +1309,6 @@ let rec infer_declaration lst in { new_env with record_labels } - | TTable ttbl -> - (* want to do something about the inner types ?*) - let inf_tparam_tys = - List.map - (fun stated_ty -> - (* let raw_ty = stated_ty.raw_ty in *) - let inf_ty = inst stated_ty in - (* not sure what this does... *) - try_unify_ty stated_ty.tspan stated_ty inf_ty; - inf_ty) - ttbl.tparam_tys - in - let inf_tret_tys = - List.map - (fun stated_ty -> - let inf_ty = inst stated_ty in - (* not sure what this does... *) - try_unify_ty stated_ty.tspan stated_ty inf_ty; - inf_ty) - ttbl.tret_tys - in - let inf_ty = - { ty with - raw_ty = - TTable - { ttbl with - tparam_tys = inf_tparam_tys - ; tret_tys = inf_tret_tys - } - } - in - define_user_ty id sizes inf_ty env | _ -> new_env in new_env, effect_count, DUserTy (id, sizes, ty) diff --git a/src/lib/frontend/typing/TyperUnify.ml b/src/lib/frontend/typing/TyperUnify.ml index f9b8baee..a3b00d5d 100644 --- a/src/lib/frontend/typing/TyperUnify.ml +++ b/src/lib/frontend/typing/TyperUnify.ml @@ -86,10 +86,7 @@ let occurs_ty span tvar raw_ty : unit = List.iter (fun ty -> occ tvar ty.raw_ty) arg_tys; occ tvar ret_ty.raw_ty | TVector (raw_ty, _) -> occ tvar raw_ty - | TTable(t) -> - List.iter occ_ty t.tparam_tys; - List.iter occ_ty t.tret_tys - | TAction(a) -> + | TAction(a) -> List.iter occ_ty a.aarg_tys; List.iter occ_ty a.aret_tys | TActionConstr({aconst_param_tys; aacn_ty = {aarg_tys; aret_tys}}) -> @@ -328,11 +325,7 @@ print_endline ("rtys2: "^(Printing.comma_sep Printing.ty_to_string tys2)); | TVector (ty1, size1), TVector (ty2, size2) -> try_unify_size span size1 size2; unify_raw_ty ty1 ty2 - | TTable(t1), TTable(t2) -> - List.iter2 (try_unify_ty span) t1.tkey_sizes t2.tkey_sizes; - List.iter2 (try_unify_ty span) t1.tparam_tys t2.tparam_tys; - List.iter2 (try_unify_ty span) t1.tret_tys t2.tret_tys - | TAction(a1), TAction(a2) -> + | TAction(a1), TAction(a2) -> unify_param_tys_after_tuple_elim a1.aarg_tys a2.aarg_tys; unify_param_tys_after_tuple_elim a1.aret_tys a2.aret_tys; @@ -354,10 +347,9 @@ print_endline ("rtys2: "^(Printing.comma_sep Printing.ty_to_string tys2)); | TRecord _ | TVector _ | TTuple _ - | TAbstract _ + | TAbstract _ | TAction _ | TActionConstr _ - | TTable _ | TPat _) , _ ) -> raise CannotUnify diff --git a/src/lib/midend/SourceTracking.ml b/src/lib/midend/SourceTracking.ml index d85a9225..ad4d8578 100644 --- a/src/lib/midend/SourceTracking.ml +++ b/src/lib/midend/SourceTracking.ml @@ -60,19 +60,7 @@ let init_tracking ds = let ctx' = enter_module ctx id in self#visit_interface ctx' intf; self#visit_decls ctx' decls - (* globals are the things we really want to track... *) - | DGlobal(id, _, exp) -> ( - match exp.e with - | ETableCreate({tactions=tactions;}) -> - (* update reference map *) - refs := add_refs - (!refs) - (Cid.id id) - (List.map cid_of_exp tactions); - (* not a table, just recurse *) - | _ -> super#visit_decl ctx decl - ) - | _ -> + | _ -> super#visit_decl ctx decl end in diff --git a/src/lib/midend/transformations/SyntaxToCore.ml b/src/lib/midend/transformations/SyntaxToCore.ml index 47901ef8..bf961eda 100644 --- a/src/lib/midend/transformations/SyntaxToCore.ml +++ b/src/lib/midend/transformations/SyntaxToCore.ml @@ -36,20 +36,6 @@ let rec translate_raw_ty (rty : S.raw_ty) tspan : C.raw_ty = | S.TGroup -> C.TGroup | S.TEvent -> C.TEvent | S.TInt sz -> C.TInt (translate_size sz) - (* TABLE UPDATE hard coded translation into table type *) - (* | S.TName(cid, sizes, _) when (Cid.equals cid Tables.t_id) -> - let size_to_ty (sz : S.size) = - C.ty (C.TInt (translate_size sz)) - in - let tkey_sizes, tparam_tys, tret_tys = match (List.map (SyntaxUtils.normalize_size) sizes) with - | [ITup(skeys); ITup(sparams); ITup(srets)] -> ( - List.map translate_size skeys, - List.map size_to_ty sparams, - List.map size_to_ty srets - ) - | _ -> S.error@@"[translate_raw_ty] expected 3 size arguments, each a tuple, but got something else" - in - C.TTable { tkey_sizes; tparam_tys; tret_tys } *) | S.TName (cid, sizes, _) -> C.TName (cid, List.map translate_size sizes) | S.TMemop (n, sz) -> C.TMemop (n, translate_size sz) | S.TFun fty -> @@ -58,23 +44,8 @@ let rec translate_raw_ty (rty : S.raw_ty) tspan : C.raw_ty = ; ret_ty = translate_ty fty.ret_ty } | S.TVoid -> C.TBool (* Dummy translation needed for foreign functions *) - | S.TBuiltin(cid, rtys, _) -> + | S.TBuiltin(cid, rtys, _) -> C.TBuiltin(cid, List.map (fun rty -> translate_raw_ty rty Span.default) rtys) - | S.TTable tbl -> - let ty_to_intsize (ty : S.ty) = - match ty.raw_ty with - | TInt(sz) -> SyntaxUtils.extract_size sz - | TBool ->1 - | _ -> S.error "[rty_to_size] expected an integer, but got something else" - in - let tkey_sizes = C.Szs (List.map ty_to_intsize tbl.tkey_sizes) in - let tparam_sizes = C.Szs (List.map ty_to_intsize tbl.tparam_tys) in - let tret_sizes = C.Szs (List.map ty_to_intsize tbl.tret_tys) in - C.TName(Tables.t_id, [tkey_sizes; tparam_sizes; tret_sizes]) - (* let tparam_tys = List.map translate_ty tbl.tparam_tys in - let tret_tys = List.map translate_ty tbl.tret_tys in - - C.TTable { tkey_sizes; tparam_tys; tret_tys } *) | S.TActionConstr a -> let aconst_param_tys = List.map translate_ty a.aconst_param_tys in let aarg_tys = List.map translate_ty a.aacn_ty.aarg_tys in @@ -207,53 +178,15 @@ and translate_exp (e : S.exp) : C.exp = e.espan "[SyntaxToCore.translate_exp] unsupported construct for core IR (EStmt, EWith, EComp, EIndex)" | EVector(exps) -> - (* vectors can appear as builtin type arguments. At this point, they have a known + (* vectors can appear as builtin type arguments. At this point, they have a known length, so can be translated into tuples. *) C.ETuple(List.map translate_exp exps) - | S.ETableCreate _ -> - err - e.espan - "[SyntaxToCore.translate_exp] ETableCreate should be translated by \ - special function" - | S.ETableMatch _ -> - err e.espan "table match exps should have been eliminated before IR." (* | S.EPatWild (Some sz) -> C.EVal (C.vwild (translate_size sz)) | S.EPatWild None -> err e.espan "wildcard patterns (_) should have a size before IR." *) in { e = e'; ety = translate_ty (Option.get e.ety); espan = e.espan } -and translate_etablecreate _ (exp : S.exp) : C.exp = - match exp.e with - | S.ETableCreate tc -> - (* let tty = translate_ty tc.tty in - let tsize = translate_exp tc.tsize in - let tactions = List.map translate_exp tc.tactions in - let default_cid, default_args, _ = SyntaxUtils.unpack_default_action tc.tdefault.e in - let tdefault = default_cid, default_args |> List.map translate_exp in - let e' = C.ETableCreate { tid = id; tty; tactions; tsize; tdefault } in *) - (* let tty = translate_ty tc.tty in *) - let tsize = translate_exp tc.tsize in - let tactions = C.tup_sp (List.map translate_exp tc.tactions) Span.default in - let default_acn_constr_evar, default_acn_constr_arg = match tc.tdefault.e with - | ECall(cid, args, _) -> - let e = Syntax.EVar(cid) in - let ty_opt = (List.hd tc.tactions).ety in - let espan = tc.tdefault.espan in - (Syntax.aexp e ty_opt espan, Syntax.tuple_sp_ty args tc.tdefault.espan) - | _ -> err_unsupported tc.tdefault.espan "default action in a table create should be a call" - in - let default_acn_constr_evar = translate_exp default_acn_constr_evar in - let default_acn_constr_arg = translate_exp default_acn_constr_arg in - let e' = - C.ECall(Cid.create ["Table"; "create"], [tsize; tactions; default_acn_constr_evar; default_acn_constr_arg], false) in - { e = e'; ety = translate_ty (Option.get exp.ety); espan = exp.espan } - | _ -> - err - exp.espan - "[SyntaxToCore.translate_etablecreate] non table create expressions \ - should be translated by translate_exp" - and translate_params params = List.map (fun (id, ty) -> id, translate_ty ty) params @@ -280,39 +213,9 @@ and translate_statement (s : S.statement) : C.statement = let translate_branch (ps, s) = List.map translate_pattern ps, translate_statement s in - (* let translate_entry (entry : S.tbl_entry) : C.tbl_entry = - let action_cid, action_args, _ = SyntaxUtils.unpack_default_action entry.eaction.e in - { ematch = List.map translate_exp entry.ematch - ; eprio = entry.eprio - ; eaction = Cid.to_id action_cid - ; eargs = List.map translate_exp action_args - } - in *) let s' = match s.s with | S.SNoop -> C.SNoop - (* TABLE UPDATE -- hard coded table install call -> table_install *) - (* | S.SUnit {e=ECall(cid, args, _)} when ((Cid.names cid) = ["Table"; "install"]) -> - let tbl_exp = List.nth args 0 in - let key_tup = List.nth args 1 in - let match_keys = match key_tup.e with - | ETuple keys -> List.map translate_exp keys - | _ -> err_unsupported key_tup.espan "keys in a table install should be a tuple" - in - let action_exp = List.nth args 2 in - let action_cid, action_args = match action_exp.e with - | ECall(cid, args, _) -> cid, List.map translate_exp args (* call to an action constructor *) - | _ -> err action_exp.espan "the last argument of Table.install must be a call to an action constructor" - in - let tbl_entry : C.tbl_entry = { - eprio = 10; - ematch = match_keys; - eaction = Cid.to_id action_cid; - eargs = action_args; - } - in - let tbl_exp = translate_exp tbl_exp in - C.STableInstall (tbl_exp, [tbl_entry]) *) | S.SUnit e -> C.SUnit (translate_exp e) | S.SLocal (id, ty, e) -> C.SLocal (id, translate_ty ty, translate_exp e) | S.SAssign (id, e) -> C.SAssign (Cid.id id, translate_exp e) @@ -324,63 +227,6 @@ and translate_statement (s : S.statement) : C.statement = | S.SMatch (es, branches) -> C.SMatch (List.map translate_exp es, List.map translate_branch branches) | S.SRet eopt -> C.SRet (Option.map translate_exp eopt) - | S.STableMatch tm -> - let (core_tm : Tables.core_tbl_match) = { - Tables.tbl = translate_exp tm.tbl - ; Tables.keys = List.map translate_exp tm.keys - ; Tables.args = List.map translate_exp tm.args - ; Tables.outs = tm.outs - ; Tables.out_tys = - (match tm.out_tys with - | None -> None - | Some otys -> Some (List.map translate_ty otys)) - } in - Tables.tbl_match_to_s core_tm - (* C.STableMatch - { C.tbl = translate_exp tm.tbl - ; C.keys = List.map translate_exp tm.keys - ; C.args = List.map translate_exp tm.args - ; C.outs = tm.outs - ; C.out_tys = - (match tm.out_tys with - | None -> None - | Some otys -> Some (List.map translate_ty otys)) - } *) - | S.STableInstall (tbl_exp, entries) -> ( - match entries with - | [{ematch; eaction}] -> ( - let tbl_exp = translate_exp tbl_exp in - let ematch = List.map translate_exp ematch in - let ematch_tys = List.map (fun (exp : C.exp) -> exp.ety.raw_ty) ematch in - let ematch_ty = CoreSyntax.ty@@CoreSyntax.TTuple ematch_tys in - let eaction = translate_exp eaction in - let action_cid, action_arg = match eaction.e with - | C.ECall(cid, args, _) -> - let arg = - if (List.length args) == 0 then - C.tup_sp [] eaction.espan - else - if (List.length args) > 1 then - C.tup_sp args eaction.espan - else - List.hd args - in - cid, arg - | _ -> err s.sspan "using old syntax, table install should be a call" - in - (* how do we figure out the type of the action reference expression? *) - let action_var = C.var (action_cid) (C.ty (C.TBool)) in - - - - let ematch = CoreSyntax.exp (CoreSyntax.ETuple ematch) ematch_ty in - let e = C.ECall(Cid.create ["Table"; "install"], [tbl_exp; ematch; action_var; action_arg], false) in - C.SUnit({e; ety=C.ty C.TBool; C.espan = s.sspan}) - ) - | _ -> err s.sspan "table install with >1 entries not supported have exactly one entry" - ) - (* C.STableInstall (translate_exp tbl_exp, List.map translate_entry entries) *) - (* TABLE UPDATE -- hard coded tuple assign -> table assign *) | S.STupleAssign(tup_asn) -> ( let ids = tup_asn.ids in let tys = match tup_asn.tys with @@ -462,40 +308,8 @@ and translate_parser_block (actions, (step, step_span)) = let translate_d preserve_user_decls d dspan dpragmas = match d with - | S.DGlobal (id, ty, constr_exp) -> ( - match ty.raw_ty with - (* TABLE UPDATE -- hard coded translation into a decl with ETableCreate *) - (* | (TName(cid, _, _)) when (Cid.equal cid Tables.t_id) -> ( - match constr_exp.e with - | S.ECall(_, [size_exp; actions_exp; default_exp], _) -> - let size = translate_exp size_exp in - let actions = match actions_exp.e with - | ETuple actions -> List.map translate_exp actions - | _ -> err_unsupported dspan "actions in a table create should be a tuple" - in - let default_cid, default_args = match default_exp.e with - | ECall(cid, args, _) -> cid, args (* call to an action constructor *) - | EVar(_) -> - err_unsupported dspan "Tables currently must use action constructors" - (* cid, [] *) (* an action, which isn't fully supported *) - | _ -> err_unsupported dspan "default action in a table create should be a call" - in - let (tbl_def : C.tbl_def) = { - tid = id; - tty = translate_ty ty; - tactions = actions; - tsize = size; - tdefault = (default_cid, List.map translate_exp default_args); - } - in - Some (C.DGlobal (id, translate_ty ty, {e=C.ETableCreate tbl_def; ety=translate_ty ty; espan=constr_exp.espan})) - | _ -> err_unsupported dspan "table create should be a call" - ) *) - | _ -> - Some (match constr_exp.e with - | S.ETableCreate _ -> C.DGlobal (id, translate_ty ty, translate_etablecreate id constr_exp) - | _ -> C.DGlobal (id, translate_ty ty, translate_exp constr_exp)) - ) + | S.DGlobal (id, ty, constr_exp) -> + Some (C.DGlobal (id, translate_ty ty, translate_exp constr_exp)) | S.DEvent (id, annot, sort, _, params) -> Some (C.DEvent (id, annot, translate_sort sort, translate_params params)) | S.DHandler (id, s, body) -> From 70e2cf1d205cf0de74cf5ecacf927a9b72f7f2aa Mon Sep 17 00:00:00 2001 From: John Sonchack Date: Sun, 7 Jun 2026 13:02:33 -0400 Subject: [PATCH 25/49] notes --- src/lib/frontend/modules/Tables.ml | 11 +++-------- src/lib/midend/interpreter/InterpSwitch.ml | 1 + 2 files changed, 4 insertions(+), 8 deletions(-) diff --git a/src/lib/frontend/modules/Tables.ml b/src/lib/frontend/modules/Tables.ml index 3bc5f3da..3401768c 100644 --- a/src/lib/frontend/modules/Tables.ml +++ b/src/lib/frontend/modules/Tables.ml @@ -1,12 +1,7 @@ (* Tables as a builtin module *) -(* TODO: test with nested types for keys, args *) -(* TODO: update documentation *) (* TODO: add an install_mask_priority function *) (* TODO: add a remove function *) (* TODO: add an update function *) -(* TODO: simplify action / action constructor syntax *) -(* TODO: remove all the pattern syntax and - special table syntax from the frontend *) open Batteries open Syntax open InterpSwitch @@ -151,13 +146,13 @@ let create_sig = ;; (* interpreter implementation *) -let create_ctor (nst : InterpSwitch.state Array.t) swid args = +(* Append a new table to the pipeline *) +let create_ctor (nst : network_state) swid args : Pipeline.t = match args with (* the table value arg is added by interpcore *) | [tbl_v; tbl_len; tbl_acn_ctors; tbl_def_acn; tbl_def_args] -> let _ = tbl_acn_ctors in - let st = nst.(swid) in - let p = st.pipeline in + let p = nst.(swid).pipeline in let tbl_id = match tbl_v with | V { v = VGlobal(tbl_id, _) } -> tbl_id | _ -> error"Table.create: expected a global for the table id" diff --git a/src/lib/midend/interpreter/InterpSwitch.ml b/src/lib/midend/interpreter/InterpSwitch.ml index 0fb7962b..106e20a1 100644 --- a/src/lib/midend/interpreter/InterpSwitch.ml +++ b/src/lib/midend/interpreter/InterpSwitch.ml @@ -79,6 +79,7 @@ and handler = network_state -> int (* switch *) -> int (* port *) -> event_val (* code inside the program has no side effects, so it should not need network state, just switch state (or even perhaps only the switch pipeline?) *) and code = network_state -> int (* switch *) -> ival list -> ival +(* and code = state -> ival list -> ival *) and ival = | V of value From 0fde6703cb7ec47a7f3a40ca8644edb25de07d61 Mon Sep 17 00:00:00 2001 From: John Sonchack Date: Sun, 7 Jun 2026 13:26:14 -0400 Subject: [PATCH 26/49] remove network state argument from closures, now only include switch state --- src/lib/frontend/modules/Arrays.ml | 40 ++++++++++----------- src/lib/frontend/modules/Counters.ml | 7 ++-- src/lib/frontend/modules/Events.ml | 2 +- src/lib/frontend/modules/LibraryUtils.ml | 22 ++++++------ src/lib/frontend/modules/Packet.ml | 4 +-- src/lib/frontend/modules/PairArrays.ml | 6 ++-- src/lib/frontend/modules/Payloads.ml | 12 +++---- src/lib/frontend/modules/System.ml | 10 +++--- src/lib/frontend/modules/Tables.ml | 25 ++++++------- src/lib/frontend/modules/Tables.mli | 2 +- src/lib/midend/interpreter/Interp.ml | 2 +- src/lib/midend/interpreter/InterpCore.ml | 28 ++++++++------- src/lib/midend/interpreter/InterpParsing.ml | 3 +- src/lib/midend/interpreter/InterpSpec.ml | 2 +- src/lib/midend/interpreter/InterpSwitch.ml | 11 +++--- 15 files changed, 90 insertions(+), 86 deletions(-) diff --git a/src/lib/frontend/modules/Arrays.ml b/src/lib/frontend/modules/Arrays.ml index 5d73096d..8add95d8 100644 --- a/src/lib/frontend/modules/Arrays.ml +++ b/src/lib/frontend/modules/Arrays.ml @@ -66,10 +66,10 @@ let array_update_ty = } ;; -let update_fun err nst swid args = +let update_fun err st args = (* Hack to make the types work *) let err str = failwith (err str) in - let open InterpSyntax in + let open InterpSyntax in match args with | [ V { v = VGlobal (_, stage) } ; V { v = VInt idx } @@ -77,21 +77,21 @@ let update_fun err nst swid args = ; getarg ; F (_, setop) ; setarg ] -> - let get_f arg = getop nst swid [V (CoreSyntax.vinteger arg); getarg] in + let get_f arg = getop st [V (CoreSyntax.vinteger arg); getarg] in let set_f arg = - match setop nst swid [V (CoreSyntax.vinteger arg); setarg] |> extract_ival with + match setop st [V (CoreSyntax.vinteger arg); setarg] |> extract_ival with | { v = VInt v } -> v | _ -> err "Wrong type of value from set op" in - let pipe = nst.(swid).pipeline in + let pipe = st.pipeline in Pipeline.update ~stage ~idx:(Integer.to_int idx) ~getop:get_f ~setop:set_f pipe (* InterpSwitch.update stage (Integer.to_int idx) get_f set_f (sw nst swid) *) | _ -> err "Incorrect number or type of arguments to Array.update" ;; let array_update_fun = update_fun array_update_error -let dummy_memop = InterpSwitch.anonf (fun _ _ args -> V(InterpSwitch.extract_ival (List.hd args))) -let setop = InterpSwitch.anonf (fun _ _ args -> V(InterpSwitch.extract_ival (List.nth args 1))) +let dummy_memop = InterpSwitch.anonf (fun _ args -> V(InterpSwitch.extract_ival (List.hd args))) +let setop = InterpSwitch.anonf (fun _ args -> V(InterpSwitch.extract_ival (List.nth args 1))) let dummy_int = InterpSwitch.V (CoreSyntax.vinteger (Integer.of_int 0)) (* Array.get *) @@ -100,13 +100,12 @@ let array_get_id = Id.create array_get_name let array_get_cid = Cid.create_ids [array_id; array_get_id] let array_get_error msg = array_error array_get_name msg -let array_get_fun nst swid args = +let array_get_fun st args = match args with | [arg1; arg2] -> update_fun array_get_error - nst - swid + st [arg1; arg2; dummy_memop; dummy_int; dummy_memop; dummy_int] | _ -> array_get_error "Incorrect number of arguments to Array.get" ;; @@ -117,13 +116,12 @@ let array_getm_id = Id.create array_getm_name let array_getm_cid = Cid.create_ids [array_id; array_getm_id] let array_getm_error msg = array_error array_getm_name msg -let array_getm_fun nst swid args = +let array_getm_fun st args = match args with | [arg1; arg2; getop; getarg] -> update_fun array_getm_error - nst - swid + st [arg1; arg2; getop; getarg; dummy_memop; dummy_int] | _ -> array_getm_error "Incorrect number of arguments to Array.getm" ;; @@ -134,13 +132,12 @@ let array_set_id = Id.create array_set_name let array_set_cid = Cid.create_ids [array_id; array_set_id] let array_set_error msg = array_error array_set_name msg -let array_set_fun nst swid args = +let array_set_fun st args = match args with | [arg1; arg2; setval] -> update_fun array_set_error - nst - swid + st [arg1; arg2; dummy_memop; dummy_int; setop; setval] | _ -> array_set_error "Incorrect number of arguments to Array.set" ;; @@ -151,13 +148,12 @@ let array_setm_id = Id.create array_setm_name let array_setm_cid = Cid.create_ids [array_id; array_setm_id] let array_setm_error msg = array_error array_setm_name msg -let array_setm_fun nst swid args = +let array_setm_fun st args = match args with | [arg1; arg2; setop; setarg] -> update_fun array_setm_error - nst - swid + st [arg1; arg2; dummy_memop; dummy_int; setop; setarg] | _ -> array_setm_error "Incorrect number of arguments to Array.setm" ;; @@ -224,19 +220,19 @@ let array_update_complex_ty = } ;; -let array_update_complex_fun nst swid args = +let array_update_complex_fun st args = let open InterpSyntax in match args with | [V { v = VGlobal (_, stage) }; V { v = VInt idx }; F(_, memop); arg1; arg2; default] -> let update_f mem1 _ = let args = [V (CoreSyntax.vinteger mem1); arg1; arg2; default] in - let v = memop nst swid args |> extract_ival in + let v = memop st args |> extract_ival in match v.v with | VTuple [VInt n1; VInt n2; v3] -> n1, n2, { v with v = v3 } | _ -> failwith "array_update_complex: Internal error" in - let pipe = nst.(swid).pipeline in + let pipe = st.pipeline in V(Pipeline.update_complex ~stage ~idx:(Integer.to_int idx) ~memop:update_f pipe) | _ -> array_update_complex_error "Incorrect number or type of arguments" ;; diff --git a/src/lib/frontend/modules/Counters.ml b/src/lib/frontend/modules/Counters.ml index b9d3aada..a0669da2 100644 --- a/src/lib/frontend/modules/Counters.ml +++ b/src/lib/frontend/modules/Counters.ml @@ -54,11 +54,12 @@ let counter_add_ty = } ;; -let dummy_memop = InterpSwitch.F (None, fun _ _ args -> V(InterpSwitch.extract_ival (List.hd args))) -let setop = InterpSwitch.F (None, fun _ _ args -> V(InterpSwitch.extract_ival (List.nth args 1))) +let dummy_memop = InterpSwitch.F (None, fun _ args -> V(InterpSwitch.extract_ival (List.hd args))) +let setop = InterpSwitch.F (None, fun _ args -> V(InterpSwitch.extract_ival (List.nth args 1))) let dummy_int = InterpSwitch.V (CoreSyntax.vinteger (Integer.of_int 0)) -let counter_add_fun nst swid args = +let counter_add_fun st args = + let nst, swid = nst_swid st in let open InterpSyntax in let open CoreSyntax in match args with diff --git a/src/lib/frontend/modules/Events.ml b/src/lib/frontend/modules/Events.ml index c6ecaadb..77d2c08d 100644 --- a/src/lib/frontend/modules/Events.ml +++ b/src/lib/frontend/modules/Events.ml @@ -16,7 +16,7 @@ let event_delay_id = Id.create event_delay_name let event_delay_cid = Cid.create_ids [event_id; event_delay_id] let event_delay_error msg = event_error event_delay_name msg -let event_delay_fun _ _ args = +let event_delay_fun _ args = let open CoreSyntax in let open InterpSyntax in match args with diff --git a/src/lib/frontend/modules/LibraryUtils.ml b/src/lib/frontend/modules/LibraryUtils.ml index bb12b30b..45fee3a5 100644 --- a/src/lib/frontend/modules/LibraryUtils.ml +++ b/src/lib/frontend/modules/LibraryUtils.ml @@ -53,25 +53,25 @@ let taction iarg marg ret = }) ;; (* convert a function from ivals -> ivals to a function from values -> values *) -let ival_fcn_to_internal_action nst swid vaction = +let ival_fcn_to_internal_action st vaction = let open CoreSyntax in - let open InterpState in - let acn_cid, action_f = match vaction with + let open InterpState in + let acn_cid, action_f = match vaction with | F (Some(cid), f) -> cid, f | F (None, _) -> error "Table.install: interpreter error -- the action was added to the global context without a name" | _ -> error "Table.install: expected a function" in - (* fill state and switch id args of the action function, - which don't matter because its a pure function *) - let acn_f (vs : value list) : value list = + (* fill the switch-state arg of the action function, + which doesn't matter because its a pure function *) + let acn_f (vs : value list) : value list = (* wrap vs in ivals, call action_f, unwrap results *) let ivals = List.map (fun v -> V v) vs in - let result = action_f nst swid ivals in - (* passing action and args separately to install makes the + let result = action_f st ivals in + (* passing action and args separately to install makes the action return a function *) - let result = match result with - | F(_, f) -> - f nst swid [] + let result = match result with + | F(_, f) -> + f st [] | V v -> V(v) (* extract_ival result *) diff --git a/src/lib/frontend/modules/Packet.ml b/src/lib/frontend/modules/Packet.ml index 2d75c5cd..3429299e 100644 --- a/src/lib/frontend/modules/Packet.ml +++ b/src/lib/frontend/modules/Packet.ml @@ -37,8 +37,8 @@ let packet_parse_ty = ;; let packet_parse_error msg = packet_error packet_parse_name msg -let packet_parse_fun nst swnum args = - let _, _, _ = nst, swnum, args in +let packet_parse_fun _ args = + let _ = args in packet_parse_error "Packet.parse should never be called outside of parsers" ;; diff --git a/src/lib/frontend/modules/PairArrays.ml b/src/lib/frontend/modules/PairArrays.ml index e04c8326..ac471c19 100644 --- a/src/lib/frontend/modules/PairArrays.ml +++ b/src/lib/frontend/modules/PairArrays.ml @@ -59,7 +59,7 @@ let pairarray_update_ty = } ;; -let pairarray_update_fun nst swid args = +let pairarray_update_fun st args = let open InterpSyntax in match args with | [V { v = VGlobal (_, stage) }; V { v = VInt idx }; F (_, memop); arg1; arg2; default] @@ -72,12 +72,12 @@ let pairarray_update_fun nst swid args = ; arg2 ; default ] in - let v = memop nst swid args |> extract_ival in + let v = memop st args |> extract_ival in match v.v with | VTuple [VInt n1; VInt n2; v3] -> n1, n2, { v with v = v3 } | _ -> failwith "array_update: Internal error" in - V(Pipeline.update_complex ~stage ~idx:(Integer.to_int idx) ~memop:update_f nst.(swid).pipeline) + V(Pipeline.update_complex ~stage ~idx:(Integer.to_int idx) ~memop:update_f st.pipeline) | _ -> pairarray_update_error "Incorrect number or type of arguments" ;; diff --git a/src/lib/frontend/modules/Payloads.ml b/src/lib/frontend/modules/Payloads.ml index af5fa440..f8b25829 100644 --- a/src/lib/frontend/modules/Payloads.ml +++ b/src/lib/frontend/modules/Payloads.ml @@ -68,7 +68,7 @@ let payload_empty_ty = (* Just use ints to represent payloads in the interpreter. We could make a new type if we really wanted to distinguish them better *) (* Lets use a pattern value for now. *) -let payload_empty_fun _ _ args = +let payload_empty_fun _ args = match args with | [] -> InterpSwitch.V({(CoreSyntax.vpat []) with vty = (SyntaxToCore.translate_ty payload_ty)}) @@ -86,8 +86,8 @@ let payload_parse_cid = Cid.create_ids [payload_id; payload_parse_id] let payload_parse_ty = effectless_fun_ty [ty TBitstring] payload_ty let payload_parse_error msg = payload_error payload_parse_name msg -let payload_parse_fun _ _ args = - (* at this point, Payload.parse is just a wrapper that stores +let payload_parse_fun _ args = + (* at this point, Payload.parse is just a wrapper that stores whatever bitstring is left at the end of packet processing. *) let open InterpSyntax in let open CoreSyntax in @@ -105,7 +105,7 @@ let payload_read_ty = effectless_fun_ty [payload_ty] (fresh_ty "payload_read_ret let payload_read_error msg = payload_error payload_read_name msg -let payload_read_fun _ _ _ = +let payload_read_fun _ _ = payload_read_error "Payload.read is not implemented yet" ;; @@ -118,7 +118,7 @@ let payload_skip_id = Id.create payload_skip_name let payload_skip_cid = Cid.create_ids [payload_id; payload_skip_id] let payload_skip_ty = effectless_fun_ty [payload_ty; ty (TInt(fresh_size "payload_skip_arg")) ] (ty TVoid) ;; let payload_skip_error msg = payload_error payload_skip_name msg -let payload_skip_fun _ _ _ = +let payload_skip_fun _ _ = payload_skip_error "Payload.skip is not implemented yet" ;; @@ -131,7 +131,7 @@ let payload_peek_ty = effectless_fun_ty [payload_ty] (fresh_ty "payload_peek_ret let payload_peek_error msg = payload_error payload_peek_name msg -let payload_peek_fun _ _ _ = +let payload_peek_fun _ _ = payload_peek_error "Payload.peek is not implemented yet" ;; diff --git a/src/lib/frontend/modules/System.ml b/src/lib/frontend/modules/System.ml index 080cfe7e..bec4b3a6 100644 --- a/src/lib/frontend/modules/System.ml +++ b/src/lib/frontend/modules/System.ml @@ -25,10 +25,12 @@ let sys_time_ty = } ;; -let sys_time_fun (nst : InterpSwitch.state Array.t) _ args = +let sys_time_fun (st : InterpSwitch.state) args = let open CoreSyntax in match args with - | [] -> InterpSwitch.V(vinteger (Integer.create ~value:!(nst.(0).global_time) ~size:32)) + (* global_time is a single shared ref, so the current switch's copy is the + network-wide time. *) + | [] -> InterpSwitch.V(vinteger (Integer.create ~value:!(st.global_time) ~size:32)) | _ -> sys_time_error "takes no parameters" ;; @@ -52,7 +54,7 @@ let sys_random_ty = } ;; -let sys_random_fun _ _ args = +let sys_random_fun _ args = let open CoreSyntax in match args with | [] -> @@ -101,7 +103,7 @@ let sys_dequeue_depth_cid = Cid.create_ids [sys_id; sys_dequeue_depth_id] let sys_dequeue_depth_error msg = sys_error sys_dequeue_depth_name msg -let sys_dequeue_depth_fun _ _ args = +let sys_dequeue_depth_fun _ args = let open CoreSyntax in match args with | [] -> diff --git a/src/lib/frontend/modules/Tables.ml b/src/lib/frontend/modules/Tables.ml index 3401768c..c5790f80 100644 --- a/src/lib/frontend/modules/Tables.ml +++ b/src/lib/frontend/modules/Tables.ml @@ -147,18 +147,18 @@ let create_sig = (* interpreter implementation *) (* Append a new table to the pipeline *) -let create_ctor (nst : network_state) swid args : Pipeline.t = +let create_ctor (st : state) args : Pipeline.t = match args with (* the table value arg is added by interpcore *) | [tbl_v; tbl_len; tbl_acn_ctors; tbl_def_acn; tbl_def_args] -> let _ = tbl_acn_ctors in - let p = nst.(swid).pipeline in + let p = st.pipeline in let tbl_id = match tbl_v with | V { v = VGlobal(tbl_id, _) } -> tbl_id | _ -> error"Table.create: expected a global for the table id" in let def_acn_cid, def_acn_ctor = - ival_fcn_to_internal_action nst swid tbl_def_acn + ival_fcn_to_internal_action st tbl_def_acn in let flat_default_args = match tbl_def_args with | V({v=VTuple(vs)}) -> List.map CoreSyntax.value vs @@ -225,12 +225,11 @@ let install_ty = ;; (* install an exact pattern, with key value equal to mask *) -let install_fun nst swid args = - let _, _ = nst, swid in +let install_fun st args = let open CoreSyntax in match args with | [vtbl; vkey; vaction; vaction_const_arg_tup] -> - let target_pipe = nst.(swid).pipeline in + let target_pipe = st.pipeline in let stage = match (extract_ival vtbl).v with | VGlobal(_, stage) -> stage | _-> error "Table.install: table arg didn't eval to a global" @@ -245,7 +244,7 @@ let install_fun nst swid args = | _ -> error "Table.create: expected a tuple for the default action args" in let acn_cid, acn_ctor = - ival_fcn_to_internal_action nst swid vaction + ival_fcn_to_internal_action st vaction in let acn remaining_args = @@ -306,12 +305,11 @@ let install_ternary_ty = ;; (* install an exact pattern, with key value equal to mask *) -let install_ternary_fun nst swid args = - let _, _ = nst, swid in +let install_ternary_fun st args = let open CoreSyntax in match args with | [vtbl; vkey; vmask; vaction; vaction_const_arg_tup] -> - let target_pipe = nst.(swid).pipeline in + let target_pipe = st.pipeline in let stage = match (extract_ival vtbl).v with | VGlobal(_, stage) -> stage | _-> error "Table.install: table arg didn't eval to a global" @@ -333,7 +331,7 @@ let install_ternary_fun nst swid args = | _ -> error "Table.create: expected a tuple for the default action args" in let acn_cid, acn_ctor = - ival_fcn_to_internal_action nst swid vaction + ival_fcn_to_internal_action st vaction in let acn remaining_args = acn_ctor (vaction_const_args@remaining_args) @@ -386,15 +384,14 @@ let lookup_ty = } ;; -let lookup_fun nst swid args = - let _, _ = nst, swid in +let lookup_fun st args = let open InterpSyntax in let open CoreSyntax in match args with | [V { v = VGlobal(_, tbl_pos); }; V { v = vkey }; V { v = vargs }] -> let keys = flatten_v vkey |> List.map value in (* get all the entries from the table *) - let default, entries = Pipeline.get_table_entries tbl_pos nst.(swid).pipeline in + let default, entries = Pipeline.get_table_entries tbl_pos st.pipeline in (* find the first matching case *) let fst_match = List.fold_left diff --git a/src/lib/frontend/modules/Tables.mli b/src/lib/frontend/modules/Tables.mli index 47d17706..1d519ac6 100644 --- a/src/lib/frontend/modules/Tables.mli +++ b/src/lib/frontend/modules/Tables.mli @@ -3,7 +3,7 @@ include LibraryInterface.TypeInterface val is_tbl_ty : CoreSyntax.raw_ty -> bool (* create the table, adding it to a pipeline in a switch *) -val create_ctor : InterpSwitch.state Array.t -> int -> InterpSwitch.ival list -> Pipeline.t +val create_ctor : InterpSwitch.state -> InterpSwitch.ival list -> Pipeline.t (* helpers for tofino backend -- these will eventually be eliminated, but smooth the conversion from custom table syntax diff --git a/src/lib/midend/interpreter/Interp.ml b/src/lib/midend/interpreter/Interp.ml index 41a4fe6c..b35cb74b 100644 --- a/src/lib/midend/interpreter/Interp.ml +++ b/src/lib/midend/interpreter/Interp.ml @@ -260,7 +260,7 @@ let execute_main_parser print_log swidx port (nst: network_state) (pkt_ev : (Cor (CorePrinting.value_to_string payload_val) swidx port; - let event_val = parser_f nst swidx main_args |> extract_ival in + let event_val = parser_f nst.(swidx) main_args |> extract_ival in match event_val.v with | VEvent(event_val) -> execute_event print_log swidx nst event_val port (InterpSwitch.Ingress) | VBool(false) -> () (* Its okay to not generate an event. That will happen for drops. *) diff --git a/src/lib/midend/interpreter/InterpCore.ml b/src/lib/midend/interpreter/InterpCore.ml index 8403997a..a8da82aa 100644 --- a/src/lib/midend/interpreter/InterpCore.ml +++ b/src/lib/midend/interpreter/InterpCore.ml @@ -236,7 +236,7 @@ let rec interp_exp (nst : network_state) swid locals e : InterpSwitch.ival = error (Cid.to_string cid ^ " is a value identifier and cannot be used in a call") - | F(_, f) -> f nst swid vs + | F(_, f) -> f nst.(swid) vs ) | EHash (Szs _, _ ) -> error "Hash expression size should not be a tuple" @@ -641,7 +641,7 @@ let interp_dglobal (nst : network_state) swid id ty e = let vg_ival = InterpSwitch.V (vglobal id idx ty) in (* call the constructor to update the pipeline, adding the value to it *) let arg_ivals = vg_ival::arg_ivals in - let new_pipe = Tables.create_ctor nst swid arg_ivals in + let new_pipe = Tables.create_ctor nst.(swid) arg_ivals in (* update the global state's pipeline *) nst.(swid) <- { nst.(swid) with pipeline = new_pipe }; (* add the global to globals context in nst *) @@ -660,8 +660,9 @@ let interp_dglobal (nst : network_state) swid id ty e = | _ -> _interp_dglobal nst swid id ty e ;; -let interp_complex_body params body nst swid args = - (* TODO: +let interp_complex_body params body st args = + let nst, swid = nst_swid st in + (* TODO: - cell2 should not take default. - the default parameter should get removed. Just use 0. *) let args, default = List.takedrop (List.length params) args in @@ -716,7 +717,8 @@ let interp_complex_body params body nst swid args = { v = VTuple vs; vty = ty TBool (* Dummy type *); vspan = Span.default } ;; -let interp_memop params body nst swid args = +let interp_memop params body st args = + let nst, swid = nst_swid st in (* Memops are polymorphic, but since the midend doesn't understand polymorphism, the size of all the ints in its body got set to 32. We'll just handle this by going through now and setting all the sizes to that of the first argument. @@ -730,7 +732,7 @@ let interp_memop params body nst swid args = let sz = List.hd args |> extract_ival |> raw_integer |> Integer.size in let body = replacer#visit_memop_body sz body in match body with - | MBComplex body -> InterpSwitch.V(interp_complex_body params body nst swid args) + | MBComplex body -> InterpSwitch.V(interp_complex_body params body st args) | MBReturn e -> let locals = List.fold_left2 @@ -810,7 +812,7 @@ and interp_parser_step nst swid payload_id locals parser_step = in (* call the parser function as you would any other function *) match InterpSwitch.lookup cid sw_st with - | F(_, parser_f) -> let rv = parser_f nst swid args in rv |> extract_ival + | F(_, parser_f) -> let rv = parser_f sw_st args in rv |> extract_ival | _ -> error "[parser call] could not find parser function" ) | _ -> error "[parser call] expected a call expression" @@ -878,7 +880,8 @@ let interp_decl (nst : network_state) swid d = (* figure out whether to use the implicit payload argument. if there is an explicit payload for the parser, it must be the first argument. *) let payload_id_opt = find_bitstring_param params in - let runtime_function nst swid args = + let runtime_function st args = + let nst, swid = nst_swid st in (* if there is no payload parameter, put one in the front *) let param_ids, payload_id = match payload_id_opt with | None -> ((Builtins.ingr_port_id)::(Builtins.packet_arg_id)::(List.split params |> fst), Builtins.packet_arg_id) @@ -902,7 +905,7 @@ let interp_decl (nst : network_state) swid d = | DEvent (id, num_opt, _, _) -> (* the expression inside a generate just constructs an event value. *) (* the generate statement adds the payload, however *) - let f _ _ args = + let f _ args = let event_num_val = match num_opt with | None -> None | Some(num) -> Some( @@ -936,7 +939,8 @@ let interp_decl (nst : network_state) swid d = failwith "Extern declarations should be handled during preprocessing" | DUserTy _ -> nst (*all user types should be inlined by now*) | DFun(id, _, body) -> - let runtime_function (nst: network_state) swid args = + let runtime_function st args = + let nst, swid = nst_swid st in (* bind args to parameters *) let locals = List.fold_left2 @@ -966,9 +970,9 @@ let interp_decl (nst : network_state) swid d = interpreted, here and in Tables.ml *) (* add a function to the environment that takes the action constructor's params and returns a function version of the inner action *) - let action_function_generator _ _ const_args = + let action_function_generator _ const_args = (* the inner action function *) - let action_function _ _ args = + let action_function _ args = (* bind the closure args and runtime args in the env *) let locals = List.fold_left2 diff --git a/src/lib/midend/interpreter/InterpParsing.ml b/src/lib/midend/interpreter/InterpParsing.ml index 61b18c35..d651e612 100644 --- a/src/lib/midend/interpreter/InterpParsing.ml +++ b/src/lib/midend/interpreter/InterpParsing.ml @@ -60,7 +60,8 @@ let parse_args (p:value) arg_tys = ;; -let lucid_parse_fun (nst: InterpSwitch.state Array.t) swid args = +let lucid_parse_fun (st : InterpSwitch.state) args = + let nst, swid = nst_swid st in (* payload is a VBits value *) let payload = match args with | [_; InterpSwitch.V(payload)] -> payload diff --git a/src/lib/midend/interpreter/InterpSpec.ml b/src/lib/midend/interpreter/InterpSpec.ml index d86f9fd8..20ecd4d4 100644 --- a/src/lib/midend/interpreter/InterpSpec.ml +++ b/src/lib/midend/interpreter/InterpSpec.ml @@ -238,7 +238,7 @@ let create_foreign_functions renaming efuns python_file = | Some o -> let f = InterpSwitch.anonf - (fun _ _ args -> + (fun _ args -> let pyretvar = Py.Callable.to_function o diff --git a/src/lib/midend/interpreter/InterpSwitch.ml b/src/lib/midend/interpreter/InterpSwitch.ml index 106e20a1..f8e9e61d 100644 --- a/src/lib/midend/interpreter/InterpSwitch.ml +++ b/src/lib/midend/interpreter/InterpSwitch.ml @@ -76,10 +76,8 @@ and network_state = state Array.t (* a handler has side effects, so it needs to see the network state *) and handler = network_state -> int (* switch *) -> int (* port *) -> event_val -> unit -(* code inside the program has no side effects, so it should not need network state, - just switch state (or even perhaps only the switch pipeline?) *) -and code = network_state -> int (* switch *) -> ival list -> ival -(* and code = state -> ival list -> ival *) +(* code inside the program may mutate switch state (first arg) *) +and code = state -> ival list -> ival and ival = | V of value @@ -88,6 +86,11 @@ and ival = let f (cid: cid) (code: code) = F(Some(cid), code) let anonf (code: code) = F(None, code) +(* Recover the (network_state, switch id) pair from a switch state. Used to + bridge `code` (which now takes just a switch state) to interpreter helpers + that still thread network state + switch id. *) +let nst_swid (st : state) : network_state * int = !(st.sws), st.swid + let extract_ival iv = match iv with | V v -> v From c3072ec7c553336216a7f6bbfe6934dd5674e15f Mon Sep 17 00:00:00 2001 From: John Sonchack Date: Sun, 7 Jun 2026 14:08:38 -0400 Subject: [PATCH 27/49] factor out network state to only require switch state throughout interpreter core --- src/lib/frontend/modules/Counters.ml | 3 +- src/lib/midend/interpreter/Interp.ml | 4 +- src/lib/midend/interpreter/InterpCore.ml | 275 +++++++++----------- src/lib/midend/interpreter/InterpParsing.ml | 5 +- src/lib/midend/interpreter/InterpSwitch.ml | 15 +- 5 files changed, 138 insertions(+), 164 deletions(-) diff --git a/src/lib/frontend/modules/Counters.ml b/src/lib/frontend/modules/Counters.ml index a0669da2..f5cae5fe 100644 --- a/src/lib/frontend/modules/Counters.ml +++ b/src/lib/frontend/modules/Counters.ml @@ -59,14 +59,13 @@ let setop = InterpSwitch.F (None, fun _ args -> V(InterpSwitch.extract_ival (Lis let dummy_int = InterpSwitch.V (CoreSyntax.vinteger (Integer.of_int 0)) let counter_add_fun st args = - let nst, swid = nst_swid st in let open InterpSyntax in let open CoreSyntax in match args with | [V { v = VGlobal (_, stage) }; V { v = VInt addval }] -> let get_f arg = vinteger arg in let set_f arg = Integer.add arg addval in - V(Pipeline.update ~stage ~idx:0 ~getop:get_f ~setop:set_f nst.(swid).pipeline) + V(Pipeline.update ~stage ~idx:0 ~getop:get_f ~setop:set_f st.pipeline) | _ -> counter_add_error "Incorrect number or type of arguments to Counter.add" ;; diff --git a/src/lib/midend/interpreter/Interp.ml b/src/lib/midend/interpreter/Interp.ml index b35cb74b..5610fa6f 100644 --- a/src/lib/midend/interpreter/Interp.ml +++ b/src/lib/midend/interpreter/Interp.ml @@ -226,7 +226,7 @@ let execute_event let default_handler_body = C.SGen(C.GPort(C.vint_exp port 32), C.value_to_exp {v=C.VEvent(event); vty=C.tevent; vspan=Span.default}) in - ignore@@InterpCore.interp_statement nst HEgress swid builtin_env (C.statement default_handler_body) + ignore@@InterpCore.interp_statement nst.(swid) HEgress builtin_env (C.statement default_handler_body) | InterpSwitch.Ingress -> error @@ "No handler for event " ^ Cid.to_string event.eid ) ;; @@ -289,7 +289,7 @@ let execute_control swidx (nst : network_state) (ctl_ev : control_val) = (ty@@TTuple(List.map (fun exp -> exp.ety.raw_ty) cmd.iargs)) in let eargs = [etbl; ekey; emask; eaction_constr; eaction_constr_args] in let ecall = C.exp (ECall(Cid.create ["Table"; "install_ternary"],eargs, false)) (ty TBool) in - InterpCore.interp_exp nst swidx Env.empty ecall + InterpCore.interp_exp nst.(swidx) Env.empty ecall in InterpControl.handle_control do_tbl_install diff --git a/src/lib/midend/interpreter/InterpCore.ml b/src/lib/midend/interpreter/InterpCore.ml index a8da82aa..1621ecaf 100644 --- a/src/lib/midend/interpreter/InterpCore.ml +++ b/src/lib/midend/interpreter/InterpCore.ml @@ -211,11 +211,11 @@ let calc_crc16_csum (zs : zint list) = Integer.bitnot (Integer.set_size 16 !sum) ;; -let rec interp_exp (nst : network_state) swid locals e : InterpSwitch.ival = - let sw_st = nst.(swid) in - let interp_exps = interp_exps nst swid locals in - let interp_exp = interp_exp nst swid locals in - +let rec interp_exp (st : InterpSwitch.state) locals e : InterpSwitch.ival = + let sw_st = st in + let interp_exps = interp_exps st locals in + let interp_exp = interp_exp st locals in + let extract_int = function | VInt n -> n | _ -> failwith "No good" @@ -236,7 +236,7 @@ let rec interp_exp (nst : network_state) swid locals e : InterpSwitch.ival = error (Cid.to_string cid ^ " is a value identifier and cannot be used in a call") - | F(_, f) -> f nst.(swid) vs + | F(_, f) -> f st vs ) | EHash (Szs _, _ ) -> error "Hash expression size should not be a tuple" @@ -322,8 +322,8 @@ let rec interp_exp (nst : network_state) swid locals e : InterpSwitch.ival = (* V (VRecord(fields)) *) -and interp_exps nst swid locals es : InterpSwitch.ival list = - List.map (interp_exp nst swid locals) es +and interp_exps st locals es : InterpSwitch.ival list = + List.map (interp_exp st locals) es ;; let bitmatch bits n = @@ -389,10 +389,10 @@ let printf_string swid str = then InterpJson.interp_report_json "printf" str (Some swid) else str -let partial_interp_exps nst swid env exps = +let partial_interp_exps st env exps = List.map (fun exp -> - match interp_exp nst swid env exp with + match interp_exp st env exp with | V v -> { e = EVal v; espan = Span.default; ety = v.vty } | _ -> error @@ -402,22 +402,22 @@ let partial_interp_exps nst swid env exps = ;; (* convert a flood port into a list of declared ports *) -let expand_flood_port (nst : network_state) swid flood_port = +let expand_flood_port (st : InterpSwitch.state) flood_port = List.filter_map - (fun (port) -> - if (port <> (-(flood_port + 1))) + (fun (port) -> + if (port <> (-(flood_port + 1))) then Some(port) else None) - (InterpSim.get_internal_non_recirc_ports nst.(swid).config.links swid) + (InterpSim.get_internal_non_recirc_ports st.config.links st.swid) ;; -let rec interp_statement nst hdl_sort swid locals s = +let rec interp_statement st hdl_sort locals s = (* (match s.s with | SSeq _ | SNoop -> () (* We'll print the sub-parts when we get to them *) | _ -> print_endline @@ "Interpreting " ^ CorePrinting.stmt_to_string s); *) - let sw_st = nst.(swid) in - let interp_exp = interp_exp nst swid locals in - let interp_s = interp_statement nst hdl_sort swid locals in + let sw_st = st in + let interp_exp = interp_exp st locals in + let interp_s = interp_statement st hdl_sort locals in match s.s with | SNoop -> locals | SAssign (id, e) -> @@ -436,7 +436,7 @@ let rec interp_statement nst hdl_sort swid locals s = if (InterpConfig.cfg.show_printf) then ( let vs = List.map (fun e -> interp_exp e |> extract_ival) es in let strout = printf_replace vs s in - printf_string swid strout |> print_endline); + printf_string st.swid strout |> print_endline); locals | SIf (e, ss1, ss2) -> let b = interp_exp e |> extract_ival |> raw_bool in @@ -444,9 +444,9 @@ let rec interp_statement nst hdl_sort swid locals s = | SSeq (ss1, ss2) -> let locals = interp_s ss1 in (* Stop evaluating after hitting a return statement *) - if !(nst.(swid).retval) <> None + if !(sw_st.retval) <> None then locals - else interp_statement nst hdl_sort swid locals ss2 + else interp_statement st hdl_sort locals ss2 | SGen (g, e) -> ( let event = interp_exp e |> extract_ival |> raw_event in @@ -490,13 +490,13 @@ let rec interp_statement nst hdl_sort swid locals s = (* if we're flooding, we should also generate an event to the "exit" node in the network with the negative flood port... Hmm, that's weird why would we do that? Just for logging? *) PFlood(port):: - (List.map (fun p-> Port(p)) (expand_flood_port nst swid port)) + (List.map (fun p-> Port(p)) (expand_flood_port st port)) | _ -> List.map (fun port -> Port(port)) ports) in (* push event to all output ports *) - List.iter (fun out_port -> - InterpSwitch.ingress_send (nst.(swid)) out_port event) + List.iter (fun out_port -> + InterpSwitch.ingress_send st out_port event) output_ports; locals ) @@ -510,14 +510,14 @@ let rec interp_statement nst hdl_sort swid locals s = egress generate variants the same! *) let port = ((port_arg locals).v |> extract_int ).value |> Z.to_int in (* egress serializes packet events *) - let ev_sort = Env.find event.eid nst.(swid).event_sorts in + let ev_sort = Env.find event.eid sw_st.event_sorts in (* serialize packet events *) let event_val = match ev_sort with | EBackground -> {event with eserialized = false} (* background events stay as events *) | EPacket -> InterpDeparsing.serialize_packet_event event in - InterpSwitch.egress_send (nst.(swid)) port event_val; + InterpSwitch.egress_send st port event_val; locals ) | HControl -> (error "control events are not implemented") @@ -525,11 +525,11 @@ let rec interp_statement nst hdl_sort swid locals s = | SRet (Some e) -> let v = interp_exp e |> extract_ival in (* Computation stops if retval is Some *) - nst.(swid).retval := Some v; + sw_st.retval := Some v; locals | SRet None -> (* Return a dummy value; type system guarantees it won't be used *) - nst.(swid).retval := Some (vint 0 0); + sw_st.retval := Some (vint 0 0); locals | SUnit e -> ignore (interp_exp e); @@ -555,7 +555,7 @@ let rec interp_statement nst hdl_sort swid locals s = | _ -> first_match in let locals = List.fold_left2 update_local locals (fst first_match) vs in - interp_statement nst hdl_sort swid locals (snd first_match) + interp_statement st hdl_sort locals (snd first_match) | STupleAssign({ids; exp}) -> (* eval the exp, get a list of results, assign them to the ids in locals *) let v_result = interp_exp exp |> extract_ival in @@ -570,13 +570,12 @@ let rec interp_statement nst hdl_sort swid locals s = ids ;; -let _interp_dglobal (nst : network_state) swid id ty e = +let _interp_dglobal (st : InterpSwitch.state) id ty e = (* FIXME: This functions is probably more complicated than it needs to be. We can probably do this a lot better by writing the Array.create function in Arrays.ml (and similarly for counters), then just calling that. But I don't want to muck around with the interpreter for now, so I'm sticking to quick fixes. *) - let st = nst.(swid) in let p = st.pipeline in let idx = Pipeline.length p in let gty_name, gty_sizes = @@ -593,7 +592,7 @@ let _interp_dglobal (nst : network_state) swid id ty e = match gty_name, gty_sizes, args with | ["Array"; "t"], [Sz size], [e] -> let len = - interp_exp nst swid Env.empty e + interp_exp st Env.empty e |> extract_ival |> raw_integer |> Integer.to_int @@ -601,7 +600,7 @@ let _interp_dglobal (nst : network_state) swid id ty e = Pipeline.append p (Pipeline.mk_array id size len false) | ["Counter"; "t"], [Sz size], [e] -> let init_value = - interp_exp nst swid Env.empty e |> extract_ival |> raw_integer + interp_exp st Env.empty e |> extract_ival |> raw_integer in let new_p = Pipeline.append p (Pipeline.mk_array id size 1 false) in ignore @@ -614,7 +613,7 @@ let _interp_dglobal (nst : network_state) swid id ty e = new_p | ["PairArray"; "t"], [Sz size], [e] -> let len = - interp_exp nst swid Env.empty e + interp_exp st Env.empty e |> extract_ival |> raw_integer |> Integer.to_int @@ -627,41 +626,36 @@ let _interp_dglobal (nst : network_state) swid id ty e = in let st = { st with pipeline = new_p } in let st = InterpSwitch.add_global (Id id) (V (vglobal id idx ty)) st in - nst.(swid) <- st; - nst + st ;; -let interp_dglobal (nst : network_state) swid id ty e = - match e.e with +let interp_dglobal (st : InterpSwitch.state) id ty e = + match e.e with | ECall(cid, args, _) when (Cid.names cid) = ["Table"; "create"] -> ( (* eval the args *) - let arg_ivals = List.map (fun e -> interp_exp nst swid Env.empty e) args in + let arg_ivals = List.map (fun e -> interp_exp st Env.empty e) args in (* construct the value *) - let idx = Pipeline.length (nst.(swid).pipeline) in + let idx = Pipeline.length (st.pipeline) in let vg_ival = InterpSwitch.V (vglobal id idx ty) in (* call the constructor to update the pipeline, adding the value to it *) let arg_ivals = vg_ival::arg_ivals in - let new_pipe = Tables.create_ctor nst.(swid) arg_ivals in + let new_pipe = Tables.create_ctor st arg_ivals in (* update the global state's pipeline *) - nst.(swid) <- { nst.(swid) with pipeline = new_pipe }; - (* add the global to globals context in nst *) - let st = nst.(swid) in + let st = { st with pipeline = new_pipe } in + (* add the global to globals context *) let st = InterpSwitch.add_global (Id id) vg_ival st in - nst.(swid) <- st; - (* return updated nst *) - nst - (* interp_dtable nst swid id ty e *) + (* return updated switch state *) + st ) - (* old builtin method of constructing globals. - TODO: put the constructors into a global context and refactor - to use the same approach as for tables, above. - Eventually, a constructor call should be implemented the same way as a + (* old builtin method of constructing globals. + TODO: put the constructors into a global context and refactor + to use the same approach as for tables, above. + Eventually, a constructor call should be implemented the same way as a function call (it just happens to be one that updates the network state) *) - | _ -> _interp_dglobal nst swid id ty e + | _ -> _interp_dglobal st id ty e ;; let interp_complex_body params body st args = - let nst, swid = nst_swid st in (* TODO: - cell2 should not take default. - the default parameter should get removed. Just use 0. *) @@ -686,14 +680,14 @@ let interp_complex_body params body st args = in let interp_b locals = function | None -> locals - | Some (id, e) -> Env.add (Id id) (interp_exp nst swid locals e) locals + | Some (id, e) -> Env.add (Id id) (interp_exp st locals e) locals in let interp_cro id locals = function | None -> false, locals | Some (e1, e2) -> - let b = interp_exp nst swid locals e1 |> extract_ival |> raw_bool in + let b = interp_exp st locals e1 |> extract_ival |> raw_bool in if b - then b, Env.add (Id id) (interp_exp nst swid locals e2) locals + then b, Env.add (Id id) (interp_exp st locals e2) locals else b, locals in let interp_cell id locals (cro1, cro2) = @@ -707,7 +701,7 @@ let interp_complex_body params body st args = List.iter (fun (cid, es) -> ignore - @@ interp_exp nst swid locals (call_sp cid es (ty TBool) Span.default)) + @@ interp_exp st locals (call_sp cid es (ty TBool) Span.default)) body.extern_calls; let _, locals = interp_cro ret_id locals body.ret in let vs = @@ -718,7 +712,6 @@ let interp_complex_body params body st args = ;; let interp_memop params body st args = - let nst, swid = nst_swid st in (* Memops are polymorphic, but since the midend doesn't understand polymorphism, the size of all the ints in its body got set to 32. We'll just handle this by going through now and setting all the sizes to that of the first argument. @@ -741,7 +734,7 @@ let interp_memop params body st args = args params in - interp_exp nst swid locals e + interp_exp st locals e | MBIf (e1, e2, e3) -> let locals = List.fold_left2 @@ -750,22 +743,22 @@ let interp_memop params body st args = args params in - let b = interp_exp nst swid locals e1 |> extract_ival |> raw_bool in + let b = interp_exp st locals e1 |> extract_ival |> raw_bool in if b - then interp_exp nst swid locals e2 - else interp_exp nst swid locals e3 + then interp_exp st locals e2 + else interp_exp st locals e3 ;; -let rec interp_parser_block nst swid payload_id locals parser_block = +let rec interp_parser_block st payload_id locals parser_block = (* interpret the actions, updating locals *) - let locals = List.fold_left (interp_parser_action nst swid payload_id) locals (List.split parser_block.pactions |> fst) in + let locals = List.fold_left (interp_parser_action st payload_id) locals (List.split parser_block.pactions |> fst) in (* now interpret the step *) - interp_parser_step nst swid payload_id locals (fst parser_block.pstep) - -and interp_parser_action (nst : network_state) swid payload_id locals parser_action = + interp_parser_step st payload_id locals (fst parser_block.pstep) + +and interp_parser_action (st : InterpSwitch.state) payload_id locals parser_action = (* TODO: implement Payload.read and Payload.peek *) - match parser_action with - | PRead(cid, ty, _) -> + match parser_action with + | PRead(cid, ty, _) -> let payload = get_local payload_id locals in (* semantically, a read creates a new variable and also updates the payload variable *) let parsed_val, payload' = InterpParsing.pread payload ty in @@ -773,45 +766,45 @@ and interp_parser_action (nst : network_state) swid payload_id locals parser_act locals |> Env.add (cid) (InterpSwitch.V(parsed_val)) |> update_local payload_id payload' - | PPeek(cid, ty, _) -> + | PPeek(cid, ty, _) -> let peeked_val = InterpParsing.ppeek (get_local payload_id locals) ty in locals |> Env.add (cid) (InterpSwitch.V(peeked_val)) | PSkip(ty) -> let payload' = InterpParsing.padvance (get_local payload_id locals) ty in update_local payload_id payload' locals | PAssign(cid, exp) -> - let assigned_ival = interp_exp nst swid locals exp in + let assigned_ival = interp_exp st locals exp in locals |> Env.remove cid |> Env.add (cid) (assigned_ival) - | PLocal(cid, _, exp) -> - let assigned_ival = interp_exp nst swid locals exp in + | PLocal(cid, _, exp) -> + let assigned_ival = interp_exp st locals exp in Env.add (cid) (assigned_ival) locals -and interp_parser_step nst swid payload_id locals parser_step = - let sw_st = nst.(swid) in +and interp_parser_step st payload_id locals parser_step = + let sw_st = st in match parser_step with | PMatch(es, branches) -> - let vs = List.map (fun e -> interp_exp nst swid locals e |> extract_ival) es in + let vs = List.map (fun e -> interp_exp st locals e |> extract_ival) es in let first_match = try List.find (fun (pats, _) -> matches_pat vs pats) branches with | _ -> error "[interp_parser_step] parser match did not match any branch!" in - interp_parser_block nst swid payload_id locals (snd first_match) + interp_parser_block st payload_id locals (snd first_match) | PGen(exp) -> ( - let event_val = interp_exp nst swid locals exp |> extract_ival in - event_val + let event_val = interp_exp st locals exp |> extract_ival in + event_val ) | PCall(exp) -> ( - match exp.e with + match exp.e with | ECall(cid, args, _) -> ( (* a call to another parser. *) (* construct ival arguments *) - let args = - (InterpSwitch.V(port_arg locals))::(List.map (interp_exp nst swid locals) args) + let args = + (InterpSwitch.V(port_arg locals))::(List.map (interp_exp st locals) args) in (* call the parser function as you would any other function *) - match InterpSwitch.lookup cid sw_st with + match InterpSwitch.lookup cid sw_st with | F(_, parser_f) -> let rv = parser_f sw_st args in rv |> extract_ival | _ -> error "[parser call] could not find parser function" ) @@ -829,15 +822,18 @@ let rec find_bitstring_param params = | _::tl -> find_bitstring_param tl ;; -let interp_decl (nst : network_state) swid d = +let interp_decl (st : InterpSwitch.state) d = (* print_endline @@ "Interping decl: " ^ Printing.decl_to_string d; *) match d.d with - | DGlobal (id, ty, e) -> interp_dglobal nst swid id ty e + | DGlobal (id, ty, e) -> interp_dglobal st id ty e | DHandler (id, hdl_sort, (params, body)) ->( (* print_endline@@"Adding handler"^(CorePrinting.id_to_string id); print_endline@@"handler sort: "^(match hdl_sort with | HData -> "ingress" | HEgress -> "egress" | _ ->""); *) + (* a handler runs in network context (it can generate to other switches), + so it keeps the `handler` type. It enters the per-switch recursion by + handing it nst.(swid). *) let f nst swid port event = - if (hdl_sort = HEgress) then + if (hdl_sort = HEgress) then print_endline@@"interping egress handler"; (* add the event to the environment *) let builtin_env = @@ -857,133 +853,111 @@ let interp_decl (nst : network_state) swid d = in update_counter swid event nst; (*TODO: why are we counting packet events here? *) Pipeline.reset_stage nst.(swid).pipeline; - ignore @@ interp_statement nst hdl_sort swid locals body + ignore @@ interp_statement nst.(swid) hdl_sort locals body in match hdl_sort with - | HData -> - (* add_hdlr, temporarily inlined for refactoring *) - let updated_switch = {nst.(swid) with hdlrs = Env.add (Cid.id id) f nst.(swid).hdlrs} in - nst.(swid) <- updated_switch; - nst - | HEgress -> - (* add_egress_hdlr, temporarily inlined for refactoring *) - let updated_switch = {nst.(swid) with egress_hdlrs = Env.add (Cid.id id) f nst.(swid).egress_hdlrs} in - nst.(swid) <- updated_switch; - (* nst.(swid) <- InterpSwitch.add_egress_hdlr (Cid.id id) f nst.(swid); *) - nst + | HData -> + { st with hdlrs = Env.add (Cid.id id) f st.hdlrs } + | HEgress -> + { st with egress_hdlrs = Env.add (Cid.id id) f st.egress_hdlrs } | _ -> error "control handlers not supported" ) - (* parsers: convention is for first two arguments to be + (* parsers: convention is for first two arguments to be ingress port and unparsed packet / payload. *) - | DParser(id, params, parser_block) -> - (* figure out whether to use the implicit payload argument. if there is an explicit + | DParser(id, params, parser_block) -> + (* figure out whether to use the implicit payload argument. if there is an explicit payload for the parser, it must be the first argument. *) let payload_id_opt = find_bitstring_param params in let runtime_function st args = - let nst, swid = nst_swid st in (* if there is no payload parameter, put one in the front *) let param_ids, payload_id = match payload_id_opt with | None -> ((Builtins.ingr_port_id)::(Builtins.packet_arg_id)::(List.split params |> fst), Builtins.packet_arg_id) | Some(payload_id) -> (Builtins.ingr_port_id)::(List.split params |> fst), payload_id in (* construct the locals table *) - let locals = + let locals = List.fold_left2 (fun acc v id -> Env.add (Id id) v acc) Env.empty args param_ids in - InterpSwitch.V(interp_parser_block nst swid payload_id locals parser_block) + InterpSwitch.V(interp_parser_block st payload_id locals parser_block) in - let st = nst.(swid) in - let st = InterpSwitch.add_global (Cid.id id) (InterpSwitch.anonf runtime_function) st in - nst.(swid) <- st; - nst + InterpSwitch.add_global (Cid.id id) (InterpSwitch.anonf runtime_function) st | DEvent (id, num_opt, _, _) -> (* the expression inside a generate just constructs an event value. *) (* the generate statement adds the payload, however *) let f _ args = let event_num_val = match num_opt with - | None -> None + | None -> None | Some(num) -> Some( vint num (size_of_tint (SyntaxToCore.translate_ty Builtins.lucid_eventnum_ty)) ) in - (* let extract_ival_pkt_placeholder ival = + (* let extract_ival_pkt_placeholder ival = match ival with | State.P(_) -> {v=VPat([]); vty=Payloads.payload_ty |> SyntaxToCore.translate_ty; vspan=Span.default} | _ -> extract_ival ival in *) - InterpSwitch.V (vevent { - eid = Id id; - data = List.map extract_ival args; + InterpSwitch.V (vevent { + eid = Id id; + data = List.map extract_ival args; edelay = 0; evnum = event_num_val; eserialized = false; }) in - let st = nst.(swid) in - let st = InterpSwitch.add_global (Id id) (InterpSwitch.f (Id id) f) st in - nst.(swid) <- st; - nst + InterpSwitch.add_global (Id id) (InterpSwitch.f (Id id) f) st | DMemop { mid; mparams; mbody } -> let f = interp_memop mparams mbody in - let st = nst.(swid) in - let st = InterpSwitch.add_global (Cid.id mid) (InterpSwitch.f (Cid.id mid) f) st in - nst.(swid) <- st; - nst + InterpSwitch.add_global (Cid.id mid) (InterpSwitch.f (Cid.id mid) f) st | DExtern _ -> failwith "Extern declarations should be handled during preprocessing" - | DUserTy _ -> nst (*all user types should be inlined by now*) - | DFun(id, _, body) -> + | DUserTy _ -> st (*all user types should be inlined by now*) + | DFun(id, _, body) -> let runtime_function st args = - let nst, swid = nst_swid st in (* bind args to parameters *) - let locals = + let locals = List.fold_left2 (fun acc v id -> Env.add (Id id) v acc) Env.empty - args + args (fst body |> List.split |> fst) in - (* no need to reset the pipe stage -- main should start at the beginning. *) - (* Pipeline.reset_stage nst.(swid).pipeline; *) (* interp the statement *) - let _ = interp_statement nst HData swid locals (snd body) in - let ret_v = match (!(nst.(swid).retval)) with + let _ = interp_statement st HData locals (snd body) in + let ret_v = match (!(st.retval)) with | Some(v) -> v | None -> vint 0 0; in - nst.(swid).retval := None; + st.retval := None; InterpSwitch.V(ret_v) - in - let st = nst.(swid) in - let st = InterpSwitch.add_global (Cid.id id) (InterpSwitch.f (Cid.id id) runtime_function) st in - nst.(swid) <- st; - nst + in + InterpSwitch.add_global (Cid.id id) (InterpSwitch.f (Cid.id id) runtime_function) st | DActionConstr({aid; aconst_params; aparams; abody}) -> - (* TODO: clean up the way actions and action constructors are + (* TODO: clean up the way actions and action constructors are interpreted, here and in Tables.ml *) - (* add a function to the environment that takes the action constructor's params + (* add a function to the environment that takes the action constructor's params and returns a function version of the inner action *) let action_function_generator _ const_args = - (* the inner action function *) - let action_function _ args = + (* the inner action function. Action bodies are pure, so they run on + whatever switch state they are called with. *) + let action_function st args = (* bind the closure args and runtime args in the env *) - let locals = + let locals = List.fold_left2 (fun acc v id -> Env.add (Id id) v acc) Env.empty (const_args@args) ((aconst_params|> List.split |> fst)@(aparams |> List.split |> fst)) in - let ret_vs = List.map - (fun exp -> (interp_exp nst swid locals exp |> extract_ival).v) - abody + let ret_vs = List.map + (fun exp -> (interp_exp st locals exp |> extract_ival).v) + abody in let ret_v = value@@VTuple(ret_vs) in InterpSwitch.V(ret_v) @@ -992,10 +966,7 @@ let interp_decl (nst : network_state) swid d = action_f in let constr_f = InterpSwitch.f (Cid.id aid) action_function_generator in - let st = nst.(swid) in - let st = InterpSwitch.add_global (Cid.id aid) constr_f st in - nst.(swid) <- st; - nst + InterpSwitch.add_global (Cid.id aid) constr_f st ;; @@ -1004,7 +975,11 @@ let process_decls nst ds = let rec aux i (nst : network_state) = if i = Array.length nst then nst - else aux (i + 1) (List.fold_left (fun nst -> interp_decl nst i) nst ds) + else ( + (* thread the switch state through every decl, then save it back *) + let st = List.fold_left interp_decl nst.(i) ds in + nst.(i) <- st; + aux (i + 1) nst) in aux 0 nst ;; diff --git a/src/lib/midend/interpreter/InterpParsing.ml b/src/lib/midend/interpreter/InterpParsing.ml index d651e612..441db4c8 100644 --- a/src/lib/midend/interpreter/InterpParsing.ml +++ b/src/lib/midend/interpreter/InterpParsing.ml @@ -61,7 +61,6 @@ let parse_args (p:value) arg_tys = let lucid_parse_fun (st : InterpSwitch.state) args = - let nst, swid = nst_swid st in (* payload is a VBits value *) let payload = match args with | [_; InterpSwitch.V(payload)] -> payload @@ -76,11 +75,11 @@ let lucid_parse_fun (st : InterpSwitch.state) args = | _ -> error "event number is not a value?" in (* look up the event signature *) - let event_cid, param_tys = match InterpSim.IntMap.find_opt event_num_int nst.(swid).event_signatures with + let event_cid, param_tys = match InterpSim.IntMap.find_opt event_num_int st.event_signatures with | Some(cid, tys) -> cid, tys | None -> print_endline ("----event number directory----"); - InterpSim.IntMap.iter (fun k v -> print_endline ("event num: "^(string_of_int k)^" event id: "^(Cid.to_string (fst v)) )) nst.(swid).event_signatures; + InterpSim.IntMap.iter (fun k v -> print_endline ("event num: "^(string_of_int k)^" event id: "^(Cid.to_string (fst v)) )) st.event_signatures; error ("parsed an event tag int that doesn't correspond to a known event: "^(string_of_int event_num_int)); in (* parse arguments from bitstring *) diff --git a/src/lib/midend/interpreter/InterpSwitch.ml b/src/lib/midend/interpreter/InterpSwitch.ml index f8e9e61d..e6e76cde 100644 --- a/src/lib/midend/interpreter/InterpSwitch.ml +++ b/src/lib/midend/interpreter/InterpSwitch.ml @@ -86,11 +86,6 @@ and ival = let f (cid: cid) (code: code) = F(Some(cid), code) let anonf (code: code) = F(None, code) -(* Recover the (network_state, switch id) pair from a switch state. Used to - bridge `code` (which now takes just a switch state) to interpreter helpers - that still thread network state + switch id. *) -let nst_swid (st : state) : network_state * int = !(st.sws), st.swid - let extract_ival iv = match iv with | V v -> v @@ -309,7 +304,11 @@ let calc_arrival_time (src_sw : state) (dst_id: location option) desired_delay = ;; (* val ingress_send : 'nst -> 'nst state -> ingress_destination -> event_val -> unit *) -let ingress_send (src_sw : state) ingress_destination event_val = +let ingress_send (src_sw : state) ingress_destination event_val = + (* re-read the source switch from the live array: a handler may send several + events, and each send persists queue changes via save_update. Working from + a stale snapshot would make successive sends clobber each other. *) + let src_sw = lookup_switch src_sw src_sw.swid in match ingress_destination with | Switch sw -> let dst_sw = lookup_switch src_sw sw in @@ -329,7 +328,9 @@ let ingress_send (src_sw : state) ingress_destination event_val = egress_receive src_sw timestamp port ievent ;; -let egress_send src_sw out_port event_val = +let egress_send src_sw out_port event_val = + (* re-read the source switch from the live array (see ingress_send). *) + let src_sw = lookup_switch src_sw src_sw.swid in let dst_opt = InterpSim.lookup_dst src_sw.config.links (src_sw.swid, out_port) in let time = gtime src_sw in (* let time = src_sw.utils.get_time nst in *) From 3c5c022f003acf9ba29b99512aaca4ddee15bb6a Mon Sep 17 00:00:00 2001 From: John Sonchack Date: Sun, 7 Jun 2026 16:07:28 -0400 Subject: [PATCH 28/49] small notes --- src/lib/midend/interpreter/InterpSwitch.ml | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/src/lib/midend/interpreter/InterpSwitch.ml b/src/lib/midend/interpreter/InterpSwitch.ml index e6e76cde..7ac02a58 100644 --- a/src/lib/midend/interpreter/InterpSwitch.ml +++ b/src/lib/midend/interpreter/InterpSwitch.ml @@ -305,10 +305,6 @@ let calc_arrival_time (src_sw : state) (dst_id: location option) desired_delay = (* val ingress_send : 'nst -> 'nst state -> ingress_destination -> event_val -> unit *) let ingress_send (src_sw : state) ingress_destination event_val = - (* re-read the source switch from the live array: a handler may send several - events, and each send persists queue changes via save_update. Working from - a stale snapshot would make successive sends clobber each other. *) - let src_sw = lookup_switch src_sw src_sw.swid in match ingress_destination with | Switch sw -> let dst_sw = lookup_switch src_sw sw in @@ -322,6 +318,7 @@ let ingress_send (src_sw : state) ingress_destination event_val = let ievent = to_internal_event event_val {switch = Some src_sw.swid; port = port} send_time in emit_or_log_exit port ievent send_time src_sw | Port port -> (* NOTE: generate_port goes through an egress for the port *) + let src_sw = lookup_switch src_sw src_sw.swid in (* need to re-read the source switch to handle multiple generates *) let dst_id_opt = InterpSim.lookup_dst_switch src_sw.config.links (src_sw.swid, port) in let timestamp = calc_arrival_time src_sw dst_id_opt (event_val.edelay) in let ievent = to_internal_event event_val {switch = Some src_sw.swid; port = port} timestamp in @@ -329,8 +326,6 @@ let ingress_send (src_sw : state) ingress_destination event_val = ;; let egress_send src_sw out_port event_val = - (* re-read the source switch from the live array (see ingress_send). *) - let src_sw = lookup_switch src_sw src_sw.swid in let dst_opt = InterpSim.lookup_dst src_sw.config.links (src_sw.swid, out_port) in let time = gtime src_sw in (* let time = src_sw.utils.get_time nst in *) From 9b01303b676ebfaa61edeacdce5c916e84b8bbd0 Mon Sep 17 00:00:00 2001 From: John Sonchack Date: Sun, 7 Jun 2026 17:55:37 -0400 Subject: [PATCH 29/49] cleanup and substantial refactor to simplify dependencies at the module and state level in the interpreter --- src/bin/InterpMain.ml | 2 +- src/lib/dune | 1 + src/lib/midend/interpreter/Interp.ml | 30 +- src/lib/midend/interpreter/Interp.mli | 1 + src/lib/midend/interpreter/InterpCore.ml | 31 ++- src/lib/midend/interpreter/InterpNetwork.ml | 136 ++++++++++ src/lib/midend/interpreter/InterpSwitch.ml | 286 +++++++------------- 7 files changed, 264 insertions(+), 223 deletions(-) create mode 100644 src/lib/midend/interpreter/InterpNetwork.ml diff --git a/src/bin/InterpMain.ml b/src/bin/InterpMain.ml index aaa6a771..3e67ccd7 100644 --- a/src/bin/InterpMain.ml +++ b/src/bin/InterpMain.ml @@ -20,7 +20,7 @@ let nst_to_string ?(show_pipeline = true) ?(show_queue = true) ?(show_exits = true) - (nst : InterpSwitch.network_state) + (nst : InterpSwitch.state array) = let base_str = Array.fold_lefti (fun acc idx st -> diff --git a/src/lib/dune b/src/lib/dune index 53ad5d15..e18637b8 100644 --- a/src/lib/dune +++ b/src/lib/dune @@ -91,6 +91,7 @@ interpSim interpState InterpSwitch + InterpNetwork InterpStdio InterpSocket interpParsing diff --git a/src/lib/midend/interpreter/Interp.ml b/src/lib/midend/interpreter/Interp.ml index 5610fa6f..c177c829 100644 --- a/src/lib/midend/interpreter/Interp.ml +++ b/src/lib/midend/interpreter/Interp.ml @@ -11,7 +11,11 @@ open InterpStdio module Env = Collections.CidMap -let save_update nst sw = +(* the simulator orchestrates the whole network; [network_state] lives in + InterpNetwork (its conceptual home). Aliased here for brevity. *) +type network_state = InterpNetwork.network_state + +let save_update nst sw = nst.(sw.swid) <- sw ;; let next_ready_event swid nst = @@ -30,9 +34,11 @@ let ready_egress_events swid nst = evs ;; -let ready_control_commands swid nst = +let ready_control_commands swid nst = let st = nst.(swid) in - InterpSwitch.ready_control_commands st !(st.global_time) + let st', vals = InterpSwitch.ready_control_commands st !(st.global_time) in + save_update nst st'; + vals ;; let all_egress_events swid nst = @@ -51,7 +57,7 @@ let load_interp_input nst interp_input = | None -> error "input event not associated with a switch" | Some(switch) -> switch in - InterpSwitch.load_interp_input (nst.(swid)) loc.port interp_input) + nst.(swid) <- InterpNetwork.load_interp_input (nst.(swid)) loc.port interp_input) locs ;; @@ -92,12 +98,6 @@ let initial_state ?(softswitch_mode=false) spec.simconfig) in let nst = switches in - (* give all the switches references to the switches Array *) - Array.iteri - (fun swid _ -> ( - switches.(swid) <- InterpSwitch.set_sws switches.(swid) switches)) - nst - ; nst ;; @@ -184,7 +184,7 @@ let execute_event st.hdlrs, "" (* nst.handlers, "" *) in - match Env.find_opt event.eid handlers with + (match Env.find_opt event.eid handlers with (* if we found a handler, run it *) | Some handler -> if print_log @@ -211,7 +211,7 @@ let execute_event (CorePrinting.event_to_string event) swid port; - handler nst swid port event + handler nst.(swid) port event (* if we didn't find a handler, that's an error for ingress but okay for egress. *) | None -> ( match gress with @@ -227,8 +227,10 @@ let execute_event C.SGen(C.GPort(C.vint_exp port 32), C.value_to_exp {v=C.VEvent(event); vty=C.tevent; vspan=Span.default}) in ignore@@InterpCore.interp_statement nst.(swid) HEgress builtin_env (C.statement default_handler_body) - | InterpSwitch.Ingress -> - error @@ "No handler for event " ^ Cid.to_string event.eid ) + | InterpSwitch.Ingress -> + error @@ "No handler for event " ^ Cid.to_string event.eid )); + (* deliver everything the handler just generated into its mailbox *) + InterpNetwork.drain_switch nst swid ;; let execute_main_parser print_log swidx port (nst: network_state) (pkt_ev : (CoreSyntax.event_val)) = diff --git a/src/lib/midend/interpreter/Interp.mli b/src/lib/midend/interpreter/Interp.mli index 20c0eecb..258d8738 100644 --- a/src/lib/midend/interpreter/Interp.mli +++ b/src/lib/midend/interpreter/Interp.mli @@ -1,5 +1,6 @@ open CoreSyntax open InterpSwitch +open InterpNetwork (* network_state *) val initialize : Renaming.env -> string -> decl list -> network_state * Preprocess.t * InterpSpec.t val simulate : network_state -> network_state diff --git a/src/lib/midend/interpreter/InterpCore.ml b/src/lib/midend/interpreter/InterpCore.ml index 1621ecaf..09c39bbe 100644 --- a/src/lib/midend/interpreter/InterpCore.ml +++ b/src/lib/midend/interpreter/InterpCore.ml @@ -142,9 +142,8 @@ let interp_op op vs = ^ " arguments") ;; -let update_counter swid event nst = - let st = nst.(swid) in - let event_sort = Env.find event.eid nst.(swid).event_sorts in +let update_counter event st = + let event_sort = Env.find event.eid st.event_sorts in InterpSwitch.update_counter event_sort st ;; @@ -494,11 +493,12 @@ let rec interp_statement st hdl_sort locals s = | _ -> List.map (fun port -> Port(port)) ports) in - (* push event to all output ports *) + (* record the generated events in the mailbox; the network delivers + them in its drain phase, after the handler finishes. *) List.iter (fun out_port -> - InterpSwitch.ingress_send st out_port event) + InterpSwitch.emit st (FromIngress (out_port, event))) output_ports; - locals + locals ) | HEgress -> ( let extract_int = function @@ -517,7 +517,7 @@ let rec interp_statement st hdl_sort locals s = {event with eserialized = false} (* background events stay as events *) | EPacket -> InterpDeparsing.serialize_packet_event event in - InterpSwitch.egress_send st port event_val; + InterpSwitch.emit st (FromEgress (port, event_val)); locals ) | HControl -> (error "control events are not implemented") @@ -829,10 +829,10 @@ let interp_decl (st : InterpSwitch.state) d = | DHandler (id, hdl_sort, (params, body)) ->( (* print_endline@@"Adding handler"^(CorePrinting.id_to_string id); print_endline@@"handler sort: "^(match hdl_sort with | HData -> "ingress" | HEgress -> "egress" | _ ->""); *) - (* a handler runs in network context (it can generate to other switches), - so it keeps the `handler` type. It enters the per-switch recursion by - handing it nst.(swid). *) - let f nst swid port event = + (* a handler runs a switch's event code; its effects are local to that + switch (outgoing events go to the mailbox, the pipeline mutates in + place), so it takes just the switch state. *) + let f st port event = if (hdl_sort = HEgress) then print_endline@@"interping egress handler"; (* add the event to the environment *) @@ -851,9 +851,9 @@ let interp_decl (st : InterpSwitch.state) d = event.data params in - update_counter swid event nst; (*TODO: why are we counting packet events here? *) - Pipeline.reset_stage nst.(swid).pipeline; - ignore @@ interp_statement nst.(swid) hdl_sort locals body + update_counter event st; (*TODO: why are we counting packet events here? *) + Pipeline.reset_stage st.pipeline; + ignore @@ interp_statement st hdl_sort locals body in match hdl_sort with | HData -> @@ -972,7 +972,8 @@ let interp_decl (st : InterpSwitch.state) d = (* interpret declarations to initialize every switch *) let process_decls nst ds = - let rec aux i (nst : network_state) = + (* the core only knows about an array of switches, not "the network" *) + let rec aux i (nst : state array) = if i = Array.length nst then nst else ( diff --git a/src/lib/midend/interpreter/InterpNetwork.ml b/src/lib/midend/interpreter/InterpNetwork.ml new file mode 100644 index 00000000..ae51939d --- /dev/null +++ b/src/lib/midend/interpreter/InterpNetwork.ml @@ -0,0 +1,136 @@ +(* The network "fabric" of the interpreter. + + This module moves events between switches and performs the external I/O + (sockets, stdio exit). It is the single "delivery" phase of the actor-model + interpreter: a switch [emit]s generated events into its mailbox (a pure, + local operation -- see InterpSwitch), and the network [drain]s those + mailboxes here, routing each event to a peer switch's queue or out an + interface. + + [InterpNetwork] depends on [InterpSwitch], never the reverse -- a switch has + no knowledge of the network. *) +open CoreSyntax +open InterpSyntax +open InterpJson +open InterpControl +open Batteries +open InterpSocket +open InterpSwitch + +(* the network is just the array of switch states. This is the network's view; + the per-switch core (InterpSwitch / InterpCore) only ever sees a single + [state], never this. *) +type network_state = state array + + +(* generate an event to stdio or the exit log *) +let log_exit port (ievent:ievent) current_time st = + if InterpConfig.cfg.interactive + then ( + InterpJson.event_exit_to_json + st.swid + (Some(port)) + ievent.sevent + current_time + |> print_endline) + else Queue.push (ievent, Some(port), current_time) st.exits +;; + +(* send an event out a port: to a bound socket if there is one, otherwise + log/print it as an exit from the simulated network. This is the only place + the interpreter performs external I/O. *) +let emit_or_log_exit port (ievent:ievent) current_time st = + match IntMap.find_opt port st.sockets with + | None -> log_exit port ievent current_time st + | Some(socket) -> InterpSocket.send_event socket ievent.sevent +;; + +(* load external input into a switch's queues; returns the new switch state. *) +let load_interp_input st port interp_input : state = + match interp_input with + | IEvent({iev; itime}) -> + let iev = to_internal_event iev {switch = Some st.swid; port} itime in + enqueue_ingress st iev itime port + | IControl({ictl; itime}) -> + enqueue_command st ictl itime +;; + +(* an event arrives at a switch's ingress: it may be dropped (the link drop + model) or enqueued. Returns the new switch state. *) +let ingress_receive st send_time arrival_time port (ievent : ievent) : state = + if Random.int 100 < st.config.drop_chance + then (log_drop ievent send_time st; st) + else enqueue_ingress st ievent arrival_time port +;; + +(* calculate when an event arrives at an input queue *) +let calc_arrival_time (src_sw : state) (dst_id: location option) desired_delay = + let propagate_delay = + if src_sw.swid = Option.default (-1) dst_id + then + src_sw.config.propagate_delay + + Random.int src_sw.config.random_propagate_range + else 0 + in + gtime src_sw + + max desired_delay src_sw.config.generate_delay + + propagate_delay + + Random.int src_sw.config.random_delay_range +;; + +(* deliver an event generated in an ingress handler at switch [src], writing + the result directly into the live network array. *) +let deliver_ingress (net : network_state) src ingress_destination event_val : unit = + let src_sw = net.(src) in + match ingress_destination with + | Switch dst -> + let send_time = gtime src_sw in + let arrive_time = calc_arrival_time src_sw (Some dst) event_val.edelay in + let ievent = to_internal_event event_val {switch = Some dst; port = 0} arrive_time in + net.(dst) <- ingress_receive net.(dst) send_time arrive_time 0 ievent + | PFlood port -> + let send_time = gtime src_sw in + let ievent = to_internal_event event_val {switch = Some src_sw.swid; port} send_time in + emit_or_log_exit port ievent send_time src_sw + | Port port -> (* generate_port goes through this switch's egress for the port *) + let dst_id_opt = InterpSim.lookup_dst_switch src_sw.config.links (src_sw.swid, port) in + let timestamp = calc_arrival_time src_sw dst_id_opt event_val.edelay in + let ievent = to_internal_event event_val {switch = Some src_sw.swid; port} timestamp in + net.(src) <- enqueue_egress net.(src) ievent timestamp port +;; + +(* deliver an event generated in an egress handler at switch [src]. *) +let deliver_egress (net : network_state) src out_port event_val : unit = + let src_sw = net.(src) in + let dst_opt = InterpSim.lookup_dst src_sw.config.links (src_sw.swid, out_port) in + let time = gtime src_sw in + match dst_opt with + | None -> + let ievent = to_internal_event event_val {switch = Some src_sw.swid; port = out_port} time in + emit_or_log_exit out_port ievent time src_sw + | Some (dst_id, dst_port) -> + let ievent = to_internal_event event_val {switch = Some dst_id; port = dst_port} time in + (* send and arrival times are the same -- 0-latency egress, for now *) + net.(dst_id) <- ingress_receive net.(dst_id) time time dst_port ievent +;; + +(* deliver one mailbox intent from switch [src] into the live network array. *) +let deliver (net : network_state) ~(src : int) (intent : send_intent) : unit = + match intent with + | FromIngress (dest, event_val) -> deliver_ingress net src dest event_val + | FromEgress (out_port, event_val) -> deliver_egress net src out_port event_val +;; + +(* deliver everything switch [swid] has queued in its mailbox, then clear it. + This is the common case: only the switch whose handler just ran has intents, + so the event loop drains that one switch rather than scanning the array. *) +let drain_switch (net : network_state) (swid : int) : unit = + let sw = net.(swid) in + List.iter (deliver net ~src:swid) (List.rev !(sw.outbox)); + sw.outbox := [] +;; + +(* drain every switch's mailbox (a full sweep over the network). *) +let drain (net : network_state) : unit = + Array.iteri (fun swid _ -> drain_switch net swid) net +;; diff --git a/src/lib/midend/interpreter/InterpSwitch.ml b/src/lib/midend/interpreter/InterpSwitch.ml index 7ac02a58..e5566a90 100644 --- a/src/lib/midend/interpreter/InterpSwitch.ml +++ b/src/lib/midend/interpreter/InterpSwitch.ml @@ -1,4 +1,8 @@ -(* Per-switch state in the interpreter. *) +(* Per-switch state in the interpreter, and all operations that touch a single + switch in isolation: its queues, globals, pipeline, mailbox, and printing. + + A switch has no knowledge of how events move between switches -- that is the + job of [InterpNetwork], which depends on this module (never the reverse). *) open CoreSyntax open InterpSyntax open InterpJson @@ -17,11 +21,11 @@ type socket_map = InterpSocket.t IntMap.t module EventQueue = BatHeap.Make (struct (* time, event, port *) type t = ievent - let compare t1 t2 = + let compare t1 t2 = (* compare stime and use squeue_order as a tiebreaker *) if (timestamp t1) = (timestamp t2) then Pervasives.compare t1.squeue_order t2.squeue_order - else + else Pervasives.compare (timestamp t1) (timestamp t2) end) @@ -36,26 +40,36 @@ type stats_counter = ; total_handled : int } -(* topology-related datatypes that should be combined +(* topology-related datatypes that should be combined into a proper "location" type *) -type gress = +type gress = | Ingress | Egress -type ingress_destination = +type ingress_destination = | Port of int | Switch of int | PFlood of int - -type state = - { + +(* An event a switch wants to send, recorded in its mailbox/outbox. The + network drains these and performs delivery -- this separates "generating a + message" (a pure switch operation) from "moving a message" (the fabric's + job). The two variants mirror the two send paths: a generate in an ingress + handler vs. an egress handler. *) +type send_intent = + | FromIngress of ingress_destination * event_val + | FromEgress of int (* out_port *) * event_val + + +type state = + { swid : int ; config : InterpSim.simulation_config ; global_env : ival Env.t ; command_queue : CommandQueue.t ; ingress_queue : EventQueue.t ; egress_queue : EventQueue.t - ; pipeline : Pipeline.t + ; pipeline : Pipeline.t ; exits : (ievent * int option * int) Queue.t ; drops : (ievent * int) Queue.t ; retval : value option ref @@ -66,15 +80,15 @@ type state = ; event_sorts : event_sort Env.t ; event_signatures : (Cid.t * CoreSyntax.ty list) InterpSim.IntMap.t ; global_names : SyntaxGlobalDirectory.dir - ; sws : network_state ref (* a reference to the array of switches in the nw *) + ; outbox : send_intent list ref (* the mailbox: events generated, not yet delivered *) ; global_time : int ref (* shared global time *) } -and network_state = state Array.t - (* values used in interpreter contexts. *) -(* a handler has side effects, so it needs to see the network state *) -and handler = network_state -> int (* switch *) -> int (* port *) -> event_val -> unit +(* a handler runs a switch's event code: its effects are local to that switch + (outgoing events go to the mailbox, the pipeline mutates in place), so it + takes just the switch state -- not the network. *) +and handler = state -> int (* port *) -> event_val -> unit (* code inside the program may mutate switch state (first arg) *) and code = state -> ival list -> ival @@ -105,40 +119,31 @@ type global_fun = ; ty : Syntax.ty } -let gfun_cid (gf : global_fun) : Cid.t = +let gfun_cid (gf : global_fun) : Cid.t = gf.cid ;; let empty_counter = { entries_handled = 0; total_handled = 0 } ;; -(* get copy of another switch's state *) -let lookup_switch self swid = - !(self.sws).(swid) -;; -(* update global state *) -let save_update self = - !(self.sws).(self.swid) <- self -;; - let create ?(softswitch_mode=false) ?(interfaces=None) start_time_ref event_sorts event_signatures config swid = (* in softswitch mode, we take the socket config from the global SwitchConfig map *) - let sockets = + let sockets = if softswitch_mode then - List.fold_left - (fun ifmap (intf:SwitchConfig.interface) -> + List.fold_left + (fun ifmap (intf:SwitchConfig.interface) -> let socket = InterpSocket.create intf.switch intf.port intf.interface in IntMap.add intf.port socket ifmap) IntMap.empty SwitchConfig.cfg.interface else ( - (* in simulation mode, create the sockets from the interfaces map *) + (* in simulation mode, create the sockets from the interfaces map *) let my_intfs = match interfaces with | Some(intfs) -> List.nth intfs swid |> snd | None -> [] in List.fold_left - (fun ifmap (port_id, interface_name) -> + (fun ifmap (port_id, interface_name) -> let socket = InterpSocket.create swid port_id interface_name in IntMap.add port_id socket ifmap) IntMap.empty @@ -162,20 +167,15 @@ let create ?(softswitch_mode=false) ?(interfaces=None) start_time_ref event_sort ; event_sorts ; event_signatures ; global_names = SyntaxGlobalDirectory.empty_dir - ; sws = ref (Array.of_list []) + ; outbox = ref [] ; global_time = start_time_ref (* shared global time *) } ;; -(* set the switch array reference *) -let set_sws (self : state) sws = - {self with sws = ref sws;} -;; - let mem_env cid state = Env.mem cid state.global_env -let lookup k state = +let lookup k state = try Env.find k state.global_env with | Not_found -> error ("missing variable: " ^ Cid.to_string k) @@ -190,159 +190,60 @@ let add_global cid v st = let get_sockets st : InterpSocket.t list = IntMap.bindings st.sockets |> List.map snd ;; - -(* generate an event to stdio or the exit log *) -let log_exit port (ievent:ievent) current_time st = - if InterpConfig.cfg.interactive - then ( - InterpJson.event_exit_to_json - st.swid - (Some(port)) - ievent.sevent - current_time - |> print_endline) - else Queue.push (ievent, Some(port), current_time) st.exits -;; - -let emit_or_log_exit port (ievent:ievent) current_time st = - (* if it is not a port bound to a socket, use - the default send -- which will print to stdio - in the Lucid interpreter. *) - match IntMap.find_opt port st.sockets with - | None -> log_exit port ievent current_time st - | Some(socket) -> InterpSocket.send_event socket ievent.sevent -;; - -let update_counter event_sort st= - let new_counter = match event_sort with - | EPacket -> - {entries_handled = !(st.counter).entries_handled + 1; - total_handled = !(st.counter).total_handled + 1} - | _ -> - {!(st.counter) with total_handled = !(st.counter).total_handled + 1} - in - st.counter := new_counter +(* mailbox: record an event the switch wants to send. The network performs the + actual delivery later, during its drain phase. The outbox is a ref so this + fits the interpreter's in-place style (like retval/counter) and needs no + state threading through interp_statement. *) +let emit (st : state) (intent : send_intent) : unit = + st.outbox := intent :: !(st.outbox) ;; -let n_queued_for_time queued_events stime = +(* how many events are already queued at [stime] -- a stable tiebreaker for + events that arrive at the same time. *) +let n_queued_for_time queued_events stime = List.length (List.filter (fun e -> (timestamp e) = stime) queued_events) ;; -(* push an event to an ingress at a different switch *) -let push_to_ingress st internal_event stime sport = +(* enqueue an event into this switch's ingress queue (pure). *) +let enqueue_ingress st iev stime sport : state = let squeue_order = n_queued_for_time (EventQueue.elems st.ingress_queue) stime in - let internal_event = { - internal_event with - sloc = loc (None,sport); - squeue_order; - stime - } in - let st' = {st with ingress_queue=EventQueue.add internal_event st.ingress_queue} in - save_update st' -;; -(* push an event from an ingress queue to an egress queue. Here, sport is the output port of the switch *) -let push_to_egress st internal_event stime sport = - (* if there's already an event in the queue with the same time, we want to - make sure this one gets popped after it. So we increment the queue_spot. *) - let squeue_order = n_queued_for_time (EventQueue.elems st.egress_queue) stime in - let internal_event = {internal_event with squeue_order; sloc = loc (None,sport); stime} in - (* let internal_event = set_timestamp internal_event stime in *) - let st' = {st with egress_queue=EventQueue.add internal_event st.egress_queue} in - save_update st' -;; - -let push_to_commands st control_val stime = - let st' = {st with command_queue=CommandQueue.add (control_val, stime) st.command_queue} in - save_update st' + let iev = { iev with sloc = loc (None, sport); squeue_order; stime } in + { st with ingress_queue = EventQueue.add iev st.ingress_queue } ;; -(** input loading **) -let load_interp_input st port interp_input = - match interp_input with - | IEvent({iev; itime}) -> - let internal_event = to_internal_event iev {switch=Some st.swid; port} itime in - push_to_ingress st internal_event itime port - | IControl({ictl; itime}) -> - push_to_commands st ictl itime +(* enqueue an event into this switch's egress queue (pure). *) +let enqueue_egress st iev stime sport : state = + let squeue_order = n_queued_for_time (EventQueue.elems st.egress_queue) stime in + let iev = { iev with squeue_order; sloc = loc (None, sport); stime } in + { st with egress_queue = EventQueue.add iev st.egress_queue } ;; - -let gtime self = - !(self.global_time) +(* enqueue a control command into this switch's command queue (pure). *) +let enqueue_command st control_val stime : state = + { st with command_queue = CommandQueue.add (control_val, stime) st.command_queue } ;; -(* event movement functions *) - -let log_drop event current_time st = +(* record a dropped event (mutates the shared drops queue). *) +let log_drop event current_time st = Queue.push (event, current_time) st.drops ;; -let ingress_receive st send_time arrival_time port (ievent : ievent) = -if Random.int 100 < st.config.drop_chance - then (log_drop ievent send_time st) - else (push_to_ingress st ievent arrival_time port) -;; - -let egress_receive st arrival_time port ievent = - push_to_egress st ievent arrival_time port -;; - -(* calculate when an event arrives at an input queue *) -let calc_arrival_time (src_sw : state) (dst_id: location option) desired_delay = - let propagate_delay = - if src_sw.swid = Option.default (-1) dst_id - then - src_sw.config.propagate_delay - + Random.int src_sw.config.random_propagate_range - else 0 +let update_counter event_sort st= + let new_counter = match event_sort with + | EPacket -> + {entries_handled = !(st.counter).entries_handled + 1; + total_handled = !(st.counter).total_handled + 1} + | _ -> + {!(st.counter) with total_handled = !(st.counter).total_handled + 1} in - gtime src_sw - (* src_sw.utils.get_time nst *) - + max desired_delay src_sw.config.generate_delay - + propagate_delay - + Random.int src_sw.config.random_delay_range -;; - -(* val ingress_send : 'nst -> 'nst state -> ingress_destination -> event_val -> unit *) -let ingress_send (src_sw : state) ingress_destination event_val = - match ingress_destination with - | Switch sw -> - let dst_sw = lookup_switch src_sw sw in - let send_time = gtime src_sw in - let arrive_time = calc_arrival_time src_sw (Some dst_sw.swid) event_val.edelay in - let ievent = to_internal_event event_val {switch = Some dst_sw.swid; port = 0} arrive_time in - ingress_receive dst_sw send_time arrive_time 0 ievent - | PFlood port -> - (* print_endline ("PFlood port = " ^ string_of_int port); *) - let send_time = gtime src_sw in - let ievent = to_internal_event event_val {switch = Some src_sw.swid; port = port} send_time in - emit_or_log_exit port ievent send_time src_sw - | Port port -> (* NOTE: generate_port goes through an egress for the port *) - let src_sw = lookup_switch src_sw src_sw.swid in (* need to re-read the source switch to handle multiple generates *) - let dst_id_opt = InterpSim.lookup_dst_switch src_sw.config.links (src_sw.swid, port) in - let timestamp = calc_arrival_time src_sw dst_id_opt (event_val.edelay) in - let ievent = to_internal_event event_val {switch = Some src_sw.swid; port = port} timestamp in - egress_receive src_sw timestamp port ievent + st.counter := new_counter ;; -let egress_send src_sw out_port event_val = - let dst_opt = InterpSim.lookup_dst src_sw.config.links (src_sw.swid, out_port) in - let time = gtime src_sw in - (* let time = src_sw.utils.get_time nst in *) - - match dst_opt with - | None -> - (* if the port is not connected to anything, we can just log the exit *) - let ievent = to_internal_event event_val {switch = Some src_sw.swid; port = out_port} time in - emit_or_log_exit out_port ievent time src_sw - | Some (dst_id, dst_port) -> - let dst_sw = lookup_switch src_sw dst_id in - let ievent = to_internal_event event_val {switch = Some dst_id; port = dst_port} time in - (* note that send and arrival times are currently the same -- we model 0-latency egress, for now *) - ingress_receive dst_sw time time dst_port ievent +let gtime self = + !(self.global_time) ;; -let next_q_ele (fsize, fmin, fdel, ftime) q cur_time = +let next_q_ele (fsize, fmin, fdel, ftime) q cur_time = let sz = fsize q in if sz = 0 then None @@ -357,7 +258,7 @@ let next_q_ele (fsize, fmin, fdel, ftime) q cur_time = ;; let command_queue_fs = (CommandQueue.size, CommandQueue.find_min, CommandQueue.del_min, snd) -let next_command current_time st = +let next_command current_time st = match (next_q_ele command_queue_fs st.command_queue current_time) with | None -> None | Some (q, (control_val, time)) -> Some ({st with command_queue = q;}, control_val, time) @@ -365,24 +266,24 @@ let next_command current_time st = let event_queue_fs = (EventQueue.size, EventQueue.find_min, EventQueue.del_min, timestamp) -let next_ingress_event current_time st = +let next_ingress_event current_time st = match (next_q_ele event_queue_fs st.ingress_queue current_time) with | None -> None | Some (q, (iev)) -> Some ({st with ingress_queue = q;}, iev.sevent, get_port iev, timestamp iev) ;; -let next_egress_event current_time st = +let next_egress_event current_time st = match (next_q_ele event_queue_fs st.egress_queue current_time) with | None -> None | Some (q, (iev)) -> Some ({st with egress_queue = q;}, iev.sevent, get_port iev, timestamp iev) -let next_event current_time st = +let next_event current_time st = let igr_result, egr_result = next_ingress_event current_time st, next_egress_event current_time st in match igr_result, egr_result with | Some (st, event, port, _), None -> Some (st, [event, port, Ingress]) | None, Some (st, event, port, _) -> Some (st, [event, port, Egress]) | Some (st1, event1, port1, t1), Some (st2, event2, port2, t2) -> ( - if (t1 = t2) then + if (t1 = t2) then ( (* taking from both ingress and egress *) let st = {st1 with egress_queue = st2.egress_queue} in @@ -395,23 +296,23 @@ let next_event current_time st = | None, None -> None ;; -let next_time st = +let next_time st = let next_time_ingress = if (EventQueue.size st.ingress_queue = 0) then None else Some (EventQueue.find_min st.ingress_queue |>timestamp) in let next_time_egress = if (EventQueue.size st.egress_queue = 0) then None else Some (EventQueue.find_min st.egress_queue|> timestamp) in let next_time_command = if (CommandQueue.size st.command_queue = 0) then None else Some (CommandQueue.find_min st.command_queue |> snd) in let next_times = List.filter_map (fun x -> x) [next_time_ingress; next_time_egress; next_time_command] in - match next_times with + match next_times with | [] -> None | _ -> Some(List.min next_times) ;; -(* we need a few more egress helpers to keep event arrival times the same +(* we need a few more egress helpers to keep event arrival times the same in the new (9/2023) version of the interpreter with the egress queues. *) -let ready_egress_events current_time st = +let ready_egress_events current_time st = (* pop events out of the queue for current time *) - let rec _all_egress_events st = + let rec _all_egress_events st = match next_egress_event current_time st with - | Some (st, event, port, _) -> + | Some (st, event, port, _) -> let st', rest = _all_egress_events st in st', (event, port, Egress) :: rest | None -> st, [] @@ -419,25 +320,24 @@ let ready_egress_events current_time st = _all_egress_events st ;; -let ready_control_commands st current_time = - (* pop events out of the queue for current time *) - let rec _all_control_commands st = +(* drain the control-command queue for [current_time]; returns the updated + switch state and the commands (the caller writes the state back). *) +let ready_control_commands st current_time = + let rec _all_control_commands st = match next_command current_time st with - | Some (st, event, _) -> + | Some (st, event, _) -> let st', rest = _all_control_commands st in st', event :: rest | None -> st, [] in - let st', control_vals = _all_control_commands st in - save_update st'; - control_vals + _all_control_commands st ;; -let all_egress_events st = +let all_egress_events st = let all_elems = EventQueue.elems st.egress_queue in - let all_elems = List.map - (fun switch_ev -> + let all_elems = List.map + (fun switch_ev -> (switch_ev.sevent, get_port switch_ev, timestamp switch_ev, Egress)) all_elems in @@ -445,7 +345,7 @@ let all_egress_events st = ;; (* printers *) -let queue_sizes st = +let queue_sizes st = Printf.sprintf "ingress: %d, egress: %d" (EventQueue.size st.ingress_queue) (EventQueue.size st.egress_queue) ;; @@ -549,4 +449,4 @@ let exits = show show_exits "Exits" @@ exits_to_string st.exits in let drops = show show_exits "Drops" @@ drops_to_string st.drops in let stats = stats_counter_to_string !(st.counter) in "{\n" ^ vars ^ pipeline ^ queue ^ exits ^ drops ^ stats ^ "\n}" -;; \ No newline at end of file +;; From 506f84317a7dd21d92537c08f31382ab6b1afb52 Mon Sep 17 00:00:00 2001 From: John Sonchack Date: Sun, 7 Jun 2026 17:56:58 -0400 Subject: [PATCH 30/49] interpreter architecture documentation --- docs/interp-arch.md | 32 ++++++++++++++++++++++++++++++++ 1 file changed, 32 insertions(+) create mode 100644 docs/interp-arch.md diff --git a/docs/interp-arch.md b/docs/interp-arch.md new file mode 100644 index 00000000..6db47281 --- /dev/null +++ b/docs/interp-arch.md @@ -0,0 +1,32 @@ +## Interpreter architecture + +The Lucid interpreter is a **discrete-event network simulator** built as four layered modules (in `src/lib/midend/interpreter/`) +### The four layers +- **`InterpSwitch`** — _one switch, in isolation._ Defines `state` (a switch's queues, `global_env`, `pipeline`, `sockets`, handlers, `outbox` mailbox, and `global_time`/`counter`/`retval` refs) and all pure single-switch operations: enqueueing, global lookup/add, the mailbox `emit`, queue draining, printing. It has **no knowledge of other switches**. + +- **`InterpNetwork`** — _the fabric._ Keeps a `network_state = state array` and moves events between switches: `deliver`/`drain`, `calc_arrival_time`, and the external-I/O paths (`emit_or_log_exit` → socket or stdio "exit"). It's the **only** module that does external I/O. Depends on `InterpSwitch`, never the reverse. There is still some legacy code in here, so the naming and internal structure may seem odd. + +- **`InterpCore`** — _per-switch execution._ Interpreting declarations in the program populates the state of all the switches at startup, including the switch's handlers, builtins, and pipeline configuration. Handlers and functions are closures over the switch's state, of which the pipeline, queues, and outbox are mutable. + +- **`Interp`** — _the orchestrator._ The discrete-event loop: advances `global_time`, pops events from switch queues, runs handlers, drains mailboxes, loads input, and exposes `run`/`simulate`. Depends on all of the above. + +Supporting modules: `Pipeline` (match-action stages backing arrays/tables), `InterpSyntax` (internal `ievent`/`loc`/`event_val`), `InterpControl` (control-plane commands), `InterpSocket`/`InterpStdio`/`InterpJson` (I/O + event formats), `InterpSim`/`InterpTopo` (config + topology links), `InterpSpec`/`Preprocess`/`InterpConfig` (setup), `InterpParsing`/`InterpDeparsing` (packet parse/deparse). + +### Core types + +- `code = state -> ival list -> ival` — every callable (builtin methods, user functions, actions, parsers), stored in `ival = V of value | F of (cid option * code)`. +- `handler = state -> int -> event_val -> unit` — event handlers; effects are local to the switch. +- `send_intent = FromIngress of ingress_destination * event_val | FromEgress of int * event_val` — a mailbox entry. + +### Execution model (actor / mailbox) + +1. An event sits in a switch's ingress queue. The orchestrator pops it and calls `execute_event`, which looks up the handler and runs it on that switch's `state`. +2. The handler runs program code (`InterpCore`): it reads/writes globals and mutates the `pipeline` in place, calls builtins/functions/actions (all `code`, dispatched by code block id), and — crucially — `generate` just **appends a `send_intent` to the switch's `outbox`**. It does _not_ deliver. +3. When the handler returns, `Interp` calls `InterpNetwork.drain_switch`, the single **delivery phase**: each queued intent is routed into a peer switch's ingress/egress queue, or out an interface (socket / stdio exit). External I/O happens only here. +4. The loop advances time and processes egress queues (which re-enter `execute_event` for egress handlers / default forwarding) until queues drain or `max_time`. + +This is the actor model: a switch is an actor that emits messages into its mailbox; the fabric is the runtime that moves them. Generation and delivery are cleanly separated phases. + +### Program / builtin model + +The interpreter runs **CoreSyntax** (the midend IR) directly. Stateful globals — `Array`, `Counter`, `Table`, etc. — are **builtin library modules**: each registers a signature pairing types with `code` implementations, dispatched generically by id. Tables in particular are an ordinary `Table.t` builtin type plus `Table.create`/`lookup`/`install` calls (no special AST nodes) — actions are `DActionConstr` declarations, and a `Table.lookup` returning a record is handled by the generic tuple-assign machinery. Global constructors are run in `InterpCore.interp_dglobal` (`Table.create` dispatches to `Tables.create_ctor`; the older array/counter constructors are still inlined there). \ No newline at end of file From be8f05c67c7b9979c7a0c672c6b2ccaa58aaf771 Mon Sep 17 00:00:00 2001 From: John Sonchack Date: Sun, 7 Jun 2026 18:06:53 -0400 Subject: [PATCH 31/49] brief readme for test_reflector.py --- examples/features/lucidvswitch/readme.md | 27 ++++++++++++++++++++++++ 1 file changed, 27 insertions(+) create mode 100644 examples/features/lucidvswitch/readme.md diff --git a/examples/features/lucidvswitch/readme.md b/examples/features/lucidvswitch/readme.md new file mode 100644 index 00000000..0ad142b0 --- /dev/null +++ b/examples/features/lucidvswitch/readme.md @@ -0,0 +1,27 @@ +This directory contains an example of using the Lucid interpreter as a switch operating on real network devices (the `lucidSwitch` binary). +`lucidSwitch` has been tested on macos 14.1 and ubuntu 24.04. + +Please see `test_reflector.py` for a simple usage example. This script: + +1. creates a veth pair (or a "feth" pair on macos); +2. constructs a test pcap +3. spawns the lucid softswitch running "reflector.dpt" in this directory +4. runs the test pcap through the softswitch +5. compares output packets to the original test pcap for validation +6. reports throughput + +Here is an example run on macos: + +```bash +(base) johnsonchack@Johns-MBP-2 lucidvswitch % ./test_reflector.py +[+] Removed old pcap: /Users/johnsonchack/Desktop/gits/lucid/examples/features/lucidvswitch/send.pcap +[+] Removed old pcap: /Users/johnsonchack/Desktop/gits/lucid/examples/features/lucidvswitch/recv.pcap +[+] Wrote 10000 packets to /Users/johnsonchack/Desktop/gits/lucid/examples/features/lucidvswitch/send.pcap +[+] feth0 and feth1 are up +[+] Started tcpdump on feth1, waiting for switch to initialize... +[+] Switch initialized +[+] Sent 10000 packets on feth1 +[*] Sent: 10000 packets, Received: 10000 packets +[+] PASS: packet counts match +[*] Throughput: 251743 pps, 2062.49 Mbps (over 0.0397s) +``` From 8e0c75f77bb54cd2f264e6390b60ecdceeac726d Mon Sep 17 00:00:00 2001 From: John Sonchack Date: Fri, 12 Jun 2026 08:28:12 -0400 Subject: [PATCH 32/49] simpler dev docker --- docker/dev/Dockerfile | 48 ++++++++++++ docker/dev/dockercmd.sh | 161 ++++++++++++++++++++++++++++++++++++++++ 2 files changed, 209 insertions(+) create mode 100644 docker/dev/Dockerfile create mode 100755 docker/dev/dockercmd.sh diff --git a/docker/dev/Dockerfile b/docker/dev/Dockerfile new file mode 100644 index 00000000..4c5d2f3c --- /dev/null +++ b/docker/dev/Dockerfile @@ -0,0 +1,48 @@ +FROM ubuntu:24.04 + +ENV DEBIAN_FRONTEND=noninteractive + +# ---- system setup ---- + +# 1. base packages +RUN apt-get update && apt-get install -y \ + sudo ca-certificates curl git \ + && rm -rf /var/lib/apt/lists/* + +RUN apt-get update && apt-get install -y \ + build-essential libpython3-dev tcpdump tcpreplay python3-scapy opam \ + pkg-config libgmp-dev m4 zlib1g-dev \ + iproute2 net-tools iputils-ping iptables \ + vim nano less procps \ + && rm -rf /var/lib/apt/lists/* + +# 2. passwordless sudo +RUN echo "ubuntu ALL=(ALL) NOPASSWD:ALL" > /etc/sudoers.d/ubuntu \ + && chmod 0440 /etc/sudoers.d/ubuntu + +# ---- user setup ---- +USER ubuntu +WORKDIR /home/ubuntu + +# 3. opam setup + switch +RUN opam init -y --auto-setup --disable-sandboxing \ + && opam switch create 4.12.0 + +# 4. opam env setup covering bash + entrypoint +RUN echo 'test -r ~/.opam/opam-init/init.sh && . ~/.opam/opam-init/init.sh' >> ~/.bashrc +RUN printf '#!/bin/bash\neval "$(opam env)"\nexec "$@"\n' > /home/ubuntu/entrypoint.sh \ + && chmod +x /home/ubuntu/entrypoint.sh +ENTRYPOINT ["/home/ubuntu/entrypoint.sh"] + +# 5. lucid opam deps (the long list — changes when deps change) +RUN opam install -y --confirm-level=unsafe-yes \ + odoc integers "batteries=3.5.1" ounit ANSITerminal menhir \ + ppx_deriving ppx_string_interpolation zarith visitors fileutils \ + ppx_import "core<=v0.14.1" "dune=3.15.3" ocamlgraph angstrom \ + "yojson=2.2.2" pyml pprint z3 "pp<=1.2.0" "cstruct=6.2.0" "ppx_cstruct=6.2.0" + +# 6. (optional) install claude +RUN curl -fsSL https://claude.ai/install.sh | bash +ENV PATH="/home/ubuntu/.local/bin:${PATH}" + +CMD ["bash"] diff --git a/docker/dev/dockercmd.sh b/docker/dev/dockercmd.sh new file mode 100755 index 00000000..d3041157 --- /dev/null +++ b/docker/dev/dockercmd.sh @@ -0,0 +1,161 @@ +#!/usr/bin/env bash +# Helper for the Lucid dev-environment container. +set -euo pipefail + +SCRIPT_DIR="$(cd "$(dirname "${BASH_SOURCE[0]}")" && pwd)" +DOCKERFILE="$SCRIPT_DIR/Dockerfile" +PROG="$(basename "$0")" + +IMAGE="lucid-dev" +REMOTE="ghcr.io/princetonuniversity/$IMAGE" +TAG="${TAG:-latest}" # tag to pull/publish +# Build platform, optional (defaults to host-native), e.g. +# PLATFORM=linux/amd64 ./dockercmd.sh build +PLATFORM="${PLATFORM:-}" +HOME_DIR="/home/ubuntu" +CONTAINER="$IMAGE" # name of the persistent background container + +usage() { + cat <&2; exit 1; }; } + +cmd_enter() { + # --cap-add=NET_ADMIN lets the interpreter create/configure veth interfaces. + local run_args=(--rm -it --cap-add=NET_ADMIN) + + local path="${1:-}" + if [[ -n "$path" ]]; then + require_path "$path" + local abs; abs="$(abspath "$path")" + run_args+=(-v "$abs:$HOME_DIR/$(basename "$abs")") + fi + + docker run "${run_args[@]}" "$IMAGE" +} + +# True if the named container exists (any state). +container_exists() { docker ps -a --format '{{.Names}}' | grep -qx "$CONTAINER"; } +# True if the named container is currently running. +container_running() { docker ps --format '{{.Names}}' | grep -qx "$CONTAINER"; } + +cmd_up() { + if container_running; then + echo "container '$CONTAINER' is already running. Use '$PROG exec' for a shell." >&2 + return 0 + fi + # Drop a stale stopped container so the new mount/workdir take effect. + container_exists && docker rm -f "$CONTAINER" >/dev/null + + local run_args=(-d --name "$CONTAINER" --cap-add=NET_ADMIN) + local workdir="$HOME_DIR" + local path="${1:-}" + if [[ -n "$path" ]]; then + require_path "$path" + local abs; abs="$(abspath "$path")" + workdir="$HOME_DIR/$(basename "$abs")" + run_args+=(-v "$abs:$workdir") + fi + run_args+=(-w "$workdir") + + # sleep infinity keeps the container alive for exec/IDE attach. + docker run "${run_args[@]}" "$IMAGE" sleep infinity >/dev/null + echo "container '$CONTAINER' is up (workdir: $workdir)." + echo "Attach your IDE (VSCode: Dev Containers > Attach to Running Container)" + echo "or run '$PROG exec' for a shell." +} + +cmd_exec() { + container_running || { echo "error: container '$CONTAINER' is not running; start it with '$PROG up [PATH]'." >&2; exit 1; } + # bash (interactive) sources ~/.bashrc, which loads the opam env. + if [[ $# -gt 0 ]]; then + docker exec -it "$CONTAINER" "$@" + else + docker exec -it "$CONTAINER" bash + fi +} + +cmd_down() { + if container_exists; then + docker rm -f "$CONTAINER" >/dev/null + echo "container '$CONTAINER' stopped and removed." + else + echo "container '$CONTAINER' is not running." + fi +} + +cmd_pull() { + # Fetch the prebuilt image (Docker picks your arch) and tag it for local use, + # so `enter` behaves the same whether you built or pulled. + docker pull "$REMOTE:$TAG" + docker tag "$REMOTE:$TAG" "$IMAGE" +} + +cmd_publish() { + # Multi-arch build + push. Requires `docker login ghcr.io` first. Uses a + # buildx builder with the docker-container driver (created here if missing). + local platforms="${PLATFORMS:-linux/amd64,linux/arm64}" + docker buildx inspect lucid-builder >/dev/null 2>&1 \ + || docker buildx create --name lucid-builder --driver docker-container >/dev/null + docker buildx build --builder lucid-builder \ + --platform "$platforms" \ + -f "$DOCKERFILE" -t "$REMOTE:$TAG" --push "$SCRIPT_DIR" +} + +main() { + local cmd="${1:-}" + [[ $# -gt 0 ]] && shift || true + case "$cmd" in + build) cmd_build "$@" ;; + enter) cmd_enter "$@" ;; + up) cmd_up "$@" ;; + exec) cmd_exec "$@" ;; + down) cmd_down "$@" ;; + pull) cmd_pull "$@" ;; + publish) cmd_publish "$@" ;; + ""|-h|--help|help) usage 0 ;; + *) echo "error: unknown command: $cmd" >&2; usage 1 ;; + esac +} + +main "$@" From a8ddc30efc763d745a90a312bc3d5b7163992cec Mon Sep 17 00:00:00 2001 From: John Sonchack Date: Fri, 12 Jun 2026 08:54:03 -0400 Subject: [PATCH 33/49] devcontainer, updated dockerfile --- .devcontainer/devcontainer.json | 21 +++++++++++++++++++++ docker/dev/Dockerfile | 6 ++++++ 2 files changed, 27 insertions(+) create mode 100644 .devcontainer/devcontainer.json diff --git a/.devcontainer/devcontainer.json b/.devcontainer/devcontainer.json new file mode 100644 index 00000000..b19413ea --- /dev/null +++ b/.devcontainer/devcontainer.json @@ -0,0 +1,21 @@ +// Dev Container config for the Lucid dev environment. +// Reuses docker/dev/Dockerfile so the image is defined in one place +// (same image dockercmd.sh builds). Paths here are relative to this file. +{ + "name": "lucid-dev", + "build": { + "dockerfile": "../docker/dev/Dockerfile", + "context": "../docker/dev" + }, + // Mount the repo where the toolchain/scripts expect it, and open there. + "workspaceFolder": "/home/ubuntu/lucid", + "workspaceMount": "source=${localWorkspaceFolder},target=/home/ubuntu/lucid,type=bind", + "remoteUser": "ubuntu", + // Lets the interpreter create/configure veth interfaces (matches dockercmd.sh). + "runArgs": ["--cap-add=NET_ADMIN"], + "customizations": { + "vscode": { + "extensions": ["ocamllabs.ocaml-platform"] + } + } +} diff --git a/docker/dev/Dockerfile b/docker/dev/Dockerfile index 4c5d2f3c..91f468eb 100644 --- a/docker/dev/Dockerfile +++ b/docker/dev/Dockerfile @@ -41,6 +41,12 @@ RUN opam install -y --confirm-level=unsafe-yes \ ppx_import "core<=v0.14.1" "dune=3.15.3" ocamlgraph angstrom \ "yojson=2.2.2" pyml pprint z3 "pp<=1.2.0" "cstruct=6.2.0" "ppx_cstruct=6.2.0" +# 5b. editor tooling: LSP + formatter (ocamlformat pinned to match .ocamlformat). +# Pre-installing these stops the VSCode OCaml Platform extension from trying to +# install them into the switch on first attach. +RUN opam install -y --confirm-level=unsafe-yes \ + ocaml-lsp-server "ocamlformat=0.19.0" + # 6. (optional) install claude RUN curl -fsSL https://claude.ai/install.sh | bash ENV PATH="/home/ubuntu/.local/bin:${PATH}" From 163bdd8aef53a66a7595e506e518bffb8eb74948 Mon Sep 17 00:00:00 2001 From: John Sonchack Date: Thu, 6 Aug 2026 12:32:45 -0400 Subject: [PATCH 34/49] include LD_LIB_PATH in tof asic sim runner --- scripts/tofino/p4tapp.sh | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/scripts/tofino/p4tapp.sh b/scripts/tofino/p4tapp.sh index 51fd6608..9cdacf14 100755 --- a/scripts/tofino/p4tapp.sh +++ b/scripts/tofino/p4tapp.sh @@ -271,7 +271,8 @@ function cd_launch_and_wait() { function start_asic_sim() { local P4_CONF=$1 - local SIMULATOR="sudo $SDE_INSTALL/bin/tofino-model" + # local SIMULATOR="sudo $SDE_INSTALL/bin/tofino-model" + local SIMULATOR="sudo env LD_LIBRARY_PATH=/usr/local/lib:$SDE_INSTALL/lib:$LD_LIBRARY_PATH $SDE_INSTALL/bin/tofino-model" # setup veths for simulator create_veth_pairs From e2396b0e6c6bc7b10faf283dccbd0df345927862 Mon Sep 17 00:00:00 2001 From: John Sonchack Date: Fri, 7 Aug 2026 08:38:08 -0400 Subject: [PATCH 35/49] ports arg overrides default --- src/lib/config/TofinoConfig.ml | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/src/lib/config/TofinoConfig.ml b/src/lib/config/TofinoConfig.ml index 68e2a5a6..94c6a614 100644 --- a/src/lib/config/TofinoConfig.ml +++ b/src/lib/config/TofinoConfig.ml @@ -35,6 +35,16 @@ let speclist = let set_profile_cmd (s : string) = cfg.profile_cmd <- Some s in let set_ctl_fn (s : string) = cfg.ctl_fn <- Some s in let set_serverlib () = cfg.serverlib <- true in + (* the first --port clears the default port list, so that the user-provided + ports replace the defaults rather than adding to them *) + let user_set_ports = ref false in + let add_port (id, speed) = + if not !user_set_ports + then ( + cfg.ports <- []; + user_set_ports := true); + cfg.ports <- cfg.ports @ [id, speed] + in [ "-o", Arg.String set_builddir, "Output build directory." ; ( "--ports" , Arg.String set_portspec @@ -47,8 +57,8 @@ let speclist = | [id; speed] -> (int_of_string id, int_of_string speed) | _ -> failwith "Invalid port specification" in - cfg.ports <- (id, speed) :: cfg.ports) - , "--port @ Specify a port to be brought up automatically in the generated control plane. Can be used multiple times." ) + add_port (id, speed)) + , "--port @ Specify a port to be brought up automatically in the generated control plane. Can be used multiple times. Using this flag at all replaces the default port list." ) ; ( "--recirc_port" , Arg.Int (fun i -> cfg.recirc_port <- i) , "Port id for recirculation" ) From db83296d59117b5ce2f02fb18538d901a03d6e41 Mon Sep 17 00:00:00 2001 From: John Sonchack Date: Fri, 7 Aug 2026 10:01:06 -0400 Subject: [PATCH 36/49] simple wire example --- examples/utils/wire/Makefile | 12 ++++++++++++ examples/utils/wire/wire.dpt | 16 ++++++++++++++++ 2 files changed, 28 insertions(+) create mode 100644 examples/utils/wire/Makefile create mode 100644 examples/utils/wire/wire.dpt diff --git a/examples/utils/wire/Makefile b/examples/utils/wire/Makefile new file mode 100644 index 00000000..7ad21e03 --- /dev/null +++ b/examples/utils/wire/Makefile @@ -0,0 +1,12 @@ + +check: + ../../../dpt wire.dpt + +compile: + ../../../dptc wire.dpt -o wire_build --port 4@100 --port 44@25 + +assemble: + cd wire_build && make + +run: + cd wire_build && sudo -E make hw diff --git a/examples/utils/wire/wire.dpt b/examples/utils/wire/wire.dpt new file mode 100644 index 00000000..5b78cc90 --- /dev/null +++ b/examples/utils/wire/wire.dpt @@ -0,0 +1,16 @@ +// simple wire between two hard coded ports, for tofino (9 bit port ids) + +const int<9> p1 = 44; +const int<9> p2 = 4; + +packet event eth(int<48> dmac, int<48> smac, int<16> ety) { + skip; + // match ingress_port with + // | p1 -> { + // generate_port(p2, this); + // } + // | p2 -> { + // generate_port(p1, this); + // } + // | _ -> { skip; } +} \ No newline at end of file From a06d80460f982a8f46a47d133578000a52bacfb8 Mon Sep 17 00:00:00 2001 From: John Sonchack Date: Fri, 7 Aug 2026 10:17:27 -0400 Subject: [PATCH 37/49] script to install minimal dependencies with opam --- scripts/utils/min-install-deps.sh | 8 ++++++++ 1 file changed, 8 insertions(+) create mode 100644 scripts/utils/min-install-deps.sh diff --git a/scripts/utils/min-install-deps.sh b/scripts/utils/min-install-deps.sh new file mode 100644 index 00000000..31e1deb3 --- /dev/null +++ b/scripts/utils/min-install-deps.sh @@ -0,0 +1,8 @@ +sudo apt install -y opam +opam init -y --auto-setup +eval $(opam env --switch=default) +opam switch create 4.12.0 +eval $(opam env --switch=4.12.0) +opam switch 4.12.0 +opam install -y z3.4.13.0 +opam install -y --confirm-level=unsafe-yes --deps-only . From 181d3946f34edee68c7c871b34ff52e66836a67d Mon Sep 17 00:00:00 2001 From: John Sonchack Date: Fri, 7 Aug 2026 11:14:38 -0400 Subject: [PATCH 38/49] 100g gets fec --- examples/utils/wire/Makefile | 5 ++++- examples/utils/wire/wire.dpt | 19 +++++++++---------- scripts/tofino/controldriver.py | 5 ++++- scripts/utils/min-install-deps.sh | 0 4 files changed, 17 insertions(+), 12 deletions(-) mode change 100644 => 100755 scripts/utils/min-install-deps.sh diff --git a/examples/utils/wire/Makefile b/examples/utils/wire/Makefile index 7ad21e03..2f578893 100644 --- a/examples/utils/wire/Makefile +++ b/examples/utils/wire/Makefile @@ -3,10 +3,13 @@ check: ../../../dpt wire.dpt compile: - ../../../dptc wire.dpt -o wire_build --port 4@100 --port 44@25 + ../../../dptc wire.dpt -o wire_build --port 28@100 --port 4@100 assemble: cd wire_build && make run: cd wire_build && sudo -E make hw + +run-nohup: + nohup $(MAKE) run > wire_run.log 2>&1 & \ No newline at end of file diff --git a/examples/utils/wire/wire.dpt b/examples/utils/wire/wire.dpt index 5b78cc90..8cbc32bc 100644 --- a/examples/utils/wire/wire.dpt +++ b/examples/utils/wire/wire.dpt @@ -1,16 +1,15 @@ // simple wire between two hard coded ports, for tofino (9 bit port ids) -const int<9> p1 = 44; +const int<9> p1 = 28; const int<9> p2 = 4; packet event eth(int<48> dmac, int<48> smac, int<16> ety) { - skip; - // match ingress_port with - // | p1 -> { - // generate_port(p2, this); - // } - // | p2 -> { - // generate_port(p1, this); - // } - // | _ -> { skip; } + match ingress_port with + | p1 -> { + generate_port(p2, this); + } + | p2 -> { + generate_port(p1, this); + } + | _ -> { skip; } } \ No newline at end of file diff --git a/scripts/tofino/controldriver.py b/scripts/tofino/controldriver.py index 6a48f2ef..e9645404 100644 --- a/scripts/tofino/controldriver.py +++ b/scripts/tofino/controldriver.py @@ -165,7 +165,10 @@ def port_up(self, dpid, speed): port_table = self.tables['$PORT'] keys = list(port_table.key_fields.keys()) port_cfg_key = {'$DEV_PORT':dpid} - port_cfg_acn = {'$SPEED':speed, '$FEC':"BF_FEC_TYP_NONE", '$PORT_ENABLE':True} + if (speed == "BF_SPEED_100G"): + port_cfg_acn = {'$SPEED':speed, '$FEC':"BF_FEC_TYP_RS", '$PORT_ENABLE':True} + else: + port_cfg_acn = {'$SPEED':speed, '$FEC':"BF_FEC_TYP_NONE", '$PORT_ENABLE':True} port_table.add_entry(port_cfg_key, None, port_cfg_acn) ### pktgen helpers diff --git a/scripts/utils/min-install-deps.sh b/scripts/utils/min-install-deps.sh old mode 100644 new mode 100755 From d6fc10da5316a8d68a5e5b1b8c654bcb2f6e70b2 Mon Sep 17 00:00:00 2001 From: John Sonchack Date: Tue, 11 Aug 2026 13:31:39 -0400 Subject: [PATCH 39/49] docker updates --- docker/dev/Dockerfile | 22 +++++++++++++++++++++- docker/dev/dockercmd.sh | 32 +++++++++++++++++++++++++------- 2 files changed, 46 insertions(+), 8 deletions(-) diff --git a/docker/dev/Dockerfile b/docker/dev/Dockerfile index 91f468eb..9515b756 100644 --- a/docker/dev/Dockerfile +++ b/docker/dev/Dockerfile @@ -14,12 +14,32 @@ RUN apt-get update && apt-get install -y \ pkg-config libgmp-dev m4 zlib1g-dev \ iproute2 net-tools iputils-ping iptables \ vim nano less procps \ + meson ninja-build python3-pyelftools libnuma-dev libpcap-dev libelf-dev \ + wget xz-utils \ && rm -rf /var/lib/apt/lists/* # 2. passwordless sudo RUN echo "ubuntu ALL=(ALL) NOPASSWD:ALL" > /etc/sudoers.d/ubuntu \ && chmod 0440 /etc/sudoers.d/ubuntu +# ---- DPDK 24.03 (dev only: net/pcap + net/af_packet PMDs) ---- +# To build the full driver set instead, drop the `-Denable_drivers=...` flag +# ISA is set to (SSE4.2, no AVX) for Rosetta/qemu on macos arm64 +# For better performance on real x86 hosts, remove the ISA_OPT override +ARG TARGETARCH +RUN wget -q https://fast.dpdk.org/rel/dpdk-24.03.tar.xz \ + && tar -xJf dpdk-24.03.tar.xz && rm dpdk-24.03.tar.xz \ + && cd dpdk-24.03 \ + && case "$TARGETARCH" in \ + amd64) ISA_OPT="-Dcpu_instruction_set=westmere" ;; \ + *) ISA_OPT="" ;; \ + esac \ + && meson setup build -Denable_drivers=net/pcap,net/af_packet -Dtests=false $ISA_OPT \ + && ninja -C build \ + && meson install -C build \ + && ldconfig \ + && cd .. && rm -rf dpdk-24.03 + # ---- user setup ---- USER ubuntu WORKDIR /home/ubuntu @@ -51,4 +71,4 @@ RUN opam install -y --confirm-level=unsafe-yes \ RUN curl -fsSL https://claude.ai/install.sh | bash ENV PATH="/home/ubuntu/.local/bin:${PATH}" -CMD ["bash"] +CMD ["bash"] \ No newline at end of file diff --git a/docker/dev/dockercmd.sh b/docker/dev/dockercmd.sh index d3041157..eea62403 100755 --- a/docker/dev/dockercmd.sh +++ b/docker/dev/dockercmd.sh @@ -27,6 +27,8 @@ Usage: $PROG up [PATH] Start the named '$CONTAINER' container in the background (for IDE attach). PATH is mounted as with 'enter'. Idempotent. + $PROG ls Print the name(s) of running dev containers (from + 'up' or 'enter') -- the identifier to pass to 'exec'. $PROG exec [CMD...] Run a shell (or CMD) in the background container. $PROG down Stop and remove the background container. $PROG pull Pull the prebuilt image from the registry. @@ -87,24 +89,39 @@ cmd_up() { # Drop a stale stopped container so the new mount/workdir take effect. container_exists && docker rm -f "$CONTAINER" >/dev/null - local run_args=(-d --name "$CONTAINER" --cap-add=NET_ADMIN) - local workdir="$HOME_DIR" + # Start the shell in the home dir (-w $HOME_DIR), matching `enter`; the mount + # lands at $HOME_DIR/ as a subdir. (Previously -w was the mounted dir, so + # `exec` dropped you *inside* the mount -- inconsistent with `enter`.) + local run_args=(-d --name "$CONTAINER" --cap-add=NET_ADMIN -w "$HOME_DIR") + local mount_at="$HOME_DIR" local path="${1:-}" if [[ -n "$path" ]]; then require_path "$path" local abs; abs="$(abspath "$path")" - workdir="$HOME_DIR/$(basename "$abs")" - run_args+=(-v "$abs:$workdir") + mount_at="$HOME_DIR/$(basename "$abs")" + run_args+=(-v "$abs:$mount_at") fi - run_args+=(-w "$workdir") # sleep infinity keeps the container alive for exec/IDE attach. docker run "${run_args[@]}" "$IMAGE" sleep infinity >/dev/null - echo "container '$CONTAINER' is up (workdir: $workdir)." + echo "container '$CONTAINER' is up (mounted at: $mount_at)." echo "Attach your IDE (VSCode: Dev Containers > Attach to Running Container)" echo "or run '$PROG exec' for a shell." } +cmd_ls() { + # Print the name(s) of running containers from the '$IMAGE' image -- whether + # started by `up` (name '$CONTAINER') or a throwaway `enter` (random name). + # The NAME is the identifier to pass to `docker exec` (or hand to tooling). + local names + names="$(docker ps --filter ancestor="$IMAGE" --format '{{.Names}}')" + if [[ -z "$names" ]]; then + echo "no running '$IMAGE' container. Start one with '$PROG up [PATH]' or '$PROG enter [PATH]'." >&2 + return 1 + fi + echo "$names" +} + cmd_exec() { container_running || { echo "error: container '$CONTAINER' is not running; start it with '$PROG up [PATH]'." >&2; exit 1; } # bash (interactive) sources ~/.bashrc, which loads the opam env. @@ -149,6 +166,7 @@ main() { build) cmd_build "$@" ;; enter) cmd_enter "$@" ;; up) cmd_up "$@" ;; + ls) cmd_ls "$@" ;; exec) cmd_exec "$@" ;; down) cmd_down "$@" ;; pull) cmd_pull "$@" ;; @@ -158,4 +176,4 @@ main() { esac } -main "$@" +main "$@" \ No newline at end of file From d47d82c42b038b24bade7f01f4a2a926a68822eb Mon Sep 17 00:00:00 2001 From: John Sonchack Date: Tue, 11 Aug 2026 13:34:43 -0400 Subject: [PATCH 40/49] docker updates --- docker/dev/dockercmd.sh | 19 +++++++------------ 1 file changed, 7 insertions(+), 12 deletions(-) diff --git a/docker/dev/dockercmd.sh b/docker/dev/dockercmd.sh index eea62403..b17e6e0c 100755 --- a/docker/dev/dockercmd.sh +++ b/docker/dev/dockercmd.sh @@ -86,12 +86,10 @@ cmd_up() { echo "container '$CONTAINER' is already running. Use '$PROG exec' for a shell." >&2 return 0 fi - # Drop a stale stopped container so the new mount/workdir take effect. + # Drop a stale stopped container so the new mount/workdir take effect container_exists && docker rm -f "$CONTAINER" >/dev/null - # Start the shell in the home dir (-w $HOME_DIR), matching `enter`; the mount - # lands at $HOME_DIR/ as a subdir. (Previously -w was the mounted dir, so - # `exec` dropped you *inside* the mount -- inconsistent with `enter`.) + # Start the shell in the home dir (-w $HOME_DIR) local run_args=(-d --name "$CONTAINER" --cap-add=NET_ADMIN -w "$HOME_DIR") local mount_at="$HOME_DIR" local path="${1:-}" @@ -110,9 +108,7 @@ cmd_up() { } cmd_ls() { - # Print the name(s) of running containers from the '$IMAGE' image -- whether - # started by `up` (name '$CONTAINER') or a throwaway `enter` (random name). - # The NAME is the identifier to pass to `docker exec` (or hand to tooling). + # Print the name(s) of running containers from the '$IMAGE' image local names names="$(docker ps --filter ancestor="$IMAGE" --format '{{.Names}}')" if [[ -z "$names" ]]; then @@ -124,7 +120,7 @@ cmd_ls() { cmd_exec() { container_running || { echo "error: container '$CONTAINER' is not running; start it with '$PROG up [PATH]'." >&2; exit 1; } - # bash (interactive) sources ~/.bashrc, which loads the opam env. + # bash (interactive) sources ~/.bashrc, to load opam env if [[ $# -gt 0 ]]; then docker exec -it "$CONTAINER" "$@" else @@ -142,15 +138,14 @@ cmd_down() { } cmd_pull() { - # Fetch the prebuilt image (Docker picks your arch) and tag it for local use, - # so `enter` behaves the same whether you built or pulled. + # Fetch the prebuilt image (Docker picks your arch) and tag it for local use docker pull "$REMOTE:$TAG" docker tag "$REMOTE:$TAG" "$IMAGE" } cmd_publish() { - # Multi-arch build + push. Requires `docker login ghcr.io` first. Uses a - # buildx builder with the docker-container driver (created here if missing). + # Multi-arch build + push. Requires `docker login ghcr.io` first + # Uses a buildx builder with the docker-container driver (created here if missing) local platforms="${PLATFORMS:-linux/amd64,linux/arm64}" docker buildx inspect lucid-builder >/dev/null 2>&1 \ || docker buildx create --name lucid-builder --driver docker-container >/dev/null From 835f0b39a58654831c11fe6c7e271d8bce9511eb Mon Sep 17 00:00:00 2001 From: John Sonchack Date: Tue, 11 Aug 2026 14:05:27 -0400 Subject: [PATCH 41/49] fix quadratic bit repr conversion --- .../features/lucidvswitch/test_reflector.py | 9 ++-- src/lib/frontend/datastructures/BitString.ml | 44 ++++++++++++++++--- 2 files changed, 42 insertions(+), 11 deletions(-) diff --git a/examples/features/lucidvswitch/test_reflector.py b/examples/features/lucidvswitch/test_reflector.py index 2da3bda2..d660087a 100755 --- a/examples/features/lucidvswitch/test_reflector.py +++ b/examples/features/lucidvswitch/test_reflector.py @@ -22,8 +22,9 @@ RECV_PCAP = os.path.join(SCRIPT_DIR, "recv.pcap") SEND_IFACE = "feth1" SWITCH_IFACE = "feth0" -NUM_PACKETS = 10000 -REPLAY_PPS = 250000 +NUM_PACKETS = 1000 +REPLAY_PPS = 5000 +TIMEOUT = 2 def repo_root(): return subprocess.check_output( @@ -66,7 +67,7 @@ def ensure_veths(): def run_test(): """Run the main test: start tcpdump, start switch, send packets.""" tcpdump = subprocess.Popen( - ["sudo", "tcpdump", "-i", SEND_IFACE, "-w", RECV_PCAP, "-c", str(NUM_PACKETS), "-B", "4096"], + ["sudo", "tcpdump", "-i", SEND_IFACE, "-w", RECV_PCAP, "-c", str(NUM_PACKETS), "-B", "4096", "-Q", "in"], stdout=subprocess.DEVNULL, stderr=subprocess.DEVNULL, ) time.sleep(1) # let tcpdump settle @@ -100,7 +101,7 @@ def run_test(): # Wait for tcpdump to finish (it exits after -c packets) with a timeout try: - tcpdump.wait(timeout=30) + tcpdump.wait(timeout=TIMEOUT) except subprocess.TimeoutExpired: tcpdump.terminate() tcpdump.wait() diff --git a/src/lib/frontend/datastructures/BitString.ml b/src/lib/frontend/datastructures/BitString.ml index 053e3b9c..7ee3c51d 100644 --- a/src/lib/frontend/datastructures/BitString.ml +++ b/src/lib/frontend/datastructures/BitString.ml @@ -25,13 +25,43 @@ let char_to_bits c = ;; (* take a string of hex numbers with no delimiters and convert it into a bit list. *) -let rec hexstr_to_bits (str:String.t) : bits = - match str with - | "" -> [] - | _ -> - let c = String.get str 0 in - let remaining_str = String.sub str 1 ((String.length str)-1) in - (char_to_bits c) @ (hexstr_to_bits remaining_str) +let hexstr_to_bits (str : string) : bits = + let acc = ref [] in + for i = String.length str - 1 downto 0 do + acc := char_to_bits str.[i] @ !acc + done; + !acc +;; + +let bits_to_hexstr (bits : bits) : string = + let buf = Buffer.create 256 in + let rec convert bits = + match bits with + | [] -> Buffer.contents buf + | b1 :: b2 :: b3 :: b4 :: bs -> + let c = match (b1, b2, b3, b4) with + | (B0,B0,B0,B0) -> '0' + | (B0,B0,B0,B1) -> '1' + | (B0,B0,B1,B0) -> '2' + | (B0,B0,B1,B1) -> '3' + | (B0,B1,B0,B0) -> '4' + | (B0,B1,B0,B1) -> '5' + | (B0,B1,B1,B0) -> '6' + | (B0,B1,B1,B1) -> '7' + | (B1,B0,B0,B0) -> '8' + | (B1,B0,B0,B1) -> '9' + | (B1,B0,B1,B0) -> 'a' + | (B1,B0,B1,B1) -> 'b' + | (B1,B1,B0,B0) -> 'c' + | (B1,B1,B0,B1) -> 'd' + | (B1,B1,B1,B0) -> 'e' + | (B1,B1,B1,B1) -> 'f' + in + Buffer.add_char buf c; + convert bs + | _ -> failwith "[bits_to_hexstr] bits must be a multiple of 4" + in + convert bits ;; let rec bits_to_hexstr (bits:bits) : string = From b40ac92588a454a879ac8e1688d07dc61e8dfb95 Mon Sep 17 00:00:00 2001 From: John Sonchack Date: Tue, 11 Aug 2026 15:39:35 -0400 Subject: [PATCH 42/49] major interpreter performance improvements, bit to byte internal repr of packets --- .../features/lucidvswitch/test_reflector.py | 4 +- src/bin/lucidSwitch.ml | 1 + src/lib/backend/c/translations/CCoreToCore.ml | 7 +- src/lib/backend/c/translations/CoreToCCore.ml | 6 +- .../backend/tofino/tofinocore/TofinoCore.ml | 1 - src/lib/frontend/datastructures/BitString.ml | 266 +++++++++--------- src/lib/frontend/datastructures/BitString.mli | 22 +- src/lib/frontend/modules/Tables.ml | 4 +- src/lib/midend/CoreSyntax.ml | 3 +- src/lib/midend/interpreter/InterpDeparsing.ml | 4 +- src/lib/midend/interpreter/InterpJson.ml | 2 +- src/lib/midend/interpreter/InterpParsing.ml | 4 +- src/lib/midend/interpreter/InterpSocket.ml | 5 +- src/lib/midend/interpreter/InterpSwitch.ml | 12 +- vendor/rawlink/lib/rawlink.ml | 6 +- vendor/rawlink/lib/rawlink_lowlevel.ml | 1 + vendor/rawlink/lib/rawlink_stubs.c | 26 +- 17 files changed, 192 insertions(+), 182 deletions(-) diff --git a/examples/features/lucidvswitch/test_reflector.py b/examples/features/lucidvswitch/test_reflector.py index d660087a..bab52140 100755 --- a/examples/features/lucidvswitch/test_reflector.py +++ b/examples/features/lucidvswitch/test_reflector.py @@ -22,8 +22,8 @@ RECV_PCAP = os.path.join(SCRIPT_DIR, "recv.pcap") SEND_IFACE = "feth1" SWITCH_IFACE = "feth0" -NUM_PACKETS = 1000 -REPLAY_PPS = 5000 +NUM_PACKETS = 10000 +REPLAY_PPS = 250000 TIMEOUT = 2 def repo_root(): diff --git a/src/bin/lucidSwitch.ml b/src/bin/lucidSwitch.ml index b6b844b7..b0b93008 100644 --- a/src/bin/lucidSwitch.ml +++ b/src/bin/lucidSwitch.ml @@ -4,6 +4,7 @@ open Batteries open Dpt let main () = + Gc.set { (Gc.get ()) with Gc.minor_heap_size = 32 * 1024 * 1024 (* words *) }; Config.base_cfg.verbose <- false; let _ = SwitchConfig.parse_args () in let ds = Input.parse Config.base_cfg.dpt_file in diff --git a/src/lib/backend/c/translations/CCoreToCore.ml b/src/lib/backend/c/translations/CCoreToCore.ml index 44116a71..c3ec35af 100644 --- a/src/lib/backend/c/translations/CCoreToCore.ml +++ b/src/lib/backend/c/translations/CCoreToCore.ml @@ -15,12 +15,7 @@ let rec ty_to_size (ty : F.ty) = | _ -> failwith "not done" ;; -let rec ints_to_bits = function - | 0::is -> BitString.B0 :: ints_to_bits is - | 1::is -> BitString.B1 :: ints_to_bits is - | [] -> [] - | _ -> err "invalid int to convert into a bit" -;; +let ints_to_bits = BitString.of_ints ;; let detuple_ty (ty : F.ty) = match ty.raw_ty with | F.TTuple(ts) -> ts diff --git a/src/lib/backend/c/translations/CoreToCCore.ml b/src/lib/backend/c/translations/CoreToCCore.ml index 8ea70d45..9a4c7529 100644 --- a/src/lib/backend/c/translations/CoreToCCore.ml +++ b/src/lib/backend/c/translations/CoreToCCore.ml @@ -54,11 +54,7 @@ let size_to_ty = function | C.Sz(sz) -> F.ty@@F.TInt(F.sz sz) | C.Szs(szs) -> F.ttuple @@ List.map (fun sz -> F.ty@@F.TInt(F.sz sz)) szs ;; -let rec bits_to_ints = function - | BitString.B0::bs -> 0::(bits_to_ints bs) - | BitString.B1::bs -> 1::(bits_to_ints bs) - | [] -> [] -;; +let bits_to_ints = BitString.to_ints ;; (* helpers for actions and action types *) diff --git a/src/lib/backend/tofino/tofinocore/TofinoCore.ml b/src/lib/backend/tofino/tofinocore/TofinoCore.ml index b37a573d..874284eb 100644 --- a/src/lib/backend/tofino/tofinocore/TofinoCore.ml +++ b/src/lib/backend/tofino/tofinocore/TofinoCore.ml @@ -60,7 +60,6 @@ and parser_action = [%import: CoreSyntax.parser_action] and parser_branch = [%import: CoreSyntax.parser_branch] and parser_step = [%import: CoreSyntax.parser_step] and parser_block = [%import: CoreSyntax.parser_block] -and bit = [%import: CoreSyntax.bit] and bits = [%import: CoreSyntax.bits] (*NEW 6/2023 -- event types / definitions *) diff --git a/src/lib/frontend/datastructures/BitString.ml b/src/lib/frontend/datastructures/BitString.ml index 7ee3c51d..000d9c73 100644 --- a/src/lib/frontend/datastructures/BitString.ml +++ b/src/lib/frontend/datastructures/BitString.ml @@ -1,169 +1,155 @@ -(* simple bitstrings, used to represent unparsed packet payloads *) -type bit = |B0|B1 -type bits = bit list +(* simple bitstrings, used to represent unparsed packet payloads. + Represented as an immutable byte string plus a bit length. + Bits are stored MSB-first: bit i lives in byte (i/8), at mask (0x80 lsr (i mod 8)). + Canonical form invariant: `bstr` is exactly (blen+7)/8 bytes and any pad bits + in the final byte are zero. Every operation returns a canonical value, so + structural equality on `bits` is semantic equality. *) +type bits = + { bstr : string + ; blen : int (* length in bits *) + } -let empty = [] -let char_to_bits c = +let empty = { bstr = ""; blen = 0 } +let length bits = bits.blen + +(* read bit i (0-indexed from the MSB); assumes i < blen *) +let get_bit bs i = + (Char.code (String.unsafe_get bs.bstr (i lsr 3)) lsr (7 - (i land 7))) land 1 +;; + +(* build a canonical bits of length len whose ith bit is f i *) +let init_bits len f = + let nbytes = (len + 7) / 8 in + let b = Bytes.make nbytes '\000' in + for i = 0 to len - 1 do + if f i = 1 + then + Bytes.unsafe_set + b + (i lsr 3) + (Char.unsafe_chr (Char.code (Bytes.unsafe_get b (i lsr 3)) lor (0x80 lsr (i land 7)))) + done; + { bstr = Bytes.unsafe_to_string b; blen = len } +;; + +let hex_char_to_int c = match c with - | '0' -> [B0; B0; B0; B0] - | '1' -> [B0; B0; B0; B1] - | '2' -> [B0; B0; B1; B0] - | '3' -> [B0; B0; B1; B1] - | '4' -> [B0; B1; B0; B0] - | '5' -> [B0; B1; B0; B1] - | '6' -> [B0; B1; B1; B0] - | '7' -> [B0; B1; B1; B1] - | '8' -> [B1; B0; B0; B0] - | '9' -> [B1; B0; B0; B1] - | 'a' | 'A' -> [B1; B0; B1; B0] - | 'b' | 'B' -> [B1; B0; B1; B1] - | 'c' | 'C' -> [B1; B1; B0; B0] - | 'd' | 'D' -> [B1; B1; B0; B1] - | 'e' | 'E' -> [B1; B1; B1; B0] - | 'f' | 'F' -> [B1; B1; B1; B1] + | '0' .. '9' -> Char.code c - Char.code '0' + | 'a' .. 'f' -> Char.code c - Char.code 'a' + 10 + | 'A' .. 'F' -> Char.code c - Char.code 'A' + 10 | _ -> failwith "[hex_to_bits] Invalid hex character" ;; -(* take a string of hex numbers with no delimiters and - convert it into a bit list. *) -let hexstr_to_bits (str : string) : bits = - let acc = ref [] in - for i = String.length str - 1 downto 0 do - acc := char_to_bits str.[i] @ !acc + +(* take a string of hex numbers with no delimiters and + convert it into a bitstring. *) +let hexstr_to_bits (str : String.t) : bits = + let n = String.length str in + let b = Bytes.make ((n + 1) / 2) '\000' in + for i = 0 to n - 1 do + let v = hex_char_to_int (String.get str i) in + let cur = Char.code (Bytes.get b (i lsr 1)) in + let nv = if i land 1 = 0 then cur lor (v lsl 4) else cur lor v in + Bytes.set b (i lsr 1) (Char.chr nv) done; - !acc + { bstr = Bytes.unsafe_to_string b; blen = 4 * n } ;; +let char_to_bits c = hexstr_to_bits (String.make 1 c) + let bits_to_hexstr (bits : bits) : string = - let buf = Buffer.create 256 in - let rec convert bits = - match bits with - | [] -> Buffer.contents buf - | b1 :: b2 :: b3 :: b4 :: bs -> - let c = match (b1, b2, b3, b4) with - | (B0,B0,B0,B0) -> '0' - | (B0,B0,B0,B1) -> '1' - | (B0,B0,B1,B0) -> '2' - | (B0,B0,B1,B1) -> '3' - | (B0,B1,B0,B0) -> '4' - | (B0,B1,B0,B1) -> '5' - | (B0,B1,B1,B0) -> '6' - | (B0,B1,B1,B1) -> '7' - | (B1,B0,B0,B0) -> '8' - | (B1,B0,B0,B1) -> '9' - | (B1,B0,B1,B0) -> 'a' - | (B1,B0,B1,B1) -> 'b' - | (B1,B1,B0,B0) -> 'c' - | (B1,B1,B0,B1) -> 'd' - | (B1,B1,B1,B0) -> 'e' - | (B1,B1,B1,B1) -> 'f' - in - Buffer.add_char buf c; - convert bs - | _ -> failwith "[bits_to_hexstr] bits must be a multiple of 4" - in - convert bits + if bits.blen mod 4 <> 0 then failwith "[bits_to_hexstr] bits must be a multiple of 4"; + String.init (bits.blen / 4) (fun i -> + let byte = Char.code (String.get bits.bstr (i lsr 1)) in + let v = if i land 1 = 0 then byte lsr 4 else byte land 0xf in + "0123456789abcdef".[v]) ;; -let rec bits_to_hexstr (bits:bits) : string = - match bits with - | [] -> "" - | b1::b2::b3::b4::bs -> - let c = match (b1,b2,b3,b4) with - | (B0,B0,B0,B0) -> '0' - | (B0,B0,B0,B1) -> '1' - | (B0,B0,B1,B0) -> '2' - | (B0,B0,B1,B1) -> '3' - | (B0,B1,B0,B0) -> '4' - | (B0,B1,B0,B1) -> '5' - | (B0,B1,B1,B0) -> '6' - | (B0,B1,B1,B1) -> '7' - | (B1,B0,B0,B0) -> '8' - | (B1,B0,B0,B1) -> '9' - | (B1,B0,B1,B0) -> 'a' - | (B1,B0,B1,B1) -> 'b' - | (B1,B1,B0,B0) -> 'c' - | (B1,B1,B0,B1) -> 'd' - | (B1,B1,B1,B0) -> 'e' - | (B1,B1,B1,B1) -> 'f' - in - String.make 1 c ^ (bits_to_hexstr bs) - | _ -> failwith "[bits_to_hexstr] bits must be a multiple of 4" +(* raw byte string conversions. of_byte_string is where packet payloads enter; + because the representation is bytes, both directions are (at most) one copy. *) +let of_byte_string (s : string) : bits = { bstr = s; blen = 8 * String.length s } + +let to_byte_string (bits : bits) : string = + if bits.blen mod 8 <> 0 then failwith "[to_byte_string] bits must be a multiple of 8"; + bits.bstr ;; + (* print as a bitstring *) -let rec to_string bits : string = - match bits with - | [] -> "" - | B1::bits -> "1" ^ (to_string bits) - | B0::bits -> "0" ^ (to_string bits) +let to_string bits : string = + String.init bits.blen (fun i -> if get_bit bits i = 1 then '1' else '0') ;; (* convert an unsigned integer to a bitstring *) -let rec int_to_bits_rev width n : bits = - if (width = 0) then [] - else - let b = match (n land 1) with - | 0 -> B0 - | 1 -> B1 - | _ -> failwith "[int_to_bits] invalid result from n land 1" - in - b::(int_to_bits_rev (width-1) (n lsr 1)) +let int_to_bits width n : bits = + let b = Bytes.make ((width + 7) / 8) '\000' in + let x = ref n in + for j = 0 to width - 1 do + if !x land 1 = 1 + then begin + let i = width - 1 - j in + Bytes.set b (i lsr 3) (Char.chr (Char.code (Bytes.get b (i lsr 3)) lor (0x80 lsr (i land 7)))) + end; + x := !x lsr 1 + done; + { bstr = Bytes.unsafe_to_string b; blen = width } ;; -let int_to_bits width n = - List.rev (int_to_bits_rev width n) -;; -let rec bits_to_int (bits:bits) : int = - match bits with - | [] -> 0 - | b::bs -> - let v = match b with - | B1 -> 1 lsl (List.length bs) - | B0 -> 0 - in - v lor (bits_to_int bs) +let bits_to_int (bits : bits) : int = + let r = ref 0 in + for i = 0 to bits.blen - 1 do + r := (!r lsl 1) lor get_bit bits i + done; + !r ;; -(* read n most significant bits into an unsigned int *) -let rec read_msb n bits: int = - match bits with - | [] -> 0 - | b::bs -> - if (n = 0) then 0 - else - let v = match b with - | B1 -> 1 lsl ((n-1)) - | B0 -> 0 - in - v lor (read_msb (n-1) bs ) -;; - (* advance to the nth bit, return new string *) -let rec advance n bits : bits option = - match n with - | 0 -> Some(bits) - | _ -> ( - match bits with - | [] -> None - | _::bs -> advance (n-1) bs - ) +let advance n bits : bits option = + if n < 0 || n > bits.blen + then None + else if n land 7 = 0 + then ( + (* byte-aligned fast path: copy the remaining bytes. pad bits of the + final byte are unchanged, so canonical form holds. *) + let len = bits.blen - n in + Some { bstr = String.sub bits.bstr (n lsr 3) ((len + 7) / 8); blen = len }) + else ( + (* unaligned: rebuild bit-by-bit *) + let len = bits.blen - n in + Some (init_bits len (fun i -> get_bit bits (i + n)))) ;; (* read n bits to unsigned int without advancing. *) -let peek_msb n bits : int option = - match advance n bits with - | None -> None - | Some(_) -> Some(read_msb n bits) +let peek_msb n bits : int option = + if n > bits.blen + then None + else ( + let r = ref 0 in + for i = 0 to n - 1 do + r := (!r lsl 1) lor get_bit bits i + done; + Some !r) ;; (* read n bits to unsigned int and advance. *) -let pop_msb n bits : (int * bits) option = - match advance n bits with - | None -> None - | Some(bits') -> Some(read_msb n bits, bits') +let pop_msb n bits : (int * bits) option = + match advance n bits, peek_msb n bits with + | Some bits', Some v -> Some (v, bits') + | _ -> None ;; (* concat 2 bitstrings *) -let rec concat bits1 bits2 : bits = - match bits1 with - | [] -> bits2 - | b::bs -> b::(concat bs bits2) \ No newline at end of file +let concat bits1 bits2 : bits = + if bits1.blen land 7 = 0 + then { bstr = bits1.bstr ^ bits2.bstr; blen = bits1.blen + bits2.blen } + else + init_bits (bits1.blen + bits2.blen) (fun i -> + if i < bits1.blen then get_bit bits1 i else get_bit bits2 (i - bits1.blen)) +;; + +(* conversions to/from lists of 0/1 ints, for compile-time translation passes *) +let to_ints (bits : bits) : int list = List.init bits.blen (fun i -> get_bit bits i) + +let of_ints (is : int list) : bits = + let arr = Array.of_list is in + Array.iter (fun i -> if i <> 0 && i <> 1 then failwith "[of_ints] invalid bit int") arr; + init_bits (Array.length arr) (fun i -> arr.(i)) +;; diff --git a/src/lib/frontend/datastructures/BitString.mli b/src/lib/frontend/datastructures/BitString.mli index bacd649d..e88f59ee 100644 --- a/src/lib/frontend/datastructures/BitString.mli +++ b/src/lib/frontend/datastructures/BitString.mli @@ -1,15 +1,25 @@ -type bit = |B0|B1 - -type bits = bit list +(* The record is exposed so ppx_import can re-export it in CoreSyntax, + but treat it as abstract: construct values only through this interface. + Invariant: bstr is exactly (blen+7)/8 bytes, MSB-first, pad bits zero. + Values are canonical, so structural equality is semantic equality. *) +type bits = + { bstr : string + ; blen : int (* length in bits *) + } val empty : bits +val length : bits -> int val char_to_bits : char -> bits val hexstr_to_bits : string -> bits val bits_to_hexstr : bits -> string +val of_byte_string : string -> bits +val to_byte_string : bits -> string val to_string : bits -> string -val advance : int -> bits -> bits option +val advance : int -> bits -> bits option val peek_msb : int -> bits -> int option val pop_msb : int -> bits -> (int * bits) option -val concat : bits -> bits -> bits +val concat : bits -> bits -> bits val int_to_bits : int -> int -> bits -val bits_to_int : bits -> int \ No newline at end of file +val bits_to_int : bits -> int +val to_ints : bits -> int list +val of_ints : int list -> bits diff --git a/src/lib/frontend/modules/Tables.ml b/src/lib/frontend/modules/Tables.ml index c5790f80..d22c3b16 100644 --- a/src/lib/frontend/modules/Tables.ml +++ b/src/lib/frontend/modules/Tables.ml @@ -51,8 +51,8 @@ match v with CoreSyntax.VTuple([v; CoreSyntax.VInt(mask)]) | VBits b -> let v = BitString.bits_to_int b in - let v = Integer.create ~value:v ~size:(List.length b) in - let m = Integer.max_int (List.length b) in + let v = Integer.create ~value:v ~size:(BitString.length b) in + let m = Integer.max_int (BitString.length b) in CoreSyntax.VTuple([CoreSyntax.VInt(v); CoreSyntax.VInt(m)]) | VGlobal _ -> Syntax.error "a global cannot appear as a key in a table" | VEvent _ -> Syntax.error "an event cannot appear as a key in a table" diff --git a/src/lib/midend/CoreSyntax.ml b/src/lib/midend/CoreSyntax.ml index 0f39bdab..7fb36108 100644 --- a/src/lib/midend/CoreSyntax.ml +++ b/src/lib/midend/CoreSyntax.ml @@ -11,7 +11,6 @@ and z = [%import: (Z.t[@opaque])] and pragma = [%import: Pragma.t] and zint = [%import: (Integer.t[@with Z.t := (Z.t [@opaque])])] and location = int -and bit = [%import: (BitString.bit[@opaque])] and bits = [%import: (BitString.bits[@opaque])] (* All sizes should be inlined and precomputed *) @@ -316,7 +315,7 @@ let rec infer_vty v = | VGlobal _ -> failwith "Cannot infer type of global value" | VPat bs -> TPat(Sz(List.length bs)) | VTuple(vs) -> TTuple(List.map infer_vty vs) - | VBits bits -> TBits(Sz(List.length bits)) + | VBits bits -> TBits(Sz(BitString.length bits)) | VRecord fields -> TRecord (List.map (fun (id, v) -> id, infer_vty v) fields) ;; diff --git a/src/lib/midend/interpreter/InterpDeparsing.ml b/src/lib/midend/interpreter/InterpDeparsing.ml index 9a4f6fbd..9ec0ccfd 100644 --- a/src/lib/midend/interpreter/InterpDeparsing.ml +++ b/src/lib/midend/interpreter/InterpDeparsing.ml @@ -23,7 +23,7 @@ let pwrite (p:BitString.bits) (v:value) : BitString.bits = The values are just serialized directly. *) let serialize_packet_event event_val = (* serialize all the event arguments to a single bitstring *) - let packet_bits = List.fold_left pwrite [] event_val.data in + let packet_bits = List.fold_left pwrite BitString.empty event_val.data in (* tag with metadata *) {event_val with eid=Cid.create ["bytes"]; data=[vbits packet_bits]; eserialized=true;} ;; @@ -37,7 +37,7 @@ let serialize_background_event lucid_hdrs event_val = | Some(evnum) -> evnum in let all_data = lucid_hdrs@[evnum]@event_val.data in - let packet_bits = List.fold_left pwrite [] all_data in + let packet_bits = List.fold_left pwrite BitString.empty all_data in {event_val with eid=Cid.create ["bytes"]; data=[vbits packet_bits]; eserialized=true;} ;; diff --git a/src/lib/midend/interpreter/InterpJson.ml b/src/lib/midend/interpreter/InterpJson.ml index 9b2623b1..4aef289a 100644 --- a/src/lib/midend/interpreter/InterpJson.ml +++ b/src/lib/midend/interpreter/InterpJson.ml @@ -186,7 +186,7 @@ let rec v_to_mask (v : CoreSyntax.v) = | VBits b -> (* let v = BitString.bits_to_int b in *) (* let v = Integer.create ~value:v ~size:(List.length b) in *) - let m = Integer.max_int (List.length b) in + let m = Integer.max_int (BitString.length b) in CoreSyntax.VInt(m) | VGlobal _ -> Console.error "a global cannot appear as a key in a table" | VEvent _ -> Console.error "an event cannot appear as a key in a table" diff --git a/src/lib/midend/interpreter/InterpParsing.ml b/src/lib/midend/interpreter/InterpParsing.ml index 441db4c8..a624764c 100644 --- a/src/lib/midend/interpreter/InterpParsing.ml +++ b/src/lib/midend/interpreter/InterpParsing.ml @@ -47,9 +47,9 @@ let parse_args (p:value) arg_tys = let _, args = List.fold_left (fun ((payload:CoreSyntax.value), argvs) ty -> if (is_payload_ty ty) then - (* (vbits []) will cause an error if there's anything + (* (vbits BitString.empty) will cause an error if there's anything after a payload (as expected) *) - (vbits []), argvs@[payload] + (vbits BitString.empty), argvs@[payload] else let arg, payload = pread payload ty in payload, argvs@[arg]) diff --git a/src/lib/midend/interpreter/InterpSocket.ml b/src/lib/midend/interpreter/InterpSocket.ml index 04076657..a41eebc6 100644 --- a/src/lib/midend/interpreter/InterpSocket.ml +++ b/src/lib/midend/interpreter/InterpSocket.ml @@ -66,7 +66,7 @@ let read_batch_nonblock self = (* create an event from timestamp, location, and buf *) let event_create timestamp locations buf = - let bytes = hexstr_to_vbits (Cstruct.to_hex_string buf) in + let bytes = vbits (BitString.of_byte_string (Cstruct.to_string buf)) in let pkt_event = packet_event bytes 0 in let ev = ievent pkt_event locations timestamp in ev @@ -80,8 +80,7 @@ let event_to_packetbuf (ev : event_val) = | [vbits] -> extract_bits vbits | _ -> error "[InterpSocket.ml] Interpreter fault: event serialized wrong" in - let hex_str = BitString.bits_to_hexstr vbits |> Cstruct.of_hex in - hex_str + Cstruct.of_string (BitString.to_byte_string vbits) ;; diff --git a/src/lib/midend/interpreter/InterpSwitch.ml b/src/lib/midend/interpreter/InterpSwitch.ml index e5566a90..39a8c176 100644 --- a/src/lib/midend/interpreter/InterpSwitch.ml +++ b/src/lib/midend/interpreter/InterpSwitch.ml @@ -198,22 +198,20 @@ let emit (st : state) (intent : send_intent) : unit = st.outbox := intent :: !(st.outbox) ;; -(* how many events are already queued at [stime] -- a stable tiebreaker for - events that arrive at the same time. *) -let n_queued_for_time queued_events stime = - List.length (List.filter (fun e -> (timestamp e) = stime) queued_events) -;; +(* arrival order, the tiebreaker for events queued at the same time *) +let enqueue_seq = ref 0 ;; +let next_enqueue_seq () = incr enqueue_seq; !enqueue_seq ;; (* enqueue an event into this switch's ingress queue (pure). *) let enqueue_ingress st iev stime sport : state = - let squeue_order = n_queued_for_time (EventQueue.elems st.ingress_queue) stime in + let squeue_order = next_enqueue_seq () in let iev = { iev with sloc = loc (None, sport); squeue_order; stime } in { st with ingress_queue = EventQueue.add iev st.ingress_queue } ;; (* enqueue an event into this switch's egress queue (pure). *) let enqueue_egress st iev stime sport : state = - let squeue_order = n_queued_for_time (EventQueue.elems st.egress_queue) stime in + let squeue_order = next_enqueue_seq () in let iev = { iev with squeue_order; sloc = loc (None, sport); stime } in { st with egress_queue = EventQueue.add iev st.egress_queue } ;; diff --git a/vendor/rawlink/lib/rawlink.ml b/vendor/rawlink/lib/rawlink.ml index 4a7c9a6d..05c32c37 100644 --- a/vendor/rawlink/lib/rawlink.ml +++ b/vendor/rawlink/lib/rawlink.ml @@ -28,9 +28,11 @@ let dhcp_server_filter = Lowlevel.dhcp_server_filter let dhcp_client_filter = Lowlevel.dhcp_client_filter let open_link ?filter ?(promisc=false) ifname = - { fd = Lowlevel.opensock ?filter ~promisc ifname; + let fd = Lowlevel.opensock ?filter ~promisc ifname in + (* blen is the granted buffer size *) + { fd; packets = ref []; - buffer = Cstruct.create 65536 } + buffer = Cstruct.create (Lowlevel.blen fd) } let close_link t = Unix.close t.fd diff --git a/vendor/rawlink/lib/rawlink_lowlevel.ml b/vendor/rawlink/lib/rawlink_lowlevel.ml index bd212a3f..58cd93b3 100644 --- a/vendor/rawlink/lib/rawlink_lowlevel.ml +++ b/vendor/rawlink/lib/rawlink_lowlevel.ml @@ -36,6 +36,7 @@ external driver: unit -> driver = "caml_driver" external unix_bytes_read: Unix.file_descr -> Cstruct.buffer -> int -> int -> int = "caml_unix_bytes_read" external bpf_align: int -> int -> int = "caml_bpf_align" +external blen: Unix.file_descr -> int = "caml_rawlink_blen" let bpf_split_buffer buffer len = let rec loop buffer n packets = diff --git a/vendor/rawlink/lib/rawlink_stubs.c b/vendor/rawlink/lib/rawlink_stubs.c index 69361adb..75b7df9a 100644 --- a/vendor/rawlink/lib/rawlink_stubs.c +++ b/vendor/rawlink/lib/rawlink_stubs.c @@ -56,6 +56,9 @@ #include "caml/custom.h" #include "caml/bigarray.h" +/* requested kernel capture buffer size */ +#define RAWLINK_BUFFER_REQUEST (512 * 1024) + #ifdef USE_BPF #define FILTER bpf_insn @@ -202,7 +205,7 @@ caml_rawlink_open(value vfilter, value vpromisc, value vifname) CAMLreturn(Val_unit); if (bpf_sethdrcmplt(fd, 1) == -1) CAMLreturn(Val_unit); - if (bpf_setblen(fd, UNIX_BUFFER_SIZE) == -1) + if (bpf_setblen(fd, RAWLINK_BUFFER_REQUEST) == -1) CAMLreturn(Val_unit); if (bpf_setfilter(fd, vfilter) == -1) CAMLreturn(Val_unit); @@ -231,6 +234,19 @@ caml_bpf_align(value va, value vb) CAMLreturn (v); } +/* buffer size granted by the kernel */ +CAMLprim value +caml_rawlink_blen(value vfd) +{ + CAMLparam1(vfd); + u_int blen; + + if (ioctl(Int_val(vfd), BIOCGBLEN, &blen) == -1) + uerror("caml_rawlink_blen", Nothing); + + CAMLreturn (Val_int(blen)); +} + #endif /* USE_BPF */ #ifdef USE_AF_PACKET @@ -384,6 +400,14 @@ caml_bpf_align(value va, value vb) CAMLreturn (Val_int(0)); } +/* AF_PACKET reads one packet per read(); a fixed buffer size is fine */ +CAMLprim value +caml_rawlink_blen(value vfd) +{ + CAMLparam1(vfd); + CAMLreturn (Val_int(UNIX_BUFFER_SIZE)); +} + #endif /* USE_AF_PACKET */ CAMLprim value From 87ae90f1a66c31a1f02e7f116f819bd5f9ce8a09 Mon Sep 17 00:00:00 2001 From: John Sonchack Date: Tue, 11 Aug 2026 16:09:58 -0400 Subject: [PATCH 43/49] cleanup --- docker/dev/Dockerfile | 34 +++++++++++++++------------------- 1 file changed, 15 insertions(+), 19 deletions(-) diff --git a/docker/dev/Dockerfile b/docker/dev/Dockerfile index 9515b756..0716866b 100644 --- a/docker/dev/Dockerfile +++ b/docker/dev/Dockerfile @@ -22,23 +22,23 @@ RUN apt-get update && apt-get install -y \ RUN echo "ubuntu ALL=(ALL) NOPASSWD:ALL" > /etc/sudoers.d/ubuntu \ && chmod 0440 /etc/sudoers.d/ubuntu -# ---- DPDK 24.03 (dev only: net/pcap + net/af_packet PMDs) ---- +# ---- DPDK 24.03 (dev only: net/pcap + net/af_packet PMDs; amd64 images only) ---- # To build the full driver set instead, drop the `-Denable_drivers=...` flag -# ISA is set to (SSE4.2, no AVX) for Rosetta/qemu on macos arm64 -# For better performance on real x86 hosts, remove the ISA_OPT override +# ISA is set to westmere (SSE4.2, no AVX) so amd64 images also run under +# Rosetta/qemu on macos arm64; remove for better performance on real x86 hosts ARG TARGETARCH -RUN wget -q https://fast.dpdk.org/rel/dpdk-24.03.tar.xz \ - && tar -xJf dpdk-24.03.tar.xz && rm dpdk-24.03.tar.xz \ - && cd dpdk-24.03 \ - && case "$TARGETARCH" in \ - amd64) ISA_OPT="-Dcpu_instruction_set=westmere" ;; \ - *) ISA_OPT="" ;; \ - esac \ - && meson setup build -Denable_drivers=net/pcap,net/af_packet -Dtests=false $ISA_OPT \ - && ninja -C build \ - && meson install -C build \ - && ldconfig \ - && cd .. && rm -rf dpdk-24.03 +RUN if [ "$TARGETARCH" = "amd64" ]; then \ + wget -q https://fast.dpdk.org/rel/dpdk-24.03.tar.xz \ + && tar -xJf dpdk-24.03.tar.xz && rm dpdk-24.03.tar.xz \ + && cd dpdk-24.03 \ + && meson setup build -Denable_drivers=net/pcap,net/af_packet -Dtests=false -Dcpu_instruction_set=westmere \ + && ninja -C build \ + && meson install -C build \ + && ldconfig \ + && cd .. && rm -rf dpdk-24.03; \ + else \ + echo "TARGETARCH=$TARGETARCH: skipping DPDK build"; \ + fi # ---- user setup ---- USER ubuntu @@ -67,8 +67,4 @@ RUN opam install -y --confirm-level=unsafe-yes \ RUN opam install -y --confirm-level=unsafe-yes \ ocaml-lsp-server "ocamlformat=0.19.0" -# 6. (optional) install claude -RUN curl -fsSL https://claude.ai/install.sh | bash -ENV PATH="/home/ubuntu/.local/bin:${PATH}" - CMD ["bash"] \ No newline at end of file From 2ffa219bd6092d8b8c7cf35dd5c2d3ff2e2fd90b Mon Sep 17 00:00:00 2001 From: John Sonchack Date: Tue, 11 Aug 2026 16:40:56 -0400 Subject: [PATCH 44/49] cleanup notes doc --- examples/p4_bmv2_examples/Lucid-overview.md | 495 -------------------- 1 file changed, 495 deletions(-) delete mode 100644 examples/p4_bmv2_examples/Lucid-overview.md diff --git a/examples/p4_bmv2_examples/Lucid-overview.md b/examples/p4_bmv2_examples/Lucid-overview.md deleted file mode 100644 index 962e16aa..00000000 --- a/examples/p4_bmv2_examples/Lucid-overview.md +++ /dev/null @@ -1,495 +0,0 @@ -Lucid is an event-based data-plane language. It is imperative and syntax is similar to c++ or rust. It has domain-specific constructs inspired by P4, but is higher level, more expressive, and simpler. - -*Advice for programming in Lucid.* When developing in Lucid, work incrementally. Write the program first and type-check it, then fix errors, then generate a test spec (consider using a Python helper script if it is complicated). Do not try to plan or pre-compute the complete solution. - -## Contents -- [Basic features](#basic-features) — the core primitives, with a complete small example -- [Key constraints](#key-constraints) — non-obvious rules; read before writing event handlers -- [Parser constraints](#parser-constraints) — rules specific to parsers -- [Common gotchas](#common-gotchas) — surface-level things that trip up newcomers -- [Running a program](#running-a-program) — interpreter, software switch, Tofino compiler -- [Additional language features](#additional-language-features) - - [Builtins](#builtins) — types, `ingress_port`, `hash`, `Array`, `generate*`, `read` - - [Externs](#externs) - - [Tables](#tables) — match-action tables, actions, lookup, install - - [Functions](#functions) - - [Sizes, vectors, and loops](#sizes-vectors-and-loops) - - [Polymorphism](#polymorphism) - - [Modules and constructors](#modules-and-constructors) - - [Multicast](#multicast) - - [Tuples](#tuples) -- [Interpreter](#interpreter) — JSON spec file format - - [Event inputs](#event-inputs) - - [Unparsed packet events](#unparsed-packet-events) - - [Control command events](#control-command-events) — `Array.get`/`set`, `Table.install` - - [Network topology](#network-topology) - - [Other specification fields](#other-specification-fields) - - [Interpreter output](#interpreter-output) -- [End-to-end interpreter workflow example](#end-to-end-interpreter-workflow-example) — program + spec + annotated output -- [The Lucid virtual switch](#the-lucid-virtual-switch) -- [The Tofino compiler](#the-tofino-compiler) - -## Basic features -The core primitives of a Lucid program are events, handlers, globals, memops, parsers, and records. - -Events abstract packets, asynchronous operations, and message passing between distributed components. - -Handlers are imperative functions that process events, perform operations on global state, and generate more events. - -Globals can be read or written by handlers and persist across handler execution. They are constructed and operated on by helpers in the builtin Array and Table modules. - -Memops are special functions passed to Array methods to operate on globals. They are restricted so they can compile to an atomic instruction: a memop may only include a return statement, or an if/else with a return statement in each branch. Expressions in the return and if/else statements can use each memop argument at most once, plus an unlimited number of constants. - -Parsers are functions from unparsed packets to events. Events dispatched by parsers should be labeled as "packet" events and contain a final argument of type "Payload.t". - -Records are type declarations with fields separated and terminated by `;`, like structs. - -Events are dispatched by one of three statements: `generate(e)` enqueues `e` for asynchronous handling on this switch; `generate_port(p, e)` emits packet event `e` out port `p`; `generate_ports(g, e)` emits `e` out every port in multicast group `g` (see Multicast). - -Here is a simple lucid example of an ethernet packet counter and reflector: -``` -const int seed = 12345; - -type eth_hdr_t = {int<48> dmac; int<48> smac; int<16> ety;} - -global Array.t<32> cts = Array.create(1024); // Create an array holding 1024 32-bit ints. - -event print_count(int<16> idx, int<32> ct); -packet event eth_pkt(eth_hdr_t eth_hdr, Payload.t pl); - -memop memval(int mv, int unused) { - return mv; -} -memop incr(int mv, int incrby) { - return mv + incrby; -} - -handle eth_pkt(eth_hdr_t eth_hdr, Payload.t pl) { - int<10> idx = hash<10>(seed, eth_hdr#dmac, eth_hdr#smac); // take the hash of the ethernet flow key. - // Array.update(arr, idx, get_memop, get_arg, set_memop, set_arg): - // the get_memop computes the return value, the set_memop computes the new cell value. - // idx can be any int size; out-of-bounds indices wrap with a modulo. - int ct = Array.update(cts, idx, memval, 0, incr, 1); - // Equivalent to (atomically): - // ct = memval(cts[idx], 0); - // cts[idx] = incr(cts[idx], 1); - generate(print_count((int<16>)idx, ct)); // generate print_count to handle asynchronously. - generate_port(ingress_port, eth_pkt(eth_hdr, pl)); // generate eth_pkt out of the port it arrived on. ingress_port is a builtin. -} - -handle print_count(int<16> idx, int<32> ct) { - printf("index: %d, count: %d", idx, ct); -} - -// a parser maps unparsed bitstrings to packet events. -// parsers for regular (non packet) events are generated by the compiler. -parser main(bitstring pkt) { - eth_hdr_t eth_hdr = read(pkt); - match eth_hdr#ety with - | LUCID_ETHERTY -> { - // a parser must begin by extracting some form of an ethernet header, matching on the LUCID_ETHERTY builtin, and calling do_lucid_parsing in that branch. - do_lucid_parsing(pkt); - } - | 0x0800 -> { drop; } // match branches can use integer literals, formatted as decimal or hex - | _ -> { - generate(eth_pkt(eth_hdr, Payload.parse(pkt))); - } -} -``` - - -## Key constraints -A handful of rules shape how Lucid programs are written. Lucid's type checker enforces these rules and provides reasonable error messages if you make a mistake. - -- **Within any execution path, globals may only be accessed in declaration order.** Any path may skip any global entirely — the ordering rule only applies to accesses that do occur. Two branches may perform different operations on the same global, or one branch may access a global while the other skips it completely. You can also revisit a global by generating another event to do it asynchronously. Lucid's type checker will tell you which global operations are misordered if you make a mistake. -- **Functions are non-recursive.** Recursion is only possible via events (a handler may generate its own event). -- **Sizes are compile-time only.** A `size` is not a runtime value. `size_to_int` converts a size to an int; there is no reverse. -- **Memops compile to atomic instructions.** They take exactly two int parameters (the current memory value and one runtime argument) and have a restricted expression grammar — no calls to other functions, no loops. - -## Parser constraints -Parsers have a few additional constraints: - -- **Parsers must begin with an ethernet header and branch on `LUCID_ETHERTY`.** The `LUCID_ETHERTY` branch must call `do_lucid_parsing(pkt)`; other branches generate user-defined packet events. -- **Parsers must terminate explicitly.** Every branch of a parser must terminate by either: a) generating an event; b) calling another parser; or c) calling "drop;", a builtin *statement* to drop the packet. Note that "drop" cannot be called from a handler, where dropping is the default behavior when no events are generated. -- **Other parser restrictions.** Other parser restrictions are similar to P4. A parser cannot access globals, use if/else statements, perform arithmetic or boolean operations, and can only match on one variable at a time. Note that nested match statements are supported. Also, match statements can also be used in handlers, with the same syntax as in parsers and with support for multiple variables. - -## Tips - -- Overall, Lucid is designed to make data-plane programming more like conventional programming. When uncertain about whether something is valid, the most effective approach is to just write it and run the type checker — it will give precise, actionable error messages. Don't reason from first principles about what might be allowed; write your best guess and iterate. -- Nested matches are allowed in parsers. -- Read operations in the parser do not add padding (e.g., between fields). -- Take advantage of the type checker to help you reason about global ordering. -- Handlers can generate multiple events. -- **Reach for `packet event` only when the protocol talks to non-Lucid endpoints.** A `packet event` is bound to a wire format: it goes through a parser on ingress and the auto-deparser on egress, which imposes real constraints (no variable-length stacks, every positional arg must occupy a distinct hardware slot, etc.). For *control protocols* that originate and terminate inside Lucid, or at Lucid-aware endpoints — probes, telemetry, distributed coordination, scheduling messages — declare a regular `event` instead. Regular events have no wire format, no parser constraints, no slot-analysis restrictions; they can carry vectors and records freely, and `generate_port` still ferries them between switches in the simulator. The data-plane semantics are identical; you only give up the ability to interoperate with non-Lucid senders/receivers, which most internal protocols don't need. -- You can also model complicated data plane programs with regular events first, to make testing easier, and then add packet events in later. -- Recursive events are good for housekeeping and data structure maintenence. The handler of a recursive event will execute periodically, like a background thread waking up to perform a task. - -## Common gotchas -Surface-level things that trip up newcomers: - -- `int`s in Lucid are **unsigned**. There are currently no signed ints. -- `#` is used for both record field access (`eth_hdr#dmac`) and tuple indexing (`pair#0`). -- `hash(seed, ...)` requires a seed as the first argument; the `N` in angle brackets is the output bit-width. -- For a table with no runtime argument (`arg_ty = ()`), pass `()` explicitly: `Table.lookup(tbl, key, ())`. -- Polymorphic identifiers begin with a tick: `'a`, `'n`. Use `auto` only when the type checker should infer a single hole. -- `size` values cannot be used where an `int` is expected — convert with `size_to_int`. There is no `int_to_size`. -- `printf` is interpreter-only; it does not appear in compiled Tofino programs. Its format string supports `%d` only — `%x`, `%s`, etc. fail at parse time. -- Bitwise XOR is `^^`. Single `^` is bitstring concatenation. -- Casts use C-style syntax: `(int<16>)idx` and truncate the higher-order bits. Cast binds tighter than `#` (record field access), so use `(int)(rec#field)`. Also, bare `int` does not work in a cast. -- A bare `int`, used as a type with no widths, means `int<32>` by default. Note that int literal *values*, such as in match arms and assignments, are inferred to the surrounding context's width. -- Record field names are resolved globally. So two different record types cannot have a field with the same name. -- JSON interpreter spec entries cannot carry comments. - -## Running a program -There are three stages, from fastest feedback to most realistic. Most development happens in stages 1 and 2. - -**1. Type-check and simulate with the interpreter (`dpt`).** Run `./dpt foo.dpt` for a quick type-check (errors print with file:line locations), or `./dpt foo.dpt --spec foo.json` to simulate a JSON-described trace of input events against an optional topology. The interpreter prints `printf` output, generated events, and a final state summary. This is the fastest loop — see the [Interpreter](#interpreter) section for spec file details. - -**2. Run live on the Lucid virtual switch (`lucidSwitch`).** `./lucidSwitch foo.dpt --interface 0:veth0 --interface 1:veth1` runs the program against real (low-rate, ~1 Gbps) traffic on raw socket interfaces, similar in spirit to an OVS switch. This is the intended target for live testing and is where most development will stop. See [The Lucid virtual switch](#the-lucid-virtual-switch). - -**3. (Optional) Compile to Tofino (`dptc`).** `./dptc foo.dpt` compiles to P4 for the Intel Tofino. Only relevant if you are specifically targeting that hardware; there are additional resource and language restrictions — see the tutorials. - -## Additional language features - -### Builtins -- `int` : integer type of width `W` -- `bool` : boolean type -- `bitstring` : the type of an unparsed packet. May only be used in parsers. -- `Payload.t` : the type of an unparsed packet payload. -- `Payload.parse(pkt)` : converts pkt (of type `bitstring`) into a `Payload.t`. Should only be used in generate statements inside of a parser. -- `ingress_port`: the port a packet arrived on. Type depends on the target, in the interpreter and software switch, it is an `int<32>`. In the Tofino, it is an `int<9>`. -- `self`: the id of the switch (in a multi-node simulation) -- `Sys.time()`: the timestamp of the current event's arrival, in nanoseconds -- `Sys.random()`: returns a random 32-bit integer -- `v = hash(seed, arg, [arg...])`: hash the argument list to an `int`, using the given seed. -- `generate(e)`: statement that generates event e -- `generate_port(p, e)`: statement that generates an event e and emits it out of port p. The type of `p` depends on the target, in the interpreter it is an `int<32>` and in the Tofino it is an `int<9>`. -- `v = Array.get(array, idx)`: returns `array[idx]` to `v` -- `Array.set(array, idx, v)`: sets `array[idx] = v` -- `v = Array.getm(array, idx, fget, arg)`: returns `fget(array[idx], arg)` to `v` -- `Array.setm(array, idx, fset, arg)`: sets `array[idx] = fset(array[idx], arg)` -- `v = Array.update(array, idx, fget, getarg, fset, setarg)` : returns `fget(array[idx], getarg)` to `v` and, in parallel, sets `array[idx] = fset(array[idx], setarg)` -- `t v = read(pkt)` : a read statement, only available in the parser. Requires `pkt` to be of type `bitstring`.Extracts a value of type `t` from the `pkt` and increments its cursor by the appropriate number of bits. -- `printf(str, args, ...)` : prints a string, which may include any number of "%d" format specifiers and a matching number of int args. - - -### Externs -Top-level variables can be declared as externs, which are assigned values by the compiler or interpreter: `extern int foo;` - -### Tables -Match-action tables map keys to action functions. Their primary operations are lookup and install. - -#### Declaration -`Table.create` creates a table. The declaration: - -`global Table.t<> tbl = Table.create(sz, actions, default_action, default_data);` - -Creates the table `tbl` of type `Table.t<>`, with `sz` entries. Each entry stores a key, data, and action function of type `data_ty -> arg_ty -> ret_ty`. The table will also have a default entry `default_action` and `default_data`, which is applied on `Table.lookup` if no other entries match. All of a table's actions must have the same data, arg, and return types. - -#### Actions -Actions are pure functions only used by tables. They have two sets of parameters, the first corresponds to `data_ty` in a table declaration, and is passed the install-time entry parameter. The second set of parameters correspond to `action_ty`, and are passed arguments when a table lookup is called. - -The grammar is: -``` -action "name"()()"{"return "}" -``` - -``` -action int plus(int p1)(int p2) { - return p1 + p2; -} -``` - -#### Table lookup -```ret_ty result = Table.lookup(tbl, key, arg);``` - -This finds the first entry in the table with a matching key and executes it, passing in the entry's data and arg as the two sets of action parameters. The action's result is returned as Table.lookup's output. - -This executes, as psuedocode: -``` -def lookup(tbl, key, arg): - for i in range(len(tbl.records)): - entry = tbl.records[i] - if (key == entry.key): # match! - data = entry.data - action = entry.action - return action(data, arg) - # no matches, run default action - return tbl.default_action(tbl.default_data, arg) -``` - -If the table has no runtime argument, pass `()` as arg. - -#### Table install - -```Table.install(tbl, key, acn, data);``` - -This installs an entry into `tbl` that matches on `key` and calls `acn` with first argument `data`. - -```Table.install_ternary(tbl, key, mask, acn, data);``` -This installs a masked entry into `tbl`. A masked entry only considers the masked bits of the key at lookup time. In other words, if `Table.lookup(tbl, k, arg);` is called, the masked entry installed above will match when `key && mask == k && mask`. - -### Functions -Lucid programs can declare and use non-recursive functions. Functions can do everything a handler does, including declaring and mutating locally-scoped variables. -``` -fun bool check_tcp_flag(tcp_t tcp, int<8> flagval) { - return tcp#flags == flagval; -} -``` - -### Sizes, vectors, and loops -Sizes are a kind of integer used only to specify compile-time data structure sizes. Their primary use is for int widths and vectors of globals. For example: -``` -size n_bits = 10; -size n_cols = 4; -const int foo = 1023; -// a vector of n_cols arrays that each have cells of size n_bits -global Array.t[n_cols] my_arrs = [Array.create(1024) for i < n_cols]; - -fun void print_vals(int[n_cols] idxs) { - for (i < n_cols) { - int v = Array.get(my_arrs[i], idxs[i]); - int ival = size_to_int(i); // a builtin to convert a size to an int, note the reverse operation is not possible. - printf("my_arrs[%d][%d] = %d", ival, idxs[i], v); - } -} - -``` - -### Polymorphism -Types and sizes can be polymorphic. Use the "auto" keyword in place of a type or size parameter, or a polymorphic identifier, which begins with a "'" (tick mark) and represents a "hole" that the type checker will attempt to fill. For example, a function add that works for any sized int: -``` -fun int<'a> add1(int<'a> x) { return x + 1; } -``` - -### Modules and constructors -Modules in Lucid work similar to basic OCaml modules. A module has an interface and an implementation. The interface declares datatypes, constructors, functions, and events that client code may access, the implementation defines them and other private internal components. Types declared in a module interface may be tagged as "global", indicating they can only be used for global variables. For example: - -``` -module Array32Vec : { - global type t<'n>; - constr t<'n> create(int<32> array_length); - - fun void print_vals(t<'n> self, int<32>['n] idxs); - - event update(t<'n> self, int<32>['n] idxs, int<32>['n] vals); -} -// implementation -{ - type t<'n> = {Array.t<32>['n] arrs} - constr t<'n> create(int<32> array_length) = { arrs=[Array.create(array_length) for i < 'n] }; - fun void print_vals(t<'n> self, int<32>['n] idxs) { - for (i < 'n) { - int<32> v = Array.get(self#arrs[i], idxs[i]); - int ival = size_to_int(i); // a builtin to convert a size to an int, note the reverse operation is not possible. - printf("self#arrs[%d][%d] = %d", ival, idxs[i], v); - } - } -} -``` - -### Multicast -Multicast groups are sets of ports which are used in the `generate_ports` statement. There are two ways to define a multicast group: -* The expression `{0,4,7}` specifies a group value with the entries 0, 4 and 7. Any number of entries are allowed, but all entries must be constant integers (i.e. the syntax `{0, 4, port_id}` is not allowed) -* The expression `flood x` takes an integer `x` and generates a group corresponding to every port _except_ x. Unlike group value expressions, `x` is allowed to be computed dynamically (i.e. `flood port_id` is allowed). - -For example, this: `generate_ports(flood(ingress_port), my_event);` generates my_event to all ports except ingress_port. - -### Tuples -Lucid also supports tuples, for example: -``` -tuple<> my_tup = (1, 2, 3); - -fun int add(auto pair) { - return pair#0 + pair#1 + pair#2; -} -``` - -## Interpreter -The interpreter runs a Lucid program on an event input trace in a simulated network. The trace and network are defined in a json specification file. - -### Event inputs -The "events" field is a list of events to input to the simulator. Each event is a dictionary that defines a single event value, plus metadata about when and where it arrives to the network. For example: - -``` -{ - "events": [ - {"name":"my_event", "args":[1], "locations": ["0:1"], "timestamp": 1000}, - {"name":"my_event", "args":[2], "locations": ["0:2"], "timestamp": 2000} - ] -} -``` -This event trace contains two instances of the event "my_event", the first with an argument of 1, arriving at switch 0 port 1 at time 1000. - -### Unparsed packet events -The interpreter also supports "packet" events that contain only an unparsed bytestring. Packet events are how you invoke the parser of a lucid program in the interpreter. The json record for a packet event has the following form: `{"type":"packet", "bytes": HEX_STRING}`. - -For example: `{"type":"packet", "bytes":"0000000000030000000000040800", "locations": ["0:1"], "timestamp": 1000}` -This is a 14 byte packet (an ethernet header with dst_mac = 3, src_mac = 4, and ether_type = 0x0800). - -The hex bytes in a packet event are interpreted in raw network-order, i.e., left-to-right. - -### Control command events -Control commands read and write globals from the control plane. They model the control program that manages a Lucid data plane. There are a few predefined control events: "Array.get", "Array.set", and "Table.install". The json formats are: - -#### Array.get - -`{"type": "command", "name":"Array.get", "args":{"array":"myarr", "index":0}}` - -This fetches the value stored at index `0` of `myarr`, i.e., it is the equivalent of `Array.get(myarr, 0);` in a Lucid program. - -#### "Array.set" - -`{"type": "command", "name":"Array.set", "args":{"array":"A", "index":n, "value":[v]}}` - -sets `A[n]` to `v`. Note that the value field takes a _list_ containing a single integer. - -#### "Table.install" -Given a table: - -``` -global Table.t<> tbl = Table.create(sz, actions, default_action, default_data); -``` - -The table install command has the syntax: -```json -{"type": "command", "name":"Table.install", "args":{"table":"tbl", "key":[v0, v1, ..., vn], "mask":[m0, m1, ..., mn], "action":"tbl.acn_foo", "args":[arg1, ..., argl]}} -``` -This command installs an entry into `tbl` where the entry key is defined by `[v0, v1, ..., vn]` with mask `[m0, m1, ..., mn]`. Key and mask values are either ints (which are parsed as int<32>) or width-tagged int strings, e.g., "1<<8>>" for 1 as an 8-bit int. Note that "mask" is optional. - -The action is named "acn_foo", which must appear in the Table.create action list. Note that the action must be prefixed by the table name. - -### Network topology -By default, the interpreter runs a single switch that can receive and generate events for any port. In other words, `generate_port(3, ...)` will work even if port 3 is not declared anywhere. The interpreter can also simulate a multi-node topology by including a topology block. A topology consists of nodes and links. - -#### Nodes and links -The nodes block maps node ids to configurations. Node IDs must be contiguous starting from 0. Each node contains "ports" and "externs" fields. There are 3 kinds of ports: "link" ports, which may connect to other nodes inside the simulator, "recirc" ports, where an event to that port will recirculate to the same node, and "interface" ports, which connect to posix interfaces outside of the simulator. - -The "links" field of "topology" is a dictionary of bidirectional links, e.g., `links : {"0:1" : "1:0", "1:1" : "2:1"}` connects switch 0 port 1 with switch 1 port 0, and switch 1 port 1 with switch 2 port 1. - -An example of a complete specification using a topology block is below: - -```json -{ - "topology": { - "nodes": { - "0": { - "externs":{"foo":0}, - "ports": { - "0" : {"type": "link"}, - "1" : {"type": "link"}, - "2" : {"type": "recirc"}, - "3" : {"type": "interface", "ifname":"veth0"} - } - }, - "1": { - "externs":{"foo":1}, - "ports": { - "0" : {"type": "link"}, - "1" : {"type": "link"}, - "2" : {"type": "recirc"} - } - } - }, - "links": [ - {"0:1": "1:0"} - ] - }, - "events": [ - {"name":"my_event", "args":[1], "locations": ["0:0"], "timestamp": 1000}, - {"name":"my_event", "args":[2], "locations": ["1:1"], "timestamp": 1200} - ] -} -``` - -### Other specification fields -`"default_input_gap": N` controls the amount of time between events in the simulation. Defaults to 1000. -`"random_seed": N` controls the seed of the RNG, defaults to random based on current system time. -`"max time": N` controls how long the simulation runs, defaults to 10000. - -### Interpreter output -The interpreter outputs a timestampped log of events received by nodes and printfs. At the end of execution, the interpreter prints: 1) a list of exit events at node, which are events generated to ports (with `generate_port`) not connected to other nodes or interfaces; 2) the final state of all globals in each node. - -## End-to-end interpreter workflow example -A small but complete example: a per-port packet counter that also reflects each packet back out its ingress port. Shows how a program, its spec file, and the interpreter's output line up. - -**Program** (`portct.dpt`): -``` -type eth_hdr_t = {int<48> dmac; int<48> smac; int<16> ety;} - -global Array.t<32> port_cts = Array.create(8); - -memop incr(int mv, int by) { return mv + by; } - -packet event eth_pkt(eth_hdr_t eth, Payload.t pl); - -handle eth_pkt(eth_hdr_t eth, Payload.t pl) { - Array.setm(port_cts, ingress_port, incr, 1); - printf("port %d saw a packet (smac=%d)", ingress_port, eth#smac); - generate_port(ingress_port, eth_pkt(eth, pl)); -} - -parser main(bitstring pkt) { - eth_hdr_t eth = read(pkt); - match eth#ety with - | LUCID_ETHERTY -> { do_lucid_parsing(pkt); } - | _ -> { generate(eth_pkt(eth, Payload.parse(pkt))); } -} -``` - -**Spec** (`portct.json`) — three 14-byte ethernet packets arriving on ports 1, 2, and 1: -```json -{ - "events": [ - {"type": "packet", "bytes": "0000000000020000000000010800", "locations": ["0:1"], "timestamp": 1000}, - {"type": "packet", "bytes": "0000000000010000000000020800", "locations": ["0:2"], "timestamp": 2000}, - {"type": "packet", "bytes": "0000000000020000000000010800", "locations": ["0:1"], "timestamp": 3000} - ] -} -``` - -**Run** with `./dpt portct.dpt --spec portct.json --silent`. The output (trimmed) is: -``` -t=1000: Parsing packet 0000000000020000000000010800 at switch 0, port 1 # <- parser invoked -t=1000: Handling packet event eth_pkt(2,1,2048,) at switch 0, port 1 # <- handler invoked; args = (dmac, smac, ety, payload) -port 1 saw a packet (smac=1) # <- printf from the handler -t=2000: Parsing packet 0000000000010000000000020800 at switch 0, port 2 -t=2000: Handling packet event eth_pkt(1,2,2048,) at switch 0, port 2 -port 2 saw a packet (smac=2) -t=3000: Parsing packet 0000000000020000000000010800 at switch 0, port 1 -t=3000: Handling packet event eth_pkt(2,1,2048,) at switch 0, port 1 -port 1 saw a packet (smac=1) -dpt: Final State: -Switch 0 : { - Pipeline : [ - port_cts(0) : [0u32; 2u32; 1u32; 0u32; 0u32; 0u32; 0u32; 0u32] # <- final value of port_cts: index 1 saw 2 pkts, index 2 saw 1 - ] - Events : [ ] # <- in-flight non-packet events (none) - Exits : [ - bytes(0000000000020000000000010800) at port 1, t=1600 # <- generate_port emits go here when the port isn't connected - bytes(0000000000010000000000020800) at port 2, t=2600 - bytes(0000000000020000000000010800) at port 1, t=3600 - ] - Drops : [ ] - packet events handled: 3 - total events handled: 3 -} -``` - -A few things to recognize: -- The `Handling packet event ...(2,1,2048,)` line shows the *handler's view* of the event — record fields are flattened into positional arguments in declaration order (`dmac=2, smac=1, ety=0x800`), and the trailing empty entry is the (empty) `Payload.t`. -- `printf` output appears inline at the timestamp it fired. -- `port_cts(0)` is the final value of the array on switch `0`. Indices that were never written stay at 0. -- The **Exits** list is the data-plane output: bytes emitted via `generate_port` to a port not connected to another node or interface. Verifying the right packets came out the right ports usually means scanning this list. Each row is `bytes(...) at port P, t=T` — note `T` is later than the input timestamp by the per-event processing delay (~600 in this run). -- **Drops** lists packets explicitly dropped by a parser `drop;`. Handlers that just don't generate anything do *not* appear here — they silently produce no output. - - -## The Lucid virtual switch -The lucidSwitch binary uses the Lucid interpreter to run a virtual switch that operates only on interface ports. Instead of taking a config file, lucidSwitch is configured by the per-port "interface" argument. *Note that lucidSwitch uses system time for timestamps, which are taken when the interpreter fetches an event from the interface's input queue.* -```bash -./lucidSwitch prog.dpt --interface 0:veth0 --interface 1:veth1 -``` - -## The Tofino compiler -The dptc binary compiles a Lucid program to a P4-tofino program. See the tutorials or run `./dptc --help` for more information about arguments. - From e9b40d0d4d4c74da68c8376ea2762af85a4f03b2 Mon Sep 17 00:00:00 2001 From: John Sonchack Date: Tue, 11 Aug 2026 16:46:56 -0400 Subject: [PATCH 45/49] branch overview markdown --- BRANCH_OVERVIEW.md | 140 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 140 insertions(+) create mode 100644 BRANCH_OVERVIEW.md diff --git a/BRANCH_OVERVIEW.md b/BRANCH_OVERVIEW.md new file mode 100644 index 00000000..a0f9662a --- /dev/null +++ b/BRANCH_OVERVIEW.md @@ -0,0 +1,140 @@ +### Task description + +Extend Lucid’s interpreter to support packet IO from standard network interfaces (e.g., in Linux, BSD). This will make it easy and safe to run Lucid programs on many platforms at 1-5Gb/s rates. + +Milestone(s) + +a. Integrate library for packet RX/TX from raw sockets. + +b. Convert raw packets to internal representations. + +c. Implement abstraction layer to map port identifiers to interfaces. + +d. Testing and documentation. + +### Overview of changes + +The relevant changes are all on the [26.2.interp-io](https://github.com/PrincetonUniversity/lucid/tree/26.2.interp-io) branch -- which you should be on. We will merge them into main after review. + +**Major changes** +1. Library for interpreter IO from sockets / interfaces. **(milestone a+b)** +2. New interpreter-based virtual Lucid switch that processes packets from sockets in real time. **(milestone a+b)** +3. New node-based interpreter topology configuration. **(milestone c)** +4. 12 new multi-node interpreter examples with test cases and documentation, ported from the commonly-referenced P4 tutorials. **(milestone c+d)** +5. Support for generic events, which simplify the above examples. **(milestone d)** +6. Major interpreter and frontend refactoring, and interpreter performance improvements. **(all milestones)** + +### Instructions for testing + +1. clone the repo; cd in + +git clone https://github.com/princetonuniversity/lucid +cd lucid + +2. switch to interpreter improvements branch + +git checkout 26.2.interp-io + +3. build or pull the lucid dev docker container. Build may take ~20 minutes to build ocaml + z3 + etc + +./docker/dev/dockercmd.sh build + +or + +./docker/dev/dockercmd.sh pull + +4. Spawn and enter the container, build lucid interpreter +(note the path argument at the end that mounts the repo in the container) + +./docker/dev/dockercmd.sh enter ./ +cd lucid +make + +5. Test the new interpreter-based Lucid switch on veth interfaces + +There is a simple reflector program, reflector.dpt, and a python script that starts it on the interpreter, sends packets in with tcpreplay, and measures output rate. Try them in the lucid dev container: + +``` +(base) johnsonchack@Johns-MBP-2 lucid % ./docker/dev/dockercmd.sh enter ./ +To run a command as administrator (user "root"), use "sudo ". +See "man sudo_root" for details. + +ubuntu@dc89b9424462:~$ cd lucid +ubuntu@dc89b9424462:~/lucid$ cd examples/features/lucidvswitch/ +ubuntu@dc89b9424462:~/lucid/examples/features/lucidvswitch$ ls +__pycache__ interpio.md readme.md recv.pcap reflector.dpt send.pcap switch_profile.txt test_reflector.py +ubuntu@dc89b9424462:~/lucid/examples/features/lucidvswitch$ python3 test_reflector.py +[+] Removed old pcap: /home/ubuntu/lucid/examples/features/lucidvswitch/send.pcap +[+] Removed old pcap: /home/ubuntu/lucid/examples/features/lucidvswitch/recv.pcap +[+] Wrote 10000 packets to /home/ubuntu/lucid/examples/features/lucidvswitch/send.pcap +[+] feth0 and feth1 are up +[+] Started tcpdump on feth1, waiting for switch to initialize... +[+] Switch initialized +[+] Sent 10000 packets on feth1 +[*] Sent: 10000 packets, Received: 5102 packets +[-] FAIL: packet counts do not match +[*] Throughput: 125705 pps, 1029.98 Mbps (over 0.0406s) +``` +Note, packet drops will probably happen because the test script just replays at a high throughput. + +6. Test the new interpreter topology configuration with the examples ported from P4 BMv2. We chose these examples because many of them were focused on multi-node programs, which is also the point of topology configuration in the Lucid interpreter. +From the repo root inside the dev container, run: +``` +ubuntu@dc89b9424462:~/lucid$ cd examples/p4_bmv2_examples/ +ubuntu@dc89b9424462:~/lucid/examples/p4_bmv2_examples$ python3 test.py +Running 11 example test(s): + PASS basic + PASS basic_tunnel + PASS calc + PASS ecn + PASS flowcache + PASS link_monitor + PASS load_balance + PASS mri + PASS multicast + PASS qos + PASS source_routing + +11 passed, 0 failed, 11 total +``` +Each example is inside its own directory in "p4_bmv2_examples", with a little readme and some helpers to construct the topology. + + +### More details on changes and new features + +Everything described here is exercised in the testing instructions above, this is just extra info. + +1. Added interpreter IO from sockets / interfaces. **(milestone a+b)** +- Integrated the rawlink library for ocaml raw sockets ([https://opam.ocaml.org/packages/rawlink/](https://opam.ocaml.org/packages/rawlink/)) +- Added custom wrapper and I/O connectors to interpreter’s event loop +- Code references: + - Vendored rawlink lib: [https://github.com/PrincetonUniversity/lucid/tree/26.2.interp-io/vendor/rawlink](https://github.com/PrincetonUniversity/lucid/tree/26.2.interp-io/vendor/rawlink) + - Rawlink wrapper: [https://github.com/PrincetonUniversity/lucid/blob/26.2.interp-io/src/lib/midend/interpreter/InterpSocket.ml](https://github.com/PrincetonUniversity/lucid/blob/26.2.interp-io/src/lib/midend/interpreter/InterpSocket.ml) + - Integration with Rawlink wrapper at various points in interpreter: [https://github.com/PrincetonUniversity/lucid/tree/26.2.interp-io/src/lib/midend/interpreter](https://github.com/PrincetonUniversity/lucid/tree/26.2.interp-io/src/lib/midend/interpreter) +2. New interpreter-based Lucid switch that processes packets from sockets in real time. Benchmarks on an M3 macbook pro for a simple program are around 2Gbps. **(milestone a+b+d)** +- Code references: + - lucidSwitch binary: [https://github.com/PrincetonUniversity/lucid/blob/26.2.interp-io/src/bin/lucidSwitch.ml](https://github.com/PrincetonUniversity/lucid/blob/26.2.interp-io/src/bin/lucidSwitch.ml) (short, but relies on new code paths in interpreter backend) + - lucidSwitch test / benchmark example: [https://github.com/PrincetonUniversity/lucid/tree/26.2.interp-io/examples/features/lucidvswitch](https://github.com/PrincetonUniversity/lucid/tree/26.2.interp-io/examples/features/lucidvswitch) + +3. New node-based interpreter topology configuration. **(milestone c)** +- This allows the user to define a simulated multi-node (i.e., multi-switch) topology to run the interpreter on by declaring the configuration of each node, then the topology of links connecting the nodes. The implementation formalizes the config options as OCaml datatypes and will be extensible, e.g., to support simulations where different nodes run different Lucid programs. +- Code references: + - Internal representation of interpreter network topologies: [https://github.com/PrincetonUniversity/lucid/blob/26.2.interp-io/src/lib/midend/interpreter/InterpTopo.ml](https://github.com/PrincetonUniversity/lucid/blob/26.2.interp-io/src/lib/midend/interpreter/InterpTopo.ml) + - A simple example: [https://github.com/PrincetonUniversity/lucid/tree/26.2.interp-io/examples/features/topology\_configs](https://github.com/PrincetonUniversity/lucid/tree/26.2.interp-io/examples/features/topology_configs) +4. Added 12 new multi-node interpreter examples, from BMv2 tutorial, with test cases and documentation. **(milestone c+d)** +- [https://github.com/PrincetonUniversity/lucid/tree/26.2.interp-io/examples/p4\_bmv2\_examples](https://github.com/PrincetonUniversity/lucid/tree/26.2.interp-io/examples/p4_bmv2_examples) +5. To better support the above examples, we added generic events **(milestone d)** +- This involved completing two language features that were previously partially implemented: polymorphic event arguments and tuples. +- Together, they let Lucid programs define generic events and handlers, e.g., an IP packet handler that is generic with respect to the type of the underlay network, or a source routing handler that is generic with respect to the length of the source routing header’s tail. +- Generic events are used in several of the new multi-node interpreter examples, e.g., source routing (the “auto” parameter is polymorphic and allows the programmer to write 1 event and handler regardless of how many records are in the sr\_tail header): [https://github.com/PrincetonUniversity/lucid/blob/26.2.interp-io/examples/p4\_bmv2\_examples/source\_routing/source\_routing.dpt\#L86](https://github.com/PrincetonUniversity/lucid/blob/26.2.interp-io/examples/p4_bmv2_examples/source_routing/source_routing.dpt#L86) +- Code references: + - New code is interleaved in frontend, start from tuple construction in the parser: [https://github.com/PrincetonUniversity/lucid/blob/26.2.interp-io/src/lib/frontend/Parser.mly\#L345](https://github.com/PrincetonUniversity/lucid/blob/26.2.interp-io/src/lib/frontend/Parser.mly#L345) , and trace through the frontend pipeline up to the point where tuples are eliminated [https://github.com/PrincetonUniversity/lucid/blob/26.2.interp-io/src/lib/frontend/FrontendPipeline.ml\#L119](https://github.com/PrincetonUniversity/lucid/blob/26.2.interp-io/src/lib/frontend/FrontendPipeline.ml#L119) +6. Interpreter and frontend refactoring / technical debt cleanup **(milestones c \+ d)** +- The interpreter was refactored from a monolithic architecture into “switch” and “network” modules. This makes the interpreter’s code structure match the computation and communication model of Lucid, and also improves the interpreter’s extensibility / maintainability. + - Code references: + - InterpSwitch and interpNetwork: + - [https://github.com/PrincetonUniversity/lucid/blob/26.2.interp-io/src/lib/midend/interpreter/InterpSwitch.ml](https://github.com/PrincetonUniversity/lucid/blob/26.2.interp-io/src/lib/midend/interpreter/InterpSwitch.ml) + - [https://github.com/PrincetonUniversity/lucid/blob/26.2.interp-io/src/lib/midend/interpreter/InterpNetwork.ml](https://github.com/PrincetonUniversity/lucid/blob/26.2.interp-io/src/lib/midend/interpreter/InterpNetwork.ml) + - Interpreter architecture overview: [https://github.com/PrincetonUniversity/lucid/blob/26.2.interp-io/docs/interp-arch.md](https://github.com/PrincetonUniversity/lucid/blob/26.2.interp-io/docs/interp-arch.md) +- The frontend was refactored to remove \~1K LoC related to match-action tables, which were previously hard-coded into Lucid’s AST but now, with tuples, can be represented as a “builtin library” similar to arrays. + - Most changes here are concentrated into this commit: [https://github.com/PrincetonUniversity/lucid/commit/54a179834ea6c4890b2f48c93dd280e0d4d8a163](https://github.com/PrincetonUniversity/lucid/commit/54a179834ea6c4890b2f48c93dd280e0d4d8a163) From 33f70849bc59061c198d2ef5adc9458ee0010ace Mon Sep 17 00:00:00 2001 From: John Sonchack Date: Tue, 11 Aug 2026 16:48:53 -0400 Subject: [PATCH 46/49] nit --- BRANCH_OVERVIEW.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/BRANCH_OVERVIEW.md b/BRANCH_OVERVIEW.md index a0f9662a..75c82fb7 100644 --- a/BRANCH_OVERVIEW.md +++ b/BRANCH_OVERVIEW.md @@ -111,7 +111,7 @@ Everything described here is exercised in the testing instructions above, this i - Vendored rawlink lib: [https://github.com/PrincetonUniversity/lucid/tree/26.2.interp-io/vendor/rawlink](https://github.com/PrincetonUniversity/lucid/tree/26.2.interp-io/vendor/rawlink) - Rawlink wrapper: [https://github.com/PrincetonUniversity/lucid/blob/26.2.interp-io/src/lib/midend/interpreter/InterpSocket.ml](https://github.com/PrincetonUniversity/lucid/blob/26.2.interp-io/src/lib/midend/interpreter/InterpSocket.ml) - Integration with Rawlink wrapper at various points in interpreter: [https://github.com/PrincetonUniversity/lucid/tree/26.2.interp-io/src/lib/midend/interpreter](https://github.com/PrincetonUniversity/lucid/tree/26.2.interp-io/src/lib/midend/interpreter) -2. New interpreter-based Lucid switch that processes packets from sockets in real time. Benchmarks on an M3 macbook pro for a simple program are around 2Gbps. **(milestone a+b+d)** +2. New interpreter-based Lucid switch that processes packets from sockets in real time. Benchmarks on an M3 macbook pro for a simple program are around 1Gbps. **(milestone a+b+d)** - Code references: - lucidSwitch binary: [https://github.com/PrincetonUniversity/lucid/blob/26.2.interp-io/src/bin/lucidSwitch.ml](https://github.com/PrincetonUniversity/lucid/blob/26.2.interp-io/src/bin/lucidSwitch.ml) (short, but relies on new code paths in interpreter backend) - lucidSwitch test / benchmark example: [https://github.com/PrincetonUniversity/lucid/tree/26.2.interp-io/examples/features/lucidvswitch](https://github.com/PrincetonUniversity/lucid/tree/26.2.interp-io/examples/features/lucidvswitch) From 049436b350dd264bd93c10241e1cf013d5c8ce11 Mon Sep 17 00:00:00 2001 From: John Sonchack Date: Tue, 11 Aug 2026 16:50:53 -0400 Subject: [PATCH 47/49] formatting --- BRANCH_OVERVIEW.md | 40 +++++++++++++++++++++++++--------------- 1 file changed, 25 insertions(+), 15 deletions(-) diff --git a/BRANCH_OVERVIEW.md b/BRANCH_OVERVIEW.md index 75c82fb7..320443c8 100644 --- a/BRANCH_OVERVIEW.md +++ b/BRANCH_OVERVIEW.md @@ -28,42 +28,48 @@ The relevant changes are all on the [26.2.interp-io](https://github.com/Princeto 1. clone the repo; cd in +``` git clone https://github.com/princetonuniversity/lucid cd lucid - +``` 2. switch to interpreter improvements branch +``` git checkout 26.2.interp-io - +``` 3. build or pull the lucid dev docker container. Build may take ~20 minutes to build ocaml + z3 + etc -./docker/dev/dockercmd.sh build +``` +./docker/dev/dockercmd.sh build +``` or +``` ./docker/dev/dockercmd.sh pull - +``` 4. Spawn and enter the container, build lucid interpreter (note the path argument at the end that mounts the repo in the container) +``` ./docker/dev/dockercmd.sh enter ./ cd lucid make +``` 5. Test the new interpreter-based Lucid switch on veth interfaces There is a simple reflector program, reflector.dpt, and a python script that starts it on the interpreter, sends packets in with tcpreplay, and measures output rate. Try them in the lucid dev container: ``` -(base) johnsonchack@Johns-MBP-2 lucid % ./docker/dev/dockercmd.sh enter ./ -To run a command as administrator (user "root"), use "sudo ". -See "man sudo_root" for details. +cd lucid +cd examples/features/lucidvswitch/ +python3 test_reflector.py +``` -ubuntu@dc89b9424462:~$ cd lucid -ubuntu@dc89b9424462:~/lucid$ cd examples/features/lucidvswitch/ -ubuntu@dc89b9424462:~/lucid/examples/features/lucidvswitch$ ls -__pycache__ interpio.md readme.md recv.pcap reflector.dpt send.pcap switch_profile.txt test_reflector.py -ubuntu@dc89b9424462:~/lucid/examples/features/lucidvswitch$ python3 test_reflector.py +The output should be something like: + +``` [+] Removed old pcap: /home/ubuntu/lucid/examples/features/lucidvswitch/send.pcap [+] Removed old pcap: /home/ubuntu/lucid/examples/features/lucidvswitch/recv.pcap [+] Wrote 10000 packets to /home/ubuntu/lucid/examples/features/lucidvswitch/send.pcap @@ -75,13 +81,17 @@ ubuntu@dc89b9424462:~/lucid/examples/features/lucidvswitch$ python3 test_reflect [-] FAIL: packet counts do not match [*] Throughput: 125705 pps, 1029.98 Mbps (over 0.0406s) ``` -Note, packet drops will probably happen because the test script just replays at a high throughput. +Note: packet drops will probably happen because the test script just replays at a high throughput. 6. Test the new interpreter topology configuration with the examples ported from P4 BMv2. We chose these examples because many of them were focused on multi-node programs, which is also the point of topology configuration in the Lucid interpreter. From the repo root inside the dev container, run: ``` -ubuntu@dc89b9424462:~/lucid$ cd examples/p4_bmv2_examples/ -ubuntu@dc89b9424462:~/lucid/examples/p4_bmv2_examples$ python3 test.py +cd examples/p4_bmv2_examples/ +python3 test.py +``` + +The output should look like: +``` Running 11 example test(s): PASS basic PASS basic_tunnel From ace22631a0f9bc99d0f62e28f1ed5ef4e8c72ead Mon Sep 17 00:00:00 2001 From: John Sonchack Date: Tue, 11 Aug 2026 16:52:37 -0400 Subject: [PATCH 48/49] formatting --- BRANCH_OVERVIEW.md | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/BRANCH_OVERVIEW.md b/BRANCH_OVERVIEW.md index 320443c8..a3c2c5b5 100644 --- a/BRANCH_OVERVIEW.md +++ b/BRANCH_OVERVIEW.md @@ -1,6 +1,6 @@ -### Task description +## Branch description -Extend Lucid’s interpreter to support packet IO from standard network interfaces (e.g., in Linux, BSD). This will make it easy and safe to run Lucid programs on many platforms at 1-5Gb/s rates. +This branch extends Lucid’s interpreter to support packet IO from standard network interfaces (e.g., in Linux, BSD). This will make it easy and safe to run Lucid programs on many platforms at 1-5Gb/s rates. Milestone(s) @@ -14,7 +14,7 @@ d. Testing and documentation. ### Overview of changes -The relevant changes are all on the [26.2.interp-io](https://github.com/PrincetonUniversity/lucid/tree/26.2.interp-io) branch -- which you should be on. We will merge them into main after review. +The relevant changes for the above milestones are all on this branch -- [26.2.interp-io](https://github.com/PrincetonUniversity/lucid/tree/26.2.interp-io). We will merge them into main after review. **Major changes** 1. Library for interpreter IO from sockets / interfaces. **(milestone a+b)** From ca73bcff5597bf080fb579fb171ad1b4e49c5e8e Mon Sep 17 00:00:00 2001 From: John Sonchack Date: Tue, 11 Aug 2026 16:59:18 -0400 Subject: [PATCH 49/49] note --- BRANCH_OVERVIEW.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/BRANCH_OVERVIEW.md b/BRANCH_OVERVIEW.md index a3c2c5b5..0147d524 100644 --- a/BRANCH_OVERVIEW.md +++ b/BRANCH_OVERVIEW.md @@ -14,7 +14,7 @@ d. Testing and documentation. ### Overview of changes -The relevant changes for the above milestones are all on this branch -- [26.2.interp-io](https://github.com/PrincetonUniversity/lucid/tree/26.2.interp-io). We will merge them into main after review. +The relevant changes for the above milestones are all on this branch -- [26.2.interp-io](https://github.com/PrincetonUniversity/lucid/tree/26.2.interp-io). We will merge the updates into main after review, and also integrate the notes in this document and the new examples into the appropriate sections of the tutorials / wiki. **Major changes** 1. Library for interpreter IO from sockets / interfaces. **(milestone a+b)**