'<PCODE "TEMPLT">

<RPACKAGE "TEMPLATE"> 

<BLOCK (<ROOT>)> 

OPCODE!-OP 

BOOLEAN 

ANY 

<SETG GOING-INSANE <>> 

"IF THIS FLAG IS TRUE USE MARC'S ASYLUM STUFF" 

TEMPLATE-DATA 

DUMP-TEMPLATE 

GETTER-DATA 

PUTTER-DATA 

<ENDBLOCK> 

<NEWTYPE LABEL WORD> 

<USE-TOTAL "TEMHLP">

<SETG LOC  %<RSUBR!- '[ %<PCODE!- "TEMPLT" 0> LOC #DECL ("VALUE" FIX ANY) IEMIT 
EMIT CONSTANT DCLBDR MCALL PRIMTYPE-C START-CODE CONSTANT GETYP EMIT PUTIMP 
TEMPLATE-SETUP COMPLR IEMIT COMPRESS NORDER ORDER XAD #FALSE ("Bad Type") TEMPLR
 BOOLEAN ANY ATOM VECTOR UVECTOR WORD TEMPLATE LIST STRING 
"Bad special TEMPLATE type--TEMPLATE" FIX 
"Incorrect STRING specification --TEMPLATE" 
"Incorrect VECTOR or UVECTOR specification--TEMPLATE" 
"Incorrect LIST or WORD specification --TEMPLATE" NAME (ATOM) LAB-COUNT (FIX) (
ACTIVATION) %<RGLOC TMPLST T> #FALSE ("ALREADY A TEMPLATE") "OPTIONAL" "REST" T 
%<TYPE-W OPCODE!-OP!-PACKAGE WORD> %<RGLOC GETTERS T> GETTER-DATA %<RGLOC 
PUTTERS T> PUTTER-DATA TEMPLATE-DATA TAB (<LIST [REST LIST]>) FIXUP-LIST (LIST) 
CODE:LIST CNT PASS1 (ANY) CODE:PTR TYPE-LIST CONSTANT-LIST TAG-LIST 
DUMP-TEMPLATE %<TYPE-W LABEL WORD> INTERNAL-TEMPLATE-ERRORS!-ERRORS FLOAT FALSE 
TVTOFF IENTS-LIST RVEC-LIST %<RGLOC ERRUUO T> %<TYPE-C LABEL WORD> %<TYPE-C 
OPCODE!-OP!-PACKAGE WORD> BAD-CALL-TO-FIXUP!-ERRORS %<RGLOC NUMPRI T> CODE-LIST 
MPOPJ TEMPLATE-TYPE-VIOLATION!-ERRORS ERROR %<RGLOC GOING-INSANE T> TABLOCK 
IBLOCK RCALL FINIS RSUBR GLUE %<RGLOC MUDDLE T> REST <NOT ANY> DECL OR [REST <
NOT ANY>] "TUPLE" TUPLE]>> 
<AND <ASSIGNED? GLUE> .GLUE <PUT ,LOC PGLUE ![715827882 -22548578305 -1 -1 -1 
-4194304 0!]>> 


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

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

<SETG TMPLST ()> 

<GDECL (TMPLST) LIST> 

"OFFSETS INTO INFORMATION LIST" 

<SETG TYPE-INFO 1> 

<GDECL (GETTERS PUTTERS) VECTOR> 

"TYPE SLOT" 

<SETG LENGTH-INFO 2> 

"LENGTH SLOT" 

<SETG BYTE-LOC-INFO 5> 

"LOCATION OF BIT START IN WORD" 

<SETG FIELD-LENGTH-INFO 3> 

"LENGTH OF A FIELD FOR UVEC/VEC/STRING SHORTNERS" 

<SETG WORD-LOC-INFO 4> 

"WORD-LOCATION OFF START IN TEMPLATE" 

"OFFSETS INTO CODE-VECTOR" 

<SETG 18BIT-VEC 1> 

<SETG 36BIT-STRING 2> 

<SETG 72BIT 3> 

<SETG 36BIT 4> 

<SETG 18BIT 5> 

<SETG BYTE-BIT 6> 

