File: mk_vocabulary

package info (click to toggle)
gfxboot 4.5.73-2
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, bullseye, sid, trixie
  • size: 21,148 kB
  • sloc: asm: 12,810; perl: 5,125; ansic: 4,018; pascal: 2,266; makefile: 569; xml: 256; sh: 235
file content (155 lines) | stat: -rwxr-xr-x 3,370 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
#! /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 $_
}