Return to vlp.l CVS log

Up to [CSRG BSD Unix] / 43BSD / ucb / vlp

Annotation of 43BSD/ucb/vlp/vlp.l, revision 1.1

1.1     ! root        1: ;$Header: vlp.l,v 1.5 84/05/07 15:09:59 jkf Exp $
        !             2: ;$Locker: layer $
        !             3: ;
        !             4: ;                      -[Mon May  7 15:04:34 1984 by jkf]-
        !             5: ;
        !             6: ;  Filter for nroffing or troffing Lisp code.
        !             7: ;  This program reads files containing Lisp code and writes them out
        !             8: ;  along with the nroff (troff) commands required to make the Lisp line up.
        !             9: ;  It does this alignment by insuring that the leftmost
        !            10: ;  blank character lines up with the closest non blank character above it.
        !            11: ;
        !            12: ;  The program operates in one of two modes: filter mode or non-filter mode.
        !            13: ;
        !            14: ;  In filter mode, only characters between lines beginning with .Ls and .Le
        !            15: ;  are processed.  The directive .Ls accepts an optional argument that is 
        !            16: ;  the point size of the output.  Pages have no titles and point size is set
        !            17: ;  by the macro, so most shell arguments are ignored.
        !            18: ;
        !            19: ;  In non-filter mode, all lines in the file are processed.
        !            20: ;
        !            21: ;  The output goes to the standard output, unless the v switch is set,
        !            22: ;  in which case it goes to vtroff.
        !            23: ;
        !            24: ;  Usage:
        !            25: ;    vlp [-p size] [-d] [-f] [-l] [-v] [-T title1] file1 ....
        !            26: ;
        !            27: ;      where,
        !            28: ;              -p      Sets the point size to "size"
        !            29: ;              -d      Turn on debugging mode
        !            30: ;              -f      Run in filtered mode
        !            31: ;              -l      Turns OFF the labeling of functions 
        !            32: ;              -v      Sends the output to vtroff
        !            33: ;              -T      Sets the title of the next file to "titleN"
        !            34: ;
        !            35: ;  NOTE: If vlp is on the right side of a pipe, the "-T" switch can not be
        !            36: ;       used.  
        !            37: ;
        !            38: ;
        !            39: ;  Written by John Foderaro
        !            40: ;  Modified by:
        !            41: ;      Kevin Layer to have enough tags.
        !            42: ;      Jim Larus to work in filtered mode.
        !            43: ;
        !            44: 
        !            45: (declare (macros t))
        !            46: 
        !            47: (allocate 'list 220)
        !            48: 
        !            49: (declare (special user-top-level EOF lines g-psize inport
        !            50:                  spaces sps chs tls trname errport outfilename
        !            51:                  filtermode g-title rest funcname readstdin debug
        !            52:                  spout outfile tagsleft LabelFunctions)) 
        !            53: 
        !            54: (defvar space-count 500.)      ; large number
        !            55: 
        !            56: ;--- toplev :: top level lisp 
        !            57: ;
        !            58: (defun toplev nil
        !            59:    (let ((args (command-line-args)))
        !            60:        (signal 2 'vlp-interrupt-routine)
        !            61:        (signal 15 'vlp-interrupt-routine)
        !            62:        (errset (apply 'vlp args))
        !            63:        (exit 0)))
        !            64: 
        !            65: (eval-when (load) (setq user-top-level 'toplev))
        !            66: 
        !            67: (setq g-psize 8
        !            68:       debug nil
        !            69:       g-filtmode nil
        !            70:       readstdin nil
        !            71:       filtermode nil
        !            72:       outfilename nil
        !            73:       LabelFunctions t)
        !            74: 
        !            75: 
        !            76: (defun GetModTime (FileName)
        !            77:   ;
        !            78:   ; Returns the last modification time as a string.
        !            79:   ;
        !            80:   (time-string (filestat:mtime (filestat (get_pname FileName)))))
        !            81: 
        !            82: 
        !            83: (defun vlp fexpr (args)
        !            84:    (prog (inport outfile)
        !            85:        ;check command line for switches
        !            86:        (setq args (do ((i args (cdr i)) (ll) (tem))
        !            87:                      ((null i) (reverse ll))
        !            88:                      (setq tem (aexplodec (car i)))
        !            89:                      (cond ((eq '- (car tem))  ; if switch
        !            90:                             (cond ((eq 'd (cadr tem))
        !            91:                                    (setq debug t))
        !            92:                                   ((eq 'f (cadr tem))
        !            93:                                    (setq filtermode t))
        !            94:                                   ((eq 'l (cadr tem))
        !            95:                                    (setq LabelFunctions nil))
        !            96:                                   ((eq 'p (cadr tem))
        !            97:                                    (setq g-psize
        !            98:                                          (cond ((eq '|6| (cadr i)) 6)
        !            99:                                                ((eq '|10| (cadr i)) 10)
        !           100:                                                ((eq '|12| (cadr i)) 12)
        !           101:                                                (t 8)))
        !           102:                                    (setq i (cdr i)))
        !           103:                                   ((eq 'v (cadr tem))
        !           104:                                    (setq outfilename
        !           105:                                          (concat "/tmp/vlp" (sys:getpid))))
        !           106:                                   (t (setq ll (cons (car i) ll)))))
        !           107:                            (t (setq ll (cons (car i) ll)))))) ; else skip it
        !           108:        ;
        !           109:        (if debug then (msg (P errport) "args = " args N))
        !           110:        ;
        !           111:        ; insure all file names given actually exist before starting.
        !           112:        (cond ((null (do ((xx args (cdr xx)))
        !           113:                        ((null xx) t)
        !           114:                        (if (eq '- (getchar (car xx) 1))
        !           115:                            then (setq xx (cdr xx)) ; skip switches
        !           116:                            else (if (not (probef (car xx))) 
        !           117:                                     then (msg (P errport)
        !           118:                                               "File does not exist: "
        !           119:                                               (car xx))
        !           120:                                          (return nil)))))
        !           121:              (return nil)))
        !           122:        ;
        !           123:        ; do before-starting-first-file actions
        !           124:        ;
        !           125:        (if outfilename then (setq outfile (outfile outfilename)))
        !           126:        (if (null args) then (setq readstdin t))
        !           127: 
        !           128:        (if (and LabelFunctions (null filtermode))
        !           129:           then ;; NOTE: the following concat'ing of strings 
        !           130:                ;; is neccessary because when vlp'ing vlp.l 
        !           131:                ;; soelim would source the file.
        !           132:                (msg (P outfile) (concat "." "so /usr/lib/vlpmacs") N))
        !           133:        (setq g-title "")
        !           134:        ;
        !           135:        ;
        !           136:        (if readstdin
        !           137:           then (setq EOF nil)
        !           138:                (setq lines nil)
        !           139:                (if (not filtermode)
        !           140:                    then (msg (P outfile) ".ps " g-psize N
        !           141:                              ".vs " (+ g-psize 2) "p" N)
        !           142:                         (msg (P outfile) ".Ti " '\" g-title '\" N)
        !           143:                         (msg (P outfile) ".wh -1.25i He" N)
        !           144:                         (msg (P outfile) ".nf" N))
        !           145:                (do ()
        !           146:                    (EOF t)
        !           147:                    (if filtermode then (skiptostarter))
        !           148:                    (processblock))
        !           149:           else (do ((files args (cdr files)))
        !           150:                    ((null files) t)
        !           151:                    (if (eq '- (getchar (car files) 1))
        !           152:                        then (if (eq '-p (car files))
        !           153:                                 then (if (null (setq g-psize
        !           154:                                                      (cdr (assoc (cadr files)
        !           155:                                                                  '((\6 . 6)
        !           156:                                                                    (\8 . 8)
        !           157:                                                                    (\10 . 10)
        !           158:                                                                    (\12 . 12))))))
        !           159:                                          then (error "bad point size"
        !           160:                                                      (cadr files)))
        !           161:                              elseif (eq '-T (car files))
        !           162:                                 then (setq g-title (cadr files))
        !           163:                                 else (error "bad switch " (car files)))
        !           164:                             (setq files (cdr files))
        !           165:                        else (setq EOF nil)
        !           166:                             (setq lines nil)
        !           167:                             (cond ((null (errset
        !           168:                                              (setq inport (infile (car files)))))
        !           169:                                    (msg (P errport) "Can't open file: "
        !           170:                                         (car args))
        !           171:                                    (return nil)))
        !           172:                             (if (not filtermode)
        !           173:                                 then (msg (P outfile)
        !           174:                                           ".ps " g-psize N
        !           175:                                           ".vs " (+ g-psize 2) "p" N)
        !           176:                                      (msg (P outfile)
        !           177:                                           ".Fi " (car files)
        !           178:                                           " \"" (GetModTime (car files)) '\"
        !           179:                                           " \"" (time-string) '\"
        !           180:                                           N)
        !           181:                                      (msg (P outfile)
        !           182:                                           ".Ti " '\" g-title '\" N)
        !           183:                                      (msg (P outfile) ".wh -1.25i He" N)
        !           184:                                      (msg (P outfile) ".nf" N))
        !           185:                             (do ()
        !           186:                                 (EOF)
        !           187:                                 (if filtermode then (skiptostarter))
        !           188:                                 (processblock))
        !           189:                             (close inport))))
        !           190:        (if outfilename
        !           191:           then
        !           192:                (close outfile)
        !           193:                (apply 'process
        !           194:                       (ncons (concat "/bin/cat " outfilename
        !           195:                                      " | /usr/ucb/vtroff")))
        !           196:                (if debug
        !           197:                    then (msg (P errport)
        !           198:                              "Troff filename is " outfilename N)
        !           199:                    else (sys:unlink outfilename)))))
        !           200: 
        !           201: 
        !           202: ;--- skiptostarter :: skip to start directive (.Ls)
        !           203: ;
        !           204: (defun skiptostarter nil
        !           205:    ;
        !           206:    ; Define a simple finite state machine that reads and prints everything
        !           207:    ; up-to and including the directive .Ls.
        !           208:    ; All text outside of the .Ls directive is simply sent on to the output.
        !           209:    ;
        !           210:    (do ((State 0)
        !           211:        (c (tyi inport) (tyi inport)))
        !           212:        ((=& 4 State))
        !           213:        (cond ((and (=& State 0) (=& c #/.))
        !           214:              (setq State 1))
        !           215:             ((and (=& State 1) (=& c #/L))
        !           216:              (setq State 2))
        !           217:             ((and (=& State 2) (=& c #/s))
        !           218:              (setq State 3))
        !           219:             ((=& State 3)                      ; Read through arguments
        !           220:              (cond ((=& c #\lf)
        !           221:                     (setq State 4)
        !           222:                     (untyi c inport))))        ; In case text starts immed.
        !           223:             ((=& c #\eof)
        !           224:              (setq EOF t)
        !           225:              (return))
        !           226:             (t
        !           227:                 (setq State 0)))
        !           228:        (tyo c outfile)))
        !           229: 
        !           230: (defun processblock nil
        !           231:    ;
        !           232:    ; Read lines until we come to one that has no blank space at its begining.
        !           233:    ; Then process the previously accumulated lines.
        !           234:    ; If the last line contains the directive .Le, then find the next block
        !           235:    ; enclosed by .Ls.
        !           236:    ;
        !           237:    (do ((newline (getline) (getline)))
        !           238:        (nil)
        !           239:        (if (or EOF (and (zerop (car newline)) (cadr newline))) 
        !           240:           then (flushlines)
        !           241:                (setq lines nil)
        !           242:                (if (=& (caadr newline) #/')    ;then must quote ' for troff
        !           243:                    then (msg (P outfile) "\\")
        !           244:                 elseif (and filtermode
        !           245:                             (=& (caadr newline) #/.)
        !           246:                             (=& (cadadr newline) #/L)
        !           247:                             (=& (caddadr newline) #/e))
        !           248:                    then (msg (P outfile) ".Le" N)
        !           249:                         (return nil))
        !           250:                (if EOF then (return nil)))
        !           251:        (setq lines (cons newline lines))))
        !           252: 
        !           253: 
        !           254: ;--- getline :: read in new line and return structure:
        !           255: ; (spaces chars)
        !           256: ; spaces is a fixnum giving the number of spaces before the first
        !           257: ; non-blank on the line.
        !           258: ; chars is the list of characters appearing on the line, in order.
        !           259: ;
        !           260: (defun getline nil
        !           261:    (do ((col 1)
        !           262:        (spaces 0)
        !           263:        (chars nil)
        !           264:        (spacemode t)
        !           265:        (newc (tyi inport) (tyi inport) ))
        !           266:        (nil)
        !           267:        (if (=& #\eof newc) 
        !           268:           then (if (null chars) 
        !           269:                    then (setq EOF t)
        !           270:                         (return nil)
        !           271:                    else (setq newc #\lf)))
        !           272:        (if (=& #\lf newc)
        !           273:          then (if (null chars)
        !           274:                  then ; for totally blank lines return a large
        !           275:                       ; space count so this won't be used for tags
        !           276:                       (return (list space-count nil))
        !           277:                  else (return (list spaces (nreverse chars)))))
        !           278:        (if (=& #\ff newc)
        !           279:           then (return (list spaces (nreverse (cons newc chars)))))
        !           280:        (if spacemode 
        !           281:           then (if (=& #\sp newc)
        !           282:                    then (setq spaces (1+ spaces))
        !           283:                 elseif (=& #\tab newc)
        !           284:                    then (setq spaces  (* (/ (+ spaces 8) 8) 8))
        !           285:                    else (setq spacemode nil
        !           286:                               chars (list newc)))
        !           287:           else (setq chars (cons newc chars)))))
        !           288:                        
        !           289: 
        !           290: ;--- flushlines
        !           291: ; go back on all lines and determine where to put tags and reference
        !           292: ; tags.
        !           293: ;
        !           294: (defun flushlines nil
        !           295:   (let (thistag tagref rlines tagloc)
        !           296:        (inittagslist '(A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
        !           297:                         a b c d e f g h i j k l m n o p q r s t u v w x y z
        !           298:                         1 2 3 4 5 6 7 8 9 0))
        !           299:        (setq tagref nil tagloc nil rlines nil)
        !           300:        (do ((xx lines (cdr xx))
        !           301:            (thistagloc nil nil)
        !           302:            (pendingtags)
        !           303:            (thistagref))
        !           304:           ((null xx))
        !           305:           (setq rlines (cons (car xx) rlines)
        !           306:                 spaces (caar xx)
        !           307:                 thistag (alloctag))
        !           308:           ; determine which of the pending tags we can insert at this level
        !           309:           (do ((yy pendingtags (cdr yy)))
        !           310:               ((or (null yy) (>& spaces (caar yy)))
        !           311:                (setq pendingtags yy))
        !           312:               (setq thistagloc (cons (car yy) thistagloc)))
        !           313:           (setq tagloc (cons thistagloc tagloc))
        !           314:           ; free up the tags we allocated at this level.
        !           315:           (mapc '(lambda (x) (freetag (cadr x))) thistagloc)
        !           316:           ;
        !           317:           ; we only need to refer to a tags at this level if 
        !           318:           ; we are not at the left edge of the paper
        !           319:           ;
        !           320:           (if (and (greaterp spaces 0) (cdr xx))
        !           321:               then (setq tagref (cons thistag tagref))
        !           322:                    (setq pendingtags (addtotags spaces thistag pendingtags))
        !           323:               else (setq tagref (cons nil tagref))))
        !           324:        (if debug then (msg " **tagref = " tagref N " **tagloc = " tagloc N))
        !           325:        ;
        !           326:        ; print out the lines. 
        !           327:        ; the lines we want to print are in the list rlines.  They are 
        !           328:        ; in the correct order.
        !           329:        ;
        !           330:        (do ((yy rlines (cdr yy))
        !           331:            (commentmode nil nil)
        !           332:            (escapemode nil nil))
        !           333:           ((null yy))
        !           334:           ; first print out spaces
        !           335:           (setq sps (caar yy) 
        !           336:                 chs (cadar yy)
        !           337:                 tls (car tagloc)
        !           338:                 trname (car tagref))
        !           339:           (headercheck sps chs)
        !           340:           (if debug
        !           341:               then (msg " spaces " sps N " chs " chs N
        !           342:                         " tagloc " (car tagloc) N " tagref " (car tagref) N))
        !           343:           (setq spout 0)
        !           344:           ; if there are characters on this line, print out
        !           345:           ; leading spaces
        !           346:           (if chs
        !           347:              then (do ()
        !           348:                       ((eq spout sps))
        !           349:                       (tyo #\sp outfile)
        !           350:                       (setq spout (1+ spout)))
        !           351: 
        !           352:                   (if trname then (tagrefprint trname)))
        !           353:           
        !           354:           (do ((xx chs (cdr xx)))
        !           355:               ((null xx)
        !           356:                (if (and tls (not (<& (caar tls) spout)))
        !           357:                    then (do ((i spout (1+ i)))
        !           358:                             ((null tls))
        !           359:                             (if (=& (caar tls) i) 
        !           360:                                 then (taglocprint (cadar tls))
        !           361:                                      (setq tls (cdr tls)))))
        !           362:                (if commentmode then (msg (P outfile) "\\fP"))
        !           363:                (terpr outfile))
        !           364:               (if (and tls (eq (caar tls) spout))
        !           365:                   then (taglocprint (cadar tls))
        !           366:                        (setq tls (cdr tls)))
        !           367:               (if (and (not escapemode) 
        !           368:                        (null commentmode) 
        !           369:                        (=& #/; (car xx)))
        !           370:                   then (msg (P outfile) "\\fI")
        !           371:                        (setq commentmode t)
        !           372:                elseif (=& #/\ (car xx))
        !           373:                   then (tyo #/\ outfile))      ; escape backslashes
        !           374:               (if (memq (car xx) '(#/\ #//))
        !           375:                   then (setq escapemode t)
        !           376:                   else (setq escapemode nil))
        !           377:               (if (=& (car xx) #\ff)
        !           378:                   then (msg (P outfile) N ".bp" N)
        !           379:                   else (tyo (car xx) outfile))
        !           380:               (setq spout (1+ spout)))
        !           381:           (setq tagloc (cdr tagloc)
        !           382:                 tagref (cdr tagref)))))
        !           383: 
        !           384: 
        !           385: ; headercheck :: check if this is a function declaration.
        !           386: ; currently this means that there are no more than 2 spaces before
        !           387: ; the line begins and that the line begins with (defxxx  <name>)
        !           388: (defun headercheck (spaces chars)
        !           389:   (if (<& spaces 3)
        !           390:       then (if (setq rest (match chars '(#/( #/d #/e #/f)))
        !           391:               then (setq funcname (skippastblkn rest))
        !           392:                    (if (and funcname LabelFunctions)
        !           393:                        then (msg (P outfile) ".Lf " funcname N)))))
        !           394: 
        !           395: ;--- match :: match lists 
        !           396: ;      list1 - list of characters (fixnum rep)
        !           397: ;      list2 - master list of characters (fixnum rep)
        !           398: ; list2 should be shorter than list1. If list2 is a substring of list1
        !           399: ; then the rest of list1 will be returned.  Otherwise nil is returned.
        !           400: ;
        !           401: (defun match (list1 list2)
        !           402:   (cond ((null list1) nil)
        !           403:        ((null list2) list1)
        !           404:        ((or (eq (car list1) (car list2))
        !           405:             (eq (car list1) (uppercase (car list2))))
        !           406:         (match (cdr list1) (cdr list2)))
        !           407:        (t nil)))
        !           408: 
        !           409: ;--- uppercase :: convert fixnum rep to upper case
        !           410: ;      char - fixnum representation of character
        !           411: ; convert character to upper case.
        !           412: ;
        !           413: (defun uppercase (ch)
        !           414:   (if (and (not (<& ch #/a)) (not (>& ch #/z)))
        !           415:       then (- ch #.(- #/a #/A))))
        !           416: 
        !           417: 
        !           418: 
        !           419: ;--- skippastblnk :: skip to and past blank field and return following name
        !           420: ;      list - list of characters (fixnums)
        !           421: ;
        !           422: ; We skip past all non blanks then all blanks and finally implode the next 
        !           423: ; word after that and return it.  
        !           424: ;
        !           425: ; bug- we can't tell the difference between a function named nil and
        !           426: ; no valid function, but then again you can't have a function named nil.
        !           427: ;
        !           428: (defun skippastblkn (list)
        !           429:    (let (res)
        !           430:       ; skip to first blank
        !           431:       (do ()
        !           432:          ((null list) nil)
        !           433:          (if (=& (car list) #\sp) then (return nil))
        !           434:          (setq list (cdr list)))
        !           435:       ; skip to first non-blank
        !           436:       (do ()
        !           437:          ((null list) nil)
        !           438:          (if (not (=& (car list) #\sp)) then (return nil))
        !           439:          (setq list (cdr list)))
        !           440:       ; collect non blanks
        !           441:       (if list 
        !           442:         then (do ()
        !           443:                  ((null list))
        !           444:                  (if (and (=& #\lpar (car list))
        !           445:                           (null res))
        !           446:                     then (setq list (cdr list)) ; form like "defun (foo ..)"
        !           447:                   elseif (or (=& #\lpar (car list))
        !           448:                              (=& #\rpar (car list))
        !           449:                              (=& #\sp (car list)))
        !           450:                     then (return nil)
        !           451:                     else (setq res (cons (car list) res))
        !           452:                          (setq list (cdr list))))
        !           453:              (if res then (implode (nreverse res))))))
        !           454: 
        !           455: ;
        !           456: ; add (spaces character) to list so that the spaces number are in 
        !           457: ; ascending order.
        !           458: ;
        !           459: (defun addtotags (spaces character oldlist)
        !           460:   (if (or (null oldlist) (>& spaces (caar oldlist)))
        !           461:       then (cons (list spaces character) oldlist)
        !           462:       else (do ((prevtag oldlist (cdr prevtag))
        !           463:                (thistag (cdr oldlist) (cdr thistag)))
        !           464:               ((or (null thistag) (>& spaces (caar thistag)))
        !           465:                (setq thistag (cons (list spaces character) thistag))
        !           466:                (rplacd prevtag thistag)))))
        !           467: 
        !           468: (defun inittagslist (list)
        !           469:   (setq tagsleft list))
        !           470: 
        !           471: (defun alloctag nil
        !           472:   (if (null tagsleft) 
        !           473:       then (msg "Out of tags, aauuuuggh " N) 
        !           474:            (exit)
        !           475:       else (prog1 (car tagsleft) (setq tagsleft (cdr tagsleft)))))
        !           476: 
        !           477: (defun freetag (tagname)
        !           478:   (setq tagsleft (cons tagname tagsleft)))
        !           479: 
        !           480: 
        !           481: (defun taglocprint (name)
        !           482:   (msg (P outfile) "\\k" name))
        !           483: 
        !           484: 
        !           485: (defun tagrefprint (name)
        !           486:   (msg (P outfile)  "\\h'|\\n" name "u'"))
        !           487: 
        !           488: 
        !           489: ;---new stuff
        !           490: ;
        !           491: ;--- programs deal in lineblk's
        !           492: ; A lineblk has these components:
        !           493: ;      class : normal or comment
        !           494: ;              comment is a line beginning with ;, in which case it is
        !           495: ;              not counted as far as spacing goes.
        !           496: ;      spaces : number of spaces before first useful info
        !           497: ;      dead : list of dead linblk's, that is those ready to print but
        !           498: ;             waiting for this line to be done.
        !           499: ;      tagref: tag to go to at the beginning of this line
        !           500: ;      tagloc : tags defined on this line
        !           501: ;      chars : list of characters to print
        !           502: 
        !           503: (defun make-lineblk (class spaces chars)
        !           504:    (list class spaces nil nil nil chars))
        !           505: (defmacro get:class (lineblk) `(car ,lineblk))
        !           506: (defmacro set:class (lineblk val) `(setf (get:class ,lineblk) ,val))
        !           507: (defmacro get:spaces (lineblk) `(cadr ,lineblk))
        !           508: (defmacro set:spaces (lineblk val) `(setf (get:spaces ,lineblk) ,val))
        !           509: (defmacro get:dead (lineblk) `(caddr ,lineblk))
        !           510: (defmacro set:dead (lineblk val) `(setf (get:dead ,lineblk) ,val))
        !           511: (defmacro get:tagref (lineblk) `(cadddr ,lineblk))
        !           512: (defmacro set:tagref (lineblk val) `(setf (get:tagref ,lineblk) ,val))
        !           513: (defmacro get:tagloc (lineblk) `(caddddr ,lineblk))
        !           514: (defmacro set:tagloc (lineblk val) `(setf (get:tagloc ,lineblk) ,val))
        !           515: (defmacro get:chars (lineblk) `(cadddddr ,lineblk))
        !           516: (defmacro set:chars (lineblk val) `(setf (get:chars ,lineblk) ,val))
        !           517: 
        !           518:    
        !           519: (defun vlp-interrupt-routine (sig)
        !           520:    (if (and (boundp 'outfilename) outfilename)
        !           521:       then (sys:unlink outfilename))
        !           522:    (exit 1))

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.