github.com/PDP-10.its
1
0
Fork 0
mirror of https://github.com/PDP-10/its.git synced 2026-04-03 21:02:59 +00:00
Code Issues Releases Wiki Activity

Added files and directories that support the MDL 55 runtime.

Browse Source
This commit is contained in:
Eric Swenson
2023-02-27 16:17:12 -08:00
parent e6cc51f558
commit d65e766017
647 changed files with 84263 additions and 3 deletions
Download Patch File Download Diff File Expand all files Collapse all files

54
LICENSE Normal file
View File

@@ -0,0 +1,54 @@
Some of the files in this repository fall under the MIT License, details of which
are found after the list of directories containing those files.
See the file COPYING for other license information for the rest of the repository.
The files and directories to which the MIT License applies are:
bin/libmud
bin/librm1
bin/librm2
bin/librm3
bin/librm4
bin/mbprog
bin/mprog
bin/mprog1
bin/mprog2
bin/mudbug
bin/mudsav
bin/mudtmp
doc/mprog2
doc/mudbug
src/libmud
src/librm1
src/librm2
src/librm3
src/librm4
src/mprog
src/mprog1
src/mprog2
src/mudbug
The MIT License (MIT)
Copyright (c) 2015 MIT Libraries
Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in all
copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
SOFTWARE.

7
Makefile
View File

@@ -45,7 +45,7 @@ SRC = syseng sysen1 sysen2 sysen3 sysnet kshack dragon channa \
lars drnil radia gjd maint bolio cent shrdlu vis cbf digest prs jsf \
decus bsg muds54 hello rrs 2500 minsky danny survey librm3 librm4 \
klotz atlogo clusys cprog r eb cpm mini nova sits nlogo bee gld mprog2 \
cfs
cfs libmud librm1 librm2 mprog mprog1 mudbug
DOC = info _info_ sysdoc sysnet syshst kshack _teco_ emacs emacs1 c kcc \
chprog sail draw wl pc tj6 share _glpr_ _xgpr_ inquir mudman system \
xfont maxout ucode moon acount alan channa fonts games graphs humor \
@@ -53,11 +53,12 @@ DOC = info _info_ sysdoc sysnet syshst kshack _teco_ emacs emacs1 c kcc \
aplogo _temp_ pdp11 chsncp cbf rug bawden llogo eak clib teach pcnet \
combat pdl minits mits_s chaos hal -pics- imlac maint cent ksc klh \
digest prs decus bsg madman hur lmdoc rrs danny netwrk klotz hello \
clu r mini nova sits jay rjl nlogo
clu r mini nova sits jay rjl nlogo mprog2 mudbug
BIN = sys sys1 sys2 emacs _teco_ lisp liblsp alan inquir sail comlap \
c decsys graphs draw datdrw fonts fonts1 fonts2 games macsym \
maint _www_ gt40 llogo bawden sysbin -pics- lmman shrdlu imlac \
pdp10 madman survey rrs clu clucmp rws mini mudsav mudsys
pdp10 madman survey rrs clu clucmp rws mini mudsav mudsys libmud \
librm1 librm2 librm3 librm4 mbprog mprog1 mprog mprog2 mudbug mudtmp
MINSRC = midas system $(DDT) $(SALV) $(KSFEDR) $(DUMP)
# These are not included on the tape.

BIN
bin/libmud/l.nbin Normal file
View File

Binary file not shown.

2
bin/libmud/libmud.dat Normal file
View File

File diff suppressed because one or more lines are too long

BIN
bin/libmud/libmud.lock Normal file
View File

Binary file not shown.

BIN
bin/libmud/libmud.nlib Normal file
View File

Binary file not shown.

94
bin/libmud/lup.fbin Normal file
View File

@@ -0,0 +1,94 @@
'<PCODE "1LUP">
<PACKAGE "LUP">
<ENTRY LUP-ACT LUP-DCT LUP-ADD-PACK LUP-ADD-DATUM LUP-DEL LIB-GC LIB-STAT DO-ADD
>
<ENTRY CUR-TYPE CUR-UPD>
<USE "LIB">
<SETG ZERO %<RSUBR!- '[ %<PCODE!- "1LUP" 0> ZERO #DECL ("VALUE" DATA-BASE
DATA-BASE FIX FIX) OENDPACKAGE ORENTRY OENTRY ORPACKAGE OPACKAGE MAKE-STRING
STRING=? HASH-NAME DEFER-FIND PACKAGE-FIND DB-HASH-MAP DB-CLOSE DB-OPEN
DB-ACCESS T OUTCHAN NM2 %<RGLOC L-LIBRARY-NAME T> (STRING) %<RGLOC MUDDLE T>
CUR-UPD %<RGLOC DB-DEAD T> "DB already active." "READB" ".LOCK" " LOCK" "PRINTO"
%<RGLOC CUR-UPD T> %<TYPE-W UPDB VECTOR> " ACTIVATED" "PRINTB" GROW-BUF %<RGLOC
GROW-BUF T> "<MDLLIB>LIBMUD" "LIBMUD;LIBMUD" DB-IN-BAD-STATE DB-OK?
"No libraries activated." %<TYPE-W DATA-BASE VECTOR> TO ".LIB" " LIB" %<RGLOC
DATA-BASES T> "DONE" ">Z" ";_" ":<" BUF %<RGLOC BUF T> "READ" "PRINT" (1) %<
RGLOC CUR-PACK T> %<RGLOC CUR-ENTRY T> %<RGLOC CUR-RENTRY T> %<RGLOC CUR-TYPE T>
%<RGLOC NO-ENT T> %<RGLOC NPACKAGE T> %<RGLOC PACKAGE T> %<RGLOC NRPACKAGE T>
%<RGLOC RPACKAGE T> %<RGLOC NENTRY T> %<RGLOC ENTRY T> %<RGLOC NRENTRY T> %<
RGLOC RENTRY T> %<RGLOC NENDPACKAGE T> %<RGLOC ENDPACKAGE T> UNBALANCED-PACKAGES
LUP-ADD-PACK ERRET-T-TO-CONTINUE PACKAGE-ALREADY-EXISTS ERRET-T-TO-REDEFINE %<
RGLOC OPACKAGE T> %<RGLOC ORPACKAGE T> %<RGLOC OENTRY T> %<RGLOC ORENTRY T> %<
RGLOC OENDPACKAGE T> INITIAL OBLIST "ATOM, " (ANY) ", GOES THROUGH INITIAL"
PACKAGE ENDPACKAGE DEFINE SETG LIST FLOAD #FALSE ("FLOAD ENCOUNTERED") UVECTOR
WORD VALUE ENTRY BAD-FIRST-ARG-TO-DEFINE-OR-SETG!-ERRORS DATUM-ALREADY-EXISTS
LUP-ADD-DATUM #FALSE ("PACKAGE NOT FOUND") PACKAGE-NOT-FOUND DO-DEL %<RGLOC SBUF
T> DATA-BASE-MUNGED TWO-PACKAGES-IN-FILE? NENDPACKAGE "GC not necessary."
" packages, " " buckets used." " packages/bucket; maximum length " " entries, "
" buckets used. " " entries/bucket; maximum length " " entries/package." %<
TYPE-C DATA-BASE VECTOR> HUV %<RGLOC HUV T> "Last update: " "Last GC: "
"Never" "File length: " " words of header and hash tables." " words." " "
" crossing" " of page boundaries. " " empty hash bucket" "Free chain is "
" entries long, containing " " word" " lost." " at "]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,ZERO PGLUE ![715827883 -1 -1 -1 -1 -1 -1
-16777216 0!]>>
<NEWTYPE UPDB VECTOR>
<SETG DB-DEAD 0>
<SETG LUP-ACT %<RSUBR-ENTRY '[ZERO LUP-ACT #DECL ("VALUE" ANY STRING "OPTIONAL"
<OR ATOM FALSE>)] 70>>
<SETG LUP-DCT %<RSUBR-ENTRY '[ZERO LUP-DCT #DECL ("VALUE" <OR FALSE STRING>
"OPTIONAL" <OR ATOM FALSE>)] 453>>
<COND (<OR <NOT <GASSIGNED? NPACKAGE>> <N==? ,PACKAGE ,NPACKAGE>> <SETG OPACKAGE
,PACKAGE> <SETG ORPACKAGE ,RPACKAGE> <SETG OENTRY ,ENTRY> <AND <GASSIGNED?
RENTRY> <SETG ORENTRY ,RENTRY>> <SETG OENDPACKAGE ,ENDPACKAGE>)>
<SETG LUP-ADD-PACK %<RSUBR-ENTRY '[ZERO LUP-ADD-PACK #DECL ("VALUE" <OR FALSE
VECTOR> STRING "OPTIONAL" <OR ATOM FALSE>)] 943>>
<SETG DO-ADD %<RSUBR-ENTRY '[ZERO DO-ADD #DECL ("VALUE" FIX STRING <LIST [REST
ATOM]> <OR FALSE <LIST [REST ATOM]>> STRING UPDB)] 1336>>
<SETG LUP-ADD-DATUM %<RSUBR-ENTRY '[ZERO LUP-ADD-DATUM #DECL ("VALUE" <OR FALSE
VECTOR> STRING STRING "OPTIONAL" ANY)] 2213>>
<SETG LUP-DEL %<RSUBR-ENTRY '[ZERO LUP-DEL #DECL ("VALUE" <OR FALSE FIX> STRING)
] 2338>>
<SETG SBUF <IUVECTOR 12 0>>
<SETG NPACKAGE %<RSUBR-ENTRY '[ZERO NPACKAGE #DECL ("VALUE" ATOM STRING "TUPLE"
TUPLE)] 3430>>
<SETG NRPACKAGE %<RSUBR-ENTRY '[ZERO NRPACKAGE #DECL ("VALUE" ATOM STRING
"TUPLE" TUPLE)] 3484>>
<SETG NENTRY %<RSUBR-ENTRY '[ZERO NENTRY #DECL ("VALUE" ATOM "TUPLE" <TUPLE [
REST ATOM]>)] 3544>>
<SETG NRENTRY %<RSUBR-ENTRY '[ZERO NRENTRY #DECL ("VALUE" ANY "TUPLE" <TUPLE [
REST ATOM]>)] 3624>>
<SETG NENDPACKAGE %<RSUBR-ENTRY '[ZERO NENDPACKAGE #DECL ("VALUE" ATOM)] 3705>>
" "
"SUBTITLE Garbage collector"
<SETG LIB-GC %<RSUBR-ENTRY '[ZERO LIB-GC #DECL ("VALUE" <OR ATOM FALSE STRING>
STRING "OPTIONAL" ANY)] 3728>>
<SETG LIB-STAT %<RSUBR-ENTRY '[ZERO LIB-STAT #DECL ("VALUE" <OR ATOM FALSE> <OR
STRING DATA-BASE>)] 5046>>
<ENDPACKAGE>

BIN
bin/libmud/nl.nbin Normal file
View File

Binary file not shown.

262
bin/libmud/nlib.fbin Normal file
View File

@@ -0,0 +1,262 @@
'<PCODE "1NLIB">
"SUBTITLE Data base definitions"
<PACKAGE "LIB">
<ENTRY DATA-BASE DB-RESET DB-OPEN DB-CLOSE DB-ACCESS DB-HASH-MAP>
<ENTRY DB-DATA DB-CHAN DB-FLEN DB-CPAGE DB-PAGE0 DB-PAGE1>
<ENTRY PACKAGE-FIND ENTRY-FIND DEFER-FIND>
<ENTRY FILNAM LASTUP LASTGC FREEPT HLEN1 HLEN2 HDRLEN>
<ENTRY BUCKET FCNCHAIN FUNCTION-NAMEBEG PACKAGE-NAMEBEG DB-MIN-ENTRY>
<ENTRY PACKAGE-CRDATE PACKAGE-ACCESS PACKAGE-ENTLEN>
<ENTRY LENHACK PTRHACK TYPHACK DEFINF>
<ENTRY LENGET PTRGET TYPGET CRDATE>
<ENTRY GET-NAME GET-FILE GET-PACKAGE RPACKAGE?>
<ENTRY ATOM=? STRING=? MAKE-STRING HASH-NAME>
<ENTRY DATA-BASES>
<ENTRY DEF-RP? DEF-PNM DEF-FNM DEF-EL DEF-REL DEF-CRDATE DEF-ACCPTR DEF-ENTLEN
DEFINF>
<SETG HDRLEN 6>
<SETG FILNAM 0>
<SETG LASTUP 1>
<SETG LASTGC 2>
<SETG FREEPT 3>
<SETG HLEN1 4>
<SETG HLEN2 5>
<MANIFEST HDRLEN FILNAM LASTUP LASTGC FREEPT HLEN1 HLEN2>
<SETG BUCKET 0>
<SETG FCNCHAIN 1>
<SETG FUNCTION-NAMEBEG 2>
<SETG PACKAGE-CRDATE 2>
<SETG PACKAGE-ACCESS 3>
<SETG PACKAGE-ENTLEN 4>
<MANIFEST PACKAGE-CRDATE PACKAGE-ACCESS PACKAGE-ENTLEN>
<SETG PACKAGE-NAMEBEG 5>
<MANIFEST BUCKET FCNCHAIN FUNCTION-NAMEBEG PACKAGE-NAMEBEG>
<SETG PTRGET <BITS 25 0>>
<SETG LENGET <BITS 10 25>>
<SETG TYPGET <BITS 1 35>>
<MANIFEST PTRGET LENGET TYPGET>
" "
"SUBTITLE In-core representation of data base"
<NEWTYPE DATA-BASE VECTOR '<<PRIMTYPE VECTOR> CHANNEL FIX FIX FIX FIX <UVECTOR [
REST FIX]> <PRIMTYPE WORD> FIX>>
<SETG DB-CHAN 1>
<SETG DB-BUF 2>
<SETG DB-PAGE0 3>
<SETG DB-PAGE1 4>
<SETG DB-CPAGE 5>
<SETG DB-DATA 6>
<SETG DB-BITS 7>
"Bits for corblk--used in DB-BITS field"
<SETG DB-FLEN 8>
"Length of file"
<MANIFEST DB-CHAN DB-BUF DB-PAGE0 DB-PAGE1 DB-CPAGE DB-DATA DB-BITS DB-FLEN>
<SETG CBNDR 4096>
<SETG CBNDW 32768>
<MANIFEST CBRED CBNDW>
<SETG PMRD 32768>
<SETG PMWR 49152>
<MANIFEST PMRD PMWR>
<OR <GASSIGNED? DATA-BASES> <SETG DATA-BASES ()>>
<GDECL (DATA-BASES) LIST>
" "
"SUBTITLE What DEFER-FIND returns"
<PUT DEFINF DECL '<VECTOR <OR ATOM FALSE> STRING STRING [2 <LIST [REST STRING]>]
[REST FIX]>>
<SETG DEF-RP? 1>
<SETG DEF-PNM 2>
<SETG DEF-FNM 3>
<SETG DEF-EL 4>
<SETG DEF-REL 5>
<SETG DEF-CRDATE 6>
<SETG DEF-ACCPTR 7>
<SETG DEF-ENTLEN 8>
<MANIFEST DEF-RP? DEF-PNM DEF-FNM DEF-EL DEF-REL DEF-CRDATE DEF-ACCPTR
DEF-ENTLEN>
" "
"SUBTITLE Data base primitives"
"Primitive operations on data base: open, close, access, reset, print, etc."
"All known data bases are kept on list DATA-BASES, as pairs: string,
data base."
"Print a data base"
<SETG DB-PRINT %<RSUBR!- '[ %<PCODE!- "1NLIB" 0> DB-PRINT #DECL ("VALUE"
CHARACTER DATA-BASE) OUTCHAN "#DATA-BASE [" "->" "<-" " \"" "--HASH--"
"--FREE--" "READB" NM2 %<RGLOC L-LIBRARY-NAME T> (STRING) %<RGLOC DATA-BASES T>
%<TYPE-W DATA-BASE VECTOR> ![!] "PRINTB" "PRINTO" %<RGLOC CBNDR T>
DATA-BASE-IN-BAD-FORMAT DB-RESET %<TYPE-C DATA-BASE VECTOR> T
NO-BUFFER-AVAILABLE]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,DB-PRINT PGLUE ![1073741823 -4194304!]>>
<PRINTTYPE DATA-BASE ,DB-PRINT>
"Put data base with specified name on list if not already there, open
it, map in hash table, etc."
<SETG DB-OPEN %<RSUBR-ENTRY '[DB-PRINT DB-OPEN #DECL ("VALUE" <OR DATA-BASE
FALSE> STRING "OPTIONAL" ANY <OR FALSE DATA-BASE>)] 212>>
"Re-initialize existing data base"
<SETG DB-RESET %<RSUBR-ENTRY '[DB-PRINT DB-RESET #DECL ("VALUE" <OR DATA-BASE
FALSE> DATA-BASE)] 331>>
"Close data base: close channel, flush buffer"
<SETG DB-CLOSE %<RSUBR-ENTRY '[DB-PRINT DB-CLOSE #DECL ("VALUE" DATA-BASE
DATA-BASE)] 391>>
"Cause hash table to be mapped (by accessing to 0)"
<SETG DB-HASH-MAP %<RSUBR-ENTRY '[DB-PRINT DB-HASH-MAP #DECL ("VALUE" <UVECTOR [
REST FIX]> DATA-BASE)] 426>>
" "
"SUBTITLE Extract data from data base"
"GET-NAME returns a string pointer to the name field of the supplied entry."
<SETG GET-NAME %<RSUBR-ENTRY '[DB-PRINT GET-NAME #DECL ("VALUE" STRING UVECTOR)]
443>>
"GET-FILE returns a string pointer to the file name for a package"
<SETG GET-FILE %<RSUBR-ENTRY '[DB-PRINT GET-FILE #DECL ("VALUE" STRING UVECTOR)]
474>>
"GET-PACKAGE returns the address in the file of the package entry for
this function"
<SETG GET-PACKAGE %<RSUBR-ENTRY '[DB-PRINT GET-PACKAGE #DECL ("VALUE" FIX
UVECTOR)] 506>>
" "
"SUBTITLE Library search routines"
"PACKAGE-FIND looks up a package in the specified data base."
<SETG PACKAGE-FIND %<RSUBR-ENTRY '[DB-PRINT PACKAGE-FIND #DECL ("VALUE" <OR
DATA-BASE FALSE STRING> STRING <OR STRING DATA-BASE> "OPTIONAL" <OR ATOM FALSE>)
] 533>>
<SETG ENTRY-FIND %<RSUBR-ENTRY '[DB-PRINT ENTRY-FIND #DECL ("VALUE" <OR FALSE <
LIST ANY>> <OR STRING ATOM> STRING)] 665>>
"DEFER-FIND returns false (if the package doesn't exist) or a list of
all the entries in the package, with the file name."
<SETG DEFER-FIND %<RSUBR-ENTRY '[DB-PRINT DEFER-FIND #DECL ("VALUE" <OR FALSE <
VECTOR <OR ATOM FALSE> STRING STRING [2 <LIST [REST STRING]>] [REST FIX]>>
STRING <OR STRING DATA-BASE> "OPTIONAL" <OR ATOM FALSE>)] 858>>
" "
"SUBTITLE Data base primitive crufties"
<SETG DB-ACCESS %<RSUBR-ENTRY '[DB-PRINT DB-ACCESS #DECL ("VALUE" <UVECTOR [REST
FIX]> DATA-BASE FIX)] 1082>>
" "
"SUBTITLE Library crufties"
<SETG ATOM=? %<RSUBR-ENTRY '[DB-PRINT ATOM=? #DECL ("VALUE" <OR ATOM FALSE>
UVECTOR STRING)] 1163>>
<SETG MAKE-STRING %<RSUBR-ENTRY '[DB-PRINT MAKE-STRING #DECL ("VALUE" STRING
UVECTOR FIX)] 1193>>
" "
"SUBTITLE Hashing function"
"HASH-NAME takes a string, a uvector (the hash table, which includes the
db header), and a fix, which is the offset in the uv of the hash table
length. It returns a fix."
<SETG HASH-NAME %<RSUBR-ENTRY '[DB-PRINT HASH-NAME #DECL ("VALUE" FIX STRING
UVECTOR FIX)] 1209>>
" "
"SUBTITLE Creation date"
<SETG CRDATE %<RSUBR-ENTRY '[DB-PRINT CRDATE #DECL ("VALUE" FIX CHANNEL)] 1246>>
<ENDPACKAGE>

161
bin/libmud/nlup.fbin Normal file
View File

@@ -0,0 +1,161 @@
'<PCODE "NLUP">
<PACKAGE "LUP">
<ENTRY LUP-ACT LUP-DCT LUP-ADD-PACK LUP-ADD-DATUM LUP-DEL LIB-GC LIB-STAT DO-ADD
FLUSH-CURRENT-PACKAGE>
<ENTRY CUR-TYPE CUR-UPD>
<USE "LIB">
<SETG ZERO %<RSUBR!- '[ %<PCODE!- "NLUP" 0> ZERO #DECL ("VALUE" DATA-BASE
DATA-BASE FIX FIX) GET-FILE L-UNUSE OUSE-DEFER OUSE OENDPACKAGE ORENTRY OENTRY
ORPACKAGE OPACKAGE MANIFEST? MAKE-STRING GET-NAME HASH-NAME ENDPACKAGE
DEFER-FIND PACKAGE-FIND LOAD-PACKAGE CRDATE TELL DB-HASH-MAP DB-CLOSE DB-OPEN
DB-ACCESS %<RGLOC MUDDLE T> T OUTCHAN SNM (STRING) NM2 %<RGLOC L-LIBRARY-NAME T>
CUR-UPD %<RGLOC DB-DEAD T> "DB already active." "READB" "READ" ".LOCK" " LOCK"
"PRINTB" "ZDATA.TMP" "_DATA TMP" "PRINTO" "PRINT" %<RGLOC CUR-UPD T> %<TYPE-W
UPDB VECTOR> " ACTIVATED" "Creating new library " GROW-BUF %<RGLOC GROW-BUF T>
"<MDLLIB>LIBMUD" "LIBMUD;LIBMUD" %<RGLOC L-DATFILE-NAME T> DB-IN-BAD-STATE
DB-OK? "No libraries activated." %<TYPE-W DATA-BASE VECTOR> TO %<RGLOC
DATA-BASES T> "DONE" ">Z" ";_" ":<" BUF %<RGLOC BUF T> (1) %<RGLOC NO-ENT T>
UNBALANCED-PACKAGES LUP-ADD-PACK ERRET-T-TO-CONTINUE %<RGLOC CUR-PACK T> %<RGLOC
CUR-ENTRY T> %<RGLOC CUR-RENTRY T> PACKAGE-ALREADY-EXISTS ERRET-T-TO-REDEFINE %<
RGLOC CUR-USES T> %<RGLOC CUR-USE-DEFERS T> #FALSE ("NO ENTRIES IN PACKAGE") #
FALSE ("FILE DID NOT DEFINE A PACKAGE") LOAD-ACT (ACTIVATION) %<RGLOC
LOAD-CHANNEL T> %<RGLOC ALL-USES T> %<RGLOC CUR-TYPE T> %<RGLOC NPACKAGE T> %<
RGLOC PACKAGE T> %<RGLOC NRPACKAGE T> %<RGLOC RPACKAGE T> %<RGLOC NENTRY T> %<
RGLOC ENTRY T> %<RGLOC NRENTRY T> %<RGLOC RENTRY T> %<RGLOC NENDPACKAGE T> %<
RGLOC ENDPACKAGE T> %<RGLOC NUSE T> %<RGLOC USE T> %<RGLOC EXTERNAL T> %<RGLOC
NUSE-DEFER T> %<RGLOC USE-DEFER T> %<RGLOC OPACKAGE T> %<RGLOC ORPACKAGE T> %<
RGLOC OENTRY T> %<RGLOC ORENTRY T> %<RGLOC OENDPACKAGE T> %<RGLOC OUSE T> %<
RGLOC OUSE-DEFER T> FILE-SYSTEM-ERROR!-ERRORS CONTROL-G?!-ERRORS
UNASSIGNED-VARIABLE!-ERRORS GVAL UNBOUND-VARIABLE!-ERRORS VALUE CALLER USE-DEFER
CUR-PACK "Flushing load of package " ": error during loading."
"Flushing load of current package:" INITIAL OBLIST "ATOM, " (ANY)
", GOES THROUGH INITIAL" PACKAGE ENDPACKAGE DEFINE SETG LIST FLOAD #FALSE (
"FLOAD ENCOUNTERED") UVECTOR WORD ENTRY BAD-FIRST-ARG-TO-DEFINE-OR-SETG!-ERRORS
DATUM-ALREADY-EXISTS LUP-ADD-DATUM #FALSE ("PACKAGE NOT FOUND")
PACKAGE-NOT-FOUND DO-DEL %<RGLOC SBUF T> DATA-BASE-MUNGED (<LIST [REST OBLIST]>)
" " PACKAGE-HAS-NO-OBLIST? WRITE-PACKAGE "Package "
" can't have datfile entry." "RPACKAGE " "PACKAGE " RENTRY USE "<NEWTYPE " " "
DECL "<PUT " " DECL " "<SETG " " %<RSUBR-ENTRY '[\\ \\ F!- " "] 0>>" ">"
MANIFEST GDECL "<ENDPACKAGE>" "WARNING: two packages defined in file " "Only "
" will be added to the library." "The second package is " TWO-PACKAGES-IN-FILE?
NENDPACKAGE %<RGLOC SACRED-PACKAGES T> RPACKAGE "GC not necessary." %<RGLOC
SAVED-ENTRIES T> " getting new entry." " being flushed." " being flushed: "
"--" %<RGLOC CUV T> LOAD-FAILED GC-NEW-PACKAGE HUV %<RGLOC HUV T>
"Last update: " "Last GC: " "Never" "Library file length: "
" words of header and hash tables." " packages, " " words." " " " crossing"
" of page boundaries. " " empty hash bucket" " entries, " "Free chain is "
" entries long, containing " " word" " lost." "The data file is empty."
"The data file is " " words long; " " words in use."
" packages with data file entries." " at "]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,ZERO PGLUE ![715827882 -22906142721 -1 -1 -1
-1 -1 -1 -1 -1 -1 -4194304 0!]>>
<NEWTYPE UPDB VECTOR '<<PRIMTYPE VECTOR> DATA-BASE <OR FALSE DATA-BASE> CHANNEL
<OR CHANNEL FALSE> CHANNEL STRING STRING>>
<SETG UPDB-BASE 1>
<SETG UPDB-NEW 2>
<SETG UPDB-DATFILE 3>
<SETG UPDB-NEWDAT 4>
<SETG UPDB-LOCK 5>
<SETG UPDB-ONAME 6>
<SETG UPDB-NNAME 7>
<MANIFEST UPDB-BASE UPDB-NEW UPDB-DATFILE UPDB-NEWDAT UPDB-LOCK UPDB-ONAME
UPDB-NNAME>
<SETG DB-MIN-ENTRY <+ ,FUNCTION-NAMEBEG 1 1>>
<MANIFEST DB-MIN-ENTRY>
<SETG DB-DEAD 0>
<SETG LOAD-CHANNEL <>>
<GDECL (DB-DEAD) FIX (NO-ENT) FIX (LOAD-CHANNEL) <OR CHANNEL FALSE>>
<SETG LUP-ACT %<RSUBR-ENTRY '[ZERO LUP-ACT #DECL ("VALUE" ANY STRING "OPTIONAL"
<OR ATOM FALSE> <OR ATOM FALSE>)] 150>>
<SETG LUP-DCT %<RSUBR-ENTRY '[ZERO LUP-DCT #DECL ("VALUE" <OR FALSE STRING>
"OPTIONAL" <OR ATOM FALSE>)] 634>>
<COND (<OR <NOT <GASSIGNED? NPACKAGE>> <N==? ,PACKAGE ,NPACKAGE>> <SETG OPACKAGE
,PACKAGE> <SETG ORPACKAGE ,RPACKAGE> <SETG OENTRY ,ENTRY> <AND <GASSIGNED?
RENTRY> <SETG ORENTRY ,RENTRY>> <SETG OENDPACKAGE ,ENDPACKAGE> <SETG OUSE ,USE>
<SETG OUSE-DEFER ,USE-DEFER>)>
<SETG LUP-ADD-PACK %<RSUBR-ENTRY '[ZERO LUP-ADD-PACK #DECL ("VALUE" <OR ATOM
FALSE <VECTOR <OR ATOM FALSE> STRING STRING [2 <LIST [REST STRING]>] [REST FIX]>
> STRING "OPTIONAL" <OR ATOM FALSE> <OR ATOM FALSE>)] 1162>>
<SETG LOAD-PACKAGE %<RSUBR-ENTRY '[ZERO LOAD-PACKAGE #DECL ("VALUE" ANY CHANNEL)
] 1388>>
<SETG LUP-ERROR-HANDLER %<RSUBR-ENTRY '[ZERO LUP-ERROR-HANDLER #DECL ("VALUE"
ANY FRAME "TUPLE" TUPLE)] 1672>>
<ON "ERROR" ,LUP-ERROR-HANDLER 100>
<SETG DO-ADD %<RSUBR-ENTRY '[ZERO DO-ADD #DECL ("VALUE" FIX STRING <LIST [REST
ATOM]> <OR FALSE <LIST [REST ATOM]>> <LIST [REST STRING]> <LIST [REST STRING]>
FIX STRING UPDB <OR ATOM FALSE>)] 1926>>
<SETG LUP-ADD-DATUM %<RSUBR-ENTRY '[ZERO LUP-ADD-DATUM #DECL ("VALUE" <OR FALSE
<VECTOR <OR ATOM FALSE> STRING STRING [2 <LIST [REST STRING]>] [REST FIX]>>
STRING STRING "OPTIONAL" ANY)] 2865>>
<SETG LUP-DEL %<RSUBR-ENTRY '[ZERO LUP-DEL #DECL ("VALUE" <OR FALSE FIX> STRING)
] 3001>>
<SETG SBUF <IUVECTOR 12 0>>
<SETG NPACKAGE %<RSUBR-ENTRY '[ZERO NPACKAGE #DECL ("VALUE" ATOM STRING "TUPLE"
TUPLE)] 4922>>
<SETG NRPACKAGE %<RSUBR-ENTRY '[ZERO NRPACKAGE #DECL ("VALUE" ATOM STRING
"TUPLE" TUPLE)] 4973>>
<SETG NENTRY %<RSUBR-ENTRY '[ZERO NENTRY #DECL ("VALUE" ATOM "TUPLE" <TUPLE [
REST ATOM]>)] 5129>>
<SETG NRENTRY %<RSUBR-ENTRY '[ZERO NRENTRY #DECL ("VALUE" ATOM "TUPLE" <TUPLE [
REST ATOM]>)] 5209>>
<SETG NENDPACKAGE %<RSUBR-ENTRY '[ZERO NENDPACKAGE #DECL ("VALUE" ATOM)] 5289>>
<SETG NUSE %<RSUBR-ENTRY '[ZERO NUSE #DECL ("VALUE" ATOM "TUPLE" ANY)] 5312>>
<SETG NUSE-DEFER %<RSUBR-ENTRY '[ZERO NUSE-DEFER #DECL ("VALUE" ATOM "TUPLE" ANY
)] 5364>>
<SETG FLUSH-CURRENT-PACKAGE %<RSUBR-ENTRY '[ZERO FLUSH-CURRENT-PACKAGE #DECL (
"VALUE" <OR ATOM FALSE STRING>)] 5416>>
<SETG SACRED-PACKAGES ("PP" "PCK" "FIXUP" "HELPLD" "EDIT" "FR&" "GRLOAD" "PAGES"
"LIB" "LUP" "NLIB" "NLUP")>
<SETG LIB-GC %<RSUBR-ENTRY '[ZERO LIB-GC #DECL ("VALUE" <OR ATOM FALSE STRING>
STRING "OPTIONAL" ANY ANY <OR ATOM FALSE>)] 5671>>
<SETG SAVED-ENTRIES <IUVECTOR 1022 ()>>
<SETG CUV <IUVECTOR 30>>
<SETG TELL %<RSUBR-ENTRY '[ZERO TELL #DECL ("VALUE" ATOM "TUPLE" ANY)] 7119>>
<SETG LIB-STAT %<RSUBR-ENTRY '[ZERO LIB-STAT #DECL ("VALUE" <OR ATOM FALSE>
STRING)] 7438>>
<ENDPACKAGE>

BIN
bin/libmud/nlup.nbin Normal file
View File

Binary file not shown.

BIN
bin/libmud/nlupcr.nbin Normal file
View File

Binary file not shown.

272
bin/libmud/npck.fbin Normal file
View File

@@ -0,0 +1,272 @@
'<PCODE "3NPCK">
<BLOCK <ROOT>>
\ \ F
PACKAGE
RPACKAGE
ENTRY
RENTRY
EXTERNAL
USE
USE-TOTAL
USE-DATFILE
DROP
NULL-OBLIST
ENDPACKAGE
FILSTR
FILPRS
L-SEARCH-PATH
L-SECOND-NAMES
L-LOAD
L-LOADER
L-DOITEM
L-LIBRARY-NAME
L-DATFILE-NAME
L-DATUM
USE-DATUM
L-NO-FILES
L-NO-MAGIC
L-ALWAYS-INQUIRE
L-USE-DATFILE
L-MUST-DATFILE
L-HANDLER
L-UNUSE
USE-DEFER
L-GASSIGNED?
L-NO-DEFER
L-NOISY
L-TRANSLATIONS
TRANSLATE
UNTRANSLATE
TRANSLATIONS
IN-COLLECTION
<MOBLIST PACKAGE 29>
<MOBLIST PKG!-PACKAGE 17>
"Set up entries in LIB that we use. This eliminates the necessity
of previous obscene hacks, and may even make it possible to glue this
crock."
<BLOCK (<MOBLIST LIB!-PACKAGE 17> <ROOT>)>
ENTRY-FIND
PACKAGE-FIND
DEFER-FIND
DEFINF
DEF-RP?
DEF-PNM
DEF-FNM
DEF-EL
DEF-REL
DEF-CRDATE
DEF-ACCPTR
DEF-ENTLEN
CRDATE
<ENDBLOCK>
<SETG OBLIST (<GET INITIAL OBLIST> <ROOT>)>
<BLOCK (<MOBLIST IPKG!-PKG!-PACKAGE 23> <GET PKG!-PACKAGE OBLIST> <ROOT> <GET
LIB!-PACKAGE OBLIST>)>
<PARSE "SEARCH!-PKG!-PACKAGE">
<SETG PKG!-PACKAGE .OBLIST>
<SETG PKG-OB <GET PACKAGE OBLIST>>
<SETG COL-OB <MOBLIST RPACKAGE 7>>
<SETG L-SEARCH-PATH <COND (<G? ,MUDDLE 100> '("LIBMUD" [] "PS:<MDLLIB>LIBMUD" [
"PS" "MDLLIB"])) ('("LIBMUD" [] "LIBMUD;LIBMUD" ["DSK" "MBPROG"] ["DSK" "MPROG"
">"]))>>
<SETG L-SECOND-NAMES <COND (<G? ,MUDDLE 100> '["FBIN" "GBIN" "NBIN" "MUD"]) ('[
"FBIN" "GBIN" "NBIN" ">"])>>
<GDECL (L-SECOND-NAMES) VECTOR (L-SEARCH-PATH) <LIST [REST <OR STRING VECTOR>]>
(MUDDLE) FIX>
<SETG L-LIBRARY-NAME "NLIB">
<SETG L-DATFILE-NAME "DAT">
<SETG L-NO-FILES <>>
<SETG L-NOISY T>
<OR <GASSIGNED? L-TRANSLATIONS> <SETG L-TRANSLATIONS ()>>
<SETG SAVSTR <REST " " 6>>
<SETG \ \ F %<RSUBR!- '[ %<PCODE!- "3NPCK" 0> \ \ F #DECL ("TUPLE" ANY)
ENTRY-FIND DROP USE PACKAGE-FIND DEFER-FIND CRDATE BAD-PURECODE-NAME %<RGLOC
SAVSTR T> LOAD-FAILED \ \ F "READ" %<RGLOC MUDDLE T> ":<" %<RGLOC L-SEARCH-PATH
T> OUTCHAN %<RGLOC OUTCHAN T> (CHANNEL) NO-LOAD (ANY) OBLIST "" %<RGLOC PKG-OB T
> NOT-LOADED %<RGLOC L-NOISY T> "/" "<>" L-LOADER %<RGLOC L-LOADER T> T
IN-COLLECTION NM2 (STRING) L-ALWAYS-DATFILE %<RGLOC L-ALWAYS-DATFILE T>
CANT-USE-DATFILE-ENTRY FIND/LOAD %<RGLOC L-DATFILE-NAME T> USE-DEFER
DATFILE-MISSING CANT-FIND-PACKAGE LOAD-DATFILE %<RGLOC L-NO-FILES T>
PACKAGE-FIND "DSK" %<RGLOC L-SECOND-NAMES T> IOBLIST %<RGLOC COL-OB T> ENTRY
NOT-IN-PACKAGE-OR-COLLECTION!-ERRORS ALREADY-USED-ELSEWHERE!-ERRORS
L-USE-DATFILE %<RGLOC L-USE-DATFILE T> USE PACKAGE NOT-FOUND!-ERRORS
"PACKAGE DID NOT DEFINE FUNCTION" DROP NOT-PACKAGE-OR-COLLECTION!-ERRORS %<RGLOC
NULL-OBLIST T> UNMATCHED-ENDPACKAGE-OR-ENDCOLLECTION!-ERRORS "PACKAGE REMOVED"
%<RGLOC UDOB T> "DATUM REMOVED" #FALSE ("NOT PACKAGE OR DATUM") %<RGLOC
L-TRANSLATIONS T> %<RGLOC L-NO-DEFER T> %<RGLOC DEFER-FIND T> #FALSE (
"DATUM NOT FOUND") #FALSE ("NOT TRANSLATED") "No translations" "-->" %<RGLOC
PACKAGE-FIND T> REDEFINE UNASSIGNED-VARIABLE!-ERRORS GVAL
UNBOUND-VARIABLE!-ERRORS VALUE CALLER %<RGLOC ERRET T> %<RGLOC L-NO-MAGIC T> %<
RGLOC IOB T> %<RGLOC L-ALWAYS-INQUIRE T> "
To get " " dynamically load
0 none -- generate error
" " " " from " "# to load? " %<RGLOC INCHAN T>]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,\ \ F PGLUE ![715915263 -1 -1 -1 -1
-17179869184!]>>
<SETG FILSTR %<RSUBR-ENTRY '[\ \ F FILSTR #DECL ("VALUE" STRING "TUPLE" <TUPLE [
REST STRING]>)] 101>>
<SETG FILPRS %<RSUBR-ENTRY '[\ \ F FILPRS #DECL ("VALUE" <LIST [4 STRING] [REST
STRING]> STRING)] 182>>
<SETG SEARCH %<RSUBR-ENTRY '[\ \ F SEARCH #DECL ("VALUE" <OR CHANNEL FALSE <
VECTOR <VECTOR <OR ATOM FALSE> [2 STRING] [2 <LIST [REST STRING]>] [REST FIX]>
STRING>> ANY <LIST [REST <OR STRING VECTOR>]> "OPTIONAL" <OR ATOM FALSE>)] 737>>
<SETG PACKAGE %<RSUBR-ENTRY '[\ \ F PACKAGE #DECL ("VALUE" ATOM STRING
"OPTIONAL" STRING FIX FIX)] 908>>
<SETG RPACKAGE %<RSUBR-ENTRY '[\ \ F RPACKAGE #DECL ("VALUE" ATOM STRING
"OPTIONAL" STRING FIX)] 1086>>
<SETG RENTRY %<RSUBR-ENTRY '[\ \ F RENTRY #DECL ("VALUE" ATOM "TUPLE" <TUPLE [
REST ATOM]>)] 1248>>
<SETG ENTRY %<RSUBR-ENTRY '[\ \ F ENTRY #DECL ("VALUE" ATOM "TUPLE" <TUPLE [REST
ATOM]>)] 1278>>
<SETG USE-DATFILE %<RSUBR-ENTRY '[\ \ F USE-DATFILE #DECL ("VALUE" ATOM "TUPLE"
ANY)] 1415>>
<SETG USE %<RSUBR-ENTRY '[\ \ F USE #DECL ("VALUE" ATOM "TUPLE" <TUPLE [REST
STRING]>)] 1510>>
<SETG USE-TOTAL %<RSUBR-ENTRY '[\ \ F USE-TOTAL #DECL ("VALUE" ATOM "TUPLE" <
TUPLE [REST STRING]>)] 1683>>
<SETG L-NO-DEFER <>>
<SETG L-GASSIGNED? %<RSUBR-ENTRY '[\ \ F L-GASSIGNED? #DECL ("VALUE" <OR ATOM
FALSE> ANY)] 1963>>
<SETG EXTERNAL ,USE>
<SETG DROP %<RSUBR-ENTRY '[\ \ F DROP #DECL ("VALUE" ATOM "TUPLE" <TUPLE [REST
STRING]>)] 2054>>
<SETG NULL-OBLIST <MOBLIST NULL 1>>
<SETG ENDPACKAGE %<RSUBR-ENTRY '[\ \ F ENDPACKAGE #DECL ("VALUE" ATOM "OPTIONAL"
<OR FALSE ATOM STRING>)] 2263>>
<SETG L-UNUSE %<RSUBR-ENTRY '[\ \ F L-UNUSE #DECL ("VALUE" <OR ATOM STRING !<
FALSE STRING!>> <OR STRING FALSE>)] 2450>>
<SETG USE-DEFER %<RSUBR-ENTRY '[\ \ F USE-DEFER #DECL ("VALUE" ATOM "TUPLE" <
TUPLE [REST STRING]>)] 2608>>
<SETG L-DATUM %<RSUBR-ENTRY '[\ \ F L-DATUM #DECL ("VALUE" ANY ANY "OPTIONAL"
ANY)] 2972>>
<SETG UDOB <MOBLIST USE-DATUM 17>>
<SETG USE-DATUM %<RSUBR-ENTRY '[\ \ F USE-DATUM #DECL ("VALUE" ANY ANY)] 3035>>
<SETG TRANSLATE %<RSUBR-ENTRY '[\ \ F TRANSLATE #DECL ("VALUE" <OR FALSE STRING>
STRING <OR FALSE STRING>)] 3088>>
<SETG UNTRANSLATE %<RSUBR-ENTRY '[\ \ F UNTRANSLATE #DECL ("VALUE" <OR STRING !<
FALSE STRING!>> STRING)] 3149>>
<SETG TRANSLATIONS %<RSUBR-ENTRY '[\ \ F TRANSLATIONS #DECL ("VALUE" ATOM)] 3214
>>
<SETG L-LOAD %<RSUBR-ENTRY '[\ \ F L-LOAD #DECL ("VALUE" <OR CHANNEL FALSE
STRING> ANY "OPTIONAL" ANY)] 3360>>
<SETG L-NO-MAGIC <>>
<SETG L-ALWAYS-INQUIRE <>>
<SETG IOB <GET <LOOKUP "INITIAL" <ROOT>> OBLIST>>
<SETG L-HANDLER %<RSUBR-ENTRY '[\ \ F L-HANDLER #DECL ("VALUE" ANY FRAME "TUPLE"
TUPLE)] 3413>>
"Load library hackers"
<USE "LIB">
<ENDBLOCK>
<ENDBLOCK>
<SET OBLIST ,OBLIST>
<ON "ERROR" ,L-HANDLER 100>

BIN
bin/libmud/npck.nbin Normal file
View File

Binary file not shown.

238
bin/libmud/pck.fbin Normal file
View File

@@ -0,0 +1,238 @@
'<PCODE "NPCK">
<BLOCK <ROOT>>
PACKAGE
RPACKAGE
ENTRY
RENTRY
EXTERNAL
USE
USE-TOTAL
DROP
NULL-OBLIST
ENDPACKAGE
FILSTR
FILPRS
L-SEARCH-PATH
L-SECOND-NAMES
L-LOAD
L-LOADER
L-DOITEM
L-LIBRARY-NAME
L-DATUM
USE-DATUM
L-NO-FILES
L-NO-MAGIC
L-ALWAYS-INQUIRE
L-HANDLER
L-UNUSE
USE-DEFER
L-GASSIGNED?
L-NO-DEFER
L-NOISY
L-TRANSLATIONS
TRANSLATE
UNTRANSLATE
TRANSLATIONS
<MOBLIST PACKAGE 29>
<MOBLIST PKG!-PACKAGE 17>
"Set up entries in LIB that we use. This eliminates the necessity
of previous obscene hacks, and may even make it possible to glue this
crock."
<BLOCK (<MOBLIST LIB!-PACKAGE 17> <ROOT>)>
ENTRY-FIND
PACKAGE-FIND
DEFER-FIND
<ENDBLOCK>
<SETG OBLIST (<GET INITIAL OBLIST> <ROOT>)>
<BLOCK (<MOBLIST IPKG!-PKG!-PACKAGE 23> <GET PKG!-PACKAGE OBLIST> <ROOT> <GET
LIB!-PACKAGE OBLIST>)>
<PARSE "SEARCH!-PKG!-PACKAGE">
<SETG PKG!-PACKAGE .OBLIST>
<SETG PKG-OB <GET PACKAGE OBLIST>>
<SETG COL-OB <MOBLIST RPACKAGE 7>>
<SETG L-SEARCH-PATH <COND (<G? ,MUDDLE 100> '("LIBMUD" "<LIBMUD>LIBMUD" [] [
"MDLLIB"])) ('("LIBMUD" "LIBMUD;LIBMUD" [] ["MBPROG"] ["MPROG" ">"]))>>
<SETG L-SECOND-NAMES <COND (<G? ,MUDDLE 100> '["FBIN" "GBIN" "NBIN" "MUD"]) ('[
"FBIN" "GBIN" "NBIN" ">"])>>
<GDECL (L-SECOND-NAMES) VECTOR (L-SEARCH-PATH) <LIST [REST <OR STRING VECTOR>]>>
<SETG L-LIBRARY-NAME "LIB">
<SETG L-NO-FILES <>>
<SETG L-NOISY T>
<SETG L-TRANSLATIONS ()>
<SETG FILSTR %<RSUBR!- '[ %<PCODE!- "NPCK" 0> FILSTR #DECL ("VALUE" STRING
"TUPLE" <TUPLE [REST STRING]>) USE DROP ENTRY-FIND PACKAGE-FIND "READ" %<RGLOC
MUDDLE T> ":<" %<RGLOC L-SEARCH-PATH T> OUTCHAN %<RGLOC OUTCHAN T> (CHANNEL)
OBLIST "" %<RGLOC PKG-OB T> %<RGLOC L-NOISY T> "/" "<>" L-LOADER %<RGLOC
L-LOADER T> T IN-COLLECTION %<RGLOC L-NO-FILES T> PACKAGE-FIND %<RGLOC
L-SECOND-NAMES T> "DSK" IOBLIST %<RGLOC COL-OB T> USE-DEFER ENTRY
NOT-IN-PACKAGE-OR-COLLECTION!-ERRORS ALREADY-USED-ELSEWHERE!-ERRORS USE PACKAGE
NOT-FOUND!-ERRORS "PACKAGE DID NOT DEFINE FUNCTION" DROP
NOT-PACKAGE-OR-COLLECTION!-ERRORS %<RGLOC NULL-OBLIST T>
UNMATCHED-ENDPACKAGE-OR-ENDCOLLECTION!-ERRORS "PACKAGE REMOVED" %<RGLOC UDOB T>
"DATUM REMOVED" #FALSE ("NOT PACKAGE OR DATUM") %<RGLOC L-TRANSLATIONS T> %<
RGLOC L-NO-DEFER T> %<RGLOC DEFER-FIND T> #FALSE ("DATUM NOT FOUND") #FALSE (
"NOT TRANSLATED") "No translations" "-->" %<RGLOC PACKAGE-FIND T> REDEFINE (ANY)
UNASSIGNED-VARIABLE!-ERRORS GVAL UNBOUND-VARIABLE!-ERRORS VALUE CALLER %<RGLOC
ERRET T> %<RGLOC L-NO-MAGIC T> %<RGLOC IOB T> %<RGLOC L-ALWAYS-INQUIRE T>
"
To get " " dynamically load
0 none -- generate error
" " " " from " "# to load? " %<RGLOC INCHAN T>]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,FILSTR PGLUE ![717225983 -1 -1 -4 0!]>>
<SETG FILPRS %<RSUBR-ENTRY '[FILSTR FILPRS #DECL ("VALUE" <LIST [4 STRING] [REST
STRING]> STRING)] 84>>
<SETG FIND/LOAD %<RSUBR-ENTRY '[FILSTR FIND/LOAD #DECL ("VALUE" <OR ATOM CHANNEL
FALSE> STRING "OPTIONAL" <OR LIST STRING>)] 122>>
<SETG SEARCH %<RSUBR-ENTRY '[FILSTR SEARCH #DECL ("VALUE" <OR CHANNEL FALSE> ANY
<LIST [REST <OR STRING VECTOR>]>)] 359>>
<SETG PACKAGE %<RSUBR-ENTRY '[FILSTR PACKAGE #DECL ("VALUE" ATOM STRING
"OPTIONAL" STRING FIX FIX)] 481>>
<SETG RPACKAGE %<RSUBR-ENTRY '[FILSTR RPACKAGE #DECL ("VALUE" ATOM STRING
"OPTIONAL" STRING FIX)] 644>>
<SETG RENTRY %<RSUBR-ENTRY '[FILSTR RENTRY #DECL ("VALUE" ATOM "TUPLE" <TUPLE [
REST ATOM]>)] 791>>
<SETG ENTRY %<RSUBR-ENTRY '[FILSTR ENTRY #DECL ("VALUE" ATOM "TUPLE" <TUPLE [
REST ATOM]>)] 821>>
<SETG DO-ENTRY %<RSUBR-ENTRY '[FILSTR DO-ENTRY #DECL ("VALUE" ATOM <TUPLE [REST
ATOM]> OBLIST)] 855>>
<SETG USE %<RSUBR-ENTRY '[FILSTR USE #DECL ("VALUE" ATOM "TUPLE" <TUPLE [REST
STRING]>)] 965>>
<SETG USE-TOTAL %<RSUBR-ENTRY '[FILSTR USE-TOTAL #DECL ("VALUE" ATOM "TUPLE" <
TUPLE [REST STRING]>)] 1117>>
<SETG L-NO-DEFER <>>
<SETG L-GASSIGNED? %<RSUBR-ENTRY '[FILSTR L-GASSIGNED? #DECL ("VALUE" <OR ATOM
FALSE> ANY)] 1393>>
<SETG EXTERNAL ,USE>
<SETG DROP %<RSUBR-ENTRY '[FILSTR DROP #DECL ("VALUE" ATOM "TUPLE" <TUPLE [REST
STRING]>)] 1487>>
<SETG NULL-OBLIST <MOBLIST NULL 1>>
<SETG ENDPACKAGE %<RSUBR-ENTRY '[FILSTR ENDPACKAGE #DECL ("VALUE" ATOM)] 1696>>
<SETG L-UNUSE %<RSUBR-ENTRY '[FILSTR L-UNUSE #DECL ("VALUE" <OR ATOM STRING !<
FALSE STRING!>> <OR STRING FALSE>)] 1844>>
<SETG TRANSLATE? %<RSUBR-ENTRY '[FILSTR TRANSLATE? #DECL ("VALUE" <OR FALSE
STRING> STRING)] 1963>>
<SETG USE-DEFER %<RSUBR-ENTRY '[FILSTR USE-DEFER #DECL ("VALUE" ATOM "TUPLE" <
TUPLE [REST STRING]>)] 2005>>
<SETG L-DATUM %<RSUBR-ENTRY '[FILSTR L-DATUM #DECL ("VALUE" ANY ANY "OPTIONAL"
ANY)] 2368>>
<SETG UDOB <MOBLIST USE-DATUM 17>>
<SETG USE-DATUM %<RSUBR-ENTRY '[FILSTR USE-DATUM #DECL ("VALUE" ANY ANY)] 2429>>
<SETG TRANSLATE %<RSUBR-ENTRY '[FILSTR TRANSLATE #DECL ("VALUE" <OR FALSE STRING
> STRING <OR FALSE STRING>)] 2482>>
<SETG UNTRANSLATE %<RSUBR-ENTRY '[FILSTR UNTRANSLATE #DECL ("VALUE" <OR STRING
!<FALSE STRING!>> STRING)] 2543>>
<SETG TRANSLATIONS %<RSUBR-ENTRY '[FILSTR TRANSLATIONS #DECL ("VALUE" ATOM)]
2608>>
<SETG GDCHN %<RSUBR-ENTRY '[FILSTR GDCHN #DECL ("VALUE" ANY STRING <OR LIST
STRING> "OPTIONAL" ANY)] 2685>>
<SETG L-LOAD %<RSUBR-ENTRY '[FILSTR L-LOAD #DECL ("VALUE" <OR CHANNEL FALSE
STRING> ANY "OPTIONAL" ANY)] 2764>>
<SETG L-NO-MAGIC <>>
<SETG L-ALWAYS-INQUIRE <>>
<SETG IOB <GET <LOOKUP "INITIAL" <ROOT>> OBLIST>>
<SETG L-HANDLER %<RSUBR-ENTRY '[FILSTR L-HANDLER #DECL ("VALUE" ANY FRAME
"TUPLE" TUPLE)] 2817>>
<SETG DISP-CHOICE %<RSUBR-ENTRY '[FILSTR DISP-CHOICE #DECL ("VALUE" <OR FALSE <
LIST [REST <OR ATOM FALSE STRING>]>> <LIST [REST STRING STRING <OR ATOM FALSE> <
OR ATOM FALSE>]> ANY)] 3177>>
"Load library hackers"
<USE "LIB">
<ENDBLOCK>
<ENDBLOCK>
<SET OBLIST ,OBLIST>
<ON "ERROR" ,L-HANDLER 100>

BIN
bin/libmud/pcksbr.nbin Normal file
View File

Binary file not shown.

BIN
bin/librm1/acchrs.nbin Normal file
View File

Binary file not shown.

150
bin/librm1/acheck.fbin Normal file
View File

@@ -0,0 +1,150 @@
'<PCODE "ACHECK">
<PACKAGE "ACHECK">
<ENTRY CHECK-FILE CHECK-ABSTR CHECK-PRINT ABSTR? NEW-DESC MAP-FIELD SDM-INIT
SDM-END OLD-NEW KNOWN-OBJECT-TYPES>
<USE "DECLM" "APRINT" "ACONST" "SDML" "STR">
<SET CAT #FALSE ()>
<SET DESC #FALSE ()>
<GDECL (KNOWN-OBJECT-TYPES) <VECTOR [REST STRING]>>
<SETG KNOWN-OBJECT-TYPES ["SUBR" "FSUBR" "PACKAGE" "FILE" "COLLECTION"
"FUNCTION" "MACRO" "ASSEMBLY-CODE" "DATUM"]>
<SETG UNIQUE-NAME 1>
<SETG OBJTYP 4>
<SETG CONTENTS 5>
<SETG DESCRIPTION 11>
<SETG ARGUMENT 12>
<SETG EXAMPLE 13>
<MANIFEST UNIQUE-NAME OBJTYP CONTENTS DESCRIPTION ARGUMENT EXAMPLE>
<SETG CHECK-FILE %<RSUBR!- '[ %<PCODE!- "ACHECK" 0> CHECK-FILE #DECL ("VALUE"
ANY STRING "OPTIONAL" ANY) PRINTSPEC SDM-INIT ABSTR-LOAD CHECK-ABSTR1 SDM-END T
"READ" G (LIST) "Checking file " #FALSE () "DONE"]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,CHECK-FILE PGLUE ![716177344!]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,CHECK-FILE GLUE ![336613655 13891564016
285459014 4179559761 1073751380 26793213952 262158 524300!]>>
<SETG CHECK-ABSTR %<RSUBR!- '[ %<PCODE!- "ACHECK" 111> CHECK-ABSTR #DECL (
"VALUE" ANY VECTOR "OPTIONAL" ANY) SDM-INIT CHECK-ABSTR1 SDM-END T "DONE"]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,CHECK-ABSTR PGLUE ![720371712!]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,CHECK-ABSTR GLUE ![336613655 12903252550
-3221225472 262158 524300!]>>
<SETG CHECK-ABSTR1 %<RSUBR!- '[ %<PCODE!- "ACHECK" 158> CHECK-ABSTR1 #DECL (
"VALUE" ANY VECTOR ANY) ABSTR? CHECK-PRINT EPRIN1 "OBJECT-NOT-ABSTRACT?"]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,CHECK-ABSTR1 PGLUE ![717225984!]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,CHECK-ABSTR1 GLUE ![67178496 537522212 0
524294!]>>
\
<SETG CHECK-PRINT %<RSUBR!- '[ %<PCODE!- "ACHECK" 199> CHECK-PRINT #DECL (
"VALUE" ANY <OR ATOM <PRIMTYPE LIST>> ANY) INDENT-TO EPRIN1 T " -- OKAY"
" -- OKAY w/o CATEGORY, DESCRIPTOR check" #FALSE () WARN " WARNINGS:"
COMPLAIN " ERRORS:"]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,CHECK-PRINT PGLUE ![738196480!]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,CHECK-PRINT GLUE ![67116113 -4019064336
22817275904 474943601 16174817364 1342177280 524294!]>>
<SETG SDM-INIT %<RSUBR!- '[ %<PCODE!- "ACHECK" 303> SDM-INIT #DECL ("VALUE" ANY
) SDMOPN CAT "MU.IRS;ACDATA CAT" DESC "MU.IRS;ACDATA DESC" "INIT"]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,SDM-INIT PGLUE ![805044224!]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,SDM-INIT GLUE ![17231379249 8509980672 2!]>>
<SETG SDM-END %<RSUBR!- '[ %<PCODE!- "ACHECK" 335> SDM-END #DECL ("VALUE" ANY)
SDMDCT CAT #FALSE () DESC]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,SDM-END PGLUE ![801112064!]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,SDM-END GLUE ![17231364287 13182746368 2!]>>
\
<SETG ABSTR? %<RSUBR!- '[ %<PCODE!- "ACHECK" 373> ABSTR? #DECL ("VALUE" <OR
ATOM LIST FALSE> VECTOR ANY) ABSTR-ELE? MAP-FIELD COMPLAIN () (LIST) WARN #FALSE
() ABSTR-DECL ABSTR-FORM "Description must have at least two elements"
"one-line-description" "One-line-description not filled in?" ["PACKAGE"
"RPACKAGE" "COLLECTION" "FILE"] "Argument template in bad format?" " --
" "Argument template empty near character: " "Example empty or not vector?"
"--args--" "'--args--'/still present in Example"
"Example of the use of this PACKAGE" "Comments on example"
"Example prompt still present?" KNOWN-OBJECT-TYPES "Unknown OBJECT-TYPE" CAT
"Unknown CATEGORY(s)" DESC NEW-DESC "Unknown DESCRIPTOR(s)"
"Abstract is old length, possibly needs Notes field."
"Abstract is wrong length." T]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,ABSTR? PGLUE ![738197503 -4 0!]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,ABSTR? GLUE ![22951174140 4460551 -16371411643
83906560 626331649 4303097927 -16823349248 15855681 5655040256 18254599232
1141178368 22678668372 245777 -4294967296 4259841 22615704583 -16906977008
253690896 16191004420 4298113119 4294971460 30068998431 1090535728 1082203263
8325759041 13166190337 -4290260496 17523544135 -16895704064 0 0!]>>
\
<SETG ABSTR-ELE? %<RSUBR!- '[ %<PCODE!- "ACHECK" 917> ABSTR-ELE? #DECL ("VALUE"
ANY <OR ATOM STRING FORM VECTOR> <OR ATOM STRING FORM VECTOR> <OR ATOM STRING
FORM VECTOR>) OBJ-DECL ALOSE T [] #FALSE () COMPLAIN]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,ABSTR-ELE? PGLUE ![737935360!]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,ABSTR-ELE? GLUE ![4440336 -3959422460
33285996545 22549626880 67108864 4294967296 17537438720 549723200 8661246148
7583301632 786440!]>>
<SETG ALOSE %<RSUBR!- '[ %<PCODE!- "ACHECK" 1098> ALOSE #DECL ("VALUE" LIST
FALSE STRING) "DECL problem in '" "' section"]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,ALOSE PGLUE ![1006632960!]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,ALOSE GLUE ![67355584 16777216 524294!]>>
<SETG MAP-FIELD %<RSUBR!- '[ %<PCODE!- "ACHECK" 1127> MAP-FIELD #DECL ("VALUE"
ANY PMCHAN ANY) SDMGET () T %<TYPE-W PMCHAN VECTOR>]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,MAP-FIELD PGLUE ![801112064!]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,MAP-FIELD GLUE ![67175424 16173254613
1543505937 1048580 4295049216 524294!]>>
\
<SETG OLD-NEW %<RSUBR!- '[ %<PCODE!- "ACHECK" 1219> OLD-NEW #DECL ("VALUE" ANY
<OR ATOM STRING> "OPTIONAL" STRING) ABSTR-LOAD FIX-ABSTR ABSTR-DUMP
"DSK:_ABST_ >" "
Processing file " " into " ".
" G #FALSE () "DONE"]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,OLD-NEW PGLUE ![718273536!]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,OLD-NEW GLUE ![336613655 12888835008
16177434895 -29544677312 517 18318872576 0 262158 524300!]>>
<SETG FIX-ABSTR %<RSUBR!- '[ %<PCODE!- "ACHECK" 1334> FIX-ABSTR #DECL ("VALUE"
<OR VECTOR FALSE> VECTOR) PPRINT
"
-- adding Notes field, Date and time fields"
", Ports field and Data-ports fields" "one-line-description"
", 'short description' string." "
-- adding Date and time fields." "*** NOT AN ABSTRACT ***" #FALSE (
"NOT AN ABSTRACT")]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,FIX-ABSTR PGLUE ![805289984!]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,FIX-ABSTR GLUE ![21233920 67109956 71565380
17179873028 1066000 1088 1073811457 4294967296 -4212064255 3933456 67124228
1145045071 788529152!]>>
<ENDPACKAGE>

BIN
bin/librm1/aerror.nbin Normal file
View File

Binary file not shown.

214
bin/librm1/ahack.fbin Normal file
View File

@@ -0,0 +1,214 @@
'<PCODE "1AHACK">
<PACKAGE "AHACK">
<ENTRY ABSTR-XLOAD ABSTR-UPDATER Abstract COPY-ABSTR CREATE-TEMPLATE ABSTR-XDUMP
ABSTR-BUG GET-HELP OPEN-ABSTR ABSTR-RESTORE ABSTR-SAVE START-AHACK>
<USE "EHACK" "BUF" "CALRDR" "CALSYM" "CALCOM" "ACONST" "APRINT" "NSTRUC" "EUTL"
"APPRINT" "STR" "AMAKE" "EGROUP">
<SETG ABSTR-RESTORE %<RSUBR!- '[ %<PCODE!- "1AHACK" 0> ABSTR-RESTORE #DECL (
"VALUE" <OR FALSE STRING> STRING) KEYWORD-CHARS INIT-NODE INIT-TYPE MAKEBST
BSTSORT BUFPRINT GETSTR BUFMAKE RTIME DATE N-GET-RID-OF PPRINT-ABSTR BGSTSORT
RESTYPES ARGTYPES NO-DUPES UPPERCASE PARSEABLE MAKE-COPY NPUT DECL-COMMENT
SEARCH COMMAND-UPDATE ADD-OBJECT BUFTOS PPRINT POS AFIND OPEN-OBJECT CLOSE-ABSTR
NNTH PRINT-ABSTR READER #FALSE () Abstract AUTODEF NODE-GROUP AUTO-TABLE
"Abstract.default" OUTCHAN "YOUR RESTORE FILE IS OUT OF DATE BUT SHOULD WIN"
OBLIST INITIAL %<RGLOC AB-OB T> (<LIST [REST OBLIST]>) ADUMP (ACTIVATION)
"ABSTR" "to file (opt)"
"
File into which the abstracts will be dumped. Default is name of the first abstract
to be dumped ABSTR." "" "FILE" T "PRINT" OBJOPEN %<RGLOC OBJOPEN T> "Close " %<
RGLOC UNAMEPOS T> "?"
"
If non-false, the abstract which is opened will be closed." "ANY" "DUMPED" %<
RGLOC OBJTYPE T> ABSTYPE %<RGLOC ABSTYPE T> %<RGLOC NODELIST T> %<RGLOC NTYPE3 T
> () ";XABSTR _TEMP_" %<RGLOC OBJVECT T> OPEN-ABSTR ,OBJVECT PUT AGROUP-TABLE
LASTEDIT %<RGLOC SCRATCHES T> SCRATCH <BUFMAKE 20> ADDSTRING GET SCRATCH-TABLE
SCRATCHES "READ" "SAVED" "NO Abstracts LOADED" COMMENT "LOADED" #FALSE (
"File not found") ["FSUBR" "SUBR"] Template #FALSE (
"Template field not for SUBR or FSUBR") #FALSE ("No abstract open") Example
"Example of use of this " "--args--" "Comments on example" Category "INTERNAL"
Descriptor Description.One.line "One line description of this "
"One-line description of object" Description.Detailed
"Detailed description of this " "Detailed description of object"
Template.description "PROMPT" Template.decl Argument NSRET NSCONT Unique.name
Name %<RGLOC OCOMLIST T> %<RGLOC OPEN-COMMANDS!-IEHACK T> %<RGLOC
DO-OPEN-OBJECT!-IEHACK T> %<RGLOC OBJNAME T> %<RGLOC OBJLOADTAB T>
"MABSTR;ABSTR HELP" #FALSE ("No help for this node") INCHAN BUG
"You are already reporting a bug.
To exit type ^B then $O
" "to XABSTR, / Back to BUG, / Leave BUG,  (from BUG)" %<RGLOC BUG T>
"MARC;BUG" %<RGLOC BUGCHAN T> "FOO" "BAR" "INT" "MARC" %<RSUBR!- '[ %<PCODE!-
"1AHACK" 2996> ANONF1!-TMP #DECL ("VALUE" BUFFER CHARACTER) ADDCHR %<RGLOC
BUGBUF T> %<TYPE-W BUFFER VECTOR>]> %<RGLOC BUG-INT-CHAN T> "BUG FROM " " ON "
" AT " "(BUFFER): " %<RGLOC BUG-OUT T> CHRTABLE %<RGLOC BUGBUF T> %<TYPE-W
BUFFER VECTOR> BUGACT Reference %<RGLOC POSVECT T> ["Unique.name" Unique.name
"Name" Name "Author" Author "Object.type" Object.type "Category" Category
"Descriptor" Descriptor "Location" Location "Reference" Reference "Description"
Description "Description.One.line" Description.One.line "Description.Detailed"
Description.Detailed "Example" Example "Notes" Notes "External.interactions"
External.interactions "Side.effect" Side.effect "Variables" Variables
"Variables.Global" Variables.Global "Global.Setg" Global.Setg "Global.Used"
Global.Used "Variables.Local" Variables.Local "Local.Set" Local.Set "Local.Used"
Local.Used "Local.Special" Local.Special "Functions" Functions "Environment"
Environment "Environment.Required" Environment.Required "Environment.During"
Environment.During "Environment.After" Environment.After "Datums.used"
Datums.used] ["Contents" Contents "Ports" Ports "Internal.functions"
Internal.functions "Data.ports" Data.ports "Data.ports.global" Data.ports.global
"Data.ports.local" Data.ports.local "Internal.data" Internal.data
"Internal.data.global" Internal.data.global "Internal.data.local"
Internal.data.local "Packages.used" Packages.used] ["Argument" Argument
"Template" Template "Template.decl" Template.decl "Template.description"
Template.description "Argument.type" Argument.type "Result.type" Result.type
"Called.by" Called.by] "NTYPE1" %<RGLOC NTYPE1 T> "NTYPE2" %<RGLOC NTYPE2 T>
"NTYPE3" "FUNCTION" "RSUBR" "ASSEMBLY-CODE" "SUBR" "FSUBR" "MACRO" "PACKAGE"
"COLLECTION" <AND <GASSIGNED? BUG> <RETURN <PROG () <END-ASCRIPT ,BUG-INT-CHAN>
<TERPRI> <PRINC "bug-mode-continued"> <MY-TTY-OFF>> .BUGACT>> %<RGLOC XSPCCHARS
T> %<RGLOC SPCCHARS T> %<RGLOC ABSTR-XLOAD T> %<RGLOC ABSTR-XDUMP T> %<RGLOC
OPEN-ABSTR T> %<RGLOC A-PRINT T> %<RGLOC VERIFY-ABSTR T> %<RGLOC EMPTY-NODE T>
%<RGLOC ABSTR-UPDATER T> AHACK!-PACKAGE IAHACK %<RGLOC KEYWD T> SPECIAL-CHECKS
%<RGLOC TCHECKER T>]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,ABSTR-RESTORE PGLUE ![0 0 0 0 0 0 0 0 0 0 0 0!
]>>
<SETG ABSTR-XDUMP %<RSUBR-ENTRY '[ABSTR-RESTORE ABSTR-XDUMP #DECL ("VALUE" ANY <
LIST [REST VECTOR]>)] 93>>
<SETG OPEN-ABSTR %<RSUBR-ENTRY '[ABSTR-RESTORE OPEN-ABSTR #DECL ("VALUE" ANY
VECTOR)] 330>>
<SETG ABSTR-SAVE %<RSUBR-ENTRY '[ABSTR-RESTORE ABSTR-SAVE #DECL ("VALUE" STRING
STRING ANY)] 413>>
<SETG ABSTR-XLOAD %<RSUBR-ENTRY '[ABSTR-RESTORE ABSTR-XLOAD #DECL ("VALUE" <OR
ATOM FALSE STRING> <OR STRING FALSE> <OR ATOM FALSE>)] 786>>
<SETG CREATE-TEMPLATE %<RSUBR-ENTRY '[ABSTR-RESTORE CREATE-TEMPLATE #DECL (
"VALUE" ANY)] 1029>>
<SETG COPY-ABSTR %<RSUBR-ENTRY '[ABSTR-RESTORE COPY-ABSTR #DECL ("VALUE" ANY <OR
VECTOR FALSE> <PRIMTYPE LIST> "OPTIONAL" <OR ATOM FALSE>)] 1108>>
<SETG EMPTY-NODE %<RSUBR-ENTRY '[ABSTR-RESTORE EMPTY-NODE #DECL ("VALUE" <OR
ATOM FALSE STRING> ATOM ANY)] 1287>>
<SETG ABSTR-UPDATER %<RSUBR-ENTRY '[ABSTR-RESTORE ABSTR-UPDATER #DECL ("VALUE"
ANY ATOM ANY)] 1620>>
<SETG VERIFY-ABSTR %<RSUBR-ENTRY '[ABSTR-RESTORE VERIFY-ABSTR #DECL ("VALUE" <OR
ATOM FALSE> ANY)] 1950>>
<SETG TCHECKER %<RSUBR-ENTRY '[ABSTR-RESTORE TCHECKER #DECL ("VALUE" STRUCTURED
ATOM VECTOR)] 1977>>
<SETG A-PRINT %<RSUBR-ENTRY '[ABSTR-RESTORE A-PRINT #DECL ("VALUE" ANY VECTOR)]
2026>>
<SETG GET-HELP %<RSUBR-ENTRY '[ABSTR-RESTORE GET-HELP #DECL ("VALUE" <OR CHANNEL
FALSE> <OR ATOM FALSE>)] 2043>>
<SETG ASCRIPT %<RSUBR-ENTRY '[ABSTR-RESTORE ASCRIPT #DECL ("VALUE" <VECTOR <LIST
CHANNEL>> CHANNEL)] 2148>>
<SETG END-ASCRIPT %<RSUBR-ENTRY '[ABSTR-RESTORE END-ASCRIPT #DECL ("VALUE" <OR
FALSE <VECTOR STRUCTURED>> CHANNEL)] 2217>>
<SETG ABSTR-BUG %<RSUBR-ENTRY '[ABSTR-RESTORE ABSTR-BUG #DECL ("VALUE" ATOM)]
2303>>
<SETG BUG-OUT %<RSUBR-ENTRY '[ABSTR-RESTORE BUG-OUT #DECL ("VALUE" ANY BUFFER
CHARACTER)] 2527>>
<SETG KEYWD %<RSUBR-ENTRY '[ABSTR-RESTORE KEYWD #DECL ("VALUE" ATOM CHARACTER <
OR ATOM FALSE>)] 2567>>
<SETG POSVECT '['(Notes ![14!] VECTOR 10906) '((Example "AUTO") ![13!] VECTOR
10673) '(Argument ![12!] ["Template" "Argument.type" "Result.type"] 9955) '((
Template.description "AUTO") ![12 1 2!] BUFFER) '((Description.Detailed "AUTO")
![11 2!] BUFFER) '((Description.One.line "AUTO") ![11 1!] BUFFER) '(Description
![11!] <OR STRING <VECTOR [REST <OR STRING LIST>]>> 9636) '(Reference ![10!] <OR
STRING ATOM <VECTOR [REST <OR STRING ATOM>]>> 9276) '(Location ![9!] <OR STRING
ATOM <VECTOR [REST <OR STRING ATOM>]>> 8753) '(Datums.used ![8 6!] <VECTOR [REST
STRING]> 8617) '(Packages.used ![8 5!] <VECTOR [REST STRING]> 8547) '((
Descriptor "APPEND" "AUTO") ![7!] <OR STRING ATOM <VECTOR [REST <OR STRING ATOM>
]>> 4179) ((Category "APPEND" "AUTO" "SYMBOL" (<MAKEBST "Categories" <BSTSORT '[
"ARITHMETIC" "ARITHMETIC" "ASSOCIATION" "ASSOCIATION" "BIT-TWIDDLING"
"BIT-TWIDDLING" "CHARACTER" "CHARACTER" "COMMAND-HANDLING" "COMMAND-HANDLING"
"CONDITIONAL" "CONDITIONAL" "DATA-BASE-MANAGEMENT" "DATA-BASE-MANAGEMENT"
"DATA-HANDLING" "DATA-HANDLING" "ENVIRONMENT" "ENVIRONMENT" "ERROR" "ERROR"
"GRAPHICS" "GRAPHICS" "IDENTIFIER" "IDENTIFIER" "INTERNAL" "INTERNAL"
"INTERRUPT" "INTERRUPT" "I/O" "I/O" "LOCATIVE" "LOCATIVE" "LOGICAL" "LOGICAL"
"NETWORK" "NETWORK" "PICTURE" "PICTURE" "PREDICATE" "PREDICATE"
"PROCESS-CONTROL" "PROCESS-CONTROL" "PROGRAM-CONTROL" "PROGRAM-CONTROL"
"PROGRAM-UNDERSTANDING" "PROGRAM-UNDERSTANDING" "SIMULATION" "SIMULATION"
"SYSTEM" "SYSTEM" "TYPE" "TYPE" "TYPE-DEFINITION" "TYPE-DEFINITION"
"TYPE-MANIPULATION" "TYPE-MANIPULATION" "UTILITY" "UTILITY"]>> ["SYM" "MULT"
"STRING"])) ![6!] '<OR STRING ATOM <VECTOR [REST <OR STRING ATOM>]>> 4004) ((
Object.type "SYMBOL" (<MAKEBST "Object types" '["ASSEMBLY-CODE" "ASSEMBLY-CODE"
"COLLECTION" "COLLECTION" "FILE" "FILE" "FSUBR" "FSUBR" "FUNCTION" "FUNCTION"
"MACRO" "MACRO" "PACKAGE" "PACKAGE" "RSUBR" "RSUBR" "SUBR" "SUBR"]> ["SYM"])) ![
4!] '<OR ATOM STRING <VECTOR [REST <OR ATOM STRING>]>> 1007) '(Author ![3!] <OR
ATOM STRING <VECTOR [REST <OR ATOM STRING>]>> 767) '(Name ![2!] <OR ATOM STRING>
549) '(Unique.name ![1!] <OR ATOM STRING> 0) '(Result.type ![12 3!] <VECTOR [
REST <OR STRING ATOM>]> 10597) '(Argument.type ![12 2!] <VECTOR [REST <OR STRING
ATOM>]> 10429) '(Template.decl ![12 1 1!] DECL) '(Template ![12 1!] <OR DECL <
VECTOR DECL [REST STRING]>> 10049) '(Environment.After ![8 4 3!] <VECTOR [REST <
OR STRING LIST>]> 8161) '(Environment.During ![8 4 2!] <VECTOR [REST <OR STRING
LIST>]> 7920) '(Environment.Required ![8 4 1!] <VECTOR [REST <OR STRING LIST>]>
7612) '(Environment ![8 4!] ["Environment.Required" "Environment.During"
"Environment.After"] 7274) '(Functions ![8 3!] <VECTOR [REST <OR STRING ATOM>]>
7031) '(Local.Special ![8 2 2 3!] <VECTOR [REST <OR STRING DECL>]> 6897) '(
Local.Used ![8 2 2 2!] <VECTOR [REST <OR STRING DECL>]> 6801) '(Local.Set ![8 2
2 1!] <VECTOR [REST <OR STRING DECL>]> 6594) '(Variables.Local ![8 2 2!] [
"Local.Set" "Local.Used" "Local.Special"] 6303) '(Global.Used ![8 2 1 2!] <
VECTOR [REST <OR STRING DECL>]> 6188) '(Global.Setg ![8 2 1 1!] <VECTOR [REST <
OR STRING DECL>]> 5965) '(Variables.Global ![8 2 1!] ["Global.Setg"
"Global.Used"] 5800) '(Variables ![8 2!] [["Variables.Global" "Global.Setg"
"Global.Used"] ["Variables.Local" "Local.Set" "Local.Used" "Local.Special"]]
5638) '(Side.effect ![8 1!] <VECTOR [REST <OR STRING ATOM>]> 5269) '(
External.interactions ![8!] ["Side.effect" ["Variables" ["Variables.Global"
"Global.Setg" "Global.Used"] ["Variables.Local" "Local.Set" "Local.Used"
"Local.Special"]] "Functions" ["Environment" "Environment.Required"
"Environment.During" "Environment.After"] "Packages.used" "Datums.used"
"Called.by"] 4741) '(Internal.data.local ![5 4 2!] <VECTOR [REST <OR STRING DECL
>]> 3887) '(Internal.data.global ![5 4 1!] <VECTOR [REST <OR STRING DECL>]> 3768
) '(Internal.data ![5 4!] ["Internal.data.global" "Internal.data.local"] 3639) '
(Data.ports.local ![5 3 2!] <VECTOR [REST <OR STRING DECL>]> 3568) '(
Data.ports.global ![5 3 1!] <VECTOR [REST <OR STRING DECL>]> 3493) '(Data.ports
![5 3!] ["Data.ports.global" "Data.ports.local"] 3146) '(Internal.functions ![5
2!] <VECTOR [REST <OR STRING ATOM>]> 2827) '(Ports ![5 1!] <VECTOR [REST <OR
STRING ATOM>]> 2051) '(Contents ![5!] ["Ports" "Internal.functions" [
"Data.ports" "Data.ports.global" "Data.ports.local"] ["Internal.data"
"Internal.data.global" "Internal.data.local"]] 1584) '(Called.by ![8 7!] <VECTOR
[REST <OR STRING ATOM>]> 8683)]>
<SETG START-AHACK %<RSUBR-ENTRY '[ABSTR-RESTORE START-AHACK #DECL ("VALUE" ANY)]
2586>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,ABSTR-RESTORE GLUE ![1073757695 1207701251
-17179608061 -1057997823 13252 269554047 -4282367729 1894798607 -4227841023
251723760 4027060720 13136575509 21491613732 22820274449 4630524156 3229859903
-17116945284 4215029760 267312 7635468544 17788829700 18237030983 147456
274012159 1136672768 240 71561237 18522116097 23387180040 16106127615 -16777213
8334016853 4194304 -4027580353 -16173220862 70751 -1048576 17175675221 4194304
19264191488 4528066 -4159766512 3313 4 1039154193 4370202688 4214852 8606728464
5490103676 71332097 4299227143 -16822300416 3949909 19323158528 267387904
11781948 33554432000 274010380 30128204800 201326720 536911089 -13136559807
1343238916 1080029248 1140867104 8585740288 262144 4332716033 18530418688
1044484 40768 256 33301741776 -1073741824 1311220 18826257 4307550208 69644 0
17196707904 16126312448 1357905920 20669530116 -12620660736 1320912 -4214162432
322 33570180364 128 2097168384 67125184 17253204992 268435456 278528 9663807489
5453199340 -16978496768 33555200 33554451 34036826112 46140416 17515676796
201333772 4194816 805503024 352411392 12888064000 17039360 262431 17212887040
4294967555 611319808 16778240 12922654805 4580196868 535823360 268697604 786432
1426181904 262211 50331649 1086327808 4259904 16781324 135381004 524480
2166096064 8389633 1426338243 16224416563 17125408767 -217906240 12897546764
809272064 -17128689403 21504246787 1812777779 739000321 -16976706816 -4294840204
4100 4313594883 272629776 125045763 71581635 -1073676288 2193682496 2142268
4294967304 11819483139 -4294709248 16911449856 1056965616 66060351 196735
269222336 17230447619 808464384 12935431164 1069563840 782398 -3825204800
201261056 67108863 262148 262478 524707 525080 1031 525412 787552 525581 525914
264098 526271 264174 264191 264296 264365 2305 526821 526861!]>>
<ENDPACKAGE>

75
bin/librm1/alib.fbin Normal file
View File

@@ -0,0 +1,75 @@
'<PCODE "ALIB">
<PACKAGE "ALIB">
<USE "SMP" "AMAKE" "ACONST">
<ENTRY LOAD-ENTRY LOAD-BUNCH LOAD-PACKAGE DUMP-ENTRY DUMP-BUNCH DUMP-PACKAGE
DELETE-ENTRY DELETE-PACKAGE LOAD-OR-MAKE SUBR-ABSTR>
<USE "SMP" "SDML" "IRSBAS" "PMAP" "APRINT" "AMAKE" "ACONST">
<SETG CONTENTS 5>
<MANIFEST CONTENTS>
<SETG IRSF ["LIBMIR;IRSMUD OBJDAT" "LIBMIR;IRSMUD OBJMAP"]>
<GDECL (IRSF) <VECTOR [2 STRING]>>
<SETG ALIB-SMPOPN %<RSUBR!- '[ %<PCODE!- "ALIB" 0> ALIB-SMPOPN #DECL ("VALUE" <
OR FALSE <VECTOR [2 PMCHAN]>> <VECTOR [2 STRING]>) SMPOPN PCLOSE]>>
<SETG LOAD-ENTRY %<RSUBR!- '[ %<PCODE!- "ALIB" 34> LOAD-ENTRY #DECL ("VALUE"
ANY <OR FIX ATOM STRING> "OPTIONAL" ANY) ALIB-SMPOPN ALIB-NAME SDMDSRC
LOAD-ENTRY1 SMPDCT IRSF]>>
<SETG LOAD-ENTRY1 %<RSUBR!- '[ %<PCODE!- "ALIB" 120> LOAD-ENTRY1 #DECL ("VALUE"
<OR FALSE VECTOR> <OR FIX ATOM STRING FALSE> <VECTOR [2 PMCHAN]>) ALIB-NAME
SDMGET %<TYPE-W PMCHAN VECTOR>]>>
<SETG ALIB-NAME %<RSUBR!- '[ %<PCODE!- "ALIB" 215> ALIB-NAME #DECL ("VALUE" <OR
FALSE STRING> <OR FIX STRING ATOM> <VECTOR [2 PMCHAN]>) SMPGETNAM OBLIST () (<
LIST [REST OBLIST]>) #FALSE ()]>>
<SETG LOAD-BUNCH %<RSUBR!- '[ %<PCODE!- "ALIB" 271> LOAD-BUNCH #DECL ("VALUE" <
PRIMTYPE LIST> LIST) ALIB-SMPOPN LOAD-ENTRY1 SMPDCT IRSF T " "]>>
<SETG LOAD-PACKAGE %<RSUBR!- '[ %<PCODE!- "ALIB" 383> LOAD-PACKAGE #DECL (
"VALUE" <PRIMTYPE LIST> <OR FIX ATOM STRING> "OPTIONAL" ANY) ALIB-SMPOPN
LOAD-ENTRY1 SMPDCT ALIB-NAME SDMDSRC IRSF T #FALSE () " "]>>
<SETG DUMP-ENTRY %<RSUBR!- '[ %<PCODE!- "ALIB" 666> DUMP-ENTRY #DECL ("VALUE"
ANY <OR ATOM STRING FIX> "OPTIONAL" STRING) LOAD-ENTRY ABSTR-DUMP GG (LIST)
"DUMPED"]>>
<SETG DUMP-BUNCH %<RSUBR!- '[ %<PCODE!- "ALIB" 742> DUMP-BUNCH #DECL ("VALUE"
ANY LIST "OPTIONAL" STRING) LOAD-BUNCH ABSTR-DUMP GG (<PRIMTYPE LIST>) "DUMPED"
]>>
<SETG DUMP-PACKAGE %<RSUBR!- '[ %<PCODE!- "ALIB" 814> DUMP-PACKAGE #DECL (
"VALUE" ANY <OR STRING FIX ATOM> "OPTIONAL" STRING) LOAD-PACKAGE ABSTR-DUMP GG (
<PRIMTYPE LIST>) "DUMPED"]>>
<SETG DELETE-ENTRY %<RSUBR!- '[ %<PCODE!- "ALIB" 886> DELETE-ENTRY #DECL (
"VALUE" ANY <OR STRING FIX ATOM>) LOAD-ENTRY "PRINT" "MABSTR;.DELE." T "DONE"]>
>
<SETG DELETE-PACKAGE %<RSUBR!- '[ %<PCODE!- "ALIB" 941> DELETE-PACKAGE #DECL (
"VALUE" ANY <OR STRING ATOM FIX>) LOAD-PACKAGE "PRINT" "MABSTR;.DELE." T "DONE"
]>>
<SETG AB [#DECL () #DECL () #DECL () #DECL () () () #DECL () #DECL () () ()]>
<SETG FAM <CHTYPE [() () () () #DECL () (<GET MUDDLE OBLIST> <ROOT>) () () ()
MUDDLE "" ,AB ()] FAMILY>>
<GDECL (FAM) FAMILY (AB) VECTOR>
<SETG SUBR-ABSTR %<RSUBR!- '[ %<PCODE!- "ALIB" 1000> SUBR-ABSTR #DECL ("VALUE"
VECTOR ATOM) ENTRY-ABSTR () AB FAM "MUDDLE"]>>
<SETG LOAD-OR-MAKE %<RSUBR!- '[ %<PCODE!- "ALIB" 1029> LOAD-OR-MAKE #DECL (
"VALUE" <PRIMTYPE LIST> <LIST [REST <OR ATOM STRING FIX>]> "OPTIONAL" ANY)
ALIB-SMPOPN ALIB-NAME SDMDSRC LOAD-ENTRY1 SUBR-ABSTR SMPDCT IRSF T #FALSE ()]>>
<ENDPACKAGE>

28
bin/librm1/allgs.fbin Normal file
View File

@@ -0,0 +1,28 @@
'<PCODE "1ALLGS">
<PACKAGE "ALLGS">
<ENTRY PALLGS>
<SETG PALLGS %<RSUBR!- '[ %<PCODE!- "1ALLGS" 0> PALLGS #DECL ("VALUE" <VECTOR
FIX [3 FIX] [REST FIX]> "OPTIONAL" <OR STRING CHANNEL> ANY) %<RGLOC &1 T>
OUTCHAN (CHANNEL) "PRINT" " #UNBOUND *000000000000*" "(Manifested)"
"There are " " slots. " " are occupied; " " have values; and " " have decls."
BAD-ARG-TO-GETDECL]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,PALLGS PGLUE ![1073741760!]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,PALLGS GLUE ![4379120913 21831401476
1145434172 4581246224 33286262784 88097028 71307332 17179869184 18253611025
5435879424 1140916240 -4293914621 -17179865344 251658480 15729745 4 16 267332
4296093764 1140850687 20 262160 524302 305 262460 262477!]>>
<SETG ALLGS %<RSUBR-ENTRY '[PALLGS ALLGS #DECL ("VALUE" VECTOR)] 303>>
<SETG GETATOM %<RSUBR-ENTRY '[PALLGS GETATOM #DECL ("VALUE" <OR ATOM FALSE> ANY)
] 312>>
<SETG GETDECL %<RSUBR-ENTRY '[PALLGS GETDECL #DECL ("VALUE" <OR DECL '#FALSE ()>
ANY)] 329>>
<ENDPACKAGE>

BIN
bin/librm1/aload.nbin Normal file
View File

Binary file not shown.

165
bin/librm1/amake.fbin Normal file
View File

@@ -0,0 +1,165 @@
'<PCODE "AMAKE">
<PACKAGE "AMAKE">
<ENTRY FILE-ABSTRACT PACKAGE-ABSTR ENTRY-ABSTR LIST-ABSTRACT RECORD QUIET
REABSTRACT GRPNAME AUTHOR OUTDIR ARGTYPES RESTYPES DECL-COMMENT>
<USE "ADATA" "ACONST" "APRINT" "NOW">
<SETG CRET "
">
<SETG FILE-ABSTRACT %<RSUBR!- '[ %<PCODE!- "AMAKE" 0> FILE-ABSTRACT #DECL (
"VALUE" ANY <OR ATOM STRING> "OPTIONAL" <OR ATOM STRING FALSE> <OR ATOM FALSE>)
PRINCLINE PRINTSPEC COLPP NOW GROUP-LOAD LIST-ABSTRACT OUTFILE (<OR ATOM STRING
FALSE>) AUT (<OR STRING <VECTOR [REST STRING]>>) #FALSE () G (LIST)
"Input from group " "." "READ" #FALSE ("INPUT FILE NOT FOUND") "Input from file"
GRPNAME "PRINT" " ABSTR" " ABSTR " OUTDIR "_TEMP_ ABSTR" "File output to"
"Output to group " REABSTRACT "Reabstracting: " AUTHOR "Author is " RECORD
"It is now " %<RGLOC CRET T> "Recording to" OUTCHAN "Abstracter record for: "
"Output file: " #FALSE ("Can't open record file.") "Group-loading from" SNM (
STRING) "Couldn't get group: " "Better luck next time." %<RGLOC NULL T>
"Atom not group name: " "Done at last." %<RGLOC OUTCHAN T>]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,FILE-ABSTRACT PGLUE ![715915263 -1 -256 0!]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,FILE-ABSTRACT GLUE ![336614512 -4003709951
5734121500 4031235527 -17104617903 -4292917310 289872903 -16889954223
-3158227008 16106148336 251658695 4299161727 -17147322609 -20996767567
-13137563140 33046274 -4110364917 -16434201854 33583865609 -17175936775
470877122 -16916672175 1594557420 1140932610 67113219 1041248307 1052786688 0
262180 524310 786445!]>>
<SETG LIST-ABSTRACT %<RSUBR!- '[ %<PCODE!- "AMAKE" 499> LIST-ABSTRACT #DECL (
"VALUE" ANY LIST <OR FALSE CHANNEL> ANY) BUILD-FAMILY GROUP-DATA PRINCLINE
PACKAGE-ABSTR PRINT-ABSTR ENTRY-ABSTR UNPARSE-NIL %<TYPE-W FAMILY VECTOR>
NO-OUTPUT-FOR-ABSTRACTS!-ERRORS QUIET %<RGLOC CRET T> "Writing abstracts."
REABSTRACT %<RGLOC LIST T> %<RGLOC TIME T> #FALSE () T AUT "==> Can't redo "
", not in group."]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,LIST-ABSTRACT PGLUE ![715849727 -67108864!]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,LIST-ABSTRACT GLUE ![-12863421408 -15297933536
52195348 30094132545 16777217 17255104732 -17044600812 17179869248 -13950189439
-4156686332 1078005847 -17179868980 2218787072 -34359672576 66352 8875147264
268960016 17179869184!]>>
<SETG PACKAGE-ABSTR %<RSUBR!- '[ %<PCODE!- "AMAKE" 821> PACKAGE-ABSTR #DECL (
"VALUE" <VECTOR STRING STRING <OR STRING <VECTOR [REST STRING]>> STRING <VECTOR
VECTOR VECTOR <VECTOR <VECTOR DECL [REST DECL]> <VECTOR DECL [REST DECL]> [REST
VECTOR]> <VECTOR <VECTOR DECL [REST DECL]> <VECTOR DECL [REST DECL]> [REST
VECTOR]> [REST VECTOR]> VECTOR VECTOR <VECTOR VECTOR <VECTOR <VECTOR <VECTOR ANY
[REST ANY]> <VECTOR ANY [REST ANY]> [REST VECTOR]> <VECTOR <VECTOR ANY [REST ANY
]> <VECTOR ANY [REST ANY]> <VECTOR ANY [REST ANY]> [REST VECTOR]> [REST VECTOR]>
VECTOR <VECTOR VECTOR VECTOR VECTOR [REST VECTOR]> VECTOR VECTOR [REST VECTOR]>
STRING VECTOR <VECTOR STRING STRING [REST STRING]> VECTOR <VECTOR STRING [REST
STRING]> VECTOR> FAMILY <OR STRING <VECTOR [REST STRING]>>) PORT-INT UNPARSE-NIL
DECL-ATOMS #FALSE () "LIBRARY" "One line description of this "
"Detailed description of this " "Example of use of this "]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,PACKAGE-ABSTR PGLUE ![721403904!]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,PACKAGE-ABSTR GLUE ![67174144 4567662609
1090519040 8388616 524296 64 1048578 2048 131072 33554432 4112 256 262145 262144
1052672 1048576 1048577 61455 3932160 15728640 1077936148 0 524294!]>>
<SETG ENTRY-ABSTR %<RSUBR!- '[ %<PCODE!- "AMAKE" 1214> ENTRY-ABSTR #DECL (
"VALUE" <VECTOR STRING STRING <OR STRING <VECTOR [REST STRING]>> STRING VECTOR
VECTOR VECTOR <VECTOR VECTOR <VECTOR <VECTOR <VECTOR ANY [REST ANY]> <VECTOR ANY
[REST ANY]> [REST VECTOR]> <VECTOR <VECTOR ANY [REST ANY]> <VECTOR ANY [REST ANY
]> <VECTOR ANY [REST ANY]> [REST VECTOR]> [REST VECTOR]> VECTOR <VECTOR VECTOR
VECTOR VECTOR [REST VECTOR]> VECTOR VECTOR VECTOR [REST VECTOR]> STRING <VECTOR
STRING [REST STRING]> <VECTOR STRING STRING [REST STRING]> VECTOR <OR <VECTOR
FORM STRING> <VECTOR STRING [REST STRING]>> VECTOR> ATOM <LIST [REST <VECTOR
ATOM LIST DECL>]> VECTOR FAMILY <OR STRING <VECTOR [REST STRING]>>) UNPARSE-NIL
ARGTYPES FATHER-LIST DECL-COMMENT RESTYPES ![RSUBR RSUBR-ENTRY!] "ASSEMBLY-CODE"
![SUBR FSUBR FUNCTION MACRO RSUBR RSUBR-ENTRY!] "DATUM" #FALSE () "INTERNAL"
"One-line description of object" "Detailed description of object"
"Example of use of this DATUM" "--args--" "Comments on example"]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,ENTRY-ABSTR PGLUE ![714080255 -17179869184!]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,ENTRY-ABSTR GLUE ![16724 2147533151
30152859393 537137652 131072 263 -16911433471 16 16384 4294983680 65792 0
16842752 -34359738305 -17175920368 1082130436 2147499132 4563680259 -17175658496
4294967296 1310732!]>>
<SETG FATHER-LIST %<RSUBR!- '[ %<PCODE!- "AMAKE" 1576> FATHER-LIST #DECL (
"VALUE" VECTOR <LIST [REST <VECTOR ATOM LIST DECL>]>) ()]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,FATHER-LIST PGLUE ![805306368!]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,FATHER-LIST GLUE ![1077690433 83890448
1090539520 0 262148!]>>
<SETG DECL-COMMENT %<RSUBR!- '[ %<PCODE!- "AMAKE" 1635> DECL-COMMENT #DECL (
"VALUE" STRING <PRIMTYPE LIST>) %<RGLOC LIST T> "VALUE" "" "OPTIONAL"
"(Optional arguments)
" TUPLE "Tuple of arguments --
" "Argument " " --
" "Returns --
"]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,DECL-COMMENT PGLUE ![1073740800!]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,DECL-COMMENT GLUE ![364921920 964 4044300097
-15766126137 -11786256324 520160316 0!]>>
<SETG UNPARSE-NIL %<RSUBR!- '[ %<PCODE!- "AMAKE" 1754> UNPARSE-NIL #DECL (
"VALUE" STRING ANY) OBLIST () (LIST)]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,UNPARSE-NIL PGLUE ![1056964608!]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,UNPARSE-NIL GLUE ![1107279872 17179869184
262148!]>>
<MAPF <> <FUNCTION (A) #DECL ((A) STRING) <OR <LOOKUP .A <ROOT>> <INSERT .A <
ROOT>>>> ("PRIMTYPE-WORD" "PRIMTYPE-LIST" "PRIMTYPE-VECTOR" "PRIMTYPE-UVECTOR"
"PRIMTYPE-STRING")>
<SETG MAKE-PRIMTYPE %<RSUBR!- '[ %<PCODE!- "AMAKE" 1781> MAKE-PRIMTYPE #DECL (
"VALUE" ATOM ATOM) "PRIMTYPE-"]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,MAKE-PRIMTYPE PGLUE ![805306368!]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,MAKE-PRIMTYPE GLUE ![1096041408 80 65536
262148!]>>
<SETG PORT-INT %<RSUBR!- '[ %<PCODE!- "AMAKE" 1836> PORT-INT #DECL ("VALUE" <
LIST <LIST [REST ATOM]> <LIST [REST ATOM]> <LIST [REST ATOM]>> <LIST [REST ATOM]
> <OR FALSE OBLIST> <OR FALSE OBLIST>) ()]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,PORT-INT PGLUE ![805306368!]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,PORT-INT GLUE ![4199807 -1069547500
17196908609 4563668993 1140867328 5368709120 786440!]>>
<SETG DECL-ATOMS %<RSUBR!- '[ %<PCODE!- "AMAKE" 1941> DECL-ATOMS #DECL ("VALUE"
DECL <LIST [REST ATOM]> "OPTIONAL" <OR FALSE DECL>) HAS-DECL? #FALSE () ()
MANIFEST NO-DECL]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,DECL-ATOMS PGLUE ![804257792!]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,DECL-ATOMS GLUE ![336613655 12948095045 69641
5435819073 -15099493345 68157760 0 262158 524300!]>>
<SETG ARGTYPES %<RSUBR!- '[ %<PCODE!- "AMAKE" 2062> ARGTYPES #DECL ("VALUE"
VECTOR <PRIMTYPE LIST>) DECLRA DCL () (<LIST [REST ATOM]>) "VALUE"]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,ARGTYPES PGLUE ![804257792!]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,ARGTYPES GLUE ![1107279873 1074008069
4366285888 270532688 0 262148!]>>
<SETG RESTYPES %<RSUBR!- '[ %<PCODE!- "AMAKE" 2145> RESTYPES #DECL ("VALUE" <OR
FALSE VECTOR> <PRIMTYPE LIST>) DECLRA DCL () (<LIST [REST ATOM]>) "VALUE"]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,RESTYPES PGLUE ![804257792!]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,RESTYPES GLUE ![1107280128 -4290506750
18270404608 262148!]>>
<SETG DECLRA %<RSUBR!- '[ %<PCODE!- "AMAKE" 2203> DECLRA #DECL ("VALUE" <OR
FALSE LIST> <OR FORM ATOM>) MAKE-PRIMTYPE ADDECL PRIMTYPE #FALSE () OR () QUOTE
]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,DECLRA PGLUE ![738131968!]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,DECLRA GLUE ![1074860100 4302372866 2432990477
-268173244 1064961 1 22633843968 -33752346624 -30030131200 0 262148!]>>
<SETG ADDECL %<RSUBR!- '[ %<PCODE!- "AMAKE" 2376> ADDECL #DECL ("VALUE" <LIST [
REST ATOM]> ATOM) DCL]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,ADDECL PGLUE ![805306368!]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,ADDECL GLUE ![1124073745 68961280 262148!]>>
<ENDPACKAGE>

53
bin/librm1/amnesa.fbin Normal file
View File

@@ -0,0 +1,53 @@
'<PCODE "AMNESA">
<PACKAGE "AMNESIA">
<ENTRY FORGET>
<USE "PIO" <COND (<GETPROP MNEME!-PACKAGE OBLIST> "MNEME") ("NMNEME")> "MLEARN">
<SETG FORGET %<RSUBR!- '[ %<PCODE!- "AMNESA" 0> FORGET #DECL ("VALUE" STRING <
OR ATOM LIST OWT>) SHRINK PARTIAL-PAGE-IN-CHK SHASH HASH-OWT-ATOM DALLOCP
MNEME-WRITE REM-HASHTBL MNEME-READ MNEME-NTH MNEME-TO-MUDDLE MNEME-TYPE?
FINDUSES MNEME-EXIST? F-FLAG ALREADY-FORGOTTEN (<LIST ATOM>) %<RGLOC MNEMECHN T>
"Chan not in print mode." %<TYPE-C OWT WORD> "not in MNEME" %<TYPE-W OWT WORD>
NON-INVERT OUTCHAN "Can't remove because of non-invert" T NEW-USES MNEME-LIST
MNEME-INSTANCE "Forgotten" "Can't forget INSTANCES yet." %<TYPE-W CHANP VECTOR>
MNEME-ATOM "Item not found in hash table" ![0!]
"Warning! Can't find back ptr in: " "PUTPROPing NON-INVERT thereon."
"Set by AMNESIA" EXT %<RGLOC STOR T> %<RGLOC STORPLUS1 T> "SHOULDN'T GET HERE"
ILLEGAL-MNEME-ITEM %<RGLOC IHT T> "ITEM NOT FOUND IN CACHE" LOST WON]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,FORGET PGLUE ![715827887 -1 -1024 0!]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,FORGET GLUE ![1107035072 -16910360803
4430302988 21474837524 13892701980 3221243164 -34091301888 71683087 1008531913
-12989235184 67108868 17201126525 16453 17383424 18287444431 -26676618160
1065024 8589935684 750817280 18325192256 26054559776 2081432576 286278144
18325964740 17704173568 17246994448 -34292628992 16754 269553937 4370268160
16106128385 4044296452 16777216 4299179008 1393680 267268 -13923580813
-16881077492 -3422796734 1077940496 2147483716 17716744464 135532544 1048585
4299441412 268498944 -17179852783 4631561216 4034936832 -34292432896 5243972
21479030880 71368768 1076887552 3145729 -4026531840 82976 21475366144 65536
266244 1077936385 17466393088 260 1081880576 7589232 1330176 805306700 1835008
20401107980 282624 67108863 262148 262212 262372 262441 524786 263275!]>>
<SETG FORGET1 %<RSUBR-ENTRY '[FORGET FORGET1 #DECL ("VALUE" STRING OWT)] 64>>
<SETG REMOVER %<RSUBR-ENTRY '[FORGET REMOVER #DECL ("VALUE" <OR ATOM FALSE> OWT)
] 224>>
<SETG AM-ZAP %<RSUBR-ENTRY '[FORGET AM-ZAP #DECL ("VALUE" <OR ATOM FALSE> <OR
FIX OWT>)] 293>>
<SETG REM-HASHTBL %<RSUBR-ENTRY '[FORGET REM-HASHTBL #DECL ("VALUE" ANY OWT)]
341>>
<SETG ADJUST-DOWNPTRS %<RSUBR-ENTRY '[FORGET ADJUST-DOWNPTRS #DECL ("VALUE" ANY
FIX OWT)] 492>>
<SETG SHRINK %<RSUBR-ENTRY '[FORGET SHRINK #DECL ("VALUE" FIX FIX STRUCTURED
STRUCTURED ANY)] 1017>>
<SETG CACHER %<RSUBR-ENTRY '[FORGET CACHER #DECL ("VALUE" ATOM OWT)] 1127>>
<ENDPACKAGE>

38
bin/librm1/anotes.fbin Normal file
View File

@@ -0,0 +1,38 @@
'<PCODE "ANOTES">
<PACKAGE "ANOTES">
<ENTRY ABSTR-SHORT PRINT-SHORT ABSTR-NOTES PRINT-NOTES>
<USE "ADATA" "ACONST">
<SETG ABSTR-SHORT %<RSUBR!- '[ %<PCODE!- "ANOTES" 0> ABSTR-SHORT #DECL ("VALUE"
<OR STRING <FALSE STRING [REST STRING]>> ATOM "OPTIONAL" ANY) EPRIN1 GROUP-DATA
BUILD-FAMILY NOTES? (ANY) T OBLIST (<LIST [REST OBLIST]>) "Group" OUTCHAN "DONE"
#FALSE ("NOT A GROUP") NM? "Called-by" "Calls" "SETG" "GVAL" "SET" "LVAL"
"SPECIAL" "USE" "USE-DATUM" ": " STRING "." ", "]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,ABSTR-SHORT PGLUE ![721420287 -16384!]>>
<SETG PRINT-SHORT %<RSUBR-ENTRY '[ABSTR-SHORT PRINT-SHORT #DECL ("VALUE" <OR
ATOM FALSE> ATOM LIST VECTOR)] 125>>
<SETG PRINT-FIELD %<RSUBR-ENTRY '[ABSTR-SHORT PRINT-FIELD #DECL ("VALUE" ANY
STRING <PRIMTYPE LIST>)] 248>>
<SETG ABSTR-NOTES %<RSUBR-ENTRY '[ABSTR-SHORT ABSTR-NOTES #DECL ("VALUE" <OR
STRING <FALSE STRING [REST STRING]>> ATOM)] 326>>
<SETG PRINT-NOTES %<RSUBR-ENTRY '[ABSTR-SHORT PRINT-NOTES #DECL ("VALUE" <OR
ATOM FALSE> <OR FALSE ATOM STRING> VECTOR)] 412>>
<SETG PRINT-LIST %<RSUBR-ENTRY '[ABSTR-SHORT PRINT-LIST #DECL ("VALUE" <OR FALSE
STRING> <LIST [REST <OR STRING ATOM>]>)] 544>>
<SETG PRINT-DECL %<RSUBR-ENTRY '[ABSTR-SHORT PRINT-DECL #DECL ("VALUE" ATOM <<
PRIMTYPE LIST> [REST <LIST ATOM> ANY]>)] 609>>
<SETG FATHER-LIST %<RSUBR-ENTRY '[ABSTR-SHORT FATHER-LIST #DECL ("VALUE" <LIST [
REST ATOM]> <LIST [REST <VECTOR ATOM LIST DECL>]>)] 659>>
<ENDPACKAGE>

22
bin/librm1/ap.fbin Normal file
View File

@@ -0,0 +1,22 @@
'<PCODE "1AP">
<PACKAGE "AP">
<ENTRY AP?>
<GDECL (EH) HANDLER>
<USE "L">
<SETG AP? %<RSUBR!- '[ %<PCODE!- "1AP" 0> AP? #DECL ("VALUE" <OR FALSE
APPLICABLE> ANY) USE L-OBL ERRLOC (ACTIVATION) EH ERROR!-INTERRUPTS "ERROR"
%<RSUBR!- '[ %<PCODE!- "1AP" 197> ANONF3!-TMP #DECL ("VALUE" ANY "TUPLE" TUPLE)
#FALSE ("ERROR IN AP?") ERRLOC]> %<RGLOC EH T> #FALSE ("CANNOT FIND ATOM VALUE"
) #FALSE ("UNUSABLE OBJECT DESCRIPTION") INTERRUPT]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,AP? PGLUE ![738197440!]>>
<SETG INTSET %<RSUBR-ENTRY '[AP? INTSET #DECL ("VALUE" HANDLER ATOM STRING
APPLICABLE "OPTIONAL" FIX)] 143>>
<ENDPACKAGE>

26
bin/librm1/append.fbin Normal file
View File

@@ -0,0 +1,26 @@
'<PCODE "1APPEN">
<PACKAGE "OPEN-APPEND">
<ENTRY OPEN-APPEND>
<SETG RNAME1 7>
<SETG RNAME2 8>
<SETG RDEVICE 9>
<SETG RDIRECTORY 10>
<SETG CBUF "UGBUG">
<GDECL (CBUF) STRING>
<MANIFEST RNAME1 RNAME2 RDEVICE RDIRECTORY>
<SETG OPEN-APPEND %<RSUBR!- '[ %<PCODE!- "1APPEN" 0> OPEN-APPEND #DECL ("VALUE"
<OR CHANNEL FALSE> "TUPLE" TUPLE) "READB" %<RGLOC CBUF T> "PRINTO" "PRINTB"]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,OPEN-APPEND PGLUE ![1069547520!]>>
<ENDPACKAGE>

BIN
bin/librm1/append.nbin Normal file
View File

Binary file not shown.

56
bin/librm1/apprin.fbin Normal file
View File

@@ -0,0 +1,56 @@
'<PCODE "APPRIN">
<PACKAGE "APPRINT">
<ENTRY PPRINT-ABSTR>
<USE "ACONST">
<SETG PPRINT-ABSTR %<RSUBR!- '[ %<PCODE!- "APPRIN" 0> PPRINT-ABSTR #DECL (
"VALUE" ANY <OR ATOM VECTOR> "OPTIONAL" CHANNEL) PPRINT-ABSTR1 OUTCHAN (CHANNEL)
OBLIST AB-OB (<LIST [REST OBLIST]>) #FALSE ("NAKED ATOM") NULL]>>
<SETG PPRINT-ABSTR1 %<RSUBR!- '[ %<PCODE!- "APPRIN" 86> PPRINT-ABSTR1 #DECL (
"VALUE" ANY VECTOR "OPTIONAL" FIX <VECTOR [REST <OR STRING VECTOR>]> <VECTOR [
REST <OR APPLICABLE VECTOR>]>) EMPTIES PHEADER PLABEL LEFT-MARGIN (FIX)
ABSTR-PPRINT ABSTR-FORM #FALSE ()]>>
<SETG PHEADER %<RSUBR!- '[ %<PCODE!- "APPRIN" 270> PHEADER #DECL ("VALUE" ANY
STRING) PLABEL "
"]>>
<SETG PLABEL %<RSUBR!- '[ %<PCODE!- "APPRIN" 290> PLABEL #DECL ("VALUE" ANY
STRING "OPTIONAL" STRING) INDENT-TO " " LEFT-MARGIN BACKSPACES UNDERLINES ":"]>>
<SETG EMPTIES %<RSUBR!- '[ %<PCODE!- "APPRIN" 354> EMPTIES #DECL ("VALUE" <OR
FALSE 'T> ANY) T #FALSE ()]>>
<SETG PSTRINGS %<RSUBR!- '[ %<PCODE!- "APPRIN" 414> PSTRINGS #DECL ("VALUE" ANY
ANY "OPTIONAL" APPLICABLE) INDENT-TO PRINC OUTCHAN T ", "]>>
<SETG PATOMS %<RSUBR!- '[ %<PCODE!- "APPRIN" 540> PATOMS #DECL ("VALUE" ANY ANY
) PSTRINGS PRIN1]>>
<SETG PDECLS %<RSUBR!- '[ %<PCODE!- "APPRIN" 562> PDECLS #DECL ("VALUE" ANY ANY
) EPRIN1 #FALSE ()]>>
<SETG PTEXT %<RSUBR!- '[ %<PCODE!- "APPRIN" 625> PTEXT #DECL ("VALUE" ANY
VECTOR) INDENT-TO EPRIN1 OUTCHAN T]>>
<SETG PDATE %<RSUBR!- '[ %<PCODE!- "APPRIN" 712> PDATE #DECL ("VALUE" ANY <OR
FIX LIST>) EPRIN1 "None."]>>
<GDECL (BACKSPACES UNDERLINES) STRING (ABSTR-PPRINT) <VECTOR [REST <OR
APPLICABLE VECTOR>]>>
<SETG BACKSPACES <ISTRING 25 !">>
<SETG UNDERLINES <ISTRING 25 !"_>>
<SETG ABSTR-PPRINT [,PATOMS ,PSTRINGS ,PSTRINGS ,PSTRINGS [,PATOMS ,PATOMS [,
PDECLS ,PDECLS] [,PDECLS ,PDECLS]] ,PSTRINGS ,PSTRINGS [,PSTRINGS [[,PDECLS ,
PDECLS] [,PDECLS ,PDECLS ,PDECLS]] ,PATOMS [,PTEXT ,PTEXT ,PTEXT] ,PSTRINGS ,
PSTRINGS ,PSTRINGS] ,PSTRINGS ,PSTRINGS ,PTEXT [,PDECLS ,PSTRINGS ,PSTRINGS] ,PTEXT ,PTEXT
[,PDATE ,PDATE ,PDATE]]>
<ENDPACKAGE>

48
bin/librm1/aprint.fbin Normal file
View File

@@ -0,0 +1,48 @@
'<PCODE "APRINT">
<PACKAGE "APRINT">
<ENTRY PRINT-ABSTR PRINCLINE PRINCTHEM PRINTSPEC ABSTR-LOAD ABSTR-DUMP>
<USE "ACONST" "AERROR">
<SETG CRET "
">
<SETG PRINT-ABSTR %<RSUBR!- '[ %<PCODE!- "APRINT" 0> PRINT-ABSTR #DECL ("VALUE"
ANY VECTOR "OPTIONAL" CHANNEL STRUCTURED) PRINCLINE SUBM-PRINT1 PPRINT OUTCHAN (
CHANNEL) ABSTR-FORM OBLIST AB-OB (<LIST [REST OBLIST]>) LEV (FIX) "[" #FALSE ()
"]" CRET "; \"***** NOT AN ABSTRACT *****\"" NULL]>>
<SETG SUBM-PRINT1 %<RSUBR!- '[ %<PCODE!- "APRINT" 151> SUBM-PRINT1 #DECL (
"VALUE" ANY ANY <OR STRING <VECTOR [REST <OR STRING VECTOR>]>>) INDENT-TO EPRIN1
LEV "; " " " OUTCHAN " [" #FALSE () "]"]>>
<SETG PRINCLINE %<RSUBR!- '[ %<PCODE!- "APRINT" 353> PRINCLINE #DECL ("VALUE"
ANY "TUPLE" TUPLE) #FALSE ()]>>
<SETG PRINCTHEM %<RSUBR!- '[ %<PCODE!- "APRINT" 395> PRINCTHEM #DECL ("VALUE"
ANY "TUPLE" TUPLE) #FALSE ()]>>
<SETG PRINTSPEC %<RSUBR!- '[ %<PCODE!- "APRINT" 436> PRINTSPEC #DECL ("VALUE"
ANY STRING CHANNEL) PRINCTHEM " "]>>
<SETG JUNK-STR <ISTRING 200>>
<SETG COMMENT-JUNKER %<RSUBR!- '[ %<PCODE!- "APRINT" 485> COMMENT-JUNKER #DECL
("VALUE" ANY ANY) JUNK-STR INCHAN "\"" #SPLICE ()]>>
<SETG COMMENT-TABLE <IVECTOR 128 0>>
<PUT ,COMMENT-TABLE <+ 1 <ASCII !";>> ,COMMENT-JUNKER>
<SETG ABSTR-LOAD %<RSUBR!- '[ %<PCODE!- "APRINT" 534> ABSTR-LOAD #DECL ("VALUE"
ANY STRING "OPTIONAL" ATOM ANY) #FALSE () "READ" T "ABSTR" OBLIST AB-OB (<LIST [
REST OBLIST]>) READ-TABLE COMMENT-TABLE (VECTOR) ERROR-RETURN (ACTIVATION)
NOT-AN-ABSTR? ABSTR-LOAD CHANNEL]>>
<SETG ABSTR-DUMP %<RSUBR!- '[ %<PCODE!- "APRINT" 723> ABSTR-DUMP #DECL ("VALUE"
ANY STRING "OPTIONAL" <OR ATOM FALSE> APPLICABLE) PRINT-ABSTR NM2 "ABSTR" (
STRING) OBLIST AB-OB (<LIST [REST OBLIST]>) OUTCHAN "PRINT" (CHANNEL) #FALSE ()
#FALSE ("NOT A GROUP") #FALSE ("GROUP DOESN'T EXIST")]>>
<ENDPACKAGE>

BIN
bin/librm1/ardsio.nbin Normal file
View File

Binary file not shown.

BIN
bin/librm1/asetup.nbin Normal file
View File

Binary file not shown.

BIN
bin/librm1/ask.nbin Normal file
View File

Binary file not shown.

BIN
bin/librm1/ast.nbin Normal file
View File

Binary file not shown.

20
bin/librm1/asylum.fbin Normal file
View File

@@ -0,0 +1,20 @@
ñ¢“¼¡øsâEAôPiÙ™ú³Q>Añ¢†ŠEõÔ ‡ýü<òÓüú: c÷-Ü ›ü<ùáÇýyåéþœÐIÝþ}4ôëþ™PoÍô2ãÑýÛöoÏÿ+<2B> ƒý›RÓüú:sAúYyååþÙr.EôE
÷” ×ø1â Eø4ìÌ«ù¨Ÿ ñCE<‹ùÕ)YAø4ìÌ«ù¨&Á<>ù0a ‹û"Ήõ±¤Ì‹ô Ôƒõ±iRŸúTÐDƒú<C692>VΟùËcA©ø3Å¥úSéSAùô"Î[ø<>jA[øÒfEAøÓ*Ó‘õ± Ôƒõ±¤Ì‹ôæO§ø«bA©ø+cI™ø¨)E§øµăú<C692>VÆ“ù‘PDƒú<C692>VÕ<56>ù“áËAø3&O‡õµgLŸørÐA™ù“á­›ø4Dƒú<C692>VÒ‹ø1ןúQDƒú<C692>V×¥ù5"­¯ùô¢ ‰ø5 ­ƒúµ$O¥õµçÒ‰ô Ôƒõ°âA©ø¨"A©ø+iDƒú‘PDƒú<C692>VÁ«ú’'ÒAø<41>jA[ú´â ‰ø5 ­¡úµDƒú<C692>VÆ“ùÑDƒú<C692>VÏ¡ø³<C3B8>Dƒú<C692>VÐ¥ù3ªWAø<41>jA[úQ`įô Ôƒõ´¢Ó‹úU¢ ‰ø5 ­ƒúQ`ÄAø<41>jA[ù4¢Á‰ô Ôƒõ°hR“ùÕDƒú<C692>VÉ¡úRgTAø<41>jA[ø0áŧúh"A©ø+iE§øµDƒú<C692>VÒ‹ø1! ‰ø5 ­¡úRgT…ô Ôƒõ°¦O‡ùh"A©ø+aȃù3–Óƒù• Ç‹ô Ôƒõ°æO§ø¨"A©ø+bE™øµ" ‰ø5 ­¥ø³ Í‹ô Ôƒõ°¦O‡ùkcR‹ø¨'A›ø<E280BA>jAAùÐfÅ[øS'×õ±©E‹ô Ôƒõ±lT‹ùÑЃøñi ‰ù'×ô)ÌŸørÐD«ùÓ'×ôjS«ùÓ'×ô Ôƒõ³'×õµ)I‹úh"A©ø+fO‡ùkiÌ‹ø´D“úKdΓúˆ&Ɖõ²gI©ôfLŸøkdΓúˆ#Å©õ³'ÃAúj-™ùðÐG‹ú‹fO‡õ¶Dƒú”¢Á‰ô Ô¯úRjEAø’iMƒú&Á¡õ´ Ç‹ôgMƒú hA<68>ø¨'A›ø«cI<63>øˆ'A›ø«cI<63>ø‹bE™øµ" <>ø3b­<62>ù3¢-ƒø‘P¥ù3ªMŸø‘PP¥ù3ªW›ùñ" ¥ø°bMŸø‘PR‹ø1'R›ùñ"¾Añ¢†Šyú´â­‰ø±¢ÒAôS`Ä›ø3‘ Eú‘gX“ùèŸ ñCE<§øµ# ¡õó6}ôE
÷”âÔ<C3A2>ô$Ò“øˆ>Añ¢†ŠyúqjGAúëÒ“ú‘VÆ™ø1ÐT}ôE
÷“é yøðiÓ“øó¢Äô§Æ<C2A7>úqj>A÷‘"Æ“ùÑPNŸøÑ©Å©ô
+A¥õ(-A÷Š<C3B7><­ø3*ÅAõÕ Ò}ô Ÿ c÷ÏŸ ñCE<§øµ# ‰ù4¤ÄAö<41><C3B6>
ñ¢žS‹ú‘ÐP™ù*Aõ”ÌAö,4}÷ÈŠñO)Å©øè"A©ø+bØ©ø³¢-¡ø1âÓAöL ñCE<§øµ# ‰ø5 Ì™ùðÐ%yúTêÂ¥ô í¥yúçÄ‹ô Ó³ù•f¢Aö<0F>Dƒú<C692>fLŸøhÄ‹øs(EúÐfU‹ôHO¥ô¤ØAøÐfS‹÷È Ó³ù•f <66>ù6 ƒú¤Î©ôfE<66>øõ$ ƒúQ`ÄAúj-™ùðÐD“úKdΓúˆ#Å©õ³'ÃAù°bMƒùËhA<68>ø«cÉ­ø¨&Ɖõ²gI©ôèE<C3A8>õ±¤Ì‹ôâÔ[øÒfEAø4#Æ“ùÑA¥ø´âÒ­ø¨"U<>ù“áËAø’&O‡ùh¼¥øó'ÃAø<41>jH‰úH*>Aô¯)G™ùðÐDƒú<C692>V×¥ù5"­¯ùô¢ ©÷ȼ¥øó'ÃAø<41>jA[ø5jHŸúKkÏ¥øˆ*>Aõ
” Q÷*P%yúQæO‡ô Ôƒõ±lT‹ùÑЃøñi ©÷È1mõ(1qõ(&Õ<>øñb-ƒù“'Ãú’gÎ[ú<>aL‹ô+bÒ¥ùô© ©ôàΩõ³`Ð[ùÑk­‰ù4¢Ã©ùô¬¡[ø´©O¥úh1kõ((O©ø³ªIƒù‹bI§ø4êE¥ô+bÒ¥ùô© ¡ø1â­›ø4(I<>øëcA“ù‘b![ø´©O¥úh1eõ(&Á¡úgG[øÐdÌ‹øˆVÅ¥úSéSAô¯)G™ùðÐL¥ú°çÕ<C3A7>úˆ*>Aô¯)G™ùðÐP<C390>úô¤Ô‹õ±¦A<C2A6>ô K÷”£ÌŸøh$A§ùk ©÷È8Sô§­¡ø1â­<C3A2>ùô–ȃúr$Î<>ô+bÒ¥ùô© §ú”¤Î<C2A4>õµ'Ï[ù<>iG‹ô+bÒ¥ùô© K÷”£ÌŸøh Ì™ùðÖÔƒøS" ©÷ȼ¥øó'ÃAùµbD™ø¨*>AôT)I<>ú<EFBFBD>‘ EúQ`ÄEô§­›ùô¢­¡ø1âÓCõ±iRŸúTÐA¥ø´âÒ­ø¨¼¥øó'ÃAùiÈ¡ø1â ©÷ȼ©û4"­¯ôiÙ™ú³PV‹øu'Ò}ôãA™úqP(cõ(¼¥øó'ÃAø•k1Aú<41><C3BA>%yúQæO‡ô Ôƒõ³'×õµ)I‹úh*>Aô¯)G™ùðÐDƒú<C692>VÌŸørÖÓ™ø±h ©÷Èƃù”â QöJP#<23>ø3)ÅAõ Y)AøPb-‰ù4¢Ã©ùô¬­¡ùògT‹úHVÅ¥úSéSAôq Ì§ø¨3Sô ^R<>ù“á <C3A1>ø3jÖAú<41><C3BA>%yúQæO‡ô Ô«úÈ*>Aô¯)G™ùðÐD«úÌ<C3BA>T}ô ^R<>ù“á ›ùñ"Ö‡úˆ*>AúóéDAôq Ì§ø¨4SôãA™úqP(qõ(ƃù”â QöªP%yúQæO‡ô Ô‘ø”¦E<C2A6>ô K÷•,ЋõµÐMƒùÒ`ÃAúÑaÔŸúO<C3BA>%yúQæO‡ô Ôƒõ´¢Á‰õµçÒ‰ô GøÐfS‹ô
¹Sô ^T³úVÃAù°gIƒøh+E‡ú“é>AôT)I<>ú•Ñ K÷”£ÌŸøh'A›ù²iÃAú<41><C3BA>%yúQæO‡ôèA¥ø«dħô GøÐfS‹ô
)Aôq Ì§ø¨7Sô ^T³úV×Aút Ëô¢Ã©ùôŸ Eú¤Î©ôHƃù”â Qö, GøÐfS‹ô
±SôãA™úqP(cöjP#<23>ø3)ÅAõ Z)Aô¯)G™ùðÐF¥ø±aLŸøré ©÷ȼ¥øó'ÃAùÐfȉúH*>Aô¯)G™ùðÐNƒù¶ªÖAú<41><C3BA>#<23>ø3)ÅAõ [©AôT¢Á‰øH®¾}ôE
÷<>gDA÷<41>iÓ“øó¢ÄôæU‹÷ÈG™ú±P<¡úµ,‰ø5 Ì™ùðÐP<C390>ù•b CûmصqöMÜ8gô X [ö(±Aõ­9mô Ý}÷ÈŠñO)Å©øè*Λø4ЃøñP%yúTêÂ¥õ±gT¥û(Û‰ø5 Ì™ùðÐU<C390>ù°h-¡ø1â Gø‘aÌAõ«A™ú±Q yùô<C3B9>Fƒù”â Oú<4F><C3BA>F“û
n oö¬ß>Añ¢†ŠyúqjGAù°h-¡ø1â K÷”©Õ…úKbΩúVP'·ø<C2B7>jA™ù“á ›ø4ЃøñP#‰ø°æ QôU Ì«ø¨<C3B8><ŸúH#A™úqP'©÷È!ȃùÓ¢ÌAøÒl <20>ù6ÝAöìÛ¾}ôE
÷”âÔ<C3A2>ô#×¥ù5" K÷”©Õ…úKbΩúVP'·ø<C2B7>jA™ù“á ¡øõéI©ø¨Ä‹øs(EúÐfU‹ôHÔAøÒl)»ô
Ø1}÷ÈŠñO)Å©øè&Á¡õ²g K÷”©Õ…úKbΩúVP'·ø<C2B7>jA™ù“á ›ø4É<>ôâE‡ùˆ"­ø3*ÅEô¤ØAø4ìÌ«ù¨#I±õ7P6aö/Ÿ ñCE<§øµ# ‰ù4¦Á¡ô ^R§ú°©-‹ùÕ)YAôöâA©ø3&O‡ô$Ò›ø4#‰ø°æ QôU Ì«ø¨<C3B8><ŸúH#A™úqPF“û<0F>A§û3*ÍAøÒl)»ô
\4}÷ÈŠñO)Å©øè"A©úQ`ÄAô¯)S«øT–Å<E28093>ú”¬ Oûq Ôƒù“'ÃAø<41>jR‹ø1#‰ø°æ QôU Ì«ø¨<C3B8>A<EFBFBD>û( Ó³ù•f <66>ù6<¡úRfÔ³úPWŸúQ yùô<C3B9>U­ø°êO¥ô(R“ùµ,ЋôçÒ‰÷Ï”ÝAö¬˜¾}ôE
÷”âÔ<C3A2>ô Ô¯úRjEAô¯)S«øT–Å<E28093>ú”¬ Oûq Ôƒù“'ÃAø<41>jW¥ù5" Gø‘aÌAõ«A™ú±Q ƒùÖPA§û3*ÍAøÒl yú¤Í©û4" ¯ùô¢>A÷“é «úÑaÔŸúHP¥ù3jY¡ø¨+Ï¥ø<C2A5>Ÿ)»ô
X´}÷ÈŠñO)Å©øè"A©ø‘`Ì™ùðÐ%yúTêÂ¥õ±gT¥û(Û‰ø5 Ì™ùðÐDƒú‘"Á™ù“á Gø‘aÌAõ«A™ú±Q yùô<C3B9>'©ô Ì§ø¯<C3B8>A§û3*ÍAøÒl yú¤Í©û4" ¯ùô¢>Sû¨2e÷Ï<C3B7>
ñ¢žS‹ú‘ÐSƒù•¢Eƒù“'ÃAô¯)S«øT–Å<E28093>ú”¬ Oûq Ôƒù“'ÃAúpfV‰ø°fLŸøhÄ‹øs(EúÐfU‹ôHO¥ô ê <20>ø3)Å}ôiÙ™ú³PF“ûP¥ù3jY¡ø¨+Ï¥ø<C2A5>”ÝAöŒX>}ôE
÷”âÔ<C3A2>ô#Õ<>ù“áËAô¯)S«øT–Å<E28093>ú”¬ Oûq Ôƒù“'ÃAúêΙùðå Gø‘aÌAõ«A™ú±Q Oúˆ#I±ô¤ØAøÒl)»ô ›0}÷ÈŠñO)Å©øè#O¥øqP%yúTêÂ¥õ±gT¥û(Û‰ø5 Ì™ùðÐFŸúPâ Gø‘aÌAõ«A™ú±Q ‡ùgN‹ùˆ!ȃùÓ¢ÌSû¨5a÷Ï<C3B7>
ñ¢žS‹ú‘ÐA™ù“á­«ú Ô‹ô ^R§ú°©-‹ùÕ)YAôöâA©ø3&O‡ôfLŸøkjЉø5" Gø‘aÌAõ«A™ú±Q ƒùÖPA§û3*ÍAøÒl)»ô ˜3}÷ÈŠñO*Ó‹ô¦Á‰ù°g"}ôE

BIN
bin/librm1/asystt.nbin Normal file
View File

Binary file not shown.

78
bin/librm1/b-ob.fbin Normal file
View File

@@ -0,0 +1,78 @@
'<PCODE "MSDTP">
<PACKAGE "B-OBJECT">
<ENTRY EXTRACT-ITEM REFILL-BUFFER MAX-STRING STRING-FILE>
<USE "MSDTP">
<SETG MAX-STRING 5120>
<SETG STRING-FILE "DSK:NETOPS;MSDTP >">
<SETG EXTRACT-ITEM %<RSUBR!- '[ %<PCODE!- "MSDTP" 212> EXTRACT-ITEM #DECL (
"VALUE" ANY STRING "OPTIONAL" <OR 'T FALSE>) GET-SEMTYPE BYTER8 REFILL-BUFFER BS
(STRING) BL (FIX) BOFF BYTES T RESERVED-CODE-USED!-ERRORS EXTRACT-ITEM #FALSE (
) TOO-MANY-SIZE-BYTES!-ERRORS B-NON-ATOM BAD-OBJECT-TYPE-CODE!-ERRORS ![
B-LBITSTR B-STRUC B-EDT B-REPEAT B-USTRUC B-STRING!]
NOT-ENOUGH-BYTES-FOR-BITS!-ERRORS P-LBITSTR %<TYPE-W BITSTR UVECTOR> %<RGLOC
MAX-STRING T> "PRINT" %<RGLOC STRING-FILE T> CANT-OPEN!-ERRORS B-STRING %<TYPE-W
POINTER LIST> () BAD-SIZE-SPECIFICATION!-ERRORS B-STRUC CHARACTER B-REPEAT
UNPARSED!-SEMTYPES ACTPARSE (ACTIVATION) %<RGLOC ERRIHEAD T> %<RGLOC ERRPARSE T>
%<TYPE-W XTRA WORD> %<TYPE-W BOOL WORD> %<TYPE-W EMPTY WORD> %<TYPE-W DFIX
UVECTOR> %<TYPE-W DWORD UVECTOR>]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,EXTRACT-ITEM PGLUE ![721420287 -1 -1048576!]>>
<SETG GET-BYTE %<RSUBR-ENTRY '[EXTRACT-ITEM GET-BYTE #DECL ("VALUE" WORD)] 127>>
<SETG NEXT-BYTE %<RSUBR-ENTRY '[EXTRACT-ITEM NEXT-BYTE #DECL ("VALUE" WORD)] 205
>>
<SETG B-NON-ATOM %<RSUBR-ENTRY '[EXTRACT-ITEM B-NON-ATOM #DECL ("VALUE" ANY FIX
"OPTIONAL" <OR 'T FALSE>)] 281>>
<SETG B-LBITSTR %<RSUBR-ENTRY '[EXTRACT-ITEM B-LBITSTR #DECL ("VALUE" BITSTR FIX
)] 400>>
<SETG B-STRING %<RSUBR-ENTRY '[EXTRACT-ITEM B-STRING #DECL ("VALUE" <OR POINTER
STRING> FIX)] 555>>
<SETG B-STRUC %<RSUBR-ENTRY '[EXTRACT-ITEM B-STRUC #DECL ("VALUE" <OR LIST
STRING> FIX "OPTIONAL" ANY)] 666>>
<SETG B-REPEAT %<RSUBR-ENTRY '[EXTRACT-ITEM B-REPEAT #DECL ("VALUE" SPLICE ANY)]
913>>
<SETG B-USTRUC %<RSUBR-ENTRY '[EXTRACT-ITEM B-USTRUC #DECL ("VALUE" <OR LIST
STRING> FIX)] 985>>
<SETG ERRIHEAD <OR <GET ERROR!-INTERRUPTS INTERRUPT> <EVENT ERROR!-INTERRUPTS
100>>>
<SETG ERRPARSE <OFF <HANDLER ,ERRIHEAD <FUNCTION ("TUPLE" T) <OFF ,ERRPARSE> <
DISMISS 0 .ACTPARSE>>>>>
<SETG B-EDT %<RSUBR-ENTRY '[EXTRACT-ITEM B-EDT #DECL ("VALUE" ANY ANY)] 1009>>
<SETG GET-ITEM %<RSUBR-ENTRY '[EXTRACT-ITEM GET-ITEM #DECL ("VALUE" ANY)] 1109>>
<SETG B-LINTEGER %<RSUBR-ENTRY '[EXTRACT-ITEM B-LINTEGER #DECL ("VALUE" <OR FIX
DFIX> FIX)] 1153>>
<SETG B-SBITSTR %<RSUBR-ENTRY '[EXTRACT-ITEM B-SBITSTR #DECL ("VALUE" <OR WORD
DWORD> FIX)] 1197>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,EXTRACT-ITEM GLUE ![336613827 -16014839801
1014100423 -16894570476 16441738561 17251192959 -16084107264 4379642892 114864
12888244992 17988321280 4296036544 -16978542564 2955936560 12889108480 16777296
17519987728 17452564756 8573243649 5368972304 34292744192 20401094672 4206592
4307554305 16777489 268959792 18192 25753812992 22299408 22548582400 4764729345
12591040 8585740289 16793601 269484037 31138578768 4630773760 336613717 786433
4568694815 1410404352 17452762432 22806869 17452777473 1091571712 3147100
17582261313 -4205575104 298308868 21562982465 323 283392 34292678656 -2969496560
68157456 21559791696 269553679 18255762448 4768662275 278528 4764733440
1073745988 17465413715 4380761372 268502081 1074795520 805310464 4362141760
50593791 262165 524300 129 207 262439 524581 262548 262703 262828 524966 263133
263157 1111 263301 263345!]>>
<ENDPACKAGE>

BIN
bin/librm1/banner.nbin Normal file
View File

Binary file not shown.

41
bin/librm1/bigpri.fbin Normal file
View File

@@ -0,0 +1,41 @@
'<PCODE "1BIGPRI">
<PACKAGE "BIGPRINT">
<ENTRY BIGPRINT 5X7-MASK>
<SETG REP-PRINC %<RSUBR!- '[ %<PCODE!- "1BIGPRI" 0> REP-PRINC #DECL ("VALUE"
ANY ANY "OPTIONAL" FIX) OUTCHAN "" "
" " " " " BAD-ASCII-CHARACTER 5X7 %<RGLOC 5X7TB T>]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,REP-PRINC PGLUE ![1073725440!]>>
<SETG BIGPRINT %<RSUBR-ENTRY '[REP-PRINC BIGPRINT #DECL ("VALUE" STRING STRING
"OPTIONAL" FIX FIX)] 36>>
<SETG 5X7-MASK %<RSUBR-ENTRY '[REP-PRINC 5X7-MASK #DECL ("VALUE" FIX CHARACTER)]
226>>
<SETG 5BY7MASKGEN %<RSUBR-ENTRY '[REP-PRINC 5BY7MASKGEN #DECL ("VALUE" FIX FIX
FIX FIX FIX FIX FIX FIX)] 264>>
"5x7 matrix for ASCII non-control characters"
<GDECL (5X7TB) <UVECTOR [REST FIX]>>
<SETG 5X7TB <UVECTOR 0 4433514500 11083448320 11105828170 4819720132 33053352547
4634990157 4433379328 2290360450 8726317192 720222880 5083136 12424 458752 396
35791360 15623448110 4701950094 15603929375 15604057646 2360313922 33854359086
15620589102 33321787920 15618065966 15621129774 415248768 415248520 71569472
32537600 272699648 15605043204 498789824 15621670449 32801506878 15620129326
32801080894 33840644639 33840644624 15620132398 18842895921 15170932878
7550830126 18879498801 17734058527 19182175793 18850958897 15621211694
32801505808 15621215821 32801506865 15620048430 33424543876 18842437166
18842436932 18842437290 18834663985 18834657412 33357762847 6580998278 545392672
13023449228 4786884740 143630464 8726249472 15288941 17748772414 16269839
1123599919 15261199 6753755400 14267438 17748772401 4299296900 2149648972
17735177041 4433514638 29017649 23905841 15255086 23910928 13187139 23904784
15218734 8888000806 18400877 18400580 18400938 18157905 18127000 32575775
3359903875 138547328 25908285592 290521088 34359738367>>
<ENDPACKAGE>

BIN
bin/librm1/blprin.nbin Normal file
View File

Binary file not shown.

BIN
bin/librm1/blt.nbin Normal file
View File

Binary file not shown.

BIN
bin/librm1/boot.nbin Normal file
View File

Binary file not shown.

BIN
bin/librm1/break.nbin Normal file
View File

Binary file not shown.

478
bin/librm1/buf.fbin Normal file
View File

@@ -0,0 +1,478 @@
'<PCODE "2BUF">
<PACKAGE "BUF">
"A buffer is a VECTOR of two STRINGs. The first points to the buffer,
the second to the first unused character in the buffer.
Entry points:
<ADDCHR buffer character>
adds the character to the buffer.
<ADDCRLF buffer character>
adds a line-feed to the buffer after the character. (used in CHRTABLE).
<ADDFILE buffer channel --count-->
inserts 'count' characters from file, or whole thing.
<ADDSTRING buffer string --count-->
inserts 'count' characters or the whole string.
<ADD-OFFSET-STRING buffer string string>
inserts the first string into the buffer, with the second
string added as a prefix of each non-empty line.
BPRMPT1
BPRMPT2
Manifest offsets for accessing prompts in buffer.
BUF-BITS
A MACRO for playing with the BBITS field. Takes a buffer, a
bit, and (optionally) an atom or false. If only two arguments,
returns the current value (atom or false); if three, sets/clears
the specified bit.
BUF-ECHO-FLAG
If FALSE, echoes happen as usual. If a fix, instead of echoing
we erase <fix> characters, and setg buf-echo-flag to false. If
atom or applicable, apply to the character typed, the buffer,
and outchan.
<BUFCLEAR buffer>
clears buffer.
<BUFGROW buffer count>
grows buffer by count characters.
<BUFLENGTH buffer>
return number of characters in buffer.
<BUFMAKE count \"OPT\" prompt1 prompt2>
makes a buffer of length count, with prompts of prompt1 and prompt2.
<BUFPRINT buffer --channel-- prompt? redisp?>
efficient buffer printer of buffer to (optional) channel. The
characters in the buffer are printed, without regard to MUDDLE
escape characteristics (i.e., double-quote will not be preceded
by a back-slash). For printing as a string, see 'BUFSPRINT'.
BUFSIZE
free variable, amount to grow by if not given.
<BUFSPRINT buffer --channel-->
prints a buffer on an (optional) channel (default .OUTCHAN).
The function prints the buffer as a string, 'escaping' the
characters double-quote and back-slash so that the the string
may be read correctly as a MUDDLE object.
<BUFTECO buffer character>
function which applies TECO to a buffer. May be used in
CHRTABLE, and is default control-E function.
<BUFTOS buffer>
uses EXTRACT to generate a string whose length is the number of
characters in the buffer.
CHRTABLE
initial table,
ESC___ Returns from GETSTR (via GETSTRACT)
^Q Quotes the next character
^X Deletes current line
^W Deletes word back to separator
^@ Clears buffer
^E Edit the buffer
^F Inserts a file into the buffer
^P Undo the last major deletion
^T Re-enter TECO without munging its buffer
^D Displays the buffer on next line
^L Clears the screen and displays the buffer
<DELCHR buffer character>
returns deleted character or FALSE. Applies <GVAL DELPRINT> to
the character, unless DELPRINT is false. Initial GVAL of DELPRINT
is IMDEL.
<DELPRINT character>
GVAL applied to chars when deleted, unless GVAL is FALSE.
<DELTOCH buffer string \"OPT\" <or false string>>
deletes characters from buffer till member of string is deleted.
Returns # of chrs deleted. If optional string present, prints
it (followed by crlf) rather than echoing deleted characters on
non-display.
<DEL-TO-EOL>
sends delete-to-end-of-line stream (ctl-P L) to system.
DISPLAY?
T if console is an erasable display.
<DLINE buffer>
deletes the current line from the buffer. The separator
(initially ,LINEBRKS contains CR__ only) is not deleted.
<DWORD buffer>
deletes one 'word' in the buffer back from current point
till a member of ,WORDBRKS is encountered. The separator is
not deleted.
<FILEINP>
asks for file names, inputs the file.
FORMATEFFS
string of format-effector chars.
<GET-CPOS \"OPT\" channel>
Reads the cursor position on the channel (it better be open
on something where that's meaningful) and updates the channel's
position indicators. Used internally after SIOTs and such, which
don't change the data stored in the channel.
<GETSTR buffer --table-->
reads a string from the tty into the buffer (arg1). The
processing for characters is defined by a dispatch table
(default .CHRTABLE). This argument is a structured object of
pairs. The first element is a character, the second an
applicable object which is applied to the buffer and the
character, whenever that character is seen. GETSTR sets up a
special activation which is bound to the atom GETSTRACT. This
activation marks the repeat loop, and thus may be returned from
to get out of GETSTR. GETSTR returns the buffer.
GETSTRACT
GETSTR's activation, special.
<HPOS-BUF buffer>
takes a BUFFER and does a horizontal position to the calculated
end of the last line. For deletions, etc.
<IBUFCLEAR buffer character>
clears the buffer and does '<BUFPRINT ..>.
<IBUFPRINT buffer character>
clears screen if character is Form-feed. Then prints the buffer.
<IDELCHR buffer character>
deletes on character and returns it, or FALSE if buffer empty.
(Used in CHRTABLE).
<IMDEL>
knows how to delete chars from display. Uses GVAL of DISPLAY? to
determine whether applicable.
<INIT>
initializes defaults, setgs DISPLAY?.
<IOT \"OPTIONAL\" word channel character>
Does IOT on channel (default ,INCHAN) with bits as given by word.
Character is only useful on output. Returns character
<ISDISPLAY?>
returns T if console is an erasable display.
LINEBRKS
<MY-TTY-OFF>
see 'TTY ORDER' on .INFO.; also NDR;TTY-ON (et al).
<QUOTECHR buffer character>
quotes the next character by calling IOT, thus escaping the
normal dispatch through GETSTR. The function assumes the TTY
environment has been set up correctly. (see MY-TTY-OFF).
<RCPOS \"OPT\" channel>
Returns first value of RCPOS on channel (default ,INCHAN).
REENTER-TECO-CHAR
character that means reenter TECO without munging its buffer.
<SIOT string \"OPT\" word channel fix>
Does SIOT on channel of string, with control bits as set by
word. Returns string, probably rested. Interruptable during
SIOT. Fix is # chars to print, default to entire string.
TECO-PROGRAM
a string which is what BUFTECO will use to try to load the
inferior TECO.
<TTY-GET uv \"OPT\" channel>
Does TTY-GET into supplied uv.
<TTY-SET uv \"OPT\" channel>
Does TTY-SET from supplied uv.
<TTY-POS character fix>
takes a char (H or V) and a FIX, does ctl-P to set cursor
position in system.
TTY1
TTY2
these are words which MY-TTY-OFF uses too pass to
TTY-SET. TTY-SET sets the way the system handles
characters for you -- echoing, interrupting and
activating may be specified for classes of characters.
each class has a field in either TTY1 or TTY2.
<UNKILL buffer chr>
Undoes the last `major' deletion (word or more) from the buffer.
If nothing there, no effect. CHR is ignored.
WORDBRKS
strings of breaks to be used in deletion
"
\
<ENTRY ADDCHR ADDCRLF ADDFILE ADDSTRING ADD-OFFSET-STRING BPRMPT1 BPRMPT2
BUF-BITS BUF-BIT-PROMPT BUF-CTL-G? BUF-CTL-S? BUF-ECHO-FLAG BUFCLEAR BUFFER
BUFGROW BUFLENGTH BUFMAKE BUFPRINT BUFSIZE BUFSPRINT BUFTECO BUFTOS CHRTABLE
DELCHR DELPRINT DELTOCH DEL-TO-EOL DISPLAY? DLINE DWORD FILEINP FORMATEFFS
GET-CPOS GETSTR GETSTRACT HPOS-BUF IBUFCLEAR IBUFPRINT IDELCHR IMDEL INIT IOT
ISDISPLAY? LINEBRKS LINESTARVE MY-TTY-OFF QUOTECHR RCPOS REENTER-TECO-CHAR SIOT
TECO-PROGRAM TTY-GET TTY-SET TTY-POS TTY1 TTY2 UNKILL WORDBRKS>
<USE "MUDTEC" "INFERIOR">
<SETG IOT %<RSUBR!- '[ %<PCODE!- "2BUF" 0> IOT #DECL ("VALUE" CHARACTER
"OPTIONAL" <PRIMTYPE WORD> CHANNEL CHARACTER) ADDSTRING INF-RESULT
TECO-READ-BUFFER TECO-BUFFER-SIZE INF-CONTIN TECO-CLOSE TECO-OPEN TECO-ALLOC
TECO-KILL INF-START TECO-LOAD %<RGLOC INCHAN T> %<RGLOC OUTCHAN T> %<TYPE-W
BUFFER VECTOR> %<RGLOC BUFSIZE T> %<RGLOC DISPLAY? T> %<RGLOC IMDEL T> %<RGLOC
DELPRINT T> T OUTCHAN "TTY" "-continued-" "
" (CHANNEL) "\\\"" "\\\\" %<TYPE-W INF VECTOR> ![*BREAK-16 *VALUE!] %<RGLOC
REENTER-TECO-CHAR T> TECO %<RGLOC TECO T> %<TYPE-C INF VECTOR> "C"
"You are starting " %<RGLOC TECO-PROGRAM T>
" for the first time. If your INIT
is unconventional, you may have to exit with ^C, ^K
or their equivalents (not ^Z!) after it begins listening.
" "Control-Z before ready? " " edit aborted.
" "Back to " "An empty string was returned from "
".
The buffer has been left unchanged.
" "DONE" ^Z-TYPED "Please return from "
" with ^C, ^K, or their equivalents.
Please re-enter with ^" ".
You could get yourself into a bad state.
" "An error occurred in returning from " ": "
" was not able to start up successfully: " (*BREAK-16 :KILL) *VALUE ":KILL" %<
RGLOC TTY1 T> %<RGLOC TTY2 T> %<RGLOC TUV T> GETSTRACT OLD-TTY %<RGLOC
GLOBL-GETSTR-HAND T> ERROR!-INTERRUPTS INTERRUPT ELSE %<RGLOC GLOBL-GETSTR-CHAND
T> %<RGLOC BUF-CTL-G? T> %<RGLOC BUF-CTL-S? T> #DISMISS T CHRTABLE DELPRINT (
ACTIVATION) %<RGLOC BUF-ECHO-FLAG T> %<RGLOC WORDBRKS T> %<RGLOC LINEBRKS T>
" XXX?" "X" "S" "R" "L" "U" %<RGLOC GARBS T> "î" "File-name: " "READ" "DSK:" "[File-Input Aborted]" "[DONE]"
ARG-WRONG-TYPE!-ERRORS ADDSTRING ""]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,IOT PGLUE ![715827967 -1 -1 -1 -1 0!]>>
<SETG SIOT %<RSUBR-ENTRY '[IOT SIOT #DECL ("VALUE" STRING STRING "OPTIONAL" <
PRIMTYPE WORD> CHANNEL FIX)] 38>>
<SETG RCPOS %<RSUBR-ENTRY '[IOT RCPOS #DECL ("VALUE" FIX "OPTIONAL" CHANNEL)]
102>>
<SETG TTY-GET %<RSUBR-ENTRY '[IOT TTY-GET #DECL ("VALUE" <UVECTOR [REST <
PRIMTYPE WORD>]> UVECTOR "OPTIONAL" CHANNEL)] 125>>
<SETG TTY-SET %<RSUBR-ENTRY '[IOT TTY-SET #DECL ("VALUE" UVECTOR UVECTOR
"OPTIONAL" CHANNEL)] 149>>
<NEWTYPE BUFFER VECTOR '<<PRIMTYPE VECTOR> [4 STRING] FIX <PRIMTYPE WORD> STRING
FIX>>
<SETG BPRMPT1 3>
<SETG BPRMPT2 4>
<SETG INITIAL-HPOS 5>
<SETG BBITS 6>
<SETG BSAVED 7>
<SETG BSAVED-MAX 8>
<MANIFEST BPRMPT1 BPRMPT2 INITIAL-HPOS BBITS BSAVED BSAVED-MAX>
"If this bit is on, print a new prompt on every cr"
<SETG BUF-BIT-PROMPT 0>
<MANIFEST BUF-BIT-PROMPT>
<SETG TJDIS 2048>
<MANIFEST TJDIS>
<SETG REENTER-TECO-CHAR !\>
<SETG FORMATEFFS <MAPF ,STRING ,ASCII [13 10 14 9 32 8]>>
<SETG WORDBRKS <STRING <ASCII 13> <ASCII 10> " , ;:.">>
<SETG LINEBRKS <STRING <ASCII 13> <ASCII 10>>>
<SETG BUFSIZE 200>
<SETG BUF-ECHO-FLAG <>>
<GDECL (INCHAN) CHANNEL (DISPLAY?) <OR ATOM FALSE> (FORMATEFFS) STRING (BUFSIZE)
FIX (OLD-TTY) UVECTOR>
<SETG ADDCHR %<RSUBR-ENTRY '[IOT ADDCHR #DECL ("VALUE" BUFFER BUFFER CHARACTER)]
215>>
<DEFMAC BUF-BITS ('BUF 'BIT "OPTIONAL" 'NEW) <FORM BIND ((B .BUF) (BIT .BIT)) #
DECL ((B) BUFFER (BIT) <PRIMTYPE WORD>) <COND (<ASSIGNED? NEW> <FORM PUT <FORM
LVAL B> ,BBITS <FORM PUTBITS <FORM BBITS <FORM LVAL B>> <FORM BITS 1 <FORM LVAL
BIT>> <FORM COND (.NEW 1) (0)>>>) (T <FORM 1? <FORM CHTYPE <FORM GETBITS <FORM
BBITS <FORM LVAL B>> <FORM BITS 1 <FORM LVAL BIT>>> FIX>>)>>>
<SETG BUFGROW %<RSUBR-ENTRY '[IOT BUFGROW #DECL ("VALUE" BUFFER BUFFER
"OPTIONAL" FIX)] 244>>
<SETG INIT %<RSUBR-ENTRY '[IOT INIT #DECL ("VALUE" ATOM)] 320>>
<SETG BUFTOS %<RSUBR-ENTRY '[IOT BUFTOS #DECL ("VALUE" STRING BUFFER)] 341>>
<SETG DELCHR %<RSUBR-ENTRY '[IOT DELCHR #DECL ("VALUE" <OR CHARACTER FALSE>
BUFFER)] 364>>
<SETG BUFPRINT %<RSUBR-ENTRY '[IOT BUFPRINT #DECL ("VALUE" FIX BUFFER "OPTIONAL"
CHANNEL <OR ATOM FALSE> <OR ATOM FALSE>)] 465>>
<SETG DOSPRINT %<RSUBR-ENTRY '[IOT DOSPRINT #DECL ("VALUE" STRING STRING ANY
"OPTIONAL" <OR ATOM FALSE> FIX)] 679>>
<SETG GET-CPOS %<RSUBR-ENTRY '[IOT GET-CPOS #DECL ("VALUE" CHANNEL "OPTIONAL"
CHANNEL)] 752>>
<SETG BUFSPRINT %<RSUBR-ENTRY '[IOT BUFSPRINT #DECL ("VALUE" BUFFER BUFFER
"OPTIONAL" CHANNEL)] 791>>
<SETG FIRST-OF %<RSUBR-ENTRY '[IOT FIRST-OF #DECL ("VALUE" <OR FALSE STRING>
STRING STRING "OPTIONAL" FIX)] 918>>
<SETG BUFLENGTH %<RSUBR-ENTRY '[IOT BUFLENGTH #DECL ("VALUE" FIX BUFFER)] 992>>
<SETG BUFCLEAR %<RSUBR-ENTRY '[IOT BUFCLEAR #DECL ("VALUE" BUFFER BUFFER)] 1007>
>
<SETG DELTOCH %<RSUBR-ENTRY '[IOT DELTOCH #DECL ("VALUE" FIX BUFFER STRING
"OPTIONAL" <OR STRING FALSE>)] 1024>>
<SETG SAVE-KILL %<RSUBR-ENTRY '[IOT SAVE-KILL #DECL ("VALUE" BUFFER BUFFER <OR
STRING FALSE>)] 1231>>
<SETG UNKILL %<RSUBR-ENTRY '[IOT UNKILL #DECL ("VALUE" BUFFER BUFFER CHARACTER)]
1330>>
<SETG TECO-PROGRAM "T">
<SETG BUFTECO %<RSUBR-ENTRY '[IOT BUFTECO #DECL ("VALUE" BUFFER BUFFER
"OPTIONAL" CHARACTER)] 1365>>
<SETG TTY1 #WORD *020202020202*>
<SETG TTY2 #WORD *030202020202*>
<SETG TUV <IUVECTOR 3 #WORD *000000000000*>>
<SETG MY-TTY-OFF %<RSUBR-ENTRY '[IOT MY-TTY-OFF #DECL ("VALUE" UVECTOR
"OPTIONAL" WORD WORD)] 1830>>
<SETG ERRFCN %<RSUBR-ENTRY '[IOT ERRFCN #DECL ("VALUE" ANY FRAME "TUPLE" ANY)]
1872>>
<SETG BUF-CTL-G? T>
<SETG BUF-CTL-S? T>
<GDECL (BUF-CTL-G? BUF-CTL-S?) <OR ATOM FALSE>>
<SETG CHARFCN %<RSUBR-ENTRY '[IOT CHARFCN #DECL ("VALUE" <OR DISMISS FALSE>
CHARACTER CHANNEL)] 1956>>
<OFF <SETG GLOBL-GETSTR-HAND <ON "ERROR" ,ERRFCN 3 0>>>
<OFF <SETG GLOBL-GETSTR-CHAND <ON "CHAR" ,CHARFCN 7 0 ,INCHAN>>>
\
<SETG GETSTR %<RSUBR-ENTRY '[IOT GETSTR #DECL ("VALUE" BUFFER BUFFER "OPTIONAL"
<OR <LIST [REST VECTOR]> VECTOR> <OR STRING FALSE> STRING)] 2070>>
<SETG SPECIAL-CHAR? %<RSUBR-ENTRY '[IOT SPECIAL-CHAR? #DECL ("VALUE" <OR FALSE
VECTOR> CHARACTER <OR VECTOR <LIST [REST VECTOR]>>)] 2370>>
<SETG DWORD %<RSUBR-ENTRY '[IOT DWORD #DECL ("VALUE" FIX BUFFER CHARACTER)] 2433
>>
<SETG DLINE %<RSUBR-ENTRY '[IOT DLINE #DECL ("VALUE" FIX BUFFER CHARACTER)] 2453
>>
<SETG QUOTECHR %<RSUBR-ENTRY '[IOT QUOTECHR #DECL ("VALUE" BUFFER BUFFER
CHARACTER)] 2475>>
<SETG ADDCRLF %<RSUBR-ENTRY '[IOT ADDCRLF #DECL ("VALUE" BUFFER BUFFER CHARACTER
)] 2520>>
<SETG IDELCHR %<RSUBR-ENTRY '[IOT IDELCHR #DECL ("VALUE" <OR CHARACTER FALSE>
BUFFER CHARACTER)] 2587>>
<SETG IMDEL %<RSUBR-ENTRY '[IOT IMDEL #DECL ("VALUE" <OR CHARACTER FIX> BUFFER <
OR CHARACTER FIX>)] 2602>>
<SETG DEL-TO-EOL %<RSUBR-ENTRY '[IOT DEL-TO-EOL #DECL ("VALUE" STRING)] 2734>>
<SETG LINESTARVE %<RSUBR-ENTRY '[IOT LINESTARVE #DECL ("VALUE" STRING)] 2750>>
<SETG IBUFCLEAR %<RSUBR-ENTRY '[IOT IBUFCLEAR #DECL ("VALUE" BUFFER BUFFER
CHARACTER)] 2766>>
<SETG IBUFPRINT %<RSUBR-ENTRY '[IOT IBUFPRINT #DECL ("VALUE" FIX BUFFER
CHARACTER)] 2789>>
<SETG GARBS "H">
<SETG TTY-POS %<RSUBR-ENTRY '[IOT TTY-POS #DECL ("VALUE" FIX CHARACTER FIX)]
2834>>
<SETG BACKS %<RSUBR-ENTRY '[IOT BACKS #DECL ("VALUE" <OR FALSE STRING> STRING
STRING)] 2887>>
<SETG HPOS-BUF %<RSUBR-ENTRY '[IOT HPOS-BUF #DECL ("VALUE" FIX BUFFER "OPTIONAL"
<OR ATOM FALSE>)] 2937>>
<SETG FILEINP %<RSUBR-ENTRY '[IOT FILEINP #DECL ("VALUE" BUFFER BUFFER
"OPTIONAL" CHARACTER)] 3058>>
<SETG PADDSTRING %<RSUBR-ENTRY '[IOT PADDSTRING #DECL ("VALUE" BUFFER BUFFER
STRING)] 3318>>
<SETG ADDSTRING %<RSUBR-ENTRY '[IOT ADDSTRING #DECL ("VALUE" BUFFER BUFFER
"TUPLE" <TUPLE [REST <OR STRING CHARACTER FIX>]>)] 3341>>
<SETG ADD-OFFSET-STRING %<RSUBR-ENTRY '[IOT ADD-OFFSET-STRING #DECL ("VALUE"
BUFFER BUFFER STRING STRING)] 3459>>
<SETG ADDFILE %<RSUBR-ENTRY '[IOT ADDFILE #DECL ("VALUE" BUFFER BUFFER CHANNEL
"OPTIONAL" FIX)] 3554>>
<SETG ISDISPLAY? %<RSUBR-ENTRY '[IOT ISDISPLAY? #DECL ("VALUE" <OR ATOM FALSE>)]
3721>>
<SET CHRTABLE [!\ ,BUFTECO !\ ,BUFTECO !\ ,FILEINP !\ ,IDELCHR <ASCII 13>
,ADDCRLF <ASCII 12> ,IBUFPRINT !\ ,IBUFPRINT !\ ,UNKILL !\ ,QUOTECHR !\
<FUNCTION (BUF CHR) <RETURN .BUF .GETSTRACT>> !\ ,DLINE !\ ,DWORD !\ ,
DLINE <ASCII 0> ,IBUFCLEAR]>
<SETG BUFMAKE %<RSUBR-ENTRY '[IOT BUFMAKE #DECL ("VALUE" BUFFER FIX "OPTIONAL"
STRING STRING)] 3739>>
<SETG BUFFER-PRINT %<RSUBR-ENTRY '[IOT BUFFER-PRINT #DECL ("VALUE" ANY BUFFER)]
3805>>
<PRINTTYPE BUFFER ,BUFFER-PRINT>
<ENDPACKAGE>

BIN
bin/librm1/bufch.nbin Normal file
View File

Binary file not shown.

BIN
bin/librm1/bug.nbin Normal file
View File

Binary file not shown.

BIN
bin/librm1/bugsys.nbin Normal file
View File

Binary file not shown.

129
bin/librm1/calcom.fbin Normal file
View File

@@ -0,0 +1,129 @@
'<PCODE "CALCOM">
<PACKAGE "CALCOM">
<USE "STR" "CALRDR" "CALSYM" "CALUTL" "LEX">
<ENTRY ACT-SUBSYSTEM SUBSYS-SYMTAB SUBSYS-EVAL FILEPRINT LISTF FILETPL XFILE
TABLEPRINT TABLETHERE COPY-FILE ADDTABLE ADDCOMMAND KILL-TABLE CALICO-QUIT
TTY-SCRIPT END-TTY-SCRIPT END-ALL-TTY-SCRIPT TTY-SILENCE-DEPTH TTY-SILENCE
TTY-UNSILENCE GLUETABLES FIXGLUETABLE FLUSHGLUETABLE GLUECOMTABLE COMTABLE
SYSTAT COMTITLES>
<SETG SUBSYS-EVAL %<RSUBR!- '[ %<PCODE!- "CALCOM" 0> SUBSYS-EVAL #DECL ("VALUE"
STRING <VECTOR STRING>) DIRST SIXTOS GETAB SYSGT QUIT LOGOUT MAKESST MAKEGST
MAKEMST LEX-FIX-MASTER-TBL LEX-FIX-STRING-TBL LEX-GET MAKELST LSTDELETE
LSTINSERT GETTABLES RLJFN GNJFN JFNS GTJFN FSP-PARSE OPENTELL XFPUSH READER
MAKEBGST USE-DATUM SUBSYS-SYMTAB "MUDCAL-SUBSYS-VECTOR" "Subsystems" %<RGLOC
SUBSYS-EVAL T> %<RGLOC SUBSYS-SYMTAB T> "named" [
"type the name of the subsystem to be activated" "ARC:CALSUB;ACTSUB HELPM"] [
"SYM"] T "READ" "PRINT" OUTCHAN %<RGLOC OUTCHAN T> " " %<RGLOC TENEX T>
CALICO-DEV ":<" CALICO-SNM ">" ".FILE." "*" "(DIR)" "*;*" JFN " " "TPL:" %<
TYPE-W SYMTABLE VECTOR> %<RGLOC GLUEABLE T> MSTOPS #FALSE () COMTABLE %<RGLOC
COMTABLE T> GLUECOMTABLE %<RGLOC GLUECOMTABLE T> %<TYPE-C SYMTABLE VECTOR>
"Glued Command Table" LSTOPS %<TYPE-W LEXID WORD> %<RGLOC LEX-SCRATCH-STRING T>
#FALSE ("Illegal symbol table type present") #FALSE ("No top level symbol table"
) LXTBL %<TYPE-W LEXTABLE VECTOR> %<RGLOC LXTBL T> %<RGLOC COMTITLES T>
"Current CALICO commands" "Command table titles" %<RSUBR!- '[ %<PCODE!-
"CALCOM" 2490> ANONF1!-TMP #DECL ("VALUE" ANY ANY)]> %<TYPE-C SYMBOL VECTOR>
PERSONALS %<RGLOC PERSONALS T> "Personal commands"
"No console script file open now." () TTY-OUTPUT-WORD TTY-SILENCE-DEPTH "SYSTAT"
"Load avg: " ", " "JOBTTY" "JOBDIR" "SNAMES" "JOBNAM" LEN
"JOB TTY SUBSYS LOG" ENT " " "DET" "?" " "]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,SUBSYS-EVAL PGLUE ![713730730 -22906486785 -1
-1 -1 -262144 0!]>>
<SETG ACT-SUBSYSTEM %<RSUBR-ENTRY '[SUBSYS-EVAL ACT-SUBSYSTEM #DECL ("VALUE"
ATOM)] 16>>
<SETG COPY-FILE %<RSUBR-ENTRY '[SUBSYS-EVAL COPY-FILE #DECL ("VALUE" ATOM STRING
STRING)] 114>>
<SETG FILEPRINT %<RSUBR-ENTRY '[SUBSYS-EVAL FILEPRINT #DECL ("VALUE" ATOM STRING
"OPTIONAL" CHANNEL)] 160>>
<SETG LISTF %<RSUBR-ENTRY '[SUBSYS-EVAL LISTF #DECL ("VALUE" ATOM STRING)] 231>>
<SETG FILETPL %<RSUBR-ENTRY '[SUBSYS-EVAL FILETPL #DECL ("VALUE" ATOM STRING)]
542>>
<SETG XFILE %<RSUBR-ENTRY '[SUBSYS-EVAL XFILE #DECL ("VALUE" ATOM STRING)] 573>>
<SETG TABLEPRINT %<RSUBR-ENTRY '[SUBSYS-EVAL TABLEPRINT #DECL ("VALUE" ATOM
SYMTABLE)] 599>>
<SETG GLUEABLE '[SSTOPS BSTOPS]>
<SETG GETTABLES %<RSUBR-ENTRY '[SUBSYS-EVAL GETTABLES #DECL ("VALUE" <OR FALSE
VECTOR> SYMTABLE)] 658>>
<SETG GLUETABLES %<RSUBR-ENTRY '[SUBSYS-EVAL GLUETABLES #DECL ("VALUE" ANY
"OPTIONAL" SYMTABLE FIX)] 775>>
<SETG FIXGLUETABLE %<RSUBR-ENTRY '[SUBSYS-EVAL FIXGLUETABLE #DECL ("VALUE" ATOM)
] 1157>>
<SETG FLUSHGLUETABLE %<RSUBR-ENTRY '[SUBSYS-EVAL FLUSHGLUETABLE #DECL ("VALUE"
ANY)] 1199>>
<SETG ADDTABLE %<RSUBR-ENTRY '[SUBSYS-EVAL ADDTABLE #DECL ("VALUE" ATOM SYMTABLE
)] 1334>>
<SETG GLUECOMTABLE <>>
<SETG TABLETHERE %<RSUBR-ENTRY '[SUBSYS-EVAL TABLETHERE #DECL ("VALUE" <OR FALSE
SYMTABLE> STRING <VECTOR [REST SYMTABLE]>)] 1505>>
<SETG ADDCOMMAND %<RSUBR-ENTRY '[SUBSYS-EVAL ADDCOMMAND #DECL ("VALUE" ATOM
STRING ANY)] 1547>>
<SETG KILL-TABLE %<RSUBR-ENTRY '[SUBSYS-EVAL KILL-TABLE #DECL ("VALUE" ATOM
SYMTABLE)] 1674>>
<SETG CALICO-QUIT %<RSUBR-ENTRY '[SUBSYS-EVAL CALICO-QUIT #DECL ("VALUE" ATOM)]
1825>>
<SETG TTY-SCRIPT %<RSUBR-ENTRY '[SUBSYS-EVAL TTY-SCRIPT #DECL ("VALUE" ATOM
STRING)] 1863>>
<SETG END-TTY-SCRIPT %<RSUBR-ENTRY '[SUBSYS-EVAL END-TTY-SCRIPT #DECL ("VALUE"
ATOM)] 1910>>
<SETG END-ALL-TTY-SCRIPT %<RSUBR-ENTRY '[SUBSYS-EVAL END-ALL-TTY-SCRIPT #DECL (
"VALUE" ATOM)] 1953>>
<SET TTY-SILENCE-DEPTH 0>
<SETG TTY-SILENCE %<RSUBR-ENTRY '[SUBSYS-EVAL TTY-SILENCE #DECL ("VALUE" ATOM)]
2001>>
<SETG TTY-UNSILENCE %<RSUBR-ENTRY '[SUBSYS-EVAL TTY-UNSILENCE #DECL ("VALUE"
ATOM)] 2043>>
<SETG SYSTAT %<RSUBR-ENTRY '[SUBSYS-EVAL SYSTAT #DECL ("VALUE" ATOM)] 2084>>
<SETG PRINCJ %<RSUBR-ENTRY '[SUBSYS-EVAL PRINCJ #DECL ("VALUE" FIX FIX)] 2378>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,SUBSYS-EVAL GLUE ![1074004996 1125638215
-15300755445 297861112 4563681282 1158740800 16452 16140190212 53248 5385819472
12892242882 1886388272 30068178945 1360007175 -4294835952 7516486912 4580294660
33554726161 4327490624 19278139423 4467783 3222996305 470548881 -16310861412
12891981841 -17022836984 7537164288 1079268400 117453824 0 67387360 17196859393
284197131 17180939532 12885181232 805307456 13958650880 4316987392 268435456
4651746304 18104729856 8338403585 4214784 1094780228 21479378944 12889169777
-16370105259 4347164416 1410334978 1073877015 -16440671364 17269260304 262404
30920495173 353224477 -83880688 262156 -17163002864 13371392 553648148
5653921843 91242496 13692339207 -8727298048 17108081 -9663624181 754978829
4496294160 69907 3145728 285212684 270192 0 16384 67121424 12884996099
12884902912 12585984 196608 1087111172 50684 184797124 3221947187 7784628240
32768256 17399026688 268502848 3291480064 1114133 -17179820032 268435473
-13859028981 857538560 1097859120 4390913 71303216 12885164032 64 272629824
4195072 1086419968 1049868 22806528 24360521740 71049280 4263168 1096220672
17448304755 -13690141348 211984 268524800 268504156 3422620864 3489726476
30072123404 281870400 1145324512 19072484384 3224617224 806154306 201523983
-34058268168 4823519436 17230213900 -3489611760 -15720243149 6175912720
31078751475 33763330 2150632691 46924359 16309354496 68501532 -4264611836
1073741823 262148 18 524408 262322 524460 262379 262690 262721 262747 799 262935
525077 1159 1201 263482 525799 525841 263822 1827 264011 1912 1955 2003 2045
2086 264526!]>>
<ENDPACKAGE>

53
bin/librm1/caldes.fbin Normal file
View File

@@ -0,0 +1,53 @@
'<PCODE "1CALDES">
<PACKAGE "CALDES">
<ENTRY PDESC CALDESC TABMAP MASTER-DESC-FILE MASTER-DESC-CHAN>
<USE "CALCOM" "CALSYM" "LEX" "PMAP" "SDML">
<SETG ARRSTR " => ">
<SETG MASTER-DESC-FILE <COND (,TENEX "<MUDDLE>[DESC].MASTER") (
"CALSUB;DESC MASTER")>>
<SETG MASTER-DESC-CHAN <>>
<SETG GETABFIL %<RSUBR!- '[ %<PCODE!- "1CALDES" 0> GETABFIL #DECL ("VALUE" <OR
FALSE PMCHAN> STRING) LEX-LOOKUP PDESC SDMGETCHAN LEX-GET SDMDCT SDMGET SDMOPN
%<RGLOC MASTER-DESC-CHAN T> %<TYPE-C PMCHAN VECTOR> %<RGLOC MASTER-DESC-FILE T>
%<TYPE-W PMCHAN VECTOR> #FALSE () T %<TYPE-W SYMTABLE VECTOR> MSTOPS LSTOPS
GSTOPS BGSTOPS VAL TABFIL %<TYPE-C LEXTABLE VECTOR> %<TYPE-W LEXTABLE VECTOR> %<
TYPE-W LEXID WORD> %<RGLOC LEX-SCRATCH-STRING T> OUTCHAN COMMENT %<RGLOC
COMTABLE T> %<TYPE-W SYMBOL VECTOR> %<TYPE-C SYMTABLE VECTOR> " " " No info?"
(CHANNEL) %<RGLOC ARRSTR T> %<RGLOC GETSYM2VCT T>]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,GETABFIL PGLUE ![715849727 -1 -17179869184!]>>
<SETG FLSTABFIL %<RSUBR-ENTRY '[GETABFIL FLSTABFIL #DECL ("VALUE" ATOM
"OPTIONAL" ANY)] 54>>
<SETG PDESC %<RSUBR-ENTRY '[GETABFIL PDESC #DECL ("VALUE" ATOM "TUPLE" <TUPLE [
REST SYMTABLE]>)] 102>>
<SETG TABMAP %<RSUBR-ENTRY '[GETABFIL TABMAP #DECL ("VALUE" ATOM VECTOR FIX
STRING)] 222>>
<SETG CALDESC %<RSUBR-ENTRY '[GETABFIL CALDESC #DECL ("VALUE" ATOM "TUPLE" <
TUPLE [REST SYMBOL]>)] 429>>
<SETG PRINTDAT %<RSUBR-ENTRY '[GETABFIL PRINTDAT #DECL ("VALUE" ANY ANY)] 610>>
<SETG GETSYMOFF %<RSUBR-ENTRY '[GETABFIL GETSYMOFF #DECL ("VALUE" <OR FALSE <
PRIMTYPE VECTOR>> STRING <PRIMTYPE VECTOR>)] 687>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,GETABFIL GLUE ![1078140352 -33889924088
4819387392 4379120709 -13951030153 13639876869 268505328 22838771968 3493876544
18259070224 1053700 17269456896 1044 17209700860 4787077313 475466944
-34069872640 8708161556 17247043925 17268195612 30065299904 201327888 4294967408
7784628228 5372903539 10670330624 -12598895153 1127219239 213909552 4366285825
4379906115 135287247 13496468823 0 17700208832 17842176 17448309824 33554497552
1048848 119476245 21475098624 4264023 13174330369 -16039018351 -17178820608 1025
268440000 262400 1048575 262148 69 262211 786662 262758 524981!]>>
<SETG GETSYM2VCT [0 0]>
<ENDPACKAGE>

BIN
bin/librm1/calrdr.fbin Normal file
View File

Binary file not shown.

190
bin/librm1/calsym.fbin Normal file
View File

@@ -0,0 +1,190 @@
'<PCODE "CALSYM">
<PACKAGE "CALSYM">
<ENTRY MAKEBST BSTOPS BSTSORT BGSTOPS BGSTSORT MAKEBGST MAKESST SSTOPS MAKEMST
MSTOPS MAKEGST GSTOPS SYMBOL SYMTABLE READER-SILENCE CURXCHAN CALICO-DEV
CALICO-SNM CALICO-NM1 CALICO-NM2 PROMPT1 PROMPT2 MUDPRM DSPLEVEL SAVEREP COMPS
SORTCHK STRCOMP-NC TENEX>
<NEWTYPE SYMTABLE VECTOR '<VECTOR ATOM [REST ANY]>>
<NEWTYPE SYMBOL VECTOR '<VECTOR STRING ANY>>
<SETG TENEX <>>
<SET CURXCHAN <>>
<SET DSPLEVEL 0>
<SET CALICO-DEV "DSK">
<SET CALICO-SNM ,SNM>
<SET CALICO-NM1 ,SNM>
<SET CALICO-NM2 !">>
<SETG SSTOPS %<RSUBR!- '[ %<PCODE!- "CALSYM" 0> SSTOPS #DECL ("VALUE" ANY FIX
"TUPLE" TUPLE) BSTLOOKUP GSTEVAL BSTPOSSYM BSTEXACT BSTALLPOSS BSTALLPOSS
BSTEXACT BSTPOSSYM BSTEVAL BSTLOOKUP GSTALLPOSS GSTEXACT GSTPOSSYM GSTEVAL
GSTLKP [SSTLKP SSTEVAL SSTPOSSYM SSTPRINT SSTEXACT SSTALLPOSS] #FALSE () () %<
TYPE-W SYMBOL VECTOR> "" OUTCHAN T " " SSTOPS %<TYPE-W SYMTABLE VECTOR>
MSTLKP MSTEVAL MSTPOSSYM MSTPRINT MSTEXACT MSTALLPOSS RES MSTOPS GSTOPS %<RGLOC
SORTCHK T> BSTOPS BGSTOPS " "]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,SSTOPS PGLUE ![715827882 -1 -67108864!]>>
<SETG SSTLKP %<RSUBR-ENTRY '[SSTOPS SSTLKP #DECL ("VALUE" <VECTOR FIX ANY STRING
FIX> STRING FIX <VECTOR [REST STRING ANY]> <VECTOR FIX ANY STRING FIX>)] 43>>
<SETG SSTALLPOSS %<RSUBR-ENTRY '[SSTOPS SSTALLPOSS #DECL ("VALUE" <LIST [REST
SYMBOL]> STRING FIX <VECTOR [REST STRING ANY]>)] 176>>
<SETG SSTPOSSYM %<RSUBR-ENTRY '[SSTOPS SSTPOSSYM #DECL ("VALUE" FIX STRING FIX <
VECTOR [REST STRING ANY]> "OPTIONAL" STRING STRING)] 258>>
<SETG SSTEVAL %<RSUBR-ENTRY '[SSTOPS SSTEVAL #DECL ("VALUE" SYMBOL FIX <VECTOR [
REST STRING ANY]>)] 364>>
<SETG SSTPRINT %<RSUBR-ENTRY '[SSTOPS SSTPRINT #DECL ("VALUE" ATOM <VECTOR [REST
STRING ANY]>)] 407>>
<SETG SSTEXACT %<RSUBR-ENTRY '[SSTOPS SSTEXACT #DECL ("VALUE" <OR FALSE SYMBOL>
STRING VECTOR)] 485>>
<SETG MAKESST %<RSUBR-ENTRY '[SSTOPS MAKESST #DECL ("VALUE" SYMTABLE STRING <
VECTOR [REST STRING ANY]> "OPTIONAL" ANY)] 543>>
<SETG MSTOPS %<RSUBR-ENTRY '[SSTOPS MSTOPS #DECL ("VALUE" ANY FIX "TUPLE" TUPLE)
] 582>>
<SETG MSTLKP %<RSUBR-ENTRY '[SSTOPS MSTLKP #DECL ("VALUE" <VECTOR FIX ANY STRING
FIX> STRING FIX <VECTOR [REST SYMTABLE]> <VECTOR FIX ANY STRING FIX>)] 639>>
<SETG MSTEVAL %<RSUBR-ENTRY '[SSTOPS MSTEVAL #DECL ("VALUE" SYMBOL <VECTOR FIX
ANY> <VECTOR [REST SYMTABLE]>)] 812>>
<SETG MSTALLPOSS %<RSUBR-ENTRY '[SSTOPS MSTALLPOSS #DECL ("VALUE" <LIST [REST
ANY]> STRING FIX <VECTOR [REST SYMTABLE]>)] 862>>
<SETG MSTPOSSYM %<RSUBR-ENTRY '[SSTOPS MSTPOSSYM #DECL ("VALUE" FIX STRING FIX <
VECTOR [REST SYMTABLE]> "OPTIONAL" STRING STRING)] 983>>
<SETG MSTPRINT %<RSUBR-ENTRY '[SSTOPS MSTPRINT #DECL ("VALUE" ATOM <VECTOR [REST
SYMTABLE]> "OPTIONAL" FIX)] 1090>>
<SETG MSTEXACT %<RSUBR-ENTRY '[SSTOPS MSTEXACT #DECL ("VALUE" <OR FALSE SYMBOL>
STRING <VECTOR [REST SYMTABLE]>)] 1191>>
<SETG MAKEMST %<RSUBR-ENTRY '[SSTOPS MAKEMST #DECL ("VALUE" SYMTABLE STRING <
VECTOR SYMTABLE> "OPTIONAL" ANY)] 1244>>
<SETG GSTOPS %<RSUBR-ENTRY '[SSTOPS GSTOPS #DECL ("VALUE" <OR ATOM FIX LIST
SYMBOL <OR FALSE LIST> <VECTOR FIX ANY STRING FIX>> FIX "TUPLE" TUPLE)] 1283>>
<SETG GSTLKP %<RSUBR-ENTRY '[SSTOPS GSTLKP #DECL ("VALUE" <VECTOR FIX ANY STRING
FIX> STRING FIX <VECTOR FIX ANY> <VECTOR FIX ANY STRING FIX>)] 1362>>
<SETG GSTPOSSYM %<RSUBR-ENTRY '[SSTOPS GSTPOSSYM #DECL ("VALUE" FIX STRING FIX <
VECTOR FIX ANY> "OPTIONAL" STRING STRING)] 1507>>
<SETG GSTALLPOSS %<RSUBR-ENTRY '[SSTOPS GSTALLPOSS #DECL ("VALUE" LIST STRING
FIX <VECTOR FIX ANY>)] 1622>>
<SETG GSTEVAL %<RSUBR-ENTRY '[SSTOPS GSTEVAL #DECL ("VALUE" SYMBOL FIX <VECTOR
FIX ANY> <OR 'T FALSE>)] 1694>>
<SETG GSTPRINT %<RSUBR-ENTRY '[SSTOPS GSTPRINT #DECL ("VALUE" ATOM VECTOR)] 1756
>>
<SETG GSTEXACT %<RSUBR-ENTRY '[SSTOPS GSTEXACT #DECL ("VALUE" <OR FALSE SYMBOL>
STRING VECTOR)] 1850>>
<SETG MAKEGST %<RSUBR-ENTRY '[SSTOPS MAKEGST #DECL ("VALUE" SYMTABLE STRING <
VECTOR FIX ANY> "OPTIONAL" ANY)] 1920>>
<SETG BSTSORT %<RSUBR-ENTRY '[SSTOPS BSTSORT #DECL ("VALUE" ANY ANY "OPTIONAL"
FIX FIX)] 1959>>
<SETG SORTCHK %<RSUBR-ENTRY '[SSTOPS SORTCHK #DECL ("VALUE" <OR ATOM FALSE>
STRING STRING)] 2011>>
<SETG MAKEBST %<RSUBR-ENTRY '[SSTOPS MAKEBST #DECL ("VALUE" SYMTABLE STRING <
VECTOR [REST STRING ANY]> "OPTIONAL" <OR FALSE FORM>)] 2037>>
<SETG BSTOPS %<RSUBR-ENTRY '[SSTOPS BSTOPS #DECL ("VALUE" <OR ATOM FIX SYMBOL <
LIST [REST SYMBOL]> <OR FALSE <LIST [REST SYMBOL]>> <VECTOR STRING ANY> <VECTOR
FIX ANY STRING FIX>> FIX "TUPLE" ANY)] 2076>>
<SETG BSTLOOKUP %<RSUBR-ENTRY '[SSTOPS BSTLOOKUP #DECL ("VALUE" <VECTOR FIX ANY
STRING FIX> STRING FIX VECTOR <VECTOR FIX ANY STRING FIX>)] 2152>>
<SETG BSTEVAL %<RSUBR-ENTRY '[SSTOPS BSTEVAL #DECL ("VALUE" SYMBOL FIX <VECTOR [
REST STRING ANY]>)] 2350>>
<SETG BSTPOSSYM %<RSUBR-ENTRY '[SSTOPS BSTPOSSYM #DECL ("VALUE" FIX STRING FIX
VECTOR "OPTIONAL" STRING STRING)] 2386>>
<SETG BSTALLPOSS %<RSUBR-ENTRY '[SSTOPS BSTALLPOSS #DECL ("VALUE" <LIST [REST
SYMBOL]> STRING FIX VECTOR)] 2563>>
<SETG BSTEXACT %<RSUBR-ENTRY '[SSTOPS BSTEXACT #DECL ("VALUE" <OR FALSE SYMBOL>
STRING VECTOR)] 2740>>
<SETG UPPERCHAR %<RSUBR-ENTRY '[SSTOPS UPPERCHAR #DECL ("VALUE" FIX CHARACTER)]
2834>>
<SETG GETINDEX %<RSUBR-ENTRY '[SSTOPS GETINDEX #DECL ("VALUE" FIX VECTOR STRING
"OPTIONAL" FIX FIX)] 2857>>
<SETG STRCOMP-NC %<RSUBR-ENTRY '[SSTOPS STRCOMP-NC #DECL ("VALUE" FIX STRING
STRING "OPTIONAL" FIX)] 3017>>
<SETG BGSTOPS %<RSUBR-ENTRY '[SSTOPS BGSTOPS #DECL ("VALUE" <OR ATOM FIX SYMBOL
<LIST [REST SYMBOL]> <OR FALSE <LIST [REST SYMBOL]>> <VECTOR STRING ANY> <VECTOR
FIX ANY STRING FIX>> FIX "TUPLE" ANY)] 3125>>
<SETG MAKEBGST %<RSUBR-ENTRY '[SSTOPS MAKEBGST #DECL ("VALUE" SYMTABLE STRING
VECTOR "OPTIONAL" ANY)] 3204>>
<SETG BGSTSORT %<RSUBR-ENTRY '[SSTOPS BGSTSORT #DECL ("VALUE" ANY VECTOR)] 3243>
>
<SETG BSTPRINT %<RSUBR-ENTRY '[SSTOPS BSTPRINT #DECL ("VALUE" ATOM <VECTOR [REST
STRING ANY]>)] 3270>>
<SETG COMPS %<RSUBR-ENTRY '[SSTOPS COMPS #DECL ("VALUE" FIX STRING STRING
"OPTIONAL" FIX)] 3337>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,SSTOPS GLUE ![4310823937 -3221225471 16
4580200465 17179870212 67108864 5372903424 1073745924 4194304 17263755264
1077919749 65536 17247043605 23018340677 82181 18350884188 -13756246783
7516520449 297795596 201392448 262144 0 1835269 4764751105 -16290676668
12888293388 16859136 268440896 33621558273 55640384 5259588 24898371584
30065823743 -16769216 8388608000 4294967297 286388480 70656 1073807360
1074070528 0 67436800 1024 1073741824 1053696 4194304 16384 16805888 67388412
87031809 16827504 4295229440 349301 18253612308 80 17533334289 23407558724
5704544257 17180131344 17760320 21474836801 1360265477 21505523716 16846016
3221225729 4214784 1052673 -3221209072 68223296 21038353 30874009601
-17175673840 9680731280 17450668096 21543003167 17450401792 1078214720 335826944
16842768 1281 256 67174401 0 335544325 1095833393 5757939780 356534016
5368725575 196656 5120 263232 16110649345 269434880 1280 267264 1090519040
1114128 117441556 18320916480 1892941824 17874956 -4291821568 5242880
17247043584 5704766464 18257629184 83886100 4379996931 -17179754496 21543326016
18605932592 262145 1342201725 5259588 24898371584 30065819908 2420179521
1083195649 17452535933 1082130432 17251451904 4299440144 67178496 1073742100 1
289408000 82176 16641 1025 5 64 0 7340353 1413860421 24910762256 4299440144
67178496 1096024081 -17174626304 71761920 786432 12952012032 257 8322548807
-17178820544 4563403797 33419427857 17179869201 4295030016 268746752 32555008
268440576 267588 286261264 524288000 4294967296 33554432000 13958660096
4363190277 1095832577 5704253440 1145324608 18253628672 0 1073745920 18271442180
1073807429 1342177360 17519935505 286331153 65536 17251242257 4294967296
4647289856 17450668099 -14759689663 1079001346 17704223232 336613655 12947816476
16843008 68157504 7360512 -17167279104 12888293633 -12884901568 17246978112
67178560 1048629 786616 786713 1048849 1310991 524658 262555 524779 524845
786987 1049225 525106 787302 787438 1049574 1311716 263248 525390 525485 525546
787688 1049948 787962 1050098 1312240 788062 788134 263904 526144 526222 788364
264125 526262 788404 526305 526339 788481 1050738 526644 788841 1050977 1313119
789003 527034 264982 527168 789304 1051446 527319 789461 527506 789648 265391
265418 789786 527638!]>>
<ENDPACKAGE>

66
bin/librm1/caltop.fbin Normal file
View File

@@ -0,0 +1,66 @@
'<PCODE "1CALTOP">
<PACKAGE "CALTOP">
<ENTRY TOPCOMTABLE>
<USE "CALDES" "CALSYM" "LEX" "CALUTL" "CALCOM" "COMMAND" "MUDCAL" "CALRDR"
"JOBS" "TAILOR">
<SETG COMBINE-SYMTABS %<RSUBR!- '[ %<PCODE!- "1CALTOP" 0> COMBINE-SYMTABS #DECL
("VALUE" ANY) MAKEMST COMBSYMS "Combined commands and symbol-tables" %<RGLOC
COMTITLES T> %<RGLOC COMTABLE T> %<RGLOC COMBSYMS T>]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,COMBINE-SYMTABS PGLUE ![805044224!]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,COMBINE-SYMTABS GLUE ![17231769648 46186559 2!
]>>
<SET TOPCOMTABLE <MAKELST "Top level commands" '["activate.subsystem" <
ACT-SUBSYSTEM> "commands" <CALICO-COMMAND <FUNCTION (A) <COND (<TYPE? .A
SYMTABLE> <TABLEPRINT .A>) (ELSE <TERPRI> <PRINC "No such command table.">)>> [,
COMTITLES "from" '[
"Type the name of the current command table
whose contents you wish to examine. Type ^F
to see the titles of all current tables." ""] ["SYM"]] [,COMTITLES]> "describe"
<CALICO-COMMAND ,CALDESC '[<COMBINE-SYMTABS> "command" [
"Type the name of the command or
symbol-table you would like described." ""] ["MULT" "SYM"]] '[] "SEGMENT-EACH">
"who" <LISTF "TTY:"> "listf" <CALICO-COMMAND ,LISTF '[[] "Device" [
"Type the name of the device
whose directory you wish to list." ""] ["FILE"]] '["DSK:"]> "print.file" <
CALICO-COMMAND ,FILEPRINT '[[] "" [
"Type the name of the file you wish to print." ""] ["FILE"]] '[""]> "copy.file"
<CALICO-COMMAND ,COPY-FILE '[[] "from" [
"Type the name of the file to be copied from." ""] ["FILE"] [] "to" [
"Type the name of the new file to get the
copy of the original file." ""] ["FILE"]]> "copy.to.printer" <CALICO-COMMAND ,
FILETPL '[[] "from" [
"Type the name of the file to be copied to
the line-printer." ""] ["FILE"]]> "delete.file" <CALICO-COMMAND ,RENAME '[[]
"named" ["Type the name of the file you wish to be
deleted." ""] ["FILE"]] '[] "PRINT-RESULT"> "rename.file" <CALICO-COMMAND <
FUNCTION (A B) <RENAME .A TO .B>> '[[] "from" [
"Type the current name of the file to be
renamed." ""] ["FILE"] [] "to" ["Type the new name to be given to the file." ""]
["FILE"]] '[] "PRINT-RESULT"> "execute.file" <CALICO-COMMAND ,XFILE '[[] "from"
["Type the name of the file whose contents is to
be used as console input." ""] ["FILE"]] '["MUDCAL (INIT)"]> "script" <
CALICO-COMMAND ,TTY-SCRIPT '[[] "to" [
"Type the name of the file into which the
tty script should be placed." ""] ["FILE"]]> "end.script" <END-TTY-SCRIPT>
"end.all.scripts" <END-ALL-TTY-SCRIPT> "turn.tty.off" <TTY-SILENCE>
"turn.tty.on" <TTY-UNSILENCE> "kill" <CALICO-COMMAND ,KILL-TABLE [,COMTITLES
"table title" '[
"Type the title of the table to be removed
from the current command set." ""] '["SYM"]] [<1 <2 ,COMTABLE>>]> "quit" <
CALICO-QUIT> "recurse.to.muddle" <RECURSEFCN> "fload" <CALICO-COMMAND ,FLOAD '[[
] "" ["Type the name of the file you want to load." ""] ["FILE"]] '[""]>
"continue" <ERRET T> "erret" <CALICO-COMMAND ,ERRET '[[] "value" [
"Type the value that you want to ERRET." ""] ["OBJECTS"]] '[] "SEGMENT-EACH">
"top.level" <TOP-LEVEL-FCN> "evaluate" <CALICO-COMMAND ,PRINT '[[] "" [
"Type the MUDDLE object you want to evaluate." ""] ["FORM"]] '[()]> "frames" <
FRAMES> "tailor" <TAILOR> "run" <CALICO-COMMAND ,RUN '[[] "job" [
"type the name of the job to be run as an inferior" "ARC:CALSUB;RUN HELPM"] [
"LINE"] [] "JCL" ["type a command stream to be given to the job."
"ARC:CALSUB;RUN HELPM"] ["LINE"]] ["TIME"] "SEGMENT-EACH">] 2>>
<ENDPACKAGE>

49
bin/librm1/calutl.fbin Normal file
View File

@@ -0,0 +1,49 @@
'<PCODE "NCALUT">
<PACKAGE "CALUTL">
<USE "STR" "CALSYM" "TTY" "TIMFCN">
<ENTRY FSP-PARSE DATE-PARSE XFPUSH XFPOP NOTTY? CAREFUL-TTY-OFF OPENTELL RDBLOUT
XFSTACK XFLEVEL>
<SETG SSNAM %<RSUBR!- '[ %<PCODE!- "NCALUT" 0> SSNAM #DECL ("VALUE" <PRIMTYPE
WORD> <PRIMTYPE WORD>) COMPS SUBSTRUC TTY-OFF SSNAM STRTOX NOTTY? T "NO-TTY"
INCHAN #FALSE () CURXCHAN XFLEVEL READER-SILENCE XFSTACK DSPLEVEL OUTCHAN SPCPRT
() [LVAL GVAL] STR P <LIST [REST FIX]> MONTHS ![31 28 31 30 31 30 31 31 30 31 30
31!]]>>
<SETG NOTTY? %<RSUBR-ENTRY '[SSNAM NOTTY? #DECL ("VALUE" <OR FALSE ATOM>)] 7>>
<SETG FSP-PARSE %<RSUBR-ENTRY '[SSNAM FSP-PARSE #DECL ("VALUE" <VECTOR [REST <OR
LOSE STRING>]> STRING)] 15>>
<SETG CAREFUL-TTY-OFF %<RSUBR-ENTRY '[SSNAM CAREFUL-TTY-OFF #DECL ("VALUE" ANY)]
87>>
<SETG OPENTELL %<RSUBR-ENTRY '[SSNAM OPENTELL #DECL ("VALUE" <OR CHANNEL FALSE>
STRING STRING)] 128>>
<SETG XFPUSH %<RSUBR-ENTRY '[SSNAM XFPUSH #DECL ("VALUE" ATOM <OR CHANNEL STRING
FALSE> "OPTIONAL" <OR ATOM FALSE>)] 171>>
<SETG XFPOP %<RSUBR-ENTRY '[SSNAM XFPOP #DECL ("VALUE" <OR CHANNEL STRING FALSE>
)] 251>>
<SET SPCPRT [9 "[TAB]" 10 "[LF]" 12 "[FF]" 13 "[CR]" 27 "[ESC]" 32 "[SP]" 127
"[DEL]"]>
<SETG RDBLOUT %<RSUBR-ENTRY '[SSNAM RDBLOUT #DECL ("VALUE" ATOM <OR STRING
CHARACTER> "OPTIONAL" CHANNEL)] 349>>
<SETG DATE-PARSE %<RSUBR-ENTRY '[SSNAM DATE-PARSE #DECL ("VALUE" <OR FALSE <LIST
[3 FIX]>> STRING "OPTIONAL" <LIST [3 FIX]>)] 476>>
<SET MONTHS ["JAN" "FEB" "MAR" "APR" "MAY" "JUN" "JUL" "AUG" "SEP" "OCT" "NOV"
"DEC"]>
<SETG POSQ %<RSUBR-ENTRY '[SSNAM POSQ #DECL ("VALUE" <OR FIX FALSE> ANY
STRUCTURED <OR 'T FALSE>)] 1070>>
<ENDPACKAGE>

174
bin/librm1/cca.fbin Normal file
View File

@@ -0,0 +1,174 @@
'<PCODE "CCA">
<PACKAGE "CCA">
<ENTRY CCA-ACTIVATE CCA-DEACTIVATE CCA-KILL CCA-READ CCA-PRINT CCA-COMMAND
CCA-ERR-SYNC CCA-ACTIVATE-SCRIPT CCA-DEACTIVATE-SCRIPT CCA-ALLOW-SCRIPT?
CCA-CHAN CCA-SCRIPT-CHAN NETCLOSE>
<ENTRY CCA-OPEN CCA-CLOSE CCA-LOGIN CCA-CONNECT CCA-ACTIVATE-DATA-CHAN
CCA-DEACTIVATE-DATA-CHAN CCA-DATA-CHAN CCA-DATA-MODE CCA-ASSIGN CCA-GET CCA-SEND
CCA-LIST>
<USE "CPYFIL">
<GDECL (CCA-CHAN) <OR <LIST CHANNEL CHANNEL> FALSE> (CCA-DATA-CHAN) <OR CHANNEL
FALSE> (CCA-DATA-MODE) <OR <LIST STRING FIX> FALSE> (CCA-SCRIPT-CHAN) <OR
CHANNEL FALSE> (CCA-ALLOW-SCRIPT?) ANY (CCA-BUFFER CCA-STR RDYMSG SYNMSG) STRING
(CCA-UVCT) UVECTOR>
<SETG CCA-CHAN <>>
<SETG CCA-SCRIPT-CHAN <>>
<SETG CCA-ALLOW-SCRIPT? T>
<SETG CCA-DATA-CHAN <>>
<SETG CCA-DATA-MODE <>>
<SETG CCA-BUFFER <ISTRING 200 !" >>
<SETG CCA-UVCT <IUVECTOR 200 0>>
<SETG CCA-STR <ISTRING 1000 !" >>
<SETG RDYMSG ".I210">
<SETG SYNMSG ".I220">
<SETG CCA-ACTIVATE %<RSUBR!- '[ %<PCODE!- "CCA" 0> CCA-ACTIVATE #DECL ("VALUE"
<OR FALSE STRING> "OPTIONAL" FIX FIX FIX) COPY-FILE CCA-PRINT CCA-ACTIVATE
CCA-READ ICP CCA-ACT (ACTIVATION) %<RGLOC CCA-CHAN T> %<RGLOC RDYMSG T> CHANNEL
![5 6!] "CHAR" ".J900" T %<RGLOC CCA-BUFFER T> %<RGLOC CCA-SCRIPT-CHAN T>
OUTCHAN ![5 8 9!] "
" %<RGLOC CCA-ALLOW-SCRIPT? T> "
**RCVD** " %<RGLOC SYNMSG T> ![-1 0 1 3!] "NET CONNECTION DEAD" "NO CHANNEL" ![
-1 0 3!] "
**SENT** " "NOT CONNECTED TO DATACOMPUTER" ";I229" "PRINTB" "" "OPEN " ";
" "CLOSE " "LOGIN " %<RGLOC CCA-DATA-CHAN T> "CONNECTION ALREADY OPEN" "READ"
"READB" "PRINT" "ILLEGAL MODE" "CONNECT " %<RGLOC CCA-DATA-MODE T>
"CONNECTION ALREADY SET-UP" FIX "PORT NOT CONNECTED" "NET"
"COULDNT OPEN DATA CHANNEL" CCA-DATA-ACT %<RGLOC DATA-NETINT T>
"TIME-OUT, RFC NOT RECEIVED" "FUNNY STATE ENCOUNTERED"
"COULDNT ACCEPT CONNECTION" CCA-DATA-CHAN " = " ".I230" ".I231" ".I240" ".I241"
";I249" ";I239" "BAD 'FROM' CHANNEL ARGUMENT" STRING
"COULDN'T OPEN OUTPUT CHANNEL" %<RGLOC CCA-STR T> %<RGLOC CCA-UVCT T>
"BAD 'TO' CHANNEL ARGUMENT" "COULDN'T OPEN INPUT CHANNEL" "LIST " CHICP (<OR
CHANNEL FALSE>) DONE %<RGLOC ICP-NETINT T> "ICP timed out" ![0!] %<RGLOC
FDUPLEX-NETINT T> ACTIVATION "INTERRUPT, NET CONNECTION CRASHED"
"INTERRUPT, AUX DATA CHAN CRASHED" INTERRUPT]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,CCA-ACTIVATE PGLUE ![716177407 -1 -1 -1 -16384
0!]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,CCA-ACTIVATE GLUE ![17268020484 22566519747
2883655 536870976 18305058564 18723391424 74464276 8321499385 4379230269
21475099696 285544772 30139224071 255853572 201396497 -16170090212 30082335840
1142179089 -16882073596 201670656 4383113472 -4293914620 17522823408 17
7516258305 1 -12788411372 1024 17180131328 1392640 0 0 69889 17180918016
268435456 486916180 5392831508 0 0 6099031 -17179803648 1052672 18328121536
1193018416 4697691204 18612720 4160 16128263235 -16910123008 5654003712
352567296 67383577 7520780357 4582019536 33290462320 9794748432 4496580612
21761212701 2080654916 16658841745 -3221225151 1364525057 3226534012 85225472
192 67109891 4570743232 12884901968 17519987728 -17106467759 4592835847
-17104632770 19061308672 1052864 18790764817 7534872512 19264325378 19277021248
18003598340 25774330129 -16880993276 33351299108 33554432016 4576112671
-17106467759 4592835847 -17108319985 4764991488 284181444 30065819648 8321572609
4179364112 201344976 66820 5441061132 8451540753 -16892820463 -17175602052
1191254017 5440303175 17700035588 805371935 5100403712 4631564739 -17174642671
-17174888443 807142336 1178625 5435884575 33286287372 15753152 290844
19060752400 16 3339781889 -17129476095 17453827397 21474853633 6443582532
30139490049 4547645888 -519867 -17108319985 4364171536 17179869505 1360461828
17986322449 18325374068 8322630671 5384535040 18539069699 -16104784128
8321568768 -3825205008 269485136 30670908 30064787456 67371284 17184064768 17473
17907725 336609524 0 5385818480 71500056 289686640 19128058132 17432842007
-17175343104 -4226871291 8522857472 18526258959 20906052 268450880 9663923200
-4294949868 4363075584 20545 18350870720 18790764817 7534872512 19260522055
612171776 4317003889 -4223385540 18186765572 1192165395 -4290510592 130023440
520093700 5369778180 8321499152 1204027392 62931068 17179870144 17263853312
18270126352 1048576 257 3339841988 30340546564 12900696064 17251175445
-15988406528 4815061276 4425187527 4765188295 806293504 269250580 7583302656
-16708669428 1010827521 1141904444 4815062016 70 172 263050 989 263234 525372
1166 263357 525499 263449 263528 525763 1679 263821 2033 526373 788513 1050655
264382 526524 264712 526854 264973 527115 527489 527548 527659 265579!]>>
<SETG CCA-DEACTIVATE %<RSUBR-ENTRY '[CCA-ACTIVATE CCA-DEACTIVATE #DECL ("VALUE"
<OR ATOM FALSE>)] 68>>
<SETG CCA-KILL %<RSUBR-ENTRY '[CCA-ACTIVATE CCA-KILL #DECL ("VALUE" <OR ATOM
FALSE>)] 170>>
<SETG CCA-READ %<RSUBR-ENTRY '[CCA-ACTIVATE CCA-READ #DECL ("VALUE" <OR FALSE
STRING> "TUPLE" <TUPLE [REST STRING]>)] 228>>
" * CCA-PRINT *"
<SETG CCA-PRINT %<RSUBR-ENTRY '[CCA-ACTIVATE CCA-PRINT #DECL ("VALUE" ANY
"TUPLE" TUPLE)] 727>>
<SETG CCA-COMMAND %<RSUBR-ENTRY '[CCA-ACTIVATE CCA-COMMAND #DECL ("VALUE" <OR
ATOM FALSE> STRING)] 902>>
<SETG CCA-ERR-SYNC %<RSUBR-ENTRY '[CCA-ACTIVATE CCA-ERR-SYNC #DECL ("VALUE" <OR
ATOM FALSE>)] 987>>
<SETG CCA-ACTIVATE-SCRIPT %<RSUBR-ENTRY '[CCA-ACTIVATE CCA-ACTIVATE-SCRIPT #DECL
("VALUE" <OR CHANNEL FALSE> <OR STRING CHANNEL> "OPTIONAL" CHANNEL)] 1072>>
<SETG CCA-DEACTIVATE-SCRIPT %<RSUBR-ENTRY '[CCA-ACTIVATE CCA-DEACTIVATE-SCRIPT #
DECL ("VALUE" FALSE)] 1164>>
" ** 'SUGARED' FUNCTIONS, PARALLELLING DATALANGUAGE COMMANDS **"
<SETG CCA-OPEN %<RSUBR-ENTRY '[CCA-ACTIVATE CCA-OPEN #DECL ("VALUE" <OR ATOM
FALSE> STRING "OPTIONAL" STRING)] 1199>>
<SETG CCA-CLOSE %<RSUBR-ENTRY '[CCA-ACTIVATE CCA-CLOSE #DECL ("VALUE" <OR ATOM
FALSE> STRING)] 1301>>
<SETG CCA-LOGIN %<RSUBR-ENTRY '[CCA-ACTIVATE CCA-LOGIN #DECL ("VALUE" <OR ATOM
FALSE> STRING)] 1380>>
<SETG CCA-CONNECT %<RSUBR-ENTRY '[CCA-ACTIVATE CCA-CONNECT #DECL ("VALUE" <OR
ATOM FALSE> STRING STRING)] 1469>>
<SETG CCA-ACTIVATE-DATA-CHAN %<RSUBR-ENTRY '[CCA-ACTIVATE CCA-ACTIVATE-DATA-CHAN
#DECL ("VALUE" <OR CHANNEL FALSE> "OPTIONAL" FIX)] 1664>>
<SETG CCA-DEACTIVATE-DATA-CHAN %<RSUBR-ENTRY '[CCA-ACTIVATE
CCA-DEACTIVATE-DATA-CHAN #DECL ("VALUE" <OR ATOM FALSE>)] 2031>>
<SETG CCA-ASSIGN %<RSUBR-ENTRY '[CCA-ACTIVATE CCA-ASSIGN #DECL ("VALUE" <OR
CHANNEL FALSE STRING> STRING STRING "OPTIONAL" ANY FIX)] 2066>>
<SETG CCA-GET %<RSUBR-ENTRY '[CCA-ACTIVATE CCA-GET #DECL ("VALUE" <OR ATOM
CHANNEL FALSE> <OR CHANNEL STRING> "OPTIONAL" <OR CHANNEL FALSE>)] 2224>>
<SETG CCA-SEND %<RSUBR-ENTRY '[CCA-ACTIVATE CCA-SEND #DECL ("VALUE" <OR ATOM
CHANNEL FALSE> <OR CHANNEL STRING> "OPTIONAL" <OR CHANNEL FALSE>)] 2554>>
<SETG CCA-LIST %<RSUBR-ENTRY '[CCA-ACTIVATE CCA-LIST #DECL ("VALUE" <OR ATOM
FALSE> STRING "OPTIONAL" STRING)] 2815>>
" * ICP *
Initiates Initial Connection Protocol with a foreign host"
<SETG ICP %<RSUBR-ENTRY '[CCA-ACTIVATE ICP #DECL ("VALUE" <OR FALSE <LIST
CHANNEL CHANNEL>> FIX FIX "OPTIONAL" FIX)] 2917>>
" * NETWORK INTERRUPT HANDLERS *"
<SETG ICP-NETINT %<RSUBR-ENTRY '[CCA-ACTIVATE ICP-NETINT #DECL ("VALUE" ANY <OR
UVECTOR FALSE> CHANNEL)] 3195>>
<SETG FDUPLEX-NETINT %<RSUBR-ENTRY '[CCA-ACTIVATE FDUPLEX-NETINT #DECL ("VALUE"
ANY ANY <OR CHANNEL FALSE>)] 3254>>
<SETG DATA-NETINT %<RSUBR-ENTRY '[CCA-ACTIVATE DATA-NETINT #DECL ("VALUE" ANY
ANY <OR CHANNEL FALSE>)] 3365>>
<SETG NETCLOSE %<RSUBR-ENTRY '[CCA-ACTIVATE NETCLOSE #DECL ("VALUE" <OR CHANNEL
FALSE> ANY)] 3431>>
<ENDPACKAGE>

BIN
bin/librm1/ccafil.nbin Normal file
View File

Binary file not shown.

BIN
bin/librm1/cdm.nbin Normal file
View File

Binary file not shown.

261
bin/librm1/celest.fbin Normal file
View File

@@ -0,0 +1,261 @@
'<PCODE "CELEST">
<PACKAGE "CELEST">
<ENTRY PHASE NEXT-PHASE NEXT-SEASON SUNRISE NOON SUNSET MOONRISE MOONSET>
<USE "TIMFCN">
<SETG PHASE %<RSUBR!- '[ %<PCODE!- "CELEST" 0> PHASE #DECL ("VALUE" FLOAT
"OPTIONAL" LIST) DATE-DOW TZDIFF DAYS BEFORE? DTSECS DTNORM DTADD DTNOW %<RGLOC
PI T> %<RGLOC LATITUDE T> %<RGLOC LONGITUDE T> %<RGLOC GMT-OFFSET T> T ((1) ())
((-1) ()) %<RGLOC SOLAR-TERMS-IN-LONGITUDE T> "GMT" ![279.69667 0.98564732
0.22669999E-12!] ![281.22082 0.47068389E-4 0.33899999E-12 0.70000000E-19!] ![
270.43415 13.176396 -0.84999997E-12 0.39000000E-19!] ![350.73748 12.190749
-0.10759999E-11 0.39000000E-19!] ![334.32955 0.11140406 -0.77390000E-11
-0.25999999E-18!] ![259.18326 -0.52953922E-1 0.15570000E-11 0.5E-19!] ((75 1 1)
(-4) "EDT") %<RGLOC ET-UT T> ((75 1 1) ()) + - TYPE-MISMATCH!-ERRORS INVERT
ERROR-IN-ANGLE!-ERRORS ANGLE-TO-HOURS %<RGLOC REFR-INDEX T>]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,PHASE PGLUE ![715833343 -1 0!]>>
<SETG NEXT-PHASE %<RSUBR-ENTRY '[PHASE NEXT-PHASE #DECL ("VALUE" <VECTOR FIX
LIST> "OPTIONAL" LIST FLOAT FIX)] 46>>
<SETG NEXT-SEASON %<RSUBR-ENTRY '[PHASE NEXT-SEASON #DECL ("VALUE" <VECTOR FIX
LIST> "OPTIONAL" LIST FLOAT FIX)] 197>>
<SETG SUNRISE %<RSUBR-ENTRY '[PHASE SUNRISE #DECL ("VALUE" LIST "OPTIONAL" LIST
FLOAT)] 348>>
<SETG SUNSET %<RSUBR-ENTRY '[PHASE SUNSET #DECL ("VALUE" LIST "OPTIONAL" LIST
FLOAT)] 399>>
<SETG SUNRISE/SET %<RSUBR-ENTRY '[PHASE SUNRISE/SET #DECL ("VALUE" LIST LIST
FLOAT FIX)] 450>>
<SETG NOON %<RSUBR-ENTRY '[PHASE NOON #DECL ("VALUE" LIST "OPTIONAL" LIST FLOAT)
] 656>>
<SETG SUN-ELEV %<RSUBR-ENTRY '[PHASE SUN-ELEV #DECL ("VALUE" LIST "OPTIONAL"
LIST)] 836>>
<SETG SUN-AZIM %<RSUBR-ENTRY '[PHASE SUN-AZIM #DECL ("VALUE" LIST "OPTIONAL"
LIST)] 891>>
<SETG MOONRISE %<RSUBR-ENTRY '[PHASE MOONRISE #DECL ("VALUE" <OR FALSE LIST>
"OPTIONAL" LIST FLOAT)] 948>>
<SETG MOONSET %<RSUBR-ENTRY '[PHASE MOONSET #DECL ("VALUE" <OR FALSE LIST>
"OPTIONAL" LIST FLOAT)] 998>>
<SETG MOONRISE/SET %<RSUBR-ENTRY '[PHASE MOONRISE/SET #DECL ("VALUE" <OR FALSE
LIST> LIST FLOAT FIX)] 1048>>
<SETG MOON-ELEV %<RSUBR-ENTRY '[PHASE MOON-ELEV #DECL ("VALUE" <LIST ATOM [3 FIX
]> "OPTIONAL" LIST)] 1272>>
<SETG MOON %<RSUBR-ENTRY '[PHASE MOON #DECL ("VALUE" <LIST ATOM [3 FIX]> LIST
LIST LIST)] 1315>>
<SETG l %<RSUBR-ENTRY '[PHASE l #DECL ("VALUE" FLOAT "OPTIONAL" LIST)] 1396>>
<SETG lp %<RSUBR-ENTRY '[PHASE lp #DECL ("VALUE" FLOAT "OPTIONAL" LIST)] 1439>>
<SETG F %<RSUBR-ENTRY '[PHASE F #DECL ("VALUE" FLOAT "OPTIONAL" LIST)] 1482>>
<SETG D %<RSUBR-ENTRY '[PHASE D #DECL ("VALUE" FLOAT "OPTIONAL" LIST)] 1525>>
<SETG MOON-TRUE-POS %<RSUBR-ENTRY '[PHASE MOON-TRUE-POS #DECL ("VALUE" FLOAT
"OPTIONAL" LIST)] 1557>>
<SETG SOLAR-TERMS-IN-LONGITUDE '![[22639.5 ![1 0 0 0!]] [-4586.4650 ![1 0 0 -2!]
] [2369.9118 ![0 0 0 2!]] [769.01599 ![2 0 0 0!]] [-668.14600 ![0 1 0 0!]] [
-411.60800 ![0 0 2 0!]] [-211.65600 ![2 0 0 -2!]] [-205.96199 ![1 1 0 -2!]] [
191.95298 ![1 0 0 2!]] [-165.14500 ![0 1 0 -2!]] [147.68700 ![1 -1 0 0!]] [
-125.15400 ![0 0 0 1!]] [-109.67300 ![1 1 0 0!]] [-55.172998 ![0 0 2 -2!]] [
-45.098999 ![1 0 2 0!]] [39.527998 ![1 0 -2 0!]] [-38.427999 ![1 0 0 -4!]] [
36.124000 ![3 0 0 0!]] [-30.773000 ![2 0 0 -4!]] [28.474998 ![1 -1 0 -2!]] [
-24.420000 ![0 1 0 2!]] [18.608999 ![1 0 0 -1!]] [18.023000 ![0 1 0 1!]] [
14.577000 ![1 -1 0 2!]] [14.386999 ![2 0 0 2!]] [13.901998 ![0 0 0 4!]] [
-13.192999 ![3 0 0 -2!]]!]>
<GDECL (SOLAR-TERMS-IN-LONGITUDE) <UVECTOR [REST <VECTOR FLOAT <UVECTOR [REST
FIX]>>]>>
<SETG d %<RSUBR-ENTRY '[PHASE d #DECL ("VALUE" FLOAT LIST)] 1677>>
<SETG JD %<RSUBR-ENTRY '[PHASE JD #DECL ("VALUE" FLOAT LIST)] 1758>>
<SETG TL %<RSUBR-ENTRY '[PHASE TL #DECL ("VALUE" FLOAT FLOAT <UVECTOR [REST
FLOAT]>)] 1774>>
<SETG SUN-MEAN-POS %<RSUBR-ENTRY '[PHASE SUN-MEAN-POS #DECL ("VALUE" FLOAT
"OPTIONAL" LIST)] 1835>>
<SETG SUN-MEAN-PGEE %<RSUBR-ENTRY '[PHASE SUN-MEAN-PGEE #DECL ("VALUE" FLOAT
"OPTIONAL" LIST)] 1872>>
<SETG MOON-MEAN-POS %<RSUBR-ENTRY '[PHASE MOON-MEAN-POS #DECL ("VALUE" FLOAT
"OPTIONAL" LIST)] 1909>>
<SETG MOON-MEAN-ELONG %<RSUBR-ENTRY '[PHASE MOON-MEAN-ELONG #DECL ("VALUE" FLOAT
"OPTIONAL" LIST)] 1946>>
<SETG MOON-MEAN-PGEE %<RSUBR-ENTRY '[PHASE MOON-MEAN-PGEE #DECL ("VALUE" FLOAT
"OPTIONAL" LIST)] 1983>>
<SETG MOON-MEAN-NODE %<RSUBR-ENTRY '[PHASE MOON-MEAN-NODE #DECL ("VALUE" FLOAT
"OPTIONAL" LIST)] 2020>>
<SETG DT-TO-UT %<RSUBR-ENTRY '[PHASE DT-TO-UT #DECL ("VALUE" FLOAT "OPTIONAL"
LIST)] 2057>>
<SETG SUN-TRUE-POS %<RSUBR-ENTRY '[PHASE SUN-TRUE-POS #DECL ("VALUE" FLOAT
"OPTIONAL" LIST)] 2100>>
<GDECL (PI ET-UT REFR-INDEX) FLOAT (LONGITUDE LATITUDE) LIST (GMT-OFFSET) FIX>
<SETG PI <* 4.0 <ATAN 1.0>>>
<SETG SUN-POSITION %<RSUBR-ENTRY '[PHASE SUN-POSITION #DECL ("VALUE" <LIST [REST
FLOAT]> FLOAT)] 2141>>
<SETG SKY-ANGLES %<RSUBR-ENTRY '[PHASE SKY-ANGLES #DECL ("VALUE" <LIST [REST
FLOAT]> FLOAT FLOAT FLOAT FLOAT)] 2320>>
<SETG SUN %<RSUBR-ENTRY '[PHASE SUN #DECL ("VALUE" <LIST [REST LIST]> LIST LIST
LIST LIST)] 2426>>
<SETG JULIAN %<RSUBR-ENTRY '[PHASE JULIAN #DECL ("VALUE" FLOAT LIST)] 2514>>
<SETG DATED %<RSUBR-ENTRY '[PHASE DATED #DECL ("VALUE" <LIST FIX FIX FIX> FLOAT)
] 2552>>
<SETG INVERT %<RSUBR-ENTRY '[PHASE INVERT #DECL ("VALUE" LIST LIST)] 2589>>
<SETG HHMMSS %<RSUBR-ENTRY '[PHASE HHMMSS #DECL ("VALUE" FLOAT <LIST [REST FIX]>
)] 2645>>
<SETG TIMED %<RSUBR-ENTRY '[PHASE TIMED #DECL ("VALUE" LIST FLOAT)] 2690>>
<SETG DDMMSS %<RSUBR-ENTRY '[PHASE DDMMSS #DECL ("VALUE" FLOAT <LIST ATOM [3 FIX
]>)] 2746>>
<SETG ANGLED %<RSUBR-ENTRY '[PHASE ANGLED #DECL ("VALUE" <LIST ATOM [3 FIX]>
FLOAT)] 2804>>
<SETG HOURS-TO-ANGLE %<RSUBR-ENTRY '[PHASE HOURS-TO-ANGLE #DECL ("VALUE" <LIST
ATOM [3 FIX]> <LIST [REST FIX]>)] 2870>>
<SETG ANGLE-TO-HOURS %<RSUBR-ENTRY '[PHASE ANGLE-TO-HOURS #DECL ("VALUE" ANY <
LIST ATOM [3 FIX]>)] 2888>>
<SETG GHA-ARIES %<RSUBR-ENTRY '[PHASE GHA-ARIES #DECL ("VALUE" FLOAT FLOAT)]
2925>>
<SETG LONGITUD %<RSUBR-ENTRY '[PHASE LONGITUD #DECL ("VALUE" FLOAT FLOAT)] 2950>
>
<SETG PERIGEE %<RSUBR-ENTRY '[PHASE PERIGEE #DECL ("VALUE" FLOAT FLOAT)] 2966>>
<SETG OBLIQUITY %<RSUBR-ENTRY '[PHASE OBLIQUITY #DECL ("VALUE" FLOAT FLOAT)]
2982>>
<SETG MOON-NODE %<RSUBR-ENTRY '[PHASE MOON-NODE #DECL ("VALUE" FLOAT FLOAT)]
2999>>
<SETG ECCENTRICITY %<RSUBR-ENTRY '[PHASE ECCENTRICITY #DECL ("VALUE" FLOAT FLOAT
)] 3016>>
<SETG MEANANOM %<RSUBR-ENTRY '[PHASE MEANANOM #DECL ("VALUE" FLOAT FLOAT)] 3033>
>
<SETG PERTURB-L %<RSUBR-ENTRY '[PHASE PERTURB-L #DECL ("VALUE" FLOAT FLOAT)]
3049>>
<SETG PERTURB-R %<RSUBR-ENTRY '[PHASE PERTURB-R #DECL ("VALUE" FLOAT FLOAT)]
3269>>
<SETG TRUEANOM %<RSUBR-ENTRY '[PHASE TRUEANOM #DECL ("VALUE" FLOAT FLOAT FLOAT)]
3356>>
<SETG ECCENANOM %<RSUBR-ENTRY '[PHASE ECCENANOM #DECL ("VALUE" FLOAT FLOAT FLOAT
FLOAT)] 3402>>
<SETG DECLINATION %<RSUBR-ENTRY '[PHASE DECLINATION #DECL ("VALUE" FLOAT FLOAT
FLOAT)] 3434>>
<SETG RIGHT-ASCENSION %<RSUBR-ENTRY '[PHASE RIGHT-ASCENSION #DECL ("VALUE" FLOAT
FLOAT FLOAT)] 3462>>
<SETG RADIUS-VECTOR-E %<RSUBR-ENTRY '[PHASE RADIUS-VECTOR-E #DECL ("VALUE" FLOAT
FLOAT FLOAT FLOAT)] 3495>>
<SETG RADIUS-VECTOR-T %<RSUBR-ENTRY '[PHASE RADIUS-VECTOR-T #DECL ("VALUE" FLOAT
FLOAT FLOAT FLOAT)] 3529>>
<SETG REFRACTION-NA %<RSUBR-ENTRY '[PHASE REFRACTION-NA #DECL ("VALUE" FLOAT
FLOAT)] 3567>>
<SETG ELEV-SPACE %<RSUBR-ENTRY '[PHASE ELEV-SPACE #DECL ("VALUE" FLOAT FLOAT)]
3601>>
<SETG ELEV-VIEW %<RSUBR-ENTRY '[PHASE ELEV-VIEW #DECL ("VALUE" FLOAT FLOAT)]
3621>>
<SETG ELEVATION-AN %<RSUBR-ENTRY '[PHASE ELEVATION-AN #DECL ("VALUE" FLOAT FLOAT
)] 3642>>
<SETG SQUARE %<RSUBR-ENTRY '[PHASE SQUARE #DECL ("VALUE" FLOAT FLOAT)] 3663>>
<SETG RANGE %<RSUBR-ENTRY '[PHASE RANGE #DECL ("VALUE" FLOAT FLOAT)] 3676>>
<SETG RAD-TO-DEG %<RSUBR-ENTRY '[PHASE RAD-TO-DEG #DECL ("VALUE" FLOAT FLOAT)]
3703>>
<SETG DEG-TO-RAD %<RSUBR-ENTRY '[PHASE DEG-TO-RAD #DECL ("VALUE" FLOAT FLOAT)]
3719>>
<SETG SIND %<RSUBR-ENTRY '[PHASE SIND #DECL ("VALUE" FLOAT FLOAT)] 3735>>
<SETG COSD %<RSUBR-ENTRY '[PHASE COSD #DECL ("VALUE" FLOAT FLOAT)] 3753>>
<SETG ATANE %<RSUBR-ENTRY '[PHASE ATANE #DECL ("VALUE" FLOAT FLOAT FLOAT)] 3771>
>
<SETG ATAND %<RSUBR-ENTRY '[PHASE ATAND #DECL ("VALUE" FLOAT FLOAT FLOAT)] 3804>
>
<SETG TAND %<RSUBR-ENTRY '[PHASE TAND #DECL ("VALUE" FLOAT FLOAT)] 3836>>
<SETG ASIND %<RSUBR-ENTRY '[PHASE ASIND #DECL ("VALUE" FLOAT FLOAT)] 3860>>
<SETG ACOSD %<RSUBR-ENTRY '[PHASE ACOSD #DECL ("VALUE" FLOAT FLOAT)] 3882>>
<SETG FRACTION %<RSUBR-ENTRY '[PHASE FRACTION #DECL ("VALUE" FLOAT FLOAT)] 3904>
>
<SETG UPDATE %<RSUBR-ENTRY '[PHASE UPDATE #DECL ("VALUE" <LIST [3 FIX]> <LIST [3
FIX]> FIX)] 3926>>
<SETG SUN-NOW-HERE %<RSUBR-ENTRY '[PHASE SUN-NOW-HERE #DECL ("VALUE" <LIST [REST
LIST]>)] 3953>>
<SETG LAST-SUNDAY %<RSUBR-ENTRY '[PHASE LAST-SUNDAY #DECL ("VALUE" FIX <LIST FIX
FIX> FIX)] 3983>>
<SETG DAY-SAVE-CROCK %<RSUBR-ENTRY '[PHASE DAY-SAVE-CROCK #DECL ("VALUE" FIX <
LIST FIX FIX FIX>)] 4021>>
<SETG ET-UT 0.52799998E-3>
<SETG REFR-INDEX 1.0002824>
<SETG LONGITUDE '(- 71 5 20)>
<SETG LATITUDE '(+ 42 21 50)>
<SETG GMT-OFFSET <+ <DAY-SAVE-CROCK <1 <DTNOW>>> 5>>
<ENDPACKAGE>

19
bin/librm1/charap.fbin Normal file
View File

@@ -0,0 +1,19 @@
'<PCODE "CHARAP">
<PACKAGE "CHARAP">
<ENTRY CHARAPPEND CR FF>
<USE-DEFER "FP">
<SETG CR <SET CR "
">>
<SETG FF <SET FF <ASCII 12>>>
<MANIFEST CR FF>
<SETG CHARAPPEND %<RSUBR!- '[ %<PCODE!- "CHARAP" 0> CHARAPPEND #DECL ("VALUE" <
OR CHANNEL FALSE> <OR STRING CHANNEL> FIX ANY "TUPLE" TUPLE) FPRINT "NUL" "NUL:"
"TTY:" OUTCHAN #FALSE () ["PRINT" "PRINTO"] "READ" "PRINTO" "PRINT" CR FF]>>
<ENDPACKAGE>

66
bin/librm1/chkadr.fbin Normal file
View File

@@ -0,0 +1,66 @@
'<PCODE "1CHKADR">
<PACKAGE "CHKADR">
<ENTRY CHECK-ADDRESSEES>
<USE "HOSTS" "LSRTNS" "NSTR" "VCTSRC">
<SETG HOSTNUMBER 3073>
<SETG CHECK-ADDRESSEES %<RSUBR!- '[ %<PCODE!- "1CHKADR" 0> CHECK-ADDRESSEES #
DECL ("VALUE" <OR ATOM FALSE> LIST "OPTIONAL" <OR FALSE LIST>) LAST-NAME
LSR-EXTRACT LSR-ENTRY HOST VCTSRC UPPERCASE ("COMEXP") OUTCHAN " -- " ", " T
"Okay." "Illegal addressee." RECURSION-DEPTH-EXCESSIVE S-EXP %<RGLOC HOSTNUMBER
T> " -- Data base is not in proper format." " -- Data base not found: " " "
%<RGLOC RCVR-STRING T> "COMKEY" #FALSE ("Empty Addressee Name") #FALSE (
"Empty Addressee in Forwarding Address") #FALSE ("Invalid Host Address") %<RGLOC
BADHOST T> ".FILE." "(DIR)" "DSK" %<RGLOC ALLOW-TOURISTS T> #FALSE (
"Invalid Local Addressee") "UNKNOWN" #FALSE ("Addressee was UNKNOWN") "BUG-" %<
RGLOC NOBOX T> "Ambiguous Last Name" "Ambiguous Local Name" ":; []{}" OBLIST
"READB" ">" "COMDAT"]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,CHECK-ADDRESSEES PGLUE ![715915263 -1 -1048576
!]>>
\
"UC? -- given string, returns new string of all upper-case, only
if original had lower case somewhere"
\
"utilities for use with user specifications, addressees, etc."
<SETG ALLOW-TOURISTS <>>
<GDECL (ALLOW-TOURISTS) <OR ATOM FALSE>>
"EXTRACT-HOST -- given string usr@host, returns fix, host number, or
string, if host unknown in tables. for simple usr type key, returns
,HOSTNUMBER"
"EXTRACT-RCVR -- given usr key, returns user string (i.e. all but @host)"
<SETG RCVR-STRING <REST <ISTRING 30 !\ > 30>>
<GDECL (RCVR-STRING) STRING>
\
<SETG BADHOST #FALSE ("Invalid Host in Forwarding Address")>
<SETG NOBOX #FALSE ("No Mailbox for that name")>
<GDECL (BADHOST NOBOX) <FALSE STRING>>
\
"UNIQUIFY -- given list of strings and atoms, returns same
list with duplicates removed."
"FILE? -- given string, returns string of file spec if a file addressee"
\
<ENDPACKAGE>

BIN
bin/librm1/clock.nbin Normal file
View File

Binary file not shown.

BIN
bin/librm1/coder.nbin Normal file
View File

Binary file not shown.

BIN
bin/librm1/column.nbin Normal file
View File

Binary file not shown.

30
bin/librm1/comand.fbin Normal file
View File

@@ -0,0 +1,30 @@
'<PCODE "1COMAND">
<PACKAGE "COMMAND">
<USE "CALSYM" "CALRDR">
<ENTRY CALICO-COMMAND CONFIRM>
<SETG CONFIRM %<RSUBR!- '[ %<PCODE!- "1COMAND" 0> CONFIRM #DECL ("VALUE" <OR
ATOM FALSE>) READARGS READER %<RGLOC CONF T> "Confirm" [
"
Please confirm the command by typing either T, True, Y, or Yes" ""] "SYM" T #
FALSE () [] EVALSW (FIX) SEGSW SYMSW HACKMULTSW READER-SILENCE OUTCHAN
"DON'T-EVAL" "GIVE-SYMBOLS" "HACK-MULTS" "INPUT" "SEGMENT-INPUT" "SEGMENT-EACH"
%<RGLOC VECTOR T> %<RGLOC READER-NULL-LINE T> () "MULT" %<TYPE-C SYMBOL VECTOR>
A "PRINT-RESULT"]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,CONFIRM PGLUE ![738197503 -256 0!]>>
<SETG CONF <MAKEBST "CONFIRM" ["F" #FALSE () "False" #FALSE () "N" #FALSE ()
"No" #FALSE () "T" T "True" T "Y" T "Yes" T]>>
<SETG CALICO-COMMAND %<RSUBR-ENTRY '[CONFIRM CALICO-COMMAND #DECL ("VALUE" ANY
APPLICABLE VECTOR "OPTIONAL" VECTOR "TUPLE" <TUPLE [REST STRING]>)] 42>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,CONFIRM GLUE ![17250140156 541094391
-12879330041 -16105841540 30586731633 -4294901244 4413571075 -16102178811
63180800 17183817984 4043571260 17465085980 1075119109 459073 18190962448
16797968 16236216576 276037632 22037568 1048669 4210753 1095172417 17263821828
1106313476 4570759936 -16926357760 12897484800 65535 2!]>>
<ENDPACKAGE>

24
bin/librm1/commud.bin Normal file
View File

@@ -0,0 +1,24 @@
'<PCODE "COMMUD">
<PACKAGE "COMMUD">
<ENTRY COMMUD>
<SETG FILE "SYS;TS MUDCOM">
<SETG ERRS ["Self Comparison" "Bad JCL" "Syntax Error" "Open Fail" "BUG"
"No Differences" "No Similarities"]>
<SETG COMMUD %<RSUBR!- '[ %<PCODE!- "COMMUD" 0> COMMUD #DECL ("VALUE" <OR FALSE
LIST> STRING) OPENF JOB (FIX) "More than 1 COMMUD?" %<RGLOC FILE T> "INFERIOR"
%<RGLOC HANDY T> WAIT (ACTIVATION) %<RGLOC ERRS T> T "COMMUD" "PRINTB" "USR" %<
RGLOC SNM T> #FALSE ("MODE NOT AVAILABLE") "READB" CORBLK-FAILED!-ERRORS
LOAD-FAILED!-ERRORS]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,COMMUD PGLUE ![805306367 -268435456!]>>
<SETG HANDY %<RSUBR-ENTRY '[COMMUD HANDY #DECL ("VALUE" ANY FIX)] 258>>
<SETG OPENF %<RSUBR-ENTRY '[COMMUD OPENF #DECL ("VALUE" ANY "TUPLE" ANY)] 353>>
<ENDPACKAGE>

213
bin/librm1/complx.fbin Normal file
View File

@@ -0,0 +1,213 @@
'<PCODE "COMPLX">
<PACKAGE "COMPLX">
<ENTRY CPX RCPX PCPX UCPX RUCPX PUCPX CPXCOPY CSET POLAR RECTANGULAR C+ C- C* C/
C** REAL RPRT IMAG IMRT MAGN MGXY PHASE PHXY UVFIX UVFLOAT VFIX VFLOAT FIXIFY XY
RT FX FL **>
"COMPLEX NUMBERS, IN POLAR OR RECTANGULAR FORMAT
EL1 -- ATOM, POLAR OR RECTANGULAR
EL2 -- FIX/FLOAT, REAL PART IF RECTANGULAR, MAGN, IF POLAR
EL3 -- FIX/FLOAT, IMAG PART IF RECTANGULAR, PHASE, IF POLAR
"
<NEWTYPE CPX VECTOR '<<PRIMTYPE VECTOR> ATOM [2 <OR FIX FLOAT>]>>
<NEWTYPE UCPX VECTOR '<<PRIMTYPE VECTOR> ATOM [2 <UVECTOR <OR FIX FLOAT>>]>>
<SETG RCPX #MACRO ( %<RSUBR!- '[ %<PCODE!- "COMPLX" 0> RCPX #DECL ("VALUE" FORM
"QUOTE" ANY "QUOTE" ANY) CHTYPE VECTOR RECTANGULAR CPX]>)>
<SETG PCPX #MACRO ( %<RSUBR!- '[ %<PCODE!- "COMPLX" 35> PCPX #DECL ("VALUE" FORM
"QUOTE" ANY "QUOTE" ANY) CHTYPE VECTOR POLAR CPX]>)>
"ARRAY OF COMPLEX NUMBERS, COMPACTED
EL1 -- ATOM, POLAR OR RECTANGULAR
EL2 -- REAL ARRAY IF RECTANGULAR, MAGN ARRAY IF POLAR
EL3 -- IMAG ARRAY IF RECTANGULAR, PHASE ARRAY IF POLAR
"
<SETG RUCPX %<RSUBR!- '[ %<PCODE!- "COMPLX" 70> RUCPX #DECL ("VALUE" UCPX
"TUPLE" TUPLE) RECTANGULAR INVALID-ARGS RUCPX %<TYPE-W UCPX VECTOR> POLAR PUCPX
%<TYPE-C CPX VECTOR> %<TYPE-W CPX VECTOR> %<TYPE-C UCPX VECTOR> #FALSE () UCPX
UNKNOWN-COMPLEX-TYPE FL UVECTOR UNKNOWN-TYPE-OF-COMPLEX REAL IMAG CPX FLOAT T C+
C- MAGN PHASE C* C/ ATTEMPT-TO-USE-IMAGINARY-POWER C** FIX XY RT]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,RUCPX PGLUE ![1070596095 -16 0!]>>
<SETG PUCPX %<RSUBR-ENTRY '[RUCPX PUCPX #DECL ("VALUE" UCPX "TUPLE" TUPLE)] 113>
>
\
<SETG CPXCOPY %<RSUBR-ENTRY '[RUCPX CPXCOPY #DECL ("VALUE" <OR CPX FALSE UCPX> <
OR CPX UCPX>)] 226>>
<SETG CSET #MACRO ( %<RSUBR!- '[ %<PCODE!- "COMPLX" 7602> CSET #DECL ("VALUE"
FORM "QUOTE" ANY "QUOTE" ANY) PROG () PUT]>)>
"C+ -- ADDS COMPLEX QUANTITIES. ALWAYS RETURNS FIRST QUANTITY
GIVEN, CHANGED TO CONTAIN THE SUM OF ALL ARGS
IF FIRST ARG IS UCPX, WILL PERFORM ELEMENT-BY-ELEMENT SUM WITH
OTHER UCPX'S IN ARG TUPLE, AND ADD VALUES OF ANY SINGLE COMPLEX
QUANTITIES TO EACH ELEMENT OF FIRST ARG.
"
<SETG C+ %<RSUBR-ENTRY '[RUCPX C+ #DECL ("VALUE" <OR CPX <<PRIMTYPE VECTOR> ATOM
<UVECTOR <OR FIX FLOAT>> <UVECTOR <OR FIX FLOAT>>>> "TUPLE" TUPLE)] 281>>
\
<SETG C- %<RSUBR-ENTRY '[RUCPX C- #DECL ("VALUE" <OR CPX <<PRIMTYPE VECTOR> ATOM
<UVECTOR <OR FIX FLOAT>> <UVECTOR <OR FIX FLOAT>>>> "TUPLE" TUPLE)] 1174>>
\
<SETG C* %<RSUBR-ENTRY '[RUCPX C* #DECL ("VALUE" <OR CPX <<PRIMTYPE VECTOR> ATOM
<UVECTOR <OR FIX FLOAT>> <UVECTOR <OR FIX FLOAT>>>> "TUPLE" TUPLE)] 2352>>
\
<SETG C/ %<RSUBR-ENTRY '[RUCPX C/ #DECL ("VALUE" <OR CPX <<PRIMTYPE VECTOR> ATOM
<UVECTOR <OR FIX FLOAT>> <UVECTOR <OR FIX FLOAT>>>> "TUPLE" TUPLE)] 3477>>
\
<SETG C** %<RSUBR-ENTRY '[RUCPX C** #DECL ("VALUE" <OR CPX <<PRIMTYPE VECTOR>
ATOM <UVECTOR <OR FIX FLOAT>> <UVECTOR <OR FIX FLOAT>>>> "TUPLE" TUPLE)] 4798>>
\
<SETG REAL #MACRO ( %<RSUBR!- '[ %<PCODE!- "COMPLX" 7682> REAL #DECL ("VALUE"
FORM "QUOTE" ANY) COND ==? RECTANGULAR POLAR TYPE? UVECTOR XY ELSE RPRT ERROR
UNKNOWN-TYPE-OF-COMPLEX REAL]>)>
<SETG IMAG #MACRO ( %<RSUBR!- '[ %<PCODE!- "COMPLX" 7840> IMAG #DECL ("VALUE"
FORM "QUOTE" ANY) COND ==? RECTANGULAR POLAR TYPE? UVECTOR XY ELSE IMRT ERROR
UNKNOWN-TYPE-OF-COMPLEX IMAG]>)>
<SETG MAGN #MACRO ( %<RSUBR!- '[ %<PCODE!- "COMPLX" 7998> MAGN #DECL ("VALUE"
FORM "QUOTE" ANY) COND ==? POLAR RECTANGULAR TYPE? UVECTOR RT ELSE MGXY ERROR
UNKNOWN-TYPE-OF-COMPLEX MAGN]>)>
<SETG PHASE #MACRO ( %<RSUBR!- '[ %<PCODE!- "COMPLX" 8156> PHASE #DECL ("VALUE"
FORM "QUOTE" ANY) COND ==? POLAR RECTANGULAR TYPE? UVECTOR RT ELSE PHXY ERROR
UNKNOWN-TYPE-OF-COMPLEX PHASE]>)>
<SETG MGXY #MACRO ( %<RSUBR!- '[ %<PCODE!- "COMPLX" 8314> MGXY #DECL ("VALUE"
FORM "QUOTE" ANY "QUOTE" ANY) COND TYPE? FIX SQRT + * FLOAT ELSE]>)>
<SETG PHXY #MACRO ( %<RSUBR!- '[ %<PCODE!- "COMPLX" 8443> PHXY #DECL ("VALUE"
FORM "QUOTE" ANY "QUOTE" ANY) + COND L? ELSE TYPE? FIX 0? * / ABS ATAN FLOAT =?
]>)>
<SETG RPRT #MACRO ( %<RSUBR!- '[ %<PCODE!- "COMPLX" 8666> RPRT #DECL ("VALUE"
FORM "QUOTE" ANY "QUOTE" ANY) COND TYPE? FIX * FLOAT COS ELSE]>)>
<SETG IMRT #MACRO ( %<RSUBR!- '[ %<PCODE!- "COMPLX" 8751> IMRT #DECL ("VALUE"
FORM "QUOTE" ANY "QUOTE" ANY) COND TYPE? FIX * FLOAT SIN ELSE]>)>
\
<SETG UVFIX #MACRO ( %<RSUBR!- '[ %<PCODE!- "COMPLX" 8836> UVFIX #DECL ("VALUE"
FORM "QUOTE" ANY) COND ==? UTYPE FIX ELSE MAPR #FALSE () FUNCTION E #DECL ((E) <
PRIMTYPE UVECTOR>) PUT LVAL + CHTYPE FLOAT CHUTYPE]>)>
<SETG UVFLOAT #MACRO ( %<RSUBR!- '[ %<PCODE!- "COMPLX" 8971> UVFLOAT #DECL (
"VALUE" FORM "QUOTE" ANY) COND ==? UTYPE FLOAT ELSE MAPR #FALSE () FUNCTION E #
DECL ((E) <PRIMTYPE UVECTOR>) PUT LVAL CHTYPE FIX CHUTYPE]>)>
<SETG VFLOAT #MACRO ( %<RSUBR!- '[ %<PCODE!- "COMPLX" 9097> VFLOAT #DECL (
"VALUE" FORM "QUOTE" ANY) MAPR #FALSE () FUNCTION E #DECL ((E) <PRIMTYPE VECTOR>
) PUT LVAL FLOAT]>)>
<SETG VFIX #MACRO ( %<RSUBR!- '[ %<PCODE!- "COMPLX" 9171> VFIX #DECL ("VALUE"
FORM "QUOTE" ANY) MAPR #FALSE () FUNCTION E #DECL ((E) <PRIMTYPE VECTOR>) PUT
LVAL FIX +]>)>
\
<SETG FIXIFY #MACRO ( %<RSUBR!- '[ %<PCODE!- "COMPLX" 9254> FIXIFY #DECL (
"VALUE" FORM "QUOTE" ANY) FIX +]>)>
\
<SETG XY %<RSUBR-ENTRY '[RUCPX XY #DECL ("VALUE" <OR CPX UCPX> ANY)] 6475>>
\
<SETG RT %<RSUBR-ENTRY '[RUCPX RT #DECL ("VALUE" <OR CPX FALSE UCPX> ANY)] 6979>
>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,RUCPX GLUE ![4378918912 1078444032 4580179972
18254660612 17467113472 34293678092 4276288 1053168 4472832 286262273 285493184
33489920 805307393 -12817572364 67108928 54526996 1075134465 4571127568
335544580 5594581 -268420096 21474849796 14033437760 272629760 1073741951
-4294967244 1128559940 17180934144 4194304 34342961173 20401095517 1574269965
8334082368 1048580 17269001503 3221307392 268436544 22850503620 5243969
-12666522553 22619881729 1024 33488909 1128559940 17180921856 4194305 -267452416
21480079360 357945567 1132208112 4026531841 17200845825 17197699089 1073759248
67388416 71319552 67112960 17891328 4564451328 4295229440 1073742081 4295229440
4312798549 22825385984 0 17105152 22817031233 -10875568048 4259841 22942154688
462848 1073749056 17826048 67109136 4456448 4456452 0 133955584 1851392
4294996224 71304192 268436544 17825792 17825808 0 535822396 17180196864
13963052149 18320724032 16384 134152192 54543172 31478513680 17179869248 524032
22331392 902847957 31152271552 335544336 4457808 3522215937 17179873280
1141199359 1010827344 1142754564 14033437760 269484032 1073742335 13648708
31478513680 4294967360 2093071 327760 5461 -12651052164 8573218816 1311040
5370020112 4312809472 18270389252 18253612096 17179870208 4294967569 69648 65540
16384 269549572 65808 5726621823 -17179869184 261 268783616 18322651076 83886145
1398645 34292633344 5368712449 3508359440 16640 17448304896 127 -4294967244
1128559936 22549693504 17424 1024 4563402753 127 -4294961844 220421 -9303749345
3221307392 268436544 22817873676 20971521 278613 8573404160 1342456272
-12814366892 18253611024 17196908545 7 -1073528563 4786754816 18271436800
285474816 16778304 16384 33489136 5244160 87389 3741595585 -267452416 20976641
17200845057 285474820 17448321092 17179869188 17448322064 262145 16777216
1095761988 17465147408 263233 256 1141112896 1052672 17179869200 263232
268435520 18259203412 8573157376 0 68420609 22548648199 25217204544 17039365
23049142016 13976277461 4563402756 4299227136 17179869185 -268382141 18376557888
4567859200 71368704 4194576 4096 8372284 17180196864 13963052149 18320719873
1074806784 1073741824 536608768 218172689 -11541348284 4563402753 4362076160
4295245824 4194304 536608768 22867345421 31163110864 14088863749 16384
4564795444 33336329472 4194321 357039119 4295049233 1949569233 7869628416
68158480 4194304 33488909 1128559936 22549693504 17424 1024 4563402753 2044
1006633280 5368709125 22938876944 -8849997764 1280 21480080640 18257822736
17842177 286261248 17842177 4362076176 4195328 66880 286278660 67108880
4567597056 1073811472 268435520 17180917760 67108880 4563419136 269549909
22901423104 0 4176 4300537860 18284510272 1342178320 22378327 -1072888780
19147276288 17039620 1048576 8372227 17462009168 5637423376 4356 256 1140850688
17179869695 252706836 13635793 7868600324 17465081856 4567597056 268452864
262144 33538079 -4223332144 4514239761 1040 1090519056 7 -268156096 18056959044
4160 4362076224 31 -1073724364 1128559940 17179869444 272629764 1 -67108864
3408948 19147276288 17039620 262144 131008 5570560 13110613877 24967937072
83886084 1114452 880553984 21474837504 285299839 -16927162348 285688641
3508359440 16640 17448305664 8176 218379335 22554083600 18253611012 17448304640
17180983296 16777216 34292875264 5370019840 1142178885 4294967296 1431782268
4528832448 16106127365 83906565 71319620 4295036992 269553664 69696 285474816
4294983684 261 17180987460 1074003968 4312809472 4194576 4296015872 17246982144
1041 268715077 4296015872 1140854784 67387477 22905224960 0 16 285688700
17185112068 4295054352 -8841587712 272629845 201618752 3143 22548578307
15028197187 17400007680 5368709376 71324928 -12364021740 65536 18259181837
880553984 21474837504 285299715 19263389776 262145 4317310976 1342504960 1168640
4194321 -11542724544 5724233712 8573157632 16 285688700 17185112068 4295054352
-8841587712 272629845 201618752 197952 4786749696 21474839607 -1072202483
880553984 21474837504 285299716 -12785267712 5368709376 71324932 4513286083
5242880 17179938837 17234903808 1342177344 17831247 327760 285 21474902016
5637436736 1075052549 22753558769 0 4294967295 262374 268623 269127!]>>
\
<SETG FX #MACRO ( %<RSUBR!- '[ %<PCODE!- "COMPLX" 9284> FX #DECL ("VALUE" FORM
"QUOTE" ANY) COND TYPE? CPX VFIX REST UCPX UVFIX ELSE ERROR UNKNOWN-COMPLEX-TYPE
FX]>)>
<SETG FL #MACRO ( %<RSUBR!- '[ %<PCODE!- "COMPLX" 9395> FL #DECL ("VALUE" FORM
"QUOTE" ANY) COND TYPE? CPX VFLOAT REST UCPX UVFLOAT ELSE ERROR
UNKNOWN-COMPLEX-TYPE FL]>)>
<SETG ** #MACRO ( %<RSUBR!- '[ %<PCODE!- "COMPLX" 9506> ** #DECL ("VALUE" FORM
"QUOTE" ANY "QUOTE" ANY) COND 0? 1? ELSE EXP * LOG]>)>
<ENDPACKAGE>

BIN
bin/librm1/confir.nbin Normal file
View File

Binary file not shown.

14
bin/librm1/cpyfil.fbin Normal file
View File

@@ -0,0 +1,14 @@
'<PCODE "2SDML">
<PACKAGE "CPYFIL">
<ENTRY COPY-FILE>
<SETG COPY-FILE %<RSUBR!- '[ %<PCODE!- "2SDML" 1784> COPY-FILE #DECL ("VALUE"
ATOM <OR STRING CHANNEL> <OR STRING CHANNEL> "OPTIONAL" UVECTOR) ![0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
0!] "READB" CANT-OPEN!-ERRORS ARG-WRONG-TYPE!-ERRORS "PRINTB"
CANT-READ-LENGTH!-ERRORS T]>>
<ENDPACKAGE>

BIN
bin/librm1/crime.nbin Normal file
View File

Binary file not shown.

177
bin/librm1/critic.fbin Normal file
View File

@@ -0,0 +1,177 @@
'<PCODE "1CRITIC">
<PACKAGE "CRITIC">
<ENTRY CRITIC CRITIC-NOTES>
<AND? <OR <LOOKUP "NO-DECL" <ROOT>> <INSERT "NO-DECL" <ROOT>>> <OR <LOOKUP
"NO-VALUE" <ROOT>> <INSERT "NO-VALUE" <ROOT>>>>
<NEWTYPE FAMILY VECTOR '<VECTOR <LIST [REST ATOM LIST LIST VECTOR]> [3 <LIST [
REST <PRIMTYPE ATOM>]>] <LIST [REST OBLIST]> <LIST [REST ATOM]> [2 <LIST [REST <
OR STRING FALSE>]>] ATOM STRING <VECTOR [4 DECL] [2 LIST] [2 DECL] LIST> LIST>>
<AND? <SETG TREE 1> <SETG TOP-FCNS 2> <SETG TOP-GLOBALS 3> <SETG TOP-LOCALS 4> <
SETG OBJECT-OBLISTS 5> <SETG ENTRIES 6> <SETG USED-PACK 7> <SETG USED-DATUM 8> <
SETG OBJECT-NAME 9> <SETG OBJECT-TYPE 10> <SETG GABST 11> <SETG NEWTYPES 12>>
<MANIFEST TREE TOP-FCNS TOP-GLOBALS TOP-LOCALS OBJECT-OBLISTS ENTRIES USED-PACK
USED-DATUM OBJECT-NAME OBJECT-TYPE GABST NEWTYPES>
<AND? <SETG GSET 1> <SETG GUSED 2> <SETG LSET 3> <SETG LUSED 4> <SETG EXTF 5> <
SETG NARGS 6> <SETG SPEC 7> <SETG RDECL 8> <SETG NOTES 9> <SETG DATUMS 10> <SETG
GOFFSET 11> <SETG ATOML 12>>
<MANIFEST GSET GUSED LSET LUSED EXTF NARGS SPEC RDECL NOTES DATUMS GOFFSET ATOML
>
<AND? <SETG RGSET 0> <SETG RGUSED 1> <SETG RLSET 2> <SETG RLUSED 3> <SETG REXTF
4> <SETG RSPEC 6> <SETG RDATUMS 9>>
<MANIFEST RGSET RGUSED RLSET RLUSED REXTF RSPEC RDATUMS>
<AND? <SETG NAME 1> <SETG FATHERS 2> <SETG SONS 3> <SETG ABST 4> <SETG NODE-SIZE
4>>
<MANIFEST NAME FATHERS SONS ABST NODE-SIZE>
<NEWTYPE FATHER VECTOR '<VECTOR [2 ATOM] DECL [2 LIST]>>
<AND? <SETG CTYPE 2> <SETG FDLST 3> <SETG FPLST 4> <SETG FSPEC 5>>
<MANIFEST CTYPE FDLST FPLST FSPEC>
\
<SETG KNOWN-ATOMS '![INCHAN OUTCHAN OBLIST!]>
<SETG KNOWN-DECLS #DECL ((INCHAN) <SPECIAL CHANNEL> (OUTCHAN) <SPECIAL CHANNEL>
(OBLIST) <SPECIAL <OR OBLIST [LIST <REST OBLIST>]>>)>
<SETG DECLS-SEEN ()>
<SETG QUOTING-SUBRS [,IUVECTOR 2 ,ISTRING 2 ,ILIST 2 ,IFORM 2 ,IVECTOR 2 ,ITUPLE
2 ,IBYTES 3 ,ISTORAGE 2 ,READ 2 ,READCHR 2 ,NEXTCHR 2 ,GC-READ 2 ,GET 3 ,GETPROP
3 ,GETPL 3 ,READB 3 ,READSTRING 4]>
<AND? <SETG EVAL-OR-APPLY '![LIST FORM SEGMENT FUNCTION MACRO CLOSURE VECTOR
UVECTOR!]> <SETG APPLICABLE-TYPES '![SUBR FSUBR FUNCTION MACRO RSUBR RSUBR-ENTRY
!]> <SETG USER-APPLICABLE-TYPES <REST ,APPLICABLE-TYPES 2>> <SETG INT-SUBRS [,
SET ,SETG ,DEFINE ,DEFMAC ,LVAL ,LLOC ,GVAL ,GLOC ,VALUE]> <SETG
CONTROL-STRUCTURES [,DEFINE ,DEFMAC ,PROG ,REPEAT ,BIND ,FUNCTION]> <SETG
FUNNY-FSUBRS ![,COND ,QUOTE!]> <SETG PRINTING-SUBRS ![,PRINT ,PRINC ,PRIN1 ,
TERPRI ,CRLF!]> <SETG OPEN-SUBRS ![,OPEN ,OPEN-NR ,FLOAD ,SAVE ,RESTORE ,CHANNEL
!]> <SETG LVAL-LLOC ![,LVAL ,LLOC!]> <SETG GVAL-GLOC ![,GVAL ,GLOC!]> <SETG
SETG-DEFINE [,SETG ,DEFINE ,DEFMAC]> <SETG APPLY-MAPF-MAPR [,APPLY ,MAPF ,MAPR ,
STACKFORM]> <SETG MAPF-MAPR ![,MAPF ,MAPR!]> <SETG DEFINE-DEFMAC [,DEFINE ,
DEFMAC]> <SETG PACKAGE-RPACKAGE [,PACKAGE ,RPACKAGE]> <SETG BLOCK-ENDBLOCK [,
BLOCK ,ENDBLOCK]> <SETG USE-USE-DEFER [,USE ,USE-DEFER]>>
<GDECL (KNOWN-ATOMS EVAL-OR-APPLY APPLICABLE-TYPES USER-APPLICABLE-TYPES) <
UVECTOR [REST ATOM]> (KNOWN-DECLS) DECL (DECLS-SEEN) LIST (QUOTING-SUBRS) <
VECTOR [REST SUBR FIX]> (INT-SUBRS) <VECTOR [REST APPLICABLE]> (
CONTROL-STRUCTURES SETG-DEFINE APPLY-MAPF-MAPR) <VECTOR [REST <OR SUBR FSUBR>]>
(FUNNY-FSUBRS) <UVECTOR [REST FSUBR]> (PRINTING-SUBRS OPEN-SUBRS LVAL-LLOC
GVAL-GLOC MAPF-MAPR) <UVECTOR [REST SUBR]> (DEFINE-DEFMAC PACKAGE-RPACKAGE
BLOCK-ENDBLOCK USE-USE-DEFER) <VECTOR [REST APPLICABLE]>>
\
<SETG CRITIC %<RSUBR!- '[ %<PCODE!- "1CRITIC" 0> CRITIC #DECL ("VALUE" <OR
FALSE STRING> ATOM "OPTIONAL" <OR CHANNEL STRING> ANY) INDENT-TO MANIFEST?
OUTCHAN (CHANNEL) NM2 "CRITIC" (STRING) "PRINT" %<RGLOC DECLS-SEEN T> NM? Group
(<OR ATOM FALSE>) OFFS (FIX) OBLIST (<LIST [REST OBLIST]>) %<RGLOC MUDDLE T>
"====== CRITIC's Review of Group: " CHANNEL " from file \"" " ======" "DONE" #
FALSE ("NOT A GROUP") T (ANY) ["Called-by" "Calls" "SETG" "GVAL" "SET" "LVAL"
"SPECIAL" "USE" "USE-DATUM"] " " ": " "Packages USEd but not referenced: "
"Internal Functions never called" DEFINE "Internal Globals never used"
"Internal Manifests never used" %<TYPE-W FATHER VECTOR> ARGS %<RGLOC KNOWN-ATOMS
T> " is unused or should be SPECIAL." "Arguments unused" "Unused"
"Unused SPECIALs" "SPECIALs never used as SPECIALs" " in " ": " " (" ")" "."
", " FAMILY (FAMILY) %<TYPE-W FAMILY VECTOR> TREE (<LIST [REST ATOM LIST LIST
VECTOR]>) STUMP (LIST) TOP-FCNS (<LIST [REST ATOM]>) TOP-GLOBALS TOP-LOCALS
OBJECT-OBLISTS INITIAL ENTRIES USED-PACK (<LIST [REST STRING]>) USED-DATUM
OBJECT-NAME (ATOM) OBJECT-TYPE "FILE" NEWTYPES NOTES
"ENTRYs not bound, assumed locals" %<RGLOC USER-APPLICABLE-TYPES T> %<RGLOC
PACKAGE-RPACKAGE T> "PACKAGE" PACKAGE %<RGLOC USE-USE-DEFER T> %<RGLOC USE-DATUM
T> %<RGLOC ENTRY T> %<RGLOC NEWTYPE T> ![LIST VECTOR UVECTOR TUPLE!]
"NEWTYPE not DECLed" %<RGLOC FLOAD T> "FLOAD in file" %<RGLOC BLOCK-ENDBLOCK T>
"BLOCK or ENDBLOCK at top level in PACKAGE." %<RGLOC DEFINE T> %<RGLOC SETG T>
VALUE %<RGLOC SET T> %<RGLOC QUOTE T> %<RGLOC DEFINE-DEFMAC T> ABST (VECTOR)
FTREE FATHER-NAME (<VECTOR [4 DECL] [2 LIST] [2 DECL] [2 LIST]>)
"External locals set" "External locals used" PP (<LIST [REST <PRIMTYPE ATOM>]>)
PS %<RGLOC DEFMAC T> %<RGLOC CONTROL-STRUCTURES T> QUOTE "ATOM "
" used twice in parameter list." UNSPECIAL SPECIAL %<RGLOC APPLICABLE-TYPES T>
"Untasteful re-use of ATOM " " in ROOT." "No DECL in DECL for" "Illegal DECL" ![
ANY LOCATIVE STRUCTURED APPLICABLE!] "Not a legal type" DECL
"Type-name not a type: " "FORM/SEGMENT too short" ![SPECIAL UNSPECIAL!]
"SPECIAL/UNSPECIAL with three or more elements" PRIMTYPE "Bad PRIMTYPE type"
"PRIMTYPE with three or more elements" OR "Bad type of structured type" BYTES
"BYTES DECL too short" "BYTES DECL too long" "Bad BYTES specification"
"REST must terminate DECL" "VECTOR in OR specification" "Nth/REST/OPT too short"
![REST OPT!] "Only REST or OPT may follow OPT" REST OPT NO-DECL MANIFEST
": MANIFESTed structure" %<RGLOC KNOWN-DECLS T> "Calls undefined function "
"Calls " " with too few arguments." " with too many arguments." %<TYPE-C FATHER
VECTOR> B? D? AUNB " but unbound and unDECLed" " but unbound" " but unDECLed"
" unbound in paths" "The ATOM " " used in " " should be special in "
"External FUNCTION " %<RGLOC MAPF-MAPR T> %<RGLOC FUNNY-FSUBRS T> %<RGLOC
PRINTING-SUBRS T> %<RGLOC OPEN-SUBRS T> DEV SNM NM1 %<RGLOC QUOTING-SUBRS T> %<
RGLOC EVAL-OR-APPLY T> FUNCTION %<RGLOC FUNCTION T> "Possibly should be QUOTEd"
%<RGLOC INT-SUBRS T> %<RGLOC LVAL-LLOC T> %<RGLOC SETG-DEFINE T> %<RGLOC
GVAL-GLOC T> %<RGLOC VALUE T> %<RGLOC APPLY-MAPF-MAPR T> ![SUBR FSUBR!] %<RGLOC
APPLY T> (0 0) ![RSUBR-ENTRY RSUBR!] "RSUBR has no DECL." #DECL ("VALUE" ANY
"TUPLE" TUPLE) "FUNCTION has no DECL." "VALUE" PUN "Parameters not DECLed"
"BIND" "\"BIND\" illegally located." ["NAME" "ACT"] ["CALL" "ARGS"]
"\"CALL\"/\"ARGS\" illegally located." ["OPTIONAL" "OPT"] "OPTIONAL"
"\"OPTIONAL\" illegally located." "TUPLE" TUPLE "\"TUPLE\" illegally located." [
"AUX" "EXTRA"] "\"AUX\" Illegally QUOTEd" ANY]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,CRITIC PGLUE ![738197503 -1 -1 -1 -1 -1 -1 -1
-1 -1 -1 -1073741824 0!]>>
<SETG CRITIC-NOTES %<RSUBR-ENTRY '[CRITIC CRITIC-NOTES #DECL ("VALUE" <OR FALSE
STRING> ATOM "OPTIONAL" <OR STRING CHANNEL>)] 315>>
\
\
\
\
\
\
\
\
\
\
\
\
\
\
\
"Make a father and add it to the list of sons of a node"
\
\
\
<DEFMAC APPEND ('AA 'STUFF) <FORM PROG <LIST <LIST A <FORM LVAL .AA>> (STUFF .
STUFF)> #DECL ((A) LIST) <FORM SET .AA '<COND (<EMPTY? .A> (.STUFF)) (ELSE <
PUTREST <REST .A <- <LENGTH .A> 1>> (.STUFF)> .A)>>>>
<ENDPACKAGE>

32
bin/librm2/datime.fbin Normal file
View File

@@ -0,0 +1,32 @@
'<PCODE "1DATIME">
<RPACKAGE "DATIME">
<ENTRY DATE RTIME RTIME:SEC GETTIMEZONE FIX-DATE>
<SETG DATE %<RSUBR!- '[ %<PCODE!- "1DATIME" 0> DATE #DECL ("VALUE" <LIST FIX
FIX FIX> "OPTIONAL" <LIST FIX FIX FIX>)]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,DATE PGLUE ![0!]>>
<SETG RTIME %<RSUBR!- '[ %<PCODE!- "1DATIME" 46> RTIME #DECL ("VALUE" <LIST FIX
FIX FIX> "OPTIONAL" <LIST FIX FIX FIX>)]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,RTIME PGLUE ![0!]>>
<SETG RTIME:SEC %<RSUBR!- '[ %<PCODE!- "1DATIME" 91> RTIME:SEC #DECL ("VALUE"
FIX)]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,RTIME:SEC PGLUE ![0!]>>
<SETG GETTIMEZONE %<RSUBR!- '[ %<PCODE!- "1DATIME" 108> GETTIMEZONE #DECL (
"VALUE" STRING) "EDT" "EST"]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,GETTIMEZONE PGLUE ![1006632960!]>>
<SETG FIX-DATE %<RSUBR!- '[ %<PCODE!- "1DATIME" 121> FIX-DATE #DECL ("VALUE"
FIX)]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,FIX-DATE PGLUE ![0!]>>
<ENDPACKAGE>

BIN
bin/librm2/datred.nbin Normal file
View File

Binary file not shown.

BIN
bin/librm2/datsav.nbin Normal file
View File

Binary file not shown.

47
bin/librm2/db.fbin Normal file
View File

@@ -0,0 +1,47 @@
'<PCODE "1DB">
<PACKAGE "DB">
<ENTRY DBOPEN DBCOPY DBREPLACE DBCLOSE>
<USE "CHAN" "SDM" "LOCKS" "CPYFIL" "LIBDAT" "RQFILE">
<SETG DBCOPY %<RSUBR!- '[ %<PCODE!- "1DB" 0> DBCOPY #DECL ("VALUE" <OR FALSE
PMCHAN> STRING "OPTIONAL" <OR FALSE 'T>) SDMOPN SOFT-LOCK LOCKED? SDMDCT
TEMPDELETE SDMACT COPY-FILE TEMPFILE UNLOCK HARD-LOCK FILSTR %<RGLOC OPSYS T>
"READ" "DATA" "-UPDATER" #FALSE ("SOMEONE ELSE UPDATING") #FALSE (
"CANNOT-LOCK-DATA-BASE") "OLD" TO T #FALSE ("CANNOT-READ-DATA-BASE") "PRINTB"
"READB" #FALSE ("CANNOT-OPEN-DATA-BASE") CXOUT (CHANNEL) CXIN COPIER (ACTIVATION
) IOCHND IOC!-INTERRUPTS "IOC" %<RSUBR!- '[ %<PCODE!- "1DB" 884> ANONF5!-TMP #
DECL ("VALUE" ANY FALSE CHANNEL) CXIN CXOUT COPIER]> %<RGLOC IOCHND T> ERRHND
ERROR!-INTERRUPTS "ERROR" %<RSUBR!- '[ %<PCODE!- "1DB" 918> ANONF15!-TMP #DECL
("VALUE" ANY "TUPLE" TUPLE) #FALSE ("ERROR DURING COPY") COPIER]> %<RGLOC ERRHND
T> %<RGLOC CI T> %<RGLOC CO T> OLDNAME ORIGINAL FILENAME TEMPNAME UPDATELOCK
TENEX-SYSTEM-UNIMPLEMENTED %<TYPE-W PMCHAN VECTOR> LOCKNAME LOCKWORD #FALSE (
"DATA BASE IN USE") RENAME-OF-DATA-BASE-FAILED DBREPLACE
RENAME-OF-COPY-DATA-BASE-FAILED DELETE-OF-OLD-DATA-BASE-FAILED INTERRUPT]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,DBCOPY PGLUE ![715827967 -1 -1 -67108864!]>>
\
<SETG DBREPLACE %<RSUBR-ENTRY '[DBCOPY DBREPLACE #DECL ("VALUE" <OR ATOM FALSE>
PMCHAN "OPTIONAL" FIX FIX)] 454>>
\
<SETG DBOPEN %<RSUBR-ENTRY '[DBCOPY DBOPEN #DECL ("VALUE" <OR FALSE PMCHAN>
STRING)] 663>>
<SETG DBCLOSE %<RSUBR-ENTRY '[DBCOPY DBCLOSE #DECL ("VALUE" <OR ATOM FALSE>
PMCHAN)] 786>>
\
<SETG INTSET %<RSUBR-ENTRY '[DBCOPY INTSET #DECL ("VALUE" HANDLER ATOM STRING
APPLICABLE "OPTIONAL" FIX)] 818>>
<DEFMAC FILCHN ('CH) <FORM FILSTR <FORM RNAME1 .CH> <FORM RNAME2 .CH> <FORM
RDEVICE .CH> <FORM RDIRECTORY .CH>>>
<ENDPACKAGE>

BIN
bin/librm2/dcreat.nbin Normal file
View File

Binary file not shown.

315
bin/librm2/ddm.fbin Normal file
View File

@@ -0,0 +1,315 @@
'<PCODE "DDM">
<PACKAGE "DDM">
<ENTRY DDMOPEN DDMCLOSE DDMFLUSH DDMREAD DDMPRINT DDMDELETE DDMRDLOCK DDMWRLOCK
DDMUNLOCK DDMRESET>
<ENTRY DDMREADA DDMPRINTA DDMNEWID DDMRESERVE DDMALLOC DDMDALLOC>
<ENTRY GET-ITEM PUT-ITEM GET-DATA PUT-DATA EXTEND-ALLOC-TABLE>
<ENTRY DDMCHAN>
<ENTRY PAGSIZ ALLSIZOFS ALLLOCOFS ALLDATOFS ALLTBLPAG>
<ENTRY DDMRETRIES DDMSLEEPTIME>
<USE "MADMAN" "TENXIO" "DDMA">
"DDM ==> Direct Data Manager/Disk Data Manager
ASSUMPTIONS:
1) Object Computer is a DEC PDP10
2) Operating System is either TENEX or TOPS-20. (Not ITS!)
2a) Data File is 'holey', i.e., its pages may be non-contiguous.
2b) Page size is 512 words.
2c) Page numbers from 0 to (2**18)-1 are legal.
3) Data file 'belongs' to a single process/user, no locking, unlocking,
communication, or shared data protocols are supported.
4) All disk access are carried out by mapping pages of the data file
into core and modifying the mapped page. No direct/random access
of the data file is used.
5) The size of a data item (# of words needed to store it) must be known
before the data item is written."
<GDECL (DDMRETRIES DDMSLEEPTIME) FIX>
<SETG DDMRETRIES 600>
<SETG DDMSLEEPTIME 100>
"**************** OFFSETS ON 'DDMCHAN' TYPE *********************"
<SETG DDMFSPC 1>
<SETG DDMFPTR 2>
<SETG DDMPMAP 3>
<SETG DDMFPAG 4>
<SETG DDMFSIZ 5>
<GDECL (DDMFSPC DDMFPTR DDMPMAP DDMFPAG DDMFSIZ) FIX>
<MANIFEST DDMFSPC DDMFPTR DDMPMAP DDMFPAG DDMFSIZ>
<NEWTYPE DDMCHAN VECTOR '<VECTOR STRING JFN <UVECTOR [REST FIX]> FIX FIX>>
<SETG EMPDDMCHAN <CHTYPE <VECTOR "" <CHTYPE 0 JFN> <IUVECTOR 0 0> 0 0> DDMCHAN>>
"Offsets on page-map triads"
<SETG PMFPAG 1>
<SETG PMCPAG 2>
<SETG PMUCNT 3>
<GDECL (PMFPAG PMCPAG PMUCNT) FIX>
<MANIFEST PMFPAG PMCPAG PMUCNT>
"Offsets on request UVECTOR quads"
<SETG RQFPAG 1>
<SETG RQOFS 2>
<SETG RQLNT 3>
<SETG RQCADR 4>
<GDECL (RQFPAG RQOFS RQLNT RQCADR) FIX>
<MANIFEST RQFPAG RQOFS RQLNT RQCADR>
<SETG LOCKLNT 1>
<SETG LOCKADR 2>
<SETG LOCKCNT 3>
<SETG LOCKPTR 4>
<SETG LOCKPRV 5>
<SETG LOCKNXT 6>
<SETG LOCKSIZ 6>
<GDECL (LOCKLNT LOCKADR LOCKCNT LOCKPTR LOCKPRV LOCKNXT LOCKSIZ) FIX>
<MANIFEST LOCKLNT LOCKADR LOCKCNT LOCKPTR LOCKPRV LOCKNXT LOCKSIZ>
<GDECL (LRUCOUNT PAGSIZ MAXPAGOFS UFDPAGOFS WRDPERITM ITMPERPAG MAXITMID) FIX>
<SETG LRUCOUNT 0>
<SETG PAGSIZ 512>
<SETG MAXPAGOFS 262143>
<SETG UFDPAGOFS 131072>
<SETG WRDPERITM 2>
<SETG ITMPERPAG </ ,PAGSIZ ,WRDPERITM>>
<SETG MAXITMID <* ,ITMPERPAG <- ,MAXPAGOFS ,UFDPAGOFS>>>
<MANIFEST PAGSIZ MAXPAGOFS UFDPAGOFS WRDPERITM ITMPERPAG MAXITMID>
"Fixed offsets and sizes for allocator and item locking tables"
<GDECL (ALLTBLPAG ALLMAXSIZ ITMLOCKPAG ITMLOCKSIZ DATPAGOFS LOWDATADR DATAREASIZ
ITMLOCKOFS ITMLOCKADR ALLLOCOFS ALLLOCADR ALLSIZOFS ALLSIZADR ALLDATOFS
ALLDATADR HIGHITMOFS HIGHITMADR USEDITMOFS USEDITMADR OPENLOCKOFS OPENLOCKADR
HIGHLOCKOFS HIGHLOCKADR MINLOCKOFS MINLOCKADR MAXLOCKADR USEDLOCKOFS USEDLOCKADR
) FIX>
"Page allocations for allocator tbl and item locking tbl"
<SETG ALLTBLPAG 0>
<SETG ALLMAXSIZ 10>
<SETG ITMLOCKPAG <+ ,ALLTBLPAG ,ALLMAXSIZ>>
<SETG ITMLOCKSIZ 10>
<SETG DATPAGOFS <+ ,ITMLOCKPAG ,ITMLOCKSIZ>>
<SETG LOWDATADR <* ,DATPAGOFS ,PAGSIZ>>
<SETG DATAREASIZ <* ,PAGSIZ <- ,UFDPAGOFS ,DATPAGOFS>>>
"Offsets on allocator table pages (including page zero)"
<SETG ITMLOCKOFS 0>
<SETG ITMLOCKADR <+ ,ITMLOCKOFS <* ,ALLTBLPAG ,PAGSIZ>>>
<SETG ALLLOCOFS 1>
<SETG ALLLOCADR <+ ,ALLLOCOFS <* ,ALLTBLPAG ,PAGSIZ>>>
<SETG ALLSIZOFS 2>
<SETG ALLSIZADR <+ ,ALLSIZOFS <* ,ALLTBLPAG ,PAGSIZ>>>
<SETG ALLDATOFS 3>
<SETG ALLDATADR <+ ,ALLDATOFS <* ,ALLTBLPAG ,PAGSIZ>>>
"Offsets on item locking pages for assigning item id's"
<SETG HIGHITMOFS 0>
<SETG HIGHITMADR <+ ,HIGHITMOFS <* ,PAGSIZ ,ITMLOCKPAG>>>
<SETG USEDITMOFS 1>
<SETG USEDITMADR <+ ,USEDITMOFS <* ,PAGSIZ ,ITMLOCKPAG>>>
"Offsets on item locking pages for allocating/deallocating item locks"
<SETG OPENLOCKOFS 2>
<SETG OPENLOCKADR <+ ,OPENLOCKOFS <* ,PAGSIZ ,ITMLOCKPAG>>>
<SETG HIGHLOCKOFS 3>
<SETG HIGHLOCKADR <+ ,HIGHLOCKOFS <* ,PAGSIZ ,ITMLOCKPAG>>>
<SETG USEDLOCKOFS 4>
<SETG USEDLOCKADR <+ ,USEDLOCKOFS <* ,PAGSIZ ,ITMLOCKPAG>>>
<SETG MINLOCKOFS 5>
<SETG MINLOCKADR <+ ,MINLOCKOFS <* ,PAGSIZ ,ITMLOCKPAG>>>
<SETG MAXLOCKADR <+ <* ,PAGSIZ ,ITMLOCKPAG> <* </ <- <* ,PAGSIZ ,ITMLOCKSIZ> ,
MINLOCKOFS> ,LOCKSIZ> ,LOCKSIZ>>>
<MANIFEST ALLTBLPAG ALLMAXSIZ ITMLOCKPAG ITMLOCKSIZ DATPAGOFS LOWDATADR
DATAREASIZ ITMLOCKOFS ITMLOCKADR ALLLOCOFS ALLLOCADR ALLSIZOFS ALLSIZADR
ALLDATOFS ALLDATADR HIGHITMOFS HIGHITMADR USEDITMOFS USEDITMADR OPENLOCKOFS
OPENLOCKADR HIGHLOCKOFS HIGHLOCKADR USEDLOCKOFS USEDLOCKADR MINLOCKOFS
MINLOCKADR MAXLOCKADR>
"Random Gval's"
<GDECL (REQUV) <UVECTOR [REST FIX]> (LOCKUV UNLOCKUV) <UVECTOR [6 FIX]> (IDUV
UV2) <UVECTOR [2 FIX]> (UV1) <UVECTOR [1 FIX]>>
<SETG REQUV <IUVECTOR 400 -1>>
<SETG LOCKUV <IUVECTOR ,LOCKSIZ 0>>
<SETG UNLOCKUV <IUVECTOR ,LOCKSIZ 0>>
<SETG IDUV <IUVECTOR 2 0>>
<SETG UV2 <IUVECTOR 2 0>>
<SETG UV1 <IUVECTOR 1 0>>
<SETG DDMOPEN %<RSUBR!- '[ %<PCODE!- "DDM" 0> DDMOPEN #DECL ("VALUE" <OR
DDMCHAN FALSE> <OR STRING JFN> "OPTIONAL" FIX FIX DDMCHAN) TRANSFER LOCATION
RELEASE-SPACE WRITE-PAGE FIND-SPACE RELEASE-LOCK GET-LOCK APRINT ALENGTH AREAD
CLOSE-FILE RELEASE-PAGE RELEASE-FILE PMAP-FILE FIND-PAGE NAME-OF-FILE OPEN-FILE
GET-FILE %<RGLOC EMPDDMCHAN T> %<TYPE-W DDMCHAN VECTOR> %<TYPE-C JFN WORD> %<
RGLOC LRUCOUNT T> %<RGLOC UV1 T> T %<RGLOC UV2 T>
ALLOCATOR-TABLE-TOO-BIG!-ERRORS %<TYPE-W JFN WORD> %<RGLOC IDUV T> %<TYPE-W
SPACE VECTOR> %<RGLOC DDMRETRIES T> %<RGLOC DDMSLEEPTIME T> %<RGLOC LOCKUV T> %<
RGLOC UNLOCKUV T> ID-IS-TOO-LARGE!-ERRORS GET-ITEM PUT-ITEM %<RGLOC REQUV T>]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,DDMOPEN PGLUE ![715827882 -22548578305
-268435456!]>>
<SETG DDMCLOSE %<RSUBR-ENTRY '[DDMOPEN DDMCLOSE #DECL ("VALUE" DDMCHAN DDMCHAN)]
413>>
<SETG DDMFLUSH %<RSUBR-ENTRY '[DDMOPEN DDMFLUSH #DECL ("VALUE" DDMCHAN DDMCHAN
"OPTIONAL" ANY)] 475>>
<SETG DDMREAD %<RSUBR-ENTRY '[DDMOPEN DDMREAD #DECL ("VALUE" ANY DDMCHAN <OR FIX
WORD> SPACE "OPTIONAL" FIX <OR ATOM FALSE>)] 571>>
<SETG DDMPRINT %<RSUBR-ENTRY '[DDMOPEN DDMPRINT #DECL ("VALUE" <OR FALSE FIX
WORD> DDMCHAN <OR FIX WORD> SPACE ANY "OPTIONAL" <OR ATOM FALSE>)] 669>>
<SETG DDMDELETE %<RSUBR-ENTRY '[DDMOPEN DDMDELETE #DECL ("VALUE" <OR FALSE FIX>
DDMCHAN <OR FIX WORD>)] 792>>
<SETG DDMRDLOCK %<RSUBR-ENTRY '[DDMOPEN DDMRDLOCK #DECL ("VALUE" <OR FALSE WORD>
DDMCHAN FIX "OPTIONAL" <OR ATOM FALSE> FIX FIX)] 915>>
<SETG DDMWRLOCK %<RSUBR-ENTRY '[DDMOPEN DDMWRLOCK #DECL ("VALUE" <OR FALSE WORD>
DDMCHAN FIX "OPTIONAL" FIX <OR FIX FLOAT>)] 1231>>
<SETG DDMUNLOCK %<RSUBR-ENTRY '[DDMOPEN DDMUNLOCK #DECL ("VALUE" <OR FALSE WORD>
DDMCHAN WORD)] 1305>>
<SETG DDMRESET %<RSUBR-ENTRY '[DDMOPEN DDMRESET #DECL ("VALUE" <OR DDMCHAN FALSE
> DDMCHAN)] 1492>>
<SETG DDMREADA %<RSUBR-ENTRY '[DDMOPEN DDMREADA #DECL ("VALUE" <OR FALSE <
PRIMTYPE WORD> <UVECTOR [REST <PRIMTYPE WORD>]>> DDMCHAN <OR FIX WORD> <OR <
PRIMTYPE WORD> <UVECTOR [REST <PRIMTYPE WORD>]>> "OPTIONAL" FIX FIX)] 1578>>
<SETG DDMPRINTA %<RSUBR-ENTRY '[DDMOPEN DDMPRINTA #DECL ("VALUE" <OR FALSE FIX
WORD> DDMCHAN <OR FIX WORD> <OR <PRIMTYPE WORD> <UVECTOR [REST <PRIMTYPE WORD>]>
> "OPTIONAL" FIX <OR FIX FALSE>)] 1703>>
<SETG DDMNEWID %<RSUBR-ENTRY '[DDMOPEN DDMNEWID #DECL ("VALUE" <OR FALSE FIX>
DDMCHAN)] 1856>>
<SETG DDMRESERVE %<RSUBR-ENTRY '[DDMOPEN DDMRESERVE #DECL ("VALUE" <OR FALSE FIX
> DDMCHAN FIX)] 1976>>
<SETG DDMALLOC %<RSUBR-ENTRY '[DDMOPEN DDMALLOC #DECL ("VALUE" <OR FALSE FIX>
DDMCHAN FIX)] 2065>>
<SETG DDMDALLOC %<RSUBR-ENTRY '[DDMOPEN DDMDALLOC #DECL ("VALUE" <OR FALSE FIX>
DDMCHAN FIX FIX)] 2102>>
"******************** PRIMITIVE FILE/DATA UTILITIES ********************"
<SETG FIND-ITEM-LOCK %<RSUBR-ENTRY '[DDMOPEN FIND-ITEM-LOCK #DECL ("VALUE" <OR
FALSE FIX> DDMCHAN FIX FIX FIX <OR ATOM FALSE>)] 2143>>
<SETG UNSPLICE-LOCK %<RSUBR-ENTRY '[DDMOPEN UNSPLICE-LOCK #DECL ("VALUE" <OR
FALSE <PRIMTYPE WORD> <UVECTOR [REST <PRIMTYPE WORD>]>> DDMCHAN WORD <UVECTOR [6
FIX]>)] 2240>>
<SETG GET-ITEM %<RSUBR-ENTRY '[DDMOPEN GET-ITEM #DECL ("VALUE" <OR FALSE <
UVECTOR [2 FIX]>> DDMCHAN FIX)] 2390>>
<SETG PUT-ITEM %<RSUBR-ENTRY '[DDMOPEN PUT-ITEM #DECL ("VALUE" <OR FALSE <
UVECTOR [2 FIX]>> DDMCHAN FIX <UVECTOR [2 FIX]>)] 2435>>
<SETG GET-DATA %<RSUBR-ENTRY '[DDMOPEN GET-DATA #DECL ("VALUE" <OR FALSE <
PRIMTYPE WORD> <UVECTOR [REST <PRIMTYPE WORD>]>> DDMCHAN <OR FIX WORD> <OR <
PRIMTYPE WORD> <UVECTOR [REST <PRIMTYPE WORD>]>> FIX "OPTIONAL" <OR ATOM FALSE>)
] 2478>>
<SETG PUT-DATA %<RSUBR-ENTRY '[DDMOPEN PUT-DATA #DECL ("VALUE" <OR FALSE <
PRIMTYPE WORD> <UVECTOR [REST <PRIMTYPE WORD>]>> DDMCHAN <OR FIX WORD> <OR <
PRIMTYPE WORD> <UVECTOR [REST <PRIMTYPE WORD>]>> FIX)] 2634>>
<SETG EXTEND-ALLOC-TABLE %<RSUBR-ENTRY '[DDMOPEN EXTEND-ALLOC-TABLE #DECL (
"VALUE" <OR FALSE FIX> DDMCHAN)] 2662>>
<SETG REQUEST-NORM %<RSUBR-ENTRY '[DDMOPEN REQUEST-NORM #DECL ("VALUE" <UVECTOR
[REST FIX]> <OR <PRIMTYPE WORD> <UVECTOR [REST <PRIMTYPE WORD>]>> FIX FIX <
UVECTOR [REST FIX]>)] 2750>>
<SETG FILL-PAGE-REQUESTS %<RSUBR-ENTRY '[DDMOPEN FILL-PAGE-REQUESTS #DECL (
"VALUE" ATOM DDMCHAN <UVECTOR [REST FIX]> <UVECTOR [REST FIX]> <OR ATOM FALSE>
"OPTIONAL" FIX)] 2869>>
<ENDPACKAGE>

39
bin/librm2/ddma.fbin Normal file
View File

@@ -0,0 +1,39 @@
'<PCODE "DDMA">
<PACKAGE "DDMA">
<ENTRY FIND-PAGE RELEASE-PAGE LOCATION TRANSFER FILL-UP FIND-SPACE RELEASE-SPACE
GET-LOCK RELEASE-LOCK>
<USE "DDM">
<SETG FIND-PAGE %<RSUBR!- '[ %<PCODE!- "DDMA" 0> FIND-PAGE #DECL ("VALUE" <OR
FIX FALSE> "OPTIONAL" FIX) EXTEND-ALLOC-TABLE %<RGLOC DDMRETRIES T> %<RGLOC
DDMSLEEPTIME T>]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,FIND-PAGE PGLUE ![788529152!]>>
<SETG RELEASE-PAGE %<RSUBR-ENTRY '[FIND-PAGE RELEASE-PAGE #DECL ("VALUE" FIX FIX
"OPTIONAL" FIX)] 24>>
<SETG LOCATION %<RSUBR-ENTRY '[FIND-PAGE LOCATION #DECL ("VALUE" FIX ANY)] 54>>
<SETG TRANSFER %<RSUBR-ENTRY '[FIND-PAGE TRANSFER #DECL ("VALUE" FIX FIX FIX FIX
)] 64>>
<SETG FILL-UP %<RSUBR-ENTRY '[FIND-PAGE FILL-UP #DECL ("VALUE" FIX FIX FIX FIX)]
79>>
<SETG FIND-SPACE %<RSUBR-ENTRY '[FIND-PAGE FIND-SPACE #DECL ("VALUE" <OR FIX
FALSE> FIX FIX)] 97>>
<SETG RELEASE-SPACE %<RSUBR-ENTRY '[FIND-PAGE RELEASE-SPACE #DECL ("VALUE" <OR
FIX FALSE> <PRIMTYPE VECTOR> FIX FIX FIX FIX)] 167>>
<SETG GET-LOCK %<RSUBR-ENTRY '[FIND-PAGE GET-LOCK #DECL ("VALUE" <OR FIX FALSE>
FIX FIX FIX)] 290>>
<SETG RELEASE-LOCK %<RSUBR-ENTRY '[FIND-PAGE RELEASE-LOCK #DECL ("VALUE" FIX FIX
)] 310>>
<ENDPACKAGE>

BIN
bin/librm2/ddt.nbin Normal file
View File

Binary file not shown.

BIN
bin/librm2/declm.nbin Normal file
View File

Binary file not shown.

23
bin/librm2/demcls.fbin Normal file
View File

@@ -0,0 +1,23 @@
'<PCODE "DEMCLS">
<PACKAGE "DEMCLS">
<ENTRY SIGNAL-DEMON SET-DEMON-STATUS CLEAR-DEMON-STATUS READ-DEMON-STATUS>
<USE "STR">
<SETG SIGNAL-DEMON %<RSUBR!- '[ %<PCODE!- "DEMCLS" 0> SIGNAL-DEMON #DECL (
"VALUE" <OR ATOM FALSE> STRING "OPTIONAL" FIX) STRTOX T "The file SYS;ATSIGN "
" does not exist"]>>
<SETG READ-DEMON-STATUS %<RSUBR!- '[ %<PCODE!- "DEMCLS" 43> READ-DEMON-STATUS #
DECL ("VALUE" <OR <VECTOR [4 FIX]> FALSE> <OR STRING FIX>) STRTOX #FALSE (
"Demon not in the system table")]>>
<SETG CLEAR-DEMON-STATUS %<RSUBR!- '[ %<PCODE!- "DEMCLS" 81> CLEAR-DEMON-STATUS
#DECL ("VALUE" <OR ATOM FALSE> <OR STRING FIX>) STRTOX T]>>
<SETG SET-DEMON-STATUS %<RSUBR!- '[ %<PCODE!- "DEMCLS" 108> SET-DEMON-STATUS #
DECL ("VALUE" <OR ATOM FALSE> <OR STRING FIX> FIX FIX FIX) STRTOX T]>>
<ENDPACKAGE>

BIN
bin/librm2/dfl.fbin Normal file
View File

Binary file not shown.

79
bin/librm2/dir.fbin Normal file
View File

@@ -0,0 +1,79 @@
'<PCODE "2DIR">
<PACKAGE "DIR">
<ENTRY GET-DIRECTORY PARSE-DIRECTORY DESC-AREA NAME-AREA DESC-PTR PACK-NUMBER
LINK-BIT OPEN-WRITE GC-MARK-BIT DELETE-ON-CLOSE DELETE-FROM-UNMOUNTED-PACK
DELETED IGNORED DUMP-BIT EXTRA-WORDS CREATION-TIME CREATION-DATE REF-DATE MONTH
DAY YEAR DISK-DATE>
<USE "NSTR">
<SETG DESC-AREA 11>
<SETG NAME-AREA 2>
<SETG DESC-PTR <BITS 13>>
<SETG PACK-NUMBER <BITS 5 13>>
<SETG LINK-BIT #WORD *000001000000*>
<SETG OPEN-WRITE #WORD *000004000000*>
<SETG GC-MARK-BIT #WORD *000010000000*>
<SETG DELETE-ON-CLOSE #WORD *000020000000*>
<SETG DELETE-FROM-UNMOUNTED-PACK #WORD *000040000000*>
<SETG DELETED <ANDB ,DELETE-ON-CLOSE ,DELETE-FROM-UNMOUNTED-PACK>>
<SETG IGNORED <ANDB ,DELETED ,OPEN-WRITE>>
<SETG DUMP-BIT #WORD *400000000000*>
<SETG EXTRA-WORDS <BITS 10 24>>
<SETG CREATION-TIME <BITS 18>>
<SETG CREATION-DATE <BITS 16 18>>
<SETG REF-DATE <BITS 16 18>>
<SETG MONTH <BITS 4 23>>
<SETG DAY <BITS 5 18>>
<SETG YEAR <BITS 7 27>>
<SETG SIXBYTES (<BITS 6 30> <BITS 6 24> <BITS 6 18> <BITS 6 12> <BITS 6 6> <BITS
6 0>)>
<MANIFEST DESC-AREA NAME-AREA DESC-PTR PACK-NUMBER LINK-BIT OPEN-WRITE
GC-MARK-BIT DELETE-ON-CLOSE DELETE-FROM-UNMOUNTED-PACK DELETED IGNORED DUMP-BIT
EXTRA-WORDS CREATION-TIME CREATION-DATE REF-DATE MONTH DAY YEAR SIXBYTES>
<SETG FIELD %<RSUBR!- '[ %<PCODE!- "2DIR" 0> FIELD #DECL ("VALUE" FIX <PRIMTYPE
WORD> BITS) SIXTOS COUNT-WORDS DTNOW T DIR (<UVECTOR [REST FIX]>) N (FIX) W (<
PRIMTYPE WORD>) (#BITS *360600000000* #BITS *300600000000* #BITS *220600000000*
#BITS *140600000000* #BITS *060600000000* #BITS *000600000000*) "READB" ".FILE."
"(DIR)" "DSK" LIST]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,FIELD PGLUE ![721420287 -17179869184!]>>
<SETG DISK-DATE %<RSUBR-ENTRY '[FIELD DISK-DATE #DECL ("VALUE" WORD "OPTIONAL"
LIST)] 113>>
<SETG GET-DIRECTORY %<RSUBR-ENTRY '[FIELD GET-DIRECTORY #DECL ("VALUE" <OR FALSE
<UVECTOR [1024 FIX]>> "OPTIONAL" STRING <UVECTOR [1024 FIX]>)] 508>>
<SETG PARSE-DIRECTORY %<RSUBR-ENTRY '[FIELD PARSE-DIRECTORY #DECL ("VALUE" <
VECTOR [REST <VECTOR STRING STRING <LIST [3 FIX]> <LIST [2 FIX] FIX> <LIST [3
FIX]> <OR FIX <LIST [3 STRING] [REST STRING]>> FIX <LIST [REST CHARACTER]>>]> <
UVECTOR [REST FIX]>)] 589>>
<SETG COUNT-WORDS %<RSUBR-ENTRY '[FIELD COUNT-WORDS #DECL ("VALUE" <OR FIX FALSE
> FIX <UVECTOR [REST FIX]> FIX)] 739>>
<ENDPACKAGE>

198
bin/librm2/displa.fbin Normal file
View File

@@ -0,0 +1,198 @@
'<PCODE "DISPLA">
<PACKAGE "DISPLA">
<ENTRY SETCLIP CALL DISP ROTX ROTY ROTZ SCALE XLATE MV DR PT LN PV HC PG STPJ
DSH STRG PICT>
<USE "SMCELLS">
<USE "MIGSMN">
<BLOCK (<GET MIGS OBLIST> <ROOT>)>
MCELL
TRMTYP
PROJX
PROJY
PROJZ
XORG
YORG
<ENDBLOCK>
<BLOCK (<GET DISPCOM OBLIST> <ROOT>)>
P1
P2
CHN
RST
BLKSTK
3DSTK
INSTK
OUTSTK
NAMSTK
XFRSTK
INSTRSTK
TXFRSTRK
CLIPCON
COMSWITCH
<ENDBLOCK>
<BLOCK (!.OBLIST <GET MIGS OBLIST> <GET MCELLS OBLIST> <GET DISPCOM OBLIST>)>
<COND (<GASSIGNED? TRMTYP> "OK") (TOO.BAD <ERROR START.OVER>)>
<COND (<=? <SET FOO ,TRMTYP> !\T> <USE "MTPRIM">) (<=? .FOO !\G> <USE "MGPRIM">)
(<=? .FOO !\A> <USE "MAPRIM">) (<=? .FOO !\I> <USE "MAPRIM">) (T <ERROR YOU.LOSE
>)>
<SET REDEFINE T>
<SET CHN T>
<SET RST T>
<SETG PICT %<RSUBR!- '[ %<PCODE!- "DISPLA" 0> PICT #DECL ("VALUE" ATOM ATOM <
LIST [REST STRING]> "ARGS" LIST) SETCLIP CLIP "INV" INV "VIS" "2D" "3D" 3D MCELL
(<OR ATOM FALSE>) BLK "!-MCELLS" %<TYPE-W MCELL LIST> "DONE" OUTSTK (<LIST [
REST <LIST FIX [REST <OR FIX FLOAT FORM ATOM>]>]>) INSTK (LIST) COMSWITCH (ANY)
Z1 "LENGHTS NOT EQUAL" "PV" %<RGLOC NULL T> %<RGLOC STCP T> %<RGLOC CLIPCON T>
3DSTK (<LIST [REST <OR ATOM FALSE>]>) BLKSTK NAMSTK (<LIST [REST ATOM]>) XFRSTK
(<LIST [REST <OR FIX VECTOR>]>) INSTRSTK (<LIST [REST LIST]>) TXFRSTK %<RGLOC
PROJX T> %<RGLOC PROJY T> %<RGLOC PROJZ T> %<RGLOC XORG T> %<RGLOC YORG T>
"NOT A MCELL" "DSPLY" "INFINITE RECURSION FOUND IN" %<RGLOC SETPROJ T> %<RGLOC
SETORG T> %<RGLOC PAGE T> %<RGLOC HCOPY T> %<RGLOC DASH T> T "INVALID OP CODE"
XFRMAT (<VECTOR FIX FIX <VECTOR [REST FLOAT]>>) TEMP (<LIST [REST <VECTOR FIX
FIX <VECTOR [REST FLOAT]>>]>) %<RGLOC PROJ T> P1 P2 "DVAL" XFR TX FIX FLOAT %<
RGLOC LINE T> "YOU BLEW IT" "M*V32"]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,PICT PGLUE ![738197503 -1 -1 -64 0!]>>
<SETG MCELL %<RSUBR-ENTRY '[PICT MCELL #DECL ("VALUE" STRING ATOM "OPTIONAL"
LIST LIST <OR ATOM FALSE> <OR ATOM FALSE> "ARGS" LIST)] 90>>
<SETG DISPCOM %<RSUBR-ENTRY '[PICT DISPCOM #DECL ("VALUE" <LIST [REST <LIST FIX
[REST <OR FIX FLOAT FORM ATOM>]>]> LIST)] 320>>
<SETG MV %<RSUBR-ENTRY '[PICT MV #DECL ("VALUE" <LIST <LIST FIX [2 <OR FIX FLOAT
>]>> <OR FIX FLOAT> <OR FIX FLOAT> "OPTIONAL" <OR FIX FLOAT>)] 400>>
<SETG DR %<RSUBR-ENTRY '[PICT DR #DECL ("VALUE" <LIST <LIST FIX [2 <OR FIX FLOAT
>]>> <OR FIX FLOAT> <OR FIX FLOAT> "OPTIONAL" <OR FIX FLOAT>)] 469>>
<SETG PT %<RSUBR-ENTRY '[PICT PT #DECL ("VALUE" <LIST <LIST FIX> <LIST FIX>> <OR
FIX FLOAT> <OR FIX FLOAT> "OPTIONAL" <OR FIX FLOAT>)] 538>>
<SETG LN %<RSUBR-ENTRY '[PICT LN #DECL ("VALUE" <LIST <LIST FIX [2 <OR FIX FLOAT
>] [REST <OR FIX FLOAT>]> <LIST FIX [2 <OR FIX FLOAT>] [REST <OR FIX FLOAT>]>> <
OR FIX FLOAT> <OR FIX FLOAT> "OPTIONAL" <OR FIX FLOAT> <OR FIX FLOAT> <OR FIX
FLOAT> <OR FIX FLOAT>)] 627>>
<SETG PV %<RSUBR-ENTRY '[PICT PV #DECL ("VALUE" ANY <OR LIST VECTOR UVECTOR> <OR
LIST VECTOR UVECTOR> "OPTIONAL" <OR LIST VECTOR UVECTOR>)] 779>>
<SETG CALL %<RSUBR-ENTRY '[PICT CALL #DECL ("VALUE" <LIST <LIST FIX ANY>> ATOM
"ARGS" <LIST [REST FORM]>)] 1104>>
<SETG FIXFRM %<RSUBR-ENTRY '[PICT FIXFRM #DECL ("VALUE" <LIST [REST FORM]> <LIST
[REST FORM]>)] 1171>>
<SETG HC %<RSUBR-ENTRY '[PICT HC #DECL ("VALUE" ATOM)] 1267>>
<SETG PG %<RSUBR-ENTRY '[PICT PG #DECL ("VALUE" ATOM)] 1298>>
<SETG STPJ %<RSUBR-ENTRY '[PICT STPJ #DECL ("VALUE" ATOM <OR FIX FLOAT> <OR FIX
FLOAT> <OR FIX FLOAT>)] 1329>>
<SETG STRG %<RSUBR-ENTRY '[PICT STRG #DECL ("VALUE" ATOM <OR FIX FLOAT> <OR FIX
FLOAT>)] 1378>>
<SETG STCP %<RSUBR-ENTRY '[PICT STCP #DECL ("VALUE" ATOM <OR FIX FLOAT> <OR FIX
FLOAT> <OR FIX FLOAT> <OR FIX FLOAT>)] 1421>>
<SETG DSH %<RSUBR-ENTRY '[PICT DSH #DECL ("VALUE" ATOM <OR ATOM FALSE>)] 1476>>
<SETG CLIPCON (0.0000000 1023.0 0.0000000 1023.0)>
<SETG KLUDGE []>
<SETG SETCLIP %<RSUBR-ENTRY '[PICT SETCLIP #DECL ("VALUE" <LIST [REST FLOAT]>
"OPTIONAL" <OR FIX FLOAT> <OR FIX FLOAT> <OR FIX FLOAT> <OR FIX FLOAT>)] 1512>>
<SETG DISP %<RSUBR-ENTRY '[PICT DISP #DECL ("VALUE" ANY ATOM "ARGS" <LIST [REST
FORM]>)] 1617>>
<SETG DSPLY %<RSUBR-ENTRY '[PICT DSPLY #DECL ("VALUE" STRING ATOM <LIST [REST
FORM]>)] 1766>>
<SETG PUSH %<RSUBR-ENTRY '[PICT PUSH #DECL ("VALUE" <LIST ANY> ANY ATOM)] 2043>>
<SETG POP %<RSUBR-ENTRY '[PICT POP #DECL ("VALUE" LIST ATOM)] 2068>>
<SETG CONCAT %<RSUBR-ENTRY '[PICT CONCAT #DECL ("VALUE" <OR FIX <VECTOR FIX FIX
<VECTOR [REST FLOAT]>>> <LIST [REST FORM]>)] 2085>>
<SETG DVAL %<RSUBR-ENTRY '[PICT DVAL #DECL ("VALUE" STRING <LIST FIX [REST <OR
FIX FLOAT>]> <OR ATOM FALSE> <OR ATOM FALSE>)] 2250>>
<SETG TCAT %<RSUBR-ENTRY '[PICT TCAT #DECL ("VALUE" <OR FIX <VECTOR FIX FIX <
VECTOR [REST FLOAT]>>> <LIST [REST <OR FIX VECTOR>]>)] 2372>>
<SETG XFORM %<RSUBR-ENTRY '[PICT XFORM #DECL ("VALUE" <LIST FIX [REST <OR FIX
FLOAT>]> <LIST FIX [REST <OR FIX FLOAT>]> <OR FIX VECTOR>)] 2563>>
<SETG CLIP %<RSUBR-ENTRY '[PICT CLIP #DECL ("VALUE" STRING <LIST [2 <OR FIX
FLOAT>]> <LIST [2 <OR FIX FLOAT>]> "OPTIONAL" FLOAT FLOAT FLOAT FLOAT)] 2594>>
<SETG CODE %<RSUBR-ENTRY '[PICT CODE #DECL ("VALUE" WORD <TUPLE FIX FIX> FLOAT
FLOAT FLOAT FLOAT)] 3028>>
<SETG M*32S %<RSUBR-ENTRY '[PICT M*32S #DECL ("VALUE" <VECTOR [2 FIX] <VECTOR [9
FLOAT] [REST FLOAT]>> <VECTOR FIX FIX <VECTOR [REST FLOAT]>> <VECTOR FIX FIX <
VECTOR [REST FLOAT]>>)] 3094>>
<SETG M*V32 %<RSUBR-ENTRY '[PICT M*V32 #DECL ("VALUE" <LIST [2 FLOAT] [REST
FLOAT]> <VECTOR FIX FIX <VECTOR [REST FLOAT]>> <LIST [REST <OR FIX FLOAT>]>)]
3564>>
<SETG SCALE %<RSUBR-ENTRY '[PICT SCALE #DECL ("VALUE" <VECTOR [2 FIX] <VECTOR [9
FLOAT] [REST FLOAT]>> <OR FIX FLOAT> "OPTIONAL" <OR FIX FLOAT> <OR FIX FLOAT>)]
3756>>
<SETG XLATE %<RSUBR-ENTRY '[PICT XLATE #DECL ("VALUE" <VECTOR [2 FIX] <VECTOR [9
FLOAT] [REST FLOAT]>> <OR FIX FLOAT> <OR FIX FLOAT> "OPTIONAL" <OR FIX FLOAT>)]
3895>>
<SETG ROTZ %<RSUBR-ENTRY '[PICT ROTZ #DECL ("VALUE" <VECTOR [2 FIX] <VECTOR [9
FLOAT] [REST FLOAT]>> FLOAT)] 4031>>
<SETG ROTX %<RSUBR-ENTRY '[PICT ROTX #DECL ("VALUE" <VECTOR [2 FIX] <VECTOR [16
FLOAT] [REST FLOAT]>> FLOAT)] 4164>>
<SETG ROTY %<RSUBR-ENTRY '[PICT ROTY #DECL ("VALUE" <VECTOR [2 FIX] <VECTOR [16
FLOAT] [REST FLOAT]>> FLOAT)] 4241>>
<ENDBLOCK>
<ENDPACKAGE>

BIN
bin/librm2/dmx.nbin Normal file
View File

Binary file not shown.

BIN
bin/librm2/doops.nbin Normal file
View File

Binary file not shown.

BIN
bin/librm2/dout.nbin Normal file
View File

Binary file not shown.

11
bin/librm2/dow.fbin Normal file
View File

@@ -0,0 +1,11 @@
'<PCODE "1DATIME">
<RPACKAGE "DOW">
<ENTRY DOW>
<SETG DOW %<RSUBR!- '[ %<PCODE!- "1DATIME" 143> DOW #DECL ("VALUE" FIX)]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,DOW PGLUE ![0!]>>
<ENDPACKAGE>

72
bin/librm2/dragan.fbin Normal file
View File

@@ -0,0 +1,72 @@
'<PCODE "1DRAGAN">
<PACKAGE "DRAGAN">
<ENTRY ANNOTATE>
<USE "LSRHIL" "LSRTNS">
<SETG ANNOTATE %<RSUBR!- '[ %<PCODE!- "1DRAGAN" 0> ANNOTATE #DECL ("VALUE" <OR
CHANNEL FALSE> "OPT" STRING STRING <OR ATOM FALSE>) FULLNAME LSR-EXTRACT
INDENT-TO LSR-ENTRY "DRAGON" T "READB" "PRINT" %<RGLOC KEY T> OUTCHAN (CHANNEL)
%<RGLOC BUF T> "#
" "î" %<RGLOC NL T> "/!" ![$MITA $MITT $HOMA $HOMT $NETA $PROJ $SUPR $REM $AUTH
$ALTR!] [" MIT: " " " " HOME: " " "
" NET: " " hacking " " for " " Remarks: "
" Authorization: " " Entered by: "]]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,ANNOTATE PGLUE ![717225983 -1073741824!]>>
<SETG INFO %<RSUBR-ENTRY '[ANNOTATE INFO #DECL ("VALUE" <OR FALSE STRING> STRING
)] 306>>
<GDECL (BUF NL KEY) STRING>
<SETG BUF <ISTRING 150>>
<SETG NL "
">
<SETG KEY
" KEY:
Relation to one's group:
A - Administrative
B - Biweekly/Exempt (?)
C - Customer
F - Faculty
G - Graduate Student
N - None
O - Other
P - Publications/Editing
R - Research Associate
S - DSR Staff
U - Undergraduate Student
|
| One's group affiliation:
| A - Artificial Intelligence Lab
| C - Project MAC
| D - Dynamic Modelling
| H - Actor/Planner Group
| I - Information Proc. Services
| L - LOGO Lab
| M - Mathlab Group
| N - Non-Consortium Macsyma User
| O - Programs (e.g. XGP)
| P - Knowledge Based Systems (AutoProg)
| R - Architecture Machine Group
| S - Stanford Visitor
| T - Tourist/Guest
| U - Authorized Macsyma User
| W - MIT-XX Person
| X - eX-user of ITS
| Z - Medical Group
| + - MIT System Wizards
| < - Very Small Data Bases
| $ - Non-MIT (NET) Wizards
| @ - Alias for someone known under another name
| |
V V
">
<ENDPACKAGE>

139
bin/librm2/dragit.fbin Normal file
View File

@@ -0,0 +1,139 @@
'<PCODE "DRAGIT">
<PACKAGE "DRAGIT">
<ENTRY DRAGON SUMMARY DATA SDATA>
<USE "LINES" "NSTR" "ITIME" "FORMAT">
<SETG DRAGON %<RSUBR!- '[ %<PCODE!- "DRAGIT" 0> DRAGON #DECL ("VALUE" <OR ATOM
FALSE> "OPTIONAL" STRING) PCRLFS!-IFORMAT PFIX!-IFORMAT IDAY PFLOAT!-IFORMAT
PCOLUMN!-IFORMAT POBJ!-IFORMAT LSH LTIME BTIME ZONE SUBSTR COUNT-LINES
BUILD-LINES READ-LINE FIND-LINE COMMENT-LINE "DRAGON HOARD" "READ" "REPORT"
"DRAGON" "TOTALS" #FALSE ("CANT FIND TOTALS LINE") "This file" %<RGLOC SDATA T>
"Totals" %<RGLOC DATA T> T %<RGLOC GSTR T> "- TOTALS -" "- RANDOMS -" " --" ""
"SUBTOTALS" NM2 (STRING) SNM "EST" %<RGLOC STSTR T> "UP" %<RGLOC UPSTR T> %<
RGLOC DNSTR T> "DOWN" %<RGLOC OKSTR T> "OK" "0123456789" " " "BAD-FRACTION"
OUTCHAN " ;" ["Sun" "Mon" "Tue" "Wed" "Thu" "Fri" "Sat"] "." " " ":" "!" (
CHANNEL) "ALL" "R" "RUNS" "G" "GRPS" "T" "TOTS" "SUMMRY" "PRINT"
"
Group-name Users Connect-time %Con Cpu time %Cpu Swaps %Swaps
" "..." " "
"
Month Log Up Down Down Cpu Up Cpu Runs Mean Swaps Swaps/hour
hrs hrs hrs (day) hrs % % run x1000 up cpu
" ["Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" "Sep" "Oct" "Nov" "Dec"] "%"
"----------------" %<RGLOC CSTART T> %<RGLOC CEND T>]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,DRAGON PGLUE ![715827882 -17179869185 -1 -1
-268435456!]>>
<SETG GSTR "MIT-DM accounts for ">
<GDECL (GSTR) STRING>
<SETG READ-GROUPS %<RSUBR-ENTRY '[DRAGON READ-GROUPS #DECL ("VALUE" VECTOR
CHANNEL)] 227>>
<SETG COUNT-LINES %<RSUBR-ENTRY '[DRAGON COUNT-LINES #DECL ("VALUE" <OR FALSE
FIX> CHANNEL "TUPLE" <TUPLE [REST STRING]>)] 391>>
<SETG COMMENT-LINE %<RSUBR-ENTRY '[DRAGON COMMENT-LINE #DECL ("VALUE" <OR FALSE
STRING> CHANNEL "TUPLE" <TUPLE [REST STRING]>)] 465>>
<SETG DEFOPEN %<RSUBR-ENTRY '[DRAGON DEFOPEN #DECL ("VALUE" <OR CHANNEL FALSE>
STRING STRING STRING STRING)] 533>>
<SETG STSTR " This file is for period beginning ">
<SETG UPSTR "UP ">
<SETG DNSTR "DOWN ">
<SETG OKSTR "OK ">
<GDECL (STSTR UPSTR DNSTR OKSTR) STRING>
<SETG BEGINS? %<RSUBR-ENTRY '[DRAGON BEGINS? #DECL ("VALUE" <OR FALSE STRING>
STRING STRING)] 570>>
<PUTPROP TIMELIST DECL '<LIST [2 <LIST [3 FIX]>] STRING>>
<PUTPROP HMS DECL '<LIST [3 FIX]>>
<SETG PRSLIN %<RSUBR-ENTRY '[DRAGON PRSLIN #DECL ("VALUE" <OR FALSE <LIST STRING
<LIST [2 <LIST [3 FIX]>] STRING> <LIST [3 FIX]> FLOAT>> STRING)] 605>>
<SETG CRASH-PARSE %<RSUBR-ENTRY '[DRAGON CRASH-PARSE #DECL ("VALUE" STRING
STRING TIMELIST HMS)] 773>>
<SETG TOTALS-PARSE %<RSUBR-ENTRY '[DRAGON TOTALS-PARSE #DECL ("VALUE" <OR FALSE
VECTOR> STRING)] 797>>
<SETG DATE-PARSE %<RSUBR-ENTRY '[DRAGON DATE-PARSE #DECL ("VALUE" STRING STRING
TIMELIST)] 949>>
<SETG TIME-PARSE %<RSUBR-ENTRY '[DRAGON TIME-PARSE #DECL ("VALUE" STRING STRING
HMS)] 1091>>
<SETG NUM-PARSE %<RSUBR-ENTRY '[DRAGON NUM-PARSE #DECL ("VALUE" STRING STRING
VECTOR)] 1328>>
<SETG LTOI %<RSUBR-ENTRY '[DRAGON LTOI #DECL ("VALUE" FIX TIMELIST)] 1392>>
<SETG ITOL %<RSUBR-ENTRY '[DRAGON ITOL #DECL ("VALUE" <LIST [2 LIST] STRING> FIX
)] 1430>>
<SETG IDUR %<RSUBR-ENTRY '[DRAGON IDUR #DECL ("VALUE" FIX HMS)] 1444>>
<SETG DAYS-IN-MONTH %<RSUBR-ENTRY '[DRAGON DAYS-IN-MONTH #DECL ("VALUE" FIX
TIMELIST)] 1493>>
<SETG FIRST-OF-NEXT %<RSUBR-ENTRY '[DRAGON FIRST-OF-NEXT #DECL ("VALUE" FIX FIX
FIX)] 1536>>
<SETG FIRST-OF-THIS %<RSUBR-ENTRY '[DRAGON FIRST-OF-THIS #DECL ("VALUE" FIX FIX
FIX)] 1576>>
<SETG HR </ 262144 24>>
<MANIFEST HR>
<SETG FTIME %<RSUBR-ENTRY '[DRAGON FTIME #DECL ("VALUE" FLOAT FIX)] 1604>>
<SETG OLINE %<RSUBR-ENTRY '[DRAGON OLINE #DECL ("VALUE" ATOM <LIST STRING
TIMELIST HMS>)] 1632>>
<SETG ODATE %<RSUBR-ENTRY '[DRAGON ODATE #DECL ("VALUE" FIX TIMELIST)] 1765>>
<SETG ODUR %<RSUBR-ENTRY '[DRAGON ODUR #DECL ("VALUE" FIX HMS)] 1869>>
<SETG OTIM %<RSUBR-ENTRY '[DRAGON OTIM #DECL ("VALUE" FIX HMS)] 1946>>
\
<SETG SUMMARY %<RSUBR-ENTRY '[DRAGON SUMMARY #DECL ("VALUE" <OR ATOM CHANNEL
FALSE> "TUPLE" TUPLE)] 2000>>
<SETG PERCENT %<RSUBR-ENTRY '[DRAGON PERCENT #DECL ("VALUE" FIX FLOAT)] 2900>>
<SETG ROUND %<RSUBR-ENTRY '[DRAGON ROUND #DECL ("VALUE" FIX FLOAT)] 2918>>
<SETG OSUM %<RSUBR-ENTRY '[DRAGON OSUM #DECL ("VALUE" FIX FLOAT FLOAT)] 2935>>
"Contract hours are 9-5, weekdays"
<SETG CSTART <* 3 </ 262144 8>>>
<SETG CEND <+ ,CSTART </ 262144 3>>>
<GDECL (CSTART CEND) FIX>
<SETG CONTRACT-DOWN %<RSUBR-ENTRY '[DRAGON CONTRACT-DOWN #DECL ("VALUE" FLOAT
FIX FIX)] 2993>>
<SETG OPCT %<RSUBR-ENTRY '[DRAGON OPCT #DECL ("VALUE" STRING FIX FIX)] 3080>>
<ENDPACKAGE>

BIN
bin/librm2/dskgrp.nbin Normal file
View File

Binary file not shown.

213
bin/librm2/egroup.fbin Normal file
View File

@@ -0,0 +1,213 @@
'<PCODE "EGROUP">
<PACKAGE "EGROUP">
<ENTRY MAKE-GROUP PRINT-GROUP AMODES ADD-NODE-GROUP AUTO-TABLE AGROUP-TABLE>
<USE "EHACK" "EUTL" "CALSYM" "CALRDR" "XGEDIT">
<SETG GET-MODES %<RSUBR!- '[ %<PCODE!- "EGROUP" 0> GET-MODES #DECL ("VALUE" <
LIST [REST <LIST ANY ANY>]> LIST) READER GET-CONDS OUTCHAN %<RGLOC AMODES T>
"mode" [
"
Modes are Input (node command format), Edit (E/node command format),
Request, which will ask if you want to edit, and Input.if.empty..else.edit
(where empty means never edited - only initialized) which is the default (CRLF or $).
If Input is selected, it should be accompanied with a Condition (see
next argument) of Empty so that filled out-nodes are not clobbered"] ["SYM"]
"Iie/ee"]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,GET-MODES GLUE ![1077953552 4563452672
-16911466224 2080384020 70912 0 262148!]>>
<SETG GET-CONDS %<RSUBR!- '[ %<PCODE!- "EGROUP" 101> GET-CONDS #DECL ("VALUE"
LIST "OPTIONAL" ANY) READER %<RGLOC CONDS T> "
Conditions" [
"
Conditions indicate either that a test will be run to determine whether to
include this node in the automatic mode at run time or that some special action
should be taken while editing the object.
The current choices are: Empty (as determined by the resident empty-checking
routine for the current object type, e.g. default automatic mode), Evaluate
(i.e. something to evaluate at run time), or Edit.with (causes a given field to
be inserted into the editing buffer if the mode is \"Edit\").
If both Empty and an Evaluate are given, they both must be satisfied for the
editing of the node to take place" ""] ["SYM"] CONDITION EMPTY "Empty" EVAL []
"the object" [
"
The form you give will be evaluated when the node is
encountered. If it is false the node will not be edited." ""] ["FORM"] TOEVAL
"Evaluate" CONT GTYPE ALLNODES "the contents of" [
"
The contents of the node you select will be appended to the contents
of the node to be edited. The node to be edited must be a terminal
node. If it contains a string, the \"with\" node must also.
Multiple nodes can be given via multiple conditions." ""] "Contents"]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,GET-CONDS GLUE ![4379120709 4391935
-5162728687 30542663772 30601640753 8522825793 30542118975 -322666752 1065237 0
15 262157!]>>
<SETG CONDS '["Edit.with" CONT "Empty" EMPTY "Evaluate" EVAL]>
<SETG NODE-GROUP-INSERT %<RSUBR!- '[ %<PCODE!- "EGROUP" 276> NODE-GROUP-INSERT
#DECL ("VALUE" <OR ATOM FIX STRING> <PRIMTYPE LIST>) SYM.INSERT GET-CONDS
INSERT.G.EDIT DEPTH.G.EDIT GTYPE ALLNODES "node" ["Select node to insert" ""] [
"SYM"] PT.G.EDIT %<RGLOC AMODES T> "mode" ["Select Mode to insert" ""] OUTCHAN
"INSERTION ONLY IN SECOND POSITION" "CAN'T INSERT"]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,NODE-GROUP-INSERT GLUE ![1076954163
-17112776698 18372117251 -66646799 4580714252 -4026531840 262148!]>>
<SETG NODE-GROUP-CHANGE %<RSUBR!- '[ %<PCODE!- "EGROUP" 378> NODE-GROUP-CHANGE
#DECL ("VALUE" <OR ATOM <PRIMTYPE LIST>> <PRIMTYPE LIST>) SYM.CHANGE GET-CONDS
CHANGE.G.EDIT DEPTH.G.EDIT PT.G.EDIT GTYPE ALLNODES "node" [
"Select node to change existing node to" ""] ["SYM"] %<RGLOC AMODES T> "mode" [
"Select Mode to change to" ""] T]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,NODE-GROUP-CHANGE GLUE ![1078136924
17461870847 -4284727028 4293926785 -3217021952 262148!]>>
<SETG NODE-GROUP-KILL %<RSUBR!- '[ %<PCODE!- "EGROUP" 472> NODE-GROUP-KILL #
DECL ("VALUE" <OR STRING <PRIMTYPE LIST>> <PRIMTYPE LIST> FIX) KILL.G.EDIT
DEPTH.G.EDIT PT.G.EDIT OUTCHAN "CAN'T KILL"]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,NODE-GROUP-KILL GLUE ![67309660 17649696924
13895729152 524294!]>>
<SETG NODE-GROUP-KM %<RSUBR!- '[ %<PCODE!- "EGROUP" 522> NODE-GROUP-KM #DECL (
"VALUE" <OR STRING <PRIMTYPE LIST>> <PRIMTYPE LIST> FIX) CHANGE.G.EDIT PT.G.EDIT
OUTCHAN "CAN'T KILL MODE"]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,NODE-GROUP-KM GLUE ![68419632 285215744
163789888 0 524294!]>>
<SETG NODE-GROUP-IM %<RSUBR!- '[ %<PCODE!- "EGROUP" 581> NODE-GROUP-IM #DECL (
"VALUE" <OR ATOM FIX STRING> <PRIMTYPE LIST> FIX) SYM.INSERT EDITOBJ (<PRIMTYPE
LIST>) DEPTH.G.EDIT GTYPE ALLNODES "node" [
"First select the node. Later select mode/conditions" ""] ["SYM"]
%<RSUBR!- '[ %<PCODE!- "EGROUP" 648> ANONF2!-TMP!- #DECL ("VALUE" <LIST ANY
ANY> ANY) READER GET-CONDS %<RGLOC AMODES T> "mode" [
"Give the mode in which the node should be edited" ""] ["SYM"]]> OUTCHAN
"CAN'T INSERT AT THIS LEVEL"]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,NODE-GROUP-IM GLUE ![68959244 17461870847
-4292895693 -16106127360 524294!]>>
<SETG NODE-GROUP-CM %<RSUBR!- '[ %<PCODE!- "EGROUP" 711> NODE-GROUP-CM #DECL (
"VALUE" <OR ATOM STRING <PRIMTYPE LIST>> <PRIMTYPE LIST> FIX) SYM.CHANGE EDITOBJ
(<PRIMTYPE LIST>) PT.G.EDIT %<RGLOC AMODES T> "mode" [
"What mode do you wish to change the existing one to?" ""] ["SYM"]
%<RSUBR!- '[ %<PCODE!- "EGROUP" 781> ANONF2!-TMP!- #DECL ("VALUE" LIST ANY)
GET-CONDS EDITOBJ PT.G.EDIT]> OUTCHAN "CAN'T CHANGE LIST"]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,NODE-GROUP-CM GLUE ![68535232 201344048
17175690864 -13136560128 524294!]>>
<SETG TABPRINT %<RSUBR!- '[ %<PCODE!- "EGROUP" 824> TABPRINT #DECL ("VALUE"
ATOM FIX) OUTCHAN " " " " " " T]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,TABPRINT GLUE ![1073860369 -13134662848 262148
!]>>
<SETG PRINT-GROUP %<RSUBR!- '[ %<PCODE!- "EGROUP" 864> PRINT-GROUP #DECL (
"VALUE" ANY) MAKEMST READER READARGS GET-TYPE TABPRINT "GTYPES" #SYMTABLE [
SSTOPS ["Nodes" T] "NODES" #FALSE ()] %<RGLOC TYPE-COM-TABLE T> %<TYPE-W
SYMTABLE VECTOR> "of" ["
Type of group to be printed ." ""] ["SYM"] T AGROUP-TABLE "named" [
"
Name of the group(s) to print. False (terminator) will print all of
the existing groups.  will flush the command." ""] ["SYM" "MULT"] OUTCHAN
" group" %<RGLOC OBJVECT T> AUTO-TABLE [
"
Name of the group(s) to print. If false (terminator), all groups will be
printed.  will flush the command." ""] NODE-GROUP
" group
Node____ Mode____ Conditions__________" "Unspecified" " "
" " " " %<RGLOC NULL T>]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,PRINT-GROUP GLUE ![17251434288 553646097
1900265535 -532397055 262144 16704 18321702917 17180917760 1140916225
-16374501376 -17175411648 268435504 -17179866112 18544154641 -4278192111
4563664897 0 4378870720 268451840 272892160 4546825264 13892600836 17183033091
753992716 201851139 54267904 1426341952 -17166303228 3222073616 12888293396
22835301383 -12884901888 2!]>>
<SETG MAKE-GROUP %<RSUBR!- '[ %<PCODE!- "EGROUP" 1443> MAKE-GROUP #DECL (
"VALUE" ANY ANY) GET-TYPE READER MAKE-NODE-GROUP MAKE-ABS-GROUP T AUTO-TABLE
"named" [
"
Indicate the name of the node group you wish to operate on. If you choose an
existing name you may either edit it or replace it." ""] ["SYM" "ATOM"]
AGROUP-TABLE [
"
Indicate the name of the object group you wish to operate on. If you
choose an existing group you may either edit it or replace it." ""]]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,MAKE-GROUP GLUE ![1078206468 17455771663
-133103472 -4293901376 17177789442 17179869184 262148!]>>
<SETG MAKE-ABS-GROUP %<RSUBR!- '[ %<PCODE!- "EGROUP" 1543> MAKE-ABS-GROUP #DECL
("VALUE" ANY <OR ATOM SYMBOL> ATOM) READER SYM.EDIT POS NO-DUPES READARGS
SYM-SORT COMMAND-UPDATE FOO (LIST) %<TYPE-C SYMBOL VECTOR> AGROUP-TABLE []
"Edit existing group?" [
"
If you wish to replace the existing group, just type a terminator.
If you wish to edit the existing group, type anything (e.g., T) followed
by a terminator." ""] ["ANY"] %<RGLOC OBJVECT T> ROBL %<RGLOC OBJLOADTAB T> %<
TYPE-W SYMTABLE VECTOR> "object" [
"
Select an object or group of them to include here.
If a group is selected, it will be expanded to its constituents." ""] ["SYM"]
"consisting of objects" [
"
Select the objects and groups of objects to comprise the new group." ""] ["SYM"
"MULT"]]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,MAKE-ABS-GROUP GLUE ![68508796 4580655104
-4294967169 -29080572 16777219 1024 17120320 16109486076 100667652 1140851460
4460800 1073807360 87107 541065220 21613278015 -536591865 17179886608 4563405833
17664 284164096 17842244 3154944 18088896 4294967872 0 524294!]>>
<SETG MAKE-NODE-GROUP %<RSUBR!- '[ %<PCODE!- "EGROUP" 1991> MAKE-NODE-GROUP #
DECL ("VALUE" ATOM <OR ATOM FALSE SYMBOL> ATOM) READER G.EDIT MAKEMST READARGS
GET-MODES GTYPE (ATOM) EDIT.LOCAL (<OR FALSE LIST>) %<TYPE-C SYMBOL VECTOR>
NODE-GROUP [] "Edit existing group?" [
"
If non-false, you may edit the group using the muddle editor. If the group has
specifications for modes (for automatic mode), the group will appear as a list of
2-lists with the node name and the mode operative. The two modes available now
are Edit and Input (equivalent to E/ and node commands). A third choice is an object
of type false, which will cause a request to occur at the time the node is reached.
If there are no mode specifications, the group will be a list of node names." ""
] ["ANY"] OPATH "INSERT" %<RGLOC NODE-GROUP-INSERT T> "CHANGE" %<RGLOC
NODE-GROUP-CHANGE T> "KILL" %<RGLOC NODE-GROUP-KILL T> "IM" %<RGLOC
NODE-GROUP-IM T> "Insert a node with a mode specified" "CM" %<RGLOC
NODE-GROUP-CM T> "Change a node to have a mode specified" "KM" %<RGLOC
NODE-GROUP-KM T> "Kill the mode for the next object" "nodes&n-groups" ALLNODES
AUTO-TABLE "consisting of nodes" [
"
These nodes will comprise the group.
Node-groups may be given, in which case they will be expanded to
their constituents and duplicates eliminated" ""] ["SYM" "MULT"] "Specify mode?"
[
"
If non-false, you will be asked for the mode of operation for each of the nodes
in the group. The form of the request will be .. Unique.name mode:, etc.
Possible answers include the modes Input and Edit which correspond to fill-node
commands and E/ commands. Other modes are explained in the next argument" ""] T
]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,MAKE-NODE-GROUP GLUE ![68508732 30585144349
17887236 34359625668 16110256131 -4294709248 16915366896 16110257088 8841720048
251658371 -508 17180979200 4567597312 84 1413757953 4194304 18270404864 4276481
4294967381 4362076225 17197711424 67130372 1162100752 1130500 18186510336
4546691140 16106127360 1006698496 872415232 0 524294!]>>
<SETG ADD-NODE-GROUP %<RSUBR!- '[ %<PCODE!- "EGROUP" 2525> ADD-NODE-GROUP #DECL
("VALUE" ANY ATOM ATOM LIST) AUTO-TABLE NODE-GROUP]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,ADD-NODE-GROUP GLUE ![4210748 268435713
16792580 0 786440!]>>
<ENDPACKAGE>

219
bin/librm2/ehack.fbin Normal file
View File

@@ -0,0 +1,219 @@
'<PCODE "2EHACK">
<PACKAGE "EHACK">
<ENTRY INIT-NODE INIT-TYPE FILL-NODE EDIT-NODE RECOVER.EDIT PRINT-NODE COPY-NODE
APPEND-NODE APPENDER MAKE-SCRATCH EDIT-SCRATCH OPEN-OBJECT OPEN-SOME-OBJECT
APPEND-SCRATCH SCRATCH-TABLE DECL-TEST AUTO-MODE GROUP-AUTO COMMAND-UPDATE
GROUP-LOOP AUTO-MODE-ACT FILLER-ACT SEARCH GET-TYPE CLOSE-ABSTR ADD-OBJECT ABUF
EDTD-STR LEVEL-BUF OPATH SCRATCHES SCRATCH OBJLOADTAB OBJONLYTAB NODE ABSEDMODE
UNAMEPOS AUTONAME SPECIAL-CHECKS SCNAME VERIFY VERIFY-MQ NODE-GROUP OCOMLIST
OBJVECT NEXTPOS OBJOPEN OBJTYPE OBJNAME AUTODEF AVNODES APPEND ALLNODES
TYPE-TABLE TYPE-COM-TABLE>
<USE "BUF" "COMMAND" "TTY" "EGROUP" "CALCOM" "NSTRUC" "EUTL" "BLPRIN" "JOBS"
"CALRDR" "CALSYM" "UVHACK" "MUDCAL">
<SETG TYPE-TABLE []>
<SETG OCOMLIST ()>
<SETG OBJVECT <REST <IVECTOR 100 0> 100>>
<SET EVENS-LIST ()>
<SET NEXTPOS 1>
<SETG AB-OB (<ROOT> <GET PACKAGE OBLIST> <GET RPACKAGE OBLIST>)>
<SETG START-EHACK %<RSUBR!- '[ %<PCODE!- "2EHACK" 0> START-EHACK #DECL ("VALUE"
<OR ATOM FALSE>) EDIT-NODES BGSTSORT FILL-NODE TTY-SET RUN TTY-GET MAKE-TABLE
APPENDER MAKE-COPY SYM-SORT NPUT AUTORET!-IEUTL PUSH-T AUTOBACKUP IMBUF BUFTECO
TECO-EDIT ADDFILE MYPPRINT BLOCK-PRINT READARGS BUFTOS GETSTR ADDSTRING BUFCLEAR
NNTH READER MAKEBST BSTSORT FUNNY-PNAME DECLEXTRACT ADDTABLE MAKEBGST USE
BUFMAKE MAKESST CALINIT OBJLOADTAB PREFIX-CHRTABLE!-IEUTL CHRTABLE %<RGLOC
SPCCHARS T> PREFIX-XSPCCHARS!-IEUTL %<RGLOC XSPCCHARS T> "MODES" "Edit" "Input"
"Request" "Input.if.empty..else.edit" "Iie/ee" %<RGLOC AMODES T> %<RGLOC
CONDS!-IEGROUP T> "B" "SCRATCHES" %<RGLOC SCRATCH-TABLE T> EHACKBUFFER!-IEUTL
LEVEL-BUF "OBJLOAD" %<RGLOC OBJLOADTAB T> "OBJONLY" %<RGLOC OBJVECT T> %<RGLOC
OBJONLYTAB T> "OBJ-COMS" %<RGLOC TYPE-COM-TABLE T> "YESNO" "Yes" T "No" %<RGLOC
YES/NO T> OBLIST (ANY) "ECOM" "Edit-node-commands" %<RGLOC DO-NODE-EDIT T> %<
RGLOC NODE-EDIT-COMMANDS T> "Open-commands" %<RGLOC DO-OPEN-OBJECT T> %<RGLOC
OPEN-COMMANDS T> "Print-commands" %<RGLOC DO-PRINT-NODE T> %<RGLOC
PRINT-COMMANDS T> "Nodes-commands" %<RGLOC DO-FILLER T> %<RGLOC NODE-COMMANDS T>
%<RSUBR!- '[ %<PCODE!- "2EHACK" 6043> ANONF0!-TMP #DECL ("VALUE" ANY ANY ANY)
]> OPATH EMPTY-NODE %<RGLOC TYPE-TABLE T> %<TYPE-W SYMTABLE VECTOR> OBJOPEN %<
RGLOC OBJTYPE T> %<RGLOC UNAMEPOS T> "APPEND" APPEND OUTCHAN " -Appending"
"AUTO" " -Default automatic mode" "SYMBOL" <OR APPLICABLE <LIST SYMTABLE VECTOR>
> " -Symbol input" NODE-SYMBOLS NODE-SYNTAX " -Group node" GROUP-NODE
"BAD ELEMENT OF GROUP NODE" "IN" ALLNODES AUTO-TABLE "AU" ".default"
AGROUP-TABLE "A" NODE-GROUP "of object-type" [
"What type of object do you want to work with the groups of?" ""] ["SYM"] NODE (
ATOM) %<RGLOC OBJOPEN T> ABUF (BUFFER) FILLER-ACT (ACTIVATION) #FALSE (
"Not a node of this type of object") REALDECL "BUFFER" STRING " (BUFFER): "
" (BUFFER): -continued-" SYMBOLS "[continued]" "" "
DECL of " " or " #FALSE (#FALSE ()) AUTO-MODE-ACT #FALSE ("Null line") %<
TYPE-C SYMBOL VECTOR> "
Non-terminal node. Do you wish to edit internal nodes?" [
"
If a positive answer is given, you will be placed in an automatic mode
containing the nodes below your present position. As usual, a
control-A may be typed to leave the automatic mode, and a control-up-arrow
may be used to back up" ""] ("Iie/ee") BUFFER SRET (<OR VECTOR FALSE>) EDTD-STR
(STRING) " ;\"" " in " "\"
" "PRINT" "XAB" ">" "DSK" "HUDINI" "COMMON" "INT:" %<RSUBR!- '[ %<PCODE!-
"2EHACK" 6061> ANONF4!-TMP #DECL ("VALUE" BUFFER CHARACTER) ADDCHR EBUF %<TYPE-W
BUFFER VECTOR>]> %<RGLOC ABSEDMODE T> "TECO" "READ" %<RGLOC LASTEDIT T> #FALSE (
"NOT EXACTLY ONE ITEM IN EDIT RESULT") NODE-UPDATER #FALSE (
"Object does not match DECL") "Can't put " " node into " " object." #FALSE (
"Open object switched since last an error was recorded") #FALSE (
"Attempt to append to non-terminal node") <TUPLE [REST STRING]>
"Attempt to append illegal item" SCNAME (<OR FIX ATOM FALSE>) (<OR ATOM FALSE>)
SCRATCH #FALSE ("No (existing) scratch specified") #FALSE ("No node specified")
(<OR FALSE ATOM FIX>) %<RGLOC SCRATCHES T> " -continued- " %<TYPE-W BUFFER
VECTOR> "C"
"
*** return from TECO by typing 'MC$$' where
'$' is ESCAPE (altmode) -- otherwise the buffer will
be lost.
*** TECO is being continued !!!
" BUFTECO-ACT "ER" "^Y" "COMSYS" %<RGLOC CTL-Z-FCN T>
"
An error occurred in returning from TECO: " "reason unknown"
"
The buffer has been left unchanged.
"
"An empty string was returned from TECO.
The buffer has been left unchanged.
" GAACT GROUP-LOOP "Opening " " automatic mode." "Object wrong type - " AUTONAME
(<OR LIST ATOM FALSE>) ("Input" "Empty") (<OR ATOM LIST>)
"Automatic mode empty"
"Permitting recover from DECL mis-match
ERRET any object to continue." " automatic mode completed."
MAKE-THE-COMPILER-HAPPY MODE "Mode?" [
"
Do you want to input to this node, edit it, or ignore this request" ""] "Empty"
"current backup" "back to node" [
"
Automatic-mode will position itself at the indicated node.
No value will back-up out of this call to automatic-mode." ""] "SYM" "Evaluate"
"Contents" SPECIAL-CHECKS ALLMODES UNVERIFIED-OBJECT!-ERRORS %<RGLOC AVNODES T>
"E/" %<RGLOC OBJNAME T> %<RGLOC OCOMLIST T> EVENS-LIST "LOADED" "OPEN-COMMANDS"
"Reloading " "Flush old copy?" [
"
Yes will replace the existing copy, No will place the new copy under a new name,
and ctl-R will flush the new copy." ""] "Input flushed" "Object now called "
NEXTPOS]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,START-EHACK PGLUE ![715827882 -22906492246
-22817013761 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 0 0!]>>
<GDECL (OBJVECT TYPE-TABLE) VECTOR (OBJLOADTAB OBJONLYTAB TYPE-COM-TABLE)
SYMTABLE (OCOMLIST) LIST>
<SETG INIT-TYPE %<RSUBR-ENTRY '[START-EHACK INIT-TYPE #DECL ("VALUE" ATOM ATOM <
UVECTOR [REST FIX]> <LIST [4 APPLICABLE]> APPLICABLE APPLICABLE "OPTIONAL"
APPLICABLE ANY)] 298>>
<SETG INIT-NODE %<RSUBR-ENTRY '[START-EHACK INIT-NODE #DECL ("VALUE" ATOM ATOM <
VECTOR [REST LIST]> "OPTIONAL" <OR 'T FALSE>)] 485>>
<SETG GET-TYPE %<RSUBR-ENTRY '[START-EHACK GET-TYPE #DECL ("VALUE" ANY)] 1136>>
<SETG LASTEDIT ()>
<SETG SCRATCHES ()>
<SETG ABSEDMODE "IMEDIT">
<SETG FILL-NODE %<RSUBR-ENTRY '[START-EHACK FILL-NODE #DECL ("VALUE" <OR ATOM
FALSE> ATOM)] 1172>>
<SETG DOWN? %<RSUBR-ENTRY '[START-EHACK DOWN? #DECL ("VALUE" <OR ATOM FALSE>
ATOM)] 1623>>
<SETG PRINT-NODE %<RSUBR-ENTRY '[START-EHACK PRINT-NODE #DECL ("VALUE" ANY <OR
FALSE ATOM> "OPTIONAL" <PRIMTYPE VECTOR>)] 1681>>
<SETG EDIT-NODES %<RSUBR-ENTRY '[START-EHACK EDIT-NODES #DECL ("VALUE" ATOM ANY
<OR VECTOR FALSE> ATOM "OPTIONAL" ANY <OR ATOM FALSE>)] 1796>>
<SETG DECL-TEST %<RSUBR-ENTRY '[START-EHACK DECL-TEST #DECL ("VALUE" <OR ATOM <
FALSE STRING [REST STRING]>> ANY <OR VECTOR FIX> ANY <PRIMTYPE VECTOR>)] 2241>>
<SETG EDIT-NODE %<RSUBR-ENTRY '[START-EHACK EDIT-NODE #DECL ("VALUE" ANY <OR
ATOM FALSE>)] 2319>>
<SETG COPY-NODE %<RSUBR-ENTRY '[START-EHACK COPY-NODE #DECL ("VALUE" ANY <OR
LIST ATOM> STRUCTURED "OPTIONAL" <PRIMTYPE VECTOR>)] 2408>>
<SETG RECOVER.EDIT %<RSUBR-ENTRY '[START-EHACK RECOVER.EDIT #DECL ("VALUE" <OR
ATOM <FALSE STRING [REST STRING]>>)] 2634>>
<SETG APPENDER %<RSUBR-ENTRY '[START-EHACK APPENDER #DECL ("VALUE" <OR FALSE
STRING VECTOR> ATOM "TUPLE" TUPLE)] 2698>>
<SETG APPEND-NODE %<RSUBR-ENTRY '[START-EHACK APPEND-NODE #DECL ("VALUE" <OR
ATOM FALSE> <OR ATOM FALSE> ANY)] 2785>>
<SETG EDIT-SCRATCH %<RSUBR-ENTRY '[START-EHACK EDIT-SCRATCH #DECL ("VALUE" <OR
ATOM FALSE> <OR ATOM FIX> ATOM)] 2836>>
<SETG APPEND-SCRATCH %<RSUBR-ENTRY '[START-EHACK APPEND-SCRATCH #DECL ("VALUE" <
OR ATOM FALSE> <OR FIX ATOM FALSE> <OR ATOM FALSE> "OPTIONAL" <OR 'T FALSE>)]
2855>>
<SETG MAKE-SCRATCH %<RSUBR-ENTRY '[START-EHACK MAKE-SCRATCH #DECL ("VALUE"
BUFFER <OR FALSE ATOM FIX>)] 2999>>
<SETG CTL-Z-FCN %<RSUBR-ENTRY '[START-EHACK CTL-Z-FCN #DECL ("VALUE" STRING
CHANNEL STRING)] 3140>>
<SETG TECO-EDIT %<RSUBR-ENTRY '[START-EHACK TECO-EDIT #DECL ("VALUE" <OR FALSE
STRING> STRING)] 3162>>
<SETG GROUP-AUTO %<RSUBR-ENTRY '[START-EHACK GROUP-AUTO #DECL ("VALUE" ANY <OR
FALSE ATOM> <OR FALSE LIST VECTOR>)] 3275>>
<SETG AUTO-MODE %<RSUBR-ENTRY '[START-EHACK AUTO-MODE #DECL ("VALUE" <OR ATOM
STRING <FALSE FALSE [REST FALSE]>> <OR LIST ATOM FALSE> "OPTIONAL" LIST)] 3530>>
<SETG DO-CONDS %<RSUBR-ENTRY '[START-EHACK DO-CONDS #DECL ("VALUE" <OR ATOM
FALSE LIST> LIST ANY)] 4216>>
<SETG SEARCH %<RSUBR-ENTRY '[START-EHACK SEARCH #DECL ("VALUE" ANY ATOM
"OPTIONAL" ANY)] 4405>>
<SETG DO-FILLER %<RSUBR-ENTRY '[START-EHACK DO-FILLER #DECL ("VALUE" <OR ATOM
FALSE> VECTOR)] 4504>>
<SETG DO-PRINT-NODE %<RSUBR-ENTRY '[START-EHACK DO-PRINT-NODE #DECL ("VALUE" ANY
VECTOR)] 4524>>
<SETG DO-NODE-EDIT %<RSUBR-ENTRY '[START-EHACK DO-NODE-EDIT #DECL ("VALUE" ANY
VECTOR)] 4544>>
<SETG DO-OPEN-OBJECT %<RSUBR-ENTRY '[START-EHACK DO-OPEN-OBJECT #DECL ("VALUE" <
OR ATOM FALSE> ANY)] 4564>>
<SETG OPEN-SOME-OBJECT %<RSUBR-ENTRY '[START-EHACK OPEN-SOME-OBJECT #DECL (
"VALUE" <OR ATOM FALSE> ANY)] 4581>>
<SETG VERIFY %<RSUBR-ENTRY '[START-EHACK VERIFY #DECL ("VALUE" ANY ANY)] 4617>>
<SETG VERIFY-MQ %<RSUBR-ENTRY '[START-EHACK VERIFY-MQ #DECL ("VALUE" VECTOR <
PRIMTYPE VECTOR>)] 4633>>
<SETG OPEN-OBJECT %<RSUBR-ENTRY '[START-EHACK OPEN-OBJECT #DECL ("VALUE" ANY ANY
"OPTIONAL" ANY <PRIMTYPE VECTOR>)] 4683>>
<SETG CLOSE-ABSTR %<RSUBR-ENTRY '[START-EHACK CLOSE-ABSTR #DECL ("VALUE" ANY
LIST "OPTIONAL" <OR FALSE 'T>)] 5166>>
<SETG COMMAND-UPDATE %<RSUBR-ENTRY '[START-EHACK COMMAND-UPDATE #DECL ("VALUE"
ANY)] 5300>>
<SETG ADD-OBJECT %<RSUBR-ENTRY '[START-EHACK ADD-OBJECT #DECL ("VALUE" <OR FIX
FLOAT> <PRIMTYPE VECTOR>)] 5570>>
<ENDPACKAGE>

BIN
bin/librm2/emonit.nbin Normal file
View File

Binary file not shown.

BIN
bin/librm2/erorc2.gbin Normal file
View File

Binary file not shown.

174
bin/librm2/eutl.fbin Normal file
View File

@@ -0,0 +1,174 @@
'<PCODE "EUTL">
<PACKAGE "EUTL">
<ENTRY DECLEXTRACT N-GET-RID-OF PARSEABLE MAKE-COPY PUSHRET PUSH-T NO-DUPES
KEYWORD-CHARS PRINT-STATUS POS SYM-SORT MAKE-TABLE MYPPRINT CALL/APPLY AFIND
AUTOBACKUP LOAD-ACTION OPEN-ACTION>
<USE "EHACK" "CALSYM" "BUF" "TTY" "CALRDR" "NSTRUC" "STR" "LEVEL" "COMMAND">
<OR <LOOKUP "MULT" <ROOT>> <INSERT "MULT" <ROOT>>>
<SETG LOAD-ACTION '<CALICO-COMMAND #FUNCTION ((TYP "TUPLE" X) <APPLY <1 <3 <MEMQ
.TYP ,TYPE-TABLE>>> !.X>) '[<COND (<LENGTH? <2 ,TYPE-COM-TABLE> 3> <PROG () <
COND (<NOT <GASSIGNED? OBJTYPE>> <ERROR USE-A-PACKAGE-DEFINING-A-TYPE!-ERRORS
E.G.-AHACK-OR-IIEDIT!-ERRORS> <AGAIN>)>> <PRINT "of type"> <PRINC <PNAME ,
OBJTYPE>> <CHTYPE (,OBJTYPE) FALSE>) (,TYPE-COM-TABLE)> "of type" '[
"name the sort of object(s) you wish to load" ""] '["SYM"] [] "named" '[
"
Name of a file of objects to be loaded for composing" ""] '["FILE"] '[]
"with group name (opt)" '[
"
Optional group name (as in GROUP-LOAD). This may be useful for dumping
your completed objects when you are finished" ""] '["ATOM"]]>>
<SETG OPEN-ACTION '<CALICO-COMMAND ,OPEN-SOME-OBJECT [,OBJONLYTAB
"of unique name" '["
Open the designated object for composing" ""] '["SYM"]]>>
<SETG DECLEXTRACT %<RSUBR!- '[ %<PCODE!- "EUTL" 0> DECLEXTRACT #DECL ("VALUE"
LIST <OR VECTOR ATOM FORM> "OPTIONAL" <OR ATOM FALSE>) MAKE-COPY BUFCLEAR NPUT
UPPERCASE BUFTOS ADDCHR BUFLENGTH ADD-WORDS RETYPE-BUFFER!-ICALRDR NNTH
DECL-TEST SEARCH APPEND-NODE ADDSTRING TTY-SET BUFMAKE TTY-GET VERIFY LEVEL
READER PPRINT BUFPRINT T () #FALSE () VECTOR (OR REST) MULT AUTO-MODE-ACT
OUTCHAN "C" SCNAME " scratch (BUFFER): " ABUF NODE " (BUFFER): " %<TYPE-W
BUFFER VECTOR> %<RGLOC OBJVECT T> %<TYPE-C SYMBOL VECTOR> OBJOPEN
" first get objects: " %<RGLOC LOAD-ACTION T> LOAD " must open an object" %<
RGLOC OPEN-ACTION T> GROUP-LOOP #SYMTABLE [SSTOPS ["Group.automatic.mode" T
"Open object" #FALSE ()] "LEAVERS" #FALSE ()] "Leave" [
"
If Group.automatic.mode, the entire group.automatic.mode will be flushed.
Otherwise, the open object will be flushed and the group.automatic mode will continue."
""] ["SYM"] "Illegal activation to GROUP.AUTOMATIC.MODE. Report to MARC."
PSTATUS #FALSE ("Can't pop") STAT PUSH/POP-ACT %<TYPE-C BUFFER VECTOR> %<RGLOC
OBJOPEN T> AUTONAME (ACTIVATION) (ANY) EDTD-STR LEVEL-BUF %<RGLOC TYPE-TABLE T>
APPEND " scratch (BUFFER):
" CHRTABLE %<RGLOC CHARCATCHER T> %<RGLOC OBJTYPE T> EHACKBUFFER XKEYBREAKS
PARSE-BREAKS STRING "Current LISTEN level: " " Open abstract: " %<RGLOC
UNAMEPOS T> "-none-" "Returning to " "LISTEN level: " " Group automatic mode: "
"Default" " Automatic mode: " " Node: " " Scratch: "]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,DECLEXTRACT PGLUE ![0 0 0 0 0 0!]>>
<SETG AUTOBACKUP %<RSUBR-ENTRY '[DECLEXTRACT AUTOBACKUP #DECL ("VALUE" ANY
"OPTIONAL" ANY ANY)] 349>>
<SETG PBUFHEAD %<RSUBR-ENTRY '[DECLEXTRACT PBUFHEAD #DECL ("VALUE" FIX BUFFER
CHARACTER)] 404>>
<SETG N-GET-RID-OF %<RSUBR-ENTRY '[DECLEXTRACT N-GET-RID-OF #DECL ("VALUE"
STRUCTURED STRUCTURED FIX FIX)] 478>>
<SETG MAKE-TABLE %<RSUBR-ENTRY '[DECLEXTRACT MAKE-TABLE #DECL ("VALUE" VECTOR
STRUCTURED)] 537>>
<SETG AEXPAND %<RSUBR-ENTRY '[DECLEXTRACT AEXPAND #DECL ("VALUE" <LIST [REST <
PRIMTYPE VECTOR>]> <LIST [REST FIX]>)] 601>>
<SETG SYM-SORT %<RSUBR-ENTRY '[DECLEXTRACT SYM-SORT #DECL ("VALUE" LIST LIST)]
661>>
<SETG AFIND %<RSUBR-ENTRY '[DECLEXTRACT AFIND #DECL ("VALUE" STRUCTURED ANY
STRUCTURED)] 760>>
<SETG MYPPRINT %<RSUBR-ENTRY '[DECLEXTRACT MYPPRINT #DECL ("VALUE" ANY ANY
CHANNEL)] 831>>
<SETG CALL/APPLY %<RSUBR-ENTRY '[DECLEXTRACT CALL/APPLY #DECL ("VALUE" ANY FORM
ATOM)] 857>>
<SETG AUTORET %<RSUBR-ENTRY '[DECLEXTRACT AUTORET #DECL ("VALUE" ANY "OPTIONAL"
ANY ANY)] 935>>
<SET PSTATUS ()>
<SETG PUSHRET %<RSUBR-ENTRY '[DECLEXTRACT PUSHRET #DECL ("VALUE" FALSE
"OPTIONAL" ANY CHARACTER)] 1062>>
<SETG PUSH-T %<RSUBR-ENTRY '[DECLEXTRACT PUSH-T #DECL ("VALUE" <OR ATOM FALSE
FIX STRING> "OPTIONAL" BUFFER CHARACTER)] 1178>>
<SET PREFIX-CHRTABLE [!" ,PBUFHEAD !" ,AUTOBACKUP !" ,PUSH-T !" ,PUSHRET !"
,AUTORET !" <FUNCTION (BUF CHR) <PRINC
"
Standard Buffer Commands
ESC___ Returns from buffer
^Q Quotes the next character
^X Deletes current line
^W Deletes word back to separator
^@ Clears buffer
^E Edit the buffer
^F Inserts a file into the buffer
^D Displays the buffer on next line
^L Clears the screen and displays the buffer
Editing Commands
 Causes automatic mode to terminate, if running
 Causes automatic mode to backup one step, if running
 PUSHes (call to LISTEN)
 POPs (returns to last  call, printing current status)
 Prints this information (would you believe Verbose??)">>]>
<SET PREFIX-XSPCCHARS '[!" <PUSH-T> !" <COND (<ASSIGNED? NODE> <PRINT <NNTH ,
OBJOPEN <1 <SEARCH .NODE>>>> <RETYPE-BUFFER!-ICALRDR T>) (<
RETYPE-BUFFER!-ICALRDR T>)> !" <AUTOBACKUP> !" <PUSHRET> !" <AUTORET> !" <
COND (<ASSIGNED? NODE> <EDIT-NODE .NODE> <ASSIGNED? FILLER-ACT> <LEGAL? .
FILLER-ACT> <RETURN T .FILLER-ACT>)>]>
<SETG POS %<RSUBR-ENTRY '[DECLEXTRACT POS #DECL ("VALUE" <OR FALSE FIX> ANY
STRUCTURED)] 1705>>
<SETG KEYWORD-CHARS %<RSUBR-ENTRY '[DECLEXTRACT KEYWORD-CHARS #DECL ("VALUE" ANY
ANY "TUPLE" <TUPLE [REST LIST]>)] 1747>>
<SETG CHARCATCHER %<RSUBR-ENTRY '[DECLEXTRACT CHARCATCHER #DECL ("VALUE" <OR
BUFFER FALSE> BUFFER CHARACTER)] 1853>>
<SETG DESEX %<RSUBR-ENTRY '[DECLEXTRACT DESEX #DECL ("VALUE" BUFFER BUFFER
"OPTIONAL" BUFFER)] 1905>>
<SETG ADD-WORDS %<RSUBR-ENTRY '[DECLEXTRACT ADD-WORDS #DECL ("VALUE" BUFFER ATOM
)] 2020>>
<SETG PARSEABLE %<RSUBR-ENTRY '[DECLEXTRACT PARSEABLE #DECL ("VALUE" <OR FALSE
ATOM> STRING)] 2100>>
<SET PARSE-BREAKS <STRING <ASCII 0> <ASCII 9> <ASCII 10> <ASCII 13> <ASCII 27> <
ASCII 33> <ASCII 32>>>
<SET XKEYBREAKS <MAPF ,STRING ,ASCII (13 9 10 32 <ASCII !",> <ASCII !".>)>>
<SETG NO-DUPES %<RSUBR-ENTRY '[DECLEXTRACT NO-DUPES #DECL ("VALUE" ANY
STRUCTURED)] 2189>>
<SETG MAKE-COPY %<RSUBR-ENTRY '[DECLEXTRACT MAKE-COPY #DECL ("VALUE" ANY ANY)]
2260>>
<SETG PRINT-STATUS %<RSUBR-ENTRY '[DECLEXTRACT PRINT-STATUS #DECL ("VALUE" <OR
ATOM FALSE> "OPTIONAL" <OR FALSE 'T>)] 2354>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,DECLEXTRACT GLUE ![336613392 13757072401
22085633 21475119375 21211988036 1376513 4299231573 1895825409 17825795
-8854432432 4563404096 17251176516 22898017404 4369498176 18275635217 68230916
4428926977 4294967296 18539872256 267280 22620934484 3260924 268436501
18048905216 12898475123 -13957856452 -16336814076 0 1094713344 20480 5637144577
0 32506885 65791 1409548480 262145 18589155344 4278452292 30408756 4294968336
17246978053 21815644160 263105 22817030144 4101 17252226304 1049664 4304404496
3317781772 -3488866435 20758712112 3242228992 17516483669 17180917760
18017797628 471613439 -8518111217 -17150296975 -16647188480 4379120913
17252548608 203223900 3295674880 7529242388 25220362245 66820 5659251716 815152
4299620865 2150632451 7529235228 12852288 8594133056 24826552092 33405475964
30586724592 30316429320 17322432 5638582272 -17179868196 3429941248 -17127640316
21944643623 4367447808 826752017 -17170382717 808193032 537658343 7633648640
12889431040 -21433008127 21549286720 23555223552 12633168 1 1342177348 64
1074249733 4195072 18022417 202129456 1073745920 5641338880 269533184 1141054464
4769071104 21543273920 -16970153727 5637144576 29470720 34076 7247893872 8406786
3292987394 2048 24696062976 738721857 22615932932 262175 22551724157 -2947279073
33554432256 22817030148 5368709120 16778240 335544336 18052284416 4362097664
16777249 269488389 16 21543277888 -13941751028 -3757309172 -3460251520
12892489484 -3237915391 22283264 -34351514617 3275493379 51179521 1191182400 768
7767855364 30281826576 18254725168 485736449 4366732528 285491217 50339059
-17178753936 -13153267709 69703 3472888064 12885017557 17469362176 16777215
262160 524300 372 262509 524651 524698 786918 262749 262809 525054 525125 525151
962 263099 525237 1085 263222 525364 1205 263340 525480 525999 526147 264063
526205 264248 264337 2373 264511!]>>
<ENDPACKAGE>

16
bin/librm2/evil.fbin Normal file
View File

@@ -0,0 +1,16 @@
'<PCODE "EVIL">
<PACKAGE "EVIL">
<ENTRY EVIL GET-TTY>
<SETG EVIL %<RSUBR!- '[ %<PCODE!- "EVIL" 0> EVIL #DECL ("VALUE" <OR FALSE
STRING> "ARGS" ANY) GET-TTY "PRINT" "JUNK >" OUTCHAN (CHANNEL) "DONE"]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,EVIL GLUE ![4379120709 68222721 30316445953
4294967296 4651495168 1141391360 0 15 262157!]>>
<SETG GET-TTY %<RSUBR!- '[ %<PCODE!- "EVIL" 116> GET-TTY #DECL ("VALUE" ANY) T
]>>
<ENDPACKAGE>

33
bin/librm2/exputi.fbin Normal file
View File

@@ -0,0 +1,33 @@
'<PCODE "1EXPUTI">
<PACKAGE "EXPUTI">
<ENTRY LA-EXP P-EXP L-EXP S-EXP GETDB UC?>
<USE "LIBDAT" "VCTMAN" "USRUTI">
<SETG LA-EXP %<RSUBR!- '[ %<PCODE!- "1EXPUTI" 0> LA-EXP #DECL ("VALUE" <OR LIST
!<FALSE STRING!>> LIST LIST) LOADIT VCTBNS UNIQUIFY #FALSE ("BAD DATA BASE SPEC"
) RECURSION-DEPTH-EXCESSIVE S-EXP <LIST [REST <OR STRING LIST>]>
"COMDMN-DEFAULT-EXPANSION-DATA" %<RGLOC DATA T> #FALSE ("DATA-BASE-NOT-FOUND") <
VECTOR [REST STRING <LIST [REST <OR STRING ATOM>]>]> #FALSE (
"IMPROPER DATA BASE FORMAT") T]>>
<AND <ASSIGNED? GLUE> .GLUE <PUT ,LA-EXP PGLUE ![721420272 0!]>>
<SETG P-EXP %<RSUBR-ENTRY '[LA-EXP P-EXP #DECL ("VALUE" <LIST [REST <OR STRING
ATOM>]> LIST LIST)] 58>>
<SETG L-EXP %<RSUBR-ENTRY '[LA-EXP L-EXP #DECL ("VALUE" <LIST [REST <OR STRING
ATOM>]> <LIST [REST <OR STRING ATOM>]> VECTOR)] 133>>
<SETG S-EXP %<RSUBR-ENTRY '[LA-EXP S-EXP #DECL ("VALUE" <LIST [REST <OR STRING
ATOM>]> STRING <VECTOR [REST STRING LIST]> "OPTIONAL" FIX)] 223>>
<SETG GETDB %<RSUBR-ENTRY '[LA-EXP GETDB #DECL ("VALUE" <OR !<FALSE STRING!> <
LIST [REST ANY]>> LIST)] 389>>
<SETG UC? %<RSUBR-ENTRY '[LA-EXP UC? #DECL ("VALUE" <OR FALSE STRING> STRING)]
585>>
<ENDPACKAGE>

BIN
bin/librm2/extern.nbin Normal file
View File

Binary file not shown.

BIN
bin/librm2/fdate.gbin Normal file
View File

Binary file not shown.

BIN
bin/librm2/filapp.nbin Normal file
View File

Binary file not shown.

Some files were not shown because too many files have changed in this diff Show More