;----------- macros for the compiler -------------
(setq sectioncamacsid "@(#)camacs.l 5.4 5/13/81") ; id for SCCS
; Copyright (c) 1980 , The Regents of the University of California.
(declare (macros t)) ; compile and save macros
; these are the compiler message producing macros. The form is
; (comp-xxxx val1 val2 val3 ... valn) , all values are printed according
; to this scheme. If vali is an atom, it is patomed, if vali is a
; list, it is evaluated and printed. If vali is N a newline is printed
; the name of the current function is printed first
; after comp-err prints the message, it does a throw to Comp-err .
; errors are preceeded by Error:
; warnings by %Warning: and
; The message is sent to the message file
`(progn (comp-msg "?Error: " v-ifile ": " g-fname ": "
(setq er-fatal (1+ er-fatal))
(throw nil Comp-error))))
(comp-msg "%Warning: " v-ifile ": " g-fname ": "
(comp-msg "%Note: " v-ifile ": " ,@(cdr l)))))))
"?Error: " v-ifile ": " g-fname ": ",@(cdr l))
(setq er-fatal (1+ er-fatal)))))
; prints the lst to the given port. The lst is printed in the manner
; described above, that is atoms are patomed, and lists are evaluated
; and printed, and N prints a newline. The output is always drained.
(do ((xx (cdr lis) (cdr xx))
`(progn ,@(nreverse (cons '(terpri) res))))
(cons (cond ((atom (car xx))
(cond ((eq (car xx) 'N) '(terpr))
((stringp (car xx)) `(patom ,(car xx)))
(t `(niceprint ,(car xx)))))
(t `(niceprint ,(car xx))))
`((lambda (float-format) (patom ,(cadr l))) "%.2f")))
(prog (majlis minlis revl)
(do ((revl (reverse lis) (cdr revl)))
(cond ((eq (car revl) 'else)
(setq majlis `((t ,@minlis) ,@majlis)
((or (eq (car revl) 'then) (eq (car revl) 'thenret))
majlis `((,(car revl) ,@minlis) ,@majlis)
((eq (car revl) 'elseif))
(setq majlis `(cond ,@majlis)))
(t (setq minlis `( ,(car revl) ,@minlis)))))
; we displace the previous macro, that is we actually replace
; the if list structure with the corresponding cond, meaning
; that the expansion is done only once
(rplaca lis (car majlis))
(rplacd lis (cdr majlis))
; (Push stackname valuetoadd)
`(setq ,atm (cons ,val ,atm)))
`(prog1 (car ,val) (setq ,val (cdr ,val))))
;--- unpush macro - like pop except top value is thrown away
;--- and an increment macro
(defmacro makecomment (arg)
`(cond (fl-comments (setq g-comments (cons ,arg g-comments)))))
;--- add a comment irregardless of the fl-comments flag
(defmacro forcecomment (arg)
`(setq g-comments (cons ,arg g-comments)))
;--- write to the .s file
(defmacro sfilewrite (arg)
(putprop 'camacs t 'version) ; flag that this file has been loaded