'<PCODE "1CRITIC">

<PACKAGE "CRITIC"> 

<ENTRY CRITIC CRITIC-NOTES> 

<AND? <OR <LOOKUP "NO-DECL" <ROOT>> <INSERT "NO-DECL" <ROOT>>> <OR <LOOKUP 
"NO-VALUE" <ROOT>> <INSERT "NO-VALUE" <ROOT>>>> 

<NEWTYPE FAMILY VECTOR '<VECTOR <LIST [REST ATOM LIST LIST VECTOR]> [3 <LIST [
REST <PRIMTYPE ATOM>]>] <LIST [REST OBLIST]> <LIST [REST ATOM]> [2 <LIST [REST <
OR STRING FALSE>]>] ATOM STRING <VECTOR [4 DECL] [2 LIST] [2 DECL] LIST> LIST>> 

<AND? <SETG TREE 1> <SETG TOP-FCNS 2> <SETG TOP-GLOBALS 3> <SETG TOP-LOCALS 4> <
SETG OBJECT-OBLISTS 5> <SETG ENTRIES 6> <SETG USED-PACK 7> <SETG USED-DATUM 8> <
SETG OBJECT-NAME 9> <SETG OBJECT-TYPE 10> <SETG GABST 11> <SETG NEWTYPES 12>> 

<MANIFEST TREE TOP-FCNS TOP-GLOBALS TOP-LOCALS OBJECT-OBLISTS ENTRIES USED-PACK 
USED-DATUM OBJECT-NAME OBJECT-TYPE GABST NEWTYPES> 

<AND? <SETG GSET 1> <SETG GUSED 2> <SETG LSET 3> <SETG LUSED 4> <SETG EXTF 5> <
SETG NARGS 6> <SETG SPEC 7> <SETG RDECL 8> <SETG NOTES 9> <SETG DATUMS 10> <SETG
GOFFSET 11> <SETG ATOML 12>> 

<MANIFEST GSET GUSED LSET LUSED EXTF NARGS SPEC RDECL NOTES DATUMS GOFFSET ATOML
> 

<AND? <SETG RGSET 0> <SETG RGUSED 1> <SETG RLSET 2> <SETG RLUSED 3> <SETG REXTF 
4> <SETG RSPEC 6> <SETG RDATUMS 9>> 

<MANIFEST RGSET RGUSED RLSET RLUSED REXTF RSPEC RDATUMS> 

<AND? <SETG NAME 1> <SETG FATHERS 2> <SETG SONS 3> <SETG ABST 4> <SETG NODE-SIZE
4>> 

<MANIFEST NAME FATHERS SONS ABST NODE-SIZE> 

<NEWTYPE FATHER VECTOR '<VECTOR [2 ATOM] DECL [2 LIST]>> 

<AND? <SETG CTYPE 2> <SETG FDLST 3> <SETG FPLST 4> <SETG FSPEC 5>> 

<MANIFEST CTYPE FDLST FPLST FSPEC> 

\ 

<SETG KNOWN-ATOMS '![INCHAN OUTCHAN OBLIST!]> 

<SETG KNOWN-DECLS #DECL ((INCHAN) <SPECIAL CHANNEL> (OUTCHAN) <SPECIAL CHANNEL> 
(OBLIST) <SPECIAL <OR OBLIST [LIST <REST OBLIST>]>>)> 

<SETG DECLS-SEEN ()> 

<SETG QUOTING-SUBRS [,IUVECTOR 2 ,ISTRING 2 ,ILIST 2 ,IFORM 2 ,IVECTOR 2 ,ITUPLE
2 ,IBYTES 3 ,ISTORAGE 2 ,READ 2 ,READCHR 2 ,NEXTCHR 2 ,GC-READ 2 ,GET 3 ,GETPROP
3 ,GETPL 3 ,READB 3 ,READSTRING 4]> 

