'<PCODE "4HELPLD">

<BLOCK (<ROOT>)> 

<NEWTYPE INTERNAL-RSUBR WORD> 

<NEWTYPE INTERNAL-RSUBR-TABLE UVECTOR> 

<ENDBLOCK> 

<SETG LOC  %<RSUBR!- '[ %<PCODE!- "4HELPLD" 0> LOC #DECL ("VALUE" FIX ANY) %<
TYPE-C INTERNAL-RSUBR WORD> "COMPILE" T "TUPLE" "OPTIONAL" 
BAD-CALL-TO-INTERNAL-RSUBR!-RSUBRS %<TYPE-C INTERNAL-RSUBR-TABLE UVECTOR> FIX 
BAD-CALL-TO-INTERNAL-RSUBR!-ERRORS %<TYPE-W INTERNAL-RSUBR WORD> OUTCHAN 
"%<INTERNAL-RSUBR " " " ">" CANT-PRINT-INTERNAL-RSUBR!-ERRORS]>> 
<AND <ASSIGNED? GLUE> .GLUE <PUT ,LOC PGLUE ![1073741823 0!]>> 


<SETG SMASH %<RSUBR-ENTRY '[LOC SMASH #DECL ("VALUE" ANY ANY FIX)] 10>> 

<SETG MOVIT %<RSUBR-ENTRY '[LOC MOVIT #DECL ("VALUE" FIX FIX)] 25>> 

<NEWTYPE INTERNAL-RSUBR WORD> 

"ROUTINES TO HELP SNAP AND UNSNAP INTERNAL-RSUBRS
 BUILD-INTERNAL-RSUBR BUILDS ONE
 GET-LOCATION GETS THE RSUBR OR RSUBR-ENTRY FROM ONE." 

<SETG BUILD-INTERNAL-RSUBR %<RSUBR-ENTRY '[LOC BUILD-INTERNAL-RSUBR #DECL (
"VALUE" INTERNAL-RSUBR LOCR FIX)] 36>> 

<SETG GET-LOCATION %<RSUBR-ENTRY '[LOC GET-LOCATION #DECL ("VALUE" ANY 
INTERNAL-RSUBR)] 52>> 

<SETG SPEC-GET-LOC %<RSUBR-ENTRY '[LOC SPEC-GET-LOC #DECL ("VALUE" ANY 
INTERNAL-RSUBR)] 67>> 

<SETG INTERNAL-RSUBR %<RSUBR-ENTRY '[LOC INTERNAL-RSUBR #DECL ("VALUE" ANY ATOM 
FIX "OPTIONAL" ANY)] 82>> 

<SETG RSUBR-HACK %<RSUBR-ENTRY '[LOC RSUBR-HACK #DECL ("VALUE" ANY RSUBR FIX FIX
ANY FIX)] 211>> 

<SETG IRSUBR-PRINT %<RSUBR-ENTRY '[LOC IRSUBR-PRINT #DECL ("VALUE" ANY <PRIMTYPE
WORD>)] 338>> 

<SETG PRINT-INTERNAL-RSUBR %<RSUBR-ENTRY '[LOC PRINT-INTERNAL-RSUBR #DECL (
"VALUE" ANY ATOM FIX RSUBR ANY)] 441>> 

<PRINTTYPE INTERNAL-RSUBR ,IRSUBR-PRINT>