mim/development/mim/vax/mimlib/gc-dump-defs.mud

   1 <DEFINITIONS "GC-DUMP-DEFS">
   2
   3 <USE "NEWSTRUC" "BACKQUOTE">
   4
   5 <GDECL (SPACE-END AL OLD-TYPES WORDS-NEEDED NUMBER-OF-NEWTYPES) FIX
   6        (DUMP-FRAME READ-FRAME) FRAME (NEW-ZONE) ZONE
   7        (ATOM-TABLE) <VECTOR [REST LIST]>
   8        (M$$TYPE-INFO!-INTERNAL) <VECTOR [REST <OR FALSE TYPE-ENTRY>]>>
   9
  10 <MSETG STYPE-FIX 0> ;"The magic storage types--used in CASE statements"
  11 <MSETG STYPE-LIST 1>
  12 <MSETG STYPE-RECORD 2>
  13 <MSETG STYPE-BYTES 4>
  14 <MSETG STYPE-STRING 5>
  15 <MSETG STYPE-UVECTOR 6>
  16 <MSETG STYPE-VECTOR 7>
  17
  18 <MSETG LENGTH-ATOM 7> ;"The length in words of various objects."
  19 <MSETG LENGTH-OFFSET 8>
  20 <MSETG LENGTH-GBIND 7>
  21 <MSETG LENGTH-TYPE-ENTRY 16>
  22 <MSETG LENGTH-LIST 3>
  23
  24 <MSETG LENUU-GBIND 10> ;"The `LENUU' of various objects."
  25 <MSETG LENUU-ATOM 10>
  26
  27 <MSETG TYPE-C-STRING <TYPE-C STRING>>
  28 <MSETG TYPE-C-ATOM <TYPE-C ATOM>>
  29 <MSETG TYPE-C-GBIND <TYPE-C GBIND>>
  30 <MSETG TYPE-C-UVECTOR <TYPE-C UVECTOR>>
  31 <MSETG TYPE-C-LIST <TYPE-C LIST>>
  32
  33 <DEFMAC ADDR-S ('S)
  34         <FORM PROG
  35               ((RESULT .S))
  36               '<IFSYS ("TOPS20"
  37                        <SET RESULT
  38                             <+ <ANDB <CALL VALUE .RESULT> 1073741823> 1>>)>
  39               '.RESULT>>
  40
  41 <DEFMAC RIGHT-ATOM ('ATM 'OFF)
  42    `<BIND ((ATM ~.ATM) (OFF ~.OFF) (VAL <CALL VALUE .ATM>))
  43        #DECL ((ATM) <PRIMTYPE ATOM> (OFF VAL) FIX)
  44        <COND (<==? .VAL -1>
  45               <CHTYPE ROOT <TYPE .ATM>>)
  46              (ELSE
  47               <CHTYPE <FIXUP-ATOM <CALL OBJECT
  48                                         ,TYPE-C-ATOM
  49                                         ,LENUU-ATOM
  50                                         <+ .VAL .OFF>>
  51                                   .OFF>
  52                       <TYPE .ATM>>)>>>
  53
  54 <DEFMAC PAIR-UP ('OC 'NC)
  55    `<BIND ((OC ~.OC) (NC ~.NC)
  56            (OLD-CODES ,OLD-CODES) (NEW-CODES ,NEW-CODES))
  57        #DECL ((OLD-CODES NEW-CODES) <<PRIMTYPE VECTOR> <PRIMTYPE FIX>>
  58               (OC NC) TYPE-C)
  59        <1 .OLD-CODES .OC>
  60        <SETG OLD-CODES <REST .OLD-CODES>>
  61        <1 .NEW-CODES .NC>
  62        <SETG NEW-CODES <REST .NEW-CODES>>>>
  63
  64 <END-DEFINITIONS>