mirror of
https://github.com/PDP-10/its.git
synced 2026-02-23 07:42:10 +00:00
178 lines
7.5 KiB
Plaintext
178 lines
7.5 KiB
Plaintext
'<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>
|