(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (FILECREATED "13-Sep-2021 17:12:03" ("compiled on " {DSK}briggs>Projects>medley>sources>LLSUBRS.;8) "13-Sep-2021 16:24:48" "COMPILE-FILEd" in "FULL 13-Sep-2021 ..." dated "13-Sep-2021 16:25:04") (FILECREATED "13-Sep-2021 17:12:03" {DSK}briggs>Projects>medley>sources>LLSUBRS.;8 27017 changes to%: (VARS \INITSUBRS) (FNS WRITECALLSUBRS) previous date%: "13-Sep-2021 16:07:08" {DSK}TMP>LLSUBRS.;1) (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)))) (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))) expand-MISCNA0001 :D8 (L (0 X)) (4 GENSYM) NIL () expand-MISCN :D8 (L (1 SI::$$MACRO-ENVIRONMENT 0 SI::$$MACRO-FORM)) s@1HHZ1LdkgNMh_M&OgghggKggI J hKhhhJ(91 LENGTH 85 MISCN-NUMBER) (79 MISCN 74 OPCODES 68 LAMBDA 63 QUOTE 57 CL:COMPILE 52 CL:FUNCALL 24 expand-MISCNA0001) () (SETF-MACRO-FUNCTION (QUOTE MISCN) (QUOTE expand-MISCN)) optimize-MISCN :D8 (L (2 $$CTX 1 $$ENV 0 $$WHOLE)) *@!HHggI J hJ(32 LENGTH 26 MISCN-NUMBER) (20 MISCN 15 OPCODES) () (PUTPROP (QUOTE MISCN) (QUOTE COMPILER:OPTIMIZER-LIST) (CL:ADJOIN (QUOTE optimize-MISCN) (GET (QUOTE MISCN) (QUOTE COMPILER:OPTIMIZER-LIST)))) MISCN-NUMBER :D8 (I 0 NAME F 0 \MISCN-TABLE-LIST) @P @o (15 ERROR) NIL ( 10 " not a MISCN index") \MISCN.UFNA0001 :D8 (NAME SI::*UNWIND-PROTECT* I 0 SI::*CLEANUP-FORMS* F 1 UFN-ENTRY F 2 INDEX F 3 ARG-COUNT F 4 MY-PARMS-PTR) QRSTlHNIL NIL () \MISCN.UFNA0003 :D8 (F 0 RESULT-IVAR F 1 MY-BF F 2 CALLER) kQPkRPPNIL NIL () \MISCN.UFNA0005 :D8 (NAME SI::*UNWIND-PROTECT* I 0 SI::*CLEANUP-FORMS* F 1 UFN-ENTRY F 2 INDEX F 3 ARG-COUNT F 4 MY-PARMS-PTR) QRSTlHNIL NIL () \MISCN.UFNA0007 :D8 (F 0 RESULT-IVAR F 1 MY-BF) kQPPNIL NIL () \MISCN.UFN :D8 (P 7 UFN-ENTRY P 6 MY-PARMS-PTR P 5 RESULT-IVAR P 4 MY-IVAR P 3 MY-BF P 2 CALLER P 1 ARG-COUNT P 0 INDEX I 0 ALPHA-BETA) @@lg `fAkK\IսkMѾ`H_j#g kKMkJM$g kKMkJM(117 \MISCN.UFNA0005 89 \MVLIST 84 \MISCN.UFNA0001 40 \GET-MY-BF 30 \INIT-MISCN-TABLE 18 BOUNDP) (112 \MISCN.UFNA0007 79 \MISCN.UFNA0003 62 \MISCN-TABLE 24 \MISCN-TABLE 13 \MISCN-TABLE) () \UNDEFINED-MISCN-UFN :D8 (I 2 ARG-PTR I 1 ARG-COUNT I 0 INDEX) Ioi @i oi Ai i io@A AB (70 ERROR 65 MISCN-COLLECT 58 CL:FORMAT 45 TERPRI 38 PRIN1 30 PRIN1 18 PRIN1 10 PRIN1) NIL ( 51 "Undefined MISCN[~d] with ~d args." 24 ", arg count " 4 "index ") MISCN-COLLECT :D8 (P 1 I I 1 ARG-PTR I 0 ARG-COUNT) (@kj2IHJAIK Lh[IkYL&NIL NIL () \GET-MY-BF :D8 NIL flNIL NIL () \INIT-MISCN-TABLE :D8 (P 2 BASE P 1 OP-LENGTH P 0 OP-NUMBER) el$l2nggj dZ`-d`LL JL[KLkjJ(66 SETA 25 ARRAY) (98 \MISCN-TABLE 54 \MISCN-TABLE 44 \MISCN-TABLE-LIST 36 ARRAYP 30 \MISCN-TABLE 19 \UNDEFINED-MISCN-UFN 14 POINTER) () (PUTPROPS MISCN ARGNAMES (NAME &REST ARGS)) (RPAQQ \USER-SUBR-LIST ((DUMMY 10 DUMMY-UFN) (SAMPLE-USER-SUBR 0 SAMPLE-USER-SUBR-UFN))) expand-USER-SUBR :D8 (L (1 SI::$$MACRO-ENVIRONMENT 0 SI::$$MACRO-FORM)) !@!HHggI J(26 USER-SUBR-NUMBER) (20 USER-SUBR 15 MISCN) () (SETF-MACRO-FUNCTION (QUOTE USER-SUBR) (QUOTE expand-USER-SUBR)) ADD-USER-SUBR :D8 (L (2 USER-SUBR-UFN 1 USER-SUBR-INDEX 0 USER-SUBR-NAME)) g `@`Ioo@ 7`@`g @`gg `A gA`gg /ooA A`gg @ABgh`(224 \INIT-USER-SUBR-TABLE 188 CL:REMOVE 165 CL:CERROR 147 CL:FIND 142 CL:SYMBOL-FUNCTION 113 ELT 96 CL:REMOVE 73 SETA 47 CL:CERROR 21 \INIT-USER-SUBR-TABLE 9 BOUNDP) (219 \USER-SUBR-LIST 213 \USER-SUBR-LIST 204 \UNDEFINED-USER-SUBR-UFN 193 \USER-SUBR-LIST 183 EQ-TO-CADR 178 :TEST 173 \USER-SUBR-LIST 137 CL:SECOND 132 :KEY 127 \USER-SUBR-LIST 118 \UNDEFINED-USER-SUBR-UFN 107 \USER-SUBR-TABLE 101 \USER-SUBR-LIST 91 EQ-TO-CAR 86 :TEST 81 \USER-SUBR-LIST 68 \UNDEFINED-USER-SUBR-UFN 60 \USER-SUBR-LIST 54 \USER-SUBR-TABLE 28 \USER-SUBR-LIST 15 \USER-SUBR-TABLE 4 \USER-SUBR-TABLE) ( 159 " User-subr index ~d already defined" 154 "Delete old User-subr" 41 "User-subr ~S already defined" 36 "Delete old User-subr") \USER-SUBR-UFN :D8 (P 0 USER-SUBR-INDEX I 2 ARG-PTR I 1 ARG-COUNT I 0 INDEX) 8g `B`H HAkBllI(39 ELT 21 \INIT-USER-SUBR-TABLE 9 BOUNDP) (33 \USER-SUBR-TABLE 15 \USER-SUBR-TABLE 4 \USER-SUBR-TABLE) () \INIT-USER-SUBR-TABLE :D8 NIL =nggj `d`HH h(52 SETA 18 ARRAY) (40 \USER-SUBR-TABLE 28 \USER-SUBR-LIST 23 \USER-SUBR-TABLE 12 \UNDEFINED-USER-SUBR-UFN 7 POINTER) () \UNDEFINED-USER-SUBR-UFN :D8 (I 2 ARG-PTR I 1 ARG-COUNT I 0 USER-SUBR-INDEX) ho@A AB (24 ERROR 19 MISCN-COLLECT 12 CL:FORMAT) NIL ( 5 "Undefined USER-SUBR[~d] with ~d args.") USER-SUBR-NUMBER :D8 (I 0 NAME) @` @o (19 ERROR) (5 \USER-SUBR-LIST) ( 14 " not a USER-SUBR index") EQ-TO-CAR :D8 (L (1 LIST 0 ITEM)) @ANIL NIL () EQ-TO-CADR :D8 (L (1 LIST 0 ITEM)) @ANIL NIL () (PUTPROPS USER-SUBR ARGNAMES (USER-SUBR-NAME &REST ARGS)) (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) (YIELD 210))) expand-SUBRCALLA0001 :D8 (L (0 X)) (4 GENSYM) NIL () expand-SUBRCALL :D8 (L (1 SI::$$MACRO-ENVIRONMENT 0 SI::$$MACRO-FORM)) s@1HHZ1LdkgNMh_M&OgghggKggI J hKhhhJ(91 LENGTH 85 SUBRNUMBER) (79 SUBRCALL 74 OPCODES 68 LAMBDA 63 QUOTE 57 CL:COMPILE 52 CL:FUNCALL 24 expand-SUBRCALLA0001) () (SETF-MACRO-FUNCTION (QUOTE SUBRCALL) (QUOTE expand-SUBRCALL)) optimize-SUBRCALL :D8 (L (2 $$CTX 1 $$ENV 0 $$WHOLE)) *@!HHggI J hJ(32 LENGTH 26 SUBRNUMBER) (20 SUBRCALL 15 OPCODES) () (PUTPROP (QUOTE SUBRCALL) (QUOTE COMPILER:OPTIMIZER-LIST) (CL:ADJOIN (QUOTE optimize-SUBRCALL) (GET ( QUOTE SUBRCALL) (QUOTE COMPILER:OPTIMIZER-LIST)))) SUBRNUMBER :D8 (P 0 NUMBER I 0 NAME F 1 \INITSUBRS) K@d3 o@ @Q/@Qgg Xo@H @o (72 ERROR 60 CL:WARN 44 CL:ASSOC 19 CL:WARN) (39 STRING.EQUAL 34 :TEST) ( 67 " not a SUBR" 53 "SUBR name ~s is in wrong package. Using ~d as subr number." 13 "SUBR name (~d) is a number; should be abstracted.") (PUTPROPS SUBRCALL ARGNAMES (NAME &REST ARGS)) (/SETTOPVAL (QUOTE \UNIXSTRING.GLOBALRESOURCE) NIL) \MOREVMEMFILE :D8 (I 0 FILEPAGE) @}NIL NIL () \WRITEMAP :D8 (I 2 FLAGS I 1 RP I 0 VP) @AB}NIL NIL () \COPYSYS0SUBR :D8 (I 0 FID) @}NIL NIL () \PUPLEVEL1STATE :D8 (I 0 FLG) @}NIL NIL () SHOWDISPLAY :D8 (I 1 RASTERWIDTH I 0 BASE) @A}NIL NIL () SETSCREENCOLOR :D8 (I 0 FLG) @}NIL NIL () \WRITERAWPBI :D8 (I 0 PBI) @}NIL NIL () \READRAWPBI :D8 NIL }NIL NIL () RAID :D8 (I 2 FLG I 1 MESS2 I 0 MESS1) @AB}NIL NIL () \LISPFINISH :D8 (I 0 DUMMY) @} NIL NIL () \GETPACKETBUFFER :D8 NIL } NIL NIL () \GATHERSTATS :D8 (I 0 FID) @} NIL NIL () \DSPRATE :D8 (I 2 AC2 I 1 AC1 I 0 AC0) @AB} NIL NIL () DSPBOUT :D8 (I 0 CHARCODE) @} NIL NIL () DISKPARTITION :D8 NIL 3dgdg}dgdg(48 \DFSCurrentVolume 4 MACHINETYPE) (39 DOVE 31 DANDELION 18 DOLPHIN 10 DORADO) () \CHECKBCPLPASSWORD :D8 (I 1 PASSWORD I 0 USER) @A}NIL NIL () SUSPEND-LISP :D8 NIL g}i(4 MACHINETYPE) (9 MAIKO) () UNIX-USERNAME :D8 (P 0 UNIXSTRING) K`l8`2n H}3HkoH Hh(56 CONCAT 51 SUBSTRING 46 CL:POSITION 24 ALLOCSTRING) (70 \UNIXSTRING.GLOBALRESOURCE 62 \UNIXSTRING.GLOBALRESOURCE 14 \UNIXSTRING.GLOBALRESOURCE 4 \MACHINETYPE) ( 40 #\Null) UNIX-FULLNAME :D8 (P 0 UNIXSTRING) K`l8`2n H}4HkoH Hh(56 CONCAT 51 SUBSTRING 46 CL:POSITION 24 ALLOCSTRING) (70 \UNIXSTRING.GLOBALRESOURCE 62 \UNIXSTRING.GLOBALRESOURCE 14 \UNIXSTRING.GLOBALRESOURCE 4 \MACHINETYPE) ( 40 #\Null) UNIX-GETENV :D8 (P 2 I P 1 X P 0 UNIXSTRING I 0 NAME) ``1n H@ I}53IkdIJ djdihҿhJk HJkԺ(80 CONCAT 75 SUBSTRING 44 NTHCHARCODE 25 MKSTRING 14 ALLOCSTRING) (86 \UNIXSTRING.GLOBALRESOURCE 59 \UNIXSTRING.GLOBALRESOURCE 4 \UNIXSTRING.GLOBALRESOURCE) () UNIX-GETPARM :D8 (P 1 UNIXSTRING P 0 LEN I 0 NAME) e`l[`&n @ I}6Xdj+IkHhݴIkoI k I(91 CONCAT 86 SUBSTRING 79 STRPOS 36 MKSTRING 27 ALLOCSTRING) (97 \UNIXSTRING.GLOBALRESOURCE 61 \UNIXSTRING.GLOBALRESOURCE 17 \UNIXSTRING.GLOBALRESOURCE 4 \MACHINETYPE) ( 73 #\Null) (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)) NIL