Annotation of 43BSDReno/contrib/emacs-18.55/src/lread.c, revision 1.1

1.1     ! root        1: /* Lisp parsing and input streams.
        !             2:    Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc.
        !             3: 
        !             4: This file is part of GNU Emacs.
        !             5: 
        !             6: GNU Emacs is distributed in the hope that it will be useful,
        !             7: but WITHOUT ANY WARRANTY.  No author or distributor
        !             8: accepts responsibility to anyone for the consequences of using it
        !             9: or for whether it serves any particular purpose or works at all,
        !            10: unless he says so in writing.  Refer to the GNU Emacs General Public
        !            11: License for full details.
        !            12: 
        !            13: Everyone is granted permission to copy, modify and redistribute
        !            14: GNU Emacs, but only under the conditions described in the
        !            15: GNU Emacs General Public License.   A copy of this license is
        !            16: supposed to have been given to you along with GNU Emacs so you
        !            17: can know your rights and responsibilities.  It should be in a
        !            18: file named COPYING.  Among other things, the copyright notice
        !            19: and this notice must be preserved on all copies.  */
        !            20: 
        !            21: 
        !            22: #include <stdio.h>
        !            23: #include <sys/types.h>
        !            24: #include <sys/stat.h>
        !            25: #include <sys/file.h>
        !            26: #undef NULL
        !            27: #include "config.h"
        !            28: #include "lisp.h"
        !            29: 
        !            30: #ifndef standalone
        !            31: #include "buffer.h"
        !            32: #include "paths.h"
        !            33: #endif
        !            34: 
        !            35: #ifdef lint
        !            36: #include <sys/inode.h>
        !            37: #endif /* lint */
        !            38: 
        !            39: #ifndef X_OK
        !            40: #define X_OK 01
        !            41: #endif
        !            42: 
        !            43: Lisp_Object Qread_char, Qget_file_char, Qstandard_input;
        !            44: Lisp_Object Qvariable_documentation, Vvalues, Vstandard_input;
        !            45: 
        !            46: /* non-zero if inside `load' */
        !            47: int load_in_progress;
        !            48: 
        !            49: /* Search path for files to be loaded. */
        !            50: Lisp_Object Vload_path;
        !            51: 
        !            52: /* File for get_file_char to read from.  Use by load */
        !            53: static FILE *instream;
        !            54: 
        !            55: /* When nonzero, read conses in pure space */
        !            56: static int read_pure;
        !            57: 
        !            58: /* For use within read-from-string (this reader is non-reentrant!!) */
        !            59: static int read_from_string_index;
        !            60: static int read_from_string_limit;
        !            61: 
        !            62: /* Handle unreading and rereading of characters.
        !            63:  Write READCHAR to read a character, UNREAD(c) to unread c to be read again. */
        !            64: 
        !            65: static int unrch;
        !            66: 
        !            67: static int readchar (readcharfun)
        !            68:      Lisp_Object readcharfun;
        !            69: {
        !            70:   Lisp_Object tem;
        !            71:   register struct buffer_text *inbuffer;
        !            72:   register int c, mpos;
        !            73: 
        !            74:   if (unrch >= 0)
        !            75:     {
        !            76:       c = unrch;
        !            77:       unrch = -1;
        !            78:       return c;
        !            79:     }
        !            80:   if (XTYPE (readcharfun) == Lisp_Buffer)
        !            81:     {
        !            82:       if (XBUFFER (readcharfun) == bf_cur)
        !            83:        inbuffer = &bf_text;
        !            84:       else
        !            85:        inbuffer = &XBUFFER (readcharfun)->text;
        !            86: 
        !            87:       if (inbuffer->pointloc >
        !            88:          inbuffer->size1 + inbuffer->size2 - inbuffer->tail_clip)
        !            89:        return -1;
        !            90:       c = *(unsigned char *) &(inbuffer->pointloc > inbuffer->size1 ? inbuffer->p2 : inbuffer->p1)[inbuffer->pointloc];
        !            91:       inbuffer->pointloc++;
        !            92:       return c;
        !            93:     }
        !            94:   if (XTYPE (readcharfun) == Lisp_Marker)
        !            95:     {
        !            96:       if (XMARKER (readcharfun)->buffer == bf_cur)
        !            97:        inbuffer = &bf_text;
        !            98:       else
        !            99:        inbuffer = &XMARKER (readcharfun)->buffer->text;
        !           100:       mpos = marker_position (readcharfun);
        !           101: 
        !           102:       if (mpos >
        !           103:          inbuffer->size1 + inbuffer->size2 - inbuffer->tail_clip)
        !           104:        return -1;
        !           105:       c = *(unsigned char *) &(mpos > inbuffer->size1 ? inbuffer->p2 : inbuffer->p1)[mpos];
        !           106:       if (mpos != inbuffer->size1 + 1)
        !           107:        XMARKER (readcharfun)->bufpos++;
        !           108:       else
        !           109:        Fset_marker (readcharfun, make_number (mpos + 1),
        !           110:                     Fmarker_buffer (readcharfun));
        !           111:       return c;
        !           112:     }
        !           113:   if (EQ (readcharfun, Qget_file_char))
        !           114:     return getc (instream);
        !           115: 
        !           116:   if (XTYPE (readcharfun) == Lisp_String)
        !           117:     {
        !           118:       register int c;
        !           119:       /* This used to be return of a conditional expression,
        !           120:         but that truncated -1 to a char on VMS.  */
        !           121:       if (read_from_string_index < read_from_string_limit)
        !           122:        c = XSTRING (readcharfun)->data[read_from_string_index++];
        !           123:       else
        !           124:        c = -1;
        !           125:       return c;
        !           126:     }
        !           127: 
        !           128:   tem = call0 (readcharfun);
        !           129: 
        !           130:   if (NULL (tem))
        !           131:     return -1;
        !           132:   return XINT (tem);
        !           133: }
        !           134: 
        !           135: #define READCHAR readchar(readcharfun)
        !           136: #define UNREAD(c) (unrch = c)
        !           137: 
        !           138: static Lisp_Object read0 (), read1 (), read_list (), read_vector ();
        !           139: 
        !           140: /* get a character from the tty */
        !           141: 
        !           142: DEFUN ("read-char", Fread_char, Sread_char, 0, 0, 0,
        !           143:   "Read a character from the command input (keyboard or macro).\n\
        !           144: It is returned as a number.")
        !           145:   ()
        !           146: {
        !           147:   register Lisp_Object val;
        !           148: 
        !           149: #ifndef standalone
        !           150:   XSET (val, Lisp_Int, get_char (0));
        !           151: #else
        !           152:   XSET (val, Lisp_Int, getchar ());
        !           153: #endif
        !           154: 
        !           155:   return val;
        !           156: }
        !           157: 
        !           158: DEFUN ("get-file-char", Fget_file_char, Sget_file_char, 0, 0, 0,
        !           159:   "Don't use this yourself.")
        !           160:   ()
        !           161: {
        !           162:   register Lisp_Object val;
        !           163:   XSET (val, Lisp_Int, getc (instream));
        !           164:   return val;
        !           165: }
        !           166: 
        !           167: void readevalloop ();
        !           168: static Lisp_Object load_unwind ();
        !           169: 
        !           170: DEFUN ("load", Fload, Sload, 1, 4, 0,
        !           171:   "Execute a file of Lisp code named FILE.\n\
        !           172: First tries FILE with .elc appended, then tries with .el,\n\
        !           173:  then tries FILE unmodified.  Searches directories in  load-path.\n\
        !           174: If optional second arg MISSING-OK is non-nil,\n\
        !           175:  report no error if FILE doesn't exist.\n\
        !           176: Print messages at start and end of loading unless\n\
        !           177:  optional third arg NOMESSAGE is non-nil.\n\
        !           178: If optional fourth arg NOSUFFIX is non-nil, don't try adding\n\
        !           179:  suffixes .elc or .el to the specified name FILE.\n\
        !           180: Return t if file exists.")
        !           181:   (str, missing_ok, nomessage, nosuffix)
        !           182:      Lisp_Object str, missing_ok, nomessage, nosuffix;
        !           183: {
        !           184:   register FILE *stream;
        !           185:   register int fd = -1;
        !           186:   register Lisp_Object lispstream;
        !           187:   register FILE **ptr;
        !           188:   int count = specpdl_ptr - specpdl;
        !           189:   struct gcpro gcpro1;
        !           190: 
        !           191:   CHECK_STRING (str, 0);
        !           192:   str = Fsubstitute_in_file_name (str);
        !           193: 
        !           194:   /* Avoid weird lossage with null string as arg,
        !           195:      since it would try to load a directory as a Lisp file */
        !           196:   if (XSTRING (str)->size > 0)
        !           197:     {
        !           198:       fd = openp (Vload_path, str, !NULL (nosuffix) ? "" : ".elc:.el:", 0, 0);
        !           199:     }
        !           200: 
        !           201:   if (fd < 0)
        !           202:     if (NULL (missing_ok))
        !           203:       while (1)
        !           204:        Fsignal (Qfile_error, Fcons (build_string ("Cannot open load file"),
        !           205:                                     Fcons (str, Qnil)));
        !           206:     else return Qnil;
        !           207: 
        !           208:   stream = fdopen (fd, "r");
        !           209:   if (stream == 0)
        !           210:     {
        !           211:       close (fd);
        !           212:       error ("Failure to create stdio stream for %s", XSTRING (str)->data);
        !           213:     }
        !           214: 
        !           215:   if (NULL (nomessage))
        !           216:     message ("Loading %s...", XSTRING (str)->data);
        !           217: 
        !           218:   GCPRO1 (str);
        !           219:   ptr = (FILE **) xmalloc (sizeof (FILE *));
        !           220:   *ptr = stream;
        !           221:   XSET (lispstream, Lisp_Internal_Stream, (int) ptr);
        !           222:   record_unwind_protect (load_unwind, lispstream);
        !           223:   load_in_progress++;
        !           224:   readevalloop (Qget_file_char, stream, Feval, 0);
        !           225:   unbind_to (count);
        !           226:   UNGCPRO;
        !           227: 
        !           228:   if (!noninteractive && NULL (nomessage))
        !           229:     message ("Loading %s...done", XSTRING (str)->data);
        !           230:   return Qt;
        !           231: }
        !           232: 
        !           233: static Lisp_Object
        !           234: load_unwind (stream)  /* used as unwind-protect function in load */
        !           235:      Lisp_Object stream;
        !           236: {
        !           237:   fclose (*(FILE **) XSTRING (stream));
        !           238:   if (--load_in_progress < 0) load_in_progress = 0;
        !           239:   return Qnil;
        !           240: }
        !           241: 
        !           242: 
        !           243: static int
        !           244: absolute_filename_p (pathname)
        !           245:      Lisp_Object pathname;
        !           246: {
        !           247:   register unsigned char *s = XSTRING (pathname)->data;
        !           248:   return (*s == '~' || *s == '/'
        !           249: #ifdef VMS
        !           250:          || index (s, ':')
        !           251: #endif /* VMS */
        !           252:          );
        !           253: }
        !           254: 
        !           255: /* Search for a file whose name is STR, looking in directories
        !           256:    in the Lisp list PATH, and trying suffixes from SUFFIX.
        !           257:    SUFFIX is a string containing possible suffixes separated by colons.
        !           258:    On success, returns a file descriptor.  On failure, returns -1.
        !           259: 
        !           260:    EXEC_ONLY nonzero means don't open the files,
        !           261:    just look for one that is executable.  In this case,
        !           262:    returns 1 on success.
        !           263: 
        !           264:    If STOREPTR is nonzero, it points to a slot where the name of
        !           265:    the file actually found should be stored as a Lisp string.
        !           266:    Nil is stored there on failure.  */
        !           267: 
        !           268: int
        !           269: openp (path, str, suffix, storeptr, exec_only)
        !           270:      Lisp_Object path, str;
        !           271:      char *suffix;
        !           272:      Lisp_Object *storeptr;
        !           273:      int exec_only;
        !           274: {
        !           275:   register int fd;
        !           276:   int fn_size = 100;
        !           277:   char buf[100];
        !           278:   register char *fn = buf;
        !           279:   int absolute = 0;
        !           280:   int want_size;
        !           281:   register Lisp_Object filename;
        !           282:   struct stat st;
        !           283: 
        !           284:   if (storeptr)
        !           285:     *storeptr = Qnil;
        !           286: 
        !           287:   if (absolute_filename_p (str))
        !           288:     absolute = 1;
        !           289: 
        !           290:   for (; !NULL (path); path = Fcdr (path))
        !           291:     {
        !           292:       char *nsuffix;
        !           293: 
        !           294:       filename = Fexpand_file_name (str, Fcar (path));
        !           295:       if (!absolute_filename_p (filename))
        !           296:        /* If there are non-absolute elts in PATH (eg ".") */
        !           297:        /* Of course, this could conceivably lose if luser sets
        !           298:           default-directory to be something non-absolute... */
        !           299:        {
        !           300:          filename = Fexpand_file_name (filename, bf_cur->directory);
        !           301:          if (!absolute_filename_p (filename))
        !           302:            /* Give up on this path element! */
        !           303:            continue;
        !           304:        }
        !           305: 
        !           306:       /* Calculate maximum size of any filename made from
        !           307:         this path element/specified file name and any possible suffix.  */
        !           308:       want_size = strlen (suffix) + XSTRING (filename)->size + 1;
        !           309:       if (fn_size < want_size)
        !           310:        fn = (char *) alloca (fn_size = 100 + want_size);
        !           311: 
        !           312:       nsuffix = suffix;
        !           313: 
        !           314:       /* Loop over suffixes.  */
        !           315:       while (1)
        !           316:        {
        !           317:          char *esuffix = (char *) index (nsuffix, ':');
        !           318:          int lsuffix = esuffix ? esuffix - nsuffix : strlen (nsuffix);
        !           319: 
        !           320:          /* Concatenate path element/specified name with the suffix.  */
        !           321:          strncpy (fn, XSTRING (filename)->data, XSTRING (filename)->size);
        !           322:          fn[XSTRING (filename)->size] = 0;
        !           323:          if (lsuffix != 0)  /* Bug happens on CCI if lsuffix is 0.  */
        !           324:            strncat (fn, nsuffix, lsuffix);
        !           325: 
        !           326:          /* Ignore file if it's a directory.  */
        !           327:          if (stat (fn, &st) >= 0
        !           328:              && (st.st_mode & S_IFMT) != S_IFDIR)
        !           329:            {
        !           330:              /* Check that we can access or open it.  */
        !           331:              if (exec_only)
        !           332:                fd = !access (fn, X_OK);
        !           333:              else
        !           334:                fd = open (fn, 0, 0);
        !           335: 
        !           336:              if (fd >= 0)
        !           337:                {
        !           338:                  /* We succeeded; return this descriptor and filename.  */
        !           339:                  if (storeptr)
        !           340:                    *storeptr = build_string (fn);
        !           341:                  return fd;
        !           342:                }
        !           343:            }
        !           344: 
        !           345:          /* Advance to next suffix.  */
        !           346:          if (esuffix == 0)
        !           347:            break;
        !           348:          nsuffix += lsuffix + 1;
        !           349:        }
        !           350:       if (absolute) return -1;
        !           351:     }
        !           352: 
        !           353:   return -1;
        !           354: }
        !           355: 
        !           356: 
        !           357: Lisp_Object
        !           358: unreadpure ()  /* Used as unwind-protect function in readevalloop */
        !           359: {
        !           360:   read_pure = 0;
        !           361:   return Qnil;
        !           362: }
        !           363: 
        !           364: static void
        !           365: readevalloop (readcharfun, stream, evalfun, printflag)
        !           366:      Lisp_Object readcharfun;
        !           367:      FILE *stream;     
        !           368:      Lisp_Object (*evalfun) ();
        !           369:      int printflag;
        !           370: {
        !           371:   register int c;
        !           372:   register Lisp_Object val;
        !           373:   register int xunrch;
        !           374:   int count = specpdl_ptr - specpdl;
        !           375: 
        !           376:   specbind (Qstandard_input, readcharfun);
        !           377: 
        !           378:   unrch = -1;
        !           379: 
        !           380:   while (1)
        !           381:     {
        !           382:       instream = stream;
        !           383:       c = READCHAR;
        !           384:       if (c == ';')
        !           385:        {
        !           386:          while ((c = READCHAR) != '\n' && c != -1);
        !           387:          continue;
        !           388:        }
        !           389:       if (c < 0) break;
        !           390:       if (c == ' ' || c == '\t' || c == '\n' || c == '\f') continue;
        !           391: 
        !           392:       if (!NULL (Vpurify_flag) && c == '(')
        !           393:        {
        !           394:          record_unwind_protect (unreadpure, Qnil);
        !           395:          val = read_list (-1, readcharfun);
        !           396:          unbind_to (count + 1);
        !           397:        }
        !           398:       else
        !           399:        {
        !           400:          UNREAD (c);
        !           401:          val = read0 (readcharfun);
        !           402:        }
        !           403: 
        !           404:       xunrch = unrch;
        !           405:       unrch = -1;
        !           406:       val = (*evalfun) (val);
        !           407:       if (printflag)
        !           408:        {
        !           409:          Vvalues = Fcons (val, Vvalues);
        !           410:          if (EQ (Vstandard_output, Qt))
        !           411:            Fprin1 (val, Qnil);
        !           412:          else
        !           413:            Fprint (val, Qnil);
        !           414:        }
        !           415:       unrch = xunrch;
        !           416:     }
        !           417: 
        !           418:   unbind_to (count);
        !           419: }
        !           420: 
        !           421: #ifndef standalone
        !           422: 
        !           423: DEFUN ("eval-current-buffer", Feval_current_buffer, Seval_current_buffer, 0, 1, "",
        !           424:   "Execute the current buffer as Lisp code.\n\
        !           425: Programs can pass argument PRINTFLAG which controls printing of output:\n\
        !           426: nil means discard it; anything else is stream for print.")
        !           427:   (printflag)
        !           428:      Lisp_Object printflag;
        !           429: {
        !           430:   int count = specpdl_ptr - specpdl;
        !           431:   Lisp_Object tem;
        !           432:   if (NULL (printflag))
        !           433:     tem = Qsymbolp;
        !           434:   else
        !           435:     tem = printflag;
        !           436:   specbind (Qstandard_output, tem);
        !           437:   record_unwind_protect (save_excursion_restore, save_excursion_save ());
        !           438:   SetPoint (FirstCharacter);
        !           439:   readevalloop (Fcurrent_buffer (), 0, Feval, !NULL (printflag));
        !           440:   unbind_to (count);
        !           441:   return Qnil;
        !           442: }
        !           443: 
        !           444: DEFUN ("eval-region", Feval_region, Seval_region, 2, 3, "r",
        !           445:   "Execute the region as Lisp code.\n\
        !           446: When called from programs, expects two arguments,\n\
        !           447: giving starting and ending indices in the current buffer\n\
        !           448: of the text to be executed.\n\
        !           449: Programs can pass third argument PRINTFLAG which controls printing of output:\n\
        !           450: nil means discard it; anything else is stream for print.")
        !           451:   (b, e, printflag)
        !           452:      Lisp_Object b, e, printflag;
        !           453: {
        !           454:   int count = specpdl_ptr - specpdl;
        !           455:   Lisp_Object tem;
        !           456:   if (NULL (printflag))
        !           457:     tem = Qsymbolp;
        !           458:   else
        !           459:     tem = printflag;
        !           460:   specbind (Qstandard_output, tem);
        !           461:   if (NULL (printflag))
        !           462:     record_unwind_protect (save_excursion_restore, save_excursion_save ());
        !           463:   record_unwind_protect (save_restriction_restore, save_restriction_save ());
        !           464:   SetPoint (XINT (b));
        !           465:   Fnarrow_to_region (make_number (FirstCharacter), e);
        !           466:   readevalloop (Fcurrent_buffer (), 0, Feval, !NULL (printflag));
        !           467:   unbind_to (count);
        !           468:   return Qnil;
        !           469: }
        !           470: 
        !           471: #endif standalone
        !           472: 
        !           473: DEFUN ("read", Fread, Sread, 0, 1, 0,
        !           474:   "Read one Lisp expression as text from STREAM, return as Lisp object.\n\
        !           475: If STREAM is nil, use the value of standard-input (which see).\n\
        !           476: STREAM or standard-input may be:\n\
        !           477:  a buffer (read from point and advance it)\n\
        !           478:  a marker (read from where it points and advance it)\n\
        !           479:  a function (call it with no arguments for each character)\n\
        !           480:  a string (takes text from string, starting at the beginning)\n\
        !           481:  t (read text line using minibuffer and use it).")
        !           482:   (readcharfun)
        !           483:      Lisp_Object readcharfun;
        !           484: {
        !           485:   extern Lisp_Object Fread_minibuffer ();
        !           486: 
        !           487:   unrch = -1;  /* Allow buffering-back only within a read. */
        !           488: 
        !           489:   if (NULL (readcharfun))
        !           490:     readcharfun = Vstandard_input;
        !           491:   if (EQ (readcharfun, Qt))
        !           492:     readcharfun = Qread_char;
        !           493: 
        !           494: #ifndef standalone
        !           495:   if (EQ (readcharfun, Qread_char))
        !           496:     return Fread_minibuffer (build_string ("Lisp expression: "), Qnil);
        !           497: #endif
        !           498: 
        !           499:   if (XTYPE (readcharfun) == Lisp_String)
        !           500:     return Fcar (Fread_from_string (readcharfun, Qnil, Qnil));
        !           501: 
        !           502:   return read0 (readcharfun);
        !           503: }
        !           504: 
        !           505: DEFUN ("read-from-string", Fread_from_string, Sread_from_string, 1, 3, 0,
        !           506:   "Read one Lisp expression which is represented as text by STRING.\n\
        !           507: Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).\n\
        !           508: START and END optionally delimit a substring of STRING from which to read;\n\
        !           509:  they default to 0 and (length STRING) respectively.")
        !           510:   (string, start, end)
        !           511:      Lisp_Object string, start, end;
        !           512: {
        !           513:   int startval, endval;
        !           514:   Lisp_Object tem;
        !           515: 
        !           516:   CHECK_STRING (string,0);
        !           517: 
        !           518:   if (NULL (end))
        !           519:     endval = XSTRING (string)->size;
        !           520:   else
        !           521:     { CHECK_NUMBER (end,2);
        !           522:       endval = XINT (end);
        !           523:       if (endval < 0 || endval > XSTRING (string)->size)
        !           524:        args_out_of_range (string, end);
        !           525:     }
        !           526: 
        !           527:   if (NULL (start))
        !           528:     startval = 0;
        !           529:   else
        !           530:     { CHECK_NUMBER (start,1);
        !           531:       startval = XINT (start);
        !           532:       if (startval < 0 || startval > endval)
        !           533:        args_out_of_range (string, start);
        !           534:     }
        !           535: 
        !           536:   read_from_string_index = startval;
        !           537:   read_from_string_limit = endval;
        !           538: 
        !           539:   unrch = -1;  /* Allow buffering-back only within a read. */
        !           540: 
        !           541:   tem = read0 (string);
        !           542:   return Fcons (tem, make_number (read_from_string_index));
        !           543: }
        !           544: 
        !           545: /* Use this for recursive reads, in contexts where internal tokens are not allowed. */
        !           546: 
        !           547: static Lisp_Object
        !           548: read0 (readcharfun)
        !           549:      Lisp_Object readcharfun;
        !           550: {
        !           551:   register Lisp_Object val;
        !           552:   char c;
        !           553: 
        !           554:   val = read1 (readcharfun);
        !           555:   if (XTYPE (val) == Lisp_Internal)
        !           556:     {
        !           557:       c = XINT (val);
        !           558:       return Fsignal (Qinvalid_read_syntax, Fcons (make_string (&c, 1), Qnil));
        !           559:     }
        !           560: 
        !           561:   return val;
        !           562: }
        !           563: 
        !           564: static int read_buffer_size;
        !           565: static char *read_buffer;
        !           566: 
        !           567: static Lisp_Object
        !           568: read1 (readcharfun)
        !           569:      register Lisp_Object readcharfun;
        !           570: {
        !           571:   register int c;
        !           572: 
        !           573:  retry:
        !           574: 
        !           575:   c = READCHAR;
        !           576:   if (c < 0) return Fsignal (Qend_of_file, Qnil);
        !           577: 
        !           578:   switch (c)
        !           579:     {
        !           580:     case '(':
        !           581:       return read_list (0, readcharfun);
        !           582: 
        !           583:     case '[':
        !           584:       return read_vector (readcharfun);
        !           585: 
        !           586:     case ')':
        !           587:     case ']':
        !           588:     case '.':
        !           589:       {
        !           590:        register Lisp_Object val;
        !           591:        XSET (val, Lisp_Internal, c);
        !           592:        return val;
        !           593:       }
        !           594: 
        !           595:     case '#':
        !           596:       return Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#", 1), Qnil));
        !           597: 
        !           598:     case ';':
        !           599:       while ((c = READCHAR) >= 0 && c != '\n');
        !           600:       goto retry;
        !           601: 
        !           602:     case '\'':
        !           603:       {
        !           604:        return Fcons (Qquote, Fcons (read0 (readcharfun), Qnil));
        !           605:       }
        !           606: 
        !           607:     case '?':
        !           608:       {
        !           609:        register Lisp_Object val;
        !           610: 
        !           611:        XSET (val, Lisp_Int, READCHAR);
        !           612:        if (XFASTINT (val) == '\\')
        !           613:          XSETINT (val, read_escape (readcharfun));
        !           614: 
        !           615:        return val;
        !           616:       }
        !           617: 
        !           618:     case '\"':
        !           619:       {
        !           620:        register char *p = read_buffer;
        !           621:        register char *end = read_buffer + read_buffer_size;
        !           622:        register int c;
        !           623:        int cancel = 0;
        !           624: 
        !           625:        while ((c = READCHAR) >= 0 &&
        !           626:                (c != '\"' || (c = READCHAR) == '\"'))
        !           627:          {
        !           628:            if (p == end)
        !           629:              {
        !           630:                char *new = (char *) xrealloc (read_buffer, read_buffer_size *= 2);
        !           631:                p += new - read_buffer;
        !           632:                read_buffer += new - read_buffer;
        !           633:                end = read_buffer + read_buffer_size;
        !           634:              }
        !           635:            if (c == '\\')
        !           636:              c = read_escape (readcharfun);
        !           637:            /* c is -1 if \ newline has just been seen */
        !           638:            if (c < 0)
        !           639:              {
        !           640:                if (p == read_buffer)
        !           641:                  cancel = 1;
        !           642:              }
        !           643:            else
        !           644:              *p++ = c;
        !           645:          }
        !           646: 
        !           647:        UNREAD (c);
        !           648:        /* If purifying, and string starts with \ newline,
        !           649:           return zero instead.  This is for doc strings
        !           650:           that we are really going to find in etc/DOC.nn.nn  */
        !           651:        if (!NULL (Vpurify_flag) && NULL (Vdoc_file_name) && cancel)
        !           652:          return make_number (0);
        !           653: 
        !           654:        if (read_pure)
        !           655:          return make_pure_string (read_buffer, p - read_buffer);
        !           656:        else
        !           657:          return make_string (read_buffer, p - read_buffer);
        !           658:       }
        !           659: 
        !           660:     default:
        !           661:       if (c <= 040) goto retry;
        !           662:       {
        !           663:        register char *p = read_buffer;
        !           664: 
        !           665:        {
        !           666:          register char *end = read_buffer + read_buffer_size;
        !           667: 
        !           668:          while (c > 040 && 
        !           669:                 !(c == '\"' || c == '\'' || c == ';' || c == '?'
        !           670:                   || c == '(' || c == ')' || c =='.'
        !           671:                   || c == '[' || c == ']' || c == '#'
        !           672:                   ))
        !           673:            {
        !           674:              if (p == end)
        !           675:                {
        !           676:                  register char *new = (char *) xrealloc (read_buffer, read_buffer_size *= 2);
        !           677:                  p += new - read_buffer;
        !           678:                  read_buffer += new - read_buffer;
        !           679:                  end = read_buffer + read_buffer_size;
        !           680:                }
        !           681:              if (c == '\\')
        !           682:                c = READCHAR;
        !           683:              *p++ = c;
        !           684:              c = READCHAR;
        !           685:            }
        !           686: 
        !           687:          if (p == end)
        !           688:            {
        !           689:              char *new = (char *) xrealloc (read_buffer, read_buffer_size *= 2);
        !           690:              p += new - read_buffer;
        !           691:              read_buffer += new - read_buffer;
        !           692: /*           end = read_buffer + read_buffer_size;  */
        !           693:            }
        !           694:          *p = 0;
        !           695:          UNREAD (c);
        !           696:        }
        !           697: 
        !           698:        /* Is it an integer? */
        !           699:        {
        !           700:          register char *p1;
        !           701:          register Lisp_Object val;
        !           702:          p1 = read_buffer;
        !           703:          if (*p1 == '+' || *p1 == '-') p1++;
        !           704:          if (p1 != p)
        !           705:            {
        !           706:              while (p1 != p && (c = *p1) >= '0' && c <= '9') p1++;
        !           707:              if (p1 == p)
        !           708:                /* It is. */
        !           709:                {
        !           710:                  XSET (val, Lisp_Int, atoi (read_buffer));
        !           711:                  return val;
        !           712:                }
        !           713:            }
        !           714:        }
        !           715: 
        !           716:        return intern (read_buffer);
        !           717:       }
        !           718:     }
        !           719: }
        !           720: 
        !           721: static Lisp_Object
        !           722: read_vector (readcharfun)
        !           723:      Lisp_Object readcharfun;
        !           724: {
        !           725:   register int i;
        !           726:   register int size;
        !           727:   register Lisp_Object *ptr;
        !           728:   register Lisp_Object tem, vector;
        !           729:   register struct Lisp_Cons *otem;
        !           730:   Lisp_Object len;
        !           731: 
        !           732:   tem = read_list (1, readcharfun);
        !           733:   len = Flength (tem);
        !           734:   vector = (read_pure ? make_pure_vector (XINT (len)) : Fmake_vector (len, Qnil));
        !           735: 
        !           736: 
        !           737:   size = XVECTOR (vector)->size;
        !           738:   ptr = XVECTOR (vector)->contents;
        !           739:   for (i = 0; i < size; i++)
        !           740:     {
        !           741:       ptr[i] = read_pure ? Fpurecopy (Fcar (tem)) : Fcar (tem);
        !           742:       otem = XCONS (tem);
        !           743:       tem = Fcdr (tem);
        !           744:       free_cons (otem);
        !           745:     }
        !           746:   return vector;
        !           747: }
        !           748:   
        !           749: /* flag = 1 means check for ] to terminate rather than ) and .
        !           750:    flag = -1 means check for starting with defun
        !           751:     and make structure pure.  */
        !           752: 
        !           753: static Lisp_Object
        !           754: read_list (flag, readcharfun)
        !           755:      int flag;
        !           756:      register Lisp_Object readcharfun;
        !           757: {
        !           758:   /* -1 means check next element for defun,
        !           759:      0 means don't check,
        !           760:      1 means already checked and found defun. */
        !           761:   int defunflag = flag < 0 ? -1 : 0;
        !           762:   Lisp_Object val, tail;
        !           763:   register Lisp_Object elt, tem;
        !           764:   struct gcpro gcpro1, gcpro2;
        !           765: 
        !           766:   val = Qnil;
        !           767:   tail = Qnil;
        !           768: 
        !           769:   while (1)
        !           770:     {
        !           771:       GCPRO2 (val, tail);
        !           772:       elt = read1 (readcharfun);
        !           773:       UNGCPRO;
        !           774:       if (XTYPE (elt) == Lisp_Internal)
        !           775:        {
        !           776:          if (flag > 0)
        !           777:            {
        !           778:              if (XINT (elt) == ']')
        !           779:                return val;
        !           780:              return Fsignal (Qinvalid_read_syntax, Fcons (make_string (") or . in a vector", 18), Qnil));
        !           781:            }
        !           782:          if (XINT (elt) == ')')
        !           783:            return val;
        !           784:          if (XINT (elt) == '.')
        !           785:            {
        !           786:              GCPRO2 (val, tail);
        !           787:              if (!NULL (tail))
        !           788:                XCONS (tail)->cdr = read0 (readcharfun);
        !           789:              else
        !           790:                val = read0 (readcharfun);
        !           791:              elt = read1 (readcharfun);
        !           792:              UNGCPRO;
        !           793:              if (XTYPE (elt) == Lisp_Internal && XINT (elt) == ')')
        !           794:                return val;
        !           795:              return Fsignal (Qinvalid_read_syntax, Fcons (make_string (". in wrong context", 18), Qnil));
        !           796:            }
        !           797:          return Fsignal (Qinvalid_read_syntax, Fcons (make_string ("] in a list", 11), Qnil));
        !           798:        }
        !           799:       tem = (read_pure && flag <= 0
        !           800:             ? pure_cons (elt, Qnil)
        !           801:             : Fcons (elt, Qnil));
        !           802:       if (!NULL (tail))
        !           803:        XCONS (tail)->cdr = tem;
        !           804:       else
        !           805:        val = tem;
        !           806:       tail = tem;
        !           807:       if (defunflag < 0)
        !           808:        defunflag = EQ (elt, Qdefun);
        !           809:       else if (defunflag > 0)
        !           810:        read_pure = 1;
        !           811:     }
        !           812: }
        !           813: 
        !           814: static int
        !           815: read_escape (readcharfun)
        !           816:      Lisp_Object readcharfun;
        !           817: {
        !           818:   register int c = READCHAR;
        !           819:   switch (c)
        !           820:     {
        !           821:     case 'a':
        !           822:       return '\a';
        !           823:     case 'b':
        !           824:       return '\b';
        !           825:     case 'e':
        !           826:       return 033;
        !           827:     case 'f':
        !           828:       return '\f';
        !           829:     case 'n':
        !           830:       return '\n';
        !           831:     case 'r':
        !           832:       return '\r';
        !           833:     case 't':
        !           834:       return '\t';
        !           835:     case 'v':
        !           836:       return '\v';
        !           837:     case '\n':
        !           838:       return -1;
        !           839: 
        !           840:     case 'M':
        !           841:       c = READCHAR;
        !           842:       if (c != '-')
        !           843:        error ("Invalid escape character syntax");
        !           844:       c = READCHAR;
        !           845:       if (c == '\\')
        !           846:        c = read_escape (readcharfun);
        !           847:       return c | 0200;
        !           848: 
        !           849:     case 'C':
        !           850:       c = READCHAR;
        !           851:       if (c != '-')
        !           852:        error ("Invalid escape character syntax");
        !           853:     case '^':
        !           854:       c = READCHAR;
        !           855:       if (c == '\\')
        !           856:        c = read_escape (readcharfun);
        !           857:       if (c == '?')
        !           858:        return 0177;
        !           859:       return (c & 0200) | (c & 037);
        !           860:       
        !           861:     case '0':
        !           862:     case '1':
        !           863:     case '2':
        !           864:     case '3':
        !           865:     case '4':
        !           866:     case '5':
        !           867:     case '6':
        !           868:     case '7':
        !           869:       {
        !           870:        register int i = c - '0';
        !           871:        register int count = 0;
        !           872:        while (++count < 3)
        !           873:          {
        !           874:            if ((c = READCHAR) >= '0' && c <= '7')
        !           875:              {
        !           876:                i *= 8;
        !           877:                i += c - '0';
        !           878:              }
        !           879:            else
        !           880:              {
        !           881:                UNREAD (c);
        !           882:                break;
        !           883:              }
        !           884:          }
        !           885:        return i;
        !           886:       }
        !           887:     default:
        !           888:       return c;
        !           889:     }
        !           890: }
        !           891: 
        !           892: Lisp_Object Vobarray;
        !           893: Lisp_Object initial_obarray;
        !           894: 
        !           895: Lisp_Object
        !           896: check_obarray (obarray)
        !           897:      Lisp_Object obarray;
        !           898: {
        !           899:   while (XTYPE (obarray) != Lisp_Vector || XVECTOR (obarray)->size == 0)
        !           900:     {
        !           901:       /* If Vobarray is now invalid, force it to be valid.  */
        !           902:       if (EQ (Vobarray, obarray)) Vobarray = initial_obarray;
        !           903: 
        !           904:       obarray = wrong_type_argument (Qvectorp, obarray);
        !           905:     }
        !           906:   return obarray;
        !           907: }
        !           908: 
        !           909: static int hash_string ();
        !           910: Lisp_Object oblookup ();
        !           911: 
        !           912: Lisp_Object
        !           913: intern (str)
        !           914:      char *str;
        !           915: {
        !           916:   Lisp_Object tem;
        !           917:   int len = strlen (str);
        !           918:   Lisp_Object obarray = Vobarray;
        !           919:   if (XTYPE (obarray) != Lisp_Vector || XVECTOR (obarray)->size == 0)
        !           920:     obarray = check_obarray (obarray);
        !           921:   tem = oblookup (obarray, str, len);
        !           922:   if (XTYPE (tem) == Lisp_Symbol)
        !           923:     return tem;
        !           924:   return Fintern ((!NULL (Vpurify_flag)
        !           925:                   ? make_pure_string (str, len)
        !           926:                   : make_string (str, len)),
        !           927:                  obarray);
        !           928: }
        !           929: 
        !           930: DEFUN ("intern", Fintern, Sintern, 1, 2, 0,
        !           931:   "Return the symbol whose name is STRING.\n\
        !           932: A second optional argument specifies the obarray to use;\n\
        !           933: it defaults to the value of  obarray.")
        !           934:   (str, obarray)
        !           935:      Lisp_Object str, obarray;
        !           936: {
        !           937:   register Lisp_Object tem, sym, *ptr;
        !           938: 
        !           939:   if (NULL (obarray)) obarray = Vobarray;
        !           940:   obarray = check_obarray (obarray);
        !           941: 
        !           942:   CHECK_STRING (str, 0);
        !           943: 
        !           944:   tem = oblookup (obarray, XSTRING (str)->data, XSTRING (str)->size);
        !           945:   if (XTYPE (tem) != Lisp_Int)
        !           946:     return tem;
        !           947: 
        !           948:   if (!NULL (Vpurify_flag))
        !           949:     str = Fpurecopy (str);
        !           950:   sym = Fmake_symbol (str);
        !           951: 
        !           952:   ptr = &XVECTOR (obarray)->contents[XINT (tem)];
        !           953:   if (XTYPE (*ptr) == Lisp_Symbol)
        !           954:     XSYMBOL (sym)->next = XSYMBOL (*ptr);
        !           955:   else
        !           956:     XSYMBOL (sym)->next = 0;
        !           957:   *ptr = sym;
        !           958:   return sym;
        !           959: }
        !           960: 
        !           961: DEFUN ("intern-soft", Fintern_soft, Sintern_soft, 1, 2, 0,
        !           962:   "Return the symbol whose name is STRING, or nil if none exists yet.\n\
        !           963: A second optional argument specifies the obarray to use;\n\
        !           964: it defaults to the value of  obarray.")
        !           965:   (str, obarray)
        !           966:      Lisp_Object str, obarray;
        !           967: {
        !           968:   register Lisp_Object tem;
        !           969: 
        !           970:   if (NULL (obarray)) obarray = Vobarray;
        !           971:   obarray = check_obarray (obarray);
        !           972: 
        !           973:   CHECK_STRING (str, 0);
        !           974: 
        !           975:   tem = oblookup (obarray, XSTRING (str)->data, XSTRING (str)->size);
        !           976:   if (XTYPE (tem) != Lisp_Int)
        !           977:     return tem;
        !           978:   return Qnil;
        !           979: }
        !           980: 
        !           981: Lisp_Object
        !           982: oblookup (obarray, ptr, size)
        !           983:      Lisp_Object obarray;
        !           984:      register char *ptr;
        !           985:      register int size;
        !           986: {
        !           987:   int hash, obsize;
        !           988:   register Lisp_Object tail;
        !           989:   Lisp_Object bucket, tem;
        !           990: 
        !           991:   if (XTYPE (obarray) != Lisp_Vector ||
        !           992:       (obsize = XVECTOR (obarray)->size) == 0)
        !           993:     {
        !           994:       obarray = check_obarray (obarray);
        !           995:       obsize = XVECTOR (obarray)->size;
        !           996:     }
        !           997:   /* Combining next two lines breaks VMS C 2.3.  */
        !           998:   hash = hash_string (ptr, size);
        !           999:   hash %= obsize;
        !          1000:   bucket = XVECTOR (obarray)->contents[hash];
        !          1001:   if (XFASTINT (bucket) == 0)
        !          1002:     ;
        !          1003:   else if (XTYPE (bucket) != Lisp_Symbol)
        !          1004:     error ("Bad data in guts of obarray"); /* Like CADR error message */
        !          1005:   else for (tail = bucket; ; XSET (tail, Lisp_Symbol, XSYMBOL (tail)->next))
        !          1006:       {
        !          1007:        if (XSYMBOL (tail)->name->size == size &&
        !          1008:            !bcmp (XSYMBOL (tail)->name->data, ptr, size))
        !          1009:          return tail;
        !          1010:        else if (XSYMBOL (tail)->next == 0)
        !          1011:          break;
        !          1012:       }
        !          1013:   XSET (tem, Lisp_Int, hash);
        !          1014:   return tem;
        !          1015: }
        !          1016: 
        !          1017: static int
        !          1018: hash_string (ptr, len)
        !          1019:      unsigned char *ptr;
        !          1020:      int len;
        !          1021: {
        !          1022:   register unsigned char *p = ptr;
        !          1023:   register unsigned char *end = p + len;
        !          1024:   register unsigned char c;
        !          1025:   register int hash = 0;
        !          1026: 
        !          1027:   while (p != end)
        !          1028:     {
        !          1029:       c = *p++;
        !          1030:       if (c >= 0140) c -= 40;
        !          1031:       hash = ((hash<<3) + (hash>>28) + c);
        !          1032:     }
        !          1033:   return hash & 07777777777;
        !          1034: }
        !          1035: 
        !          1036: void
        !          1037: map_obarray (obarray, fn, arg)
        !          1038:      Lisp_Object obarray;
        !          1039:      int (*fn) ();
        !          1040:      Lisp_Object arg;
        !          1041: {
        !          1042:   register int i;
        !          1043:   register Lisp_Object tail;
        !          1044:   CHECK_VECTOR (obarray, 1);
        !          1045:   for (i = XVECTOR (obarray)->size - 1; i >= 0; i--)
        !          1046:     {
        !          1047:       tail = XVECTOR (obarray)->contents[i];
        !          1048:       if (XFASTINT (tail) != 0)
        !          1049:        while (1)
        !          1050:          {
        !          1051:            (*fn) (tail, arg);
        !          1052:            if (XSYMBOL (tail)->next == 0)
        !          1053:              break;
        !          1054:            XSET (tail, Lisp_Symbol, XSYMBOL (tail)->next);
        !          1055:          }
        !          1056:     }
        !          1057: }
        !          1058: 
        !          1059: mapatoms_1 (sym, function)
        !          1060:      Lisp_Object sym, function;
        !          1061: {
        !          1062:   call1 (function, sym);
        !          1063: }
        !          1064: 
        !          1065: DEFUN ("mapatoms", Fmapatoms, Smapatoms, 1, 2, 0,
        !          1066:   "Call FUNCTION on every symbol in OBARRAY.\n\
        !          1067: OBARRAY defaults to the value of  obarray.")
        !          1068:   (function, obarray)
        !          1069:      Lisp_Object function, obarray;
        !          1070: {
        !          1071:   Lisp_Object tem;
        !          1072: 
        !          1073:   if (NULL (obarray)) obarray = Vobarray;
        !          1074:   obarray = check_obarray (obarray);
        !          1075: 
        !          1076:   map_obarray (obarray, mapatoms_1, function);
        !          1077:   return Qnil;
        !          1078: }
        !          1079: 
        !          1080: #define OBARRAY_SIZE 511
        !          1081: 
        !          1082: void
        !          1083: init_obarray ()
        !          1084: {
        !          1085:   Lisp_Object oblength;
        !          1086:   int hash;
        !          1087:   Lisp_Object *tem;
        !          1088: 
        !          1089:   XFASTINT (oblength) = OBARRAY_SIZE;
        !          1090: 
        !          1091:   Qnil = Fmake_symbol (make_pure_string ("nil", 3));
        !          1092:   Vobarray = Fmake_vector (oblength, make_number (0));
        !          1093:   initial_obarray = Vobarray;
        !          1094:   staticpro (&Vobarray);
        !          1095:   staticpro (&initial_obarray);
        !          1096:   /* Intern nil in the obarray */
        !          1097:   /* These locals are to kludge around a pyramid compiler bug. */
        !          1098:   hash = hash_string ("nil", 3);
        !          1099:   /* Separate statement here to avoid VAXC bug. */
        !          1100:   hash %= OBARRAY_SIZE;
        !          1101:   tem = &XVECTOR (Vobarray)->contents[hash];
        !          1102:   *tem = Qnil;
        !          1103: 
        !          1104:   Qunbound = Fmake_symbol (make_pure_string ("unbound", 7));
        !          1105:   XSYMBOL (Qnil)->function = Qunbound;
        !          1106:   XSYMBOL (Qunbound)->value = Qunbound;
        !          1107:   XSYMBOL (Qunbound)->function = Qunbound;
        !          1108: 
        !          1109:   Qt = intern ("t");
        !          1110:   XSYMBOL (Qnil)->value = Qnil;
        !          1111:   XSYMBOL (Qnil)->plist = Qnil;
        !          1112:   XSYMBOL (Qt)->value = Qt;
        !          1113: 
        !          1114:   /* Qt is correct even if CANNOT_DUMP.  loadup.el will set to nil at end.  */
        !          1115:   Vpurify_flag = Qt;
        !          1116: 
        !          1117:   Qvariable_documentation = intern ("variable-documentation");
        !          1118: 
        !          1119:   read_buffer_size = 100;
        !          1120:   read_buffer = (char *) malloc (read_buffer_size);
        !          1121: }
        !          1122: 
        !          1123: void
        !          1124: defsubr (sname)
        !          1125:      struct Lisp_Subr *sname;
        !          1126: {
        !          1127:   Lisp_Object sym;
        !          1128:   sym = intern (sname->symbol_name);
        !          1129:   XSET (XSYMBOL (sym)->function, Lisp_Subr, sname);
        !          1130: }
        !          1131: 
        !          1132: #ifdef NOTDEF /* use fset in subr.el now */
        !          1133: void
        !          1134: defalias (sname, string)
        !          1135:      struct Lisp_Subr *sname;
        !          1136:      char *string;
        !          1137: {
        !          1138:   Lisp_Object sym;
        !          1139:   sym = intern (string);
        !          1140:   XSET (XSYMBOL (sym)->function, Lisp_Subr, sname);
        !          1141: }
        !          1142: #endif NOTDEF
        !          1143: 
        !          1144: /* New replacement for DefIntVar; it ignores the doc string argument
        !          1145:    on the assumption that make-docfile will handle that.  */
        !          1146: /* Define an "integer variable"; a symbol whose value is forwarded
        !          1147:  to a C variable of type int.  Sample call: */
        !          1148:   /* DEFVARINT ("indent-tabs-mode", &indent_tabs_mode, "Documentation");  */
        !          1149: 
        !          1150: void
        !          1151: defvar_int (namestring, address, doc)
        !          1152:      char *namestring;
        !          1153:      int *address;
        !          1154:      char *doc;
        !          1155: {
        !          1156:   Lisp_Object sym;
        !          1157:   sym = intern (namestring);
        !          1158:   XSET (XSYMBOL (sym)->value, Lisp_Intfwd, address);
        !          1159: }
        !          1160: 
        !          1161: /* Similar but define a variable whose value is T if address contains 1,
        !          1162:  NIL if address contains 0 */
        !          1163: 
        !          1164: void
        !          1165: defvar_bool (namestring, address, doc)
        !          1166:      char *namestring;
        !          1167:      int *address;
        !          1168:      char *doc;
        !          1169: {
        !          1170:   Lisp_Object sym;
        !          1171:   sym = intern (namestring);
        !          1172:   XSET (XSYMBOL (sym)->value, Lisp_Boolfwd, address);
        !          1173: }
        !          1174: 
        !          1175: /* Similar but define a variable whose value is the Lisp Object stored at address. */
        !          1176: 
        !          1177: void
        !          1178: defvar_lisp (namestring, address, doc)
        !          1179:      char *namestring;
        !          1180:      Lisp_Object *address;
        !          1181:      char *doc;
        !          1182: {
        !          1183:   Lisp_Object sym;
        !          1184:   sym = intern (namestring);
        !          1185:   XSET (XSYMBOL (sym)->value, Lisp_Objfwd, address);
        !          1186:   staticpro (address);
        !          1187: }
        !          1188: 
        !          1189: /* Similar but don't request gc-marking of the C variable.
        !          1190:    Used when that variable will be gc-marked for some other reason,
        !          1191:    since marking the same slot twice can cause trouble with strings.  */
        !          1192: 
        !          1193: void
        !          1194: defvar_lisp_nopro (namestring, address, doc)
        !          1195:      char *namestring;
        !          1196:      Lisp_Object *address;
        !          1197:      char *doc;
        !          1198: {
        !          1199:   Lisp_Object sym;
        !          1200:   sym = intern (namestring);
        !          1201:   XSET (XSYMBOL (sym)->value, Lisp_Objfwd, address);
        !          1202: }
        !          1203: 
        !          1204: #ifndef standalone
        !          1205: 
        !          1206: /* Similar but define a variable whose value is the Lisp Object stored in
        !          1207:  the current buffer.  address is the address of the slot in the buffer that is current now. */
        !          1208: 
        !          1209: void
        !          1210: defvar_per_buffer (namestring, address, doc)
        !          1211:      char *namestring;
        !          1212:      Lisp_Object *address;
        !          1213:      char *doc;
        !          1214: {
        !          1215:   Lisp_Object sym;
        !          1216:   int offset;
        !          1217:   extern struct buffer buffer_local_symbols;
        !          1218: 
        !          1219:   sym = intern (namestring);
        !          1220:   offset = (char *)address - (char *)bf_cur;
        !          1221: 
        !          1222:   XSET (XSYMBOL (sym)->value, Lisp_Buffer_Objfwd,
        !          1223:        (Lisp_Object *) offset);
        !          1224:   *(Lisp_Object *)(offset + (char *)&buffer_local_symbols) = sym;
        !          1225:   if (*(int *)(offset + (char *)&buffer_local_flags) == 0)
        !          1226:     /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
        !          1227:        slot of buffer_local_flags */
        !          1228:     abort ();
        !          1229: }
        !          1230: 
        !          1231: #endif standalone
        !          1232: 
        !          1233: init_read ()
        !          1234: {
        !          1235:   char *normal = PATH_LOADSEARCH;
        !          1236:   Lisp_Object normal_path;
        !          1237: 
        !          1238:   /* Warn if dirs in the *standard* path don't exist.  */
        !          1239:   normal_path = decode_env_path ("", normal);
        !          1240:   for (; !NULL (normal_path); normal_path = XCONS (normal_path)->cdr)
        !          1241:     {
        !          1242:       Lisp_Object dirfile;
        !          1243:       dirfile = Fcar (normal_path);
        !          1244:       if (!NULL (dirfile))
        !          1245:        {
        !          1246:          dirfile = Fdirectory_file_name (dirfile);
        !          1247:          if (access (XSTRING (dirfile)->data, 0) < 0)
        !          1248:            printf ("Warning: lisp library (%s) does not exist.\n",
        !          1249:                    XSTRING (Fcar (normal_path))->data);
        !          1250:        }
        !          1251:     }
        !          1252: 
        !          1253:   Vvalues = Qnil;
        !          1254: 
        !          1255:   Vload_path = decode_env_path ("EMACSLOADPATH", normal);
        !          1256: #ifndef CANNOT_DUMP
        !          1257:   if (!NULL (Vpurify_flag))
        !          1258:     Vload_path = Fcons (build_string ("../lisp"), Vload_path);
        !          1259: #endif /* not CANNOT_DUMP */
        !          1260:   load_in_progress = 0;
        !          1261: }
        !          1262: 
        !          1263: void
        !          1264: syms_of_read ()
        !          1265: {
        !          1266:   defsubr (&Sread);
        !          1267:   defsubr (&Sread_from_string);
        !          1268:   defsubr (&Sintern);
        !          1269:   defsubr (&Sintern_soft);
        !          1270:   defsubr (&Sload);
        !          1271:   defsubr (&Seval_current_buffer);
        !          1272:   defsubr (&Seval_region);
        !          1273:   defsubr (&Sread_char);
        !          1274:   defsubr (&Sget_file_char);
        !          1275:   defsubr (&Smapatoms);
        !          1276: 
        !          1277:   DEFVAR_LISP ("obarray", &Vobarray,
        !          1278:     "Symbol table for use by  intern  and  read.\n\
        !          1279: It is a vector whose length ought to be prime for best results.\n\
        !          1280: Each element is a list of all interned symbols whose names hash in that bucket.");
        !          1281: 
        !          1282:   DEFVAR_LISP ("values", &Vvalues,
        !          1283:     "List of values of all expressions which were read, evaluated and printed.\n\
        !          1284: Order is reverse chronological.");
        !          1285: 
        !          1286:   DEFVAR_LISP ("standard-input", &Vstandard_input,
        !          1287:     "Stream for read to get input from.\n\
        !          1288: See documentation of read for possible values.");
        !          1289:   Vstandard_input = Qt;
        !          1290: 
        !          1291:   DEFVAR_LISP ("load-path", &Vload_path,
        !          1292:     "*List of directories to search for files to load.\n\
        !          1293: Each element is a string (directory name) or nil (try default directory).\n\
        !          1294: Initialized based on EMACSLOADPATH environment variable, if any,\n\
        !          1295: otherwise to default specified in by file paths.h when emacs was built.");
        !          1296: 
        !          1297:   DEFVAR_BOOL ("load-in-progress", &load_in_progress,
        !          1298:     "Non-nil iff inside of  load.");
        !          1299: 
        !          1300:   Qstandard_input = intern ("standard-input");
        !          1301:   staticpro (&Qstandard_input);
        !          1302: 
        !          1303:   Qread_char = intern ("read-char");
        !          1304:   staticpro (&Qread_char);
        !          1305: 
        !          1306:   Qget_file_char = intern ("get-file-char");
        !          1307:   staticpro (&Qget_file_char);
        !          1308: 
        !          1309:   unrch = -1;
        !          1310: }

unix.superglobalmegacorp.com

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.