PDP-10.its/bin/librm2/ehack.fbin

'<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>