;;; -*- Mode: LISP; Package: USER; Base: 10 -*- ;;; $Header: /ct/debug/nodenum.l,v 1.8 85/06/21 12:26:00 bill Exp $ (putprop 'nodenum "$Revision: 1.8 $" 'rcs_revision) ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; ;;; nodenum.l ;;; ;;; ;;; ;;; William Brew 9-14-83 ;;; ;;; ;;; ;;; Perform mapping between diana nodes and small integers. ;;; ;;; ;;; ;;; This file is part of a proprietary software project. Source ;;; ;;; code and documentation describing implementation details are ;;; ;;; available on a confidential, non-disclosure basis only. These ;;; ;;; materials, including this file in particular, are trade secrets ;;; ;;; of Computer * Thought Corporation. ;;; ;;; ;;; ;;; (c) Copyright 1982 and 1983, Computer * Thought Corporation. ;;; ;;; All Rights Reserved. ;;; ;;; ;;; ;;; Reference materials: ;;; ;;; Foderaro and Sklower, The FRANZ LISP Manual, September 1981. ;;; ;;; Weinreb and Moon, LISP MACHINE MANUAL, Symbolics, July 1981. ;;; ;;; Charniak et al., 1980. Artificial Intelligence Programming. ;;; ;;; Miller, 1982. The C*T Ada Tutor: Guide to the Implementation. ;;; ;;; ;;; ;;; The following code assumes familiarity with these materials. ;;; ;;; ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Ensure presence of needed files. (comment Assumes ct_load and some suitable file_map are present) (eval-when (compile load eval) (ct_load 'aip)) ;AIP macros pkg. (eval-when (compile load eval) (ct_load 'compat)) ;Franz/LM compat pkg. (eval-when (compile load eval) (ct_load 'dbutils)) ;Debugger utilities (eval-when (compile load eval) (ct_load 'diana)) ;Diana utilities ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Compiler Declarations and Global Variables -- #+franz (declare (macros t)) #+franz (setq *flavor-expand-macros* t) (defvar *db%node_num_map* nil "An alist which associates a node with a node_num record." ) (defconst *db%node_num_count* 99 "The number of diana nodes which may be numbered." ) ; A record for the value associated with "a number" (def_record_type db%node_num_rec nil (num . acc_list)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Macro definitions -- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Flavor definitions -- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Externally Callable Functions/Methods -- ; ; The node num utilities are used by the debugger to map diana nodes which are ; being monitored into some small integer. The integer is used when we have ; to generate a name for the tag associated with the monitor. ; ; The node num utilities are used to form associations between some object ; (in this case a diana node (usually)) and an pool of integers. When the ; association is formed, a tag is also associated with the object and is ; put on the access list of the association. If an association with the ; object is again requested, we return the same integer and just add the ; tag to the association list. When freeing up associations, we look to make ; sure there really is a valid association. If so then remove the tag from the ; access list. If the access list becomes nil then we completly break the ; association between the object and the number. ; ; ; Initialize the node num module ; (defun db%init_nodenum () nil) ; ; Startup the node num map. Loop the appropriate number of times and ; build a list of dotted pairs of the form (nil . (db%node_num_rec num nil)). ; (defun db%start_nodenum () (setq *db%node_num_map* (loop for i from 0 to *db%node_num_count* collect `(nil . ,(db%node_num_rec i nil))))) ; ; Get a new node number. First look to see if there is an association between ; the node and a number already. If not then try for a free number. If we ; find a slot then fill in the appropriate values i.e., associate the node ; with the slot and put the tag on the access list. If we couldn't find a slot ; then try for a ct_id. If still no luck then generate a symbol. ; (defun db%get_node_num (node tag) (let ((it (or (assq node *db%node_num_map*) (assq nil *db%node_num_map*))) acc_list) (cond (it (%= (car it) node) (cond ((not (memq tag (setq acc_list (db%node_num_rec%acc_list (cdr it))))) (%= (db%node_num_rec%acc_list (cdr it)) (cons tag acc_list)))) (db%node_num_rec%num (cdr it))) ((diana_nodep node) (diana_get node 'ct_id)) (t (gensym))))) ; ; Return a number to the pool (maybe). Look to see if the node is associated ; with a slot. If no association or the tag isn't on the access list if we ; did find a slot then this isn't really a valid association. Otherwise, ; delete the tag from the access list. If the list becomes nil then free the ; slot by setting the node to nil. Return the length of the access list. ; (defun db%return_node_num (node tag) (let* ((it (assq node *db%node_num_map*)) (acc_list (db%node_num_rec%acc_list (cdr it)))) (cond ((or (null it) (not (memq tag acc_list))) nil) ((null (setq acc_list (delq tag acc_list))) (%= (db%node_num_rec%acc_list (cdr it)) acc_list) (%= (car it) nil) (length acc_list))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Internal Use Only Functions/Methods -- ;;; eof ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;