<mdl.comp>/istruc.mud.102

   1 <PACKAGE "ISTRUC">
   2
   3 <ENTRY ISTRUC-GEN>
   4
   5 <USE "CODGEN" "COMCOD" "CACS" "CHKDCL" "COMPDEC">
   6
   7
   8 "ILIST, IVECTOR, IUVECTOR AND ISTRING."
   9
  10 <DEFINE ISTRUC-GEN (N W
  11                     "AUX" (NAM <NODE-NAME .N>) (K <KIDS .N>)
  12                           (NT <NODE-TYPE .N>) (BYTSZ <>))
  13         #DECL ((N NUM EL) NODE)
  14         <COND (<==? .NAM ITUPLE>
  15                <ITUPLE-GEN .N
  16                            .W
  17                            <==? .NT ,ISTRUC-CODE>
  18                            <1 .K>
  19                            <2 .K>
  20                            <ISTYPE? <RESULT-TYPE .N>>
  21                            .BYTSZ>)
  22               (ELSE
  23                <PROG ((STK (0 !.STK)))
  24                      #DECL ((STK) <SPECIAL LIST>)
  25                      <COND (<==? .NAM IBYTES>
  26                             <SET BYTSZ <1 .K>>
  27                             <SET K <REST .K>>)>
  28                      <APPLY <NTH ,IERS <LENGTH <MEMQ .NAM ,NAMVEC>>>
  29                             .N
  30                             .W
  31                             <==? .NT ,ISTRUC-CODE>
  32                             <1 .K>
  33                             <2 .K>
  34                             <ISTYPE? <RESULT-TYPE .N>>
  35                             .BYTSZ>>)>>
  36
  37 <DEFINE ILIST-GEN (N W GENR NUMN EL TYP BYTSZ "AUX" NUM START TEM END ELD)
  38         #DECL ((N NUMN EL) NODE (NUM VALUE) DATUM (START END) ATOM)
  39         <SET NUM <GEN .NUMN DONT-CARE>>
  40         <EMIT <INSTRUCTION `PUSH  `P*  !<ADDR:VALUE .NUM>>>
  41         <RET-TMP-AC .NUM>
  42         <STACK:ARGUMENT <REFERENCE ()>>
  43         <STACK:ARGUMENT <REFERENCE ()>>
  44         <ADD:STACK 4>
  45         <ADD:STACK PSLOT>
  46         <COND (.GENR <SET ELD <GEN .EL DONT-CARE>>)>
  47         <REGSTO T>
  48         <LABEL:TAG <SET START <MAKE:TAG>>>
  49         <EMIT '<`SOSGE  `(P) >>
  50         <BRANCH:TAG <SET END <MAKE:TAG>>>
  51         <RET-TMP-AC <COND (.GENR <DOEVS .ELD <DATUM ,AC-C ,AC-D>>)
  52                           (ELSE <GEN .EL <DATUM ,AC-C ,AC-D>>)>>
  53         <REGSTO T>
  54         <EMIT '<`MOVEI  `E* >>
  55         <EMIT '<`PUSHJ  `P*  |CICONS >>
  56         <EMIT '<`SKIPE  `(TP) >>
  57         <EMIT '<`HRRM  `B*  `@  `(TP) >>
  58         <EMIT '<`MOVEM  `B*  `(TP) >>
  59         <EMIT '<`SKIPN  `(TP)  -2>>
  60         <EMIT '<`MOVEM  `B*  `(TP)  -2>>
  61         <BRANCH:TAG .START>
  62         <LABEL:TAG .END>
  63         <EMIT '<`MOVE  `B*  `(TP)  -2>>
  64         <EMIT '<`SUB  `TP*  [<4 (4)>]>>
  65         <EMIT '<`SUB  `P*  [<1 (1)>]>>
  66         <AND .GENR <RET-TMP-AC .ELD>>
  67         <SET TEM <DATUM .TYP ,AC-B>>
  68         <SGETREG ,AC-B .TEM>
  69         <MOVE:ARG .TEM .W>>
  70
  71 <DEFINE IVEC-GEN (N W GENR NUMN EL TYP BYTSZ
  72                   "AUX" NT (UV <==? .TYP UVECTOR>) START END TEM (ETY <>) ADS
  73                         ACS ANAC ATAG DAT AC OFPT ELD TTEM)
  74    #DECL ((N NUMN EL) NODE (NT) FIX (DAT TEM) DATUM (AC) AC (OFPT) OFFPTR)
  75    <REGSTO T>
  76    <RET-TMP-AC <GEN .NUMN <DATUM FIX ,AC-A>>>
  77    <COND (.UV <EMIT '<`MOVEI  `O*  |IBLOCK >>)
  78          (ELSE <EMIT '<`MOVEI  `O*  |IBLOK1 >>)>
  79    <REGSTO T>
  80    <EMIT '<`PUSHJ  `P*  |RCALL >>
  81    <COND
  82     (<AND <NOT .GENR>
  83           <==? <NODE-TYPE .EL> ,QUOTE-CODE>
  84           <==? <NODE-NAME .EL> #LOSE *000000000000*>>
  85      <MOVE:ARG <FUNCTION:VALUE T> .W>)
  86     (<AND <NOT .GENR>
  87           <OR <==? <SET NT <NODE-TYPE .EL>> ,QUOTE-CODE>
  88               <==? .NT ,LVAL-CODE>
  89               <==? .NT ,FLVAL-CODE>
  90               <==? .NT ,FGVAL-CODE>
  91               <==? .NT ,GVAL-CODE>>>
  92      <SET DAT <DATUM .TYP ,AC-B>>
  93      <SGETREG <DATVAL .DAT> .DAT>
  94      <MUNG-AC ,AC-B .DAT>
  95      <SET TEM
  96           <GEN .EL
  97                <COND (<AND .UV <SET ETY <ISTYPE? <RESULT-TYPE .EL>>>>
  98                       <DATUM .ETY <GETREG <>>>)
  99                      (ELSE <ANY2ACS>)>>>
 100      <EMIT <INSTRUCTION `MOVE  <SET ACS <ACSYM <SET AC <GETREG <>>>>> `B >>
 101      <SET ADS <ADDRSYM .AC>>
 102      <COND (<==? <NODE-TYPE .NUMN> ,QUOTE-CODE>
 103             <OR <G? <CHTYPE <NODE-NAME .NUMN> FIX> 0>
 104                     <MESSAGE ERROR "BAD ARG TO " <NODE-NAME .N>>>)
 105            (ELSE <EMIT <INSTRUCTION `JUMPGE  .ACS <SET END <MAKE:TAG>>>>)>
 106      <LABEL:TAG <SET START <MAKE:TAG>>>
 107      <MUNG-AC .AC>
 108      <SET OFPT <OFFPTR <COND (.UV -1) (ELSE 0)> <DATUM .TYP .AC> .TYP>>
 109      <MOVE:ARG .TEM <DATUM <COND (.ETY) (.UV WORD) (ELSE .OFPT)> .OFPT>>
 110      <AND <TYPE? <DATVAL .TEM> AC> <MUNG-AC <DATVAL .TEM> .TEM>>
 111      <AND <TYPE? <DATTYP .TEM> AC> <MUNG-AC <DATTYP .TEM> .TEM>>
 112      <COND (.UV <EMIT <INSTRUCTION `AOBJN  .ACS .START>>)
 113            (ELSE
 114             <EMIT <INSTRUCTION `ADD  .ACS '[<2 (2)>]>>
 115             <EMIT <INSTRUCTION `JUMPL  .ACS .START>>)>
 116      <AND <ASSIGNED? END> <LABEL:TAG .END>>
 117      <COND (.ETY
 118             <EMIT <INSTRUCTION `MOVEI
 119                                `O*
 120                                <FORM TYPE-CODE!-OP!-PACKAGE .ETY>>>
 121             <EMIT <INSTRUCTION PUTYP!-OP!-PACKAGE `O*  (.ADS)>>)
 122            (.UV
 123             <EMIT <INSTRUCTION GETYP!-OP!-PACKAGE `O*  !<ADDR:TYPE .TEM>>>
 124             <EMIT <INSTRUCTION PUTYP!-OP!-PACKAGE `O*  (.ADS)>>)>
 125      <RET-TMP-AC .OFPT>
 126      <MOVE:ARG .DAT .W>)
 127     (ELSE
 128      <REGSTO T>
 129      <COND (<==? <NODE-TYPE .NUMN> ,QUOTE-CODE>
 130             <OR <G? <CHTYPE <NODE-NAME .NUMN> FIX> 0>
 131                     <MESSAGE ERROR "BAD ARG TO " <NODE-NAME .N>>>)
 132            (ELSE <EMIT <INSTRUCTION `JUMPGE  `B*  <SET END <MAKE:TAG>>>>)>
 133      <SET ETY <ISTYPE? <RESULT-TYPE .EL>>>
 134      <COND (<AND .UV .CAREFUL <NOT .ETY>>
 135             <EMIT <INSTRUCTION `PUSH  `P*  '[0]>>
 136             <ADD:STACK PSLOT>)>
 137      <STACK:ARGUMENT <DATUM .TYP ,AC-B>>
 138      <STACK:ARGUMENT <DATUM .TYP ,AC-B>>
 139      <ADD:STACK 4>
 140      <COND (<AND .ETY .UV>
 141             <COND (<N==? <NODE-TYPE .NUMN> ,QUOTE-CODE>
 142                    <EMIT '<`HLRE  `O*  `B >>
 143                    <EMIT '<`SUB  `B*  `O* >>)>
 144             <EMIT <INSTRUCTION `MOVEI
 145                                `O*
 146                                <FORM TYPE-CODE!-OP!-PACKAGE .ETY>>>
 147             <EMIT <INSTRUCTION PUTYP!-OP!-PACKAGE
 148                                `O*
 149                                <COND (<==? <NODE-TYPE .NUMN> ,QUOTE-CODE>
 150                                       <NODE-NAME .NUMN>)
 151                                      (ELSE 0)>
 152                                `(B) >>)>
 153      <COND (.GENR <SET ELD <GEN .EL DONT-CARE>> <REGSTO T>)>
 154      <LABEL:TAG <SET START <MAKE:TAG>>>
 155      <SET TTEM
 156           <COND (<AND .UV .ETY> <DATUM .ETY ANY-AC>)
 157                 (.UV DONT-CARE)
 158                 (ELSE <DATUM ANY-AC ANY-AC>)>>
 159      <SET TEM <COND (.GENR <DOEVS .ELD .TTEM>) (ELSE <GEN .EL .TTEM>)>>
 160      <AND <TYPE? <DATVAL .TEM> AC> <MUNG-AC <DATVAL .TEM> .TEM>>
 161      <AND <TYPE? <DATTYP .TEM> AC> <MUNG-AC <DATTYP .TEM> .TEM>>
 162      <EMIT <INSTRUCTION `MOVE  <SET ACS <ACSYM <SET AC <GETREG <>>>>> `(TP) >>
 163      <COND (<AND .UV <NOT .ETY>>
 164             <EMIT <INSTRUCTION GETYP!-OP!-PACKAGE `O*  !<ADDR:TYPE .TEM>>>
 165             <COND (.CAREFUL
 166                    <EMIT <INSTRUCTION `SKIPE  '`(P) >>
 167                    <BRANCH:TAG <SET ATAG <MAKE:TAG>>>)>
 168             <COND (<==? <NODE-TYPE .NUMN> ,QUOTE-CODE>
 169                    <EMIT <INSTRUCTION PUTYP!-OP!-PACKAGE
 170                                       `O*
 171                                       <NODE-NAME .NUMN>
 172                                       (<ADDRSYM .AC>)>>)
 173                   (ELSE
 174                    <PUT .AC ,ACPROT T>
 175                    <EMIT <INSTRUCTION `HLRE
 176                                       <ACSYM <SET ANAC <GETREG <>>>>
 177                                       <ADDRSYM .AC>>>
 178                    <PUT .AC ,ACPROT <>>
 179                    <EMIT <INSTRUCTION `SUBM  .ACS <ADDRSYM .ANAC>>>
 180                    <EMIT <INSTRUCTION PUTYP!-OP!-PACKAGE
 181                                       `O*
 182                                       (<ADDRSYM .ANAC>)>>)>
 183             <COND (.CAREFUL
 184                    <EMIT <INSTRUCTION `MOVEM  `O*  '`(P) >>
 185                    <LABEL:TAG .ATAG>
 186                    <EMIT <INSTRUCTION `CAIE  `O*  `@  '`(P) >>
 187                    <BRANCH:TAG |COMPER >)>)>
 188      <SET OFPT <OFFPTR <COND (.UV -1) (ELSE 0)> <DATUM .TYP .AC> .TYP>>
 189      <VAR-STORE T>
 190      <MOVE:ARG .TEM <DATUM <COND (.UV WORD) (ELSE .OFPT)> .OFPT>>
 191      <EMIT <INSTRUCTION `ADD  .ACS <COND (.UV '[<1 (1)>]) (ELSE '[<2 (2)>])>>>
 192      <EMIT <INSTRUCTION `MOVEM  .ACS '`(TP) >>
 193      <EMIT <INSTRUCTION `JUMPL  .ACS .START>>
 194      <RET-TMP-AC .OFPT>
 195      <RET-TMP-AC .TEM>
 196      <SET TEM <DATUM <COND (<ISTYPE? <RESULT-TYPE .N>>) (ELSE ,AC-A)> ,AC-B>>
 197      <EMIT <INSTRUCTION `MOVE  <ACSYM <CHTYPE <DATVAL .TEM> AC>> -2 '`(TP) >>
 198      <EMIT <INSTRUCTION `SUB  `TP*  '[<4 (4)>]>>
 199      <COND (<AND .UV .CAREFUL <NOT .ETY>>
 200             <EMIT <INSTRUCTION `SUB  `P*  '[<1 (1)>]>>)>
 201      <AND <ASSIGNED? END> <LABEL:TAG .END>>
 202      <MOVE:ARG .TEM .W>)>>
 203
 204 <DEFINE DOEVS (D W)
 205         #DECL ((D VALUE) DATUM)
 206         <STACK:ARGUMENT .D>
 207         <REGSTO T>
 208         <SUBR:CALL EVAL 1>
 209         <MOVE:ARG <FUNCTION:VALUE T> .W>>
 210
 211 <DEFINE ISTR-GEN (N W GENR NUMN EL TYP BYTSZ
 212                   "AUX" RES NK TN NN TT ACS OAC TEM BP START END ETY DAT
 213                         (SOB <==? <NODE-SUBR .N> ,ISTRING>) ELD TTEM
 214                         (OT <COND (.SOB CHARACTER) (ELSE FIX)>)
 215                         (NT <COND (.SOB STRING) (ELSE BYTES)>) (SIZ 7) SIZD)
 216    #DECL ((N NUMN EL) NODE (TN SIZ) FIX (RES DAT SIZD TEM) DATUM (TT) AC
 217           (NN) <PRIMTYPE WORD> (BYTSZ) <OR FALSE NODE>
 218           (BP) <FORM ANY <LIST ANY>>)
 219    <COND (.BYTSZ
 220           <COND (<==? <NODE-TYPE .BYTSZ> ,QUOTE-CODE>
 221                  <SET SIZ <NODE-NAME .BYTSZ>>)
 222                 (ELSE <SET SIZD <GEN .BYTSZ <DATUM FIX ANY-AC>>>)>)>
 223    <REGSTO T>
 224    <COND (<==? <NODE-TYPE .NUMN> ,QUOTE-CODE>
 225           <SET NK T>
 226           <SGETREG ,AC-A <>>
 227           <AND <OR <L? <SET TN <NODE-NAME .NUMN>> 0> <G? .TN 262143>>
 228               <MESSAGE ERROR "BAD ARG TO ISTRING/IBYTES ">>
 229           <COND (<ASSIGNED? SIZD>
 230                  <EMIT '<`MOVEI  `A*  36>>
 231                  <EMIT <INSTRUCTION `IDIV  `A*  !<ADDR:VALUE .SIZD>>>
 232                  <EMIT <INSTRUCTION `MOVEI  `O*  .TN>>
 233                  <EMIT '<`ADDI  `O*  (`A ) -1>>
 234                  <EMIT '<`IDIVM  `O*  `A >>)
 235                 (ELSE
 236                  <EMIT <INSTRUCTION `MOVEI
 237                                     `A*
 238                                     </ <+ .TN </ 36 .SIZ> -1> </ 36 .SIZ>>>>)>)
 239          (ELSE
 240           <SET NK <>>
 241           <SET TEM <GEN .NUMN <DATUM FIX ,AC-A>>>
 242           <MUNG-AC ,AC-A .TEM>
 243           <RET-TMP-AC .TEM>
 244           <SGETREG ,AC-B <>>
 245           <ADD:STACK PSLOT>
 246           <COND (<NOT <ASSIGNED? SIZD>>
 247                  <EMIT '<`PUSH  `P*  `A >>
 248                  <EMIT <INSTRUCTION `ADDI  `A*  <- </ 36 .SIZ> 1>>>
 249                  <EMIT <INSTRUCTION `IDIVI  `A*  </ 36 .SIZ>>>)
 250                 (ELSE
 251                  <EMIT '<`PUSH  `P*  `A >>
 252                  <EMIT '<`MOVEI  `A*  36>>
 253                  <EMIT <INSTRUCTION `IDIV  `A*  !<ADDR:VALUE .SIZD>>>
 254                  <EMIT <INSTRUCTION `MOVE  `O*  (`P )>>
 255                  <EMIT '<`ADDI  `O*  (`A ) -1>>
 256                  <EMIT '<`IDIVM  `O*  `A >>)>)>
 257    <EMIT '<`MOVEI  `O*  |IBLOCK >>
 258    <EMIT '<`PUSHJ  `P*  |RCALL >>
 259    <SET RES <DATUM UVECTOR ,AC-B>>
 260    <SGETREG ,AC-B .RES>
 261    <MUNG-AC ,AC-A>
 262    <MUNG-AC ,AC-B .RES>
 263    <COND
 264     (<AND <NOT .GENR> <==? <NODE-TYPE .EL> ,QUOTE-CODE> <NOT <ASSIGNED? SIZD>>>
 265      <COND (<NOT <0? <CHTYPE <SET NN <NODE-NAME .EL>> FIX>>>
 266             <OR .NK
 267                     <EMIT <INSTRUCTION `JUMPGE  `B*  <SET END <MAKE:TAG>>>>>
 268             <SET NN <WOFBYTE .SIZ <CHTYPE .NN FIX>>>
 269             <SET DAT <DATUM FIX FIX>>
 270             <PUT .DAT ,DATVAL <GETREG .DAT>>
 271             <EMIT <INSTRUCTION `MOVE  <SET ACS <ACSYM <DATVAL .DAT>>> `B >>
 272             <EMIT <INSTRUCTION `MOVE  <SET OAC <ACSYM <GETREG <>>>> [.NN]>>
 273             <LABEL:TAG <SET START <MAKE:TAG>>>
 274             <EMIT <INSTRUCTION `MOVEM
 275                                .OAC
 276                                (<ADDRSYM <CHTYPE <DATVAL .DAT> AC>>)>>
 277             <EMIT <INSTRUCTION `AOBJN  .ACS .START>>
 278             <RET-TMP-AC .DAT>
 279             <MUNG-AC <DATVAL .DAT>>)>)
 280     (ELSE
 281      <OR .NK
 282          <ASSIGNED? SIZD>
 283          <EMIT <INSTRUCTION `JUMPGE  `B*  <SET END <MAKE:TAG>>>>>
 284      <RET-TMP-AC <STACK:ARGUMENT .RES>>
 285      <COND (.NK <EMIT <INSTRUCTION `PUSH  `P*  [.TN]>>)
 286            (ELSE <EMIT '<`PUSH  `P*  `(P) >>)>
 287      <EMIT <INSTRUCTION `PUSH
 288                         `P*
 289                         [<SET BP
 290                           <FORM (<COND (<NOT <ASSIGNED? SIZD>>
 291                                         <ORB #WORD *000000440000*
 292                                              <LSH .SIZ 6>>)
 293                                        (ELSE #WORD *000000440000*)>)
 294                                 (IDX)>>]>>
 295      <MAPF <> ,ADD:STACK '(2 PSLOT PSLOT)>
 296      <COND (<ASSIGNED? SIZD>
 297             <SGETREG ,AC-A <>>
 298             <EMIT '<`MOVEI  36>>
 299             <EMIT <INSTRUCTION `IDIV  !<ADDR:VALUE .SIZD>>>
 300             <EMIT '<`ASH  `A*  6>>
 301             <EMIT <INSTRUCTION `IOR  `A*  !<ADDR:VALUE .SIZD>>>
 302             <RET-TMP-AC .SIZD>
 303             <EMIT '<`DPB  `A*  [<(#WORD *000000300600*) `(P) >]>>
 304             <EMIT '<`ASH  `A*  6>>
 305             <EMIT '<`HRRM  `A*  `(TP)  -1>>
 306             <COND (<NOT .NK>
 307                    <EMIT '<`SKIPG  `(P)  -1>>
 308                    <BRANCH:TAG <SET END <MAKE:TAG>>>)>)>
 309      <COND (.GENR <SET ELD <GEN .EL DONT-CARE>> <REGSTO T>)>
 310      <LABEL:TAG <SET START <MAKE:TAG>>>
 311      <SET ETY <ISTYPE? <RESULT-TYPE .EL>>>
 312      <SET TTEM
 313           <COND (<AND .CAREFUL <NOT .ETY>> <DATUM ANY-AC ANY-AC>)
 314                 (ELSE <DATUM .OT ANY-AC>)>>
 315      <SET TEM <COND (.GENR <DOEVS .ELD .TTEM>) (ELSE <GEN .EL .TTEM>)>>
 316      <COND (<AND .CAREFUL <NOT .ETY>>
 317             <EMIT <INSTRUCTION GETYP!-OP!-PACKAGE `O*  !<ADDR:TYPE .TEM>>>
 318             <EMIT <INSTRUCTION `CAIE  `O*  <FORM TYPE-CODE!-OP!-PACKAGE .OT>>>
 319             <BRANCH:TAG |COMPER >)>
 320      <EMIT <INSTRUCTION `HRRZ  <ACSYM <SET TT <GETREG <>>>> '`(TP) >>
 321      <PUT <2 .BP> 1 <ADDRSYM .TT>>
 322      <EMIT <INSTRUCTION `IDPB  <ACSYM <CHTYPE <DATVAL .TEM> AC>> '`(P) >>
 323      <MUNG-AC <DATVAL .TEM> .TEM>
 324      <AND <TYPE? <DATTYP .TEM> AC> <MUNG-AC <DATTYP .TEM> .TEM>>
 325      <RET-TMP-AC .TEM>
 326      <VAR-STORE T>
 327      <EMIT '<`SOSE  `(P)  -1>>
 328      <BRANCH:TAG .START>
 329      <COND (<ASSIGNED? END> <LABEL:TAG .END>)>
 330      <EMIT '<`MOVE  `B*  `(TP) >>
 331      <EMIT '<`HRL  `B*  `(TP)  -1>>
 332      <EMIT '<`SUB  `TP*  [<2 (2)>]>>
 333      <EMIT '<`SUB  `P*  [<2 (2)>]>>
 334      <SGETREG <DATVAL .RES> .RES>)>
 335    <RET-TMP-AC .RES>
 336    <COND (.NK
 337           <EMIT <INSTRUCTION `MOVE
 338                              `A*
 339                              [<FORM .TN
 340                                     (<FORM TYPE-CODE!-OP!-PACKAGE .NT>)>]>>)
 341          (ELSE
 342           <AND <ASSIGNED? END> <LABEL:TAG .END>>
 343           <EMIT '<`POP  `P*  `A >>
 344           <EMIT <INSTRUCTION `HRLI  `A*  <FORM TYPE-CODE!-OP!-PACKAGE .NT>>>)>
 345    <COND (<NOT <ASSIGNED? SIZD>>
 346           <EMIT <INSTRUCTION `HRLI
 347                              `B*
 348                              <CHTYPE <ORB <LSH .SIZ 6> <LSH <MOD 36 .SIZ> 12>>
 349                                      FIX>>>)>
 350    <EMIT '<`SUBI  `B*  1>>
 351    <MOVE:ARG <FUNCTION:VALUE T> .W>>
 352
 353 <DEFINE ITUPLE-GEN (N W GENR NUMN EL TYP BYTSZ
 354                     "AUX" (START <MAKE:TAG>) (END <MAKE:TAG>) NX NT TEM
 355                           (NTEM <DATUM FIX ,AC-D>) (DOFLG <>) (ONEFLG <>)
 356                           (SFLG <GOOD-TUPLE .N>) ELD TTEM NW)
 357    #DECL ((NT) FIX (NTEM TEM) DATUM (START END) ATOM (NUMN N EL) NODE
 358           (DOFLG) <OR FIX ATOM FALSE>)
 359    <REGSTO T>
 360    <OR <TYPE-OK? <RESULT-TYPE .NUMN> FIX>
 361            <MESSAGE ERROR "BAD ARG TO ITUPLE" .N>>
 362    <COND (<==? <NODE-TYPE .NUMN> ,QUOTE-CODE>
 363           <COND (<L? <SET DOFLG <NODE-NAME .NUMN>> 0>
 364                  <MESSAGE ERROR "BAD-ARG TO ITUPLE" .N>)>)>
 365    <COND
 366     (<AND .SFLG <0? .DOFLG>> <ADD:STACK 2>)
 367     (<COND
 368       (<AND <NOT .GENR>
 369             <==? <NODE-TYPE .EL> ,QUOTE-CODE>
 370             <==? <NODE-NAME .EL> #LOSE *000000000000*>>
 371        <COND (.DOFLG <EMIT <INSTRUCTION `MOVEI  `A*  <* .DOFLG 2>>>)
 372              (ELSE
 373               <GEN .NUMN .NTEM>
 374               <AND .CAREFUL <EMIT <INSTRUCTION `JUMPL  `D*  |COMPER >>>
 375               <EMIT <INSTRUCTION `MOVEI  `A*  (<ADDRSYM <CHTYPE <DATVAL .NTEM> AC>>)>>
 376               <EMIT <INSTRUCTION `ASH  `A*  1>>
 377               <EMIT <INSTRUCTION `PUSH  `P*  <ADDRSYM <CHTYPE <DATVAL .NTEM> AC>>>>
 378               <EMIT <INSTRUCTION `JUMPE  <ACSYM <CHTYPE <DATVAL .NTEM> AC>> .END>>
 379               <RET-TMP-AC .NTEM>)>
 380        <REGSTO T>
 381        <EMIT '<`PUSHJ  `P*  |TPALOC >>
 382        <COND (<SET NX <GOOD-TUPLE .N>> <ADD:STACK <+ <CHTYPE .NX FIX> 2>>)
 383              (ELSE <ADD:STACK PSTACK>)>
 384        <LABEL:TAG .END>)
 385       (<AND <NOT .GENR>
 386             <OR <==? <SET NT <NODE-TYPE .EL>> ,QUOTE-CODE>
 387                 <==? .NT ,LVAL-CODE>
 388                 <==? .NT ,FLVAL-CODE>
 389                 <==? .NT ,FGVAL-CODE>
 390                 <==? .NT ,GVAL-CODE>>>
 391        <COND (<NOT .DOFLG>
 392               <GEN .NUMN .NTEM>
 393               <AND .CAREFUL
 394                    <EMIT <INSTRUCTION `JUMPL
 395                                       <ACSYM <CHTYPE <DATVAL .NTEM> AC>>
 396                                       |COMPER >>>)>
 397        <SET TEM <GEN .EL <DATUM ANY-AC ANY-AC>>>
 398        <COND (<NOT .DOFLG> <TOACV .NTEM> <ADD:STACK PSLOT> <ADD:STACK PSTACK>)>
 399        <COND (.DOFLG
 400               <COND (<==? .DOFLG 1> <SET ONEFLG T>)
 401                     (<EMIT <INSTRUCTION `PUSH  `P*  <VECTOR <- .DOFLG 1>>>>)>)
 402              (ELSE
 403               <EMIT <INSTRUCTION `PUSH  `P*  <ADDRSYM <CHTYPE <DATVAL .NTEM> AC>>>>
 404               <EMIT <INSTRUCTION `PUSH  `P*  <ADDRSYM <CHTYPE <DATVAL .NTEM> AC>>>>)>
 405        <COND (<NOT .DOFLG>
 406               <EMIT <INSTRUCTION `JUMPE  <ACSYM <CHTYPE <DATVAL .NTEM> AC>> .END>>)>
 407        <TOACV .TEM>
 408        <EMIT <INSTRUCTION `PUSH  `TP*  <ADDRSYM <CHTYPE <DATTYP .TEM> AC>>>>
 409        <EMIT <INSTRUCTION `PUSH  `TP*  <ADDRSYM <CHTYPE <DATVAL .TEM> AC>>>>
 410        <COND (<NOT .DOFLG>
 411               <EMIT '<`SOSG  -1 `(P) >>
 412               <EMIT <INSTRUCTION `JRST  .END>>
 413               <RET-TMP-AC .NTEM>)>
 414        <RET-TMP-AC .TEM>
 415        <REGSTO T>
 416        <COND (<AND .DOFLG .ONEFLG>)
 417              (<LABEL:TAG .START>
 418               <EMIT '<INTGO!-OP!-PACKAGE>>
 419               <EMIT <INSTRUCTION `PUSH  `TP*  -1 `(TP) >>
 420               <EMIT <INSTRUCTION `PUSH  `TP*  -1 `(TP) >>
 421               <EMIT <COND (.DOFLG '<`SOSE  `(P) >) ('<`SOSE  -1 `(P) >)>>
 422               <EMIT <INSTRUCTION `JRST  .START>>)>
 423        <LABEL:TAG .END>
 424        <COND (<SET NX <GOOD-TUPLE .N>>
 425               <OR .ONEFLG <EMIT '<`SUB  `P*  [<1 (1)>]>>>
 426               <ADD:STACK <+ <CHTYPE .NX FIX> 2>>)>)
 427       (ELSE
 428        <COND (<NOT .DOFLG>
 429               <GEN .NUMN .NTEM>
 430               <EMIT <INSTRUCTION `PUSH  `P*  <ADDRSYM <CHTYPE <DATVAL .NTEM> AC>>>>
 431               <EMIT <INSTRUCTION `PUSH  `P*  <ADDRSYM <CHTYPE <DATVAL .NTEM> AC>>>>)
 432              (ELSE
 433               <EMIT <INSTRUCTION `PUSH  `P*  [.DOFLG]>>
 434               <EMIT <INSTRUCTION `PUSH  `P*  [.DOFLG]>>)>
 435        <ADD:STACK PSLOT>
 436        <ADD:STACK PSTACK>
 437        <COND (<NOT .DOFLG>
 438               <AND .CAREFUL
 439                    <EMIT <INSTRUCTION `JUMPL
 440                                       <ACSYM <CHTYPE <DATVAL .NTEM> AC>>
 441                                       |COMPER >>>
 442               <EMIT <INSTRUCTION `JUMPE  <ACSYM <CHTYPE <DATVAL .NTEM> AC>> .END>>
 443               <RET-TMP-AC .NTEM>)>
 444        <COND (.GENR <SET ELD <GEN .EL DONT-CARE>>)>
 445        <COND (<AND .DOFLG <0? .DOFLG>> <REGSTO T>)
 446              (<REGSTO T>
 447               <LABEL:TAG .START>
 448               <EMIT '<INTGO!-OP!-PACKAGE>>
 449               <SET TEM
 450                    <COND (.GENR <DOEVS .ELD <DATUM ANY-AC ANY-AC>>)
 451                          (ELSE <GEN .EL <DATUM ANY-AC ANY-AC>>)>>
 452               <EMIT <INSTRUCTION `PUSH  `TP*  <ADDRSYM <CHTYPE <DATTYP .TEM> AC>>>>
 453               <EMIT <INSTRUCTION `PUSH  `TP*  <ADDRSYM <CHTYPE <DATVAL .TEM> AC>>>>
 454               <RET-TMP-AC .TEM>
 455               <REGSTO T>
 456               <EMIT <INSTRUCTION `SOSE  -1 `(P) >>
 457               <BRANCH:TAG .START>)>
 458        <LABEL:TAG .END>)>)>
 459    <COND (<NOT .SFLG>
 460           <COND (.DOFLG <EMIT <INSTRUCTION `MOVEI  `D*  <* .DOFLG 2>>>)
 461                 (ELSE <EMIT '<`MOVE  `D*  `(P) >> <EMIT '<`ASH  `D*  1>>)>
 462           <EMIT '<`AOS  `(P) >>)
 463          (<EMIT <INSTRUCTION `MOVEI  `D*  <* .DOFLG 2>>>)>
 464    <SET NW <TUPLE:FINAL>>
 465    <COND (<==? .W DONT-CARE> .NW) (ELSE <MOVE:ARG .W .NW>)>>
 466
 467 <SETG NAMVEC '![ITUPLE ILIST IFORM IVECTOR IUVECTOR ISTRING IBYTES!]>
 468
 469 <SETG IERS
 470       ![,ISTR-GEN
 471         ,ISTR-GEN
 472         ,IVEC-GEN
 473         ,IVEC-GEN
 474         ,ILIST-GEN
 475         ,ILIST-GEN
 476         ,ITUPLE-GEN!]>
 477
 478 <DEFINE WOFBYTE (SIZ VAL "AUX" (M <MOD 36 .SIZ>) (NUM </ 36 .SIZ>))
 479         #DECL ((SIZ VAL NUM M) FIX)
 480         <REPEAT ((TOT 0))
 481                 #DECL ((TOT) FIX)
 482                 <SET TOT <CHTYPE <ORB <LSH .TOT .SIZ> .VAL> FIX>>
 483                 <AND <L? <SET NUM <- .NUM 1>> 0> <RETURN <LSH .TOT .M>>>>>
 484 <ENDPACKAGE>\ 3\ 3\ 3