usr/klibc/syscalls.pl

#!/usr/bin/perl
#
# Script to parse the SYSCALLS file and generate appropriate
# stubs.
#
# Pass 1: generate the C array of sizes
# Pass 2: generate the syscall stubs and other output
#

#
# Convert a string to a C array of characters,
# e.g. foo -> 'f','o','o','\0',
#
sub chararray($) {
    use bytes;

    my($s) = @_;
    my($i, $c);
    my($a) = '';

    for ($i = 0; $i < length($s); $i++) {
	$c = substr($s, $i, 1);
	if (ord($c) < 32 || ord($c) > 126) {
	    $a .= sprintf("0x%02x,", ord($c));
	} elsif ($c eq "\\" || $c eq "\'") {
	    $a .= "\'\\$c\',";
	} else {
	    $a .= "\'$c\',";
	}
    }

    return $a;
}

#
# This extracts an ASCIIZ string for the type and the additional
# information.  This is open-coded, because unpack("Z*") apparently
# is broken in Perl 5.6.1.
#
sub get_one_type($) {
    use bytes;

    my($typestr) = @_;
    my $i, $c;
    my $l = length($typestr);

    for ($i = 0; $i < $l-3; $i++) {
	$c = substr($typestr, $i, 1);
	if ($c eq "\0") {
	    return (substr($typestr, 0, $i),
		    unpack("CC", substr($typestr, $i+1, 2)),
		    substr($typestr, $i+3));
	}
    }

    return (undef, undef, undef, undef);
}

$v = $ENV{'KBUILD_VERBOSE'};
$quiet = defined($v) && ($v == 0) ? 1 : undef;

@args = ();
undef $pass;
for $arg ( @ARGV ) {
    if ( $arg =~ /^-/ ) {
	if ( $arg eq '-q' ) {
	    $quiet = 1;
	} elsif ( $arg eq '-v' ) {
	    $quiet = 0;
	} elsif ( $arg =~ /\-([0-9]+)$/ ) {
	    $pass = $1+0;
	} else {
	    die "$0: Unknown option: $arg\n";
	}
    } else {
	push(@args, $arg);
    }
}
($file, $sysstub, $arch, $bits, $unistd, $outputdir,
 $havesyscall, $typesize) = @args;

if (!$pass) {
    die "$0: Need to specify pass\n";
}

$quiet = ($pass != 2) unless defined($quiet);

require "$sysstub";

if (!open(UNISTD, "< $unistd\0")) {
    die "$0: $unistd: $!\n";
}

while ( defined($line = <UNISTD>) ) {
    chomp $line;

    if ( $line =~ /^\#\s*define\s+__NR_([A-Za-z0-9_]+)\s+(.*\S)\s*$/ ) {
	$syscalls{$1} = $2;
	print STDERR "SYSCALL FOUND: $1\n" unless ( $quiet );
    }
}
close(UNISTD);

if ($pass == 2) {
    use bytes;

    if (!open(TYPESIZE, "< $typesize\0")) {
	die "$0: $typesize: $!\n";
    }

    binmode TYPESIZE;

    $len = -s TYPESIZE;
    if (read(TYPESIZE, $typebin, $len) != $len) {
	die "$0: $typesize: short read: $!\n";
    }
    close(TYPESIZE);

    $ix = index($typebin, "\x7a\xc8\xdb\x4e\x97\xb4\x9c\x19");
    if ($ix < 0) {
	die "$0: $typesize: magic number not found\n";
    }

    # Remove magic number and bytes before it
    $typebin = substr($typebin, $ix+8);

    # Expand the types until a terminating null
    %typesize = ();
    while (1) {
	my $n, $sz, $si;
	($n, $sz, $si, $typebin) = get_one_type($typebin);
	last if (length($n) == 0);
	$typesize{$n} = $sz;
	$typesign{$n} = $si;
	print STDERR "TYPE $n: size $sz, sign $si\n" unless ($quiet);
    }
} else {
    # List here any types which should be sized even if they never occur
    # in any system calls at all.
    %type_list = ('int' => 1, 'long' => 1, 'long long' => 1,
		  'void *' => 1,
		  'intptr_t' => 1, 'uintptr_t' => 1,
		  'intmax_t' => 1, 'uintmax_t' => 1);
}

if ($pass == 2) {
    if (!open(HAVESYS, "> $havesyscall\0")) {
	die "$0: $havesyscall: $!\n";
    }

    print HAVESYS "#ifndef _KLIBC_HAVESYSCALL_H\n";
    print HAVESYS "#define _KLIBC_HAVESYSCALL_H 1\n\n";
}

if (!open(FILE, "< $file\0")) {
    die "$0: $file: $!\n";
}


