/[gcl]/gcl/cmpnew/gcl_cmpbind.lsp
ViewVC logotype

Diff of /gcl/cmpnew/gcl_cmpbind.lsp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.3 by camm, Mon Dec 1 17:00:52 2003 UTC revision 1.4 by camm, Fri Jul 8 06:02:47 2005 UTC
# Line 1  Line 1 
1    ;;-*-Lisp-*-
2  ;;; CMPBIND  Variable Binding.  ;;; CMPBIND  Variable Binding.
3  ;;;  ;;;
4  ;; Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa  ;; Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa
# Line 85  Line 86 
86           (let ((*inline-blocks* 0) (*restore-avma* *restore-avma*))           (let ((*inline-blocks* 0) (*restore-avma* *restore-avma*))
87             (save-avma '(nil integer))             (save-avma '(nil integer))
88             (wt-nl "V" (var-loc var) "= ")             (wt-nl "V" (var-loc var) "= ")
89             (wt-integer-loc loc var)             (wt-integer-loc loc)
90             (wt ";")             (wt ";")
91             (close-inline-blocks)))             (close-inline-blocks)))
92          (t          (t
93           (wt-nl "V" (var-loc var) "= ")           (wt-nl "V" (var-loc var) "= ")
94           (case (var-kind var)           (let ((wtf (cdr (assoc (var-kind var) +wt-loc-alist+))))
95                 (OBJECT (wt-loc loc))            (unless wtf (baboon))
96                 (FIXNUM (wt-fixnum-loc loc))            (funcall wtf loc))
97                 (CHARACTER (wt-character-loc loc))           (wt ";"))))
                (LONG-FLOAT (wt-long-float-loc loc))  
                (SHORT-FLOAT (wt-short-float-loc loc))  
                (t (baboon)))  
          (wt ";")))  
   )  
98    
99  (defun c2bind-init (var init)  (defun c2bind-init (var init)
100    (case (var-kind var)    (case (var-kind var)
# Line 121  Line 117 
117          (DOWN          (DOWN
118            (let ((*value-to-go* (list 'down (var-loc var))))            (let ((*value-to-go* (list 'down (var-loc var))))
119              (c2expr* init)))              (c2expr* init)))
120          ((OBJECT FIXNUM CHARACTER LONG-FLOAT SHORT-FLOAT INTEGER)          (t
121             (unless (assoc (var-kind var) +wt-loc-alist+)
122               (baboon))
123           (let ((*value-to-go* (list 'var var nil)))           (let ((*value-to-go* (list 'var var nil)))
124                (c2expr* init)))             (c2expr* init)))))
         (t (baboon)))  
   )  
125    
126  (defun set-bds-bind (loc vv)  (defun set-bds-bind (loc vv)
127         (wt-nl "bds_bind(VV[" vv "]," loc ");"))         (wt-nl "bds_bind(VV[" vv "]," loc ");"))

Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26