<AND? <SETG EVAL-OR-APPLY '![LIST FORM SEGMENT FUNCTION MACRO CLOSURE VECTOR 
UVECTOR!]> <SETG APPLICABLE-TYPES '![SUBR FSUBR FUNCTION MACRO RSUBR RSUBR-ENTRY
!]> <SETG USER-APPLICABLE-TYPES <REST ,APPLICABLE-TYPES 2>> <SETG INT-SUBRS [,
SET ,SETG ,DEFINE ,DEFMAC ,LVAL ,LLOC ,GVAL ,GLOC ,VALUE]> <SETG 
CONTROL-STRUCTURES [,DEFINE ,DEFMAC ,PROG ,REPEAT ,BIND ,FUNCTION]> <SETG 
FUNNY-FSUBRS ![,COND ,QUOTE!]> <SETG PRINTING-SUBRS ![,PRINT ,PRINC ,PRIN1 ,
TERPRI ,CRLF!]> <SETG OPEN-SUBRS ![,OPEN ,OPEN-NR ,FLOAD ,SAVE ,RESTORE ,CHANNEL
!]> <SETG LVAL-LLOC ![,LVAL ,LLOC!]> <SETG GVAL-GLOC ![,GVAL ,GLOC!]> <SETG 
SETG-DEFINE [,SETG ,DEFINE ,DEFMAC]> <SETG APPLY-MAPF-MAPR [,APPLY ,MAPF ,MAPR ,
STACKFORM]> <SETG MAPF-MAPR ![,MAPF ,MAPR!]> <SETG DEFINE-DEFMAC [,DEFINE ,
DEFMAC]> <SETG PACKAGE-RPACKAGE [,PACKAGE ,RPACKAGE]> <SETG BLOCK-ENDBLOCK [,
BLOCK ,ENDBLOCK]> <SETG USE-USE-DEFER [,USE ,USE-DEFER]>> 

<GDECL (KNOWN-ATOMS EVAL-OR-APPLY APPLICABLE-TYPES USER-APPLICABLE-TYPES) <
UVECTOR [REST ATOM]> (KNOWN-DECLS) DECL (DECLS-SEEN) LIST (QUOTING-SUBRS) <
VECTOR [REST SUBR FIX]> (INT-SUBRS) <VECTOR [REST APPLICABLE]> (
CONTROL-STRUCTURES SETG-DEFINE APPLY-MAPF-MAPR) <VECTOR [REST <OR SUBR FSUBR>]> 
(FUNNY-FSUBRS) <UVECTOR [REST FSUBR]> (PRINTING-SUBRS OPEN-SUBRS LVAL-LLOC 
GVAL-GLOC MAPF-MAPR) <UVECTOR [REST SUBR]> (DEFINE-DEFMAC PACKAGE-RPACKAGE 
BLOCK-ENDBLOCK USE-USE-DEFER) <VECTOR [REST APPLICABLE]>> 

\ 

<SETG CRITIC  %<RSUBR!- '[ %<PCODE!- "1CRITIC" 0> CRITIC #DECL ("VALUE" <OR 
FALSE STRING> ATOM "OPTIONAL" <OR CHANNEL STRING> ANY) INDENT-TO MANIFEST? 
OUTCHAN (CHANNEL) NM2 "CRITIC" (STRING) "PRINT" %<RGLOC DECLS-SEEN T> NM? Group 
(<OR ATOM FALSE>) OFFS (FIX) OBLIST (<LIST [REST OBLIST]>) %<RGLOC MUDDLE T> 
"====== CRITIC's Review of Group: " CHANNEL " from file \"" " ======" "DONE" #
FALSE ("NOT A GROUP") T (ANY) ["Called-by" "Calls" "SETG" "GVAL" "SET" "LVAL" 
"SPECIAL" "USE" "USE-DATUM"] "  " ":  " "Packages USEd but not referenced: " 
"Internal Functions never called" DEFINE "Internal Globals never used" 
"Internal Manifests never used" %<TYPE-W FATHER VECTOR> ARGS %<RGLOC KNOWN-ATOMS
T> " is unused or should be SPECIAL." "Arguments unused" "Unused" 
"Unused SPECIALs" "SPECIALs never used as SPECIALs" " in " ": " "   (" ")" "." 
", " FAMILY (FAMILY) %<TYPE-W FAMILY VECTOR> TREE (<LIST [REST ATOM LIST LIST 
VECTOR]>) STUMP (LIST) TOP-FCNS (<LIST [REST ATOM]>) TOP-GLOBALS TOP-LOCALS 
OBJECT-OBLISTS INITIAL ENTRIES USED-PACK (<LIST [REST STRING]>) USED-DATUM 
OBJECT-NAME (ATOM) OBJECT-TYPE "FILE" NEWTYPES NOTES 
"ENTRYs not bound, assumed locals" %<RGLOC USER-APPLICABLE-TYPES T> %<RGLOC 
PACKAGE-RPACKAGE T> "PACKAGE" PACKAGE %<RGLOC USE-USE-DEFER T> %<RGLOC USE-DATUM
T> %<RGLOC ENTRY T> %<RGLOC NEWTYPE T> ![LIST VECTOR UVECTOR TUPLE!] 
"NEWTYPE not DECLed" %<RGLOC FLOAD T> "FLOAD in file" %<RGLOC BLOCK-ENDBLOCK T> 
"BLOCK or ENDBLOCK at top level in PACKAGE." %<RGLOC DEFINE T> %<RGLOC SETG T> 
VALUE %<RGLOC SET T> %<RGLOC QUOTE T> %<RGLOC DEFINE-DEFMAC T> ABST (VECTOR) 
FTREE FATHER-NAME (<VECTOR [4 DECL] [2 LIST] [2 DECL] [2 LIST]>) 
"External locals set" "External locals used" PP (<LIST [REST <PRIMTYPE ATOM>]>) 
PS %<RGLOC DEFMAC T> %<RGLOC CONTROL-STRUCTURES T> QUOTE "ATOM " 
" used twice in parameter list." UNSPECIAL SPECIAL %<RGLOC APPLICABLE-TYPES T> 
"Untasteful re-use of ATOM " " in ROOT." "No DECL in DECL for" "Illegal DECL" ![
ANY LOCATIVE STRUCTURED APPLICABLE!] "Not a legal type" DECL 
"Type-name not a type: " "FORM/SEGMENT too short" ![SPECIAL UNSPECIAL!] 
"SPECIAL/UNSPECIAL with three or more elements" PRIMTYPE "Bad PRIMTYPE type" 
"PRIMTYPE with three or more elements" OR "Bad type of structured type" BYTES 
"BYTES DECL too short" "BYTES DECL too long" "Bad BYTES specification" 
"REST must terminate DECL" "VECTOR in OR specification" "Nth/REST/OPT too short"
 ![REST OPT!] "Only REST or OPT may follow OPT" REST OPT NO-DECL MANIFEST 