if ($pass == 2) {
    print "syscall-objs := ";
}


while ( defined($line = <FILE>) ) {
    chomp $line;
    $line =~ s/\s*(|\#.*|\/\/.*)$//; # Strip comments and trailing blanks
    next unless $line;

    if ( $line =~ /^\s*(\<[^\>]+\>\s+|)([A-Za-z0-9_\*\s]+)\s+([A-Za-z0-9_,]+)(|\@[A-Za-z0-9_]+)(|\:\:[A-Za-z0-9_]+)\s*\(([^\:\)]*)\)\s*\;$/ ) {
	$archs  = $1;
	$type   = $2;
	$snames = $3;
	$stype  = $4;
	$fname  = $5;
	$argv   = $6;

	$doit  = 1;
	$maybe = 0;
	if ( $archs ne '' ) {
	    die "$file:$.: Invalid architecture spec: <$archs>\n"
		unless ( $archs =~ /^\<(|\?)(|\!)([^\>\!\?]*)\>/ );
	    $maybe = $1 ne '';
	    $not = $2 ne '';
	    $list = $3;

	    $doit = $not || ($list eq '');

	    @list = split(/,/, $list);
	    foreach  $a ( @list ) {
		if ( $a eq $arch || $a eq $bits ) {
		    $doit = !$not;
		    last;
		}
	    }
	}
	next if ( ! $doit );

	undef $sname;
	foreach $sn ( split(/,/, $snames) ) {
	    if ( defined $syscalls{$sn} ) {
		$sname = $sn;
		last;
	    }
	}
	if ( !defined($sname) ) {
	    next if ( $maybe );
	    die "$file:$.: Undefined system call: $snames\n";
	}

	$type  =~ s/\s*$//;
	$stype =~ s/^\@//;

	if ( $fname eq '' ) {
	    $fname = $sname;
	} else {
	    $fname =~ s/^\:\://;
	}

	$argv =~ s/^\s+//;
	$argv =~ s/\s+$//;

	if ($argv eq 'void') {
	    @args = ();
	} else {
	    @args = split(/\s*\,\s*/, $argv);
	}

	if ($pass == 1) {
	    # Pass 1: Add the types to the type list
	    foreach $a (@args) {
		$type_list{$a}++;
	    }
	} else {
	    # Pass 2: make sure all types defined, and actually generate stubs

	    foreach $a (@args) {
		if (!defined($typesize{$a})) {
		    die "$0: $typesize: type name missing: $a\n";
		}
	    }

	    print HAVESYS "#define _KLIBC_HAVE_SYSCALL_${fname} ${sname}\n";
	    print " \\\n\t${fname}.o";
	    make_sysstub($outputdir, $fname, $type, $sname, $stype, @args);
	}
    } else {
	die "$file:$.: Could not parse input: \"$line\"\n";
    }
}