<SETG BOOLEAN-BIT 7> 

<SETG 54BIT 8> 

<SETG RHW <BITS 18>> 

<SETG LHW <BITS 18 18>> 

<SETG ERRUUO-CODE 117440512> 

<MANIFEST 72BIT 36BIT 18BIT BYTE-BIT BOOLEAN-BIT RHW LHW TYPE-INFO LENGTH-INFO 
FIELD-LENGTH-INFO BYTE-LOC-INFO WORD-LOC-INFO 36BIT-STRING 18BIT-VEC 54BIT 
ERRUUO-CODE> 

\ 

<SETG XAD %<RSUBR-ENTRY '[LOC XAD #DECL ("VALUE" ANY ANY)] 36>> 

\ 

<SETG COMPRESS %<RSUBR-ENTRY '[LOC COMPRESS #DECL ("VALUE" LIST LIST)] 391>> 

\ 

<SETG TEMPLATE %<RSUBR-ENTRY '[LOC TEMPLATE #DECL ("VALUE" ANY ATOM "TUPLE" ANY)
] 510>> 

\ 

<SETG ORDER %<RSUBR-ENTRY '[LOC ORDER #DECL ("VALUE" <LIST FIX FIX> <LIST [REST 
LIST]>)] 1100>> 

\ 

<SETG NORDER %<RSUBR-ENTRY '[LOC NORDER #DECL ("VALUE" <LIST LIST FIX> FIX LIST)
] 1416>> 

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

<SETG DEL %<RSUBR-ENTRY '[LOC DEL #DECL ("VALUE" STRUCTURED ATOM FIX)] 1713>> 

\ 

<SETG COMPLR %<RSUBR-ENTRY '[LOC COMPLR #DECL ("VALUE" STRUCTURED ANY ANY ANY 
ANY ANY ANY ANY)] 1754>> 

<SETG FIXUP-LOCS %<RSUBR-ENTRY '[LOC FIXUP-LOCS #DECL ("VALUE" <OR FALSE LIST> <
LIST [REST <LIST [2 ANY]>]> LIST ANY)] 2044>> 

<SETG BUILD-TYPE-FIXUP %<RSUBR-ENTRY '[LOC BUILD-TYPE-FIXUP #DECL ("VALUE" <LIST
[REST ANY]> LIST)] 2157>> 

<SETG BUILD-TEMPLATE-CODE %<RSUBR-ENTRY '[LOC BUILD-TEMPLATE-CODE #DECL ("VALUE"
LIST VECTOR UVECTOR ANY ANY ANY)] 2237>> 

"GETTER FOR 18BIT UVECTOR OR VECTOR WITH LENGTH SPECIFIED" 

<SETG 18BIT-VEC-GET %<RSUBR-ENTRY '[LOC 18BIT-VEC-GET #DECL ("VALUE" <OR FIX 
FLOAT> ATOM FIX FIX FIX FIX)] 2437>> 

"POPJ P*" 

<SETG EXIT %<RSUBR-ENTRY '[LOC EXIT #DECL ("VALUE" <OR FIX FLOAT>)] 2507>> 

"SUCCESSFUL EXIT OUT OF PUTTERS" 

<SETG SUCCESSFUL-EXIT %<RSUBR-ENTRY '[LOC SUCCESSFUL-EXIT #DECL ("VALUE" <OR FIX
FLOAT>)] 2520>> 

"18BIT PUTTER FOR UVEC/VEC WITH LENGTH SPECIFIED" 

<SETG 18BIT-VEC-PUT %<RSUBR-ENTRY '[LOC 18BIT-VEC-PUT #DECL ("VALUE" <OR FIX 
FLOAT> ATOM FIX FIX FIX FIX)] 2540>> 

"36BIT GETTER FOR STRING WITH LENGTH SPECIFIED" 

<SETG 36BIT-STRING-GET %<RSUBR-ENTRY '[LOC 36BIT-STRING-GET #DECL ("VALUE" <OR 
FIX FLOAT> ATOM FIX FIX FIX FIX)] 2626>> 

