;;; -*- Mode:Common-Lisp; Package:MACTOOLBOX; Base:10; Patch-file:T -*-
;;; Written 11/28/88 10:33:43 by JONES,
;;; Reason: Correct patch 1.19.
;;; while running on HOBBS from band LOD1
;;; With SYSTEM 5.17, GC 5.3, VIRTUAL-MEMORY 5.5, MICRONET 5.5, MICRONET-COMM 5.11,
;;;  DISK-IO 5.8, BASIC-PATHNAME 5.2, MAC-PATHNAME 5.0, NETWORK-SUPPORT-COLD 5.1,
;;;  BASIC-NAMESPACE 5.5, BASIC-FILE 5.3, RPC 5.4, NFS 5.8, EH 5.2, MAKE-SYSTEM 5.1,
;;;  MEMORY-AUX 5.1, MACTOOLBOX 1.20, COMPILER 5.1, TV 5.15, NVRAM 5.1, UCL 5.0, INPUT-EDITOR 5.0,
;;;  METER 5.0, ZWEI 5.8, DEBUG-TOOLS 5.0, WINDOW-MX 5.24, PRINTER 5.10, MAC-PRINTER-TYPES 5.2,
;;;  NETWORK-PATHNAME 5.0, NETWORK-NAMESPACE 5.0, DATALINK 5.6, CHAOSNET 5.4, NETWORK-SUPPORT 5.0,
;;;  NETWORK-SERVICE 5.0, DATALINK-DISPLAYS 5.0, NAMESPACE-EDITOR 5.1, IP 3.32, NFS-SERVER 5.3,
;;;  PRINTER-TYPES 5.2, IMAGEN 5.1, MAIL-DAEMON 5.1, MAIL-READER 5.3, TELNET 5.0,
;;;  VT100 5.0, STREAMER-TAPE 5.6, DECNET 1.40, VISIDOC 5.4, PROFILE 5.1, DISK-LABEL 5.1,
;;;   microcode 92, Band Name: nb04*1



