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

Diff of /gcl/cmpnew/cmptop.lsp

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

revision 1.3 by camm, Sat Jul 20 07:10:55 2002 UTC revision 1.4 by camm, Fri Aug 2 22:23:58 2002 UTC
# Line 214  Line 214 
214             )))             )))
215    )    )
216    
217    (defun declaration-type (type)
218      (cond ((equal type "") "void")
219            ((equal type "long ") "object ")
220            (t type)))
221    
222  (defvar *vaddress-list*)   ;; hold addresses of C functions, and other data  (defvar *vaddress-list*)   ;; hold addresses of C functions, and other data
223  (defvar *vind*)            ;; index in the VV array where the address is.  (defvar *vind*)            ;; index in the VV array where the address is.
224  (defvar *Inits*)  (defvar *Inits*)
# Line 315  Line 320 
320                    (t                    (t
321                     (setq type (if type (Rep-type type) ""))))                     (setq type (if type (Rep-type type) ""))))
322    
323              (wt-h "static " (if (equal type "") "void" type) " LnkT" num "() ;") ;initial function.              (wt-h "static " (declaration-type type) " LnkT" num "() ;") ;initial function.
324     #-sgi3d    (wt-h "static "  (if (equal type "") "void" type) " (*Lnk" num ")() = LnkT" num ";")     #-sgi3d    (wt-h "static "  (declaration-type type) " (*Lnk" num ")() = LnkT" num ";")
325     #+sgi3d    (wt-h "static "  (if (equal type "") "void" type) " (*Lnk" num ")();")))     #+sgi3d    (wt-h "static "  (declaration-type type) " (*Lnk" num ")();")))
326    )    )
327    
328    
# Line 695  Line 700 
700                     )                     )
701               (setf (var-loc (car vl)) (next-cvar)))               (setf (var-loc (car vl)) (next-cvar)))
702           (wt-comment "local entry for function " fname)           (wt-comment "local entry for function " fname)
703           (wt-h "static " (rep-type (caddr inline-info)) "LI" cfun "();")           (wt-h "static " (declaration-type (rep-type (caddr inline-info))) "LI" cfun "();")
704           (wt-nl1 "static " (rep-type (caddr inline-info)) "LI" cfun "(")           (wt-nl1 "static " (declaration-type (rep-type (caddr inline-info))) "LI" cfun "(")
705           (wt-requireds  requireds           (wt-requireds  requireds
706                         (cadr inline-info))                         (cadr inline-info))
707           ;;; Now the body.           ;;; Now the body.
# Line 1426  Line 1431 
1431                 (wt-nl1 "vs_push(")                 (wt-nl1 "vs_push(")
1432                 (case (car arg)                 (case (car arg)
1433                       (object (wt (cadr arg)))                       (object (wt (cadr arg)))
1434                       (char (wt "code_char((int)" (cadr arg) ")"))                       (char (wt "code_char((long)" (cadr arg) ")"))
1435                       (int (when (zerop *space*) (wt "CMP"))                       (int (when (zerop *space*) (wt "CMP"))
1436                            (wt "make_fixnum((int)" (cadr arg) ")"))                            (wt "make_fixnum((long)" (cadr arg) ")"))
1437                       (float (wt "make_shortfloat((double)" (cadr arg) ")"))                       (float (wt "make_shortfloat((double)" (cadr arg) ")"))
1438                       (double (wt "make_longfloat((double)" (cadr arg) ")")))                       (double (wt "make_longfloat((double)" (cadr arg) ")")))
1439                 (wt ");"))                 (wt ");"))

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