1
0
mirror of synced 2026-03-15 14:47:09 +00:00

Compare commits

...

16 Commits

Author SHA1 Message Date
rmkaplan
21c8759084 Change default EOL to LF on UFS (#312)
UFS changes the the default in \UFSeol to LF.EOLC.  LLREAD changes \rprint2 to convert EOL to LF if escaped in a string.  NSPROTECTION eliminates literal EOL
2021-04-22 21:10:48 -07:00
Nick Briggs
f0b9ce3dae Fix eolconv.sh script so tr doesn't choke on bad UTF-8 data (#309) 2021-04-17 22:47:31 -07:00
Larry Masinter
1d81350714 guard didn't include #endif 2021-04-05 21:56:17 -07:00
Larry Masinter
5a83a9cd8f Add writing guard and running again 2021-04-05 21:56:17 -07:00
Larry Masinter
ba70b3a126 spell nightly correctly 2021-04-05 21:55:22 -07:00
Larry Masinter
26e4af726a Default tag to nightly 2021-04-05 21:55:22 -07:00
Larry Masinter
ad912885aa needed updated release-notes.md 2021-04-05 21:55:22 -07:00
Larry Masinter
ee5efd782f add missing font directories 2021-04-05 21:55:22 -07:00
Larry Masinter
9ddef79484 add scripts to release 2021-04-05 21:55:22 -07:00
Larry Masinter
5a04b88dcc tar files have version tag 2021-04-05 21:55:22 -07:00
Larry Masinter
945ffe56f8 Second try release scripts 2021-04-05 21:55:22 -07:00
Larry Masinter
7d8efbdfd6 Fix MAKESYSNAME (misspelled) and move GATHER-INFO to my personal init 2021-04-05 21:53:13 -07:00
Larry Masinter
6e9791ad0a Add back in files that were in lisp.venuesysout 2021-04-05 21:53:13 -07:00
Larry Masinter
3e64317db5 TEMPORARILY add files needed to compile (or load) that had been moved to 'obsolete/' 2021-03-31 14:07:31 -07:00
Larry Masinter
78d53039c5 dwim dwimify checktran fix (#295)
* Use checktran for all uses except in newfault1 block

* Replace CHECKTRAN+ with /DWIMCHECKTRAN only used in DWIM to undoably /RPLNODE the original, e.g. for spelling correction. Should be fixed for CL:LAMBDA
2021-03-22 20:25:17 -07:00
Larry Masinter
094f0146c9 sysout logout version (#296)
* Fix sysout makesys to make new versions

* redoing some lost edits
2021-03-22 20:22:22 -07:00
38 changed files with 1164 additions and 277 deletions

File diff suppressed because one or more lines are too long

Binary file not shown.

View File

@@ -1,16 +1,47 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 7-Sep-89 12:31:44" "{piglet/n}<piglet>vanmelle>lispusers>nsprotection;4" 31274
(FILECREATED "21-Apr-2021 11:56:06" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>NSPROTECTION.;4 32481
changes to%: (FNS NSPROT.SET.MULTIPLE))
changes to%: (FNS NSPROT.LIMITCHARS)
previous date%: " 7-Sep-89 12:31:44"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>NSPROTECTION.;2)
(* "
Copyright (c) 1987, 1989 by Xerox Corporation. All rights reserved.
(* ; "
Copyright (c) 1987, 1989, 2021 by Xerox Corporation.
")
(PRETTYCOMPRINT NSPROTECTIONCOMS)
(RPAQQ NSPROTECTIONCOMS ((COMS (* ; "Main window selection handlers") (FNS NSPROTECTION NSPROT.SHOW NSPROT.FETCH.PROTECTION NSPROT.NEW.ENTRY NSPROT.APPLY NSPROT.SET.PROTECTION NSPROT.SET.PROTECTION.ONE NSPROT.SET.MULTIPLE NSPROT.SET.TO.DEFAULT NSPROT.BEGIN.COMMAND) (FNS NSPROT.HANDLE.TYPE NSPROT.RESTORE.TYPE NSPROT.HANDLE.VERIFY NSPROT.RESTORE.VERIFY NSPROT.PARSE.FILENAME NSPROT.PARSE.PROTECTIONS NSPROT.STRIP.HOST NSPROT.EXPAND.FULLNAME)) (COMS (* ; "Handle protection submenus") (FNS NSPROT.GET.SUBMENU NSPROT.ADD.SUBMENU NSPROT.REMOVE.SUBMENUS NSPROT.CHANGE.STATE NSPROT.HANDLE.ALL NSPROT.MESSAGE.ALL NSPROT.HANDLE.SUBTYPE NSPROT.SHOW.PROT.VALUE)) (COMS (* ; "utilities") (FNS NSPROT.DIRECTORY.SYNTAXP NSPROT.TOP.LEVELP NSPROT.GET.FONT NSPROT.PROMPT NSPROT.CLEAR.PROMPT NSPROT.LIMITCHARS NSPROT.PAGEFULLFN NSPROT.ICONFN)) (INITVARS NSPROT.PLAIN.FONT NSPROT.BOLD.FONT) (VARS NSPROT.ICON) (GLOBALVARS NSPROT.PLAIN.FONT NSPROT.BOLD.FONT \NSFILING.ATTRIBUTES NSPROT.ICON \DEFAULTTTYDISPLAYSTREAM) (LOCALVARS . T) (COMS (DECLARE%: DONTEVAL@LOAD DOCOPY (P (AND (EQ MAKESYSNAME :LYRIC) (FILESLOAD (SYSLOAD) NSRANDOM)))) (FNS ADD.NSPROTECTION) (DECLARE%: DONTEVAL@LOAD DOCOPY (P (ADD.NSPROTECTION)))) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) (NLAML) (LAMA NSPROT.PROMPT)))))
(RPAQQ NSPROTECTIONCOMS
[(COMS (* ; "Main window selection handlers")
(FNS NSPROTECTION NSPROT.SHOW NSPROT.FETCH.PROTECTION NSPROT.NEW.ENTRY NSPROT.APPLY
NSPROT.SET.PROTECTION NSPROT.SET.PROTECTION.ONE NSPROT.SET.MULTIPLE
NSPROT.SET.TO.DEFAULT NSPROT.BEGIN.COMMAND)
(FNS NSPROT.HANDLE.TYPE NSPROT.RESTORE.TYPE NSPROT.HANDLE.VERIFY NSPROT.RESTORE.VERIFY
NSPROT.PARSE.FILENAME NSPROT.PARSE.PROTECTIONS NSPROT.STRIP.HOST
NSPROT.EXPAND.FULLNAME))
(COMS (* ; "Handle protection submenus")
(FNS NSPROT.GET.SUBMENU NSPROT.ADD.SUBMENU NSPROT.REMOVE.SUBMENUS NSPROT.CHANGE.STATE
NSPROT.HANDLE.ALL NSPROT.MESSAGE.ALL NSPROT.HANDLE.SUBTYPE NSPROT.SHOW.PROT.VALUE)
)
(COMS (* ; "utilities")
(FNS NSPROT.DIRECTORY.SYNTAXP NSPROT.TOP.LEVELP NSPROT.GET.FONT NSPROT.PROMPT
NSPROT.CLEAR.PROMPT NSPROT.LIMITCHARS NSPROT.PAGEFULLFN NSPROT.ICONFN))
(INITVARS NSPROT.PLAIN.FONT NSPROT.BOLD.FONT)
(VARS NSPROT.ICON)
(GLOBALVARS NSPROT.PLAIN.FONT NSPROT.BOLD.FONT \NSFILING.ATTRIBUTES NSPROT.ICON
\DEFAULTTTYDISPLAYSTREAM)
(LOCALVARS . T)
[COMS [DECLARE%: DONTEVAL@LOAD DOCOPY (P (AND (EQ MAKESYSNAME :LYRIC)
(FILESLOAD (SYSLOAD)
NSRANDOM]
(FNS ADD.NSPROTECTION)
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (ADD.NSPROTECTION]
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
(LAMA])
@@ -159,8 +190,16 @@ Copyright (c) 1987, 1989 by Xerox Corporation. All rights reserved.
)
(NSPROT.LIMITCHARS
(LAMBDA (ITEM WINDOW CHAR) (* ; "Edited 21-Aug-87 12:00 by bvm:") (SELECTQ CHAR ((%
Â) (FM.SKIPNEXT WINDOW) NIL) T)))
[LAMBDA (ITEM WINDOW CHAR) (* ; "Edited 21-Apr-2021 11:55 by rmk:")
(* ;; "RMK: Got rid of literal %%<CR> in favor of CHARCODE CR, for switch to default LF EOL convention. But compiled file may end up with LF")
(SELECTC CHAR
((LIST (CHARACTER (CHARCODE CR))
'Â)
(FM.SKIPNEXT WINDOW)
NIL)
T])
(NSPROT.PAGEFULLFN
(LAMBDA (PW) (* ; "Edited 2-Aug-89 16:19 by bvm") (* ;; "PAGEFULLFN for prompt window--makes the window a line bigger and allows output to proceed") (SETQ \CURRENTDISPLAYLINE (PROG1 \#DISPLAYLINES (GETPROMPTWINDOW (MAINWINDOW PW) (+ 1 \#DISPLAYLINES)) (* ; "\Currentdisplayline is the line we're on when window fills, origin zero"))))
@@ -171,14 +210,17 @@ Copyright (c) 1987, 1989 by Xerox Corporation. All rights reserved.
)
)
(RPAQ? NSPROT.PLAIN.FONT NIL)
(RPAQ? NSPROT.PLAIN.FONT NIL)
(RPAQ? NSPROT.BOLD.FONT NIL)
(RPAQ? NSPROT.BOLD.FONT NIL)
(RPAQQ NSPROT.ICON (#*(80 40)OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@@@@@@@@@@@@@@@@@CL@@@@@@@@@@@@@@@@@@CL@@@@@@@@@@@@@@@@@@CL@@@@@@@@@@@@@@@@@@CL@@@@@@@@@@@@@@AN@@CL@@@@@@@@@@@@@@GOH@CL@@@@@@@@@@@@@@OOL@CL@@@@@@@@@@@@@AOCN@CL@@@@@@@@@@@@@ANAN@CL@@@@@@@@@@@@@CL@O@CL@@@@@@@@@@@@@CL@O@CL@@@@@@@@@@@@@GH@G@CL@@@@@@@@@@@@@GH@GHCL@@@@@@@@@@@@@GH@GHCL@@@@@@@@@@@@@O@@CHCL@@@@@@@@@@@@@O@@CHCLAOOOOOOOOOOOOO@@CHCLCOOOOOOOOOOOOO@@CHCLCOOOOOOOOOOOOO@@CHCLAOOOOOOOOOOOOO@@CHCL@GNGNGN@@@@@@O@@CHCL@GNGNGN@@@@@@O@@CHCL@GNFFGN@@@@@@GH@GHCL@FFFFGN@@@@@@GH@GHCL@FF@@GN@@@@@@GH@G@CL@@@@@FF@@@@@@CL@O@CL@@@@@FF@@@@@@CL@O@CL@@@@@@@@@@@@@ANAN@CL@@@@@@@@@@@@@AOCN@CL@@@@@@@@@@@@@@OOL@CL@@@@@@@@@@@@@@GOH@CL@@@@@@@@@@@@@@CO@@CL@@@@@@@@@@@@@@@L@@CL@@@@@@@@@@@@@@@@@@CL@@@@@@@@@@@@@@@@@@CL@@@@@@@@@@@@@@@@@@COOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO NIL (4 22 51 14)))
(RPAQQ NSPROT.ICON (#*(80 40)OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@@@@@@@@@@@@@@@@@CL@@@@@@@@@@@@@@@@@@CL@@@@@@@@@@@@@@@@@@CL@@@@@@@@@@@@@@@@@@CL@@@@@@@@@@@@@@AN@@CL@@@@@@@@@@@@@@GOH@CL@@@@@@@@@@@@@@OOL@CL@@@@@@@@@@@@@AOCN@CL@@@@@@@@@@@@@ANAN@CL@@@@@@@@@@@@@CL@O@CL@@@@@@@@@@@@@CL@O@CL@@@@@@@@@@@@@GH@G@CL@@@@@@@@@@@@@GH@GHCL@@@@@@@@@@@@@GH@GHCL@@@@@@@@@@@@@O@@CHCL@@@@@@@@@@@@@O@@CHCLAOOOOOOOOOOOOO@@CHCLCOOOOOOOOOOOOO@@CHCLCOOOOOOOOOOOOO@@CHCLAOOOOOOOOOOOOO@@CHCL@GNGNGN@@@@@@O@@CHCL@GNGNGN@@@@@@O@@CHCL@GNFFGN@@@@@@GH@GHCL@FFFFGN@@@@@@GH@GHCL@FF@@GN@@@@@@GH@G@CL@@@@@FF@@@@@@CL@O@CL@@@@@FF@@@@@@CL@O@CL@@@@@@@@@@@@@ANAN@CL@@@@@@@@@@@@@AOCN@CL@@@@@@@@@@@@@@OOL@CL@@@@@@@@@@@@@@GOH@CL@@@@@@@@@@@@@@CO@@CL@@@@@@@@@@@@@@@L@@CL@@@@@@@@@@@@@@@@@@CL@@@@@@@@@@@@@@@@@@CL@@@@@@@@@@@@@@@@@@COOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
NIL
(4 22 51 14)))
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS NSPROT.PLAIN.FONT NSPROT.BOLD.FONT \NSFILING.ATTRIBUTES NSPROT.ICON \DEFAULTTTYDISPLAYSTREAM)
(GLOBALVARS NSPROT.PLAIN.FONT NSPROT.BOLD.FONT \NSFILING.ATTRIBUTES NSPROT.ICON
\DEFAULTTTYDISPLAYSTREAM)
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
@@ -186,7 +228,9 @@ Copyright (c) 1987, 1989 by Xerox Corporation. All rights reserved.
)
(DECLARE%: DONTEVAL@LOAD DOCOPY
(AND (EQ MAKESYSNAME :LYRIC) (FILESLOAD (SYSLOAD) NSRANDOM))
(AND (EQ MAKESYSNAME :LYRIC)
(FILESLOAD (SYSLOAD)
NSRANDOM))
)
(DEFINEQ
@@ -196,30 +240,30 @@ Copyright (c) 1987, 1989 by Xerox Corporation. All rights reserved.
)
(DECLARE%: DONTEVAL@LOAD DOCOPY
(ADD.NSPROTECTION)
(ADD.NSPROTECTION)
)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA)
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML)
(ADDTOVAR NLAML )
(ADDTOVAR LAMA NSPROT.PROMPT)
(ADDTOVAR LAMA )
)
(PUTPROPS NSPROTECTION COPYRIGHT ("Xerox Corporation" 1987 1989))
(PUTPROPS NSPROTECTION COPYRIGHT ("Xerox Corporation" 1987 1989 2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1695 14166 (NSPROTECTION 1705 . 4891) (NSPROT.SHOW 4893 . 5411) (
NSPROT.FETCH.PROTECTION 5413 . 8347) (NSPROT.NEW.ENTRY 8349 . 8972) (NSPROT.APPLY 8974 . 9903) (
NSPROT.SET.PROTECTION 9905 . 10481) (NSPROT.SET.PROTECTION.ONE 10483 . 11359) (NSPROT.SET.MULTIPLE
11361 . 12860) (NSPROT.SET.TO.DEFAULT 12862 . 13674) (NSPROT.BEGIN.COMMAND 13676 . 14164)) (14167
21199 (NSPROT.HANDLE.TYPE 14177 . 14477) (NSPROT.RESTORE.TYPE 14479 . 14830) (NSPROT.HANDLE.VERIFY
14832 . 15192) (NSPROT.RESTORE.VERIFY 15194 . 15525) (NSPROT.PARSE.FILENAME 15527 . 17256) (
NSPROT.PARSE.PROTECTIONS 17258 . 19753) (NSPROT.STRIP.HOST 19755 . 20136) (NSPROT.EXPAND.FULLNAME
20138 . 21197)) (21243 25794 (NSPROT.GET.SUBMENU 21253 . 23057) (NSPROT.ADD.SUBMENU 23059 . 23366) (
NSPROT.REMOVE.SUBMENUS 23368 . 23788) (NSPROT.CHANGE.STATE 23790 . 24072) (NSPROT.HANDLE.ALL 24074 .
24316) (NSPROT.MESSAGE.ALL 24318 . 24590) (NSPROT.HANDLE.SUBTYPE 24592 . 25137) (
NSPROT.SHOW.PROT.VALUE 25139 . 25792)) (25821 29042 (NSPROT.DIRECTORY.SYNTAXP 25831 . 26015) (
NSPROT.TOP.LEVELP 26017 . 26179) (NSPROT.GET.FONT 26181 . 26700) (NSPROT.PROMPT 26702 . 27226) (
NSPROT.CLEAR.PROMPT 27228 . 28111) (NSPROT.LIMITCHARS 28113 . 28254) (NSPROT.PAGEFULLFN 28256 . 28616)
(NSPROT.ICONFN 28618 . 29040)) (30249 30998 (ADD.NSPROTECTION 30259 . 30996)))))
(FILEMAP (NIL (2525 14996 (NSPROTECTION 2535 . 5721) (NSPROT.SHOW 5723 . 6241) (
NSPROT.FETCH.PROTECTION 6243 . 9177) (NSPROT.NEW.ENTRY 9179 . 9802) (NSPROT.APPLY 9804 . 10733) (
NSPROT.SET.PROTECTION 10735 . 11311) (NSPROT.SET.PROTECTION.ONE 11313 . 12189) (NSPROT.SET.MULTIPLE
12191 . 13690) (NSPROT.SET.TO.DEFAULT 13692 . 14504) (NSPROT.BEGIN.COMMAND 14506 . 14994)) (14997
22029 (NSPROT.HANDLE.TYPE 15007 . 15307) (NSPROT.RESTORE.TYPE 15309 . 15660) (NSPROT.HANDLE.VERIFY
15662 . 16022) (NSPROT.RESTORE.VERIFY 16024 . 16355) (NSPROT.PARSE.FILENAME 16357 . 18086) (
NSPROT.PARSE.PROTECTIONS 18088 . 20583) (NSPROT.STRIP.HOST 20585 . 20966) (NSPROT.EXPAND.FULLNAME
20968 . 22027)) (22073 26624 (NSPROT.GET.SUBMENU 22083 . 23887) (NSPROT.ADD.SUBMENU 23889 . 24196) (
NSPROT.REMOVE.SUBMENUS 24198 . 24618) (NSPROT.CHANGE.STATE 24620 . 24902) (NSPROT.HANDLE.ALL 24904 .
25146) (NSPROT.MESSAGE.ALL 25148 . 25420) (NSPROT.HANDLE.SUBTYPE 25422 . 25967) (
NSPROT.SHOW.PROT.VALUE 25969 . 26622)) (26651 30154 (NSPROT.DIRECTORY.SYNTAXP 26661 . 26845) (
NSPROT.TOP.LEVELP 26847 . 27009) (NSPROT.GET.FONT 27011 . 27530) (NSPROT.PROMPT 27532 . 28056) (
NSPROT.CLEAR.PROMPT 28058 . 28941) (NSPROT.LIMITCHARS 28943 . 29366) (NSPROT.PAGEFULLFN 29368 . 29728)
(NSPROT.ICONFN 29730 . 30152)) (31446 32195 (ADD.NSPROTECTION 31456 . 32193)))))
STOP

Binary file not shown.

File diff suppressed because one or more lines are too long

BIN
lispusers/WHO-LINE.DFASL Normal file

Binary file not shown.

Binary file not shown.

29
release-notes.md Normal file
View File

@@ -0,0 +1,29 @@
Each release should have a subset of the medley repo in a file
`medley-`releasename`.tgz`
and at least one
`maiko-`releasename`.`osname`.`arch`.tgz`
e.g.,
`maiko-$tag.linux.x86_64.tgz`
for each os/arch pair for which we have GitHub "action" runners.
To use (from a shell/terminal window):
1. Unpack the medley tar file
```
tar -xvfz medley-$tag.tgz
```
and the maiko file for your os.arch
```
tar -xvfz maiko-$tag.linux.x86_64.tgz
```
this should leave you with two new directories, `medley` and `maiko`.
Then you can
```
cd medley
./run-medley -full
```

View File

@@ -1,2 +1,2 @@
#!/bin/sh
tr '\r' '\n' < $1 | tr -d '\001-\006'
LANG=C tr '\r' '\n' < $1 | tr -d '\001-\006'

31
scripts/release-one.sh Executable file
View File

@@ -0,0 +1,31 @@
#!/bin/sh
export MEDLEYDIR=`pwd`
if [ ! -x run-medley ] ; then
echo "run from MEDLEYDIR (with MAIKODIR ../maiko)"
exit 1
fi
tag=$1
if [ -z "$tag" ] ; then
tag=nightly-`date +%y%m%d`
fi
cd ../maiko/bin
export PATH=.:"$PATH"
osarch=`osversion`.`machinetype`
cd ../..
echo making maiko-$tag-$osarch.tgz
tar cfz medley/tmp/maiko-$tag-$osarch.tgz \
--exclude "make*" --exclude legacy \
maiko/bin \
maiko/$osarch/lde*
cd medley
echo uploading
gh release upload --clobber $tag tmp/maiko-$tag-$osarch.tgz

41
scripts/start-release.sh Executable file
View File

@@ -0,0 +1,41 @@
#!/bin/sh
export MEDLEYDIR=`pwd`
if [ ! -x run-medley ] ; then
echo run from MEDLEYDIR
exit 1
fi
tag=$1
if [ -z "$tag" ] ; then
tag=nightly-`date +%y%m%d`
fi
cd ..
echo making medley zip
tar cfz medley/tmp/medley-$tag.tgz \
--exclude-backups --exclude="*.PDF" \
medley/docs/dinfo \
medley/greetfiles/SIMPLE-INIT \
medley/run-medley \
medley/scripts \
medley/loadups \
medley/fonts/displayfonts medley/fonts/altofonts \
medley/fonts/postscriptfonts medley/fonts/ipfonts \
medley/library/ \
medley/internal/library \
medley/lispusers/ \
medley/sources/
cd medley
echo making release
sed s/'$tag'/$tag/g < release-notes.md > tmp/release-notes.md
gh release create $tag -F tmp/release-notes.md -p -t $tag
echo uploaded tmp/medley-$tag.tgz
gh release upload $tag tmp/medley-$tag.tgz --clobber
./scripts/release-one.sh $tag

File diff suppressed because one or more lines are too long

Binary file not shown.

397
sources/DOVEDECLS Executable file
View File

@@ -0,0 +1,397 @@
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED "16-May-90 15:55:59" {DSK}<usr>local>lde>lispcore>sources>DOVEDECLS.;2 15966
changes to%: (VARS DOVEDECLSCOMS)
previous date%: "31-Mar-86 11:10:09" {DSK}<usr>local>lde>lispcore>sources>DOVEDECLS.;1)
(* ; "
Copyright (c) 1985, 1986, 1990 by Venue & Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT DOVEDECLSCOMS)
(RPAQQ DOVEDECLSCOMS
((DECLARE%: DONTCOPY (FILES MESATYPES))
(MACROS \Dove.ClearQueueBlock \DoveIO.ByteSwap \DoveIO.IORegionOffset \DoveIO.LockMem
\DoveIO.NotifyIOP \DoveIO.SetMaintPanel \DoveFCBAt)
(CONSTANTS \DoveIO.ADD \DoveIO.AND \DoveIO.OR \DoveIO.OVERWRITEIFNIL \DoveIO.XCHG
\#WDS.OpieAddress)
(CONSTANTS \DoveIO.ByteFALSE \DoveIO.ByteTRUE)
(CONSTANTS * DoveIO.IORegionConstants)
(CONSTANTS * DoveIO.HandlerIDs)
(RECORDS Dove.OpieAddress DoveIO.ClientCondition DoveIO.TaskContextBlock DoveIO.SegmentRec
DoveIO.IORTable Dove.QueueBlock)
(PROP ARGNAMES \DoveFCBAt)
(COMS (CONSTANTS * DOVEIOREGIONOFFSETS)
(CONSTANTS * DOVEOPIEADDRESSTYPES)
(VARS \Dove.FCBSizes \DoveIO.PromVersion))
(GLOBALVARS \DoveBeep.FCBPointer \DoveProcessor.FCBPointer \DoveKyMo.FCBPointer
\DoveMP.FCBPointer \DoveDisk.FCBPointer \DoveDisplay.FCBPointer \DoveEther.FCBPointer
\DoveFloppy.FCBPointer)
(TEMPLATES \DoveIO.LockMem)))
(DECLARE%: DONTCOPY
(FILESLOAD MESATYPES)
)
(DECLARE%: EVAL@COMPILE
(PROGN (DEFMACRO \Dove.ClearQueueBlock (BASE)
`(\CLEARWORDS %, BASE (MESASIZE Dove.QueueBlock)))
NIL)
(PUTPROPS \DoveIO.ByteSwap DMACRO [ARGS (LET ((X (CAR ARGS)))
`((OPCODES DOVEMISC 4)
%, X])
(PROGN (DEFMACRO \DoveIO.IORegionOffset (X)
`(IDIFFERENCE (\LOLOC %, X)
(\LOLOC \DoveIORegion)))
NIL)
(PUTPROPS \DoveIO.LockMem DMACRO [ARGS (LET ((MASK (CAR ARGS))
(VALUE (CADR ARGS))
(ADDR (CADDR ARGS))
(OP (CADDDR ARGS)))
`((OPCODES DOVEMISC 5)
%, OP %, ADDR %, VALUE %, MASK])
(PUTPROPS \DoveIO.NotifyIOP DMACRO [ARGS (LET ((MASK (CAR ARGS)))
`((OPCODES DOVEMISC 6)
%, MASK])
(PUTPROPS \DoveIO.SetMaintPanel DMACRO [ARGS (LET ((CODE (CAR ARGS)))
`((OPCODES DOVEMISC 2)
%,
(\DTEST CODE 'SMALLP])
(PUTPROPS \DoveFCBAt DMACRO (DEFMACRO (X) (SELECTQ \DoveIO.PromVersion
(OLD `(\ADDBASE \DoveIORegion %, X))
(NEW (ERROR "Don't use \DoveFCBAt anymore!"))
'IGNOREMACRO)))
)
(DECLARE%: EVAL@COMPILE
(RPAQQ \DoveIO.ADD 0)
(RPAQQ \DoveIO.AND 1)
(RPAQQ \DoveIO.OR 2)
(RPAQQ \DoveIO.OVERWRITEIFNIL 4)
(RPAQQ \DoveIO.XCHG 3)
(RPAQQ \#WDS.OpieAddress 2)
(CONSTANTS \DoveIO.ADD \DoveIO.AND \DoveIO.OR \DoveIO.OVERWRITEIFNIL \DoveIO.XCHG \#WDS.OpieAddress)
)
(DECLARE%: EVAL@COMPILE
(RPAQQ \DoveIO.ByteFALSE 0)
(RPAQQ \DoveIO.ByteTRUE 255)
(CONSTANTS \DoveIO.ByteFALSE \DoveIO.ByteTRUE)
)
(RPAQQ DoveIO.IORegionConstants ((DoveIO.SegmentGranularity 8)
(DoveIO.ioRegionByteOffset 16384)
(DoveIO.iorSegmentBase (FOLDLO DoveIO.ioRegionByteOffset 16))))
(DECLARE%: EVAL@COMPILE
(RPAQQ DoveIO.SegmentGranularity 8)
(RPAQQ DoveIO.ioRegionByteOffset 16384)
(RPAQ DoveIO.iorSegmentBase (FOLDLO DoveIO.ioRegionByteOffset 16))
(CONSTANTS (DoveIO.SegmentGranularity 8)
(DoveIO.ioRegionByteOffset 16384)
(DoveIO.iorSegmentBase (FOLDLO DoveIO.ioRegionByteOffset 16)))
)
(RPAQQ DoveIO.HandlerIDs
((DoveIO.beepHandler 1)
(DoveIO.diskHandler (ADD1 DoveIO.beepHandler))
(DoveIO.displayHandler (ADD1 DoveIO.diskHandler))
(DoveIO.ethernetHandler (ADD1 DoveIO.displayHandler))
(DoveIO.floppyHandler (ADD1 DoveIO.ethernetHandler))
(DoveIO.kymoHandler (ADD1 DoveIO.floppyHandler))
(DoveIO.mpHandler (ADD1 DoveIO.kymoHandler))
(DoveIO.lispHandler 16)
(DoveIO.ttyHandler (ADD1 DoveIO.lispHandler))
(DoveIO.rs232Handler (ADD1 DoveIO.ttyHandler))
(DoveIO.confHandler (ADD1 DoveIO.rs232Handler))
(DoveIO.pceDispatchHandler (ADD1 DoveIO.confHandler))
(DoveIO.pceDisplayHandler (ADD1 DoveIO.pceDispatchHandler))
(DoveIO.pceKeyHandler (ADD1 DoveIO.pceDisplayHandler))
(DoveIO.pceMouseHandler (ADD1 DoveIO.pceKeyHandler))
(DoveIO.pcePrinterHandler (ADD1 DoveIO.pceMouseHandler))
(DoveIO.pceFloppyHandler (ADD1 DoveIO.pcePrinterHandler))
(DoveIO.pceHardDiskHandler (ADD1 DoveIO.pceFloppyHandler))
(DoveIO.pceDMAHandler (ADD1 DoveIO.pceHardDiskHandler))
(DoveIO.pceTimer (ADD1 DoveIO.pceDMAHandler))))
(DECLARE%: EVAL@COMPILE
(RPAQQ DoveIO.beepHandler 1)
(RPAQ DoveIO.diskHandler (ADD1 DoveIO.beepHandler))
(RPAQ DoveIO.displayHandler (ADD1 DoveIO.diskHandler))
(RPAQ DoveIO.ethernetHandler (ADD1 DoveIO.displayHandler))
(RPAQ DoveIO.floppyHandler (ADD1 DoveIO.ethernetHandler))
(RPAQ DoveIO.kymoHandler (ADD1 DoveIO.floppyHandler))
(RPAQ DoveIO.mpHandler (ADD1 DoveIO.kymoHandler))
(RPAQQ DoveIO.lispHandler 16)
(RPAQ DoveIO.ttyHandler (ADD1 DoveIO.lispHandler))
(RPAQ DoveIO.rs232Handler (ADD1 DoveIO.ttyHandler))
(RPAQ DoveIO.confHandler (ADD1 DoveIO.rs232Handler))
(RPAQ DoveIO.pceDispatchHandler (ADD1 DoveIO.confHandler))
(RPAQ DoveIO.pceDisplayHandler (ADD1 DoveIO.pceDispatchHandler))
(RPAQ DoveIO.pceKeyHandler (ADD1 DoveIO.pceDisplayHandler))
(RPAQ DoveIO.pceMouseHandler (ADD1 DoveIO.pceKeyHandler))
(RPAQ DoveIO.pcePrinterHandler (ADD1 DoveIO.pceMouseHandler))
(RPAQ DoveIO.pceFloppyHandler (ADD1 DoveIO.pcePrinterHandler))
(RPAQ DoveIO.pceHardDiskHandler (ADD1 DoveIO.pceFloppyHandler))
(RPAQ DoveIO.pceDMAHandler (ADD1 DoveIO.pceHardDiskHandler))
(RPAQ DoveIO.pceTimer (ADD1 DoveIO.pceDMAHandler))
(CONSTANTS (DoveIO.beepHandler 1)
(DoveIO.diskHandler (ADD1 DoveIO.beepHandler))
(DoveIO.displayHandler (ADD1 DoveIO.diskHandler))
(DoveIO.ethernetHandler (ADD1 DoveIO.displayHandler))
(DoveIO.floppyHandler (ADD1 DoveIO.ethernetHandler))
(DoveIO.kymoHandler (ADD1 DoveIO.floppyHandler))
(DoveIO.mpHandler (ADD1 DoveIO.kymoHandler))
(DoveIO.lispHandler 16)
(DoveIO.ttyHandler (ADD1 DoveIO.lispHandler))
(DoveIO.rs232Handler (ADD1 DoveIO.ttyHandler))
(DoveIO.confHandler (ADD1 DoveIO.rs232Handler))
(DoveIO.pceDispatchHandler (ADD1 DoveIO.confHandler))
(DoveIO.pceDisplayHandler (ADD1 DoveIO.pceDispatchHandler))
(DoveIO.pceKeyHandler (ADD1 DoveIO.pceDisplayHandler))
(DoveIO.pceMouseHandler (ADD1 DoveIO.pceKeyHandler))
(DoveIO.pcePrinterHandler (ADD1 DoveIO.pceMouseHandler))
(DoveIO.pceFloppyHandler (ADD1 DoveIO.pcePrinterHandler))
(DoveIO.pceHardDiskHandler (ADD1 DoveIO.pceFloppyHandler))
(DoveIO.pceDMAHandler (ADD1 DoveIO.pceHardDiskHandler))
(DoveIO.pceTimer (ADD1 DoveIO.pceDMAHandler)))
)
(DECLARE%: EVAL@COMPILE
(MESARECORD Dove.OpieAddress ((LoPart.BS WORD)
(HiPart BYTE)
(AddrType BYTE))
[ACCESSFNS ((LispPointer (\DoveIO.PointerFromOpieAddress DATUM)
(\DoveIO.MakeOpieAddress DATUM NEWVALUE])
(MESATYPE DoveIO.ClientCondition (3 WORD))
(MESARECORD DoveIO.TaskContextBlock ((taskQueue 2 WORD)
(taskCondition WORD)
(taskICPtr WORD)
(taskSP WORD)
(returnSPSS 2 WORD)
(prevState BITS 4)
(presentState BITS 4)
(taskHandlerID BYTE)
(timerValue WORD)))
(MESARECORD DoveIO.SegmentRec ((ioRegionSegment WORD)
(stackSegment WORD)))
(MESARECORD DoveIO.IORTable ((mesaHasLock BITS 16)
(iopRequestsLock BITS 16)
(segments DoveIO.SegmentRec)))
(MESARECORD Dove.QueueBlock ((QueueHead Dove.OpieAddress)
(QueueTail Dove.OpieAddress)
(QueueNext Dove.OpieAddress))
[ACCESSFNS ((LispQueueHead (\DoveIO.PointerFromOpieAddress
(fetch (Dove.QueueBlock QueueHead)
of DATUM))
(\DoveIO.MakeOpieAddress (fetch (
Dove.QueueBlock
QueueHead)
of DATUM)
NEWVALUE))
(LispQueueTail (\DoveIO.PointerFromOpieAddress
(fetch (Dove.QueueBlock QueueTail)
of DATUM))
(\DoveIO.MakeOpieAddress (fetch (
Dove.QueueBlock
QueueTail)
of DATUM)
NEWVALUE))
(LispQueueNext (\DoveIO.PointerFromOpieAddress
(fetch (Dove.QueueBlock QueueNext)
of DATUM))
(\DoveIO.MakeOpieAddress (fetch (
Dove.QueueBlock
QueueNext)
of DATUM)
NEWVALUE])
)
(PUTPROPS \DoveFCBAt ARGNAMES (OFFSET))
(RPAQQ DOVEIOREGIONOFFSETS
((\Dove.VmemPageRunTableOffset 16128)
(\Dove.MesaClientFCBOffset 4474)
(\Dove.RemoteMemoryFCBOffset 3911)
(\Dove.UnservicedFCBOffset 3815)
(\Dove.WorkNotifierFCBOffset 3719)
(\Dove.BindweedFCBOffset 3623)
(\Dove.BootStrapFCBOffset 3527)
(\Dove.WatchDogFCBOffset 3431)
(\Dove.TestClientFCBOffset 2816)
(\Dove.TimerFCBOffset 870)
(\Dove.UmbilicalFCBOffset 478)
(\Dove.ParityFCBOffset 382)
(\Dove.OpieFCBOffset 30)
(\Dove.BermudaFCBOffset 26)))
(DECLARE%: EVAL@COMPILE
(RPAQQ \Dove.VmemPageRunTableOffset 16128)
(RPAQQ \Dove.MesaClientFCBOffset 4474)
(RPAQQ \Dove.RemoteMemoryFCBOffset 3911)
(RPAQQ \Dove.UnservicedFCBOffset 3815)
(RPAQQ \Dove.WorkNotifierFCBOffset 3719)
(RPAQQ \Dove.BindweedFCBOffset 3623)
(RPAQQ \Dove.BootStrapFCBOffset 3527)
(RPAQQ \Dove.WatchDogFCBOffset 3431)
(RPAQQ \Dove.TestClientFCBOffset 2816)
(RPAQQ \Dove.TimerFCBOffset 870)
(RPAQQ \Dove.UmbilicalFCBOffset 478)
(RPAQQ \Dove.ParityFCBOffset 382)
(RPAQQ \Dove.OpieFCBOffset 30)
(RPAQQ \Dove.BermudaFCBOffset 26)
(CONSTANTS (\Dove.VmemPageRunTableOffset 16128)
(\Dove.MesaClientFCBOffset 4474)
(\Dove.RemoteMemoryFCBOffset 3911)
(\Dove.UnservicedFCBOffset 3815)
(\Dove.WorkNotifierFCBOffset 3719)
(\Dove.BindweedFCBOffset 3623)
(\Dove.BootStrapFCBOffset 3527)
(\Dove.WatchDogFCBOffset 3431)
(\Dove.TestClientFCBOffset 2816)
(\Dove.TimerFCBOffset 870)
(\Dove.UmbilicalFCBOffset 478)
(\Dove.ParityFCBOffset 382)
(\Dove.OpieFCBOffset 30)
(\Dove.BermudaFCBOffset 26))
)
(RPAQQ DOVEOPIEADDRESSTYPES (\DoveIO.ExtendedBusType \DoveIO.IOPIORegionRelativeType
\DoveIO.IOPLogicalType \DoveIO.PCLogicalType
\DoveIO.VirtualFirst64KRelativeType \DoveIO.VirtualPageType
\DoveIO.VirtualWordType))
(DECLARE%: EVAL@COMPILE
(RPAQQ \DoveIO.ExtendedBusType 16)
(RPAQQ \DoveIO.IOPIORegionRelativeType 81)
(RPAQQ \DoveIO.IOPLogicalType 80)
(RPAQQ \DoveIO.PCLogicalType 144)
(RPAQQ \DoveIO.VirtualFirst64KRelativeType 225)
(RPAQQ \DoveIO.VirtualPageType 240)
(RPAQQ \DoveIO.VirtualWordType 224)
(CONSTANTS \DoveIO.ExtendedBusType \DoveIO.IOPIORegionRelativeType \DoveIO.IOPLogicalType
\DoveIO.PCLogicalType \DoveIO.VirtualFirst64KRelativeType \DoveIO.VirtualPageType
\DoveIO.VirtualWordType)
)
(RPAQQ \Dove.FCBSizes
((NIL 2)
(\Dove.MesaIOPOffset 5)
(\Dove.WorkMaskAreaOffset 17)
(\Dove.MesaPageMapLocationOffset 2)
(\Dove.BermudaFCBOffset 4)
(\Dove.OpieFCBOffset 256)
(\Dove.MaintPanelFCBOffset 96)
(\Dove.ParityFCBOffset 96)
(\Dove.UmbilicalFCBOffset 96)
(\Dove.Keyboard&MouseFCBOffset 175)
(\Dove.BeepFCBOffset 25)
(\Dove.DisplayFCBOffset 96)
(\Dove.TimerFCBOffset 96)
(\Dove.EthernetFCBOffset 1850)
(\Dove.TestClientFCBOffset 340)
(\Dove.DiskFCBOffset 150)
(\Dove.FloppyFCBOffset 125)
(\Dove.WatchDogFCBOffset 96)
(\Dove.BootStrapFCBOffset 96)
(\Dove.BindweedFCBOffset 96)
(\Dove.WorkNotifierFCBOffset 96)
(\Dove.UnservicedFCBOffset 96)
(\Dove.RemoteMemoryFCBOffset 231)
(\Dove.TTYFCBOffset 96)
(\Dove.RS232CFCBOffset 140)
(\Dove.ProcessorFCBOffset 96)
(\Dove.MesaClientFCBOffset 96)
(\Dove.PCEDispatcherFCBOffset 96)
(\Dove.PCETimerFCBOffset 96)
(\Dove.PCEParallelFCBOffset 96)
(\Dove.PCEDisplayFCBOffset 96)
(\Dove.PCEKeyboardFCBOffset 96)
(\Dove.PCERS232CFCBOffset 96)
(\Dove.PCEDiskFCBOffset 96)
(\Dove.PCEFloppyFCBOffset 160)))
(RPAQQ \DoveIO.PromVersion NEW)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \DoveBeep.FCBPointer \DoveProcessor.FCBPointer \DoveKyMo.FCBPointer \DoveMP.FCBPointer
\DoveDisk.FCBPointer \DoveDisplay.FCBPointer \DoveEther.FCBPointer \DoveFloppy.FCBPointer)
)
(SETTEMPLATE '\DoveIO.LockMem '(|..| EVAL))
(PUTPROPS DOVEDECLS COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1990))
(DECLARE%: DONTCOPY
(FILEMAP (NIL)))
STOP

293
sources/DOVEETHERDECLS Executable file
View File

@@ -0,0 +1,293 @@
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED "16-May-90 16:04:03" {DSK}<usr>local>lde>lispcore>sources>DOVEETHERDECLS.;2 14397
changes to%: (VARS DOVEETHERDECLSCOMS)
previous date%: "17-Dec-86 18:38:00" {DSK}<usr>local>lde>lispcore>sources>DOVEETHERDECLS.;1)
(* ; "
Copyright (c) 1986, 1990 by Venue & Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT DOVEETHERDECLSCOMS)
(RPAQQ DOVEETHERDECLSCOMS
((FILES MESATYPES)
(RECORDS Dove.EtherSCB)
(RECORDS Dove.EtherAddr Dove.EtherConfigure Dove.EtherDumpStatus Dove.EtherFCB
Dove.Etheri586Status Dove.EtherIOCB Dove.EtherCommandIOCB Dove.EtherIOIOCB
Dove.EtherMulticastAddr Dove.EtherTransmit Dove.RxBufferDesc Dove.RxFrameDesc
Dove.TimeDomainRFL)
(FUNCTIONS \DoveEther.DoOutput)
(CONSTANTS \DoveEther.MulticastAddr \DoveEther.QueuePtrSize \DoveEther.ClientConditionSize
\DoveEther.IOIOCBLength \DoveEther.RequestON \DoveEther.RequestOFF)
(CONSTANTS * DoveEther.IOCBTypes)
(CONSTANTS * DoveEther.ActionCommands)))
(FILESLOAD MESATYPES)
(DECLARE%: EVAL@COMPILE
(MESARECORD Dove.EtherSCB ((stat BITS 4)
(NIL BITS 1)
(cus BITS 3) (* command unit status)
(NIL BITS 1)
(rus BITS 3) (* receive unit status)
(NIL BITS 4)
(ack BITS 4) (* acknowledge int)
(NIL BITS 1)
(cuc BITS 3) (* command unit command)
(reset FLAG)
(ruc BITS 3) (* receive unit command)
(NIL BITS 4)
(cblOffset WORD)
(rfaOffset WORD)
(crcErrs WORD)
(alnErrs WORD)
(rscErrs WORD)
(ovrnErrs WORD)))
)
(DECLARE%: EVAL@COMPILE
(BLOCKRECORD Dove.EtherAddr ((id 3 WORD)))
(MESARECORD Dove.EtherConfigure ((NIL BITS 4)
(ByteCount BITS 4)
(NIL BITS 4)
(FifoLimit BITS 4)
(SaveBadFrames FLAG)
(SyncReady FLAG)
(NIL BITS 6)
(ExternalLoopBack FLAG)
(InternalLoopBack FLAG)
(PreambleLength BITS 2)
(AddrTypeLoc BITS 1)
(AddrLength BITS 3)
(ExpBackoffMethod BITS 1)
(AccContRes BITS 3)
(NIL BITS 1)
(LinearPolarity BITS 3)
(InterframeSpacing BYTE)
(SlotTimeLow BYTE)
(RetryNumber BITS 4)
(NIL BITS 1)
(SlotTimeHigh BITS 3)
(Padding FLAG)
(BitStuffing FLAG)
(CRC16 FLAG)
(NoCRCInsertion FLAG)
(TxNoCRS FLAG)
(NRZEncoding FLAG)
(BroadcastDisable FLAG)
(PromiscuousMode FLAG)
(InternalCDT FLAG)
(CDTFilter BITS 3)
(InternalCRS FLAG)
(CRSFilter BITS 3)
(MinFrameLength BYTE)
(NIL BYTE)))
(BLOCKRECORD Dove.EtherDumpStatus ((Buffer WORD)))
(MESARECORD Dove.EtherFCB ((mesaOutQueue Dove.QueueBlock)
(mesaInQueue Dove.QueueBlock)
(mesaClientStateRequest WORD)
(scb Dove.EtherSCB)
(etherOutWorkMask WORD)
(etherInWorkMask WORD)
(etherLockMask WORD)
(mesaInClientState WORD)
(mesaOutClientState WORD)))
(BLOCKRECORD Dove.Etheri586Status ((completion FLAG)
(busy FLAG)
(okay FLAG))
(BLOCKRECORD Dove.Etheri586Status ((NIL BITS 3)
(* receiveframe variant)
(unused FLAG)
(crcErr FLAG)
(alnErr FLAG)
(rscErr FLAG)
(ovrnErr FLAG)
(frameTooShort FLAG)
(noEOFFlag FLAG)
(NIL BITS 6)))
(BLOCKRECORD Dove.Etheri586Status ((NIL BITS 3)
(* command variant.
 Mainly for transmit)
(aborted FLAG)
(NIL FLAG)
(noCRS FLAG)
(lossOfCTS FLAG)
(underrun FLAG)
(deferred FLAG)
(sqeTest FLAG)
(tooManyCollisions FLAG)
(NIL BITS 1)
(collisions BITS 4))))
(MESARECORD Dove.EtherIOCB ((next Dove.OpieAddress) (* Next IOCB in IO queue)
(ClientCondition 3 WORD) (* Gets notifed in Mesaland when IO
 is complete)
(i586Status WORD) (* Status from the Dove ethernet
 coprocessor)
(Status BYTE) (* IO status?)
(IOCBType BITS 4) (* What type of IO operation is
 this?)
(Action BITS 4) (* Used only for Command variant)
)
[ACCESSFNS ((nextIOCB (fetch (Dove.OpieAddress LispPointer)
of (fetch (Dove.EtherIOCB next)
of DATUM))
(replace (Dove.OpieAddress LispPointer)
of (fetch (Dove.EtherIOCB next)
of DATUM) with NEWVALUE]
(BLOCKRECORD Dove.EtherIOCB ((NIL 6 WORD)
(done FLAG)
(handled FLAG)
(okay FLAG)
(frameTooLong FLAG)
(interruptTimeout FLAG)
(NIL BITS 2)
(isDequeued FLAG))))
(MESARECORD Dove.EtherCommandIOCB ((iocbCommon Dove.EtherIOCB)
(select 7 WORD)))
(MESARECORD Dove.EtherIOIOCB ((iocbCommon Dove.EtherIOCB)
(address Dove.OpieAddress)
(length WORD)
(count WORD))
[ACCESSFNS ((bufferAddress (fetch (Dove.OpieAddress LispPointer)
of (fetch (Dove.EtherIOIOCB
address)
of DATUM))
(replace (Dove.OpieAddress LispPointer)
of (fetch (Dove.EtherIOIOCB address)
of DATUM) with NEWVALUE])
(BLOCKRECORD Dove.EtherMulticastAddr ((ByteCount WORD)
(MulticastID1 3 WORD)
(MulticastID2 3 WORD)))
(BLOCKRECORD Dove.EtherTransmit ((BdPtr WORD)
(DestAddr 3 WORD)
(Type WORD)))
(BLOCKRECORD Dove.RxBufferDesc ((EndOfFrame FLAG)
(Filled FLAG)
(ActualCount BITS 14)
(Next WORD)
(BufAddrIOPReal WORD)
(EndOfList FLAG)
(Unused FLAG)
(Size BITS 14)))
(BLOCKRECORD Dove.RxFrameDesc ((Status WORD)
(EndOfList FLAG)
(Suspend FLAG)
(NIL BITS 14)
(Link WORD)
(BDPtr WORD)
(DestAddr 3 WORD)
(SourceAddr 3 WORD)
(Type WORD)))
(BLOCKRECORD Dove.TimeDomainRFL ((LinkOK FLAG)
(XcvrProblem FLAG)
(Open FLAG)
(Short FLAG)
(NIL FLAG)
(Time BITS 11)))
)
(DEFMACRO \DoveEther.DoOutput (IOCB)
`(PROGN (\DoveEther.Initiate ,IOCB)
(until (fetch (Dove.EtherIOCB done) of ,IOCB))
(\DoveEther.DeQueue (fetch (Dove.EtherFCB mesaOutQueue) of \DoveEther.FCBPointer)
,IOCB)
(fetch (Dove.EtherIOCB okay) of ,IOCB)))
(DECLARE%: EVAL@COMPILE
(RPAQQ \DoveEther.MulticastAddr 3)
(RPAQQ \DoveEther.QueuePtrSize 6)
(RPAQQ \DoveEther.ClientConditionSize 3)
(RPAQQ \DoveEther.IOIOCBLength 11)
(RPAQQ \DoveEther.RequestON 1)
(RPAQQ \DoveEther.RequestOFF 0)
(CONSTANTS \DoveEther.MulticastAddr \DoveEther.QueuePtrSize \DoveEther.ClientConditionSize
\DoveEther.IOIOCBLength \DoveEther.RequestON \DoveEther.RequestOFF)
)
(RPAQQ DoveEther.IOCBTypes ((DoveEther.commandIOCBType 0)
(DoveEther.outputIOCBType 1)
(DoveEther.resetIOCBType 2)
(DoveEther.startRUIOCBType 3)
(DoveEther.inputIOCBType 15)))
(DECLARE%: EVAL@COMPILE
(RPAQQ DoveEther.commandIOCBType 0)
(RPAQQ DoveEther.outputIOCBType 1)
(RPAQQ DoveEther.resetIOCBType 2)
(RPAQQ DoveEther.startRUIOCBType 3)
(RPAQQ DoveEther.inputIOCBType 15)
(CONSTANTS (DoveEther.commandIOCBType 0)
(DoveEther.outputIOCBType 1)
(DoveEther.resetIOCBType 2)
(DoveEther.startRUIOCBType 3)
(DoveEther.inputIOCBType 15))
)
(RPAQQ DoveEther.ActionCommands ((DoveEther.actionNop 0)
(DoveEther.actionIndividualAddr 1)
(DoveEther.actionConfigure 2)
(DoveEther.actionMulticastAddr 3)
(DoveEther.actionTransmit 4)
(DoveEther.actionTimeDomainRfl 5)
(DoveEther.actionDumpStatus 6)
(DoveEther.actionDiagnose 7)))
(DECLARE%: EVAL@COMPILE
(RPAQQ DoveEther.actionNop 0)
(RPAQQ DoveEther.actionIndividualAddr 1)
(RPAQQ DoveEther.actionConfigure 2)
(RPAQQ DoveEther.actionMulticastAddr 3)
(RPAQQ DoveEther.actionTransmit 4)
(RPAQQ DoveEther.actionTimeDomainRfl 5)
(RPAQQ DoveEther.actionDumpStatus 6)
(RPAQQ DoveEther.actionDiagnose 7)
(CONSTANTS (DoveEther.actionNop 0)
(DoveEther.actionIndividualAddr 1)
(DoveEther.actionConfigure 2)
(DoveEther.actionMulticastAddr 3)
(DoveEther.actionTransmit 4)
(DoveEther.actionTimeDomainRfl 5)
(DoveEther.actionDumpStatus 6)
(DoveEther.actionDiagnose 7))
)
(PUTPROPS DOVEETHERDECLS COPYRIGHT ("Venue & Xerox Corporation" 1986 1990))
(DECLARE%: DONTCOPY
(FILEMAP (NIL)))
STOP

File diff suppressed because one or more lines are too long

Binary file not shown.

File diff suppressed because one or more lines are too long

Binary file not shown.

File diff suppressed because one or more lines are too long

Binary file not shown.

File diff suppressed because one or more lines are too long

Binary file not shown.

File diff suppressed because one or more lines are too long

Binary file not shown.

File diff suppressed because one or more lines are too long

Binary file not shown.

File diff suppressed because one or more lines are too long

Binary file not shown.

File diff suppressed because one or more lines are too long

BIN
sources/MAIKOETHER.LCOM Normal file

Binary file not shown.

File diff suppressed because one or more lines are too long

Binary file not shown.

1
sources/TCPHTE Executable file

File diff suppressed because one or more lines are too long

View File

@@ -1,23 +1,25 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "31-Dec-2000 12:38:40" {DSK}<project>medley3.5>sources>UFS.;2 69364
(FILECREATED "21-Apr-2021 11:36:54" {DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>UFS.;5 69271
changes to%: (VARS UFSCOMS)
changes to%: (FNS \UFSeol)
previous date%: "29-Mar-95 17:50:11" {DSK}<project>medley3.5>sources>UFS.;1)
previous date%: "20-Apr-2021 12:11:36"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>UFS.;4)
(* ; "
Copyright (c) 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 2000 by Venue & Xerox Corporation. All rights reserved.
Copyright (c) 1988-1995, 2000, 2021 by Venue & Xerox Corporation.
")
(PRETTYCOMPRINT UFSCOMS)
(RPAQQ UFSCOMS
(RPAQQ UFSCOMS
[(PROP (FILETYPE MAKEFILE-ENVIRONMENT)
UFS)
(DECLARE%: EVAL@COMPILE DONTEVAL@LOAD DONTCOPY (FILES (LOADCOMP)
DIRECTORY FILEIO))
(COMS (* ; "Create FDEV function.")
(INITVARS (\UFS.DEFAULT.EOLC NIL))
(COMS (* ; "Create FDEV function.")
(FNS \UFSCreateDevice \UFS.CREATE.DEVICE \UFSOpenDevice \UFSCloseDevice)
(INITVARS (\UFSdevice)
(\UFStopMonitor (CREATE.MONITORLOCK "UFSTopMonitor")))
@@ -25,15 +27,15 @@ Copyright (c) 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 2000 by Venue & Xe
(COMS (DECLARE%: DONTCOPY (EXPORT (RECORDS UFSGENFILESTATE)))
(INITRECORDS UFSGENFILESTATE)
(SYSRECORDS UFSGENFILESTATE))
(COMS (* ;
 "UNIX File System's FDEV methods.")
(COMS (* ;
 "UNIX File System's FDEV methods.")
(FNS \UFSOpenFile \UFS.OPENP \UFS.RECOGNIZE.FILE \UFS.DIRECTORY.NAME \UFSCloseFile
\UFSGetFileName \UFSDeleteFile \UFSRenameFile \UFSReadPages \UFSWritePages
\UFSTruncateFile \UFSDirectoryNameP \UFSEventFn \UFSGetFileInfo \UFS.CREATE.PROPS
\UFSSetFileInfo \UFSGenerateFiles \UFS.NEXTFILEFN \UFS.FILEINFOFN \UFS.VALID.PROPP
\UFS.REGISTER.GFS \UFS.UNREGISTER.GFS \UFS.ABORT.DIRECTORY \UFS.ABORT.CL-DIRECTORY
\UFS.CLEANUP.GFS.TABLE))
(COMS (* ; "File Name parsing")
(COMS (* ; "File Name parsing")
(FNS \UFSMakeUnixFormatName \UFSParseNameString \UFSParse-Directory \UFS.PARSE.BODY
\UFS.ADJUST.HOST \UFS.FULLNAME \UFS.ADD.HOST.FIELD \UFS.REMOVE.HOST.FIELD
\UFS.HANDLE.RELATIVEDIRECTORY)
@@ -54,22 +56,22 @@ Copyright (c) 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 2000 by Venue & Xe
\UFS.DEFAULT.DIRECTORY *DSK-UPPER-CASE-FILE-NAMES* \UFS.GFS.TABLE
*DSK-HOST-NAME* *UFS-HOST-NAME*))
(COMS
(* ;; "Change UNIX Curent Directory")
(* ;; "Change UNIX Curent Directory")
(FNS CHDIR)
(* ;; "To access UNIX special files by like {UNIX}/dev/ttya.")
(* ;; "To access UNIX special files by like {UNIX}/dev/ttya.")
(FNS \DEVICEFILE.EOSERROR)
(* ;; "flush/revalidate unvisible stream, like dribble files.")
(* ;; "flush/revalidate unvisible stream, like dribble files.")
(FNS \UNVISIBLE.PAGED.REVALIDATEFILELST \UNVISIBLE.FLUSH.OPEN.STREAMS)
(* ;; " Error handler")
(* ;; " Error handler")
(FNS \UFSError))
(COMS (* ; "File Type and EOL handling")
(COMS (* ; "File Type and EOL handling")
(FNS \UFSGetFileType \UFSSetFileType \UFSeol)
[DECLARE%: DONTEVAL@LOAD DOCOPY (VARS (DEFAULTFILETYPE 'BINARY)
(DEFAULTFILETYPELIST '((NIL . BINARY)
@@ -108,26 +110,28 @@ Copyright (c) 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 2000 by Venue & Xe
(VM . BINARY]
(GLOBALVARS DEFAULTFILETYPE DEFAULTFILETYPELIST))
(DECLARE%: EVAL@COMPILE DONTCOPY (COMS * UFSDECLS))
(COMS (* ; "Filetypepatch functions. ")
(COMS (* ; "Filetypepatch functions. ")
(FNS \UFSGetPrintFileType \UFSGetFileTypeConfirm \UFSPrintTypeMenu)
(* ; "for hardcopy")
(* ; "for hardcopy")
(FNS \UFStoOtherCopyMess \UFStoOtherRenameMess)
(* ; "for copyfile,renamefile")
(* ; "for copyfile,renamefile")
(INITVARS (FileTypeConfirmFlg T))
(GLOBALVARS FileTypeMenu FileTypeConfirmFlg))
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
(LAMA])
(PUTPROPS UFS FILETYPE :BCOMPL)
(PUTPROPS UFS FILETYPE :BCOMPL)
(PUTPROPS UFS MAKEFILE-ENVIRONMENT (:PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10))
(PUTPROPS UFS MAKEFILE-ENVIRONMENT (:PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10))
(DECLARE%: EVAL@COMPILE DONTEVAL@LOAD DONTCOPY
(FILESLOAD (LOADCOMP)
DIRECTORY FILEIO)
)
(RPAQ? \UFS.DEFAULT.EOLC NIL)
(* ; "Create FDEV function.")
@@ -154,12 +158,12 @@ Copyright (c) 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 2000 by Venue & Xe
(RPAQ? \UFSdevice )
(RPAQ? \UFStopMonitor (CREATE.MONITORLOCK "UFSTopMonitor"))
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \UFSdevice \UFStopMonitor)
)
(DECLARE%: DONTCOPY
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
(DECLARE%: DONTCOPY
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
(DATATYPE UFSGENFILESTATE (
(* ;;
@@ -171,12 +175,12 @@ Copyright (c) 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 2000 by Venue & Xe
(TOTALNUM FIXP)
DIRECTORY DEV (PROPP FLAG)
THISFILE
(ERRONO FIXP)
NAME
(LENGTH FIXP)
(WDATE FIXP)
(RDATE FIXP)
(PROTECTION FIXP)
(ERRONO FIXP)
NAME
(LENGTH FIXP)
(WDATE FIXP)
(RDATE FIXP)
(PROTECTION FIXP)
AUTHOR
(AULEN FIXP)
SUBGENERATORS (* ;
@@ -409,46 +413,65 @@ update the map") (SETQ PAGES (RESTOREMAP STREAM))) (DELETED (* ; "the file disap
(RPAQ? \UFSDefaultDelimiterChar '/)
(RPAQ? \UFSDefaultConnDir "./")
(RPAQ? \UFSDefaultConnDir "./")
(RPAQ? \UFSBeforeType '%.)
(RPAQ? \UFSBeforeVersion ';)
(RPAQ? \UFSDeviceDelimiter '})
(RPAQ? \DSK.DEFAULT.DIRECTORY "~>")
(RPAQ? \UFS.DEFAULT.DIRECTORY ".>")
(RPAQ? *DSK-UPPER-CASE-FILE-NAMES* NIL)
(RPAQ? \UFS.GFS.TABLE (HASHARRAY 20))
(RPAQ? *DSK-HOST-NAME* "{DSK}")
(RPAQ? *UFS-HOST-NAME* "{UNIX}")
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \UFSDeviceDelimiter \UFSBeforeVersion \UFSBeforeType \UFSDefaultConnDir
\UFSDefaultDelimiterChar \UFSDefaultDelimiter \DSK.DEFAULT.DIRECTORY \UFS.DEFAULT.DIRECTORY
*DSK-UPPER-CASE-FILE-NAMES* \UFS.GFS.TABLE *DSK-HOST-NAME* *UFS-HOST-NAME*)
(RPAQ? \UFSDeviceDelimiter '})
(RPAQ? \DSK.DEFAULT.DIRECTORY "~>")
(RPAQ? \UFS.DEFAULT.DIRECTORY ".>")
(RPAQ? *DSK-UPPER-CASE-FILE-NAMES* NIL)
(RPAQ? \UFS.GFS.TABLE (HASHARRAY 20))
(RPAQ? *DSK-HOST-NAME* "{DSK}")
(RPAQ? *UFS-HOST-NAME* "{UNIX}")
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \UFSDeviceDelimiter \UFSBeforeVersion \UFSBeforeType \UFSDefaultConnDir
\UFSDefaultDelimiterChar \UFSDefaultDelimiter \DSK.DEFAULT.DIRECTORY \UFS.DEFAULT.DIRECTORY
*DSK-UPPER-CASE-FILE-NAMES* \UFS.GFS.TABLE *DSK-HOST-NAME* *UFS-HOST-NAME*)
)
(* ;; "Change UNIX Curent Directory")
(DEFINEQ
(CHDIR
(LAMBDA (PATHNAME) (* ; "Edited 2-Apr-90 01:07 by nm") (* ;;; "(\CALL-C SUBR-UFS-DIRECTORYNAMEP ..) returns T(=1) or NIL.") (WITH.MONITOR \UFStopMonitor (LET ((PATH (\ADD.CONNECTED.DIR PATHNAME)) HOST) (if PATH then (SETQ HOST (U-CASE (FILENAMEFIELD PATH (QUOTE HOST)))) (if (OR (EQ HOST (QUOTE DSK)) (EQ HOST (QUOTE UNIX))) then (if (SETQ PATH (DIRECTORYNAME PATH)) then (if (\UFSCHDIR-C PATH) then (DIRECTORYNAME PATH) else (ERROR "NO-SUCH-DIRECTORY" PATHNAME)) else (ERROR "NO-SUCH-DIRECTORY" PATHNAME)) else (ERROR "Bad Host Name" HOST)) else (ERROR "NO-SUCH-DIRECTORY" PATHNAME)))))
)
)
(* ;; "To access UNIX special files by like {UNIX}/dev/ttya.")
)
(* ;; "Change UNIX Curent Directory")
(DEFINEQ
(CHDIR
(LAMBDA (PATHNAME) (* ; "Edited 2-Apr-90 01:07 by nm") (* ;;; "(\CALL-C SUBR-UFS-DIRECTORYNAMEP ..) returns T(=1) or NIL.") (WITH.MONITOR \UFStopMonitor (LET ((PATH (\ADD.CONNECTED.DIR PATHNAME)) HOST) (if PATH then (SETQ HOST (U-CASE (FILENAMEFIELD PATH (QUOTE HOST)))) (if (OR (EQ HOST (QUOTE DSK)) (EQ HOST (QUOTE UNIX))) then (if (SETQ PATH (DIRECTORYNAME PATH)) then (if (\UFSCHDIR-C PATH) then (DIRECTORYNAME PATH) else (ERROR "NO-SUCH-DIRECTORY" PATHNAME)) else (ERROR "NO-SUCH-DIRECTORY" PATHNAME)) else (ERROR "Bad Host Name" HOST)) else (ERROR "NO-SUCH-DIRECTORY" PATHNAME)))))
)
)
(* ;; "To access UNIX special files by like {UNIX}/dev/ttya.")
(DEFINEQ
(\DEVICEFILE.EOSERROR
(LAMBDA (STREAM) (* ; "Edited 3-Mar-89 15:06 by bvm") (SELECTQ (fetch (STREAM ACCESS) of STREAM) (OUTPUT (LISPERROR "END OF FILE" (fetch (STREAM FULLNAME) of STREAM) T)) (INPUT (PROG (BUF VMEMBUF DATASIZE) (OR (SETQ BUF (fetch (STREAM BUFFS) of STREAM)) (replace (STREAM BUFFS) of STREAM with (SETQ BUF (\GETMAPBUFFER)))) (SETQ VMEMBUF (fetch (BUFFER VMEMPAGE) of BUF)) (until (SETQ DATASIZE (\UFSReadPages-C (fetch (UFSSTREAM FILEID) of STREAM) 0 VMEMBUF)) do (BLOCK)) (if (EQ DATASIZE 0) then (LISPERROR "END OF FILE" (fetch (STREAM FULLNAME) of STREAM) T) (RETURN NIL)) (UNINTERRUPTABLY (replace (BUFFER FILEPAGE#) of BUF with 0) (replace (BUFFER BUFFERNEXT) of BUF with NIL) (replace (BUFFER SYSNEXT) of BUF with NIL) (replace (STREAM CBUFSIZE) of STREAM with DATASIZE) (replace (STREAM EOFFSET) of STREAM with DATASIZE) (replace (STREAM COFFSET) of STREAM with 0) (replace (STREAM CBUFPTR) of STREAM with VMEMBUF)) (RETURN T))) (SHOULDNT)))
)
)
(* ;; "flush/revalidate unvisible stream, like dribble files.")
(DEFINEQ
(\UNVISIBLE.PAGED.REVALIDATEFILELST
(LAMBDA (DEVICE) (* ; "Edited 3-Mar-89 15:33 by bvm") (* ;;; "This function is writen based on \PAGED.REVALIDATEFILELST") (* ;;; "Revalidate unvisible open files on DEVICE (a PMAP device)") (bind REASON PAGES for STREAM in (fetch (FDEV OPENFILELST) of DEVICE) when (NULL (fetch (STREAM USERVISIBLE) of STREAM)) do (if (SETQ REASON (\PAGED.REVALIDATEFILE STREAM)) then (SELECTQ REASON (CHANGED (* ; "it changed %
%
update the map") (SETQ PAGES (RESTOREMAP STREAM))) (DELETED (* ; "the file disappeared, so zap the stream") (SETQ PAGES (FORGETPAGES STREAM)) (MAPC (STREAMPROP STREAM (QUOTE AFTERCLOSE)) (FUNCTION (LAMBDA (FN) (APPLY* FN STREAM)))) (replace (STREAM ACCESS) of STREAM with NIL) (FDEVOP (QUOTE UNREGISTERFILE) DEVICE DEVICE STREAM)) (SHOULDNT)) (\PRINT-REVALIDATION-RESULT REASON STREAM))))
)
(\UNVISIBLE.FLUSH.OPEN.STREAMS
(LAMBDA (FDEV) (* ; "Edited 20-Dec-88 10:20 by Hayata") (* ;;; "This function is writen based on \FLUSH.OPEN.STREAMS") (* ;;; "flush unvisible open streams") (for STREAM in (fetch (FDEV OPENFILELST) of FDEV) bind STREAM when (AND (NULL (fetch (STREAM USERVISIBLE) of STREAM)) (DIRTYABLE STREAM)) do (FDEVOP (QUOTE FORCEOUTPUT) FDEV STREAM)))
@@ -456,124 +479,127 @@ update the map") (SETQ PAGES (RESTOREMAP STREAM))) (DELETED (* ; "the file disap
)
(* ;; "flush/revalidate unvisible stream, like dribble files.")
(* ;; " Error handler")
(DEFINEQ
(\UFSError
(LAMBDA (PATHNAME ERRNO DEV) (* ; "Edited 14-Dec-94 16:46 by jds") (* ;; "If DEV is supplied, we combine it with PATHNAME to get a real name.") (* ;; "Note that codes not explicitly listed here do not signal an error (!!). This may be reasonable for code zero (file not found), but others???") (PROG ((NO (IPLUS ERRNO 0))) (* ;; "errno is fixp cell, changed into a SMALLP using IPLUS, and residing in NO.") (COND (DEV (SETQ PATHNAME (\UFS.FULLNAME PATHNAME DEV)))) (SELECTQ NO (1 (ERROR "Not owner" PATHNAME)) (5 (* ; "I/O error") (CL:ERROR (QUOTE XCL:SIMPLE-DEVICE-ERROR) :MESSAGE PATHNAME)) (13 (* ; "Permission denied") (CL:ERROR (QUOTE XCL:FS-PROTECTION-VIOLATION) :PATHNAME PATHNAME)) (21 (ERROR "Is a directory" PATHNAME)) (23 (* ; "File table overflow") (CL:ERROR (QUOTE XCL:FILE-WONT-OPEN) :PATHNAME PATHNAME)) (24 (* ; "LISPERROR 15 is no longer supported (LISPERROR %"TOO MANY FILES OPEN%" |pathname|)") (ERROR "TOO MANY FILES OPEN" PATHNAME)) (27 (ERROR "File too large" PATHNAME)) (28 (* ; "No space left on device") (CL:ERROR (QUOTE XCL:FS-RESOURCES-EXCEEDED) :PATHNAME PATHNAME)) (29 (* ; "Illegal seek") (CL:ERROR (QUOTE XCL:SIMPLE-DEVICE-ERROR) :MESSAGE PATHNAME)) (30 (* ; "Read only file system") (CL:ERROR (QUOTE XCL:FS-PROTECTION-VIOLATION) :PATHNAME PATHNAME)) (60 (* ; "Connect request or NFS request failed") (ERROR "Connection timed out" PATHNAME)) (62 (* ; "Too many levels of symbolic link (usually a loop of links)") (ERROR "Too many levels of symbolic link in" PATHNAME)) (66 (ERROR "Directory not empty" PATHNAME)) (100 (ERROR "Connection timed out" PATHNAME)) NIL)))
(\UNVISIBLE.PAGED.REVALIDATEFILELST
(LAMBDA (DEVICE) (* ; "Edited 3-Mar-89 15:33 by bvm") (* ;;; "This function is writen based on \PAGED.REVALIDATEFILELST") (* ;;; "Revalidate unvisible open files on DEVICE (a PMAP device)") (bind REASON PAGES for STREAM in (fetch (FDEV OPENFILELST) of DEVICE) when (NULL (fetch (STREAM USERVISIBLE) of STREAM)) do (if (SETQ REASON (\PAGED.REVALIDATEFILE STREAM)) then (SELECTQ REASON (CHANGED (* ; "it changed %
%
update the map") (SETQ PAGES (RESTOREMAP STREAM))) (DELETED (* ; "the file disappeared, so zap the stream") (SETQ PAGES (FORGETPAGES STREAM)) (MAPC (STREAMPROP STREAM (QUOTE AFTERCLOSE)) (FUNCTION (LAMBDA (FN) (APPLY* FN STREAM)))) (replace (STREAM ACCESS) of STREAM with NIL) (FDEVOP (QUOTE UNREGISTERFILE) DEVICE DEVICE STREAM)) (SHOULDNT)) (\PRINT-REVALIDATION-RESULT REASON STREAM))))
)
(\UNVISIBLE.FLUSH.OPEN.STREAMS
(LAMBDA (FDEV) (* ; "Edited 20-Dec-88 10:20 by Hayata") (* ;;; "This function is writen based on \FLUSH.OPEN.STREAMS") (* ;;; "flush unvisible open streams") (for STREAM in (fetch (FDEV OPENFILELST) of FDEV) bind STREAM when (AND (NULL (fetch (STREAM USERVISIBLE) of STREAM)) (DIRTYABLE STREAM)) do (FDEVOP (QUOTE FORCEOUTPUT) FDEV STREAM)))
)
)
)
(* ; "File Type and EOL handling")
(DEFINEQ
(\UFSGetFileType
(LAMBDA (FILENAME) (* ; "Edited 19-May-91 11:18 by jds") (LET ((TYPE (UNPACKFILENAME.STRING FILENAME (QUOTE EXTENSION)))) (SETQ TYPE (MKATOM (U-CASE (COND ((AND (EQ (NCHARS TYPE) 0) (* ; "Handle null extension specially") (CDR (CL:ASSOC NIL DEFAULTFILETYPELIST)))) ((CDR (CL:ASSOC TYPE DEFAULTFILETYPELIST :TEST (QUOTE STRING-EQUAL)))) (T DEFAULTFILETYPE))))) (* ; "(SELECTQ TYPE ((TEXT BINARY) TYPE) (CL:ERROR %"Invalid File Type ~A for ~A%" TYPE FILENAME))") (* ;; "TYPE used to be constraied to be TEXT or BINARY, which caused some older user code to tail. AR 11373") TYPE))
(* ;; " Error handler")
(DEFINEQ
(\UFSError
)
(\UFSSetFileType
(LAMBDA (FILENAME TYPE) (* ; "Edited 6-Jun-88 13:48 by HH") (LET ((EXTENSION (MKATOM (U-CASE (LISTGET (\UFSParseNameString FILENAME) (QUOTE EXTENSION)))))) (SETQ TYPE (MKATOM (U-CASE TYPE))) (for PAIR in DEFAULTFILETYPELIST bind PAIR finally (RETURN (EQ TYPE (MKATOM (U-CASE DEFAULTFILETYPE)))) do (if (EQUAL EXTENSION (MKATOM (U-CASE (CAR PAIR)))) then (RETURN (EQ TYPE (MKATOM (U-CASE (CDR PAIR)))))))))
)
(\UFSeol
[LAMBDA (FILENAME TYPE RECOG) (* ; "Edited 21-Apr-2021 11:36 by rmk:")
(if (AND [SETQ TYPE (SELECTQ (CADR TYPE)
)
)
(* ; "File Type and EOL handling")
(TEXT 'TEXT)
(NIL NIL)
(PROGN (* ; "Anything else reduces to binary")
'BINARY]
(EQ RECOG 'NEW)
(NEQ TYPE (\UFSGetFileType FILENAME)))
then (* ;
 "Warn user that TYPE will not be properly inferred when we next read this file")
(\UFSGetFileType
(LAMBDA (FILENAME) (* ; "Edited 19-May-91 11:18 by jds") (LET ((TYPE (UNPACKFILENAME.STRING FILENAME (QUOTE EXTENSION)))) (SETQ TYPE (MKATOM (U-CASE (COND ((AND (EQ (NCHARS TYPE) 0) (* ; "Handle null extension specially") (CDR (CL:ASSOC NIL DEFAULTFILETYPELIST)))) ((CDR (CL:ASSOC TYPE DEFAULTFILETYPELIST :TEST (QUOTE STRING-EQUAL)))) (T DEFAULTFILETYPE))))) (* ; "(SELECTQ TYPE ((TEXT BINARY) TYPE) (CL:ERROR %"Invalid File Type ~A for ~A%" TYPE FILENAME))") (* ;; "TYPE used to be constraied to be TEXT or BINARY, which caused some older user code to tail. AR 11373") TYPE))
(PRINTOUT PROMPTWINDOW T "Warning: creating " TYPE " file, but name '"
(\UFS.PARSE.BODY (\UFSParseNameString FILENAME))
"' does not have a " TYPE " extension."))
(SELECTQ (OR TYPE (\UFSGetFileType FILENAME))
(\UFSSetFileType
(LAMBDA (FILENAME TYPE) (* ; "Edited 6-Jun-88 13:48 by HH") (LET ((EXTENSION (MKATOM (U-CASE (LISTGET (\UFSParseNameString FILENAME) (QUOTE EXTENSION)))))) (SETQ TYPE (MKATOM (U-CASE TYPE))) (for PAIR in DEFAULTFILETYPELIST bind PAIR finally (RETURN (EQ TYPE (MKATOM (U-CASE DEFAULTFILETYPE)))) do (if (EQUAL EXTENSION (MKATOM (U-CASE (CAR PAIR)))) then (RETURN (EQ TYPE (MKATOM (U-CASE (CDR PAIR)))))))))
)
(TEXT LF.EOLC)
(PROGN (* ;
 "BINARY or unknown. RMK: Switch default to LF")
(OR \UFS.DEFAULT.EOLC LF.EOLC])
)
(DECLARE%: DONTEVAL@LOAD DOCOPY
(LAMBDA (FILENAME TYPE RECOG) (* ; "Edited 27-Feb-89 16:21 by bvm") (if (AND (SETQ TYPE (SELECTQ (CADR TYPE) (TEXT (QUOTE TEXT)) (NIL NIL) (PROGN (* ; "Anything else reduces to binary") (QUOTE BINARY)))) (EQ RECOG (QUOTE NEW)) (NEQ TYPE (\UFSGetFileType FILENAME))) then (* ; "Warn user that TYPE will not be properly inferred when we next read this file") (PRINTOUT PROMPTWINDOW T "Warning: creating " TYPE " file, but name '" (\UFS.PARSE.BODY (\UFSParseNameString FILENAME)) "' does not have a " TYPE " extension.")) (SELECTQ (OR TYPE (\UFSGetFileType FILENAME)) (TEXT LF.EOLC) (PROGN (* ; "BINARY or unknown") CR.EOLC)))
)
(RPAQQ DEFAULTFILETYPE BINARY)
(DECLARE%: DONTEVAL@LOAD DOCOPY
(RPAQQ DEFAULTFILETYPE BINARY)
(RPAQQ DEFAULTFILETYPELIST ((NIL . BINARY)
(C . TEXT)
(H . TEXT)
(EL . TEXT)
(IM . TEXT)
(LISP . TEXT)
(LSP . TEXT)
(RPAQQ DEFAULTFILETYPELIST
((NIL . BINARY)
(C . TEXT)
(H . TEXT)
(EL . TEXT)
(LCOM . BINARY)
(DFASL . BINARY)
(DCOM . BINARY)
(SKETCH . BINARY)
(TEDIT . BINARY)
(TED . BINARY)
(DISPLAYFONT . BINARY)
(AC . BINARY)
(WD . BINARY)
(IM . TEXT)
(LISP . TEXT)
(LSP . TEXT)
(O . BINARY)
(OUT . BINARY)
(INTERPRESS . BINARY)
(PRESS . BINARY)
(PSCFONT . BINARY)
(RST . BINARY)
(BIN . BINARY)
(LCOM . BINARY)
(DFASL . BINARY)
(SYSOUT . BINARY)
(SYSOUT.Z . BINARY)
(TAR . BINARY)
(INDEX . BINARY)
(HASH . BINARY)
(DCOM . BINARY)
(SKETCH . BINARY)
(TEDIT . BINARY)
(TED . BINARY)
(DISPLAYFONT . BINARY)
(AC . BINARY)
(WD . BINARY)
(IP . BINARY)
(INTERPRESS . BINARY)
(PRESS . BINARY)
(PSCFONT . BINARY)
(RST . BINARY)
(Z . BINARY)
(BIN . BINARY)
(MAIL . BINARY)
(SYSOUT . BINARY)
(SYSOUT.Z . BINARY)
(TAR . BINARY)
(INDEX . BINARY)
(VM . BINARY)))
)
(HASH . BINARY)
(NOTEFILE . BINARY)
(Z . BINARY)
(VIRTUALMEM . BINARY)
(VM . BINARY)))
)
(GLOBALVARS DEFAULTFILETYPE DEFAULTFILETYPELIST)
)
(DECLARE%: EVAL@COMPILE DONTCOPY
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(RPAQQ UFSDECLS ((MACROS \UFS.FULLNAME.M \UFSGetMonitor \UFS.DEFAULT.DIR \UFS.FILE.RECOGNIZER
\UFS.DIRECTORY.RECOGNIZER DSKP)
(RECORDS UFSSTREAM NAME&ALLPROPS)
(* ;; "File attribute code. For interface between Cfunc and LISPfunc.")
(GLOBALVARS DEFAULTFILETYPE DEFAULTFILETYPELIST)
)
(DECLARE%: EVAL@COMPILE DONTCOPY
(CONSTANTS (ATTR-LENGTH 1)
(ATTR-WDATE 2)
(ATTR-RDATE 3)
(RPAQQ UFSDECLS
((MACROS \UFS.FULLNAME.M \UFSGetMonitor \UFS.DEFAULT.DIR \UFS.FILE.RECOGNIZER
\UFS.DIRECTORY.RECOGNIZER DSKP)
(RECORDS UFSSTREAM NAME&ALLPROPS)
(* ;; "File attribute code. For interface between Cfunc and LISPfunc.")
(CONSTANTS (ATTR-LENGTH 1)
(ATTR-WDATE 2)
(ATTR-RDATE 3)
(ATTR-CDATE 4)
(ATTR-AUTHOR 5)
(ATTR-PROTECTION 6)
(ATTR-EOL 7)
(ATTR-ALL 8))
(* ;; "File RECOG code. For interface between Cfunc and LISPfunc.")
(ATTR-ALL 8))
(CONSTANTS (RECOG-OLD 0)
(RECOG-OLDEST 1)
(RECOG-NEW 2)
(RECOG-NEW-OLD 3)
(RECOG-OTHER 4)
(RECOG-OLDEST 1)
(RECOG-NON 5))
(* ;; "File ACCESS code. For interface between Cfunc and LISPfunc.")
(RECOG-OTHER 4)
(CONSTANTS (ACCESS-INPUT 0)
(ACCESS-OUTPUT 1)
(* ;; "File ACCESS code. For interface between Cfunc and LISPfunc.")
(ACCESS-BOTH 2)
(ACCESS-APPEND 3)
(ACCESS-OTHER 4))
(* ;; "\UFSGetFileInfo allocate this size buffer to keep the user name.")
@@ -747,25 +773,26 @@ update the map") (SETQ PAGES (RESTOREMAP STREAM))) (DELETED (* ; "the file disap
(CONSTANTS (ACCESS-INPUT 0)
(ACCESS-OUTPUT 1)
(ACCESS-BOTH 2)
(ACCESS-APPEND 3)
(ACCESS-OUTPUT 1)
(ACCESS-BOTH 2)
(ACCESS-APPEND 3)
(ACCESS-OTHER 4))
)
(* ;; "\UFSGetFileInfo allocate this size buffer to keep the user name.")
(DECLARE%: EVAL@COMPILE
(RPAQQ MAX-UNAME-LEN 512)
(CONSTANTS (MAX-UNAME-LEN 512))
)
(ACCESS-OTHER 4))
)
(* ;; "\UFSGetFileInfo allocate this size buffer to keep the user name.")
(DECLARE%: EVAL@COMPILE
(RPAQQ MAX-UNAME-LEN 512)
(CONSTANTS (MAX-UNAME-LEN 512))
)
(* ;; "\UFSGetFileName allocate this size buffer to keep the path name.")
(DECLARE%: EVAL@COMPILE

Binary file not shown.

View File

@@ -1,8 +1,10 @@
/* This file written from LLSUBRS on 7-Nov-88 14:41:04 */
/* This file written from LLSUBRS on 17-Mar-2021 11:14:28 */
/* Do not edit this file! Instead, edit the list \initsubrs */
/* on the lisp file LLSUBRS and then call WRITECALLSUBRS to */
/* generate a new version. */
#define sb_DUMMY_135Q 0135
#ifndef SUBRS_H
#define SUBRS_H 1
#define sb_YIELD 0322
#define sb_BACKGROUNDSUBR 06
#define sb_CHECKBCPLPASSWORD 07
#define sb_DISKPARTITION 010
@@ -22,20 +24,14 @@
#define sb_CONTEXTSWITCH 026
#define sb_COPYSYS0SUBR 027
#define sb_WRITEMAP 030
#define sb_UFS_OPENFILE 040
#define sb_UFS_CLOSEFILE 041
#define sb_UFS_GETFILENAME 042
#define sb_UFS_DELETEFILE 043
#define sb_UFS_RENAMEFILE 044
#define sb_UFS_READPAGES 045
#define sb_UFS_WRITEPAGES 046
#define sb_UFS_GETSIZE 047
#define sb_UFS_READDIR 050
#define sb_COM_READPAGES 045
#define sb_COM_WRITEPAGES 046
#define sb_COM_TRUNCATEFILE 047
#define sb_UFS_DIRECTORYNAMEP 051
#define sb_UFS_GETFILEINFO 052
#define sb_UFS_DIRSIZE 053
#define sb_UFS_CHANGEDIR 054
#define sb_UFS_GETFREEBLOCK 055
#define sb_COM_GETFREEBLOCK 055
#define sb_SETUNIXTIME 060
#define sb_GETUNIXTIME 061
#define sb_COPYTIMESTATS 062
@@ -46,6 +42,7 @@
#define sb_CHECK_SUM 067
#define sb_ETHER_SUSPEND 070
#define sb_ETHER_RESUME 071
#define sb_ETHER_AVAILABLE 072
#define sb_ETHER_RESET 073
#define sb_ETHER_GET 074
#define sb_ETHER_SEND 075
@@ -58,34 +55,96 @@
#define sb_DSP_SCREENHEIGHT 0104
#define sb_BITBLTSUB 0105
#define sb_BLTCHAR 0106
#define sb_TEDIT_BLTCHAR 0107
#define sb_BITBLT_BITMAP 0110
#define sb_BLTSHADE_BITMAP 0111
#define sb_RS232C_CMD 0112
#define sb_RS232C_READ_INIT 0113
#define sb_RS232C_WRITE 0114
#define sb_KEYBOARDBEEP 0120
#define sb_KEYBOARDMAP 0121
#define sb_KEYBOARDSTATE 0122
#define sb_VMEMSAVE 0131
#define sb_LISP_FINISH 0132
#define sb_NEWPAGE 0133
#define sb_DORECLAIM 0134
#define sb_DUMMY_135Q 0135
#define sb_NATIVE_MEMORY_REFERENCE 0136
#define sb_OLD_COMPILE_LOAD_NATIVE 0137
#define sb_UFS_SETFILEINFO 0146
#define sb_DSK_SETFILEINFO 0147
#define sb_DSK_OPENFILE 0150
#define sb_DSK_CLOSEFILE 0151
#define sb_DISABLEGC 0140
#define sb_COM_SETFILEINFO 0147
#define sb_COM_OPENFILE 0150
#define sb_COM_CLOSEFILE 0151
#define sb_DSK_GETFILENAME 0152
#define sb_DSK_DELETEFILE 0153
#define sb_DSK_RENAMEFILE 0154
#define sb_DSK_READDIR 0160
#define sb_COM_NEXT_FILE 0156
#define sb_COM_FINISH_FINFO 0157
#define sb_COM_GEN_FILES 0160
#define sb_DSK_DIRECTORYNAMEP 0161
#define sb_DSK_GETFILEINFO 0162
#define sb_DSK_DIRSIZE 0163
#define sb_DSK_CHANGEDIR 0164
#define sb_COM_GETFILEINFO 0162
#define sb_COM_CHANGEDIR 0164
#define sb_UNIX_HANDLECOMM 0165
#define sb_RPC_CALL 0167
#define sb_MESSAGE_READP 0170
#define sb_MESSAGE_READ 0171
#define sb_MONITOR_CONTROL 0200
#define sb_GET_NATIVE_ADDR_FROM_LISP_PTR 0203
#define sb_GET_LISP_PTR_FROM_NATIVE_ADDR 0204
#define sb_LOAD_NATIVE_FILE 0205
#define sb_SUSPEND_LISP 0206
#define sb_NEW_BLTCHAR 0207
#define sb_COLOR_INIT 0210
#define sb_COLOR_SCREENMODE 0211
#define sb_COLOR_MAP 0212
#define sb_COLOR_BASE 0213
#define sb_C_SlowBltChar 0214
#define sb_UNCOLORIZE_BITMAP 0215
#define sb_COLORIZE_BITMAP 0216
#define sb_COLOR_8BPPDRAWLINE 0217
#define sb_TCP_OP 0220
#define sb_WITH_SYMBOL 0221
#define sb_CAUSE_INTERRUPT 0222
#define sb_OPEN_SOCKET 0240
#define sb_CLOSE_SOCKET 0241
#define sb_READ_SOCKET 0242
#define sb_WRITE_SOCKET 0243
#define sb_CALL_C_FUNCTION 0247
#define sb_DLD_LINK 0250
#define sb_DLD_UNLINK_BY_FILE 0251
#define sb_DLD_UNLINK_BY_SYMBOL 0252
#define sb_DLD_GET_SYMBOL 0253
#define sb_DLD_GET_FUNC 0254
#define sb_DLD_FUNCTION_EXECUTABLE_P 0255
#define sb_DLD_LIST_UNDEFINED_SYMBOLS 0256
#define sb_C_MALLOC 0257
#define sb_C_FREE 0260
#define sb_C_PUTBASEBYTE 0261
#define sb_C_GETBASEBYTE 0262
#define sb_CHAR_OPENFILE 0310
#define sb_CHAR_BIN 0311
#define sb_CHAR_BOUT 0312
#define sb_CHAR_IOCTL 0313
#define sb_CHAR_CLOSEFILE 0314
#define sb_CHAR_EOFP 0315
#define sb_CHAR_READP 0316
#define sb_CHAR_BINS 0317
#define sb_CHAR_BOUTS 0320
#define sb_CHAR_FILLBUFFER 0321
/* MISCN opcodes */
#define miscn_USER_SUBR 00
#define miscn_VALUES 01
#define miscn_SXHASH 02
#define miscn_EQLHASHBITSFN 03
#define miscn_STRINGHASHBITS 04
#define miscn_STRING_EQUAL_HASHBITS 05
#define miscn_VALUES_LIST 06
#define miscn_LCFetchMethod 07
#define miscn_LCFetchMethodOrHelp 010
#define miscn_LCFindVarIndex 011
#define miscn_LCGetIVValue 012
#define miscn_LCPutIVValue 013
/* Assigned USER SUBR numbers */
#define user_subr_DUMMY 012
#define user_subr_SAMPLE_USER_SUBR 00
#endif