github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-05-03 22:59:35 +00:00
Code Issues Projects Releases Wiki Activity

Merge branch 'master' into Remake-CMLARITH-filemap

Browse Source 
Signed-off-by: Matt Heffron <mattheffron475@gmail.com>
This commit is contained in:
Matt Heffron
2023-10-29 22:38:03 -07:00
committed by GitHub
parent df8c5a52f1 9054814ef7
commit 2ea1321d81
116 changed files with 6356 additions and 3113 deletions
Download Patch File Download Diff File Expand all files Collapse all files

117
sources/ADIR
View File

@@ -1,13 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "11-May-2023 21:39:25" {DSK}<cygdrive>c>Users>Larry>home>il>MEDLEY>SOURCES>ADIR.;2 65907
(FILECREATED "14-Sep-2023 23:20:17" {WMEDLEY}<sources>ADIR.;30 67297
:EDIT-BY "lmm"
:EDIT-BY rmk
:CHANGES-TO (FNS OPENFILE)
:CHANGES-TO (FNS \COPYSYS)
:PREVIOUS-DATE "31-Oct-2022 23:50:03"
{DSK}<cygdrive>c>Users>Larry>home>il>MEDLEY>SOURCES>ADIR.;1)
:PREVIOUS-DATE "14-Sep-2023 22:56:19" {WMEDLEY}<sources>ADIR.;29)
(PRETTYCOMPRINT ADIRCOMS)
@@ -79,16 +78,18 @@
(\GETFILENAME X RECOG])
(INFILE
[LAMBDA (FILE) (* rmk%: " 3-OCT-79 14:23")
(INPUT (OPENFILE FILE 'INPUT 'OLD])
[LAMBDA (FILE) (* ; "Edited 14-Sep-2023 22:40 by rmk")
(* rmk%: " 3-OCT-79 14:23")
(INPUT (OPENSTREAM FILE 'INPUT 'OLD])
(INFILEP
[LAMBDA (FILE) (* rmk%: " 9-OCT-79 22:39")
(\GETFILENAME FILE 'OLD])
(IOFILE
[LAMBDA (FILE) (* rmk%: " 5-SEP-81 13:54")
(OPENFILE FILE 'BOTH 'OLD])
[LAMBDA (FILE) (* ; "Edited 14-Sep-2023 22:56 by rmk")
(* rmk%: " 5-SEP-81 13:54")
(OPENSTREAM FILE 'BOTH 'OLD])
(OPENFILE
[LAMBDA (FILE ACCESS RECOG PARAMETERS OPTIONAL) (* ; "Edited 11-May-2023 21:05 by lmm")
@@ -167,8 +168,9 @@
(RETURN STREAM])
(OUTFILE
[LAMBDA (FILE) (* rmk%: " 3-OCT-79 14:24")
(OUTPUT (OPENFILE FILE 'OUTPUT 'NEW])
[LAMBDA (FILE) (* ; "Edited 13-Sep-2023 17:59 by rmk")
(* rmk%: " 3-OCT-79 14:24")
(OUTPUT (OPENSTREAM FILE 'OUTPUT 'NEW])
(OUTFILEP
[LAMBDA (FILE) (* rmk%: " 9-OCT-79 22:39")
@@ -195,50 +197,69 @@
(fetch (IFPAGE NActivePages) of \InterfacePage])
(\COPYSYS
[LAMBDA (FILE SYSNAME DONTSAVE) (* ; "Edited 31-Oct-2022 23:49 by rmk")
[LAMBDA (FILE SYSNAME DONTSAVE) (* ; "Edited 14-Sep-2023 23:19 by rmk")
(* ; "Edited 3-Jul-2023 19:21 by rmk")
(* ; "Edited 1-Jul-2023 12:34 by rmk")
(* ; "Edited 29-Jun-2023 11:41 by rmk")
(* ; "Edited 31-Oct-2022 23:49 by rmk")
(* ; "Edited 16-Mar-2021 19:46 by larry")
(PROG (FULLNAME VAL TFILE THOST)
(PROG (TEMPNAME VAL TARGETFILE TARGETHOST PSEUDOHOSTP)
RETRY
(SETQ FILE (PACKFILENAME.STRING 'BODY FILE 'BODY "WORK.SYSOUT" 'BODY \CONNECTED.DIRECTORY))
(SETQ TFILE (TRUEFILENAME FILE))
[SELECTQ [SETQ THOST (U-CASE (FILENAMEFIELD TFILE 'HOST]
(DSK [SETQ FULLNAME (PACKFILENAME.STRING 'HOST THOST 'NAME 'tmp 'EXTENSION 'SYSOUT
(* ;; "RMK: Get the full target name, including version in particular for DSK, at the outset so we know what the RENAMEFILE will do and we can return that value.")
(* ;; "We try to make the temp file on the same device, so that the RENAMEFILE (hopefully) won't do a copy. ")
(* ;; "The reason for all this fooling around is because \FLUSHVM doesn't like version numbers.")
(* ;; "")
(* ;; "Perhaps we should also check the value of RENAMEFILE to make sure it succeeded?")
(SETQ FILE (OUTFILEP (PACKFILENAME.STRING 'BODY FILE 'BODY "WORK.SYSOUT" 'BODY
\CONNECTED.DIRECTORY)))
(SETQ PSEUDOHOSTP (PSEUDOHOSTP FILE)) (* ;
 "In order to return the expected name at the end.")
(SETQ TARGETFILE (TRUEFILENAME FILE))
[SELECTQ [SETQ TARGETHOST (U-CASE (FILENAMEFIELD TARGETFILE 'HOST]
(DSK [SETQ TEMPNAME (PACKFILENAME.STRING 'HOST TARGETHOST 'NAME 'tmp 'EXTENSION
'SYSOUT
'BODY
(\UFS.RECOGNIZE.FILE TFILE 'NON (\GETDEVICEFROMNAME THOST]
(SETQ VAL (\FLUSHVM FULLNAME))
(SETQ FULLNAME (RENAMEFILE FULLNAME FILE)))
(UNIX [SETQ FULLNAME (CONCAT "{" THOST "}" (\UFS.RECOGNIZE.FILE TFILE 'NON (
\GETDEVICEFROMNAME
THOST]
(\UFS.RECOGNIZE.FILE TARGETFILE 'NON (\GETDEVICEFROMNAME
TARGETHOST]
(SETQ VAL (\FLUSHVM TEMPNAME)))
(UNIX [SETQ TEMPNAME (CONCAT "{" TARGETHOST "}" (\UFS.RECOGNIZE.FILE TARGETFILE
'NON
(\GETDEVICEFROMNAME TARGETHOST]
(* ; "\DOFLUSHVM ")
(SETQ VAL (\FLUSHVM FULLNAME))
(SETQ FULLNAME (RENAMEFILE FULLNAME FILE)))
(SETQ VAL (\FLUSHVM TEMPNAME)))
(PROGN (SETQ VAL (\FLUSHVM))
(LET ((UNIXVAR (UNIX-GETENV "LDEDESTSYSOUT")))
(LET ((LDEDEST (UNIX-GETENV "LDEDESTSYSOUT")))
(* ;
 "\FLSUVM saves image to Unix enviroment var or lisp.virtualmem")
(SETQ FULLNAME (COPYFILE (COND
(UNIXVAR (CONCAT "{DSK}" UNIXVAR))
 "\FLUSHVM saves image to Unix enviroment var or lisp.virtualmem. LDEDEST is assumed to be DSK??")
(SETQ TEMPNAME (COPYFILE (COND
(LDEDEST (CONCAT "{DSK}" LDEDEST))
(T "{DSK}~/lisp.virtualmem"))
FILE
TARGETFILE
'((TYPE BINARY]
(COND
((NULL VAL)
(* ;; "First clause of OR is T when resuming this vmem; second is starting the sysout. Unless \COPYSYS1 itself does a \FLUSHVM, the second never returns T, yes? NIL is normal return (continuing in same image), <fixp> is error return")
(* ; "Continuing in the current image")
((NULL VAL) (* ; "Continuing in the current image")
(CL:WHEN TARGETFILE (RENAMEFILE TEMPNAME TARGETFILE))
(\DAYTIME0 \LASTUSERACTION)
(RETURN FULLNAME))
(RETURN (CL:IF PSEUDOHOSTP
(PSEUDOFILENAME TARGETFILE)
TARGETFILE)))
((AND (SMALLP VAL)
(IGREATERP 0 VAL)) (* ;
 "Error occurred while making sysout.")
(LISPERROR (IMINUS VAL)
FULLNAME)
TEMPNAME)
(GO RETRY))
(T (* ; "Starting sysout")
(T (* ; "Restarting sysout")
(\CLEARSYSBUF T) (* ; "Get rid of any spurious typeahead")
(\RESETKEYBOARD) (* ; "Enable keyhandler")
(RETURN (LIST FULLNAME])
(RETURN (LIST (OR FILE TEMPNAME])
(\FLUSHVM
[LAMBDA (MAIKO.SYSOUTFILE) (* ; "Edited 16-Mar-2021 10:59 by larry")
@@ -1229,14 +1250,14 @@
(ADDTOVAR LAMA PACKFILENAME.STRING PACKFILENAME)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (3175 14373 (DELFILE 3185 . 3346) (FULLNAME 3348 . 3715) (INFILE 3717 . 3865) (INFILEP
3867 . 4002) (IOFILE 4004 . 4144) (OPENFILE 4146 . 4449) (OPENSTREAM 4451 . 8791) (OUTFILE 8793 . 8944
) (OUTFILEP 8946 . 9082) (RENAMEFILE 9084 . 9390) (SIMPLE.FINDFILE 9392 . 9802) (VMEMSIZE 9804 . 9971)
(\COPYSYS 9973 . 13092) (\FLUSHVM 13094 . 14166) (\LOGOUT0 14168 . 14371)) (14831 36736 (
UNPACKFILENAME.STRING 14841 . 34115) (\UPF.DIRECTORY 34117 . 36734)) (38264 40936 (UNPACKFILENAME
38274 . 38460) (LASTCHPOS 38462 . 39156) (FILENAMEFIELD 39158 . 39643) (FILENAMEFIELD.STRING 39645 .
40224) (PACKFILENAME 40226 . 40569) (PACKFILENAME.STRING 40571 . 40934)) (55406 56319 (
FILEDIRCASEARRAY 55416 . 56317)) (56486 63666 (LOGOUT 56496 . 57413) (MAKESYS 57415 . 59044) (SYSOUT
59046 . 60598) (SAVEVM 60600 . 61400) (HERALD 61402 . 61562) (INTERPRET.REM.CM 61564 . 63289) (
\USEREVENT 63291 . 63664)) (63848 65575 (USERNAME 63858 . 64814) (SETUSERNAME 64816 . 65573)))))
(FILEMAP (NIL (3106 15763 (DELFILE 3116 . 3277) (FULLNAME 3279 . 3646) (INFILE 3648 . 3907) (INFILEP
3909 . 4044) (IOFILE 4046 . 4297) (OPENFILE 4299 . 4602) (OPENSTREAM 4604 . 8944) (OUTFILE 8946 . 9208
) (OUTFILEP 9210 . 9346) (RENAMEFILE 9348 . 9654) (SIMPLE.FINDFILE 9656 . 10066) (VMEMSIZE 10068 .
10235) (\COPYSYS 10237 . 14482) (\FLUSHVM 14484 . 15556) (\LOGOUT0 15558 . 15761)) (16221 38126 (
UNPACKFILENAME.STRING 16231 . 35505) (\UPF.DIRECTORY 35507 . 38124)) (39654 42326 (UNPACKFILENAME
39664 . 39850) (LASTCHPOS 39852 . 40546) (FILENAMEFIELD 40548 . 41033) (FILENAMEFIELD.STRING 41035 .
41614) (PACKFILENAME 41616 . 41959) (PACKFILENAME.STRING 41961 . 42324)) (56796 57709 (
FILEDIRCASEARRAY 56806 . 57707)) (57876 65056 (LOGOUT 57886 . 58803) (MAKESYS 58805 . 60434) (SYSOUT
60436 . 61988) (SAVEVM 61990 . 62790) (HERALD 62792 . 62952) (INTERPRET.REM.CM 62954 . 64679) (
\USEREVENT 64681 . 65054)) (65238 66965 (USERNAME 65248 . 66204) (SETUSERNAME 66206 . 66963)))))
STOP

BIN
sources/ADIR.LCOM
View File

Binary file not shown.

131
sources/CMLCOMPILE
View File

@@ -1,20 +1,48 @@
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED " 2-Jul-90 20:24:02" |{PELE:MV:ENVOS}<LISPCORE>SOURCES>CMLCOMPILE.;7| 21037
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
changes to%: (FNS COMPILE-FILE-EXPRESSION FAKE-COMPILE-FILE COMPILE-FILE-SCAN-FIRST)
(FILECREATED "24-Sep-2023 14:11:25" {WMEDLEY}<sources>CMLCOMPILE.;2 22597
previous date%: "30-Jun-90 18:55:12" |{PELE:MV:ENVOS}<LISPCORE>SOURCES>CMLCOMPILE.;6|)
:EDIT-BY rmk
:CHANGES-TO (FNS COMPILE-IN-CORE)
:PREVIOUS-DATE " 2-Jul-90 20:24:02" {WMEDLEY}<sources>CMLCOMPILE.;1)
(* ; "
Copyright (c) 1985, 1986, 1987, 1990 by Venue & Xerox Corporation. All rights reserved.
Copyright (c) 1985-1987, 1990 by Venue & Xerox Corporation.
")
(PRETTYCOMPRINT CMLCOMPILECOMS)
(RPAQQ CMLCOMPILECOMS ((COMS (FUNCTIONS CL:DISASSEMBLE) (FNS FAKE-COMPILE-FILE INTERLISP-FORMAT-P INTERLISP-NLAMBDA-FUNCTION-P COMPILE-FILE-EXPRESSION COMPILE-FILE-WALK-FUNCTION ARGTYPE.STATE COMPILE.CHECK.ARGTYPE COMPILE.FILE.DEFINEQ COMPILE-FILE-SETF-SYMBOL-FUNCTION COMPILE-FILE-EX/IMPORT COMPILE.FILE.APPLY COMPILE.FILE.RESET COMPILE-IN-CORE) (FNS COMPILE-FILE-SCAN-FIRST) (* ; "This function is support for AR#11185") (VARS ARGTYPE.VARS) (PROP COMPILE-FILE-EXPRESSION DEFINEQ * SETF-SYMBOL-FUNCTION PRETTYCOMPRINT) (FUNCTIONS COMPILE-FILE-DECLARE%:)) (COMS (FNS NEWDEFC) (DECLARE%: DONTEVAL@LOAD DOCOPY (P (MOVD (QUOTE NEWDEFC) (QUOTE DEFC))))) (PROP FILETYPE CMLCOMPILE) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) (NLAML) (LAMA FAKE-COMPILE-FILE)))))
(RPAQQ CMLCOMPILECOMS
[(COMS (FUNCTIONS CL:DISASSEMBLE)
(FNS FAKE-COMPILE-FILE INTERLISP-FORMAT-P INTERLISP-NLAMBDA-FUNCTION-P
COMPILE-FILE-EXPRESSION COMPILE-FILE-WALK-FUNCTION ARGTYPE.STATE
COMPILE.CHECK.ARGTYPE COMPILE.FILE.DEFINEQ COMPILE-FILE-SETF-SYMBOL-FUNCTION
COMPILE-FILE-EX/IMPORT COMPILE.FILE.APPLY COMPILE.FILE.RESET COMPILE-IN-CORE)
(FNS COMPILE-FILE-SCAN-FIRST)
(* ;
 "This function is support for AR#11185")
(VARS ARGTYPE.VARS)
(PROP COMPILE-FILE-EXPRESSION DEFINEQ * SETF-SYMBOL-FUNCTION PRETTYCOMPRINT)
(FUNCTIONS COMPILE-FILE-DECLARE%:))
[COMS (FNS NEWDEFC)
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (MOVD 'NEWDEFC 'DEFC]
(PROP FILETYPE CMLCOMPILE)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
(LAMA FAKE-COMPILE-FILE])
(CL:DEFUN CL:DISASSEMBLE (NAME-OR-COMPILED-FUNCTION &KEY LEVEL-P (RADIX 8) (OUTPUT *STANDARD-OUTPUT*) FIRST-BYTE MARKED-PC) (PRINTCODE (if (CCODEP NAME-OR-COMPILED-FUNCTION) then NAME-OR-COMPILED-FUNCTION else (CL:COMPILE NIL (if (CL:SYMBOLP NAME-OR-COMPILED-FUNCTION) then (CL:SYMBOL-FUNCTION NAME-OR-COMPILED-FUNCTION) else NAME-OR-COMPILED-FUNCTION))) LEVEL-P RADIX OUTPUT FIRST-BYTE MARKED-PC))
(CL:DEFUN CL:DISASSEMBLE (NAME-OR-COMPILED-FUNCTION &KEY LEVEL-P (RADIX 8)
(OUTPUT *STANDARD-OUTPUT*)
FIRST-BYTE MARKED-PC)
(PRINTCODE (if (CCODEP NAME-OR-COMPILED-FUNCTION)
then NAME-OR-COMPILED-FUNCTION
else (CL:COMPILE NIL (if (CL:SYMBOLP NAME-OR-COMPILED-FUNCTION)
then (CL:SYMBOL-FUNCTION NAME-OR-COMPILED-FUNCTION)
else NAME-OR-COMPILED-FUNCTION)))
LEVEL-P RADIX OUTPUT FIRST-BYTE MARKED-PC))
(DEFINEQ
(FAKE-COMPILE-FILE
@@ -132,18 +160,24 @@ Copyright (c) 1985, 1986, 1987, 1990 by Venue & Xerox Corporation. All rights r
(COMPILE-IN-CORE
[LAMBDA (fn-name fn-expr fn-type NOSAVE)
(DECLARE (SPECVARS LCFIL LAPFLG STRF SVFLG LSTFIL SPECVARS LOCALVARS DONT-TRANSFER-PUTD))
(* ; "Edited 24-Sep-2023 14:11 by rmk")
(* lmm " 2-Jun-86 22:04")
(* ;; "in-core compiling for functions and forms, without the interview. if X is a list, we assume that we are being called merely to display the lap and machine code. the form is compiled as the definition of FOO but the compiled CODE is thrown away. --- if X is a litatom, then saving, redefining, and printing is controlled by the flags.")
(* in-core compiling for functions and forms, without the interview.
 if X is a list, we assume that we are being called merely to display the lap
 and machine code. the form is compiled as the definition of FOO but the
 compiled :CODE is thrown away. -
 if X is a litatom, then saving, redefining, and printing is controlled by the
 flags.)
 if X is a list, we assume that we are being called merely to display the lap and
 machine code. the form is compiled as the definition of FOO but the compiled
 :CODE is thrown away. -
 if X is a litatom, then saving, redefining, and printing is controlled by the
 flags.)
(LET ((NOREDEFINE NIL)
(PRINTLAP NIL)
(DONT-TRANSFER-PUTD T))
(* ;; "RMK: Is it really worth saving NULLFILE from one invocation to the next?")
(RESETVARS [(NLAMA NLAMA)
(NLAML NLAML)
(LAMS LAMS)
@@ -155,10 +189,9 @@ Copyright (c) 1985, 1986, 1987, 1990 by Venue & Xerox Corporation. All rights r
(STREAMP NULLFILE)
(OPENP NULLFILE))
NULLFILE)
(T (SETQ NULLFILE (OPENFILE '{NULL} 'OUTPUT]
(RETURN (RESETLST (* RESETLST to provide reset context
 for macros under COMPILE1 as
 generated e.g. by DECL.)
(T (SETQ NULLFILE (OPENSTREAM '{NULL} 'OUTPUT]
(RETURN (RESETLST (* ;
 "RESETLST to provide reset context for macros under COMPILE1 as generated e.g. by DECL.")
[PROG ((LCFIL)
[LAPFLG (AND PRINTLAP (COND
(BYTECOMPFLG T)
@@ -186,17 +219,46 @@ Copyright (c) 1985, 1986, 1987, 1990 by Venue & Xerox Corporation. All rights r
(* ; "This function is support for AR#11185")
(RPAQQ ARGTYPE.VARS ((1 NLAML "NLAMBDA spread") (2 LAMA "LAMBDA nospread") (0 LAMS "LAMBDA spread") (3 NLAMA "NLAMBDA no-spread")))
(RPAQQ ARGTYPE.VARS ((1 NLAML "NLAMBDA spread")
(2 LAMA "LAMBDA nospread")
(0 LAMS "LAMBDA spread")
(3 NLAMA "NLAMBDA no-spread")))
(PUTPROPS DEFINEQ COMPILE-FILE-EXPRESSION COMPILE.FILE.DEFINEQ)
(PUTPROPS DEFINEQ COMPILE-FILE-EXPRESSION COMPILE.FILE.DEFINEQ)
(PUTPROPS * COMPILE-FILE-EXPRESSION NILL)
(PUTPROPS * COMPILE-FILE-EXPRESSION NILL)
(PUTPROPS SETF-SYMBOL-FUNCTION COMPILE-FILE-EXPRESSION COMPILE-FILE-SETF-SYMBOL-FUNCTION)
(PUTPROPS SETF-SYMBOL-FUNCTION COMPILE-FILE-EXPRESSION COMPILE-FILE-SETF-SYMBOL-FUNCTION)
(PUTPROPS PRETTYCOMPRINT COMPILE-FILE-EXPRESSION NILL)
(PUTPROPS PRETTYCOMPRINT COMPILE-FILE-EXPRESSION NILL)
(CL:DEFUN COMPILE-FILE-DECLARE%: (FORM COMPILED.FILE EVAL@COMPILE DOCOPY DEFER) (CL:DO ((TAIL (CDR FORM) (CDR TAIL))) ((CL:ENDP TAIL)) (CL:IF (CL:SYMBOLP (CAR TAIL)) (CASE (CAR TAIL) ((EVAL@LOAD DOEVAL@LOAD DONTEVAL@LOAD) NIL) ((EVAL@LOADWHEN) (CL:POP TAIL)) ((EVAL@COMPILE DOEVAL@COMPILE) (SETQ EVAL@COMPILE T)) ((DONTEVAL@COMPILE) (SETQ EVAL@COMPILE NIL)) ((EVAL@COMPILEWHEN) (SETQ EVAL@COMPILE (EVAL (CAR (SETQ TAIL (CDR TAIL)))))) ((COPY DOCOPY) (SETQ DOCOPY T)) ((DONTCOPY) (SETQ DOCOPY NIL)) ((COPYWHEN) (SETQ DOCOPY (EVAL (CAR (SETQ TAIL (CDR TAIL)))))) ((FIRST)) ((NOTFIRST COMPILERVARS)) (CL:OTHERWISE (CL:FORMAT COUTFILE "Warning: Ignoring unrecognized DECLARE: tag: ~S~%%" (CAR TAIL)))) (COND ((EQ (QUOTE DECLARE%:) (CAR (CAR TAIL))) (COMPILE-FILE-DECLARE%: (CAR TAIL) COMPILED.FILE EVAL@COMPILE DOCOPY DEFER)) (T (CL:WHEN EVAL@COMPILE (EVAL (CAR TAIL))) (CL:WHEN DOCOPY (COMPILE-FILE-EXPRESSION (CAR TAIL) COMPILED.FILE EVAL@COMPILE DEFER)))))))
(CL:DEFUN COMPILE-FILE-DECLARE%: (FORM COMPILED.FILE EVAL@COMPILE DOCOPY DEFER)
(CL:DO ((TAIL (CDR FORM)
(CDR TAIL)))
((CL:ENDP TAIL))
(CL:IF (CL:SYMBOLP (CAR TAIL))
(CASE (CAR TAIL)
((EVAL@LOAD DOEVAL@LOAD DONTEVAL@LOAD) NIL)
((EVAL@LOADWHEN) (CL:POP TAIL))
((EVAL@COMPILE DOEVAL@COMPILE) (SETQ EVAL@COMPILE T))
((DONTEVAL@COMPILE) (SETQ EVAL@COMPILE NIL))
((EVAL@COMPILEWHEN) [SETQ EVAL@COMPILE (EVAL (CAR (SETQ TAIL (CDR TAIL])
((COPY DOCOPY) (SETQ DOCOPY T))
((DONTCOPY) (SETQ DOCOPY NIL))
((COPYWHEN) [SETQ DOCOPY (EVAL (CAR (SETQ TAIL (CDR TAIL])
((FIRST) )
((NOTFIRST COMPILERVARS) )
(CL:OTHERWISE (CL:FORMAT COUTFILE "Warning: Ignoring unrecognized DECLARE: tag: ~S~%%"
(CAR TAIL))))
[COND
((EQ 'DECLARE%: (CAR (CAR TAIL)))
(COMPILE-FILE-DECLARE%: (CAR TAIL)
COMPILED.FILE EVAL@COMPILE DOCOPY DEFER))
(T (CL:WHEN EVAL@COMPILE
(EVAL (CAR TAIL)))
(CL:WHEN DOCOPY
(COMPILE-FILE-EXPRESSION (CAR TAIL)
COMPILED.FILE EVAL@COMPILE DEFER))])))
(DEFINEQ
(NEWDEFC
@@ -228,25 +290,26 @@ Copyright (c) 1985, 1986, 1987, 1990 by Venue & Xerox Corporation. All rights r
)
(DECLARE%: DONTEVAL@LOAD DOCOPY
(MOVD (QUOTE NEWDEFC) (QUOTE DEFC))
(MOVD 'NEWDEFC 'DEFC)
)
(PUTPROPS CMLCOMPILE FILETYPE CL:COMPILE-FILE)
(PUTPROPS CMLCOMPILE FILETYPE CL:COMPILE-FILE)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA)
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML)
(ADDTOVAR NLAML )
(ADDTOVAR LAMA FAKE-COMPILE-FILE)
(ADDTOVAR LAMA FAKE-COMPILE-FILE)
)
(PUTPROPS CMLCOMPILE COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1990))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1675 16480 (FAKE-COMPILE-FILE 1685 . 5121) (INTERLISP-FORMAT-P 5123 . 5341) (
INTERLISP-NLAMBDA-FUNCTION-P 5343 . 5577) (COMPILE-FILE-EXPRESSION 5579 . 8929) (
COMPILE-FILE-WALK-FUNCTION 8931 . 9178) (ARGTYPE.STATE 9180 . 9340) (COMPILE.CHECK.ARGTYPE 9342 .
11334) (COMPILE.FILE.DEFINEQ 11336 . 11829) (COMPILE-FILE-SETF-SYMBOL-FUNCTION 11831 . 12425) (
COMPILE-FILE-EX/IMPORT 12427 . 12755) (COMPILE.FILE.APPLY 12757 . 13017) (COMPILE.FILE.RESET 13019 .
13880) (COMPILE-IN-CORE 13882 . 16478)) (16481 18210 (COMPILE-FILE-SCAN-FIRST 16491 . 18208)) (19612
20676 (NEWDEFC 19622 . 20674)))))
(FILEMAP (NIL (1636 2253 (CL:DISASSEMBLE 1636 . 2253)) (2254 17523 (FAKE-COMPILE-FILE 2264 . 5700) (
INTERLISP-FORMAT-P 5702 . 5920) (INTERLISP-NLAMBDA-FUNCTION-P 5922 . 6156) (COMPILE-FILE-EXPRESSION
6158 . 9508) (COMPILE-FILE-WALK-FUNCTION 9510 . 9757) (ARGTYPE.STATE 9759 . 9919) (
COMPILE.CHECK.ARGTYPE 9921 . 11913) (COMPILE.FILE.DEFINEQ 11915 . 12408) (
COMPILE-FILE-SETF-SYMBOL-FUNCTION 12410 . 13004) (COMPILE-FILE-EX/IMPORT 13006 . 13334) (
COMPILE.FILE.APPLY 13336 . 13596) (COMPILE.FILE.RESET 13598 . 14459) (COMPILE-IN-CORE 14461 . 17521))
(17524 19253 (COMPILE-FILE-SCAN-FIRST 17534 . 19251)) (19796 21163 (COMPILE-FILE-DECLARE%: 19796 .
21163)) (21164 22228 (NEWDEFC 21174 . 22226)))))
STOP

BIN
sources/CMLCOMPILE.LCOM
View File

Binary file not shown.

120
sources/COMPILE
View File

@@ -1,11 +1,13 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS)
(FILECREATED " 5-Jul-2021 13:46:39" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>COMPILE.;4 77731
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
changes to%: (FNS BCOMPL BCOMPL.BODY)
(FILECREATED "24-Sep-2023 13:59:34" {WMEDLEY}<sources>COMPILE.;5 77344
previous date%: " 5-Jul-2021 09:31:55"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>COMPILE.;3)
:EDIT-BY rmk
:CHANGES-TO (VARS COMPILECOMS)
(FNS COMPSET)
:PREVIOUS-DATE " 5-Jul-2021 13:46:39" {WMEDLEY}<sources>COMPILE.;4)
(* ; "
@@ -22,7 +24,7 @@ with the terms of said license.
[(FNS BCOMPL BCOMPL.BODY PRINT-COMPILE-HEADER RESETOPENFILES BCOMPL1A BCOMPL2 BCOMPL3 BLOCK%:
BRECOMPILE BRECOMPILE1 BRECOMPILE2 BRECOMPILE3 BLOCKCOMPILE BLOCKCOMPILE1 COMPSET
COMPSETREAD COMPSETY COMPSETF RCOMP3 TCOMPL RECOMPILE RECOMP? COMPILE COMPILE1 COMPILE1A
SHOULD-BE-DWIMIFIED? COMPILE.FILECHECK COMPEM GETCFILE SPECVARS LOCALVARS GLOBALVARS)
SHOULD-BE-DWIMIFIED? COMPEM GETCFILE SPECVARS LOCALVARS GLOBALVARS)
(ADDVARS (NOLINKFNS HELP ERRORX ERRORSET EVALV FAULTEVAL INTERRUPT SEARCHPDL MAPDL BREAK1
EDITE EDITL)
(LINKFNS)
@@ -72,7 +74,7 @@ with the terms of said license.
(CL:PROCLAIM '(CL:SPECIAL COMPVARMACROHASH))
(CL:PROCLAIM '(GLOBAL SYSSPECVARS SYSLOCALVARS COMPILE.EXT NOTCOMPILEDFILES CLISPARRAY
FILERDTBL DWIMFLG DWIMWAIT LISPXHISTORY]
(COMS (* ; "COMPILEMODE")
(COMS (* ; "COMPILEMODE")
(PROP VARTYPE COMPILEMODELST)
(FNS COMPILEMODE))
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
@@ -1018,26 +1020,19 @@ with the terms of said license.
(RETURN (OR TEM BLKNAME])
(COMPSET
(LAMBDA (FILE FLG) (* bvm%: " 2-Aug-86 16:58")
(* If FILE is not NIL, COMPSET doesn't ask any questions but simply initializes
 the output FILE, LCFIL. If FLG is T (AND FILE IS NIL) COMPSET doesn't ask for
 an output FILE, but does set up LAPFLG, STRF, SVFLG, and LSTFIL.
 -
 -
 BCOMPL and BRECOMPILE both call COMPSET twice, once with FILE NIL and FLG T,
 and once with FILE set to their output FILE.
 -
 COMPILE calls COMPSET only once, with both arguments NIL.)
[LAMBDA (FILE FLG) (* ; "Edited 24-Sep-2023 13:59 by rmk")
(* bvm%: " 2-Aug-86 16:58")
(* ;; "If FILE is not NIL, COMPSET doesn't ask any questions but simply initializes the output FILE, LCFIL. If FLG is T (AND FILE IS NIL) COMPSET doesn't ask for an output FILE, but does set up LAPFLG, STRF, SVFLG, and LSTFIL. --- --- BCOMPL and BRECOMPILE both call COMPSET twice, once with FILE NIL and FLG T, and once with FILE set to their output FILE. --- COMPILE calls COMPSET only once, with both arguments NIL.")
(PROG (OLDO)
(COND
(FILE (GO NT)))
(SELECTQ (SETQ FILE (COMPSETREAD '"listing? " COMPSETKEYLST (OR FLG '(S T %
))))
(S (COND
[SELECTQ [SETQ FILE (COMPSETREAD '"listing? " COMPSETKEYLST (OR FLG '(S T %
]
(S [COND
(LAPFLG (PRIN1 '"file: " T)
(SETQ LSTFIL (COMPSETF (COMPSETREAD)))))
(SETQ LSTFIL (COMPSETF (COMPSETREAD]
(GO NOCHANGE))
((ST STF)
(SETQ LAPFLG NIL)
@@ -1055,34 +1050,33 @@ with the terms of said license.
(PRIN1 '"file: " T)
(SETQ FILE (COMPSETREAD)))
NIL)
(SETQ LSTFIL (COMPSETF FILE)))))
(COND
((SETQ STRF (COMPSETY (COMPSETREAD '"redefine? ")))
(SETQ SVFLG (COMPSETY (COMPSETREAD '"save exprs? ")))))
(SETQ LSTFIL (COMPSETF FILE]
[COND
([SETQ STRF (COMPSETY (COMPSETREAD '"redefine? "]
(SETQ SVFLG (COMPSETY (COMPSETREAD '"save exprs? "]
NOCHANGE
(COND
((AND LAPFLG (NEQ LSTFIL 'T)
(NOT (OPENP LSTFIL 'OUTPUT)))
(SETQ LSTFIL1 (SETQ LSTFIL (OPENFILE LSTFIL 'OUTPUT 'NEW NIL '((TYPE TEXT)))))
(* LSTFIL1 is set when the file is opened for this compilation.
 in this case it will be closed when the compilation is finished or aborttd.)
([AND LAPFLG (NEQ LSTFIL 'T)
(NOT (OPENP LSTFIL 'OUTPUT]
[SETQ LSTFIL1 (SETQ LSTFIL (OPENSTREAM LSTFIL 'OUTPUT 'NEW '((TYPE TEXT]
(* ;; "LSTFIL1 is set when the file is opened for this compilation. in this case it will be closed when the compilation is finished or aborttd.")
)
(T (SETQ LSTFIL1 NIL)))
(COND
((AND (NULL FLG)
([AND (NULL FLG)
(COMPSETY (COMPSETREAD '"output file? " NIL '(N %
))))
]
(PRIN1 '"file name: " T)
(SETQ FILE (COMPSETREAD)))
(T (SETQ FILE NIL)))
NT (COND
NT [COND
((AND (SETQ LCFIL (COMPSETF FILE))
(NEQ LCFIL T))
(SETQ LCFIL (OR (OPENP LCFIL 'OUTPUT)
(OPENSTREAM LCFIL 'OUTPUT 'NEW NIL '((TYPE BINARY)))))))
(RETURN 'DONE))))
(OPENSTREAM LCFIL 'OUTPUT 'NEW '((TYPE BINARY]
(RETURN 'DONE])
(COMPSETREAD
(LAMBDA (MESS KEYLST DEFAULT) (* wt%: "23-AUG-80 01:29")
@@ -1309,10 +1303,6 @@ with the terms of said license.
FINALLY (RETURN (EQ (CAR FORM)
'CLISP%:])
(COMPILE.FILECHECK
(LAMBDA (FILE) (* lmm "11-Jul-84 17:27")
(OPENFILE FILE 'INPUT)))
(COMPEM
(LAMBDA (X Y ERRORFLG FL) (* wt%: " 7-JUL-78 13:07")
@@ -1414,15 +1404,13 @@ with the terms of said license.
THEN (SETQ GLOBALVARS (UNION A GLOBALVARS])
)
(ADDTOVAR NOLINKFNS HELP ERRORX ERRORSET EVALV FAULTEVAL INTERRUPT SEARCHPDL MAPDL BREAK1 EDITE
EDITL)
(ADDTOVAR NOLINKFNS HELP ERRORX ERRORSET EVALV FAULTEVAL INTERRUPT SEARCHPDL MAPDL BREAK1 EDITE EDITL)
(ADDTOVAR LINKFNS )
(ADDTOVAR FREEVARS )
(ADDTOVAR SYSSPECVARS HELPCLOCK LISPXHIST RESETSTATE OLDVALUE UNDOSIDE0 SPECVARS LOCALVARS
GLOBALVARS)
(ADDTOVAR SYSSPECVARS HELPCLOCK LISPXHIST RESETSTATE OLDVALUE UNDOSIDE0 SPECVARS LOCALVARS GLOBALVARS)
(ADDTOVAR SYSLOCALVARS )
@@ -1455,16 +1443,16 @@ with the terms of said license.
(RPAQ? COMPSETLST '(ST F STF S Y N 1 2 NIL T))
(RPAQ? COMPSETKEYLST '((ST "ore and redefine " KEYLST ("" (F . "orget exprs")))
(S . "ame as last time")
(F . "ile only")
(T . "o terminal")
(1)
(2)
(Y . "es")
(N . "o")))
(S . "ame as last time")
(F . "ile only")
(T . "o terminal")
(1)
(2)
(Y . "es")
(N . "o")))
(RPAQ? COMPSETDEFAULTKEYLST '((Y . "es")
(N . "o")))
(N . "o")))
(RPAQ? BCOMPL.SCRATCH '{CORE}BCOMPL.SCRATCH)
@@ -1490,8 +1478,8 @@ with the terms of said license.
(DECLARE%: EVAL@COMPILE
(PUTPROPS DIGITCHARP MACRO [LAMBDA (CHAR)
(AND (IGEQ CHAR (CHARCODE 0))
(ILEQ CHAR (CHARCODE 9])
(AND (IGEQ CHAR (CHARCODE 0))
(ILEQ CHAR (CHARCODE 9])
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
@@ -1546,14 +1534,14 @@ with the terms of said license.
)
(PUTPROPS COMPILE COPYRIGHT ("Venue & Xerox Corporation" T 1984 1985 1986 1987 1988 1989 1990 2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (3770 74020 (BCOMPL 3780 . 5430) (BCOMPL.BODY 5432 . 12011) (PRINT-COMPILE-HEADER 12013
. 13076) (RESETOPENFILES 13078 . 13431) (BCOMPL1A 13433 . 19446) (BCOMPL2 19448 . 26263) (BCOMPL3
26265 . 27614) (BLOCK%: 27616 . 28248) (BRECOMPILE 28250 . 43239) (BRECOMPILE1 43241 . 49093) (
BRECOMPILE2 49095 . 49897) (BRECOMPILE3 49899 . 51275) (BLOCKCOMPILE 51277 . 53137) (BLOCKCOMPILE1
53139 . 58224) (COMPSET 58226 . 60989) (COMPSETREAD 60991 . 62302) (COMPSETY 62304 . 62428) (COMPSETF
62430 . 62596) (RCOMP3 62598 . 64305) (TCOMPL 64307 . 64606) (RECOMPILE 64608 . 64691) (RECOMP? 64693
. 65153) (COMPILE 65155 . 67144) (COMPILE1 67146 . 67734) (COMPILE1A 67736 . 69383) (
SHOULD-BE-DWIMIFIED? 69385 . 70074) (COMPILE.FILECHECK 70076 . 70222) (COMPEM 70224 . 70948) (GETCFILE
70950 . 72681) (SPECVARS 72683 . 73238) (LOCALVARS 73240 . 73814) (GLOBALVARS 73816 . 74018)) (76481
77430 (COMPILEMODE 76491 . 77428)))))
(FILEMAP (NIL (3708 73744 (BCOMPL 3718 . 5368) (BCOMPL.BODY 5370 . 11949) (PRINT-COMPILE-HEADER 11951
. 13014) (RESETOPENFILES 13016 . 13369) (BCOMPL1A 13371 . 19384) (BCOMPL2 19386 . 26201) (BCOMPL3
26203 . 27552) (BLOCK%: 27554 . 28186) (BRECOMPILE 28188 . 43177) (BRECOMPILE1 43179 . 49031) (
BRECOMPILE2 49033 . 49835) (BRECOMPILE3 49837 . 51213) (BLOCKCOMPILE 51215 . 53075) (BLOCKCOMPILE1
53077 . 58162) (COMPSET 58164 . 60861) (COMPSETREAD 60863 . 62174) (COMPSETY 62176 . 62300) (COMPSETF
62302 . 62468) (RCOMP3 62470 . 64177) (TCOMPL 64179 . 64478) (RECOMPILE 64480 . 64563) (RECOMP? 64565
. 65025) (COMPILE 65027 . 67016) (COMPILE1 67018 . 67606) (COMPILE1A 67608 . 69255) (
SHOULD-BE-DWIMIFIED? 69257 . 69946) (COMPEM 69948 . 70672) (GETCFILE 70674 . 72405) (SPECVARS 72407 .
72962) (LOCALVARS 72964 . 73538) (GLOBALVARS 73540 . 73742)) (76094 77043 (COMPILEMODE 76104 . 77041))
)))
STOP

BIN
sources/COMPILE.LCOM
View File

Binary file not shown.

144
sources/FONTPROFILE
View File

@@ -1,19 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "13-Apr-2023 08:40:30" {DSK}<home>larry>il>medley>sources>FONTPROFILE.;2 35652
(FILECREATED "23-Jul-2023 20:42:48" {WMEDLEY}<sources>FONTPROFILE.;4 34903
:EDIT-BY "lmm"
:EDIT-BY rmk
:CHANGES-TO (ALISTS (FONTDEFS HUGE)
(FONTDEFS BIG)
(FONTDEFS MEDIUM)
(FONTDEFS STANDARD)
(FONTDEFS BIGGER)
(FONTDEFS NS)
(FONTDEFS BIGGERNS))
(VARS FONTPROFILECOMS)
:CHANGES-TO (FNS FONTSET)
:PREVIOUS-DATE " 6-Sep-2021 19:11:32" {DSK}<home>larry>il>medley>sources>FONTPROFILE.;1)
:PREVIOUS-DATE "13-Apr-2023 08:40:30" {WMEDLEY}<sources>FONTPROFILE.;3)
(PRETTYCOMPRINT FONTPROFILECOMS)
@@ -459,7 +452,9 @@
(DEFINEQ
(FONTSET
[LAMBDA (NAME CHANGE-WINDOWS?) (* ; "Edited 23-Jun-88 10:46 by jds")
[LAMBDA (NAME CHANGE-WINDOWS?) (* ; "Edited 23-Jul-2023 20:42 by rmk")
(* ; "Edited 23-Jun-88 10:46 by jds")
(DECLARE (SPECVARS NAME))
(COND
[NAME
(LET
@@ -470,10 +465,10 @@
(* ;; "Looks up NAME on FONTSLST and sets apropriate parameters. entries are added to fontslst by FONTNAME.")
(for X in FONTVARS when (AND (CL:SYMBOLP (CAR X))
(NEQ (CAR X)
'*)
(NEQ (CAR X)
(CADR X))) do (SETTOPVAL (CAR X)))
(NEQ (CAR X)
'*)
(NEQ (CAR X)
(CADR X))) do (SETTOPVAL (CAR X)))
[MAPC (CDR TEM)
(FUNCTION (LAMBDA (X)
(/SETTOPVAL (CAR X)
@@ -481,60 +476,57 @@
[PROG (BASICCLASSES)
(for X in FONTPROFILE
do (PROG (SEEN (NAME (CAR X))
(FONTS X))
LP [COND
((MEMB (CAR FONTS)
SEEN)
(ERROR "Circular font profile specification" X))
(T (push SEEN (CAR FONTS]
[SETQ FONTS (CDR (COND
((OR (NULL (CADR FONTS))
(LISTP (CADR FONTS)))
(FONTS X))
LP [COND
((MEMB (CAR FONTS)
SEEN)
(ERROR "Circular font profile specification" X))
(T (push SEEN (CAR FONTS]
[SETQ FONTS (CDR (COND
((OR (NULL (CADR FONTS))
(LISTP (CADR FONTS)))
(*)
(* ;
 "This skips over the now-defunct NIL or list-of-escape sequence")
(CDR FONTS))
(T FONTS]
(COND
((OR (NLISTP FONTS)
(LITATOM (CAR FONTS)))(* ;
 "Indirect thru another's font spec")
(AND (SETQ FONTS (ASSOC (SELECTQ (CAR (LISTP FONTS))
((NIL DEFAULTFONT)
 "This skips over the now-defunct NIL or list-of-escape sequence")
(CDR FONTS))
(T FONTS]
(COND
((OR (NLISTP FONTS)
(LITATOM (CAR FONTS))) (* ; "Indirect thru another's font spec")
(AND (SETQ FONTS (ASSOC (SELECTQ (CAR (LISTP FONTS))
((NIL DEFAULTFONT)
(* ;
 "Don't let DEFAULTFONT loop thru itself")
(AND (NOT (MEMB 'DEFAULTFONT SEEN
))
'DEFAULTFONT))
(CAR FONTS))
FONTPROFILE))
(GO LP)))
(T [push BASICCLASSES (SETQ FONTS (FONTCLASS NAME FONTS
'DISPLAY]
 "Don't let DEFAULTFONT loop thru itself")
(AND (NOT (MEMB 'DEFAULTFONT SEEN))
'DEFAULTFONT))
(CAR FONTS))
FONTPROFILE))
(GO LP)))
(T [push BASICCLASSES (SETQ FONTS (FONTCLASS NAME FONTS 'DISPLAY]
(* ;
 "Now we have a font class datastructure")
))
(AND NAME (/SETTOPVAL NAME FONTS))
 "Now we have a font class datastructure")
))
(AND NAME (/SETTOPVAL NAME FONTS))
(* ;; "NIL for the class-name means just establish the font-correspondences but don't connect them up with a pretty class name.")
(* ;; "NIL for the class-name means just establish the font-correspondences but don't connect them up with a pretty class name.")
))
))
(AND BASICCLASSES (FONTMAPARRAY BASICCLASSES 'DISPLAY]
[for X in FONTVARS when (NEQ (CAR X)
'*)
'*)
do (COND
((LISTP (CAR X))
(EVAL (CAR X)))
[(CADDR X)
(SET (CAR X)
(FONTCREATE (OR (GETTOPVAL (CAR X))
(EVAL (CADR X))
DEFAULTFONT)
NIL NIL NIL 'DISPLAY]
(T (OR (GETTOPVAL (CAR X))
(AND (CADR X)
(SET (CAR X)
(EVAL (CADR X]
((LISTP (CAR X))
(EVAL (CAR X)))
[(CADDR X)
(SET (CAR X)
(FONTCREATE (OR (GETTOPVAL (CAR X))
(EVAL (CADR X))
DEFAULTFONT)
NIL NIL NIL 'DISPLAY]
(T (OR (GETTOPVAL (CAR X))
(AND (CADR X)
(SET (CAR X)
(EVAL (CADR X]
(CL:WHEN CHANGE-WINDOWS?
(CL:WHEN (NEQ OLDDEFAULT (FONTCREATE DEFAULTFONT NIL NIL NIL 'DISPLAY))
(for X in (OPENWINDOWS) when (EQ OLDDEFAULT (DSPFONT NIL X))
@@ -543,25 +535,25 @@
(SETQ MaxValueLeftMargin (ITIMES 35 (STRINGWIDTH 'A DEFAULTFONT)))
(MAPC CACHEDMENUS 'SET)
[for W in (OPENWINDOWS) do [COND
[(OR (EQ (WINDOWPROP W 'RESHAPEFN)
'DONT)
(WINDOWPROP W 'MAINWINDOW]
(T
(* ;;
 "don't reshape if can't or if this window is attached to another.")
[(OR (EQ (WINDOWPROP W 'RESHAPEFN)
'DONT)
(WINDOWPROP W 'MAINWINDOW]
(T
(* ;;
 "don't reshape if can't or if this window is attached to another.")
(SHAPEW W (WINDOWREGION W]
(COND
((AND (NEQ (WINDOWPROP W 'WINDOWENTRYFN)
(FUNCTION \TEDIT.PROCIDLEFN))
(WINDOWPROP W 'REPAINTFN))
(REDISPLAYW W])
(SHAPEW W (WINDOWREGION W]
(COND
((AND (NEQ (WINDOWPROP W 'WINDOWENTRYFN)
(FUNCTION \TEDIT.PROCIDLEFN))
(WINDOWPROP W 'REPAINTFN))
(REDISPLAYW W])
(* ;; "Set the new font profile name, and return the old one, so he can restore later.")
(PROG1 FONTNAME (SETQ FONTNAME NAME]
(T (* ;
 "He passed in NIL, so return font profile name in effect.")
 "He passed in NIL, so return font profile name in effect.")
FONTNAME])
(FONTPROFILE
@@ -700,6 +692,6 @@
(SETSEPR '(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26)
1 FILERDTBL)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (21780 33364 (FONTSET 21790 . 28131) (FONTPROFILE 28133 . 30482) (FONTPROFILE.ADDDEVICE
30484 . 33362)) (33600 35499 (FONTMAPARRAY 33610 . 35497)))))
(FILEMAP (NIL (21437 32615 (FONTSET 21447 . 27382) (FONTPROFILE 27384 . 29733) (FONTPROFILE.ADDDEVICE
29735 . 32613)) (32851 34750 (FONTMAPARRAY 32861 . 34748)))))
STOP

BIN
sources/FONTPROFILE.LCOM
View File

Binary file not shown.

168
sources/HARDCOPY
View File

@@ -1,10 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "18-Oct-2022 18:47:42" {DSK}<home>larry>ilisp>medley>sources>HARDCOPY.;2 103854
(FILECREATED "24-Sep-2023 15:25:20" {WMEDLEY}<sources>HARDCOPY.;13 105614
:CHANGES-TO (FNS HARDCOPYIMAGEW.TOPRINTER)
:EDIT-BY rmk
:PREVIOUS-DATE "20-Jul-2022 17:14:14" {DSK}<home>larry>ilisp>medley>sources>HARDCOPY.;1)
:CHANGES-TO (FNS CONVERT.FILE.TO.TYPE.FOR.PRINTER)
:PREVIOUS-DATE "14-Sep-2023 22:58:42" {WMEDLEY}<sources>HARDCOPY.;12)
(* ; "
@@ -46,7 +48,7 @@ Copyright (c) 1984-1993, 1999, 2018, 2021-2022 by Venue & Xerox Corporation.
(INITVARS (TEXTDEFAULTTABS (LIST 20320))
(TEXTDEFAULTPAGEREGION (CREATEREGION 2794 1905 18415 24765)))
(* ;
 "TEXTDEFAULTTABS Hack, mica equivalent of 8 inches")
 "TEXTDEFAULTTABS Hack, mica equivalent of 8 inches. NOT USED ANYWHERE")
(GLOBALVARS TEXTDEFAULTTABS TEXTDEFAULTPAGEREGION)
(FNS TEXTTOIMAGEFILE COPY.TEXT.TO.IMAGE))
(COMS (FNS \BLTSHADE.GENERICPRINTER)
@@ -62,7 +64,9 @@ Copyright (c) 1984-1993, 1999, 2018, 2021-2022 by Venue & Xerox Corporation.
\HDCPYDSPPRINTCHAR \SLOWHDCPYBLTCHAR \CHANGECHARSET.HDCPYDISPLAY)
[DECLARE%: DONTCOPY DOEVAL@COMPILE (EXPORT (CONSTANTS (MICASPERPT (FQUOTIENT 2540 72))
(IHALFMICASPERPT 17)
(IMICASPERPT 35]
(IMICASPERPT 35)
(DEFAULTTAB 36]
(* ; "screen-points: 1/2 inch")
(DECLARE%: DONTCOPY DOEVAL@COMPILE (EXPORT (FUNCTIONS \MICASTOPTS)))
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (\HDCPYDISPLAYINIT]
[COMS (* ;
@@ -168,20 +172,24 @@ Copyright (c) 1984-1993, 1999, 2018, 2021-2022 by Venue & Xerox Corporation.
(DEFINEQ
(MakeMenuOfPrinters
[LAMBDA (MENUTITLE) (* ; "Edited 29-May-93 14:18 by rmk:")
(* ; "Edited 11-Jul-90 13:35 by jds")
[LAMBDA (MENUTITLE) (* ; "Edited 22-Jun-2023 17:30 by rmk")
(* ; "Edited 29-May-93 14:18 by rmk:")
(* ; "Edited 11-Jul-90 13:35 by jds")
(DECLARE (GLOBALVARS DEFAULTPRINTINGHOST))
(CREATE MENU
ITEMS _ (APPEND (FOR P INSIDE DEFAULTPRINTINGHOST
COLLECT (LIST (COND
((LISTP P)
(IF (CADDR P)
THEN (CONCAT (CADR P)
" "
(CADDR P))
ELSE (CADR P)))
(T P))
(KWOTE P)))
((LISTP P)
(IF (CADDR P)
THEN (CONCAT (CADR P)
" "
(CADDR P))
ELSE (CADR P)))
(T (CL:IF (OR (NULL P)
(ZEROP (NCHARS P)))
"(Default printer)"
P)))
(KWOTE P)))
(LIST (LIST "Other..." (KWOTE 'OTHER)
"You will be prompted for a printer")))
TITLE _ MENUTITLE
@@ -357,8 +365,31 @@ Copyright (c) 1984-1993, 1999, 2018, 2021-2022 by Venue & Xerox Corporation.
)
(CONVERT.FILE.TO.TYPE.FOR.PRINTER
(LAMBDA (FILE FILETYPE PRINTERTYPE HEADING PRINTOPTIONS) (* ; "Edited 29-Dec-88 15:39 by jds") (* ;; "Convert FILE to the kind of hardcopy file (Interpress, Press, 4045HQ, etc) appropriate to PRINTERTYPE.") (SETQ FILETYPE (OR FILETYPE (QUOTE TEXT))) (PROG ((SCRATCH (CLOSEF (OPENFILE (PRINTER.SCRATCH.FILE FILE PRINTERTYPE) (QUOTE OUTPUT) (QUOTE NEW))))) (* ; "Doing the open & close gets us a guaranteed version number, so that all files are truly unique.") (APPLY* (OR (LISTGET (PRINTERPROP PRINTERTYPE (QUOTE CONVERSION)) FILETYPE) (for CANPRINT in (PRINTERPROP PRINTERTYPE (QUOTE CANPRINT)) bind CONVERTER when (SETQ CONVERTER (LISTGET (PRINTFILEPROP CANPRINT (QUOTE CONVERSION)) FILETYPE)) do (RETURN CONVERTER)) (ERROR (CONCAT "Can't convert a " FILETYPE " for a " PRINTERTYPE " printer") (FULLNAME FILE))) FILE SCRATCH (LISTGET PRINTOPTIONS (QUOTE FONTS)) HEADING NIL PRINTOPTIONS) (RESETSAVE NIL (LIST (FUNCTION (LAMBDA (SCRATCH) (CLOSEF? SCRATCH) (DELFILE SCRATCH))) SCRATCH)) (RETURN SCRATCH)))
)
[LAMBDA (FILE FILETYPE PRINTERTYPE HEADING PRINTOPTIONS) (* ; "Edited 24-Sep-2023 15:25 by rmk")
(* ; "Edited 14-Sep-2023 22:58 by rmk")
(* ; "Edited 29-Dec-88 15:39 by jds")
(* ;; "Convert FILE to the kind of hardcopy file (Interpress, Press, 4045HQ, etc) appropriate to PRINTERTYPE.")
(SETQ FILETYPE (OR FILETYPE 'TEXT))
(PROG [(SCRATCH (CLOSEF (OPENSTREAM (PRINTER.SCRATCH.FILE FILE PRINTERTYPE)
'OUTPUT
'NEW] (* ;
 "Doing the open & close gets us a guaranteed version number, so that all files are truly unique.")
(APPLY* (OR (LISTGET (PRINTERPROP PRINTERTYPE 'CONVERSION)
FILETYPE)
(for CANPRINT in (PRINTERPROP PRINTERTYPE 'CANPRINT) bind CONVERTER
when (SETQ CONVERTER (LISTGET (PRINTFILEPROP CANPRINT 'CONVERSION)
FILETYPE)) do (RETURN CONVERTER))
(ERROR (CONCAT "Can't convert a " FILETYPE " for a " PRINTERTYPE " printer")
(FULLNAME FILE)))
FILE SCRATCH (LISTGET PRINTOPTIONS 'FONTS)
HEADING NIL PRINTOPTIONS)
(RESETSAVE NIL (LIST [FUNCTION (LAMBDA (SCRATCH)
(CLOSEF? SCRATCH)
(DELFILE SCRATCH]
SCRATCH))
(RETURN SCRATCH])
(EMPRESS
(LAMBDA (FILE %#COPIES HOST HEADING %#SIDES PRINTOPTIONS) (* ; "Edited 26-Aug-87 14:17 by Snow") (SEND.FILE.TO.PRINTER FILE HOST (NCONC (COND (HEADING (LIST (QUOTE HEADING) HEADING))) (COND (%#COPIES (LIST (QUOTE %#COPIES) %#COPIES))) (COND (%#SIDES (LIST (QUOTE %#SIDES) %#SIDES))) PRINTOPTIONS)))
@@ -686,7 +717,7 @@ Copyright (c) 1984-1993, 1999, 2018, 2021-2022 by Venue & Xerox Corporation.
(* ; "TEXTDEFAULTTABS Hack, mica equivalent of 8 inches")
(* ; "TEXTDEFAULTTABS Hack, mica equivalent of 8 inches. NOT USED ANYWHERE")
(DECLARE%: DOEVAL@COMPILE DONTCOPY
@@ -729,7 +760,8 @@ Copyright (c) 1984-1993, 1999, 2018, 2021-2022 by Venue & Xerox Corporation.
(CLOSEF IMAGESTREAM])])
(COPY.TEXT.TO.IMAGE
[LAMBDA (INFILE IMAGESTREAM FONTS TABS) (* ; "Edited 20-Jul-2022 17:14 by rmk")
[LAMBDA (INFILE IMAGESTREAM FONTS TABS) (* ; "Edited 3-Mar-2023 23:46 by rmk")
(* ; "Edited 20-Jul-2022 17:14 by rmk")
(* ; "Edited 8-Oct-2021 22:23 by rmk:")
(* ; "Edited 10-Apr-95 21:23 by rmk:")
@@ -741,7 +773,7 @@ Copyright (c) 1984-1993, 1999, 2018, 2021-2022 by Venue & Xerox Corporation.
(FONTARRAY (FONTMAPARRAY FONTS))
(MAXFONT (ARRAYSIZE FONTARRAY))
(INSTRM (GETSTREAM INFILE 'INPUT))
DEFAULTTAB C FC (EOSP (GETFILEINFO INSTRM 'ENDOFSTREAMOP]
DEFTAB C FC (EOSP (GETFILEINFO INSTRM 'ENDOFSTREAMOP]
(* ;;
 "RMK: EOS function changed to NILL from ZERO. 0 in low-order bits is OK in UNICODE, when we switch")
@@ -775,17 +807,19 @@ Copyright (c) 1984-1993, 1999, 2018, 2021-2022 by Venue & Xerox Corporation.
(\OUTCHAR IMAGESTREAM (CHARCODE ^T))
(RETURN))
(* ;; "TEXTDEFAULTTABS is a hack, since it depends on the units of the stream. Should really be a property of the stream or imagetype, or defined in terms of standard scale")
(* ;; "DEFAULTTAB is now a constant defined here as 36 = 1/2 inch. Maybe that should be scaled by the stream's scale factor vis a vis points, not related to the current font. If you are tabbing for alignment, you wouldn't want it to be ragged based on what font one line is in compare to another. TEXTDEFAULTTAB is a hack that should be removed.")
[SETQ FC
(IF TABS
THEN (OR (CAR (NTH TABS FC))
(ERROR "Undefined absolute tab number" FC))
ELSE (TIMES FC (OR DEFAULTTAB
(SETQ DEFAULTTAB
(TIMES 8 (CHARWIDTH (CHARCODE SPACE)
(FONTCREATE (ELT FONTARRAY 1)
NIL NIL NIL IMAGESTREAM]
ELSE (TIMES FC (OR DEFTAB (SETQ DEFTAB
(TIMES 8
(CHARWIDTH (CHARCODE SPACE)
(FONTCREATE (ELT FONTARRAY
1)
NIL NIL NIL
IMAGESTREAM]
(DSPXPOSITION FC IMAGESTREAM))
(NIL (\OUTCHAR IMAGESTREAM (CHARCODE ^F))
(* ; "EOS after ^F")
@@ -912,15 +946,23 @@ Copyright (c) 1984-1993, 1999, 2018, 2021-2022 by Venue & Xerox Corporation.
(RPAQQ IMICASPERPT 35)
(RPAQQ DEFAULTTAB 36)
(CONSTANTS (MICASPERPT (FQUOTIENT 2540 72))
(IHALFMICASPERPT 17)
(IMICASPERPT 35))
(IMICASPERPT 35)
(DEFAULTTAB 36))
)
(* "END EXPORTED DEFINITIONS")
)
(* ; "screen-points: 1/2 inch")
(DECLARE%: DONTCOPY DOEVAL@COMPILE
(* "FOLLOWING DEFINITIONS EXPORTED")
(DEFMACRO \MICASTOPTS (MICAS)
@@ -1083,40 +1125,40 @@ Copyright (c) 1984-1993, 1999, 2018, 2021-2022 by Venue & Xerox Corporation.
(PUTPROPS HARDCOPY COPYRIGHT ("Venue & Xerox Corporation" 1984 1985 1986 1987 1988 1989 1990 1991 1992
1993 1999 2018 2021 2022))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (6168 10934 (HARDCOPY.SOMEHOW 6178 . 7536) (HARDCOPYIMAGEW 7538 . 7690) (
HARDCOPYIMAGEW.TOFILE 7692 . 8000) (HARDCOPYIMAGEW.TOPRINTER 8002 . 9249) (HARDCOPYREGION.TOFILE 9251
. 9549) (HARDCOPYREGION.TOPRINTER 9551 . 10173) (COPY.WINDOW.TO.BITMAP 10175 . 10932)) (11006 21556 (
MakeMenuOfPrinters 11016 . 12241) (PRINTERS.WHENSELECTEDFN 12243 . 13985) (MakeMenuOfImageTypes 13987
. 14505) (GetNewPrinterFromUser 14507 . 14935) (PopUpWindowAndGetAtom 14937 . 16322) (
PopUpWindowAndGetList 16324 . 17890) (NewPrinter 17892 . 18840) (GetPrinterName 18842 . 19122) (
GetImageFile 19124 . 21411) (FetchDefaultPrinter 21413 . 21554)) (21591 22129 (
ExtensionForPrintFileType 21601 . 21794) (PRINTFILETYPE.FROM.EXTENSION 21796 . 22127)) (22184 38568 (
DEFAULTPRINTER 22194 . 22354) (CAN.PRINT.DIRECTLY 22356 . 22512) (CONVERT.FILE.TO.TYPE.FOR.PRINTER
22514 . 23558) (EMPRESS 23560 . 23873) (HARDCOPYW 23875 . 26835) (LISTFILES1 26837 . 27010) (
PRINTER.BITMAPFILE 27012 . 27259) (PRINTER.BITMAPSCALE 27261 . 27526) (PRINTER.SCRATCH.FILE 27528 .
27651) (PRINTERPROP 27653 . 27836) (PRINTERSTATUS 27838 . 28027) (PRINTERTYPE 28029 . 30338) (
PRINTERNAME 30340 . 30642) (PRINTFILEPROP 30644 . 30835) (PRINTFILETYPE 30837 . 32781) (
\EXPECTED.FILE.TYPE 32783 . 33565) (SEND.FILE.TO.PRINTER 33567 . 38566)) (38569 43551 (PRINTERDEVICE
38579 . 43549)) (44366 52124 (TEXTTOIMAGEFILE 44376 . 46566) (COPY.TEXT.TO.IMAGE 46568 . 52122)) (
52125 53260 (\BLTSHADE.GENERICPRINTER 52135 . 53258)) (53388 72140 (MAKEHARDCOPYSTREAM 53398 . 54402)
(UNMAKEHARDCOPYSTREAM 54404 . 55088) (HARDCOPYSTREAMTYPE 55090 . 55369) (\CHARWIDTH.HDCPYDISPLAY 55371
. 55802) (\DSPFONT.HDCPYDISPLAY 55804 . 57209) (\DSPRIGHTMARGIN.HDCPYDISPLAY 57211 . 57788) (
\DSPXPOSITION.HDCPYDISPLAY 57790 . 58051) (\DSPYPOSITION.HDCPYDISPLAY 58053 . 58314) (
\STRINGWIDTH.HDCPYDISPLAY 58316 . 58823) (\STRINGWIDTH.HCPYDISPLAYAUX 58825 . 61157) (\HDCPYBLTCHAR
61159 . 63694) (\HDCPYDISPLAY.FIX.XPOS 63696 . 64116) (\HDCPYDISPLAY.FIX.YPOS 64118 . 64538) (
\HDCPYDISPLAYINIT 64540 . 65317) (\HDCPYDSPPRINTCHAR 65319 . 67479) (\SLOWHDCPYBLTCHAR 67481 . 70984)
(\CHANGECHARSET.HDCPYDISPLAY 70986 . 72138)) (72550 72691 (\MICASTOPTS 72550 . 72691)) (72862 103159 (
MAKEHARDCOPYMODESTREAM 72872 . 74781) (UNMAKEHARDCOPYMODESTREAM 74783 . 75861) (\BLTSHADE.HCPYMODE
75863 . 76310) (\BITBLT.HCPYMODE 76312 . 76934) (\BRUSHCONVERT.HCPYMODE 76936 . 77173) (
\CHANGECHARSET.HCPYMODE 77175 . 78942) (\DASHINGCONVERT.HCPYMODE 78944 . 79207) (\CHARWIDTH.HCPYMODE
79209 . 79496) (\DRAWLINE.HCPYMODE 79498 . 79810) (\DRAWCURVE.HCPYMODE 79812 . 80241) (
\DRAWCIRCLE.HCPYMODE 80243 . 80638) (\DRAWELLIPSE.HCPYMODE 80640 . 81152) (\DSPFONT.HCPYMODE 81154 .
82310) (\DSPLEFTMARGIN.HCPYMODE 82312 . 82896) (\DSPLINEFEED.HCPYMODE 82898 . 83308) (
\DSPRIGHTMARGIN.HCPYMODE 83310 . 83939) (\DSPSPACEFACTOR.HCPYMODE 83941 . 84462) (
\DSPXPOSITION.HCPYMODE 84464 . 85045) (\DSPYPOSITION.HCPYMODE 85047 . 85452) (\MOVETO.HCPYMODE 85454
. 85606) (\FONTCREATE.HCPYMODE.PRESS 85608 . 86620) (\CREATECHARSET.HCPYMODE.PRESS 86622 . 87593) (
\FONTCREATE.HCPYMODE.INTERPRESS 87595 . 88629) (\CREATECHARSET.HCPYMODE.INTERPRESS 88631 . 89619) (
\STRINGWIDTH.HCPYMODE 89621 . 90055) (\HCPYMODEBLTCHAR 90057 . 93026) (\HCPYMODEDISPLAYINIT 93028 .
95959) (\HCPYMODEDSPPRINTCHAR 95961 . 98142) (\SLOWHCPYMODEBLTCHAR 98144 . 101658) (\SFFixY.HCPYMODE
101660 . 103157)))))
(FILEMAP (NIL (6336 11102 (HARDCOPY.SOMEHOW 6346 . 7704) (HARDCOPYIMAGEW 7706 . 7858) (
HARDCOPYIMAGEW.TOFILE 7860 . 8168) (HARDCOPYIMAGEW.TOPRINTER 8170 . 9417) (HARDCOPYREGION.TOFILE 9419
. 9717) (HARDCOPYREGION.TOPRINTER 9719 . 10341) (COPY.WINDOW.TO.BITMAP 10343 . 11100)) (11174 22031 (
MakeMenuOfPrinters 11184 . 12716) (PRINTERS.WHENSELECTEDFN 12718 . 14460) (MakeMenuOfImageTypes 14462
. 14980) (GetNewPrinterFromUser 14982 . 15410) (PopUpWindowAndGetAtom 15412 . 16797) (
PopUpWindowAndGetList 16799 . 18365) (NewPrinter 18367 . 19315) (GetPrinterName 19317 . 19597) (
GetImageFile 19599 . 21886) (FetchDefaultPrinter 21888 . 22029)) (22066 22604 (
ExtensionForPrintFileType 22076 . 22269) (PRINTFILETYPE.FROM.EXTENSION 22271 . 22602)) (22659 39736 (
DEFAULTPRINTER 22669 . 22829) (CAN.PRINT.DIRECTLY 22831 . 22987) (CONVERT.FILE.TO.TYPE.FOR.PRINTER
22989 . 24726) (EMPRESS 24728 . 25041) (HARDCOPYW 25043 . 28003) (LISTFILES1 28005 . 28178) (
PRINTER.BITMAPFILE 28180 . 28427) (PRINTER.BITMAPSCALE 28429 . 28694) (PRINTER.SCRATCH.FILE 28696 .
28819) (PRINTERPROP 28821 . 29004) (PRINTERSTATUS 29006 . 29195) (PRINTERTYPE 29197 . 31506) (
PRINTERNAME 31508 . 31810) (PRINTFILEPROP 31812 . 32003) (PRINTFILETYPE 32005 . 33949) (
\EXPECTED.FILE.TYPE 33951 . 34733) (SEND.FILE.TO.PRINTER 34735 . 39734)) (39737 44719 (PRINTERDEVICE
39747 . 44717)) (45554 53793 (TEXTTOIMAGEFILE 45564 . 47754) (COPY.TEXT.TO.IMAGE 47756 . 53791)) (
53794 54929 (\BLTSHADE.GENERICPRINTER 53804 . 54927)) (55057 73809 (MAKEHARDCOPYSTREAM 55067 . 56071)
(UNMAKEHARDCOPYSTREAM 56073 . 56757) (HARDCOPYSTREAMTYPE 56759 . 57038) (\CHARWIDTH.HDCPYDISPLAY 57040
. 57471) (\DSPFONT.HDCPYDISPLAY 57473 . 58878) (\DSPRIGHTMARGIN.HDCPYDISPLAY 58880 . 59457) (
\DSPXPOSITION.HDCPYDISPLAY 59459 . 59720) (\DSPYPOSITION.HDCPYDISPLAY 59722 . 59983) (
\STRINGWIDTH.HDCPYDISPLAY 59985 . 60492) (\STRINGWIDTH.HCPYDISPLAYAUX 60494 . 62826) (\HDCPYBLTCHAR
62828 . 65363) (\HDCPYDISPLAY.FIX.XPOS 65365 . 65785) (\HDCPYDISPLAY.FIX.YPOS 65787 . 66207) (
\HDCPYDISPLAYINIT 66209 . 66986) (\HDCPYDSPPRINTCHAR 66988 . 69148) (\SLOWHDCPYBLTCHAR 69150 . 72653)
(\CHANGECHARSET.HDCPYDISPLAY 72655 . 73807)) (74310 74451 (\MICASTOPTS 74310 . 74451)) (74622 104919 (
MAKEHARDCOPYMODESTREAM 74632 . 76541) (UNMAKEHARDCOPYMODESTREAM 76543 . 77621) (\BLTSHADE.HCPYMODE
77623 . 78070) (\BITBLT.HCPYMODE 78072 . 78694) (\BRUSHCONVERT.HCPYMODE 78696 . 78933) (
\CHANGECHARSET.HCPYMODE 78935 . 80702) (\DASHINGCONVERT.HCPYMODE 80704 . 80967) (\CHARWIDTH.HCPYMODE
80969 . 81256) (\DRAWLINE.HCPYMODE 81258 . 81570) (\DRAWCURVE.HCPYMODE 81572 . 82001) (
\DRAWCIRCLE.HCPYMODE 82003 . 82398) (\DRAWELLIPSE.HCPYMODE 82400 . 82912) (\DSPFONT.HCPYMODE 82914 .
84070) (\DSPLEFTMARGIN.HCPYMODE 84072 . 84656) (\DSPLINEFEED.HCPYMODE 84658 . 85068) (
\DSPRIGHTMARGIN.HCPYMODE 85070 . 85699) (\DSPSPACEFACTOR.HCPYMODE 85701 . 86222) (
\DSPXPOSITION.HCPYMODE 86224 . 86805) (\DSPYPOSITION.HCPYMODE 86807 . 87212) (\MOVETO.HCPYMODE 87214
. 87366) (\FONTCREATE.HCPYMODE.PRESS 87368 . 88380) (\CREATECHARSET.HCPYMODE.PRESS 88382 . 89353) (
\FONTCREATE.HCPYMODE.INTERPRESS 89355 . 90389) (\CREATECHARSET.HCPYMODE.INTERPRESS 90391 . 91379) (
\STRINGWIDTH.HCPYMODE 91381 . 91815) (\HCPYMODEBLTCHAR 91817 . 94786) (\HCPYMODEDISPLAYINIT 94788 .
97719) (\HCPYMODEDSPPRINTCHAR 97721 . 99902) (\SLOWHCPYMODEBLTCHAR 99904 . 103418) (\SFFixY.HCPYMODE
103420 . 104917)))))
STOP

BIN
sources/HARDCOPY.LCOM
View File

Binary file not shown.

54
sources/HPRINT
View File

@@ -1,11 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 3-Aug-2022 21:31:57" {DSK}<home>larry>medley>sources>HPRINT.;3 58021
(FILECREATED "31-Jul-2023 13:33:10" {WMEDLEY}<sources>HPRINT.;5 57926
:CHANGES-TO (VARS HPRINTCOMS)
(FNS HPRINT)
:EDIT-BY rmk
:PREVIOUS-DATE "17-Oct-2021 13:54:11" {DSK}<home>larry>medley>sources>HPRINT.;1)
:CHANGES-TO (FNS EQUALALL)
:PREVIOUS-DATE " 3-Aug-2022 21:31:57" {WMEDLEY}<sources>HPRINT.;2)
(* ; "
@@ -901,8 +902,8 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2022 by Venue & Xerox Corporation
(DEFINEQ
(EQUALALL
[LAMBDA (X Y) (* ;
 "Edited 26-Apr-2021 14:34 by rmk:")
[LAMBDA (X Y) (* ; "Edited 31-Jul-2023 13:31 by rmk")
(* ; "Edited 26-Apr-2021 14:34 by rmk:")
(OR (EQ X Y)
(PROG ((TY (TYPENAME Y))
TEM)
@@ -925,7 +926,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2022 by Venue & Xerox Corporation
(ARRAYSIZE Y))
(for I from (ARRAYORIG X) as J to TEM
always (EQUALALL (ELT X I)
(ELT Y I])
(ELT Y I])
((ONED-ARRAY TWOD-ARRAY GENERAL-ARRAY)
(* ; "RMK: Added CL arrays")
[AND (EQUAL (CL:ARRAY-DIMENSIONS X)
@@ -939,14 +940,12 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2022 by Venue & Xerox Corporation
(EQP (CL:FILL-POINTER X)
(CL:FILL-POINTER Y)))
(NOT (CL:ARRAY-HAS-FILL-POINTER-P Y)))
(FOR I FROM 0 TO (SUB1 (CL:ARRAY-TOTAL-SIZE
X))
(FOR I FROM 0 TO (SUB1 (CL:ARRAY-TOTAL-SIZE X))
ALWAYS (EQUALALL (XCL:ROW-MAJOR-AREF X I)
(XCL:ROW-MAJOR-AREF Y I])
(XCL:ROW-MAJOR-AREF Y I])
(HARRAYP (EQUALHASH X Y))
(READTABLEP (for I from 0 to 127
always (EQUALALL (GETSYNTAX I X)
(GETSYNTAX I Y))))
(READTABLEP (for I from 0 to 127 always (EQUALALL (GETSYNTAX I X)
(GETSYNTAX I Y))))
(TERMTABLEP [AND (EQ (GETCONTROL X)
(GETCONTROL Y))
(EQ (GETRAISE X)
@@ -965,18 +964,19 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2022 by Venue & Xerox Corporation
Y]
(for I from 0 to 31
always (EQ (ECHOCONTROL I NIL X)
(ECHOCONTROL I NIL Y)))
(ECHOCONTROL I NIL Y)))
(EVERY ORIGDELETECONTROL
(FUNCTION (LAMBDA (Z)
(EQUAL (DELETECONTROL (CAR Z)
NIL X)
(DELETECONTROL (CAR Z)
NIL Y])
((BITMAP BIGBM)
(BITMAPEQUAL X Y))
(OR (EQP X Y)
(AND (SETQ TY (GETDESCRIPTORS TY))
(for FIELD in TY always (EQUALALL
(FETCHFIELD FIELD X)
(FETCHFIELD FIELD Y])
(for FIELD in TY always (EQUALALL (FETCHFIELD FIELD X)
(FETCHFIELD FIELD Y])
(EQUALHASH
[LAMBDA (AR1 AR2)
@@ -1118,14 +1118,14 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2022 by Venue & Xerox Corporation
(PUTPROPS HPRINT COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1988 1990 1991
1993 1994 2022))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (3694 6232 (MAKEHVPRETTYCOMS 3704 . 4991) (READVARS 4993 . 5559) (HPRINT0 5561 . 6230))
(6234 6567 (READVARS-FROM-STRINGS 6234 . 6567)) (6569 6956 (READVARS-FROM-STREAM 6569 . 6956)) (6957
8885 (READVAR-FROM-STRING 6967 . 7373) (READVARS-FROM-STRING 7375 . 7611) (HPRINT-TO-STRING 7613 .
7819) (HPRINT-TO-STRINGS 7821 . 8883)) (9696 38289 (HPRINT 9706 . 11697) (HPRINT1 11699 . 23201) (
HPRINTEND 23203 . 24239) (RPTPRINT 24241 . 24479) (RPTEND 24481 . 24640) (RPTPUT 24642 . 25140) (
HPRINTSP 25142 . 25206) (HPERR 25208 . 25305) (HVFWDCDREAD 25307 . 25686) (HVBAKREAD 25688 . 33733) (
HVREADCHECKGETFN 33735 . 35134) (HVREADEND 35136 . 35488) (HVRPTREAD 35490 . 36016) (HVFWDREAD 36018
. 36872) (HREAD 36874 . 37196) (HPINITRDTBL 37198 . 38032) (HVREADERR 38034 . 38147) (HPRINSP 38149
. 38287)) (38290 47172 (COPYALL 38300 . 42203) (\COPYDATATYPE 42205 . 42894) (HCOPYALL 42896 . 43206)
(HCOPYALL1 43208 . 47170)) (47173 54520 (EQUALALL 47183 . 52841) (EQUALHASH 52843 . 54518)))))
(FILEMAP (NIL (3652 6190 (MAKEHVPRETTYCOMS 3662 . 4949) (READVARS 4951 . 5517) (HPRINT0 5519 . 6188))
(6192 6525 (READVARS-FROM-STRINGS 6192 . 6525)) (6527 6914 (READVARS-FROM-STREAM 6527 . 6914)) (6915
8843 (READVAR-FROM-STRING 6925 . 7331) (READVARS-FROM-STRING 7333 . 7569) (HPRINT-TO-STRING 7571 .
7777) (HPRINT-TO-STRINGS 7779 . 8841)) (9654 38247 (HPRINT 9664 . 11655) (HPRINT1 11657 . 23159) (
HPRINTEND 23161 . 24197) (RPTPRINT 24199 . 24437) (RPTEND 24439 . 24598) (RPTPUT 24600 . 25098) (
HPRINTSP 25100 . 25164) (HPERR 25166 . 25263) (HVFWDCDREAD 25265 . 25644) (HVBAKREAD 25646 . 33691) (
HVREADCHECKGETFN 33693 . 35092) (HVREADEND 35094 . 35446) (HVRPTREAD 35448 . 35974) (HVFWDREAD 35976
. 36830) (HREAD 36832 . 37154) (HPINITRDTBL 37156 . 37990) (HVREADERR 37992 . 38105) (HPRINSP 38107
. 38245)) (38248 47130 (COPYALL 38258 . 42161) (\COPYDATATYPE 42163 . 42852) (HCOPYALL 42854 . 43164)
(HCOPYALL1 43166 . 47128)) (47131 54425 (EQUALALL 47141 . 52746) (EQUALHASH 52748 . 54423)))))
STOP

BIN
sources/HPRINT.LCOM
View File

Binary file not shown.

119
sources/LLDISPLAY
View File

@@ -1,17 +1,13 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 9-Jul-2022 12:08:02" 
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>LLDISPLAY.;16 269372
(FILECREATED "31-Jul-2023 14:50:58" {WMEDLEY}<sources>LLDISPLAY.;19 270570
:CHANGES-TO (FNS \COMMON.DSPCREATE)
:EDIT-BY rmk
:PREVIOUS-DATE " 8-Jul-2022 23:44:51"
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>LLDISPLAY.;13)
:CHANGES-TO (FNS BITMAPEQUAL)
:PREVIOUS-DATE "31-Jul-2023 14:45:32" {WMEDLEY}<sources>LLDISPLAY.;18)
(* ; "
Copyright (c) 1981-1990, 1993-1994, 2021 by Venue & Xerox Corporation.
")
(PRETTYCOMPRINT LLDISPLAYCOMS)
@@ -33,8 +29,8 @@ Copyright (c) 1981-1990, 1993-1994, 2021 by Venue & Xerox Corporation.
(DECLARE%: DONTEVAL@LOAD DOCOPY (VARS (CursorBitMap (\CreateCursorBitMap]
[COMS (* ; "bitmap functions.")
(FNS BITBLT BLTSHADE \BITBLTSUB \GETPILOTBBTSCRATCHBM BITMAPCOPY BITMAPCREATE BITMAPBIT
BLTCHAR \BLTCHAR \MEDW.BLTCHAR \CHANGECHARSET.DISPLAY \INDICATESTRING \SLOWBLTCHAR
TEXTUREP INVERT.TEXTURE INVERT.TEXTURE.BITMAP BITMAPWIDTH READBITMAP
BITMAPEQUAL BLTCHAR \BLTCHAR \MEDW.BLTCHAR \CHANGECHARSET.DISPLAY \INDICATESTRING
\SLOWBLTCHAR TEXTUREP INVERT.TEXTURE INVERT.TEXTURE.BITMAP BITMAPWIDTH READBITMAP
\INSUREBITSPERPIXEL MAXIMUMCOLOR OPPOSITECOLOR MAXIMUMSHADE OPPOSITESHADE
\MEDW.BITBLT)
(FUNCTIONS FINISH-READING-BITMAP)
@@ -1022,6 +1018,29 @@ Copyright (c) 1981-1990, 1993-1994, 2021 by Venue & Xerox Corporation.
 "anything outside the clipping region returns 0.")
0])
(BITMAPEQUAL
[LAMBDA (BM1 BM2) (* ; "Edited 31-Jul-2023 14:50 by rmk")
(* ;; "T if BM1 and BM2 are both bitmaps of the same shape and contents. The numeric fields are all SMALLP's")
(if (AND (type? BITMAP BM1)
(type? BITMAP BM2))
then (CL:WHEN (AND (EQ (ffetch (BITMAP BITMAPWIDTH) of BM1)
(ffetch (BITMAP BITMAPWIDTH) of BM2))
(EQ (ffetch (BITMAP BITMAPHEIGHT) of BM1)
(ffetch (BITMAP BITMAPHEIGHT) of BM2))
(EQ (ffetch (BITMAP BITMAPRASTERWIDTH) of BM1)
(ffetch (BITMAP BITMAPRASTERWIDTH) of BM2))
(EQ (ffetch (BITMAP BITMAPBITSPERPIXEL) of BM1)
(ffetch (BITMAP BITMAPBITSPERPIXEL) of BM2)))
(for I (BASE1 _ (ffetch (BITMAP BITMAPBASE) of BM1))
(BASE2 _ (ffetch (BITMAP BITMAPBASE) of BM2)) from 0
to (SUB1 (ITIMES (ffetch (BITMAP BITMAPRASTERWIDTH) of BM1)
(ffetch (BITMAP BITMAPHEIGHT) of BM1)))
always (EQ (\GETBASE BASE1 I)
(\GETBASE BASE2 I))))
else (BIGBITMAPEQUAL BM1 BM2])
(BLTCHAR
[LAMBDA (CHARCODE DISPLAYSTREAM) (* rmk%: " 4-Apr-85 11:45")
(* ; "user entry --- seldom used")
@@ -4553,46 +4572,44 @@ Copyright (c) 1981-1990, 1993-1994, 2021 by Venue & Xerox Corporation.
(ADDTOVAR LAMA )
)
(PUTPROPS LLDISPLAY COPYRIGHT ("Venue & Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1988
1989 1990 1993 1994 2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (20598 23266 (\FBITMAPBIT 20608 . 21068) (\FBITMAPBIT.UFN 21070 . 22089) (
\NEWPAGE.DISPLAY 22091 . 22226) (INITBITMASKS 22228 . 23264)) (25191 25700 (\CreateCursorBitMap 25201
. 25698)) (25817 84905 (BITBLT 25827 . 36217) (BLTSHADE 36219 . 36997) (\BITBLTSUB 36999 . 47134) (
\GETPILOTBBTSCRATCHBM 47136 . 47751) (BITMAPCOPY 47753 . 48329) (BITMAPCREATE 48331 . 49891) (
BITMAPBIT 49893 . 58280) (BLTCHAR 58282 . 58898) (\BLTCHAR 58900 . 59402) (\MEDW.BLTCHAR 59404 . 64282
) (\CHANGECHARSET.DISPLAY 64284 . 67242) (\INDICATESTRING 67244 . 68440) (\SLOWBLTCHAR 68442 . 75538)
(TEXTUREP 75540 . 75810) (INVERT.TEXTURE 75812 . 76086) (INVERT.TEXTURE.BITMAP 76088 . 77623) (
BITMAPWIDTH 77625 . 77997) (READBITMAP 77999 . 80509) (\INSUREBITSPERPIXEL 80511 . 80806) (
MAXIMUMCOLOR 80808 . 80949) (OPPOSITECOLOR 80951 . 81130) (MAXIMUMSHADE 81132 . 81343) (OPPOSITESHADE
81345 . 81524) (\MEDW.BITBLT 81526 . 84903)) (84907 90093 (FINISH-READING-BITMAP 84907 . 90093)) (
91215 91696 (BITMAPBIT.EXPANDER 91225 . 91694)) (91697 140231 (\BITBLT.DISPLAY 91707 . 114946) (
\BITBLT.BITMAP 114948 . 124047) (\BITBLT.MERGE 124049 . 126302) (\BLTSHADE.DISPLAY 126304 . 133404) (
\BLTSHADE.BITMAP 133406 . 140229)) (140232 149552 (\BITBLT.BITMAP.SLOW 140242 . 149550)) (149553
165934 (\PUNT.BLTSHADE.BITMAP 149563 . 156659) (\PUNT.BITBLT.BITMAP 156661 . 165932)) (165935 169375 (
\SCALEDBITBLT.DISPLAY 165945 . 167578) (\BACKCOLOR.DISPLAY 167580 . 169373)) (173230 175503 (
DISPLAYSTREAMP 173240 . 173848) (DSPSOURCETYPE 173850 . 174859) (DSPXOFFSET 174861 . 175180) (
DSPYOFFSET 175182 . 175501)) (175504 189699 (DSPDESTINATION 175514 . 178617) (DSPTEXTURE 178619 .
178781) (\DISPLAYSTREAMINCRXPOSITION 178783 . 179070) (\SFFixDestination 179072 . 180250) (
\SFFixClippingRegion 180252 . 182424) (\SFFixFont 182426 . 183476) (\SFFIXLINELENGTH 183478 . 184974)
(\UPDATE-SYNONYM-STREAM-LINELENGTH-FIELD 184976 . 186789) (\SFFixY 186791 . 189697)) (189700 193547 (
\SIMPLE.DSPCREATE 189710 . 190260) (\COMMON.DSPCREATE 190262 . 193545)) (193648 195842 (\MEDW.XOFFSET
193658 . 194799) (\MEDW.YOFFSET 194801 . 195840)) (195843 203769 (\DSPCLIPPINGREGION.DISPLAY 195853 .
196599) (\DSPFONT.DISPLAY 196601 . 198971) (\DISPLAY.PILOTBITBLT 198973 . 199122) (
\DSPLINEFEED.DISPLAY 199124 . 199695) (\DSPLEFTMARGIN.DISPLAY 199697 . 200428) (\DSPOPERATION.DISPLAY
200430 . 201454) (\DSPRIGHTMARGIN.DISPLAY 201456 . 202301) (\DSPXPOSITION.DISPLAY 202303 . 203160) (
\DSPYPOSITION.DISPLAY 203162 . 203767)) (207957 212993 (TTYDISPLAYSTREAM 207967 . 212991)) (213296
214326 (DSPSCROLL 213306 . 214006) (PAGEHEIGHT 214008 . 214324)) (214371 217393 (\DSPRESET.DISPLAY
214381 . 217391)) (217429 217952 (\MAYBE-DRIBBLE-CHAR 217429 . 217952)) (217953 238591 (\DSPPRINTCHAR
217963 . 225801) (\DSPPRINTCR/LF 225803 . 238589)) (238592 239184 (\TTYBACKGROUND 238602 . 239182)) (
239185 242472 (DSPBACKUP 239195 . 242470)) (242656 242912 (COLORDISPLAYP 242666 . 242910)) (242913
244984 (DISPLAYBEFOREEXIT 242923 . 243749) (DISPLAYAFTERENTRY 243751 . 244982)) (245356 249888 (
\DSPCLIPTRANSFORMX 245366 . 245955) (\DSPCLIPTRANSFORMY 245957 . 246682) (\DSPTRANSFORMREGION 246684
. 247216) (\DSPUNTRANSFORMY 247218 . 247478) (\DSPUNTRANSFORMX 247480 . 247740) (
\OFFSETCLIPPINGREGION 247742 . 249886)) (251202 253789 (UPDATESCREENDIMENSIONS 251212 . 251841) (
\CreateScreenBitMap 251843 . 253787)) (254348 267507 (\CoerceToDisplayDevice 254358 . 254771) (
\CREATEDISPLAY 254773 . 256613) (DISPLAYSTREAMINIT 256615 . 259759) (\STARTDISPLAY 259761 . 262672) (
\MOVE.WINDOWS.ONTO.SCREEN 262674 . 264866) (\UPDATE.PBT.RASTERWIDTHS 264868 . 266650) (\STOPDISPLAY
266652 . 267144) (\DEFINEDISPLAYINFO 267146 . 267505)) (268115 268876 (INITIALIZEDISPLAYSTREAMS 268125
. 268874)))))
(FILEMAP (NIL (20459 23127 (\FBITMAPBIT 20469 . 20929) (\FBITMAPBIT.UFN 20931 . 21950) (
\NEWPAGE.DISPLAY 21952 . 22087) (INITBITMASKS 22089 . 23125)) (25052 25561 (\CreateCursorBitMap 25062
. 25559)) (25678 86230 (BITBLT 25688 . 36078) (BLTSHADE 36080 . 36858) (\BITBLTSUB 36860 . 46995) (
\GETPILOTBBTSCRATCHBM 46997 . 47612) (BITMAPCOPY 47614 . 48190) (BITMAPCREATE 48192 . 49752) (
BITMAPBIT 49754 . 58141) (BITMAPEQUAL 58143 . 59605) (BLTCHAR 59607 . 60223) (\BLTCHAR 60225 . 60727)
(\MEDW.BLTCHAR 60729 . 65607) (\CHANGECHARSET.DISPLAY 65609 . 68567) (\INDICATESTRING 68569 . 69765) (
\SLOWBLTCHAR 69767 . 76863) (TEXTUREP 76865 . 77135) (INVERT.TEXTURE 77137 . 77411) (
INVERT.TEXTURE.BITMAP 77413 . 78948) (BITMAPWIDTH 78950 . 79322) (READBITMAP 79324 . 81834) (
\INSUREBITSPERPIXEL 81836 . 82131) (MAXIMUMCOLOR 82133 . 82274) (OPPOSITECOLOR 82276 . 82455) (
MAXIMUMSHADE 82457 . 82668) (OPPOSITESHADE 82670 . 82849) (\MEDW.BITBLT 82851 . 86228)) (86232 91418 (
FINISH-READING-BITMAP 86232 . 91418)) (92540 93021 (BITMAPBIT.EXPANDER 92550 . 93019)) (93022 141556 (
\BITBLT.DISPLAY 93032 . 116271) (\BITBLT.BITMAP 116273 . 125372) (\BITBLT.MERGE 125374 . 127627) (
\BLTSHADE.DISPLAY 127629 . 134729) (\BLTSHADE.BITMAP 134731 . 141554)) (141557 150877 (
\BITBLT.BITMAP.SLOW 141567 . 150875)) (150878 167259 (\PUNT.BLTSHADE.BITMAP 150888 . 157984) (
\PUNT.BITBLT.BITMAP 157986 . 167257)) (167260 170700 (\SCALEDBITBLT.DISPLAY 167270 . 168903) (
\BACKCOLOR.DISPLAY 168905 . 170698)) (174555 176828 (DISPLAYSTREAMP 174565 . 175173) (DSPSOURCETYPE
175175 . 176184) (DSPXOFFSET 176186 . 176505) (DSPYOFFSET 176507 . 176826)) (176829 191024 (
DSPDESTINATION 176839 . 179942) (DSPTEXTURE 179944 . 180106) (\DISPLAYSTREAMINCRXPOSITION 180108 .
180395) (\SFFixDestination 180397 . 181575) (\SFFixClippingRegion 181577 . 183749) (\SFFixFont 183751
. 184801) (\SFFIXLINELENGTH 184803 . 186299) (\UPDATE-SYNONYM-STREAM-LINELENGTH-FIELD 186301 . 188114
) (\SFFixY 188116 . 191022)) (191025 194872 (\SIMPLE.DSPCREATE 191035 . 191585) (\COMMON.DSPCREATE
191587 . 194870)) (194973 197167 (\MEDW.XOFFSET 194983 . 196124) (\MEDW.YOFFSET 196126 . 197165)) (
197168 205094 (\DSPCLIPPINGREGION.DISPLAY 197178 . 197924) (\DSPFONT.DISPLAY 197926 . 200296) (
\DISPLAY.PILOTBITBLT 200298 . 200447) (\DSPLINEFEED.DISPLAY 200449 . 201020) (\DSPLEFTMARGIN.DISPLAY
201022 . 201753) (\DSPOPERATION.DISPLAY 201755 . 202779) (\DSPRIGHTMARGIN.DISPLAY 202781 . 203626) (
\DSPXPOSITION.DISPLAY 203628 . 204485) (\DSPYPOSITION.DISPLAY 204487 . 205092)) (209282 214318 (
TTYDISPLAYSTREAM 209292 . 214316)) (214621 215651 (DSPSCROLL 214631 . 215331) (PAGEHEIGHT 215333 .
215649)) (215696 218718 (\DSPRESET.DISPLAY 215706 . 218716)) (218754 219277 (\MAYBE-DRIBBLE-CHAR
218754 . 219277)) (219278 239916 (\DSPPRINTCHAR 219288 . 227126) (\DSPPRINTCR/LF 227128 . 239914)) (
239917 240509 (\TTYBACKGROUND 239927 . 240507)) (240510 243797 (DSPBACKUP 240520 . 243795)) (243981
244237 (COLORDISPLAYP 243991 . 244235)) (244238 246309 (DISPLAYBEFOREEXIT 244248 . 245074) (
DISPLAYAFTERENTRY 245076 . 246307)) (246681 251213 (\DSPCLIPTRANSFORMX 246691 . 247280) (
\DSPCLIPTRANSFORMY 247282 . 248007) (\DSPTRANSFORMREGION 248009 . 248541) (\DSPUNTRANSFORMY 248543 .
248803) (\DSPUNTRANSFORMX 248805 . 249065) (\OFFSETCLIPPINGREGION 249067 . 251211)) (252527 255114 (
UPDATESCREENDIMENSIONS 252537 . 253166) (\CreateScreenBitMap 253168 . 255112)) (255673 268832 (
\CoerceToDisplayDevice 255683 . 256096) (\CREATEDISPLAY 256098 . 257938) (DISPLAYSTREAMINIT 257940 .
261084) (\STARTDISPLAY 261086 . 263997) (\MOVE.WINDOWS.ONTO.SCREEN 263999 . 266191) (
\UPDATE.PBT.RASTERWIDTHS 266193 . 267975) (\STOPDISPLAY 267977 . 268469) (\DEFINEDISPLAYINFO 268471 .
268830)) (269440 270201 (INITIALIZEDISPLAYSTREAMS 269450 . 270199)))))
STOP

158
sources/LLDISPLAY.LCOM
View File

@@ -1,12 +1,9 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 9-Jul-2022 12:08:03" ("compiled on "
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>LLDISPLAY.;16) " 8-Jul-2022 23:54:51"
"COMPILE-FILEd" in "FULL 8-Jul-2022 ..." dated " 8-Jul-2022 23:54:57")
(FILECREATED " 9-Jul-2022 12:08:02"
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>LLDISPLAY.;16 269372 :CHANGES-TO (FNS
\COMMON.DSPCREATE) :PREVIOUS-DATE " 8-Jul-2022 23:44:51"
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>LLDISPLAY.;13)
(FILECREATED "31-Jul-2023 14:50:58" ("compiled on " {WMEDLEY}<sources>LLDISPLAY.;19)
"31-Jul-2023 14:48:17" "COMPILE-FILEd" in "FULL 31-Jul-2023 ..." dated "31-Jul-2023 14:48:24")
(FILECREATED "31-Jul-2023 14:50:58" {WMEDLEY}<sources>LLDISPLAY.;19 270570 :EDIT-BY rmk :CHANGES-TO (
FNS BITMAPEQUAL) :PREVIOUS-DATE "31-Jul-2023 14:45:32" {WMEDLEY}<sources>LLDISPLAY.;18)
(RPAQQ LLDISPLAYCOMS ((DECLARE%: DONTCOPY (EXPORT (RECORDS PILOTBBT \DISPLAYDATA DISPLAYSTATE
DISPLAYINFO) (MACROS \GETDISPLAYDATA))) (* ;
"User-visible records are on ADISPLAY --- must be init'ed here") (INITRECORDS BITMAP PILOTBBT REGION
@@ -16,12 +13,12 @@ OPTIMIZERS \FBITMAPBIT) (EXPORT (DECLARE%: DONTCOPY (MACROS \BITMASK \4BITMASK \
WORDMASK 65535)))) (DECLARE%: DONTEVAL@LOAD DOCOPY (P (INITBITMASKS)))) (COMS (* ; "init cursor") (FNS
\CreateCursorBitMap) (DECLARE%: DONTEVAL@LOAD DOCOPY (VARS (CursorBitMap (\CreateCursorBitMap))))) (
COMS (* ; "bitmap functions.") (FNS BITBLT BLTSHADE \BITBLTSUB \GETPILOTBBTSCRATCHBM BITMAPCOPY
BITMAPCREATE BITMAPBIT BLTCHAR \BLTCHAR \MEDW.BLTCHAR \CHANGECHARSET.DISPLAY \INDICATESTRING
\SLOWBLTCHAR TEXTUREP INVERT.TEXTURE INVERT.TEXTURE.BITMAP BITMAPWIDTH READBITMAP \INSUREBITSPERPIXEL
MAXIMUMCOLOR OPPOSITECOLOR MAXIMUMSHADE OPPOSITESHADE \MEDW.BITBLT) (FUNCTIONS FINISH-READING-BITMAP)
(CONSTANTS (MINIMUMCOLOR 0) (MINIMUMSHADE 0)) (P (MOVD (QUOTE BITMAPBIT) (QUOTE \BITMAPBIT))) (
DECLARE%: DONTCOPY (EXPORT (MACROS \INVALIDATEDISPLAYCACHE))) (OPTIMIZERS BITMAPBIT BITMAPP) (FNS
BITMAPBIT.EXPANDER) (FNS \BITBLT.DISPLAY \BITBLT.BITMAP \BITBLT.MERGE \BLTSHADE.DISPLAY
BITMAPCREATE BITMAPBIT BITMAPEQUAL BLTCHAR \BLTCHAR \MEDW.BLTCHAR \CHANGECHARSET.DISPLAY
\INDICATESTRING \SLOWBLTCHAR TEXTUREP INVERT.TEXTURE INVERT.TEXTURE.BITMAP BITMAPWIDTH READBITMAP
\INSUREBITSPERPIXEL MAXIMUMCOLOR OPPOSITECOLOR MAXIMUMSHADE OPPOSITESHADE \MEDW.BITBLT) (FUNCTIONS
FINISH-READING-BITMAP) (CONSTANTS (MINIMUMCOLOR 0) (MINIMUMSHADE 0)) (P (MOVD (QUOTE BITMAPBIT) (QUOTE
\BITMAPBIT))) (DECLARE%: DONTCOPY (EXPORT (MACROS \INVALIDATEDISPLAYCACHE))) (OPTIMIZERS BITMAPBIT
BITMAPP) (FNS BITMAPBIT.EXPANDER) (FNS \BITBLT.DISPLAY \BITBLT.BITMAP \BITBLT.MERGE \BLTSHADE.DISPLAY
\BLTSHADE.BITMAP) (FNS (* ;; "For SunLoadup") \BITBLT.BITMAP.SLOW) (FNS (* ;;
" punt case for C funcs.bitblt_bitmap,bitshade.bitmap") \PUNT.BLTSHADE.BITMAP \PUNT.BITBLT.BITMAP) (
FNS (* ;; "from SUMEX-AIM") \SCALEDBITBLT.DISPLAY \BACKCOLOR.DISPLAY) (DECLARE%: DONTCOPY (CONSTANTS (
@@ -123,18 +120,18 @@ NIL $l dk
()
(RPAQ CursorBitMap (\CreateCursorBitMap))
BITBLT :D8
(L (11 CLIPPINGREGION 10 TEXTURE 9 OPERATION 8 SOURCETYPE 7 HEIGHT 6 WIDTH 5 DESTINATIONBOTTOM 4 DESTINATIONLEFT 3 DESTINATION 2 SOURCEBOTTOM 1 SOURCELEFT 0 SOURCE) F 19 \SOFTCURSORUPP F 20 \CURSORDESTINATION F 21 \SCREENBITMAPS) ¢ D£jb¿E£jb
(L (11 CLIPPINGREGION 10 TEXTURE 9 OPERATION 8 SOURCETYPE 7 HEIGHT 6 WIDTH 5 DESTINATIONBOTTOM 4 DESTINATIONLEFT 3 DESTINATION 2 SOURCEBOTTOM 1 SOURCELEFT 0 SOURCE) F 19 \SOFTCURSORP F 20 \SOFTCURSORUPP F 21 \CURSORDESTINATION F 22 \SCREENBITMAPS) œ D£jb¿E£jb
¿Ggð²NCdò¿GCDEFGGG gh HÉ.ɹGHDEFGGGlIð@@dò]¿A£jb¿B£jb¿@¹AºB»Fµ3@Èb ¿Gµ@Èb¿±É@ÈBÙ½dMñ²ì¿M°è@ÈAÙ¼dLñ²É¿L°Ågh É0X¢±…A¦HÉ
b¿B§HÉ
b¿HɹAHÉØbHÈ"¾dNñ¡¿NºBHÉØbHÈ$_¿dOñ¢¿O»FµNHÈ#JÙb ¿Gµ%HÈ%KÙb¿G¥HÉ6b¿Fjñ´ Gjñ³4hHÈ%KÙ_¿dOñ²Ö¿O°ÑHÈ#JÙ_¿dOñ²­¿O°¨Cdâ±É¿@ ¢±¤h__¿`²8W&´h@gh
W(ð_²`È_¿`jÍ¿¿@gh _`ð³hO
W*—O ¿IABCDEFGGGGGJK O´‚±X¿`OÍ¿±DIABCDEFGGGGGJK gh _@Cð’±ê@ ¢±àC ¢±Ï@dC
¢±Ä¿h__ _"¿`²8W&´h@gh
W(ð_"²`È_ ¿`jÍ¿¿@gh _`ð³hO
W*—O ¿IABFG
b¿HɹAHÉØbHÈ"¾dNñ¡¿NºBHÉØbHÈ$_¿dOñ¢¿O»FµNHÈ#JÙb ¿Gµ%HÈ%KÙb¿G¥HÉ6b¿Fjñ´ Gjñ³4hHÈ%KÙ_¿dOñ²Ö¿O°ÑHÈ#JÙ_¿dOñ²­¿O°¨Cdâ±Æ¿@ ¢±¡h__¿W&²8W(´h@gh
W*ð_²`È_¿`jÍ¿¿@gh _`ð³hO
W,—O ¿IABCDEFGGGGGJK O´‚±U¿`OÍ¿±AIABCDEFGGGGGJK gh _@Cð’±ç@ ¢±ÝC ¢±Ì@dC
¢±Á¿h__ _"¿W&²8W(´h@gh
W*ð_"²`È_ ¿`jÍ¿¿@gh _`ð³hO
W,—O ¿IABFG
_jdFGgg
¿O"Ÿ¿`O Í¿OjdODEFGGGGG @ ¿OÉ.É_$¿IABODEFGGGGGJKlO$h(881 TOTOPW 874 BKBITBLT 838 \SOFTCURSORUPCURRENT 829 BKBITBLT 806 BITMAPCREATE 794 \TOTOPWDS 783 DSPDESTINATION 765 \GETSTREAM 752 \SOFTCURSORDOWN 721 DSPDESTINATION 716 \GETSTREAM 679 WOVERLAPP 667 WINDOWP 657 WINDOWP 642 \GETSTREAM 630 \BITBLT.BITMAP 591 \SOFTCURSORUPCURRENT 578 \BITBLT.BITMAP 552 \TOTOPWDS 541 DSPDESTINATION 523 \GETSTREAM 510 \SOFTCURSORDOWN 479 DSPDESTINATION 474 \GETSTREAM 440 WINDOWP 214 \GETSTREAM 61 \GETSTREAM 49 \BLTSHADE.BITMAP)
(896 IMAGEOPS 889 STREAM 844 \EM.DISPINTERRUPT 823 REPLACE 818 INPUT 772 \TOPWDS 759 OUTPUT 743 \EM.DISPINTERRUPT 733 \EM.DISPINTERRUPT 710 OUTPUT 697 \SOFTCURSORP 636 OUTPUT 597 \EM.DISPINTERRUPT 530 \TOPWDS 517 OUTPUT 501 \EM.DISPINTERRUPT 491 \EM.DISPINTERRUPT 468 OUTPUT 455 \SOFTCURSORP 429 BITMAP 404 \DISPLAYDATA 380 \DISPLAYDATA 345 \DISPLAYDATA 328 \DISPLAYDATA 305 \DISPLAYDATA 294 \DISPLAYDATA 277 \DISPLAYDATA 266 \DISPLAYDATA 256 \DISPLAYDATA 226 \DISPLAYDATA 219 STREAM 208 OUTPUT 189 BITMAP 169 BITMAP 155 BITMAP 140 BITMAP 110 BITMAP 77 IMAGEOPS 70 STREAM 55 OUTPUT 28 BITMAP 18 TEXTURE)
¿O"Ÿ¿`O Í¿OjdODEFGGGGG @ ¿OÉ.É_$¿IABODEFGGGGGJKlO$h(875 TOTOPW 868 BKBITBLT 832 \SOFTCURSORUPCURRENT 823 BKBITBLT 800 BITMAPCREATE 788 \TOTOPWDS 777 DSPDESTINATION 759 \GETSTREAM 746 \SOFTCURSORDOWN 715 DSPDESTINATION 710 \GETSTREAM 676 WOVERLAPP 664 WINDOWP 654 WINDOWP 639 \GETSTREAM 627 \BITBLT.BITMAP 588 \SOFTCURSORUPCURRENT 575 \BITBLT.BITMAP 549 \TOTOPWDS 538 DSPDESTINATION 520 \GETSTREAM 507 \SOFTCURSORDOWN 476 DSPDESTINATION 471 \GETSTREAM 440 WINDOWP 214 \GETSTREAM 61 \GETSTREAM 49 \BLTSHADE.BITMAP)
(890 IMAGEOPS 883 STREAM 838 \EM.DISPINTERRUPT 817 REPLACE 812 INPUT 766 \TOPWDS 753 OUTPUT 737 \EM.DISPINTERRUPT 727 \EM.DISPINTERRUPT 704 OUTPUT 633 OUTPUT 594 \EM.DISPINTERRUPT 527 \TOPWDS 514 OUTPUT 498 \EM.DISPINTERRUPT 488 \EM.DISPINTERRUPT 465 OUTPUT 429 BITMAP 404 \DISPLAYDATA 380 \DISPLAYDATA 345 \DISPLAYDATA 328 \DISPLAYDATA 305 \DISPLAYDATA 294 \DISPLAYDATA 277 \DISPLAYDATA 266 \DISPLAYDATA 256 \DISPLAYDATA 226 \DISPLAYDATA 219 STREAM 208 OUTPUT 189 BITMAP 169 BITMAP 155 BITMAP 140 BITMAP 110 BITMAP 77 IMAGEOPS 70 STREAM 55 OUTPUT 28 BITMAP 18 TEXTURE)
()
BLTSHADE :D8
(L (7 CLIPPINGREGION 6 OPERATION 5 HEIGHT 4 WIDTH 3 DESTINATIONBOTTOM 2 DESTINATIONLEFT 1 DESTINATION 0 TEXTURE)) [Adò¿@ABµjCµjDEFG gh HÉ.ɹ@HBµjCµjDEFd¥H
@@ -171,7 +168,7 @@ BITMAPCREATE :D8
NIL
( 102 "bits in BITMAP -- too big" 88 131066)
BITMAPBIT :D8
(P 15 SOFTCURSORUP P 14 DISPINTERRUPT P 13 DD P 12 TY P 11 TX P 6 bitmapbase P 5 oldword P 4 HEIGHT P 3 OLDVALUE P 2 WORDX P 1 BITX P 0 NBITS I 3 NEWVALUE I 2 Y I 1 X I 0 BITMAP F 16 \SOFTCURSORUPP F 17 \CURSORDESTINATION F 18 \SCREENBITMAPS) ì°
(P 15 SOFTCURSORUP P 14 DISPINTERRUPT P 13 DD P 12 TY P 11 TX P 6 bitmapbase P 5 oldword P 4 HEIGHT P 3 OLDVALUE P 2 WORDX P 1 BITX P 0 NBITS I 3 NEWVALUE I 2 Y I 1 X I 0 BITMAP F 16 \SOFTCURSORP F 17 \SOFTCURSORUPP F 18 \CURSORDESTINATION F 19 \SCREENBITMAPS) é°
@â±+@ÈXjAñ’± A@Èýñ¢±üjBñ’±õB@È\ýñ¢±åHkð²[Cdjð²¿@ÉABkLkÙ@Èh8³@ÉABlLkÙ@Èh8@ÉABlLkÙ@Èh8@É@ÈBÙkÙ@ÈÚÐ^C²jCñ¯C@È ñ–C ¿Hdkð²c¿AââââZNJÐÈ]`Alå_¿_ÉOl
OØÐÈYCµ MIåjð² jjð<6A>NJÐMImÿæåÍ¿°èNJÐMIäÍ¿°Ýklð²mAlçYdââââZNJÐÈ]d`Alå_¿_ÉOl
OØÐÈå[C²NJÐMKæCllAlåÙÚ
@@ -180,27 +177,32 @@ BITMAPBIT :D8
[C—NAC KoH
0 @gh bÉ0_AO
_BO
_O¢±þºd¢±þµ `²-W ´ h@
W"ð_²`È_¿`jÍ¿¿@`ð³h@
W$–@ ¿OÉOOCû_¿Ož¿`OÍO(733 \SOFTCURSORUPCURRENT 705 \TOTOPWDS 695 DSPDESTINATION 678 \SOFTCURSORDOWN 647 DSPDESTINATION 613 \DSPCLIPTRANSFORMY 603 \DSPCLIPTRANSFORMX 579 \GETSTREAM 563 ERROR 550 \PUTBASE24 539 \GETBASE24 435 LRSH 415 LLSH 382 \GETBASEFIXP 275 \GETBASEFIXP 220 \ILLEGAL.ARG 212 MAXIMUMCOLOR)
(739 \EM.DISPINTERRUPT 713 \DISPLAYDATA 685 \TOPWDS 669 \EM.DISPINTERRUPT 659 \EM.DISPINTERRUPT 634 \SOFTCURSORP 593 \DISPLAYDATA 586 STREAM 573 OUTPUT 375 ARRAYP 366 ARRAYP 352 4BITMASKARRAY 268 ARRAYP 259 ARRAYP 245 BITMASKARRAY 205 BITMAP 186 BITMAP 174 BITMAP 166 BITMAP 154 BITMAP 139 BITMAP 127 BITMAP 112 BITMAP 98 BITMAP 84 BITMAP 57 BITMAP 35 BITMAP 18 BITMAP 8 BITMAP)
_O¢±þºd¢±þµ W ²-W"´ h@
W$ð_²`È_¿`jÍ¿¿@`ð³h@
W&–@ ¿OÉOOCû_¿Ož¿`OÍO(730 \SOFTCURSORUPCURRENT 702 \TOTOPWDS 692 DSPDESTINATION 675 \SOFTCURSORDOWN 644 DSPDESTINATION 613 \DSPCLIPTRANSFORMY 603 \DSPCLIPTRANSFORMX 579 \GETSTREAM 563 ERROR 550 \PUTBASE24 539 \GETBASE24 435 LRSH 415 LLSH 382 \GETBASEFIXP 275 \GETBASEFIXP 220 \ILLEGAL.ARG 212 MAXIMUMCOLOR)
(736 \EM.DISPINTERRUPT 710 \DISPLAYDATA 682 \TOPWDS 666 \EM.DISPINTERRUPT 656 \EM.DISPINTERRUPT 593 \DISPLAYDATA 586 STREAM 573 OUTPUT 375 ARRAYP 366 ARRAYP 352 4BITMASKARRAY 268 ARRAYP 259 ARRAYP 245 BITMASKARRAY 205 BITMAP 186 BITMAP 174 BITMAP 166 BITMAP 154 BITMAP 139 BITMAP 127 BITMAP 112 BITMAP 98 BITMAP 84 BITMAP 57 BITMAP 35 BITMAP 18 BITMAP 8 BITMAP)
( 557 "unknown bits per pixel size.")
BITMAPEQUAL :D8
(P 3 BASE2 P 2 BASE1 P 1 I I 1 BM2 I 0 BM1) k@ò\AòT@ÈAÈð´J@ÈAÈð´A@ÈAÈð´8@ÈAÈð´/@È@ÈÚkÙj@ÉAÉIHó³JIÐÈKIÐÈð¡hIkÔY°êi@A
(104 BIGBITMAPEQUAL)
(13 BITMAP 5 BITMAP)
()
BLTCHAR :D8
(I 1 DISPLAYSTREAM I 0 CHARCODE) 2@d—¿j@ñ¡@…@ Adgh É0 (47 \BLTCHAR 30 \GETSTREAM 17 \ILLEGAL.ARG)
(42 \DISPLAYDATA 35 STREAM 24 OUTPUT)
()
\BLTCHAR :D8
(P 0 A0448 I 2 DISPLAYDATA I 1 DISPLAYSTREAM I 0 CHARCODE) (Agh bÉ.ÉZ@ABlH(11 \GETSTREAM)
(P 0 A0229 I 2 DISPLAYDATA I 1 DISPLAYSTREAM I 0 CHARCODE) (Agh bÉ.ÉZ@ABlH(11 \GETSTREAM)
(25 IMAGEOPS 18 STREAM 5 OUTPUT)
()
\MEDW.BLTCHAR :D8
(L (2 DISPLAYDATA 1 DISPLAYSTREAM 0 CHARCODE) F 7 \SOFTCURSORUPP F 8 \CURSORDESTINATION F 9 \SCREENBITMAPS) p@lÿå\¿BdÉ>@ãð¨@ã
(L (2 DISPLAYDATA 1 DISPLAYSTREAM 0 CHARCODE) F 7 \SOFTCURSORP F 8 \SOFTCURSORUPP F 9 \CURSORDESTINATION F 10 \SCREENBITMAPS)  p@lÿå\¿BdÉ>@ãð¨@ã
¿BÉ—@A
BÉ[BÉ0LÐÈØYBÉñŸKBÉñ™l A
°ÃBKBÉLÐÈØ¿BɸKHØ»IHØYBÈ#Xñ‘H¹KBÈ"Xñ‘K€HºIJñ´‚±“BÉ*XÈ jð’±<00>h]¾`²*W´ hA
Wð^²`Ƚ`jÍ¿¿A`ð³hA
W–A ¿HJÍ¿HIJÙÍ¿HBÉLÐÈJØKÙÍ¿Hjv¿N<C2BF>¿`MÍih(255 \SOFTCURSORUPCURRENT 216 \TOTOPWDS 206 DSPDESTINATION 189 \SOFTCURSORDOWN 161 DSPDESTINATION 68 \DSPPRINTCR/LF 35 \SLOWBLTCHAR 23 \CHANGECHARSET.DISPLAY)
(261 \EM.DISPINTERRUPT 196 \TOPWDS 180 \EM.DISPINTERRUPT 172 \EM.DISPINTERRUPT 148 \SOFTCURSORP 132 PILOTBBT)
°ÃBKBÉLÐÈØ¿BɸKHØ»IHØYBÈ#Xñ‘H¹KBÈ"Xñ‘K€HºIJñ´‚±ŽBÉ*XÈ jð³}h]¾W²*W´ hA
Wð^²`Ƚ`jÍ¿¿A`ð³hA
W–A ¿HJÍ¿HIJÙÍ¿HBÉLÐÈJØKÙÍ¿Hjv¿N<C2BF>¿`MÍih(250 \SOFTCURSORUPCURRENT 211 \TOTOPWDS 201 DSPDESTINATION 184 \SOFTCURSORDOWN 156 DSPDESTINATION 68 \DSPPRINTCR/LF 35 \SLOWBLTCHAR 23 \CHANGECHARSET.DISPLAY)
(256 \EM.DISPINTERRUPT 191 \TOPWDS 175 \EM.DISPINTERRUPT 167 \EM.DISPINTERRUPT 132 PILOTBBT)
()
\CHANGECHARSET.DISPLAY :D8
(P 4 \INTERRUPTABLE P 2 BM P 1 CSINFO P 0 PBT I 1 CHARSET I 0 DISPLAYDATA) Š@É*@É ÉAàÐɵ A@É h "@IÉ¿@IÉ¿@IÉ0¿@A>¿IɺHJÈàààànÿÿåÍ¿@È'IÈ
@@ -218,17 +220,17 @@ BLTCHAR :D8
(75 ^ 52 %# 16 SI::RESETUNWIND)
( 81 "" 58 "")
\SLOWBLTCHAR :D8
(P 16 CSINFO P 15 HEIGHTMOVED P 14 YPOS P 13 SOFTCURSORUP P 12 DISPINTERRUPT P 11 SOURCEBIT P 10 WIDTH P 9 DESTBIT P 8 PILOTBBT P 7 CURX P 6 RIGHT P 5 LEFT P 4 NEWX P 2 DD P 1 CHAR8CODE P 0 ROTATION I 1 DISPLAYSTREAM I 0 CHARCODE F 17 \SOFTCURSORUPP F 18 \CURSORDESTINATION F 19 \SCREENBITMAPS) N@@lÿåYAÉ0ZdÉ È Xdjð¢±<EFBFBD>€ JÉ_JÉIÐÈØ\JÉñ²l A
¿JÉ_JÉIÐÈؼJL¿OJÉØ_¿JÈ"dOñ¢¿O½JÈ#LJÉØ»dKñ‘¿K¾JÉ*_¿NMñ¢±OÈ jð’±M_¿NMÙ_¿JÉIÐÈMØOÙ_¿JÉÈdkð³adlð²¿Oàà_¿Oàà_¿Oàà_°Ddlð²¿Oààà_¿Oààà_¿Oààà_°$lð²lOÚ_¿lOÚ_¿lOÚ_„¿ `²-W"´ hA
W$ð_²`È_¿`jÍ¿¿A`ð³hA
W&–A ¿OOÍ¿OOÍ¿OOÍ¿Ojv¿OŸ¿`OÍ¿±·0JÉ_¿JÉIÐÈ_¿JÉ É@ãàÐɵ @ãJÉ h _ ¿HdlZð²;¿AOOØ
(P 16 CSINFO P 15 HEIGHTMOVED P 14 YPOS P 13 SOFTCURSORUP P 12 DISPINTERRUPT P 11 SOURCEBIT P 10 WIDTH P 9 DESTBIT P 8 PILOTBBT P 7 CURX P 6 RIGHT P 5 LEFT P 4 NEWX P 2 DD P 1 CHAR8CODE P 0 ROTATION I 1 DISPLAYSTREAM I 0 CHARCODE F 17 \SOFTCURSORP F 18 \SOFTCURSORUPP F 19 \CURSORDESTINATION F 20 \SCREENBITMAPS) K@@lÿåYAÉ0ZdÉ È Xdjð¢±~€ JÉ_JÉIÐÈØ\JÉñ²l A
¿JÉ_JÉIÐÈؼJL¿OJÉØ_¿JÈ"dOñ¢¿O½JÈ#LJÉØ»dKñ‘¿K¾JÉ*_¿NMñ¢± OÈ jð’±M_¿NMÙ_¿JÉIÐÈMØOÙ_¿JÉÈdkð³adlð²¿Oàà_¿Oàà_¿Oàà_°Ddlð²¿Oààà_¿Oààà_¿Oààà_°$lð²lOÚ_¿lOÚ_¿lOÚ_„¿ W"²-W$´ hA
W&ð_²`È_¿`jÍ¿¿A`ð³hA
W(–A ¿OOÍ¿OOÍ¿OOÍ¿Ojv¿OŸ¿`OÍ¿±·0JÉ_¿JÉIÐÈ_¿JÉ É@ãàÐɵ @ãJÉ h _ ¿HdlZð²;¿AOOØ
¿O ÉjJÉIÐÈAJÉO È
ÙkØOO È
O È ØO °Hnð²8AOOÙ
¿O ÉjJÉIÐÈAJÉO È ÙJÉO È
O È ØO ‰o h(586 ERROR 575 BKBITBLT 533 \DSPYPOSITION.DISPLAY 514 BKBITBLT 471 \DSPYPOSITION.DISPLAY 449 \CREATECHARSET 390 \SOFTCURSORUPCURRENT 355 \TOTOPWDS 345 DSPDESTINATION 328 \SOFTCURSORDOWN 297 DSPDESTINATION 275 SHOULDNT 55 \DSPPRINTCR/LF)
(396 \EM.DISPINTERRUPT 335 \TOPWDS 319 \EM.DISPINTERRUPT 309 \EM.DISPINTERRUPT 284 \SOFTCURSORP 111 \DISPLAYDATA 83 \DISPLAYDATA)
( 581 "Not implemented to rotate by other than 0, 90 or 270")
O È ØO ‰o h(583 ERROR 572 BKBITBLT 530 \DSPYPOSITION.DISPLAY 511 BKBITBLT 468 \DSPYPOSITION.DISPLAY 446 \CREATECHARSET 387 \SOFTCURSORUPCURRENT 352 \TOTOPWDS 342 DSPDESTINATION 325 \SOFTCURSORDOWN 294 DSPDESTINATION 275 SHOULDNT 55 \DSPPRINTCR/LF)
(393 \EM.DISPINTERRUPT 332 \TOPWDS 316 \EM.DISPINTERRUPT 306 \EM.DISPINTERRUPT 111 \DISPLAYDATA 83 \DISPLAYDATA)
( 578 "Not implemented to rotate by other than 0, 90 or 270")
TEXTUREP :D8
(I 0 OBJECT) @d3 ³ô@Èkð´@NIL
(18 BITMAP 10 BITMAP)
@@ -276,7 +278,7 @@ OPPOSITESHADE :D8
NIL
()
\MEDW.BITBLT :D8
(P 9 A0451 P 8 A0450 P 7 SOURCEBOTTOMTRANSFORMED P 6 SOURCELEFTTRANSFORMED P 3 SRCWIN P 2 A0449 P 1 DD P 0 DSTWIN I 11 CLIPPINGREGION I 10 TEXTURE I 9 OPERATION I 8 SOURCETYPE I 7 HEIGHT I 6 WIDTH I 5 DESTINATIONBOTTOM I 4 DESTINATIONLEFT I 3 DESTINATION I 2 SOURCEBOTTOM I 1 SOURCELEFT I 0 SOURCE F 10 \SCREENBITMAPS) 
(P 9 A0232 P 8 A0231 P 7 SOURCEBOTTOMTRANSFORMED P 6 SOURCELEFTTRANSFORMED P 3 SRCWIN P 2 A0230 P 1 DD P 0 DSTWIN I 11 CLIPPINGREGION I 10 TEXTURE I 9 OPERATION I 8 SOURCETYPE I 7 HEIGHT I 6 WIDTH I 5 DESTINATIONBOTTOM I 4 DESTINATIONLEFT I 3 DESTINATION I 2 SOURCEBOTTOM I 1 SOURCELEFT I 0 SOURCE F 10 \SCREENBITMAPS) 
 @ ³C ªo ¿@òZ@²WCi
Cgh É0HÉ2ÉHºHÉ2@ABCDEFGGGGGABlJ±–Cô‚±¯C´‚±¨@i
!@gh É0AIÉصABIÉصBKÉ2ÉJ_¿KÉ2IÉNOCDEFGGGGGNIÈ"¼dLñ¡¿LOIÈ$½dMñ¡¿MlO±Þ@
@@ -315,28 +317,28 @@ BITMAPBIT.EXPANDER :D8
NIL
( 32 (OPCODES MISC4 6))
\BITBLT.DISPLAY :D8
(L (11 CLIPPINGREGION 10 TEXTURE 9 OPERATION 8 SOURCETYPE 7 HEIGHT 6 WIDTH 5 DESTINATIONBOTTOM 4 DESTINATIONLEFT 3 DESTINATION 2 SOURCEBOTTOM 1 SOURCELEFT 0 SOURCEBITMAP) F 48 \SCREENBITMAPS F 49 \SOFTCURSORUPP F 50 \CURSORDESTINATION) <EFBFBD>0 ðð@dò[¿A£jb¿B£jb¿AºB»Fµ3@Èb ¿Gµ@Èb¿±Í@ÈBÙ½dMñ²ì¿M°è@ÈAÙ¼dLñ²É¿L°Ågh É0X¢±‰@¹A¦HÉ
(L (11 CLIPPINGREGION 10 TEXTURE 9 OPERATION 8 SOURCETYPE 7 HEIGHT 6 WIDTH 5 DESTINATIONBOTTOM 4 DESTINATIONLEFT 3 DESTINATION 2 SOURCEBOTTOM 1 SOURCELEFT 0 SOURCEBITMAP) F 48 \SCREENBITMAPS F 49 \SOFTCURSORP F 50 \SOFTCURSORUPP F 51 \CURSORDESTINATION) x0 ðð@dò[¿A£jb¿B£jb¿AºB»Fµ3@Èb ¿Gµ@Èb¿±Í@ÈBÙ½dMñ²ì¿M°è@ÈAÙ¼dLñ²É¿L°Ågh É0X¢±‰@¹A¦HÉ
b¿B§HÉ
b¿HÉb¿AHÉØbHÈ"¾dNñ¡¿NºBHÉØbHÈ$_¿dOñ¢¿O»FµNHÈ#JÙb ¿Gµ%HÈ%KÙb¿G¥HÉ6b¿Fjñ´ Gjñ³4hHÈ%KÙ_¿dOñ²Ö¿O°ÑHÈ#JÙ_¿dOñ²­¿O°¨Cdâ±É¿I ¢±¤h__¿`²8Wb´h@gh
Wdð_²`È_¿`jÍ¿¿@gh _`ð³hO
W`—O ¿@ABCDEFGGGGGJK O´‚±”¿`OÍ¿±€@ABCDEFGGGGGJK gh _IdCð’± ³I¢±&Id ¢±¿C ¢±òIdC
¢±ç¿I ÉÉ.C ÉÉ.ð¢±Âh__ _"¿`²8Wb´hIgh
Wdð_"²`È_ ¿`jÍ¿¿Igh _`ð³hO
b¿HÉb¿AHÉØbHÈ"¾dNñ¡¿NºBHÉØbHÈ$_¿dOñ¢¿O»FµNHÈ#JÙb ¿Gµ%HÈ%KÙb¿G¥HÉ6b¿Fjñ´ Gjñ³4hHÈ%KÙ_¿dOñ²Ö¿O°ÑHÈ#JÙ_¿dOñ²­¿O°¨Cdâ±Æ¿I ¢±¡h__¿Wb²8Wd´h@gh
Wfð_²`È_¿`jÍ¿¿@gh _`ð³hO
W`—O ¿@ABCDEFGGGGGJK O´‚±Ž¿`OÍ¿±z@ABCDEFGGGGGJK gh _IdCð’± ³I¢±#Id ¢±¿C ¢±ïIdC
¢±ä¿I ÉÉ.C ÉÉ.𢱿h__ _"¿Wb²8Wd´hIgh
Wfð_"²`È_ ¿`jÍ¿¿Igh _`ð³hO
W`—O ¿@ABFG
_jdFGgg
¿O"Ÿ¿`O Í¿OjdODEFGGGGG I ¿I²hI
hO
ð¢±ö°)OÉ0_JÉ_L¿O`ð³hO
ð¢±ó°)OÉ0_JÉ_L¿O`ð³hO
W`—O ¿DOJÉØb¿EOJÉØb
¿OJÈ"_B¿OJÈ$_F¿OJÈ#_H¿OJÈ%_D¿G²nOBGOJÉØ_(¿dO(ñ¢¿O(_B¿OFGOJÉØ_*¿dO*ñ¢¿O*_F¿OHO(GØ_$¿dO$ñ’¿O$_H¿ODO*GØ_&¿dO&ñ’¿O&_D¿OLÈ_N¿@È_PONð³2OPkð²@jON ON °ONkð¢±Ë@ON
b¿DdOBñ¢¿OB_B¿EdOFñ¢¿OF_F¿F<C2BF>DFØdOHñ’¿OH_H¿GžEGØdODñ’¿OD_D¿DAÙ_>¿EBÙ_@¿JOBO>Ù_,¿dO,ñ¢¿O,djñ¡¿j_B¿KOFO@Ù_.¿dO.ñ¢¿O.djñ¡¿j_F¿@ÈOHO>Ù_0¿dO0ñ’¿O0JFØ_2¿dO2ñ’¿O2_H¿@ÈODO@Ù_4¿dO4ñ’¿O4KGØ_6¿dO6ñ’¿O6_D¿OHOBñ¢±ïODOFñ¢±æG¦OJÉb¿ON _R¿Gdgð²~¿Gd²¿ONkð™G b<14>G£OR°JGd3 —ORåORæ°<òG`µld
¿OJÈ"_B¿OJÈ$_F¿OJÈ#_H¿OJÈ%_D¿G²nOBGOJÉØ_(¿dO(ñ¢¿O(_B¿OFGOJÉØ_*¿dO*ñ¢¿O*_F¿OHO(GØ_$¿dO$ñ’¿O$_H¿ODO*GØ_&¿dO&ñ’¿O&_D¿OLÈ_N¿@È_PONð³2OPkð²@jON ON °ONkð¢±È@ON
b¿DdOBñ¢¿OB_B¿EdOFñ¢¿OF_F¿F<C2BF>DFØdOHñ’¿OH_H¿GžEGØdODñ’¿OD_D¿DAÙ_>¿EBÙ_@¿JOBO>Ù_,¿dO,ñ¢¿O,djñ¡¿j_B¿KOFO@Ù_.¿dO.ñ¢¿O.djñ¡¿j_F¿@ÈOHO>Ù_0¿dO0ñ’¿O0JFØ_2¿dO2ñ’¿O2_H¿@ÈODO@Ù_4¿dO4ñ’¿O4KGØ_6¿dO6ñ’¿O6_D¿OHOBñ¢±ìODOFñ¢±ãG¦OJÉb¿ON _R¿Gdgð²~¿Gd²¿ONkð™G b<14>G£OR°JGd3 —ORåORæ°<òG`µld

°ONkð©GON
†G b¿ONdkð³)¿GON
°gð²ONdkðœ¿G b¿ONkð³ONOBÚ_B¿ONOHÚ_H¿ONO>Ú_>¿h_8_:¿`².Wb´ hO
Wdð_:²`È_8¿`jÍ¿¿O`ð³hO
W`—O ¿`/ODOFÙ_T¿OHOBÙ_V¿OLÈODO@ØÙ_X¿OBO>Ø_Z¿@ÈODÙ_\¿OB_^¿`OVÍ¿`OTÍ ¿Ggð²"`@O^O\OLOZOXOVOTGG ° `@O^O\OLOZOXOTGGG O:Ÿ¿`O8Í¿°.OÉ.É_<¿@ABODEFGGGGGJKlO<h(1859 \SOFTCURSORUPCURRENT 1850 \BITBLTSUB 1818 \BITBLT.MERGE 1683 \TOTOPWDS 1672 DSPDESTINATION 1653 \SOFTCURSORDOWN 1622 DSPDESTINATION 1564 INSURE.B&W.TEXTURE 1540 COLORTEXTUREFROMCOLOR# 1520 \ILLEGAL.ARG 1512 COLORNUMBERP 1496 INVERT.TEXTURE.BITMAP 1486 BITMAPCREATE 1438 INSURE.B&W.TEXTURE 1404 MAXIMUMSHADE 1171 UNCOLORIZEBITMAP 1166 COLORMAP 1148 COLORIZEBITMAP 1141 MAXIMUMCOLOR 915 \TOTOPWDS 904 DSPDESTINATION 857 DSPDESTINATION 849 DSPDESTINATION 838 TOTOPW 831 BKBITBLT 795 \SOFTCURSORUPCURRENT 786 BKBITBLT 763 BITMAPCREATE 751 \TOTOPWDS 740 DSPDESTINATION 722 \GETSTREAM 709 \SOFTCURSORDOWN 678 DSPDESTINATION 673 \GETSTREAM 627 \INSUREWINDOW 612 \INSUREWINDOW 601 WOVERLAPP 589 WINDOWP 578 WFROMDS 564 WINDOWP 549 \GETSTREAM 537 \BITBLT.BITMAP 498 \SOFTCURSORUPCURRENT 485 \BITBLT.BITMAP 459 \TOTOPWDS 448 DSPDESTINATION 430 \GETSTREAM 417 \SOFTCURSORDOWN 386 DSPDESTINATION 381 \GETSTREAM 347 WINDOWP 117 \GETSTREAM)
(1887 IMAGEOPS 1880 STREAM 1865 \EM.DISPINTERRUPT 1825 \SYSPILOTBBT 1793 \SYSPILOTBBT 1785 MERGE 1773 PILOTBBT 1768 \SYSPILOTBBT 1758 PILOTBBT 1753 \SYSPILOTBBT 1735 BITMAP 1710 BITMAP 1661 \TOPWDS 1644 \EM.DISPINTERRUPT 1634 \EM.DISPINTERRUPT 1608 \SOFTCURSORP 1547 TEXTURE 1491 \BBSCRATCHTEXTURE 1476 \BBSCRATCHTEXTURE 1467 BITMAP 1415 MERGE 1111 BITMAP 1038 \DISPLAYDATA 1008 \DISPLAYDATA 987 \DISPLAYDATA 975 \DISPLAYDATA 963 \DISPLAYDATA 951 \DISPLAYDATA 938 \DISPLAYDATA 924 \DISPLAYDATA 893 \TOPWDS 881 \DISPLAYDATA 872 STREAM 801 \EM.DISPINTERRUPT 780 REPLACE 775 INPUT 729 \TOPWDS 716 OUTPUT 700 \EM.DISPINTERRUPT 690 \EM.DISPINTERRUPT 667 OUTPUT 654 \SOFTCURSORP 634 STREAM 619 STREAM 543 OUTPUT 504 \EM.DISPINTERRUPT 437 \TOPWDS 424 OUTPUT 408 \EM.DISPINTERRUPT 398 \EM.DISPINTERRUPT 375 OUTPUT 362 \SOFTCURSORP 336 BITMAP 311 \DISPLAYDATA 287 \DISPLAYDATA 252 \DISPLAYDATA 235 \DISPLAYDATA 212 \DISPLAYDATA 201 \DISPLAYDATA 184 \DISPLAYDATA 173 \DISPLAYDATA 161 \DISPLAYDATA 129 \DISPLAYDATA 122 STREAM 111 OUTPUT 92 BITMAP 72 BITMAP 58 BITMAP 43 BITMAP 15 BITMAP)
°gð²ONdkðœ¿G b¿ONkð³ONOBÚ_B¿ONOHÚ_H¿ONO>Ú_>¿h_8_:¿Wb².Wd´ hO
Wfð_:²`È_8¿`jÍ¿¿O`ð³hO
W`—O ¿`/ODOFÙ_T¿OHOBÙ_V¿OLÈODO@ØÙ_X¿OBO>Ø_Z¿@ÈODÙ_\¿OB_^¿`OVÍ¿`OTÍ ¿Ggð²"`@O^O\OLOZOXOVOTGG ° `@O^O\OLOZOXOTGGG O:Ÿ¿`O8Í¿°.OÉ.É_<¿@ABODEFGGGGGJKlO<h(1850 \SOFTCURSORUPCURRENT 1841 \BITBLTSUB 1809 \BITBLT.MERGE 1674 \TOTOPWDS 1663 DSPDESTINATION 1644 \SOFTCURSORDOWN 1613 DSPDESTINATION 1558 INSURE.B&W.TEXTURE 1534 COLORTEXTUREFROMCOLOR# 1514 \ILLEGAL.ARG 1506 COLORNUMBERP 1490 INVERT.TEXTURE.BITMAP 1480 BITMAPCREATE 1432 INSURE.B&W.TEXTURE 1398 MAXIMUMSHADE 1165 UNCOLORIZEBITMAP 1160 COLORMAP 1142 COLORIZEBITMAP 1135 MAXIMUMCOLOR 909 \TOTOPWDS 898 DSPDESTINATION 851 DSPDESTINATION 843 DSPDESTINATION 832 TOTOPW 825 BKBITBLT 789 \SOFTCURSORUPCURRENT 780 BKBITBLT 757 BITMAPCREATE 745 \TOTOPWDS 734 DSPDESTINATION 716 \GETSTREAM 703 \SOFTCURSORDOWN 672 DSPDESTINATION 667 \GETSTREAM 624 \INSUREWINDOW 609 \INSUREWINDOW 598 WOVERLAPP 586 WINDOWP 575 WFROMDS 561 WINDOWP 546 \GETSTREAM 534 \BITBLT.BITMAP 495 \SOFTCURSORUPCURRENT 482 \BITBLT.BITMAP 456 \TOTOPWDS 445 DSPDESTINATION 427 \GETSTREAM 414 \SOFTCURSORDOWN 383 DSPDESTINATION 378 \GETSTREAM 347 WINDOWP 117 \GETSTREAM)
(1878 IMAGEOPS 1871 STREAM 1856 \EM.DISPINTERRUPT 1816 \SYSPILOTBBT 1784 \SYSPILOTBBT 1776 MERGE 1764 PILOTBBT 1759 \SYSPILOTBBT 1749 PILOTBBT 1744 \SYSPILOTBBT 1726 BITMAP 1701 BITMAP 1652 \TOPWDS 1635 \EM.DISPINTERRUPT 1625 \EM.DISPINTERRUPT 1541 TEXTURE 1485 \BBSCRATCHTEXTURE 1470 \BBSCRATCHTEXTURE 1461 BITMAP 1409 MERGE 1105 BITMAP 1032 \DISPLAYDATA 1002 \DISPLAYDATA 981 \DISPLAYDATA 969 \DISPLAYDATA 957 \DISPLAYDATA 945 \DISPLAYDATA 932 \DISPLAYDATA 918 \DISPLAYDATA 887 \TOPWDS 875 \DISPLAYDATA 866 STREAM 795 \EM.DISPINTERRUPT 774 REPLACE 769 INPUT 723 \TOPWDS 710 OUTPUT 694 \EM.DISPINTERRUPT 684 \EM.DISPINTERRUPT 661 OUTPUT 631 STREAM 616 STREAM 540 OUTPUT 501 \EM.DISPINTERRUPT 434 \TOPWDS 421 OUTPUT 405 \EM.DISPINTERRUPT 395 \EM.DISPINTERRUPT 372 OUTPUT 336 BITMAP 311 \DISPLAYDATA 287 \DISPLAYDATA 252 \DISPLAYDATA 235 \DISPLAYDATA 212 \DISPLAYDATA 201 \DISPLAYDATA 184 \DISPLAYDATA 173 \DISPLAYDATA 161 \DISPLAYDATA 129 \DISPLAYDATA 122 STREAM 111 OUTPUT 92 BITMAP 72 BITMAP 58 BITMAP 43 BITMAP 15 BITMAP)
()
\BITBLT.BITMAP :D8
(L (13 CLIPPEDSOURCEBOTTOM 12 CLIPPEDSOURCELEFT 11 CLIPPINGREGION 10 TEXTURE 9 OPERATION 8 SOURCETYPE 7 HEIGHT 6 WIDTH 5 DESTINATIONBOTTOM 4 DESTINATIONLEFT 3 DESTBITMAP 2 SOURCEBOTTOM 1 SOURCELEFT 0 SOURCEBITMAP) P 18 \INTERRUPTABLE) ð0CÈ[CÈ\j]d^@È_CÈZG²QMG_¿dOñ¢¿O½NG_¿dOñ¢¿O¾JGGØ_¿dOñ’¿OºKGGØ_¿dOñ’¿O»DdMñ¡¿M½EdNñ¡¿N¾F™DFØdJñ‘¿JºGšEGØdKñ‘¿K»DAÙXEBÙYGdjñ¡¿jMHÙ_¿dOñ¢¿O½Gdjñ¡¿jNIÙ_¿dOñ¢¿O¾@ÈJHÙ_¿dOñ’¿OGFØ_¿dOñ’¿Oº@ÈKIÙ_ ¿dO ñ’¿O GGØ_"¿dO"ñ’¿O"[JMñ´dNñ¡hGgð²WGµnÿÿ°K3 ›Gnÿÿånÿÿæ°<Lkð©GL
@@ -356,13 +358,13 @@ NIL
(158 INPUT 136 ERASE 131 TEXTURE 111 REPLACE 106 INPUT 58 ERASE 53 TEXTURE 33 REPLACE 28 INPUT 6 REPLACE)
()
\BLTSHADE.DISPLAY :D8
(L (7 CLIPPINGREGION 6 OPERATION 5 HEIGHT 4 WIDTH 3 DESTINATIONBOTTOM 2 DESTINATIONLEFT 1 STREAM 0 TEXTURE) F 14 \SCREENBITMAPS F 15 \SOFTCURSORUPP F 16 \CURSORDESTINATION) Zà AÉ0]A`ð³hA
(L (7 CLIPPINGREGION 6 OPERATION 5 HEIGHT 4 WIDTH 3 DESTINATIONBOTTOM 2 DESTINATIONLEFT 1 STREAM 0 TEXTURE) F 14 \SCREENBITMAPS F 15 \SOFTCURSORP F 16 \SOFTCURSORUPP F 17 \CURSORDESTINATION) Wà AÉ0]A`ð³hA
W–A ¿BMÉØbCMÉØbMÈ"¸MÈ$ºMÈ#»MÈ%¹G²`HGMÉØ_¿dOñ¢¿O¸JGMÉØ_¿dOñ¢¿OºKOGØ_¿dOñ’¿O»IOGØ_¿dOñ’¿O¹MÉ\dÈ^BdHñ¡¿H¸CdJñ¡¿JºD™BDØdKñ‘¿K»E™CEØdIñ‘¿I¹KHñ´IJñ¡h@ dgð¨dgð²¿@¤MÉ6°RNkð³G@Ni °;dgð§dgðš¿@N å°(dgð“¿@°gðœNkð¨@N
µ@ bNkð³NHÚ¸NKÚ»@N
b¿h__¿`²-W´ hA
W ð_²`È_¿`jÍ¿¿A`ð³hA
W–A ¿IJÙ_¿`KHÙÍ¿`OÍ ¿`hHhLHLÈIÙOgFµMÉ@NMÉÚMÉ ¿Ož¿`OÍi(588 \SOFTCURSORUPCURRENT 579 \BITBLTSUB 483 \TOTOPWDS 473 DSPDESTINATION 456 \SOFTCURSORDOWN 425 DSPDESTINATION 398 COLORTEXTUREFROMCOLOR# 376 \ILLEGAL.ARG 368 COLORNUMBERP 335 MAXIMUMSHADE 309 COLORNUMBERP 271 TYPENAME 37 \TOTOPWDS 27 DSPDESTINATION)
(594 \EM.DISPINTERRUPT 571 \DISPLAYDATA 562 \DISPLAYDATA 548 TEXTURE 537 BITMAP 526 \SYSPILOTBBT 516 PILOTBBT 511 \SYSPILOTBBT 500 PILOTBBT 495 \SYSPILOTBBT 463 \TOPWDS 447 \EM.DISPINTERRUPT 437 \EM.DISPINTERRUPT 412 \SOFTCURSORP 355 LISTP 344 BITMAP 325 FIXP 317 SMALLP 285 NEW-ATOM 277 LITATOM 211 BITMAP 202 \DISPLAYDATA 138 \DISPLAYDATA 112 \DISPLAYDATA 95 \DISPLAYDATA 86 \DISPLAYDATA 77 \DISPLAYDATA 68 \DISPLAYDATA 57 \DISPLAYDATA 45 \DISPLAYDATA 17 \TOPWDS 8 STREAM)
b¿h__¿W²-W ´ hA
W"ð_²`È_¿`jÍ¿¿A`ð³hA
W–A ¿IJÙ_¿`KHÙÍ¿`OÍ ¿`hHhLHLÈIÙOgFµMÉ@NMÉÚMÉ ¿Ož¿`OÍi(585 \SOFTCURSORUPCURRENT 576 \BITBLTSUB 480 \TOTOPWDS 470 DSPDESTINATION 453 \SOFTCURSORDOWN 422 DSPDESTINATION 398 COLORTEXTUREFROMCOLOR# 376 \ILLEGAL.ARG 368 COLORNUMBERP 335 MAXIMUMSHADE 309 COLORNUMBERP 271 TYPENAME 37 \TOTOPWDS 27 DSPDESTINATION)
(591 \EM.DISPINTERRUPT 568 \DISPLAYDATA 559 \DISPLAYDATA 545 TEXTURE 534 BITMAP 523 \SYSPILOTBBT 513 PILOTBBT 508 \SYSPILOTBBT 497 PILOTBBT 492 \SYSPILOTBBT 460 \TOPWDS 444 \EM.DISPINTERRUPT 434 \EM.DISPINTERRUPT 355 LISTP 344 BITMAP 325 FIXP 317 SMALLP 285 NEW-ATOM 277 LITATOM 211 BITMAP 202 \DISPLAYDATA 138 \DISPLAYDATA 112 \DISPLAYDATA 95 \DISPLAYDATA 86 \DISPLAYDATA 77 \DISPLAYDATA 68 \DISPLAYDATA 57 \DISPLAYDATA 45 \DISPLAYDATA 17 \TOPWDS 8 STREAM)
()
\BLTSHADE.BITMAP :D8
(L (7 CLIPPINGREGION 6 OPERATION 5 HEIGHT 4 WIDTH 3 DESTINATIONBOTTOM 2 DESTINATIONLEFT 1 DESTINATIONBITMAP 0 TEXTURE) P 10 \INTERRUPTABLE) ú   jXdYAÈZAÈ[AÈ\dkð‘h¼G²IHG½dMñ¡¿M¸IG¾dNñ¡¿N¹KGGØ_¿dOñ’¿O»JGGØ_¿dOñ’¿OºB£jb¿C£jb¿BdHñ¡¿H¸CdIñ¡¿I¹D™BDØdKñ‘¿K»E™CEØdJñ‘¿JºKHñ´JIñ¡h@ dgð¨dgð²{¿L²q@µ L ŽLi µ@ bLµ‚±ù
@@ -423,11 +425,11 @@ Q
(145 ERASE 138 INVERT 121 INVERT 110 PAINT 99 ERASE 86 \DISPLAYDATA 77 \DISPLAYDATA 53 INVERT 43 INPUT 32 \DISPLAYDATA 23 \DISPLAYDATA 16 STREAM 5 OUTPUT)
()
DSPXOFFSET :D8
(P 0 A0463 I 1 DISPLAYSTREAM I 0 XOFFSET) 'Agh bÉ.É\@AlH(11 \GETSTREAM)
(P 0 A0244 I 1 DISPLAYSTREAM I 0 XOFFSET) 'Agh bÉ.É\@AlH(11 \GETSTREAM)
(25 IMAGEOPS 18 STREAM 5 OUTPUT)
()
DSPYOFFSET :D8
(P 0 A0464 I 1 DISPLAYSTREAM I 0 YOFFSET) 'Agh bÉ.É^@AlH(11 \GETSTREAM)
(P 0 A0245 I 1 DISPLAYSTREAM I 0 YOFFSET) 'Agh bÉ.É^@AlH(11 \GETSTREAM)
(25 IMAGEOPS 18 STREAM 5 OUTPUT)
()
DSPDESTINATION :D8
@@ -581,8 +583,8 @@ DSPSCROLL :D8
(45 OFF 36 OFF 23 \DISPLAYDATA 16 STREAM 5 OUTPUT)
()
PAGEHEIGHT :D8
(L (0 N) F 0 \#DISPLAYLINES) P@3š@c¿j¿NIL
(14 \CURRENTDISPLAYLINE)
(L (0 N) F 0 \#DISPLAYLINES F 1 \CURRENTDISPLAYLINE) P@3—@c¿jc¿NIL
NIL
()
(RPAQ? \CURRENTTTYDEVICE (QUOTE BCPLDISPLAY))
\DSPRESET.DISPLAY :D8
@@ -631,20 +633,20 @@ expand-\MAYBE-DRIBBLE-CHAR :D8
(543 STREAM 537 STREAM 511 STREAM 505 STREAM 400 \MACHINETYPE 378 STREAM 372 STREAM 268 STREAM 262 STREAM 195 STREAM 189 STREAM 113 STREAM 107 STREAM 63 CHARTABLE 53 CHARTABLE 10 \CARET.UP)
( 421 ((880 . 2500)))
\DSPPRINTCR/LF :D8
(P 15 SOFTCURSORUP P 14 DISPINTERRUPT P 13 KEPTWIDTH P 12 HGHT P 11 DBITMAP P 10 BKGRND P 9 WDTH P 8 LFT P 7 X P 6 CLIPREG P 5 FONT P 4 ROTATION P 3 Y P 2 AMOUNT/BELOW P 1 BTM P 0 DD I 1 DISPLAY-STREAM I 0 CHARCODE F 16 \SOFTCURSORUPP F 17 \CURSORDESTINATION F 18 \SCREENBITMAPS F 19 \TERM.OFD) ÙAdW&𲿿`–A ¿AÉ0QHÉ¢±NHÉ È \jð’±8HÉ
(P 15 SOFTCURSORUP P 14 DISPINTERRUPT P 13 KEPTWIDTH P 12 HGHT P 11 DBITMAP P 10 BKGRND P 9 WDTH P 8 LFT P 7 X P 6 CLIPREG P 5 FONT P 4 ROTATION P 3 Y P 2 AMOUNT/BELOW P 1 BTM P 0 DD I 1 DISPLAY-STREAM I 0 CHARCODE F 16 \SOFTCURSORP F 17 \SCREENBITMAPS F 18 \SOFTCURSORUPP F 19 \CURSORDESTINATION F 20 \TERM.OFD) ÓAdW(𲿿`–A ¿AÉ0QHÉ¢±KHÉ È \jð’±5HÉ
@l ð²AHÉ2[•AkK¿LdlZð•¿N°nðœNNØmÿ؉o A
¿HÉLdlZð—¿jHÉÙ°nð“Hɉo Ø_¿HÉ¢±¨LdlZð²,¿OHÉØHÈ#HÉ È ÙÙZjñ°5nð²*HÈ"HÉ È ØOHÉØÙZjñ„¢±@` HÈ"_¿HÉ_¿HÈ$¹HÈ%IÙ_¿HÈ#OÙ_¿HÉ6_¿ `²-W ´ hA
W"ð_²`È_¿`jÍ¿¿A`ð³hA
W$–A ¿JOñ›hjdOOIO°eLlZð²3OOJØIOOIOJÙ_Ogg
¿HÉLdlZð—¿jHÉÙ°nð“Hɉo Ø_¿HÉ¢±¥LdlZð²,¿OHÉØHÈ#HÉ È ÙÙZjñ°5nð²*HÈ"HÉ È ØOHÉØÙZjñ„¢±=` HÈ"_¿HÉ_¿HÈ$¹HÈ%IÙ_¿HÈ#OÙ_¿HÉ6_¿ W ²-W$´ hA
W&ð_²`È_¿`jÍ¿¿A`ð³hA
W"–A ¿JOñ›hjdOOIO°eLlZð²3OOJØIOOIOJÙ_Ogg
¿hjdOOOØ°,OOIOOJØIOJÙOgg
¿hjdOOIJOggO ¿OŸ¿`OÍ¿LlZð”OJÙƒOJØ_<0E>OA
±\@l ð²HÉ2[•AkK¿HÉA
¿HÉHÉØ»HÉ¢±!HÈ$YHÉ È ØKHÉØÙZjñ¢±öP HÈ"_¿HÉ_¿HÈ%IÙ_¿HÈ#OÙ_¿HÉ6_¿ `²-W ´ hA
W"ð_²`È_¿`jÍ¿¿A`ð³hA
W$–A ¿JOñ<>hjdOOIOO°0OOIOOIJØOOJÙgg
±Y@l ð²HÉ2[•AkK¿HÉA
¿HÉHÉØ»HÉ¢±HÈ$YHÉ È ØKHÉØÙZjñ¢±óP HÈ"_¿HÉ_¿HÈ%IÙ_¿HÈ#OÙ_¿HÉ6_¿ W ²-W$´ hA
W&ð_²`È_¿`jÍ¿¿A`ð³hA
W"–A ¿JOñ<>hjdOOIOO°0OOIOOIJØOOJÙgg
¿hjdOOIOJggO ¿OŸ¿`OÍ¿KJØ[€KA
h(981 DSPYPOSITION 956 \SOFTCURSORUPCURRENT 947 BKBITBLT 917 BKBITBLT 863 \TOTOPWDS 853 DSPDESTINATION 836 \SOFTCURSORDOWN 805 DSPDESTINATION 667 DSPXPOSITION 632 DSPXPOSITION 594 \SOFTCURSORUPCURRENT 585 BKBITBLT 555 BKBITBLT 508 BKBITBLT 448 \TOTOPWDS 438 DSPDESTINATION 421 \SOFTCURSORDOWN 390 DSPDESTINATION 303 SHOULDNT 187 ERROR 145 DSPYPOSITION 139 ERROR 25 \CARET.DOWN 12 \STOPSCROLL?)
(962 \EM.DISPINTERRUPT 939 REPLACE 934 TEXTURE 911 REPLACE 906 INPUT 843 \TOPWDS 827 \EM.DISPINTERRUPT 817 \EM.DISPINTERRUPT 792 \SOFTCURSORP 770 \DISPLAYDATA 751 \DISPLAYDATA 740 \DISPLAYDATA 720 \DISPLAYDATA 710 FONTDESCRIPTOR 703 \DISPLAYDATA 694 \DISPLAYDATA 682 \DISPLAYDATA 648 \DISPLAYDATA 600 \EM.DISPINTERRUPT 577 REPLACE 572 TEXTURE 549 REPLACE 544 INPUT 502 REPLACE 497 INPUT 428 \TOPWDS 412 \EM.DISPINTERRUPT 402 \EM.DISPINTERRUPT 377 \SOFTCURSORP 355 \DISPLAYDATA 338 \DISPLAYDATA 327 \DISPLAYDATA 316 \DISPLAYDATA 290 \DISPLAYDATA 279 FONTDESCRIPTOR 272 \DISPLAYDATA 264 \DISPLAYDATA 243 FONTDESCRIPTOR 236 \DISPLAYDATA 228 \DISPLAYDATA 219 \DISPLAYDATA 197 \DISPLAYDATA 152 \DISPLAYDATA 89 \DISPLAYDATA 62 FONTDESCRIPTOR 55 \DISPLAYDATA 43 \DISPLAYDATA 32 STREAM 18 \CARET.UP)
h(975 DSPYPOSITION 950 \SOFTCURSORUPCURRENT 941 BKBITBLT 911 BKBITBLT 857 \TOTOPWDS 847 DSPDESTINATION 830 \SOFTCURSORDOWN 799 DSPDESTINATION 664 DSPXPOSITION 629 DSPXPOSITION 591 \SOFTCURSORUPCURRENT 582 BKBITBLT 552 BKBITBLT 505 BKBITBLT 445 \TOTOPWDS 435 DSPDESTINATION 418 \SOFTCURSORDOWN 387 DSPDESTINATION 303 SHOULDNT 187 ERROR 145 DSPYPOSITION 139 ERROR 25 \CARET.DOWN 12 \STOPSCROLL?)
(956 \EM.DISPINTERRUPT 933 REPLACE 928 TEXTURE 905 REPLACE 900 INPUT 837 \TOPWDS 821 \EM.DISPINTERRUPT 811 \EM.DISPINTERRUPT 767 \DISPLAYDATA 748 \DISPLAYDATA 737 \DISPLAYDATA 717 \DISPLAYDATA 707 FONTDESCRIPTOR 700 \DISPLAYDATA 691 \DISPLAYDATA 679 \DISPLAYDATA 645 \DISPLAYDATA 597 \EM.DISPINTERRUPT 574 REPLACE 569 TEXTURE 546 REPLACE 541 INPUT 499 REPLACE 494 INPUT 425 \TOPWDS 409 \EM.DISPINTERRUPT 399 \EM.DISPINTERRUPT 355 \DISPLAYDATA 338 \DISPLAYDATA 327 \DISPLAYDATA 316 \DISPLAYDATA 290 \DISPLAYDATA 279 FONTDESCRIPTOR 272 \DISPLAYDATA 264 \DISPLAYDATA 243 FONTDESCRIPTOR 236 \DISPLAYDATA 228 \DISPLAYDATA 219 \DISPLAYDATA 197 \DISPLAYDATA 152 \DISPLAYDATA 89 \DISPLAYDATA 62 FONTDESCRIPTOR 55 \DISPLAYDATA 43 \DISPLAYDATA 32 STREAM 18 \CARET.UP)
( 182 "Only rotations supported are 0, 90 and 270" 134 "Only rotations supported are 0, 90 and 270")
\TTYBACKGROUND :D8
(P 0 X F 1 \LINEBUF.OFD) DQÉ`ð²/`²``ð¥¿`ŠdjHµô(65 \BACKGROUND 39 WAIT.FOR.TTY)
@@ -758,11 +760,11 @@ Z`S
(167 \LastTTYLines 155 SCREENHEIGHT 148 SCREENHEIGHT 133 SCREENWIDTH 115 SCREENWIDTH 91 FONTDESCRIPTOR 76 SCREENHEIGHT 62 \LastTTYLines 52 \TopLevelTtyWindow 47 \DEFAULTTTYDISPLAYSTREAM 35 ScreenBitMap 27 FONTDESCRIPTOR)
()
\STARTDISPLAY :D8
(P 2 \INTERRUPTABLE P 1 W P 0 OLDWINDOWS F 3 \MAINSCREEN F 4 \WINDOWWORLD F 5 \CURSORDESTINATION F 6 \CURSORDESTRASTERWIDTH F 7 \CURSORDESTWIDTH F 8 \CURSORDESTHEIGHT) @``ðœ``ð³AT²> ¸``ó«``ó–H ¿HŒdI µò``
(P 2 \INTERRUPTABLE P 1 W P 0 OLDWINDOWS F 3 \MAINSCREEN F 4 \WINDOWWORLD F 5 \CURSORDESTINATION F 6 WINDOWBACKGROUNDSHADE F 7 \CURSORDESTWIDTH F 8 \CURSORDESTHEIGHT F 9 \CURSORDESTRASTERWIDTH) <``ðœ``ð³AT²> ¸``ó«``ó–H ¿HŒdI µò``
É`È
¿ijd``hSµ;`c
`c`c`Èc H²P` ¿H °:`¿S`¿S`¿°ždI µò``h(291 \OPENW1 235 REVERSE 228 CHANGEBACKGROUND 142 SHOWDISPLAY 113 \CreateScreenBitMap 90 \CLOSEW1 76 \MOVE.WINDOWS.ONTO.SCREEN 45 REVERSE 40 OPENWINDOWS 7 UPDATESCREENDIMENSIONS)
(316 \OLDSCREENWIDTH 311 SCREENWIDTH 306 \OLDSCREENHEIGHT 301 SCREENHEIGHT 275 SCREENHEIGHT 270 SCREEN 261 SCREENWIDTH 256 SCREEN 247 ScreenBitMap 242 SCREEN 223 WINDOWBACKGROUNDSHADE 211 BITMAP 206 ScreenBitMap 199 SCREENHEIGHT 192 SCREENWIDTH 185 ScreenBitMap 177 WHOLESCREEN 172 WHOLEDISPLAY 162 SCREENHEIGHT 157 SCREENWIDTH 149 \DisplayStarted 135 BITMAP 130 ScreenBitMap 123 BITMAP 118 ScreenBitMap 108 SCREENHEIGHT 103 SCREENWIDTH 68 SCREENHEIGHT 63 \OLDSCREENHEIGHT 56 SCREENWIDTH 51 \OLDSCREENWIDTH 29 \OLDSCREENHEIGHT 24 SCREENHEIGHT 17 \OLDSCREENWIDTH 12 SCREENWIDTH)
¿ijd``hSµ7`c
`c`c`ÈcH²LV ¿H °:`¿S`¿S`¿°¢dI µò``h(287 \OPENW1 231 REVERSE 224 CHANGEBACKGROUND 142 SHOWDISPLAY 113 \CreateScreenBitMap 90 \CLOSEW1 76 \MOVE.WINDOWS.ONTO.SCREEN 45 REVERSE 40 OPENWINDOWS 7 UPDATESCREENDIMENSIONS)
(312 \OLDSCREENWIDTH 307 SCREENWIDTH 302 \OLDSCREENHEIGHT 297 SCREENHEIGHT 271 SCREENHEIGHT 266 SCREEN 257 SCREENWIDTH 252 SCREEN 243 ScreenBitMap 238 SCREEN 211 BITMAP 206 ScreenBitMap 199 SCREENHEIGHT 192 SCREENWIDTH 185 ScreenBitMap 177 WHOLESCREEN 172 WHOLEDISPLAY 162 SCREENHEIGHT 157 SCREENWIDTH 149 \DisplayStarted 135 BITMAP 130 ScreenBitMap 123 BITMAP 118 ScreenBitMap 108 SCREENHEIGHT 103 SCREENWIDTH 68 SCREENHEIGHT 63 \OLDSCREENHEIGHT 56 SCREENWIDTH 51 \OLDSCREENWIDTH 29 \OLDSCREENHEIGHT 24 SCREENHEIGHT 17 \OLDSCREENWIDTH 12 SCREENWIDTH)
()
\MOVE.WINDOWS.ONTO.SCREEN :D8
(P 4 REG P 3 YFACTOR P 2 XFACTOR P 1 W I 0 WINDOWS) Ú@Hµ+h´&```ëZ``ë[@HµAhYÉLLØmÿØ`óµLLØmÿØ`ó•Iµ¥i°¢HX°™Yd ð²\Ii
@@ -794,6 +796,4 @@ hdg cgkPh
(INITIALIZEDISPLAYSTREAMS)
(DISPLAYSTREAMINIT 1000)
(PUTPROPS LLDISPLAY FILETYPE COMPILE-FILE)
(PUTPROPS LLDISPLAY COPYRIGHT ("Venue & Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1988
1989 1990 1993 1994 2021))
NIL

27
sources/MEDLEYDIR
View File

@@ -1,11 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "17-Jul-2023 16:13:10" {DSK}<home>frank>il>medley>gmedley>sources>MEDLEYDIR.;2 9970
(FILECREATED "19-Jul-2023 08:57:43" {WMEDLEY}<sources>MEDLEYDIR.;22 10362
:CHANGES-TO (VARS MEDLEY-INIT-VARS)
:EDIT-BY rmk
:PREVIOUS-DATE "22-Apr-2023 11:53:53" {DSK}<home>frank>il>medley>gmedley>sources>MEDLEYDIR.;1
)
:CHANGES-TO (FNS MEDLEYDIR)
:PREVIOUS-DATE "17-Jul-2023 16:13:10" {WMEDLEY}<sources>MEDLEYDIR.;21)
(PRETTYCOMPRINT MEDLEYDIRCOMS)
@@ -95,16 +96,22 @@
NIL])
(MEDLEYDIR
[LAMBDA (DIRNAME FILENAME OUTPUT NOERROR) (* ; "Edited 18-Oct-2022 17:49 by lmm")
[LAMBDA (DIRNAME FILENAME OUTPUT NOERROR) (* ; "Edited 29-Jun-2023 22:48 by rmk")
(* ; "Edited 18-Oct-2022 17:49 by lmm")
(* ; "Edited 5-Mar-2022 12:43 by larry")
(* ; "Edited 2-Dec-2021 20:23 by kaplan")
(* ;; "RMK: MEDLEYDIR defaults to DSK")
(COND
((NULL DIRNAME)
(if (OR (NOT (BOUNDP 'MEDLEYDIR))
(NOT MEDLEYDIR))
then (OR (SETQ MEDLEYDIR (DIRECTORYNAME (OR (UNIX-GETENV "MEDLEYDIR")
T)))
(DIRECTORYNAME T))
then [SETQ MEDLEYDIR (DIRECTORYNAME (if (SETQ MEDLEYDIR (UNIX-GETENV "MEDLEYDIR"))
then (DIRECTORYNAME (PACKFILENAME 'BODY MEDLEYDIR
'HOST
'DSK))
else (DIRECTORYNAME T]
elseif (STRPOS "/" MEDLEYDIR)
then (SETQ MEDLEYDIR (DIRECTORYNAME MEDLEYDIR))
else MEDLEYDIR))
@@ -199,6 +206,6 @@
(ADDTOVAR GLOBALVARS MEDLEYDIR MEDLEY-INIT-VARS \SAVE.MEDLEYDIR DIRECTORIES)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1469 7896 (MEDLEY-INIT-VARS 1479 . 4957) (MEDLEYDIR 4959 . 6914) (MEDLEYSUBSTDIR 6916
. 7894)))))
(FILEMAP (NIL (1432 8288 (MEDLEY-INIT-VARS 1442 . 4920) (MEDLEYDIR 4922 . 7306) (MEDLEYSUBSTDIR 7308
. 8286)))))
STOP

BIN
sources/MEDLEYDIR.LCOM
View File

Binary file not shown.

51
sources/PRINTFN
View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "19-Jun-2022 00:02:19" 
{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>PRINTFN.;34 13484
(FILECREATED "14-Sep-2023 22:53:09" {WMEDLEY}<sources>PRINTFN.;35 13520
:CHANGES-TO (FNS PFCOPYBYTES)
:EDIT-BY rmk
:PREVIOUS-DATE "15-Mar-2022 00:20:04"
{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>PRINTFN.;33)
:CHANGES-TO (FNS PF)
:PREVIOUS-DATE "19-Jun-2022 00:02:19" {WMEDLEY}<sources>PRINTFN.;34)
(* ; "
@@ -31,50 +31,51 @@ Copyright (c) 1986-1987, 1990, 1999, 2018, 2021 by Venue & Xerox Corporation.
(DEFINEQ
(PF
[NLAMBDA FN (* ; "Edited 4-Apr-2018 11:13 by rmk:")
[NLAMBDA FN (* ; "Edited 14-Sep-2023 22:52 by rmk")
(* ; "Edited 4-Apr-2018 11:13 by rmk:")
(* ;; "RMK; Fixed to skip compiled files, also to use FUNCTIONS as well as FNS. That might not help, if FUNCTIONS are not included in the filemap.")
(* ;; "RMK; Fixed to skip compiled files, also to use FUNCTIONS as well as FNS. That might not help, if FUNCTIONS are not included in the filemap.")
(* ;; "Print from files known to masterscope database before looking at whereis database. Note, however, that it also prefers the masterscope database to incore files")
(* ;; "Print from files known to masterscope database before looking at whereis database. Note, however, that it also prefers the masterscope database to incore files")
(* ;; "If FN is NIL, prints the function named by LASTWORD")
(* ;; "If FN is NIL, prints the function named by LASTWORD")
(* ;; "If FN is a list, then extra args are interpreted as:")
(* ;; "If FN is a list, then extra args are interpreted as:")
(* ;; " OUTPUT FILE")
(* ;; " OUTPUT FILE")
(* ;; "...")
(* ;; "...")
(RESETLST
(PROG (OUT OTHERARGS IFILES)
(SETQ FN (NLAMBDA.ARGS FN)) (* ; "Grab the args as a list")
(SETQ FN (NLAMBDA.ARGS FN)) (* ; "Grab the args as a list")
[COND
((LISTP FN) (* ;
 "If it's a list, take the first element as the function name.")
((LISTP FN) (* ;
 "If it's a list, take the first element as the function name.")
(SETQ OTHERARGS (CDR FN))
(SETQ FN (CAR FN]
(COND
(FN (* ; "FN name specified; use it.")
(FN (* ; "FN name specified; use it.")
(SETQ LASTWORD FN))
(T (* ; "Not specified, use LASTWORD")
(T (* ; "Not specified, use LASTWORD")
(SETQ FN LASTWORD)))
[SETQ IFILES (OR (CAR OTHERARGS)
(APPEND (WHEREIS FN 'FNS T)
(WHEREIS FN 'FUNCTIONS T]
[RESETSAVE (OUTPUT (COND
((CADR OTHERARGS) (* ;
 "An output file was specified; if not open for output, open it.")
((CADR OTHERARGS) (* ;
 "An output file was specified; if not open for output, open it.")
(OR (OPENP (CADR OTHERARGS)
'OUTPUT)
(WINDOWP (CADR OTHERARGS))
(PROGN [RESETSAVE (SETQ OUT (OPENFILE (CADR OTHERARGS)
(PROGN [RESETSAVE (SETQ OUT (OPENSTREAM (CADR OTHERARGS)
'OUTPUT))
'(PROGN (CLOSEF? OLDVALUE]
OUT)))
(T (* ; "otherwise, use primary output.")
T] (* ; "skip compiled files")
(T (* ; "otherwise, use primary output.")
T] (* ; "skip compiled files")
(FOR FILE INSIDE IFILES UNLESS (MEMB (FILENAMEFIELD FILE 'EXTENSION)
*COMPILED-EXTENSIONS*)
*COMPILED-EXTENSIONS*)
DO (PRINTFN FN FILE))))])
(PF*
@@ -288,6 +289,6 @@ Copyright (c) 1986-1987, 1990, 1999, 2018, 2021 by Venue & Xerox Corporation.
)
(PUTPROPS PRINTFN COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1990 1999 2018 2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1115 11618 (PF 1125 . 3820) (PF* 3822 . 4116) (PRINTFN 4118 . 4688) (PRINTFNDEF 4690 .
5873) (FINDFNDEF 5875 . 7247) (PFCOPYBYTES 7249 . 11368) (DISPLAYP 11370 . 11616)))))
(FILEMAP (NIL (1044 11654 (PF 1054 . 3856) (PF* 3858 . 4152) (PRINTFN 4154 . 4724) (PRINTFNDEF 4726 .
5909) (FINDFNDEF 5911 . 7283) (PFCOPYBYTES 7285 . 11404) (DISPLAYP 11406 . 11652)))))
STOP

BIN
sources/PRINTFN.LCOM
View File

Binary file not shown.

85
sources/UFS
View File

@@ -1,14 +1,13 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "29-Mar-2022 11:29:33" {DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>UFS.;32 78036
(FILECREATED "16-Sep-2023 09:22:55" {DSK}<Users>briggs>Projects>medley>sources>UFS.;2 78813
:PREVIOUS-DATE "28-Mar-2022 22:09:43"
{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>UFS.;31)
:EDIT-BY "briggs"
:CHANGES-TO (FNS \UFSCloseFile)
:PREVIOUS-DATE "29-Mar-2022 11:29:33" {DSK}<Users>briggs>Projects>medley>sources>UFS.;1)
(* ; "
Copyright (c) 1988-1995, 2000, 2021-2022 by Venue & Xerox Corporation.
")
(PRETTYCOMPRINT UFSCOMS)
@@ -291,8 +290,38 @@ Copyright (c) 1988-1995, 2000, 2021-2022 by Venue & Xerox Corporation.
)
(\UFSCloseFile
(LAMBDA (STREAMFILE) (* ; "Edited 30-Mar-90 10:39 by nm") (* ; "return stream") (* ;;; "Closes the specified stream.") (* * WITH.MONITOR \UFStopMonitor) (* ;;; "Write out and dispense with buffers for this stream.") (\CLEARMAP STREAMFILE) (PROG ((DEVICE (fetch (STREAM DEVICE) of STREAMFILE)) (CDATE 0) (ERRNO (CREATECELL \FIXP)) (UNIXNAME (fetch (UFSSTREAM UNIXNAME) of STREAMFILE))) (if (NULL UNIXNAME) then (* ; "Already closed! Somebody's trying to close us twice.") (RETURN NIL)) (if (DIRTYABLE STREAMFILE) then (* ; "Open for output") (FDEVOP (QUOTE TRUNCATEFILE) DEVICE STREAMFILE) (SETQ CDATE (fetch (UFSSTREAM CDATE) of STREAMFILE))) (RETURN (if (\UFSCloseFile-C UNIXNAME (fetch (UFSSTREAM FILEID) of STREAMFILE) CDATE ERRNO) then (replace (UFSSTREAM FILEID) of STREAMFILE with NIL) (replace (UFSSTREAM CDATE) of STREAMFILE with NIL) (* ; "Clear open-file state") STREAMFILE else (\UFSError (fetch (STREAM FULLFILENAME) of STREAMFILE) ERRNO)))))
)
[LAMBDA (STREAMFILE) (* ; "Edited 16-Sep-2023 09:21 by briggs")
(* ; "Edited 30-Mar-90 10:39 by nm")
(* ; "return stream")
(* ;;; "Closes the specified stream.")
(* * WITH.MONITOR \UFStopMonitor)
(* ;;; "Write out and dispense with buffers for this stream.")
(\CLEARMAP STREAMFILE)
(PROG ((DEVICE (fetch (STREAM DEVICE) of STREAMFILE))
(CDATE 0)
(ERRNO (CREATECELL \FIXP))
(UNIXNAME (fetch (UFSSTREAM UNIXNAME) of STREAMFILE)))
(if (OR (NULL UNIXNAME)
(NULL (fetch (STREAM ACCESS) of STREAMFILE)))
then (* ;
 "Already closed! Somebody's trying to close us twice.")
(RETURN NIL))
(if (DIRTYABLE STREAMFILE)
then (* ; "Open for output")
(FDEVOP 'TRUNCATEFILE DEVICE STREAMFILE)
(SETQ CDATE (fetch (UFSSTREAM CDATE) of STREAMFILE)))
(RETURN (if (\UFSCloseFile-C UNIXNAME (fetch (UFSSTREAM FILEID) of STREAMFILE)
CDATE ERRNO)
then (replace (UFSSTREAM FILEID) of STREAMFILE with NIL)
(replace (UFSSTREAM CDATE) of STREAMFILE with NIL)
(* ; "Clear open-file state")
STREAMFILE
else (\UFSError (fetch (STREAM FULLFILENAME) of STREAMFILE)
ERRNO])
(\UFSGetFileName
(LAMBDA (FILENAME RECOG DEV) (* ; "Edited 24-Feb-89 16:20 by bvm") (* ;; "Recognize filename, return full name") (\UFS.FULLNAME (\UFS.RECOGNIZE.FILE FILENAME RECOG DEV) DEV T))
@@ -1126,26 +1155,24 @@ update the map") (SETQ PAGES (RESTOREMAP STREAM))) (DELETED (* ; "the file disap
(ADDTOVAR LAMA )
)
(PUTPROPS UFS COPYRIGHT ("Venue & Xerox Corporation" 1988 1989 1990 1991 1992 1993 1994 1995 2000 2021
2022))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (8950 10503 (\UFSCreateDevice 8960 . 9325) (\UFS.CREATE.DEVICE 9327 . 10183) (
\UFSOpenDevice 10185 . 10362) (\UFSCloseDevice 10364 . 10501)) (14766 50339 (\UFSOpenFile 14776 .
18070) (\UFS.OPENP 18072 . 18569) (\UFS.RECOGNIZE.FILE 18571 . 19324) (\UFS.DIRECTORY.NAME 19326 .
20069) (\UFSCloseFile 20071 . 21047) (\UFSGetFileName 21049 . 21248) (\UFSDeleteFile 21250 . 21790) (
\UFSRenameFile 21792 . 22957) (\UFSReadPages 22959 . 24094) (\UFSWritePages 24096 . 25316) (
\UFSTruncateFile 25318 . 26815) (\UFSDirectoryNameP 26817 . 27871) (\UFSEventFn 27873 . 28535) (
\UFSGetFileInfo 28537 . 30819) (\UFS.CREATE.PROPS 30821 . 31174) (\UFSSetFileInfo 31176 . 32405) (
\UFSGenerateFiles 32407 . 39287) (\UFS.NEXTFILEFN 39289 . 46927) (\UFS.FILEINFOFN 46929 . 48378) (
\UFS.VALID.PROPP 48380 . 48672) (\UFS.REGISTER.GFS 48674 . 48929) (\UFS.UNREGISTER.GFS 48931 . 49514)
(\UFS.ABORT.DIRECTORY 49516 . 49864) (\UFS.ABORT.CL-DIRECTORY 49866 . 50153) (\UFS.CLEANUP.GFS.TABLE
50155 . 50337)) (50374 57058 (\UFSMakeUnixFormatName 50384 . 51405) (\UFSParseNameString 51407 . 51781
) (\UFSParse-Directory 51783 . 52324) (\UFS.PARSE.BODY 52326 . 52871) (\UFS.ADJUST.HOST 52873 . 53032)
(\UFS.FULLNAME 53034 . 54242) (\UFS.ADD.HOST.FIELD 54244 . 54604) (\UFS.REMOVE.HOST.FIELD 54606 .
56276) (\UFS.HANDLE.RELATIVEDIRECTORY 56278 . 57056)) (57874 58487 (CHDIR 57884 . 58485)) (58559 59545
(\DEVICEFILE.EOSERROR 58569 . 59543)) (59618 60855 (\UNVISIBLE.PAGED.REVALIDATEFILELST 59628 . 60473)
(\UNVISIBLE.FLUSH.OPEN.STREAMS 60475 . 60853)) (60888 62514 (\UFSError 60898 . 62512)) (62558 64973 (
\UFSGetFileType 62568 . 63169) (\UFSSetFileType 63171 . 63768) (\UFSeol 63770 . 64971)) (73620 74744 (
\UFSGetPrintFileType 73630 . 74042) (\UFSGetFileTypeConfirm 74044 . 74492) (\UFSPrintTypeMenu 74494 .
74742)) (74774 77612 (\UFStoOtherCopyMess 74784 . 76462) (\UFStoOtherRenameMess 76464 . 77610)))))
(FILEMAP (NIL (8909 10462 (\UFSCreateDevice 8919 . 9284) (\UFS.CREATE.DEVICE 9286 . 10142) (
\UFSOpenDevice 10144 . 10321) (\UFSCloseDevice 10323 . 10460)) (14725 51227 (\UFSOpenFile 14735 .
18029) (\UFS.OPENP 18031 . 18528) (\UFS.RECOGNIZE.FILE 18530 . 19283) (\UFS.DIRECTORY.NAME 19285 .
20028) (\UFSCloseFile 20030 . 21935) (\UFSGetFileName 21937 . 22136) (\UFSDeleteFile 22138 . 22678) (
\UFSRenameFile 22680 . 23845) (\UFSReadPages 23847 . 24982) (\UFSWritePages 24984 . 26204) (
\UFSTruncateFile 26206 . 27703) (\UFSDirectoryNameP 27705 . 28759) (\UFSEventFn 28761 . 29423) (
\UFSGetFileInfo 29425 . 31707) (\UFS.CREATE.PROPS 31709 . 32062) (\UFSSetFileInfo 32064 . 33293) (
\UFSGenerateFiles 33295 . 40175) (\UFS.NEXTFILEFN 40177 . 47815) (\UFS.FILEINFOFN 47817 . 49266) (
\UFS.VALID.PROPP 49268 . 49560) (\UFS.REGISTER.GFS 49562 . 49817) (\UFS.UNREGISTER.GFS 49819 . 50402)
(\UFS.ABORT.DIRECTORY 50404 . 50752) (\UFS.ABORT.CL-DIRECTORY 50754 . 51041) (\UFS.CLEANUP.GFS.TABLE
51043 . 51225)) (51262 57946 (\UFSMakeUnixFormatName 51272 . 52293) (\UFSParseNameString 52295 . 52669
) (\UFSParse-Directory 52671 . 53212) (\UFS.PARSE.BODY 53214 . 53759) (\UFS.ADJUST.HOST 53761 . 53920)
(\UFS.FULLNAME 53922 . 55130) (\UFS.ADD.HOST.FIELD 55132 . 55492) (\UFS.REMOVE.HOST.FIELD 55494 .
57164) (\UFS.HANDLE.RELATIVEDIRECTORY 57166 . 57944)) (58762 59375 (CHDIR 58772 . 59373)) (59447 60433
(\DEVICEFILE.EOSERROR 59457 . 60431)) (60506 61743 (\UNVISIBLE.PAGED.REVALIDATEFILELST 60516 . 61361)
(\UNVISIBLE.FLUSH.OPEN.STREAMS 61363 . 61741)) (61776 63402 (\UFSError 61786 . 63400)) (63446 65861 (
\UFSGetFileType 63456 . 64057) (\UFSSetFileType 64059 . 64656) (\UFSeol 64658 . 65859)) (74508 75632 (
\UFSGetPrintFileType 74518 . 74930) (\UFSGetFileTypeConfirm 74932 . 75380) (\UFSPrintTypeMenu 75382 .
75630)) (75662 78500 (\UFStoOtherCopyMess 75672 . 77350) (\UFStoOtherRenameMess 77352 . 78498)))))
STOP

BIN
sources/UFS.LCOM
View File

Binary file not shown.