"36BIT PUTTER FOR STRING WITH LENGTH SPECIFIED" 

<SETG 36BIT-STRING-PUT %<RSUBR-ENTRY '[LOC 36BIT-STRING-PUT #DECL ("VALUE" <OR 
FIX FLOAT> ATOM FIX FIX FIX FIX)] 2677>> 

"72BIT GETTER FOR ANY. ALWAYS SKIP RETURN" 

<SETG ANY-GET %<RSUBR-ENTRY '[LOC ANY-GET #DECL ("VALUE" <OR FIX FLOAT> ATOM FIX
FIX FIX FIX)] 2744>> 

"72BIT PUTTER FOR ANY" 

<SETG ANY-PUT %<RSUBR-ENTRY '[LOC ANY-PUT #DECL ("VALUE" <OR FIX FLOAT> ATOM FIX
FIX FIX FIX)] 2787>> 

"54BIT GETTER FOR STRINGS" 

<SETG 54BIT-GET %<RSUBR-ENTRY '[LOC 54BIT-GET #DECL ("VALUE" <OR FIX FLOAT> ATOM
FIX FIX FIX FIX)] 2830>> 

"54BIT PUTTERS FOR STRINGS" 

<SETG 54BIT-PUT %<RSUBR-ENTRY '[LOC 54BIT-PUT #DECL ("VALUE" <OR FIX FLOAT> ATOM
FIX FIX FIX FIX)] 2907>> 

"36BIT-GETTER" 

<SETG 36BIT-GET %<RSUBR-ENTRY '[LOC 36BIT-GET #DECL ("VALUE" <OR FIX FLOAT> ATOM
FIX FIX FIX FIX)] 3000>> 

"36BIT-PUTTER" 

<SETG 36BIT-PUT %<RSUBR-ENTRY '[LOC 36BIT-PUT #DECL ("VALUE" <OR FIX FLOAT> ATOM
FIX FIX FIX FIX)] 3043>> 

<SETG 18BIT-GET %<RSUBR-ENTRY '[LOC 18BIT-GET #DECL ("VALUE" <OR FIX FLOAT> ATOM
FIX FIX FIX FIX)] 3093>> 

<SETG 18BIT-PUT %<RSUBR-ENTRY '[LOC 18BIT-PUT #DECL ("VALUE" <OR FIX FLOAT> ATOM
FIX FIX FIX FIX)] 3170>> 

<SETG BOOLEAN-GET %<RSUBR-ENTRY '[LOC BOOLEAN-GET #DECL ("VALUE" <OR FIX FLOAT> 
ATOM FIX FIX FIX FIX)] 3263>> 

<SETG BOOLEAN-PUT %<RSUBR-ENTRY '[LOC BOOLEAN-PUT #DECL ("VALUE" <OR FIX FLOAT> 
ATOM FIX FIX FIX FIX)] 3377>> 

<SETG BYTE-GET %<RSUBR-ENTRY '[LOC BYTE-GET #DECL ("VALUE" <OR FIX FLOAT> ATOM 
FIX FIX FIX FIX)] 3509>> 

<SETG BYTE-PUT %<RSUBR-ENTRY '[LOC BYTE-PUT #DECL ("VALUE" <OR FIX FLOAT> ATOM 
FIX FIX FIX FIX)] 3563>> 

<SETG EMIT-OPTIONAL %<RSUBR-ENTRY '[LOC EMIT-OPTIONAL #DECL ("VALUE" <OR FIX 
FLOAT>)] 3624>> 

<SETG GEN-TEMPLATE-REST %<RSUBR-ENTRY '[LOC GEN-TEMPLATE-REST #DECL ("VALUE" <OR
FALSE FIX FLOAT> UVECTOR FIX FIX FIX ANY ANY)] 3658>> 

\ 

"ROUTINES TO ALLOW ASSEMBLY" 

<SETG INTERNAL-ENTRY %<RSUBR-ENTRY '[LOC INTERNAL-ENTRY #DECL ("VALUE" <PRIMTYPE
LIST> FIX)] 3793>> 

