From 5a83a9cd8fd45e2b9eafba928e4b29bba4621402 Mon Sep 17 00:00:00 2001 From: Larry Masinter Date: Wed, 17 Mar 2021 00:10:38 -0700 Subject: [PATCH] Add writing guard and running again --- sources/LLSUBRS | 2 +- sources/LLSUBRS.LCOM | Bin 13948 -> 13996 bytes sources/subrs.h | 98 ++++++++++++++++++++++++++++++++++--------- 3 files changed, 79 insertions(+), 21 deletions(-) diff --git a/sources/LLSUBRS b/sources/LLSUBRS index ce9304e5..9a8013c4 100644 --- a/sources/LLSUBRS +++ b/sources/LLSUBRS @@ -1 +1 @@ -(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (FILECREATED "21-Feb-2021 21:20:11" {DSK}larry>medley>sources>LLSUBRS.;2 21799 changes to%: (FNS UNIX-GETENV) previous date%: "17-Dec-92 14:28:41" {DSK}larry>medley>sources>LLSUBRS.;1) (* ; " Copyright (c) 1983, 1984, 1985, 1986, 1988, 1989, 1990, 1991, 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 (QUOTE \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 (QUOTE POINTER) (QUOTE \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 (QUOTE \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 (QUOTE POINTER) (QUOTE \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 ((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 6-Nov-89 15:39 by jds") (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. */~&") (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))))) ) (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) (QUOTE 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 (3635 6424 (MISCN-NUMBER 3645 . 3800) (\MISCN.UFN 3802 . 5257) (\UNDEFINED-MISCN-UFN 5259 . 5527) (MISCN-COLLECT 5529 . 5696) (\GET-MY-BF 5698 . 5841) (\INIT-MISCN-TABLE 5843 . 6422)) ( 7808 9097 (ADD-USER-SUBR 7808 . 9097)) (9098 10463 (\USER-SUBR-UFN 9108 . 9548) (\INIT-USER-SUBR-TABLE 9550 . 9877) (\UNDEFINED-USER-SUBR-UFN 9879 . 10178) (USER-SUBR-NUMBER 10180 . 10341) (EQ-TO-CAR 10343 . 10400) (EQ-TO-CADR 10402 . 10461)) (14726 15375 (SUBRNUMBER 14736 . 15373)) (15436 16843 ( WRITECALLSUBRS 15446 . 16346) (FIX-SUBR-NAME 16348 . 16841)) (17052 20999 (\MOREVMEMFILE 17062 . 17177 ) (\WRITEMAP 17179 . 17292) (\COPYSYS0SUBR 17294 . 17399) (\PUPLEVEL1STATE 17401 . 17510) (SHOWDISPLAY 17512 . 17750) (SETSCREENCOLOR 17752 . 17860) (\WRITERAWPBI 17862 . 17965) (\READRAWPBI 17967 . 18062 ) (RAID 18064 . 18176) (\LISPFINISH 18178 . 18283) (\GETPACKETBUFFER 18285 . 18390) (\GATHERSTATS 18392 . 18495) (\DSPRATE 18497 . 18652) (DSPBOUT 18654 . 18758) (DISKPARTITION 18760 . 18947) ( \CHECKBCPLPASSWORD 18949 . 19081) (SUSPEND-LISP 19083 . 19233) (UNIX-USERNAME 19235 . 19485) ( UNIX-FULLNAME 19487 . 19738) (UNIX-GETENV 19740 . 20337) (UNIX-GETPARM 20339 . 20997))))) STOP \ No newline at end of file +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (FILECREATED "16-Mar-2021 23:00:15" {DSK}larry>ilisp>medley>sources>LLSUBRS.;3 22484 changes to%: (VARS \INITSUBRS) (FNS WRITECALLSUBRS) previous date%: "21-Feb-2021 21:20:11" {DSK}larry>ilisp>medley>sources>LLSUBRS.;1) (* ; " 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 (QUOTE \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 (QUOTE POINTER) (QUOTE \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 (QUOTE \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 (QUOTE POINTER) (QUOTE \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 16-Mar-2021 22:47 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]) (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) (QUOTE 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 (3658 6447 (MISCN-NUMBER 3668 . 3823) (\MISCN.UFN 3825 . 5280) (\UNDEFINED-MISCN-UFN 5282 . 5550) (MISCN-COLLECT 5552 . 5719) (\GET-MY-BF 5721 . 5864) (\INIT-MISCN-TABLE 5866 . 6445)) ( 7831 9120 (ADD-USER-SUBR 7831 . 9120)) (9121 10486 (\USER-SUBR-UFN 9131 . 9571) (\INIT-USER-SUBR-TABLE 9573 . 9900) (\UNDEFINED-USER-SUBR-UFN 9902 . 10201) (USER-SUBR-NUMBER 10203 . 10364) (EQ-TO-CAR 10366 . 10423) (EQ-TO-CADR 10425 . 10484)) (14769 15418 (SUBRNUMBER 14779 . 15416)) (15479 17528 ( WRITECALLSUBRS 15489 . 17031) (FIX-SUBR-NAME 17033 . 17526)) (17737 21684 (\MOREVMEMFILE 17747 . 17862 ) (\WRITEMAP 17864 . 17977) (\COPYSYS0SUBR 17979 . 18084) (\PUPLEVEL1STATE 18086 . 18195) (SHOWDISPLAY 18197 . 18435) (SETSCREENCOLOR 18437 . 18545) (\WRITERAWPBI 18547 . 18650) (\READRAWPBI 18652 . 18747 ) (RAID 18749 . 18861) (\LISPFINISH 18863 . 18968) (\GETPACKETBUFFER 18970 . 19075) (\GATHERSTATS 19077 . 19180) (\DSPRATE 19182 . 19337) (DSPBOUT 19339 . 19443) (DISKPARTITION 19445 . 19632) ( \CHECKBCPLPASSWORD 19634 . 19766) (SUSPEND-LISP 19768 . 19918) (UNIX-USERNAME 19920 . 20170) ( UNIX-FULLNAME 20172 . 20423) (UNIX-GETENV 20425 . 21022) (UNIX-GETPARM 21024 . 21682))))) STOP \ No newline at end of file diff --git a/sources/LLSUBRS.LCOM b/sources/LLSUBRS.LCOM index f488950964660fc088827561a3003d3c6b16c678..696f011141f418c1b5392f142f46c4b31d0b682f 100644 GIT binary patch delta 639 zcmZuuU279T6wQh)XkAQO6$&j}R)wsx>(1;)n?*t>`4TT`A&0-@-w#ymn9qOfaXS1*pZ}yv|KDyyC!`7nVoy6-n=-A&3o6R?@y}D{F$nEHZf4f_82$@ zc%j=SECQiggoN`w4^a6M7Iw`t@R$YBwoaQZ5`t-g8&e*OD{wYJf#Ylp37r3g0=7B5 I{^-rEzbG1|S^xk5 delta 530 zcmZ8c-D(p-7~Szg@Mj^d8e1{=xhQ0m4Lh@&Y<3mNCOcb~u4_9pX)UzS*eq5^yOKmv zM0^6lGM6Iw0Nw=!FQhku@8FdWP<;X~-1MsLckzAad>lCEeBSvtc)z0dQF(80UHw6G z^Av+_5YLRV$0oHX0pj?U?OV>?kK1>Sylb_Z0sY=M>z~kDo?oXvr3TikQJk<2XMtp) z`i|yGuS2o;=I(aBlieHihQn9t0L^bupv3h&*xK&xKFLNf&TslqjZ&dQH;o^e3rwdN+GReVuJb1O$@-&^iR1 z2Wv$}&xZ8}vFN0x4B80;$2-pLtMicK87Al6$UiO#JTnI{C}D7jOPFV diff --git a/sources/subrs.h b/sources/subrs.h index 84096d51..c49b914e 100644 --- a/sources/subrs.h +++ b/sources/subrs.h @@ -1,8 +1,10 @@ -/* This file written from LLSUBRS on 7-Nov-88 14:41:04 */ +/* This file written from LLSUBRS on 16-Mar-2021 23:02:48 */ /* Do not edit this file! Instead, edit the list \initsubrs */ /* on the lisp file LLSUBRS and then call WRITECALLSUBRS to */ /* generate a new version. */ -#define sb_DUMMY_135Q 0135 +#ifndef SUBRS_H +#define SUBRS_H 1 +#define sb_YIELD 0322 #define sb_BACKGROUNDSUBR 06 #define sb_CHECKBCPLPASSWORD 07 #define sb_DISKPARTITION 010 @@ -22,20 +24,14 @@ #define sb_CONTEXTSWITCH 026 #define sb_COPYSYS0SUBR 027 #define sb_WRITEMAP 030 -#define sb_UFS_OPENFILE 040 -#define sb_UFS_CLOSEFILE 041 #define sb_UFS_GETFILENAME 042 #define sb_UFS_DELETEFILE 043 #define sb_UFS_RENAMEFILE 044 -#define sb_UFS_READPAGES 045 -#define sb_UFS_WRITEPAGES 046 -#define sb_UFS_GETSIZE 047 -#define sb_UFS_READDIR 050 +#define sb_COM_READPAGES 045 +#define sb_COM_WRITEPAGES 046 +#define sb_COM_TRUNCATEFILE 047 #define sb_UFS_DIRECTORYNAMEP 051 -#define sb_UFS_GETFILEINFO 052 -#define sb_UFS_DIRSIZE 053 -#define sb_UFS_CHANGEDIR 054 -#define sb_UFS_GETFREEBLOCK 055 +#define sb_COM_GETFREEBLOCK 055 #define sb_SETUNIXTIME 060 #define sb_GETUNIXTIME 061 #define sb_COPYTIMESTATS 062 @@ -46,6 +42,7 @@ #define sb_CHECK_SUM 067 #define sb_ETHER_SUSPEND 070 #define sb_ETHER_RESUME 071 +#define sb_ETHER_AVAILABLE 072 #define sb_ETHER_RESET 073 #define sb_ETHER_GET 074 #define sb_ETHER_SEND 075 @@ -58,34 +55,95 @@ #define sb_DSP_SCREENHEIGHT 0104 #define sb_BITBLTSUB 0105 #define sb_BLTCHAR 0106 +#define sb_TEDIT_BLTCHAR 0107 +#define sb_BITBLT_BITMAP 0110 +#define sb_BLTSHADE_BITMAP 0111 +#define sb_RS232C_CMD 0112 +#define sb_RS232C_READ_INIT 0113 +#define sb_RS232C_WRITE 0114 #define sb_KEYBOARDBEEP 0120 +#define sb_KEYBOARDMAP 0121 #define sb_KEYBOARDSTATE 0122 #define sb_VMEMSAVE 0131 #define sb_LISP_FINISH 0132 #define sb_NEWPAGE 0133 #define sb_DORECLAIM 0134 +#define sb_DUMMY_135Q 0135 #define sb_NATIVE_MEMORY_REFERENCE 0136 #define sb_OLD_COMPILE_LOAD_NATIVE 0137 -#define sb_UFS_SETFILEINFO 0146 -#define sb_DSK_SETFILEINFO 0147 -#define sb_DSK_OPENFILE 0150 -#define sb_DSK_CLOSEFILE 0151 +#define sb_DISABLEGC 0140 +#define sb_COM_SETFILEINFO 0147 +#define sb_COM_OPENFILE 0150 +#define sb_COM_CLOSEFILE 0151 #define sb_DSK_GETFILENAME 0152 #define sb_DSK_DELETEFILE 0153 #define sb_DSK_RENAMEFILE 0154 -#define sb_DSK_READDIR 0160 +#define sb_COM_NEXT_FILE 0156 +#define sb_COM_FINISH_FINFO 0157 +#define sb_COM_GEN_FILES 0160 #define sb_DSK_DIRECTORYNAMEP 0161 -#define sb_DSK_GETFILEINFO 0162 -#define sb_DSK_DIRSIZE 0163 -#define sb_DSK_CHANGEDIR 0164 +#define sb_COM_GETFILEINFO 0162 +#define sb_COM_CHANGEDIR 0164 #define sb_UNIX_HANDLECOMM 0165 #define sb_RPC_CALL 0167 #define sb_MESSAGE_READP 0170 #define sb_MESSAGE_READ 0171 +#define sb_MONITOR_CONTROL 0200 #define sb_GET_NATIVE_ADDR_FROM_LISP_PTR 0203 #define sb_GET_LISP_PTR_FROM_NATIVE_ADDR 0204 #define sb_LOAD_NATIVE_FILE 0205 #define sb_SUSPEND_LISP 0206 #define sb_NEW_BLTCHAR 0207 +#define sb_COLOR_INIT 0210 +#define sb_COLOR_SCREENMODE 0211 +#define sb_COLOR_MAP 0212 +#define sb_COLOR_BASE 0213 +#define sb_C_SlowBltChar 0214 +#define sb_UNCOLORIZE_BITMAP 0215 +#define sb_COLORIZE_BITMAP 0216 +#define sb_COLOR_8BPPDRAWLINE 0217 +#define sb_TCP_OP 0220 +#define sb_WITH_SYMBOL 0221 +#define sb_CAUSE_INTERRUPT 0222 +#define sb_OPEN_SOCKET 0240 +#define sb_CLOSE_SOCKET 0241 +#define sb_READ_SOCKET 0242 +#define sb_WRITE_SOCKET 0243 +#define sb_CALL_C_FUNCTION 0247 +#define sb_DLD_LINK 0250 +#define sb_DLD_UNLINK_BY_FILE 0251 +#define sb_DLD_UNLINK_BY_SYMBOL 0252 +#define sb_DLD_GET_SYMBOL 0253 +#define sb_DLD_GET_FUNC 0254 +#define sb_DLD_FUNCTION_EXECUTABLE_P 0255 +#define sb_DLD_LIST_UNDEFINED_SYMBOLS 0256 +#define sb_C_MALLOC 0257 +#define sb_C_FREE 0260 +#define sb_C_PUTBASEBYTE 0261 +#define sb_C_GETBASEBYTE 0262 +#define sb_CHAR_OPENFILE 0310 +#define sb_CHAR_BIN 0311 +#define sb_CHAR_BOUT 0312 +#define sb_CHAR_IOCTL 0313 +#define sb_CHAR_CLOSEFILE 0314 +#define sb_CHAR_EOFP 0315 +#define sb_CHAR_READP 0316 +#define sb_CHAR_BINS 0317 +#define sb_CHAR_BOUTS 0320 +#define sb_CHAR_FILLBUFFER 0321 +/* MISCN opcodes */ #define miscn_USER_SUBR 00 +#define miscn_VALUES 01 +#define miscn_SXHASH 02 +#define miscn_EQLHASHBITSFN 03 +#define miscn_STRINGHASHBITS 04 +#define miscn_STRING_EQUAL_HASHBITS 05 +#define miscn_VALUES_LIST 06 +#define miscn_LCFetchMethod 07 +#define miscn_LCFetchMethodOrHelp 010 +#define miscn_LCFindVarIndex 011 +#define miscn_LCGetIVValue 012 +#define miscn_LCPutIVValue 013 +/* Assigned USER SUBR numbers */ +#define user_subr_DUMMY 012 #define user_subr_SAMPLE_USER_SUBR 00