mk_vocabulary

#! /usr/bin/perl

# Ensure that both mkbootmsg.c & bincode.asm talk about the same thing.

@callback = qw (
  KeyEvent MenuInit InfoBoxInit InfoBoxDone
  ProgressInit ProgressDone ProgressUpdate
  PasswordInit PasswordDone
  Timeout Timer
);

@primary = qw (
  [ ] def if ifelse loop repeat for forall exit return array get put length
  dup pop exch rot roll over index exec
  add sub mul div mod neg abs min max and or xor not shl shr
  eq ne gt ge lt le
  trace dtrace
  malloc free realloc memsize dumpmem
  gettype settype
  screen.size image.colors vscreen.size monitorsize displaysizes screen.framebuffer
  moveto currentpoint lineto setcolor currentcolor putpixel getpixel
  setfont currentfont fontheight strsize show settextmodecolor
  image loadpalette setpalette getpalette
  settransparentcolor
  savescreen restorescreen
  fillrect
  snprintf
  edit.init edit.done edit.input edit.showcursor edit.hidecursor edit.redraw
  edit.getleft
  rmoveto strstr

  sound.getvolume sound.setvolume
  sound.getsamplerate sound.setsamplerate
  sound.play sound.done
  mod.load mod.play mod.playsample
  wav.play wav.playlater

  settextwrap currenttextwrap
  seteotchar currenteotchar
  settextcolors currenttextcolors
  setmaxrows currentmaxrows
  formattext
  gettextrows setstartrow
  getlinks
  setlink currentlink
  getlink
  lineheight
  currenttitle

  usleep notimeout
  time date
  idle
  image.size

  eject poweroff reboot

  64bit

  getbyte putbyte getword putword getdword putdword
  inbyte outbyte
  findfile filesize getcwd chdir mount

  setmode currentmode videomodeinfo videomodes
  colorbits

  setimage currentimage

  settransparency currenttransparency

  unpackimage

  keepmode

  blend

  memcpy sysconfig _readsector sysinfo

  getkey serial.init serial.putc serial.setconfig serial.getbaud

  realpath systempath

  xxx test1 test2 test3 test4 test5 test6

);

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

sub canon_name;

if($ARGV[0] eq '-a') {
  printf "cb_functions\t\tequ %u\n", @callback + 0;
  printf "prim_functions\t\tequ %u\n\n", @primary + 3;

  $i = 0;
  for (@callback) {
    $c = canon_name $_;
    $s = "";
    $s .= "\t" if length $c < 3;
    $s .= "\t" if length $c < 11;
    print "cb_$c$s\tequ $i\n";
    $i++;
  }

  print "\n%macro\t\t\tprim_jump_table 0\n";
  print "jt_p_none\t\tdw 0\t\t\t; 00h\njt_p_code\t\tdw 0\t\t\t; 01h\njt_p_ret\t\tdw 0\t\t\t; 02h\n";
  $i = 3;
  for (@primary) {
    $c = canon_name $_;
    $s = "";
    $s .= "\t" if length $c < 3;
    $s .= "\t" if length $c < 11;
    $t = "";
    $t .= "\t" if length $_ < 8;
    print "jt_p_$c$s\tdw prim_$c$t\t; ";
    printf "%02xh\n", $i++
  }
  print "%endmacro\n"
}

if($ARGV[0] eq '-c') {
  print "typedef enum {\n";
  print "  p_none,\n  p_code,\n  p_ret";
  for (@primary) { $c = canon_name $_; print ",\n  p_$c" }
  print "\n} prim_t;\n\n";

  print "struct {\n  type_t type;\n  unsigned value;\n  char *name;\n} prim_names[] = {\n";

  for (@callback) {
    print "  { t_none, 0, \"$_\" },\n"
  }

  print "  { t_prim, p_code, \"{\" },\n";
  print "  { t_prim, p_ret, \"{\" }";

  for (@primary) {
    $c = canon_name $_;
    print ",\n  { t_prim, p_$c, \"$_\" }"
  }

  print "\n};\n"
}


sub canon_name
{
  local $_ = shift;

  $_ = 'astart' if $_ eq '[';
  $_ = 'aend' if $_ eq ']';
  tr/.//d;

  return $_
}