mirror of
https://github.com/PDP-10/its.git
synced 2026-04-26 12:17:41 +00:00
Added files and directories that support the MDL 55 runtime.
This commit is contained in:
Eric Swenson
219
bin/librm2/ehack.fbin
Normal file
219
bin/librm2/ehack.fbin
Normal 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>
|
||||
Reference in New Issue
Block a user