Re: GC24-bit card

[Bill St. Clair <bill>]

   Date: Sat, 27 Oct 90 16:51:29 PDT
   From: ogus@math.berkeley.edu (Arthur E. Ogus)
   To: info-macl@cambridge.apple.com
   Subject: GC24-bit card
   
   The Apple 8-24-GC card I order to use with my MacIIfx finally arrived.
   Page 20 of the manual warns:
   "...there may be situations when yo uwill want to turn the
   acceleration feature off--for example if you are using an application
   program that does not conform to the programming standards specified
   by Apple.  Symptoms of application incompatibility may include the
   appearance of unexpected objects or artificats on the screen, or the
   incorrect execution of commands."
   
   Unfortunately, MACL 1.3.2 seems not to conform to the programming
   standards specified by Apple.  The insertion point in FRED does not
   behave properly, and I sometimes get system errors.  There are also
   some milder problems with Hypercard 1.2.5.  (The browse tool is all
   black.)
   
   Since I bought the card primarily for lisp, I would like to know if
   this is fixable.  Any comments, Apple?
   

The FRED display code erroneously assumed that register D1 would be
preserved accross a call to _SetClip.  This happenned to be true in
the normal QuickDraw code, but is not true in the code as patched by
the 8-24-GC card's INIT.  The following patch file should fix the
problem.  If you still notice system errors, please tell us about
them.  There may be a few more places with the same problem.  Before
blaming MACL, however, try removing screen savers from your System
file.

Bill St. Clair
bill@cambridge.apple.com


------- Cut Here ------------------------------------------------------------

;;;;;;;
;;
;; 8-24-patch.lisp
;;
;; Patches to make MACL 1.3.2 work correctly with the Apple 8-24 GC graphics
;; card.  Before the patch, the cursor will blink erratically, and leave
;; turds behind when you type.  After the patch, all should be well in Gotham
;; City.
;; Note that the 8-24 GC card also has problems with some screen savers
;; (e.g. AutoIdle appears to cause occasional crashes).
;;
;; The patch modifies the code in your running Lisp and writes the resource
;; out to the resource fork so that the patch will be there next time you
;; start up.  Hence, it's a good idea to back up your Lisp application before
;; running it.
;;
;; TO INSTALL THE PATCH, load this file or Eval this buffer.
;;
(in-package :ccl)

(require 'traps)

(defun get-resource (type number)
  (%stack-block ((restype 4))
    (dotimes (i 4)
      (%put-byte restype (char-code (char type i)) i))
    (_GetResource :ptr (%get-ptr restype) :word number :ptr)))

(defun hex (x)
  (format t "#x~x" x)
  (values))

(defvar $patch1-Offset (- #x5705f4 #x56d284))
(defvar $patch1-Size (ash (- #x57061c #x5705f4) -1))

(defvar $patch2-Offset (- #x3f43bc #x3f227c))
(defvar $patch2-Size (ash (- #x3f43d0 #x3f43bc) -1))

(defparameter *patch1-before*
  '(12840 46 53866 50 53866 52        ; These six words slide to the end
    8235 20 1088 15 18496 1088 15 18496 12032 17063 18519 43131 20623 8278))
(defparameter *patch1-after*
  '(8235 20 1088 15 18496 1088 15 18496 12032 17063 18519 43131 20623 8278 
    12840 46 53866 50 53866 52))

(defparameter *patch2-before*
  '(12844 65522                       ; These two words slide to the end
    12076 65528 12092 65535 65535 18519 43131 20623))
(defparameter *patch2-after*
  '(12076 65528 12092 65535 65535 18519 43131 20623
    12844 65522))

(defun 8-24-patch ()
  (let ((resource (get-resource "CODE" 3)))
    (unless resource (error "Can't open code resource"))
    (install-8-24-patches resource)
    (_ChangedResource :ptr resource)
    (unless (eql 0 (_ResError :word))
      (error "Error from _ChangedResource"))
    (_WriteResource :ptr resource)
    (unless (eql 0 (_ResError :word))
      (error "Error from _WriteResource"))))

(defun install-8-24-patches (resource &aux res)
  (with-dereferenced-handles ((p resource))
    (block patch1
      (dotimes (i $patch1-size)
        (push (%get-word p (+ $patch1-offset (* i 2))) res))
      (setq res (nreverse res))
      (unless (equal res *patch1-before*)
        (if (equal res *patch1-after*)
          (progn
            (format t "~&8-24-GC Patch 1 already installed.~%")
            (return-from patch1 nil))
          (error "Can't install 8-24-GC patch 1.  CODE resource 3 not as expected.")))
      (setq res *patch1-after*)
      (without-interrupts
       (dotimes (i $patch1-size)
         (%put-word p (pop res) (+ $patch1-offset (* i 2))) res)))
    
    (block patch2
      (setq res nil)
      (dotimes (i $patch2-size)
        (push (%get-word p (+ $patch2-offset (* i 2))) res))
      (setq res (nreverse res))
      (unless (equal res *patch2-before*)
        (if (equal res *patch2-after*)
          (progn
            (format t "~&8-24-GC Patch 2 already installed.~%")
            (return-from patch2 nil))
          (error "Can't install 8-24-GC patch 2.  CODE resource 3 not as expected.")))
      (setq res *patch2-after*)
      (without-interrupts
       (dotimes (i $patch2-size)
         (%put-word p (pop res) (+ $patch2-offset (* i 2))) res)))))

; Install the patches.
(8-24-patch)