": MANIFESTed structure" %<RGLOC KNOWN-DECLS T> "Calls undefined function " 
"Calls " " with too few arguments." " with too many arguments." %<TYPE-C FATHER 
VECTOR> B? D? AUNB " but unbound and unDECLed" " but unbound" " but unDECLed" 
" unbound in paths" "The ATOM " " used in " " should be special in " 
"External FUNCTION " %<RGLOC MAPF-MAPR T> %<RGLOC FUNNY-FSUBRS T> %<RGLOC 
PRINTING-SUBRS T> %<RGLOC OPEN-SUBRS T> DEV SNM NM1 %<RGLOC QUOTING-SUBRS T> %<
RGLOC EVAL-OR-APPLY T> FUNCTION %<RGLOC FUNCTION T> "Possibly should be QUOTEd" 
%<RGLOC INT-SUBRS T> %<RGLOC LVAL-LLOC T> %<RGLOC SETG-DEFINE T> %<RGLOC 
GVAL-GLOC T> %<RGLOC VALUE T> %<RGLOC APPLY-MAPF-MAPR T> ![SUBR FSUBR!] %<RGLOC 
APPLY T> (0 0) ![RSUBR-ENTRY RSUBR!] "RSUBR has no DECL." #DECL ("VALUE" ANY 
"TUPLE" TUPLE) "FUNCTION has no DECL." "VALUE" PUN "Parameters not DECLed" 
"BIND" "\"BIND\" illegally located." ["NAME" "ACT"] ["CALL" "ARGS"] 
"\"CALL\"/\"ARGS\" illegally located." ["OPTIONAL" "OPT"] "OPTIONAL" 
"\"OPTIONAL\" illegally located." "TUPLE" TUPLE "\"TUPLE\" illegally located." [
"AUX" "EXTRA"] "\"AUX\" Illegally QUOTEd" ANY]>> 
<AND <ASSIGNED? GLUE> .GLUE <PUT ,CRITIC PGLUE ![738197503 -1 -1 -1 -1 -1 -1 -1 
-1 -1 -1 -1073741824 0!]>> 


<SETG CRITIC-NOTES %<RSUBR-ENTRY '[CRITIC CRITIC-NOTES #DECL ("VALUE" <OR FALSE 
STRING> ATOM "OPTIONAL" <OR STRING CHANNEL>)] 315>> 

\ 

\ 

\ 

\ 

\ 

\ 

\ 

\ 

\ 

\ 

\ 

\ 

\ 

\ 

\ 

"Make a father and add it to the list of sons of a node" 

\ 

\ 

\ 

<DEFMAC APPEND ('AA 'STUFF) <FORM PROG <LIST <LIST A <FORM LVAL .AA>> (STUFF .
STUFF)> #DECL ((A) LIST) <FORM SET .AA '<COND (<EMPTY? .A> (.STUFF)) (ELSE <
PUTREST <REST .A <- <LENGTH .A> 1>> (.STUFF)> .A)>>>> 

<ENDPACKAGE>