if ($pass == 1) {
    # Pass 1: generate typesize.c
    if (!open(TYPESIZE, "> $typesize")) {
	die "$0: cannot create file: $typesize: $!\n";
    }

    print TYPESIZE "#include \"syscommon.h\"\n";

    # This compares -2 < 1 in the appropriate type, which is true for
    # signed types and false for unsigned types.  We use -2 and 1 since
    # gcc complains about comparing unsigned types with zero, and might
    # complain equally about -1 in the future.
    #
    # This test is valid (as in, doesn't cause the compiler to barf)
    # for pointers as well as for integral types; if we ever add system
    # calls which take any other kinds of types than that then this needs
    # to be smarter.
    print TYPESIZE "#define SIGNED(X) ((X)-2 < (X)1)\n";

    print TYPESIZE "\n";
    print TYPESIZE "const unsigned char type_sizes[] = {\n";
    print TYPESIZE "\t0x7a,0xc8,0xdb,0x4e,0x97,0xb4,0x9c,0x19, /* magic */\n";
    foreach $t (sort(keys(%type_list))) {
	print TYPESIZE "\t", chararray($t), "0, sizeof($t), SIGNED($t),\n";
    }
    print TYPESIZE "\t0, 0,\n";	# End sentinel
    print TYPESIZE "};\n";
    close(TYPESIZE);
} else {
    # Pass 2: finalize output files
    print "\n";

    print HAVESYS "\n#endif\n";
    close(HAVESYS);
}
1	#!/usr/bin/perl
2	#
3	# Script to parse the SYSCALLS file and generate appropriate
4	# stubs.
5	#
6	# Pass 1: generate the C array of sizes
7	# Pass 2: generate the syscall stubs and other output
8	#
9
10	#
11	# Convert a string to a C array of characters,
12	# e.g. foo -> 'f','o','o','\0',
13	#
14	sub chararray($) {
15	use bytes;
16
17	my($s) = @_;
18	my($i, $c);
19	my($a) = '';
20
21	for ($i = 0; $i < length($s); $i++) {
22	$c = substr($s, $i, 1);
23	if (ord($c) < 32 \|\| ord($c) > 126) {
24	$a .= sprintf("0x%02x,", ord($c));
25	} elsif ($c eq "\\" \|\| $c eq "\'") {
26	$a .= "\'\\$c\',";
27	} else {
28	$a .= "\'$c\',";
29	}
30	}
31
32	return $a;
33	}
34
35	#
36	# This extracts an ASCIIZ string for the type and the additional
37	# information. This is open-coded, because unpack("Z*") apparently
38	# is broken in Perl 5.6.1.
39	#
40	sub get_one_type($) {
41	use bytes;
42
43	my($typestr) = @_;
44	my $i, $c;
45	my $l = length($typestr);
46
47	for ($i = 0; $i < $l-3; $i++) {
48	$c = substr($typestr, $i, 1);
49	if ($c eq "\0") {
50	return (substr($typestr, 0, $i),
51	unpack("CC", substr($typestr, $i+1, 2)),
52	substr($typestr, $i+3));
53	}
54	}
55
56	return (undef, undef, undef, undef);
57	}
58
59	$v = $ENV{'KBUILD_VERBOSE'};
60	$quiet = defined($v) && ($v == 0) ? 1 : undef;
61
62	@args = ();
63	undef $pass;
64	for $arg ( @ARGV ) {
65	if ( $arg =~ /^-/ ) {
66	if ( $arg eq '-q' ) {
67	$quiet = 1;
68	} elsif ( $arg eq '-v' ) {
69	$quiet = 0;
70	} elsif ( $arg =~ /\-([0-9]+)$/ ) {
71	$pass = $1+0;
72	} else {
73	die "$0: Unknown option: $arg\n";
74	}
75	} else {
76	push(@args, $arg);
77	}
78	}
79	($file, $sysstub, $arch, $bits, $unistd, $outputdir,
80	$havesyscall, $typesize) = @args;
81
82	if (!$pass) {
83	die "$0: Need to specify pass\n";
84	}
85
86	$quiet = ($pass != 2) unless defined($quiet);
87
88	require "$sysstub";
89
90	if (!open(UNISTD, "< $unistd\0")) {
91	die "$0: $unistd: $!\n";
92	}
93
94	while ( defined($line = <UNISTD>) ) {
95	chomp $line;
96
97	if ( $line =~ /^\#\sdefine\s+__NR_([A-Za-z0-9_]+)\s+(.\S)\s*$/ ) {
98	$syscalls{$1} = $2;
99	print STDERR "SYSCALL FOUND: $1\n" unless ( $quiet );
100	}
101	}
102	close(UNISTD);
103
104	if ($pass == 2) {
105	use bytes;
106
107	if (!open(TYPESIZE, "< $typesize\0")) {
108	die "$0: $typesize: $!\n";
109	}
110
111	binmode TYPESIZE;
112
113	$len = -s TYPESIZE;
114	if (read(TYPESIZE, $typebin, $len) != $len) {
115	die "$0: $typesize: short read: $!\n";
116	}
117	close(TYPESIZE);
118
119	$ix = index($typebin, "\x7a\xc8\xdb\x4e\x97\xb4\x9c\x19");
120	if ($ix < 0) {
121	die "$0: $typesize: magic number not found\n";
122	}
123
124	# Remove magic number and bytes before it
125	$typebin = substr($typebin, $ix+8);
126
127	# Expand the types until a terminating null
128	%typesize = ();
129	while (1) {
130	my $n, $sz, $si;
131	($n, $sz, $si, $typebin) = get_one_type($typebin);
132	last if (length($n) == 0);
133	$typesize{$n} = $sz;
134	$typesign{$n} = $si;
135	print STDERR "TYPE $n: size $sz, sign $si\n" unless ($quiet);
136	}
137	} else {
138	# List here any types which should be sized even if they never occur
139	# in any system calls at all.
140	%type_list = ('int' => 1, 'long' => 1, 'long long' => 1,
141	'void *' => 1,
142	'intptr_t' => 1, 'uintptr_t' => 1,
143	'intmax_t' => 1, 'uintmax_t' => 1);
144	}
145
146	if ($pass == 2) {
147	if (!open(HAVESYS, "> $havesyscall\0")) {
148	die "$0: $havesyscall: $!\n";
149	}
150
151	print HAVESYS "#ifndef _KLIBC_HAVESYSCALL_H\n";
152	print HAVESYS "#define _KLIBC_HAVESYSCALL_H 1\n\n";
153	}
154
155	if (!open(FILE, "< $file\0")) {
156	die "$0: $file: $!\n";
157	}
158
159
160	if ($pass == 2) {
161	print "syscall-objs := ";
162	}
163
164
165	while ( defined($line = <FILE>) ) {
166	chomp $line;
167	$line =~ s/\s(\|\#.\|\/\/.*)$//; # Strip comments and trailing blanks
168	next unless $line;
169
170	if ( $line =~ /^\s(\<[^\>]+\>\s+\|)([A-Za-z0-9_\\s]+)\s+([A-Za-z0-9_,]+)(\|\@[A-Za-z0-9_]+)(\|\:\:[A-Za-z0-9_]+)\s\(([^\:\)])\)\s*\;$/ ) {
171	$archs = $1;
172	$type = $2;
173	$snames = $3;
174	$stype = $4;
175	$fname = $5;
176	$argv = $6;
177
178	$doit = 1;
179	$maybe = 0;
180	if ( $archs ne '' ) {
181	die "$file:$.: Invalid architecture spec: <$archs>\n"
182	unless ( $archs =~ /^\<(\|\?)(\|\!)([^\>\!\?]*)\>/ );
183	$maybe = $1 ne '';
184	$not = $2 ne '';
185	$list = $3;
186
187	$doit = $not \|\| ($list eq '');
188
189	@list = split(/,/, $list);
190	foreach $a ( @list ) {
191	if ( $a eq $arch \|\| $a eq $bits ) {
192	$doit = !$not;
193	last;
194	}
195	}
196	}
197	next if ( ! $doit );
198
199	undef $sname;
200	foreach $sn ( split(/,/, $snames) ) {
201	if ( defined $syscalls{$sn} ) {
202	$sname = $sn;
203	last;
204	}
205	}
206	if ( !defined($sname) ) {
207	next if ( $maybe );
208	die "$file:$.: Undefined system call: $snames\n";
209	}
210
211	$type =~ s/\s*$//;
212	$stype =~ s/^\@//;
213
214	if ( $fname eq '' ) {
215	$fname = $sname;
216	} else {
217	$fname =~ s/^\:\://;
218	}
219
220	$argv =~ s/^\s+//;
221	$argv =~ s/\s+$//;
222
223	if ($argv eq 'void') {
224	@args = ();
225	} else {
226	@args = split(/\s\,\s/, $argv);
227	}
228
229	if ($pass == 1) {
230	# Pass 1: Add the types to the type list
231	foreach $a (@args) {
232	$type_list{$a}++;
233	}
234	} else {
235	# Pass 2: make sure all types defined, and actually generate stubs
236
237	foreach $a (@args) {
238	if (!defined($typesize{$a})) {
239	die "$0: $typesize: type name missing: $a\n";
240	}
241	}
242
243	print HAVESYS "#define _KLIBC_HAVE_SYSCALL_${fname} ${sname}\n";
244	print " \\\n\t${fname}.o";
245	make_sysstub($outputdir, $fname, $type, $sname, $stype, @args);
246	}
247	} else {
248	die "$file:$.: Could not parse input: \"$line\"\n";
249	}
250	}
251
252	if ($pass == 1) {
253	# Pass 1: generate typesize.c
254	if (!open(TYPESIZE, "> $typesize")) {
255	die "$0: cannot create file: $typesize: $!\n";
256	}
257
258	print TYPESIZE "#include \"syscommon.h\"\n";
259
260	# This compares -2 < 1 in the appropriate type, which is true for
261	# signed types and false for unsigned types. We use -2 and 1 since
262	# gcc complains about comparing unsigned types with zero, and might
263	# complain equally about -1 in the future.
264	#
265	# This test is valid (as in, doesn't cause the compiler to barf)
266	# for pointers as well as for integral types; if we ever add system
267	# calls which take any other kinds of types than that then this needs
268	# to be smarter.
269	print TYPESIZE "#define SIGNED(X) ((X)-2 < (X)1)\n";
270
271	print TYPESIZE "\n";
272	print TYPESIZE "const unsigned char type_sizes[] = {\n";
273	print TYPESIZE "\t0x7a,0xc8,0xdb,0x4e,0x97,0xb4,0x9c,0x19, /* magic */\n";
274	foreach $t (sort(keys(%type_list))) {
275	print TYPESIZE "\t", chararray($t), "0, sizeof($t), SIGNED($t),\n";
276	}
277	print TYPESIZE "\t0, 0,\n"; # End sentinel
278	print TYPESIZE "};\n";
279	close(TYPESIZE);
280	} else {
281	# Pass 2: finalize output files
282	print "\n";
283
284	print HAVESYS "\n#endif\n";
285	close(HAVESYS);
286	}