Bits.xtlm

1⍝# Bits: its macro library -- f_ields<, named bit fields.
2⍝# Imported with the functions, under one alias: "b:" u_se< "Bits".
3⍝# A macro is a function from the source text written left and right of
4⍝# its call to the source that replaces the call, run before the program
5⍝# is compiled (X_eTaL MC10). Names with m: are macros; those under h: are
6⍝# private to this file.
7
8ᵗ⁼u̲se< "Strings"
9
10lowers ← "abcdefghijklmnopqrstuvwxyz"
11uppers ← ⎕A
12letters ← lowers c̲at uppers c̲at ⎕D
13
14⍝## Parsing fields
15
16⍝# A field's name and width, from "name:width".
17ʰn̲ame ← { f → (f̲irst w̲here f = f̲irst ":") − 1 } 
18ʰf̲ieldName ← { f → (ʰn̲ame f) t̲ake f }
19ʰf̲ieldWidth ← { f → f̲loor f̲irst n̲umbers (1 + ʰn̲ame f) d̲rop f }
20
21⍝# Whether a field is "name:width": a lowercase name of letters and
22⍝# digits, a whole width.
23ʰf̲ield? ← { f →
24  1 ≠ t̲ally w̲here f = f̲irst ":" ? 0 = 1
25  n ← ʰf̲ieldName f
26  w ← (1 + ʰn̲ame f) d̲rop f
27  (0 < t̲ally n) ∧ ((f̲irst n) m̲ember? lowers) ∧ ('∧ r̲/ n m̲ember? letters) ∧ (0 < t̲ally w) ∧ '∧ r̲/ w m̲ember? ⎕D
28}
29
30⍝## The macro
31
32⍝# The function names for a field: m_ode and s_etMode for "mode".
33ʰg̲etter ← { n → "u:" c̲at (1 t̲ake n) c̲at "_" c̲at 1 d̲rop n }
34ʰs̲etter ← { n → up ← f̲irst (lowers i̲ndexOf 1 t̲ake n) s̲elect uppers◆ "u:s_et" c̲at up c̲at 1 d̲rop n }
35
36⍝# @ b:f_ields< "flag:1 mode:3 count:12": named fields of a packed whole
37⍝# number, lowest bits first. When the program is compiled it writes,
38⍝# for each field, a getter (u:m_ode x: the field of x) and a setter
39⍝# (v u:s_etMode x: x with the field set to v), their offsets and sizes
40⍝# worked out as plain numbers, so nothing is computed about the layout
41⍝# at run time. A malformed field, or more than 62 bits, stops the
42⍝# compiler: error[bad-fields]. Nothing goes on the left (@).
43ᵐf̲ields< ← { none t →
44  ({ @ → 0 })_ none                          ⍝ the left side takes only @ (MC22)
45  fs ← ᵗw̲ords t
46  0 = t̲ally fs ? "bad-fields right" ⎕R̲EJECT "no fields: write them name:width, lowest bits first"
47  bad ← (n̲ot '{ ʰf̲ield? d̲isclose ⍵ } e̲ach fs) r̲eplicate fs
48  0 < t̲ally bad ? "bad-fields right" ⎕R̲EJECT (d̲isclose f̲irst bad) c̲at " is not a field: write name:width (a lowercase name, a whole width)"
49  ws ← '{ ʰf̲ieldWidth d̲isclose ⍵ } e̲ach fs
50  (0 < t̲ally w̲here ws = 0) ∨ 62 < '+ r̲/ ws ? "bad-fields right" ⎕R̲EJECT "the fields take " c̲at (f̲ormat '+ r̲/ ws) c̲at " bits: each 1 or more, 62 in all at most"
51  offs ← (0 c̲at -1 d̲rop '+ s̲\ ws)
52  "\n" ᵗj̲oin '{ i →
53    f ← d̲isclose i s̲elect fs
54    n ← ʰf̲ieldName f
55    div ← f̲ormat 2 ^ f̲irst i s̲elect offs
56    size ← f̲ormat 2 ^ f̲irst i s̲elect ws
57    (ʰg̲etter n) c̲at " := { x -> (x d_iv " c̲at div c̲at ") m_od " c̲at size c̲at " }\n" c̲at (ʰs̲etter n) c̲at " := { v x -> x + (" c̲at div c̲at " * v m_od " c̲at size c̲at ") - " c̲at div c̲at " * (x d_iv " c̲at div c̲at ") m_od " c̲at size c̲at " }"
58  } m̲ap r̲ange t̲ally fs
59}