Attachment #186215 for bug #257679

Lines 39-44 Link Here

(-)pvs4.2-orig/BDD/bdd-allegro.lisp (+7 lines)
39		39
40	;;; #define NULL_LIST ((LIST) 0)	40	;;; #define NULL_LIST ((LIST) 0)
41		41
		42	;;; int null_list_p (LIST x)
		43	(ff:def-foreign-call (null_list_p "bdd___null_list_p")
		44	((x :unsigned-int integer))
		45	#+(version>= 6) :strings-convert #+(version>= 6) nil
		46	:arg-checking nil
		47	:call-direct t
		48	:returning :unsigned-int)
42	;;; void *elem_contents (LIST_ELEM_PTR x)	49	;;; void *elem_contents (LIST_ELEM_PTR x)
43	(ff:def-foreign-call (elem_contents "bdd___elem_contents")	50	(ff:def-foreign-call (elem_contents "bdd___elem_contents")
44	((x :unsigned-int integer))	51	((x :unsigned-int integer))

Lines 39-44 Link Here

(-)pvs4.2-orig/BDD/bdd-cmu.lisp (+5 lines)
39		39
40	;;; #define NULL_LIST ((LIST) 0)	40	;;; #define NULL_LIST ((LIST) 0)
41		41
		42	;;; int null_list_p (LIST x)
		43	(alien:def-alien-routine ("bdd___null_list_p" null_list_p)
		44	unsigned-int
		45	(x unsigned-int))
		46
42	;;; void *elem_contents (LIST_ELEM_PTR x)	47	;;; void *elem_contents (LIST_ELEM_PTR x)
43	(alien:def-alien-routine ("bdd___elem_contents" elem_contents)	48	(alien:def-alien-routine ("bdd___elem_contents" elem_contents)
44	unsigned-int	49	unsigned-int

Lines 4-9 Link Here

(-)pvs4.2-orig/BDD/bdd-ld-table (+1 lines)
4	bdd___bdd_poslit_p = bdd_poslit_p ;	4	bdd___bdd_poslit_p = bdd_poslit_p ;
5	bdd___bdd_neglit_p = bdd_neglit_p ;	5	bdd___bdd_neglit_p = bdd_neglit_p ;
6	bdd___bdd_equal_p = bdd_equal_p ;	6	bdd___bdd_equal_p = bdd_equal_p ;
		7	bdd___null_list_p = null_list_p ;
7	bdd___elem_contents = elem_contents ;	8	bdd___elem_contents = elem_contents ;
8	bdd___list_first = list_first ;	9	bdd___list_first = list_first ;
9	bdd___list_last = list_last ;	10	bdd___list_last = list_last ;





(in-package :pvs)

(defmacro null-list? (list) `(= (null_list_p ,list) 1))
(defmacro bdd-void? (bdd) `(= (bdd_void_p ,bdd) 1))
(defmacro bdd-1? (bdd) `(= (bdd_1_p ,bdd) 1))
(defmacro bdd-0? (bdd) `(= (bdd_0_p ,bdd) 1))

	    (pushnew (cons op name) (cdr entry) :test #'eql :key #'cdr))))))

(defun translate-from-bdd-list (bddlist)
  (let ((bdds (unless (null-list? bddlist)
		(translate-from-bdd-list* (list_first bddlist)))))
    (mapcar #'translate-bdd-cube bdds)))

(defun translate-from-bdd-list* (bddlist &optional result)
  (if (null-list? bddlist)
      (nreverse result)
      (translate-from-bdd-list*
       (list_next bddlist)




;; --------------------------------------------------------------------
;; PVS
;; Copyright (C) 2006, SRI International.  All Rights Reserved.

;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License
;; as published by the Free Software Foundation; either version 2
;; of the License, or (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software
;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
;; --------------------------------------------------------------------

(in-package :pvs)

;; SO - We load this from pvs-init (in src/pvs.lisp), as it requires mu.so,
;; but if mu.so is loaded at save-lisp time, it doesn't work (at least I
;; can't get it to).

;;; List accessors
;;; Lists in the BDD package involve two structures.

;;; A LIST is a structure with slots for a first element pointer, a last
;;; element pointer, the size, and user-defined info.

;;; A LIST_ELEM is a structure with slots for the contents and the next
;;; element.

;;; #define NULL_LIST ((LIST) 0)

;;; void *elem_contents (LIST_ELEM_PTR x)
(sb-alien:define-alien-routine ("bdd___elem_contents" elem_contents)
			       (* t)
  (x (* t)))

;;; LIST_ELEM_PTR list_first (LIST x)
(sb-alien:define-alien-routine ("bdd___list_first" list_first)
			       (* t)
  (x (* t)))

;;; LIST_ELEM_PTR list_last (LIST x)
(sb-alien:define-alien-routine ("bdd___list_last" list_last)
			       (* t)
  (x (* t)))

;;; int list_info (LIST x)
(sb-alien:define-alien-routine ("bdd___list_info" list_info)
			       (integer 32)
  (x (* t)))

;;; LIST_ELEM_PTR list_next (LIST_ELEM_PTR x)
(sb-alien:define-alien-routine ("bdd___list_next" list_next)
			       (* t)
  (x (* t)))

;;; This pretty much follows the bdd.doc sections.

;;; User settable program parameters
;;; --------------------------------
;;; int bdd_do_gc;	            /* default 1 */

(sb-alien:define-alien-variable "bdd_do_gc" (integer 32))

;;; set_bdd_do_gc (int flag)
(declaim (inline set_bdd_do_gc))
(defun set_bdd_do_gc (flag)
  (setf bdd-do-gc flag))

;;; int bdd_do_dynamic_ordering;/* default 1 */
(sb-alien:define-alien-variable "bdd_do_dynamic_ordering" (integer 32))

;;; set_bdd_do_dynamic_ordering (int flag)
(declaim (inline set_bdd_do_dynamic_ordering))
(defun set_bdd_do_dynamic_ordering (flag)
  (setf bdd-do-dynamic-ordering flag))

;;; int bdd_verbose;            /* default 0 */
(sb-alien:define-alien-variable "bdd_verbose" (integer 32))

;;; set_bdd_verbose (int flag)
(declaim (inline set_bdd_verbose))
(defun set_bdd_verbose (flag)
  (setf bdd-verbose flag))

;;; int bdd_use_neg_edges;      /* default 1*/
(sb-alien:define-alien-variable "bdd_use_neg_edges" (integer 32))

;;; set_bdd_use_neg_edges (int flag)
(declaim (inline set_bdd_use_neg_edges))
(defun set_bdd_use_neg_edges (flag)
  (setf bdd-use-neg-edges flag))

;;; int bdd_use_inv_edges;  /* default 1; 0 when bdd_do_dynamic_ordering = 1 */
(sb-alien:define-alien-variable "bdd_use_inv_edges" (integer 32))

;;; set_bdd_use_inv_edges (int flag)
(declaim (inline set_bdd_use_inv_edges))
(defun set_bdd_use_inv_edges (flag)
  (setf bdd-use-inv-edges flag))

;;; int bdd_sizeof_user_data;   /* default 0 */
;;; int BDD_COMPUTED_TABLE_SIZE;/* default DEFAULT_BDD_COMPUTED_TABLE_SIZE */
;;; int BDD_HASHTAB_SIZE;	    /* default DEFAULT_BDD_HASHTAB_SIZE */
;;; int BDD_NR_RANKS;	    /* default DEFAULT_BDD_NR_RANKS */
;;; int BDD_LOAD_FACTOR;        /* default DEFAULT_BDD_LOAD_FACTOR */


;;; C preprocessor macros:
;;; ----------------------

;;; Access to fields of BDD struct:

;;; BDD_VARID (F)
;;; bdd_varid (BDDPTR f)
(sb-alien:define-alien-routine ("bdd___bdd_varid" bdd_varid)
			       (sb-alien:unsigned 32)
  (f (* t)))

;;; BDD_THEN (F)
;;; BDD_ELSE (F)
;;; BDD_REFCOUNT (F)
;;; BDD_FLAG (F)
;;; BDD_MARK (F)


;;; Test on terminal nodes:
;;; -----------------------

;;; BDD_VOID_P (f)
;;; int bdd_void_p (BDDPTR f)
(sb-alien:define-alien-routine ("bdd___bdd_void_p" bdd_void_p)
			       (integer 32)
  (f (* t)))

;;; BDD_1_P (f)
;;; bdd_1_p (BDDPTR f)
(sb-alien:define-alien-routine ("bdd___bdd_1_p" bdd_1_p)
			       (integer 32)
  (f (* t)))

;;; BDD_0_P (f)
;;; bdd_0_p (BDDPTR f)
(sb-alien:define-alien-routine ("bdd___bdd_0_p" bdd_0_p)
			       (integer 32)
  (f (* t)))

;;; BDD_X_P (f)
;;; bdd_x_p (BDDPTR f)
(sb-alien:define-alien-routine ("bdd___bdd_x_p" bdd_x_p)
			       (integer 32)
  (f (* t)))

;;; BDD_CONST_P (f)
;;; int bdd_const_p (BDDPTR f)
(sb-alien:define-alien-routine ("bdd___bdd_const_p" bdd_const_p)
			       (integer 32)
  (f (* t)))

;;; BDD_TERM_P (f)
;;; bdd_term_p (BDDPTR f)
(sb-alien:define-alien-routine ("bdd___bdd_term_p" bdd_term_p)
			       (integer 32)
  (f (* t)))

;;; BDD_LIT_P (f)
;;; bdd_lit_p (BDDPTR f)
(sb-alien:define-alien-routine ("bdd___bdd_lit_p" bdd_lit_p)
			       (integer 32)
  (f (* t)))

;;; BDD_POSLIT_P (f)
;;; int bdd_poslit_p (BDDPTR f)
(sb-alien:define-alien-routine ("bdd___bdd_poslit_p" bdd_poslit_p)
			       (integer 32)
  (f (* t)))

;;; BDD_NEGLIT_P (f)
;;; int bdd_neglit_p (BDDPTR f)
(sb-alien:define-alien-routine ("bdd___bdd_neglit_p" bdd_neglit_p)
			       (integer 32)
  (f (* t)))

;;; BDD_COFACTOR_POS (f)
;;; BDDPTR bdd_cofactor_pos_ (BDDPTR f)
(sb-alien:define-alien-routine ("bdd___bdd_cofactor_pos_" bdd_cofactor_pos_)
			       (* t)
  (f (* t)))

;;; BDD_COFACTOR_NEG (f)
;;; BDDPTR bdd_cofactor_neg_ (BDDPTR f)
(sb-alien:define-alien-routine ("bdd___bdd_cofactor_neg_" bdd_cofactor_neg_)
			       (* t)
  (f (* t)))

;;; void bdd_reset_marks (BDDPTR f)
;;; void bdd_traverse_pre (register BDDPTR v, void (*pre_action)(BDDPTR))
;;; void bdd_traverse_post (register BDDPTR v, void (*post_action)(BDDPTR))

;;; int bdd_size (BDDPTR f)
(sb-alien:define-alien-routine ("bdd___bdd_size" bdd_size)
			       (integer 32)
  (f (* t)))

;;; int bdd_size_vec (BDDPTR *f_vec, int size)
;;; int bdd_size_ceil (BDDPTR f, int ceiling)

;;; void bdd_init (void)
(sb-alien:define-alien-routine ("bdd___bdd_init" bdd_init)
			       sb-alien:void)

;;; void bdd_free (BDDPTR f)
(sb-alien:define-alien-routine ("bdd___bdd_free" bdd_free)
			       sb-alien:void
  (f (* t)))

;;; int bdd_gc (void)
(sb-alien:define-alien-routine ("bdd___bdd_gc" bdd_gc)
			       (integer 32))

;;; BDDPTR bdd_ite (BDDPTR F, BDDPTR G, BDDPTR H)
(sb-alien:define-alien-routine ("bdd___bdd_ite" bdd_ite)
			       (* t)
  (f (* t))
  (g (* t))
  (h (* t)))

;;; BDDPTR bdd_ite_const (BDDPTR F, BDDPTR G, BDDPTR H)
(sb-alien:define-alien-routine ("bdd___bdd_ite_const" bdd_ite_const)
			       (* t)
  (f (* t))
  (g (* t))
  (h (* t)))

;;; void bdd_cofactors (BDDPTR f, BDDPTR *vp, BDDPTR *Tp, BDDPTR *Ep)
;;; BDDPTR bdd_invert_input_top (BDDPTR f)
(sb-alien:define-alien-routine
 ("bdd___bdd_invert_input_top" bdd_invert_input_top)
			       (* t)
  (f (* t)))

;;; BDDPTR bdd_create_var (int v)
(sb-alien:define-alien-routine ("bdd___bdd_create_var" bdd_create_var)
			       (* t)
  (v (integer 32)))

;;; BDDPTR bdd_create_var_first	(void)
(sb-alien:define-alien-routine
 ("bdd___bdd_create_var_first" bdd_create_var_first)
			       (* t))

;;; BDDPTR bdd_create_var_before (BDDPTR v)
(sb-alien:define-alien-routine
 ("bdd___bdd_create_var_before" bdd_create_var_before)
			       (* t)
  (v (* t)))

;;; BDDPTR bdd_create_var_after	(BDDPTR v)
(sb-alien:define-alien-routine
 ("bdd___bdd_create_var_after" bdd_create_var_after)
			       (* t)
  (v (* t)))

;;; BDDPTR bdd_create_var_last (void)
(sb-alien:define-alien-routine
 ("bdd___bdd_create_var_last" bdd_create_var_last)
			       (* t))

;;; void bdd_print (FILE *fp, BDDPTR f, char *s)
(sb-alien:define-alien-routine ("bdd___bdd_print" bdd_print)
			       sb-alien:void
  (fp (* t))
  (f (* t))
  (s sb-alien:c-string))

;;; void bdd_print_stats (FILE *fp)
;;; void bdd_quit (void)
(sb-alien:define-alien-routine ("bdd___bdd_quit" bdd_quit)
			       sb-alien:void)

;;; int bdd_memsize (void)
;;; int bdd_memsize_limit (void)
;;; void bdd_set_memsize_limit_and_handler (int limit, void (*handler) (void))
;;; int bdd_nodes_alive (void)
(sb-alien:define-alien-routine ("bdd___bdd_nodes_alive" bdd_nodes_alive)
			       (integer 32))

;;; int bdd_nodes_allocated (void)
(sb-alien:define-alien-routine
 ("bdd___bdd_nodes_allocated" bdd_nodes_allocated)
			       (integer 32))

;;; int bdd_nr_occurs_var (int id)
;;; int bdd_compl_p (BDDPTR f, BDDPTR g)
;;; int bdd_equal_p (BDDPTR F, BDDPTR G)
(sb-alien:define-alien-routine ("bdd___bdd_equal_p" bdd_equal_p)
			       (integer 32)
  (f (* t))
  (g (* t)))

;;; int bdd_implies_taut (BDDPTR F, BDDPTR G)
;;; BDDPTR bdd_not (BDDPTR F)
(sb-alien:define-alien-routine ("bdd___bdd_not" bdd_not)
			       (* t)
  (f (* t)))

;;; BDDPTR bdd_and (BDDPTR F, BDDPTR G)
(sb-alien:define-alien-routine ("bdd___bdd_and" bdd_and)
			       (* t)
  (f (* t))
  (g (* t)))

;;; BDDPTR bdd_greater	(BDDPTR F, BDDPTR G)
(sb-alien:define-alien-routine ("bdd___bdd_greater" bdd_greater)
			       (* t)
  (f (* t))
  (g (* t)))

;;; BDDPTR bdd_less (BDDPTR F, BDDPTR G)
(sb-alien:define-alien-routine ("bdd___bdd_less" bdd_less)
			       (* t)
  (f (* t))
  (g (* t)))

;;; BDDPTR bdd_xor (BDDPTR F, BDDPTR G)
(sb-alien:define-alien-routine ("bdd___bdd_xor" bdd_xor)
			       (* t)
  (f (* t))
  (g (* t)))

;;; BDDPTR bdd_or (BDDPTR F, BDDPTR G)
(sb-alien:define-alien-routine ("bdd___bdd_or" bdd_or)
			       (* t)
  (f (* t))
  (g (* t)))

;;; BDDPTR bdd_nor (BDDPTR F, BDDPTR G)
(sb-alien:define-alien-routine ("bdd___bdd_nor" bdd_nor)
			       (* t)
  (f (* t))
  (g (* t)))

;;; BDDPTR bdd_equiv (BDDPTR F, BDDPTR G)
(sb-alien:define-alien-routine ("bdd___bdd_equiv" bdd_equiv)
			       (* t)
  (f (* t))
  (g (* t)))

;;; BDDPTR bdd_xnor (BDDPTR F, BDDPTR G) /* equivalent to bdd_equiv */
(sb-alien:define-alien-routine ("bdd___bdd_xnor" bdd_xnor)
			       (* t)
  (f (* t))
  (g (* t)))

;;; BDDPTR bdd_implied (BDDPTR F, BDDPTR G)
(sb-alien:define-alien-routine ("bdd___bdd_implied" bdd_implied)
			       (* t)
  (f (* t))
  (g (* t)))

;;; BDDPTR bdd_implies (BDDPTR F, BDDPTR G)
(sb-alien:define-alien-routine ("bdd___bdd_implies" bdd_implies)
			       (* t)
  (f (* t))
  (g (* t)))

;;; BDDPTR bdd_nand (BDDPTR F, BDDPTR G)
(sb-alien:define-alien-routine ("bdd___bdd_nand" bdd_nand)
			       (* t)
  (f (* t))
  (g (* t)))

;;; BDDPTR bdd_0 (void)
(sb-alien:define-alien-routine ("bdd___bdd_0" bdd_0)
			       (* t))

;;; BDDPTR bdd_1 (void)
(sb-alien:define-alien-routine ("bdd___bdd_1" bdd_1)
			       (* t))

;;; BDDPTR bdd_X (void)
(sb-alien:define-alien-routine ("bdd___bdd_X" bdd_X)
			       (* t))

;;; BDDPTR bdd_assign (BDDPTR f)
(sb-alien:define-alien-routine ("bdd___bdd_assign" bdd_assign)
			       (* t)
  (f (* t)))

;;; BDDPTR bdd_top_var (BDDPTR f)
;;; int bdd_top_var_rank (BDDPTR f)
;;; BDDPTR bdd_then (BDDPTR f)
(sb-alien:define-alien-routine ("bdd___bdd_then" bdd_then)
			       (* t)
  (f (* t)))

;;; BDDPTR bdd_else (BDDPTR f)
(sb-alien:define-alien-routine ("bdd___bdd_else" bdd_else)
			       (* t)
  (f (* t)))

;;; BDDPTR bdd_apply (BDDPTR (*f)(BDDPTR,BDDPTR),BDDPTR a,BDDPTR b)
(sb-alien:define-alien-routine ("bdd___bdd_apply" bdd_apply)
			       (* t)
  (f (* t))
  (a (* t))
  (b (* t)))

;;; BDDPTR bdd_constrain (BDDPTR f, BDDPTR c)
(sb-alien:define-alien-routine ("bdd___bdd_constrain" bdd_constrain)
			       (* t)
  (f (* t))
  (c (* t)))

;;; BDDPTR bdd_top_var (BDDPTR f)
(sb-alien:define-alien-routine ("bdd___bdd_top_var" bdd_top_var)
			       (* t)
  (f (* t)))

;;; BDD_LIST bdd_sum_of_cubes (BDDPTR f, int irredundant)
(sb-alien:define-alien-routine ("bdd___bdd_sum_of_cubes" bdd_sum_of_cubes)
			       (* t)
  (f (* t))
  (irredundant (integer 32)))

(sb-alien:define-alien-variable ("bdd_interrupted" bdd_interrupted) (integer 32))

;;; The following were obtained by looking through mu.c and collecting
;;; functions not mentioned above.

;;; int bdd_reorder_var (int var_id, int target_var_id)
(sb-alien:define-alien-routine ("bdd___bdd_reorder_var" bdd_reorder_var)
			       (integer 32)
  (var_id (integer 32))
  (target_var (integer 32)))

;;; BDDPTR bdd_and_smooth (BDDPTR f, BDDPTR g, BDD_LIST vars)
(sb-alien:define-alien-routine ("bdd___bdd_and_smooth" bdd_and_smooth)
			       (* t)
  (f (* t))
  (g (* t))
  (vars (* t)))

;;; BDD_LIST bdd_rank_order_vars (BDD_LIST vars)
(sb-alien:define-alien-routine
 ("bdd___bdd_rank_order_vars" bdd_rank_order_vars)
			       (* t)
  (vars (* t)))

;;; BDDPTR bdd_quantify (int existential, BDDPTR f, BDD_LIST vars)
(sb-alien:define-alien-routine ("bdd___bdd_quantify" bdd_quantify)
			       (* t)
  (existential (integer 32))
  (f (* t))
  (vars (* t)))

;;; BDDPTR bdd_subst_par (BDDPTR *f_vec, BDD_LIST vars, BDDPTR g)
(sb-alien:define-alien-routine ("bdd___bdd_subst_par" bdd_subst_par)
			       (* t)
  (f_vec (array (* t)))
  (vars (* t))
  (g (* t)))

;;; BDDPTR bdd_subst_par_list (BDD_LIST f_list, BDD_LIST vars, BDDPTR g)
(sb-alien:define-alien-routine ("bdd___bdd_subst_par_list" bdd_subst_par_list)
			       (* t)
  (f_list (* t))
  (vars (* t))
  (g (* t)))

;;; void bdd_free_vec (BDDPTR *f_vec, int size)
(sb-alien:define-alien-routine ("bdd___bdd_free_vec" bdd_free_vec)
			       sb-alien:void
  (f_vec (array (* t)))
  (size (integer 32)))

;;; const char *bdd_get_output_string (int idx)
(sb-alien:define-alien-routine
 ("bdd___bdd_get_output_string" bdd_get_output_string)
			       sb-alien:c-string
  (idx (integer 32)))

;;; void bdd_set_output_string (int idx, const char *str)
(sb-alien:define-alien-routine
 ("bdd___bdd_set_output_string" bdd_set_output_string)
			       sb-alien:void
  (idx (integer 32))
  (str sb-alien:c-string))

;;; void bdd_print_as_sum_of_cubes (FILE *fp, BDDPTR f, int irredundant)
(sb-alien:define-alien-routine
 ("bdd___bdd_print_as_sum_of_cubes" bdd_print_as_sum_of_cubes)
			       sb-alien:void
  (fp (* t))
  (f (* t))
  (irredundant (integer 32)))

;;; BDDPTR bdd_diff (BDDPTR f, BDD_LIST vars)
(sb-alien:define-alien-routine ("bdd___bdd_diff" bdd_diff)
			       (* t)
  (f (* t))
  (vars (* t)))

;;; BDDPTR bdd_one_of_vec (BDDPTR *vec, int size)
(sb-alien:define-alien-routine ("bdd___bdd_one_of_vec" bdd_one_of_vec)
			       (* t)
  (vec (array (* t)))
  (size (integer 32)))

;;; BDDPTR bdd_none_of_vec (BDDPTR *args, int size)
(sb-alien:define-alien-routine ("bdd___bdd_none_of_vec" bdd_none_of_vec)
			       (* t)
  (args (array (* t)))
  (size (integer 32)))

;;; BDDPTR bdd_subst (BDDPTR f, int var, BDDPTR g)
(sb-alien:define-alien-routine ("bdd___bdd_subst" bdd_subst)
			       (* t)
  (f (* t))
  (var (integer 32))
  (g (* t)))

;;; BDD_LIST bdd_sum_of_cubes_as_list (BDDPTR f)
(sb-alien:define-alien-routine
 ("bdd___bdd_sum_of_cubes_as_list" bdd_sum_of_cubes_as_list)
			       (* t)
  (f (* t)))

;;; int bdd_traverse_cube (BDDPTR cube,
;;;                        void (*action) (int index, int neg, int first))
(sb-alien:define-alien-routine ("bdd___bdd_traverse_cube" bdd_traverse_cube)
			       (integer 32)
  (cube (* t))
  (action (* t)))

;;; BDD_LIST bdd_support_as_list_of_vars (BDDPTR f)
(sb-alien:define-alien-routine
 ("bdd___bdd_support_as_list_of_vars" bdd_support_as_list_of_vars)
			       (* t)
  (f (* t)))

(defun bdd-interrupted? ()
  (not (zerop 'bdd_interrupted)))

(bdd_init)

Lines 8-13 Link Here

(-)pvs4.2-orig/BDD/bdd_table.c (+2 lines)
8		8
9	int bdd___bdd_equal_p (BDDPTR F, BDDPTR G) {return bdd_equal_p (F, G);}	9	int bdd___bdd_equal_p (BDDPTR F, BDDPTR G) {return bdd_equal_p (F, G);}
10		10
		11	int bdd___null_list_p (LIST x) {return null_list_p (x);}
		12
11	void bdd___elem_contents (LIST_ELEM_PTR x) {elem_contents (x);}	13	void bdd___elem_contents (LIST_ELEM_PTR x) {elem_contents (x);}
12		14
13	LIST_ELEM_PTR bdd___list_first (LIST x) {	15	LIST_ELEM_PTR bdd___list_first (LIST x) {




BDD = ../bdd/src
MU = ../mu/src
UTILS = ../bdd/utils
INCLUDES = -I/usr/include -I$(BDD) -I$(UTILS) -I$(MU)
LD = ld
LDFLAGS = -Bsymbolic -shared -warn-once -L./
CC = gcc
CFLAGS = -D_POSIX_SOURCE -DSYSV $(INCLUDES) -DLINUX -DLINUX_REDHAT5 -DSIGNALS_LINUX -fPIC
XCFLAGS = -O
SHELL = /bin/sh
VPATH = ..:../bdd/utils:../bdd/src:../mu/src

muobj = bdd_interface.o bdd.o bdd_factor.o bdd_quant.o bdd_fns.o bdd_vfns.o \
        appl.o mu_interface.o mu.o

utilobj = double.o list.o hash.o alloc.o

.SUFFIXES:
.SUFFIXES: .c .o
.c.o : ; $(CC) $(XCFLAGS) ${CFLAGS} -c $< -o $@

all : mu.so

mu.so : ${muobj} libutils.a ../bdd-ld-table ../mu-ld-table 
	$(LD) ../bdd-ld-table ../mu-ld-table $(LDFLAGS) -o  mu.so  ${muobj} -lutils  -lm -lbsd

libutils.a : ${utilobj}
	ar r libutils.a ${utilobj}
	ranlib libutils.a

bdd_interface.o : bdd_interface.c bdd_fns.h
bdd_factor.o : bdd_factor.c bdd_factor.h
bdd.o : bdd.c bdd.h bdd_extern.h
bdd_fns.o : bdd_fns.c bdd_fns.h bdd.h bdd_extern.h
bdd_quant.o : bdd_quant.c bdd_fns.h bdd.h bdd_extern.h
bdd_vfns.o : bdd_vfns.c bdd_vfns.h bdd_fns.h bdd.h bdd_extern.h

mu_interface.o : mu_interface.c mu.h
mu.o : mu.c mu.h

double.o : double.c double.h
list.o : list.c list.h alloc.h
hash.o : hash.c hash.h alloc.h
alloc.o : alloc.c

clean : 
	rm -f *.o *.a *.so





;; --------------------------------------------------------------------
;; PVS
;; Copyright (C) 2006, SRI International.  All Rights Reserved.

;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License
;; as published by the Free Software Foundation; either version 2
;; of the License, or (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software
;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
;; --------------------------------------------------------------------
(in-package :pvs)


;;;;;;;;;;;;;;;;;
;;;  Formula  ;;;
;;;;;;;;;;;;;;;;;

;;; Formula mu_mk_false_formula (void)
(sb-alien:define-alien-routine ("mu___mu_mk_false_formula" mu_mk_false_formula)
			       (* t))

;;; Formula mu_mk_true_formula (void)
(sb-alien:define-alien-routine ("mu___mu_mk_true_formula" mu_mk_true_formula)
			       (* t))

;;; Formula mu_mk_bool_var (char *name)
(sb-alien:define-alien-routine ("mu___mu_mk_bool_var" mu_mk_bool_var)
			       (* t)
  (name sb-alien:c-string))

;;; int mu_check_bool_var (char *name)
(sb-alien:define-alien-routine ("mu___mu_check_bool_var" mu_check_bool_var)
			       (integer 32)
  (var sb-alien:c-string))

;;; Formula mu_check_mk_bool_var (char *name)
(sb-alien:define-alien-routine
 ("mu___mu_check_mk_bool_var" mu_check_mk_bool_var)
			       (* t)
  (name sb-alien:c-string))

;;; Formula mu_mk_ite_formula (Formula cond, Formula then_part, Formula else_part)
(sb-alien:define-alien-routine ("mu___mu_mk_ite_formula" mu_mk_ite_formula)
			       (* t)
  (cnd (* t))
  (then_part (* t))
  (else_part (* t)))

;;; Formula mu_mk_curry_application (Term R, LIST subs)
(sb-alien:define-alien-routine
 ("mu___mu_mk_curry_application" mu_mk_curry_application)
			       (* t)
  (R (* t))
  (subs (* t)))

;;; Formula mu_mk_application (Term R, LIST subs, int curried)
(sb-alien:define-alien-routine ("mu___mu_mk_application" mu_mk_application)
			       (* t)
  (R (* t))
  (subs (* t))
  (curried (integer 32)))

;;; Formula mu_mk_forall (LIST listvars, Formula fml)
(sb-alien:define-alien-routine ("mu___mu_mk_forall" mu_mk_forall)
			       (* t)
  (listvars (* t))
  (fml (* t)))

;;; Formula mu_mk_exists (LIST listvars, Formula fml)
(sb-alien:define-alien-routine ("mu___mu_mk_exists" mu_mk_exists)
			       (* t)
  (listvars (* t))
  (fml (* t)))

;;; Formula mu_mk_implies_formula (Formula fml1, Formula fml2)
(sb-alien:define-alien-routine
 ("mu___mu_mk_implies_formula" mu_mk_implies_formula)
			       (* t)
  (fml1 (* t))
  (fml2 (* t)))

;;; Formula mu_mk_equiv_formula (Formula fml1, Formula fml2)
(sb-alien:define-alien-routine ("mu___mu_mk_equiv_formula" mu_mk_equiv_formula)
			       (* t)
  (fml1 (* t))
  (fml2 (* t)))

;;; Formula mu_mk_or_formula (Formula fml1, Formula fml2)
(sb-alien:define-alien-routine ("mu___mu_mk_or_formula" mu_mk_or_formula)
			       (* t)
  (fml1 (* t))
  (fml2 (* t)))

;;; Formula mu_mk_and_formula (Formula fml1, Formula fml2)
(sb-alien:define-alien-routine ("mu___mu_mk_and_formula" mu_mk_and_formula)
			       (* t)
  (fml1 (* t))
  (fml2 (* t)))

;;; Formula mu_mk_not_formula (Formula fml)
(sb-alien:define-alien-routine ("mu___mu_mk_not_formula" mu_mk_not_formula)
			       (* t)
  (fml (* t)))

;;; Formula mu_mk_cofactor (Formula fml1, Formula fml2)
(sb-alien:define-alien-routine ("mu___mu_mk_cofactor" mu_mk_cofactor)
			       (* t)
  (fml1 (* t))
  (fml2 (* t)))

;;;;;;;;;;;;;;;
;;;  Term   ;;;
;;;;;;;;;;;;;;;
;;; Term mu_mk_abstraction (LIST vars, Formula f1)
(sb-alien:define-alien-routine ("mu___mu_mk_abstraction" mu_mk_abstraction)
			       (* t)
  (vars (* t))
  (f1 (* t)))
;;; Term mu_mk_l_fixed_point (int relvar, Term fml1)
(sb-alien:define-alien-routine ("mu___mu_mk_l_fixed_point" mu_mk_l_fixed_point)
			       (* t)
  (relvar (integer 32))
  (fml1 (* t)))
;;; Term mu_mk_g_fixed_point (int relvar, Term fml1)
(sb-alien:define-alien-routine ("mu___mu_mk_g_fixed_point" mu_mk_g_fixed_point)
			       (* t)
  (relvar (integer 32))
  (fml1 (* t)))
;;; Term mu_mk_reach (Term Next, Term S0, Term Inv)
(sb-alien:define-alien-routine ("mu___mu_mk_reach" mu_mk_reach)
			       (* t)
  (Next (* t))
  (S0 (* t))
  (Inv (* t)))
;;; Term mu_mk_rel_var_dcl (char *name)
(sb-alien:define-alien-routine ("mu___mu_mk_rel_var_dcl" mu_mk_rel_var_dcl)
			       (* t)
  (name sb-alien:c-string))
;;; Term mu_mk_rel_var_ (char *name)
(sb-alien:define-alien-routine ("mu___mu_mk_rel_var_" mu_mk_rel_var_)
			       (* t)
  (name sb-alien:c-string))
;;; Term mu_mk_true_term (void)
(sb-alien:define-alien-routine ("mu___mu_mk_true_term" mu_mk_true_term)
			       (* t))
;;; Term mu_mk_false_term (void)
(sb-alien:define-alien-routine ("mu___mu_mk_false_term" mu_mk_false_term)
			       (* t))
;;; Term mu_mk_not_term (Term fml1)
(sb-alien:define-alien-routine ("mu___mu_mk_not_term" mu_mk_not_term)
			       (* t)
  (fml1 (* t)))
;;; Term mu_mk_and_term (Term fml1, Term fml2)
(sb-alien:define-alien-routine ("mu___mu_mk_and_term" mu_mk_and_term)
			       (* t)
  (fml1 (* t))
  (fml2 (* t)))
;;; Term mu_mk_or_term (Term fml1, Term fml2)
(sb-alien:define-alien-routine ("mu___mu_mk_or_term" mu_mk_or_term)
			       (* t)
  (fml1 (* t))
  (fml2 (* t)))
;;; Term mu_mk_equiv_term (Term fml1, Term fml2)
(sb-alien:define-alien-routine ("mu___mu_mk_equiv_term" mu_mk_equiv_term)
			       (* t)
  (fml1 (* t))
  (fml2 (* t)))
;;; Term mu_mk_implies_term (Term fml1, Term fml2)
(sb-alien:define-alien-routine ("mu___mu_mk_implies_term" mu_mk_implies_term)
			       (* t)
  (fml1 (* t))
  (fml2 (* t)))
;;; const char *get_mu_bool_var_name (int bdd_idx)
(sb-alien:define-alien-routine
 ("mu___get_mu_bool_var_name" get_mu_bool_var_name)
			       sb-alien:c-string
  (bdd_idx (integer 32)))

;;;;;;;;;;;;;;;;;;;
;;;  Lists      ;;;
;;;;;;;;;;;;;;;;;;;

;;; LIST append_cont (void *p, LIST list)
(sb-alien:define-alien-routine ("mu___append_cont" append_cont)
			       (* t)
  (p (* t))
  (list (* t)))
;;; LIST empty_list (void)
(sb-alien:define-alien-routine ("mu___empty_list" empty_list)
			       (* t))

;;;
;;; Flags

;;; int set_mu_warnings (int flag)
(sb-alien:define-alien-routine ("mu___set_mu_warnings" set_mu_warnings)
			       (integer 32)
  (flag (integer 32)))
;;; int set_mu_simplify_frontier (int flag)
(sb-alien:define-alien-routine
 ("mu___set_mu_simplify_frontier" set_mu_simplify_frontier)
			       (integer 32)
  (flag (integer 32)))
;;; int set_mu_verbose (int flag)
(sb-alien:define-alien-routine ("mu___set_mu_verbose" set_mu_verbose)
			       (integer 32)
  (flag (integer 32)))

;;
;;
;; GC management: not needed, "modelcheck_formula" takes care of it.
;;

;;;;;;;;;;;;;;;;;;;
;;;  print      ;;;
;;;;;;;;;;;;;;;;;;;

;;; void pvs_mu_print_formula (Formula fml)
(sb-alien:define-alien-routine
 ("mu___pvs_mu_print_formula" pvs_mu_print_formula)
			       sb-alien:void
  (fml (* t)))
;;; void pvs_mu_print_term (Term t)
(sb-alien:define-alien-routine ("mu___pvs_mu_print_term" pvs_mu_print_term)
			       sb-alien:void
  (term (* t)))

;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Main function   ;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;

;;; void mu_init (void)
(sb-alien:define-alien-routine ("mu___mu_init" mu_init)
			       sb-alien:void)
(sb-alien:define-alien-routine ("mu___mu_quit" mu_quit)
			       sb-alien:void)
;;; BDDPTR mu___modelcheck_formula (Formula fml)
(sb-alien:define-alien-routine ("mu___modelcheck_formula" modelcheck_formula)
			       (* t)
  (fml (* t)))




  src/groundeval/*.lisp \
  src/utils/*.lisp \
  src/utils/ix86-Linux/Makefile src/utils/ix86-MacOSX/Makefile \
  src/utils/ix86_64-Linux/Makefile \
  src/utils/powerpc-MacOSX/Makefile \
  src/utils/sun4-SunOS5/Makefile \
  BDD/bdd-ld-table BDD/mu-ld-table \
  BDD/*.c \
  BDD/*.lisp \
  BDD/ix86-Linux/Makefile BDD/ix86_64-Linux/Makefile BDD/sun4-SunOS5/Makefile \
  BDD/ix86-MacOSX/Makefile BDD/powerpc-MacOSX/Makefile \
  BDD/bdd BDD/mu \
  src/WS1S/README src/WS1S/ws1s-ld-table \
  src/WS1S/*.c src/WS1S/mona-1.4 \
  src/WS1S/ix86_64-Linux/Makefile
  src/WS1S/ix86-Linux/Makefile src/WS1S/sun4-SunOS5/Makefile \
  src/WS1S/ix86-MacOSX/Makefile src/WS1S/powerpc-MacOSX/Makefile \
  doc/pvs.bib doc/makebnf.sty doc/pvstex.tex doc/release-notes \

# echo "pvs-libraries.tgz not created - need to typecheck finite_sets and bitvectors"
# fi

for platform in ix86-Linux ix86_64-Linux ix86-MacOSX powerpc-MacOSX \
                sun4-SunOS5
  do
  for subdir in runtime devel

    else
     echo "CMU Lisp ${subdir} not available for ${platform}"
   fi
   if [ -e bin/${platform}/${subdir}/pvs-sbclisp -a "$subdir" = "runtime" ]
    then
     echo Creating pvs-${version}-${platform}-sbclisp${kind}.tgz
     tar ${TARFLAGS} -f pvs-${version}-${platform}-sbclisp${kind}.tgz \
	  ${pvssystemfiles} \
	  bin/${platform}/b64 bin/relocate \
	  bin/pvs-platform bin/tar-b64-mail \
	  bin/${platform}/${subdir}/mu.* \
	  bin/${platform}/${subdir}/file_utils.* \
	  bin/${platform}/${subdir}/ws1s.* \
	  bin/${platform}/${subdir}/*-sbcl.* \
	  bin/${platform}/${subdir}/lisp \
	  bin/${platform}/${subdir}/pvs-sbclisp*
     ls -l pvs-${version}-${platform}-sbclisp${kind}.tgz
    else
     echo "SBCL ${subdir} not available for ${platform}"
   fi
   done
  done

Lines 33-39 Link Here

(-)pvs4.2-orig/bin/pvs-platform (-1 / +5 lines)
33	esac	33	esac
34	os=SunOS	34	os=SunOS
35	os_version=`uname -r \| cut -d"." -f1`;;	35	os_version=`uname -r \| cut -d"." -f1`;;
36	Linux) arch=ix86	36	Linux) case `uname -m` in
		37	x86_64) arch=ix86_64;;
		38	i*86) arch=ix86;;
		39	x86*) arch=ix86;;
		40	esac
37	os=Linux;;	41	os=Linux;;
38	AIX) arch=powerpc-ibm	42	AIX) arch=powerpc-ibm
39	os=AIX	43	os=AIX




#! /bin/sh
# Attempt to guess a canonical system name.
#   Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
#   2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
#   Free Software Foundation, Inc.

timestamp='2008-12-19'

# This file is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by

#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA
# 02110-1301, USA.
#
# As a special exception to the GNU General Public License, if you
# distribute this file as part of a program that contains a
# configuration script generated by Autoconf, you may include it under
# the same distribution terms that you use for the rest of that program.


# Originally written by Per Bothner <per@bothner.com>.
# Please send patches to <config-patches@gnu.org>.  Submit a context
# diff and a properly formatted ChangeLog entry.

GNU config.guess ($timestamp)

Originally written by Per Bothner.
Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001,
2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.

This is free software; see the source for copying conditions.  There is NO
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE."

while test $# -gt 0 ; do
  case $1 in
    --time-stamp | --time* | -t )
       echo "$timestamp" ; exit ;;
    --version | -v )
       echo "$version" ; exit ;;
    --help | --h* | -h )
       echo "$usage"; exit ;;
    -- )     # Stop option processing
       shift; break ;;
    - )	# Use stdin as input.

trap "exitcode=\$?; (rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null) && exit \$exitcode" 0 ;
trap "rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null; exit 1" 1 2 13 15 ;
: ${TMPDIR=/tmp} ;
 { tmp=`(umask 077 && mktemp -d "$TMPDIR/cgXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" ; } ||
 { test -n "$RANDOM" && tmp=$TMPDIR/cg$$-$RANDOM && (umask 077 && mkdir $tmp) ; } ||
 { tmp=$TMPDIR/cg-$$ && (umask 077 && mkdir $tmp) && echo "Warning: creating insecure temp directory" >&2 ; } ||
 { echo "$me: cannot create a temporary directory in $TMPDIR" >&2 ; exit 1 ; } ;

	;;
 ,,*)   CC_FOR_BUILD=$CC ;;
 ,*,*)  CC_FOR_BUILD=$HOST_CC ;;
esac ; set_cc_for_build= ;'

# This is needed to find uname on a Pyramid OSx when run in the BSD universe.
# (ghazi@noc.rutgers.edu 1994-08-24)

UNAME_SYSTEM=`(uname -s) 2>/dev/null`  || UNAME_SYSTEM=unknown
UNAME_VERSION=`(uname -v) 2>/dev/null` || UNAME_VERSION=unknown

## for Red Hat Linux
if test -f /etc/redhat-release ; then
    VENDOR=redhat ;
else
    VENDOR= ;
fi

# Note: order is significant - the case branches are not exclusive.

case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in

	    arm*) machine=arm-unknown ;;
	    sh3el) machine=shl-unknown ;;
	    sh3eb) machine=sh-unknown ;;
	    sh5el) machine=sh5le-unknown ;;
	    *) machine=${UNAME_MACHINE_ARCH}-unknown ;;
	esac
	# The Operating System including object format, if it has switched

	# contains redundant information, the shorter form:
	# CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM is used.
	echo "${machine}-${os}${release}"
	exit ;;
    amiga:OpenBSD:*:*)
	echo m68k-unknown-openbsd${UNAME_RELEASE}
	exit 0 ;;
    arc:OpenBSD:*:*)
	echo mipsel-unknown-openbsd${UNAME_RELEASE}
	exit 0 ;;
    hp300:OpenBSD:*:*)
	echo m68k-unknown-openbsd${UNAME_RELEASE}
	exit 0 ;;
    mac68k:OpenBSD:*:*)
	echo m68k-unknown-openbsd${UNAME_RELEASE}
	exit 0 ;;
    macppc:OpenBSD:*:*)
	echo powerpc-unknown-openbsd${UNAME_RELEASE}
	exit 0 ;;
    mvme68k:OpenBSD:*:*)
	echo m68k-unknown-openbsd${UNAME_RELEASE}
	exit 0 ;;
    mvme88k:OpenBSD:*:*)
	echo m88k-unknown-openbsd${UNAME_RELEASE}
	exit 0 ;;
    mvmeppc:OpenBSD:*:*)
	echo powerpc-unknown-openbsd${UNAME_RELEASE}
	exit 0 ;;
    pmax:OpenBSD:*:*)
	echo mipsel-unknown-openbsd${UNAME_RELEASE}
	exit 0 ;;
    sgi:OpenBSD:*:*)
	echo mipseb-unknown-openbsd${UNAME_RELEASE}
	exit 0 ;;
    sun3:OpenBSD:*:*)
	echo m68k-unknown-openbsd${UNAME_RELEASE}
	exit 0 ;;
    wgrisc:OpenBSD:*:*)
	echo mipsel-unknown-openbsd${UNAME_RELEASE}
	exit 0 ;;
    *:OpenBSD:*:*)
	UNAME_MACHINE_ARCH=`arch | sed 's/OpenBSD.//'`
	echo ${UNAME_MACHINE_ARCH}-unknown-openbsd${UNAME_RELEASE}
	exit ;;
    *:ekkoBSD:*:*)
	echo ${UNAME_MACHINE}-unknown-ekkobsd${UNAME_RELEASE}
	exit ;;
    *:SolidBSD:*:*)
	echo ${UNAME_MACHINE}-unknown-solidbsd${UNAME_RELEASE}
	exit ;;
    macppc:MirBSD:*:*)
	echo powerpc-unknown-mirbsd${UNAME_RELEASE}
	exit ;;
    *:MirBSD:*:*)
	echo ${UNAME_MACHINE}-unknown-mirbsd${UNAME_RELEASE}
	exit ;;
    alpha:OSF1:*:*)
	case $UNAME_RELEASE in
	*4.0)
		UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $3}'`
		;;
	*5.*)
	        UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $4}'`
		;;
	esac
	# According to Compaq, /usr/sbin/psrinfo has been available on
	# OSF/1 and Tru64 systems produced since 1995.  I hope that
	# covers most systems running today.  This code pipes the CPU

	    "EV7.9 (21364A)")
		UNAME_MACHINE="alphaev79" ;;
	esac
	# A Pn.n version is a patched version.
	# A Vn.n version is a released version.
	# A Tn.n version is a released field test version.
	# A Xn.n version is an unreleased experimental baselevel.
	# 1.2 uses "1.2" for uname -r.
	echo ${UNAME_MACHINE}-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^[PVTX]//' | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'`
	exit ;;
    Alpha*:OpenVMS:*:*)
	echo alpha-hp-vms
	exit 0 ;;
    Alpha\ *:Windows_NT*:*)
	# How do we know it's Interix rather than the generic POSIX subsystem?
	# Should we change UNAME_MACHINE based on the output of uname instead
	# of the specific Alpha model?
	echo alpha-pc-interix
	exit ;;
    21064:Windows_NT:50:3)
	echo alpha-dec-winnt3.5
	exit ;;
    Amiga*:UNIX_System_V:4.0:*)
	echo m68k-unknown-sysv4
	exit ;;
    *:[Aa]miga[Oo][Ss]:*:*)
	echo ${UNAME_MACHINE}-unknown-amigaos
	exit ;;
    *:[Mm]orph[Oo][Ss]:*:*)
	echo ${UNAME_MACHINE}-unknown-morphos
	exit ;;
    *:OS/390:*:*)
	echo i370-ibm-openedition
	exit ;;
    *:z/VM:*:*)
	echo s390-ibm-zvmoe
	exit ;;
    *:OS400:*:*)
        echo powerpc-ibm-os400
	exit ;;
    arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*)
	echo arm-acorn-riscix${UNAME_RELEASE}
	exit ;;
    arm:riscos:*:*|arm:RISCOS:*:*)
	echo arm-unknown-riscos
	exit ;;
    SR2?01:HI-UX/MPP:*:* | SR8000:HI-UX/MPP:*:*)
	echo hppa1.1-hitachi-hiuxmpp
	exit ;;
    Pyramid*:OSx*:*:* | MIS*:OSx*:*:* | MIS*:SMP_DC-OSx*:*:*)
	# akee@wpdis03.wpafb.af.mil (Earle F. Ake) contributed MIS and NILE.
	if test "`(/bin/universe) 2>/dev/null`" = att ; then

	else
		echo pyramid-pyramid-bsd
	fi
	exit ;;
    NILE*:*:*:dcosx)
	echo pyramid-pyramid-svr4
	exit ;;
    DRS?6000:unix:4.0:6*)
	echo sparc-icl-nx6
	exit ;;
    DRS?6000:UNIX_SV:4.2*:7* | DRS?6000:isis:4.2*:7*)
	case `/usr/bin/uname -p` in
	    sparc) echo sparc-icl-nx7; exit ;;
	esac ;;
    sun4H:SunOS:5.*:*)
	echo sparc-hal-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
	exit ;;
    sun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*)
	echo sparc-sun-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
	exit ;;
    i86pc:SunOS:5.*:* | i86xen:SunOS:5.*:*)
	eval $set_cc_for_build
	SUN_ARCH="i386"
	# If there is a compiler, see if it is configured for 64-bit objects.
	# Note that the Sun cc does not turn __LP64__ into 1 like gcc does.
	# This test works for both compilers.
	if [ "$CC_FOR_BUILD" != 'no_compiler_found' ]; then
	    if (echo '#ifdef __amd64'; echo IS_64BIT_ARCH; echo '#endif') | \
		(CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | \
		grep IS_64BIT_ARCH >/dev/null
	    then
		SUN_ARCH="x86_64"
	    fi
	fi
	echo ${SUN_ARCH}-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
	exit ;;
    sun4*:SunOS:6*:*)
	# According to config.sub, this is the proper way to canonicalize
	# SunOS6.  Hard to guess exactly what SunOS6 will be like, but
	# it's likely to be more like Solaris than SunOS4.
	echo sparc-sun-solaris3`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
	exit ;;
    sun4*:SunOS:*:*)
	case "`/usr/bin/arch -k`" in
	    Series*|S4*)

	esac
	# Japanese Language versions have a version number like `4.1.3-JL'.
	echo sparc-sun-sunos`echo ${UNAME_RELEASE}|sed -e 's/-/_/'`
	exit ;;
    sun3*:SunOS:*:*)
	echo m68k-sun-sunos${UNAME_RELEASE}
	exit ;;
    sun*:*:4.2BSD:*)
	UNAME_RELEASE=`(sed 1q /etc/motd | awk '{print substr($5,1,3)}') 2>/dev/null`
	test "x${UNAME_RELEASE}" = "x" && UNAME_RELEASE=3

		echo sparc-sun-sunos${UNAME_RELEASE}
		;;
	esac
	exit ;;
    aushp:SunOS:*:*)
	echo sparc-auspex-sunos${UNAME_RELEASE}
	exit ;;
    # The situation for MiNT is a little confusing.  The machine name
    # can be virtually everything (everything which is not
    # "atarist" or "atariste" at least should have a processor

    # be no problem.
    atarist[e]:*MiNT:*:* | atarist[e]:*mint:*:* | atarist[e]:*TOS:*:*)
        echo m68k-atari-mint${UNAME_RELEASE}
	exit ;;
    atari*:*MiNT:*:* | atari*:*mint:*:* | atarist[e]:*TOS:*:*)
	echo m68k-atari-mint${UNAME_RELEASE}
        exit ;;
    *falcon*:*MiNT:*:* | *falcon*:*mint:*:* | *falcon*:*TOS:*:*)
        echo m68k-atari-mint${UNAME_RELEASE}
	exit ;;
    milan*:*MiNT:*:* | milan*:*mint:*:* | *milan*:*TOS:*:*)
        echo m68k-milan-mint${UNAME_RELEASE}
        exit ;;
    hades*:*MiNT:*:* | hades*:*mint:*:* | *hades*:*TOS:*:*)
        echo m68k-hades-mint${UNAME_RELEASE}
        exit ;;
    *:*MiNT:*:* | *:*mint:*:* | *:*TOS:*:*)
        echo m68k-unknown-mint${UNAME_RELEASE}
        exit ;;
    m68k:machten:*:*)
	echo m68k-apple-machten${UNAME_RELEASE}
	exit ;;
    powerpc:machten:*:*)
	echo powerpc-apple-machten${UNAME_RELEASE}
	exit ;;
    RISC*:Mach:*:*)
	echo mips-dec-mach_bsd4.3
	exit ;;
    RISC*:ULTRIX:*:*)
	echo mips-dec-ultrix${UNAME_RELEASE}
	exit ;;
    VAX*:ULTRIX*:*:*)
	echo vax-dec-ultrix${UNAME_RELEASE}
	exit ;;
    2020:CLIX:*:* | 2430:CLIX:*:*)
	echo clipper-intergraph-clix${UNAME_RELEASE}
	exit ;;
    mips:*:*:UMIPS | mips:*:*:RISCos)
	eval $set_cc_for_build
	sed 's/^	//' << EOF >$dummy.c

	  exit (-1);
	}
EOF
	$CC_FOR_BUILD -o $dummy $dummy.c &&
	  dummyarg=`echo "${UNAME_RELEASE}" | sed -n 's/\([0-9]*\).*/\1/p'` &&
	  SYSTEM_NAME=`$dummy $dummyarg` &&
	    { echo "$SYSTEM_NAME"; exit; }
	echo mips-mips-riscos${UNAME_RELEASE}
	exit ;;
    Motorola:PowerMAX_OS:*:*)
	echo powerpc-motorola-powermax
	exit ;;
    Motorola:*:4.3:PL8-*)
	echo powerpc-harris-powermax
	exit ;;
    Night_Hawk:*:*:PowerMAX_OS | Synergy:PowerMAX_OS:*:*)
	echo powerpc-harris-powermax
	exit ;;
    Night_Hawk:Power_UNIX:*:*)
	echo powerpc-harris-powerunix
	exit ;;
    m88k:CX/UX:7*:*)
	echo m88k-harris-cxux7
	exit ;;
    m88k:*:4*:R4*)
	echo m88k-motorola-sysv4
	exit ;;
    m88k:*:3*:R3*)
	echo m88k-motorola-sysv3
	exit ;;
    AViiON:dgux:*:*)
        # DG/UX returns AViiON for all architectures
        UNAME_PROCESSOR=`/usr/bin/uname -p`

	else
	    echo i586-dg-dgux${UNAME_RELEASE}
	fi
 	exit ;;
    M88*:DolphinOS:*:*)	# DolphinOS (SVR3)
	echo m88k-dolphin-sysv3
	exit ;;
    M88*:*:R3*:*)
	# Delta 88k system running SVR3
	echo m88k-motorola-sysv3
	exit ;;
    XD88*:*:*:*) # Tektronix XD88 system running UTekV (SVR3)
	echo m88k-tektronix-sysv3
	exit ;;
    Tek43[0-9][0-9]:UTek:*:*) # Tektronix 4300 system running UTek (BSD)
	echo m68k-tektronix-bsd
	exit ;;
    *:IRIX*:*:*)
	echo mips-sgi-irix`echo ${UNAME_RELEASE}|sed -e 's/-/_/g'`
	exit ;;
    ????????:AIX?:[12].1:2)   # AIX 2.2.1 or AIX 2.1.1 is RT/PC AIX.
	echo romp-ibm-aix     # uname -m gives an 8 hex-code CPU id
	exit ;;               # Note that: echo "'`uname -s`'" gives 'AIX '
    i*86:AIX:*:*)
	echo i386-ibm-aix
	exit ;;
    ia64:AIX:*:*)
	if [ -x /usr/bin/oslevel ] ; then
		IBM_REV=`/usr/bin/oslevel`

		IBM_REV=${UNAME_VERSION}.${UNAME_RELEASE}
	fi
	echo ${UNAME_MACHINE}-ibm-aix${IBM_REV}
	exit ;;
    *:AIX:2:3)
	if grep bos325 /usr/include/stdio.h >/dev/null 2>&1; then
		eval $set_cc_for_build

			exit(0);
			}
EOF
		if $CC_FOR_BUILD -o $dummy $dummy.c && SYSTEM_NAME=`$dummy`
		then
			echo "$SYSTEM_NAME"
		else
			echo rs6000-ibm-aix3.2.5
		fi
	elif grep bos324 /usr/include/stdio.h >/dev/null 2>&1; then
		echo rs6000-ibm-aix3.2.4
	else
		echo rs6000-ibm-aix3.2
	fi
	exit ;;
    *:AIX:*:[456])
	IBM_CPU_ID=`/usr/sbin/lsdev -C -c processor -S available | sed 1q | awk '{ print $1 }'`
	if /usr/sbin/lsattr -El ${IBM_CPU_ID} | grep ' POWER' >/dev/null 2>&1; then
		IBM_ARCH=rs6000

		IBM_REV=${UNAME_VERSION}.${UNAME_RELEASE}
	fi
	echo ${IBM_ARCH}-ibm-aix${IBM_REV}
	exit ;;
    *:AIX:*:*)
	echo rs6000-ibm-aix
	exit ;;
    ibmrt:4.4BSD:*|romp-ibm:BSD:*)
	echo romp-ibm-bsd4.4
	exit ;;
    ibmrt:*BSD:*|romp-ibm:BSD:*)            # covers RT/PC BSD and
	echo romp-ibm-bsd${UNAME_RELEASE}   # 4.3 with uname added to
	exit ;;                             # report: romp-ibm BSD 4.3
    *:BOSX:*:*)
	echo rs6000-bull-bosx
	exit ;;
    DPX/2?00:B.O.S.:*:*)
	echo m68k-bull-sysv3
	exit ;;
    9000/[34]??:4.3bsd:1.*:*)
	echo m68k-hp-bsd
	exit ;;
    hp300:4.4BSD:*:* | 9000/[34]??:4.3bsd:2.*:*)
	echo m68k-hp-bsd4.4
	exit ;;
    9000/[34678]??:HP-UX:*:*)
	HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'`
	case "${UNAME_MACHINE}" in

	esac
	if [ ${HP_ARCH} = "hppa2.0w" ]
	then
	    eval $set_cc_for_build

	    # hppa2.0w-hp-hpux* has a 64-bit kernel and a compiler generating
	    # 32-bit code.  hppa64-hp-hpux* has the same kernel and a compiler
	    # generating 64-bit code.  GNU and HP use different nomenclature:
	    #
	    # $ CC_FOR_BUILD=cc ./config.guess
	    # => hppa2.0w-hp-hpux11.23
	    # $ CC_FOR_BUILD="cc +DA2.0w" ./config.guess
	    # => hppa64-hp-hpux11.23

	    if echo __LP64__ | (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) |
		grep __LP64__ >/dev/null
	    then
		HP_ARCH="hppa2.0w"
	    else

	    fi
	fi
	echo ${HP_ARCH}-hp-hpux${HPUX_REV}
	exit ;;
    ia64:HP-UX:*:*)
	HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'`
	echo ia64-hp-hpux${HPUX_REV}
	exit ;;
    3050*:HI-UX:*:*)
	eval $set_cc_for_build
	sed 's/^	//' << EOF >$dummy.c

	  exit (0);
	}
EOF
	$CC_FOR_BUILD -o $dummy $dummy.c && SYSTEM_NAME=`$dummy` &&
		{ echo "$SYSTEM_NAME"; exit; }
	echo unknown-hitachi-hiuxwe2
	exit ;;
    9000/7??:4.3bsd:*:* | 9000/8?[79]:4.3bsd:*:* )
	echo hppa1.1-hp-bsd
	exit ;;
    9000/8??:4.3bsd:*:*)
	echo hppa1.0-hp-bsd
	exit ;;
    *9??*:MPE/iX:*:* | *3000*:MPE/iX:*:*)
	echo hppa1.0-hp-mpeix
	exit ;;
    hp7??:OSF1:*:* | hp8?[79]:OSF1:*:* )
	echo hppa1.1-hp-osf
	exit ;;
    hp8??:OSF1:*:*)
	echo hppa1.0-hp-osf
	exit ;;
    i*86:OSF1:*:*)
	if [ -x /usr/sbin/sysversion ] ; then
	    echo ${UNAME_MACHINE}-unknown-osf1mk
	else
	    echo ${UNAME_MACHINE}-unknown-osf1
	fi
	exit ;;
    parisc*:Lites*:*:*)
	echo hppa1.1-hp-lites
	exit ;;
    C1*:ConvexOS:*:* | convex:ConvexOS:C1*:*)
	echo c1-convex-bsd
        exit ;;
    C2*:ConvexOS:*:* | convex:ConvexOS:C2*:*)
	if getsysinfo -f scalar_acc
	then echo c32-convex-bsd
	else echo c2-convex-bsd
	fi
        exit ;;
    C34*:ConvexOS:*:* | convex:ConvexOS:C34*:*)
	echo c34-convex-bsd
        exit ;;
    C38*:ConvexOS:*:* | convex:ConvexOS:C38*:*)
	echo c38-convex-bsd
        exit ;;
    C4*:ConvexOS:*:* | convex:ConvexOS:C4*:*)
	echo c4-convex-bsd
        exit ;;
    CRAY*Y-MP:*:*:*)
	echo ymp-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'
	exit ;;
    CRAY*[A-Z]90:*:*:*)
	echo ${UNAME_MACHINE}-cray-unicos${UNAME_RELEASE} \
	| sed -e 's/CRAY.*\([A-Z]90\)/\1/' \
	      -e y/ABCDEFGHIJKLMNOPQRSTUVWXYZ/abcdefghijklmnopqrstuvwxyz/ \
	      -e 's/\.[^.]*$/.X/'
	exit ;;
    CRAY*TS:*:*:*)
	echo t90-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'
	exit ;;
    CRAY*T3E:*:*:*)
	echo alphaev5-cray-unicosmk${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'
	exit ;;
    CRAY*SV1:*:*:*)
	echo sv1-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'
	exit ;;
    *:UNICOS/mp:*:*)
	echo craynv-cray-unicosmp${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'
	exit ;;
    F30[01]:UNIX_System_V:*:* | F700:UNIX_System_V:*:*)
	FUJITSU_PROC=`uname -m | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'`
        FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'`
        FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'`
        echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}"
        exit ;;
    5000:UNIX_System_V:4.*:*)
        FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'`
        FUJITSU_REL=`echo ${UNAME_RELEASE} | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/ /_/'`
        echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}"
	exit ;;
    i*86:BSD/386:*:* | i*86:BSD/OS:*:* | *:Ascend\ Embedded/OS:*:*)
	echo ${UNAME_MACHINE}-pc-bsdi${UNAME_RELEASE}
	exit ;;
    sparc*:BSD/OS:*:*)
	echo sparc-unknown-bsdi${UNAME_RELEASE}
	exit ;;
    *:BSD/OS:*:*)
	echo ${UNAME_MACHINE}-unknown-bsdi${UNAME_RELEASE}
	exit ;;
    *:FreeBSD:*:*)
	case ${UNAME_MACHINE} in
	    pc98)
		echo i386-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;;
	    amd64)
		echo x86_64-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;;
	    *)
		echo ${UNAME_MACHINE}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;;
	esac
	exit ;;
EOF
	eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep ^LIBC=`
	echo ${UNAME_MACHINE}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`${LIBC:+-$LIBC}
	exit 0 ;;
    i*:CYGWIN*:*)
	echo ${UNAME_MACHINE}-pc-cygwin
	exit ;;
    *:MINGW*:*)
	echo ${UNAME_MACHINE}-pc-mingw32
	exit ;;
    i*:windows32*:*)
    	# uname -m includes "-pc" on this system.
    	echo ${UNAME_MACHINE}-mingw32
	exit ;;
    i*:PW*:*)
	echo ${UNAME_MACHINE}-pc-pw32
	exit ;;
    *:Interix*:[3456]*)
    	case ${UNAME_MACHINE} in
	    x86)
		echo i586-pc-interix${UNAME_RELEASE}
		exit ;;
	    EM64T | authenticamd | genuineintel)
		echo x86_64-unknown-interix${UNAME_RELEASE}
		exit ;;
	    IA64)
		echo ia64-unknown-interix${UNAME_RELEASE}
		exit ;;
	esac ;;
    [345]86:Windows_95:* | [345]86:Windows_98:* | [345]86:Windows_NT:*)
	echo i${UNAME_MACHINE}-pc-mks
	exit ;;
    i*:Windows_NT*:* | Pentium*:Windows_NT*:*)
	# How do we know it's Interix rather than the generic POSIX subsystem?
	# It also conflicts with pre-2.0 versions of AT&T UWIN. Should we
	# UNAME_MACHINE based on the output of uname instead of i386?
	echo i586-pc-interix
	exit ;;
    i*:UWIN*:*)
	echo ${UNAME_MACHINE}-pc-uwin
	exit ;;
    amd64:CYGWIN*:*:* | x86_64:CYGWIN*:*:*)
	echo x86_64-unknown-cygwin
	exit ;;
    p*:CYGWIN*:*)
	echo powerpcle-unknown-cygwin
	exit ;;
    prep*:SunOS:5.*:*)
	echo powerpcle-unknown-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
	exit ;;
    *:GNU:*:*)
	# the GNU system
	echo `echo ${UNAME_MACHINE}|sed -e 's,[-/].*$,,'`-unknown-gnu`echo ${UNAME_RELEASE}|sed -e 's,/.*$,,'`
	exit ;;
    *:GNU/*:*:*)
	# other systems with GNU libc and userland
	echo ${UNAME_MACHINE}-unknown-`echo ${UNAME_SYSTEM} | sed 's,^[^/]*/,,' | tr '[A-Z]' '[a-z]'``echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`-gnu
	exit ;;
    i*86:Minix:*:*)
	echo ${UNAME_MACHINE}-pc-minix
	exit ;;
    arm*:Linux:*:*)
	eval $set_cc_for_build
	if echo __ARM_EABI__ | $CC_FOR_BUILD -E - 2>/dev/null \
	    | grep -q __ARM_EABI__
	then
	    echo ${UNAME_MACHINE}-unknown-linux-gnu
	else
	    echo ${UNAME_MACHINE}-unknown-linux-gnueabi
	fi
	exit ;;
    avr32*:Linux:*:*)
	echo ${UNAME_MACHINE}-unknown-linux-gnu
	exit ;;
    cris:Linux:*:*)
	echo cris-axis-linux-gnu
	exit ;;
    crisv32:Linux:*:*)
	echo crisv32-axis-linux-gnu
	exit ;;
    frv:Linux:*:*)
    	echo frv-unknown-linux-gnu
	exit ;;
    ia64:Linux:*:*)
	echo ${UNAME_MACHINE}-unknown-linux-gnu
	exit ;;
    m32r*:Linux:*:*)
	echo ${UNAME_MACHINE}-unknown-linux-gnu
	exit ;;
    m68*:Linux:*:*)
	echo ${UNAME_MACHINE}-unknown-linux-gnu
	exit ;;
    mips:Linux:*:*)
	eval $set_cc_for_build
	sed 's/^	//' << EOF >$dummy.c

	#endif
	#endif
EOF
	eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n '
	    /^CPU/{
		s: ::g
		p
	    }'`"
	test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; }
	;;
    mips64:Linux:*:*)
	eval $set_cc_for_build

	#endif
	#endif
EOF
	eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n '
	    /^CPU/{
		s: ::g
		p
	    }'`"
	test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; }
	;;
    or32:Linux:*:*)
	echo or32-unknown-linux-gnu
	exit ;;
    ppc:Linux:*:*)
	echo powerpc-unknown-linux-gnu
	exit ;;
    ppc64:Linux:*:*)
	echo powerpc64-unknown-linux-gnu
	exit ;;
    alpha:Linux:*:*)
	case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in
	  EV5)   UNAME_MACHINE=alphaev5 ;;

	objdump --private-headers /bin/sh | grep ld.so.1 >/dev/null
	if test "$?" = 0 ; then LIBC="libc1" ; else LIBC="" ; fi
	echo ${UNAME_MACHINE}-unknown-linux-gnu${LIBC}
	exit ;;
    padre:Linux:*:*)
	echo sparc-unknown-linux-gnu
	exit ;;
    parisc:Linux:*:* | hppa:Linux:*:*)
	# Look for CPU level
	case `grep '^cpu[^a-z]*:' /proc/cpuinfo 2>/dev/null | cut -d' ' -f2` in

	  PA8*) echo hppa2.0-unknown-linux-gnu ;;
	  *)    echo hppa-unknown-linux-gnu ;;
	esac
	exit ;;
    parisc64:Linux:*:* | hppa64:Linux:*:*)
	echo hppa64-unknown-linux-gnu
	exit ;;
    s390:Linux:*:* | s390x:Linux:*:*)
	echo ${UNAME_MACHINE}-ibm-linux
	exit ;;
    sh64*:Linux:*:*)
    	echo ${UNAME_MACHINE}-unknown-linux-gnu
	exit ;;
    sh*:Linux:*:*)
	echo ${UNAME_MACHINE}-unknown-linux-gnu
	exit ;;
    sparc:Linux:*:* | sparc64:Linux:*:*)
	echo ${UNAME_MACHINE}-unknown-linux-gnu
	exit ;;
    vax:Linux:*:*)
	echo ${UNAME_MACHINE}-dec-linux-gnu
	exit ;;
    x86_64:Linux:*:*)
	echo x86_64-unknown-linux-gnu
	exit ;;
    xtensa*:Linux:*:*)
    	echo ${UNAME_MACHINE}-unknown-linux-gnu
	exit ;;
    i*86:Linux:*:*)
	# The BFD linker knows what the default object file format is, so
	# first see if it will tell us. cd to the root directory to prevent

		;;
	  a.out-i386-linux)
		echo "${UNAME_MACHINE}-pc-linux-gnuaout"
		exit ;;
	  coff-i386)
		echo "${UNAME_MACHINE}-pc-linux-gnucoff"
		exit 0 ;;
	  "")
		# Either a pre-BFD a.out linker (linux-gnuoldld) or
		# one that does not give us useful --help.
		echo "${UNAME_MACHINE}-pc-linux-gnuoldld"
		exit ;;
	esac
	# Determine whether the default compiler is a.out or elf
	eval $set_cc_for_build

	LIBC=gnulibc1
	# endif
	#else
	#if defined(__INTEL_COMPILER) || defined(__PGI) || defined(__SUNPRO_C) || defined(__SUNPRO_CC)
	LIBC=gnu
	#else
	LIBC=gnuaout
	#endif
	#endif
	#ifdef __dietlibc__
	LIBC=dietlibc
	#endif
EOF
	eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n '
	    /^LIBC/{
		s: ::g
		p
	    }'`"
	test x"${LIBC}" != x && {
		echo "${UNAME_MACHINE}-pc-linux-${LIBC}"
		exit
	}
	test x"${TENTATIVE}" != x && { echo "${TENTATIVE}"; exit; }
	;;
    i*86:DYNIX/ptx:4*:*)
	# ptx 4.0 does uname -s correctly, with DYNIX/ptx in there.
	# earlier versions are messed up and put the nodename in both
	# sysname and nodename.
	echo i386-sequent-sysv4
	exit ;;
    i*86:UNIX_SV:4.2MP:2.*)
        # Unixware is an offshoot of SVR4, but it has its own version
        # number series starting with 2...

	# I just have to hope.  -- rms.
        # Use sysv4.2uw... so that sysv4* matches it.
	echo ${UNAME_MACHINE}-pc-sysv4.2uw${UNAME_VERSION}
	exit ;;
    i*86:OS/2:*:*)
	# If we were able to find `uname', then EMX Unix compatibility
	# is probably installed.
	echo ${UNAME_MACHINE}-pc-os2-emx
	exit ;;
    i*86:XTS-300:*:STOP)
	echo ${UNAME_MACHINE}-unknown-stop
	exit ;;
    i*86:atheos:*:*)
	echo ${UNAME_MACHINE}-unknown-atheos
	exit ;;
    i*86:syllable:*:*)
	echo ${UNAME_MACHINE}-pc-syllable
	exit ;;
    i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.0*:*)
	echo i386-unknown-lynxos${UNAME_RELEASE}
	exit ;;
    i*86:*DOS:*:*)
	echo ${UNAME_MACHINE}-pc-msdosdjgpp
	exit ;;
    i*86:*:4.*:* | i*86:SYSTEM_V:4.*:*)
	UNAME_REL=`echo ${UNAME_RELEASE} | sed 's/\/MP$//'`
	if grep Novell /usr/include/link.h >/dev/null 2>/dev/null; then

	else
		echo ${UNAME_MACHINE}-pc-sysv${UNAME_REL}
	fi
	exit ;;
    i*86:*:5:[678]*)
    	# UnixWare 7.x, OpenUNIX and OpenServer 6.
	case `/bin/uname -X | grep "^Machine"` in
	    *486*)	     UNAME_MACHINE=i486 ;;
	    *Pentium)	     UNAME_MACHINE=i586 ;;
	    *Pent*|*Celeron) UNAME_MACHINE=i686 ;;
	esac
	echo ${UNAME_MACHINE}-unknown-sysv${UNAME_RELEASE}${UNAME_SYSTEM}${UNAME_VERSION}
	exit ;;
    i*86:*:3.2:*)
	if test -f /usr/options/cb.name; then
		UNAME_REL=`sed -n 's/.*Version //p' </usr/options/cb.name`

	else
		echo ${UNAME_MACHINE}-pc-sysv32
	fi
	exit ;;
    pc:*:*:*)
	# Left here for compatibility:
        # uname -m prints for DJGPP always 'pc', but it prints nothing about
        # the processor, so we play safe by assuming i386.
	echo i386-pc-msdosdjgpp
        exit ;;
    Intel:Mach:3*:*)
	echo i386-pc-mach3
	exit ;;
    paragon:*:*:*)
	echo i860-intel-osf1
	exit ;;
    i860:*:4.*:*) # i860-SVR4
	if grep Stardent /usr/include/sys/uadmin.h >/dev/null 2>&1 ; then
	  echo i860-stardent-sysv${UNAME_RELEASE} # Stardent Vistra i860-SVR4
	else # Add other i860-SVR4 vendors below as they are discovered.
	  echo i860-unknown-sysv${UNAME_RELEASE}  # Unknown i860-SVR4
	fi
	exit ;;
    mini*:CTIX:SYS*5:*)
	# "miniframe"
	echo m68010-convergent-sysv
	exit ;;
    mc68k:UNIX:SYSTEM5:3.51m)
	echo m68k-convergent-sysv
	exit ;;
    M680?0:D-NIX:5.3:*)
	echo m68k-diab-dnix
	exit ;;
    M68*:*:R3V[5678]*:*)
	test -r /sysV68 && { echo 'm68k-motorola-sysv'; exit; } ;;
    3[345]??:*:4.0:3.0 | 3[34]??A:*:4.0:3.0 | 3[34]??,*:*:4.0:3.0 | 3[34]??/*:*:4.0:3.0 | 4400:*:4.0:3.0 | 4850:*:4.0:3.0 | SKA40:*:4.0:3.0 | SDS2:*:4.0:3.0 | SHG2:*:4.0:3.0 | S7501*:*:4.0:3.0)
	OS_REL=''
	test -r /etc/.relid \
	&& OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid`
	/bin/uname -p 2>/dev/null | grep 86 >/dev/null \
	  && { echo i486-ncr-sysv4.3${OS_REL}; exit; }
	/bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \
	  && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;;
    3[34]??:*:4.0:* | 3[34]??,*:*:4.0:*)
        /bin/uname -p 2>/dev/null | grep 86 >/dev/null \
          && { echo i486-ncr-sysv4; exit; } ;;
    NCR*:*:4.2:* | MPRAS*:*:4.2:*)
	OS_REL='.3'
	test -r /etc/.relid \
	    && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid`
	/bin/uname -p 2>/dev/null | grep 86 >/dev/null \
	    && { echo i486-ncr-sysv4.3${OS_REL}; exit; }
	/bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \
	    && { echo i586-ncr-sysv4.3${OS_REL}; exit; }
	/bin/uname -p 2>/dev/null | /bin/grep pteron >/dev/null \
	    && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;;
    m68*:LynxOS:2.*:* | m68*:LynxOS:3.0*:*)
	echo m68k-unknown-lynxos${UNAME_RELEASE}
	exit ;;
    mc68030:UNIX_System_V:4.*:*)
	echo m68k-atari-sysv4
	exit ;;
    TSUNAMI:LynxOS:2.*:*)
	echo sparc-unknown-lynxos${UNAME_RELEASE}
	exit ;;
    rs6000:LynxOS:2.*:*)
	echo rs6000-unknown-lynxos${UNAME_RELEASE}
	exit ;;
    PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.0*:*)
	echo powerpc-unknown-lynxos${UNAME_RELEASE}
	exit ;;
    SM[BE]S:UNIX_SV:*:*)
	echo mips-dde-sysv${UNAME_RELEASE}
	exit ;;
    RM*:ReliantUNIX-*:*:*)
	echo mips-sni-sysv4
	exit ;;
    RM*:SINIX-*:*:*)
	echo mips-sni-sysv4
	exit ;;
    *:SINIX-*:*:*)
	if uname -p 2>/dev/null >/dev/null ; then
		UNAME_MACHINE=`(uname -p) 2>/dev/null`

	else
		echo ns32k-sni-sysv
	fi
	exit ;;
    PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort
                      # says <Richard.M.Bartel@ccMail.Census.GOV>
        echo i586-unisys-sysv4
        exit ;;
    *:UNIX_System_V:4*:FTX*)
	# From Gerald Hewes <hewes@openmarket.com>.
	# How about differentiating between stratus architectures? -djm
	echo hppa1.1-stratus-sysv4
	exit ;;
    *:*:*:FTX*)
	# From seanf@swdc.stratus.com.
	echo i860-stratus-sysv4
	exit ;;
    i*86:VOS:*:*)
	# From Paul.Green@stratus.com.
	echo ${UNAME_MACHINE}-stratus-vos
	exit ;;
    *:VOS:*:*)
	# From Paul.Green@stratus.com.
	echo hppa1.1-stratus-vos
	exit ;;
    mc68*:A/UX:*:*)
	echo m68k-apple-aux${UNAME_RELEASE}
	exit ;;
    news*:NEWS-OS:6*:*)
	echo mips-sony-newsos6
	exit ;;
    R[34]000:*System_V*:*:* | R4000:UNIX_SYSV:*:* | R*000:UNIX_SV:*:*)
	if [ -d /usr/nec ]; then
	        echo mips-nec-sysv${UNAME_RELEASE}
	else
	        echo mips-unknown-sysv${UNAME_RELEASE}
	fi
        exit ;;
    BeBox:BeOS:*:*)	# BeOS running on hardware made by Be, PPC only.
	echo powerpc-be-beos
	exit ;;
    BeMac:BeOS:*:*)	# BeOS running on Mac or Mac clone, PPC only.
	echo powerpc-apple-beos
	exit ;;
    BePC:BeOS:*:*)	# BeOS running on Intel PC compatible.
	echo i586-pc-beos
	exit ;;
    BePC:Haiku:*:*)	# Haiku running on Intel PC compatible.
	echo i586-pc-haiku
	exit ;;
    SX-4:SUPER-UX:*:*)
	echo sx4-nec-superux${UNAME_RELEASE}
	exit ;;
    SX-5:SUPER-UX:*:*)
	echo sx5-nec-superux${UNAME_RELEASE}
	exit ;;
    SX-6:SUPER-UX:*:*)
	echo sx6-nec-superux${UNAME_RELEASE}
	exit ;;
    SX-7:SUPER-UX:*:*)
	echo sx7-nec-superux${UNAME_RELEASE}
	exit ;;
    SX-8:SUPER-UX:*:*)
	echo sx8-nec-superux${UNAME_RELEASE}
	exit ;;
    SX-8R:SUPER-UX:*:*)
	echo sx8r-nec-superux${UNAME_RELEASE}
	exit ;;
    Power*:Rhapsody:*:*)
	echo powerpc-apple-rhapsody${UNAME_RELEASE}
	exit ;;
    *:Rhapsody:*:*)
	echo ${UNAME_MACHINE}-apple-rhapsody${UNAME_RELEASE}
	exit ;;
    *:Darwin:*:*)
	UNAME_PROCESSOR=`uname -p` || UNAME_PROCESSOR=unknown
	case $UNAME_PROCESSOR in
	    unknown) UNAME_PROCESSOR=powerpc ;;
	esac
	echo ${UNAME_PROCESSOR}-apple-darwin${UNAME_RELEASE}
	exit ;;
    *:procnto*:*:* | *:QNX:[0123456789]*:*)
	UNAME_PROCESSOR=`uname -p`
	if test "$UNAME_PROCESSOR" = "x86"; then

		UNAME_MACHINE=pc
	fi
	echo ${UNAME_PROCESSOR}-${UNAME_MACHINE}-nto-qnx${UNAME_RELEASE}
	exit ;;
    *:QNX:*:4*)
	echo i386-pc-qnx
	exit ;;
    NSE-?:NONSTOP_KERNEL:*:*)
	echo nse-tandem-nsk${UNAME_RELEASE}
	exit ;;
    NSR-?:NONSTOP_KERNEL:*:*)
	echo nsr-tandem-nsk${UNAME_RELEASE}
	exit ;;
    *:NonStop-UX:*:*)
	echo mips-compaq-nonstopux
	exit ;;
    BS2000:POSIX*:*:*)
	echo bs2000-siemens-sysv
	exit ;;
    DS/*:UNIX_System_V:*:*)
	echo ${UNAME_MACHINE}-${UNAME_SYSTEM}-${UNAME_RELEASE}
	exit ;;
    *:Plan9:*:*)
	# "uname -m" is not consistent, so use $cputype instead. 386
	# is converted to i386 for consistency with other x86

	    UNAME_MACHINE="$cputype"
	fi
	echo ${UNAME_MACHINE}-unknown-plan9
	exit ;;
    *:TOPS-10:*:*)
	echo pdp10-unknown-tops10
	exit ;;
    *:TENEX:*:*)
	echo pdp10-unknown-tenex
	exit ;;
    KS10:TOPS-20:*:* | KL10:TOPS-20:*:* | TYPE4:TOPS-20:*:*)
	echo pdp10-dec-tops20
	exit ;;
    XKL-1:TOPS-20:*:* | TYPE5:TOPS-20:*:*)
	echo pdp10-xkl-tops20
	exit ;;
    *:TOPS-20:*:*)
	echo pdp10-unknown-tops20
	exit ;;
    *:ITS:*:*)
	echo pdp10-unknown-its
	exit ;;
    SEI:*:*:SEIUX)
        echo mips-sei-seiux${UNAME_RELEASE}
	exit ;;
    *:DragonFly:*:*)
	echo ${UNAME_MACHINE}-unknown-dragonfly`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`
	exit ;;
    *:*VMS:*:*)
    	UNAME_MACHINE=`(uname -p) 2>/dev/null`
	case "${UNAME_MACHINE}" in
	    A*) echo alpha-dec-vms ; exit ;;
	    I*) echo ia64-dec-vms ; exit ;;
	    V*) echo vax-dec-vms ; exit ;;
	esac ;;
    *:XENIX:*:SysV)
	echo i386-pc-xenix
	exit ;;
    i*86:skyos:*:*)
	echo ${UNAME_MACHINE}-pc-skyos`echo ${UNAME_RELEASE}` | sed -e 's/ .*$//'
	exit ;;
    i*86:rdos:*:*)
	echo ${UNAME_MACHINE}-pc-rdos
	exit ;;
esac

#echo '(No uname command or uname output not recognized.)' 1>&2

#endif

#if defined (__arm) && defined (__acorn) && defined (__unix)
  printf ("arm-acorn-riscix\n"); exit (0);
#endif

#if defined (hp300) && !defined (hpux)

}
EOF

$CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null && SYSTEM_NAME=`$dummy` &&
	{ echo "$SYSTEM_NAME"; exit; }

# Apollos put the system type in the environment.

test -d /usr/apollo && { echo ${ISP}-apollo-${SYSTYPE}; exit; }

# Convex versions that predate uname can use getsysinfo(1)


    case `getsysinfo -f cpu_type` in
    c1*)
	echo c1-convex-bsd
	exit ;;
    c2*)
	if getsysinfo -f scalar_acc
	then echo c32-convex-bsd
	else echo c2-convex-bsd
	fi
	exit ;;
    c34*)
	echo c34-convex-bsd
	exit ;;
    c38*)
	echo c38-convex-bsd
	exit ;;
    c4*)
	echo c4-convex-bsd
	exit ;;
    esac
fi


the operating system you are using. It is advised that you
download the most up to date version of the config scripts from

  http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess;hb=HEAD
and
  http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub;hb=HEAD

If the version you run ($0) is already up to date, please
send the following data and any information you think might be




#! /bin/sh
# Configuration validation subroutine script.
#   Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
#   2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
#   Free Software Foundation, Inc.

timestamp='2009-01-19'

# This file is (in principle) common to ALL GNU software.
# The presence of a machine in this file suggests that SOME GNU software

#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA
# 02110-1301, USA.
#
# As a special exception to the GNU General Public License, if you
# distribute this file as part of a program that contains a
# configuration script generated by Autoconf, you may include it under
# the same distribution terms that you use for the rest of that program.


# Please send patches to <config-patches@gnu.org>.  Submit a context
# diff and a properly formatted ChangeLog entry.
#

version="\
GNU config.sub ($timestamp)

Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001,
2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.

This is free software; see the source for copying conditions.  There is NO
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE."

while test $# -gt 0 ; do
  case $1 in
    --time-stamp | --time* | -t )
       echo "$timestamp" ; exit ;;
    --version | -v )
       echo "$version" ; exit ;;
    --help | --h* | -h )
       echo "$usage"; exit ;;
    -- )     # Stop option processing
       shift; break ;;
    - )	# Use stdin as input.

    *local*)
       # First pass through any local machine types.
       echo $1
       exit ;;

    * )
       break ;;

# Here we must recognize all the valid KERNEL-OS combinations.
maybe_os=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\2/'`
case $maybe_os in
  nto-qnx* | linux-gnu* | linux-dietlibc | linux-newlib* | linux-uclibc* | \
  uclinux-uclibc* | uclinux-gnu* | kfreebsd*-gnu* | knetbsd*-gnu* | netbsd*-gnu* | \
  kopensolaris*-gnu* | \
  storm-chaos* | os2-emx* | rtmk-nova*)
    os=-$maybe_os
    basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'`
    ;;

	-convergent* | -ncr* | -news | -32* | -3600* | -3100* | -hitachi* |\
	-c[123]* | -convex* | -sun | -crds | -omron* | -dg | -ultra | -tti* | \
	-harris | -dolphin | -highlevel | -gould | -cbm | -ns | -masscomp | \
	-apple | -axis | -knuth | -cray)
		os=
		basic_machine=$1
		;;

	-hiux*)
		os=-hiuxwe2
		;;
	-sco6)
		os=-sco5v6
		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
		;;
	-sco5)
		os=-sco3.2v5
		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`

		# Don't forget version if it is 3.2v4 or newer.
		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
		;;
	-sco5v6*)
		# Don't forget version if it is 3.2v4 or newer.
		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
		;;
	-sco*)
		os=-sco3.2v2
		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`

	| a29k \
	| alpha | alphaev[4-8] | alphaev56 | alphaev6[78] | alphapca5[67] \
	| alpha64 | alpha64ev[4-8] | alpha64ev56 | alpha64ev6[78] | alpha64pca5[67] \
	| am33_2.0 \
	| arc | arm | arm[bl]e | arme[lb] | armv[2345] | armv[345][lb] | avr | avr32 \
	| bfin \
	| c4x | clipper \
	| d10v | d30v | dlx | dsp16xx \
	| fido | fr30 | frv \
	| h8300 | h8500 | hppa | hppa1.[01] | hppa2.0 | hppa2.0[nw] | hppa64 \
	| i370 | i860 | i960 | ia64 \
	| ip2k | iq2000 \
	| lm32 \
	| m32c | m32r | m32rle | m68000 | m68k | m88k \
	| maxq | mb | microblaze | mcore | mep | metag \
	| mips | mipsbe | mipseb | mipsel | mipsle \
	| mips16 \
	| mips64 | mips64el \
	| mips64octeon | mips64octeonel \
	| mips64orion | mips64orionel \
	| mips64r5900 | mips64r5900el \
	| mips64vr | mips64vrel \
	| mips64vr4100 | mips64vr4100el \
	| mips64vr4300 | mips64vr4300el \
	| mips64vr5000 | mips64vr5000el \
	| mips64vr5900 | mips64vr5900el \
	| mipsisa32 | mipsisa32el \
	| mipsisa32r2 | mipsisa32r2el \
	| mipsisa64 | mipsisa64el \
	| mipsisa64r2 | mipsisa64r2el \
	| mipsisa64sb1 | mipsisa64sb1el \
	| mipsisa64sr71k | mipsisa64sr71kel \
	| mipstx39 | mipstx39el \
	| mn10200 | mn10300 \
	| mt \
	| msp430 \
	| nios | nios2 \
	| ns16k | ns32k \
	| or32 \
	| pdp10 | pdp11 | pj | pjl \
	| powerpc | powerpc64 | powerpc64le | powerpcle | ppcbe \
	| pyramid \
	| score \
	| sh | sh[1234] | sh[24]a | sh[24]aeb | sh[23]e | sh[34]eb | sheb | shbe | shle | sh[1234]le | sh3ele \
	| sh64 | sh64le \
	| sparc | sparc64 | sparc64b | sparc64v | sparc86x | sparclet | sparclite \
	| sparcv8 | sparcv9 | sparcv9b | sparcv9v \
	| spu | strongarm \
	| tahoe | thumb | tic4x | tic80 | tron \
	| v850 | v850e \
	| we32k \
	| x86 | xc16x | xscale | xscalee[bl] | xstormy16 | xtensa \
	| z8k | z80)
		basic_machine=$basic_machine-unknown
		;;
	m6811 | m68hc11 | m6812 | m68hc12)

		;;
	m88110 | m680[12346]0 | m683?2 | m68360 | m5200 | v70 | w65 | z8k)
		;;
	ms1)
		basic_machine=mt-unknown
		;;

	# We use `pc' rather than `unknown'
	# because (1) that's what they normally are, and

	| alpha64-* | alpha64ev[4-8]-* | alpha64ev56-* | alpha64ev6[78]-* \
	| alphapca5[67]-* | alpha64pca5[67]-* | arc-* \
	| arm-*  | armbe-* | armle-* | armeb-* | armv*-* \
	| avr-* | avr32-* \
	| bfin-* | bs2000-* \
	| c[123]* | c30-* | [cjt]90-* | c4x-* | c54x-* | c55x-* | c6x-* \
	| clipper-* | craynv-* | cydra-* \
	| d10v-* | d30v-* | dlx-* \
	| elxsi-* \
	| f30[01]-* | f700-* | fido-* | fr30-* | frv-* | fx80-* \
	| h8300-* | h8500-* \
	| hppa-* | hppa1.[01]-* | hppa2.0-* | hppa2.0[nw]-* | hppa64-* \
	| i*86-* | i860-* | i960-* | ia64-* \
	| ip2k-* | iq2000-* \
	| lm32-* \
	| m32c-* | m32r-* | m32rle-* \
	| m68000-* | m680[012346]0-* | m68360-* | m683?2-* | m68k-* \
	| m88110-* | m88k-* | maxq-* | mcore-* | metag-* \
	| mips-* | mipsbe-* | mipseb-* | mipsel-* | mipsle-* \
	| mips16-* \
	| mips64-* | mips64el-* \
	| mips64octeon-* | mips64octeonel-* \
	| mips64orion-* | mips64orionel-* \
	| mips64r5900-* | mips64r5900el-* \
	| mips64vr-* | mips64vrel-* \
	| mips64vr4100-* | mips64vr4100el-* \
	| mips64vr4300-* | mips64vr4300el-* \
	| mips64vr5000-* | mips64vr5000el-* \
	| mips64vr5900-* | mips64vr5900el-* \
	| mipsisa32-* | mipsisa32el-* \
	| mipsisa32r2-* | mipsisa32r2el-* \
	| mipsisa64-* | mipsisa64el-* \
	| mipsisa64r2-* | mipsisa64r2el-* \
	| mipsisa64sb1-* | mipsisa64sb1el-* \
	| mipsisa64sr71k-* | mipsisa64sr71kel-* \
	| mipstx39-* | mipstx39el-* \
	| mmix-* \
	| mt-* \
	| msp430-* \
	| nios-* | nios2-* \
	| none-* | np1-* | ns16k-* | ns32k-* \
	| orion-* \
	| pdp10-* | pdp11-* | pj-* | pjl-* | pn-* | power-* \
	| powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* | ppcbe-* \
	| pyramid-* \
	| romp-* | rs6000-* \
	| sh-* | sh[1234]-* | sh[24]a-* | sh[24]aeb-* | sh[23]e-* | sh[34]eb-* | sheb-* | shbe-* \
	| sh-* | sh[1234]-* | sh[23]e-* | sh[34]eb-* | shbe-* \
	| shle-* | sh[1234]le-* | sh3ele-* | sh64-* | sh64le-* \
	| sparc-* | sparc64-* | sparc64b-* | sparc64v-* | sparc86x-* | sparclet-* \
	| sparclite-* \
	| sparcv8-* | sparcv9-* | sparcv9b-* | sparcv9v-* | strongarm-* | sv1-* | sx?-* \
	| tahoe-* | thumb-* \
	| tic30-* | tic4x-* | tic54x-* | tic55x-* | tic6x-* | tic80-* | tile-* \
	| tron-* \
	| v850-* | v850e-* | vax-* \
	| we32k-* \
	| x86-* | x86_64-* | xc16x-* | xps100-* | xscale-* | xscalee[bl]-* \
	| xstormy16-* | xtensa*-* \
	| ymp-* \
	| z8k-* | z80-*)
		;;
	# Recognize the basic CPU types without company name, with glob match.
	xtensa*)
		basic_machine=$basic_machine-unknown
		;;
	# Recognize the various machine names and aliases which stand
	# for a CPU type and a company and sometimes even an OS.

		basic_machine=a29k-amd
		os=-udi
		;;
    	abacus)
		basic_machine=abacus-unknown
		;;
	adobe68k)
		basic_machine=m68010-adobe
		os=-scout

	amd64)
		basic_machine=x86_64-pc
		;;
	amd64-*)
		basic_machine=x86_64-`echo $basic_machine | sed 's/^[^-]*-//'`
		;;
	amdahl)
		basic_machine=580-amdahl
		os=-sysv

		basic_machine=ns32k-sequent
		os=-dynix
		;;
	blackfin)
		basic_machine=bfin-unknown
		os=-linux
		;;
	blackfin-*)
		basic_machine=bfin-`echo $basic_machine | sed 's/^[^-]*-//'`
		os=-linux
		;;
	c90)
		basic_machine=c90-cray
		os=-unicos
		;;
        cegcc)
		basic_machine=arm-unknown
		os=-cegcc
		;;
	convex-c1)
		basic_machine=c1-convex
		os=-bsd

		basic_machine=j90-cray
		os=-unicos
		;;
	craynv)
		basic_machine=craynv-cray
		os=-unicosmp
		;;
	cr16)
		basic_machine=cr16-unknown
		os=-elf
		;;
	crds | unos)
		basic_machine=m68k-crds
		;;
	crisv32 | crisv32-* | etraxfs*)
		basic_machine=crisv32-axis
		;;
	cris | cris-* | etrax*)
		basic_machine=cris-axis
		;;
	crx)
		basic_machine=crx-unknown
		os=-elf
		;;
	da30 | da30-*)
		basic_machine=m68k-da30
		;;

		basic_machine=m88k-motorola
		os=-sysv3
		;;
	dicos)
		basic_machine=i686-pc
		os=-dicos
		;;
	djgpp)
		basic_machine=i586-pc
		os=-msdosdjgpp
		;;
	dpx20 | dpx20-*)
		basic_machine=rs6000-bull
		os=-bosx

		basic_machine=m68k-isi
		os=-sysv
		;;
	m68knommu)
		basic_machine=m68k-unknown
		os=-linux
		;;
	m68knommu-*)
		basic_machine=m68k-`echo $basic_machine | sed 's/^[^-]*-//'`
		os=-linux
		;;
	m88k-omron*)
		basic_machine=m88k-omron
		;;

		basic_machine=i386-pc
		os=-mingw32
		;;
	mingw32ce)
		basic_machine=arm-unknown
		os=-mingw32ce
		;;
	miniframe)
		basic_machine=m68000-convergent
		;;

	mips3*)
		basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'`-unknown
		;;
	mmix*)
		basic_machine=mmix-knuth
		os=-mmixware
		;;
	monitor)
		basic_machine=m68k-rom68k
		os=-coff

		basic_machine=i386-pc
		os=-msdos
		;;
	ms1-*)
		basic_machine=`echo $basic_machine | sed -e 's/ms1-/mt-/'`
		;;
	mvs)
		basic_machine=i370-ibm
		os=-mvs

	np1)
		basic_machine=np1-gould
		;;
	nv1)
		basic_machine=nv1-cray
		os=-unicosmp
		;;
	nsr-tandem)
		basic_machine=nsr-tandem
		;;

		basic_machine=hppa1.1-oki
		os=-proelf
		;;
	openrisc | openrisc-*)
		basic_machine=or32-unknown
		;;
	os400)
		basic_machine=powerpc-ibm
		os=-os400
		;;
	OSE68000 | ose68000)
		basic_machine=m68000-ericsson

		basic_machine=i860-intel
		os=-osf
		;;
	parisc)
		basic_machine=hppa-unknown
		os=-linux
		;;
	parisc-*)
		basic_machine=hppa-`echo $basic_machine | sed 's/^[^-]*-//'`
		os=-linux
		;;
	pbd)
		basic_machine=sparc-tti
		;;

	pc532 | pc532-*)
		basic_machine=ns32k-pc532
		;;
	pc98)
		basic_machine=i386-pc
		;;
	pc98-*)
		basic_machine=i386-`echo $basic_machine | sed 's/^[^-]*-//'`
		;;
	pentium | p5 | k5 | k6 | nexgen | viac3)
		basic_machine=i586-pc
		;;

		basic_machine=i586-unknown
		os=-pw32
		;;
	rdos)
		basic_machine=i386-pc
		os=-rdos
		;;
	rom68k)
		basic_machine=m68k-rom68k
		os=-coff

	rtpc | rtpc-*)
		basic_machine=romp-ibm
		;;
	s390 | s390-*)
		basic_machine=s390-ibm
		;;
	s390x | s390x-*)
		basic_machine=s390x-ibm
		;;
	sa29200)
		basic_machine=a29k-amd
		os=-udi

	sb1el)
		basic_machine=mipsisa64sb1el-unknown
		;;
	sde)
		basic_machine=mipsisa32-sde
		os=-elf
		;;
	sei)
		basic_machine=mips-sei
		os=-seiux

		basic_machine=sh-hitachi
		os=-hms
		;;
	sh5el)
		basic_machine=sh5le-unknown
		;;
	sh64)
		basic_machine=sh64-unknown
		;;

		basic_machine=tic6x-unknown
		os=-coff
		;;
	tile*)
		basic_machine=tile-unknown
		os=-linux-gnu
		;;
	tx39)
		basic_machine=mipstx39-unknown
		;;

	tower | tower-32)
		basic_machine=m68k-ncr
		;;
	tpf)
		basic_machine=s390x-ibm
		os=-tpf
		;;
	udi29k)
		basic_machine=a29k-amd
		os=-udi

		basic_machine=hppa1.1-winbond
		os=-proelf
		;;
	xbox)
		basic_machine=i686-pc
		os=-mingw32
		;;
	xps | xps100)
		basic_machine=xps100-honeywell
		;;

		basic_machine=z8k-unknown
		os=-sim
		;;
	z80-*-coff)
		basic_machine=z80-unknown
		os=-sim
		;;
	none)
		basic_machine=none-none
		os=-none

	romp)
		basic_machine=romp-ibm
		;;
	mmix)
		basic_machine=mmix-knuth
		;;
	rs6000)
		basic_machine=rs6000-ibm
		;;

	we32k)
		basic_machine=we32k-att
		;;
	sh[1234] | sh[24]a | sh[24]aeb | sh[34]eb | sh[1234]le | sh[23]ele)
		basic_machine=sh-unknown
		;;
	sparc | sparcv8 | sparcv9 | sparcv9b | sparcv9v)
		basic_machine=sh64-unknown
		;;
	sparc | sparcv8 | sparcv9 | sparcv9b)
		basic_machine=sparc-sun
		;;
	cydra)

	-gnu* | -bsd* | -mach* | -minix* | -genix* | -ultrix* | -irix* \
	      | -*vms* | -sco* | -esix* | -isc* | -aix* | -sunos | -sunos[34]*\
	      | -hpux* | -unos* | -osf* | -luna* | -dgux* | -solaris* | -sym* \
	      | -kopensolaris* \
	      | -amigaos* | -amigados* | -msdos* | -newsos* | -unicos* | -aof* \
	      | -aos* \
	      | -nindy* | -vxsim* | -vxworks* | -ebmon* | -hms* | -mvs* \
	      | -clix* | -riscos* | -uniplus* | -iris* | -rtu* | -xenix* \
	      | -hiux* | -386bsd* | -knetbsd* | -mirbsd* | -netbsd* \
	      | -openbsd* | -solidbsd* \
	      | -ekkobsd* | -kfreebsd* | -freebsd* | -riscix* | -lynxos* \
	      | -bosx* | -nextstep* | -cxux* | -aout* | -elf* | -oabi* \
	      | -ptx* | -coff* | -ecoff* | -winnt* | -domain* | -vsta* \
	      | -udi* | -eabi* | -lites* | -ieee* | -go32* | -aux* \
	      | -chorusos* | -chorusrdb* | -cegcc* \
	      | -cygwin* | -pe* | -psos* | -moss* | -proelf* | -rtems* \
	      | -mingw32* | -linux-gnu* | -linux-newlib* | -linux-uclibc* \
	      | -uxpv* | -beos* | -mpeix* | -udk* \
	      | -interix* | -uwin* | -mks* | -rhapsody* | -darwin* | -opened* \
	      | -openstep* | -oskit* | -conix* | -pw32* | -nonstopux* \
	      | -storm-chaos* | -tops10* | -tenex* | -tops20* | -its* \
	      | -os2* | -vos* | -palmos* | -uclinux* | -nucleus* \
	      | -morphos* | -superux* | -rtmk* | -rtmk-nova* | -windiss* \
	      | -powermax* | -dnix* | -nx6 | -nx7 | -sei* | -dragonfly* \
	      | -skyos* | -haiku* | -rdos* | -toppers* | -drops*)
	# Remember, each alternative MUST END IN *, to match a version number.
		;;
	-qnx*)

		os=`echo $os | sed -e 's|nto|nto-qnx|'`
		;;
	-sim | -es1800* | -hms* | -xray | -os68k* | -none* | -v88r* \
	      | -windows* | -osx | -abug | -netware* | -os9* | -beos* | -haiku* \
	      | -macos* | -mpw* | -magic* | -mmixware* | -mon960* | -lnews*)
		;;
	-mac*)
		os=`echo $os | sed -e 's|mac|macos|'`
		;;
	-linux-dietlibc)
		os=-linux-dietlibc
		;;
	-linux*)
		os=`echo $os | sed -e 's|linux|linux-gnu|'`
		;;

	-opened*)
		os=-openedition
		;;
        -os400*)
		os=-os400
		;;
	-wince*)
		os=-wince
		;;

	-atheos*)
		os=-atheos
		;;
	-syllable*)
		os=-syllable
		;;
	-386bsd)
		os=-bsd
		;;

	-sinix*)
		os=-sysv4
		;;
        -tpf*)
		os=-tpf
		;;
	-triton*)
		os=-sysv3
		;;

	-kaos*)
		os=-kaos
		;;
	-zvmoe)
		os=-zvmoe
		;;
	-dicos*)
		os=-dicos
		;;
	-none)
		;;
	*)

# system, and we'll never get to this point.

case $basic_machine in
        score-*)
		os=-elf
		;;
        spu-*)
		os=-elf
		;;
	*-acorn)
		os=-riscix1.2
		;;

	arm*-semi)
		os=-aout
		;;
        c4x-* | tic4x-*)
        	os=-coff
		;;
	# This must come before the *-dec entry.
	pdp10-*)

	m68*-cisco)
		os=-aout
		;;
        mep-*)
		os=-elf
		;;
	mips*-cisco)
		os=-elf
		;;

	*-be)
		os=-beos
		;;
	*-haiku)
		os=-haiku
		;;
	*-ibm)
		os=-aix
		;;
    	*-knuth)
		os=-mmixware
		;;
	*-wec)
		os=-proelf
		;;

			-mvs* | -opened*)
				vendor=ibm
				;;
			-os400*)
				vendor=ibm
				;;
			-ptx*)
				vendor=sequent
				;;
			-tpf*)
				vendor=ibm
				;;
			-vxsim* | -vxworks* | -windiss*)
				vendor=wrs
				;;

esac

echo $basic_machine$os
exit

# Local variables:
# eval: (add-hook 'write-file-hooks 'time-stamp)

Lines 6-12 Link Here

(-)pvs4.2-orig/doc/language/language.tex (-1 / +1 lines)
6	\usepackage{makeidx}	6	\usepackage{makeidx}
7	\usepackage{relsize}	7	\usepackage{relsize}
8	\usepackage{boxedminipage}	8	\usepackage{boxedminipage}
9	\usepackage{fancyheadings}	9	\usepackage{fancyhdr}
10	%\usepackage{../../pvs}	10	%\usepackage{../../pvs}
11	\usepackage{url}	11	\usepackage{url}
12	\usepackage{../makebnf}	12	\usepackage{../makebnf}

Lines 1-7 Link Here

(-)pvs4.2-orig/doc/prover/prover.tex (-1 / +1 lines)
1	% Document Type: LaTeX	1	% Document Type: LaTeX
2	% Master File: prover.tex	2	% Master File: prover.tex
3	\documentclass[12pt,twoside]{book}	3	\documentclass[12pt,twoside]{book}
4	\usepackage{relsize,alltt,makeidx,url,boxedminipage,fancyheadings,tabularx}	4	\usepackage{relsize,alltt,makeidx,url,boxedminipage,fancyhdr,tabularx}
5	%\usepackage{../../pvs}	5	%\usepackage{../../pvs}
6	\usepackage{../makebnf}	6	\usepackage{../makebnf}
7	\usepackage[chapter]{tocbibind}	7	\usepackage[chapter]{tocbibind}

Lines 7-13 Link Here

(-)pvs4.2-orig/doc/user-guide/user-guide.tex (-1 / +1 lines)
7	%\usepackage{showidx} % use for index debugging	7	%\usepackage{showidx} % use for index debugging
8	\usepackage{relsize}	8	\usepackage{relsize}
9	\usepackage{boxedminipage}	9	\usepackage{boxedminipage}
10	\usepackage{fancyheadings}	10	\usepackage{fancyhdr}
11	\usepackage{graphicx}	11	\usepackage{graphicx}
12	\usepackage{../../pvs}	12	\usepackage{../../pvs}
13	\usepackage{url}	13	\usepackage{url}

Lines 181-188 Link Here

(-)pvs4.2-orig/emacs/emacs-src/ilisp/completer.el (-2 / +2 lines)
181	(not (memq +ilisp-emacs-version-id+	181	(not (memq +ilisp-emacs-version-id+
182	'(xemacs lucid-19 lucid-19-new)))	182	'(xemacs lucid-19 lucid-19-new)))
183	)	183	)
184	(setq quit-flag nil	184	(setq quit-flag nil)
185	unread-command-char 7))))	185	(push 7 unread-command-events))))
186		186
187	;;;	187	;;;
188	(defun completer-deleter (regexp choices &optional keep)	188	(defun completer-deleter (regexp choices &optional keep)

Lines 22-31 Link Here

(-)pvs4.2-orig/emacs/emacs-src/ilisp/ilisp-acl.el (-2 / +2 lines)
22	(defun allegro-check-prompt (old new)	22	(defun allegro-check-prompt (old new)
23	"Compare the break level printed at the beginning of the prompt."	23	"Compare the break level printed at the beginning of the prompt."
24	(let* ((old-level (if (and old (eq 1 (string-match "[0-9]+" old)))	24	(let* ((old-level (if (and old (eq 1 (string-match "[0-9]+" old)))
25	(string-to-int (substring old 1))	25	(string-to-number (substring old 1))
26	0))	26	0))
27	(new-level (if (eq 1 (string-match "[0-9]+" new))	27	(new-level (if (eq 1 (string-match "[0-9]+" new))
28	(string-to-int (substring new 1))	28	(string-to-number (substring new 1))
29	0)))	29	0)))
30	(<= new-level old-level)))	30	(<= new-level old-level)))
31		31

Lines 40-46 Link Here

(-)pvs4.2-orig/emacs/emacs-src/ilisp/ilisp-chs.el (-2 / +2 lines)
40	(string-match "Break" old)	40	(string-match "Break" old)
41	(string-match "[0-9]+" old)))	41	(string-match "[0-9]+" old)))
42	(old-level (if was-in	42	(old-level (if was-in
43	(string-to-int	43	(string-to-number
44	(substring old (match-beginning 0)	44	(substring old (match-beginning 0)
45	(match-end 0)))	45	(match-end 0)))
46	0))	46	0))
Lines 48-54 Link Here
48	(string-match "Break" new)	48	(string-match "Break" new)
49	(string-match "[0-9]+" new)))	49	(string-match "[0-9]+" new)))
50	(new-level (if is-in	50	(new-level (if is-in
51	(string-to-int	51	(string-to-number
52	(substring new (match-beginning 0)	52	(substring new (match-beginning 0)
53	(match-end 0)))	53	(match-end 0)))
54	0)))	54	0)))

Lines 43-50 Link Here

(-)pvs4.2-orig/emacs/emacs-src/ilisp/ilisp-def.el (-2 / +2 lines)
43	;;;	43	;;;
44	(defmacro deflocal (variable default &optional documentation)	44	(defmacro deflocal (variable default &optional documentation)
45	"Define an ilisp local variable."	45	"Define an ilisp local variable."
46	(` (progn (lisp-deflocal '(, variable))	46	`(progn (lisp-deflocal ',variable)
47	(defvar (, variable) (, default) (, documentation)))))	47	(defvar ,variable ,default ,documentation)))
48		48
49	;;;%%Simple customization	49	;;;%%Simple customization
50		50




	(hook (read (format "%s-hook" dialect)))
	(program (read (format "%s-program" dialect)))
	(dialects (format "%s" dialect)))
    `(progn
       (defvar ,hook nil ,(format "*Inferior %s hook." full-name))
       (defvar ,program nil
	 ,(format "*Inferior %s default program." full-name))
       (defun ,setup (buffer)
	 ,(format "Set up for interacting with %s." full-name)
	 ,(read (format "(setup-%s buffer)" parent))
	 ,@body
	 (setq ilisp-program (or ,program ilisp-program)
	       ilisp-dialect (cons ',dialect ilisp-dialect))
	 (run-hooks ',(read (format "%s-hook" dialect))))
       (defun ,dialect (&optional buffer program)
	 ,(format "Create an inferior %s.  With prefix, prompt for buffer and program."
		   full-name)
		   full-name))
	 (interactive (list nil nil))
	 (ilisp-start-dialect (or buffer ,dialects)
			      program
			      ',setup)
	 (setq ,program ilisp-program))
       (lisp-add-dialect ,dialects))))

;;;%%ilisp
(defun setup-ilisp (buffer)




	    (comint-send 
	     (ilisp-process) binary
	     t nil 'binary nil 
	     `(lambda (error wait message output last)
		  (if (or error
			  (not (string-match "\"[^\"]*\"" output)))
		      (progn
			(lisp-display-output output)
			(abort-commands-lisp "No binary"))
		      (setq ,var
			    (substring output
				       (1+ (match-beginning 0))
				       (1- (match-end 0)))))))))))

;;;
(defun ilisp-done-init ()




		(goto-char (point-min))
		(pop-to-buffer pbuf)
		(pvs-mode))
	      (error "%s is not in the prelude." fname))))))

(defun get-prelude-file-and-region (theoryname)
  (let ((freg nil)

			"Name of root file (CR for this one): ")
		       (list (y-or-n-p "Include libraries? "))
		       (list (read-from-minibuffer
			      (format "Mail to: ")
			      pvs-last-email-address))
		       (list (read-string "CC: "))
		       (list (read-string "Subject: "))))

  (let* ((lkeymap (copy-keymap (current-local-map)))
	 (file-string (pvs-dump-files-string pvs-file libraries-p)))
    (define-key lkeymap "\C-c\C-c"
      `(lambda ()
	 (interactive)
	 (pvs-mail-send-and-exit ,to ,subject ,file-string)))
    (use-local-map lkeymap)))

(defun pvs-mail-send-and-exit (to subject file-string)


(defun pvs-major-version-number ()
  (if *pvs-version-information*
      (string-to-number (car *pvs-version-information*))
      (string-to-number (pvs-send-and-wait "*pvs-version*" nil nil))))

;;; Replay





  (case (intern (getenv "PVSLISP"))
    (allegro (pvsallegro "pvs" nil))
    (cmulisp (pvscmulisp "pvs" nil))
    (sbclisp (pvssbclisp "pvs" nil))
    (t (error "Unknown lisp - %s" (getenv "PVSLISP"))))
  (save-excursion
    (set-buffer (ilisp-buffer))

  (setq ilisp-binary-extension (pvs-cmulisp-binary-extension))
  (setq ilisp-init-binary-extension ilisp-binary-extension)
  (setq ilisp-load-inits nil)
  (setq ilisp-program (format "%s -quiet -noinit" (pvs-program)))
  (setq comint-prompt-regexp
	"^\\([0-9]+\\]+\\|\\*\\|[-a-zA-Z0-9]*\\[[0-9]+\\]:\\) \\|Rule\\? \\|<GndEval> \\|<PVSio> \\|(Y or N)\\|(Yes or No)\\|Please enter")
  (setq comint-interrupt-regexp  "^Interrupted at")

	"^\\([0-9]+\\]+\\|\\*\\|[-a-zA-Z0-9]*\\[[0-9]+\\]:\\) ")
  (setq pvs-gc-end-regexp ";;; Finished GC"))

(defdialect pvssbclisp "pvs-sbclisp"
  cmulisp
  (pvs-comint-init)
  ;;(setq comint-send-newline nil)
  (setq ilisp-binary-extension (pvs-sbclisp-binary-extension))
  (setq ilisp-init-binary-extension ilisp-binary-extension)
  (setq ilisp-load-inits nil)
  (setq ilisp-program (format "%s --noinform --no-userinit" (pvs-program)))
  (setq ilisp-reset ":abort")
  (setq comint-prompt-regexp
	"^\\([0-9]+\\]+\\|\\*\\|[-a-zA-Z0-9]*\\[[0-9]+\\]:\\) \\|Rule\\? \\|<GndEval> \\|<PVSio> \\|(Y or N)\\|(Yes or No)\\|Please enter")
  (setq comint-interrupt-regexp  "^  Interactive interrupt at")
  (setq comint-continue ":continue")
  (setq ilisp-error-regexp "^restarts (invokable by number or by possibly-abbreviated name):$")
  (setq pvs-top-regexp
	"^\\([0-9]+\\]+\\|\\*\\|[-a-zA-Z0-9]*\\[[0-9]+\\]:\\) ")
  (setq pvs-gc-end-regexp ";;; Finished GC"))

(defun pvs-allegro-binary-extension ()
  (let ((machine (getenv "PVSARCH")))
    (cond ((string-equal machine "sun4") ; Sun/Solaris

	   "ppcf")
	  (t (error "Machine architecture %s not recognized" machine)))))

(defun pvs-sbclisp-binary-extension ()
  (let ((machine (getenv "PVSARCH")))
    (cond ((string-equal machine "sun4") ; Sun/Solaris
	   "sparcs")
	  ((string-equal machine "ix86") ; Intel/Linux
	   "x86s")
	  ((string-equal machine "ix86_64") ; Intel/Linux
	   "x8664s")
	  ((string-equal machine "powerpc") ; Mac
	   "ppcs")
	  (t (error "Machine architecture %s not recognized" machine)))))

(defun pvs-comint-init ()
  (setq ilisp-motd nil)
  (setq pvs-fix-error comint-fix-error)


(defun resize-info-buffer ()
  (unless (one-window-p t)
    (let* ((maxsize (/ (frame-height) 2))
	   (cursize (1- (window-height)))
	   (lines (real-number-of-lines))
	   (size (min maxsize lines)))

	     (show-entry))
	    (t (error "Unknown display type %s" type))))))	   

(defun pvs-locate (out)
  (apply 'display-file-at-location
	 (parse-pvs-message out)))


(defun pvs-locate (output)
  (let* ((message (parse-pvs-message output))
	 (dir (car message))

Lines 238-244 Link Here

(-)pvs4.2-orig/emacs/emacs-src/pvs-load.el (-1 / +1 lines)
238	(insert "\n\nPlease check our website periodically for news of later versions")	238	(insert "\n\nPlease check our website periodically for news of later versions")
239	(insert "\nat http://pvs.csl.sri.com/")	239	(insert "\nat http://pvs.csl.sri.com/")
240	(insert "\n\n" (cadr (cdddr vers)) "\n" (cadr (cddddr vers)))	240	(insert "\n\n" (cadr (cdddr vers)) "\n" (cadr (cddddr vers)))
241	(insert-string "	241	(insert "
242	----------	242	----------
243	Bug reports and suggestions for improvement should be sent to	243	Bug reports and suggestions for improvement should be sent to
244	pvs-bugs@csl.sri.com	244	pvs-bugs@csl.sri.com




      (if (> indent 0)
	  (while (and (>= (point) start)
		      (progn (beginning-of-line)
			     (insert indstr)
			     (= (forward-line -1) 0))))))
    (when crs (insert "\n\n"))))


  (pvs-bury-output)
  (let ((file (current-pvs-file)))
    (when (buffer-modified-p (get-file-buffer file))
      (error "%s is not parsed" file))
    (when (pvs-send-and-wait (format "(lisp (modify-declaration-at \"%s\" %d))"
				 file (current-line-number))
			     nil nil 'bool)

		    nil)
		   ((and (stringp depth)
			 (string-match "^[ \t]*[0-9]+[ \t]*$" depth))
		    (string-to-number depth))
		   (t (error "set-rewrite-depth: %s is not a number or nil"
			     depth)))))
    (pvs-send (format "(setq *rewrite-print-depth* %s)" dep))))

		    nil)
		   ((and (stringp length)
			 (string-match "^[ \t]*[0-9]+[ \t]*$" length))
		    (string-to-number length))
		   (t (error "set-rewrite-length: %s is not an integer or nil"
			     length)))))
    (pvs-send (format "(setq *rewrite-print-length* %s)" len))))

		    nil)
		   ((and (stringp depth)
			 (string-match "^[ \t]*[0-9]+[ \t]*$" depth))
		    (string-to-number depth))
		   (t (error "set-print-depth: %s is not an integer" depth)))))
    (pvs-send (format "(setq *prover-print-depth* %s)"
		  (when (plusp dep) dep)))))

		    nil)
		   ((and (stringp length)
			 (string-match "^[ \t]*[0-9]+[ \t]*$" length))
		    (string-to-number length))
		   (t (error "set-print-length: %s is not an integer"
			     length)))))
    (pvs-send (format "(setq *prover-print-length* %s)"

		    nil)
		   ((and (stringp lines)
			 (string-match "^[ \t]*[0-9]+[ \t]*$" lines))
		    (string-to-number lines))
		   (t (error "set-print-lines: %s is not an integer" lines)))))
    (pvs-send (format "(setq *prover-print-lines* %s)"
		  (when (plusp dep) dep)))))

		  1)
		 ((and (stringp num)
		       (string-match "^[ \t]*[0-9]+[ \t]*$" num))
		  (string-to-number num))
		 (t (error "set-proof-backup-number: %s is not an integer"
			   num)))))
    (pvs-send (format "(setq *number-of-proof-backups* %s)" n))))




	  (setq ept (point))
	  (setq def2arw (buffer-substring bpt ept)))
      (setq def2arw (read-from-minibuffer "Auto-rewrite: ")))
    (goto-char (point-max))
    (insert "(auto-rewrite " ?\" def2arw ?\" ")")
    (return-ilisp)))


		    (setq fnum (buffer-substring bpt ept)))
		  (setq fnum (read-from-minibuffer
			      "in formula [CR for default]# " ""))))
	  (goto-char (point-max))
	  (insert "(expand " ?\" def2expand ?\" " " fnum ")")
	  (return-ilisp)))))


      (setq expr (buffer-substring start end))
      (if (not (y-or-n-p (concat "Typepred for " expr)))
	  (error "typepred aborted.")))
    (goto-char (point-max))
    (insert "(typepred " ?\" expr ?\" ")")
    (return-ilisp)))


	    (if editprfwin
		(set-window-point editprfwin (point))))
	  (setq cmd (buffer-substring beg end))))
      (goto-char (point-max))
      (insert cmd)
      (return-ilisp)
      (hilit-next-prover-command)

	  (pvs-prover-goto-prev-step t))
	(hilit-next-prover-command)
	(switch-to-buffer pvsbuf)
	(goto-char (point-max))
	(switch-to-buffer editprfbuf)
	(pop-to-buffer pvsbuf)
	(goto-char (point-max)))))


;;; pvs-prover-goto-next-step puts the cursor at the beginning of the next

Lines 94-100 Link Here

(-)pvs4.2-orig/emacs/emacs-src/pvs-tcl.el (-1 / +1 lines)
94	"PVS Error"))	94	"PVS Error"))
95	(t (comint-display-output	95	(t (comint-display-output
96	(format "PVS was developed and tested for %s versions %s,\nbut you are using version %s.\nThis is unlikely to cause problems, as it is a later release."	96	(format "PVS was developed and tested for %s versions %s,\nbut you are using version %s.\nThis is unlikely to cause problems, as it is a later release."
97	program-name expected version program-name)	97	program-name expected version)
98	"PVS Warning"))))))	98	"PVS Warning"))))))
99		99
100	(defun pvs-parse-version-numbers (vnum)	100	(defun pvs-parse-version-numbers (vnum)




		nil nil 'list)))
    (when fandp
      (cond ((not (file-exists-p (car fandp)))
	     (error "Theory %s was in %s which no longer exists"
		    theoryname (car fandp)))
	    ((or (null (cdr fandp))
		 (buffer-modified-p (find-file-noselect (car fandp))))

	      (error "Must specify a theory name")
	      (list theory))))))

(defun remove-duplicates (list)
  (let ((nlist nil))
    (dolist (e list)
      (unless (member-equal e nlist)
	(push e nlist)))
    (nreverse nlist)))

(defun current-theory ()
  (let ((file (current-pvs-file t)))
    (if file

  (or (car (get cmd 'abbreviations))
      cmd))

(defun remove-if (pred list)
  (let ((nlist nil))
    (dolist (e list)
      (unless (funcall pred e)
	(push e nlist)))
    (nreverse nlist)))

(defun add-final-newline ()
  (save-excursion
    (unless (equal (char-after (1- (point-max))) ?\n)

(setq pvs-reserved-words-regexp
  "\\bassuming\\b\\|\\baxiom\\b\\|\\baccept\\b\\|\\bchanges\\b\\|\\ball\\b\\|\\band\\b\\|\\barray\\b\\|\\bbegin\\b\\|\\bby\\b\\|\\bcase\\b\\|\\bdeclare\\b\\|\\bdefinition\\b\\|\\belse\\b\\|\\belsif\\b\\|\\bendif\\b\\|\\bendassuming\\b\\|\\bendcase\\b\\|\\bend\\b\\|\\bexists\\b\\|\\bexporting\\b\\|\\bexit\\b\\|\\bforall\\b\\|\\bfunction\\b\\|\\bformula\\b\\|\\bfrom\\b\\|\\bif\\b\\|\\biff\\b\\|\\bimplies\\b\\|\\bimporting\\b\\|\\bin\\b\\|\\bis\\b\\|\\blambda\\b\\|\\blemma\\b\\|\\bloop\\b\\|\\bmapping\\b\\|\\bmeasure\\b\\|\\bmodule\\b\\|\\bnot\\b\\|\\bnothing\\b\\|\\bof\\b\\|\\bonto\\b\\|\\bobligation\\b\\|\\bopspec\\b\\|\\bor\\b\\|\\bproof\\b\\|\\bprove\\b\\|\\brecursive\\b\\|\\bresult\\b\\|\\btheorem\\b\\|\\btheory\\b\\|\\busing\\b\\|\\bvar\\b\\|\\bvariable\\b\\|\\brecord\\b\\|\\bverify\\b\\|\\bwhere\\b\\|\\bthen\\b\\|\\btype\\b\\|\\bwhen\\b\\|\\bwhile\\b\\|\\bwith\\b\\|\\blet\\b\\|\\bsetvariable\\b\\|\\[#\\|#\\]\\|[(]#\\|#[)]")

(defmacro pvs-find-face (name)
  (if (featurep 'xemacs)
      `(find-face ,name)
    `(facep ,name)))

(defun highlight-pvs ()
  (interactive)
  (unless (pvs-find-face 'pvs-keyword)
    (make-face 'pvs-keyword)
    (set-face-foreground 'pvs-keyword "Blue")
    (set-face-font 'pvs-keyword "*courier-bold-r-normal--12*"))

(defvar pvs-unexpected-output nil)

(defmacro pvs-validate (file directory &rest body)
  `(let* ((logfile (concat default-directory ,file)))
       (pvs-backup-logfile logfile)
       (let ((logbuf (find-file-noselect logfile t)))
	 (unwind-protect

		     (default-directory default-directory))
		 (pvs-message (pvs-version-string))
		 (let ((pvs-disable-messages nil))
		   (change-context ,directory))
		 (condition-case err
		     (progn ,@body)
		   (error (pvs-message "ERROR: Emacs: %s %s"
			    (car err) (cdr err)))))
	       (pvs-wait-for-it)

		     (pvs-message "NO BASELINE - using this run to create baseline.log")
		     (copy-file (buffer-file-name) "baseline.log"))))
	   (fset 'pvs-handler 'pvs-handler-orig)
	   (fset 'ask-user-about-lock 'ask-user-about-lock-orig)))))


;;; This function provides the most basic form of test, removing bin

Lines 24-29 Link Here

(-)pvs4.2-orig/emacs/go-pvs.el (+1 lines)
24	;; --------------------------------------------------------------------	24	;; --------------------------------------------------------------------
25		25
26	(setq debug-on-error t)	26	(setq debug-on-error t)
		27	(setq inhibit-startup-screen t)
27		28
28	(defconst pvs-emacs-system	29	(defconst pvs-emacs-system
29	(cond ((or (string-match "XEmacs 21" (emacs-version))	30	(cond ((or (string-match "XEmacs 21" (emacs-version))

Lines 15-22 Link Here

(-)pvs4.2-orig/ess/box-defs.lisp (-2 / +2 lines)
15	;;; Frank Pfenning (fp@cs.cmu.edu) ;;;	15	;;; Frank Pfenning (fp@cs.cmu.edu) ;;;
16	;;; ******************************************************************* ;;;	16	;;; ******************************************************************* ;;;
17		17
18	(in-package :tools #+sbcl (:use :common-lisp :ergolisp))	18	(in-package :tools)
19	#-sbcl (use-package :ergolisp)	19	(use-package :ergolisp)
20		20
21	(export '(plain-readtable))	21	(export '(plain-readtable))
22		22

Lines 24-30 Link Here

(-)pvs4.2-orig/ess/lang/ab-term/rel/af-dependency.lisp (-1 / +1 lines)
24	;;; 07-17-86 rln Initial development and release	24	;;; 07-17-86 rln Initial development and release
25	;;; 07-22-87 rln Reimplementation	25	;;; 07-22-87 rln Reimplementation
26		26
27	(in-package 'analysis-facility)	27	(in-package :analysis-facility)
28	(use-package '("AF-RUNTIME-LIB"))	28	(use-package '("AF-RUNTIME-LIB"))
29		29
30	;;; The variable CODE accumulates the code descriptors generated by SCHEDULE.	30	;;; The variable CODE accumulates the code descriptors generated by SCHEDULE.

Lines 25-31 Link Here

(-)pvs4.2-orig/ess/lang/ab-term/rel/af-runtime.lisp (-1 / +6 lines)
25	;;; 07-22-87 rln Initial development release.	25	;;; 07-22-87 rln Initial development release.
26	;;;	26	;;;
27		27
28	(in-package "AF-RUNTIME-LIB" :nicknames '(abrt afrt))	28	(eval-when (compile load eval)
		29	(unless (find-package "AF-RUNTIME-LIB")
		30	(make-package "AF-RUNTIME-LIB"
		31	:nicknames '("ABRT" "AFRT")
		32	:use '("COMMON-LISP"))))
		33	(in-package "AF-RUNTIME-LIB")
29		34
30	(export '(opcase argcase rt-delta-error rt-term-argn rt-term-args	35	(export '(opcase argcase rt-delta-error rt-term-argn rt-term-args
31	rt-symbol rt-ite rt-opt rt-function rt-ast	36	rt-symbol rt-ite rt-opt rt-function rt-ast

Lines 23-29 Link Here

(-)pvs4.2-orig/ess/lang/ab-term/rel/af-structs.lisp (-1 / +1 lines)
23	;;;	23	;;;
24	;;; 07-22-87 rln Initial development and release.	24	;;; 07-22-87 rln Initial development and release.
25		25
26	(in-package 'analysis-facility)	26	(in-package :analysis-facility)
27		27
28	;;; A DP-EVAL structure describes an attribute which is defined by an expression.	28	;;; A DP-EVAL structure describes an attribute which is defined by an expression.
29	;;; An expression always defines exactly one attribute.	29	;;; An expression always defines exactly one attribute.

Lines 29-35 Link Here

(-)pvs4.2-orig/ess/lang/ab-term/rel/af-top.lisp (-1 / +1 lines)
29	;;; 07-22-87 rln Initial development release.	29	;;; 07-22-87 rln Initial development release.
30		30
31		31
32	(in-package 'analysis-facility :nicknames '(ab af))	32	(in-package :analysis-facility)
33		33
34	(export '(ab ab-make help))	34	(export '(ab ab-make help))
35		35

Lines 21-27 Link Here

(-)pvs4.2-orig/ess/lang/sb-term/rel/access-par.lisp (-1 / +1 lines)
21	;;; Revised Scott Dietzen, Mon Oct 13 15:32:09 1986	21	;;; Revised Scott Dietzen, Mon Oct 13 15:32:09 1986
22		22
23		23
24	(in-package 'syntax-box) (use-package :ergolisp)	24	(in-package :syntax-box) (use-package :ergolisp)
25		25
26		26
27		27

Lines 17-23 Link Here

(-)pvs4.2-orig/ess/lang/sb-term/rel/aux-funs.lisp (-1 / +1 lines)
17	;;; Scott Dietzen, Mon Oct 13 16:05:43 1986	17	;;; Scott Dietzen, Mon Oct 13 16:05:43 1986
18		18
19		19
20	(in-package 'syntax-box) (use-package :ergolisp)	20	(in-package :syntax-box) (use-package :ergolisp)
21		21
22		22
23	(defparameter sb-package (find-package :sb))	23	(defparameter sb-package (find-package :sb))

Lines 16-22 Link Here

(-)pvs4.2-orig/ess/lang/sb-term/rel/collapse.lisp (-1 / +1 lines)
16		16
17	;;;; Basic Function: Collapse fragments into lisp functions	17	;;;; Basic Function: Collapse fragments into lisp functions
18		18
19	(in-package 'syntax-box) (use-package :ergolisp)	19	(in-package :syntax-box) (use-package :ergolisp)
20		20
21		21
22	; The purpose of collapse is to take the fragments produced by process-grammar	22	; The purpose of collapse is to take the fragments produced by process-grammar

Lines 17-23 Link Here

(-)pvs4.2-orig/ess/lang/sb-term/rel/flatten.lisp (-1 / +1 lines)
17		17
18	;;;; Basic Function: Flatten Patterns	18	;;;; Basic Function: Flatten Patterns
19		19
20	(in-package 'syntax-box) (use-package :ergolisp)	20	(in-package :syntax-box) (use-package :ergolisp)
21		21
22		22
23		23

Lines 16-23 Link Here

(-)pvs4.2-orig/ess/lang/sb-term/rel/inter-phase.lisp (-2 / +2 lines)
16		16
17	;;; Intermediate Phase.	17	;;; Intermediate Phase.
18		18
19	(in-package 'syntax-box) (use-package :ergolisp)	19	(in-package :syntax-box) (use-package :ergolisp)
20	(use-package '(sb-runtime))	20	(use-package :sb-runtime)
21		21
22	;;; Understanding of the internal grammar term structure is essential to	22	;;; Understanding of the internal grammar term structure is essential to
23	;;; understanding this code (see documentation in access.lisp). @@@	23	;;; understanding this code (see documentation in access.lisp). @@@

Lines 31-37 Link Here

(-)pvs4.2-orig/ess/lang/sb-term/rel/lexer-gen.lisp (-1 / +1 lines)
31	;;; (Routines check-comment-char(s)-with-op(S))	31	;;; (Routines check-comment-char(s)-with-op(S))
32		32
33		33
34	(in-package 'syntax-box) (use-package :ergolisp)	34	(in-package :syntax-box) (use-package :ergolisp)
35		35
36		36
37		37

Lines 9-17 Link Here

(-)pvs4.2-orig/ess/lang/sb-term/rel/look-ahead.lisp (-2 / +2 lines)
9	;;; ******************************************************************* ;;;	9	;;; ******************************************************************* ;;;
10		10
11		11
12	(in-package 'syntax-box) (use-package :ergolisp)	12	(in-package :syntax-box) (use-package :ergolisp)
13		13
14	(use-package '(sb-runtime))	14	(use-package :sb-runtime)
15		15
16		16
17		17

Lines 13-19 Link Here

(-)pvs4.2-orig/ess/lang/sb-term/rel/new-rt-format.lisp (-1 / +1 lines)
13		13
14	;;; Scott Dietzen, Wed Aug 26 17:16:29 1987	14	;;; Scott Dietzen, Wed Aug 26 17:16:29 1987
15		15
16	(in-package 'sb-runtime) (use-package :ergolisp)	16	(in-package :sb-runtime) (use-package :ergolisp)
17		17
18	(export '(	18	(export '(
19	format-uterm	19	format-uterm

Lines 13-19 Link Here

(-)pvs4.2-orig/ess/lang/sb-term/rel/old-rt-format.lisp (-1 / +1 lines)
13		13
14	;;; Scott Dietzen, Wed Aug 26 17:16:29 1987	14	;;; Scott Dietzen, Wed Aug 26 17:16:29 1987
15		15
16	(in-package 'sb-runtime) (use-package :ergolisp)	16	(in-package :sb-runtime) (use-package :ergolisp)
17		17
18	(export '(	18	(export '(
19	format-uterm	19	format-uterm

Lines 13-19 Link Here

(-)pvs4.2-orig/ess/lang/sb-term/rel/old-rt-unp-structs.lisp (-1 / +1 lines)
13		13
14	;;; Scott Dietzen, Wed Aug 26 17:16:29 1987	14	;;; Scott Dietzen, Wed Aug 26 17:16:29 1987
15		15
16	(in-package 'sb-runtime) (use-package :ergolisp)	16	(in-package :sb-runtime) (use-package :ergolisp)
17		17
18	(export '(token-p make-token token-kind token-subkind	18	(export '(token-p make-token token-kind token-subkind
19	token-value token-str-value	19	token-value token-str-value

Lines 40-46 Link Here

(-)pvs4.2-orig/ess/lang/sb-term/rel/rt-lex.lisp (-1 / +1 lines)
40	))	40	))
41		41
42		42
43	(defconstant possible-single-char-operators	43	(defconstant-if-unbound possible-single-char-operators
44	'(#$ #$ #\[ #\] #\{ #\} #\< #\> #\, #\; #\\| #\^ #\# #\~ #\/	44	'(#$ #$ #\[ #\] #\{ #\} #\< #\> #\, #\; #\\| #\^ #\# #\~ #\/
45	#\! #\@ #\$ #\& #\_ #\- #\? #\% #\' #\: #\* #\+ #\` #\= #\\))	45	#\! #\@ #\$ #\& #\_ #\- #\? #\% #\' #\: #\* #\+ #\` #\= #\\))
46		46

Lines 19-25 Link Here

(-)pvs4.2-orig/ess/lang/sb-term/rel/rt-term.lisp (-1 / +1 lines)
19		19
20		20
21		21
22	(in-package "SB-RUNTIME" :nicknames '("RT-SB" "RTSB" "SB-RT" "SBRT"))	22	(in-package "SB-RUNTIME")
23	(use-package :ergolisp)	23	(use-package :ergolisp)
24		24
25	(use-package '("TERM" "OCC" "OPER"))	25	(use-package '("TERM" "OCC" "OPER"))





;;; Just so we don't repeatedly cons identical tokens.

(defconstant-if-unbound ellipsis-token
  (make-token :kind :lt :subkind :string :value "#"))
(defconstant-if-unbound cr-token
  (make-token :kind :whitespace :subkind :cr))
(defconstant-if-unbound unindent-token
  (make-token :kind :whitespace :subkind :unindent))
(defconstant-if-unbound tab-left-token
  (make-token :kind :whitespace :subkind :tab-left))
(defconstant-if-unbound tab-right-token
  (make-token :kind :whitespace :subkind :tab-right))
(defconstant-if-unbound untab-token
  (make-token :kind :whitespace :subkind :untab))







;;; Scott Dietzen, Tue Oct  6 15:32:22 1987

(in-package "SB-RUNTIME")  (use-package :ergolisp)


;;; The following is a hack to avoid the problems inherent in the circularity




(defun memo-uterm (term unp-function &key (top-level? nil))
  (if (or *disable-caching*
	  (and *disable-nested-caching*
	       (null top-level?)))
      (funcall unp-function term)
      (newattr::get-gsyn theuterm
			 term
			 (list unp-function
			       *unparse-style*
			       *no-escapes*
			       *sb-print-depth*
			       *sb-print-length*
			       *formatting-off*))))


(defun memo-aw (uterm width indent-unit-width fontwidth fontheight)
  (if *disable-caching*
      (let* ((aw (make-aw :uterm uterm
			  :indent-unit-width indent-unit-width)))
	(format-aw uterm aw width))
      (newattr::get-gsyn theaw
			 (uterm-term uterm)
			 (list uterm
			       width
			       indent-unit-width
			       fontwidth
			       fontheight))))





(newattr::defgcon uterm-args)
(newattr::defgsyn theuterm uterm-args)


			:indent-unit-width indent-unit-width)))
      (format-aw uterm aw width))))




(defun memo-uterm (term unp-function &key (top-level? nil))
  (if (or *disable-caching*
	  (and *disable-nested-caching*
	       (null top-level?)))
      (funcall unp-function term)
      (newattr::get-gsyn theuterm
			 term
			 (list unp-function
			       *unparse-style*
			       *no-escapes*
			       *sb-print-depth*
			       *sb-print-length*
			       *formatting-off*))))


(defun memo-aw (uterm width indent-unit-width fontwidth fontheight)
  (if *disable-caching*
      (let* ((aw (make-aw :uterm uterm
			  :indent-unit-width indent-unit-width)))
	(format-aw uterm aw width))
      (newattr::get-gsyn theaw
			 (uterm-term uterm)
			 (list uterm
			       width
			       indent-unit-width
			       fontwidth
			       fontheight))))

Lines 13-19 Link Here

(-)pvs4.2-orig/ess/lang/sb-term/rel/rt-unp-structs.lisp (-1 / +1 lines)
13		13
14	;;; Scott Dietzen, Wed Aug 26 17:16:29 1987	14	;;; Scott Dietzen, Wed Aug 26 17:16:29 1987
15		15
16	(in-package 'sb-runtime) (use-package :ergolisp)	16	(in-package "SB-RUNTIME") (use-package :ergolisp)
17		17
18	(export '(token-p make-token token-kind token-subkind	18	(export '(token-p make-token token-kind token-subkind
19	token-value token-str-value	19	token-value token-str-value

Lines 2-8 Link Here

(-)pvs4.2-orig/ess/lang/sb-term/rel/sbrt-lang-def.lisp (-1 / +3 lines)
2	;;; package SB-RUNTIME is seen. fp, Mon Jan 2 11:07:17 1989.	2	;;; package SB-RUNTIME is seen. fp, Mon Jan 2 11:07:17 1989.
3	#-gcl	3	#-gcl
4	(defpackage :sb-runtime	4	(defpackage :sb-runtime
5	#+sbcl (:use :common-lisp :ergolisp :oper :occ :term :sort :lang))	5	#+sbcl (:nicknames "RT-SB" "RTSB" "SB-RT" "SBRT")
		6	#+sbcl (:use :common-lisp :ergolisp :oper :occ :term :sort :lang)
		7	#+sbcl (:shadowing-import-from :sb-int memq))
6	(in-package :sb-runtime)	8	(in-package :sb-runtime)
7	#-sbcl (use-package :ergolisp)	9	#-sbcl (use-package :ergolisp)
8	#-sbcl (use-package '(:oper :occ :term :sort :lang))	10	#-sbcl (use-package '(:oper :occ :term :sort :lang))

Lines 25-31 Link Here

(-)pvs4.2-orig/ess/lang/sb-term/rel/top.lisp (-1 / +1 lines)
25	;;; Added calls to preprocessing phase.	25	;;; Added calls to preprocessing phase.
26		26
27		27
28	(in-package 'syntax-box) (use-package :ergolisp)	28	(in-package :syntax-box) (use-package :ergolisp)
29		29
30	(export '(sb sb-make))	30	(export '(sb sb-make))
31		31

Lines 14-20 Link Here

(-)pvs4.2-orig/ess/lang/sb-term/rel/unp-code-revise.lisp (-1 / +1 lines)
14	;;; This code modifies unparser generator code.	14	;;; This code modifies unparser generator code.
15	;;; Scott Dietzen, Wed Nov 11 15:38:39 1987	15	;;; Scott Dietzen, Wed Nov 11 15:38:39 1987
16		16
17	(in-package 'SB) (use-package :ergolisp)	17	(in-package :SB) (use-package :ergolisp)
18		18
19		19
20	(defun unp-code-revision (routines)	20	(defun unp-code-revision (routines)

Lines 26-32 Link Here

(-)pvs4.2-orig/ess/sys/ergolisp/rel/dlambda.lisp (-1 / +1 lines)
26	;; This is a macro so that setf will work for declare-constructor	26	;; This is a macro so that setf will work for declare-constructor
27	`(gethash ,constr constructors-table :no-info))	27	`(gethash ,constr constructors-table :no-info))
28		28
29	(defconstant reserved-constrs '(:as)	29	(defconstant-if-unbound reserved-constrs '(:as)
30	"List of symbols that may not be used as constructors.")	30	"List of symbols that may not be used as constructors.")
31		31
32	(defmacro defreconstr (constr argcnt &key equal)	32	(defmacro defreconstr (constr argcnt &key equal)

Lines 190-204 Link Here

(-)pvs4.2-orig/ess/sys/tools/rel/box-system.lisp (-13 / +11 lines)
190	(when lisp-compiler	190	(when lisp-compiler
191	(when boot	191	(when boot
192	(load source-file))	192	(load source-file))
193	(if readtable	193	(let ((readtable (if readtable readtable readtable))
194	(let ((readtable readtable))	194	#+sbcl (compiler-progress messages))
195	(compile-file source-file :output-file compiled-file
196	#+(or lucid allegro) :messages #+(or lucid allegro) messages
197	#+(or cmu sbcl) :progress #+(or cmu sbcl) messages
198	))
199	(compile-file source-file :output-file compiled-file	195	(compile-file source-file :output-file compiled-file
200	#+(or lucid allegro) :messages #+(or lucid allegro) messages	196	#+(or lucid allegro) :messages #+(or lucid allegro) messages
201	#+(or cmu sbcl) :progress #+(or cmu sbcl) messages	197	#+cmu :progress #+cmu messages
202	))	198	))
203	)	199	)
204	;; #+kcl (rename-file (merge-pathnames ".o" source-file) compiled-file)	200	;; #+kcl (rename-file (merge-pathnames ".o" source-file) compiled-file)
Lines 249-254 Link Here
249	(multiple-value-bind (junk1 junk2 result junk4)	245	(multiple-value-bind (junk1 junk2 result junk4)
250	(run-program "cc" :arguments arguments)	246	(run-program "cc" :arguments arguments)
251	result)	247	result)
		248	#+sbcl
		249	(sb-ext:process-exit-code (sb-ext:run-program "cc" arguments))
252	#+allegro	250	#+allegro
253	(excl:run-shell-command	251	(excl:run-shell-command
254	(format nil "cc ~{ ~a~}" arguments))))	252	(format nil "cc ~{ ~a~}" arguments))))
Lines 390-397 Link Here
390	;;; all source files are .lisp, so we need only one set.	388	;;; all source files are .lisp, so we need only one set.
391	;;; Recommend not changing the source extension. -fp	389	;;; Recommend not changing the source extension. -fp
392		390
393	(defconstant lisp-source-extension "lisp")	391	(defconstant-if-unbound lisp-source-extension "lisp")
394	(defconstant lisp-compiled-extension	392	(defconstant-if-unbound lisp-compiled-extension
395	#+(and allegro sparc) "fasl" ; Sun4	393	#+(and allegro sparc) "fasl" ; Sun4
396	#+(and allegro rios) "rfasl" ; PowerPC/RS6000	394	#+(and allegro rios) "rfasl" ; PowerPC/RS6000
397	#+(and allegro hpux) "hfasl" ; HP 9000	395	#+(and allegro hpux) "hfasl" ; HP 9000
Lines 421-434 Link Here
421	for this implementation of Lisp in the file sys/tools/rel/box-system.lisp.	419	for this implementation of Lisp in the file sys/tools/rel/box-system.lisp.
422	Right now it is assumed to be \"bin\".")	420	Right now it is assumed to be \"bin\".")
423		421
424	(defconstant lisp-source-suffix-string	422	(defconstant-if-unbound lisp-source-suffix-string
425	(concatenate 'string "." lisp-source-extension))	423	(concatenate 'string "." lisp-source-extension))
426		424
427	(defconstant lisp-compiled-suffix-string	425	(defconstant-if-unbound lisp-compiled-suffix-string
428	(concatenate 'string "." lisp-compiled-extension))	426	(concatenate 'string "." lisp-compiled-extension))
429		427
430	(defconstant lisp-source-extension-pathname	428	(defconstant-if-unbound lisp-source-extension-pathname
431	(make-pathname :type lisp-source-extension))	429	(make-pathname :type lisp-source-extension))
432		430
433	(defconstant lisp-compiled-extension-pathname	431	(defconstant-if-unbound lisp-compiled-extension-pathname
434	(make-pathname :type lisp-compiled-extension))	432	(make-pathname :type lisp-compiled-extension))

Lines 8-13 Link Here

(-)pvs4.2-orig/ess/sys/tools/rel/print-utils.lisp (+1 lines)
8	(defpackage :print-utils #+sbcl (:use :common-lisp :ergolisp))	8	(defpackage :print-utils #+sbcl (:use :common-lisp :ergolisp))
9	(in-package :print-utils) #-sbcl (use-package :ergolisp)	9	(in-package :print-utils) #-sbcl (use-package :ergolisp)
10		10
		11	#-sbcl
11	(export '(lisp::print-struct lisp::writing-readably)	12	(export '(lisp::print-struct lisp::writing-readably)
12	:lisp)	13	:lisp)
13	(export '(print-struct writing-readably))	14	(export '(print-struct writing-readably))




(defvar *regression-testing-p* nil)

(defun regression-test (&key (name "Anonymous test")
			     form (form-predicate #'identity) script donep)
  (declare (special name script donep))
  (let ((*regression-testing-p* t))
    (catch 'script-ended
      (let ((formval (if (functionp form) (funcall form) (eval form))))

  (cadr (car script)))

(defun move-script ()
  (declare (special name script donep))
  (when (null script)
    (if donep
	(throw 'script-ended nil)
	(error "Regression test ~s fell off of end of script." name)))
  (pop script)
  (when (and (null script) donep) (throw 'script-ended nil))
  (values))

(defmacro regression-test-only (key &body body)

 :name "Regressible-error should succeed."
 :form '(regressible-error :test "Error message ~s." 'foo)
 :script '((:test "Error message FOO."))
 :donep t)

#+regression
(regression-test







(defconstant-if-unbound standard-use-packages
  '("ERGOLISP" "OPER" "OCC" "TERM" "SORT" "SB-RUNTIME" "LANG" "NEWATTR")
  "The standard packages used by SB output files.")

(defconstant-if-unbound standard-use-languages
  '("LEXICAL-TERMINALS")
  "The standard languages used by SB output files.")


(defconstant-if-unbound gen-src-file-ext "lisp")

(defconstant-if-unbound per-gen-src-file-ext
  (concatenate 'string "." gen-src-file-ext))



Lines 19-25 Link Here

(-)pvs4.2-orig/ess/term/trep/rel/attr-prims.lisp (-1 / +5 lines)
19	;;; features from the terms, so it is the default method for storing	19	;;; features from the terms, so it is the default method for storing
20	;;; attributes.	20	;;; attributes.
21		21
22	(in-package "TERM" :nicknames '("GTERM")) (use-package :ergolisp)	22	(eval-when (compile load eval)
		23	(unless (find-package "TERM")
		24	(make-package "TERM" :nicknames '("GTERM")
		25	:use '(:cl-user :common-lisp :ergolisp))))
		26	(in-package "TERM")
23		27
24	(export '(attr-clear-one attr-clear-all))	28	(export '(attr-clear-one attr-clear-all))
25		29

Lines 29-35 Link Here

(-)pvs4.2-orig/ess/term/trep/rel/gterm.lisp (-1 / +5 lines)
29	;;; instead of a real operator.	29	;;; instead of a real operator.
30	;;;	30	;;;
31		31
32	(in-package :term :nicknames '(:gterm)) (use-package :ergolisp)	32	(eval-when (compile load eval)
		33	(unless (find-package "TERM")
		34	(make-package "TERM" :nicknames '("GTERM")
		35	:use '(:cl-user :common-lisp :ergolisp))))
		36	(in-package "TERM")
33		37
34	(export '(term termp mk-term ds-term term-op term-args	38	(export '(term termp mk-term ds-term term-op term-args
35	term-attr set-term-attr))	39	term-attr set-term-attr))

Lines 1-7 Link Here

(-)pvs4.2-orig/install-sh (-183 / +301 lines)
1	#!/bin/sh	1	#!/bin/sh
2	# install - install a program, script, or datafile	2	# install - install a program, script, or datafile
3		3
4	scriptversion=2005-11-07.23	4	scriptversion=2006-12-25.00
5		5
6	# This originates from X11R5 (mit/util/scripts/install.sh), which was	6	# This originates from X11R5 (mit/util/scripts/install.sh), which was
7	# later released in X11R6 (xc/config/util/install.sh) with the	7	# later released in X11R6 (xc/config/util/install.sh) with the
Lines 39-90 Link Here
39	# when there is no Makefile.	39	# when there is no Makefile.
40	#	40	#
41	# This script is compatible with the BSD install script, but was written	41	# This script is compatible with the BSD install script, but was written
42	# from scratch. It can only install one file at a time, a restriction	42	# from scratch.
43	# shared with many OS's install programs.	43
		44	nl='
		45	'
		46	IFS=" "" $nl"
44		47
45	# set DOITPROG to echo to test this script	48	# set DOITPROG to echo to test this script
46		49
47	# Don't use :- since 4.3BSD and earlier shells don't like it.	50	# Don't use :- since 4.3BSD and earlier shells don't like it.
48	doit="${DOITPROG-}"	51	doit=${DOITPROG-}
		52	if test -z "$doit"; then
		53	doit_exec=exec
		54	else
		55	doit_exec=$doit
		56	fi
49		57
50	# put in absolute paths if you don't have them in your path; or use env. vars.	58	# Put in absolute file names if you don't have them in your path;
		59	# or use environment vars.
51		60
52	mvprog="${MVPROG-mv}"	61	chgrpprog=${CHGRPPROG-chgrp}
53	cpprog="${CPPROG-cp}"	62	chmodprog=${CHMODPROG-chmod}
54	chmodprog="${CHMODPROG-chmod}"	63	chownprog=${CHOWNPROG-chown}
55	chownprog="${CHOWNPROG-chown}"	64	cmpprog=${CMPPROG-cmp}
56	chgrpprog="${CHGRPPROG-chgrp}"	65	cpprog=${CPPROG-cp}
57	stripprog="${STRIPPROG-strip}"	66	mkdirprog=${MKDIRPROG-mkdir}
58	rmprog="${RMPROG-rm}"	67	mvprog=${MVPROG-mv}
59	mkdirprog="${MKDIRPROG-mkdir}"	68	rmprog=${RMPROG-rm}
		69	stripprog=${STRIPPROG-strip}
		70
		71	posix_glob='?'
		72	initialize_posix_glob='
		73	test "$posix_glob" != "?" \|\| {
		74	if (set -f) 2>/dev/null; then
		75	posix_glob=
		76	else
		77	posix_glob=:
		78	fi
		79	}
		80	'
60		81
61	posix_glob=
62	posix_mkdir=	82	posix_mkdir=
63		83
64	# Symbolic mode for testing mkdir with directories.
65	# It is the same as 755, but also tests that "u+" works.
66	test_mode=u=rwx,g=rx,o=rx,u+wx
67
68	# Desired mode of installed file.	84	# Desired mode of installed file.
69	mode=0755	85	mode=0755
70		86
71	# Desired mode of newly created intermediate directories.	87	chgrpcmd=
72	# It is empty if not known yet.
73	intermediate_mode=
74
75	chmodcmd=$chmodprog	88	chmodcmd=$chmodprog
76	chowncmd=	89	chowncmd=
77	chgrpcmd=	90	mvcmd=$mvprog
78	stripcmd=
79	rmcmd="$rmprog -f"	91	rmcmd="$rmprog -f"
80	mvcmd="$mvprog"	92	stripcmd=
		93
81	src=	94	src=
82	dst=	95	dst=
83	dir_arg=	96	dir_arg=
84	dstarg=	97	dst_arg=
		98
		99	copy_on_change=false
85	no_target_directory=	100	no_target_directory=
86		101
87	usage="Usage: $0 [OPTION]... [-T] SRCFILE DSTFILE	102	usage="\
		103	Usage: $0 [OPTION]... [-T] SRCFILE DSTFILE
88	or: $0 [OPTION]... SRCFILES... DIRECTORY	104	or: $0 [OPTION]... SRCFILES... DIRECTORY
89	or: $0 [OPTION]... -t DIRECTORY SRCFILES...	105	or: $0 [OPTION]... -t DIRECTORY SRCFILES...
90	or: $0 [OPTION]... -d DIRECTORIES...	106	or: $0 [OPTION]... -d DIRECTORIES...
Lines 94-174 Link Here
94	In the 4th, create DIRECTORIES.	110	In the 4th, create DIRECTORIES.
95		111
96	Options:	112	Options:
97	-c (ignored)	113	--help display this help and exit.
98	-d create directories instead of installing files.	114	--version display version info and exit.
99	-g GROUP $chgrpprog installed files to GROUP.	115
100	-m MODE $chmodprog installed files to MODE.	116	-c (ignored)
101	-o USER $chownprog installed files to USER.	117	-C install only if different (preserve the last data modification time)
102	-s $stripprog installed files.	118	-d create directories instead of installing files.
103	-t DIRECTORY install into DIRECTORY.	119	-g GROUP $chgrpprog installed files to GROUP.
104	-T report an error if DSTFILE is a directory.	120	-m MODE $chmodprog installed files to MODE.
105	--help display this help and exit.	121	-o USER $chownprog installed files to USER.
106	--version display version info and exit.	122	-s $stripprog installed files.
		123	-t DIRECTORY install into DIRECTORY.
		124	-T report an error if DSTFILE is a directory.
107		125
108	Environment variables override the default commands:	126	Environment variables override the default commands:
109	CHGRPPROG CHMODPROG CHOWNPROG CPPROG MKDIRPROG MVPROG RMPROG STRIPPROG	127	CHGRPPROG CHMODPROG CHOWNPROG CMPPROG CPPROG MKDIRPROG MVPROG
		128	RMPROG STRIPPROG
110	"	129	"
111		130
112	while test -n "$1"; do	131	while test $# -ne 0; do
113	case $1 in	132	case $1 in
114	-c) shift	133	-c) ;;
115	continue;;
116		134
117	-d) dir_arg=true	135	-C) copy_on_change=true;;
118	shift	136
119	continue;;	137	-d) dir_arg=true;;
120		138
121	-g) chgrpcmd="$chgrpprog $2"	139	-g) chgrpcmd="$chgrpprog $2"
122	shift	140	shift;;
123	shift
124	continue;;
125		141
126	--help) echo "$usage"; exit $?;;	142	--help) echo "$usage"; exit $?;;
127		143
128	-m) mode=$2	144	-m) mode=$2
129	shift	145	case $mode in
130	shift	146	' ' \| ' ' \| *'
131	continue;;	147	'* \| ''* \| '?' \| '[')
		148	echo "$0: invalid mode: $mode" >&2
		149	exit 1;;
		150	esac
		151	shift;;
132		152
133	-o) chowncmd="$chownprog $2"	153	-o) chowncmd="$chownprog $2"
134	shift	154	shift;;
135	shift	155
136	continue;;	156	-s) stripcmd=$stripprog;;
137		157
138	-s) stripcmd=$stripprog	158	-t) dst_arg=$2
139	shift	159	shift;;
140	continue;;	160
141		161	-T) no_target_directory=true;;
142	-t) dstarg=$2
143	shift
144	shift
145	continue;;
146
147	-T) no_target_directory=true
148	shift
149	continue;;
150		162
151	--version) echo "$0 $scriptversion"; exit $?;;	163	--version) echo "$0 $scriptversion"; exit $?;;
152		164
153	*) # When -d is used, all remaining arguments are directories to create.	165	--) shift
154	# When -t is used, the destination is already specified.
155	test -n "$dir_arg$dstarg" && break
156	# Otherwise, the last argument is the destination. Remove it from $@.
157	for arg
158	do
159	if test -n "$dstarg"; then
160	# $@ is not empty: it contains at least $arg.
161	set fnord "$@" "$dstarg"
162	shift # fnord
163	fi
164	shift # arg
165	dstarg=$arg
166	done
167	break;;	166	break;;
		167
		168	-*) echo "$0: invalid option: $1" >&2
		169	exit 1;;
		170
		171	*) break;;
168	esac	172	esac
		173	shift
169	done	174	done
170		175
171	if test -z "$1"; then	176	if test $# -ne 0 && test -z "$dir_arg$dst_arg"; then
		177	# When -d is used, all remaining arguments are directories to create.
		178	# When -t is used, the destination is already specified.
		179	# Otherwise, the last argument is the destination. Remove it from $@.
		180	for arg
		181	do
		182	if test -n "$dst_arg"; then
		183	# $@ is not empty: it contains at least $arg.
		184	set fnord "$@" "$dst_arg"
		185	shift # fnord
		186	fi
		187	shift # arg
		188	dst_arg=$arg
		189	done
		190	fi
		191
		192	if test $# -eq 0; then
172	if test -z "$dir_arg"; then	193	if test -z "$dir_arg"; then
173	echo "$0: no input file specified." >&2	194	echo "$0: no input file specified." >&2
174	exit 1	195	exit 1
Lines 178-190 Link Here
178	exit 0	199	exit 0
179	fi	200	fi
180		201
181	test -n "$dir_arg" \|\| trap '(exit $?); exit' 1 2 13 15	202	if test -z "$dir_arg"; then
		203	trap '(exit $?); exit' 1 2 13 15
		204
		205	# Set umask so as not to create temps with too-generous modes.
		206	# However, 'strip' requires both read and write access to temps.
		207	case $mode in
		208	# Optimize common cases.
		209	*644) cp_umask=133;;
		210	*755) cp_umask=22;;
		211
		212	*[0-7])
		213	if test -z "$stripcmd"; then
		214	u_plus_rw=
		215	else
		216	u_plus_rw='% 200'
		217	fi
		218	cp_umask=`expr '(' 777 - $mode % 1000 ')' $u_plus_rw`;;
		219	*)
		220	if test -z "$stripcmd"; then
		221	u_plus_rw=
		222	else
		223	u_plus_rw=,u+rw
		224	fi
		225	cp_umask=$mode$u_plus_rw;;
		226	esac
		227	fi
182		228
183	for src	229	for src
184	do	230	do
185	# Protect names starting with `-'.	231	# Protect names starting with `-'.
186	case $src in	232	case $src in
187	-*) src=./$src ;;	233	-*) src=./$src;;
188	esac	234	esac
189		235
190	if test -n "$dir_arg"; then	236	if test -n "$dir_arg"; then
Lines 202-223 Link Here
202	exit 1	248	exit 1
203	fi	249	fi
204		250
205	if test -z "$dstarg"; then	251	if test -z "$dst_arg"; then
206	echo "$0: no destination specified." >&2	252	echo "$0: no destination specified." >&2
207	exit 1	253	exit 1
208	fi	254	fi
209		255
210	dst=$dstarg	256	dst=$dst_arg
211	# Protect names starting with `-'.	257	# Protect names starting with `-'.
212	case $dst in	258	case $dst in
213	-*) dst=./$dst ;;	259	-*) dst=./$dst;;
214	esac	260	esac
215		261
216	# If destination is a directory, append the input filename; won't work	262	# If destination is a directory, append the input filename; won't work
217	# if double slashes aren't ignored.	263	# if double slashes aren't ignored.
218	if test -d "$dst"; then	264	if test -d "$dst"; then
219	if test -n "$no_target_directory"; then	265	if test -n "$no_target_directory"; then
220	echo "$0: $dstarg: Is a directory" >&2	266	echo "$0: $dst_arg: Is a directory" >&2
221	exit 1	267	exit 1
222	fi	268	fi
223	dstdir=$dst	269	dstdir=$dst
Lines 230-243 Link Here
230	expr X"$dst" : 'X$.[^/]$//[^/][^/]/$' \\| \	276	expr X"$dst" : 'X$.[^/]$//[^/][^/]/$' \\| \
231	X"$dst" : 'X$//$[^/]' \\| \	277	X"$dst" : 'X$//$[^/]' \\| \
232	X"$dst" : 'X$//$$' \\| \	278	X"$dst" : 'X$//$$' \\| \
233	X"$dst" : 'X$/$' \\| \	279	X"$dst" : 'X$/$' \\| . 2>/dev/null \|\|
234	. : '$.$' 2>/dev/null \|\|
235	echo X"$dst" \|	280	echo X"$dst" \|
236	sed '/^X$.[^/]$\/\/[^/][^/]\/$/{ s//\1/; q; }	281	sed '/^X$.[^/]$\/\/[^/][^/]\/$/{
237	/^X$\/\/$[^/].*/{ s//\1/; q; }	282	s//\1/
238	/^X$\/\/$$/{ s//\1/; q; }	283	q
239	/^X$\/$.*/{ s//\1/; q; }	284	}
240	s/.*/./; q'	285	/^X$\/\/$[^/].*/{
		286	s//\1/
		287	q
		288	}
		289	/^X$\/\/$$/{
		290	s//\1/
		291	q
		292	}
		293	/^X$\/$.*/{
		294	s//\1/
		295	q
		296	}
		297	s/.*/./; q'
241	`	298	`
242		299
243	test -d "$dstdir"	300	test -d "$dstdir"
Lines 250-332 Link Here
250	if test $dstdir_status != 0; then	307	if test $dstdir_status != 0; then
251	case $posix_mkdir in	308	case $posix_mkdir in
252	'')	309	'')
253	posix_mkdir=false	310	# Create intermediate dirs using mode 755 as modified by the umask.
254	if $mkdirprog -m $test_mode -p -- / >/dev/null 2>&1; then	311	# This is like FreeBSD 'install' as of 1997-10-28.
255	posix_mkdir=true	312	umask=`umask`
256	else	313	case $stripcmd.$umask in
257	# Remove any dirs left behind by ancient mkdir implementations.	314	# Optimize common cases.
258	rmdir ./-m "$test_mode" ./-p ./-- 2>/dev/null	315	*[2367][2367]) mkdir_umask=$umask;;
259	fi ;;	316	.*0[02][02] \| .[02][02] \| .[02]) mkdir_umask=22;;
260	esac	317
261		318	*[0-7])
262	if	319	mkdir_umask=`expr $umask + 22 \
263	$posix_mkdir && {	320	- $umask % 100 % 40 + $umask % 20 \
		321	- $umask % 10 % 4 + $umask % 2
		322	`;;
		323	*) mkdir_umask=$umask,go-w;;
		324	esac
264		325
265	# With -d, create the new directory with the user-specified mode.	326	# With -d, create the new directory with the user-specified mode.
266	# Otherwise, create it using the same intermediate mode that	327	# Otherwise, rely on $mkdir_umask.
267	# mkdir -p would use when creating intermediate directories.
268	# POSIX says that this mode is "$(umask -S),u+wx", so use that
269	# if umask -S works.
270
271	if test -n "$dir_arg"; then	328	if test -n "$dir_arg"; then
272	mkdir_mode=$mode	329	mkdir_mode=-m$mode
273	else	330	else
274	case $intermediate_mode in	331	mkdir_mode=
275	'')
276	if umask_S=`(umask -S) 2>/dev/null`; then
277	intermediate_mode=$umask_S,u+wx
278	else
279	intermediate_mode=$test_mode
280	fi ;;
281	esac
282	mkdir_mode=$intermediate_mode
283	fi	332	fi
284		333
285	$mkdirprog -m "$mkdir_mode" -p -- "$dstdir"	334	posix_mkdir=false
286	}	335	case $umask in
		336	*[123567][0-7][0-7])
		337	# POSIX mkdir -p sets u+wx bits regardless of umask, which
		338	# is incompatible with FreeBSD 'install' when (umask & 300) != 0.
		339	;;
		340	*)
		341	tmpdir=${TMPDIR-/tmp}/ins$RANDOM-$$
		342	trap 'ret=$?; rmdir "$tmpdir/d" "$tmpdir" 2>/dev/null; exit $ret' 0
		343
		344	if (umask $mkdir_umask &&
		345	exec $mkdirprog $mkdir_mode -p -- "$tmpdir/d") >/dev/null 2>&1
		346	then
		347	if test -z "$dir_arg" \|\| {
		348	# Check for POSIX incompatibilities with -m.
		349	# HP-UX 11.23 and IRIX 6.5 mkdir -m -p sets group- or
		350	# other-writeable bit of parent directory when it shouldn't.
		351	# FreeBSD 6.1 mkdir -m -p sets mode of existing directory.
		352	ls_ld_tmpdir=`ls -ld "$tmpdir"`
		353	case $ls_ld_tmpdir in
		354	d????-?r-*) different_mode=700;;
		355	d????-?--*) different_mode=755;;
		356	*) false;;
		357	esac &&
		358	$mkdirprog -m$different_mode -p -- "$tmpdir" && {
		359	ls_ld_tmpdir_1=`ls -ld "$tmpdir"`
		360	test "$ls_ld_tmpdir" = "$ls_ld_tmpdir_1"
		361	}
		362	}
		363	then posix_mkdir=:
		364	fi
		365	rmdir "$tmpdir/d" "$tmpdir"
		366	else
		367	# Remove any dirs left behind by ancient mkdir implementations.
		368	rmdir ./$mkdir_mode ./-p ./-- 2>/dev/null
		369	fi
		370	trap '' 0;;
		371	esac;;
		372	esac
		373
		374	if
		375	$posix_mkdir && (
		376	umask $mkdir_umask &&
		377	$doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir"
		378	)
287	then :	379	then :
288	else	380	else
289		381
290	# mkdir does not conform to POSIX, or it failed possibly due to	382	# The umask is ridiculous, or mkdir does not conform to POSIX,
291	# a race condition. Create the directory the slow way, step by	383	# or it failed possibly due to a race condition. Create the
292	# step, checking for races as we go.	384	# directory the slow way, step by step, checking for races as we go.
293		385
294	case $dstdir in	386	case $dstdir in
295	/*) pathcomp=/ ;;	387	/*) prefix='/';;
296	-*) pathcomp=./ ;;	388	-*) prefix='./';;
297	*) pathcomp= ;;	389	*) prefix='';;
298	esac	390	esac
299		391
300	case $posix_glob in	392	eval "$initialize_posix_glob"
301	'')
302	if (set -f) 2>/dev/null; then
303	posix_glob=true
304	else
305	posix_glob=false
306	fi ;;
307	esac
308		393
309	oIFS=$IFS	394	oIFS=$IFS
310	IFS=/	395	IFS=/
311	$posix_glob && set -f	396	$posix_glob set -f
312	set fnord $dstdir	397	set fnord $dstdir
313	shift	398	shift
314	$posix_glob && set +f	399	$posix_glob set +f
315	IFS=$oIFS	400	IFS=$oIFS
316		401
		402	prefixes=
		403
317	for d	404	for d
318	do	405	do
319	test "x$d" = x && continue	406	test -z "$d" && continue
320		407
321	pathcomp=$pathcomp$d	408	prefix=$prefix$d
322	if test ! -d "$pathcomp"; then	409	if test -d "$prefix"; then
323	$mkdirprog "$pathcomp"	410	prefixes=
324	# Don't fail if two instances are running concurrently.	411	else
325	test -d "$pathcomp" \|\| exit 1	412	if $posix_mkdir; then
		413	(umask=$mkdir_umask &&
		414	$doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir") && break
		415	# Don't fail if two instances are running concurrently.
		416	test -d "$prefix" \|\| exit 1
		417	else
		418	case $prefix in
		419	\') qprefix=`echo "$prefix" \| sed "s/'/'\\\\\\\\''/g"`;;
		420	*) qprefix=$prefix;;
		421	esac
		422	prefixes="$prefixes '$qprefix'"
		423	fi
326	fi	424	fi
327	pathcomp=$pathcomp/	425	prefix=$prefix/
328	done	426	done
329	obsolete_mkdir_used=true	427
		428	if test -n "$prefixes"; then
		429	# Don't fail if two instances are running concurrently.
		430	(umask $mkdir_umask &&
		431	eval "\$doit_exec \$mkdirprog $prefixes") \|\|
		432	test -d "$dstdir" \|\| exit 1
		433	obsolete_mkdir_used=true
		434	fi
330	fi	435	fi
331	fi	436	fi
332		437
Lines 334-340 Link Here
334	{ test -z "$chowncmd" \|\| $doit $chowncmd "$dst"; } &&	439	{ test -z "$chowncmd" \|\| $doit $chowncmd "$dst"; } &&
335	{ test -z "$chgrpcmd" \|\| $doit $chgrpcmd "$dst"; } &&	440	{ test -z "$chgrpcmd" \|\| $doit $chgrpcmd "$dst"; } &&
336	{ test "$obsolete_mkdir_used$chowncmd$chgrpcmd" = false \|\|	441	{ test "$obsolete_mkdir_used$chowncmd$chgrpcmd" = false \|\|
337	test -z "$chmodcmd" \|\| $doit $chmodcmd "$mode" "$dst"; } \|\| exit 1	442	test -z "$chmodcmd" \|\| $doit $chmodcmd $mode "$dst"; } \|\| exit 1
338	else	443	else
339		444
340	# Make a couple of temp file names in the proper directory.	445	# Make a couple of temp file names in the proper directory.
Lines 345-351 Link Here
345	trap 'ret=$?; rm -f "$dsttmp" "$rmtmp" && exit $ret' 0	450	trap 'ret=$?; rm -f "$dsttmp" "$rmtmp" && exit $ret' 0
346		451
347	# Copy the file name to the temp name.	452	# Copy the file name to the temp name.
348	$doit $cpprog "$src" "$dsttmp" &&	453	(umask $cp_umask && $doit_exec $cpprog "$src" "$dsttmp") &&
349		454
350	# and set any options; do chmod last to preserve setuid bits.	455	# and set any options; do chmod last to preserve setuid bits.
351	#	456	#
Lines 353-393 Link Here
353	# ignore errors from any of these, just make sure not to ignore	458	# ignore errors from any of these, just make sure not to ignore
354	# errors from the above "$doit $cpprog $src $dsttmp" command.	459	# errors from the above "$doit $cpprog $src $dsttmp" command.
355	#	460	#
356	{ test -z "$chowncmd" \|\| $doit $chowncmd "$dsttmp"; } \	461	{ test -z "$chowncmd" \|\| $doit $chowncmd "$dsttmp"; } &&
357	&& { test -z "$chgrpcmd" \|\| $doit $chgrpcmd "$dsttmp"; } \	462	{ test -z "$chgrpcmd" \|\| $doit $chgrpcmd "$dsttmp"; } &&
358	&& { test -z "$stripcmd" \|\| $doit $stripcmd "$dsttmp"; } \	463	{ test -z "$stripcmd" \|\| $doit $stripcmd "$dsttmp"; } &&
359	&& { test -z "$chmodcmd" \|\| $doit $chmodcmd "$mode" "$dsttmp"; } &&	464	{ test -z "$chmodcmd" \|\| $doit $chmodcmd $mode "$dsttmp"; } &&
360		465
361	# Now rename the file to the real destination.	466	# If -C, don't bother to copy if it wouldn't change the file.
362	{ $doit $mvcmd -f "$dsttmp" "$dst" 2>/dev/null \	467	if $copy_on_change &&
363	\|\| {	468	old=`LC_ALL=C ls -dlL "$dst" 2>/dev/null` &&
364	# The rename failed, perhaps because mv can't rename something else	469	new=`LC_ALL=C ls -dlL "$dsttmp" 2>/dev/null` &&
365	# to itself, or perhaps because mv is so ancient that it does not	470
366	# support -f.	471	eval "$initialize_posix_glob" &&
367		472	$posix_glob set -f &&
368	# Now remove or move aside any old file at destination location.	473	set X $old && old=:$2:$4:$5:$6 &&
369	# We try this two ways since rm can't unlink itself on some	474	set X $new && new=:$2:$4:$5:$6 &&
370	# systems and the destination file might be busy for other	475	$posix_glob set +f &&
371	# reasons. In this case, the final cleanup might fail but the new	476
372	# file should still install successfully.	477	test "$old" = "$new" &&
373	{	478	$cmpprog "$dst" "$dsttmp" >/dev/null 2>&1
374	if test -f "$dst"; then	479	then
375	$doit $rmcmd -f "$dst" 2>/dev/null \	480	rm -f "$dsttmp"
376	\|\| { $doit $mvcmd -f "$dst" "$rmtmp" 2>/dev/null \	481	else
377	&& { $doit $rmcmd -f "$rmtmp" 2>/dev/null; :; }; }\	482	# Rename the file to the real destination.
378	\|\| {	483	$doit $mvcmd -f "$dsttmp" "$dst" 2>/dev/null \|\|
379	echo "$0: cannot unlink or rename $dst" >&2	484
380	(exit 1); exit 1	485	# The rename failed, perhaps because mv can't rename something else
381	}	486	# to itself, or perhaps because mv is so ancient that it does not
382	else	487	# support -f.
383	:	488	{
384	fi	489	# Now remove or move aside any old file at destination location.
385	} &&	490	# We try this two ways since rm can't unlink itself on some
386		491	# systems and the destination file might be busy for other
387	# Now rename the file to the real destination.	492	# reasons. In this case, the final cleanup might fail but the new
388	$doit $mvcmd "$dsttmp" "$dst"	493	# file should still install successfully.
389	}	494	{
390	} \|\| exit 1	495	test ! -f "$dst" \|\|
		496	$doit $rmcmd -f "$dst" 2>/dev/null \|\|
		497	{ $doit $mvcmd -f "$dst" "$rmtmp" 2>/dev/null &&
		498	{ $doit $rmcmd -f "$rmtmp" 2>/dev/null; :; }
		499	} \|\|
		500	{ echo "$0: cannot unlink or rename $dst" >&2
		501	(exit 1); exit 1
		502	}
		503	} &&
		504
		505	# Now rename the file to the real destination.
		506	$doit $mvcmd "$dsttmp" "$dst"
		507	}
		508	fi \|\| exit 1
391		509
392	trap '' 0	510	trap '' 0
393	fi	511	fi




endif
endif

ifneq ($(SBCLISP_HOME),)
# Check that the given SBCLISP_HOME works
SBCLISPEXE = $(SBCLISP_HOME)/bin/sbcl
ifeq ($(shell if [ -x "$(SBCLISPEXE)" ]; then echo OK; fi),OK)
SBCLVERSION = $(shell $(SBCLISPEXE) --version)
$(warning "$(SBCLVERSION)")
sbcl-devel += $(bindir)/devel/$(SYSTEM)-sbclisp
sbcl-rt += $(bindir)/runtime/$(SYSTEM)-sbclisp
else
$(error "$(SBCLISPEXE) is not executable")
endif
endif


LOAD-FOREIGN-EXTENSION=so

	  src/tex-support.lisp \
          src/raw-api.lisp

sbcllisp += src/utils/file-utils-sbcl.lisp
cmulisp += src/utils/file-utils-cmu.lisp
allegrolisp += src/utils/file-utils.lisp



bddlisp = BDD/bdd.lisp BDD/mu.lisp
allegrolisp += BDD/bdd-allegro.lisp BDD/mu-allegro.lisp
sbcllisp += BDD/bdd-sbcl.lisp BDD/mu-sbcl.lisp
cmulisp += BDD/bdd-cmu.lisp BDD/mu-cmu.lisp

PVSiolisp = src/PVSio/pvs-lib.lisp src/PVSio/defattach.lisp \

groundevallisp := $(patsubst %,$(PVSPATH)%,$(groundevallisp))
inst-by-unif-lisp := $(patsubst %,$(PVSPATH)%,$(inst-by-unif-lisp))
allegrolisp := $(patsubst %,$(PVSPATH)%,$(allegrolisp))
sbcllisp := $(patsubst %,$(PVSPATH)%,$(sbcllisp))
cmulisp := $(patsubst %,$(PVSPATH)%,$(cmulisp))
endif


.PHONY : all devel runtime parser emacs prelude-files-and-regions etags

ifneq ($(buildcmds),)
ifeq ($(SBCLISP_HOME)$(CMULISP_HOME)$(ALLEGRO_HOME),)
$(error "Must set SBCLISP_HOME, CMULISP_HOME, or ALLEGRO_HOME")
endif
endif

all : devel runtime prelude-files-and-regions $(emacs-elc) etags

devel : $(allegro-devel) $(sbcl-devel) $(cmulisp-devel)

runtime : $(allegro-rt) $(sbcl-rt) $(cmulisp-rt)

parser : pvs-parser-out



etags : $(PVSPATH)TAGS

$(PVSPATH)TAGS : $(lisp-files) $(allegrolisp) $(sbcllisp) $(cmulisp) $(pvs-emacs-src)
	$(ETAGS) $(lisp-files) $(allegrolisp) $(sbcllisp) $(cmulisp) $(pvs-emacs-src)

fileutils = \
   $(PVSPATH)src/utils/$(PLATFORM)/file_utils.$(LOAD-FOREIGN-EXTENSION) \

# Here are the rules for building the PVS grammar, pvs-methods file, and
# devel and runtime images.

ifneq ($(SBCLISP_HOME),)

ifeq ($(ALLEGRO_HOME),) # Build these with Allegro, if available
$(PVSPATH)src/pvs-lexer.lisp : $(pvs-parser-in)
	@echo "******* Creating parser"
	$(SBCLISPEXE) --load src/make-pvs-parser

$(PVSPATH)src/pvs-methods.lisp : $(PVSPATH)src/make-pvs-methods.lisp \
	$(PVSPATH)src/defcl.lisp \
	$(PVSPATH)src/classes-expr.lisp \
	$(PVSPATH)src/classes-decl.lisp
	@echo "******* Creating pvs-methods.lisp"
	$(SBCLISPEXE) --eval "(defvar *pvs-path* \"$(PVSPATH)\")" \
		   --load src/make-pvs-methods.lisp
endif

$(sbcl-devel) $(sbcl-rt) : $(image-deps) \
             $(pvs-make-files) $(ess) $(ff-files) \
             $(lisp-files) $(sbcllisp) \
             $(PVSPATH)lib/prelude.pvs $(PVSPATH)lib/prelude.prf
	$(MKDIR) -p $(subst $(SYSTEM)-sbclisp,,$@)
	@echo "******* Compiling PVS files in Steel Bank Common Lisp (SBCL)"
	$(SBCLISPEXE) --eval '(require :sb-posix)' \
		      --eval '(require :sb-md5)' \
		      --eval '(load "pvs.system" :verbose t)' \
		      --eval "(let ((*load-pvs-prelude* nil)) \
				(mk:operate-on-system :pvs :compile))" \
		      --eval '(quit)'
	cp $(PVSPATH)src/utils/$(PLATFORM)/b64 $(bindir)
	@echo "******* Building PVS image $@"
	$(SBCLISPEXE) --eval '(require :sb-posix)' \
		      --eval '(require :sb-md5)' \
		      --eval '(load "pvs.system" :verbose t)' \
		      --eval "(unwind-protect \
				  (mk:operate-on-system :pvs :compile) \
				(save-lisp-and-die \"$@.core\" \
				    :toplevel (function startup-pvs) \
			       ))"
	-rm $(PVSPATH)BDD/$(PLATFORM)/bdd-sbcl.*
	cp $(SBCLISPEXE) $(subst $(SYSTEM)-sbclisp,,$@)
	cp $(PVSPATH)BDD/$(PLATFORM)/mu.$(LOAD-FOREIGN-EXTENSION) $(subst $(SYSTEM)-sbclisp,,$@)
	cp $(PVSPATH)BDD/bdd-sbcl.lisp $(PVSPATH)BDD/mu-sbcl.lisp $(subst $(SYSTEM)-sbclisp,,$@)
	cp $(PVSPATH)src/WS1S/$(PLATFORM)/ws1s.$(LOAD-FOREIGN-EXTENSION) $(subst $(SYSTEM)-sbclisp,,$@)
	cp $(PVSPATH)src/WS1S/lisp/dfa-foreign-sbcl.lisp $(subst $(SYSTEM)-sbclisp,,$@)
	cp $(PVSPATH)src/utils/$(PLATFORM)/b64 $(bindir)
	echo "#!/bin/sh" > $@
	echo "sbcl --core \`dirname \$$0\`/\`basename \$$0\`.core \$$*" >> $@
	chmod a+x $@
endif

ifneq ($(CMULISP_HOME),)

ifeq ($(ALLEGRO_HOME),) # Build these with Allegro, if available


faslexts = fasl,rfasl,hfasl,lfasl,mfasl,nfasl,sbin,obin,rbin,mbin,x86f,ppcf,sparcf,x8664s,x86s,ppcs,sparcs,clfasl,wfasl,err

platforms = ix86-Linux,ix86_64-Linux,ix86-MacOSX,powerpc-MacOSX,powerpc-MacOSX,sun4-SunOS5
# HT: Need to put a comma in a variable, because a literal 
# comma cannot appear in a makefile function argument.
comma:= ,

Lines 99-105 Link Here

(-)pvs4.2-orig/pvs-config.lisp (-1 / +1 lines)
99		99
100	#+sbcl	100	#+sbcl
101	(defun bye (&optional (exit-status 0))	101	(defun bye (&optional (exit-status 0))
102	(sb-unix:unix-exit exit-status))	102	(quit :unix-status exit-status))
103		103
104	(defun pvs-version-and-quit ()	104	(defun pvs-version-and-quit ()
105	(format t "PVS Version ~a" (eval (find-symbol (string :pvs-version) :pvs)))	105	(format t "PVS Version ~a" (eval (find-symbol (string :pvs-version) :pvs)))




#   -version | --version prints the PVS version
#   -emacs emacsref        emacs, xemacs, alias, or pathname
#   -load-after efile      loads emacs file name after PVS emacs files
#   -lisp name             lisp image name - allegro, cmulisp, or sbclisp
#   -runtime               use the runtime image (devel is default, if there)
#   -decision-procedures   set the default decision procedures (ics or shostak)
#   -force-decision-procedures  forces the decision procedures to be used

#   PVSVERBOSE    - corresponds to the -v argument
#
# The following environment variables are used by PVS, and are set below:
#   PVSPATH     pvs system path - this should not normally be set by the user
#   PVSARCH	sun4, ix86, ix86_64, or powerpc
#
# The PVS binary paths are appended to the front of the PATH variable
# --------------------------------------------------------------------
# PVS
# Copyright (C) 2006, SRI International.  All Rights Reserved.

       case $2 in
	 allegro) PVSLISP=allegro;;
	 cmulisp) PVSLISP=cmulisp;;
	 sbclisp) PVSLISP=sbclisp;;
	 *) echo "Only allegro, cmulisp, and sbclisp are currently available"
	    exit 1;;
       esac
       shift;;

  -version | --version show the PVS version number
  -emacs emacsref    emacs, xemacs, alias, or pathname
  -load-after efile  loads emacs file after PVS emacs files
  -lisp name         lisp image name (allegro, cmulisp, or sbclisp)
  -runtime           use the runtime image
  -decision-procedures  set default decision procedures (ics or shostak)
  -force-decision-procedures  forces the decision procedures (ics or shostak)

case $opsys in
  SunOS) majvers=`uname -r | cut -d"." -f1`
	 if [ $majvers = 4 ]
	    then echo "PVS 4.2 only runs under Mac OS X, Linux, FreeBSD, or Solaris"; exit 1
	 fi
	 PVSARCH=sun4;;
  Linux) # If Linux, we need to determine the Redhat version to use.
	 opsys=Linux
	 majvers=
	 case `uname -m` in
	   x86)    PVSARCH=ix86    ;;
	   x86_64) PVSARCH=ix86_64 ;;
	   *) echo "PVS 4.2 only runs on Intel Linux"; exit 1
	 esac
	 # Allegro does not work with Linux's New Posix Thread Library (NPTL)
	 # used in newer Red Hat kernels and 2.6 kernels.  This will force
	 # the old thread-implementation.

	 ;;
  FreeBSD) opsys=Linux
	   majvers=
	   case `uname -m` in
	     x86)    PVSARCH=ix86    ;;
	     x86_64) PVSARCH=ix86_64 ;;
	     *) echo "PVS 4.2 only runs on Intel Linux"; exit 1
	   esac
	   # Allegro does not work with Linux's New Posix Thread Library (NPTL)
	   # used in newer Red Hat kernels and 2.6 kernels.  This will force
	   # the old thread-implementation.

          #majvers=`uname -r | cut -d"." -f1`
	  majvers=
	  ;;
  *) echo "PVS 4.2 only runs under Solaris, Linux, FreeBSD (linux-enabled), or Mac (Darwin 7.4)"; exit 1
esac

binpath=$PVSPATH/bin/$PVSARCH-$opsys${majvers}

if [ -n "$PVSLISP" -a "$PVSLISP" != "allegro" -a "$PVSLISP" != "cmulisp" -a "$PVSLISP" != "sbclisp" ]
  then echo "ERROR: PVSLISP must be unset, or set to 'allegro', 'cmulisp', or 'sbclisp'"
       exit 1
fi


        then PVSLISP=cmulisp
        elif [ -x $binpath/runtime/pvs-cmulisp ]
        then PVSLISP=cmulisp
	elif [ -x $binpath/devel/pvs-sbclisp ]
	then PVSLISP=sbclisp
	elif [ -x $binpath/runtime/pvs-sbclisp ]
	then PVSLISP=sbclisp
        else echo "No executable available in $binpath"
             exit 1
        fi

	    do flags="$flags -load $lf"; done
	fi
	;;
    sbclisp)
	noinit="--noinform --no-userinit"
	evalflag="--eval"
	if [ -n "$lisploadfiles" ]
	  then
	    flags="$flags --eval (pvs::pvs-init)"
	    for lf in $lisploadfiles
	    do flags="$flags --load $lf"; done
	fi
	;;
esac

PVSPATCHLEVEL=${PVSPATCHLEVEL:-2}

Lines 22-28 Link Here

(-)pvs4.2-orig/pvsio.in (-2 / +3 lines)
22	-T\|--timing print timing information for each evaluation	22	-T\|--timing print timing information for each evaluation
23	-v\|--version print PVSio version	23	-v\|--version print PVSio version
24	-V\|--verbose print typechecking information	24	-V\|--verbose print typechecking information
25	-l\|--lisp PVS lisp version [allegro,cmulisp]	25	-l\|--lisp PVS lisp version [allegro,cmulisp,sbclisp]
26	<file>@<theory>:<main> load <theory> from <file>.pvs, evaluate <main>,	26	<file>@<theory>:<main> load <theory> from <file>.pvs, evaluate <main>,
27	and exit	27	and exit
28		28
Lines 42-48 Link Here
42	case $2 in	42	case $2 in
43	allegro) PVSLISP='-lisp allegro';;	43	allegro) PVSLISP='-lisp allegro';;
44	cmulisp) PVSLISP='-lisp cmulisp';;	44	cmulisp) PVSLISP='-lisp cmulisp';;
45	*) echo "Only allegro and cmulisp are currently available"	45	sbclisp) PVSLISP='-lisp sbclisp';;
		46	*) echo "Only allegro, cmulisp, and sbclisp are currently available"
46	exit 1;;	47	exit 1;;
47	esac	48	esac
48	shift;;	49	shift;;




Name:           pvs-sbcl
Version:        4.2
Release:        1%{?dist}
Summary:        The PVS Verification System, SBCL build

Group:          Applications/Engineering
License:        GPLv2+
URL:            http://pvs.csl.sri.com/
Source0:        http://pvs.csl.sri.com/download-open/pvs-%{version}-source.tgz
Source1:        http://pvs.csl.sri.com/doc/pvs-prelude.pdf
Source2:        http://pvs.csl.sri.com/doc/interpretations.pdf
Source3:        http://pvs.csl.sri.com/papers/csl-97-2/csl-97-2.ps.gz
Source4:        http://pvs.csl.sri.com/papers/csl-93-9/csl-93-9.ps.gz
Patch0:         pvs-4.2-sbcl.patch
Patch1:         pvs-4.2-unused.patch
Patch2:         pvs-4.2-64bit.patch
Patch3:         pvs-4.2-mona.patch
Patch4:         pvs-4.2-config.patch
Patch5:         pvs-4.2-typo.patch
Patch6:         pvs-4.2-emacs.patch
Patch7:         pvs-4.2-latex.patch
BuildRoot:      %{_tmppath}/%{name}-%{version}-%{release}-root-%(%{__id_u} -n)

BuildRequires:  sbcl, texinfo-tex, texlive-latex, emacs-el, xemacs-devel
Requires:       sbcl, texlive-latex
Provides:       pvs = %{version}-%{release}, pvsio = %{version}-%{release}

%description
PVS is a verification system: that is, a specification language integrated
with support tools and a theorem prover.  It is intended to capture the
state-of-the-art in mechanized formal methods and to be sufficiently rugged
that it can be used for significant applications.  PVS is a research
prototype: it evolves and improves as we develop or apply new capabilities,
and as the stress of real use exposes new requirements.

%prep
%setup -q -c
cp -p %{SOURCE1} %{SOURCE2} %{SOURCE3} %{SOURCE4} .

# Enable support for building PVS with sbcl
%patch0 -p1

# Get rid of an unused variable warning
%patch1 -p1

# Enable building on 64-bit platforms
%patch2 -p1

# Enable use of a system-installed Mona
%patch3 -p1

# Update config.sub and config.guess so they'll recognize amd64- systems
%patch4 -p1

# Fix a few typographical errors that result in miscompilations
%patch5 -p1

# Modernize the Emacs interface
%patch6 -p1

# Use the fancyhdr package instead of the obsolete fancyheadings package.
# Also don't try to make Emacs kill an already dead process.
%patch7 -p1

%build
./configure CFLAGS="$RPM_OPT_FLAGS -fPIC"
make SBCLISP_HOME=/usr PVSPATH=`pwd`/

# Now that we're done building, we don't want the devel version
rm -fr bin/*/devel

# We also don't want the useless copy of the sbcl binary
rm -f bin/*/runtime/sbcl

# Run it once to force Lisp compilation of the native interfaces
bin/relocate > /dev/null
echo -e '(sb-ext:quit :recklessly-p t)' | ./pvs -raw

# Get rid of some emacs save files and CVS control files
find . -name .cvsignore -o -name \*~ | xargs rm -f

# Get rid of some temporary files we no longer need
rm -f doc/release-notes/pvs-release-notes.{pg,ky,tp,fn,cp,vr}

# Build the documentation
make -C doc/language
mv doc/language/language.pdf pvs-language-reference.pdf

make -C doc/prover
mv doc/prover/prover.pdf pvs-prover-guide.pdf

rm -f doc/release-notes/pvs-release-notes.pdf
make -C doc/release-notes pvs-release-notes.pdf

make -C doc/user-guide
mv doc/user-guide/user-guide.pdf pvs-system-guide.pdf

# Mimic the effects of the relocate script for the installed location
sed -i -e "s,^PVSPATH=.*$,PVSPATH=%{_datadir}/pvs," pvs
sed -i -e "s,^PVSPATH=.*$,PVSPATH=%{_datadir}/pvs," pvsio

%install
rm -rf $RPM_BUILD_ROOT
mkdir -p $RPM_BUILD_ROOT%{_bindir}
mkdir -p $RPM_BUILD_ROOT%{_datadir}/pvs/doc/release-notes
mkdir -p $RPM_BUILD_ROOT%{_datadir}/texmf/tex/latex/pvs
cp -a bin emacs lib pvs-tex.sub wish $RPM_BUILD_ROOT%{_datadir}/pvs
cp -a doc/release-notes/pvs-release-notes.info $RPM_BUILD_ROOT%{_datadir}/pvs/doc/release-notes
cp -a pvs.sty $RPM_BUILD_ROOT%{_datadir}/texmf/tex/latex/pvs
cp -a pvs pvsio $RPM_BUILD_ROOT%{_bindir}

# We don't need the relocate script
rm -f $RPM_BUILD_ROOT%{_datadir}/pvs/bin/relocate

%clean
rm -rf $RPM_BUILD_ROOT

%post -p /usr/bin/mktexlsr

%postun -p /usr/bin/mktexlsr

%files
%defattr(-,root,root,-)
%doc *.pdf *.ps.gz LICENSE NOTICES README doc/PVSio-2.d.pdf Examples
%{_bindir}/pvs*
%{_datadir}/pvs
%{_datadir}/texmf/tex/latex/pvs

%changelog
* Fri Jan 23 2009 Jerry James <loganjerry@gmail.com> - 4.2-1
- Initial package, based on cmulisp package

Lines 25-30 Link Here

(-)pvs4.2-orig/pvs.system (-6 / +30 lines)
25	;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.	25	;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
26	;; --------------------------------------------------------------------	26	;; --------------------------------------------------------------------
27		27
		28	(in-package :common-lisp)
		29
		30	(#-(or cmu sbcl) progn
		31	#+cmu ext:without-package-locks
		32	#+sbcl sb-ext:without-package-locks
		33	(defmacro defconstant-if-unbound (name value &optional doc)
		34	`(defconstant ,name (if (boundp ',name) (symbol-value ',name) ,value)
		35	,@(when doc (list doc))))
		36	(export 'defconstant-if-unbound))
		37
28	(in-package :cl-user)	38	(in-package :cl-user)
29		39
30	#+allegro	40	#+allegro
Lines 46-54 Link Here
46	#+sbcl	56	#+sbcl
47	(defun startup-pvs ()	57	(defun startup-pvs ()
48	(in-package :pvs)	58	(in-package :pvs)
49	;; Can't directly call (pvs::pvs-init)	59	;; Turn off compiler warnings
50	(apply (find-symbol (string :pvs-init) :pvs) nil)	60	(handler-bind ((sb-ext:compiler-note #'muffle-warning))
51	)	61	;; Can't directly call (pvs::pvs-init)
		62	(apply (find-symbol (string :pvs-init) :pvs) nil)
		63	(sb-impl::toplevel-init)))
52		64
53	#+allegro	65	#+allegro
54	(eval-when (eval load)	66	(eval-when (eval load)
Lines 59-70 Link Here
59	excl:enclose-printer-errors nil	71	excl:enclose-printer-errors nil
60	print-pretty t))	72	print-pretty t))
61		73
		74	#+sbcl
		75	(eval-when (eval load)
		76	(setq compile-verbose nil)
		77	(setq compile-print nil))
		78
62	(eval-when (eval load)	79	(eval-when (eval load)
63	;; This sets pvs-path and sets pvs-binary-type	80	;; This sets pvs-path and sets pvs-binary-type
64	(load "pvs-config.lisp")	81	(load "pvs-config.lisp")
65	#+allegro (chdir pvs-path))	82	#+allegro (chdir pvs-path))
66		83
67	(defpackage :ilisp)	84	(defpackage :ilisp (:nicknames :ILISP) (:use :common-lisp #+:CMU :conditions))
68	(defpackage :bvec)	85	(defpackage :bvec)
69		86
70	(unless (find-package :make)	87	(unless (find-package :make)
Lines 181-187 Link Here
181	(load (format nil "~a/src/xp" pvs-path))	198	(load (format nil "~a/src/xp" pvs-path))
182	#+gcl	199	#+gcl
183	(load (format nil "~a/src/xp-code" pvs-path))	200	(load (format nil "~a/src/xp-code" pvs-path))
184	(apply (find-symbol :install :xp) :package :pvs nil))	201	#-sbcl
		202	(apply (find-symbol :install :xp) :package :pvs nil)
		203	#+sbcl
		204	(apply (find-symbol "INSTALL" (find-package :xp))
		205	:package :pvs nil))
185	#-(or cmu sbcl)	206	#-(or cmu sbcl)
186	(load (format nil "~a/ess/dist-ess.lisp" pvs-path))	207	(load (format nil "~a/ess/dist-ess.lisp" pvs-path))
187	#-gcl	208	#-gcl
Lines 215-220 Link Here
215	(let* ((platform #+(and sun4 sunos4) "sun4-SunOS4"	236	(let* ((platform #+(and sun4 sunos4) "sun4-SunOS4"
216	#+(and sun4 (not sunos4)) "sun4-SunOS5"	237	#+(and sun4 (not sunos4)) "sun4-SunOS5"
217	#+(and x86 (not macosx)) "ix86-Linux"	238	#+(and x86 (not macosx)) "ix86-Linux"
		239	#+(and x86-64 (not macosx)) "ix86_64-Linux"
218	#+(and macosx powerpc) "powerpc-MacOSX"	240	#+(and macosx powerpc) "powerpc-MacOSX"
219	#+(and macosx x86) "ix86-MacOSX")	241	#+(and macosx x86) "ix86-MacOSX")
220	(utilpath (concatenate 'string	242	(utilpath (concatenate 'string
Lines 281-287 Link Here
281	:components ((:file "hashfn")	303	:components ((:file "hashfn")
282	#+allegro	304	#+allegro
283	(:file "file-utils")	305	(:file "file-utils")
284	#+(or cmu sbcl)	306	#+sbcl
		307	(:file "file-utils-sbcl")
		308	#+cmu
285	(:file "file-utils-cmu")))	309	(:file "file-utils-cmu")))
286	(:module language	310	(:module language
287	:source-pathname "src/"	311	:source-pathname "src/"

Lines 27-33 Link Here

(-)pvs4.2-orig/src/abstraction/abstract.lisp (-1 / +1 lines)
27	;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.	27	;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
28	;; --------------------------------------------------------------------	28	;; --------------------------------------------------------------------
29		29
30	(in-package 'pvs)	30	(in-package :pvs)
31		31
32		32
33	(defvar abs-cache+ nil)	33	(defvar abs-cache+ nil)

Lines 141-147 Link Here

(-)pvs4.2-orig/src/classes-decl.lisp (-1 / +5 lines)
141	type-name type-name? type-value types update-expr using-hash	141	type-name type-name? type-value types update-expr using-hash
142	var-decl visible?))	142	var-decl visible?))
143	#+(or cmu sbcl)	143	#+(or cmu sbcl)
144	(ext:without-package-locks	144	(#-sbcl ext:without-package-locks #+sbcl sb-ext:without-package-locks
145	(defgeneric class (x))	145	(defgeneric class (x))
146	(defgeneric (setf class) (x y))	146	(defgeneric (setf class) (x y))
147	(defgeneric keyword (x))	147	(defgeneric keyword (x))
Lines 338-343 Link Here
338	;;; unparser. The type is set by the typechecker to the canonical value	338	;;; unparser. The type is set by the typechecker to the canonical value
339	;;; of the declared-type.	339	;;; of the declared-type.
340		340
		341	(
		342	#-sbcl progn
		343	#+sbcl sb-ext:without-package-locks
341	(defcl declaration (syntax)	344	(defcl declaration (syntax)
342	(newline-comment :restore-as nil)	345	(newline-comment :restore-as nil)
343	(id :type (or symbol number) :parse t :restore-as nil)	346	(id :type (or symbol number) :parse t :restore-as nil)
Lines 353-358 Link Here
353	(semi :parse t :restore-as nil)	356	(semi :parse t :restore-as nil)
354	(tcc-form :fetch-as nil :ignore t)	357	(tcc-form :fetch-as nil :ignore t)
355	(typecheck-time :restore-as nil))	358	(typecheck-time :restore-as nil))
		359	)
356		360
357	;;; declared-type-string keeps the string of the declared type for	361	;;; declared-type-string keeps the string of the declared type for
358	;;; creating the pvs context - see create-declaration-entry	362	;;; creating the pvs context - see create-declaration-entry

Lines 35-41 Link Here

(-)pvs4.2-orig/src/classes-expr.lisp (-2 / +14 lines)
35	propositional-application))	35	propositional-application))
36		36
37	#+(or cmu sbcl)	37	#+(or cmu sbcl)
38	(ext:without-package-locks	38	(#-sbcl ext:without-package-locks #+sbcl sb-ext:without-package-locks
39	(defgeneric type (x))	39	(defgeneric type (x))
40	(defgeneric (setf type) (x y))	40	(defgeneric (setf type) (x y))
41	(defgeneric number (x))	41	(defgeneric number (x))
Lines 45-51 Link Here
45		45
46	#+(or cmu sbcl)	46	#+(or cmu sbcl)
47	;; This is actually defined in utils, but convenient to add here	47	;; This is actually defined in utils, but convenient to add here
48	(ext:without-package-locks	48	(#-sbcl ext:without-package-locks #+sbcl sb-ext:without-package-locks
49	(defgeneric condition (x)))	49	(defgeneric condition (x)))
50		50
51	;;; Provide a class on which to hang syntactic information	51	;;; Provide a class on which to hang syntactic information
Lines 172-179 Link Here
172	;; When an extraction-expr is used as a conversion	172	;; When an extraction-expr is used as a conversion
173	(defcl extraction-conversion (extraction-application))	173	(defcl extraction-conversion (extraction-application))
174		174
		175	#-sbcl
175	(defcl number-expr (expr)	176	(defcl number-expr (expr)
176	(number :type integer :parse t :restore-as nil))	177	(number :type integer :parse t :restore-as nil))
		178	#+sbcl
		179	(sb-ext:without-package-locks
		180	(defcl number-expr (expr)
		181	(number :type integer :parse t :restore-as nil)))
177		182
178	;; This is for integers of the form xxx.000, where the fractional part is	183	;; This is for integers of the form xxx.000, where the fractional part is
179	;; all zeros. We keep it as a number expr, but store the number of zeros so	184	;; all zeros. We keep it as a number expr, but store the number of zeros so
Lines 529-538 Link Here
529	;;; resolution. The inclusions are the predicates which will become	534	;;; resolution. The inclusions are the predicates which will become
530	;;; TCCs if that particular resolution is chosen.	535	;;; TCCs if that particular resolution is chosen.
531		536
		537	#-sbcl
532	(defcl resolution ()	538	(defcl resolution ()
533	(declaration :restore-as nil)	539	(declaration :restore-as nil)
534	module-instance	540	module-instance
535	type)	541	type)
		542	#+sbcl
		543	(sb-ext:without-package-locks
		544	(defcl resolution ()
		545	(declaration :restore-as nil)
		546	module-instance
		547	type))
536		548
537	;(defcl judgement-resolution (resolution)	549	;(defcl judgement-resolution (resolution)
538	; judgement-type	550	; judgement-type




	      subdir))
	(multiple-value-bind (result err)
	    (ignore-lisp-errors #+allegro (excl:make-directory subdir)
			   #+cmu (unix:unix-mkdir (namestring subdir) #o777)
			   #+sbcl
			   (sb-unix:unix-mkdir (namestring subdir) #o777))
	  (cond (result (pvs-message "Created directory ~a" subdir)
			t)
		(t (pvs-message "Error creating ~a: ~a" subdir err)


#+(or cmu sbcl)
(defun md5-file (file)
  (let ((digest (#+cmu md5:md5sum-file #+sbcl sb-md5:md5sum-file file))
	(sum 0))
    (loop for x across digest
	  do (setq sum (+ (* sum 256) x)))

Lines 203-209 Link Here

(-)pvs4.2-orig/src/datatype.lisp (-1 / +2 lines)
203	(checksum-ok? (and adt-ce	203	(checksum-ok? (and adt-ce
204	file-exists?	204	file-exists?
205	(equal #+allegro (excl:md5-file adt-path)	205	(equal #+allegro (excl:md5-file adt-path)
206	#-allegro (md5:md5sum-file adt-path)	206	#+sbcl (sb-md5:md5sum-file adt-path)
		207	#-(or allegro sbcl) (md5:md5sum-file adt-path)
207	(ce-md5sum adt-ce)))))	208	(ce-md5sum adt-ce)))))
208	(unless (and file-exists?	209	(unless (and file-exists?
209	ce	210	ce




(defmacro defcl (name classes &rest args)
  (setf args (mapcar #'(lambda (a) (if (consp a) a (list a))) args))
  `(progn ,@(mapcar #'(lambda (a)
			#+(or allegro sbcl)
				  `(declaim (ftype (function
						    (t)
						    ,(cadr (member :type a)))
						   ,(car a)))
			#-(or allegro sbcl)
				  `(proclaim '(function ,(car a) (t)
					       ,(cadr (member :type a)))))
		    (remove-if-not #'(lambda (a) (member :type a))
		      args))

Lines 4796-4802 Link Here

(-)pvs4.2-orig/src/defsystem.lisp (-1 / +1 lines)
4796	:loader #+:lucid #'load-foreign-files	4796	:loader #+:lucid #'load-foreign-files
4797	#+:allegro #'load	4797	#+:allegro #'load
4798	#+(or :cmu :scl) #'alien:load-foreign	4798	#+(or :cmu :scl) #'alien:load-foreign
4799	#+:sbcl #'sb-alien:load-foreign	4799	#+:sbcl #'sb-alien:load-shared-object
4800	#+(and :lispworks :unix (not :linux) (not :macosx)) #'link-load:read-foreign-modules	4800	#+(and :lispworks :unix (not :linux) (not :macosx)) #'link-load:read-foreign-modules
4801	#+(and :lispworks :unix (or :linux :macosx)) #'fli:register-module	4801	#+(and :lispworks :unix (or :linux :macosx)) #'fli:register-module
4802	#+(and :lispworks :win32) #'fli:register-module	4802	#+(and :lispworks :win32) #'fli:register-module

Lines 346-352 Link Here

(-)pvs4.2-orig/src/globals.lisp (-1 / +4 lines)
346	(pprint-indent :block 0)	346	(pprint-indent :block 0)
347	(loop (pprint-exit-if-list-exhausted)	347	(loop (pprint-exit-if-list-exhausted)
348	(write (pprint-pop) :stream stream :escape nil :pretty nil	348	(write (pprint-pop) :stream stream :escape nil :pretty nil
349	:pprint-dispatch nil)	349	:pprint-dispatch #-sbcl nil
		350	#+sbcl (sb-pretty::make-pprint-dispatch-table)
		351	)
350	(pprint-exit-if-list-exhausted)	352	(pprint-exit-if-list-exhausted)
351	(pprint-newline :mandatory stream)))))	353	(pprint-newline :mandatory stream)))))
352		354
Lines 385-390 Link Here
385		387
386	(defvar use-default-dp? nil)	388	(defvar use-default-dp? nil)
387	(defvar prover-print-lines nil)	389	(defvar prover-print-lines nil)
		390	#-sbcl
388	(defvar print-lines nil)	391	(defvar print-lines nil)
389		392
390	(defvar substit-dont-simplify nil)	393	(defvar substit-dont-simplify nil)




(defmethod print-object ((obj eval-info) stream)
  (if *debugging-print-object*
      (call-next-method)
      (format stream "~@<#<eval-info ~2I~_~0:Iinternal: ~W~:@_external: ~W>~:>"
	(internal obj) (external obj))))

(defmethod print-object ((obj eval-defn-info) stream)
  (if *debugging-print-object*
      (call-next-method)
      (format stream
	  "~@<#<eval-defn-info ~2I~_~0:Iunary:       ~W~:@_multiary:    ~W~:@_destructive: ~W>~:>"
	(unary obj) (multiary obj) (destructive obj))))

(defmethod print-object ((obj eval-defn) stream)

Lines 29-35 Link Here

(-)pvs4.2-orig/src/groundeval/ground-expr.lisp (-1 / +1 lines)
29	; -- no free variables	29	; -- no free variables
30	;	30	;
31		31
32	(in-package 'pvs)	32	(in-package :pvs)
33		33
34	(defun ground-expr? (expr)	34	(defun ground-expr? (expr)
35	(assert (type expr))	35	(assert (type expr))





(defmethod pvs2clean* ((expr projection-application) bindings livevars)
  (let* ((ll (length (exprs expr)))
	 (dummy (gentemp "DDD"))
	 (match-list (pvs2clean_tuple (matchlist (index expr) ll dummy)))
	 (expr-list (pvs2clean* expr bindings livevars)))
    `(let ,match-list = ,expr-list in ,dummy)))

				      (updateable-free-formal-vars operator)
				      livevars))))
	  (if (clean-updateable? (type operator))
	      (format nil "(pvsSelect ~a ~a ~a)"
		clean-op clean-arg
		(mk-clean-funcall clean-op
				  (list clean-arg))))))))

				     livevars))))))
    (if else-part
	(format nil "~a ~% _ -> ~a"
	  selections-clean
	  (pvs2clean* (expression else-part) bindings livevars))
	selections-clean)))


Lines 47-53 Link Here

(-)pvs4.2-orig/src/groundeval/pvseval-update.lisp (-2 / +2 lines)
47	(if (special-variable-p id)	47	(if (special-variable-p id)
48	(let ((lid (gethash id lisp-id-hash)))	48	(let ((lid (gethash id lisp-id-hash)))
49	(or lid	49	(or lid
50	(let ((new-lid (intern (gensym (string id)))))	50	(let ((new-lid (intern (symbol-name (gensym (string id))))))
51	(setf (gethash id lisp-id-hash) new-lid)	51	(setf (gethash id lisp-id-hash) new-lid)
52	new-lid)))	52	new-lid)))
53	id))	53	id))
Lines 1779-1785 Link Here
1779	:if-exists	1779	:if-exists
1780	(if supersede? :supersede :append)	1780	(if supersede? :supersede :append)
1781	:if-does-not-exist :create)	1781	:if-does-not-exist :create)
1782	(when supersede? (format output "(in-package 'PVS)~%"))	1782	(when supersede? (format output "(in-package :pvs)~%"))
1783	(print-lisp-defns-to-output (get-theory theory) output))	1783	(print-lisp-defns-to-output (get-theory theory) output))
1784	(print-lisp-defns-to-output (get-theory theory) nil)))	1784	(print-lisp-defns-to-output (get-theory theory) nil)))
1785		1785

Lines 42-48 Link Here

(-)pvs4.2-orig/src/groundeval/static-update.lisp (-1 / +1 lines)
42	;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.	42	;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
43	;; --------------------------------------------------------------------	43	;; --------------------------------------------------------------------
44		44
45	(in-package 'pvs)	45	(in-package :pvs)
46		46
47	(defmethod updateable? ((texpr tupletype))	47	(defmethod updateable? ((texpr tupletype))
48	(updateable? (types texpr)))	48	(updateable? (types texpr)))




(defconstant  true 'true  )
(defconstant  false 'false )

(defconstant-if-unbound  primtypealist
    '((true .  bool)
      (false . bool)
      (and . bool)


;;; the following special declarations are rather offensive:

(proclaim '(special const sum u s #-sbcl eq lit var coef product ineqpot  ))


;;; the following (til end-of-file) are taken from prpp:

(defconstant-if-unbound *infixlist*	;temporary list of infixes	
   '(equal nequal lessp greaterp lesseq lesseqp greatereq greatereqp
	   PLUS MINUS TIMES DIVIDE DIFFERENCE) )

(defconstant-if-unbound precedence-alist 					
  '((iff 1)
    (implies 2)
    (or 3)




(defun prerr (&rest args)
  (apply #'error args))

(defconstant-if-unbound *truecons* '(true))

(defconstant-if-unbound *eqarithrels* '(greatereqp lesseqp))

(defconstant *ifops* nil ;;'(if if*)
  )

(defconstant-if-unbound *boolconstants* '(false true))

(defconstant-if-unbound *arithrels* '(lessp lesseqp greaterp greatereqp))

(defconstant-if-unbound *arithops* '(PLUS TIMES DIFFERENCE MINUS))

(defconstant-if-unbound *boolops* '(and or implies not ;;if
				    iff))

(defmacro singleton? (obj)
  `(and (consp ,obj) (null (cdr ,obj))))

Lines 729-735 Link Here

(-)pvs4.2-orig/src/ground-prover/process.lisp (-2 / +2 lines)
729	; (set (setsolve atf))	729	; (set (setsolve atf))
730	(tuple (tupsolve atf))	730	(tuple (tupsolve atf))
731	(array (arraysolve atf))	731	(array (arraysolve atf))
732	(t (error "No solver for type " (prtype (arg1 atf))))	732	(t (error "No solver for type ~a" (prtype (arg1 atf))))
733	)))))	733	)))))
734		734
735	; ------------------------------------------------------------------	735	; ------------------------------------------------------------------
Lines 808-814 Link Here
808	; (set (setnsolve atf))	808	; (set (setnsolve atf))
809	(tuple (tupnsolve atf))	809	(tuple (tupnsolve atf))
810	(array (arraynsolve atf))	810	(array (arraynsolve atf))
811	(t (error "No nsolve for type "	811	(t (error "No nsolve for type ~a"
812	(or (prtype (arg1 atf)) (prtype (arg2 atf))) ))	812	(or (prtype (arg1 atf)) (prtype (arg2 atf))) ))
813	)))))	813	)))))
814		814

Lines 66-76 Link Here

(-)pvs4.2-orig/src/interface/pvs-emacs.lisp (-5 / +11 lines)
66	noninteractive-timeout	66	noninteractive-timeout
67	,(not (and (listp form)	67	,(not (and (listp form)
68	(memq (car form) prover-invoking-commands))))	68	(memq (car form) prover-invoking-commands))))
69	#-(or multiprocessing mp) nil	69	#-(or multiprocessing mp sbcl) nil
70	#+(or multiprocessing mp)	70	#+(or multiprocessing mp)
71	(mp:with-timeout (noninteractive-timeout	71	(mp:with-timeout (noninteractive-timeout
72	(format t "Timed out!"))	72	(format t "Timed out!"))
73	,form)	73	,form)
		74	#+sbcl
		75	(sb-ext:with-timeout noninteractive-timeout
		76	(handler-case ,form
		77	(sb-ext:timeout () (format t "Timed out!"))))
74	,form))	78	,form))
75	(string (error)	79	(string (error)
76	(with-output-to-string (string)	80	(with-output-to-string (string)
Lines 94-100 Link Here
94	;;; This replaces ilisp-restore in pvs-init	98	;;; This replaces ilisp-restore in pvs-init
95	(defun pvs-ilisp-restore ()	99	(defun pvs-ilisp-restore ()
96	"Restore the old result history."	100	"Restore the old result history."
97	(declare (special / // + ++ * **))	101	#-sbcl (declare (special / // + ++ * **))
98	(setq // (pop old-result)	102	(setq // (pop old-result)
99	** (first //)	103	** (first //)
100	/ (pop old-result)	104	/ (pop old-result)
Lines 105-111 Link Here
105	nil)	109	nil)
106		110
107	(defun pvs-ilisp-save ()	111	(defun pvs-ilisp-save ()
108	(declare (special / // /// + ++ +++))	112	#-sbcl (declare (special / // /// + ++ +++))
109	(unless old-result	113	(unless old-result
110	(setq old-result (list /// // +++ ++))))	114	(setq old-result (list /// // +++ ++))))
111		115
Lines 546-552 Link Here
546	(t (cons (char string pos) result))))	550	(t (cons (char string pos) result))))
547	(coerce (nreverse result) 'string)))	551	(coerce (nreverse result) 'string)))
548		552
549	(#+(or cmu sbcl) ext:without-package-locks	553	(#+cmu ext:without-package-locks
		554	#+sbcl sb-ext:without-package-locks
550	#-(or cmu sbcl) progn	555	#-(or cmu sbcl) progn
551	(defun parse-error (obj message &rest args)	556	(defun parse-error (obj message &rest args)
552	;;(assert (or in-checker current-file))	557	;;(assert (or in-checker current-file))
Lines 606-612 Link Here
606	(defvar type-error-argument nil)	611	(defvar type-error-argument nil)
607	(defvar skip-all-conversion-checks nil)	612	(defvar skip-all-conversion-checks nil)
608		613
609	(#+(or cmu sbcl) ext:without-package-locks	614	(#+cmu ext:without-package-locks
		615	#+sbcl sb-ext:without-package-locks
610	#-(or cmu sbcl) progn	616	#-(or cmu sbcl) progn
611	(defun type-error (obj message &rest args)	617	(defun type-error (obj message &rest args)
612	(let ((errmsg (type-error-for-conversion obj message args)))	618	(let ((errmsg (type-error-for-conversion obj message args)))

Lines 51-57 Link Here

(-)pvs4.2-orig/src/linked-hash-table.lisp (-4 / +7 lines)
51	(if (memq test '(eq eql equal equalp))	51	(if (memq test '(eq eql equal equalp))
52	(make-hash-table :test test :size size :rehash-size rehash-size	52	(make-hash-table :test test :size size :rehash-size rehash-size
53	:rehash-threshold rehash-threshold	53	:rehash-threshold rehash-threshold
54	:weak-p weak-keys)	54	#-sbcl :weak-p #+sbcl :weakness weak-keys)
55	(make-pvs-hash-table	55	(make-pvs-hash-table
56	:strong-eq? (eq test 'strong-tc-eq)	56	:strong-eq? (eq test 'strong-tc-eq)
57	:weak-p weak-keys	57	:weak-p weak-keys
Lines 77-82 Link Here
77	:weak-keys (excl:hash-table-weak-keys ht))	77	:weak-keys (excl:hash-table-weak-keys ht))
78	#-allegro	78	#-allegro
79	(let* ((test (hash-table-test ht))	79	(let* ((test (hash-table-test ht))
		80	(weakp #+sbcl (sb-ext:hash-table-weakness ht)
		81	#-sbcl (lisp::hash-table-weak-p ht))
80	(newht	82	(newht
81	(if (memq test '(eq eql equal equalp))	83	(if (memq test '(eq eql equal equalp))
82	(make-hash-table	84	(make-hash-table
Lines 84-96 Link Here
84	:size size	86	:size size
85	:rehash-size rehash-size	87	:rehash-size rehash-size
86	:rehash-threshold rehash-threshold	88	:rehash-threshold rehash-threshold
87	:weak-p (lisp::hash-table-weak-p ht))	89	#-sbcl :weak-p #+sbcl :weakness weakp)
88	(make-pvs-hash-table :strong-eq? (eq test 'strong-tc-eq)	90	(make-pvs-hash-table :strong-eq? (eq test 'strong-tc-eq)
89	:weak-keys? (lisp::hash-table-weak-p ht)	91	:weak-keys? weakp
90	:size size	92	:size size
91	:rehash-size rehash-size	93	:rehash-size rehash-size
92	:rehash-threshold rehash-threshold	94	:rehash-threshold rehash-threshold
93	:table (lisp::hash-table-table ht)))))	95	:table #-sbcl (lisp::hash-table-table ht)
		96	#+sbcl (sb-impl::hash-table-table ht)))))
94	(declare (inline maphash))	97	(declare (inline maphash))
95	(maphash #'(lambda (x y) (setf (gethash x newht) y))	98	(maphash #'(lambda (x y) (setf (gethash x newht) y))
96	ht)	99	ht)

Lines 33-40 Link Here

(-)pvs4.2-orig/src/make-pvs-methods.lisp (-2 / +5 lines)
33	;; This sets pvs-path and sets pvs-binary-type	33	;; This sets pvs-path and sets pvs-binary-type
34	(load "pvs-config.lisp"))	34	(load "pvs-config.lisp"))
35		35
36	(defpackage pvs (:use #+lucid :lucid-common-lisp :lisp	36	(defpackage pvs (:use #+lucid :lucid-common-lisp #-sbcl :lisp #+sbcl :cl
37	#-(or gcl cmu sbcl) :clos #+(or gcl cmu sbcl) :pcl))	37	#-(or gcl cmu sbcl) :clos #+(or gcl cmu) :pcl
		38	#+sbcl :sb-pcl)
		39	#+sbcl (:shadowing-import-from :sb-int memq)
		40	#+sbcl (:export memq))
38		41
39	(in-package :pvs)	42	(in-package :pvs)
40	(import '(cl-user:pvs-path))	43	(import '(cl-user:pvs-path))

Lines 288-294 Link Here

(-)pvs4.2-orig/src/metering.lisp (-3 / +15 lines)
288	;;; to seconds.	288	;;; to seconds.
289		289
290	(progn	290	(progn
291	#-(or cmu allegro)	291	#-(or sbcl cmu allegro)
292	(eval-when (compile eval)	292	(eval-when (compile eval)
293	(warn	293	(warn
294	"You may want to supply implementation-specific get-time functions."))	294	"You may want to supply implementation-specific get-time functions."))
Lines 302-307 Link Here
302	;;; The get-cons macro is called to find the total number of bytes	302	;;; The get-cons macro is called to find the total number of bytes
303	;;; consed since the beginning of time.	303	;;; consed since the beginning of time.
304		304
		305	#+sbcl
		306	(defmacro get-cons ()
		307	"The get-cons macro is called to find the total number of bytes
		308	consed since the beginning of time."
		309	'(sb-ext:get-bytes-consed))
		310
305	#+:cmu	311	#+:cmu
306	(defmacro get-cons ()	312	(defmacro get-cons ()
307	"The get-cons macro is called to find the total number of bytes	313	"The get-cons macro is called to find the total number of bytes
Lines 312-318 Link Here
312	#+:lcl3.0	318	#+:lcl3.0
313	(defmacro get-cons () `(gc-size))	319	(defmacro get-cons () `(gc-size))
314		320
315	#-(or :cmu :lcl3.0)	321	#-(or sbcl :cmu :lcl3.0)
316	(progn	322	(progn
317	(eval-when (compile eval)	323	(eval-when (compile eval)
318	(warn "No consing will be reported unless a get-cons function is ~	324	(warn "No consing will be reported unless a get-cons function is ~
Lines 326-331 Link Here
326	;;; arguments. The function Required-Arguments returns two values: the first	332	;;; arguments. The function Required-Arguments returns two values: the first
327	;;; is the number of required arguments, and the second is T iff there are any	333	;;; is the number of required arguments, and the second is T iff there are any
328	;;; non-required arguments (e.g. &optional, &rest, &key).	334	;;; non-required arguments (e.g. &optional, &rest, &key).
		335	#+sbcl
		336	(defun required-arguments (name)
		337	(multiple-value-bind (min max)
		338	(sb-kernel:fun-type-nargs (sb-kernel:ctype-of (symbol-function name)))
		339	(values (or min 0) (or (null max) (> max min)))))
		340
329	#+cmu	341	#+cmu
330	(progn	342	(progn
331	#-new-compiler	343	#-new-compiler
Lines 387-393 Link Here
387		399
388		400
389		401
390	#-(or :cmu :lcl3.0 (and :allegro (not :coral)))	402	#-(or sbcl :cmu :lcl3.0 (and :allegro (not :coral)))
391	(progn	403	(progn
392	(eval-when (compile eval)	404	(eval-when (compile eval)
393	(warn	405	(warn

Lines 611-617 Link Here

(-)pvs4.2-orig/src/pp-html.lisp (-1 / +2 lines)
611	(when (eq ans :auto)	611	(when (eq ans :auto)
612	(setq force-dirs t)))))	612	(setq force-dirs t)))))
613	#+allegro (excl:make-directory dir)	613	#+allegro (excl:make-directory dir)
614	#+(or cmu sbcl) (unix:unix-mkdir dir #o777)	614	#+cmu (unix:unix-mkdir dir #o777)
		615	#+sbcl (sb-unix:unix-mkdir dir #o777)
615	(pvs-message "Directory ~a created" dir))	616	(pvs-message "Directory ~a created" dir))
616	(t (html-pvs-error "Directory ~a not created" dir))))))	617	(t (html-pvs-error "Directory ~a not created" dir))))))
617		618

Lines 55-61 Link Here

(-)pvs4.2-orig/src/prover/checker-macros.lisp (-6 / +16 lines)
55	(defvar printproofstate nil)	55	(defvar printproofstate nil)
56	(defvar in-checker nil)	56	(defvar in-checker nil)
57	(defvar in-apply nil)	57	(defvar in-apply nil)
58	(defvar please-interrupt nil)	58	(defvar please-interrupt #-sbcl nil #+sbcl t)
59	(defvar assert-bindings nil)	59	(defvar assert-bindings nil)
60	(defvar modsubst nil)	60	(defvar modsubst nil)
61	(defvar proving-tcc nil)	61	(defvar proving-tcc nil)
Lines 143-151 Link Here
143	(defvar module-context)	143	(defvar module-context)
144	;;(defvar current-theory)	144	;;(defvar current-theory)
145	(defvar ps nil)	145	(defvar ps nil)
146	(defvar * '*)	146	(#+sbcl sb-ext:without-package-locks
147	(defvar + '+)	147	#-sbcl progn
148	(defvar - '-)	148	(defvar * '*)
		149	(defvar + '+)
		150	(defvar - '-))
149	(defvar macro-names nil)	151	(defvar macro-names nil)
150	(defvar subst-type-hash ;;used in assert-sformnums	152	(defvar subst-type-hash ;;used in assert-sformnums
151	;;(make-pvs-hash-table)	153	;;(make-pvs-hash-table)
Lines 177-190 Link Here
177	(defmacro with-interrupts-deferred (&body form)	179	(defmacro with-interrupts-deferred (&body form)
178	`(let ((excl::without-interrupts t)) ,@form))	180	`(let ((excl::without-interrupts t)) ,@form))
179		181
180	#+(or cmu sbcl)	182	#+cmu
181	(defmacro with-interrupts-allowed (&body form)	183	(defmacro with-interrupts-allowed (&body form)
182	`(system:with-interrupts ,@form))	184	`(system:with-interrupts ,@form))
183		185
184	#+(or cmu sbcl)	186	#+cmu
185	(defmacro with-interrupts-deferred (&body form)	187	(defmacro with-interrupts-deferred (&body form)
186	`(system:without-interrupts ,@form))	188	`(system:without-interrupts ,@form))
187		189
		190	#+sbcl
		191	(defmacro with-interrupts-allowed (&body form)
		192	`(sb-sys:with-interrupts ,@form))
		193
		194	#+sbcl
		195	(defmacro with-interrupts-deferred (&body form)
		196	`(sb-sys:without-interrupts ,@form))
		197
188		198
189		199
190	;;; KCL does not really have the equivalent to the following - punt for now.	200	;;; KCL does not really have the equivalent to the following - punt for now.




	  (and *noninteractive*
	       *noninteractive-timeout*))
      (let ((timeout (or *proof-timeout* *noninteractive-timeout*)))
	#-sbcl
	(mp:with-timeout (timeout (pvs-message "Interrupted: ~a sec timeout"
				    timeout))
			 (call-next-method))
	#+sbcl
	(sb-ext:with-timeout timeout
	  (handler-case (call-next-method)
	    (sb-ext:timeout ()
	      (pvs-message "Interrupted: ~a sec timeout" timeout)))))
      (call-next-method)))

(defmethod prove-decl ((decl formula-decl) &key strategy context)

			(values 'X nil nil))
		       ((and (or (digit-char-p (char strlbl 0))
				 (char= (char strlbl 0) #\-))
			     (every #'digit-char-p (subseq strlbl 1)))
			(error-format-if
			 "~%Label cannot be an integer"))
		       (t

Lines 334-342 Link Here

(-)pvs4.2-orig/src/prover/rules.lisp (+6 lines)
334	(init-time (get-internal-run-time))	334	(init-time (get-internal-run-time))
335	(result (let ((in-apply ps))	335	(result (let ((in-apply ps))
336	(if timeout	336	(if timeout
		337	#-sbcl
337	(mp:with-timeout (timeout nil)	338	(mp:with-timeout (timeout nil)
338	(prove* newps)	339	(prove* newps)
339	newps)	340	newps)
		341	#+sbcl
		342	(sb-ext:with-timeout timeout
		343	(handler-case
		344	(progn (prove* newps) newps)
		345	(sb-ext:timeout () nil)))
340	(prove* newps))))	346	(prove* newps))))
341	(end-time (/ (- (get-internal-run-time) init-time)	347	(end-time (/ (- (get-internal-run-time) init-time)
342	internal-time-units-per-second)))	348	internal-time-units-per-second)))

Lines 910-915 Link Here

(-)pvs4.2-orig/src/prover/translate-to-yices.lisp (+7 lines)
910	:input "//dev//null"	910	:input "//dev//null"
911	:output out	911	:output out
912	:error-output :output)	912	:error-output :output)
		913	#+sbcl
		914	(sb-ext:run-program
		915	(format nil "~a ~a" yices-call (namestring file))
		916	nil
		917	:input "//dev//null"
		918	:output out
		919	:error out)
913	#+cmu	920	#+cmu
914	(extensions:run-program	921	(extensions:run-program
915	(format nil "~a ~a" yices-call (namestring file))	922	(format nil "~a ~a" yices-call (namestring file))




  (let ((exepath (car (make::split-string
		       (environment-variable "LD_LIBRARY_PATH") :item #\:))))
    (pushnew exepath *pvs-directories*)
    (#+cmu ext:load-foreign #+sbcl sb-alien:load-shared-object
		      (format nil "~a/mu.~a" exepath
			      #+darwin "dylib"
			      #-darwin "so"))
    (#+cmu ext:load-foreign #+sbcl sb-alien:load-shared-object
		      (format nil "~a/ws1s.~a" exepath
			      #+darwin "dylib"
			      #-darwin "so"))
    ;; Have no idea what is going on here, but if you leave this out,
    ;; bdd-cmu gives a compile error.
    #+cmu (fmakunbound 'bdd_cofactor_neg_)
    #+cmu (lf "bdd-cmu") #+sbcl (lf "bdd-sbcl")
    #+cmu (lf "mu-cmu") #+sbcl (lf "mu-sbcl")
    (bdd_init)
    #+cmu (lf "dfa-foreign-cmu") #+sbcl (lf "dfa-foreign-sbcl"))
  (setq *started-with-minus-q*
	(or dont-load-user-lisp
	    (let ((mq (environment-variable "PVSMINUSQ")))

Lines 27-33 Link Here

(-)pvs4.2-orig/src/restore-theories.lisp (-1 / +1 lines)
27	;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.	27	;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
28	;; --------------------------------------------------------------------	28	;; --------------------------------------------------------------------
29		29
30	(in-package 'pvs)	30	(in-package :pvs)
31		31
32	;;; Restores the state of the system from information provided in the	32	;;; Restores the state of the system from information provided in the
33	;;; context. The context has the form	33	;;; context. The context has the form

Lines 301-308 Link Here

(-)pvs4.2-orig/src/store-object.lisp (-2 / +2 lines)
301	(ensure-vector-size store-object-store store-object-store-size size)	301	(ensure-vector-size store-object-store store-object-store-size size)
302	(with-open-file (f file :direction :input	302	(with-open-file (f file :direction :input
303	:element-type '(unsigned-byte 32))	303	:element-type '(unsigned-byte 32))
304	(lisp:read-sequence store-object-store f	304	(cl:read-sequence store-object-store f
305	:start 0 :end size))	305	:start 0 :end size))
306	(when reverse-endian	306	(when reverse-endian
307	(dotimes (i size)	307	(dotimes (i size)
308	(setf (object-store i)	308	(setf (object-store i)

Lines 532-538 Link Here

(-)pvs4.2-orig/src/tex-support.lisp (-1 / +1 lines)
532	(when (and report-mode	532	(when (and report-mode
533	(loop for sf in neg-s-forms	533	(loop for sf in neg-s-forms
534	thereis (memq sf par-sforms)))	534	thereis (memq sf par-sforms)))
535	(format stream "~% & $\\vdots$ \\\\" prover-indent)))	535	(format stream "~%~VT & $\\vdots$ \\\\" prover-indent)))
536	(t (format stream "\\strut\\\\")))	536	(t (format stream "\\strut\\\\")))
537	(format stream "\\hline~%")	537	(format stream "\\hline~%")
538	(cond (pos-s-forms	538	(cond (pos-s-forms




;; --------------------------------------------------------------------
;; PVS
;; Copyright (C) 2008, SRI International.  All Rights Reserved.

;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License
;; as published by the Free Software Foundation; either version 2
;; of the License, or (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software
;; Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA
;; 02110-1301, USA.
;; --------------------------------------------------------------------

(in-package :pvs)
(require :sb-posix)
(export '(file-exists-p directory-p read-permission? write-permission?
			file-write-time get-file-info))

(defun remove-backslashes (string)
  (declare (type string string))
  (sb-impl::remove-backslashes string 0 (length string)))

(defun file-exists-p (file)
  (handler-case
      (zerop
       (sb-posix:access
	(remove-backslashes (namestring (merge-pathnames file)))
	sb-posix:f-ok))
    (sb-posix:syscall-error () nil)))

(defun directory-p (dir)
  (handler-case
      (let ((filestring (namestring (merge-pathnames dir))))
	(when (sb-posix:s-isdir (sb-posix:stat-mode (sb-posix:stat filestring)))
	  ;; Needs to end with a slash!!!
	  (pathname (if (char= (char filestring (1- (length filestring))) #\/)
			filestring
		      (concatenate 'string filestring "/")))))
    (sb-posix:syscall-error () nil)))

(defun read-permission? (file)
  (handler-case (zerop (sb-posix:access file sb-posix:r-ok))
    (sb-posix:syscall-error () nil)))

(defun write-permission? (file)
  (handler-case (zerop (sb-posix:access file sb-posix:w-ok))
    (sb-posix:syscall-error () nil)))

(defconstant u1970 (encode-universal-time 0 0 0 1 1 1970 0))

(defun file-write-time (file)
  (handler-case (+ u1970 (sb-posix:stat-mtime (sb-posix:stat file)))
    (sb-posix:syscall-error () nil)))

(defun get-file-info (file)
  (handler-case
      (let ((stat (sb-posix:stat file)))
	(list (sb-posix:stat-dev stat) (sb-posix:stat-ino stat)))
    (sb-posix:syscall-error () nil)))




;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
;; --------------------------------------------------------------------

(in-package :pvs)

;(declaim (function pvs-sxhash* (T list) (integer 0 65535)))


;(defun tc-eq (x y &optional bindings)
;  (tc-eq* x y bindings))

(defconstant-if-unbound pvs-sxhash-byte (byte #+allegro 24 #-allegro 29 0))

(defconstant pvs-max-hashnum (1- (expt 2 #+allegro 24 #-allegro 29)))


  (declare (ignore bindings))
  (the positive-fixnum (sxhash x)))

(defconstant-if-unbound nil-sxhash (sxhash nil))

(defmethod pvs-sxhash* ((x null) bindings)
  (declare (ignore bindings))




LD = gcc
LDFLAGS = -shared -L./
CC=gcc
CFLAGS=-fPIC
WFLAGS=-Wall
VPATH=..

obj=file_utils.o

.SUFFIXES:
.SUFFIXES: .c .o
.c.o : ; $(CC) $(XCFLAGS) ${WFLAGS} ${CFLAGS} -c $< -o $@

all : file_utils.so b64

file_utils.so: ${obj}
	$(LD) ../utils-ld-table $(LDFLAGS) -o file_utils.so ${obj} -lc

b64: ../b64.c
	$(CC) -o ./b64 ../b64.c

clean :
	rm -f *.o *.a *.so b64




  (let* ((test (hash-table-test ht))
	 (size (hash-table-count ht))
	 (weak? #+allegro (excl:hash-table-weak-keys ht)
		#+cmu     (lisp::hash-table-weak-p ht)
		#+sbcl    (sb-ext:hash-table-weakness ht))
	 (new-ht (if (memq test '(eq eql equal equalp))
		     (make-hash-table
		      :test test :size size
		      #+allegro :weak-keys #+cmu :weak-p #+sbcl :weakness weak?)
		     (make-pvs-hash-table :strong-eq? (eq test 'strong-tc-eq)
					  :size size
					  :weak-keys? weak?))))

       #+(and allegro (version>= 6) (not (version>= 7)))
       (excl::variable-special-p obj nil)
       #+(and allegro (not (version>= 6))) (clos::variable-special-p obj nil)
       #+cmu (eq (extensions:info variable kind obj) :special)
       #+sbcl (sb-walker:var-globally-special-p obj)
       #+harlequin-common-lisp (system:declared-special-p obj)
       #-(or lucid kcl allegro harlequin-common-lisp cmu sbcl)
       (error "Need to handle special variables for this version of lisp")

			 (namestring (working-directory))))
  nil)

#+(or gcl cmu)
(defun working-directory ()
  (pathname (nth-value 1 (unix:unix-current-directory))))

#+(or gcl cmu)
(defun set-working-directory (dir)
  (unix:unix-chdir (namestring dir)))

#+sbcl
(defun working-directory ()
  (make-pathname :directory (sb-posix:getcwd)))

#+sbcl
(defun set-working-directory (dir)
  (sb-posix:chdir dir))

#+allegro
(defun working-directory ()
  (excl:current-directory))

(defun environment-variable (string)
  (sys:getenv string))

#+cmu
(defun environment-variable (string)
  (tools:getenv string))

#+sbcl
(defun environment-variable (string)
  (sb-posix:getenv string))

#+harlequin-common-lisp
(defun environment-variable (string)
  ;; This didn't work before

   :show-cmd nil
   :output-stream (open "/dev/null" :direction :output
			  :if-exists :append)))
#+cmu
(defun chmod (prot file)
  (extensions:run-program
   "chmod"
   (list prot (namestring file))
   :output nil :error nil :wait nil))

#+sbcl
(defun chmod (prot file)
  (sb-ext:run-program
   "chmod"
   (list prot (namestring file))
   :output nil :error nil :wait nil))

#+gcl
(defun chmod (prot file)
  (system (format nil "chmod ~a ~a" prot (namestring file))))


(defun shortpath (directory)
  (or (gethash directory *shortpath-directories*)
      (let* ((realdir (namestring (truename directory)))
	     (dirlist (pathname-directory
		       (directory-p
			#+allegro (excl:pathname-resolve-symbolic-links realdir)
			#+cmu (unix:unix-resolve-links realdir)
			#-(or allegro cmu) realdir)))
	     (file-info (get-file-info directory))
	     (result (if (eq (car dirlist) :absolute)
			 (shortpath* (reverse (cdr dirlist)) file-info)

(defun direct-superclasses (class)
  (slot-value class 'pcl:class-direct-superclasses))

#+cmu
(defun direct-superclasses (class)
  (class-direct-superclasses class))

#+sbcl
(defun direct-superclasses (class)
  (sb-mop:class-direct-superclasses class))

(defun types-of (obj)
  (let ((types nil))
    (labels ((tof (type)

  (when (compiled-function-p #'pvs-gc-after-hook)
    (setf excl:*gc-after-hook* #'pvs-gc-after-hook)))

#+cmu
(eval-when (load)
  (setf extensions:*gc-verbose* nil))


    (every #'(lambda (slot)
	       (let ((name (slot-value slot
				       '#+allegro excl::name
				       #+cmu pcl::name
				       #+sbcl sb-pcl::name)))
		 (equals (slot-value x name) (slot-value y name))))
	   slots)))


  #-(or allegro cmu sbcl)
  (error "Need a hash-table for tc-eq for this lisp"))

#+cmu
(extensions:define-hash-table-test 'tc-eq-test #'tc-eq #'pvs-sxhash)
#+cmu
(extensions:define-hash-table-test 'strong-tc-eq-test
				   #'strong-tc-eq #'pvs-sxhash)
#+sbcl
(sb-int:define-hash-table-test 'tc-eq-test #'tc-eq #'pvs-sxhash)
#+sbcl
(sb-int:define-hash-table-test 'strong-tc-eq-test #'strong-tc-eq #'pvs-sxhash)




ifneq (,)
This makefile requires GNU Make.
endif

BDD = ../mona/BDD
DFA = ../mona/DFA
UTILS = ../mona/Mem
INCLUDES = -I$(BDD) -I$(DFA) -I$(UTILS)
LD = gcc
LDFLAGS = -shared -L./
CC = gcc
CFLAGS += -fPIC -D_POSIX_SOURCE -DSYSV $(INCLUDES)
XCFLAGS = -O
SHELL = /bin/sh
VPATH = ..:../mona/BDD:../mona/DFA:../mona/Mem

obj  = analyze.o prefix.o product.o \
       quotient.o basic.o external.o \
       makebasic.o minimize.o printdfa.o \
       project.o dfa.o \
       bdd.o bdd_double.o bdd_external.o \
       bdd_manager.o hash.o bdd_dump.o \
       bdd_trace.o bdd_cache.o \
       dlmalloc.o mem.o \
       ws1s_extended_interface.o 

.SUFFIXES:
.SUFFIXES: .c .o
.c.o : ; $(CC) $(XCFLAGS) ${CFLAGS} -c $< -o $@

all : ws1s.so

ws1s_extended_interface.o : ../ws1s_extended_interface.c
	$(CC) $(XCFLAGS) ${CFLAGS} -c $< -o $@

ws1s.so : ${obj}
	$(LD) ../ws1s-ld-table $(LDFLAGS) -o ws1s.so ${obj}

bdd.o: bdd.c bdd.h bdd_internal.h
bdd_double.o: bdd_double.c bdd.h bdd_internal.h
bdd_external.o: bdd_external.c bdd_external.h mem.h
bdd_manager.o: bdd_manager.c bdd.h bdd_internal.h
hash.o: hash.c mem.h hash.h
bdd_dump.o: bdd_dump.c bdd_dump.h
bdd_trace.o: bdd_trace.c bdd.h bdd_internal.h
bdd_cache.o: bdd_cache.c bdd.h bdd_internal.h

analyze.o: analyze.c dfa.h mem.h
prefix.o: prefix.c dfa.h mem.h
product.o: product.c dfa.h bdd.h hash.h mem.h
quotient.o: quotient.c dfa.h hash.h mem.h
basic.o: basic.c dfa.h mem.h
external.o: external.c dfa.h bdd_external.h mem.h
makebasic.o: makebasic.c dfa.h bdd_internal.h
minimize.o: minimize.c dfa.h hash.h mem.h
printdfa.o: printdfa.c dfa.h mem.h
project.o: project.c dfa.h hash.h mem.h
dfa.o: dfa.c dfa.h bdd.h hash.h mem.h

dlmalloc.o: dlmalloc.c dlmalloc.h
mem.o: mem.c dlmalloc.h

clean : 
	rm -f *.o *.a *.so




SHELL = /bin/sh
VPATH = ..:../mona/BDD:../mona/DFA:../mona/Mem

obj  = ws1s_table.o ws1s_extended_interface.o
       quotient.o basic.o external.o \
       makebasic.o minimize.o printdfa.o \
       project.o dfa.o \
       bdd.o bdd_double.o bdd_external.o \
       bdd_manager.o hash.o bdd_dump.o \
       bdd_trace.o bdd_cache.o \
       dlmalloc.o mem.o \
       ws1s_extended_interface.o 

.SUFFIXES:
.SUFFIXES: .c .o

	$(CC) $(XCFLAGS) ${CFLAGS} -c $< -o $@

ws1s.so : ${obj}
	$(CC) -shared $(CFLAGS) -o ws1s.so ${obj}

bdd.o: bdd.c bdd.h bdd_internal.h
bdd_double.o: bdd_double.c bdd.h bdd_internal.h




;; --------------------------------------------------------------------
;; PVS
;; Copyright (C) 2006, SRI International.  All Rights Reserved.

;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License
;; as published by the Free Software Foundation; either version 2
;; of the License, or (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software
;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
;; --------------------------------------------------------------------

(in-package :pvs)

;; Structure of a DFA in foreign space
(sb-alien:define-alien-type nil
  (sb-alien:struct mona-dfa
   (bddm (* t))              ; Manager of BDD nodes
   (ns   (integer 32))       ; Number of states
   (q    (* t))              ; Transition array
   (s    (integer 32))       ; Start State
   (f    (* (integer 32))))) ; State Status Array

;; Predefined basic automata

(sb-alien:define-alien-routine ("ws1s___dfaTrue" mona-true)     ; true
  (* (sb-alien:struct mona-dfa)))

(sb-alien:define-alien-routine ("ws1s___dfaFalse" mona-false)   ; false
  (* (sb-alien:struct mona-dfa)))

(sb-alien:define-alien-routine ("ws1s___dfaConst" mona-const)   ; p_i = n
  (* (sb-alien:struct mona-dfa))
  (n (integer 32)) (i (integer 32)))

(sb-alien:define-alien-routine ("ws1s___dfaLess" mona-less)     ; p_i < p_j
  (* (sb-alien:struct mona-dfa))
  (i (integer 32)) (j (integer 32)))

(sb-alien:define-alien-routine ("ws1s___dfaLesseq" mona-lesseq) ; p_i <= p_j
  (* (sb-alien:struct mona-dfa))
  (i (integer 32)) (j (integer 32)))

(sb-alien:define-alien-routine ("ws1s___dfaPlus1" mona-plus1)   ;  p_i = p_j + n
  (* (sb-alien:struct mona-dfa))
  (i (integer 32)) (j (integer 32)) (n (integer 32)))

(sb-alien:define-alien-routine ("ws1s___dfaMinus1" mona-minus1) ;  p_i = p_i - p_j
  (* (sb-alien:struct mona-dfa))
  (i (integer 32)) (j (integer 32)))

(sb-alien:define-alien-routine ("ws1s___dfaEq1" mona-eq1)       ; p_i = p_j
  (* (sb-alien:struct mona-dfa))
  (i (integer 32)) (j (integer 32)))

(sb-alien:define-alien-routine ("ws1s___dfaEq2" mona-eq2)       ; P_i = P_j
  (* (sb-alien:struct mona-dfa))
  (i (integer 32)) (j (integer 32)))

(sb-alien:define-alien-routine ("ws1s___dfaPlus2" mona-plus2)   ; P_i = P_j + 1
  (* (sb-alien:struct mona-dfa))
  (i (integer 32)) (j (integer 32)))

(sb-alien:define-alien-routine ("ws1s___dfaMinus2" mona-minus2) ; P_i = P_j - 1
  (* (sb-alien:struct mona-dfa))
  (i (integer 32)) (j (integer 32)))

(sb-alien:define-alien-routine ("ws1s___dfaPlusModulo1" mona-plusmodulo1) ;  p_i = p_j + 1 % p_k
  (* (sb-alien:struct mona-dfa))
  (i (integer 32)) (j (integer 32)) (k (integer 32)))

(sb-alien:define-alien-routine ("ws1s___dfaMinusModulo1" mona-minusmodulo1) ;  p_i = p_j - 1 % p_k
  (* (sb-alien:struct mona-dfa))
  (i (integer 32)) (j (integer 32)) (k (integer 32)))

(sb-alien:define-alien-routine ("ws1s___dfaEmpty" mona-empty)   ; P_i = empty
  (* (sb-alien:struct mona-dfa))
  (i (integer 32)))

(sb-alien:define-alien-routine ("ws1s___dfaIn" mona-in) ; p_i in P_j  recognizes <X,X>(<0,X>+)<1,1>(<X,X>*)
  (* (sb-alien:struct mona-dfa))
  (i (integer 32)) (j (integer 32)))

(sb-alien:define-alien-routine ("ws1s___dfaSubset" mona-subset) ; P_i sub P_j
  (* (sb-alien:struct mona-dfa))
  (i (integer 32)) (j (integer 32)))

(sb-alien:define-alien-routine ("ws1s___dfaUnion" mona-union)   ; P_i = P_j union P_k
  (* (sb-alien:struct mona-dfa))
  (i (integer 32)) (j (integer 32)) (k (integer 32)))

(sb-alien:define-alien-routine ("ws1s___dfaInter" mona-intersection) ; P_i = P_j inter P_k
  (* (sb-alien:struct mona-dfa))
  (i (integer 32)) (j (integer 32)) (k (integer 32)))

(sb-alien:define-alien-routine ("ws1s___dfaSetminus" mona-difference) ; P_i = P_j \ P_k
  (* (sb-alien:struct mona-dfa))
  (i (integer 32)) (j (integer 32)) (k (integer 32)))

(sb-alien:define-alien-routine ("ws1s___dfaMax" mona-max)       ;  p_i = max(P_j)
  (* (sb-alien:struct mona-dfa))
  (i (integer 32)) (j (integer 32)))

(sb-alien:define-alien-routine ("ws1s___dfaMin" mona-min)       ;  p_i = min(P_j)
  (* (sb-alien:struct mona-dfa))
  (i (integer 32)) (j (integer 32)))

(sb-alien:define-alien-routine ("ws1s___dfaBoolvar" mona-boolvar) ; b_i
  (* (sb-alien:struct mona-dfa))
  (b (integer 32)))

(sb-alien:define-alien-routine ("ws1s___dfaPresbConst" mona-presburger-const) ; P_i = pconst(n)
  (* (sb-alien:struct mona-dfa))
  (i (integer 32)) (n (integer 32)))

(sb-alien:define-alien-routine ("ws1s___dfaSingleton" mona-singleton) ; singleton(P_i)
  (* (sb-alien:struct mona-dfa))
  (i (integer 32)))

(sb-alien:define-alien-routine ("ws1s___dfaFirstOrder" mona-first-order) ; recognizes 0*1+
  (* (sb-alien:struct mona-dfa))
  (i (integer 32)))


;; Automaton operations

(sb-alien:define-alien-routine ("ws1s___dfaFree" mona-free!)
  sb-alien:void
  (a (* (sb-alien:struct mona-dfa))))

(sb-alien:define-alien-routine ("ws1s___dfaNegation" mona-negation!)
  sb-alien:void
  (a (* (sb-alien:struct mona-dfa))))

(sb-alien:define-alien-routine ("ws1s___dfaRestrict" mona-restrict!)
  sb-alien:void
  (a (* (sb-alien:struct mona-dfa))))

(sb-alien:define-alien-routine ("ws1s___dfaUnrestrict" mona-unrestrict!)
  sb-alien:void
  (a (* (sb-alien:struct mona-dfa))))

(sb-alien:define-alien-routine ("ws1s___dfaCopy" mona-copy)
  (* (sb-alien:struct mona-dfa))
  (a (* (sb-alien:struct mona-dfa))))

(sb-alien:define-alien-routine ("ws1s___dfaProduct" mona-product)
  (* (sb-alien:struct mona-dfa))
  (a1 (* (sb-alien:struct mona-dfa)))
  (a2 (* (sb-alien:struct mona-dfa)))
  (mode (integer 32)))

(sb-alien:define-alien-routine ("ws1s___dfaPrefixClose" mona-prefix-close!)
  sb-alien:void
  (a (* (sb-alien:struct mona-dfa))))

(sb-alien:define-alien-routine ("ws1s___dfaConjunction" mona-conjunction)
  (* (sb-alien:struct mona-dfa))
  (a1 (* (sb-alien:struct mona-dfa))) (a2 (* (sb-alien:struct mona-dfa))))

(sb-alien:define-alien-routine ("ws1s___dfaDisjunction" mona-disjunction)
  (* (sb-alien:struct mona-dfa))
  (a1 (* (sb-alien:struct mona-dfa))) (a2 (* (sb-alien:struct mona-dfa))))

(sb-alien:define-alien-routine ("ws1s___dfaImplication" mona-implication)
  (* (sb-alien:struct mona-dfa))
  (a1 (* (sb-alien:struct mona-dfa))) (a2 (* (sb-alien:struct mona-dfa))))

(sb-alien:define-alien-routine ("ws1s___dfaIff" mona-iff)
  (* (sb-alien:struct mona-dfa))
  (a1 (* (sb-alien:struct mona-dfa))) (a2 (* (sb-alien:struct mona-dfa))))

(sb-alien:define-alien-routine ("ws1s___dfaStatus" mona-status)
  (integer 32)
  (a (* (sb-alien:struct mona-dfa))))

(sb-alien:define-alien-routine ("ws1s___dfaProject" mona-project)
				; projects away track var_index from a and
				; determinizes the resulting automaton
  (* (sb-alien:struct mona-dfa))
  (a (* (sb-alien:struct mona-dfa))) (index (sb-alien:unsigned 32)))

(sb-alien:define-alien-routine ("ws1s___dfaRightQuotient" mona-right-quotient!)
  sb-alien:void
  (a (* (sb-alien:struct mona-dfa))) (index (sb-alien:unsigned 32)))

(sb-alien:define-alien-routine ("ws1s___dfaMinimize" mona-minimize) ; Minimization
  (* (sb-alien:struct mona-dfa))
  (a (* (sb-alien:struct mona-dfa))))


;; Analysis and printing

(sb-alien:define-alien-routine ("ws1s___dfaMakeExample" mona-make-example)
  sb-alien:c-string
  (a (* (sb-alien:struct mona-dfa)))
  (kind (integer 32))
  (num (integer 32))
  (indices (array (sb-alien:unsigned 32))))

(sb-alien:define-alien-routine ("ws1s___dfaAnalyze" mona-analyze)
  sb-alien:void
  (a (* (sb-alien:struct mona-dfa)))
  (num (integer 32))
  (names (array sb-alien:c-string))
  (indices (array sb-alien:unsigned))
  (orders (array sb-alien:char))
  (treestyle (integer 32)))

(sb-alien:define-alien-routine ("ws1s___dfaPrintVitals" mona-print-vitals)
  sb-alien:void
  (a (* (sb-alien:struct mona-dfa))))

(sb-alien:define-alien-routine ("ws1s___dfaPrint" mona-print)
  sb-alien:void
  (a (* (sb-alien:struct mona-dfa)))
  (num (integer 32))
  (names (array sb-alien:c-string))
  (indices (array (sb-alien:unsigned 32))))

(sb-alien:define-alien-routine ("ws1s___dfaPrintGraphviz" mona-print-graphviz)
  sb-alien:void
  (a (* (sb-alien:struct mona-dfa)))
  (num (integer 32))
  (indices (array (sb-alien:unsigned 32))))

(sb-alien:define-alien-routine ("ws1s___dfaPrintVerbose" mona-print-verbose)
  sb-alien:void
  (a (* (sb-alien:struct mona-dfa))))

(sb-alien:define-alien-routine ("ws1s___bdd_size" bdd-size)
  (sb-alien:unsigned 32)
  (bbdm (* t)))


;; Constructing Automata Explicitly

(sb-alien:define-alien-routine ("ws1s___dfaSetup" mona-setup)
  sb-alien:void
  (s (integer 32))
  (len (integer 32))
  (indices (array (integer 32))))

(sb-alien:define-alien-routine ("ws1s___dfaAllocExceptions" mona-alloc-exceptions)
  sb-alien:void
  (n (integer 32)))

(sb-alien:define-alien-routine ("ws1s___dfaStoreException" mona-store-exception)
  sb-alien:void
  (s (integer 32)) (path sb-alien:c-string))

(sb-alien:define-alien-routine ("ws1s___dfaStoreState" mona-store-state)
  sb-alien:void
  (s (integer 32)))

(sb-alien:define-alien-routine ("ws1s___dfaBuild" mona-build)
  (* (sb-alien:struct mona-dfa))
  (statuses (array sb-alien:char)))

;; Exporting

(sb-alien:define-alien-routine ("ws1s___dfaExport" mona-export)
  (integer 32)
  (a (* (sb-alien:struct mona-dfa)))
  (filename sb-alien:c-string)
  (num (integer 32))
  (names (array sb-alien:c-string))
  (orders (array sb-alien:char)))

Lines 81-87 Link Here

(-)pvs4.2-orig/src/WS1S/lisp/symtab.lisp (-1 / +1 lines)
81	(let* ((free (symtab-freevars symtab))	81	(let* ((free (symtab-freevars symtab))
82	(size (length free))	82	(size (length free))
83	(offsets (make-array size :element-type 'fixnum))	83	(offsets (make-array size :element-type 'fixnum))
84	(fvars (make-array size :element-type 'string))	84	(fvars (make-array size :element-type 'string :initial-element ""))
85	(types (make-string size))	85	(types (make-string size))
86	(i 0))	86	(i 0))
87	(mapc #'(lambda (bndng)	87	(mapc #'(lambda (bndng)

Lines 193-199 Link Here

(-)pvs4.2-orig/src/WS1S/lisp/ws1s-strategy.lisp (-1 / +1 lines)
193	(loop* 0 (emptyset-operator))))	193	(loop* 0 (emptyset-operator))))
194		194
195	(defun ws1s-automaton-output (p num fvars offsets)	195	(defun ws1s-automaton-output (p num fvars offsets)
196	(format t "~2%Free vars:~2%" fvars)	196	(format t "~2%Free vars:~{ ~s~}~2%" fvars)
197	(dfa-print p num fvars offsets)	197	(dfa-print p num fvars offsets)
198	(format t "~%"))	198	(format t "~%"))
199		199

Return to bug 257679

Lines 1043-1049 Link Here

(-)pvs4.2-orig/emacs/emacs-src/pvs-prover.el (-8 / +8 lines)
1043	(if (> indent 0)	1043	(if (> indent 0)
1044	(while (and (>= (point) start)	1044	(while (and (>= (point) start)
1045	(progn (beginning-of-line)	1045	(progn (beginning-of-line)
1046	(insert-string indstr)	1046	(insert indstr)
1047	(= (forward-line -1) 0))))))	1047	(= (forward-line -1) 0))))))
1048	(when crs (insert "\n\n"))))	1048	(when crs (insert "\n\n"))))
1049		1049
Lines 1084-1090 Link Here
1084	(pvs-bury-output)	1084	(pvs-bury-output)
1085	(let ((file (current-pvs-file)))	1085	(let ((file (current-pvs-file)))
1086	(when (buffer-modified-p (get-file-buffer file))	1086	(when (buffer-modified-p (get-file-buffer file))
1087	(error "~a is not parsed" file))	1087	(error "%s is not parsed" file))
1088	(when (pvs-send-and-wait (format "(lisp (modify-declaration-at \"%s\" %d))"	1088	(when (pvs-send-and-wait (format "(lisp (modify-declaration-at \"%s\" %d))"
1089	file (current-line-number))	1089	file (current-line-number))
1090	nil nil 'bool)	1090	nil nil 'bool)
Lines 1192-1198 Link Here
1192	nil)	1192	nil)
1193	((and (stringp depth)	1193	((and (stringp depth)
1194	(string-match "^[ \t][0-9]+[ \t]$" depth))	1194	(string-match "^[ \t][0-9]+[ \t]$" depth))
1195	(string-to-int depth))	1195	(string-to-number depth))
1196	(t (error "set-rewrite-depth: %s is not a number or nil"	1196	(t (error "set-rewrite-depth: %s is not a number or nil"
1197	depth)))))	1197	depth)))))
1198	(pvs-send (format "(setq rewrite-print-depth %s)" dep))))	1198	(pvs-send (format "(setq rewrite-print-depth %s)" dep))))
Lines 1221-1227 Link Here
1221	nil)	1221	nil)
1222	((and (stringp length)	1222	((and (stringp length)
1223	(string-match "^[ \t][0-9]+[ \t]$" length))	1223	(string-match "^[ \t][0-9]+[ \t]$" length))
1224	(string-to-int length))	1224	(string-to-number length))
1225	(t (error "set-rewrite-length: %s is not an integer or nil"	1225	(t (error "set-rewrite-length: %s is not an integer or nil"
1226	length)))))	1226	length)))))
1227	(pvs-send (format "(setq rewrite-print-length %s)" len))))	1227	(pvs-send (format "(setq rewrite-print-length %s)" len))))
Lines 1242-1248 Link Here
1242	nil)	1242	nil)
1243	((and (stringp depth)	1243	((and (stringp depth)
1244	(string-match "^[ \t][0-9]+[ \t]$" depth))	1244	(string-match "^[ \t][0-9]+[ \t]$" depth))
1245	(string-to-int depth))	1245	(string-to-number depth))
1246	(t (error "set-print-depth: %s is not an integer" depth)))))	1246	(t (error "set-print-depth: %s is not an integer" depth)))))
1247	(pvs-send (format "(setq prover-print-depth %s)"	1247	(pvs-send (format "(setq prover-print-depth %s)"
1248	(when (plusp dep) dep)))))	1248	(when (plusp dep) dep)))))
Lines 1264-1270 Link Here
1264	nil)	1264	nil)
1265	((and (stringp length)	1265	((and (stringp length)
1266	(string-match "^[ \t][0-9]+[ \t]$" length))	1266	(string-match "^[ \t][0-9]+[ \t]$" length))
1267	(string-to-int length))	1267	(string-to-number length))
1268	(t (error "set-print-length: %s is not an integer"	1268	(t (error "set-print-length: %s is not an integer"
1269	length)))))	1269	length)))))
1270	(pvs-send (format "(setq prover-print-length %s)"	1270	(pvs-send (format "(setq prover-print-length %s)"
Lines 1285-1291 Link Here
1285	nil)	1285	nil)
1286	((and (stringp lines)	1286	((and (stringp lines)
1287	(string-match "^[ \t][0-9]+[ \t]$" lines))	1287	(string-match "^[ \t][0-9]+[ \t]$" lines))
1288	(string-to-int lines))	1288	(string-to-number lines))
1289	(t (error "set-print-lines: %s is not an integer" lines)))))	1289	(t (error "set-print-lines: %s is not an integer" lines)))))
1290	(pvs-send (format "(setq prover-print-lines %s)"	1290	(pvs-send (format "(setq prover-print-lines %s)"
1291	(when (plusp dep) dep)))))	1291	(when (plusp dep) dep)))))
Lines 2153-2159 Link Here
2153	1)	2153	1)
2154	((and (stringp num)	2154	((and (stringp num)
2155	(string-match "^[ \t][0-9]+[ \t]$" num))	2155	(string-match "^[ \t][0-9]+[ \t]$" num))
2156	(string-to-int num))	2156	(string-to-number num))
2157	(t (error "set-proof-backup-number: %s is not an integer"	2157	(t (error "set-proof-backup-number: %s is not an integer"
2158	num)))))	2158	num)))))
2159	(pvs-send (format "(setq number-of-proof-backups %s)" n))))	2159	(pvs-send (format "(setq number-of-proof-backups %s)" n))))

Lines 19-24 Link Here

(-)pvs4.2-orig/BDD/bdd.lisp (-2 / +3 lines)
19		19
20	(in-package :pvs)	20	(in-package :pvs)
21		21
		22	(defmacro null-list? (list) `(= (null_list_p ,list) 1))
22	(defmacro bdd-void? (bdd) `(= (bdd_void_p ,bdd) 1))	23	(defmacro bdd-void? (bdd) `(= (bdd_void_p ,bdd) 1))
23	(defmacro bdd-1? (bdd) `(= (bdd_1_p ,bdd) 1))	24	(defmacro bdd-1? (bdd) `(= (bdd_1_p ,bdd) 1))
24	(defmacro bdd-0? (bdd) `(= (bdd_0_p ,bdd) 1))	25	(defmacro bdd-0? (bdd) `(= (bdd_0_p ,bdd) 1))
Lines 369-380 Link Here
369	(pushnew (cons op name) (cdr entry) :test #'eql :key #'cdr))))))	370	(pushnew (cons op name) (cdr entry) :test #'eql :key #'cdr))))))
370		371
371	(defun translate-from-bdd-list (bddlist)	372	(defun translate-from-bdd-list (bddlist)
372	(let ((bdds (unless (zerop bddlist)	373	(let ((bdds (unless (null-list? bddlist)
373	(translate-from-bdd-list* (list_first bddlist)))))	374	(translate-from-bdd-list* (list_first bddlist)))))
374	(mapcar #'translate-bdd-cube bdds)))	375	(mapcar #'translate-bdd-cube bdds)))
375		376
376	(defun translate-from-bdd-list* (bddlist &optional result)	377	(defun translate-from-bdd-list* (bddlist &optional result)
377	(if (zerop bddlist)	378	(if (null-list? bddlist)
378	(nreverse result)	379	(nreverse result)
379	(translate-from-bdd-list*	380	(translate-from-bdd-list*
380	(list_next bddlist)	381	(list_next bddlist)

Line 0 Link Here

(-)pvs4.2-orig/BDD/bdd-sbcl.lisp (+550 lines)
		1	;; --------------------------------------------------------------------
		2	;; PVS
		3	;; Copyright (C) 2006, SRI International. All Rights Reserved.
		4
		5	;; This program is free software; you can redistribute it and/or
		6	;; modify it under the terms of the GNU General Public License
		7	;; as published by the Free Software Foundation; either version 2
		8	;; of the License, or (at your option) any later version.
		9
		10	;; This program is distributed in the hope that it will be useful,
		11	;; but WITHOUT ANY WARRANTY; without even the implied warranty of
		12	;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
		13	;; GNU General Public License for more details.
		14
		15	;; You should have received a copy of the GNU General Public License
		16	;; along with this program; if not, write to the Free Software
		17	;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
		18	;; --------------------------------------------------------------------
		19
		20	(in-package :pvs)
		21
		22	;; SO - We load this from pvs-init (in src/pvs.lisp), as it requires mu.so,
		23	;; but if mu.so is loaded at save-lisp time, it doesn't work (at least I
		24	;; can't get it to).
		25
		26	;;; List accessors
		27	;;; Lists in the BDD package involve two structures.
		28
		29	;;; A LIST is a structure with slots for a first element pointer, a last
		30	;;; element pointer, the size, and user-defined info.
		31
		32	;;; A LIST_ELEM is a structure with slots for the contents and the next
		33	;;; element.
		34
		35	;;; #define NULL_LIST ((LIST) 0)
		36
		37	;;; void *elem_contents (LIST_ELEM_PTR x)
		38	(sb-alien:define-alien-routine ("bdd___elem_contents" elem_contents)
		39	(* t)
		40	(x (* t)))
		41
		42	;;; LIST_ELEM_PTR list_first (LIST x)
		43	(sb-alien:define-alien-routine ("bdd___list_first" list_first)
		44	(* t)
		45	(x (* t)))
		46
		47	;;; LIST_ELEM_PTR list_last (LIST x)
		48	(sb-alien:define-alien-routine ("bdd___list_last" list_last)
		49	(* t)
		50	(x (* t)))
		51
		52	;;; int list_info (LIST x)
		53	(sb-alien:define-alien-routine ("bdd___list_info" list_info)
		54	(integer 32)
		55	(x (* t)))
		56
		57	;;; LIST_ELEM_PTR list_next (LIST_ELEM_PTR x)
		58	(sb-alien:define-alien-routine ("bdd___list_next" list_next)
		59	(* t)
		60	(x (* t)))
		61
		62	;;; This pretty much follows the bdd.doc sections.
		63
		64	;;; User settable program parameters
65	;;; --------------------------------
66	;;; int bdd_do_gc; /* default 1 */
67
68	(sb-alien:define-alien-variable "bdd_do_gc" (integer 32))
69
70	;;; set_bdd_do_gc (int flag)
71	(declaim (inline set_bdd_do_gc))
72	(defun set_bdd_do_gc (flag)
73	(setf bdd-do-gc flag))
74
75	;;; int bdd_do_dynamic_ordering;/* default 1 */
76	(sb-alien:define-alien-variable "bdd_do_dynamic_ordering" (integer 32))
77
78	;;; set_bdd_do_dynamic_ordering (int flag)
79	(declaim (inline set_bdd_do_dynamic_ordering))
80	(defun set_bdd_do_dynamic_ordering (flag)
81	(setf bdd-do-dynamic-ordering flag))
82
83	;;; int bdd_verbose; /* default 0 */
84	(sb-alien:define-alien-variable "bdd_verbose" (integer 32))
85
86	;;; set_bdd_verbose (int flag)
87	(declaim (inline set_bdd_verbose))
88	(defun set_bdd_verbose (flag)
89	(setf bdd-verbose flag))
90
91	;;; int bdd_use_neg_edges; /* default 1*/
92	(sb-alien:define-alien-variable "bdd_use_neg_edges" (integer 32))
93
94	;;; set_bdd_use_neg_edges (int flag)
95	(declaim (inline set_bdd_use_neg_edges))
96	(defun set_bdd_use_neg_edges (flag)
97	(setf bdd-use-neg-edges flag))
98
99	;;; int bdd_use_inv_edges; /* default 1; 0 when bdd_do_dynamic_ordering = 1 */
100	(sb-alien:define-alien-variable "bdd_use_inv_edges" (integer 32))
101
102	;;; set_bdd_use_inv_edges (int flag)
103	(declaim (inline set_bdd_use_inv_edges))
104	(defun set_bdd_use_inv_edges (flag)
105	(setf bdd-use-inv-edges flag))
106
107	;;; int bdd_sizeof_user_data; /* default 0 */
108	;;; int BDD_COMPUTED_TABLE_SIZE;/* default DEFAULT_BDD_COMPUTED_TABLE_SIZE */
109	;;; int BDD_HASHTAB_SIZE; /* default DEFAULT_BDD_HASHTAB_SIZE */
110	;;; int BDD_NR_RANKS; /* default DEFAULT_BDD_NR_RANKS */
111	;;; int BDD_LOAD_FACTOR; /* default DEFAULT_BDD_LOAD_FACTOR */
112
113
114	;;; C preprocessor macros:
115	;;; ----------------------
116
117	;;; Access to fields of BDD struct:
118
119	;;; BDD_VARID (F)
120	;;; bdd_varid (BDDPTR f)
121	(sb-alien:define-alien-routine ("bdd___bdd_varid" bdd_varid)
122	(sb-alien:unsigned 32)
123	(f (* t)))
124
125	;;; BDD_THEN (F)
126	;;; BDD_ELSE (F)
127	;;; BDD_REFCOUNT (F)
128	;;; BDD_FLAG (F)
129	;;; BDD_MARK (F)
130
131
132	;;; Test on terminal nodes:
133	;;; -----------------------
134
135	;;; BDD_VOID_P (f)
136	;;; int bdd_void_p (BDDPTR f)
137	(sb-alien:define-alien-routine ("bdd___bdd_void_p" bdd_void_p)
138	(integer 32)
139	(f (* t)))
140
141	;;; BDD_1_P (f)
142	;;; bdd_1_p (BDDPTR f)
143	(sb-alien:define-alien-routine ("bdd___bdd_1_p" bdd_1_p)
144	(integer 32)
145	(f (* t)))
146
147	;;; BDD_0_P (f)
148	;;; bdd_0_p (BDDPTR f)
149	(sb-alien:define-alien-routine ("bdd___bdd_0_p" bdd_0_p)
150	(integer 32)
151	(f (* t)))
152
153	;;; BDD_X_P (f)
154	;;; bdd_x_p (BDDPTR f)
155	(sb-alien:define-alien-routine ("bdd___bdd_x_p" bdd_x_p)
156	(integer 32)
157	(f (* t)))
158
159	;;; BDD_CONST_P (f)
160	;;; int bdd_const_p (BDDPTR f)
161	(sb-alien:define-alien-routine ("bdd___bdd_const_p" bdd_const_p)
162	(integer 32)
163	(f (* t)))
164
165	;;; BDD_TERM_P (f)
166	;;; bdd_term_p (BDDPTR f)
167	(sb-alien:define-alien-routine ("bdd___bdd_term_p" bdd_term_p)
168	(integer 32)
169	(f (* t)))
170
171	;;; BDD_LIT_P (f)
172	;;; bdd_lit_p (BDDPTR f)
173	(sb-alien:define-alien-routine ("bdd___bdd_lit_p" bdd_lit_p)
174	(integer 32)
175	(f (* t)))
176
177	;;; BDD_POSLIT_P (f)
178	;;; int bdd_poslit_p (BDDPTR f)
179	(sb-alien:define-alien-routine ("bdd___bdd_poslit_p" bdd_poslit_p)
180	(integer 32)
181	(f (* t)))
182
183	;;; BDD_NEGLIT_P (f)
184	;;; int bdd_neglit_p (BDDPTR f)
185	(sb-alien:define-alien-routine ("bdd___bdd_neglit_p" bdd_neglit_p)
186	(integer 32)
187	(f (* t)))
188
189	;;; BDD_COFACTOR_POS (f)
190	;;; BDDPTR bdd_cofactor_pos_ (BDDPTR f)
191	(sb-alien:define-alien-routine ("bdd___bdd_cofactor_pos_" bdd_cofactor_pos_)
192	(* t)
193	(f (* t)))
194
195	;;; BDD_COFACTOR_NEG (f)
196	;;; BDDPTR bdd_cofactor_neg_ (BDDPTR f)
197	(sb-alien:define-alien-routine ("bdd___bdd_cofactor_neg_" bdd_cofactor_neg_)
198	(* t)
199	(f (* t)))
200
201	;;; void bdd_reset_marks (BDDPTR f)
202	;;; void bdd_traverse_pre (register BDDPTR v, void (*pre_action)(BDDPTR))
203	;;; void bdd_traverse_post (register BDDPTR v, void (*post_action)(BDDPTR))
204
205	;;; int bdd_size (BDDPTR f)
206	(sb-alien:define-alien-routine ("bdd___bdd_size" bdd_size)
207	(integer 32)
208	(f (* t)))
209
210	;;; int bdd_size_vec (BDDPTR *f_vec, int size)
211	;;; int bdd_size_ceil (BDDPTR f, int ceiling)
212
213	;;; void bdd_init (void)
214	(sb-alien:define-alien-routine ("bdd___bdd_init" bdd_init)
215	sb-alien:void)
216
217	;;; void bdd_free (BDDPTR f)
218	(sb-alien:define-alien-routine ("bdd___bdd_free" bdd_free)
219	sb-alien:void
220	(f (* t)))
221
222	;;; int bdd_gc (void)
223	(sb-alien:define-alien-routine ("bdd___bdd_gc" bdd_gc)
224	(integer 32))
225
226	;;; BDDPTR bdd_ite (BDDPTR F, BDDPTR G, BDDPTR H)
227	(sb-alien:define-alien-routine ("bdd___bdd_ite" bdd_ite)
228	(* t)
229	(f (* t))
230	(g (* t))
231	(h (* t)))
232
233	;;; BDDPTR bdd_ite_const (BDDPTR F, BDDPTR G, BDDPTR H)
234	(sb-alien:define-alien-routine ("bdd___bdd_ite_const" bdd_ite_const)
235	(* t)
236	(f (* t))
237	(g (* t))
238	(h (* t)))
239
240	;;; void bdd_cofactors (BDDPTR f, BDDPTR vp, BDDPTR Tp, BDDPTR *Ep)
241	;;; BDDPTR bdd_invert_input_top (BDDPTR f)
242	(sb-alien:define-alien-routine
243	("bdd___bdd_invert_input_top" bdd_invert_input_top)
244	(* t)
245	(f (* t)))
246
247	;;; BDDPTR bdd_create_var (int v)
248	(sb-alien:define-alien-routine ("bdd___bdd_create_var" bdd_create_var)
249	(* t)
250	(v (integer 32)))
251
252	;;; BDDPTR bdd_create_var_first (void)
253	(sb-alien:define-alien-routine
254	("bdd___bdd_create_var_first" bdd_create_var_first)
255	(* t))
256
257	;;; BDDPTR bdd_create_var_before (BDDPTR v)
258	(sb-alien:define-alien-routine
259	("bdd___bdd_create_var_before" bdd_create_var_before)
260	(* t)
261	(v (* t)))
262
263	;;; BDDPTR bdd_create_var_after (BDDPTR v)
264	(sb-alien:define-alien-routine
265	("bdd___bdd_create_var_after" bdd_create_var_after)
266	(* t)
267	(v (* t)))
268
269	;;; BDDPTR bdd_create_var_last (void)
270	(sb-alien:define-alien-routine
271	("bdd___bdd_create_var_last" bdd_create_var_last)
272	(* t))
273
274	;;; void bdd_print (FILE fp, BDDPTR f, char s)
275	(sb-alien:define-alien-routine ("bdd___bdd_print" bdd_print)
276	sb-alien:void
277	(fp (* t))
278	(f (* t))
279	(s sb-alien:c-string))
280
281	;;; void bdd_print_stats (FILE *fp)
282	;;; void bdd_quit (void)
283	(sb-alien:define-alien-routine ("bdd___bdd_quit" bdd_quit)
284	sb-alien:void)
285
286	;;; int bdd_memsize (void)
287	;;; int bdd_memsize_limit (void)
288	;;; void bdd_set_memsize_limit_and_handler (int limit, void (*handler) (void))
289	;;; int bdd_nodes_alive (void)
290	(sb-alien:define-alien-routine ("bdd___bdd_nodes_alive" bdd_nodes_alive)
291	(integer 32))
292
293	;;; int bdd_nodes_allocated (void)
294	(sb-alien:define-alien-routine
295	("bdd___bdd_nodes_allocated" bdd_nodes_allocated)
296	(integer 32))
297
298	;;; int bdd_nr_occurs_var (int id)
299	;;; int bdd_compl_p (BDDPTR f, BDDPTR g)
300	;;; int bdd_equal_p (BDDPTR F, BDDPTR G)
301	(sb-alien:define-alien-routine ("bdd___bdd_equal_p" bdd_equal_p)
302	(integer 32)
303	(f (* t))
304	(g (* t)))
305
306	;;; int bdd_implies_taut (BDDPTR F, BDDPTR G)
307	;;; BDDPTR bdd_not (BDDPTR F)
308	(sb-alien:define-alien-routine ("bdd___bdd_not" bdd_not)
309	(* t)
310	(f (* t)))
311
312	;;; BDDPTR bdd_and (BDDPTR F, BDDPTR G)
313	(sb-alien:define-alien-routine ("bdd___bdd_and" bdd_and)
314	(* t)
315	(f (* t))
316	(g (* t)))
317
318	;;; BDDPTR bdd_greater (BDDPTR F, BDDPTR G)
319	(sb-alien:define-alien-routine ("bdd___bdd_greater" bdd_greater)
320	(* t)
321	(f (* t))
322	(g (* t)))
323
324	;;; BDDPTR bdd_less (BDDPTR F, BDDPTR G)
325	(sb-alien:define-alien-routine ("bdd___bdd_less" bdd_less)
326	(* t)
327	(f (* t))
328	(g (* t)))
329
330	;;; BDDPTR bdd_xor (BDDPTR F, BDDPTR G)
331	(sb-alien:define-alien-routine ("bdd___bdd_xor" bdd_xor)
332	(* t)
333	(f (* t))
334	(g (* t)))
335
336	;;; BDDPTR bdd_or (BDDPTR F, BDDPTR G)
337	(sb-alien:define-alien-routine ("bdd___bdd_or" bdd_or)
338	(* t)
339	(f (* t))
340	(g (* t)))
341
342	;;; BDDPTR bdd_nor (BDDPTR F, BDDPTR G)
343	(sb-alien:define-alien-routine ("bdd___bdd_nor" bdd_nor)
344	(* t)
345	(f (* t))
346	(g (* t)))
347
348	;;; BDDPTR bdd_equiv (BDDPTR F, BDDPTR G)
349	(sb-alien:define-alien-routine ("bdd___bdd_equiv" bdd_equiv)
350	(* t)
351	(f (* t))
352	(g (* t)))
353
354	;;; BDDPTR bdd_xnor (BDDPTR F, BDDPTR G) /* equivalent to bdd_equiv */
355	(sb-alien:define-alien-routine ("bdd___bdd_xnor" bdd_xnor)
356	(* t)
357	(f (* t))
358	(g (* t)))
359
360	;;; BDDPTR bdd_implied (BDDPTR F, BDDPTR G)
361	(sb-alien:define-alien-routine ("bdd___bdd_implied" bdd_implied)
362	(* t)
363	(f (* t))
364	(g (* t)))
365
366	;;; BDDPTR bdd_implies (BDDPTR F, BDDPTR G)
367	(sb-alien:define-alien-routine ("bdd___bdd_implies" bdd_implies)
368	(* t)
369	(f (* t))
370	(g (* t)))
371
372	;;; BDDPTR bdd_nand (BDDPTR F, BDDPTR G)
373	(sb-alien:define-alien-routine ("bdd___bdd_nand" bdd_nand)
374	(* t)
375	(f (* t))
376	(g (* t)))
377
378	;;; BDDPTR bdd_0 (void)
379	(sb-alien:define-alien-routine ("bdd___bdd_0" bdd_0)
380	(* t))
381
382	;;; BDDPTR bdd_1 (void)
383	(sb-alien:define-alien-routine ("bdd___bdd_1" bdd_1)
384	(* t))
385
386	;;; BDDPTR bdd_X (void)
387	(sb-alien:define-alien-routine ("bdd___bdd_X" bdd_X)
388	(* t))
389
390	;;; BDDPTR bdd_assign (BDDPTR f)
391	(sb-alien:define-alien-routine ("bdd___bdd_assign" bdd_assign)
392	(* t)
393	(f (* t)))
394
395	;;; BDDPTR bdd_top_var (BDDPTR f)
396	;;; int bdd_top_var_rank (BDDPTR f)
397	;;; BDDPTR bdd_then (BDDPTR f)
398	(sb-alien:define-alien-routine ("bdd___bdd_then" bdd_then)
399	(* t)
400	(f (* t)))
401
402	;;; BDDPTR bdd_else (BDDPTR f)
403	(sb-alien:define-alien-routine ("bdd___bdd_else" bdd_else)
404	(* t)
405	(f (* t)))
406
407	;;; BDDPTR bdd_apply (BDDPTR (*f)(BDDPTR,BDDPTR),BDDPTR a,BDDPTR b)
408	(sb-alien:define-alien-routine ("bdd___bdd_apply" bdd_apply)
409	(* t)
410	(f (* t))
411	(a (* t))
412	(b (* t)))
413
414	;;; BDDPTR bdd_constrain (BDDPTR f, BDDPTR c)
415	(sb-alien:define-alien-routine ("bdd___bdd_constrain" bdd_constrain)
416	(* t)
417	(f (* t))
418	(c (* t)))
419
420	;;; BDDPTR bdd_top_var (BDDPTR f)
421	(sb-alien:define-alien-routine ("bdd___bdd_top_var" bdd_top_var)
422	(* t)
423	(f (* t)))
424
425	;;; BDD_LIST bdd_sum_of_cubes (BDDPTR f, int irredundant)
426	(sb-alien:define-alien-routine ("bdd___bdd_sum_of_cubes" bdd_sum_of_cubes)
427	(* t)
428	(f (* t))
429	(irredundant (integer 32)))
430
431	(sb-alien:define-alien-variable ("bdd_interrupted" bdd_interrupted) (integer 32))
432
433	;;; The following were obtained by looking through mu.c and collecting
434	;;; functions not mentioned above.
435
436	;;; int bdd_reorder_var (int var_id, int target_var_id)
437	(sb-alien:define-alien-routine ("bdd___bdd_reorder_var" bdd_reorder_var)
438	(integer 32)
439	(var_id (integer 32))
440	(target_var (integer 32)))
441
442	;;; BDDPTR bdd_and_smooth (BDDPTR f, BDDPTR g, BDD_LIST vars)
443	(sb-alien:define-alien-routine ("bdd___bdd_and_smooth" bdd_and_smooth)
444	(* t)
445	(f (* t))
446	(g (* t))
447	(vars (* t)))
448
449	;;; BDD_LIST bdd_rank_order_vars (BDD_LIST vars)
450	(sb-alien:define-alien-routine
451	("bdd___bdd_rank_order_vars" bdd_rank_order_vars)
452	(* t)
453	(vars (* t)))
454
455	;;; BDDPTR bdd_quantify (int existential, BDDPTR f, BDD_LIST vars)
456	(sb-alien:define-alien-routine ("bdd___bdd_quantify" bdd_quantify)
457	(* t)
458	(existential (integer 32))
459	(f (* t))
460	(vars (* t)))
461
462	;;; BDDPTR bdd_subst_par (BDDPTR *f_vec, BDD_LIST vars, BDDPTR g)
463	(sb-alien:define-alien-routine ("bdd___bdd_subst_par" bdd_subst_par)
464	(* t)
465	(f_vec (array (* t)))
466	(vars (* t))
467	(g (* t)))
468
469	;;; BDDPTR bdd_subst_par_list (BDD_LIST f_list, BDD_LIST vars, BDDPTR g)
470	(sb-alien:define-alien-routine ("bdd___bdd_subst_par_list" bdd_subst_par_list)
471	(* t)
472	(f_list (* t))
473	(vars (* t))
474	(g (* t)))
475
476	;;; void bdd_free_vec (BDDPTR *f_vec, int size)
477	(sb-alien:define-alien-routine ("bdd___bdd_free_vec" bdd_free_vec)
478	sb-alien:void
479	(f_vec (array (* t)))
480	(size (integer 32)))
481
482	;;; const char *bdd_get_output_string (int idx)
483	(sb-alien:define-alien-routine
484	("bdd___bdd_get_output_string" bdd_get_output_string)
485	sb-alien:c-string
486	(idx (integer 32)))
487
488	;;; void bdd_set_output_string (int idx, const char *str)
489	(sb-alien:define-alien-routine
490	("bdd___bdd_set_output_string" bdd_set_output_string)
491	sb-alien:void
492	(idx (integer 32))
493	(str sb-alien:c-string))
494
495	;;; void bdd_print_as_sum_of_cubes (FILE *fp, BDDPTR f, int irredundant)
496	(sb-alien:define-alien-routine
497	("bdd___bdd_print_as_sum_of_cubes" bdd_print_as_sum_of_cubes)
498	sb-alien:void
499	(fp (* t))
500	(f (* t))
501	(irredundant (integer 32)))
502
503	;;; BDDPTR bdd_diff (BDDPTR f, BDD_LIST vars)
504	(sb-alien:define-alien-routine ("bdd___bdd_diff" bdd_diff)
505	(* t)
506	(f (* t))
507	(vars (* t)))
508
509	;;; BDDPTR bdd_one_of_vec (BDDPTR *vec, int size)
510	(sb-alien:define-alien-routine ("bdd___bdd_one_of_vec" bdd_one_of_vec)
511	(* t)
512	(vec (array (* t)))
513	(size (integer 32)))
514
515	;;; BDDPTR bdd_none_of_vec (BDDPTR *args, int size)
516	(sb-alien:define-alien-routine ("bdd___bdd_none_of_vec" bdd_none_of_vec)
517	(* t)
518	(args (array (* t)))
519	(size (integer 32)))
520
521	;;; BDDPTR bdd_subst (BDDPTR f, int var, BDDPTR g)
522	(sb-alien:define-alien-routine ("bdd___bdd_subst" bdd_subst)
523	(* t)
524	(f (* t))
525	(var (integer 32))
526	(g (* t)))
527
528	;;; BDD_LIST bdd_sum_of_cubes_as_list (BDDPTR f)
529	(sb-alien:define-alien-routine
530	("bdd___bdd_sum_of_cubes_as_list" bdd_sum_of_cubes_as_list)
531	(* t)
532	(f (* t)))
533
534	;;; int bdd_traverse_cube (BDDPTR cube,
535	;;; void (*action) (int index, int neg, int first))
536	(sb-alien:define-alien-routine ("bdd___bdd_traverse_cube" bdd_traverse_cube)
537	(integer 32)
538	(cube (* t))
539	(action (* t)))
540
541	;;; BDD_LIST bdd_support_as_list_of_vars (BDDPTR f)
542	(sb-alien:define-alien-routine
543	("bdd___bdd_support_as_list_of_vars" bdd_support_as_list_of_vars)
544	(* t)
545	(f (* t)))
546
547	(defun bdd-interrupted? ()
548	(not (zerop 'bdd_interrupted)))
549
550	(bdd_init)

Line 0 Link Here

(-)pvs4.2-orig/BDD/ix86_64-Linux/Makefile (+48 lines)
	1	BDD = ../bdd/src
	2	MU = ../mu/src
	3	UTILS = ../bdd/utils
	4	INCLUDES = -I/usr/include -I$(BDD) -I$(UTILS) -I$(MU)
	5	LD = ld
	6	LDFLAGS = -Bsymbolic -shared -warn-once -L./
	7	CC = gcc
	8	CFLAGS = -D_POSIX_SOURCE -DSYSV $(INCLUDES) -DLINUX -DLINUX_REDHAT5 -DSIGNALS_LINUX -fPIC
	9	XCFLAGS = -O
	10	SHELL = /bin/sh
	11	VPATH = ..:../bdd/utils:../bdd/src:../mu/src
	12
	13	muobj = bdd_interface.o bdd.o bdd_factor.o bdd_quant.o bdd_fns.o bdd_vfns.o \
	14	appl.o mu_interface.o mu.o
	15
	16	utilobj = double.o list.o hash.o alloc.o
	17
	18	.SUFFIXES:
	19	.SUFFIXES: .c .o
	20	.c.o : ; $(CC) $(XCFLAGS) ${CFLAGS} -c $< -o $@
	21
	22	all : mu.so
	23
	24	mu.so : ${muobj} libutils.a ../bdd-ld-table ../mu-ld-table
	25	$(LD) ../bdd-ld-table ../mu-ld-table $(LDFLAGS) -o mu.so ${muobj} -lutils -lm -lbsd
	26
	27	libutils.a : ${utilobj}
	28	ar r libutils.a ${utilobj}
	29	ranlib libutils.a
	30
	31	bdd_interface.o : bdd_interface.c bdd_fns.h
	32	bdd_factor.o : bdd_factor.c bdd_factor.h
	33	bdd.o : bdd.c bdd.h bdd_extern.h
	34	bdd_fns.o : bdd_fns.c bdd_fns.h bdd.h bdd_extern.h
	35	bdd_quant.o : bdd_quant.c bdd_fns.h bdd.h bdd_extern.h
	36	bdd_vfns.o : bdd_vfns.c bdd_vfns.h bdd_fns.h bdd.h bdd_extern.h
	37
	38	mu_interface.o : mu_interface.c mu.h
	39	mu.o : mu.c mu.h
	40
	41	double.o : double.c double.h
	42	list.o : list.c list.h alloc.h
	43	hash.o : hash.c hash.h alloc.h
	44	alloc.o : alloc.c
	45
	46	clean :
	47	rm -f .o .a *.so
	48

Line 0 Link Here

(-)pvs4.2-orig/BDD/mu-sbcl.lisp (+248 lines)
		1	;; --------------------------------------------------------------------
		2	;; PVS
		3	;; Copyright (C) 2006, SRI International. All Rights Reserved.
		4
		5	;; This program is free software; you can redistribute it and/or
		6	;; modify it under the terms of the GNU General Public License
		7	;; as published by the Free Software Foundation; either version 2
		8	;; of the License, or (at your option) any later version.
		9
		10	;; This program is distributed in the hope that it will be useful,
		11	;; but WITHOUT ANY WARRANTY; without even the implied warranty of
		12	;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
		13	;; GNU General Public License for more details.
		14
		15	;; You should have received a copy of the GNU General Public License
		16	;; along with this program; if not, write to the Free Software
		17	;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
		18	;; --------------------------------------------------------------------
		19	(in-package :pvs)
		20
		21
		22	;;;;;;;;;;;;;;;;;
		23	;;; Formula ;;;
		24	;;;;;;;;;;;;;;;;;
		25
		26	;;; Formula mu_mk_false_formula (void)
		27	(sb-alien:define-alien-routine ("mu___mu_mk_false_formula" mu_mk_false_formula)
		28	(* t))
		29
		30	;;; Formula mu_mk_true_formula (void)
		31	(sb-alien:define-alien-routine ("mu___mu_mk_true_formula" mu_mk_true_formula)
		32	(* t))
		33
		34	;;; Formula mu_mk_bool_var (char *name)
		35	(sb-alien:define-alien-routine ("mu___mu_mk_bool_var" mu_mk_bool_var)
		36	(* t)
		37	(name sb-alien:c-string))
		38
		39	;;; int mu_check_bool_var (char *name)
		40	(sb-alien:define-alien-routine ("mu___mu_check_bool_var" mu_check_bool_var)
		41	(integer 32)
		42	(var sb-alien:c-string))
		43
		44	;;; Formula mu_check_mk_bool_var (char *name)
		45	(sb-alien:define-alien-routine
		46	("mu___mu_check_mk_bool_var" mu_check_mk_bool_var)
		47	(* t)
		48	(name sb-alien:c-string))
		49
		50	;;; Formula mu_mk_ite_formula (Formula cond, Formula then_part, Formula else_part)
		51	(sb-alien:define-alien-routine ("mu___mu_mk_ite_formula" mu_mk_ite_formula)
		52	(* t)
		53	(cnd (* t))
		54	(then_part (* t))
		55	(else_part (* t)))
		56
		57	;;; Formula mu_mk_curry_application (Term R, LIST subs)
		58	(sb-alien:define-alien-routine
		59	("mu___mu_mk_curry_application" mu_mk_curry_application)
		60	(* t)
		61	(R (* t))
		62	(subs (* t)))
		63
		64	;;; Formula mu_mk_application (Term R, LIST subs, int curried)
65	(sb-alien:define-alien-routine ("mu___mu_mk_application" mu_mk_application)
66	(* t)
67	(R (* t))
68	(subs (* t))
69	(curried (integer 32)))
70
71	;;; Formula mu_mk_forall (LIST listvars, Formula fml)
72	(sb-alien:define-alien-routine ("mu___mu_mk_forall" mu_mk_forall)
73	(* t)
74	(listvars (* t))
75	(fml (* t)))
76
77	;;; Formula mu_mk_exists (LIST listvars, Formula fml)
78	(sb-alien:define-alien-routine ("mu___mu_mk_exists" mu_mk_exists)
79	(* t)
80	(listvars (* t))
81	(fml (* t)))
82
83	;;; Formula mu_mk_implies_formula (Formula fml1, Formula fml2)
84	(sb-alien:define-alien-routine
85	("mu___mu_mk_implies_formula" mu_mk_implies_formula)
86	(* t)
87	(fml1 (* t))
88	(fml2 (* t)))
89
90	;;; Formula mu_mk_equiv_formula (Formula fml1, Formula fml2)
91	(sb-alien:define-alien-routine ("mu___mu_mk_equiv_formula" mu_mk_equiv_formula)
92	(* t)
93	(fml1 (* t))
94	(fml2 (* t)))
95
96	;;; Formula mu_mk_or_formula (Formula fml1, Formula fml2)
97	(sb-alien:define-alien-routine ("mu___mu_mk_or_formula" mu_mk_or_formula)
98	(* t)
99	(fml1 (* t))
100	(fml2 (* t)))
101
102	;;; Formula mu_mk_and_formula (Formula fml1, Formula fml2)
103	(sb-alien:define-alien-routine ("mu___mu_mk_and_formula" mu_mk_and_formula)
104	(* t)
105	(fml1 (* t))
106	(fml2 (* t)))
107
108	;;; Formula mu_mk_not_formula (Formula fml)
109	(sb-alien:define-alien-routine ("mu___mu_mk_not_formula" mu_mk_not_formula)
110	(* t)
111	(fml (* t)))
112
113	;;; Formula mu_mk_cofactor (Formula fml1, Formula fml2)
114	(sb-alien:define-alien-routine ("mu___mu_mk_cofactor" mu_mk_cofactor)
115	(* t)
116	(fml1 (* t))
117	(fml2 (* t)))
118
119	;;;;;;;;;;;;;;;
120	;;; Term ;;;
121	;;;;;;;;;;;;;;;
122	;;; Term mu_mk_abstraction (LIST vars, Formula f1)
123	(sb-alien:define-alien-routine ("mu___mu_mk_abstraction" mu_mk_abstraction)
124	(* t)
125	(vars (* t))
126	(f1 (* t)))
127	;;; Term mu_mk_l_fixed_point (int relvar, Term fml1)
128	(sb-alien:define-alien-routine ("mu___mu_mk_l_fixed_point" mu_mk_l_fixed_point)
129	(* t)
130	(relvar (integer 32))
131	(fml1 (* t)))
132	;;; Term mu_mk_g_fixed_point (int relvar, Term fml1)
133	(sb-alien:define-alien-routine ("mu___mu_mk_g_fixed_point" mu_mk_g_fixed_point)
134	(* t)
135	(relvar (integer 32))
136	(fml1 (* t)))
137	;;; Term mu_mk_reach (Term Next, Term S0, Term Inv)
138	(sb-alien:define-alien-routine ("mu___mu_mk_reach" mu_mk_reach)
139	(* t)
140	(Next (* t))
141	(S0 (* t))
142	(Inv (* t)))
143	;;; Term mu_mk_rel_var_dcl (char *name)
144	(sb-alien:define-alien-routine ("mu___mu_mk_rel_var_dcl" mu_mk_rel_var_dcl)
145	(* t)
146	(name sb-alien:c-string))
147	;;; Term mu_mk_rel_var_ (char *name)
148	(sb-alien:define-alien-routine ("mu___mu_mk_rel_var_" mu_mk_rel_var_)
149	(* t)
150	(name sb-alien:c-string))
151	;;; Term mu_mk_true_term (void)
152	(sb-alien:define-alien-routine ("mu___mu_mk_true_term" mu_mk_true_term)
153	(* t))
154	;;; Term mu_mk_false_term (void)
155	(sb-alien:define-alien-routine ("mu___mu_mk_false_term" mu_mk_false_term)
156	(* t))
157	;;; Term mu_mk_not_term (Term fml1)
158	(sb-alien:define-alien-routine ("mu___mu_mk_not_term" mu_mk_not_term)
159	(* t)
160	(fml1 (* t)))
161	;;; Term mu_mk_and_term (Term fml1, Term fml2)
162	(sb-alien:define-alien-routine ("mu___mu_mk_and_term" mu_mk_and_term)
163	(* t)
164	(fml1 (* t))
165	(fml2 (* t)))
166	;;; Term mu_mk_or_term (Term fml1, Term fml2)
167	(sb-alien:define-alien-routine ("mu___mu_mk_or_term" mu_mk_or_term)
168	(* t)
169	(fml1 (* t))
170	(fml2 (* t)))
171	;;; Term mu_mk_equiv_term (Term fml1, Term fml2)
172	(sb-alien:define-alien-routine ("mu___mu_mk_equiv_term" mu_mk_equiv_term)
173	(* t)
174	(fml1 (* t))
175	(fml2 (* t)))
176	;;; Term mu_mk_implies_term (Term fml1, Term fml2)
177	(sb-alien:define-alien-routine ("mu___mu_mk_implies_term" mu_mk_implies_term)
178	(* t)
179	(fml1 (* t))
180	(fml2 (* t)))
181	;;; const char *get_mu_bool_var_name (int bdd_idx)
182	(sb-alien:define-alien-routine
183	("mu___get_mu_bool_var_name" get_mu_bool_var_name)
184	sb-alien:c-string
185	(bdd_idx (integer 32)))
186
187	;;;;;;;;;;;;;;;;;;;
188	;;; Lists ;;;
189	;;;;;;;;;;;;;;;;;;;
190
191	;;; LIST append_cont (void *p, LIST list)
192	(sb-alien:define-alien-routine ("mu___append_cont" append_cont)
193	(* t)
194	(p (* t))
195	(list (* t)))
196	;;; LIST empty_list (void)
197	(sb-alien:define-alien-routine ("mu___empty_list" empty_list)
198	(* t))
199
200	;;;
201	;;; Flags
202
203	;;; int set_mu_warnings (int flag)
204	(sb-alien:define-alien-routine ("mu___set_mu_warnings" set_mu_warnings)
205	(integer 32)
206	(flag (integer 32)))
207	;;; int set_mu_simplify_frontier (int flag)
208	(sb-alien:define-alien-routine
209	("mu___set_mu_simplify_frontier" set_mu_simplify_frontier)
210	(integer 32)
211	(flag (integer 32)))
212	;;; int set_mu_verbose (int flag)
213	(sb-alien:define-alien-routine ("mu___set_mu_verbose" set_mu_verbose)
214	(integer 32)
215	(flag (integer 32)))
216
217	;;
218	;;
219	;; GC management: not needed, "modelcheck_formula" takes care of it.
220	;;
221
222	;;;;;;;;;;;;;;;;;;;
223	;;; print ;;;
224	;;;;;;;;;;;;;;;;;;;
225
226	;;; void pvs_mu_print_formula (Formula fml)
227	(sb-alien:define-alien-routine
228	("mu___pvs_mu_print_formula" pvs_mu_print_formula)
229	sb-alien:void
230	(fml (* t)))
231	;;; void pvs_mu_print_term (Term t)
232	(sb-alien:define-alien-routine ("mu___pvs_mu_print_term" pvs_mu_print_term)
233	sb-alien:void
234	(term (* t)))
235
236	;;;;;;;;;;;;;;;;;;;;;;;;;
237	;;; Main function ;;;;;
238	;;;;;;;;;;;;;;;;;;;;;;;;;
239
240	;;; void mu_init (void)
241	(sb-alien:define-alien-routine ("mu___mu_init" mu_init)
242	sb-alien:void)
243	(sb-alien:define-alien-routine ("mu___mu_quit" mu_quit)
244	sb-alien:void)
245	;;; BDDPTR mu___modelcheck_formula (Formula fml)
246	(sb-alien:define-alien-routine ("mu___modelcheck_formula" modelcheck_formula)
247	(* t)
248	(fml (* t)))

Lines 91-106 Link Here

(-)pvs4.2-orig/bin/make-dist (-2 / +21 lines)
91	src/groundeval/*.lisp \	91	src/groundeval/*.lisp \
92	src/utils/*.lisp \	92	src/utils/*.lisp \
93	src/utils/ix86-Linux/Makefile src/utils/ix86-MacOSX/Makefile \	93	src/utils/ix86-Linux/Makefile src/utils/ix86-MacOSX/Makefile \
		94	src/utils/ix86_64-Linux/Makefile \
94	src/utils/powerpc-MacOSX/Makefile \	95	src/utils/powerpc-MacOSX/Makefile \
95	src/utils/sun4-SunOS5/Makefile \	96	src/utils/sun4-SunOS5/Makefile \
96	BDD/bdd-ld-table BDD/mu-ld-table \	97	BDD/bdd-ld-table BDD/mu-ld-table \
97	BDD/*.c \	98	BDD/*.c \
98	BDD/*.lisp \	99	BDD/*.lisp \
99	BDD/ix86-Linux/Makefile BDD/sun4-SunOS5/Makefile \	100	BDD/ix86-Linux/Makefile BDD/ix86_64-Linux/Makefile BDD/sun4-SunOS5/Makefile \
100	BDD/ix86-MacOSX/Makefile BDD/powerpc-MacOSX/Makefile \	101	BDD/ix86-MacOSX/Makefile BDD/powerpc-MacOSX/Makefile \
101	BDD/bdd BDD/mu \	102	BDD/bdd BDD/mu \
102	src/WS1S/README src/WS1S/ws1s-ld-table \	103	src/WS1S/README src/WS1S/ws1s-ld-table \
103	src/WS1S/*.c src/WS1S/mona-1.4 \	104	src/WS1S/*.c src/WS1S/mona-1.4 \
		105	src/WS1S/ix86_64-Linux/Makefile
104	src/WS1S/ix86-Linux/Makefile src/WS1S/sun4-SunOS5/Makefile \	106	src/WS1S/ix86-Linux/Makefile src/WS1S/sun4-SunOS5/Makefile \
105	src/WS1S/ix86-MacOSX/Makefile src/WS1S/powerpc-MacOSX/Makefile \	107	src/WS1S/ix86-MacOSX/Makefile src/WS1S/powerpc-MacOSX/Makefile \
106	doc/pvs.bib doc/makebnf.sty doc/pvstex.tex doc/release-notes \	108	doc/pvs.bib doc/makebnf.sty doc/pvstex.tex doc/release-notes \
Lines 155-161 Link Here
155	# echo "pvs-libraries.tgz not created - need to typecheck finite_sets and bitvectors"	157	# echo "pvs-libraries.tgz not created - need to typecheck finite_sets and bitvectors"
156	# fi	158	# fi
157		159
158	for platform in ix86-Linux ix86-MacOSX powerpc-MacOSX \	160	for platform in ix86-Linux ix86_64-Linux ix86-MacOSX powerpc-MacOSX \
159	sun4-SunOS5	161	sun4-SunOS5
160	do	162	do
161	for subdir in runtime devel	163	for subdir in runtime devel
Lines 199-203 Link Here
199	else	201	else
200	echo "CMU Lisp ${subdir} not available for ${platform}"	202	echo "CMU Lisp ${subdir} not available for ${platform}"
201	fi	203	fi
		204	if [ -e bin/${platform}/${subdir}/pvs-sbclisp -a "$subdir" = "runtime" ]
		205	then
		206	echo Creating pvs-${version}-${platform}-sbclisp${kind}.tgz
		207	tar ${TARFLAGS} -f pvs-${version}-${platform}-sbclisp${kind}.tgz \
		208	${pvssystemfiles} \
		209	bin/${platform}/b64 bin/relocate \
		210	bin/pvs-platform bin/tar-b64-mail \
		211	bin/${platform}/${subdir}/mu.* \
		212	bin/${platform}/${subdir}/file_utils.* \
		213	bin/${platform}/${subdir}/ws1s.* \
		214	bin/${platform}/${subdir}/-sbcl. \
		215	bin/${platform}/${subdir}/lisp \
		216	bin/${platform}/${subdir}/pvs-sbclisp*
		217	ls -l pvs-${version}-${platform}-sbclisp${kind}.tgz
		218	else
		219	echo "SBCL ${subdir} not available for ${platform}"
		220	fi
202	done	221	done
203	done	222	done

Lines 120-146 Link Here

(-)pvs4.2-orig/emacs/emacs-src/ilisp/ilisp-dia.el (-20 / +19 lines)
120	(hook (read (format "%s-hook" dialect)))	120	(hook (read (format "%s-hook" dialect)))
121	(program (read (format "%s-program" dialect)))	121	(program (read (format "%s-program" dialect)))
122	(dialects (format "%s" dialect)))	122	(dialects (format "%s" dialect)))
123	(`	123	`(progn
124	(progn	124	(defvar ,hook nil ,(format "*Inferior %s hook." full-name))
125	(defvar (, hook) nil (, (format "*Inferior %s hook." full-name)))	125	(defvar ,program nil
126	(defvar (, program) nil	126	,(format "*Inferior %s default program." full-name))
127	(, (format "*Inferior %s default program." full-name)))	127	(defun ,setup (buffer)
128	(defun (, setup) (buffer)	128	,(format "Set up for interacting with %s." full-name)
129	(, (format "Set up for interacting with %s." full-name))	129	,(read (format "(setup-%s buffer)" parent))
130	(, (read (format "(setup-%s buffer)" parent)))	130	,@body
131	(,@ body)	131	(setq ilisp-program (or ,program ilisp-program)
132	(setq ilisp-program (or (, program) ilisp-program)	132	ilisp-dialect (cons ',dialect ilisp-dialect))
133	ilisp-dialect (cons '(, dialect) ilisp-dialect))	133	(run-hooks ',(read (format "%s-hook" dialect))))
134	(run-hooks '(, (read (format "%s-hook" dialect)))))	134	(defun ,dialect (&optional buffer program)
135	(defun (, dialect) (&optional buffer program)	135	,(format "Create an inferior %s. With prefix, prompt for buffer and program."
136	(, (format "Create an inferior %s. With prefix, prompt for buffer and program."	136	full-name)
137	full-name))
138	(interactive (list nil nil))	137	(interactive (list nil nil))
139	(ilisp-start-dialect (or buffer (, dialects))	138	(ilisp-start-dialect (or buffer ,dialects)
140	program	139	program
141	'(, setup))	140	',setup)
142	(setq (, program) ilisp-program))	141	(setq ,program ilisp-program))
143	(lisp-add-dialect (, dialects))))))	142	(lisp-add-dialect ,dialects))))
144		143
145	;;;%%ilisp	144	;;;%%ilisp
146	(defun setup-ilisp (buffer)	145	(defun setup-ilisp (buffer)

Lines 409-424 Link Here

(-)pvs4.2-orig/emacs/emacs-src/ilisp/ilisp-snd.el (-3 / +3 lines)
409	(comint-send	409	(comint-send
410	(ilisp-process) binary	410	(ilisp-process) binary
411	t nil 'binary nil	411	t nil 'binary nil
412	(` (lambda (error wait message output last)	412	`(lambda (error wait message output last)
413	(if (or error	413	(if (or error
414	(not (string-match "\"[^\"]*\"" output)))	414	(not (string-match "\"[^\"]*\"" output)))
415	(progn	415	(progn
416	(lisp-display-output output)	416	(lisp-display-output output)
417	(abort-commands-lisp "No binary"))	417	(abort-commands-lisp "No binary"))
418	(setq (, var)	418	(setq ,var
419	(substring output	419	(substring output
420	(1+ (match-beginning 0))	420	(1+ (match-beginning 0))
421	(1- (match-end 0))))))))))))	421	(1- (match-end 0)))))))))))
422		422
423	;;;	423	;;;
424	(defun ilisp-done-init ()	424	(defun ilisp-done-init ()

Lines 478-484 Link Here

(-)pvs4.2-orig/emacs/emacs-src/pvs-cmds.el (-7 / +7 lines)
478	(goto-char (point-min))	478	(goto-char (point-min))
479	(pop-to-buffer pbuf)	479	(pop-to-buffer pbuf)
480	(pvs-mode))	480	(pvs-mode))
481	(error "%s is not in the prelude."))))))	481	(error "%s is not in the prelude." fname))))))
482		482
483	(defun get-prelude-file-and-region (theoryname)	483	(defun get-prelude-file-and-region (theoryname)
484	(let ((freg nil)	484	(let ((freg nil)
Lines 768-774 Link Here
768	"Name of root file (CR for this one): ")	768	"Name of root file (CR for this one): ")
769	(list (y-or-n-p "Include libraries? "))	769	(list (y-or-n-p "Include libraries? "))
770	(list (read-from-minibuffer	770	(list (read-from-minibuffer
771	(format "Mail to: " pvs-last-email-address)	771	(format "Mail to: ")
772	pvs-last-email-address))	772	pvs-last-email-address))
773	(list (read-string "CC: "))	773	(list (read-string "CC: "))
774	(list (read-string "Subject: "))))	774	(list (read-string "Subject: "))))
Lines 787-795 Link Here
787	(let* ((lkeymap (copy-keymap (current-local-map)))	787	(let* ((lkeymap (copy-keymap (current-local-map)))
788	(file-string (pvs-dump-files-string pvs-file libraries-p)))	788	(file-string (pvs-dump-files-string pvs-file libraries-p)))
789	(define-key lkeymap "\C-c\C-c"	789	(define-key lkeymap "\C-c\C-c"
790	(` (lambda ()	790	`(lambda ()
791	(interactive)	791	(interactive)
792	(pvs-mail-send-and-exit (, to) (, subject) (, file-string)))))	792	(pvs-mail-send-and-exit ,to ,subject ,file-string)))
793	(use-local-map lkeymap)))	793	(use-local-map lkeymap)))
794		794
795	(defun pvs-mail-send-and-exit (to subject file-string)	795	(defun pvs-mail-send-and-exit (to subject file-string)
Lines 1435-1442 Link Here
1435		1435
1436	(defun pvs-major-version-number ()	1436	(defun pvs-major-version-number ()
1437	(if pvs-version-information	1437	(if pvs-version-information
1438	(string-to-int (car pvs-version-information))	1438	(string-to-number (car pvs-version-information))
1439	(string-to-int (pvs-send-and-wait "pvs-version" nil nil))))	1439	(string-to-number (pvs-send-and-wait "pvs-version" nil nil))))
1440		1440
1441	;;; Replay	1441	;;; Replay
1442		1442

Lines 111-116 Link Here

(-)pvs4.2-orig/emacs/emacs-src/pvs-ilisp.el (-7 / +33 lines)
111	(case (intern (getenv "PVSLISP"))	111	(case (intern (getenv "PVSLISP"))
112	(allegro (pvsallegro "pvs" nil))	112	(allegro (pvsallegro "pvs" nil))
113	(cmulisp (pvscmulisp "pvs" nil))	113	(cmulisp (pvscmulisp "pvs" nil))
		114	(sbclisp (pvssbclisp "pvs" nil))
114	(t (error "Unknown lisp - %s" (getenv "PVSLISP"))))	115	(t (error "Unknown lisp - %s" (getenv "PVSLISP"))))
115	(save-excursion	116	(save-excursion
116	(set-buffer (ilisp-buffer))	117	(set-buffer (ilisp-buffer))
Lines 164-170 Link Here
164	(setq ilisp-binary-extension (pvs-cmulisp-binary-extension))	165	(setq ilisp-binary-extension (pvs-cmulisp-binary-extension))
165	(setq ilisp-init-binary-extension ilisp-binary-extension)	166	(setq ilisp-init-binary-extension ilisp-binary-extension)
166	(setq ilisp-load-inits nil)	167	(setq ilisp-load-inits nil)
167	(setq ilisp-program (format "%s -qq" (pvs-program)))	168	(setq ilisp-program (format "%s -quiet -noinit" (pvs-program)))
168	(setq comint-prompt-regexp	169	(setq comint-prompt-regexp
169	"^\\([0-9]+\\]+\\\|\\\\\|[-a-zA-Z0-9]\\[[0-9]+\\]:\\) \\\|Rule\\? \\\|<GndEval> \\\|<PVSio> \\\|(Y or N)\\\|(Yes or No)\\\|Please enter")	170	"^\\([0-9]+\\]+\\\|\\\\\|[-a-zA-Z0-9]\\[[0-9]+\\]:\\) \\\|Rule\\? \\\|<GndEval> \\\|<PVSio> \\\|(Y or N)\\\|(Yes or No)\\\|Please enter")
170	(setq comint-interrupt-regexp "^Interrupted at")	171	(setq comint-interrupt-regexp "^Interrupted at")
Lines 173-178 Link Here
173	"^\\([0-9]+\\]+\\\|\\\\\|[-a-zA-Z0-9]\\[[0-9]+\\]:\\) ")	174	"^\\([0-9]+\\]+\\\|\\\\\|[-a-zA-Z0-9]\\[[0-9]+\\]:\\) ")
174	(setq pvs-gc-end-regexp ";;; Finished GC"))	175	(setq pvs-gc-end-regexp ";;; Finished GC"))
175		176
		177	(defdialect pvssbclisp "pvs-sbclisp"
		178	cmulisp
		179	(pvs-comint-init)
		180	;;(setq comint-send-newline nil)
		181	(setq ilisp-binary-extension (pvs-sbclisp-binary-extension))
		182	(setq ilisp-init-binary-extension ilisp-binary-extension)
		183	(setq ilisp-load-inits nil)
		184	(setq ilisp-program (format "%s --noinform --no-userinit" (pvs-program)))
		185	(setq ilisp-reset ":abort")
		186	(setq comint-prompt-regexp
		187	"^\\([0-9]+\\]+\\\|\\\\\|[-a-zA-Z0-9]\\[[0-9]+\\]:\\) \\\|Rule\\? \\\|<GndEval> \\\|<PVSio> \\\|(Y or N)\\\|(Yes or No)\\\|Please enter")
		188	(setq comint-interrupt-regexp "^ Interactive interrupt at")
		189	(setq comint-continue ":continue")
		190	(setq ilisp-error-regexp "^restarts (invokable by number or by possibly-abbreviated name):$")
		191	(setq pvs-top-regexp
		192	"^\\([0-9]+\\]+\\\|\\\\\|[-a-zA-Z0-9]\\[[0-9]+\\]:\\) ")
		193	(setq pvs-gc-end-regexp ";;; Finished GC"))
		194
176	(defun pvs-allegro-binary-extension ()	195	(defun pvs-allegro-binary-extension ()
177	(let ((machine (getenv "PVSARCH")))	196	(let ((machine (getenv "PVSARCH")))
178	(cond ((string-equal machine "sun4") ; Sun/Solaris	197	(cond ((string-equal machine "sun4") ; Sun/Solaris
Lines 193-198 Link Here
193	"ppcf")	212	"ppcf")
194	(t (error "Machine architecture %s not recognized" machine)))))	213	(t (error "Machine architecture %s not recognized" machine)))))
195		214
		215	(defun pvs-sbclisp-binary-extension ()
		216	(let ((machine (getenv "PVSARCH")))
		217	(cond ((string-equal machine "sun4") ; Sun/Solaris
		218	"sparcs")
		219	((string-equal machine "ix86") ; Intel/Linux
		220	"x86s")
		221	((string-equal machine "ix86_64") ; Intel/Linux
		222	"x8664s")
		223	((string-equal machine "powerpc") ; Mac
		224	"ppcs")
		225	(t (error "Machine architecture %s not recognized" machine)))))
		226
196	(defun pvs-comint-init ()	227	(defun pvs-comint-init ()
197	(setq ilisp-motd nil)	228	(setq ilisp-motd nil)
198	(setq pvs-fix-error comint-fix-error)	229	(setq pvs-fix-error comint-fix-error)
Lines 736-742 Link Here
736		767
737	(defun resize-info-buffer ()	768	(defun resize-info-buffer ()
738	(unless (one-window-p t)	769	(unless (one-window-p t)
739	(let* ((maxsize (/ (screen-height) 2))	770	(let* ((maxsize (/ (frame-height) 2))
740	(cursize (1- (window-height)))	771	(cursize (1- (window-height)))
741	(lines (real-number-of-lines))	772	(lines (real-number-of-lines))
742	(size (min maxsize lines)))	773	(size (min maxsize lines)))
Lines 1108-1118 Link Here
1108	(show-entry))	1139	(show-entry))
1109	(t (error "Unknown display type %s" type))))))	1140	(t (error "Unknown display type %s" type))))))
1110		1141
1111	(defun pvs-locate (out)
1112	(apply 'display-file-at-location
1113	(parse-pvs-message out)))
1114
1115
1116	(defun pvs-locate (output)	1142	(defun pvs-locate (output)
1117	(let* ((message (parse-pvs-message output))	1143	(let* ((message (parse-pvs-message output))
1118	(dir (car message))	1144	(dir (car message))

Lines 244-250 Link Here

(-)pvs4.2-orig/emacs/emacs-src/pvs-prover-helps.el (-6 / +6 lines)
244	(setq ept (point))	244	(setq ept (point))
245	(setq def2arw (buffer-substring bpt ept)))	245	(setq def2arw (buffer-substring bpt ept)))
246	(setq def2arw (read-from-minibuffer "Auto-rewrite: ")))	246	(setq def2arw (read-from-minibuffer "Auto-rewrite: ")))
247	(end-of-buffer)	247	(goto-char (point-max))
248	(insert "(auto-rewrite " ?\" def2arw ?\" ")")	248	(insert "(auto-rewrite " ?\" def2arw ?\" ")")
249	(return-ilisp)))	249	(return-ilisp)))
250		250
Lines 372-378 Link Here
372	(setq fnum (buffer-substring bpt ept)))	372	(setq fnum (buffer-substring bpt ept)))
373	(setq fnum (read-from-minibuffer	373	(setq fnum (read-from-minibuffer
374	"in formula [CR for default]# " ""))))	374	"in formula [CR for default]# " ""))))
375	(end-of-buffer)	375	(goto-char (point-max))
376	(insert "(expand " ?\" def2expand ?\" " " fnum ")")	376	(insert "(expand " ?\" def2expand ?\" " " fnum ")")
377	(return-ilisp)))))	377	(return-ilisp)))))
378		378
Lines 701-707 Link Here
701	(setq expr (buffer-substring start end))	701	(setq expr (buffer-substring start end))
702	(if (not (y-or-n-p (concat "Typepred for " expr)))	702	(if (not (y-or-n-p (concat "Typepred for " expr)))
703	(error "typepred aborted.")))	703	(error "typepred aborted.")))
704	(end-of-buffer)	704	(goto-char (point-max))
705	(insert "(typepred " ?\" expr ?\" ")")	705	(insert "(typepred " ?\" expr ?\" ")")
706	(return-ilisp)))	706	(return-ilisp)))
707		707
Lines 767-773 Link Here
767	(if editprfwin	767	(if editprfwin
768	(set-window-point editprfwin (point))))	768	(set-window-point editprfwin (point))))
769	(setq cmd (buffer-substring beg end))))	769	(setq cmd (buffer-substring beg end))))
770	(end-of-buffer)	770	(goto-char (point-max))
771	(insert cmd)	771	(insert cmd)
772	(return-ilisp)	772	(return-ilisp)
773	(hilit-next-prover-command)	773	(hilit-next-prover-command)
Lines 820-829 Link Here
820	(pvs-prover-goto-prev-step t))	820	(pvs-prover-goto-prev-step t))
821	(hilit-next-prover-command)	821	(hilit-next-prover-command)
822	(switch-to-buffer pvsbuf)	822	(switch-to-buffer pvsbuf)
823	(end-of-buffer)	823	(goto-char (point-max))
824	(switch-to-buffer editprfbuf)	824	(switch-to-buffer editprfbuf)
825	(pop-to-buffer pvsbuf)	825	(pop-to-buffer pvsbuf)
826	(end-of-buffer))))	826	(goto-char (point-max)))))
827		827
828		828
829	;;; pvs-prover-goto-next-step puts the cursor at the beginning of the next	829	;;; pvs-prover-goto-next-step puts the cursor at the beginning of the next

Lines 238-244 Link Here

(-)pvs4.2-orig/emacs/emacs-src/pvs-utils.el (-20 / +11 lines)
238	nil nil 'list)))	238	nil nil 'list)))
239	(when fandp	239	(when fandp
240	(cond ((not (file-exists-p (car fandp)))	240	(cond ((not (file-exists-p (car fandp)))
241	(error "Theory ~a was in ~a which no longer exists"	241	(error "Theory %s was in %s which no longer exists"
242	theoryname (car fandp)))	242	theoryname (car fandp)))
243	((or (null (cdr fandp))	243	((or (null (cdr fandp))
244	(buffer-modified-p (find-file-noselect (car fandp))))	244	(buffer-modified-p (find-file-noselect (car fandp))))
Lines 990-1002 Link Here
990	(error "Must specify a theory name")	990	(error "Must specify a theory name")
991	(list theory))))))	991	(list theory))))))
992		992
993	(defun remove-duplicates (list)
994	(let ((nlist nil))
995	(dolist (e list)
996	(unless (member-equal e nlist)
997	(push e nlist)))
998	(nreverse nlist)))
999
1000	(defun current-theory ()	993	(defun current-theory ()
1001	(let ((file (current-pvs-file t)))	994	(let ((file (current-pvs-file t)))
1002	(if file	995	(if file
Lines 1235-1247 Link Here
1235	(or (car (get cmd 'abbreviations))	1228	(or (car (get cmd 'abbreviations))
1236	cmd))	1229	cmd))
1237		1230
1238	(defun remove-if (pred list)
1239	(let ((nlist nil))
1240	(dolist (e list)
1241	(unless (funcall pred e)
1242	(push e nlist)))
1243	(nreverse nlist)))
1244
1245	(defun add-final-newline ()	1231	(defun add-final-newline ()
1246	(save-excursion	1232	(save-excursion
1247	(unless (equal (char-after (1- (point-max))) ?\n)	1233	(unless (equal (char-after (1- (point-max))) ?\n)
Lines 1355-1363 Link Here
1355	(setq pvs-reserved-words-regexp	1341	(setq pvs-reserved-words-regexp
1356	"\\bassuming\\b\\\|\\baxiom\\b\\\|\\baccept\\b\\\|\\bchanges\\b\\\|\\ball\\b\\\|\\band\\b\\\|\\barray\\b\\\|\\bbegin\\b\\\|\\bby\\b\\\|\\bcase\\b\\\|\\bdeclare\\b\\\|\\bdefinition\\b\\\|\\belse\\b\\\|\\belsif\\b\\\|\\bendif\\b\\\|\\bendassuming\\b\\\|\\bendcase\\b\\\|\\bend\\b\\\|\\bexists\\b\\\|\\bexporting\\b\\\|\\bexit\\b\\\|\\bforall\\b\\\|\\bfunction\\b\\\|\\bformula\\b\\\|\\bfrom\\b\\\|\\bif\\b\\\|\\biff\\b\\\|\\bimplies\\b\\\|\\bimporting\\b\\\|\\bin\\b\\\|\\bis\\b\\\|\\blambda\\b\\\|\\blemma\\b\\\|\\bloop\\b\\\|\\bmapping\\b\\\|\\bmeasure\\b\\\|\\bmodule\\b\\\|\\bnot\\b\\\|\\bnothing\\b\\\|\\bof\\b\\\|\\bonto\\b\\\|\\bobligation\\b\\\|\\bopspec\\b\\\|\\bor\\b\\\|\\bproof\\b\\\|\\bprove\\b\\\|\\brecursive\\b\\\|\\bresult\\b\\\|\\btheorem\\b\\\|\\btheory\\b\\\|\\busing\\b\\\|\\bvar\\b\\\|\\bvariable\\b\\\|\\brecord\\b\\\|\\bverify\\b\\\|\\bwhere\\b\\\|\\bthen\\b\\\|\\btype\\b\\\|\\bwhen\\b\\\|\\bwhile\\b\\\|\\bwith\\b\\\|\\blet\\b\\\|\\bsetvariable\\b\\\|\\[#\\\|#\\]\\\|[(]#\\\|#[)]")	1342	"\\bassuming\\b\\\|\\baxiom\\b\\\|\\baccept\\b\\\|\\bchanges\\b\\\|\\ball\\b\\\|\\band\\b\\\|\\barray\\b\\\|\\bbegin\\b\\\|\\bby\\b\\\|\\bcase\\b\\\|\\bdeclare\\b\\\|\\bdefinition\\b\\\|\\belse\\b\\\|\\belsif\\b\\\|\\bendif\\b\\\|\\bendassuming\\b\\\|\\bendcase\\b\\\|\\bend\\b\\\|\\bexists\\b\\\|\\bexporting\\b\\\|\\bexit\\b\\\|\\bforall\\b\\\|\\bfunction\\b\\\|\\bformula\\b\\\|\\bfrom\\b\\\|\\bif\\b\\\|\\biff\\b\\\|\\bimplies\\b\\\|\\bimporting\\b\\\|\\bin\\b\\\|\\bis\\b\\\|\\blambda\\b\\\|\\blemma\\b\\\|\\bloop\\b\\\|\\bmapping\\b\\\|\\bmeasure\\b\\\|\\bmodule\\b\\\|\\bnot\\b\\\|\\bnothing\\b\\\|\\bof\\b\\\|\\bonto\\b\\\|\\bobligation\\b\\\|\\bopspec\\b\\\|\\bor\\b\\\|\\bproof\\b\\\|\\bprove\\b\\\|\\brecursive\\b\\\|\\bresult\\b\\\|\\btheorem\\b\\\|\\btheory\\b\\\|\\busing\\b\\\|\\bvar\\b\\\|\\bvariable\\b\\\|\\brecord\\b\\\|\\bverify\\b\\\|\\bwhere\\b\\\|\\bthen\\b\\\|\\btype\\b\\\|\\bwhen\\b\\\|\\bwhile\\b\\\|\\bwith\\b\\\|\\blet\\b\\\|\\bsetvariable\\b\\\|\\[#\\\|#\\]\\\|[(]#\\\|#[)]")
1357		1343
		1344	(defmacro pvs-find-face (name)
		1345	(if (featurep 'xemacs)
		1346	`(find-face ,name)
		1347	`(facep ,name)))
		1348
1358	(defun highlight-pvs ()	1349	(defun highlight-pvs ()
1359	(interactive)	1350	(interactive)
1360	(unless (internal-find-face 'pvs-keyword)	1351	(unless (pvs-find-face 'pvs-keyword)
1361	(make-face 'pvs-keyword)	1352	(make-face 'pvs-keyword)
1362	(set-face-foreground 'pvs-keyword "Blue")	1353	(set-face-foreground 'pvs-keyword "Blue")
1363	(set-face-font 'pvs-keyword "courier-bold-r-normal--12"))	1354	(set-face-font 'pvs-keyword "courier-bold-r-normal--12"))
Lines 1575-1581 Link Here
1575	(defvar pvs-unexpected-output nil)	1566	(defvar pvs-unexpected-output nil)
1576		1567
1577	(defmacro pvs-validate (file directory &rest body)	1568	(defmacro pvs-validate (file directory &rest body)
1578	(` (let* ((logfile (concat default-directory (, file))))	1569	`(let* ((logfile (concat default-directory ,file)))
1579	(pvs-backup-logfile logfile)	1570	(pvs-backup-logfile logfile)
1580	(let ((logbuf (find-file-noselect logfile t)))	1571	(let ((logbuf (find-file-noselect logfile t)))
1581	(unwind-protect	1572	(unwind-protect
Lines 1592-1600 Link Here
1592	(default-directory default-directory))	1583	(default-directory default-directory))
1593	(pvs-message (pvs-version-string))	1584	(pvs-message (pvs-version-string))
1594	(let ((pvs-disable-messages nil))	1585	(let ((pvs-disable-messages nil))
1595	(change-context (, directory)))	1586	(change-context ,directory))
1596	(condition-case err	1587	(condition-case err
1597	(progn (,@ body))	1588	(progn ,@body)
1598	(error (pvs-message "ERROR: Emacs: %s %s"	1589	(error (pvs-message "ERROR: Emacs: %s %s"
1599	(car err) (cdr err)))))	1590	(car err) (cdr err)))))
1600	(pvs-wait-for-it)	1591	(pvs-wait-for-it)
Lines 1659-1665 Link Here
1659	(pvs-message "NO BASELINE - using this run to create baseline.log")	1650	(pvs-message "NO BASELINE - using this run to create baseline.log")
1660	(copy-file (buffer-file-name) "baseline.log"))))	1651	(copy-file (buffer-file-name) "baseline.log"))))
1661	(fset 'pvs-handler 'pvs-handler-orig)	1652	(fset 'pvs-handler 'pvs-handler-orig)
1662	(fset 'ask-user-about-lock 'ask-user-about-lock-orig))))))	1653	(fset 'ask-user-about-lock 'ask-user-about-lock-orig)))))
1663		1654
1664		1655
1665	;;; This function provides the most basic form of test, removing bin	1656	;;; This function provides the most basic form of test, removing bin

Lines 117-133 Link Here

(-)pvs4.2-orig/ess/lang/sb-term/rel/rt-unparse.lisp (-6 / +6 lines)
117		117
118	;;; Just so we don't repeatedly cons identical tokens.	118	;;; Just so we don't repeatedly cons identical tokens.
119		119
120	(defconstant ellipsis-token	120	(defconstant-if-unbound ellipsis-token
121	(make-token :kind :lt :subkind :string :value "#"))	121	(make-token :kind :lt :subkind :string :value "#"))
122	(defconstant cr-token	122	(defconstant-if-unbound cr-token
123	(make-token :kind :whitespace :subkind :cr))	123	(make-token :kind :whitespace :subkind :cr))
124	(defconstant unindent-token	124	(defconstant-if-unbound unindent-token
125	(make-token :kind :whitespace :subkind :unindent))	125	(make-token :kind :whitespace :subkind :unindent))
126	(defconstant tab-left-token	126	(defconstant-if-unbound tab-left-token
127	(make-token :kind :whitespace :subkind :tab-left))	127	(make-token :kind :whitespace :subkind :tab-left))
128	(defconstant tab-right-token	128	(defconstant-if-unbound tab-right-token
129	(make-token :kind :whitespace :subkind :tab-right))	129	(make-token :kind :whitespace :subkind :tab-right))
130	(defconstant untab-token	130	(defconstant-if-unbound untab-token
131	(make-token :kind :whitespace :subkind :untab))	131	(make-token :kind :whitespace :subkind :untab))
132		132
133		133

Lines 13-19 Link Here

(-)pvs4.2-orig/ess/lang/sb-term/rel/rt-unp-attr.lisp (-33 / +31 lines)
13		13
14	;;; Scott Dietzen, Tue Oct 6 15:32:22 1987	14	;;; Scott Dietzen, Tue Oct 6 15:32:22 1987
15		15
16	(in-package 'sb-runtime) (use-package :ergolisp)	16	(in-package "SB-RUNTIME") (use-package :ergolisp)
17		17
18		18
19	;;; The following is a hack to avoid the problems inherent in the circularity	19	;;; The following is a hack to avoid the problems inherent in the circularity
Lines 42-79 Link Here
42		42
43		43
44		44
45	(defun memo-uterm (term unp-function &key (top-level? nil))
46	(if (or disable-caching
47	(and disable-nested-caching
48	(null top-level?)))
49	(funcall unp-function term)
50	(newattr::get-gsyn theuterm
51	term
52	(list unp-function
53	unparse-style
54	no-escapes
55	sb-print-depth
56	sb-print-length
57	formatting-off))))
58
59
60	(defun memo-aw (uterm width indent-unit-width fontwidth fontheight)
61	(if disable-caching
62	(let* ((aw (make-aw :uterm uterm
63	:indent-unit-width indent-unit-width)))
64	(format-aw uterm aw width))
65	(newattr::get-gsyn theaw
66	(uterm-term uterm)
67	(list uterm
68	width
69	indent-unit-width
70	fontwidth
71	fontheight))))
72
73
74
75
76
77	(newattr::defgcon uterm-args)	45	(newattr::defgcon uterm-args)
78	(newattr::defgsyn theuterm uterm-args)	46	(newattr::defgsyn theuterm uterm-args)
79		47
Lines 105-107 Link Here
105	:indent-unit-width indent-unit-width)))	73	:indent-unit-width indent-unit-width)))
106	(format-aw uterm aw width))))	74	(format-aw uterm aw width))))
107		75
		76
		77
		78
		79	(defun memo-uterm (term unp-function &key (top-level? nil))
		80	(if (or disable-caching
		81	(and disable-nested-caching
		82	(null top-level?)))
		83	(funcall unp-function term)
		84	(newattr::get-gsyn theuterm
		85	term
		86	(list unp-function
		87	unparse-style
		88	no-escapes
		89	sb-print-depth
		90	sb-print-length
		91	formatting-off))))
		92
		93
		94	(defun memo-aw (uterm width indent-unit-width fontwidth fontheight)
		95	(if disable-caching
		96	(let* ((aw (make-aw :uterm uterm
		97	:indent-unit-width indent-unit-width)))
		98	(format-aw uterm aw width))
		99	(newattr::get-gsyn theaw
		100	(uterm-term uterm)
		101	(list uterm
		102	width
		103	indent-unit-width
		104	fontwidth
		105	fontheight))))

Lines 19-26 Link Here

(-)pvs4.2-orig/ess/sys/tools/rel/regression-test.lisp (-6 / +6 lines)
19	(defvar regression-testing-p nil)	19	(defvar regression-testing-p nil)
20		20
21	(defun regression-test (&key (name "Anonymous test")	21	(defun regression-test (&key (name "Anonymous test")
22	form (form-predicate #'identity) script endp)	22	form (form-predicate #'identity) script donep)
23	(declare (special name script endp))	23	(declare (special name script donep))
24	(let ((regression-testing-p t))	24	(let ((regression-testing-p t))
25	(catch 'script-ended	25	(catch 'script-ended
26	(let ((formval (if (functionp form) (funcall form) (eval form))))	26	(let ((formval (if (functionp form) (funcall form) (eval form))))
Lines 43-55 Link Here
43	(cadr (car script)))	43	(cadr (car script)))
44		44
45	(defun move-script ()	45	(defun move-script ()
46	(declare (special name script endp))	46	(declare (special name script donep))
47	(when (null script)	47	(when (null script)
48	(if endp	48	(if donep
49	(throw 'script-ended nil)	49	(throw 'script-ended nil)
50	(error "Regression test ~s fell off of end of script." name)))	50	(error "Regression test ~s fell off of end of script." name)))
51	(pop script)	51	(pop script)
52	(when (and (null script) endp) (throw 'script-ended nil))	52	(when (and (null script) donep) (throw 'script-ended nil))
53	(values))	53	(values))
54		54
55	(defmacro regression-test-only (key &body body)	55	(defmacro regression-test-only (key &body body)
Lines 164-170 Link Here
164	:name "Regressible-error should succeed."	164	:name "Regressible-error should succeed."
165	:form '(regressible-error :test "Error message ~s." 'foo)	165	:form '(regressible-error :test "Error message ~s." 'foo)
166	:script '((:test "Error message FOO."))	166	:script '((:test "Error message FOO."))
167	:endp t)	167	:donep t)
168		168
169	#+regression	169	#+regression
170	(regression-test	170	(regression-test

Lines 85-102 Link Here

(-)pvs4.2-orig/ess/term/language/rel/languages.lisp (-4 / +4 lines)
85		85
86		86
87		87
88	(defconstant standard-use-packages	88	(defconstant-if-unbound standard-use-packages
89	'("ERGOLISP" "OPER" "OCC" "TERM" "SORT" "SB-RUNTIME" "LANG" "NEWATTR")	89	'("ERGOLISP" "OPER" "OCC" "TERM" "SORT" "SB-RUNTIME" "LANG" "NEWATTR")
90	"The standard packages used by SB output files.")	90	"The standard packages used by SB output files.")
91		91
92	(defconstant standard-use-languages	92	(defconstant-if-unbound standard-use-languages
93	'("LEXICAL-TERMINALS")	93	'("LEXICAL-TERMINALS")
94	"The standard languages used by SB output files.")	94	"The standard languages used by SB output files.")
95		95
96		96
97	(defconstant gen-src-file-ext "lisp")	97	(defconstant-if-unbound gen-src-file-ext "lisp")
98		98
99	(defconstant per-gen-src-file-ext	99	(defconstant-if-unbound per-gen-src-file-ext
100	(concatenate 'string "." gen-src-file-ext))	100	(concatenate 'string "." gen-src-file-ext))
101		101
102		102

Lines 90-107 Link Here

(-)pvs4.2-orig/Makefile.in (-19 / +72 lines)
90	endif	90	endif
91	endif	91	endif
92		92
93	# ifneq ($(SBCL_HOME),)	93	ifneq ($(SBCLISP_HOME),)
94	# # Check that the given SBCL_HOME works	94	# Check that the given SBCLISP_HOME works
95	# SBCLISPEXE = $(SBCL_HOME)/bin/lisp	95	SBCLISPEXE = $(SBCLISP_HOME)/bin/sbcl
96	# ifeq ($(shell if [ -x "$(SBCLISPEXE)" ]; then echo OK; fi),OK)	96	ifeq ($(shell if [ -x "$(SBCLISPEXE)" ]; then echo OK; fi),OK)
97	# SBCLVERSION = $(shell $(SBCL_HOME)/bin/lisp -batch -eval '(progn (format t "~a" (lisp-implementation-version)) (terpri) (quit))')	97	SBCLVERSION = $(shell $(SBCLISPEXE) --version)
98	# $(warning "SBCL Version $(SBCLVERSION)")	98	$(warning "$(SBCLVERSION)")
99	# sbcl-devel += $(bindir)/devel/$(SYSTEM)-sbclisp	99	sbcl-devel += $(bindir)/devel/$(SYSTEM)-sbclisp
100	# sbcl-rt += $(bindir)/runtime/$(SYSTEM)-sbclisp	100	sbcl-rt += $(bindir)/runtime/$(SYSTEM)-sbclisp
101	# else	101	else
102	# $(error "$(SBCLISPEXE) is not executable")	102	$(error "$(SBCLISPEXE) is not executable")
103	# endif	103	endif
104	# endif	104	endif
105		105
106		106
107	LOAD-FOREIGN-EXTENSION=so	107	LOAD-FOREIGN-EXTENSION=so
Lines 342-347 Link Here
342	src/tex-support.lisp \	342	src/tex-support.lisp \
343	src/raw-api.lisp	343	src/raw-api.lisp
344		344
		345	sbcllisp += src/utils/file-utils-sbcl.lisp
345	cmulisp += src/utils/file-utils-cmu.lisp	346	cmulisp += src/utils/file-utils-cmu.lisp
346	allegrolisp += src/utils/file-utils.lisp	347	allegrolisp += src/utils/file-utils.lisp
347		348
Lines 372-377 Link Here
372		373
373	bddlisp = BDD/bdd.lisp BDD/mu.lisp	374	bddlisp = BDD/bdd.lisp BDD/mu.lisp
374	allegrolisp += BDD/bdd-allegro.lisp BDD/mu-allegro.lisp	375	allegrolisp += BDD/bdd-allegro.lisp BDD/mu-allegro.lisp
		376	sbcllisp += BDD/bdd-sbcl.lisp BDD/mu-sbcl.lisp
375	cmulisp += BDD/bdd-cmu.lisp BDD/mu-cmu.lisp	377	cmulisp += BDD/bdd-cmu.lisp BDD/mu-cmu.lisp
376		378
377	PVSiolisp = src/PVSio/pvs-lib.lisp src/PVSio/defattach.lisp \	379	PVSiolisp = src/PVSio/pvs-lib.lisp src/PVSio/defattach.lisp \
Lines 423-428 Link Here
423	groundevallisp := $(patsubst %,$(PVSPATH)%,$(groundevallisp))	425	groundevallisp := $(patsubst %,$(PVSPATH)%,$(groundevallisp))
424	inst-by-unif-lisp := $(patsubst %,$(PVSPATH)%,$(inst-by-unif-lisp))	426	inst-by-unif-lisp := $(patsubst %,$(PVSPATH)%,$(inst-by-unif-lisp))
425	allegrolisp := $(patsubst %,$(PVSPATH)%,$(allegrolisp))	427	allegrolisp := $(patsubst %,$(PVSPATH)%,$(allegrolisp))
		428	sbcllisp := $(patsubst %,$(PVSPATH)%,$(sbcllisp))
426	cmulisp := $(patsubst %,$(PVSPATH)%,$(cmulisp))	429	cmulisp := $(patsubst %,$(PVSPATH)%,$(cmulisp))
427	endif	430	endif
428		431
Lines 437-452 Link Here
437	.PHONY : all devel runtime parser emacs prelude-files-and-regions etags	440	.PHONY : all devel runtime parser emacs prelude-files-and-regions etags
438		441
439	ifneq ($(buildcmds),)	442	ifneq ($(buildcmds),)
440	ifeq ($(CMULISP_HOME)$(ALLEGRO_HOME),)	443	ifeq ($(SBCLISP_HOME)$(CMULISP_HOME)$(ALLEGRO_HOME),)
441	$(error "Must set CMULISP_HOME or ALLEGRO_HOME")	444	$(error "Must set SBCLISP_HOME, CMULISP_HOME, or ALLEGRO_HOME")
442	endif	445	endif
443	endif	446	endif
444		447
445	all : devel runtime prelude-files-and-regions $(emacs-elc) etags	448	all : devel runtime prelude-files-and-regions $(emacs-elc) etags
446		449
447	devel : $(allegro-devel) $(cmulisp-devel)	450	devel : $(allegro-devel) $(sbcl-devel) $(cmulisp-devel)
448		451
449	runtime : $(allegro-rt) $(cmulisp-rt)	452	runtime : $(allegro-rt) $(sbcl-rt) $(cmulisp-rt)
450		453
451	parser : pvs-parser-out	454	parser : pvs-parser-out
452		455
Lines 454-461 Link Here
454		457
455	etags : $(PVSPATH)TAGS	458	etags : $(PVSPATH)TAGS
456		459
457	$(PVSPATH)TAGS : $(lisp-files) $(allegrolisp) $(cmulisp) $(pvs-emacs-src)	460	$(PVSPATH)TAGS : $(lisp-files) $(allegrolisp) $(sbcllisp) $(cmulisp) $(pvs-emacs-src)
458	$(ETAGS) $(lisp-files) $(allegrolisp) $(cmulisp) $(pvs-emacs-src)	461	$(ETAGS) $(lisp-files) $(allegrolisp) $(sbcllisp) $(cmulisp) $(pvs-emacs-src)
459		462
460	fileutils = \	463	fileutils = \
461	$(PVSPATH)src/utils/$(PLATFORM)/file_utils.$(LOAD-FOREIGN-EXTENSION) \	464	$(PVSPATH)src/utils/$(PLATFORM)/file_utils.$(LOAD-FOREIGN-EXTENSION) \
Lines 472-477 Link Here
472	# Here are the rules for building the PVS grammar, pvs-methods file, and	475	# Here are the rules for building the PVS grammar, pvs-methods file, and
473	# devel and runtime images.	476	# devel and runtime images.
474		477
		478	ifneq ($(SBCLISP_HOME),)
		479
		480	ifeq ($(ALLEGRO_HOME),) # Build these with Allegro, if available
		481	$(PVSPATH)src/pvs-lexer.lisp : $(pvs-parser-in)
		482	@echo "******* Creating parser"
		483	$(SBCLISPEXE) --load src/make-pvs-parser
		484
		485	$(PVSPATH)src/pvs-methods.lisp : $(PVSPATH)src/make-pvs-methods.lisp \
		486	$(PVSPATH)src/defcl.lisp \
		487	$(PVSPATH)src/classes-expr.lisp \
		488	$(PVSPATH)src/classes-decl.lisp
		489	@echo "******* Creating pvs-methods.lisp"
		490	$(SBCLISPEXE) --eval "(defvar pvs-path \"$(PVSPATH)\")" \
		491	--load src/make-pvs-methods.lisp
		492	endif
		493
		494	$(sbcl-devel) $(sbcl-rt) : $(image-deps) \
		495	$(pvs-make-files) $(ess) $(ff-files) \
		496	$(lisp-files) $(sbcllisp) \
		497	$(PVSPATH)lib/prelude.pvs $(PVSPATH)lib/prelude.prf
		498	$(MKDIR) -p $(subst $(SYSTEM)-sbclisp,,$@)
		499	@echo "******* Compiling PVS files in Steel Bank Common Lisp (SBCL)"
		500	$(SBCLISPEXE) --eval '(require :sb-posix)' \
		501	--eval '(require :sb-md5)' \
		502	--eval '(load "pvs.system" :verbose t)' \
		503	--eval "(let ((load-pvs-prelude nil)) \
		504	(mk:operate-on-system :pvs :compile))" \
		505	--eval '(quit)'
		506	cp $(PVSPATH)src/utils/$(PLATFORM)/b64 $(bindir)
		507	@echo "******* Building PVS image $@"
		508	$(SBCLISPEXE) --eval '(require :sb-posix)' \
		509	--eval '(require :sb-md5)' \
		510	--eval '(load "pvs.system" :verbose t)' \
		511	--eval "(unwind-protect \
		512	(mk:operate-on-system :pvs :compile) \
		513	(save-lisp-and-die \"$@.core\" \
		514	:toplevel (function startup-pvs) \
		515	))"
		516	-rm $(PVSPATH)BDD/$(PLATFORM)/bdd-sbcl.*
		517	cp $(SBCLISPEXE) $(subst $(SYSTEM)-sbclisp,,$@)
		518	cp $(PVSPATH)BDD/$(PLATFORM)/mu.$(LOAD-FOREIGN-EXTENSION) $(subst $(SYSTEM)-sbclisp,,$@)
		519	cp $(PVSPATH)BDD/bdd-sbcl.lisp $(PVSPATH)BDD/mu-sbcl.lisp $(subst $(SYSTEM)-sbclisp,,$@)
		520	cp $(PVSPATH)src/WS1S/$(PLATFORM)/ws1s.$(LOAD-FOREIGN-EXTENSION) $(subst $(SYSTEM)-sbclisp,,$@)
		521	cp $(PVSPATH)src/WS1S/lisp/dfa-foreign-sbcl.lisp $(subst $(SYSTEM)-sbclisp,,$@)
		522	cp $(PVSPATH)src/utils/$(PLATFORM)/b64 $(bindir)
		523	echo "#!/bin/sh" > $@
		524	echo "sbcl --core \`dirname \$$0\`/\`basename \$$0\`.core \$$*" >> $@
		525	chmod a+x $@
		526	endif
		527
475	ifneq ($(CMULISP_HOME),)	528	ifneq ($(CMULISP_HOME),)
476		529
477	ifeq ($(ALLEGRO_HOME),) # Build these with Allegro, if available	530	ifeq ($(ALLEGRO_HOME),) # Build these with Allegro, if available
Lines 621-627 Link Here
621		674
622	faslexts = fasl,rfasl,hfasl,lfasl,mfasl,nfasl,sbin,obin,rbin,mbin,x86f,ppcf,sparcf,x8664s,x86s,ppcs,sparcs,clfasl,wfasl,err	675	faslexts = fasl,rfasl,hfasl,lfasl,mfasl,nfasl,sbin,obin,rbin,mbin,x86f,ppcf,sparcf,x8664s,x86s,ppcs,sparcs,clfasl,wfasl,err
623		676
624	platforms = ix86-Linux,ix86-MacOSX,powerpc-MacOSX,powerpc-MacOSX,sun4-SunOS5	677	platforms = ix86-Linux,ix86_64-Linux,ix86-MacOSX,powerpc-MacOSX,powerpc-MacOSX,sun4-SunOS5
625	# HT: Need to put a comma in a variable, because a literal	678	# HT: Need to put a comma in a variable, because a literal
626	# comma cannot appear in a makefile function argument.	679	# comma cannot appear in a makefile function argument.
627	comma:= ,	680	comma:= ,

Lines 11-17 Link Here

(-)pvs4.2-orig/pvs.in (-12 / +35 lines)
11	# -version \| --version prints the PVS version	11	# -version \| --version prints the PVS version
12	# -emacs emacsref emacs, xemacs, alias, or pathname	12	# -emacs emacsref emacs, xemacs, alias, or pathname
13	# -load-after efile loads emacs file name after PVS emacs files	13	# -load-after efile loads emacs file name after PVS emacs files
14	# -lisp name lisp image name - allegro or cmulisp	14	# -lisp name lisp image name - allegro, cmulisp, or sbclisp
15	# -runtime use the runtime image (devel is default, if there)	15	# -runtime use the runtime image (devel is default, if there)
16	# -decision-procedures set the default decision procedures (ics or shostak)	16	# -decision-procedures set the default decision procedures (ics or shostak)
17	# -force-decision-procedures forces the decision procedures to be used	17	# -force-decision-procedures forces the decision procedures to be used
Lines 42-51 Link Here
42	# PVSVERBOSE - corresponds to the -v argument	42	# PVSVERBOSE - corresponds to the -v argument
43	#	43	#
44	# The following environment variables are used by PVS, and are set below:	44	# The following environment variables are used by PVS, and are set below:
45	# PVSPATH pvs system path - this should not normally be set by the user	45	# PVSPATH pvs system path - this should not normally be set by the user
46	# PVSARCH sun4 or ix86	46	# PVSARCH sun4, ix86, ix86_64, or powerpc
47	#	47	#
48	# The PVS binary paths are appended to the front of the PATH variable	48	# The PVS binary paths are appended to the front of the PATH variable
49	# --------------------------------------------------------------------	49	# --------------------------------------------------------------------
50	# PVS	50	# PVS
51	# Copyright (C) 2006, SRI International. All Rights Reserved.	51	# Copyright (C) 2006, SRI International. All Rights Reserved.
Lines 98-104 Link Here
98	case $2 in	98	case $2 in
99	allegro) PVSLISP=allegro;;	99	allegro) PVSLISP=allegro;;
100	cmulisp) PVSLISP=cmulisp;;	100	cmulisp) PVSLISP=cmulisp;;
101	*) echo "Only allegro and cmulisp are currently available"	101	sbclisp) PVSLISP=sbclisp;;
		102	*) echo "Only allegro, cmulisp, and sbclisp are currently available"
102	exit 1;;	103	exit 1;;
103	esac	104	esac
104	shift;;	105	shift;;
Lines 170-176 Link Here
170	-version \| --version show the PVS version number	171	-version \| --version show the PVS version number
171	-emacs emacsref emacs, xemacs, alias, or pathname	172	-emacs emacsref emacs, xemacs, alias, or pathname
172	-load-after efile loads emacs file after PVS emacs files	173	-load-after efile loads emacs file after PVS emacs files
173	-lisp name lisp image name (allegro or cmulisp)	174	-lisp name lisp image name (allegro, cmulisp, or sbclisp)
174	-runtime use the runtime image	175	-runtime use the runtime image
175	-decision-procedures set default decision procedures (ics or shostak)	176	-decision-procedures set default decision procedures (ics or shostak)
176	-force-decision-procedures forces the decision procedures (ics or shostak)	177	-force-decision-procedures forces the decision procedures (ics or shostak)
Lines 198-210 Link Here
198	case $opsys in	199	case $opsys in
199	SunOS) majvers=`uname -r \| cut -d"." -f1`	200	SunOS) majvers=`uname -r \| cut -d"." -f1`
200	if [ $majvers = 4 ]	201	if [ $majvers = 4 ]
201	then echo "PVS 3.3 only runs under Mac OS X, Linux, FreeBSD, or Solaris"; exit 1	202	then echo "PVS 4.2 only runs under Mac OS X, Linux, FreeBSD, or Solaris"; exit 1
202	fi	203	fi
203	PVSARCH=sun4;;	204	PVSARCH=sun4;;
204	Linux) # If Linux, we need to determine the Redhat version to use.	205	Linux) # If Linux, we need to determine the Redhat version to use.
205	opsys=Linux	206	opsys=Linux
206	majvers=	207	majvers=
207	PVSARCH=ix86	208	case `uname -m` in
		209	x86) PVSARCH=ix86 ;;
		210	x86_64) PVSARCH=ix86_64 ;;
		211	*) echo "PVS 4.2 only runs on Intel Linux"; exit 1
		212	esac
208	# Allegro does not work with Linux's New Posix Thread Library (NPTL)	213	# Allegro does not work with Linux's New Posix Thread Library (NPTL)
209	# used in newer Red Hat kernels and 2.6 kernels. This will force	214	# used in newer Red Hat kernels and 2.6 kernels. This will force
210	# the old thread-implementation.	215	# the old thread-implementation.
Lines 215-221 Link Here
215	;;	220	;;
216	FreeBSD) opsys=Linux	221	FreeBSD) opsys=Linux
217	majvers=	222	majvers=
218	PVSARCH=ix86	223	case `uname -m` in
		224	x86) PVSARCH=ix86 ;;
		225	x86_64) PVSARCH=ix86_64 ;;
		226	*) echo "PVS 4.2 only runs on Intel Linux"; exit 1
		227	esac
219	# Allegro does not work with Linux's New Posix Thread Library (NPTL)	228	# Allegro does not work with Linux's New Posix Thread Library (NPTL)
220	# used in newer Red Hat kernels and 2.6 kernels. This will force	229	# used in newer Red Hat kernels and 2.6 kernels. This will force
221	# the old thread-implementation.	230	# the old thread-implementation.
Lines 233-245 Link Here
233	#majvers=`uname -r \| cut -d"." -f1`	242	#majvers=`uname -r \| cut -d"." -f1`
234	majvers=	243	majvers=
235	;;	244	;;
236	*) echo "PVS 3.3 only runs under Solaris, Linux, FreeBSD (linux-enabled), or Mac (Darwin 7.4)"; exit 1	245	*) echo "PVS 4.2 only runs under Solaris, Linux, FreeBSD (linux-enabled), or Mac (Darwin 7.4)"; exit 1
237	esac	246	esac
238		247
239	binpath=$PVSPATH/bin/$PVSARCH-$opsys${majvers}	248	binpath=$PVSPATH/bin/$PVSARCH-$opsys${majvers}
240		249
241	if [ -n "$PVSLISP" -a "$PVSLISP" != "allegro" -a "$PVSLISP" != "cmulisp" ]	250	if [ -n "$PVSLISP" -a "$PVSLISP" != "allegro" -a "$PVSLISP" != "cmulisp" -a "$PVSLISP" != "sbclisp" ]
242	then echo "ERROR: PVSLISP must be unset, or set to 'allegro' or 'cmulisp'"	251	then echo "ERROR: PVSLISP must be unset, or set to 'allegro', 'cmulisp', or 'sbclisp'"
243	exit 1	252	exit 1
244	fi	253	fi
245		254
Lines 252-257 Link Here
252	then PVSLISP=cmulisp	261	then PVSLISP=cmulisp
253	elif [ -x $binpath/runtime/pvs-cmulisp ]	262	elif [ -x $binpath/runtime/pvs-cmulisp ]
254	then PVSLISP=cmulisp	263	then PVSLISP=cmulisp
		264	elif [ -x $binpath/devel/pvs-sbclisp ]
		265	then PVSLISP=sbclisp
		266	elif [ -x $binpath/runtime/pvs-sbclisp ]
		267	then PVSLISP=sbclisp
255	else echo "No executable available in $binpath"	268	else echo "No executable available in $binpath"
256	exit 1	269	exit 1
257	fi	270	fi
Lines 292-297 Link Here
292	do flags="$flags -load $lf"; done	305	do flags="$flags -load $lf"; done
293	fi	306	fi
294	;;	307	;;
		308	sbclisp)
		309	noinit="--noinform --no-userinit"
		310	evalflag="--eval"
		311	if [ -n "$lisploadfiles" ]
		312	then
		313	flags="$flags --eval (pvs::pvs-init)"
		314	for lf in $lisploadfiles
		315	do flags="$flags --load $lf"; done
		316	fi
		317	;;
295	esac	318	esac
296		319
297	PVSPATCHLEVEL=${PVSPATCHLEVEL:-2}	320	PVSPATCHLEVEL=${PVSPATCHLEVEL:-2}

Line 0 Link Here

(-)pvs4.2-orig/pvs-sbcl.spec (+131 lines)
		1	Name: pvs-sbcl
		2	Version: 4.2
		3	Release: 1%{?dist}
		4	Summary: The PVS Verification System, SBCL build
		5
		6	Group: Applications/Engineering
		7	License: GPLv2+
		8	URL: http://pvs.csl.sri.com/
		9	Source0: http://pvs.csl.sri.com/download-open/pvs-%{version}-source.tgz
		10	Source1: http://pvs.csl.sri.com/doc/pvs-prelude.pdf
		11	Source2: http://pvs.csl.sri.com/doc/interpretations.pdf
		12	Source3: http://pvs.csl.sri.com/papers/csl-97-2/csl-97-2.ps.gz
		13	Source4: http://pvs.csl.sri.com/papers/csl-93-9/csl-93-9.ps.gz
		14	Patch0: pvs-4.2-sbcl.patch
		15	Patch1: pvs-4.2-unused.patch
		16	Patch2: pvs-4.2-64bit.patch
		17	Patch3: pvs-4.2-mona.patch
		18	Patch4: pvs-4.2-config.patch
		19	Patch5: pvs-4.2-typo.patch
		20	Patch6: pvs-4.2-emacs.patch
		21	Patch7: pvs-4.2-latex.patch
		22	BuildRoot: %{_tmppath}/%{name}-%{version}-%{release}-root-%(%{__id_u} -n)
		23
		24	BuildRequires: sbcl, texinfo-tex, texlive-latex, emacs-el, xemacs-devel
		25	Requires: sbcl, texlive-latex
		26	Provides: pvs = %{version}-%{release}, pvsio = %{version}-%{release}
		27
		28	%description
		29	PVS is a verification system: that is, a specification language integrated
		30	with support tools and a theorem prover. It is intended to capture the
		31	state-of-the-art in mechanized formal methods and to be sufficiently rugged
		32	that it can be used for significant applications. PVS is a research
		33	prototype: it evolves and improves as we develop or apply new capabilities,
		34	and as the stress of real use exposes new requirements.
		35
		36	%prep
		37	%setup -q -c
		38	cp -p %{SOURCE1} %{SOURCE2} %{SOURCE3} %{SOURCE4} .
		39
		40	# Enable support for building PVS with sbcl
		41	%patch0 -p1
		42
		43	# Get rid of an unused variable warning
		44	%patch1 -p1
		45
		46	# Enable building on 64-bit platforms
		47	%patch2 -p1
		48
		49	# Enable use of a system-installed Mona
		50	%patch3 -p1
		51
		52	# Update config.sub and config.guess so they'll recognize amd64- systems
		53	%patch4 -p1
		54
		55	# Fix a few typographical errors that result in miscompilations
		56	%patch5 -p1
		57
		58	# Modernize the Emacs interface
		59	%patch6 -p1
		60
		61	# Use the fancyhdr package instead of the obsolete fancyheadings package.
		62	# Also don't try to make Emacs kill an already dead process.
		63	%patch7 -p1
		64
65	%build
66	./configure CFLAGS="$RPM_OPT_FLAGS -fPIC"
67	make SBCLISP_HOME=/usr PVSPATH=`pwd`/
68
69	# Now that we're done building, we don't want the devel version
70	rm -fr bin/*/devel
71
72	# We also don't want the useless copy of the sbcl binary
73	rm -f bin/*/runtime/sbcl
74
75	# Run it once to force Lisp compilation of the native interfaces
76	bin/relocate > /dev/null
77	echo -e '(sb-ext:quit :recklessly-p t)' \| ./pvs -raw
78
79	# Get rid of some emacs save files and CVS control files
80	find . -name .cvsignore -o -name \*~ \| xargs rm -f
81
82	# Get rid of some temporary files we no longer need
83	rm -f doc/release-notes/pvs-release-notes.{pg,ky,tp,fn,cp,vr}
84
85	# Build the documentation
86	make -C doc/language
87	mv doc/language/language.pdf pvs-language-reference.pdf
88
89	make -C doc/prover
90	mv doc/prover/prover.pdf pvs-prover-guide.pdf
91
92	rm -f doc/release-notes/pvs-release-notes.pdf
93	make -C doc/release-notes pvs-release-notes.pdf
94
95	make -C doc/user-guide
96	mv doc/user-guide/user-guide.pdf pvs-system-guide.pdf
97
98	# Mimic the effects of the relocate script for the installed location
99	sed -i -e "s,^PVSPATH=.*$,PVSPATH=%{_datadir}/pvs," pvs
100	sed -i -e "s,^PVSPATH=.*$,PVSPATH=%{_datadir}/pvs," pvsio
101
102	%install
103	rm -rf $RPM_BUILD_ROOT
104	mkdir -p $RPM_BUILD_ROOT%{_bindir}
105	mkdir -p $RPM_BUILD_ROOT%{_datadir}/pvs/doc/release-notes
106	mkdir -p $RPM_BUILD_ROOT%{_datadir}/texmf/tex/latex/pvs
107	cp -a bin emacs lib pvs-tex.sub wish $RPM_BUILD_ROOT%{_datadir}/pvs
108	cp -a doc/release-notes/pvs-release-notes.info $RPM_BUILD_ROOT%{_datadir}/pvs/doc/release-notes
109	cp -a pvs.sty $RPM_BUILD_ROOT%{_datadir}/texmf/tex/latex/pvs
110	cp -a pvs pvsio $RPM_BUILD_ROOT%{_bindir}
111
112	# We don't need the relocate script
113	rm -f $RPM_BUILD_ROOT%{_datadir}/pvs/bin/relocate
114
115	%clean
116	rm -rf $RPM_BUILD_ROOT
117
118	%post -p /usr/bin/mktexlsr
119
120	%postun -p /usr/bin/mktexlsr
121
122	%files
123	%defattr(-,root,root,-)
124	%doc .pdf .ps.gz LICENSE NOTICES README doc/PVSio-2.d.pdf Examples
125	%{_bindir}/pvs*
126	%{_datadir}/pvs
127	%{_datadir}/texmf/tex/latex/pvs
128
129	%changelog
130	* Fri Jan 23 2009 Jerry James <loganjerry@gmail.com> - 4.2-1
131	- Initial package, based on cmulisp package

Lines 402-409 Link Here

(-)pvs4.2-orig/src/context.lisp (-3 / +4 lines)
402	subdir))	402	subdir))
403	(multiple-value-bind (result err)	403	(multiple-value-bind (result err)
404	(ignore-lisp-errors #+allegro (excl:make-directory subdir)	404	(ignore-lisp-errors #+allegro (excl:make-directory subdir)
405	#+(or cmu sbcl)	405	#+cmu (unix:unix-mkdir (namestring subdir) #o777)
406	(unix:unix-mkdir (namestring subdir) #o777))	406	#+sbcl
		407	(sb-unix:unix-mkdir (namestring subdir) #o777))
407	(cond (result (pvs-message "Created directory ~a" subdir)	408	(cond (result (pvs-message "Created directory ~a" subdir)
408	t)	409	t)
409	(t (pvs-message "Error creating ~a: ~a" subdir err)	410	(t (pvs-message "Error creating ~a: ~a" subdir err)
Lines 534-540 Link Here
534		535
535	#+(or cmu sbcl)	536	#+(or cmu sbcl)
536	(defun md5-file (file)	537	(defun md5-file (file)
537	(let ((digest (md5:md5sum-file file))	538	(let ((digest (#+cmu md5:md5sum-file #+sbcl sb-md5:md5sum-file file))
538	(sum 0))	539	(sum 0))
539	(loop for x across digest	540	(loop for x across digest
540	do (setq sum (+ (* sum 256) x)))	541	do (setq sum (+ (* sum 256) x)))

Lines 51-61 Link Here

(-)pvs4.2-orig/src/defcl.lisp (-2 / +4 lines)
51	(defmacro defcl (name classes &rest args)	51	(defmacro defcl (name classes &rest args)
52	(setf args (mapcar #'(lambda (a) (if (consp a) a (list a))) args))	52	(setf args (mapcar #'(lambda (a) (if (consp a) a (list a))) args))
53	`(progn ,@(mapcar #'(lambda (a)	53	`(progn ,@(mapcar #'(lambda (a)
54	#+allegro `(declaim (ftype (function	54	#+(or allegro sbcl)
		55	`(declaim (ftype (function
55	(t)	56	(t)
56	,(cadr (member :type a)))	57	,(cadr (member :type a)))
57	,(car a)))	58	,(car a)))
58	#-allegro `(proclaim '(function ,(car a) (t)	59	#-(or allegro sbcl)
		60	`(proclaim '(function ,(car a) (t)
59	,(cadr (member :type a)))))	61	,(cadr (member :type a)))))
60	(remove-if-not #'(lambda (a) (member :type a))	62	(remove-if-not #'(lambda (a) (member :type a))
61	args))	63	args))

Lines 68-81 Link Here

(-)pvs4.2-orig/src/groundeval/eval-utils.lisp (-2 / +2 lines)
68	(defmethod print-object ((obj eval-info) stream)	68	(defmethod print-object ((obj eval-info) stream)
69	(if debugging-print-object	69	(if debugging-print-object
70	(call-next-method)	70	(call-next-method)
71	(format stream "~@<#<eval-info ~2I~_~:0Iinternal: ~W~:@_external: ~W>~:>"	71	(format stream "~@<#<eval-info ~2I~_~0:Iinternal: ~W~:@_external: ~W>~:>"
72	(internal obj) (external obj))))	72	(internal obj) (external obj))))
73		73
74	(defmethod print-object ((obj eval-defn-info) stream)	74	(defmethod print-object ((obj eval-defn-info) stream)
75	(if debugging-print-object	75	(if debugging-print-object
76	(call-next-method)	76	(call-next-method)
77	(format stream	77	(format stream
78	"~@<#<eval-defn-info ~2I~_~:0Iunary: ~W~:@_multiary: ~W~:@_destructive: ~W>~:>"	78	"~@<#<eval-defn-info ~2I~_~0:Iunary: ~W~:@_multiary: ~W~:@_destructive: ~W>~:>"
79	(unary obj) (multiary obj) (destructive obj))))	79	(unary obj) (multiary obj) (destructive obj))))
80		80
81	(defmethod print-object ((obj eval-defn) stream)	81	(defmethod print-object ((obj eval-defn) stream)

Lines 138-144 Link Here

(-)pvs4.2-orig/src/groundeval/pvs2clean.lisp (-2 / +3 lines)
138		138
139	(defmethod pvs2clean* ((expr projection-application) bindings livevars)	139	(defmethod pvs2clean* ((expr projection-application) bindings livevars)
140	(let* ((ll (length (exprs expr)))	140	(let* ((ll (length (exprs expr)))
141	(dummy (gentemp 'ddd))	141	(dummy (gentemp "DDD"))
142	(match-list (pvs2clean_tuple (matchlist (index expr) ll dummy)))	142	(match-list (pvs2clean_tuple (matchlist (index expr) ll dummy)))
143	(expr-list (pvs2clean* expr bindings livevars)))	143	(expr-list (pvs2clean* expr bindings livevars)))
144	`(let ,match-list = ,expr-list in ,dummy)))	144	`(let ,match-list = ,expr-list in ,dummy)))
Lines 177-183 Link Here
177	(updateable-free-formal-vars operator)	177	(updateable-free-formal-vars operator)
178	livevars))))	178	livevars))))
179	(if (clean-updateable? (type operator))	179	(if (clean-updateable? (type operator))
180	(format nil "(pvsSelect ~a ~a)"	180	(format nil "(pvsSelect ~a ~a ~a)"
181	clean-op clean-arg	181	clean-op clean-arg
182	(mk-clean-funcall clean-op	182	(mk-clean-funcall clean-op
183	(list clean-arg))))))))	183	(list clean-arg))))))))
Lines 375-380 Link Here
375	livevars))))))	375	livevars))))))
376	(if else-part	376	(if else-part
377	(format nil "~a ~% _ -> ~a"	377	(format nil "~a ~% _ -> ~a"
		378	selections-clean
378	(pvs2clean* (expression else-part) bindings livevars))	379	(pvs2clean* (expression else-part) bindings livevars))
379	selections-clean)))	380	selections-clean)))
380		381

Lines 46-52 Link Here

(-)pvs4.2-orig/src/ground-prover/prglobals.lisp (-4 / +4 lines)
46	(defconstant true 'true )	46	(defconstant true 'true )
47	(defconstant false 'false )	47	(defconstant false 'false )
48		48
49	(defconstant primtypealist	49	(defconstant-if-unbound primtypealist
50	'((true . bool)	50	'((true . bool)
51	(false . bool)	51	(false . bool)
52	(and . bool)	52	(and . bool)
Lines 139-154 Link Here
139		139
140	;;; the following special declarations are rather offensive:	140	;;; the following special declarations are rather offensive:
141		141
142	(proclaim '(special const sum u s eq lit var coef product ineqpot ))	142	(proclaim '(special const sum u s #-sbcl eq lit var coef product ineqpot ))
143		143
144		144
145	;;; the following (til end-of-file) are taken from prpp:	145	;;; the following (til end-of-file) are taken from prpp:
146		146
147	(defconstant infixlist ;temporary list of infixes	147	(defconstant-if-unbound infixlist ;temporary list of infixes
148	'(equal nequal lessp greaterp lesseq lesseqp greatereq greatereqp	148	'(equal nequal lessp greaterp lesseq lesseqp greatereq greatereqp
149	PLUS MINUS TIMES DIVIDE DIFFERENCE) )	149	PLUS MINUS TIMES DIVIDE DIFFERENCE) )
150		150
151	(defconstant precedence-alist	151	(defconstant-if-unbound precedence-alist
152	'((iff 1)	152	'((iff 1)
153	(implies 2)	153	(implies 2)
154	(or 3)	154	(or 3)

Lines 55-75 Link Here

(-)pvs4.2-orig/src/ground-prover/prmacros.lisp (-7 / +7 lines)
55	(defun prerr (&rest args)	55	(defun prerr (&rest args)
56	(apply #'error args))	56	(apply #'error args))
57		57
58	(defconstant truecons '(true))	58	(defconstant-if-unbound truecons '(true))
59		59
60	(defconstant eqarithrels '(greatereqp lesseqp))	60	(defconstant-if-unbound eqarithrels '(greatereqp lesseqp))
61		61
62	(defconstant ifops nil ;;'(if if*)	62	(defconstant ifops nil ;;'(if if*)
63	)	63	)
64		64
65	(defconstant boolconstants '(false true))	65	(defconstant-if-unbound boolconstants '(false true))
66		66
67	(defconstant arithrels '(lessp lesseqp greaterp greatereqp))	67	(defconstant-if-unbound arithrels '(lessp lesseqp greaterp greatereqp))
68		68
69	(defconstant arithops '(PLUS TIMES DIFFERENCE MINUS))	69	(defconstant-if-unbound arithops '(PLUS TIMES DIFFERENCE MINUS))
70		70
71	(defconstant boolops '(and or implies not ;;if	71	(defconstant-if-unbound boolops '(and or implies not ;;if
72	iff))	72	iff))
73		73
74	(defmacro singleton? (obj)	74	(defmacro singleton? (obj)
75	`(and (consp ,obj) (null (cdr ,obj))))	75	`(and (consp ,obj) (null (cdr ,obj))))

Lines 210-218 Link Here

(-)pvs4.2-orig/src/prover/eproofcheck.lisp (-2 / +8 lines)
210	(and noninteractive	210	(and noninteractive
211	noninteractive-timeout))	211	noninteractive-timeout))
212	(let ((timeout (or proof-timeout noninteractive-timeout)))	212	(let ((timeout (or proof-timeout noninteractive-timeout)))
		213	#-sbcl
213	(mp:with-timeout (timeout (pvs-message "Interrupted: ~a sec timeout"	214	(mp:with-timeout (timeout (pvs-message "Interrupted: ~a sec timeout"
214	timeout))	215	timeout))
215	(call-next-method)))	216	(call-next-method))
		217	#+sbcl
		218	(sb-ext:with-timeout timeout
		219	(handler-case (call-next-method)
		220	(sb-ext:timeout ()
		221	(pvs-message "Interrupted: ~a sec timeout" timeout)))))
216	(call-next-method)))	222	(call-next-method)))
217		223
218	(defmethod prove-decl ((decl formula-decl) &key strategy context)	224	(defmethod prove-decl ((decl formula-decl) &key strategy context)
Lines 3446-3452 Link Here
3446	(values 'X nil nil))	3452	(values 'X nil nil))
3447	((and (or (digit-char-p (char strlbl 0))	3453	((and (or (digit-char-p (char strlbl 0))
3448	(char= (char strlbl 0) #\-))	3454	(char= (char strlbl 0) #\-))
3449	(every #'digit-char-p (subseq strlbl) 1))	3455	(every #'digit-char-p (subseq strlbl 1)))
3450	(error-format-if	3456	(error-format-if
3451	"~%Label cannot be an integer"))	3457	"~%Label cannot be an integer"))
3452	(t	3458	(t

Lines 102-120 Link Here

(-)pvs4.2-orig/src/pvs.lisp (-6 / +8 lines)
102	(let ((exepath (car (make::split-string	102	(let ((exepath (car (make::split-string
103	(environment-variable "LD_LIBRARY_PATH") :item #\:))))	103	(environment-variable "LD_LIBRARY_PATH") :item #\:))))
104	(pushnew exepath pvs-directories)	104	(pushnew exepath pvs-directories)
105	(ext:load-foreign (format nil "~a/mu.~a" exepath	105	(#+cmu ext:load-foreign #+sbcl sb-alien:load-shared-object
		106	(format nil "~a/mu.~a" exepath
106	#+darwin "dylib"	107	#+darwin "dylib"
107	#-darwin "so"))	108	#-darwin "so"))
108	(ext:load-foreign (format nil "~a/ws1s.~a" exepath	109	(#+cmu ext:load-foreign #+sbcl sb-alien:load-shared-object
		110	(format nil "~a/ws1s.~a" exepath
109	#+darwin "dylib"	111	#+darwin "dylib"
110	#-darwin "so"))	112	#-darwin "so"))
111	;; Have no idea what is going on here, but if you leave this out,	113	;; Have no idea what is going on here, but if you leave this out,
112	;; bdd-cmu gives a compile error.	114	;; bdd-cmu gives a compile error.
113	(fmakunbound 'bdd_cofactor_neg_)	115	#+cmu (fmakunbound 'bdd_cofactor_neg_)
114	(lf "bdd-cmu")	116	#+cmu (lf "bdd-cmu") #+sbcl (lf "bdd-sbcl")
115	(lf "mu-cmu")	117	#+cmu (lf "mu-cmu") #+sbcl (lf "mu-sbcl")
116	(bdd_init)	118	(bdd_init)
117	(lf "dfa-foreign-cmu"))	119	#+cmu (lf "dfa-foreign-cmu") #+sbcl (lf "dfa-foreign-sbcl"))
118	(setq started-with-minus-q	120	(setq started-with-minus-q
119	(or dont-load-user-lisp	121	(or dont-load-user-lisp
120	(let ((mq (environment-variable "PVSMINUSQ")))	122	(let ((mq (environment-variable "PVSMINUSQ")))

Line 0 Link Here

(-)pvs4.2-orig/src/utils/file-utils-sbcl.lisp (+66 lines)
		1	;; --------------------------------------------------------------------
		2	;; PVS
		3	;; Copyright (C) 2008, SRI International. All Rights Reserved.
		4
		5	;; This program is free software; you can redistribute it and/or
		6	;; modify it under the terms of the GNU General Public License
		7	;; as published by the Free Software Foundation; either version 2
		8	;; of the License, or (at your option) any later version.
		9
		10	;; This program is distributed in the hope that it will be useful,
		11	;; but WITHOUT ANY WARRANTY; without even the implied warranty of
		12	;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
		13	;; GNU General Public License for more details.
		14
		15	;; You should have received a copy of the GNU General Public License
		16	;; along with this program; if not, write to the Free Software
		17	;; Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA
		18	;; 02110-1301, USA.
		19	;; --------------------------------------------------------------------
		20
		21	(in-package :pvs)
		22	(require :sb-posix)
		23	(export '(file-exists-p directory-p read-permission? write-permission?
		24	file-write-time get-file-info))
		25
		26	(defun remove-backslashes (string)
		27	(declare (type string string))
		28	(sb-impl::remove-backslashes string 0 (length string)))
		29
		30	(defun file-exists-p (file)
		31	(handler-case
		32	(zerop
		33	(sb-posix:access
		34	(remove-backslashes (namestring (merge-pathnames file)))
		35	sb-posix:f-ok))
		36	(sb-posix:syscall-error () nil)))
		37
		38	(defun directory-p (dir)
		39	(handler-case
		40	(let ((filestring (namestring (merge-pathnames dir))))
		41	(when (sb-posix:s-isdir (sb-posix:stat-mode (sb-posix:stat filestring)))
		42	;; Needs to end with a slash!!!
		43	(pathname (if (char= (char filestring (1- (length filestring))) #\/)
		44	filestring
		45	(concatenate 'string filestring "/")))))
		46	(sb-posix:syscall-error () nil)))
		47
		48	(defun read-permission? (file)
		49	(handler-case (zerop (sb-posix:access file sb-posix:r-ok))
		50	(sb-posix:syscall-error () nil)))
		51
		52	(defun write-permission? (file)
		53	(handler-case (zerop (sb-posix:access file sb-posix:w-ok))
		54	(sb-posix:syscall-error () nil)))
		55
		56	(defconstant u1970 (encode-universal-time 0 0 0 1 1 1970 0))
		57
		58	(defun file-write-time (file)
		59	(handler-case (+ u1970 (sb-posix:stat-mtime (sb-posix:stat file)))
		60	(sb-posix:syscall-error () nil)))
		61
		62	(defun get-file-info (file)
		63	(handler-case
		64	(let ((stat (sb-posix:stat file)))
65	(list (sb-posix:stat-dev stat) (sb-posix:stat-ino stat)))
66	(sb-posix:syscall-error () nil)))

Lines 56-62 Link Here

(-)pvs4.2-orig/src/utils/hashfn.lisp (-3 / +3 lines)
56	;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.	56	;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
57	;; --------------------------------------------------------------------	57	;; --------------------------------------------------------------------
58		58
59	(in-package 'pvs)	59	(in-package :pvs)
60		60
61	;(declaim (function pvs-sxhash* (T list) (integer 0 65535)))	61	;(declaim (function pvs-sxhash* (T list) (integer 0 65535)))
62		62
Lines 64-70 Link Here
64	;(defun tc-eq (x y &optional bindings)	64	;(defun tc-eq (x y &optional bindings)
65	; (tc-eq* x y bindings))	65	; (tc-eq* x y bindings))
66		66
67	(defconstant pvs-sxhash-byte (byte #+allegro 24 #-allegro 29 0))	67	(defconstant-if-unbound pvs-sxhash-byte (byte #+allegro 24 #-allegro 29 0))
68		68
69	(defconstant pvs-max-hashnum (1- (expt 2 #+allegro 24 #-allegro 29)))	69	(defconstant pvs-max-hashnum (1- (expt 2 #+allegro 24 #-allegro 29)))
70		70
Lines 104-110 Link Here
104	(declare (ignore bindings))	104	(declare (ignore bindings))
105	(the positive-fixnum (sxhash x)))	105	(the positive-fixnum (sxhash x)))
106		106
107	(defconstant nil-sxhash (sxhash nil))	107	(defconstant-if-unbound nil-sxhash (sxhash nil))
108		108
109	(defmethod pvs-sxhash* ((x null) bindings)	109	(defmethod pvs-sxhash* ((x null) bindings)
110	(declare (ignore bindings))	110	(declare (ignore bindings))

Line 0 Link Here

(-)pvs4.2-orig/src/utils/ix86_64-Linux/Makefile (+23 lines)
	1	LD = gcc
	2	LDFLAGS = -shared -L./
	3	CC=gcc
	4	CFLAGS=-fPIC
	5	WFLAGS=-Wall
	6	VPATH=..
	7
	8	obj=file_utils.o
	9
	10	.SUFFIXES:
	11	.SUFFIXES: .c .o
	12	.c.o : ; $(CC) $(XCFLAGS) ${WFLAGS} ${CFLAGS} -c $< -o $@
	13
	14	all : file_utils.so b64
	15
	16	file_utils.so: ${obj}
	17	$(LD) ../utils-ld-table $(LDFLAGS) -o file_utils.so ${obj} -lc
	18
	19	b64: ../b64.c
	20	$(CC) -o ./b64 ../b64.c
	21
	22	clean :
	23	rm -f .o .a *.so b64

Lines 137-147 Link Here

(-)pvs4.2-orig/src/utils.lisp (-16 / +47 lines)
137	(let* ((test (hash-table-test ht))	137	(let* ((test (hash-table-test ht))
138	(size (hash-table-count ht))	138	(size (hash-table-count ht))
139	(weak? #+allegro (excl:hash-table-weak-keys ht)	139	(weak? #+allegro (excl:hash-table-weak-keys ht)
140	#+(or cmu sbcl) (lisp::hash-table-weak-p ht))	140	#+cmu (lisp::hash-table-weak-p ht)
		141	#+sbcl (sb-ext:hash-table-weakness ht))
141	(new-ht (if (memq test '(eq eql equal equalp))	142	(new-ht (if (memq test '(eq eql equal equalp))
142	(make-hash-table	143	(make-hash-table
143	:test test :size size	144	:test test :size size
144	#+allegro :weak-keys #+(or cmu sbcl) :weak-p weak?)	145	#+allegro :weak-keys #+cmu :weak-p #+sbcl :weakness weak?)
145	(make-pvs-hash-table :strong-eq? (eq test 'strong-tc-eq)	146	(make-pvs-hash-table :strong-eq? (eq test 'strong-tc-eq)
146	:size size	147	:size size
147	:weak-keys? weak?))))	148	:weak-keys? weak?))))
Lines 279-285 Link Here
279	#+(and allegro (version>= 6) (not (version>= 7)))	280	#+(and allegro (version>= 6) (not (version>= 7)))
280	(excl::variable-special-p obj nil)	281	(excl::variable-special-p obj nil)
281	#+(and allegro (not (version>= 6))) (clos::variable-special-p obj nil)	282	#+(and allegro (not (version>= 6))) (clos::variable-special-p obj nil)
282	#+(or cmu sbcl) (eq (extensions:info variable kind obj) :special)	283	#+cmu (eq (extensions:info variable kind obj) :special)
		284	#+sbcl (sb-walker:var-globally-special-p obj)
283	#+harlequin-common-lisp (system:declared-special-p obj)	285	#+harlequin-common-lisp (system:declared-special-p obj)
284	#-(or lucid kcl allegro harlequin-common-lisp cmu sbcl)	286	#-(or lucid kcl allegro harlequin-common-lisp cmu sbcl)
285	(error "Need to handle special variables for this version of lisp")	287	(error "Need to handle special variables for this version of lisp")
Lines 310-323 Link Here
310	(namestring (working-directory))))	312	(namestring (working-directory))))
311	nil)	313	nil)
312		314
313	#+(or gcl cmu sbcl)	315	#+(or gcl cmu)
314	(defun working-directory ()	316	(defun working-directory ()
315	(pathname (nth-value 1 (unix:unix-current-directory))))	317	(pathname (nth-value 1 (unix:unix-current-directory))))
316		318
317	#+(or gcl cmu sbcl)	319	#+(or gcl cmu)
318	(defun set-working-directory (dir)	320	(defun set-working-directory (dir)
319	(unix:unix-chdir (namestring dir)))	321	(unix:unix-chdir (namestring dir)))
320		322
		323	#+sbcl
		324	(defun working-directory ()
		325	(make-pathname :directory (sb-posix:getcwd)))
		326
		327	#+sbcl
		328	(defun set-working-directory (dir)
		329	(sb-posix:chdir dir))
		330
321	#+allegro	331	#+allegro
322	(defun working-directory ()	332	(defun working-directory ()
323	(excl:current-directory))	333	(excl:current-directory))
Lines 334-343 Link Here
334	(defun environment-variable (string)	344	(defun environment-variable (string)
335	(sys:getenv string))	345	(sys:getenv string))
336		346
337	#+(or cmu sbcl)	347	#+cmu
338	(defun environment-variable (string)	348	(defun environment-variable (string)
339	(tools:getenv string))	349	(tools:getenv string))
340		350
		351	#+sbcl
		352	(defun environment-variable (string)
		353	(sb-posix:getenv string))
		354
341	#+harlequin-common-lisp	355	#+harlequin-common-lisp
342	(defun environment-variable (string)	356	(defun environment-variable (string)
343	;; This didn't work before	357	;; This didn't work before
Lines 370-382 Link Here
370	:show-cmd nil	384	:show-cmd nil
371	:output-stream (open "/dev/null" :direction :output	385	:output-stream (open "/dev/null" :direction :output
372	:if-exists :append)))	386	:if-exists :append)))
373	#+(or cmu sbcl)	387	#+cmu
374	(defun chmod (prot file)	388	(defun chmod (prot file)
375	(extensions:run-program	389	(extensions:run-program
376	"chmod"	390	"chmod"
377	(list prot (namestring file))	391	(list prot (namestring file))
378	:output nil :error nil :wait nil))	392	:output nil :error nil :wait nil))
379		393
		394	#+sbcl
		395	(defun chmod (prot file)
		396	(sb-ext:run-program
		397	"chmod"
		398	(list prot (namestring file))
		399	:output nil :error nil :wait nil))
		400
380	#+gcl	401	#+gcl
381	(defun chmod (prot file)	402	(defun chmod (prot file)
382	(system (format nil "chmod ~a ~a" prot (namestring file))))	403	(system (format nil "chmod ~a ~a" prot (namestring file))))
Lines 605-615 Link Here
605		626
606	(defun shortpath (directory)	627	(defun shortpath (directory)
607	(or (gethash directory shortpath-directories)	628	(or (gethash directory shortpath-directories)
608	(let* ((dirlist (pathname-directory	629	(let* ((realdir (namestring (truename directory)))
		630	(dirlist (pathname-directory
609	(directory-p	631	(directory-p
610	(#+allegro excl:pathname-resolve-symbolic-links	632	#+allegro (excl:pathname-resolve-symbolic-links realdir)
611	#+(or cmu sbcl) unix:unix-resolve-links	633	#+cmu (unix:unix-resolve-links realdir)
612	(namestring (truename directory))))))	634	#-(or allegro cmu) realdir)))
613	(file-info (get-file-info directory))	635	(file-info (get-file-info directory))
614	(result (if (eq (car dirlist) :absolute)	636	(result (if (eq (car dirlist) :absolute)
615	(shortpath* (reverse (cdr dirlist)) file-info)	637	(shortpath* (reverse (cdr dirlist)) file-info)
Lines 2915-2924 Link Here
2915	(defun direct-superclasses (class)	2937	(defun direct-superclasses (class)
2916	(slot-value class 'pcl:class-direct-superclasses))	2938	(slot-value class 'pcl:class-direct-superclasses))
2917		2939
2918	#+(or cmu sbcl)	2940	#+cmu
2919	(defun direct-superclasses (class)	2941	(defun direct-superclasses (class)
2920	(class-direct-superclasses class))	2942	(class-direct-superclasses class))
2921		2943
		2944	#+sbcl
		2945	(defun direct-superclasses (class)
		2946	(sb-mop:class-direct-superclasses class))
		2947
2922	(defun types-of (obj)	2948	(defun types-of (obj)
2923	(let ((types nil))	2949	(let ((types nil))
2924	(labels ((tof (type)	2950	(labels ((tof (type)
Lines 3225-3231 Link Here
3225	(when (compiled-function-p #'pvs-gc-after-hook)	3251	(when (compiled-function-p #'pvs-gc-after-hook)
3226	(setf excl:gc-after-hook #'pvs-gc-after-hook)))	3252	(setf excl:gc-after-hook #'pvs-gc-after-hook)))
3227		3253
3228	#+(or cmu sbcl)	3254	#+cmu
3229	(eval-when (load)	3255	(eval-when (load)
3230	(setf extensions:gc-verbose nil))	3256	(setf extensions:gc-verbose nil))
3231		3257
Lines 4022-4028 Link Here
4022	(every #'(lambda (slot)	4048	(every #'(lambda (slot)
4023	(let ((name (slot-value slot	4049	(let ((name (slot-value slot
4024	'#+allegro excl::name	4050	'#+allegro excl::name
4025	#+(or cmu sbcl) pcl::name)))	4051	#+cmu pcl::name
		4052	#+sbcl sb-pcl::name)))
4026	(equals (slot-value x name) (slot-value y name))))	4053	(equals (slot-value x name) (slot-value y name))))
4027	slots)))	4054	slots)))
4028		4055
Lines 4059-4066 Link Here
4059	#-(or allegro cmu sbcl)	4086	#-(or allegro cmu sbcl)
4060	(error "Need a hash-table for tc-eq for this lisp"))	4087	(error "Need a hash-table for tc-eq for this lisp"))
4061		4088
4062	#+(or cmu sbcl)	4089	#+cmu
4063	(extensions:define-hash-table-test 'tc-eq-test #'tc-eq #'pvs-sxhash)	4090	(extensions:define-hash-table-test 'tc-eq-test #'tc-eq #'pvs-sxhash)
4064	#+(or cmu sbcl)	4091	#+cmu
4065	(extensions:define-hash-table-test 'strong-tc-eq-test	4092	(extensions:define-hash-table-test 'strong-tc-eq-test
4066	#'strong-tc-eq #'pvs-sxhash)	4093	#'strong-tc-eq #'pvs-sxhash)
		4094	#+sbcl
		4095	(sb-int:define-hash-table-test 'tc-eq-test #'tc-eq #'pvs-sxhash)
		4096	#+sbcl
		4097	(sb-int:define-hash-table-test 'strong-tc-eq-test #'strong-tc-eq #'pvs-sxhash)