(eval-when (compile)
  (loop
    (cond ((fboundp 'create-mac-traps)
	   (return))
	  (t
	   (compiler-let ((compiler:warn-on-errors nil)) 
	     (cerror "Make the system and try again" "You must make the system BUILD-TRAP-TABLE before attempting to compile this file."))))))

#!C
; From file EXPER-TB-DATATYPES.LISP#> TOOLBOX-INTERFACE; SYS:
#10R MACTOOLBOX#:
(COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "MACTOOLBOX"))
                          (SI:*LISP-MODE* :Common-lisp)
                          (*READTABLE* Sys:Common-lisp-readtable)
                          (SI:*READER-SYMBOL-SUBSTITUTIONS* Sys::*common-lisp-symbol-substitutions*))
  (COMPILER#:PATCH-SOURCE-FILE "SYS: TOOLBOX-INTERFACE; EXPER-TB-DATATYPES.É#É"

(eval-when (compile)

(defmacro rTERecType (acb acb-index trap-table-index)
  (declare (ignore trap-table-index))
  (let ((index (floor acb-index 4)))
    `(make-instance-no-init 'terec :handle (parm-32b ,acb ,index))
    ))

(setf (get 'rTERecType :sizeof) 4)
(setf (get 'rTERecType :pretty-arg-name) "TERec-inst")
)))

#!C
; From file EXPER-TB-MACROS.LISP#> TOOLBOX-INTERFACE; HEYERDAHL:
#10R MACTOOLBOX#:
(COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "MACTOOLBOX"))
                          (SI:*LISP-MODE* :Common-lisp)
                          (*READTABLE* Sys:Common-lisp-readtable)
                          (SI:*READER-SYMBOL-SUBSTITUTIONS* Sys::*common-lisp-symbol-substitutions*))
  (COMPILER#:PATCH-SOURCE-FILE "Sys: TOOLBOX-INTERFACE; EXPER-TB-MACROS.É#É"


(eval-when (compile)
(defvar *initial-trap-index* 0 "The Mac side table index for the first trap in *trap-table*")

(defmacro generate-trap (trap-table-index)
  (let ((byte-offset 4))
    `(defun ,(intern (string-upcase (trap-name trap-table-index)) 'tb)
	    ,(loop for i from 1 to (trap-nargs trap-table-index)
		   collect (trap-arg-name trap-table-index i))
            (declare (arglist
		       ,@(loop for i from 1 to (trap-nargs trap-table-index)
			      collect (trap-arg-pretty-name trap-table-index i)))
		     (values ,(trap-return-pretty-name trap-table-index)))
       (let ((acb (get-acb-fast ,(acb-size-needed trap-table-index))))
	 
	 ;; opcode 0 is a trap call, >0 are control calls.
	 (setf (add:opcode acb) 0)
	 
	 ;; Only set requestor complete if there is no return value or VAR arg.
	 ,(cond ((not (trap-wait-for-values trap-table-index))
		 `(setf (requestor-complete acb) t)))
	 
	 (setf (parm-32b acb 0) ,(+ trap-table-index *initial-trap-index*))
	 
	 ;; Each of the data type macros takes:
	 ;;  1) arg name
	 ;;  2) acb
	 ;;  3) byte offset into acb of where to put the arg

	 ,(cons 'progn
		(loop for i from 1 to (trap-nargs trap-table-index)
		      collect `(,(trap-arg-type trap-table-index i)
				,(trap-arg-name trap-table-index i)
				      acb
				      ,byte-offset)
		      do (setf byte-offset
			       (+ byte-offset
				  (sizeof (trap-arg-type trap-table-index i))))))

	 ,(cond ((not (trap-wait-for-values trap-table-index))
		 `(tb-transmit-packet acb))
		(t `(tb-transmit-packet-and-wait acb)))

	 ,(cond	((var-args? trap-table-index)
		 ;; Start over at the first arg.
		 (setf byte-offset 4)
		 (cons 'progn
			(loop for i from 1 to (trap-nargs trap-table-index)
			      when (var-arg-p trap-table-index i)
			      collect `(,(trap-arg-type trap-table-index i)
				       ,(trap-arg-name trap-table-index i)
				       acb
				       ,byte-offset
				       :return)
			     do (setf byte-offset
				      (+ byte-offset
					 (sizeof (trap-arg-type trap-table-index i)
						 )))))))
	 ,(cond ((trap-wait-for-values trap-table-index)
		 `(multiple-value-prog1
		    (,(trap-return-type trap-table-index)
		      acb
		      ,byte-offset
		      ,trap-table-index)		    
		    
		    ,(when (trap-signal-low-mem-error trap-table-index)
		       (setq byte-offset
			   (+ byte-offset
			      (sizeof (trap-return-type trap-table-index))))
		       
		       (let ((index (floor byte-offset 4)))
			 `(when *Signal-mac-oserr*
			    (signal-oserr (signed-ldb 16 (parm-32b acb ,index))
					  ',(trap-symbol trap-table-index)))))
		    (setf (requestor-complete acb) t)
		    (return-acb-fast acb)))
		((eq (trap-return-type trap-table-index) 'rDontCare)
		 T ;return just T for a dont care
		 ))

	 )))))
))

(compiler-let ((*initial-trap-index* 435)
      (*trap-table*
	'((#xA9D2 
	   nil 
	   nil 
	   rTERectype
	   (
	    Recttype 
	    Recttype
	    ) 
	   "!TENew"))))
  
  (create-mac-traps)
  
  
  (mapc
    #'(lambda (name-&-arglist)
	(let* ((trap-symbol (find-symbol (first name-&-arglist) 'MACTOOLBOX))
	       (debug-info  (and (fboundp trap-symbol)
				 (sys:get-debug-info-struct trap-symbol)))
	       (arglist     () )
	       (descriptive-arglist (rest name-&-arglist)))
	  (when debug-info
	    ;; then this is a function with a SYS:DEBUG-INFO-STRUCT, so update it
	    (setf arglist (sys:dbi-arglist debug-info))
	    (when (/= (length arglist) (length descriptive-arglist))
	      (warn "~2%WARNING: The original arglist of ~a:~
                   ~%    ~A~
                   ~%is not the same length as its new descriptive arglist:~
                   ~%    ~A" trap-symbol arglist descriptive-arglist))
	    (setf (getf (sys:dbi-plist debug-info) :descriptive-arglist)
		  descriptive-arglist))))
    ;; NOTE:  Trap name strings should be written with the same capitalization as they
    ;; function names were defined with.
    '(("!TENEW" |destRect| |viewRect|))))

(compiler-let ((*initial-trap-index* 663)
      (*trap-table*
	'(
	  ;;/*  SetMCEntries					*/
	  
	  (#xAA65 
	   mac2 
	   3 
	   rDontcare 
	   (
	    intType 
	    ptrType
	    ) 
	   "!SetMCEntries"))))
  
  (create-mac-traps)
  
  
  (mapc
    #'(lambda (name-&-arglist)
	(let* ((trap-symbol (find-symbol (first name-&-arglist) 'MACTOOLBOX))
	       (debug-info  (and (fboundp trap-symbol)
				 (sys:get-debug-info-struct trap-symbol)))
	       (arglist     () )
	       (descriptive-arglist (rest name-&-arglist)))
	  (when debug-info
	    ;; then this is a function with a SYS:DEBUG-INFO-STRUCT, so update it
	    (setf arglist (sys:dbi-arglist debug-info))
	    (when (/= (length arglist) (length descriptive-arglist))
	      (warn "~2%WARNING: The original arglist of ~a:~
                   ~%    ~A~
                   ~%is not the same length as its new descriptive arglist:~
                   ~%    ~A" trap-symbol arglist descriptive-arglist))
	    (setf (getf (sys:dbi-plist debug-info) :descriptive-arglist)
		  descriptive-arglist))))
    ;; NOTE:  Trap name strings should be written with the same capitalization as they
    ;; function names were defined with.
    '(("!SETMCENTRIES" |numEntries| |menuCEntries|))))


