mirror of
https://github.com/PDP-10/its.git
synced 2026-01-19 01:27:05 +00:00
51 lines
1.6 KiB
Plaintext
51 lines
1.6 KiB
Plaintext
'<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>
|