picolisp

Unnamed repository; edit this file to name it for gitweb.
git clone https://logand.com/git/picolisp.git/
Log | Files | Refs | README | LICENSE

commit e909fb2ea80afc28f95fae8eeee4a195ea1dcfcd
parent c1e11bfd250c23f82ef02ff3660977b221fe9f54
Author: Alexander Burger <abu@software-lab.de>
Date:   Sun,  6 Feb 2011 09:01:09 +0100

Disallow null-bytes "..^@.." in symbol names
Diffstat:
Mersatz/picolisp.jar | 0
Mersatz/sys.src | 7+++++--
Mlib/tags | 80++++++++++++++++++++++++++++++++++++++++----------------------------------------
Msrc/io.c | 7+++++--
Msrc64/io.l | 4+++-
Msrc64/version.l | 4++--
6 files changed, 55 insertions(+), 47 deletions(-)

diff --git a/ersatz/picolisp.jar b/ersatz/picolisp.jar Binary files differ. diff --git a/ersatz/sys.src b/ersatz/sys.src @@ -1,4 +1,4 @@ -// 03feb11abu +// 06feb11abu // (c) Software Lab. Alexander Burger import java.util.*; @@ -1342,6 +1342,7 @@ public class PicoLisp { } final void eofErr() {err(null, null, "EOF Overrun");} + final void badInput() {err(null, null, "Bad input '" + (char)Chr + "'");} final int get() { try { @@ -1422,6 +1423,8 @@ public class PicoLisp { return false; if (Chr == '^') { get(); + if (Chr == '@') + badInput(); if (Chr == '?') Chr = 127; else @@ -1558,7 +1561,7 @@ public class PicoLisp { return mkSymbol(null, sb.toString(), Transient); } if (Chr == ')' || Chr == ']' || Chr == '~') - err(null, null, "Bad input '" + (char)Chr + "' (" + Chr + ')'); + badInput(); if (Chr == '\\') get(); int i = Chr; diff --git a/lib/tags b/lib/tags @@ -29,7 +29,7 @@ adr (606 . "@src64/main.l") alarm (480 . "@src64/main.l") all (772 . "@src64/sym.l") and (1621 . "@src64/flow.l") -any (3877 . "@src64/io.l") +any (3879 . "@src64/io.l") append (1338 . "@src64/subr.l") apply (713 . "@src64/apply.l") arg (2267 . "@src64/main.l") @@ -82,12 +82,12 @@ cdddr (245 . "@src64/subr.l") cddr (79 . "@src64/subr.l") cdr (17 . "@src64/subr.l") chain (1141 . "@src64/subr.l") -char (3359 . "@src64/io.l") +char (3361 . "@src64/io.l") chop (1093 . "@src64/sym.l") circ (816 . "@src64/subr.l") circ? (2398 . "@src64/subr.l") clip (1795 . "@src64/subr.l") -close (4265 . "@src64/io.l") +close (4267 . "@src64/io.l") cmd (2870 . "@src64/main.l") cnt (1413 . "@src64/apply.l") co (2544 . "@src64/flow.l") @@ -98,7 +98,7 @@ cond (1916 . "@src64/flow.l") connect (201 . "@src64/net.l") cons (747 . "@src64/subr.l") copy (1225 . "@src64/subr.l") -ctl (4205 . "@src64/io.l") +ctl (4207 . "@src64/io.l") ctty (2668 . "@src64/main.l") cut (1797 . "@src64/sym.l") date (2382 . "@src64/main.l") @@ -115,13 +115,13 @@ dir (2801 . "@src64/main.l") dm (543 . "@src64/flow.l") do (2136 . "@src64/flow.l") e (2904 . "@src64/flow.l") -echo (4296 . "@src64/io.l") +echo (4298 . "@src64/io.l") env (618 . "@src64/main.l") -eof (3436 . "@src64/io.l") -eol (3427 . "@src64/io.l") +eof (3438 . "@src64/io.l") +eol (3429 . "@src64/io.l") errno (1378 . "@src64/main.l") eval (182 . "@src64/flow.l") -ext (5026 . "@src64/io.l") +ext (5028 . "@src64/io.l") ext? (1034 . "@src64/sym.l") extern (900 . "@src64/sym.l") extra (1263 . "@src64/flow.l") @@ -136,13 +136,13 @@ find (1322 . "@src64/apply.l") fish (1613 . "@src64/apply.l") flg? (2441 . "@src64/subr.l") flip (1695 . "@src64/subr.l") -flush (5001 . "@src64/io.l") +flush (5003 . "@src64/io.l") fold (3343 . "@src64/sym.l") for (2225 . "@src64/flow.l") fork (3248 . "@src64/flow.l") format (2089 . "@src64/big.l") free (2047 . "@src64/db.l") -from (3455 . "@src64/io.l") +from (3457 . "@src64/io.l") full (1075 . "@src64/subr.l") fun? (734 . "@src64/sym.l") gc (429 . "@src64/gc.l") @@ -154,14 +154,14 @@ glue (1234 . "@src64/sym.l") gt0 (2716 . "@src64/big.l") head (1816 . "@src64/subr.l") heap (535 . "@src64/main.l") -hear (3140 . "@src64/io.l") +hear (3142 . "@src64/io.l") host (184 . "@src64/net.l") id (1027 . "@src64/db.l") idx (2037 . "@src64/sym.l") if (1802 . "@src64/flow.l") if2 (1821 . "@src64/flow.l") ifn (1862 . "@src64/flow.l") -in (4101 . "@src64/io.l") +in (4103 . "@src64/io.l") inc (2256 . "@src64/big.l") index (2633 . "@src64/subr.l") info (2705 . "@src64/main.l") @@ -170,7 +170,7 @@ ipid (3193 . "@src64/flow.l") isa (959 . "@src64/flow.l") job (1426 . "@src64/flow.l") journal (970 . "@src64/db.l") -key (3288 . "@src64/io.l") +key (3290 . "@src64/io.l") kill (3225 . "@src64/flow.l") last (2040 . "@src64/subr.l") le0 (2691 . "@src64/big.l") @@ -178,14 +178,14 @@ length (2737 . "@src64/subr.l") let (1476 . "@src64/flow.l") let? (1537 . "@src64/flow.l") lieu (1156 . "@src64/db.l") -line (3611 . "@src64/io.l") -lines (3764 . "@src64/io.l") +line (3613 . "@src64/io.l") +lines (3766 . "@src64/io.l") link (1172 . "@src64/subr.l") lisp (1945 . "@src64/main.l") list (887 . "@src64/subr.l") listen (151 . "@src64/net.l") lit (157 . "@src64/flow.l") -load (4078 . "@src64/io.l") +load (4080 . "@src64/io.l") lock (1184 . "@src64/db.l") loop (2168 . "@src64/flow.l") low? (3215 . "@src64/sym.l") @@ -235,30 +235,30 @@ offset (2673 . "@src64/subr.l") on (1583 . "@src64/sym.l") onOff (1613 . "@src64/sym.l") one (1646 . "@src64/sym.l") -open (4227 . "@src64/io.l") +open (4229 . "@src64/io.l") opid (3209 . "@src64/flow.l") opt (2991 . "@src64/main.l") or (1637 . "@src64/flow.l") -out (4121 . "@src64/io.l") +out (4123 . "@src64/io.l") pack (1144 . "@src64/sym.l") pair (2390 . "@src64/subr.l") pass (754 . "@src64/apply.l") pat? (720 . "@src64/sym.l") path (1238 . "@src64/io.l") -peek (3343 . "@src64/io.l") +peek (3345 . "@src64/io.l") pick (1369 . "@src64/apply.l") -pipe (4142 . "@src64/io.l") -poll (3232 . "@src64/io.l") +pipe (4144 . "@src64/io.l") +poll (3234 . "@src64/io.l") pool (648 . "@src64/db.l") pop (1773 . "@src64/sym.l") port (5 . "@src64/net.l") -pr (5109 . "@src64/io.l") +pr (5111 . "@src64/io.l") pre? (1411 . "@src64/sym.l") -prin (4925 . "@src64/io.l") -prinl (4939 . "@src64/io.l") -print (4965 . "@src64/io.l") -println (4996 . "@src64/io.l") -printsp (4981 . "@src64/io.l") +prin (4927 . "@src64/io.l") +prinl (4941 . "@src64/io.l") +print (4967 . "@src64/io.l") +println (4998 . "@src64/io.l") +printsp (4983 . "@src64/io.l") prior (2709 . "@src64/subr.l") prog (1757 . "@src64/flow.l") prog1 (1765 . "@src64/flow.l") @@ -278,15 +278,15 @@ rand (2973 . "@src64/big.l") range (997 . "@src64/subr.l") rank (3029 . "@src64/subr.l") raw (458 . "@src64/main.l") -rd (5043 . "@src64/io.l") -read (2571 . "@src64/io.l") +rd (5045 . "@src64/io.l") +read (2573 . "@src64/io.l") replace (1499 . "@src64/subr.l") rest (2296 . "@src64/main.l") reverse (1674 . "@src64/subr.l") -rewind (5009 . "@src64/io.l") +rewind (5011 . "@src64/io.l") rollback (1890 . "@src64/db.l") rot (848 . "@src64/subr.l") -rpc (5142 . "@src64/io.l") +rpc (5144 . "@src64/io.l") run (313 . "@src64/flow.l") sect (2537 . "@src64/subr.l") seed (2958 . "@src64/big.l") @@ -297,31 +297,31 @@ set (1482 . "@src64/sym.l") setq (1515 . "@src64/sym.l") sigio (496 . "@src64/main.l") size (2802 . "@src64/subr.l") -skip (3413 . "@src64/io.l") +skip (3415 . "@src64/io.l") sort (3958 . "@src64/subr.l") sp? (711 . "@src64/sym.l") -space (4943 . "@src64/io.l") +space (4945 . "@src64/io.l") split (1588 . "@src64/subr.l") stack (564 . "@src64/main.l") state (2006 . "@src64/flow.l") stem (1985 . "@src64/subr.l") -str (3931 . "@src64/io.l") +str (3933 . "@src64/io.l") str? (1013 . "@src64/sym.l") strip (1572 . "@src64/subr.l") sub? (1444 . "@src64/sym.l") sum (1460 . "@src64/apply.l") super (1218 . "@src64/flow.l") -sym (3917 . "@src64/io.l") +sym (3919 . "@src64/io.l") sym? (2430 . "@src64/subr.l") -sync (3100 . "@src64/io.l") +sync (3102 . "@src64/io.l") sys (3045 . "@src64/flow.l") t (1748 . "@src64/flow.l") tail (1907 . "@src64/subr.l") -tell (3172 . "@src64/io.l") +tell (3174 . "@src64/io.l") text (1272 . "@src64/sym.l") throw (2488 . "@src64/flow.l") tick (3161 . "@src64/flow.l") -till (3522 . "@src64/io.l") +till (3524 . "@src64/io.l") time (2515 . "@src64/main.l") touch (1049 . "@src64/sym.l") trim (1755 . "@src64/subr.l") @@ -338,12 +338,12 @@ use (1570 . "@src64/flow.l") usec (2620 . "@src64/main.l") val (1463 . "@src64/sym.l") version (3005 . "@src64/main.l") -wait (3062 . "@src64/io.l") +wait (3064 . "@src64/io.l") when (1881 . "@src64/flow.l") while (2058 . "@src64/flow.l") wipe (3090 . "@src64/sym.l") with (1327 . "@src64/flow.l") -wr (5126 . "@src64/io.l") +wr (5128 . "@src64/io.l") xchg (1538 . "@src64/sym.l") xor (1698 . "@src64/flow.l") x| (2885 . "@src64/big.l") diff --git a/src/io.c b/src/io.c @@ -1,4 +1,4 @@ -/* 19jan11abu +/* 05feb11abu * (c) Software Lab. Alexander Burger */ @@ -27,6 +27,7 @@ static byte TBuf[] = {INTERN+4, 'T'}; static void openErr(any ex, char *s) {err(ex, NULL, "%s open: %s", s, strerror(errno));} static void closeErr(void) {err(NULL, NULL, "Close error: %s", strerror(errno));} static void eofErr(void) {err(NULL, NULL, "EOF Overrun");} +static void badInput(void) {err(NULL, NULL, "Bad input '%c'", Chr);} static void badFd(any ex, any x) {err(ex, x, "Bad FD");} static void lockErr(void) {err(NULL, NULL, "File lock: %s", strerror(errno));} static void writeErr(char *s) {err(NULL, NULL, "%s write: %s", s, strerror(errno));} @@ -987,6 +988,8 @@ static bool testEsc(void) { return NO; if (Chr == '^') { Env.get(); + if (Chr == '@') + badInput(); if (Chr == '?') Chr = 127; else @@ -1201,7 +1204,7 @@ static any read0(bool top) { return x; } if (Chr == ')' || Chr == ']' || Chr == '~') - err(NULL, NULL, "Bad input '%c' (%d)", isprint(Chr)? Chr:'?', Chr); + badInput(); if (Chr == '\\') Env.get(); i = Chr; diff --git a/src64/io.l b/src64/io.l @@ -1,4 +1,4 @@ -# 19jan11abu +# 05feb11abu # (c) Software Lab. Alexander Burger # Close file descriptor @@ -1995,6 +1995,8 @@ cmp B (char "\^") # Caret? if eq # Yes call (Get_A) # Skip '^' + cmp B (char "@") # At-mark? + jeq badInputErrB # Yes cmp B (char "?") # Question-mark? if eq # Yes ld B 127 # DEL diff --git a/src64/version.l b/src64/version.l @@ -1,6 +1,6 @@ -# 03feb11abu +# 06feb11abu # (c) Software Lab. Alexander Burger -(de *Version 3 0 5 12) +(de *Version 3 0 5 13) # vi:et:ts=3:sw=3