mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-23 20:05:32 +02:00
rtl-program? -> program?
* libguile/programs.c (scm_program_p): Rename from scm_rtl_program_p. Changes name also from rtl-program? to program?. * libguile/programs.h: * module/ice-9/session.scm: * module/language/tree-il/analyze.scm: * module/statprof.scm: * module/system/repl/command.scm: * module/system/repl/debug.scm: * module/system/vm/coverage.scm: * module/system/vm/disassembler.scm: * module/system/vm/frame.scm: * module/system/vm/program.scm: * module/system/vm/traps.scm: * module/system/xref.scm: Adapt.
This commit is contained in:
Andy Wingo
parent
edba822553
commit
0bd1e9c6a0
13 changed files with 26 additions and 27 deletions
|
|
@ -136,10 +136,10 @@ scm_i_program_print (SCM program, SCM port, scm_print_state *pstate)
|
|||
* Scheme interface
|
||||
*/
|
||||
|
||||
SCM_DEFINE (scm_rtl_program_p, "rtl-program?", 1, 0, 0,
|
||||
SCM_DEFINE (scm_program_p, "program?", 1, 0, 0,
|
||||
(SCM obj),
|
||||
"")
|
||||
#define FUNC_NAME s_scm_rtl_program_p
|
||||
#define FUNC_NAME s_scm_program_p
|
||||
{
|
||||
return scm_from_bool (SCM_PROGRAM_P (obj));
|
||||
}
|
||||
|
|
|
|||
|
|
@ -41,7 +41,7 @@ scm_i_make_program (const scm_t_uint32 *code)
|
|||
}
|
||||
#endif
|
||||
|
||||
SCM_INTERNAL SCM scm_rtl_program_p (SCM obj);
|
||||
SCM_INTERNAL SCM scm_program_p (SCM obj);
|
||||
SCM_INTERNAL SCM scm_rtl_program_code (SCM program);
|
||||
|
||||
SCM_INTERNAL SCM scm_primitive_p (SCM obj);
|
||||
|
|
|
|||
|
|
@ -522,7 +522,7 @@ The alist keys that are currently defined are `required', `optional',
|
|||
(rest . ,rest)))))
|
||||
((procedure-source proc)
|
||||
=> cadr)
|
||||
(((@ (system vm program) rtl-program?) proc)
|
||||
(((@ (system vm program) program?) proc)
|
||||
((@ (system vm program) program-arguments-alist) proc))
|
||||
(else #f)))
|
||||
|
||||
|
|
|
|||
|
|
@ -950,7 +950,7 @@ given `tree-il' element."
|
|||
(or (and (or (null? x) (pair? x))
|
||||
(length x))
|
||||
0))
|
||||
(cond ((rtl-program? proc)
|
||||
(cond ((program? proc)
|
||||
(values (procedure-name proc)
|
||||
(map (lambda (a)
|
||||
(list (length (or (assq-ref a 'required) '()))
|
||||
|
|
|
|||
|
|
@ -217,7 +217,7 @@
|
|||
|
||||
(define (get-call-data proc)
|
||||
(let ((k (cond
|
||||
((rtl-program? proc) (rtl-program-code proc))
|
||||
((program? proc) (rtl-program-code proc))
|
||||
(else proc))))
|
||||
(or (hashv-ref procedure-data k)
|
||||
(let ((call-data (make-call-data proc 0 0 0)))
|
||||
|
|
@ -580,7 +580,7 @@ to @code{statprof-reset} is true."
|
|||
(lambda (a b)
|
||||
(cond
|
||||
((eq? a b))
|
||||
((and (rtl-program? a) (rtl-program? b))
|
||||
((and (program? a) (program? b))
|
||||
(eq? (rtl-program-code a) (rtl-program-code b)))
|
||||
(else
|
||||
#f))))
|
||||
|
|
|
|||
|
|
@ -492,7 +492,7 @@ Run the optimizer on a piece of code and print the result."
|
|||
Disassemble a compiled procedure."
|
||||
(let ((obj (repl-eval repl (repl-parse repl form))))
|
||||
(cond
|
||||
((rtl-program? obj)
|
||||
((program? obj)
|
||||
(disassemble-program obj))
|
||||
((bytevector? obj)
|
||||
(disassemble-image (load-image obj)))
|
||||
|
|
|
|||
|
|
@ -95,7 +95,7 @@
|
|||
|
||||
(format port "~aRegisters:~%" per-line-prefix)
|
||||
(print "ip = #x~x" (frame-instruction-pointer frame))
|
||||
(when (rtl-program? (frame-procedure frame))
|
||||
(when (program? (frame-procedure frame))
|
||||
(let ((code (rtl-program-code (frame-procedure frame))))
|
||||
(format port " (#x~x~@d)" code
|
||||
(- (frame-instruction-pointer frame) code))))
|
||||
|
|
|
|||
|
|
@ -257,7 +257,7 @@ executed."
|
|||
((< val* val)
|
||||
(lp (1+ idx) end))
|
||||
(else elt))))))
|
||||
(and (rtl-program? proc)
|
||||
(and (program? proc)
|
||||
(match (binary-search (data-ip-counts data) car (rtl-program-code proc))
|
||||
(#f 0)
|
||||
((ip . code) code))))
|
||||
|
|
@ -312,7 +312,7 @@ gathered, even if their code was not executed."
|
|||
#;
|
||||
(define (dump-function proc)
|
||||
;; Dump source location and basic coverage data for PROC.
|
||||
(and (or (program? proc) (rtl-program? proc))
|
||||
(and (or (program? proc))
|
||||
(let ((sources (program-sources* data proc)))
|
||||
(and (pair? sources)
|
||||
(let* ((line (source:line-for-user (car sources)))
|
||||
|
|
|
|||
|
|
@ -416,7 +416,7 @@ address of that offset."
|
|||
|
||||
(define* (fold-program-code proc seed program-or-addr #:key raw?)
|
||||
(cond
|
||||
((find-program-debug-info (if (rtl-program? program-or-addr)
|
||||
((find-program-debug-info (if (program? program-or-addr)
|
||||
(rtl-program-code program-or-addr)
|
||||
program-or-addr))
|
||||
=> (lambda (pdi)
|
||||
|
|
|
|||
|
|
@ -88,7 +88,7 @@
|
|||
(cons
|
||||
(or (false-if-exception (procedure-name p)) p)
|
||||
(cond
|
||||
((and (rtl-program? p)
|
||||
((and (program? p)
|
||||
(program-arguments-alist p (frame-instruction-pointer frame)))
|
||||
;; case 1
|
||||
=> (lambda (arguments)
|
||||
|
|
|
|||
|
|
@ -41,7 +41,7 @@
|
|||
program-arguments-alist program-arguments-alists
|
||||
program-lambda-list
|
||||
|
||||
rtl-program? rtl-program-code
|
||||
program? rtl-program-code
|
||||
program-free-variables
|
||||
program-num-free-variables
|
||||
program-free-variable-ref program-free-variable-set!))
|
||||
|
|
@ -51,20 +51,20 @@
|
|||
|
||||
;; These procedures are called by programs.c.
|
||||
(define (rtl-program-name program)
|
||||
(unless (rtl-program? program)
|
||||
(unless (program? program)
|
||||
(error "shouldn't get here"))
|
||||
(and=> (find-program-debug-info (rtl-program-code program))
|
||||
program-debug-info-name))
|
||||
(define (rtl-program-documentation program)
|
||||
(unless (rtl-program? program)
|
||||
(unless (program? program)
|
||||
(error "shouldn't get here"))
|
||||
(find-program-docstring (rtl-program-code program)))
|
||||
(define (rtl-program-minimum-arity program)
|
||||
(unless (rtl-program? program)
|
||||
(unless (program? program)
|
||||
(error "shouldn't get here"))
|
||||
(program-minimum-arity (rtl-program-code program)))
|
||||
(define (rtl-program-properties program)
|
||||
(unless (rtl-program? program)
|
||||
(unless (program? program)
|
||||
(error "shouldn't get here"))
|
||||
(find-program-properties (rtl-program-code program)))
|
||||
|
||||
|
|
@ -257,7 +257,7 @@
|
|||
(arity->arguments-alist
|
||||
prog
|
||||
(list 0 0 nreq nopt rest? '(#f . ()))))))))
|
||||
((rtl-program? prog)
|
||||
((program? prog)
|
||||
(or-map (lambda (arity)
|
||||
(and (or (not ip)
|
||||
(and (<= (arity-low-pc arity) ip)
|
||||
|
|
@ -305,7 +305,7 @@ lists."
|
|||
(list 0 0 nreq nopt rest? '(#f . ())))))))
|
||||
(cond
|
||||
((primitive? prog) (fallback))
|
||||
((rtl-program? prog)
|
||||
((program? prog)
|
||||
(let ((arities (find-program-arities (rtl-program-code prog))))
|
||||
(if arities
|
||||
(map arity-arguments-alist arities)
|
||||
|
|
|
|||
|
|
@ -115,7 +115,7 @@
|
|||
|
||||
(define (frame-matcher proc match-code?)
|
||||
(if match-code?
|
||||
(if (rtl-program? proc)
|
||||
(if (program? proc)
|
||||
(let ((start (rtl-program-code proc))
|
||||
(end (program-last-ip proc)))
|
||||
(lambda (frame)
|
||||
|
|
@ -317,7 +317,7 @@
|
|||
|
||||
(define (program-sources-by-line proc file)
|
||||
(cond
|
||||
((rtl-program? proc)
|
||||
((program? proc)
|
||||
(let ((code (rtl-program-code proc)))
|
||||
(let lp ((sources (program-sources proc))
|
||||
(out '()))
|
||||
|
|
|
|||
|
|
@ -35,12 +35,12 @@
|
|||
(define (nested-procedures prog)
|
||||
(define (cons-uniq x y)
|
||||
(if (memq x y) y (cons x y)))
|
||||
(if (rtl-program? prog)
|
||||
(if (program? prog)
|
||||
(reverse
|
||||
(fold-program-code (lambda (elt out)
|
||||
(match elt
|
||||
(('static-ref dst proc)
|
||||
(if (rtl-program? proc)
|
||||
(if (program? proc)
|
||||
(fold cons-uniq
|
||||
(cons proc out)
|
||||
(nested-procedures prog))
|
||||
|
|
@ -79,7 +79,7 @@
|
|||
|
||||
(define (procedure-callee-rev-vars proc)
|
||||
(cond
|
||||
((rtl-program? proc) (program-callee-rev-vars proc))
|
||||
((program? proc) (program-callee-rev-vars proc))
|
||||
(else '())))
|
||||
|
||||
(define (procedure-callees prog)
|
||||
|
|
@ -201,8 +201,7 @@ pair of the form (module-name . variable-name), "
|
|||
;; ((ip file line . col) ...)
|
||||
(define (procedure-sources proc)
|
||||
(cond
|
||||
((or (rtl-program? proc) (program? proc))
|
||||
(program-sources proc))
|
||||
((program? proc) (program-sources proc))
|
||||
(else '())))
|
||||
|
||||
;; file -> line -> (proc ...)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue