1: /* Random utility Lisp functions.
   2:    Copyright (C) 1985 Richard M. Stallman.
   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 "config.h"
  23: 
  24: /* Define two macros KERNEL_FILE (file to find kernel symtab in)
  25:    and LDAV_SYMBOL (symbol name to look for), based on system type.
  26:    Also define NLIST_STRUCT if the type `nlist' is a structure we
  27:    can get from nlist.h; otherwise must use a.out.h and initialize
  28:    with strcpy.  Note that config.h may define NLIST_STRUCT
  29:    for more modrern USG systems.  */
  30: 
  31: #ifdef USG
  32: #ifdef HPUX
  33: #define LDAV_SYMBOL "_avenrun"
  34: #define KERNEL_FILE "/hp-ux"
  35: #define NLIST_STRUCT
  36: #else /* not HPUX */
  37: #define LDAV_SYMBOL "avenrun"
  38: #define KERNEL_FILE "/unix"
  39: #endif /* not HPUX */
  40: #else /* not USG */
  41: #define LDAV_SYMBOL "_avenrun"
  42: #define NLIST_STRUCT
  43: #ifndef KERNEL_FILE
  44: #define KERNEL_FILE "/vmunix"
  45: #endif /* no KERNEL_FILE yet */
  46: #endif /* not USG */
  47: 
  48: #ifdef LOAD_AVE_TYPE
  49: #ifdef BSD
  50: #include <sys/param.h>
  51: #endif /* BSD */
  52: #ifndef eunice
  53: #ifndef NLIST_STRUCT
  54: #include <a.out.h>
  55: #else /* NLIST_STRUCT */
  56: #include <nlist.h>
  57: #endif /* NLIST_STRUCT */
  58: #endif /* not eunice */
  59: #endif /* LOAD_AVE_TYPE */
  60: 
  61: #undef NULL
  62: #include "lisp.h"
  63: #include "commands.h"
  64: 
  65: #ifdef lint
  66: #include "buffer.h"
  67: #endif /* lint */
  68: 
  69: Lisp_Object Qstring_lessp;
  70: 
  71: DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0,
  72:   "Return the argument unchanged.")
  73:   (arg)
  74:      Lisp_Object arg;
  75: {
  76:   return arg;
  77: }
  78: 
  79: DEFUN ("random", Frandom, Srandom, 0, 1, 0,
  80:   "Return a pseudo-random number.\n\
  81: On most systems all integers representable in Lisp are equally likely.\n\
  82:   This is 24 bits' worth.\n\
  83: If optional argument is supplied as  t,\n\
  84:  the random number seed is set based on the current time and pid.")
  85:   (arg)
  86:      Lisp_Object arg;
  87: {
  88:   extern long random ();
  89:   extern srandom ();
  90:   extern long time ();
  91: 
  92:   if (EQ (arg, Qt))
  93:     srandom (getpid () + time (0));
  94:   return make_number ((int) random ());
  95: }
  96: 
  97: /* Random data-structure functions */
  98: 
  99: DEFUN ("length", Flength, Slength, 1, 1, 0,
 100:   "Return the length of vector, list or string SEQUENCE.")
 101:   (obj)
 102:      register Lisp_Object obj;
 103: {
 104:   register Lisp_Object tail, val;
 105:   register int i;
 106: 
 107:  retry:
 108:   if (XTYPE (obj) == Lisp_Vector || XTYPE (obj) == Lisp_String)
 109:     return Farray_length (obj);
 110:   else if (LISTP(obj))
 111:     {
 112:       for (i = 0, tail = obj; !NULL(tail); i++)
 113:     {
 114:       QUIT;
 115:       tail = Fcdr (tail);
 116:     }
 117: 
 118:       XFASTINT (val) = i;
 119:       return val;
 120:     }
 121:   else if (NULL(obj))
 122:     {
 123:       XFASTINT (val) = 0;
 124:       return val;
 125:     }
 126:   else
 127:     {
 128:       obj = wrong_type_argument (Qsequencep, obj);
 129:       goto retry;
 130:     }
 131: }
 132: 
 133: DEFUN ("string-equal", Fstring_equal, Sstring_equal, 2, 2, 0,
 134:   "T if two strings have identical contents.\n\
 135: Symbols are also allowed; their print names are used instead.")
 136:   (s1, s2)
 137:      register Lisp_Object s1, s2;
 138: {
 139:   if (XTYPE (s1) == Lisp_Symbol)
 140:     XSETSTRING (s1, XSYMBOL (s1)->name), XSETTYPE (s1, Lisp_String);
 141:   if (XTYPE (s2) == Lisp_Symbol)
 142:     XSETSTRING (s2, XSYMBOL (s2)->name), XSETTYPE (s2, Lisp_String);
 143:   CHECK_STRING (s1, 0);
 144:   CHECK_STRING (s2, 1);
 145: 
 146:   if (XSTRING (s1)->size != XSTRING (s2)->size ||
 147:       bcmp (XSTRING (s1)->data, XSTRING (s2)->data, XSTRING (s1)->size))
 148:     return Qnil;
 149:   return Qt;
 150: }
 151: 
 152: DEFUN ("string-lessp", Fstring_lessp, Sstring_lessp, 2, 2, 0,
 153:   "T if first arg string is less than second in lexicographic order.\n\
 154: Symbols are also allowed; their print names are used instead.")
 155:   (s1, s2)
 156:      register Lisp_Object s1, s2;
 157: {
 158:   register int i;
 159:   register unsigned char *p1, *p2;
 160:   register int end;
 161: 
 162:   if (XTYPE (s1) == Lisp_Symbol)
 163:     XSETSTRING (s1, XSYMBOL (s1)->name), XSETTYPE (s1, Lisp_String);
 164:   if (XTYPE (s2) == Lisp_Symbol)
 165:     XSETSTRING (s2, XSYMBOL (s2)->name), XSETTYPE (s2, Lisp_String);
 166:   CHECK_STRING (s1, 0);
 167:   CHECK_STRING (s2, 1);
 168: 
 169:   p1 = XSTRING (s1)->data;
 170:   p2 = XSTRING (s2)->data;
 171:   end = XSTRING (s1)->size;
 172:   if (end > XSTRING (s2)->size)
 173:     end = XSTRING (s2)->size;
 174: 
 175:   for (i = 0; i < end; i++)
 176:     {
 177:       if (p1[i] != p2[i])
 178:     return p1[i] < p2[i] ? Qt : Qnil;
 179:     }
 180:   return i < XSTRING (s2)->size ? Qt : Qnil;
 181: }
 182: 
 183: static Lisp_Object concat ();
 184: 
 185: /* ARGSUSED */
 186: Lisp_Object
 187: concat2 (s1, s2)
 188:      Lisp_Object s1, s2;
 189: {
 190: #ifdef NO_ARG_ARRAY
 191:   Lisp_Object args[2];
 192:   args[0] = s1;
 193:   args[1] = s2;
 194:   return concat (2, args, Lisp_String, 0);
 195: #else
 196:   return concat (2, &s1, Lisp_String, 0);
 197: #endif /* NO_ARG_ARRAY */
 198: }
 199: 
 200: DEFUN ("append", Fappend, Sappend, 0, MANY, 0,
 201:   "Concatenate arguments and make the result a list.\n\
 202: The result is a list whose elements are the elements of all the arguments.\n\
 203: Each argument may be a list, vector or string.")
 204:   (nargs, args)
 205:      int nargs;
 206:      Lisp_Object *args;
 207: {
 208:   return concat (nargs, args, Lisp_Cons, 1);
 209: }
 210: 
 211: DEFUN ("concat", Fconcat, Sconcat, 0, MANY, 0,
 212:   "Concatenate arguments and make the result a string.\n\
 213: The result is a string whose elements are the elements of all the arguments.\n\
 214: Each argument may be a list, vector or string; but all elements\n\
 215: of a list or vector must be numbers, or an error is signaled.")
 216:   (nargs, args)
 217:      int nargs;
 218:      Lisp_Object *args;
 219: {
 220:   return concat (nargs, args, Lisp_String, 0);
 221: }
 222: 
 223: DEFUN ("vconcat", Fvconcat, Svconcat, 0, MANY, 0,
 224:   "Concatenate arguments and make the result a vector.\n\
 225: The result is a list whose elements are the elements of all the arguments.\n\
 226: Each argument may be a list, vector or string.")
 227:   (nargs, args)
 228:      int nargs;
 229:      Lisp_Object *args;
 230: {
 231:   return concat (nargs, args, Lisp_Vector, 0);
 232: }
 233: 
 234: DEFUN ("copy-sequence", Fcopy_sequence, Scopy_sequence, 1, 1, 0,
 235:   "Return a copy of a list, vector or string.")
 236:   (arg)
 237:      Lisp_Object arg;
 238: {
 239:   if (NULL (arg)) return arg;
 240:   if (!LISTP (arg) && XTYPE (arg) != Lisp_Vector && XTYPE (arg) != Lisp_String)
 241:     arg = wrong_type_argument (Qsequencep, arg);
 242:   return concat (1, &arg, LISTP (arg) ? Lisp_Cons : XTYPE (arg), 0);
 243: }
 244: 
 245: static Lisp_Object
 246: concat (nargs, args, target_type, last_special)
 247:      int nargs;
 248:      Lisp_Object *args;
 249:      enum Lisp_Type target_type;
 250:      int last_special;
 251: {
 252:   Lisp_Object val;
 253:   Lisp_Object len;
 254:   register Lisp_Object tail;
 255:   register Lisp_Object this;
 256:   int toindex;
 257:   register int leni;
 258:   register int argnum;
 259:   Lisp_Object last_tail;
 260:   Lisp_Object prev;
 261: 
 262:   /* In append, the last arg isn't treated like the others */
 263:   if (last_special && nargs > 0)
 264:     {
 265:       nargs--;
 266:       last_tail = args[nargs];
 267:     }
 268:   else
 269:     last_tail = Qnil;
 270: 
 271:   for (argnum = 0; argnum < nargs; argnum++)
 272:     {
 273:       this = args[argnum];
 274:       if (!(LISTP (this) || NULL (this)
 275:           || XTYPE (this) == Lisp_Vector || XTYPE (this) == Lisp_String))
 276:     {
 277:       if (XTYPE (this) == Lisp_Int)
 278:             args[argnum] = Fint_to_string (this);
 279:       else
 280:         args[argnum] = wrong_type_argument (Qsequencep, this);
 281:     }
 282:     }
 283: 
 284:   for (argnum = 0, leni = 0; argnum < nargs; argnum++)
 285:     {
 286:       this = args[argnum];
 287:       len = Flength (this);
 288:       leni += XFASTINT (len);
 289:     }
 290: 
 291:   XFASTINT (len) = leni;
 292: 
 293:   if (target_type == Lisp_Cons)
 294:     val = Fmake_list (len, Qnil);
 295:   else if (target_type == Lisp_Vector)
 296:     val = Fmake_vector (len, Qnil);
 297:   else
 298:     val = Fmake_string (len, len);
 299: 
 300:   /* In append, if all but last arg are nil, return last arg */
 301:   if (target_type == Lisp_Cons && EQ (val, Qnil))
 302:     return last_tail;
 303: 
 304:   if (LISTP (val))
 305:     tail = val, toindex = -1;       /* -1 in toindex is flag we are making a list */
 306:   else
 307:     toindex = 0;
 308: 
 309:   prev = Qnil;
 310: 
 311:   for (argnum = 0; argnum < nargs; argnum++)
 312:     {
 313:       Lisp_Object thislen;
 314:       int thisleni;
 315:       register int thisindex = 0;
 316: 
 317:       this = args[argnum];
 318:       if (!LISTP (this))
 319:     thislen = Flength (this), thisleni = XINT (thislen);
 320: 
 321:       while (1)
 322:     {
 323:       register Lisp_Object elt;
 324: 
 325:       /* Fetch next element of `this' arg into `elt', or break if `this' is exhausted. */
 326:       if (NULL (this)) break;
 327:       if (LISTP (this))
 328:         elt = Fcar (this), this = Fcdr (this);
 329:       else
 330:         {
 331:           if (thisindex >= thisleni) break;
 332:           if (XTYPE (this) == Lisp_String)
 333:         XFASTINT (elt) = XSTRING (this)->data[thisindex++];
 334:           else
 335:         elt = XVECTOR (this)->contents[thisindex++];
 336:         }
 337: 
 338:       /* Store into result */
 339:       if (toindex < 0)
 340:         {
 341:           XCONS (tail)->car = elt;
 342:           prev = tail;
 343:           tail = XCONS (tail)->cdr;
 344:         }
 345:       else if (XTYPE (val) == Lisp_Vector)
 346:         XVECTOR (val)->contents[toindex++] = elt;
 347:       else
 348:         {
 349:           if (XTYPE (elt) != Lisp_Int)
 350:         elt = wrong_type_argument (Qintegerp, elt);
 351:           else
 352:             XSTRING (val)->data[toindex++] = XINT (elt);
 353:         }
 354:     }
 355:     }
 356:   if (!NULL (prev))
 357:     XCONS (prev)->cdr = last_tail;
 358: 
 359:   return val;
 360: }
 361: 
 362: DEFUN ("substring", Fsubstring, Ssubstring, 2, 3, 0,
 363:   "Return a substring of STRING, starting at index FROM and reaching until TO.\n\
 364: TO may be nil or omitted; then the substring runs to the end of STRING.\n\
 365: If FROM or TO is negative, it counts from the end.")
 366:   (string, from, to)
 367:      Lisp_Object string;
 368:      register Lisp_Object from, to;
 369: {
 370:   register Lisp_Object val, len;
 371: 
 372:   CHECK_STRING (string, 0);
 373:   CHECK_NUMBER (from, 1);
 374:   if (NULL (to))
 375:     to = Flength (string);
 376:   else
 377:     CHECK_NUMBER (to, 2);
 378: 
 379:   if (XINT (from) < 0)
 380:     XSETINT (from, XINT (from) + XSTRING (string)->size);
 381:   if (XINT (to) < 0)
 382:     XSETINT (to, XINT (to) + XSTRING (string)->size);
 383:   if (!(0 <= XINT (from) && XINT (from) <= XINT (to)
 384:         && XINT (to) <= XSTRING (string)->size))
 385:     args_out_of_range_3 (string, from, to);
 386: 
 387:   XFASTINT (len) = XINT (to) - XINT (from);
 388:   val = Fmake_string (len, len);
 389: 
 390:   bcopy (XSTRING (string)->data + XINT (from), XSTRING (val)->data, XINT (len));
 391: 
 392:   return val;
 393: }
 394: 
 395: DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0,
 396:   "Takes cdr N times on LIST, returns the result.")
 397:   (n, list)
 398:      Lisp_Object n;
 399:      register Lisp_Object list;
 400: {
 401:   register int i, num;
 402:   CHECK_NUMBER (n, 0);
 403:   num = XINT (n);
 404:   for (i = 0; i < num; i++)
 405:     {
 406:       QUIT;
 407:       list = Fcdr (list);
 408:     }
 409:   return list;
 410: }
 411: 
 412: DEFUN ("nth", Fnth, Snth, 2, 2, 0,
 413:   "Returns the Nth element of LIST.\n\
 414: N counts from zero.  If LIST is not that long, nil is returned.")
 415:   (n, list)
 416:      Lisp_Object n, list;
 417: {
 418:   CHECK_NUMBER (n, 0);
 419:   if (!(XTYPE (list) == Lisp_Cons || NULL (list)))
 420:     list = wrong_type_argument (Qlistp, list);
 421:   return Fcar (Fnthcdr (n, list));
 422: }
 423: 
 424: DEFUN ("elt", Felt, Selt, 2, 2, 0,
 425:   "Returns element of SEQUENCE at index N.")
 426:   (seq, n)
 427:      register Lisp_Object seq, n;
 428: {
 429:   CHECK_NUMBER (n, 0);
 430:   while (1)
 431:     {
 432:       if (XTYPE (seq) == Lisp_Cons || NULL (seq))
 433:     return Fcar (Fnthcdr (n, seq));
 434:       else if (XTYPE (seq) == Lisp_String ||
 435:            XTYPE (seq) == Lisp_Vector)
 436:     return Faref (seq, n);
 437:       else
 438:     seq = wrong_type_argument (Qsequencep, seq);
 439:     }
 440: }
 441: 
 442: DEFUN ("memq", Fmemq, Smemq, 2, 2, 0,
 443:   "Returns non-nil if ELT is an element of LIST.  Comparison done with EQ.\n\
 444: The value is actually the tail of LIST whose car is ELT.")
 445:   (elt, list)
 446:      register Lisp_Object elt;
 447:      Lisp_Object list;
 448: {
 449:   register Lisp_Object tail;
 450:   for (tail = list; !NULL (tail); tail = Fcdr (tail))
 451:     {
 452:       register Lisp_Object tem;
 453:       tem = Fcar (tail);
 454:       if (EQ (elt, tem)) return tail;
 455:       QUIT;
 456:     }
 457:   return Qnil;
 458: }
 459: 
 460: DEFUN ("assq", Fassq, Sassq, 2, 2, 0,
 461:   "Returns non-nil if ELT is the car of an element of LIST.  Comparison done with eq.\n\
 462: The value is actually the element of LIST whose car is ELT.")
 463:   (key, list)
 464:      register Lisp_Object key;
 465:      Lisp_Object list;
 466: {
 467:   register Lisp_Object tail;
 468:   for (tail = list; !NULL (tail); tail = Fcdr (tail))
 469:     {
 470:       register Lisp_Object elt, tem;
 471:       elt = Fcar (tail);
 472:       if (!LISTP (elt)) continue;
 473:       tem = Fcar (elt);
 474:       if (EQ (key, tem)) return elt;
 475:       QUIT;
 476:     }
 477:   return Qnil;
 478: }
 479: 
 480: DEFUN ("assoc", Fassoc, Sassoc, 2, 2, 0,
 481:   "Returns non-nil if ELT is the car of an element of LIST.  Comparison done with  equal.\n\
 482: The value is actually the element of LIST whose car is ELT.")
 483:   (key, list)
 484:      register Lisp_Object key;
 485:      Lisp_Object list;
 486: {
 487:   register Lisp_Object tail;
 488:   for (tail = list; !NULL (tail); tail = Fcdr (tail))
 489:     {
 490:       register Lisp_Object elt, tem;
 491:       elt = Fcar (tail);
 492:       if (!LISTP (elt)) continue;
 493:       tem = Fequal (Fcar (elt), key);
 494:       if (!NULL (tem)) return elt;
 495:       QUIT;
 496:     }
 497:   return Qnil;
 498: }
 499: 
 500: DEFUN ("rassq", Frassq, Srassq, 2, 2, 0,
 501:   "Returns non-nil if ELT is the cdr of an element of LIST.  Comparison done with EQ.\n\
 502: The value is actually the element of LIST whose cdr is ELT.")
 503:   (key, list)
 504:      register Lisp_Object key;
 505:      Lisp_Object list;
 506: {
 507:   register Lisp_Object tail;
 508:   for (tail = list; !NULL (tail); tail = Fcdr (tail))
 509:     {
 510:       register Lisp_Object elt, tem;
 511:       elt = Fcar (tail);
 512:       if (!LISTP (elt)) continue;
 513:       tem = Fcdr (elt);
 514:       if (EQ (key, tem)) return elt;
 515:       QUIT;
 516:     }
 517:   return Qnil;
 518: }
 519: 
 520: DEFUN ("delq", Fdelq, Sdelq, 2, 2, 0,
 521:   "Deletes by side effect any occurrences of ELT as a member of LIST.\n\
 522: The modified LIST is returned.\n\
 523: If the first member of LIST is ELT, there is no way to remove it by side effect;\n\
 524: therefore, write  (setq foo (delq element foo))  to be sure of changing  foo.")
 525:   (elt, list)
 526:      register Lisp_Object elt;
 527:      Lisp_Object list;
 528: {
 529:   register Lisp_Object tail, prev;
 530:   register Lisp_Object tem;
 531: 
 532:   tail = list;
 533:   prev = Qnil;
 534:   while (!NULL (tail))
 535:     {
 536:       tem = Fcar (tail);
 537:       if (EQ (elt, tem))
 538:     {
 539:       if (NULL (prev))
 540:         list = Fcdr (tail);
 541:       else
 542:         Fsetcdr (prev, Fcdr (tail));
 543:     }
 544:       else
 545:     prev = tail;
 546:       tail = Fcdr (tail);
 547:       QUIT;
 548:     }
 549:   return list;
 550: }
 551: 
 552: DEFUN ("nreverse", Fnreverse, Snreverse, 1, 1, 0,
 553:   "Reverses LIST by modifying cdr pointers.  Returns the beginning of the reversed list.")
 554:   (list)
 555:      Lisp_Object list;
 556: {
 557:   register Lisp_Object prev, tail, next;
 558: 
 559:   if (NULL (list)) return list;
 560:   prev = Qnil;
 561:   tail = list;
 562:   while (!NULL (tail))
 563:     {
 564:       QUIT;
 565:       next = Fcdr (tail);
 566:       Fsetcdr (tail, prev);
 567:       prev = tail;
 568:       tail = next;
 569:     }
 570:   return prev;
 571: }
 572: 
 573: DEFUN ("reverse", Freverse, Sreverse, 1, 1, 0,
 574:   "Reverses LIST, copying.  Returns the beginning of the reversed list.")
 575:   (list)
 576:      Lisp_Object list;
 577: {
 578:   Lisp_Object length;
 579:   register Lisp_Object *vector;
 580:   register Lisp_Object tail;
 581:   register int i;
 582: 
 583:   length = Flength (list);
 584:   vector = (Lisp_Object *) alloca (XINT (length) * sizeof (Lisp_Object));
 585:   for (i = XINT (length) - 1, tail = list; i >= 0; i--, tail = Fcdr (tail))
 586:     vector[i] = Fcar (tail);
 587: 
 588:   return Flist (XINT (length), vector);
 589: }
 590: 
 591: Lisp_Object merge ();
 592: 
 593: DEFUN ("sort", Fsort, Ssort, 2, 2, 0,
 594:   "Sort LIST, stably, comparing elements using PREDICATE.\n\
 595: Returns the sorted list.  LIST is modified by side effects.\n\
 596: PREDICATE is called with two elements of LIST, and should return T\n\
 597: if the first element is \"less\" than the second.")
 598:   (list, pred)
 599:      Lisp_Object list, pred;
 600: {
 601:   Lisp_Object front, back;
 602:   register Lisp_Object len, tem;
 603:   struct gcpro gcpro1, gcpro2;
 604:   register int length;
 605: 
 606:   front = list;
 607:   len = Flength (list);
 608:   length = XINT (len);
 609:   if (length < 2)
 610:     return list;
 611: 
 612:   XSETINT (len, (length / 2) - 1);
 613:   tem = Fnthcdr (len, list);
 614:   back = Fcdr (tem);
 615:   Fsetcdr (tem, Qnil);
 616: 
 617:   GCPRO2 (front, back);
 618:   front = Fsort (front, pred);
 619:   back = Fsort (back, pred);
 620:   UNGCPRO;
 621:   return merge (front, back, pred);
 622: }
 623: 
 624: Lisp_Object
 625: merge (org_l1, org_l2, pred)
 626:      Lisp_Object org_l1, org_l2;
 627:      Lisp_Object pred;
 628: {
 629:   Lisp_Object value;
 630:   register Lisp_Object tail;
 631:   Lisp_Object tem;
 632:   register Lisp_Object l1, l2;
 633:   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
 634: 
 635:   l1 = org_l1;
 636:   l2 = org_l2;
 637:   tail = Qnil;
 638:   value = Qnil;
 639: 
 640:   /* It is sufficient to protect org_l1 and org_l2.
 641:      When l1 and l2 are updated, we copy the new values
 642:      back into the org_ vars.  */
 643:   GCPRO4 (org_l1, org_l2, pred, value);
 644: 
 645:   while (1)
 646:     {
 647:       if (NULL (l1))
 648:     {
 649:       UNGCPRO;
 650:       if (NULL (tail))
 651:         return l2;
 652:       Fsetcdr (tail, l2);
 653:       return value;
 654:     }
 655:       if (NULL (l2))
 656:     {
 657:       UNGCPRO;
 658:       if (NULL (tail))
 659:         return l1;
 660:       Fsetcdr (tail, l1);
 661:       return value;
 662:     }
 663:       tem = call2 (pred, Fcar (l1), Fcar (l2));
 664:       if (!NULL (tem))
 665:     {
 666:       tem = l1;
 667:       l1 = Fcdr (l1);
 668:       org_l1 = l1;
 669:     }
 670:       else
 671:     {
 672:       tem = l2;
 673:       l2 = Fcdr (l2);
 674:       org_l2 = l2;
 675:     }
 676:       if (NULL (tail))
 677:     value = tem;
 678:       else
 679:     Fsetcdr (tail, tem);
 680:       tail = tem;
 681:     }
 682: }
 683: 
 684: DEFUN ("get", Fget, Sget, 2, 2, 0,
 685:   "Return the value of SYMBOL's PROPNAME property.\n\
 686: This is the last VALUE stored with  (put SYMBOL PROPNAME VALUE).")
 687:   (sym, prop)
 688:      Lisp_Object sym;
 689:      register Lisp_Object prop;
 690: {
 691:   register Lisp_Object tail;
 692:   for (tail = Fsymbol_plist (sym); !NULL (tail); tail = Fcdr (Fcdr (tail)))
 693:     {
 694:       register Lisp_Object tem;
 695:       tem = Fcar (tail);
 696:       if (EQ (prop, tem))
 697:     return Fcar (Fcdr (tail));
 698:     }
 699:   return Qnil;
 700: }
 701: 
 702: DEFUN ("put", Fput, Sput, 3, 3, 0,
 703:   "Store SYMBOL's PROPNAME property with value VALUE.\n\
 704: It can be retrieved with  (get SYMBOL PROPNAME).")
 705:   (sym, prop, val)
 706:      Lisp_Object sym;
 707:      register Lisp_Object prop;
 708:      Lisp_Object val;
 709: {
 710:   register Lisp_Object tail, prev;
 711:   Lisp_Object newcell;
 712:   prev = Qnil;
 713:   for (tail = Fsymbol_plist (sym); !NULL (tail); tail = Fcdr (Fcdr (tail)))
 714:     {
 715:       register Lisp_Object tem;
 716:       tem = Fcar (tail);
 717:       if (EQ (prop, tem))
 718:     return Fsetcar (Fcdr (tail), val);
 719:       prev = tail;
 720:     }
 721:   newcell = Fcons (prop, Fcons (val, Qnil));
 722:   if (NULL (prev))
 723:     Fsetplist (sym, newcell);
 724:   else
 725:     Fsetcdr (Fcdr (prev), newcell);
 726:   return val;
 727: }
 728: 
 729: DEFUN ("equal", Fequal, Sequal, 2, 2, 0,
 730:   "T if two Lisp objects have similar structure and contents.\n\
 731: They must have the same data type.\n\
 732: Conses are compared by comparing the cars and the cdrs.\n\
 733: Vectors and strings are compared element by element.\n\
 734: Numbers are compared by value.  Symbols must match exactly.")
 735:   (o1, o2)
 736:      register Lisp_Object o1, o2;
 737: {
 738: do_cdr:
 739:   QUIT;
 740:   if (XTYPE (o1) != XTYPE (o2)) return Qnil;
 741:   if (XINT (o1) == XINT (o2)) return Qt;
 742:   if (XTYPE (o1) == Lisp_Cons)
 743:     {
 744:       Lisp_Object v1;
 745:       v1 = Fequal (Fcar (o1), Fcar (o2));
 746:       if (NULL (v1))
 747:     return v1;
 748:       o1 = Fcdr (o1), o2 = Fcdr (o2);
 749:       goto do_cdr;
 750:     }
 751:   if (XTYPE (o1) == Lisp_Marker)
 752:     {
 753:       return (XMARKER (o1)->buffer == XMARKER (o2)->buffer
 754:           && XMARKER (o1)->bufpos == XMARKER (o2)->bufpos)
 755:     ? Qt : Qnil;
 756:     }
 757:   if (XTYPE (o1) == Lisp_Vector)
 758:     {
 759:       register int index;
 760:       if (XVECTOR (o1)->size != XVECTOR (o2)->size)
 761:     return Qnil;
 762:       for (index = 0; index < XVECTOR (o1)->size; index++)
 763:     {
 764:       Lisp_Object v, v1, v2;
 765:       v1 = XVECTOR (o1)->contents [index];
 766:       v2 = XVECTOR (o2)->contents [index];
 767:       v = Fequal (v1, v2);
 768:       if (NULL (v)) return v;
 769:     }
 770:       return Qt;
 771:     }
 772:   if (XTYPE (o1) == Lisp_String)
 773:     {
 774:       if (XSTRING (o1)->size != XSTRING (o2)->size)
 775:     return Qnil;
 776:       if (bcmp (XSTRING (o1)->data, XSTRING (o2)->data, XSTRING (o1)->size))
 777:     return Qnil;
 778:       return Qt;
 779:     }
 780:   return Qnil;
 781: }
 782: 
 783: DEFUN ("fillarray", Ffillarray, Sfillarray, 2, 2, 0,
 784:   "Store each element of ARRAY with ITEM.  ARRAY is a vector or string.")
 785:   (array, item)
 786:      Lisp_Object array, item;
 787: {
 788:   register int size, index, charval;
 789:  retry:
 790:   if (XTYPE (array) == Lisp_Vector)
 791:     {
 792:       register Lisp_Object *p = XVECTOR (array)->contents;
 793:       size = XVECTOR (array)->size;
 794:       for (index = 0; index < size; index++)
 795:     p[index] = item;
 796:     }
 797:   else if (XTYPE (array) == Lisp_String)
 798:     {
 799:       register unsigned char *p = XSTRING (array)->data;
 800:       CHECK_NUMBER (item, 1);
 801:       charval = XINT (item);
 802:       size = XSTRING (array)->size;
 803:       for (index = 0; index < size; index++)
 804:     p[index] = charval;
 805:     }
 806:   else
 807:     {
 808:       array = wrong_type_argument (Qarrayp, array);
 809:       goto retry;
 810:     }
 811:   return array;
 812: }
 813: 
 814: /* ARGSUSED */
 815: Lisp_Object
 816: nconc2 (s1, s2)
 817:      Lisp_Object s1, s2;
 818: {
 819: #ifdef NO_ARG_ARRAY
 820:   Lisp_Object args[2];
 821:   args[0] = s1;
 822:   args[1] = s2;
 823:   return Fnconc (2, args);
 824: #else
 825:   return Fnconc (2, &s1);
 826: #endif /* NO_ARG_ARRAY */
 827: }
 828: 
 829: DEFUN ("nconc", Fnconc, Snconc, 0, MANY, 0,
 830:   "Concatenate any number of lists by altering them.\n\
 831: Only the last argument is not altered, and need not be a list.")
 832:   (nargs, args)
 833:      int nargs;
 834:      Lisp_Object *args;
 835: {
 836:   register int argnum;
 837:   register Lisp_Object tail, tem, val;
 838: 
 839:   val = Qnil;
 840: 
 841:   for (argnum = 0; argnum < nargs; argnum++)
 842:     {
 843:       tem = args[argnum];
 844:       if (NULL (tem)) continue;
 845: 
 846:       if (!LISTP (tem))
 847:     tem = wrong_type_argument (Qlistp, tem);
 848: 
 849:       if (NULL (val))
 850:     val = tem;
 851: 
 852:       if (argnum + 1 == nargs) break;
 853: 
 854:       while (LISTP (tem))
 855:     {
 856:       tail = tem;
 857:       tem = Fcdr (tail);
 858:       QUIT;
 859:     }
 860: 
 861:       tem = args[argnum + 1];
 862:       Fsetcdr (tail, tem);
 863:       if (NULL (tem))
 864:     args[argnum + 1] = tail;
 865:     }
 866: 
 867:   return val;
 868: }
 869: 
 870: /* This is the guts of all mapping functions.
 871:  Apply fn to each element of seq, one by one,
 872:  storing the results into elements of vals, a C vector of Lisp_Objects.
 873:  leni is the length of vals, which should also be the length of seq. */
 874: 
 875: static void
 876: mapcar1 (leni, vals, fn, seq)
 877:      int leni;
 878:      Lisp_Object *vals;
 879:      Lisp_Object fn, seq;
 880: {
 881:   register Lisp_Object tail;
 882:   Lisp_Object dummy;
 883:   register int i;
 884:   struct gcpro gcpro1, gcpro2, gcpro3;
 885: 
 886:   /* Don't let vals contain any garbage when GC happens.  */
 887:   for (i = 0; i < leni; i++)
 888:     vals[i] = Qnil;
 889: 
 890:   GCPRO3 (dummy, fn, seq);
 891:   gcpro1.var = vals;
 892:   gcpro1.nvars = leni;
 893:   /* We need not explicitly protect `tail' because it is used only on lists, and
 894:     1) lists are not relocated and 2) the list is marked via `seq' so will not be freed */
 895: 
 896:   if (XTYPE (seq) == Lisp_Vector)
 897:     {
 898:       for (i = 0; i < leni; i++)
 899:     {
 900:       dummy = XVECTOR (seq)->contents[i];
 901:       vals[i] = call1 (fn, dummy);
 902:     }
 903:     }
 904:   else if (XTYPE (seq) == Lisp_String)
 905:     {
 906:       for (i = 0; i < leni; i++)
 907:     {
 908:       XFASTINT (dummy) = XSTRING (seq)->data[i];
 909:       vals[i] = call1 (fn, dummy);
 910:     }
 911:     }
 912:   else   /* Must be a list, since Flength did not get an error */
 913:     {
 914:       tail = seq;
 915:       for (i = 0; i < leni; i++)
 916:     {
 917:       vals[i] = call1 (fn, Fcar (tail));
 918:       tail = Fcdr (tail);
 919:     }
 920:     }
 921: 
 922:   UNGCPRO;
 923: }
 924: 
 925: DEFUN ("mapconcat", Fmapconcat, Smapconcat, 3, 3, 0,
 926:   "Apply FN to each element of SEQ, and concat the results as strings.\n\
 927: In between each pair of results, stick in SEP.\n\
 928: Thus, \" \" as SEP results in spaces between the values return by FN.")
 929:   (fn, seq, sep)
 930:      Lisp_Object fn, seq, sep;
 931: {
 932:   Lisp_Object len;
 933:   register int leni;
 934:   int nargs;
 935:   register Lisp_Object *args;
 936:   register int i;
 937: 
 938:   len = Flength (seq);
 939:   leni = XINT (len);
 940:   nargs = leni + leni - 1;
 941:   if (nargs < 0) return build_string ("");
 942: 
 943:   args = (Lisp_Object *) alloca (nargs * sizeof (Lisp_Object));
 944: 
 945:   mapcar1 (leni, args, fn, seq);
 946: 
 947:   for (i = leni - 1; i >= 0; i--)
 948:     args[i + i] = args[i];
 949: 
 950:   for (i = 1; i < nargs; i += 2)
 951:     args[i] = sep;
 952: 
 953:   return Fconcat (nargs, args);
 954: }
 955: 
 956: DEFUN ("mapcar", Fmapcar, Smapcar, 2, 2, 0,
 957:   "Apply FUNCTION to each element of LIST, and make a list of the results.\n\
 958: The result is a list just as long as LIST.")
 959:   (fn, seq)
 960:      Lisp_Object fn, seq;
 961: {
 962:   register Lisp_Object len;
 963:   register int leni;
 964:   register Lisp_Object *args;
 965: 
 966:   len = Flength (seq);
 967:   leni = XFASTINT (len);
 968:   args = (Lisp_Object *) alloca (leni * sizeof (Lisp_Object));
 969: 
 970:   mapcar1 (leni, args, fn, seq);
 971: 
 972:   return Flist (leni, args);
 973: }
 974: 
 975: DEFUN ("y-or-n-p", Fy_or_n_p, Sy_or_n_p, 1, 1, 0,
 976:   "Ask user a \"y or n\" question.  Return t if answer is \"y\".\n\
 977: No confirmation of the answer is requested; a single character is enough.\n\
 978: Also accepts Space to mean yes, or Delete to mean no.")
 979:   (prompt)
 980:      Lisp_Object prompt;
 981: {
 982:   register int ans;
 983:   register Lisp_Object xprompt;
 984:   Lisp_Object args[2];
 985: 
 986:   CHECK_STRING (prompt, 0);
 987:   xprompt = prompt;
 988:   while (1)
 989:     {
 990:       message ("%s(y or n) ", XSTRING (xprompt)->data);
 991:       ans = get_char (0);
 992:       message ("%s(y or n) %c", XSTRING (xprompt)->data, ans);
 993:       QUIT;
 994:       if (ans >= 'A' && ans <= 'Z') ans += 'a' - 'A';
 995:       if (ans == 'y' || ans == ' ')
 996:     return Qt;
 997:       if (ans == 'n' || ans == 127)
 998:     return Qnil;
 999:       if (EQ (xprompt, prompt))
1000:     {
1001:       Fdiscard_input ();
1002:       args[0] = build_string ("Please answer y or n.  ");
1003:       args[1] = prompt;
1004:       xprompt = Fconcat (2, args);
1005:     }
1006:     }
1007: }
1008: 
1009: DEFUN ("yes-or-no-p", Fyes_or_no_p, Syes_or_no_p, 1, 1, 0,
1010:   "Ask user a yes or no question.  Return t if answer is yes.\n\
1011: The user must confirm the answer with a newline, and can rub it out if not confirmed.")
1012:   (prompt)
1013:      Lisp_Object prompt;
1014: {
1015:   register Lisp_Object ans;
1016:   Lisp_Object args[2];
1017:   CHECK_STRING (prompt, 0);
1018: 
1019:   args[0] = prompt;
1020:   args[1] = build_string ("(yes or no) ");
1021:   prompt = Fconcat (2, args);
1022:   while (1)
1023:     {
1024:       ans = Fdowncase (read_minibuf_string (Vminibuffer_local_map,
1025:                         Qnil,
1026:                         prompt));
1027:       if (XSTRING (ans)->size == 3 && !strcmp (XSTRING (ans)->data, "yes"))
1028:     return Qt;
1029:       if (XSTRING (ans)->size == 2 && !strcmp (XSTRING (ans)->data, "no"))
1030:     return Qnil;
1031: 
1032:       Fdiscard_input ();
1033:       message ("Please answer yes or no.");
1034:       Fsleep_for (make_number (2));
1035:     }
1036: }
1037: 
1038: /* Avoid static vars inside a function since in HPUX they dump as pure.  */
1039: static int ldav_initialized;
1040: static int ldav_channel;
1041: #ifdef LOAD_AVE_TYPE
1042: static struct nlist ldav_nl[2];
1043: #endif /* LOAD_AVE_TYPE */
1044: 
1045: #define channel ldav_channel
1046: #define initialized ldav_initialized
1047: #define nl ldav_nl
1048: 
1049: DEFUN ("load-average", Fload_average, Sload_average, 0, 0, 0,
1050:   "Return the current 1 minute, 5 minute and 15 minute load averages\n\
1051: in a list (all floating point load average values are multiplied by 100\n\
1052: and then turned into integers).")
1053:   ()
1054: {
1055: #ifdef  eunice
1056: #include <vms/iodef.h>
1057:   /*
1058:    *	VMS/Eunice specific code -- read from the Load Ave driver
1059:    */
1060:   float load_ave[3];
1061:   struct {int size; char *ptr;} descriptor;
1062: 
1063:   /* If this fails for any reason, we can return (0 0 0) */
1064:   load_ave[0] = 0.0; load_ave[1] = 0.0; load_ave[2] = 0.0;
1065: 
1066:   /*
1067:    *	Ensure that there is a channel open to the load ave device
1068:    */
1069:   if (initialized == 0)
1070:     {
1071:       /* Attempt to open the channel */
1072:       descriptor.size = 18;
1073:       descriptor.ptr  = "$$VMS_LOAD_AVERAGE";
1074:       if (sys$assign (&descriptor, &channel, 0, 0) & 1)
1075:     initialized = 1;
1076:     }
1077:   /*
1078:    *	Read the load average vector
1079:    */
1080:   if (initialized)
1081:     {
1082:       if (!(sys$qiow (0, channel, IO$_READVBLK, 0, 0, 0,
1083:              load_ave, 12, 0, 0, 0, 0)
1084:         & 1))
1085:     {
1086:       sys$dassgn (channel);
1087:       initialized = 0;
1088:     }
1089:     }
1090: #else  /* not eunice */
1091: 
1092: #ifndef LOAD_AVE_TYPE
1093:   error ("load-average not implemented for this operating system");
1094: #define LOAD_AVE_CVT(x) 0
1095: #else /* LOAD_AVE_TYPE defined */
1096:   /*
1097:    *	4.2BSD UNIX-specific code -- read _avenrun from /dev/kmem
1098:    */
1099: 
1100:   LOAD_AVE_TYPE load_ave[3];
1101: 
1102:   /* If this fails for any reason, we can return (0 0 0) */
1103:   load_ave[0] = 0.0; load_ave[1] = 0.0; load_ave[2] = 0.0;
1104: 
1105:   /*
1106:    *	Make sure we have the address of _avenrun
1107:    */
1108:   if (nl[0].n_value == 0)
1109:     {
1110:       /*
1111:        *	Get the address of _avenrun
1112:        */
1113: #ifndef NLIST_STRUCT
1114:       strcpy (nl[0].n_name, LDAV_SYMBOL);
1115:       nl[1].n_zeroes = 0;
1116: #else /* NLIST_STRUCT */
1117:       nl[0].n_name = LDAV_SYMBOL;
1118:       nl[1].n_name = 0;
1119: #endif /* NLIST_STRUCT */
1120: 
1121:       nlist (KERNEL_FILE, nl);
1122: 
1123: #ifdef FIXUP_KERNEL_SYMBOL_ADDR
1124:       if ((nl[0].n_type & N_TYPE) != N_ABS)
1125:     nl[0].n_value = (nlp->n_value >> 2) | 0xc0000000;
1126: #endif /* FIXUP_KERNEL_SYMBOL_ADDR */
1127:     }
1128:   /*
1129:    *	Make sure we have /dev/kmem open
1130:    */
1131:   if (initialized == 0)
1132:     {
1133:       /*
1134:        *	Open /dev/kmem
1135:        */
1136:       channel = open ("/dev/kmem", 0);
1137:       if (channel >= 0) initialized = 1;
1138:     }
1139:   /*
1140:    *	If we can, get the load ave values
1141:    */
1142:   if ((nl[0].n_value != 0) && (initialized != 0))
1143:     {
1144:       /*
1145:        *	Seek to the correct address
1146:        */
1147:       lseek (channel, (long) nl[0].n_value, 0);
1148:       if (read (channel, load_ave, sizeof load_ave)
1149:       != sizeof(load_ave))
1150:     {
1151:       close (channel);
1152:       initialized = 0;
1153:     }
1154:     }
1155: #endif /* LOAD_AVE_TYPE */
1156: #endif /* not eunice */
1157: 
1158:   /*
1159:    *	Return the list of load average values
1160:    */
1161:   return Fcons (make_number (LOAD_AVE_CVT (load_ave[0])),
1162:         Fcons (make_number (LOAD_AVE_CVT (load_ave[1])),
1163:                Fcons (make_number (LOAD_AVE_CVT (load_ave[2])),
1164:                   Qnil)));
1165: }
1166: 
1167: #undef channel
1168: #undef initialized
1169: #undef nl
1170: 
1171: Lisp_Object Vfeatures;
1172: 
1173: DEFUN ("featurep", Ffeaturep, Sfeaturep, 1, 1, 0,
1174:   "Returns t if FEATURE is present in this Emacs.\n\
1175: Use this to conditionalize execution of lisp code based on the presence or\n\
1176: absence of emacs or environment extensions.\n\
1177: Use  provide  to declare that a feature is available.\n\
1178: This function looks at the value of the variable  features.")
1179:      (feature)
1180:      Lisp_Object feature;
1181: {
1182:   register Lisp_Object tem;
1183:   CHECK_SYMBOL (feature, 0);
1184:   tem = Fmemq (feature, Vfeatures);
1185:   return (NULL (tem)) ? Qnil : Qt;
1186: }
1187: 
1188: DEFUN ("provide", Fprovide, Sprovide, 1, 1, 0,
1189:   "Announce that FEATURE is a feature of the current Emacs.")
1190:      (feature)
1191:      Lisp_Object feature;
1192: {
1193:   register Lisp_Object tem;
1194:   CHECK_SYMBOL (feature, 0);
1195:   if (!NULL (Vautoload_queue))
1196:     Vautoload_queue = Fcons (Fcons (Vfeatures, Qnil), Vautoload_queue);
1197:   tem = Fmemq (feature, Vfeatures);
1198:   if (NULL (tem))
1199:     Vfeatures = Fcons (feature, Vfeatures);
1200:   return feature;
1201: }
1202: 
1203: DEFUN ("require", Frequire, Srequire, 1, 2, 0,
1204:   "If FEATURE is not present in Emacs (ie (featurep FEATURE) is false),\n\
1205: load FILENAME.  FILENAME is optional and defaults to FEATURE.")
1206:      (feature, file_name)
1207:      Lisp_Object feature, file_name;
1208: {
1209:   register Lisp_Object tem;
1210:   CHECK_SYMBOL (feature, 0);
1211:   tem = Fmemq (feature, Vfeatures);
1212:   if (NULL (tem))
1213:     {
1214:       Fload (NULL (file_name) ? Fsymbol_name (feature) : file_name,
1215:          Qnil, Qt);
1216:       tem = Fmemq (feature, Vfeatures);
1217:       if (NULL (tem))
1218:     error ("Required feature %s was not provided",
1219:            XSYMBOL (feature)->name->data );
1220:     }
1221:   return feature;
1222: }
1223: 
1224: syms_of_fns ()
1225: {
1226:   Qstring_lessp = intern ("string-lessp");
1227:   staticpro (&Qstring_lessp);
1228: 
1229:   DefLispVar ("features", &Vfeatures,
1230:     "A list of symbols which are the features of the executing emacs.\n\
1231: Used by  featurep  and  require, and altered by  provide.");
1232:   Vfeatures = Qnil;
1233: 
1234:   defsubr (&Sidentity);
1235:   defsubr (&Srandom);
1236:   defsubr (&Slength);
1237:   defsubr (&Sstring_equal);
1238:   defsubr (&Sstring_lessp);
1239:   defalias (&Sstring_equal, "string=");
1240:   defalias (&Sstring_lessp, "string<");
1241:   defsubr (&Sappend);
1242:   defsubr (&Sconcat);
1243:   defsubr (&Svconcat);
1244:   defsubr (&Scopy_sequence);
1245:   defsubr (&Ssubstring);
1246:   defsubr (&Snthcdr);
1247:   defsubr (&Snth);
1248:   defsubr (&Selt);
1249:   defsubr (&Smemq);
1250:   defsubr (&Sassq);
1251:   defsubr (&Sassoc);
1252:   defsubr (&Srassq);
1253:   defsubr (&Sdelq);
1254:   defsubr (&Snreverse);
1255:   defsubr (&Sreverse);
1256:   defsubr (&Ssort);
1257:   defsubr (&Sget);
1258:   defsubr (&Sput);
1259:   defsubr (&Sequal);
1260:   defsubr (&Sfillarray);
1261:   defsubr (&Snconc);
1262:   defsubr (&Smapcar);
1263:   defsubr (&Smapconcat);
1264:   defsubr (&Sy_or_n_p);
1265:   defsubr (&Syes_or_no_p);
1266:   defsubr (&Sload_average);
1267:   defsubr (&Sfeaturep);
1268:   defsubr (&Srequire);
1269:   defsubr (&Sprovide);
1270: }

Defined functions

DEFUN defined in line 1203; never used
concat defined in line 245; used 7 times
mapcar1 defined in line 875; used 2 times
merge defined in line 624; used 2 times
syms_of_fns defined in line 1224; used 1 times

Defined variables

Qstring_lessp defined in line 69; used 2 times
Vfeatures defined in line 1171; used 9 times
ldav_channel defined in line 1040; used 1 times
ldav_initialized defined in line 1039; used 1 times
ldav_nl defined in line 1042; used 1 times

Defined macros

KERNEL_FILE defined in line 44; used 2 times
LDAV_SYMBOL defined in line 41; used 2 times
LOAD_AVE_CVT defined in line 1094; used 3 times
NLIST_STRUCT defined in line 42; used 2 times
channel defined in line 1045; used 9 times
initialized defined in line 1046; used 9 times
nl defined in line 1047; used 11 times
Last modified: 1986-02-25
Generated: 2016-12-26
Generated by src2html V0.67
page hit count: 2132
Valid CSS Valid XHTML 1.0 Strict