Compare commits
13 Commits
medley-211
...
medley-211
| Author | SHA1 | Date | |
|---|---|---|---|
|
ca069578c3 | ||
|
|
23731b05d1 | ||
|
ab4800054e | ||
|
|
b1634ef140 | ||
|
76a2235636 | ||
|
|
7c65b47fba | ||
|
|
a315e6926f | ||
|
|
c3a497d8f3 | ||
|
|
9cf54a1687 | ||
|
|
5490abb143 | ||
|
|
18f5da85fd | ||
|
|
01de5a2324 | ||
|
|
1c9c1da257 |
50
.github/workflows/buildDocker.yml
vendored
50
.github/workflows/buildDocker.yml
vendored
@@ -7,10 +7,6 @@ name: Build Medley Docker image
|
||||
on:
|
||||
workflow_dispatch:
|
||||
|
||||
# push:
|
||||
# branches:
|
||||
# - master
|
||||
|
||||
# Jobs that compose this workflow
|
||||
jobs:
|
||||
# Job to build the docker image
|
||||
@@ -21,27 +17,34 @@ jobs:
|
||||
- name: Checkout
|
||||
uses: actions/checkout@v2
|
||||
|
||||
# Get the Medley Release Information
|
||||
- name: Get Medley Release Information
|
||||
id: medley_version
|
||||
uses: abatilo/release-info-action@v1.3.0
|
||||
with:
|
||||
owner: Interlisp
|
||||
repo: medley
|
||||
|
||||
# Get the Maiko Release Information
|
||||
- name: Get Maiko Release Information
|
||||
id: maiko_version
|
||||
uses: abatilo/release-info-action@v1.3.0
|
||||
with:
|
||||
owner: Interlisp
|
||||
repo: maiko
|
||||
|
||||
# Setup needed environment variables
|
||||
- name: Prepare
|
||||
id: prep
|
||||
run: |
|
||||
DOCKER_IMAGE=interlisp/${GITHUB_REPOSITORY#*/}
|
||||
DOCKERHUB_ACCOUNT=interlisp
|
||||
DOCKER_IMAGE=${DOCKERHUB_ACCOUNT}/${GITHUB_REPOSITORY#*/}
|
||||
VERSION=latest
|
||||
SHORTREF=${GITHUB_SHA::8}
|
||||
|
||||
# If this is git tag, use the tag name as a docker tag
|
||||
if [[ $GITHUB_REF == refs/tags/* ]]; then
|
||||
VERSION=${GITHUB_REF#refs/tags/}
|
||||
fi
|
||||
TAGS="${DOCKER_IMAGE}:${VERSION},${DOCKER_IMAGE}:${SHORTREF}"
|
||||
|
||||
# If the VERSION looks like medley followed by a date, assume that
|
||||
# this is the most recent version of the image and also
|
||||
# tag it 'latest'.
|
||||
if [[ $VERSION =~ ^medley-[0-9]{1,6}.$ ]]; then
|
||||
TAGS="$TAGS,${DOCKER_IMAGE}:latest"
|
||||
fi
|
||||
MAIKO_RELEASE=${{ steps.maiko_version.outputs.latest_tag }}
|
||||
MEDLEY_RELEASE=${{ steps.medley_version.outputs.latest_tag }}
|
||||
|
||||
TAGS="${DOCKER_IMAGE}:${MEDLEY_RELEASE},${DOCKER_IMAGE}:${VERSION},${DOCKER_IMAGE}:${MAIKO_RELEASE}"
|
||||
|
||||
# Set output parameters.
|
||||
echo ::set-output name=tags::${TAGS}
|
||||
echo ::set-output name=docker_image::${DOCKER_IMAGE}
|
||||
@@ -57,6 +60,15 @@ jobs:
|
||||
latest: true
|
||||
fileName: "*"
|
||||
|
||||
# Download Maiko Release Assets
|
||||
- name: Download Release Assets
|
||||
uses: robinraju/release-downloader@v1.2
|
||||
with:
|
||||
repository: Interlisp/maiko
|
||||
token: ${{ secrets.GITHUB_TOKEN }}
|
||||
latest: true
|
||||
fileName: "*"
|
||||
|
||||
# Setup Docker Machine Emulation environment
|
||||
- name: Set up QEMU
|
||||
uses: docker/setup-qemu-action@master
|
||||
|
||||
43
.github/workflows/buildLoadup.yml
vendored
43
.github/workflows/buildLoadup.yml
vendored
@@ -27,24 +27,37 @@ jobs:
|
||||
- name: Checkout Medley
|
||||
uses: actions/checkout@v2
|
||||
|
||||
- name: Get the latest Maiko Release
|
||||
uses: actions/checkout@v2
|
||||
# Get Maiko release information, retrieves the name of the latest
|
||||
# release. Used to download the correct Maiko release
|
||||
- name: Get Maiko Release Information
|
||||
id: latest_version
|
||||
uses: abatilo/release-info-action@v1.3.0
|
||||
with:
|
||||
repository: interlisp/maiko
|
||||
path: maiko
|
||||
owner: Interlisp
|
||||
repo: maiko
|
||||
|
||||
# Download Maiko Release Assets
|
||||
- name: Download Release Assets
|
||||
uses: robinraju/release-downloader@v1.2
|
||||
with:
|
||||
repository: Interlisp/maiko
|
||||
token: ${{ secrets.GITHUB_TOKEN }}
|
||||
latest: true
|
||||
fileName: "${{ steps.latest_version.outputs.latest_tag }}-linux.x86_64.tgz"
|
||||
|
||||
- name: install compiler
|
||||
run: sudo apt-get update && sudo apt-get install -y make clang libx11-dev gcc x11vnc xvfb
|
||||
- name: Untar Maiko Release
|
||||
run: |
|
||||
tar -xvzf "${{ steps.latest_version.outputs.latest_tag }}-linux.x86_64.tgz"
|
||||
|
||||
- name: install vnc
|
||||
run: sudo apt-get install -y tightvncserver
|
||||
|
||||
- name: Compile Maiko
|
||||
working-directory: maiko/bin
|
||||
run: ./makeright x && ./makeright init
|
||||
run: sudo apt-get update && sudo apt-get install -y tightvncserver
|
||||
|
||||
- name: Build Loadout
|
||||
run: pwd && Xvnc -once -geometry 1280x720 :0 & DISPLAY=:0 PATH="/maiko:$PATH" scripts/loadup-all.sh
|
||||
run: |
|
||||
Xvnc -geometry 1280x720 :0 &
|
||||
export DISPLAY=":0"
|
||||
PATH="$PWD/maiko:$PATH"
|
||||
scripts/loadup-all.sh
|
||||
|
||||
- name: Build release tar get libs
|
||||
run: |
|
||||
@@ -66,7 +79,7 @@ jobs:
|
||||
--exclude "*~" --exclude "*#*" \
|
||||
medley/docs/dinfo \
|
||||
medley/docs/Documentation\ Tools \
|
||||
medley/greetfiles/SIMPLE-INIT \
|
||||
medley/greetfiles \
|
||||
medley/run-medley \
|
||||
medley/scripts \
|
||||
medley/fonts/displayfonts \
|
||||
@@ -81,13 +94,13 @@ jobs:
|
||||
|
||||
- name: Release notes
|
||||
run: |
|
||||
sed s/'$tag'/$tag/g < release-notes.md > tmp/release-notes.md &&
|
||||
ls tmp && env
|
||||
sed s/'$tag'/$tag/g < release-notes.md > tmp/release-notes.md
|
||||
|
||||
- name: push the release
|
||||
uses: ncipollo/release-action@v1.8.10
|
||||
with:
|
||||
artifacts: tmp/${{ env.tag }}-loadups.tgz,tmp/${{ env.tag }}-runtime.tgz
|
||||
tag: ${{ env.tag }}
|
||||
draft: true
|
||||
bodyfile: tmp/release-notes.md
|
||||
token: ${{ secrets.GITHUB_TOKEN }}
|
||||
@@ -1,10 +1,14 @@
|
||||
# How to build a medley release
|
||||
|
||||
Originally done only with shell scripts:
|
||||
|
||||
```
|
||||
./scripts/loadup-all.sh
|
||||
```
|
||||
to make the loadups
|
||||
```
|
||||
./scripts/loadup-and-release.sh
|
||||
|
||||
```
|
||||
to go on to make the tgz files and release them
|
||||
|
||||
# Using github actions
|
||||
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
FROM interlisp/maiko:latest
|
||||
FROM ubuntu:focal
|
||||
ARG BUILD_DATE
|
||||
LABEL name="Medley"
|
||||
# LABEL tags=${tags}
|
||||
|
||||
29
README.md
29
README.md
@@ -125,16 +125,25 @@ files.
|
||||
|
||||
Each directory should have a README.md, but briefly
|
||||
|
||||
- docs -- Documentation files (either PDFs or online help)
|
||||
- fonts -- raster fonts (or font widths) in various resolutions for display, postscript, interpress, press formats
|
||||
- greetfiles -- various configuration setups
|
||||
- internal -- These _were_ internal to Venue; now internal/library and internal/test
|
||||
- library -- packages that were supported (30 years ago)
|
||||
- lispusers -- packages that were only half supported (ditto)
|
||||
- loadups -- has sysouts and other builds
|
||||
- scripts -- some scripts for fixing up things
|
||||
- sources -- sources for Interlisp and Common Lisp implementations
|
||||
- unicode -- data files for support of XCCS to and from Unicode mappings
|
||||
* BUILDING.md -- instructions on how to make your own loadups
|
||||
* clos -- early implementation of Common Lisp Object System
|
||||
* CLTL2 -- files submitted to bring Medley up to the conformance to "Common Lisp, the Language" 2nd edition. Not enough to conform to the ANSII standard lisp.
|
||||
* Dockerfile -- used when building Docker containers with Medley
|
||||
* docs -- Documentation files (either PDFs or online help; see medley/wiki)
|
||||
* fonts -- raster fonts (or font widths) in various resolutions for display, postscript, interpress, press formats
|
||||
* greetfiles -- various configuration setups
|
||||
* internal -- These _were_ internal to Venue; now internal/library and internal/test
|
||||
* library -- packages that were supported (30 years ago)
|
||||
* lispusers -- User contributed packages that were only half supported (ditto)
|
||||
* loadups -- has sysouts and other builds plus a few remnants
|
||||
* obsolete -- files we should remove from the repo
|
||||
* rooms -- implementation of ROOMS window / desktop manager
|
||||
* run-medley -- script to enhance the options of running medley
|
||||
* scripts -- some scripts for fixing up things
|
||||
* sources -- sources for Interlisp and Common Lisp implementations
|
||||
* unicode -- data files for support of XCCS to and from Unicode mappings
|
||||
|
||||
plus
|
||||
Dockerfile, and scripts for building and running medley
|
||||
tmp directory for use during build processes
|
||||
|
||||
|
||||
11
docs/README.md
Normal file
11
docs/README.md
Normal file
@@ -0,0 +1,11 @@
|
||||
This directory has:
|
||||
|
||||
* dinfo -- files for HelpSys man command Interlisp Reference Manual
|
||||
* Documentation Tools -- should be moved into Library
|
||||
|
||||
* Various conversions of Medley legacy documentation
|
||||
|
||||
Needs to be cleaned up. Putting PDF files in the repo doesn't seem right;
|
||||
we can make PS and PDF files as part of building a loadup
|
||||
|
||||
|
||||
16
fonts/README.md
Normal file
16
fonts/README.md
Normal file
@@ -0,0 +1,16 @@
|
||||
# Fonts
|
||||
|
||||
These are a not-very-well curated directories of fonts.
|
||||
|
||||
"adobe" -- display versions of Postscript's fonts
|
||||
palatino 8 9 10 12 14 18
|
||||
"altofonts" -- random remnants of fonts used with Alto
|
||||
"big" -- supposedly bigger fonts but turned out not (see #482)
|
||||
"displayfonts" -- separated into directories by charset
|
||||
"ipfonts" -- fonts (or font width information for Xeorx Interpress file format.
|
||||
"other" -- random fonts associated with lispusers packages and not available elsewhere.
|
||||
"postscriptfonts" -- fonts for postscript
|
||||
"press" -- fonts for the older-than-interpress "press" format.
|
||||
|
||||
"xeroxprivate" -- ?? Seems like junk
|
||||
|
||||
60
greetfiles/MEDLEYDIR-INIT
Normal file
60
greetfiles/MEDLEYDIR-INIT
Normal file
@@ -0,0 +1,60 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "14-Nov-2021 22:34:49" {DSK}<home>larry>medley>greetfiles>MEDLEYDIR-INIT.;2 2303
|
||||
|
||||
changes to%: (VARS MEDLEYDIR-INITCOMS)
|
||||
|
||||
previous date%: "14-Nov-2021 22:10:37" {DSK}<home>larry>medley>greetfiles>medleydir-INIT.;1)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT MEDLEYDIR-INITCOMS)
|
||||
|
||||
(RPAQQ MEDLEYDIR-INITCOMS
|
||||
((P (LOAD? (CONCAT (OR (UNIX-GETENV "MEDLEYDIR")
|
||||
"")
|
||||
"/sources/MEDLEYDIR.LCOM")))
|
||||
(FILES BACKGROUND-YIELD)
|
||||
(VARS (FILING.ENUMERATION.DEPTH 1)
|
||||
[LOGINDIR (DIRECTORYNAME (OR (UNIX-GETENV "LOGINDIR")
|
||||
(UNIX-GETENV "HOME"]
|
||||
[USERGREETFILES `((,LOGINDIR "INIT" COM)
|
||||
(,LOGINDIR "INIT"]
|
||||
(COPYRIGHTSRESERVED NIL))
|
||||
[P (KEYACTION 'LOCK '(LOCKTOGGLE . IGNORE]
|
||||
(FNS INTERLISPMODE)))
|
||||
|
||||
(LOAD? (CONCAT (OR (UNIX-GETENV "MEDLEYDIR")
|
||||
"")
|
||||
"/sources/MEDLEYDIR.LCOM"))
|
||||
|
||||
(FILESLOAD BACKGROUND-YIELD)
|
||||
|
||||
(RPAQQ FILING.ENUMERATION.DEPTH 1)
|
||||
|
||||
(RPAQ LOGINDIR (DIRECTORYNAME (OR (UNIX-GETENV "LOGINDIR")
|
||||
(UNIX-GETENV "HOME"))))
|
||||
|
||||
(RPAQ USERGREETFILES `((,LOGINDIR "INIT" COM)
|
||||
(,LOGINDIR "INIT")))
|
||||
|
||||
(RPAQQ COPYRIGHTSRESERVED NIL)
|
||||
|
||||
(KEYACTION 'LOCK '(LOCKTOGGLE . IGNORE))
|
||||
(DEFINEQ
|
||||
|
||||
(INTERLISPMODE
|
||||
[LAMBDA (OLD?) (* N.H.Briggs " 2-Feb-88 14:26")
|
||||
(PROCESSPROP 'EXEC 'PROFILE (XCL:COPY-PROFILE (if OLD?
|
||||
then "OLD-INTERLISP-T"
|
||||
else "INTERLISP")))
|
||||
(XCL:SET-DEFAULT-EXEC-TYPE (if OLD?
|
||||
then "OLD-INTERLISP-T"
|
||||
else "INTERLISP"))
|
||||
(SETQ *DEFAULT-MAKEFILE-ENVIRONMENT* (LIST :READTABLE (if OLD?
|
||||
then "OLD-INTERLISP-FILE"
|
||||
else "INTERLISP")
|
||||
:PACKAGE "INTERLISP"])
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1455 2280 (INTERLISPMODE 1465 . 2278)))))
|
||||
STOP
|
||||
BIN
greetfiles/MEDLEYDIR-INIT.LCOM
Normal file
BIN
greetfiles/MEDLEYDIR-INIT.LCOM
Normal file
Binary file not shown.
10
greetfiles/README.md
Normal file
10
greetfiles/README.md
Normal file
@@ -0,0 +1,10 @@
|
||||
# medley/greetfiles
|
||||
|
||||
This directory is somewhat vestigal -- it originally was used to hold 'initialization' files for everyone. Medley repo has only two:
|
||||
|
||||
NOGREET -- file to set as "system init" when doing loadups that don't want any personalization.
|
||||
|
||||
SIMPLE-INIT -- system init for git-directory relative directory structure.
|
||||
Contains INTERLISPMODE.
|
||||
|
||||
|
||||
@@ -1,4 +0,0 @@
|
||||
lldb ../../maiko/darwin.386/ldeinit
|
||||
|
||||
break set -n error
|
||||
run ./INIT.DLINIT -INIT -NF
|
||||
@@ -1,10 +1,11 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED " 1-Sep-2021 21:13:57" {DSK}<home>larry>medley>internal>library>MAKE-PS.;6 5503
|
||||
|
||||
changes to%: (VARS MAKE-PSCOMS)
|
||||
(FNS MAKE-PS-INIT)
|
||||
(FILECREATED "17-Oct-2021 16:06:41" {DSK}<home>larry>medley>internal>library>MAKE-PS.;2 5515
|
||||
|
||||
previous date%: "31-Aug-2021 22:30:13" {DSK}<home>larry>medley>internal>library>MAKE-PS.;4)
|
||||
changes to%: (FILES DOC-OBJECTS)
|
||||
(VARS MAKE-PSCOMS)
|
||||
|
||||
previous date%: " 1-Sep-2021 21:13:57" {DSK}<home>larry>medley>internal>library>MAKE-PS.;1)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT MAKE-PSCOMS)
|
||||
@@ -14,7 +15,7 @@
|
||||
|
||||
(* ;; " Load known used image object types")
|
||||
|
||||
(FILES DOC-OBJECTS EQUATIONS IMINDEX IMNAME IMTEDIT IMTOOLS IMTRAN MATHTONS SKETCH)
|
||||
(FILES DOC-OBJECTS EQUATIONS IMINDEX IMNAME IMTEDIT IMTOOLS IMTRAN MATHTONS SKETCH TMAX)
|
||||
(ADVISE TEDIT.PROMPTPRINT)
|
||||
(INITVARS (BADFILESFILE)
|
||||
(BADFS)
|
||||
@@ -113,7 +114,7 @@
|
||||
(* ;; " Load known used image object types")
|
||||
|
||||
|
||||
(FILESLOAD DOC-OBJECTS EQUATIONS IMINDEX IMNAME IMTEDIT IMTOOLS IMTRAN MATHTONS SKETCH)
|
||||
(FILESLOAD DOC-OBJECTS EQUATIONS IMINDEX IMNAME IMTEDIT IMTOOLS IMTRAN MATHTONS SKETCH TMAX)
|
||||
|
||||
[XCL:REINSTALL-ADVICE 'TEDIT.PROMPTPRINT :BEFORE '((:LAST (PRIN1 MSG T]
|
||||
|
||||
@@ -129,5 +130,5 @@
|
||||
(MAKE-PS-INIT)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (786 5110 (MAKE-PS 796 . 4293) (MAKE-PS-INIT 4295 . 4731) (BADFILE 4733 . 5108)))))
|
||||
(FILEMAP (NIL (793 5117 (MAKE-PS 803 . 4300) (MAKE-PS-INIT 4302 . 4738) (BADFILE 4740 . 5115)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,28 +1,124 @@
|
||||
(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "INTERLISP")
|
||||
(FILECREATED "28-Mar-2021 10:17:29"
|
||||
|{DSK}<home>larry>ilisp>medley>internal>library>MEDLEY-UTILS.;4| 3190
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
|
||||
|
||||
(FILECREATED "25-Oct-2021 14:54:43" |{DSK}<home>larry>medley>internal>library>MEDLEY-UTILS.;14| 9472
|
||||
|
||||
|changes| |to:| (VARS MEDLEY-UTILSCOMS)
|
||||
(FNS GATHER-INFO)
|
||||
|
||||
|previous| |date:| "24-Mar-2021 15:45:15"
|
||||
|{DSK}<home>larry>ilisp>medley>internal>library>MEDLEY-UTILS.;3|)
|
||||
|previous| |date:| "23-Oct-2021 14:53:16"
|
||||
|{DSK}<home>larry>medley>internal>library>MEDLEY-UTILS.;2|)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT MEDLEY-UTILSCOMS)
|
||||
|
||||
(RPAQQ MEDLEY-UTILSCOMS ((FNS MEDLEY-FIX-LINKS MEDLEY-FIX-DATES)
|
||||
(RPAQQ MEDLEY-UTILSCOMS ((FNS GATHER-INFO MEDLEY-FIX-LINKS MEDLEY-FIX-DATES)
|
||||
(VARS MEDLEY-FIX-DIRS)
|
||||
(FNS MAKE-EXPORTS-ALL MAKE-WHEREIS-HASH)))
|
||||
(DEFINEQ
|
||||
|
||||
(GATHER-INFO
|
||||
(LAMBDA (PHASE) (* \;
|
||||
"Edited 24-Oct-2021 09:43 by larry")
|
||||
(SELECTQ PHASE
|
||||
(ALL (SETQ SYSFILES (UNION SYSFILES FILELST))
|
||||
(SETQ FILELST NIL)
|
||||
(FILESLOAD (SOURCE)
|
||||
SYSEDIT)
|
||||
(|for| I |from| 1 |to| 4 |do| (GATHER-INFO I)))
|
||||
(1 (SETQ LOADEDFILES (|for| X |in| LOADEDFILELST |collect| (FILENAMEFIELD
|
||||
X
|
||||
'NAME)))
|
||||
(FILESLOAD FILESETS)
|
||||
(SETQ ALLFILESETSFILES (|for| X |in| FILESETS |join| (APPEND (EVAL X))))
|
||||
(SETQ SOURCES (|for| X |in| (DIRECTORY (MEDLEYDIR "sources" "*.*;" T))
|
||||
|when| (NOT (MEMB (FILENAMEFIELD X 'EXTENSION)
|
||||
'(LCOM DFASL TEDIT TXT)))
|
||||
|collect| (FILENAMEFIELD X 'NAME))))
|
||||
(-1 (PRINTOUT T " loaded files not in SYSFILES or FILELST: "
|
||||
(|for| X |in| LOADEDFILES |when| (NOT (OR (FMEMB X SYSFILES)
|
||||
(FMEMB X FILELST)))
|
||||
|collect| X)
|
||||
T)
|
||||
(PRINTOUT T "Sources not loaded: " (CL:SET-DIFFERENCE SOURCES (APPEND ALLFILESETSFILES
|
||||
LOADEDFILES))
|
||||
T)
|
||||
(PRINTOUT T "Files in FILESETS not loaded " (CL:SET-DIFFERENCE ALLFILESETSFILES
|
||||
LOADEDFILES)
|
||||
T))
|
||||
(2 (SETQ DEFINEDFNS (LET ((DEFD NIL))
|
||||
(MAPATOMS (FUNCTION (CL:LAMBDA (X)
|
||||
(CL:WHEN (GETD X)
|
||||
(CL:SETQ DEFD (CONS X DEFD))))))
|
||||
DEFD))
|
||||
(|for| X |in| DEFINEDFNS |when| (CCODEP X)
|
||||
|do| (LET ((Y (PUTPROP X 'CCC (CALLSCCODE X))))
|
||||
(|for| REV |in| '(BLOCK-CALLED-BY CALLED-BY SPECIAL-BY GLOBAL-BY)
|
||||
|as| VAL |in| Y
|
||||
|do| (|for| S |in| VAL
|
||||
|do| (PUTPROP S REV (CONS X (GETPROP S REV)))))))
|
||||
(SETQ CALLEDFNS NIL)
|
||||
(MAPATOMS (FUNCTION (LAMBDA (X)
|
||||
(|if| (AND (NOT (GETD X))
|
||||
(GETPROP X 'CALLED-BY))
|
||||
|then| (CL:PUSH X CALLEDFNS))))))
|
||||
(-2 (PRINTOUT T "Functions called and not defined" CALLEDFNS T))
|
||||
(3 (|for| X |in| SYSFILES
|
||||
|do|
|
||||
(LOAD X 'PROP)
|
||||
(PUTPROP X 'CONTENT (READFILE X))
|
||||
(|for| EXR |in| (GETPROP X 'CONTENT)
|
||||
|do| (SELECTQ (CAR EXR)
|
||||
(DEFINEQ (|for| DFN |in| (CDR EXR)
|
||||
|do| (|if| (EQUAL (CADR DFN)
|
||||
(GETPROP (CAR DFN)
|
||||
'EXPR))
|
||||
|then| (PRINTOUT T (CAR DFN)
|
||||
" ")
|
||||
(PUTPROP (CAR DFN)
|
||||
'EXPR
|
||||
(CADR DFN))
|
||||
|else| (PRINTOUT T (CAR DFN)
|
||||
"* "))))
|
||||
NIL)))
|
||||
(SETQ ALLCONTENT (|for| X |in| SYSFILES |collect| (CONS X (GETPROP
|
||||
X
|
||||
'CONTENT))))
|
||||
(* \; " don't edit with SEDIT")
|
||||
(LET (DUPS)
|
||||
(|for| X |in| SYSFILES
|
||||
|do| (|for| FN |in| (FILEFNSLST X)
|
||||
|do| (|if| (GETPROP FN 'WHEREIS)
|
||||
|then| (NCONC1 (GETPROP FN 'WHEREIS)
|
||||
X)
|
||||
(OR (FMEMB FN DUPS)
|
||||
(SETQ DUPS (CONS FN DUPS)))
|
||||
|else| (PUTPROP FN 'WHEREIS (LIST X)))))
|
||||
(SETQ DUPFNS DUPS))
|
||||
(SETQ NO-SOURCE (|for| X |in| DEFINEDFNS |when| (NOT (GETPROP X 'EXPR))
|
||||
|collect| X)))
|
||||
(-3 (PRINTOUT T "Functions compiled but no expr" NO-SOURCE T)
|
||||
(PRINTOUT T "Functions on more than one file: " DUPFNS T))
|
||||
(4 (PRINTOUT T T "STARTING MASTERSCOPE PHASE ON " (DATE)
|
||||
T)
|
||||
(FILESLOAD (SOURCE)
|
||||
SYSEDIT)
|
||||
(|for| X |in| SYSFILES |do| (MSNOTICEFILE X))
|
||||
(|for| X |in| SYSFILES |do| (PRINTOUT T T "Analyzing " X T)
|
||||
(MASTERSCOPE `(ANALYZE ON ,(KWOTE X)))))
|
||||
(-4 "No queries yet")
|
||||
(HELP))))
|
||||
|
||||
(MEDLEY-FIX-LINKS
|
||||
(LAMBDA (UNIXPATH) (* \; "Edited 18-Jan-2021 12:01 by larry")
|
||||
(LAMBDA (UNIXPATH) (* \;
|
||||
"Edited 18-Jan-2021 12:01 by larry")
|
||||
(OR UNIXPATH (SETQ UNIXPATH (UNIX-GETENV "MEDLEYDIR"))
|
||||
(ERROR "No Directory")) (* \; "Edited 18-Jan-2021 11:45 by larry")
|
||||
(ERROR "No Directory")) (* \;
|
||||
"Edited 18-Jan-2021 11:45 by larry")
|
||||
(|ShellCommand| (CONCAT "cd " UNIXPATH " && /bin/sh scripts/fixlinks && /bin/sh /tmp/doit"))))
|
||||
|
||||
(MEDLEY-FIX-DATES
|
||||
(LAMBDA (DIRS) (* \; "Edited 28-Jan-2021 12:15 by larry")
|
||||
(LAMBDA (DIRS) (* \;
|
||||
"Edited 28-Jan-2021 12:15 by larry")
|
||||
(|for| X |in| (OR DIRS MEDLEY-FIX-DIRS) |join| (FIX-DIRECTORY-DATES
|
||||
(MEDLEYDIR (PRINT X T))))))
|
||||
)
|
||||
@@ -32,7 +128,8 @@
|
||||
(DEFINEQ
|
||||
|
||||
(MAKE-EXPORTS-ALL
|
||||
(LAMBDA NIL (* \; "Edited 9-Mar-2021 16:11 by larry")
|
||||
(LAMBDA NIL (* \;
|
||||
"Edited 9-Mar-2021 16:11 by larry")
|
||||
(* "Edited May 3, 2018 by Ron Kaplan--relative to MEDLEYDIR/lispcore/. Don't know why it does the CORE/RENAME")
|
||||
(*
|
||||
"Edited Aug 17 94 by Sybalsky -- point it to /king/export/lispcore as the truth directory.")
|
||||
@@ -45,7 +142,8 @@
|
||||
(GATHEREXPORTS EXPORTFILES (MEDLEYDIR "tmp" "exports.all" T))))
|
||||
|
||||
(MAKE-WHEREIS-HASH
|
||||
(LAMBDA NIL (* \; "Edited 24-Mar-2021 13:26 by larry")
|
||||
(LAMBDA NIL (* \;
|
||||
"Edited 24-Mar-2021 13:26 by larry")
|
||||
(LET ((FILING.ENUMERATION.DEPTH 1)
|
||||
HASHFILE)
|
||||
(DRIBBLE (MEDLEYDIR "tmp" "whereis.dribble" T))
|
||||
@@ -59,6 +157,6 @@
|
||||
(DRIBBLE))))
|
||||
)
|
||||
(DECLARE\: DONTCOPY
|
||||
(FILEMAP (NIL (567 1272 (MEDLEY-FIX-LINKS 577 . 966) (MEDLEY-FIX-DATES 968 . 1270)) (1430 3167 (
|
||||
MAKE-EXPORTS-ALL 1440 . 2389) (MAKE-WHEREIS-HASH 2391 . 3165)))))
|
||||
(FILEMAP (NIL (618 7420 (GATHER-INFO 628 . 6522) (MEDLEY-FIX-LINKS 6524 . 7047) (MEDLEY-FIX-DATES 7049
|
||||
. 7418)) (7578 9449 (MAKE-EXPORTS-ALL 7588 . 8604) (MAKE-WHEREIS-HASH 8606 . 9447)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,15 +1,15 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
|
||||
(FILECREATED "13-Jun-2021 14:02:38"
|
||||
|{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>BIGBITMAPS.;5| 113115
|
||||
|
||||
|changes| |to:| (FNS \\DRAWLINE.BIGBM.DASH \\DRAWLINE.BIGBM.NODASH BIGBITMAPP)
|
||||
(FILECREATED "26-Oct-2021 14:51:38" |{DSK}<home>larry>medley>library>BIGBITMAPS.;7| 110451
|
||||
|
||||
|changes| |to:| (FNS UNCOLORIZEBITMAP COLORIZEBITMAP \\BWTOCOLORBLT)
|
||||
(VARS BIGBITMAPSCOMS)
|
||||
(MACROS |\\SFInvert|)
|
||||
|
||||
|previous| |date:| "10-May-2021 15:37:51"
|
||||
|{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>BIGBITMAPS.;1|)
|
||||
|previous| |date:| "13-Jun-2021 14:02:38" |{DSK}<home>larry>medley>library>BIGBITMAPS.;5|)
|
||||
|
||||
|
||||
; Copyright (c) 1991, 1993-1994, 2021 by Venue.
|
||||
; Copyright (c) 1991, 1993-1994 by Venue.
|
||||
|
||||
(PRETTYCOMPRINT BIGBITMAPSCOMS)
|
||||
|
||||
@@ -69,11 +69,7 @@
|
||||
|
||||
(PUTPROPS |\\SFInvert| MACRO ((|BitMap| \y)
|
||||
|
||||
(* |corrects| |for| |the| |fact| |that| |alto| |bitmaps| |are| |stored| |with|
|
||||
0\,0 |as| |upper| |left| |while| |lisp| |bitmaps| |have| 0\,0 |as| |lower|
|
||||
|left.| |The| |correction| |is| |actually| |off| |by| |one|
|
||||
(|greater|) |because| \a |majority| |of| |the| |places| |that| |it| |is|
|
||||
|called| |actually| |need| |one| |more| |than| |corrected| Y |value.|)
|
||||
(* |;;| "corrects for the fact that alto bitmaps are stored with 0,0 as upper left while lisp bitmaps have 0,0 as lower left. The correction is actually off by one (greater) because a majority of the places that it is called actually need one more than corrected Y value.")
|
||||
|
||||
(IDIFFERENCE (|fetch| (BITMAP BITMAPHEIGHT) |of|
|
||||
|BitMap|)
|
||||
@@ -1478,11 +1474,12 @@
|
||||
(DEFINEQ
|
||||
|
||||
(COLORIZEBITMAP
|
||||
(LAMBDA (BITMAP 0COLOR 1COLOR BITSPERPIXEL) (* \; "Edited 13-Jul-90 14:42 by matsuda")
|
||||
(LAMBDA (BITMAP 0COLOR 1COLOR BITSPERPIXEL) (* \;
|
||||
"Edited 26-Oct-2021 14:23 by larry")
|
||||
(* \;
|
||||
"Edited 13-Jul-90 14:42 by matsuda")
|
||||
|
||||
(* |creates| \a |copy| |of| BITMAP |that| |is| |in| |color| |form| |allowing|
|
||||
BITSPERPIXEL |per| |pixel.| 0COLOR |and| 1COLOR |are| |the| |color| |numbers|
|
||||
|that| |get| |translated| |from| 0 |and| 1 |respectively.|)
|
||||
(* |;;| "creates a copy of BITMAP that is in color form allowing BITSPERPIXEL per pixel. 0COLOR and 1COLOR are the color numbers that get translated from 0 and 1 respectively.")
|
||||
|
||||
(PROG (COLORBITMAP)
|
||||
(SETQ COLORBITMAP (BITMAPCREATE (|fetch| (BITMAP BITMAPWIDTH) |of| BITMAP)
|
||||
@@ -1516,14 +1513,20 @@
|
||||
(RETURN COLORBITMAP))))
|
||||
|
||||
(\\BWTOCOLORBLT
|
||||
(LAMBDA (SOURCEBWBM SLEFT SBOTTOM DESTCOLORBM DLEFT DBOTTOM WIDTH HEIGHT 0COLOR 1COLOR DESTNBITS)
|
||||
(* \; "Edited 8-May-2021 22:31 by rmk:")
|
||||
(LAMBDA (SOURCEBWBM SLEFT SBOTTOM DESTCOLORBM DLEFT DBOTTOM WIDTH HEIGHT 0COLOR 1COLOR DESTNBITS)
|
||||
(* \;
|
||||
"Edited 26-Oct-2021 14:36 by larry")
|
||||
(* \;
|
||||
"Edited 26-Oct-2021 14:32 by larry")
|
||||
(* \;
|
||||
"Edited 26-Oct-2021 14:26 by larry")
|
||||
(* \;
|
||||
"Edited 8-May-2021 22:31 by rmk:")
|
||||
|
||||
(* |;;| "blits from a black and white bitmap into a color bitmap which has DESTNBITS bits per pixel. DESTCOLORBM is a pointer to the color bitmap.")
|
||||
|
||||
(* |;;| "assumes all datatypes and bounds have been checked")
|
||||
|
||||
(* |blits| |from| \a |black| |and| |white| |bitmap| |into| \a |color| |bitmap|
|
||||
|which| |has| DESTNBITS |bits| |per| |pixel.|
|
||||
DESTCOLORBM |is| \a |pointer| |to| |the| |color| |bitmap.|)
|
||||
(* |assumes| |all| |datatypes| |and|
|
||||
|bounds| |have| |been| |checked|)
|
||||
(SELECTQ DESTNBITS
|
||||
(4 (PROG (MAP SRCBASE SRCHEIGHT SRCRW SRCWRD SRCOFFSET DESBASE DESHEIGHT DESRW DESWRD DESOFF
|
||||
NBITS DESALIGNLEFT SCR)
|
||||
@@ -1538,24 +1541,24 @@
|
||||
(SETQ DESRW (|fetch| (BITMAP BITMAPRASTERWIDTH) |of| DESTCOLORBM))
|
||||
(SETQ DESWRD (FOLDLO DLEFT 4))
|
||||
(SETQ DESOFF (MOD DLEFT 4))
|
||||
(SETQ NBITS 4) (* DESTCOLORBM |is| |used| |to|
|
||||
|allow| |one| |bit| |per| |pixel|
|
||||
|bitblt| |operations| |on| |the|
|
||||
|bitmap.|)
|
||||
(SETQ NBITS 4)
|
||||
|
||||
(* |;;|
|
||||
"DESTCOLORBM is used to allow one bit per pixel bitblt operations on the bitmap.")
|
||||
|
||||
(COND
|
||||
((NOT (EQ 0 DESOFF)) (* |save| |the| |left| |bits| |of|
|
||||
|the| |destination| |bitmap| |so|
|
||||
|it| |can| |be| |word| |aligned.|)
|
||||
((NOT (EQ 0 DESOFF))
|
||||
|
||||
(* |;;|
|
||||
"save the left bits of the destination bitmap so it can be word aligned.")
|
||||
|
||||
(SETQ SCR (BITMAPCREATE 4 HEIGHT 4))
|
||||
(BITBLT DESTCOLORBM (SETQ DESALIGNLEFT (LLSH DESWRD 2))
|
||||
DBOTTOM SCR 0 0 DESOFF HEIGHT 'INPUT 'REPLACE)))
|
||||
(|for| LINECOUNTER |from| 1 |to| HEIGHT
|
||||
|do|
|
||||
|
||||
(* |linecounter| |goes| |from| 1 |to| |height| |because| |bitmaps| |are|
|
||||
|stored| |internally| |with| |top| |first| |so| |subtracting| |height| |is|
|
||||
|necessary| |to| |get| |offset| |of| |line| |and| |the| 1 |corrects| |for|
|
||||
|height| |difference.|)
|
||||
(* |;;| "linecounter goes from 1 to height because bitmaps are stored internally with top first so subtracting height is necessary to get offset of line and the 1 corrects for height difference.")
|
||||
|
||||
(\\4BITLINEBLT (\\ADDBASE SRCBASE (IPLUS (ITIMES (IDIFFERENCE SRCHEIGHT
|
||||
(IPLUS LINECOUNTER
|
||||
@@ -1570,9 +1573,11 @@
|
||||
DESWRD))
|
||||
WIDTH MAP 0COLOR 1COLOR))
|
||||
(COND
|
||||
(DESALIGNLEFT (* |move| |the| |color| |bits| |to|
|
||||
|the| |right| |and| |restore| |the|
|
||||
|saved| |color| |bits.|)
|
||||
(DESALIGNLEFT
|
||||
|
||||
(* |;;|
|
||||
"move the color bits to the right and restore the saved color bits.")
|
||||
|
||||
(BITBLT DESTCOLORBM DESALIGNLEFT DBOTTOM DESTCOLORBM (IPLUS
|
||||
DESALIGNLEFT
|
||||
DESOFF)
|
||||
@@ -1580,32 +1585,8 @@
|
||||
(BITBLT SCR 0 0 DESTCOLORBM DESALIGNLEFT DBOTTOM DESOFF HEIGHT
|
||||
'INPUT
|
||||
'REPLACE)))))
|
||||
(8
|
||||
|
||||
(* PROG (MAP SRCBASE SRCHEIGHT SRCRW SRCWRD SRCOFFSET DESBASE DESHEIGHT DESRW
|
||||
DESWRD DESOFF) (SETQ MAP (|fetch| (ARRAYP BASE) |of|
|
||||
(\\MAP8 0COLOR 1COLOR))) (SETQ SRCBASE (|fetch|
|
||||
(BITMAP BITMAPBASE) |of| SOURCEBWBM)) (SETQ SRCHEIGHT
|
||||
(|fetch| (BITMAP BITMAPHEIGHT) |of| SOURCEBWBM))
|
||||
(SETQ SRCRW (|fetch| (BITMAP BITMAPRASTERWIDTH) |of| SOURCEBWBM))
|
||||
(SETQ SRCWRD (FOLDLO SLEFT BITSPERWORD))
|
||||
(SETQ SRCOFFSET (MOD SLEFT BITSPERWORD))
|
||||
(SETQ DESBASE (|fetch| (BITMAP BITMAPBASE) |of| DESTCOLORBM))
|
||||
(SETQ DESHEIGHT (|fetch| (BITMAP BITMAPHEIGHT) |of| DESTCOLORBM))
|
||||
(SETQ DESRW (|fetch| (BITMAP BITMAPRASTERWIDTH) |of| DESTCOLORBM))
|
||||
(SETQ DESWRD (FOLDLO DLEFT 2)) (SETQ DESOFF
|
||||
(MOD DLEFT 2)) (|for| LINECOUNTER |from| 1 |to| HEIGHT |do|
|
||||
(* |linecounter| |goes| |from| 1 |to| |height| |because| |bitmaps| |are|
|
||||
|stored| |internally| |with| |top| |first| |so| |subtracting| |height| |is|
|
||||
|necessary| |to| |get| |offset| |of| |line| |and| |the| 1 |corrects| |for|
|
||||
|height| |difference.|) (\\8BITLINEBLT (\\ADDBASE SRCBASE
|
||||
(IPLUS (ITIMES (IDIFFERENCE SRCHEIGHT (IPLUS LINECOUNTER SBOTTOM)) SRCRW)
|
||||
SRCWRD)) SRCOFFSET (\\ADDBASE DESBASE (IPLUS
|
||||
(ITIMES (IDIFFERENCE DESHEIGHT (IPLUS LINECOUNTER DBOTTOM)) DESRW) DESWRD))
|
||||
DESOFF WIDTH MAP 0COLOR 1COLOR)) *)
|
||||
|
||||
((OPCODES SUBRCALL 142 11)
|
||||
SOURCEBWBM SLEFT SBOTTOM DESTCOLORBM DLEFT DBOTTOM WIDTH HEIGHT 0COLOR 1COLOR DESTNBITS))
|
||||
(8 (SUBRCALL COLORIZE-BITMAP SOURCEBWBM SLEFT SBOTTOM DESTCOLORBM DLEFT DBOTTOM WIDTH HEIGHT
|
||||
0COLOR 1COLOR DESTNBITS))
|
||||
(24 (PROG (SRCBASE SRCHEIGHT SRCRW DESBASE DESHEIGHT DESRW)
|
||||
(SETQ SRCBASE (|fetch| (BITMAP BITMAPBASE) |of| SOURCEBWBM))
|
||||
(SETQ SRCHEIGHT (|fetch| (BITMAP BITMAPHEIGHT) |of| SOURCEBWBM))
|
||||
@@ -1616,10 +1597,7 @@
|
||||
(|for| LINECOUNTER |from| 1 |to| HEIGHT
|
||||
|do|
|
||||
|
||||
(* |linecounter| |goes| |from| 1 |to| |height| |because| |bitmaps| |are|
|
||||
|stored| |internally| |with| |top| |first| |so| |subtracting| |height| |is|
|
||||
|necessary| |to| |get| |offset| |of| |line| |and| |the| 1 |corrects| |for|
|
||||
|height| |difference.|)
|
||||
(* |;;| "linecounter goes from 1 to height because bitmaps are stored internally with top first so subtracting height is necessary to get offset of line and the 1 corrects for height difference.")
|
||||
|
||||
(\\24BITLINEBLT (\\ADDBASE SRCBASE (ITIMES (IDIFFERENCE SRCHEIGHT
|
||||
(IPLUS LINECOUNTER
|
||||
@@ -1634,7 +1612,14 @@
|
||||
(SHOULDNT))))
|
||||
|
||||
(UNCOLORIZEBITMAP
|
||||
(LAMBDA (BITMAP COLORMAP) (* \; "Edited 13-Jul-90 16:54 by matsuda")
|
||||
(LAMBDA (BITMAP COLORMAP) (* \;
|
||||
"Edited 26-Oct-2021 14:51 by larry")
|
||||
(* \;
|
||||
"Edited 26-Oct-2021 14:44 by larry")
|
||||
(* \;
|
||||
"Edited 26-Oct-2021 14:44 by larry")
|
||||
(* \;
|
||||
"Edited 13-Jul-90 16:54 by matsuda")
|
||||
(PROG (BITSPERPIXEL MAXCOLOR MAXX MAXY BWBITMAP TABLE RGB R G B BIT BASE BWBASE RASTERWIDTH
|
||||
BWRASTERWIDTH WORD)
|
||||
(SETQ MAXX (SUB1 (BITMAPWIDTH BITMAP)))
|
||||
@@ -1685,8 +1670,7 @@
|
||||
(SETQ BWBASE (\\ADDBASE BWBASE BWRASTERWIDTH))))))
|
||||
(8 (COND
|
||||
((NOT (|type?| BIGBM BITMAP))
|
||||
((OPCODES SUBRCALL 141 3)
|
||||
BITMAP BWBITMAP TABLE))
|
||||
(SUBRCALL UNCOLORIZE-BITMAP BITMAP BWBITMAP TABLE))
|
||||
(T (PROG ((SRCBIGBMLIST (|fetch| (BIGBM BIGBMLIST) |of| BITMAP))
|
||||
SRCBITMAP
|
||||
(WIDTH (ADD1 MAXX))
|
||||
@@ -1705,8 +1689,8 @@
|
||||
|of|
|
||||
SRCBITMAP)
|
||||
)))
|
||||
((OPCODES SUBRCALL 141 3)
|
||||
SRCBITMAP TEMPBM TABLE)
|
||||
(SUBRCALL UNCOLORIZE-BITMAP SRCBITMAP
|
||||
TEMPBM TABLE)
|
||||
(BITBLT TEMPBM 0 (IDIFFERENCE
|
||||
(ADD1 MAXY)
|
||||
HEIGHT)
|
||||
@@ -1714,25 +1698,7 @@
|
||||
'INPUT
|
||||
'REPLACE)
|
||||
(SETQ SRCBITMAP (|GetNewFragment|
|
||||
SRCBIGBMLIST))))))
|
||||
(* |for| Y |from| 0 |to| MAXY |do|
|
||||
(SETQ WORD 0) (|for| X |from| 0 |to|
|
||||
MAXX |do| (SETQ WORD
|
||||
(LOGOR (LLSH WORD 1)
|
||||
(\\GETBASE TABLE (\\GETBASEBYTE BASE
|
||||
X)))) (COND ((EQ (LOGAND X 15) 15)
|
||||
(\\PUTBASE BWBASE (FOLDLO X 16) WORD)
|
||||
(SETQ WORD 0)))) (COND
|
||||
((NOT (EQ (LOGAND MAXX 15) 15))
|
||||
(SETQ WORD (LLSH WORD
|
||||
(IDIFFERENCE 15 (LOGAND MAXX 15))))
|
||||
(\\PUTBASE BWBASE (FOLDLO MAXX 16)
|
||||
WORD))) (COND ((NOT
|
||||
(EQ Y MAXY)) (SETQ BASE
|
||||
(\\ADDBASE BASE RASTERWIDTH))
|
||||
(SETQ BWBASE (\\ADDBASE BWBASE
|
||||
BWRASTERWIDTH)))) *)
|
||||
)
|
||||
SRCBIGBMLIST)))))))
|
||||
NIL)
|
||||
(RETURN BWBITMAP))))
|
||||
)
|
||||
@@ -1746,17 +1712,17 @@
|
||||
|
||||
(MOVD 'BITBLT 'BKBITBLT)
|
||||
)
|
||||
(PUTPROPS BIGBITMAPS COPYRIGHT ("Venue" 1991 1993 1994 2021))
|
||||
(PUTPROPS BIGBITMAPS COPYRIGHT ("Venue" 1991 1993 1994))
|
||||
(DECLARE\: DONTCOPY
|
||||
(FILEMAP (NIL (3337 48035 (BIGBITMAPP 3347 . 3493) (BITBLT.BIGBM 3495 . 14318) (BITMAPCREATE.BIGBM
|
||||
14320 . 15662) (BITMAPCREATE 15664 . 17266) (BITMAPCOPY 17268 . 17803) (BLTSHADE.BIGBM 17805 . 20941)
|
||||
(BITBLT 20943 . 22591) (\\ORG.BITBLT 22593 . 34162) (\\BLTSHADE.DISPLAY 34164 . 43402) (
|
||||
\\RESHOWBORDER1 43404 . 48033)) (48036 71314 (\\DRAWCIRCLE.BIGBM 48046 . 51409) (\\FILLCIRCLE.BIGBM
|
||||
51411 . 55457) (\\DRAWELLIPSE.BIGBM 55459 . 59979) (\\DRAWCURVE.BIGBM 59981 . 63831) (
|
||||
\\DRAWLINE.BIGBM.DASH 63833 . 68192) (\\DRAWLINE.BIGBM.NODASH 68194 . 71312)) (71315 86890 (DSPCREATE
|
||||
71325 . 73755) (DSPDESTINATION 73757 . 77655) (|\\SFFixY| 77657 . 83379) (|\\SFFixDestination| 83381
|
||||
. 84564) (|\\SFFixClippingRegion| 84566 . 86888)) (86891 94977 (\\SW2BM 86901 . 91925) (BITMAPHEIGHT
|
||||
91927 . 92425) (BITMAPWIDTH 92427 . 92919) (|\\SFFixFont| 92921 . 93893) (BITSPERPIXEL 93895 . 94975))
|
||||
(94978 112868 (COLORIZEBITMAP 94988 . 97625) (\\BWTOCOLORBLT 97627 . 105909) (UNCOLORIZEBITMAP 105911
|
||||
. 112866)))))
|
||||
(FILEMAP (NIL (3215 47913 (BIGBITMAPP 3225 . 3371) (BITBLT.BIGBM 3373 . 14196) (BITMAPCREATE.BIGBM
|
||||
14198 . 15540) (BITMAPCREATE 15542 . 17144) (BITMAPCOPY 17146 . 17681) (BLTSHADE.BIGBM 17683 . 20819)
|
||||
(BITBLT 20821 . 22469) (\\ORG.BITBLT 22471 . 34040) (\\BLTSHADE.DISPLAY 34042 . 43280) (
|
||||
\\RESHOWBORDER1 43282 . 47911)) (47914 71192 (\\DRAWCIRCLE.BIGBM 47924 . 51287) (\\FILLCIRCLE.BIGBM
|
||||
51289 . 55335) (\\DRAWELLIPSE.BIGBM 55337 . 59857) (\\DRAWCURVE.BIGBM 59859 . 63709) (
|
||||
\\DRAWLINE.BIGBM.DASH 63711 . 68070) (\\DRAWLINE.BIGBM.NODASH 68072 . 71190)) (71193 86768 (DSPCREATE
|
||||
71203 . 73633) (DSPDESTINATION 73635 . 77533) (|\\SFFixY| 77535 . 83257) (|\\SFFixDestination| 83259
|
||||
. 84442) (|\\SFFixClippingRegion| 84444 . 86766)) (86769 94855 (\\SW2BM 86779 . 91803) (BITMAPHEIGHT
|
||||
91805 . 92303) (BITMAPWIDTH 92305 . 92797) (|\\SFFixFont| 92799 . 93771) (BITSPERPIXEL 93773 . 94853))
|
||||
(94856 110209 (COLORIZEBITMAP 94866 . 97676) (\\BWTOCOLORBLT 97678 . 104271) (UNCOLORIZEBITMAP 104273
|
||||
. 110207)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,19 +1,22 @@
|
||||
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
|
||||
(FILECREATED " 3-May-93 18:44:36" "{DSK}<project>lfg>parser>DATABASEFNS.;4" 17283
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "27-Oct-2021 10:55:18" {DSK}<home>larry>medley>library>DATABASEFNS.;7 16051
|
||||
|
||||
changes to%: (FNS DUMPDB)
|
||||
|
||||
previous date%: " 7-Jul-92 09:57:14" "{DSK}<project>lfg>parser>DATABASEFNS.;3")
|
||||
previous date%: "24-Oct-2021 20:18:51" {DSK}<home>larry>medley>library>DATABASEFNS.;6)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1986, 1990, 1991, 1992, 1993 by Xerox Corporation. All rights reserved.
|
||||
Copyright (c) 1986, 1990-1993 by Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT DATABASEFNSCOMS)
|
||||
|
||||
(RPAQQ DATABASEFNSCOMS
|
||||
[(* Does automatic Masterscope database maintenance)
|
||||
[
|
||||
(* ;; "Does automatic Masterscope database maintenance")
|
||||
|
||||
[DECLARE%: FIRST (P (VIRGINFN 'LOAD T)
|
||||
(MOVD? 'LOAD 'OLDLOAD)
|
||||
(VIRGINFN 'LOADFROM T)
|
||||
@@ -28,16 +31,15 @@ Copyright (c) 1986, 1990, 1991, 1992, 1993 by Xerox Corporation. All rights res
|
||||
(INITVARS (LOADDBFLG 'ASK)
|
||||
(SAVEDBFLG 'ASK))
|
||||
(ADDVARS (MAKEFILEFORMS (MAKEDB FILE)))
|
||||
(* To permit MSHASH interface)
|
||||
(INITVARS (MSHASHFILENAME)
|
||||
(MSFILETABLE))
|
||||
(INITVARS (MSFILETABLE))
|
||||
(* ; "To permit MSHASH interface")
|
||||
(LOCALVARS . T)
|
||||
(BLOCKS (LOADDB LOADDB DBFILE DBFILE1 DBFILE2 (NOLINKFNS . T)))
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (P (RESETSAVE DWIMIFYCOMPFLG T])
|
||||
|
||||
|
||||
|
||||
(* Does automatic Masterscope database maintenance)
|
||||
(* ;; "Does automatic Masterscope database maintenance")
|
||||
|
||||
(DECLARE%: FIRST
|
||||
|
||||
@@ -56,78 +58,81 @@ Copyright (c) 1986, 1990, 1991, 1992, 1993 by Xerox Corporation. All rights res
|
||||
(DEFINEQ
|
||||
|
||||
(DBFILE
|
||||
[LAMBDA (FILE ASKFLAG) (* lmm "29-APR-81 20:27")
|
||||
|
||||
(* Finds a database file that corresponds to the contents of FILE.
|
||||
Looks in directory of FILE, and also in the directory that file originally came
|
||||
from, if it was copied. Returns NIL if no database file is found, else
|
||||
(fulldbfilename . filedates)%, where filedates identifies the name under which
|
||||
the file that the database corresponds to is currently known.
|
||||
-
|
||||
If FILE doesn't have a version, tries to get database for version in core, or
|
||||
most recent version if it hasn't been loaded)
|
||||
[LAMBDA (FILE ASKFLAG) (* ; "Edited 24-Oct-2021 16:50 by rmk:")
|
||||
(* lmm "29-APR-81 20:27")
|
||||
|
||||
(* ;; "Finds a database file that corresponds to the contents of FILE. Looks in directory of FILE, and also in the directory that file originally came from, if it was copied. Returns NIL if no database file is found, else (fulldbfilename . filedates), where filedates identifies the name under which the file that the database corresponds to is currently known.")
|
||||
|
||||
(* ;; "If FILE doesn't have a version, tries to get database for version in core, or most recent version if it hasn't been loaded")
|
||||
|
||||
(DECLARE (GLOBALVARS COMPILE.EXT FILERDTBL))
|
||||
[COND
|
||||
((NULL FILE)
|
||||
(SETQ FILE (INPUT)))
|
||||
((EQ (FILENAMEFIELD FILE 'EXTENSION)
|
||||
COMPILE.EXT) (* Map compiled file into symbolic
|
||||
name)
|
||||
((MEMB (FILENAMEFIELD FILE 'EXTENSION)
|
||||
*COMPILED-EXTENSIONS*) (* ;
|
||||
"Map compiled file into symbolic name")
|
||||
(SETQ FILE (PACKFILENAME 'EXTENSION NIL 'VERSION NIL 'BODY FILE]
|
||||
(PROG [(FILEDATES (COND
|
||||
[(AND (NULL (FILENAMEFIELD FILE 'VERSION))
|
||||
(CAR (GETPROP (NAMEFIELD FILE)
|
||||
'FILEDATES]
|
||||
([SETQ FILE (COND
|
||||
(ASKFLAG (INFILEP FILE))
|
||||
(T (FINDFILE FILE]
|
||||
(CONS (FILEDATE FILE)
|
||||
FILE]
|
||||
(AND FILEDATES (RETURN (DBFILE1 FILE FILEDATES])
|
||||
(LET [(FILEDATES (COND
|
||||
[(AND (NULL (FILENAMEFIELD FILE 'VERSION))
|
||||
(CAR (GETPROP (NAMEFIELD FILE)
|
||||
'FILEDATES]
|
||||
([SETQ FILE (COND
|
||||
(ASKFLAG (INFILEP FILE))
|
||||
(T (FINDFILE FILE]
|
||||
(CONS (FILEDATE FILE)
|
||||
FILE]
|
||||
(AND FILEDATES (DBFILE1 FILE FILEDATES])
|
||||
|
||||
(DBFILE1
|
||||
[LAMBDA (F FILEDATES) (* jds "25-Sep-86 20:04")
|
||||
|
||||
(* Searches databases based on F to find one that matches FILEDATES.
|
||||
Returns (dbfilename . filedates) if successful.
|
||||
For efficiency, checks the most likely highest version first, before doing the
|
||||
directory enumeration)
|
||||
[LAMBDA (F FILEDATES) (* ; "Edited 24-Oct-2021 15:43 by rmk:")
|
||||
(* jds "25-Sep-86 20:04")
|
||||
|
||||
(PROG ((HIGHEST (INFILEP (PACKFILENAME 'EXTENSION 'DATABASE 'VERSION 'NIL 'BODY F)))
|
||||
DBF)
|
||||
(RETURN (COND
|
||||
((NULL HIGHEST) (* ;
|
||||
"No file matches the name we gave, so punt.")
|
||||
NIL)
|
||||
((SETQ DBF (DBFILE2 HIGHEST FILEDATES)) (* ; "The most recent one matches.")
|
||||
(CONS DBF FILEDATES))
|
||||
(T (* ;
|
||||
"Hunt back thru back versions looking for a matching one.")
|
||||
(for DBF in (REMOVE HIGHEST (FILDIR (PACKFILENAME 'EXTENSION 'DATABASE
|
||||
'VERSION
|
||||
'*
|
||||
'BODY F)))
|
||||
when (SETQ DBF (DBFILE2 DBF FILEDATES))
|
||||
do (RETURN (CONS DBF FILEDATES])
|
||||
(* ;; "Searches databases based on F to find one that matches FILEDATES. Returns (dbfilename . filedates) if successful. For efficiency, checks the most likely highest version first, before doing the directory enumeration")
|
||||
|
||||
(LET ((HIGHEST (INFILEP (PACKFILENAME 'EXTENSION 'DATABASE 'VERSION 'NIL 'BODY F)))
|
||||
DBF)
|
||||
(COND
|
||||
((NULL HIGHEST) (* ;
|
||||
"No file matches the name we gave, so punt.")
|
||||
NIL)
|
||||
((SETQ DBF (DBFILE2 HIGHEST FILEDATES)) (* ; "The most recent one matches.")
|
||||
(CONS DBF FILEDATES))
|
||||
(T (* ;
|
||||
"Hunt back thru back versions looking for a matching one.")
|
||||
(for DBF in (REMOVE HIGHEST (FILDIR (PACKFILENAME 'EXTENSION 'DATABASE
|
||||
'VERSION
|
||||
'*
|
||||
'BODY F)))
|
||||
when (SETQ DBF (DBFILE2 DBF FILEDATES))
|
||||
do (RETURN (CONS DBF FILEDATES])
|
||||
|
||||
(DBFILE2
|
||||
[LAMBDA (DBF FILEDATES) (* ; "Edited 28-Nov-90 12:42 by rmk:")
|
||||
(* T if DBF is the name of the
|
||||
database file matching FILEDATES)
|
||||
[LAMBDA (DBF FILEDATES) (* ;
|
||||
"Edited 24-Oct-2021 20:18 by rmk:")
|
||||
(* ; "Edited 28-Nov-90 12:42 by rmk:")
|
||||
|
||||
(* ;; "Returns an open stream for DBF if it's the name of the database file matching FILEDATES. DBF is positioned after all the header material, and the reader environment is set up for it.")
|
||||
|
||||
[RESETSAVE (SETQ DBF (OPENSTREAM DBF 'INPUT))
|
||||
'(PROGN (CLOSEF? OLDVALUE]
|
||||
(SET-READER-ENVIRONMENT (READ-READER-ENVIRONMENT DBF (MAKE-READER-ENVIRONMENT
|
||||
*NEW-INTERLISP-MAKEFILE-ENVIRONMENT*)
|
||||
)
|
||||
DBF)
|
||||
|
||||
(* The close is done in the LOADDB RESETLST, except when a candidate file isn't
|
||||
correct)
|
||||
(* ;; "Skip the header stuff")
|
||||
|
||||
(SKREAD DBF) (* Skip LOAD error message)
|
||||
(COND
|
||||
([STREQUAL (CAR FILEDATES)
|
||||
(CAR (READ DBF (FIND-READTABLE "INTERLISP"]
|
||||
DBF)
|
||||
(T (CLOSEF DBF)
|
||||
NIL])
|
||||
(CL:WHEN [OR (EQ 0 (GETFILEPTR DBF))
|
||||
(AND [EQ 'FILECREATED (CAR (LISTP (READ DBF]
|
||||
(EQ 'PRETTYCOMPRINT (CAR (LISTP (READ DBF]
|
||||
[EQ 'PROGN (CAR (LISTP (READ DBF]
|
||||
(COND
|
||||
((STREQUAL (CAR FILEDATES)
|
||||
(CAR (READ DBF)))
|
||||
DBF)
|
||||
(T (CLOSEF DBF)
|
||||
NIL)))])
|
||||
|
||||
(LOAD
|
||||
[LAMBDA (FILE LDFLG PRINTFLG) (* lmm "29-APR-81 20:27")
|
||||
@@ -156,88 +161,62 @@ Copyright (c) 1986, 1990, 1991, 1992, 1993 by Xerox Corporation. All rights res
|
||||
(DEFINEQ
|
||||
|
||||
(DUMPDB
|
||||
[LAMBDA (FILE PROPFLG) (* ; "Edited 3-May-93 18:44 by rmk:")
|
||||
[LAMBDA (FILE PROPFLG) (* ;
|
||||
"Edited 27-Oct-2021 10:51 by larry")
|
||||
(* ;
|
||||
"Edited 24-Oct-2021 16:24 by rmk:")
|
||||
|
||||
(* Dumps a Masterscope database for functions in FILE.
|
||||
Checks the DATABASE property if PROPFLG=T which is how the MAKEFILE advice
|
||||
calls it. A user-level call would default PROPFLG to NIL.)
|
||||
(* ;; "Dumps a Masterscope database for functions in FILE. Checks the DATABASE property if PROPFLG=T which is how the MAKEFILE advice calls it. A user-level call would default PROPFLG to NIL.")
|
||||
|
||||
(* The FILE check is because MAKEFILE returns a list when it doesn't understand
|
||||
the options)
|
||||
(* ;;
|
||||
"The FILE check is because MAKEFILE returns a list when it doesn't understand the options")
|
||||
|
||||
(DECLARE (GLOBALVARS MSHASHFILENAME MSFILETABLE SAVEDBFLG))
|
||||
(AND FILE (OR (LITATOM FILE)
|
||||
(STRINGP FILE))
|
||||
(PROG (DBFILE (FL (NAMEFIELD FILE))
|
||||
FNS
|
||||
(FFNS (FILEFNSLST FILE)))
|
||||
(COND
|
||||
(FFNS)
|
||||
((AND MSFILETABLE (TESTTABLE FL (CADR MSFILETABLE)))
|
||||
(* Always dump if this is a known
|
||||
file)
|
||||
(SETQ PROPFLG NIL))
|
||||
(T (COND
|
||||
(PROPFLG (/REMPROP FL 'DATABASE))
|
||||
(T (printout T T FILE " has no functions." T)))
|
||||
(RETURN)))
|
||||
(SETQ FNS FFNS)
|
||||
(COND
|
||||
([OR (NULL PROPFLG)
|
||||
(EQ (GETPROP FL 'DATABASE)
|
||||
'YES)
|
||||
(EQ SAVEDBFLG 'YES)
|
||||
(AND MSFILETABLE (TESTTABLE FL (CADR MSFILETABLE]
|
||||
(* If MSHASH is loaded, only dump
|
||||
functions in the local database)
|
||||
[COND
|
||||
(MSHASHFILENAME (SETQ FNS (for FN in FNS
|
||||
when (PROGN (UPDATEFN FN)
|
||||
(LOCALFNP FN)) collect FN]
|
||||
(RESETLST
|
||||
[RESETSAVE (SETQ DBFILE (OPENSTREAM (PACKFILENAME 'EXTENSION 'DATABASE
|
||||
'VERSION NIL 'BODY FILE)
|
||||
'OUTPUT
|
||||
'NEW))
|
||||
'(PROGN (CLOSEF? OLDVALUE)
|
||||
(AND RESETSTATE (DELFILE OLDVALUE]
|
||||
(RESETSAVE (OUTPUT DBFILE))
|
||||
(RESETSAVE (SETREADTABLE (FIND-READTABLE "INTERLISP")))
|
||||
(RESETSAVE (CL:IN-PACKAGE "INTERLISP")
|
||||
(LIST 'CL:IN-PACKAGE (CL:PACKAGE-NAME *PACKAGE*)))
|
||||
(PRIN1 "(PROGN (PRIN1 %"Use LOADDB to load database files!%
|
||||
%" T) (ERROR!))%
|
||||
"
|
||||
)
|
||||
[AND MSFILETABLE (STORETABLE FL MSFILETABLE (PRINT (CAR (GETPROP FL
|
||||
'FILEDATES]
|
||||
(COND
|
||||
(MSHASHFILENAME (UPDATECONTAINS FL FFNS T)))
|
||||
(* T flag means that the function
|
||||
won't be erased--it might still be
|
||||
interesting)
|
||||
(printout NIL "FNS " .P2 FFNS T) (* So the database file knows which
|
||||
functions are on the file)
|
||||
(COND
|
||||
(FNS (DUMPDATABASE FNS))
|
||||
(T (printout NIL "STOP" T))))
|
||||
[COND
|
||||
(PROPFLG (PRINT (FULLNAME DBFILE)
|
||||
T))
|
||||
(T (/PUT FL 'DATABASEFILENAME DBFILE) (* Remember that we have this file
|
||||
valid already.)
|
||||
(/PUT FL 'DATABASE 'YES] (* Take future note of the databae
|
||||
on a user call)
|
||||
(RETURN (FULLNAME DBFILE])
|
||||
(DECLARE (GLOBALVARS MSFILETABLE SAVEDBFLG))
|
||||
(CL:WHEN (AND FILE (OR (LITATOM FILE)
|
||||
(STRINGP FILE)))
|
||||
(PROG (DBFILE (FL (NAMEFIELD FILE))
|
||||
(FNS (FILEFNSLST FILE)))
|
||||
(COND
|
||||
(FNS)
|
||||
((AND MSFILETABLE (TESTTABLE FL (CADR MSFILETABLE)))
|
||||
(* ;
|
||||
"Always dump if this is a known file")
|
||||
(SETQ PROPFLG NIL))
|
||||
(T (COND
|
||||
(PROPFLG (/REMPROP FL 'DATABASE))
|
||||
(T (printout T T FILE " has no functions." T)))
|
||||
(RETURN)))
|
||||
(CL:WHEN [OR (NULL PROPFLG)
|
||||
(EQ (GETPROP FL 'DATABASE)
|
||||
'YES)
|
||||
(EQ SAVEDBFLG 'YES)
|
||||
(AND MSFILETABLE (TESTTABLE FL (CADR MSFILETABLE]
|
||||
(CL:WHEN MSFILETABLE
|
||||
[STORETABLE FL MSFILETABLE (CAR (GETPROP FL 'FILEDATES])
|
||||
[SETQ DBFILE (PRETTYDEF NIL (PACKFILENAME 'EXTENSION 'DATABASE 'VERSION NIL
|
||||
'BODY FILE)
|
||||
`((P (PROGN (PRIN1 "Use LOADDB to load database files!" T)
|
||||
(ERROR!)))
|
||||
(E [PRINT (CAR (GETPROP ',FILE 'FILEDATES]
|
||||
(DUMPDATABASE ',FNS]
|
||||
[COND
|
||||
(PROPFLG (PRINT (FULLNAME DBFILE)
|
||||
T))
|
||||
(T (/PUT FL 'DATABASEFILENAME DBFILE) (* ;
|
||||
"Remember that we have this file valid already.")
|
||||
(/PUT FL 'DATABASE 'YES] (* ;
|
||||
"Take future note of the databae on a user call")
|
||||
(RETURN DBFILE))))])
|
||||
|
||||
(LOADDB
|
||||
[LAMBDA (FILE ASKFLAG) (* ; "Edited 7-Jul-92 09:57 by rmk:")
|
||||
[LAMBDA (FILE ASKFLAG) (* ; "Edited 24-Oct-2021 17:44 by rmk:")
|
||||
(* ; "Edited 7-Jul-92 09:57 by rmk:")
|
||||
|
||||
(* ;; "Loads the database file corresponding to FILE, asking for confirmation only if ASKFLAG is T, which is the case from the advice on LOAD but not from usual user-level calls. Before asking, it looks around first to see whether a database file of the appropriate name really exists.")
|
||||
(* ;; "Loads the database file corresponding to FILE, asking for confirmation only if ASKFLAG is T, which is the case from the advice on LOAD but not from usual user-level calls. Before asking, it looks around first to see whether a database file of the appropriate name really exists.")
|
||||
|
||||
(DECLARE (GLOBALVARS MSHASHFILENAME MSFILETABLE MSARGTABLE DWIMWAIT LOADDBFLG))
|
||||
(DECLARE (GLOBALVARS MSFILETABLE MSARGTABLE DWIMWAIT LOADDBFLG))
|
||||
(RESETLST
|
||||
[PROG* [TEM NEWFNS FORFILE (*READTABLE* (FIND-READTABLE "INTERLISP"))
|
||||
[PROG* [TEM FORFILE (*READTABLE* (FIND-READTABLE "INTERLISP"))
|
||||
(*PACKAGE* (CL:FIND-PACKAGE "INTERLISP"))
|
||||
(NF (NAMEFIELD FILE))
|
||||
(DBSTREAM (DBFILE FILE ASKFLAG))
|
||||
@@ -253,8 +232,8 @@ Copyright (c) 1986, 1990, 1991, 1992, 1993 by Xerox Corporation. All rights res
|
||||
([COND
|
||||
[ASKFLAG (COND
|
||||
((EQ (GETPROP NF 'DATABASEFILENAME)
|
||||
DBFILE) (* ;
|
||||
"If the database for this very file has already been loaded, don't bother doing it again.")
|
||||
DBFILE) (* ;
|
||||
"If the database for this very file has already been loaded, don't bother doing it again.")
|
||||
(PRINTOUT T "Database " DBFILE " already loaded." T)
|
||||
NIL)
|
||||
(T (SELECTQ (GETPROP NF 'DATABASE)
|
||||
@@ -275,42 +254,37 @@ Copyright (c) 1986, 1990, 1991, 1992, 1993 by Xerox Corporation. All rights res
|
||||
NIL]
|
||||
(T (/PUT NF 'DATABASE 'YES]
|
||||
(LISPXPRINT (FULLNAME DBFILE)
|
||||
T) (* ; "DBSTREAM was opened in DBFILE")
|
||||
T) (* ; "DBSTREAM was opened in DBFILE")
|
||||
(RESETSAVE (INPUT DBSTREAM))
|
||||
[COND
|
||||
((EQ (SETQ TEM (READ))
|
||||
'FNS)
|
||||
(SETQ NEWFNS (READ))
|
||||
(READ) (* ; "Old format: thrown away")
|
||||
(COND
|
||||
((EQ (SETQ TEM (READ))
|
||||
'ARGS)
|
||||
[COND
|
||||
[MSHASHFILENAME (BIND F WHILE (SETQ F (READ))
|
||||
DO (STORETABLE F MSARGTABLE (READ]
|
||||
(T (WHILE (READ]
|
||||
(WHILE (READ))
|
||||
(SETQ TEM (READ]
|
||||
(COND
|
||||
((OR (EQ (CAR (LISTP TEM))
|
||||
'READATABASE)
|
||||
(EQ TEM 'STOP))
|
||||
(COND
|
||||
((NEQ TEM 'STOP) (* ; "It must be (READATABASE)")
|
||||
((NEQ TEM 'STOP) (* ; "It must be (READATABASE)")
|
||||
(READATABASE)))
|
||||
(COND
|
||||
(MSHASHFILENAME (UPDATECONTAINS NF NEWFNS)))
|
||||
(AND MSFILETABLE (STORETABLE NF MSFILETABLE FORFILE))
|
||||
(* ;
|
||||
"This is done whether or not there is a hashfile.")
|
||||
(UPDATEFILES) (* ;
|
||||
"Mark any edited fns as needing to be reanalyzed.")
|
||||
(* ;
|
||||
"This is done whether or not there is a hashfile.")
|
||||
(UPDATEFILES) (* ;
|
||||
"Mark any edited fns as needing to be reanalyzed.")
|
||||
(FOR FN IN (CDR (GETP NF 'FILE))
|
||||
WHEN (OR (EXPRP FN)
|
||||
(GETP FN 'EXPR)) DO (MSMARKCHANGED FN)))
|
||||
(T (PRINTOUT T T DBFILE " is not a database file!" T)
|
||||
(* ; "So that value of LOADDB is NIL")
|
||||
(* ; "So that value of LOADDB is NIL")
|
||||
(SETQ DBFILE NIL)))
|
||||
(/PUT NF 'DATABASEFILENAME DBFILE) (* ;
|
||||
"Remember the name of the database we just loaded.")
|
||||
(/PUT NF 'DATABASEFILENAME DBFILE) (* ;
|
||||
"Remember the name of the database we just loaded.")
|
||||
(RETURN (FULLNAME DBFILE])])
|
||||
|
||||
(MAKEDB
|
||||
@@ -345,14 +319,12 @@ Copyright (c) 1986, 1990, 1991, 1992, 1993 by Xerox Corporation. All rights res
|
||||
|
||||
(ADDTOVAR MAKEFILEFORMS (MAKEDB FILE))
|
||||
|
||||
|
||||
|
||||
(* To permit MSHASH interface)
|
||||
|
||||
|
||||
(RPAQ? MSHASHFILENAME )
|
||||
|
||||
(RPAQ? MSFILETABLE )
|
||||
|
||||
|
||||
|
||||
(* ; "To permit MSHASH interface")
|
||||
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(LOCALVARS . T)
|
||||
@@ -367,7 +339,7 @@ Copyright (c) 1986, 1990, 1991, 1992, 1993 by Xerox Corporation. All rights res
|
||||
)
|
||||
(PUTPROPS DATABASEFNS COPYRIGHT ("Xerox Corporation" 1986 1990 1991 1992 1993))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1637 6218 (DBFILE 1647 . 3295) (DBFILE1 3297 . 4820) (DBFILE2 4822 . 5584) (LOAD 5586
|
||||
. 5816) (LOADFROM 5818 . 6006) (MAKEFILE 6008 . 6216)) (6274 16706 (DUMPDB 6284 . 10572) (LOADDB
|
||||
10574 . 15618) (MAKEDB 15620 . 16704)))))
|
||||
(FILEMAP (NIL (1679 6704 (DBFILE 1689 . 3334) (DBFILE1 3336 . 4846) (DBFILE2 4848 . 6070) (LOAD 6072
|
||||
. 6302) (LOADFROM 6304 . 6492) (MAKEFILE 6494 . 6702)) (6760 15499 (DUMPDB 6770 . 9534) (LOADDB 9536
|
||||
. 14411) (MAKEDB 14413 . 15497)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
155
library/LLCOLOR
155
library/LLCOLOR
@@ -1,15 +1,14 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "10-Jul-92 14:57:14" |{PELE:MV:ENVOS}<LISPCORE>LIBRARY>LLCOLOR.;6| 137483
|
||||
|
||||
changes to%: (VARS LLCOLORCOMS)
|
||||
(MACROS .DRAW4BPPLINEX. .DRAW8BPPLINEX .DRAW24BPPLINEX .DRAW4BPPLINEY.
|
||||
.DRAW8BPPLINEY .DRAW24BPPLINEY)
|
||||
(FILECREATED "26-Oct-2021 10:53:47" {DSK}<home>larry>medley>library>LLCOLOR.;2 137753
|
||||
|
||||
previous date%: "21-Aug-91 12:27:17" |{PELE:MV:ENVOS}<LISPCORE>LIBRARY>LLCOLOR.;5|)
|
||||
changes to%: (FNS \COLORDISPLAYBITS \DRAW8BPPCOLORLINE)
|
||||
|
||||
previous date%: "10-Jul-92 14:57:14" {DSK}<home>larry>medley>library>LLCOLOR.;1)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 by Xerox Corporation. All rights reserved.
|
||||
Copyright (c) 1982-1992 by Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT LLCOLORCOMS)
|
||||
@@ -51,7 +50,7 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b
|
||||
(FNS PSEUDOCOLOR \PSEUDOCOLOR.BITMAP \PSEUDOCOLOR.UFN)
|
||||
(GLOBALVARS \COLORDISPLAYFDEV \COLORDISPLAYBITS ColorScreenBitMap \4COLORMAP \8COLORMAP)
|
||||
(P
|
||||
(* ;; "NOTE: This is very bad. I shouldn't have to and don't really want to do the following, but since about March 86, someone did something really nonstandard wrt Helvetica fonts so that the in core versions are not equal to what is stored on file. The SETFONTDESCRIPTOR and friends undoes this kludge which has never been explained to LISPCORE^ by the person who brain damaged Helvetica this way. If I don't undo this kludge by someone else, then color menus come out wrong. *")
|
||||
(* ;; "NOTE: This is very bad. I shouldn't have to and don't really want to do the following, but since about March 86, someone did something really nonstandard wrt Helvetica fonts so that the in core versions are not equal to what is stored on file. The SETFONTDESCRIPTOR and friends undoes this kludge which has never been explained to LISPCORE^ by the person who brain damaged Helvetica this way. If I don't undo this kludge by someone else, then color menus come out wrong. *")
|
||||
|
||||
(SETFONTDESCRIPTOR 'HELVETICA 10 'MRR 0 'DISPLAY NIL)
|
||||
(SETQ MENUFONT (FONTCREATE 'HELVETICA 10)))
|
||||
@@ -290,7 +289,10 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b
|
||||
ColorScreenBitMap])
|
||||
|
||||
(\COLORDISPLAYBITS
|
||||
[LAMBDA (WIDTH HEIGHT BITSPERPIXEL) (* ; "Edited 31-Oct-89 10:25 by takeshi")
|
||||
[LAMBDA (WIDTH HEIGHT BITSPERPIXEL) (* ;
|
||||
"Edited 26-Oct-2021 10:24 by larry")
|
||||
(* ;
|
||||
"Edited 31-Oct-89 10:25 by takeshi")
|
||||
(* returns a pointer to the bits
|
||||
that the color board needs.)
|
||||
(DECLARE (GLOBALVARS \COLORDISPLAYBITS))
|
||||
@@ -300,8 +302,8 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b
|
||||
(OR (\MAIKO.CGSIXP)
|
||||
(\MAIKO.CGTHREEP)
|
||||
(\MAIKO.CGFOURP)))
|
||||
(PROG [(DUMMY (\ALLOCPAGEBLOCK 1))
|
||||
(ADDROFFSET ((OPCODES SUBRCALL 139 0]
|
||||
(PROG ((DUMMY (\ALLOCPAGEBLOCK 1))
|
||||
(ADDROFFSET (SUBRCALL COLOR-BASE)))
|
||||
(WHILE (NEQ (LOGAND \MAIKO.COLORBUF.ALIGN (IPLUS (\LOLOC DUMMY)
|
||||
ADDROFFSET))
|
||||
0) DO (SETQ DUMMY (\ALLOCPAGEBLOCK 1)))
|
||||
@@ -663,10 +665,13 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b
|
||||
(.DRAW4BPPLINEY. MODE])
|
||||
|
||||
(\DRAW8BPPCOLORLINE
|
||||
[LAMBDA (X0 Y0 XLIMIT YLIMIT DX DY CDL YINC MODE BITMAPBASE RASTERWIDTH COLOR)
|
||||
(* ; "Edited 19-Mar-91 12:46 by matsuda")
|
||||
((OPCODES SUBRCALL 143 12)
|
||||
X0 Y0 XLIMIT YLIMIT DX DY CDL YINC MODE BITMAPBASE RASTERWIDTH COLOR])
|
||||
[LAMBDA (X0 Y0 XLIMIT YLIMIT DX DY CDL YINC MODE BITMAPBASE RASTERWIDTH COLOR)
|
||||
(* ;
|
||||
"Edited 26-Oct-2021 10:25 by larry")
|
||||
(* ;
|
||||
"Edited 19-Mar-91 12:46 by matsuda")
|
||||
(SUBRCALL COLOR-8BPPDRAWLINE X0 Y0 XLIMIT YLIMIT DX DY CDL YINC MODE BITMAPBASE RASTERWIDTH COLOR
|
||||
])
|
||||
|
||||
(\DRAW24BPPCOLORLINE
|
||||
[LAMBDA (X0 Y0 XLIMIT YLIMIT DX DY CDL YINC MODE BITMAPBASE RASTERWIDTH COLOR)
|
||||
@@ -705,7 +710,7 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b
|
||||
[(MODE)
|
||||
(PROG (INSIDEBITS OUTSIDEBITS)
|
||||
(until (IGREATERP X0 XLIMIT)
|
||||
do (* main loop)
|
||||
do (* main loop)
|
||||
(SETQ INSIDEBITS (LOGAND MASK (fetch (BITMAPWORD BITS) of MAPPTR)))
|
||||
(SETQ OUTSIDEBITS (LOGAND (LOGNOT MASK)
|
||||
(fetch (BITMAPWORD BITS) of MAPPTR)))
|
||||
@@ -717,9 +722,9 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b
|
||||
OUTSIDEBITS))
|
||||
(PAINT (LOGOR (LOGOR COLORMASK INSIDEBITS)
|
||||
OUTSIDEBITS))
|
||||
(PROGN (* case is REPLACE.
|
||||
Legality of OPERATION has been
|
||||
checked by \CLIPANDDRAWLINE1)
|
||||
(PROGN (* case is REPLACE.
|
||||
Legality of OPERATION has been
|
||||
checked by \CLIPANDDRAWLINE1)
|
||||
(LOGOR COLORMASK OUTSIDEBITS]
|
||||
[COND
|
||||
([NOT (IGREATERP DX (SETQ CDL (IPLUS CDL DY]
|
||||
@@ -732,7 +737,7 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b
|
||||
YINC]
|
||||
[COND
|
||||
[(ZEROP (SETQ MASK (LRSH MASK 4)))
|
||||
(* crossed word boundary)
|
||||
(* crossed word boundary)
|
||||
[SETQ MAPPTR (\ADDBASE BITMAPBASE (SETQ WORDOFFSET (ADD1 WORDOFFSET]
|
||||
(SETQ COLORMASK COLORMASKORG)
|
||||
(SETQ MASK (CONSTANT (\4BITMASK 0]
|
||||
@@ -744,7 +749,7 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b
|
||||
(COND
|
||||
((EQ STARTBYTE 1)
|
||||
(GO 1LP)))
|
||||
0LP (* main loop)
|
||||
0LP (* main loop)
|
||||
(\PUTBASEBYTE MAPPTR 0
|
||||
(SELECTQ MODE
|
||||
(ERASE (LOGAND COLOR (\GETBASEBYTE MAPPTR 0)
|
||||
@@ -753,9 +758,9 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b
|
||||
)))
|
||||
(PAINT (LOGOR COLOR (\GETBASEBYTE MAPPTR 0)))
|
||||
(PROGN
|
||||
(* case is REPLACE.
|
||||
Legality of OPERATION has been
|
||||
checked by \CLIPANDDRAWLINE1)
|
||||
(* case is REPLACE.
|
||||
Legality of OPERATION has been
|
||||
checked by \CLIPANDDRAWLINE1)
|
||||
COLOR)))
|
||||
[COND
|
||||
([NOT (IGREATERP DX (SETQ CDL (IPLUS CDL DY]
|
||||
@@ -779,9 +784,9 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b
|
||||
)))
|
||||
(PAINT (LOGOR COLOR (\GETBASEBYTE MAPPTR 1)))
|
||||
(PROGN
|
||||
(* case is REPLACE.
|
||||
Legality of OPERATION has been
|
||||
checked by \CLIPANDDRAWLINE1)
|
||||
(* case is REPLACE.
|
||||
Legality of OPERATION has been
|
||||
checked by \CLIPANDDRAWLINE1)
|
||||
COLOR)))
|
||||
[COND
|
||||
([NOT (IGREATERP DX (SETQ CDL (IPLUS CDL DY]
|
||||
@@ -802,7 +807,7 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b
|
||||
(GO 0LP))))
|
||||
|
||||
(PUTPROPS .DRAW24BPPLINEX MACRO ((MODE)
|
||||
(PROG NIL (* main loop)
|
||||
(PROG NIL (* main loop)
|
||||
LP (\PUTBASE24 MAPPTR 0
|
||||
(SELECTQ MODE
|
||||
(ERASE (LOGAND COLOR (\GETBASE24 MAPPTR
|
||||
@@ -812,9 +817,9 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b
|
||||
(PAINT (LOGOR COLOR (\GETBASE24 MAPPTR
|
||||
0)))
|
||||
(PROGN
|
||||
(* case is REPLACE.
|
||||
Legality of OPERATION has been
|
||||
checked by \CLIPANDDRAWLINE1)
|
||||
(* case is REPLACE.
|
||||
Legality of OPERATION has been
|
||||
checked by \CLIPANDDRAWLINE1)
|
||||
COLOR)))
|
||||
[COND
|
||||
([NOT (IGREATERP DX (SETQ CDL (IPLUS CDL DY]
|
||||
@@ -838,7 +843,7 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b
|
||||
[(MODE)
|
||||
(PROG (INSIDEBITS OUTSIDEBITS)
|
||||
(until (IGREATERP Y0 YLIMIT)
|
||||
do (* main loop)
|
||||
do (* main loop)
|
||||
(SETQ INSIDEBITS (LOGAND MASK (fetch (BITMAPWORD BITS) of MAPPTR)))
|
||||
(SETQ OUTSIDEBITS (LOGAND (LOGNOT MASK)
|
||||
(fetch (BITMAPWORD BITS) of MAPPTR)))
|
||||
@@ -850,9 +855,9 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b
|
||||
OUTSIDEBITS))
|
||||
(PAINT (LOGOR (LOGOR COLORMASK INSIDEBITS)
|
||||
OUTSIDEBITS))
|
||||
(PROGN (* case is REPLACE.
|
||||
Legality of OPERATION has been
|
||||
checked by \CLIPANDDRAWLINE1)
|
||||
(PROGN (* case is REPLACE.
|
||||
Legality of OPERATION has been
|
||||
checked by \CLIPANDDRAWLINE1)
|
||||
(LOGOR COLORMASK OUTSIDEBITS]
|
||||
[COND
|
||||
([NOT (IGREATERP DY (SETQ CDL (IPLUS CDL DX]
|
||||
@@ -863,7 +868,7 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b
|
||||
(SETQ CDL (IDIFFERENCE CDL DY))
|
||||
(COND
|
||||
[(ZEROP (SETQ MASK (LRSH MASK 4)))
|
||||
(* crossed word boundary)
|
||||
(* crossed word boundary)
|
||||
[SETQ MAPPTR (\ADDBASE BITMAPBASE (SETQ WORDOFFSET (ADD1 WORDOFFSET
|
||||
]
|
||||
(SETQ COLORMASK COLORMASKORG)
|
||||
@@ -877,7 +882,7 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b
|
||||
(COND
|
||||
((EQ STARTBYTE 1)
|
||||
(GO 1LP)))
|
||||
0LP (* main loop)
|
||||
0LP (* main loop)
|
||||
(\PUTBASEBYTE MAPPTR 0
|
||||
(SELECTQ MODE
|
||||
(ERASE (LOGAND COLOR (\GETBASEBYTE MAPPTR 0)
|
||||
@@ -886,9 +891,9 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b
|
||||
)))
|
||||
(PAINT (LOGOR COLOR (\GETBASEBYTE MAPPTR 0)))
|
||||
(PROGN
|
||||
(* case is REPLACE.
|
||||
Legality of OPERATION has been
|
||||
checked by \CLIPANDDRAWLINE1)
|
||||
(* case is REPLACE.
|
||||
Legality of OPERATION has been
|
||||
checked by \CLIPANDDRAWLINE1)
|
||||
COLOR)))
|
||||
(COND
|
||||
((IGREATERP (SETQ Y0 (ADD1 Y0))
|
||||
@@ -899,8 +904,8 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b
|
||||
YINC]
|
||||
(COND
|
||||
([NOT (IGREATERP DY (SETQ CDL (IPLUS CDL DX]
|
||||
(* moved enough in Y to move a point
|
||||
in X)
|
||||
(* moved enough in Y to move a point
|
||||
in X)
|
||||
(COND
|
||||
((IGREATERP (SETQ X0 (ADD1 X0))
|
||||
XLIMIT)
|
||||
@@ -916,9 +921,9 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b
|
||||
)))
|
||||
(PAINT (LOGOR COLOR (\GETBASEBYTE MAPPTR 1)))
|
||||
(PROGN
|
||||
(* case is REPLACE.
|
||||
Legality of OPERATION has been
|
||||
checked by \CLIPANDDRAWLINE1)
|
||||
(* case is REPLACE.
|
||||
Legality of OPERATION has been
|
||||
checked by \CLIPANDDRAWLINE1)
|
||||
COLOR)))
|
||||
(COND
|
||||
((IGREATERP (SETQ Y0 (ADD1 Y0))
|
||||
@@ -929,8 +934,8 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b
|
||||
YINC]
|
||||
(COND
|
||||
([NOT (IGREATERP DY (SETQ CDL (IPLUS CDL DX]
|
||||
(* moved enough in Y to move a point
|
||||
in X)
|
||||
(* moved enough in Y to move a point
|
||||
in X)
|
||||
(COND
|
||||
((IGREATERP (SETQ X0 (ADD1 X0))
|
||||
XLIMIT)
|
||||
@@ -947,7 +952,7 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b
|
||||
(COND
|
||||
((EQ STARTBYTE 1)
|
||||
(GO 1LP)))
|
||||
0LP (* main loop)
|
||||
0LP (* main loop)
|
||||
(\PUTBASEBYTE MAPPTR 0
|
||||
(SELECTQ MODE
|
||||
(ERASE (LOGAND COLOR (\GETBASEBYTE MAPPTR 0
|
||||
@@ -957,9 +962,9 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b
|
||||
(PAINT (LOGOR COLOR (\GETBASEBYTE MAPPTR 0)
|
||||
))
|
||||
(PROGN
|
||||
(* case is REPLACE.
|
||||
Legality of OPERATION has been
|
||||
checked by \CLIPANDDRAWLINE1)
|
||||
(* case is REPLACE.
|
||||
Legality of OPERATION has been
|
||||
checked by \CLIPANDDRAWLINE1)
|
||||
COLOR)))
|
||||
(COND
|
||||
((IGREATERP (SETQ Y0 (ADD1 Y0))
|
||||
@@ -970,8 +975,8 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b
|
||||
YINC]
|
||||
(COND
|
||||
([NOT (IGREATERP DY (SETQ CDL (IPLUS CDL DX]
|
||||
(* moved enough in Y to move a point
|
||||
in X)
|
||||
(* moved enough in Y to move a point
|
||||
in X)
|
||||
(COND
|
||||
((IGREATERP (SETQ X0 (ADD1 X0))
|
||||
XLIMIT)
|
||||
@@ -988,9 +993,9 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b
|
||||
(PAINT (LOGOR COLOR (\GETBASEBYTE MAPPTR 1)
|
||||
))
|
||||
(PROGN
|
||||
(* case is REPLACE.
|
||||
Legality of OPERATION has been
|
||||
checked by \CLIPANDDRAWLINE1)
|
||||
(* case is REPLACE.
|
||||
Legality of OPERATION has been
|
||||
checked by \CLIPANDDRAWLINE1)
|
||||
COLOR)))
|
||||
(COND
|
||||
((IGREATERP (SETQ Y0 (ADD1 Y0))
|
||||
@@ -1001,8 +1006,8 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b
|
||||
YINC]
|
||||
(COND
|
||||
([NOT (IGREATERP DY (SETQ CDL (IPLUS CDL DX]
|
||||
(* moved enough in Y to move a point
|
||||
in X)
|
||||
(* moved enough in Y to move a point
|
||||
in X)
|
||||
(COND
|
||||
((IGREATERP (SETQ X0 (ADD1 X0))
|
||||
XLIMIT)
|
||||
@@ -2211,7 +2216,7 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b
|
||||
)
|
||||
|
||||
|
||||
(* ;; "NOTE: This is very bad. I shouldn't have to and don't really want to do the following, but since about March 86, someone did something really nonstandard wrt Helvetica fonts so that the in core versions are not equal to what is stored on file. The SETFONTDESCRIPTOR and friends undoes this kludge which has never been explained to LISPCORE^ by the person who brain damaged Helvetica this way. If I don't undo this kludge by someone else, then color menus come out wrong. *")
|
||||
(* ;; "NOTE: This is very bad. I shouldn't have to and don't really want to do the following, but since about March 86, someone did something really nonstandard wrt Helvetica fonts so that the in core versions are not equal to what is stored on file. The SETFONTDESCRIPTOR and friends undoes this kludge which has never been explained to LISPCORE^ by the person who brain damaged Helvetica this way. If I don't undo this kludge by someone else, then color menus come out wrong. *")
|
||||
|
||||
|
||||
(SETFONTDESCRIPTOR 'HELVETICA 10 'MRR 0 'DISPLAY NIL)
|
||||
@@ -2228,22 +2233,22 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b
|
||||
(PUTPROPS LLCOLOR COPYRIGHT ("Xerox Corporation" 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991
|
||||
1992))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3539 21062 (COLORDISPLAY 3549 . 6952) (COLORMAPBITS 6954 . 7111) (
|
||||
\CreateColorScreenBitMap 7113 . 8484) (\CREATECOLORDISPLAYFDEV 8486 . 9444) (COLORMAP 9446 . 10860) (
|
||||
COLORMAPCOPY 10862 . 11382) (SCREENCOLORMAP 11384 . 11578) (SCREENCOLORMAPENTRY 11580 . 11807) (
|
||||
ROTATECOLORMAP 11809 . 12701) (RGBCOLORMAP 12703 . 14841) (CMYCOLORMAP 14843 . 15333) (GRAYCOLORMAP
|
||||
15335 . 16293) (COLORSCREENBITMAP 16295 . 16533) (\COLORDISPLAYBITS 16535 . 19180) (COLORSCREEN 19182
|
||||
. 19310) (SHOWCOLORTESTPATTERN 19312 . 21060)) (21101 21732 (\STARTCOLOR 21111 . 21249) (\STOPCOLOR
|
||||
21251 . 21387) (\SENDCOLORMAPENTRY 21389 . 21730)) (21733 27692 (COLORMAPCREATE 21743 . 22729) (
|
||||
COLORLEVEL 22731 . 23712) (COLORNUMBERP 23714 . 25298) (COLORFROMRGB 25300 . 26482) (
|
||||
INTENSITIESFROMCOLORMAP 26484 . 26869) (SETCOLORINTENSITY 26871 . 27690)) (27693 33530 (\FAST8BIT
|
||||
27703 . 31402) (\MAP4 31404 . 32283) (\MAP8 32285 . 33528)) (33531 34438 (\GETCOLORBRUSH 33541 . 34436
|
||||
)) (34439 38686 (\DRAWCOLORLINE1 34449 . 35191) (\DRAW4BPPCOLORLINE 35193 . 36838) (\DRAW8BPPCOLORLINE
|
||||
36840 . 37160) (\DRAW24BPPCOLORLINE 37162 . 38684)) (62183 120797 (\BWTOCOLORBLT 62193 . 70344) (
|
||||
\4BITLINEBLT 70346 . 104918) (\8BITLINEBLT 104920 . 113861) (\24BITLINEBLT 113863 . 114646) (
|
||||
\GETBASE24 114648 . 116106) (\PUTBASE24 116108 . 117716) (COLORTEXTUREFROMCOLOR# 117718 . 120341) (
|
||||
\BITMAPWORD 120343 . 120795)) (120798 126101 (COLORIZEBITMAP 120808 . 121783) (UNCOLORIZEBITMAP 121785
|
||||
. 126099)) (126189 129506 (COLORMENU 126199 . 129118) (CURSORCOLOR 129120 . 129504)) (132029 136501 (
|
||||
PSEUDOCOLOR 132039 . 134952) (\PSEUDOCOLOR.BITMAP 134954 . 135183) (\PSEUDOCOLOR.UFN 135185 . 136499))
|
||||
(FILEMAP (NIL (3332 21090 (COLORDISPLAY 3342 . 6745) (COLORMAPBITS 6747 . 6904) (
|
||||
\CreateColorScreenBitMap 6906 . 8277) (\CREATECOLORDISPLAYFDEV 8279 . 9237) (COLORMAP 9239 . 10653) (
|
||||
COLORMAPCOPY 10655 . 11175) (SCREENCOLORMAP 11177 . 11371) (SCREENCOLORMAPENTRY 11373 . 11600) (
|
||||
ROTATECOLORMAP 11602 . 12494) (RGBCOLORMAP 12496 . 14634) (CMYCOLORMAP 14636 . 15126) (GRAYCOLORMAP
|
||||
15128 . 16086) (COLORSCREENBITMAP 16088 . 16326) (\COLORDISPLAYBITS 16328 . 19208) (COLORSCREEN 19210
|
||||
. 19338) (SHOWCOLORTESTPATTERN 19340 . 21088)) (21129 21760 (\STARTCOLOR 21139 . 21277) (\STOPCOLOR
|
||||
21279 . 21415) (\SENDCOLORMAPENTRY 21417 . 21758)) (21761 27720 (COLORMAPCREATE 21771 . 22757) (
|
||||
COLORLEVEL 22759 . 23740) (COLORNUMBERP 23742 . 25326) (COLORFROMRGB 25328 . 26510) (
|
||||
INTENSITIESFROMCOLORMAP 26512 . 26897) (SETCOLORINTENSITY 26899 . 27718)) (27721 33558 (\FAST8BIT
|
||||
27731 . 31430) (\MAP4 31432 . 32311) (\MAP8 32313 . 33556)) (33559 34466 (\GETCOLORBRUSH 33569 . 34464
|
||||
)) (34467 38956 (\DRAWCOLORLINE1 34477 . 35219) (\DRAW4BPPCOLORLINE 35221 . 36866) (\DRAW8BPPCOLORLINE
|
||||
36868 . 37430) (\DRAW24BPPCOLORLINE 37432 . 38954)) (62453 121067 (\BWTOCOLORBLT 62463 . 70614) (
|
||||
\4BITLINEBLT 70616 . 105188) (\8BITLINEBLT 105190 . 114131) (\24BITLINEBLT 114133 . 114916) (
|
||||
\GETBASE24 114918 . 116376) (\PUTBASE24 116378 . 117986) (COLORTEXTUREFROMCOLOR# 117988 . 120611) (
|
||||
\BITMAPWORD 120613 . 121065)) (121068 126371 (COLORIZEBITMAP 121078 . 122053) (UNCOLORIZEBITMAP 122055
|
||||
. 126369)) (126459 129776 (COLORMENU 126469 . 129388) (CURSORCOLOR 129390 . 129774)) (132299 136771 (
|
||||
PSEUDOCOLOR 132309 . 135222) (\PSEUDOCOLOR.BITMAP 135224 . 135453) (\PSEUDOCOLOR.UFN 135455 . 136769))
|
||||
)))
|
||||
STOP
|
||||
|
||||
@@ -1,14 +1,20 @@
|
||||
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
|
||||
(FILECREATED "23-Oct-91 14:43:35" |{PELE:MV:ENVOS}<LISPCORE>LIBRARY>MAIKOCOLOR.;6| 57582
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "26-Oct-2021 10:53:57" {DSK}<home>larry>medley>library>MAIKOCOLOR.;2 60141
|
||||
|
||||
changes to%: (VARS MAIKOCOLORCOMS)
|
||||
(FNS \MAIKOCOLOR.EVENTFN)
|
||||
(MACROS \MAIKO.CGTHREEP \MAIKO.CGFOURP \MAIKO.CGSIXP \MAIKO.CGTWOP)
|
||||
(FNS \MAIKO.COLORINIT \MAIKO.STARTCOLOR \MAIKO.STOPCOLOR \MAIKOCOLOR.EVENTFN
|
||||
\MAIKO.SENDCOLORMAPENTRY \MAIKO.CHANGESCREEN CURSOREXIT CURSORSCREEN
|
||||
WARPCURSOR \SLOWBLTCHAR \SOFTCURSORUP \BITBLT.DISPLAY \PUNT.SLOWBLTCHAR
|
||||
\PUNT.BLTSHADE.BITMAP \PUNT.BITBLT.BITMAP BITMAPOBJ.SNAPW \MAIKO.PUNTBLTCHAR
|
||||
\MAIKO.BLTCHAR)
|
||||
|
||||
previous date%: "22-Aug-91 17:11:25" |{PELE:MV:ENVOS}<LISPCORE>LIBRARY>MAIKOCOLOR.;3|)
|
||||
previous date%: "23-Oct-91 14:43:35" {DSK}<home>larry>medley>library>MAIKOCOLOR.;1)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1988, 1989, 1990, 1991 by Fuji Xerox Co., Ltd.. All rights reserved.
|
||||
Copyright (c) 1988-1991 by Fuji Xerox Co., Ltd..
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT MAIKOCOLORCOMS)
|
||||
@@ -63,8 +69,9 @@ Copyright (c) 1988, 1989, 1990, 1991 by Fuji Xerox Co., Ltd.. All rights reserv
|
||||
|
||||
(\MAIKO.COLORINIT
|
||||
[LAMBDA NIL
|
||||
(DECLARE (GLOBALVARS \MAIKOCOLORWSOPS \MAIKOCOLORINFO))
|
||||
(* ; "Edited 28-Apr-89 16:51 by tshimizu.fx")
|
||||
(DECLARE (GLOBALVARS \MAIKOCOLORWSOPS \MAIKOCOLORINFO))
|
||||
(* ;
|
||||
"Edited 28-Apr-89 16:51 by tshimizu.fx")
|
||||
(SETQ \MAIKOCOLORWSOPS (create WSOPS
|
||||
STARTBOARD _ (FUNCTION NILL)
|
||||
STARTCOLOR _ (FUNCTION \MAIKO.STARTCOLOR)
|
||||
@@ -82,7 +89,10 @@ Copyright (c) 1988, 1989, 1990, 1991 by Fuji Xerox Co., Ltd.. All rights reserv
|
||||
(\DEFINEDISPLAYINFO \MAIKOCOLORINFO])
|
||||
|
||||
(\MAIKO.STARTCOLOR
|
||||
[LAMBDA (FDEV) (* ; "Edited 2-Nov-88 11:13 by shimizu")
|
||||
[LAMBDA (FDEV) (* ;
|
||||
"Edited 26-Oct-2021 10:17 by larry")
|
||||
(* ;
|
||||
"Edited 2-Nov-88 11:13 by shimizu")
|
||||
(PROG (DISPLAYSTATE)
|
||||
(SETQ DISPLAYSTATE (fetch (FDEV DEVICEINFO) of FDEV))
|
||||
(replace (DISPLAYSTATE ONOFF) of DISPLAYSTATE with 'STARTCOLOR)
|
||||
@@ -90,19 +100,19 @@ Copyright (c) 1988, 1989, 1990, 1991 by Fuji Xerox Co., Ltd.. All rights reserv
|
||||
|
||||
(* ;; " MMAP colorbuffer")
|
||||
|
||||
((OPCODES SUBRCALL 136 1)
|
||||
(FETCH (BITMAP BITMAPBASE) OF ColorScreenBitMap))
|
||||
(SUBRCALL COLOR-INIT (FETCH (BITMAP BITMAPBASE) OF ColorScreenBitMap))
|
||||
(replace (DISPLAYSTATE ONOFF) of DISPLAYSTATE with 'ON])
|
||||
|
||||
(\MAIKO.STOPCOLOR
|
||||
[LAMBDA (FDEV) (* ; "Edited 28-Apr-89 16:51 by tshimizu.fx")
|
||||
[LAMBDA (FDEV) (* ;
|
||||
"Edited 28-Apr-89 16:51 by tshimizu.fx")
|
||||
(* ; "By Take")
|
||||
(PROG (DISPLAYSTATE)
|
||||
(SETQ DISPLAYSTATE (fetch (FDEV DEVICEINFO) of FDEV))
|
||||
(replace (DISPLAYSTATE ONOFF) of DISPLAYSTATE with 'OFF])
|
||||
|
||||
(\MAIKOCOLOR.EVENTFN
|
||||
[LAMBDA (FDEV EVENT) (* ; "Edited 23-Oct-91 14:18 by jds")
|
||||
[LAMBDA (FDEV EVENT) (* ; "Edited 23-Oct-91 14:18 by jds")
|
||||
(COND
|
||||
((EQ (fetch (DISPLAYSTATE ONOFF) of (fetch (FDEV DEVICEINFO) of FDEV))
|
||||
'ON)
|
||||
@@ -117,22 +127,26 @@ Copyright (c) 1988, 1989, 1990, 1991 by Fuji Xerox Co., Ltd.. All rights reserv
|
||||
NIL])
|
||||
|
||||
(\MAIKO.SENDCOLORMAPENTRY
|
||||
[LAMBDA (FDEV COLOR# RGB) (* ; "Edited 1-Dec-88 18:16 by shimizu")
|
||||
((OPCODES SUBRCALL 138 4)
|
||||
COLOR#
|
||||
(CAR RGB)
|
||||
(CADR RGB)
|
||||
(CADDR RGB])
|
||||
[LAMBDA (FDEV COLOR# RGB) (* ;
|
||||
"Edited 26-Oct-2021 10:17 by larry")
|
||||
(* ;
|
||||
"Edited 1-Dec-88 18:16 by shimizu")
|
||||
(SUBRCALL COLOR-MAP COLOR# (CAR RGB)
|
||||
(CADR RGB)
|
||||
(CADDR RGB])
|
||||
|
||||
(\MAIKO.CHANGESCREEN
|
||||
[LAMBDA (TOSCREEN) (* ; "Edited 1-Dec-88 18:32 by shimizu")
|
||||
((OPCODES SUBRCALL 137 1)
|
||||
TOSCREEN])
|
||||
[LAMBDA (TOSCREEN) (* ;
|
||||
"Edited 26-Oct-2021 10:18 by larry")
|
||||
(* ;
|
||||
"Edited 1-Dec-88 18:32 by shimizu")
|
||||
(SUBRCALL COLOR-SCREENMODE TOSCREEN])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(CURSOREXIT
|
||||
[LAMBDA NIL (* ; "Edited 11-Aug-89 13:16 by takeshi")
|
||||
[LAMBDA NIL (* ;
|
||||
"Edited 11-Aug-89 13:16 by takeshi")
|
||||
|
||||
(* * called when cursor moves off the screen edge)
|
||||
|
||||
@@ -160,7 +174,8 @@ Copyright (c) 1988, 1989, 1990, 1991 by Fuji Xerox Co., Ltd.. All rights reserv
|
||||
(CURSORSCREEN SCREEN2 XCOORD2 YCOORD2])
|
||||
|
||||
(CURSORSCREEN
|
||||
[LAMBDA (SCREEN XCOORD YCOORD) (* ; "Edited 19-Jun-90 16:33 by matsuda")
|
||||
[LAMBDA (SCREEN XCOORD YCOORD) (* ;
|
||||
"Edited 19-Jun-90 16:33 by matsuda")
|
||||
|
||||
(* * sets up SCREEN to be the current screen, XCOORD %, YCOORD is initial pos
|
||||
of cursor on SCREEN)
|
||||
@@ -201,7 +216,8 @@ Copyright (c) 1988, 1989, 1990, 1991 by Fuji Xerox Co., Ltd.. All rights reserv
|
||||
(CLEARW W))])
|
||||
|
||||
(WARPCURSOR
|
||||
[LAMBDA (ENABLE) (* ; "Edited 20-Jul-90 19:02 by matsuda")
|
||||
[LAMBDA (ENABLE) (* ;
|
||||
"Edited 20-Jul-90 19:02 by matsuda")
|
||||
(COND
|
||||
(ENABLE (MOVD 'SAVE.CURSOREXIT 'CURSOREXIT)
|
||||
T)
|
||||
@@ -209,12 +225,15 @@ Copyright (c) 1988, 1989, 1990, 1991 by Fuji Xerox Co., Ltd.. All rights reserv
|
||||
NIL])
|
||||
|
||||
(\SLOWBLTCHAR
|
||||
[LAMBDA (CHARCODE DISPLAYSTREAM) (* ; "Edited 7-Jun-90 14:06 by matsuda")
|
||||
((OPCODES SUBRCALL 140 2)
|
||||
CHARCODE DISPLAYSTREAM])
|
||||
[LAMBDA (CHARCODE DISPLAYSTREAM) (* ;
|
||||
"Edited 26-Oct-2021 10:19 by larry")
|
||||
(* ;
|
||||
"Edited 7-Jun-90 14:06 by matsuda")
|
||||
(SUBRCALL C-SlowBltChar CHARCODE DISPLAYSTREAM])
|
||||
|
||||
(\SOFTCURSORUP
|
||||
[LAMBDA (NEWCURSOR) (* ; "Edited 16-Jan-89 15:44 by shimizu")
|
||||
[LAMBDA (NEWCURSOR) (* ;
|
||||
"Edited 16-Jan-89 15:44 by shimizu")
|
||||
(* Put soft NEWCURSOR up, assuming
|
||||
soft cursor is down.
|
||||
*)
|
||||
@@ -290,7 +309,8 @@ Copyright (c) 1988, 1989, 1990, 1991 by Fuji Xerox Co., Ltd.. All rights reserv
|
||||
(\BITBLT.DISPLAY
|
||||
[LAMBDA (SOURCEBITMAP SOURCELEFT SOURCEBOTTOM DESTSTRM DESTINATIONLEFT DESTINATIONBOTTOM WIDTH
|
||||
HEIGHT SOURCETYPE OPERATION TEXTURE CLIPPINGREGION CLIPPEDSOURCELEFT
|
||||
CLIPPEDSOURCEBOTTOM) (* ; "Edited 24-Jan-91 11:57 by matsuda")
|
||||
CLIPPEDSOURCEBOTTOM) (* ;
|
||||
"Edited 24-Jan-91 11:57 by matsuda")
|
||||
(DECLARE (LOCALVARS . T))
|
||||
(DECLARE (GLOBALVARS \SYSPILOTBBT \SCREENBITMAPS \BBSCRATCHTEXTURE \SOFTCURSORP
|
||||
\SOFTCURSORUPP \CURSORDESTINATION))
|
||||
@@ -454,7 +474,8 @@ Copyright (c) 1988, 1989, 1990, 1991 by Fuji Xerox Co., Ltd.. All rights reserv
|
||||
(DEFINEQ
|
||||
|
||||
(\PUNT.SLOWBLTCHAR
|
||||
[LAMBDA (CHARCODE DISPLAYSTREAM) (* ; "Edited 2-Jul-90 14:23 by matsuda")
|
||||
[LAMBDA (CHARCODE DISPLAYSTREAM) (* ;
|
||||
"Edited 2-Jul-90 14:23 by matsuda")
|
||||
|
||||
(* ;; "case of BLTCHAR where either font is rotated or destination is a color bitmap. DISPLAYSTREAM is known to be a display stream, and its cache fields have been updated for CHARCODE's charset")
|
||||
|
||||
@@ -535,7 +556,10 @@ Copyright (c) 1988, 1989, 1990, 1991 by Fuji Xerox Co., Ltd.. All rights reserv
|
||||
(T (ERROR "Not implemented to rotate by other than 0, 90 or 270"])
|
||||
|
||||
(\MAIKO.PUNTBLTCHAR
|
||||
[LAMBDA (CHARCODE DISPLAYSTREAM DISPLAYDATA) (* ; "Edited 1-Nov-89 15:26 by takeshi")
|
||||
[LAMBDA (CHARCODE DISPLAYSTREAM DISPLAYDATA) (* ;
|
||||
"Edited 26-Oct-2021 10:21 by larry")
|
||||
(* ;
|
||||
"Edited 1-Nov-89 15:26 by takeshi")
|
||||
|
||||
(* ;; "puts a character on a display stream. This function will be called when \maiko.bltchar failed. Punt from subr call")
|
||||
|
||||
@@ -598,20 +622,23 @@ Copyright (c) 1988, 1989, 1990, 1991 by Fuji Xerox Co., Ltd.. All rights reserv
|
||||
DDPILOTBBT)
|
||||
of DISPLAYDATA)))
|
||||
0)))
|
||||
(.WHILE.TOP.DS. DISPLAYSTREAM ((OPCODES SUBRCALL 70 6)
|
||||
LOCAL1 DISPLAYDATA CHAR8CODE CURX LEFT RIGHT))
|
||||
(.WHILE.TOP.DS. DISPLAYSTREAM (SUBRCALL BLTCHAR LOCAL1 DISPLAYDATA CHAR8CODE
|
||||
CURX LEFT RIGHT))
|
||||
T])
|
||||
|
||||
(\MAIKO.BLTCHAR
|
||||
[LAMBDA (CHARCODE DISPLAYSTREAM DISPLAYDATA) (* ; "Edited 6-Jul-90 10:14 by matsuda")
|
||||
((OPCODES SUBRCALL 135 3)
|
||||
CHARCODE DISPLAYSTREAM DISPLAYDATA])
|
||||
[LAMBDA (CHARCODE DISPLAYSTREAM DISPLAYDATA) (* ;
|
||||
"Edited 26-Oct-2021 10:22 by larry")
|
||||
(* ;
|
||||
"Edited 6-Jul-90 10:14 by matsuda")
|
||||
(SUBRCALL NEW-BLTCHAR CHARCODE DISPLAYSTREAM DISPLAYDATA])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(\PUNT.BLTSHADE.BITMAP
|
||||
[LAMBDA (TEXTURE DESTINATIONBITMAP DESTINATIONLEFT DESTINATIONBOTTOM WIDTH HEIGHT OPERATION
|
||||
CLIPPINGREGION) (* ; "Edited 5-Jun-90 12:12 by Takeshi")
|
||||
CLIPPINGREGION) (* ;
|
||||
"Edited 5-Jun-90 12:12 by Takeshi")
|
||||
|
||||
(* ;; "This FNS is for a punt case of \BLTSHADE.BITMAP which is implemeted in C ")
|
||||
(* ;
|
||||
@@ -718,7 +745,8 @@ Copyright (c) 1988, 1989, 1990, 1991 by Fuji Xerox Co., Ltd.. All rights reserv
|
||||
(\PUNT.BITBLT.BITMAP
|
||||
[LAMBDA (SOURCEBITMAP SOURCELEFT SOURCEBOTTOM DESTBITMAP DESTINATIONLEFT DESTINATIONBOTTOM WIDTH
|
||||
HEIGHT SOURCETYPE OPERATION TEXTURE CLIPPINGREGION CLIPPEDSOURCELEFT
|
||||
CLIPPEDSOURCEBOTTOM) (* ; "Edited 5-Jun-90 11:59 by Takeshi")
|
||||
CLIPPEDSOURCEBOTTOM) (* ;
|
||||
"Edited 5-Jun-90 11:59 by Takeshi")
|
||||
|
||||
(* ;; " This FNS is for a punt case of \BITBLT.BITMAP which is implemeted in C")
|
||||
|
||||
@@ -858,7 +886,8 @@ Copyright (c) 1988, 1989, 1990, 1991 by Fuji Xerox Co., Ltd.. All rights reserv
|
||||
(DEFINEQ
|
||||
|
||||
(BITMAPOBJ.SNAPW
|
||||
[LAMBDA NIL (* ; "Edited 12-Apr-90 09:09 by matsuda")
|
||||
[LAMBDA NIL (* ;
|
||||
"Edited 12-Apr-90 09:09 by matsuda")
|
||||
|
||||
(* * makes an image object of a prompted for region of the screen.)
|
||||
|
||||
@@ -962,11 +991,11 @@ Copyright (c) 1988, 1989, 1990, 1991 by Fuji Xerox Co., Ltd.. All rights reserv
|
||||
)
|
||||
(PUTPROPS MAIKOCOLOR COPYRIGHT ("Fuji Xerox Co., Ltd." 1988 1989 1990 1991))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (2782 5984 (\MAIKO.COLORINIT 2792 . 3962) (\MAIKO.STARTCOLOR 3964 . 4559) (
|
||||
\MAIKO.STOPCOLOR 4561 . 4945) (\MAIKOCOLOR.EVENTFN 4947 . 5578) (\MAIKO.SENDCOLORMAPENTRY 5580 . 5805)
|
||||
(\MAIKO.CHANGESCREEN 5807 . 5982)) (5985 26414 (CURSOREXIT 5995 . 7433) (CURSORSCREEN 7435 . 9475) (
|
||||
WARPCURSOR 9477 . 9726) (\SLOWBLTCHAR 9728 . 9910) (\SOFTCURSORUP 9912 . 15707) (\BITBLT.DISPLAY 15709
|
||||
. 26412)) (26485 37922 (\PUNT.SLOWBLTCHAR 26495 . 33267) (\MAIKO.PUNTBLTCHAR 33269 . 37722) (
|
||||
\MAIKO.BLTCHAR 37724 . 37920)) (37923 54124 (\PUNT.BLTSHADE.BITMAP 37933 . 44959) (\PUNT.BITBLT.BITMAP
|
||||
44961 . 54122)) (54125 54867 (BITMAPOBJ.SNAPW 54135 . 54865)))))
|
||||
(FILEMAP (NIL (3229 7254 (\MAIKO.COLORINIT 3239 . 4475) (\MAIKO.STARTCOLOR 4477 . 5293) (
|
||||
\MAIKO.STOPCOLOR 5295 . 5749) (\MAIKOCOLOR.EVENTFN 5751 . 6382) (\MAIKO.SENDCOLORMAPENTRY 6384 . 6842)
|
||||
(\MAIKO.CHANGESCREEN 6844 . 7252)) (7255 28244 (CURSOREXIT 7265 . 8769) (CURSORSCREEN 8771 . 10877) (
|
||||
WARPCURSOR 10879 . 11194) (\SLOWBLTCHAR 11196 . 11608) (\SOFTCURSORUP 11610 . 17471) (\BITBLT.DISPLAY
|
||||
17473 . 28242)) (28315 40283 (\PUNT.SLOWBLTCHAR 28325 . 35163) (\MAIKO.PUNTBLTCHAR 35165 . 39855) (
|
||||
\MAIKO.BLTCHAR 39857 . 40281)) (40284 56617 (\PUNT.BLTSHADE.BITMAP 40294 . 47386) (\PUNT.BITBLT.BITMAP
|
||||
47388 . 56615)) (56618 57426 (BITMAPOBJ.SNAPW 56628 . 57424)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,10 +1,10 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "20-Sep-2021 11:37:28" {DSK}<home>larry>medley>lispusers>BACKGROUND-YIELD.;3 1644
|
||||
|
||||
changes to%: (FNS BACKGROUND-YIELD)
|
||||
(VARS BACKGROUND-YIELDCOMS)
|
||||
(FILECREATED "14-Nov-2021 22:05:58" {DSK}<home>larry>medley>lispusers>BACKGROUND-YIELD.;2 1597
|
||||
|
||||
previous date%: "19-Sep-2021 13:37:10" {DSK}<home>larry>medley>lispusers>BACKGROUND-YIELD.;1)
|
||||
changes to%: (VARS BACKGROUND-YIELD)
|
||||
|
||||
previous date%: "20-Sep-2021 11:37:28" {DSK}<home>larry>medley>lispusers>BACKGROUND-YIELD.;1)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT BACKGROUND-YIELDCOMS)
|
||||
@@ -44,7 +44,7 @@
|
||||
(INIT-YIELD T)
|
||||
)
|
||||
|
||||
(RPAQQ BACKGROUND-YIELD 8333330)
|
||||
(RPAQQ BACKGROUND-YIELD 833333)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (879 1528 (BACKGROUND-YIELD 889 . 1144) (INIT-YIELD 1146 . 1526)))))
|
||||
(FILEMAP (NIL (833 1482 (BACKGROUND-YIELD 843 . 1098) (INIT-YIELD 1100 . 1480)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
207
lispusers/TMAX
207
lispusers/TMAX
@@ -1,22 +1,26 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "19-May-99 08:41:45" {DSK}<project>medley3.5>lispusers>TMAX.;5 28668
|
||||
|
||||
changes to%: (MACROS MAKE.XREFOBJ.IMAGEFNS)
|
||||
(FILECREATED "24-Oct-2021 23:45:20"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>TMAX.;4 31402
|
||||
|
||||
previous date%: "18-May-99 22:44:24" {DSK}<project>medley3.5>lispusers>TMAX.;3)
|
||||
changes to%: (VARS TMAXCOMS)
|
||||
(FNS GET.TSP.FONT.FAMILY)
|
||||
|
||||
previous date%: "24-Oct-2021 22:06:32"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>TMAX.;2)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1987, 1997, 1999 by Stanford University. All rights reserved.
|
||||
Copyright (c) 1987, 1997, 1999 by Stanford University.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT TMAXCOMS)
|
||||
|
||||
(RPAQQ TMAXCOMS
|
||||
( (* ;
|
||||
"Developed under support from NIH grant RR-00785.")
|
||||
(* ;
|
||||
"Written by Frank Gilmurray and Sami Shaio.")
|
||||
( (* ;
|
||||
"Developed under support from NIH grant RR-00785.")
|
||||
(* ;
|
||||
"Written by Frank Gilmurray and Sami Shaio.")
|
||||
(FILES (COMPILED SYSLOAD)
|
||||
TEDIT FREEMENU)
|
||||
(VARS TMAX.FILE.LIST)
|
||||
@@ -27,38 +31,38 @@ Copyright (c) 1987, 1997, 1999 by Stanford University. All rights reserved.
|
||||
(P (DOFILESLOAD TMAX.FILE.LIST))
|
||||
|
||||
|
||||
(* ;;; "Free Menu data structures")
|
||||
(* ;;; "Free Menu data structures")
|
||||
|
||||
(VARS TSP.FM.DESC IMAGEOBJ.MENU.ITEMS)
|
||||
|
||||
|
||||
(* ;;; "Free Menu functions")
|
||||
(* ;;; "Free Menu functions")
|
||||
|
||||
(FNS TSP.DISPLAY.FMMENU TSP.SETUP.FILENAMES TSP.SETUP.FMMENU TSP.FMMENU TSP.FM.APPLY
|
||||
UPDATE.ALL DOWNDATE.ALL TSP.FUNCTION.HOOKS TSP.GETFN TSP.PUTFN)
|
||||
|
||||
|
||||
(* ;;; "Free Menu toggle functions")
|
||||
(* ;;; "Free Menu toggle functions")
|
||||
|
||||
(FNS AutoUpdate.TOGGLE UPDATE? NGROUP.Menu.TOGGLE NGROUPMENU.ENABLED?
|
||||
NGROUP.Text-Before.TOGGLE TEXTBEFORE.ENABLED? NGROUP.Text-After.TOGGLE
|
||||
TEXTAFTER.ENABLED? Manual.Index.TOGGLE MANUALINDEX.ENABLED?)
|
||||
|
||||
|
||||
(* ;;; "TSP font stuff")
|
||||
(* ;;; "TSP font stuff")
|
||||
|
||||
(FNS GET.TSP.FONT GET.TSP.FONT.FAMILY GET.TSP.FONT.SIZE GET.TSP.FONT.FACE ABBREVIATE.FONT
|
||||
TMAX.SHADEOBJ)
|
||||
|
||||
|
||||
(* ;;; "Collect ImageObjects")
|
||||
(* ;;; "Collect ImageObjects")
|
||||
|
||||
(FNS TSP.LIST.OF.OBJECTS)
|
||||
(GLOBALVARS GP.DefaultFont GP.DefaultShade)
|
||||
(MACROS MAKE.DATEOBJ.IMAGEFNS MAKE.NUMBEROBJ.IMAGEFNS MAKE.REGMARKOBJ.IMAGEFNS
|
||||
MAKE.XREFOBJ.IMAGEFNS)
|
||||
(VARS (GP.DefaultFont (FONTCREATE 'GACHA 10))
|
||||
(GP.DefaultShade 10260)
|
||||
(VARS (GP.DefaultFont (FONTCREATE 'TERMINAL 10))
|
||||
(GP.DefaultShade 1024)
|
||||
(\NUMBEROBJ.IMAGEFNS (MAKE.NUMBEROBJ.IMAGEFNS))
|
||||
(\DATEOBJ.IMAGEFNS (MAKE.DATEOBJ.IMAGEFNS))
|
||||
(\REGMARKOBJ.IMAGEFNS (MAKE.REGMARKOBJ.IMAGEFNS))
|
||||
@@ -134,7 +138,7 @@ Copyright (c) 1987, 1997, 1999 by Stanford University. All rights reserved.
|
||||
(LABEL "Known References" ID KNOWNREF SELECTEDFN TSP.FM.APPLY)
|
||||
(LABEL "Reference By" TYPE STATE MENUITEMS (Ask Value Page)
|
||||
INITSTATE Value LINKS (DISPLAY DEFAULTREF))
|
||||
(LABEL "" TYPE DISPLAY ID DEFAULTREF FONT (GACHA 10 MRR)))
|
||||
(LABEL "" TYPE DISPLAY ID DEFAULTREF FONT (TERMINAL 10 MRR)))
|
||||
((LABEL "Endnotes:" TYPE DISPLAY FONT (NIL NIL MRR))
|
||||
(LABEL "Endnote" ID ENDNOTE SELECTEDFN TSP.FM.APPLY)
|
||||
(LABEL "Insert Endnotes" ID INSERTNOTE SELECTEDFN TSP.FM.APPLY)
|
||||
@@ -150,7 +154,7 @@ Copyright (c) 1987, 1997, 1999 by Stanford University. All rights reserved.
|
||||
(LABEL "Create TOC" ID CREATETOC SELECTEDFN TSP.FM.APPLY)
|
||||
(LABEL "View TOC" ID VIEWTOC SELECTEDFN TSP.FM.APPLY)
|
||||
(LABEL "TOC Filename:" TYPE EDITSTART LINKS (EDIT TOC.FILE))
|
||||
(LABEL "" TYPE EDIT ID TOC.FILE FONT (GACHA 10 MRR)))
|
||||
(LABEL "" TYPE EDIT ID TOC.FILE FONT (TERMINAL 10 MRR)))
|
||||
((LABEL "Indices:" TYPE DISPLAY FONT (NIL NIL MRR))
|
||||
(LABEL "Index" ID INDEX SELECTEDFN TSP.FM.APPLY)
|
||||
(LABEL "Extended Index" ID XTNDINDEX SELECTEDFN TSP.FM.APPLY)
|
||||
@@ -160,7 +164,7 @@ Copyright (c) 1987, 1997, 1999 by Stanford University. All rights reserved.
|
||||
(LABEL "Create Index" ID CREATEINDEX SELECTEDFN TSP.FM.APPLY)
|
||||
(LABEL "View Index" ID VIEWINDEX SELECTEDFN TSP.FM.APPLY)
|
||||
(LABEL "Index Filename:" TYPE EDITSTART LINKS (EDIT INDEX.FILE))
|
||||
(LABEL "" TYPE EDIT ID INDEX.FILE FONT (GACHA 10 MRR])
|
||||
(LABEL "" TYPE EDIT ID INDEX.FILE FONT (TERMINAL 10 MRR])
|
||||
|
||||
(RPAQQ IMAGEOBJ.MENU.ITEMS
|
||||
((UPDATE (UPDATE.ALL TSTREAM TWINDOW))
|
||||
@@ -430,14 +434,17 @@ Copyright (c) 1987, 1997, 1999 by Stanford University. All rights reserved.
|
||||
(LIST FAMILY SIZE (FONTPROP NEWENTRY.FONT 'FACE])
|
||||
|
||||
(GET.TSP.FONT.FAMILY
|
||||
[LAMBDA (DEFAULT.FONT) (* fsg " 8-Jul-87 15:44")
|
||||
(* * Get the font family from the menu or DEFAULT.FONT if the menu returns NIL.)
|
||||
[LAMBDA (DEFAULT.FONT) (* ; "Edited 24-Oct-2021 23:39 by rmk:")
|
||||
(* fsg " 8-Jul-87 15:44")
|
||||
|
||||
(* * Get the font family from the menu or DEFAULT.FONT if the menu returns NIL.)
|
||||
|
||||
(OR [MKATOM (MENU (create MENU
|
||||
TITLE _ "Font Family"
|
||||
CENTERFLG _ T
|
||||
ITEMS _ '((Classic 'CLASSIC)
|
||||
(Gacha 'GACHA)
|
||||
(Terminal 'TERMINAL)
|
||||
(Helvetica 'HELVETICA)
|
||||
(Modern 'MODERN)
|
||||
(TimesRoman 'TIMESROMAN]
|
||||
@@ -468,10 +475,12 @@ Copyright (c) 1987, 1997, 1999 by Stanford University. All rights reserved.
|
||||
(FONTPROP DEFAULT.FONT 'FACE])
|
||||
|
||||
(ABBREVIATE.FONT
|
||||
[LAMBDA (FONT) (* fsg " 8-Jul-87 15:57")
|
||||
(* * Returns an abbreviated font description.
|
||||
For example, if the font is (TIMESROMAN 12
|
||||
(BOLD REGULAR REGULAR)) then the list (TimesRoman 12 Bold) is returned.)
|
||||
[LAMBDA (FONT) (* ; "Edited 24-Oct-2021 22:05 by rmk:")
|
||||
(* fsg " 8-Jul-87 15:57")
|
||||
|
||||
(* * Returns an abbreviated font description.
|
||||
For example, if the font is (TIMESROMAN 12
|
||||
(BOLD REGULAR REGULAR)) then the list (TimesRoman 12 Bold) is returned.)
|
||||
|
||||
(LET [(FONT.LIST (COND
|
||||
[(FONTP FONT)
|
||||
@@ -482,13 +491,15 @@ Copyright (c) 1987, 1997, 1999 by Stanford University. All rights reserved.
|
||||
(LIST (LET ((FONT.FAMILY (CAR FONT.LIST)))
|
||||
(SELECTQ FONT.FAMILY
|
||||
(CLASSIC 'Classic)
|
||||
(TERMINAL 'Terminal)
|
||||
(GACHA 'Gacha)
|
||||
(HELVETICA 'Helvetica)
|
||||
(MODERN 'Modern)
|
||||
(TIMESROMAN 'TimesRoman)
|
||||
FONT.FAMILY))
|
||||
(CADR FONT.LIST)
|
||||
(LET [(FONT.FACE (CONCATLIST (for FIELD in (CADDR FONT.LIST) collect (GNC FIELD]
|
||||
(LET [(FONT.FACE (CONCATLIST (for FIELD in (CADDR FONT.LIST)
|
||||
collect (GNC FIELD]
|
||||
(SELECTQ (MKATOM FONT.FACE)
|
||||
(MRR 'Standard)
|
||||
(MIR 'Italic)
|
||||
@@ -497,10 +508,10 @@ Copyright (c) 1987, 1997, 1999 by Stanford University. All rights reserved.
|
||||
FONT.FACE])
|
||||
|
||||
(TMAX.SHADEOBJ
|
||||
[LAMBDA (OBJ STREAM SHADE) (* ; "Edited 26-Jan-97 14:07 by rmk:")
|
||||
(* fsg "17-Sep-87 11:25")
|
||||
[LAMBDA (OBJ STREAM SHADE) (* ; "Edited 26-Jan-97 14:07 by rmk:")
|
||||
(* fsg "17-Sep-87 11:25")
|
||||
|
||||
(* ;; "Shade the ImageObject to distinguish it from normal text.")
|
||||
(* ;; "Shade the ImageObject to distinguish it from normal text.")
|
||||
|
||||
(AND (IMAGESTREAMTYPEP STREAM 'DISPLAY)
|
||||
(LET [(BOUNDBOX (IMAGEOBJPROP OBJ 'BOUNDBOX]
|
||||
@@ -543,74 +554,70 @@ Copyright (c) 1987, 1997, 1999 by Stanford University. All rights reserved.
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS MAKE.DATEOBJ.IMAGEFNS MACRO
|
||||
[LAMBDA NIL
|
||||
(IMAGEFNSCREATE (FUNCTION DATE.DISPLAYFN)
|
||||
(FUNCTION DATE.IMAGEBOXFN)
|
||||
(FUNCTION DATE.PUTFN)
|
||||
(FUNCTION DATE.GETFN)
|
||||
(FUNCTION DATE.COPYFN)
|
||||
(FUNCTION DATE.BUTTONEVENTINFN)
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION NILL])
|
||||
(PUTPROPS MAKE.DATEOBJ.IMAGEFNS MACRO [LAMBDA NIL
|
||||
(IMAGEFNSCREATE (FUNCTION DATE.DISPLAYFN)
|
||||
(FUNCTION DATE.IMAGEBOXFN)
|
||||
(FUNCTION DATE.PUTFN)
|
||||
(FUNCTION DATE.GETFN)
|
||||
(FUNCTION DATE.COPYFN)
|
||||
(FUNCTION DATE.BUTTONEVENTINFN)
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION NILL])
|
||||
|
||||
(PUTPROPS MAKE.NUMBEROBJ.IMAGEFNS MACRO
|
||||
[LAMBDA NIL
|
||||
(IMAGEFNSCREATE (FUNCTION NUMBER.DISPLAYFN)
|
||||
(FUNCTION NUMBER.IMAGEBOXFN)
|
||||
(FUNCTION NUMBER.PUTFN)
|
||||
(FUNCTION NUMBER.GETFN)
|
||||
(FUNCTION NUMBER.COPYFN)
|
||||
(FUNCTION NUMBER.BUTTONEVENTINFN)
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION XREF.WHENDELETEDFN)
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION NUMBER.PREPRINTFN])
|
||||
(PUTPROPS MAKE.NUMBEROBJ.IMAGEFNS MACRO [LAMBDA NIL
|
||||
(IMAGEFNSCREATE (FUNCTION NUMBER.DISPLAYFN)
|
||||
(FUNCTION NUMBER.IMAGEBOXFN)
|
||||
(FUNCTION NUMBER.PUTFN)
|
||||
(FUNCTION NUMBER.GETFN)
|
||||
(FUNCTION NUMBER.COPYFN)
|
||||
(FUNCTION NUMBER.BUTTONEVENTINFN)
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION XREF.WHENDELETEDFN)
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION NUMBER.PREPRINTFN])
|
||||
|
||||
(PUTPROPS MAKE.REGMARKOBJ.IMAGEFNS MACRO
|
||||
[LAMBDA NIL
|
||||
(IMAGEFNSCREATE (FUNCTION REGMARK.DISPLAYFN)
|
||||
(FUNCTION REGMARK.IMAGEBOXFN)
|
||||
(FUNCTION REGMARK.PUTFN)
|
||||
(FUNCTION REGMARK.GETFN)
|
||||
(FUNCTION REGMARK.COPYFN)
|
||||
(FUNCTION REGMARK.BUTTONEVENTINFN)
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION NILL])
|
||||
(PUTPROPS MAKE.REGMARKOBJ.IMAGEFNS MACRO [LAMBDA NIL
|
||||
(IMAGEFNSCREATE (FUNCTION REGMARK.DISPLAYFN)
|
||||
(FUNCTION REGMARK.IMAGEBOXFN)
|
||||
(FUNCTION REGMARK.PUTFN)
|
||||
(FUNCTION REGMARK.GETFN)
|
||||
(FUNCTION REGMARK.COPYFN)
|
||||
(FUNCTION REGMARK.BUTTONEVENTINFN)
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION NILL])
|
||||
|
||||
(PUTPROPS MAKE.XREFOBJ.IMAGEFNS MACRO
|
||||
[LAMBDA NIL
|
||||
(IMAGEFNSCREATE (FUNCTION XREF.DISPLAYFN)
|
||||
(FUNCTION XREF.IMAGEBOXFN)
|
||||
(FUNCTION XREF.PUTFN)
|
||||
(FUNCTION XREF.GETFN)
|
||||
(FUNCTION XREF.COPYFN)
|
||||
(FUNCTION XREF.BUTTONEVENTINFN)
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION XREF.GET.DISPLAY.TEXT])
|
||||
(PUTPROPS MAKE.XREFOBJ.IMAGEFNS MACRO [LAMBDA NIL
|
||||
(IMAGEFNSCREATE (FUNCTION XREF.DISPLAYFN)
|
||||
(FUNCTION XREF.IMAGEBOXFN)
|
||||
(FUNCTION XREF.PUTFN)
|
||||
(FUNCTION XREF.GETFN)
|
||||
(FUNCTION XREF.COPYFN)
|
||||
(FUNCTION XREF.BUTTONEVENTINFN)
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION XREF.GET.DISPLAY.TEXT])
|
||||
)
|
||||
|
||||
(RPAQ GP.DefaultFont (FONTCREATE 'GACHA 10))
|
||||
(RPAQ GP.DefaultFont (FONTCREATE 'TERMINAL 10))
|
||||
|
||||
(RPAQQ GP.DefaultShade 10260)
|
||||
(RPAQQ GP.DefaultShade 1024)
|
||||
|
||||
(RPAQ \NUMBEROBJ.IMAGEFNS (MAKE.NUMBEROBJ.IMAGEFNS))
|
||||
|
||||
@@ -643,14 +650,14 @@ Copyright (c) 1987, 1997, 1999 by Stanford University. All rights reserved.
|
||||
(TSP.FUNCTION.HOOKS)
|
||||
(PUTPROPS TMAX COPYRIGHT ("Stanford University" 1987 1997 1999))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (8744 15959 (TSP.DISPLAY.FMMENU 8754 . 9319) (TSP.SETUP.FILENAMES 9321 . 10572) (
|
||||
TSP.SETUP.FMMENU 10574 . 11034) (TSP.FMMENU 11036 . 12222) (TSP.FM.APPLY 12224 . 12543) (UPDATE.ALL
|
||||
12545 . 13217) (DOWNDATE.ALL 13219 . 13589) (TSP.FUNCTION.HOOKS 13591 . 15021) (TSP.GETFN 15023 .
|
||||
15583) (TSP.PUTFN 15585 . 15957)) (16005 18254 (AutoUpdate.TOGGLE 16015 . 16251) (UPDATE? 16253 .
|
||||
16398) (NGROUP.Menu.TOGGLE 16400 . 16782) (NGROUPMENU.ENABLED? 16784 . 17020) (
|
||||
NGROUP.Text-Before.TOGGLE 17022 . 17272) (TEXTBEFORE.ENABLED? 17274 . 17437) (NGROUP.Text-After.TOGGLE
|
||||
17439 . 17687) (TEXTAFTER.ENABLED? 17689 . 17850) (Manual.Index.TOGGLE 17852 . 18091) (
|
||||
MANUALINDEX.ENABLED? 18093 . 18252)) (18288 23401 (GET.TSP.FONT 18298 . 19462) (GET.TSP.FONT.FAMILY
|
||||
19464 . 20147) (GET.TSP.FONT.SIZE 20149 . 20637) (GET.TSP.FONT.FACE 20639 . 21338) (ABBREVIATE.FONT
|
||||
21340 . 22649) (TMAX.SHADEOBJ 22651 . 23399)) (23441 24657 (TSP.LIST.OF.OBJECTS 23451 . 24655)))))
|
||||
(FILEMAP (NIL (8815 16030 (TSP.DISPLAY.FMMENU 8825 . 9390) (TSP.SETUP.FILENAMES 9392 . 10643) (
|
||||
TSP.SETUP.FMMENU 10645 . 11105) (TSP.FMMENU 11107 . 12293) (TSP.FM.APPLY 12295 . 12614) (UPDATE.ALL
|
||||
12616 . 13288) (DOWNDATE.ALL 13290 . 13660) (TSP.FUNCTION.HOOKS 13662 . 15092) (TSP.GETFN 15094 .
|
||||
15654) (TSP.PUTFN 15656 . 16028)) (16076 18325 (AutoUpdate.TOGGLE 16086 . 16322) (UPDATE? 16324 .
|
||||
16469) (NGROUP.Menu.TOGGLE 16471 . 16853) (NGROUPMENU.ENABLED? 16855 . 17091) (
|
||||
NGROUP.Text-Before.TOGGLE 17093 . 17343) (TEXTBEFORE.ENABLED? 17345 . 17508) (NGROUP.Text-After.TOGGLE
|
||||
17510 . 17758) (TEXTAFTER.ENABLED? 17760 . 17921) (Manual.Index.TOGGLE 17923 . 18162) (
|
||||
MANUALINDEX.ENABLED? 18164 . 18323)) (18359 23832 (GET.TSP.FONT 18369 . 19533) (GET.TSP.FONT.FAMILY
|
||||
19535 . 20383) (GET.TSP.FONT.SIZE 20385 . 20873) (GET.TSP.FONT.FACE 20875 . 21574) (ABBREVIATE.FONT
|
||||
21576 . 23076) (TMAX.SHADEOBJ 23078 . 23830)) (23872 25088 (TSP.LIST.OF.OBJECTS 23882 . 25086)))))
|
||||
STOP
|
||||
|
||||
@@ -1,39 +1,54 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
|
||||
(filecreated "12-Mar-88 15:42:46" {erinyes}<lispusers>lyric>tmax-date.\;2 15254
|
||||
|
||||
|changes| |to:| (fns current.display.font)
|
||||
(FILECREATED "24-Oct-2021 13:52:22"
|
||||
|{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>TMAX-DATE.;4| 14231
|
||||
|
||||
|previous| |date:| "30-Dec-87 11:39:18" {erinyes}<lispusers>lyric>tmax-date.\;1)
|
||||
|changes| |to:| (FNS FINDMONTH FINDTIME FINDHOUR AMPM CHANGE.DATE.FORMAT FINDYEAR)
|
||||
(VARS TMAX-DATECOMS)
|
||||
|
||||
|previous| |date:| "12-Mar-88 15:42:46"
|
||||
|{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>TMAX-DATE.;1|)
|
||||
|
||||
|
||||
; Copyright (c) 1987, 1988 by Xerox Corporation. All rights reserved.
|
||||
; Copyright (c) 1987-1988 by Xerox Corporation.
|
||||
|
||||
(prettycomprint tmax-datecoms)
|
||||
(PRETTYCOMPRINT TMAX-DATECOMS)
|
||||
|
||||
(rpaqq tmax-datecoms ((* |Developed| |under| |support| |from| nih |grant| rr-00785.)
|
||||
(* |Written| |by| |Frank| |Gilmurray| |and| |Sami| |Shaio.|)
|
||||
(* * tmax-datenil |ImageObject| |functions|)
|
||||
(fns dateobj dateobjp date.displayfn date.imageboxfn date.putfn date.getfn
|
||||
date.copyfn date.buttoneventinfn)
|
||||
(* * |Date| |support| |functions|)
|
||||
(fns current.display.font change.date.format)
|
||||
(* * |Functions| |to| |change| |date| |format|)
|
||||
(fns findtime findhour ampm findday nump findmonth findyear)
|
||||
(vars date.format.items)
|
||||
(records daterecord)))
|
||||
(RPAQQ TMAX-DATECOMS
|
||||
(
|
||||
(* |;;| "Developed under support from NIH grant RR-00785. Written by Frank Gilmurray and Sami Shaio. Updated by Ron Kaplan (2021)")
|
||||
|
||||
|
||||
|
||||
(* |;;;| "TMAX-DATE ImageObject functions")
|
||||
|
||||
(FNS DATEOBJ DATEOBJP DATE.DISPLAYFN DATE.IMAGEBOXFN DATE.PUTFN DATE.GETFN DATE.COPYFN
|
||||
DATE.BUTTONEVENTINFN)
|
||||
|
||||
|
||||
(* |;;;| "Date support functions")
|
||||
|
||||
(FNS CURRENT.DISPLAY.FONT CHANGE.DATE.FORMAT)
|
||||
|
||||
|
||||
(* |;;;| "Functions to change date format")
|
||||
|
||||
(FNS FINDTIME FINDHOUR AMPM FINDDAY NUMP FINDMONTH FINDYEAR)
|
||||
(VARS DATE.FORMAT.ITEMS)
|
||||
(DECLARE\: DOEVAL@COMPILE DONTCOPY (RECORDS DATERECORD))))
|
||||
|
||||
|
||||
|
||||
(* |Developed| |under| |support| |from| nih |grant| rr-00785.)
|
||||
(* |;;|
|
||||
"Developed under support from NIH grant RR-00785. Written by Frank Gilmurray and Sami Shaio. Updated by Ron Kaplan (2021)"
|
||||
)
|
||||
|
||||
|
||||
|
||||
|
||||
(* |Written| |by| |Frank| |Gilmurray| |and| |Sami| |Shaio.|)
|
||||
(* |;;;| "TMAX-DATE ImageObject functions")
|
||||
|
||||
(* * tmax-datenil |ImageObject| |functions|)
|
||||
|
||||
(defineq
|
||||
(DEFINEQ
|
||||
|
||||
(dateobj
|
||||
(lambda (date/time date.string template) (* |fsg| "13-Jul-87 11:51")
|
||||
@@ -126,9 +141,12 @@
|
||||
template.date)))))
|
||||
'changed))))))
|
||||
)
|
||||
(* * |Date| |support| |functions|)
|
||||
|
||||
(defineq
|
||||
|
||||
|
||||
(* |;;;| "Date support functions")
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(current.display.font
|
||||
(lambda (stream) (* \; "Edited 12-Mar-88 15:28 by drc:")
|
||||
@@ -144,123 +162,103 @@
|
||||
(|fetch| displayfd |of| current.font))
|
||||
(t (shouldnt "Can't get current font"))))))
|
||||
|
||||
(change.date.format
|
||||
(lambda (date template) (* |ss:| "27-Jun-87 15:36")
|
||||
(* * |Convert| |the| |string| date |to| |the| |format| |specified| |by|
|
||||
template.)
|
||||
(CHANGE.DATE.FORMAT
|
||||
(LAMBDA (DATE TEMPLATE) (* \;
|
||||
"Edited 24-Oct-2021 13:47 by rmk:")
|
||||
(* |ss:| "27-Jun-87 15:36")
|
||||
|
||||
(cond
|
||||
(template (let ((version (|if| (equal (last template)
|
||||
'(a))
|
||||
|then| 'abbrev
|
||||
|else| (|if| (equal (last template)
|
||||
'(f))
|
||||
|then| 'full
|
||||
|else| 'euro)))
|
||||
(funclst '((d findday)
|
||||
(m findmonth)
|
||||
(y findyear))))
|
||||
(cond
|
||||
((eq (car template)
|
||||
t)
|
||||
(findtime date version))
|
||||
(t (let ((ch (|if| (eq version 'abbrev)
|
||||
(* |;;;| "Convert the string DATE to the format specified by TEMPLATE.")
|
||||
|
||||
(COND
|
||||
(TEMPLATE (LET ((VERSION (SELECTQ (CAR (LAST TEMPLATE))
|
||||
(A 'ABBREV)
|
||||
(F 'FULL)
|
||||
'EURO))
|
||||
(FUNCLST '((D FINDDAY)
|
||||
(M FINDMONTH)
|
||||
(Y FINDYEAR))))
|
||||
(COND
|
||||
((EQ T (CAR TEMPLATE))
|
||||
(FINDTIME DATE VERSION))
|
||||
(T (LET ((CH (|if| (EQ VERSION 'ABBREV)
|
||||
|then| "/"
|
||||
|else| " ")))
|
||||
(concat (apply (cadr (assoc (car template)
|
||||
funclst))
|
||||
(list date version))
|
||||
ch
|
||||
(apply (cadr (assoc (cadr template)
|
||||
funclst))
|
||||
(list date version))
|
||||
(|if| (equal ch " ")
|
||||
(CONCAT (APPLY (CADR (ASSOC (CAR TEMPLATE)
|
||||
FUNCLST))
|
||||
(LIST DATE VERSION))
|
||||
CH
|
||||
(APPLY (CADR (ASSOC (CADR TEMPLATE)
|
||||
FUNCLST))
|
||||
(LIST DATE VERSION))
|
||||
(|if| (EQUAL CH " ")
|
||||
|then| ", "
|
||||
|else| ch)
|
||||
(apply (cadr (assoc (caddr template)
|
||||
funclst))
|
||||
(list date version))))))))
|
||||
(t (date)))))
|
||||
|else| CH)
|
||||
(APPLY (CADR (ASSOC (CADDR TEMPLATE)
|
||||
FUNCLST))
|
||||
(LIST DATE VERSION))))))))
|
||||
(T (DATE)))))
|
||||
)
|
||||
(* * |Functions| |to| |change| |date| |format|)
|
||||
|
||||
(defineq
|
||||
|
||||
(findtime
|
||||
(lambda (olddate version) (* |ss:| "27-Jun-87 15:40")
|
||||
(let ((hour (substring olddate 11 12))
|
||||
(minutes (substring olddate 14 15)))
|
||||
(|if| (equal version 'abbrev)
|
||||
|then| (concat (findhour hour)
|
||||
":" minutes " " (ampm hour))
|
||||
|else| (|if| (equal version 'euro)
|
||||
|then| (substring olddate 11 15)
|
||||
|else| (concat (selectq (|if| (lessp (mkatom minutes)
|
||||
46)
|
||||
|then| (mkatom (findhour hour))
|
||||
|else| (plus 1 (mkatom (findhour hour))))
|
||||
(1 "one")
|
||||
(2 "two")
|
||||
(3 "three")
|
||||
(4 "four")
|
||||
(5 "five")
|
||||
(6 "six")
|
||||
(7 "seven")
|
||||
(8 "eight")
|
||||
(9 "nine")
|
||||
(10 "ten")
|
||||
(11 "eleven")
|
||||
(12 "twelve")
|
||||
nil)
|
||||
" "
|
||||
(|if| (and (greaterp (mkatom minutes)
|
||||
15)
|
||||
(lessp (mkatom minutes)
|
||||
45))
|
||||
|then| "thirty"
|
||||
|else| "o'clock")
|
||||
" "
|
||||
(|if| (and (greaterp (mkatom minutes)
|
||||
44)
|
||||
(equal (findhour hour)
|
||||
"11"))
|
||||
|then| (|if| (equal (ampm hour)
|
||||
"a.m.")
|
||||
|then| "p.m."
|
||||
|else| "a.m.")
|
||||
|else| (ampm hour))))))))
|
||||
|
||||
(findhour
|
||||
(lambda (hour) (* |ss:| " 8-Feb-86 17:49")
|
||||
(cond
|
||||
((lessp (mkatom hour)
|
||||
13)
|
||||
(cond
|
||||
((lessp (mkatom hour)
|
||||
10)
|
||||
(mkstring (cadr (unpack hour))))
|
||||
(t hour)))
|
||||
(t (mkstring (selectq (mkatom hour)
|
||||
(13 1)
|
||||
(14 2)
|
||||
(15 3)
|
||||
(16 4)
|
||||
(17 5)
|
||||
(18 6)
|
||||
(19 7)
|
||||
(20 8)
|
||||
(21 9)
|
||||
(22 10)
|
||||
(23 11)
|
||||
(24 12)
|
||||
nil))))))
|
||||
(* |;;;| "Functions to change date format")
|
||||
|
||||
(ampm
|
||||
(lambda (hour)
|
||||
(|if| (or (lessp (mkatom hour)
|
||||
12)
|
||||
(equal (mkatom hour)
|
||||
24))
|
||||
(DEFINEQ
|
||||
|
||||
(FINDTIME
|
||||
(LAMBDA (OLDDATE VERSION) (* \;
|
||||
"Edited 24-Oct-2021 13:28 by rmk:")
|
||||
|
||||
(* |;;|
|
||||
"RMK: The spell-out default is very strange: it rounds the minutes to the nearest half hour.")
|
||||
|
||||
(* |;;| "RMK: Correct for Y2K: Substrings then work. Still, terrible code.")
|
||||
(* |ss:| "27-Jun-87 15:40")
|
||||
(LET* ((UDATE (\\UNPACKDATE (IDATE OLDDATE)))
|
||||
(HOUR (CAR (NTH UDATE 4)))
|
||||
(MINUTES (CAR (NTH UDATE 5))))
|
||||
(SELECTQ VERSION
|
||||
(ABBREV (CONCAT (FINDHOUR HOUR)
|
||||
":" MINUTES " " (AMPM HOUR)))
|
||||
(EURO (SUBSTRING OLDDATE 13 17))
|
||||
(CONCAT (SELECTQ (|if| (LESSP MINUTES 46)
|
||||
|then| (FINDHOUR HOUR)
|
||||
|else| (PLUS 1 (FINDHOUR HOUR)))
|
||||
(1 "one")
|
||||
(2 "two")
|
||||
(3 "three")
|
||||
(4 "four")
|
||||
(5 "five")
|
||||
(6 "six")
|
||||
(7 "seven")
|
||||
(8 "eight")
|
||||
(9 "nine")
|
||||
(10 "ten")
|
||||
(11 "eleven")
|
||||
(12 "twelve")
|
||||
NIL)
|
||||
" "
|
||||
(|if| (AND (GREATERP MINUTES 15)
|
||||
(LESSP MINUTES 45))
|
||||
|then| "thirty"
|
||||
|else| "o'clock")
|
||||
" "
|
||||
(AMPM HOUR))))))
|
||||
|
||||
(FINDHOUR
|
||||
(LAMBDA (HOUR) (* \;
|
||||
"Edited 24-Oct-2021 13:35 by rmk:")
|
||||
(* |ss:| " 8-Feb-86 17:49")
|
||||
(COND
|
||||
((LESSP HOUR 13)
|
||||
HOUR)
|
||||
(T (IDIFFERENCE HOUR 12)))))
|
||||
|
||||
(AMPM
|
||||
(LAMBDA (HOUR) (* \;
|
||||
"Edited 24-Oct-2021 13:37 by rmk:")
|
||||
(|if| (OR (LESSP HOUR 12)
|
||||
(EQ HOUR 24))
|
||||
|then| "a.m."
|
||||
|else| "p.m.")))
|
||||
|
||||
@@ -275,55 +273,66 @@
|
||||
(* |changed|)
|
||||
(not (null (numberp (mkatom n))))))
|
||||
|
||||
(findmonth
|
||||
(lambda (olddate version) (* |ss:| "27-Jun-87 15:40")
|
||||
(prog ((dates '((|Jan| 1 |January|)
|
||||
(|Feb| 2 |February|)
|
||||
(|Mar| 3 |March|)
|
||||
(|Apr| 4 |April|)
|
||||
(|May| 5 |May|)
|
||||
(|Jun| 6 |June|)
|
||||
(|Jul| 7 |July|)
|
||||
(|Aug| 8 |August|)
|
||||
(|Sep| 9 |September|)
|
||||
(|Oct| 10 |October|)
|
||||
(|Nov| 11 |November|)
|
||||
(|Dec| 12 |December|)))
|
||||
(output nil))
|
||||
(|if| (eq version 'abbrev)
|
||||
|then| (setq output (car (cdr (assoc (mkatom (substring olddate 4 6))
|
||||
dates))))
|
||||
|else| (setq output (car (cddr (assoc (mkatom (substring olddate 4 6))
|
||||
dates)))))
|
||||
(return output))))
|
||||
(FINDMONTH
|
||||
(LAMBDA (OLDDATE VERSION) (* \;
|
||||
"Edited 24-Oct-2021 13:52 by rmk:")
|
||||
(* |ss:| "27-Jun-87 15:40")
|
||||
|
||||
(findyear
|
||||
(lambda (olddate version) (* |ss:| "27-Jun-87 15:41")
|
||||
(|if| (eq version 'abbrev)
|
||||
|then| (mkatom (substring olddate 8 9))
|
||||
|else| (mkatom (concat "19" (substring olddate 8 9))))))
|
||||
(* |;;| "\\UNPACKDATE uses 0 origin for months")
|
||||
|
||||
(LET ((MONTH (ASSOC (ADD1 (CAR (NTH (\\UNPACKDATE (IDATE OLDDATE))
|
||||
2)))
|
||||
'((1 |Jan| |January|)
|
||||
(2 |Feb| |February|)
|
||||
(3 |Mar| |March|)
|
||||
(4 |Apr| |April|)
|
||||
(5 |May| |May|)
|
||||
(6 |Jun| |June|)
|
||||
(7 |Jul| |July|)
|
||||
(8 |Aug| |August|)
|
||||
(9 |Sep| |September|)
|
||||
(10 |Oct| |October|)
|
||||
(11 |Nov| |November|)
|
||||
(12 |DecDecember|)))))
|
||||
(|if| (EQ VERSION 'ABBREV)
|
||||
|then| (CADR MONTH)
|
||||
|else| (CADDR MONTH)))))
|
||||
|
||||
(FINDYEAR
|
||||
(LAMBDA (OLDDATE VERSION) (* \;
|
||||
"Edited 24-Oct-2021 13:48 by rmk:")
|
||||
(* |ss:| "27-Jun-87 15:41")
|
||||
(CAR (\\UNPACKDATE (IDATE OLDDATE)))))
|
||||
)
|
||||
|
||||
(rpaqq date.format.items ((|Month Day, Year| '(m d y f)
|
||||
"Insert current date as \"March 8, 1952\"")
|
||||
(|Month/Day/Year| '(m d y a) "Insert current date as \"3/8/52\"")
|
||||
(|Day Month, Year| '(d m y f)
|
||||
"Insert current date as \"8 March, 1952\"")
|
||||
(|Day/Month/Year| '(d m y a) "Insert current date as \"8/3/52\"")
|
||||
(|Time| '(t f) "Insert current time as \"four thirty p.m.\"")
|
||||
(|Numbered Time| '(t a) "Insert current time as \"4:30 p.m.\"")
|
||||
(|Military Time| '(t e) "Insert current time as \"16:30\"")
|
||||
(|Update| t "Convert to current date/time")))
|
||||
(declare\: eval@compile
|
||||
(RPAQQ DATE.FORMAT.ITEMS
|
||||
((|Month Day, Year| '(M D Y F)
|
||||
"Insert current date as \"March 8, 1952\"")
|
||||
(|Month/Day/Year| '(M D Y A)
|
||||
"Insert current date as \"3/8/52\"")
|
||||
(|Day Month, Year| '(D M Y F)
|
||||
"Insert current date as \"8 March, 1952\"")
|
||||
(|Day/Month/Year| '(D M Y A)
|
||||
"Insert current date as \"8/3/52\"")
|
||||
(|Time| '(T F)
|
||||
"Insert current time as \"four thirty p.m.\"")
|
||||
(|Numbered Time| '(T A)
|
||||
"Insert current time as \"4:30 p.m.\"")
|
||||
(|Military Time| '(T E)
|
||||
"Insert current time as \"16:30\"")
|
||||
(|Update| T "Convert to current date/time")))
|
||||
(DECLARE\: DOEVAL@COMPILE DONTCOPY
|
||||
(DECLARE\: EVAL@COMPILE
|
||||
|
||||
(record daterecord (datestring display.date template.date))
|
||||
(RECORD DATERECORD (DATESTRING DISPLAY.DATE TEMPLATE.DATE))
|
||||
)
|
||||
(putprops tmax-date copyright ("Xerox Corporation" 1987 1988))
|
||||
(declare\: dontcopy
|
||||
(filemap (nil (1398 6132 (dateobj 1408 . 2175) (dateobjp 2177 . 2611) (date.displayfn 2613 . 2935) (
|
||||
date.imageboxfn 2937 . 3564) (date.putfn 3566 . 3764) (date.getfn 3766 . 4060) (date.copyfn 4062 .
|
||||
4594) (date.buttoneventinfn 4596 . 6130)) (6174 8957 (current.display.font 6184 . 6890) (
|
||||
change.date.format 6892 . 8955)) (9012 14248 (findtime 9022 . 11531) (findhour 11533 . 12290) (ampm
|
||||
12292 . 12496) (findday 12498 . 12769) (nump 12771 . 13000) (findmonth 13002 . 13980) (findyear 13982
|
||||
. 14246)))))
|
||||
stop
|
||||
)
|
||||
(PUTPROPS TMAX-DATE COPYRIGHT ("Xerox Corporation" 1987 1988))
|
||||
(DECLARE\: DONTCOPY
|
||||
(FILEMAP (NIL (1422 6156 (DATEOBJ 1432 . 2199) (DATEOBJP 2201 . 2635) (DATE.DISPLAYFN 2637 . 2959) (
|
||||
DATE.IMAGEBOXFN 2961 . 3588) (DATE.PUTFN 3590 . 3788) (DATE.GETFN 3790 . 4084) (DATE.COPYFN 4086 .
|
||||
4618) (DATE.BUTTONEVENTINFN 4620 . 6154)) (6200 8853 (CURRENT.DISPLAY.FONT 6210 . 6916) (
|
||||
CHANGE.DATE.FORMAT 6918 . 8851)) (8906 13305 (FINDTIME 8916 . 10695) (FINDHOUR 10697 . 11058) (AMPM
|
||||
11060 . 11359) (FINDDAY 11361 . 11632) (NUMP 11634 . 11863) (FINDMONTH 11865 . 12981) (FINDYEAR 12983
|
||||
. 13303)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Binary file not shown.
@@ -1,11 +1,11 @@
|
||||
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
|
||||
(FILECREATED "11-Jun-2021 12:50:16"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>WHEELSCROLL.;18 10803
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
changes to%: (FNS ENABLEWHEELSCROLL)
|
||||
(FILECREATED "23-Oct-2021 16:33:29" {DSK}<home>larry>medley>lispusers>WHEELSCROLL.;2 11221
|
||||
|
||||
previous date%: "11-Jun-2021 11:11:10"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>WHEELSCROLL.;14)
|
||||
changes to%: (VARS WHEELSCROLLCOMS)
|
||||
(FNS ENABLEWHEELSCROLL WHEELSCROLL)
|
||||
|
||||
previous date%: "11-Jun-2021 12:50:16" {DSK}<home>larry>medley>lispusers>WHEELSCROLL.;1)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT WHEELSCROLLCOMS)
|
||||
@@ -14,15 +14,15 @@
|
||||
[(FNS ENABLEWHEELSCROLL WHEELSCROLL WHEELSCROLL.DOIT INSTALL-WHEELSCROLL
|
||||
LISPINTERRUPTS.WHEELSCROLL)
|
||||
|
||||
(* ;; "These are the highest meta-ctrl characters, they will be unaffected by teh state of ctrl and meta mode keys")
|
||||
(* ;; "These are the highest meta-ctrl characters, they will be unaffected by teh state of ctrl and meta mode keys")
|
||||
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (UP 156)
|
||||
(DOWN 157)
|
||||
(LEFT 158)
|
||||
(RIGHT 159)))
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\WSUP 156)
|
||||
(\WSDOWN 157)
|
||||
(\WSLEFT 158)
|
||||
(\WSRIGHT 159)))
|
||||
(GLOBALVARS WHEELSCROLLDELTA WHEELSCROLLSETTLETIME \WHEELSCROLLINPROGRESS)
|
||||
|
||||
(* ;; "To restore the keyactions for PAD..., if the keyaction table has been reinitialized")
|
||||
(* ;; "To restore the keyactions for PAD..., if the keyaction table has been reinitialized")
|
||||
|
||||
[ADDVARS (AFTERSYSOUTFORMS (AND WHEELSCROLLENABLED (ENABLEWHEELSCROLL T)))
|
||||
(AFTERMAKESYSFORMS (AND WHEELSCROLLENABLED (ENABLEWHEELSCROLL T]
|
||||
@@ -35,65 +35,69 @@
|
||||
(DEFINEQ
|
||||
|
||||
(ENABLEWHEELSCROLL
|
||||
[LAMBDA (ON EXCLUDEHORIZONTAL) (* ; "Edited 11-Jun-2021 12:50 by rmk:")
|
||||
(* ; "Edited 28-May-2021 11:46 by rmk:")
|
||||
[LAMBDA (ON EXCLUDEHORIZONTAL) (* ;
|
||||
"Edited 23-Oct-2021 16:31 by larry")
|
||||
(* ;
|
||||
"Edited 11-Jun-2021 12:50 by rmk:")
|
||||
(* ;
|
||||
"Edited 28-May-2021 11:46 by rmk:")
|
||||
|
||||
(* ;; "So we can toggle this scrolling.")
|
||||
(* ;; "So we can toggle this scrolling.")
|
||||
|
||||
(IF ON
|
||||
THEN (CL:UNLESS (EQP (GETD 'LISPINTERRUPTS)
|
||||
(if ON
|
||||
then (CL:UNLESS (EQP (GETD 'LISPINTERRUPTS)
|
||||
(GETD 'LISPINTERRUPTS.WHEELSCROLL))
|
||||
(CL:WHEN (GETD 'LISPINTERRUPTS.WHEELSCROLL)
|
||||
(* ; "In case of LOADFROM?")
|
||||
(* ; "In case of LOADFROM?")
|
||||
(MOVD? 'LISPINTERRUPTS 'LISPINTERRUPTS.WSORIG)
|
||||
(MOVD 'LISPINTERRUPTS.WHEELSCROLL 'LISPINTERRUPTS)))
|
||||
|
||||
(* ;; "In some situations these other keyactions seem to be installed, hit them all.")
|
||||
(* ;; "In some situations these other keyactions seem to be installed, hit them all.")
|
||||
|
||||
[FOR KAT IN (LIST \CURRENTKEYACTION \COMMANDKEYACTION \DEFAULTKEYACTION)
|
||||
DO ((FOR K IN [IF EXCLUDEHORIZONTAL
|
||||
THEN `((PAD1 ,UP)
|
||||
(PAD2 ,DOWN)
|
||||
(PAD4 IGNORE)
|
||||
(PAD5 IGNORE))
|
||||
ELSE `((PAD1 ,UP)
|
||||
(PAD2 ,DOWN)
|
||||
(PAD4 ,LEFT)
|
||||
(PAD5 ,RIGHT]
|
||||
DO (KEYACTION (CAR K)
|
||||
(CONS (CL:IF (EQ (CADR K)
|
||||
'IGNORE)
|
||||
'IGNORE
|
||||
`(,(CADR K)
|
||||
,(CADR K)))
|
||||
`IGNORE)
|
||||
KAT]
|
||||
(FOR I IN WHEELSCROLLINTERRUPTS
|
||||
DO (INTERRUPTCHAR (CAR I)
|
||||
(for KAT in (LIST \CURRENTKEYACTION \COMMANDKEYACTION \DEFAULTKEYACTION)
|
||||
do (for K in [if EXCLUDEHORIZONTAL
|
||||
then `((PAD1 ,\WSUP)
|
||||
(PAD2 ,\WSDOWN)
|
||||
(PAD4 IGNORE)
|
||||
(PAD5 IGNORE))
|
||||
else `((PAD1 ,\WSUP)
|
||||
(PAD2 ,\WSDOWN)
|
||||
(PAD4 ,\WSLEFT)
|
||||
(PAD5 ,\WSRIGHT]
|
||||
do (KEYACTION (CAR K)
|
||||
(CONS (CL:IF (EQ (CADR K)
|
||||
'IGNORE)
|
||||
'IGNORE
|
||||
`(,(CADR K)
|
||||
,(CADR K)))
|
||||
`IGNORE)
|
||||
KAT)))
|
||||
(for I in WHEELSCROLLINTERRUPTS
|
||||
do (INTERRUPTCHAR (CAR I)
|
||||
(CADR I)
|
||||
(CADDR I))
|
||||
(CL:WHEN (BOUNDP 'TEDIT.READTABLE)
|
||||
|
||||
(* ;; "These actions are invoked when the caret is in the Tedit window, because TEDIT disables the interrupts")
|
||||
(* ;; "These actions are invoked when the caret is in the Tedit window, because TEDIT disables the interrupts")
|
||||
|
||||
(TEDIT.SETFUNCTION (CAR I)
|
||||
`[LAMBDA NIL
|
||||
,(CADR I]
|
||||
TEDIT.READTABLE)))
|
||||
(SETQ WHEELSCROLLENABLED T)
|
||||
ELSE (CL:WHEN (EQP (GETD 'LISPINTERRUPTS.WHEELSCROLL)
|
||||
else (CL:WHEN (EQP (GETD 'LISPINTERRUPTS.WHEELSCROLL)
|
||||
(GETD 'LISPINTERRUPTS))
|
||||
(MOVD 'LISPINTERRUPTS.WSORIG 'LISPINTERRUPTS))
|
||||
(FOR I IN WHEELSCROLLINTERRUPTS DO (INTERRUPTCHAR (CAR I)
|
||||
(for I in WHEELSCROLLINTERRUPTS do (INTERRUPTCHAR (CAR I)
|
||||
NIL)
|
||||
(CL:WHEN (BOUNDP 'TEDIT.READTABLE)
|
||||
|
||||
(* ;; "These actions are invoked when the caret is in the Tedit window, because TEDIT disables the interrupts")
|
||||
(* ;; "These actions are invoked when the caret is in the Tedit window, because TEDIT disables the interrupts")
|
||||
|
||||
(TEDIT.SETFUNCTION (CAR I)
|
||||
NIL TEDIT.READTABLE)))
|
||||
(FOR KAT IN (LIST \CURRENTKEYACTION \COMMANDKEYACTION \DEFAULTKEYACTION)
|
||||
DO (KEYACTION 'PAD1 '(IGNORE . IGNORE)
|
||||
(for KAT in (LIST \CURRENTKEYACTION \COMMANDKEYACTION \DEFAULTKEYACTION)
|
||||
do (KEYACTION 'PAD1 '(IGNORE . IGNORE)
|
||||
KAT)
|
||||
(KEYACTION 'PAD2 '(IGNORE . IGNORE)
|
||||
KAT)
|
||||
@@ -104,41 +108,42 @@
|
||||
(SETQ WHEELSCROLLENABLED NIL])
|
||||
|
||||
(WHEELSCROLL
|
||||
[LAMBDA (DIRECTION DELTA) (* ; "Edited 21-Feb-2021 09:38 by rmk:")
|
||||
[LAMBDA (DIRECTION DELTA) (* ;
|
||||
"Edited 21-Feb-2021 09:38 by rmk:")
|
||||
|
||||
(* ;; "The wheel may accidentally turn (giving the interrupt) when the users intention is simply to push the middle button. And there may be another accidental turn (also giving an interrupt) when the user is releasing the middle button. We don't yet have a good solution to this problem. (This is not an issue with a trackpad)")
|
||||
(* ;; "The wheel may accidentally turn (giving the interrupt) when the users intention is simply to push the middle button. And there may be another accidental turn (also giving an interrupt) when the user is releasing the middle button. We don't yet have a good solution to this problem. (This is not an issue with a trackpad)")
|
||||
|
||||
(* ;; "")
|
||||
(* ;; "")
|
||||
|
||||
(CL:WHEN (MOUSESTATE UP) (* ;
|
||||
"Ignore interrupt if a button is down")
|
||||
(CL:WHEN (MOUSESTATE UP) (* ;
|
||||
"Ignore interrupt if a button is down")
|
||||
[LET ((W (WHICHW)))
|
||||
|
||||
(* Unsuccessful a ttempt to suppress scroll if middlebutton comes down within
|
||||
the setetle time (NOT (UNTILMOUSESTATE (ONLY MIDDLE) WHEELSCROLLSETTLETIME)))
|
||||
(* Unsuccessful a ttempt to suppress scroll if middlebutton comes down within
|
||||
the setetle time (NOT (UNTILMOUSESTATE (ONLY MIDDLE) WHEELSCROLLSETTLETIME)))
|
||||
|
||||
(CL:WHEN W
|
||||
|
||||
(* ;; "We scroll only if the window has a scrollfn. Our behavior is thus different from a direct call to SCROLLW, which defaults to SCROLLBYREPAINTFN in that case, but conforms to what happens with IN/SCROLL/BAR? and SCROLL.HANDLER in WINDOWSCROLL. Menus and scrollbars typically do not have scrollfns, so this suppresses otherwise funky behavior. ")
|
||||
(* ;; "We scroll only if the window has a scrollfn. Our behavior is thus different from a direct call to SCROLLW, which defaults to SCROLLBYREPAINTFN in that case, but conforms to what happens with IN/SCROLL/BAR? and SCROLL.HANDLER in WINDOWSCROLL. Menus and scrollbars typically do not have scrollfns, so this suppresses otherwise funky behavior. ")
|
||||
|
||||
(IF (WINDOWPROP W 'SCROLLFN)
|
||||
THEN [PROCESS.EVAL (FIND.PROCESS 'MOUSE)
|
||||
(if (WINDOWPROP W 'SCROLLFN)
|
||||
then [PROCESS.EVAL (FIND.PROCESS 'MOUSE)
|
||||
(CL:IF (EQ DIRECTION 'VERTICAL)
|
||||
`(WHEELSCROLL.DOIT ,(KWOTE W)
|
||||
0
|
||||
,DELTA)
|
||||
`(WHEELSCROLL.DOIT ,(KWOTE W)
|
||||
,DELTA 0))]
|
||||
ELSEIF (EQ DIRECTION 'VERTICAL)
|
||||
THEN
|
||||
elseif (EQ DIRECTION 'VERTICAL)
|
||||
then
|
||||
|
||||
(* ;; "We are in a pop-up scrollbar. This moves the cursor there, the user has to click to scroll the main window.")
|
||||
(* ;; "We are in a pop-up scrollbar. This moves the cursor there, the user has to click to scroll the main window.")
|
||||
|
||||
(CL:WHEN (WINDOWPROP W 'VERTICALSCROLLBARFOR)
|
||||
(\CURSORPOSITION LASTMOUSEX (IPLUS LASTMOUSEY DELTA))
|
||||
(GETMOUSESTATE))
|
||||
ELSEIF (EQ DIRECTION 'HORIZONTAL)
|
||||
THEN (CL:WHEN (WINDOWPROP W 'HORIZONTALSCROLLBARFOR)
|
||||
elseif (EQ DIRECTION 'HORIZONTAL)
|
||||
then (CL:WHEN (WINDOWPROP W 'HORIZONTALSCROLLBARFOR)
|
||||
(\CURSORPOSITION (IPLUS DELTA LASTMOUSEX)
|
||||
LASTMOUSEY)
|
||||
(GETMOUSESTATE))))])])
|
||||
@@ -186,19 +191,19 @@
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RPAQQ UP 156)
|
||||
(RPAQQ \WSUP 156)
|
||||
|
||||
(RPAQQ DOWN 157)
|
||||
(RPAQQ \WSDOWN 157)
|
||||
|
||||
(RPAQQ LEFT 158)
|
||||
(RPAQQ \WSLEFT 158)
|
||||
|
||||
(RPAQQ RIGHT 159)
|
||||
(RPAQQ \WSRIGHT 159)
|
||||
|
||||
|
||||
(CONSTANTS (UP 156)
|
||||
(DOWN 157)
|
||||
(LEFT 158)
|
||||
(RIGHT 159))
|
||||
(CONSTANTS (\WSUP 156)
|
||||
(\WSDOWN 157)
|
||||
(\WSLEFT 158)
|
||||
(\WSRIGHT 159))
|
||||
)
|
||||
)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
@@ -229,6 +234,6 @@
|
||||
(ENABLEWHEELSCROLL T)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1575 9814 (ENABLEWHEELSCROLL 1585 . 5542) (WHEELSCROLL 5544 . 8080) (WHEELSCROLL.DOIT
|
||||
8082 . 8718) (INSTALL-WHEELSCROLL 8720 . 9535) (LISPINTERRUPTS.WHEELSCROLL 9537 . 9812)))))
|
||||
(FILEMAP (NIL (1604 10208 (ENABLEWHEELSCROLL 1614 . 5871) (WHEELSCROLL 5873 . 8474) (WHEELSCROLL.DOIT
|
||||
8476 . 9112) (INSTALL-WHEELSCROLL 9114 . 9929) (LISPINTERRUPTS.WHEELSCROLL 9931 . 10206)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
15
loadups/README.md
Normal file
15
loadups/README.md
Normal file
@@ -0,0 +1,15 @@
|
||||
# medley/loadups
|
||||
|
||||
This directory is for holding the sysouts from a release
|
||||
* lisp.sysout (the system in the IRM + Common Lisp)
|
||||
* full.sysout (lisp + modernizations + TEdit and others)
|
||||
|
||||
* starter.sysout you have to have a running Medley to make a new one(!)
|
||||
this file is just a stable place to stand.
|
||||
|
||||
* whereis.hash A "hash file" directory index of everything
|
||||
|
||||
* lisp.venuesysout full.venuesysout -- vintage sysouts for comparision
|
||||
|
||||
Plus, if you make your own loadups (from BUILDING.md) you'll see some .dribble files which are the logs of the build proccess.
|
||||
|
||||
@@ -51,7 +51,7 @@ if [ -z "$LDEDESTSYSOUT" ] ; then
|
||||
fi
|
||||
|
||||
if [ -z "$LDEINIT" ] ; then
|
||||
export LDEINIT="$MEDLEYDIR/greetfiles/SIMPLE-INIT"
|
||||
export LDEINIT="$MEDLEYDIR/greetfiles/MEDLEYDIR-INIT"
|
||||
fi
|
||||
|
||||
export LDEKBDTYPE=x
|
||||
@@ -195,4 +195,3 @@ export INMEDLEY=1
|
||||
|
||||
"$prog" $noscroll $geometry $screensize $mem -t "Medley Interlisp" $passthrough_args "$LDESRCESYSOUT"
|
||||
|
||||
|
||||
|
||||
@@ -29,7 +29,7 @@ tar cfz medley/tmp/$tag-runtime.tgz \
|
||||
--exclude "*~" --exclude "*#*" \
|
||||
medley/docs/dinfo \
|
||||
medley/docs/Documentation\ Tools \
|
||||
medley/greetfiles/SIMPLE-INIT \
|
||||
medley/greetfiles \
|
||||
medley/run-medley \
|
||||
medley/scripts \
|
||||
medley/fonts/displayfonts medley/fonts/altofonts \
|
||||
|
||||
166
sources/ATBL
166
sources/ATBL
@@ -1,10 +1,11 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "21-Aug-2021 08:06:49" {DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>ATBL.;22 91541
|
||||
|
||||
changes to%: (FNS \ORIGTERMTABLE)
|
||||
(FILECREATED "24-Oct-2021 21:53:59" {DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>ATBL.;28 92451
|
||||
|
||||
previous date%: "19-Aug-2021 14:45:21"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>ATBL.;21)
|
||||
changes to%: (FNS MAKE-READER-ENVIRONMENT)
|
||||
|
||||
previous date%: "24-Oct-2021 20:14:01"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>ATBL.;27)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -14,15 +15,15 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation.
|
||||
(PRETTYCOMPRINT ATBLCOMS)
|
||||
|
||||
(RPAQQ ATBLCOMS
|
||||
[(COMS (* ;
|
||||
"Common features of read and terminal tables")
|
||||
[(COMS (* ;
|
||||
"Common features of read and terminal tables")
|
||||
(DECLARE%: DONTCOPY (EXPORT (MACROS \SYNCODE \SETSYNCODE)
|
||||
(RECORDS CHARTABLE))
|
||||
(CONSTANTS \NSCHARHASHKEYS \NSCHARHASHOVERFLOW)
|
||||
(MACROS \CREATENSCHARHASH))
|
||||
(FNS GETSYNTAX SETSYNTAX SYNTAXP \COPYSYNTAX \GETCHARCODE \SETFATSYNCODE \MAPCHARTABLE)
|
||||
)
|
||||
(COMS (* ; "terminal tables")
|
||||
(COMS (* ; "terminal tables")
|
||||
(FNS CONTROL COPYTERMTABLE DELETECONTROL GETDELETECONTROL ECHOCHAR ECHOCONTROL ECHOMODE
|
||||
GETECHOMODE GETCONTROL GETTERMTABLE RAISE GETRAISE RESETTERMTABLE SETTERMTABLE
|
||||
TERMTABLEP \GETTERMSYNTAX \GTTERMTABLE \ORIGTERMTABLE \SETTERMSYNTAX
|
||||
@@ -31,16 +32,16 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation.
|
||||
(CONSTANTS * TERMCLASSES)
|
||||
(RECORDS TERMCODE TERMTABLEP)))
|
||||
(INITRECORDS TERMTABLEP))
|
||||
(COMS (* ; "read tables")
|
||||
(COMS (* ; "read tables")
|
||||
(FNS COPYREADTABLE FIND-READTABLE IN-READTABLE ESCAPE GETBRK GETREADTABLE GETSEPR
|
||||
READMACROS READTABLEP READTABLEPROP RESETREADTABLE SETBRK SETREADTABLE SETSEPR
|
||||
\GETREADSYNTAX \GTREADTABLE \GTREADTABLE1 \ORIGREADTABLE \READCLASSTOCODE
|
||||
\SETMACROSYNTAX \SETREADSYNTAX \READTABLEP.DEFPRINT)
|
||||
(PROP ARGNAMES READTABLEPROP)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (* ;
|
||||
"READCLASSTOKENS Generates READCLASSES and some interesting SELECTQ's")
|
||||
(* ;
|
||||
"OTHER must be zero because of initialization.")
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (* ;
|
||||
"READCLASSTOKENS Generates READCLASSES and some interesting SELECTQ's")
|
||||
(* ;
|
||||
"OTHER must be zero because of initialization.")
|
||||
[VARS READCLASSTOKENS (READCLASSES (MAPCAR READCLASSTOKENS
|
||||
(FUNCTION (LAMBDA
|
||||
(PAIR)
|
||||
@@ -48,8 +49,8 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation.
|
||||
".RC")
|
||||
(CADR PAIR]
|
||||
(MACROS \COMPUTED.FORM)
|
||||
(* ;
|
||||
"This macro ought to be official somehow")
|
||||
(* ;
|
||||
"This macro ought to be official somehow")
|
||||
(RECORDS CONTEXTS ESCAPES WAKEUPS)
|
||||
(EXPORT (MACROS \GETREADMACRODEF \GTREADTABLE \GTREADTABLE1)
|
||||
(CONSTANTS MACROBIT BREAKBIT STOPATOMBIT ESCAPEBIT INNERESCAPEBIT)
|
||||
@@ -64,8 +65,8 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation.
|
||||
[COMS (INITVARS (\READTABLEHASH))
|
||||
(FNS \ATBLSET)
|
||||
(INITRECORDS READER-ENVIRONMENT)
|
||||
(* ;
|
||||
"Definition is on CMLREAD, need it here to initialize *OLD-INTERLISP-READ-ENVIRONMENT*")
|
||||
(* ;
|
||||
"Definition is on CMLREAD, need it here to initialize *OLD-INTERLISP-READ-ENVIRONMENT*")
|
||||
(FNS MAKE-READER-ENVIRONMENT EQUAL-READER-ENVIRONMENT SET-READER-ENVIRONMENT)
|
||||
(INITVARS (*LISP-PACKAGE*)
|
||||
(*INTERLISP-PACKAGE*)
|
||||
@@ -85,8 +86,8 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation.
|
||||
|
||||
(PUTPROPS \SYNCODE DMACRO [OPENLAMBDA (TABLE CHAR)
|
||||
(CHECK (type? CHARTABLE TABLE))
|
||||
(* ;
|
||||
"0 is either NONE.TC, REAL.CCE, or OTHER.RC")
|
||||
(* ;
|
||||
"0 is either NONE.TC, REAL.CCE, or OTHER.RC")
|
||||
(COND
|
||||
((IGREATERP CHAR \MAXTHINCHAR)
|
||||
(OR (AND (fetch (CHARTABLE NSCHARHASH) of TABLE)
|
||||
@@ -97,8 +98,8 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation.
|
||||
|
||||
(PUTPROPS \SETSYNCODE DMACRO [LAMBDA (TABLE CHAR CODE)
|
||||
(CHECK (type? CHARTABLE TABLE))
|
||||
(* ;
|
||||
"0 is REAL.CCE, NONE.TC, OTHER.RC")
|
||||
(* ;
|
||||
"0 is REAL.CCE, NONE.TC, OTHER.RC")
|
||||
(COND
|
||||
((ILEQ CHAR \MAXTHINCHAR)
|
||||
(\PUTBASEBYTE TABLE CHAR CODE))
|
||||
@@ -401,8 +402,8 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation.
|
||||
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS \CREATENSCHARHASH MACRO (ARGS (* ;
|
||||
"added size argument for creation of \ORIGTERMTABLE during initialization.")
|
||||
(PUTPROPS \CREATENSCHARHASH MACRO (ARGS (* ;
|
||||
"added size argument for creation of \ORIGTERMTABLE during initialization.")
|
||||
(LIST 'HASHARRAY (OR (CAR ARGS)
|
||||
'\NSCHARHASHKEYS)
|
||||
'\NSCHARHASHOVERFLOW)))
|
||||
@@ -949,8 +950,8 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation.
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(ACCESSFNS TERMCODE ((CCECHO (LOGAND DATUM 24))
|
||||
(TERMCLASS (LOGAND DATUM 7))) (* ;
|
||||
"We assume that values are appropriately shifted")
|
||||
(TERMCLASS (LOGAND DATUM 7))) (* ;
|
||||
"We assume that values are appropriately shifted")
|
||||
(CREATE (LOGOR CCECHO TERMCLASS)))
|
||||
|
||||
(DATATYPE TERMTABLEP (TERMSA RAISEFLG DELCHARECHO LINEDELETE 1STCHDEL NTHCHDEL POSTCHDEL
|
||||
@@ -1640,34 +1641,34 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation.
|
||||
|
||||
(RECORD READMACRODEF (MACROTYPE . MACROFN))
|
||||
|
||||
(DATATYPE READTABLEP ((READSA POINTER) (* ;
|
||||
"A CHARTABLE defining syntax of each char")
|
||||
(READMACRODEFS POINTER) (* ;
|
||||
"A hash table associating macro chars with macro definitions")
|
||||
(READMACROFLG FLAG) (* ;
|
||||
"True if read macros are enabled (turned off by Interlisp's crufty READMACROS function)")
|
||||
(ESCAPEFLG FLAG) (* ; "True if the char(s) with escape syntax are enabled (turned off by Interlisp's crufty ESCAPE function)")
|
||||
(COMMONLISP FLAG) (* ;
|
||||
"True if table is a Common Lisp read table and hence must obey Common Lisp syntax rules")
|
||||
(NUMBERBASE BITS 5) (* ; "Not used")
|
||||
(CASEINSENSITIVE FLAG) (* ;
|
||||
"If true, unescaped lowercase chars are converted to uppercase in symbols")
|
||||
(COMMONNUMSYNTAX FLAG) (* ; "True if number notation includes Common Lisp numbers: rationals as a/b, and the dfls exponent markers")
|
||||
(USESILPACKAGE FLAG) (* ;
|
||||
"If true, IL:READ ignores *PACKAGE* and reads in the IL package")
|
||||
(DATATYPE READTABLEP ((READSA POINTER) (* ;
|
||||
"A CHARTABLE defining syntax of each char")
|
||||
(READMACRODEFS POINTER) (* ;
|
||||
"A hash table associating macro chars with macro definitions")
|
||||
(READMACROFLG FLAG) (* ;
|
||||
"True if read macros are enabled (turned off by Interlisp's crufty READMACROS function)")
|
||||
(ESCAPEFLG FLAG) (* ; "True if the char(s) with escape syntax are enabled (turned off by Interlisp's crufty ESCAPE function)")
|
||||
(COMMONLISP FLAG) (* ;
|
||||
"True if table is a Common Lisp read table and hence must obey Common Lisp syntax rules")
|
||||
(NUMBERBASE BITS 5) (* ; "Not used")
|
||||
(CASEINSENSITIVE FLAG) (* ;
|
||||
"If true, unescaped lowercase chars are converted to uppercase in symbols")
|
||||
(COMMONNUMSYNTAX FLAG) (* ; "True if number notation includes Common Lisp numbers: rationals as a/b, and the dfls exponent markers")
|
||||
(USESILPACKAGE FLAG) (* ;
|
||||
"If true, IL:READ ignores *PACKAGE* and reads in the IL package")
|
||||
(NIL 5 FLAG)
|
||||
(DISPATCHMACRODEFS POINTER) (* ;
|
||||
"An a-list of dispatching macro char and its dispatch definitions")
|
||||
(HASHMACROCHAR BYTE) (* ;
|
||||
"The character code used in this read table for the # dispatch macro")
|
||||
(ESCAPECHAR BYTE) (* ;
|
||||
"The character code used in this read table for single escape")
|
||||
(MULTESCAPECHAR BYTE) (* ;
|
||||
"The character code used in this read table for multiple escape")
|
||||
(PACKAGECHAR BYTE) (* ;
|
||||
"The character code used in this read table for package delimiter")
|
||||
(READTBLNAME POINTER) (* ;
|
||||
"The canonical 'name' of this read table")
|
||||
(DISPATCHMACRODEFS POINTER) (* ;
|
||||
"An a-list of dispatching macro char and its dispatch definitions")
|
||||
(HASHMACROCHAR BYTE) (* ;
|
||||
"The character code used in this read table for the # dispatch macro")
|
||||
(ESCAPECHAR BYTE) (* ;
|
||||
"The character code used in this read table for single escape")
|
||||
(MULTESCAPECHAR BYTE) (* ;
|
||||
"The character code used in this read table for multiple escape")
|
||||
(PACKAGECHAR BYTE) (* ;
|
||||
"The character code used in this read table for package delimiter")
|
||||
(READTBLNAME POINTER) (* ;
|
||||
"The canonical 'name' of this read table")
|
||||
)
|
||||
READSA _ (create CHARTABLE))
|
||||
)
|
||||
@@ -1833,14 +1834,33 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation.
|
||||
(DEFINEQ
|
||||
|
||||
(MAKE-READER-ENVIRONMENT
|
||||
[LAMBDA (PACKAGE READTABLE BASE FORMAT PACKAGEFORM READTABLEFORM)
|
||||
(* ; "Edited 16-Aug-2021 23:44 by rmk:")
|
||||
[LAMBDA (PACKAGE READTABLE BASE FORMAT PACKAGEFORM READTABLEFORM)
|
||||
(* ;
|
||||
"Edited 24-Oct-2021 21:53 by rmk:")
|
||||
(* ;
|
||||
"Edited 16-Aug-2021 23:44 by rmk:")
|
||||
|
||||
(* ;; "PACKAGE can be a prop list of keyword-values")
|
||||
|
||||
(CL:WHEN (LISTP PACKAGE)
|
||||
(CL:UNLESS READTABLE
|
||||
(SETQ READTABLE (LISTGET PACKAGE :READTABLE)))
|
||||
(CL:UNLESS BASE
|
||||
(SETQ BASE (LISTGET PACKAGE :BASE)))
|
||||
(CL:UNLESS FORMAT
|
||||
(SETQ FORMAT (LISTGET PACKAGE :FORMAT)))
|
||||
(SETQ PACKAGE (LISTGET PACKAGE :PACKAGE)))
|
||||
(create READER-ENVIRONMENT
|
||||
REPACKAGE _ (COND
|
||||
(PACKAGE (\DTEST PACKAGE 'PACKAGE))
|
||||
((CL:PACKAGEP PACKAGE)
|
||||
PACKAGE)
|
||||
[PACKAGE (OR (CL:FIND-PACKAGE PACKAGE)
|
||||
(\DEST PACKAGE 'PACKAGE]
|
||||
(T *PACKAGE*))
|
||||
REREADTABLE _ (COND
|
||||
(READTABLE (\DTEST READTABLE 'READTABLEP))
|
||||
((READTABLEP READTABLE))
|
||||
[READTABLE (OR (FIND-READTABLE READTABLE)
|
||||
(\DEST READTABLE 'READTABLEP]
|
||||
(T *READTABLE*))
|
||||
REBASE _ (COND
|
||||
(BASE (\CHECKRADIX BASE))
|
||||
@@ -1904,22 +1924,22 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation.
|
||||
(PUTPROPS ATBL COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1990 1993 2018
|
||||
2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (18036 29188 (GETSYNTAX 18046 . 22877) (SETSYNTAX 22879 . 23952) (SYNTAXP 23954 . 26451)
|
||||
(\COPYSYNTAX 26453 . 27170) (\GETCHARCODE 27172 . 27460) (\SETFATSYNCODE 27462 . 28753) (
|
||||
\MAPCHARTABLE 28755 . 29186)) (29221 44187 (CONTROL 29231 . 29483) (COPYTERMTABLE 29485 . 29852) (
|
||||
DELETECONTROL 29854 . 32495) (GETDELETECONTROL 32497 . 33459) (ECHOCHAR 33461 . 34902) (ECHOCONTROL
|
||||
34904 . 35361) (ECHOMODE 35363 . 35609) (GETECHOMODE 35611 . 35775) (GETCONTROL 35777 . 35943) (
|
||||
GETTERMTABLE 35945 . 36012) (RAISE 36014 . 36440) (GETRAISE 36442 . 36604) (RESETTERMTABLE 36606 .
|
||||
37690) (SETTERMTABLE 37692 . 37926) (TERMTABLEP 37928 . 38089) (\GETTERMSYNTAX 38091 . 38362) (
|
||||
\GTTERMTABLE 38364 . 38700) (\ORIGTERMTABLE 38702 . 42312) (\SETTERMSYNTAX 42314 . 42949) (
|
||||
\TERMCLASSTOCODE 42951 . 43380) (\TERMCODETOCLASS 43382 . 43769) (\LITCHECK 43771 . 44185)) (46717
|
||||
70541 (COPYREADTABLE 46727 . 46925) (FIND-READTABLE 46927 . 47074) (IN-READTABLE 47076 . 47236) (
|
||||
ESCAPE 47238 . 47491) (GETBRK 47493 . 47631) (GETREADTABLE 47633 . 47769) (GETSEPR 47771 . 47909) (
|
||||
READMACROS 47911 . 48174) (READTABLEP 48176 . 48339) (READTABLEPROP 48341 . 53499) (RESETREADTABLE
|
||||
53501 . 57748) (SETBRK 57750 . 59360) (SETREADTABLE 59362 . 59550) (SETSEPR 59552 . 61094) (
|
||||
\GETREADSYNTAX 61096 . 63786) (\GTREADTABLE 63788 . 64013) (\GTREADTABLE1 64015 . 64271) (
|
||||
\ORIGREADTABLE 64273 . 66181) (\READCLASSTOCODE 66183 . 66634) (\SETMACROSYNTAX 66636 . 68431) (
|
||||
\SETREADSYNTAX 68433 . 69494) (\READTABLEP.DEFPRINT 69496 . 70539)) (83633 88086 (\ATBLSET 83643 .
|
||||
88084)) (88533 91065 (MAKE-READER-ENVIRONMENT 88543 . 89321) (EQUAL-READER-ENVIRONMENT 89323 . 90467)
|
||||
(SET-READER-ENVIRONMENT 90469 . 91063)))))
|
||||
(FILEMAP (NIL (18046 29198 (GETSYNTAX 18056 . 22887) (SETSYNTAX 22889 . 23962) (SYNTAXP 23964 . 26461)
|
||||
(\COPYSYNTAX 26463 . 27180) (\GETCHARCODE 27182 . 27470) (\SETFATSYNCODE 27472 . 28763) (
|
||||
\MAPCHARTABLE 28765 . 29196)) (29231 44197 (CONTROL 29241 . 29493) (COPYTERMTABLE 29495 . 29862) (
|
||||
DELETECONTROL 29864 . 32505) (GETDELETECONTROL 32507 . 33469) (ECHOCHAR 33471 . 34912) (ECHOCONTROL
|
||||
34914 . 35371) (ECHOMODE 35373 . 35619) (GETECHOMODE 35621 . 35785) (GETCONTROL 35787 . 35953) (
|
||||
GETTERMTABLE 35955 . 36022) (RAISE 36024 . 36450) (GETRAISE 36452 . 36614) (RESETTERMTABLE 36616 .
|
||||
37700) (SETTERMTABLE 37702 . 37936) (TERMTABLEP 37938 . 38099) (\GETTERMSYNTAX 38101 . 38372) (
|
||||
\GTTERMTABLE 38374 . 38710) (\ORIGTERMTABLE 38712 . 42322) (\SETTERMSYNTAX 42324 . 42959) (
|
||||
\TERMCLASSTOCODE 42961 . 43390) (\TERMCODETOCLASS 43392 . 43779) (\LITCHECK 43781 . 44195)) (46727
|
||||
70551 (COPYREADTABLE 46737 . 46935) (FIND-READTABLE 46937 . 47084) (IN-READTABLE 47086 . 47246) (
|
||||
ESCAPE 47248 . 47501) (GETBRK 47503 . 47641) (GETREADTABLE 47643 . 47779) (GETSEPR 47781 . 47919) (
|
||||
READMACROS 47921 . 48184) (READTABLEP 48186 . 48349) (READTABLEPROP 48351 . 53509) (RESETREADTABLE
|
||||
53511 . 57758) (SETBRK 57760 . 59370) (SETREADTABLE 59372 . 59560) (SETSEPR 59562 . 61104) (
|
||||
\GETREADSYNTAX 61106 . 63796) (\GTREADTABLE 63798 . 64023) (\GTREADTABLE1 64025 . 64281) (
|
||||
\ORIGREADTABLE 64283 . 66191) (\READCLASSTOCODE 66193 . 66644) (\SETMACROSYNTAX 66646 . 68441) (
|
||||
\SETREADSYNTAX 68443 . 69504) (\READTABLEP.DEFPRINT 69506 . 70549)) (83643 88096 (\ATBLSET 83653 .
|
||||
88094)) (88543 91975 (MAKE-READER-ENVIRONMENT 88553 . 90231) (EQUAL-READER-ENVIRONMENT 90233 . 91377)
|
||||
(SET-READER-ENVIRONMENT 91379 . 91973)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,14 +1,16 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "10-Aug-2020 21:44:38" {DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>IOCHAR.;5 90419
|
||||
|
||||
changes to%: (FNS FILEPOS FFILEPOS)
|
||||
(FILECREATED "24-Oct-2021 23:57:27"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>IOCHAR.;3 90360
|
||||
|
||||
previous date%: "11-Nov-2018 12:12:53"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>IOCHAR.;4)
|
||||
changes to%: (VARS IOCHARCOMS)
|
||||
|
||||
previous date%: "24-Oct-2021 23:53:23"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>IOCHAR.;2)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 2018, 2020 by Venue & Xerox Corporation. All rights reserved.
|
||||
Copyright (c) 1981-1988, 1990-1991, 2018, 2020 by Venue & Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT IOCHARCOMS)
|
||||
@@ -38,17 +40,17 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 2018,
|
||||
(\MIN.SEARCH.LENGTH 100)))
|
||||
(INITRESOURCES \FFDELTA1 \FFDELTA2 \FFPATCHAR))
|
||||
[COMS
|
||||
(* ;; "DATE Functions")
|
||||
(* ;; "DATE Functions")
|
||||
|
||||
(FNS DATE DATEFORMAT GDATE IDATE \IDATESCANTOKEN \IDATE-PARSE-MONTH \OUTDATE
|
||||
\OUTDATE-STRING \RPLRIGHT \UNPACKDATE \PACKDATE \DTSCAN \ISDST? \CHECKDSTCHANGE)
|
||||
(OPTIMIZERS DATEFORMAT)
|
||||
|
||||
(* ;; "Because DST begins the FIRST weekend in April now, \BeginDST changed from 120 to 98 as of 4/3/87 (JDS) Note: this only affects standalone users--those with time servers automatically get correct local info (bvm)")
|
||||
(* ;; "Because DST begins the FIRST weekend in April now, \BeginDST changed from 120 to 98 as of 4/3/87 (JDS) Note: this only affects standalone users--those with time servers automatically get correct local info (bvm)")
|
||||
|
||||
(INITVARS (\TimeZoneComp 8)
|
||||
(\BeginDST 98)
|
||||
(\EndDST 304)
|
||||
(\BeginDST 74)
|
||||
(\EndDST 312)
|
||||
(\DayLightSavings T))
|
||||
(ADDVARS (TIME.ZONES (8 "PST" "PDT")
|
||||
(7 "MST" "MDT")
|
||||
@@ -163,14 +165,14 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 2018,
|
||||
|
||||
(CL:DEFUN XCL:PACK (NAMES &OPTIONAL (PACKAGE *PACKAGE*))
|
||||
|
||||
(* ;;; "NAMES should be a list of symbols and strings. A new symbol is created in the given package with a print name equal to the concatenation of the of the NAMES. ")
|
||||
(* ;;; "NAMES should be a list of symbols and strings. A new symbol is created in the given package with a print name equal to the concatenation of the of the NAMES. ")
|
||||
|
||||
(CL:INTERN (CONCATLIST NAMES)
|
||||
PACKAGE))
|
||||
|
||||
(CL:DEFUN XCL:PACK* (&REST NAMES)
|
||||
|
||||
(* ;;; "NAMES should be a list of symbols and strings. A new symbol is created in the current package with a print name equal to the concatenation of the of the NAMES. ")
|
||||
(* ;;; "NAMES should be a list of symbols and strings. A new symbol is created in the current package with a print name equal to the concatenation of the of the NAMES. ")
|
||||
|
||||
(CL:INTERN (CONCATLIST NAMES)))
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
@@ -182,11 +184,11 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 2018,
|
||||
|
||||
(PUTPROPS \CATRANSLATE MACRO (OPENLAMBDA (CABASE CASIZE CAFAT CHAR)
|
||||
(COND
|
||||
((ILEQ CHAR CASIZE)(* ;
|
||||
"If it's in the table, use the table value")
|
||||
((ILEQ CHAR CASIZE)(* ;
|
||||
"If it's in the table, use the table value")
|
||||
(\GETBASEBYTE CABASE CHAR))
|
||||
(T (* ;
|
||||
"Off the end -- assume it's itself")
|
||||
(T (* ;
|
||||
"Off the end -- assume it's itself")
|
||||
CHAR))))
|
||||
)
|
||||
)
|
||||
@@ -1326,9 +1328,9 @@ DONTCOPY
|
||||
|
||||
(RPAQ? \TimeZoneComp 8)
|
||||
|
||||
(RPAQ? \BeginDST 98)
|
||||
(RPAQ? \BeginDST 74)
|
||||
|
||||
(RPAQ? \EndDST 304)
|
||||
(RPAQ? \EndDST 312)
|
||||
|
||||
(RPAQ? \DayLightSavings T)
|
||||
|
||||
@@ -1372,15 +1374,15 @@ DONTCOPY
|
||||
(PUTPROPS IOCHAR COPYRIGHT ("Venue & Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1988 1990
|
||||
1991 2018 2020))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3507 7301 (CHCON 3517 . 4367) (UNPACK 4369 . 5263) (DCHCON 5265 . 6532) (DUNPACK 6534
|
||||
. 7299)) (7302 18817 (UALPHORDER 7312 . 7408) (ALPHORDER 7410 . 9213) (CONCAT 9215 . 9860) (
|
||||
CONCATCODES 9862 . 10048) (PACKC 10050 . 12653) (PACK 12655 . 13234) (PACK* 13236 . 14958) (\PACK.ITEM
|
||||
14960 . 15415) (STRPOS 15417 . 18815)) (18819 19108 (XCL:PACK 18819 . 19108)) (19110 19360 (XCL:PACK*
|
||||
19110 . 19360)) (20078 22469 (STRPOSL 20088 . 21714) (MAKEBITTABLE 21716 . 22467)) (22631 23108 (
|
||||
CASEARRAY 22641 . 22831) (UPPERCASEARRAY 22833 . 23106)) (23430 47032 (FILEPOS 23440 . 33352) (
|
||||
FFILEPOS 33354 . 44467) (\SETUP.FFILEPOS 44469 . 47030)) (47820 89067 (DATE 47830 . 47916) (DATEFORMAT
|
||||
47918 . 48010) (GDATE 48012 . 48123) (IDATE 48125 . 59796) (\IDATESCANTOKEN 59798 . 61077) (
|
||||
\IDATE-PARSE-MONTH 61079 . 64775) (\OUTDATE 64777 . 77525) (\OUTDATE-STRING 77527 . 78142) (\RPLRIGHT
|
||||
78144 . 78382) (\UNPACKDATE 78384 . 84175) (\PACKDATE 84177 . 87497) (\DTSCAN 87499 . 87641) (\ISDST?
|
||||
87643 . 88150) (\CHECKDSTCHANGE 88152 . 89065)))))
|
||||
(FILEMAP (NIL (3448 7242 (CHCON 3458 . 4308) (UNPACK 4310 . 5204) (DCHCON 5206 . 6473) (DUNPACK 6475
|
||||
. 7240)) (7243 18758 (UALPHORDER 7253 . 7349) (ALPHORDER 7351 . 9154) (CONCAT 9156 . 9801) (
|
||||
CONCATCODES 9803 . 9989) (PACKC 9991 . 12594) (PACK 12596 . 13175) (PACK* 13177 . 14899) (\PACK.ITEM
|
||||
14901 . 15356) (STRPOS 15358 . 18756)) (18760 19049 (XCL:PACK 18760 . 19049)) (19051 19301 (XCL:PACK*
|
||||
19051 . 19301)) (20019 22410 (STRPOSL 20029 . 21655) (MAKEBITTABLE 21657 . 22408)) (22572 23049 (
|
||||
CASEARRAY 22582 . 22772) (UPPERCASEARRAY 22774 . 23047)) (23371 46973 (FILEPOS 23381 . 33293) (
|
||||
FFILEPOS 33295 . 44408) (\SETUP.FFILEPOS 44410 . 46971)) (47761 89008 (DATE 47771 . 47857) (DATEFORMAT
|
||||
47859 . 47951) (GDATE 47953 . 48064) (IDATE 48066 . 59737) (\IDATESCANTOKEN 59739 . 61018) (
|
||||
\IDATE-PARSE-MONTH 61020 . 64716) (\OUTDATE 64718 . 77466) (\OUTDATE-STRING 77468 . 78083) (\RPLRIGHT
|
||||
78085 . 78323) (\UNPACKDATE 78325 . 84116) (\PACKDATE 84118 . 87438) (\DTSCAN 87440 . 87582) (\ISDST?
|
||||
87584 . 88091) (\CHECKDSTCHANGE 88093 . 89006)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
406
sources/LLBASIC
406
sources/LLBASIC
@@ -1,19 +1,19 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "31-Jan-98 09:55:50" {DSK}<disk>disk2>jdstools>lc3>lispcore3.0>sources>LLBASIC.;13 118684
|
||||
|
||||
changes to%: (RECORDS PNAMEINDEX)
|
||||
(FILECREATED "27-Oct-2021 21:23:51" {DSK}<home>larry>medley>sources>LLBASIC.;2 120519
|
||||
|
||||
previous date%: "31-Jan-98 09:30:10"
|
||||
{DSK}<disk>disk2>jdstools>lc3>lispcore3.0>sources>LLBASIC.;12)
|
||||
changes to%: (FNS \SETGLOBALVAL.UFN \CREATE.SYMBOL)
|
||||
|
||||
previous date%: "31-Jan-98 09:55:50" {DSK}<home>larry>medley>sources>LLBASIC.;1)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1993, 1994, 1995, 1998 by Syntelligence Systems, Inc. This program or documentation contains confidential information and trade secrets of Syntelligence Systems, Inc. Reverse engineering, reverse compiling and disassembling of object code are prohibited. Use of this program or documentation is governed by written agreement with Syntelligence Systems, Inc. Use of copyright notice is precautionary and does not imply publication or disclosure of trade secrets. All rights reserved.
|
||||
Copyright (c) 1981-1988, 1990-1995, 1998 by Syntelligence Systems, Inc. This program or documentation contains confidential information and trade secrets of Syntelligence Systems, Inc. Reverse engineering, reverse compiling and disassembling of object code are prohibited. Use of this program or documentation is governed by written agreement with Syntelligence Systems, Inc. Use of copyright notice is precautionary and does not imply publication or disclosure of trade secrets.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT LLBASICCOMS)
|
||||
|
||||
(RPAQQ LLBASICCOMS
|
||||
(RPAQQ LLBASICCOMS
|
||||
((FNS LISTP LITATOM FIXP SMALLP NLISTP ARRAYP FLOATP NUMBERP STACKP)
|
||||
(FUNCTIONS ATOM)
|
||||
(DECLARE%: DONTCOPY (EXPORT (MACROS CHECK \StatsZero \StatsAdd1 IPLUS16 SMALLPOSP SETXVAR
|
||||
@@ -207,56 +207,59 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992,
|
||||
(DECLARE%: DONTCOPY
|
||||
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
|
||||
|
||||
[PUTPROPS CHECK MACRO (ARGS (COND
|
||||
[(AND (BOUNDP 'CHECK)
|
||||
CHECK)
|
||||
(CONS 'PROGN (for I in ARGS
|
||||
collect (LIST 'OR I
|
||||
(LIST 'RAID
|
||||
(KWOTE (LIST
|
||||
'Check-failure%:
|
||||
I]
|
||||
(T (CONS COMMENTFLG ARGS]
|
||||
(PUTPROPS CHECK MACRO [ARGS (COND
|
||||
[(AND (BOUNDP 'CHECK)
|
||||
CHECK)
|
||||
(CONS 'PROGN
|
||||
(for I in ARGS
|
||||
collect (LIST 'OR I
|
||||
(LIST 'RAID
|
||||
(KWOTE (LIST
|
||||
'
|
||||
Check-failure%:
|
||||
I]
|
||||
(T (CONS COMMENTFLG ARGS])
|
||||
|
||||
(PUTPROPS \StatsZero BYTEMACRO (OPENLAMBDA (N)
|
||||
(\PUTBASE N 0 0)
|
||||
(\PUTBASE N 1 0)))
|
||||
(PUTPROPS \StatsZero BYTEMACRO (OPENLAMBDA (N)
|
||||
(\PUTBASE N 0 0)
|
||||
(\PUTBASE N 1 0)))
|
||||
|
||||
[PUTPROPS \StatsAdd1 DMACRO (OPENLAMBDA (A)
|
||||
(PROG ((LO (IPLUS16 (\GETBASE A 1)
|
||||
1)))
|
||||
(DECLARE (LOCALVARS LO))
|
||||
(PUTPROPS \StatsAdd1 DMACRO [OPENLAMBDA (A)
|
||||
(PROG ((LO (IPLUS16 (\GETBASE A 1)
|
||||
1)))
|
||||
(DECLARE (LOCALVARS LO))
|
||||
(* ; "Increment double word at A by 1")
|
||||
(\PUTBASE A 1 LO)
|
||||
(COND
|
||||
((EQ LO 0)
|
||||
(\PUTBASE A 0 (ADD1 (\GETBASE A 0]
|
||||
(\PUTBASE A 1 LO)
|
||||
(COND
|
||||
((EQ LO 0)
|
||||
(\PUTBASE A 0 (ADD1 (\GETBASE A 0])
|
||||
|
||||
[PUTPROPS IPLUS16 MACRO ((X Y) (* ; "Kludge to do 16-bit plus")
|
||||
(\LOLOC (\ADDBASE X Y]
|
||||
(PUTPROPS IPLUS16 MACRO ((X Y) (* ; "Kludge to do 16-bit plus")
|
||||
(\LOLOC (\ADDBASE X Y))))
|
||||
|
||||
[PUTPROPS SMALLPOSP MACRO (OPENLAMBDA (X)
|
||||
(AND (SMALLP X)
|
||||
(IGEQ X 0]
|
||||
(PUTPROPS SMALLPOSP MACRO (OPENLAMBDA (X)
|
||||
(AND (SMALLP X)
|
||||
(IGEQ X 0))))
|
||||
|
||||
[PROGN [PUTPROPS SETXVAR MACRO (X `(SETQ.NOREF %, (CADAR X)
|
||||
%,
|
||||
(CADR X]
|
||||
(PUTPROPS SETXVAR DMACRO (X (OR (AND (EQ (CAAR X)
|
||||
'QUOTE)
|
||||
(LITATOM (CADAR X)))
|
||||
(SHOULDNT))
|
||||
(GLOBALVARS \VALSPACE)
|
||||
(LIST 'SETQ.NOREF (CADAR X)
|
||||
(CADR X]
|
||||
[PROGN (PUTPROPS SETXVAR MACRO [X `(SETQ.NOREF %, (CADAR X)
|
||||
%,
|
||||
(CADR X])
|
||||
(PUTPROPS SETXVAR DMACRO (X (OR (AND (EQ (CAAR X)
|
||||
'QUOTE)
|
||||
(LITATOM (CADAR X)))
|
||||
(SHOULDNT))
|
||||
(GLOBALVARS \VALSPACE)
|
||||
(LIST 'SETQ.NOREF (CADAR X)
|
||||
(CADR X))))]
|
||||
|
||||
(PUTPROPS SETQ.NOREF DMACRO ((VAR VAL)
|
||||
(\PUTBASEPTR (LOCF (fetch (LITATOM VALUE) of 'VAR))
|
||||
0 VAL)))
|
||||
(PUTPROPS SETQ.NOREF DMACRO ((VAR VAL)
|
||||
(\PUTBASEPTR (LOCF (fetch (LITATOM VALUE)
|
||||
of 'VAR))
|
||||
0 VAL)))
|
||||
|
||||
(PROGN (PUTPROPS IEQ MACRO ((X Y)
|
||||
(IEQP X Y)))
|
||||
(PUTPROPS IEQ DMACRO (= . EQ)))
|
||||
(PROGN (PUTPROPS IEQ MACRO ((X Y)
|
||||
(IEQP X Y)))
|
||||
(PUTPROPS IEQ DMACRO (= . EQ)))
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
@@ -318,8 +321,12 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992,
|
||||
(replace (LITATOM VALUE) of ATM with VAL])
|
||||
|
||||
(\SETGLOBALVAL.UFN
|
||||
[LAMBDA (V A) (* bvm%: " 6-Jun-85 11:54")
|
||||
(replace (VALINDEX VALUE) of A with V])
|
||||
[LAMBDA (V A) (* ;
|
||||
"Edited 27-Oct-2021 21:18 by larry")
|
||||
(* ;
|
||||
"Edited 27-Oct-2021 21:13 by larry")
|
||||
(* bvm%: " 6-Jun-85 11:54")
|
||||
(replace (VCELL VALUE) of (\VALCELL A) with V])
|
||||
|
||||
(\SETFVAR.UFN
|
||||
[LAMBDA (V VCELL) (* edited%: " 3-Apr-85 16:40")
|
||||
@@ -370,8 +377,8 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992,
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
[PUTPROPS \PROPCELL MACRO ((ATOM)
|
||||
(\ATOMCELL ATOM (CONSTANT \PLIST.HI]
|
||||
(PUTPROPS \PROPCELL MACRO ((ATOM)
|
||||
(\ATOMCELL ATOM (CONSTANT \PLIST.HI))))
|
||||
)
|
||||
|
||||
(DEFOPTIMIZER \ATOMCELL (&REST X)
|
||||
@@ -492,7 +499,11 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992,
|
||||
NEWATOM))])
|
||||
|
||||
(\CREATE.SYMBOL
|
||||
[LAMBDA (BASE OFFSET LEN FATP FATCHARSEENP) (* ; "Edited 8-Feb-93 16:48 by jds")
|
||||
[LAMBDA (BASE OFFSET LEN FATP FATCHARSEENP) (* ;
|
||||
"Edited 27-Oct-2021 21:21 by larry")
|
||||
(* ;
|
||||
"Edited 27-Oct-2021 21:13 by larry")
|
||||
(* ; "Edited 8-Feb-93 16:48 by jds")
|
||||
|
||||
(* ;;; "Creates a new symbol whose pname is as indicated. FATP means the presented string is fat, while FATCHARSEENP means that there actually is a fat char in there (otherwise we will store a thin pname) --- Must be called UNINTERRUPTABLY and the caller is responsible for interning the symbol wherever it belongs")
|
||||
|
||||
@@ -522,7 +533,7 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992,
|
||||
(* ;; "Now, just create us a NEW-ATOM, and keep going:")
|
||||
|
||||
(SETQ ATM (CREATECELL \NEW-ATOM))
|
||||
(REPLACE (VALINDEX VALUE) OF ATM WITH 'NOBIND))
|
||||
(replace (VCELL VALUE) of (\VALCELL ATM) with 'NOBIND))
|
||||
((EVENP ATM 256) (* ;
|
||||
"Can fit 256 new atoms into 10 pages.")
|
||||
|
||||
@@ -764,17 +775,18 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992,
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS MDSTYPE# MACRO ((PAGE#)
|
||||
(LOGAND (\GETBASE \MDSTypeTable (LRSH PAGE# 1))
|
||||
\TT.TYPEMASK)))
|
||||
(PUTPROPS MDSTYPE# MACRO ((PAGE#)
|
||||
(LOGAND (\GETBASE \MDSTypeTable (LRSH PAGE# 1))
|
||||
\TT.TYPEMASK)))
|
||||
|
||||
[PUTPROPS .ALLOCATED.PER.PAGE. MACRO (OPENLAMBDA (SIZE) (* Maybe change this some day to a
|
||||
(PUTPROPS .ALLOCATED.PER.PAGE. MACRO (OPENLAMBDA (SIZE)
|
||||
(* Maybe change this some day to a
|
||||
fetch of a flag from the DTD)
|
||||
(AND (IGEQ (LISPVERSION)
|
||||
37384)
|
||||
(ILESSP (IREMAINDER WORDSPERPAGE SIZE)
|
||||
(LRSH SIZE 1))
|
||||
(ILESSP SIZE WORDSPERPAGE]
|
||||
(AND (IGEQ (LISPVERSION)
|
||||
37384)
|
||||
(ILESSP (IREMAINDER WORDSPERPAGE SIZE)
|
||||
(LRSH SIZE 1))
|
||||
(ILESSP SIZE WORDSPERPAGE))))
|
||||
)
|
||||
|
||||
|
||||
@@ -790,7 +802,7 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992,
|
||||
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS READSYS.HAS.PACKAGES MACRO (NIL (NEQ 1 READSYS.PACKAGE.FROM.NAME)))
|
||||
(PUTPROPS READSYS.HAS.PACKAGES MACRO (NIL (NEQ 1 READSYS.PACKAGE.FROM.NAME)))
|
||||
)
|
||||
|
||||
(RPAQQ READSYS.PACKAGE.FROM.NAME 1)
|
||||
@@ -1715,91 +1727,91 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992,
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS \DEFCELL MACRO ((ATOM)
|
||||
(\ATOMCELL ATOM \DEF.HI)))
|
||||
(PUTPROPS \DEFCELL MACRO ((ATOM)
|
||||
(\ATOMCELL ATOM \DEF.HI)))
|
||||
|
||||
(PUTPROPS \VALCELL MACRO ((ATOM)
|
||||
(\ATOMCELL ATOM \VAL.HI)))
|
||||
(PUTPROPS \VALCELL MACRO ((ATOM)
|
||||
(\ATOMCELL ATOM \VAL.HI)))
|
||||
|
||||
(PUTPROPS \PNAMECELL MACRO ((ATOM)
|
||||
(\ATOMCELL ATOM \PNAME.HI)))
|
||||
(PUTPROPS \PNAMECELL MACRO ((ATOM)
|
||||
(\ATOMCELL ATOM \PNAME.HI)))
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
[PUTPROPS \ATOMVALINDEX DMACRO (OPENLAMBDA (X)
|
||||
(COND
|
||||
((EQ (NTYPX X)
|
||||
\LITATOM) (* ; "Original litatoms")
|
||||
(\LOLOC X))
|
||||
((EQ (NTYPX X)
|
||||
\NEW-ATOM) (* ; "new 3-byte symbols")
|
||||
X)
|
||||
(T (SHOULDNT]
|
||||
(PUTPROPS \ATOMVALINDEX DMACRO [OPENLAMBDA (X)
|
||||
(COND
|
||||
((EQ (NTYPX X)
|
||||
\LITATOM) (* ; "Original litatoms")
|
||||
(\LOLOC X))
|
||||
((EQ (NTYPX X)
|
||||
\NEW-ATOM) (* ; "new 3-byte symbols")
|
||||
X)
|
||||
(T (SHOULDNT])
|
||||
|
||||
[PUTPROPS \ATOMDEFINDEX DMACRO (OPENLAMBDA (X)
|
||||
(COND
|
||||
((EQ (NTYPX X)
|
||||
\LITATOM) (* ; "Original litatoms")
|
||||
(\LOLOC X))
|
||||
((EQ (NTYPX X)
|
||||
\NEW-ATOM) (* ; "new 3-byte symbols")
|
||||
X)
|
||||
(T (SHOULDNT]
|
||||
(PUTPROPS \ATOMDEFINDEX DMACRO [OPENLAMBDA (X)
|
||||
(COND
|
||||
((EQ (NTYPX X)
|
||||
\LITATOM) (* ; "Original litatoms")
|
||||
(\LOLOC X))
|
||||
((EQ (NTYPX X)
|
||||
\NEW-ATOM) (* ; "new 3-byte symbols")
|
||||
X)
|
||||
(T (SHOULDNT])
|
||||
|
||||
[PUTPROPS \ATOMPNAMEINDEX DMACRO (OPENLAMBDA (X)
|
||||
(COND
|
||||
((EQ (NTYPX X)
|
||||
\LITATOM) (* ; "Original litatoms")
|
||||
(\LOLOC X))
|
||||
((EQ (NTYPX X)
|
||||
\NEW-ATOM) (* ; "new 3-byte symbols")
|
||||
X)
|
||||
(T (SHOULDNT]
|
||||
(PUTPROPS \ATOMPNAMEINDEX DMACRO [OPENLAMBDA (X)
|
||||
(COND
|
||||
((EQ (NTYPX X)
|
||||
\LITATOM) (* ; "Original litatoms")
|
||||
(\LOLOC X))
|
||||
((EQ (NTYPX X)
|
||||
\NEW-ATOM)(* ; "new 3-byte symbols")
|
||||
X)
|
||||
(T (SHOULDNT])
|
||||
|
||||
[PUTPROPS \ATOMPROPINDEX DMACRO ((X)
|
||||
(COND
|
||||
((EQ (NTYPX X)
|
||||
\LITATOM) (* ; "Original litatoms")
|
||||
(\LOLOC X))
|
||||
((EQ (NTYPX X)
|
||||
\NEW-ATOM) (* ; "new 3-byte symbols")
|
||||
X)
|
||||
(T (SHOULDNT]
|
||||
(PUTPROPS \ATOMPROPINDEX DMACRO [(X)
|
||||
(COND
|
||||
((EQ (NTYPX X)
|
||||
\LITATOM) (* ; "Original litatoms")
|
||||
(\LOLOC X))
|
||||
((EQ (NTYPX X)
|
||||
\NEW-ATOM) (* ; "new 3-byte symbols")
|
||||
X)
|
||||
(T (SHOULDNT])
|
||||
|
||||
[PUTPROPS \INDEXATOMPNAME DMACRO (OPENLAMBDA (X)
|
||||
(COND
|
||||
[(FIXP X) (* ; "Xerox Lisp traditional symbol")
|
||||
(COND
|
||||
((SMALLP X)
|
||||
(\VAG2 \AtomHI X))
|
||||
(T (\VAG2 (LRSH X 16)
|
||||
(LOGAND X 65535]
|
||||
(T (* ; "New symbol")
|
||||
X]
|
||||
(PUTPROPS \INDEXATOMPNAME DMACRO (OPENLAMBDA (X)
|
||||
(COND
|
||||
[(FIXP X) (* ; "Xerox Lisp traditional symbol")
|
||||
(COND
|
||||
((SMALLP X)
|
||||
(\VAG2 \AtomHI X))
|
||||
(T (\VAG2 (LRSH X 16)
|
||||
(LOGAND X 65535]
|
||||
(T (* ; "New symbol")
|
||||
X))))
|
||||
|
||||
[PUTPROPS \INDEXATOMVAL DMACRO (OPENLAMBDA (X)
|
||||
(COND
|
||||
[(FIXP X) (* ; "Xerox Lisp traditional symbol")
|
||||
(COND
|
||||
((SMALLP X)
|
||||
(\VAG2 \AtomHI X))
|
||||
(T (\VAG2 (LRSH X 16)
|
||||
(LOGAND X 65535]
|
||||
(T (* ; "New symbol")
|
||||
X]
|
||||
(PUTPROPS \INDEXATOMVAL DMACRO (OPENLAMBDA (X)
|
||||
(COND
|
||||
[(FIXP X) (* ; "Xerox Lisp traditional symbol")
|
||||
(COND
|
||||
((SMALLP X)
|
||||
(\VAG2 \AtomHI X))
|
||||
(T (\VAG2 (LRSH X 16)
|
||||
(LOGAND X 65535]
|
||||
(T (* ; "New symbol")
|
||||
X))))
|
||||
|
||||
[PUTPROPS \INDEXATOMDEF DMACRO (OPENLAMBDA (X)
|
||||
(COND
|
||||
[(FIXP X) (* ; "Xerox Lisp traditional symbol")
|
||||
(COND
|
||||
((SMALLP X)
|
||||
(\VAG2 \AtomHI X))
|
||||
(T (\VAG2 (LRSH X 16)
|
||||
(LOGAND X 65535]
|
||||
(T (* ; "New symbol")
|
||||
X]
|
||||
(PUTPROPS \INDEXATOMDEF DMACRO (OPENLAMBDA (X)
|
||||
(COND
|
||||
[(FIXP X) (* ; "Xerox Lisp traditional symbol")
|
||||
(COND
|
||||
((SMALLP X)
|
||||
(\VAG2 \AtomHI X))
|
||||
(T (\VAG2 (LRSH X 16)
|
||||
(LOGAND X 65535]
|
||||
(T (* ; "New symbol")
|
||||
X))))
|
||||
|
||||
(PUTPROPS \ATOMNUMBER DMACRO (= . \LOLOC))
|
||||
(PUTPROPS \ATOMNUMBER DMACRO (= . \LOLOC))
|
||||
)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
@@ -1842,35 +1854,36 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992,
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
[PUTPROPS COMPUTE.ATOM.HASH MACRO ((BASE OFFST LEN FIRSTBYTE FATP)
|
||||
(PUTPROPS COMPUTE.ATOM.HASH MACRO [(BASE OFFST LEN FIRSTBYTE FATP)
|
||||
(* ;
|
||||
"Sets variable HASH to atom hash of indicated string")
|
||||
(SETQ HASH (LLSH FIRSTBYTE 8))
|
||||
(for CHAR# from (ADD1 OFFST)
|
||||
to (SUB1 (IPLUS OFFST LEN))
|
||||
do (SETQ HASH
|
||||
(IPLUS16 (IPLUS16 (SETQ HASH
|
||||
(IPLUS16 HASH
|
||||
(LLSH (LOGAND HASH 4095)
|
||||
2)))
|
||||
(LLSH (LOGAND HASH 255)
|
||||
8))
|
||||
(UNLESSRDSYS (COND
|
||||
(FATP (LOGAND (\GETBASEFAT
|
||||
BASE CHAR#)
|
||||
255))
|
||||
(T (\GETBASETHIN BASE CHAR#)))
|
||||
(NTHCHARCODE BASE CHAR#]
|
||||
(SETQ HASH (LLSH FIRSTBYTE 8))
|
||||
(for CHAR# from (ADD1 OFFST)
|
||||
to (SUB1 (IPLUS OFFST LEN))
|
||||
do (SETQ HASH
|
||||
(IPLUS16 (IPLUS16 (SETQ HASH
|
||||
(IPLUS16 HASH
|
||||
(LLSH (LOGAND HASH
|
||||
4095)
|
||||
2)))
|
||||
(LLSH (LOGAND HASH 255)
|
||||
8))
|
||||
(UNLESSRDSYS
|
||||
(COND
|
||||
(FATP (LOGAND (\GETBASEFAT BASE
|
||||
CHAR#)
|
||||
255))
|
||||
(T (\GETBASETHIN BASE CHAR#)))
|
||||
(NTHCHARCODE BASE CHAR#])
|
||||
|
||||
[PUTPROPS ATOM.HASH.REPROBE MACRO ((HASH FIRSTBYTE)
|
||||
(LOGAND 63 (LOGOR 1 (LOGXOR FIRSTBYTE HASH]
|
||||
(PUTPROPS ATOM.HASH.REPROBE MACRO [(HASH FIRSTBYTE)
|
||||
(LOGAND 63 (LOGOR 1 (LOGXOR FIRSTBYTE HASH])
|
||||
)
|
||||
|
||||
|
||||
(ADDTOVAR DONTCOMPILEFNS
|
||||
INITATOMS COPYATOM UNCOPYATOM READATOM MAKE.LOCAL.ATOM SYMBOL.VALUE SYMBOL.PNAME
|
||||
SYMBOL.PACKAGE OLD.FIND.SYMBOL LOOKUP-SYMBOL FIND.PACKAGE FIND.SYMBOL PACKAGE.NAME
|
||||
GETDEFN PUTDEFN FSETVAL)
|
||||
(ADDTOVAR DONTCOMPILEFNS INITATOMS COPYATOM UNCOPYATOM READATOM MAKE.LOCAL.ATOM SYMBOL.VALUE
|
||||
SYMBOL.PNAME SYMBOL.PACKAGE OLD.FIND.SYMBOL LOOKUP-SYMBOL
|
||||
FIND.PACKAGE FIND.SYMBOL PACKAGE.NAME GETDEFN PUTDEFN FSETVAL)
|
||||
)
|
||||
|
||||
|
||||
@@ -2079,17 +2092,17 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992,
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS .CLEARNWORDS. MACRO (OPENLAMBDA (BASE NWORDS)
|
||||
(PUTPROPS .CLEARNWORDS. MACRO (OPENLAMBDA (BASE NWORDS)
|
||||
|
||||
(* ;; "Clear NWORDS words starting at base. Assumes NWORDS is smallp and greater than zero. Compiler refuses to optimize out an IGREATERP test here, so push back to caller")
|
||||
|
||||
(\PUTBASE BASE (SUB1 NWORDS)
|
||||
0)
|
||||
[COND
|
||||
((NEQ NWORDS 1)
|
||||
(\BLT BASE (\ADDBASE BASE 1)
|
||||
(SUB1 NWORDS]
|
||||
NIL))
|
||||
(\PUTBASE BASE (SUB1 NWORDS)
|
||||
0)
|
||||
[COND
|
||||
((NEQ NWORDS 1)
|
||||
(\BLT BASE (\ADDBASE BASE 1)
|
||||
(SUB1 NWORDS]
|
||||
NIL))
|
||||
)
|
||||
)
|
||||
|
||||
@@ -2100,10 +2113,10 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992,
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS \MOVEWORDS MACRO (OPENLAMBDA (SBASE SOFFSET DBASE DOFFSET NWORDS)
|
||||
(\BLT (\ADDBASE DBASE DOFFSET)
|
||||
(\ADDBASE SBASE SOFFSET)
|
||||
NWORDS)))
|
||||
(PUTPROPS \MOVEWORDS MACRO (OPENLAMBDA (SBASE SOFFSET DBASE DOFFSET NWORDS)
|
||||
(\BLT (\ADDBASE DBASE DOFFSET)
|
||||
(\ADDBASE SBASE SOFFSET)
|
||||
NWORDS)))
|
||||
)
|
||||
|
||||
(* "END EXPORTED DEFINITIONS")
|
||||
@@ -2181,39 +2194,38 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992,
|
||||
(\ATOMNUMBER . VATOMNUMBER)
|
||||
(\CREATE.SYMBOL . VNOSUCHATOM))
|
||||
|
||||
(ADDTOVAR RDCOMS
|
||||
(FNS UNCOPYATOM MAKE.LOCAL.ATOM SYMBOL.VALUE SYMBOL.PNAME SYMBOL.PACKAGE OLD.FIND.SYMBOL
|
||||
LOOKUP-SYMBOL FIND.PACKAGE FIND.SYMBOL PACKAGE.NAME \MKATOM GETTOPVAL GETPROPLIST
|
||||
SETTOPVAL GETDEFN \ATOMCELL)
|
||||
(FNS LISTP)
|
||||
(VARS (COPYATOMSTR)))
|
||||
(ADDTOVAR RDCOMS (FNS UNCOPYATOM MAKE.LOCAL.ATOM SYMBOL.VALUE SYMBOL.PNAME SYMBOL.PACKAGE
|
||||
OLD.FIND.SYMBOL LOOKUP-SYMBOL FIND.PACKAGE FIND.SYMBOL PACKAGE.NAME \MKATOM
|
||||
GETTOPVAL GETPROPLIST SETTOPVAL GETDEFN \ATOMCELL)
|
||||
(FNS LISTP)
|
||||
(VARS (COPYATOMSTR)))
|
||||
|
||||
(ADDTOVAR RD.SUBFNS (\RPLPTR . VPUTBASEPTR))
|
||||
|
||||
(ADDTOVAR RDVALS (\AtomFrLst))
|
||||
)
|
||||
|
||||
(PUTPROPS LLBASIC FILETYPE CL:COMPILE-FILE)
|
||||
(PUTPROPS LLBASIC FILETYPE CL:COMPILE-FILE)
|
||||
(PUTPROPS LLBASIC COPYRIGHT (
|
||||
"Syntelligence Systems, Inc. This program or documentation contains confidential information and trade secrets of Syntelligence Systems, Inc. Reverse engineering, reverse compiling and disassembling of object code are prohibited. Use of this program or documentation is governed by written agreement with Syntelligence Systems, Inc. Use of copyright notice is precautionary and does not imply publication or disclosure of trade secrets"
|
||||
1981 1982 1983 1984 1985 1986 1987 1988 1990 1991 1992 1993 1994 1995 1998))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (9820 12218 (LISTP 9830 . 10413) (LITATOM 10415 . 10682) (FIXP 10684 . 10921) (SMALLP
|
||||
10923 . 11178) (NLISTP 11180 . 11393) (ARRAYP 11395 . 11650) (FLOATP 11652 . 11907) (NUMBERP 11909 .
|
||||
12055) (STACKP 12057 . 12216)) (15995 19501 (GETTOPVAL 16005 . 16161) (SETTOPVAL 16163 . 16532) (
|
||||
FSETVAL 16534 . 16881) (\SETGLOBALVAL.UFN 16883 . 17054) (\SETFVAR.UFN 17056 . 17226) (GETPROPLIST
|
||||
17228 . 17388) (\ATOMCELL 17390 . 19319) (SETPROPLIST 19321 . 19499)) (20325 34368 (\MKATOM 20335 .
|
||||
27567) (\CREATE.SYMBOL 27569 . 31866) (\MKATOM.FULL 31868 . 32345) (\INITATOMPAGE 32347 . 34366)) (
|
||||
34369 43358 (MAPATOMS 34379 . 37686) (ATOMHASH#PROBES 37688 . 42551) (\SFLHASHLOOKUP 42553 . 43356)) (
|
||||
45385 74528 (INITATOMS 45395 . 47439) (COPYATOM 47441 . 51860) (UNCOPYATOM 51862 . 52659) (
|
||||
MAKE.LOCAL.ATOM 52661 . 53408) (SYMBOL.VALUE 53410 . 54190) (SYMBOL.PNAME 54192 . 55353) (
|
||||
SYMBOL.PACKAGE 55355 . 56469) (OLD.FIND.SYMBOL 56471 . 63826) (LOOKUP-SYMBOL 63828 . 67022) (
|
||||
FIND.PACKAGE 67024 . 69226) (FIND.SYMBOL 69228 . 74357) (PACKAGE.NAME 74359 . 74526)) (74802 81505 (
|
||||
\DEFINEDP 74812 . 75015) (PUTD 75017 . 75815) (\PUTD 75817 . 78533) (GETD 78535 . 79167) (PUTDEFN
|
||||
79169 . 81347) (GETDEFN 81349 . 81503)) (81506 85926 (\STKMIN 81516 . 85924)) (104646 107529 (
|
||||
\RESETSYSTEMSTATE 104656 . 104813) (INITIALEVALQT 104815 . 106420) (SIMPLEPRINT 106422 . 107527)) (
|
||||
107624 108423 (PAGEFAULTS 107634 . 107828) (\SETTOTALTIME 107830 . 108247) (\SERIALNUMBER 108249 .
|
||||
108421)) (108487 113398 (\BLT 108497 . 109395) (\MOVEBYTES 109397 . 110841) (\CLEARWORDS 110843 .
|
||||
111537) (\CLEARBYTES 111539 . 112343) (\CLEARCELLS 112345 . 113396)) (114545 115996 (\MOVEWORDS 114555
|
||||
. 114758) (\ZEROBYTES 114760 . 114932) (\ZEROWORDS 114934 . 115994)))))
|
||||
(FILEMAP (NIL (9717 12115 (LISTP 9727 . 10310) (LITATOM 10312 . 10579) (FIXP 10581 . 10818) (SMALLP
|
||||
10820 . 11075) (NLISTP 11077 . 11290) (ARRAYP 11292 . 11547) (FLOATP 11549 . 11804) (NUMBERP 11806 .
|
||||
11952) (STACKP 11954 . 12113)) (16335 20191 (GETTOPVAL 16345 . 16501) (SETTOPVAL 16503 . 16872) (
|
||||
FSETVAL 16874 . 17221) (\SETGLOBALVAL.UFN 17223 . 17744) (\SETFVAR.UFN 17746 . 17916) (GETPROPLIST
|
||||
17918 . 18078) (\ATOMCELL 18080 . 20009) (SETPROPLIST 20011 . 20189)) (21034 35427 (\MKATOM 21044 .
|
||||
28276) (\CREATE.SYMBOL 28278 . 32925) (\MKATOM.FULL 32927 . 33404) (\INITATOMPAGE 33406 . 35425)) (
|
||||
35428 44417 (MAPATOMS 35438 . 38745) (ATOMHASH#PROBES 38747 . 43610) (\SFLHASHLOOKUP 43612 . 44415)) (
|
||||
46558 75701 (INITATOMS 46568 . 48612) (COPYATOM 48614 . 53033) (UNCOPYATOM 53035 . 53832) (
|
||||
MAKE.LOCAL.ATOM 53834 . 54581) (SYMBOL.VALUE 54583 . 55363) (SYMBOL.PNAME 55365 . 56526) (
|
||||
SYMBOL.PACKAGE 56528 . 57642) (OLD.FIND.SYMBOL 57644 . 64999) (LOOKUP-SYMBOL 65001 . 68195) (
|
||||
FIND.PACKAGE 68197 . 70399) (FIND.SYMBOL 70401 . 75530) (PACKAGE.NAME 75532 . 75699)) (75975 82678 (
|
||||
\DEFINEDP 75985 . 76188) (PUTD 76190 . 76988) (\PUTD 76990 . 79706) (GETD 79708 . 80340) (PUTDEFN
|
||||
80342 . 82520) (GETDEFN 82522 . 82676)) (82679 87099 (\STKMIN 82689 . 87097)) (106399 109282 (
|
||||
\RESETSYSTEMSTATE 106409 . 106566) (INITIALEVALQT 106568 . 108173) (SIMPLEPRINT 108175 . 109280)) (
|
||||
109377 110176 (PAGEFAULTS 109387 . 109581) (\SETTOTALTIME 109583 . 110000) (\SERIALNUMBER 110002 .
|
||||
110174)) (110240 115151 (\BLT 110250 . 111148) (\MOVEBYTES 111150 . 112594) (\CLEARWORDS 112596 .
|
||||
113290) (\CLEARBYTES 113292 . 114096) (\CLEARCELLS 114098 . 115149)) (116344 117795 (\MOVEWORDS 116354
|
||||
. 116557) (\ZEROBYTES 116559 . 116731) (\ZEROWORDS 116733 . 117793)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
293
sources/LLINTERP
293
sources/LLINTERP
@@ -1,13 +1,14 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED " 2-Feb-95 17:31:23" {DSK}<lispcore>sources>LLINTERP.;3 120814
|
||||
|
||||
changes to%: (VARS LLINTERPCOMS)
|
||||
(FILECREATED "27-Oct-2021 21:03:21" {DSK}<home>larry>medley>sources>LLINTERP.;2 127414
|
||||
|
||||
previous date%: "31-Aug-94 14:38:32" {DSK}<lispcore>sources>LLINTERP.;2)
|
||||
changes to%: (FNS \STKSCAN)
|
||||
|
||||
previous date%: " 2-Feb-95 17:31:23" {DSK}<home>larry>medley>sources>LLINTERP.;1)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1994, 1995 by Venue & Xerox Corporation. All rights reserved.
|
||||
Copyright (c) 1981-1988, 1990-1992, 1994-1995 by Venue & Xerox Corporation.
|
||||
The following program was created in 1981 but has not been published
|
||||
within the meaning of the copyright law, is furnished under license,
|
||||
and may not be used, copied and/or disclosed except in accordance
|
||||
@@ -16,7 +17,7 @@ with the terms of said license.
|
||||
|
||||
(PRETTYCOMPRINT LLINTERPCOMS)
|
||||
|
||||
(RPAQQ LLINTERPCOMS
|
||||
(RPAQQ LLINTERPCOMS
|
||||
[(COMS (* ; "Compilation pre-requisites")
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
|
||||
LLBASIC LLSTK LLCODE LLPARAMS ACODE)))
|
||||
@@ -368,35 +369,36 @@ with the terms of said license.
|
||||
(DECLARE%: DONTCOPY
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
[PUTPROPS .APPLY. MACRO ((U V) (* body for APPLY, used by RETAPPLY
|
||||
(PUTPROPS .APPLY. MACRO [(U V) (* body for APPLY, used by RETAPPLY
|
||||
too)
|
||||
(PROG ((DEF U))
|
||||
LP [COND
|
||||
((LITATOM DEF)
|
||||
(COND
|
||||
((NOT (fetch (LITATOM CCODEP) of DEF))
|
||||
(PROG ((DEF U))
|
||||
LP [COND
|
||||
((LITATOM DEF)
|
||||
(COND
|
||||
((NOT (fetch (LITATOM CCODEP) of DEF))
|
||||
(* EXPR)
|
||||
(SETQ DEF (fetch (LITATOM DEFPOINTER) of DEF)))
|
||||
((EQ (fetch (LITATOM ARGTYPE) of DEF)
|
||||
3)
|
||||
(GO NLSTAR))
|
||||
(T (GO NORMAL]
|
||||
[COND
|
||||
((LISTP DEF)
|
||||
(SELECTQ (CAR DEF)
|
||||
(NLAMBDA (AND (NLISTP (CADR DEF))
|
||||
(CADR DEF)
|
||||
(GO NLSTAR)))
|
||||
(FUNARG (SETQ DEF (CADR DEF))
|
||||
(GO LP))
|
||||
NIL))
|
||||
((NULL DEF)
|
||||
(RETURN (FAULTAPPLY U V]
|
||||
NORMAL
|
||||
(RETURN (SPREADAPPLY U V))
|
||||
NLSTAR
|
||||
(SETQ DEF (fetch (LITATOM DEFPOINTER) of
|
||||
DEF)))
|
||||
((EQ (fetch (LITATOM ARGTYPE) of DEF)
|
||||
3)
|
||||
(GO NLSTAR))
|
||||
(T (GO NORMAL]
|
||||
[COND
|
||||
((LISTP DEF)
|
||||
(SELECTQ (CAR DEF)
|
||||
(NLAMBDA (AND (NLISTP (CADR DEF))
|
||||
(CADR DEF)
|
||||
(GO NLSTAR)))
|
||||
(FUNARG (SETQ DEF (CADR DEF))
|
||||
(GO LP))
|
||||
NIL))
|
||||
((NULL DEF)
|
||||
(RETURN (FAULTAPPLY U V]
|
||||
NORMAL
|
||||
(RETURN (SPREADAPPLY U V))
|
||||
NLSTAR
|
||||
(* NLAMBDA*)
|
||||
(RETURN (SPREADAPPLY* U V]
|
||||
(RETURN (SPREADAPPLY* U V])
|
||||
)
|
||||
)
|
||||
|
||||
@@ -444,7 +446,9 @@ with the terms of said license.
|
||||
(GO LP])])
|
||||
|
||||
(\STKSCAN
|
||||
[LAMBDA (VAR) (* ; "Edited 27-Jan-91 14:48 by jds")
|
||||
[LAMBDA (VAR) (* ;
|
||||
"Edited 27-Oct-2021 20:51 by larry")
|
||||
(* ; "Edited 27-Jan-91 14:48 by jds")
|
||||
|
||||
(* ;; "Returns pointer to place where VAR is bound")
|
||||
|
||||
@@ -455,7 +459,7 @@ with the terms of said license.
|
||||
[COND
|
||||
((fetch (FX INVALIDP) of FX) (* ;
|
||||
"Reached top of stack without finding a binding")
|
||||
(RETURN (fetch (VALINDEX VCELL) of ATOM#]
|
||||
(RETURN (\VALCELL VAR]
|
||||
(SETQ NT (fetch (FX NAMETABLE) of FX))
|
||||
(SETQ NTSIZE (fetch (FNHEADER NTSIZE) of NT))
|
||||
(SETQ NT (\ADDBASE NT (fetch (FNHEADER OVERHEADWORDS) of T)))
|
||||
@@ -1216,9 +1220,8 @@ with the terms of said license.
|
||||
)
|
||||
)
|
||||
|
||||
(RPAQ? OPENFNS
|
||||
'(APPLY* SETQ AND OR COND SELECTQ PROG PROGN PROG1 ARG SETARG ERSETQ NLSETQ RESETFORM RESETLST
|
||||
RESETVARS RPTQ SAVESETQ SETN UNDONLSETQ XNLSETQ))
|
||||
(RPAQ? OPENFNS '(APPLY* SETQ AND OR COND SELECTQ PROG PROGN PROG1 ARG SETARG ERSETQ NLSETQ
|
||||
RESETFORM RESETLST RESETVARS RPTQ SAVESETQ SETN UNDONLSETQ XNLSETQ))
|
||||
|
||||
(RPAQQ \BLIPNAMES (*TAIL* *FORM* *FN* *ARGVALS*))
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
@@ -1433,7 +1436,7 @@ with the terms of said license.
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
|
||||
(RPAQQ RAIDCOMS
|
||||
(RPAQQ RAIDCOMS
|
||||
((MACROS PSTKFLD PRINTSTKFIELDS PSTK PRINTVA)
|
||||
(ADDVARS (RDCOMS (FNS RAIDCOMMAND RAIDSHOWFRAME RAIDSTACKCMD RAIDROOTFRAME PRINTADDRS PRINTVA
|
||||
READVA READOCT READATOM SHOWSTACKBLOCKS SHOWSTACKBLOCK1 PRINCOPY
|
||||
@@ -1445,29 +1448,30 @@ with the terms of said license.
|
||||
NOSUCHATOM))))
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
[PUTPROPS PSTKFLD MACRO ((FLD STR TEST FMT STR2)
|
||||
(PROG ((FLD (fetch (FX FLD) of FRAME)))
|
||||
(DECLARE (LOCALVARS FLD))
|
||||
(COND
|
||||
(TEST (PRIN1 'STR)
|
||||
(SELECTQ (CONSTANT (NTHCHAR 'STR -1))
|
||||
(= (printout NIL %, FLD STR2))
|
||||
NIL)
|
||||
T]
|
||||
(PUTPROPS PSTKFLD MACRO [(FLD STR TEST FMT STR2)
|
||||
(PROG ((FLD (fetch (FX FLD) of FRAME)))
|
||||
(DECLARE (LOCALVARS FLD))
|
||||
(COND
|
||||
(TEST (PRIN1 'STR)
|
||||
(SELECTQ (CONSTANT (NTHCHAR 'STR -1))
|
||||
(= (printout NIL %, FLD STR2))
|
||||
NIL)
|
||||
T])
|
||||
|
||||
[PUTPROPS PRINTSTKFIELDS MACRO (FIELDS (CONS 'PROGN (MAPCAR FIELDS (FUNCTION (LAMBDA (X)
|
||||
(CONS 'PSTKFLD X]
|
||||
(PUTPROPS PRINTSTKFIELDS MACRO [FIELDS (CONS 'PROGN (MAPCAR FIELDS (FUNCTION (LAMBDA (X)
|
||||
(CONS
|
||||
'PSTKFLD X])
|
||||
|
||||
(PUTPROPS PSTK MACRO ((N . FIELDS)
|
||||
(\PRINTSTK (IPLUS FRAME N))
|
||||
(PRINTSTKFIELDS . FIELDS)
|
||||
(TERPRI)))
|
||||
(PUTPROPS PSTK MACRO ((N . FIELDS)
|
||||
(\PRINTSTK (IPLUS FRAME N))
|
||||
(PRINTSTKFIELDS . FIELDS)
|
||||
(TERPRI)))
|
||||
|
||||
[PUTPROPS PRINTVA MACRO (LAMBDA (X)
|
||||
(printout NIL "{" (HILOC X)
|
||||
","
|
||||
(LOLOC X)
|
||||
"}"]
|
||||
(PUTPROPS PRINTVA MACRO [LAMBDA (X)
|
||||
(printout NIL "{" (HILOC X)
|
||||
","
|
||||
(LOLOC X)
|
||||
"}"])
|
||||
)
|
||||
|
||||
(ADDTOVAR RDCOMS (FNS RAIDCOMMAND RAIDSHOWFRAME RAIDSTACKCMD RAIDROOTFRAME PRINTADDRS PRINTVA
|
||||
@@ -1628,29 +1632,29 @@ with the terms of said license.
|
||||
(* ; "Translation machinery for new LAMBDA words")
|
||||
|
||||
|
||||
(PUTPROPS LAMBDATRANFNS VARTYPE ALIST)
|
||||
(PUTPROPS LAMBDATRANFNS VARTYPE ALIST)
|
||||
|
||||
(ADDTOVAR LAMBDATRANFNS )
|
||||
(DECLARE%: DONTCOPY
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
[PUTPROPS \CCODENARGS MACRO ((FNH)
|
||||
([LAMBDA (N)
|
||||
(COND
|
||||
((ILESSP N 0)
|
||||
1)
|
||||
(T N]
|
||||
(fetch (FNHEADER NA) of FNH]
|
||||
(PUTPROPS \CCODENARGS MACRO ((FNH)
|
||||
([LAMBDA (N)
|
||||
(COND
|
||||
((ILESSP N 0)
|
||||
1)
|
||||
(T N]
|
||||
(fetch (FNHEADER NA) of FNH))))
|
||||
|
||||
[PUTPROPS \CCODEFNTYP MACRO ((FNH)
|
||||
(SELECTQ (\CCODEARGTYPE FNH)
|
||||
(0 'CEXPR)
|
||||
(1 'CFEXPR)
|
||||
(2 'CEXPR*)
|
||||
'CFEXPR*]
|
||||
(PUTPROPS \CCODEFNTYP MACRO ((FNH)
|
||||
(SELECTQ (\CCODEARGTYPE FNH)
|
||||
(0 'CEXPR)
|
||||
(1 'CFEXPR)
|
||||
(2 'CEXPR*)
|
||||
'CFEXPR*)))
|
||||
|
||||
(PUTPROPS \CCODEARGTYPE MACRO ((FNH)
|
||||
(fetch (FNHEADER ARGTYPE) of FNH)))
|
||||
(PUTPROPS \CCODEARGTYPE MACRO ((FNH)
|
||||
(fetch (FNHEADER ARGTYPE) of FNH)))
|
||||
)
|
||||
)
|
||||
|
||||
@@ -1714,9 +1718,8 @@ with the terms of said license.
|
||||
)
|
||||
|
||||
|
||||
(ADDTOVAR CONSTANTFOLDFNS
|
||||
PLUS IPLUS TIMES ITIMES DIFFERENCE IDIFFERENCE QUOTIENT IQUOTIENT IMIN IMAX IABS LLSH LRSH
|
||||
LOGOR LOGXOR LOGAND OR AND)
|
||||
(ADDTOVAR CONSTANTFOLDFNS PLUS IPLUS TIMES ITIMES DIFFERENCE IDIFFERENCE QUOTIENT IQUOTIENT IMIN
|
||||
IMAX IABS LLSH LRSH LOGOR LOGXOR LOGAND OR AND)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS COMPVARMACROHASH CONSTANTFOLDFNS)
|
||||
@@ -1743,33 +1746,119 @@ with the terms of said license.
|
||||
|
||||
(ADDTOVAR LAMA APPLY* \INTERPRETER)
|
||||
)
|
||||
(PRETTYCOMPRINT LLINTERPCOMS)
|
||||
|
||||
(RPAQQ LLINTERPCOMS
|
||||
[(COMS (* ; "Compilation pre-requisites")
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
|
||||
LLBASIC LLSTK LLCODE LLPARAMS ACODE)))
|
||||
[E (* ;
|
||||
"Don't fontify these common functions")
|
||||
(SETQ FNSLST
|
||||
(LDIFFERENCE FNSLST
|
||||
'(EVALV PROG SET SETQ RETURN GO QUOTE AND OR PROGN COND PROG1 FUNCTION EVAL
|
||||
APPLY]
|
||||
(COMS (* ;
|
||||
"For calling interpreted functions")
|
||||
(FNS \INTERPRETER \INTERPRETER1 \SETUP-COMPILED-CLOSURE-CALL \STKNAME))
|
||||
(COMS (* ; "EVCALL ufn.")
|
||||
(FNS \ENVCALL.UFN \SETUP-ENVIRONMENT-CALL))
|
||||
(COMS (* ; "recursive interpreter")
|
||||
(FNS EVAL \EVAL \EVALFORM \EVALFORMASLAMBDA \EVALOTHER APPLY APPLY* \CHECKAPPLY*
|
||||
\CKAPPLYARGS DEFEVAL)
|
||||
(DECLARE%: DONTCOPY (MACROS .APPLY.))
|
||||
(COMS (* ; "Free variable manipulation")
|
||||
(FNS EVALV \EVALV1 \EVALVAR BOUNDP SET \SETVAR SETQ \STKSCAN \SETFVARSLOT))
|
||||
(COMS (* ; "PROG and friends")
|
||||
(FNS PROG \PROG0 \EVPROG1 RETURN GO EVALA \EVALA ERRORSET
|
||||
SI::ERRORSET-PRINT-FUNCTION))
|
||||
(COMS (* ;
|
||||
"LET and friends -- need these in the init")
|
||||
(FNS LET LET* \LET0 \LET*))
|
||||
(FNS QUOTE AND OR PROGN COND \EVPROGN PROG1)
|
||||
(COMS (VARS (\DEFEVALFNS NIL)
|
||||
(\EVALHOOK))
|
||||
(SPECVARS *EVALHOOK*)
|
||||
(ADDVARS (LAMBDASPLST LAMBDA NLAMBDA CL:LAMBDA OPENLAMBDA))
|
||||
(GLOBALVARS \DEFEVALFNS \EVALHOOK LAMBDASPLST CLISPARRAY)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (VARS (CLISPARRAY))
|
||||
(P (MOVD? 'SETQ 'SETN NIL T)))
|
||||
(GLOBALVARS CLISPARRAY))
|
||||
[COMS (* ;
|
||||
"Evaluating in different stack environment")
|
||||
(FNS ENVEVAL ENVAPPLY FUNCTION \FUNCT1 \MAKEFUNARGFRAME STKEVAL STKAPPLY RETEVAL
|
||||
RETAPPLY)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (* ;
|
||||
"For bootstrapping, IL:FUNCTION is as good as CL:FUNCTION")
|
||||
(P (MOVD? 'FUNCTION 'CL:FUNCTION NIL T]
|
||||
(COMS (* ; "Blip and other stack funniness")
|
||||
(FNS BLIPVAL SETBLIPVAL BLIPSCAN)
|
||||
(FNS \REALFRAMEP)
|
||||
[INITVARS (OPENFNS '(APPLY* SETQ AND OR COND SELECTQ PROG PROGN PROG1 ARG SETARG
|
||||
ERSETQ NLSETQ RESETFORM RESETLST RESETVARS RPTQ
|
||||
SAVESETQ SETN UNDONLSETQ XNLSETQ]
|
||||
(VARS \BLIPNAMES)
|
||||
(GLOBALVARS BRKINFOLST)
|
||||
(GLOBALVARS \BLIPNAMES OPENFNS)))
|
||||
(COMS (FNS RAIDCOMMAND RAIDSHOWFRAME RAIDSTACKCMD RAIDROOTFRAME PRINTADDRS PRINTVA READVA
|
||||
READATOM READOCT SHOWSTACKBLOCKS SHOWSTACKBLOCK1 PRINCOPY NOSUCHATOM)
|
||||
(FNS BACKTRACE \BACKTRACE \SCANFORNTENTRY \PRINTSTK \PRINTFRAME \PRINTBF)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (COMS * RAIDCOMS)))
|
||||
(COMS (FNS CCODEP EXPRP SUBRP FNTYP ARGTYPE NARGS ARGLIST \CCODEARGLIST \CCODEIVARSCAN)
|
||||
(COMS (* ;
|
||||
"Translation machinery for new LAMBDA words")
|
||||
(PROP VARTYPE LAMBDATRANFNS)
|
||||
(ALISTS (LAMBDATRANFNS)))
|
||||
(DECLARE%: DONTCOPY (MACROS \CCODENARGS \CCODEFNTYP \CCODEARGTYPE)))
|
||||
(COMS (* ; "CONSTANTS mechanism")
|
||||
(FNS CONSTANTS CONSTANTEXPRESSIONP)
|
||||
(INITVARS (COMPVARMACROHASH (HASHARRAY 100)))
|
||||
(* ; "We need this initialized for the INIT, so don't put it off. (It used to start out NIL and get set later)")
|
||||
(ADDVARS (CONSTANTFOLDFNS PLUS IPLUS TIMES ITIMES DIFFERENCE IDIFFERENCE QUOTIENT
|
||||
IQUOTIENT IMIN IMAX IABS LLSH LRSH LOGOR LOGXOR LOGAND OR AND))
|
||||
(GLOBALVARS COMPVARMACROHASH CONSTANTFOLDFNS))
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY DONTEVAL@LOAD (LOCALVARS . T))
|
||||
(SPECVARS *TAIL* *FN* *FORM* *ARGVAL*)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (ADDVARS (LAMS FAULTEVAL FAULTAPPLY)))
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
|
||||
(ADDVARS (NLAMA CONSTANTS PROG1 COND PROGN OR AND QUOTE LET* LET GO PROG SETQ)
|
||||
(NLAML FUNCTION RETURN)
|
||||
(LAMA BOUNDP APPLY* \INTERPRETER])
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
|
||||
|
||||
(ADDTOVAR NLAMA CONSTANTS PROG1 COND PROGN OR AND QUOTE LET* LET GO PROG SETQ)
|
||||
|
||||
(ADDTOVAR NLAML FUNCTION RETURN)
|
||||
|
||||
(ADDTOVAR LAMA BOUNDP APPLY* \INTERPRETER)
|
||||
)
|
||||
(PUTPROPS LLINTERP COPYRIGHT ("Venue & Xerox Corporation" T 1981 1982 1983 1984 1985 1986 1987 1988
|
||||
1990 1991 1992 1994 1995))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (6448 23709 (\INTERPRETER 6458 . 11054) (\INTERPRETER1 11056 . 17624) (
|
||||
\SETUP-COMPILED-CLOSURE-CALL 17626 . 22773) (\STKNAME 22775 . 23707)) (23738 29150 (\ENVCALL.UFN 23748
|
||||
. 23880) (\SETUP-ENVIRONMENT-CALL 23882 . 29148)) (29189 34066 (EVAL 29199 . 29299) (\EVAL 29301 .
|
||||
29511) (\EVALFORM 29513 . 30744) (\EVALFORMASLAMBDA 30746 . 30936) (\EVALOTHER 30938 . 31145) (APPLY
|
||||
31147 . 31254) (APPLY* 31256 . 32371) (\CHECKAPPLY* 32373 . 33478) (\CKAPPLYARGS 33480 . 33823) (
|
||||
DEFEVAL 33825 . 34064)) (35868 43313 (EVALV 35878 . 36087) (\EVALV1 36089 . 36244) (\EVALVAR 36246 .
|
||||
36609) (BOUNDP 36611 . 36827) (SET 36829 . 37195) (\SETVAR 37197 . 37567) (SETQ 37569 . 38241) (
|
||||
\STKSCAN 38243 . 41763) (\SETFVARSLOT 41765 . 43311)) (43347 56354 (PROG 43357 . 45873) (\PROG0 45875
|
||||
. 49505) (\EVPROG1 49507 . 49710) (RETURN 49712 . 50253) (GO 50255 . 51070) (EVALA 51072 . 53001) (
|
||||
\EVALA 53003 . 55596) (ERRORSET 55598 . 56203) (SI::ERRORSET-PRINT-FUNCTION 56205 . 56352)) (56413
|
||||
69065 (LET 56423 . 58566) (LET* 58568 . 60716) (\LET0 60718 . 64378) (\LET* 64380 . 69063)) (69066
|
||||
70642 (QUOTE 69076 . 69107) (AND 69109 . 69317) (OR 69319 . 69567) (PROGN 69569 . 69848) (COND 69850
|
||||
. 70184) (\EVPROGN 70186 . 70399) (PROG1 70401 . 70640)) (71130 78021 (ENVEVAL 71140 . 71390) (
|
||||
ENVAPPLY 71392 . 71649) (FUNCTION 71651 . 71881) (\FUNCT1 71883 . 74332) (\MAKEFUNARGFRAME 74334 .
|
||||
76531) (STKEVAL 76533 . 76681) (STKAPPLY 76683 . 76852) (RETEVAL 76854 . 77458) (RETAPPLY 77460 .
|
||||
78019)) (78142 85650 (BLIPVAL 78152 . 82053) (SETBLIPVAL 82055 . 84797) (BLIPSCAN 84799 . 85648)) (
|
||||
85651 86346 (\REALFRAMEP 85661 . 86344)) (86722 96117 (RAIDCOMMAND 86732 . 90338) (RAIDSHOWFRAME 90340
|
||||
. 90723) (RAIDSTACKCMD 90725 . 91906) (RAIDROOTFRAME 91908 . 92170) (PRINTADDRS 92172 . 92698) (
|
||||
PRINTVA 92700 . 92845) (READVA 92847 . 92925) (READATOM 92927 . 93509) (READOCT 93511 . 94142) (
|
||||
SHOWSTACKBLOCKS 94144 . 95390) (SHOWSTACKBLOCK1 95392 . 95543) (PRINCOPY 95545 . 95677) (NOSUCHATOM
|
||||
95679 . 96115)) (96118 104746 (BACKTRACE 96128 . 96485) (\BACKTRACE 96487 . 97593) (\SCANFORNTENTRY
|
||||
97595 . 99225) (\PRINTSTK 99227 . 99414) (\PRINTFRAME 99416 . 103399) (\PRINTBF 103401 . 104744)) (
|
||||
107255 116599 (CCODEP 107265 . 107540) (EXPRP 107542 . 107801) (SUBRP 107803 . 107858) (FNTYP 107860
|
||||
. 108620) (ARGTYPE 108622 . 109236) (NARGS 109238 . 109725) (ARGLIST 109727 . 110976) (\CCODEARGLIST
|
||||
110978 . 115374) (\CCODEIVARSCAN 115376 . 116597)) (117516 119747 (CONSTANTS 117526 . 117817) (
|
||||
CONSTANTEXPRESSIONP 117819 . 119745)))))
|
||||
(FILEMAP (NIL (6396 23657 (\INTERPRETER 6406 . 11002) (\INTERPRETER1 11004 . 17572) (
|
||||
\SETUP-COMPILED-CLOSURE-CALL 17574 . 22721) (\STKNAME 22723 . 23655)) (23686 29098 (\ENVCALL.UFN 23696
|
||||
. 23828) (\SETUP-ENVIRONMENT-CALL 23830 . 29096)) (29137 34014 (EVAL 29147 . 29247) (\EVAL 29249 .
|
||||
29459) (\EVALFORM 29461 . 30692) (\EVALFORMASLAMBDA 30694 . 30884) (\EVALOTHER 30886 . 31093) (APPLY
|
||||
31095 . 31202) (APPLY* 31204 . 32319) (\CHECKAPPLY* 32321 . 33426) (\CKAPPLYARGS 33428 . 33771) (
|
||||
DEFEVAL 33773 . 34012)) (36106 43695 (EVALV 36116 . 36325) (\EVALV1 36327 . 36482) (\EVALVAR 36484 .
|
||||
36847) (BOUNDP 36849 . 37065) (SET 37067 . 37433) (\SETVAR 37435 . 37805) (SETQ 37807 . 38479) (
|
||||
\STKSCAN 38481 . 42145) (\SETFVARSLOT 42147 . 43693)) (43729 56736 (PROG 43739 . 46255) (\PROG0 46257
|
||||
. 49887) (\EVPROG1 49889 . 50092) (RETURN 50094 . 50635) (GO 50637 . 51452) (EVALA 51454 . 53383) (
|
||||
\EVALA 53385 . 55978) (ERRORSET 55980 . 56585) (SI::ERRORSET-PRINT-FUNCTION 56587 . 56734)) (56795
|
||||
69447 (LET 56805 . 58948) (LET* 58950 . 61098) (\LET0 61100 . 64760) (\LET* 64762 . 69445)) (69448
|
||||
71024 (QUOTE 69458 . 69489) (AND 69491 . 69699) (OR 69701 . 69949) (PROGN 69951 . 70230) (COND 70232
|
||||
. 70566) (\EVPROGN 70568 . 70781) (PROG1 70783 . 71022)) (71512 78403 (ENVEVAL 71522 . 71772) (
|
||||
ENVAPPLY 71774 . 72031) (FUNCTION 72033 . 72263) (\FUNCT1 72265 . 74714) (\MAKEFUNARGFRAME 74716 .
|
||||
76913) (STKEVAL 76915 . 77063) (STKAPPLY 77065 . 77234) (RETEVAL 77236 . 77840) (RETAPPLY 77842 .
|
||||
78401)) (78524 86032 (BLIPVAL 78534 . 82435) (SETBLIPVAL 82437 . 85179) (BLIPSCAN 85181 . 86030)) (
|
||||
86033 86728 (\REALFRAMEP 86043 . 86726)) (87109 96504 (RAIDCOMMAND 87119 . 90725) (RAIDSHOWFRAME 90727
|
||||
. 91110) (RAIDSTACKCMD 91112 . 92293) (RAIDROOTFRAME 92295 . 92557) (PRINTADDRS 92559 . 93085) (
|
||||
PRINTVA 93087 . 93232) (READVA 93234 . 93312) (READATOM 93314 . 93896) (READOCT 93898 . 94529) (
|
||||
SHOWSTACKBLOCKS 94531 . 95777) (SHOWSTACKBLOCK1 95779 . 95930) (PRINCOPY 95932 . 96064) (NOSUCHATOM
|
||||
96066 . 96502)) (96505 105133 (BACKTRACE 96515 . 96872) (\BACKTRACE 96874 . 97980) (\SCANFORNTENTRY
|
||||
97982 . 99612) (\PRINTSTK 99614 . 99801) (\PRINTFRAME 99803 . 103786) (\PRINTBF 103788 . 105131)) (
|
||||
107892 117236 (CCODEP 107902 . 108177) (EXPRP 108179 . 108438) (SUBRP 108440 . 108495) (FNTYP 108497
|
||||
. 109257) (ARGTYPE 109259 . 109873) (NARGS 109875 . 110362) (ARGLIST 110364 . 111613) (\CCODEARGLIST
|
||||
111615 . 116011) (\CCODEIVARSCAN 116013 . 117234)) (118282 120513 (CONSTANTS 118292 . 118583) (
|
||||
CONSTANTEXPRESSIONP 118585 . 120511)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,13 +1,14 @@
|
||||
(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "LISP")
|
||||
(IL:FILECREATED "22-Sep-92 11:47:31" "{Pele:mv:envos}<LispCore>Sources>LLPACKAGE.;25" 82127
|
||||
(DEFINE-FILE-INFO PACKAGE "LISP" READTABLE "XCL" BASE 10)
|
||||
|
||||
IL:|changes| IL:|to:| (IL:FUNCTIONS IL:ADD-SYMBOL)
|
||||
(IL:FILECREATED "24-Oct-2021 10:20:31" IL:|{DSK}<home>larry>medley>sources>LLPACKAGE.;4| 82444
|
||||
|
||||
IL:|previous| IL:|date:| "20-May-91 13:07:32" "{Pele:mv:envos}<LispCore>Sources>LLPACKAGE.;24"
|
||||
IL:|changes| IL:|to:| (IL:FUNCTIONS IL:FIND-EXTERNAL-SYMBOL IL:FIND-SYMBOL*)
|
||||
|
||||
IL:|previous| IL:|date:| "22-Sep-92 11:47:31" IL:|{DSK}<home>larry>medley>sources>LLPACKAGE.;1|
|
||||
)
|
||||
|
||||
|
||||
; Copyright (c) 1986, 1987, 1990, 1991, 1992 by Venue & Xerox Corporation. All rights reserved.
|
||||
; Copyright (c) 1986-1987, 1990-1992 by Venue & Xerox Corporation.
|
||||
|
||||
(IL:PRETTYCOMPRINT IL:LLPACKAGECOMS)
|
||||
|
||||
@@ -524,9 +525,7 @@
|
||||
PACKAGE)))
|
||||
(IL:DEFINEQ
|
||||
|
||||
(xcl:defpackage
|
||||
(il:nlambda il:args (il:* il:\; "Edited 2-Dec-87 10:39 by raf") (il:setq il:args (xcl:remove-comments il:args)) (let ((package (find-package (car il:args)))) (cond ((packagep package) (il:* il:\; "If one already exists, test compatability of package definitions") (il:|for| il:option il:|in| (cdr il:args) il:|do| (let* ((il:key (cond ((keywordp il:option) il:option) ((il:listp il:option) (car il:option)) (t (il:error "Bad option for defpackage " il:option)))) (values (cond ((keywordp il:option) (list t)) ((il:listp il:option) (cdr il:option)) (t (il:error "Bad option for defpackage " il:option))))) (il:selectq il:key ((:internal-symbols :external-symbols) nil) (:external-only (if (not (%package-external-only package)) (il:error "Package NOT :external-only as asserted by defpackage: " package))) (:prefix-name (setf (%package-namesymbol package) (make-symbol (car values)))) (:use (use-package values package)) (:nicknames (il:enter-new-nicknames package values)) (:export (export (il:for il:symbol il:in values il:collect (il:if (il:litatom il:symbol) il:then il:symbol il:elseif (il:stringp il:symbol) il:then (intern il:symbol package) il:else (il:error "Bad object in :export option of defpackage " il:symbol))) package)) (:import (import values package)) ((:shadow :shadowing-import) (let ((il:symbols-to-shadow (il:mapconc values (il:function (il:lambda (symbol) (cond ((not (il:memb symbol (%package-shadowing-symbols package))) (list symbol)))))))) (il:selectq il:key (:shadow (shadow il:symbols-to-shadow package)) (:shadowing-import (shadowing-import il:symbols-to-shadow package)) nil))) (il:error "Bad keyword for defpackage " il:key))))) (t (il:* il:\; "Otherwise, make a new package to spec") (let ((il:post-make-forms nil)) (il:setq package (il:apply (quote make-package) (cons (car il:args) (il:|for| il:option il:|in| (cdr il:args) il:|join| (let ((il:key (cond ((keywordp il:option) il:option) ((il:listp il:option) (car il:option)) (t (il:error "Bad option for defpackage " il:option)))) (values (cond ((keywordp il:option) (list t)) ((il:listp il:option) (cdr il:option)) (t (il:error "Bad option for defpackage " il:option))))) (il:selectq il:key ((:use :nicknames) (list il:key (il:|if| (car values) il:|then| values il:|else| (il:* il:\; "Handles case where NIL is being used to explicitly say the package's :USE list is empty, since the default is to use LISP.") nil))) ((:prefix-name :internal-symbols :external-symbols :external-only) (list il:key (car values))) ((:shadow :export :import :shadowing-import) (il:setq il:post-make-forms (cons (cons il:key values) il:post-make-forms)) nil) (il:error "Bad keyword for defpackage " il:key))))))) (il:mapc il:post-make-forms (il:function (il:lambda (il:form) (il:selectq (car il:form) (:shadow (shadow (cdr il:form) package)) (:export (export (il:for il:symbol il:in (cdr il:form) il:collect (il:if (il:litatom il:symbol) il:then il:symbol il:elseif (il:stringp il:symbol) il:then (intern il:symbol package) il:else (il:error "Bad object in :export option of defpackage " il:symbol))) package)) (:import (import (cdr il:form) package)) (:shadowing-import (shadowing-import (cdr il:form) package)) (il:shouldnt "Bogus form on post-make-forms")))))))) (package-name package)))
|
||||
)
|
||||
(xcl:defpackage
|
||||
(il:nlambda il:args (il:* il:\; "Edited 2-Dec-87 10:39 by raf") (il:setq il:args (xcl:remove-comments il:args)) (let ((package (find-package (car il:args)))) (cond ((packagep package) (il:* il:\; "If one already exists, test compatability of package definitions") (il:|for| il:option il:|in| (cdr il:args) il:|do| (let* ((il:key (cond ((keywordp il:option) il:option) ((il:listp il:option) (car il:option)) (t (il:error "Bad option for defpackage " il:option)))) (values (cond ((keywordp il:option) (list t)) ((il:listp il:option) (cdr il:option)) (t (il:error "Bad option for defpackage " il:option))))) (il:selectq il:key ((:internal-symbols :external-symbols) nil) (:external-only (if (not (%package-external-only package)) (il:error "Package NOT :external-only as asserted by defpackage: " package))) (:prefix-name (setf (%package-namesymbol package) (make-symbol (car values)))) (:use (use-package values package)) (:nicknames (il:enter-new-nicknames package values)) (:export (export (il:for il:symbol il:in values il:collect (il:if (il:litatom il:symbol) il:then il:symbol il:elseif (il:stringp il:symbol) il:then (intern il:symbol package) il:else (il:error "Bad object in :export option of defpackage " il:symbol))) package)) (:import (import values package)) ((:shadow :shadowing-import) (let ((il:symbols-to-shadow (il:mapconc values (il:function (il:lambda (symbol) (cond ((not (il:memb symbol (%package-shadowing-symbols package))) (list symbol)))))))) (il:selectq il:key (:shadow (shadow il:symbols-to-shadow package)) (:shadowing-import (shadowing-import il:symbols-to-shadow package)) nil))) (il:error "Bad keyword for defpackage " il:key))))) (t (il:* il:\; "Otherwise, make a new package to spec") (let ((il:post-make-forms nil)) (il:setq package (il:apply (quote make-package) (cons (car il:args) (il:|for| il:option il:|in| (cdr il:args) il:|join| (let ((il:key (cond ((keywordp il:option) il:option) ((il:listp il:option) (car il:option)) (t (il:error "Bad option for defpackage " il:option)))) (values (cond ((keywordp il:option) (list t)) ((il:listp il:option) (cdr il:option)) (t (il:error "Bad option for defpackage " il:option))))) (il:selectq il:key ((:use :nicknames) (list il:key (il:|if| (car values) il:|then| values il:|else| (il:* il:\; "Handles case where NIL is being used to explicitly say the package's :USE list is empty, since the default is to use LISP.") nil))) ((:prefix-name :internal-symbols :external-symbols :external-only) (list il:key (car values))) ((:shadow :export :import :shadowing-import) (il:setq il:post-make-forms (cons (cons il:key values) il:post-make-forms)) nil) (il:error "Bad keyword for defpackage " il:key))))))) (il:mapc il:post-make-forms (il:function (il:lambda (il:form) (il:selectq (car il:form) (:shadow (shadow (cdr il:form) package)) (:export (export (il:for il:symbol il:in (cdr il:form) il:collect (il:if (il:litatom il:symbol) il:then il:symbol il:elseif (il:stringp il:symbol) il:then (intern il:symbol package) il:else (il:error "Bad object in :export option of defpackage " il:symbol))) package)) (:import (import (cdr il:form) package)) (:shadowing-import (shadowing-import (cdr il:form) package)) (il:shouldnt "Bogus form on post-make-forms")))))))) (package-name package)))
|
||||
)
|
||||
)
|
||||
@@ -1033,7 +1032,7 @@
|
||||
(T (IL:ADD-SYMBOL (%PACKAGE-INTERNAL-SYMBOLS PACKAGE)
|
||||
SYMBOL)))
|
||||
(VALUES SYMBOL NIL)))))
|
||||
"Check internal and external symbols, then scan down the list of hashtables for inherited symbols. When an inherited symbol is found pull that table to the beginning of the list."
|
||||
|
||||
(DEFUN IL:FIND-SYMBOL* (IL:BASE IL:OFFSET IL:LENGTH IL:FATP PACKAGE)
|
||||
(IL:* IL:\; "Check internal and external symbols, then scan down the list of hashtables for inherited symbols. When an inherited symbol is found pull that table to the beginning of the list.")
|
||||
|
||||
@@ -1042,10 +1041,11 @@
|
||||
(LET* ((IL:HASH (IL:SYMBOL-HASH IL:BASE IL:OFFSET IL:LENGTH IL:FATP))
|
||||
(IL:EHASH (IL:ENTRY-HASH IL:LENGTH IL:HASH))
|
||||
(IL:RESULT (IL:\\CREATECELL IL:\\FIXP))
|
||||
(IL:NEW-SYMBOL-CODE (PROGN (IL:SETQ IL:SYM ((IL:OPCODES IL:SUBRCALL 145 6)
|
||||
IL:BASE IL:OFFSET IL:LENGTH IL:FATP
|
||||
(%PACKAGE-INTERNAL-SYMBOLS PACKAGE)
|
||||
IL:RESULT))
|
||||
IL:SYM IL:WHERE (IL:DONE))
|
||||
(UNLESS (%PACKAGE-EXTERNAL-ONLY PACKAGE)
|
||||
(IL:NEW-SYMBOL-CODE (PROGN (IL:SETQ IL:SYM (IL:SUBRCALL IL:WITH-SYMBOL IL:BASE IL:OFFSET
|
||||
IL:LENGTH IL:FATP (
|
||||
%PACKAGE-INTERNAL-SYMBOLS
|
||||
PACKAGE)
|
||||
IL:RESULT))
|
||||
(COND
|
||||
@@ -1061,10 +1061,11 @@
|
||||
"Was (cl:return-from find-symbol* (cl:values cl:symbol :internal))")
|
||||
|
||||
(IL:SETQ IL:WHERE :INTERNAL)
|
||||
(IL:NEW-SYMBOL-CODE (PROGN (IL:SETQ IL:SYM ((IL:OPCODES IL:SUBRCALL 145 6)
|
||||
IL:BASE IL:OFFSET IL:LENGTH IL:FATP
|
||||
(%PACKAGE-EXTERNAL-SYMBOLS PACKAGE)
|
||||
IL:RESULT))
|
||||
(IL:SETQ IL:DONE T)))))
|
||||
(UNLESS IL:DONE
|
||||
(IL:NEW-SYMBOL-CODE (PROGN (IL:SETQ IL:SYM (IL:SUBRCALL IL:WITH-SYMBOL IL:BASE IL:OFFSET
|
||||
IL:LENGTH IL:FATP (
|
||||
%PACKAGE-EXTERNAL-SYMBOLS
|
||||
PACKAGE)
|
||||
IL:RESULT))
|
||||
(COND
|
||||
@@ -1087,10 +1088,10 @@
|
||||
(DO ((IL:PREV IL:HEAD IL:TABLE)
|
||||
(IL:TABLE (CDR IL:HEAD)
|
||||
(CDR IL:TABLE)))
|
||||
(IL:NEW-SYMBOL-CODE (PROGN (IL:SETQ IL:SYM ((IL:OPCODES IL:SUBRCALL 145 6)
|
||||
IL:BASE IL:OFFSET IL:LENGTH IL:FATP
|
||||
(CAR IL:TABLE)
|
||||
IL:RESULT))
|
||||
((OR IL:DONE (NULL IL:TABLE))
|
||||
(VALUES NIL NIL))
|
||||
(IL:NEW-SYMBOL-CODE (PROGN (IL:SETQ IL:SYM (IL:SUBRCALL IL:WITH-SYMBOL IL:BASE
|
||||
IL:OFFSET IL:LENGTH IL:FATP
|
||||
(CAR IL:TABLE)
|
||||
IL:RESULT))
|
||||
(COND
|
||||
@@ -1518,11 +1519,11 @@
|
||||
(IL:FATP (IL:|ffetch| (IL:STRINGP IL:FATSTRINGP) IL:|of| STRING))
|
||||
(IL:HASH (IL:SYMBOL-HASH IL:BASE IL:OFFSET IL:LENGTH IL:FATP))
|
||||
(IL:EHASH (IL:ENTRY-HASH IL:LENGTH IL:HASH))
|
||||
(IL:NEW-SYMBOL-CODE (PROGN (IL:SETQ IL:SYM ((IL:OPCODES IL:SUBRCALL 145 6)
|
||||
IL:BASE IL:OFFSET IL:LENGTH IL:FATP (
|
||||
(IL:RESULT (IL:\\CREATECELL IL:\\FIXP))
|
||||
IL:SYM)
|
||||
(IL:NEW-SYMBOL-CODE (PROGN (IL:SETQ IL:SYM (IL:SUBRCALL IL:WITH-SYMBOL IL:BASE IL:OFFSET
|
||||
PACKAGE)
|
||||
IL:RESULT))
|
||||
IL:LENGTH IL:FATP (
|
||||
%PACKAGE-EXTERNAL-SYMBOLS
|
||||
PACKAGE)
|
||||
IL:RESULT))
|
||||
(VALUES IL:SYM (NOT (IL:IEQP IL:RESULT -1))))
|
||||
@@ -1563,5 +1564,30 @@
|
||||
|
||||
(IL:ADDTOVAR IL:LAMA )
|
||||
)
|
||||
(IL:FILEMAP (NIL (25052 28345 (XCL:DEFPACKAGE 25065 . 28343)))))
|
||||
(IL:PUTPROPS IL:LLPACKAGE IL:COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1990 1991 1992))
|
||||
(IL:DECLARE\: IL:DONTCOPY
|
||||
(IL:FILEMAP (NIL (9779 10219 (IL:\\UPCASEBASE 9779 . 10219)) (10221 11342 (IL:APROPOS-SEARCH 10221 .
|
||||
11342)) (12882 12964 (PACKAGE-NAME 12882 . 12964)) (12966 13058 (PACKAGE-NICKNAMES 12966 . 13058)) (
|
||||
13060 13168 (PACKAGE-SHADOWING-SYMBOLS 13060 . 13168)) (13170 13260 (PACKAGE-USE-LIST 13170 . 13260))
|
||||
(13262 13360 (PACKAGE-USED-BY-LIST 13262 . 13360)) (13362 14517 (IL:MAKE-PACKAGE-HASHTABLE 13362 .
|
||||
14517)) (14519 14681 (PRINT-PACKAGE 14519 . 14681)) (14683 15074 (PRINT-PACKAGE-HASHTABLE 14683 .
|
||||
15074)) (16142 16923 (MAKE-SYMBOL 16142 . 16923)) (18034 18444 (IL:\\PKG-FIND-FREE-PACKAGE-INDEX 18034
|
||||
. 18444)) (18501 18647 (IL:SETF-SYMBOL-PACKAGE 18501 . 18647)) (18649 18741 (SYMBOL-PACKAGE 18649 .
|
||||
18741)) (21512 21684 (IL:INTERNAL-SYMBOL-COUNT 21512 . 21684)) (21686 21804 (IL:EXTERNAL-SYMBOL-COUNT
|
||||
21686 . 21804)) (21806 22962 (IL:ENTER-NEW-NICKNAMES 21806 . 22962)) (22964 23390 (
|
||||
IL:MAKE-PRIME-HASHTABLE-SIZE 22964 . 23390)) (23392 25061 (MAKE-PACKAGE 23392 . 25061)) (25062 28355 (
|
||||
XCL:DEFPACKAGE 25075 . 28353)) (28404 28626 (FIND-PACKAGE 28404 . 28626)) (28628 31966 (USE-PACKAGE
|
||||
28628 . 31966)) (31968 32448 (IN-PACKAGE 31968 . 32448)) (32450 32724 (XCL:PKG-GOTO 32450 . 32724)) (
|
||||
32726 33826 (RENAME-PACKAGE 32726 . 33826)) (33828 35279 (XCL:DELETE-PACKAGE 33828 . 35279)) (35281
|
||||
38227 (EXPORT 35281 . 38227)) (38229 39472 (UNEXPORT 38229 . 39472)) (39474 41118 (IMPORT 39474 .
|
||||
41118)) (41120 42398 (SHADOWING-IMPORT 41120 . 42398)) (42400 43454 (SHADOW 42400 . 43454)) (43456
|
||||
44111 (UNUSE-PACKAGE 43456 . 44111)) (44175 44481 (LIST-ALL-PACKAGES 44175 . 44481)) (44538 48313 (
|
||||
IL:ADD-SYMBOL 44538 . 48313)) (52637 53940 (IL:INTERN* 52637 . 53940)) (53942 59790 (IL:FIND-SYMBOL*
|
||||
53942 . 59790)) (59792 61243 (INTERN 59792 . 61243)) (61245 61823 (FIND-SYMBOL 61245 . 61823)) (61881
|
||||
62781 (IL:NUKE-SYMBOL 61881 . 62781)) (62783 64903 (UNINTERN 62783 . 64903)) (64905 66048 (
|
||||
IL:MOBY-UNINTERN 64905 . 66048)) (66107 66179 (IL:\\INDEXATOMPNAME 66107 . 66179)) (66291 66438 (
|
||||
IL:MAKE-DO-SYMBOLS-VARS 66291 . 66438)) (66440 67895 (IL:MAKE-DO-SYMBOLS-CODE 66440 . 67895)) (75495
|
||||
76020 (FIND-ALL-SYMBOLS 75495 . 76020)) (76022 76301 (IL:BRIEFLY-DESCRIBE-SYMBOL 76022 . 76301)) (
|
||||
76303 77817 (APROPOS 76303 . 77817)) (77819 79476 (APROPOS-LIST 77819 . 79476)) (79580 81153 (
|
||||
IL:FIND-EXTERNAL-SYMBOL 79580 . 81153)) (81155 81675 (IL:FIND-EXACT-SYMBOL 81155 . 81675)) (81677
|
||||
81757 (IL:PACKAGE-NAME-AS-SYMBOL 81677 . 81757)) (81759 81908 (IL:\\FIND.PACKAGE.INTERNAL 81759 .
|
||||
|
||||
Binary file not shown.
@@ -1,28 +1,31 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
|
||||
(FILECREATED "25-Feb-94 16:50:33" |{DSK}<users>nilsson>mnw>MAIKOBITBLT.;1| 8778
|
||||
|
||||
|changes| |to:| (VARS MAIKOBITBLTCOMS)
|
||||
(FILECREATED "26-Oct-2021 10:52:24" |{DSK}<home>larry>medley>sources>MAIKOBITBLT.;2| 9691
|
||||
|
||||
|previous| |date:| "14-Jun-90 16:57:27" |{DSK}<king>export>lispcore>sources>MAIKOBITBLT.;1|)
|
||||
|changes| |to:| (FNS \\MAIKO.BITBLTSUB \\MAIKO.BLTCHAR \\MAIKO.PUNTBLTCHAR
|
||||
\\MAIKO.BITBLT.BITMAP \\MAIKO.BLTSHADE.BITMAP)
|
||||
|
||||
|previous| |date:| "24-Oct-2021 10:31:31" |{DSK}<home>larry>medley>sources>MAIKOBITBLT.;1|)
|
||||
|
||||
|
||||
; Copyright (c) 1988, 1989, 1990, 1994 by Venue & Xerox Corporation. All rights reserved.
|
||||
; Copyright (c) 1988-1990, 1994 by Venue & Xerox Corporation.
|
||||
|
||||
(PRETTYCOMPRINT MAIKOBITBLTCOMS)
|
||||
|
||||
(RPAQQ MAIKOBITBLTCOMS (
|
||||
(* |;;| "this file has some optimizations for BITBLT on MAIKO; while PILOTBITBLT opcode still works, these functions directly implement some higher level operations")
|
||||
(RPAQQ MAIKOBITBLTCOMS
|
||||
(
|
||||
(* |;;| "this file has some optimizations for BITBLT on MAIKO; while PILOTBITBLT opcode still works, these functions directly implement some higher level operations")
|
||||
|
||||
(FNS \\MAIKO.BITBLTSUB \\MAIKO.BLTCHAR \\MAIKO.PUNTBLTCHAR
|
||||
\\MAIKO.BITBLT.BITMAP \\MAIKO.BLTSHADE.BITMAP)
|
||||
|
||||
(* |;;| "Save the old \\BITBLT.BITMAP, because it handles the OPERATION - MERGE case, where the C code doesn't.")
|
||||
(FNS \\MAIKO.BITBLTSUB \\MAIKO.BLTCHAR \\MAIKO.PUNTBLTCHAR \\MAIKO.BITBLT.BITMAP
|
||||
\\MAIKO.BLTSHADE.BITMAP)
|
||||
|
||||
(* |;;| "Save the old \\BITBLT.BITMAP, because it handles the OPERATION - MERGE case, where the C code doesn't.")
|
||||
|
||||
(P (MOVD '\\BITBLT.BITMAP '\\MAIKO.OLDBITBLT.BITMAP))
|
||||
(ADDVARS (\\MAIKO.MOVDS (\\MAIKO.BLTCHAR \\MEDW.BLTCHAR)
|
||||
(\\MAIKO.BITBLTSUB \\BITBLTSUB)
|
||||
(\\MAIKO.BITBLT.BITMAP \\BITBLT.BITMAP)
|
||||
(\\MAIKO.BLTSHADE.BITMAP \\BLTSHADE.BITMAP)))))
|
||||
(P (MOVD '\\BITBLT.BITMAP '\\MAIKO.OLDBITBLT.BITMAP))
|
||||
(ADDVARS (\\MAIKO.MOVDS (\\MAIKO.BLTCHAR \\MEDW.BLTCHAR)
|
||||
(\\MAIKO.BITBLTSUB \\BITBLTSUB)
|
||||
(\\MAIKO.BITBLT.BITMAP \\BITBLT.BITMAP)
|
||||
(\\MAIKO.BLTSHADE.BITMAP \\BLTSHADE.BITMAP)))))
|
||||
|
||||
|
||||
|
||||
@@ -34,22 +37,28 @@
|
||||
|
||||
(\\MAIKO.BITBLTSUB
|
||||
(LAMBDA (PILOTBBT |SourceBitMap| SLX STY |DestinationBitMap| DLX DTY HEIGHT |SourceType|
|
||||
|Operation| |Texture| |WindowXOffset| |WindowYOffset|)
|
||||
|Operation| |Texture| |WindowXOffset| |WindowYOffset|)
|
||||
(* \;
|
||||
"Edited 26-Oct-2021 10:06 by larry")
|
||||
(* \; "Edited 29-Jun-88 16:24 by ")
|
||||
|
||||
(* |;;| "replaces \\BITBLTSUB on Maiko")
|
||||
|
||||
((OPCODES SUBRCALL 69 13)
|
||||
PILOTBBT |SourceBitMap| SLX STY |DestinationBitMap| DLX DTY HEIGHT |SourceType| |Operation|
|
||||
|Texture| |WindowXOffset| |WindowYOffset|)))
|
||||
(SUBRCALL BITBLTSUB PILOTBBT |SourceBitMap| SLX STY |DestinationBitMap| DLX DTY HEIGHT
|
||||
|SourceType| |Operation| |Texture| |WindowXOffset| |WindowYOffset|)))
|
||||
|
||||
(\\MAIKO.BLTCHAR
|
||||
(LAMBDA (CHARCODE DISPLAYSTREAM DISPLAYDATA)
|
||||
((OPCODES SUBRCALL 135 3)
|
||||
CHARCODE DISPLAYSTREAM DISPLAYDATA)))
|
||||
(LAMBDA (CHARCODE DISPLAYSTREAM DISPLAYDATA) (* \;
|
||||
"Edited 26-Oct-2021 10:22 by larry")
|
||||
(* \;
|
||||
"Edited 6-Jul-90 10:14 by matsuda")
|
||||
(SUBRCALL NEW-BLTCHAR CHARCODE DISPLAYSTREAM DISPLAYDATA)))
|
||||
|
||||
(\\MAIKO.PUNTBLTCHAR
|
||||
(LAMBDA (CHARCODE DISPLAYSTREAM DISPLAYDATA) (* \; "Edited 29-Jun-88 16:04 by ")
|
||||
(LAMBDA (CHARCODE DISPLAYSTREAM DISPLAYDATA) (* \;
|
||||
"Edited 26-Oct-2021 10:21 by larry")
|
||||
(* \;
|
||||
"Edited 1-Nov-89 15:26 by takeshi")
|
||||
|
||||
(* |;;| "puts a character on a display stream. This function will be called when \\maiko.bltchar failed. Punt from subr call")
|
||||
|
||||
@@ -63,7 +72,12 @@
|
||||
(\\CHANGECHARSET.DISPLAY DISPLAYDATA (\\CHARSET CHARCODE))))
|
||||
(COND
|
||||
((|ffetch| (\\DISPLAYDATA |DDSlowPrintingCase|) |of| DISPLAYDATA)
|
||||
(RETURN (\\SLOWBLTCHAR CHARCODE DISPLAYSTREAM))))
|
||||
(RETURN (COND
|
||||
((|type?| STREAM DISPLAYSTREAM)
|
||||
(\\SLOWBLTCHAR CHARCODE DISPLAYSTREAM))
|
||||
((|type?| WINDOW DISPLAYSTREAM)
|
||||
(\\SLOWBLTCHAR CHARCODE (FETCH DSP OF DISPLAYSTREAM)))
|
||||
(T (ERROR "Not Stream or Window" DISPLAYSTREAM))))))
|
||||
(SETQ CURX (|ffetch| (\\DISPLAYDATA DDXPOSITION) |of| DISPLAYDATA))
|
||||
(SETQ RIGHT (IPLUS CURX (\\DSPGETCHARIMAGEWIDTH CHAR8CODE DISPLAYDATA)))
|
||||
(COND
|
||||
@@ -107,14 +121,14 @@
|
||||
DISPLAYDATA)
|
||||
))
|
||||
0)))
|
||||
(.WHILE.TOP.DS. DISPLAYSTREAM ((OPCODES SUBRCALL 70 6)
|
||||
LOCAL1 DISPLAYDATA CHAR8CODE CURX LEFT RIGHT))
|
||||
(.WHILE.TOP.DS. DISPLAYSTREAM (SUBRCALL BLTCHAR LOCAL1 DISPLAYDATA CHAR8CODE
|
||||
CURX LEFT RIGHT))
|
||||
T))))))
|
||||
|
||||
(\\MAIKO.BITBLT.BITMAP
|
||||
(LAMBDA (SOURCEBITMAP SOURCELEFT SOURCEBOTTOM DESTBITMAP DESTINATIONLEFT DESTINATIONBOTTOM WIDTH
|
||||
HEIGHT SOURCETYPE OPERATION TEXTURE CLIPPINGREGION CLIPPEDSOURCELEFT
|
||||
CLIPPEDSOURCEBOTTOM) (* \; "Edited 14-Jun-90 16:47 by TS")
|
||||
CLIPPEDSOURCEBOTTOM) (* \; "Edited 14-Jun-90 16:47 by TS")
|
||||
|
||||
(* |;;| "SUN version of \\BITBLT.BITMAP. For all but the MERGE case, use C code. For the MERGE case, use the old code.")
|
||||
|
||||
@@ -132,7 +146,7 @@
|
||||
|
||||
(\\MAIKO.BLTSHADE.BITMAP
|
||||
(LAMBDA (TEXTURE DESTINATIONBITMAP DESTINATIONLEFT DESTINATIONBOTTOM WIDTH HEIGHT OPERATION
|
||||
CLIPPINGREGION) (* \; "Edited 14-Jun-90 16:49 by TS")
|
||||
CLIPPINGREGION) (* \; "Edited 14-Jun-90 16:49 by TS")
|
||||
(DECLARE (LOCALVARS . T))
|
||||
|
||||
(* |;;| "C function, bitshade_bitmap , has PUNT case \\PUNT.BLTSHADE.BITMAP(Takeshi)")
|
||||
@@ -156,7 +170,7 @@
|
||||
(\\MAIKO.BLTSHADE.BITMAP \\BLTSHADE.BITMAP))
|
||||
(PUTPROPS MAIKOBITBLT COPYRIGHT ("Venue & Xerox Corporation" 1988 1989 1990 1994))
|
||||
(DECLARE\: DONTCOPY
|
||||
(FILEMAP (NIL (1600 8233 (\\MAIKO.BITBLTSUB 1610 . 2130) (\\MAIKO.BLTCHAR 2132 . 2272) (
|
||||
\\MAIKO.PUNTBLTCHAR 2274 . 6375) (\\MAIKO.BITBLT.BITMAP 6377 . 7729) (\\MAIKO.BLTSHADE.BITMAP 7731 .
|
||||
8231)))))
|
||||
(FILEMAP (NIL (1500 9146 (\\MAIKO.BITBLTSUB 1510 . 2193) (\\MAIKO.BLTCHAR 2195 . 2623) (
|
||||
\\MAIKO.PUNTBLTCHAR 2625 . 7288) (\\MAIKO.BITBLT.BITMAP 7290 . 8642) (\\MAIKO.BLTSHADE.BITMAP 8644 .
|
||||
9144)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,13 +1,11 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
|
||||
(FILECREATED "25-Mar-2021 09:50:57" |{DSK}<home>larry>ilisp>medley>sources>MAIKOETHER.;2| 47411
|
||||
|
||||
|changes| |to:| (VARS MAIKOETHERCOMS \\EPT.3TO10)
|
||||
(FNS \\MAIKO.10MBSENDPACKET \\MAIKO.10MBWATCHER \\MAIKO.ETHERRESUME
|
||||
\\MAIKO.ETHERSUSPEND \\MAIKO.INPUT.INTERRUPT \\MAIKO.10MBSTARTDRIVER
|
||||
\\MAIKO.10MBTURNONETHER \\MAIKO.10MB.RESTART.ETHER \\MAIKO.CHECKSUM)
|
||||
(FILECREATED "25-Oct-2021 15:12:33" |{DSK}<home>larry>medley>sources>MAIKOETHER.;2| 28792
|
||||
|
||||
|previous| |date:| " 4-May-91 15:52:07" |{DSK}<home>larry>ilisp>medley>sources>MAIKOETHER.;1|
|
||||
)
|
||||
|changes| |to:| (FNS \\DISPLAYLINE)
|
||||
(VARS MAIKOETHERCOMS)
|
||||
|
||||
|previous| |date:| "25-Mar-2021 09:50:57" |{DSK}<home>larry>medley>sources>MAIKOETHER.;1|)
|
||||
|
||||
|
||||
; Copyright (c) 1988-1991, 2021 by Venue & Xerox Corporation.
|
||||
@@ -16,7 +14,7 @@
|
||||
|
||||
(RPAQQ MAIKOETHERCOMS
|
||||
((FNS \\10MB.RESTART.ETHER \\10MB.STARTDRIVER \\10MB.TURNOFFETHER \\10MB.TURNONETHER
|
||||
\\10MBSENDPACKET \\10MBWATCHER \\DISPLAYLINE \\MAIKO.10MBSENDPACKET \\MAIKO.10MBWATCHER
|
||||
\\10MBSENDPACKET \\10MBWATCHER \\MAIKO.10MBSENDPACKET \\MAIKO.10MBWATCHER
|
||||
\\MAIKO.ETHERRESUME \\MAIKO.ETHERSUSPEND \\MAIKO.INPUT.INTERRUPT \\NS.SETTIME
|
||||
\\PUP.SETTIME \\MAIKO.10MBSTARTDRIVER \\MAIKO.10MBTURNONETHER \\MAIKO.10MB.RESTART.ETHER
|
||||
\\MAIKO.CHECKSUM)
|
||||
@@ -183,256 +181,6 @@
|
||||
(SETQ CNTR 0)
|
||||
(GO LP))))
|
||||
|
||||
(\\DISPLAYLINE
|
||||
(LAMBDA (TEXTOBJ LINE WINDOW) (* \; "Edited 5-Apr-89 16:22 by snow")
|
||||
|
||||
(* |;;| "Display the line of text LINE in the edit window where it belongs.")
|
||||
|
||||
(* |;;| " This Function works on MIAKO")
|
||||
|
||||
(PROG ((CH 0)
|
||||
(CHLIST (|fetch| (THISLINE CHARS) |of| (|fetch| THISLINE |of| TEXTOBJ)))
|
||||
(WLIST (|fetch| (THISLINE WIDTHS) |of| (|ffetch| THISLINE |of| TEXTOBJ)))
|
||||
(LOOKS (|fetch| (THISLINE LOOKS) |of| (|ffetch| THISLINE |of| TEXTOBJ)))
|
||||
(WINDOWDS (WINDOWPROP (OR WINDOW (CAR (|fetch| (TEXTOBJ \\WINDOW) |of| TEXTOBJ)))
|
||||
'DSP))
|
||||
(TEXTLEN (|ffetch| (TEXTOBJ TEXTLEN) |of| TEXTOBJ))
|
||||
(THISLINE (|ffetch| (TEXTOBJ THISLINE) |of| TEXTOBJ))
|
||||
(TERMSA (|ffetch| (TEXTOBJ TXTTERMSA) |of| TEXTOBJ))
|
||||
(STREAM (|ffetch| (TEXTOBJ STREAMHINT) |of| TEXTOBJ))
|
||||
(OLDCACHE (|fetch| LCBITMAP |of| (|ffetch| (TEXTOBJ DISPLAYCACHE) |of|
|
||||
TEXTOBJ)))
|
||||
(DS (|ffetch| (TEXTOBJ DISPLAYCACHEDS) |of| TEXTOBJ))
|
||||
(HCPYDS (|ffetch| (TEXTOBJ DISPLAYHCPYDS) |of| TEXTOBJ))
|
||||
(HARDCOPYMODE (|fetch| (FMTSPEC FMTHARDCOPY) |of| (|fetch| (LINEDESCRIPTOR
|
||||
LFMTSPEC)
|
||||
|of| LINE)))
|
||||
LOOKSTARTX CACHE \\PCHARSLEFT \\PSTRING \\PFILE FONT OFONT OLOOKS XOFFSET CLIPLEFT
|
||||
CLIPRIGHT DISPLAYDATA DDPILOTBBT DDWIDTHCACHE DDOFFSETCACHE CURY LHEIGHT SCALE)
|
||||
(SETQ LHEIGHT (COND
|
||||
((|ffetch| (LINEDESCRIPTOR PREVLINE) |of| LINE)
|
||||
(* \;
|
||||
"So if theres a base-to-base measure, we clear everything right.")
|
||||
(IMAX (IDIFFERENCE (|fetch| YBOT |of| (|ffetch| (
|
||||
LINEDESCRIPTOR
|
||||
PREVLINE)
|
||||
|of| LINE))
|
||||
(|ffetch| (LINEDESCRIPTOR YBOT) |of| LINE))
|
||||
(|ffetch| (LINEDESCRIPTOR LHEIGHT) |of| LINE)))
|
||||
(T (|ffetch| (LINEDESCRIPTOR LHEIGHT) |of| LINE))))
|
||||
(COND
|
||||
(HARDCOPYMODE (* \;
|
||||
"This is a hardcopy-mode line. Scale things.")
|
||||
(* \; "(SETQ DS HCPYDS)")
|
||||
(SETQ SCALE (DSPSCALE NIL HCPYDS)))
|
||||
(T (SETQ SCALE 1)))
|
||||
(SETQ CACHE (\\TEDIT.LINECACHE (|ffetch| (TEXTOBJ DISPLAYCACHE) |of| TEXTOBJ)
|
||||
(COND
|
||||
(HARDCOPYMODE (FIXR (FQUOTIENT (|fetch| RIGHTMARGIN |of|
|
||||
LINE)
|
||||
SCALE)))
|
||||
(T (|fetch| RIGHTMARGIN |of| LINE)))
|
||||
LHEIGHT))
|
||||
(COND
|
||||
((NEQ CACHE OLDCACHE) (* \;
|
||||
"We changed the bitmaps because this line was bigger--update the displaystream, too")
|
||||
(DSPDESTINATION CACHE DS)
|
||||
(DSPCLIPPINGREGION (|create| REGION
|
||||
LEFT _ 0
|
||||
BOTTOM _ 0
|
||||
WIDTH _ (|fetch| BITMAPWIDTH |of| CACHE)
|
||||
HEIGHT _ (|ffetch| BITMAPHEIGHT |of| CACHE))
|
||||
DS)))
|
||||
(BITBLT NIL 0 0 CACHE 0 0 NIL NIL 'TEXTURE 'REPLACE WHITESHADE)
|
||||
(* \; "Clear the line cache")
|
||||
(COND
|
||||
(HARDCOPYMODE (* \;
|
||||
"This is a hardcopy-mode line. Scale things.")
|
||||
(* \; "(SETQ DS HCPYDS)")
|
||||
(SETQ SCALE (DSPSCALE NIL HCPYDS)))
|
||||
(T (SETQ SCALE 1)))
|
||||
(COND
|
||||
((AND (NOT (ZEROP (|fetch| CHAR1 |of| LINE)))
|
||||
(ILEQ (|ffetch| CHAR1 |of| LINE)
|
||||
TEXTLEN)
|
||||
(IGEQ (|ffetch| YBOT |of| LINE)
|
||||
(|ffetch| WBOTTOM |of| TEXTOBJ)))
|
||||
|
||||
(* |;;| "Only display the line of it contains text (CHAR1 > 0), appears before the end of the test, and is on-screen.")
|
||||
|
||||
(COND
|
||||
((NEQ (|fetch| DESC |of| THISLINE)
|
||||
LINE) (* \;
|
||||
"No image cache -- re-format and display")
|
||||
(\\FORMATLINE TEXTOBJ NIL (|ffetch| CHAR1 |of| LINE)
|
||||
LINE)))
|
||||
(MOVETO (|ffetch| LEFTMARGIN |of| LINE)
|
||||
(|ffetch| DESCENT |of| LINE)
|
||||
DS)
|
||||
(SETQ DISPLAYDATA (|fetch| IMAGEDATA |of| DS))
|
||||
(SETQ DDPILOTBBT (|ffetch| DDPILOTBBT |of| DISPLAYDATA))
|
||||
(SETQ XOFFSET (|ffetch| DDXOFFSET |of| DISPLAYDATA))
|
||||
|
||||
(* |;;| "The X position of the left edge of the window, since \\TEDIT.BLTCHAR works on the screen bitmap itself.")
|
||||
|
||||
(SETQ CLIPLEFT (|ffetch| |DDClippingLeft| |of| DISPLAYDATA))
|
||||
(* \;
|
||||
"The left and right edges of the clipping region for the text display window.")
|
||||
(SETQ CLIPRIGHT (|ffetch| |DDClippingRight| |of| DISPLAYDATA))
|
||||
(SETQ OFONT (DSPFONT (|fetch| CLFONT |of| (SETQ OLOOKS (\\EDITELT LOOKS 0)))
|
||||
DS)) (* \; "The starting font")
|
||||
(SETQ DDWIDTHCACHE (|ffetch| DDWIDTHSCACHE |of| DISPLAYDATA))
|
||||
(* \;
|
||||
"Cache the character-image widths")
|
||||
(SETQ DDOFFSETCACHE (|ffetch| DDOFFSETSCACHE |of| DISPLAYDATA))
|
||||
(* \;
|
||||
"And the offset-into-strike-bitmap array")
|
||||
(SETQ LOOKSTARTX (|ffetch| LEFTMARGIN |of| LINE))
|
||||
(* \;
|
||||
"Starting X position for the current-looks text.")
|
||||
(AND (|fetch| CLOFFSET |of| OLOOKS)
|
||||
(RELMOVETO 0 (FIXR (FTIMES SCALE (|ffetch| CLOFFSET |of| OLOOKS)))
|
||||
DS)) (* \;
|
||||
"Any sub- or superscripting at start of line")
|
||||
(|bind| (LOOKNO _ 1)
|
||||
DX
|
||||
(TX _ (IPLUS XOFFSET (|ffetch| LEFTMARGIN |of| LINE))) |for| I
|
||||
|from| 0 |to| (|fetch| LEN |of| THISLINE)
|
||||
|do|
|
||||
|
||||
(* |;;| "Display the line character by character")
|
||||
|
||||
(SETQ CH (\\EDITELT CHLIST I)) (* \;
|
||||
"Grab the character (or IMAGEOBJ) to display")
|
||||
(SETQ DX (\\WORDELT WLIST I)) (* \; "And its width")
|
||||
(SELECTC CH
|
||||
(|LMInvisibleRun| (* \;
|
||||
"An INVISIBLE run -- skip it, and skip over the char count")
|
||||
(|add| LOOKNO 1))
|
||||
(|LMLooksChange| (* \; "A LOOKS change")
|
||||
(|freplace| DDXPOSITION |of| DISPLAYDATA
|
||||
|with| (IDIFFERENCE TX XOFFSET))
|
||||
(* \;
|
||||
"Make the displaystream reflect our current X position")
|
||||
(TEDIT.MODIFYLOOKS LINE LOOKSTARTX DS OLOOKS (|ffetch| DESCENT
|
||||
|of| LINE))
|
||||
(* \;
|
||||
"Make any necessary changes to the preceding characters (underline, strike-out &c)")
|
||||
(DSPFONT (|fetch| CLFONT |of| (SETQ OLOOKS (\\EDITELT LOOKS
|
||||
LOOKNO)))
|
||||
DS) (* \; "Set the new font")
|
||||
(|add| LOOKNO 1) (* \;
|
||||
"Grab the next set of char looks")
|
||||
(AND (|ffetch| CLOFFSET |of| OLOOKS)
|
||||
(RELMOVETO 0 (|ffetch| CLOFFSET |of| OLOOKS)
|
||||
DS)) (* \; "Account for super/subscripting")
|
||||
(SETQ LOOKSTARTX (IDIFFERENCE TX XOFFSET))
|
||||
(* \;
|
||||
"Remember the starting Xpos for possible later underlining &c")
|
||||
)
|
||||
((CHARCODE (TAB \#^I)) (* \;
|
||||
"TAB: use the width from the cache to decide the right formatting.")
|
||||
(COND
|
||||
((OR (IEQP CH (CHARCODE \#^I))
|
||||
(|ffetch| CLLEADER |of| OLOOKS)
|
||||
(EQ (|ffetch| CLUSERINFO |of| OLOOKS)
|
||||
'DOTTEDLEADER))
|
||||
(LET* ((LEADERFONT (COND
|
||||
(HARDCOPYMODE (FONTCOPY (|ffetch|
|
||||
CLFONT
|
||||
|of| OLOOKS)
|
||||
'DEVICE HCPYDS))
|
||||
(T (|ffetch| CLFONT |of| OLOOKS))))
|
||||
(DOTWIDTH (CHARWIDTH (CHARCODE \.)
|
||||
LEADERFONT))
|
||||
(TTX (IPLUS TX DOTWIDTH (IDIFFERENCE DOTWIDTH
|
||||
(IREMAINDER TX DOTWIDTH))))
|
||||
)
|
||||
(|while| (ILEQ TTX (IPLUS TX DX))
|
||||
|do| (COND
|
||||
(HARDCOPYMODE
|
||||
(SUBRCALL TEDIT.BLTCHAR (CHARCODE \.)
|
||||
DS
|
||||
(FIXR (FQUOTIENT (IDIFFERENCE TTX
|
||||
DOTWIDTH)
|
||||
SCALE))
|
||||
DISPLAYDATA DDPILOTBBT CLIPRIGHT))
|
||||
((OR TERMSA HARDCOPYMODE)
|
||||
(* \;
|
||||
"Using special instrns from TERMSA")
|
||||
(\\DSPPRINTCHAR DS (CHARCODE \.)))
|
||||
(T (* \; "Native charcodes")
|
||||
(SUBRCALL TEDIT.BLTCHAR (CHARCODE \.)
|
||||
DS
|
||||
(IDIFFERENCE TTX DOTWIDTH)
|
||||
DISPLAYDATA DDPILOTBBT CLIPRIGHT))
|
||||
)
|
||||
(|add| TTX DOTWIDTH))))))
|
||||
(13 (* \; "It's a CR")
|
||||
NIL)
|
||||
(COND
|
||||
((SMALLP CH) (* \;
|
||||
"Normal character -- just display it.")
|
||||
(COND
|
||||
(HARDCOPYMODE (SUBRCALL TEDIT.BLTCHAR CH DS (FIXR (FQUOTIENT TX
|
||||
SCALE))
|
||||
DISPLAYDATA DDPILOTBBT CLIPRIGHT))
|
||||
((OR TERMSA HARDCOPYMODE) (* \;
|
||||
"Using special instrns from TERMSA")
|
||||
(\\DSPPRINTCHAR DS CH))
|
||||
(T (* \; "Native charcodes")
|
||||
(SUBRCALL TEDIT.BLTCHAR CH DS TX DISPLAYDATA DDPILOTBBT
|
||||
CLIPRIGHT))))
|
||||
(T (* \; "CH is an object.")
|
||||
(MOVETO (IDIFFERENCE (FIXR (FQUOTIENT TX SCALE))
|
||||
XOFFSET)
|
||||
(SETQ CURY (DSPYPOSITION NIL DS))
|
||||
DS) (* \;
|
||||
"Go to the base line, left edge of the image region.")
|
||||
(APPLY* (IMAGEOBJPROP CH 'DISPLAYFN)
|
||||
CH DS 'DISPLAY (|ffetch| STREAMHINT |of| TEXTOBJ))
|
||||
(* \;
|
||||
"Tell him to display himself here.")
|
||||
(DSPFONT (|ffetch| CLFONT |of| OLOOKS)
|
||||
DS)
|
||||
(MOVETO (IDIFFERENCE (FIXR (FQUOTIENT TX SCALE))
|
||||
XOFFSET)
|
||||
CURY DS) (* \;
|
||||
"Move to after the object's image")
|
||||
)))
|
||||
(|add| TX DX) (* \; "Update our X position")
|
||||
|finally| (|freplace| DDXPOSITION |of| DISPLAYDATA
|
||||
|with| (IDIFFERENCE (FIXR (FQUOTIENT TX SCALE))
|
||||
XOFFSET))
|
||||
(* \;
|
||||
"Make any necessary looks mods to the last run of characters")
|
||||
(TEDIT.MODIFYLOOKS LINE LOOKSTARTX DS OLOOKS (|ffetch| DESCENT
|
||||
|of| LINE)))))
|
||||
(BITBLT CACHE 0 0 WINDOWDS 0 (|ffetch| YBOT |of| LINE)
|
||||
(|ffetch| WRIGHT |of| TEXTOBJ)
|
||||
LHEIGHT
|
||||
'INPUT
|
||||
'REPLACE) (* \;
|
||||
"Paint the cached image on the screen (this lessens flicker during update)")
|
||||
(COND
|
||||
((|fetch| (FMTSPEC FMTREVISED) |of| (|ffetch| (LINEDESCRIPTOR LFMTSPEC)
|
||||
|of| LINE))
|
||||
(* \;
|
||||
"This paragraph has been revised, so mark it.")
|
||||
(\\TEDIT.MARK.REVISION TEXTOBJ (|ffetch| (LINEDESCRIPTOR LFMTSPEC) |of| LINE)
|
||||
WINDOWDS LINE)))
|
||||
(SELECTQ (|ffetch| LMARK |of| LINE)
|
||||
(GREY (* \;
|
||||
"This line has some property that isn't visible to the user. Tell him to be careful")
|
||||
(BITBLT NIL 0 0 WINDOWDS 0 (|ffetch| YBASE |of| LINE)
|
||||
6 6 'TEXTURE 'PAINT 42405))
|
||||
(SOLID (* \;
|
||||
"This line has some property that isn't visible to the user. Tell him to be careful")
|
||||
(BITBLT NIL 0 0 WINDOWDS 0 (|ffetch| YBASE |of| LINE)
|
||||
6 6 'TEXTURE 'PAINT BLACKSHADE))
|
||||
(BITBLT NIL 0 0 WINDOWDS 0 (|ffetch| YBASE |of| LINE)
|
||||
6 6 'TEXTURE 'REPLACE WHITESHADE)))))
|
||||
|
||||
(\\MAIKO.10MBSENDPACKET
|
||||
(LAMBDA (NDB PACKET) (* \; "Edited 31-Oct-89 14:10 by bvm")
|
||||
(PROG NIL
|
||||
@@ -781,13 +529,12 @@
|
||||
(RPAQQ \\MAIKO.IO-INTERRUPT-VECTOR NIL)
|
||||
(PUTPROPS MAIKOETHER COPYRIGHT ("Venue & Xerox Corporation" 1988 1989 1990 1991 2021))
|
||||
(DECLARE\: DONTCOPY
|
||||
(FILEMAP (NIL (2870 40835 (\\10MB.RESTART.ETHER 2880 . 3040) (\\10MB.STARTDRIVER 3042 . 4801) (
|
||||
\\10MB.TURNOFFETHER 4803 . 4963) (\\10MB.TURNONETHER 4965 . 7335) (\\10MBSENDPACKET 7337 . 9708) (
|
||||
\\10MBWATCHER 9710 . 11049) (\\DISPLAYLINE 11051 . 29389) (\\MAIKO.10MBSENDPACKET 29391 . 31769) (
|
||||
\\MAIKO.10MBWATCHER 31771 . 33116) (\\MAIKO.ETHERRESUME 33118 . 33277) (\\MAIKO.ETHERSUSPEND 33279 .
|
||||
33440) (\\MAIKO.INPUT.INTERRUPT 33442 . 35704) (\\NS.SETTIME 35706 . 35986) (\\PUP.SETTIME 35988 .
|
||||
36269) (\\MAIKO.10MBSTARTDRIVER 36271 . 37926) (\\MAIKO.10MBTURNONETHER 37928 . 40303) (
|
||||
\\MAIKO.10MB.RESTART.ETHER 40305 . 40658) (\\MAIKO.CHECKSUM 40660 . 40833)) (41890 44955 (
|
||||
\\MAIKO.ETHER-INTERRUPT 41900 . 44953)) (45077 46440 (\\MAIKO.CONSOLE-LOG-PRINT 45087 . 46438)) (46486
|
||||
47166 (\\MAIKO.IO-INTERRUPT 46496 . 47164)))))
|
||||
(FILEMAP (NIL (2591 22216 (\\10MB.RESTART.ETHER 2601 . 2761) (\\10MB.STARTDRIVER 2763 . 4522) (
|
||||
\\10MB.TURNOFFETHER 4524 . 4684) (\\10MB.TURNONETHER 4686 . 7056) (\\10MBSENDPACKET 7058 . 9429) (
|
||||
\\10MBWATCHER 9431 . 10770) (\\MAIKO.10MBSENDPACKET 10772 . 13150) (\\MAIKO.10MBWATCHER 13152 . 14497)
|
||||
(\\MAIKO.ETHERRESUME 14499 . 14658) (\\MAIKO.ETHERSUSPEND 14660 . 14821) (\\MAIKO.INPUT.INTERRUPT
|
||||
14823 . 17085) (\\NS.SETTIME 17087 . 17367) (\\PUP.SETTIME 17369 . 17650) (\\MAIKO.10MBSTARTDRIVER
|
||||
17652 . 19307) (\\MAIKO.10MBTURNONETHER 19309 . 21684) (\\MAIKO.10MB.RESTART.ETHER 21686 . 22039) (
|
||||
\\MAIKO.CHECKSUM 22041 . 22214)) (23271 26336 (\\MAIKO.ETHER-INTERRUPT 23281 . 26334)) (26458 27821 (
|
||||
\\MAIKO.CONSOLE-LOG-PRINT 26468 . 27819)) (27867 28547 (\\MAIKO.IO-INTERRUPT 27877 . 28545)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,9 +1,10 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED " 2-Mar-2021 23:12:27" {DSK}<home>larry>ilisp>medley>sources>MAIKOLOADUPFNS.;4 5921
|
||||
|
||||
changes to%: (VARS MAIKOLOADUPFNSCOMS)
|
||||
(FILECREATED "26-Oct-2021 09:55:14" {DSK}<home>larry>medley>sources>MAIKOLOADUPFNS.;2 5969
|
||||
|
||||
previous date%: "25-Feb-2021 15:43:43" {DSK}<home>larry>ilisp>save>MAIKOLOADUPFNS.;1)
|
||||
changes to%: (FNS \BITBLTSUB \BLTCHAR)
|
||||
|
||||
previous date%: " 2-Mar-2021 23:12:27" {DSK}<home>larry>medley>sources>MAIKOLOADUPFNS.;1)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -59,18 +60,16 @@ Copyright (c) 1989, 2018, 2021 by ENVOS Corporation.
|
||||
|
||||
(\BITBLTSUB
|
||||
[LAMBDA (PILOTBBT SourceBitMap SLX STY DestinationBitMap DLX DTY HEIGHT SourceType Operation
|
||||
Texture WindowXOffset WindowYOffset) (* ; "Edited 29-Jun-88 16:24 by ")
|
||||
Texture WindowXOffset WindowYOffset) (* ; "Edited 26-Oct-2021 09:53 by larry")
|
||||
|
||||
(* ;; "replaces \BITBLTSUB on Maiko")
|
||||
|
||||
((OPCODES SUBRCALL 69 13)
|
||||
PILOTBBT SourceBitMap SLX STY DestinationBitMap DLX DTY HEIGHT SourceType Operation Texture
|
||||
WindowXOffset WindowYOffset])
|
||||
(SUBRCALL BITBLTSUB PILOTBBT SourceBitMap SLX STY DestinationBitMap DLX DTY HEIGHT SourceType
|
||||
Operation Texture WindowXOffset WindowYOffset])
|
||||
|
||||
(\BLTCHAR
|
||||
[LAMBDA (CHARCODE DISPLAYSTREAM DISPLAYDATA)
|
||||
((OPCODES SUBRCALL 135 3)
|
||||
CHARCODE DISPLAYSTREAM DISPLAYDATA])
|
||||
[LAMBDA (CHARCODE DISPLAYSTREAM DISPLAYDATA) (* ; "Edited 26-Oct-2021 09:51 by larry")
|
||||
(SUBRCALL NEW-BLTCHAR CHARCODE DISPLAYSTREAM DISPLAYDATA])
|
||||
|
||||
(\CHECKSUM
|
||||
[LAMBDA (BASE NWORDS INITSUM) (* ; "Edited 20-May-88 11:48 by MASINTER")
|
||||
@@ -164,12 +163,12 @@ Copyright (c) 1989, 2018, 2021 by ENVOS Corporation.
|
||||
)
|
||||
(PUTPROPS MAIKOLOADUPFNS COPYRIGHT ("ENVOS Corporation" 1989 2018 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1336 5603 (CL::%%COPY-TIME-STATS 1346 . 1542) (CHECKPAGEMAP 1544 . 1676) (CLOCK 1678 .
|
||||
1827) (CLOCK0 1829 . 1979) (DAYTIME 1981 . 2132) (SETTIME 2134 . 2408) (\BITBLTSUB 2410 . 2832) (
|
||||
\BLTCHAR 2834 . 2966) (\CHECKSUM 2968 . 3133) (\CLOCK0 3135 . 3286) (\COUNTREALPAGES 3288 . 3421) (
|
||||
\DAYTIME0 3423 . 3576) (\DIRTYBACKGROUND 3578 . 3714) (\DOLOCKPAGES 3716 . 3848) (\DONEWPAGE 3850 .
|
||||
3999) (\DORECLAIM 4001 . 4147) (\DOTEMPLOCKPAGES 4149 . 4285) (\LOADVMEMPAGE 4287 . 4420) (
|
||||
\LOCKEDPAGEP 4422 . 4538) (\LOCKPAGES 4540 . 4670) (\MOVEVMEMFILEPAGE 4672 . 4793) (\NEWPAGE 4795 .
|
||||
4942) (\PAGEFAULT 4944 . 5056) (\SHOWPAGETABLE 5058 . 5192) (\TEMPUNLOCKPAGES 5194 . 5330) (
|
||||
\UNLOCKPAGES 5332 . 5464) (\WRITEDIRTYPAGE 5466 . 5601)))))
|
||||
(FILEMAP (NIL (1335 5651 (CL::%%COPY-TIME-STATS 1345 . 1541) (CHECKPAGEMAP 1543 . 1675) (CLOCK 1677 .
|
||||
1826) (CLOCK0 1828 . 1978) (DAYTIME 1980 . 2131) (SETTIME 2133 . 2407) (\BITBLTSUB 2409 . 2831) (
|
||||
\BLTCHAR 2833 . 3014) (\CHECKSUM 3016 . 3181) (\CLOCK0 3183 . 3334) (\COUNTREALPAGES 3336 . 3469) (
|
||||
\DAYTIME0 3471 . 3624) (\DIRTYBACKGROUND 3626 . 3762) (\DOLOCKPAGES 3764 . 3896) (\DONEWPAGE 3898 .
|
||||
4047) (\DORECLAIM 4049 . 4195) (\DOTEMPLOCKPAGES 4197 . 4333) (\LOADVMEMPAGE 4335 . 4468) (
|
||||
\LOCKEDPAGEP 4470 . 4586) (\LOCKPAGES 4588 . 4718) (\MOVEVMEMFILEPAGE 4720 . 4841) (\NEWPAGE 4843 .
|
||||
4990) (\PAGEFAULT 4992 . 5104) (\SHOWPAGETABLE 5106 . 5240) (\TEMPUNLOCKPAGES 5242 . 5378) (
|
||||
\UNLOCKPAGES 5380 . 5512) (\WRITEDIRTYPAGE 5514 . 5649)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Reference in New Issue
Block a user