;; -*- mode:lisp;package:user;base:10.;fonts:(cptfontb) -*- 
;;; $Header: /ct/interp/adabe.l,v 1.3 83/12/09 13:03:55 penny Exp $
;;; $Log:	/ct/interp/adabe.l,v $
;;;Revision 1.3  83/12/09  13:03:55  penny
;;;tried to modify to compile with flavors
;;;
;;;Revision 1.2  83/12/07  17:34:02  penny
;;;added the ctincludef of intrpdcl
;;;
;;;Revision 1.1  83/12/07  17:20:45  penny
;;;Initial revision
;;;
;;;
;;; Hacked 15 August 1985 Richard Mark Soley for Lambda port


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;                             ADABE                                ;;;
;;; Penny Muncaster-Jewell                                  7-Dec-83 ;;;
;;; See last page for edit history.                                  ;;;
;;;								     ;;;
;;;          The adabe_activation of the C*T Ada Interpreter         ;;;
;;;                                                                  ;;;
;;;   Initializes an activation record, tree walks the Diana S-expr, ;;;
;;; and so on, supporting the Dynamic Semantic Functions.  Similar   ;;;
;;; in flavor to a micro-code engine, with specials serving a role   ;;;
;;; analogous to the hardware machine registers.                     ;;;
;;;                                                                  ;;;
;;; 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. ;;;
;;;   Tartan Labs, 1982.  The Diana Reference Manual.                ;;;
;;;   Robertson & Miller, 1982.  The C*T Diana Virtual Machine.      ;;;
;;; The following code assumes familiarity with these materials.     ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Ensure presence of needed files. 

(comment Assumes presence of ct_load and a suitable database)

(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 'diana))   ;;Diana internal rep.

#+franz
(eval-when (compile load eval) (ct_load 'format))  ;;Compatible formatted IO.

(eval-when (compile load eval) (ct_load 'ctio))

(eval-when (compile load eval) (ct_load 'ctflav)) ;;LM-compat flavors

(eval-when (compile load eval) (ct_load 'ferec))  ;;Nodestagerec,Exceptionrec
#+franz (declare (macros t))
(declare (ct_includef 'intrpdcl))

 ;;;(record_type adabe_activation  ()
 ;;; An activation record includes the "pc" or Diana node being executed,
 ;;;   the "node" (or "code") over which the pc is operating,
 ;;;   the access link (pointer to parent static environment)
 ;;;   the control link (pointer to parent dynamic environment)
 ;;;   the nodestages field (see above)
 ;;;   the optional enhook (a functional hook of 1 arg, pc, to run on entry)
 ;;;   the optional exhook (a functional hook of arg, pc, to run on exit)
 ;;;   and an a-list of vars local to this record (including formals,
 ;;;   locals, etc.)
 ;;;	     (pc node alink clink nodestages enhook exhook . locals))

(ct_defflavor adabe_activation 	       ;;jrm change

 ;;; An activation record includes:
 ;;;   the "pc" or Diana node being executed,
 ;;;   the "node" (or "code") over which the pc is operating,
 ;;;   the access link (pointer to parent static environment)
 ;;;   the control link (pointer to parent dynamic environment)
 ;;;   the nodestages field (see above)
 ;;;   the taskinstance in which it resides
 ;;;   the procedure nesting level of this activation record
 ;;;   the optional enhook (a functional hook of 1 arg, pc, to run on entry)
 ;;;   the optional exhook (a functional hook of arg, pc, to run on exit)
 ;;;   and an a-list of vars local to this record (including formals,
 ;;;   locals, etc.)

    (pc node alink clink nodestages taskinstance pnl arid enhook exhook locals)
    ()
    #+Lispm (:special-instance-variables pc)
    :gettable-instance-variables
    :settable-instance-variables)

;
; Pretty print an activation record. Formats a string or stream.
; Subsequent lines tell the values of the
; locals for this activation. wab
; 

(ct_defmethod (adabe_activation printself) (stream)
    (let ((strings
	    (loop for (dnode . instance) in locals
		  collect (ct_format stream "~15x~a = ~a~%"
				     (maknam
				       (second
					 (diana_get dnode 'lx_symrep)))
				     (ct_if (get-handler-for instance 'printself)
					    (ct_send instance 'printself nil)
					    "<can't printself yet>"
					    )
				     )
		  )
	    )
	  )
      (cond (stream nil)
	    ((null strings) "")
	    (t (apply 'string-append strings))
	    )
      )
)