;;; -*- Mode: Common-Lisp; Package: User; Base: 10.; Patch-File: T -*- ;;; Written 02/09/90 16:34:44 by MARKY, ;;; Reason: Patch to correct acb deallocation for MAC-STRING-TO-MX-STRING ;;; and initialize data-size for :mac-to-mac case in BLOCK-MOVE. ;;; while running on RAMP-4 from band bas4 ;;; With SYSTEM 6.29, GC 6.3, VIRTUAL-MEMORY 6.2, MICRONET 6.0, MICRONET-COMM 6.1, ;;; DISK-IO 6.1, DISK-LABEL 6.0, BASIC-PATHNAME 6.2, MAC-PATHNAME 6.0, NETWORK-SUPPORT-COLD 6.2, ;;; BASIC-NAMESPACE 6.7, BASIC-FILE 6.6, RPC 6.2, NFS-MX 6.4, EH 6.5, MAKE-SYSTEM 6.2, ;;; MEMORY-AUX 6.0, COMPILER 6.14, TV 6.19, NVRAM 6.2, UCL 6.0, INPUT-EDITOR 6.0, ;;; Inconsistent MACTOOLBOX 2.12, METER 6.1, ZWEI 6.8, DEBUG-TOOLS 6.3, WINDOW-MX 6.9, ;;; PRINTER 6.3, MAC-PRINTER-TYPES 6.1, CLIPBOARD 6.1, TI-CLOS 6.26, CLEH 6.5, NETWORK-PATHNAME 6.0, ;;; NETWORK-NAMESPACE 6.0, DATALINK 6.0, CHAOSNET 6.5, NETWORK-SUPPORT 6.0, NETWORK-SERVICE 6.2, ;;; DATALINK-DISPLAYS 6.0, MX-DATALINK 6.1, NAMESPACE-EDITOR 6.4, IP 3.56, NFS-MX-SERVER 6.0, ;;; MX-SERIAL 6.1, PRINTER-TYPES 6.2, IMAGEN 6.1, MAIL-DAEMON 6.3, MAIL-READER 6.6, ;;; TELNET 6.0, VT100 6.0, STREAMER-TAPE 6.5, DECNET 1.70, VISIDOC 6.5, PROFILE 6.2, ;;; Experimental ACTION 2.0, Experimental SNRL 4.0, Experimental SNRL-ADD-ONS 1.0, ;;; Experimental QUERY 1.0, Experimental SST-WINDOWS 1.0, Experimental CONFLICT-RESOLUTION 40.0, ;;; Experimental ARMAC 3.15, microcode 138, Band Name: mx,network,action,sst,patches ;;; Patch to correct acb deallocation for mac-string-to-mx-STRING ;;; and initialize data-size for :mac-to-mac case in BLOCK-MOVE. #!C ; From file EXPER-TOOLBOX-INTERFACE.LISP#> TOOLBOX-INTERFACE; Hotel: #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-TOOLBOX-INTERFACE.#" (defun mac-string-to-mx-string (mac-string-handle-or-pointer &optional mx-string &aux acb str len) (LET ((pointer nil)) (unwind-protect ;make sure handle gets unlocked (progn (setf pointer (ETYPECASE mac-string-handle-or-pointer (mac-handle (!HLock mac-string-handle-or-pointer) (deref mac-string-handle-or-pointer)) (mac-pointer mac-string-handle-or-pointer))) (setq len (FetchByte pointer 0)) (setq acb (add:get-acb-fast len)) (!BlockMove (SEND pointer :+ 1) (make-instance 'mac-pointer :pointer (addr-32-to-24 (sys:array-data-buffer-address (add:parm-block-accessor acb :string)))) len) (setq str (if mx-string (adjust-array mx-string len) (make-string len))) (add:copy-parms-string acb str :to-array len 0 0) (add:return-acb-fast acb t)) ;; may 02/09/90 Added T arg to force-p else Since requestor-bit is nil, the acb was not returned. (when (typep mac-string-handle-or-pointer 'mac-handle) ;; then we had to lock this to use it, so unlock it now (!HUnlock mac-string-handle-or-pointer))) str)) )) #!C ; From file EXPER-TOOLBOX-INTERFACE.LISP#> TOOLBOX-INTERFACE; Hotel: #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-TOOLBOX-INTERFACE.#" (defun BLOCK-MOVE (src dest count) "Move count elements from src to destination. Src and Dest can be a lisp array, a mac-pointer, or a mac-handle. Note that count is in elements and not in bytes. Count is the number of elements to be transfered. The data that is moved is correctly byte swapped for its element size. The element size is taken from the the lisp array type. In the Mac to Mac case it is assumed to be 8. **Beware** There is no bounds checking on mac-pointers and mac-handles so you are free to copy over anything you want." ;; Note that all Mac addresses are 24 bit addresses. (let (byte-count acb direction (data-size 8)) ;; may 02/12/90 8 for :exp-to-exp and :mac-to-mac case. Prevent ECASE error on nil data-size. (setf direction (cond ((and (arrayp src) (arrayp dest)) :exp-to-exp) ((and (mac-pointer-or-handle src) (mac-pointer-or-handle dest)) :mac-to-mac) ((and (mac-pointer-or-handle src) (arrayp dest)) (setf data-size (array-element-size dest)) :mac-to-exp) ((and (mac-pointer-or-handle dest) (arrayp src)) (setf data-size (array-element-size src)) :exp-to-mac) (t (ferror 'invalid-datatypes "Invalid data types were passed to block-move.") ))) (setf byte-count (ecase data-size (8 count) (16 (* count 2)) (32 (* count 4)))) (case direction (:mac-to-mac (!BlockMove (send src :mac-pointer) (send dest :mac-pointer) count)) (:exp-to-exp (si:copy-array-portion src 0 count dest 0 count)) (:mac-to-exp (setf acb (get-acb-fast byte-count)) (ecase data-size (8 (!blockmove (send src :mac-pointer) (make-instance 'mac-pointer :pointer (addr-32-to-24 (sys:array-data-buffer-address (add:parm-block-accessor acb 8)))) count) (copy-parms-8b acb dest :to-array count 0 0)) (16 (block-swap-16b (send src :mac-pointer) (make-instance 'mac-pointer :pointer (addr-32-to-24 (sys:array-data-buffer-address (add:parm-block-accessor acb 16)))) count) (copy-parms-16b acb dest :to-array count 0 0)) (32 (block-swap-32b src (make-instance 'mac-pointer :pointer (addr-32-to-24 (sys:array-data-buffer-address (add:parm-block-accessor acb 32)))) count) (copy-parms-32b acb dest :to-array count 0 0))) (add:return-acb-fast acb t)) (:exp-to-mac (setf acb (get-acb-fast byte-count)) (ecase data-size (8 (copy-parms-8b acb src :to-acb count 0 0) (!blockmove (make-instance 'mac-pointer :pointer (addr-32-to-24 (sys:array-data-buffer-address (add:parm-block-accessor acb 8)))) (send dest :mac-pointer) count)) (16 (copy-parms-16b acb src :to-acb count 0 0) (block-swap-16b (make-instance 'mac-pointer :pointer (addr-32-to-24 (sys:array-data-buffer-address (add:parm-block-accessor acb 16)))) (send dest :mac-pointer) count)) (32 (copy-parms-32b acb src :to-acb count 0 0) (block-swap-32b (make-instance 'mac-pointer :pointer (addr-32-to-24 (sys:array-data-buffer-address (add:parm-block-accessor acb 32)))) (send dest :mac-pointer) count))) (add:return-acb-fast acb t))) dest)) ))