(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10)


(FILECREATED "14-Apr-2026 12:14:44" {PROJECTS}<BROKENATOMS>BROKEN-ATOMS.;10
 7207   

      :CHANGES-TO (FUNCTIONS WITHOUT-BROKEN-ATOMS TEST-PRETTY-FILE TEST-DEEP-COMPUTATION 
                         CURE-BROKEN-ATOM)
                  (VARS BROKEN-ATOMSCOMS)

      :PREVIOUS-DATE "18-Feb-2026 16:08:40" {PROJECTS}<BROKENATOMS>BROKEN-ATOMS.;3)


(PRETTYCOMPRINT BROKEN-ATOMSCOMS)

(RPAQQ BROKEN-ATOMSCOMS

       (
        (* ;; "the representation of a broken atom")


        (RECORDS BROKEN-ATOM)
        (FUNCTIONS CURE-BROKEN-ATOM)
        
        (* ;; "for DEFPRINT")


        (FNS BROKEN-ATOM-PRINTER)
        
        (* ;; "special form")


        (FUNCTIONS WITHOUT-BROKEN-ATOMS)
        
        (* ;; "setup")


        (P (DEFPRINT 'BROKEN-ATOM 'BROKEN-ATOM-PRINTER))
        
        (* ;; "Debugging/testing")


        (FUNCTIONS TEST-INTERNAL-BA TEST-EXTERNAL-BA TEST-DEEP-COMPUTATION TEST-PRETTY-FILE)))



(* ;; "the representation of a broken atom")


(DECLARE%: EVAL@COMPILE

(DATATYPE BROKEN-ATOM
 ((PACKAGE POINTER)
                       (NAME POINTER)
                       (EXTERNAL FLAG)))
)

(/DECLAREDATATYPE 'BROKEN-ATOM '(POINTER POINTER FLAG)
       '((BROKEN-ATOM 0 POINTER)
         (BROKEN-ATOM 2 POINTER)
         (BROKEN-ATOM 2 (FLAGBITS . 0)))
       '4)