<SETG REFERENCE-R %<RSUBR-ENTRY '[LOC REFERENCE-R #DECL ("VALUE" 
OPCODE!-OP!-PACKAGE ANY)] 3848>> 

<SETG SPECIAL-MEMQ %<RSUBR-ENTRY '[LOC SPECIAL-MEMQ #DECL ("VALUE" <OR FALSE <
LIST ANY>> ANY LIST)] 3976>> 

<SETG ERRUUO %<RSUBR-ENTRY '[LOC ERRUUO #DECL ("VALUE" <OR FIX FLOAT> ANY)] 4035
>> 

<SETG GETYP %<RSUBR-ENTRY '[LOC GETYP #DECL ("VALUE" <OR FIX FLOAT> ANY "TUPLE" 
ANY)] 4052>> 

<SETG GEN:LABEL %<RSUBR-ENTRY '[LOC GEN:LABEL #DECL ("VALUE" LABEL)] 4079>> 

<SETG PUTYP %<RSUBR-ENTRY '[LOC PUTYP #DECL ("VALUE" <OR FIX FLOAT> ANY "TUPLE" 
ANY)] 4097>> 

<SETG MCALL %<RSUBR-ENTRY '[LOC MCALL #DECL ("VALUE" <OR FIX FLOAT> ANY "TUPLE" 
ANY)] 4124>> 

<SETG EMIT %<RSUBR-ENTRY '[LOC EMIT #DECL ("VALUE" <OR FIX FLOAT> "TUPLE" ANY)] 
4152>> 

<SETG IEMIT %<RSUBR-ENTRY '[LOC IEMIT #DECL ("VALUE" FIX "TUPLE" ANY)] 4216>> 

<SETG FIXUP %<RSUBR-ENTRY '[LOC FIXUP #DECL ("VALUE" <OR FALSE FIX> ATOM)] 4287>
> 

<SETG CONSTANT %<RSUBR-ENTRY '[LOC CONSTANT #DECL ("VALUE" FIX "TUPLE" ANY)] 
4421>> 

<SETG TYPE-CODE %<RSUBR-ENTRY '[LOC TYPE-CODE #DECL ("VALUE" ANY ATOM)] 4528>> 

<SETG LABEL:OFF %<RSUBR-ENTRY '[LOC LABEL:OFF #DECL ("VALUE" <LIST ANY ANY> 
LABEL)] 4662>> 

<SETG LABEL:USE %<RSUBR-ENTRY '[LOC LABEL:USE #DECL ("VALUE" LIST LABEL)] 4698>> 

<SETG ADD-LABEL %<RSUBR-ENTRY '[LOC ADD-LABEL #DECL ("VALUE" <LIST ANY> LABEL)] 
4738>> 

<SETG FINISH-ASSEMBLY %<RSUBR-ENTRY '[LOC FINISH-ASSEMBLY #DECL ("VALUE" <OR 
FALSE FIX FLOAT> ANY)] 4784>> 

\ 

<SETG CRBDR %<RSUBR-ENTRY '[LOC CRBDR #DECL ("VALUE" ATOM ATOM UVECTOR ANY ANY 
ANY ANY ANY ANY ANY)] 4839>> 

<SETG GENERATE-STRUCTURE %<RSUBR-ENTRY '[LOC GENERATE-STRUCTURE #DECL ("VALUE" 
ANY ANY)] 5792>> 

\ 

<SETG START-CODE %<RSUBR-ENTRY '[LOC START-CODE #DECL ("VALUE" <OR FIX FLOAT> 
ANY ANY)] 5896>> 

<SETG GEN-LENGTH %<RSUBR-ENTRY '[LOC GEN-LENGTH #DECL ("VALUE" <LIST ANY ANY> <
UVECTOR [3 LIST]> ANY ANY ANY ANY ANY ANY)] 6252>> 

<SETG PUT-IN-LENGTH %<RSUBR-ENTRY '[LOC PUT-IN-LENGTH #DECL ("VALUE" <OR FALSE 
FIX FLOAT> <UVECTOR [3 LIST]> ANY ANY)] 6529>> 

