--- /dev/null
+# Grammar for Python, version 3
+
+# Changes compared to version 2:
+# The syntax of Boolean operations is changed to use more
+# conventional priorities: or < and < not.
+
+# Changes compared to version 1:
+# modules and scripts are unified;
+# 'quit' is gone (use ^D);
+# empty_stmt is gone, replaced by explicit NEWLINE where appropriate;
+# 'import' and 'def' aren't special any more;
+# added 'from' NAME option on import clause, and '*' to import all;
+# added class definition.
+# TO DO:
+# replace 'dir' by something more general?
+
+# Start symbols for the grammar:
+# single_input is a single interactive statement;
+# file_input is a module or sequence of commands read from an input file;
+# expr_input is the input for the input() function;
+# eval_input is the input for the eval() function.
+
+# NB: compound_stmt in single_input is followed by extra NEWLINE!
+single_input: NEWLINE | simple_stmt | compound_stmt NEWLINE
+file_input: (NEWLINE | stmt)* ENDMARKER
+expr_input: testlist NEWLINE
+eval_input: testlist ENDMARKER
+
+funcdef: 'def' NAME parameters ':' suite
+parameters: '(' [fplist] ')'
+fplist: fpdef (',' fpdef)*
+fpdef: NAME | '(' fplist ')'
+
+stmt: simple_stmt | compound_stmt
+simple_stmt: expr_stmt | print_stmt | pass_stmt | del_stmt | dir_stmt | flow_stmt | import_stmt
+expr_stmt: (exprlist '=')* exprlist NEWLINE
+# For assignments, additional restrictions enforced by the interpreter
+print_stmt: 'print' (test ',')* [test] NEWLINE
+del_stmt: 'del' exprlist NEWLINE
+dir_stmt: 'dir' [expr] NEWLINE
+pass_stmt: 'pass' NEWLINE
+flow_stmt: break_stmt | return_stmt | raise_stmt
+break_stmt: 'break' NEWLINE
+return_stmt: 'return' [testlist] NEWLINE
+raise_stmt: 'raise' expr [',' expr] NEWLINE
+import_stmt: 'import' NAME (',' NAME)* NEWLINE | 'from' NAME 'import' ('*' | NAME (',' NAME)*) NEWLINE
+compound_stmt: if_stmt | while_stmt | for_stmt | try_stmt | funcdef | classdef
+if_stmt: 'if' test ':' suite ('elif' test ':' suite)* ['else' ':' suite]
+while_stmt: 'while' test ':' suite ['else' ':' suite]
+for_stmt: 'for' exprlist 'in' exprlist ':' suite ['else' ':' suite]
+try_stmt: 'try' ':' suite (except_clause ':' suite)* ['finally' ':' suite]
+except_clause: 'except' [expr [',' expr]]
+suite: simple_stmt | NEWLINE INDENT NEWLINE* (stmt NEWLINE*)+ DEDENT
+
+test: and_test ('or' and_test)*
+and_test: not_test ('and' not_test)*
+not_test: 'not' not_test | comparison
+comparison: expr (comp_op expr)*
+comp_op: '<'|'>'|'='|'>' '='|'<' '='|'<' '>'|'in'|'not' 'in'|'is'|'is' 'not'
+expr: term (('+'|'-') term)*
+term: factor (('*'|'/'|'%') factor)*
+factor: ('+'|'-') factor | atom trailer*
+atom: '(' [testlist] ')' | '[' [testlist] ']' | '{' '}' | '`' testlist '`' | NAME | NUMBER | STRING
+trailer: '(' [exprlist] ')' | '[' subscript ']' | '.' NAME
+subscript: expr | [expr] ':' [expr]
+exprlist: expr (',' expr)* [',']
+testlist: test (',' test)* [',']
+
+classdef: 'class' NAME parameters ['=' baselist] ':' suite
+baselist: atom arguments (',' atom arguments)*
+arguments: '(' [testlist] ')'
--- /dev/null
+#define assert(e) { if (!(e)) { printf("Assertion failed\n"); abort(); } }
--- /dev/null
+/* Bitset interface */
+
+#define BYTE char
+
+typedef BYTE *bitset;
+
+bitset newbitset PROTO((int nbits));
+void delbitset PROTO((bitset bs));
+/* int testbit PROTO((bitset bs, int ibit)); /* Now a macro, see below */
+int addbit PROTO((bitset bs, int ibit)); /* Returns 0 if already set */
+int samebitset PROTO((bitset bs1, bitset bs2, int nbits));
+void mergebitset PROTO((bitset bs1, bitset bs2, int nbits));
+
+#define BITSPERBYTE (8*sizeof(BYTE))
+#define NBYTES(nbits) (((nbits) + BITSPERBYTE - 1) / BITSPERBYTE)
+
+#define BIT2BYTE(ibit) ((ibit) / BITSPERBYTE)
+#define BIT2SHIFT(ibit) ((ibit) % BITSPERBYTE)
+#define BIT2MASK(ibit) (1 << BIT2SHIFT(ibit))
+#define BYTE2BIT(ibyte) ((ibyte) * BITSPERBYTE)
+
+#define testbit(ss, ibit) (((ss)[BIT2BYTE(ibit)] & BIT2MASK(ibit)) != 0)
--- /dev/null
+/* Definitions used by cgen output */
+
+typedef char *string;
+
+#define mknewlongobject(x) newintobject(x)
+#define mknewshortobject(x) newintobject((long)x)
+#define mknewfloatobject(x) newfloatobject(x)
+
+extern object *mknewcharobject PROTO((int c));
+
+extern int getiobjectarg PROTO((object *args, int nargs, int i, object **p_a));
+extern int getilongarg PROTO((object *args, int nargs, int i, long *p_a));
+extern int getishortarg PROTO((object *args, int nargs, int i, short *p_a));
+extern int getifloatarg PROTO((object *args, int nargs, int i, float *p_a));
+extern int getistringarg PROTO((object *args, int nargs, int i, string *p_a));
--- /dev/null
+/* Class object interface */
+
+/*
+Classes are really hacked in at the last moment.
+It should be possible to use other object types as base classes,
+but currently it isn't. We'll see if we can fix that later, sigh...
+*/
+
+extern typeobject Classtype, Classmembertype, Classmethodtype;
+
+#define is_classobject(op) ((op)->ob_type == &Classtype)
+#define is_classmemberobject(op) ((op)->ob_type == &Classmembertype)
+#define is_classmethodobject(op) ((op)->ob_type == &Classmethodtype)
+
+extern object *newclassobject PROTO((node *, object *, object *));
+extern object *newclassmemberobject PROTO((object *));
+extern object *newclassmethodobject PROTO((object *, object *));
+
+extern object *classmethodgetfunc PROTO((object *));
+extern object *classmethodgetself PROTO((object *));
--- /dev/null
+/*
+Dictionary object type -- mapping from char * to object.
+NB: the key is given as a char *, not as a stringobject.
+These functions set errno for errors. Functions dictremove() and
+dictinsert() return nonzero for errors, getdictsize() returns -1,
+the others NULL. A successful call to dictinsert() calls INCREF()
+for the inserted item.
+*/
+
+extern typeobject Dicttype;
+
+#define is_dictobject(op) ((op)->ob_type == &Dicttype)
+
+extern object *newdictobject PROTO((void));
+extern object *dictlookup PROTO((object *dp, char *key));
+extern int dictinsert PROTO((object *dp, char *key, object *item));
+extern int dictremove PROTO((object *dp, char *key));
+extern int getdictsize PROTO((object *dp));
+extern char *getdictkey PROTO((object *dp, int i));
+
+/* New interface with (string)object * instead of char * arguments */
+extern object *dict2lookup PROTO((object *dp, object *key));
+extern int dict2insert PROTO((object *dp, object *key, object *item));
+extern int dict2remove PROTO((object *dp, object *key));
+extern object *getdict2key PROTO((object *dp, int i));
--- /dev/null
+/* Error codes passed around between file input, tokenizer, parser and
+ interpreter. This was necessary so we can turn them into Python
+ exceptions at a higher level. */
+
+#define E_OK 10 /* No error */
+#define E_EOF 11 /* (Unexpected) EOF read */
+#define E_INTR 12 /* Interrupted */
+#define E_TOKEN 13 /* Bad token */
+#define E_SYNTAX 14 /* Syntax error */
+#define E_NOMEM 15 /* Ran out of memory */
+#define E_DONE 16 /* Parsing complete */
+#define E_ERROR 17 /* Execution error */
--- /dev/null
+/* Error handling definitions */
+
+void err_set PROTO((object *));
+void err_setval PROTO((object *, object *));
+void err_setstr PROTO((object *, char *));
+int err_occurred PROTO((void));
+void err_get PROTO((object **, object **));
+void err_clear PROTO((void));
+
+/* Predefined exceptions (in run.c) */
+object *RuntimeError; /* Raised by error() */
+object *EOFError; /* Raised by eof_error() */
+object *TypeError; /* Rased by type_error() */
+object *MemoryError; /* Raised by mem_error() */
+object *NameError; /* Raised by name_error() */
+object *SystemError; /* Raised by sys_error() */
+object *KeyboardInterrupt; /* Raised by intr_error() */
--- /dev/null
+/* File object interface */
+
+extern typeobject Filetype;
+
+#define is_fileobject(op) ((op)->ob_type == &Filetype)
+
+extern object *newfileobject PROTO((char *, char *));
+extern object *newopenfileobject PROTO((FILE *, char *, char *));
+extern FILE *getfilefile PROTO((object *));
--- /dev/null
+/* Float object interface */
+
+/*
+floatobject represents a (double precision) floating point number.
+*/
+
+typedef struct {
+ OB_HEAD
+ double ob_fval;
+} floatobject;
+
+extern typeobject Floattype;
+
+#define is_floatobject(op) ((op)->ob_type == &Floattype)
+
+extern object *newfloatobject PROTO((double));
+extern double getfloatvalue PROTO((object *));
+
+/* Macro, trading safety for speed */
+#define GETFLOATVALUE(op) ((op)->ob_fval)
--- /dev/null
+/* Function object interface */
+
+extern typeobject Functype;
+
+#define is_funcobject(op) ((op)->ob_type == &Functype)
+
+extern object *newfuncobject PROTO((node *, object *));
+extern node *getfuncnode PROTO((object *));
+extern object *getfuncglobals PROTO((object *));
--- /dev/null
+#define single_input 256
+#define file_input 257
+#define expr_input 258
+#define eval_input 259
+#define funcdef 260
+#define parameters 261
+#define fplist 262
+#define fpdef 263
+#define stmt 264
+#define simple_stmt 265
+#define expr_stmt 266
+#define print_stmt 267
+#define del_stmt 268
+#define dir_stmt 269
+#define pass_stmt 270
+#define flow_stmt 271
+#define break_stmt 272
+#define return_stmt 273
+#define raise_stmt 274
+#define import_stmt 275
+#define compound_stmt 276
+#define if_stmt 277
+#define while_stmt 278
+#define for_stmt 279
+#define try_stmt 280
+#define except_clause 281
+#define suite 282
+#define test 283
+#define and_test 284
+#define not_test 285
+#define comparison 286
+#define comp_op 287
+#define expr 288
+#define term 289
+#define factor 290
+#define atom 291
+#define trailer 292
+#define subscript 293
+#define exprlist 294
+#define testlist 295
+#define classdef 296
+#define baselist 297
+#define arguments 298
--- /dev/null
+/* Grammar interface */
+
+#include "bitset.h" /* Sigh... */
+
+/* A label of an arc */
+
+typedef struct _label {
+ int lb_type;
+ char *lb_str;
+} label;
+
+#define EMPTY 0 /* Label number 0 is by definition the empty label */
+
+/* A list of labels */
+
+typedef struct _labellist {
+ int ll_nlabels;
+ label *ll_label;
+} labellist;
+
+/* An arc from one state to another */
+
+typedef struct _arc {
+ short a_lbl; /* Label of this arc */
+ short a_arrow; /* State where this arc goes to */
+} arc;
+
+/* A state in a DFA */
+
+typedef struct _state {
+ int s_narcs;
+ arc *s_arc; /* Array of arcs */
+
+ /* Optional accelerators */
+ int s_lower; /* Lowest label index */
+ int s_upper; /* Highest label index */
+ int *s_accel; /* Accelerator */
+ int s_accept; /* Nonzero for accepting state */
+} state;
+
+/* A DFA */
+
+typedef struct _dfa {
+ int d_type; /* Non-terminal this represents */
+ char *d_name; /* For printing */
+ int d_initial; /* Initial state */
+ int d_nstates;
+ state *d_state; /* Array of states */
+ bitset d_first;
+} dfa;
+
+/* A grammar */
+
+typedef struct _grammar {
+ int g_ndfas;
+ dfa *g_dfa; /* Array of DFAs */
+ labellist g_ll;
+ int g_start; /* Start symbol of the grammar */
+ int g_accel; /* Set if accelerators present */
+} grammar;
+
+/* FUNCTIONS */
+
+grammar *newgrammar PROTO((int start));
+dfa *adddfa PROTO((grammar *g, int type, char *name));
+int addstate PROTO((dfa *d));
+void addarc PROTO((dfa *d, int from, int to, int lbl));
+dfa *finddfa PROTO((grammar *g, int type));
+char *typename PROTO((grammar *g, int lbl));
+
+int addlabel PROTO((labellist *ll, int type, char *str));
+int findlabel PROTO((labellist *ll, int type, char *str));
+char *labelrepr PROTO((label *lb));
+void translatelabels PROTO((grammar *g));
+
+void addfirstsets PROTO((grammar *g));
+
+void addaccellerators PROTO((grammar *g));
--- /dev/null
+/* Module definition and import interface */
+
+void init_modules PROTO(());
+void close_modules PROTO(());
+object *new_module PROTO((char *name));
+void define_module PROTO((struct _context *ctx, char *name));
+object *import_module PROTO((struct _context *ctx, char *name));
--- /dev/null
+/* Integer object interface */
+
+/*
+123456789-123456789-123456789-123456789-123456789-123456789-123456789-12
+
+intobject represents a (long) integer. This is an immutable object;
+an integer cannot change its value after creation.
+
+There are functions to create new integer objects, to test an object
+for integer-ness, and to get the integer value. The latter functions
+returns -1 and sets errno to EBADF if the object is not an intobject.
+None of the functions should be applied to nil objects.
+
+The type intobject is (unfortunately) exposed bere so we can declare
+TrueObject and FalseObject below; don't use this.
+*/
+
+typedef struct {
+ OB_HEAD
+ long ob_ival;
+} intobject;
+
+extern typeobject Inttype;
+
+#define is_intobject(op) ((op)->ob_type == &Inttype)
+
+extern object *newintobject PROTO((long));
+extern long getintvalue PROTO((object *));
+
+
+/*
+123456789-123456789-123456789-123456789-123456789-123456789-123456789-12
+
+False and True are special intobjects used by Boolean expressions.
+All values of type Boolean must point to either of these; but in
+contexts where integers are required they are integers (valued 0 and 1).
+Hope these macros don't conflict with other people's.
+
+Don't forget to apply INCREF() when returning True or False!!!
+*/
+
+extern intobject FalseObject, TrueObject; /* Don't use these directly */
+
+#define False ((object *) &FalseObject)
+#define True ((object *) &TrueObject)
+
+/* Macro, trading safety for speed */
+#define GETINTVALUE(op) ((op)->ob_ival)
--- /dev/null
+/* List object interface */
+
+/*
+123456789-123456789-123456789-123456789-123456789-123456789-123456789-12
+
+Another generally useful object type is an list of object pointers.
+This is a mutable type: the list items can be changed, and items can be
+added or removed. Out-of-range indices or non-list objects are ignored.
+
+*** WARNING *** setlistitem does not increment the new item's reference
+count, but does decrement the reference count of the item it replaces,
+if not nil. It does *decrement* the reference count if it is *not*
+inserted in the list. Similarly, getlistitem does not increment the
+returned item's reference count.
+*/
+
+extern typeobject Listtype;
+
+#define is_listobject(op) ((op)->ob_type == &Listtype)
+
+extern object *newlistobject PROTO((int size));
+extern int getlistsize PROTO((object *));
+extern object *getlistitem PROTO((object *, int));
+extern int setlistitem PROTO((object *, int, object *));
+extern int inslistitem PROTO((object *, int, object *));
+extern int addlistitem PROTO((object *, object *));
--- /dev/null
+#define MSTART 256
+#define RULE 257
+#define RHS 258
+#define ALT 259
+#define ITEM 260
+#define ATOM 261
--- /dev/null
+/* Method object interface */
+
+extern typeobject Methodtype;
+
+#define is_methodobject(op) ((op)->ob_type == &Methodtype)
+
+typedef object *(*method) FPROTO((object *, object *));
+
+extern object *newmethodobject PROTO((char *, method, object *));
+extern method getmethod PROTO((object *));
+extern object *getself PROTO((object *));
--- /dev/null
+/* Module support interface */
+
+struct methodlist {
+ char *ml_name;
+ method ml_meth;
+};
+
+extern object *findmethod PROTO((struct methodlist *, object *, char *));
+extern object *initmodule PROTO((char *, struct methodlist *));
+extern int err_badargs PROTO((void));
+extern object *err_nomem PROTO((void));
--- /dev/null
+/* Module object interface */
+
+extern typeobject Moduletype;
+
+#define is_moduleobject(op) ((op)->ob_type == &Moduletype)
+
+extern object *newmoduleobject PROTO((char *));
+extern object *getmoduledict PROTO((object *));
+extern int setmoduledict PROTO((object *, object *));
--- /dev/null
+/* Parse tree node interface */
+
+typedef struct _node {
+ int n_type;
+ char *n_str;
+ int n_nchildren;
+ struct _node *n_child;
+} node;
+
+extern node *newnode PROTO((int type));
+extern node *addchild PROTO((node *n, int type, char *str));
+
+/* Node access functions */
+#define NCH(n) ((n)->n_nchildren)
+#define CHILD(n, i) (&(n)->n_child[i])
+#define TYPE(n) ((n)->n_type)
+#define STR(n) ((n)->n_str)
+
+/* Assert that the type of a node is what we expect */
+#ifndef DEBUG
+#define REQ(n, type) { /*pass*/ ; }
+#else
+#define REQ(n, type) \
+ { if (TYPE(n) != (type)) { \
+ fprintf(stderr, "FATAL: node type %d, required %d\n", \
+ TYPE(n), type); \
+ abort(); \
+ } }
+#endif
--- /dev/null
+/* Object and type object interface */
+
+/*
+123456789-123456789-123456789-123456789-123456789-123456789-123456789-12
+
+Objects are structures allocated on the heap. Special rules apply to
+the use of objects to ensure they are properly garbage-collected.
+Objects are never allocated statically or on the stack; they must be
+accessed through special macros and functions only. (Type objects are
+exceptions to the first rule; the standard types are represented by
+statically initialized type objects.)
+
+An object has a 'reference count' that is increased or decreased when a
+pointer to the object is copied or deleted; when the reference count
+reaches zero there are no references to the object left and it can be
+removed from the heap.
+
+An object has a 'type' that determines what it represents and what kind
+of data it contains. An object's type is fixed when it is created.
+Types themselves are represented as objects; an object contains a
+pointer to the corresponding type object. The type itself has a type
+pointer pointing to the object representing the type 'type', which
+contains a pointer to itself!).
+
+Objects do not float around in memory; once allocated an object keeps
+the same size and address. Objects that must hold variable-size data
+can contain pointers to variable-size parts of the object. Not all
+objects of the same type have the same size; but the size cannot change
+after allocation. (These restrictions are made so a reference to an
+object can be simply a pointer -- moving an object would require
+updating all the pointers, and changing an object's size would require
+moving it if there was another object right next to it.)
+
+Objects are always accessed through pointers of the type 'object *'.
+The type 'object' is a structure that only contains the reference count
+and the type pointer. The actual memory allocated for an object
+contains other data that can only be accessed after casting the pointer
+to a pointer to a longer structure type. This longer type must start
+with the reference count and type fields; the macro OB_HEAD should be
+used for this (to accomodate for future changes). The implementation
+of a particular object type can cast the object pointer to the proper
+type and back.
+
+A standard interface exists for objects that contain an array of items
+whose size is determined when the object is allocated.
+
+123456789-123456789-123456789-123456789-123456789-123456789-123456789-12
+*/
+
+#ifdef THINK_C
+/* Debugging options for THINK_C (which has no -D compiler option): */
+/*#define TRACE_REFS*/
+/*#define REF_DEBUG*/
+#endif
+
+#ifdef TRACE_REFS
+#define OB_HEAD \
+ struct _object *_ob_next, *_ob_prev; \
+ unsigned int ob_refcnt; \
+ struct _typeobject *ob_type;
+#define OB_HEAD_INIT(type) 0, 0, 1, type,
+#else
+#define OB_HEAD \
+ unsigned int ob_refcnt; \
+ struct _typeobject *ob_type;
+#define OB_HEAD_INIT(type) 1, type,
+#endif
+
+#define OB_VARHEAD \
+ OB_HEAD \
+ unsigned int ob_size; /* Number of items in variable part */
+
+typedef struct _object {
+ OB_HEAD
+} object;
+
+typedef struct {
+ OB_VARHEAD
+} varobject;
+
+
+/*
+123456789-123456789-123456789-123456789-123456789-123456789-123456789-12
+
+Type objects contain a string containing the type name (to help somewhat
+in debugging), the allocation parameters (see newobj() and newvarobj()),
+and methods for accessing objects of the type. Methods are optional,a
+nil pointer meaning that particular kind of access is not available for
+this type. The DECREF() macro uses the tp_dealloc method without
+checking for a nil pointer; it should always be implemented except if
+the implementation can guarantee that the reference count will never
+reach zero (e.g., for type objects).
+
+NB: the methods for certain type groups are now contained in separate
+method blocks.
+*/
+
+typedef struct {
+ object *(*nb_add) FPROTO((object *, object *));
+ object *(*nb_subtract) FPROTO((object *, object *));
+ object *(*nb_multiply) FPROTO((object *, object *));
+ object *(*nb_divide) FPROTO((object *, object *));
+ object *(*nb_remainder) FPROTO((object *, object *));
+ object *(*nb_power) FPROTO((object *, object *));
+ object *(*nb_negative) FPROTO((object *));
+ object *(*nb_positive) FPROTO((object *));
+} number_methods;
+
+typedef struct {
+ int (*sq_length) FPROTO((object *));
+ object *(*sq_concat) FPROTO((object *, object *));
+ object *(*sq_repeat) FPROTO((object *, int));
+ object *(*sq_item) FPROTO((object *, int));
+ object *(*sq_slice) FPROTO((object *, int, int));
+ int (*sq_ass_item) FPROTO((object *, int, object *));
+ int (*sq_ass_slice) FPROTO((object *, int, int, object *));
+} sequence_methods;
+
+typedef struct {
+ int (*mp_length) FPROTO((object *));
+ object *(*mp_subscript) FPROTO((object *, object *));
+ int (*mp_ass_subscript) FPROTO((object *, object *, object *));
+} mapping_methods;
+
+typedef struct _typeobject {
+ OB_VARHEAD
+ char *tp_name; /* For printing */
+ unsigned int tp_basicsize, tp_itemsize; /* For allocation */
+
+ /* Methods to implement standard operations */
+
+ void (*tp_dealloc) FPROTO((object *));
+ void (*tp_print) FPROTO((object *, FILE *, int));
+ object *(*tp_getattr) FPROTO((object *, char *));
+ int (*tp_setattr) FPROTO((object *, char *, object *));
+ int (*tp_compare) FPROTO((object *, object *));
+ object *(*tp_repr) FPROTO((object *));
+
+ /* Method suites for standard classes */
+
+ number_methods *tp_as_number;
+ sequence_methods *tp_as_sequence;
+ mapping_methods *tp_as_mapping;
+} typeobject;
+
+extern typeobject Typetype; /* The type of type objects */
+
+#define is_typeobject(op) ((op)->ob_type == &Typetype)
+
+extern void printobject PROTO((object *, FILE *, int));
+extern object * reprobject PROTO((object *));
+extern int cmpobject PROTO((object *, object *));
+
+/* Flag bits for printing: */
+#define PRINT_RAW 1 /* No string quotes etc. */
+
+/*
+123456789-123456789-123456789-123456789-123456789-123456789-123456789-12
+
+The macros INCREF(op) and DECREF(op) are used to increment or decrement
+reference counts. DECREF calls the object's deallocator function; for
+objects that don't contain references to other objects or heap memory
+this can be the standard function free(). Both macros can be used
+whereever a void expression is allowed. The argument shouldn't be a
+NIL pointer. The macro NEWREF(op) is used only to initialize reference
+counts to 1; it is defined here for convenience.
+
+We assume that the reference count field can never overflow; this can
+be proven when the size of the field is the same as the pointer size
+but even with a 16-bit reference count field it is pretty unlikely so
+we ignore the possibility. (If you are paranoid, make it a long.)
+
+Type objects should never be deallocated; the type pointer in an object
+is not considered to be a reference to the type object, to save
+complications in the deallocation function. (This is actually a
+decision that's up to the implementer of each new type so if you want,
+you can count such references to the type object.)
+
+*** WARNING*** The DECREF macro must have a side-effect-free argument
+since it may evaluate its argument multiple times. (The alternative
+would be to mace it a proper function or assign it to a global temporary
+variable first, both of which are slower; and in a multi-threaded
+environment the global variable trick is not safe.)
+*/
+
+#ifdef TRACE_REFS
+#ifndef REF_DEBUG
+#define REF_DEBUG
+#endif
+#endif
+
+#ifndef TRACE_REFS
+#define DELREF(op) (*(op)->ob_type->tp_dealloc)((object *)(op))
+#endif
+
+#ifdef REF_DEBUG
+extern long ref_total;
+#ifndef TRACE_REFS
+#define NEWREF(op) (ref_total++, (op)->ob_refcnt = 1)
+#endif
+#define INCREF(op) (ref_total++, (op)->ob_refcnt++)
+#define DECREF(op) \
+ if (--ref_total, --(op)->ob_refcnt != 0) \
+ ; \
+ else \
+ DELREF(op)
+#else
+#define NEWREF(op) ((op)->ob_refcnt = 1)
+#define INCREF(op) ((op)->ob_refcnt++)
+#define DECREF(op) \
+ if (--(op)->ob_refcnt != 0) \
+ ; \
+ else \
+ DELREF(op)
+#endif
+
+
+/* Definition of NULL, so you don't have to include <stdio.h> */
+
+#ifndef NULL
+#define NULL 0
+#endif
+
+
+/*
+NoObject is an object of undefined type which can be used in contexts
+where NULL (nil) is not suitable (since NULL often means 'error').
+
+Don't forget to apply INCREF() when returning this value!!!
+*/
+
+extern object NoObject; /* Don't use this directly */
+
+#define None (&NoObject)
+
+
+/*
+123456789-123456789-123456789-123456789-123456789-123456789-123456789-12
+
+More conventions
+================
+
+Argument Checking
+-----------------
+
+Functions that take objects as arguments normally don't check for nil
+arguments, but they do check the type of the argument, and return an
+error if the function doesn't apply to the type.
+
+Failure Modes
+-------------
+
+Functions may fail for a variety of reasons, including running out of
+memory. This is communicated to the caller in two ways: 'errno' is set
+to indicate the error, and the function result differs: functions that
+normally return a pointer return nil for failure, functions returning
+an integer return -1 (which can be a legal return value too!), and
+other functions return 0 for success and the error number for failure.
+Callers should always check for errors before using the result. The
+following error codes are used:
+
+ EBADF bad object type (first argument only)
+ EINVAL bad argument type (second and further arguments)
+ ENOMEM no memory (malloc failed)
+ ENOENT key not found in dictionary
+ EDOM index out of range or division by zero
+ ERANGE result not representable
+
+ XXX any others?
+
+Reference Counts
+----------------
+
+It takes a while to get used to the proper usage of reference counts.
+
+Functions that create an object set the reference count to 1; such new
+objects must be stored somewhere or destroyed again with DECREF().
+Functions that 'store' objects such as settupleitem() and dictinsert()
+don't increment the reference count of the object, since the most
+frequent use is to store a fresh object. Functions that 'retrieve'
+objects such as gettupleitem() and dictlookup() also don't increment
+the reference count, since most frequently the object is only looked at
+quickly. Thus, to retrieve an object and store it again, the caller
+must call INCREF() explicitly.
+
+NOTE: functions that 'consume' a reference count like dictinsert() even
+consume the reference if the object wasn't stored, to simplify error
+handling.
+
+It seems attractive to make other functions that take an object as
+argument consume a reference count; however this may quickly get
+confusing (even the current practice is already confusing). Consider
+it carefully, it may safe lots of calls to INCREF() and DECREF() at
+times.
+
+123456789-123456789-123456789-123456789-123456789-123456789-123456789-12
+*/
+
+/* Error number interface */
+#include <errno.h>
+
+#ifndef errno
+extern int errno;
+#endif
+
+#ifdef THINK_C
+/* Lightspeed C doesn't define these in <errno.h> */
+#define EDOM 33
+#define ERANGE 34
+#endif
--- /dev/null
+/*
+123456789-123456789-123456789-123456789-123456789-123456789-123456789-12
+
+Additional macros for modules that implement new object types.
+You must first include "object.h".
+
+NEWOBJ(type, typeobj) allocates memory for a new object of the given
+type; here 'type' must be the C structure type used to represent the
+object and 'typeobj' the address of the corresponding type object.
+Reference count and type pointer are filled in; the rest of the bytes of
+the object are *undefined*! The resulting expression type is 'type *'.
+The size of the object is actually determined by the tp_basicsize field
+of the type object.
+
+NEWVAROBJ(type, typeobj, n) is similar but allocates a variable-size
+object with n extra items. The size is computer as tp_basicsize plus
+n * tp_itemsize. This fills in the ob_size field as well.
+*/
+
+extern object *newobject PROTO((typeobject *));
+extern varobject *newvarobject PROTO((typeobject *, unsigned int));
+
+#define NEWOBJ(type, typeobj) ((type *) newobject(typeobj))
+#define NEWVAROBJ(type, typeobj, n) ((type *) newvarobject(typeobj, n))
+
+extern int StopPrint; /* Set when printing is interrupted */
+
+/* Malloc interface */
+#include "malloc.h"
+
+extern char *strdup PROTO((char *));
--- /dev/null
+/* Parser-tokenizer link interface */
+
+#if 0
+extern int parsetok PROTO((struct tok_state *, grammar *, int start,
+ node **n_ret));
+#endif
+extern int parsestring PROTO((char *, grammar *, int start, node **n_ret));
+extern int parsefile PROTO((FILE *, grammar *, int start,
+ char *ps1, char *ps2, node **n_ret));
--- /dev/null
+/* Error handling definitions */
+
+void err_set PROTO((object *));
+void err_setval PROTO((object *, object *));
+void err_setstr PROTO((object *, char *));
+int err_occurred PROTO((void));
+void err_get PROTO((object **, object **));
+void err_clear PROTO((void));
+
+/* Predefined exceptions (in run.c) */
+object *RuntimeError; /* Raised by error() */
+object *EOFError; /* Raised by eof_error() */
+object *TypeError; /* Rased by type_error() */
+object *MemoryError; /* Raised by mem_error() */
+object *NameError; /* Raised by name_error() */
+object *SystemError; /* Raised by sys_error() */
+object *KeyboardInterrupt; /* Raised by intr_error() */
--- /dev/null
+/* String object interface */
+
+/*
+123456789-123456789-123456789-123456789-123456789-123456789-123456789-12
+
+Type stringobject represents a character string. An extra zero byte is
+reserved at the end to ensure it is zero-terminated, but a size is
+present so strings with null bytes in them can be represented. This
+is an immutable object type.
+
+There are functions to create new string objects, to test
+an object for string-ness, and to get the
+string value. The latter function returns a null pointer
+if the object is not of the proper type.
+There is a variant that takes an explicit size as well as a
+variant that assumes a zero-terminated string. Note that none of the
+functions should be applied to nil objects.
+*/
+
+/* NB The type is revealed here only because it is used in dictobject.c */
+
+typedef struct {
+ OB_VARHEAD
+ char ob_sval[1];
+} stringobject;
+
+extern typeobject Stringtype;
+
+#define is_stringobject(op) ((op)->ob_type == &Stringtype)
+
+extern object *newsizedstringobject PROTO((char *, int));
+extern object *newstringobject PROTO((char *));
+extern unsigned int getstringsize PROTO((object *));
+extern char *getstringvalue PROTO((object *));
+extern void joinstring PROTO((object **, object *));
+extern int resizestring PROTO((object **, int));
+
+/* Macro, trading safety for speed */
+#define GETSTRINGVALUE(op) ((op)->ob_sval)
--- /dev/null
+/* System module interface */
+
+object *sysget PROTO((char *));
+int sysset PROTO((char *, object *));
+FILE *sysgetfile PROTO((char *, FILE *));
+void initsys PROTO((int, char **));
--- /dev/null
+/* Token types */
+
+#define ENDMARKER 0
+#define NAME 1
+#define NUMBER 2
+#define STRING 3
+#define NEWLINE 4
+#define INDENT 5
+#define DEDENT 6
+#define LPAR 7
+#define RPAR 8
+#define LSQB 9
+#define RSQB 10
+#define COLON 11
+#define COMMA 12
+#define SEMI 13
+#define PLUS 14
+#define MINUS 15
+#define STAR 16
+#define SLASH 17
+#define VBAR 18
+#define AMPER 19
+#define LESS 20
+#define GREATER 21
+#define EQUAL 22
+#define DOT 23
+#define PERCENT 24
+#define BACKQUOTE 25
+#define LBRACE 26
+#define RBRACE 27
+#define OP 28
+#define ERRORTOKEN 29
+#define N_TOKENS 30
+
+/* Special definitions for cooperation with parser */
+
+#define NT_OFFSET 256
+
+#define ISTERMINAL(x) ((x) < NT_OFFSET)
+#define ISNONTERMINAL(x) ((x) >= NT_OFFSET)
+#define ISEOF(x) ((x) == ENDMARKER)
+
+
+extern char *tok_name[]; /* Token names */
+extern int tok_1char PROTO((int));
--- /dev/null
+/* Tuple object interface */
+
+/*
+123456789-123456789-123456789-123456789-123456789-123456789-123456789-12
+
+Another generally useful object type is an tuple of object pointers.
+This is a mutable type: the tuple items can be changed (but not their
+number). Out-of-range indices or non-tuple objects are ignored.
+
+*** WARNING *** settupleitem does not increment the new item's reference
+count, but does decrement the reference count of the item it replaces,
+if not nil. It does *decrement* the reference count if it is *not*
+inserted in the tuple. Similarly, gettupleitem does not increment the
+returned item's reference count.
+*/
+
+extern typeobject Tupletype;
+
+#define is_tupleobject(op) ((op)->ob_type == &Tupletype)
+
+extern object *newtupleobject PROTO((int size));
+extern int gettuplesize PROTO((object *));
+extern object *gettupleitem PROTO((object *, int));
+extern int settupleitem PROTO((object *, int, object *));
--- /dev/null
+# Python script to parse cstubs file for gl and generate C stubs.
+# usage: python cgen <cstubs >glmodule.c
+#
+# XXX BUG return arrays generate wrong code
+# XXX need to change error returns into gotos to free mallocked arrays
+
+
+import string
+import sys
+
+
+# Function to print to stderr
+#
+def err(args):
+ savestdout = sys.stdout
+ try:
+ sys.stdout = sys.stderr
+ for i in args:
+ print i,
+ print
+ finally:
+ sys.stdout = savestdout
+
+
+# The set of digits that form a number
+#
+digits = '0123456789'
+
+
+# Function to extract a string of digits from the front of the string.
+# Returns the leading string of digits and the remaining string.
+# If no number is found, returns '' and the original string.
+#
+def getnum(s):
+ n = ''
+ while s[:1] in digits:
+ n = n + s[:1]
+ s = s[1:]
+ return n, s
+
+
+# Function to check if a string is a number
+#
+def isnum(s):
+ if not s: return 0
+ for c in s:
+ if not c in digits: return 0
+ return 1
+
+
+# Allowed function return types
+#
+return_types = ['void', 'short', 'long']
+
+
+# Allowed function argument types
+#
+arg_types = ['char', 'string', 'short', 'float', 'long', 'double']
+
+
+# Need to classify arguments as follows
+# simple input variable
+# simple output variable
+# input array
+# output array
+# input giving size of some array
+#
+# Array dimensions can be specified as follows
+# constant
+# argN
+# constant * argN
+# retval
+# constant * retval
+#
+# The dimensions given as constants * something are really
+# arrays of points where points are 2- 3- or 4-tuples
+#
+# We have to consider three lists:
+# python input arguments
+# C stub arguments (in & out)
+# python output arguments (really return values)
+#
+# There is a mapping from python input arguments to the input arguments
+# of the C stub, and a further mapping from C stub arguments to the
+# python return values
+
+
+# Exception raised by checkarg() and generate()
+#
+arg_error = 'bad arg'
+
+
+# Function to check one argument.
+# Arguments: the type and the arg "name" (really mode plus subscript).
+# Raises arg_error if something's wrong.
+# Return type, mode, factor, rest of subscript; factor and rest may be empty.
+#
+def checkarg(type, arg):
+ #
+ # Turn "char *x" into "string x".
+ #
+ if type = 'char' and arg[0] = '*':
+ type = 'string'
+ arg = arg[1:]
+ #
+ # Check that the type is supported.
+ #
+ if type not in arg_types:
+ raise arg_error, ('bad type', type)
+ #
+ # Split it in the mode (first character) and the rest.
+ #
+ mode, rest = arg[:1], arg[1:]
+ #
+ # The mode must be 's' for send (= input) or 'r' for return argument.
+ #
+ if mode not in ('r', 's'):
+ raise arg_error, ('bad arg mode', mode)
+ #
+ # Is it a simple argument: if so, we are done.
+ #
+ if not rest:
+ return type, mode, '', ''
+ #
+ # Not a simple argument; must be an array.
+ # The 'rest' must be a subscript enclosed in [ and ].
+ # The subscript must be one of the following forms,
+ # otherwise we don't handle it (where N is a number):
+ # N
+ # argN
+ # retval
+ # N*argN
+ # N*retval
+ #
+ if rest[:1] <> '[' or rest[-1:] <> ']':
+ raise arg_error, ('subscript expected', rest)
+ sub = rest[1:-1]
+ #
+ # Is there a leading number?
+ #
+ num, sub = getnum(sub)
+ if num:
+ # There is a leading number
+ if not sub:
+ # The subscript is just a number
+ return type, mode, num, ''
+ if sub[:1] = '*':
+ # There is a factor prefix
+ sub = sub[1:]
+ else:
+ raise arg_error, ('\'*\' expected', sub)
+ if sub = 'retval':
+ # size is retval -- must be a reply argument
+ if mode <> 'r':
+ raise arg_error, ('non-r mode with [retval]', mode)
+ elif sub[:3] <> 'arg' or not isnum(sub[3:]):
+ raise arg_error, ('bad subscript', sub)
+ #
+ return type, mode, num, sub
+
+
+# List of functions for which we have generated stubs
+#
+functions = []
+
+
+# Generate the stub for the given function, using the database of argument
+# information build by successive calls to checkarg()
+#
+def generate(type, func, database):
+ #
+ # Check that we can handle this case:
+ # no variable size reply arrays yet
+ #
+ n_in_args = 0
+ n_out_args = 0
+ #
+ for a_type, a_mode, a_factor, a_sub in database:
+ if a_mode = 's':
+ n_in_args = n_in_args + 1
+ elif a_mode = 'r':
+ n_out_args = n_out_args + 1
+ else:
+ # Can't happen
+ raise arg_error, ('bad a_mode', a_mode)
+ if (a_mode = 'r' and a_sub) or a_sub = 'retval':
+ e = 'Function', func, 'too complicated:'
+ err(e + (a_type, a_mode, a_factor, a_sub))
+ print '/* XXX Too complicated to generate code for */'
+ return
+ #
+ functions.append(func)
+ #
+ # Stub header
+ #
+ print
+ print 'static object *'
+ print 'gl_' + func + '(self, args)'
+ print '\tobject *self;'
+ print '\tobject *args;'
+ print '{'
+ #
+ # Declare return value if any
+ #
+ if type <> 'void':
+ print '\t' + type, 'retval;'
+ #
+ # Declare arguments
+ #
+ for i in range(len(database)):
+ a_type, a_mode, a_factor, a_sub = database[i]
+ print '\t' + a_type,
+ if a_sub:
+ print '*',
+ print 'arg' + `i+1`,
+ if a_factor and not a_sub:
+ print '[', a_factor, ']',
+ print ';'
+ #
+ # Find input arguments derived from array sizes
+ #
+ for i in range(len(database)):
+ a_type, a_mode, a_factor, a_sub = database[i]
+ if a_mode = 's' and a_sub[:3] = 'arg' and isnum(a_sub[3:]):
+ # Sending a variable-length array
+ n = eval(a_sub[3:])
+ if 1 <= n <= len(database):
+ b_type, b_mode, b_factor, b_sub = database[n-1]
+ if b_mode = 's':
+ database[n-1] = b_type, 'i', a_factor, `i`
+ n_in_args = n_in_args - 1
+ #
+ # Assign argument positions in the Python argument list
+ #
+ in_pos = []
+ i_in = 0
+ for i in range(len(database)):
+ a_type, a_mode, a_factor, a_sub = database[i]
+ if a_mode = 's':
+ in_pos.append(i_in)
+ i_in = i_in + 1
+ else:
+ in_pos.append(-1)
+ #
+ # Get input arguments
+ #
+ for i in range(len(database)):
+ a_type, a_mode, a_factor, a_sub = database[i]
+ if a_mode = 'i':
+ #
+ # Implicit argument;
+ # a_factor is divisor if present,
+ # a_sub indicates which arg (`database index`)
+ #
+ j = eval(a_sub)
+ print '\tif',
+ print '(!geti' + a_type + 'arraysize(args,',
+ print `n_in_args` + ',',
+ print `in_pos[j]` + ',',
+ print '&arg' + `i+1` + '))'
+ print '\t\treturn NULL;'
+ if a_factor:
+ print '\targ' + `i+1`,
+ print '= arg' + `i+1`,
+ print '/', a_factor + ';'
+ elif a_mode = 's':
+ if a_sub: # Allocate memory for varsize array
+ print '\tif ((arg' + `i+1`, '=',
+ print 'NEW(' + a_type + ',',
+ if a_factor: print a_factor, '*',
+ print a_sub, ')) == NULL)'
+ print '\t\treturn err_nomem();'
+ print '\tif',
+ if a_factor or a_sub: # Get a fixed-size array array
+ print '(!geti' + a_type + 'array(args,',
+ print `n_in_args` + ',',
+ print `in_pos[i]` + ',',
+ if a_factor: print a_factor,
+ if a_factor and a_sub: print '*',
+ if a_sub: print a_sub,
+ print ', arg' + `i+1` + '))'
+ else: # Get a simple variable
+ print '(!geti' + a_type + 'arg(args,',
+ print `n_in_args` + ',',
+ print `in_pos[i]` + ',',
+ print '&arg' + `i+1` + '))'
+ print '\t\treturn NULL;'
+ #
+ # Begin of function call
+ #
+ if type <> 'void':
+ print '\tretval =', func + '(',
+ else:
+ print '\t' + func + '(',
+ #
+ # Argument list
+ #
+ for i in range(len(database)):
+ if i > 0: print ',',
+ a_type, a_mode, a_factor, a_sub = database[i]
+ if a_mode = 'r' and not a_factor:
+ print '&',
+ print 'arg' + `i+1`,
+ #
+ # End of function call
+ #
+ print ');'
+ #
+ # Free varsize arrays
+ #
+ for i in range(len(database)):
+ a_type, a_mode, a_factor, a_sub = database[i]
+ if a_mode = 's' and a_sub:
+ print '\tDEL(arg' + `i+1` + ');'
+ #
+ # Return
+ #
+ if n_out_args:
+ #
+ # Multiple return values -- construct a tuple
+ #
+ if type <> 'void':
+ n_out_args = n_out_args + 1
+ if n_out_args = 1:
+ for i in range(len(database)):
+ a_type, a_mode, a_factor, a_sub = database[i]
+ if a_mode = 'r':
+ break
+ else:
+ raise arg_error, 'expected r arg not found'
+ print '\treturn',
+ print mkobject(a_type, 'arg' + `i+1`) + ';'
+ else:
+ print '\t{ object *v = newtupleobject(',
+ print n_out_args, ');'
+ print '\t if (v == NULL) return NULL;'
+ i_out = 0
+ if type <> 'void':
+ print '\t settupleitem(v,',
+ print `i_out` + ',',
+ print mkobject(type, 'retval') + ');'
+ i_out = i_out + 1
+ for i in range(len(database)):
+ a_type, a_mode, a_factor, a_sub = database[i]
+ if a_mode = 'r':
+ print '\t settupleitem(v,',
+ print `i_out` + ',',
+ s = mkobject(a_type, 'arg' + `i+1`)
+ print s + ');'
+ i_out = i_out + 1
+ print '\t return v;'
+ print '\t}'
+ else:
+ #
+ # Simple function return
+ # Return None or return value
+ #
+ if type = 'void':
+ print '\tINCREF(None);'
+ print '\treturn None;'
+ else:
+ print '\treturn', mkobject(type, 'retval') + ';'
+ #
+ # Stub body closing brace
+ #
+ print '}'
+
+
+# Subroutine to return a function call to mknew<type>object(<arg>)
+#
+def mkobject(type, arg):
+ return 'mknew' + type + 'object(' + arg + ')'
+
+
+# Input line number
+lno = 0
+
+
+# Input is divided in two parts, separated by a line containing '%%'.
+# <part1> -- literally copied to stdout
+# <part2> -- stub definitions
+
+# Variable indicating the current input part.
+#
+part = 1
+
+# Main loop over the input
+#
+while 1:
+ try:
+ line = raw_input()
+ except EOFError:
+ break
+ #
+ lno = lno+1
+ words = string.split(line)
+ #
+ if part = 1:
+ #
+ # In part 1, copy everything literally
+ # except look for a line of just '%%'
+ #
+ if words = ['%%']:
+ part = part + 1
+ else:
+ #
+ # Look for names of manually written
+ # stubs: a single percent followed by the name
+ # of the function in Python.
+ # The stub name is derived by prefixing 'gl_'.
+ #
+ if words and words[0][0] = '%':
+ func = words[0][1:]
+ if (not func) and words[1:]:
+ func = words[1]
+ if func:
+ functions.append(func)
+ else:
+ print line
+ elif not words:
+ pass # skip empty line
+ elif words[0] = '#include':
+ print line
+ elif words[0][:1] = '#':
+ pass # ignore comment
+ elif words[0] not in return_types:
+ err('Line', lno, ': bad return type :', words[0])
+ elif len(words) < 2:
+ err('Line', lno, ': no funcname :', line)
+ else:
+ if len(words) % 2 <> 0:
+ err('Line', lno, ': odd argument list :', words[2:])
+ else:
+ database = []
+ try:
+ for i in range(2, len(words), 2):
+ x = checkarg(words[i], words[i+1])
+ database.append(x)
+ print
+ print '/*',
+ for w in words: print w,
+ print '*/'
+ generate(words[0], words[1], database)
+ except arg_error, msg:
+ err('Line', lno, ':', msg)
+
+
+print
+print 'static struct methodlist gl_methods[] = {'
+for func in functions:
+ print '\t{"' + func + '", gl_' + func + '},'
+print '\t{NULL, NULL} /* Sentinel */'
+print '};'
+print
+print 'initgl()'
+print '{'
+print '\tinitmodule("gl", gl_methods);'
+print '}'
--- /dev/null
+/* Functions used by cgen output */
+
+#include <stdio.h>
+
+#include "PROTO.h"
+#include "object.h"
+#include "intobject.h"
+#include "floatobject.h"
+#include "stringobject.h"
+#include "tupleobject.h"
+#include "listobject.h"
+#include "methodobject.h"
+#include "moduleobject.h"
+#include "modsupport.h"
+#include "import.h"
+#include "cgensupport.h"
+#include "errors.h"
+
+
+/* Functions to construct return values */
+
+object *
+mknewcharobject(c)
+ int c;
+{
+ char ch[1];
+ ch[0] = c;
+ return newsizedstringobject(ch, 1);
+}
+
+/* Functions to extract arguments.
+ These needs to know the total number of arguments supplied,
+ since the argument list is a tuple only of there is more than
+ one argument. */
+
+int
+getiobjectarg(args, nargs, i, p_arg)
+ register object *args;
+ int nargs, i;
+ object **p_arg;
+{
+ if (nargs != 1) {
+ if (args == NULL || !is_tupleobject(args) ||
+ nargs != gettuplesize(args) ||
+ i < 0 || i >= nargs) {
+ return err_badarg();
+ }
+ else {
+ args = gettupleitem(args, i);
+ }
+ }
+ if (args == NULL) {
+ return err_badarg();
+ }
+ *p_arg = args;
+ return 1;
+}
+
+int
+getilongarg(args, nargs, i, p_arg)
+ register object *args;
+ int nargs, i;
+ long *p_arg;
+{
+ if (nargs != 1) {
+ if (args == NULL || !is_tupleobject(args) ||
+ nargs != gettuplesize(args) ||
+ i < 0 || i >= nargs) {
+ return err_badarg();
+ }
+ args = gettupleitem(args, i);
+ }
+ if (args == NULL || !is_intobject(args)) {
+ return err_badarg();
+ }
+ *p_arg = getintvalue(args);
+ return 1;
+}
+
+int
+getishortarg(args, nargs, i, p_arg)
+ register object *args;
+ int nargs, i;
+ short *p_arg;
+{
+ long x;
+ if (!getilongarg(args, nargs, i, &x))
+ return 0;
+ *p_arg = x;
+ return 1;
+}
+
+static int
+extractdouble(v, p_arg)
+ register object *v;
+ double *p_arg;
+{
+ if (v == NULL) {
+ /* Fall through to error return at end of function */
+ }
+ else if (is_floatobject(v)) {
+ *p_arg = GETFLOATVALUE((floatobject *)v);
+ return 1;
+ }
+ else if (is_intobject(v)) {
+ *p_arg = GETINTVALUE((intobject *)v);
+ return 1;
+ }
+ return err_badarg();
+}
+
+static int
+extractfloat(v, p_arg)
+ register object *v;
+ float *p_arg;
+{
+ if (v == NULL) {
+ /* Fall through to error return at end of function */
+ }
+ else if (is_floatobject(v)) {
+ *p_arg = GETFLOATVALUE((floatobject *)v);
+ return 1;
+ }
+ else if (is_intobject(v)) {
+ *p_arg = GETINTVALUE((intobject *)v);
+ return 1;
+ }
+ return err_badarg();
+}
+
+int
+getifloatarg(args, nargs, i, p_arg)
+ register object *args;
+ int nargs, i;
+ float *p_arg;
+{
+ object *v;
+ float x;
+ if (!getiobjectarg(args, nargs, i, &v))
+ return 0;
+ if (!extractfloat(v, &x))
+ return 0;
+ *p_arg = x;
+ return 1;
+}
+
+int
+getistringarg(args, nargs, i, p_arg)
+ object *args;
+ int nargs, i;
+ string *p_arg;
+{
+ object *v;
+ if (!getiobjectarg(args, nargs, i, &v))
+ return NULL;
+ if (!is_stringobject(v)) {
+ return err_badarg();
+ }
+ *p_arg = getstringvalue(v);
+ return 1;
+}
+
+int
+getichararg(args, nargs, i, p_arg)
+ object *args;
+ int nargs, i;
+ char *p_arg;
+{
+ string x;
+ if (!getistringarg(args, nargs, i, &x))
+ return 0;
+ if (x[0] == '\0' || x[1] != '\0') {
+ /* Not exactly one char */
+ return err_badarg();
+ }
+ *p_arg = x[0];
+ return 1;
+}
+
+int
+getilongarraysize(args, nargs, i, p_arg)
+ object *args;
+ int nargs, i;
+ long *p_arg;
+{
+ object *v;
+ if (!getiobjectarg(args, nargs, i, &v))
+ return 0;
+ if (is_tupleobject(v)) {
+ *p_arg = gettuplesize(v);
+ return 1;
+ }
+ if (is_listobject(v)) {
+ *p_arg = getlistsize(v);
+ return 1;
+ }
+ return err_badarg();
+}
+
+int
+getishortarraysize(args, nargs, i, p_arg)
+ object *args;
+ int nargs, i;
+ short *p_arg;
+{
+ long x;
+ if (!getilongarraysize(args, nargs, i, &x))
+ return 0;
+ *p_arg = x;
+ return 1;
+}
+
+/* XXX The following four are too similar. Should share more code. */
+
+int
+getilongarray(args, nargs, i, n, p_arg)
+ object *args;
+ int nargs, i;
+ int n;
+ long *p_arg; /* [n] */
+{
+ object *v, *w;
+ if (!getiobjectarg(args, nargs, i, &v))
+ return 0;
+ if (is_tupleobject(v)) {
+ if (gettuplesize(v) != n) {
+ return err_badarg();
+ }
+ for (i = 0; i < n; i++) {
+ w = gettupleitem(v, i);
+ if (!is_intobject(w)) {
+ return err_badarg();
+ }
+ p_arg[i] = getintvalue(w);
+ }
+ return 1;
+ }
+ else if (is_listobject(v)) {
+ if (getlistsize(v) != n) {
+ return err_badarg();
+ }
+ for (i = 0; i < n; i++) {
+ w = getlistitem(v, i);
+ if (!is_intobject(w)) {
+ return err_badarg();
+ }
+ p_arg[i] = getintvalue(w);
+ }
+ return 1;
+ }
+ else {
+ return err_badarg();
+ }
+}
+
+int
+getishortarray(args, nargs, i, n, p_arg)
+ object *args;
+ int nargs, i;
+ int n;
+ short *p_arg; /* [n] */
+{
+ object *v, *w;
+ if (!getiobjectarg(args, nargs, i, &v))
+ return 0;
+ if (is_tupleobject(v)) {
+ if (gettuplesize(v) != n) {
+ return err_badarg();
+ }
+ for (i = 0; i < n; i++) {
+ w = gettupleitem(v, i);
+ if (!is_intobject(w)) {
+ return err_badarg();
+ }
+ p_arg[i] = getintvalue(w);
+ }
+ return 1;
+ }
+ else if (is_listobject(v)) {
+ if (getlistsize(v) != n) {
+ return err_badarg();
+ }
+ for (i = 0; i < n; i++) {
+ w = getlistitem(v, i);
+ if (!is_intobject(w)) {
+ return err_badarg();
+ }
+ p_arg[i] = getintvalue(w);
+ }
+ return 1;
+ }
+ else {
+ return err_badarg();
+ }
+}
+
+int
+getidoublearray(args, nargs, i, n, p_arg)
+ object *args;
+ int nargs, i;
+ int n;
+ double *p_arg; /* [n] */
+{
+ object *v, *w;
+ if (!getiobjectarg(args, nargs, i, &v))
+ return 0;
+ if (is_tupleobject(v)) {
+ if (gettuplesize(v) != n) {
+ return err_badarg();
+ }
+ for (i = 0; i < n; i++) {
+ w = gettupleitem(v, i);
+ if (!extractdouble(w, &p_arg[i]))
+ return 0;
+ }
+ return 1;
+ }
+ else if (is_listobject(v)) {
+ if (getlistsize(v) != n) {
+ return err_badarg();
+ }
+ for (i = 0; i < n; i++) {
+ w = getlistitem(v, i);
+ if (!extractdouble(w, &p_arg[i]))
+ return 0;
+ }
+ return 1;
+ }
+ else {
+ return err_badarg();
+ }
+}
+
+int
+getifloatarray(args, nargs, i, n, p_arg)
+ object *args;
+ int nargs, i;
+ int n;
+ float *p_arg; /* [n] */
+{
+ object *v, *w;
+ if (!getiobjectarg(args, nargs, i, &v))
+ return 0;
+ if (is_tupleobject(v)) {
+ if (gettuplesize(v) != n) {
+ return err_badarg();
+ }
+ for (i = 0; i < n; i++) {
+ w = gettupleitem(v, i);
+ if (!extractfloat(w, &p_arg[i]))
+ return 0;
+ }
+ return 1;
+ }
+ else if (is_listobject(v)) {
+ if (getlistsize(v) != n) {
+ return err_badarg();
+ }
+ for (i = 0; i < n; i++) {
+ w = getlistitem(v, i);
+ if (!extractfloat(w, &p_arg[i]))
+ return 0;
+ }
+ return 1;
+ }
+ else {
+ return err_badarg();
+ }
+}
--- /dev/null
+/* Definitions used by cgen output */
+
+typedef char *string;
+
+#define mknewlongobject(x) newintobject(x)
+#define mknewshortobject(x) newintobject((long)x)
+#define mknewfloatobject(x) newfloatobject(x)
+
+extern object *mknewcharobject PROTO((int c));
+
+extern int getiobjectarg PROTO((object *args, int nargs, int i, object **p_a));
+extern int getilongarg PROTO((object *args, int nargs, int i, long *p_a));
+extern int getishortarg PROTO((object *args, int nargs, int i, short *p_a));
+extern int getifloatarg PROTO((object *args, int nargs, int i, float *p_a));
+extern int getistringarg PROTO((object *args, int nargs, int i, string *p_a));
--- /dev/null
+/*
+Input used to generate the Python module "glmodule.c".
+The stub generator is a Python script called "cgen".
+
+Each definition must be contained on one line:
+
+<returntype> <name> <type> <arg> <type> <arg>
+
+<returntype> can be: void, short, long (XXX maybe others?)
+
+<type> can be: char, string, short, float, long, or double
+ string indicates a null terminated string;
+ if <type> is char and <arg> begins with a *, the * is stripped
+ and <type> is changed into string
+
+<arg> has the form <mode> or <mode>[<subscript>]
+ where <mode> can be
+ s: arg is sent
+ r: arg is received (arg is a pointer)
+ and <subscript> can be (N and I are numbers):
+ N
+ argI
+ retval
+ N*argI
+ N*retval
+*/
+
+#include <stdio.h>
+#include <gl.h>
+#include <device.h>
+#include "PROTO.h"
+#include "object.h"
+#include "intobject.h"
+#include "floatobject.h"
+#include "listobject.h"
+#include "tupleobject.h"
+#include "dictobject.h"
+#include "methodobject.h"
+#include "moduleobject.h"
+#include "objimpl.h"
+#include "import.h"
+#include "sigtype.h"
+#include "modsupport.h"
+#include "cgensupport.h"
+#include "errors.h"
+
+/*
+Some stubs are too complicated for the stub generator.
+We can include manually written versions of them here.
+A line starting with '%' gives the name of the function so the stub
+generator can include it in the table of functions.
+*/
+
+/*
+varray -- an array of v.. calls.
+The argument is an array (maybe list or tuple) of points.
+Each point must be a tuple or list of coordinates (x, y, z).
+The points may be 2- or 3-dimensional but must all have the
+same dimension. Float and int values may be mixed however.
+The points are always converted to 3D double precision points
+by assuming z=0.0 if necessary (as indicated in the man page),
+and for each point v3d() is called.
+*/
+
+% varray
+
+static object *
+gl_varray(self, args)
+ object *self;
+ object *args;
+{
+ object *v, *w;
+ int i, n, width;
+ double vec[3];
+ object * (*getitem) FPROTO((object *, int));
+
+ if (!getiobjectarg(args, 1, 0, &v))
+ return NULL;
+
+ if (is_listobject(v)) {
+ n = getlistsize(v);
+ getitem = getlistitem;
+ }
+ else if (is_tupleobject(v)) {
+ n = gettuplesize(v);
+ getitem = gettupleitem;
+ }
+ else {
+ err_badarg();
+ return NULL;
+ }
+
+ if (n == 0) {
+ INCREF(None);
+ return None;
+ }
+ if (n > 0)
+ w = (*getitem)(v, 0);
+
+ width = 0;
+ if (w == NULL) {
+ }
+ else if (is_listobject(w)) {
+ width = getlistsize(w);
+ }
+ else if (is_tupleobject(w)) {
+ width = gettuplesize(w);
+ }
+
+ switch (width) {
+ case 2:
+ vec[2] = 0.0;
+ /* Fall through */
+ case 3:
+ break;
+ default:
+ err_badarg();
+ return NULL;
+ }
+
+ for (i = 0; i < n; i++) {
+ w = (*getitem)(v, i);
+ if (!getidoublearray(w, 1, 0, width, vec))
+ return NULL;
+ v3d(vec);
+ }
+
+ INCREF(None);
+ return None;
+}
+
+/*
+vnarray, nvarray -- an array of n3f and v3f calls.
+The argument is an array (list or tuple) of pairs of points and normals.
+Each pair is a tuple (NOT a list) of a point and a normal for that point.
+Each point or normal must be a tuple (NOT a list) of coordinates (x, y, z).
+Three coordinates must be given. Float and int values may be mixed.
+For each pair, n3f() is called for the normal, and then v3f() is called
+for the vector.
+
+vnarray and nvarray differ only in the order of the vector and normal in
+the pair: vnarray expects (v, n) while nvarray expects (n, v).
+*/
+
+static object *gen_nvarray(); /* Forward */
+
+% nvarray
+
+static object *
+gl_nvarray(self, args)
+ object *self;
+ object *args;
+{
+ return gen_nvarray(args, 0);
+}
+
+% vnarray
+
+static object *
+gl_vnarray(self, args)
+ object *self;
+ object *args;
+{
+ return gen_nvarray(args, 1);
+}
+
+/* Generic, internal version of {nv,nv}array: inorm indicates the
+ argument order, 0: normal first, 1: vector first. */
+
+static object *
+gen_nvarray(args, inorm)
+ object *args;
+ int inorm;
+{
+ object *v, *w, *wnorm, *wvec;
+ int i, n;
+ float norm[3], vec[3];
+ object * (*getitem) FPROTO((object *, int));
+
+ if (!getiobjectarg(args, 1, 0, &v))
+ return NULL;
+
+ if (is_listobject(v)) {
+ n = getlistsize(v);
+ getitem = getlistitem;
+ }
+ else if (is_tupleobject(v)) {
+ n = gettuplesize(v);
+ getitem = gettupleitem;
+ }
+ else {
+ err_badarg();
+ return NULL;
+ }
+
+ for (i = 0; i < n; i++) {
+ w = (*getitem)(v, i);
+ if (!is_tupleobject(w) || gettuplesize(w) != 2) {
+ err_badarg();
+ return NULL;
+ }
+ wnorm = gettupleitem(w, inorm);
+ wvec = gettupleitem(w, 1 - inorm);
+ if (!getifloatarray(wnorm, 1, 0, 3, norm) ||
+ !getifloatarray(wvec, 1, 0, 3, vec))
+ return NULL;
+ n3f(norm);
+ v3f(vec);
+ }
+
+ INCREF(None);
+ return None;
+}
+
+/* nurbssurface(s_knots[], t_knots[], ctl[][], s_order, t_order, type).
+ The dimensions of ctl[] are computed as follows:
+ [len(s_knots) - s_order], [len(t_knots) - t_order]
+*/
+
+% nurbssurface
+
+static object *
+gl_nurbssurface(self, args)
+ object *self;
+ object *args;
+{
+ long arg1 ;
+ double * arg2 ;
+ long arg3 ;
+ double * arg4 ;
+ double *arg5 ;
+ long arg6 ;
+ long arg7 ;
+ long arg8 ;
+ long ncoords;
+ long s_byte_stride, t_byte_stride;
+ long s_nctl, t_nctl;
+ long s, t;
+ object *v, *w, *pt;
+ double *pnext;
+ if (!getilongarraysize(args, 6, 0, &arg1))
+ return NULL;
+ if ((arg2 = NEW(double, arg1 )) == NULL) {
+ return err_nomem();
+ }
+ if (!getidoublearray(args, 6, 0, arg1 , arg2))
+ return NULL;
+ if (!getilongarraysize(args, 6, 1, &arg3))
+ return NULL;
+ if ((arg4 = NEW(double, arg3 )) == NULL) {
+ return err_nomem();
+ }
+ if (!getidoublearray(args, 6, 1, arg3 , arg4))
+ return NULL;
+ if (!getilongarg(args, 6, 3, &arg6))
+ return NULL;
+ if (!getilongarg(args, 6, 4, &arg7))
+ return NULL;
+ if (!getilongarg(args, 6, 5, &arg8))
+ return NULL;
+ if (arg8 == N_XYZ)
+ ncoords = 3;
+ else if (arg8 == N_XYZW)
+ ncoords = 4;
+ else {
+ err_badarg();
+ return NULL;
+ }
+ s_nctl = arg1 - arg6;
+ t_nctl = arg3 - arg7;
+ if (!getiobjectarg(args, 6, 2, &v))
+ return NULL;
+ if (!is_listobject(v) || getlistsize(v) != s_nctl) {
+ err_badarg();
+ return NULL;
+ }
+ if ((arg5 = NEW(double, s_nctl*t_nctl*ncoords )) == NULL) {
+ return err_nomem();
+ }
+ pnext = arg5;
+ for (s = 0; s < s_nctl; s++) {
+ w = getlistitem(v, s);
+ if (w == NULL || !is_listobject(w) ||
+ getlistsize(w) != t_nctl) {
+ err_badarg();
+ return NULL;
+ }
+ for (t = 0; t < t_nctl; t++) {
+ pt = getlistitem(w, t);
+ if (!getidoublearray(pt, 1, 0, ncoords, pnext))
+ return NULL;
+ pnext += ncoords;
+ }
+ }
+ s_byte_stride = sizeof(double) * ncoords;
+ t_byte_stride = s_byte_stride * s_nctl;
+ nurbssurface( arg1 , arg2 , arg3 , arg4 ,
+ s_byte_stride , t_byte_stride , arg5 , arg6 , arg7 , arg8 );
+ DEL(arg2);
+ DEL(arg4);
+ DEL(arg5);
+ INCREF(None);
+ return None;
+}
+
+/* nurbscurve(knots, ctlpoints, order, type).
+ The length of ctlpoints is len(knots)-order. */
+
+%nurbscurve
+
+static object *
+gl_nurbscurve(self, args)
+ object *self;
+ object *args;
+{
+ long arg1 ;
+ double * arg2 ;
+ long arg3 ;
+ double * arg4 ;
+ long arg5 ;
+ long arg6 ;
+ int ncoords, npoints;
+ int i;
+ object *v;
+ double *pnext;
+ if (!getilongarraysize(args, 4, 0, &arg1))
+ return NULL;
+ if ((arg2 = NEW(double, arg1 )) == NULL) {
+ return err_nomem();
+ }
+ if (!getidoublearray(args, 4, 0, arg1 , arg2))
+ return NULL;
+ if (!getilongarg(args, 4, 2, &arg5))
+ return NULL;
+ if (!getilongarg(args, 4, 3, &arg6))
+ return NULL;
+ if (arg6 == N_ST)
+ ncoords = 2;
+ else if (arg6 == N_STW)
+ ncoords = 3;
+ else {
+ err_badarg();
+ return NULL;
+ }
+ npoints = arg1 - arg5;
+ if (!getiobjectarg(args, 4, 1, &v))
+ return NULL;
+ if (!is_listobject(v) || getlistsize(v) != npoints) {
+ err_badarg();
+ return NULL;
+ }
+ if ((arg4 = NEW(double, npoints*ncoords )) == NULL) {
+ return err_nomem();
+ }
+ pnext = arg4;
+ for (i = 0; i < npoints; i++) {
+ if (!getidoublearray(getlistitem(v, i), 1, 0, ncoords, pnext))
+ return NULL;
+ pnext += ncoords;
+ }
+ arg3 = (sizeof(double)) * ncoords;
+ nurbscurve( arg1 , arg2 , arg3 , arg4 , arg5 , arg6 );
+ DEL(arg2);
+ DEL(arg4);
+ INCREF(None);
+ return None;
+}
+
+/* pwlcurve(points, type).
+ Points is a list of points. Type must be N_ST. */
+
+%pwlcurve
+
+static object *
+gl_pwlcurve(self, args)
+ object *self;
+ object *args;
+{
+ object *v;
+ long type;
+ double *data, *pnext;
+ long npoints, ncoords;
+ int i;
+ if (!getiobjectarg(args, 2, 0, &v))
+ return NULL;
+ if (!getilongarg(args, 2, 1, &type))
+ return NULL;
+ if (!is_listobject(v)) {
+ err_badarg();
+ return NULL;
+ }
+ npoints = getlistsize(v);
+ if (type == N_ST)
+ ncoords = 2;
+ else {
+ err_badarg();
+ return NULL;
+ }
+ if ((data = NEW(double, npoints*ncoords)) == NULL) {
+ return err_nomem();
+ }
+ pnext = data;
+ for (i = 0; i < npoints; i++) {
+ if (!getidoublearray(getlistitem(v, i), 1, 0, ncoords, pnext))
+ return NULL;
+ pnext += ncoords;
+ }
+ pwlcurve(npoints, data, sizeof(double)*ncoords, type);
+ DEL(data);
+ INCREF(None);
+ return None;
+}
+
+
+/* Picking and Selecting */
+
+static short *pickbuffer = NULL;
+static long pickbuffersize;
+
+static object *
+pick_select(args, func)
+ object *args;
+ void (*func)();
+{
+ if (!getilongarg(args, 1, 0, &pickbuffersize))
+ return NULL;
+ if (pickbuffer != NULL) {
+ err_setstr(RuntimeError,
+ "pick/gselect: already picking/selecting");
+ return NULL;
+ }
+ if ((pickbuffer = NEW(short, pickbuffersize)) == NULL) {
+ return err_nomem();
+ }
+ (*func)(pickbuffer, pickbuffersize);
+ INCREF(None);
+ return None;
+}
+
+static object *
+endpick_select(args, func)
+ object *args;
+ long (*func)();
+{
+ object *v, *w;
+ int i, nhits, n;
+ if (!getnoarg(args))
+ return NULL;
+ if (pickbuffer == NULL) {
+ err_setstr(RuntimeError,
+ "endpick/endselect: not in pick/select mode");
+ return NULL;
+ }
+ nhits = (*func)(pickbuffer);
+ if (nhits < 0) {
+ nhits = -nhits; /* How to report buffer overflow otherwise? */
+ }
+ /* Scan the buffer to see how many integers */
+ n = 0;
+ for (; nhits > 0; nhits--) {
+ n += 1 + pickbuffer[n];
+ }
+ v = newlistobject(n);
+ if (v == NULL)
+ return NULL;
+ /* XXX Could do it nicer and interpret the data structure here,
+ returning a list of lists. But this can be done in Python... */
+ for (i = 0; i < n; i++) {
+ w = newintobject((long)pickbuffer[i]);
+ if (w == NULL) {
+ DECREF(v);
+ return NULL;
+ }
+ setlistitem(v, i, w);
+ }
+ DEL(pickbuffer);
+ pickbuffer = NULL;
+ return v;
+}
+
+extern void pick(), gselect();
+extern long endpick(), endselect();
+
+%pick
+static object *gl_pick(self, args) object *self, *args; {
+ return pick_select(args, pick);
+}
+
+%endpick
+static object *gl_endpick(self, args) object *self, *args; {
+ return endpick_select(args, endpick);
+}
+
+%gselect
+static object *gl_gselect(self, args) object *self, *args; {
+ return pick_select(args, gselect);
+}
+
+%endselect
+static object *gl_endselect(self, args) object *self, *args; {
+ return endpick_select(args, endselect);
+}
+
+
+/* XXX The generator botches this one. Here's a quick hack to fix it. */
+
+% getmatrix float r[16]
+
+static object *
+gl_getmatrix(self, args)
+ object *self;
+ object *args;
+{
+ float arg1 [ 16 ] ;
+ object *v, *w;
+ int i;
+ getmatrix( arg1 );
+ v = newlistobject(16);
+ if (v == NULL) {
+ return err_nomem();
+ }
+ for (i = 0; i < 16; i++) {
+ w = mknewfloatobject(arg1[i]);
+ if (w == NULL) {
+ DECREF(v);
+ return NULL;
+ }
+ setlistitem(v, i, w);
+ }
+ return v;
+}
+
+/* End of manually written stubs */
+
+%%
+
+long getshade
+void devport short s long s
+void rdr2i long s long s
+void rectfs short s short s short s short s
+void rects short s short s short s short s
+void rmv2i long s long s
+void noport
+void popviewport
+void clear
+void clearhitcode
+void closeobj
+void cursoff
+void curson
+void doublebuffer
+void finish
+void gconfig
+void ginit
+void greset
+void multimap
+void onemap
+void popattributes
+void popmatrix
+void pushattributes
+void pushmatrix
+void pushviewport
+void qreset
+void RGBmode
+void singlebuffer
+void swapbuffers
+void gsync
+void tpon
+void tpoff
+void clkon
+void clkoff
+void ringbell
+#void callfunc
+void gbegin
+void textinit
+void initnames
+void pclos
+void popname
+void spclos
+void zclear
+void screenspace
+void reshapeviewport
+void winpush
+void winpop
+void foreground
+void endfullscrn
+void endpupmode
+void fullscrn
+void pupmode
+void winconstraints
+void pagecolor short s
+void textcolor short s
+void color short s
+void curveit short s
+void font short s
+void linewidth short s
+void setlinestyle short s
+void setmap short s
+void swapinterval short s
+void writemask short s
+void textwritemask short s
+void qdevice short s
+void unqdevice short s
+void curvebasis short s
+void curveprecision short s
+void loadname short s
+void passthrough short s
+void pushname short s
+void setmonitor short s
+void setshade short s
+void setpattern short s
+void pagewritemask short s
+#
+void callobj long s
+void delobj long s
+void editobj long s
+void makeobj long s
+void maketag long s
+void chunksize long s
+void compactify long s
+void deltag long s
+void lsrepeat long s
+void objinsert long s
+void objreplace long s
+void winclose long s
+void blanktime long s
+void freepup long s
+# This is not in the library!?
+###void pupcolor long s
+#
+void backbuffer long s
+void frontbuffer long s
+void lsbackup long s
+void resetls long s
+void lampon long s
+void lampoff long s
+void setbell long s
+void blankscreen long s
+void depthcue long s
+void zbuffer long s
+void backface long s
+#
+void cmov2i long s long s
+void draw2i long s long s
+void move2i long s long s
+void pnt2i long s long s
+void patchbasis long s long s
+void patchprecision long s long s
+void pdr2i long s long s
+void pmv2i long s long s
+void rpdr2i long s long s
+void rpmv2i long s long s
+void xfpt2i long s long s
+void objdelete long s long s
+void patchcurves long s long s
+void minsize long s long s
+void maxsize long s long s
+void keepaspect long s long s
+void prefsize long s long s
+void stepunit long s long s
+void fudge long s long s
+void winmove long s long s
+#
+void attachcursor short s short s
+void deflinestyle short s short s
+void noise short s short s
+void picksize short s short s
+void qenter short s short s
+void setdepth short s short s
+void cmov2s short s short s
+void draw2s short s short s
+void move2s short s short s
+void pdr2s short s short s
+void pmv2s short s short s
+void pnt2s short s short s
+void rdr2s short s short s
+void rmv2s short s short s
+void rpdr2s short s short s
+void rpmv2s short s short s
+void xfpt2s short s short s
+#
+void cmov2 float s float s
+void draw2 float s float s
+void move2 float s float s
+void pnt2 float s float s
+void pdr2 float s float s
+void pmv2 float s float s
+void rdr2 float s float s
+void rmv2 float s float s
+void rpdr2 float s float s
+void rpmv2 float s float s
+void xfpt2 float s float s
+#
+void loadmatrix float s[16]
+void multmatrix float s[16]
+void crv float s[16]
+void rcrv float s[16]
+#
+# Methods that have strings.
+#
+void addtopup long s char *s long s
+void charstr char *s
+void getport char *s
+long strwidth char *s
+long winopen char *s
+void wintitle char *s
+#
+# Methods that have 1 long (# of elements) and an array
+#
+void polf long s float s[3*arg1]
+void polf2 long s float s[2*arg1]
+void poly long s float s[3*arg1]
+void poly2 long s float s[2*arg1]
+void crvn long s float s[3*arg1]
+void rcrvn long s float s[4*arg1]
+#
+void polf2i long s long s[2*arg1]
+void polfi long s long s[3*arg1]
+void poly2i long s long s[2*arg1]
+void polyi long s long s[3*arg1]
+#
+void polf2s long s short s[2*arg1]
+void polfs long s short s[3*arg1]
+void polys long s short s[3*arg1]
+void poly2s long s short s[2*arg1]
+#
+void defcursor short s short s[16]
+void writepixels short s short s[arg1]
+void defbasis long s float s[16]
+void gewrite short s short s[arg1]
+#
+void rotate short s char s
+# This is not in the library!?
+###void setbutton short s char s
+void rot float s char s
+#
+void circfi long s long s long s
+void circi long s long s long s
+void cmovi long s long s long s
+void drawi long s long s long s
+void movei long s long s long s
+void pnti long s long s long s
+void newtag long s long s long s
+void pdri long s long s long s
+void pmvi long s long s long s
+void rdri long s long s long s
+void rmvi long s long s long s
+void rpdri long s long s long s
+void rpmvi long s long s long s
+void xfpti long s long s long s
+#
+void circ float s float s float s
+void circf float s float s float s
+void cmov float s float s float s
+void draw float s float s float s
+void move float s float s float s
+void pnt float s float s float s
+void scale float s float s float s
+void translate float s float s float s
+void pdr float s float s float s
+void pmv float s float s float s
+void rdr float s float s float s
+void rmv float s float s float s
+void rpdr float s float s float s
+void rpmv float s float s float s
+void xfpt float s float s float s
+#
+void RGBcolor short s short s short s
+void RGBwritemask short s short s short s
+void setcursor short s short s short s
+void tie short s short s short s
+void circfs short s short s short s
+void circs short s short s short s
+void cmovs short s short s short s
+void draws short s short s short s
+void moves short s short s short s
+void pdrs short s short s short s
+void pmvs short s short s short s
+void pnts short s short s short s
+void rdrs short s short s short s
+void rmvs short s short s short s
+void rpdrs short s short s short s
+void rpmvs short s short s short s
+void xfpts short s short s short s
+void curorigin short s short s short s
+void cyclemap short s short s short s
+#
+void patch float s[16] float s[16] float s[16]
+void splf long s float s[3*arg1] short s[arg1]
+void splf2 long s float s[2*arg1] short s[arg1]
+void splfi long s long s[3*arg1] short s[arg1]
+void splf2i long s long s[2*arg1] short s[arg1]
+void splfs long s short s[3*arg1] short s[arg1]
+void splf2s long s short s[2*arg1] short s[arg1]
+void defpattern short s short s short s[arg2*arg2/16]
+#
+void rpatch float s[16] float s[16] float s[16] float s[16]
+#
+# routines that send 4 floats
+#
+void ortho2 float s float s float s float s
+void rect float s float s float s float s
+void rectf float s float s float s float s
+void xfpt4 float s float s float s float s
+#
+void textport short s short s short s short s
+void mapcolor short s short s short s short s
+void scrmask short s short s short s short s
+void setvaluator short s short s short s short s
+void viewport short s short s short s short s
+void shaderange short s short s short s short s
+void xfpt4s short s short s short s short s
+void rectfi long s long s long s long s
+void recti long s long s long s long s
+void xfpt4i long s long s long s long s
+void prefposition long s long s long s long s
+#
+void arc float s float s float s short s short s
+void arcf float s float s float s short s short s
+void arcfi long s long s long s short s short s
+void arci long s long s long s short s short s
+#
+void bbox2 short s short s float s float s float s float s
+void bbox2i short s short s long s long s long s long s
+void bbox2s short s short s short s short s short s short s
+void blink short s short s short s short s short s
+void ortho float s float s float s float s float s float s
+void window float s float s float s float s float s float s
+void lookat float s float s float s float s float s float s short s
+#
+void perspective short s float s float s float s
+void polarview float s short s short s short s
+# XXX getichararray not supported
+#void writeRGB short s char s[arg1] char s[arg1] char s[arg1]
+#
+void arcfs short s short s short s short s short s
+void arcs short s short s short s short s short s
+void rectcopy short s short s short s short s short s short s
+void RGBcursor short s short s short s short s short s short s short s
+#
+long getbutton short s
+long getcmmode
+long getlsbackup
+long getresetls
+long getdcm
+long getzbuffer
+long ismex
+long isobj long s
+long isqueued short s
+long istag long s
+#
+long genobj
+long gentag
+long getbuffer
+long getcolor
+long getdisplaymode
+long getfont
+long getheight
+long gethitcode
+long getlstyle
+long getlwidth
+long getmap
+long getplanes
+long getwritemask
+long qtest
+long getlsrepeat
+long getmonitor
+long getopenobj
+long getpattern
+long winget
+long winattach
+long getothermonitor
+long newpup
+#
+long getvaluator short s
+void winset long s
+long dopup long s
+void getdepth short r short r
+void getcpos short r short r
+void getsize long r long r
+void getorigin long r long r
+void getviewport short r short r short r short r
+void gettp short r short r short r short r
+void getgpos float r float r float r float r
+void winposition long s long s long s long s
+void gRGBcolor short r short r short r
+void gRGBmask short r short r short r
+void getscrmask short r short r short r short r
+void gRGBcursor short r short r short r short r short r short r short r short r long *
+void getmcolor short s short r short r short r
+void mapw long s short s short s float r float r float r float r float r float r
+void mapw2 long s short s short s float r float r
+void defrasterfont short s short s short s Fontchar s[arg3] short s short s[4*arg5]
+long qread short r
+void getcursor short r short r short r long r
+#
+# For these we receive arrays of stuff
+#
+void getdev long s short s[arg1] short r[arg1]
+#XXX not generated correctly yet
+#void getmatrix float r[16]
+long readpixels short s short r[retval]
+long readRGB short s char r[retval] char r[retval] char r[retval]
+long blkqread short s short r[arg1]
+#
+# New 4D routines
+#
+void cmode
+void concave long s
+void curstype long s
+void drawmode long s
+void gammaramp short s[256] short s[256] short s[256]
+long getbackface
+long getdescender
+long getdrawmode
+long getmmode
+long getsm
+long getvideo long s
+void imakebackground
+void lmbind short s short s
+void lmdef long s long s long s float s[arg3]
+void mmode long s
+void normal float s[3]
+void overlay long s
+void RGBrange short s short s short s short s short s short s short s short s
+void setvideo long s long s
+void shademodel long s
+void underlay long s
+#
+# New Personal Iris/GT Routines
+#
+void bgnclosedline
+void bgnline
+void bgnpoint
+void bgnpolygon
+void bgnsurface
+void bgntmesh
+void bgntrim
+void endclosedline
+void endline
+void endpoint
+void endpolygon
+void endsurface
+void endtmesh
+void endtrim
+void blendfunction long s long s
+void c3f float s[3]
+void c3i long s[3]
+void c3s short s[3]
+void c4f float s[4]
+void c4i long s[4]
+void c4s short s[4]
+void colorf float s
+void cpack long s
+void czclear long s long s
+void dglclose long s
+long dglopen char *s long s
+long getgdesc long s
+void getnurbsproperty long s float r
+void glcompat long s long s
+void iconsize long s long s
+void icontitle char *s
+void lRGBrange short s short s short s short s short s short s long s long s
+void linesmooth long s
+void lmcolor long s
+void logicop long s
+long lrectread short s short s short s short s long r[retval]
+void lrectwrite short s short s short s short s long s[(arg2-arg1+1)*(arg4-arg3+1)]
+long rectread short s short s short s short s short r[retval]
+void rectwrite short s short s short s short s short s[(arg2-arg1+1)*(arg4-arg3+1)]
+void lsetdepth long s long s
+void lshaderange short s short s long s long s
+void n3f float s[3]
+void noborder
+void pntsmooth long s
+void readsource long s
+void rectzoom float s float s
+void sbox float s float s float s float s
+void sboxi long s long s long s long s
+void sboxs short s short s short s short s
+void sboxf float s float s float s float s
+void sboxfi long s long s long s long s
+void sboxfs short s short s short s short s
+void setnurbsproperty long s float s
+void setpup long s long s long s
+void smoothline long s
+void subpixel long s
+void swaptmesh
+long swinopen long s
+void v2f float s[2]
+void v2i long s[2]
+void v2s short s[2]
+void v3f float s[3]
+void v3i long s[3]
+void v3s short s[3]
+void v4f float s[4]
+void v4i long s[4]
+void v4s short s[4]
+void videocmd long s
+long windepth long s
+void wmpack long s
+void zdraw long s
+void zfunction long s
+void zsource long s
+void zwritemask long s
+#
+# uses doubles
+#
+void v2d double s[2]
+void v3d double s[3]
+void v4d double s[4]
--- /dev/null
+/* Math module -- standard C math library functions, pi and e */
+
+#include <stdio.h>
+#include <math.h>
+
+#include "PROTO.h"
+#include "object.h"
+#include "intobject.h"
+#include "tupleobject.h"
+#include "floatobject.h"
+#include "dictobject.h"
+#include "methodobject.h"
+#include "moduleobject.h"
+#include "objimpl.h"
+#include "import.h"
+#include "modsupport.h"
+
+static int
+getdoublearg(args, px)
+ register object *args;
+ double *px;
+{
+ if (args == NULL)
+ return err_badarg();
+ if (is_floatobject(args)) {
+ *px = getfloatvalue(args);
+ return 1;
+ }
+ if (is_intobject(args)) {
+ *px = getintvalue(args);
+ return 1;
+ }
+ return err_badarg();
+}
+
+static int
+get2doublearg(args, px, py)
+ register object *args;
+ double *px, *py;
+{
+ if (args == NULL || !is_tupleobject(args) || gettuplesize(args) != 2)
+ return err_badarg();
+ return getdoublearg(gettupleitem(args, 0), px) &&
+ getdoublearg(gettupleitem(args, 1), py);
+}
+
+static object *
+math_1(args, func)
+ object *args;
+ double (*func) FPROTO((double));
+{
+ double x;
+ if (!getdoublearg(args, &x))
+ return NULL;
+ errno = 0;
+ x = (*func)(x);
+ if (errno != 0)
+ return NULL;
+ else
+ return newfloatobject(x);
+}
+
+static object *
+math_2(args, func)
+ object *args;
+ double (*func) FPROTO((double, double));
+{
+ double x, y;
+ if (!get2doublearg(args, &x, &y))
+ return NULL;
+ errno = 0;
+ x = (*func)(x, y);
+ if (errno != 0)
+ return NULL;
+ else
+ return newfloatobject(x);
+}
+
+#define FUNC1(stubname, func) \
+ static object * stubname(self, args) object *self, *args; { \
+ return math_1(args, func); \
+ }
+
+#define FUNC2(stubname, func) \
+ static object * stubname(self, args) object *self, *args; { \
+ return math_2(args, func); \
+ }
+
+FUNC1(math_acos, acos)
+FUNC1(math_asin, asin)
+FUNC1(math_atan, atan)
+FUNC2(math_atan2, atan2)
+FUNC1(math_ceil, ceil)
+FUNC1(math_cos, cos)
+FUNC1(math_cosh, cosh)
+FUNC1(math_exp, exp)
+FUNC1(math_fabs, fabs)
+FUNC1(math_floor, floor)
+#if 0
+/* XXX This one is not in the Amoeba library yet, so what the heck... */
+FUNC2(math_fmod, fmod)
+#endif
+FUNC1(math_log, log)
+FUNC1(math_log10, log10)
+FUNC2(math_pow, pow)
+FUNC1(math_sin, sin)
+FUNC1(math_sinh, sinh)
+FUNC1(math_sqrt, sqrt)
+FUNC1(math_tan, tan)
+FUNC1(math_tanh, tanh)
+
+#if 0
+/* What about these? */
+double frexp(double x, int *i);
+double ldexp(double x, int n);
+double modf(double x, double *i);
+#endif
+
+static struct methodlist math_methods[] = {
+ {"acos", math_acos},
+ {"asin", math_asin},
+ {"atan", math_atan},
+ {"atan2", math_atan2},
+ {"ceil", math_ceil},
+ {"cos", math_cos},
+ {"cosh", math_cosh},
+ {"exp", math_exp},
+ {"fabs", math_fabs},
+ {"floor", math_floor},
+#if 0
+ {"fmod", math_fmod},
+ {"frexp", math_freqp},
+ {"ldexp", math_ldexp},
+#endif
+ {"log", math_log},
+ {"log10", math_log10},
+#if 0
+ {"modf", math_modf},
+#endif
+ {"pow", math_pow},
+ {"sin", math_sin},
+ {"sinh", math_sinh},
+ {"sqrt", math_sqrt},
+ {"tan", math_tan},
+ {"tanh", math_tanh},
+ {NULL, NULL} /* sentinel */
+};
+
+void
+initmath()
+{
+ object *m, *d, *v;
+ struct methodlist *ml;
+ if ((m = new_module("math")) == NULL)
+ fatal("can't create math module");
+ d = getmoduledict(m);
+ for (ml = math_methods; ml->ml_name != NULL; ml++) {
+ v = newmethodobject(ml->ml_name, ml->ml_meth, (object *)NULL);
+ if (v == NULL || dictinsert(d, ml->ml_name, v) != 0) {
+ fatal("can't initialize math module");
+ }
+ DECREF(v);
+ }
+ dictinsert(d, "pi", newfloatobject(atan(1.0) * 4.0));
+ dictinsert(d, "e", newfloatobject(exp(1.0)));
+ DECREF(m);
+}
--- /dev/null
+/* POSIX module implementation */
+
+#include <stdio.h>
+#include <signal.h>
+#include <string.h>
+#include <setjmp.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <sys/time.h>
+#ifdef SYSV
+#include <dirent.h>
+#define direct dirent
+#else
+#include <sys/dir.h>
+#endif
+
+#include "PROTO.h"
+#include "object.h"
+#include "intobject.h"
+#include "stringobject.h"
+#include "tupleobject.h"
+#include "listobject.h"
+#include "dictobject.h"
+#include "methodobject.h"
+#include "moduleobject.h"
+#include "objimpl.h"
+#include "import.h"
+#include "sigtype.h"
+#include "modsupport.h"
+#include "errors.h"
+
+extern char *strerror();
+
+#ifdef AMOEBA
+#define NO_LSTAT
+#endif
+
+
+/* Return a dictionary corresponding to the POSIX environment table */
+
+extern char **environ;
+
+static object *
+convertenviron()
+{
+ object *d;
+ char **e;
+ d = newdictobject();
+ if (d == NULL)
+ return NULL;
+ if (environ == NULL)
+ return d;
+ /* XXX This part ignores errors */
+ for (e = environ; *e != NULL; e++) {
+ object *v;
+ char *p = strchr(*e, '=');
+ if (p == NULL)
+ continue;
+ v = newstringobject(p+1);
+ if (v == NULL)
+ continue;
+ *p = '\0';
+ (void) dictinsert(d, *e, v);
+ *p = '=';
+ DECREF(v);
+ }
+ return d;
+}
+
+
+static object *PosixError; /* Exception posix.error */
+
+/* Set a POSIX-specific error from errno, and return NULL */
+
+static object *
+posix_error()
+{
+ object *v = newtupleobject(2);
+ if (v != NULL) {
+ settupleitem(v, 0, newintobject((long)errno));
+ settupleitem(v, 1, newstringobject(strerror(errno)));
+ }
+ err_setval(PosixError, v);
+ if (v != NULL)
+ DECREF(v);
+ return NULL;
+}
+
+
+/* POSIX generic methods */
+
+static object *
+posix_1str(args, func)
+ object *args;
+ int (*func) FPROTO((const char *));
+{
+ object *path1;
+ if (!getstrarg(args, &path1))
+ return NULL;
+ if ((*func)(getstringvalue(path1)) < 0)
+ return posix_error();
+ INCREF(None);
+ return None;
+}
+
+static object *
+posix_2str(args, func)
+ object *args;
+ int (*func) FPROTO((const char *, const char *));
+{
+ object *path1, *path2;
+ if (!getstrstrarg(args, &path1, &path2))
+ return NULL;
+ if ((*func)(getstringvalue(path1), getstringvalue(path2)) < 0)
+ return posix_error();
+ INCREF(None);
+ return None;
+}
+
+static object *
+posix_strint(args, func)
+ object *args;
+ int (*func) FPROTO((const char *, int));
+{
+ object *path1;
+ int i;
+ if (!getstrintarg(args, &path1, &i))
+ return NULL;
+ if ((*func)(getstringvalue(path1), i) < 0)
+ return posix_error();
+ INCREF(None);
+ return None;
+}
+
+static object *
+posix_do_stat(self, args, statfunc)
+ object *self;
+ object *args;
+ int (*statfunc) FPROTO((const char *, struct stat *));
+{
+ struct stat st;
+ object *path;
+ object *v;
+ if (!getstrarg(args, &path))
+ return NULL;
+ if ((*statfunc)(getstringvalue(path), &st) != 0)
+ return posix_error();
+ v = newtupleobject(10);
+ if (v == NULL)
+ return NULL;
+ errno = 0;
+#define SET(i, st_member) settupleitem(v, i, newintobject((long)st.st_member))
+ SET(0, st_mode);
+ SET(1, st_ino);
+ SET(2, st_dev);
+ SET(3, st_nlink);
+ SET(4, st_uid);
+ SET(5, st_gid);
+ SET(6, st_size);
+ SET(7, st_atime);
+ SET(8, st_mtime);
+ SET(9, st_ctime);
+#undef SET
+ if (errno != 0) {
+ DECREF(v);
+ return err_nomem();
+ }
+ return v;
+}
+
+
+/* POSIX methods */
+
+static object *
+posix_chdir(self, args)
+ object *self;
+ object *args;
+{
+ extern int chdir PROTO((const char *));
+ return posix_1str(args, chdir);
+}
+
+static object *
+posix_chmod(self, args)
+ object *self;
+ object *args;
+{
+ extern int chmod PROTO((const char *, mode_t));
+ return posix_strint(args, chmod);
+}
+
+static object *
+posix_getcwd(self, args)
+ object *self;
+ object *args;
+{
+ char buf[1026];
+ extern char *getcwd PROTO((char *, int));
+ if (!getnoarg(args))
+ return NULL;
+ if (getcwd(buf, sizeof buf) == NULL)
+ return posix_error();
+ return newstringobject(buf);
+}
+
+static object *
+posix_link(self, args)
+ object *self;
+ object *args;
+{
+ extern int link PROTO((const char *, const char *));
+ return posix_2str(args, link);
+}
+
+static object *
+posix_listdir(self, args)
+ object *self;
+ object *args;
+{
+ object *name, *d, *v;
+ DIR *dirp;
+ struct direct *ep;
+ if (!getstrarg(args, &name))
+ return NULL;
+ if ((dirp = opendir(getstringvalue(name))) == NULL)
+ return posix_error();
+ if ((d = newlistobject(0)) == NULL) {
+ closedir(dirp);
+ return NULL;
+ }
+ while ((ep = readdir(dirp)) != NULL) {
+ v = newstringobject(ep->d_name);
+ if (v == NULL) {
+ DECREF(d);
+ d = NULL;
+ break;
+ }
+ if (addlistitem(d, v) != 0) {
+ DECREF(v);
+ DECREF(d);
+ d = NULL;
+ break;
+ }
+ DECREF(v);
+ }
+ closedir(dirp);
+ return d;
+}
+
+static object *
+posix_mkdir(self, args)
+ object *self;
+ object *args;
+{
+ extern int mkdir PROTO((const char *, mode_t));
+ return posix_strint(args, mkdir);
+}
+
+static object *
+posix_rename(self, args)
+ object *self;
+ object *args;
+{
+ extern int rename PROTO((const char *, const char *));
+ return posix_2str(args, rename);
+}
+
+static object *
+posix_rmdir(self, args)
+ object *self;
+ object *args;
+{
+ extern int rmdir PROTO((const char *));
+ return posix_1str(args, rmdir);
+}
+
+static object *
+posix_stat(self, args)
+ object *self;
+ object *args;
+{
+ extern int stat PROTO((const char *, struct stat *));
+ return posix_do_stat(self, args, stat);
+}
+
+static object *
+posix_system(self, args)
+ object *self;
+ object *args;
+{
+ object *command;
+ int sts;
+ if (!getstrarg(args, &command))
+ return NULL;
+ sts = system(getstringvalue(command));
+ return newintobject((long)sts);
+}
+
+static object *
+posix_umask(self, args)
+ object *self;
+ object *args;
+{
+ int i;
+ if (!getintarg(args, &i))
+ return NULL;
+ i = umask(i);
+ if (i < 0)
+ return posix_error();
+ return newintobject((long)i);
+}
+
+static object *
+posix_unlink(self, args)
+ object *self;
+ object *args;
+{
+ extern int unlink PROTO((const char *));
+ return posix_1str(args, unlink);
+}
+
+static object *
+posix_utimes(self, args)
+ object *self;
+ object *args;
+{
+ object *path;
+ struct timeval tv[2];
+ if (args == NULL || !is_tupleobject(args) || gettuplesize(args) != 2) {
+ err_badarg();
+ return NULL;
+ }
+ if (!getstrarg(gettupleitem(args, 0), &path) ||
+ !getlonglongargs(gettupleitem(args, 1),
+ &tv[0].tv_sec, &tv[1].tv_sec))
+ return NULL;
+ tv[0].tv_usec = tv[1].tv_usec = 0;
+ if (utimes(getstringvalue(path), tv) < 0)
+ return posix_error();
+ INCREF(None);
+ return None;
+}
+
+#ifdef NO_GETCWD
+
+/* Quick hack to get posix.getcwd() working for pure BSD 4.3 */
+/* XXX This assumes MAXPATHLEN = 1024 !!! */
+
+static char *
+getcwd(buf, size)
+ char *buf;
+ int size;
+{
+ extern char *getwd PROTO((char *));
+ register char *ret = getwd(buf);
+ if (ret == NULL)
+ errno = EACCES; /* Most likely error */
+ return ret;
+}
+
+#endif /* NO_GETCWD */
+
+
+#ifndef NO_LSTAT
+
+static object *
+posix_lstat(self, args)
+ object *self;
+ object *args;
+{
+ extern int lstat PROTO((const char *, struct stat *));
+ return posix_do_stat(self, args, lstat);
+}
+
+static object *
+posix_readlink(self, args)
+ object *self;
+ object *args;
+{
+ char buf[1024]; /* XXX Should use MAXPATHLEN */
+ object *path;
+ int n;
+ if (!getstrarg(args, &path))
+ return NULL;
+ n = readlink(getstringvalue(path), buf, sizeof buf);
+ if (n < 0)
+ return posix_error();
+ return newsizedstringobject(buf, n);
+}
+
+static object *
+posix_symlink(self, args)
+ object *self;
+ object *args;
+{
+ extern int symlink PROTO((const char *, const char *));
+ return posix_2str(args, symlink);
+}
+
+#endif /* NO_LSTAT */
+
+
+static struct methodlist posix_methods[] = {
+ {"chdir", posix_chdir},
+ {"chmod", posix_chmod},
+ {"getcwd", posix_getcwd},
+ {"link", posix_link},
+ {"listdir", posix_listdir},
+ {"mkdir", posix_mkdir},
+ {"rename", posix_rename},
+ {"rmdir", posix_rmdir},
+ {"stat", posix_stat},
+ {"system", posix_system},
+ {"umask", posix_umask},
+ {"unlink", posix_unlink},
+ {"utimes", posix_utimes},
+#ifndef NO_LSTAT
+ {"lstat", posix_lstat},
+ {"readlink", posix_readlink},
+ {"symlink", posix_symlink},
+#endif
+ {NULL, NULL} /* Sentinel */
+};
+
+
+void
+initposix()
+{
+ object *m, *d, *v;
+
+ m = initmodule("posix", posix_methods);
+ d = getmoduledict(m);
+
+ /* Initialize posix.environ dictionary */
+ v = convertenviron();
+ if (v == NULL || dictinsert(d, "environ", v) != 0)
+ fatal("can't define posix.environ");
+ DECREF(v);
+
+ /* Initialize posix.error exception */
+ PosixError = newstringobject("posix.error");
+ if (PosixError == NULL || dictinsert(d, "error", PosixError) != 0)
+ fatal("can't define posix.error");
+}
--- /dev/null
+/* Stdwin module */
+
+/* Stdwin itself is a module, not a separate object type.
+ Object types defined here:
+ wp: a window
+ dp: a drawing structure (only one can exist at a time)
+ mp: a menu
+ tp: a textedit block
+*/
+
+/* Rules for translating C stdwin function calls into Python stwin:
+ - All names drop their initial letter 'w'
+ - Functions with a window as first parameter are methods of window objects
+ - There is no equivalent for wclose(); just delete the window object
+ (all references to it!) (XXX maybe this is a bad idea)
+ - w.begindrawing() returns a drawing object
+ - There is no equivalent for wenddrawing(win); just delete the drawing
+ object (all references to it!) (XXX maybe this is a bad idea)
+ - Functions that may only be used inside wbegindrawing / wendddrawing
+ are methods of the drawing object; this includes the text measurement
+ functions (which however have doubles as module functions).
+ - Methods of the drawing object drop an initial 'draw' from their name
+ if they have it, e.g., wdrawline() --> d.line()
+ - The obvious type conversions: int --> intobject; string --> stringobject
+ - A text parameter followed by a length parameter is only a text (string)
+ parameter in Python
+ - A point or other pair of horizontal and vertical coordinates is always
+ a pair of integers in Python
+ - Two points forming a rectangle or endpoints of a line segment are a
+ pair of points in Python
+ - The arguments to d.elarc() are three points.
+ - The functions wgetclip() and wsetclip() are translated into
+ stdwin.getcutbuffer() and stdwin.setcutbuffer(); 'clip' is really
+ a bad word for what these functions do (clipping has a different
+ meaning in the drawing world), while cutbuffer is standard X jargon.
+ - For textedit, similar rules hold, but they are less strict.
+ XXX more?
+*/
+
+#include <stdio.h>
+#include "stdwin.h"
+
+#include "PROTO.h"
+#include "object.h"
+#include "intobject.h"
+#include "stringobject.h"
+#include "tupleobject.h"
+#include "dictobject.h"
+#include "methodobject.h"
+#include "moduleobject.h"
+#include "objimpl.h"
+#include "import.h"
+#include "modsupport.h"
+#include "errors.h"
+
+
+/* Window and menu object types declared here because of forward references */
+
+typedef struct {
+ OB_HEAD
+ object *w_title;
+ WINDOW *w_win;
+ object *w_attr; /* Attributes dictionary */
+} windowobject;
+
+extern typeobject Windowtype; /* Really static, forward */
+
+#define is_windowobject(wp) ((wp)->ob_type == &Windowtype)
+
+typedef struct {
+ OB_HEAD
+ MENU *m_menu;
+ int m_id;
+ object *m_attr; /* Attributes dictionary */
+} menuobject;
+
+extern typeobject Menutype; /* Really static, forward */
+
+#define is_menuobject(mp) ((mp)->ob_type == &Menutype)
+
+
+/* Strongly stdwin-specific argument handlers */
+
+static int
+getmousedetail(v, ep)
+ object *v;
+ EVENT *ep;
+{
+ if (v == NULL || !is_tupleobject(v) || gettuplesize(v) != 4)
+ return err_badarg();
+ return getintintarg(gettupleitem(v, 0),
+ &ep->u.where.h, &ep->u.where.v) &&
+ getintarg(gettupleitem(v, 1), &ep->u.where.clicks) &&
+ getintarg(gettupleitem(v, 2), &ep->u.where.button) &&
+ getintarg(gettupleitem(v, 3), &ep->u.where.mask);
+}
+
+static int
+getmenudetail(v, ep)
+ object *v;
+ EVENT *ep;
+{
+ object *mp;
+ if (v == NULL || !is_tupleobject(v) || gettuplesize(v) != 2)
+ return err_badarg();
+ mp = gettupleitem(v, 0);
+ if (mp == NULL || !is_menuobject(mp))
+ return err_badarg();
+ ep->u.m.id = ((menuobject *)mp) -> m_id;
+ return getintarg(gettupleitem(v, 1), &ep->u.m.item);
+}
+
+static int
+geteventarg(v, ep)
+ object *v;
+ EVENT *ep;
+{
+ object *wp, *detail;
+ int a[4];
+ if (v == NULL || !is_tupleobject(v) || gettuplesize(v) != 3)
+ return err_badarg();
+ if (!getintarg(gettupleitem(v, 0), &ep->type))
+ return 0;
+ wp = gettupleitem(v, 1);
+ if (wp == None)
+ ep->window = NULL;
+ else if (wp == NULL || !is_windowobject(wp))
+ return err_badarg();
+ else
+ ep->window = ((windowobject *)wp) -> w_win;
+ detail = gettupleitem(v, 2);
+ switch (ep->type) {
+ case WE_CHAR:
+ if (!is_stringobject(detail) || getstringsize(detail) != 1)
+ return err_badarg();
+ ep->u.character = getstringvalue(detail)[0];
+ return 1;
+ case WE_COMMAND:
+ return getintarg(detail, &ep->u.command);
+ case WE_DRAW:
+ if (!getrectarg(detail, a))
+ return 0;
+ ep->u.area.left = a[0];
+ ep->u.area.top = a[1];
+ ep->u.area.right = a[2];
+ ep->u.area.bottom = a[3];
+ return 1;
+ case WE_MOUSE_DOWN:
+ case WE_MOUSE_UP:
+ case WE_MOUSE_MOVE:
+ return getmousedetail(detail, ep);
+ case WE_MENU:
+ return getmenudetail(detail, ep);
+ default:
+ return 1;
+ }
+}
+
+
+/* Return construction tools */
+
+static object *
+makepoint(a, b)
+ int a, b;
+{
+ object *v;
+ object *w;
+ if ((v = newtupleobject(2)) == NULL)
+ return NULL;
+ if ((w = newintobject((long)a)) == NULL ||
+ settupleitem(v, 0, w) != 0 ||
+ (w = newintobject((long)b)) == NULL ||
+ settupleitem(v, 1, w) != 0) {
+ DECREF(v);
+ return NULL;
+ }
+ return v;
+}
+
+static object *
+makerect(a, b, c, d)
+ int a, b, c, d;
+{
+ object *v;
+ object *w;
+ if ((v = newtupleobject(2)) == NULL)
+ return NULL;
+ if ((w = makepoint(a, b)) == NULL ||
+ settupleitem(v, 0, w) != 0 ||
+ (w = makepoint(c, d)) == NULL ||
+ settupleitem(v, 1, w) != 0) {
+ DECREF(v);
+ return NULL;
+ }
+ return v;
+}
+
+static object *
+makemouse(hor, ver, clicks, button, mask)
+ int hor, ver, clicks, button, mask;
+{
+ object *v;
+ object *w;
+ if ((v = newtupleobject(4)) == NULL)
+ return NULL;
+ if ((w = makepoint(hor, ver)) == NULL ||
+ settupleitem(v, 0, w) != 0 ||
+ (w = newintobject((long)clicks)) == NULL ||
+ settupleitem(v, 1, w) != 0 ||
+ (w = newintobject((long)button)) == NULL ||
+ settupleitem(v, 2, w) != 0 ||
+ (w = newintobject((long)mask)) == NULL ||
+ settupleitem(v, 3, w) != 0) {
+ DECREF(v);
+ return NULL;
+ }
+ return v;
+}
+
+static object *
+makemenu(mp, item)
+ object *mp;
+ int item;
+{
+ object *v;
+ object *w;
+ if ((v = newtupleobject(2)) == NULL)
+ return NULL;
+ INCREF(mp);
+ if (settupleitem(v, 0, mp) != 0 ||
+ (w = newintobject((long)item)) == NULL ||
+ settupleitem(v, 1, w) != 0) {
+ DECREF(v);
+ return NULL;
+ }
+ return v;
+}
+
+
+/* Drawing objects */
+
+typedef struct {
+ OB_HEAD
+ windowobject *d_ref;
+} drawingobject;
+
+static drawingobject *Drawing; /* Set to current drawing object, or NULL */
+
+/* Drawing methods */
+
+static void
+drawing_dealloc(dp)
+ drawingobject *dp;
+{
+ wenddrawing(dp->d_ref->w_win);
+ Drawing = NULL;
+ DECREF(dp->d_ref);
+ free((char *)dp);
+}
+
+static object *
+drawing_generic(dp, args, func)
+ drawingobject *dp;
+ object *args;
+ void (*func) FPROTO((int, int, int, int));
+{
+ int a[4];
+ if (!getrectarg(args, a))
+ return NULL;
+ (*func)(a[0], a[1], a[2], a[3]);
+ INCREF(None);
+ return None;
+}
+
+static object *
+drawing_line(dp, args)
+ drawingobject *dp;
+ object *args;
+{
+ drawing_generic(dp, args, wdrawline);
+}
+
+static object *
+drawing_xorline(dp, args)
+ drawingobject *dp;
+ object *args;
+{
+ drawing_generic(dp, args, wxorline);
+}
+
+static object *
+drawing_circle(dp, args)
+ drawingobject *dp;
+ object *args;
+{
+ int a[3];
+ if (!getpointintarg(args, a))
+ return NULL;
+ wdrawcircle(a[0], a[1], a[2]);
+ INCREF(None);
+ return None;
+}
+
+static object *
+drawing_elarc(dp, args)
+ drawingobject *dp;
+ object *args;
+{
+ int a[6];
+ if (!get3pointarg(args, a))
+ return NULL;
+ wdrawelarc(a[0], a[1], a[2], a[3], a[4], a[5]);
+ INCREF(None);
+ return None;
+}
+
+static object *
+drawing_box(dp, args)
+ drawingobject *dp;
+ object *args;
+{
+ drawing_generic(dp, args, wdrawbox);
+}
+
+static object *
+drawing_erase(dp, args)
+ drawingobject *dp;
+ object *args;
+{
+ drawing_generic(dp, args, werase);
+}
+
+static object *
+drawing_paint(dp, args)
+ drawingobject *dp;
+ object *args;
+{
+ drawing_generic(dp, args, wpaint);
+}
+
+static object *
+drawing_invert(dp, args)
+ drawingobject *dp;
+ object *args;
+{
+ drawing_generic(dp, args, winvert);
+}
+
+static object *
+drawing_cliprect(dp, args)
+ drawingobject *dp;
+ object *args;
+{
+ drawing_generic(dp, args, wcliprect);
+}
+
+static object *
+drawing_noclip(dp, args)
+ drawingobject *dp;
+ object *args;
+{
+ if (!getnoarg(args))
+ return NULL;
+ wnoclip();
+ INCREF(None);
+ return None;
+}
+
+static object *
+drawing_shade(dp, args)
+ drawingobject *dp;
+ object *args;
+{
+ int a[5];
+ if (!getrectintarg(args, a))
+ return NULL;
+ wshade(a[0], a[1], a[2], a[3], a[4]);
+ INCREF(None);
+ return None;
+}
+
+static object *
+drawing_text(dp, args)
+ drawingobject *dp;
+ object *args;
+{
+ int a[2];
+ object *s;
+ if (!getpointstrarg(args, a, &s))
+ return NULL;
+ wdrawtext(a[0], a[1], getstringvalue(s), (int)getstringsize(s));
+ INCREF(None);
+ return None;
+}
+
+/* The following four are also used as stdwin functions */
+
+static object *
+drawing_lineheight(dp, args)
+ drawingobject *dp;
+ object *args;
+{
+ if (!getnoarg(args))
+ return NULL;
+ return newintobject((long)wlineheight());
+}
+
+static object *
+drawing_baseline(dp, args)
+ drawingobject *dp;
+ object *args;
+{
+ if (!getnoarg(args))
+ return NULL;
+ return newintobject((long)wbaseline());
+}
+
+static object *
+drawing_textwidth(dp, args)
+ drawingobject *dp;
+ object *args;
+{
+ object *s;
+ if (!getstrarg(args, &s))
+ return NULL;
+ return newintobject(
+ (long)wtextwidth(getstringvalue(s), (int)getstringsize(s)));
+}
+
+static object *
+drawing_textbreak(dp, args)
+ drawingobject *dp;
+ object *args;
+{
+ object *s;
+ int a;
+ if (!getstrintarg(args, &s, &a))
+ return NULL;
+ return newintobject(
+ (long)wtextbreak(getstringvalue(s), (int)getstringsize(s), a));
+}
+
+static struct methodlist drawing_methods[] = {
+ {"box", drawing_box},
+ {"circle", drawing_circle},
+ {"cliprect", drawing_cliprect},
+ {"elarc", drawing_elarc},
+ {"erase", drawing_erase},
+ {"invert", drawing_invert},
+ {"line", drawing_line},
+ {"noclip", drawing_noclip},
+ {"paint", drawing_paint},
+ {"shade", drawing_shade},
+ {"text", drawing_text},
+ {"xorline", drawing_xorline},
+
+ /* Text measuring methods: */
+ {"baseline", drawing_baseline},
+ {"lineheight", drawing_lineheight},
+ {"textbreak", drawing_textbreak},
+ {"textwidth", drawing_textwidth},
+ {NULL, NULL} /* sentinel */
+};
+
+static object *
+drawing_getattr(wp, name)
+ drawingobject *wp;
+ char *name;
+{
+ return findmethod(drawing_methods, (object *)wp, name);
+}
+
+static typeobject Drawingtype = {
+ OB_HEAD_INIT(&Typetype)
+ 0, /*ob_size*/
+ "drawing", /*tp_name*/
+ sizeof(drawingobject), /*tp_size*/
+ 0, /*tp_itemsize*/
+ /* methods */
+ drawing_dealloc, /*tp_dealloc*/
+ 0, /*tp_print*/
+ drawing_getattr, /*tp_getattr*/
+ 0, /*tp_setattr*/
+ 0, /*tp_compare*/
+ 0, /*tp_repr*/
+};
+
+
+/* Text(edit) objects */
+
+typedef struct {
+ OB_HEAD
+ TEXTEDIT *t_text;
+ windowobject *t_ref;
+ object *t_attr; /* Attributes dictionary */
+} textobject;
+
+extern typeobject Texttype; /* Really static, forward */
+
+static textobject *
+newtextobject(wp, left, top, right, bottom)
+ windowobject *wp;
+ int left, top, right, bottom;
+{
+ textobject *tp;
+ tp = NEWOBJ(textobject, &Texttype);
+ if (tp == NULL)
+ return NULL;
+ tp->t_attr = NULL;
+ INCREF(wp);
+ tp->t_ref = wp;
+ tp->t_text = tecreate(wp->w_win, left, top, right, bottom);
+ if (tp->t_text == NULL) {
+ DECREF(tp);
+ return (textobject *) err_nomem();
+ }
+ return tp;
+}
+
+/* Text(edit) methods */
+
+static void
+text_dealloc(tp)
+ textobject *tp;
+{
+ if (tp->t_text != NULL)
+ tefree(tp->t_text);
+ if (tp->t_attr != NULL)
+ DECREF(tp->t_attr);
+ DECREF(tp->t_ref);
+ DEL(tp);
+}
+
+static object *
+text_arrow(self, args)
+ textobject *self;
+ object *args;
+{
+ int code;
+ if (!getintarg(args, &code))
+ return NULL;
+ tearrow(self->t_text, code);
+ INCREF(None);
+ return None;
+}
+
+static object *
+text_draw(self, args)
+ textobject *self;
+ object *args;
+{
+ register TEXTEDIT *tp = self->t_text;
+ int a[4];
+ int left, top, right, bottom;
+ if (!getrectarg(args, a))
+ return NULL;
+ if (Drawing != NULL) {
+ err_setstr(RuntimeError, "not drawing");
+ return NULL;
+ }
+ /* Clip to text area and ignore if area is empty */
+ left = tegetleft(tp);
+ top = tegettop(tp);
+ right = tegetright(tp);
+ bottom = tegetbottom(tp);
+ if (a[0] < left) a[0] = left;
+ if (a[1] < top) a[1] = top;
+ if (a[2] > right) a[2] = right;
+ if (a[3] > bottom) a[3] = bottom;
+ if (a[0] < a[2] && a[1] < a[3]) {
+ /* Hide/show focus around draw call; these are undocumented,
+ but required here to get the highlighting correct.
+ The call to werase is also required for this reason.
+ Finally, this forces us to require (above) that we are NOT
+ already drawing. */
+ tehidefocus(tp);
+ wbegindrawing(self->t_ref->w_win);
+ werase(a[0], a[1], a[2], a[3]);
+ tedrawnew(tp, a[0], a[1], a[2], a[3]);
+ wenddrawing(self->t_ref->w_win);
+ teshowfocus(tp);
+ }
+ INCREF(None);
+ return None;
+}
+
+static object *
+text_event(self, args)
+ textobject *self;
+ object *args;
+{
+ register TEXTEDIT *tp = self->t_text;
+ EVENT e;
+ if (!geteventarg(args, &e))
+ return NULL;
+ if (e.type == WE_MOUSE_DOWN) {
+ /* Cheat at the left margin */
+ if (e.u.where.h < 0 && tegetleft(tp) == 0)
+ e.u.where.h = 0;
+ /* XXX should also check right margin and bottom,
+ but we have no wgetdocsize() yet */
+ }
+ return newintobject((long) teevent(tp, &e));
+}
+
+static object *
+text_getfocus(self, args)
+ textobject *self;
+ object *args;
+{
+ if (!getnoarg(args))
+ return NULL;
+ return makepoint(tegetfoc1(self->t_text), tegetfoc2(self->t_text));
+}
+
+static object *
+text_getfocustext(self, args)
+ textobject *self;
+ object *args;
+{
+ int f1, f2;
+ char *text;
+ if (!getnoarg(args))
+ return NULL;
+ f1 = tegetfoc1(self->t_text);
+ f2 = tegetfoc2(self->t_text);
+ text = tegettext(self->t_text);
+ return newsizedstringobject(text + f1, f2-f1);
+}
+
+static object *
+text_getrect(self, args)
+ textobject *self;
+ object *args;
+{
+ if (!getnoarg(args))
+ return NULL;
+ return makerect(tegetleft(self->t_text),
+ tegettop(self->t_text),
+ tegetright(self->t_text),
+ tegetbottom(self->t_text));
+}
+
+static object *
+text_gettext(self, args)
+ textobject *self;
+ object *args;
+{
+ if (!getnoarg(args))
+ return NULL;
+ return newsizedstringobject(tegettext(self->t_text),
+ tegetlen(self->t_text));
+}
+
+static object *
+text_move(self, args)
+ textobject *self;
+ object *args;
+{
+ int a[4];
+ if (!getrectarg(args, a))
+ return NULL;
+ temovenew(self->t_text, a[0], a[1], a[2], a[3]);
+ INCREF(None);
+ return None;
+}
+
+static object *
+text_setfocus(self, args)
+ textobject *self;
+ object *args;
+{
+ int a[2];
+ if (!getpointarg(args, a))
+ return NULL;
+ tesetfocus(self->t_text, a[0], a[1]);
+ INCREF(None);
+ return None;
+}
+
+static object *
+text_replace(self, args)
+ textobject *self;
+ object *args;
+{
+ object *text;
+ if (!getstrarg(args, &text))
+ return NULL;
+ tereplace(self->t_text, getstringvalue(text));
+ INCREF(None);
+ return None;
+}
+
+static struct methodlist text_methods[] = {
+ "arrow", text_arrow,
+ "draw", text_draw,
+ "event", text_event,
+ "getfocus", text_getfocus,
+ "getfocustext", text_getfocustext,
+ "getrect", text_getrect,
+ "gettext", text_gettext,
+ "move", text_move,
+ "replace", text_replace,
+ "setfocus", text_setfocus,
+ {NULL, NULL} /* sentinel */
+};
+
+static object *
+text_getattr(tp, name)
+ textobject *tp;
+ char *name;
+{
+ if (tp->t_attr != NULL) {
+ object *v = dictlookup(tp->t_attr, name);
+ if (v != NULL) {
+ INCREF(v);
+ return v;
+ }
+ }
+ return findmethod(text_methods, (object *)tp, name);
+}
+
+static int
+text_setattr(tp, name, v)
+ textobject *tp;
+ char *name;
+ object *v;
+{
+ if (tp->t_attr == NULL) {
+ tp->t_attr = newdictobject();
+ if (tp->t_attr == NULL)
+ return -1;
+ }
+ if (v == NULL)
+ return dictremove(tp->t_attr, name);
+ else
+ return dictinsert(tp->t_attr, name, v);
+}
+
+static typeobject Texttype = {
+ OB_HEAD_INIT(&Typetype)
+ 0, /*ob_size*/
+ "textedit", /*tp_name*/
+ sizeof(textobject), /*tp_size*/
+ 0, /*tp_itemsize*/
+ /* methods */
+ text_dealloc, /*tp_dealloc*/
+ 0, /*tp_print*/
+ text_getattr, /*tp_getattr*/
+ text_setattr, /*tp_setattr*/
+ 0, /*tp_compare*/
+ 0, /*tp_repr*/
+};
+
+
+/* Menu objects */
+
+#define MAXNMENU 50
+static menuobject *menulist[MAXNMENU]; /* Slot 0 unused */
+
+static menuobject *
+newmenuobject(title)
+ object *title;
+{
+ int id;
+ MENU *menu;
+ menuobject *mp;
+ for (id = 1; id < MAXNMENU; id++) {
+ if (menulist[id] == NULL)
+ break;
+ }
+ if (id >= MAXNMENU)
+ return (menuobject *) err_nomem();
+ menu = wmenucreate(id, getstringvalue(title));
+ if (menu == NULL)
+ return (menuobject *) err_nomem();
+ mp = NEWOBJ(menuobject, &Menutype);
+ if (mp != NULL) {
+ mp->m_menu = menu;
+ mp->m_id = id;
+ mp->m_attr = NULL;
+ menulist[id] = mp;
+ }
+ else
+ wmenudelete(menu);
+ return mp;
+}
+
+/* Menu methods */
+
+static void
+menu_dealloc(mp)
+ menuobject *mp;
+{
+
+ int id = mp->m_id;
+ if (id >= 0 && id < MAXNMENU) {
+ menulist[id] = NULL;
+ }
+ wmenudelete(mp->m_menu);
+ if (mp->m_attr != NULL)
+ DECREF(mp->m_attr);
+ DEL(mp);
+}
+
+static object *
+menu_additem(self, args)
+ menuobject *self;
+ object *args;
+{
+ object *text;
+ int shortcut;
+ if (is_tupleobject(args)) {
+ object *v;
+ if (!getstrstrarg(args, &text, &v))
+ return NULL;
+ if (getstringsize(v) != 1) {
+ err_badarg();
+ return NULL;
+ }
+ shortcut = *getstringvalue(v) & 0xff;
+ }
+ else {
+ if (!getstrarg(args, &text))
+ return NULL;
+ shortcut = -1;
+ }
+ wmenuadditem(self->m_menu, getstringvalue(text), shortcut);
+ INCREF(None);
+ return None;
+}
+
+static object *
+menu_setitem(self, args)
+ menuobject *self;
+ object *args;
+{
+ int index;
+ object *text;
+ if (!getintstrarg(args, &index, &text))
+ return NULL;
+ wmenusetitem(self->m_menu, index, getstringvalue(text));
+ INCREF(None);
+ return None;
+}
+
+static object *
+menu_enable(self, args)
+ menuobject *self;
+ object *args;
+{
+ int index;
+ int flag;
+ if (!getintintarg(args, &index, &flag))
+ return NULL;
+ wmenuenable(self->m_menu, index, flag);
+ INCREF(None);
+ return None;
+}
+
+static object *
+menu_check(self, args)
+ menuobject *self;
+ object *args;
+{
+ int index;
+ int flag;
+ if (!getintintarg(args, &index, &flag))
+ return NULL;
+ wmenucheck(self->m_menu, index, flag);
+ INCREF(None);
+ return None;
+}
+
+static struct methodlist menu_methods[] = {
+ "additem", menu_additem,
+ "setitem", menu_setitem,
+ "enable", menu_enable,
+ "check", menu_check,
+ {NULL, NULL} /* sentinel */
+};
+
+static object *
+menu_getattr(mp, name)
+ menuobject *mp;
+ char *name;
+{
+ if (mp->m_attr != NULL) {
+ object *v = dictlookup(mp->m_attr, name);
+ if (v != NULL) {
+ INCREF(v);
+ return v;
+ }
+ }
+ return findmethod(menu_methods, (object *)mp, name);
+}
+
+static int
+menu_setattr(mp, name, v)
+ menuobject *mp;
+ char *name;
+ object *v;
+{
+ if (mp->m_attr == NULL) {
+ mp->m_attr = newdictobject();
+ if (mp->m_attr == NULL)
+ return -1;
+ }
+ if (v == NULL)
+ return dictremove(mp->m_attr, name);
+ else
+ return dictinsert(mp->m_attr, name, v);
+}
+
+static typeobject Menutype = {
+ OB_HEAD_INIT(&Typetype)
+ 0, /*ob_size*/
+ "menu", /*tp_name*/
+ sizeof(menuobject), /*tp_size*/
+ 0, /*tp_itemsize*/
+ /* methods */
+ menu_dealloc, /*tp_dealloc*/
+ 0, /*tp_print*/
+ menu_getattr, /*tp_getattr*/
+ menu_setattr, /*tp_setattr*/
+ 0, /*tp_compare*/
+ 0, /*tp_repr*/
+};
+
+
+/* Windows */
+
+#define MAXNWIN 50
+static windowobject *windowlist[MAXNWIN];
+
+/* Window methods */
+
+static void
+window_dealloc(wp)
+ windowobject *wp;
+{
+ if (wp->w_win != NULL) {
+ int tag = wgettag(wp->w_win);
+ if (tag >= 0 && tag < MAXNWIN)
+ windowlist[tag] = NULL;
+ else
+ fprintf(stderr, "XXX help! tag %d in window_dealloc\n",
+ tag);
+ wclose(wp->w_win);
+ }
+ DECREF(wp->w_title);
+ if (wp->w_attr != NULL)
+ DECREF(wp->w_attr);
+ free((char *)wp);
+}
+
+static void
+window_print(wp, fp, flags)
+ windowobject *wp;
+ FILE *fp;
+ int flags;
+{
+ fprintf(fp, "<window titled '%s'>", getstringvalue(wp->w_title));
+}
+
+static object *
+window_begindrawing(wp, args)
+ windowobject *wp;
+ object *args;
+{
+ drawingobject *dp;
+ if (!getnoarg(args))
+ return NULL;
+ if (Drawing != NULL) {
+ err_setstr(RuntimeError, "already drawing");
+ return NULL;
+ }
+ dp = NEWOBJ(drawingobject, &Drawingtype);
+ if (dp == NULL)
+ return NULL;
+ Drawing = dp;
+ INCREF(wp);
+ dp->d_ref = wp;
+ wbegindrawing(wp->w_win);
+ return (object *)dp;
+}
+
+static object *
+window_change(wp, args)
+ windowobject *wp;
+ object *args;
+{
+ int a[4];
+ if (!getrectarg(args, a))
+ return NULL;
+ wchange(wp->w_win, a[0], a[1], a[2], a[3]);
+ INCREF(None);
+ return None;
+}
+
+static object *
+window_gettitle(wp, args)
+ windowobject *wp;
+ object *args;
+{
+ if (!getnoarg(args))
+ return NULL;
+ INCREF(wp->w_title);
+ return wp->w_title;
+}
+
+static object *
+window_getwinsize(wp, args)
+ windowobject *wp;
+ object *args;
+{
+ int width, height;
+ if (!getnoarg(args))
+ return NULL;
+ wgetwinsize(wp->w_win, &width, &height);
+ return makepoint(width, height);
+}
+
+static object *
+window_getdocsize(wp, args)
+ windowobject *wp;
+ object *args;
+{
+ int width, height;
+ if (!getnoarg(args))
+ return NULL;
+ wgetdocsize(wp->w_win, &width, &height);
+ return makepoint(width, height);
+}
+
+static object *
+window_getorigin(wp, args)
+ windowobject *wp;
+ object *args;
+{
+ int width, height;
+ if (!getnoarg(args))
+ return NULL;
+ wgetorigin(wp->w_win, &width, &height);
+ return makepoint(width, height);
+}
+
+static object *
+window_scroll(wp, args)
+ windowobject *wp;
+ object *args;
+{
+ int a[6];
+ if (!getrectpointarg(args, a))
+ return NULL;
+ wscroll(wp->w_win, a[0], a[1], a[2], a[3], a[4], a[5]);
+ INCREF(None);
+ return None;
+}
+
+static object *
+window_setdocsize(wp, args)
+ windowobject *wp;
+ object *args;
+{
+ int a[2];
+ if (!getpointarg(args, a))
+ return NULL;
+ wsetdocsize(wp->w_win, a[0], a[1]);
+ INCREF(None);
+ return None;
+}
+
+static object *
+window_setorigin(wp, args)
+ windowobject *wp;
+ object *args;
+{
+ int a[2];
+ if (!getpointarg(args, a))
+ return NULL;
+ wsetorigin(wp->w_win, a[0], a[1]);
+ INCREF(None);
+ return None;
+}
+
+static object *
+window_settitle(wp, args)
+ windowobject *wp;
+ object *args;
+{
+ object *title;
+ if (!getstrarg(args, &title))
+ return NULL;
+ DECREF(wp->w_title);
+ INCREF(title);
+ wp->w_title = title;
+ wsettitle(wp->w_win, getstringvalue(title));
+ INCREF(None);
+ return None;
+}
+
+static object *
+window_show(wp, args)
+ windowobject *wp;
+ object *args;
+{
+ int a[4];
+ if (!getrectarg(args, a))
+ return NULL;
+ wshow(wp->w_win, a[0], a[1], a[2], a[3]);
+ INCREF(None);
+ return None;
+}
+
+static object *
+window_settimer(wp, args)
+ windowobject *wp;
+ object *args;
+{
+ int a;
+ if (!getintarg(args, &a))
+ return NULL;
+ wsettimer(wp->w_win, a);
+ INCREF(None);
+ return None;
+}
+
+static object *
+window_menucreate(self, args)
+ windowobject *self;
+ object *args;
+{
+ menuobject *mp;
+ object *title;
+ if (!getstrarg(args, &title))
+ return NULL;
+ wmenusetdeflocal(1);
+ mp = newmenuobject(title);
+ if (mp == NULL)
+ return NULL;
+ wmenuattach(self->w_win, mp->m_menu);
+ return (object *)mp;
+}
+
+static object *
+window_textcreate(self, args)
+ windowobject *self;
+ object *args;
+{
+ textobject *tp;
+ int a[4];
+ if (!getrectarg(args, a))
+ return NULL;
+ return (object *)
+ newtextobject(self, a[0], a[1], a[2], a[3]);
+}
+
+static struct methodlist window_methods[] = {
+ {"begindrawing",window_begindrawing},
+ {"change", window_change},
+ {"getdocsize", window_getdocsize},
+ {"getorigin", window_getorigin},
+ {"gettitle", window_gettitle},
+ {"getwinsize", window_getwinsize},
+ {"menucreate", window_menucreate},
+ {"scroll", window_scroll},
+ {"setdocsize", window_setdocsize},
+ {"setorigin", window_setorigin},
+ {"settimer", window_settimer},
+ {"settitle", window_settitle},
+ {"show", window_show},
+ {"textcreate", window_textcreate},
+ {NULL, NULL} /* sentinel */
+};
+
+static object *
+window_getattr(wp, name)
+ windowobject *wp;
+ char *name;
+{
+ if (wp->w_attr != NULL) {
+ object *v = dictlookup(wp->w_attr, name);
+ if (v != NULL) {
+ INCREF(v);
+ return v;
+ }
+ }
+ return findmethod(window_methods, (object *)wp, name);
+}
+
+static int
+window_setattr(wp, name, v)
+ windowobject *wp;
+ char *name;
+ object *v;
+{
+ if (wp->w_attr == NULL) {
+ wp->w_attr = newdictobject();
+ if (wp->w_attr == NULL)
+ return -1;
+ }
+ if (v == NULL)
+ return dictremove(wp->w_attr, name);
+ else
+ return dictinsert(wp->w_attr, name, v);
+}
+
+static typeobject Windowtype = {
+ OB_HEAD_INIT(&Typetype)
+ 0, /*ob_size*/
+ "window", /*tp_name*/
+ sizeof(windowobject), /*tp_size*/
+ 0, /*tp_itemsize*/
+ /* methods */
+ window_dealloc, /*tp_dealloc*/
+ window_print, /*tp_print*/
+ window_getattr, /*tp_getattr*/
+ window_setattr, /*tp_setattr*/
+ 0, /*tp_compare*/
+ 0, /*tp_repr*/
+};
+
+/* Stdwin methods */
+
+static object *
+stdwin_open(sw, args)
+ object *sw;
+ object *args;
+{
+ int tag;
+ object *title;
+ windowobject *wp;
+ if (!getstrarg(args, &title))
+ return NULL;
+ for (tag = 0; tag < MAXNWIN; tag++) {
+ if (windowlist[tag] == NULL)
+ break;
+ }
+ if (tag >= MAXNWIN)
+ return err_nomem();
+ wp = NEWOBJ(windowobject, &Windowtype);
+ if (wp == NULL)
+ return NULL;
+ INCREF(title);
+ wp->w_title = title;
+ wp->w_win = wopen(getstringvalue(title), (void (*)()) NULL);
+ wp->w_attr = NULL;
+ if (wp->w_win == NULL) {
+ DECREF(wp);
+ return NULL;
+ }
+ windowlist[tag] = wp;
+ wsettag(wp->w_win, tag);
+ return (object *)wp;
+}
+
+static object *
+stdwin_getevent(sw, args)
+ object *sw;
+ object *args;
+{
+ EVENT e;
+ object *v, *w;
+ if (!getnoarg(args))
+ return NULL;
+ if (Drawing != NULL) {
+ err_setstr(RuntimeError, "cannot getevent() while drawing");
+ return NULL;
+ }
+ again:
+ wgetevent(&e);
+ if (e.type == WE_COMMAND && e.u.command == WC_CANCEL) {
+ /* Turn keyboard interrupts into exceptions */
+ err_set(KeyboardInterrupt);
+ return NULL;
+ }
+ if (e.window == NULL && (e.type == WE_COMMAND || e.type == WE_CHAR))
+ goto again;
+ v = newtupleobject(3);
+ if (v == NULL)
+ return NULL;
+ if ((w = newintobject((long)e.type)) == NULL) {
+ DECREF(v);
+ return NULL;
+ }
+ settupleitem(v, 0, w);
+ if (e.window == NULL)
+ w = None;
+ else {
+ int tag = wgettag(e.window);
+ if (tag < 0 || tag >= MAXNWIN || windowlist[tag] == NULL)
+ w = None;
+ else
+ w = (object *)windowlist[tag];
+ }
+if ((long)w == (long)0x80000001) {
+err_setstr(SystemError, "bad pointer in stdwin.getevent()");
+return NULL;
+}
+ INCREF(w);
+ settupleitem(v, 1, w);
+ switch (e.type) {
+ case WE_CHAR:
+ {
+ char c[1];
+ c[0] = e.u.character;
+ w = newsizedstringobject(c, 1);
+ }
+ break;
+ case WE_COMMAND:
+ w = newintobject((long)e.u.command);
+ break;
+ case WE_DRAW:
+ w = makerect(e.u.area.left, e.u.area.top,
+ e.u.area.right, e.u.area.bottom);
+ break;
+ case WE_MOUSE_DOWN:
+ case WE_MOUSE_MOVE:
+ case WE_MOUSE_UP:
+ w = makemouse(e.u.where.h, e.u.where.v,
+ e.u.where.clicks,
+ e.u.where.button,
+ e.u.where.mask);
+ break;
+ case WE_MENU:
+ if (e.u.m.id >= 0 && e.u.m.id < MAXNMENU &&
+ menulist[e.u.m.id] != NULL)
+ w = (object *)menulist[e.u.m.id];
+ else
+ w = None;
+ w = makemenu(w, e.u.m.item);
+ break;
+ default:
+ w = None;
+ INCREF(w);
+ break;
+ }
+ if (w == NULL) {
+ DECREF(v);
+ return NULL;
+ }
+ settupleitem(v, 2, w);
+ return v;
+}
+
+static object *
+stdwin_setdefwinpos(sw, args)
+ object *sw;
+ object *args;
+{
+ int a[2];
+ if (!getpointarg(args, a))
+ return NULL;
+ wsetdefwinpos(a[0], a[1]);
+ INCREF(None);
+ return None;
+}
+
+static object *
+stdwin_setdefwinsize(sw, args)
+ object *sw;
+ object *args;
+{
+ int a[2];
+ if (!getpointarg(args, a))
+ return NULL;
+ wsetdefwinsize(a[0], a[1]);
+ INCREF(None);
+ return None;
+}
+
+static object *
+stdwin_menucreate(self, args)
+ object *self;
+ object *args;
+{
+ object *title;
+ if (!getstrarg(args, &title))
+ return NULL;
+ wmenusetdeflocal(0);
+ return (object *)newmenuobject(title);
+}
+
+static object *
+stdwin_askfile(self, args)
+ object *self;
+ object *args;
+{
+ object *prompt, *dflt;
+ int new, ret;
+ char buf[256];
+ if (!getstrstrintarg(args, &prompt, &dflt, &new))
+ return NULL;
+ strncpy(buf, getstringvalue(dflt), sizeof buf);
+ buf[sizeof buf - 1] = '\0';
+ ret = waskfile(getstringvalue(prompt), buf, sizeof buf, new);
+ if (!ret) {
+ err_set(KeyboardInterrupt);
+ return NULL;
+ }
+ return newstringobject(buf);
+}
+
+static object *
+stdwin_askync(self, args)
+ object *self;
+ object *args;
+{
+ object *prompt;
+ int new, ret;
+ if (!getstrintarg(args, &prompt, &new))
+ return NULL;
+ ret = waskync(getstringvalue(prompt), new);
+ if (ret < 0) {
+ err_set(KeyboardInterrupt);
+ return NULL;
+ }
+ return newintobject((long)ret);
+}
+
+static object *
+stdwin_askstr(self, args)
+ object *self;
+ object *args;
+{
+ object *prompt, *dflt;
+ int ret;
+ char buf[256];
+ if (!getstrstrarg(args, &prompt, &dflt))
+ return NULL;
+ strncpy(buf, getstringvalue(dflt), sizeof buf);
+ buf[sizeof buf - 1] = '\0';
+ ret = waskstr(getstringvalue(prompt), buf, sizeof buf);
+ if (!ret) {
+ err_set(KeyboardInterrupt);
+ return NULL;
+ }
+ return newstringobject(buf);
+}
+
+static object *
+stdwin_message(self, args)
+ object *self;
+ object *args;
+{
+ object *msg;
+ if (!getstrarg(args, &msg))
+ return NULL;
+ wmessage(getstringvalue(msg));
+ INCREF(None);
+ return None;
+}
+
+static object *
+stdwin_fleep(self, args)
+ object *self;
+ object *args;
+{
+ if (!getnoarg(args))
+ return NULL;
+ wfleep();
+ INCREF(None);
+ return None;
+}
+
+static object *
+stdwin_setcutbuffer(self, args)
+ object *self;
+ object *args;
+{
+ object *str;
+ if (!getstrarg(args, &str))
+ return NULL;
+ wsetclip(getstringvalue(str), getstringsize(str));
+ INCREF(None);
+ return None;
+}
+
+static object *
+stdwin_getcutbuffer(self, args)
+ object *self;
+ object *args;
+{
+ char *str;
+ if (!getnoarg(args))
+ return NULL;
+ str = wgetclip();
+ if (str == NULL)
+ str = "";
+ return newstringobject(str);
+}
+
+static struct methodlist stdwin_methods[] = {
+ {"askfile", stdwin_askfile},
+ {"askstr", stdwin_askstr},
+ {"askync", stdwin_askync},
+ {"fleep", stdwin_fleep},
+ {"getcutbuffer", stdwin_getcutbuffer},
+ {"getevent", stdwin_getevent},
+ {"menucreate", stdwin_menucreate},
+ {"message", stdwin_message},
+ {"open", stdwin_open},
+ {"setcutbuffer", stdwin_setcutbuffer},
+ {"setdefwinpos", stdwin_setdefwinpos},
+ {"setdefwinsize", stdwin_setdefwinsize},
+
+ /* Text measuring methods borrow code from drawing objects: */
+ {"baseline", drawing_baseline},
+ {"lineheight", drawing_lineheight},
+ {"textbreak", drawing_textbreak},
+ {"textwidth", drawing_textwidth},
+ {NULL, NULL} /* sentinel */
+};
+
+void
+initstdwin()
+{
+ initmodule("stdwin", stdwin_methods);
+}
--- /dev/null
+/* Time module */
+
+#include <stdio.h>
+#include <signal.h>
+#include <setjmp.h>
+
+#ifdef __STDC__
+#include <time.h>
+#else /* !__STDC__ */
+typedef unsigned long time_t;
+extern time_t time();
+#endif /* !__STDC__ */
+
+#include "PROTO.h"
+#include "object.h"
+#include "intobject.h"
+#include "dictobject.h"
+#include "methodobject.h"
+#include "moduleobject.h"
+#include "objimpl.h"
+#include "import.h"
+#include "sigtype.h"
+#include "modsupport.h"
+#include "errors.h"
+
+
+/* Time methods */
+
+static object *
+time_time(self, args)
+ object *self;
+ object *args;
+{
+ long secs;
+ if (!getnoarg(args))
+ return NULL;
+ secs = time((time_t *)NULL);
+ return newintobject(secs);
+}
+
+static jmp_buf sleep_intr;
+
+static void
+sleep_catcher(sig)
+ int sig;
+{
+ longjmp(sleep_intr, 1);
+}
+
+static object *
+time_sleep(self, args)
+ object *self;
+ object *args;
+{
+ int secs;
+ SIGTYPE (*sigsave)();
+ if (!getintarg(args, &secs))
+ return NULL;
+ if (setjmp(sleep_intr)) {
+ signal(SIGINT, sigsave);
+ err_set(KeyboardInterrupt);
+ return NULL;
+ }
+ sigsave = signal(SIGINT, SIG_IGN);
+ if (sigsave != (SIGTYPE (*)()) SIG_IGN)
+ signal(SIGINT, sleep_catcher);
+ sleep(secs);
+ signal(SIGINT, sigsave);
+ INCREF(None);
+ return None;
+}
+
+#ifdef THINK_C
+#define DO_MILLI
+#endif /* THINK_C */
+
+#ifdef AMOEBA
+#define DO_MILLI
+extern long sys_milli();
+#define millitimer sys_milli
+#endif /* AMOEBA */
+
+#ifdef DO_MILLI
+
+static object *
+time_millisleep(self, args)
+ object *self;
+ object *args;
+{
+ long msecs;
+ SIGTYPE (*sigsave)();
+ if (!getlongarg(args, &msecs))
+ return NULL;
+ if (setjmp(sleep_intr)) {
+ signal(SIGINT, sigsave);
+ err_set(KeyboardInterrupt);
+ return NULL;
+ }
+ sigsave = signal(SIGINT, SIG_IGN);
+ if (sigsave != (SIGTYPE (*)()) SIG_IGN)
+ signal(SIGINT, sleep_catcher);
+ millisleep(msecs);
+ signal(SIGINT, sigsave);
+ INCREF(None);
+ return None;
+}
+
+static object *
+time_millitimer(self, args)
+ object *self;
+ object *args;
+{
+ long msecs;
+ extern long millitimer();
+ if (!getnoarg(args))
+ return NULL;
+ msecs = millitimer();
+ return newintobject(msecs);
+}
+
+#endif /* DO_MILLI */
+
+
+static struct methodlist time_methods[] = {
+#ifdef DO_MILLI
+ {"millisleep", time_millisleep},
+ {"millitimer", time_millitimer},
+#endif /* DO_MILLI */
+ {"sleep", time_sleep},
+ {"time", time_time},
+ {NULL, NULL} /* sentinel */
+};
+
+
+void
+inittime()
+{
+ initmodule("time", time_methods);
+}
+
+
+#ifdef THINK_C
+
+#define MacTicks (* (long *)0x16A)
+
+static
+sleep(msecs)
+ int msecs;
+{
+ register long deadline;
+
+ deadline = MacTicks + msecs * 60;
+ while (MacTicks < deadline) {
+ if (intrcheck())
+ sleep_catcher(SIGINT);
+ }
+}
+
+static
+millisleep(msecs)
+ long msecs;
+{
+ register long deadline;
+
+ deadline = MacTicks + msecs * 3 / 50; /* msecs * 60 / 1000 */
+ while (MacTicks < deadline) {
+ if (intrcheck())
+ sleep_catcher(SIGINT);
+ }
+}
+
+static long
+millitimer()
+{
+ return MacTicks * 50 / 3; /* MacTicks * 1000 / 60 */
+}
+
+#endif /* THINK_C */
--- /dev/null
+/* Class object implementation */
+
+#include <stdio.h>
+
+#include "PROTO.h"
+#include "node.h"
+#include "object.h"
+#include "stringobject.h"
+#include "tupleobject.h"
+#include "dictobject.h"
+#include "funcobject.h"
+#include "classobject.h"
+#include "objimpl.h"
+
+typedef struct {
+ OB_HEAD
+ node *cl_tree; /* The entire classdef parse tree */
+ object *cl_bases; /* A tuple */
+ object *cl_methods; /* A dictionary */
+} classobject;
+
+object *
+newclassobject(tree, bases, methods)
+ node *tree;
+ object *bases; /* NULL or tuple of classobjects! */
+ object *methods;
+{
+ classobject *op;
+ op = NEWOBJ(classobject, &Classtype);
+ if (op == NULL)
+ return NULL;
+ op->cl_tree = tree;
+ if (bases != NULL)
+ INCREF(bases);
+ op->cl_bases = bases;
+ INCREF(methods);
+ op->cl_methods = methods;
+ return (object *) op;
+}
+
+/* Class methods */
+
+static void
+class_dealloc(op)
+ classobject *op;
+{
+ int i;
+ if (op->cl_bases != NULL)
+ DECREF(op->cl_bases);
+ DECREF(op->cl_methods);
+ free((ANY *)op);
+}
+
+static object *
+class_getattr(op, name)
+ register classobject *op;
+ register char *name;
+{
+ register object *v;
+ v = dictlookup(op->cl_methods, name);
+ if (v != NULL) {
+ INCREF(v);
+ return v;
+ }
+ if (op->cl_bases != NULL) {
+ int n = gettuplesize(op->cl_bases);
+ int i;
+ for (i = 0; i < n; i++) {
+ v = class_getattr(gettupleitem(op->cl_bases, i), name);
+ if (v != NULL)
+ return v;
+ }
+ }
+ errno = ESRCH;
+ return NULL;
+}
+
+typeobject Classtype = {
+ OB_HEAD_INIT(&Typetype)
+ 0,
+ "class",
+ sizeof(classobject),
+ 0,
+ class_dealloc, /*tp_dealloc*/
+ 0, /*tp_print*/
+ class_getattr, /*tp_getattr*/
+ 0, /*tp_setattr*/
+ 0, /*tp_compare*/
+ 0, /*tp_repr*/
+ 0, /*tp_as_number*/
+ 0, /*tp_as_sequence*/
+ 0, /*tp_as_mapping*/
+};
+
+
+/* We're not done yet: next, we define class member objects... */
+
+typedef struct {
+ OB_HEAD
+ classobject *cm_class; /* The class object */
+ object *cm_attr; /* A dictionary */
+} classmemberobject;
+
+object *
+newclassmemberobject(class)
+ register object *class;
+{
+ register classmemberobject *cm;
+ if (!is_classobject(class)) {
+ errno = EINVAL;
+ return NULL;
+ }
+ cm = NEWOBJ(classmemberobject, &Classmembertype);
+ if (cm == NULL)
+ return NULL;
+ INCREF(class);
+ cm->cm_class = (classobject *)class;
+ cm->cm_attr = newdictobject();
+ if (cm->cm_attr == NULL) {
+ DECREF(cm);
+ return NULL;
+ }
+ return (object *)cm;
+}
+
+/* Class member methods */
+
+static void
+classmember_dealloc(cm)
+ register classmemberobject *cm;
+{
+ DECREF(cm->cm_class);
+ if (cm->cm_attr != NULL)
+ DECREF(cm->cm_attr);
+ free((ANY *)cm);
+}
+
+static object *
+classmember_getattr(cm, name)
+ register classmemberobject *cm;
+ register char *name;
+{
+ register object *v = dictlookup(cm->cm_attr, name);
+ if (v != NULL) {
+ INCREF(v);
+ return v;
+ }
+ v = class_getattr(cm->cm_class, name);
+ if (v == NULL)
+ return v; /* class_getattr() has set errno */
+ if (is_funcobject(v)) {
+ object *w = newclassmethodobject(v, (object *)cm);
+ DECREF(v);
+ return w;
+ }
+ DECREF(v);
+ errno = ESRCH;
+ return NULL;
+}
+
+static int
+classmember_setattr(cm, name, v)
+ classmemberobject *cm;
+ char *name;
+ object *v;
+{
+ if (v == NULL)
+ return dictremove(cm->cm_attr, name);
+ else
+ return dictinsert(cm->cm_attr, name, v);
+}
+
+typeobject Classmembertype = {
+ OB_HEAD_INIT(&Typetype)
+ 0,
+ "class member",
+ sizeof(classmemberobject),
+ 0,
+ classmember_dealloc, /*tp_dealloc*/
+ 0, /*tp_print*/
+ classmember_getattr, /*tp_getattr*/
+ classmember_setattr, /*tp_setattr*/
+ 0, /*tp_compare*/
+ 0, /*tp_repr*/
+ 0, /*tp_as_number*/
+ 0, /*tp_as_sequence*/
+ 0, /*tp_as_mapping*/
+};
+
+
+/* And finally, here are class method objects */
+/* (Really methods of class members) */
+
+typedef struct {
+ OB_HEAD
+ object *cm_func; /* The method function */
+ object *cm_self; /* The object to which this applies */
+} classmethodobject;
+
+object *
+newclassmethodobject(func, self)
+ object *func;
+ object *self;
+{
+ register classmethodobject *cm;
+ if (!is_funcobject(func)) {
+ errno = EINVAL;
+ return NULL;
+ }
+ cm = NEWOBJ(classmethodobject, &Classmethodtype);
+ if (cm == NULL)
+ return NULL;
+ INCREF(func);
+ cm->cm_func = func;
+ INCREF(self);
+ cm->cm_self = self;
+ return (object *)cm;
+}
+
+object *
+classmethodgetfunc(cm)
+ register object *cm;
+{
+ if (!is_classmethodobject(cm)) {
+ errno = EINVAL;
+ return NULL;
+ }
+ return ((classmethodobject *)cm)->cm_func;
+}
+
+object *
+classmethodgetself(cm)
+ register object *cm;
+{
+ if (!is_classmethodobject(cm)) {
+ errno = EINVAL;
+ return NULL;
+ }
+ return ((classmethodobject *)cm)->cm_self;
+}
+
+/* Class method methods */
+
+static void
+classmethod_dealloc(cm)
+ register classmethodobject *cm;
+{
+ DECREF(cm->cm_func);
+ DECREF(cm->cm_self);
+ free((ANY *)cm);
+}
+
+typeobject Classmethodtype = {
+ OB_HEAD_INIT(&Typetype)
+ 0,
+ "class method",
+ sizeof(classmethodobject),
+ 0,
+ classmethod_dealloc, /*tp_dealloc*/
+ 0, /*tp_print*/
+ 0, /*tp_getattr*/
+ 0, /*tp_setattr*/
+ 0, /*tp_compare*/
+ 0, /*tp_repr*/
+ 0, /*tp_as_number*/
+ 0, /*tp_as_sequence*/
+ 0, /*tp_as_mapping*/
+};
--- /dev/null
+/* File object implementation */
+
+#include <stdio.h>
+
+#include "PROTO.h"
+#include "object.h"
+#include "stringobject.h"
+#include "intobject.h"
+#include "fileobject.h"
+#include "methodobject.h"
+#include "objimpl.h"
+
+typedef struct {
+ OB_HEAD
+ FILE *f_fp;
+ object *f_name;
+ object *f_mode;
+ /* XXX Should move the 'need space' on printing flag here */
+} fileobject;
+
+FILE *
+getfilefile(f)
+ object *f;
+{
+ if (!is_fileobject(f)) {
+ errno = EBADF;
+ return NULL;
+ }
+ return ((fileobject *)f)->f_fp;
+}
+
+object *
+newopenfileobject(fp, name, mode)
+ FILE *fp;
+ char *name;
+ char *mode;
+{
+ fileobject *f = NEWOBJ(fileobject, &Filetype);
+ if (f == NULL)
+ return NULL;
+ f->f_fp = NULL;
+ f->f_name = newstringobject(name);
+ f->f_mode = newstringobject(mode);
+ if (f->f_name == NULL || f->f_mode == NULL) {
+ DECREF(f);
+ errno = ENOMEM;
+ return NULL;
+ }
+ f->f_fp = fp;
+ return (object *) f;
+}
+
+object *
+newfileobject(name, mode)
+ char *name, *mode;
+{
+ fileobject *f;
+ FILE *fp;
+ f = (fileobject *) newopenfileobject((FILE *)NULL, name, mode);
+ if (f == NULL)
+ return NULL;
+ if ((f->f_fp = fopen(name, mode)) == NULL) {
+ DECREF(f);
+ return NULL;
+ }
+ return (object *)f;
+}
+
+/* Methods */
+
+static void
+filedealloc(f)
+ fileobject *f;
+{
+ if (f->f_fp != NULL)
+ fclose(f->f_fp);
+ if (f->f_name != NULL)
+ DECREF(f->f_name);
+ if (f->f_mode != NULL)
+ DECREF(f->f_mode);
+ free((char *)f);
+}
+
+static void
+fileprint(f, fp, flags)
+ fileobject *f;
+ FILE *fp;
+ int flags;
+{
+ fprintf(fp, "<%s file ", f->f_fp == NULL ? "closed" : "open");
+ printobject(f->f_name, fp, flags);
+ fprintf(fp, ", mode ");
+ printobject(f->f_mode, fp, flags);
+ fprintf(fp, ">");
+}
+
+static object *
+filerepr(f)
+ fileobject *f;
+{
+ char buf[300];
+ /* XXX This differs from fileprint if the filename contains
+ quotes or other funny characters. */
+ sprintf(buf, "<%s file '%.256s', mode '%.10s'>",
+ f->f_fp == NULL ? "closed" : "open",
+ getstringvalue(f->f_name),
+ getstringvalue(f->f_mode));
+ return newstringobject(buf);
+}
+
+static object *
+fileclose(f, args)
+ fileobject *f;
+ object *args;
+{
+ if (args != NULL) {
+ errno = EINVAL;
+ return NULL;
+ }
+ if (f->f_fp != NULL) {
+ fclose(f->f_fp);
+ f->f_fp = NULL;
+ }
+ INCREF(None);
+ return None;
+}
+
+static object *
+fileread(f, args)
+ fileobject *f;
+ object *args;
+{
+ int n;
+ object *v;
+ if (f->f_fp == NULL) {
+ errno = EBADF;
+ return NULL;
+ }
+ if (args == NULL || !is_intobject(args)) {
+ errno = EINVAL;
+ return NULL;
+ }
+ n = getintvalue(args);
+ if (n <= 0 /* || n > 0x7fff /*XXX*/ ) {
+ errno = EDOM;
+ return NULL;
+ }
+ v = newsizedstringobject((char *)NULL, n);
+ if (v == NULL) {
+ errno = ENOMEM;
+ return NULL;
+ }
+ n = fread(getstringvalue(v), 1, n, f->f_fp);
+ /* EOF is reported as an empty string */
+ /* XXX should detect real I/O errors? */
+ resizestring(&v, n);
+ return v;
+}
+
+/* XXX Should this be unified with raw_input()? */
+
+static object *
+filereadline(f, args)
+ fileobject *f;
+ object *args;
+{
+ int n;
+ object *v;
+ if (f->f_fp == NULL) {
+ errno = EBADF;
+ return NULL;
+ }
+ if (args == NULL) {
+ n = 10000; /* XXX should really be unlimited */
+ }
+ else if (is_intobject(args)) {
+ n = getintvalue(args);
+ if (n < 0 || n > 0x7fff /*XXX*/ ) {
+ errno = EDOM;
+ return NULL;
+ }
+ }
+ else {
+ errno = EINVAL;
+ return NULL;
+ }
+ v = newsizedstringobject((char *)NULL, n);
+ if (v == NULL) {
+ errno = ENOMEM;
+ return NULL;
+ }
+ if (fgets(getstringvalue(v), n+1, f->f_fp) == NULL) {
+ /* EOF is reported as an empty string */
+ /* XXX should detect real I/O errors? */
+ n = 0;
+ }
+ else {
+ n = strlen(getstringvalue(v));
+ }
+ resizestring(&v, n);
+ return v;
+}
+
+static object *
+filewrite(f, args)
+ fileobject *f;
+ object *args;
+{
+ int n, n2;
+ if (f->f_fp == NULL) {
+ errno = EBADF;
+ return NULL;
+ }
+ if (args == NULL || !is_stringobject(args)) {
+ errno = EINVAL;
+ return NULL;
+ }
+ errno = 0;
+ n2 = fwrite(getstringvalue(args), 1, n = getstringsize(args), f->f_fp);
+ if (n2 != n) {
+ if (errno == 0)
+ errno = EIO;
+ return NULL;
+ }
+ INCREF(None);
+ return None;
+}
+
+static struct methodlist {
+ char *ml_name;
+ method ml_meth;
+} filemethods[] = {
+ {"write", filewrite},
+ {"read", fileread},
+ {"readline", filereadline},
+ {"close", fileclose},
+ {NULL, NULL} /* sentinel */
+};
+
+static object *
+filegetattr(f, name)
+ fileobject *f;
+ char *name;
+{
+ struct methodlist *ml = filemethods;
+ for (; ml->ml_name != NULL; ml++) {
+ if (strcmp(name, ml->ml_name) == 0)
+ return newmethodobject(ml->ml_name, ml->ml_meth,
+ (object *)f);
+ }
+ errno = ESRCH;
+ return NULL;
+}
+
+typeobject Filetype = {
+ OB_HEAD_INIT(&Typetype)
+ 0,
+ "file",
+ sizeof(fileobject),
+ 0,
+ filedealloc, /*tp_dealloc*/
+ fileprint, /*tp_print*/
+ filegetattr, /*tp_getattr*/
+ 0, /*tp_setattr*/
+ 0, /*tp_compare*/
+ filerepr, /*tp_repr*/
+};
--- /dev/null
+/* Float object implementation */
+
+#include <stdio.h>
+#include <math.h>
+#include <ctype.h>
+
+#include "PROTO.h"
+#include "object.h"
+#include "floatobject.h"
+#include "stringobject.h"
+#include "objimpl.h"
+
+object *
+newfloatobject(fval)
+ double fval;
+{
+ /* For efficiency, this code is copied from newobject() */
+ register floatobject *op = (floatobject *) malloc(sizeof(floatobject));
+ if (op == NULL) {
+ errno = ENOMEM;
+ }
+ else {
+ NEWREF(op);
+ op->ob_type = &Floattype;
+ op->ob_fval = fval;
+ }
+ return (object *) op;
+}
+
+double
+getfloatvalue(op)
+ object *op;
+{
+ if (!is_floatobject(op)) {
+ errno = EBADF;
+ return -1;
+ }
+ else
+ return ((floatobject *)op) -> ob_fval;
+}
+
+/* Methods */
+
+static void
+float_buf_repr(buf, v)
+ char *buf;
+ floatobject *v;
+{
+ register char *cp;
+ /* Subroutine for float_repr and float_print.
+ We want float numbers to be recognizable as such,
+ i.e., they should contain a decimal point or an exponent.
+ However, %g may print the number as an integer;
+ in such cases, we append ".0" to the string. */
+ sprintf(buf, "%.12g", v->ob_fval);
+ cp = buf;
+ if (*cp == '-')
+ cp++;
+ for (; *cp != '\0'; cp++) {
+ /* Any non-digit means it's not an integer;
+ this takes care of NAN and INF as well. */
+ if (!isdigit(*cp))
+ break;
+ }
+ if (*cp == '\0') {
+ *cp++ = '.';
+ *cp++ = '0';
+ *cp++ = '\0';
+ }
+}
+
+static void
+float_print(v, fp, flags)
+ floatobject *v;
+ FILE *fp;
+ int flags;
+{
+ char buf[100];
+ float_buf_repr(buf, v);
+ fputs(buf, fp);
+}
+
+static object *
+float_repr(v)
+ floatobject *v;
+{
+ char buf[100];
+ float_buf_repr(buf, v);
+ return newstringobject(buf);
+}
+
+static int
+float_compare(v, w)
+ floatobject *v, *w;
+{
+ double i = v->ob_fval;
+ double j = w->ob_fval;
+ return (i < j) ? -1 : (i > j) ? 1 : 0;
+}
+
+static object *
+float_add(v, w)
+ floatobject *v;
+ object *w;
+{
+ if (!is_floatobject(w)) {
+ errno = EINVAL;
+ return NULL;
+ }
+ return newfloatobject(v->ob_fval + ((floatobject *)w) -> ob_fval);
+}
+
+static object *
+float_sub(v, w)
+ floatobject *v;
+ object *w;
+{
+ if (!is_floatobject(w)) {
+ errno = EINVAL;
+ return NULL;
+ }
+ return newfloatobject(v->ob_fval - ((floatobject *)w) -> ob_fval);
+}
+
+static object *
+float_mul(v, w)
+ floatobject *v;
+ object *w;
+{
+ if (!is_floatobject(w)) {
+ errno = EINVAL;
+ return NULL;
+ }
+ return newfloatobject(v->ob_fval * ((floatobject *)w) -> ob_fval);
+}
+
+static object *
+float_div(v, w)
+ floatobject *v;
+ object *w;
+{
+ if (!is_floatobject(w)) {
+ errno = EINVAL;
+ return NULL;
+ }
+ if (((floatobject *)w) -> ob_fval == 0) {
+ errno = EDOM;
+ return NULL;
+ }
+ return newfloatobject(v->ob_fval / ((floatobject *)w) -> ob_fval);
+}
+
+static object *
+float_rem(v, w)
+ floatobject *v;
+ object *w;
+{
+ double wx;
+ extern double fmod();
+ if (!is_floatobject(w)) {
+ errno = EINVAL;
+ return NULL;
+ }
+ wx = ((floatobject *)w) -> ob_fval;
+ if (wx == 0.0) {
+ errno = EDOM;
+ return NULL;
+ }
+ return newfloatobject(fmod(v->ob_fval, wx));
+}
+
+static object *
+float_pow(v, w)
+ floatobject *v;
+ object *w;
+{
+ double iv, iw, ix;
+ extern double pow();
+ if (!is_floatobject(w)) {
+ errno = EINVAL;
+ return NULL;
+ }
+ iv = v->ob_fval;
+ iw = ((floatobject *)w)->ob_fval;
+ errno = 0;
+ ix = pow(iv, iw);
+ if (errno != 0)
+ return NULL;
+ else
+ return newfloatobject(ix);
+}
+
+static object *
+float_neg(v)
+ floatobject *v;
+{
+ return newfloatobject(-v->ob_fval);
+}
+
+static object *
+float_pos(v)
+ floatobject *v;
+{
+ return newfloatobject(v->ob_fval);
+}
+
+static number_methods float_as_number = {
+ float_add, /*tp_add*/
+ float_sub, /*tp_subtract*/
+ float_mul, /*tp_multiply*/
+ float_div, /*tp_divide*/
+ float_rem, /*tp_remainder*/
+ float_pow, /*tp_power*/
+ float_neg, /*tp_negate*/
+ float_pos, /*tp_plus*/
+};
+
+typeobject Floattype = {
+ OB_HEAD_INIT(&Typetype)
+ 0,
+ "float",
+ sizeof(floatobject),
+ 0,
+ free, /*tp_dealloc*/
+ float_print, /*tp_print*/
+ 0, /*tp_getattr*/
+ 0, /*tp_setattr*/
+ float_compare, /*tp_compare*/
+ float_repr, /*tp_repr*/
+ &float_as_number, /*tp_as_number*/
+ 0, /*tp_as_sequence*/
+ 0, /*tp_as_mapping*/
+};
+
+/*
+XXX This is not enough. Need:
+- automatic casts for mixed arithmetic (3.1 * 4)
+- mixed comparisons (!)
+- look at other uses of ints that could be extended to floats
+*/
--- /dev/null
+/* Function object implementation */
+
+#include <stdio.h>
+
+#include "PROTO.h"
+#include "object.h"
+#include "node.h"
+#include "stringobject.h"
+#include "funcobject.h"
+#include "objimpl.h"
+#include "token.h"
+
+typedef struct {
+ OB_HEAD
+ node *func_node;
+ object *func_globals;
+} funcobject;
+
+object *
+newfuncobject(n, globals)
+ node *n;
+ object *globals;
+{
+ funcobject *op = NEWOBJ(funcobject, &Functype);
+ if (op != NULL) {
+ op->func_node = n;
+ if (globals != NULL)
+ INCREF(globals);
+ op->func_globals = globals;
+ }
+ return (object *)op;
+}
+
+node *
+getfuncnode(op)
+ object *op;
+{
+ if (!is_funcobject(op)) {
+ errno = EBADF;
+ return NULL;
+ }
+ return ((funcobject *) op) -> func_node;
+}
+
+object *
+getfuncglobals(op)
+ object *op;
+{
+ if (!is_funcobject(op)) {
+ errno = EBADF;
+ return NULL;
+ }
+ return ((funcobject *) op) -> func_globals;
+}
+
+/* Methods */
+
+static void
+funcdealloc(op)
+ funcobject *op;
+{
+ /* XXX free node? */
+ DECREF(op->func_globals);
+ free((char *)op);
+}
+
+static void
+funcprint(op, fp, flags)
+ funcobject *op;
+ FILE *fp;
+ int flags;
+{
+ node *n = op->func_node;
+ n = CHILD(n, 1);
+ fprintf(fp, "<user function %s>", STR(n));
+}
+
+static object *
+funcrepr(op)
+ funcobject *op;
+{
+ char buf[100];
+ node *n = op->func_node;
+ n = CHILD(n, 1);
+ sprintf(buf, "<user function %.80s>", STR(n));
+ return newstringobject(buf);
+}
+
+typeobject Functype = {
+ OB_HEAD_INIT(&Typetype)
+ 0,
+ "function",
+ sizeof(funcobject),
+ 0,
+ funcdealloc, /*tp_dealloc*/
+ funcprint, /*tp_print*/
+ 0, /*tp_getattr*/
+ 0, /*tp_setattr*/
+ 0, /*tp_compare*/
+ funcrepr, /*tp_repr*/
+};
--- /dev/null
+/* Integer object implementation */
+
+#include <stdio.h>
+
+#include "PROTO.h"
+#include "object.h"
+#include "intobject.h"
+#include "stringobject.h"
+#include "objimpl.h"
+
+/* Standard Booleans */
+intobject FalseObject = {
+ OB_HEAD_INIT(&Inttype)
+ 0
+};
+intobject TrueObject = {
+ OB_HEAD_INIT(&Inttype)
+ 1
+};
+
+object *
+newintobject(ival)
+ long ival;
+{
+ /* For efficiency, this code is copied from newobject() */
+ register intobject *op = (intobject *) malloc(sizeof(intobject));
+ if (op == NULL) {
+ errno = ENOMEM;
+ }
+ else {
+ NEWREF(op);
+ op->ob_type = &Inttype;
+ op->ob_ival = ival;
+ }
+ return (object *) op;
+}
+
+long
+getintvalue(op)
+ register object *op;
+{
+ if (!is_intobject(op)) {
+ errno = EBADF;
+ return -1;
+ }
+ else
+ return ((intobject *)op) -> ob_ival;
+}
+
+/* Methods */
+
+static void
+intprint(v, fp, flags)
+ intobject *v;
+ FILE *fp;
+ int flags;
+{
+ fprintf(fp, "%ld", v->ob_ival);
+}
+
+static object *
+intrepr(v)
+ intobject *v;
+{
+ char buf[20];
+ sprintf(buf, "%ld", v->ob_ival);
+ return newstringobject(buf);
+}
+
+static int
+intcompare(v, w)
+ intobject *v, *w;
+{
+ register long i = v->ob_ival;
+ register long j = w->ob_ival;
+ return (i < j) ? -1 : (i > j) ? 1 : 0;
+}
+
+static object *
+intadd(v, w)
+ intobject *v;
+ register object *w;
+{
+ register long a, b, x;
+ if (!is_intobject(w)) {
+ errno = EINVAL;
+ return NULL;
+ }
+ a = v->ob_ival;
+ b = ((intobject *)w) -> ob_ival;
+ x = a + b;
+ if ((x^a) < 0 && (x^b) < 0) {
+ errno = ERANGE;
+ return NULL;
+ }
+ return newintobject(x);
+}
+
+static object *
+intsub(v, w)
+ intobject *v;
+ register object *w;
+{
+ register long a, b, x;
+ if (!is_intobject(w)) {
+ errno = EINVAL;
+ return NULL;
+ }
+ a = v->ob_ival;
+ b = ((intobject *)w) -> ob_ival;
+ x = a - b;
+ if ((x^a) < 0 && (x^~b) < 0) {
+ errno = ERANGE;
+ return NULL;
+ }
+ return newintobject(x);
+}
+
+static object *
+intmul(v, w)
+ intobject *v;
+ register object *w;
+{
+ register long a, b;
+ double x;
+ if (!is_intobject(w)) {
+ errno = EINVAL;
+ return NULL;
+ }
+ a = v->ob_ival;
+ b = ((intobject *)w) -> ob_ival;
+ x = (double)a * (double)b;
+ if (x > 0x7fffffff || x < (double) (long) 0x80000000) {
+ errno = ERANGE;
+ return NULL;
+ }
+ return newintobject(a * b);
+}
+
+static object *
+intdiv(v, w)
+ intobject *v;
+ register object *w;
+{
+ if (!is_intobject(w)) {
+ errno = EINVAL;
+ return NULL;
+ }
+ if (((intobject *)w) -> ob_ival == 0) {
+ errno = EDOM;
+ return NULL;
+ }
+ return newintobject(v->ob_ival / ((intobject *)w) -> ob_ival);
+}
+
+static object *
+intrem(v, w)
+ intobject *v;
+ register object *w;
+{
+ if (!is_intobject(w)) {
+ errno = EINVAL;
+ return NULL;
+ }
+ if (((intobject *)w) -> ob_ival == 0) {
+ errno = EDOM;
+ return NULL;
+ }
+ return newintobject(v->ob_ival % ((intobject *)w) -> ob_ival);
+}
+
+static object *
+intpow(v, w)
+ intobject *v;
+ register object *w;
+{
+ register long iv, iw, ix;
+ register int neg;
+ if (!is_intobject(w)) {
+ errno = EINVAL;
+ return NULL;
+ }
+ iv = v->ob_ival;
+ iw = ((intobject *)w)->ob_ival;
+ neg = 0;
+ if (iw < 0)
+ neg = 1, iw = -iw;
+ ix = 1;
+ for (; iw > 0; iw--)
+ ix = ix * iv;
+ if (neg) {
+ if (ix == 0) {
+ errno = EDOM;
+ return NULL;
+ }
+ ix = 1/ix;
+ }
+ /* XXX How to check for overflow? */
+ return newintobject(ix);
+}
+
+static object *
+intneg(v)
+ intobject *v;
+{
+ register long a, x;
+ a = v->ob_ival;
+ x = -a;
+ if (a < 0 && x < 0) {
+ errno = ERANGE;
+ return NULL;
+ }
+ return newintobject(x);
+}
+
+static object *
+intpos(v)
+ intobject *v;
+{
+ INCREF(v);
+ return (object *)v;
+}
+
+static number_methods int_as_number = {
+ intadd, /*tp_add*/
+ intsub, /*tp_subtract*/
+ intmul, /*tp_multiply*/
+ intdiv, /*tp_divide*/
+ intrem, /*tp_remainder*/
+ intpow, /*tp_power*/
+ intneg, /*tp_negate*/
+ intpos, /*tp_plus*/
+};
+
+typeobject Inttype = {
+ OB_HEAD_INIT(&Typetype)
+ 0,
+ "int",
+ sizeof(intobject),
+ 0,
+ free, /*tp_dealloc*/
+ intprint, /*tp_print*/
+ 0, /*tp_getattr*/
+ 0, /*tp_setattr*/
+ intcompare, /*tp_compare*/
+ intrepr, /*tp_repr*/
+ &int_as_number, /*tp_as_number*/
+ 0, /*tp_as_sequence*/
+ 0, /*tp_as_mapping*/
+};
--- /dev/null
+/* List object implementation */
+
+#include <stdio.h>
+
+#include "PROTO.h"
+#include "object.h"
+#include "intobject.h"
+#include "stringobject.h"
+#include "tupleobject.h"
+#include "methodobject.h"
+#include "listobject.h"
+#include "objimpl.h"
+#include "modsupport.h"
+
+typedef struct {
+ OB_VARHEAD
+ object **ob_item;
+} listobject;
+
+object *
+newlistobject(size)
+ int size;
+{
+ int i;
+ listobject *op;
+ if (size < 0) {
+ errno = EINVAL;
+ return NULL;
+ }
+ op = (listobject *) malloc(sizeof(listobject));
+ if (op == NULL) {
+ errno = ENOMEM;
+ return NULL;
+ }
+ if (size <= 0) {
+ op->ob_item = NULL;
+ }
+ else {
+ op->ob_item = (object **) malloc(size * sizeof(object *));
+ if (op->ob_item == NULL) {
+ free((ANY *)op);
+ errno = ENOMEM;
+ return NULL;
+ }
+ }
+ NEWREF(op);
+ op->ob_type = &Listtype;
+ op->ob_size = size;
+ for (i = 0; i < size; i++)
+ op->ob_item[i] = NULL;
+ return (object *) op;
+}
+
+int
+getlistsize(op)
+ object *op;
+{
+ if (!is_listobject(op)) {
+ errno = EBADF;
+ return -1;
+ }
+ else
+ return ((listobject *)op) -> ob_size;
+}
+
+object *
+getlistitem(op, i)
+ object *op;
+ int i;
+{
+ if (!is_listobject(op)) {
+ errno = EBADF;
+ return NULL;
+ }
+ if (i < 0 || i >= ((listobject *)op) -> ob_size) {
+ errno = EDOM;
+ return NULL;
+ }
+ return ((listobject *)op) -> ob_item[i];
+}
+
+int
+setlistitem(op, i, newitem)
+ register object *op;
+ register int i;
+ register object *newitem;
+{
+ register object *olditem;
+ if (!is_listobject(op)) {
+ if (newitem != NULL)
+ DECREF(newitem);
+ return errno = EBADF;
+ }
+ if (i < 0 || i >= ((listobject *)op) -> ob_size) {
+ if (newitem != NULL)
+ DECREF(newitem);
+ return errno = EDOM;
+ }
+ olditem = ((listobject *)op) -> ob_item[i];
+ ((listobject *)op) -> ob_item[i] = newitem;
+ if (olditem != NULL)
+ DECREF(olditem);
+ return 0;
+}
+
+static int
+ins1(self, where, v)
+ listobject *self;
+ int where;
+ object *v;
+{
+ int i;
+ object **items;
+ if (v == NULL)
+ return errno = EINVAL;
+ items = self->ob_item;
+ RESIZE(items, object *, self->ob_size+1);
+ if (items == NULL)
+ return errno = ENOMEM;
+ if (where < 0)
+ where = 0;
+ if (where > self->ob_size)
+ where = self->ob_size;
+ for (i = self->ob_size; --i >= where; )
+ items[i+1] = items[i];
+ INCREF(v);
+ items[where] = v;
+ self->ob_item = items;
+ self->ob_size++;
+ return 0;
+}
+
+int
+inslistitem(op, where, newitem)
+ object *op;
+ int where;
+ object *newitem;
+{
+ if (!is_listobject(op))
+ return errno = EBADF;
+ return ins1((listobject *)op, where, newitem);
+}
+
+int
+addlistitem(op, newitem)
+ object *op;
+ object *newitem;
+{
+ if (!is_listobject(op))
+ return errno = EBADF;
+ return ins1((listobject *)op,
+ (int) ((listobject *)op)->ob_size, newitem);
+}
+
+/* Methods */
+
+static void
+list_dealloc(op)
+ listobject *op;
+{
+ int i;
+ for (i = 0; i < op->ob_size; i++) {
+ if (op->ob_item[i] != NULL)
+ DECREF(op->ob_item[i]);
+ }
+ if (op->ob_item != NULL)
+ free((ANY *)op->ob_item);
+ free((ANY *)op);
+}
+
+static void
+list_print(op, fp, flags)
+ listobject *op;
+ FILE *fp;
+ int flags;
+{
+ int i;
+ fprintf(fp, "[");
+ for (i = 0; i < op->ob_size && !StopPrint; i++) {
+ if (i > 0) {
+ fprintf(fp, ", ");
+ }
+ printobject(op->ob_item[i], fp, flags);
+ }
+ fprintf(fp, "]");
+}
+
+object *
+list_repr(v)
+ listobject *v;
+{
+ object *s, *t, *comma;
+ int i;
+ s = newstringobject("[");
+ comma = newstringobject(", ");
+ for (i = 0; i < v->ob_size && s != NULL; i++) {
+ if (i > 0)
+ joinstring(&s, comma);
+ t = reprobject(v->ob_item[i]);
+ joinstring(&s, t);
+ DECREF(t);
+ }
+ DECREF(comma);
+ t = newstringobject("]");
+ joinstring(&s, t);
+ DECREF(t);
+ return s;
+}
+
+static int
+list_compare(v, w)
+ listobject *v, *w;
+{
+ int len = (v->ob_size < w->ob_size) ? v->ob_size : w->ob_size;
+ int i;
+ for (i = 0; i < len; i++) {
+ int cmp = cmpobject(v->ob_item[i], w->ob_item[i]);
+ if (cmp != 0)
+ return cmp;
+ }
+ return v->ob_size - w->ob_size;
+}
+
+static int
+list_length(a)
+ listobject *a;
+{
+ return a->ob_size;
+}
+
+static object *
+list_item(a, i)
+ listobject *a;
+ int i;
+{
+ if (i < 0 || i >= a->ob_size) {
+ errno = EDOM;
+ return NULL;
+ }
+ INCREF(a->ob_item[i]);
+ return a->ob_item[i];
+}
+
+static object *
+list_slice(a, ilow, ihigh)
+ listobject *a;
+ int ilow, ihigh;
+{
+ listobject *np;
+ int i;
+ if (ilow < 0)
+ ilow = 0;
+ else if (ilow > a->ob_size)
+ ilow = a->ob_size;
+ if (ihigh < 0)
+ ihigh = 0;
+ if (ihigh < ilow)
+ ihigh = ilow;
+ else if (ihigh > a->ob_size)
+ ihigh = a->ob_size;
+ np = (listobject *) newlistobject(ihigh - ilow);
+ if (np == NULL)
+ return NULL;
+ for (i = ilow; i < ihigh; i++) {
+ object *v = a->ob_item[i];
+ INCREF(v);
+ np->ob_item[i - ilow] = v;
+ }
+ return (object *)np;
+}
+
+static object *
+list_concat(a, bb)
+ listobject *a;
+ object *bb;
+{
+ int size;
+ int i;
+ listobject *np;
+ if (!is_listobject(bb)) {
+ errno = EINVAL;
+ return NULL;
+ }
+#define b ((listobject *)bb)
+ size = a->ob_size + b->ob_size;
+ np = (listobject *) newlistobject(size);
+ if (np == NULL) {
+ errno = ENOMEM;
+ return NULL;
+ }
+ for (i = 0; i < a->ob_size; i++) {
+ object *v = a->ob_item[i];
+ INCREF(v);
+ np->ob_item[i] = v;
+ }
+ for (i = 0; i < b->ob_size; i++) {
+ object *v = b->ob_item[i];
+ INCREF(v);
+ np->ob_item[i + a->ob_size] = v;
+ }
+ return (object *)np;
+#undef b
+}
+
+static int
+list_ass_item(a, i, v)
+ listobject *a;
+ int i;
+ object *v;
+{
+ if (i < 0 || i >= a->ob_size)
+ return errno = EDOM;
+ if (v == NULL)
+ return list_ass_slice(a, i, i+1, v);
+ INCREF(v);
+ DECREF(a->ob_item[i]);
+ a->ob_item[i] = v;
+ return 0;
+}
+
+static int
+list_ass_slice(a, ilow, ihigh, v)
+ listobject *a;
+ int ilow, ihigh;
+ object *v;
+{
+ object **item;
+ int n; /* Size of replacement list */
+ int d; /* Change in size */
+ int k; /* Loop index */
+#define b ((listobject *)v)
+ if (v == NULL)
+ n = 0;
+ else if (is_listobject(v))
+ n = b->ob_size;
+ else
+ return errno = EINVAL;
+ if (ilow < 0)
+ ilow = 0;
+ else if (ilow > a->ob_size)
+ ilow = a->ob_size;
+ if (ihigh < 0)
+ ihigh = 0;
+ if (ihigh < ilow)
+ ihigh = ilow;
+ else if (ihigh > a->ob_size)
+ ihigh = a->ob_size;
+ item = a->ob_item;
+ d = n - (ihigh-ilow);
+ if (d <= 0) { /* Delete -d items; DECREF ihigh-ilow items */
+ for (k = ilow; k < ihigh; k++)
+ DECREF(item[k]);
+ if (d < 0) {
+ for (/*k = ihigh*/; k < a->ob_size; k++)
+ item[k+d] = item[k];
+ a->ob_size += d;
+ RESIZE(item, object *, a->ob_size); /* Can't fail */
+ a->ob_item = item;
+ }
+ }
+ else { /* Insert d items; DECREF ihigh-ilow items */
+ RESIZE(item, object *, a->ob_size + d);
+ if (item == NULL)
+ return errno = ENOMEM;
+ for (k = a->ob_size; --k >= ihigh; )
+ item[k+d] = item[k];
+ for (/*k = ihigh-1*/; k >= ilow; --k)
+ DECREF(item[k]);
+ a->ob_item = item;
+ a->ob_size += d;
+ }
+ for (k = 0; k < n; k++, ilow++) {
+ object *w = b->ob_item[k];
+ INCREF(w);
+ item[ilow] = w;
+ }
+ return 0;
+#undef b
+}
+
+static object *
+ins(self, where, v)
+ listobject *self;
+ int where;
+ object *v;
+{
+ if (ins1(self, where, v) != 0)
+ return NULL;
+ INCREF(None);
+ return None;
+}
+
+static object *
+listinsert(self, args)
+ listobject *self;
+ object *args;
+{
+ int i;
+ if (args == NULL || !is_tupleobject(args) || gettuplesize(args) != 2) {
+ errno = EINVAL;
+ return NULL;
+ }
+ if (!getintarg(gettupleitem(args, 0), &i))
+ return NULL;
+ return ins(self, i, gettupleitem(args, 1));
+}
+
+static object *
+listappend(self, args)
+ listobject *self;
+ object *args;
+{
+ return ins(self, (int) self->ob_size, args);
+}
+
+static int
+cmp(v, w)
+ char *v, *w;
+{
+ return cmpobject(* (object **) v, * (object **) w);
+}
+
+static object *
+listsort(self, args)
+ listobject *self;
+ object *args;
+{
+ if (args != NULL) {
+ errno = EINVAL;
+ return NULL;
+ }
+ errno = 0;
+ if (self->ob_size > 1)
+ qsort((char *)self->ob_item,
+ (int) self->ob_size, sizeof(object *), cmp);
+ if (errno != 0)
+ return NULL;
+ INCREF(None);
+ return None;
+}
+
+static struct methodlist list_methods[] = {
+ {"append", listappend},
+ {"insert", listinsert},
+ {"sort", listsort},
+ {NULL, NULL} /* sentinel */
+};
+
+static object *
+list_getattr(f, name)
+ listobject *f;
+ char *name;
+{
+ return findmethod(list_methods, (object *)f, name);
+}
+
+static sequence_methods list_as_sequence = {
+ list_length, /*sq_length*/
+ list_concat, /*sq_concat*/
+ 0, /*sq_repeat*/
+ list_item, /*sq_item*/
+ list_slice, /*sq_slice*/
+ list_ass_item, /*sq_ass_item*/
+ list_ass_slice, /*sq_ass_slice*/
+};
+
+typeobject Listtype = {
+ OB_HEAD_INIT(&Typetype)
+ 0,
+ "list",
+ sizeof(listobject),
+ 0,
+ list_dealloc, /*tp_dealloc*/
+ list_print, /*tp_print*/
+ list_getattr, /*tp_getattr*/
+ 0, /*tp_setattr*/
+ list_compare, /*tp_compare*/
+ list_repr, /*tp_repr*/
+ 0, /*tp_as_number*/
+ &list_as_sequence, /*tp_as_sequence*/
+ 0, /*tp_as_mapping*/
+};
--- /dev/null
+/* Method object implementation */
+
+#include <stdio.h>
+
+#include "PROTO.h"
+#include "object.h"
+#include "node.h"
+#include "stringobject.h"
+#include "methodobject.h"
+#include "objimpl.h"
+#include "token.h"
+
+typedef struct {
+ OB_HEAD
+ char *m_name;
+ method m_meth;
+ object *m_self;
+} methodobject;
+
+object *
+newmethodobject(name, meth, self)
+ char *name; /* static string */
+ method meth;
+ object *self;
+{
+ methodobject *op = NEWOBJ(methodobject, &Methodtype);
+ if (op != NULL) {
+ op->m_name = name;
+ op->m_meth = meth;
+ if (self != NULL)
+ INCREF(self);
+ op->m_self = self;
+ }
+ return (object *)op;
+}
+
+method
+getmethod(op)
+ object *op;
+{
+ if (!is_methodobject(op)) {
+ errno = EBADF;
+ return NULL;
+ }
+ return ((methodobject *)op) -> m_meth;
+}
+
+object *
+getself(op)
+ object *op;
+{
+ if (!is_methodobject(op)) {
+ errno = EBADF;
+ return NULL;
+ }
+ return ((methodobject *)op) -> m_self;
+}
+
+/* Methods (the standard built-in methods, that is) */
+
+static void
+meth_dealloc(m)
+ methodobject *m;
+{
+ if (m->m_self != NULL)
+ DECREF(m->m_self);
+ free((char *)m);
+}
+
+static void
+meth_print(m, fp, flags)
+ methodobject *m;
+ FILE *fp;
+ int flags;
+{
+ if (m->m_self == NULL)
+ fprintf(fp, "<%s method>", m->m_name);
+ else
+ fprintf(fp, "<%s method of %s object at %lx>",
+ m->m_name, m->m_self->ob_type->tp_name,
+ (long)m->m_self);
+}
+
+static object *
+meth_repr(m)
+ methodobject *m;
+{
+ char buf[200];
+ if (m->m_self == NULL)
+ sprintf(buf, "<%.80s method>", m->m_name);
+ else
+ sprintf(buf, "<%.80s method of %.80s object at %lx>",
+ m->m_name, m->m_self->ob_type->tp_name,
+ (long)m->m_self);
+ return newstringobject(buf);
+}
+
+typeobject Methodtype = {
+ OB_HEAD_INIT(&Typetype)
+ 0,
+ "method",
+ sizeof(methodobject),
+ 0,
+ meth_dealloc, /*tp_dealloc*/
+ meth_print, /*tp_print*/
+ 0, /*tp_getattr*/
+ 0, /*tp_setattr*/
+ 0, /*tp_compare*/
+ meth_repr, /*tp_repr*/
+ 0, /*tp_as_number*/
+ 0, /*tp_as_sequence*/
+ 0, /*tp_as_mapping*/
+};
--- /dev/null
+/* Module object implementation */
+
+#include <stdio.h>
+
+#include "PROTO.h"
+#include "object.h"
+#include "stringobject.h"
+#include "dictobject.h"
+#include "moduleobject.h"
+#include "objimpl.h"
+
+typedef struct {
+ OB_HEAD
+ object *md_name;
+ object *md_dict;
+} moduleobject;
+
+object *
+newmoduleobject(name)
+ char *name;
+{
+ moduleobject *m = NEWOBJ(moduleobject, &Moduletype);
+ if (m == NULL)
+ return NULL;
+ m->md_name = newstringobject(name);
+ m->md_dict = newdictobject();
+ if (m->md_name == NULL || m->md_dict == NULL) {
+ DECREF(m);
+ return NULL;
+ }
+ return (object *)m;
+}
+
+object *
+getmoduledict(m)
+ object *m;
+{
+ if (!is_moduleobject(m)) {
+ errno = EBADF;
+ return NULL;
+ }
+ return ((moduleobject *)m) -> md_dict;
+}
+
+int
+setmoduledict(m, v)
+ object *m;
+ object *v;
+{
+ if (!is_moduleobject(m))
+ return errno = EBADF;
+ if (!is_dictobject(v))
+ return errno = EINVAL;
+ DECREF(((moduleobject *)m) -> md_dict);
+ INCREF(v);
+ ((moduleobject *)m) -> md_dict = v;
+ return 0;
+}
+
+/* Methods */
+
+static void
+moduledealloc(m)
+ moduleobject *m;
+{
+ if (m->md_name != NULL)
+ DECREF(m->md_name);
+ if (m->md_dict != NULL)
+ DECREF(m->md_dict);
+ free((char *)m);
+}
+
+static void
+moduleprint(m, fp, flags)
+ moduleobject *m;
+ FILE *fp;
+ int flags;
+{
+ fprintf(fp, "<module %s>", getstringvalue(m->md_name));
+}
+
+static object *
+modulerepr(m)
+ moduleobject *m;
+{
+ char buf[100];
+ sprintf(buf, "<module %.80s>", getstringvalue(m->md_name));
+ return newstringobject(buf);
+}
+
+static object *
+modulegetattr(m, name)
+ moduleobject *m;
+ char *name;
+{
+ object *res = dictlookup(m->md_dict, name);
+ if (res == NULL) {
+ if (errno == ENOENT)
+ errno = ESRCH;
+ }
+ else
+ INCREF(res);
+ return res;
+}
+
+static int
+modulesetattr(m, name, v)
+ moduleobject *m;
+ char *name;
+ object *v;
+{
+ if (v == NULL)
+ return dictremove(m->md_dict, name);
+ else
+ return dictinsert(m->md_dict, name, v);
+}
+
+typeobject Moduletype = {
+ OB_HEAD_INIT(&Typetype)
+ 0, /*ob_size*/
+ "module", /*tp_name*/
+ sizeof(moduleobject), /*tp_size*/
+ 0, /*tp_itemsize*/
+ moduledealloc, /*tp_dealloc*/
+ moduleprint, /*tp_print*/
+ modulegetattr, /*tp_getattr*/
+ modulesetattr, /*tp_setattr*/
+ 0, /*tp_compare*/
+ modulerepr, /*tp_repr*/
+};
--- /dev/null
+/* Object implementation; and 'noobject' implementation */
+
+#include <stdio.h>
+
+#include "PROTO.h"
+#include "object.h"
+#include "stringobject.h"
+#include "objimpl.h"
+#include "errors.h"
+
+extern object *err_nomem PROTO((void)); /* XXX from modsupport.c */
+
+int StopPrint; /* Flag to indicate printing must be stopped */
+
+/* Object allocation routines used by NEWOBJ and NEWVAROBJ macros */
+
+object *
+newobject(tp)
+ typeobject *tp;
+{
+ object *op = (object *) malloc(tp->tp_basicsize);
+ if (op == NULL)
+ return err_nomem();
+ NEWREF(op);
+ op->ob_type = tp;
+ return op;
+}
+
+#if 0 /* unused */
+
+varobject *
+newvarobject(tp, size)
+ typeobject *tp;
+ unsigned int size;
+{
+ varobject *op = (varobject *)
+ malloc(tp->tp_basicsize + size * tp->tp_itemsize);
+ if (op == NULL)
+ return err_nomem();
+ NEWREF(op);
+ op->ob_type = tp;
+ op->ob_size = size;
+ return op;
+}
+
+#endif
+
+static int prlevel;
+
+void
+printobject(op, fp, flags)
+ object *op;
+ FILE *fp;
+ int flags;
+{
+ /* Hacks to make printing a long or recursive object interruptible */
+ prlevel++;
+ if (!StopPrint && intrcheck()) {
+ fprintf(fp, "\n[print interrupted]\n");
+ StopPrint = 1;
+ }
+ if (!StopPrint) {
+ if (op == NULL) {
+ fprintf(fp, "<nil>");
+ }
+ else if (op->ob_type->tp_print == NULL) {
+ fprintf(fp, "<%s object at %lx>",
+ op->ob_type->tp_name, (long)op);
+ }
+ else {
+ (*op->ob_type->tp_print)(op, fp, flags);
+ }
+ }
+ prlevel--;
+ if (prlevel == 0)
+ StopPrint = 0;
+}
+
+object *
+reprobject(v)
+ object *v;
+{
+ object *w;
+ /* Hacks to make converting a long or recursive object interruptible */
+ prlevel++;
+ if (!StopPrint && intrcheck()) {
+ StopPrint = 1;
+ w = NULL;
+ err_set(KeyboardInterrupt);
+ }
+ if (!StopPrint) {
+ if (v == NULL) {
+ w = newstringobject("<nil>");
+ }
+ else if (v->ob_type->tp_repr == NULL) {
+ char buf[100];
+ sprintf(buf, "<%.80s object at %lx>",
+ v->ob_type->tp_name, (long)v);
+ w = newstringobject(buf);
+ }
+ else {
+ w = (*v->ob_type->tp_repr)(v);
+ }
+ }
+ prlevel--;
+ if (prlevel == 0)
+ StopPrint = 0;
+ return w;
+}
+
+int
+cmpobject(v, w)
+ object *v, *w;
+{
+ typeobject *tp;
+ if (v == w)
+ return 0;
+ if (v == NULL)
+ return -1;
+ if (w == NULL)
+ return 1;
+ if ((tp = v->ob_type) != w->ob_type)
+ return strcmp(tp->tp_name, w->ob_type->tp_name);
+ if (tp->tp_compare == NULL)
+ return (v < w) ? -1 : 1;
+ return ((*tp->tp_compare)(v, w));
+}
+
+
+/*
+NoObject is usable as a non-NULL undefined value, used by the macro None.
+There is (and should be!) no way to create other objects of this type,
+so there is exactly one.
+*/
+
+static void
+noprint(op, fp, flags)
+ object *op;
+ FILE *fp;
+ int flags;
+{
+ fprintf(fp, "<no value>");
+}
+
+static typeobject Notype = {
+ OB_HEAD_INIT(&Typetype)
+ 0,
+ "novalue",
+ 0,
+ 0,
+ 0, /*tp_dealloc*/ /*never called*/
+ noprint, /*tp_print*/
+};
+
+object NoObject = {
+ OB_HEAD_INIT(&Notype)
+};
+
+
+#ifdef TRACE_REFS
+
+static object refchain = {&refchain, &refchain};
+
+NEWREF(op)
+ object *op;
+{
+ ref_total++;
+ op->ob_refcnt = 1;
+ op->_ob_next = refchain._ob_next;
+ op->_ob_prev = &refchain;
+ refchain._ob_next->_ob_prev = op;
+ refchain._ob_next = op;
+}
+
+DELREF(op)
+ object *op;
+{
+ op->_ob_next->_ob_prev = op->_ob_prev;
+ op->_ob_prev->_ob_next = op->_ob_next;
+ (*(op)->ob_type->tp_dealloc)(op);
+}
+
+printrefs(fp)
+ FILE *fp;
+{
+ object *op;
+ fprintf(fp, "Remaining objects:\n");
+ for (op = refchain._ob_next; op != &refchain; op = op->_ob_next) {
+ fprintf(fp, "[%d] ", op->ob_refcnt);
+ printobject(op, fp, 0);
+ putc('\n', fp);
+ }
+}
+
+#endif
--- /dev/null
+/* String object implementation */
+
+#include <stdio.h>
+
+#include "PROTO.h"
+#include "object.h"
+#include "stringobject.h"
+#include "intobject.h"
+#include "objimpl.h"
+
+object *
+newsizedstringobject(str, size)
+ char *str;
+ int size;
+{
+ register stringobject *op = (stringobject *)
+ malloc(sizeof(stringobject) + size * sizeof(char));
+ if (op == NULL) {
+ errno = ENOMEM;
+ }
+ else {
+ NEWREF(op);
+ op->ob_type = &Stringtype;
+ op->ob_size = size;
+ if (str != NULL)
+ memcpy(op->ob_sval, str, size);
+ op->ob_sval[size] = '\0';
+ }
+ return (object *) op;
+}
+
+object *
+newstringobject(str)
+ char *str;
+{
+ register unsigned int size = strlen(str);
+ register stringobject *op = (stringobject *)
+ malloc(sizeof(stringobject) + size * sizeof(char));
+ if (op == NULL) {
+ errno = ENOMEM;
+ }
+ else {
+ NEWREF(op);
+ op->ob_type = &Stringtype;
+ op->ob_size = size;
+ strcpy(op->ob_sval, str);
+ }
+ return (object *) op;
+}
+
+unsigned int
+getstringsize(op)
+ register object *op;
+{
+ if (!is_stringobject(op)) {
+ errno = EBADF;
+ return -1;
+ }
+ return ((stringobject *)op) -> ob_size;
+}
+
+/*const*/ char *
+getstringvalue(op)
+ register object *op;
+{
+ if (!is_stringobject(op)) {
+ errno = EBADF;
+ return NULL;
+ }
+ return ((stringobject *)op) -> ob_sval;
+}
+
+/* Methods */
+
+static void
+stringprint(op, fp, flags)
+ stringobject *op;
+ FILE *fp;
+ int flags;
+{
+ int i;
+ char c;
+ if (flags & PRINT_RAW) {
+ fwrite(op->ob_sval, 1, (int) op->ob_size, fp);
+ return;
+ }
+ fprintf(fp, "'");
+ for (i = 0; i < op->ob_size; i++) {
+ c = op->ob_sval[i];
+ if (c == '\'' || c == '\\')
+ fprintf(fp, "\\%c", c);
+ else if (c < ' ' || c >= 0177)
+ fprintf(fp, "\\%03o", c&0377);
+ else
+ putc(c, fp);
+ }
+ fprintf(fp, "'");
+}
+
+static object *
+stringrepr(op)
+ register stringobject *op;
+{
+ /* XXX overflow? */
+ int newsize = 2 + 4 * op->ob_size * sizeof(char);
+ object *v = newsizedstringobject((char *)NULL, newsize);
+ if (v == NULL) {
+ errno = ENOMEM;
+ }
+ else {
+ register int i;
+ register char c;
+ register char *p;
+ NEWREF(v);
+ v->ob_type = &Stringtype;
+ ((stringobject *)v)->ob_size = newsize;
+ p = ((stringobject *)v)->ob_sval;
+ *p++ = '\'';
+ for (i = 0; i < op->ob_size; i++) {
+ c = op->ob_sval[i];
+ if (c == '\'' || c == '\\')
+ *p++ = '\\', *p++ = c;
+ else if (c < ' ' || c >= 0177) {
+ sprintf(p, "\\%03o", c&0377);
+ while (*p != '\0')
+ p++;
+
+ }
+ else
+ *p++ = c;
+ }
+ *p++ = '\'';
+ *p = '\0';
+ resizestring(&v, (int) (p - ((stringobject *)v)->ob_sval));
+ }
+ return v;
+}
+
+static int
+stringlength(a)
+ stringobject *a;
+{
+ return a->ob_size;
+}
+
+static object *
+stringconcat(a, bb)
+ register stringobject *a;
+ register object *bb;
+{
+ register unsigned int size;
+ register stringobject *op;
+ if (!is_stringobject(bb)) {
+ errno = EINVAL;
+ return NULL;
+ }
+#define b ((stringobject *)bb)
+ /* Optimize cases with empty left or right operand */
+ if (a->ob_size == 0) {
+ INCREF(bb);
+ return bb;
+ }
+ if (b->ob_size == 0) {
+ INCREF(a);
+ return (object *)a;
+ }
+ size = a->ob_size + b->ob_size;
+ op = (stringobject *)
+ malloc(sizeof(stringobject) + size * sizeof(char));
+ if (op == NULL) {
+ errno = ENOMEM;
+ }
+ else {
+ NEWREF(op);
+ op->ob_type = &Stringtype;
+ op->ob_size = size;
+ memcpy(op->ob_sval, a->ob_sval, (int) a->ob_size);
+ memcpy(op->ob_sval + a->ob_size, b->ob_sval, (int) b->ob_size);
+ op->ob_sval[size] = '\0';
+ }
+ return (object *) op;
+#undef b
+}
+
+static object *
+stringrepeat(a, n)
+ register stringobject *a;
+ register int n;
+{
+ register int i;
+ register unsigned int size;
+ register stringobject *op;
+ if (n < 0)
+ n = 0;
+ size = a->ob_size * n;
+ if (size == a->ob_size) {
+ INCREF(a);
+ return (object *)a;
+ }
+ op = (stringobject *)
+ malloc(sizeof(stringobject) + size * sizeof(char));
+ if (op == NULL) {
+ errno = ENOMEM;
+ }
+ else {
+ NEWREF(op);
+ op->ob_type = &Stringtype;
+ op->ob_size = size;
+ for (i = 0; i < size; i += a->ob_size)
+ memcpy(op->ob_sval+i, a->ob_sval, (int) a->ob_size);
+ op->ob_sval[size] = '\0';
+ }
+ return (object *) op;
+}
+
+/* String slice a[i:j] consists of characters a[i] ... a[j-1] */
+
+static object *
+stringslice(a, i, j)
+ register stringobject *a;
+ register int i, j; /* May be negative! */
+{
+ if (i < 0)
+ i = 0;
+ if (j < 0)
+ j = 0; /* Avoid signed/unsigned bug in next line */
+ if (j > a->ob_size)
+ j = a->ob_size;
+ if (i == 0 && j == a->ob_size) { /* It's the same as a */
+ INCREF(a);
+ return (object *)a;
+ }
+ if (j < i)
+ j = i;
+ return newsizedstringobject(a->ob_sval + i, (int) (j-i));
+}
+
+static object *
+stringitem(a, i)
+ stringobject *a;
+ register int i;
+{
+ if (i < 0 || i >= a->ob_size) {
+ errno = EDOM;
+ return NULL;
+ }
+ return stringslice(a, i, i+1);
+}
+
+static int
+stringcompare(a, b)
+ stringobject *a, *b;
+{
+ /* XXX should use memcmp on shortest size, then compare lengths */
+ return strcmp(a->ob_sval, b->ob_sval);
+}
+
+static sequence_methods string_as_sequence = {
+ stringlength, /*tp_length*/
+ stringconcat, /*tp_concat*/
+ stringrepeat, /*tp_repeat*/
+ stringitem, /*tp_item*/
+ stringslice, /*tp_slice*/
+ 0, /*tp_ass_item*/
+ 0, /*tp_ass_slice*/
+};
+
+typeobject Stringtype = {
+ OB_HEAD_INIT(&Typetype)
+ 0,
+ "string",
+ sizeof(stringobject),
+ sizeof(char),
+ free, /*tp_dealloc*/
+ stringprint, /*tp_print*/
+ 0, /*tp_getattr*/
+ 0, /*tp_setattr*/
+ stringcompare, /*tp_compare*/
+ stringrepr, /*tp_repr*/
+ 0, /*tp_as_number*/
+ &string_as_sequence, /*tp_as_sequence*/
+ 0, /*tp_as_mapping*/
+};
+
+void
+joinstring(pv, w)
+ register object **pv;
+ register object *w;
+{
+ register object *v;
+ if (*pv == NULL || w == NULL || !is_stringobject(*pv))
+ return;
+ v = stringconcat((stringobject *) *pv, w);
+ DECREF(*pv);
+ *pv = v;
+}
+
+/* The following function breaks the notion that strings are immutable:
+ it changes the size of a string. We get away with this only if there
+ is only one module referencing the object. You can also think of it
+ as creating a new string object and destroying the old one, only
+ more efficiently. In any case, don't use this if the string may
+ already be known to some other part of the code... */
+
+int
+resizestring(pv, newsize)
+ object **pv;
+ int newsize;
+{
+ register stringobject *v;
+ v = (stringobject *) *pv;
+ if (!is_stringobject(v) || v->ob_refcnt != 1) {
+ *pv = 0;
+ DECREF(v);
+ return errno = EBADF;
+ }
+ *pv = (object *)
+ realloc((char *)v,
+ sizeof(stringobject) + newsize * sizeof(char));
+ if (*pv == NULL) {
+ DECREF(v);
+ return errno = ENOMEM;
+ }
+ v = (stringobject *) *pv;
+ v->ob_size = newsize;
+ v->ob_sval[newsize] = '\0';
+ return 0;
+}
--- /dev/null
+/* Tuple object implementation */
+
+#include <stdio.h>
+
+#include "PROTO.h"
+#include "object.h"
+#include "stringobject.h"
+#include "tupleobject.h"
+#include "intobject.h"
+#include "objimpl.h"
+
+typedef struct {
+ OB_VARHEAD
+ object *ob_item[1];
+} tupleobject;
+
+object *
+newtupleobject(size)
+ register int size;
+{
+ register int i;
+ register tupleobject *op;
+ if (size < 0) {
+ errno = EINVAL;
+ return NULL;
+ }
+ op = (tupleobject *)
+ malloc(sizeof(tupleobject) + size * sizeof(object *));
+ if (op == NULL) {
+ errno = ENOMEM;
+ return NULL;
+ }
+ NEWREF(op);
+ op->ob_type = &Tupletype;
+ op->ob_size = size;
+ for (i = 0; i < size; i++)
+ op->ob_item[i] = NULL;
+ return (object *) op;
+}
+
+int
+gettuplesize(op)
+ register object *op;
+{
+ if (!is_tupleobject(op)) {
+ errno = EBADF;
+ return -1;
+ }
+ else
+ return ((tupleobject *)op)->ob_size;
+}
+
+object *
+gettupleitem(op, i)
+ register object *op;
+ register int i;
+{
+ if (!is_tupleobject(op)) {
+ errno = EBADF;
+ return NULL;
+ }
+ if (i < 0 || i >= ((tupleobject *)op) -> ob_size) {
+ errno = EDOM;
+ return NULL;
+ }
+ return ((tupleobject *)op) -> ob_item[i];
+}
+
+int
+settupleitem(op, i, newitem)
+ register object *op;
+ register int i;
+ register object *newitem;
+{
+ register object *olditem;
+ if (!is_tupleobject(op)) {
+ if (newitem != NULL)
+ DECREF(newitem);
+ return errno = EBADF;
+ }
+ if (i < 0 || i >= ((tupleobject *)op) -> ob_size) {
+ if (newitem != NULL)
+ DECREF(newitem);
+ return errno = EDOM;
+ }
+ olditem = ((tupleobject *)op) -> ob_item[i];
+ ((tupleobject *)op) -> ob_item[i] = newitem;
+ if (olditem != NULL)
+ DECREF(olditem);
+ return 0;
+}
+
+/* Methods */
+
+static void
+tupledealloc(op)
+ register tupleobject *op;
+{
+ register int i;
+ for (i = 0; i < op->ob_size; i++) {
+ if (op->ob_item[i] != NULL)
+ DECREF(op->ob_item[i]);
+ }
+ free((ANY *)op);
+}
+
+static void
+tupleprint(op, fp, flags)
+ tupleobject *op;
+ FILE *fp;
+ int flags;
+{
+ int i;
+ fprintf(fp, "(");
+ for (i = 0; i < op->ob_size && !StopPrint; i++) {
+ if (i > 0) {
+ fprintf(fp, ", ");
+ }
+ printobject(op->ob_item[i], fp, flags);
+ }
+ if (op->ob_size == 1)
+ fprintf(fp, ",");
+ fprintf(fp, ")");
+}
+
+object *
+tuplerepr(v)
+ tupleobject *v;
+{
+ object *s, *t, *comma;
+ int i;
+ s = newstringobject("(");
+ comma = newstringobject(", ");
+ for (i = 0; i < v->ob_size && s != NULL; i++) {
+ if (i > 0)
+ joinstring(&s, comma);
+ t = reprobject(v->ob_item[i]);
+ joinstring(&s, t);
+ if (t != NULL)
+ DECREF(t);
+ }
+ DECREF(comma);
+ if (v->ob_size == 1) {
+ t = newstringobject(",");
+ joinstring(&s, t);
+ DECREF(t);
+ }
+ t = newstringobject(")");
+ joinstring(&s, t);
+ DECREF(t);
+ return s;
+}
+
+static int
+tuplecompare(v, w)
+ register tupleobject *v, *w;
+{
+ register int len =
+ (v->ob_size < w->ob_size) ? v->ob_size : w->ob_size;
+ register int i;
+ for (i = 0; i < len; i++) {
+ int cmp = cmpobject(v->ob_item[i], w->ob_item[i]);
+ if (cmp != 0)
+ return cmp;
+ }
+ return v->ob_size - w->ob_size;
+}
+
+static int
+tuplelength(a)
+ tupleobject *a;
+{
+ return a->ob_size;
+}
+
+static object *
+tupleitem(a, i)
+ register tupleobject *a;
+ register int i;
+{
+ if (i < 0 || i >= a->ob_size) {
+ errno = EDOM;
+ return NULL;
+ }
+ INCREF(a->ob_item[i]);
+ return a->ob_item[i];
+}
+
+static object *
+tupleslice(a, ilow, ihigh)
+ register tupleobject *a;
+ register int ilow, ihigh;
+{
+ register tupleobject *np;
+ register int i;
+ if (ilow < 0)
+ ilow = 0;
+ if (ihigh > a->ob_size)
+ ihigh = a->ob_size;
+ if (ihigh < ilow)
+ ihigh = ilow;
+ if (ilow == 0 && ihigh == a->ob_size) {
+ /* XXX can only do this if tuples are immutable! */
+ INCREF(a);
+ return (object *)a;
+ }
+ np = (tupleobject *)newtupleobject(ihigh - ilow);
+ if (np == NULL)
+ return NULL;
+ for (i = ilow; i < ihigh; i++) {
+ object *v = a->ob_item[i];
+ INCREF(v);
+ np->ob_item[i - ilow] = v;
+ }
+ return (object *)np;
+}
+
+static object *
+tupleconcat(a, bb)
+ register tupleobject *a;
+ register object *bb;
+{
+ register int size;
+ register int i;
+ tupleobject *np;
+ if (!is_tupleobject(bb)) {
+ errno = EINVAL;
+ return NULL;
+ }
+#define b ((tupleobject *)bb)
+ size = a->ob_size + b->ob_size;
+ np = (tupleobject *) newtupleobject(size);
+ if (np == NULL) {
+ errno = ENOMEM;
+ return NULL;
+ }
+ for (i = 0; i < a->ob_size; i++) {
+ object *v = a->ob_item[i];
+ INCREF(v);
+ np->ob_item[i] = v;
+ }
+ for (i = 0; i < b->ob_size; i++) {
+ object *v = b->ob_item[i];
+ INCREF(v);
+ np->ob_item[i + a->ob_size] = v;
+ }
+ return (object *)np;
+#undef b
+}
+
+static sequence_methods tuple_as_sequence = {
+ tuplelength, /*sq_length*/
+ tupleconcat, /*sq_concat*/
+ 0, /*sq_repeat*/
+ tupleitem, /*sq_item*/
+ tupleslice, /*sq_slice*/
+ 0, /*sq_ass_item*/
+ 0, /*sq_ass_slice*/
+};
+
+typeobject Tupletype = {
+ OB_HEAD_INIT(&Typetype)
+ 0,
+ "tuple",
+ sizeof(tupleobject) - sizeof(object *),
+ sizeof(object *),
+ tupledealloc, /*tp_dealloc*/
+ tupleprint, /*tp_print*/
+ 0, /*tp_getattr*/
+ 0, /*tp_setattr*/
+ tuplecompare, /*tp_compare*/
+ tuplerepr, /*tp_repr*/
+ 0, /*tp_as_number*/
+ &tuple_as_sequence, /*tp_as_sequence*/
+ 0, /*tp_as_mapping*/
+};
--- /dev/null
+/* Type object implementation */
+
+#include <stdio.h>
+
+#include "PROTO.h"
+#include "object.h"
+#include "stringobject.h"
+#include "objimpl.h"
+
+/* Type object implementation */
+
+static void
+typeprint(v, fp, flags)
+ typeobject *v;
+ FILE *fp;
+ int flags;
+{
+ fprintf(fp, "<type '%s'>", v->tp_name);
+}
+
+static object *
+typerepr(v)
+ typeobject *v;
+{
+ char buf[100];
+ sprintf(buf, "<type '%.80s'>", v->tp_name);
+ return newstringobject(buf);
+}
+
+typedef struct {
+ OB_HEAD
+ long ob_ival;
+} intobject;
+
+typeobject Typetype = {
+ OB_HEAD_INIT(&Typetype)
+ 0, /* Number of items for varobject */
+ "type", /* Name of this type */
+ sizeof(typeobject), /* Basic object size */
+ 0, /* Item size for varobject */
+ 0, /*tp_dealloc*/
+ typeprint, /*tp_print*/
+ 0, /*tp_getattr*/
+ 0, /*tp_setattr*/
+ 0, /*tp_compare*/
+ typerepr, /*tp_repr*/
+};
--- /dev/null
+/* Xx objects */
+
+typedef struct {
+ OB_HEAD
+ object *x_attr; /* Attributes dictionary */
+} xxobject;
+
+extern typeobject Xxtype; /* Really static, forward */
+
+static xxobject *
+newxxobject(arg)
+ object *arg;
+{
+ textobject *xp;
+ xp = NEWOBJ(xxobject, &Xxtype);
+ if (xp == NULL)
+ return NULL;
+ xp->x_attr = NULL;
+ return xp;
+}
+
+/* Xx methods */
+
+static void
+xx_dealloc(xp)
+ xxobject *xp;
+{
+ if (xp->x_attr != NULL)
+ DECREF(xp->x_attr);
+ DEL(xp);
+}
+
+static object *
+xx_demo(self, args)
+ xxobject *self;
+ object *args;
+{
+ if (!getnoarg(args))
+ return NULL;
+ INCREF(None);
+ return None;
+}
+
+static struct methodlist xx_methods[] = {
+ "demo", xx_demo,
+ {NULL, NULL} /* sentinel */
+};
+
+static object *
+xx_getattr(xp, name)
+ xxobject *xp;
+ char *name;
+{
+ if (xp->x_attr != NULL) {
+ object *v = dictlookup(xp->x_attr, name);
+ if (v != NULL) {
+ INCREF(v);
+ return v;
+ }
+ }
+ return findmethod(xx_methods, (object *)xp, name);
+}
+
+static int
+xx_setattr(xp, name, v)
+ xxobject *xp;
+ char *name;
+ object *v;
+{
+ if (xp->x_attr == NULL) {
+ xp->x_attr = newdictobject();
+ if (xp->x_attr == NULL)
+ return errno;
+ }
+ if (v == NULL)
+ return dictremove(xp->x_attr, name);
+ else
+ return dictinsert(xp->x_attr, name, v);
+}
+
+static typeobject Xxtype = {
+ OB_HEAD_INIT(&Typetype)
+ 0, /*ob_size*/
+ "xx", /*tp_name*/
+ sizeof(xxobject), /*tp_size*/
+ 0, /*tp_itemsize*/
+ /* methods */
+ xx_dealloc, /*tp_dealloc*/
+ 0, /*tp_print*/
+ xx_getattr, /*tp_getattr*/
+ xx_setattr, /*tp_setattr*/
+ 0, /*tp_compare*/
+ 0, /*tp_repr*/
+};
--- /dev/null
+/* Parser accelerator module */
+
+#include <stdio.h>
+
+#include "PROTO.h"
+#include "grammar.h"
+#include "token.h"
+#include "malloc.h"
+
+static void
+fixstate(g, d, s)
+ grammar *g;
+ dfa *d;
+ state *s;
+{
+ arc *a;
+ int k;
+ int *accel;
+ int nl = g->g_ll.ll_nlabels;
+ s->s_accept = 0;
+ accel = NEW(int, nl);
+ for (k = 0; k < nl; k++)
+ accel[k] = -1;
+ a = s->s_arc;
+ for (k = s->s_narcs; --k >= 0; a++) {
+ int lbl = a->a_lbl;
+ label *l = &g->g_ll.ll_label[lbl];
+ int type = l->lb_type;
+ if (a->a_arrow >= (1 << 7)) {
+ printf("XXX too many states!\n");
+ continue;
+ }
+ if (ISNONTERMINAL(type)) {
+ dfa *d1 = finddfa(g, type);
+ int ibit;
+ if (type - NT_OFFSET >= (1 << 7)) {
+ printf("XXX too high nonterminal number!\n");
+ continue;
+ }
+ for (ibit = 0; ibit < g->g_ll.ll_nlabels; ibit++) {
+ if (testbit(d1->d_first, ibit)) {
+ if (accel[ibit] != -1)
+ printf("XXX ambiguity!\n");
+ accel[ibit] = a->a_arrow | (1 << 7) |
+ ((type - NT_OFFSET) << 8);
+ }
+ }
+ }
+ else if (lbl == EMPTY)
+ s->s_accept = 1;
+ else if (lbl >= 0 && lbl < nl)
+ accel[lbl] = a->a_arrow;
+ }
+ while (nl > 0 && accel[nl-1] == -1)
+ nl--;
+ for (k = 0; k < nl && accel[k] == -1;)
+ k++;
+ if (k < nl) {
+ int i;
+ s->s_accel = NEW(int, nl-k);
+ if (s->s_accel == NULL) {
+ fprintf(stderr, "no mem to add parser accelerators\n");
+ exit(1);
+ }
+ s->s_lower = k;
+ s->s_upper = nl;
+ for (i = 0; k < nl; i++, k++)
+ s->s_accel[i] = accel[k];
+ }
+ DEL(accel);
+}
+
+static void
+fixdfa(g, d)
+ grammar *g;
+ dfa *d;
+{
+ state *s;
+ int j;
+ s = d->d_state;
+ for (j = 0; j < d->d_nstates; j++, s++)
+ fixstate(g, d, s);
+}
+
+void
+addaccelerators(g)
+ grammar *g;
+{
+ dfa *d;
+ int i;
+#ifdef DEBUG
+ printf("Adding parser accellerators ...\n");
+#endif
+ d = g->g_dfa;
+ for (i = g->g_ndfas; --i >= 0; d++)
+ fixdfa(g, d);
+ g->g_accel = 1;
+#ifdef DEBUG
+ printf("Done.\n");
+#endif
+}
--- /dev/null
+#define assert(e) { if (!(e)) { printf("Assertion failed\n"); abort(); } }
--- /dev/null
+/* Bitset primitives */
+
+#include "PROTO.h"
+#include "malloc.h"
+#include "bitset.h"
+
+bitset
+newbitset(nbits)
+ int nbits;
+{
+ int nbytes = NBYTES(nbits);
+ bitset ss = NEW(BYTE, nbytes);
+
+ if (ss == NULL)
+ fatal("no mem for bitset");
+
+ ss += nbytes;
+ while (--nbytes >= 0)
+ *--ss = 0;
+ return ss;
+}
+
+void
+delbitset(ss)
+ bitset ss;
+{
+ DEL(ss);
+}
+
+int
+addbit(ss, ibit)
+ bitset ss;
+ int ibit;
+{
+ int ibyte = BIT2BYTE(ibit);
+ BYTE mask = BIT2MASK(ibit);
+
+ if (ss[ibyte] & mask)
+ return 0; /* Bit already set */
+ ss[ibyte] |= mask;
+ return 1;
+}
+
+#if 0 /* Now a macro */
+int
+testbit(ss, ibit)
+ bitset ss;
+ int ibit;
+{
+ return (ss[BIT2BYTE(ibit)] & BIT2MASK(ibit)) != 0;
+}
+#endif
+
+int
+samebitset(ss1, ss2, nbits)
+ bitset ss1, ss2;
+ int nbits;
+{
+ int i;
+
+ for (i = NBYTES(nbits); --i >= 0; )
+ if (*ss1++ != *ss2++)
+ return 0;
+ return 1;
+}
+
+void
+mergebitset(ss1, ss2, nbits)
+ bitset ss1, ss2;
+ int nbits;
+{
+ int i;
+
+ for (i = NBYTES(nbits); --i >= 0; )
+ *ss1++ |= *ss2++;
+}
--- /dev/null
+/* Computation of FIRST stets */
+
+#include <stdio.h>
+
+#include "PROTO.h"
+#include "malloc.h"
+#include "grammar.h"
+#include "token.h"
+
+extern int debugging;
+
+static void
+calcfirstset(g, d)
+ grammar *g;
+ dfa *d;
+{
+ int i, j;
+ state *s;
+ arc *a;
+ int nsyms;
+ int *sym;
+ int nbits;
+ static bitset dummy;
+ bitset result;
+ int type;
+ dfa *d1;
+ label *l0;
+
+ if (debugging)
+ printf("Calculate FIRST set for '%s'\n", d->d_name);
+
+ if (dummy == NULL)
+ dummy = newbitset(1);
+ if (d->d_first == dummy) {
+ fprintf(stderr, "Left-recursion for '%s'\n", d->d_name);
+ return;
+ }
+ if (d->d_first != NULL) {
+ fprintf(stderr, "Re-calculating FIRST set for '%s' ???\n",
+ d->d_name);
+ }
+ d->d_first = dummy;
+
+ l0 = g->g_ll.ll_label;
+ nbits = g->g_ll.ll_nlabels;
+ result = newbitset(nbits);
+
+ sym = NEW(int, 1);
+ if (sym == NULL)
+ fatal("no mem for new sym in calcfirstset");
+ nsyms = 1;
+ sym[0] = findlabel(&g->g_ll, d->d_type, (char *)NULL);
+
+ s = &d->d_state[d->d_initial];
+ for (i = 0; i < s->s_narcs; i++) {
+ a = &s->s_arc[i];
+ for (j = 0; j < nsyms; j++) {
+ if (sym[j] == a->a_lbl)
+ break;
+ }
+ if (j >= nsyms) { /* New label */
+ RESIZE(sym, int, nsyms + 1);
+ if (sym == NULL)
+ fatal("no mem to resize sym in calcfirstset");
+ sym[nsyms++] = a->a_lbl;
+ type = l0[a->a_lbl].lb_type;
+ if (ISNONTERMINAL(type)) {
+ d1 = finddfa(g, type);
+ if (d1->d_first == dummy) {
+ fprintf(stderr,
+ "Left-recursion below '%s'\n",
+ d->d_name);
+ }
+ else {
+ if (d1->d_first == NULL)
+ calcfirstset(g, d1);
+ mergebitset(result, d1->d_first, nbits);
+ }
+ }
+ else if (ISTERMINAL(type)) {
+ addbit(result, a->a_lbl);
+ }
+ }
+ }
+ d->d_first = result;
+ if (debugging) {
+ printf("FIRST set for '%s': {", d->d_name);
+ for (i = 0; i < nbits; i++) {
+ if (testbit(result, i))
+ printf(" %s", labelrepr(&l0[i]));
+ }
+ printf(" }\n");
+ }
+}
+
+void
+addfirstsets(g)
+ grammar *g;
+{
+ int i;
+ dfa *d;
+
+ printf("Adding FIRST sets ...\n");
+ for (i = 0; i < g->g_ndfas; i++) {
+ d = &g->g_dfa[i];
+ if (d->d_first == NULL)
+ calcfirstset(g, d);
+ }
+}
--- /dev/null
+/* Grammar implementation */
+
+#include <stdio.h>
+#include <ctype.h>
+
+#include "PROTO.h"
+#include "malloc.h"
+#include "assert.h"
+#include "token.h"
+#include "grammar.h"
+
+extern int debugging;
+
+grammar *
+newgrammar(start)
+ int start;
+{
+ grammar *g;
+
+ g = NEW(grammar, 1);
+ if (g == NULL)
+ fatal("no mem for new grammar");
+ g->g_ndfas = 0;
+ g->g_dfa = NULL;
+ g->g_start = start;
+ g->g_ll.ll_nlabels = 0;
+ g->g_ll.ll_label = NULL;
+ return g;
+}
+
+dfa *
+adddfa(g, type, name)
+ grammar *g;
+ int type;
+ char *name;
+{
+ dfa *d;
+
+ RESIZE(g->g_dfa, dfa, g->g_ndfas + 1);
+ if (g->g_dfa == NULL)
+ fatal("no mem to resize dfa in adddfa");
+ d = &g->g_dfa[g->g_ndfas++];
+ d->d_type = type;
+ d->d_name = name;
+ d->d_nstates = 0;
+ d->d_state = NULL;
+ d->d_initial = -1;
+ d->d_first = NULL;
+ return d; /* Only use while fresh! */
+}
+
+int
+addstate(d)
+ dfa *d;
+{
+ state *s;
+
+ RESIZE(d->d_state, state, d->d_nstates + 1);
+ if (d->d_state == NULL)
+ fatal("no mem to resize state in addstate");
+ s = &d->d_state[d->d_nstates++];
+ s->s_narcs = 0;
+ s->s_arc = NULL;
+ return s - d->d_state;
+}
+
+void
+addarc(d, from, to, lbl)
+ dfa *d;
+ int lbl;
+{
+ state *s;
+ arc *a;
+
+ assert(0 <= from && from < d->d_nstates);
+ assert(0 <= to && to < d->d_nstates);
+
+ s = &d->d_state[from];
+ RESIZE(s->s_arc, arc, s->s_narcs + 1);
+ if (s->s_arc == NULL)
+ fatal("no mem to resize arc list in addarc");
+ a = &s->s_arc[s->s_narcs++];
+ a->a_lbl = lbl;
+ a->a_arrow = to;
+}
+
+int
+addlabel(ll, type, str)
+ labellist *ll;
+ int type;
+ char *str;
+{
+ int i;
+ label *lb;
+
+ for (i = 0; i < ll->ll_nlabels; i++) {
+ if (ll->ll_label[i].lb_type == type &&
+ strcmp(ll->ll_label[i].lb_str, str) == 0)
+ return i;
+ }
+ RESIZE(ll->ll_label, label, ll->ll_nlabels + 1);
+ if (ll->ll_label == NULL)
+ fatal("no mem to resize labellist in addlabel");
+ lb = &ll->ll_label[ll->ll_nlabels++];
+ lb->lb_type = type;
+ lb->lb_str = str; /* XXX strdup(str) ??? */
+ return lb - ll->ll_label;
+}
+
+/* Same, but rather dies than adds */
+
+int
+findlabel(ll, type, str)
+ labellist *ll;
+ int type;
+ char *str;
+{
+ int i;
+ label *lb;
+
+ for (i = 0; i < ll->ll_nlabels; i++) {
+ if (ll->ll_label[i].lb_type == type /*&&
+ strcmp(ll->ll_label[i].lb_str, str) == 0*/)
+ return i;
+ }
+ fprintf(stderr, "Label %d/'%s' not found\n", type, str);
+ abort();
+}
+
+static void
+translabel(g, lb)
+ grammar *g;
+ label *lb;
+{
+ int i;
+
+ if (debugging)
+ printf("Translating label %s ...\n", labelrepr(lb));
+
+ if (lb->lb_type == NAME) {
+ for (i = 0; i < g->g_ndfas; i++) {
+ if (strcmp(lb->lb_str, g->g_dfa[i].d_name) == 0) {
+ if (debugging)
+ printf("Label %s is non-terminal %d.\n",
+ lb->lb_str,
+ g->g_dfa[i].d_type);
+ lb->lb_type = g->g_dfa[i].d_type;
+ lb->lb_str = NULL;
+ return;
+ }
+ }
+ for (i = 0; i < (int)N_TOKENS; i++) {
+ if (strcmp(lb->lb_str, tok_name[i]) == 0) {
+ if (debugging)
+ printf("Label %s is terminal %d.\n",
+ lb->lb_str, i);
+ lb->lb_type = i;
+ lb->lb_str = NULL;
+ return;
+ }
+ }
+ printf("Can't translate NAME label '%s'\n", lb->lb_str);
+ return;
+ }
+
+ if (lb->lb_type == STRING) {
+ if (isalpha(lb->lb_str[1])) {
+ char *p, *strchr();
+ if (debugging)
+ printf("Label %s is a keyword\n", lb->lb_str);
+ lb->lb_type = NAME;
+ lb->lb_str++;
+ p = strchr(lb->lb_str, '\'');
+ if (p)
+ *p = '\0';
+ }
+ else {
+ if (lb->lb_str[2] == lb->lb_str[0]) {
+ int type = (int) tok_1char(lb->lb_str[1]);
+ if (type != OP) {
+ lb->lb_type = type;
+ lb->lb_str = NULL;
+ }
+ else
+ printf("Unknown OP label %s\n",
+ lb->lb_str);
+ }
+ else
+ printf("Can't translate STRING label %s\n",
+ lb->lb_str);
+ }
+ }
+ else
+ printf("Can't translate label '%s'\n", labelrepr(lb));
+}
+
+void
+translatelabels(g)
+ grammar *g;
+{
+ int i;
+
+ printf("Translating labels ...\n");
+ /* Don't translate EMPTY */
+ for (i = EMPTY+1; i < g->g_ll.ll_nlabels; i++)
+ translabel(g, &g->g_ll.ll_label[i]);
+}
--- /dev/null
+/* Grammar subroutines needed by parser */
+
+#include "PROTO.h"
+#define NULL 0
+#include "assert.h"
+#include "grammar.h"
+#include "token.h"
+
+/* Return the DFA for the given type */
+
+dfa *
+finddfa(g, type)
+ grammar *g;
+ register int type;
+{
+ register int i;
+ register dfa *d;
+
+ for (i = g->g_ndfas, d = g->g_dfa; --i >= 0; d++) {
+ if (d->d_type == type)
+ return d;
+ }
+ assert(0);
+ /* NOTREACHED */
+}
+
+char *
+labelrepr(lb)
+ label *lb;
+{
+ static char buf[100];
+
+ if (lb->lb_type == ENDMARKER)
+ return "EMPTY";
+ else if (ISNONTERMINAL(lb->lb_type)) {
+ if (lb->lb_str == NULL) {
+ sprintf(buf, "NT%d", lb->lb_type);
+ return buf;
+ }
+ else
+ return lb->lb_str;
+ }
+ else {
+ if (lb->lb_str == NULL)
+ return tok_name[lb->lb_type];
+ else {
+ sprintf(buf, "%.32s(%.32s)",
+ tok_name[lb->lb_type], lb->lb_str);
+ return buf;
+ }
+ }
+}
--- /dev/null
+/* Check for interrupts */
+
+#ifdef MSDOS
+
+/* This might work for MS-DOS: */
+
+void
+initintr()
+{
+}
+
+int
+intrcheck()
+{
+ int interrupted = 0;
+ while (kbhit()) {
+ if (getch() == '\003')
+ interrupted = 1;
+ }
+ return interrupted;
+}
+
+#define OK
+
+#endif
+
+
+#ifdef THINK_C
+
+#include <MacHeaders>
+
+void
+initintr()
+{
+}
+
+int
+intrcheck()
+{
+ /* Static to make it faster(?) only */
+ static EventRecord e;
+
+ /* XXX This fails if the user first types ahead and then
+ decides to interrupt -- repeating Command-. until the
+ event queue overflows may work though. */
+ if (EventAvail(keyDownMask|autoKeyMask, &e) &&
+ (e.modifiers & cmdKey) &&
+ (e.message & charCodeMask) == '.') {
+ (void) GetNextEvent(keyDownMask|autoKeyMask, &e);
+ return 1;
+ }
+ return 0;
+}
+
+#define OK
+
+#endif /* THINK_C */
+
+
+#ifndef OK
+
+/* Default version -- should work for Unix and Standard C */
+
+#include <stdio.h>
+#include <signal.h>
+
+#include "sigtype.h"
+
+static int interrupted;
+
+static SIGTYPE
+intcatcher(sig)
+ int sig;
+{
+ interrupted = 1;
+ signal(SIGINT, intcatcher);
+}
+
+void
+initintr()
+{
+ if (signal(SIGINT, SIG_IGN) != SIG_IGN)
+ signal(SIGINT, intcatcher);
+}
+
+int
+intrcheck()
+{
+ if (!interrupted)
+ return 0;
+ interrupted = 0;
+ return 1;
+}
+
+#endif /* !OK */
--- /dev/null
+/* List a node on a file */
+
+#include <stdio.h>
+
+#include "PROTO.h"
+#include "token.h"
+#include "node.h"
+
+static int level, atbol;
+
+static void
+list1node(fp, n)
+ FILE *fp;
+ node *n;
+{
+ if (n == 0)
+ return;
+ if (ISNONTERMINAL(TYPE(n))) {
+ int i;
+ for (i = 0; i < NCH(n); i++)
+ list1node(fp, CHILD(n, i));
+ }
+ else if (ISTERMINAL(TYPE(n))) {
+ switch (TYPE(n)) {
+ case INDENT:
+ ++level;
+ break;
+ case DEDENT:
+ --level;
+ break;
+ default:
+ if (atbol) {
+ int i;
+ for (i = 0; i < level; ++i)
+ fprintf(fp, "\t");
+ atbol = 0;
+ }
+ if (TYPE(n) == NEWLINE) {
+ if (STR(n) != NULL)
+ fprintf(fp, "%s", STR(n));
+ fprintf(fp, "\n");
+ atbol = 1;
+ }
+ else
+ fprintf(fp, "%s ", STR(n));
+ break;
+ }
+ }
+ else
+ fprintf(fp, "? ");
+}
+
+void
+listnode(fp, n)
+ FILE *fp;
+ node *n;
+{
+ level = 0;
+ atbol = 1;
+ list1node(fp, n);
+}
+
+void
+listtree(n)
+ node *n;
+{
+ listnode(stdout, n);
+}
--- /dev/null
+#include "PROTO.h"
+#include "metagrammar.h"
+#include "grammar.h"
+static arc arcs_0_0[3] = {
+ {2, 0},
+ {3, 0},
+ {4, 1},
+};
+static arc arcs_0_1[1] = {
+ {0, 1},
+};
+static state states_0[2] = {
+ {3, arcs_0_0},
+ {1, arcs_0_1},
+};
+static arc arcs_1_0[1] = {
+ {5, 1},
+};
+static arc arcs_1_1[1] = {
+ {6, 2},
+};
+static arc arcs_1_2[1] = {
+ {7, 3},
+};
+static arc arcs_1_3[1] = {
+ {3, 4},
+};
+static arc arcs_1_4[1] = {
+ {0, 4},
+};
+static state states_1[5] = {
+ {1, arcs_1_0},
+ {1, arcs_1_1},
+ {1, arcs_1_2},
+ {1, arcs_1_3},
+ {1, arcs_1_4},
+};
+static arc arcs_2_0[1] = {
+ {8, 1},
+};
+static arc arcs_2_1[2] = {
+ {9, 0},
+ {0, 1},
+};
+static state states_2[2] = {
+ {1, arcs_2_0},
+ {2, arcs_2_1},
+};
+static arc arcs_3_0[1] = {
+ {10, 1},
+};
+static arc arcs_3_1[2] = {
+ {10, 1},
+ {0, 1},
+};
+static state states_3[2] = {
+ {1, arcs_3_0},
+ {2, arcs_3_1},
+};
+static arc arcs_4_0[2] = {
+ {11, 1},
+ {13, 2},
+};
+static arc arcs_4_1[1] = {
+ {7, 3},
+};
+static arc arcs_4_2[3] = {
+ {14, 4},
+ {15, 4},
+ {0, 2},
+};
+static arc arcs_4_3[1] = {
+ {12, 4},
+};
+static arc arcs_4_4[1] = {
+ {0, 4},
+};
+static state states_4[5] = {
+ {2, arcs_4_0},
+ {1, arcs_4_1},
+ {3, arcs_4_2},
+ {1, arcs_4_3},
+ {1, arcs_4_4},
+};
+static arc arcs_5_0[3] = {
+ {5, 1},
+ {16, 1},
+ {17, 2},
+};
+static arc arcs_5_1[1] = {
+ {0, 1},
+};
+static arc arcs_5_2[1] = {
+ {7, 3},
+};
+static arc arcs_5_3[1] = {
+ {18, 1},
+};
+static state states_5[4] = {
+ {3, arcs_5_0},
+ {1, arcs_5_1},
+ {1, arcs_5_2},
+ {1, arcs_5_3},
+};
+static dfa dfas[6] = {
+ {256, "MSTART", 0, 2, states_0,
+ "\070\000\000"},
+ {257, "RULE", 0, 5, states_1,
+ "\040\000\000"},
+ {258, "RHS", 0, 2, states_2,
+ "\040\010\003"},
+ {259, "ALT", 0, 2, states_3,
+ "\040\010\003"},
+ {260, "ITEM", 0, 5, states_4,
+ "\040\010\003"},
+ {261, "ATOM", 0, 4, states_5,
+ "\040\000\003"},
+};
+static label labels[19] = {
+ {0, "EMPTY"},
+ {256, 0},
+ {257, 0},
+ {4, 0},
+ {0, 0},
+ {1, 0},
+ {11, 0},
+ {258, 0},
+ {259, 0},
+ {18, 0},
+ {260, 0},
+ {9, 0},
+ {10, 0},
+ {261, 0},
+ {16, 0},
+ {14, 0},
+ {3, 0},
+ {7, 0},
+ {8, 0},
+};
+static grammar gram = {
+ 6,
+ dfas,
+ {19, labels},
+ 256
+};
+
+grammar *
+meta_grammar()
+{
+ return &gram;
+}
--- /dev/null
+/* Parse tree node implementation */
+
+#include "PROTO.h"
+#include "malloc.h"
+#include "node.h"
+
+node *
+newnode(type)
+ int type;
+{
+ node *n = NEW(node, 1);
+ if (n == NULL)
+ return NULL;
+ n->n_type = type;
+ n->n_str = NULL;
+ n->n_nchildren = 0;
+ n->n_child = NULL;
+ return n;
+}
+
+#define XXX 3 /* Node alignment factor to speed up realloc */
+#define XXXROUNDUP(n) ((n) == 1 ? 1 : ((n) + XXX - 1) / XXX * XXX)
+
+node *
+addchild(n1, type, str)
+ register node *n1;
+ int type;
+ char *str;
+{
+ register int nch = n1->n_nchildren;
+ register int nch1 = nch+1;
+ register node *n;
+ if (XXXROUNDUP(nch) < nch1) {
+ n = n1->n_child;
+ nch1 = XXXROUNDUP(nch1);
+ RESIZE(n, node, nch1);
+ if (n == NULL)
+ return NULL;
+ n1->n_child = n;
+ }
+ n = &n1->n_child[n1->n_nchildren++];
+ n->n_type = type;
+ n->n_str = str;
+ n->n_nchildren = 0;
+ n->n_child = NULL;
+ return n;
+}
--- /dev/null
+/* Parser implementation */
+
+/* For a description, see the comments at end of this file */
+
+/* XXX To do: error recovery */
+
+#include <stdio.h>
+#include "assert.h"
+
+#include "PROTO.h"
+#include "malloc.h"
+#include "token.h"
+#include "grammar.h"
+#include "node.h"
+#include "parser.h"
+#include "errcode.h"
+
+extern int debugging;
+
+#ifdef DEBUG
+#define D(x) if (!debugging); else x
+#else
+#define D(x)
+#endif
+
+
+/* STACK DATA TYPE */
+
+static void s_reset PROTO((stack *));
+
+static void
+s_reset(s)
+ stack *s;
+{
+ s->s_top = &s->s_base[MAXSTACK];
+}
+
+#define s_empty(s) ((s)->s_top == &(s)->s_base[MAXSTACK])
+
+static int s_push PROTO((stack *, dfa *, node *));
+
+static int
+s_push(s, d, parent)
+ register stack *s;
+ dfa *d;
+ node *parent;
+{
+ register stackentry *top;
+ if (s->s_top == s->s_base) {
+ fprintf(stderr, "s_push: parser stack overflow\n");
+ return -1;
+ }
+ top = --s->s_top;
+ top->s_dfa = d;
+ top->s_parent = parent;
+ top->s_state = 0;
+ return 0;
+}
+
+#ifdef DEBUG
+
+static void s_pop PROTO((stack *));
+
+static void
+s_pop(s)
+ register stack *s;
+{
+ if (s_empty(s)) {
+ fprintf(stderr, "s_pop: parser stack underflow -- FATAL\n");
+ abort();
+ }
+ s->s_top++;
+}
+
+#else /* !DEBUG */
+
+#define s_pop(s) (s)->s_top++
+
+#endif
+
+
+/* PARSER CREATION */
+
+parser_state *
+newparser(g, start)
+ grammar *g;
+ int start;
+{
+ parser_state *ps;
+
+ if (!g->g_accel)
+ addaccelerators(g);
+ ps = NEW(parser_state, 1);
+ if (ps == NULL)
+ return NULL;
+ ps->p_grammar = g;
+ ps->p_tree = newnode(start);
+ if (ps->p_tree == NULL) {
+ if (ps->p_tree != NULL)
+ DEL(ps->p_tree); /* XXX freeing a node!?! */
+ DEL(ps);
+ return NULL;
+ }
+ s_reset(&ps->p_stack);
+ (void) s_push(&ps->p_stack, finddfa(g, start), ps->p_tree);
+ return ps;
+}
+
+void
+delparser(ps)
+ parser_state *ps;
+{
+ DEL(ps);
+}
+
+
+/* PARSER STACK OPERATIONS */
+
+static int shift PROTO((stack *, int, char *, int));
+
+static int
+shift(s, type, str, newstate)
+ register stack *s;
+ int type;
+ char *str;
+ int newstate;
+{
+ assert(!s_empty(s));
+ if (addchild(s->s_top->s_parent, type, str) == NULL) {
+ fprintf(stderr, "shift: no mem in addchild\n");
+ return -1;
+ }
+ s->s_top->s_state = newstate;
+ return 0;
+}
+
+static int push PROTO((stack *, int, dfa *, int));
+
+static int
+push(s, type, d, newstate)
+ register stack *s;
+ int type;
+ dfa *d;
+ int newstate;
+{
+ register node *n;
+ n = s->s_top->s_parent;
+ assert(!s_empty(s));
+ if (addchild(n, type, (char *)NULL) == NULL) {
+ fprintf(stderr, "push: no mem in addchild\n");
+ return -1;
+ }
+ s->s_top->s_state = newstate;
+ return s_push(s, d, CHILD(n, NCH(n)-1));
+}
+
+
+/* PARSER PROPER */
+
+static int classify PROTO((grammar *, int, char *));
+
+static int
+classify(g, type, str)
+ grammar *g;
+ register int type;
+ char *str;
+{
+ register int n = g->g_ll.ll_nlabels;
+
+ if (type == NAME) {
+ register char *s = str;
+ register label *l = g->g_ll.ll_label;
+ register int i;
+ for (i = n; i > 0; i--, l++) {
+ if (l->lb_type == NAME && l->lb_str != NULL &&
+ l->lb_str[0] == s[0] &&
+ strcmp(l->lb_str, s) == 0) {
+ D(printf("It's a keyword\n"));
+ return n - i;
+ }
+ }
+ }
+
+ {
+ register label *l = g->g_ll.ll_label;
+ register int i;
+ for (i = n; i > 0; i--, l++) {
+ if (l->lb_type == type && l->lb_str == NULL) {
+ D(printf("It's a token we know\n"));
+ return n - i;
+ }
+ }
+ }
+
+ D(printf("Illegal token\n"));
+ return -1;
+}
+
+int
+addtoken(ps, type, str)
+ register parser_state *ps;
+ register int type;
+ char *str;
+{
+ register int ilabel;
+
+ D(printf("Token %s/'%s' ... ", tok_name[type], str));
+
+ /* Find out which label this token is */
+ ilabel = classify(ps->p_grammar, type, str);
+ if (ilabel < 0)
+ return E_SYNTAX;
+
+ /* Loop until the token is shifted or an error occurred */
+ for (;;) {
+ /* Fetch the current dfa and state */
+ register dfa *d = ps->p_stack.s_top->s_dfa;
+ register state *s = &d->d_state[ps->p_stack.s_top->s_state];
+
+ D(printf(" DFA '%s', state %d:",
+ d->d_name, ps->p_stack.s_top->s_state));
+
+ /* Check accelerator */
+ if (s->s_lower <= ilabel && ilabel < s->s_upper) {
+ register int x = s->s_accel[ilabel - s->s_lower];
+ if (x != -1) {
+ if (x & (1<<7)) {
+ /* Push non-terminal */
+ int nt = (x >> 8) + NT_OFFSET;
+ int arrow = x & ((1<<7)-1);
+ dfa *d1 = finddfa(ps->p_grammar, nt);
+ if (push(&ps->p_stack, nt, d1, arrow) < 0) {
+ D(printf(" MemError: push.\n"));
+ return E_NOMEM;
+ }
+ D(printf(" Push ...\n"));
+ continue;
+ }
+
+ /* Shift the token */
+ if (shift(&ps->p_stack, type, str, x) < 0) {
+ D(printf(" MemError: shift.\n"));
+ return E_NOMEM;
+ }
+ D(printf(" Shift.\n"));
+ /* Pop while we are in an accept-only state */
+ while (s = &d->d_state
+ [ps->p_stack.s_top->s_state],
+ s->s_accept && s->s_narcs == 1) {
+ D(printf(" Direct pop.\n"));
+ s_pop(&ps->p_stack);
+ if (s_empty(&ps->p_stack)) {
+ D(printf(" ACCEPT.\n"));
+ return E_DONE;
+ }
+ d = ps->p_stack.s_top->s_dfa;
+ }
+ return E_OK;
+ }
+ }
+
+ if (s->s_accept) {
+ /* Pop this dfa and try again */
+ s_pop(&ps->p_stack);
+ D(printf(" Pop ...\n"));
+ if (s_empty(&ps->p_stack)) {
+ D(printf(" Error: bottom of stack.\n"));
+ return E_SYNTAX;
+ }
+ continue;
+ }
+
+ /* Stuck, report syntax error */
+ D(printf(" Error.\n"));
+ return E_SYNTAX;
+ }
+}
+
+
+#ifdef DEBUG
+
+/* DEBUG OUTPUT */
+
+void
+dumptree(g, n)
+ grammar *g;
+ node *n;
+{
+ int i;
+
+ if (n == NULL)
+ printf("NIL");
+ else {
+ label l;
+ l.lb_type = TYPE(n);
+ l.lb_str = TYPE(str);
+ printf("%s", labelrepr(&l));
+ if (ISNONTERMINAL(TYPE(n))) {
+ printf("(");
+ for (i = 0; i < NCH(n); i++) {
+ if (i > 0)
+ printf(",");
+ dumptree(g, CHILD(n, i));
+ }
+ printf(")");
+ }
+ }
+}
+
+void
+showtree(g, n)
+ grammar *g;
+ node *n;
+{
+ int i;
+
+ if (n == NULL)
+ return;
+ if (ISNONTERMINAL(TYPE(n))) {
+ for (i = 0; i < NCH(n); i++)
+ showtree(g, CHILD(n, i));
+ }
+ else if (ISTERMINAL(TYPE(n))) {
+ printf("%s", tok_name[TYPE(n)]);
+ if (TYPE(n) == NUMBER || TYPE(n) == NAME)
+ printf("(%s)", STR(n));
+ printf(" ");
+ }
+ else
+ printf("? ");
+}
+
+void
+printtree(ps)
+ parser_state *ps;
+{
+ if (debugging) {
+ printf("Parse tree:\n");
+ dumptree(ps->p_grammar, ps->p_tree);
+ printf("\n");
+ printf("Tokens:\n");
+ showtree(ps->p_grammar, ps->p_tree);
+ printf("\n");
+ }
+ printf("Listing:\n");
+ listtree(ps->p_tree);
+ printf("\n");
+}
+
+#endif /* DEBUG */
+
+/*
+
+Description
+-----------
+
+The parser's interface is different than usual: the function addtoken()
+must be called for each token in the input. This makes it possible to
+turn it into an incremental parsing system later. The parsing system
+constructs a parse tree as it goes.
+
+A parsing rule is represented as a Deterministic Finite-state Automaton
+(DFA). A node in a DFA represents a state of the parser; an arc represents
+a transition. Transitions are either labeled with terminal symbols or
+with non-terminals. When the parser decides to follow an arc labeled
+with a non-terminal, it is invoked recursively with the DFA representing
+the parsing rule for that as its initial state; when that DFA accepts,
+the parser that invoked it continues. The parse tree constructed by the
+recursively called parser is inserted as a child in the current parse tree.
+
+The DFA's can be constructed automatically from a more conventional
+language description. An extended LL(1) grammar (ELL(1)) is suitable.
+Certain restrictions make the parser's life easier: rules that can produce
+the empty string should be outlawed (there are other ways to put loops
+or optional parts in the language). To avoid the need to construct
+FIRST sets, we can require that all but the last alternative of a rule
+(really: arc going out of a DFA's state) must begin with a terminal
+symbol.
+
+As an example, consider this grammar:
+
+expr: term (OP term)*
+term: CONSTANT | '(' expr ')'
+
+The DFA corresponding to the rule for expr is:
+
+------->.---term-->.------->
+ ^ |
+ | |
+ \----OP----/
+
+The parse tree generated for the input a+b is:
+
+(expr: (term: (NAME: a)), (OP: +), (term: (NAME: b)))
+
+*/
--- /dev/null
+/* Parser interface */
+
+#define MAXSTACK 100
+
+typedef struct _stackentry {
+ int s_state; /* State in current DFA */
+ dfa *s_dfa; /* Current DFA */
+ node *s_parent; /* Where to add next node */
+} stackentry;
+
+typedef struct _stack {
+ stackentry *s_top; /* Top entry */
+ stackentry s_base[MAXSTACK];/* Array of stack entries */
+ /* NB The stack grows down */
+} stack;
+
+typedef struct {
+ struct _stack p_stack; /* Stack of parser states */
+ struct _grammar *p_grammar; /* Grammar to use */
+ struct _node *p_tree; /* Top of parse tree */
+} parser_state;
+
+parser_state *newparser PROTO((struct _grammar *g, int start));
+void delparser PROTO((parser_state *ps));
+int addtoken PROTO((parser_state *ps, int type, char *str));
--- /dev/null
+/* Parser-tokenizer link implementation */
+
+#include <stdio.h>
+
+#include "PROTO.h"
+#include "malloc.h"
+#include "tokenizer.h"
+#include "node.h"
+#include "grammar.h"
+#include "parser.h"
+#include "errcode.h"
+
+extern int debugging;
+
+
+/* Parse input coming from the given tokenizer structure.
+ Return error code. */
+
+static int
+parsetok(tok, g, start, n_ret)
+ struct tok_state *tok;
+ grammar *g;
+ int start;
+ node **n_ret;
+{
+ parser_state *ps;
+ int ret;
+
+ if ((ps = newparser(g, start)) == NULL) {
+ fprintf(stderr, "no mem for new parser\n");
+ return E_NOMEM;
+ }
+
+ for (;;) {
+ char *a, *b;
+ int type;
+ int len;
+ char *str;
+
+ type = tok_get(tok, &a, &b);
+ if (type == ERRORTOKEN) {
+ ret = tok->done;
+ break;
+ }
+ len = b - a;
+ str = NEW(char, len + 1);
+ if (str == NULL) {
+ fprintf(stderr, "no mem for next token\n");
+ ret = E_NOMEM;
+ break;
+ }
+ strncpy(str, a, len);
+ str[len] = '\0';
+ ret = addtoken(ps, (int)type, str);
+ if (ret != E_OK) {
+ if (ret == E_DONE)
+ *n_ret = ps->p_tree;
+ else if (tok->lineno <= 1 && tok->done == E_EOF)
+ ret = E_EOF;
+ break;
+ }
+ }
+
+ delparser(ps);
+ return ret;
+}
+
+
+/* Parse input coming from a string. Return error code. */
+
+int
+parsestring(s, g, start, n_ret)
+ char *s;
+ grammar *g;
+ int start;
+ node **n_ret;
+{
+ struct tok_state *tok = tok_setups(s);
+ int ret;
+
+ if (tok == NULL) {
+ fprintf(stderr, "no mem for tok_setups\n");
+ return E_NOMEM;
+ }
+ ret = parsetok(tok, g, start, n_ret);
+ if (ret == E_TOKEN || ret == E_SYNTAX) {
+ fprintf(stderr, "String parsing error at line %d\n",
+ tok->lineno);
+ }
+ tok_free(tok);
+ return ret;
+}
+
+
+/* Parse input coming from a file. Return error code. */
+
+int
+parsefile(fp, g, start, ps1, ps2, n_ret)
+ FILE *fp;
+ grammar *g;
+ int start;
+ char *ps1, *ps2;
+ node **n_ret;
+{
+ struct tok_state *tok = tok_setupf(fp, ps1, ps2);
+ int ret;
+
+ if (tok == NULL) {
+ fprintf(stderr, "no mem for tok_setupf\n");
+ return E_NOMEM;
+ }
+ ret = parsetok(tok, g, start, n_ret);
+ if (ret == E_TOKEN || ret == E_SYNTAX) {
+ char *p;
+ fprintf(stderr, "Parsing error at line %d:\n",
+ tok->lineno);
+ *tok->inp = '\0';
+ if (tok->inp > tok->buf && tok->inp[-1] == '\n')
+ tok->inp[-1] = '\0';
+ fprintf(stderr, "%s\n", tok->buf);
+ for (p = tok->buf; p < tok->cur; p++) {
+ if (*p == '\t')
+ putc('\t', stderr);
+ else
+ putc(' ', stderr);
+ }
+ fprintf(stderr, "^\n");
+ }
+ tok_free(tok);
+ return ret;
+}
--- /dev/null
+/* Parser generator */
+
+/* For a description, see the comments at end of this file */
+
+#include <stdio.h>
+#include "assert.h"
+
+#include "PROTO.h"
+#include "malloc.h"
+#include "token.h"
+#include "node.h"
+#include "grammar.h"
+#include "metagrammar.h"
+#include "pgen.h"
+
+extern int debugging;
+
+
+/* PART ONE -- CONSTRUCT NFA -- Cf. Algorithm 3.2 from [Aho&Ullman 77] */
+
+typedef struct _nfaarc {
+ int ar_label;
+ int ar_arrow;
+} nfaarc;
+
+typedef struct _nfastate {
+ int st_narcs;
+ nfaarc *st_arc;
+} nfastate;
+
+typedef struct _nfa {
+ int nf_type;
+ char *nf_name;
+ int nf_nstates;
+ nfastate *nf_state;
+ int nf_start, nf_finish;
+} nfa;
+
+static int
+addnfastate(nf)
+ nfa *nf;
+{
+ nfastate *st;
+
+ RESIZE(nf->nf_state, nfastate, nf->nf_nstates + 1);
+ if (nf->nf_state == NULL)
+ fatal("out of mem");
+ st = &nf->nf_state[nf->nf_nstates++];
+ st->st_narcs = 0;
+ st->st_arc = NULL;
+ return st - nf->nf_state;
+}
+
+static void
+addnfaarc(nf, from, to, lbl)
+ nfa *nf;
+ int from, to, lbl;
+{
+ nfastate *st;
+ nfaarc *ar;
+
+ st = &nf->nf_state[from];
+ RESIZE(st->st_arc, nfaarc, st->st_narcs + 1);
+ if (st->st_arc == NULL)
+ fatal("out of mem");
+ ar = &st->st_arc[st->st_narcs++];
+ ar->ar_label = lbl;
+ ar->ar_arrow = to;
+}
+
+static nfa *
+newnfa(name)
+ char *name;
+{
+ nfa *nf;
+ static type = NT_OFFSET; /* All types will be disjunct */
+
+ nf = NEW(nfa, 1);
+ if (nf == NULL)
+ fatal("no mem for new nfa");
+ nf->nf_type = type++;
+ nf->nf_name = name; /* XXX strdup(name) ??? */
+ nf->nf_nstates = 0;
+ nf->nf_state = NULL;
+ nf->nf_start = nf->nf_finish = -1;
+ return nf;
+}
+
+typedef struct _nfagrammar {
+ int gr_nnfas;
+ nfa **gr_nfa;
+ labellist gr_ll;
+} nfagrammar;
+
+static nfagrammar *
+newnfagrammar()
+{
+ nfagrammar *gr;
+
+ gr = NEW(nfagrammar, 1);
+ if (gr == NULL)
+ fatal("no mem for new nfa grammar");
+ gr->gr_nnfas = 0;
+ gr->gr_nfa = NULL;
+ gr->gr_ll.ll_nlabels = 0;
+ gr->gr_ll.ll_label = NULL;
+ addlabel(&gr->gr_ll, ENDMARKER, "EMPTY");
+ return gr;
+}
+
+static nfa *
+addnfa(gr, name)
+ nfagrammar *gr;
+ char *name;
+{
+ nfa *nf;
+
+ nf = newnfa(name);
+ RESIZE(gr->gr_nfa, nfa *, gr->gr_nnfas + 1);
+ if (gr->gr_nfa == NULL)
+ fatal("out of mem");
+ gr->gr_nfa[gr->gr_nnfas++] = nf;
+ addlabel(&gr->gr_ll, NAME, nf->nf_name);
+ return nf;
+}
+
+#ifdef DEBUG
+
+static char REQNFMT[] = "metacompile: less than %d children\n";
+
+#define REQN(i, count) \
+ if (i < count) { \
+ fprintf(stderr, REQNFMT, count); \
+ abort(); \
+ } else
+
+#else
+#define REQN(i, count) /* empty */
+#endif
+
+static nfagrammar *
+metacompile(n)
+ node *n;
+{
+ nfagrammar *gr;
+ int i;
+
+ printf("Compiling (meta-) parse tree into NFA grammar\n");
+ gr = newnfagrammar();
+ REQ(n, MSTART);
+ i = n->n_nchildren - 1; /* Last child is ENDMARKER */
+ n = n->n_child;
+ for (; --i >= 0; n++) {
+ if (n->n_type != NEWLINE)
+ compile_rule(gr, n);
+ }
+ return gr;
+}
+
+static
+compile_rule(gr, n)
+ nfagrammar *gr;
+ node *n;
+{
+ nfa *nf;
+
+ REQ(n, RULE);
+ REQN(n->n_nchildren, 4);
+ n = n->n_child;
+ REQ(n, NAME);
+ nf = addnfa(gr, n->n_str);
+ n++;
+ REQ(n, COLON);
+ n++;
+ REQ(n, RHS);
+ compile_rhs(&gr->gr_ll, nf, n, &nf->nf_start, &nf->nf_finish);
+ n++;
+ REQ(n, NEWLINE);
+}
+
+static
+compile_rhs(ll, nf, n, pa, pb)
+ labellist *ll;
+ nfa *nf;
+ node *n;
+ int *pa, *pb;
+{
+ int i;
+ int a, b;
+
+ REQ(n, RHS);
+ i = n->n_nchildren;
+ REQN(i, 1);
+ n = n->n_child;
+ REQ(n, ALT);
+ compile_alt(ll, nf, n, pa, pb);
+ if (--i <= 0)
+ return;
+ n++;
+ a = *pa;
+ b = *pb;
+ *pa = addnfastate(nf);
+ *pb = addnfastate(nf);
+ addnfaarc(nf, *pa, a, EMPTY);
+ addnfaarc(nf, b, *pb, EMPTY);
+ for (; --i >= 0; n++) {
+ REQ(n, VBAR);
+ REQN(i, 1);
+ --i;
+ n++;
+ REQ(n, ALT);
+ compile_alt(ll, nf, n, &a, &b);
+ addnfaarc(nf, *pa, a, EMPTY);
+ addnfaarc(nf, b, *pb, EMPTY);
+ }
+}
+
+static
+compile_alt(ll, nf, n, pa, pb)
+ labellist *ll;
+ nfa *nf;
+ node *n;
+ int *pa, *pb;
+{
+ int i;
+ int a, b;
+
+ REQ(n, ALT);
+ i = n->n_nchildren;
+ REQN(i, 1);
+ n = n->n_child;
+ REQ(n, ITEM);
+ compile_item(ll, nf, n, pa, pb);
+ --i;
+ n++;
+ for (; --i >= 0; n++) {
+ if (n->n_type == COMMA) { /* XXX Temporary */
+ REQN(i, 1);
+ --i;
+ n++;
+ }
+ REQ(n, ITEM);
+ compile_item(ll, nf, n, &a, &b);
+ addnfaarc(nf, *pb, a, EMPTY);
+ *pb = b;
+ }
+}
+
+static
+compile_item(ll, nf, n, pa, pb)
+ labellist *ll;
+ nfa *nf;
+ node *n;
+ int *pa, *pb;
+{
+ int i;
+ int a, b;
+
+ REQ(n, ITEM);
+ i = n->n_nchildren;
+ REQN(i, 1);
+ n = n->n_child;
+ if (n->n_type == LSQB) {
+ REQN(i, 3);
+ n++;
+ REQ(n, RHS);
+ *pa = addnfastate(nf);
+ *pb = addnfastate(nf);
+ addnfaarc(nf, *pa, *pb, EMPTY);
+ compile_rhs(ll, nf, n, &a, &b);
+ addnfaarc(nf, *pa, a, EMPTY);
+ addnfaarc(nf, b, *pb, EMPTY);
+ REQN(i, 1);
+ n++;
+ REQ(n, RSQB);
+ }
+ else {
+ compile_atom(ll, nf, n, pa, pb);
+ if (--i <= 0)
+ return;
+ n++;
+ addnfaarc(nf, *pb, *pa, EMPTY);
+ if (n->n_type == STAR)
+ *pb = *pa;
+ else
+ REQ(n, PLUS);
+ }
+}
+
+static
+compile_atom(ll, nf, n, pa, pb)
+ labellist *ll;
+ nfa *nf;
+ node *n;
+ int *pa, *pb;
+{
+ int i;
+
+ REQ(n, ATOM);
+ i = n->n_nchildren;
+ REQN(i, 1);
+ n = n->n_child;
+ if (n->n_type == LPAR) {
+ REQN(i, 3);
+ n++;
+ REQ(n, RHS);
+ compile_rhs(ll, nf, n, pa, pb);
+ n++;
+ REQ(n, RPAR);
+ }
+ else if (n->n_type == NAME || n->n_type == STRING) {
+ *pa = addnfastate(nf);
+ *pb = addnfastate(nf);
+ addnfaarc(nf, *pa, *pb, addlabel(ll, n->n_type, n->n_str));
+ }
+ else
+ REQ(n, NAME);
+}
+
+static void
+dumpstate(ll, nf, istate)
+ labellist *ll;
+ nfa *nf;
+ int istate;
+{
+ nfastate *st;
+ int i;
+ nfaarc *ar;
+
+ printf("%c%2d%c",
+ istate == nf->nf_start ? '*' : ' ',
+ istate,
+ istate == nf->nf_finish ? '.' : ' ');
+ st = &nf->nf_state[istate];
+ ar = st->st_arc;
+ for (i = 0; i < st->st_narcs; i++) {
+ if (i > 0)
+ printf("\n ");
+ printf("-> %2d %s", ar->ar_arrow,
+ labelrepr(&ll->ll_label[ar->ar_label]));
+ ar++;
+ }
+ printf("\n");
+}
+
+static void
+dumpnfa(ll, nf)
+ labellist *ll;
+ nfa *nf;
+{
+ int i;
+
+ printf("NFA '%s' has %d states; start %d, finish %d\n",
+ nf->nf_name, nf->nf_nstates, nf->nf_start, nf->nf_finish);
+ for (i = 0; i < nf->nf_nstates; i++)
+ dumpstate(ll, nf, i);
+}
+
+
+/* PART TWO -- CONSTRUCT DFA -- Algorithm 3.1 from [Aho&Ullman 77] */
+
+static int
+addclosure(ss, nf, istate)
+ bitset ss;
+ nfa *nf;
+ int istate;
+{
+ if (addbit(ss, istate)) {
+ nfastate *st = &nf->nf_state[istate];
+ nfaarc *ar = st->st_arc;
+ int i;
+
+ for (i = st->st_narcs; --i >= 0; ) {
+ if (ar->ar_label == EMPTY)
+ addclosure(ss, nf, ar->ar_arrow);
+ ar++;
+ }
+ }
+}
+
+typedef struct _ss_arc {
+ bitset sa_bitset;
+ int sa_arrow;
+ int sa_label;
+} ss_arc;
+
+typedef struct _ss_state {
+ bitset ss_ss;
+ int ss_narcs;
+ ss_arc *ss_arc;
+ int ss_deleted;
+ int ss_finish;
+ int ss_rename;
+} ss_state;
+
+typedef struct _ss_dfa {
+ int sd_nstates;
+ ss_state *sd_state;
+} ss_dfa;
+
+static
+makedfa(gr, nf, d)
+ nfagrammar *gr;
+ nfa *nf;
+ dfa *d;
+{
+ int nbits = nf->nf_nstates;
+ bitset ss;
+ int xx_nstates;
+ ss_state *xx_state, *yy;
+ ss_arc *zz;
+ int istate, jstate, iarc, jarc, ibit;
+ nfastate *st;
+ nfaarc *ar;
+
+ ss = newbitset(nbits);
+ addclosure(ss, nf, nf->nf_start);
+ xx_state = NEW(ss_state, 1);
+ if (xx_state == NULL)
+ fatal("no mem for xx_state in makedfa");
+ xx_nstates = 1;
+ yy = &xx_state[0];
+ yy->ss_ss = ss;
+ yy->ss_narcs = 0;
+ yy->ss_arc = NULL;
+ yy->ss_deleted = 0;
+ yy->ss_finish = testbit(ss, nf->nf_finish);
+ if (yy->ss_finish)
+ printf("Error: nonterminal '%s' may produce empty.\n",
+ nf->nf_name);
+
+ /* This algorithm is from a book written before
+ the invention of structured programming... */
+
+ /* For each unmarked state... */
+ for (istate = 0; istate < xx_nstates; ++istate) {
+ yy = &xx_state[istate];
+ ss = yy->ss_ss;
+ /* For all its states... */
+ for (ibit = 0; ibit < nf->nf_nstates; ++ibit) {
+ if (!testbit(ss, ibit))
+ continue;
+ st = &nf->nf_state[ibit];
+ /* For all non-empty arcs from this state... */
+ for (iarc = 0; iarc < st->st_narcs; iarc++) {
+ ar = &st->st_arc[iarc];
+ if (ar->ar_label == EMPTY)
+ continue;
+ /* Look up in list of arcs from this state */
+ for (jarc = 0; jarc < yy->ss_narcs; ++jarc) {
+ zz = &yy->ss_arc[jarc];
+ if (ar->ar_label == zz->sa_label)
+ goto found;
+ }
+ /* Add new arc for this state */
+ RESIZE(yy->ss_arc, ss_arc, yy->ss_narcs + 1);
+ if (yy->ss_arc == NULL)
+ fatal("out of mem");
+ zz = &yy->ss_arc[yy->ss_narcs++];
+ zz->sa_label = ar->ar_label;
+ zz->sa_bitset = newbitset(nbits);
+ zz->sa_arrow = -1;
+ found: ;
+ /* Add destination */
+ addclosure(zz->sa_bitset, nf, ar->ar_arrow);
+ }
+ }
+ /* Now look up all the arrow states */
+ for (jarc = 0; jarc < xx_state[istate].ss_narcs; jarc++) {
+ zz = &xx_state[istate].ss_arc[jarc];
+ for (jstate = 0; jstate < xx_nstates; jstate++) {
+ if (samebitset(zz->sa_bitset,
+ xx_state[jstate].ss_ss, nbits)) {
+ zz->sa_arrow = jstate;
+ goto done;
+ }
+ }
+ RESIZE(xx_state, ss_state, xx_nstates + 1);
+ if (xx_state == NULL)
+ fatal("out of mem");
+ zz->sa_arrow = xx_nstates;
+ yy = &xx_state[xx_nstates++];
+ yy->ss_ss = zz->sa_bitset;
+ yy->ss_narcs = 0;
+ yy->ss_arc = NULL;
+ yy->ss_deleted = 0;
+ yy->ss_finish = testbit(yy->ss_ss, nf->nf_finish);
+ done: ;
+ }
+ }
+
+ if (debugging)
+ printssdfa(xx_nstates, xx_state, nbits, &gr->gr_ll,
+ "before minimizing");
+
+ simplify(xx_nstates, xx_state);
+
+ if (debugging)
+ printssdfa(xx_nstates, xx_state, nbits, &gr->gr_ll,
+ "after minimizing");
+
+ convert(d, xx_nstates, xx_state);
+
+ /* XXX cleanup */
+}
+
+static
+printssdfa(xx_nstates, xx_state, nbits, ll, msg)
+ int xx_nstates;
+ ss_state *xx_state;
+ int nbits;
+ labellist *ll;
+ char *msg;
+{
+ int i, ibit, iarc;
+ ss_state *yy;
+ ss_arc *zz;
+
+ printf("Subset DFA %s\n", msg);
+ for (i = 0; i < xx_nstates; i++) {
+ yy = &xx_state[i];
+ if (yy->ss_deleted)
+ continue;
+ printf(" Subset %d", i);
+ if (yy->ss_finish)
+ printf(" (finish)");
+ printf(" { ");
+ for (ibit = 0; ibit < nbits; ibit++) {
+ if (testbit(yy->ss_ss, ibit))
+ printf("%d ", ibit);
+ }
+ printf("}\n");
+ for (iarc = 0; iarc < yy->ss_narcs; iarc++) {
+ zz = &yy->ss_arc[iarc];
+ printf(" Arc to state %d, label %s\n",
+ zz->sa_arrow,
+ labelrepr(&ll->ll_label[zz->sa_label]));
+ }
+ }
+}
+
+
+/* PART THREE -- SIMPLIFY DFA */
+
+/* Simplify the DFA by repeatedly eliminating states that are
+ equivalent to another oner. This is NOT Algorithm 3.3 from
+ [Aho&Ullman 77]. It does not always finds the minimal DFA,
+ but it does usually make a much smaller one... (For an example
+ of sub-optimal behaviour, try S: x a b+ | y a b+.)
+*/
+
+static int
+samestate(s1, s2)
+ ss_state *s1, *s2;
+{
+ int i;
+
+ if (s1->ss_narcs != s2->ss_narcs || s1->ss_finish != s2->ss_finish)
+ return 0;
+ for (i = 0; i < s1->ss_narcs; i++) {
+ if (s1->ss_arc[i].sa_arrow != s2->ss_arc[i].sa_arrow ||
+ s1->ss_arc[i].sa_label != s2->ss_arc[i].sa_label)
+ return 0;
+ }
+ return 1;
+}
+
+static void
+renamestates(xx_nstates, xx_state, from, to)
+ int xx_nstates;
+ ss_state *xx_state;
+ int from, to;
+{
+ int i, j;
+
+ if (debugging)
+ printf("Rename state %d to %d.\n", from, to);
+ for (i = 0; i < xx_nstates; i++) {
+ if (xx_state[i].ss_deleted)
+ continue;
+ for (j = 0; j < xx_state[i].ss_narcs; j++) {
+ if (xx_state[i].ss_arc[j].sa_arrow == from)
+ xx_state[i].ss_arc[j].sa_arrow = to;
+ }
+ }
+}
+
+static
+simplify(xx_nstates, xx_state)
+ int xx_nstates;
+ ss_state *xx_state;
+{
+ int changes;
+ int i, j, k;
+
+ do {
+ changes = 0;
+ for (i = 1; i < xx_nstates; i++) {
+ if (xx_state[i].ss_deleted)
+ continue;
+ for (j = 0; j < i; j++) {
+ if (xx_state[j].ss_deleted)
+ continue;
+ if (samestate(&xx_state[i], &xx_state[j])) {
+ xx_state[i].ss_deleted++;
+ renamestates(xx_nstates, xx_state, i, j);
+ changes++;
+ break;
+ }
+ }
+ }
+ } while (changes);
+}
+
+
+/* PART FOUR -- GENERATE PARSING TABLES */
+
+/* Convert the DFA into a grammar that can be used by our parser */
+
+static
+convert(d, xx_nstates, xx_state)
+ dfa *d;
+ int xx_nstates;
+ ss_state *xx_state;
+{
+ int i, j;
+ ss_state *yy;
+ ss_arc *zz;
+
+ for (i = 0; i < xx_nstates; i++) {
+ yy = &xx_state[i];
+ if (yy->ss_deleted)
+ continue;
+ yy->ss_rename = addstate(d);
+ }
+
+ for (i = 0; i < xx_nstates; i++) {
+ yy = &xx_state[i];
+ if (yy->ss_deleted)
+ continue;
+ for (j = 0; j < yy->ss_narcs; j++) {
+ zz = &yy->ss_arc[j];
+ addarc(d, yy->ss_rename,
+ xx_state[zz->sa_arrow].ss_rename,
+ zz->sa_label);
+ }
+ if (yy->ss_finish)
+ addarc(d, yy->ss_rename, yy->ss_rename, 0);
+ }
+
+ d->d_initial = 0;
+}
+
+
+/* PART FIVE -- GLUE IT ALL TOGETHER */
+
+static grammar *
+maketables(gr)
+ nfagrammar *gr;
+{
+ int i;
+ nfa *nf;
+ dfa *d;
+ grammar *g;
+
+ if (gr->gr_nnfas == 0)
+ return NULL;
+ g = newgrammar(gr->gr_nfa[0]->nf_type);
+ /* XXX first rule must be start rule */
+ g->g_ll = gr->gr_ll;
+
+ for (i = 0; i < gr->gr_nnfas; i++) {
+ nf = gr->gr_nfa[i];
+ if (debugging) {
+ printf("Dump of NFA for '%s' ...\n", nf->nf_name);
+ dumpnfa(&gr->gr_ll, nf);
+ }
+ printf("Making DFA for '%s' ...\n", nf->nf_name);
+ d = adddfa(g, nf->nf_type, nf->nf_name);
+ makedfa(gr, gr->gr_nfa[i], d);
+ }
+
+ return g;
+}
+
+grammar *
+pgen(n)
+ node *n;
+{
+ nfagrammar *gr;
+ grammar *g;
+
+ gr = metacompile(n);
+ g = maketables(gr);
+ translatelabels(g);
+ addfirstsets(g);
+ return g;
+}
+
+
+/*
+
+Description
+-----------
+
+Input is a grammar in extended BNF (using * for repetition, + for
+at-least-once repetition, [] for optional parts, | for alternatives and
+() for grouping). This has already been parsed and turned into a parse
+tree.
+
+Each rule is considered as a regular expression in its own right.
+It is turned into a Non-deterministic Finite Automaton (NFA), which
+is then turned into a Deterministic Finite Automaton (DFA), which is then
+optimized to reduce the number of states. See [Aho&Ullman 77] chapter 3,
+or similar compiler books (this technique is more often used for lexical
+analyzers).
+
+The DFA's are used by the parser as parsing tables in a special way
+that's probably unique. Before they are usable, the FIRST sets of all
+non-terminals are computed.
+
+Reference
+---------
+
+[Aho&Ullman 77]
+ Aho&Ullman, Principles of Compiler Design, Addison-Wesley 1977
+ (first edition)
+
+*/
--- /dev/null
+/* Parser generator interface */
+
+extern grammar gram;
+
+extern grammar *meta_grammar PROTO((void));
+extern grammar *pgen PROTO((node *));
--- /dev/null
+/* Parser generator main program */
+
+#include <stdio.h>
+
+#include "PROTO.h"
+#include "grammar.h"
+#include "node.h"
+#include "parsetok.h"
+#include "pgen.h"
+
+int debugging;
+
+#ifdef THINK_C
+char *
+askfile()
+{
+ char buf[256];
+ static char name[256];
+ printf("Input file name: ");
+ if (fgets(buf, sizeof buf, stdin) == NULL) {
+ printf("EOF\n");
+ exit(1);
+ }
+ if (sscanf(buf, " %s ", name) != 1) {
+ printf("No file\n");
+ exit(1);
+ }
+ return name;
+}
+#endif
+
+grammar *
+getgrammar(filename)
+ char *filename;
+{
+ FILE *fp;
+ node *n;
+ grammar *g0, *g;
+
+ fp = fopen(filename, "r");
+ if (fp == NULL) {
+ perror(filename);
+ exit(1);
+ }
+ g0 = meta_grammar();
+ n = NULL;
+ parsefile(fp, g0, g0->g_start, (char *)NULL, (char *)NULL, &n);
+ fclose(fp);
+ if (n == NULL) {
+ fprintf(stderr, "Parsing error.\n");
+ exit(1);
+ }
+ g = pgen(n);
+ if (g == NULL) {
+ printf("Bad grammar.\n");
+ exit(1);
+ }
+ return g;
+}
+
+main(argc, argv)
+ int argc;
+ char **argv;
+{
+ grammar *g;
+ node *n;
+ FILE *fp;
+ char *filename;
+
+#ifdef THINK_C
+ filename = askfile();
+#else
+ if (argc != 2) {
+ fprintf(stderr, "usage: %s grammar\n", argv[0]);
+ exit(2);
+ }
+ filename = argv[1];
+#endif
+ g = getgrammar(filename);
+ fp = fopen("graminit.c", "w");
+ if (fp == NULL) {
+ perror("graminit.c");
+ exit(1);
+ }
+ printf("Writing graminit.c ...\n");
+ printgrammar(g, fp);
+ fclose(fp);
+ fp = fopen("graminit.h", "w");
+ if (fp == NULL) {
+ perror("graminit.h");
+ exit(1);
+ }
+ printf("Writing graminit.h ...\n");
+ printnonterminals(g, fp);
+ fclose(fp);
+ exit(0);
+}
+
+void
+fatal(msg)
+ char *msg;
+{
+ fprintf(stderr, "pgen: FATAL ERROR: %s\n", msg);
+ exit(1);
+}
+
+/* TO DO:
+
+ - improve user interface
+ - check for duplicate definitions of names (instead of fatal err)
+*/
--- /dev/null
+/* Print a bunch of C initializers that represent a grammar */
+
+#include <stdio.h>
+
+#include "PROTO.h"
+#include "grammar.h"
+
+static void
+printarcs(i, d, fp)
+ int i;
+ dfa *d;
+ FILE *fp;
+{
+ arc *a;
+ state *s;
+ int j, k;
+
+ s = d->d_state;
+ for (j = 0; j < d->d_nstates; j++, s++) {
+ fprintf(fp, "static arc arcs_%d_%d[%d] = {\n",
+ i, j, s->s_narcs);
+ a = s->s_arc;
+ for (k = 0; k < s->s_narcs; k++, a++)
+ fprintf(fp, "\t{%d, %d},\n", a->a_lbl, a->a_arrow);
+ fprintf(fp, "};\n");
+ }
+}
+
+static void
+printstates(g, fp)
+ grammar *g;
+ FILE *fp;
+{
+ state *s;
+ dfa *d;
+ int i, j;
+
+ d = g->g_dfa;
+ for (i = 0; i < g->g_ndfas; i++, d++) {
+ printarcs(i, d, fp);
+ fprintf(fp, "static state states_%d[%d] = {\n",
+ i, d->d_nstates);
+ s = d->d_state;
+ for (j = 0; j < d->d_nstates; j++, s++)
+ fprintf(fp, "\t{%d, arcs_%d_%d},\n",
+ s->s_narcs, i, j);
+ fprintf(fp, "};\n");
+ }
+}
+
+static void
+printdfas(g, fp)
+ grammar *g;
+ FILE *fp;
+{
+ dfa *d;
+ int i, j;
+
+ printstates(g, fp);
+ fprintf(fp, "static dfa dfas[%d] = {\n", g->g_ndfas);
+ d = g->g_dfa;
+ for (i = 0; i < g->g_ndfas; i++, d++) {
+ fprintf(fp, "\t{%d, \"%s\", %d, %d, states_%d,\n",
+ d->d_type, d->d_name, d->d_initial, d->d_nstates, i);
+ fprintf(fp, "\t \"");
+ for (j = 0; j < NBYTES(g->g_ll.ll_nlabels); j++)
+ fprintf(fp, "\\%03o", d->d_first[j] & 0xff);
+ fprintf(fp, "\"},\n");
+ }
+ fprintf(fp, "};\n");
+}
+
+static void
+printlabels(g, fp)
+ grammar *g;
+ FILE *fp;
+{
+ label *l;
+ int i;
+
+ fprintf(fp, "static label labels[%d] = {\n", g->g_ll.ll_nlabels);
+ l = g->g_ll.ll_label;
+ for (i = g->g_ll.ll_nlabels; --i >= 0; l++) {
+ if (l->lb_str == NULL)
+ fprintf(fp, "\t{%d, 0},\n", l->lb_type);
+ else
+ fprintf(fp, "\t{%d, \"%s\"},\n",
+ l->lb_type, l->lb_str);
+ }
+ fprintf(fp, "};\n");
+}
+
+void
+printgrammar(g, fp)
+ grammar *g;
+ FILE *fp;
+{
+ fprintf(fp, "#include \"PROTO.h\"\n");
+ fprintf(fp, "#include \"grammar.h\"\n");
+ printdfas(g, fp);
+ printlabels(g, fp);
+ fprintf(fp, "grammar gram = {\n");
+ fprintf(fp, "\t%d,\n", g->g_ndfas);
+ fprintf(fp, "\tdfas,\n");
+ fprintf(fp, "\t{%d, labels},\n", g->g_ll.ll_nlabels);
+ fprintf(fp, "\t%d\n", g->g_start);
+ fprintf(fp, "};\n");
+}
+
+void
+printnonterminals(g, fp)
+ grammar *g;
+ FILE *fp;
+{
+ dfa *d;
+ int i;
+
+ d = g->g_dfa;
+ for (i = g->g_ndfas; --i >= 0; d++)
+ fprintf(fp, "#define %s %d\n", d->d_name, d->d_type);
+}
--- /dev/null
+/* Tokenizer implementation */
+
+/* XXX This is rather old, should be restructured perhaps */
+/* XXX Need a better interface to report errors than writing to stderr */
+
+#include <stdio.h>
+#include <ctype.h>
+#include "string.h"
+
+#include "PROTO.h"
+#include "malloc.h"
+#include "tokenizer.h"
+#include "errcode.h"
+
+#ifdef THINK_C
+#define TABSIZE 4
+#endif
+
+#ifndef TABSIZE
+#define TABSIZE 8
+#endif
+
+/* Token names */
+
+char *tok_name[] = {
+ "ENDMARKER",
+ "NAME",
+ "NUMBER",
+ "STRING",
+ "NEWLINE",
+ "INDENT",
+ "DEDENT",
+ "LPAR",
+ "RPAR",
+ "LSQB",
+ "RSQB",
+ "COLON",
+ "COMMA",
+ "SEMI",
+ "PLUS",
+ "MINUS",
+ "STAR",
+ "SLASH",
+ "VBAR",
+ "AMPER",
+ "LESS",
+ "GREATER",
+ "EQUAL",
+ "DOT",
+ "PERCENT",
+ "BACKQUOTE",
+ "LBRACE",
+ "RBRACE",
+ "OP",
+ "<ERRORTOKEN>",
+ "<N_TOKENS>"
+};
+
+
+/* Create and initialize a new tok_state structure */
+
+static struct tok_state *
+tok_new()
+{
+ struct tok_state *tok = NEW(struct tok_state, 1);
+ if (tok == NULL)
+ return NULL;
+ tok->buf = tok->cur = tok->end = tok->inp = NULL;
+ tok->done = E_OK;
+ tok->fp = NULL;
+ tok->tabsize = TABSIZE;
+ tok->indent = 0;
+ tok->indstack[0] = 0;
+ tok->atbol = 1;
+ tok->pendin = 0;
+ tok->prompt = tok->nextprompt = NULL;
+ tok->lineno = 0;
+ return tok;
+}
+
+
+/* Set up tokenizer for string */
+
+struct tok_state *
+tok_setups(str)
+ char *str;
+{
+ struct tok_state *tok = tok_new();
+ if (tok == NULL)
+ return NULL;
+ tok->buf = tok->cur = str;
+ tok->end = tok->inp = strchr(str, '\0');
+ return tok;
+}
+
+
+/* Set up tokenizer for string */
+
+struct tok_state *
+tok_setupf(fp, ps1, ps2)
+ FILE *fp;
+ char *ps1, *ps2;
+{
+ struct tok_state *tok = tok_new();
+ if (tok == NULL)
+ return NULL;
+ if ((tok->buf = NEW(char, BUFSIZ)) == NULL) {
+ DEL(tok);
+ return NULL;
+ }
+ tok->cur = tok->inp = tok->buf;
+ tok->end = tok->buf + BUFSIZ;
+ tok->fp = fp;
+ tok->prompt = ps1;
+ tok->nextprompt = ps2;
+ return tok;
+}
+
+
+/* Free a tok_state structure */
+
+void
+tok_free(tok)
+ struct tok_state *tok;
+{
+ /* XXX really need a separate flag to say 'my buffer' */
+ if (tok->fp != NULL && tok->buf != NULL)
+ DEL(tok->buf);
+ DEL(tok);
+}
+
+
+/* Get next char, updating state; error code goes into tok->done */
+
+static int
+tok_nextc(tok)
+ register struct tok_state *tok;
+{
+ if (tok->done != E_OK)
+ return EOF;
+
+ for (;;) {
+ if (tok->cur < tok->inp)
+ return *tok->cur++;
+ if (tok->fp == NULL) {
+ tok->done = E_EOF;
+ return EOF;
+ }
+ if (tok->inp > tok->buf && tok->inp[-1] == '\n')
+ tok->inp = tok->buf;
+ if (tok->inp == tok->end) {
+ int n = tok->end - tok->buf;
+ char *new = tok->buf;
+ RESIZE(new, char, n+n);
+ if (new == NULL) {
+ fprintf(stderr, "tokenizer out of mem\n");
+ tok->done = E_NOMEM;
+ return EOF;
+ }
+ tok->buf = new;
+ tok->inp = tok->buf + n;
+ tok->end = tok->inp + n;
+ }
+#ifdef USE_READLINE
+ if (tok->prompt != NULL) {
+ extern char *readline PROTO((char *prompt));
+ static int been_here;
+ if (!been_here) {
+ /* Force rebind of TAB to insert-tab */
+ extern int rl_insert();
+ rl_bind_key('\t', rl_insert);
+ been_here++;
+ }
+ if (tok->buf != NULL)
+ free(tok->buf);
+ tok->buf = readline(tok->prompt);
+ (void) intrcheck(); /* Clear pending interrupt */
+ if (tok->nextprompt != NULL)
+ tok->prompt = tok->nextprompt;
+ /* XXX different semantics w/o readline()! */
+ if (tok->buf == NULL) {
+ tok->done = E_EOF;
+ }
+ else {
+ unsigned int n = strlen(tok->buf);
+ if (n > 0)
+ add_history(tok->buf);
+ /* Append the '\n' that readline()
+ doesn't give us, for the tokenizer... */
+ tok->buf = realloc(tok->buf, n+2);
+ if (tok->buf == NULL)
+ tok->done = E_NOMEM;
+ else {
+ tok->end = tok->buf + n;
+ *tok->end++ = '\n';
+ *tok->end = '\0';
+ tok->inp = tok->end;
+ tok->cur = tok->buf;
+ }
+ }
+ }
+ else
+#endif
+ {
+ tok->cur = tok->inp;
+ if (tok->prompt != NULL && tok->inp == tok->buf) {
+ fprintf(stderr, "%s", tok->prompt);
+ tok->prompt = tok->nextprompt;
+ }
+ tok->done = fgets_intr(tok->inp,
+ (int)(tok->end - tok->inp), tok->fp);
+ }
+ if (tok->done != E_OK) {
+ if (tok->prompt != NULL)
+ fprintf(stderr, "\n");
+ return EOF;
+ }
+ tok->inp = strchr(tok->inp, '\0');
+ }
+}
+
+
+/* Back-up one character */
+
+static void
+tok_backup(tok, c)
+ register struct tok_state *tok;
+ register int c;
+{
+ if (c != EOF) {
+ if (--tok->cur < tok->buf) {
+ fprintf(stderr, "tok_backup: begin of buffer\n");
+ abort();
+ }
+ if (*tok->cur != c)
+ *tok->cur = c;
+ }
+}
+
+
+/* Return the token corresponding to a single character */
+
+int
+tok_1char(c)
+ int c;
+{
+ switch (c) {
+ case '(': return LPAR;
+ case ')': return RPAR;
+ case '[': return LSQB;
+ case ']': return RSQB;
+ case ':': return COLON;
+ case ',': return COMMA;
+ case ';': return SEMI;
+ case '+': return PLUS;
+ case '-': return MINUS;
+ case '*': return STAR;
+ case '/': return SLASH;
+ case '|': return VBAR;
+ case '&': return AMPER;
+ case '<': return LESS;
+ case '>': return GREATER;
+ case '=': return EQUAL;
+ case '.': return DOT;
+ case '%': return PERCENT;
+ case '`': return BACKQUOTE;
+ case '{': return LBRACE;
+ case '}': return RBRACE;
+ default: return OP;
+ }
+}
+
+
+/* Get next token, after space stripping etc. */
+
+int
+tok_get(tok, p_start, p_end)
+ register struct tok_state *tok; /* In/out: tokenizer state */
+ char **p_start, **p_end; /* Out: point to start/end of token */
+{
+ register int c;
+
+ /* Get indentation level */
+ if (tok->atbol) {
+ register int col = 0;
+ tok->atbol = 0;
+ tok->lineno++;
+ for (;;) {
+ c = tok_nextc(tok);
+ if (c == ' ')
+ col++;
+ else if (c == '\t')
+ col = (col/tok->tabsize + 1) * tok->tabsize;
+ else
+ break;
+ }
+ tok_backup(tok, c);
+ if (col == tok->indstack[tok->indent]) {
+ /* No change */
+ }
+ else if (col > tok->indstack[tok->indent]) {
+ /* Indent -- always one */
+ if (tok->indent+1 >= MAXINDENT) {
+ fprintf(stderr, "excessive indent\n");
+ tok->done = E_TOKEN;
+ return ERRORTOKEN;
+ }
+ tok->pendin++;
+ tok->indstack[++tok->indent] = col;
+ }
+ else /* col < tok->indstack[tok->indent] */ {
+ /* Dedent -- any number, must be consistent */
+ while (tok->indent > 0 &&
+ col < tok->indstack[tok->indent]) {
+ tok->indent--;
+ tok->pendin--;
+ }
+ if (col != tok->indstack[tok->indent]) {
+ fprintf(stderr, "inconsistent dedent\n");
+ tok->done = E_TOKEN;
+ return ERRORTOKEN;
+ }
+ }
+ }
+
+ *p_start = *p_end = tok->cur;
+
+ /* Return pending indents/dedents */
+ if (tok->pendin != 0) {
+ if (tok->pendin < 0) {
+ tok->pendin++;
+ return DEDENT;
+ }
+ else {
+ tok->pendin--;
+ return INDENT;
+ }
+ }
+
+ again:
+ /* Skip spaces */
+ do {
+ c = tok_nextc(tok);
+ } while (c == ' ' || c == '\t');
+
+ /* Set start of current token */
+ *p_start = tok->cur - 1;
+
+ /* Skip comment */
+ if (c == '#') {
+ /* Hack to allow overriding the tabsize in the file.
+ This is also recognized by vi, when it occurs near the
+ beginning or end of the file. (Will vi never die...?) */
+ int x;
+ if (sscanf(tok->cur, " vi:set tabsize=%d:", &x) == 1 &&
+ x >= 1 && x <= 40) {
+ fprintf(stderr, "# vi:set tabsize=%d:\n", x);
+ tok->tabsize = x;
+ }
+ do {
+ c = tok_nextc(tok);
+ } while (c != EOF && c != '\n');
+ }
+
+ /* Check for EOF and errors now */
+ if (c == EOF)
+ return tok->done == E_EOF ? ENDMARKER : ERRORTOKEN;
+
+ /* Identifier (most frequent token!) */
+ if (isalpha(c) || c == '_') {
+ do {
+ c = tok_nextc(tok);
+ } while (isalnum(c) || c == '_');
+ tok_backup(tok, c);
+ *p_end = tok->cur;
+ return NAME;
+ }
+
+ /* Newline */
+ if (c == '\n') {
+ tok->atbol = 1;
+ *p_end = tok->cur - 1; /* Leave '\n' out of the string */
+ return NEWLINE;
+ }
+
+ /* Number */
+ if (isdigit(c)) {
+ if (c == '0') {
+ /* Hex or octal */
+ c = tok_nextc(tok);
+ if (c == '.')
+ goto fraction;
+ if (c == 'x' || c == 'X') {
+ /* Hex */
+ do {
+ c = tok_nextc(tok);
+ } while (isxdigit(c));
+ }
+ else {
+ /* Octal; c is first char of it */
+ /* There's no 'isoctdigit' macro, sigh */
+ while ('0' <= c && c < '8') {
+ c = tok_nextc(tok);
+ }
+ }
+ }
+ else {
+ /* Decimal */
+ do {
+ c = tok_nextc(tok);
+ } while (isdigit(c));
+ /* Accept floating point numbers.
+ XXX This accepts incomplete things like 12e or 1e+;
+ worry about that at run-time.
+ XXX Doesn't accept numbers starting with a dot */
+ if (c == '.') {
+ fraction:
+ /* Fraction */
+ do {
+ c = tok_nextc(tok);
+ } while (isdigit(c));
+ }
+ if (c == 'e' || c == 'E') {
+ /* Exponent part */
+ c = tok_nextc(tok);
+ if (c == '+' || c == '-')
+ c = tok_nextc(tok);
+ while (isdigit(c)) {
+ c = tok_nextc(tok);
+ }
+ }
+ }
+ tok_backup(tok, c);
+ *p_end = tok->cur;
+ return NUMBER;
+ }
+
+ /* String */
+ if (c == '\'') {
+ for (;;) {
+ c = tok_nextc(tok);
+ if (c == '\n' || c == EOF) {
+ tok->done = E_TOKEN;
+ return ERRORTOKEN;
+ }
+ if (c == '\\') {
+ c = tok_nextc(tok);
+ *p_end = tok->cur;
+ if (c == '\n' || c == EOF) {
+ tok->done = E_TOKEN;
+ return ERRORTOKEN;
+ }
+ continue;
+ }
+ if (c == '\'')
+ break;
+ }
+ *p_end = tok->cur;
+ return STRING;
+ }
+
+ /* Line continuation */
+ if (c == '\\') {
+ c = tok_nextc(tok);
+ if (c != '\n') {
+ tok->done = E_TOKEN;
+ return ERRORTOKEN;
+ }
+ goto again; /* Read next line */
+ }
+
+ /* Punctuation character */
+ *p_end = tok->cur;
+ return tok_1char(c);
+}
+
+
+#ifdef DEBUG
+
+void
+tok_dump(type, start, end)
+ int type;
+ char *start, *end;
+{
+ printf("%s", tok_name[type]);
+ if (type == NAME || type == NUMBER || type == STRING || type == OP)
+ printf("(%.*s)", (int)(end - start), start);
+}
+
+#endif
--- /dev/null
+/* Tokenizer interface */
+
+#include "token.h" /* For token types */
+
+#define MAXINDENT 100 /* Max indentation level */
+
+/* Tokenizer state */
+struct tok_state {
+ /* Input state; buf <= cur <= inp <= end */
+ /* NB an entire token must fit in the buffer */
+ char *buf; /* Input buffer */
+ char *cur; /* Next character in buffer */
+ char *inp; /* End of data in buffer */
+ char *end; /* End of input buffer */
+ int done; /* 0 normally, 1 at EOF, -1 after error */
+ FILE *fp; /* Rest of input; NULL if tokenizing a string */
+ int tabsize; /* Tab spacing */
+ int indent; /* Current indentation index */
+ int indstack[MAXINDENT]; /* Stack of indents */
+ int atbol; /* Nonzero if at begin of new line */
+ int pendin; /* Pending indents (if > 0) or dedents (if < 0) */
+ char *prompt, *nextprompt; /* For interactive prompting */
+ int lineno; /* Current line number */
+};
+
+extern struct tok_state *tok_setups PROTO((char *));
+extern struct tok_state *tok_setupf PROTO((FILE *, char *ps1, char *ps2));
+extern void tok_free PROTO((struct tok_state *));
+extern int tok_get PROTO((struct tok_state *, char **, char **));
--- /dev/null
+/* Functions used by cgen output */
+
+#include <stdio.h>
+
+#include "PROTO.h"
+#include "object.h"
+#include "intobject.h"
+#include "floatobject.h"
+#include "stringobject.h"
+#include "tupleobject.h"
+#include "listobject.h"
+#include "methodobject.h"
+#include "moduleobject.h"
+#include "modsupport.h"
+#include "import.h"
+#include "cgensupport.h"
+#include "errors.h"
+
+
+/* Functions to construct return values */
+
+object *
+mknewcharobject(c)
+ int c;
+{
+ char ch[1];
+ ch[0] = c;
+ return newsizedstringobject(ch, 1);
+}
+
+/* Functions to extract arguments.
+ These needs to know the total number of arguments supplied,
+ since the argument list is a tuple only of there is more than
+ one argument. */
+
+int
+getiobjectarg(args, nargs, i, p_arg)
+ register object *args;
+ int nargs, i;
+ object **p_arg;
+{
+ if (nargs != 1) {
+ if (args == NULL || !is_tupleobject(args) ||
+ nargs != gettuplesize(args) ||
+ i < 0 || i >= nargs) {
+ return err_badarg();
+ }
+ else {
+ args = gettupleitem(args, i);
+ }
+ }
+ if (args == NULL) {
+ return err_badarg();
+ }
+ *p_arg = args;
+ return 1;
+}
+
+int
+getilongarg(args, nargs, i, p_arg)
+ register object *args;
+ int nargs, i;
+ long *p_arg;
+{
+ if (nargs != 1) {
+ if (args == NULL || !is_tupleobject(args) ||
+ nargs != gettuplesize(args) ||
+ i < 0 || i >= nargs) {
+ return err_badarg();
+ }
+ args = gettupleitem(args, i);
+ }
+ if (args == NULL || !is_intobject(args)) {
+ return err_badarg();
+ }
+ *p_arg = getintvalue(args);
+ return 1;
+}
+
+int
+getishortarg(args, nargs, i, p_arg)
+ register object *args;
+ int nargs, i;
+ short *p_arg;
+{
+ long x;
+ if (!getilongarg(args, nargs, i, &x))
+ return 0;
+ *p_arg = x;
+ return 1;
+}
+
+static int
+extractdouble(v, p_arg)
+ register object *v;
+ double *p_arg;
+{
+ if (v == NULL) {
+ /* Fall through to error return at end of function */
+ }
+ else if (is_floatobject(v)) {
+ *p_arg = GETFLOATVALUE((floatobject *)v);
+ return 1;
+ }
+ else if (is_intobject(v)) {
+ *p_arg = GETINTVALUE((intobject *)v);
+ return 1;
+ }
+ return err_badarg();
+}
+
+static int
+extractfloat(v, p_arg)
+ register object *v;
+ float *p_arg;
+{
+ if (v == NULL) {
+ /* Fall through to error return at end of function */
+ }
+ else if (is_floatobject(v)) {
+ *p_arg = GETFLOATVALUE((floatobject *)v);
+ return 1;
+ }
+ else if (is_intobject(v)) {
+ *p_arg = GETINTVALUE((intobject *)v);
+ return 1;
+ }
+ return err_badarg();
+}
+
+int
+getifloatarg(args, nargs, i, p_arg)
+ register object *args;
+ int nargs, i;
+ float *p_arg;
+{
+ object *v;
+ float x;
+ if (!getiobjectarg(args, nargs, i, &v))
+ return 0;
+ if (!extractfloat(v, &x))
+ return 0;
+ *p_arg = x;
+ return 1;
+}
+
+int
+getistringarg(args, nargs, i, p_arg)
+ object *args;
+ int nargs, i;
+ string *p_arg;
+{
+ object *v;
+ if (!getiobjectarg(args, nargs, i, &v))
+ return NULL;
+ if (!is_stringobject(v)) {
+ return err_badarg();
+ }
+ *p_arg = getstringvalue(v);
+ return 1;
+}
+
+int
+getichararg(args, nargs, i, p_arg)
+ object *args;
+ int nargs, i;
+ char *p_arg;
+{
+ string x;
+ if (!getistringarg(args, nargs, i, &x))
+ return 0;
+ if (x[0] == '\0' || x[1] != '\0') {
+ /* Not exactly one char */
+ return err_badarg();
+ }
+ *p_arg = x[0];
+ return 1;
+}
+
+int
+getilongarraysize(args, nargs, i, p_arg)
+ object *args;
+ int nargs, i;
+ long *p_arg;
+{
+ object *v;
+ if (!getiobjectarg(args, nargs, i, &v))
+ return 0;
+ if (is_tupleobject(v)) {
+ *p_arg = gettuplesize(v);
+ return 1;
+ }
+ if (is_listobject(v)) {
+ *p_arg = getlistsize(v);
+ return 1;
+ }
+ return err_badarg();
+}
+
+int
+getishortarraysize(args, nargs, i, p_arg)
+ object *args;
+ int nargs, i;
+ short *p_arg;
+{
+ long x;
+ if (!getilongarraysize(args, nargs, i, &x))
+ return 0;
+ *p_arg = x;
+ return 1;
+}
+
+/* XXX The following four are too similar. Should share more code. */
+
+int
+getilongarray(args, nargs, i, n, p_arg)
+ object *args;
+ int nargs, i;
+ int n;
+ long *p_arg; /* [n] */
+{
+ object *v, *w;
+ if (!getiobjectarg(args, nargs, i, &v))
+ return 0;
+ if (is_tupleobject(v)) {
+ if (gettuplesize(v) != n) {
+ return err_badarg();
+ }
+ for (i = 0; i < n; i++) {
+ w = gettupleitem(v, i);
+ if (!is_intobject(w)) {
+ return err_badarg();
+ }
+ p_arg[i] = getintvalue(w);
+ }
+ return 1;
+ }
+ else if (is_listobject(v)) {
+ if (getlistsize(v) != n) {
+ return err_badarg();
+ }
+ for (i = 0; i < n; i++) {
+ w = getlistitem(v, i);
+ if (!is_intobject(w)) {
+ return err_badarg();
+ }
+ p_arg[i] = getintvalue(w);
+ }
+ return 1;
+ }
+ else {
+ return err_badarg();
+ }
+}
+
+int
+getishortarray(args, nargs, i, n, p_arg)
+ object *args;
+ int nargs, i;
+ int n;
+ short *p_arg; /* [n] */
+{
+ object *v, *w;
+ if (!getiobjectarg(args, nargs, i, &v))
+ return 0;
+ if (is_tupleobject(v)) {
+ if (gettuplesize(v) != n) {
+ return err_badarg();
+ }
+ for (i = 0; i < n; i++) {
+ w = gettupleitem(v, i);
+ if (!is_intobject(w)) {
+ return err_badarg();
+ }
+ p_arg[i] = getintvalue(w);
+ }
+ return 1;
+ }
+ else if (is_listobject(v)) {
+ if (getlistsize(v) != n) {
+ return err_badarg();
+ }
+ for (i = 0; i < n; i++) {
+ w = getlistitem(v, i);
+ if (!is_intobject(w)) {
+ return err_badarg();
+ }
+ p_arg[i] = getintvalue(w);
+ }
+ return 1;
+ }
+ else {
+ return err_badarg();
+ }
+}
+
+int
+getidoublearray(args, nargs, i, n, p_arg)
+ object *args;
+ int nargs, i;
+ int n;
+ double *p_arg; /* [n] */
+{
+ object *v, *w;
+ if (!getiobjectarg(args, nargs, i, &v))
+ return 0;
+ if (is_tupleobject(v)) {
+ if (gettuplesize(v) != n) {
+ return err_badarg();
+ }
+ for (i = 0; i < n; i++) {
+ w = gettupleitem(v, i);
+ if (!extractdouble(w, &p_arg[i]))
+ return 0;
+ }
+ return 1;
+ }
+ else if (is_listobject(v)) {
+ if (getlistsize(v) != n) {
+ return err_badarg();
+ }
+ for (i = 0; i < n; i++) {
+ w = getlistitem(v, i);
+ if (!extractdouble(w, &p_arg[i]))
+ return 0;
+ }
+ return 1;
+ }
+ else {
+ return err_badarg();
+ }
+}
+
+int
+getifloatarray(args, nargs, i, n, p_arg)
+ object *args;
+ int nargs, i;
+ int n;
+ float *p_arg; /* [n] */
+{
+ object *v, *w;
+ if (!getiobjectarg(args, nargs, i, &v))
+ return 0;
+ if (is_tupleobject(v)) {
+ if (gettuplesize(v) != n) {
+ return err_badarg();
+ }
+ for (i = 0; i < n; i++) {
+ w = gettupleitem(v, i);
+ if (!extractfloat(w, &p_arg[i]))
+ return 0;
+ }
+ return 1;
+ }
+ else if (is_listobject(v)) {
+ if (getlistsize(v) != n) {
+ return err_badarg();
+ }
+ for (i = 0; i < n; i++) {
+ w = getlistitem(v, i);
+ if (!extractfloat(w, &p_arg[i]))
+ return 0;
+ }
+ return 1;
+ }
+ else {
+ return err_badarg();
+ }
+}
--- /dev/null
+/* Error handling -- see also run.c */
+
+/* New error handling interface.
+
+ The following problem exists (existed): methods of built-in modules
+ are called with 'self' and 'args' arguments, but without a context
+ argument, so they have no way to raise a specific exception.
+ The same is true for the object implementations: no context argument.
+ The old convention was to set 'errno' and to return NULL.
+ The caller (usually call_function() in eval.c) detects the NULL
+ return value and then calls puterrno(ctx) to turn the errno value
+ into a true exception. Problems with this approach are:
+ - it used standard errno values to indicate Python-specific errors,
+ but this means that when such an error code is reported by UNIX the
+ user gets a confusing message
+ - errno is a global variable, which makes extensions to a multi-
+ threading environment difficult; e.g., in IRIX, multi-threaded
+ programs must use the function getoserror() (sp.?) instead of
+ looking in errno
+ - there is no portable way to add new error numbers for specic
+ situations -- the value space for errno is reserved to the OS, yet
+ the way to turn module-specific errors into a module-specific
+ exception requires module-specific values for errno
+ - there is no way to add a more situation-specific message to an
+ error.
+
+ The new interface solves all these problems. To return an error, a
+ built-in function calls err_set(exception), err_set(valexception,
+ value) or err_setstr(exception, string), and returns NULL. These
+ functions save the value for later use by puterrno(). To adapt this
+ scheme to a multi-threaded environment, only the implementation of
+ err_setval() has to be changed.
+*/
+
+#include <stdio.h>
+
+#include "PROTO.h"
+#include "object.h"
+#include "stringobject.h"
+#include "errors.h"
+
+/* Last exception stored by err_setval() */
+
+static object *last_exception;
+static object *last_exc_val;
+
+void
+err_setval(exception, value)
+ object *exception;
+ object *value;
+{
+ if (last_exception != NULL)
+ DECREF(last_exception);
+ if (exception != NULL)
+ INCREF(exception);
+ last_exception = exception;
+
+ if (last_exc_val != NULL)
+ DECREF(last_exc_val);
+ if (value != NULL)
+ INCREF(value);
+ last_exc_val = value;
+}
+
+void
+err_set(exception)
+ object *exception;
+{
+ err_setval(exception, (object *)NULL);
+}
+
+void
+err_setstr(exception, string)
+ object *exception;
+ char *string;
+{
+ object *value = newstringobject(string);
+ err_setval(exception, value);
+ if (value != NULL)
+ DECREF(value);
+}
+
+int
+err_occurred()
+{
+ return last_exception != NULL;
+}
+
+void
+err_get(p_exc, p_val)
+ object **p_exc;
+ object **p_val;
+{
+ *p_exc = last_exception;
+ last_exception = NULL;
+ *p_val = last_exc_val;
+ last_exc_val = NULL;
+}
+
+void
+err_clear()
+{
+ if (last_exception != NULL) {
+ DECREF(last_exception);
+ last_exception = NULL;
+ }
+ if (last_exc_val != NULL) {
+ DECREF(last_exc_val);
+ last_exc_val = NULL;
+ }
+}
--- /dev/null
+/* Portable fmod(x, y) implementation for systems that don't have it */
+
+#include <math.h>
+#include <errno.h>
+
+extern int errno;
+
+double
+fmod(x, y)
+ double x, y;
+{
+ double i, f;
+
+ if (y == 0.0) {
+ errno = EDOM;
+ return 0.0;
+ }
+
+ /* return f such that x = i*y + f for some integer i
+ such that |f| < |y| and f has the same sign as x */
+
+ i = floor(x/y);
+ f = x - i*y;
+ if ((x < 0.0) != (y < 0.0))
+ f = f-y;
+ return f;
+}
--- /dev/null
+#include "PROTO.h"
+#include "grammar.h"
+static arc arcs_0_0[3] = {
+ {2, 1},
+ {3, 1},
+ {4, 2},
+};
+static arc arcs_0_1[1] = {
+ {0, 1},
+};
+static arc arcs_0_2[1] = {
+ {2, 1},
+};
+static state states_0[3] = {
+ {3, arcs_0_0},
+ {1, arcs_0_1},
+ {1, arcs_0_2},
+};
+static arc arcs_1_0[3] = {
+ {2, 0},
+ {6, 0},
+ {7, 1},
+};
+static arc arcs_1_1[1] = {
+ {0, 1},
+};
+static state states_1[2] = {
+ {3, arcs_1_0},
+ {1, arcs_1_1},
+};
+static arc arcs_2_0[1] = {
+ {9, 1},
+};
+static arc arcs_2_1[1] = {
+ {2, 2},
+};
+static arc arcs_2_2[1] = {
+ {0, 2},
+};
+static state states_2[3] = {
+ {1, arcs_2_0},
+ {1, arcs_2_1},
+ {1, arcs_2_2},
+};
+static arc arcs_3_0[1] = {
+ {9, 1},
+};
+static arc arcs_3_1[1] = {
+ {7, 2},
+};
+static arc arcs_3_2[1] = {
+ {0, 2},
+};
+static state states_3[3] = {
+ {1, arcs_3_0},
+ {1, arcs_3_1},
+ {1, arcs_3_2},
+};
+static arc arcs_4_0[1] = {
+ {12, 1},
+};
+static arc arcs_4_1[1] = {
+ {13, 2},
+};
+static arc arcs_4_2[1] = {
+ {14, 3},
+};
+static arc arcs_4_3[1] = {
+ {15, 4},
+};
+static arc arcs_4_4[1] = {
+ {16, 5},
+};
+static arc arcs_4_5[1] = {
+ {0, 5},
+};
+static state states_4[6] = {
+ {1, arcs_4_0},
+ {1, arcs_4_1},
+ {1, arcs_4_2},
+ {1, arcs_4_3},
+ {1, arcs_4_4},
+ {1, arcs_4_5},
+};
+static arc arcs_5_0[1] = {
+ {17, 1},
+};
+static arc arcs_5_1[2] = {
+ {18, 2},
+ {19, 3},
+};
+static arc arcs_5_2[1] = {
+ {19, 3},
+};
+static arc arcs_5_3[1] = {
+ {0, 3},
+};
+static state states_5[4] = {
+ {1, arcs_5_0},
+ {2, arcs_5_1},
+ {1, arcs_5_2},
+ {1, arcs_5_3},
+};
+static arc arcs_6_0[1] = {
+ {20, 1},
+};
+static arc arcs_6_1[2] = {
+ {21, 0},
+ {0, 1},
+};
+static state states_6[2] = {
+ {1, arcs_6_0},
+ {2, arcs_6_1},
+};
+static arc arcs_7_0[2] = {
+ {13, 1},
+ {17, 2},
+};
+static arc arcs_7_1[1] = {
+ {0, 1},
+};
+static arc arcs_7_2[1] = {
+ {18, 3},
+};
+static arc arcs_7_3[1] = {
+ {19, 1},
+};
+static state states_7[4] = {
+ {2, arcs_7_0},
+ {1, arcs_7_1},
+ {1, arcs_7_2},
+ {1, arcs_7_3},
+};
+static arc arcs_8_0[2] = {
+ {3, 1},
+ {4, 1},
+};
+static arc arcs_8_1[1] = {
+ {0, 1},
+};
+static state states_8[2] = {
+ {2, arcs_8_0},
+ {1, arcs_8_1},
+};
+static arc arcs_9_0[7] = {
+ {22, 1},
+ {23, 1},
+ {24, 1},
+ {25, 1},
+ {26, 1},
+ {27, 1},
+ {28, 1},
+};
+static arc arcs_9_1[1] = {
+ {0, 1},
+};
+static state states_9[2] = {
+ {7, arcs_9_0},
+ {1, arcs_9_1},
+};
+static arc arcs_10_0[1] = {
+ {29, 1},
+};
+static arc arcs_10_1[2] = {
+ {30, 0},
+ {2, 2},
+};
+static arc arcs_10_2[1] = {
+ {0, 2},
+};
+static state states_10[3] = {
+ {1, arcs_10_0},
+ {2, arcs_10_1},
+ {1, arcs_10_2},
+};
+static arc arcs_11_0[1] = {
+ {31, 1},
+};
+static arc arcs_11_1[2] = {
+ {32, 2},
+ {2, 3},
+};
+static arc arcs_11_2[2] = {
+ {21, 1},
+ {2, 3},
+};
+static arc arcs_11_3[1] = {
+ {0, 3},
+};
+static state states_11[4] = {
+ {1, arcs_11_0},
+ {2, arcs_11_1},
+ {2, arcs_11_2},
+ {1, arcs_11_3},
+};
+static arc arcs_12_0[1] = {
+ {33, 1},
+};
+static arc arcs_12_1[1] = {
+ {29, 2},
+};
+static arc arcs_12_2[1] = {
+ {2, 3},
+};
+static arc arcs_12_3[1] = {
+ {0, 3},
+};
+static state states_12[4] = {
+ {1, arcs_12_0},
+ {1, arcs_12_1},
+ {1, arcs_12_2},
+ {1, arcs_12_3},
+};
+static arc arcs_13_0[1] = {
+ {34, 1},
+};
+static arc arcs_13_1[2] = {
+ {35, 2},
+ {2, 3},
+};
+static arc arcs_13_2[1] = {
+ {2, 3},
+};
+static arc arcs_13_3[1] = {
+ {0, 3},
+};
+static state states_13[4] = {
+ {1, arcs_13_0},
+ {2, arcs_13_1},
+ {1, arcs_13_2},
+ {1, arcs_13_3},
+};
+static arc arcs_14_0[1] = {
+ {36, 1},
+};
+static arc arcs_14_1[1] = {
+ {2, 2},
+};
+static arc arcs_14_2[1] = {
+ {0, 2},
+};
+static state states_14[3] = {
+ {1, arcs_14_0},
+ {1, arcs_14_1},
+ {1, arcs_14_2},
+};
+static arc arcs_15_0[3] = {
+ {37, 1},
+ {38, 1},
+ {39, 1},
+};
+static arc arcs_15_1[1] = {
+ {0, 1},
+};
+static state states_15[2] = {
+ {3, arcs_15_0},
+ {1, arcs_15_1},
+};
+static arc arcs_16_0[1] = {
+ {40, 1},
+};
+static arc arcs_16_1[1] = {
+ {2, 2},
+};
+static arc arcs_16_2[1] = {
+ {0, 2},
+};
+static state states_16[3] = {
+ {1, arcs_16_0},
+ {1, arcs_16_1},
+ {1, arcs_16_2},
+};
+static arc arcs_17_0[1] = {
+ {41, 1},
+};
+static arc arcs_17_1[2] = {
+ {9, 2},
+ {2, 3},
+};
+static arc arcs_17_2[1] = {
+ {2, 3},
+};
+static arc arcs_17_3[1] = {
+ {0, 3},
+};
+static state states_17[4] = {
+ {1, arcs_17_0},
+ {2, arcs_17_1},
+ {1, arcs_17_2},
+ {1, arcs_17_3},
+};
+static arc arcs_18_0[1] = {
+ {42, 1},
+};
+static arc arcs_18_1[1] = {
+ {35, 2},
+};
+static arc arcs_18_2[2] = {
+ {21, 3},
+ {2, 4},
+};
+static arc arcs_18_3[1] = {
+ {35, 5},
+};
+static arc arcs_18_4[1] = {
+ {0, 4},
+};
+static arc arcs_18_5[1] = {
+ {2, 4},
+};
+static state states_18[6] = {
+ {1, arcs_18_0},
+ {1, arcs_18_1},
+ {2, arcs_18_2},
+ {1, arcs_18_3},
+ {1, arcs_18_4},
+ {1, arcs_18_5},
+};
+static arc arcs_19_0[2] = {
+ {43, 1},
+ {44, 2},
+};
+static arc arcs_19_1[1] = {
+ {13, 3},
+};
+static arc arcs_19_2[1] = {
+ {13, 4},
+};
+static arc arcs_19_3[2] = {
+ {21, 1},
+ {2, 5},
+};
+static arc arcs_19_4[1] = {
+ {43, 6},
+};
+static arc arcs_19_5[1] = {
+ {0, 5},
+};
+static arc arcs_19_6[2] = {
+ {45, 7},
+ {13, 8},
+};
+static arc arcs_19_7[1] = {
+ {2, 5},
+};
+static arc arcs_19_8[2] = {
+ {21, 9},
+ {2, 5},
+};
+static arc arcs_19_9[1] = {
+ {13, 8},
+};
+static state states_19[10] = {
+ {2, arcs_19_0},
+ {1, arcs_19_1},
+ {1, arcs_19_2},
+ {2, arcs_19_3},
+ {1, arcs_19_4},
+ {1, arcs_19_5},
+ {2, arcs_19_6},
+ {1, arcs_19_7},
+ {2, arcs_19_8},
+ {1, arcs_19_9},
+};
+static arc arcs_20_0[6] = {
+ {46, 1},
+ {47, 1},
+ {48, 1},
+ {49, 1},
+ {11, 1},
+ {50, 1},
+};
+static arc arcs_20_1[1] = {
+ {0, 1},
+};
+static state states_20[2] = {
+ {6, arcs_20_0},
+ {1, arcs_20_1},
+};
+static arc arcs_21_0[1] = {
+ {51, 1},
+};
+static arc arcs_21_1[1] = {
+ {32, 2},
+};
+static arc arcs_21_2[1] = {
+ {15, 3},
+};
+static arc arcs_21_3[1] = {
+ {16, 4},
+};
+static arc arcs_21_4[3] = {
+ {52, 1},
+ {53, 5},
+ {0, 4},
+};
+static arc arcs_21_5[1] = {
+ {15, 6},
+};
+static arc arcs_21_6[1] = {
+ {16, 7},
+};
+static arc arcs_21_7[1] = {
+ {0, 7},
+};
+static state states_21[8] = {
+ {1, arcs_21_0},
+ {1, arcs_21_1},
+ {1, arcs_21_2},
+ {1, arcs_21_3},
+ {3, arcs_21_4},
+ {1, arcs_21_5},
+ {1, arcs_21_6},
+ {1, arcs_21_7},
+};
+static arc arcs_22_0[1] = {
+ {54, 1},
+};
+static arc arcs_22_1[1] = {
+ {32, 2},
+};
+static arc arcs_22_2[1] = {
+ {15, 3},
+};
+static arc arcs_22_3[1] = {
+ {16, 4},
+};
+static arc arcs_22_4[2] = {
+ {53, 5},
+ {0, 4},
+};
+static arc arcs_22_5[1] = {
+ {15, 6},
+};
+static arc arcs_22_6[1] = {
+ {16, 7},
+};
+static arc arcs_22_7[1] = {
+ {0, 7},
+};
+static state states_22[8] = {
+ {1, arcs_22_0},
+ {1, arcs_22_1},
+ {1, arcs_22_2},
+ {1, arcs_22_3},
+ {2, arcs_22_4},
+ {1, arcs_22_5},
+ {1, arcs_22_6},
+ {1, arcs_22_7},
+};
+static arc arcs_23_0[1] = {
+ {55, 1},
+};
+static arc arcs_23_1[1] = {
+ {29, 2},
+};
+static arc arcs_23_2[1] = {
+ {56, 3},
+};
+static arc arcs_23_3[1] = {
+ {29, 4},
+};
+static arc arcs_23_4[1] = {
+ {15, 5},
+};
+static arc arcs_23_5[1] = {
+ {16, 6},
+};
+static arc arcs_23_6[2] = {
+ {53, 7},
+ {0, 6},
+};
+static arc arcs_23_7[1] = {
+ {15, 8},
+};
+static arc arcs_23_8[1] = {
+ {16, 9},
+};
+static arc arcs_23_9[1] = {
+ {0, 9},
+};
+static state states_23[10] = {
+ {1, arcs_23_0},
+ {1, arcs_23_1},
+ {1, arcs_23_2},
+ {1, arcs_23_3},
+ {1, arcs_23_4},
+ {1, arcs_23_5},
+ {2, arcs_23_6},
+ {1, arcs_23_7},
+ {1, arcs_23_8},
+ {1, arcs_23_9},
+};
+static arc arcs_24_0[1] = {
+ {57, 1},
+};
+static arc arcs_24_1[1] = {
+ {15, 2},
+};
+static arc arcs_24_2[1] = {
+ {16, 3},
+};
+static arc arcs_24_3[3] = {
+ {58, 1},
+ {59, 4},
+ {0, 3},
+};
+static arc arcs_24_4[1] = {
+ {15, 5},
+};
+static arc arcs_24_5[1] = {
+ {16, 6},
+};
+static arc arcs_24_6[1] = {
+ {0, 6},
+};
+static state states_24[7] = {
+ {1, arcs_24_0},
+ {1, arcs_24_1},
+ {1, arcs_24_2},
+ {3, arcs_24_3},
+ {1, arcs_24_4},
+ {1, arcs_24_5},
+ {1, arcs_24_6},
+};
+static arc arcs_25_0[1] = {
+ {60, 1},
+};
+static arc arcs_25_1[2] = {
+ {35, 2},
+ {0, 1},
+};
+static arc arcs_25_2[2] = {
+ {21, 3},
+ {0, 2},
+};
+static arc arcs_25_3[1] = {
+ {35, 4},
+};
+static arc arcs_25_4[1] = {
+ {0, 4},
+};
+static state states_25[5] = {
+ {1, arcs_25_0},
+ {2, arcs_25_1},
+ {2, arcs_25_2},
+ {1, arcs_25_3},
+ {1, arcs_25_4},
+};
+static arc arcs_26_0[2] = {
+ {3, 1},
+ {2, 2},
+};
+static arc arcs_26_1[1] = {
+ {0, 1},
+};
+static arc arcs_26_2[1] = {
+ {61, 3},
+};
+static arc arcs_26_3[2] = {
+ {2, 3},
+ {6, 4},
+};
+static arc arcs_26_4[3] = {
+ {6, 4},
+ {2, 4},
+ {62, 1},
+};
+static state states_26[5] = {
+ {2, arcs_26_0},
+ {1, arcs_26_1},
+ {1, arcs_26_2},
+ {2, arcs_26_3},
+ {3, arcs_26_4},
+};
+static arc arcs_27_0[1] = {
+ {63, 1},
+};
+static arc arcs_27_1[2] = {
+ {64, 0},
+ {0, 1},
+};
+static state states_27[2] = {
+ {1, arcs_27_0},
+ {2, arcs_27_1},
+};
+static arc arcs_28_0[1] = {
+ {65, 1},
+};
+static arc arcs_28_1[2] = {
+ {66, 0},
+ {0, 1},
+};
+static state states_28[2] = {
+ {1, arcs_28_0},
+ {2, arcs_28_1},
+};
+static arc arcs_29_0[2] = {
+ {67, 1},
+ {68, 2},
+};
+static arc arcs_29_1[1] = {
+ {65, 2},
+};
+static arc arcs_29_2[1] = {
+ {0, 2},
+};
+static state states_29[3] = {
+ {2, arcs_29_0},
+ {1, arcs_29_1},
+ {1, arcs_29_2},
+};
+static arc arcs_30_0[1] = {
+ {35, 1},
+};
+static arc arcs_30_1[2] = {
+ {69, 0},
+ {0, 1},
+};
+static state states_30[2] = {
+ {1, arcs_30_0},
+ {2, arcs_30_1},
+};
+static arc arcs_31_0[6] = {
+ {70, 1},
+ {71, 2},
+ {30, 3},
+ {56, 3},
+ {67, 4},
+ {72, 5},
+};
+static arc arcs_31_1[3] = {
+ {30, 3},
+ {71, 3},
+ {0, 1},
+};
+static arc arcs_31_2[2] = {
+ {30, 3},
+ {0, 2},
+};
+static arc arcs_31_3[1] = {
+ {0, 3},
+};
+static arc arcs_31_4[1] = {
+ {56, 3},
+};
+static arc arcs_31_5[2] = {
+ {67, 3},
+ {0, 5},
+};
+static state states_31[6] = {
+ {6, arcs_31_0},
+ {3, arcs_31_1},
+ {2, arcs_31_2},
+ {1, arcs_31_3},
+ {1, arcs_31_4},
+ {2, arcs_31_5},
+};
+static arc arcs_32_0[1] = {
+ {73, 1},
+};
+static arc arcs_32_1[3] = {
+ {74, 0},
+ {75, 0},
+ {0, 1},
+};
+static state states_32[2] = {
+ {1, arcs_32_0},
+ {3, arcs_32_1},
+};
+static arc arcs_33_0[1] = {
+ {76, 1},
+};
+static arc arcs_33_1[4] = {
+ {45, 0},
+ {77, 0},
+ {78, 0},
+ {0, 1},
+};
+static state states_33[2] = {
+ {1, arcs_33_0},
+ {4, arcs_33_1},
+};
+static arc arcs_34_0[3] = {
+ {74, 1},
+ {75, 1},
+ {79, 2},
+};
+static arc arcs_34_1[1] = {
+ {76, 3},
+};
+static arc arcs_34_2[2] = {
+ {80, 2},
+ {0, 2},
+};
+static arc arcs_34_3[1] = {
+ {0, 3},
+};
+static state states_34[4] = {
+ {3, arcs_34_0},
+ {1, arcs_34_1},
+ {2, arcs_34_2},
+ {1, arcs_34_3},
+};
+static arc arcs_35_0[7] = {
+ {17, 1},
+ {81, 2},
+ {83, 3},
+ {85, 4},
+ {13, 5},
+ {86, 5},
+ {87, 5},
+};
+static arc arcs_35_1[2] = {
+ {9, 6},
+ {19, 5},
+};
+static arc arcs_35_2[2] = {
+ {9, 7},
+ {82, 5},
+};
+static arc arcs_35_3[1] = {
+ {84, 5},
+};
+static arc arcs_35_4[1] = {
+ {9, 8},
+};
+static arc arcs_35_5[1] = {
+ {0, 5},
+};
+static arc arcs_35_6[1] = {
+ {19, 5},
+};
+static arc arcs_35_7[1] = {
+ {82, 5},
+};
+static arc arcs_35_8[1] = {
+ {85, 5},
+};
+static state states_35[9] = {
+ {7, arcs_35_0},
+ {2, arcs_35_1},
+ {2, arcs_35_2},
+ {1, arcs_35_3},
+ {1, arcs_35_4},
+ {1, arcs_35_5},
+ {1, arcs_35_6},
+ {1, arcs_35_7},
+ {1, arcs_35_8},
+};
+static arc arcs_36_0[3] = {
+ {17, 1},
+ {81, 2},
+ {89, 3},
+};
+static arc arcs_36_1[2] = {
+ {29, 4},
+ {19, 5},
+};
+static arc arcs_36_2[1] = {
+ {88, 6},
+};
+static arc arcs_36_3[1] = {
+ {13, 5},
+};
+static arc arcs_36_4[1] = {
+ {19, 5},
+};
+static arc arcs_36_5[1] = {
+ {0, 5},
+};
+static arc arcs_36_6[1] = {
+ {82, 5},
+};
+static state states_36[7] = {
+ {3, arcs_36_0},
+ {2, arcs_36_1},
+ {1, arcs_36_2},
+ {1, arcs_36_3},
+ {1, arcs_36_4},
+ {1, arcs_36_5},
+ {1, arcs_36_6},
+};
+static arc arcs_37_0[2] = {
+ {35, 1},
+ {15, 2},
+};
+static arc arcs_37_1[2] = {
+ {15, 2},
+ {0, 1},
+};
+static arc arcs_37_2[2] = {
+ {35, 3},
+ {0, 2},
+};
+static arc arcs_37_3[1] = {
+ {0, 3},
+};
+static state states_37[4] = {
+ {2, arcs_37_0},
+ {2, arcs_37_1},
+ {2, arcs_37_2},
+ {1, arcs_37_3},
+};
+static arc arcs_38_0[1] = {
+ {35, 1},
+};
+static arc arcs_38_1[2] = {
+ {21, 2},
+ {0, 1},
+};
+static arc arcs_38_2[2] = {
+ {35, 1},
+ {0, 2},
+};
+static state states_38[3] = {
+ {1, arcs_38_0},
+ {2, arcs_38_1},
+ {2, arcs_38_2},
+};
+static arc arcs_39_0[1] = {
+ {32, 1},
+};
+static arc arcs_39_1[2] = {
+ {21, 2},
+ {0, 1},
+};
+static arc arcs_39_2[2] = {
+ {32, 1},
+ {0, 2},
+};
+static state states_39[3] = {
+ {1, arcs_39_0},
+ {2, arcs_39_1},
+ {2, arcs_39_2},
+};
+static arc arcs_40_0[1] = {
+ {90, 1},
+};
+static arc arcs_40_1[1] = {
+ {13, 2},
+};
+static arc arcs_40_2[1] = {
+ {14, 3},
+};
+static arc arcs_40_3[2] = {
+ {30, 4},
+ {15, 5},
+};
+static arc arcs_40_4[1] = {
+ {91, 6},
+};
+static arc arcs_40_5[1] = {
+ {16, 7},
+};
+static arc arcs_40_6[1] = {
+ {15, 5},
+};
+static arc arcs_40_7[1] = {
+ {0, 7},
+};
+static state states_40[8] = {
+ {1, arcs_40_0},
+ {1, arcs_40_1},
+ {1, arcs_40_2},
+ {2, arcs_40_3},
+ {1, arcs_40_4},
+ {1, arcs_40_5},
+ {1, arcs_40_6},
+ {1, arcs_40_7},
+};
+static arc arcs_41_0[1] = {
+ {79, 1},
+};
+static arc arcs_41_1[1] = {
+ {92, 2},
+};
+static arc arcs_41_2[2] = {
+ {21, 0},
+ {0, 2},
+};
+static state states_41[3] = {
+ {1, arcs_41_0},
+ {1, arcs_41_1},
+ {2, arcs_41_2},
+};
+static arc arcs_42_0[1] = {
+ {17, 1},
+};
+static arc arcs_42_1[2] = {
+ {9, 2},
+ {19, 3},
+};
+static arc arcs_42_2[1] = {
+ {19, 3},
+};
+static arc arcs_42_3[1] = {
+ {0, 3},
+};
+static state states_42[4] = {
+ {1, arcs_42_0},
+ {2, arcs_42_1},
+ {1, arcs_42_2},
+ {1, arcs_42_3},
+};
+static dfa dfas[43] = {
+ {256, "single_input", 0, 3, states_0,
+ "\004\060\002\200\026\037\310\002\000\014\352\004"},
+ {257, "file_input", 0, 2, states_1,
+ "\204\060\002\200\026\037\310\002\000\014\352\004"},
+ {258, "expr_input", 0, 3, states_2,
+ "\000\040\002\000\000\000\000\000\010\014\352\000"},
+ {259, "eval_input", 0, 3, states_3,
+ "\000\040\002\000\000\000\000\000\010\014\352\000"},
+ {260, "funcdef", 0, 6, states_4,
+ "\000\020\000\000\000\000\000\000\000\000\000\000"},
+ {261, "parameters", 0, 4, states_5,
+ "\000\000\002\000\000\000\000\000\000\000\000\000"},
+ {262, "fplist", 0, 2, states_6,
+ "\000\040\002\000\000\000\000\000\000\000\000\000"},
+ {263, "fpdef", 0, 4, states_7,
+ "\000\040\002\000\000\000\000\000\000\000\000\000"},
+ {264, "stmt", 0, 2, states_8,
+ "\000\060\002\200\026\037\310\002\000\014\352\004"},
+ {265, "simple_stmt", 0, 2, states_9,
+ "\000\040\002\200\026\037\000\000\000\014\352\000"},
+ {266, "expr_stmt", 0, 3, states_10,
+ "\000\040\002\000\000\000\000\000\000\014\352\000"},
+ {267, "print_stmt", 0, 4, states_11,
+ "\000\000\000\200\000\000\000\000\000\000\000\000"},
+ {268, "del_stmt", 0, 4, states_12,
+ "\000\000\000\000\002\000\000\000\000\000\000\000"},
+ {269, "dir_stmt", 0, 4, states_13,
+ "\000\000\000\000\004\000\000\000\000\000\000\000"},
+ {270, "pass_stmt", 0, 3, states_14,
+ "\000\000\000\000\020\000\000\000\000\000\000\000"},
+ {271, "flow_stmt", 0, 2, states_15,
+ "\000\000\000\000\000\007\000\000\000\000\000\000"},
+ {272, "break_stmt", 0, 3, states_16,
+ "\000\000\000\000\000\001\000\000\000\000\000\000"},
+ {273, "return_stmt", 0, 4, states_17,
+ "\000\000\000\000\000\002\000\000\000\000\000\000"},
+ {274, "raise_stmt", 0, 6, states_18,
+ "\000\000\000\000\000\004\000\000\000\000\000\000"},
+ {275, "import_stmt", 0, 10, states_19,
+ "\000\000\000\000\000\030\000\000\000\000\000\000"},
+ {276, "compound_stmt", 0, 2, states_20,
+ "\000\020\000\000\000\000\310\002\000\000\000\004"},
+ {277, "if_stmt", 0, 8, states_21,
+ "\000\000\000\000\000\000\010\000\000\000\000\000"},
+ {278, "while_stmt", 0, 8, states_22,
+ "\000\000\000\000\000\000\100\000\000\000\000\000"},
+ {279, "for_stmt", 0, 10, states_23,
+ "\000\000\000\000\000\000\200\000\000\000\000\000"},
+ {280, "try_stmt", 0, 7, states_24,
+ "\000\000\000\000\000\000\000\002\000\000\000\000"},
+ {281, "except_clause", 0, 5, states_25,
+ "\000\000\000\000\000\000\000\020\000\000\000\000"},
+ {282, "suite", 0, 5, states_26,
+ "\004\040\002\200\026\037\000\000\000\014\352\000"},
+ {283, "test", 0, 2, states_27,
+ "\000\040\002\000\000\000\000\000\010\014\352\000"},
+ {284, "and_test", 0, 2, states_28,
+ "\000\040\002\000\000\000\000\000\010\014\352\000"},
+ {285, "not_test", 0, 3, states_29,
+ "\000\040\002\000\000\000\000\000\010\014\352\000"},
+ {286, "comparison", 0, 2, states_30,
+ "\000\040\002\000\000\000\000\000\000\014\352\000"},
+ {287, "comp_op", 0, 6, states_31,
+ "\000\000\000\100\000\000\000\001\310\001\000\000"},
+ {288, "expr", 0, 2, states_32,
+ "\000\040\002\000\000\000\000\000\000\014\352\000"},
+ {289, "term", 0, 2, states_33,
+ "\000\040\002\000\000\000\000\000\000\014\352\000"},
+ {290, "factor", 0, 4, states_34,
+ "\000\040\002\000\000\000\000\000\000\014\352\000"},
+ {291, "atom", 0, 9, states_35,
+ "\000\040\002\000\000\000\000\000\000\000\352\000"},
+ {292, "trailer", 0, 7, states_36,
+ "\000\000\002\000\000\000\000\000\000\000\002\002"},
+ {293, "subscript", 0, 4, states_37,
+ "\000\240\002\000\000\000\000\000\000\014\352\000"},
+ {294, "exprlist", 0, 3, states_38,
+ "\000\040\002\000\000\000\000\000\000\014\352\000"},
+ {295, "testlist", 0, 3, states_39,
+ "\000\040\002\000\000\000\000\000\010\014\352\000"},
+ {296, "classdef", 0, 8, states_40,
+ "\000\000\000\000\000\000\000\000\000\000\000\004"},
+ {297, "baselist", 0, 3, states_41,
+ "\000\040\002\000\000\000\000\000\000\000\352\000"},
+ {298, "arguments", 0, 4, states_42,
+ "\000\000\002\000\000\000\000\000\000\000\000\000"},
+};
+static label labels[93] = {
+ {0, "EMPTY"},
+ {256, 0},
+ {4, 0},
+ {265, 0},
+ {276, 0},
+ {257, 0},
+ {264, 0},
+ {0, 0},
+ {258, 0},
+ {295, 0},
+ {259, 0},
+ {260, 0},
+ {1, "def"},
+ {1, 0},
+ {261, 0},
+ {11, 0},
+ {282, 0},
+ {7, 0},
+ {262, 0},
+ {8, 0},
+ {263, 0},
+ {12, 0},
+ {266, 0},
+ {267, 0},
+ {270, 0},
+ {268, 0},
+ {269, 0},
+ {271, 0},
+ {275, 0},
+ {294, 0},
+ {22, 0},
+ {1, "print"},
+ {283, 0},
+ {1, "del"},
+ {1, "dir"},
+ {288, 0},
+ {1, "pass"},
+ {272, 0},
+ {273, 0},
+ {274, 0},
+ {1, "break"},
+ {1, "return"},
+ {1, "raise"},
+ {1, "import"},
+ {1, "from"},
+ {16, 0},
+ {277, 0},
+ {278, 0},
+ {279, 0},
+ {280, 0},
+ {296, 0},
+ {1, "if"},
+ {1, "elif"},
+ {1, "else"},
+ {1, "while"},
+ {1, "for"},
+ {1, "in"},
+ {1, "try"},
+ {281, 0},
+ {1, "finally"},
+ {1, "except"},
+ {5, 0},
+ {6, 0},
+ {284, 0},
+ {1, "or"},
+ {285, 0},
+ {1, "and"},
+ {1, "not"},
+ {286, 0},
+ {287, 0},
+ {20, 0},
+ {21, 0},
+ {1, "is"},
+ {289, 0},
+ {14, 0},
+ {15, 0},
+ {290, 0},
+ {17, 0},
+ {24, 0},
+ {291, 0},
+ {292, 0},
+ {9, 0},
+ {10, 0},
+ {26, 0},
+ {27, 0},
+ {25, 0},
+ {2, 0},
+ {3, 0},
+ {293, 0},
+ {23, 0},
+ {1, "class"},
+ {297, 0},
+ {298, 0},
+};
+grammar gram = {
+ 43,
+ dfas,
+ {93, labels},
+ 256
+};
--- /dev/null
+/* Module definition and import implementation */
+
+#include <stdio.h>
+#include "string.h"
+
+#include "PROTO.h"
+#include "object.h"
+#include "stringobject.h"
+#include "listobject.h"
+#include "dictobject.h"
+#include "moduleobject.h"
+#include "node.h"
+#include "context.h"
+#include "token.h"
+#include "graminit.h"
+#include "run.h"
+#include "support.h"
+#include "import.h"
+#include "errcode.h"
+#include "sysmodule.h"
+
+/* Define pathname separator and delimiter in $PYTHONPATH */
+
+#ifdef THINK_C
+#define SEP ':'
+#define DELIM ' '
+#endif
+
+#ifndef SEP
+#define SEP '/'
+#endif
+
+#ifndef DELIM
+#define DELIM ':'
+#endif
+
+void
+initimport()
+{
+ object *v;
+ if ((v = newdictobject()) == NULL)
+ fatal("no mem for module table");
+ if (sysset("modules", v) != 0)
+ fatal("can't assign sys.modules");
+}
+
+object *
+new_module(name)
+ char *name;
+{
+ object *m;
+ object *mtab;
+ mtab = sysget("modules");
+ if (mtab == NULL || !is_dictobject(mtab)) {
+ errno = EBADF;
+ return NULL;
+ }
+ m = newmoduleobject(name);
+ if (m == NULL)
+ return NULL;
+ if (dictinsert(mtab, name, m) != 0) {
+ DECREF(m);
+ return NULL;
+ }
+ return m;
+}
+
+void
+define_module(ctx, name)
+ context *ctx;
+ char *name;
+{
+ object *m, *d;
+ m = new_module(name);
+ if (m == NULL) {
+ puterrno(ctx);
+ return;
+ }
+ d = getmoduledict(m);
+ INCREF(d);
+ DECREF(ctx->ctx_locals);
+ ctx->ctx_locals = d;
+ INCREF(d);
+ DECREF(ctx->ctx_globals);
+ ctx->ctx_globals = d;
+ DECREF(m);
+}
+
+object *
+parsepath(path, delim)
+ char *path;
+ int delim;
+{
+ int i, n;
+ char *p;
+ object *v, *w;
+
+ n = 1;
+ p = path;
+ while ((p = strchr(p, delim)) != NULL) {
+ n++;
+ p++;
+ }
+ v = newlistobject(n);
+ if (v == NULL)
+ return NULL;
+ for (i = 0; ; i++) {
+ p = strchr(path, delim);
+ if (p == NULL)
+ p = strchr(path, '\0'); /* End of string */
+ w = newsizedstringobject(path, (int) (p - path));
+ if (w == NULL) {
+ DECREF(v);
+ return NULL;
+ }
+ setlistitem(v, i, w);
+ if (*p == '\0')
+ break;
+ path = p+1;
+ }
+ return v;
+}
+
+void
+setpythonpath(path)
+ char *path;
+{
+ object *v;
+ if ((v = parsepath(path, DELIM)) != NULL) {
+ if (sysset("path", v) != 0)
+ fatal("can't assign sys.path");
+ DECREF(v);
+ }
+}
+
+static FILE *
+open_module(name, suffix)
+ char *name;
+ char *suffix;
+{
+ object *path;
+ char namebuf[256];
+ FILE *fp;
+
+ path = sysget("path");
+ if (path == NULL || !is_listobject(path)) {
+ strcpy(namebuf, name);
+ strcat(namebuf, suffix);
+ fp = fopen(namebuf, "r");
+ }
+ else {
+ int npath = getlistsize(path);
+ int i;
+ fp = NULL;
+ for (i = 0; i < npath; i++) {
+ object *v = getlistitem(path, i);
+ int len;
+ if (!is_stringobject(v))
+ continue;
+ strcpy(namebuf, getstringvalue(v));
+ len = getstringsize(v);
+ if (len > 0 && namebuf[len-1] != SEP)
+ namebuf[len++] = SEP;
+ strcpy(namebuf+len, name); /* XXX check for overflow */
+ strcat(namebuf, suffix); /* XXX ditto */
+ fp = fopen(namebuf, "r");
+ if (fp != NULL)
+ break;
+ }
+ }
+ return fp;
+}
+
+static object *
+load_module(ctx, name)
+ context *ctx;
+ char *name;
+{
+ object *m;
+ char **p;
+ FILE *fp;
+ node *n, *mh;
+ int err;
+ object *mtab;
+ object *save_locals, *save_globals;
+
+ mtab = sysget("modules");
+ if (mtab == NULL || !is_dictobject(mtab)) {
+ errno = EBADF;
+ return NULL;
+ }
+ fp = open_module(name, ".py");
+ if (fp == NULL) {
+ /* XXX Compatibility hack */
+ fprintf(stderr,
+ "Can't find '%s.py' in sys.path, trying '%s'\n",
+ name, name);
+ fp = open_module(name, "");
+ }
+ if (fp == NULL) {
+ name_error(ctx, name);
+ return NULL;
+ }
+#ifdef DEBUG
+ fprintf(stderr, "Reading module %s from file '%s'\n", name, namebuf);
+#endif
+ err = parseinput(fp, file_input, &n);
+ fclose(fp);
+ if (err != E_DONE) {
+ input_error(ctx, err);
+ return NULL;
+ }
+ save_locals = ctx->ctx_locals;
+ INCREF(save_locals);
+ save_globals = ctx->ctx_globals;
+ INCREF(save_globals);
+ define_module(ctx, name);
+ exec_node(ctx, n);
+ DECREF(ctx->ctx_locals);
+ ctx->ctx_locals = save_locals;
+ DECREF(ctx->ctx_globals);
+ ctx->ctx_globals = save_globals;
+ /* XXX need to free the tree n here; except referenced defs */
+ if (ctx->ctx_exception) {
+ dictremove(mtab, name); /* Undefine the module */
+ return NULL;
+ }
+ m = dictlookup(mtab, name);
+ if (m == NULL) {
+ error(ctx, "module not defined after loading");
+ return NULL;
+ }
+ return m;
+}
+
+object *
+import_module(ctx, name)
+ context *ctx;
+ char *name;
+{
+ object *m;
+ object *mtab;
+ mtab = sysget("modules");
+ if (mtab == NULL || !is_dictobject(mtab)) {
+ error(ctx, "bad sys.modules");
+ return NULL;
+ }
+ if ((m = dictlookup(mtab, name)) == NULL) {
+ m = load_module(ctx, name);
+ }
+ return m;
+}
--- /dev/null
+/* Module support implementation */
+
+#include <stdio.h>
+
+#include "PROTO.h"
+#include "object.h"
+#include "intobject.h"
+#include "stringobject.h"
+#include "tupleobject.h"
+#include "listobject.h"
+#include "methodobject.h"
+#include "moduleobject.h"
+#include "modsupport.h"
+#include "import.h"
+#include "errors.h"
+
+
+/* Find a method in a module's method table.
+ Usually called from a module's getattr method. */
+
+object *
+findmethod(ml, op, name)
+ struct methodlist *ml;
+ object *op;
+ char *name;
+{
+ for (; ml->ml_name != NULL; ml++) {
+ if (strcmp(name, ml->ml_name) == 0)
+ return newmethodobject(ml->ml_name, ml->ml_meth, op);
+ }
+ err_setstr(NameError, name);
+ return NULL;
+}
+
+
+object *
+initmodule(name, methods)
+ char *name;
+ struct methodlist *methods;
+{
+ object *m, *d, *v;
+ struct methodlist *ml;
+ if ((m = new_module(name)) == NULL) {
+ fprintf(stderr, "initializing module: %s\n", name);
+ fatal("can't create a module");
+ }
+ d = getmoduledict(m);
+ for (ml = methods; ml->ml_name != NULL; ml++) {
+ v = newmethodobject(ml->ml_name, ml->ml_meth, (object *)NULL);
+ if (v == NULL || dictinsert(d, ml->ml_name, v) != 0) {
+ fprintf(stderr, "initializing module: %s\n", name);
+ fatal("can't initialize module");
+ }
+ DECREF(v);
+ }
+ DECREF(m);
+ return m; /* Yes, it still exists, in sys.modules... */
+}
+
+
+/* Convenience functions to set a type error exception and return 0 */
+
+int
+err_badarg()
+{
+ err_setstr(TypeError, "illegal argument type for built-in function");
+ return 0;
+}
+
+object *
+err_nomem()
+{
+ err_setstr(MemoryError, "in built-in function");
+ return NULL;
+}
+
+/* Argument list handling tools.
+ All return 1 for success, or call err_set*() and return 0 for failure */
+
+int
+getnoarg(v)
+ object *v;
+{
+ if (v != NULL) {
+ return err_badarg();
+ }
+ return 1;
+}
+
+int
+getintarg(v, a)
+ object *v;
+ int *a;
+{
+ if (v == NULL || !is_intobject(v)) {
+ return err_badarg();
+ }
+ *a = getintvalue(v);
+ return 1;
+}
+
+int
+getintintarg(v, a, b)
+ object *v;
+ int *a;
+ int *b;
+{
+ if (v == NULL || !is_tupleobject(v) || gettuplesize(v) != 2) {
+ return err_badarg();
+ }
+ return getintarg(gettupleitem(v, 0), a) &&
+ getintarg(gettupleitem(v, 1), b);
+}
+
+int
+getlongarg(v, a)
+ object *v;
+ long *a;
+{
+ if (v == NULL || !is_intobject(v)) {
+ return err_badarg();
+ }
+ *a = getintvalue(v);
+ return 1;
+}
+
+int
+getlonglongargs(v, a, b)
+ object *v;
+ long *a, *b;
+{
+ if (v == NULL || !is_tupleobject(v) || gettuplesize(v) != 2) {
+ return err_badarg();
+ }
+ return getlongarg(gettupleitem(v, 0), a) &&
+ getlongarg(gettupleitem(v, 1), b);
+}
+
+int
+getlonglongobjectargs(v, a, b, c)
+ object *v;
+ long *a, *b;
+ object **c;
+{
+ if (v == NULL || !is_tupleobject(v) || gettuplesize(v) != 3) {
+ return err_badarg();
+ }
+ if (getlongarg(gettupleitem(v, 0), a) &&
+ getlongarg(gettupleitem(v, 1), b)) {
+ *c = gettupleitem(v, 2);
+ return 1;
+ }
+ else {
+ return err_badarg();
+ }
+}
+
+int
+getstrarg(v, a)
+ object *v;
+ object **a;
+{
+ if (v == NULL || !is_stringobject(v)) {
+ return err_badarg();
+ }
+ *a = v;
+ return 1;
+}
+
+int
+getstrstrarg(v, a, b)
+ object *v;
+ object **a;
+ object **b;
+{
+ if (v == NULL || !is_tupleobject(v) || gettuplesize(v) != 2) {
+ return err_badarg();
+ }
+ return getstrarg(gettupleitem(v, 0), a) &&
+ getstrarg(gettupleitem(v, 1), b);
+}
+
+int
+getstrstrintarg(v, a, b, c)
+ object *v;
+ object **a;
+ object **b;
+ int *c;
+{
+ if (v == NULL || !is_tupleobject(v) || gettuplesize(v) != 3) {
+ return err_badarg();
+ }
+ return getstrarg(gettupleitem(v, 0), a) &&
+ getstrarg(gettupleitem(v, 1), b) &&
+ getintarg(gettupleitem(v, 2), c);
+}
+
+int
+getstrintarg(v, a, b)
+ object *v;
+ object **a;
+ int *b;
+{
+ if (v == NULL || !is_tupleobject(v) || gettuplesize(v) != 2) {
+ return err_badarg();
+ }
+ return getstrarg(gettupleitem(v, 0), a) &&
+ getintarg(gettupleitem(v, 1), b);
+}
+
+int
+getintstrarg(v, a, b)
+ object *v;
+ int *a;
+ object **b;
+{
+ if (v == NULL || !is_tupleobject(v) || gettuplesize(v) != 2) {
+ return err_badarg();
+ }
+ return getintarg(gettupleitem(v, 0), a) &&
+ getstrarg(gettupleitem(v, 1), b);
+}
+
+int
+getpointarg(v, a)
+ object *v;
+ int *a; /* [2] */
+{
+ return getintintarg(v, a, a+1);
+}
+
+int
+get3pointarg(v, a)
+ object *v;
+ int *a; /* [6] */
+{
+ if (v == NULL || !is_tupleobject(v) || gettuplesize(v) != 3) {
+ return err_badarg();
+ }
+ return getpointarg(gettupleitem(v, 0), a) &&
+ getpointarg(gettupleitem(v, 1), a+2) &&
+ getpointarg(gettupleitem(v, 2), a+4);
+}
+
+int
+getrectarg(v, a)
+ object *v;
+ int *a; /* [2+2] */
+{
+ if (v == NULL || !is_tupleobject(v) || gettuplesize(v) != 2) {
+ return err_badarg();
+ }
+ return getpointarg(gettupleitem(v, 0), a) &&
+ getpointarg(gettupleitem(v, 1), a+2);
+}
+
+int
+getrectintarg(v, a)
+ object *v;
+ int *a; /* [4+1] */
+{
+ if (v == NULL || !is_tupleobject(v) || gettuplesize(v) != 2) {
+ return err_badarg();
+ }
+ return getrectarg(gettupleitem(v, 0), a) &&
+ getintarg(gettupleitem(v, 1), a+4);
+}
+
+int
+getpointintarg(v, a)
+ object *v;
+ int *a; /* [2+1] */
+{
+ if (v == NULL || !is_tupleobject(v) || gettuplesize(v) != 2) {
+ return err_badarg();
+ }
+ return getpointarg(gettupleitem(v, 0), a) &&
+ getintarg(gettupleitem(v, 1), a+2);
+}
+
+int
+getpointstrarg(v, a, b)
+ object *v;
+ int *a; /* [2] */
+ object **b;
+{
+ if (v == NULL || !is_tupleobject(v) || gettuplesize(v) != 2) {
+ return err_badarg();
+ }
+ return getpointarg(gettupleitem(v, 0), a) &&
+ getstrarg(gettupleitem(v, 1), b);
+}
+
+int
+getstrintintarg(v, a, b, c)
+ object *v;
+ object *a;
+ int *b, *c;
+{
+ if (v == NULL || !is_tupleobject(v) || gettuplesize(v) != 3) {
+ return err_badarg();
+ }
+ return getstrarg(gettupleitem(v, 0), a) &&
+ getintarg(gettupleitem(v, 1), b) &&
+ getintarg(gettupleitem(v, 2), c);
+}
+
+int
+getrectpointarg(v, a)
+ object *v;
+ int *a; /* [4+2] */
+{
+ if (v == NULL || !is_tupleobject(v) || gettuplesize(v) != 2) {
+ return err_badarg();
+ }
+ return getrectarg(gettupleitem(v, 0), a) &&
+ getpointarg(gettupleitem(v, 1), a+4);
+}
+
+int
+getlongtuplearg(args, a, n)
+ object *args;
+ long *a; /* [n] */
+ int n;
+{
+ int i;
+ if (!is_tupleobject(args) || gettuplesize(args) != n) {
+ return err_badarg();
+ }
+ for (i = 0; i < n; i++) {
+ object *v = gettupleitem(args, i);
+ if (!is_intobject(v)) {
+ return err_badarg();
+ }
+ a[i] = getintvalue(v);
+ }
+ return 1;
+}
+
+int
+getshorttuplearg(args, a, n)
+ object *args;
+ short *a; /* [n] */
+ int n;
+{
+ int i;
+ if (!is_tupleobject(args) || gettuplesize(args) != n) {
+ return err_badarg();
+ }
+ for (i = 0; i < n; i++) {
+ object *v = gettupleitem(args, i);
+ if (!is_intobject(v)) {
+ return err_badarg();
+ }
+ a[i] = getintvalue(v);
+ }
+ return 1;
+}
+
+int
+getlonglistarg(args, a, n)
+ object *args;
+ long *a; /* [n] */
+ int n;
+{
+ int i;
+ if (!is_listobject(args) || getlistsize(args) != n) {
+ return err_badarg();
+ }
+ for (i = 0; i < n; i++) {
+ object *v = getlistitem(args, i);
+ if (!is_intobject(v)) {
+ return err_badarg();
+ }
+ a[i] = getintvalue(v);
+ }
+ return 1;
+}
+
+int
+getshortlistarg(args, a, n)
+ object *args;
+ short *a; /* [n] */
+ int n;
+{
+ int i;
+ if (!is_listobject(args) || getlistsize(args) != n) {
+ return err_badarg();
+ }
+ for (i = 0; i < n; i++) {
+ object *v = getlistitem(args, i);
+ if (!is_intobject(v)) {
+ return err_badarg();
+ }
+ a[i] = getintvalue(v);
+ }
+ return 1;
+}
--- /dev/null
+/* Python interpreter main program */
+
+/* XXX This is still a mess */
+
+#ifdef THINK_C
+#define USE_STDWIN
+#endif
+
+#include <stdio.h>
+#include <ctype.h>
+#include "string.h"
+
+#ifdef USE_STDWIN
+#include "stdwin.h"
+int use_stdwin;
+#endif
+
+extern char *getenv();
+
+#include "PROTO.h"
+#include "grammar.h"
+#include "node.h"
+#include "parsetok.h"
+#include "graminit.h"
+#include "errcode.h"
+#include "object.h"
+#include "stringobject.h"
+#include "sysmodule.h"
+
+extern grammar gram; /* From graminit.c */
+
+#ifndef PYTHONPATH
+
+#ifdef THINK_C
+
+#define PYTHONPATH ": :mod"
+
+#else /* !THINK_C */
+
+#ifdef AMOEBA
+#define PYTHONPATH ".:/profile/module/python"
+#else /* !AMOEBA */
+#define PYTHONPATH ".:/usr/local/lib/python"
+#endif /* !AMOEBA */
+
+#endif /* !THINK_C */
+
+#endif /* !PYTHONPATH */
+
+int debugging;
+
+main(argc, argv)
+ int argc;
+ char **argv;
+{
+ char *path;
+ char *filename = NULL;
+ FILE *fp = stdin;
+ int ret;
+
+#ifdef USE_STDWIN
+#ifdef THINK_C
+ wsetstdio(1);
+#else THINK_C
+ /* Must use "python -s" now to get stdwin support */
+ if (argc > 1 && strcmp(argv[1], "-s") == 0)
+ argv[1] = argv[0],
+ argc--, argv++,
+#endif /* !THINK_C */
+ use_stdwin = 1;
+ if (use_stdwin)
+ winitargs(&argc, &argv);
+#endif /* USE_STDWIN */
+
+#ifdef THINK_C_not_today
+ printf("argc = %d, argv[0] = '%s'\n", argc, argv[0]);
+ if (argc <= 1)
+ askargs(&argc, &argv);
+#endif
+
+ initintr(); /* For intrcheck() */
+
+ if (argc > 1 && strcmp(argv[1], "-") != 0)
+ filename = argv[1];
+
+ if (filename != NULL) {
+ if ((fp = fopen(filename, "r")) == NULL) {
+ fprintf(stderr, "python: can't open file '%s'\n",
+ filename);
+ exit(2);
+ }
+ }
+
+ /* XXX what is the ideal initialization order? */
+
+ initsys(argc-1, argv+1);
+ inittime();
+ initmath();
+
+#ifndef THINK_C
+ path = getenv("PYTHONPATH");
+ if (path == NULL)
+#endif
+ path = PYTHONPATH;
+ setpythonpath(path);
+
+ initrun();
+
+#ifdef USE_POSIX
+ initposix();
+#endif
+
+#ifdef THINK_C
+ initmac();
+#endif
+
+#ifdef USE_AUDIO
+ initaudio();
+#endif
+
+#ifdef USE_AMOEBA
+ initamoeba();
+#endif
+
+#ifdef USE_STDWIN
+ if (use_stdwin)
+ initstdwin();
+#endif
+
+#ifdef USE_GL
+ initgl();
+#endif
+
+#ifdef USE_PANEL
+ initpanel();
+#endif
+
+ if (!isatty(fileno(fp))) {
+ ret = runfile(fp, file_input, (char *)NULL, (char *)NULL);
+ }
+ else {
+ sysset("ps1", newstringobject(">>> "));
+ sysset("ps2", newstringobject("... "));
+ for (;;) {
+ object *v = sysget("ps1"), *w = sysget("ps2");
+ char *ps1 = NULL, *ps2 = NULL;
+ if (v != NULL && is_stringobject(v)) {
+ INCREF(v);
+ ps1 = getstringvalue(v);
+ }
+ else
+ v = NULL;
+ if (w != NULL && is_stringobject(w)) {
+ INCREF(w);
+ ps2 = getstringvalue(w);
+ }
+ else
+ w = NULL;
+ ret = runfile(fp, single_input, ps1, ps2);
+ if (v != NULL)
+ DECREF(v);
+ if (w != NULL)
+ DECREF(w);
+ if (ret == E_EOF || ret == E_NOMEM)
+ break;
+ }
+ }
+ goaway(ret == E_DONE || ret == E_EOF ? 0 : 1);
+ /*NOTREACHED*/
+}
+
+goaway(sts)
+ int sts;
+{
+ closerun();
+#ifdef USE_STDWIN
+ if (use_stdwin)
+ wdone();
+#endif
+#ifdef THINK_C
+#ifndef TRACE_REFS
+ /* Avoid 'click mouse to continue' in Lightspeed C */
+ if (sts == 0)
+ Click_On(0);
+#endif
+#endif
+ exit(sts);
+ /*NOTREACHED*/
+}
+
+/* Parse input from a file and execute it */
+
+static int
+runfile(fp, start, ps1, ps2)
+ FILE *fp;
+ int start;
+ char *ps1, *ps2;
+{
+ node *n;
+ int ret;
+ ret = parsefile(fp, &gram, start, ps1, ps2, &n);
+ if (ret != E_DONE)
+ return ret;
+ return execute(n) == 0 ? E_DONE : E_ERROR;
+}
+
+#ifdef THINK_C
+
+/* Ask a yes/no question */
+
+int
+askyesno(prompt)
+ char *prompt;
+{
+ char buf[256];
+
+ printf("%s [ny] ", prompt);
+ if (fgets(buf, sizeof buf, stdin) == NULL)
+ return 0;
+ return buf[0] == 'y' || buf[0] == 'Y';
+}
+
+/* Check for file descriptor connected to interactive device.
+ Pretend that stdin is always interactive, other files never. */
+
+int
+isatty(fd)
+ int fd;
+{
+ return fd == fileno(stdin);
+}
+
+/* Kludge to get arguments on the Mac */
+
+#define MAXARGS 20
+
+static char *
+nextarg(pnext)
+ char **pnext;
+{
+ char *ret;
+ char *p = *pnext;
+ while (isspace(*p))
+ p++;
+ if (*p == '\0')
+ return NULL;
+ ret = p;
+ while (!isspace(*p))
+ p++;
+ if (*p != '\0')
+ *p++ = '\0';
+ *pnext = p;
+ return ret;
+}
+
+static
+askargs(pargc, pargv)
+ int *pargc;
+ char ***pargv; /* sic */
+{
+ static char buf[256];
+ static char *argv[MAXARGS];
+ int argc;
+ char *p, *next;
+ fprintf(stderr, "Args: ");
+ if (fgets(buf, sizeof buf, stdin) == NULL)
+ return;
+ next = buf;
+ if ((p = nextarg(&next)) == NULL)
+ return;
+ if (*pargc > 0)
+ argv[0] = (*pargv)[0];
+ else
+ argv[0] = "PYTHON";
+ argc = 1;
+ argv[argc++] = p;
+ while (argc+1 < MAXARGS && (p = nextarg(&next)) != NULL)
+ argv[argc++] = p;
+ argv[argc] = NULL;
+ *pargc = argc;
+ *pargv = argv;
+}
+
+#endif
+
+/* WISH LIST
+
+ - improved per-module error handling; different use of errno
+ - possible new types:
+ - iterator (for range, keys, ...)
+ - improve interpreter error handling, e.g., true tracebacks
+ - release parse trees when no longer needed (make them objects?)
+ - faster parser (for long modules)
+ - save precompiled modules on file?
+ - fork threads, locking
+ - allow syntax extensions
+*/
--- /dev/null
+/* PD implementation of strerror() for BSD derivatives that don't have it.
+ Author: Guido van Rossum, CWI Amsterdam, Oct. 1990, <guido@cwi.nl>. */
+
+#include <stdio.h>
+
+extern int sys_nerr;
+extern char *sys_errlist[];
+
+char *
+strerror(err)
+ int err;
+{
+ static char buf[20];
+ if (err >= 0 && err < sys_nerr)
+ return sys_errlist[err];
+ sprintf(buf, "Unknown errno %d", err);
+ return buf;
+}
--- /dev/null
+/* System module */
+
+/*
+Various bits of information used by the interpreter are collected in
+module 'sys'.
+Data members:
+- stdin, stdout, stderr: standard file objects
+- ps1, ps2: primary and secondary prompts (strings)
+- path: module search path (list of strings)
+- modules: the table of modules (dictionary)
+Function members:
+- exit(sts): call exit()
+*/
+
+#include <stdio.h>
+
+#include "PROTO.h"
+#include "object.h"
+#include "stringobject.h"
+#include "listobject.h"
+#include "dictobject.h"
+#include "fileobject.h"
+#include "moduleobject.h"
+#include "sysmodule.h"
+#include "node.h" /* For context.h */
+#include "context.h" /* For import.h */
+#include "import.h"
+#include "methodobject.h"
+#include "modsupport.h"
+#include "errors.h"
+
+static object *sysdict;
+
+object *
+sysget(name)
+ char *name;
+{
+ return dictlookup(sysdict, name);
+}
+
+FILE *
+sysgetfile(name, def)
+ char *name;
+ FILE *def;
+{
+ FILE *fp = NULL;
+ object *v = sysget(name);
+ if (v != NULL)
+ fp = getfilefile(v);
+ if (fp == NULL)
+ fp = def;
+ return fp;
+}
+
+int
+sysset(name, v)
+ char *name;
+ object *v;
+{
+ if (v == NULL)
+ return dictremove(sysdict, name);
+ else
+ return dictinsert(sysdict, name, v);
+}
+
+static object *
+makeargv(argc, argv)
+ int argc;
+ char **argv;
+{
+ int i;
+ object *av, *v;
+ if (argc < 0 || argv == NULL)
+ argc = 0;
+ av = newlistobject(argc);
+ if (av != NULL) {
+ for (i = 0; i < argc; i++) {
+ v = newstringobject(argv[i]);
+ if (v == NULL) {
+ DECREF(av);
+ av = NULL;
+ break;
+ }
+ setlistitem(av, i, v);
+ }
+ }
+ if (av == NULL)
+ fatal("no mem for sys.argv");
+ return av;
+}
+
+/* sys.exit method */
+
+static object *
+sys_exit(self, args)
+ object *self;
+ object *args;
+{
+ int sts;
+ if (!getintarg(args, &sts))
+ return NULL;
+ goaway(sts);
+ exit(sts); /* Just in case */
+ /* NOTREACHED */
+}
+
+static object *sysin, *sysout, *syserr;
+
+void
+initsys(argc, argv)
+ int argc;
+ char **argv;
+{
+ object *v;
+ object *exit;
+ if ((sysdict = newdictobject()) == NULL)
+ fatal("can't create sys dict");
+ /* NB keep an extra ref to the std files to avoid closing them
+ when the user deletes them */
+ sysin = newopenfileobject(stdin, "<stdin>", "r");
+ sysout = newopenfileobject(stdout, "<stdout>", "w");
+ syserr = newopenfileobject(stderr, "<stderr>", "w");
+ v = makeargv(argc, argv);
+ exit = newmethodobject("exit", sys_exit, (object *)NULL);
+ if (err_occurred())
+ fatal("can't create sys.* objects");
+ dictinsert(sysdict, "stdin", sysin);
+ dictinsert(sysdict, "stdout", sysout);
+ dictinsert(sysdict, "stderr", syserr);
+ dictinsert(sysdict, "argv", v);
+ dictinsert(sysdict, "exit", exit);
+ if (err_occurred())
+ fatal("can't insert sys.* objects in sys dict");
+ DECREF(v);
+ /* The other symbols are added elsewhere */
+
+ /* Only now can we initialize the import stuff, after which
+ we can turn ourselves into a module */
+ initimport();
+ if ((v = new_module("sys")) == NULL)
+ fatal("can't create sys module");
+ if (setmoduledict(v, sysdict) != 0)
+ fatal("can't assign sys dict to sys module");
+}
+
+void
+closesys()
+{
+ object *mtab;
+ mtab = sysget("modules");
+ if (mtab != NULL && is_dictobject(mtab))
+ dictremove(mtab, "sys"); /* Get rid of recursion */
+ else
+ fprintf(stderr, "[module sys not found]\n");
+ DECREF(sysdict);
+}
projects / thirdparty / Python / cpython.git / commitdiff
