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

(FILECREATED "17-Mar-2021 11:10:55" {DSK}<home>larry>ilisp>medley>sources>LLSUBRS.;6
 27745  

      changes to%:  (VARS \INITSUBRS)
                    (FNS MISCN-NUMBER \MISCN.UFN \UNDEFINED-MISCN-UFN MISCN-COLLECT \GET-MY-BF 
                         \INIT-MISCN-TABLE \USER-SUBR-UFN \INIT-USER-SUBR-TABLE 
                         \UNDEFINED-USER-SUBR-UFN USER-SUBR-NUMBER EQ-TO-CAR EQ-TO-CADR SUBRNUMBER 
                         WRITECALLSUBRS FIX-SUBR-NAME \MOREVMEMFILE \WRITEMAP \COPYSYS0SUBR 
                         \PUPLEVEL1STATE SHOWDISPLAY SETSCREENCOLOR \WRITERAWPBI \READRAWPBI RAID 
                         \LISPFINISH \GETPACKETBUFFER \GATHERSTATS \DSPRATE DSPBOUT DISKPARTITION 
                         \CHECKBCPLPASSWORD SUSPEND-LISP UNIX-USERNAME UNIX-FULLNAME UNIX-GETENV 
                         UNIX-GETPARM)

      previous date%: "16-Mar-2021 23:00:15" {DSK}<home>larry>ilisp>medley>sources>LLSUBRS.;3)


(* ; "
Copyright (c) 1983-1986, 1988-1992, 2021 by Venue & Xerox Corporation.
")

(PRETTYCOMPRINT LLSUBRSCOMS)

(RPAQQ LLSUBRSCOMS

       ((DECLARE%: EVAL@COMPILE DONTCOPY (ADDVARS (DONTCOMPILEFNS SUBRCALL MISCN FIX-SUBR-NAME 
                                                         WRITECALLSUBRS)))
        

(* ;;; "MISCN  Vars & Functions")


        (EXPORT (VARS \MISCN-TABLE-LIST))
        (FUNCTIONS MISCN)
        (OPTIMIZERS MISCN)
        (FNS MISCN-NUMBER \MISCN.UFN \UNDEFINED-MISCN-UFN MISCN-COLLECT \GET-MY-BF \INIT-MISCN-TABLE)
        (PROP ARGNAMES MISCN)
        (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS MISCN-UFN-SPEC MISCN-UFN-ENTRY))
        

(* ;;; " USER-SUBR Vars & Functions")


        (EXPORT (VARS \USER-SUBR-LIST))
        (FUNCTIONS USER-SUBR ADD-USER-SUBR)
        (FNS \USER-SUBR-UFN \INIT-USER-SUBR-TABLE \UNDEFINED-USER-SUBR-UFN USER-SUBR-NUMBER EQ-TO-CAR
             EQ-TO-CADR)
        (PROP ARGNAMES USER-SUBR)
        

(* ;;; "SUBRCALL Vars & Functions")


        (EXPORT (VARS \INITSUBRS))
        (FUNCTIONS SUBRCALL)
        (OPTIMIZERS SUBRCALL)
        (FNS SUBRNUMBER)
        
        (* ;; "use this to make a subrs.h file for Maiko ")


        (FNS WRITECALLSUBRS FIX-SUBR-NAME)
        (PROP ARGNAMES SUBRCALL)
        (DECLARE%: DONTCOPY (RESOURCES UNIXSTRING))
        (INITRESOURCES UNIXSTRING)
        (FNS \MOREVMEMFILE \WRITEMAP \COPYSYS0SUBR \PUPLEVEL1STATE SHOWDISPLAY SETSCREENCOLOR 
             \WRITERAWPBI \READRAWPBI RAID \LISPFINISH \GETPACKETBUFFER \GATHERSTATS \DSPRATE DSPBOUT
             DISKPARTITION \CHECKBCPLPASSWORD SUSPEND-LISP UNIX-USERNAME UNIX-FULLNAME UNIX-GETENV 
             UNIX-GETPARM)
        (IFPROP ARGNAMES SHOWDISPLAY SETSCREENCOLOR \WRITERAWPBI \READRAWPBI RAID \LISPFINISH 
               \GETPACKETBUFFER \GATHERSTATS \DSPRATE DSPBOUT DISKPARTITION \CHECKBCPLPASSWORD)
        (PROPS (LLSUBRS FILETYPE))))
(DECLARE%: EVAL@COMPILE DONTCOPY 

(ADDTOVAR DONTCOMPILEFNS
 SUBRCALL MISCN FIX-SUBR-NAME WRITECALLSUBRS)
)



(* ;;; "MISCN  Vars & Functions")


