From 3333939d9af70b2f0c7cd69d5c8e19a82f111430 Mon Sep 17 00:00:00 2001 From: Lua Team Date: Thu, 8 Jul 1999 13:34:46 +0000 Subject: [PATCH] Imported from ../lua-3.2.tar.gz. --- COPYRIGHT | 12 +- HISTORY | 19 +- INSTALL | 36 ++- MANIFEST | 6 +- Makefile | 13 +- README | 14 +- config | 48 ++- doc/idx.html | 32 +- doc/index.html | 21 +- doc/luac.html | 118 ++++--- doc/luac.man | 107 ++++--- doc/manual.html | 926 ++++++++++++++++++++++++++++++++++++----------------- doc/readme.html | 31 ++ etc/README | 7 +- etc/bin2c.c | 9 +- etc/trace.c | 32 +- include/lauxlib.h | 8 +- include/lua.h | 29 +- include/luadebug.h | 11 +- include/lualib.h | 8 +- src/lapi.c | 268 ++++++++++------ src/lapi.h | 4 +- src/lauxlib.c | 36 ++- src/lbuffer.c | 160 +++++---- src/lbuiltin.c | 766 ++++++++++++++++++++++++++++---------------- src/ldo.c | 222 ++++++------- src/ldo.h | 6 +- src/lfunc.c | 4 +- src/lgc.c | 31 +- src/lib/Makefile | 4 +- src/lib/ldblib.c | 217 +++++++++++++ src/lib/linit.c | 17 + src/lib/liolib.c | 553 ++++++++++++++++++++------------ src/lib/lmathlib.c | 124 ++++--- src/lib/lstrlib.c | 407 +++++++++++++---------- src/llex.c | 130 +++----- src/llex.h | 12 +- src/lmem.c | 253 ++++++++------- src/lmem.h | 16 +- src/lobject.c | 76 ++++- src/lobject.h | 24 +- src/lopcodes.h | 319 ++++++++---------- src/lparser.c | 570 ++++++++++++++++++--------------- src/lparser.h | 4 +- src/lstate.c | 24 +- src/lstate.h | 32 +- src/lstring.c | 139 ++++---- src/ltable.c | 169 ++++------ src/ltable.h | 14 +- src/ltm.c | 91 +++--- src/ltm.h | 6 +- src/lua/Makefile | 4 +- src/lua/README | 24 +- src/lua/lua.c | 64 ++-- src/luac/Makefile | 6 +- src/luac/README | 31 +- src/luac/dump.c | 312 +++++++++--------- src/luac/luac.c | 99 +++--- src/luac/luac.h | 81 +++-- src/luac/opcode.c | 85 +++-- src/luac/opcode.h | 204 ++++-------- src/luac/opt.c | 241 ++++++++------ src/luac/print.c | 182 +++++------ src/luac/stubs.c | 91 ++++-- src/luac/test.c | 253 +++++++++++++++ src/lundump.c | 171 +++++----- src/lundump.h | 117 +++---- src/lvm.c | 570 ++++++++++++++------------------- src/lvm.h | 9 +- src/lzio.c | 22 +- 70 files changed, 5059 insertions(+), 3692 deletions(-) create mode 100644 doc/readme.html rewrite src/lbuffer.c (61%) create mode 100644 src/lib/ldblib.c create mode 100644 src/lib/linit.c rewrite src/lmem.c (73%) rewrite src/lopcodes.h (89%) rewrite src/luac/dump.c (61%) rewrite src/luac/luac.h (63%) rewrite src/luac/opcode.h (98%) create mode 100644 src/luac/test.c rewrite src/lundump.h (89%) diff --git a/COPYRIGHT b/COPYRIGHT index 3a1c024..65c64ac 100644 --- a/COPYRIGHT +++ b/COPYRIGHT @@ -4,14 +4,18 @@ Lua COPYRIGHT NOTICE Lua is free and non-proprietary. It can be used for both academic and commercial purposes at absolutely no cost. There are no royalties or GNU-like "copyleft" restrictions. -On the other hand, Lua is not in the public domain; TeCGraf keeps its copyright. -If you use Lua, please give us credit, but we would appreciate *not* receiving +Lua (probably) qualifies as Open Source software. +Nevertheless, Lua is not in the public domain and TeCGraf keeps its copyright. + +If you use Lua, please give us credit (a nice way to do this is to include a +logo in a web page for your product), but we would appreciate *not* receiving lengthy legal documents to sign. -The legal details are below. + +The legal details are below. =============================================================================== -Copyright (c) 1994-1998 TeCGraf, PUC-Rio. All rights reserved. +Copyright (c) 1994-1999 TeCGraf, PUC-Rio. All rights reserved. Permission is hereby granted, without written agreement and without license or royalty fees, to use, copy, modify, and distribute this software and its diff --git a/HISTORY b/HISTORY index c87a005..b01a4c4 100644 --- a/HISTORY +++ b/HISTORY @@ -1,6 +1,18 @@ -This is version 3.1. +This is Lua 3.2 + +* Changes from version 3.1 to 3.2 + ------------------------------- + + redirected all output in Lua's core to _ERRORMESSAGE and _ALERT. + + increased limit on the number of constants and globals per function + (from 2^16 to 2^24). + + debugging info (lua_debug and hooks) moved into lua_state and new API + functions provided to get and set this info. + + new debug lib gives full debugging access within Lua. + + new table functions "foreachi", "sort", "tinsert", "tremove", "getn". + + new io functions "flush", "seek". * Changes from version 3.0 to 3.1 + ------------------------------- + NEW FEATURE: anonymous functions with closures (via "upvalues"). + new syntax: - local variables in chunks. @@ -23,6 +35,7 @@ This is version 3.1. handles control-C interruptions gracefully. * Changes from version 2.5 to 3.0 + ------------------------------- + NEW CONCEPT: "tag methods". Tag methods replace fallbacks as the meta-mechanism for extending the semantics of Lua. Whereas fallbacks had a global nature, tag methods @@ -37,6 +50,7 @@ This is version 3.1. + luac can now also undump. * Changes from version 2.4 to 2.5 + ------------------------------- + io and string libraries are now based on pattern matching; the old libraries are still available for compatibility + dofile and dostring can now return values (via return statement) @@ -44,6 +58,7 @@ This is version 3.1. + expanded documentation, with more examples * Changes from version 2.2 to 2.4 + ------------------------------- + external compiler creates portable binary files that can be loaded faster + interface for debugging and profiling + new "getglobal" fallback @@ -53,11 +68,13 @@ This is version 3.1. + expanded documentation, with more examples * Changes from version 2.1 to 2.2 + ------------------------------- + functions now may be declared with any "lvalue" as a name + garbage collection of functions + support for pipes * Changes from version 1.1 to 2.1 + ------------------------------- + object-oriented support + fallbacks + simplified syntax for tables diff --git a/INSTALL b/INSTALL index 95a10dd..1c5b924 100644 --- a/INSTALL +++ b/INSTALL @@ -1,5 +1,7 @@ -* Installation +This is Lua 3.2 +* Installation + ------------ Building Lua on a Unix system should be very easy: 1. Edit "config" to suit your platform, if at all necessary. @@ -8,7 +10,7 @@ See below for instructions for Windows and Macintosh. * What you get - + ------------ If "make" succeeds, you get: * an interpreter in ./bin/lua and a compiler in ./bin/luac; * libraries in ./lib; @@ -19,26 +21,36 @@ and some useful stuff in ./etc. You don't need these directories for development. -* If you have problems (and solutions!) + See also the README files in the various subdirectories. + A convenient staring point is ./doc/readme.html. +* If you have problems (and solutions!) + ------------------------------------- If "make" fails, please let us know (lua@tecgraf.puc-rio.br). If you make changes to "config", please send them to us. * Shared libraries - + ---------------- If you are running SunOs 4.x, type the following after "make" succeeds: - ld -o lib/liblua.so.3.1 src/*.o - ld -o lib/liblualib.so.3.1 src/lib/*.o + ld -o lib/liblua.so.3.2 src/*.o + ld -o lib/liblualib.so.3.2 src/lib/*.o - If you want the interpreter to use shared libraries, then do: + If you are running Linux, type the following after "make" succeeds: + ld -o lib/liblua.so.3.2 -shared src/*.o + ld -o lib/liblualib.so.3.2 -shared src/lib/*.o + cd lib + ln -s liblua.so.3.2 liblua.so + ln -s liblualib.so.3.2 liblualib.so.3.2 + + If you want the interpreter to use shared libraries, then do this too: rm bin/lua cd src/lua; make + You may need to include lib/ in the LD_LIBRAY_PATH environment variable. - For AIX, the OpenGL clone Mesa includes a script for making shared libraries. - For other systems, please tell us how! + Building shared libraries in other systems is similar but details differ. * Installation on Windows or Macintosh - + ------------------------------------ The instructions for building Lua on a Mac or Windows machine depend on the particular compiler you are using. The simplest way is to create a folder with all .c and .h files. @@ -49,11 +61,11 @@ llex.c lmem.c lobject.c lparser.c lstate.c lstring.c ltable.c ltm.c lundump.c lvm.c lzio.c - standard lib: liolib.c lmathlib.c lstrlib.c + standard lib: linit.c ldblib.c liolib.c lmathlib.c lstrlib.c interpreter: basic lib, standard lib, lua.c - compiler: basic lib, dump.c luac.c print.c stubs.c opcode.c opt.c + compiler: basic lib, dump.c luac.c opcode.c opt.c print.c stubs.c test.c Of course, to use Lua as a library, you'll have to know how to create and use libraries with your compiler. diff --git a/MANIFEST b/MANIFEST index 7e5d11d..3b2aec5 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1,4 +1,4 @@ -MANIFEST contents of Lua 3.1 distribution on Sat Jul 11 22:48:43 EST 1998 +MANIFEST contents of Lua 3.2 distribution on Thu Jul 8 10:34:45 EST 1999 lua lua/COPYRIGHT lua/HISTORY @@ -14,6 +14,7 @@ lua/doc/index.html lua/doc/luac.html lua/doc/luac.man lua/doc/manual.html +lua/doc/readme.html lua/etc lua/etc/Makefile lua/etc/README @@ -45,6 +46,8 @@ lua/src/lgc.h lua/src/lib lua/src/lib/Makefile lua/src/lib/README +lua/src/lib/ldblib.c +lua/src/lib/linit.c lua/src/lib/liolib.c lua/src/lib/lmathlib.c lua/src/lib/lstrlib.c @@ -80,6 +83,7 @@ lua/src/luac/opcode.h lua/src/luac/opt.c lua/src/luac/print.c lua/src/luac/stubs.c +lua/src/luac/test.c lua/src/lundump.c lua/src/lundump.h lua/src/lvm.c diff --git a/Makefile b/Makefile index a8978c9..bd67221 100644 --- a/Makefile +++ b/Makefile @@ -1,8 +1,11 @@ # makefile for lua hierarchy all co clean klean: - cd include; make $@ - cd src; make $@ - cd src/luac; make $@ - cd src/lib; make $@ - cd src/lua; make $@ + cd include; $(MAKE) $@ + cd src; $(MAKE) $@ + cd src/luac; $(MAKE) $@ + cd src/lib; $(MAKE) $@ + cd src/lua; $(MAKE) $@ + +strip: + strip bin/lua* diff --git a/README b/README index 344faf7..07896c2 100644 --- a/README +++ b/README @@ -1,4 +1,7 @@ +This is Lua 3.2 + * What is Lua? + ------------ Lua is a programming language originally designed for extending applications, but also frequently used as a general-purpose, stand-alone language. Lua combines simple procedural syntax (similar to Pascal) with powerful @@ -11,12 +14,13 @@ and compiles unmodified in all known platforms. The implementation goals are simplicity, efficiency, portability, and low embedding cost. - Lua has been awarded the first prize (technological category) in the Second - Compaq Award for Research and Development in Computer Science. This award + Lua was awarded the first prize (technological category) in the Second Compaq + Award for Research and Development in Computer Science in 1997. This award is a joint venture of Compaq Computer in Brazil, the Brazilian Ministry of Science and Technology, and the Brazilian Academy of Sciences. * Availability + ------------ Lua is freely available for both academic and commercial purposes and can be downloaded from the sites below. See COPYRIGHT for details. @@ -24,19 +28,23 @@ http://csg.uwaterloo.ca/~lhf/lua/ In Brazil: ftp://ftp.tecgraf.puc-rio.br/pub/lua/lua.tar.gz In Canada: ftp://csg.uwaterloo.ca/pub/lhf/lua/lua.tar.gz + In the US: ftp://ftp.cdrom.com/pub/languages/lua/lua.tar.gz In Germany: ftp://ftp.uni-trier.de/pub/languages/lua/lua.tar.gz + In Germany: ftp://ftp.gwdg.de/pub/languages/lua/lua.tar.gz In Greece: ftp://ftp.ntua.gr/pub/lang/lua/lua.tar.gz * Installation + ------------ See INSTALL. * Contacting the authors + ---------------------- Lua has been designed and implemented by Waldemar Celes, Roberto Ierusalimschy and Luiz Henrique de Figueiredo. They can be contacted by email at lua@tecgraf.puc-rio.br. Send your comments, bug reports and anything else to lua@tecgraf.puc-rio.br. - For reporting bugs, try also the mailing list: lua-l@tecgraf.puc-rio.br + For reporting bugs, try also the mailing list: lua-l@tecgraf.puc-rio.br. To subscribe to this list, send "subscribe lua-l YOUR-NAME" to listproc@tecgraf.puc-rio.br in the body of the message (not in the subject). diff --git a/config b/config index af7feb5..fe62a51 100644 --- a/config +++ b/config @@ -1,54 +1,68 @@ # configuration file for making Lua -# == CHANGE THE SETTINGS BELOW TO SUIT YOUR ENVIRONMENT ====================== +# == CHANGE THE SETTINGS BELOW TO SUIT YOUR ENVIRONMENT ======================= -# you need an ANSI C compiler. gcc is a popular one. -CC= gcc -WARN= -ansi -Wall - -# on SGI's, cc is ANSI. -#CC= cc -#WARN= -ansi -fullwarn +# ------------------------------------------------------------------ Lua # if you need compatibility with version 2.5 or older, uncomment the line below. #COMPAT= -DLUA_COMPAT2_5 # Lua uses double for numbers. To change this, uncomment one of the lines below. +#NUMBER= -DLUA_NUM_TYPE=double #NUMBER= -DLUA_NUM_TYPE=float #NUMBER= -DLUA_NUM_TYPE=long # if you want support for pipes, uncomment the following line. #POPEN= -DPOPEN +# ------------------------------------------------------------------ C compiler + +# you need an ANSI C compiler. gcc is a popular one. +CC= gcc +WARN= -ansi -Wall + +# on IRIX, cc is a good ANSI compiler. +#CC= cc +#WARN= -ansi -fullwarn + +# on Solaris, cc is optional. you may have to add -Dsparc if you use -Xc. +#CC= cc +#WARN= -Xc # -Dsparc + +# ------------------------------------------------------------------ C library + # if your C library is not POSIX compliant, comment the following line. POSIX= -D_POSIX_SOURCE # if your C library does not have the newer ANSI functions memmove, strerror, -# and locale support (e.g., in SunOs 4.1.x.), uncomment the following line. +# and locale support, uncomment the following line. SunOs 4.1.x is one example. #OLD_ANSI= -DOLD_ANSI # in SunOs 4.1.x, standard headers in /usr/include are not ANSI, # so uncomment the following line to avoid prototypes warnings. #EXTRA_INCS= -I/usr/5include -# if your system doesn't have (or need) ranlib, change "ranlib" to "true". -# on some systems, "ar s" does it. -RANLIB= ranlib -#RANLIB= ar s -#RANLIB= true +# ------------------------------------------------------------------ librarian # this should work in all unix systems. AR= ar rcu -# == END OF USER SETTINGS. DO NOT CHANGE ANYTHING BELOW THIS LINE ============ +# if your system doesn't have (or need) ranlib, use RANLIB=true. +# on some systems, "ar s" does what ranlib would do. +RANLIB= ranlib +#RANLIB= ar s +#RANLIB= true + +# == END OF USER SETTINGS. DO NOT CHANGE ANYTHING BELOW THIS LINE ============= -VERSION= 3.1 +VERSION= 3.2 INC= $(LUA)/include LIB= $(LUA)/lib BIN= $(LUA)/bin INCS= -I$(INC) $(EXTRA_INCS) -DEFS= $(COMPAT) $(NUMBER) $(OLD_ANSI) $(EXTRA_DEFS) +DEFS= $(COMPAT) $(NUMBER) $(OLD_ANSI) $(EXTRALIB) $(EXTRA_DEFS) CFLAGS= -O2 $(WARN) $(INCS) $(DEFS) + diff --git a/doc/idx.html b/doc/idx.html index 534ce43..65b0e78 100644 --- a/doc/idx.html +++ b/doc/idx.html @@ -1,9 +1,9 @@ -Lua 3.1 Reference Manual - Word Index +Lua 3.2 Reference Manual - Word Index - +

Index

@@ -28,10 +28,10 @@ Operator precedence
PI
Pre-processor
-Tag Methods
Types and Tags
Upvalues
Visibility
+_ERRORMESSAGE
_INPUT
_OUTPUT
_STDERR
@@ -40,6 +40,7 @@ abs
acos
add event
+alert
and
appendto
arguments
@@ -59,6 +60,7 @@ character class
chunk
clock
+closefile
closing a file
collectgarbage
concatenation event
@@ -74,7 +76,6 @@ dofile
dostring
eight-bit clean
-error method
error
event
execute
@@ -82,10 +83,13 @@ exponentiation
file handles
floor
+flush
+foreachi
foreachvar
foreach
format
frexp
+funcinfo
function call
function event
function
@@ -94,6 +98,9 @@ getenv
getglobal event
getglobal
+getlocal
+getn
+getstack
gettable event
gettagmethod
gettagmethod
@@ -158,7 +165,6 @@ lua_rawsettable
lua_ref
lua_register
-lua_seterrormethod
lua_setglobal
lua_setstate
lua_settable
@@ -183,6 +189,7 @@ nil
not
number
+openfile
or
packed results
pattern item
@@ -216,10 +223,14 @@ reserved words
return statement
return
+seek
self
+setcallhook
setglobal event
setglobal
+setlinehook
setlocale
+setlocal
settable event
settagmethod
settagmethod
@@ -227,8 +238,10 @@ short-cut evaluation
sin
skips
+sort
sqrt
statements
+stderr
strbyte
strchar
strfind
@@ -240,25 +253,32 @@ strupper
sub event
table
+tag methods
tag
tag
tan
+tinsert
tmpname
tokens
tonumber
tostring
+tremove
type
unm event
userdata
vararg
version 3.0
+version 3.1
while-do
writeto
write

+ Last update: -Fri Jul 10 15:10:14 EST 1998 +Wed Jul 7 13:36:24 EST 1999 by lhf. + + diff --git a/doc/index.html b/doc/index.html index ca4a281..e6ff5fa 100644 --- a/doc/index.html +++ b/doc/index.html @@ -1,16 +1,17 @@ -Lua 3.1 Reference Manual - Contents +Lua 3.2 Reference Manual - Contents - + +

Reference Manual of the Programming Language Lua -3.1

+3.2

Roberto Ierusalimschy, -Luiz Henrique de Figueiredo, +Luiz Henrique de Figueiredo, Waldemar Celes
lua@tecgraf.puc-rio.br
@@ -26,7 +27,11 @@ | index | -ps +ps +| +pdf +| +old versions ]


@@ -69,6 +74,7 @@
  • 7.1 - Stack and Function Information
  • 7.2 - Manipulating Local Variables
  • 7.3 - Hooks +
  • 7.4 - The Reflexive Debugger Interface
  • 8 - Lua Stand-alone
  • Acknowledgments @@ -77,8 +83,11 @@
    + Last update: -Fri Jul 10 15:10:14 EST 1998 +Wed Jul 7 13:36:24 EST 1999 by lhf. + + diff --git a/doc/luac.html b/doc/luac.html index 1948e7a..92d9ddf 100644 --- a/doc/luac.html +++ b/doc/luac.html @@ -1,35 +1,20 @@ - -LUAC 1 "06 February 1998" + + + +LUAC man page + + + +

    NAME

    luac - Lua compiler

    SYNOPSIS

    luac [ --c -| --u -] [ --D -name -] [ --d -] [ --l -] [ --O -] [ --o -filename +options ] [ --p -] [ --q -] [ --v -] [ --V +filenames ] -sourcefile ...

    DESCRIPTION

    luac is the Lua compiler. @@ -43,10 +28,16 @@ in Lua. The main advantages of pre-compiling chunks are: faster loading, protecting source code from user changes, +and off-line syntax error detection. The binary files created by luac -are portable to all known architectures. +are portable to all architectures. +

    +Pre-compiling does not imply faster execution +because in Lua chunks are always compiled into bytecodes before being executed. +luac +simply allows those bytecodes to be saved in a file for later execution.

    luac produces a single output file containing the bytecodes @@ -71,16 +62,26 @@ option.

    Binary files produced by differents runs of luac +(even in different machines) can be combined into one large file, using cat(1). -The result is still a valid binary file, +The result is still a valid binary file and can be loaded with a single call to lua_dofile or dofile.

    +The internal format of the binary files produced by +luac +may change when a new version of Lua is released. +We try to maintain compatibility even for binary files, +but sometimes it cannot be done. +So, +save the source files of all Lua programs that you precompile. +

    OPTIONS

    +Options must be separate.

    -c compile (this is the default). @@ -89,26 +90,44 @@ compile (this is the default). undump, i.e., load and list the given binary files. If no files are given, then luac undumps luac.out. -

    --D "name" -predefine symbol -name -for conditional compilation. +Listing a binary file is useful to learn Lua's virtual machine. +Listing is also useful to test the integrity of binary files: +corrupted files will probably generate errors when undumped. +To test without listing, use +-q. +For a thourough integrity test, +use +-t.

    -d turn debugging on. Individual chunks may still control the generation of debug information with $debug and $nodebug. +If debugging is on, then listings show the names of the local variables. +

    +-D "name" +predefine symbol +name +for conditional compilation. +By default, +luac +does +not +predefine any symbols, +not even the built-in functions.

    -l produce a listing of the compiled bytecode for Lua's virtual machine. This is the default when undumping.

    --O -optimize code. -Debug information is removed, -duplicate constants are coalesced. +-n +Save numbers in native format. +By default, +numbers are saved in text form, +for maximum portability. +Binary files with numbers in native format are slightly faster to load, +but are not completely portable.

    -o "filename" output to @@ -117,14 +136,33 @@ instead of the default luac.out. The output file cannot be a source file.

    +-O +optimize. +Debug information is removed +and +duplicate constants are coalesced. +

    -p -parse sources files but does not generate any output file. +parse sources files but do not generate any output file. Used mainly for syntax checking.

    -q quiet; produces no listing. This is the default when compiling.

    +-t +perform a thourough integrity test when undumping. +Code that passes this test is completely safe, +in the sense that it will not break the interpreter. +However, +there is no guarantee that such code does anything sensible. +(None can be given, because the halting problem is unsolvable.) +

    +-U "name" +undefine symbol +name +for conditional compilation. +

    -v print version information.

    @@ -135,7 +173,7 @@ print the names of the source files as they are processed.

    luac.out default output file -

    "SEE ALSO"

    +

    SEE ALSO

    lua(1)
    "Reference Manual of the Programming Language Lua" @@ -148,11 +186,9 @@ default output file #6 (1996) 635-652.

    DIAGNOSTICS

    Error messages should be self explanatory. -

    BUGS

    -Inherits any bugs from Lua, -but Lua has no bugs...

    AUTHORS

    L. H. de Figueiredo, R. Ierusalimschy and W. Celes (lua@tecgraf.puc-rio.br) + diff --git a/doc/luac.man b/doc/luac.man index e5c9073..818448b 100644 --- a/doc/luac.man +++ b/doc/luac.man @@ -1,35 +1,14 @@ -.\" $Id: luac.man,v 1.11 1998/07/01 14:51:45 lhf Exp $ -.TH LUAC 1 "01 July 1998" +.\" luac.man,v 1.17 1999/07/07 16:02:07 lhf Exp +.TH LUAC 1 "1999/07/07 16:02:07" .SH NAME luac \- Lua compiler .SH SYNOPSIS .B luac [ -.B \-c -| -.B \-u -] [ -.B \-d -] [ -.B \-D -.I name -] [ -.B \-l -] [ -.B \-o -.I filename -] [ -.B \-O +.I options ] [ -.B \-p -] [ -.B \-q -] [ -.B \-v -] [ -.B \-V +.I filenames ] -.IR sourcefile " ..." .SH DESCRIPTION .B luac is the Lua compiler. @@ -43,10 +22,16 @@ in Lua. The main advantages of pre-compiling chunks are: faster loading, protecting source code from user changes, +and off-line syntax error detection. The binary files created by .B luac -are portable to all known architectures. +are portable to all architectures. +.LP +Pre-compiling does not imply faster execution +because in Lua chunks are always compiled into bytecodes before being executed. +.B luac +simply allows those bytecodes to be saved in a file for later execution. .LP .B luac produces a single output file containing the bytecodes @@ -71,16 +56,26 @@ option. .LP Binary files produced by differents runs of .B luac +(even in different machines) can be combined into one large file, using .BR cat (1). -The result is still a valid binary file, +The result is still a valid binary file and can be loaded with a single call to .B lua_dofile or .BR dofile . .LP +The internal format of the binary files produced by +.B luac +may change when a new version of Lua is released. +We try to maintain compatibility even for binary files, +but sometimes it cannot be done. +So, +save the source files of all Lua programs that you precompile. +.LP .SH OPTIONS +Options must be separate. .TP .B \-c compile (this is the default). @@ -89,6 +84,21 @@ compile (this is the default). undump, i.e., load and list the given binary files. If no files are given, then luac undumps .BR luac.out . +Listing a binary file is useful to learn Lua's virtual machine. +Listing is also useful to test the integrity of binary files: +corrupted files will probably generate errors when undumped. +To test without listing, use +.BR \-q . +For a thourough integrity test, +use +.BR \-t . +.TP +.B \-d +turn debugging on. +Individual chunks may +still control the generation of debug information with +$debug and $nodebug. +If debugging is on, then listings show the names of the local variables. .TP .BI \-D " name" predefine symbol @@ -101,21 +111,17 @@ does predefine any symbols, not even the built-in functions. .TP -.B \-d -turn debugging on. -Individual chunks may -still control the generation of debug information with -$debug and $nodebug. -If debugging is on, then listings show the names of the local variables. -.TP .B \-l produce a listing of the compiled bytecode for Lua's virtual machine. This is the default when undumping. .TP -.B \-O -optimize code. -Debug information is removed, -duplicate constants are coalesced. +.B \-n +Save numbers in native format. +By default, +numbers are saved in text form, +for maximum portability. +Binary files with numbers in native format are slightly faster to load, +but are not completely portable. .TP .BI \-o " filename" output to @@ -124,14 +130,33 @@ instead of the default .BR luac.out . The output file cannot be a source file. .TP +.B \-O +optimize. +Debug information is removed +and +duplicate constants are coalesced. +.TP .B \-p -parse sources files but does not generate any output file. +parse sources files but do not generate any output file. Used mainly for syntax checking. .TP .B \-q quiet; produces no listing. This is the default when compiling. .TP +.B \-t +perform a thourough integrity test when undumping. +Code that passes this test is completely safe, +in the sense that it will not break the interpreter. +However, +there is no guarantee that such code does anything sensible. +(None can be given, because the halting problem is unsolvable.) +.TP +.BI \-U " name" +undefine symbol +.I name +for conditional compilation. +.TP .B \-v print version information. .TP @@ -155,11 +180,9 @@ http://www.tecgraf.puc-rio.br/lua/ #6 (1996) 635-652. .SH DIAGNOSTICS Error messages should be self explanatory. -.SH BUGS -Inherits any bugs from Lua, -but Lua has no bugs... .SH AUTHORS L. H. de Figueiredo, R. Ierusalimschy and W. Celes .I (lua@tecgraf.puc-rio.br) +.\" EOF diff --git a/doc/manual.html b/doc/manual.html index 8707ec2..8c157c2 100644 --- a/doc/manual.html +++ b/doc/manual.html @@ -1,9 +1,12 @@ -Lua 3.1 Reference Manual +Lua 3.2 Reference Manual - -

    Lua 3.1 Reference Manual

    + +

    Lua 3.2 Reference Manual

    + +

    +


    @@ -14,10 +17,6 @@ general procedural programming with data description facilities. Lua is intended to be used as a light-weight, but powerful, configuration language for any program that needs one. -Lua has been designed and implemented by -W. Celes, -R. Ierusalimschy and -L. H. de Figueiredo.

    Lua is implemented as a library, written in C. Being an extension language, Lua has no notion of a ``main'' program: @@ -48,15 +47,17 @@ at the following URL's:

    All statements in Lua are executed in a global environment. This environment, which keeps all global variables, -is initialized at the beginning of the embedding program and -persists until its end. +is initialized with a call from the embedding program to +lua_open and +persists until a call to lua_close, +or the end of the embedding program. Optionally, a user can create multiple independent global environments (see Section 5.1).

    The global environment can be manipulated by Lua code or by the embedding program, which can read and write global variables -using functions from the API library that implements Lua. +using API functions from the library that implements Lua.

    Global variables do not need declaration. Any variable is assumed to be global unless explicitly declared local @@ -79,7 +80,7 @@ A chunk may optionally end with a return statement (see Section&nbs When a chunk is executed, first all its code is pre-compiled, then the statements are executed in sequential order. All modifications a chunk effects on the global environment persist -after its end. +after the chunk end.

    Chunks may also be pre-compiled into binary form; see program luac for details. @@ -104,7 +105,7 @@ There are six basic types in Lua: ni string, function, userdata, and table. Nil is the type of the value nil, whose main property is to be different from any other value. -Number represents real (double precision floating point) numbers, +Number represents real (double-precision floating-point) numbers, while string has the usual meaning. Lua is eight-bit clean, and so strings may contain any 8-bit character, @@ -160,7 +161,7 @@ semantics of Lua (see Section 4.8). Each of the types nil, number and string has a different tag. All values of each of these types have this same pre-defined tag. Values of type function can have two different tags, -depending on whether they are Lua or C functions. +depending on whether they are Lua functions or C functions. Finally, values of type userdata and table can have as many different tags as needed (see Section 4.8). @@ -200,7 +201,7 @@ Lua is a case-sensitive language: and is a reserved word, but And and \'and (if the locale permits) are two other different identifiers. As a convention, identifiers starting with underscore followed by -uppercase letters should not be used in regular programs. +uppercase letters are reserved for internal variables.

    The following strings denote other tokens:

    @@ -211,7 +212,7 @@ The following strings denote other tokens:
     Literal strings can be delimited by matching single or double quotes,
     and can contain the C-like escape sequences
     '\a' (bell),
    -'\b' (back space),
    +'\b' (backspace),
     '\f' (form feed),
     '\n' (new line),
     '\r' (carriage return),
    @@ -251,9 +252,9 @@ in Unix systems (see Section 8).
     

    Numerical constants may be written with an optional decimal part, and an optional decimal exponent. -Examples of valid numerical constants are: +Examples of valid numerical constants are

    -       4     4.0     0.4     4.57e-3     0.3e12
    +       3     3.0     3.1416  314.16e-2   0.31416E1
     

    @@ -280,7 +281,7 @@ Directives may be freely nested. Particularly, a $endinput may occur inside a $if; in that case, even the matching $end is not parsed.

    -A cond part may be: +A cond part may be

    nil
    - always false.
    1
    - always true. @@ -298,11 +299,7 @@ Lua provides some automatic conversions between values at run time. Any arithmetic operation applied to a string tries to convert that string to a number, following the usual rules. Conversely, whenever a number is used when a string is expected, -that number is converted to a string, according to the following rule: -if the number is an integer, it is written without exponent or decimal point; -otherwise, it is formatted following the %g -conversion specification of the printf function in the -standard C library. +that number is converted to a string, in a reasonable format. For complete control on how numbers are converted to strings, use the format function (see Section 6.2).

    @@ -313,12 +310,13 @@ use the format function (see Section 6.2

    Functions in Lua can return many values. Because there are no type declarations, +when a function is called the system does not know how many values a function will return, or how many parameters it needs. Therefore, sometimes, a list of values must be adjusted, at run time, to a given length. If there are more values than are needed, -then the last values are thrown away. +then the excess values are thrown away. If there are more needs than values, then the list is extended with as many nil's as needed. Adjustment occurs in multiple assignment (see Section 4.5.2) @@ -376,7 +374,7 @@ The two lists may have different lengths. Before the assignment, the list of values is adjusted to the length of the list of variables (see Section 4.4).

    -A single name can denote a global or a local variable, +A single name can denote a global variable, a local variable, or a formal parameter:

     var ::= name
    @@ -414,15 +412,14 @@ only nil is considered false.
     

    -stat ::= while exp1 do block end 
    | repeat block until exp1
    | if exp1 then block {elseif} [else block] end -elseif ::= elseif exp1 then block +stat ::= while exp1 do block end
    | repeat block until exp1
    | if exp1 then block {elseif exp1 then block} [else block] end

    A return is used to return values from a function or from a chunk. Because they may return more than one value, -the syntax for a return statement is: +the syntax for a return statement is

     ret ::= return [explist1] [sc]
     
    @@ -457,7 +454,7 @@ Otherwise, all variables are initialized with nil.

    4.6 - Expressions

    4.6.1 - Basic Expressions

    -Basic expressions are: +Basic expressions are
     exp ::= '(' exp ')'
     exp ::= nil
    @@ -477,7 +474,7 @@ string literals are explained in Section 4.1;
     variables are explained in Section 4.5.2;
     upvalues are explained in Section 4.7;
     function definitions (function) are explained in Section 4.6.9;
    -function call are explained in Section 4.6.8.
    +function calls are explained in Section 4.6.8.
     

    An access to a global variable x is equivalent to a call getglobal('x'); @@ -535,7 +532,7 @@ then their values are compared using lexicographical order. Otherwise, the ``order'' tag method is called (see Section 4.8).

    4.6.4 - Logical Operators

    -The logical operators are: +The logical operators are
                  and   or   not
    @@ -589,7 +586,7 @@ every time a constructor is evaluated, a new table is created.
     Constructors can be used to create empty tables,
     or to create a table and initialize some fields.
     

    -The general syntax for constructors is: +The general syntax for constructors is

     tableconstructor ::= '{' fieldlist '}'
     fieldlist ::= lfieldlist | ffieldlist | lfieldlist ';' ffieldlist | ffieldlist ';' lfieldlist
    @@ -597,17 +594,17 @@ lfieldlist ::= [lfieldlist1]
     ffieldlist ::= [ffieldlist1]
     

    -The form lfieldlist1 is used to initialize lists. +The form lfieldlist1 is used to initialize lists:

     lfieldlist1 ::= exp {',' exp} [',']
     
    The expressions in the list are assigned to consecutive numerical indices, starting with 1. -For example: +For example,
        a = {"v1", "v2", 34}
     
    -is equivalent to: +is equivalent to
       do
         local temp = {}
    @@ -623,11 +620,11 @@ The form ffieldlist1 initializes other fields in a table:
     ffieldlist1 ::= ffield {',' ffield} [',']
     ffield ::= '[' exp ']' '=' exp | name '=' exp
     
    -For example: +For example,
        a = {[f(k)] = g(y), x = 1, y = 3, [0] = b+c}
     
    -is equivalent to: +is equivalent to
       do
         local temp = {}
    @@ -649,7 +646,7 @@ For example, all forms below are correct:
        x = {;}
        x = {'a', 'b',}
        x = {type='list'; 'a', 'b'}
    -   x = {f(0), f(1), f(2),; n=3}
    +   x = {f(0), f(1), f(2),; n=3,}
     

    @@ -678,6 +675,7 @@ is syntactic sugar for

    except that simpleexp is evaluated only once.

    +Arguments have the following syntax:

     args ::= '(' [explist1] ')'
     args ::= tableconstructor
    @@ -707,33 +705,33 @@ If the function is called in a place that can hold many values
     (syntactically denoted by the non-terminal exp),
     then no adjustment is made.
     Note that the only place that can hold many values
    -is the last expression (or the only one) in an assignment
    +is the last (or the only) expression in an assignment
     or in a return statement; see examples below.
     
    -      f();  -- adjusted to 0
    -      g(x, f());     -- f() is adjusted to 1
    -      a,b,c = f(), x;   -- f() is adjusted to 1 result (and c gets nil)
    -      a,b,c = x, f();   -- f() is adjusted to 2
    -      a,b,c = f();   -- f() is adjusted to 3
    -      return f();   -- returns all values returned by f()
    +      f();               -- adjusted to 0
    +      g(x, f());         -- f() is adjusted to 1
    +      a,b,c = f(), x;    -- f() is adjusted to 1 result (and c gets nil)
    +      a,b,c = x, f();    -- f() is adjusted to 2
    +      a,b,c = f();       -- f() is adjusted to 3
    +      return f();        -- returns all values returned by f()
     

    4.6.9 - Function Definitions

    -The syntax for function definition is: +The syntax for function definition is

     function ::= function '(' [parlist1] ')' block end
     stat ::= function funcname '(' [parlist1] ')' block end
     funcname ::= name | name '.' name
     
    -The statement: +The statement
           function f (...)
             ...
           end
     
    -is just syntactic sugar for: +is just syntactic sugar for
           f = function (...)
                 ...
    @@ -769,8 +767,8 @@ A vararg function does not adjust its argument list;
     instead, it collects any extra arguments into an implicit parameter,
     called arg.
     This parameter is always initialized as a table,
    -with a field n with the number of extra arguments,
    -and the extra arguments at positions 1, 2, ...
    +with a field n whose value is the number of extra arguments,
    +and the extra arguments at positions 1, 2, ...
     

    As an example, suppose definitions like:

    @@ -795,21 +793,21 @@ If control reaches the end of a function without a return instruction,
     then the function returns with no results.
     

    There is a special syntax for defining methods, -that is, functions that have an implicit extra parameter self. +that is, functions that have an implicit extra parameter self:

     function ::= function name ':' name '(' [parlist1] ')' block end
     
    Thus, a declaration like
    -function v:f (...)
    -  ...
    -end
    +      function v:f (...)
    +        ...
    +      end
     
    is equivalent to
    -v.f = function (self, ...)
    -  ...
    -end
    +      v.f = function (self, ...)
    +        ...
    +      end
     
    that is, the function gets an extra formal parameter called self. Note that the variable v must have been @@ -842,19 +840,19 @@ at the point where the function is defined.

    Here are some examples:

    -a,b,c = 1,2,3   -- global variables
    -function f (x)
    -  local b   -- x and b are local to f
    -  local g = function (a)
    -    local y  -- a and y are local to g
    -    p = a   -- OK, access local 'a'
    -    p = c   -- OK, access global 'c'
    -    p = b   -- ERROR: cannot access a variable in outer scope
    -    p = %b  -- OK, access frozen value of 'b' (local to 'f')
    -    p = %c  -- OK, access frozen value of global 'c'
    -    p = %y  -- ERROR: 'y' is not visible where 'g' is defined
    -  end  -- g
    -end  -- f
    +      a,b,c = 1,2,3   -- global variables
    +      function f (x)
    +        local b       -- x and b are local to f
    +        local g = function (a)
    +          local y     -- a and y are local to g
    +          p = a       -- OK, access local 'a'
    +          p = c       -- OK, access global 'c'
    +          p = b       -- ERROR: cannot access a variable in outer scope
    +          p = %b      -- OK, access frozen value of 'b' (local to 'f')
    +          p = %c      -- OK, access frozen value of global 'c'
    +          p = %y      -- ERROR: 'y' is not visible where 'g' is defined
    +        end           -- g
    +      end             -- f
     

    @@ -863,7 +861,7 @@ end -- f

    4.8 - Tag Methods

    Lua provides a powerful mechanism to extend its semantics, -called Tag Methods. +called tag methods. A tag method is a programmer-defined function that is called at specific key points during the evaluation of a program, allowing the programmer to change the standard Lua behavior at these points. @@ -874,10 +872,10 @@ according to the tag of the values involved in the event (see Section 3). The function settagmethod changes the tag method associated with a given pair (tag, event). -Its first parameter is the tag, the second is the event name -(a string, see below), +Its first parameter is the tag, the second parameter is the event name +(a string; see below), and the third parameter is the new method (a function), -or nil to restore the default behavior. +or nil to restore the default behavior for the pair. The function returns the previous tag method for that pair. Another function, gettagmethod, receives a tag and an event name and returns the @@ -893,7 +891,7 @@ Please notice that the code shown here is only illustrative; the real behavior is hard coded in the interpreter, and it is much more efficient than this simulation. All functions used in these descriptions -(rawgetglobal, tonumber, call, etc) +(rawgetglobal, tonumber, call, etc.) are described in Section 6.1.

    @@ -1137,7 +1135,7 @@ called when Lua tries to call a non function value.

    ``gc'':
    -called when Lua is garbage collecting an object. +called when Lua is ``garbage collecting'' an object. This method cannot be set for strings, numbers, functions, and userdata with default tag. For each object to be collected, @@ -1165,29 +1163,27 @@ Because Lua is an extension language, all Lua actions start from C code in the host program calling a function from the Lua library. Whenever an error occurs during Lua compilation or execution, -the error method is called, +function _ERRORMESSAGE is called +(provided it is different from nil), and then the corresponding function from the library (lua_dofile, lua_dostring, lua_dobuffer, or lua_callfunction) is terminated, returning an error condition.

    -The only argument to the error method is a string +The only argument to _ERRORMESSAGE is a string describing the error. -The default method prints this message to stderr. -If needed, it is possible to change the error method with the -function seterrormethod, -which gets the new error handler as its only parameter -(see Section 6.1). -The standard I/O library uses this facility to redefine the error method, -using the debug facilities (see Section 7), -in order to print some extra information, +The default definition for this function calls _ALERT, +which prints the message to stderr (see Section 6.1). +The standard I/O library redefines _ERRORMESSAGE, +and uses the debug facilities (see Section 7) +to print some extra information, such as the call stack.

    To provide more information about errors, Lua programs should include the compilation pragma $debug. -When an error occurs in a program compiled with this option, +When an error occurs in a chunk compiled with this option, the I/O error routine is able to print the number of the lines where the calls (and the error) were made.

    @@ -1229,6 +1225,8 @@ is stored in a dynamic structure pointed by typedef struct lua_State lua_State; extern lua_State *lua_state;

    +The variable lua_state is the only C global variable in +the Lua library.

    Before calling any API function, this state must be initialized. @@ -1255,19 +1253,19 @@ For that, you must set lua_state back to NULL before calling lua_open. An easy way to do that is defining an auxiliary function:

    -lua_State *lua_newstate (void) {
    -  lua_State *old = lua_setstate(NULL);
    -  lua_open();
    -  return lua_setstate(old);
    -}
    +      lua_State *lua_newstate (void) {
    +        lua_State *old = lua_setstate(NULL);
    +        lua_open();
    +        return lua_setstate(old);
    +      }
     
    This function creates a new state without changing the current state of the interpreter. -Note that any new state is built with all predefined functions, +Note that any new state is created with all predefined functions, but any additional library (such as the standard libraries) must be explicitly open in the new state, if needed.

    -If necessary, a state may be released: +If necessary, a state may be released by calling

     void lua_close (void);
     
    @@ -1281,14 +1279,14 @@ If lua_state is already NULL, lua_close has no effect.

    If you are using multiple states, -you may find useful the following function, +you may find useful to define the following function, which releases a given state:

    -void lua_freestate (lua_State *st) {
    -  lua_State *old = lua_setstate(st);
    -  lua_close();
    -  if (old != st) lua_setstate(old);
    -}
    +      void lua_freestate (lua_State *st) {
    +        lua_State *old = lua_setstate(st);
    +        lua_close();
    +        if (old != st) lua_setstate(old);
    +      }
     

    @@ -1316,7 +1314,7 @@ int lua_isfunction (lua_Object object); int lua_iscfunction (lua_Object object); int lua_isuserdata (lua_Object object);

    -All macros return 1 if the object is compatible with the given type, +These functions return 1 if the object is compatible with the given type, and 0 otherwise. The function lua_isnumber accepts numbers and numerical strings, whereas @@ -1356,7 +1354,8 @@ but may contain other zeros in their body. If you do not know whether a string may contain zeros, you can use lua_strlen to get the actual length. Because Lua has garbage collection, -there is no guarantee that such pointer will be valid after the block ends +there is no guarantee that the pointer returned by lua_getstring +will be valid after the block ends (see Section 5.3).

    lua_getcfunction converts a lua_Object to a C function. @@ -1415,7 +1414,7 @@ Note that the structure lua2C cannot be directly modified by C code.

    The second structure, C2lua, is an abstract stack. Pushing elements into this stack -is done with the following functions and macros: +is done with the following functions: @@ -1433,7 +1432,7 @@ void lua_pushcfunction (lua_CFunction f); /* macro */ All of them receive a C value, convert it to a corresponding lua_Object, and leave the result on the top of C2lua. -Particularly, functions lua_pushlstring and lua_pushstring +In particular, functions lua_pushlstring and lua_pushstring make an internal copy of the given string. Function lua_pushstring can only be used to push proper C strings (that is, strings that do not contain zeros and end with a zero); @@ -1518,9 +1517,6 @@ is the ``name of the chunk'', used in error messages and debug information. If name is NULL, Lua gives a default name to the chunk. -In files this name is the file name, -and lua_dostring uses a small prefix -of the string as the chunk name.

    These functions return, in structure lua2C, any values eventually returned by the chunks. @@ -1565,7 +1561,7 @@ The function

     lua_Object lua_gettable (void);
     
    -pops from the stack C2lua a table and an index, +pops a table and an index from the stack C2lua, and returns the contents of the table at that index. As in Lua, this operation may trigger a tag method. To get the real value of any table index, @@ -1579,7 +1575,7 @@ lua_Object lua_rawgettable (void); To store a value in an index, the program must push the table, the index, and the value onto C2lua, -and then call the function: +and then call the function
     void lua_settable (void);
    @@ -1636,9 +1632,9 @@ equivalent to the Lua code:
       lua_pushnumber(4);                                   /* 3rd argument */
       lua_callfunction(lua_getglobal("f"));           /* call Lua function */
       lua_pushobject(lua_getresult(1));   /* push first result of the call */
    -  lua_setglobal("a");                      /* sets global variable 'a' */
    -  lua_pushobject(lua_getresult(2));   /* push second result of the call */
    -  lua_setglobal("b");                      /* sets global variable 'b' */
    +  lua_setglobal("a");                       /* set global variable 'a' */
    +  lua_pushobject(lua_getresult(2));  /* push second result of the call */
    +  lua_setglobal("b");                       /* set global variable 'b' */
     

    Some special Lua functions have exclusive interfaces. @@ -1651,19 +1647,11 @@ This function never returns. If the C function has been called from Lua, then the corresponding Lua execution terminates, as if an error had occurred inside Lua code. -Otherwise, the whole program terminates with a call to exit(1). -The message is passed to the error handler method. +Otherwise, the whole host program terminates with a call to exit(1). +The message is passed to the error handler function, +_ERRORMESSAGE. If message is NULL, -the error handler method is not called. -

    -The error handler method (see Section 4.9) can be -changed with: -

    -lua_Object lua_seterrormethod (void);
    -
    -This function sets the object at the top of C2lua -as the new error method, -and returns the old error method value. +then _ERRORMESSAGE is not called.

    Tag methods can be changed with:

    @@ -1722,12 +1710,13 @@ Like a Lua function, a C function called by Lua can also return
     many results.
     

    When a C function is created, -it is possible to associate some upvalues to it; +it is possible to associate some upvalues to it, +thus creating a C closure; then these values are passed to the function whenever it is called, as common arguments. To associate upvalues to a function, first these values must be pushed on C2lua. -Then the function: +Then the function

     void lua_pushcclosure (lua_CFunction fn, int n);
    @@ -1792,7 +1781,7 @@ The libraries, on the other hand, provide useful routines
     that are implemented directly through the standard API.
     Therefore, they are not necessary to the language,
     and are provided as separate C modules.
    -Currently there are three standard libraries:
    +Currently, there are three standard libraries:
     
    • string manipulation;
    • mathematical functions (sin, log, etc); @@ -1809,17 +1798,16 @@ and lua_iolibopen, declared in lualib.h.

      6.1 - Predefined Functions

      -

      call (func, arg [, mode [, errmethod]])

      +

      call (func, arg [, mode [, errhandler]])

      -This function calls function func with +Calls function func with the arguments given by the table arg. The call is equivalent to
      -      func(arg[1], arg[2], ..., arg[arg.n])
      +      func(arg[1], arg[2], ..., arg[n])
       
      -If arg.n is not defined, -then Lua stops getting arguments at the first nil value. +where n is the result of getn(arg) (see Section 6.1).

      By default, all results from func are just returned by the call. @@ -1833,6 +1821,7 @@ For instance, the following calls produce the following results:

       a = call(sin, {5})                --> a = 0.0871557 = sin(5)
       a = call(max, {1,4,5; n=2})       --> a = 4 (only 1 and 4 are arguments)
      +a = call(max, {1,4,5; n=2}, "p")  --> a = {4; n=1}
       t = {x=1}
       a = call(next, {t,nil;n=2}, "p")  --> a={"x", 1; n=2}
       
      @@ -1842,14 +1831,15 @@ if an error occurs during the function call, the error is propagated. If the string mode contains "x", then the call is protected. -In this mode, function call does not generate an error, -whatever happens during the call. +In this mode, function call does not propagate an error, +regardless of what happens during the call. Instead, it returns nil to signal the error -(besides calling the appropriated error method). +(besides calling the appropriated error handler).

      -If provided, errmethod is temporarily set as the error method, -while func runs. -As a particular case, if errmethod is nil, +If provided, +errhandler is temporarily set as the error function +_ERRORMESSAGE, while func runs. +In particular, if errhandler is nil, no error messages will be issued during the execution of the called function.

      collectgarbage ([limit])

      @@ -1858,13 +1848,13 @@ Returns the number of objects collected. An optional argument, limit, is a number that makes the next cycle occur only after that number of new objects have been created. -If absent, Lua uses an adaptive algorithm to set -this limit. +If limit is absent or equal to 0, +Lua uses an adaptive algorithm to set this limit. collectgarbage is equivalent to the API function lua_collectgarbage.

      dofile (filename)

      -This function receives a file name, +Receives a file name, opens the file, and executes the file contents as a Lua chunk, or as pre-compiled chunks. When called without arguments, @@ -1877,7 +1867,7 @@ It issues an error when called with a non string argument. dofile is equivalent to the API function lua_dofile.

      dostring (string [, chunkname])

      -This function executes a given string as a Lua chunk. +Executes a given string as a Lua chunk. If there is any error executing the string, dostring returns nil. Otherwise, it returns the values returned by the chunk, @@ -1893,7 +1883,7 @@ Returns a new tag. newtag is equivalent to the API function lua_newtag.

      next (table, index)

      -This function allows a program to traverse all fields of a table. +Allows a program to traverse all fields of a table. Its first argument is a table and its second argument is an index in this table. It returns the next index of the table and the @@ -1911,8 +1901,9 @@ field not present in a table or a field with value nil. Therefore, the function only considers fields with non nil values. The order in which the indices are enumerated is not specified, even for numeric indices -(to traverse a table in numeric order, use a counter). -If the table is modified in any way during a traversal, +(to traverse a table in numeric order, +use a counter or the function foreachi). +If the table indices are modified in any way during a traversal, the semantics of next is undefined.

      This function cannot be written with the standard API. @@ -1925,67 +1916,35 @@ or nil to get a first name. Similarly to next, it returns the name of another variable and its value, or nil if there are no more variables. -There can be no assignments to global variables during the traversal; +There can be no creation of new global variables during the traversal; otherwise the semantics of nextvar is undefined.

      This function cannot be written with the standard API.

      -

      foreach (table, function)

      -Executes the given function over all elements of table. -For each element, the function is called with the index and -respective value as arguments. -If the function returns any non-nil value, -the loop is broken, and the value is returned -as the final value of foreach. -

      -This function could be defined in Lua: -

      -function foreach (t, f)
      -  local i, v = next(t, nil)
      -  while i do
      -    local res = f(i, v)
      -    if res then return res end
      -    i, v = next(t, i)
      -  end
      -end
      -
      -

      -

      foreachvar (function)

      -Executes function over all global variables. -For each variable, -the function is called with its name and its value as arguments. -If the function returns any non-nil value, -the loop is broken, and the value is returned -as the final value of foreachvar. -

      -This function could be defined in Lua: -

      -function foreachvar (f)
      -  local n, v = nextvar(nil)
      -  while n do
      -    local res = f(n, v)
      -    if res then return res end
      -    n, v = nextvar(n)
      -  end
      -end
      -
      -

      tostring (e)

      -This function receives an argument of any type and +Receives an argument of any type and converts it to a string in a reasonable format. For complete control on how numbers are converted, use function format.

      print (e1, e2, ...)

      -This function receives any number of arguments, +Receives any number of arguments, and prints their values using the strings returned by tostring. This function is not intended for formatted output, but only as a quick way to show a value, -for instance for error messages or debugging. +for instance for debugging. See Section 6.4 for functions for formatted output.

      + +

      _ALERT (message)

      +Prints its only string argument to stderr. +All error messages in Lua are printed through this function. +Therefore, a program may redefine it +to change the way such messages are shown +(for instance, for systems without stderr). +

      tonumber (e [, base])

      -This function receives one argument, +Receives one argument, and tries to convert it to a number. If the argument is already a number or a string convertible to a number, then tonumber returns that number; @@ -2002,7 +1961,7 @@ In other bases, only integers are accepted.

      type (v)

      -This function allows Lua to test the type of a value. +Allows Lua to test the type of a value. It receives one argument, and returns its type, coded as a string. The possible results of this function are "nil" (a string, not the value nil), @@ -2013,12 +1972,12 @@ The possible results of this function are and "userdata".

      tag (v)

      -This function allows Lua to test the tag of a value (see Section 3). +Allows Lua to test the tag of a value (see Section 3). It receives one argument, and returns its tag (a number). tag is equivalent to the API function lua_tag.

      settag (t, tag)

      -This function sets the tag of a given table (see Section 3). +Sets the tag of a given table (see Section 3). tag must be a value created with newtag (see Section 6.1). It returns the value of its first argument (the table). @@ -2027,21 +1986,21 @@ it is impossible to change the tag of a userdata from Lua.

      assert (v [, message])

      -This function issues an ``assertion failed!'' error +Issues an ``assertion failed!'' error when its argument is nil. This function is equivalent to the following Lua function:
      -function assert (v, m)
      -  if not v then
      -    m = m or ""
      -    error("assertion failed!  " .. m)
      -  end
      -end
      +      function assert (v, m)
      +        if not v then
      +          m = m or ""
      +          error("assertion failed!  " .. m)
      +        end
      +      end
       

      error (message)

      -This function calls the error handler and then terminates +Calls the error handler and then terminates the last protected function called (in C: lua_dofile, lua_dostring, lua_dobuffer, or lua_callfunction; @@ -2064,7 +2023,7 @@ without invoking any tag method. and value is any Lua value.

      rawsetglobal (name, value)

      -This function assigns the given value to a global variable. +Assigns the given value to a global variable. The string name does not need to be a syntactically valid variable name. Therefore, @@ -2073,7 +2032,7 @@ this function can set global variables with strange names like Function rawsetglobal returns the value of its second argument.

      setglobal (name, value)

      -This function assigns the given value to a global variable, +Assigns the given value to a global variable, or calls a tag method. Its full semantics is explained in Section 4.8. The string name does not need to be a @@ -2081,42 +2040,197 @@ syntactically valid variable name. Function setglobal returns the value of its second argument.

      rawgetglobal (name)

      -This function retrieves the value of a global variable. +Retrieves the value of a global variable. The string name does not need to be a syntactically valid variable name.

      getglobal (name)

      -This function retrieves the value of a global variable, +Retrieves the value of a global variable, or calls a tag method. Its full semantics is explained in Section 4.8. The string name does not need to be a syntactically valid variable name.

      -

      seterrormethod (newmethod)

      - - -Sets the error handler (see Section 4.9). -newmethod must be a function or nil, -in which case the error handler does nothing. -Returns the old error handler. -

      settagmethod (tag, event, newmethod)

      -This function sets a new tag method to the given pair (tag, event). +Sets a new tag method to the given pair (tag, event). It returns the old method. If newmethod is nil, settagmethod restores the default behavior for the given event.

      gettagmethod (tag, event)

      -This function returns the current tag method +Returns the current tag method for a given pair (tag, event).

      copytagmethods (tagto, tagfrom)

      -This function copies all tag methods from one tag to another; +Copies all tag methods from one tag to another; it returns tagto.

      + +

      getn (table)

      +Returns the ``size'' of a table, when seen as a list. +If the table has an n field with a numeric value, +this is its ``size''. +Otherwise, the size is the largest numerical index with a non-nil +value in the table. +This function could be defined in Lua: +
      +      function getn (t)
      +        if type(t.n) == 'number' then return t.n end
      +        local max = 0
      +        local i = next(t, nil)
      +        while i do
      +          if type(i) == 'number' and i>max then max=i end
      +          i = next(t, i)
      +        end
      +        return max
      +      end
      +
      +

      +

      +

      foreach (table, function)

      +Executes the given function over all elements of table. +For each element, the function is called with the index and +respective value as arguments. +If the function returns any non-nil value, +the loop is broken, and the value is returned +as the final value of foreach. +

      +This function could be defined in Lua: +

      +      function foreach (t, f)
      +        local i, v = next(t, nil)
      +        while i do
      +          local res = f(i, v)
      +          if res then return res end
      +          i, v = next(t, i)
      +        end
      +      end
      +
      +

      +

      +

      foreachi (table, function)

      +Executes the given function over the +numerical indices of table. +For each index, the function is called with the index and +respective value as arguments. +Indices are visited in sequential order, +from 1 to n, +where n is the result of getn(table) (see Section 6.1). +If the function returns any non-nil value, +the loop is broken, and the value is returned +as the final value of foreachi. +

      +This function could be defined in Lua: +

      +      function foreachi (t, f)
      +        local i, n = 1, getn(t)
      +        while i <= n do
      +          local res = f(i, t[i])
      +          if res then return res end
      +          i = i+1
      +        end
      +      end
      +
      +

      +

      foreachvar (function)

      +Executes function over all global variables. +For each variable, +the function is called with its name and its value as arguments. +If the function returns any non-nil value, +the loop is broken, and the value is returned +as the final value of foreachvar. +

      +This function could be defined in Lua: +

      +      function foreachvar (f)
      +        local n, v = nextvar(nil)
      +        while n do
      +          local res = f(n, v)
      +          if res then return res end
      +          n, v = nextvar(n)
      +        end
      +      end
      +
      +

      +

      tinsert (table [, pos] , value)

      +

      +Inserts element value at table position pos, +shifting other elements to open space. +The default value for pos is n+1 +(where n is the result of getn(table) (see Section 6.1)) +so that a call tinsert(t,x) inserts x at the end +of table t. +

      +This function also sets or increments the field n of the table, +to n+1. +

      +This function is equivalent to the following Lua function, +except that the table accesses are all raw (that is, without tag methods): +

      +      function tinsert (t, ...)
      +        local pos, value
      +        local n = getn(t)
      +        if arg.n == 1 then
      +          pos = n+1; value = arg[1]
      +        else
      +          pos = arg[1]; value = arg[2]
      +        end
      +        t.n = n+1;
      +        while n >= pos do
      +          t[n+1] = t[n]
      +          n = n-1
      +        end
      +        t[pos] = value
      +      end
      +
      +

      +

      tremove (table [, pos])

      +

      +Removes from table the element at position pos, +shifting other elements to close the space. +Returns the value of the removed element. +The default value for pos is n +(where n is the result of getn(table) (see Section 6.1)), +so that a call tremove(t) removes the last element +of table t. +

      +This function also sets or decrements the field n of the table, +to n-1. +

      +This function is equivalent to the following Lua function, +except that the table accesses are all raw (that is, without tag methods): +

      +      function tremove (t, pos)
      +        local n = getn(t)
      +        pos = pos or n
      +        local value = t[pos]
      +        if n<=0 then return end
      +        while pos < n do
      +          t[pos] = t[pos+1]
      +          pos = pos+1
      +        end
      +        t[n] = nil
      +        t.n = n-1
      +        return value
      +      end
      +
      +

      +

      sort (table [, comp])

      +Sorts table elements in a given order, in-place, +from table[1] to table[n], +where n is the result of getn(table) (see Section 6.1). +If comp is given, +it must be a function that receives two table elements, +and returns true when the first is less than the second +(so that not comp(a[i+1], a[i]) will be true after the sort). +If comp is not given, +the standard < Lua operator is used instead. +

      +Function sort returns the (sorted) table. +

      6.2 - String Manipulation

      @@ -2127,7 +2241,7 @@ When indexing a string, the first character is at position 1

      strfind (str, pattern [, init [, plain]])

      -This function looks for the first match of +Looks for the first match of pattern in str. If it finds one, then it returns the indices on str where this occurrence starts and ends; @@ -2203,7 +2317,7 @@ Note that numerical codes are not necessarily portable across platforms.

      format (formatstring, e1, e2, ...)

      -This function returns a formatted version of its variable number of arguments +Returns a formatted version of its variable number of arguments following the description given in its first argument (which must be a string). The format string follows the same rules as the printf family of standard C functions. @@ -2212,9 +2326,8 @@ The only differences are that the options/modifiers and h are not supported, and there is an extra option, q. This option formats a string in a form suitable to be safely read -back by the Lua interpreter; -that is, -the string is written between double quotes, +back by the Lua interpreter: +The string is written between double quotes, and all double quotes, returns and backslashes in the string are correctly escaped when written. For instance, the call @@ -2241,7 +2354,7 @@ The options c, d, E, e, g, G, i, o, u, X, and x all expect a number as argument, whereas q and s expect a string. -Note that the * modifier can be simulated by building +The * modifier can be simulated by building the appropriate format string. For example, "%*g" can be simulated with "%"..width.."g". @@ -2273,30 +2386,29 @@ the maximum number of substitutions to occur. For instance, when n is 1 only the first occurrence of pat is replaced.

      -See some examples below: +Here are some examples:

      -  x = gsub("hello world", "(%w%w*)", "%1 %1")
      +  x = gsub("hello world", "(%w+)", "%1 %1")
         --> x="hello hello world world"
       

      - x = gsub("hello world", "(%w%w*)", "%1 %1", 1) + x = gsub("hello world", "(%w+)", "%1 %1", 1) --> x="hello hello world"

      - x = gsub("hello world from Lua", "(%w%w*)%s*(%w%w*)", "%2 %1") + x = gsub("hello world from Lua", "(%w+)%s*(%w+)", "%2 %1") --> x="world hello Lua from"

      - x = gsub("home = $HOME, user = $USER", "$(%w%w*)", getenv) + x = gsub("home = $HOME, user = $USER", "%$(%w+)", getenv) --> x="home = /home/roberto, user = roberto" (for instance)

      - x = gsub("4+5 = $return 4+5$", "$(.-)%$", dostring) + x = gsub("4+5 = $return 4+5$", "%$(.-)%$", dostring) --> x="4+5 = 9"

      - local t = {name="lua", version="3.1"} - x = gsub("$name - $version", "$(%w%w*)", function (v) return %t[v] end) - --> x="lua - 3.1" + local t = {name="lua", version="3.2"} + x = gsub("$name - $version", "%$(%w+)", function (v) return %t[v] end) + --> x="lua - 3.2"

      t = {n=0} - gsub("first second word", "(%w%w*)", - function (w) %t.n = %t.n+1; %t[%t.n] = w end) + gsub("first second word", "(%w+)", function (w) tinsert(%t, w) end) --> t={"first", "second", "word"; n=3}

      @@ -2308,24 +2420,25 @@ See some examples below: a character class is used to represent a set of characters. The following combinations are allowed in describing a character class:

      -
      x
      (where x is any character not in the list ()%.[*-?) +
      x
      (where x is any character not in the list +^$()%.[]*+-?) - represents the character x itself.
      .
      - (a dot) represents all characters.
      %a
      - represents all letters. -
      %A
      - represents all non letter characters. +
      %c
      - represents all control characters.
      %d
      - represents all digits. -
      %D
      - represents all non digits.
      %l
      - represents all lower case letters. -
      %L
      - represents all non lower case letter characters. +
      %p
      - represents all punctuation characters.
      %s
      - represents all space characters. -
      %S
      - represents all non space characters.
      %u
      - represents all upper case letters. -
      %U
      - represents all non upper case letter characters.
      %w
      - represents all alphanumeric characters. -
      %W
      - represents all non alphanumeric characters. -
      %x
      (where x is any non alphanumeric character) - +
      %x
      - represents all hexa-decimal digits. +
      %z
      - represents the character with representation 0. +
      %x
      (where x is any non alphanumeric character) - represents the character x. -This is the standard way to escape the magic characters ()%.[*-?. +This is the standard way to escape the magic characters ()%.[]*-?. +It is strongly recommended that any control character (even the non magic), +when used to represent itself in a pattern, should be preceded by a %.
      [char-set]
      - Represents the class which is the union of all characters in char-set. @@ -2343,13 +2456,16 @@ E.g., assuming an ascii character set, represents the complement of char-set, where char-set is interpreted as above.
      +For all classes represented by single letters (%a, %c, ...), +the correspondent upper-case letter represents the complement of the class. +For instance, %S represents all non-space characters.

      The definitions of letter, space, etc. depend on the current locale. In particular, the class [a-z] may not be equivalent to %l. The second form should be preferred for more portable programs.

      Pattern Item:

      -a pattern item may be: +a pattern item may be
      • a single character class, @@ -2357,12 +2473,16 @@ which matches any single character in the class;
      • a single character class followed by *, which matches 0 or more repetitions of characters in the class. -These repetition items will always match the longest possible sequence. +These repetition items will always match the longest possible sequence; +
      • +a single character class followed by +, +which matches 1 or more repetitions of characters in the class. +These repetition items will always match the longest possible sequence;
      • a single character class followed by -, which also matches 0 or more repetitions of characters in the class. Unlike *, -these repetition items will always match the shortest possible sequence. +these repetition items will always match the shortest possible sequence;
      • a single character class followed by ?, which matches 0 or 1 occurrence of a character in the class; @@ -2441,14 +2561,16 @@ The function random, when called without arguments, returns a pseudo-random real number in the range [0,1). When called with a number n, random returns a pseudo-random integer in the range [1,n]. +When called with two arguments, l and u, +random returns a pseudo-random integer in the range [l,u].

        6.4 - I/O Facilities

        -All input and output operations in Lua are done over two -file handles, one for reading and one for writing. +All input and output operations in Lua are done, by default, +over two file handles, one for reading and one for writing. These handles are stored in two Lua global variables, called _INPUT and _OUTPUT. The global variables @@ -2461,12 +2583,39 @@ Initially, _INPUT=_STDIN and _OUTPUT=_STDOUT.

        A file handle is a userdata containing the file stream FILE*, and with a distinctive tag created by the I/O library. -

        +Whenever a file handle is collected by the garbage collector, +its correspondent stream is automatically closed.

        Unless otherwise stated, all I/O functions return nil on failure and some value different from nil on success.

        +

        openfile (filename, mode)

        +

        +This function opens a file, +in the mode specified in the string mode. +It returns a new file handle, +or, in case of errors, nil plus a string describing the error. +This function does not modify either _INPUT or _OUTPUT. +

        +The string mode can be any of the following: +

        +
        "r"
        read mode; +
        "w"
        write mode; +
        "a"
        append mode; +
        "r+"
        update mode, all previous data is preserved; +
        "w+"
        update mode, all previous data is erased; +
        "a+"
        append update mode, previous data is preserved, + writing is only allowed at the end of file. +
        +The string mode may also have a b at the end, +which is needed in some systems to open the file in binary mode. +

        +

        closefile (handle)

        +

        +This function closes the given file. +It does not modify either _INPUT or _OUTPUT. +

        readfrom (filename)

        This function may be called in two ways. @@ -2519,52 +2668,81 @@ usually limited and depends on the system.

        appendto (filename)

        -This function opens a file named filename and sets it as the +Opens a file named filename and sets it as the value of _OUTPUT. Unlike the writeto operation, this function does not erase any previous content of the file. If this function fails, it returns nil, plus a string describing the error.

        -Note that function writeto is -available to close an output file opened by appendto. -

        remove (filename)

        -This function deletes the file with the given name. +Deletes the file with the given name. If this function fails, it returns nil, plus a string describing the error.

        rename (name1, name2)

        -This function renames file named name1 to name2. +Renames file named name1 to name2. +If this function fails, it returns nil, +plus a string describing the error. +

        +

        flush ([filehandle])

        +

        +Saves any written data to the given file. +If filehandle is not specified, +flushes all open files. If this function fails, it returns nil, plus a string describing the error.

        +

        seek (filehandle [, whence] [, offset])

        +

        +Sets and gets the file position, +measured in bytes from the beginning of the file, +to the position given by offset plus a base +specified by the string whence, as follows: +

        +
        "set"
        base is position 0 (beginning of the file); +
        "cur"
        base is current position; +
        "end"
        base is end of file; +
        +In case of success, function seek returns the final file position, +measured in bytes from the beginning of the file. +If the call fails, it returns nil, +plus a string describing the error. +

        +The default value for whence is "cur", +and for offset is 0. +Therefore, the call seek(file) returns the current +file position, without changing it; +the call seek(file, "set") sets the position to the +beginning of the file (and returns 0); +and the call seek(file, "end") sets the position to the +end of the file, and returns its size. +

        tmpname ()

        -This function returns a string with a file name that can safely +Returns a string with a file name that can safely be used for a temporary file. The file must be explicitly removed when no longer needed.

        -

        read ([filehandle] [readpattern])

        +

        read ([filehandle,] readpattern1, ...)

        -This function reads the file _INPUT, -or from filehandle if this argument is given, -according to a read pattern, which specifies how much to read; -characters are read from the input file until -the read pattern fails or ends. -The function read returns a string with the characters read, +Reads file _INPUT, +or filehandle if this argument is given, +according to read patterns, which specify how much to read. +For each pattern, +the function returns a string with the characters read, even if the pattern succeeds only partially, or nil if the read pattern fails and the result string would be empty. -When called without parameters, +When called without patterns, it uses a default pattern that reads the next line (see below).

        A read pattern is a sequence of read pattern items. An item may be a single character class -or a character class followed by ? or by *. +or a character class followed by ?, by *, or by +. A single character class reads the next character from the input if it belongs to the class, otherwise it fails. A character class followed by ? reads the next character @@ -2573,6 +2751,9 @@ it never fails. A character class followed by * reads until a character that does not belong to the class, or end of file; since it can match a sequence of zero characters, it never fails. +A character class followed by + reads until a character that +does not belong to the class, or end of file; +it fails if it cannot read at least one character. Note that the behavior of read patterns is slightly different from the regular pattern matching behavior, where a * expands to the maximum length such that @@ -2585,26 +2766,27 @@ that describe skips. Characters matching a skip are read, but are not included in the resulting string.

        -Following are some examples of read patterns and their meanings: -

          -
        • "." returns the next character, or nil on end of file. -
        • ".*" reads the whole file. -
        • "[^\n]*{\n}" returns the next line +There are some predefined patterns, as follows: +
          +
          ``*n''
          reads a number; +this is the only pattern that returns a number instead of a string. +
          ``*l''
          returns the next line (skipping the end of line), or nil on end of file. This is the default pattern. -
        • "{%s*}%S%S*" returns the next word +It is equivalent to the pattern "[^\n]*{\n}". +
          ``*a''
          reads the whole file. +It is equivalent to the pattern ".*". +
          ``*w''
          returns the next word (maximal sequence of non white-space characters), -skipping spaces if necessary, -or nil on end of file. -
        • "{%s*}[+-]?%d%d*" returns the next integer -or nil if the next characters do not conform to an integer format. -
        +skipping spaces if necessary, or nil on end of file. +It is equivalent to the pattern "{%s*}%S+". +

    write ([filehandle, ] value1, ...)

    -This function writes the value of each of its arguments to the +Writes the value of each of its arguments to file _OUTPUT, -or to filehandle if this argument is given, +or to filehandle if this argument is given. The arguments must be strings or numbers. To write other values, use tostring or format before write. @@ -2613,21 +2795,21 @@ plus a string describing the error.

    date ([format])

    -This function returns a string containing date and time +Returns a string containing date and time formatted according to the given string format, following the same rules of the ANSI C function strftime. When called without arguments, it returns a reasonable date and time representation that depends on -the host system and the locale. +the host system and on the locale.

    clock ()

    -This function returns an approximation of the amount of CPU time +Returns an approximation of the amount of CPU time used by the program, in seconds.

    exit ([code])

    -This function calls the C function exit, +Calls the C function exit, with an optional code, to terminate the program. The default value for code is 1. @@ -2694,12 +2876,16 @@ it accepts only a handle returned by

    Three other functions produce extra information about a function:

    -void lua_funcinfo (lua_Object func, char **filename, int *linedefined);
    +void lua_funcinfo (lua_Object func, char **source, int *linedefined);
     int lua_currentline (lua_Function func);
     char *lua_getobjname (lua_Object o, char **name);
     
    -lua_funcinfo gives the file name and the line where the -given function has been defined. +lua_funcinfo gives the source and the line where the +given function has been defined: +If the function was defined in a string, +source is that string; +If the function was defined in a file, +source starts with a @ followed by the file name. If the ``function'' is in fact the main code of a chunk, then linedefined is 0. If the function is a C function, @@ -2708,21 +2894,30 @@ then linedefined is -1, and filename is " The function lua_currentline gives the current line where a given function is executing. It only works if the function has been compiled with debug -information (see Section 4.9). +information. When no line information is available, lua_currentline returns -1.

    +The generation of debug information is controled by an internal flag, +which can be switched with +

    +int lua_setdebug (int debug);
    +
    +This function sets the flag and returns its previous value. +This flag can also be set from Lua (see Section 4.9). +

    Function lua_getobjname tries to find a reasonable name for a given function. Because functions in Lua are first class values, they do not have a fixed name: Some functions may be the value of many global variables, while others may be stored only in a table field. -Function lua_getobjname first checks whether the given -function is a tag method. -If so, it returns the string "tag-method", +Function lua_getobjname checks whether the given +function is a tag method or the value of a global variable. +If the given function is a tag method, then lua_getobjname +returns the string "tag-method", and name is set to point to the event name. -Otherwise, if the given function is the value of a global variable, +If the given function is the value of a global variable, then lua_getobjname returns the string "global", and name points to the variable name. If the given function is neither a tag method nor a global variable, @@ -2736,6 +2931,8 @@ The following functions allow the manipulation of the local variables of a given activation record. They only work if the function has been compiled with debug information (see Section 4.9). +Moreover, for these functions, a local variable becomes +visible in the line after its definition.

     lua_Object lua_getlocal (lua_Function func, int local_number, char **name);
     int lua_setlocal (lua_Function func, int local_number);
    @@ -2766,17 +2963,17 @@ then this function fails and returns 0.
     The Lua interpreter offers two hooks for debugging purposes:
     
     typedef void (*lua_CHFunction) (lua_Function func, char *file, int line);
    -extern lua_CHFunction lua_callhook;
    +lua_CHFunction lua_setcallhook (lua_CHFunction func);
     

    typedef void (*lua_LHFunction) (int line); -extern lua_LHFunction lua_linehook; +lua_LHFunction lua_setlinehook (lua_LHFunction func);

    -The first one is called whenever the interpreter enters or leaves a +The first hook is called whenever the interpreter enters or leaves a function. When entering a function, its parameters are a handle to the function activation record, -plus the file and the line where the function is defined (the same -information which is provided by lua_funcinfo); +plus the file and the line where the function is defined +(the same information which is provided by lua_funcinfo); when leaving a function, func is LUA_NOOBJECT, file is "(return)", and line is 0.

    @@ -2785,12 +2982,131 @@ the line of code it is executing. Its only parameter is the line number (the same information which is provided by the call lua_currentline(lua_stackedfunction(0))). -This second hook is only called if the active function +This second hook is called only if the active function has been compiled with debug information (see Section 4.9).

    A hook is disabled when its value is NULL, which is the initial value of both hooks. +Both lua_setcallhook and lua_setlinehook +set their corresponding hooks and return their previous values. +

    +

    +

    + +

    7.4 - The Reflexive Debugger Interface

    +

    +The library ldblib provides +the functionallity of the debugger interface to Lua programs. +If you want to use this library, +your host application must open it, +calling lua_dblibopen. +

    +You should exert great care when using this library. +The functions provided here should be used exclusively for debugging +and similar tasks (e.g. profiling). +Please resist the temptation to use them as a +usual programming tool. +They are slow and violate some (otherwise) secure aspects of the +language (e.g. privacy of local variables). +As a general rule, if your program does not need this library, +do not open it. +

    +

    +

    funcinfo (function)

    +

    +This function returns a table with information about the given function. +The table contains the following fields: +

    +
    kind
    : may be "C", if this is a C function, +"chunk", if this is the main part of a chunk, +or "Lua" if this is a Lua function. +

    +

    source
    the source where the function was defined. +If the function was defined in a string, +source is that string; +If the function was defined in a file, +source starts with a @ followed by the file name. +

    +

    def_line
    the line where the function was defined in the source +(only valid if this is a Lua function). +

    +

    where
    can be "global" if this function has a global name, +or "tag-method" if this function is a tag method handler. +

    +

    name
    if where = global, +name is the global name of the function; +if where = tag-method, +name is the event name of the tag method. +
    +

    +

    getstack (index)

    +

    +This function returns a table with informations about the function +running at level index of the stack. +Index 0 is the current function (getstack itself). +If index is bigger than the number of active functions, +the function returns nil. +The table contains all the fields returned by funcinfo, +plus the following: +

    +
    func
    the function at that level. +
    current
    the current line on the function execution; +this will be available only when the function is +precompiled with debug information. +

    +

    getlocal (index [, local])

    +

    +This function returns information about the local variables of the +function at level index of the stack. +It can be called in three ways. +When called without a local argument, +it returns a table, which associates variable names to their values. +When called with a name (a string) as local, +it returns the value of the local variable with that name. +Finally, when called with an index (a number), +it returns the value and the name of the local variable +with that index. +(The first parameter has index 1, and so on, +until the last active local variable.) +In that case, the function returns nil if there is no local +variable with the given index. +The specification by index is the only way to distinguish +homonym variables in a function. +

    +

    setlocal (index, local, newvalue)

    +

    +This function changes the values of the local variables of the +function at level index of the stack. +The local variable can be specified by name or by index; +see function getlocal. +

    +

    setcallhook (hook)

    +

    +Sets the function hook as the call hook; +this hook will be called every time the interpreter starts and +exits the execution of a function. +When Lua enters a function, +the hook is called with the function been called, +plus the source and the line where the function is defined. +When Lua exits a function, +the hook is called with no arguments. +

    +When called without arguments, +this function turns off call hooks. +

    +

    setlinehook (hook)

    +

    +Sets the function hook as the line hook; +this hook will be called every time the interpreter changes +the line of code it is executing. +The only argument to the hook is the line number the interpreter +is about to execut. +This hook is called only if the active function +has been compiled with debug information (see Section 4.9). +

    +When called without arguments, +this function turns off line hooks.

    @@ -2866,6 +3182,18 @@ the previous public versions of Lua, some differences had to be introduced. Here is a list of all these incompatibilities.

    +

    Incompatibilities with version 3.1

    +
      +
    • +In the debug API, the old variables lua_debug, +lua_callhook and lua_linehook now live inside lua_state. +Therefore, they are no longer directly accessible, and must be +manipulated only through the new functions lua_setdebug, +lua_setcallhook and lua_setlinehook. +

      +

    • Old pre-compiled code is obsolete, and must be re-compiled. +
    +

    Incompatibilities with version 3.0

      @@ -2877,7 +3205,7 @@ so any existing program that opens at least one standard library before calling Lua does not need to be modified.

    • Function dostring no longer accepts an optional second argument, -with a temporary error method. +with a temporary error handler. This facility is now provided by function call.

    • Function gsub no longer accepts an optional fourth argument @@ -2898,11 +3226,13 @@ programs should use an explicit assignment instead, such as

    -


    + Last update: -Fri Jul 10 15:10:14 EST 1998 +Wed Jul 7 13:36:24 EST 1999 by lhf. + + diff --git a/doc/readme.html b/doc/readme.html new file mode 100644 index 0000000..dd75b1d --- /dev/null +++ b/doc/readme.html @@ -0,0 +1,31 @@ + + +Lua documentation + + + + +
    +

    Lua documentation

    + + + +
    + +Last update: +Wed Jul 7 13:24:17 EST 1999 +by lhf. + + + + diff --git a/etc/README b/etc/README index fda602d..002190a 100644 --- a/etc/README +++ b/etc/README @@ -5,9 +5,9 @@ bin2c.c run with lua_dobuffer. This allows C programs to include all necessary Lua code, even in precompiled form. - Even if code is include in source form, bin2c is useful because it + Even if the code is included in source form, bin2c is useful because it avoids the hassle of having to quote special characters in C strings. - Example of usage: run bin2c file1 file2 ... > init.h. The in your C + Example of usage: Run bin2c file1 file2 ... > init.h. Then, in your C program, just do #include "init.h" anywhere in the *body* of a function. This will be equivalent to calling lua_dofile("file1"); lua_dofile("file2"); ... @@ -17,7 +17,8 @@ min.c setfallback.lua An implementation of fallbacks on top of tag methods. - Useful if you have Lua code written for version 2.5 or earlier. + Useful if you have Lua code written for version 2.5 or earlier, + which uses setfallback. If you have C code that uses lua_setfallback, then define LUA_COMPAT2_5 before building Lua (see config). diff --git a/etc/bin2c.c b/etc/bin2c.c index 349b7ee..fca82a5 100644 --- a/etc/bin2c.c +++ b/etc/bin2c.c @@ -2,15 +2,16 @@ * bin2c.c * convert binary files to byte arrays * Luiz Henrique de Figueiredo (lhf@tecgraf.puc-rio.br) -* 25 Jun 98 10:55:12 +* 24 Nov 98 12:15:27 */ #include #include +#include void dump(FILE* f, int n) { - printf("static unsigned char B%d[]={\n"); + printf("static unsigned char B%d[]={\n",n); for (n=1;;n++) { int c=getc(f); @@ -49,6 +50,7 @@ void emit(char* fn, int n) int main(int argc, char* argv[]) { + printf("/* code automatically generated by bin2c -- DO NOT EDIT */\n"); printf("{\n"); if (argc<2) { @@ -58,6 +60,9 @@ int main(int argc, char* argv[]) else { int i; + printf("/* #include'ing this file in a C program is equivalent to calling\n"); + for (i=1; i @@ -8,45 +8,41 @@ #include "lua.h" #include "luadebug.h" -static FILE* P; /* output file */ +static FILE* LOG; /* output file */ static int L=0; /* indentation level */ static void linehook(int line) { - fprintf(P,"%*sLINE(%d)\t-- %d\n",L,"",line,L); + fprintf(LOG,"%*sLINE(%d)\t-- %d\n",L,"",line,L); } static void callhook(lua_Function func, char* file, int line) { - fprintf(P,"%*sCALL('%s',%d)\t-- %d\n",L,"",file,line,L); + fprintf(LOG,"%*sCALL('%s',%d)\t-- %d\n",L,"",file,line,L); if (line==0 && strcmp(file,"(return)")==0) --L; else ++L; } -void start_trace(void) +void start_trace(FILE* logfile) { - lua_linehook=linehook; - lua_callhook=callhook; - lua_debug=1; -#if 0 - P=fopen("trace.out","w"); -#else - P=stderr; -#endif + lua_setlinehook(linehook); + lua_setcallhook(callhook); + lua_setdebug(1); + LOG=logfile; } void stop_trace(void) { - lua_linehook=NULL; - lua_callhook=NULL; - lua_debug=0; - fclose(P); + lua_setlinehook(NULL); + lua_setcallhook(NULL); + lua_setdebug(0); + fclose(LOG); } int main(void) { int rc; lua_open(); - start_trace(); + start_trace(stderr); rc=lua_dofile(0); stop_trace(); return rc; diff --git a/include/lauxlib.h b/include/lauxlib.h index e4d46fb..28a4664 100644 --- a/include/lauxlib.h +++ b/include/lauxlib.h @@ -1,5 +1,5 @@ /* -** $Id: lauxlib.h,v 1.9 1998/06/19 16:14:09 roberto Exp $ +** $Id: lauxlib.h,v 1.12 1999/03/10 14:19:41 roberto Exp $ ** Auxiliary functions for building Lua libraries ** See Copyright Notice in lua.h */ @@ -28,7 +28,11 @@ char *luaL_check_lstr (int numArg, long *len); #define luaL_opt_string(n, d) (luaL_opt_lstr((n), (d), NULL)) char *luaL_opt_lstr (int numArg, char *def, long *len); double luaL_check_number (int numArg); +#define luaL_check_int(n) ((int)luaL_check_number(n)) +#define luaL_check_long(n) ((long)luaL_check_number(n)) double luaL_opt_number (int numArg, double def); +#define luaL_opt_int(n,d) ((int)luaL_opt_number(n,d)) +#define luaL_opt_long(n,d) ((long)luaL_opt_number(n,d)) lua_Object luaL_functionarg (int arg); lua_Object luaL_tablearg (int arg); lua_Object luaL_nonnullarg (int numArg); @@ -42,6 +46,8 @@ int luaL_newbuffer (int size); void luaL_oldbuffer (int old); char *luaL_buffer (void); int luaL_findstring (char *name, char *list[]); +void luaL_chunkid (char *out, char *source, int len); +void luaL_filesource (char *out, char *filename, int len); #endif diff --git a/include/lua.h b/include/lua.h index bce5a2c..f46b2e1 100644 --- a/include/lua.h +++ b/include/lua.h @@ -1,5 +1,5 @@ /* -** $Id: lua.h,v 1.23 1998/06/18 16:51:53 roberto Exp $ +** $Id: lua.h,v 1.32 1999/05/11 20:29:19 roberto Exp $ ** Lua - An Extensible Extension Language ** TeCGraf: Grupo de Tecnologia em Computacao Grafica, PUC-Rio, Brazil ** e-mail: lua@tecgraf.puc-rio.br @@ -11,8 +11,8 @@ #ifndef lua_h #define lua_h -#define LUA_VERSION "Lua 3.1" -#define LUA_COPYRIGHT "Copyright (C) 1994-1998 TeCGraf, PUC-Rio" +#define LUA_VERSION "Lua 3.2" +#define LUA_COPYRIGHT "Copyright (C) 1994-1999 TeCGraf, PUC-Rio" #define LUA_AUTHORS "W. Celes, R. Ierusalimschy & L. H. de Figueiredo" @@ -20,19 +20,18 @@ #define LUA_ANYTAG (-1) -typedef void (*lua_CFunction) (void); -typedef unsigned int lua_Object; - typedef struct lua_State lua_State; extern lua_State *lua_state; +typedef void (*lua_CFunction) (void); +typedef unsigned int lua_Object; + void lua_open (void); void lua_close (void); lua_State *lua_setstate (lua_State *st); lua_Object lua_settagmethod (int tag, char *event); /* In: new method */ lua_Object lua_gettagmethod (int tag, char *event); -lua_Object lua_seterrormethod (void); /* In: new method */ int lua_newtag (void); int lua_copytagmethods (int tagto, int tagfrom); @@ -90,6 +89,9 @@ lua_Object lua_rawgettable (void); /* In: table, index */ int lua_tag (lua_Object object); +char *lua_nextvar (char *varname); /* Out: value */ +int lua_next (lua_Object o, int i); + /* Out: ref, value */ int lua_ref (int lock); /* In: value */ lua_Object lua_getref (int ref); @@ -101,29 +103,23 @@ long lua_collectgarbage (long limit); /* =============================================================== */ -/* some useful macros/derived functions */ +/* some useful macros/functions */ -int (lua_call) (char *name); #define lua_call(name) lua_callfunction(lua_getglobal(name)) -void (lua_pushref) (int ref); #define lua_pushref(ref) lua_pushobject(lua_getref(ref)) -int (lua_refobject) (lua_Object o, int l); #define lua_refobject(o,l) (lua_pushobject(o), lua_ref(l)) -void (lua_register) (char *n, lua_CFunction f); #define lua_register(n,f) (lua_pushcfunction(f), lua_setglobal(n)) -void (lua_pushuserdata) (void *u); #define lua_pushuserdata(u) lua_pushusertag(u, 0) -void (lua_pushcfunction) (lua_CFunction f); #define lua_pushcfunction(f) lua_pushcclosure(f, 0) -int (lua_clonetag) (int t); #define lua_clonetag(t) lua_copytagmethods(lua_newtag(), (t)) +lua_Object lua_seterrormethod (void); /* In: new method */ /* ========================================================================== ** for compatibility with old versions. Avoid using these macros/functions @@ -162,7 +158,7 @@ lua_Object lua_setfallback (char *event, lua_CFunction fallback); /****************************************************************************** -* Copyright (c) 1994-1998 TeCGraf, PUC-Rio. All rights reserved. +* Copyright (c) 1994-1999 TeCGraf, PUC-Rio. All rights reserved. * * Permission is hereby granted, without written agreement and without license * or royalty fees, to use, copy, modify, and distribute this software and its @@ -192,5 +188,6 @@ lua_Object lua_setfallback (char *event, lua_CFunction fallback); * The Lua language and this implementation have been entirely designed and * written by Waldemar Celes Filho, Roberto Ierusalimschy and * Luiz Henrique de Figueiredo at TeCGraf, PUC-Rio. +* * This implementation contains no third-party code. ******************************************************************************/ diff --git a/include/luadebug.h b/include/luadebug.h index 36726f7..1dc9f20 100644 --- a/include/luadebug.h +++ b/include/luadebug.h @@ -1,5 +1,5 @@ /* -** $Id: luadebug.h,v 1.2 1998/06/19 16:14:09 roberto Exp $ +** $Id: luadebug.h,v 1.6 1999/03/04 21:17:26 roberto Exp $ ** Debugging API ** See Copyright Notice in lua.h */ @@ -17,17 +17,18 @@ typedef void (*lua_LHFunction) (int line); typedef void (*lua_CHFunction) (lua_Function func, char *file, int line); lua_Function lua_stackedfunction (int level); -void lua_funcinfo (lua_Object func, char **filename, int *linedefined); +void lua_funcinfo (lua_Object func, char **source, int *linedefined); int lua_currentline (lua_Function func); char *lua_getobjname (lua_Object o, char **name); lua_Object lua_getlocal (lua_Function func, int local_number, char **name); int lua_setlocal (lua_Function func, int local_number); +int lua_nups (lua_Function func); -extern lua_LHFunction lua_linehook; -extern lua_CHFunction lua_callhook; -extern int lua_debug; +lua_LHFunction lua_setlinehook (lua_LHFunction func); +lua_CHFunction lua_setcallhook (lua_CHFunction func); +int lua_setdebug (int debug); #endif diff --git a/include/lualib.h b/include/lualib.h index 583f1b5..c718786 100644 --- a/include/lualib.h +++ b/include/lualib.h @@ -1,5 +1,5 @@ /* -** $Id: lualib.h,v 1.4 1998/06/19 16:14:09 roberto Exp $ +** $Id: lualib.h,v 1.6 1999/05/05 19:23:11 roberto Exp $ ** Lua standard libraries ** See Copyright Notice in lua.h */ @@ -10,12 +10,13 @@ #include "lua.h" - void lua_iolibopen (void); void lua_strlibopen (void); void lua_mathlibopen (void); +void lua_dblibopen (void); +void lua_userinit (void); /* To keep compatibility with old versions */ @@ -28,7 +29,8 @@ void lua_mathlibopen (void); /* Auxiliary functions (private) */ -int luaI_singlematch (int c, char *p, char **ep); +char *luaI_classend (char *p); +int luaI_singlematch (int c, char *p, char *ep); #endif diff --git a/src/lapi.c b/src/lapi.c index 9db0278..0a5b99d 100644 --- a/src/lapi.c +++ b/src/lapi.c @@ -1,5 +1,5 @@ /* -** $Id: lapi.c,v 1.25 1998/06/05 22:17:44 roberto Exp $ +** $Id: lapi.c,v 1.47 1999/06/22 20:37:23 roberto Exp $ ** Lua API ** See Copyright Notice in lua.h */ @@ -25,17 +25,16 @@ char lua_ident[] = "$Lua: " LUA_VERSION " " LUA_COPYRIGHT " $\n" - "$Autores: " LUA_AUTHORS " $"; + "$Authors: " LUA_AUTHORS " $"; -TObject *luaA_Address (lua_Object o) -{ - return Address(o); +TObject *luaA_Address (lua_Object o) { + return (o != LUA_NOOBJECT) ? Address(o) : NULL; } -static int normalized_type (TObject *o) +static lua_Type normalized_type (TObject *o) { int t = ttype(o); switch (t) { @@ -71,12 +70,8 @@ void luaA_packresults (void) } -int luaA_passresults (void) -{ - luaD_checkstack(L->Cstack.num); - memcpy(L->stack.top, L->Cstack.lua2C+L->stack.stack, - L->Cstack.num*sizeof(TObject)); - L->stack.top += L->Cstack.num; +int luaA_passresults (void) { + L->Cstack.base = L->Cstack.lua2C; /* position of first result */ return L->Cstack.num; } @@ -88,24 +83,29 @@ static void checkCparams (int nParams) } -static lua_Object put_luaObject (TObject *o) -{ +static lua_Object put_luaObject (TObject *o) { luaD_openstack((L->stack.top-L->stack.stack)-L->Cstack.base); L->stack.stack[L->Cstack.base++] = *o; return L->Cstack.base; /* this is +1 real position (see Ref) */ } -static lua_Object put_luaObjectonTop (void) -{ +static lua_Object put_luaObjectonTop (void) { luaD_openstack((L->stack.top-L->stack.stack)-L->Cstack.base); L->stack.stack[L->Cstack.base++] = *(--L->stack.top); return L->Cstack.base; /* this is +1 real position (see Ref) */ } -lua_Object lua_pop (void) -{ +static void top2LC (int n) { + /* Put the 'n' elements on the top as the Lua2C contents */ + L->Cstack.base = (L->stack.top-L->stack.stack); /* new base */ + L->Cstack.lua2C = L->Cstack.base-n; /* position of the new results */ + L->Cstack.num = n; /* number of results */ +} + + +lua_Object lua_pop (void) { checkCparams(1); return put_luaObjectonTop(); } @@ -131,7 +131,7 @@ int lua_callfunction (lua_Object function) else { luaD_openstack((L->stack.top-L->stack.stack)-L->Cstack.base); set_normalized(L->stack.stack+L->Cstack.base, Address(function)); - return luaD_protectedrun(MULT_RET); + return luaD_protectedrun(); } } @@ -150,12 +150,12 @@ lua_Object lua_settagmethod (int tag, char *event) } -lua_Object lua_seterrormethod (void) -{ - TObject temp = L->errorim; +lua_Object lua_seterrormethod (void) { + lua_Object temp; checkCparams(1); - L->errorim = *(--L->stack.top); - return put_luaObject(&temp); + temp = lua_getglobal("_ERRORMESSAGE"); + lua_setglobal("_ERRORMESSAGE"); + return temp; } @@ -167,34 +167,26 @@ lua_Object lua_gettable (void) } -lua_Object lua_rawgettable (void) -{ +lua_Object lua_rawgettable (void) { checkCparams(2); if (ttype(L->stack.top-2) != LUA_T_ARRAY) lua_error("indexed expression not a table in rawgettable"); - else { - TObject *h = luaH_get(avalue(L->stack.top-2), L->stack.top-1); - --L->stack.top; - if (h != NULL) - *(L->stack.top-1) = *h; - else - ttype(L->stack.top-1) = LUA_T_NIL; - } + *(L->stack.top-2) = *luaH_get(avalue(L->stack.top-2), L->stack.top-1); + --L->stack.top; return put_luaObjectonTop(); } -void lua_settable (void) -{ +void lua_settable (void) { checkCparams(3); - luaV_settable(L->stack.top-3, 1); + luaV_settable(L->stack.top-3); + L->stack.top -= 2; /* pop table and index */ } -void lua_rawsettable (void) -{ +void lua_rawsettable (void) { checkCparams(3); - luaV_settable(L->stack.top-3, 0); + luaV_rawsettable(L->stack.top-3); } @@ -373,14 +365,11 @@ void luaA_pushobject (TObject *o) incr_top; } -void lua_pushobject (lua_Object o) -{ +void lua_pushobject (lua_Object o) { if (o == LUA_NOOBJECT) lua_error("API error - attempt to push a NOOBJECT"); - else { - set_normalized(L->stack.top, Address(o)); - incr_top; - } + set_normalized(L->stack.top, Address(o)); + incr_top; } @@ -426,22 +415,108 @@ void lua_settag (int tag) break; default: luaL_verror("cannot change the tag of a %.20s", - luaO_typenames[-ttype((L->stack.top-1))]); + luaO_typename(L->stack.top-1)); } L->stack.top--; } +TaggedString *luaA_nextvar (TaggedString *g) { + if (g == NULL) + g = (TaggedString *)L->rootglobal.next; /* first variable */ + else { + /* check whether name is in global var list */ + luaL_arg_check((GCnode *)g != g->head.next, 1, "variable name expected"); + g = (TaggedString *)g->head.next; /* get next */ + } + while (g && g->u.s.globalval.ttype == LUA_T_NIL) /* skip globals with nil */ + g = (TaggedString *)g->head.next; + if (g) { + ttype(L->stack.top) = LUA_T_STRING; tsvalue(L->stack.top) = g; + incr_top; + luaA_pushobject(&g->u.s.globalval); + } + return g; +} + + +char *lua_nextvar (char *varname) { + TaggedString *g = (varname == NULL) ? NULL : luaS_new(varname); + g = luaA_nextvar(g); + if (g) { + top2LC(2); + return g->str; + } + else { + top2LC(0); + return NULL; + } +} + + +int luaA_next (Hash *t, int i) { + int tsize = nhash(t); + for (; ilinehook; + L->linehook = func; + return old; +} + +lua_CHFunction lua_setcallhook (lua_CHFunction func) { + lua_CHFunction old = L->callhook; + L->callhook = func; + return old; +} + +int lua_setdebug (int debug) { + int old = L->debug; + L->debug = debug; + return old; +} + +/* }====================================================== */ -/* Hooks */ -lua_CHFunction lua_callhook = NULL; -lua_LHFunction lua_linehook = NULL; + +/* +** {====================================================== +** Debug interface +** ======================================================= +*/ lua_Function lua_stackedfunction (int level) @@ -457,6 +532,12 @@ lua_Function lua_stackedfunction (int level) } +int lua_nups (lua_Function func) { + TObject *o = luaA_Address(func); + return (!o || normalized_type(o) != LUA_T_CLOSURE) ? 0 : o->value.cl->nelems; +} + + int lua_currentline (lua_Function func) { TObject *f = Address(func); @@ -465,8 +546,7 @@ int lua_currentline (lua_Function func) } -lua_Object lua_getlocal (lua_Function func, int local_number, char **name) -{ +lua_Object lua_getlocal (lua_Function func, int local_number, char **name) { /* check whether func is a Lua function */ if (lua_tag(func) != LUA_T_PROTO) return LUA_NOOBJECT; @@ -477,7 +557,7 @@ lua_Object lua_getlocal (lua_Function func, int local_number, char **name) if (*name) { /* if "*name", there must be a LUA_T_LINE */ /* therefore, f+2 points to function base */ - return Ref((f+2)+(local_number-1)); + return put_luaObject((f+2)+(local_number-1)); } else return LUA_NOOBJECT; @@ -508,18 +588,17 @@ int lua_setlocal (lua_Function func, int local_number) } -void lua_funcinfo (lua_Object func, char **filename, int *linedefined) -{ +void lua_funcinfo (lua_Object func, char **source, int *linedefined) { if (!lua_isfunction(func)) - lua_error("API - `funcinfo' called with a non-function value"); + lua_error("API error - `funcinfo' called with a non-function value"); else { TObject *f = luaA_protovalue(Address(func)); if (normalized_type(f) == LUA_T_PROTO) { - *filename = tfvalue(f)->fileName->str; + *source = tfvalue(f)->source->str; *linedefined = tfvalue(f)->lineDefined; } else { - *filename = "(C)"; + *source = "(C)"; *linedefined = -1; } } @@ -534,31 +613,37 @@ static int checkfunc (TObject *o) char *lua_getobjname (lua_Object o, char **name) { /* try to find a name for given function */ - set_normalized(L->stack.top, Address(o)); /* to be accessed by "checkfunc */ - if ((*name = luaT_travtagmethods(checkfunc)) != NULL) - return "tag-method"; - else if ((*name = luaS_travsymbol(checkfunc)) != NULL) + set_normalized(L->stack.top, Address(o)); /* to be accessed by "checkfunc" */ + if ((*name = luaS_travsymbol(checkfunc)) != NULL) return "global"; + else if ((*name = luaT_travtagmethods(checkfunc)) != NULL) + return "tag-method"; else return ""; } +/* }====================================================== */ + + /* -** ======================================================= +** {====================================================== ** BLOCK mechanism ** ======================================================= */ -void lua_beginblock (void) -{ - if (L->numCblocks >= MAX_C_BLOCKS) - lua_error("too many nested blocks"); +#ifndef MAX_C_BLOCKS +#define MAX_C_BLOCKS 1000 /* arbitrary limit */ +#endif + + +void lua_beginblock (void) { + luaM_growvector(L->Cblocks, L->numCblocks, 1, struct C_Lua_Stack, + "too many nested blocks", MAX_C_BLOCKS); L->Cblocks[L->numCblocks] = L->Cstack; L->numCblocks++; } -void lua_endblock (void) -{ +void lua_endblock (void) { --L->numCblocks; L->Cstack = L->Cblocks[L->numCblocks]; luaD_adjusttop(L->Cstack.base); @@ -566,8 +651,7 @@ void lua_endblock (void) -int lua_ref (int lock) -{ +int lua_ref (int lock) { int ref; checkCparams(1); ref = luaC_ref(L->stack.top-1, lock); @@ -577,32 +661,12 @@ int lua_ref (int lock) -lua_Object lua_getref (int ref) -{ +lua_Object lua_getref (int ref) { TObject *o = luaC_getref(ref); return (o ? put_luaObject(o) : LUA_NOOBJECT); } - -/* -** ======================================================= -** Derived functions -** ======================================================= -*/ -int (lua_call) (char *name) { return lua_call(name); } - -void (lua_pushref) (int ref) { lua_pushref(ref); } - -int (lua_refobject) (lua_Object o, int l) { return lua_refobject(o, l); } - -void (lua_register) (char *n, lua_CFunction f) { lua_register(n, f); } - -void (lua_pushuserdata) (void *u) { lua_pushuserdata(u); } - -void (lua_pushcfunction) (lua_CFunction f) { lua_pushcfunction(f); } - -int (lua_clonetag) (int t) { return lua_clonetag(t); } - +/* }====================================================== */ @@ -611,17 +675,15 @@ int (lua_clonetag) (int t) { return lua_clonetag(t); } ** API: set a function as a fallback */ -static void do_unprotectedrun (lua_CFunction f, int nParams, int nResults) -{ - StkId base = (L->stack.top-L->stack.stack)-nParams; +static void do_unprotectedrun (lua_CFunction f, int nParams, int nResults) { luaD_openstack(nParams); - L->stack.stack[base].ttype = LUA_T_CPROTO; - L->stack.stack[base].value.f = f; - luaD_call(base+1, nResults); + (L->stack.top-nParams)->ttype = LUA_T_CPROTO; + (L->stack.top-nParams)->value.f = f; + luaD_calln(nParams, nResults); } -lua_Object lua_setfallback (char *name, lua_CFunction fallback) -{ + +lua_Object lua_setfallback (char *name, lua_CFunction fallback) { lua_pushstring(name); lua_pushcfunction(fallback); do_unprotectedrun(luaT_setfallback, 2, 1); diff --git a/src/lapi.h b/src/lapi.h index ca9a117..638a847 100644 --- a/src/lapi.h +++ b/src/lapi.h @@ -1,5 +1,5 @@ /* -** $Id: lapi.h,v 1.2 1998/06/19 16:14:09 roberto Exp $ +** $Id: lapi.h,v 1.4 1999/02/23 14:57:28 roberto Exp $ ** Auxiliary functions from Lua API ** See Copyright Notice in lua.h */ @@ -16,5 +16,7 @@ TObject *luaA_Address (lua_Object o); void luaA_pushobject (TObject *o); void luaA_packresults (void); int luaA_passresults (void); +TaggedString *luaA_nextvar (TaggedString *g); +int luaA_next (Hash *t, int i); #endif diff --git a/src/lauxlib.c b/src/lauxlib.c index 0a972af..db929c4 100644 --- a/src/lauxlib.c +++ b/src/lauxlib.c @@ -1,5 +1,5 @@ /* -** $Id: lauxlib.c,v 1.12 1998/06/19 16:14:09 roberto Exp $ +** $Id: lauxlib.c,v 1.17 1999/03/11 18:59:19 roberto Exp $ ** Auxiliary functions for building Lua libraries ** See Copyright Notice in lua.h */ @@ -10,9 +10,10 @@ #include /* Please Notice: This file uses only the official API of Lua -** Any function declared here could be written as an application -** function. With care, these functions can be used by other libraries. +** Any function declared here could be written as an application function. +** With care, these functions can be used by other libraries. */ + #include "lauxlib.h" #include "lua.h" #include "luadebug.h" @@ -27,12 +28,13 @@ int luaL_findstring (char *name, char *list[]) { return -1; /* name not found */ } -void luaL_argerror (int numarg, char *extramsg) -{ +void luaL_argerror (int numarg, char *extramsg) { + lua_Function f = lua_stackedfunction(0); char *funcname; - lua_getobjname(lua_stackedfunction(0), &funcname); + lua_getobjname(f, &funcname); + numarg -= lua_nups(f); if (funcname == NULL) - funcname = "???"; + funcname = "?"; if (extramsg == NULL) luaL_verror("bad argument #%d to function `%.50s'", numarg, funcname); else @@ -109,3 +111,23 @@ void luaL_verror (char *fmt, ...) lua_error(buff); } + +void luaL_chunkid (char *out, char *source, int len) { + len -= 13; /* 13 = strlen("string ''...\0") */ + if (*source == '@') + sprintf(out, "file `%.*s'", len, source+1); + else if (*source == '(') + strcpy(out, "(C code)"); + else { + char *b = strchr(source , '\n'); /* stop string at first new line */ + int lim = (b && (b-source) - -#include "lauxlib.h" -#include "lmem.h" -#include "lstate.h" - - -/*------------------------------------------------------- -** Auxiliary buffer --------------------------------------------------------*/ - -#define BUFF_STEP 32 - -#define openspace(size) if (L->Mbuffnext+(size) > L->Mbuffsize) Openspace(size) - -static void Openspace (int size) -{ - lua_State *l = L; /* to optimize */ - int base = l->Mbuffbase-l->Mbuffer; - l->Mbuffsize *= 2; - if (l->Mbuffnext+size > l->Mbuffsize) /* still not big enough? */ - l->Mbuffsize = l->Mbuffnext+size; - l->Mbuffer = luaM_realloc(l->Mbuffer, l->Mbuffsize); - l->Mbuffbase = l->Mbuffer+base; -} - - -char *luaL_openspace (int size) -{ - openspace(size); - return L->Mbuffer+L->Mbuffnext; -} - - -void luaL_addchar (int c) -{ - openspace(BUFF_STEP); - L->Mbuffer[L->Mbuffnext++] = c; -} - - -void luaL_resetbuffer (void) -{ - L->Mbuffnext = L->Mbuffbase-L->Mbuffer; -} - - -void luaL_addsize (int n) -{ - L->Mbuffnext += n; -} - -int luaL_getsize (void) -{ - return L->Mbuffnext-(L->Mbuffbase-L->Mbuffer); -} - -int luaL_newbuffer (int size) -{ - int old = L->Mbuffbase-L->Mbuffer; - openspace(size); - L->Mbuffbase = L->Mbuffer+L->Mbuffnext; - return old; -} - - -void luaL_oldbuffer (int old) -{ - L->Mbuffnext = L->Mbuffbase-L->Mbuffer; - L->Mbuffbase = L->Mbuffer+old; -} - - -char *luaL_buffer (void) -{ - return L->Mbuffbase; -} - +/* +** $Id: lbuffer.c,v 1.9 1999/02/26 15:48:55 roberto Exp $ +** Auxiliary functions for building Lua libraries +** See Copyright Notice in lua.h +*/ + + +#include + +#include "lauxlib.h" +#include "lmem.h" +#include "lstate.h" + + +/*------------------------------------------------------- +** Auxiliary buffer +-------------------------------------------------------*/ + + +#define EXTRABUFF 32 + + +#define openspace(size) if (L->Mbuffnext+(size) > L->Mbuffsize) Openspace(size) + +static void Openspace (int size) { + lua_State *l = L; /* to optimize */ + size += EXTRABUFF; + l->Mbuffsize = l->Mbuffnext+size; + luaM_growvector(l->Mbuffer, l->Mbuffnext, size, char, arrEM, MAX_INT); +} + + +char *luaL_openspace (int size) { + openspace(size); + return L->Mbuffer+L->Mbuffnext; +} + + +void luaL_addchar (int c) { + openspace(1); + L->Mbuffer[L->Mbuffnext++] = (char)c; +} + + +void luaL_resetbuffer (void) { + L->Mbuffnext = L->Mbuffbase; +} + + +void luaL_addsize (int n) { + L->Mbuffnext += n; +} + +int luaL_getsize (void) { + return L->Mbuffnext-L->Mbuffbase; +} + +int luaL_newbuffer (int size) { + int old = L->Mbuffbase; + openspace(size); + L->Mbuffbase = L->Mbuffnext; + return old; +} + + +void luaL_oldbuffer (int old) { + L->Mbuffnext = L->Mbuffbase; + L->Mbuffbase = old; +} + + +char *luaL_buffer (void) { + return L->Mbuffer+L->Mbuffbase; +} + diff --git a/src/lbuiltin.c b/src/lbuiltin.c index 0fd39f7..c88ccd4 100644 --- a/src/lbuiltin.c +++ b/src/lbuiltin.c @@ -1,5 +1,5 @@ /* -** $Id: lbuiltin.c,v 1.32 1998/06/29 18:24:06 roberto Exp $ +** $Id: lbuiltin.c,v 1.59 1999/06/17 17:04:03 roberto Exp $ ** Built-in functions ** See Copyright Notice in lua.h */ @@ -23,11 +23,18 @@ #include "ltm.h" #include "lua.h" #include "lundump.h" +#include "lvm.h" -static void pushstring (TaggedString *s) -{ +/* +** {====================================================== +** Auxiliary functions +** ======================================================= +*/ + + +static void pushtagstring (TaggedString *s) { TObject o; o.ttype = LUA_T_STRING; o.value.ts = s; @@ -35,209 +42,126 @@ static void pushstring (TaggedString *s) } -static void nextvar (void) -{ - TObject *o = luaA_Address(luaL_nonnullarg(1)); - TaggedString *g; - if (ttype(o) == LUA_T_NIL) - g = (TaggedString *)L->rootglobal.next; - else { - luaL_arg_check(ttype(o) == LUA_T_STRING, 1, "variable name expected"); - g = tsvalue(o); - /* check whether name is in global var list */ - luaL_arg_check((GCnode *)g != g->head.next, 1, "variable name expected"); - g = (TaggedString *)g->head.next; - } - while (g && g->u.s.globalval.ttype == LUA_T_NIL) /* skip globals with nil */ - g = (TaggedString *)g->head.next; - if (g) { - pushstring(g); - luaA_pushobject(&g->u.s.globalval); +static real getsize (Hash *h) { + real max = 0; + int i; + for (i = 0; inode+i; + if (ttype(ref(n)) == LUA_T_NUMBER && + ttype(val(n)) != LUA_T_NIL && + nvalue(ref(n)) > max) + max = nvalue(ref(n)); } - else lua_pushnil(); + return max; } -static void foreachvar (void) -{ - TObject f = *luaA_Address(luaL_functionarg(1)); - GCnode *g; - StkId name = L->Cstack.base++; /* place to keep var name (to avoid GC) */ - ttype(L->stack.stack+name) = LUA_T_NIL; - L->stack.top++; - for (g = L->rootglobal.next; g; g = g->next) { - TaggedString *s = (TaggedString *)g; - if (s->u.s.globalval.ttype != LUA_T_NIL) { - ttype(L->stack.stack+name) = LUA_T_STRING; - tsvalue(L->stack.stack+name) = s; /* keep s on stack to avoid GC */ - luaA_pushobject(&f); - pushstring(s); - luaA_pushobject(&s->u.s.globalval); - luaD_call((L->stack.top-L->stack.stack)-2, 1); - if (ttype(L->stack.top-1) != LUA_T_NIL) - return; - L->stack.top--; - } - } +static real getnarg (Hash *a) { + TObject index; + TObject *value; + /* value = table.n */ + ttype(&index) = LUA_T_STRING; + tsvalue(&index) = luaS_new("n"); + value = luaH_get(a, &index); + return (ttype(value) == LUA_T_NUMBER) ? nvalue(value) : getsize(a); } -static void next (void) -{ - lua_Object o = luaL_tablearg(1); - lua_Object r = luaL_nonnullarg(2); - Node *n = luaH_next(luaA_Address(o), luaA_Address(r)); - if (n) { - luaA_pushobject(&n->ref); - luaA_pushobject(&n->val); - } - else lua_pushnil(); +static Hash *gethash (int arg) { + return avalue(luaA_Address(luaL_tablearg(arg))); } - -static void foreach (void) -{ - TObject t = *luaA_Address(luaL_tablearg(1)); - TObject f = *luaA_Address(luaL_functionarg(2)); - int i; - for (i=0; inhash; i++) { - Node *nd = &(avalue(&t)->node[i]); - if (ttype(ref(nd)) != LUA_T_NIL && ttype(val(nd)) != LUA_T_NIL) { - luaA_pushobject(&f); - luaA_pushobject(ref(nd)); - luaA_pushobject(val(nd)); - luaD_call((L->stack.top-L->stack.stack)-2, 1); - if (ttype(L->stack.top-1) != LUA_T_NIL) - return; - L->stack.top--; - } - } -} +/* }====================================================== */ -static void internaldostring (void) -{ - long l; - char *s = luaL_check_lstr(1, &l); - if (*s == ID_CHUNK) - lua_error("`dostring' cannot run pre-compiled code"); - if (lua_dobuffer(s, l, luaL_opt_string(2, NULL)) == 0) - if (luaA_passresults() == 0) - lua_pushuserdata(NULL); /* at least one result to signal no errors */ -} +/* +** {====================================================== +** Functions that use only the official API +** ======================================================= +*/ -static void internaldofile (void) -{ - char *fname = luaL_opt_string(1, NULL); - if (lua_dofile(fname) == 0) - if (luaA_passresults() == 0) - lua_pushuserdata(NULL); /* at least one result to signal no errors */ +/* +** If your system does not support "stderr", redefine this function, or +** redefine _ERRORMESSAGE so that it won't need _ALERT. +*/ +static void luaB_alert (void) { + fputs(luaL_check_string(1), stderr); } -static void to_string (void) { - lua_Object obj = lua_getparam(1); - char *buff = luaL_openspace(30); - TObject *o = luaA_Address(obj); - switch (ttype(o)) { - case LUA_T_NUMBER: - lua_pushstring(lua_getstring(obj)); - return; - case LUA_T_STRING: - lua_pushobject(obj); - return; - case LUA_T_ARRAY: { - sprintf(buff, "table: %p", (void *)o->value.a); - break; - } - case LUA_T_CLOSURE: { - sprintf(buff, "function: %p", (void *)o->value.cl); - break; - } - case LUA_T_PROTO: { - sprintf(buff, "function: %p", (void *)o->value.tf); - break; - } - case LUA_T_CPROTO: { - sprintf(buff, "function: %p", (void *)o->value.f); - break; - } - case LUA_T_USERDATA: { - sprintf(buff, "userdata: %p", o->value.ts->u.d.v); - break; - } - case LUA_T_NIL: - lua_pushstring("nil"); - return; - default: - LUA_INTERNALERROR("invalid type"); +/* +** Standard implementation of _ERRORMESSAGE. +** The library "iolib" redefines _ERRORMESSAGE for better error information. +*/ +static void error_message (void) { + lua_Object al = lua_rawgetglobal("_ALERT"); + if (lua_isfunction(al)) { /* avoid error loop if _ALERT is not defined */ + char buff[600]; + sprintf(buff, "lua error: %.500s\n", luaL_check_string(1)); + lua_pushstring(buff); + lua_callfunction(al); } - lua_pushstring(buff); } -static void luaI_print (void) { - TaggedString *ts = luaS_new("tostring"); +/* +** If your system does not support "stdout", just remove this function. +** If you need, you can define your own "print" function, following this +** model but changing "fputs" to put the strings at a proper place +** (a console window or a log file, for instance). +*/ +#ifndef MAXPRINT +#define MAXPRINT 40 /* arbitrary limit */ +#endif + +static void luaB_print (void) { + lua_Object args[MAXPRINT]; lua_Object obj; - int i = 1; - while ((obj = lua_getparam(i++)) != LUA_NOOBJECT) { - luaA_pushobject(&ts->u.s.globalval); - lua_pushobject(obj); - luaD_call((L->stack.top-L->stack.stack)-1, 1); - if (ttype(L->stack.top-1) != LUA_T_STRING) + int n = 0; + int i; + while ((obj = lua_getparam(n+1)) != LUA_NOOBJECT) { + luaL_arg_check(n < MAXPRINT, n+1, "too many arguments"); + args[n++] = obj; + } + for (i=0; istack.top-1)); - L->stack.top--; + if (i>0) fputs("\t", stdout); + fputs(lua_getstring(obj), stdout); } - printf("\n"); -} - - -static void luaI_type (void) -{ - lua_Object o = luaL_nonnullarg(1); - lua_pushstring(luaO_typenames[-ttype(luaA_Address(o))]); - lua_pushnumber(lua_tag(o)); + fputs("\n", stdout); } -static void tonumber (void) -{ - int base = luaL_opt_number(2, 10); +static void luaB_tonumber (void) { + int base = luaL_opt_int(2, 10); if (base == 10) { /* standard conversion */ lua_Object o = lua_getparam(1); - if (lua_isnumber(o)) - lua_pushnumber(lua_getnumber(o)); + if (lua_isnumber(o)) lua_pushnumber(lua_getnumber(o)); + else lua_pushnil(); /* not a number */ } else { char *s = luaL_check_string(1); - unsigned long n; + long n; luaL_arg_check(0 <= base && base <= 36, 2, "base out of range"); n = strtol(s, &s, base); - while (isspace(*s)) s++; /* skip trailing spaces */ + while (isspace((unsigned char)*s)) s++; /* skip trailing spaces */ if (*s) lua_pushnil(); /* invalid format: return nil */ else lua_pushnumber(n); } } -static void luaI_error (void) -{ +static void luaB_error (void) { lua_error(lua_getstring(lua_getparam(1))); } - -static void luaI_assert (void) -{ - lua_Object p = lua_getparam(1); - if (p == LUA_NOOBJECT || lua_isnil(p)) - luaL_verror("assertion failed! %.100s", luaL_opt_string(2, "")); -} - - -static void setglobal (void) -{ +static void luaB_setglobal (void) { char *n = luaL_check_string(1); lua_Object value = luaL_nonnullarg(2); lua_pushobject(value); @@ -245,8 +169,7 @@ static void setglobal (void) lua_pushobject(value); /* return given value */ } -static void rawsetglobal (void) -{ +static void luaB_rawsetglobal (void) { char *n = luaL_check_string(1); lua_Object value = luaL_nonnullarg(2); lua_pushobject(value); @@ -254,51 +177,111 @@ static void rawsetglobal (void) lua_pushobject(value); /* return given value */ } -static void getglobal (void) -{ +static void luaB_getglobal (void) { lua_pushobject(lua_getglobal(luaL_check_string(1))); } -static void rawgetglobal (void) -{ +static void luaB_rawgetglobal (void) { lua_pushobject(lua_rawgetglobal(luaL_check_string(1))); } -static void luatag (void) -{ +static void luaB_luatag (void) { lua_pushnumber(lua_tag(lua_getparam(1))); } +static void luaB_settag (void) { + lua_Object o = luaL_tablearg(1); + lua_pushobject(o); + lua_settag(luaL_check_int(2)); + lua_pushobject(o); /* return first argument */ +} + +static void luaB_newtag (void) { + lua_pushnumber(lua_newtag()); +} + +static void luaB_copytagmethods (void) { + lua_pushnumber(lua_copytagmethods(luaL_check_int(1), + luaL_check_int(2))); +} + +static void luaB_rawgettable (void) { + lua_pushobject(luaL_nonnullarg(1)); + lua_pushobject(luaL_nonnullarg(2)); + lua_pushobject(lua_rawgettable()); +} + +static void luaB_rawsettable (void) { + lua_pushobject(luaL_nonnullarg(1)); + lua_pushobject(luaL_nonnullarg(2)); + lua_pushobject(luaL_nonnullarg(3)); + lua_rawsettable(); +} + +static void luaB_settagmethod (void) { + lua_Object nf = luaL_nonnullarg(3); + lua_pushobject(nf); + lua_pushobject(lua_settagmethod(luaL_check_int(1), luaL_check_string(2))); +} + +static void luaB_gettagmethod (void) { + lua_pushobject(lua_gettagmethod(luaL_check_int(1), luaL_check_string(2))); +} -static int getnarg (lua_Object table) -{ - lua_Object temp; - /* temp = table.n */ - lua_pushobject(table); lua_pushstring("n"); temp = lua_rawgettable(); - return (lua_isnumber(temp) ? lua_getnumber(temp) : MAX_INT); +static void luaB_seterrormethod (void) { + lua_Object nf = luaL_functionarg(1); + lua_pushobject(nf); + lua_pushobject(lua_seterrormethod()); +} + +static void luaB_collectgarbage (void) { + lua_pushnumber(lua_collectgarbage(luaL_opt_int(1, 0))); } -static void luaI_call (void) -{ +/* }====================================================== */ + + +/* +** {====================================================== +** Functions that could use only the official API but +** do not, for efficiency. +** ======================================================= +*/ + +static void luaB_dostring (void) { + long l; + char *s = luaL_check_lstr(1, &l); + if (*s == ID_CHUNK) + lua_error("`dostring' cannot run pre-compiled code"); + if (lua_dobuffer(s, l, luaL_opt_string(2, s)) == 0) + if (luaA_passresults() == 0) + lua_pushuserdata(NULL); /* at least one result to signal no errors */ +} + + +static void luaB_dofile (void) { + char *fname = luaL_opt_string(1, NULL); + if (lua_dofile(fname) == 0) + if (luaA_passresults() == 0) + lua_pushuserdata(NULL); /* at least one result to signal no errors */ +} + + +static void luaB_call (void) { lua_Object f = luaL_nonnullarg(1); - lua_Object arg = luaL_tablearg(2); + Hash *arg = gethash(2); char *options = luaL_opt_string(3, ""); lua_Object err = lua_getparam(4); - int narg = getnarg(arg); + int narg = (int)getnarg(arg); int i, status; if (err != LUA_NOOBJECT) { /* set new error method */ lua_pushobject(err); err = lua_seterrormethod(); } /* push arg[1...n] */ - for (i=0; istack.top++) = *luaH_getint(arg, i+1); status = lua_callfunction(f); if (err != LUA_NOOBJECT) { /* restore old error method */ lua_pushobject(err); @@ -312,7 +295,7 @@ static void luaI_call (void) else lua_error(NULL); } - else { /* no errors */ + else { /* no errors */ if (strchr(options, 'p')) luaA_packresults(); else @@ -321,91 +304,306 @@ static void luaI_call (void) } -static void settag (void) -{ - lua_Object o = luaL_tablearg(1); - lua_pushobject(o); - lua_settag(luaL_check_number(2)); - lua_pushobject(o); /* returns first argument */ +static void luaB_nextvar (void) { + TObject *o = luaA_Address(luaL_nonnullarg(1)); + TaggedString *g; + if (ttype(o) == LUA_T_NIL) + g = NULL; + else { + luaL_arg_check(ttype(o) == LUA_T_STRING, 1, "variable name expected"); + g = tsvalue(o); + } + if (!luaA_nextvar(g)) + lua_pushnil(); } -static void newtag (void) -{ - lua_pushnumber(lua_newtag()); +static void luaB_next (void) { + Hash *a = gethash(1); + TObject *k = luaA_Address(luaL_nonnullarg(2)); + int i = (ttype(k) == LUA_T_NIL) ? 0 : luaH_pos(a, k)+1; + if (luaA_next(a, i) == 0) + lua_pushnil(); } -static void copytagmethods (void) -{ - lua_pushnumber(lua_copytagmethods(luaL_check_number(1), - luaL_check_number(2))); +static void luaB_tostring (void) { + lua_Object obj = lua_getparam(1); + TObject *o = luaA_Address(obj); + char buff[64]; + switch (ttype(o)) { + case LUA_T_NUMBER: + lua_pushstring(lua_getstring(obj)); + return; + case LUA_T_STRING: + lua_pushobject(obj); + return; + case LUA_T_ARRAY: + sprintf(buff, "table: %p", (void *)o->value.a); + break; + case LUA_T_CLOSURE: + sprintf(buff, "function: %p", (void *)o->value.cl); + break; + case LUA_T_PROTO: + sprintf(buff, "function: %p", (void *)o->value.tf); + break; + case LUA_T_CPROTO: + sprintf(buff, "function: %p", (void *)o->value.f); + break; + case LUA_T_USERDATA: + sprintf(buff, "userdata: %p", o->value.ts->u.d.v); + break; + case LUA_T_NIL: + lua_pushstring("nil"); + return; + default: + LUA_INTERNALERROR("invalid type"); + } + lua_pushstring(buff); } -static void rawgettable (void) -{ - lua_pushobject(luaL_nonnullarg(1)); - lua_pushobject(luaL_nonnullarg(2)); - lua_pushobject(lua_rawgettable()); +static void luaB_type (void) { + lua_Object o = luaL_nonnullarg(1); + lua_pushstring(luaO_typename(luaA_Address(o))); + lua_pushnumber(lua_tag(o)); } +/* }====================================================== */ -static void rawsettable (void) -{ - lua_pushobject(luaL_nonnullarg(1)); - lua_pushobject(luaL_nonnullarg(2)); - lua_pushobject(luaL_nonnullarg(3)); - lua_rawsettable(); + + +/* +** {====================================================== +** "Extra" functions +** These functions can be written in Lua, so you can +** delete them if you need a tiny Lua implementation. +** If you delete them, remove their entries in array +** "builtin_funcs". +** ======================================================= +*/ + +static void luaB_assert (void) { + lua_Object p = lua_getparam(1); + if (p == LUA_NOOBJECT || lua_isnil(p)) + luaL_verror("assertion failed! %.100s", luaL_opt_string(2, "")); } -static void settagmethod (void) -{ - lua_Object nf = luaL_nonnullarg(3); - lua_pushobject(nf); - lua_pushobject(lua_settagmethod((int)luaL_check_number(1), - luaL_check_string(2))); +static void luaB_foreachi (void) { + Hash *t = gethash(1); + int i; + int n = (int)getnarg(t); + TObject f; + /* 'f' cannot be a pointer to TObject, because it is on the stack, and the + stack may be reallocated by the call. Moreover, some C compilers do not + initialize structs, so we must do the assignment after the declaration */ + f = *luaA_Address(luaL_functionarg(2)); + luaD_checkstack(3); /* for f, ref, and val */ + for (i=1; i<=n; i++) { + *(L->stack.top++) = f; + ttype(L->stack.top) = LUA_T_NUMBER; nvalue(L->stack.top++) = i; + *(L->stack.top++) = *luaH_getint(t, i); + luaD_calln(2, 1); + if (ttype(L->stack.top-1) != LUA_T_NIL) + return; + L->stack.top--; + } } -static void gettagmethod (void) -{ - lua_pushobject(lua_gettagmethod((int)luaL_check_number(1), - luaL_check_string(2))); +static void luaB_foreach (void) { + Hash *a = gethash(1); + int i; + TObject f; /* see comment in 'foreachi' */ + f = *luaA_Address(luaL_functionarg(2)); + luaD_checkstack(3); /* for f, ref, and val */ + for (i=0; inhash; i++) { + Node *nd = &(a->node[i]); + if (ttype(val(nd)) != LUA_T_NIL) { + *(L->stack.top++) = f; + *(L->stack.top++) = *ref(nd); + *(L->stack.top++) = *val(nd); + luaD_calln(2, 1); + if (ttype(L->stack.top-1) != LUA_T_NIL) + return; + L->stack.top--; /* remove result */ + } + } } -static void seterrormethod (void) -{ - lua_Object nf = luaL_functionarg(1); - lua_pushobject(nf); - lua_pushobject(lua_seterrormethod()); +static void luaB_foreachvar (void) { + GCnode *g; + TObject f; /* see comment in 'foreachi' */ + f = *luaA_Address(luaL_functionarg(1)); + luaD_checkstack(4); /* for extra var name, f, var name, and globalval */ + for (g = L->rootglobal.next; g; g = g->next) { + TaggedString *s = (TaggedString *)g; + if (s->u.s.globalval.ttype != LUA_T_NIL) { + pushtagstring(s); /* keep (extra) s on stack to avoid GC */ + *(L->stack.top++) = f; + pushtagstring(s); + *(L->stack.top++) = s->u.s.globalval; + luaD_calln(2, 1); + if (ttype(L->stack.top-1) != LUA_T_NIL) { + L->stack.top--; + *(L->stack.top-1) = *L->stack.top; /* remove extra s */ + return; + } + L->stack.top-=2; /* remove result and extra s */ + } + } +} + + +static void luaB_getn (void) { + lua_pushnumber(getnarg(gethash(1))); +} + + +static void luaB_tinsert (void) { + Hash *a = gethash(1); + lua_Object v = lua_getparam(3); + int n = (int)getnarg(a); + int pos; + if (v != LUA_NOOBJECT) + pos = luaL_check_int(2); + else { /* called with only 2 arguments */ + v = luaL_nonnullarg(2); + pos = n+1; + } + luaV_setn(a, n+1); /* a.n = n+1 */ + for ( ;n>=pos; n--) + luaH_move(a, n, n+1); /* a[n+1] = a[n] */ + luaH_setint(a, pos, luaA_Address(v)); /* a[pos] = v */ +} + + +static void luaB_tremove (void) { + Hash *a = gethash(1); + int n = (int)getnarg(a); + int pos = luaL_opt_int(2, n); + if (n <= 0) return; /* table is "empty" */ + luaA_pushobject(luaH_getint(a, pos)); /* result = a[pos] */ + for ( ;posstack.top) = *luaA_Address(f); + *(L->stack.top+1) = *a; + *(L->stack.top+2) = *b; + L->stack.top += 3; + luaD_calln(2, 1); + } + else { /* a < b? */ + *(L->stack.top) = *a; + *(L->stack.top+1) = *b; + L->stack.top += 2; + luaV_comparison(LUA_T_NUMBER, LUA_T_NIL, LUA_T_NIL, IM_LT); + } + return ttype(--(L->stack.top)) != LUA_T_NIL; +} + +static void auxsort (Hash *a, int l, int u, lua_Object f) { + while (l < u) { /* for tail recursion */ + TObject *P; + int i, j; + /* sort elements a[l], a[(l+u)/2] and a[u] */ + if (sort_comp(f, luaH_getint(a, u), luaH_getint(a, l))) /* a[l]>a[u]? */ + swap(a, l, u); + if (u-l == 1) break; /* only 2 elements */ + i = (l+u)/2; + P = luaH_getint(a, i); + if (sort_comp(f, P, luaH_getint(a, l))) /* a[l]>a[i]? */ + swap(a, l, i); + else if (sort_comp(f, luaH_getint(a, u), P)) /* a[i]>a[u]? */ + swap(a, i, u); + if (u-l == 2) break; /* only 3 elements */ + P = L->stack.top++; + *P = *luaH_getint(a, i); /* save pivot on stack (for GC) */ + swap(a, i, u-1); /* put median element as pivot (a[u-1]) */ + /* a[l] <= P == a[u-1] <= a[u], only needs to sort from l+1 to u-2 */ + i = l; j = u-1; + for (;;) { + /* invariant: a[l..i] <= P <= a[j..u] */ + while (sort_comp(f, luaH_getint(a, ++i), P)) /* stop when a[i] >= P */ + if (i>u) lua_error("invalid order function for sorting"); + while (sort_comp(f, P, luaH_getint(a, --j))) /* stop when a[j] <= P */ + if (jstack.top--; /* remove pivot from stack */ + /* a[l..i-1] <= a[i] == P <= a[i+1..u] */ + /* adjust so that smaller "half" is in [j..i] and larger one in [l..u] */ + if (i-l < u-i) { + j=l; i=i-1; l=i+2; + } + else { + j=i+1; i=u; u=j-2; + } + auxsort(a, j, i, f); /* call recursively the smaller one */ + } /* repeat the routine for the larger one */ +} + +static void luaB_sort (void) { + lua_Object t = lua_getparam(1); + Hash *a = gethash(1); + int n = (int)getnarg(a); + lua_Object func = lua_getparam(2); + luaL_arg_check(func == LUA_NOOBJECT || lua_isfunction(func), 2, + "function expected"); + luaD_checkstack(4); /* for Pivot, f, a, b (sort_comp) */ + auxsort(a, 1, n, func); + lua_pushobject(t); } +/* }}===================================================== */ + /* -** ======================================================= +** ====================================================== */ + + + +#ifdef DEBUG +/* +** {====================================================== ** some DEBUG functions ** ======================================================= */ -#ifdef DEBUG -static void mem_query (void) -{ +static void mem_query (void) { lua_pushnumber(totalmem); lua_pushnumber(numblocks); } -static void countlist (void) -{ +static void query_strings (void) { + lua_pushnumber(L->string_root[luaL_check_int(1)].nuse); +} + + +static void countlist (void) { char *s = luaL_check_string(1); GCnode *l = (s[0]=='t') ? L->roottable.next : (s[0]=='c') ? L->rootcl.next : (s[0]=='p') ? L->rootproto.next : L->rootglobal.next; @@ -418,8 +616,7 @@ static void countlist (void) } -static void testC (void) -{ +static void testC (void) { #define getnum(s) ((*s++) - '0') #define getname(s) (nome[0] = *s++, nome) @@ -428,7 +625,7 @@ static void testC (void) char nome[2]; char *s = luaL_check_string(1); nome[1] = 0; - while (1) { + for (;;) { switch (*s++) { case '0': case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': @@ -454,11 +651,17 @@ static void testC (void) case '=': lua_setglobal(getname(s)); break; case 's': lua_pushstring(getname(s)); break; case 'o': lua_pushobject(reg[getnum(s)]); break; - case 'f': (lua_call)(getname(s)); break; + case 'f': lua_call(getname(s)); break; case 'i': reg[getnum(s)] = lua_gettable(); break; case 'I': reg[getnum(s)] = lua_rawgettable(); break; case 't': lua_settable(); break; case 'T': lua_rawsettable(); break; + case 'N' : lua_pushstring(lua_nextvar(lua_getstring(reg[getnum(s)]))); + break; + case 'n' : { int n=getnum(s); + n=lua_next(reg[n], (int)lua_getnumber(reg[getnum(s)])); + lua_pushnumber(n); break; + } default: luaL_verror("unknown command in `testC': %c", *(s-1)); } if (*s == 0) return; @@ -466,13 +669,12 @@ static void testC (void) } } +/* }====================================================== */ #endif -/* -** Internal functions -*/ -static struct luaL_reg int_funcs[] = { + +static struct luaL_reg builtin_funcs[] = { #ifdef LUA_COMPAT2_5 {"setfallback", luaT_setfallback}, #endif @@ -480,46 +682,54 @@ static struct luaL_reg int_funcs[] = { {"testC", testC}, {"totalmem", mem_query}, {"count", countlist}, + {"querystr", query_strings}, #endif - {"assert", luaI_assert}, - {"call", luaI_call}, - {"collectgarbage", luaI_collectgarbage}, - {"dofile", internaldofile}, - {"copytagmethods", copytagmethods}, - {"dostring", internaldostring}, - {"error", luaI_error}, - {"foreach", foreach}, - {"foreachvar", foreachvar}, - {"getglobal", getglobal}, - {"newtag", newtag}, - {"next", next}, - {"nextvar", nextvar}, - {"print", luaI_print}, - {"rawgetglobal", rawgetglobal}, - {"rawgettable", rawgettable}, - {"rawsetglobal", rawsetglobal}, - {"rawsettable", rawsettable}, - {"seterrormethod", seterrormethod}, - {"setglobal", setglobal}, - {"settagmethod", settagmethod}, - {"gettagmethod", gettagmethod}, - {"settag", settag}, - {"tonumber", tonumber}, - {"tostring", to_string}, - {"tag", luatag}, - {"type", luaI_type} + {"_ALERT", luaB_alert}, + {"_ERRORMESSAGE", error_message}, + {"call", luaB_call}, + {"collectgarbage", luaB_collectgarbage}, + {"copytagmethods", luaB_copytagmethods}, + {"dofile", luaB_dofile}, + {"dostring", luaB_dostring}, + {"error", luaB_error}, + {"getglobal", luaB_getglobal}, + {"gettagmethod", luaB_gettagmethod}, + {"newtag", luaB_newtag}, + {"next", luaB_next}, + {"nextvar", luaB_nextvar}, + {"print", luaB_print}, + {"rawgetglobal", luaB_rawgetglobal}, + {"rawgettable", luaB_rawgettable}, + {"rawsetglobal", luaB_rawsetglobal}, + {"rawsettable", luaB_rawsettable}, + {"seterrormethod", luaB_seterrormethod}, + {"setglobal", luaB_setglobal}, + {"settag", luaB_settag}, + {"settagmethod", luaB_settagmethod}, + {"tag", luaB_luatag}, + {"tonumber", luaB_tonumber}, + {"tostring", luaB_tostring}, + {"type", luaB_type}, + /* "Extra" functions */ + {"assert", luaB_assert}, + {"foreach", luaB_foreach}, + {"foreachi", luaB_foreachi}, + {"foreachvar", luaB_foreachvar}, + {"getn", luaB_getn}, + {"sort", luaB_sort}, + {"tinsert", luaB_tinsert}, + {"tremove", luaB_tremove} }; -#define INTFUNCSIZE (sizeof(int_funcs)/sizeof(int_funcs[0])) +#define INTFUNCSIZE (sizeof(builtin_funcs)/sizeof(builtin_funcs[0])) -void luaB_predefine (void) -{ +void luaB_predefine (void) { /* pre-register mem error messages, to avoid loop when error arises */ luaS_newfixedstring(tableEM); luaS_newfixedstring(memEM); - luaL_openlib(int_funcs, (sizeof(int_funcs)/sizeof(int_funcs[0]))); + luaL_openlib(builtin_funcs, (sizeof(builtin_funcs)/sizeof(builtin_funcs[0]))); lua_pushstring(LUA_VERSION); lua_setglobal("_VERSION"); } diff --git a/src/ldo.c b/src/ldo.c index f7a9f27..bf840bf 100644 --- a/src/ldo.c +++ b/src/ldo.c @@ -1,5 +1,5 @@ /* -** $Id: ldo.c,v 1.27 1998/06/19 18:47:06 roberto Exp $ +** $Id: ldo.c,v 1.45 1999/06/22 20:37:23 roberto Exp $ ** Stack and Call structure of Lua ** See Copyright Notice in lua.h */ @@ -10,6 +10,7 @@ #include #include +#include "lauxlib.h" #include "ldo.h" #include "lfunc.h" #include "lgc.h" @@ -17,6 +18,7 @@ #include "lobject.h" #include "lparser.h" #include "lstate.h" +#include "lstring.h" #include "ltm.h" #include "lua.h" #include "luadebug.h" @@ -27,42 +29,33 @@ #ifndef STACK_LIMIT -#define STACK_LIMIT 6000 +#define STACK_LIMIT 6000 /* arbitrary limit */ #endif -/* -** Error messages -*/ - -static void stderrorim (void) -{ - fprintf(stderr, "lua error: %s\n", lua_getstring(lua_getparam(1))); -} - +#define STACK_UNIT 128 -#define STACK_UNIT 128 +#ifdef DEBUG +#undef STACK_UNIT +#define STACK_UNIT 2 +#endif -void luaD_init (void) -{ +void luaD_init (void) { L->stack.stack = luaM_newvector(STACK_UNIT, TObject); L->stack.top = L->stack.stack; L->stack.last = L->stack.stack+(STACK_UNIT-1); - ttype(&L->errorim) = LUA_T_CPROTO; - fvalue(&L->errorim) = stderrorim; } -void luaD_checkstack (int n) -{ +void luaD_checkstack (int n) { struct Stack *S = &L->stack; if (S->last-S->top <= n) { StkId top = S->top-S->stack; - int stacksize = (S->last-S->stack)+1+STACK_UNIT+n; - S->stack = luaM_reallocvector(S->stack, stacksize, TObject); + int stacksize = (S->last-S->stack)+STACK_UNIT+n; + luaM_reallocvector(S->stack, stacksize, TObject); S->last = S->stack+(stacksize-1); S->top = S->stack + top; if (stacksize >= STACK_LIMIT) { /* stack overflow? */ @@ -78,8 +71,7 @@ void luaD_checkstack (int n) /* ** Adjust stack. Set top to the given value, pushing NILs if needed. */ -void luaD_adjusttop (StkId newtop) -{ +void luaD_adjusttop (StkId newtop) { int diff = newtop-(L->stack.top-L->stack.stack); if (diff <= 0) L->stack.top += diff; @@ -94,38 +86,35 @@ void luaD_adjusttop (StkId newtop) /* ** Open a hole below "nelems" from the L->stack.top. */ -void luaD_openstack (int nelems) -{ +void luaD_openstack (int nelems) { luaO_memup(L->stack.top-nelems+1, L->stack.top-nelems, nelems*sizeof(TObject)); incr_top; } -void luaD_lineHook (int line) -{ +void luaD_lineHook (int line) { struct C_Lua_Stack oldCLS = L->Cstack; StkId old_top = L->Cstack.lua2C = L->Cstack.base = L->stack.top-L->stack.stack; L->Cstack.num = 0; - (*lua_linehook)(line); + (*L->linehook)(line); L->stack.top = L->stack.stack+old_top; L->Cstack = oldCLS; } -void luaD_callHook (StkId base, TProtoFunc *tf, int isreturn) -{ +void luaD_callHook (StkId base, TProtoFunc *tf, int isreturn) { struct C_Lua_Stack oldCLS = L->Cstack; StkId old_top = L->Cstack.lua2C = L->Cstack.base = L->stack.top-L->stack.stack; L->Cstack.num = 0; if (isreturn) - (*lua_callhook)(LUA_NOOBJECT, "(return)", 0); + (*L->callhook)(LUA_NOOBJECT, "(return)", 0); else { TObject *f = L->stack.stack+base-1; if (tf) - (*lua_callhook)(Ref(f), tf->fileName->str, tf->lineDefined); + (*L->callhook)(Ref(f), tf->source->str, tf->lineDefined); else - (*lua_callhook)(Ref(f), "(C)", -1); + (*L->callhook)(Ref(f), "(C)", -1); } L->stack.top = L->stack.stack+old_top; L->Cstack = oldCLS; @@ -137,28 +126,26 @@ void luaD_callHook (StkId base, TProtoFunc *tf, int isreturn) ** Cstack.num is the number of arguments; Cstack.lua2C points to the ** first argument. Returns an index to the first result from C. */ -static StkId callC (lua_CFunction f, StkId base) -{ - struct C_Lua_Stack *CS = &L->Cstack; - struct C_Lua_Stack oldCLS = *CS; +static StkId callC (lua_CFunction f, StkId base) { + struct C_Lua_Stack *cls = &L->Cstack; + struct C_Lua_Stack oldCLS = *cls; StkId firstResult; int numarg = (L->stack.top-L->stack.stack) - base; - CS->num = numarg; - CS->lua2C = base; - CS->base = base+numarg; /* == top-stack */ - if (lua_callhook) + cls->num = numarg; + cls->lua2C = base; + cls->base = base+numarg; /* == top-stack */ + if (L->callhook) luaD_callHook(base, NULL, 0); (*f)(); /* do the actual call */ - if (lua_callhook) /* func may have changed lua_callhook */ + if (L->callhook) /* func may have changed callhook */ luaD_callHook(base, NULL, 1); - firstResult = CS->base; - *CS = oldCLS; + firstResult = cls->base; + *cls = oldCLS; return firstResult; } -static StkId callCclosure (struct Closure *cl, lua_CFunction f, StkId base) -{ +static StkId callCclosure (struct Closure *cl, lua_CFunction f, StkId base) { TObject *pbase; int nup = cl->nelems; /* number of upvalues */ luaD_checkstack(nup); @@ -172,24 +159,25 @@ static StkId callCclosure (struct Closure *cl, lua_CFunction f, StkId base) } -void luaD_callTM (TObject *f, int nParams, int nResults) -{ +void luaD_callTM (TObject *f, int nParams, int nResults) { luaD_openstack(nParams); *(L->stack.top-nParams-1) = *f; - luaD_call((L->stack.top-L->stack.stack)-nParams, nResults); + luaD_calln(nParams, nResults); } /* -** Call a function (C or Lua). The parameters must be on the L->stack.stack, -** between [L->stack.stack+base,L->stack.top). The function to be called is at L->stack.stack+base-1. -** When returns, the results are on the L->stack.stack, between [L->stack.stack+base-1,L->stack.top). +** Call a function (C or Lua). The parameters must be on the stack, +** between [top-nArgs,top). The function to be called is right below the +** arguments. +** When returns, the results are on the stack, between [top-nArgs-1,top). ** The number of results is nResults, unless nResults=MULT_RET. */ -void luaD_call (StkId base, int nResults) -{ +void luaD_calln (int nArgs, int nResults) { + struct Stack *S = &L->stack; /* to optimize */ + StkId base = (S->top-S->stack)-nArgs; + TObject *func = S->stack+base-1; StkId firstResult; - TObject *func = L->stack.stack+base-1; int i; switch (ttype(func)) { case LUA_T_CPROTO: @@ -214,23 +202,23 @@ void luaD_call (StkId base, int nResults) TObject *im = luaT_getimbyObj(func, IM_FUNCTION); if (ttype(im) == LUA_T_NIL) lua_error("call expression not a function"); - luaD_callTM(im, (L->stack.top-L->stack.stack)-(base-1), nResults); + luaD_callTM(im, (S->top-S->stack)-(base-1), nResults); return; } } /* adjust the number of results */ - if (nResults != MULT_RET) + if (nResults == MULT_RET) + nResults = (S->top-S->stack)-firstResult; + else luaD_adjusttop(firstResult+nResults); /* move results to base-1 (to erase parameters and function) */ base--; - nResults = L->stack.top - (L->stack.stack+firstResult); /* actual number of results */ for (i=0; istack.stack+base+i) = *(L->stack.stack+firstResult+i); - L->stack.top -= firstResult-base; + *(S->stack+base+i) = *(S->stack+firstResult+i); + S->top -= firstResult-base; } - /* ** Traverse all objects on L->stack.stack */ @@ -243,59 +231,50 @@ void luaD_travstack (int (*fn)(TObject *)) -static void message (char *s) -{ - TObject im = L->errorim; - if (ttype(&im) != LUA_T_NIL) { +static void message (char *s) { + TObject *em = &(luaS_new("_ERRORMESSAGE")->u.s.globalval); + if (ttype(em) == LUA_T_PROTO || ttype(em) == LUA_T_CPROTO || + ttype(em) == LUA_T_CLOSURE) { + *L->stack.top = *em; + incr_top; lua_pushstring(s); - luaD_callTM(&im, 1, 0); + luaD_calln(1, 0); } } /* ** Reports an error, and jumps up to the available recover label */ -void lua_error (char *s) -{ +void lua_error (char *s) { if (s) message(s); if (L->errorJmp) - longjmp(*((jmp_buf *)L->errorJmp), 1); + longjmp(L->errorJmp->b, 1); else { - fprintf (stderr, "lua: exit(1). Unable to recover\n"); + message("exit(1). Unable to recover.\n"); exit(1); } } -/* -** Call the function at L->Cstack.base, and incorporate results on -** the Lua2C structure. -*/ -static void do_callinc (int nResults) -{ - StkId base = L->Cstack.base; - luaD_call(base+1, nResults); - L->Cstack.lua2C = base; /* position of the luaM_new results */ - L->Cstack.num = (L->stack.top-L->stack.stack) - base; /* number of results */ - L->Cstack.base = base + L->Cstack.num; /* incorporate results on L->stack.stack */ -} - /* ** Execute a protected call. Assumes that function is at L->Cstack.base and ** parameters are on top of it. Leave nResults on the stack. */ -int luaD_protectedrun (int nResults) -{ - jmp_buf myErrorJmp; - int status; +int luaD_protectedrun (void) { volatile struct C_Lua_Stack oldCLS = L->Cstack; - jmp_buf *volatile oldErr = L->errorJmp; + struct lua_longjmp myErrorJmp; + volatile int status; + struct lua_longjmp *volatile oldErr = L->errorJmp; L->errorJmp = &myErrorJmp; - if (setjmp(myErrorJmp) == 0) { - do_callinc(nResults); + if (setjmp(myErrorJmp.b) == 0) { + StkId base = L->Cstack.base; + luaD_calln((L->stack.top-L->stack.stack)-base-1, MULT_RET); + L->Cstack.lua2C = base; /* position of the new results */ + L->Cstack.num = (L->stack.top-L->stack.stack) - base; + L->Cstack.base = base + L->Cstack.num; /* incorporate results on stack */ status = 0; } - else { /* an error occurred: restore L->Cstack and L->stack.top */ + else { /* an error occurred: restore L->Cstack and L->stack.top */ L->Cstack = oldCLS; L->stack.top = L->stack.stack+L->Cstack.base; status = 1; @@ -308,18 +287,20 @@ int luaD_protectedrun (int nResults) /* ** returns 0 = chunk loaded; 1 = error; 2 = no more chunks to load */ -static int protectedparser (ZIO *z, int bin) -{ +static int protectedparser (ZIO *z, int bin) { + volatile struct C_Lua_Stack oldCLS = L->Cstack; + struct lua_longjmp myErrorJmp; volatile int status; TProtoFunc *volatile tf; - jmp_buf myErrorJmp; - jmp_buf *volatile oldErr = L->errorJmp; + struct lua_longjmp *volatile oldErr = L->errorJmp; L->errorJmp = &myErrorJmp; - if (setjmp(myErrorJmp) == 0) { + if (setjmp(myErrorJmp.b) == 0) { tf = bin ? luaU_undump1(z) : luaY_parser(z); status = 0; } - else { + else { /* an error occurred: restore L->Cstack and L->stack.top */ + L->Cstack = oldCLS; + L->stack.top = L->stack.stack+L->Cstack.base; tf = NULL; status = 1; } @@ -334,9 +315,9 @@ static int protectedparser (ZIO *z, int bin) } -static int do_main (ZIO *z, int bin) -{ +static int do_main (ZIO *z, int bin) { int status; + int debug = L->debug; /* save debug status */ do { long old_blocks = (luaC_checkGC(), L->nblocks); status = protectedparser(z, bin); @@ -345,10 +326,11 @@ static int do_main (ZIO *z, int bin) else { unsigned long newelems2 = 2*(L->nblocks-old_blocks); L->GCthreshold += newelems2; - status = luaD_protectedrun(MULT_RET); + status = luaD_protectedrun(); L->GCthreshold -= newelems2; } } while (bin && status == 0); + L->debug = debug; /* restore debug status */ return status; } @@ -364,23 +346,24 @@ void luaD_gcIM (TObject *o) } -int lua_dofile (char *filename) -{ +#define MAXFILENAME 260 /* maximum part of a file name kept */ + +int lua_dofile (char *filename) { ZIO z; int status; int c; int bin; + char source[MAXFILENAME]; FILE *f = (filename == NULL) ? stdin : fopen(filename, "r"); if (f == NULL) return 2; - if (filename == NULL) - filename = "(stdin)"; c = fgetc(f); ungetc(c, f); bin = (c == ID_CHUNK); if (bin) f = freopen(filename, "rb", f); /* set binary mode */ - luaZ_Fopen(&z, f, filename); + luaL_filesource(source, filename, sizeof(source)); + luaZ_Fopen(&z, f, source); status = do_main(&z, bin); if (f != stdin) fclose(f); @@ -388,40 +371,15 @@ int lua_dofile (char *filename) } -#define SIZE_PREF 20 /* size of string prefix to appear in error messages */ -#define SSIZE_PREF "20" - - -static void build_name (char *str, char *name) { - if (str == NULL || *str == ID_CHUNK) - strcpy(name, "(buffer)"); - else { - char *temp; - sprintf(name, "(dostring) >> \"%." SSIZE_PREF "s\"", str); - temp = strchr(name, '\n'); - if (temp) { /* end string after first line */ - *temp = '"'; - *(temp+1) = 0; - } - } -} - - int lua_dostring (char *str) { - return lua_dobuffer(str, strlen(str), NULL); + return lua_dobuffer(str, strlen(str), str); } int lua_dobuffer (char *buff, int size, char *name) { - char newname[SIZE_PREF+25]; ZIO z; - int status; - if (name==NULL) { - build_name(buff, newname); - name = newname; - } + if (!name) name = "?"; luaZ_mopen(&z, buff, size, name); - status = do_main(&z, buff[0]==ID_CHUNK); - return status; + return do_main(&z, buff[0]==ID_CHUNK); } diff --git a/src/ldo.h b/src/ldo.h index 0e981fb..01eec54 100644 --- a/src/ldo.h +++ b/src/ldo.h @@ -1,5 +1,5 @@ /* -** $Id: ldo.h,v 1.4 1997/12/15 16:17:20 roberto Exp $ +** $Id: ldo.h,v 1.6 1999/06/22 20:37:23 roberto Exp $ ** Stack and Call structure of Lua ** See Copyright Notice in lua.h */ @@ -35,9 +35,9 @@ void luaD_adjusttop (StkId newtop); void luaD_openstack (int nelems); void luaD_lineHook (int line); void luaD_callHook (StkId base, TProtoFunc *tf, int isreturn); -void luaD_call (StkId base, int nResults); +void luaD_calln (int nArgs, int nResults); void luaD_callTM (TObject *f, int nParams, int nResults); -int luaD_protectedrun (int nResults); +int luaD_protectedrun (void); void luaD_gcIM (TObject *o); void luaD_travstack (int (*fn)(TObject *)); void luaD_checkstack (int n); diff --git a/src/lfunc.c b/src/lfunc.c index fae5966..7494e2c 100644 --- a/src/lfunc.c +++ b/src/lfunc.c @@ -1,5 +1,5 @@ /* -** $Id: lfunc.c,v 1.9 1998/06/19 16:14:09 roberto Exp $ +** $Id: lfunc.c,v 1.10 1999/03/04 21:17:26 roberto Exp $ ** Auxiliary functions to manipulate prototypes and closures ** See Copyright Notice in lua.h */ @@ -31,7 +31,7 @@ TProtoFunc *luaF_newproto (void) TProtoFunc *f = luaM_new(TProtoFunc); f->code = NULL; f->lineDefined = 0; - f->fileName = NULL; + f->source = NULL; f->consts = NULL; f->nconsts = 0; f->locvars = NULL; diff --git a/src/lgc.c b/src/lgc.c index f982a82..e153ce8 100644 --- a/src/lgc.c +++ b/src/lgc.c @@ -1,5 +1,5 @@ /* -** $Id: lgc.c,v 1.18 1998/03/09 21:49:52 roberto Exp $ +** $Id: lgc.c,v 1.23 1999/03/04 21:17:26 roberto Exp $ ** Garbage Collector ** See Copyright Notice in lua.h */ @@ -29,23 +29,18 @@ static int markobject (TObject *o); */ -int luaC_ref (TObject *o, int lock) -{ +int luaC_ref (TObject *o, int lock) { int ref; if (ttype(o) == LUA_T_NIL) ref = -1; /* special ref for nil */ else { for (ref=0; refrefSize; ref++) if (L->refArray[ref].status == FREE) - goto found; - /* no more empty spaces */ { - int oldSize = L->refSize; - L->refSize = luaM_growvector(&L->refArray, L->refSize, struct ref, - refEM, MAX_INT); - for (ref=oldSize; refrefSize; ref++) - L->refArray[ref].status = FREE; - ref = oldSize; - } found: + break; + if (ref == L->refSize) { /* no more empty spaces? */ + luaM_growvector(L->refArray, L->refSize, 1, struct ref, refEM, MAX_INT); + L->refSize++; + } L->refArray[ref].o = *o; L->refArray[ref].status = lock ? LOCK : HOLD; } @@ -163,21 +158,13 @@ static void strmark (TaggedString *s) } -static void protomark (TProtoFunc *f) -{ +static void protomark (TProtoFunc *f) { if (!f->head.marked) { - LocVar *v = f->locvars; int i; f->head.marked = 1; - if (f->fileName) - strmark(f->fileName); + strmark(f->source); for (i=0; inconsts; i++) markobject(&f->consts[i]); - if (v) { - for (; v->line != -1; v++) - if (v->varname) - strmark(v->varname); - } } } diff --git a/src/lib/Makefile b/src/lib/Makefile index 70db660..5d8664c 100644 --- a/src/lib/Makefile +++ b/src/lib/Makefile @@ -7,8 +7,8 @@ include $(LUA)/config # actually only used in liolib.c EXTRA_DEFS= $(POPEN) -OBJS= liolib.o lmathlib.o lstrlib.o -SRCS= liolib.c lmathlib.c lstrlib.c +OBJS= linit.o ldblib.o liolib.o lmathlib.o lstrlib.o +SRCS= linit.c ldblib.c liolib.c lmathlib.c lstrlib.c T= $(LIB)/liblualib.a diff --git a/src/lib/ldblib.c b/src/lib/ldblib.c new file mode 100644 index 0000000..388a2f2 --- /dev/null +++ b/src/lib/ldblib.c @@ -0,0 +1,217 @@ +/* +** $Id: ldblib.c,v 1.5 1999/03/04 21:17:26 roberto Exp $ +** Interface from Lua to its debug API +** See Copyright Notice in lua.h +*/ + + +#include +#include + +#include "lauxlib.h" +#include "lua.h" +#include "luadebug.h" +#include "lualib.h" + + + +static void settabss (lua_Object t, char *i, char *v) { + lua_pushobject(t); + lua_pushstring(i); + lua_pushstring(v); + lua_settable(); +} + + +static void settabsi (lua_Object t, char *i, int v) { + lua_pushobject(t); + lua_pushstring(i); + lua_pushnumber(v); + lua_settable(); +} + + +static lua_Object getfuncinfo (lua_Object func) { + lua_Object result = lua_createtable(); + char *str; + int line; + lua_funcinfo(func, &str, &line); + if (line == -1) /* C function? */ + settabss(result, "kind", "C"); + else if (line == 0) { /* "main"? */ + settabss(result, "kind", "chunk"); + settabss(result, "source", str); + } + else { /* Lua function */ + settabss(result, "kind", "Lua"); + settabsi(result, "def_line", line); + settabss(result, "source", str); + } + if (line != 0) { /* is it not a "main"? */ + char *kind = lua_getobjname(func, &str); + if (*kind) { + settabss(result, "name", str); + settabss(result, "where", kind); + } + } + return result; +} + + +static void getstack (void) { + lua_Object func = lua_stackedfunction(luaL_check_int(1)); + if (func == LUA_NOOBJECT) /* level out of range? */ + return; + else { + lua_Object result = getfuncinfo(func); + int currline = lua_currentline(func); + if (currline > 0) + settabsi(result, "current", currline); + lua_pushobject(result); + lua_pushstring("func"); + lua_pushobject(func); + lua_settable(); /* result.func = func */ + lua_pushobject(result); + } +} + + +static void funcinfo (void) { + lua_pushobject(getfuncinfo(luaL_functionarg(1))); +} + + +static int findlocal (lua_Object func, int arg) { + lua_Object v = lua_getparam(arg); + if (lua_isnumber(v)) + return (int)lua_getnumber(v); + else { + char *name = luaL_check_string(arg); + int i = 0; + int result = -1; + char *vname; + while (lua_getlocal(func, ++i, &vname) != LUA_NOOBJECT) { + if (strcmp(name, vname) == 0) + result = i; /* keep looping to get the last var with this name */ + } + if (result == -1) + luaL_verror("no local variable `%.50s' at given level", name); + return result; + } +} + + +static void getlocal (void) { + lua_Object func = lua_stackedfunction(luaL_check_int(1)); + lua_Object val; + char *name; + if (func == LUA_NOOBJECT) /* level out of range? */ + return; /* return nil */ + else if (lua_getparam(2) != LUA_NOOBJECT) { /* 2nd argument? */ + if ((val = lua_getlocal(func, findlocal(func, 2), &name)) != LUA_NOOBJECT) { + lua_pushobject(val); + lua_pushstring(name); + } + /* else return nil */ + } + else { /* collect all locals in a table */ + lua_Object result = lua_createtable(); + int i; + for (i=1; ;i++) { + if ((val = lua_getlocal(func, i, &name)) == LUA_NOOBJECT) + break; + lua_pushobject(result); + lua_pushstring(name); + lua_pushobject(val); + lua_settable(); /* result[name] = value */ + } + lua_pushobject(result); + } +} + + +static void setlocal (void) { + lua_Object func = lua_stackedfunction(luaL_check_int(1)); + int numvar; + luaL_arg_check(func != LUA_NOOBJECT, 1, "level out of range"); + numvar = findlocal(func, 2); + lua_pushobject(luaL_nonnullarg(3)); + if (!lua_setlocal(func, numvar)) + lua_error("no such local variable"); +} + + + +static int linehook = -1; /* Lua reference to line hook function */ +static int callhook = -1; /* Lua reference to call hook function */ + + +static void dohook (int ref) { + lua_LHFunction oldlinehook = lua_setlinehook(NULL); + lua_CHFunction oldcallhook = lua_setcallhook(NULL); + lua_callfunction(lua_getref(ref)); + lua_setlinehook(oldlinehook); + lua_setcallhook(oldcallhook); +} + + +static void linef (int line) { + lua_pushnumber(line); + dohook(linehook); +} + + +static void callf (lua_Function func, char *file, int line) { + if (func != LUA_NOOBJECT) { + lua_pushobject(func); + lua_pushstring(file); + lua_pushnumber(line); + } + dohook(callhook); +} + + +static void setcallhook (void) { + lua_Object f = lua_getparam(1); + lua_unref(callhook); + if (f == LUA_NOOBJECT) { + callhook = -1; + lua_setcallhook(NULL); + } + else { + lua_pushobject(f); + callhook = lua_ref(1); + lua_setcallhook(callf); + } +} + + +static void setlinehook (void) { + lua_Object f = lua_getparam(1); + lua_unref(linehook); + if (f == LUA_NOOBJECT) { + linehook = -1; + lua_setlinehook(NULL); + } + else { + lua_pushobject(f); + linehook = lua_ref(1); + lua_setlinehook(linef); + } +} + + +static struct luaL_reg dblib[] = { + {"funcinfo", funcinfo}, + {"getlocal", getlocal}, + {"getstack", getstack}, + {"setcallhook", setcallhook}, + {"setlinehook", setlinehook}, + {"setlocal", setlocal} +}; + + +void lua_dblibopen (void) { + luaL_openlib(dblib, (sizeof(dblib)/sizeof(dblib[0]))); +} + diff --git a/src/lib/linit.c b/src/lib/linit.c new file mode 100644 index 0000000..be57aae --- /dev/null +++ b/src/lib/linit.c @@ -0,0 +1,17 @@ +/* +** $Id: linit.c,v 1.1 1999/01/08 16:49:32 roberto Exp $ +** Initialization of libraries for lua.c +** See Copyright Notice in lua.h +*/ + +#include "lua.h" +#include "lualib.h" + + +void lua_userinit (void) { + lua_iolibopen(); + lua_strlibopen(); + lua_mathlibopen(); + lua_dblibopen(); +} + diff --git a/src/lib/liolib.c b/src/lib/liolib.c index 15ea658..d833cec 100644 --- a/src/lib/liolib.c +++ b/src/lib/liolib.c @@ -1,5 +1,5 @@ /* -** $Id: liolib.c,v 1.21 1998/06/18 17:04:28 roberto Exp $ +** $Id: liolib.c,v 1.41 1999/06/23 13:48:39 roberto Exp $ ** Standard I/O (and system) library ** See Copyright Notice in lua.h */ @@ -20,6 +20,7 @@ #ifndef OLD_ANSI #include #else +/* no support for locale and for strerror: fake them */ #define setlocale(a,b) 0 #define LC_ALL 0 #define LC_COLLATE 0 @@ -31,10 +32,12 @@ #endif -#define CLOSEDTAG 2 -#define IOTAG 1 +#define IOTAG 1 + +#define FIRSTARG 2 /* 1st is upvalue */ + +#define CLOSEDTAG(tag) ((tag)-1) /* assume that CLOSEDTAG = iotag-1 */ -#define FIRSTARG 3 /* 1st and 2nd are upvalues */ #define FINPUT "_INPUT" #define FOUTPUT "_OUTPUT" @@ -43,262 +46,371 @@ #ifdef POPEN FILE *popen(); int pclose(); +#define CLOSEFILE(f) {if (pclose(f) == -1) fclose(f);} #else +/* no support for popen */ #define popen(x,y) NULL /* that is, popen always fails */ -#define pclose(x) (-1) +#define CLOSEFILE(f) {fclose(f);} #endif -static int gettag (int i) -{ - return lua_getnumber(lua_getparam(i)); -} - -static void pushresult (int i) -{ +static void pushresult (int i) { if (i) lua_pushuserdata(NULL); else { lua_pushnil(); lua_pushstring(strerror(errno)); + lua_pushnumber(errno); } } -static int ishandler (lua_Object f) -{ +/* +** {====================================================== +** FILE Operations +** ======================================================= +*/ + +static int gettag (void) { + return (int)lua_getnumber(lua_getparam(IOTAG)); +} + + +static int ishandle (lua_Object f) { if (lua_isuserdata(f)) { - if (lua_tag(f) == gettag(CLOSEDTAG)) + int tag = gettag(); + if (lua_tag(f) == CLOSEDTAG(tag)) lua_error("cannot access a closed file"); - return lua_tag(f) == gettag(IOTAG); + return lua_tag(f) == tag; } else return 0; } -static FILE *getfile (char *name) -{ + +static FILE *getfilebyname (char *name) { lua_Object f = lua_getglobal(name); - if (!ishandler(f)) + if (!ishandle(f)) luaL_verror("global variable `%.50s' is not a file handle", name); return lua_getuserdata(f); } -static FILE *getfileparam (char *name, int *arg) -{ - lua_Object f = lua_getparam(*arg); - if (ishandler(f)) { +static FILE *getfile (int arg) { + lua_Object f = lua_getparam(arg); + return (ishandle(f)) ? lua_getuserdata(f) : NULL; +} + + +static FILE *getnonullfile (int arg) { + FILE *f = getfile(arg); + luaL_arg_check(f, arg, "invalid file handle"); + return f; +} + + +static FILE *getfileparam (char *name, int *arg) { + FILE *f = getfile(*arg); + if (f) { (*arg)++; - return lua_getuserdata(f); + return f; } else - return getfile(name); + return getfilebyname(name); +} + + +static void closefile (FILE *f) { + if (f != stdin && f != stdout) { + int tag = gettag(); + CLOSEFILE(f); + lua_pushusertag(f, tag); + lua_settag(CLOSEDTAG(tag)); + } +} + + +static void io_close (void) { + closefile(getnonullfile(FIRSTARG)); +} + + +static void gc_close (void) { + FILE *f = getnonullfile(FIRSTARG); + if (f != stdin && f != stdout && f != stderr) { + CLOSEFILE(f); + } } -static void closefile (char *name) -{ - FILE *f = getfile(name); - if (f == stdin || f == stdout) return; - if (pclose(f) == -1) - fclose(f); - lua_pushobject(lua_getglobal(name)); - lua_settag(gettag(CLOSEDTAG)); +static void io_open (void) { + FILE *f = fopen(luaL_check_string(FIRSTARG), luaL_check_string(FIRSTARG+1)); + if (f) lua_pushusertag(f, gettag()); + else pushresult(0); } -static void setfile (FILE *f, char *name, int tag) -{ +static void setfile (FILE *f, char *name, int tag) { lua_pushusertag(f, tag); lua_setglobal(name); } -static void setreturn (FILE *f, char *name) -{ - int tag = gettag(IOTAG); - setfile(f, name, tag); - lua_pushusertag(f, tag); +static void setreturn (FILE *f, char *name) { + if (f == NULL) + pushresult(0); + else { + int tag = gettag(); + setfile(f, name, tag); + lua_pushusertag(f, tag); + } } -static void io_readfrom (void) -{ +static void io_readfrom (void) { FILE *current; lua_Object f = lua_getparam(FIRSTARG); if (f == LUA_NOOBJECT) { - closefile(FINPUT); + closefile(getfilebyname(FINPUT)); current = stdin; } - else if (lua_tag(f) == gettag(IOTAG)) + else if (lua_tag(f) == gettag()) /* deprecated option */ current = lua_getuserdata(f); else { char *s = luaL_check_string(FIRSTARG); current = (*s == '|') ? popen(s+1, "r") : fopen(s, "r"); - if (current == NULL) { - pushresult(0); - return; - } } setreturn(current, FINPUT); } -static void io_writeto (void) -{ +static void io_writeto (void) { FILE *current; lua_Object f = lua_getparam(FIRSTARG); if (f == LUA_NOOBJECT) { - closefile(FOUTPUT); + closefile(getfilebyname(FOUTPUT)); current = stdout; } - else if (lua_tag(f) == gettag(IOTAG)) + else if (lua_tag(f) == gettag()) /* deprecated option */ current = lua_getuserdata(f); else { char *s = luaL_check_string(FIRSTARG); - current = (*s == '|') ? popen(s+1,"w") : fopen(s,"w"); - if (current == NULL) { - pushresult(0); - return; - } + current = (*s == '|') ? popen(s+1,"w") : fopen(s, "w"); } setreturn(current, FOUTPUT); } -static void io_appendto (void) -{ - char *s = luaL_check_string(FIRSTARG); - FILE *fp = fopen (s, "a"); - if (fp != NULL) - setreturn(fp, FOUTPUT); - else - pushresult(0); +static void io_appendto (void) { + FILE *current = fopen(luaL_check_string(FIRSTARG), "a"); + setreturn(current, FOUTPUT); } + +/* +** {====================================================== +** READ +** ======================================================= +*/ + + +/* +** We cannot lookahead without need, because this can lock stdin. +** This flag signals when we need to read a next char. +*/ #define NEED_OTHER (EOF-1) /* just some flag different from EOF */ -static void read_until (FILE *f, int lim) { - int l = 0; - int c; - for (c = getc(f); c != EOF && c != lim; c = getc(f)) { - luaL_addchar(c); - l++; +static int read_pattern (FILE *f, char *p) { + int inskip = 0; /* {skip} level */ + int c = NEED_OTHER; + while (*p != '\0') { + switch (*p) { + case '{': + inskip++; + p++; + continue; + case '}': + if (!inskip) lua_error("unbalanced braces in read pattern"); + inskip--; + p++; + continue; + default: { + char *ep = luaI_classend(p); /* get what is next */ + int m; /* match result */ + if (c == NEED_OTHER) c = getc(f); + m = (c==EOF) ? 0 : luaI_singlematch(c, p, ep); + if (m) { + if (!inskip) luaL_addchar(c); + c = NEED_OTHER; + } + switch (*ep) { + case '+': /* repetition (1 or more) */ + if (!m) goto break_while; /* pattern fails? */ + /* else go through */ + case '*': /* repetition (0 or more) */ + while (m) { /* reads the same item until it fails */ + c = getc(f); + m = (c==EOF) ? 0 : luaI_singlematch(c, p, ep); + if (m && !inskip) luaL_addchar(c); + } + /* go through to continue reading the pattern */ + case '?': /* optional */ + p = ep+1; /* continues reading the pattern */ + continue; + default: + if (!m) goto break_while; /* pattern fails? */ + p = ep; /* else continues reading the pattern */ + } + } + } + } break_while: + if (c != NEED_OTHER) ungetc(c, f); + return (*p == '\0'); +} + + +static int read_number (FILE *f) { + double d; + if (fscanf(f, "%lf", &d) == 1) { + lua_pushnumber(d); + return 1; } - if (l > 0 || c == lim) /* read anything? */ - lua_pushlstring(luaL_buffer(), l); + else return 0; /* read fails */ +} + + +#define HUNK_LINE 1024 +#define HUNK_FILE BUFSIZ + +static int read_line (FILE *f) { + /* equivalent to: return read_pattern(f, "[^\n]*{\n}"); */ + int n; + char *b; + do { + b = luaL_openspace(HUNK_LINE); + if (!fgets(b, HUNK_LINE, f)) return 0; /* read fails */ + n = strlen(b); + luaL_addsize(n); + } while (b[n-1] != '\n'); + luaL_addsize(-1); /* remove '\n' */ + return 1; +} + + +static void read_file (FILE *f) { + /* equivalent to: return read_pattern(f, ".*"); */ + int n; + do { + char *b = luaL_openspace(HUNK_FILE); + n = fread(b, sizeof(char), HUNK_FILE, f); + luaL_addsize(n); + } while (n==HUNK_FILE); } + static void io_read (void) { + static char *options[] = {"*n", "*l", "*a", ".*", "*w", NULL}; int arg = FIRSTARG; FILE *f = getfileparam(FINPUT, &arg); - char *p = luaL_opt_string(arg, NULL); - luaL_resetbuffer(); - if (p == NULL) /* default: read a line */ - read_until(f, '\n'); - else if (p[0] == '.' && p[1] == '*' && p[2] == 0) /* p = ".*" */ - read_until(f, EOF); - else { - int l = 0; /* number of chars read in buffer */ - int inskip = 0; /* to control {skips} */ - int c = NEED_OTHER; - while (*p) { - switch (*p) { - case '{': - inskip++; - p++; - continue; - case '}': - if (inskip == 0) - lua_error("unbalanced braces in read pattern"); - inskip--; - p++; - continue; - default: { - char *ep; /* get what is next */ - int m; /* match result */ - if (c == NEED_OTHER) c = getc(f); - if (c == EOF) { - luaI_singlematch(0, p, &ep); /* to set "ep" */ - m = 0; - } - else { - m = luaI_singlematch(c, p, &ep); - if (m) { - if (inskip == 0) { - luaL_addchar(c); - l++; - } - c = NEED_OTHER; - } - } - switch (*ep) { - case '*': /* repetition */ - if (!m) p = ep+1; /* else stay in (repeat) the same item */ - continue; - case '?': /* optional */ - p = ep+1; /* continues reading the pattern */ - continue; - default: - if (m) p = ep; /* continues reading the pattern */ - else - goto break_while; /* pattern fails */ - } - } - } - } break_while: - if (c >= 0) /* not EOF nor NEED_OTHER? */ - ungetc(c, f); - if (l > 0 || *p == 0) /* read something or did not fail? */ - lua_pushlstring(luaL_buffer(), l); - } + char *p = luaL_opt_string(arg++, "*l"); + do { /* repeat for each part */ + long l; + int success; + luaL_resetbuffer(); + switch (luaL_findstring(p, options)) { + case 0: /* number */ + if (!read_number(f)) return; /* read fails */ + continue; /* number is already pushed; avoid the "pushstring" */ + case 1: /* line */ + success = read_line(f); + break; + case 2: case 3: /* file */ + read_file(f); + success = 1; /* always success */ + break; + case 4: /* word */ + success = read_pattern(f, "{%s*}%S+"); + break; + default: + success = read_pattern(f, p); + } + l = luaL_getsize(); + if (!success && l==0) return; /* read fails */ + lua_pushlstring(luaL_buffer(), l); + } while ((p = luaL_opt_string(arg++, NULL)) != NULL); } +/* }====================================================== */ + -static void io_write (void) -{ +static void io_write (void) { int arg = FIRSTARG; FILE *f = getfileparam(FOUTPUT, &arg); int status = 1; char *s; long l; while ((s = luaL_opt_lstr(arg++, NULL, &l)) != NULL) - status = status && (fwrite(s, 1, l, f) == l); + status = status && ((long)fwrite(s, 1, l, f) == l); pushresult(status); } -static void io_execute (void) -{ +static void io_seek (void) { + static int mode[] = {SEEK_SET, SEEK_CUR, SEEK_END}; + static char *modenames[] = {"set", "cur", "end", NULL}; + FILE *f = getnonullfile(FIRSTARG); + int op = luaL_findstring(luaL_opt_string(FIRSTARG+1, "cur"), modenames); + long offset = luaL_opt_long(FIRSTARG+2, 0); + luaL_arg_check(op != -1, FIRSTARG+1, "invalid mode"); + op = fseek(f, offset, mode[op]); + if (op) + pushresult(0); /* error */ + else + lua_pushnumber(ftell(f)); +} + + +static void io_flush (void) { + FILE *f = getfile(FIRSTARG); + luaL_arg_check(f || lua_getparam(FIRSTARG) == LUA_NOOBJECT, FIRSTARG, + "invalid file handle"); + pushresult(fflush(f) == 0); +} + +/* }====================================================== */ + + +/* +** {====================================================== +** Other O.S. Operations +** ======================================================= +*/ + +static void io_execute (void) { lua_pushnumber(system(luaL_check_string(1))); } -static void io_remove (void) -{ +static void io_remove (void) { pushresult(remove(luaL_check_string(1)) == 0); } -static void io_rename (void) -{ +static void io_rename (void) { pushresult(rename(luaL_check_string(1), luaL_check_string(2)) == 0); } -static void io_tmpname (void) -{ +static void io_tmpname (void) { lua_pushstring(tmpnam(NULL)); } -static void io_getenv (void) -{ +static void io_getenv (void) { lua_pushstring(getenv(luaL_check_string(1))); /* if NULL push nil */ } @@ -308,12 +420,11 @@ static void io_clock (void) { } -static void io_date (void) -{ - time_t t; - struct tm *tm; +static void io_date (void) { + char b[256]; char *s = luaL_opt_string(1, "%c"); - char b[BUFSIZ]; + struct tm *tm; + time_t t; time(&t); tm = localtime(&t); if (strftime(b,sizeof(b),s,tm)) lua_pushstring(b); @@ -322,8 +433,7 @@ static void io_date (void) } -static void setloc (void) -{ +static void setloc (void) { static int cat[] = {LC_ALL, LC_COLLATE, LC_CTYPE, LC_MONETARY, LC_NUMERIC, LC_TIME}; static char *catnames[] = {"all", "collate", "ctype", "monetary", @@ -334,115 +444,140 @@ static void setloc (void) } -static void io_exit (void) -{ +static void io_exit (void) { lua_Object o = lua_getparam(1); exit(lua_isnumber(o) ? (int)lua_getnumber(o) : 1); } +/* }====================================================== */ + + -static void io_debug (void) -{ - while (1) { +static void io_debug (void) { + for (;;) { char buffer[250]; fprintf(stderr, "lua_debug> "); - if (fgets(buffer, sizeof(buffer), stdin) == 0) return; - if (strcmp(buffer, "cont\n") == 0) return; + if (fgets(buffer, sizeof(buffer), stdin) == 0 || + strcmp(buffer, "cont\n") == 0) + return; lua_dostring(buffer); } } -static void lua_printstack (FILE *f) -{ + +#define MESSAGESIZE 150 +#define MAXMESSAGE (MESSAGESIZE*10) + + +#define MAXSRC 60 + + +static void errorfb (void) { + char buff[MAXMESSAGE]; int level = 1; /* skip level 0 (it's this function) */ lua_Object func; + sprintf(buff, "lua error: %.200s\n", lua_getstring(lua_getparam(1))); while ((func = lua_stackedfunction(level++)) != LUA_NOOBJECT) { char *name; int currentline; - char *filename; + char *chunkname; + char buffchunk[MAXSRC]; int linedefined; - lua_funcinfo(func, &filename, &linedefined); - fprintf(f, (level==2) ? "Active Stack:\n\t" : "\t"); + lua_funcinfo(func, &chunkname, &linedefined); + luaL_chunkid(buffchunk, chunkname, sizeof(buffchunk)); + if (level == 2) strcat(buff, "Active Stack:\n"); + strcat(buff, " "); + if (strlen(buff) > MAXMESSAGE-MESSAGESIZE) { + strcat(buff, "...\n"); + break; /* buffer is full */ + } switch (*lua_getobjname(func, &name)) { case 'g': - fprintf(f, "function %s", name); + sprintf(buff+strlen(buff), "function `%.50s'", name); break; case 't': - fprintf(f, "`%s' tag method", name); + sprintf(buff+strlen(buff), "`%.50s' tag method", name); break; default: { if (linedefined == 0) - fprintf(f, "main of %s", filename); + sprintf(buff+strlen(buff), "main of %.70s", buffchunk); else if (linedefined < 0) - fprintf(f, "%s", filename); + sprintf(buff+strlen(buff), "%.70s", buffchunk); else - fprintf(f, "function (%s:%d)", filename, linedefined); - filename = NULL; + sprintf(buff+strlen(buff), "function <%d:%.70s>", + linedefined, buffchunk); + chunkname = NULL; } } if ((currentline = lua_currentline(func)) > 0) - fprintf(f, " at line %d", currentline); - if (filename) - fprintf(f, " [in file %s]", filename); - fprintf(f, "\n"); + sprintf(buff+strlen(buff), " at line %d", currentline); + if (chunkname) + sprintf(buff+strlen(buff), " [%.70s]", buffchunk); + strcat(buff, "\n"); + } + func = lua_rawgetglobal("_ALERT"); + if (lua_isfunction(func)) { /* avoid error loop if _ALERT is not defined */ + lua_pushstring(buff); + lua_callfunction(func); } -} - - -static void errorfb (void) -{ - fprintf(stderr, "lua: %s\n", lua_getstring(lua_getparam(1))); - lua_printstack(stderr); } static struct luaL_reg iolib[] = { -{"setlocale", setloc}, -{"execute", io_execute}, -{"remove", io_remove}, -{"rename", io_rename}, -{"tmpname", io_tmpname}, -{"getenv", io_getenv}, -{"date", io_date}, -{"clock", io_clock}, -{"exit", io_exit}, -{"debug", io_debug}, -{"print_stack", errorfb} + {"_ERRORMESSAGE", errorfb}, + {"clock", io_clock}, + {"date", io_date}, + {"debug", io_debug}, + {"execute", io_execute}, + {"exit", io_exit}, + {"getenv", io_getenv}, + {"remove", io_remove}, + {"rename", io_rename}, + {"setlocale", setloc}, + {"tmpname", io_tmpname} }; + static struct luaL_reg iolibtag[] = { -{"readfrom", io_readfrom}, -{"writeto", io_writeto}, -{"appendto", io_appendto}, -{"read", io_read}, -{"write", io_write} + {"appendto", io_appendto}, + {"closefile", io_close}, + {"flush", io_flush}, + {"openfile", io_open}, + {"read", io_read}, + {"readfrom", io_readfrom}, + {"seek", io_seek}, + {"write", io_write}, + {"writeto", io_writeto} }; -static void openwithtags (void) -{ - int iotag = lua_newtag(); - int closedtag = lua_newtag(); + +static void openwithtags (void) { int i; + int iotag = lua_newtag(); + lua_newtag(); /* alloc CLOSEDTAG: assume that CLOSEDTAG = iotag-1 */ for (i=0; i=0) ? pos : len+pos+1; } -static void str_sub (void) -{ +static void str_sub (void) { long l; char *s = luaL_check_lstr(1, &l); - long start = posrelat(luaL_check_number(2), l); - long end = posrelat(luaL_opt_number(3, -1), l); - if (1 <= start && start <= end && end <= l) + long start = posrelat(luaL_check_long(2), l); + long end = posrelat(luaL_opt_long(3, -1), l); + if (start < 1) start = 1; + if (end > l) end = l; + if (start <= end) lua_pushlstring(s+start-1, end-start+1); else lua_pushstring(""); } -static void str_lower (void) -{ +static void str_lower (void) { long l; int i; char *s = luaL_check_lstr(1, &l); @@ -69,8 +67,7 @@ static void str_lower (void) } -static void str_upper (void) -{ +static void str_upper (void) { long l; int i; char *s = luaL_check_lstr(1, &l); @@ -84,7 +81,7 @@ static void str_rep (void) { long l; char *s = luaL_check_lstr(1, &l); - int n = (int)luaL_check_number(2); + int n = luaL_check_int(2); luaL_resetbuffer(); while (n-- > 0) addnchar(s, l); @@ -92,38 +89,42 @@ static void str_rep (void) } -static void str_byte (void) -{ +static void str_byte (void) { long l; char *s = luaL_check_lstr(1, &l); - long pos = posrelat(luaL_opt_number(2, 1), l); + long pos = posrelat(luaL_opt_long(2, 1), l); luaL_arg_check(0level; i++) - lua_pushlstring(cap->capture[i].init, cap->capture[i].len); + for (i=0; ilevel; i++) { + int l = cap->capture[i].len; + if (l == -1) lua_error("unfinished capture"); + lua_pushlstring(cap->capture[i].init, l); + } } -static int check_cap (int l, struct Capture *cap) -{ +static int check_cap (int l, struct Capture *cap) { l -= '1'; if (!(0 <= l && l < cap->level && cap->capture[l].len != -1)) lua_error("invalid capture index"); @@ -152,8 +154,7 @@ static int check_cap (int l, struct Capture *cap) } -static int capture_to_close (struct Capture *cap) -{ +static int capture_to_close (struct Capture *cap) { int level = cap->level; for (level--; level>=0; level--) if (cap->capture[level].len == -1) return level; @@ -162,14 +163,25 @@ static int capture_to_close (struct Capture *cap) } -static char *bracket_end (char *p) -{ - return (*p == 0) ? NULL : strchr((*p=='^') ? p+2 : p+1, ']'); +char *luaI_classend (char *p) { + switch (*p++) { + case ESC: + if (*p == '\0') + luaL_verror("incorrect pattern (ends with `%c')", ESC); + return p+1; + case '[': + if (*p == '^') p++; + if (*p == ']') p++; + p = strchr(p, ']'); + if (!p) lua_error("incorrect pattern (missing `]')"); + return p+1; + default: + return p; + } } -static int matchclass (int c, int cl) -{ +static int matchclass (int c, int cl) { int res; switch (tolower(cl)) { case 'a' : res = isalpha(c); break; @@ -180,57 +192,63 @@ static int matchclass (int c, int cl) case 's' : res = isspace(c); break; case 'u' : res = isupper(c); break; case 'w' : res = isalnum(c); break; + case 'x' : res = isxdigit(c); break; case 'z' : res = (c == '\0'); break; default: return (cl == c); } - return (islower((unsigned char)cl) ? res : !res); + return (islower(cl) ? res : !res); } -int luaI_singlematch (int c, char *p, char **ep) -{ + +static int matchbracketclass (int c, char *p, char *end) { + int sig = 1; + if (*(p+1) == '^') { + sig = 0; + p++; /* skip the '^' */ + } + while (++p < end) { + if (*p == ESC) { + p++; + if ((p < end) && matchclass(c, (unsigned char)*p)) + return sig; + } + else if ((*(p+1) == '-') && (p+2 < end)) { + p+=2; + if ((int)(unsigned char)*(p-2) <= c && c <= (int)(unsigned char)*p) + return sig; + } + else if ((unsigned char)*p == c) return sig; + } + return !sig; +} + + + +int luaI_singlematch (int c, char *p, char *ep) { switch (*p) { case '.': /* matches any char */ - *ep = p+1; return 1; - case '\0': /* end of pattern; matches nothing */ - *ep = p; - return 0; case ESC: - if (*(++p) == '\0') - luaL_verror("incorrect pattern (ends with `%c')", ESC); - *ep = p+1; - return matchclass(c, (unsigned char)*p); - case '[': { - char *end = bracket_end(p+1); - int sig = *(p+1) == '^' ? (p++, 0) : 1; - if (end == NULL) lua_error("incorrect pattern (missing `]')"); - *ep = end+1; - while (++p < end) { - if (*p == ESC) { - if (((p+1) < end) && matchclass(c, (unsigned char)*++p)) - return sig; - } - else if ((*(p+1) == '-') && (p+2 < end)) { - p+=2; - if ((unsigned char)*(p-2) <= c && c <= (unsigned char)*p) - return sig; - } - else if ((unsigned char)*p == c) return sig; - } - return !sig; - } + return matchclass(c, (unsigned char)*(p+1)); + case '[': + return matchbracketclass(c, p, ep-1); default: - *ep = p+1; return ((unsigned char)*p == c); } } -static char *matchbalance (char *s, int b, int e, struct Capture *cap) -{ - if (*s != b) return NULL; +static char *match (char *s, char *p, struct Capture *cap); + + +static char *matchbalance (char *s, char *p, struct Capture *cap) { + if (*p == 0 || *(p+1) == 0) + lua_error("unbalanced pattern"); + if (*s != *p) return NULL; else { + int b = *p; + int e = *(p+1); int cont = 1; while (++s < cap->src_end) { if (*s == e) { @@ -243,101 +261,120 @@ static char *matchbalance (char *s, int b, int e, struct Capture *cap) } -static char *matchitem (char *s, char *p, struct Capture *cap, char **ep) -{ - if (*p == ESC) { - p++; - if (isdigit((unsigned char)*p)) { /* capture */ - int l = check_cap(*p, cap); - int len = cap->capture[l].len; - *ep = p+1; - if (cap->src_end-s >= len && memcmp(cap->capture[l].init, s, len) == 0) - return s+len; - else return NULL; - } - else if (*p == 'b') { /* balanced string */ - p++; - if (*p == 0 || *(p+1) == 0) - lua_error("unbalanced pattern"); - *ep = p+2; - return matchbalance(s, *p, *(p+1), cap); - } - else p--; /* and go through */ +static char *max_expand (char *s, char *p, char *ep, struct Capture *cap) { + int i = 0; /* counts maximum expand for item */ + while ((s+i)src_end && luaI_singlematch((unsigned char)*(s+i), p, ep)) + i++; + /* keeps trying to match mith the maximum repetitions */ + while (i>=0) { + char *res = match((s+i), ep+1, cap); + if (res) return res; + i--; /* else didn't match; reduce 1 repetition to try again */ } - /* "luaI_singlematch" sets "ep" (so must be called even when *s == 0) */ - return (luaI_singlematch((unsigned char)*s, p, ep) && ssrc_end) ? - s+1 : NULL; + return NULL; } -static char *match (char *s, char *p, struct Capture *cap) -{ +static char *min_expand (char *s, char *p, char *ep, struct Capture *cap) { + for (;;) { + char *res = match(s, ep+1, cap); + if (res != NULL) + return res; + else if (ssrc_end && luaI_singlematch((unsigned char)*s, p, ep)) + s++; /* try with one more repetition */ + else return NULL; + } +} + + +static char *start_capt (char *s, char *p, struct Capture *cap) { + char *res; + int level = cap->level; + if (level >= MAX_CAPT) lua_error("too many captures"); + cap->capture[level].init = s; + cap->capture[level].len = -1; + cap->level = level+1; + if ((res=match(s, p+1, cap)) == NULL) /* match failed? */ + cap->level--; /* undo capture */ + return res; +} + + +static char *end_capt (char *s, char *p, struct Capture *cap) { + int l = capture_to_close(cap); + char *res; + cap->capture[l].len = s - cap->capture[l].init; /* close capture */ + if ((res = match(s, p+1, cap)) == NULL) /* match failed? */ + cap->capture[l].len = -1; /* undo capture */ + return res; +} + + +static char *match_capture (char *s, int level, struct Capture *cap) { + int l = check_cap(level, cap); + int len = cap->capture[l].len; + if (cap->src_end-s >= len && + memcmp(cap->capture[l].init, s, len) == 0) + return s+len; + else return NULL; +} + + +static char *match (char *s, char *p, struct Capture *cap) { init: /* using goto's to optimize tail recursion */ switch (*p) { - case '(': { /* start capture */ - char *res; - if (cap->level >= MAX_CAPT) lua_error("too many captures"); - cap->capture[cap->level].init = s; - cap->capture[cap->level].len = -1; - cap->level++; - if ((res=match(s, p+1, cap)) == NULL) /* match failed? */ - cap->level--; /* undo capture */ - return res; - } - case ')': { /* end capture */ - int l = capture_to_close(cap); - char *res; - cap->capture[l].len = s - cap->capture[l].init; /* close capture */ - if ((res = match(s, p+1, cap)) == NULL) /* match failed? */ - cap->capture[l].len = -1; /* undo capture */ - return res; - } - case '\0': case '$': /* (possibly) end of pattern */ - if (*p == 0 || (*(p+1) == 0 && s == cap->src_end)) - return s; - /* else go through */ - default: { /* it is a pattern item */ - char *ep; /* get what is next */ - char *s1 = matchitem(s, p, cap, &ep); + case '(': /* start capture */ + return start_capt(s, p, cap); + case ')': /* end capture */ + return end_capt(s, p, cap); + case ESC: /* may be %[0-9] or %b */ + if (isdigit((unsigned char)(*(p+1)))) { /* capture? */ + s = match_capture(s, *(p+1), cap); + if (s == NULL) return NULL; + p+=2; goto init; /* else return match(p+2, s, cap) */ + } + else if (*(p+1) == 'b') { /* balanced string? */ + s = matchbalance(s, p+2, cap); + if (s == NULL) return NULL; + p+=4; goto init; /* else return match(p+4, s, cap); */ + } + else goto dflt; /* case default */ + case '\0': /* end of pattern */ + return s; /* match succeeded */ + case '$': + if (*(p+1) == '\0') /* is the '$' the last char in pattern? */ + return (s == cap->src_end) ? s : NULL; /* check end of string */ + else goto dflt; + default: dflt: { /* it is a pattern item */ + char *ep = luaI_classend(p); /* points to what is next */ + int m = ssrc_end && luaI_singlematch((unsigned char)*s, p, ep); switch (*ep) { - case '*': { /* repetition */ - char *res; - if (s1 && s1>s && ((res=match(s1, p, cap)) != NULL)) - return res; - p=ep+1; goto init; /* else return match(s, ep+1, cap); */ - } case '?': { /* optional */ char *res; - if (s1 && ((res=match(s1, ep+1, cap)) != NULL)) + if (m && ((res=match(s+1, ep+1, cap)) != NULL)) return res; p=ep+1; goto init; /* else return match(s, ep+1, cap); */ } - case '-': { /* repetition */ - char *res; - if ((res = match(s, ep+1, cap)) != NULL) - return res; - else if (s1 && s1>s) { - s = s1; - goto init; /* return match(s1, p, cap); */ - } - else - return NULL; - } + case '*': /* 0 or more repetitions */ + return max_expand(s, p, ep, cap); + case '+': /* 1 or more repetitions */ + return (m ? max_expand(s+1, p, ep, cap) : NULL); + case '-': /* 0 or more repetitions (minimum) */ + return min_expand(s, p, ep, cap); default: - if (s1) { s=s1; p=ep; goto init; } /* return match(s1, ep, cap); */ - else return NULL; + if (!m) return NULL; + s++; p=ep; goto init; /* else return match(s+1, ep, cap); */ } } } } -static void str_find (void) -{ +static void str_find (void) { long l; char *s = luaL_check_lstr(1, &l); char *p = luaL_check_string(2); - long init = posrelat(luaL_opt_number(3, 1), l) - 1; + long init = posrelat(luaL_opt_long(3, 1), l) - 1; struct Capture cap; luaL_arg_check(0 <= init && init <= l, 3, "out of range"); if (lua_getparam(4) != LUA_NOOBJECT || @@ -368,8 +405,7 @@ static void str_find (void) } -static void add_s (lua_Object newp, struct Capture *cap) -{ +static void add_s (lua_Object newp, struct Capture *cap) { if (lua_isstring(newp)) { char *news = lua_getstring(newp); int l = lua_strlen(newp); @@ -411,13 +447,12 @@ static void add_s (lua_Object newp, struct Capture *cap) } -static void str_gsub (void) -{ +static void str_gsub (void) { long srcl; char *src = luaL_check_lstr(1, &srcl); char *p = luaL_check_string(2); lua_Object newp = lua_getparam(3); - int max_s = (int)luaL_opt_number(4, srcl+1); + int max_s = luaL_opt_int(4, srcl+1); int anchor = (*p == '^') ? (p++, 1) : 0; int n = 0; struct Capture cap; @@ -445,26 +480,33 @@ static void str_gsub (void) lua_pushnumber(n); /* number of substitutions */ } +/* }====================================================== */ -static void luaI_addquoted (char *s) -{ + +static void luaI_addquoted (int arg) { + long l; + char *s = luaL_check_lstr(arg, &l); luaL_addchar('"'); - for (; *s; s++) { - if (strchr("\"\\\n", *s)) - luaL_addchar('\\'); - luaL_addchar(*s); + while (l--) { + switch (*s) { + case '"': case '\\': case '\n': + luaL_addchar('\\'); + luaL_addchar(*s); + break; + case '\0': addnchar("\\000", 4); break; + default: luaL_addchar(*s); + } + s++; } luaL_addchar('"'); } -#define MAX_FORMAT 200 +/* maximum size of each format specification (such as '%-099.99d') */ +#define MAX_FORMAT 20 /* arbitrary limit */ -static void str_format (void) -{ +static void str_format (void) { int arg = 1; char *strfrmt = luaL_check_string(arg); - struct Capture cap; - cap.src_end = strfrmt+strlen(strfrmt)+1; luaL_resetbuffer(); while (*strfrmt) { if (*strfrmt != '%') @@ -472,34 +514,28 @@ static void str_format (void) else if (*++strfrmt == '%') luaL_addchar(*strfrmt++); /* %% */ else { /* format item */ - char form[MAX_FORMAT]; /* store the format ('%...') */ - char *buff; + struct Capture cap; + char form[MAX_FORMAT]; /* to store the format ('%...') */ + char *buff; /* to store the formatted item */ char *initf = strfrmt; form[0] = '%'; - cap.level = 0; - if (isdigit((unsigned char)initf[0]) && initf[1] == '$') { - arg = initf[0] - '0'; + if (isdigit((unsigned char)*initf) && *(initf+1) == '$') { + arg = *initf - '0'; initf += 2; /* skip the 'n$' */ } arg++; + cap.src_end = strfrmt+strlen(strfrmt)+1; + cap.level = 0; strfrmt = match(initf, "[-+ #0]*(%d*)%.?(%d*)", &cap); - if (cap.capture[0].len > 2 || cap.capture[1].len > 2) /* < 100? */ + if (cap.capture[0].len > 2 || cap.capture[1].len > 2 || /* < 100? */ + strfrmt-initf > MAX_FORMAT-2) lua_error("invalid format (width or precision too long)"); strncpy(form+1, initf, strfrmt-initf+1); /* +1 to include conversion */ form[strfrmt-initf+2] = 0; - buff = luaL_openspace(1000); /* to store the formatted value */ + buff = luaL_openspace(512); /* 512 > size of format('%99.99f', -1e308) */ switch (*strfrmt++) { - case 'q': - luaI_addquoted(luaL_check_string(arg)); - continue; - case 's': { - char *s = luaL_check_string(arg); - buff = luaL_openspace(strlen(s)); - sprintf(buff, form, s); - break; - } case 'c': case 'd': case 'i': - sprintf(buff, form, (int)luaL_check_number(arg)); + sprintf(buff, form, luaL_check_int(arg)); break; case 'o': case 'u': case 'x': case 'X': sprintf(buff, form, (unsigned int)luaL_check_number(arg)); @@ -507,6 +543,23 @@ static void str_format (void) case 'e': case 'E': case 'f': case 'g': case 'G': sprintf(buff, form, luaL_check_number(arg)); break; + case 'q': + luaI_addquoted(arg); + continue; /* skip the "addsize" at the end */ + case 's': { + long l; + char *s = luaL_check_lstr(arg, &l); + if (cap.capture[1].len == 0 && l >= 100) { + /* no precision and string is too big to be formatted; + keep original string */ + addnchar(s, l); + continue; /* skip the "addsize" at the end */ + } + else { + sprintf(buff, form, s); + break; + } + } default: /* also treat cases 'pnLlh' */ lua_error("invalid option in `format'"); } @@ -524,7 +577,7 @@ static struct luaL_reg strlib[] = { {"strupper", str_upper}, {"strchar", str_char}, {"strrep", str_rep}, -{"ascii", str_byte}, /* for compatibility */ +{"ascii", str_byte}, /* for compatibility with 3.0 and earlier */ {"strbyte", str_byte}, {"format", str_format}, {"strfind", str_find}, diff --git a/src/llex.c b/src/llex.c index ec1966c..2d607d9 100644 --- a/src/llex.c +++ b/src/llex.c @@ -1,6 +1,6 @@ /* -** $Id: llex.c,v 1.23 1998/07/06 22:04:58 roberto Exp $ -** Lexical Analizer +** $Id: llex.c,v 1.36 1999/06/17 17:04:03 roberto Exp $ +** Lexical Analyzer ** See Copyright Notice in lua.h */ @@ -20,9 +20,6 @@ -int lua_debug=0; - - #define next(LS) (LS->current = zgetc(LS->lex_z)) @@ -35,8 +32,7 @@ char *reserved [] = {"and", "do", "else", "elseif", "end", "function", "until", "while"}; -void luaX_init (void) -{ +void luaX_init (void) { int i; for (i=0; i<(sizeof(reserved)/sizeof(reserved[0])); i++) { TaggedString *ts = luaS_new(reserved[i]); @@ -45,24 +41,28 @@ void luaX_init (void) } +#define MAXSRC 80 + void luaX_syntaxerror (LexState *ls, char *s, char *token) { - if (token[0] == 0) + char buff[MAXSRC]; + luaL_chunkid(buff, zname(ls->lex_z), sizeof(buff)); + if (token[0] == '\0') token = ""; - luaL_verror("%.100s;\n last token read: `%.50s' at line %d in chunk `%.50s'", - s, token, ls->linenumber, zname(ls->lex_z)); + luaL_verror("%.100s;\n last token read: `%.50s' at line %d in %.80s", + s, token, ls->linenumber, buff); } void luaX_error (LexState *ls, char *s) { - save(0); + save('\0'); luaX_syntaxerror(ls, s, luaL_buffer()); } -void luaX_token2str (LexState *ls, int token, char *s) { +void luaX_token2str (int token, char *s) { if (token < 255) { - s[0] = token; - s[1] = 0; + s[0] = (char)token; + s[1] = '\0'; } else strcpy(s, reserved[token-FIRST_RESERVED]); @@ -70,8 +70,8 @@ void luaX_token2str (LexState *ls, int token, char *s) { static void luaX_invalidchar (LexState *ls, int c) { - char buff[10]; - sprintf(buff, "0x%X", c); + char buff[8]; + sprintf(buff, "0x%02X", c); luaX_syntaxerror(ls, "invalid control char", buff); } @@ -106,17 +106,17 @@ void luaX_setinput (LexState *LS, ZIO *z) ** ======================================================= */ -#define PRAGMASIZE 20 +#ifndef PRAGMASIZE +#define PRAGMASIZE 80 /* arbitrary limit */ +#endif -static void skipspace (LexState *LS) -{ +static void skipspace (LexState *LS) { while (LS->current == ' ' || LS->current == '\t' || LS->current == '\r') next(LS); } -static int checkcond (LexState *LS, char *buff) -{ +static int checkcond (LexState *LS, char *buff) { static char *opts[] = {"nil", "1", NULL}; int i = luaL_findstring(buff, opts); if (i >= 0) return i; @@ -129,8 +129,7 @@ static int checkcond (LexState *LS, char *buff) } -static void readname (LexState *LS, char *buff) -{ +static void readname (LexState *LS, char *buff) { int i = 0; skipspace(LS); while (isalnum(LS->current) || LS->current == '_') { @@ -138,7 +137,7 @@ static void readname (LexState *LS, char *buff) buff[PRAGMASIZE] = 0; luaX_syntaxerror(LS, "pragma too long", buff); } - buff[i++] = LS->current; + buff[i++] = (char)LS->current; next(LS); } buff[i] = 0; @@ -148,8 +147,7 @@ static void readname (LexState *LS, char *buff) static void inclinenumber (LexState *LS); -static void ifskip (LexState *LS) -{ +static void ifskip (LexState *LS) { while (LS->ifstate[LS->iflevel].skip) { if (LS->current == '\n') inclinenumber(LS); @@ -160,8 +158,7 @@ static void ifskip (LexState *LS) } -static void inclinenumber (LexState *LS) -{ +static void inclinenumber (LexState *LS) { static char *pragmas [] = {"debug", "nodebug", "endinput", "end", "ifnot", "if", "else", NULL}; next(LS); /* skip '\n' */ @@ -174,10 +171,10 @@ static void inclinenumber (LexState *LS) readname(LS, buff); switch (luaL_findstring(buff, pragmas)) { case 0: /* debug */ - if (!skip) lua_debug = 1; + if (!skip) L->debug = 1; break; case 1: /* nodebug */ - if (!skip) lua_debug = 0; + if (!skip) L->debug = 0; break; case 2: /* endinput */ if (!skip) { @@ -221,6 +218,7 @@ static void inclinenumber (LexState *LS) } + /* ** ======================================================= ** LEXICAL ANALIZER @@ -229,12 +227,9 @@ static void inclinenumber (LexState *LS) - - -static int read_long_string (LexState *LS) -{ +static int read_long_string (LexState *LS) { int cont = 0; - while (1) { + for (;;) { switch (LS->current) { case EOZ: luaX_error(LS, "unfinished long string"); @@ -262,17 +257,16 @@ static int read_long_string (LexState *LS) save_and_next(LS); } } endloop: - save_and_next(LS); /* pass the second ']' */ - LS->seminfo.ts = luaS_newlstr(L->Mbuffbase+2, - L->Mbuffnext-(L->Mbuffbase-L->Mbuffer)-4); + save_and_next(LS); /* skip the second ']' */ + LS->seminfo.ts = luaS_newlstr(L->Mbuffer+(L->Mbuffbase+2), + L->Mbuffnext-L->Mbuffbase-4); return STRING; } int luaX_lex (LexState *LS) { - double a; luaL_resetbuffer(); - while (1) { + for (;;) { switch (LS->current) { case ' ': case '\t': case '\r': /* CR: to avoid problems with DOS */ @@ -347,7 +341,7 @@ int luaX_lex (LexState *LS) { c = 10*c + (LS->current-'0'); next(LS); } while (++i<3 && isdigit(LS->current)); - if (c >= 256) + if (c != (unsigned char)c) luaX_error(LS, "escape sequence too large"); save(c); } @@ -364,8 +358,8 @@ int luaX_lex (LexState *LS) { } } save_and_next(LS); /* skip delimiter */ - LS->seminfo.ts = luaS_newlstr(L->Mbuffbase+1, - L->Mbuffnext-(L->Mbuffbase-L->Mbuffer)-2); + LS->seminfo.ts = luaS_newlstr(L->Mbuffer+(L->Mbuffbase+1), + L->Mbuffnext-L->Mbuffbase-2); return STRING; } @@ -382,15 +376,11 @@ int luaX_lex (LexState *LS) { else return CONC; /* .. */ } else if (!isdigit(LS->current)) return '.'; - /* LS->current is a digit: goes through to number */ - a=0.0; - goto fraction; + goto fraction; /* LS->current is a digit: goes through to number */ case '0': case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': - a=0.0; do { - a = 10.0*a + (LS->current-'0'); save_and_next(LS); } while (isdigit(LS->current)); if (LS->current == '.') { @@ -402,35 +392,19 @@ int luaX_lex (LexState *LS) { } } fraction: - { double da=0.1; - while (isdigit(LS->current)) - { - a += (LS->current-'0')*da; - da /= 10.0; - save_and_next(LS); - } - if (toupper(LS->current) == 'E') { - int e = 0; - int neg; - double ea; + while (isdigit(LS->current)) + save_and_next(LS); + if (toupper(LS->current) == 'E') { + save_and_next(LS); /* read 'E' */ + save_and_next(LS); /* read '+', '-' or first digit */ + while (isdigit(LS->current)) save_and_next(LS); - neg = (LS->current=='-'); - if (LS->current == '+' || LS->current == '-') save_and_next(LS); - if (!isdigit(LS->current)) - luaX_error(LS, "invalid numeral format"); - do { - e = 10*e + (LS->current-'0'); - save_and_next(LS); - } while (isdigit(LS->current)); - for (ea=neg?0.1:10.0; e>0; e>>=1) - { - if (e & 1) a *= ea; - ea *= ea; - } - } - LS->seminfo.r = a; - return NUMBER; } + save('\0'); + LS->seminfo.r = luaO_str2d(L->Mbuffer+L->Mbuffbase); + if (LS->seminfo.r < 0) + luaX_error(LS, "invalid numeric format"); + return NUMBER; case EOZ: if (LS->iflevel > 0) @@ -450,9 +424,9 @@ int luaX_lex (LexState *LS) { do { save_and_next(LS); } while (isalnum(LS->current) || LS->current == '_'); - save(0); - ts = luaS_new(L->Mbuffbase); - if (ts->head.marked >= 'A') + save('\0'); + ts = luaS_new(L->Mbuffer+L->Mbuffbase); + if (ts->head.marked >= FIRST_RESERVED) return ts->head.marked; /* reserved word */ LS->seminfo.ts = ts; return NAME; diff --git a/src/llex.h b/src/llex.h index ba8c52a..7c1a4be 100644 --- a/src/llex.h +++ b/src/llex.h @@ -1,6 +1,6 @@ /* -** $Id: llex.h,v 1.9 1998/06/19 16:14:09 roberto Exp $ -** Lexical Analizer +** $Id: llex.h,v 1.12 1999/06/17 17:04:03 roberto Exp $ +** Lexical Analyzer ** See Copyright Notice in lua.h */ @@ -25,12 +25,14 @@ enum RESERVED { NAME, CONC, DOTS, EQ, GE, LE, NE, NUMBER, STRING, EOS}; -#define MAX_IFS 5 +#ifndef MAX_IFS +#define MAX_IFS 5 /* arbitrary limit */ +#endif /* "ifstate" keeps the state of each nested $if the lexical is dealing with. */ struct ifState { - int elsepart; /* true if its in the $else part */ + int elsepart; /* true if it's in the $else part */ int condition; /* true if $if condition is true */ int skip; /* true if part must be skipped */ }; @@ -56,7 +58,7 @@ void luaX_setinput (LexState *LS, ZIO *z); int luaX_lex (LexState *LS); void luaX_syntaxerror (LexState *ls, char *s, char *token); void luaX_error (LexState *ls, char *s); -void luaX_token2str (LexState *ls, int token, char *s); +void luaX_token2str (int token, char *s); #endif diff --git a/src/lmem.c b/src/lmem.c dissimilarity index 73% index bcb3c8e..5f840b0 100644 --- a/src/lmem.c +++ b/src/lmem.c @@ -1,113 +1,140 @@ -/* -** $Id: lmem.c,v 1.7 1998/06/29 22:03:06 roberto Exp $ -** Interface to Memory Manager -** See Copyright Notice in lua.h -*/ - - -#include - -#include "lmem.h" -#include "lstate.h" -#include "lua.h" - - - -int luaM_growaux (void **block, unsigned long nelems, int size, - char *errormsg, unsigned long limit) -{ - if (nelems >= limit) - lua_error(errormsg); - nelems = (nelems == 0) ? 32 : nelems*2; - if (nelems > limit) - nelems = limit; - *block = luaM_realloc(*block, nelems*size); - return (int)nelems; -} - - - -#ifndef DEBUG - -/* -** generic allocation routine. -** real ANSI systems do not need some of these tests, -** since realloc(NULL, s)==malloc(s) and realloc(b, 0)==free(b). -** But some systems (e.g. Sun OS) are not that ANSI... -*/ -void *luaM_realloc (void *block, unsigned long size) -{ - size_t s = (size_t)size; - if (s != size) - lua_error("Allocation Error: Block too big"); - if (size == 0) { - if (block) { - free(block); - } - return NULL; - } - block = block ? realloc(block, s) : malloc(s); - if (block == NULL) - lua_error(memEM); - return block; -} - - - -#else -/* DEBUG */ - -#include - - -#define HEADER (sizeof(double)) - -#define MARK 55 - -unsigned long numblocks = 0; -unsigned long totalmem = 0; - - -static void *checkblock (void *block) -{ - unsigned long *b = (unsigned long *)((char *)block - HEADER); - unsigned long size = *b; - LUA_ASSERT(*(((char *)b)+size+HEADER) == MARK, - "corrupted block"); - numblocks--; - totalmem -= size; - return b; -} - - -void *luaM_realloc (void *block, unsigned long size) -{ - unsigned long realsize = HEADER+size+1; - if (realsize != (size_t)realsize) - lua_error("Allocation Error: Block too big"); - if (size == 0) { /* ANSI dosen't need this, but some machines... */ - if (block) { - unsigned long *b = (unsigned long *)((char *)block - HEADER); - memset(block, -1, *b); /* erase block */ - block = checkblock(block); - free(block); - } - return NULL; - } - if (block) { - block = checkblock(block); - block = (unsigned long *)realloc(block, realsize); - } - else - block = (unsigned long *)malloc(realsize); - if (block == NULL) - lua_error(memEM); - totalmem += size; - numblocks++; - *(unsigned long *)block = size; - *(((char *)block)+size+HEADER) = MARK; - return (unsigned long *)((char *)block+HEADER); -} - - -#endif +/* +** $Id: lmem.c,v 1.17 1999/05/24 17:51:05 roberto Exp $ +** Interface to Memory Manager +** See Copyright Notice in lua.h +*/ + + +#include + +#include "lmem.h" +#include "lstate.h" +#include "lua.h" + + +/* +** real ANSI systems do not need these tests; +** but some systems (Sun OS) are not that ANSI... +*/ +#ifdef OLD_ANSI +#define realloc(b,s) ((b) == NULL ? malloc(s) : (realloc)(b, s)) +#define free(b) if (b) (free)(b) +#endif + + +#define MINSIZE 8 /* minimum size for "growing" vectors */ + + + + +static unsigned long power2 (unsigned long n) { + unsigned long p = MINSIZE; + while (p<=n) p<<=1; + return p; +} + + +void *luaM_growaux (void *block, unsigned long nelems, int inc, int size, + char *errormsg, unsigned long limit) { + unsigned long newn = nelems+inc; + if (newn >= limit) lua_error(errormsg); + if ((newn ^ nelems) <= nelems || /* still the same power of 2 limit? */ + (nelems > 0 && newn < MINSIZE)) /* or block already is MINSIZE? */ + return block; /* do not need to reallocate */ + else /* it crossed a power of 2 boundary; grow to next power */ + return luaM_realloc(block, power2(newn)*size); +} + + +#ifndef DEBUG + +/* +** generic allocation routine. +*/ +void *luaM_realloc (void *block, unsigned long size) { + size_t s = (size_t)size; + if (s != size) + lua_error("memory allocation error: block too big"); + if (size == 0) { + free(block); /* block may be NULL, that is OK for free */ + return NULL; + } + block = realloc(block, s); + if (block == NULL) + lua_error(memEM); + return block; +} + + + +#else +/* DEBUG */ + +#include + + +#define HEADER (sizeof(double)) +#define MARKSIZE 16 + +#define MARK 55 + + +#define blocksize(b) ((unsigned long *)((char *)(b) - HEADER)) + +unsigned long numblocks = 0; +unsigned long totalmem = 0; + + +static void *checkblock (void *block) { + if (block == NULL) + return NULL; + else { + unsigned long *b = blocksize(block); + unsigned long size = *b; + int i; + for (i=0;i size) oldsize = size; + memcpy(newblock+HEADER, block, oldsize); + freeblock(block); /* erase (and check) old copy */ + } + if (newblock == NULL) + lua_error(memEM); + totalmem += size; + numblocks++; + *(unsigned long *)newblock = size; + for (i=0;i /* memory error messages */ #define codeEM "code size overflow" @@ -19,18 +16,19 @@ #define refEM "reference table overflow" #define tableEM "table overflow" #define memEM "not enough memory" +#define arrEM "internal array bigger than `int' limit" void *luaM_realloc (void *oldblock, unsigned long size); -int luaM_growaux (void **block, unsigned long nelems, int size, +void *luaM_growaux (void *block, unsigned long nelems, int inc, int size, char *errormsg, unsigned long limit); #define luaM_free(b) luaM_realloc((b), 0) #define luaM_malloc(t) luaM_realloc(NULL, (t)) #define luaM_new(t) ((t *)luaM_malloc(sizeof(t))) #define luaM_newvector(n,t) ((t *)luaM_malloc((n)*sizeof(t))) -#define luaM_growvector(old,n,t,e,l) \ - (luaM_growaux((void**)old,n,sizeof(t),e,l)) -#define luaM_reallocvector(v,n,t) ((t *)luaM_realloc(v,(n)*sizeof(t))) +#define luaM_growvector(v,nelems,inc,t,e,l) \ + ((v)=(t *)luaM_growaux(v,nelems,inc,sizeof(t),e,l)) +#define luaM_reallocvector(v,n,t) ((v)=(t *)luaM_realloc(v,(n)*sizeof(t))) #ifdef DEBUG diff --git a/src/lobject.c b/src/lobject.c index 8d331ef..0225e2d 100644 --- a/src/lobject.c +++ b/src/lobject.c @@ -1,9 +1,10 @@ /* -** $Id: lobject.c,v 1.13 1998/06/19 16:14:09 roberto Exp $ +** $Id: lobject.c,v 1.19 1999/04/13 19:28:49 roberto Exp $ ** Some generic functions over Lua objects ** See Copyright Notice in lua.h */ +#include #include #include "lobject.h" @@ -34,14 +35,12 @@ int luaO_redimension (int oldsize) if (dimensions[i] > oldsize) return dimensions[i]; } - lua_error("table overflow"); + lua_error("tableEM"); return 0; /* to avoid warnings */ } -int luaO_equalObj (TObject *t1, TObject *t2) -{ - if (ttype(t1) != ttype(t2)) return 0; +int luaO_equalval (TObject *t1, TObject *t2) { switch (ttype(t1)) { case LUA_T_NIL: return 1; case LUA_T_NUMBER: return nvalue(t1) == nvalue(t2); @@ -64,20 +63,67 @@ void luaO_insertlist (GCnode *root, GCnode *node) node->marked = 0; } + #ifdef OLD_ANSI -void luaO_memup (void *dest, void *src, int size) -{ - char *d = dest; - char *s = src; - while (size--) d[size]=s[size]; +void luaO_memup (void *dest, void *src, int size) { + while (size--) + ((char *)dest)[size]=((char *)src)[size]; } -void luaO_memdown (void *dest, void *src, int size) -{ - char *d = dest; - char *s = src; +void luaO_memdown (void *dest, void *src, int size) { int i; - for (i=0; i>=1) { + if (e & 1) res *= exp; + exp *= exp; + } + return res; +} + + +double luaO_str2d (char *s) { /* LUA_NUMBER */ + double a = 0.0; + int point = 0; + while (isdigit((unsigned char)*s)) { + a = 10.0*a + (*(s++)-'0'); + } + if (*s == '.') { + s++; + while (isdigit((unsigned char)*s)) { + a = 10.0*a + (*(s++)-'0'); + point++; + } + } + if (toupper((unsigned char)*s) == 'E') { + int e = 0; + int sig = 1; + s++; + if (*s == '-') { + s++; + sig = -1; + } + else if (*s == '+') s++; + if (!isdigit((unsigned char)*s)) return -1; /* no digit in the exponent? */ + do { + e = 10*e + (*(s++)-'0'); + } while (isdigit((unsigned char)*s)); + point -= sig*e; + } + while (isspace((unsigned char)*s)) s++; + if (*s != '\0') return -1; /* invalid trailing characters? */ + if (point > 0) + a /= expten(point); + else if (point < 0) + a *= expten(-point); + return a; +} + diff --git a/src/lobject.h b/src/lobject.h index fbd6070..f3b2147 100644 --- a/src/lobject.h +++ b/src/lobject.h @@ -1,5 +1,5 @@ /* -** $Id: lobject.h,v 1.21 1998/06/18 16:57:03 roberto Exp $ +** $Id: lobject.h,v 1.28 1999/03/16 16:43:27 roberto Exp $ ** Type definitions for Lua objects ** See Copyright Notice in lua.h */ @@ -32,10 +32,6 @@ #define LUA_NUM_TYPE double #endif -/* -** format to convert number to strings -*/ -#define NUMBER_FMT "%g" typedef LUA_NUM_TYPE real; @@ -45,13 +41,6 @@ typedef unsigned char Byte; /* unsigned 8 bits */ #define MAX_INT (INT_MAX-2) /* maximum value of an int (-2 for safety) */ -/* maximum value of a word of 2 bytes (-2 for safety); must fit in an "int" */ -#if MAX_INT < 65534 -#define MAX_WORD MAX_INT -#else -#define MAX_WORD 65534 -#endif - typedef unsigned int IntPoint; /* unsigned with same size as a pointer (for hashing) */ @@ -75,7 +64,6 @@ typedef enum { LUA_T_LINE = -11 } lua_Type; -#define NUM_TYPES 11 #define NUM_TAGS 7 @@ -139,7 +127,7 @@ typedef struct TProtoFunc { int nconsts; Byte *code; /* ends with opcode ENDCODE */ int lineDefined; - TaggedString *fileName; + TaggedString *source; struct LocVar *locvars; /* ends with line = -1 */ } TProtoFunc; @@ -192,11 +180,17 @@ typedef struct Hash { extern char *luaO_typenames[]; +#define luaO_typename(o) luaO_typenames[-ttype(o)] + + extern TObject luaO_nilobject; -int luaO_equalObj (TObject *t1, TObject *t2); +#define luaO_equalObj(t1,t2) ((ttype(t1) != ttype(t2)) ? 0 \ + : luaO_equalval(t1,t2)) +int luaO_equalval (TObject *t1, TObject *t2); int luaO_redimension (int oldsize); void luaO_insertlist (GCnode *root, GCnode *node); +double luaO_str2d (char *s); #ifdef OLD_ANSI void luaO_memup (void *dest, void *src, int size); diff --git a/src/lopcodes.h b/src/lopcodes.h dissimilarity index 89% index 27dded4..6a59b39 100644 --- a/src/lopcodes.h +++ b/src/lopcodes.h @@ -1,181 +1,138 @@ -/* -** $Id: lopcodes.h,v 1.18 1998/06/25 14:37:00 roberto Exp $ -** Opcodes for Lua virtual machine -** See Copyright Notice in lua.h -*/ - -#ifndef lopcodes_h -#define lopcodes_h - - -/* -** NOTICE: variants of the same opcode must be consecutive: First, those -** with byte parameter, then with built-in parameters, and last with -** word parameter. -*/ - - -typedef enum { -/* name parm before after side effect ------------------------------------------------------------------------------*/ -ENDCODE,/* - - - */ - -PUSHNIL,/* b - nil_0...nil_b */ -PUSHNIL0,/* - - nil */ - -PUSHNUMBER,/* b - (float)b */ -PUSHNUMBER0,/* - - 0.0 */ -PUSHNUMBER1,/* - - 1.0 */ -PUSHNUMBER2,/* - - 2.0 */ -PUSHNUMBERW,/* w - (float)w */ - -PUSHCONSTANT,/* b - CNST[b] */ -PUSHCONSTANT0,/*- - CNST[0] */ -PUSHCONSTANT1,/*- - CNST[1] */ -PUSHCONSTANT2,/*- - CNST[2] */ -PUSHCONSTANT3,/*- - CNST[3] */ -PUSHCONSTANT4,/*- - CNST[4] */ -PUSHCONSTANT5,/*- - CNST[5] */ -PUSHCONSTANT6,/*- - CNST[6] */ -PUSHCONSTANT7,/*- - CNST[7] */ -PUSHCONSTANTW,/*w - CNST[w] */ - -PUSHUPVALUE,/* b - Closure[b] */ -PUSHUPVALUE0,/* - - Closure[0] */ -PUSHUPVALUE1,/* - - Closure[1] */ - -PUSHLOCAL,/* b - LOC[b] */ -PUSHLOCAL0,/* - - LOC[0] */ -PUSHLOCAL1,/* - - LOC[1] */ -PUSHLOCAL2,/* - - LOC[2] */ -PUSHLOCAL3,/* - - LOC[3] */ -PUSHLOCAL4,/* - - LOC[4] */ -PUSHLOCAL5,/* - - LOC[5] */ -PUSHLOCAL6,/* - - LOC[6] */ -PUSHLOCAL7,/* - - LOC[7] */ - -GETGLOBAL,/* b - VAR[CNST[b]] */ -GETGLOBAL0,/* - - VAR[CNST[0]] */ -GETGLOBAL1,/* - - VAR[CNST[1]] */ -GETGLOBAL2,/* - - VAR[CNST[2]] */ -GETGLOBAL3,/* - - VAR[CNST[3]] */ -GETGLOBAL4,/* - - VAR[CNST[4]] */ -GETGLOBAL5,/* - - VAR[CNST[5]] */ -GETGLOBAL6,/* - - VAR[CNST[6]] */ -GETGLOBAL7,/* - - VAR[CNST[7]] */ -GETGLOBALW,/* w - VAR[CNST[w]] */ - -GETTABLE,/* - i t t[i] */ - -GETDOTTED,/* b t t[CNST[b]] */ -GETDOTTED0,/* - t t[CNST[0]] */ -GETDOTTED1,/* - t t[CNST[1]] */ -GETDOTTED2,/* - t t[CNST[2]] */ -GETDOTTED3,/* - t t[CNST[3]] */ -GETDOTTED4,/* - t t[CNST[4]] */ -GETDOTTED5,/* - t t[CNST[5]] */ -GETDOTTED6,/* - t t[CNST[6]] */ -GETDOTTED7,/* - t t[CNST[7]] */ -GETDOTTEDW,/* w t t[CNST[w]] */ - -PUSHSELF,/* b t t t[CNST[b]] */ -PUSHSELF0,/* - t t t[CNST[0]] */ -PUSHSELF1,/* - t t t[CNST[1]] */ -PUSHSELF2,/* - t t t[CNST[2]] */ -PUSHSELF3,/* - t t t[CNST[3]] */ -PUSHSELF4,/* - t t t[CNST[4]] */ -PUSHSELF5,/* - t t t[CNST[5]] */ -PUSHSELF6,/* - t t t[CNST[6]] */ -PUSHSELF7,/* - t t t[CNST[7]] */ -PUSHSELFW,/* w t t t[CNST[w]] */ - -CREATEARRAY,/* b - newarray(size = b) */ -CREATEARRAY0,/* - - newarray(size = 0) */ -CREATEARRAY1,/* - - newarray(size = 1) */ -CREATEARRAYW,/* w - newarray(size = w) */ - -SETLOCAL,/* b x - LOC[b]=x */ -SETLOCAL0,/* - x - LOC[0]=x */ -SETLOCAL1,/* - x - LOC[1]=x */ -SETLOCAL2,/* - x - LOC[2]=x */ -SETLOCAL3,/* - x - LOC[3]=x */ -SETLOCAL4,/* - x - LOC[4]=x */ -SETLOCAL5,/* - x - LOC[5]=x */ -SETLOCAL6,/* - x - LOC[6]=x */ -SETLOCAL7,/* - x - LOC[7]=x */ - -SETGLOBAL,/* b x - VAR[CNST[b]]=x */ -SETGLOBAL0,/* - x - VAR[CNST[0]]=x */ -SETGLOBAL1,/* - x - VAR[CNST[1]]=x */ -SETGLOBAL2,/* - x - VAR[CNST[2]]=x */ -SETGLOBAL3,/* - x - VAR[CNST[3]]=x */ -SETGLOBAL4,/* - x - VAR[CNST[4]]=x */ -SETGLOBAL5,/* - x - VAR[CNST[5]]=x */ -SETGLOBAL6,/* - x - VAR[CNST[6]]=x */ -SETGLOBAL7,/* - x - VAR[CNST[7]]=x */ -SETGLOBALW,/* w x - VAR[CNST[w]]=x */ - -SETTABLE0,/* - v i t - t[i]=v */ - -SETTABLE,/* b v a_b...a_1 i t a_b...a_1 i t t[i]=v */ - -SETLIST,/* b c v_c...v_1 t - t[i+b*FPF]=v_i */ -SETLIST0,/* b v_b...v_1 t - t[i]=v_i */ -SETLISTW,/* w c v_c...v_1 t - t[i+w*FPF]=v_i */ - -SETMAP,/* b v_b k_b ...v_0 k_0 t t t[k_i]=v_i */ -SETMAP0,/* - v_0 k_0 t t t[k_0]=v_0 */ - -EQOP,/* - y x (x==y)? 1 : nil */ -NEQOP,/* - y x (x~=y)? 1 : nil */ -LTOP,/* - y x (xy)? 1 : nil */ -GEOP,/* - y x (x>=y)? 1 : nil */ -ADDOP,/* - y x x+y */ -SUBOP,/* - y x x-y */ -MULTOP,/* - y x x*y */ -DIVOP,/* - y x x/y */ -POWOP,/* - y x x^y */ -CONCOP,/* - y x x..y */ -MINUSOP,/* - x -x */ -NOTOP,/* - x (x==nil)? 1 : nil */ - -ONTJMP,/* b x (x!=nil)? x : - (x!=nil)? PC+=b */ -ONTJMPW,/* w x (x!=nil)? x : - (x!=nil)? PC+=w */ -ONFJMP,/* b x (x==nil)? x : - (x==nil)? PC+=b */ -ONFJMPW,/* w x (x==nil)? x : - (x==nil)? PC+=w */ -JMP,/* b - - PC+=b */ -JMPW,/* w - - PC+=w */ -IFFJMP,/* b x - (x==nil)? PC+=b */ -IFFJMPW,/* w x - (x==nil)? PC+=w */ -IFTUPJMP,/* b x - (x!=nil)? PC-=b */ -IFTUPJMPW,/* w x - (x!=nil)? PC-=w */ -IFFUPJMP,/* b x - (x==nil)? PC-=b */ -IFFUPJMPW,/* w x - (x==nil)? PC-=w */ - -CLOSURE,/* b c v_c...v_1 closure(CNST[b], v_c...v_1) */ -CLOSUREW,/* w c v_b...v_1 closure(CNST[w], v_c...v_1) */ - -CALLFUNC,/* b c v_c...v_1 f r_b...r_1 f(v1,...,v_c) */ -CALLFUNC0,/* b v_b...v_1 f - f(v1,...,v_b) */ -CALLFUNC1,/* b v_b...v_1 f r_1 f(v1,...,v_b) */ - -RETCODE,/* b - - */ - -SETLINE,/* b - - LINE=b */ -SETLINEW,/* w - - LINE=w */ - -POP,/* b - - TOP-=(b+1) */ -POP0,/* - - - TOP-=1 */ -POP1/* - - - TOP-=2 */ - -} OpCode; - - -#define RFIELDS_PER_FLUSH 32 /* records (SETMAP) */ -#define LFIELDS_PER_FLUSH 64 /* lists (SETLIST) */ - -#define ZEROVARARG 64 - -#endif +/* +** $Id: lopcodes.h,v 1.33 1999/06/17 17:04:03 roberto Exp $ +** Opcodes for Lua virtual machine +** See Copyright Notice in lua.h +*/ + +#ifndef lopcodes_h +#define lopcodes_h + + +/* +** NOTICE: variants of the same opcode must be consecutive: First, those +** with word parameter, then with byte parameter. +*/ + + +typedef enum { +/* name parm before after side effect +-----------------------------------------------------------------------------*/ +ENDCODE,/* - - (return) */ +RETCODE,/* b - (return) */ + +CALL,/* b c v_c...v_1 f r_b...r_1 f(v1,...,v_c) */ + +TAILCALL,/* b c v_c...v_1 f (return) f(v1,...,v_c) */ + +PUSHNIL,/* b - nil_0...nil_b */ +POP,/* b a_b...a_1 - */ + +PUSHNUMBERW,/* w - (float)w */ +PUSHNUMBER,/* b - (float)b */ + +PUSHNUMBERNEGW,/* w - (float)-w */ +PUSHNUMBERNEG,/* b - (float)-b */ + +PUSHCONSTANTW,/*w - CNST[w] */ +PUSHCONSTANT,/* b - CNST[b] */ + +PUSHUPVALUE,/* b - Closure[b] */ + +PUSHLOCAL,/* b - LOC[b] */ + +GETGLOBALW,/* w - VAR[CNST[w]] */ +GETGLOBAL,/* b - VAR[CNST[b]] */ + +GETTABLE,/* - i t t[i] */ + +GETDOTTEDW,/* w t t[CNST[w]] */ +GETDOTTED,/* b t t[CNST[b]] */ + +PUSHSELFW,/* w t t t[CNST[w]] */ +PUSHSELF,/* b t t t[CNST[b]] */ + +CREATEARRAYW,/* w - newarray(size = w) */ +CREATEARRAY,/* b - newarray(size = b) */ + +SETLOCAL,/* b x - LOC[b]=x */ + +SETGLOBALW,/* w x - VAR[CNST[w]]=x */ +SETGLOBAL,/* b x - VAR[CNST[b]]=x */ + +SETTABLEPOP,/* - v i t - t[i]=v */ + +SETTABLE,/* b v a_b...a_1 i t a_b...a_1 i t t[i]=v */ + +SETLISTW,/* w c v_c...v_1 t t t[i+w*FPF]=v_i */ +SETLIST,/* b c v_c...v_1 t t t[i+b*FPF]=v_i */ + +SETMAP,/* b v_b k_b ...v_0 k_0 t t t[k_i]=v_i */ + +NEQOP,/* - y x (x~=y)? 1 : nil */ +EQOP,/* - y x (x==y)? 1 : nil */ +LTOP,/* - y x (xy)? 1 : nil */ +GEOP,/* - y x (x>=y)? 1 : nil */ +ADDOP,/* - y x x+y */ +SUBOP,/* - y x x-y */ +MULTOP,/* - y x x*y */ +DIVOP,/* - y x x/y */ +POWOP,/* - y x x^y */ +CONCOP,/* - y x x..y */ +MINUSOP,/* - x -x */ +NOTOP,/* - x (x==nil)? 1 : nil */ + +ONTJMPW,/* w x (x!=nil)? x : - (x!=nil)? PC+=w */ +ONTJMP,/* b x (x!=nil)? x : - (x!=nil)? PC+=b */ +ONFJMPW,/* w x (x==nil)? x : - (x==nil)? PC+=w */ +ONFJMP,/* b x (x==nil)? x : - (x==nil)? PC+=b */ +JMPW,/* w - - PC+=w */ +JMP,/* b - - PC+=b */ +IFFJMPW,/* w x - (x==nil)? PC+=w */ +IFFJMP,/* b x - (x==nil)? PC+=b */ +IFTUPJMPW,/* w x - (x!=nil)? PC-=w */ +IFTUPJMP,/* b x - (x!=nil)? PC-=b */ +IFFUPJMPW,/* w x - (x==nil)? PC-=w */ +IFFUPJMP,/* b x - (x==nil)? PC-=b */ + +CLOSUREW,/* w c v_c...v_1 closure(CNST[w], v_c...v_1) */ +CLOSURE,/* b c v_c...v_1 closure(CNST[b], v_c...v_1) */ + +SETLINEW,/* w - - LINE=w */ +SETLINE,/* b - - LINE=b */ + +LONGARGW,/* w (add w*(1<<16) to arg of next instruction) */ +LONGARG,/* b (add b*(1<<16) to arg of next instruction) */ + +CHECKSTACK /* b (assert #temporaries == b; only for internal debuging!) */ + +} OpCode; + + +#define RFIELDS_PER_FLUSH 32 /* records (SETMAP) */ +#define LFIELDS_PER_FLUSH 64 /* FPF - lists (SETLIST) */ + +#define ZEROVARARG 128 + + +/* maximum value of an arg of 3 bytes; must fit in an "int" */ +#if MAX_INT < (1<<24) +#define MAX_ARG MAX_INT +#else +#define MAX_ARG ((1<<24)-1) +#endif + +/* maximum value of a word of 2 bytes; cannot be bigger than MAX_ARG */ +#if MAX_ARG < (1<<16) +#define MAX_WORD MAX_ARG +#else +#define MAX_WORD ((1<<16)-1) +#endif + + +/* maximum value of a byte */ +#define MAX_BYTE ((1<<8)-1) + + +#endif diff --git a/src/lparser.c b/src/lparser.c index 9b37d9d..c18b75c 100644 --- a/src/lparser.c +++ b/src/lparser.c @@ -1,11 +1,12 @@ /* -** $Id: lparser.c,v 1.3 1998/07/06 22:07:51 roberto Exp $ +** $Id: lparser.c,v 1.37 1999/06/17 17:04:03 roberto Exp $ ** LL(1) Parser and code generator for Lua ** See Copyright Notice in lua.h */ #include +#include #include "lauxlib.h" #include "ldo.h" @@ -21,35 +22,48 @@ #include "lzio.h" -/* for limit numbers in error messages */ -#define MES_LIM(x) "(limit=" x ")" - /* size of a "normal" jump instruction: OpCode + 1 byte */ #define JMPSIZE 2 /* maximum number of local variables */ -#define MAXLOCALS 32 -#define SMAXLOCALS "32" +#ifndef MAXLOCALS +#define MAXLOCALS 200 /* arbitrary limit (<256) */ +#endif /* maximum number of upvalues */ -#define MAXUPVALUES 16 -#define SMAXUPVALUES "16" +#ifndef MAXUPVALUES +#define MAXUPVALUES 32 /* arbitrary limit (<256) */ +#endif + + +/* maximum number of variables in the left side of an assignment */ +#ifndef MAXVARSLH +#define MAXVARSLH 100 /* arbitrary limit (<255) */ +#endif + + +/* maximum number of parameters in a function */ +#ifndef MAXPARAMS +#define MAXPARAMS 100 /* arbitrary limit (locvars */ - int maxcode; /* size of f->code */ - int maxvars; /* size of f->locvars (-1 if no debug information) */ - int maxconsts; /* size of f->consts */ + int nvars; /* number of entries in f->locvars (-1 if no debug information) */ int lastsetline; /* line where last SETLINE was issued */ vardesc upvalues[MAXUPVALUES]; /* upvalues */ TaggedString *localvar[MAXLOCALS]; /* store local variable names */ } FuncState; +/* +** prototypes for non-terminal functions +*/ static int assignment (LexState *ls, vardesc *v, int nvars); static int cond (LexState *ls); static int funcname (LexState *ls, vardesc *v); @@ -117,22 +131,28 @@ static void exp1 (LexState *ls); static void exp2 (LexState *ls, vardesc *v); static void explist (LexState *ls, listdesc *e); static void explist1 (LexState *ls, listdesc *e); -static void ifpart (LexState *ls); +static void ifpart (LexState *ls, int line); static void parlist (LexState *ls); static void part (LexState *ls, constdesc *cd); static void recfield (LexState *ls); static void ret (LexState *ls); -static void simpleexp (LexState *ls, vardesc *v); static void statlist (LexState *ls); static void var_or_func (LexState *ls, vardesc *v); static void var_or_func_tail (LexState *ls, vardesc *v); +static void checklimit (LexState *ls, int val, int limit, char *msg) { + if (val > limit) { + char buff[100]; + sprintf(buff, "too many %s (limit=%d)", msg, limit); + luaX_error(ls, buff); + } +} + + static void check_pc (FuncState *fs, int n) { - if (fs->pc+n > fs->maxcode) - fs->maxcode = luaM_growvector(&fs->f->code, fs->maxcode, - Byte, codeEM, MAX_INT); + luaM_growvector(fs->f->code, fs->pc, n, Byte, codeEM, MAX_INT); } @@ -146,76 +166,79 @@ static void deltastack (LexState *ls, int delta) { FuncState *fs = ls->fs; fs->stacksize += delta; if (fs->stacksize > fs->maxstacksize) { - if (fs->stacksize > 255) + if (fs->stacksize > MAX_BYTE) luaX_error(ls, "function/expression too complex"); fs->maxstacksize = fs->stacksize; } } -static int code_oparg_at (LexState *ls, int pc, OpCode op, int builtin, - int arg, int delta) { +static void code_oparg_at (LexState *ls, int pc, OpCode op, + int arg, int delta) { Byte *code = ls->fs->f->code; deltastack(ls, delta); - if (arg < builtin) { - code[pc] = op+1+arg; - return 1; + if (arg <= MAX_BYTE) { + code[pc] = (Byte)op; + code[pc+1] = (Byte)arg; } - else if (arg <= 255) { - code[pc] = op; - code[pc+1] = arg; - return 2; - } - else if (arg <= MAX_WORD) { - code[pc] = op+1+builtin; - code[pc+1] = arg>>8; - code[pc+2] = arg&0xFF; - return 3; + else if (arg > MAX_ARG) + luaX_error(ls, "code too long"); + else { /* MAX_BYTE < arg < MAX_ARG */ + if (arg > MAX_WORD) { + code[pc] = (Byte)LONGARG; + code[pc+1] = (Byte)(arg>>16); + pc += 2; + } + code[pc] = (Byte)(op-1); /* opcode for word argument */ + code[pc+1] = (Byte)((arg&0xFFFF)>>8); + code[pc+2] = (Byte)(arg&0xFF); } - else luaX_error(ls, "code too long " MES_LIM("64K")); - return 0; /* to avoid warnings */ } -static int fix_opcode (LexState *ls, int pc, OpCode op, int builtin, int arg) { - FuncState *fs = ls->fs; - TProtoFunc *f = fs->f; - if (arg < builtin) { /* close space */ - luaO_memdown(f->code+pc+1, f->code+pc+2, fs->pc-(pc+2)); - fs->pc--; - } - else if (arg > 255) { /* open space */ - check_pc(fs, 1); - luaO_memup(f->code+pc+1, f->code+pc, fs->pc-pc); - fs->pc++; +static int codesize (int arg) { + if (arg <= MAX_BYTE) return 2; /* opcode + 1 byte */ + else if (arg <= MAX_WORD) return 3; /* opcode + 1 word (2 bytes) */ + else return 5; /* LONGARG + 1 byte + opcode + 1 word (2 bytes) */ +} + + +static int fix_opcode (LexState *ls, int pc, OpCode op, int arg) { + int tomove = codesize(arg)-2; + if (tomove > 0) { /* need to open space? */ + FuncState *fs = ls->fs; + TProtoFunc *f = fs->f; + check_pc(fs, tomove); + luaO_memup(f->code+pc+tomove, f->code+pc, fs->pc-pc); + fs->pc += tomove; } - return code_oparg_at(ls, pc, op, builtin, arg, 0) - 2; + code_oparg_at(ls, pc, op, arg, 0); + return tomove; } -static void code_oparg (LexState *ls, OpCode op, int builtin, int arg, - int delta) { - check_pc(ls->fs, 3); /* maximum code size */ - ls->fs->pc += code_oparg_at(ls, ls->fs->pc, op, builtin, arg, delta); + +static void code_oparg (LexState *ls, OpCode op, int arg, int delta) { + int size = codesize(arg); + check_pc(ls->fs, size); + code_oparg_at(ls, ls->fs->pc, op, arg, delta); + ls->fs->pc += size; } static void code_opcode (LexState *ls, OpCode op, int delta) { deltastack(ls, delta); - code_byte(ls->fs, op); + code_byte(ls->fs, (Byte)op); } static void code_constant (LexState *ls, int c) { - code_oparg(ls, PUSHCONSTANT, 8, c, 1); + code_oparg(ls, PUSHCONSTANT, c, 1); } static int next_constant (FuncState *fs) { TProtoFunc *f = fs->f; - if (f->nconsts >= fs->maxconsts) { - fs->maxconsts = luaM_growvector(&f->consts, fs->maxconsts, TObject, - constantEM, MAX_WORD); - } + luaM_growvector(f->consts, f->nconsts, 1, TObject, constantEM, MAX_ARG); return f->nconsts++; } @@ -249,9 +272,9 @@ static int real_constant (FuncState *fs, real r) { if (ttype(&cnt[c]) == LUA_T_NUMBER && nvalue(&cnt[c]) == r) return c; } - /* not found; create a luaM_new entry */ + /* not found; create a new entry */ c = next_constant(fs); - cnt = fs->f->consts; /* 'next_constant' may reallocate this vector */ + cnt = fs->f->consts; /* 'next_constant' may have reallocated this vector */ ttype(&cnt[c]) = LUA_T_NUMBER; nvalue(&cnt[c]) = r; return c; @@ -259,9 +282,11 @@ static int real_constant (FuncState *fs, real r) { static void code_number (LexState *ls, real f) { - int i; - if (f >= 0 && f <= (real)MAX_WORD && (real)(i=(int)f) == f) - code_oparg(ls, PUSHNUMBER, 3, i, 1); /* f has a short integer value */ + real af = (f<0) ? -f : f; + if (0 <= af && af <= (real)MAX_WORD && (int)af == af) { + /* abs(f) has a short integer value */ + code_oparg(ls, (f<0) ? PUSHNUMBERNEG : PUSHNUMBER, (int)af, 1); + } else code_constant(ls, real_constant(ls->fs, f)); } @@ -269,24 +294,23 @@ static void code_number (LexState *ls, real f) { static void flush_record (LexState *ls, int n) { if (n > 0) - code_oparg(ls, SETMAP, 1, n-1, -2*n); + code_oparg(ls, SETMAP, n-1, -2*n); } static void flush_list (LexState *ls, int m, int n) { - if (n == 0) return; - code_oparg(ls, SETLIST, 1, m, -n); - code_byte(ls->fs, n); + if (n > 0) { + code_oparg(ls, SETLIST, m, -n); + code_byte(ls->fs, (Byte)n); + } } static void luaI_registerlocalvar (FuncState *fs, TaggedString *varname, int line) { - if (fs->maxvars != -1) { /* debug information? */ + if (fs->nvars != -1) { /* debug information? */ TProtoFunc *f = fs->f; - if (fs->nvars >= fs->maxvars) - fs->maxvars = luaM_growvector(&f->locvars, fs->maxvars, - LocVar, "", MAX_WORD); + luaM_growvector(f->locvars, fs->nvars, 1, LocVar, "", MAX_INT); f->locvars[fs->nvars].varname = varname; f->locvars[fs->nvars].line = line; fs->nvars++; @@ -301,10 +325,8 @@ static void luaI_unregisterlocalvar (FuncState *fs, int line) { static void store_localvar (LexState *ls, TaggedString *name, int n) { FuncState *fs = ls->fs; - if (fs->nlocalvar+n < MAXLOCALS) - fs->localvar[fs->nlocalvar+n] = name; - else - luaX_error(ls, "too many local variables " MES_LIM(SMAXLOCALS)); + checklimit(ls, fs->nlocalvar+n+1, MAXLOCALS, "local variables"); + fs->localvar[fs->nlocalvar+n] = name; luaI_registerlocalvar(fs, name, ls->linenumber); } @@ -315,6 +337,16 @@ static void add_localvar (LexState *ls, TaggedString *name) { } +static void correctvarlines (LexState *ls, int nvars) { + FuncState *fs = ls->fs; + if (fs->nvars != -1) { /* debug information? */ + for (; nvars; nvars--) { /* correct line information */ + fs->f->locvars[fs->nvars-nvars].line = fs->lastsetline; + } + } +} + + static int aux_localname (FuncState *fs, TaggedString *n) { int i; for (i=fs->nlocalvar-1; i >= 0; i--) @@ -326,13 +358,13 @@ static int aux_localname (FuncState *fs, TaggedString *n) { static void singlevar (LexState *ls, TaggedString *n, vardesc *var, int prev) { FuncState *fs = prev ? ls->fs->prev : ls->fs; int i = aux_localname(fs, n); - if (i >= 0) { /* local value */ + if (i >= 0) { /* local value? */ var->k = VLOCAL; var->info = i; } - else { /* check shadowing */ + else { FuncState *level = fs; - while ((level = level->prev) != NULL) + while ((level = level->prev) != NULL) /* check shadowing */ if (aux_localname(level, n) >= 0) luaX_syntaxerror(ls, "cannot access a variable in outer scope", n->str); var->k = VGLOBAL; @@ -351,29 +383,26 @@ static int indexupvalue (LexState *ls, TaggedString *n) { return i; } /* new one */ - if (++(fs->nupvalues) > MAXUPVALUES) - luaX_error(ls, "too many upvalues in a single function " - MES_LIM(SMAXUPVALUES)); + ++(fs->nupvalues); + checklimit(ls, fs->nupvalues, MAXUPVALUES, "upvalues"); fs->upvalues[i] = v; /* i = fs->nupvalues - 1 */ return i; } static void pushupvalue (LexState *ls, TaggedString *n) { - int i; if (ls->fs->prev == NULL) luaX_syntaxerror(ls, "cannot access upvalue in main", n->str); if (aux_localname(ls->fs, n) >= 0) luaX_syntaxerror(ls, "cannot access an upvalue in current scope", n->str); - i = indexupvalue(ls, n); - code_oparg(ls, PUSHUPVALUE, 2, i, 1); + code_oparg(ls, PUSHUPVALUE, indexupvalue(ls, n), 1); } static void check_debugline (LexState *ls) { - if (lua_debug && ls->linenumber != ls->fs->lastsetline) { - code_oparg(ls, SETLINE, 0, ls->linenumber, 0); + if (L->debug && ls->linenumber != ls->fs->lastsetline) { + code_oparg(ls, SETLINE, ls->linenumber, 0); ls->fs->lastsetline = ls->linenumber; } } @@ -381,22 +410,22 @@ static void check_debugline (LexState *ls) { static void adjuststack (LexState *ls, int n) { if (n > 0) - code_oparg(ls, POP, 2, n-1, -n); + code_oparg(ls, POP, n, -n); else if (n < 0) - code_oparg(ls, PUSHNIL, 1, (-n)-1, -n); + code_oparg(ls, PUSHNIL, (-n)-1, -n); } static void close_exp (LexState *ls, int pc, int nresults) { - if (pc > 0) { /* expression is an open function call */ + if (pc > 0) { /* expression is an open function call? */ Byte *code = ls->fs->f->code; - int nparams = code[pc]; /* save nparams */ - pc += fix_opcode(ls, pc-2, CALLFUNC, 2, nresults); - code[pc] = nparams; /* restore nparams */ - if (nresults != MULT_RET) - deltastack(ls, nresults); /* "push" results */ - deltastack(ls, -(nparams+1)); /* "pop" params and function */ + code[pc-1] = (Byte)nresults; /* set nresults */ + /* push results, pop params (at code[pc]) and function */ + deltastack(ls, nresults-(code[pc]+1)); } +#ifdef DEBUG + code_oparg(ls, CHECKSTACK, ls->fs->stacksize, 0); +#endif } @@ -408,7 +437,7 @@ static void adjust_mult_assign (LexState *ls, int nvars, listdesc *d) { } else { /* must correct function call */ diff--; /* do not count function call itself */ - if (diff < 0) { /* more variables than values */ + if (diff <= 0) { /* more variables than values? */ /* function call must provide extra values */ close_exp(ls, d->pc, -diff); } @@ -423,29 +452,39 @@ static void adjust_mult_assign (LexState *ls, int nvars, listdesc *d) { static void code_args (LexState *ls, int nparams, int dots) { FuncState *fs = ls->fs; fs->nlocalvar += nparams; /* "self" may already be there */ + checklimit(ls, fs->nlocalvar, MAXPARAMS, "parameters"); nparams = fs->nlocalvar; if (!dots) { - fs->f->code[1] = nparams; /* fill-in arg information */ + fs->f->code[1] = (Byte)nparams; /* fill-in arg information */ deltastack(ls, nparams); } else { - fs->f->code[1] = nparams+ZEROVARARG; + fs->f->code[1] = (Byte)(nparams+ZEROVARARG); deltastack(ls, nparams+1); add_localvar(ls, luaS_new("arg")); } } +static void unloaddot (LexState *ls, vardesc *v) { + /* dotted variables must be stored like regular indexed vars */ + if (v->k == VDOT) { + code_constant(ls, v->info); + v->k = VINDEXED; + } +} + + static void lua_pushvar (LexState *ls, vardesc *var) { switch (var->k) { case VLOCAL: - code_oparg(ls, PUSHLOCAL, 8, var->info, 1); + code_oparg(ls, PUSHLOCAL, var->info, 1); break; case VGLOBAL: - code_oparg(ls, GETGLOBAL, 8, var->info, 1); + code_oparg(ls, GETGLOBAL, var->info, 1); break; case VDOT: - code_oparg(ls, GETDOTTED, 8, var->info, 0); + code_oparg(ls, GETDOTTED, var->info, 0); break; case VINDEXED: code_opcode(ls, GETTABLE, -1); @@ -462,13 +501,13 @@ static void lua_pushvar (LexState *ls, vardesc *var) { static void storevar (LexState *ls, vardesc *var) { switch (var->k) { case VLOCAL: - code_oparg(ls, SETLOCAL, 8, var->info, -1); + code_oparg(ls, SETLOCAL, var->info, -1); break; case VGLOBAL: - code_oparg(ls, SETGLOBAL, 8, var->info, -1); + code_oparg(ls, SETGLOBAL, var->info, -1); break; case VINDEXED: - code_opcode(ls, SETTABLE0, -3); + code_opcode(ls, SETTABLEPOP, -3); break; default: LUA_INTERNALERROR("invalid var kind to store"); @@ -478,21 +517,20 @@ static void storevar (LexState *ls, vardesc *var) { static int fix_jump (LexState *ls, int pc, OpCode op, int n) { /* jump is relative to position following jump instruction */ - return fix_opcode(ls, pc, op, 0, n-(pc+JMPSIZE)); + return fix_opcode(ls, pc, op, n-(pc+JMPSIZE)); } static void fix_upjmp (LexState *ls, OpCode op, int pos) { int delta = ls->fs->pc+JMPSIZE - pos; /* jump is relative */ - if (delta > 255) delta++; - code_oparg(ls, op, 0, delta, 0); + code_oparg(ls, op, delta+(codesize(delta)-2), 0); } static void codeIf (LexState *ls, int thenAdd, int elseAdd) { FuncState *fs = ls->fs; int elseinit = elseAdd+JMPSIZE; - if (fs->pc == elseinit) { /* no else part */ + if (fs->pc == elseinit) { /* no else part? */ fs->pc -= JMPSIZE; elseinit = fs->pc; } @@ -513,13 +551,14 @@ static void func_onstack (LexState *ls, FuncState *func) { else { for (i=0; inupvalues; i++) lua_pushvar(ls, &func->upvalues[i]); - code_oparg(ls, CLOSURE, 0, c, -func->nupvalues+1); - code_byte(fs, func->nupvalues); + deltastack(ls, 1); /* CLOSURE puts one extra element (before poping) */ + code_oparg(ls, CLOSURE, c, -func->nupvalues); + code_byte(fs, (Byte)func->nupvalues); } } -static void init_state (LexState *ls, FuncState *fs, TaggedString *filename) { +static void init_state (LexState *ls, FuncState *fs, TaggedString *source) { TProtoFunc *f = luaF_newproto(); fs->prev = ls->fs; /* linked list of funcstates */ ls->fs = fs; @@ -529,17 +568,15 @@ static void init_state (LexState *ls, FuncState *fs, TaggedString *filename) { fs->nupvalues = 0; fs->lastsetline = 0; fs->f = f; - f->fileName = filename; + f->source = source; fs->pc = 0; - fs->maxcode = 0; f->code = NULL; - fs->maxconsts = 0; - if (lua_debug) - fs->nvars = fs->maxvars = 0; - else - fs->maxvars = -1; /* flag no debug information */ - code_byte(fs, 0); /* to be filled with stacksize */ + fs->nvars = (L->debug) ? 0 : -1; /* flag no debug information? */ + code_byte(fs, 0); /* to be filled with maxstacksize */ code_byte(fs, 0); /* to be filled with arg information */ + /* push function (to avoid GC) */ + tfvalue(L->stack.top) = f; ttype(L->stack.top) = LUA_T_PROTO; + incr_top; } @@ -547,14 +584,15 @@ static void close_func (LexState *ls) { FuncState *fs = ls->fs; TProtoFunc *f = fs->f; code_opcode(ls, ENDCODE, 0); - f->code[0] = fs->maxstacksize; - f->code = luaM_reallocvector(f->code, fs->pc, Byte); - f->consts = luaM_reallocvector(f->consts, f->nconsts, TObject); - if (fs->maxvars != -1) { /* debug information? */ + f->code[0] = (Byte)fs->maxstacksize; + luaM_reallocvector(f->code, fs->pc, Byte); + luaM_reallocvector(f->consts, f->nconsts, TObject); + if (fs->nvars != -1) { /* debug information? */ luaI_registerlocalvar(fs, NULL, -1); /* flag end of vector */ - f->locvars = luaM_reallocvector(f->locvars, fs->nvars, LocVar); + luaM_reallocvector(f->locvars, fs->nvars, LocVar); } ls->fs = fs->prev; + L->stack.top--; /* pop function */ } @@ -562,13 +600,11 @@ static void close_func (LexState *ls) { static int expfollow [] = {ELSE, ELSEIF, THEN, IF, WHILE, REPEAT, DO, NAME, LOCAL, FUNCTION, END, UNTIL, RETURN, ')', ']', '}', ';', EOS, ',', 0}; + static int is_in (int tok, int *toks) { - int *t = toks; - while (*t) { - if (*t == tok) - return t-toks; - t++; - } + int *t; + for (t=toks; *t; t++) + if (*t == tok) return t-toks; return -1; } @@ -580,19 +616,25 @@ static void next (LexState *ls) { static void error_expected (LexState *ls, int token) { char buff[100], t[TOKEN_LEN]; - luaX_token2str(ls, token, t); + luaX_token2str(token, t); sprintf(buff, "`%s' expected", t); luaX_error(ls, buff); } + +static void error_unexpected (LexState *ls) { + luaX_error(ls, "unexpected token"); +} + + static void error_unmatched (LexState *ls, int what, int who, int where) { if (where == ls->linenumber) error_expected(ls, what); else { char buff[100]; char t_what[TOKEN_LEN], t_who[TOKEN_LEN]; - luaX_token2str(ls, what, t_what); - luaX_token2str(ls, who, t_who); + luaX_token2str(what, t_what); + luaX_token2str(who, t_who); sprintf(buff, "`%s' expected (to close `%s' at line %d)", t_what, t_who, where); luaX_error(ls, buff); @@ -612,13 +654,18 @@ static void check_match (LexState *ls, int what, int who, int where) { next(ls); } -static TaggedString *checkname (LexState *ls) { - TaggedString *ts; +static int checkname (LexState *ls) { + int sc; if (ls->token != NAME) luaX_error(ls, "`NAME' expected"); - ts = ls->seminfo.ts; + sc = string_constant(ls->fs, ls->seminfo.ts); next(ls); - return ts; + return sc; +} + + +static TaggedString *str_checkname (LexState *ls) { + return tsvalue(&ls->fs->f->consts[checkname(ls)]); } @@ -669,12 +716,9 @@ static int stat (LexState *ls) { int line = ls->linenumber; /* may be needed for error messages */ FuncState *fs = ls->fs; switch (ls->token) { - case IF: { /* stat -> IF ifpart END */ - next(ls); - ifpart(ls); - check_match(ls, END, IF, line); + case IF: /* stat -> IF ifpart END */ + ifpart(ls, line); return 1; - } case WHILE: { /* stat -> WHILE cond DO block END */ TProtoFunc *f = fs->f; @@ -732,7 +776,8 @@ static int stat (LexState *ls) { next(ls); nvars = localnamelist(ls); decinit(ls, &d); - ls->fs->nlocalvar += nvars; + fs->nlocalvar += nvars; + correctvarlines(ls, nvars); /* vars will be alive only after decinit */ adjust_mult_assign(ls, nvars, &d); return 1; } @@ -746,8 +791,8 @@ static int stat (LexState *ls) { luaX_error(ls, "syntax error"); close_exp(ls, v.info, 0); } - else { - int left = assignment(ls, &v, 1); /* stat -> ['%'] NAME assignment */ + else { /* stat -> ['%'] NAME assignment */ + int left = assignment(ls, &v, 1); adjuststack(ls, left); /* remove eventual 'garbage' left on stack */ } return 1; @@ -758,7 +803,7 @@ static int stat (LexState *ls) { return 0; default: - luaX_error(ls, " expected"); + error_unexpected(ls); return 0; /* to avoid warnings */ } } @@ -788,18 +833,18 @@ static void block (LexState *ls) { chunk(ls); adjuststack(ls, fs->nlocalvar - nlocalvar); for (; fs->nlocalvar > nlocalvar; fs->nlocalvar--) - luaI_unregisterlocalvar(fs, ls->linenumber); + luaI_unregisterlocalvar(fs, fs->lastsetline); } static int funcname (LexState *ls, vardesc *v) { /* funcname -> NAME [':' NAME | '.' NAME] */ int needself = 0; - singlevar(ls, checkname(ls), v, 0); + singlevar(ls, str_checkname(ls), v, 0); if (ls->token == ':' || ls->token == '.') { needself = (ls->token == ':'); next(ls); lua_pushvar(ls, v); - code_string(ls, checkname(ls)); + code_constant(ls, checkname(ls)); v->k = VINDEXED; } return needself; @@ -808,7 +853,7 @@ static int funcname (LexState *ls, vardesc *v) { static void body (LexState *ls, int needself, int line) { /* body -> '(' parlist ')' chunk END */ FuncState newfs; - init_state(ls, &newfs, ls->fs->f->fileName); + init_state(ls, &newfs, ls->fs->f->source); newfs.f->lineDefined = line; check(ls, '('); if (needself) @@ -821,36 +866,40 @@ static void body (LexState *ls, int needself, int line) { func_onstack(ls, &newfs); } -static void ifpart (LexState *ls) { + +static void ifpart (LexState *ls, int line) { /* ifpart -> cond THEN block [ELSE block | ELSEIF ifpart] */ - int c = cond(ls); + int c; int e; + next(ls); /* skip IF or ELSEIF */ + c = cond(ls); check(ls, THEN); block(ls); e = SaveWord(ls); - switch (ls->token) { - case ELSE: - next(ls); + if (ls->token == ELSEIF) + ifpart(ls, line); + else { + if (optional(ls, ELSE)) block(ls); - break; - - case ELSEIF: - next(ls); - ifpart(ls); - break; + check_match(ls, END, IF, line); } codeIf(ls, c, e); } + static void ret (LexState *ls) { /* ret -> [RETURN explist sc] */ - if (ls->token == RETURN) { + if (optional(ls, RETURN)) { listdesc e; check_debugline(ls); - next(ls); - explist(ls, &e); - close_exp(ls, e.pc, MULT_RET); - code_oparg(ls, RETCODE, 0, ls->fs->nlocalvar, 0); + explist(ls, &e); + if (e.pc > 0) { /* expression is an open function call? */ + Byte *code = ls->fs->f->code; + code[e.pc-2] = TAILCALL; /* instead of a conventional CALL */ + code[e.pc-1] = (Byte)ls->fs->nlocalvar; + } + else + code_oparg(ls, RETCODE, ls->fs->nlocalvar, 0); ls->fs->stacksize = ls->fs->nlocalvar; /* removes all temp values */ optional(ls, ';'); } @@ -863,6 +912,9 @@ static void ret (LexState *ls) { ** (EQ=2, NE=3, ... '^'=13). The unary NOT is 0 and UNMINUS is 1. */ +#define INDNOT 0 +#define INDMINUS 1 + /* code of first binary operator */ #define FIRSTBIN 2 @@ -879,9 +931,9 @@ static int priority [POW+1] = {5, 5, 1, 1, 1, 1, 1, 1, 2, 3, 3, 4, 4, 6}; static OpCode opcodes [POW+1] = {NOTOP, MINUSOP, EQOP, NEQOP, GTOP, LTOP, LEOP, GEOP, CONCOP, ADDOP, SUBOP, MULTOP, DIVOP, POWOP}; -#define MAXOPS 20 +#define MAXOPS 20 /* op's stack size (arbitrary limit) */ -typedef struct { +typedef struct stack_op { int ops[MAXOPS]; int top; } stack_op; @@ -892,39 +944,33 @@ static void exp1 (LexState *ls) { exp0(ls, &v); lua_pushvar(ls, &v); if (is_in(ls->token, expfollow) < 0) - luaX_error(ls, "ill formed expression"); + luaX_error(ls, "ill-formed expression"); } static void exp0 (LexState *ls, vardesc *v) { + /* exp0 -> exp2 {(AND | OR) exp2} */ exp2(ls, v); while (ls->token == AND || ls->token == OR) { - int is_and = (ls->token == AND); + int op = (ls->token == AND) ? ONFJMP : ONTJMP; int pc; lua_pushvar(ls, v); next(ls); pc = SaveWordPop(ls); exp2(ls, v); lua_pushvar(ls, v); - fix_jump(ls, pc, (is_and?ONFJMP:ONTJMP), ls->fs->pc); + fix_jump(ls, pc, op, ls->fs->pc); } } static void push (LexState *ls, stack_op *s, int op) { - if (s->top == MAXOPS) + if (s->top >= MAXOPS) luaX_error(ls, "expression too complex"); s->ops[s->top++] = op; } -static void prefix (LexState *ls, stack_op *s) { - while (ls->token == NOT || ls->token == '-') { - push(ls, s, ls->token==NOT?0:1); - next(ls); - } -} - static void pop_to (LexState *ls, stack_op *s, int prio) { int op; while (s->top > 0 && priority[(op=s->ops[s->top-1])] >= prio) { @@ -933,92 +979,104 @@ static void pop_to (LexState *ls, stack_op *s, int prio) { } } -static void exp2 (LexState *ls, vardesc *v) { - stack_op s; - int op; - s.top = 0; - prefix(ls, &s); - simpleexp(ls, v); - while ((op = is_in(ls->token, binop)) >= 0) { - op += FIRSTBIN; - lua_pushvar(ls, v); - /* '^' is right associative, so must 'simulate' a higher priority */ - pop_to(ls, &s, (op == POW)?priority[op]+1:priority[op]); - push(ls, &s, op); - next(ls); - prefix(ls, &s); - simpleexp(ls, v); - lua_pushvar(ls, v); - } - if (s.top > 0) { - lua_pushvar(ls, v); - pop_to(ls, &s, 0); - } -} - - -static void simpleexp (LexState *ls, vardesc *v) { +static void simpleexp (LexState *ls, vardesc *v, stack_op *s) { check_debugline(ls); switch (ls->token) { - case '(': /* simpleexp -> '(' exp0 ')' */ - next(ls); - exp0(ls, v); - check(ls, ')'); - break; - - case NUMBER: /* simpleexp -> NUMBER */ - code_number(ls, ls->seminfo.r); + case NUMBER: { /* simpleexp -> NUMBER */ + real r = ls->seminfo.r; next(ls); - v->k = VEXP; v->info = 0; + /* dirty trick: check whether it is a -NUMBER not followed by '^' */ + /* (because the priority of '^' is closer than '-'...) */ + if (s->top > 0 && s->ops[s->top-1] == INDMINUS && ls->token != '^') { + s->top--; /* remove '-' from stack */ + r = -r; + } + code_number(ls, r); break; + } case STRING: /* simpleexp -> STRING */ - code_string(ls, ls->seminfo.ts); + code_string(ls, ls->seminfo.ts); /* must use 'seminfo' before "next" */ next(ls); - v->k = VEXP; v->info = 0; break; case NIL: /* simpleexp -> NIL */ adjuststack(ls, -1); next(ls); - v->k = VEXP; v->info = 0; break; case '{': /* simpleexp -> constructor */ constructor(ls); - v->k = VEXP; v->info = 0; break; - case FUNCTION: { /* simpleexp -> FUNCTION body */ - int line = ls->linenumber; + case FUNCTION: /* simpleexp -> FUNCTION body */ next(ls); - body(ls, 0, line); - v->k = VEXP; v->info = 0; + body(ls, 0, ls->linenumber); break; - } + + case '(': /* simpleexp -> '(' exp0 ')' */ + next(ls); + exp0(ls, v); + check(ls, ')'); + return; case NAME: case '%': var_or_func(ls, v); - break; + return; default: luaX_error(ls, " expected"); - break; + return; + } + v->k = VEXP; v->info = 0; +} + + +static void prefixexp (LexState *ls, vardesc *v, stack_op *s) { + /* prefixexp -> {NOT | '-'} simpleexp */ + while (ls->token == NOT || ls->token == '-') { + push(ls, s, (ls->token==NOT)?INDNOT:INDMINUS); + next(ls); + } + simpleexp(ls, v, s); +} + + +static void exp2 (LexState *ls, vardesc *v) { + stack_op s; + int op; + s.top = 0; + prefixexp(ls, v, &s); + while ((op = is_in(ls->token, binop)) >= 0) { + op += FIRSTBIN; + lua_pushvar(ls, v); + /* '^' is right associative, so must 'simulate' a higher priority */ + pop_to(ls, &s, (op == POW)?priority[op]+1:priority[op]); + push(ls, &s, op); + next(ls); + prefixexp(ls, v, &s); + lua_pushvar(ls, v); + } + if (s.top > 0) { + lua_pushvar(ls, v); + pop_to(ls, &s, 0); } } + static void var_or_func (LexState *ls, vardesc *v) { /* var_or_func -> ['%'] NAME var_or_func_tail */ if (optional(ls, '%')) { /* upvalue? */ - pushupvalue(ls, checkname(ls)); + pushupvalue(ls, str_checkname(ls)); v->k = VEXP; v->info = 0; /* closed expression */ } else /* variable name */ - singlevar(ls, checkname(ls), v, 0); + singlevar(ls, str_checkname(ls), v, 0); var_or_func_tail(ls, v); } + static void var_or_func_tail (LexState *ls, vardesc *v) { for (;;) { switch (ls->token) { @@ -1026,7 +1084,7 @@ static void var_or_func_tail (LexState *ls, vardesc *v) { next(ls); lua_pushvar(ls, v); /* 'v' must be on stack */ v->k = VDOT; - v->info = string_constant(ls->fs, checkname(ls)); + v->info = checkname(ls); break; case '[': /* var_or_func_tail -> '[' exp1 ']' */ @@ -1040,7 +1098,7 @@ static void var_or_func_tail (LexState *ls, vardesc *v) { case ':': /* var_or_func_tail -> ':' NAME funcparams */ next(ls); lua_pushvar(ls, v); /* 'v' must be on stack */ - code_oparg(ls, PUSHSELF, 8, string_constant(ls->fs, checkname(ls)), 1); + code_oparg(ls, PUSHSELF, checkname(ls), 1); v->k = VEXP; v->info = funcparams(ls, 1); break; @@ -1058,13 +1116,14 @@ static void var_or_func_tail (LexState *ls, vardesc *v) { static int funcparams (LexState *ls, int slf) { FuncState *fs = ls->fs; - int nparams = 1; /* default value */ + int nparams = 1; /* in cases STRING and constructor */ switch (ls->token) { case '(': { /* funcparams -> '(' explist ')' */ + int line = ls->linenumber; listdesc e; next(ls); explist(ls, &e); - check(ls, ')'); + check_match(ls, ')', '(', line); close_exp(ls, e.pc, 1); nparams = e.n; break; @@ -1075,7 +1134,7 @@ static int funcparams (LexState *ls, int slf) { break; case STRING: /* funcparams -> STRING */ - code_string(ls, ls->seminfo.ts); + code_string(ls, ls->seminfo.ts); /* must use 'seminfo' before "next" */ next(ls); break; @@ -1083,9 +1142,9 @@ static int funcparams (LexState *ls, int slf) { luaX_error(ls, "function arguments expected"); break; } - code_byte(fs, 0); /* save space for opcode */ - code_byte(fs, 0); /* and nresult */ - code_byte(fs, nparams+slf); + code_byte(fs, CALL); + code_byte(fs, 0); /* save space for nresult */ + code_byte(fs, (Byte)(nparams+slf)); return fs->pc-1; } @@ -1131,7 +1190,7 @@ static void parlist (LexState *ls) { case NAME: /* parlist, tailparlist -> NAME [',' tailparlist] */ init: - store_localvar(ls, checkname(ls), nparams++); + store_localvar(ls, str_checkname(ls), nparams++); if (ls->token == ',') { next(ls); switch (ls->token) { @@ -1158,10 +1217,10 @@ static void parlist (LexState *ls) { static int localnamelist (LexState *ls) { /* localnamelist -> NAME {',' NAME} */ int i = 1; - store_localvar(ls, checkname(ls), 0); + store_localvar(ls, str_checkname(ls), 0); while (ls->token == ',') { next(ls); - store_localvar(ls, checkname(ls), i++); + store_localvar(ls, str_checkname(ls), i++); } return i; } @@ -1178,13 +1237,11 @@ static void decinit (LexState *ls, listdesc *d) { } } + static int assignment (LexState *ls, vardesc *v, int nvars) { int left = 0; - /* dotted variables must be stored like regular indexed vars */ - if (v->k == VDOT) { - code_constant(ls, v->info); - v->k = VINDEXED; - } + checklimit(ls, nvars, MAXVARSLH, "variables in a multiple assignment"); + unloaddot(ls, v); if (ls->token == ',') { /* assignment -> ',' NAME assignment */ vardesc nv; next(ls); @@ -1204,12 +1261,13 @@ static int assignment (LexState *ls, vardesc *v, int nvars) { storevar(ls, v); } else { /* indexed var with values in between*/ - code_oparg(ls, SETTABLE, 0, left+(nvars-1), -1); - left += 2; /* table/index are not popped, because they aren't on top */ + code_oparg(ls, SETTABLE, left+(nvars-1), -1); + left += 2; /* table&index are not popped, because they aren't on top */ } return left; } + static void constructor (LexState *ls) { /* constructor -> '{' part [';' part] '}' */ int line = ls->linenumber; @@ -1229,7 +1287,7 @@ static void constructor (LexState *ls) { nelems += other_cd.n; } check_match(ls, '}', '{', line); - fix_opcode(ls, pc, CREATEARRAY, 2, nelems); + fix_opcode(ls, pc, CREATEARRAY, nelems); } static void part (LexState *ls, constdesc *cd) { @@ -1251,7 +1309,7 @@ static void part (LexState *ls, constdesc *cd) { code_string(ls, ls->fs->localvar[v.info]); break; default: - luaX_error(ls, "`=' unexpected"); + error_unexpected(ls); } next(ls); exp1(ls); @@ -1316,7 +1374,7 @@ static void recfield (LexState *ls) { /* recfield -> (NAME | '['exp1']') = exp1 */ switch (ls->token) { case NAME: - code_string(ls, checkname(ls)); + code_constant(ls, checkname(ls)); break; case '[': diff --git a/src/lparser.h b/src/lparser.h index b37fd81..9825ec5 100644 --- a/src/lparser.h +++ b/src/lparser.h @@ -1,6 +1,6 @@ /* -** $Id: lparser.h,v 1.2 1997/12/22 20:57:18 roberto Exp $ -** Syntax analizer and code generator +** $Id: lparser.h,v 1.3 1999/02/25 19:13:56 roberto Exp $ +** LL(1) Parser and code generator for Lua ** See Copyright Notice in lua.h */ diff --git a/src/lstate.c b/src/lstate.c index 43015b9..3b98d72 100644 --- a/src/lstate.c +++ b/src/lstate.c @@ -1,5 +1,5 @@ /* -** $Id: lstate.c,v 1.6 1998/06/02 20:37:04 roberto Exp $ +** $Id: lstate.c,v 1.12 1999/05/11 20:08:20 roberto Exp $ ** Global State ** See Copyright Notice in lua.h */ @@ -24,11 +24,19 @@ void lua_open (void) { if (lua_state) return; lua_state = luaM_new(lua_State); - L->numCblocks = 0; L->Cstack.base = 0; L->Cstack.lua2C = 0; L->Cstack.num = 0; L->errorJmp = NULL; + L->Mbuffer = NULL; + L->Mbuffbase = 0; + L->Mbuffsize = 0; + L->Mbuffnext = 0; + L->Cblocks = NULL; + L->numCblocks = 0; + L->debug = 0; + L->callhook = NULL; + L->linehook = NULL; L->rootproto.next = NULL; L->rootproto.marked = 0; L->rootcl.next = NULL; @@ -37,12 +45,9 @@ void lua_open (void) L->rootglobal.marked = 0; L->roottable.next = NULL; L->roottable.marked = 0; + L->IMtable = NULL; L->refArray = NULL; L->refSize = 0; - L->Mbuffsize = 0; - L->Mbuffnext = 0; - L->Mbuffbase = NULL; - L->Mbuffer = NULL; L->GCthreshold = GARBAGE_BLOCK; L->nblocks = 0; luaD_init(); @@ -69,6 +74,7 @@ void lua_close (void) luaM_free(L->IMtable); luaM_free(L->refArray); luaM_free(L->Mbuffer); + luaM_free(L->Cblocks); luaM_free(L); L = NULL; #ifdef DEBUG @@ -78,9 +84,3 @@ void lua_close (void) } -lua_State *lua_setstate (lua_State *st) { - lua_State *old = lua_state; - lua_state = st; - return old; -} - diff --git a/src/lstate.h b/src/lstate.h index 71d956f..168257d 100644 --- a/src/lstate.h +++ b/src/lstate.h @@ -1,5 +1,5 @@ /* -** $Id: lstate.h,v 1.11 1998/06/24 13:33:00 roberto Exp $ +** $Id: lstate.h,v 1.19 1999/05/11 20:08:20 roberto Exp $ ** Global State ** See Copyright Notice in lua.h */ @@ -11,15 +11,24 @@ #include "lobject.h" #include "lua.h" +#include "luadebug.h" -#define MAX_C_BLOCKS 10 - #define GARBAGE_BLOCK 150 typedef int StkId; /* index to stack elements */ + +/* +** "jmp_buf" may be an array, so it is better to make sure it has an +** address (and not that it *is* an address...) +*/ +struct lua_longjmp { + jmp_buf b; +}; + + struct Stack { TObject *top; TObject *stack; @@ -34,7 +43,7 @@ struct C_Lua_Stack { }; -typedef struct { +typedef struct stringtable { int size; int nuse; /* number of elements (including EMPTYs) */ TaggedString **hash; @@ -53,22 +62,23 @@ struct lua_State { /* thread-specific state */ struct Stack stack; /* Lua stack */ struct C_Lua_Stack Cstack; /* C2lua struct */ - jmp_buf *errorJmp; /* current error recover point */ + struct lua_longjmp *errorJmp; /* current error recover point */ char *Mbuffer; /* global buffer */ - char *Mbuffbase; /* current first position of Mbuffer */ + int Mbuffbase; /* current first position of Mbuffer */ int Mbuffsize; /* size of Mbuffer */ int Mbuffnext; /* next position to fill in Mbuffer */ - struct C_Lua_Stack Cblocks[MAX_C_BLOCKS]; + struct C_Lua_Stack *Cblocks; int numCblocks; /* number of nested Cblocks */ + int debug; + lua_CHFunction callhook; + lua_LHFunction linehook; /* global state */ - TObject errorim; /* error tag method */ GCnode rootproto; /* list of all prototypes */ GCnode rootcl; /* list of all closures */ GCnode roottable; /* list of all tables */ GCnode rootglobal; /* list of strings with global values */ stringtable *string_root; /* array of hash tables for strings and udata */ struct IM *IMtable; /* table for tag methods */ - int IMtable_size; /* size of IMtable */ int last_tag; /* last used tag in IMtable */ struct ref *refArray; /* locked objects */ int refSize; /* size of refArray */ @@ -77,10 +87,8 @@ struct lua_State { }; -extern lua_State *lua_state; - - #define L lua_state #endif + diff --git a/src/lstring.c b/src/lstring.c index fd7cc58..fa974ae 100644 --- a/src/lstring.c +++ b/src/lstring.c @@ -1,5 +1,5 @@ /* -** $Id: lstring.c,v 1.13 1998/06/19 16:14:09 roberto Exp $ +** $Id: lstring.c,v 1.19 1999/02/26 15:49:53 roberto Exp $ ** String table (keeps all strings handled by Lua) ** See Copyright Notice in lua.h */ @@ -14,7 +14,9 @@ #include "lua.h" -#define NUM_HASHS 61 +#define NUM_HASHSTR 31 +#define NUM_HASHUDATA 31 +#define NUM_HASHS (NUM_HASHSTR+NUM_HASHUDATA) #define gcsizestring(l) (1+(l/64)) /* "weight" for a string with length 'l' */ @@ -25,8 +27,7 @@ static TaggedString EMPTY = {{NULL, 2}, 0L, 0, {{{LUA_T_NIL, {NULL}}, 0L}}, {0}}; -void luaS_init (void) -{ +void luaS_init (void) { int i; L->string_root = luaM_newvector(NUM_HASHS, stringtable); for (i=0; i>2)+(unsigned char)*(s++)); return h; } -static int newsize (stringtable *tb) -{ +static int newsize (stringtable *tb) { int size = tb->size; int realuse = 0; int i; @@ -54,16 +53,11 @@ static int newsize (stringtable *tb) for (i=0; ihash[i] != NULL && tb->hash[i] != &EMPTY) realuse++; - if (2*(realuse+1) <= size) /* +1 is the new element */ - return size; /* don't need to grow, just rehash to clear EMPTYs */ - else - return luaO_redimension(size); + return luaO_redimension((realuse+1)*2); /* +1 is the new element */ } -static void grow (stringtable *tb) -{ - +static void grow (stringtable *tb) { int ns = newsize(tb); TaggedString **newhash = luaM_newvector(ns, TaggedString *); int i; @@ -73,10 +67,13 @@ static void grow (stringtable *tb) tb->nuse = 0; for (i=0; isize; i++) { if (tb->hash[i] != NULL && tb->hash[i] != &EMPTY) { - int h = tb->hash[i]->hash%ns; - while (newhash[h]) - h = (h+1)%ns; - newhash[h] = tb->hash[i]; + unsigned long h = tb->hash[i]->hash; + int h1 = h%ns; + while (newhash[h1]) { + h1 += (h&(ns-2)) + 1; /* double hashing */ + if (h1 >= ns) h1 -= ns; + } + newhash[h1] = tb->hash[i]; tb->nuse++; } } @@ -86,8 +83,7 @@ static void grow (stringtable *tb) } -static TaggedString *newone_s (char *str, long l, unsigned long h) -{ +static TaggedString *newone_s (char *str, long l, unsigned long h) { TaggedString *ts = (TaggedString *)luaM_malloc(sizeof(TaggedString)+l); memcpy(ts->str, str, l); ts->str[l] = 0; /* ending 0 */ @@ -101,8 +97,7 @@ static TaggedString *newone_s (char *str, long l, unsigned long h) return ts; } -static TaggedString *newone_u (char *buff, int tag, unsigned long h) -{ +static TaggedString *newone_u (char *buff, int tag, unsigned long h) { TaggedString *ts = luaM_new(TaggedString); ts->u.d.v = buff; ts->u.d.tag = (tag == LUA_ANYTAG) ? 0 : tag; @@ -114,82 +109,79 @@ static TaggedString *newone_u (char *buff, int tag, unsigned long h) return ts; } -static TaggedString *insert_s (char *str, long l, stringtable *tb) -{ +static TaggedString *insert_s (char *str, long l, stringtable *tb) { TaggedString *ts; unsigned long h = hash_s(str, l); int size = tb->size; - int i; int j = -1; + int h1; if ((long)tb->nuse*3 >= (long)size*2) { grow(tb); size = tb->size; } - for (i = h%size; (ts = tb->hash[i]) != NULL; ) { + h1 = h%size; + while ((ts = tb->hash[h1]) != NULL) { if (ts == &EMPTY) - j = i; - else if (ts->constindex >= 0 && - ts->u.s.len == l && - (memcmp(str, ts->str, l) == 0)) + j = h1; + else if (ts->u.s.len == l && (memcmp(str, ts->str, l) == 0)) return ts; - if (++i == size) i=0; + h1 += (h&(size-2)) + 1; /* double hashing */ + if (h1 >= size) h1 -= size; } /* not found */ if (j != -1) /* is there an EMPTY space? */ - i = j; + h1 = j; else tb->nuse++; - ts = tb->hash[i] = newone_s(str, l, h); + ts = tb->hash[h1] = newone_s(str, l, h); return ts; } -static TaggedString *insert_u (void *buff, int tag, stringtable *tb) -{ + +static TaggedString *insert_u (void *buff, int tag, stringtable *tb) { TaggedString *ts; unsigned long h = (unsigned long)buff; int size = tb->size; - int i; int j = -1; + int h1; if ((long)tb->nuse*3 >= (long)size*2) { grow(tb); size = tb->size; } - for (i = h%size; (ts = tb->hash[i]) != NULL; ) { + h1 = h%size; + while ((ts = tb->hash[h1]) != NULL) { if (ts == &EMPTY) - j = i; - else if (ts->constindex < 0 && /* is a udata? */ - (tag == ts->u.d.tag || tag == LUA_ANYTAG) && - buff == ts->u.d.v) + j = h1; + else if ((tag == ts->u.d.tag || tag == LUA_ANYTAG) && buff == ts->u.d.v) return ts; - if (++i == size) i=0; + h1 += (h&(size-2)) + 1; /* double hashing */ + if (h1 >= size) h1 -= size; } /* not found */ if (j != -1) /* is there an EMPTY space? */ - i = j; + h1 = j; else tb->nuse++; - ts = tb->hash[i] = newone_u(buff, tag, h); + ts = tb->hash[h1] = newone_u(buff, tag, h); return ts; } -TaggedString *luaS_createudata (void *udata, int tag) -{ - return insert_u(udata, tag, &L->string_root[(unsigned)udata%NUM_HASHS]); + +TaggedString *luaS_createudata (void *udata, int tag) { + int t = ((unsigned)udata%NUM_HASHUDATA)+NUM_HASHSTR; + return insert_u(udata, tag, &L->string_root[t]); } -TaggedString *luaS_newlstr (char *str, long l) -{ - int i = (l==0)?0:(unsigned char)str[0]; - return insert_s(str, l, &L->string_root[i%NUM_HASHS]); +TaggedString *luaS_newlstr (char *str, long l) { + int t = (l==0) ? 0 : ((int)((unsigned char)str[0]*l))%NUM_HASHSTR; + return insert_s(str, l, &L->string_root[t]); } -TaggedString *luaS_new (char *str) -{ +TaggedString *luaS_new (char *str) { return luaS_newlstr(str, strlen(str)); } -TaggedString *luaS_newfixedstring (char *str) -{ +TaggedString *luaS_newfixedstring (char *str) { TaggedString *ts = luaS_new(str); if (ts->head.marked == 0) ts->head.marked = 2; /* avoid GC */ @@ -197,8 +189,7 @@ TaggedString *luaS_newfixedstring (char *str) } -void luaS_free (TaggedString *l) -{ +void luaS_free (TaggedString *l) { while (l) { TaggedString *next = (TaggedString *)l->head.next; L->nblocks -= (l->constindex == -1) ? 1 : gcsizestring(l->u.s.len); @@ -212,8 +203,7 @@ void luaS_free (TaggedString *l) ** Garbage collection functions. */ -static void remove_from_list (GCnode *l) -{ +static void remove_from_list (GCnode *l) { while (l) { GCnode *next = l->next; while (next && !next->marked) @@ -223,8 +213,7 @@ static void remove_from_list (GCnode *l) } -TaggedString *luaS_collector (void) -{ +TaggedString *luaS_collector (void) { TaggedString *frees = NULL; int i; remove_from_list(&(L->rootglobal)); @@ -247,18 +236,18 @@ TaggedString *luaS_collector (void) } -TaggedString *luaS_collectudata (void) -{ +TaggedString *luaS_collectudata (void) { TaggedString *frees = NULL; int i; L->rootglobal.next = NULL; /* empty list of globals */ - for (i=0; istring_root[i]; int j; for (j=0; jsize; j++) { TaggedString *t = tb->hash[j]; - if (t == NULL || t == &EMPTY || t->constindex != -1) - continue; /* get only user data */ + if (t == NULL || t == &EMPTY) + continue; + LUA_ASSERT(t->constindex == -1, "must be userdata"); t->head.next = (GCnode *)frees; frees = t; tb->hash[j] = &EMPTY; @@ -268,8 +257,7 @@ TaggedString *luaS_collectudata (void) } -void luaS_freeall (void) -{ +void luaS_freeall (void) { int i; for (i=0; istring_root[i]; @@ -285,8 +273,7 @@ void luaS_freeall (void) } -void luaS_rawsetglobal (TaggedString *ts, TObject *newval) -{ +void luaS_rawsetglobal (TaggedString *ts, TObject *newval) { ts->u.s.globalval = *newval; if (ts->head.next == (GCnode *)ts) { /* is not in list? */ ts->head.next = L->rootglobal.next; @@ -295,8 +282,7 @@ void luaS_rawsetglobal (TaggedString *ts, TObject *newval) } -char *luaS_travsymbol (int (*fn)(TObject *)) -{ +char *luaS_travsymbol (int (*fn)(TObject *)) { TaggedString *g; for (g=(TaggedString *)L->rootglobal.next; g; g=(TaggedString *)g->head.next) if (fn(&g->u.s.globalval)) @@ -305,8 +291,7 @@ char *luaS_travsymbol (int (*fn)(TObject *)) } -int luaS_globaldefined (char *name) -{ +int luaS_globaldefined (char *name) { TaggedString *ts = luaS_new(name); return ts->u.s.globalval.ttype != LUA_T_NIL; } diff --git a/src/ltable.c b/src/ltable.c index 28cd2ed..d768ba0 100644 --- a/src/ltable.c +++ b/src/ltable.c @@ -1,5 +1,5 @@ /* -** $Id: ltable.c,v 1.12 1998/01/28 16:50:33 roberto Exp $ +** $Id: ltable.c,v 1.22 1999/05/21 19:41:49 roberto Exp $ ** Lua tables (hash) ** See Copyright Notice in lua.h */ @@ -20,14 +20,11 @@ #define nodevector(t) ((t)->node) -#define REHASH_LIMIT 0.70 /* avoid more than this % full */ - #define TagDefault LUA_T_ARRAY; -static long int hashindex (TObject *ref) -{ +static long int hashindex (TObject *ref) { long int h; switch (ttype(ref)) { case LUA_T_NUMBER: @@ -56,61 +53,45 @@ static long int hashindex (TObject *ref) } -static int present (Hash *t, TObject *key) -{ +Node *luaH_present (Hash *t, TObject *key) { int tsize = nhash(t); long int h = hashindex(key); int h1 = h%tsize; - TObject *rf = ref(node(t, h1)); - if (ttype(rf) != LUA_T_NIL && !luaO_equalObj(key, rf)) { - int h2 = h%(tsize-2) + 1; - do { - h1 += h2; - if (h1 >= tsize) h1 -= tsize; - rf = ref(node(t, h1)); - } while (ttype(rf) != LUA_T_NIL && !luaO_equalObj(key, rf)); + Node *n = node(t, h1); + /* keep looking until an entry with "ref" equal to key or nil */ + while ((ttype(ref(n)) == ttype(key)) ? !luaO_equalval(key, ref(n)) + : ttype(ref(n)) != LUA_T_NIL) { + h1 += (h&(tsize-2)) + 1; /* double hashing */ + if (h1 >= tsize) h1 -= tsize; + n = node(t, h1); } - return h1; + return n; } -/* -** Alloc a vector node -*/ -static Node *hashnodecreate (int nhash) -{ - Node *v = luaM_newvector(nhash, Node); - int i; - for (i=0; ihead.next; L->nblocks -= gcsize(frees->nhash); - hashdelete(frees); + luaM_free(nodevector(frees)); + luaM_free(frees); frees = next; } } -Hash *luaH_new (int nhash) -{ +static Node *hashnodecreate (int nhash) { + Node *v = luaM_newvector(nhash, Node); + int i; + for (i=0; inode; int size = nhash(t); int realuse = 0; int i; for (i=0; inblocks += gcsize(nnew)-gcsize(nold); luaM_free(vold); } -/* -** If the hash node is present, return its pointer, otherwise return -** null. -*/ -TObject *luaH_get (Hash *t, TObject *ref) -{ - int h = present(t, ref); - if (ttype(ref(node(t, h))) != LUA_T_NIL) return val(node(t, h)); - else return NULL; -} - -/* -** If the hash node is present, return its pointer, otherwise create a luaM_new -** node for the given reference and also return its pointer. -*/ -TObject *luaH_set (Hash *t, TObject *ref) -{ - Node *n = node(t, present(t, ref)); - if (ttype(ref(n)) == LUA_T_NIL) { - nuse(t)++; - if ((float)nuse(t) > (float)nhash(t)*REHASH_LIMIT) { +void luaH_set (Hash *t, TObject *ref, TObject *val) { + Node *n = luaH_present(t, ref); + if (ttype(ref(n)) != LUA_T_NIL) + *val(n) = *val; + else { + TObject buff; + buff = *val; /* rehash may invalidate this address */ + if ((long)nuse(t)*3L > (long)nhash(t)*2L) { rehash(t); - n = node(t, present(t, ref)); + n = luaH_present(t, ref); } + nuse(t)++; *ref(n) = *ref; - ttype(val(n)) = LUA_T_NIL; + *val(n) = buff; } - return (val(n)); } -static Node *hashnext (Hash *t, int i) -{ - Node *n; - int tsize = nhash(t); - if (i >= tsize) - return NULL; - n = node(t, i); - while (ttype(ref(n)) == LUA_T_NIL || ttype(val(n)) == LUA_T_NIL) { - if (++i >= tsize) - return NULL; - n = node(t, i); - } - return node(t, i); +int luaH_pos (Hash *t, TObject *r) { + Node *n = luaH_present(t, r); + luaL_arg_check(ttype(val(n)) != LUA_T_NIL, 2, "key not found"); + return n-(t->node); } -Node *luaH_next (TObject *o, TObject *r) -{ - Hash *t = avalue(o); - if (ttype(r) == LUA_T_NIL) - return hashnext(t, 0); - else { - int i = present(t, r); - Node *n = node(t, i); - luaL_arg_check(ttype(ref(n))!=LUA_T_NIL && ttype(val(n))!=LUA_T_NIL, - 2, "key not found"); - return hashnext(t, i+1); - } + +void luaH_setint (Hash *t, int ref, TObject *val) { + TObject index; + ttype(&index) = LUA_T_NUMBER; + nvalue(&index) = ref; + luaH_set(t, &index, val); } + + +TObject *luaH_getint (Hash *t, int ref) { + TObject index; + ttype(&index) = LUA_T_NUMBER; + nvalue(&index) = ref; + return luaH_get(t, &index); +} + diff --git a/src/ltable.h b/src/ltable.h index 92b0316..49b485f 100644 --- a/src/ltable.h +++ b/src/ltable.h @@ -1,5 +1,5 @@ /* -** $Id: ltable.h,v 1.5 1997/11/26 18:53:45 roberto Exp $ +** $Id: ltable.h,v 1.11 1999/02/23 14:57:28 roberto Exp $ ** Lua tables (hash) ** See Copyright Notice in lua.h */ @@ -15,10 +15,16 @@ #define val(n) (&(n)->val) #define nhash(t) ((t)->nhash) +#define luaH_get(t,ref) (val(luaH_present((t), (ref)))) +#define luaH_move(t,from,to) (luaH_setint(t, to, luaH_getint(t, from))) + Hash *luaH_new (int nhash); void luaH_free (Hash *frees); -TObject *luaH_get (Hash *t, TObject *ref); -TObject *luaH_set (Hash *t, TObject *ref); -Node *luaH_next (TObject *o, TObject *r); +Node *luaH_present (Hash *t, TObject *key); +void luaH_set (Hash *t, TObject *ref, TObject *val); +int luaH_pos (Hash *t, TObject *r); +void luaH_setint (Hash *t, int ref, TObject *val); +TObject *luaH_getint (Hash *t, int ref); + #endif diff --git a/src/ltm.c b/src/ltm.c index 0bbee22..709d5e5 100644 --- a/src/ltm.c +++ b/src/ltm.c @@ -1,5 +1,5 @@ /* -** $Id: ltm.c,v 1.16 1998/06/18 16:57:03 roberto Exp $ +** $Id: ltm.c,v 1.25 1999/05/21 19:41:49 roberto Exp $ ** Tag methods ** See Copyright Notice in lua.h */ @@ -22,8 +22,7 @@ char *luaT_eventname[] = { /* ORDER IM */ }; -static int luaI_checkevent (char *name, char *list[]) -{ +static int luaI_checkevent (char *name, char *list[]) { int e = luaL_findstring(name, list); if (e < 0) luaL_verror("`%.50s' is not a valid event name", name); @@ -35,7 +34,7 @@ static int luaI_checkevent (char *name, char *list[]) /* events in LUA_T_NIL are all allowed, since this is used as a * 'placeholder' for "default" fallbacks */ -static char validevents[NUM_TAGS][IM_N] = { /* ORDER LUA_T, ORDER IM */ +static char luaT_validevents[NUM_TAGS][IM_N] = { /* ORDER LUA_T, ORDER IM */ {1, 1, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1}, /* LUA_T_USERDATA */ {1, 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1}, /* LUA_T_NUMBER */ {1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1}, /* LUA_T_STRING */ @@ -45,71 +44,59 @@ static char validevents[NUM_TAGS][IM_N] = { /* ORDER LUA_T, ORDER IM */ {1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1} /* LUA_T_NIL */ }; - -static int validevent (int t, int e) -{ /* ORDER LUA_T */ - return (t < LUA_T_NIL) ? 1 : validevents[-t][e]; +static int luaT_validevent (int t, int e) { /* ORDER LUA_T */ + return (t < LUA_T_NIL) ? 1 : luaT_validevents[-t][e]; } -static void init_entry (int tag) -{ +static void init_entry (int tag) { int i; for (i=0; iIMtable_size = NUM_TAGS*2; L->last_tag = -(NUM_TAGS-1); - L->IMtable = luaM_newvector(L->IMtable_size, struct IM); + luaM_growvector(L->IMtable, 0, NUM_TAGS, struct IM, arrEM, MAX_INT); for (t=L->last_tag; t<=0; t++) init_entry(t); } -int lua_newtag (void) -{ +int lua_newtag (void) { --L->last_tag; - if ((-L->last_tag) >= L->IMtable_size) - L->IMtable_size = luaM_growvector(&L->IMtable, L->IMtable_size, - struct IM, memEM, MAX_INT); + luaM_growvector(L->IMtable, -(L->last_tag), 1, struct IM, arrEM, MAX_INT); init_entry(L->last_tag); return L->last_tag; } -static void checktag (int tag) -{ +static void checktag (int tag) { if (!(L->last_tag <= tag && tag <= 0)) luaL_verror("%d is not a valid tag", tag); } -void luaT_realtag (int tag) -{ +void luaT_realtag (int tag) { if (!(L->last_tag <= tag && tag < LUA_T_NIL)) - luaL_verror("tag %d is not result of `newtag'", tag); + luaL_verror("tag %d was not created by `newtag'", tag); } -int lua_copytagmethods (int tagto, int tagfrom) -{ +int lua_copytagmethods (int tagto, int tagfrom) { int e; checktag(tagto); checktag(tagfrom); for (e=0; eerrorim)) - return "error"; - for (e=IM_GETTABLE; e<=IM_FUNCTION; e++) { /* ORDER IM */ + for (e=IM_GETTABLE; e<=IM_FUNCTION; e++) { int t; for (t=0; t>=L->last_tag; t--) if (fn(luaT_getim(t,e))) @@ -177,6 +162,7 @@ char *luaT_travtagmethods (int (*fn)(TObject *)) #ifdef LUA_COMPAT2_5 #include "lapi.h" +#include "lstring.h" static void errorFB (void) { @@ -191,23 +177,20 @@ static void errorFB (void) static void nilFB (void) { } -static void typeFB (void) -{ +static void typeFB (void) { lua_error("unexpected type"); } -static void fillvalids (IMS e, TObject *func) -{ +static void fillvalids (IMS e, TObject *func) { int t; for (t=LUA_T_NIL; t<=LUA_T_USERDATA; t++) - if (validevent(t, e)) + if (luaT_validevent(t, e)) *luaT_getim(t, e) = *func; } -void luaT_setfallback (void) -{ +void luaT_setfallback (void) { static char *oldnames [] = {"error", "getglobal", "arith", "order", NULL}; TObject oldfunc; lua_CFunction replace; @@ -215,11 +198,13 @@ void luaT_setfallback (void) lua_Object func = lua_getparam(2); luaL_arg_check(lua_isfunction(func), 2, "function expected"); switch (luaL_findstring(name, oldnames)) { - case 0: /* old error fallback */ - oldfunc = L->errorim; - L->errorim = *luaA_Address(func); + case 0: { /* old error fallback */ + TObject *em = &(luaS_new("_ERRORMESSAGE")->u.s.globalval); + oldfunc = *em; + *em = *luaA_Address(func); replace = errorFB; break; + } case 1: /* old getglobal fallback */ oldfunc = *luaT_getim(LUA_T_NIL, IM_GETGLOBAL); *luaT_getim(LUA_T_NIL, IM_GETGLOBAL) = *luaA_Address(func); diff --git a/src/ltm.h b/src/ltm.h index b688d1e..845ea15 100644 --- a/src/ltm.h +++ b/src/ltm.h @@ -1,5 +1,5 @@ /* -** $Id: ltm.h,v 1.4 1997/11/26 18:53:45 roberto Exp $ +** $Id: ltm.h,v 1.5 1999/01/15 13:11:57 roberto Exp $ ** Tag methods ** See Copyright Notice in lua.h */ @@ -45,14 +45,14 @@ struct IM { #define luaT_getim(tag,event) (&L->IMtable[-(tag)].int_method[event]) -#define luaT_getimbyObj(o,e) (luaT_getim(luaT_efectivetag(o),(e))) +#define luaT_getimbyObj(o,e) (luaT_getim(luaT_effectivetag(o),(e))) extern char *luaT_eventname[]; void luaT_init (void); void luaT_realtag (int tag); -int luaT_efectivetag (TObject *o); +int luaT_effectivetag (TObject *o); void luaT_settagmethod (int t, char *event, TObject *func); TObject *luaT_gettagmethod (int t, char *event); char *luaT_travtagmethods (int (*fn)(TObject *)); diff --git a/src/lua/Makefile b/src/lua/Makefile index 1ec8370..cf5d31b 100644 --- a/src/lua/Makefile +++ b/src/lua/Makefile @@ -17,10 +17,10 @@ $T: $(OBJS) $(LIB)/liblua.a $(LIB)/liblualib.a $(CC) -o $@ $(OBJS) -L$(LIB) -llua -llualib -lm $(LIB)/liblua.a: - cd ..; make + cd ..; $(MAKE) $(LIB)/liblualib.a: - cd ../lib; make + cd ../lib; $(MAKE) clean: rm -f $(OBJS) $T diff --git a/src/lua/README b/src/lua/README index 3134042..db2eafb 100644 --- a/src/lua/README +++ b/src/lua/README @@ -1,5 +1,6 @@ This client is a sample lua interpreter. -It can be used as a batch interpreter and interactively. +It can be used as a batch interpreter and also interactively. + Here are the options it understands: -v print version information @@ -11,10 +12,27 @@ Here are the options it understands: a=b sets global `a' with string `b' (no need to quote b) name dofile `name' -If no options are given, then it reads and executes lines from stdin. -In this case, each line must contain a complete statement. +If no options are given, then it reads lines from stdin and executes them +as they are read. So, each line must contain a complete statement. To span a statement across several lines, end each line with a backslash '\'. + To change the prompt, set the global variable _PROMPT to whatever you want. +You can do after calling the interpreter or on the command line with + _PROMPT="lua: " +for example. + +You must be careful when using quotes on the command line because they are +usually handled by the shell. This interpreter is good for using Lua as a standalone language. For a minimal interpreter, see etc/min.c. + +If your application simply exports new functions to Lua (which is common), +then you can use this interpreter unmodified: just define a function + + void lua_userinit (void) + +in your code. In this function, you should do whatever initializations are +need, typically exporting your functions to Lua. +If you use this scheme, you must explicily open any standard libraries you need. +See ../lib/linit.c diff --git a/src/lua/lua.c b/src/lua/lua.c index a6a92f7..5acd617 100644 --- a/src/lua/lua.c +++ b/src/lua/lua.c @@ -1,5 +1,5 @@ /* -** $Id: lua.c,v 1.14 1998/02/11 20:56:05 roberto Exp $ +** $Id: lua.c,v 1.21 1999/07/02 18:22:38 roberto Exp $ ** Lua stand-alone interpreter ** See Copyright Notice in lua.h */ @@ -15,12 +15,6 @@ #include "lualib.h" -#ifndef OLD_ANSI -#include -#else -#define setlocale(a,b) 0 -#endif - #ifdef _POSIX_SOURCE #include #else @@ -32,27 +26,33 @@ typedef void (*handler)(int); /* type for signal actions */ static void laction (int i); -static handler lreset (void) -{ - lua_linehook = NULL; - lua_callhook = NULL; + +static lua_LHFunction old_linehook = NULL; +static lua_CHFunction old_callhook = NULL; + + +static handler lreset (void) { return signal(SIGINT, laction); } -static void lstop (void) -{ + +static void lstop (void) { + lua_setlinehook(old_linehook); + lua_setcallhook(old_callhook); lreset(); lua_error("interrupted!"); } -static void laction (int i) -{ - lua_linehook = (lua_LHFunction)lstop; - lua_callhook = (lua_CHFunction)lstop; + +static void laction (int i) { + signal(SIGINT, SIG_DFL); /* if another SIGINT happens before lstop, + terminate process (default action) */ + old_linehook = lua_setlinehook((lua_LHFunction)lstop); + old_callhook = lua_setcallhook((lua_CHFunction)lstop); } -static int ldo (int (*f)(char *), char *name) -{ + +static int ldo (int (*f)(char *), char *name) { int res; handler h = lreset(); res = f(name); /* dostring | dofile */ @@ -61,8 +61,7 @@ static int ldo (int (*f)(char *), char *name) } -static void print_message (void) -{ +static void print_message (void) { fprintf(stderr, "Lua: command line options:\n" " -v print version information\n" @@ -76,8 +75,7 @@ static void print_message (void) } -static void assign (char *arg) -{ +static void assign (char *arg) { if (strlen(arg) >= 500) fprintf(stderr, "lua: shell argument too long"); else { @@ -90,13 +88,11 @@ static void assign (char *arg) } } -#define BUF_SIZE 512 -static void manual_input (int prompt) -{ +static void manual_input (int prompt) { int cont = 1; while (cont) { - char buffer[BUF_SIZE]; + char buffer[BUFSIZ]; int i = 0; lua_beginblock(); if (prompt) @@ -112,13 +108,13 @@ static void manual_input (int prompt) buffer[i-1] = '\n'; else break; } - else if (i >= BUF_SIZE-1) { + else if (i >= BUFSIZ-1) { fprintf(stderr, "lua: argument line too long\n"); break; } - else buffer[i++] = c; + else buffer[i++] = (char)c; } - buffer[i] = 0; + buffer[i] = '\0'; ldo(lua_dostring, buffer); lua_endblock(); } @@ -129,11 +125,9 @@ static void manual_input (int prompt) int main (int argc, char *argv[]) { int i; - setlocale(LC_ALL, ""); - lua_iolibopen(); - lua_strlibopen(); - lua_mathlibopen(); + lua_open(); lua_pushstring("> "); lua_setglobal("_PROMPT"); + lua_userinit(); if (argc < 2) { /* no arguments? */ if (isatty(0)) { printf("%s %s\n", LUA_VERSION, LUA_COPYRIGHT); @@ -155,7 +149,7 @@ int main (int argc, char *argv[]) manual_input(0); break; case 'd': - lua_debug = 1; + lua_setdebug(1); break; case 'v': printf("%s %s\n(written by %s)\n\n", diff --git a/src/luac/Makefile b/src/luac/Makefile index 195b5cc..e2950e6 100644 --- a/src/luac/Makefile +++ b/src/luac/Makefile @@ -5,8 +5,8 @@ LUA= ../.. include $(LUA)/config INCS= -I$(INC) $(EXTRA_INCS) -I.. -OBJS= dump.o luac.o opcode.o opt.o print.o stubs.o -SRCS= dump.c luac.c opcode.c opt.c print.c stubs.c luac.h opcode.h +OBJS= dump.o luac.o opcode.o opt.o print.o stubs.o test.o +SRCS= dump.c luac.c opcode.c opt.c print.c stubs.c test.c luac.h opcode.h T= $(BIN)/luac @@ -16,7 +16,7 @@ $T: $(OBJS) $(LIB)/liblua.a $(CC) -o $@ $(OBJS) -L$(LIB) -llua $(LIB)/liblua.a: - cd ..; make + cd ..; $(MAKE) clean: rm -f $(OBJS) $T diff --git a/src/luac/README b/src/luac/README index 1fd49cc..9fba74b 100644 --- a/src/luac/README +++ b/src/luac/README @@ -2,24 +2,27 @@ luac translates Lua programs into binary files that can be loaded and executed with lua_dofile in C or with dofile in Lua. The main advantages of pre-compiling chunks are: faster loading, protecting source code from user changes, off-line syntax error detection. - luac can also be used to learn about the Lua virtual machine. -Here are the options it understands: +Here are the options that luac understands: - -c compile (default) - -u undump - -d generate debugging information - -D predefine symbol for conditional compilation - -l list (default for -u) - -o output file for -c (default is "luac.out") - -O optimize - -p parse only - -q quiet (default for -c) - -v show version information - -V verbose - - compile "stdin" + -c compile (default) + -d generate debugging information + -D name predefine 'name' for conditional compilation + -l list (default for -u) + -n save numbers in native format (file may not be portable) + -o file output file for -c (default is "luac.out") + -O optimize + -p parse only + -q quiet (default for -c) + -t test code integrity + -u undump + -U name undefine 'name' for conditional compilation + -v show version information + -V verbose + - compile "stdin" Finally, luac is an example of how to use the internals of Lua (politely). Also, luac does not need the runtime code and stubs.c makes sure it is not linked into luac. This file also shows how to avoid linking the parser. + diff --git a/src/luac/dump.c b/src/luac/dump.c dissimilarity index 61% index ce9551e..479ce5d 100644 --- a/src/luac/dump.c +++ b/src/luac/dump.c @@ -1,158 +1,154 @@ -/* -** $Id: dump.c,v 1.11 1998/07/12 00:17:37 lhf Exp $ -** save bytecodes to file -** See Copyright Notice in lua.h -*/ - -#include -#include -#include "luac.h" - -#define NotWord(x) ((unsigned short)x!=x) -#define DumpBlock(b,size,D) fwrite(b,size,1,D) -#define DumpNative(t,D) DumpBlock(&t,sizeof(t),D) - -static void DumpWord(int i, FILE* D) -{ - int hi= 0x0000FF & (i>>8); - int lo= 0x0000FF & i; - fputc(hi,D); - fputc(lo,D); -} - -static void DumpLong(long i, FILE* D) -{ - int hi= 0x00FFFF & (i>>16); - int lo= 0x00FFFF & i; - DumpWord(hi,D); - DumpWord(lo,D); -} - -#if ID_NUMBER==ID_REAL4 -/* LUA_NUMBER */ -/* assumes sizeof(long)==4 and sizeof(float)==4 (IEEE) */ -static void DumpFloat(float f, FILE* D) -{ - long l=*(long*)&f; - DumpLong(l,D); -} -#endif - -#if ID_NUMBER==ID_REAL8 -/* LUA_NUMBER */ -/* assumes sizeof(long)==4 and sizeof(double)==8 (IEEE) */ -static void DumpDouble(double f, FILE* D) -{ - long* l=(long*)&f; - int x=1; - if (*(char*)&x==1) /* little-endian */ - { - DumpLong(l[1],D); - DumpLong(l[0],D); - } - else /* big-endian */ - { - DumpLong(l[0],D); - DumpLong(l[1],D); - } -} -#endif - -static void DumpCode(TProtoFunc* tf, FILE* D) -{ - int size=CodeSize(tf); - if (NotWord(size)) - fprintf(stderr,"luac: warning: " - "\"%s\":%d code too long for 16-bit machines (%d bytes)\n", - fileName(tf),tf->lineDefined,size); - DumpLong(size,D); - DumpBlock(tf->code,size,D); -} - -static void DumpString(char* s, int size, FILE* D) -{ - if (s==NULL) - DumpWord(0,D); - else - { - if (NotWord(size)) - luaL_verror("string too long (%d bytes): \"%.32s...\"",size,s); - DumpWord(size,D); - DumpBlock(s,size,D); - } -} - -static void DumpTString(TaggedString* s, FILE* D) -{ - if (s==NULL) DumpString(NULL,0,D); else DumpString(s->str,s->u.s.len+1,D); -} - -static void DumpLocals(TProtoFunc* tf, FILE* D) -{ - int n; - LocVar* lv; - for (n=0,lv=tf->locvars; lv && lv->line>=0; lv++) ++n; - DumpWord(n,D); - for (lv=tf->locvars; lv && lv->line>=0; lv++) - { - DumpWord(lv->line,D); - DumpTString(lv->varname,D); - } -} - -static void DumpFunction(TProtoFunc* tf, FILE* D); - -static void DumpConstants(TProtoFunc* tf, FILE* D) -{ - int i,n=tf->nconsts; - DumpWord(n,D); - for (i=0; iconsts+i; - fputc(-ttype(o),D); - switch (ttype(o)) - { - case LUA_T_NUMBER: - DumpNumber(nvalue(o),D); - break; - case LUA_T_STRING: - DumpTString(tsvalue(o),D); - break; - case LUA_T_PROTO: - DumpFunction(tfvalue(o),D); - break; - case LUA_T_NIL: - break; - default: /* cannot happen */ - luaL_verror("cannot dump constant #%d: type=%d [%s]", - i,ttype(o),luaO_typename(o)); - break; - } - } -} - -static void DumpFunction(TProtoFunc* tf, FILE* D) -{ - DumpWord(tf->lineDefined,D); - DumpTString(tf->fileName,D); - DumpCode(tf,D); - DumpLocals(tf,D); - DumpConstants(tf,D); -} - -static void DumpHeader(TProtoFunc* Main, FILE* D) -{ - real t=TEST_NUMBER; - fputc(ID_CHUNK,D); - fputs(SIGNATURE,D); - fputc(VERSION,D); - fputc(ID_NUMBER,D); - fputc(sizeof(t),D); - DumpNumber(t,D); -} - -void DumpChunk(TProtoFunc* Main, FILE* D) -{ - DumpHeader(Main,D); - DumpFunction(Main,D); -} +/* +** $Id: dump.c,v 1.20 1999/07/02 19:34:26 lhf Exp $ +** save bytecodes to file +** See Copyright Notice in lua.h +*/ + +#include +#include +#include +#include "luac.h" + +#ifdef OLD_ANSI +#define strerror(e) "(no error message provided by operating system)" +#endif + +#define DumpBlock(b,size,D) fwrite(b,size,1,D) +#define DumpInt DumpLong + +static void DumpWord(int i, FILE* D) +{ + int hi= 0x0000FF & (i>>8); + int lo= 0x0000FF & i; + fputc(hi,D); + fputc(lo,D); +} + +static void DumpLong(long i, FILE* D) +{ + int hi= 0x00FFFF & (i>>16); + int lo= 0x00FFFF & i; + DumpWord(hi,D); + DumpWord(lo,D); +} + +static void DumpNumber(real x, FILE* D, int native, TProtoFunc* tf) +{ + if (native) + DumpBlock(&x,sizeof(x),D); + else + { + char b[256]; + int n; + sprintf(b,NUMBER_FMT"%n",x,&n); + luaU_str2d(b,tf->source->str); /* help lundump not to fail */ + fputc(n,D); + DumpBlock(b,n,D); + } +} + +static void DumpCode(TProtoFunc* tf, FILE* D) +{ + int size=luaU_codesize(tf); + DumpLong(size,D); + DumpBlock(tf->code,size,D); +} + +static void DumpString(char* s, int size, FILE* D) +{ + if (s==NULL) + DumpLong(0,D); + else + { + DumpLong(size,D); + DumpBlock(s,size,D); + } +} + +static void DumpTString(TaggedString* s, FILE* D) +{ + if (s==NULL) + DumpString(NULL,0,D); + else + DumpString(s->str,s->u.s.len+1,D); +} + +static void DumpLocals(TProtoFunc* tf, FILE* D) +{ + if (tf->locvars==NULL) + DumpInt(0,D); + else + { + LocVar* v; + int n=0; + for (v=tf->locvars; v->line>=0; v++) + ++n; + DumpInt(n,D); + for (v=tf->locvars; v->line>=0; v++) + { + DumpInt(v->line,D); + DumpTString(v->varname,D); + } + } +} + +static void DumpFunction(TProtoFunc* tf, FILE* D, int native); + +static void DumpConstants(TProtoFunc* tf, FILE* D, int native) +{ + int i,n=tf->nconsts; + DumpInt(n,D); + for (i=0; iconsts+i; + fputc(-ttype(o),D); /* ttype(o) is negative - ORDER LUA_T */ + switch (ttype(o)) + { + case LUA_T_NUMBER: + DumpNumber(nvalue(o),D,native,tf); + break; + case LUA_T_STRING: + DumpTString(tsvalue(o),D); + break; + case LUA_T_PROTO: + DumpFunction(tfvalue(o),D,native); + break; + case LUA_T_NIL: + break; + default: /* cannot happen */ + luaU_badconstant("dump",i,o,tf); + break; + } + } +} + +static void DumpFunction(TProtoFunc* tf, FILE* D, int native) +{ + DumpInt(tf->lineDefined,D); + DumpTString(tf->source,D); + DumpCode(tf,D); + DumpLocals(tf,D); + DumpConstants(tf,D,native); + if (ferror(D)) + luaL_verror("write error" IN ": %s (errno=%d)",INLOC,strerror(errno),errno); +} + +static void DumpHeader(TProtoFunc* Main, FILE* D, int native) +{ + fputc(ID_CHUNK,D); + fputs(SIGNATURE,D); + fputc(VERSION,D); + if (native) + { + fputc(sizeof(real),D); + DumpNumber(TEST_NUMBER,D,native,Main); + } + else + fputc(0,D); +} + +void luaU_dumpchunk(TProtoFunc* Main, FILE* D, int native) +{ + DumpHeader(Main,D,native); + DumpFunction(Main,D,native); +} diff --git a/src/luac/luac.c b/src/luac/luac.c index c461915..68af1c7 100644 --- a/src/luac/luac.c +++ b/src/luac/luac.c @@ -1,5 +1,5 @@ /* -** $Id: luac.c,v 1.10 1998/07/12 00:38:30 lhf Exp $ +** $Id: luac.c,v 1.17 1999/07/02 19:34:26 lhf Exp $ ** lua compiler (saves bytecodes to files; also list binary files) ** See Copyright Notice in lua.h */ @@ -9,43 +9,45 @@ #include #include "luac.h" #include "lparser.h" +#include "lstate.h" #include "lzio.h" -#include "luadebug.h" #define OUTPUT "luac.out" /* default output file */ -extern void DumpChunk(TProtoFunc* Main, FILE* D); -extern void PrintChunk(TProtoFunc* Main); -extern void OptChunk(TProtoFunc* Main); - static FILE* efopen(char* name, char* mode); static void doit(int undump, char* filename); static int listing=0; /* list bytecodes? */ -static int debugging=0; /* debug? */ +static int debugging=0; /* emit debug information? */ static int dumping=1; /* dump bytecodes? */ static int undumping=0; /* undump bytecodes? */ static int optimizing=0; /* optimize? */ static int parsing=0; /* parse only? */ +static int testing=0; /* test integrity? */ static int verbose=0; /* tell user what is done */ +static int native=0; /* save numbers in native format? */ static FILE* D; /* output file */ -static void usage(void) +static void usage(char* op) { - fprintf(stderr,"usage: " - "luac [-c | -u] [-D name] [-d] [-l] [-o output] [-O] [-p] [-q] [-v] [-V] [files]\n" - " -c\tcompile (default)\n" - " -u\tundump\n" - " -d\tgenerate debugging information\n" - " -D\tpredefine symbol for conditional compilation\n" - " -l\tlist (default for -u)\n" - " -o\toutput file for -c (default is \"" OUTPUT "\")\n" - " -O\toptimize\n" - " -p\tparse only\n" - " -q\tquiet (default for -c)\n" - " -v\tshow version information\n" - " -V\tverbose\n" - " -\tcompile \"stdin\"\n" + if (op) fprintf(stderr,"luac: unrecognized option '%s'\n",op); + fprintf(stderr, + "usage: luac [options] [filenames]. Available options are:\n" + " -c\t\tcompile (default)\n" + " -d\t\tgenerate debugging information\n" + " -D name\tpredefine 'name' for conditional compilation\n" + " -l\t\tlist (default for -u)\n" + " -n\t\tsave numbers in native format (file may not be portable)\n" + " -o file\toutput file for -c (default is \"" OUTPUT "\")\n" + " -O\t\toptimize\n" + " -p\t\tparse only\n" + " -q\t\tquiet (default for -c)\n" + " -t\t\ttest code integrity\n" + " -u\t\tundump\n" + " -U name\tundefine 'name' for conditional compilation\n" + " -v\t\tshow version information\n" + " -V\t\tverbose\n" + " -\t\tcompile \"stdin\"\n" ); exit(1); } @@ -61,7 +63,7 @@ int main(int argc, char* argv[]) { if (argv[i][0]!='-') /* end of options */ break; - else if (IS("-")) /* use stdin */ + else if (IS("-")) /* end of options; use stdin */ break; else if (IS("-c")) /* compile (and dump) */ { @@ -78,6 +80,8 @@ int main(int argc, char* argv[]) debugging=1; else if (IS("-l")) /* list */ listing=1; + else if (IS("-n")) /* native */ + native=1; else if (IS("-o")) /* output file */ d=argv[++i]; else if (IS("-O")) /* optimize */ @@ -89,34 +93,37 @@ int main(int argc, char* argv[]) } else if (IS("-q")) /* quiet */ listing=0; + else if (IS("-t")) /* test */ + testing=1; else if (IS("-u")) /* undump */ { dumping=0; undumping=1; listing=1; } + else if (IS("-U")) /* undefine */ + { + TaggedString* s=luaS_new(argv[++i]); + s->u.s.globalval.ttype=LUA_T_NIL; + } else if (IS("-v")) /* show version */ printf("%s %s\n(written by %s)\n\n",LUA_VERSION,LUA_COPYRIGHT,LUA_AUTHORS); else if (IS("-V")) /* verbose */ verbose=1; else /* unknown option */ - usage(); + usage(argv[i]); } --i; /* fake new argv[0] */ argc-=i; argv+=i; if (dumping || parsing) { - if (argc<2) usage(); + if (argc<2) usage(NULL); if (dumping) { for (i=1; idebug=0; + if (debugging) L->debug=1; Main=luaY_parser(z); - if (optimizing) OptChunk(Main); - if (listing) PrintChunk(Main); - if (dumping) DumpChunk(Main,D); + if (optimizing) luaU_optchunk(Main); + if (listing) luaU_printchunk(Main); + if (testing) luaU_testchunk(Main); + if (dumping) luaU_dumpchunk(Main,D,native); } static void do_undump(ZIO* z) { - while (1) + for (;;) { TProtoFunc* Main=luaU_undump1(z); if (Main==NULL) break; - if (optimizing) OptChunk(Main); - if (listing) PrintChunk(Main); + if (optimizing) luaU_optchunk(Main); + if (listing) luaU_printchunk(Main); + if (testing) luaU_testchunk(Main); } } static void doit(int undump, char* filename) { - FILE* f; + FILE* f= (filename==NULL) ? stdin : efopen(filename, undump ? "rb" : "r"); ZIO z; - if (filename==NULL) - { - f=stdin; filename="(stdin)"; - } - else - { - f=efopen(filename, undump ? "rb" : "r"); - } - zFopen(&z,f,filename); - if (verbose) fprintf(stderr,"%s\n",filename); + char source[255+2]; /* +2 for '@' and '\0' */ + luaL_filesource(source,filename,sizeof(source)); + zFopen(&z,f,source); + if (verbose) fprintf(stderr,"%s\n",source+1); if (undump) do_undump(&z); else do_compile(&z); if (f!=stdin) fclose(f); } diff --git a/src/luac/luac.h b/src/luac/luac.h dissimilarity index 63% index c3d8d73..1ae5267 100644 --- a/src/luac/luac.h +++ b/src/luac/luac.h @@ -1,33 +1,48 @@ -/* -** $Id: luac.h,v 1.6 1998/07/12 00:17:37 lhf Exp $ -** definitions for luac -** See Copyright Notice in lua.h -*/ - -#include "lauxlib.h" -#include "lfunc.h" -#include "lobject.h" -#include "lopcodes.h" -#include "lstring.h" -#include "lundump.h" - -typedef struct -{ - char* name; - int size; - int op; - int class; - int arg; - int arg2; -} Opcode; - -int OpcodeInfo(TProtoFunc* tf, Byte* p, Opcode* I, char* xFILE, int xLINE); -int CodeSize(TProtoFunc* tf); - -#define INFO(tf,p,I) OpcodeInfo(tf,p,I,__FILE__,__LINE__) -#define fileName(tf) ( (tf->fileName)==NULL ? NULL : tf->fileName->str ) - -#define NOP 255 -#define STACK -1 -#define ARGS -2 -#define VARARGS -3 +/* +** $Id: luac.h,v 1.11 1999/07/02 19:34:26 lhf Exp $ +** definitions for luac +** See Copyright Notice in lua.h +*/ + +#include "lauxlib.h" +#include "lfunc.h" +#include "lmem.h" +#include "lobject.h" +#include "lopcodes.h" +#include "lstring.h" +#include "lundump.h" + +typedef struct +{ + char* name; /* name of opcode */ + int op; /* value of opcode */ + int class; /* class of opcode (byte variant) */ + int args; /* types of arguments (operands) */ + int arg; /* arg #1 */ + int arg2; /* arg #2 */ +} Opcode; + +/* from dump.c */ +void luaU_dumpchunk(TProtoFunc* Main, FILE* D, int native); + +/* from opcode.c */ +int luaU_opcodeinfo(TProtoFunc* tf, Byte* p, Opcode* I, char* xFILE, int xLINE); +int luaU_codesize(TProtoFunc* tf); + +/* from opt.c */ +void luaU_optchunk(TProtoFunc* Main); + +/* from print.c */ +void luaU_printchunk(TProtoFunc* Main); + +/* from test.c */ +void luaU_testchunk(TProtoFunc* Main); +TObject* luaU_getconstant(TProtoFunc* tf, int i, int at); + +#define INFO(tf,p,I) luaU_opcodeinfo(tf,p,I,__FILE__,__LINE__) + +/* fake (but convenient) opcodes */ +#define NOP 255 +#define STACK (-1) +#define ARGS (-2) +#define VARARGS (-3) diff --git a/src/luac/opcode.c b/src/luac/opcode.c index c97e46a..c2d4ae7 100644 --- a/src/luac/opcode.c +++ b/src/luac/opcode.c @@ -1,83 +1,98 @@ /* -** $Id: opcode.c,v 1.4 1998/07/12 00:17:37 lhf Exp $ +** $Id: opcode.c,v 1.9 1999/05/25 19:58:55 lhf Exp $ ** opcode information ** See Copyright Notice in lua.h */ #include "luac.h" +enum { /* for Opcode.args */ + ARGS_NONE, + ARGS_B, + ARGS_W, + ARGS_BB, + ARGS_WB +}; + static Opcode Info[]= /* ORDER lopcodes.h */ { #include "opcode.h" }; +static Opcode Fake[]= /* ORDER luac.h */ +{ +{ "NOP", NOP, NOP, ARGS_NONE, -1, -1 }, +{ "STACK", STACK, STACK, ARGS_B, -1, -1 }, +{ "ARGS", ARGS, ARGS, ARGS_B, -1, -1 }, +{ "VARARGS", VARARGS, VARARGS, ARGS_B, -1, -1 }, +}; + #define NOPCODES (sizeof(Info)/sizeof(Info[0])) -int OpcodeInfo(TProtoFunc* tf, Byte* p, Opcode* I, char* xFILE, int xLINE) +int luaU_opcodeinfo(TProtoFunc* tf, Byte* p, Opcode* I, char* xFILE, int xLINE) { Opcode OP; Byte* code=tf->code; int op=*p; - if (p==code) + int size=1; + if (p==code) /* first byte is STACK */ { - OP.name="STACK"; - OP.size=1; - OP.op=STACK; - OP.class=STACK; + OP=Fake[-STACK]; OP.arg=op; } - else if (p==code+1) + else if (p==code+1) /* second byte is ARGS or VARARGS */ { - OP.size=1; - if (op>=ZEROVARARG) + if (op=NOPCODES) /* cannot happen */ { - luaL_verror("internal error at %s:%d: bad opcode %d at %d in tf=%p", - xFILE, xLINE,op,(int)(p-code),tf); + luaL_verror("[%s:%d] bad opcode %d at pc=%d" IN, + xFILE,xLINE,op,(int)(p-code),INLOC); return 0; } - else + else /* ordinary opcode */ { OP=Info[op]; - if (op==SETLIST || op==CLOSURE || op==CALLFUNC) + switch (OP.args) { - OP.arg=p[1]; - OP.arg2=p[2]; + case ARGS_NONE: size=1; + break; + case ARGS_B: size=2; OP.arg=p[1]; + break; + case ARGS_W: size=3; OP.arg=(p[1]<<8)+p[2]; + break; + case ARGS_BB: size=3; OP.arg=p[1]; OP.arg2=p[2]; + break; + case ARGS_WB: size=4; OP.arg=(p[1]<<8)+p[2]; OP.arg2=p[3]; + break; + default: /* cannot happen */ + luaL_verror("[%s:%d] bad args %d for %s at pc=%d" IN, + __FILE__,__LINE__,OP.args,OP.name,(int)(p-code),INLOC); + break; } - else if (OP.size==2) OP.arg=p[1]; - else if (OP.size>=3) OP.arg=(p[1]<<8)+p[2]; - if (op==SETLISTW || op==CLOSUREW) OP.arg2=p[3]; } *I=OP; - return OP.size; + return size; } -int CodeSize(TProtoFunc* tf) +int luaU_codesize(TProtoFunc* tf) { Byte* code=tf->code; Byte* p=code; - while (1) + for (;;) { Opcode OP; p+=INFO(tf,p,&OP); diff --git a/src/luac/opcode.h b/src/luac/opcode.h dissimilarity index 98% index 805933c..4ae910f 100644 --- a/src/luac/opcode.h +++ b/src/luac/opcode.h @@ -1,134 +1,70 @@ -/* -** $Id: opcode.h,v 1.3 1998/06/25 15:50:09 lhf Exp $ -** opcode info to be #included into opcode.c -** extracted automatically from lopcodes.h by mkopcodeh -** See Copyright Notice in lua.h -*/ -{ "ENDCODE", 1, ENDCODE, ENDCODE, ENDCODE-ENDCODE-1, 0 }, -{ "PUSHNIL", 2, PUSHNIL, PUSHNIL, PUSHNIL-PUSHNIL-1, 0 }, -{ "PUSHNIL0", 1, PUSHNIL0, PUSHNIL, PUSHNIL0-PUSHNIL-1, 0 }, -{ "PUSHNUMBER", 2, PUSHNUMBER, PUSHNUMBER, PUSHNUMBER-PUSHNUMBER-1, 0 }, -{ "PUSHNUMBER0", 1, PUSHNUMBER0, PUSHNUMBER, PUSHNUMBER0-PUSHNUMBER-1, 0 }, -{ "PUSHNUMBER1", 1, PUSHNUMBER1, PUSHNUMBER, PUSHNUMBER1-PUSHNUMBER-1, 0 }, -{ "PUSHNUMBER2", 1, PUSHNUMBER2, PUSHNUMBER, PUSHNUMBER2-PUSHNUMBER-1, 0 }, -{ "PUSHNUMBERW", 3, PUSHNUMBERW, PUSHNUMBER, PUSHNUMBERW-PUSHNUMBER-1, 0 }, -{ "PUSHCONSTANT", 2, PUSHCONSTANT, PUSHCONSTANT, PUSHCONSTANT-PUSHCONSTANT-1, 0 }, -{ "PUSHCONSTANT0", 1, PUSHCONSTANT0, PUSHCONSTANT, PUSHCONSTANT0-PUSHCONSTANT-1, 0 }, -{ "PUSHCONSTANT1", 1, PUSHCONSTANT1, PUSHCONSTANT, PUSHCONSTANT1-PUSHCONSTANT-1, 0 }, -{ "PUSHCONSTANT2", 1, PUSHCONSTANT2, PUSHCONSTANT, PUSHCONSTANT2-PUSHCONSTANT-1, 0 }, -{ "PUSHCONSTANT3", 1, PUSHCONSTANT3, PUSHCONSTANT, PUSHCONSTANT3-PUSHCONSTANT-1, 0 }, -{ "PUSHCONSTANT4", 1, PUSHCONSTANT4, PUSHCONSTANT, PUSHCONSTANT4-PUSHCONSTANT-1, 0 }, -{ "PUSHCONSTANT5", 1, PUSHCONSTANT5, PUSHCONSTANT, PUSHCONSTANT5-PUSHCONSTANT-1, 0 }, -{ "PUSHCONSTANT6", 1, PUSHCONSTANT6, PUSHCONSTANT, PUSHCONSTANT6-PUSHCONSTANT-1, 0 }, -{ "PUSHCONSTANT7", 1, PUSHCONSTANT7, PUSHCONSTANT, PUSHCONSTANT7-PUSHCONSTANT-1, 0 }, -{ "PUSHCONSTANTW", 3, PUSHCONSTANTW, PUSHCONSTANT, PUSHCONSTANTW-PUSHCONSTANT-1, 0 }, -{ "PUSHUPVALUE", 2, PUSHUPVALUE, PUSHUPVALUE, PUSHUPVALUE-PUSHUPVALUE-1, 0 }, -{ "PUSHUPVALUE0", 1, PUSHUPVALUE0, PUSHUPVALUE, PUSHUPVALUE0-PUSHUPVALUE-1, 0 }, -{ "PUSHUPVALUE1", 1, PUSHUPVALUE1, PUSHUPVALUE, PUSHUPVALUE1-PUSHUPVALUE-1, 0 }, -{ "PUSHLOCAL", 2, PUSHLOCAL, PUSHLOCAL, PUSHLOCAL-PUSHLOCAL-1, 0 }, -{ "PUSHLOCAL0", 1, PUSHLOCAL0, PUSHLOCAL, PUSHLOCAL0-PUSHLOCAL-1, 0 }, -{ "PUSHLOCAL1", 1, PUSHLOCAL1, PUSHLOCAL, PUSHLOCAL1-PUSHLOCAL-1, 0 }, -{ "PUSHLOCAL2", 1, PUSHLOCAL2, PUSHLOCAL, PUSHLOCAL2-PUSHLOCAL-1, 0 }, -{ "PUSHLOCAL3", 1, PUSHLOCAL3, PUSHLOCAL, PUSHLOCAL3-PUSHLOCAL-1, 0 }, -{ "PUSHLOCAL4", 1, PUSHLOCAL4, PUSHLOCAL, PUSHLOCAL4-PUSHLOCAL-1, 0 }, -{ "PUSHLOCAL5", 1, PUSHLOCAL5, PUSHLOCAL, PUSHLOCAL5-PUSHLOCAL-1, 0 }, -{ "PUSHLOCAL6", 1, PUSHLOCAL6, PUSHLOCAL, PUSHLOCAL6-PUSHLOCAL-1, 0 }, -{ "PUSHLOCAL7", 1, PUSHLOCAL7, PUSHLOCAL, PUSHLOCAL7-PUSHLOCAL-1, 0 }, -{ "GETGLOBAL", 2, GETGLOBAL, GETGLOBAL, GETGLOBAL-GETGLOBAL-1, 0 }, -{ "GETGLOBAL0", 1, GETGLOBAL0, GETGLOBAL, GETGLOBAL0-GETGLOBAL-1, 0 }, -{ "GETGLOBAL1", 1, GETGLOBAL1, GETGLOBAL, GETGLOBAL1-GETGLOBAL-1, 0 }, -{ "GETGLOBAL2", 1, GETGLOBAL2, GETGLOBAL, GETGLOBAL2-GETGLOBAL-1, 0 }, -{ "GETGLOBAL3", 1, GETGLOBAL3, GETGLOBAL, GETGLOBAL3-GETGLOBAL-1, 0 }, -{ "GETGLOBAL4", 1, GETGLOBAL4, GETGLOBAL, GETGLOBAL4-GETGLOBAL-1, 0 }, -{ "GETGLOBAL5", 1, GETGLOBAL5, GETGLOBAL, GETGLOBAL5-GETGLOBAL-1, 0 }, -{ "GETGLOBAL6", 1, GETGLOBAL6, GETGLOBAL, GETGLOBAL6-GETGLOBAL-1, 0 }, -{ "GETGLOBAL7", 1, GETGLOBAL7, GETGLOBAL, GETGLOBAL7-GETGLOBAL-1, 0 }, -{ "GETGLOBALW", 3, GETGLOBALW, GETGLOBAL, GETGLOBALW-GETGLOBAL-1, 0 }, -{ "GETTABLE", 1, GETTABLE, GETTABLE, GETTABLE-GETTABLE-1, 0 }, -{ "GETDOTTED", 2, GETDOTTED, GETDOTTED, GETDOTTED-GETDOTTED-1, 0 }, -{ "GETDOTTED0", 1, GETDOTTED0, GETDOTTED, GETDOTTED0-GETDOTTED-1, 0 }, -{ "GETDOTTED1", 1, GETDOTTED1, GETDOTTED, GETDOTTED1-GETDOTTED-1, 0 }, -{ "GETDOTTED2", 1, GETDOTTED2, GETDOTTED, GETDOTTED2-GETDOTTED-1, 0 }, -{ "GETDOTTED3", 1, GETDOTTED3, GETDOTTED, GETDOTTED3-GETDOTTED-1, 0 }, -{ "GETDOTTED4", 1, GETDOTTED4, GETDOTTED, GETDOTTED4-GETDOTTED-1, 0 }, -{ "GETDOTTED5", 1, GETDOTTED5, GETDOTTED, GETDOTTED5-GETDOTTED-1, 0 }, -{ "GETDOTTED6", 1, GETDOTTED6, GETDOTTED, GETDOTTED6-GETDOTTED-1, 0 }, -{ "GETDOTTED7", 1, GETDOTTED7, GETDOTTED, GETDOTTED7-GETDOTTED-1, 0 }, -{ "GETDOTTEDW", 3, GETDOTTEDW, GETDOTTED, GETDOTTEDW-GETDOTTED-1, 0 }, -{ "PUSHSELF", 2, PUSHSELF, PUSHSELF, PUSHSELF-PUSHSELF-1, 0 }, -{ "PUSHSELF0", 1, PUSHSELF0, PUSHSELF, PUSHSELF0-PUSHSELF-1, 0 }, -{ "PUSHSELF1", 1, PUSHSELF1, PUSHSELF, PUSHSELF1-PUSHSELF-1, 0 }, -{ "PUSHSELF2", 1, PUSHSELF2, PUSHSELF, PUSHSELF2-PUSHSELF-1, 0 }, -{ "PUSHSELF3", 1, PUSHSELF3, PUSHSELF, PUSHSELF3-PUSHSELF-1, 0 }, -{ "PUSHSELF4", 1, PUSHSELF4, PUSHSELF, PUSHSELF4-PUSHSELF-1, 0 }, -{ "PUSHSELF5", 1, PUSHSELF5, PUSHSELF, PUSHSELF5-PUSHSELF-1, 0 }, -{ "PUSHSELF6", 1, PUSHSELF6, PUSHSELF, PUSHSELF6-PUSHSELF-1, 0 }, -{ "PUSHSELF7", 1, PUSHSELF7, PUSHSELF, PUSHSELF7-PUSHSELF-1, 0 }, -{ "PUSHSELFW", 3, PUSHSELFW, PUSHSELF, PUSHSELFW-PUSHSELF-1, 0 }, -{ "CREATEARRAY", 2, CREATEARRAY, CREATEARRAY, CREATEARRAY-CREATEARRAY-1, 0 }, -{ "CREATEARRAY0", 1, CREATEARRAY0, CREATEARRAY, CREATEARRAY0-CREATEARRAY-1, 0 }, -{ "CREATEARRAY1", 1, CREATEARRAY1, CREATEARRAY, CREATEARRAY1-CREATEARRAY-1, 0 }, -{ "CREATEARRAYW", 3, CREATEARRAYW, CREATEARRAY, CREATEARRAYW-CREATEARRAY-1, 0 }, -{ "SETLOCAL", 2, SETLOCAL, SETLOCAL, SETLOCAL-SETLOCAL-1, 0 }, -{ "SETLOCAL0", 1, SETLOCAL0, SETLOCAL, SETLOCAL0-SETLOCAL-1, 0 }, -{ "SETLOCAL1", 1, SETLOCAL1, SETLOCAL, SETLOCAL1-SETLOCAL-1, 0 }, -{ "SETLOCAL2", 1, SETLOCAL2, SETLOCAL, SETLOCAL2-SETLOCAL-1, 0 }, -{ "SETLOCAL3", 1, SETLOCAL3, SETLOCAL, SETLOCAL3-SETLOCAL-1, 0 }, -{ "SETLOCAL4", 1, SETLOCAL4, SETLOCAL, SETLOCAL4-SETLOCAL-1, 0 }, -{ "SETLOCAL5", 1, SETLOCAL5, SETLOCAL, SETLOCAL5-SETLOCAL-1, 0 }, -{ "SETLOCAL6", 1, SETLOCAL6, SETLOCAL, SETLOCAL6-SETLOCAL-1, 0 }, -{ "SETLOCAL7", 1, SETLOCAL7, SETLOCAL, SETLOCAL7-SETLOCAL-1, 0 }, -{ "SETGLOBAL", 2, SETGLOBAL, SETGLOBAL, SETGLOBAL-SETGLOBAL-1, 0 }, -{ "SETGLOBAL0", 1, SETGLOBAL0, SETGLOBAL, SETGLOBAL0-SETGLOBAL-1, 0 }, -{ "SETGLOBAL1", 1, SETGLOBAL1, SETGLOBAL, SETGLOBAL1-SETGLOBAL-1, 0 }, -{ "SETGLOBAL2", 1, SETGLOBAL2, SETGLOBAL, SETGLOBAL2-SETGLOBAL-1, 0 }, -{ "SETGLOBAL3", 1, SETGLOBAL3, SETGLOBAL, SETGLOBAL3-SETGLOBAL-1, 0 }, -{ "SETGLOBAL4", 1, SETGLOBAL4, SETGLOBAL, SETGLOBAL4-SETGLOBAL-1, 0 }, -{ "SETGLOBAL5", 1, SETGLOBAL5, SETGLOBAL, SETGLOBAL5-SETGLOBAL-1, 0 }, -{ "SETGLOBAL6", 1, SETGLOBAL6, SETGLOBAL, SETGLOBAL6-SETGLOBAL-1, 0 }, -{ "SETGLOBAL7", 1, SETGLOBAL7, SETGLOBAL, SETGLOBAL7-SETGLOBAL-1, 0 }, -{ "SETGLOBALW", 3, SETGLOBALW, SETGLOBAL, SETGLOBALW-SETGLOBAL-1, 0 }, -{ "SETTABLE0", 1, SETTABLE0, SETTABLE0, SETTABLE0-SETTABLE0-1, 0 }, -{ "SETTABLE", 2, SETTABLE, SETTABLE, SETTABLE-SETTABLE-1, 0 }, -{ "SETLIST", 3, SETLIST, SETLIST, SETLIST-SETLIST-1, 0 }, -{ "SETLIST0", 2, SETLIST0, SETLIST, SETLIST0-SETLIST-1, 0 }, -{ "SETLISTW", 4, SETLISTW, SETLIST, SETLISTW-SETLIST-1, 0 }, -{ "SETMAP", 2, SETMAP, SETMAP, SETMAP-SETMAP-1, 0 }, -{ "SETMAP0", 1, SETMAP0, SETMAP, SETMAP0-SETMAP-1, 0 }, -{ "EQOP", 1, EQOP, EQOP, EQOP-EQOP-1, 0 }, -{ "NEQOP", 1, NEQOP, NEQOP, NEQOP-NEQOP-1, 0 }, -{ "LTOP", 1, LTOP, LTOP, LTOP-LTOP-1, 0 }, -{ "LEOP", 1, LEOP, LEOP, LEOP-LEOP-1, 0 }, -{ "GTOP", 1, GTOP, GTOP, GTOP-GTOP-1, 0 }, -{ "GEOP", 1, GEOP, GEOP, GEOP-GEOP-1, 0 }, -{ "ADDOP", 1, ADDOP, ADDOP, ADDOP-ADDOP-1, 0 }, -{ "SUBOP", 1, SUBOP, SUBOP, SUBOP-SUBOP-1, 0 }, -{ "MULTOP", 1, MULTOP, MULTOP, MULTOP-MULTOP-1, 0 }, -{ "DIVOP", 1, DIVOP, DIVOP, DIVOP-DIVOP-1, 0 }, -{ "POWOP", 1, POWOP, POWOP, POWOP-POWOP-1, 0 }, -{ "CONCOP", 1, CONCOP, CONCOP, CONCOP-CONCOP-1, 0 }, -{ "MINUSOP", 1, MINUSOP, MINUSOP, MINUSOP-MINUSOP-1, 0 }, -{ "NOTOP", 1, NOTOP, NOTOP, NOTOP-NOTOP-1, 0 }, -{ "ONTJMP", 2, ONTJMP, ONTJMP, ONTJMP-ONTJMP-1, 0 }, -{ "ONTJMPW", 3, ONTJMPW, ONTJMP, ONTJMPW-ONTJMP-1, 0 }, -{ "ONFJMP", 2, ONFJMP, ONFJMP, ONFJMP-ONFJMP-1, 0 }, -{ "ONFJMPW", 3, ONFJMPW, ONFJMP, ONFJMPW-ONFJMP-1, 0 }, -{ "JMP", 2, JMP, JMP, JMP-JMP-1, 0 }, -{ "JMPW", 3, JMPW, JMP, JMPW-JMP-1, 0 }, -{ "IFFJMP", 2, IFFJMP, IFFJMP, IFFJMP-IFFJMP-1, 0 }, -{ "IFFJMPW", 3, IFFJMPW, IFFJMP, IFFJMPW-IFFJMP-1, 0 }, -{ "IFTUPJMP", 2, IFTUPJMP, IFTUPJMP, IFTUPJMP-IFTUPJMP-1, 0 }, -{ "IFTUPJMPW", 3, IFTUPJMPW, IFTUPJMP, IFTUPJMPW-IFTUPJMP-1, 0 }, -{ "IFFUPJMP", 2, IFFUPJMP, IFFUPJMP, IFFUPJMP-IFFUPJMP-1, 0 }, -{ "IFFUPJMPW", 3, IFFUPJMPW, IFFUPJMP, IFFUPJMPW-IFFUPJMP-1, 0 }, -{ "CLOSURE", 3, CLOSURE, CLOSURE, CLOSURE-CLOSURE-1, 0 }, -{ "CLOSUREW", 4, CLOSUREW, CLOSURE, CLOSUREW-CLOSURE-1, 0 }, -{ "CALLFUNC", 3, CALLFUNC, CALLFUNC, CALLFUNC-CALLFUNC-1, 0 }, -{ "CALLFUNC0", 2, CALLFUNC0, CALLFUNC, CALLFUNC0-CALLFUNC-1, 0 }, -{ "CALLFUNC1", 2, CALLFUNC1, CALLFUNC, CALLFUNC1-CALLFUNC-1, 0 }, -{ "RETCODE", 2, RETCODE, RETCODE, RETCODE-RETCODE-1, 0 }, -{ "SETLINE", 2, SETLINE, SETLINE, SETLINE-SETLINE-1, 0 }, -{ "SETLINEW", 3, SETLINEW, SETLINE, SETLINEW-SETLINE-1, 0 }, -{ "POP", 2, POP, POP, POP-POP-1, 0 }, -{ "POP0", 1, POP0, POP, POP0-POP-1, 0 }, -{ "POP1", 1, POP1, POP, POP1-POP-1, 0 }, +/* +** $Id: opcode.h,v 1.1 1999/03/25 13:43:05 lhf Exp $ +** opcode info to be #included into opcode.c +** extracted automatically from lopcodes.h by mkopcodeh -- DO NOT EDIT +** See Copyright Notice in lua.h +*/ +{ "ENDCODE", ENDCODE, ENDCODE, ARGS_NONE, -1, -1 }, +{ "RETCODE", RETCODE, RETCODE, ARGS_B, -1, -1 }, +{ "CALL", CALL, CALL, ARGS_BB, -1, -1 }, +{ "TAILCALL", TAILCALL, TAILCALL, ARGS_BB, -1, -1 }, +{ "PUSHNIL", PUSHNIL, PUSHNIL, ARGS_B, -1, -1 }, +{ "POP", POP, POP, ARGS_B, -1, -1 }, +{ "PUSHNUMBERW", PUSHNUMBERW, PUSHNUMBER, ARGS_W, -1, -1 }, +{ "PUSHNUMBER", PUSHNUMBER, PUSHNUMBER, ARGS_B, -1, -1 }, +{ "PUSHNUMBERNEGW", PUSHNUMBERNEGW, PUSHNUMBERNEG, ARGS_W, -1, -1 }, +{ "PUSHNUMBERNEG", PUSHNUMBERNEG, PUSHNUMBERNEG, ARGS_B, -1, -1 }, +{ "PUSHCONSTANTW", PUSHCONSTANTW, PUSHCONSTANT, ARGS_W, -1, -1 }, +{ "PUSHCONSTANT", PUSHCONSTANT, PUSHCONSTANT, ARGS_B, -1, -1 }, +{ "PUSHUPVALUE", PUSHUPVALUE, PUSHUPVALUE, ARGS_B, -1, -1 }, +{ "PUSHLOCAL", PUSHLOCAL, PUSHLOCAL, ARGS_B, -1, -1 }, +{ "GETGLOBALW", GETGLOBALW, GETGLOBAL, ARGS_W, -1, -1 }, +{ "GETGLOBAL", GETGLOBAL, GETGLOBAL, ARGS_B, -1, -1 }, +{ "GETTABLE", GETTABLE, GETTABLE, ARGS_NONE, -1, -1 }, +{ "GETDOTTEDW", GETDOTTEDW, GETDOTTED, ARGS_W, -1, -1 }, +{ "GETDOTTED", GETDOTTED, GETDOTTED, ARGS_B, -1, -1 }, +{ "PUSHSELFW", PUSHSELFW, PUSHSELF, ARGS_W, -1, -1 }, +{ "PUSHSELF", PUSHSELF, PUSHSELF, ARGS_B, -1, -1 }, +{ "CREATEARRAYW", CREATEARRAYW, CREATEARRAY, ARGS_W, -1, -1 }, +{ "CREATEARRAY", CREATEARRAY, CREATEARRAY, ARGS_B, -1, -1 }, +{ "SETLOCAL", SETLOCAL, SETLOCAL, ARGS_B, -1, -1 }, +{ "SETGLOBALW", SETGLOBALW, SETGLOBAL, ARGS_W, -1, -1 }, +{ "SETGLOBAL", SETGLOBAL, SETGLOBAL, ARGS_B, -1, -1 }, +{ "SETTABLEPOP", SETTABLEPOP, SETTABLEPOP, ARGS_NONE, -1, -1 }, +{ "SETTABLE", SETTABLE, SETTABLE, ARGS_B, -1, -1 }, +{ "SETLISTW", SETLISTW, SETLIST, ARGS_WB, -1, -1 }, +{ "SETLIST", SETLIST, SETLIST, ARGS_BB, -1, -1 }, +{ "SETMAP", SETMAP, SETMAP, ARGS_B, -1, -1 }, +{ "NEQOP", NEQOP, NEQOP, ARGS_NONE, -1, -1 }, +{ "EQOP", EQOP, EQOP, ARGS_NONE, -1, -1 }, +{ "LTOP", LTOP, LTOP, ARGS_NONE, -1, -1 }, +{ "LEOP", LEOP, LEOP, ARGS_NONE, -1, -1 }, +{ "GTOP", GTOP, GTOP, ARGS_NONE, -1, -1 }, +{ "GEOP", GEOP, GEOP, ARGS_NONE, -1, -1 }, +{ "ADDOP", ADDOP, ADDOP, ARGS_NONE, -1, -1 }, +{ "SUBOP", SUBOP, SUBOP, ARGS_NONE, -1, -1 }, +{ "MULTOP", MULTOP, MULTOP, ARGS_NONE, -1, -1 }, +{ "DIVOP", DIVOP, DIVOP, ARGS_NONE, -1, -1 }, +{ "POWOP", POWOP, POWOP, ARGS_NONE, -1, -1 }, +{ "CONCOP", CONCOP, CONCOP, ARGS_NONE, -1, -1 }, +{ "MINUSOP", MINUSOP, MINUSOP, ARGS_NONE, -1, -1 }, +{ "NOTOP", NOTOP, NOTOP, ARGS_NONE, -1, -1 }, +{ "ONTJMPW", ONTJMPW, ONTJMP, ARGS_W, -1, -1 }, +{ "ONTJMP", ONTJMP, ONTJMP, ARGS_B, -1, -1 }, +{ "ONFJMPW", ONFJMPW, ONFJMP, ARGS_W, -1, -1 }, +{ "ONFJMP", ONFJMP, ONFJMP, ARGS_B, -1, -1 }, +{ "JMPW", JMPW, JMP, ARGS_W, -1, -1 }, +{ "JMP", JMP, JMP, ARGS_B, -1, -1 }, +{ "IFFJMPW", IFFJMPW, IFFJMP, ARGS_W, -1, -1 }, +{ "IFFJMP", IFFJMP, IFFJMP, ARGS_B, -1, -1 }, +{ "IFTUPJMPW", IFTUPJMPW, IFTUPJMP, ARGS_W, -1, -1 }, +{ "IFTUPJMP", IFTUPJMP, IFTUPJMP, ARGS_B, -1, -1 }, +{ "IFFUPJMPW", IFFUPJMPW, IFFUPJMP, ARGS_W, -1, -1 }, +{ "IFFUPJMP", IFFUPJMP, IFFUPJMP, ARGS_B, -1, -1 }, +{ "CLOSUREW", CLOSUREW, CLOSURE, ARGS_WB, -1, -1 }, +{ "CLOSURE", CLOSURE, CLOSURE, ARGS_BB, -1, -1 }, +{ "SETLINEW", SETLINEW, SETLINE, ARGS_W, -1, -1 }, +{ "SETLINE", SETLINE, SETLINE, ARGS_B, -1, -1 }, +{ "LONGARGW", LONGARGW, LONGARG, ARGS_W, -1, -1 }, +{ "LONGARG", LONGARG, LONGARG, ARGS_B, -1, -1 }, +{ "CHECKSTACK", CHECKSTACK, CHECKSTACK, ARGS_B, -1, -1 }, diff --git a/src/luac/opt.c b/src/luac/opt.c index 5084dde..e2becc2 100644 --- a/src/luac/opt.c +++ b/src/luac/opt.c @@ -1,70 +1,126 @@ /* -** $Id: opt.c,v 1.4 1998/04/02 20:44:08 lhf Exp $ +** $Id: opt.c,v 1.12 1999/07/02 19:34:26 lhf Exp $ ** optimize bytecodes ** See Copyright Notice in lua.h */ #include #include +#include #include "luac.h" -#include "lmem.h" + +static void FixArg(Byte* p, int i, int j, int isconst) +{ + if (j==i) + ; + else if (i<=MAX_BYTE) /* j>8; + p[2]=j; + } + } + else /* previous instruction must've been LONGARG */ + { + if (isconst && j<=MAX_WORD) p[-2]=p[-1]=NOP; else p[-1]=j>>16; + p[1]=j>>8; + p[2]=j; + } +} static void FixConstants(TProtoFunc* tf, int* C) { Byte* code=tf->code; Byte* p=code; - while (1) + int longarg=0; + for (;;) { Opcode OP; int n=INFO(tf,p,&OP); int op=OP.class; - int i=OP.arg; - if (op==ENDCODE) break; - if ( op==PUSHCONSTANT || op==GETDOTTED || op==PUSHSELF || - op==GETGLOBAL || op==SETGLOBAL) + int i=OP.arg+longarg; + longarg=0; + if (op==PUSHCONSTANT || op==GETGLOBAL || op==GETDOTTED || + op==PUSHSELF || op==SETGLOBAL || op==CLOSURE) + FixArg(p,i,C[i],1); + else if (op==LONGARG) longarg=i<<16; + else if (op==ENDCODE) break; + p+=n; + } +} + +#define UNREF 1 /* "type" of unused constants */ +#define BIAS 128 /* mark for used constants */ + +static void NoUnrefs(TProtoFunc* tf) +{ + int i,n=tf->nconsts; + Byte* code=tf->code; + Byte* p=code; + int longarg=0; + for (;;) /* mark all used constants */ + { + Opcode OP; + int n=INFO(tf,p,&OP); + int op=OP.class; + int i=OP.arg+longarg; + longarg=0; + if (op==PUSHCONSTANT || op==GETGLOBAL || op==GETDOTTED || + op==PUSHSELF || op==SETGLOBAL || op==CLOSURE) { - int j=C[i]; - if (j==i) - ; - else if (n==1) - { - p[0]=op+j+1; - } - else if (n==2) - { - if (j<8) { p[0]=op+j+1; p[1]=NOP; } else p[1]=j; - } - else - { - if (j<=255) - { - p[0]=op; - p[1]=j; - p[2]=NOP; - } - else - { - p[1]= 0x0000FF & (j>>8); - p[2]= 0x0000FF & j; - } - } + TObject* o=tf->consts+i; + if (ttype(o)<=0) ttype(o)+=BIAS; /* mark as used */ } + else if (op==LONGARG) longarg=i<<16; + else if (op==ENDCODE) break; p+=n; } + for (i=0; iconsts+i; + if (ttype(o)<=0) + ttype(o)=UNREF; /* mark as unused */ + else + ttype(o)-=BIAS; /* unmark used constant */ + } } -static TProtoFunc* TF; +#define CMP(oa,ob,f) memcmp(&f(oa),&f(ob),sizeof(f(oa))) -static int compare(const void* a, const void *b) +static int compare(TProtoFunc* tf, int ia, int ib) +{ + TObject* oa=tf->consts+ia; + TObject* ob=tf->consts+ib; + int t=ttype(oa)-ttype(ob); + if (t) return t; + switch (ttype(oa)) + { + case LUA_T_NUMBER: return CMP(oa,ob,nvalue); + case LUA_T_STRING: return CMP(oa,ob,tsvalue); + case LUA_T_PROTO: return CMP(oa,ob,tfvalue); + case LUA_T_NIL: return 0; + case UNREF: return 0; + default: return ia-ib; /* cannot happen */ + } +} + +static TProtoFunc* TF; /* for sort */ + +static int compare1(const void* a, const void* b) { int ia=*(int*)a; int ib=*(int*)b; - int t; - TObject* oa=TF->consts+ia; - TObject* ob=TF->consts+ib; - t=ttype(oa)-ttype(ob); if (t) return t; - t=oa->value.i-ob->value.i; if (t) return t; - return ia-ib; + int t=compare(TF,ia,ib); + return (t) ? t : ia-ib; } static void OptConstants(TProtoFunc* tf) @@ -74,43 +130,60 @@ static void OptConstants(TProtoFunc* tf) int i,k; int n=tf->nconsts; if (n==0) return; - C=luaM_reallocvector(C,n,int); - D=luaM_reallocvector(D,n,int); + luaM_reallocvector(C,n,int); + luaM_reallocvector(D,n,int); + NoUnrefs(tf); for (i=0; iconsts+k; - TObject* ob=tf->consts+j; - if (ttype(oa)==ttype(ob) && oa->value.i==ob->value.i) D[j]=k; else k=j; + if (compare(tf,k,j)==0) D[j]=k; else k=j; } k=0; /* build rename map & pack constants */ for (i=0; iconsts[k]=tf->consts[i]; C[i]=k++; } else C[i]=C[D[i]]; + if (D[i]==i) /* new value */ + { + TObject* o=tf->consts+i; + if (ttype(o)!=UNREF) + { + tf->consts[k]=tf->consts[i]; + C[i]=k++; + } + } + else C[i]=C[D[i]]; + } + if (ksource->str,tf->lineDefined,n,k); + FixConstants(tf,C); + tf->nconsts=k; } - if (k>=n) return; -printf("\t\"%s\":%d reduced constants from %d to %d\n", - tf->fileName->str,tf->lineDefined,n,k); - tf->nconsts=k; - FixConstants(tf,C); } static int NoDebug(TProtoFunc* tf) { Byte* code=tf->code; Byte* p=code; + int lop=NOP; /* last opcode */ int nop=0; - while (1) /* change SETLINE to NOP */ + for (;;) /* change SETLINE to NOP */ { Opcode OP; int n=INFO(tf,p,&OP); int op=OP.class; - if (op==ENDCODE) break; if (op==NOP) ++nop; - if (op==SETLINE) { nop+=n; memset(p,NOP,n); } + else if (op==SETLINE) + { + int m; + if (lop==LONGARG) m=2; else if (lop==LONGARGW) m=3; else m=0; + nop+=n+m; memset(p-m,NOP,n+m); + } + else if (op==ENDCODE) break; + lop=OP.op; p+=n; } return nop; @@ -125,8 +198,8 @@ static int FixJump(TProtoFunc* tf, Byte* a, Byte* b) Opcode OP; int n=INFO(tf,p,&OP); int op=OP.class; - if (op==ENDCODE) break; if (op==NOP) ++nop; + else if (op==ENDCODE) break; p+=n; } return nop; @@ -136,42 +209,22 @@ static void FixJumps(TProtoFunc* tf) { Byte* code=tf->code; Byte* p=code; - while (1) + int longarg=0; + for (;;) { Opcode OP; int n=INFO(tf,p,&OP); int op=OP.class; - int i=OP.arg; - int nop; + int i=OP.arg+longarg; + int nop=0; + longarg=0; if (op==ENDCODE) break; - nop=0; - if (op==IFTUPJMP || op==IFFUPJMP) nop=FixJump(tf,p-i+n,p); else - if (op==ONTJMP || op==ONFJMP || op==JMP || op==IFFJMP) nop=FixJump(tf,p,p+i+n); - if (nop>0) - { - int j=i-nop; - if (n==2) - p[1]=j; - else -#if 0 - { - if (j<=255) /* does NOT work for nested loops */ - { - if (op==IFTUPJMP || op==IFFUPJMP) --j; - p[0]=OP.op-1; /* *JMP and *JMPW are consecutive */ - p[1]=j; - p[2]=NOP; - } - else -#endif - { - p[1]= 0x0000FF & (j>>8); - p[2]= 0x0000FF & j; - } -#if 0 - } -#endif - } + else if (op==IFTUPJMP || op==IFFUPJMP) + nop=FixJump(tf,p-i+n,p); + else if (op==ONTJMP || op==ONFJMP || op==JMP || op==IFFJMP) + nop=FixJump(tf,p,p+i+n); + else if (op==LONGARG) longarg=i<<16; + if (nop>0) FixArg(p,i,i-nop,0); p+=n; } } @@ -181,7 +234,7 @@ static void PackCode(TProtoFunc* tf) Byte* code=tf->code; Byte* p=code; Byte* q=code; - while (1) + for (;;) { Opcode OP; int n=INFO(tf,p,&OP); @@ -190,14 +243,13 @@ static void PackCode(TProtoFunc* tf) p+=n; if (op==ENDCODE) break; } -printf("\t\"%s\":%d reduced code from %d to %d\n", - tf->fileName->str,tf->lineDefined,(int)(p-code),(int)(q-code)); +printf("\t" SOURCE " reduced code from %d to %d\n", + tf->source->str,tf->lineDefined,(int)(p-code),(int)(q-code)); } static void OptCode(TProtoFunc* tf) { - int nop=NoDebug(tf); - if (nop==0) return; /* cannot improve code */ + if (NoDebug(tf)==0) return; /* cannot improve code */ FixJumps(tf); PackCode(tf); } @@ -216,13 +268,14 @@ static void OptFunctions(TProtoFunc* tf) static void OptFunction(TProtoFunc* tf) { - tf->locvars=NULL; /* remove local variables table */ OptConstants(tf); OptCode(tf); OptFunctions(tf); + tf->source=luaS_new(""); + tf->locvars=NULL; } -void OptChunk(TProtoFunc* Main) +void luaU_optchunk(TProtoFunc* Main) { OptFunction(Main); } diff --git a/src/luac/print.c b/src/luac/print.c index ce98539..b1ee893 100644 --- a/src/luac/print.c +++ b/src/luac/print.c @@ -1,5 +1,5 @@ /* -** $Id: print.c,v 1.13 1998/07/12 00:17:37 lhf Exp $ +** $Id: print.c,v 1.21 1999/05/25 19:58:55 lhf Exp $ ** print bytecodes ** See Copyright Notice in lua.h */ @@ -9,88 +9,81 @@ #include "luac.h" #ifdef DEBUG -void PrintConstant1(TProtoFunc* tf, int i) -{ - TObject* o=tf->consts+i; - printf("%6d ",i); - if (i<0 || i>=tf->nconsts) - printf("(bad constant #%d: max=%d)",i,tf->nconsts); - else - switch (ttype(o)) - { - case LUA_T_NUMBER: - printf("N " NUMBER_FMT "\n",nvalue(o)); /* LUA_NUMBER */ - break; - case LUA_T_STRING: - printf("S %p\t\"%s\"\n",(void*)tsvalue(o),svalue(o)); - break; - case LUA_T_PROTO: - printf("F %p\n",(void*)tfvalue(o)); - break; - default: /* cannot happen */ - printf("? %d\n",ttype(o)); - break; - } -} - static void PrintConstants(TProtoFunc* tf) { int i,n=tf->nconsts; - printf("constants (%d):\n",n); - for (i=0; i=tf->nconsts) - printf("(bad constant #%d: max=%d)",i,tf->nconsts); - else + printf("constants (%d) for %p:\n",n,tf); + for (i=0; iconsts+i; + printf("%6d ",i); switch (ttype(o)) { case LUA_T_NUMBER: - printf(NUMBER_FMT,nvalue(o)); /* LUA_NUMBER */ + printf("N " NUMBER_FMT "\n",(double)nvalue(o)); break; case LUA_T_STRING: - printf("\"%s\"",svalue(o)); + printf("S %p\t\"%s\"\n",tsvalue(o),svalue(o)); break; case LUA_T_PROTO: - printf("function at %p",(void*)tfvalue(o)); + printf("F %p\n",tfvalue(o)); break; case LUA_T_NIL: - printf("(nil)"); + printf("nil\n"); break; default: /* cannot happen */ - printf("(bad constant #%d: type=%d [%s])\n",i,ttype(o),luaO_typename(o)); + printf("? type=%d\n",ttype(o)); break; } } } +#endif -#define VarStr(i) svalue(tf->consts+i) +static void PrintConstant(TProtoFunc* tf, int i, int at) +{ + TObject* o=luaU_getconstant(tf,i,at); + switch (ttype(o)) + { + case LUA_T_NUMBER: + printf(NUMBER_FMT,(double)nvalue(o)); + break; + case LUA_T_STRING: + printf("\"%s\"",svalue(o)); + break; + case LUA_T_PROTO: + printf("function at %p",(void*)tfvalue(o)); + break; + case LUA_T_NIL: + printf("(nil)"); + break; + default: /* cannot happen */ + luaU_badconstant("print",i,o,tf); + break; + } +} static void PrintCode(TProtoFunc* tf) { Byte* code=tf->code; Byte* p=code; int line=0; - while (1) + int longarg=0; + for (;;) { Opcode OP; int n=INFO(tf,p,&OP); - int op=OP.op; - int i=OP.arg; - printf("%6d ",(int)(p-code)); + int i=OP.arg+longarg; + int at=p-code; + longarg=0; + printf("%6d ",at); { Byte* q=p; int j=n; while (j--) printf("%02X",*q++); } - printf("%*s%-13s",2*(5-n),"",OP.name); - - if (n!=1 || op<0) printf("\t%d",i); else if (i>=0) printf("\t"); + printf("%*s%-14s ",2*(5-n),"",OP.name); + if (OP.arg >=0) printf("%d",i); + if (OP.arg2>=0) printf(" %d",OP.arg2); switch (OP.class) { @@ -99,13 +92,14 @@ static void PrintCode(TProtoFunc* tf) printf("\n"); return; - case CLOSURE: - printf(" %d",OP.arg2); case PUSHCONSTANT: + case GETGLOBAL: + case SETGLOBAL: case GETDOTTED: case PUSHSELF: + case CLOSURE: printf("\t; "); - PrintConstant(tf,i); + PrintConstant(tf,i,at); break; case PUSHLOCAL: @@ -116,29 +110,24 @@ static void PrintCode(TProtoFunc* tf) break; } - case GETGLOBAL: - case SETGLOBAL: - printf("\t; %s",VarStr(i)); - break; - - case SETLIST: - case CALLFUNC: - if (n>=3) printf(" %d",OP.arg2); + case SETLINE: + printf("\t; " SOURCE,tf->source->str,line=i); break; - case SETLINE: - printf("\t; \"%s\":%d",fileName(tf),line=i); + case LONGARG: + longarg=i<<16; break; /* suggested by Norman Ramsey */ - case IFTUPJMP: - case IFFUPJMP: - i=-i; case ONTJMP: case ONFJMP: case JMP: case IFFJMP: - printf("\t; to %d",(int)(p-code)+i+n); + printf("\t; to %d",at+i+n); + break; + case IFTUPJMP: + case IFFUPJMP: + printf("\t; to %d",at-i+n); break; } @@ -150,47 +139,44 @@ static void PrintCode(TProtoFunc* tf) static void PrintLocals(TProtoFunc* tf) { LocVar* v=tf->locvars; - int n,i=0; - if (v==NULL || v->varname==NULL) return; + int n,i; + if (v==NULL || v->line<0) return; n=tf->code[1]; if (n>=ZEROVARARG) n-=ZEROVARARG; - printf("locals:"); - if (n>0) - { - for (i=0; ivarname->str); - } - if (v->varname!=NULL) + for (i=0; ivarname->str); + for (; v->line>=0; v++) { - for (; v->line>=0; v++) + if (v->varname==NULL) { - if (v->varname==NULL) - { - printf(")"); --i; - } - else - { - printf(" (%s",v->varname->str); i++; - } + --i; if (i<0) luaL_verror("bad locvars[%d]",v-tf->locvars); else printf(")"); + } + else + { + ++i; printf(" (%s",v->varname->str); } - i-=n; - while (i--) printf(")"); } + i-=n; + while (i--) printf(")"); printf("\n"); } +#define IsMain(tf) (tf->lineDefined==0) + static void PrintHeader(TProtoFunc* tf, TProtoFunc* Main, int at) { - int size=CodeSize(tf); + int size=luaU_codesize(tf); if (IsMain(tf)) - printf("\nmain of \"%s\" (%d bytes at %p)\n",fileName(tf),size,(void*)tf); - else if (Main) + printf("\nmain " SOURCE " (%d bytes at %p)\n", + tf->source->str,tf->lineDefined,size,tf); + else { - printf("\nfunction defined at \"%s\":%d (%d bytes at %p); used at ", - fileName(tf),tf->lineDefined,size,(void*)tf); - if (IsMain(Main)) + printf("\nfunction " SOURCE " (%d bytes at %p); used at ", + tf->source->str,tf->lineDefined,size,tf); + if (Main && IsMain(Main)) printf("main"); else - printf("%p",(void*)Main); + printf("%p",Main); printf("+%d\n",at); } } @@ -201,17 +187,21 @@ static void PrintFunctions(TProtoFunc* Main) { Byte* code=Main->code; Byte* p=code; - while (1) + int longarg=0; + for (;;) { Opcode OP; int n=INFO(Main,p,&OP); - if (OP.class==ENDCODE) break; - if (OP.class==PUSHCONSTANT || OP.class==CLOSURE) + int op=OP.class; + int i=OP.arg+longarg; + longarg=0; + if (op==PUSHCONSTANT || op==CLOSURE) { - int i=OP.arg; TObject* o=Main->consts+i; if (ttype(o)==LUA_T_PROTO) PrintFunction(tfvalue(o),Main,(int)(p-code)); } + else if (op==LONGARG) longarg=i<<16; + else if (op==ENDCODE) break; p+=n; } } @@ -227,7 +217,7 @@ static void PrintFunction(TProtoFunc* tf, TProtoFunc* Main, int at) PrintFunctions(tf); } -void PrintChunk(TProtoFunc* Main) +void luaU_printchunk(TProtoFunc* Main) { PrintFunction(Main,0,0); } diff --git a/src/luac/stubs.c b/src/luac/stubs.c index d42bec2..5f38940 100644 --- a/src/luac/stubs.c +++ b/src/luac/stubs.c @@ -1,9 +1,17 @@ /* -** $Id: stubs.c,v 1.8 1998/07/12 00:17:37 lhf Exp $ +** $Id: stubs.c,v 1.11 1999/03/11 17:09:10 lhf Exp $ ** avoid runtime modules in luac ** See Copyright Notice in lua.h */ +#ifdef NOSTUBS + +/* according to gcc, ANSI C forbids an empty source file */ +void luaU_dummy(void); +void luaU_dummy(void){} + +#else + #include #include #include @@ -22,32 +30,34 @@ void lua_error(char* s) } /* copied from lauxlib.c */ -void luaL_verror(char* fmt, ...) +void luaL_verror (char *fmt, ...) { - char buff[500]; - va_list argp; - va_start(argp,fmt); - vsprintf(buff,fmt,argp); - va_end(argp); - lua_error(buff); + char buff[500]; + va_list argp; + va_start(argp, fmt); + vsprintf(buff, fmt, argp); + va_end(argp); + lua_error(buff); } /* copied from lauxlib.c */ -int luaL_findstring (char* name, char* list[]) -{ - int i; - for (i=0; list[i]; i++) - if (strcmp(list[i], name) == 0) - return i; - return -1; +void luaL_filesource (char *out, char *filename, int len) { + if (filename == NULL) filename = "(stdin)"; + sprintf(out, "@%.*s", len-2, filename); /* -2 for '@' and '\0' */ } /* avoid runtime modules in lstate.c */ + +#include "lbuiltin.h" +#include "ldo.h" +#include "lgc.h" +#include "ltable.h" +#include "ltm.h" + void luaB_predefine(void){} void luaC_hashcallIM(Hash *l){} void luaC_strcallIM(TaggedString *l){} void luaD_gcIM(TObject *o){} -void luaD_init(void){} void luaH_free(Hash *frees){} void luaT_init(void){} @@ -59,10 +69,53 @@ void luaT_init(void){} #ifdef NOPARSER -int lua_debug=0; +#include "llex.h" +#include "lparser.h" void luaX_init(void){} -void luaY_init(void){} -void luaY_parser(void) { lua_error("parser not loaded"); } +void luaD_init(void){} + +TProtoFunc* luaY_parser(ZIO *z) { + lua_error("parser not loaded"); + return NULL; +} + +#else +/* copied from lauxlib.c */ +int luaL_findstring (char *name, char *list[]) { + int i; + for (i=0; list[i]; i++) + if (strcmp(list[i], name) == 0) + return i; + return -1; /* name not found */ +} + +/* copied from lauxlib.c */ +void luaL_chunkid (char *out, char *source, int len) { + len -= 13; /* 13 = strlen("string ''...\0") */ + if (*source == '@') + sprintf(out, "file `%.*s'", len, source+1); + else if (*source == '(') + strcpy(out, "(C code)"); + else { + char *b = strchr(source , '\n'); /* stop string at first new line */ + int lim = (b && (b-source)stack.stack = luaM_newvector(STACK_UNIT, TObject); + L->stack.top = L->stack.stack; + L->stack.last = L->stack.stack+(STACK_UNIT-1); +} + +#endif #endif diff --git a/src/luac/test.c b/src/luac/test.c new file mode 100644 index 0000000..78ba455 --- /dev/null +++ b/src/luac/test.c @@ -0,0 +1,253 @@ +/* +** $Id: test.c,v 1.10 1999/07/02 19:34:26 lhf Exp $ +** test integrity +** See Copyright Notice in lua.h +*/ + +#include +#include +#include +#include "luac.h" + +#define AT "pc=%d" +#define ATLOC 0) +#define UNSAFE(s) \ + luaL_verror("unsafe code at " AT IN "\n " s,at,INLOC + +TObject* luaU_getconstant(TProtoFunc* tf, int i, int at) +{ + if (i>=tf->nconsts) UNSAFE("bad constant #%d (max=%d)"),i,tf->nconsts-1,ATLOC; + return tf->consts+i; +} + +static int check(int n, TProtoFunc* tf, int at, int sp, int ss) +{ + if (n==0) return sp; + sp+=n; + if (sp<00) UNSAFE("stack underflow (sp=%d)"),sp,ATLOC; + if (sp>ss) UNSAFE("stack overflow (sp=%d ss=%d)"),sp,ss,ATLOC; + return sp; +} + +#define CHECK(before,after) \ + sp=check(-(before),tf,at,sp,ss), sp=check(after,tf,at,sp,ss) + +static int jmpok(TProtoFunc* tf, int size, int at, int d) +{ + int to=at+d; + if (to<2 || to>=size) + UNSAFE("invalid jump to %d (valid range is 2..%d)"),to,size-1,ATLOC; + return to; +} + +static void TestStack(TProtoFunc* tf, int size, int* SP, int* JP) +{ + Byte* code=tf->code; + Byte* p=code; + int longarg=0; + int ss=0; + int sp=0; + for (;;) + { + Opcode OP; + int n=INFO(tf,p,&OP); + int op=OP.class; + int i=OP.arg+longarg; + int at=p-code; + longarg=0; + switch (op) /* test sanity of operands */ + { + case PUSHCONSTANT: + case GETGLOBAL: + case GETDOTTED: + case PUSHSELF: + case SETGLOBAL: + case CLOSURE: + { + TObject* o=luaU_getconstant(tf,i,at); + if ((op==CLOSURE && ttype(o)!=LUA_T_PROTO) + || (op==GETGLOBAL && ttype(o)!=LUA_T_STRING) + || (op==SETGLOBAL && ttype(o)!=LUA_T_STRING)) + UNSAFE("bad operand to %s"),OP.name,ATLOC; + break; + } + case PUSHLOCAL: + if (i>=sp) UNSAFE("bad local #%d (max=%d)"),i,sp-1,ATLOC; + break; + case SETLOCAL: + if (i>=(sp-1)) UNSAFE("bad local #%d (max=%d)"),i,sp-2,ATLOC; + break; + case ONTJMP: + case ONFJMP: /* negate to remember ON?JMP */ + JP[at]=-jmpok(tf,size,at,i+n); + break; + case JMP: /* remember JMP targets */ + case IFFJMP: + JP[at]= jmpok(tf,size,at,i+n); + break; + case IFTUPJMP: + case IFFUPJMP: + JP[at]= jmpok(tf,size,at,-i+n); + break; + } + + SP[at]=sp; /* remember depth before instruction */ + + switch (op) + { + case STACK: ss=i; break; + case ARGS: CHECK(0,i); break; + case VARARGS: break; + case ENDCODE: return; + case RETCODE: CHECK(i,0); sp=i; break; + case CALL: CHECK(OP.arg2+1,i); break; + case TAILCALL: CHECK(OP.arg2,0); sp=i; break; + case PUSHNIL: CHECK(0,i+1); break; + case POP: CHECK(0,-i); break; + case PUSHNUMBER: + case PUSHNUMBERNEG: + case PUSHCONSTANT: + case PUSHUPVALUE: + case PUSHLOCAL: + case GETGLOBAL: CHECK(0,1); break; + case GETTABLE: CHECK(2,1); break; + case GETDOTTED: CHECK(1,1); break; + case PUSHSELF: CHECK(1,2); break; + case CREATEARRAY: CHECK(0,1); break; + case SETLOCAL: CHECK(1,0); break; + case SETGLOBAL: CHECK(1,0); break; + case SETTABLEPOP: CHECK(3,0); break; + case SETTABLE: CHECK(i+3,i+2); break; + case SETLIST: CHECK(OP.arg2+1,1); break; + case SETMAP: CHECK(2*(i+1)+1,1); break; + case NEQOP: + case EQOP: + case LTOP: + case LEOP: + case GTOP: + case GEOP: + case ADDOP: + case SUBOP: + case MULTOP: + case DIVOP: + case POWOP: + case CONCOP: CHECK(2,1); break; + case MINUSOP: + case NOTOP: CHECK(1,1); break; + case ONTJMP: + case ONFJMP: + case IFFJMP: + case IFTUPJMP: + case IFFUPJMP: CHECK(1,0); break; + case JMP: break; + case CLOSURE: CHECK(OP.arg2,1); break; + case SETLINE: break; + case LONGARG: + longarg=i<<16; + if (longarg<0) UNSAFE("longarg overflow"),ATLOC; + break; + case CHECKSTACK: break; + default: /* cannot happen */ + UNSAFE("cannot test opcode %d [%s]"),OP.op,OP.name,ATLOC; + break; + } + p+=n; + } +} + +static void TestJumps(TProtoFunc* tf, int size, int* SP, int* JP) +{ + int i; + for (i=0; ilocvars==NULL) return; + for (v=tf->locvars; v->line>=0; v++) + { + int at=v-tf->locvars; /* for ATLOC */ + if (l>v->line) + UNSAFE("bad line number %d; expected at least %d"),v->line,l,ATLOC; + l=v->line; + if (v->varname==NULL) + { + if (--d<0) UNSAFE("no scope to close"),ATLOC; + } + else + ++d; + } +} + +static void TestFunction(TProtoFunc* tf); + +static void TestConstants(TProtoFunc* tf) +{ + int i,n=tf->nconsts; + for (i=0; iconsts+i; + switch (ttype(o)) + { + case LUA_T_NUMBER: + break; + case LUA_T_STRING: + break; + case LUA_T_PROTO: + TestFunction(tfvalue(o)); + break; + case LUA_T_NIL: + break; + default: /* cannot happen */ + luaU_badconstant("print",i,o,tf); + break; + } + } +} + +static void TestFunction(TProtoFunc* tf) +{ + TestCode(tf); + TestLocals(tf); + TestConstants(tf); +} + +void luaU_testchunk(TProtoFunc* Main) +{ + TestFunction(Main); +} diff --git a/src/lundump.c b/src/lundump.c index 4fe2b0d..0c3b5fd 100644 --- a/src/lundump.c +++ b/src/lundump.c @@ -1,5 +1,5 @@ /* -** $Id: lundump.c,v 1.12 1998/07/12 01:46:59 lhf Exp $ +** $Id: lundump.c,v 1.21 1999/07/02 19:34:26 lhf Exp $ ** load bytecodes from files ** See Copyright Notice in lua.h */ @@ -9,99 +9,96 @@ #include "lauxlib.h" #include "lfunc.h" #include "lmem.h" +#include "lopcodes.h" #include "lstring.h" #include "lundump.h" #define LoadBlock(b,size,Z) ezread(Z,b,size) -#define LoadNative(t,Z) LoadBlock(&t,sizeof(t),Z) -#if ID_NUMBER==ID_NATIVE - #define doLoadNumber(f,Z) LoadNative(f,Z) -#else - #define doLoadNumber(f,Z) f=LoadNumber(Z) -#endif - -static void unexpectedEOZ(ZIO* Z) +static void unexpectedEOZ (ZIO* Z) { luaL_verror("unexpected end of file in %s",zname(Z)); } -static int ezgetc(ZIO* Z) +static int ezgetc (ZIO* Z) { int c=zgetc(Z); if (c==EOZ) unexpectedEOZ(Z); return c; } -static void ezread(ZIO* Z, void* b, int n) +static void ezread (ZIO* Z, void* b, int n) { int r=zread(Z,b,n); if (r!=0) unexpectedEOZ(Z); } -static unsigned int LoadWord(ZIO* Z) +static unsigned int LoadWord (ZIO* Z) { unsigned int hi=ezgetc(Z); unsigned int lo=ezgetc(Z); return (hi<<8)|lo; } -static unsigned long LoadLong(ZIO* Z) +static unsigned long LoadLong (ZIO* Z) { unsigned long hi=LoadWord(Z); unsigned long lo=LoadWord(Z); return (hi<<16)|lo; } -#if ID_NUMBER==ID_REAL4 -/* LUA_NUMBER */ -/* assumes sizeof(long)==4 and sizeof(float)==4 (IEEE) */ -static float LoadFloat(ZIO* Z) +/* +* convert number from text +*/ +double luaU_str2d (char* b, char* where) { - unsigned long l=LoadLong(Z); - float f; - memcpy(&f,&l,sizeof(f)); - return f; + int negative=(b[0]=='-'); + double x=luaO_str2d(b+negative); + if (x<0) luaL_verror("cannot convert number '%s' in %s",b,where); + return negative ? -x : x; } -#endif -#if ID_NUMBER==ID_REAL8 -/* LUA_NUMBER */ -/* assumes sizeof(long)==4 and sizeof(double)==8 (IEEE) */ -static double LoadDouble(ZIO* Z) +static real LoadNumber (ZIO* Z, int native) { - unsigned long l[2]; - double f; - int x=1; - if (*(char*)&x==1) /* little-endian */ + real x; + if (native) { - l[1]=LoadLong(Z); - l[0]=LoadLong(Z); + LoadBlock(&x,sizeof(x),Z); + return x; } - else /* big-endian */ + else { - l[0]=LoadLong(Z); - l[1]=LoadLong(Z); + char b[256]; + int size=ezgetc(Z); + LoadBlock(b,size,Z); + b[size]=0; + return luaU_str2d(b,zname(Z)); } - memcpy(&f,l,sizeof(f)); - return f; } -#endif -static Byte* LoadCode(ZIO* Z) +static int LoadInt (ZIO* Z, char* message) { - unsigned long size=LoadLong(Z); - unsigned int s=size; - void* b; - if (s!=size) luaL_verror("code too long (%ld bytes) in %s",size,zname(Z)); - b=luaM_malloc(size); + unsigned long l=LoadLong(Z); + unsigned int i=l; + if (i!=l) luaL_verror(message,l,zname(Z)); + return i; +} + +#define PAD 5 /* two word operands plus opcode */ + +static Byte* LoadCode (ZIO* Z) +{ + int size=LoadInt(Z,"code too long (%ld bytes) in %s"); + Byte* b=luaM_malloc(size+PAD); LoadBlock(b,size,Z); + if (b[size-1]!=ENDCODE) luaL_verror("bad code in %s",zname(Z)); + memset(b+size,ENDCODE,PAD); /* pad code for safety */ return b; } -static TaggedString* LoadTString(ZIO* Z) +static TaggedString* LoadTString (ZIO* Z) { - int size=LoadWord(Z); + long size=LoadLong(Z); if (size==0) return NULL; else @@ -112,65 +109,65 @@ static TaggedString* LoadTString(ZIO* Z) } } -static void LoadLocals(TProtoFunc* tf, ZIO* Z) +static void LoadLocals (TProtoFunc* tf, ZIO* Z) { - int i,n=LoadWord(Z); + int i,n=LoadInt(Z,"too many locals (%ld) in %s"); if (n==0) return; tf->locvars=luaM_newvector(n+1,LocVar); for (i=0; ilocvars[i].line=LoadWord(Z); + tf->locvars[i].line=LoadInt(Z,"too many lines (%ld) in %s"); tf->locvars[i].varname=LoadTString(Z); } tf->locvars[i].line=-1; /* flag end of vector */ tf->locvars[i].varname=NULL; } -static TProtoFunc* LoadFunction(ZIO* Z); +static TProtoFunc* LoadFunction (ZIO* Z, int native); -static void LoadConstants(TProtoFunc* tf, ZIO* Z) +static void LoadConstants (TProtoFunc* tf, ZIO* Z, int native) { - int i,n=LoadWord(Z); + int i,n=LoadInt(Z,"too many constants (%ld) in %s"); tf->nconsts=n; if (n==0) return; tf->consts=luaM_newvector(n,TObject); for (i=0; iconsts+i; - ttype(o)=-ezgetc(Z); + ttype(o)=-ezgetc(Z); /* ttype(o) is negative - ORDER LUA_T */ switch (ttype(o)) { case LUA_T_NUMBER: - doLoadNumber(nvalue(o),Z); + nvalue(o)=LoadNumber(Z,native); break; case LUA_T_STRING: tsvalue(o)=LoadTString(Z); break; case LUA_T_PROTO: - tfvalue(o)=LoadFunction(Z); + tfvalue(o)=LoadFunction(Z,native); break; case LUA_T_NIL: break; - default: - luaL_verror("bad constant #%d in %s: type=%d [%s]", - i,zname(Z),ttype(o),luaO_typename(o)); + default: /* cannot happen */ + luaU_badconstant("load",i,o,tf); break; } } } -static TProtoFunc* LoadFunction(ZIO* Z) +static TProtoFunc* LoadFunction (ZIO* Z, int native) { TProtoFunc* tf=luaF_newproto(); - tf->lineDefined=LoadWord(Z); - tf->fileName=LoadTString(Z); + tf->lineDefined=LoadInt(Z,"lineDefined too large (%ld) in %s"); + tf->source=LoadTString(Z); + if (tf->source==NULL) tf->source=luaS_new(zname(Z)); tf->code=LoadCode(Z); LoadLocals(tf,Z); - LoadConstants(tf,Z); + LoadConstants(tf,Z,native); return tf; } -static void LoadSignature(ZIO* Z) +static void LoadSignature (ZIO* Z) { char* s=SIGNATURE; while (*s!=0 && ezgetc(Z)==*s) @@ -178,10 +175,10 @@ static void LoadSignature(ZIO* Z) if (*s!=0) luaL_verror("bad signature in %s",zname(Z)); } -static void LoadHeader(ZIO* Z) +static int LoadHeader (ZIO* Z) { - int version,id,sizeofR; - real f=-TEST_NUMBER,tf=TEST_NUMBER; + int version,sizeofR; + int native; LoadSignature(Z); version=ezgetc(Z); if (version>VERSION) @@ -192,32 +189,36 @@ static void LoadHeader(ZIO* Z) luaL_verror( "%s too old: version=0x%02x; expected at least 0x%02x", zname(Z),version,VERSION0); - id=ezgetc(Z); /* test number representation */ sizeofR=ezgetc(Z); - if (id!=ID_NUMBER || sizeofR!=sizeof(real)) + native=(sizeofR!=0); + if (native) /* test number representation */ { - luaL_verror("unknown number signature in %s: " - "read 0x%02x%02x; expected 0x%02x%02x", - zname(Z),id,sizeofR,ID_NUMBER,sizeof(real)); + if (sizeofR!=sizeof(real)) + luaL_verror("unknown number size in %s: read %d; expected %d", + zname(Z),sizeofR,sizeof(real)); + else + { + real tf=TEST_NUMBER; + real f=LoadNumber(Z,native); + if ((long)f!=(long)tf) + luaL_verror("unknown number format in %s: " + "read " NUMBER_FMT "; expected " NUMBER_FMT, + zname(Z),f,tf); + } } - doLoadNumber(f,Z); - if (f!=tf) - luaL_verror("unknown number representation in %s: " - "read " NUMBER_FMT "; expected " NUMBER_FMT, /* LUA_NUMBER */ - zname(Z),f,tf); + return native; } -static TProtoFunc* LoadChunk(ZIO* Z) +static TProtoFunc* LoadChunk (ZIO* Z) { - LoadHeader(Z); - return LoadFunction(Z); + return LoadFunction(Z,LoadHeader(Z)); } /* ** load one chunk from a file or buffer ** return main if ok and NULL at EOF */ -TProtoFunc* luaU_undump1(ZIO* Z) +TProtoFunc* luaU_undump1 (ZIO* Z) { int c=zgetc(Z); if (c==ID_CHUNK) @@ -226,3 +227,13 @@ TProtoFunc* luaU_undump1(ZIO* Z) luaL_verror("%s is not a Lua binary file",zname(Z)); return NULL; } + +/* +* handle constants that cannot happen +*/ +void luaU_badconstant (char* s, int i, TObject* o, TProtoFunc* tf) +{ + int t=ttype(o); + char* name= (t>0 || tlineDefined==0) -#define luaO_typename(o) luaO_typenames[-ttype(o)] - -/* number representation */ -#define ID_INT4 'l' /* 4-byte integers */ -#define ID_REAL4 'f' /* 4-byte reals */ -#define ID_REAL8 'd' /* 8-byte reals */ -#define ID_NATIVE '?' /* whatever your machine uses */ - -/* -* use a multiple of PI for testing number representation. -* multiplying by 1E8 gives notrivial integer values. -*/ -#define TEST_NUMBER 3.14159265358979323846E8 - -/* LUA_NUMBER -* choose one below for the number representation in precompiled chunks. -* the default is ID_REAL8 because the default for LUA_NUM_TYPE is double. -* if your machine does not use IEEE 754, use ID_NATIVE. -* the next version will support conversion to/from IEEE 754. -* -* if you change LUA_NUM_TYPE, make sure you set ID_NUMBER accordingly, -* specially if sizeof(long)!=4. -* for types other than the ones listed below, you'll have to write your own -* dump and undump routines. -*/ - -#ifndef ID_NUMBER -#define ID_NUMBER ID_REAL8 -#endif - -#if 0 -#define ID_NUMBER ID_INT4 -#define ID_NUMBER ID_REAL4 -#define ID_NUMBER ID_REAL8 -#define ID_NUMBER ID_NATIVE -#endif - -#endif - -#if ID_NUMBER==ID_REAL4 - #define DumpNumber DumpFloat - #define LoadNumber LoadFloat - #define SIZEOF_NUMBER 4 -#elif ID_NUMBER==ID_REAL8 - #define DumpNumber DumpDouble - #define LoadNumber LoadDouble - #define SIZEOF_NUMBER 8 -#elif ID_NUMBER==ID_INT4 - #define DumpNumber DumpLong - #define LoadNumber LoadLong - #define SIZEOF_NUMBER 4 -#elif ID_NUMBER==ID_NATIVE - #define DumpNumber DumpNative - #define LoadNumber LoadNative - #define SIZEOF_NUMBER sizeof(real) -#else - #error bad ID_NUMBER -#endif +/* +** $Id: lundump.h,v 1.15 1999/07/02 19:34:26 lhf Exp $ +** load pre-compiled Lua chunks +** See Copyright Notice in lua.h +*/ + +#ifndef lundump_h +#define lundump_h + +#include "lobject.h" +#include "lzio.h" + +TProtoFunc* luaU_undump1 (ZIO* Z); /* load one chunk */ +void luaU_badconstant (char* s, int i, TObject* o, TProtoFunc* tf); + /* handle cases that cannot happen */ +double luaU_str2d (char* b, char* where); + /* convert number from text */ + +/* definitions for headers of binary files */ +#define VERSION 0x32 /* last format change was in 3.2 */ +#define VERSION0 0x32 /* last major change was in 3.2 */ +#define ID_CHUNK 27 /* binary files start with ESC... */ +#define SIGNATURE "Lua" /* ...followed by this signature */ + +/* formats for error messages */ +#define SOURCE "<%s:%d>" +#define IN " in %p " SOURCE +#define INLOC tf,tf->source->str,tf->lineDefined + +/* format for numbers in listings and error messages */ +#ifndef NUMBER_FMT +#define NUMBER_FMT "%.16g" /* LUA_NUMBER */ +#endif + +/* a multiple of PI for testing native format */ +/* multiplying by 1E8 gives non-trivial integer values */ +#define TEST_NUMBER 3.14159265358979323846E8 + +#endif diff --git a/src/lvm.c b/src/lvm.c index 72c26c1..670642b 100644 --- a/src/lvm.c +++ b/src/lvm.c @@ -1,11 +1,14 @@ /* -** $Id: lvm.c,v 1.30 1998/06/11 18:21:37 roberto Exp $ +** $Id: lvm.c,v 1.58 1999/06/22 20:37:23 roberto Exp $ ** Lua virtual machine ** See Copyright Notice in lua.h */ +#include +#include #include +#include #include #include "lauxlib.h" @@ -13,6 +16,7 @@ #include "lfunc.h" #include "lgc.h" #include "lmem.h" +#include "lobject.h" #include "lopcodes.h" #include "lstate.h" #include "lstring.h" @@ -27,9 +31,7 @@ #endif -#define skip_word(pc) (pc+=2) -#define get_word(pc) ((*(pc)<<8)+(*((pc)+1))) -#define next_word(pc) (pc+=2, get_word(pc-2)) +#define highbyte(x) ((x)<<8) /* Extra stack size to run a function: LUA_T_LINE(1), TM calls(2), ... */ @@ -37,45 +39,47 @@ -static TaggedString *strconc (TaggedString *l, TaggedString *r) -{ - size_t nl = l->u.s.len; - size_t nr = r->u.s.len; - char *buffer = luaL_openspace(nl+nr+1); +static TaggedString *strconc (TaggedString *l, TaggedString *r) { + long nl = l->u.s.len; + long nr = r->u.s.len; + char *buffer = luaL_openspace(nl+nr); memcpy(buffer, l->str, nl); memcpy(buffer+nl, r->str, nr); return luaS_newlstr(buffer, nl+nr); } -int luaV_tonumber (TObject *obj) -{ /* LUA_NUMBER */ - double t; - char c; +int luaV_tonumber (TObject *obj) { /* LUA_NUMBER */ if (ttype(obj) != LUA_T_STRING) return 1; - else if (sscanf(svalue(obj), "%lf %c",&t, &c) == 1) { - nvalue(obj) = (real)t; + else { + double t; + char *e = svalue(obj); + int sig = 1; + while (isspace((unsigned char)*e)) e++; + if (*e == '-') { + e++; + sig = -1; + } + else if (*e == '+') e++; + /* no digit before or after decimal point? */ + if (!isdigit((unsigned char)*e) && !isdigit((unsigned char)*(e+1))) + return 2; + t = luaO_str2d(e); + if (t<0) return 2; + nvalue(obj) = (real)t*sig; ttype(obj) = LUA_T_NUMBER; return 0; } - else - return 2; } -int luaV_tostring (TObject *obj) -{ /* LUA_NUMBER */ +int luaV_tostring (TObject *obj) { /* LUA_NUMBER */ if (ttype(obj) != LUA_T_NUMBER) return 1; else { - char s[60]; - real f = nvalue(obj); - int i; - if ((real)(-MAX_INT) <= f && f <= (real)MAX_INT && (real)(i=(int)f) == f) - sprintf (s, "%d", i); - else - sprintf (s, NUMBER_FMT, nvalue(obj)); + char s[32]; /* 16 digits, signal, point and \0 (+ some extra...) */ + sprintf(s, "%.16g", (double)nvalue(obj)); tsvalue(obj) = luaS_new(s); ttype(obj) = LUA_T_STRING; return 0; @@ -83,8 +87,15 @@ int luaV_tostring (TObject *obj) } -void luaV_closure (int nelems) -{ +void luaV_setn (Hash *t, int val) { + TObject index, value; + ttype(&index) = LUA_T_STRING; tsvalue(&index) = luaS_new("n"); + ttype(&value) = LUA_T_NUMBER; nvalue(&value) = val; + luaH_set(t, &index, &value); +} + + +void luaV_closure (int nelems) { if (nelems > 0) { struct Stack *S = &L->stack; Closure *c = luaF_newclosure(nelems); @@ -101,99 +112,110 @@ void luaV_closure (int nelems) ** Function to index a table. ** Receives the table at top-2 and the index at top-1. */ -void luaV_gettable (void) -{ - struct Stack *S = &L->stack; +void luaV_gettable (void) { + TObject *table = L->stack.top-2; TObject *im; - if (ttype(S->top-2) != LUA_T_ARRAY) /* not a table, get "gettable" method */ - im = luaT_getimbyObj(S->top-2, IM_GETTABLE); + if (ttype(table) != LUA_T_ARRAY) { /* not a table, get gettable method */ + im = luaT_getimbyObj(table, IM_GETTABLE); + if (ttype(im) == LUA_T_NIL) + lua_error("indexed expression not a table"); + } else { /* object is a table... */ - int tg = (S->top-2)->value.a->htag; + int tg = table->value.a->htag; im = luaT_getim(tg, IM_GETTABLE); if (ttype(im) == LUA_T_NIL) { /* and does not have a "gettable" method */ - TObject *h = luaH_get(avalue(S->top-2), S->top-1); - if (h != NULL && ttype(h) != LUA_T_NIL) { - --S->top; - *(S->top-1) = *h; + TObject *h = luaH_get(avalue(table), table+1); + if (ttype(h) == LUA_T_NIL && + (ttype(im=luaT_getim(tg, IM_INDEX)) != LUA_T_NIL)) { + /* result is nil and there is an "index" tag method */ + luaD_callTM(im, 2, 1); /* calls it */ } - else if (ttype(im=luaT_getim(tg, IM_INDEX)) != LUA_T_NIL) - luaD_callTM(im, 2, 1); else { - --S->top; - ttype(S->top-1) = LUA_T_NIL; + L->stack.top--; + *table = *h; /* "push" result into table position */ } return; } /* else it has a "gettable" method, go through to next command */ } /* object is not a table, or it has a "gettable" method */ - if (ttype(im) != LUA_T_NIL) - luaD_callTM(im, 2, 1); - else - lua_error("indexed expression not a table"); + luaD_callTM(im, 2, 1); } /* -** Function to store indexed based on values at the stack.top -** mode = 0: raw store (without tag methods) -** mode = 1: normal store (with tag methods) -** mode = 2: "deep L->stack.stack" store (with tag methods) +** Receives table at *t, index at *(t+1) and value at top. */ -void luaV_settable (TObject *t, int mode) -{ +void luaV_settable (TObject *t) { struct Stack *S = &L->stack; - TObject *im = (mode == 0) ? NULL : luaT_getimbyObj(t, IM_SETTABLE); - if (ttype(t) == LUA_T_ARRAY && (im == NULL || ttype(im) == LUA_T_NIL)) { - TObject *h = luaH_set(avalue(t), t+1); - *h = *(S->top-1); - S->top -= (mode == 2) ? 1 : 3; + TObject *im; + if (ttype(t) != LUA_T_ARRAY) { /* not a table, get "settable" method */ + im = luaT_getimbyObj(t, IM_SETTABLE); + if (ttype(im) == LUA_T_NIL) + lua_error("indexed expression not a table"); } - else { /* object is not a table, and/or has a specific "settable" method */ - if (im && ttype(im) != LUA_T_NIL) { - if (mode == 2) { - *(S->top+1) = *(L->stack.top-1); - *(S->top) = *(t+1); - *(S->top-1) = *t; - S->top += 2; /* WARNING: caller must assure stack space */ - } - luaD_callTM(im, 3, 0); + else { /* object is a table... */ + im = luaT_getim(avalue(t)->htag, IM_SETTABLE); + if (ttype(im) == LUA_T_NIL) { /* and does not have a "settable" method */ + luaH_set(avalue(t), t+1, S->top-1); + S->top--; /* pop value */ + return; } - else - lua_error("indexed expression not a table"); + /* else it has a "settable" method, go through to next command */ } + /* object is not a table, or it has a "settable" method */ + /* prepare arguments and call the tag method */ + *(S->top+1) = *(L->stack.top-1); + *(S->top) = *(t+1); + *(S->top-1) = *t; + S->top += 2; /* WARNING: caller must assure stack space */ + luaD_callTM(im, 3, 0); } -void luaV_getglobal (TaggedString *ts) -{ - /* WARNING: caller must assure stack space */ - TObject *value = &ts->u.s.globalval; - TObject *im = luaT_getimbyObj(value, IM_GETGLOBAL); - if (ttype(im) == LUA_T_NIL) { /* default behavior */ - *L->stack.top++ = *value; - } +void luaV_rawsettable (TObject *t) { + if (ttype(t) != LUA_T_ARRAY) + lua_error("indexed expression not a table"); else { struct Stack *S = &L->stack; - ttype(S->top) = LUA_T_STRING; - tsvalue(S->top) = ts; - S->top++; - *S->top++ = *value; - luaD_callTM(im, 2, 1); + luaH_set(avalue(t), t+1, S->top-1); + S->top -= 3; } } -void luaV_setglobal (TaggedString *ts) -{ +void luaV_getglobal (TaggedString *ts) { + /* WARNING: caller must assure stack space */ + /* only userdata, tables and nil can have getglobal tag methods */ + static char valid_getglobals[] = {1, 0, 0, 1, 0, 0, 1, 0}; /* ORDER LUA_T */ + TObject *value = &ts->u.s.globalval; + if (valid_getglobals[-ttype(value)]) { + TObject *im = luaT_getimbyObj(value, IM_GETGLOBAL); + if (ttype(im) != LUA_T_NIL) { /* is there a tag method? */ + struct Stack *S = &L->stack; + ttype(S->top) = LUA_T_STRING; + tsvalue(S->top) = ts; + S->top++; + *S->top++ = *value; + luaD_callTM(im, 2, 1); + return; + } + /* else no tag method: go through to default behavior */ + } + *L->stack.top++ = *value; /* default behavior */ +} + + +void luaV_setglobal (TaggedString *ts) { TObject *oldvalue = &ts->u.s.globalval; TObject *im = luaT_getimbyObj(oldvalue, IM_SETGLOBAL); - if (ttype(im) == LUA_T_NIL) /* default behavior */ + if (ttype(im) == LUA_T_NIL) /* is there a tag method? */ luaS_rawsetglobal(ts, --L->stack.top); else { /* WARNING: caller must assure stack space */ struct Stack *S = &L->stack; - TObject newvalue = *(S->top-1); + TObject newvalue; + newvalue = *(S->top-1); ttype(S->top-1) = LUA_T_STRING; tsvalue(S->top-1) = ts; *S->top++ = *oldvalue; @@ -225,7 +247,7 @@ static void call_arith (IMS event) } -static int strcomp (char *l, long ll, char *r, long lr) +static int luaV_strcomp (char *l, long ll, char *r, long lr) { for (;;) { long temp = strcoll(l, r); @@ -242,18 +264,17 @@ static int strcomp (char *l, long ll, char *r, long lr) } } -static void comparison (lua_Type ttype_less, lua_Type ttype_equal, - lua_Type ttype_great, IMS op) -{ +void luaV_comparison (lua_Type ttype_less, lua_Type ttype_equal, + lua_Type ttype_great, IMS op) { struct Stack *S = &L->stack; TObject *l = S->top-2; TObject *r = S->top-1; - int result; + real result; if (ttype(l) == LUA_T_NUMBER && ttype(r) == LUA_T_NUMBER) - result = (nvalue(l) < nvalue(r)) ? -1 : (nvalue(l) == nvalue(r)) ? 0 : 1; + result = nvalue(l)-nvalue(r); else if (ttype(l) == LUA_T_STRING && ttype(r) == LUA_T_STRING) - result = strcomp(svalue(l), tsvalue(l)->u.s.len, - svalue(r), tsvalue(r)->u.s.len); + result = luaV_strcomp(svalue(l), tsvalue(l)->u.s.len, + svalue(r), tsvalue(r)->u.s.len); else { call_binTM(op, "unexpected type in comparison"); return; @@ -265,27 +286,16 @@ static void comparison (lua_Type ttype_less, lua_Type ttype_equal, } -void luaV_pack (StkId firstel, int nvararg, TObject *tab) -{ +void luaV_pack (StkId firstel, int nvararg, TObject *tab) { TObject *firstelem = L->stack.stack+firstel; int i; + Hash *htab; if (nvararg < 0) nvararg = 0; - avalue(tab) = luaH_new(nvararg+1); /* +1 for field 'n' */ + htab = avalue(tab) = luaH_new(nvararg+1); /* +1 for field 'n' */ ttype(tab) = LUA_T_ARRAY; - for (i=0; istack; /* to optimize */ - Byte *pc = tf->code; + register Byte *pc = tf->code; TObject *consts = tf->consts; - if (lua_callhook) + if (L->callhook) luaD_callHook(base, tf, 0); luaD_checkstack((*pc++)+EXTRA_STACK); if (*pc < ZEROVARARG) @@ -319,228 +328,159 @@ StkId luaV_execute (Closure *cl, TProtoFunc *tf, StkId base) luaC_checkGC(); adjust_varargs(base+(*pc++)-ZEROVARARG); } - while (1) { - int aux; - switch ((OpCode)(aux = *pc++)) { + for (;;) { + register int aux = 0; + switchentry: + switch ((OpCode)*pc++) { + + case ENDCODE: + S->top = S->stack + base; + goto ret; + + case RETCODE: + base += *pc++; + goto ret; - case PUSHNIL0: - ttype(S->top++) = LUA_T_NIL; + case CALL: aux = *pc++; + luaD_calln(*pc++, aux); break; - case PUSHNIL: - aux = *pc++; + case TAILCALL: aux = *pc++; + luaD_calln(*pc++, MULT_RET); + base += aux; + goto ret; + + case PUSHNIL: aux = *pc++; do { ttype(S->top++) = LUA_T_NIL; } while (aux--); break; - case PUSHNUMBER: - aux = *pc++; goto pushnumber; - - case PUSHNUMBERW: - aux = next_word(pc); goto pushnumber; + case POP: aux = *pc++; + S->top -= aux; + break; - case PUSHNUMBER0: case PUSHNUMBER1: case PUSHNUMBER2: - aux -= PUSHNUMBER0; - pushnumber: + case PUSHNUMBERW: aux += highbyte(*pc++); + case PUSHNUMBER: aux += *pc++; ttype(S->top) = LUA_T_NUMBER; nvalue(S->top) = aux; S->top++; break; - case PUSHLOCAL: - aux = *pc++; goto pushlocal; + case PUSHNUMBERNEGW: aux += highbyte(*pc++); + case PUSHNUMBERNEG: aux += *pc++; + ttype(S->top) = LUA_T_NUMBER; + nvalue(S->top) = -aux; + S->top++; + break; - case PUSHLOCAL0: case PUSHLOCAL1: case PUSHLOCAL2: case PUSHLOCAL3: - case PUSHLOCAL4: case PUSHLOCAL5: case PUSHLOCAL6: case PUSHLOCAL7: - aux -= PUSHLOCAL0; - pushlocal: - *S->top++ = *((S->stack+base) + aux); + case PUSHCONSTANTW: aux += highbyte(*pc++); + case PUSHCONSTANT: aux += *pc++; + *S->top++ = consts[aux]; break; - case GETGLOBALW: - aux = next_word(pc); goto getglobal; + case PUSHUPVALUE: aux = *pc++; + *S->top++ = cl->consts[aux+1]; + break; - case GETGLOBAL: - aux = *pc++; goto getglobal; + case PUSHLOCAL: aux = *pc++; + *S->top++ = *((S->stack+base) + aux); + break; - case GETGLOBAL0: case GETGLOBAL1: case GETGLOBAL2: case GETGLOBAL3: - case GETGLOBAL4: case GETGLOBAL5: case GETGLOBAL6: case GETGLOBAL7: - aux -= GETGLOBAL0; - getglobal: + case GETGLOBALW: aux += highbyte(*pc++); + case GETGLOBAL: aux += *pc++; luaV_getglobal(tsvalue(&consts[aux])); break; case GETTABLE: - luaV_gettable(); - break; - - case GETDOTTEDW: - aux = next_word(pc); goto getdotted; - - case GETDOTTED: - aux = *pc++; goto getdotted; + luaV_gettable(); + break; - case GETDOTTED0: case GETDOTTED1: case GETDOTTED2: case GETDOTTED3: - case GETDOTTED4: case GETDOTTED5: case GETDOTTED6: case GETDOTTED7: - aux -= GETDOTTED0; - getdotted: + case GETDOTTEDW: aux += highbyte(*pc++); + case GETDOTTED: aux += *pc++; *S->top++ = consts[aux]; luaV_gettable(); break; - case PUSHSELFW: - aux = next_word(pc); goto pushself; - - case PUSHSELF: - aux = *pc++; goto pushself; - - case PUSHSELF0: case PUSHSELF1: case PUSHSELF2: case PUSHSELF3: - case PUSHSELF4: case PUSHSELF5: case PUSHSELF6: case PUSHSELF7: - aux -= PUSHSELF0; - pushself: { - TObject receiver = *(S->top-1); + case PUSHSELFW: aux += highbyte(*pc++); + case PUSHSELF: aux += *pc++; { + TObject receiver; + receiver = *(S->top-1); *S->top++ = consts[aux]; luaV_gettable(); *S->top++ = receiver; break; } - case PUSHCONSTANTW: - aux = next_word(pc); goto pushconstant; - - case PUSHCONSTANT: - aux = *pc++; goto pushconstant; - - case PUSHCONSTANT0: case PUSHCONSTANT1: case PUSHCONSTANT2: - case PUSHCONSTANT3: case PUSHCONSTANT4: case PUSHCONSTANT5: - case PUSHCONSTANT6: case PUSHCONSTANT7: - aux -= PUSHCONSTANT0; - pushconstant: - *S->top++ = consts[aux]; - break; - - case PUSHUPVALUE: - aux = *pc++; goto pushupvalue; - - case PUSHUPVALUE0: case PUSHUPVALUE1: - aux -= PUSHUPVALUE0; - pushupvalue: - *S->top++ = cl->consts[aux+1]; + case CREATEARRAYW: aux += highbyte(*pc++); + case CREATEARRAY: aux += *pc++; + luaC_checkGC(); + avalue(S->top) = luaH_new(aux); + ttype(S->top) = LUA_T_ARRAY; + S->top++; break; - case SETLOCAL: - aux = *pc++; goto setlocal; - - case SETLOCAL0: case SETLOCAL1: case SETLOCAL2: case SETLOCAL3: - case SETLOCAL4: case SETLOCAL5: case SETLOCAL6: case SETLOCAL7: - aux -= SETLOCAL0; - setlocal: + case SETLOCAL: aux = *pc++; *((S->stack+base) + aux) = *(--S->top); break; - case SETGLOBALW: - aux = next_word(pc); goto setglobal; - - case SETGLOBAL: - aux = *pc++; goto setglobal; - - case SETGLOBAL0: case SETGLOBAL1: case SETGLOBAL2: case SETGLOBAL3: - case SETGLOBAL4: case SETGLOBAL5: case SETGLOBAL6: case SETGLOBAL7: - aux -= SETGLOBAL0; - setglobal: + case SETGLOBALW: aux += highbyte(*pc++); + case SETGLOBAL: aux += *pc++; luaV_setglobal(tsvalue(&consts[aux])); break; - case SETTABLE0: - luaV_settable(S->top-3, 1); - break; + case SETTABLEPOP: + luaV_settable(S->top-3); + S->top -= 2; /* pop table and index */ + break; case SETTABLE: - luaV_settable(S->top-3-(*pc++), 2); + luaV_settable(S->top-3-(*pc++)); break; - case SETLISTW: - aux = next_word(pc); aux *= LFIELDS_PER_FLUSH; goto setlist; - - case SETLIST: - aux = *(pc++) * LFIELDS_PER_FLUSH; goto setlist; - - case SETLIST0: - aux = 0; - setlist: { + case SETLISTW: aux += highbyte(*pc++); + case SETLIST: aux += *pc++; { int n = *(pc++); - TObject *arr = S->top-n-1; - for (; n; n--) { - ttype(S->top) = LUA_T_NUMBER; - nvalue(S->top) = n+aux; - *(luaH_set(avalue(arr), S->top)) = *(S->top-1); - S->top--; - } + Hash *arr = avalue(S->top-n-1); + aux *= LFIELDS_PER_FLUSH; + for (; n; n--) + luaH_setint(arr, n+aux, --S->top); break; } - case SETMAP0: - aux = 0; goto setmap; - - case SETMAP: - aux = *pc++; - setmap: { - TObject *arr = S->top-(2*aux)-3; + case SETMAP: aux = *pc++; { + Hash *arr = avalue(S->top-(2*aux)-3); do { - *(luaH_set(avalue(arr), S->top-2)) = *(S->top-1); + luaH_set(arr, S->top-2, S->top-1); S->top-=2; } while (aux--); break; } - case POP: - aux = *pc++; goto pop; - - case POP0: case POP1: - aux -= POP0; - pop: - S->top -= (aux+1); - break; - - case CREATEARRAYW: - aux = next_word(pc); goto createarray; - - case CREATEARRAY0: case CREATEARRAY1: - aux -= CREATEARRAY0; goto createarray; - - case CREATEARRAY: - aux = *pc++; - createarray: - luaC_checkGC(); - avalue(S->top) = luaH_new(aux); - ttype(S->top) = LUA_T_ARRAY; - S->top++; - break; - - case EQOP: case NEQOP: { + case NEQOP: aux = 1; + case EQOP: { int res = luaO_equalObj(S->top-2, S->top-1); + if (aux) res = !res; S->top--; - if (aux == NEQOP) res = !res; ttype(S->top-1) = res ? LUA_T_NUMBER : LUA_T_NIL; nvalue(S->top-1) = 1; break; } case LTOP: - comparison(LUA_T_NUMBER, LUA_T_NIL, LUA_T_NIL, IM_LT); + luaV_comparison(LUA_T_NUMBER, LUA_T_NIL, LUA_T_NIL, IM_LT); break; case LEOP: - comparison(LUA_T_NUMBER, LUA_T_NUMBER, LUA_T_NIL, IM_LE); + luaV_comparison(LUA_T_NUMBER, LUA_T_NUMBER, LUA_T_NIL, IM_LE); break; case GTOP: - comparison(LUA_T_NIL, LUA_T_NIL, LUA_T_NUMBER, IM_GT); + luaV_comparison(LUA_T_NIL, LUA_T_NIL, LUA_T_NUMBER, IM_GT); break; case GEOP: - comparison(LUA_T_NIL, LUA_T_NUMBER, LUA_T_NUMBER, IM_GE); + luaV_comparison(LUA_T_NIL, LUA_T_NUMBER, LUA_T_NUMBER, IM_GE); break; case ADDOP: { @@ -624,98 +564,47 @@ StkId luaV_execute (Closure *cl, TProtoFunc *tf, StkId base) nvalue(S->top-1) = 1; break; - case ONTJMPW: - aux = next_word(pc); goto ontjmp; - - case ONTJMP: - aux = *pc++; - ontjmp: + case ONTJMPW: aux += highbyte(*pc++); + case ONTJMP: aux += *pc++; if (ttype(S->top-1) != LUA_T_NIL) pc += aux; else S->top--; break; - case ONFJMPW: - aux = next_word(pc); goto onfjmp; - - case ONFJMP: - aux = *pc++; - onfjmp: + case ONFJMPW: aux += highbyte(*pc++); + case ONFJMP: aux += *pc++; if (ttype(S->top-1) == LUA_T_NIL) pc += aux; else S->top--; break; - case JMPW: - aux = next_word(pc); goto jmp; - - case JMP: - aux = *pc++; - jmp: + case JMPW: aux += highbyte(*pc++); + case JMP: aux += *pc++; pc += aux; break; - case IFFJMPW: - aux = next_word(pc); goto iffjmp; - - case IFFJMP: - aux = *pc++; - iffjmp: + case IFFJMPW: aux += highbyte(*pc++); + case IFFJMP: aux += *pc++; if (ttype(--S->top) == LUA_T_NIL) pc += aux; break; - case IFTUPJMPW: - aux = next_word(pc); goto iftupjmp; - - case IFTUPJMP: - aux = *pc++; - iftupjmp: + case IFTUPJMPW: aux += highbyte(*pc++); + case IFTUPJMP: aux += *pc++; if (ttype(--S->top) != LUA_T_NIL) pc -= aux; break; - case IFFUPJMPW: - aux = next_word(pc); goto iffupjmp; - - case IFFUPJMP: - aux = *pc++; - iffupjmp: + case IFFUPJMPW: aux += highbyte(*pc++); + case IFFUPJMP: aux += *pc++; if (ttype(--S->top) == LUA_T_NIL) pc -= aux; break; - case CLOSUREW: - aux = next_word(pc); goto closure; - - case CLOSURE: - aux = *pc++; - closure: + case CLOSUREW: aux += highbyte(*pc++); + case CLOSURE: aux += *pc++; *S->top++ = consts[aux]; luaV_closure(*pc++); luaC_checkGC(); break; - case CALLFUNC: - aux = *pc++; goto callfunc; - - case CALLFUNC0: case CALLFUNC1: - aux -= CALLFUNC0; - callfunc: { - StkId newBase = (S->top-S->stack)-(*pc++); - luaD_call(newBase, aux); - break; - } - - case ENDCODE: - S->top = S->stack + base; - /* goes through */ - case RETCODE: - if (lua_callhook) - luaD_callHook(base, NULL, 1); - return (base + ((aux==RETCODE) ? *pc : 0)); - - case SETLINEW: - aux = next_word(pc); goto setline; - - case SETLINE: - aux = *pc++; - setline: + case SETLINEW: aux += highbyte(*pc++); + case SETLINE: aux += *pc++; if ((S->stack+base-1)->ttype != LUA_T_LINE) { /* open space for LINE value */ luaD_openstack((S->top-S->stack)-base); @@ -723,15 +612,24 @@ StkId luaV_execute (Closure *cl, TProtoFunc *tf, StkId base) (S->stack+base-1)->ttype = LUA_T_LINE; } (S->stack+base-1)->value.i = aux; - if (lua_linehook) + if (L->linehook) luaD_lineHook(aux); break; -#ifdef DEBUG - default: - LUA_INTERNALERROR("opcode doesn't match"); -#endif + case LONGARGW: aux += highbyte(*pc++); + case LONGARG: aux += *pc++; + aux = highbyte(highbyte(aux)); + goto switchentry; /* do not reset "aux" */ + + case CHECKSTACK: aux = *pc++; + LUA_ASSERT((S->top-S->stack)-base == aux && S->last >= S->top, + "wrong stack size"); + break; + } - } + } ret: + if (L->callhook) + luaD_callHook(0, NULL, 1); + return base; } diff --git a/src/lvm.h b/src/lvm.h index 9b3f900..d6a639e 100644 --- a/src/lvm.h +++ b/src/lvm.h @@ -1,5 +1,5 @@ /* -** $Id: lvm.h,v 1.4 1997/12/15 16:17:20 roberto Exp $ +** $Id: lvm.h,v 1.8 1999/02/08 17:07:59 roberto Exp $ ** Lua virtual machine ** See Copyright Notice in lua.h */ @@ -10,6 +10,7 @@ #include "ldo.h" #include "lobject.h" +#include "ltm.h" #define tonumber(o) ((ttype(o) != LUA_T_NUMBER) && (luaV_tonumber(o) != 0)) @@ -19,11 +20,15 @@ void luaV_pack (StkId firstel, int nvararg, TObject *tab); int luaV_tonumber (TObject *obj); int luaV_tostring (TObject *obj); +void luaV_setn (Hash *t, int val); void luaV_gettable (void); -void luaV_settable (TObject *t, int mode); +void luaV_settable (TObject *t); +void luaV_rawsettable (TObject *t); void luaV_getglobal (TaggedString *ts); void luaV_setglobal (TaggedString *ts); StkId luaV_execute (Closure *cl, TProtoFunc *tf, StkId base); void luaV_closure (int nelems); +void luaV_comparison (lua_Type ttype_less, lua_Type ttype_equal, + lua_Type ttype_great, IMS op); #endif diff --git a/src/lzio.c b/src/lzio.c index 0ab1adf..865d9c5 100644 --- a/src/lzio.c +++ b/src/lzio.c @@ -1,5 +1,5 @@ /* -** $Id: lzio.c,v 1.3 1997/12/22 20:57:18 roberto Exp $ +** $Id: lzio.c,v 1.7 1999/03/05 13:15:50 roberto Exp $ ** a generic input stream interface ** See Copyright Notice in lua.h */ @@ -15,11 +15,11 @@ /* ----------------------------------------------------- memory buffers --- */ -static int zmfilbuf (ZIO* z) -{ +static int zmfilbuf (ZIO* z) { return EOZ; } + ZIO* zmopen (ZIO* z, char* b, int size, char *name) { if (b==NULL) return NULL; @@ -41,9 +41,10 @@ ZIO* zsopen (ZIO* z, char* s, char *name) /* -------------------------------------------------------------- FILEs --- */ -static int zffilbuf (ZIO* z) -{ - int n=fread(z->buffer,1,ZBSIZE,z->u); +static int zffilbuf (ZIO* z) { + int n; + if (feof((FILE *)z->u)) return EOZ; + n=fread(z->buffer,1,ZBSIZE,z->u); if (n==0) return EOZ; z->n=n-1; z->p=z->buffer; @@ -64,16 +65,15 @@ ZIO* zFopen (ZIO* z, FILE* f, char *name) /* --------------------------------------------------------------- read --- */ -int zread (ZIO *z, void *b, int n) -{ +int zread (ZIO *z, void *b, int n) { while (n) { int m; if (z->n == 0) { if (z->filbuf(z) == EOZ) - return n; /* retorna quantos faltaram ler */ - zungetc(z); /* poe o resultado de filbuf no buffer */ + return n; /* return number of missing bytes */ + zungetc(z); /* put result from 'filbuf' in the buffer */ } - m = (n <= z->n) ? n : z->n; /* minimo de n e z->n */ + m = (n <= z->n) ? n : z->n; /* min. between n and z->n */ memcpy(b, z->p, m); z->n -= m; z->p += m; -- 2.11.4.GIT