<SETG BUILD-SPEC-DECL %<RSUBR-ENTRY '[LOC BUILD-SPEC-DECL #DECL ("VALUE" <LIST [
REST ANY]> LIST)] 6673>> 

<SETG FIXUP-RSUBR %<RSUBR-ENTRY '[LOC FIXUP-RSUBR #DECL ("VALUE" ANY ANY LIST 
LIST LIST LIST LIST LIST LIST LIST LIST)] 6744>> 

<SETG FIXUP-CODE %<RSUBR-ENTRY '[LOC FIXUP-CODE #DECL ("VALUE" <OR FALSE UVECTOR
> UVECTOR ANY)] 6950>> 

<SETG FIXUP-BUILDER %<RSUBR-ENTRY '[LOC FIXUP-BUILDER #DECL ("VALUE" <LIST ANY> 
LIST)] 7061>> 

<SETG GLUE-BUILDER %<RSUBR-ENTRY '[LOC GLUE-BUILDER #DECL ("VALUE" UVECTOR LIST 
LIST LIST UVECTOR ANY)] 7160>> 

<SETG ADD-M %<RSUBR-ENTRY '[LOC ADD-M #DECL ("VALUE" <OR FALSE UVECTOR> UVECTOR 
LIST)] 7282>> 

<SETG PUT-IN %<RSUBR-ENTRY '[LOC PUT-IN #DECL ("VALUE" UVECTOR UVECTOR FIX FIX)]
7359>> 

<SETG ADD-R %<RSUBR-ENTRY '[LOC ADD-R #DECL ("VALUE" <OR FALSE UVECTOR> ANY ANY)
] 7429>> 

<SETG GEN-ARG %<RSUBR-ENTRY '[LOC GEN-ARG #DECL ("VALUE" <OR FIX FLOAT> ANY FIX 
<UVECTOR [3 LIST]>)] 7512>> 

<SETG OPTIONAL? %<RSUBR-ENTRY '[LOC OPTIONAL? #DECL ("VALUE" <OR ATOM FALSE> FIX
)] 7610>> 

<SETG REST? %<RSUBR-ENTRY '[LOC REST? #DECL ("VALUE" <OR ATOM FALSE> FIX)] 7628>
> 

<SETG EXIT? %<RSUBR-ENTRY '[LOC EXIT? #DECL ("VALUE" <OR ATOM FALSE> FIX)] 7646>
> 

\ 

<SETG DCLBDR %<RSUBR-ENTRY '[LOC DCLBDR #DECL ("VALUE" DECL ATOM LIST LIST LIST)
] 7664>> 

<SETG SQUOZE %<RSUBR-ENTRY '[LOC SQUOZE #DECL ("VALUE" WORD STRING "OPTIONAL" <
PRIMTYPE WORD>)] 8004>> 

<SETG LREVERSE %<RSUBR-ENTRY '[LOC LREVERSE #DECL ("VALUE" LIST LIST)] 8101>> 

<SETG GETTERS [,18BIT-VEC-GET ,36BIT-STRING-GET ,ANY-GET ,36BIT-GET ,18BIT-GET ,
BYTE-GET ,BOOLEAN-GET ,54BIT-GET]> 

<SETG PUTTERS [,18BIT-VEC-PUT ,36BIT-STRING-PUT ,ANY-PUT ,36BIT-PUT ,18BIT-PUT ,
BYTE-PUT ,BOOLEAN-PUT ,54BIT-PUT]> 

<SETG NUMPRI <SQUOTA <SQUOZE "NUMPRI">>> 

<SETG MULTI-EMIT %<RSUBR-ENTRY '[LOC MULTI-EMIT #DECL ("VALUE" <OR FALSE FIX 
FLOAT> LIST)] 8129>> 

<SETG CODE-FIXUP %<RSUBR-ENTRY '[LOC CODE-FIXUP #DECL ("VALUE" LIST "TUPLE" ANY)
] 8173>> 

<SETG SVALID-TYPE? %<RSUBR-ENTRY '[LOC SVALID-TYPE? #DECL ("VALUE" <OR ATOM 
FALSE TYPE-C> ATOM)] 8253>> 

<ENDPACKAGE>