(CL:DEFUN CURE-BROKEN-ATOM
 (CONDITION)
   "Given an XCL:MISSING-EXTERNAL-SYMBOL condition, return a corresponding BROKEN-ATOM"
   (COND
      ((TYPEP CONDITION 'XCL:MISSING-PACKAGE)                (* ; "no such package ")

       (create
 BROKEN-ATOM
              PACKAGE _ (XCL:MISSING-PACKAGE-PACKAGE-NAME CONDITION)
              NAME _ (XCL:MISSING-PACKAGE-SYMBOL-NAME CONDITION)
              EXTERNAL _ (XCL:MISSING-PACKAGE-EXTERNAL CONDITION)))
      ((TYPEP CONDITION 'XCL:MISSING-EXTERNAL-SYMBOL)        (* ; 

                                                            "package exists, no such external symbol")

       (create
 BROKEN-ATOM
              PACKAGE _ (CL:PACKAGE-NAME (XCL:MISSING-EXTERNAL-SYMBOL-PACKAGE CONDITION))
              NAME _ (XCL:MISSING-EXTERNAL-SYMBOL-NAME CONDITION)
              EXTERNAL _ NIL))
      (T (HELP "Don't know how to cure" CONDITION))))



(* ;; "for DEFPRINT")


(DEFINEQ

(BROKEN-ATOM-PRINTER

  [LAMBDA (BROKEN-ATOM STREAM)
    (CONS (CONCAT (fetch
 (BROKEN-ATOM PACKAGE) of
 BROKEN-ATOM)
                 (if
 (fetch
 (BROKEN-ATOM EXTERNAL) of
 BROKEN-ATOM)
                     then
 ":"
                   else
 "::")
                 (fetch
 (BROKEN-ATOM NAME) of
 BROKEN-ATOM])
)



(* ;; "special form")



(DEFMACRO WITHOUT-BROKEN-ATOMS
 (&BODY FORMS)
   "Handle any broken-atom errors by producing a BROKEN-ATOM that prints as if the original atom were intact"
   `[HANDLER-BIND [[XCL:MISSING-PACKAGE #'(CL:LAMBDA (C)
                                                 (CONDITIONS:INVOKE-RESTART 
                                                        'CREATE-MISSING-PACKAGE-BA (CURE-BROKEN-ATOM

                                                                                    C]
                   (XCL:MISSING-EXTERNAL-SYMBOL #'(CL:LAMBDA (C)
                                                         (CONDITIONS:INVOKE-RESTART 
                                                                'CREATE-EXTERNAL-BA (CURE-BROKEN-ATOM

                                                                                     C]
           (CONDITIONS:RESTART-BIND [(CREATE-MISSING-PACKAGE-BA
                                      #'(CL:LAMBDA (V)
                                               (RETFROM (FUNCTION RESOLVE-MISSING-PACKAGE)
                                                      V)
                                               V))
                                     (CREATE-EXTERNAL-BA #'(CL:LAMBDA (V)
                                                                  (RETFROM (FUNCTION 
                                                                      RESOLVE-MISSING-EXTERNAL-SYMBOL
                                                                            )
                                                                         V)
                                                                  V]
                  (PROGN ,@FORMS])



(* ;; "setup")



(DEFPRINT 'BROKEN-ATOM 'BROKEN-ATOM-PRINTER)



(* ;; "Debugging/testing")



(CL:DEFUN TEST-INTERNAL-BA
 ()
   [LET ((FILE NIL))
        (CL:WITH-OPEN-STREAM (OUT (OPENSTREAM "{nodircore}" 'OUTPUT))
               (SETQ FILE OUT)
               (PRINTOUT OUT "BROKEN::INTERNAL-ATOM" T))
        (CL:WITH-OPEN-STREAM (IN
 (OPENSTREAM FILE 'INPUT))
               (WITHOUT-BROKEN-ATOMS
 (RATOM IN])

(CL:DEFUN TEST-EXTERNAL-BA
 ()
   [LET ((FILE NIL))
        (CL:WITH-OPEN-STREAM (OUT (OPENSTREAM "{nodircore}" 'OUTPUT))
               (SETQ FILE OUT)
               (PRINTOUT OUT "BROKEN:EXTERNAL-ATOM" T))
        (CL:WITH-OPEN-STREAM (IN
 (OPENSTREAM FILE 'INPUT))
               (WITHOUT-BROKEN-ATOMS
 (RATOM IN])

(CL:DEFUN TEST-DEEP-COMPUTATION
 ()
   "Test that we can handle internal calls to READ that encounter broken atoms"

   (* ;; "make sure it works when there's no error")


   (LET [(RESULT (WITHOUT-BROKEN-ATOMS
 (CL:LOOP :FOR X :FROM 0 :TO 9 :COLLECT X]
        (PRINTOUT T "No error loop result: " RESULT T))

   (* ;; "and when reading legit atoms")


   (LET [(RESULT (WITHOUT-BROKEN-ATOMS
 (CL:LOOP :FOR X :FROM 0 :TO 9 :COLLECT (CL:READ-FROM-STRING
                                                                               (CONCAT "IL:ATOM" X]
        (PRINTOUT T "No error read loop result: " RESULT T))

   (* ;; "test XCL:MISSING-PACKAGE.")


   (COND
      ((CL:FIND-PACKAGE :BROKEN)
       (DELETE-PACKAGE :BROKEN)))
   (LET [(RESULT (WITHOUT-BROKEN-ATOMS
 (CL:LOOP :FOR X :FROM 0 :TO 9 :COLLECT (CL:READ-FROM-STRING
                                                                               (CONCAT "BROKEN:ATOM"
                                                                                      X]
        (PRINTOUT T "No such package loop result: " RESULT T))

   (* ;; "test XCL:MISSING-EXTERNAL-SYMBOL")


   (CL:UNWIND-PROTECT
       (PROGN (CL:MAKE-PACKAGE :BROKEN)
              (LET [(RESULT (WITHOUT-BROKEN-ATOMS
 (CL:LOOP :FOR X :FROM 0 :TO 9 :COLLECT
                                                         (CL:READ-FROM-STRING (CONCAT "BROKEN:ATOM" X
                                                                                     ]
                   (PRINTOUT T "Not external symbol loop result: " RESULT T)))
       [COND
          ((CL:FIND-PACKAGE :BROKEN)
           (DELETE-PACKAGE 'BROKEN]))

(CL:DEFUN TEST-PRETTY-FILE
 (SOURCE-FILE-NAME OUTPUT-FILE-NAME OUTPUT-TYPE)
   "Prettyprint a Lisp source file to an imagestream file"
   (CL:WITH-OPEN-STREAM (OUTPUT-STREAM (OPENIMAGESTREAM OUTPUT-FILE-NAME OUTPUT-TYPE))
          (WITHOUT-BROKEN-ATOMS
 (PRETTYFILEINDEX SOURCE-FILE-NAME NIL OUTPUT-STREAM T))
          (FULLNAME OUTPUT-STREAM)))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (1403 2315 (CURE-BROKEN-ATOM 1403 . 2315)) (2346 2699 (BROKEN-ATOM-PRINTER 2356 . 2697))
 (2731 4397 (WITHOUT-BROKEN-ATOMS 2731 . 4397)) (4503 4831 (TEST-INTERNAL-BA 4503 . 4831)) (4833 5160 
(TEST-EXTERNAL-BA 4833 . 5160)) (5162 6829 (TEST-DEEP-COMPUTATION 5162 . 6829)) (6831 7184 (
TEST-PRETTY-FILE 6831 . 7184)))))
STOP