Changeset 13084


Ignore:
Timestamp:
Oct 22, 2009, 6:53:29 PM (10 years ago)
Author:
gz
Message:

add core-all-processes, core-process-name, core-list

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711/ccl/library/core-files.lisp

    r13071 r13084  
    2727          core-uvtype core-uvtypep core-uvref core-uvsize
    2828          core-car core-cdr core-object-type core-istruct-type
    29           copy-from-core
     29          copy-from-core core-list
    3030          core-keyword-package core-find-package core-find-symbol
    3131          core-package-names core-package-name
     
    3636          core-find-class
    3737          core-instance-class-name
    38           core-string-equal))
     38          core-string-equal
     39          core-all-processes core-process-name
     40          ))
    3941
    4042;; The intended way to use these facilities is to open up a particular core file once,
     
    835837
    836838
     839(defun core-list (ptr)
     840  (let ((cars (loop while (core-consp ptr)
     841                    collect (core-car ptr)
     842                    do (setq ptr (core-cdr ptr)))))
     843    (if (core-nullp ptr)
     844      cars
     845      (nconc cars ptr))))
     846
     847(defun core-all-processes ()
     848  (let* ((sym (core-find-symbol 'all-processes))
     849         (closure (core-uvref sym target::symbol.fcell-cell))
     850         (imm-start (core-l (logandc2 closure target::fulltagmask) target::node-size))
     851         (imm-end (core-uvsize closure))
     852         (vcell (loop for idx from (1+ imm-start) below imm-end as imm = (core-uvref closure idx)
     853                      when (core-uvtypep imm :value-cell) return imm))
     854         (val (core-uvref vcell target::value-cell.value-cell))
     855         (processes (core-list val)))
     856    processes))
     857
     858(defun core-process-name (proc)
     859  (assert (core-uvtypep proc :instance))
     860  (let ((slots (core-uvref proc ccl::instance.slots)))
     861    (copy-from-core (core-uvref slots 1) :depth 1)))
     862
     863(defun core-process-tcr (proc)
     864  (assert (core-uvtypep proc :instance))
     865  (let* ((slots (core-uvref proc ccl::instance.slots))
     866         (thread (core-uvref slots 2)))
     867    (core-uvref thread ccl::lisp-thread.tcr)))
    837868
    838869) ; :x8664-target
Note: See TracChangeset for help on using the changeset viewer.