328 <SETG PLUSINF <CHTYPE <MIN> FIX>>
330 <SETG MINUSINF <CHTYPE <MAX> FIX>>
332 "Type specification for NODE."
373 "Offsets into pass 1 structure entities and functions to create same."
375 <SETG NODE-TYPE <OFFSET 1 NODE>>
377 ;"Code specifying the node type."
379 <SETG PARENT <OFFSET 2 NODE>>
381 ;"Pointer to parent node."
383 <SETG RESULT-TYPE <OFFSET 3 NODE>>
385 ;"Type expression for result returned by code
386 generated by this node."
388 <SETG NODE-NAME <OFFSET 4 NODE>>
390 ;"Usually name of SUBR associated with this node."
392 <SETG KIDS <OFFSET 5 NODE>>
394 ;"List of sub-nodes for this node."
396 <SETG STACKS <OFFSET 6 NODE>>
398 ;"Amount of stack needed by this node."
400 <SETG SEGS <OFFSET 7 NODE>>
402 ;"Predicate: any segments among kids?"
404 <SETG TYPE-INFO <OFFSET 8 NODE>>
406 ;"Points to transient type info for this node."
408 <SETG SIDE-EFFECTS <OFFSET 9 NODE>>
410 ;"General info about side effects (format not yet firm.)"
412 <SETG RSUBR-DECLS <OFFSET 10 NODE>>
414 ;"Function only: final rsubr decls."
416 <SETG BINDING-STRUCTURE <OFFSET 11 NODE>>
418 ;"Partially compiled arg list."
420 <SETG SPECS-START <OFFSET 12 NODE>>
422 ;"Offset to 1st special."
424 <SETG SYMTAB <OFFSET 13 NODE>>
426 ;"Pointer to local symbol table."
428 <SETG SSLOTS <OFFSET 14 NODE>>
430 ;"Number of specials."
432 <SETG USLOTS <OFFSET 15 NODE>>
434 ;"Number of unspecials."
436 <SETG ACTIVATED <OFFSET 16 NODE>>
438 ;"Predicate: any named activation?"
440 <SETG TMPLS <OFFSET 17 NODE>>
442 ;"Offset to unamed temps."
444 <SETG PRE-ALLOC <OFFSET 18 NODE>>
446 ;"Variable slots allocated in advance."
448 <SETG STK-B <OFFSET 19 NODE>>
450 ;"Base of stack at entry."
452 <SETG BTP-B <OFFSET 20 NODE>>
454 ;"Base of stack after bindings."
456 <SETG SPCS-X <OFFSET 21 NODE>>
458 ;"Predicate: any specials bound?"
460 <SETG DST <OFFSET 22 NODE>>
462 ;"Destination spec for value of node."
464 <SETG CDST <OFFSET 23 NODE>>
466 ;"Current destination used."
468 <SETG ATAG <OFFSET 24 NODE>>
470 ;"Label for local againing."
472 <SETG RTAG <OFFSET 25 NODE>>
474 ;"Label for local Returning."
476 <SETG ASSUM <OFFSET 26 NODE>>
478 ;"Node type assumptions."
480 <SETG AGND <OFFSET 27 NODE>>
482 ;"Predicate: Again possible?"
484 <SETG ACS <OFFSET 28 NODE>>
486 ;"Predicate: AC call possible? (if not false
489 <SETG TOTARGS <OFFSET 29 NODE>>
491 ;"Total number of args (including optional)."
493 <SETG REQARGS <OFFSET 30 NODE>>
495 ;"Required arguemnts."
497 <SETG LOOP-VARS <OFFSET 31 NODE>>
499 "Variables kept in acs thru loop."
501 <SETG AGAIN-STATES <OFFSET 32 NODE>>
505 <SETG RETURN-STATES <OFFSET 33 NODE>>
509 <SETG PROG-VARS <OFFSET 34 NODE>>
511 "Vars handled in this prog/repeat."
513 ;"Information used for merging states with prog-nodes"
515 <SETG CLAUSES <OFFSET <INDEX ,KIDS> NODE>>
519 <SETG NODE-SUBR <OFFSET <INDEX ,RSUBR-DECLS> NODE>>
521 ;"For many nodes, the SUBR (not its name)."
523 <SETG PREDIC <OFFSET <INDEX ,NODE-NAME> NODE>>
525 ;"For cond clause nodes, the predicate."
527 <SETG ACCUM-TYPE <OFFSET <INDEX ,DST> NODE>>
529 ;"Accumulated type from all returns etc."
531 <SETG DEAD-VARS <OFFSET <INDEX ,CDST> NODE>>
533 <SETG LIVE-VARS <OFFSET <INDEX ,TYPE-INFO> NODE>>
535 <SETG VSPCD <OFFSET <INDEX ,ATAG> NODE>>
537 <SETG INIT-DECL-TYPE <OFFSET <INDEX ,RTAG> NODE>>
539 " Definitions associated with compiler symbol tables."
541 "Offsets for variable description blocks"
545 '<VECTOR <PRIMTYPE VECTOR>
557 <OR FALSE DATUM LIST>
565 <SETG NEXT-SYM <OFFSET 1 SYMTAB>>
567 ;"Pointer to next symbol table entry."
569 <SETG NAME-SYM <OFFSET 2 SYMTAB>>
573 <SETG SPEC-SYM <OFFSET 3 SYMTAB>>
575 ;"Predicate: special?"
577 <SETG CODE-SYM <OFFSET 4 SYMTAB>>
579 ;"Code specifying whether AUX, OPTIONAL etc."
581 <SETG ARGNUM-SYM <OFFSET 5 SYMTAB>>
583 ;"If an argument, which one."
585 <SETG PURE-SYM <OFFSET 6 SYMTAB>>
587 ;"Predicate: unchanged in function?"
589 <SETG DECL-SYM <OFFSET 7 SYMTAB>>
591 ;"Decl for this variable."
593 <SETG ADDR-SYM <OFFSET 8 SYMTAB>>
597 <SETG INIT-SYM <OFFSET 9 SYMTAB>>
599 ;"Predicate: initial value? if so what."
601 <SETG FRMNO <OFFSET 10 SYMTAB>>
605 <SETG RET-AGAIN-ONLY <OFFSET 11 SYMTAB>>
607 ;"Predicate: used only in AGAIN/RETURN?"
609 <SETG ASS? <OFFSET 12 SYMTAB>>
611 ;"Predicate: used in ASSIGNED?"
613 <SETG INACS <OFFSET 13 SYMTAB>>
615 ;"Predicate: currently in some AC?"
617 <SETG STORED <OFFSET 14 SYMTAB>>
619 ;"Predicate: stored in slot?"
621 <SETG USED-AT-ALL <OFFSET 15 SYMTAB>>
623 ;"Predicate: symbolused at all."
625 <SETG DEATH-LIST <OFFSET 16 SYMTAB>>
627 ;"List of info associated with life time."
629 <SETG CURRENT-TYPE <OFFSET 17 SYMTAB>>
631 ;"Current decl determined by analysis"
633 <SETG COMPOSIT-TYPE <OFFSET 18 SYMTAB>>
635 <SETG USAGE-SYM <OFFSET 19 SYMTAB>>
637 "How a variable is used in a loop."
639 <SETG PROG-AC <OFFSET <INDEX ,CURRENT-TYPE> SYMTAB>>
641 <SETG NUM-SYM <OFFSET <INDEX ,COMPOSIT-TYPE> SYMTAB>>
643 <SETG POTLV <OFFSET <INDEX ,USED-AT-ALL> SYMTAB>>
646 "Slot used to store information for variables in loops."
648 ;"Type as figured out by all uses of symbol."
650 <DEFINE NODE1 (TYP PAR RES-TYP NAME KID)
651 <CHTYPE [.TYP .PAR .RES-TYP .NAME .KID 0 <>] NODE>>
653 "Create a function node with all its hair."
655 <DEFINE NODEF (TYP PAR RES-TYP NAME KID RSD BST HAT VTB ACS? TRG RQRG)
656 <CHTYPE [.TYP .PAR .RES-TYP .NAME .KID 0 <> () <> .RSD .BST 0 .VTB 0
657 0 <> <MAKE:TAG "FRM"> <> () () <> <> <> <> .RES-TYP <> <>
658 .ACS? .TRG .RQRG] NODE>>
660 "Create a PROG/REPEAT node with nearly as much hair."
662 <DEFINE NODEPR (TYP PAR RES-TYP NAME KID VL BST HAT VTB)
699 "Create a COND node."
701 <DEFINE NODECOND (TYP PAR RES-TYP NAME CLAU)
702 <CHTYPE [.TYP .PAR .RES-TYP .NAME .CLAU 0 <> () <>] NODE>>
704 "Create a node for a COND clause."
706 <DEFINE NODEB (TYP PAR RES-TYP PRED CLAU)
707 <CHTYPE [.TYP .PAR .RES-TYP .PRED .CLAU 0 <> () <>] NODE>>
709 "Create a node for a SUBR call etc."
711 <DEFINE NODEFM (TYP PAR RES-TYP NAME KID SUB)
712 <CHTYPE [.TYP .PAR .RES-TYP .NAME .KID 0 <> () <> .SUB] NODE>>
715 <DEFINE ADDVAR (NAM SPEC CODE ARGNUM PURE DCL ADDR INIT)
716 <SET VARTBL <CHTYPE [.VARTBL .NAM .SPEC .CODE .ARGNUM .PURE .DCL .ADDR .INIT 0 <>
717 <> <> T <> () <> ANY 0] SYMTAB>>>
720 "Some specialized decl stuff."
724 #DECL ((VARTBL) <SPECIAL ANY>)
725 <ADDVAR OBLIST T -1 0 T '(<OR LIST OBLIST>) <> <>>
726 <ADDVAR OUTCHAN T -1 0 T '(CHANNEL) <> <>>
727 <ADDVAR INCHAN T -1 0 T '(CHANNEL) <> <>>
730 <PUT CHANNEL DECL '<CHANNEL FIX [11 ANY] [5 FIX]>>
732 <PUT STRING DECL '<STRING [REST CHARACTER]>>
734 <PUT OBLIST DECL '<UVECTOR [REST <LIST [REST <OR ATOM LINK>]>]>>
736 "Codes for the node types in the tree built by pass1 and modified by
739 "Give symbolic codes arbitrary increasing values."
744 <FUNCTION (ATM) <SETG .ATM .N> <SET N <+ .N 1>> .ATM>
837 <SETG COMP-TYPES .N>>
842 "Build a dispatch table based on node types."
844 <DEFINE DISPATCH (DEFAULT "TUPLE" PAIRS
845 "AUX" (TT <IVECTOR ,COMP-TYPES '.DEFAULT>))
846 #DECL ((PAIRS) <TUPLE [REST <LIST FIX ANY>]>
848 <REPEAT ((PAIR '(1 1))) #DECL ((PAIR) <LIST FIX ANY>)
849 <COND (<EMPTY? .PAIRS><RETURN .TT>)>
850 <PUT .TT <1 <SET PAIR <1 .PAIRS>>> <2 .PAIR>>
851 <SET PAIRS <REST .PAIRS>>>>
853 <SETG PREDV <IUVECTOR ,COMP-TYPES 0>>
856 <FUNCTION (N) <PUT ,PREDV .N 1>>
876 "Predicate: does this type have special predicate code?"
880 '<LIST [5 <LIST [REST SYMTAB DATUM <OR FALSE ATOM> <OR ATOM FALSE>]>]>>
882 <PUT SYMBOL DECL '<OR SYMTAB TEMP COMMON>>
884 <NEWTYPE TEMP VECTOR '<VECTOR SCL <OR FALSE DATUM>>>
890 <OR FALSE <LIST [REST SYMBOL]>>
891 [REST <LIST SYMBOL [3 ANY]>]>]>>
893 <SETG TMPNO <OFFSET 1 TEMP>>
895 <SETG TMPAC <OFFSET 2 TEMP>>
897 <SETG DATTYP <OFFSET 1 DATUM>>
899 <SETG DATVAL <OFFSET 2 DATUM>>
901 <SETG ADDRSYM <OFFSET 1 AC>>
903 <SETG ACSYM <OFFSET 2 AC>>
905 <SETG ACLINK <OFFSET 3 AC>>
907 <SETG ACAGE <OFFSET 4 AC>>
909 <SETG ACNUM <OFFSET 5 AC>>
911 <SETG ACPROT <OFFSET 6 AC>>
913 <SETG AC1SYM <OFFSET 7 AC>>
915 <SETG ACRESIDUE <OFFSET 8 AC>>
917 <SETG ACPREF <OFFSET 9 AC>>
921 '<<PRIMTYPE VECTOR> <PRIMTYPE WORD>
923 <OR <LIST [REST DATUM]> FALSE>
933 '<<PRIMTYPE LIST> <OR ATOM <PRIMTYPE LIST> <PRIMTYPE VECTOR>>
934 <OR ATOM <PRIMTYPE LIST> <PRIMTYPE VECTOR>>>>
936 <NEWTYPE OFFPTR LIST '<<PRIMTYPE LIST> FIX DATUM ATOM>>
940 <NEWTYPE IRSUBR LIST>
942 "A TOKEN GIVES INFORMATION TO CUP"
944 <NEWTYPE TOKEN VECTOR '<<PRIMTYPE VECTOR> FIX>>
946 <NEWTYPE ADDRESS:PAIR LIST>
948 <NEWTYPE ADDRESS:C LIST>
952 <FUNCTION (N1 N2 N N+1 NAME "AUX" THISAC)
953 <SETG .NAME <SET THISAC <CHTYPE [.N1 .N2 <> 0 .N <> .N+1 <> <>] AC>>>
954 <EVAL <FORM GDECL (.NAME) AC>> .THISAC>
955 ![`A `B `C `D `E `F `TVP `SP!]
956 ![`A* `B* `C* `D* `E* `F* `TVP* `SP*!]
958 ![`B* `C* `D* `E* `F* `TVP* `SP* `AB*!]
959 ![AC-A AC-B AC-C AC-D AC-E AC-F AC-G AC-H!]>>
961 <SETG NUMACS <LENGTH ,ALLACS>>
965 <SETG LAST-AC-1 ,AC-G>
974 <PUT .AC ,ACRESIDUE <>>
975 <PUT .AC ,ACPREF <>>>
980 <GDECL (ALLACS) !<UVECTOR [8 AC]> (ATIME REGS) FIX (LAST-AC LAST-AC-1 AC0) AC>
982 <MANIFEST SS-SYM-SLOT SS-DAT-SLOT SS-STORED-SLOT SS-POTENT-SLOT>
984 <MANIFEST TMPFRM TMPNO THOME TUSERS DATTYP DATVAL ADDRSYM ACSYM ACLINK ACAGE
985 ACNUM ACPROT AC1SYM ACRESIDUE ACPREF ACINUSE TMPAC COMMON-DATUM
988 <MAPF <> ,MANIFEST ,CODVEC>
990 <MANIFEST TOT-MODES RESTS RMODES COMP-TYPES
991 GDECL-SYM GNAME-SYM GNEXT-SYM FRMNO INIT-SYM ADDR-SYM TOTARGS REQARGS
992 DECL-SYM PURE-SYM ARGNUM-SYM CODE-SYM SPEC-SYM NAME-SYM NEXT-SYM PREDIC
993 NODE-SUBR CLAUSES ACS TMPLS ACTIVATED USLOTS SSLOTS SYMTAB SPECS-START
994 BINDING-STRUCTURE RSUBR-DECLS SEGS STACKS KIDS NODE-NAME RESULT-TYPE PARENT
995 NODE-TYPE SIDE-EFFECTS RET-AGAIN-ONLY ASS? INACS STORED DST CDST ACCUM-TYPE
996 INIT-DECL-TYPE VSPCD AGND ASSUM RTAG ATAG SPCS-X BTP-B STK-B PRE-ALLOC
997 USED-AT-ALL CURRENT-TYPE DEATH-LIST COMPOSIT-TYPE AGAIN-STATES RETURN-STATES
998 PROG-VARS LOOP-VARS PROG-AC NUM-SYM TYPE-INFO USAGE-SYM LIVE-VARS
1005 <SETG NO-RESIDUE 10000000>
1007 <SETG STORED-RESIDUE 1000000>
1009 <SETG NOT-STORED-RESIDUE 100000>
1011 <SETG NOT-PREF 10000>
1013 <SETG P-N-CLEAN 1000>
1015 <SETG P-N-STO-RES 100>
1017 <SETG P-N-NO-STO-RES 10>
1031 <SETG ACO <CHTYPE [`O* `O* <> 0 0 <> `A* <> <>] AC>>
1033 <SETG SS-SYM-SLOT 1>
1037 <SETG SS-DAT-SLOT 2>
1039 "DATUM OF THE SYMBOL"
1041 <SETG SS-STORED-SLOT 3>
1043 "IS THE SYMBOL STORED"
1045 <SETG SS-POTENT-SLOT 4>
1047 "IS THE SYMBOL POTENTIAL"
1049 <MANIFEST SS-SYM-SLOT SS-DAT-SLOT SS-STORED-SLOT SS-POTENT-SLOT>
1051 "MANIFESTS FOR PROG-AC"
1055 <SETG NUM-SYM-SLOT 2>
1057 <SETG STORED-SLOT 3>
1061 "MANIFESTED VARIABLES FOR SLOT STORE IN PROG-VARS"
1065 <SETG SAVED-NUM-SYM-SLOT 2>
1067 <SETG SAVED-PROG-AC-SLOT 3>
1069 <SETG SAVED-POTLV-SLOT 4>
1071 <SETG LENGTH-PROG-VARS 4>
1073 "MANIFESTS FOR AGAIN AND RETURN STATES"
1075 <SETG SAVED-AC-STATE 1>
1077 <SETG SAVED-CODE:PTR 2>
1079 <SETG SAVED-STACK-STATE 3>
1081 <SETG SAVED-RET-FLAG 4>
1083 <SETG LENGTH-CONTROL-STATE 4>
1085 "OFFSETS FOR STACK:INFO"
1091 <SETG SAVED-NTSLOTS 3>
1095 "SLOTS FOR SAVED-AC-SLOT"
1099 <SETG CINACS-SLOT 2>
1101 <SETG CSTORED-SLOT 3>
1103 <SETG CPOTLV-SLOT 4>
1105 <SETG LENGTH-CSTATE 4>
1107 "SLOTS FOR LOOP-VARS"
1111 <SETG LINACS-SLOT 2>
1113 <SETG LOOPVARS-LENGTH 2>
1115 <MANIFEST NUM-SYM-SLOT
1136 LENGTH-CONTROL-STATE
1144 '<<PRIMTYPE VECTOR> ATOM <OR COMMON SYMTAB> FIX ANY <PRIMTYPE LIST>>>
1146 <SETG COMMON-TYPE <OFFSET 1 COMMON>>
1148 "TYPE OF COMMON (ATOM)"
1150 <SETG COMMON-SYMT <OFFSET 2 COMMON>>
1152 "POINTER TO OR COMMON SYMTAB"
1154 <SETG COMMON-ITEM <OFFSET 3 COMMON>>
1156 "3RD ARGUMENT TO NTH,REST,PUT ETC."
1158 <SETG COMMON-PRIMTYPE <OFFSET 4 COMMON>>
1160 "PRIMTYPE OF OBJECT IN COMMON"
1162 <SETG COMMON-DATUM <OFFSET 5 COMMON>>
1164 "DATUM FOR THIS COMMON"
1166 <MANIFEST COMMON-TYPE COMMON-SYMTAB COMMON-ITEM COMMON-PRIMTYPE COMMON-DATUM>
1170 '<<PRIMTYPE VECTOR> NODE <UVECTOR [7 FIX]> <UVECTOR [7 FIX]>>>
1172 <DEFINE MESSAGE (SEVERITY STR "TUPLE" TEXT)
1173 <AND <GASSIGNED? DEBUGSW> <ERROR .SEVERITY .STR>>
1176 #DECL ((ATM SEV) ATOM)
1177 <COND (<==? .SEV .SEVERITY>
1178 <AND <ASSIGNED? .ATM> <SET .ATM T>>
1180 '(ERROR NOTE WARNING INCONSISTANCY INCONSISTENCY)
1181 '(ERRS NOTES WARNS INCONS INCONS)>
1183 <PRINC .SEVERITY> ;"Typically NOTE, WARNING, ERROR, or INCONSISTANCY"
1187 <COND (<EMPTY? .TEXT> <RETURN 0>)
1188 (<==? <TYPE <1 .TEXT>> ATOM> <PRINC <1 .TEXT>>)
1189 (<TYPE? <1 .TEXT> NODE>
1190 <COND (<GASSIGNED? NODE-COMPLAIN>
1192 <NODE-COMPLAIN <1 .TEXT>>
1194 (ELSE <PRIN1 <1 .TEXT>>)>
1195 <PRINC " "> ;"Space"
1196 <SET TEXT <REST .TEXT>>>
1198 <COND (<==? .SEVERITY ERROR> <RETURN " COMPILATION ABORTED " .COMPILER>)
1199 (<OR <==? .SEVERITY INCONSISTANCY> <==? .SEVERITY INCONSISTENCY>>
1200 <RETURN " INFORM BKD; OR CLR; " .COMPILER>)>
1203 <SETG INSTRUCTION ,FORM>