(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (FILECREATED "18-Oct-93 16:42:05" "{Pele:mv:envos}Sources>CLTL2>LLSUBRS.;1" 28802 previous date%: "17-Dec-92 14:28:41" "{Pele:mv:envos}Sources>LLSUBRS.;15") (* ; " Copyright (c) 1983, 1984, 1985, 1986, 1988, 1989, 1990, 1991, 1992, 1993 by Venue & Xerox Corporation. All rights reserved. ") (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) (LISP:VALUES 1 LISP::VALUES-UFN NIL) (LISP:SXHASH 2 LISP::SXHASH-UFN NIL) (LISP::EQLHASHBITSFN 3 LISP::EQLHASHBITSFN-UFN NIL) (STRINGHASHBITS 4 \STRINGHASHBITS-UFN NIL) (STRING-EQUAL-HASHBITS 5 \STRING-EQUAL-HASHBITS-UFN NIL) (LISP:VALUES-LIST 6 LISP::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] `(LISP:FUNCALL [LISP: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.") (LISP: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 (LISP: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)) (LISP: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) (LISP: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 (LISP: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) (LISP:FIND USER-SUBR-INDEX \USER-SUBR-LIST :KEY #'LISP:SECOND)) (LISP:CERROR "Delete old User-subr" " User-subr index ~d already defined" USER-SUBR-INDEX) (SETQ \USER-SUBR-LIST (LISP:REMOVE USER-SUBR-INDEX \USER-SUBR-LIST :TEST 'EQ-TO-CADR] (LISP: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 (LISP: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 ((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] `(LISP:FUNCALL [LISP: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) (LISP:WARN "SUBR name (~d) is a number; should be abstracted." NAME) NAME) ((CADR (ASSOC NAME \INITSUBRS))) ([SETQ NUMBER (CADR (LISP:ASSOC NAME \INITSUBRS :TEST (FUNCTION STRING.EQUAL] (LISP: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 6-Nov-89 15:39 by jds") (LISP:WITH-OPEN-FILE (*STANDARD-OUTPUT* "subrs.h" :DIRECTION :OUTPUT :IF-EXISTS :NEW-VERSION) (LISP:FORMAT T "/* This file written from LLSUBRS on ~A */~&" (DATE)) (LISP:FORMAT T "/* Do not edit this file! Instead, edit the list \initsubrs */~&") (LISP:FORMAT T "/* on the lisp file LLSUBRS and then call WRITECALLSUBRS to */~&") (LISP:FORMAT T "/* generate a new version. */~&") (for X in \INITSUBRS do (LISP:FORMAT T "#define sb_~A 0~O~&" (FIX-SUBR-NAME (CAR X)) (CADR X))) (LISP:FORMAT T "~&~&/* MISCN opcodes */~&") (for X in \MISCN-TABLE-LIST do (LISP:FORMAT T "#define miscn_~A 0~O~&" (FIX-SUBR-NAME (CAR X)) (CADR X))) (LISP:FORMAT T "~&~&/* Assigned USER SUBR numbers */~&") (for X in \USER-SUBR-LIST do (LISP:FORMAT T "#define user_subr_~A 0~O~&" (FIX-SUBR-NAME (CAR X)) (CADR X]) (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 (LISP: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 (LISP:POSITION #\Null UNIXSTRING]) (UNIX-GETENV [LAMBDA (NAME) (* ;  "Edited 1-Aug-88 23:13 by masinter") (if (EQ \MACHINETYPE \MAIKO) then (WITH-RESOURCE UNIXSTRING (if (SUBRCALL UNIX-GETENV (MKSTRING NAME) UNIXSTRING) then (CONCAT (SUBSTRING UNIXSTRING 1 (LISP:POSITION #\Null UNIXSTRING]) (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 LISP:VECTOR)) (PUTPROPS LLSUBRS FILETYPE LISP:COMPILE-FILE) (PUTPROPS LLSUBRS COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1988 1989 1990 1991 1992 1993)) (DECLARE%: DONTCOPY (FILEMAP (NIL (3699 8653 (MISCN-NUMBER 3709 . 3992) (\MISCN.UFN 3994 . 6255) (\UNDEFINED-MISCN-UFN 6257 . 6642) (MISCN-COLLECT 6644 . 6928) (\GET-MY-BF 6930 . 7209) (\INIT-MISCN-TABLE 7211 . 8651)) ( 11345 13366 (\USER-SUBR-UFN 11355 . 11997) (\INIT-USER-SUBR-TABLE 11999 . 12529) ( \UNDEFINED-USER-SUBR-UFN 12531 . 12945) (USER-SUBR-NUMBER 12947 . 13236) (EQ-TO-CAR 13238 . 13299) ( EQ-TO-CADR 13301 . 13364)) (17653 18308 (SUBRNUMBER 17663 . 18306)) (18369 20603 (WRITECALLSUBRS 18379 . 19846) (FIX-SUBR-NAME 19848 . 20601)) (20814 27992 (\MOREVMEMFILE 20824 . 21056) (\WRITEMAP 21058 . 21285) (\COPYSYS0SUBR 21287 . 21514) (\PUPLEVEL1STATE 21516 . 21747) (SHOWDISPLAY 21749 . 22105) ( SETSCREENCOLOR 22107 . 22337) (\WRITERAWPBI 22339 . 22564) (\READRAWPBI 22566 . 22785) (RAID 22787 . 23009) (\LISPFINISH 23011 . 23236) (\GETPACKETBUFFER 23238 . 23467) (\GATHERSTATS 23469 . 23694) ( \DSPRATE 23696 . 24093) (DSPBOUT 24095 . 24316) (DISKPARTITION 24318 . 24682) (\CHECKBCPLPASSWORD 24684 . 24863) (SUSPEND-LISP 24865 . 25125) (UNIX-USERNAME 25127 . 25718) (UNIX-FULLNAME 25720 . 26315 ) (UNIX-GETENV 26317 . 26978) (UNIX-GETPARM 26980 . 27990))))) STOP