mim/development/mim/vaxc/crecord.mud

   1
   2
   3 <DEFINE INIT-RECORD-DEFS ()
   4         <SETG RECORD-TABLE ()>>
   5
   6 <DEFINE DEFINE-RECORD (TYP STACK "TUPLE" ELEMENTS "AUX" DESC ELIST)
   7         <SET ELIST <LIST !.ELEMENTS>>
   8         <SET DESC <CHTYPE <VECTOR .TYP .ELIST .STACK> RECORD-DESCRIPTOR>>
   9         <SETG RECORD-TABLE (.DESC !,RECORD-TABLE)>>
  10
  11 <DEFINE PARSE-RED (TYP OFFSET
  12                    "OPTIONAL" (ALTOFF 0) (LEN? <>) (SBOOL? <>)
  13                    "AUX" RES)
  14         #DECL ((TYP) ATOM (OFFSET ALTOFF) FIX (LEN?) <OR FALSE FIX>
  15                (SBOOL?) BOOLEAN)
  16         <COND (<==? .TYP ANY>
  17                <SET RES <VECTOR .OFFSET .ALTOFF ANY 0 <> <> <>>>)
  18               (<OR <==? .TYP BYTE>
  19                    <==? .TYP SMALL-INT>
  20                    <==? .TYP SMALL-POS-INT>
  21                    <==? .TYP SMALL-FR-OFFSET>>
  22                <SET RES <VECTOR .OFFSET 0 .TYP 0 <> <> <>>>)
  23               (<==? .TYP BOOLEAN>
  24                <SET RES <VECTOR .OFFSET 0 BOOLEAN .ALTOFF <> <> <>>>)
  25               (<==? .TYP TYPE-C>
  26                <SET RES <VECTOR .OFFSET 0 TYPE-C 0 .SBOOL? <> .TYP>>)
  27               (<AND <VALID-TYPE? .TYP>
  28                     <MEMQ <TYPEPRIM .TYP> '[VECTOR STRING UVECTOR BYTES]>
  29                     <NOT .LEN?>>
  30                <SET RES <VECTOR .OFFSET .ALTOFF COUNTVWORD 0 .SBOOL? <> .TYP>>)
  31               (<OR .LEN?
  32                    <MEMQ .TYP '[T$ATOM T$LBIND T$MSUBR T$GBIND T$FRAME
  33                                 T$OBLIST]>
  34                    <==? <TYPEPRIM .TYP> LIST> <==? <TYPEPRIM .TYP> FIX>>
  35                <SET RES <VECTOR .OFFSET 0 VWORD1 0 .SBOOL? .LEN? .TYP>>)>
  36         <CHTYPE .RES RECORD-ELEMENT-DESCRIPTOR>>
  37
  38 <DEFINE GET-RELE-DESCRIPTOR (NUM HINT "AUX" RTYP RECTYP)
  39         #DECL ((NUM) FIX (HINT) <OR ATOM HINT>)
  40         <COND (<TYPE? .HINT ATOM> <SET RTYP .HINT>)
  41               (<SET RTYP <PARSE-HINT .HINT RECORD-TYPE>>)>
  42         <MAPF <>
  43               <FCN (ELE)
  44                    <COND (<OR <MEMQ .RTYP <SET RECTYP <REC-TYPE-NAME .ELE>>>
  45                               <MEMQ <CLEAN-DECL .RTYP> .RECTYP>>
  46                           <MAPLEAVE <NTH <REC-ELEMENTS .ELE> .NUM>>)>>
  47               ,RECORD-TABLE>>
  48
  49 <DEFINE GET-RSTACK? (HINT "AUX" RTYP RECTYP)
  50         #DECL ((HINT) <OR ATOM HINT>)
  51         <COND (<TYPE? .HINT ATOM> <SET RTYP .HINT>)
  52               (<SET RTYP <PARSE-HINT .HINT RECORD-TYPE>>)>
  53         <MAPF <>
  54               <FCN (ELE)
  55                    <COND (<OR <MEMQ .RTYP <SET RECTYP <REC-TYPE-NAME .ELE>>>
  56                               <MEMQ <CLEAN-DECL .RTYP> .RECTYP>>
  57                           <MAPLEAVE <REC-STACK .ELE>>)>>
  58               ,RECORD-TABLE>>
  59
  60 <DEFINE GET-RELE-BRANCH? (HINT2)
  61         #DECL ((HINT2) <OR FALSE HINT>)
  62         <COND (<AND .HINT2
  63                     <OR <==? <1 .HINT2> BRANCH-FALSE>
  64                         <==? <1 .HINT2> BRANCH-TAG>>>
  65                <PROG ((CP .CODPTR) FROB)
  66                  #DECL ((CP) LIST)
  67                  <COND (<AND <NOT <EMPTY? .CP>>
  68                              <TYPE? <SET FROB <1 .CP>> FORM>>
  69                         <COND (<N==? <1 .FROB> DEAD!-MIMOP>
  70                                <PUTPROP .FROB DONE T>)
  71                               (T
  72                                <SET CP <REST .CP>>
  73                                <AGAIN>)>)>>
  74                <REST .HINT2>)>>
  75
  76 <DEFINE INIT-REC-DEFS ()
  77         <INIT-RECORD-DEFS>
  78         <DEFINE-RECORD [T$ATOM T$LINK T$GVAL T$LVAL ATOM LINK GVAL LVAL]
  79                        <>
  80                        <PARSE-RED T$GBIND 0 0 <> T>
  81                        <PARSE-RED T$LBIND 4 0 <> T>
  82                        <PARSE-RED STRING 12 10 <> <>>
  83                        <PARSE-RED T$OBLIST 16 0 <> T>
  84                        <PARSE-RED TYPE-C 8 0 <> T>>
  85         <DEFINE-RECORD [T$FRAME FRAME]
  86                        T
  87                        <PARSE-RED T$MSUBR -24 0 4 <>>
  88                        <PARSE-RED FIX -20 0 <> <>>
  89                        <PARSE-RED SMALL-POS-INT -16 0 <> <>>
  90                        <PARSE-RED SMALL-POS-INT -14 0 <> <>>
  91                        <PARSE-RED T$FRAME -12 0 <> <>>
  92                        <PARSE-RED SMALL-POS-INT -6 0 0 <>>
  93                        <PARSE-RED SMALL-FR-OFFSET -8 0 <> <>>
  94                        <PARSE-RED FIX -4 0 <> <>>>
  95         <DEFINE-RECORD [T$LBIND LBIND]
  96                        T
  97                        <PARSE-RED ANY 4 0 <> <>>
  98                        <PARSE-RED T$ATOM 8 0 <> <>>
  99                        <PARSE-RED ANY 16 12 <> <>>
 100                        <PARSE-RED T$LBIND 20 0 <> T>
 101                        <PARSE-RED T$LBIND 24 0 <> T>
 102                        <PARSE-RED FIX 28 0 <> <>>>
 103         <DEFINE-RECORD [T$GBIND GBIND]
 104                        <>
 105                        <PARSE-RED ANY 4 0 <> <>>
 106                        <PARSE-RED T$ATOM 8 0 <> <>>
 107                        <PARSE-RED ANY 16 12 <> <>>>>