(* "FOLLOWING DEFINITIONS EXPORTED")
(RPAQQ \MISCN-TABLE-LIST

       ((USER-SUBR 0 \USER-SUBR-UFN T)
        (CL:VALUES 1 CL::VALUES-UFN NIL)
        (CL:SXHASH 2 CL::SXHASH-UFN NIL)
        (CL::EQLHASHBITSFN 3 CL::EQLHASHBITSFN-UFN NIL)
        (STRINGHASHBITS 4 \STRINGHASHBITS-UFN NIL)
        (STRING-EQUAL-HASHBITS 5 \STRING-EQUAL-HASHBITS-UFN NIL)
        (CL:VALUES-LIST 6 CL::VALUES-LIST-UFN NIL)
        (LCFetchMethod 7 LCFetchMethod NIL)
        (LCFetchMethodOrHelp 8 NIL NIL)
        (LCFindVarIndex 9 NIL NIL)
        (LCGetIVValue 10 NIL NIL)
        (LCPutIVValue 11 NIL NIL)))

(* "END EXPORTED DEFINITIONS")


(DEFMACRO MISCN
 (NAME &REST ARGS)
   [LET [(ARGNAMES (MAPCAR ARGS #'(LAMBDA (X)
                                    (GENSYM]
        `(CL:FUNCALL [CL:COMPILE NIL '(LAMBDA ,ARGNAMES
                                        ((OPCODES MISCN ,(MISCN-NUMBER
 NAME)
                                                ,(LENGTH ARGS))
                                         ,@ARGNAMES]
                ,@ARGS])

(DEFOPTIMIZER MISCN
 (NAME &REST ARGS)
                        `((OPCODES MISCN ,(MISCN-NUMBER
 NAME)
                                 ,(LENGTH ARGS))
                          ,@ARGS))
(DEFINEQ

(MISCN-NUMBER

  [LAMBDA (NAME)
                                      (* ; "Edited  7-Nov-88 15:21 by krivacic")

    (CADR (OR (ASSOC NAME \MISCN-TABLE-LIST)
              (ERROR NAME " not a MISCN index"])

(\MISCN.UFN

  [LAMBDA (ALPHA-BETA)
                                   (* ; "Edited  8-Jun-89 16:57 by jds")


    (* ;; "The UFN for the MISCN opcode.")


    (DECLARE
 (GLOBALVARS \MISCN-TABLE))

    (* ;; "Get the misc index & number of args from the code stream")


    (LET ((INDEX (LRSH ALPHA-BETA 8))
          (ARG-COUNT (LOGAND ALPHA-BETA 255)))

         (* ;; "compute the position of the real IVARS on the stack.  Create a pointer to these args and pass it to the Handler routine.")


         (COND
            ((NOT (AND (BOUNDP '\MISCN-TABLE)
                       \MISCN-TABLE))
             (\INIT-MISCN-TABLE
)))
         (LET* [(CALLER (\MYALINK))
                (MY-BF (\GET-MY-BF
))
                (MY-IVAR (fetch
 (BF IVAR) of
 MY-BF))
                (RESULT-IVAR (- MY-IVAR (LLSH ARG-COUNT 1)))
                (MY-PARMS-PTR (\VAG2 1 RESULT-IVAR))
                (UFN-ENTRY (\ADDBASE \MISCN-TABLE (LLSH INDEX 1]
               (COND
                  ((fetch
 (MISCN-UFN-ENTRY MISCN-MVS) OF
 UFN-ENTRY)

                   (* ;; "This UFN can return Multiple values, so we need to preserve them.")


                   (CL:UNWIND-PROTECT
                       (APPLY* (\GETBASEPTR UFN-ENTRY 0)
                              INDEX ARG-COUNT MY-PARMS-PTR)
                       (replace
 (BF IVAR) of
 MY-BF with
 RESULT-IVAR)
                       (REPLACE
 (FX NEXTBLOCK) OF
 CALLER WITH
 RESULT-IVAR)))
                  (T 
                     (* ;; "He said no MVs are possible, so don't even TRY to preserve them.  This is an expanded and cleaned up version of CL:UNWIND-PROTECT, so watch it!")


                     (PROG1 (.UNWIND.PROTECT. [FUNCTION (LAMBDA NIL
                                                          (replace
 (BF IVAR) of
 MY-BF
                                                             with
 RESULT-IVAR]
                                   (APPLY* (\GETBASEPTR UFN-ENTRY 0)
                                          INDEX ARG-COUNT MY-PARMS-PTR))
                         (replace
 (BF IVAR) of
 MY-BF with
 RESULT-IVAR)
                         (REPLACE
 (FX NEXTBLOCK) OF
 CALLER WITH
 RESULT-IVAR))])

(\UNDEFINED-MISCN-UFN

  [LAMBDA (INDEX ARG-COUNT ARG-PTR)
                   (* ; "Edited  3-Nov-88 15:56 by krivacic")

    (PRINTOUT T "index " INDEX ", arg count " ARG-COUNT T)
    (ERROR (CL:FORMAT T "Undefined MISCN[~d] with ~d args." INDEX ARG-COUNT)
           (MISCN-COLLECT
 ARG-COUNT ARG-PTR])

(MISCN-COLLECT

  [LAMBDA (ARG-COUNT ARG-PTR)
                         (* ; "Edited  3-Nov-88 11:52 by krivacic")

    (FOR
 I FROM
 0 TO
 (- ARG-COUNT 1) COLLECT
 (\GETBASEPTR ARG-PTR (LLSH I 1])

(\GET-MY-BF

  [LAMBDA NIL
                                         (* ; "Edited  3-Nov-88 11:08 by krivacic")


    (* ;; "Returns the stack index of the caller's BF.")


    (- (\MYALINK)
       2])

(\INIT-MISCN-TABLE

  [LAMBDA NIL
    (DECLARE
 (GLOBALVARS \MISCN-TABLE-LIST \MISCN-TABLE))

                                                             (* ; "Edited  7-Mar-89 09:43 by jds")

    (LET ((OP-NUMBER 36)
          (OP-LENGTH 3)
          BASE)
         (SETQ \MISCN-TABLE (ARRAY 256 'POINTER '\UNDEFINED-MISCN-UFN 0))
         (SETQ BASE (FETCH
 (ARRAYP BASE) OF
 \MISCN-TABLE))
         (for
 MISCN-ENTRY in
 \MISCN-TABLE-LIST do
 (SETA \MISCN-TABLE (CADR MISCN-ENTRY)
                                                                    (CADDR MISCN-ENTRY))
                                                             (REPLACE
 (MISCN-UFN-ENTRY MISCN-MVS)
                                                                OF
 (\ADDBASE2 BASE
                                                                              (FETCH
 (
                                                                                       MISCN-UFN-SPEC
                                                                                          INDEX)
                                                                                 OF
 MISCN-ENTRY))
                                                                WITH
 (FETCH
 (MISCN-UFN-SPEC
                                                                                     MVS)
                                                                            OF
 MISCN-ENTRY)))
         (SETQ \MISCN-TABLE BASE])
)

(PUTPROPS MISCN
 ARGNAMES
 (NAME &REST ARGS))
(DECLARE%: EVAL@COMPILE DONTCOPY 
(DECLARE%: EVAL@COMPILE

(RECORD MISCN-UFN-SPEC
 (
                            (* ;; 

                "This is the description for a MISCN opcode's UFN, as placed in \MISCN-TABLE-LIST.")


                            NAME                             (* ; 

                                                    "Name of the MISCN, for the MISCN macro's use.")

                            INDEX                            (* ; "Sub-opcode index.")

                            UFN-NAME                         (* ; "Name of the UFN")

                            MVS                              (* ; 

              "T if the UFN can returnmultiple values.  If this is NIL, MVs WILL NOT BE PRESERVED.")

                            ))

(BLOCKRECORD MISCN-UFN-ENTRY
 ((MISCN-MVS FLAG)
                                  (NIL BITS 3)
                                  (MISCN-UFN POINTER)))
)
)



(* ;;; " USER-SUBR Vars & Functions")


(* "FOLLOWING DEFINITIONS EXPORTED")
(RPAQQ \USER-SUBR-LIST
 ((DUMMY 10 DUMMY-UFN)
                            (SAMPLE-USER-SUBR 0 SAMPLE-USER-SUBR-UFN)))

(* "END EXPORTED DEFINITIONS")


(DEFMACRO USER-SUBR
 (USER-SUBR-NAME &REST ARGS)
   `(MISCN
 USER-SUBR ,(USER-SUBR-NUMBER
 USER-SUBR-NAME)
           ,@ARGS))

(CL:DEFUN ADD-USER-SUBR
 (USER-SUBR-NAME USER-SUBR-INDEX USER-SUBR-UFN)
   (DECLARE
 (GLOBALVARS \USER-SUBR-TABLE \USER-SUBR-LIST))

   (* ;; "Make Sure \USER-SUBR-TABLE is made")


   (IF
 (NOT (AND (BOUNDP '\USER-SUBR-TABLE)
                     \USER-SUBR-TABLE))
       THEN
 (\INIT-USER-SUBR-TABLE
))

   (* ;; "See if the Name is already defined")


   [AND (FASSOC USER-SUBR-NAME \USER-SUBR-LIST)
        (CL:CERROR "Delete old User-subr" "User-subr ~S already defined" USER-SUBR-NAME)
        (SETA \USER-SUBR-TABLE (CADR (FASSOC USER-SUBR-NAME \USER-SUBR-LIST))
              '\UNDEFINED-USER-SUBR-UFN)
        (SETQ \USER-SUBR-LIST (CL:REMOVE USER-SUBR-NAME \USER-SUBR-LIST :TEST 'EQ-TO-CAR]

   (* ;; "See if the UFN is already defined")


   [AND (OR (NEQ (ELT \USER-SUBR-TABLE USER-SUBR-INDEX)
                 '\UNDEFINED-USER-SUBR-UFN)
            (CL:FIND USER-SUBR-INDEX \USER-SUBR-LIST :KEY #'CL:SECOND))
        (CL:CERROR "Delete old User-subr" " User-subr index ~d already defined" USER-SUBR-INDEX)
        (SETQ \USER-SUBR-LIST (CL:REMOVE USER-SUBR-INDEX \USER-SUBR-LIST :TEST 'EQ-TO-CADR]
   (CL:PUSH (LIST USER-SUBR-NAME USER-SUBR-INDEX (OR USER-SUBR-UFN '\UNDEFINED-USER-SUBR-UFN))
          \USER-SUBR-LIST)
   (\INIT-USER-SUBR-TABLE
))
(DEFINEQ

(\USER-SUBR-UFN

  [LAMBDA (INDEX ARG-COUNT ARG-PTR)
    (DECLARE
 (GLOBALVARS \USER-SUBR-TABLE))
       (* ; "Edited  4-Nov-88 18:43 by krivacic")

    (IF
 (NOT (AND (BOUNDP '\USER-SUBR-TABLE)
                      \USER-SUBR-TABLE))
        THEN
 (\INIT-USER-SUBR-TABLE
))
    (LET ((USER-SUBR-INDEX (\GETBASE ARG-PTR 1)))

         (* ;; "User SUBR ufn.  Index on the User subr indexes")


         (APPLY* (ELT \USER-SUBR-TABLE USER-SUBR-INDEX)
                USER-SUBR-INDEX
                (- ARG-COUNT 1)
                (\ADDBASE ARG-PTR 2])

(\INIT-USER-SUBR-TABLE

  [LAMBDA NIL
    (DECLARE
 (GLOBALVARS \USER-SUBR-TABLE \USER-SUBR-LIST))

                                                          (* ; "Edited  4-Nov-88 18:58 by krivacic")

    (SETQ \USER-SUBR-TABLE (ARRAY 256 'POINTER '\UNDEFINED-USER-SUBR-UFN 0))
    (for
 SUBR-ENTRY in
 \USER-SUBR-LIST do
 (SETA \USER-SUBR-TABLE (CADR SUBR-ENTRY)
                                                            (CADDR SUBR-ENTRY])

(\UNDEFINED-USER-SUBR-UFN

  [LAMBDA (USER-SUBR-INDEX ARG-COUNT ARG-PTR)
         (* ; "Edited  7-Nov-88 14:33 by krivacic")


    (* ;; "User SUBR ufn.  Index on the User subr indexes")


    (ERROR (CL:FORMAT NIL "Undefined USER-SUBR[~d] with ~d args." USER-SUBR-INDEX ARG-COUNT)
           (MISCN-COLLECT
 ARG-COUNT ARG-PTR])

(USER-SUBR-NUMBER

  [LAMBDA (NAME)
                                      (* ; "Edited  4-Nov-88 18:42 by krivacic")

    (CADR (OR (ASSOC NAME \USER-SUBR-LIST)
              (ERROR NAME " not a USER-SUBR index"])

(EQ-TO-CAR

  [LAMBDA (ITEM LIST)
    (EQ ITEM (CAR LIST])

(EQ-TO-CADR

  [LAMBDA (ITEM LIST)
    (EQ ITEM (CADR LIST])
)

(PUTPROPS USER-SUBR
 ARGNAMES
 (USER-SUBR-NAME &REST ARGS))



(* ;;; "SUBRCALL Vars & Functions")


(* "FOLLOWING DEFINITIONS EXPORTED")
(RPAQQ \INITSUBRS

       ((YIELD 210)
        (BACKGROUNDSUBR 6)
        (CHECKBCPLPASSWORD 7)
        (DISKPARTITION 8)
        (DSPBOUT 9)
        (DSPRATE 10)
        (GATHERSTATS 11)
        (GETPACKETBUFFER 12)
        (LISPFINISH 13)
        (MOREVMEMFILE 14)
        (RAID 15)
        (READRAWPBI 16)
        (WRITERAWPBI 17)
        (SETSCREENCOLOR 18)
        (SHOWDISPLAY 19)
        (PUPLEVEL1STATE 20)
        (WRITESTATS 21)
        (CONTEXTSWITCH 22)
        (COPYSYS0SUBR 23)
        (WRITEMAP 24)
        (UFS-GETFILENAME 34)
        (UFS-DELETEFILE 35)
        (UFS-RENAMEFILE 36)
        (COM-READPAGES 37)
        (COM-WRITEPAGES 38)
        (COM-TRUNCATEFILE 39)
        (UFS-DIRECTORYNAMEP 41)
        (COM-GETFREEBLOCK 45)
        (SETUNIXTIME 48)
        (GETUNIXTIME 49)
        (COPYTIMESTATS 50)
        (UNIX-USERNAME 51)
        (UNIX-FULLNAME 52)
        (UNIX-GETENV 53)
        (UNIX-GETPARM 54)
        (CHECK-SUM 55)
        (ETHER-SUSPEND 56)
        (ETHER-RESUME 57)
        (ETHER-AVAILABLE 58)
        (ETHER-RESET 59)
        (ETHER-GET 60)
        (ETHER-SEND 61)
        (ETHER-SETFILTER 62)
        (ETHER-CHECK 63)
        (DSPCURSOR 64)
        (SETMOUSEXY 65)
        (DSP-VIDEOCOLOR 66)
        (DSP-SCREENWIDTH 67)
        (DSP-SCREENHEIGHT 68)
        (BITBLTSUB 69)
        (BLTCHAR 70)
        (TEDIT.BLTCHAR 71)
        (BITBLT.BITMAP 72)
        (BLTSHADE.BITMAP 73)
        (RS232C-CMD 74)
        (RS232C-READ-INIT 75)
        (RS232C-WRITE 76)
        (KEYBOARDBEEP 80)
        (KEYBOARDMAP 81)
        (KEYBOARDSTATE 82)
        (VMEMSAVE 89)
        (LISP-FINISH 90)
        (NEWPAGE 91)
        (DORECLAIM 92)
        (DUMMY-135Q 93)
        (NATIVE-MEMORY-REFERENCE 94)
        (OLD-COMPILE-LOAD-NATIVE 95)
        (DISABLEGC 96)
        (COM-SETFILEINFO 103)
        (COM-OPENFILE 104)
        (COM-CLOSEFILE 105)
        (DSK-GETFILENAME 106)
        (DSK-DELETEFILE 107)
        (DSK-RENAMEFILE 108)
        (COM-NEXT-FILE 110)
        (COM-FINISH-FINFO 111)
        (COM-GEN-FILES 112)
        (DSK-DIRECTORYNAMEP 113)
        (COM-GETFILEINFO 114)
        (COM-CHANGEDIR 116)
        (UNIX-HANDLECOMM 117)
        (RPC-CALL 119)
        (MESSAGE-READP 120)
        (MESSAGE-READ 121)
        (MONITOR-CONTROL 128)
        (GET-NATIVE-ADDR-FROM-LISP-PTR 131)
        (GET-LISP-PTR-FROM-NATIVE-ADDR 132)
        (LOAD-NATIVE-FILE 133)
        (SUSPEND-LISP 134)
        (NEW-BLTCHAR 135)
        (COLOR-INIT 136)
        (COLOR-SCREENMODE 137)
        (COLOR-MAP 138)
        (COLOR-BASE 139)
        (C-SlowBltChar 140)
        (UNCOLORIZE-BITMAP 141)
        (COLORIZE-BITMAP 142)
        (COLOR-8BPPDRAWLINE 143)
        (TCP-OP 144)
        (WITH-SYMBOL 145)
        (CAUSE-INTERRUPT 146)
        (OPEN-SOCKET 160)
        (CLOSE-SOCKET 161)
        (READ-SOCKET 162)
        (WRITE-SOCKET 163)
        (CALL-C-FUNCTION 167)
        (DLD-LINK 168)
        (DLD-UNLINK-BY-FILE 169)
        (DLD-UNLINK-BY-SYMBOL 170)
        (DLD-GET-SYMBOL 171)
        (DLD-GET-FUNC 172)
        (DLD-FUNCTION-EXECUTABLE-P 173)
        (DLD-LIST-UNDEFINED-SYMBOLS 174)
        (C-MALLOC 175)
        (C-FREE 176)
        (C-PUTBASEBYTE 177)
        (C-GETBASEBYTE 178)
        (CHAR-OPENFILE 200)
        (CHAR-BIN 201)
        (CHAR-BOUT 202)
        (CHAR-IOCTL 203)
        (CHAR-CLOSEFILE 204)
        (CHAR-EOFP 205)
        (CHAR-READP 206)
        (CHAR-BINS 207)
        (CHAR-BOUTS 208)
        (CHAR-FILLBUFFER 209)))

(* "END EXPORTED DEFINITIONS")


(DEFMACRO SUBRCALL
 (NAME &REST ARGS)
   [LET [(ARGNAMES (MAPCAR ARGS #'(LAMBDA (X)
                                    (GENSYM]
        `(CL:FUNCALL [CL:COMPILE NIL '(LAMBDA ,ARGNAMES
                                        ((OPCODES SUBRCALL ,(SUBRNUMBER
 NAME)
                                                ,(LENGTH ARGS))
                                         ,@ARGNAMES]
                ,@ARGS])

(DEFOPTIMIZER SUBRCALL
 (NAME &REST ARGS)
                           `((OPCODES SUBRCALL ,(SUBRNUMBER
 NAME)
                                    ,(LENGTH ARGS))
                             ,@ARGS))
(DEFINEQ

(SUBRNUMBER

  [LAMBDA (NAME)
                                         (* ; "Edited  5-Feb-92 16:49 by jds")


    (* ;; "Given a SUBR's NAME or number, return the corresponding subr number.")


    (LET (NUMBER)
         (COND
            ((FIXP NAME)
             (CL:WARN "SUBR name (~d) is a number; should be abstracted." NAME)
             NAME)
            ((CADR (ASSOC NAME \INITSUBRS)))
            ([SETQ NUMBER (CADR (CL:ASSOC NAME \INITSUBRS :TEST (FUNCTION STRING.EQUAL]
             (CL:WARN "SUBR name ~s is in wrong package.  Using ~d as subr number." NAME NUMBER))
            (T (ERROR NAME " not a SUBR"])
)



(* ;; "use this to make a subrs.h file for Maiko ")


(DEFINEQ

(WRITECALLSUBRS

  [LAMBDA NIL
                                          (* ; "Edited 17-Mar-2021 11:05 by larry")

    (CL:WITH-OPEN-FILE (*STANDARD-OUTPUT* "subrs.h" :DIRECTION :OUTPUT :IF-EXISTS :NEW-VERSION)
           (CL:FORMAT T "/* This file written from LLSUBRS on ~A                      */~&" (DATE))
           (CL:FORMAT T "/* Do not edit this file! Instead, edit the list \initsubrs */~&")
           (CL:FORMAT T "/* on the lisp file LLSUBRS and then call WRITECALLSUBRS to  */~&")
           (CL:FORMAT T "/* generate a new version.                                   */~&")
           (CL:FORMAT T "#ifndef SUBRS_H~&#define SUBRS_H 1~&")
           (for
 X in
 \INITSUBRS do
 (CL:FORMAT T "#define sb_~A	0~O~&" (FIX-SUBR-NAME

                                                                                   (CAR X))
                                                      (CADR X)))
           (CL:FORMAT T "~&~&/* MISCN opcodes */~&")
           (for
 X in
 \MISCN-TABLE-LIST do
 (CL:FORMAT T "#define miscn_~A	0~O~&"
                                                             (FIX-SUBR-NAME
 (CAR X))
                                                             (CADR X)))
           (CL:FORMAT T "~&~&/* Assigned USER SUBR numbers */~&")
           (for
 X in
 \USER-SUBR-LIST do
 (CL:FORMAT T "#define user_subr_~A	0~O~&"
                                                           (FIX-SUBR-NAME
 (CAR X))
                                                           (CADR X)))
           (CL:FORMAT T "#endif ~&"])

(FIX-SUBR-NAME

  [LAMBDA (NAME)
                                         (* ; "Edited 13-Feb-89 16:17 by jds")


    (* ;; "Fix up a SUBR name for use as a symbol in the C code, by:")


    (* ;; "Converting all -'s to _'s")


    (* ;; "Converting all .'s to _'s")


    (* ;; "Removing all \'s.")


    (* ;; "This allows us to use fairly normal Lisp symbols for SUBR names (like \TEDIT.BLTCHAR), while having them translate pleasantly.")


    (CONCATCODES (DREMOVE (CHARCODE \)
                        (SUBST (CHARCODE _)
                               (CHARCODE %.)
                               (SUBST (CHARCODE _)
                                      (CHARCODE -
)
                                      (CHCON NAME])
)

(PUTPROPS SUBRCALL
 ARGNAMES
 (NAME &REST ARGS))
(DECLARE%: DONTCOPY 
(DECLARE%: EVAL@COMPILE 

[PUTDEF 'UNIXSTRING 'RESOURCES '(NEW (ALLOCSTRING 512]
)
)

(/SETTOPVAL '\UNIXSTRING.GLOBALRESOURCE NIL)
(DEFINEQ

(\MOREVMEMFILE

  [LAMBDA (FILEPAGE)
                                  (* ; "Edited 27-Apr-88 13:36 by MASINTER")

    (SUBRCALL
 MOREVMEMFILE FILEPAGE])

(\WRITEMAP

  [LAMBDA (VP RP FLAGS)
                               (* ; "Edited 27-Apr-88 13:37 by MASINTER")

    (SUBRCALL
 WRITEMAP VP RP FLAGS])

(\COPYSYS0SUBR

  [LAMBDA (FID)
                                       (* ; "Edited 20-Apr-88 12:36 by MASINTER")

    (SUBRCALL
 COPYSYS0SUBR FID])

(\PUPLEVEL1STATE

  [LAMBDA (FLG)
                                       (* ; "Edited 20-Apr-88 12:37 by MASINTER")

    (SUBRCALL
 PUPLEVEL1STATE FLG])

(SHOWDISPLAY

  [LAMBDA (BASE RASTERWIDTH)
                          (* ; "Edited 27-Apr-88 13:40 by MASINTER")


    (* ;; "comments are done with semicolons one comment is at the right margin, it automatically do you type ")


    (SUBRCALL
 SHOWDISPLAY BASE RASTERWIDTH])

(SETSCREENCOLOR

  [LAMBDA (FLG)
                                       (* ; "Edited 20-Apr-88 12:37 by MASINTER")

    (SUBRCALL
 SETSCREENCOLOR FLG])

(\WRITERAWPBI

  [LAMBDA (PBI)
                                       (* ; "Edited 20-Apr-88 12:38 by MASINTER")

    (SUBRCALL
 WRITERAWPBI PBI])

(\READRAWPBI

  [LAMBDA NIL
                                         (* ; "Edited 20-Apr-88 12:38 by MASINTER")

    (SUBRCALL
 READRAWPBI])

(RAID

  [LAMBDA (MESS1 MESS2 FLG)
                           (* ; "Edited 20-Apr-88 12:38 by MASINTER")

    (SUBRCALL
 RAID MESS1 MESS2 FLG])

(\LISPFINISH

  [LAMBDA (DUMMY)
                                     (* ; "Edited 20-Apr-88 12:38 by MASINTER")

    (SUBRCALL
 LISPFINISH DUMMY])

(\GETPACKETBUFFER

  [LAMBDA NIL
                                         (* ; "Edited 20-Apr-88 12:38 by MASINTER")

    (SUBRCALL
 GETPACKETBUFFER])

(\GATHERSTATS

  [LAMBDA (FID)
                                       (* ; "Edited 20-Apr-88 12:38 by MASINTER")

    (SUBRCALL
 GATHERSTATS FID])

(\DSPRATE

  [LAMBDA (AC0 AC1 AC2)
                               (* ; "Edited 20-Apr-88 12:39 by MASINTER")


                                                          (* ; "Edited 20-Apr-88 12:39 by MASINTER")

    (SUBRCALL
 DSPRATE AC0 AC1 AC2])

(DSPBOUT

  [LAMBDA (CHARCODE)
                                  (* ; "Edited 20-Apr-88 12:39 by MASINTER")

    (SUBRCALL
 DSPBOUT CHARCODE])

(DISKPARTITION

  [LAMBDA NIL
                                         (* ; "Edited 20-Apr-88 12:39 by MASINTER")

    (SELECTQ (MACHINETYPE)
        ((DORADO DOLPHIN) 
             (SUBRCALL
 DISKPARTITION))
        ((DANDELION DOVE) 
             (\DFSCurrentVolume))
        NIL])

(\CHECKBCPLPASSWORD

  [LAMBDA (USER PASSWORD)
                                (* ; "Edited 14-Jun-88 13:33 by drc:")

    (SUBRCALL
 CHECKBCPLPASSWORD USER PASSWORD])

(SUSPEND-LISP

  [LAMBDA NIL
                                            (* ; "Edited 20-Jun-88 15:24 by greep")

    (if
 (EQ (MACHINETYPE)
                'MAIKO)
        then
 (SUBRCALL
 SUSPEND-LISP)
              T
      else
 NIL])

(UNIX-USERNAME

  [LAMBDA NIL
                                         (* ; "Edited  1-Aug-88 23:22 by masinter")

    (if
 (EQ \MACHINETYPE \MAIKO)
        then
 (WITH-RESOURCE UNIXSTRING (if
 (SUBRCALL
 UNIX-USERNAME UNIXSTRING)
                                               then
 (CONCAT (SUBSTRING UNIXSTRING 1
                                                                       (CL:POSITION #\Null UNIXSTRING
                                                                              ])

(UNIX-FULLNAME

  [LAMBDA NIL
                                         (* ; "Edited 18-Jul-88 03:47 by masinter")

    (if
 (EQ \MACHINETYPE \MAIKO)
        then
 (WITH-RESOURCES UNIXSTRING (if
 (SUBRCALL
 UNIX-FULLNAME UNIXSTRING)
                                                then
 (CONCAT (SUBSTRING UNIXSTRING 1
                                                                        (CL:POSITION #\Null 
                                                                               UNIXSTRING])

(UNIX-GETENV

  [LAMBDA (NAME)
                                       (* ; "Edited 21-Feb-2021 21:09 by larry")

    (WITH-RESOURCES
     UNIXSTRING
     (LET ((X UNIXSTRING))
          (if
 (SUBRCALL
 UNIX-GETENV (MKSTRING NAME)
                         X)
              then
 (CONCAT (SUBSTRING X 1 (for
 I from
 1
                                                 do
 (if
 (FMEMB (NTHCHARCODE X I)
                                                                       '(0 NIL))
                                                            then
 (RETURN (SUB1 I])

(UNIX-GETPARM

  [LAMBDA (NAME)
                                         (* ; "Edited 27-Feb-91 17:11 by nm")


    (* ;; "Read information from the C emulator.  Usually gets info about configuration of the machine we're running on.")


    (* ;; 

"Used to use CL:POSITION, but now called in the INIT if you're on a Sun, so I changed it to STRPOS.")


    (* ;; "SUBRCALL UNIX-GETPARM now returns the length of the string.")


    (if
 (EQ \MACHINETYPE \MAIKO)
        then
 (LET (LEN)
                      (WITH-RESOURCE UNIXSTRING (SETQ LEN (SUBRCALL
 UNIX-GETPARM (MKSTRING NAME)
                                                                 UNIXSTRING))
                             (COND
                                [(SMALLP LEN)
                                 (if
 (> LEN 0)
                                     then
 (CONCAT (SUBSTRING UNIXSTRING 1 LEN]
                                (LEN (CONCAT (SUBSTRING UNIXSTRING 1 (SUB1 (STRPOS #\Null UNIXSTRING])
)

(PUTPROPS SHOWDISPLAY
 ARGNAMES
 (BASE RASTERWIDTH))

(PUTPROPS SETSCREENCOLOR
 ARGNAMES
 (FLG))

(PUTPROPS \WRITERAWPBI
 ARGNAMES
 (PBI))

(PUTPROPS \READRAWPBI
 ARGNAMES
 NIL)

(PUTPROPS RAID
 ARGNAMES
 (MESS1 MESS2 FLG))

(PUTPROPS \LISPFINISH
 ARGNAMES
 (DUMMY))

(PUTPROPS \GETPACKETBUFFER
 ARGNAMES
 NIL)

(PUTPROPS \GATHERSTATS
 ARGNAMES
 (FID))

(PUTPROPS \DSPRATE
 ARGNAMES
 (AC0 AC1 AC2))

(PUTPROPS DSPBOUT
 ARGNAMES
 (CHARCODE))

(PUTPROPS DISKPARTITION
 ARGNAMES
 NIL)

(PUTPROPS \CHECKBCPLPASSWORD
 ARGNAMES
 (PASS CL:VECTOR))

(PUTPROPS LLSUBRS
 FILETYPE
 CL:COMPILE-FILE)
(PUTPROPS LLSUBRS COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1988 1989 1990 1991 1992 
2021))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (4322 9066 (MISCN-NUMBER 4332 . 4548) (\MISCN.UFN 4550 . 6807) (\UNDEFINED-MISCN-UFN 
6809 . 7125) (MISCN-COLLECT 7127 . 7344) (\GET-MY-BF 7346 . 7558) (\INIT-MISCN-TABLE 7560 . 9064)) (
10450 11739 (ADD-USER-SUBR 10450 . 11739)) (11740 13491 (\USER-SUBR-UFN 11750 . 12325) (
\INIT-USER-SUBR-TABLE 12327 . 12792) (\UNDEFINED-USER-SUBR-UFN 12794 . 13137) (USER-SUBR-NUMBER 13139
 . 13361) (EQ-TO-CAR 13363 . 13424) (EQ-TO-CADR 13426 . 13489)) (17774 18423 (SUBRNUMBER 17784 . 18421
)) (18484 20832 (WRITECALLSUBRS 18494 . 20075) (FIX-SUBR-NAME 20077 . 20830)) (21041 26945 (
\MOREVMEMFILE 21051 . 21216) (\WRITEMAP 21218 . 21378) (\COPYSYS0SUBR 21380 . 21540) (\PUPLEVEL1STATE 
21542 . 21706) (SHOWDISPLAY 21708 . 21997) (SETSCREENCOLOR 21999 . 22162) (\WRITERAWPBI 22164 . 22322)
 (\READRAWPBI 22324 . 22476) (RAID 22478 . 22633) (\LISPFINISH 22635 . 22793) (\GETPACKETBUFFER 22795
 . 22957) (\GATHERSTATS 22959 . 23117) (\DSPRATE 23119 . 23386) (DSPBOUT 23388 . 23542) (DISKPARTITION
 23544 . 23839) (\CHECKBCPLPASSWORD 23841 . 24020) (SUSPEND-LISP 24022 . 24280) (UNIX-USERNAME 24282
 . 24804) (UNIX-FULLNAME 24806 . 25332) (UNIX-GETENV 25334 . 25931) (UNIX-GETPARM 25933 . 26943)))))
STOP