Compare commits
17 Commits
medley-260
...
nhb-fix-et
| Author | SHA1 | Date | |
|---|---|---|---|
|
c160b0af15 | ||
|
13eb940538 | ||
|
|
3dc2bba019 | ||
|
322b2e0fbe | ||
|
a24a4dffc2 | ||
|
|
95e08680b8 | ||
|
|
7a7fca0bcf | ||
|
|
9e4d37efd7 | ||
|
b8c0c594a9 | ||
|
|
d9f1a78f47 | ||
|
|
d79f1ae819 | ||
|
|
b0f92834e2 | ||
|
|
b45dea97c7 | ||
|
|
1bf3f50d98 | ||
|
|
09b6b1e854 | ||
|
|
6e00dcf458 | ||
|
|
16fa8c6a24 |
@@ -1,12 +1,14 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
|
||||
|
||||
(FILECREATED "22-Feb-2026 14:15:31" |{WMEDLEY}<internal>loadups>LOADUP-LISP.;27| 7420
|
||||
(FILECREATED "26-Mar-2026 18:38:22"
|
||||
|{DSK}<Users>briggs>Projects>medley>internal>loadups>LOADUP-LISP.;14| 7604
|
||||
|
||||
:EDIT-BY |rmk|
|
||||
:EDIT-BY "briggs"
|
||||
|
||||
:CHANGES-TO (FNS LOADUP-LISP)
|
||||
|
||||
:PREVIOUS-DATE "22-Feb-2026 09:49:23" |{WMEDLEY}<internal>loadups>LOADUP-LISP.;26|)
|
||||
:PREVIOUS-DATE "22-Feb-2026 14:15:31"
|
||||
|{DSK}<Users>briggs>Projects>medley>internal>loadups>LOADUP-LISP.;13|)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT LOADUP-LISPCOMS)
|
||||
@@ -19,7 +21,8 @@
|
||||
(DEFINEQ
|
||||
|
||||
(LOADUP-LISP
|
||||
(LAMBDA (DRIBBLEFILE) (* \; "Edited 22-Feb-2026 14:15 by rmk")
|
||||
(LAMBDA (DRIBBLEFILE) (* \; "Edited 26-Mar-2026 18:38 by briggs")
|
||||
(* \; "Edited 22-Feb-2026 14:15 by rmk")
|
||||
(* \; "Edited 28-Jan-2026 14:30 by lmm")
|
||||
(* \; "Edited 27-Dec-2025 15:02 by rmk")
|
||||
(* \; "Edited 16-Oct-2025 16:55 by rmk")
|
||||
@@ -135,6 +138,7 @@
|
||||
|
||||
(LOADUP '(PUP 10MBDRIVER LEAF LLETHER DPUPFTP LOCALFILE DSKDISPLAY COURIER LLNS TRSERVER SPP
|
||||
NSPRINT AUTHENTICATION BSP CLEARINGHOUSE NSFILING MAIKOETHER))
|
||||
(RESTART.ETHER)
|
||||
(DRIBBLE)
|
||||
(SETQ MAKESYSNAME :MEDLEY)))
|
||||
)
|
||||
@@ -147,5 +151,5 @@
|
||||
(GLOBALVARS MAKESYSFILENAME MEDLEY-INIT-VARS MEDLEYDIR SYSTEMINITVARS USERRECLST)
|
||||
)
|
||||
(DECLARE\: DONTCOPY
|
||||
(FILEMAP (NIL (640 7214 (LOADUP-LISP 650 . 7212)))))
|
||||
(FILEMAP (NIL (695 7398 (LOADUP-LISP 705 . 7396)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -111,11 +111,11 @@ output directory called \f[I]gitinfo\f[R] which contains the git commit,
|
||||
git branch and git status information for the directory at the time the
|
||||
loadup is run.
|
||||
.PP
|
||||
Only one instance (per <MEDLEIDIR>) of loadup can be run at a time.
|
||||
Only one instance (per <MEDLEYDIR>) of loadup can be run at a time.
|
||||
There is lock file to prevent simultaneous loadups in the work directory
|
||||
(named \f[B]\f[BI]lock\f[B]\f[R]) that can be manually removed.
|
||||
The lock can also be automatically overridden (see the \[en]override
|
||||
flag below).
|
||||
The lock can also be automatically overridden (see the --override flag
|
||||
below).
|
||||
Alternatively, if a lock is encountered at run time, the user will be
|
||||
asked to choose whether to override or simply exit the loadup.
|
||||
.PP
|
||||
@@ -130,7 +130,7 @@ But Medley can be installed in multiple places on any given machine and
|
||||
hence MEDLEYDIR is computed on each invocation of loadup.
|
||||
.SH OPTIONS
|
||||
.TP
|
||||
\f[B]-z [+], --man [+], -man [+], -h [+], \[en]help [+]\f[R]
|
||||
\f[B]-z [+], --man [+], -man [+], -h [+], --help [+]\f[R]
|
||||
Print this manual page on the screen.
|
||||
If the \f[B]+\f[R] parameter is specified, then no pager is used when
|
||||
displaying the man page.
|
||||
@@ -138,7 +138,7 @@ displaying the man page.
|
||||
\f[B]-t STAGE, --target STAGE, -target STAGE\f[R]
|
||||
Run the sequential loadup procedure until the STAGE is complete,
|
||||
starting from the files created by the previously run STAGE specified in
|
||||
the \[en]start option.
|
||||
the --start option.
|
||||
.RS
|
||||
.PP
|
||||
STAGE can be one of the following:
|
||||
@@ -175,7 +175,7 @@ Full.sysout is copied into the loadups directory.
|
||||
.RS
|
||||
.PP
|
||||
a, apps, 5: Run the loadup sequence through Stage 5 (apps.sysout).
|
||||
Also run the Aux stage as if \[en]aux option had been specified.
|
||||
Also run the Aux stage as if --aux option had been specified.
|
||||
Apps.sysout and the Aux files are copied into the loadups directory.
|
||||
.RE
|
||||
.RE
|
||||
@@ -185,7 +185,7 @@ Apps.sysout and the Aux files are copied into the loadups directory.
|
||||
a-, apps-, 5-: Run the loadup sequence through Stage 5 (apps.sysout).
|
||||
The Aux stage is not run unless otherwise specified.
|
||||
Apps.sysout is copied into the loadups directory.
|
||||
Also run the Aux stage as if \[en]aux option had been specified.
|
||||
Also run the Aux stage as if --aux option had been specified.
|
||||
.RE
|
||||
.RE
|
||||
.TP
|
||||
@@ -245,22 +245,22 @@ If this stage complete successfully, these files are copied into
|
||||
loadups.
|
||||
.TP
|
||||
\f[B]-i, --init, -init, -1\f[R]
|
||||
Synonym for \[lq]\[en]target init\[rq]
|
||||
Synonym for \[lq]--target init\[rq]
|
||||
.TP
|
||||
\f[B]-m, --mid, -mid, -2\f[R]
|
||||
Synonym for \[lq]\[en]target mid\[rq]
|
||||
Synonym for \[lq]--target mid\[rq]
|
||||
.TP
|
||||
\f[B]-l, --lisp, -lisp, -3\f[R]
|
||||
Synonym for \[lq]\[en]target lisp\[rq]
|
||||
Synonym for \[lq]--target lisp\[rq]
|
||||
.TP
|
||||
\f[B]-f, --full. -full, -4\f[R]
|
||||
Synonym for \[lq]\[en]target full\[rq]
|
||||
Synonym for \[lq]--target full\[rq]
|
||||
.TP
|
||||
\f[B]-a, --apps, -apps, -5\f[R]
|
||||
Synonym for \[lq]\[en]target apps\[rq]
|
||||
Synonym for \[lq]--target apps\[rq]
|
||||
.TP
|
||||
\f[B]-a-, --apps-, -apps-, -5-\f[R]
|
||||
Synonym for \[lq]\[en]target apps\[rq]
|
||||
Synonym for \[lq]--target apps\[rq]
|
||||
.TP
|
||||
\f[B]-ov, --override, -override\f[R]
|
||||
Automatically override the lock that prevents two loadups from running
|
||||
@@ -300,14 +300,14 @@ contained in the working directory.
|
||||
If the \f[B]+\f[R] parameter is used, then instead of deleting just the
|
||||
versioned files, all files and subdirectories are deleted except for
|
||||
those contained in the working directory.
|
||||
If \f[B]+\f[R] is used and there is no working directory and
|
||||
\f[I]\[en]tag TAG\f[R] is also specified, then the tagged loadups
|
||||
directory (<MEDLEYDIR>/loadups/tagged/TAG) is also deleted.
|
||||
If \f[B]+\f[R] is used and there is no working directory and \f[I]--tag
|
||||
TAG\f[R] is also specified, then the tagged loadups directory
|
||||
(<MEDLEYDIR>/loadups/tagged/TAG) is also deleted.
|
||||
.TP
|
||||
\f[B]-th [+], --thin [+], -thin [+]\f[R]
|
||||
Equivalent to specifying both -tw [+] and -tl [+].
|
||||
If \f[I]\[en]tag TAG\f[R] is also specified and the \f[B]+\f[R]
|
||||
parameter is used here, then the tagged loadups directory
|
||||
If \f[I]--tag TAG\f[R] is also specified and the \f[B]+\f[R] parameter
|
||||
is used here, then the tagged loadups directory
|
||||
(<MEDLEYDIR>/loadups/tagged/TAG) is removed.
|
||||
.TP
|
||||
\f[B]-d DIR, --maikodir DIR, -maikodir DIR\f[R]
|
||||
@@ -328,38 +328,36 @@ commonly used in running Medley in the absence of an Xwindows server.
|
||||
.PP
|
||||
The defaults for the Options context-dependent and somewhat complicated
|
||||
due to the goal of maintaining compatibility with legacy loadup scripts.
|
||||
All of the following defaults rules hold independent of the
|
||||
\[en]maikodir (-d) option.
|
||||
All of the following defaults rules hold independent of the --maikodir
|
||||
(-d) option.
|
||||
.IP "1." 3
|
||||
If none of \[en]target, \[en]start, \[en]aux, and \[en]db are specified,
|
||||
then:
|
||||
If none of --target, --start, --aux, and --db are specified, then:
|
||||
.RS
|
||||
.PP
|
||||
1A.
|
||||
If neither \[en]thinw nor \[en]thinl are specified, the options default
|
||||
to:
|
||||
If neither --thinw nor --thinl are specified, the options default to:
|
||||
.RE
|
||||
.RS
|
||||
.RS
|
||||
.PP
|
||||
\f[B]\[en]target full \[en]start 0 \[en]aux\f[R]
|
||||
\f[B]--target full --start 0 --aux\f[R]
|
||||
.RE
|
||||
.RE
|
||||
.RS
|
||||
.PP
|
||||
1B.
|
||||
If either \[en]thinw or \[en]thinl are specified, no loadups are run.
|
||||
If either --thinw or --thinl are specified, no loadups are run.
|
||||
.RE
|
||||
.IP "2." 3
|
||||
If neither \[en]start nor \[en]target are specified but either -aux or
|
||||
-db or both are, then \[en]start defaults to \f[I]full\f[R] and
|
||||
\[en]target is irrelevant.
|
||||
If neither --start nor --target are specified but either -aux or -db or
|
||||
both are, then --start defaults to \f[I]full\f[R] and --target is
|
||||
irrelevant.
|
||||
.IP "3." 3
|
||||
If \[en]start is specified and \[en]target is not, then \[en]target
|
||||
defaults to \f[I]full\f[R]
|
||||
If --start is specified and --target is not, then --target defaults to
|
||||
\f[I]full\f[R]
|
||||
.IP "4." 3
|
||||
If \[en]target is specified and \[en]start is not, then \[en]start
|
||||
defaults to \f[I]0\f[R]
|
||||
If --target is specified and --start is not, then --start defaults to
|
||||
\f[I]0\f[R]
|
||||
.SH EXAMPLES
|
||||
.PP
|
||||
\f[B]./loadup -full -s lisp\f[R] : run loadup thru Stage 4 (full.sysout)
|
||||
@@ -368,14 +366,14 @@ starting from existing Stage 3 outputs (lisp.sysout).
|
||||
\f[B]./loadup --target full --start lisp\f[R] : run loadup thru Stage 4
|
||||
(full.sysout) starting from existing Stage 3 outputs (lisp.sysout).
|
||||
.PP
|
||||
\f[B]./loadup -5 \[en]aux\f[R] : run loadup from the beginning thru
|
||||
Stage 5 (apps.sysout) then run the Aux \[lq]stage\[rq] to create
|
||||
\f[B]./loadup -5 --aux\f[R] : run loadup from the beginning thru Stage 5
|
||||
(apps.sysout) then run the Aux \[lq]stage\[rq] to create
|
||||
\f[I]whereis.hash\f[R] and \f[I]exports.all\f[R]
|
||||
.PP
|
||||
\f[B]./loadup -db\f[R] : just run the DB \[lq]stage\[rq] starting from
|
||||
an existing full.sysout; do not run any of the sequential stages.
|
||||
.PP
|
||||
\f[B]./loadup \[en]maikodir \[ti]/il/newmaiko\f[R] : run loadup sequence
|
||||
\f[B]./loadup --maikodir \[ti]/il/newmaiko\f[R] : run loadup sequence
|
||||
from beginning to full plus the loadup Aux stage, while using
|
||||
\f[I]\[ti]/il/newmaiko\f[R] as the location for the lde executables when
|
||||
running Medley.
|
||||
|
||||
Binary file not shown.
@@ -52,7 +52,7 @@ Loadup does all of its work in a work directory (\<MEDLEYDIR>/loadups/build). T
|
||||
|
||||
If \<MEDLEYDIR> is a git directory, then a file is created in the loadups output directory called *gitinfo* which contains the git commit, git branch and git status information for the directory at the time the loadup is run.
|
||||
|
||||
Only one instance (per \<MEDLEIDIR>) of loadup can be run at a time. There is lock file to prevent simultaneous loadups in the work directory (named ***lock***) that can be manually removed. The lock can also be automatically overridden (see the --override flag below). Alternatively, if a lock is encountered at run time, the user will be asked to choose whether to override or simply exit the loadup.
|
||||
Only one instance (per \<MEDLEYDIR>) of loadup can be run at a time. There is lock file to prevent simultaneous loadups in the work directory (named ***lock***) that can be manually removed. The lock can also be automatically overridden (see the \-\-override flag below). Alternatively, if a lock is encountered at run time, the user will be asked to choose whether to override or simply exit the loadup.
|
||||
|
||||
Note: **MEDLEYDIR** is an environment variable set by the loadup script. It is set to the top level directory of the Medley installation that contains the specific loadup script that
|
||||
is invoked after all symbolic links are resolved. In the standard global installation this will
|
||||
@@ -61,12 +61,12 @@ hence MEDLEYDIR is computed on each invocation of loadup.
|
||||
|
||||
OPTIONS
|
||||
=======
|
||||
**-z [+], \-\-man [+], \-man [+], -h [+], --help [+]**
|
||||
**-z [+], \-\-man [+], \-man [+], -h [+], \-\-help [+]**
|
||||
: Print this manual page on the screen. If the **+** parameter is specified, then no pager is used when
|
||||
displaying the man page.
|
||||
|
||||
**-t STAGE, \-\-target STAGE, -target STAGE**
|
||||
: Run the sequential loadup procedure until the STAGE is complete, starting from the files created by the previously run STAGE specified in the --start option.
|
||||
: Run the sequential loadup procedure until the STAGE is complete, starting from the files created by the previously run STAGE specified in the \-\-start option.
|
||||
|
||||
>STAGE can be one of the following:
|
||||
|
||||
@@ -78,9 +78,9 @@ displaying the man page.
|
||||
|
||||
>>f, full, 4: Run the loadup sequence through Stage 4 (full.sysout). Full.sysout is copied into the loadups directory.
|
||||
|
||||
>>a, apps, 5: Run the loadup sequence through Stage 5 (apps.sysout). Also run the Aux stage as if --aux option had been specified. Apps.sysout and the Aux files are copied into the loadups directory.
|
||||
>>a, apps, 5: Run the loadup sequence through Stage 5 (apps.sysout). Also run the Aux stage as if \-\-aux option had been specified. Apps.sysout and the Aux files are copied into the loadups directory.
|
||||
|
||||
>>a-, apps-, 5-: Run the loadup sequence through Stage 5 (apps.sysout). The Aux stage is not run unless otherwise specified. Apps.sysout is copied into the loadups directory. Also run the Aux stage as if --aux option had been specified.
|
||||
>>a-, apps-, 5-: Run the loadup sequence through Stage 5 (apps.sysout). The Aux stage is not run unless otherwise specified. Apps.sysout is copied into the loadups directory. Also run the Aux stage as if \-\-aux option had been specified.
|
||||
|
||||
|
||||
**-s STAGE \-\-start STAGE, -start STAGE**
|
||||
@@ -105,22 +105,22 @@ displaying the man page.
|
||||
: Run the DB loadup stage, creating the *fuller.database* file. If this stage complete successfully, these files are copied into loadups.
|
||||
|
||||
**-i, \-\-init, -init, -1**
|
||||
: Synonym for "--target init"
|
||||
: Synonym for "\-\-target init"
|
||||
|
||||
**-m, \-\-mid, -mid, -2**
|
||||
: Synonym for "--target mid"
|
||||
: Synonym for "\-\-target mid"
|
||||
|
||||
**-l, \-\-lisp, -lisp, -3**
|
||||
: Synonym for "--target lisp"
|
||||
: Synonym for "\-\-target lisp"
|
||||
|
||||
**-f, \-\-full. -full, -4**
|
||||
: Synonym for "--target full"
|
||||
: Synonym for "\-\-target full"
|
||||
|
||||
**-a, \-\-apps, -apps, -5**
|
||||
: Synonym for "--target apps"
|
||||
: Synonym for "\-\-target apps"
|
||||
|
||||
**-a-, \-\-apps-, -apps-, -5-**
|
||||
: Synonym for "--target apps"
|
||||
: Synonym for "\-\-target apps"
|
||||
|
||||
**-ov, \-\-override, -override**
|
||||
: Automatically override the lock that prevents two loadups from running simultaneously. If this flag is not set and an active lock is encountered, the user will be asked to choose whether to override or exit.
|
||||
@@ -149,11 +149,11 @@ working directory (and all files and subdirectories it contains) is deleted.
|
||||
files except for those contained in the working directory.
|
||||
If the **+** parameter is used, then instead of deleting just the versioned files, all files and
|
||||
subdirectories are deleted except for those contained in the working directory. If **+** is used and
|
||||
there is no working directory and *--tag TAG* is also specified,
|
||||
there is no working directory and *\-\-tag TAG* is also specified,
|
||||
then the tagged loadups directory (\<MEDLEYDIR>/loadups/tagged/TAG) is also deleted.
|
||||
|
||||
**-th [+], \-\-thin [+], -thin [+]**
|
||||
: Equivalent to specifying both -tw [+] and -tl [+]. If *--tag TAG* is also specified and
|
||||
: Equivalent to specifying both -tw [+] and -tl [+]. If *\-\-tag TAG* is also specified and
|
||||
the **+** parameter is used here, then the tagged loadups directory (\<MEDLEYDIR>/loadups/tagged/TAG)
|
||||
is removed.
|
||||
|
||||
@@ -168,21 +168,21 @@ running Medley in the absence of an Xwindows server.
|
||||
|
||||
DEFAULTS
|
||||
====
|
||||
The defaults for the Options context-dependent and somewhat complicated due to the goal of maintaining compatibility with legacy loadup scripts. All of the following defaults rules hold independent of the --maikodir (-d) option.
|
||||
The defaults for the Options context-dependent and somewhat complicated due to the goal of maintaining compatibility with legacy loadup scripts. All of the following defaults rules hold independent of the \-\-maikodir (-d) option.
|
||||
|
||||
1. If none of --target, --start, --aux, and --db are specified, then:
|
||||
1. If none of \-\-target, \-\-start, \-\-aux, and \-\-db are specified, then:
|
||||
|
||||
>1A. If neither --thinw nor --thinl are specified, the options default to:
|
||||
>1A. If neither \-\-thinw nor \-\-thinl are specified, the options default to:
|
||||
|
||||
>> **--target full --start 0 --aux**
|
||||
>> **\-\-target full \-\-start 0 \-\-aux**
|
||||
|
||||
>1B. If either --thinw or --thinl are specified, no loadups are run.
|
||||
>1B. If either \-\-thinw or \-\-thinl are specified, no loadups are run.
|
||||
|
||||
2. If neither --start nor --target are specified but either -aux or -db or both are, then --start defaults to *full* and --target is irrelevant.
|
||||
2. If neither \-\-start nor \-\-target are specified but either -aux or -db or both are, then \-\-start defaults to *full* and \-\-target is irrelevant.
|
||||
|
||||
3. If --start is specified and --target is not, then --target defaults to *full*
|
||||
3. If \-\-start is specified and \-\-target is not, then \-\-target defaults to *full*
|
||||
|
||||
4. If --target is specified and --start is not, then --start defaults to *0*
|
||||
4. If \-\-target is specified and \-\-start is not, then \-\-start defaults to *0*
|
||||
|
||||
EXAMPLES
|
||||
====
|
||||
@@ -190,11 +190,11 @@ EXAMPLES
|
||||
|
||||
**./loadup \-\-target full \-\-start lisp** : run loadup thru Stage 4 (full.sysout) starting from existing Stage 3 outputs (lisp.sysout).
|
||||
|
||||
**./loadup -5 --aux** : run loadup from the beginning thru Stage 5 (apps.sysout) then run the Aux "stage" to create *whereis.hash* and *exports.all*
|
||||
**./loadup -5 \-\-aux** : run loadup from the beginning thru Stage 5 (apps.sysout) then run the Aux "stage" to create *whereis.hash* and *exports.all*
|
||||
|
||||
**./loadup -db** : just run the DB "stage" starting from an existing full.sysout; do not run any of the sequential stages.
|
||||
|
||||
**./loadup --maikodir ~/il/newmaiko** : run loadup sequence from beginning to full plus the loadup Aux stage, while using *~/il/newmaiko* as the location for the lde executables when running Medley.
|
||||
**./loadup \-\-maikodir ~/il/newmaiko** : run loadup sequence from beginning to full plus the loadup Aux stage, while using *~/il/newmaiko* as the location for the lde executables when running Medley.
|
||||
|
||||
**./loadup -full** : run loadup sequence from beginning thru full
|
||||
|
||||
|
||||
@@ -83,11 +83,11 @@ the work directory after the loadup completes.</p>
|
||||
the loadups output directory called <em>gitinfo</em> which contains the
|
||||
git commit, git branch and git status information for the directory at
|
||||
the time the loadup is run.</p>
|
||||
<p>Only one instance (per <MEDLEIDIR>) of loadup can be run at a
|
||||
<p>Only one instance (per <MEDLEYDIR>) of loadup can be run at a
|
||||
time. There is lock file to prevent simultaneous loadups in the work
|
||||
directory (named <strong><em>lock</em></strong>) that can be manually
|
||||
removed. The lock can also be automatically overridden (see the
|
||||
–override flag below). Alternatively, if a lock is encountered at run
|
||||
--override flag below). Alternatively, if a lock is encountered at run
|
||||
time, the user will be asked to choose whether to override or simply
|
||||
exit the loadup.</p>
|
||||
<p>Note: <strong>MEDLEYDIR</strong> is an environment variable set by
|
||||
@@ -99,7 +99,8 @@ installed in multiple places on any given machine and hence MEDLEYDIR is
|
||||
computed on each invocation of loadup.</p>
|
||||
<h1>OPTIONS</h1>
|
||||
<dl>
|
||||
<dt><strong>-z [+], --man [+], -man [+], -h [+], –help [+]</strong></dt>
|
||||
<dt><strong>-z [+], --man [+], -man [+], -h [+], --help
|
||||
[+]</strong></dt>
|
||||
<dd>
|
||||
<p>Print this manual page on the screen. If the <strong>+</strong>
|
||||
parameter is specified, then no pager is used when displaying the man
|
||||
@@ -109,7 +110,7 @@ page.</p>
|
||||
<dd>
|
||||
<p>Run the sequential loadup procedure until the STAGE is complete,
|
||||
starting from the files created by the previously run STAGE specified in
|
||||
the –start option.</p>
|
||||
the --start option.</p>
|
||||
<p>STAGE can be one of the following:</p>
|
||||
<blockquote>
|
||||
<p>i, init, 1: Run the loadup sequence through Stage 1 (init.dlinit).
|
||||
@@ -129,13 +130,13 @@ Full.sysout is copied into the loadups directory.</p>
|
||||
</blockquote>
|
||||
<blockquote>
|
||||
<p>a, apps, 5: Run the loadup sequence through Stage 5 (apps.sysout).
|
||||
Also run the Aux stage as if –aux option had been specified. Apps.sysout
|
||||
and the Aux files are copied into the loadups directory.</p>
|
||||
Also run the Aux stage as if --aux option had been specified.
|
||||
Apps.sysout and the Aux files are copied into the loadups directory.</p>
|
||||
</blockquote>
|
||||
<blockquote>
|
||||
<p>a-, apps-, 5-: Run the loadup sequence through Stage 5 (apps.sysout).
|
||||
The Aux stage is not run unless otherwise specified. Apps.sysout is
|
||||
copied into the loadups directory. Also run the Aux stage as if –aux
|
||||
copied into the loadups directory. Also run the Aux stage as if --aux
|
||||
option had been specified.</p>
|
||||
</blockquote>
|
||||
</dd>
|
||||
@@ -181,27 +182,27 @@ loadups.</p>
|
||||
</dd>
|
||||
<dt><strong>-i, --init, -init, -1</strong></dt>
|
||||
<dd>
|
||||
<p>Synonym for “–target init”</p>
|
||||
<p>Synonym for “--target init”</p>
|
||||
</dd>
|
||||
<dt><strong>-m, --mid, -mid, -2</strong></dt>
|
||||
<dd>
|
||||
<p>Synonym for “–target mid”</p>
|
||||
<p>Synonym for “--target mid”</p>
|
||||
</dd>
|
||||
<dt><strong>-l, --lisp, -lisp, -3</strong></dt>
|
||||
<dd>
|
||||
<p>Synonym for “–target lisp”</p>
|
||||
<p>Synonym for “--target lisp”</p>
|
||||
</dd>
|
||||
<dt><strong>-f, --full. -full, -4</strong></dt>
|
||||
<dd>
|
||||
<p>Synonym for “–target full”</p>
|
||||
<p>Synonym for “--target full”</p>
|
||||
</dd>
|
||||
<dt><strong>-a, --apps, -apps, -5</strong></dt>
|
||||
<dd>
|
||||
<p>Synonym for “–target apps”</p>
|
||||
<p>Synonym for “--target apps”</p>
|
||||
</dd>
|
||||
<dt><strong>-a-, --apps-, -apps-, -5-</strong></dt>
|
||||
<dd>
|
||||
<p>Synonym for “–target apps”</p>
|
||||
<p>Synonym for “--target apps”</p>
|
||||
</dd>
|
||||
<dt><strong>-ov, --override, -override</strong></dt>
|
||||
<dd>
|
||||
@@ -245,13 +246,13 @@ contained in the working directory. If the <strong>+</strong> parameter
|
||||
is used, then instead of deleting just the versioned files, all files
|
||||
and subdirectories are deleted except for those contained in the working
|
||||
directory. If <strong>+</strong> is used and there is no working
|
||||
directory and <em>–tag TAG</em> is also specified, then the tagged
|
||||
directory and <em>--tag</em> TAG is also specified, then the tagged
|
||||
loadups directory (<MEDLEYDIR>/loadups/tagged/TAG) is also
|
||||
deleted.</p>
|
||||
</dd>
|
||||
<dt><strong>-th [+], --thin [+], -thin [+]</strong></dt>
|
||||
<dd>
|
||||
<p>Equivalent to specifying both -tw [+] and -tl [+]. If <em>–tag
|
||||
<p>Equivalent to specifying both -tw [+] and -tl [+]. If <em>--tag
|
||||
TAG</em> is also specified and the <strong>+</strong> parameter is used
|
||||
here, then the tagged loadups directory
|
||||
(<MEDLEYDIR>/loadups/tagged/TAG) is removed.</p>
|
||||
@@ -277,24 +278,24 @@ absence of an Xwindows server.</p>
|
||||
<p>The defaults for the Options context-dependent and somewhat
|
||||
complicated due to the goal of maintaining compatibility with legacy
|
||||
loadup scripts. All of the following defaults rules hold independent of
|
||||
the –maikodir (-d) option.</p>
|
||||
the --maikodir (-d) option.</p>
|
||||
<ol type="1">
|
||||
<li><p>If none of –target, –start, –aux, and –db are specified,
|
||||
<li><p>If none of --target, --start, --aux, and --db are specified,
|
||||
then:</p>
|
||||
<p>1A. If neither –thinw nor –thinl are specified, the options default
|
||||
<p>1A. If neither --thinw nor --thinl are specified, the options default
|
||||
to:</p>
|
||||
<blockquote>
|
||||
<p><strong>–target full –start 0 –aux</strong></p>
|
||||
<p><strong>--target full --start 0 --aux</strong></p>
|
||||
</blockquote>
|
||||
<p>1B. If either –thinw or –thinl are specified, no loadups are
|
||||
<p>1B. If either --thinw or --thinl are specified, no loadups are
|
||||
run.</p></li>
|
||||
<li><p>If neither –start nor –target are specified but either -aux or
|
||||
-db or both are, then –start defaults to <em>full</em> and –target is
|
||||
<li><p>If neither --start nor --target are specified but either -aux or
|
||||
-db or both are, then --start defaults to <em>full</em> and --target is
|
||||
irrelevant.</p></li>
|
||||
<li><p>If –start is specified and –target is not, then –target defaults
|
||||
to <em>full</em></p></li>
|
||||
<li><p>If –target is specified and –start is not, then –start defaults
|
||||
to <em>0</em></p></li>
|
||||
<li><p>If --start is specified and --target is not, then --target
|
||||
defaults to <em>full</em></p></li>
|
||||
<li><p>If --target is specified and --start is not, then --start
|
||||
defaults to <em>0</em></p></li>
|
||||
</ol>
|
||||
<h1>EXAMPLES</h1>
|
||||
<p><strong>./loadup -full -s lisp</strong> : run loadup thru Stage 4
|
||||
@@ -302,12 +303,12 @@ to <em>0</em></p></li>
|
||||
<p><strong>./loadup --target full --start lisp</strong> : run loadup
|
||||
thru Stage 4 (full.sysout) starting from existing Stage 3 outputs
|
||||
(lisp.sysout).</p>
|
||||
<p><strong>./loadup -5 –aux</strong> : run loadup from the beginning
|
||||
<p><strong>./loadup -5 --aux</strong> : run loadup from the beginning
|
||||
thru Stage 5 (apps.sysout) then run the Aux “stage” to create
|
||||
<em>whereis.hash</em> and <em>exports.all</em></p>
|
||||
<p><strong>./loadup -db</strong> : just run the DB “stage” starting from
|
||||
an existing full.sysout; do not run any of the sequential stages.</p>
|
||||
<p><strong>./loadup –maikodir ~/il/newmaiko</strong> : run loadup
|
||||
<p><strong>./loadup --maikodir ~/il/newmaiko</strong> : run loadup
|
||||
sequence from beginning to full plus the loadup Aux stage, while using
|
||||
<em>~/il/newmaiko</em> as the location for the lde executables when
|
||||
running Medley.</p>
|
||||
|
||||
52
lispusers/CONVERT-TO-UTF8
Normal file
52
lispusers/CONVERT-TO-UTF8
Normal file
@@ -0,0 +1,52 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "25-Feb-2026 09:09:57" {WMEDLEY}<lispusers>CONVERT-TO-UTF8.;16 2573
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS CONVERT-TO-UTF8)
|
||||
|
||||
:PREVIOUS-DATE "24-Feb-2026 22:45:57" {WMEDLEY}<lispusers>CONVERT-TO-UTF8.;14)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT CONVERT-TO-UTF8COMS)
|
||||
|
||||
(RPAQQ CONVERT-TO-UTF8COMS ((FNS CONVERT-TO-UTF8)))
|
||||
(DEFINEQ
|
||||
|
||||
(CONVERT-TO-UTF8
|
||||
[LAMBDA (FILENAME FILETYPE) (* ; "Edited 25-Feb-2026 09:09 by rmk")
|
||||
|
||||
(* ;; "This produces a new version of the source FILENAME with :UTF-8 external format.")
|
||||
|
||||
(* ;; "If we had a list of problematic functions (multiple definitions on multiple files, MOVD's), we could check that against the functions in FILENAME, and at least produce a warning.")
|
||||
|
||||
(* ;; "Compiling may be tricky: some files have CL:COMPILE-FILE FILETYPE properties that don't correspond to the fact that they actually have only an LCOM. This tries to revert the filetype back to FAKE-COMPILE-FILE so that we don't get confused when a DFASL mysteriously appears.")
|
||||
|
||||
(SETQ FILENAME (PSEUDOFILENAME FILENAME))
|
||||
(SETQ FILENAME (OR (FINDFILE FILENAME T)
|
||||
(ERROR "FILE NOT FOUND" FILENAME)))
|
||||
(if [EQ :UTF-8 (CL:WITH-OPEN-FILE (STREAM FILENAME :DIRECTION :INPUT)
|
||||
(fetch (READER-ENVIRONMENT REFORMAT) of (GET-ENVIRONMENT-AND-FILEMAP STREAM
|
||||
T]
|
||||
then (PRINTOUT T FILENAME " is already " .P2 :UTF-8 T)
|
||||
NIL
|
||||
else (LOAD? (MEDLEYDIR "loadups" 'EXPORTS.ALL)) (* ; "Maybe this should load SYSEDIT ?")
|
||||
(LOAD FILENAME 'PROP)
|
||||
(LOADCOMP FILENAME)
|
||||
(SETQ FILENAME (PACKFILENAME 'VERSION NIL 'BODY FILENAME))
|
||||
(CL:WHEN [AND (EQ 'CL:COMPILE-FILE (GETPROP (ROOTFILENAME FILENAME)
|
||||
'FILETYPE))
|
||||
(FINDFILE (PACKFILENAME 'EXTENSION 'LCOM 'BODY FILENAME))
|
||||
(NOT (FINDFILE (PACKFILENAME 'EXTENSION 'DFASL 'BODY FILENAME]
|
||||
(CL:UNLESS FILETYPE (SETQ FILETYPE :FAKE-COMPILE-FILE))
|
||||
(PRINTOUT T "Changing FILETYPE back to " .P2 FILETYPE T)
|
||||
(PUTPROP (ROOTFILENAME FILENAME)
|
||||
'FILETYPE FILETYPE))
|
||||
[SETQ FILENAME (MAKEFILE FILENAME '(NEW :UTF-8]
|
||||
(MAKEFILE1 FILENAME NIL '(F))
|
||||
FILENAME])
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (406 2550 (CONVERT-TO-UTF8 416 . 2548)))))
|
||||
STOP
|
||||
BIN
lispusers/CONVERT-TO-UTF8.LCOM
Normal file
BIN
lispusers/CONVERT-TO-UTF8.LCOM
Normal file
Binary file not shown.
BIN
lispusers/CONVERT-TO-UTF8.TEDIT
Normal file
BIN
lispusers/CONVERT-TO-UTF8.TEDIT
Normal file
Binary file not shown.
215
lispusers/GITFNS
215
lispusers/GITFNS
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10 :FORMAT :UTF-8)
|
||||
|
||||
(FILECREATED "28-Oct-2025 14:10:06" {WMEDLEY}<lispusers>GITFNS.;569 131593
|
||||
(FILECREATED " 2-Mar-2026 14:00:13" {WMEDLEY}<lispusers>GITFNS.;576 133513
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS GIT-WORKING-COMPARE-DIRECTORIES GIT-BRANCHES-COMPARE-DIRECTORIES)
|
||||
:CHANGES-TO (FNS GIT-MY-NEXT-BRANCH)
|
||||
|
||||
:PREVIOUS-DATE "28-Oct-2025 13:32:16" {WMEDLEY}<lispusers>GITFNS.;568)
|
||||
:PREVIOUS-DATE "26-Feb-2026 00:39:22" {WMEDLEY}<lispusers>GITFNS.;575)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT GITFNSCOMS)
|
||||
@@ -74,7 +74,7 @@
|
||||
|
||||
(* ;; "Differences")
|
||||
|
||||
(FNS GIT-BRANCH-DIFF GIT-COMMIT-DIFFS GIT-BRANCH-RELATIONS)
|
||||
(FNS GIT-BRANCH-DIFF GIT-COMMIT-DIFFS GIT-BRANCH-RELATIONS GIT-MODIFIED)
|
||||
|
||||
(* ;; "")
|
||||
|
||||
@@ -169,6 +169,7 @@
|
||||
|
||||
(GIT-MAKE-PROJECT
|
||||
[LAMBDA (PROJECTNAME CLONEPATH WORKINGPATH EXCLUSIONS DEFAULTSUBDIRS)
|
||||
(* ; "Edited 25-Feb-2026 23:25 by rmk")
|
||||
(* ; "Edited 25-Oct-2025 16:53 by rmk")
|
||||
(* ; "Edited 22-Oct-2025 12:45 by rmk")
|
||||
(* ; "Edited 20-Oct-2025 18:10 by rmk")
|
||||
@@ -234,9 +235,8 @@
|
||||
(CL:WHEN (SETQ GITIGNORE (INFILEP (PACKFILENAME.STRING 'NAME ".gitignore" 'BODY
|
||||
CLONEPATH)))
|
||||
(SETQ GITIGNORE (CL:WITH-OPEN-FILE (STREAM GITIGNORE :EXTERNAL-FORMAT :UTF-8)
|
||||
(bind L until (EOFP STREAM)
|
||||
while (SETQ L (CL:READ-LINE STREAM :EOF-ERROR-P NIL
|
||||
:EOF-VALUE NIL))
|
||||
(bind L until (EOFP STREAM) while (SETQ L (CL:READ-LINE
|
||||
STREAM NIL))
|
||||
unless (OR (EQ 0 (NCHARS L))
|
||||
(STRPOS "#" L)) collect L))))
|
||||
(SETQ EXCLUSIONS (CL:REMOVE-DUPLICATES (APPEND (for E inside EXCLUSIONS
|
||||
@@ -274,16 +274,16 @@
|
||||
"")
|
||||
"for " PROJECTNAME]
|
||||
(SETQ PROJECT (create GIT-PROJECT
|
||||
PROJECTNAME _ PROJECTNAME
|
||||
GITHOST _ (PACK* "{" (PSEUDOHOST PROJECTNAME CLONEPATH)
|
||||
PROJECTNAME ← PROJECTNAME
|
||||
GITHOST ← (PACK* "{" (PSEUDOHOST PROJECTNAME CLONEPATH)
|
||||
"}")
|
||||
WHOST _ (AND WORKINGPATH (PACK* "{" (PSEUDOHOST (CONCAT "W"
|
||||
WHOST ← (AND WORKINGPATH (PACK* "{" (PSEUDOHOST (CONCAT "W"
|
||||
PROJECTNAME)
|
||||
WORKINGPATH)
|
||||
"}"))
|
||||
EXCLUSIONS _ EXCLUSIONS
|
||||
DEFAULTSUBDIRS _ (MKLIST DEFAULTSUBDIRS)
|
||||
CLONEPATH _ CLONEPATH))
|
||||
EXCLUSIONS ← EXCLUSIONS
|
||||
DEFAULTSUBDIRS ← (MKLIST DEFAULTSUBDIRS)
|
||||
CLONEPATH ← CLONEPATH))
|
||||
(/RPLACD [OR (ASSOC PROJECTNAME GIT-PROJECTS)
|
||||
(CAR (push GIT-PROJECTS (CONS PROJECTNAME]
|
||||
PROJECT)
|
||||
@@ -358,7 +358,7 @@
|
||||
|
||||
(FIND-ANCESTOR-DIRECTORY
|
||||
[LAMBDA (STARTDIR PREDFN) (* ; "Edited 8-May-2022 12:17 by rmk")
|
||||
(BIND POS (A _ STARTDIR) WHILE (SETQ POS (STRPOS "/" A -2 NIL NIL NIL FILEDIRCASEARRAY T))
|
||||
(BIND POS (A ← STARTDIR) WHILE (SETQ POS (STRPOS "/" A -2 NIL NIL NIL FILEDIRCASEARRAY T))
|
||||
DO (SETQ A (SUBSTRING A 1 POS))
|
||||
(CL:WHEN (APPLY* PREDFN A)
|
||||
(RETURN A])
|
||||
@@ -372,7 +372,7 @@
|
||||
(GIT-CLONEP (GIT-PROJECT-PATH PROJECTNAME PROJECTPATH)
|
||||
T T)
|
||||
[FIND-ANCESTOR-DIRECTORY PROJECTPATH (FUNCTION (LAMBDA (A)
|
||||
(BIND D (GEN _ (\GENERATEFILES A NIL NIL 1))
|
||||
(BIND D (GEN ← (\GENERATEFILES A NIL NIL 1))
|
||||
WHILE (SETQ D (\GENERATENEXTFILE GEN))
|
||||
WHEN (GIT-CLONEP D T)
|
||||
DO (RETFROM (FUNCTION
|
||||
@@ -684,7 +684,7 @@
|
||||
|
||||
(GIT-MAINBRANCH? (GIT-WHICH-BRANCH PROJECT)
|
||||
PROJECT)
|
||||
(FOR MF GF DEST (MEDLEYSUBDIRS _ (MEDLEYSUBDIRS PROJECT)) INSIDE MFILES
|
||||
(FOR MF GF DEST (MEDLEYSUBDIRS ← (MEDLEYSUBDIRS PROJECT)) INSIDE MFILES
|
||||
COLLECT (SETQ MF (OR (FINDFILE MF NIL MEDLEYSUBDIRS)
|
||||
(ERROR "FILE NOT FOUND" MF)))
|
||||
(CL:UNLESS (STRING.EQUAL MF (INFILEP (PACKFILENAME 'VERSION NIL 'BODY MF))
|
||||
@@ -709,7 +709,7 @@
|
||||
(* ;; "Does anybody call this?")
|
||||
|
||||
(SETQ PROJECT (GIT-GET-PROJECT PROJECT))
|
||||
(FOR GF MF DEST (GITSUBDIRS _ (GITSUBDIRS PROJECT)) INSIDE GFILES
|
||||
(FOR GF MF DEST (GITSUBDIRS ← (GITSUBDIRS PROJECT)) INSIDE GFILES
|
||||
COLLECT (SETQ GF (OR (FINDFILE GF NIL GITSUBDIRS)
|
||||
(ERROR "FILE NOT FOUND" GF)))
|
||||
(SETQ MF (MFILE4GFILE GF))
|
||||
@@ -742,8 +742,8 @@
|
||||
"")])
|
||||
|
||||
(STRIPDIR
|
||||
[LAMBDA (FILE DIRECTORY) (* ; "Edited 18-Jan-2022 16:09 by rmk")
|
||||
(* ; "Edited 8-Nov-2021 11:50 by rmk:")
|
||||
[LAMBDA (FILE DIRECTORY) (* ; "Edited 18-Jan-2022 16:09 by rmk")
|
||||
(* ; "Edited 8-Nov-2021 11:50 by rmk:")
|
||||
(IF (STRPOS DIRECTORY FILE 1 NIL T NIL FILEDIRCASEARRAY)
|
||||
THEN (SUBSTRING FILE (ADD1 (NCHARS DIRECTORY)))
|
||||
ELSE FILE])
|
||||
@@ -1023,7 +1023,7 @@
|
||||
": ")
|
||||
(IF (EQ (CAR X)
|
||||
'Comments)
|
||||
THEN (FOR CC (POS _ (POSITION T)) IN (CDR X)
|
||||
THEN (FOR CC (POS ← (POSITION T)) IN (CDR X)
|
||||
DO (IF (EQ CC T)
|
||||
THEN (TERPRI T)
|
||||
ELSE (PRINTOUT T .TAB0 POS CC)))
|
||||
@@ -1163,7 +1163,7 @@
|
||||
|
||||
(* ;; "Returns the identifiers for commits in BRANCH1 but not in BUTNOTBRANCH2")
|
||||
|
||||
(GIT-COMMAND (CONCAT "git log --format=%"%%h%" %"" BRANCH1 "%" %"" BUTNOTBRANCH2 "%"")
|
||||
(GIT-COMMAND (CONCAT "git log --format=%"%%h%" %"" BRANCH1 "%" %"^" BUTNOTBRANCH2 "%"")
|
||||
NIL NIL PROJECT])
|
||||
|
||||
(GIT-BRANCH-RELATIONS
|
||||
@@ -1227,6 +1227,16 @@
|
||||
then (CONS MAIN (DREMOVE MAIN (SORT DATUM)))
|
||||
else (SORT DATUM]
|
||||
(RETURN (LIST SUPERSETS EQUALS])
|
||||
|
||||
(GIT-MODIFIED
|
||||
[LAMBDA (PROJECT) (* ; "Edited 25-Dec-2025 13:39 by rmk")
|
||||
|
||||
(* ;;
|
||||
"A list of files that have been modified M or introduced but not committed ??. see git help status")
|
||||
|
||||
(for X POS in (GIT-COMMAND "git status --porcelain")
|
||||
when (SETQ POS (OR (STRPOS " M " X NIL NIL NIL T)
|
||||
(STRPOS "?? " X NIL NIL NIL T))) collect (SUBSTRING X POS])
|
||||
)
|
||||
|
||||
|
||||
@@ -1353,7 +1363,7 @@
|
||||
(CL:WHEN (thereis B in BRANCHES suchthat (STRPOS "HEAD detached" B))
|
||||
(PRINTOUT T "Execute %"git gc%" to eliminate a branch with a detached HEAD" T))
|
||||
(CL:WHEN EXCLUDEMERGED
|
||||
(SETQ BRANCHES (for B (MAINBRANCH _ (GIT-MAINBRANCH PROJECT 'LOCAL)) in BRANCHES
|
||||
(SETQ BRANCHES (for B (MAINBRANCH ← (GIT-MAINBRANCH PROJECT 'LOCAL)) in BRANCHES
|
||||
when (EQUAL (GIT-COMMAND (CONCAT "git merge-base %"" B "%" %""
|
||||
MAINBRANCH "%""))
|
||||
(GIT-COMMAND (CONCAT "git rev-parse %"" B "%"")))
|
||||
@@ -1392,11 +1402,11 @@
|
||||
(CL:WHEN PIN?
|
||||
[SETQ BRANCHES (APPEND BRANCHES '((" Pin menu" 'PinMenu])
|
||||
(create MENU
|
||||
TITLE _ (OR TITLE (CONCAT (LENGTH BRANCHES)
|
||||
TITLE ← (OR TITLE (CONCAT (LENGTH BRANCHES)
|
||||
" branches"))
|
||||
ITEMS _ BRANCHES
|
||||
MENUFONT _ DEFAULTFONT
|
||||
WHENSELECTEDFN _ (FUNCTION GIT-BRANCH-WHENSELECTEDFN)))])
|
||||
ITEMS ← BRANCHES
|
||||
MENUFONT ← DEFAULTFONT
|
||||
WHENSELECTEDFN ← (FUNCTION GIT-BRANCH-WHENSELECTEDFN)))])
|
||||
|
||||
(GIT-BRANCH-WHENSELECTEDFN
|
||||
[LAMBDA (ITEM MENU BUTTON) (* ; "Edited 2-Oct-2025 23:08 by rmk")
|
||||
@@ -1446,20 +1456,20 @@
|
||||
eachtime [SETQ DRAFT (EQ 'true (JSON-GET JSOBJ 'isDraft] when (OR INCLUDEDRAFTS
|
||||
(NOT DRAFT))
|
||||
collect [SETQ PR (create PULLREQUEST
|
||||
PRNUMBER _ (JSON-GET JSOBJ 'number)
|
||||
PRNAME _ (JSON-GET JSOBJ 'headRefName)
|
||||
PRDESCRIPTION _ (JSON-GET JSOBJ 'title)
|
||||
PRSTATUS _ (CL:IF DRAFT
|
||||
PRNUMBER ← (JSON-GET JSOBJ 'number)
|
||||
PRNAME ← (JSON-GET JSOBJ 'headRefName)
|
||||
PRDESCRIPTION ← (JSON-GET JSOBJ 'title)
|
||||
PRSTATUS ← (CL:IF DRAFT
|
||||
'D
|
||||
(SELECTQ (MKATOM (JSON-GET JSOBJ 'reviewDecision))
|
||||
(CHANGES¬REQUESTED
|
||||
(CHANGES_REQUESTED
|
||||
'C)
|
||||
(REVIEW¬REQUIRED
|
||||
(REVIEW_REQUIRED
|
||||
" ")
|
||||
'A))
|
||||
PRPROJECT _ PROJECT
|
||||
PRURL _ (JSON-GET JSOBJ 'url)
|
||||
PRLOGIN _ (JSON-GET JSOBJ '(headRepositoryOwner login]
|
||||
PRPROJECT ← PROJECT
|
||||
PRURL ← (JSON-GET JSOBJ 'url)
|
||||
PRLOGIN ← (JSON-GET JSOBJ '(headRepositoryOwner login]
|
||||
(CL:WHEN (STRPOS ":" (fetch (PULLREQUEST PRNAME) of PR))
|
||||
|
||||
(* ;; "From Nick: Git commands to bring install and deal with the remotes:")
|
||||
@@ -1510,8 +1520,8 @@
|
||||
(LET ((RELATIONS (GIT-BRANCH-RELATIONS (for PR in PRS
|
||||
collect (GITORIGIN (fetch PRNAME of PR)))
|
||||
NIL T PROJECT)))
|
||||
(SORT (for PR REL LABEL PRNAME STATUS (SUPERSETS _ (CAR RELATIONS))
|
||||
(EQUALS _ (CADR RELATIONS)) in PRS
|
||||
(SORT (for PR REL LABEL PRNAME STATUS (SUPERSETS ← (CAR RELATIONS))
|
||||
(EQUALS ← (CADR RELATIONS)) in PRS
|
||||
eachtime (SETQ PRNAME (fetch PRNAME of PR))
|
||||
(SETQ LABEL (CONCAT "#" (fetch (PULLREQUEST PRNUMBER) of PR)
|
||||
" "
|
||||
@@ -1558,15 +1568,33 @@
|
||||
(GIT-BRANCH-NUM (OR BRANCH (GIT-WHICH-BRANCH PROJECT T])
|
||||
|
||||
(GIT-MY-NEXT-BRANCH
|
||||
[LAMBDA (PROJECT) (* ; "Edited 19-May-2022 14:08 by rmk")
|
||||
[LAMBDA (PROJECT) (* ; "Edited 2-Mar-2026 14:00 by rmk")
|
||||
(* ; "Edited 19-May-2022 14:08 by rmk")
|
||||
(* ; "Edited 8-Jan-2022 09:43 by rmk")
|
||||
|
||||
(* ;; "Figures out the number of my next incremental branch would be. ")
|
||||
|
||||
(PACK* (GIT-INITIALS)
|
||||
(ADD1 (OR (GIT-MY-BRANCHP (GIT-MY-CURRENT-BRANCH PROJECT)
|
||||
PROJECT)
|
||||
0])
|
||||
(LET (PROJECTLIST PROJECTENTRY NEXTNUM)
|
||||
(CL:WITH-OPEN-FILE (STRM "{LI}GIT-MY-CURRENT-BRANCH-NUMS;1" :DIRECTION :IO
|
||||
:IF-DOES-NOT-EXIST :CREATE :IF-EXISTS :OVERWRITE)
|
||||
(SETQ PROJECTLIST (CL:UNLESS (EQ 0 (GETEOFPTR STRM))
|
||||
(READ STRM)))
|
||||
(SETQ PROJECTENTRY (ASSOC (GIT-GET-PROJECT PROJECT 'PROJECTNAME)
|
||||
PROJECTLIST))
|
||||
(CL:UNLESS PROJECTENTRY
|
||||
(SETQ PROJECTENTRY (LIST (GIT-GET-PROJECT PROJECT 'PROJECTNAME)
|
||||
(OR (GIT-MY-BRANCHP (GIT-MY-CURRENT-BRANCH
|
||||
PROJECT)
|
||||
PROJECT)
|
||||
0)))
|
||||
(push PROJECTLIST PROJECTENTRY))
|
||||
(SETQ NEXTNUM (ADD1 (CADR PROJECTENTRY)))
|
||||
(RPLACA (CDR PROJECTENTRY)
|
||||
NEXTNUM)
|
||||
(SETFILEPTR STRM 0)
|
||||
(PRINT PROJECTLIST STRM)
|
||||
NEXTNUM])
|
||||
|
||||
(GIT-MY-BRANCHES
|
||||
[LAMBDA (PROJECT EXCLUDEMERGED INITS) (* ; "Edited 19-May-2022 19:10 by rmk")
|
||||
@@ -1647,14 +1675,14 @@
|
||||
(CL:WHEN (STRPOS "fatal: " (CAR LINES)
|
||||
1 NIL T)
|
||||
(ERROR "Could not remove worktree for " BRANCH))
|
||||
(* (DELFILE (CONCAT PATH "/.DS_Store"))
|
||||
(* (DELFILE (CONCAT PATH "/.DS←Store"))
|
||||
(GIT-COMMAND (CONCAT "rmdir " DIR) NIL
|
||||
NIL PROJECT))
|
||||
BRANCH])
|
||||
|
||||
(GIT-LIST-WORKTREES
|
||||
[LAMBDA NIL (* ; "Edited 12-Dec-2021 12:13 by rmk")
|
||||
(* ; "Edited 19-Nov-2021 18:53 by rmk:")
|
||||
[LAMBDA NIL (* ; "Edited 12-Dec-2021 12:13 by rmk")
|
||||
(* ; "Edited 19-Nov-2021 18:53 by rmk:")
|
||||
|
||||
(* ;; "The git command tells us what the clone thinks about it, but then we look to see what is actually in our worktrees directory, to make sure that the subdirectory wasn't deleted in a wy that the clone didn't know about.")
|
||||
|
||||
@@ -1880,14 +1908,14 @@
|
||||
|
||||
(replace (CDENTRY INFO2) of CDE
|
||||
with (create CDINFO
|
||||
FULLNAME _ (CADR MAP)
|
||||
DATE _ (CL:IF (EQ 'R (CADDR MAP))
|
||||
FULLNAME ← (CADR MAP)
|
||||
DATE ← (CL:IF (EQ 'R (CADDR MAP))
|
||||
" <-"
|
||||
" ==")
|
||||
LENGTH _ ""
|
||||
AUTHOR _ ""
|
||||
TYPE _ ""
|
||||
EOL _ ""))
|
||||
LENGTH ← ""
|
||||
AUTHOR ← ""
|
||||
TYPE ← ""
|
||||
EOL ← ""))
|
||||
(replace (CDENTRY DATEREL) of CDE
|
||||
with (CADDR MAP]
|
||||
(TERPRI T)
|
||||
@@ -1957,10 +1985,10 @@
|
||||
then (SETQ SUBDIRS (ALLSUBDIRS PROJECT))
|
||||
"ALL subdirectories"
|
||||
else SUBDIRS)))
|
||||
(for SUBDIR TITLE CDVAL (WPROJ _ (CONCAT "Working " (L-CASE (fetch PROJECTNAME of PROJECT)
|
||||
(for SUBDIR TITLE CDVAL (WPROJ ← (CONCAT "Working " (L-CASE (fetch PROJECTNAME of PROJECT)
|
||||
T)))
|
||||
(NENTRIES _ 0)
|
||||
(BRANCH2 _ (GIT-WHICH-BRANCH PROJECT T))
|
||||
(NENTRIES ← 0)
|
||||
(BRANCH2 ← (GIT-WHICH-BRANCH PROJECT T))
|
||||
first (PRINTOUT T "Comparing " SUBDIRSTRING 6 " of " WPROJ " and Git " BRANCH2 T)
|
||||
(BKSYSBUF " ") inside SUBDIRS
|
||||
collect (TERPRI T)
|
||||
@@ -2132,12 +2160,12 @@
|
||||
NIL]
|
||||
(CL:WHEN (OR COPYITEM COMPAREITEMS)
|
||||
(SELECTQ (MENU (CREATE MENU
|
||||
TITLE _ (CONCAT (WINDOWPROP WINDOW 'SUBDIR)
|
||||
TITLE ← (CONCAT (WINDOWPROP WINDOW 'SUBDIR)
|
||||
"/"
|
||||
(FETCH MATCHNAME OF CDENTRY))
|
||||
ITEMS _ (APPEND COPYITEM COMPAREITEMS)
|
||||
MENUFONT _ FONT
|
||||
MENUTITLEFONT _ FONT))
|
||||
ITEMS ← (APPEND COPYITEM COMPAREITEMS)
|
||||
MENUFONT ← FONT
|
||||
MENUTITLEFONT ← FONT))
|
||||
(TOGIT (CL:WHEN (TOGIT (FETCH (CDINFO FULLNAME) OF INFO1)
|
||||
WINDOW)
|
||||
(IMAGEOBJPROP OBJ 'COPIED T)
|
||||
@@ -2162,18 +2190,18 @@
|
||||
NIL)))])
|
||||
|
||||
(GIT-CD-LABELFN
|
||||
[LAMBDA (FILE1 FILE2 USERDATA) (* ; "Edited 5-Jan-2022 15:10 by rmk")
|
||||
(* ; "Edited 16-Dec-2021 12:25 by rmk")
|
||||
[LAMBDA (FILE1 FILE2 USERDATA) (* ; "Edited 5-Jan-2022 15:10 by rmk")
|
||||
(* ; "Edited 16-Dec-2021 12:25 by rmk")
|
||||
(* ; "Edited 13-Dec-2021 22:13 by rmk")
|
||||
(DECLARE (USEDFREE CDVALUE))
|
||||
(LET (NC B LABEL1 LABEL2)
|
||||
(CL:WHEN (SETQ NC (FETCH NCDIR OF (FETCH CDMAXNC1 OF CDVALUE)))
|
||||
(SETQ LABEL1 (SLASHIT (SUBSTRING FILE1 (ADD1 NC))
|
||||
(SETQ LABEL1 (SLASHIT (SUBSTRING FILE1 (ADD1 NC))
|
||||
T))
|
||||
(CL:WHEN (SETQ B (LISTGET USERDATA 'BRANCH1))
|
||||
(SETQ LABEL1 (CONCAT B "/" LABEL1))))
|
||||
(CL:WHEN (SETQ NC (FETCH NCDIR OF (FETCH CDMAXNC2 OF CDVALUE)))
|
||||
(SETQ LABEL2 (SLASHIT (SUBSTRING FILE2 (ADD1 NC))
|
||||
(SETQ LABEL2 (SLASHIT (SUBSTRING FILE2 (ADD1 NC))
|
||||
T))
|
||||
(CL:WHEN (SETQ B (LISTGET USERDATA 'BRANCH2))
|
||||
(SETQ LABEL2 (CONCAT B "/" LABEL2))))
|
||||
@@ -2367,15 +2395,15 @@
|
||||
NIL])
|
||||
|
||||
(GIT-RESULT-TO-LINES
|
||||
[LAMBDA (FILE ALL) (* ; "Edited 31-Mar-2025 15:19 by rmk")
|
||||
[LAMBDA (FILE ALL) (* ; "Edited 25-Feb-2026 23:24 by rmk")
|
||||
(* ; "Edited 31-Mar-2025 15:19 by rmk")
|
||||
(* ; "Edited 16-Jul-2022 22:21 by rmk")
|
||||
|
||||
(* ;; "Suppress .git lines unless ALL SYSTEM-EXTERNALFORMAT may make the wrong guess, but at least we ensure here that lines get broken.")
|
||||
|
||||
(CL:WITH-OPEN-FILE (STREAM FILE :DIRECTION :INPUT :EXTERNAL-FORMAT (LIST (SYSTEM-EXTERNALFORMAT)
|
||||
'ANY))
|
||||
(bind LINE until (EOFP STREAM) when [PROGN (SETQ LINE (CL:READ-LINE STREAM :EOF-ERROR-P
|
||||
NIL :EOF-VALUE NIL))
|
||||
(bind LINE until (EOFP STREAM) when [PROGN (SETQ LINE (CL:READ-LINE STREAM NIL))
|
||||
(OR ALL (NOT (STRPOS ".git" LINE 1]
|
||||
collect LINE])
|
||||
|
||||
@@ -2394,32 +2422,33 @@
|
||||
|
||||
(PUTPROPS GITFNS FILETYPE :TCOMPL)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (4196 21002 (GIT-CLONEP 4206 . 5637) (GIT-INIT 5639 . 6269) (GIT-MAKE-PROJECT 6271 .
|
||||
14060) (GIT-GET-PROJECT 14062 . 15987) (GIT-PUT-PROJECT-FIELD 15989 . 17630) (GIT-PROJECT-PATH 17632
|
||||
. 18676) (FIND-ANCESTOR-DIRECTORY 18678 . 19027) (GIT-FIND-CLONE 19029 . 20110) (GIT-MAINBRANCH 20112
|
||||
. 20507) (GIT-MAINBRANCH? 20509 . 21000)) (26465 31394 (PRC-COMMAND 26475 . 31392)) (31450 34238 (
|
||||
ALLSUBDIRS 31460 . 32746) (MEDLEYSUBDIRS 32748 . 33441) (GITSUBDIRS 33443 . 34236)) (34239 36640 (
|
||||
TOGIT 34249 . 35655) (FROMGIT 35657 . 36638)) (36641 39644 (MYMEDLEYSUBDIR 36651 . 37107) (GITSUBDIR
|
||||
37109 . 37552) (STRIPDIR 37554 . 37925) (STRIPHOST 37927 . 38167) (STRIPNAME 38169 . 38922) (
|
||||
STRIPWHERE 38924 . 39642)) (39645 41880 (GFILE4MFILE 39655 . 40351) (MFILE4GFILE 40353 . 40922) (
|
||||
GIT-REPO-FILENAME 40924 . 41878)) (41929 52184 (GIT-COMMIT 41939 . 42765) (GIT-PUSH 42767 . 43527) (
|
||||
GIT-PULL 43529 . 44281) (GIT-APPROVAL 44283 . 44632) (GIT-GET-FILE 44634 . 46549) (GIT-FILE-EXISTS?
|
||||
46551 . 46825) (GIT-REMOTE-UPDATE 46827 . 47662) (GIT-REMOTE-ADD 47664 . 47971) (GIT-FILE-DATE 47973
|
||||
. 49020) (GIT-FILE-HISTORY 49022 . 50956) (GIT-PRINT-FILE-HISTORY 50958 . 52008) (GIT-FETCH 52010 .
|
||||
52182)) (52214 63694 (GIT-BRANCH-DIFF 52224 . 59113) (GIT-COMMIT-DIFFS 59115 . 60006) (
|
||||
GIT-BRANCH-RELATIONS 60008 . 63692)) (63739 82478 (GIT-BRANCH-NUM 63749 . 64322) (GIT-CHECKOUT 64324
|
||||
. 65610) (GIT-WHICH-BRANCH 65612 . 66019) (GIT-MAKE-BRANCH 66021 . 68600) (GIT-BRANCHES 68602 . 71197
|
||||
) (GIT-BRANCH-EXISTS? 71199 . 72070) (GIT-PICK-BRANCH 72072 . 72562) (GIT-BRANCH-MENU 72564 . 73445) (
|
||||
GIT-BRANCH-WHENSELECTEDFN 73447 . 74986) (GIT-PULL-REQUESTS 74988 . 78859) (GIT-SHORT-BRANCH-NAME
|
||||
78861 . 79152) (GIT-LONG-NAME 79154 . 79471) (GIT-PRC-BRANCHES 79473 . 82476)) (82508 85956 (
|
||||
GIT-MY-CURRENT-BRANCH 82518 . 82888) (GIT-MY-BRANCHP 82890 . 83508) (GIT-MY-NEXT-BRANCH 83510 . 84004)
|
||||
(GIT-MY-BRANCHES 84006 . 85954)) (86002 90077 (GIT-ADD-WORKTREE 86012 . 87619) (GIT-REMOVE-WORKTREE
|
||||
87621 . 88551) (GIT-LIST-WORKTREES 88553 . 89357) (WORKTREEDIR 89359 . 90075)) (90125 123133 (
|
||||
GIT-GET-DIFFERENT-FILES 90135 . 97043) (GIT-BRANCHES-COMPARE-DIRECTORIES 97045 . 104672) (
|
||||
GIT-WORKING-COMPARE-DIRECTORIES 104674 . 110470) (GIT-COMPARE-WORKTREE 110472 . 114450) (
|
||||
GITCDOBJBUTTONFN 114452 . 118942) (GIT-CD-LABELFN 118944 . 120026) (GIT-CD-MENUFN 120028 . 121114) (
|
||||
GIT-WORKING-COMPARE-FILES 121116 . 121736) (GIT-BRANCHES-COMPARE-FILES 121738 . 122902) (
|
||||
GIT-PR-COMPARE 122904 . 123131)) (123203 131526 (CDGITDIR 123213 . 123900) (GIT-COMMAND 123902 .
|
||||
125460) (GITORIGIN 125462 . 126159) (GIT-INITIALS 126161 . 126465) (GIT-COMMAND-TO-FILE 126467 .
|
||||
129952) (GIT-RESULT-TO-LINES 129954 . 130859) (STRIPLOCAL 130861 . 131524)))))
|
||||
(FILEMAP (NIL (4178 21056 (GIT-CLONEP 4188 . 5619) (GIT-INIT 5621 . 6251) (GIT-MAKE-PROJECT 6253 .
|
||||
14110) (GIT-GET-PROJECT 14112 . 16037) (GIT-PUT-PROJECT-FIELD 16039 . 17680) (GIT-PROJECT-PATH 17682
|
||||
. 18726) (FIND-ANCESTOR-DIRECTORY 18728 . 19079) (GIT-FIND-CLONE 19081 . 20164) (GIT-MAINBRANCH 20166
|
||||
. 20561) (GIT-MAINBRANCH? 20563 . 21054)) (26519 31448 (PRC-COMMAND 26529 . 31446)) (31504 34292 (
|
||||
ALLSUBDIRS 31514 . 32800) (MEDLEYSUBDIRS 32802 . 33495) (GITSUBDIRS 33497 . 34290)) (34293 36698 (
|
||||
TOGIT 34303 . 35711) (FROMGIT 35713 . 36696)) (36699 39709 (MYMEDLEYSUBDIR 36709 . 37165) (GITSUBDIR
|
||||
37167 . 37610) (STRIPDIR 37612 . 37990) (STRIPHOST 37992 . 38232) (STRIPNAME 38234 . 38987) (
|
||||
STRIPWHERE 38989 . 39707)) (39710 41945 (GFILE4MFILE 39720 . 40416) (MFILE4GFILE 40418 . 40987) (
|
||||
GIT-REPO-FILENAME 40989 . 41943)) (41994 52251 (GIT-COMMIT 42004 . 42830) (GIT-PUSH 42832 . 43592) (
|
||||
GIT-PULL 43594 . 44346) (GIT-APPROVAL 44348 . 44697) (GIT-GET-FILE 44699 . 46614) (GIT-FILE-EXISTS?
|
||||
46616 . 46890) (GIT-REMOTE-UPDATE 46892 . 47727) (GIT-REMOTE-ADD 47729 . 48036) (GIT-FILE-DATE 48038
|
||||
. 49085) (GIT-FILE-HISTORY 49087 . 51021) (GIT-PRINT-FILE-HISTORY 51023 . 52075) (GIT-FETCH 52077 .
|
||||
52249)) (52281 64233 (GIT-BRANCH-DIFF 52291 . 59180) (GIT-COMMIT-DIFFS 59182 . 60073) (
|
||||
GIT-BRANCH-RELATIONS 60075 . 63759) (GIT-MODIFIED 63761 . 64231)) (64278 83045 (GIT-BRANCH-NUM 64288
|
||||
. 64861) (GIT-CHECKOUT 64863 . 66149) (GIT-WHICH-BRANCH 66151 . 66558) (GIT-MAKE-BRANCH 66560 . 69139
|
||||
) (GIT-BRANCHES 69141 . 71738) (GIT-BRANCH-EXISTS? 71740 . 72611) (GIT-PICK-BRANCH 72613 . 73103) (
|
||||
GIT-BRANCH-MENU 73105 . 73994) (GIT-BRANCH-WHENSELECTEDFN 73996 . 75535) (GIT-PULL-REQUESTS 75537 .
|
||||
79422) (GIT-SHORT-BRANCH-NAME 79424 . 79715) (GIT-LONG-NAME 79717 . 80034) (GIT-PRC-BRANCHES 80036 .
|
||||
83043)) (83075 87829 (GIT-MY-CURRENT-BRANCH 83085 . 83455) (GIT-MY-BRANCHP 83457 . 84075) (
|
||||
GIT-MY-NEXT-BRANCH 84077 . 85877) (GIT-MY-BRANCHES 85879 . 87827)) (87875 91959 (GIT-ADD-WORKTREE
|
||||
87885 . 89492) (GIT-REMOVE-WORKTREE 89494 . 90426) (GIT-LIST-WORKTREES 90428 . 91239) (WORKTREEDIR
|
||||
91241 . 91957)) (92007 125045 (GIT-GET-DIFFERENT-FILES 92017 . 98925) (
|
||||
GIT-BRANCHES-COMPARE-DIRECTORIES 98927 . 106566) (GIT-WORKING-COMPARE-DIRECTORIES 106568 . 112370) (
|
||||
GIT-COMPARE-WORKTREE 112372 . 116350) (GITCDOBJBUTTONFN 116352 . 120850) (GIT-CD-LABELFN 120852 .
|
||||
121938) (GIT-CD-MENUFN 121940 . 123026) (GIT-WORKING-COMPARE-FILES 123028 . 123648) (
|
||||
GIT-BRANCHES-COMPARE-FILES 123650 . 124814) (GIT-PR-COMPARE 124816 . 125043)) (125115 133446 (CDGITDIR
|
||||
125125 . 125812) (GIT-COMMAND 125814 . 127372) (GITORIGIN 127374 . 128071) (GIT-INITIALS 128073 .
|
||||
128377) (GIT-COMMAND-TO-FILE 128379 . 131864) (GIT-RESULT-TO-LINES 131866 . 132779) (STRIPLOCAL 132781
|
||||
. 133444)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,22 +1,21 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10 :FORMAT :UTF-8)
|
||||
|
||||
(FILECREATED "27-Jan-2025 08:49:34" {WMEDLEY}<lispusers>VERSIONDEFS.;12 5880
|
||||
(FILECREATED " 7-Mar-2026 22:55:43" {WMEDLEY}<lispusers>VERSIONDEFS.;18 6534
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS GETVINFO)
|
||||
|
||||
:PREVIOUS-DATE "12-Dec-2024 15:07:45" {WMEDLEY}<lispusers>VERSIONDEFS.;11)
|
||||
:PREVIOUS-DATE " 6-Mar-2026 22:47:25" {WMEDLEY}<lispusers>VERSIONDEFS.;17)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT VERSIONDEFSCOMS)
|
||||
|
||||
(RPAQQ VERSIONDEFSCOMS [(FNS FINDFILEVERSION GETVINFO VERSIONP)
|
||||
(FNS EDV DFV)
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
|
||||
(ADDVARS (NLAMA DFV EDV)
|
||||
(NLAML)
|
||||
(LAMA])
|
||||
(RPAQQ VERSIONDEFSCOMS
|
||||
[(FNS FINDFILEVERSION GETVINFO VERSIONP)
|
||||
(FNS EDV DFV)
|
||||
(PROP ARGNAMES EDV DFV)
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA DFV EDV)
|
||||
(NLAML)
|
||||
(LAMA])
|
||||
(DEFINEQ
|
||||
|
||||
(FINDFILEVERSION
|
||||
@@ -119,16 +118,26 @@
|
||||
(CAR VINFO])
|
||||
|
||||
(DFV
|
||||
[NLAMBDA ARGS (* ; "Edited 6-Dec-2024 21:29 by rmk")
|
||||
[NLAMBDA ARGS (* ; "Edited 6-Mar-2026 22:42 by rmk")
|
||||
(* ; "Edited 6-Dec-2024 21:29 by rmk")
|
||||
(* ; "Edited 2-Dec-2024 00:08 by rmk")
|
||||
(SETQ ARGS (MKLIST ARGS))
|
||||
(APPLY (FUNCTION EDV)
|
||||
(LIST (POP ARGS)
|
||||
NIL
|
||||
(POP ARGS)
|
||||
(POP ARGS)
|
||||
(POP ARGS])
|
||||
(LET ((NAME (POP ARGS))) (* ; "If FNS and FUNCTIONS, show both")
|
||||
(CL:WHEN (HASDEF NAME 'FUNCTIONS '?)
|
||||
(APPLY (FUNCTION EDV)
|
||||
(LIST NAME 'FUNCTIONS (POP ARGS)
|
||||
(POP ARGS)
|
||||
(POP ARGS))))
|
||||
(CL:WHEN (HASDEF NAME 'FNS '?)
|
||||
(APPLY (FUNCTION EDV)
|
||||
(LIST NAME 'FNS (POP ARGS)
|
||||
(POP ARGS)
|
||||
(POP ARGS))))])
|
||||
)
|
||||
|
||||
(PUTPROPS EDV ARGNAMES (NAME TYPE FILE VERSION DIRLST . VINFO))
|
||||
|
||||
(PUTPROPS DFV ARGNAMES (NAME FILE VERSION DIRLST . VINFO))
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
|
||||
|
||||
(ADDTOVAR NLAMA DFV EDV)
|
||||
@@ -138,6 +147,6 @@
|
||||
(ADDTOVAR LAMA )
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (671 4570 (FINDFILEVERSION 681 . 2128) (GETVINFO 2130 . 4253) (VERSIONP 4255 . 4568)) (
|
||||
4571 5717 (EDV 4581 . 5281) (DFV 5283 . 5715)))))
|
||||
(FILEMAP (NIL (706 4605 (FINDFILEVERSION 716 . 2163) (GETVINFO 2165 . 4288) (VERSIONP 4290 . 4603)) (
|
||||
4606 6230 (EDV 4616 . 5316) (DFV 5318 . 6228)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10)
|
||||
|
||||
(FILECREATED "25-Feb-2026 15:03:24" {WMEDLEY}<sources>BOOTSTRAP.;69 47041
|
||||
(FILECREATED " 2-Mar-2026 12:03:05" {WMEDLEY}<sources>BOOTSTRAP.;71 47856
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS MAKE-DEFINE-FILE-INFO-ENV READ-READER-ENVIRONMENT)
|
||||
:CHANGES-TO (FNS READ-READER-ENVIRONMENT)
|
||||
|
||||
:PREVIOUS-DATE "25-Feb-2026 13:52:00" {WMEDLEY}<sources>BOOTSTRAP.;66)
|
||||
:PREVIOUS-DATE "25-Feb-2026 15:03:24" {WMEDLEY}<sources>BOOTSTRAP.;69)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT BOOTSTRAPCOMS)
|
||||
@@ -800,7 +800,9 @@
|
||||
(TERPRI STREAM)))])
|
||||
|
||||
(READ-READER-ENVIRONMENT
|
||||
[LAMBDA (STREAM DEFAULTENV RETURNFORM) (* ; "Edited 25-Feb-2026 14:15 by rmk")
|
||||
[LAMBDA (STREAM DEFAULTENV RETURNFORM) (* ; "Edited 2-Mar-2026 12:03 by rmk")
|
||||
(* ; "Edited 1-Mar-2026 10:49 by rmk")
|
||||
(* ; "Edited 25-Feb-2026 14:15 by rmk")
|
||||
(* ; "Edited 26-Sep-2021 23:31 by rmk:")
|
||||
|
||||
(* ;; "Starting environment is the old interlisp file, just for the seprchar scans.")
|
||||
@@ -809,42 +811,49 @@
|
||||
|
||||
(* ;; "RETURNFORM=T means return the DEFINE-FILE-INFO as a second value, for READFILE")
|
||||
|
||||
(CL:UNLESS DEFAULTENV (SETQ DEFAULTENV *OLD-INTERLISP-READ-ENVIRONMENT*))
|
||||
(LET ((START (GETFILEPTR STREAM))
|
||||
ARGS
|
||||
(ENV DEFAULTENV)
|
||||
(*READTABLE* (FETCH (READER-ENVIRONMENT REREADTABLE) OF *OLD-INTERLISP-READ-ENVIRONMENT*)))
|
||||
(DECLARE (SPECVARS *READTABLE*))
|
||||
(SETFILEPTR STREAM 0) (* ; "Hope we are RANDACCESSP")
|
||||
(SELCHARQ (SKIPSEPRCODES STREAM)
|
||||
(";" (* ; "Assume it's a common lisp file")
|
||||
(\EXTERNALFORMAT STREAM (FETCH (READER-ENVIRONMENT REFORMAT) OF
|
||||
(if (\GETSTREAM STREAM 'INPUT T)
|
||||
then (CL:UNLESS DEFAULTENV (SETQ DEFAULTENV *OLD-INTERLISP-READ-ENVIRONMENT*))
|
||||
(LET ((START (GETFILEPTR STREAM))
|
||||
ARGS
|
||||
(ENV DEFAULTENV)
|
||||
(*READTABLE* (FETCH (READER-ENVIRONMENT REREADTABLE) OF
|
||||
*OLD-INTERLISP-READ-ENVIRONMENT*
|
||||
)))
|
||||
(DECLARE (SPECVARS *READTABLE*))
|
||||
(SETFILEPTR STREAM 0) (* ; "Hope we are RANDACCESSP")
|
||||
(SELCHARQ (SKIPSEPRCODES STREAM)
|
||||
(";" (* ; "Assume it's a common lisp file")
|
||||
(\EXTERNALFORMAT STREAM (FETCH (READER-ENVIRONMENT REFORMAT) OF
|
||||
*COMMON-LISP-READ-ENVIRONMENT*
|
||||
))
|
||||
*COMMON-LISP-READ-ENVIRONMENT*)
|
||||
("(" (\EXTERNALFORMAT STREAM (FETCH (READER-ENVIRONMENT REFORMAT) OF
|
||||
))
|
||||
*COMMON-LISP-READ-ENVIRONMENT*)
|
||||
("(" (\EXTERNALFORMAT STREAM (FETCH (READER-ENVIRONMENT REFORMAT) OF
|
||||
*DEFINE-FILE-INFO-ENV*
|
||||
)) (* ;
|
||||
))(* ;
|
||||
"Should we reset the format if we fail?")
|
||||
(READCCODE STREAM)
|
||||
(WITH-READER-ENVIRONMENT *DEFINE-FILE-INFO-ENV*
|
||||
(if (STREQUAL "DEFINE-FILE-INFO" (RSTRING STREAM))
|
||||
then
|
||||
(* ;;
|
||||
(READCCODE STREAM)
|
||||
(WITH-READER-ENVIRONMENT *DEFINE-FILE-INFO-ENV*
|
||||
(if (STREQUAL "DEFINE-FILE-INFO" (RSTRING STREAM))
|
||||
then
|
||||
(* ;;
|
||||
"After the \DO-DEFINE-FILE-INFO, we have the new environment and we have set the new format.")
|
||||
|
||||
(SETQ ARGS (CL:READ-DELIMITED-LIST (CHARCODE ")")
|
||||
STREAM))
|
||||
(SETQ ENV (\DO-DEFINE-FILE-INFO STREAM ARGS))
|
||||
else (SETFILEPTR STREAM START))
|
||||
(SETQ ARGS (CL:READ-DELIMITED-LIST (CHARCODE ")")
|
||||
STREAM))
|
||||
(SETQ ENV (\DO-DEFINE-FILE-INFO STREAM ARGS))
|
||||
else (SETFILEPTR STREAM START))
|
||||
|
||||
(* ;;
|
||||
(* ;;
|
||||
"If we didn't see ARGS, then we didn't see a DEFINE-FILE-INFO, no form to return.")
|
||||
|
||||
(CL:IF (AND RETURNFORM ARGS)
|
||||
(CL:VALUES ENV (CONS 'DEFINE-FILE-INFO ARGS))
|
||||
ENV)))
|
||||
DEFAULTENV])
|
||||
(CL:IF (AND RETURNFORM ARGS)
|
||||
(CL:VALUES ENV (CONS 'DEFINE-FILE-INFO ARGS))
|
||||
ENV)))
|
||||
DEFAULTENV))
|
||||
else (CL:WITH-OPEN-FILE (STRM (OR (FINDFILE STREAM T)
|
||||
STREAM)
|
||||
:DIRECTION :INPUT)
|
||||
(READ-READER-ENVIRONMENT STRM DEFAULTENV RETURNFORM])
|
||||
|
||||
(MAKE-DEFINE-FILE-INFO-ENV
|
||||
[LAMBDA NIL (* ; "Edited 25-Feb-2026 15:03 by rmk")
|
||||
@@ -969,13 +978,13 @@
|
||||
(ADDTOVAR LAMA )
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (4621 14293 (GETPROP 4631 . 5203) (SETATOMVAL 5205 . 5334) (RPAQQ 5336 . 5389) (RPAQ
|
||||
5391 . 5703) (RPAQ? 5705 . 6075) (MOVD 6077 . 7941) (MOVD? 7943 . 8373) (SELECTQ 8375 . 8562) (
|
||||
SELECTQ1 8564 . 8906) (NCONC1 8908 . 9104) (PUTPROP 9106 . 10590) (PROPNAMES 10592 . 10783) (ADDPROP
|
||||
10785 . 12848) (REMPROP 12850 . 13704) (MEMB 13706 . 13965) (CLOSEF? 13967 . 14291)) (14366 34343 (
|
||||
LOAD 14376 . 15545) (\LOAD-STREAM 15547 . 28034) (FILECREATED 28036 . 29454) (FILECREATED1 29456 .
|
||||
30564) (PRETTYCOMPRINT 30566 . 31051) (BOOTSTRAP-NAMEFIELD 31053 . 32013) (PUTPROPS 32015 . 32383) (
|
||||
DECLARE%: 32385 . 32517) (DECLARE%:1 32519 . 33391) (ROOTFILENAME 33393 . 34341)) (34381 44987 (
|
||||
DEFINE-FILE-INFO 34391 . 34826) (\DO-DEFINE-FILE-INFO 34828 . 38971) (PRINT-READER-ENVIRONMENT 38973
|
||||
. 40725) (READ-READER-ENVIRONMENT 40727 . 43553) (MAKE-DEFINE-FILE-INFO-ENV 43555 . 44985)))))
|
||||
(FILEMAP (NIL (4595 14267 (GETPROP 4605 . 5177) (SETATOMVAL 5179 . 5308) (RPAQQ 5310 . 5363) (RPAQ
|
||||
5365 . 5677) (RPAQ? 5679 . 6049) (MOVD 6051 . 7915) (MOVD? 7917 . 8347) (SELECTQ 8349 . 8536) (
|
||||
SELECTQ1 8538 . 8880) (NCONC1 8882 . 9078) (PUTPROP 9080 . 10564) (PROPNAMES 10566 . 10757) (ADDPROP
|
||||
10759 . 12822) (REMPROP 12824 . 13678) (MEMB 13680 . 13939) (CLOSEF? 13941 . 14265)) (14340 34317 (
|
||||
LOAD 14350 . 15519) (\LOAD-STREAM 15521 . 28008) (FILECREATED 28010 . 29428) (FILECREATED1 29430 .
|
||||
30538) (PRETTYCOMPRINT 30540 . 31025) (BOOTSTRAP-NAMEFIELD 31027 . 31987) (PUTPROPS 31989 . 32357) (
|
||||
DECLARE%: 32359 . 32491) (DECLARE%:1 32493 . 33365) (ROOTFILENAME 33367 . 34315)) (34355 45802 (
|
||||
DEFINE-FILE-INFO 34365 . 34800) (\DO-DEFINE-FILE-INFO 34802 . 38945) (PRINT-READER-ENVIRONMENT 38947
|
||||
. 40699) (READ-READER-ENVIRONMENT 40701 . 44368) (MAKE-DEFINE-FILE-INFO-ENV 44370 . 45800)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10)
|
||||
|
||||
(FILECREATED "11-Sep-2025 16:49:07" {WMEDLEY}<sources>COREIO.;18 56903
|
||||
(FILECREATED "28-Feb-2026 12:09:38" {WMEDLEY}<sources>COREIO.;20 57201
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \CORE.DIRECTORYNAMEP)
|
||||
|
||||
:PREVIOUS-DATE " 5-Jun-2022 00:14:07" {WMEDLEY}<sources>COREIO.;17)
|
||||
:PREVIOUS-DATE "11-Sep-2025 16:49:07" {WMEDLEY}<sources>COREIO.;18)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT COREIOCOMS)
|
||||
@@ -89,6 +89,8 @@
|
||||
(\CORE.DIRECTORYNAMEP
|
||||
[LAMBDA (DIRNAME DEV)
|
||||
|
||||
(* ;; "Edited 28-Feb-2026 12:08 by rmk")
|
||||
|
||||
(* ;; "Edited 11-Sep-2025 16:48 by rmk")
|
||||
|
||||
(* ;; "Edited 18-Jan-2022 11:17 by rmk")
|
||||
@@ -106,18 +108,21 @@
|
||||
|
||||
(* ;; "Returns NIL for a DIRNAME of just {CORE}, or {CORE}xxx. If the latter, then we want it to be a directory and not a file (assuming that xxx and xxx> can't both exist.")
|
||||
|
||||
[LET [(DIR (FILENAMEFIELD DIRNAME 'DIRECTORY]
|
||||
(CL:WHEN DIR
|
||||
(SETQ DIR (CONCAT DIR ">"))
|
||||
(LET [(DIR (FILENAMEFIELD DIRNAME 'DIRECTORY]
|
||||
(if DIR
|
||||
then (SETQ DIR (CONCAT DIR ">"))
|
||||
|
||||
(* ;; "DIRPOS because caller may not have stripped off the device. This will match the first < or / (or >)")
|
||||
(* ;; "DIRPOS because caller may not have stripped off the device. This will match the first < or / (or >)")
|
||||
|
||||
(FOR ENTRY (DIRPOS _ (STRPOS "<" DIRNAME 1 NIL NIL NIL FILEDIRCASEARRAY))
|
||||
FIRST (CL:UNLESS (EQ DIRPOS 1)
|
||||
(SETQ DIRNAME (SUBSTRING DIRNAME DIRPOS)))
|
||||
IN (CDR (FETCH COREDIRECTORY OF DEV))
|
||||
WHEN (STRPOS DIRNAME (CAR ENTRY)
|
||||
1 NIL T NIL FILEDIRCASEARRAY) DO (RETURN T)))])])
|
||||
(FOR ENTRY (DIRPOS _ (STRPOS "<" DIRNAME 1 NIL NIL NIL FILEDIRCASEARRAY))
|
||||
FIRST (CL:UNLESS (EQ DIRPOS 1)
|
||||
(SETQ DIRNAME (SUBSTRING DIRNAME DIRPOS)))
|
||||
IN (CDR (FETCH COREDIRECTORY OF DEV))
|
||||
WHEN (STRPOS DIRNAME (CAR ENTRY)
|
||||
1 NIL T NIL FILEDIRCASEARRAY) DO (RETURN T))
|
||||
else (* ;
|
||||
"Top level: does the device exist at al. The cd {CORE}case")
|
||||
T)))])
|
||||
|
||||
(\CORE.FINDPAGE
|
||||
[LAMBDA (STREAM PN) (* bvm%: "20-Apr-85 13:32")
|
||||
@@ -997,16 +1002,16 @@
|
||||
)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1572 46115 (\CORE.CLOSEFILE 1582 . 2355) (\CORE.DELETEFILE 2357 . 4343) (
|
||||
\CORE.DIRECTORYNAMEP 4345 . 5838) (\CORE.FINDPAGE 5840 . 9069) (\CORE.GENERATEFILES 9071 . 11658) (
|
||||
\CORE.NEXTFILEFN 11660 . 12159) (\CORE.FILEINFOFN 12161 . 12390) (\CORE.GETFILEHANDLE 12392 . 14546) (
|
||||
\CORE.GETFILEINFO 14548 . 15511) (\CORE.GETFILEINFO.FROM.INFOBLOCK 15513 . 17050) (\CORE.GETFILENAME
|
||||
17052 . 19341) (\CORE.GETINFOBLOCK 19343 . 21966) (\CORE.NAMESCAN 21968 . 23515) (\CORE.NAMESEGMENT
|
||||
23517 . 23954) (\CORE.OPENFILE 23956 . 27348) (\COREFILE.SETPARAMETERS 27350 . 29531) (
|
||||
\CORE.PACKFILENAME 29533 . 29928) (\CORE.RELEASEPAGES 29930 . 30531) (\CORE.SETFILEPTR 30533 . 31632)
|
||||
(\CORE.UPDATEOF 31634 . 33263) (\CORE.BACKFILEPTR 33265 . 35473) (\CORE.SETEOFPTR 35475 . 37344) (
|
||||
\CORE.SETACCESSTIME 37346 . 37971) (\CORE.SETFILEINFO 37973 . 40275) (\CORE.GETNEXTBUFFER 40277 .
|
||||
44233) (\CORE.UNPACKFILENAME 44235 . 46113)) (46116 49749 (COREDEVICE 46126 . 46297) (
|
||||
\CREATECOREDEVICE 46299 . 49747)) (49750 52164 (\NODIRCOREFDEV 49760 . 50357) (\NODIRCORE.OPENFILE
|
||||
50359 . 52162)))))
|
||||
(FILEMAP (NIL (1572 46413 (\CORE.CLOSEFILE 1582 . 2355) (\CORE.DELETEFILE 2357 . 4343) (
|
||||
\CORE.DIRECTORYNAMEP 4345 . 6136) (\CORE.FINDPAGE 6138 . 9367) (\CORE.GENERATEFILES 9369 . 11956) (
|
||||
\CORE.NEXTFILEFN 11958 . 12457) (\CORE.FILEINFOFN 12459 . 12688) (\CORE.GETFILEHANDLE 12690 . 14844) (
|
||||
\CORE.GETFILEINFO 14846 . 15809) (\CORE.GETFILEINFO.FROM.INFOBLOCK 15811 . 17348) (\CORE.GETFILENAME
|
||||
17350 . 19639) (\CORE.GETINFOBLOCK 19641 . 22264) (\CORE.NAMESCAN 22266 . 23813) (\CORE.NAMESEGMENT
|
||||
23815 . 24252) (\CORE.OPENFILE 24254 . 27646) (\COREFILE.SETPARAMETERS 27648 . 29829) (
|
||||
\CORE.PACKFILENAME 29831 . 30226) (\CORE.RELEASEPAGES 30228 . 30829) (\CORE.SETFILEPTR 30831 . 31930)
|
||||
(\CORE.UPDATEOF 31932 . 33561) (\CORE.BACKFILEPTR 33563 . 35771) (\CORE.SETEOFPTR 35773 . 37642) (
|
||||
\CORE.SETACCESSTIME 37644 . 38269) (\CORE.SETFILEINFO 38271 . 40573) (\CORE.GETNEXTBUFFER 40575 .
|
||||
44531) (\CORE.UNPACKFILENAME 44533 . 46411)) (46414 50047 (COREDEVICE 46424 . 46595) (
|
||||
\CREATECOREDEVICE 46597 . 50045)) (50048 52462 (\NODIRCOREFDEV 50058 . 50655) (\NODIRCORE.OPENFILE
|
||||
50657 . 52460)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
528
sources/LLETHER
528
sources/LLETHER
@@ -1,15 +1,13 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED " 3-May-2021 23:13:56" {DSK}<home>larry>ilisp>medley>sources>LLETHER.;4 139646
|
||||
|
||||
changes to%: (FNS \ETHEREVENTFN \ETHER-AVAILABLE)
|
||||
(VARS LLETHERCOMS)
|
||||
(FILECREATED "23-Jan-2026 12:42:02" {DSK}<Users>briggs>PROJECTS>Medley>sources>LLETHER.;4 138728
|
||||
|
||||
previous date%: " 2-May-2021 12:37:02" {DSK}<home>larry>ilisp>medley>sources>LLETHER.;3)
|
||||
:EDIT-BY nhb
|
||||
|
||||
:CHANGES-TO (FNS \SETETHERFLAGS)
|
||||
|
||||
:PREVIOUS-DATE "20-Dec-2025 14:12:06" {DSK}<Users>briggs>PROJECTS>Medley>sources>LLETHER.;3)
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1982-1988, 1990-1993, 2021 by Venue & Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT LLETHERCOMS)
|
||||
|
||||
@@ -17,19 +15,19 @@ Copyright (c) 1982-1988, 1990-1993, 2021 by Venue & Xerox Corporation.
|
||||
[(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (SOURCE)
|
||||
LLNSDECLS))
|
||||
[COMS (* ;
|
||||
"Stuff that should be somewhere else!")
|
||||
"Stuff that should be somewhere else!")
|
||||
(INITVARS (ERRORMESSAGESTREAM T)
|
||||
(PROMPTWINDOW T))
|
||||
(GLOBALVARS ERRORMESSAGESTREAM PROMPTWINDOW)
|
||||
(COMS (* ;
|
||||
"Queue management for data which can be chain-linked through the first cell")
|
||||
"Queue management for data which can be chain-linked through the first cell")
|
||||
(DECLARE%: DONTCOPY (EXPORT (RECORDS SYSQUEUE QABLEITEM)
|
||||
(MACROS \QUEUEHEAD)))
|
||||
(INITRECORDS SYSQUEUE)
|
||||
(SYSRECORDS SYSQUEUE)
|
||||
(FNS CANONICAL.HOSTNAME \ENQUEUE \DEQUEUE \QUEUELENGTH \ONQUEUE \UNQUEUE)
|
||||
(* ;
|
||||
"Queue management constructed by TCONC")
|
||||
"Queue management constructed by TCONC")
|
||||
(EXPORT (MACROS \DETCONC \ENTCONC \PEEKTCONC]
|
||||
(COMS (* ; "General packet management")
|
||||
(DECLARE%: DONTCOPY
|
||||
@@ -124,7 +122,7 @@ Copyright (c) 1982-1988, 1990-1993, 2021 by Venue & Xerox Corporation.
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (GLOBALVARS \CENTICLOCKFACTOR \CENTICLOCKBOX)
|
||||
(RECORDS CENTICLOCK)))
|
||||
(COMS (* ;
|
||||
"3MB stuff, which is not needed in DandeLion")
|
||||
"3MB stuff, which is not needed in DandeLion")
|
||||
(FNS \3MBGETPACKET \3MB.CREATENDB \3MBSENDPACKET \3MBWATCHER \3MBENCAPSULATE
|
||||
\3MB.BROADCASTP \3MBFLUSH)
|
||||
(INITVARS (\MAXWATCHERGETS 5))
|
||||
@@ -168,19 +166,18 @@ Copyright (c) 1982-1988, 1990-1993, 2021 by Venue & Xerox Corporation.
|
||||
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(DATATYPE SYSQUEUE ((NIL BYTE)
|
||||
(SYSQUEUEHEAD POINTER)
|
||||
(NIL BYTE)
|
||||
(SYSQUEUETAIL POINTER)))
|
||||
(SYSQUEUEHEAD POINTER)
|
||||
(NIL BYTE)
|
||||
(SYSQUEUETAIL POINTER)))
|
||||
|
||||
(BLOCKRECORD QABLEITEM ((NIL BITS 4)
|
||||
(QLINK POINTER) (* ;
|
||||
"Link to next thing in queue always in first pointer of datum, independent of what the datum is")
|
||||
)
|
||||
(BLOCKRECORD QABLEITEM ((NIL BITS 4)
|
||||
(LINK POINTER)
|
||||
(* ;
|
||||
"Let's also be able to call it a LINK")
|
||||
)))
|
||||
(QLINK POINTER) (* ;
|
||||
"Link to next thing in queue always in first pointer of datum, independent of what the datum is")
|
||||
)
|
||||
(BLOCKRECORD QABLEITEM ((NIL BITS 4)
|
||||
(LINK POINTER)(* ;
|
||||
"Let's also be able to call it a LINK")
|
||||
)))
|
||||
)
|
||||
|
||||
(/DECLAREDATATYPE 'SYSQUEUE '(BYTE POINTER BYTE POINTER)
|
||||
@@ -192,7 +189,7 @@ Copyright (c) 1982-1988, 1990-1993, 2021 by Venue & Xerox Corporation.
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS \QUEUEHEAD MACRO ((Q)
|
||||
(fetch (SYSQUEUE SYSQUEUEHEAD) of Q)))
|
||||
(fetch (SYSQUEUE SYSQUEUEHEAD) of Q)))
|
||||
)
|
||||
|
||||
(* "END EXPORTED DEFINITIONS")
|
||||
@@ -208,9 +205,9 @@ Copyright (c) 1982-1988, 1990-1993, 2021 by Venue & Xerox Corporation.
|
||||
(ADDTOVAR SYSTEMRECLST
|
||||
|
||||
(DATATYPE SYSQUEUE ((NIL BYTE)
|
||||
(SYSQUEUEHEAD POINTER)
|
||||
(NIL BYTE)
|
||||
(SYSQUEUETAIL POINTER)))
|
||||
(SYSQUEUEHEAD POINTER)
|
||||
(NIL BYTE)
|
||||
(SYSQUEUETAIL POINTER)))
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
@@ -362,9 +359,9 @@ Copyright (c) 1982-1988, 1990-1993, 2021 by Venue & Xerox Corporation.
|
||||
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS \DETCONC MACRO [OPENLAMBDA (TQ)
|
||||
(PROG1 (\PEEKTCONC TQ)
|
||||
(if [NULL (CAR (RPLACA TQ (CDAR TQ]
|
||||
then (RPLACD TQ)))])
|
||||
(PROG1 (\PEEKTCONC TQ)
|
||||
(if [NULL (CAR (RPLACA TQ (CDAR TQ]
|
||||
then (RPLACD TQ)))])
|
||||
|
||||
(PUTPROPS \ENTCONC MACRO (= . TCONC))
|
||||
|
||||
@@ -382,48 +379,48 @@ Copyright (c) 1982-1988, 1990-1993, 2021 by Venue & Xerox Corporation.
|
||||
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(DATATYPE ETHERPACKET ((NIL BYTE)
|
||||
(EPLINK POINTER) (* ; "For queue maintenence")
|
||||
(EPFLAGS BYTE) (* ;
|
||||
"optional flags for some applications")
|
||||
(EPUSERFIELD POINTER) (* ;
|
||||
"Arbitrary pointer for applications")
|
||||
(NIL BYTE)
|
||||
(EPPLIST POINTER) (* ;
|
||||
"Extra field for use as an A-list for properties")
|
||||
(EPTRANSMITTING FLAG) (* ;
|
||||
"True while packet is being transmitted and hence cannot be reused")
|
||||
(EPRECEIVING FLAG) (* ;
|
||||
"True when a packet has been seen at the head of the network's input queue at least once")
|
||||
(NIL BITS 6)
|
||||
(EPREQUEUE POINTER) (* ;
|
||||
"Where to requeue this packet after transmission")
|
||||
(NIL BYTE)
|
||||
(EPSOCKET POINTER)
|
||||
(NIL BYTE)
|
||||
(EPNETWORK POINTER)
|
||||
(EPTYPE WORD) (* ;
|
||||
"Type of packet to be encapsulated (PUP or XIP or 10TO3)")
|
||||
(NIL WORD)
|
||||
(EPTIMESTAMP FIXP) (* ;
|
||||
"Gets RCLK value when transmitted/received")
|
||||
(EPREQUEUEFN POINTER) (* ; "FN to perform requeueing")
|
||||
(NIL 4 WORD) (* ; "Space for expansion")
|
||||
(EPLINK POINTER) (* ; "For queue maintenence")
|
||||
(EPFLAGS BYTE) (* ;
|
||||
"optional flags for some applications")
|
||||
(EPUSERFIELD POINTER) (* ;
|
||||
"Arbitrary pointer for applications")
|
||||
(NIL BYTE)
|
||||
(EPPLIST POINTER) (* ;
|
||||
"Extra field for use as an A-list for properties")
|
||||
(EPTRANSMITTING FLAG) (* ;
|
||||
"True while packet is being transmitted and hence cannot be reused")
|
||||
(EPRECEIVING FLAG) (* ;
|
||||
"True when a packet has been seen at the head of the network's input queue at least once")
|
||||
(NIL BITS 6)
|
||||
(EPREQUEUE POINTER) (* ;
|
||||
"Where to requeue this packet after transmission")
|
||||
(NIL BYTE)
|
||||
(EPSOCKET POINTER)
|
||||
(NIL BYTE)
|
||||
(EPNETWORK POINTER)
|
||||
(EPTYPE WORD) (* ;
|
||||
"Type of packet to be encapsulated (PUP or XIP or 10TO3)")
|
||||
(NIL WORD)
|
||||
(EPTIMESTAMP FIXP) (* ;
|
||||
"Gets RCLK value when transmitted/received")
|
||||
(EPREQUEUEFN POINTER) (* ; "FN to perform requeueing")
|
||||
(NIL 4 WORD) (* ; "Space for expansion")
|
||||
(* ;
|
||||
"Note: This next field wants to be quad+2 aligned so that the 10mb packet is quad+3 aligned")
|
||||
(EPENCAPSULATION 8 WORD) (* ;
|
||||
"10mb encapsulation, or 3mb encapsulation with padding")
|
||||
(EPBODY 289 WORD) (* ;
|
||||
"Body of packet, header up to 16 words plus data up to 546 bytes")
|
||||
))
|
||||
"Note: This next field wants to be quad+2 aligned so that the 10mb packet is quad+3 aligned")
|
||||
(EPENCAPSULATION 8 WORD) (* ;
|
||||
"10mb encapsulation, or 3mb encapsulation with padding")
|
||||
(EPBODY 289 WORD) (* ;
|
||||
"Body of packet, header up to 16 words plus data up to 546 bytes")
|
||||
))
|
||||
|
||||
(ACCESSFNS ETHERAUX ((AUXPTR (CDR (ASSOC 'AUXPTR (fetch EPPLIST of DATUM)))
|
||||
(\EP.PUT.AUX DATUM 'AUXPTR NEWVALUE))
|
||||
(AUXWORD (OR (CDR (ASSOC 'AUXWORD (fetch EPPLIST of DATUM)))
|
||||
0)
|
||||
(\EP.PUT.AUX DATUM 'AUXWORD NEWVALUE))
|
||||
(AUXBYTE (OR (CDR (ASSOC 'AUXBYTE (fetch EPPLIST of DATUM)))
|
||||
0)
|
||||
(\EP.PUT.AUX DATUM 'AUXBYTE NEWVALUE))))
|
||||
(\EP.PUT.AUX DATUM 'AUXPTR NEWVALUE))
|
||||
(AUXWORD (OR (CDR (ASSOC 'AUXWORD (fetch EPPLIST of DATUM)))
|
||||
0)
|
||||
(\EP.PUT.AUX DATUM 'AUXWORD NEWVALUE))
|
||||
(AUXBYTE (OR (CDR (ASSOC 'AUXBYTE (fetch EPPLIST of DATUM)))
|
||||
0)
|
||||
(\EP.PUT.AUX DATUM 'AUXBYTE NEWVALUE))))
|
||||
)
|
||||
|
||||
(/DECLAREDATATYPE 'ETHERPACKET
|
||||
@@ -1140,26 +1137,26 @@ Copyright (c) 1982-1988, 1990-1993, 2021 by Venue & Xerox Corporation.
|
||||
(ADDTOVAR SYSTEMRECLST
|
||||
|
||||
(DATATYPE ETHERPACKET ((NIL BYTE)
|
||||
(EPLINK POINTER)
|
||||
(EPFLAGS BYTE)
|
||||
(EPUSERFIELD POINTER)
|
||||
(NIL BYTE)
|
||||
(EPPLIST POINTER)
|
||||
(EPTRANSMITTING FLAG)
|
||||
(EPRECEIVING FLAG)
|
||||
(NIL BITS 6)
|
||||
(EPREQUEUE POINTER)
|
||||
(NIL BYTE)
|
||||
(EPSOCKET POINTER)
|
||||
(NIL BYTE)
|
||||
(EPNETWORK POINTER)
|
||||
(EPTYPE WORD)
|
||||
(NIL WORD)
|
||||
(EPTIMESTAMP FIXP)
|
||||
(EPREQUEUEFN POINTER)
|
||||
(NIL 4 WORD)
|
||||
(EPENCAPSULATION 8 WORD)
|
||||
(EPBODY 289 WORD)))
|
||||
(EPLINK POINTER)
|
||||
(EPFLAGS BYTE)
|
||||
(EPUSERFIELD POINTER)
|
||||
(NIL BYTE)
|
||||
(EPPLIST POINTER)
|
||||
(EPTRANSMITTING FLAG)
|
||||
(EPRECEIVING FLAG)
|
||||
(NIL BITS 6)
|
||||
(EPREQUEUE POINTER)
|
||||
(NIL BYTE)
|
||||
(EPSOCKET POINTER)
|
||||
(NIL BYTE)
|
||||
(EPNETWORK POINTER)
|
||||
(EPTYPE WORD)
|
||||
(NIL WORD)
|
||||
(EPTIMESTAMP FIXP)
|
||||
(EPREQUEUEFN POINTER)
|
||||
(NIL 4 WORD)
|
||||
(EPENCAPSULATION 8 WORD)
|
||||
(EPBODY 289 WORD)))
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
@@ -1499,21 +1496,19 @@ Copyright (c) 1982-1988, 1990-1993, 2021 by Venue & Xerox Corporation.
|
||||
HOSTNAMEP _ 'NILL])
|
||||
|
||||
(\ETHEREVENTFN
|
||||
[LAMBDA (DEV EVENT) (* ; "Edited 3-May-2021 23:12 by larry")
|
||||
[LAMBDA (DEV EVENT) (* ; "Edited 17-Dec-2025 11:01 by nhb")
|
||||
(* ; "Edited 3-May-2021 23:12 by larry")
|
||||
(PROG (NDB TURNOFFNS TIMESET)
|
||||
(SELECTQ EVENT
|
||||
((NIL AFTERLOGOUT AFTERSYSOUT AFTERMAKESYS AFTERSAVEVM RESTART)
|
||||
(SETQ \PUP.READY (SETQ \NS.READY (SETQ \IP.READY)))
|
||||
(OR (\ETHER-AVAILABLE)
|
||||
(RETURN))
|
||||
(\SETETHERFLAGS)
|
||||
(\SETLOCALNSNUMBERS)
|
||||
(\FLUSHNDBS EVENT)
|
||||
(SETQ \10MBLOCALNDB (COND
|
||||
(\10MBFLG (SETQ NDB (\10MB.CREATENDB \10MBFLG))
|
||||
(COND
|
||||
(\LOCALNDBS (replace NDBNEXT of
|
||||
\LOCALNDBS
|
||||
(\LOCALNDBS (replace NDBNEXT of \LOCALNDBS
|
||||
with NDB))
|
||||
(T (SETQ \LOCALNDBS NDB)))
|
||||
NDB)))
|
||||
@@ -1536,10 +1531,10 @@ Copyright (c) 1982-1988, 1990-1993, 2021 by Venue & Xerox Corporation.
|
||||
((BEFOREMAKESYS BEFORELOGOUT BEFORESYSOUT BEFORESAVEVM)
|
||||
(COND
|
||||
((EQ EVENT 'BEFORESAVEVM) (* ;
|
||||
"Save passwords in place outside vmem to avoid having to reenter them later")
|
||||
"Save passwords in place outside vmem to avoid having to reenter them later")
|
||||
(\STASH.PASSWORDS))
|
||||
(T (* ;
|
||||
"No need to flush this before SAVEVM")
|
||||
"No need to flush this before SAVEVM")
|
||||
(CLRHASH \ETHERPORTS)))
|
||||
(CLRHASH LOGINPASSWORDS))
|
||||
NIL])
|
||||
@@ -1556,11 +1551,13 @@ Copyright (c) 1982-1988, 1990-1993, 2021 by Venue & Xerox Corporation.
|
||||
(printout PROMPTWINDOW T "[Time not set]"])
|
||||
|
||||
(\SETETHERFLAGS
|
||||
[LAMBDA NIL (* ; "Edited 2-May-2021 12:35 by larry")
|
||||
[LAMBDA NIL (* ; "Edited 23-Jan-2026 12:39 by nhb")
|
||||
(* ; "Edited 2-May-2021 12:35 by larry")
|
||||
|
||||
(* ;; "for Medley there is no 3MB ethernet ; used to be conditional on \MACHINETYPE")
|
||||
|
||||
(SETQ \10MBFLG 0)
|
||||
(SETQ \10MBFLG (AND (\ETHER-AVAILABLE)
|
||||
0))
|
||||
(SETQ \3MBFLG NIL)
|
||||
(SETQ *MAXIMUM-PACKET-SIZE* (- (TIMES 2 BYTESPERPAGE)
|
||||
(UNFOLD (INDEXF (FETCH EPBODY))
|
||||
@@ -1706,40 +1703,40 @@ Copyright (c) 1982-1988, 1990-1993, 2021 by Venue & Xerox Corporation.
|
||||
(DECLARE%: DONTCOPY
|
||||
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(DATATYPE NDB ((NETTYPE BYTE) (* ; "10 or 3 for now")
|
||||
(NDBNEXT POINTER) (* ; "Link to next NDB")
|
||||
(NDBPUPNET# BYTE) (* ;
|
||||
"Pup number of this net. May be different from NS net number, though not in Xerox world")
|
||||
(NDBNSNET# POINTER) (* ;
|
||||
"Can be 32-bits, so might as well leave its box around")
|
||||
(NDBTASK# BYTE) (* ; "Task # of this network")
|
||||
(NDBBROADCASTP POINTER) (* ;
|
||||
"Function that returns true if packet is of broadcast type")
|
||||
(NDBPUPHOST# BYTE) (* ;
|
||||
"My pup address on this net. NS address is global to all nets, so not needed here")
|
||||
(NDBTRANSMITTER POINTER) (* ;
|
||||
"(NDB PACKET) -- fn to send a raw packet on this net. returns NIL on failure")
|
||||
(NIL BYTE)
|
||||
(NDBENCAPSULATOR POINTER) (* ;
|
||||
"(NDB PACKET HOST LENGTH TYPE) -- fn to encapsulate and send a higher-level packet on this net ")
|
||||
(NDBCSB POINTER) (* ; "Pointer to CSB for this network")
|
||||
(NDBIQLENGTH BYTE)
|
||||
(NDBIQ POINTER) (* ;
|
||||
"Queue of empty packets for receiver")
|
||||
(NDBTQ POINTER) (* ; "Queue of packets to transmit")
|
||||
(NDBTRANSLATIONS POINTER) (* ;
|
||||
"Cache of translations, 3:10 or 10:3 according to network")
|
||||
(NDBETHERFLUSHER POINTER) (* ; "Turns off this ether. Args NDB")
|
||||
(NDBWATCHER POINTER)
|
||||
(NDBCANHEARSELF POINTER) (* ;
|
||||
"True if receiver can hear packets sent by transmitter")
|
||||
(NDBIPNET# POINTER)
|
||||
(NDBIPHOST# POINTER)
|
||||
(NDBPUPTYPE WORD) (* ;
|
||||
"The packet encapsulation of PUP on this net")
|
||||
(NIL WORD)
|
||||
(NIL POINTER) (* ; "Spares")
|
||||
))
|
||||
(DATATYPE NDB ((NETTYPE BYTE) (* ; "10 or 3 for now")
|
||||
(NDBNEXT POINTER) (* ; "Link to next NDB")
|
||||
(NDBPUPNET# BYTE) (* ;
|
||||
"Pup number of this net. May be different from NS net number, though not in Xerox world")
|
||||
(NDBNSNET# POINTER) (* ;
|
||||
"Can be 32-bits, so might as well leave its box around")
|
||||
(NDBTASK# BYTE) (* ; "Task # of this network")
|
||||
(NDBBROADCASTP POINTER) (* ;
|
||||
"Function that returns true if packet is of broadcast type")
|
||||
(NDBPUPHOST# BYTE) (* ;
|
||||
"My pup address on this net. NS address is global to all nets, so not needed here")
|
||||
(NDBTRANSMITTER POINTER) (* ;
|
||||
"(NDB PACKET) -- fn to send a raw packet on this net. returns NIL on failure")
|
||||
(NIL BYTE)
|
||||
(NDBENCAPSULATOR POINTER) (* ;
|
||||
"(NDB PACKET HOST LENGTH TYPE) -- fn to encapsulate and send a higher-level packet on this net ")
|
||||
(NDBCSB POINTER) (* ; "Pointer to CSB for this network")
|
||||
(NDBIQLENGTH BYTE)
|
||||
(NDBIQ POINTER) (* ;
|
||||
"Queue of empty packets for receiver")
|
||||
(NDBTQ POINTER) (* ; "Queue of packets to transmit")
|
||||
(NDBTRANSLATIONS POINTER) (* ;
|
||||
"Cache of translations, 3:10 or 10:3 according to network")
|
||||
(NDBETHERFLUSHER POINTER) (* ; "Turns off this ether. Args NDB")
|
||||
(NDBWATCHER POINTER)
|
||||
(NDBCANHEARSELF POINTER) (* ;
|
||||
"True if receiver can hear packets sent by transmitter")
|
||||
(NDBIPNET# POINTER)
|
||||
(NDBIPHOST# POINTER)
|
||||
(NDBPUPTYPE WORD) (* ;
|
||||
"The packet encapsulation of PUP on this net")
|
||||
(NIL WORD)
|
||||
(NIL POINTER) (* ; "Spares")
|
||||
))
|
||||
|
||||
(RECORD ROUTING (RTNET# RTHOPCOUNT RTGATEWAY# RTNDB RTTIMER RTRECENT))
|
||||
)
|
||||
@@ -1786,26 +1783,24 @@ Copyright (c) 1982-1988, 1990-1993, 2021 by Venue & Xerox Corporation.
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS ENCAPSULATE.ETHERPACKET MACRO ((NDB PACKET HOST LENGTH TYPE)
|
||||
(SPREADAPPLY* (fetch NDBENCAPSULATOR
|
||||
of NDB)
|
||||
NDB PACKET HOST LENGTH TYPE)))
|
||||
(SPREADAPPLY* (fetch NDBENCAPSULATOR of NDB)
|
||||
NDB PACKET HOST LENGTH TYPE)))
|
||||
|
||||
(PUTPROPS TRANSMIT.ETHERPACKET MACRO ((NDB PACKET)
|
||||
(SPREADAPPLY* (fetch NDBTRANSMITTER of NDB)
|
||||
NDB PACKET)))
|
||||
(SPREADAPPLY* (fetch NDBTRANSMITTER of NDB)
|
||||
NDB PACKET)))
|
||||
|
||||
(PUTPROPS BROADCASTP MACRO ((PACKET)
|
||||
([LAMBDA (NDB)
|
||||
(AND NDB (APPLY* (fetch NDBBROADCASTP of NDB)
|
||||
PACKET NDB]
|
||||
(fetch EPNETWORK of PACKET))))
|
||||
([LAMBDA (NDB)
|
||||
(AND NDB (APPLY* (fetch NDBBROADCASTP of NDB)
|
||||
PACKET NDB]
|
||||
(fetch EPNETWORK of PACKET))))
|
||||
|
||||
(PUTPROPS \CHECK.ROUTING.TABLE MACRO [(TABLE)
|
||||
(if (NEQ (NTYPX TABLE)
|
||||
\ROUTING.TABLE.TYPENUM)
|
||||
then (CL:ERROR 'CONDITIONS:SIMPLE-TYPE-ERROR
|
||||
:CULPRIT TABLE :EXPECTED-TYPE
|
||||
'RoutingTable])
|
||||
(if (NEQ (NTYPX TABLE)
|
||||
\ROUTING.TABLE.TYPENUM)
|
||||
then (CL:ERROR 'CONDITIONS:SIMPLE-TYPE-ERROR :CULPRIT TABLE
|
||||
:EXPECTED-TYPE 'RoutingTable])
|
||||
)
|
||||
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
@@ -1851,28 +1846,28 @@ Copyright (c) 1982-1988, 1990-1993, 2021 by Venue & Xerox Corporation.
|
||||
(ADDTOVAR SYSTEMRECLST
|
||||
|
||||
(DATATYPE NDB ((NETTYPE BYTE)
|
||||
(NDBNEXT POINTER)
|
||||
(NDBPUPNET# BYTE)
|
||||
(NDBNSNET# POINTER)
|
||||
(NDBTASK# BYTE)
|
||||
(NDBBROADCASTP POINTER)
|
||||
(NDBPUPHOST# BYTE)
|
||||
(NDBTRANSMITTER POINTER)
|
||||
(NIL BYTE)
|
||||
(NDBENCAPSULATOR POINTER)
|
||||
(NDBCSB POINTER)
|
||||
(NDBIQLENGTH BYTE)
|
||||
(NDBIQ POINTER)
|
||||
(NDBTQ POINTER)
|
||||
(NDBTRANSLATIONS POINTER)
|
||||
(NDBETHERFLUSHER POINTER)
|
||||
(NDBWATCHER POINTER)
|
||||
(NDBCANHEARSELF POINTER)
|
||||
(NDBIPNET# POINTER)
|
||||
(NDBIPHOST# POINTER)
|
||||
(NDBPUPTYPE WORD)
|
||||
(NIL WORD)
|
||||
(NIL POINTER)))
|
||||
(NDBNEXT POINTER)
|
||||
(NDBPUPNET# BYTE)
|
||||
(NDBNSNET# POINTER)
|
||||
(NDBTASK# BYTE)
|
||||
(NDBBROADCASTP POINTER)
|
||||
(NDBPUPHOST# BYTE)
|
||||
(NDBTRANSMITTER POINTER)
|
||||
(NIL BYTE)
|
||||
(NDBENCAPSULATOR POINTER)
|
||||
(NDBCSB POINTER)
|
||||
(NDBIQLENGTH BYTE)
|
||||
(NDBIQ POINTER)
|
||||
(NDBTQ POINTER)
|
||||
(NDBTRANSLATIONS POINTER)
|
||||
(NDBETHERFLUSHER POINTER)
|
||||
(NDBWATCHER POINTER)
|
||||
(NDBCANHEARSELF POINTER)
|
||||
(NDBIPNET# POINTER)
|
||||
(NDBIPHOST# POINTER)
|
||||
(NDBPUPTYPE WORD)
|
||||
(NIL WORD)
|
||||
(NIL POINTER)))
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
@@ -2231,48 +2226,49 @@ Copyright (c) 1982-1988, 1990-1993, 2021 by Venue & Xerox Corporation.
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(ACCESSFNS ETHERTRANS [(TRANSBODY (LOCF (fetch (ETHERPACKET EPBODY) of DATUM]
|
||||
[BLOCKRECORD TRANSBODY ((TRANSOPERATION WORD)
|
||||
[BLOCKRECORD TRANSBODY ((TRANSOPERATION WORD)
|
||||
(* ; "Request or response")
|
||||
(BASETRANSNSHOST 3 WORD)
|
||||
(BASETRANSNSHOST 3 WORD)
|
||||
(* ; "Known or desired NS address")
|
||||
(TRANSPUPHOST BYTE)
|
||||
(TRANSPUPHOST BYTE)
|
||||
(* ; "Known or desired PUP address")
|
||||
(NIL BYTE) (* ; "Padding")
|
||||
(BASETRANSSENDERNSHOST 3 WORD)
|
||||
(NIL BYTE) (* ; "Padding")
|
||||
(BASETRANSSENDERNSHOST 3 WORD)
|
||||
(* ; "Sender's info")
|
||||
(TRANSSENDERPUPHOST BYTE)
|
||||
(NIL BYTE))
|
||||
[ACCESSFNS BASETRANSNSHOST ((TRANSNSHOST (\LOADNSHOSTNUMBER
|
||||
(LOCF DATUM))
|
||||
(\STORENSHOSTNUMBER (LOCF DATUM)
|
||||
NEWVALUE]
|
||||
(ACCESSFNS BASETRANSSENDERNSHOST ((TRANSSENDERNSHOST
|
||||
(\LOADNSHOSTNUMBER (LOCF DATUM))
|
||||
(\STORENSHOSTNUMBER (LOCF DATUM)
|
||||
NEWVALUE]
|
||||
[ACCESSFNS ETHERTRANS
|
||||
([TRANSNSADDRESS
|
||||
(PROGN (* ;
|
||||
"Kludge to get a pointer that looks like a full ns address")
|
||||
(\ADDBASE DATUM (CONSTANT (+ (INDEXF (FETCH
|
||||
(ETHERPACKET EPBODY)
|
||||
of T))
|
||||
(INDEXF (FETCH
|
||||
(ETHERTRANS
|
||||
(TRANSSENDERPUPHOST BYTE)
|
||||
(NIL BYTE))
|
||||
[ACCESSFNS BASETRANSNSHOST ((TRANSNSHOST (\LOADNSHOSTNUMBER (LOCF DATUM)
|
||||
)
|
||||
(\STORENSHOSTNUMBER (LOCF DATUM)
|
||||
NEWVALUE]
|
||||
(ACCESSFNS BASETRANSSENDERNSHOST ((TRANSSENDERNSHOST (\LOADNSHOSTNUMBER
|
||||
(LOCF DATUM))
|
||||
(\STORENSHOSTNUMBER
|
||||
(LOCF DATUM)
|
||||
NEWVALUE]
|
||||
[ACCESSFNS ETHERTRANS
|
||||
([TRANSNSADDRESS (PROGN (* ;
|
||||
"Kludge to get a pointer that looks like a full ns address")
|
||||
(\ADDBASE
|
||||
DATUM
|
||||
(CONSTANT (+ (INDEXF (FETCH (ETHERPACKET EPBODY
|
||||
)
|
||||
of T))
|
||||
(INDEXF (FETCH (ETHERTRANS
|
||||
BASETRANSNSHOST
|
||||
) of
|
||||
T))
|
||||
-2]
|
||||
(TRANSSENDERNSADDRESS
|
||||
(\ADDBASE DATUM (CONSTANT (+ (INDEXF (FETCH (ETHERPACKET
|
||||
EPBODY)
|
||||
of T))
|
||||
(INDEXF (FETCH (ETHERTRANS
|
||||
)
|
||||
of T))
|
||||
-2]
|
||||
(TRANSSENDERNSADDRESS (\ADDBASE
|
||||
DATUM
|
||||
(CONSTANT (+ (INDEXF (FETCH (ETHERPACKET EPBODY)
|
||||
of T))
|
||||
(INDEXF (FETCH (ETHERTRANS
|
||||
BASETRANSSENDERNSHOST
|
||||
)
|
||||
of T))
|
||||
-2]
|
||||
(TYPE? (type? ETHERPACKET DATUM)))
|
||||
)
|
||||
of T))
|
||||
-2]
|
||||
(TYPE? (type? ETHERPACKET DATUM)))
|
||||
)
|
||||
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
@@ -2571,7 +2567,7 @@ Copyright (c) 1982-1988, 1990-1993, 2021 by Venue & Xerox Corporation.
|
||||
(RPAQ? \RAWTRACING )
|
||||
|
||||
(ADDTOVAR \PACKET.PRINTERS (512 . PRINTPUP)
|
||||
(1537 . PRINT10TO3))
|
||||
(1537 . PRINT10TO3))
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS \RAWTRACING \PACKET.PRINTERS PUPTRACEFILE XIPTRACEFILE \RCLKMILLISECOND)
|
||||
@@ -2615,7 +2611,7 @@ Copyright (c) 1982-1988, 1990-1993, 2021 by Venue & Xerox Corporation.
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(BLOCKRECORD CENTICLOCK ((CENTICLOCKSIGNBIT BITS 1)
|
||||
(CENTICLOCKMAGNITUDE BITS 31)))
|
||||
(CENTICLOCKMAGNITUDE BITS 31)))
|
||||
)
|
||||
)
|
||||
|
||||
@@ -2757,43 +2753,41 @@ Copyright (c) 1982-1988, 1990-1993, 2021 by Venue & Xerox Corporation.
|
||||
(DECLARE%: DONTCOPY
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(ACCESSFNS 3MBENCAPSULATION [(3MBENCAPSTART (LOCF (fetch (ETHERPACKET EPENCAPSULATION)
|
||||
of DATUM]
|
||||
(BLOCKRECORD 3MBENCAPSTART ((NIL 5 WORD)
|
||||
(ACCESSFNS 3MBENCAPSULATION [(3MBENCAPSTART (LOCF (fetch (ETHERPACKET EPENCAPSULATION) of DATUM]
|
||||
(BLOCKRECORD 3MBENCAPSTART ((NIL 5 WORD)
|
||||
(* ; "waste space")
|
||||
(3MBLENGTH WORD)
|
||||
(3MBLENGTH WORD)
|
||||
(* ;
|
||||
"Length of packet in words, starting at the next word")
|
||||
(3MBDESTHOST BYTE)
|
||||
"Length of packet in words, starting at the next word")
|
||||
(3MBDESTHOST BYTE)
|
||||
(* ; "Immediate destination host")
|
||||
(3MBSOURCEHOST BYTE)
|
||||
(3MBSOURCEHOST BYTE)
|
||||
(* ; "Us")
|
||||
(3MBTYPE WORD)
|
||||
(3MBTYPE WORD)
|
||||
(* ;
|
||||
"Type of packet -- PUP or XIP or 10TO3")
|
||||
)
|
||||
[ACCESSFNS 3MBLENGTH ((3MBBASE (LOCF DATUM]
|
||||
"Type of packet -- PUP or XIP or 10TO3")
|
||||
)
|
||||
[ACCESSFNS 3MBLENGTH ((3MBBASE (LOCF DATUM]
|
||||
(* ; "What to hand to BCPL")
|
||||
)
|
||||
(TYPE? (type? ETHERPACKET DATUM)))
|
||||
)
|
||||
(TYPE? (type? ETHERPACKET DATUM)))
|
||||
|
||||
(BLOCKRECORD PBI ((PBILINK WORD)
|
||||
(PBIQUEUE WORD)
|
||||
(PBISOCKET WORD)
|
||||
(PBINDB WORD)
|
||||
(PBIINPUTP FLAG)
|
||||
(PBIALLNETSP FLAG)
|
||||
(PBINOZEROP FLAG)
|
||||
(NIL BITS 13)
|
||||
(PBITIMER WORD)
|
||||
(PBILENGTH WORD)
|
||||
(PBIENCAPSULATION 2 WORD)
|
||||
(PBIFIRSTPUPWORD 10 WORD)
|
||||
(PBIFIRSTPUPDATAWORD WORD))
|
||||
[ACCESSFNS PBI ((PBIPUPSTART (LOCF (fetch PBIFIRSTPUPWORD of DATUM)))
|
||||
(PBIPUPDATASTART (LOCF (fetch PBIFIRSTPUPDATAWORD
|
||||
of DATUM)))
|
||||
(PBIRAWSTART (LOCF (fetch PBILENGTH of DATUM])
|
||||
(PBIQUEUE WORD)
|
||||
(PBISOCKET WORD)
|
||||
(PBINDB WORD)
|
||||
(PBIINPUTP FLAG)
|
||||
(PBIALLNETSP FLAG)
|
||||
(PBINOZEROP FLAG)
|
||||
(NIL BITS 13)
|
||||
(PBITIMER WORD)
|
||||
(PBILENGTH WORD)
|
||||
(PBIENCAPSULATION 2 WORD)
|
||||
(PBIFIRSTPUPWORD 10 WORD)
|
||||
(PBIFIRSTPUPDATAWORD WORD))
|
||||
[ACCESSFNS PBI ((PBIPUPSTART (LOCF (fetch PBIFIRSTPUPWORD of DATUM)))
|
||||
(PBIPUPDATASTART (LOCF (fetch PBIFIRSTPUPDATAWORD of DATUM)))
|
||||
(PBIRAWSTART (LOCF (fetch PBILENGTH of DATUM])
|
||||
)
|
||||
|
||||
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
|
||||
@@ -2879,8 +2873,8 @@ Copyright (c) 1982-1988, 1990-1993, 2021 by Venue & Xerox Corporation.
|
||||
T])
|
||||
)
|
||||
|
||||
(RPAQQ ROUTINGINFOMACRO (1 "Operation = " WORDS 2 "Info: " REPEAT "(" SEPR ", " INTEGER -4 WORDS
|
||||
SEPR ") " -2 FINALLY ")"))
|
||||
(RPAQQ ROUTINGINFOMACRO (1 "Operation = " WORDS 2 "Info: " REPEAT "(" SEPR ", " INTEGER -4 WORDS SEPR
|
||||
") " -2 FINALLY ")"))
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
@@ -2913,10 +2907,10 @@ Copyright (c) 1982-1988, 1990-1993, 2021 by Venue & Xerox Corporation.
|
||||
(DECLARE%: DONTCOPY
|
||||
|
||||
(RPAQQ D0DEVICES ((\DEVICE.3MBETHERIN 7)
|
||||
(\DEVICE.3MBETHEROUT 6)
|
||||
(\DEVICE.10MBETHER 21)
|
||||
(\DEVICE.SA4000 3)
|
||||
(\DEVICE.DISPLAY 2)))
|
||||
(\DEVICE.3MBETHEROUT 6)
|
||||
(\DEVICE.10MBETHER 21)
|
||||
(\DEVICE.SA4000 3)
|
||||
(\DEVICE.DISPLAY 2)))
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RPAQQ \DEVICE.3MBETHERIN 7)
|
||||
@@ -2947,33 +2941,31 @@ Copyright (c) 1982-1988, 1990-1993, 2021 by Venue & Xerox Corporation.
|
||||
(* "END EXPORTED DEFINITIONS")
|
||||
|
||||
)
|
||||
(PUTPROPS LLETHER COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1988 1990 1991
|
||||
1992 1993 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (10792 19248 (CANONICAL.HOSTNAME 10802 . 12391) (\ENQUEUE 12393 . 15038) (\DEQUEUE 15040
|
||||
. 16367) (\QUEUELENGTH 16369 . 16669) (\ONQUEUE 16671 . 16937) (\UNQUEUE 16939 . 19246)) (52949 56815
|
||||
(\ALLOCATE.ETHERPACKET 52959 . 54000) (\RELEASE.ETHERPACKET 54002 . 55075) (RELEASE.PUP 55077 . 55222
|
||||
) (\FLUSH.PACKET.QUEUE 55224 . 55575) (\REQUEUE.ETHERPACKET 55577 . 56091) (\EP.PUT.AUX 56093 . 56813)
|
||||
) (57389 68770 (\SETLOCALNSNUMBERS 57399 . 58784) (\LOADNSADDRESS 58786 . 59078) (\STORENSADDRESS
|
||||
59080 . 59261) (\PRINTNSADDRESS 59263 . 60346) (\NSADDRESS.DEFPRINT 60348 . 65293) (
|
||||
\NSADDRESS.PRINT.DECIMAL 65295 . 67426) (\LOADNSHOSTNUMBER 67428 . 68057) (\STORENSHOSTNUMBER 68059 .
|
||||
68463) (PRINTNSHOSTNUMBER 68465 . 68768)) (68883 74631 (\ETHERINIT 68893 . 69463) (\ETHEREVENTFN 69465
|
||||
. 71997) (\ETHER-AVAILABLE 71999 . 72157) (\TIME.NOT.SET 72159 . 72485) (\SETETHERFLAGS 72487 . 72938
|
||||
) (\FLUSHNDBS 72940 . 74118) (\FLUSH.NDB.QUEUE 74120 . 74629)) (74632 77924 (\CHECKSUM 74642 . 76574)
|
||||
(\HANDLE.RAW.OTHER 76576 . 76931) (\HANDLE.RAW.PACKET 76933 . 77445) (\ADD.PACKET.FILTER 77447 . 77679
|
||||
) (\DEL.PACKET.FILTER 77681 . 77922)) (85757 86282 (ENCAPSULATE.ETHERPACKET 85767 . 86039) (
|
||||
TRANSMIT.ETHERPACKET 86041 . 86280)) (86570 99166 (\AGE.ROUTING.TABLE 86580 . 88729) (
|
||||
\ADD.ROUTING.TABLE.ENTRY 88731 . 89427) (\CLEAR.ROUTING.TABLE 89429 . 90156) (\MAP.ROUTING.TABLE 90158
|
||||
. 90686) (PRINTROUTINGTABLE 90688 . 94313) (\ROUTINGTABLE.INFOHOOK 94315 . 99164)) (99651 106436 (
|
||||
\TRANSLATE.10TO3 99661 . 101445) (\NOTE.10TO3 101447 . 103063) (\HANDLE.RAW.10TO3 103065 . 106434)) (
|
||||
110418 125240 (PRINTPACKET 110428 . 110989) (\MAYBEPRINTPACKET 110991 . 112648) (PRINT10TO3 112650 .
|
||||
114018) (PRINTPACKETDATA 114020 . 119310) (PRINTPACKETQUEUE 119312 . 119741) (TIME.SINCE.PACKET 119743
|
||||
. 120228) (MAKE-NETWORK-TRACE-WINDOW 120230 . 123772) (\CHANGE.ETHER.TRACING 123774 . 125238)) (
|
||||
125611 126426 (\CENTICLOCK 125621 . 126424)) (126881 132981 (\3MBGETPACKET 126891 . 128311) (
|
||||
\3MB.CREATENDB 128313 . 129028) (\3MBSENDPACKET 129030 . 131213) (\3MBWATCHER 131215 . 131953) (
|
||||
\3MBENCAPSULATE 131955 . 132503) (\3MB.BROADCASTP 132505 . 132676) (\3MBFLUSH 132678 . 132979)) (
|
||||
135935 137878 (ASSURE.ETHER.ON 135945 . 136275) (INITPUPLEVEL1 136277 . 136757) (TURN.ON.ETHER 136759
|
||||
. 136904) (RESTART.ETHER 136906 . 137280) (TURN.OFF.ETHER 137282 . 137600) (PRINTWORDS 137602 .
|
||||
137876)) (138153 138688 (\DEVICE.INPUT 138163 . 138328) (\DEVICE.OUTPUT 138330 . 138524) (\D0.STARTIO
|
||||
138526 . 138686)))))
|
||||
(FILEMAP (NIL (10585 19041 (CANONICAL.HOSTNAME 10595 . 12184) (\ENQUEUE 12186 . 14831) (\DEQUEUE 14833
|
||||
. 16160) (\QUEUELENGTH 16162 . 16462) (\ONQUEUE 16464 . 16730) (\UNQUEUE 16732 . 19039)) (52600 56466
|
||||
(\ALLOCATE.ETHERPACKET 52610 . 53651) (\RELEASE.ETHERPACKET 53653 . 54726) (RELEASE.PUP 54728 . 54873
|
||||
) (\FLUSH.PACKET.QUEUE 54875 . 55226) (\REQUEUE.ETHERPACKET 55228 . 55742) (\EP.PUT.AUX 55744 . 56464)
|
||||
) (57040 68421 (\SETLOCALNSNUMBERS 57050 . 58435) (\LOADNSADDRESS 58437 . 58729) (\STORENSADDRESS
|
||||
58731 . 58912) (\PRINTNSADDRESS 58914 . 59997) (\NSADDRESS.DEFPRINT 59999 . 64944) (
|
||||
\NSADDRESS.PRINT.DECIMAL 64946 . 67077) (\LOADNSHOSTNUMBER 67079 . 67708) (\STORENSHOSTNUMBER 67710 .
|
||||
68114) (PRINTNSHOSTNUMBER 68116 . 68419)) (68534 74394 (\ETHERINIT 68544 . 69114) (\ETHEREVENTFN 69116
|
||||
. 71594) (\ETHER-AVAILABLE 71596 . 71754) (\TIME.NOT.SET 71756 . 72082) (\SETETHERFLAGS 72084 . 72701
|
||||
) (\FLUSHNDBS 72703 . 73881) (\FLUSH.NDB.QUEUE 73883 . 74392)) (74395 77687 (\CHECKSUM 74405 . 76337)
|
||||
(\HANDLE.RAW.OTHER 76339 . 76694) (\HANDLE.RAW.PACKET 76696 . 77208) (\ADD.PACKET.FILTER 77210 . 77442
|
||||
) (\DEL.PACKET.FILTER 77444 . 77685)) (85191 85716 (ENCAPSULATE.ETHERPACKET 85201 . 85473) (
|
||||
TRANSMIT.ETHERPACKET 85475 . 85714)) (86004 98600 (\AGE.ROUTING.TABLE 86014 . 88163) (
|
||||
\ADD.ROUTING.TABLE.ENTRY 88165 . 88861) (\CLEAR.ROUTING.TABLE 88863 . 89590) (\MAP.ROUTING.TABLE 89592
|
||||
. 90120) (PRINTROUTINGTABLE 90122 . 93747) (\ROUTINGTABLE.INFOHOOK 93749 . 98598)) (99085 105870 (
|
||||
\TRANSLATE.10TO3 99095 . 100879) (\NOTE.10TO3 100881 . 102497) (\HANDLE.RAW.10TO3 102499 . 105868)) (
|
||||
109860 124682 (PRINTPACKET 109870 . 110431) (\MAYBEPRINTPACKET 110433 . 112090) (PRINT10TO3 112092 .
|
||||
113460) (PRINTPACKETDATA 113462 . 118752) (PRINTPACKETQUEUE 118754 . 119183) (TIME.SINCE.PACKET 119185
|
||||
. 119670) (MAKE-NETWORK-TRACE-WINDOW 119672 . 123214) (\CHANGE.ETHER.TRACING 123216 . 124680)) (
|
||||
125049 125864 (\CENTICLOCK 125059 . 125862)) (126315 132415 (\3MBGETPACKET 126325 . 127745) (
|
||||
\3MB.CREATENDB 127747 . 128462) (\3MBSENDPACKET 128464 . 130647) (\3MBWATCHER 130649 . 131387) (
|
||||
\3MBENCAPSULATE 131389 . 131937) (\3MB.BROADCASTP 131939 . 132110) (\3MBFLUSH 132112 . 132413)) (
|
||||
135157 137100 (ASSURE.ETHER.ON 135167 . 135497) (INITPUPLEVEL1 135499 . 135979) (TURN.ON.ETHER 135981
|
||||
. 136126) (RESTART.ETHER 136128 . 136502) (TURN.OFF.ETHER 136504 . 136822) (PRINTWORDS 136824 .
|
||||
137098)) (137371 137906 (\DEVICE.INPUT 137381 . 137546) (\DEVICE.OUTPUT 137548 . 137742) (\D0.STARTIO
|
||||
137744 . 137904)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,14 +1,14 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
|
||||
|
||||
(FILECREATED "25-Oct-2021 15:12:33" |{DSK}<home>larry>medley>sources>MAIKOETHER.;2| 28792
|
||||
(FILECREATED "30-Dec-2025 19:09:34" |{DSK}<Users>briggs>projects>medley>sources>MAIKOETHER.;7| 26899
|
||||
|
||||
|changes| |to:| (FNS \\DISPLAYLINE)
|
||||
(VARS MAIKOETHERCOMS)
|
||||
:EDIT-BY |nhb|
|
||||
|
||||
|previous| |date:| "25-Mar-2021 09:50:57" |{DSK}<home>larry>medley>sources>MAIKOETHER.;1|)
|
||||
:CHANGES-TO (VARS MAIKOETHERCOMS)
|
||||
|
||||
:PREVIOUS-DATE "30-Dec-2025 18:50:46" |{DSK}<Users>briggs>projects>medley>sources>MAIKOETHER.;6|
|
||||
)
|
||||
|
||||
; Copyright (c) 1988-1991, 2021 by Venue & Xerox Corporation.
|
||||
|
||||
(PRETTYCOMPRINT MAIKOETHERCOMS)
|
||||
|
||||
@@ -23,10 +23,6 @@
|
||||
(DECLARE\: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
|
||||
10MBDRIVER)
|
||||
(GLOBALVARS \\MAIKO.INPUT.PACKET |\\ETHERtopMonitor|)
|
||||
|
||||
(* |;;| "The NDB for Maiko's 10MB connection; used by \\MAIKO.ETHER-INTERRUPT:")
|
||||
|
||||
(GLOBALVARS \\MAIKO.10MB.NDB)
|
||||
(GLOBALVARS \\MAIKO.IO-INTERRUPT-FLAGS \\MAIKO.IO-INTERRUPT-VECTOR))
|
||||
(ADDVARS (\\MAIKO.MOVDS (\\MAIKO.10MBSTARTDRIVER \\10MB.STARTDRIVER)
|
||||
(\\MAIKO.10MBWATCHER \\10MBWATCHER)
|
||||
@@ -35,9 +31,13 @@
|
||||
(\\MAIKO.10MBTURNONETHER \\10MB.TURNONETHER)
|
||||
(\\MAIKO.ETHERRESUME \\10MB.RESTART.ETHER)
|
||||
(\\MAIKO.CHECKSUM \\CHECKSUM)))
|
||||
(COMS (* \; "MAIKO handler for new interrupt-driven incoming ethernet communication, rather than polling for it.")
|
||||
(COMS
|
||||
(* |;;| "MAIKO handler for new interrupt-driven incoming ethernet communication, rather than polling for it.")
|
||||
|
||||
(FNS \\MAIKO.ETHER-INTERRUPT))
|
||||
(COMS (* \; "MAIKO Log & Console message handling. Interrupt-driven message printing, instead of polled printing.")
|
||||
(COMS
|
||||
(* |;;| "MAIKO Log & Console message handling. Interrupt-driven message printing, instead of polled printing.")
|
||||
|
||||
(FNS \\MAIKO.CONSOLE-LOG-PRINT))
|
||||
(COMS
|
||||
(* |;;| "Asynchronous I/O handling")
|
||||
@@ -48,13 +48,12 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\\10MB.RESTART.ETHER
|
||||
(LAMBDA NIL (* \; "Edited 11-May-88 16:09 by MASINTER")
|
||||
(LAMBDA NIL (* \; "Edited 11-May-88 16:09 by MASINTER")
|
||||
(SUBRCALL ETHER-RESUME)))
|
||||
|
||||
(\\10MB.STARTDRIVER
|
||||
(LAMBDA (NDB RESTARTFLG MYNSNUMBER) (* \; "Edited 5-Apr-89 15:03 by snow")
|
||||
(DECLARE (GLOBALVARS \\MAIKO.INPUT.PACKET \\10MB.EXPECTED.RECEIVE.INTERVAL
|
||||
\\10MB.INPUT.TIMEOUT))
|
||||
(LAMBDA (NDB RESTARTFLG MYNSNUMBER) (* \; "Edited 5-Apr-89 15:03 by snow")
|
||||
(DECLARE (GLOBALVARS \\MAIKO.INPUT.PACKET \\10MB.EXPECTED.RECEIVE.INTERVAL \\10MB.INPUT.TIMEOUT))
|
||||
(SUBRCALL ETHER-SUSPEND)
|
||||
(OR (\\INIT.ETHER.BUFFER.POOL)
|
||||
(ERROR "Unable to create buffer pool"))
|
||||
@@ -65,21 +64,17 @@
|
||||
0 0)
|
||||
(PROG ((CSB (|fetch| NDBCSB |of| NDB)))
|
||||
(OR \\MAIKO.INPUT.PACKET (SETQ \\MAIKO.INPUT.PACKET (\\ALLOCATE.ETHERPACKET)))
|
||||
(|replace| DLFIRSTICB |of| (|fetch| NDBCSB |of| NDB) |with|
|
||||
\\ES.PENDING)
|
||||
(SUBRCALL ETHER-GET \\10MBPACKETLENGTH (|fetch| 10MBPACKETBASE |of|
|
||||
\\MAIKO.INPUT.PACKET
|
||||
))
|
||||
(|replace| NDBWATCHER |of| NDB |with| (ADD.PROCESS (LIST '\\10MBWATCHER
|
||||
(KWOTE NDB))
|
||||
'RESTARTABLE
|
||||
'SYSTEM
|
||||
'AFTEREXIT
|
||||
'DELETE))
|
||||
(|replace| DLFIRSTICB |of| (|fetch| NDBCSB |of| NDB) |with| \\ES.PENDING)
|
||||
(SUBRCALL ETHER-GET \\10MBPACKETLENGTH (|fetch| 10MBPACKETBASE |of| \\MAIKO.INPUT.PACKET))
|
||||
(|replace| NDBWATCHER |of| NDB |with| (ADD.PROCESS (LIST '\\10MBWATCHER (KWOTE NDB))
|
||||
'RESTARTABLE
|
||||
'SYSTEM
|
||||
'AFTEREXIT
|
||||
'DELETE))
|
||||
(RETURN NDB))))
|
||||
|
||||
(\\10MB.TURNOFFETHER
|
||||
(LAMBDA NIL (* \; "Edited 11-May-88 16:11 by MASINTER")
|
||||
(LAMBDA NIL (* \; "Edited 11-May-88 16:11 by MASINTER")
|
||||
(SUBRCALL ETHER-SUSPEND)))
|
||||
|
||||
(\\10MB.TURNONETHER
|
||||
@@ -92,20 +87,16 @@
|
||||
|
||||
(PROG ((CSB (|fetch| NDBCSB |of| NDB)))
|
||||
(\\MAIKO.ETHERSUSPEND)
|
||||
(OR CSB (|replace| NDBCSB |of| NDB |with| (SETQ CSB
|
||||
(LOCF (|fetch| DLETHERNET
|
||||
|of| \\IOPAGE)))))
|
||||
(OR CSB (|replace| NDBCSB |of| NDB |with| (SETQ CSB (LOCF (|fetch| DLETHERNET |of| \\IOPAGE
|
||||
)))))
|
||||
(|replace| DLFIRSTOCB |of| CSB |with| 0)
|
||||
(|replace| DLFIRSTICB |of| CSB |with| 0)
|
||||
(AND NSHOSTNUMBER (COND
|
||||
((EQ NSHOSTNUMBER T)
|
||||
(\\BLT (LOCF (|fetch| DLLOCALHOST0 |of| CSB))
|
||||
(LOCF (|fetch| (IFPAGE |NSHost0|) |of|
|
||||
|\\InterfacePage|)
|
||||
)
|
||||
(LOCF (|fetch| (IFPAGE |NSHost0|) |of| |\\InterfacePage|))
|
||||
\\#WDS.NSHOSTNUMBER))
|
||||
(T (\\STORENSHOSTNUMBER (LOCF (|fetch| DLLOCALHOST0 |of|
|
||||
CSB))
|
||||
(T (\\STORENSHOSTNUMBER (LOCF (|fetch| DLLOCALHOST0 |of| CSB))
|
||||
NSHOSTNUMBER))))
|
||||
(AND OUTINTERRUPT (|replace| DLOUTPUTMASK |of| CSB |with| OUTINTERRUPT))
|
||||
(AND ININTERRUPT (|replace| DLINPUTMASK |of| CSB |with| ININTERRUPT))
|
||||
@@ -117,7 +108,7 @@
|
||||
(RETURN NDB))))
|
||||
|
||||
(\\10MBSENDPACKET
|
||||
(LAMBDA (NDB PACKET) (* \; "Edited 11-May-88 16:10 by MASINTER")
|
||||
(LAMBDA (NDB PACKET) (* \; "Edited 11-May-88 16:10 by MASINTER")
|
||||
(PROG NIL
|
||||
(COND
|
||||
(\\RAWTRACING (\\MAYBEPRINTPACKET PACKET 'RAWPUT)))
|
||||
@@ -125,23 +116,23 @@
|
||||
((OR (|fetch| 10MBMULTICASTP |of| PACKET)
|
||||
(EQNSADDRESS.HOST \\MY.NSADDRESS (|fetch| 10MBDESTHOSTBASE |of| PACKET)))
|
||||
(* \;
|
||||
"We would hear this packet if our hardware let us, so fake receipt")
|
||||
"We would hear this packet if our hardware let us, so fake receipt")
|
||||
(PROG ((COPYPACKET (\\ALLOCATE.ETHERPACKET)))
|
||||
(\\BLT (LOCF (|fetch| 10MBLENGTH |of| COPYPACKET))
|
||||
(LOCF (|fetch| 10MBLENGTH |of| PACKET))
|
||||
(ADD1 (|fetch| 10MBLENGTH |of| PACKET)))
|
||||
(* \;
|
||||
"Copy all data that would have been transmitted")
|
||||
"Copy all data that would have been transmitted")
|
||||
(|replace| EPNETWORK |of| COPYPACKET |with| NDB)
|
||||
(|replace| EPTYPE |of| COPYPACKET
|
||||
|with| (|for| PAIR |in| \\10MBTYPE.TRANSLATIONS
|
||||
|bind| (TYPE _ (|fetch| 10MBTYPE |of| PACKET))
|
||||
|when| (EQ TYPE (CAR PAIR)) |do|
|
||||
|bind| (TYPE _ (|fetch| 10MBTYPE |of| PACKET))
|
||||
|when| (EQ TYPE (CAR PAIR)) |do|
|
||||
|
||||
(* |;;| "TYPE is the raw type of the etherpacket. These do not always correspond one-to-one with the EPTYPE constants we use (in particular, for pups), so translate if necessary.")
|
||||
|
||||
(RETURN (CDR PAIR))
|
||||
|finally| (RETURN TYPE)))
|
||||
(RETURN (CDR PAIR))
|
||||
|finally| (RETURN TYPE)))
|
||||
(COND
|
||||
(\\RAWTRACING (\\MAYBEPRINTPACKET COPYPACKET 'RAWGET)))
|
||||
(\\HANDLE.RAW.PACKET COPYPACKET))))
|
||||
@@ -154,20 +145,21 @@
|
||||
(RETURN T))))
|
||||
|
||||
(\\10MBWATCHER
|
||||
(LAMBDA (NDB) (* \; "Edited 16-May-88 22:24 by MASINTER")
|
||||
(LAMBDA (NDB) (* \; "Edited 16-May-88 22:24 by MASINTER")
|
||||
|
||||
(* |;;| "merge message and packet reading")
|
||||
|
||||
(PROG ((CNTR 0)
|
||||
MESSAGE-BUFFER MESSAGE-LENGTH PACKET)
|
||||
LP (IF (SUBRCALL MESSAGE-READP)
|
||||
THEN (PROMPTPRINT (IF (SETQ MESSAGE-LENGTH (SUBRCALL MESSAGE-READ
|
||||
(OR MESSAGE-BUFFER
|
||||
(SETQ MESSAGE-BUFFER
|
||||
(ALLOCSTRING 1024)))
|
||||
1024))
|
||||
THEN (SUBSTRING MESSAGE-BUFFER 1 MESSAGE-LENGTH)
|
||||
ELSE "?? system message: polling failed")))
|
||||
THEN (PROMPTPRINT (IF (SETQ MESSAGE-LENGTH (SUBRCALL MESSAGE-READ (OR MESSAGE-BUFFER
|
||||
(SETQ
|
||||
MESSAGE-BUFFER
|
||||
(ALLOCSTRING
|
||||
1024)))
|
||||
1024))
|
||||
THEN (SUBSTRING MESSAGE-BUFFER 1 MESSAGE-LENGTH)
|
||||
ELSE "?? system message: polling failed")))
|
||||
(UNINTERRUPTABLY
|
||||
(SUBRCALL ETHER-CHECK)
|
||||
(SETQ PACKET (\\MAIKO.INPUT.INTERRUPT NDB)))
|
||||
@@ -182,31 +174,31 @@
|
||||
(GO LP))))
|
||||
|
||||
(\\MAIKO.10MBSENDPACKET
|
||||
(LAMBDA (NDB PACKET) (* \; "Edited 31-Oct-89 14:10 by bvm")
|
||||
(LAMBDA (NDB PACKET) (* \; "Edited 31-Oct-89 14:10 by bvm")
|
||||
(PROG NIL
|
||||
(COND
|
||||
(\\RAWTRACING (\\MAYBEPRINTPACKET PACKET 'RAWPUT)))
|
||||
(COND
|
||||
((OR (|fetch| 10MBMULTICASTP |of| PACKET)
|
||||
(EQNSADDRESS.HOST \\MY.NSADDRESS (|fetch| 10MBDESTNSADDRESSBASE |of| PACKET
|
||||
)))(* \;
|
||||
"We would hear this packet if our hardware let us, so fake receipt")
|
||||
(EQNSADDRESS.HOST \\MY.NSADDRESS (|fetch| 10MBDESTNSADDRESSBASE |of| PACKET)))
|
||||
(* \;
|
||||
"We would hear this packet if our hardware let us, so fake receipt")
|
||||
(PROG ((COPYPACKET (\\ALLOCATE.ETHERPACKET)))
|
||||
(\\BLT (LOCF (|fetch| 10MBLENGTH |of| COPYPACKET))
|
||||
(LOCF (|fetch| 10MBLENGTH |of| PACKET))
|
||||
(ADD1 (|fetch| 10MBLENGTH |of| PACKET)))
|
||||
(* \;
|
||||
"Copy all data that would have been transmitted")
|
||||
"Copy all data that would have been transmitted")
|
||||
(|replace| EPNETWORK |of| COPYPACKET |with| NDB)
|
||||
(|replace| EPTYPE |of| COPYPACKET
|
||||
|with| (|for| PAIR |in| \\10MBTYPE.TRANSLATIONS
|
||||
|bind| (TYPE _ (|fetch| 10MBTYPE |of| PACKET))
|
||||
|when| (EQ TYPE (CAR PAIR)) |do|
|
||||
|bind| (TYPE _ (|fetch| 10MBTYPE |of| PACKET))
|
||||
|when| (EQ TYPE (CAR PAIR)) |do|
|
||||
|
||||
(* |;;| "TYPE is the raw type of the etherpacket. These do not always correspond one-to-one with the EPTYPE constants we use (in particular, for pups), so translate if necessary.")
|
||||
|
||||
(RETURN (CDR PAIR))
|
||||
|finally| (RETURN TYPE)))
|
||||
(RETURN (CDR PAIR))
|
||||
|finally| (RETURN TYPE)))
|
||||
(COND
|
||||
(\\RAWTRACING (\\MAYBEPRINTPACKET COPYPACKET 'RAWGET)))
|
||||
(\\HANDLE.RAW.PACKET COPYPACKET))))
|
||||
@@ -219,20 +211,21 @@
|
||||
(RETURN T))))
|
||||
|
||||
(\\MAIKO.10MBWATCHER
|
||||
(LAMBDA (NDB) (* \; "Edited 16-May-88 22:24 by MASINTER")
|
||||
(LAMBDA (NDB) (* \; "Edited 16-May-88 22:24 by MASINTER")
|
||||
|
||||
(* |;;| "merge message and packet reading")
|
||||
|
||||
(PROG ((CNTR 0)
|
||||
MESSAGE-BUFFER MESSAGE-LENGTH PACKET)
|
||||
LP (IF (SUBRCALL MESSAGE-READP)
|
||||
THEN (PROMPTPRINT (IF (SETQ MESSAGE-LENGTH (SUBRCALL MESSAGE-READ
|
||||
(OR MESSAGE-BUFFER
|
||||
(SETQ MESSAGE-BUFFER
|
||||
(ALLOCSTRING 1024)))
|
||||
1024))
|
||||
THEN (SUBSTRING MESSAGE-BUFFER 1 MESSAGE-LENGTH)
|
||||
ELSE "?? system message: polling failed")))
|
||||
THEN (PROMPTPRINT (IF (SETQ MESSAGE-LENGTH (SUBRCALL MESSAGE-READ (OR MESSAGE-BUFFER
|
||||
(SETQ
|
||||
MESSAGE-BUFFER
|
||||
(ALLOCSTRING
|
||||
1024)))
|
||||
1024))
|
||||
THEN (SUBSTRING MESSAGE-BUFFER 1 MESSAGE-LENGTH)
|
||||
ELSE "?? system message: polling failed")))
|
||||
(UNINTERRUPTABLY
|
||||
(SUBRCALL ETHER-CHECK)
|
||||
(SETQ PACKET (\\MAIKO.INPUT.INTERRUPT NDB)))
|
||||
@@ -247,15 +240,15 @@
|
||||
(GO LP))))
|
||||
|
||||
(\\MAIKO.ETHERRESUME
|
||||
(LAMBDA NIL (* \; "Edited 11-May-88 16:09 by MASINTER")
|
||||
(LAMBDA NIL (* \; "Edited 11-May-88 16:09 by MASINTER")
|
||||
(SUBRCALL ETHER-RESUME)))
|
||||
|
||||
(\\MAIKO.ETHERSUSPEND
|
||||
(LAMBDA NIL (* \; "Edited 11-May-88 16:11 by MASINTER")
|
||||
(LAMBDA NIL (* \; "Edited 11-May-88 16:11 by MASINTER")
|
||||
(SUBRCALL ETHER-SUSPEND)))
|
||||
|
||||
(\\MAIKO.INPUT.INTERRUPT
|
||||
(LAMBDA (NDB) (* \; "Edited 11-May-88 16:05 by MASINTER")
|
||||
(LAMBDA (NDB) (* \; "Edited 11-May-88 16:05 by MASINTER")
|
||||
|
||||
(* |;;| "This routine gets called when 10MB input signals an interrupt. See if the \\MAIKO.INPUT.PACKET has indeed been processed, and if so, take care of it")
|
||||
|
||||
@@ -266,43 +259,38 @@
|
||||
(|replace| 10MBLENGTH |of| PACKET |with| LENGTH)
|
||||
(\\RCLK (LOCF (|fetch| EPTIMESTAMP |of| PACKET)))
|
||||
(|replace| EPNETWORK |of| PACKET |with| NDB)
|
||||
(|replace| EPTYPE |of| PACKET |with| (|for| PAIR |in|
|
||||
\\10MBTYPE.TRANSLATIONS
|
||||
|bind| (TYPE _
|
||||
(|fetch|
|
||||
10MBTYPE
|
||||
|of| PACKET
|
||||
))
|
||||
|when| (EQ TYPE (CAR PAIR))
|
||||
|do| (RETURN (CDR PAIR))
|
||||
|finally| (RETURN TYPE)))
|
||||
(|replace| EPTYPE |of| PACKET |with| (|for| PAIR |in| \\10MBTYPE.TRANSLATIONS
|
||||
|bind| (TYPE _ (|fetch| 10MBTYPE |of| PACKET))
|
||||
|when| (EQ TYPE (CAR PAIR))
|
||||
|do| (RETURN (CDR PAIR))
|
||||
|finally| (RETURN TYPE)))
|
||||
(COND
|
||||
(\\RAWTRACING (\\MAYBEPRINTPACKET PACKET 'RAWGET)))
|
||||
(RETURN (PROG1 PACKET
|
||||
(SETQ \\MAIKO.INPUT.PACKET (\\ALLOCATE.ETHERPACKET))
|
||||
(|replace| DLFIRSTICB |of| (|fetch| NDBCSB |of| NDB)
|
||||
|with| \\ES.PENDING)
|
||||
(SUBRCALL ETHER-GET \\10MBPACKETLENGTH (|fetch| 10MBPACKETBASE
|
||||
|of| \\MAIKO.INPUT.PACKET))))
|
||||
)
|
||||
(|replace| DLFIRSTICB |of| (|fetch| NDBCSB |of| NDB) |with| \\ES.PENDING)
|
||||
(SUBRCALL ETHER-GET \\10MBPACKETLENGTH (|fetch| 10MBPACKETBASE |of|
|
||||
\\MAIKO.INPUT.PACKET
|
||||
)))))
|
||||
(T (RETURN NIL))))))
|
||||
|
||||
(\\NS.SETTIME
|
||||
(LAMBDA (RETFLG) (* \; "Edited 13-May-88 15:22 by MASINTER")
|
||||
(LAMBDA (RETFLG) (* \; "Edited 13-May-88 15:22 by MASINTER")
|
||||
(CL:UNLESS (AND RETFLG (NOT (STRINGP RETFLG)))
|
||||
(SETQ |\\TimeZoneComp| (SUBRCALL GETUNIXTIME 8 NIL)))
|
||||
(\\PROCESS.RESET.TIMERS)
|
||||
(DAYTIME)))
|
||||
|
||||
(\\PUP.SETTIME
|
||||
(LAMBDA (RETFLG) (* \; "Edited 13-May-88 15:22 by MASINTER")
|
||||
(LAMBDA (RETFLG) (* \; "Edited 13-May-88 15:22 by MASINTER")
|
||||
(CL:UNLESS (AND RETFLG (NOT (STRINGP RETFLG)))
|
||||
(SETQ |\\TimeZoneComp| (SUBRCALL GETUNIXTIME 8 NIL)))
|
||||
(\\PROCESS.RESET.TIMERS)
|
||||
(DAYTIME)))
|
||||
|
||||
(\\MAIKO.10MBSTARTDRIVER
|
||||
(LAMBDA (NDB RESTARTFLG MYNSNUMBER) (* \; "Edited 4-May-91 15:50 by jds")
|
||||
(LAMBDA (NDB RESTARTFLG MYNSNUMBER) (* \; "Edited 30-Dec-2025 18:50 by nhb")
|
||||
(* \; "Edited 4-May-91 15:50 by jds")
|
||||
|
||||
(* |;;| "Start the \"driver\" for the 10MB ethernet on Sun Medley. In particular, turn on the C ehternet code, queue up the first input packet, and start the \\10MBWATCHER process.")
|
||||
|
||||
@@ -312,13 +300,11 @@
|
||||
(|replace| NDBTQ |of| NDB |with| (|create| SYSQUEUE))
|
||||
(SETQ \\10MB.RAWPACKETQ (|create| SYSQUEUE))
|
||||
(SETQ \\10MB.INPUT.TIMEOUT (TIMES \\RCLKSECOND \\10MB.EXPECTED.RECEIVE.INTERVAL))
|
||||
(SETQ \\MAIKO.10MB.NDB NDB)
|
||||
(\\10MB.TURNONETHER NDB NIL NIL (OR MYNSNUMBER T)
|
||||
0 0)
|
||||
(PROG ((CSB (|fetch| NDBCSB |of| NDB)))
|
||||
(OR \\MAIKO.INPUT.PACKET (SETQ \\MAIKO.INPUT.PACKET (\\ALLOCATE.ETHERPACKET)))
|
||||
(|replace| DLFIRSTICB |of| (|fetch| NDBCSB |of| NDB) |with|
|
||||
\\ES.PENDING)
|
||||
(|replace| DLFIRSTICB |of| (|fetch| NDBCSB |of| NDB) |with| \\ES.PENDING)
|
||||
(AND (SUBRCALL ETHER-GET \\10MBPACKETLENGTH (|fetch| 10MBPACKETBASE |of|
|
||||
\\MAIKO.INPUT.PACKET
|
||||
))
|
||||
@@ -340,20 +326,16 @@
|
||||
|
||||
(PROG ((CSB (|fetch| NDBCSB |of| NDB)))
|
||||
(\\MAIKO.ETHERSUSPEND)
|
||||
(OR CSB (|replace| NDBCSB |of| NDB |with| (SETQ CSB
|
||||
(LOCF (|fetch| DLETHERNET
|
||||
|of| \\IOPAGE)))))
|
||||
(OR CSB (|replace| NDBCSB |of| NDB |with| (SETQ CSB (LOCF (|fetch| DLETHERNET |of| \\IOPAGE
|
||||
)))))
|
||||
(|replace| DLFIRSTOCB |of| CSB |with| 0)
|
||||
(|replace| DLFIRSTICB |of| CSB |with| 0)
|
||||
(AND NSHOSTNUMBER (COND
|
||||
((EQ NSHOSTNUMBER T)
|
||||
(\\BLT (LOCF (|fetch| DLLOCALHOST0 |of| CSB))
|
||||
(LOCF (|fetch| (IFPAGE |NSHost0|) |of|
|
||||
|\\InterfacePage|)
|
||||
)
|
||||
(LOCF (|fetch| (IFPAGE |NSHost0|) |of| |\\InterfacePage|))
|
||||
\\#WDS.NSHOSTNUMBER))
|
||||
(T (\\STORENSHOSTNUMBER (LOCF (|fetch| DLLOCALHOST0 |of|
|
||||
CSB))
|
||||
(T (\\STORENSHOSTNUMBER (LOCF (|fetch| DLLOCALHOST0 |of| CSB))
|
||||
NSHOSTNUMBER))))
|
||||
(AND OUTINTERRUPT (|replace| DLOUTPUTMASK |of| CSB |with| OUTINTERRUPT))
|
||||
(AND ININTERRUPT (|replace| DLINPUTMASK |of| CSB |with| ININTERRUPT))
|
||||
@@ -365,14 +347,14 @@
|
||||
(RETURN NDB))))
|
||||
|
||||
(\\MAIKO.10MB.RESTART.ETHER
|
||||
(LAMBDA (NDB) (* \; "Edited 11-May-88 16:08 by MASINTER")
|
||||
(LAMBDA (NDB) (* \; "Edited 11-May-88 16:08 by MASINTER")
|
||||
|
||||
(* |;;;| "Kick the Ethernet receiver task to restart the Ethernet receiver task. This function gets called when the 10MBDRIVER thinks the Ethernet has been accidentally disabled")
|
||||
|
||||
(SUBRCALL ETHER-RESUME)))
|
||||
|
||||
(\\MAIKO.CHECKSUM
|
||||
(LAMBDA (BASE NWORDS INITSUM) (* \; "Edited 20-May-88 11:48 by MASINTER")
|
||||
(LAMBDA (BASE NWORDS INITSUM) (* \; "Edited 20-May-88 11:48 by MASINTER")
|
||||
(SUBRCALL CHECK-SUM BASE NWORDS INITSUM)))
|
||||
)
|
||||
|
||||
@@ -391,41 +373,37 @@
|
||||
|
||||
(DECLARE\: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS \\MAIKO.10MB.NDB)
|
||||
)
|
||||
|
||||
(DECLARE\: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS \\MAIKO.IO-INTERRUPT-FLAGS \\MAIKO.IO-INTERRUPT-VECTOR)
|
||||
)
|
||||
)
|
||||
|
||||
(ADDTOVAR \\MAIKO.MOVDS (\\MAIKO.10MBSTARTDRIVER \\10MB.STARTDRIVER)
|
||||
(\\MAIKO.10MBWATCHER \\10MBWATCHER)
|
||||
(\\MAIKO.10MBSENDPACKET \\10MBSENDPACKET)
|
||||
(\\MAIKO.ETHERSUSPEND \\10MB.TURNOFFETHER)
|
||||
(\\MAIKO.10MBTURNONETHER \\10MB.TURNONETHER)
|
||||
(\\MAIKO.ETHERRESUME \\10MB.RESTART.ETHER)
|
||||
(\\MAIKO.CHECKSUM \\CHECKSUM))
|
||||
(\\MAIKO.10MBWATCHER \\10MBWATCHER)
|
||||
(\\MAIKO.10MBSENDPACKET \\10MBSENDPACKET)
|
||||
(\\MAIKO.ETHERSUSPEND \\10MB.TURNOFFETHER)
|
||||
(\\MAIKO.10MBTURNONETHER \\10MB.TURNONETHER)
|
||||
(\\MAIKO.ETHERRESUME \\10MB.RESTART.ETHER)
|
||||
(\\MAIKO.CHECKSUM \\CHECKSUM))
|
||||
|
||||
|
||||
|
||||
(* \;
|
||||
(* |;;|
|
||||
"MAIKO handler for new interrupt-driven incoming ethernet communication, rather than polling for it.")
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(\\MAIKO.ETHER-INTERRUPT
|
||||
(LAMBDA NIL (* \; "Edited 4-May-91 13:46 by jds")
|
||||
(LAMBDA NIL (* \; "Edited 30-Dec-2025 18:36 by nhb")
|
||||
(* \; "Edited 4-May-91 13:46 by jds")
|
||||
|
||||
(* |;;| "This routine gets called when 10MB input signals an interrupt. See if the \\MAIKO.INPUT.PACKET has indeed been processed, and if so, take care of it")
|
||||
|
||||
(PROG ((NDB \\MAIKO.10MB.NDB)
|
||||
(PROG ((NDB \\10MBLOCALNDB)
|
||||
LENGTH)
|
||||
|
||||
(* |;;| "First, turn off the interrupt flag:")
|
||||
|
||||
(REPLACE (INTERRUPTSTATE ETHERINTERRUPT) OF \\INTERRUPTSTATE WITH NIL)
|
||||
(|replace| (INTERRUPTSTATE ETHERINTERRUPT) |of| \\INTERRUPTSTATE |with| NIL)
|
||||
|
||||
(* |;;| "Now handle it:")
|
||||
|
||||
@@ -437,33 +415,27 @@
|
||||
|
||||
READ-MORE-LOOP
|
||||
(COND
|
||||
((NEQ (SETQ LENGTH (|fetch| DLFIRSTICB |of| (|fetch| NDBCSB
|
||||
|of| NDB)))
|
||||
((NEQ (SETQ LENGTH (|fetch| DLFIRSTICB |of| (|fetch| NDBCSB |of| NDB)))
|
||||
\\ES.PENDING)
|
||||
(|replace| 10MBLENGTH |of| PACKET |with| LENGTH)
|
||||
(\\RCLK (LOCF (|fetch| EPTIMESTAMP |of| PACKET)))
|
||||
(|replace| EPNETWORK |of| PACKET |with| NDB)
|
||||
(|replace| EPTYPE |of| PACKET
|
||||
|with| (|for| PAIR |in| \\10MBTYPE.TRANSLATIONS
|
||||
|bind| (TYPE _ (|fetch| 10MBTYPE |of| PACKET
|
||||
))
|
||||
|when| (EQ TYPE (CAR PAIR))
|
||||
|do| (RETURN (CDR PAIR)) |finally| (RETURN
|
||||
TYPE)))
|
||||
|bind| (TYPE _ (|fetch| 10MBTYPE |of| PACKET))
|
||||
|when| (EQ TYPE (CAR PAIR)) |do| (RETURN (CDR PAIR))
|
||||
|finally| (RETURN TYPE)))
|
||||
(COND
|
||||
(\\RAWTRACING (\\MAYBEPRINTPACKET PACKET 'RAWGET)))
|
||||
(\\HANDLE.RAW.PACKET PACKET)
|
||||
(SETQ \\MAIKO.INPUT.PACKET (\\ALLOCATE.ETHERPACKET))
|
||||
(|replace| DLFIRSTICB |of| (|fetch| NDBCSB |of| NDB)
|
||||
|with| \\ES.PENDING)
|
||||
(|replace| DLFIRSTICB |of| (|fetch| NDBCSB |of| NDB) |with| \\ES.PENDING)
|
||||
(COND
|
||||
((SUBRCALL ETHER-GET \\10MBPACKETLENGTH (|fetch| 10MBPACKETBASE
|
||||
|of|
|
||||
\\MAIKO.INPUT.PACKET)
|
||||
)
|
||||
|of| \\MAIKO.INPUT.PACKET))
|
||||
|
||||
(* |;;|
|
||||
"Returned T, so there's another packet waiting already. Process it.")
|
||||
"Returned T, so there's another packet waiting already. Process it.")
|
||||
|
||||
(SETQ PACKET \\MAIKO.INPUT.PACKET)
|
||||
(GO READ-MORE-LOOP)))))))))))
|
||||
@@ -471,7 +443,7 @@
|
||||
|
||||
|
||||
|
||||
(* \;
|
||||
(* |;;|
|
||||
"MAIKO Log & Console message handling. Interrupt-driven message printing, instead of polled printing."
|
||||
)
|
||||
|
||||
@@ -527,14 +499,13 @@
|
||||
(RPAQ \\MAIKO.IO-INTERRUPT-FLAGS (\\CREATECELL \\FIXP))
|
||||
|
||||
(RPAQQ \\MAIKO.IO-INTERRUPT-VECTOR NIL)
|
||||
(PUTPROPS MAIKOETHER COPYRIGHT ("Venue & Xerox Corporation" 1988 1989 1990 1991 2021))
|
||||
(DECLARE\: DONTCOPY
|
||||
(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)))))
|
||||
(FILEMAP (NIL (2301 20787 (\\10MB.RESTART.ETHER 2311 . 2475) (\\10MB.STARTDRIVER 2477 . 3863) (
|
||||
\\10MB.TURNOFFETHER 3865 . 4029) (\\10MB.TURNONETHER 4031 . 6121) (\\10MBSENDPACKET 6123 . 8481) (
|
||||
\\10MBWATCHER 8483 . 9926) (\\MAIKO.10MBSENDPACKET 9928 . 12296) (\\MAIKO.10MBWATCHER 12298 . 13747) (
|
||||
\\MAIKO.ETHERRESUME 13749 . 13912) (\\MAIKO.ETHERSUSPEND 13914 . 14079) (\\MAIKO.INPUT.INTERRUPT 14081
|
||||
. 15925) (\\NS.SETTIME 15927 . 16211) (\\PUP.SETTIME 16213 . 16498) (\\MAIKO.10MBSTARTDRIVER 16500 .
|
||||
18150) (\\MAIKO.10MBTURNONETHER 18152 . 20247) (\\MAIKO.10MB.RESTART.ETHER 20249 . 20606) (
|
||||
\\MAIKO.CHECKSUM 20608 . 20785)) (21751 24528 (\\MAIKO.ETHER-INTERRUPT 21761 . 24526)) (24652 26015 (
|
||||
\\MAIKO.CONSOLE-LOG-PRINT 24662 . 26013)) (26061 26741 (\\MAIKO.IO-INTERRUPT 26071 . 26739)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
380
sources/PUP
380
sources/PUP
@@ -1,15 +1,13 @@
|
||||
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP" BASE 8)
|
||||
(FILECREATED " 1-May-2021 19:49:18" {DSK}<home>larry>ilisp>medley>sources>PUP.;2 336270Q
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 8)
|
||||
|
||||
changes to%: (FNS \PUP.SETTIME CANONICAL.HOSTNAME)
|
||||
(VARS PUPCOMS)
|
||||
(FILECREATED "22-Dec-2025 11:58:55" {DSK}<Users>briggs>projects>medley>sources>PUP.;4 334515Q
|
||||
|
||||
previous date%: "19-Jan-93 11:14:09" {DSK}<home>larry>ilisp>medley>sources>PUP.;1)
|
||||
:EDIT-BY nhb
|
||||
|
||||
:CHANGES-TO (FNS \FIND.LOCALPUPHOSTNUMBER)
|
||||
|
||||
:PREVIOUS-DATE "20-Dec-2025 13:51:34" {DSK}<Users>briggs>projects>medley>sources>PUP.;3)
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 3676-3711, 3745 by Venue & Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT PUPCOMS)
|
||||
|
||||
@@ -45,13 +43,13 @@ Copyright (c) 3676-3711, 3745 by Venue & Xerox Corporation.
|
||||
(FNS CLEARPUP PUTPUPWORD GETPUPBYTE PUTPUPBYTE GETPUPSTRING GETPUPSTREAM PUTPUPSTRING)
|
||||
(OPTIMIZERS GETPUPWORD PUTPUPWORD GETPUPBYTE PUTPUPBYTE))
|
||||
(COMS (* ;
|
||||
"Reading property lists from streams")
|
||||
"Reading property lists from streams")
|
||||
(FNS READPLIST)
|
||||
(INITVARS \READPLIST.READTABLES)
|
||||
(GLOBALVARS \READPLIST.READTABLES))
|
||||
(COMS (FNS \CANONICAL.HOSTNAME \CANONICALIZE.PUP.HOSTNAME)
|
||||
(P (* ;
|
||||
"Default this for when IP not loaded")
|
||||
"Default this for when IP not loaded")
|
||||
(MOVD? 'NILL '\CANONICALIZE.IP.HOSTNAME NIL T))
|
||||
(ADDVARS (\HOSTNAMES)
|
||||
(\SYSTEMCACHEVARS \HOSTNAMES))
|
||||
@@ -138,53 +136,52 @@ Copyright (c) 3676-3711, 3745 by Venue & Xerox Corporation.
|
||||
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(ACCESSFNS PUP [(PUPBASE (LOCF (fetch (ETHERPACKET EPBODY) of DATUM]
|
||||
[BLOCKRECORD PUPBASE ((PUPLENGTH WORD)
|
||||
(PUPTCONTROL BYTE)
|
||||
(PUPTYPE BYTE)
|
||||
(PUPID FIXP)
|
||||
(PUPDEST WORD)
|
||||
(PUPDESTSOCKET FIXP)
|
||||
(PUPSOURCE WORD)
|
||||
(PUPSOURCESOCKET FIXP)
|
||||
(PUPDATASTART 412Q WORD))
|
||||
(BLOCKRECORD PUPBASE ((NIL WORD)
|
||||
(TYPEWORD WORD)
|
||||
(PUPIDHI WORD)
|
||||
(PUPIDLO WORD)
|
||||
(PUPDESTNET BYTE)
|
||||
(PUPDESTHOST BYTE)
|
||||
(PUPDESTSOCKETHI WORD)
|
||||
(PUPDESTSOCKETLO WORD)
|
||||
(PUPSOURCENET BYTE)
|
||||
(PUPSOURCEHOST BYTE)
|
||||
(PUPSOURCESOCKETHI WORD)
|
||||
(PUPSOURCESOCKETLO WORD))
|
||||
[BLOCKRECORD PUPBASE ((PUPLENGTH WORD)
|
||||
(PUPTCONTROL BYTE)
|
||||
(PUPTYPE BYTE)
|
||||
(PUPID FIXP)
|
||||
(PUPDEST WORD)
|
||||
(PUPDESTSOCKET FIXP)
|
||||
(PUPSOURCE WORD)
|
||||
(PUPSOURCESOCKET FIXP)
|
||||
(PUPDATASTART 412Q WORD))
|
||||
(BLOCKRECORD PUPBASE ((NIL WORD)
|
||||
(TYPEWORD WORD)
|
||||
(PUPIDHI WORD)
|
||||
(PUPIDLO WORD)
|
||||
(PUPDESTNET BYTE)
|
||||
(PUPDESTHOST BYTE)
|
||||
(PUPDESTSOCKETHI WORD)
|
||||
(PUPDESTSOCKETLO WORD)
|
||||
(PUPSOURCENET BYTE)
|
||||
(PUPSOURCEHOST BYTE)
|
||||
(PUPSOURCESOCKETHI WORD)
|
||||
(PUPSOURCESOCKETLO WORD))
|
||||
(* ; "Temporary extra synonyms")
|
||||
(SYNONYM PUPDESTNET (DESTNET))
|
||||
(SYNONYM PUPDESTHOST (DESTHOST))
|
||||
(SYNONYM PUPDESTSOCKETHI (DESTSKTHI))
|
||||
(SYNONYM PUPDESTSOCKETLO (DESTSKTLO))
|
||||
(SYNONYM PUPSOURCENET (SOURCENET))
|
||||
(SYNONYM PUPSOURCEHOST (SOURCEHOST))
|
||||
(SYNONYM PUPSOURCESOCKETHI (SOURCESKTHI))
|
||||
(SYNONYM PUPSOURCESOCKETLO (SOURCESKTLO)))
|
||||
(SYNONYM PUPDEST (DEST))
|
||||
(SYNONYM PUPDESTSOCKET (DESTSKT))
|
||||
(SYNONYM PUPSOURCE (SOURCE))
|
||||
(SYNONYM PUPSOURCESOCKET (SOURCESKT))
|
||||
(ACCESSFNS PUPDATASTART ((PUPCONTENTS (LOCF DATUM]
|
||||
[ACCESSFNS PUP [(PUPCHECKSUMBASE (fetch PUPBASE of DATUM))
|
||||
(PUPCHECKSUMLOC (\ADDBASE (fetch PUPBASE of DATUM)
|
||||
(FOLDLO (SUB1 (fetch PUPLENGTH
|
||||
of DATUM))
|
||||
BYTESPERWORD]
|
||||
(BLOCKRECORD PUPCHECKSUMLOC ((PUPCHECKSUM WORD]
|
||||
(TYPE? (type? ETHERPACKET DATUM)))
|
||||
(SYNONYM PUPDESTNET (DESTNET))
|
||||
(SYNONYM PUPDESTHOST (DESTHOST))
|
||||
(SYNONYM PUPDESTSOCKETHI (DESTSKTHI))
|
||||
(SYNONYM PUPDESTSOCKETLO (DESTSKTLO))
|
||||
(SYNONYM PUPSOURCENET (SOURCENET))
|
||||
(SYNONYM PUPSOURCEHOST (SOURCEHOST))
|
||||
(SYNONYM PUPSOURCESOCKETHI (SOURCESKTHI))
|
||||
(SYNONYM PUPSOURCESOCKETLO (SOURCESKTLO)))
|
||||
(SYNONYM PUPDEST (DEST))
|
||||
(SYNONYM PUPDESTSOCKET (DESTSKT))
|
||||
(SYNONYM PUPSOURCE (SOURCE))
|
||||
(SYNONYM PUPSOURCESOCKET (SOURCESKT))
|
||||
(ACCESSFNS PUPDATASTART ((PUPCONTENTS (LOCF DATUM]
|
||||
[ACCESSFNS PUP [(PUPCHECKSUMBASE (fetch PUPBASE of DATUM))
|
||||
(PUPCHECKSUMLOC (\ADDBASE (fetch PUPBASE of DATUM)
|
||||
(FOLDLO (SUB1 (fetch PUPLENGTH of DATUM))
|
||||
BYTESPERWORD]
|
||||
(BLOCKRECORD PUPCHECKSUMLOC ((PUPCHECKSUM WORD]
|
||||
(TYPE? (type? ETHERPACKET DATUM)))
|
||||
|
||||
(ACCESSFNS PUPADDRESS ((PUPNET# (LRSH DATUM 10Q))
|
||||
(PUPHOST# (LOGAND DATUM 377Q)))
|
||||
(CREATE (IPLUS (LLSH PUPNET# 10Q)
|
||||
PUPHOST#)))
|
||||
(PUPHOST# (LOGAND DATUM 377Q)))
|
||||
(CREATE (IPLUS (LLSH PUPNET# 10Q)
|
||||
PUPHOST#)))
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
@@ -274,23 +271,26 @@ Copyright (c) 3676-3711, 3745 by Venue & Xerox Corporation.
|
||||
(RETURN T])])
|
||||
|
||||
(\FIND.LOCALPUPHOSTNUMBER
|
||||
[LAMBDA (NDB EVENT QUIET) (* bvm%: "26-Jul-84 16:27")
|
||||
[LAMBDA (NDB EVENT QUIET) (* ; "Edited 22-Dec-2025 11:58 by nhb")
|
||||
(* ; "Edited 20-Dec-2025 13:51 by nhb")
|
||||
(* bvm%: "26-Jul-84 16:27")
|
||||
|
||||
(* ;; "Finds out our pup address on this 10mb NDB")
|
||||
|
||||
(PROG (NEWNUMBER)
|
||||
[COND
|
||||
((NOT (\ETHER-AVAILABLE))
|
||||
(RETURN NIL))
|
||||
[(SETQ NEWNUMBER (\LOOKUPPUPNUMBER \MY.NSHOSTNUMBER NDB))
|
||||
(COND
|
||||
(PUPTRACEFLG (printout PUPTRACEFILE "My pup address = " (fetch PUPNET#
|
||||
of NEWNUMBER)
|
||||
(PUPTRACEFLG (printout PUPTRACEFILE "My pup address = " (fetch PUPNET# of NEWNUMBER)
|
||||
"#"
|
||||
(fetch PUPHOST# of NEWNUMBER)
|
||||
"#" T]
|
||||
(QUIET (RETURN NIL))
|
||||
(T (SETQ NEWNUMBER (\PROMPT.FOR.PUP.NUMBER (AND (EQ EVENT 'AFTERLOGOUT)
|
||||
(NEQ \OLDPUPHOST# 0)
|
||||
(OCTALSTRING \OLDPUPHOST#]
|
||||
(NEQ \OLDPUPHOST# 0)
|
||||
(OCTALSTRING \OLDPUPHOST#]
|
||||
|
||||
(* ;; "Only rely on the host number part of reply. There is confusion for machines that exist on more than one net")
|
||||
|
||||
@@ -470,14 +470,14 @@ Copyright (c) 3676-3711, 3745 by Venue & Xerox Corporation.
|
||||
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(ACCESSFNS ERRORPUP ((ERRORPUPBASE (fetch PUPCONTENTS of DATUM)))
|
||||
(BLOCKRECORD ERRORPUPBASE ((ERRORPUPCOPY 12Q WORD)
|
||||
(BLOCKRECORD ERRORPUPBASE ((ERRORPUPCOPY 12Q WORD)
|
||||
(* ; "Copy of pup header")
|
||||
(ERRORPUPCODE WORD)
|
||||
(ERRORPUPARG WORD)
|
||||
(ERRORPUPCODE WORD)
|
||||
(ERRORPUPARG WORD)
|
||||
(* ; "Usually zero")
|
||||
(ERRORPUPSTRINGBASE WORD)
|
||||
(ERRORPUPSTRINGBASE WORD)
|
||||
(* ; "Human readable message")
|
||||
)))
|
||||
)))
|
||||
)
|
||||
|
||||
(RPAQQ PUPERRORCODES
|
||||
@@ -1174,24 +1174,22 @@ Copyright (c) 3676-3711, 3745 by Venue & Xerox Corporation.
|
||||
)
|
||||
|
||||
(DEFOPTIMIZER GETPUPWORD (PUPARG WORD#)
|
||||
`(\GETBASE (fetch PUPCONTENTS of (\DTEST ,PUPARG 'ETHERPACKET))
|
||||
,WORD#))
|
||||
`(\GETBASE (fetch PUPCONTENTS of (\DTEST ,PUPARG 'ETHERPACKET))
|
||||
,WORD#))
|
||||
|
||||
(DEFOPTIMIZER PUTPUPWORD (PUPARG WORD# VALUE)
|
||||
`(\PUTBASE (fetch PUPCONTENTS of (\DTEST ,PUPARG 'ETHERPACKET))
|
||||
,WORD#
|
||||
,VALUE))
|
||||
`(\PUTBASE (fetch PUPCONTENTS of (\DTEST ,PUPARG 'ETHERPACKET))
|
||||
,WORD#
|
||||
,VALUE))
|
||||
|
||||
(DEFOPTIMIZER GETPUPBYTE (PUPARG BYTE#)
|
||||
`(\GETBASEBYTE (fetch PUPCONTENTS of (\DTEST ,PUPARG
|
||||
'ETHERPACKET))
|
||||
,BYTE#))
|
||||
`(\GETBASEBYTE (fetch PUPCONTENTS of (\DTEST ,PUPARG 'ETHERPACKET))
|
||||
,BYTE#))
|
||||
|
||||
(DEFOPTIMIZER PUTPUPBYTE (PUPARG BYTE# VALUE)
|
||||
`(\PUTBASEBYTE (fetch PUPCONTENTS of (\DTEST ,PUPARG
|
||||
'ETHERPACKET))
|
||||
,BYTE#
|
||||
,VALUE))
|
||||
`(\PUTBASEBYTE (fetch PUPCONTENTS of (\DTEST ,PUPARG 'ETHERPACKET))
|
||||
,BYTE#
|
||||
,VALUE))
|
||||
|
||||
|
||||
|
||||
@@ -1282,7 +1280,7 @@ Copyright (c) 3676-3711, 3745 by Venue & Xerox Corporation.
|
||||
)
|
||||
|
||||
(* ;
|
||||
"Default this for when IP not loaded")
|
||||
"Default this for when IP not loaded")
|
||||
|
||||
(MOVD? 'NILL '\CANONICALIZE.IP.HOSTNAME NIL T)
|
||||
|
||||
@@ -1301,8 +1299,8 @@ Copyright (c) 3676-3711, 3745 by Venue & Xerox Corporation.
|
||||
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS BINDPUPS MACRO [X (CONS (LIST 'LAMBDA (CAR X)
|
||||
(CONS 'PROGN (CDR X)))
|
||||
(in (CAR X) collect (LIST 'ALLOCATE.PUP])
|
||||
(CONS 'PROGN (CDR X)))
|
||||
(in (CAR X) collect (LIST 'ALLOCATE.PUP])
|
||||
)
|
||||
|
||||
(PUTPROPS BINDPUPS INFO BINDS)
|
||||
@@ -1597,12 +1595,12 @@ Copyright (c) 3676-3711, 3745 by Venue & Xerox Corporation.
|
||||
(DECLARE%: DONTCOPY
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(BLOCKRECORD PUPROUTINGINFO ( (* ;
|
||||
"Format of each entry in a pup routing info packet. We only actually use NET# and #HOPS")
|
||||
(NET# BYTE)
|
||||
(GATENET# BYTE)
|
||||
(GATEHOST# BYTE)
|
||||
(%#HOPS BYTE)))
|
||||
(BLOCKRECORD PUPROUTINGINFO ( (* ;
|
||||
"Format of each entry in a pup routing info packet. We only actually use NET# and #HOPS")
|
||||
(NET# BYTE)
|
||||
(GATENET# BYTE)
|
||||
(GATEHOST# BYTE)
|
||||
(%#HOPS BYTE)))
|
||||
)
|
||||
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
@@ -1628,24 +1626,24 @@ Copyright (c) 3676-3711, 3745 by Venue & Xerox Corporation.
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(DATATYPE PUPSOCKET ((NIL BITS 4)
|
||||
(PUPSOCLINK POINTER) (* ; "So that we can Queue them")
|
||||
(PSOCKET# FIXP)
|
||||
(INQUEUE POINTER)
|
||||
(INQUEUELENGTH WORD)
|
||||
(PUPSOC#ALLOCATION WORD)
|
||||
(PUPSOCHANDLE WORD) (* ; "Back-fitting for Bcpl")
|
||||
(PUPSOCPUPADDRESS WORD) (* ; "Local net/host")
|
||||
(NIL BITS 4)
|
||||
(PUPSOCEVENT POINTER) (* ;
|
||||
"Event that is notified when a pup arrives on this socket")
|
||||
(NIL BITS 4)
|
||||
(NIL POINTER))
|
||||
(BLOCKRECORD PUPSOCKET ((NIL BITS 4)
|
||||
(NIL POINTER)
|
||||
(PSOCKETHI WORD)
|
||||
(PSOCKETLO WORD)))
|
||||
INQUEUE _ (create SYSQUEUE)
|
||||
PUPSOC#ALLOCATION _ \MAX.EPKTS.ON.PUPSOCKET)
|
||||
(PUPSOCLINK POINTER) (* ; "So that we can Queue them")
|
||||
(PSOCKET# FIXP)
|
||||
(INQUEUE POINTER)
|
||||
(INQUEUELENGTH WORD)
|
||||
(PUPSOC#ALLOCATION WORD)
|
||||
(PUPSOCHANDLE WORD) (* ; "Back-fitting for Bcpl")
|
||||
(PUPSOCPUPADDRESS WORD) (* ; "Local net/host")
|
||||
(NIL BITS 4)
|
||||
(PUPSOCEVENT POINTER) (* ;
|
||||
"Event that is notified when a pup arrives on this socket")
|
||||
(NIL BITS 4)
|
||||
(NIL POINTER))
|
||||
(BLOCKRECORD PUPSOCKET ((NIL BITS 4)
|
||||
(NIL POINTER)
|
||||
(PSOCKETHI WORD)
|
||||
(PSOCKETLO WORD)))
|
||||
INQUEUE _ (create SYSQUEUE)
|
||||
PUPSOC#ALLOCATION _ \MAX.EPKTS.ON.PUPSOCKET)
|
||||
)
|
||||
|
||||
(/DECLAREDATATYPE 'PUPSOCKET '((BITS 4)
|
||||
@@ -1670,11 +1668,11 @@ Copyright (c) 3676-3711, 3745 by Venue & Xerox Corporation.
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS \PUPSOCKET.FROM# MACRO (OPENLAMBDA (SOCHI SOCLO)
|
||||
(for SOC in \PUPSOCKETS
|
||||
when (AND (EQ (fetch PSOCKETLO of SOC)
|
||||
SOCLO)
|
||||
(EQ (fetch PSOCKETHI of SOC)
|
||||
SOCHI)) do (RETURN SOC))))
|
||||
(for SOC in \PUPSOCKETS
|
||||
when (AND (EQ (fetch PSOCKETLO of SOC)
|
||||
SOCLO)
|
||||
(EQ (fetch PSOCKETHI of SOC)
|
||||
SOCHI)) do (RETURN SOC))))
|
||||
)
|
||||
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
@@ -1704,17 +1702,17 @@ Copyright (c) 3676-3711, 3745 by Venue & Xerox Corporation.
|
||||
(ADDTOVAR SYSTEMRECLST
|
||||
|
||||
(DATATYPE PUPSOCKET ((NIL BITS 4)
|
||||
(PUPSOCLINK POINTER)
|
||||
(PSOCKET# FIXP)
|
||||
(INQUEUE POINTER)
|
||||
(INQUEUELENGTH WORD)
|
||||
(PUPSOC#ALLOCATION WORD)
|
||||
(PUPSOCHANDLE WORD)
|
||||
(PUPSOCPUPADDRESS WORD)
|
||||
(NIL BITS 4)
|
||||
(PUPSOCEVENT POINTER)
|
||||
(NIL BITS 4)
|
||||
(NIL POINTER)))
|
||||
(PUPSOCLINK POINTER)
|
||||
(PSOCKET# FIXP)
|
||||
(INQUEUE POINTER)
|
||||
(INQUEUELENGTH WORD)
|
||||
(PUPSOC#ALLOCATION WORD)
|
||||
(PUPSOCHANDLE WORD)
|
||||
(PUPSOCPUPADDRESS WORD)
|
||||
(NIL BITS 4)
|
||||
(PUPSOCEVENT POINTER)
|
||||
(NIL BITS 4)
|
||||
(NIL POINTER)))
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
@@ -1826,21 +1824,21 @@ Copyright (c) 3676-3711, 3745 by Venue & Xerox Corporation.
|
||||
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(BLOCKRECORD PORT ((NETHOST WORD)
|
||||
(SOCKET FIXP))
|
||||
(BLOCKRECORD PORT ((NET BYTE)
|
||||
(HOST BYTE)
|
||||
(SOCKETHI WORD)
|
||||
(SOCKETLO WORD))))
|
||||
(SOCKET FIXP))
|
||||
(BLOCKRECORD PORT ((NET BYTE)
|
||||
(HOST BYTE)
|
||||
(SOCKETHI WORD)
|
||||
(SOCKETLO WORD))))
|
||||
|
||||
(ACCESSFNS ERRORPUP ((ERRORPUPBASE (fetch PUPCONTENTS of DATUM)))
|
||||
(BLOCKRECORD ERRORPUPBASE ((ERRORPUPCOPY 12Q WORD)
|
||||
(BLOCKRECORD ERRORPUPBASE ((ERRORPUPCOPY 12Q WORD)
|
||||
(* ; "Copy of pup header")
|
||||
(ERRORPUPCODE WORD)
|
||||
(ERRORPUPARG WORD)
|
||||
(ERRORPUPCODE WORD)
|
||||
(ERRORPUPARG WORD)
|
||||
(* ; "Usually zero")
|
||||
(ERRORPUPSTRINGBASE WORD)
|
||||
(ERRORPUPSTRINGBASE WORD)
|
||||
(* ; "Human readable message")
|
||||
)))
|
||||
)))
|
||||
)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
@@ -1868,20 +1866,20 @@ Copyright (c) 3676-3711, 3745 by Venue & Xerox Corporation.
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS \GETPUPWORD DMACRO ((PUP WORD#)
|
||||
(\GETBASE (fetch PUPCONTENTS of PUP)
|
||||
WORD#)))
|
||||
(\GETBASE (fetch PUPCONTENTS of PUP)
|
||||
WORD#)))
|
||||
|
||||
(PUTPROPS \PUTPUPWORD DMACRO ((PUP WORD# VALUE)
|
||||
(\PUTBASE (fetch PUPCONTENTS of PUP)
|
||||
WORD# VALUE)))
|
||||
(\PUTBASE (fetch PUPCONTENTS of PUP)
|
||||
WORD# VALUE)))
|
||||
|
||||
(PUTPROPS \GETPUPBYTE DMACRO ((PUP BYTE#)
|
||||
(\GETBASEBYTE (fetch PUPCONTENTS of PUP)
|
||||
BYTE#)))
|
||||
(\GETBASEBYTE (fetch PUPCONTENTS of PUP)
|
||||
BYTE#)))
|
||||
|
||||
(PUTPROPS \PUTPUPBYTE DMACRO ((PUP BYTE# VALUE)
|
||||
(\PUTBASEBYTE (fetch PUPCONTENTS of PUP)
|
||||
BYTE# VALUE)))
|
||||
(\PUTBASEBYTE (fetch PUPCONTENTS of PUP)
|
||||
BYTE# VALUE)))
|
||||
)
|
||||
|
||||
(RPAQQ RAWPUPTYPES
|
||||
@@ -2033,13 +2031,13 @@ Copyright (c) 3676-3711, 3745 by Venue & Xerox Corporation.
|
||||
(RPAQ? PUPTYPES RAWPUPTYPES)
|
||||
|
||||
(RPAQQ WELLKNOWNPUPSOCKETS ((\PUPSOCKET.TELNET 1)
|
||||
(\PUPSOCKET.ROUTING 2)
|
||||
(\PUPSOCKET.FTP 3)
|
||||
(\PUPSOCKET.MISCSERVICES 4)
|
||||
(\PUPSOCKET.ECHO 5)
|
||||
(\PUPSOCKET.EFTP 20Q)
|
||||
(\PUPSOCKET.PRINTERSTATUS 21Q)
|
||||
(\PUPSOCKET.LEAF 43Q)))
|
||||
(\PUPSOCKET.ROUTING 2)
|
||||
(\PUPSOCKET.FTP 3)
|
||||
(\PUPSOCKET.MISCSERVICES 4)
|
||||
(\PUPSOCKET.ECHO 5)
|
||||
(\PUPSOCKET.EFTP 20Q)
|
||||
(\PUPSOCKET.PRINTERSTATUS 21Q)
|
||||
(\PUPSOCKET.LEAF 43Q)))
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RPAQQ \PUPSOCKET.TELNET 1)
|
||||
@@ -2074,9 +2072,9 @@ Copyright (c) 3676-3711, 3745 by Venue & Xerox Corporation.
|
||||
|
||||
|
||||
(RPAQQ PUPCONSTANTS ((\PUPHEADERLEN 24Q)
|
||||
(\NetMask 177400Q)
|
||||
(\HILOCALSOCKET 1)
|
||||
(\PORTIDLEN 3)))
|
||||
(\NetMask 177400Q)
|
||||
(\HILOCALSOCKET 1)
|
||||
(\PORTIDLEN 3)))
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RPAQQ \PUPHEADERLEN 24Q)
|
||||
@@ -2097,28 +2095,28 @@ Copyright (c) 3676-3711, 3745 by Venue & Xerox Corporation.
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS PUPDEBUGGING MACRO [(X . Y)
|
||||
(COND
|
||||
(PUPTRACEFLG (printout PUPTRACEFILE X . Y])
|
||||
(COND
|
||||
(PUPTRACEFLG (printout PUPTRACEFILE X . Y])
|
||||
)
|
||||
|
||||
|
||||
(ADDTOVAR PUPPRINTMACROS (210Q CHARS)
|
||||
(214Q CHARS)
|
||||
(211Q CHARS)
|
||||
(213Q CHARS)
|
||||
(201Q WORDS 2 CHARS 24Q |...|)
|
||||
(30Q CHARS))
|
||||
(214Q CHARS)
|
||||
(211Q CHARS)
|
||||
(213Q CHARS)
|
||||
(201Q WORDS 2 CHARS 24Q |...|)
|
||||
(30Q CHARS))
|
||||
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(BLOCKRECORD TIMEPUPCONTENTS ((TIMEPUPVALUEHI WORD)
|
||||
(TIMEPUPVALUELO WORD)
|
||||
(TIMEPUPEASTP FLAG)
|
||||
(TIMEPUPHOURS BITS 7)
|
||||
(TIMEPUPMINUTES BITS 10Q)
|
||||
(TIMEPUPBEGINDST WORD)
|
||||
(TIMEPUPENDDST WORD)) (* ; "format of alto time response")
|
||||
)
|
||||
(TIMEPUPVALUELO WORD)
|
||||
(TIMEPUPEASTP FLAG)
|
||||
(TIMEPUPHOURS BITS 7)
|
||||
(TIMEPUPMINUTES BITS 10Q)
|
||||
(TIMEPUPBEGINDST WORD)
|
||||
(TIMEPUPENDDST WORD)) (* ; "format of alto time response")
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
@@ -2447,10 +2445,10 @@ Copyright (c) 3676-3711, 3745 by Venue & Xerox Corporation.
|
||||
(ADDTOVAR PUPIGNORETYPES )
|
||||
|
||||
(ADDTOVAR PUPPRINTMACROS (4 . PRINTERRORPUP)
|
||||
(220Q CHARS)
|
||||
(221Q REPEAT BYTES -2 WORDS -4)
|
||||
(223Q BYTES -2 WORDS)
|
||||
(224Q CHARS))
|
||||
(220Q CHARS)
|
||||
(221Q REPEAT BYTES -2 WORDS -4)
|
||||
(223Q BYTES -2 WORDS)
|
||||
(224Q CHARS))
|
||||
(DECLARE%: DONTEVAL@LOAD
|
||||
|
||||
(\PUPINIT)
|
||||
@@ -2469,32 +2467,30 @@ Copyright (c) 3676-3711, 3745 by Venue & Xerox Corporation.
|
||||
(PUTPROPS PUP MAKEFILE-ENVIRONMENT (:READTABLE "INTERLISP" :PACKAGE "INTERLISP" :BASE 10Q))
|
||||
|
||||
(PUTPROPS PUP FILETYPE CL:COMPILE-FILE)
|
||||
(PUTPROPS PUP COPYRIGHT ("Venue & Xerox Corporation" 3676Q 3677Q 3700Q 3701Q 3702Q 3703Q 3704Q 3705Q
|
||||
3706Q 3707Q 3710Q 3711Q 3745Q))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (25631Q 61606Q (\STARTPUP 25643Q . 26515Q) (ASSURE.PUP.READY 26517Q . 34612Q) (
|
||||
\FIND.LOCALPUPHOSTNUMBER 34614Q . 37012Q) (\PROMPT.FOR.PUP.NUMBER 37014Q . 41034Q) (\HANDLE.RAW.PUP
|
||||
41036Q . 57136Q) (\FORWARD.PUP 57140Q . 60060Q) (\SETPUPCHECKSUM 60062Q . 61604Q)) (66376Q 73470Q (
|
||||
\PUPERROR 66410Q . 73466Q)) (73527Q 112663Q (SETUPPUP 73541Q . 76727Q) (SWAPPUPPORTS 76731Q . 77546Q)
|
||||
(GETPUP 77550Q . 102462Q) (SENDPUP 102464Q . 106306Q) (EXCHANGEPUPS 106310Q . 110346Q) (DISCARDPUPS
|
||||
110350Q . 111154Q) (GETPUPWORD 111156Q . 111475Q) (\PUPINIT 111477Q . 112661Q)) (112664Q 154244Q (
|
||||
ETHERHOSTNAME 112676Q . 122024Q) (ETHERHOSTNUMBER 122026Q . 122441Q) (ETHERPORT 122443Q . 126162Q) (
|
||||
BESTPUPADDRESS 126164Q . 136224Q) (NETDAYTIME0 136226Q . 136557Q) (\PUP.SETTIME 136561Q . 137206Q) (
|
||||
\SETNEWTIME0 137210Q . 140270Q) (\NET.SETTIME 140272Q . 141361Q) (NETDATE 141363Q . 141720Q) (
|
||||
\LOOKUPPORT 141722Q . 147561Q) (\PARSE.PORTCONSTANT 147563Q . 152673Q) (\FIXLOCALNET 152675Q . 154242Q
|
||||
)) (154245Q 155602Q (PORTSTRING 154257Q . 155246Q) (OCTALSTRING 155250Q . 155600Q)) (156174Q 165305Q (
|
||||
CLEARPUP 156206Q . 160721Q) (PUTPUPWORD 160723Q . 161250Q) (GETPUPBYTE 161252Q . 161575Q) (PUTPUPBYTE
|
||||
161577Q . 162130Q) (GETPUPSTRING 162132Q . 163563Q) (GETPUPSTREAM 163565Q . 164514Q) (PUTPUPSTRING
|
||||
164516Q . 165303Q)) (167410Q 175227Q (READPLIST 167422Q . 175225Q)) (175410Q 200610Q (
|
||||
\CANONICAL.HOSTNAME 175422Q . 176467Q) (\CANONICALIZE.PUP.HOSTNAME 176471Q . 200606Q)) (203163Q
|
||||
236370Q (\PUPGATELISTENER 203175Q . 207026Q) (\HANDLE.PUP.ROUTING.INFO 207030Q . 221367Q) (\ROUTE.PUP
|
||||
221371Q . 225224Q) (\LOCATE.PUPNET 225226Q . 231763Q) (SORT.PUPHOSTS.BY.DISTANCE 231765Q . 234241Q) (
|
||||
\PUPNET.CLOSERP 234243Q . 235424Q) (PUPNET.DISTANCE 235426Q . 236366Q)) (250017Q 257771Q (
|
||||
OPENPUPSOCKET 250031Q . 254512Q) (CLOSEPUPSOCKET 254514Q . 256173Q) (PUPSOCKETNUMBER 256175Q . 256426Q
|
||||
) (PUPSOCKETFROMNUMBER 256430Q . 257067Q) (PUPSOCKETEVENT 257071Q . 257350Q) (\FLUSHPUPSOCQUEUE
|
||||
257352Q . 257767Q)) (257772Q 260537Q (\GETMISCSOCKET 260004Q . 260535Q)) (300551Q 313341Q (
|
||||
PUP.ECHOSERVER 300563Q . 303370Q) (PUP.ECHOUSER 303372Q . 313337Q)) (313372Q 322523Q (\PEEKPUP 313404Q
|
||||
. 320535Q) (\MAYBEPEEKPUP 320537Q . 322521Q)) (323124Q 334361Q (PRINTPUP 323136Q . 327306Q) (
|
||||
PRINTPUPROUTE 327310Q . 331255Q) (PRINTPUPDATA 331257Q . 331727Q) (PRINTERRORPUP 331731Q . 332431Q) (
|
||||
PUPTRACE 332433Q . 332744Q) (PRINTCONSTANT 332746Q . 334357Q)))))
|
||||
(FILEMAP (NIL (25117Q 61405Q (\STARTPUP 25131Q . 26003Q) (ASSURE.PUP.READY 26005Q . 34100Q) (
|
||||
\FIND.LOCALPUPHOSTNUMBER 34102Q . 36611Q) (\PROMPT.FOR.PUP.NUMBER 36613Q . 40633Q) (\HANDLE.RAW.PUP
|
||||
40635Q . 56735Q) (\FORWARD.PUP 56737Q . 57657Q) (\SETPUPCHECKSUM 57661Q . 61403Q)) (66151Q 73243Q (
|
||||
\PUPERROR 66163Q . 73241Q)) (73302Q 112436Q (SETUPPUP 73314Q . 76502Q) (SWAPPUPPORTS 76504Q . 77321Q)
|
||||
(GETPUP 77323Q . 102235Q) (SENDPUP 102237Q . 106061Q) (EXCHANGEPUPS 106063Q . 110121Q) (DISCARDPUPS
|
||||
110123Q . 110727Q) (GETPUPWORD 110731Q . 111250Q) (\PUPINIT 111252Q . 112434Q)) (112437Q 154017Q (
|
||||
ETHERHOSTNAME 112451Q . 121577Q) (ETHERHOSTNUMBER 121601Q . 122214Q) (ETHERPORT 122216Q . 125735Q) (
|
||||
BESTPUPADDRESS 125737Q . 135777Q) (NETDAYTIME0 136001Q . 136332Q) (\PUP.SETTIME 136334Q . 136761Q) (
|
||||
\SETNEWTIME0 136763Q . 140043Q) (\NET.SETTIME 140045Q . 141134Q) (NETDATE 141136Q . 141473Q) (
|
||||
\LOOKUPPORT 141475Q . 147334Q) (\PARSE.PORTCONSTANT 147336Q . 152446Q) (\FIXLOCALNET 152450Q . 154015Q
|
||||
)) (154020Q 155355Q (PORTSTRING 154032Q . 155021Q) (OCTALSTRING 155023Q . 155353Q)) (155747Q 165060Q (
|
||||
CLEARPUP 155761Q . 160474Q) (PUTPUPWORD 160476Q . 161023Q) (GETPUPBYTE 161025Q . 161350Q) (PUTPUPBYTE
|
||||
161352Q . 161703Q) (GETPUPSTRING 161705Q . 163336Q) (GETPUPSTREAM 163340Q . 164267Q) (PUTPUPSTRING
|
||||
164271Q . 165056Q)) (166651Q 174470Q (READPLIST 166663Q . 174466Q)) (174651Q 200051Q (
|
||||
\CANONICAL.HOSTNAME 174663Q . 175730Q) (\CANONICALIZE.PUP.HOSTNAME 175732Q . 200047Q)) (202406Q
|
||||
235613Q (\PUPGATELISTENER 202420Q . 206251Q) (\HANDLE.PUP.ROUTING.INFO 206253Q . 220612Q) (\ROUTE.PUP
|
||||
220614Q . 224447Q) (\LOCATE.PUPNET 224451Q . 231206Q) (SORT.PUPHOSTS.BY.DISTANCE 231210Q . 233464Q) (
|
||||
\PUPNET.CLOSERP 233466Q . 234647Q) (PUPNET.DISTANCE 234651Q . 235611Q)) (247006Q 256760Q (
|
||||
OPENPUPSOCKET 247020Q . 253501Q) (CLOSEPUPSOCKET 253503Q . 255162Q) (PUPSOCKETNUMBER 255164Q . 255415Q
|
||||
) (PUPSOCKETFROMNUMBER 255417Q . 256056Q) (PUPSOCKETEVENT 256060Q . 256337Q) (\FLUSHPUPSOCQUEUE
|
||||
256341Q . 256756Q)) (256761Q 257526Q (\GETMISCSOCKET 256773Q . 257524Q)) (277224Q 312014Q (
|
||||
PUP.ECHOSERVER 277236Q . 302043Q) (PUP.ECHOUSER 302045Q . 312012Q)) (312045Q 321176Q (\PEEKPUP 312057Q
|
||||
. 317210Q) (\MAYBEPEEKPUP 317212Q . 321174Q)) (321577Q 333034Q (PRINTPUP 321611Q . 325761Q) (
|
||||
PRINTPUPROUTE 325763Q . 327730Q) (PRINTPUPDATA 327732Q . 330402Q) (PRINTERRORPUP 330404Q . 331104Q) (
|
||||
PUPTRACE 331106Q . 331417Q) (PRINTCONSTANT 331421Q . 333032Q)))))
|
||||
STOP
|
||||
|
||||
BIN
sources/PUP.LCOM
BIN
sources/PUP.LCOM
Binary file not shown.
Reference in New Issue
Block a user