--- /dev/null
+/**
+ * @file SFMT-alti.h
+ *
+ * @brief SIMD oriented Fast Mersenne Twister(SFMT)
+ * pseudorandom number generator
+ *
+ * @author Mutsuo Saito (Hiroshima University)
+ * @author Makoto Matsumoto (Hiroshima University)
+ *
+ * Copyright (C) 2007 Mutsuo Saito, Makoto Matsumoto and Hiroshima
+ * University. All rights reserved.
+ *
+ * The new BSD License is applied to this software.
+ * see LICENSE.txt
+ */
+
+#ifndef SFMT_ALTI_H
+#define SFMT_ALTI_H
+
+inline static vector unsigned int
+vec_recursion(vector unsigned int a,
+ vector unsigned int b,
+ vector unsigned int c, vector unsigned int d)
+ ALWAYSINLINE;
+
+/**
+ * This function represents the recursion formula in AltiVec and BIG ENDIAN.
+ * @param a a 128-bit part of the interal state array
+ * @param b a 128-bit part of the interal state array
+ * @param c a 128-bit part of the interal state array
+ * @param d a 128-bit part of the interal state array
+ * @return output
+ */
+ inline static vector unsigned int vec_recursion(vector unsigned int a,
+ vector unsigned int b,
+ vector unsigned int c,
+ vector unsigned int d)
+{
+
+ const vector unsigned int sl1 = ALTI_SL1;
+ const vector unsigned int sr1 = ALTI_SR1;
+#ifdef ONLY64
+ const vector unsigned int mask = ALTI_MSK64;
+ const vector unsigned char perm_sl = ALTI_SL2_PERM64;
+ const vector unsigned char perm_sr = ALTI_SR2_PERM64;
+#else
+ const vector unsigned int mask = ALTI_MSK;
+ const vector unsigned char perm_sl = ALTI_SL2_PERM;
+ const vector unsigned char perm_sr = ALTI_SR2_PERM;
+#endif
+ vector unsigned int v, w, x, y, z;
+ x = vec_perm(a, (vector unsigned int) perm_sl, perm_sl);
+ v = a;
+ y = vec_sr(b, sr1);
+ z = vec_perm(c, (vector unsigned int) perm_sr, perm_sr);
+ w = vec_sl(d, sl1);
+ z = vec_xor(z, w);
+ y = vec_and(y, mask);
+ v = vec_xor(v, x);
+ z = vec_xor(z, y);
+ z = vec_xor(z, v);
+ return z;
+}
+
+/**
+ * This function fills the internal state array with pseudorandom
+ * integers.
+ */
+inline static void
+gen_rand_all(void)
+{
+ int i;
+ vector unsigned int r, r1, r2;
+
+ r1 = sfmt[N - 2].s;
+ r2 = sfmt[N - 1].s;
+ for (i = 0; i < N - POS1; i++) {
+ r = vec_recursion(sfmt[i].s, sfmt[i + POS1].s, r1, r2);
+ sfmt[i].s = r;
+ r1 = r2;
+ r2 = r;
+ }
+ for (; i < N; i++) {
+ r = vec_recursion(sfmt[i].s, sfmt[i + POS1 - N].s, r1, r2);
+ sfmt[i].s = r;
+ r1 = r2;
+ r2 = r;
+ }
+}
+
+/**
+ * This function fills the user-specified array with pseudorandom
+ * integers.
+ *
+ * @param array an 128-bit array to be filled by pseudorandom numbers.
+ * @param size number of 128-bit pesudorandom numbers to be generated.
+ */
+inline static void
+gen_rand_array(w128_t *array, int size)
+{
+ int i, j;
+ vector unsigned int r, r1, r2;
+
+ r1 = sfmt[N - 2].s;
+ r2 = sfmt[N - 1].s;
+ for (i = 0; i < N - POS1; i++) {
+ r = vec_recursion(sfmt[i].s, sfmt[i + POS1].s, r1, r2);
+ array[i].s = r;
+ r1 = r2;
+ r2 = r;
+ }
+ for (; i < N; i++) {
+ r = vec_recursion(sfmt[i].s, array[i + POS1 - N].s, r1, r2);
+ array[i].s = r;
+ r1 = r2;
+ r2 = r;
+ }
+ /* main loop */
+ for (; i < size - N; i++) {
+ r = vec_recursion(array[i - N].s, array[i + POS1 - N].s, r1, r2);
+ array[i].s = r;
+ r1 = r2;
+ r2 = r;
+ }
+ for (j = 0; j < 2 * N - size; j++) {
+ sfmt[j].s = array[j + size - N].s;
+ }
+ for (; i < size; i++) {
+ r = vec_recursion(array[i - N].s, array[i + POS1 - N].s, r1, r2);
+ array[i].s = r;
+ sfmt[j++].s = r;
+ r1 = r2;
+ r2 = r;
+ }
+}
+
+#ifndef ONLY64
+#if defined(__APPLE__)
+#define ALTI_SWAP (vector unsigned char) \
+ (4, 5, 6, 7, 0, 1, 2, 3, 12, 13, 14, 15, 8, 9, 10, 11)
+#else
+#define ALTI_SWAP {4, 5, 6, 7, 0, 1, 2, 3, 12, 13, 14, 15, 8, 9, 10, 11}
+#endif
+/**
+ * This function swaps high and low 32-bit of 64-bit integers in user
+ * specified array.
+ *
+ * @param array an 128-bit array to be swaped.
+ * @param size size of 128-bit array.
+ */
+inline static void
+swap(w128_t *array, int size)
+{
+ int i;
+ const vector unsigned char perm = ALTI_SWAP;
+
+ for (i = 0; i < size; i++) {
+ array[i].s = vec_perm(array[i].s, (vector unsigned int) perm, perm);
+ }
+}
+#endif
+
+#endif
--- /dev/null
+#ifndef SFMT_PARAMS_H
+#define SFMT_PARAMS_H
+
+/* Just always use this period */
+#define MEXP 19937
+
+#if !defined(MEXP)
+#ifdef __GNUC__
+#warning "MEXP is not defined. I assume MEXP is 19937."
+#endif
+#define MEXP 19937
+#endif
+/*-----------------
+ BASIC DEFINITIONS
+ -----------------*/
+/** Mersenne Exponent. The period of the sequence
+ * is a multiple of 2^MEXP-1.
+ * #define MEXP 19937 */
+/** SFMT generator has an internal state array of 128-bit integers,
+ * and N is its size. */
+#define N (MEXP / 128 + 1)
+/** N32 is the size of internal state array when regarded as an array
+ * of 32-bit integers.*/
+#define N32 (N * 4)
+/** N64 is the size of internal state array when regarded as an array
+ * of 64-bit integers.*/
+#define N64 (N * 2)
+
+/*----------------------
+ the parameters of SFMT
+ following definitions are in paramsXXXX.h file.
+ ----------------------*/
+/** the pick up position of the array.
+#define POS1 122
+*/
+
+/** the parameter of shift left as four 32-bit registers.
+#define SL1 18
+ */
+
+/** the parameter of shift left as one 128-bit register.
+ * The 128-bit integer is shifted by (SL2 * 8) bits.
+#define SL2 1
+*/
+
+/** the parameter of shift right as four 32-bit registers.
+#define SR1 11
+*/
+
+/** the parameter of shift right as one 128-bit register.
+ * The 128-bit integer is shifted by (SL2 * 8) bits.
+#define SR2 1
+*/
+
+/** A bitmask, used in the recursion. These parameters are introduced
+ * to break symmetry of SIMD.
+#define MSK1 0xdfffffefU
+#define MSK2 0xddfecb7fU
+#define MSK3 0xbffaffffU
+#define MSK4 0xbffffff6U
+*/
+
+/** These definitions are part of a 128-bit period certification vector.
+#define PARITY1 0x00000001U
+#define PARITY2 0x00000000U
+#define PARITY3 0x00000000U
+#define PARITY4 0xc98e126aU
+*/
+
+#if MEXP == 607
+#include "SFMT-params607.h"
+#elif MEXP == 1279
+#include "SFMT-params1279.h"
+#elif MEXP == 2281
+#include "SFMT-params2281.h"
+#elif MEXP == 4253
+#include "SFMT-params4253.h"
+#elif MEXP == 11213
+#include "SFMT-params11213.h"
+#elif MEXP == 19937
+#include "SFMT-params19937.h"
+#elif MEXP == 44497
+#include "SFMT-params44497.h"
+#elif MEXP == 86243
+#include "SFMT-params86243.h"
+#elif MEXP == 132049
+#include "SFMT-params132049.h"
+#elif MEXP == 216091
+#include "SFMT-params216091.h"
+#else
+#ifdef __GNUC__
+#error "MEXP is not valid."
+#undef MEXP
+#else
+#undef MEXP
+#endif
+
+#endif
+
+#endif /* SFMT_PARAMS_H */
--- /dev/null
+#ifndef SFMT_PARAMS19937_H
+#define SFMT_PARAMS19937_H
+
+#define POS1 122
+#define SL1 18
+#define SL2 1
+#define SR1 11
+#define SR2 1
+#define MSK1 0xdfffffefU
+#define MSK2 0xddfecb7fU
+#define MSK3 0xbffaffffU
+#define MSK4 0xbffffff6U
+#define PARITY1 0x00000001U
+#define PARITY2 0x00000000U
+#define PARITY3 0x00000000U
+#define PARITY4 0x13c9e684U
+
+
+/* PARAMETERS FOR ALTIVEC */
+#if defined(__APPLE__) /* For OSX */
+#define ALTI_SL1 (vector unsigned int)(SL1, SL1, SL1, SL1)
+#define ALTI_SR1 (vector unsigned int)(SR1, SR1, SR1, SR1)
+#define ALTI_MSK (vector unsigned int)(MSK1, MSK2, MSK3, MSK4)
+#define ALTI_MSK64 \
+ (vector unsigned int)(MSK2, MSK1, MSK4, MSK3)
+#define ALTI_SL2_PERM \
+ (vector unsigned char)(1,2,3,23,5,6,7,0,9,10,11,4,13,14,15,8)
+#define ALTI_SL2_PERM64 \
+ (vector unsigned char)(1,2,3,4,5,6,7,31,9,10,11,12,13,14,15,0)
+#define ALTI_SR2_PERM \
+ (vector unsigned char)(7,0,1,2,11,4,5,6,15,8,9,10,17,12,13,14)
+#define ALTI_SR2_PERM64 \
+ (vector unsigned char)(15,0,1,2,3,4,5,6,17,8,9,10,11,12,13,14)
+#else /* For OTHER OSs(Linux?) */
+#define ALTI_SL1 {SL1, SL1, SL1, SL1}
+#define ALTI_SR1 {SR1, SR1, SR1, SR1}
+#define ALTI_MSK {MSK1, MSK2, MSK3, MSK4}
+#define ALTI_MSK64 {MSK2, MSK1, MSK4, MSK3}
+#define ALTI_SL2_PERM {1,2,3,23,5,6,7,0,9,10,11,4,13,14,15,8}
+#define ALTI_SL2_PERM64 {1,2,3,4,5,6,7,31,9,10,11,12,13,14,15,0}
+#define ALTI_SR2_PERM {7,0,1,2,11,4,5,6,15,8,9,10,17,12,13,14}
+#define ALTI_SR2_PERM64 {15,0,1,2,3,4,5,6,17,8,9,10,11,12,13,14}
+#endif /* For OSX */
+#define IDSTR "SFMT-19937:122-18-1-11-1:dfffffef-ddfecb7f-bffaffff-bffffff6"
+
+#endif /* SFMT_PARAMS19937_H */
--- /dev/null
+/**
+ * @file SFMT-sse2.h
+ * @brief SIMD oriented Fast Mersenne Twister(SFMT) for Intel SSE2
+ *
+ * @author Mutsuo Saito (Hiroshima University)
+ * @author Makoto Matsumoto (Hiroshima University)
+ *
+ * @note We assume LITTLE ENDIAN in this file
+ *
+ * Copyright (C) 2006, 2007 Mutsuo Saito, Makoto Matsumoto and Hiroshima
+ * University. All rights reserved.
+ *
+ * The new BSD License is applied to this software, see LICENSE.txt
+ */
+
+#ifndef SFMT_SSE2_H
+#define SFMT_SSE2_H
+
+PRE_ALWAYS static __m128i
+mm_recursion(__m128i * a, __m128i * b, __m128i c, __m128i d, __m128i mask)
+ ALWAYSINLINE;
+
+/**
+ * This function represents the recursion formula.
+ * @param a a 128-bit part of the interal state array
+ * @param b a 128-bit part of the interal state array
+ * @param c a 128-bit part of the interal state array
+ * @param d a 128-bit part of the interal state array
+ * @param mask 128-bit mask
+ * @return output
+ */
+ PRE_ALWAYS static __m128i mm_recursion(__m128i * a, __m128i * b,
+ __m128i c, __m128i d, __m128i mask)
+{
+ __m128i v, x, y, z;
+
+ x = _mm_load_si128(a);
+ y = _mm_srli_epi32(*b, SR1);
+ z = _mm_srli_si128(c, SR2);
+ v = _mm_slli_epi32(d, SL1);
+ z = _mm_xor_si128(z, x);
+ z = _mm_xor_si128(z, v);
+ x = _mm_slli_si128(x, SL2);
+ y = _mm_and_si128(y, mask);
+ z = _mm_xor_si128(z, x);
+ z = _mm_xor_si128(z, y);
+ return z;
+}
+
+/**
+ * This function fills the internal state array with pseudorandom
+ * integers.
+ */
+inline static void
+gen_rand_all(void)
+{
+ int i;
+ __m128i r, r1, r2, mask;
+ mask = _mm_set_epi32(MSK4, MSK3, MSK2, MSK1);
+
+ r1 = _mm_load_si128(&sfmt[N - 2].si);
+ r2 = _mm_load_si128(&sfmt[N - 1].si);
+ for (i = 0; i < N - POS1; i++) {
+ r = mm_recursion(&sfmt[i].si, &sfmt[i + POS1].si, r1, r2, mask);
+ _mm_store_si128(&sfmt[i].si, r);
+ r1 = r2;
+ r2 = r;
+ }
+ for (; i < N; i++) {
+ r = mm_recursion(&sfmt[i].si, &sfmt[i + POS1 - N].si, r1, r2, mask);
+ _mm_store_si128(&sfmt[i].si, r);
+ r1 = r2;
+ r2 = r;
+ }
+}
+
+/**
+ * This function fills the user-specified array with pseudorandom
+ * integers.
+ *
+ * @param array an 128-bit array to be filled by pseudorandom numbers.
+ * @param size number of 128-bit pesudorandom numbers to be generated.
+ */
+inline static void
+gen_rand_array(w128_t *array, int size)
+{
+ int i, j;
+ __m128i r, r1, r2, mask;
+ mask = _mm_set_epi32(MSK4, MSK3, MSK2, MSK1);
+
+ r1 = _mm_load_si128(&sfmt[N - 2].si);
+ r2 = _mm_load_si128(&sfmt[N - 1].si);
+ for (i = 0; i < N - POS1; i++) {
+ r = mm_recursion(&sfmt[i].si, &sfmt[i + POS1].si, r1, r2, mask);
+ _mm_store_si128(&array[i].si, r);
+ r1 = r2;
+ r2 = r;
+ }
+ for (; i < N; i++) {
+ r = mm_recursion(&sfmt[i].si, &array[i + POS1 - N].si, r1, r2, mask);
+ _mm_store_si128(&array[i].si, r);
+ r1 = r2;
+ r2 = r;
+ }
+ /* main loop */
+ for (; i < size - N; i++) {
+ r = mm_recursion(&array[i - N].si, &array[i + POS1 - N].si, r1, r2, mask);
+ _mm_store_si128(&array[i].si, r);
+ r1 = r2;
+ r2 = r;
+ }
+ for (j = 0; j < 2 * N - size; j++) {
+ r = _mm_load_si128(&array[j + size - N].si);
+ _mm_store_si128(&sfmt[j].si, r);
+ }
+ for (; i < size; i++) {
+ r = mm_recursion(&array[i - N].si, &array[i + POS1 - N].si, r1, r2, mask);
+ _mm_store_si128(&array[i].si, r);
+ _mm_store_si128(&sfmt[j++].si, r);
+ r1 = r2;
+ r2 = r;
+ }
+}
+
+#endif
--- /dev/null
+PowerPC architecture specific stuff:
+
+On OS X, the configure script tries to use gcc's -mdynamic-no-pic
+option:
+
+`-mdynamic-no-pic'
+ On Darwin and Mac OS X systems, compile code so that it is not
+ relocatable, but that its external references are relocatable.
+ The resulting code is suitable for applications, but not shared
+ libraries.
+
+
+If you're using a G4 or G4, add --enable-altivec to your configure
+options to get a vectorized version of the pseudo random number
+generator.
+PowerPC architecture specific stuff:
+
+On OS X, the configure script tries to use gcc's -mdynamic-no-pic
+option:
+
+`-mdynamic-no-pic'
+ On Darwin and Mac OS X systems, compile code so that it is not
+ relocatable, but that its external references are relocatable.
+ The resulting code is suitable for applications, but not shared
+ libraries.
+
+
+If you're using a G4 or G4, add --enable-altivec to your configure
+options to get a vectorized version of the pseudo random number
+generator.
--- /dev/null
+x86 and x86-64 specific stuff:
+
+All this assumes you're using gcc as your compiler.
+
+Add -march=FOO to your CFLAGS, where FOO is your processor: athlon,
+athlon-xp, pentium4, core2, etc. (Not all gcc versions support all
+these; see the documentation for your installation.)
+
+For example (Requires gcc 4.3 or better):
+CFLAGS="-O -march=core2" ./configure -C
+
+On 32 bit systems, consider adding -momit-leaf-frame-pointer to your
+CFLAGS. (This might someday be done for you by configure).
+
+On Pentium-M and better, add --enable-sse2 to your configure options
+to get a SIMD version of the pseudo random number generator and
+some other code.
+
+On Prescott Pentium-4 and better, add --enable-sse3 to your configure
+options (Implies --enable-sse2).
+
+Better yet, pass the correct -march=FOO flag in CFLAGS and they'll be
+automatically configured.
+
+x86 and x86-64 specific stuff:
+
+All this assumes you're using gcc as your compiler.
+
+Add -march=FOO to your CFLAGS, where FOO is your processor: athlon,
+athlon-xp, pentium4, core2, etc. (Not all gcc versions support all
+these; see the documentation for your installation.)
+
+For example (Requires gcc 4.3 or better):
+CFLAGS="-O -march=core2" ./configure -C
+
+On 32 bit systems, consider adding -momit-leaf-frame-pointer to your
+CFLAGS. (This might someday be done for you by configure).
+
+On Pentium-M and better, add --enable-sse2 to your configure options
+to get a SIMD version of the pseudo random number generator and
+some other code.
+
+On Prescott Pentium-4 and better, add --enable-sse3 to your configure
+options (Implies --enable-sse2).
+
+Better yet, pass the correct -march=FOO flag in CFLAGS and they'll be
+automatically configured.
+
--- /dev/null
+run tests:
+test('soundex.1', $god, 'think soundex(a)', 'A000');
+test('soundex.2', $god, 'think soundex(0)', '#-1 FUNCTION \(SOUNDEX\) REQUIRES A SINGLE WORD ARGUMENT');
+test('soundex.3', $god, 'think soundex(fred)', 'F630');
+test('soundex.4', $god, 'think soundex(phred)', 'F630');
+test('soundex.5', $god, 'think soundex(afford)', 'A163');
+
+test('soundslike.1', $god, 'think soundslike(robin, robbyn)', '1');
+test('soundslike.2', $god, 'think soundslike(robin, roebuck)', '0');
+test('soundslike.3', $god, 'think soundslike(frick, frack)', 1);
+test('soundslike.4', $god, 'think soundslike(glacier, glazier)', 1);
+test('soundslike.5', $god, 'think soundslike(rutabega, rototiller)', 0);
+
+run tests:
+test('soundex.1', $god, 'think soundex(a)', 'A000');
+test('soundex.2', $god, 'think soundex(0)', '#-1 FUNCTION \(SOUNDEX\) REQUIRES A SINGLE WORD ARGUMENT');
+test('soundex.3', $god, 'think soundex(fred)', 'F630');
+test('soundex.4', $god, 'think soundex(phred)', 'F630');
+test('soundex.5', $god, 'think soundex(afford)', 'A163');
+
+test('soundslike.1', $god, 'think soundslike(robin, robbyn)', '1');
+test('soundslike.2', $god, 'think soundslike(robin, roebuck)', '0');
+test('soundslike.3', $god, 'think soundslike(frick, frack)', 1);
+test('soundslike.4', $god, 'think soundslike(glacier, glazier)', 1);
+test('soundslike.5', $god, 'think soundslike(rutabega, rototiller)', 0);
+
--- /dev/null
+The utils directory has assorted scripts used as part of the build
+process, and source code for programs used manually at times to update
+various things that don't change often.
+
+Detailed information about how to use the scripts can usually be found
+in comments in them Here's a quick overview of what they're for:
+
+clwrapper.sh: A wrapper around the cl compiler from Microsoft.
+
+columnize.scm: Script to format the tables of functions/commands/etc.
+in help files.
+
+customize.pl: perl script used by 'make customize'
+
+fixdepend.pl: perl script used by 'make distdepend'
+
+fixdiff.scm: scheme script to convert a diff with Windows-style path
+separators to Unix-style ones.
+
+gentables.c: Compiles into a program used to make src/tables.c
+
+ln-dir.sh: A manual alternative to make customize. Kinda.
+
+make_access_cnf.sh: Script used to update ancient versions of Penn
+that used two files for sitelocks.
+
+mkcmds.pl: Perl script used by the makefile to create hdrs/funs.h,
+hdrs/cmds.h, hdrs/patches.h, hdrs/switches.h and src/switchinc.c when
+needed.
+
+mkvershlp.pl: perl script that turns the CHANGES.* files into
+game/txt/hlp/pennv*.hlp files.
+
+splint.sh: Wrapper for the splint code analysis tool to control
+ what warnings are printed out.
+
+typedefs.scm: Compiles into a program used to update the list of
+ typedefs used by 'make indent'.
+
+update-cnf.pl: Used by make to reconcile changes between
+game/mushcnf.dst and your local game/mush.cnf.
+
+update.pl: Used by make to reconcile changes between options.h.dist
+and your options.h.
+
--- /dev/null
+#!/usr/local/bin/csi -script
+#| !# ; |#
+;;; Formats words in columns for inclusion in help files.
+
+;; Works with chicken or guile
+
+;; Reads from standard input, prints to standard output. Intended to
+;; be used from within an editor to replace a table in-place.
+
+;; For emacs:
+;; Mark the current table, then C-u M-| utils/columnize.scm
+;;
+;; For vi:
+;; Something like :jfadskjfq423jram utils/columnize.scm
+;;
+;; (Or, using guile instead of chicken: guile -s utils/columize.scm)
+;;
+;; Compiled instead of interpeted:
+;; csc -o columize -O2 utils/columnize.scm
+;; (display "|")
+;; This is similar to column(1) but that doesn't always work the way
+;; we need. This does.
+
+(cond-expand
+ ((and chicken compiling)
+ (declare (block)
+ (fixnum)
+ (usual-integrations)
+ (disable-interrupts)
+ (uses srfi-1 srfi-13 regex)))
+ ((and chicken csi)
+ (use srfi-1 srfi-13 regex))
+ (guile
+ (use-modules (srfi srfi-1) (srfi srfi-13) (ice-9 regex)
+ (ice-9 rdelim))
+ (define fx= =)
+ (define fx+ +)
+ (define fx< <)
+ (define fx> >)
+ (define fxmax max)
+ (define (read-lines)
+ (let loop ((line (read-line))
+ (accum '()))
+ (if (eof-object? line)
+ (reverse accum)
+ (loop (read-line) (cons line accum)))))
+ (define-macro (define-constant sym val)
+ `(define ,sym ,val))
+ (define (string-split-fields re str)
+ (map match:substring (list-matches re str)))))
+
+(define-constant line-width 78)
+
+(define (drop-while pred? lst)
+ (cond
+ ((null? lst) '())
+ ((pred? (car lst)) (drop-while pred? (cdr lst)))
+ (else lst)))
+
+(define words
+ (drop-while (lambda (w) (fx= (string-length w) 0))
+ (sort
+ (string-split-fields "[A-Za-z0-9_@()-]+"
+ (string-join (read-lines) " "))
+ string-ci<?)))
+(define max-word-length (fold (lambda (w len)
+ (fxmax (string-length w) len))
+ 0 words))
+(define column-width (fx+ max-word-length 3))
+(define ncolumns (quotient line-width column-width))
+
+(define (print-word word column)
+ (cond
+ ((fx= column 1)
+ (display " ")
+ (display (string-pad-right word column-width))
+ 2)
+ ((fx< column ncolumns)
+ (display (string-pad-right word column-width))
+ (fx+ column 1))
+ (else
+ (display word)
+ (newline)
+ 1)))
+
+(if (fx> (fold print-word 1 words) 1) (newline))
+
+
+
--- /dev/null
+#!/usr/bin/env csi -script
+;;; Convert a diff file made with Windows-style \ directory paths to
+;;; Unix-style / paths. Works with context and unified diffs. Requires
+;;; chicken scheme (http://www.call-with-current-continuation.org).
+;;;
+;;; Written by Shawn Wagner (Raevnos) and placed in public domain.
+;;; No warranty. Use at your own risk. Blah blah blah.
+;;;
+;;; Usage: ./utils/fixdiff.scm < win32.patch > unix.path
+;;; or compile with: csc -O2 -o fixdiff fixdiff.scm
+
+(cond-expand
+ ((and chicken compiling)
+ ; Boilerplate for turning on optimizations
+ (declare
+ (block)
+ (usual-integrations)
+ (fixnum)
+ (disable-interrupts)
+ (always-bound path-regexp)
+ (uses utils regex)))
+ ((and chicken csi)
+ ; Load the appropriate libraries in the interpeter
+ (use utils regex)))
+
+;;; Two ways of doing it.
+
+;; Some testing suggests the regular expression approach is a little
+;; bit faster (Especially when run through csi instead of compiled to
+;; a binary)
+(define path-regexp (regexp "^(?:\\+\\+\\+|---|\\*\\*\\*|Index:|diff)\\s"))
+(define (fix-paths line)
+ (if (string-search path-regexp line)
+ (string-translate line #\\ #\/)
+ line))
+
+;; But this version, using the SRFI-13 string-prefix? function, is a lot
+;; more readable when it comes to seeing what marks a line with a path that needs
+;; to be converted.
+;(define (fix-paths line)
+; (if (or (string-prefix? "+++ " line)
+; (string-prefix? "--- " line)
+; (string-prefix? "*** " line)
+; (string-prefix? "Index: " line)
+; (string-prefix? "diff " line))
+; (string-translate line #\\ #\/)
+; line))
+
+;; The driver, equivalent to perl's behavior when invoked with -p
+(for-each-argv-line (compose print fix-paths))
+
+;;; As an exercise, compare with the following idiomatic perl equivalent:
+
+; #!/usr/bin/env perl -p
+; s!\\!/!og if m!^(?:\+\+\+|---|\*\*\*|Index:|diff)\s!o;
+;
+; Without -p, but still using all the things that give perl a bad name
+; (Like relying on $_ instead of explict variables) it'd be more like:
+;
+; while (<>) {
+; s!\\!/!og if m!^(?:\+\+\+|---|\*\*\*|Index:|diff)\s!o;
+; print;
+; }
+;
+; I think the scheme version is far more readable, with only a few
+; more lines of actual code (Ignoring all the boilerplate stuff in the
+; cond-expand. It's just hints to the compiler and loading libraries).
+
--- /dev/null
+#!/bin/sh
+
+# Wrapper script for checking Penn source with splint (http://www.splint.org)
+# Run from within the source directory.
+
+SFLAGS="-I.. -I../hdrs +posixlib -weak"
+
+# Disable assorted spurious warnings
+SFLAGS="$SFLAGS -nestcomment -fixedformalarray"
+SFLAGS="$SFLAGS -predbool -retvalother -unrecog"
+
+# Work around C99/GCC keywords splint doesn't understand
+SFLAGS="$SFLAGS -D__restrict= -Drestrict="
+
+echo "Using options: $SFLAGS"
+
+exec splint $SFLAGS $*
--- /dev/null
+#!/usr/local/bin/csi -script
+#| !# ; |#
+
+; Print out a list of all typedefs in the src in a format suitable for
+; using in the indent rule for src/Makefile. Requires chicken scheme.
+; http://call-with-current-continuation.org or your package manager.
+;
+; Also works with guile 1.8
+;
+; Written by Raevnos <shawnw@speakeasy.org> for PennMUSH.
+;
+; Version 0.9.2
+;
+; Usage:
+; % csc -O2 -heap-initial-size 768k -o typedefs utils/typedefs.scm
+; % make etags
+; % ./typedefs < src/TAGS > indent.defs
+; % emacs src/Makefile.in indent.defs
+; edit Makefile.in to modify the indent typedef section
+; % ./config.status
+; % make
+;
+; You can also use it as an interpreted script:
+; % csi -script utils/typedefs.scm < src/TAGS > indent.defs
+; or
+; % guile -s utils/typedefs.scm < src/TAGS > indent.defs
+; or
+; % chmod +x typedefs.scm
+; % ./typedefs.scm < TAGS
+;
+; This is just slower to run, thus good for occasional use.
+; Some rough time trials suggest that the compiled version runs
+; twice as fast. Of course, it also takes a while to compile it...
+;
+;
+; TODO
+; Take command-line arguments: The TAGS file and whether or not to
+; generate output to be included into a Makefile (Lines continued by \)
+; or into an .indent.pro file. # of columns, tab stops, etc.
+
+; Optimization and module directives.
+(cond-expand
+ ((and chicken compiling)
+ (declare
+ (fixnum)
+ (block)
+ (usual-integrations)
+ (disable-interrupts)
+ (lambda-lift)
+ (no-procedure-checks-for-usual-bindings)
+ (bound-to-procedure string-between/shared process-line read-typedefs
+ copy-typedef emit-typedef)
+ (uses utils srfi-1 srfi-13)))
+ ((and chicken csi)
+ (require-extension utils)
+ (require-extension srfi-1)
+ (require-extension srfi-13))
+ (guile
+ (use-modules (srfi srfi-1) (srfi srfi-13) (ice-9 rdelim)
+ (ice-9 format))
+ (define fx>= >=)
+ (define fx+ +)
+ (define fx= =)
+ (define signal throw)
+ (define (for-each-line f in-port)
+ (let loop ((line (read-line in-port)))
+ (if (not (eof-object? line))
+ (begin
+ (f line)
+ (loop (read-line in-port))))))
+ (define-macro (handle-exceptions exn handler body)
+ `(catch #t
+ (lambda () ,body)
+ (lambda (,exn) ,handler)))
+ (define-macro (printf fmtstr . args)
+ `(format #t ,fmtstr ,@args))
+ (define-macro (define-constant sym val)
+ `(define ,sym ,val))))
+
+
+; Return what's between the first occurance of fc and the last of lc in
+; a string. Raises an error if index(fc) > index(lc) or one of the two
+; doesn't exist.
+(define (string-between/shared str fc lc)
+ (let ((first-index (string-index str fc))
+ (last-index (string-index-right str lc)))
+ (cond
+ ((not (and (integer? first-index) (integer? last-index)))
+ (signal 'out-of-range))
+ ((fx>= first-index last-index)
+ (signal 'out-of-range))
+ (else
+ (substring/shared str (fx+ first-index 1) last-index)))))
+
+; The special characters that mark the start and end of an identifier
+(define-constant type-start (integer->char 127))
+(define-constant type-end (integer->char 1))
+
+; Either return a typedef name or a symbol : 'line-did-not-match or
+; 'read-more-lines
+(define process-line #f)
+(let*
+ ((in-struct-typedef? #f)
+ (in-enum-typedef? #f)
+ (copy-typedef (lambda (str)
+ (string-between/shared str type-start type-end)))
+ (pl (lambda (line)
+ (handle-exceptions
+ exn (if (eq? exn 'out-of-range)
+ (begin
+ (display
+ (format "Unable to extract typedef name from line: ~A\n"
+ line) (current-error-port))
+ 'line-did-not-match)
+ (abort exn))
+ (cond
+ (in-struct-typedef?
+ (if (char=? (string-ref line 0) #\})
+ (begin
+ (set! in-struct-typedef? #f)
+ (copy-typedef line))
+ 'read-more-lines))
+ (in-enum-typedef?
+ (if (char=? (string-ref line 0) #\})
+ (begin
+ (set! in-enum-typedef? #f)
+ (copy-typedef line))
+ 'read-more-lines))
+ ((string-prefix? "typedef struct " line)
+ (if (string-index line #\;)
+ (copy-typedef line)
+ (begin
+ ; If the struct is defined here the typedef name
+ ; is on the next line starting with }. There are
+ ; optional structure member lines between.
+ (set! in-struct-typedef? #t)
+ 'read-more-lines)))
+ ((string-prefix? "typedef enum " line)
+ (if (string-index line #\;)
+ (copy-typedef line)
+ (begin
+ ; Skip enum values
+ (set! in-enum-typedef? #t)
+ 'read-more-lines)))
+ ((string-prefix? "typedef " line)
+ (copy-typedef line))
+ ((string-prefix? "} " line)
+ ; We get this with a typedef of an anonymous struct.
+ ; If it then starts an array, some versions of etags
+ ; won't record the typedef name and you'll get a warning.
+ (copy-typedef line))
+ (else 'line-did-not-match))))))
+ (set! process-line pl))
+
+(define-macro (prepend! val lst)
+ `(set! ,lst (cons ,val ,lst)))
+
+; Read all typedefs from an inchannel or filename.
+(define (read-typedefs from)
+ (let*
+ ((typedefs '())
+ (fl-proc (lambda (line)
+ (let ((res (process-line line)))
+ (if (string? res) (prepend! res typedefs))))))
+ (for-each-line fl-proc from)
+ (delete-duplicates (sort typedefs string-ci<) string-ci=)))
+
+; Control pretty-printing of the typedefs.
+(define-constant max-column-width 75)
+(define-constant tab-stop 8)
+
+; Print out one typedef to stdout, formated as indent args.
+(define emit-typedef #f)
+(let*
+ ((column tab-stop)
+ (et (lambda (typedef)
+ (let* ((start-of-line? (fx= column tab-stop))
+ (len (fx+ (string-length typedef)
+ (if start-of-line? 3 4))))
+ (if (fx>= (fx+ column len) max-column-width)
+ (begin
+ (display " \\\n\t")
+ (set! column tab-stop)
+ (set! start-of-line? #t)))
+ (if start-of-line?
+ (printf "-T ~A" typedef)
+ (printf " -T ~A" typedef))
+ (set! column (fx+ column len))))))
+ (set! emit-typedef et))
+
+; main
+(let ((typedefs (read-typedefs (current-input-port))))
+ (write-char #\tab)
+ (for-each emit-typedef typedefs)
+ (newline))
projects / cobramush.git / commitdiff