<mdl.comp>/comtem.mud.2

   1 <PACKAGE "COMTEM">
   2
   3 <ENTRY TEMPLATE-NTH TEMPLATE-PUT GET:TEMPLATE:LENGTH>
   4
   5 <USE "CODGEN" "CACS" "CHKDCL" "COMCOD" "COMPDEC">
   6
   7 <DEFINE TEMPLATE-NTH (NOD WHERE TYP TPS NK NNUM STRN NUMN
   8                       "OPTIONAL" (NOTF <>) (BRANCH <>) (DIR <>) EX1 EX2
   9                       "AUX" RLEN COMPLFORM (DIR1 .DIR)
  10                             (FLS <==? .WHERE FLUSHED>)
  11                             (B2 <COND (.BRANCH .BRANCH) (ELSE <MAKE:TAG>)>)
  12                             (TTYPE <GET <SET TYP <ISTYPE? .TYP>> TEMPLATE-DATA>)
  13                             DEST (NORMUSE <1 .TTYPE>) (RESTUSE <2 .TTYPE>)
  14                             (RX <GEN .STRN <DATUM .TYP ANY-AC>>) RUSE LENCOMB PC
  15                             TYPER PCA BITR IDX AC1 AC2)
  16    #DECL ((B2 TYPER) ATOM (AC1 AC2) <PRIMTYPE WORD>
  17           (NNUM RLEN LENCOMB PC PCA IDX) FIX (DEST) <LIST <PRIMTYPE WORD>>
  18           (RX RUSE) DATUM (TTYPE) <VECTOR [2 LIST] [2 FIX] ANY [2 FIX]>
  19           (RESTUSE NORMUSE) <LIST [REST LIST]> (COMPLFORM) <LIST ATOM [4 FIX]>
  20           (STRN NOD) NODE)
  21    <AND .NOTF <SET DIR <NOT .DIR>>>
  22    <COND (<G? .NNUM <3 .TTYPE>>
  23           <COND (<0? <4 .TTYPE>> <MESSAGE ERROR TEMPLATE-OVERFLOW!-ERRORS>)>
  24           <SET RLEN <+ 1 <MOD <- .NNUM 1 <3 .TTYPE>> <4 .TTYPE>>>>
  25           <SET COMPLFORM <NTH .RESTUSE .RLEN>>
  26           <SET COMPLFORM
  27                (<1 .COMPLFORM>
  28                 <2 .COMPLFORM>
  29                 <3 .COMPLFORM>
  30                 <+ <4 .COMPLFORM>
  31                    <* <7 .TTYPE>
  32                       <COND (<G? <- </ <- .NNUM <3 .TTYPE>> <4 .TTYPE>> 1> 0>
  33                              <- </ <- .NNUM <3 .TTYPE>> <4 .TTYPE>> 1>)
  34                             (ELSE 0)>>>
  35                 <5 .COMPLFORM>)>)
  36          (ELSE <SET COMPLFORM <NTH .NORMUSE .NNUM>>)>
  37    <SET RUSE
  38         <GOODACS .NOD <COND (.FLS DONT-CARE) (ELSE .WHERE)>>>
  39    <SET TYPER <1 .COMPLFORM>>
  40    <SET PCA <3 .COMPLFORM>>
  41    <SET PC <5 .COMPLFORM>>
  42    <SET LENCOMB <2 .COMPLFORM>>
  43    <SET DEST (<ADDRSYM <DATVAL .RX>>)>
  44    <COND (<AND <NOT <==? .LENCOMB 72>>
  45                <NOT <1? .LENCOMB>>
  46                <NOT <==? .LENCOMB 36>>>
  47           <COND (<==? <DATVAL .RUSE> ANY-AC>
  48                  <PUT .RUSE ,DATVAL <GETREG .RUSE>>)
  49                 (ELSE <SGETREG <DATVAL .RUSE> .RUSE>)>
  50           <SET AC2 <ACSYM <DATVAL .RUSE>>>)>
  51    <COND (<5 .TTYPE>
  52           <SET IDX <+ <4 .COMPLFORM> 1>>
  53           <MUNG-AC <DATVAL .RX> .RX>
  54           <EMIT <INSTRUCTION `LDB  `O  [<FORM (74816) 1 .DEST>]>>
  55           <EMIT <INSTRUCTION `SUB  <ACSYM <DATVAL .RX>> `O >>)
  56          (ELSE <SET IDX <- <4 .COMPLFORM> <6 .TTYPE>>>)>
  57    <COND (<OR <AND <NOT <==? .LENCOMB 72>> <G? .LENCOMB 36>>
  58               <AND <==? .LENCOMB 36> <NOT <0? .PCA>>>>
  59           <COND (<==? <DATTYP .RUSE> ANY-AC>
  60                  <PUT .RUSE ,DATTYP <GETREG .RUSE>>)
  61                 (ELSE <SGETREG <DATTYP .RUSE> .RUSE>)>
  62           <SET AC1 <ACSYM <DATTYP .RUSE>>>)>
  63    <TOACV .RX>
  64    <SET DEST (<ADDRSYM <DATVAL .RX>>)>
  65    <COND
  66     (<==? .LENCOMB 72>
  67      <COND (<NOT .FLS>
  68             <COND (<AND .BRANCH .NOTF>
  69                    <SET WHERE <MOVE:ARG <REFERENCE .DIR1> .RUSE>>)
  70                   (ELSE
  71                    <PUT .RUSE ,DATTYP <OFFPTR .IDX .RX .TYP>>
  72                    <PUT .RUSE ,DATVAL <OFFPTR .IDX .RX .TYP>>
  73                    <SET WHERE <MOVE:ARG .RUSE .WHERE>>)>)>
  74      <COND (.BRANCH
  75             <EMIT <INSTRUCTION GETYP!-OP!-PACKAGE
  76                                `O
  77                                .IDX
  78                                (!<ADDR:VALUE .RX>)>>
  79             <EMIT <INSTRUCTION <COND (.DIR `CAIE ) (ELSE `CAIN )>
  80                                `O
  81                                '<TYPE-CODE!-OP!-PACKAGE FALSE>>>
  82             <BRANCH:TAG .BRANCH>)>
  83      <COND (<OR .FLS <AND .BRANCH .NOTF>> <RET-TMP-AC .RX>)>)
  84     (<NOT <0? .PCA>>
  85      <COND (<==? .LENCOMB 36>
  86             <EMIT <INSTRUCTION `MOVE  .AC2 .IDX .DEST>>
  87             <RET-TMP-AC .RX>
  88             <EMIT <INSTRUCTION `HRLI  .AC1 '<TYPE-CODE!-OP!-PACKAGE STRING>>>
  89             <EMIT <INSTRUCTION `HRRI  .AC1 .PCA>>)
  90            (ELSE
  91             <PUT .RUSE ,DATTYP .TYPER>
  92             <COND (<==? .PC 36> <EMIT <INSTRUCTION `HLR  .AC2 .IDX .DEST>>)
  93                   (ELSE <EMIT <INSTRUCTION `HRR  .AC2 .IDX .DEST>>)>
  94             <RET-TMP-AC .RX>
  95             <EMIT <INSTRUCTION `HRLI
  96                                .AC2
  97                                <COND (<==? .TYPER UVECTOR> <- .PCA>)
  98                                      (ELSE <* -2 .PCA>)>>>)>)
  99     (<==? .LENCOMB 54>
 100      <COND (<==? .PC 36>
 101             <EMIT <INSTRUCTION `MOVE  .AC2 .IDX .DEST>>
 102             <EMIT <INSTRUCTION `HLR  .AC1 <+ .IDX 1> .DEST>>)
 103            (ELSE
 104             <EMIT <INSTRUCTION `MOVE  .AC2 <+ .IDX 1> .DEST>>
 105             <EMIT <INSTRUCTION `HRR  .AC1 .IDX .DEST>>)>
 106      <EMIT <INSTRUCTION `HRLI  .AC1 '<TYPE-CODE!-OP!-PACKAGE STRING>>>
 107      <RET-TMP-AC .RX>)
 108     (<==? .LENCOMB 36>
 109      <PUT .RUSE ,DATTYP .TYPER>
 110      <PUT .RUSE ,DATVAL <OFFPTR <- .IDX 1> .RX .TYP>>)
 111     (<==? .LENCOMB 18>
 112      <PUT .RUSE ,DATTYP .TYPER>
 113      <COND (<AND <==? .TYPER FALSE> .FLS>)
 114            (<EMIT <INSTRUCTION <COND (<==? .PC 36>
 115                                       <COND (<==? .TYPER FIX> `HLRE )
 116                                             (<==? .TYPER FLOAT> `HLLZ )
 117                                             (ELSE `HLRZ )>)
 118                                      (ELSE
 119                                       <COND (<==? .TYPER FIX> `HRRE )
 120                                             (<==? .TYPER FLOAT> `HRLZ )
 121                                             (ELSE `HRRZ )>)>
 122                                .AC2
 123                                .IDX
 124                                .DEST>>)>
 125      <COND (<==? .TYPER FALSE>
 126             <COND (<NOT .FLS> <SET WHERE <MOVE:ARG .RUSE .WHERE>>)>
 127             <COND (<AND .BRANCH <NOT .DIR>> <BRANCH:TAG .BRANCH>)>)>)
 128     (<1? .LENCOMB>
 129      <EMIT <INSTRUCTION `MOVE  `O  .IDX .DEST>>
 130      <SET BITR
 131           <BITS 1 <COND (<G? .PC 18> <- .PC 19>) (ELSE <- .PC 1>)>>>
 132      <SET BITR
 133           <PUTBITS #WORD *000000000000* .BITR #WORD *777777777777*>>
 134      <RET-TMP-AC .RX>
 135      <COND (<OR <AND <NOT .DIR> <NOT .BRANCH> <NOT .FLS>>
 136                 <AND <NOT .DIR1> <NOT .FLS>>>
 137             <RET-TMP-AC <MOVE:ARG <REFERENCE <>> .RUSE>>)>
 138      <COND (<G? .PC 18> <EMIT <INSTRUCTION `TLNN  `O  .BITR>>)
 139            (ELSE <EMIT <INSTRUCTION `TRNN  `O  .BITR>>)>
 140      <SET BITR <MAKE:TAG>>
 141      <COND (<NOT .DIR> <BRANCH:TAG .B2>)
 142            (ELSE <BRANCH:TAG .BITR>)>
 143      <COND (<OR <AND <NOT .DIR> <NOT .BRANCH> <NOT .FLS>>
 144                 <AND .DIR1 <NOT .FLS>>>
 145             <MOVE:ARG <REFERENCE T> .RUSE>)>
 146      <COND (<AND .DIR .BRANCH> <BRANCH:TAG .B2>)>
 147      <LABEL:TAG .BITR>
 148      <COND (<NOT .BRANCH> <LABEL:TAG .B2>)>)
 149     (ELSE
 150      <PUT .RUSE ,DATTYP .TYPER>
 151      <EMIT <INSTRUCTION `LDB
 152                         .AC2
 153                         <BYTE <- .PC .LENCOMB> .LENCOMB .IDX .DEST>>>)>
 154    <COND (<NOT <OR <NOT <0? .PCA>>
 155                    <G? .LENCOMB 36>
 156                    <1? .LENCOMB>
 157                    <==? .LENCOMB 36>>>
 158           <RET-TMP-AC .RX>)>
 159    <COND (<AND <NOT <==? .LENCOMB 72>> <NOT <==? .TYPER FALSE>>>
 160           <MOVE:ARG .RUSE .WHERE>)
 161          (ELSE .WHERE)>>
 162
 163 \\f
 164
 165 <DEFINE TEMPLATE-PUT (NOD WHERE TYP TPS NK NNUM SNOD NNOD VNOD
 166                       "OPTIONAL" EX1 EX2
 167                       "AUX" CK YDAT XDAT RLEN DEST COMPLFORM XTP VDAT
 168                             (TTYPE <GET <SET TYP <ISTYPE? .TYP>> TEMPLATE-DATA>)
 169                             (NORMUSE <1 .TTYPE>) (RESTUSE <2 .TTYPE>)
 170                             (RX <GEN .SNOD <GOODACS .NOD .WHERE>>) LENCOMB PC
 171                             TYPER PCA BITR IDX AC1 AC2 TT)
 172    #DECL ((PCA NNUM PC IDX LENCOMB RLEN) FIX (TYPER) ATOM
 173           (AC1 AC2) <PRIMTYPE WORD> (DEST) <LIST <PRIMTYPE WORD>>
 174           (RX XDAT YDAT VDAT) DATUM (RESTUSE NORMUSE) <LIST [REST LIST]>
 175           (TTYPE) <VECTOR [2 LIST] [2 FIX] ANY [2 FIX]>
 176           (COMPLFORM) <LIST ATOM [4 FIX]> (SNOD VNOD NOD) NODE)
 177    <COND (<G? .NNUM <3 .TTYPE>>
 178           <COND (<0? <4 .TTYPE>> <MESSAGE ERROR TEMPLATE-OVERFLOW!-ERRORS>)>
 179           <SET RLEN <+ 1 <MOD <- .NNUM 1 <3 .TTYPE>> <4 .TTYPE>>>>
 180           <SET COMPLFORM <NTH .RESTUSE .RLEN>>
 181           <SET COMPLFORM
 182                (<1 .COMPLFORM>
 183                 <2 .COMPLFORM>
 184                 <3 .COMPLFORM>
 185                 <+ <4 .COMPLFORM>
 186                    <* <7 .TTYPE>
 187                       <COND (<G? <- </ <- .NNUM <3 .TTYPE>> <4 .TTYPE>> 1> 0>
 188                              <- </ <- .NNUM <3 .TTYPE>> <4 .TTYPE>> 1>)
 189                             (ELSE 0)>>>
 190                 <5 .COMPLFORM>)>)
 191          (ELSE <SET COMPLFORM <NTH .NORMUSE .NNUM>>)>
 192    <SET LENCOMB <2 .COMPLFORM>>
 193    <SET TYPER <1 .COMPLFORM>>
 194    <SET PCA <3 .COMPLFORM>>
 195    <SET PC <5 .COMPLFORM>>
 196    <TOACV .RX>
 197    <SET DEST (<ADDRSYM <DATVAL .RX>>)>
 198    <COND (<SET CK <5 .TTYPE>>
 199           <SET IDX <+ <4 .COMPLFORM> 1>>
 200           <COND (<AND <5 .TTYPE> <N==? .WHERE FLUSHED>>
 201                  <PUT <DATVAL .RX> ,ACPROT T>
 202                  <SET YDAT <DATUM .TYP ANY-AC>>
 203                  <PUT .YDAT ,DATVAL <GETREG .YDAT>>
 204                  <EMIT <INSTRUCTION `MOVE
 205                                     <ACSYM <DATVAL .YDAT>>
 206                                     <ADDRSYM <DATVAL .RX>>>>
 207                  <PUT <DATVAL .RX> ,ACPROT <>>)>)
 208          (ELSE <SET IDX <- <4 .COMPLFORM> <6 .TTYPE>>>)>
 209    <SET XTP <ISTYPE? <RESULT-TYPE .VNOD>>>
 210    <COND
 211     (<NOT <1? .LENCOMB>>
 212      <SET VDAT
 213           <GEN .VNOD
 214                <DATUM <COND (<NOT <ISTYPE-GOOD? .XTP>> ANY-AC) (ELSE .XTP)>
 215                       ANY-AC>>>
 216      <COND
 217       (<AND <NOT <==? .LENCOMB 72>>
 218             <SET XTP <ISTYPE? <RESULT-TYPE .VNOD>>>>
 219        <COND (<NOT <OR <==? .TYPER .XTP> <1? .LENCOMB>>>
 220               <MESSAGE ERROR TEMPLATE-TYPE-ERROR-PUT!-ERRORS>)>)
 221       (ELSE
 222        <COND (<AND .CAREFUL
 223                    <NOT <==? .TYPER ANY>>
 224                    <NOT <==? <RESULT-TYPE .VNOD> .TYPER>>>
 225               <EMIT <INSTRUCTION GETYP!-OP!-PACKAGE `O  !<ADDR:TYPE .VDAT>>>
 226               <EMIT <INSTRUCTION `CAIE
 227                                  `O
 228                                  <FORM TYPE-CODE!-OP!-PACKAGE .TYPER>>>
 229               <BRANCH:TAG |COMPER >)>)>)>
 230    <TOACV .RX>
 231    <SET DEST (<ADDRSYM <DATVAL .RX>>)>
 232    <COND (<AND .CK <NOT <1? .LENCOMB>>>
 233           <MUNG-AC <DATVAL .RX> .RX>
 234           <EMIT <INSTRUCTION `LDB  `O  [<FORM (74816) 1 .DEST>]>>
 235           <EMIT <INSTRUCTION `SUB  <ACSYM <DATVAL .RX>> `O >>)>
 236    <COND (<NOT <1? .LENCOMB>> <SET AC2 <ACSYM <DATVAL .VDAT>>>)>
 237    <COND
 238     (<==? .LENCOMB 72>
 239      <TOACT .VDAT>
 240      <EMIT <INSTRUCTION `MOVEM  <ACSYM <DATTYP .VDAT>> .IDX .DEST>>
 241      <RET-TMP-AC <DATTYP .VDAT> .VDAT>
 242      <EMIT <INSTRUCTION `MOVEM  .AC2 <+ .IDX 1> .DEST>>)
 243     (<NOT <0? .PCA>>
 244      <COND (<==? .LENCOMB 36>
 245             <COND (.CAREFUL
 246                    <EMIT `HRRZ  `O  !<ADDR:TYPE .VDAT>>
 247                    <EMIT <INSTRUCTION `CAIE  <ACSYM <DATTYP .VDAT>> .PCA>>
 248                    <BRANCH:TAG |COMPER >)>
 249             <EMIT <INSTRUCTION `MOVEM  .AC2 .IDX .DEST>>)
 250            (ELSE
 251             <COND (.CAREFUL
 252                    <EMIT <INSTRUCTION `HLRZ  `O  <ADDRSYM <DATVAL .VDAT>>>>
 253                    <EMIT <INSTRUCTION `CAIE
 254                                       `O
 255                                       <COND (<==? .TYPER UVECTOR> <- .PCA>)
 256                                             (ELSE <* -2 .PCA>)>>>
 257                    <BRANCH:TAG |COMPER >)>
 258             <EMIT <INSTRUCTION <COND (<==? .PC 36> `HRLM ) (ELSE `HRRM )>
 259                                .AC2
 260                                .IDX
 261                                .DEST>>)>)
 262     (<==? .LENCOMB 54>
 263      <TOACT .VDAT>
 264      <COND (<==? .PC 36>
 265             <EMIT <INSTRUCTION `MOVEM  .AC2 .IDX .DEST>>
 266             <EMIT <INSTRUCTION `HRLM
 267                                <ACSYM <DATTYP .VDAT>>
 268                                <+ .IDX 1>
 269                                .DEST>>
 270             <RET-TMP-AC <DATTYP .VDAT> .VDAT>)
 271            (ELSE
 272             <EMIT <INSTRUCTION `MOVEM  .AC2 <+ .IDX 1> .DEST>>
 273             <EMIT <INSTRUCTION `HRRM  <ACSYM <DATTYP .VDAT>> .IDX .DEST>>
 274             <RET-TMP-AC <DATTYP .VDAT> .VDAT>)>
 275      <RET-TMP-AC <DATTYP .VDAT> .VDAT>)
 276     (<==? .LENCOMB 36>
 277      <EMIT <INSTRUCTION `MOVEM  .AC2 .IDX .DEST>>)
 278     (<==? .LENCOMB 18>
 279      <EMIT <INSTRUCTION <COND (<==? .PC 36>
 280                                <COND (<==? .TYPER FLOAT> `HLLM ) (ELSE `HRLM )>)
 281                               (ELSE
 282                                <COND (<==? .TYPER FLOAT> `HLRM )
 283                                      (ELSE `HRRM )>)>
 284                         .AC2
 285                         .IDX
 286                         .DEST>>)
 287     (<1? .LENCOMB>
 288      <SET BITR <BITS 1 <- .PC 1>>>
 289      <SET BITR
 290           <PUTBITS #WORD *000000000000* .BITR #WORD *777777777777*>>
 291      <SET VDAT <GEN .VNOD DONT-CARE>>
 292      <TOACV .RX>
 293      <SET DEST (<ADDRSYM <DATVAL .RX>>)>
 294      <COND (.CK
 295             <MUNG-AC <DATVAL .RX> .RX>
 296             <EMIT <INSTRUCTION `LDB  `O  [<FORM (74816) 1 .DEST>]>>
 297             <EMIT <INSTRUCTION `SUB  <ACSYM <DATVAL .RX>> `O >>)>
 298      <COND (<NOT .XTP>
 299             <SET XDAT <DATUM FIX ANY-AC>>
 300             <PUT <DATVAL .RX> ,ACPROT T>
 301             <PUT .XDAT ,DATVAL <GETREG .XDAT>>
 302             <PUT <DATVAL .RX> ,ACPROT <>>
 303             <SET TT <ACSYM <DATVAL .XDAT>>>)
 304            (ELSE <RET-TMP-AC .VDAT> <SET TT 0>)>
 305      <EMIT <INSTRUCTION `MOVE  .TT [.BITR]>>
 306      <COND (.XTP
 307             <EMIT <INSTRUCTION <COND (<==? .XTP FALSE> `ANDCAM ) (ELSE `IORM )>
 308                                .TT
 309                                .IDX
 310                                .DEST>>)
 311            (ELSE
 312             <D:B:TAG <SET BITR <MAKE:TAG>> .VDAT T <RESULT-TYPE .VNOD>>
 313             <RET-TMP-AC .XDAT>
 314             <EMIT <INSTRUCTION `ANDCAM  .TT .IDX .DEST>>
 315             <EMIT '<`SKIPA >>
 316             <LABEL:TAG .BITR>
 317             <RET-TMP-AC .VDAT>
 318             <EMIT <INSTRUCTION `IORM  .TT .IDX .DEST>>)>)
 319     (ELSE
 320      <EMIT <INSTRUCTION `DPB
 321                         .AC2
 322                         <BYTE <- .PC .LENCOMB> .LENCOMB .IDX .DEST>>>)>
 323    <COND (<NOT <1? .LENCOMB>> <RET-TMP-AC .VDAT>)>
 324    <COND (<NOT <5 .TTYPE>> <MOVE:ARG .RX .WHERE>)
 325          (<N==? .WHERE FLUSHED>
 326           <RET-TMP-AC .RX>
 327           <MOVE:ARG .YDAT .WHERE>)
 328          (ELSE <MOVE:ARG .RX .WHERE>)>>
 329
 330 "ROUTINE TO FIND THE LENGTH OF A TEMPLATE"
 331
 332 <DEFINE GET:TEMPLATE:LENGTH (NM DAT NDAT "AUX" (TD <GET .NM TEMPLATE-DATA>))
 333         #DECL ((NM) ATOM (TD) <OR FALSE <VECTOR [2 LIST] [5 ANY]>>
 334                (NDAT) <OR <DATUM ANY AC> AC>)
 335         <COND (<NOT .TD>
 336                <MESSAGE INCONSISTENCY "TEMPLATE DATA NOT AVAIABLE">)>
 337         <COND
 338          (<NOT <5 .TD>>
 339           <MESSAGE WARNING "ASKING LENGTH OF CONSTANT TEMPLATE">
 340           <EMIT <INSTRUCTION `MOVEI
 341                              <ACSYM <COND (<TYPE? .NDAT DATUM> <DATVAL .NDAT>)
 342                                           (ELSE .NDAT)>>
 343                              <LENGTH <1 .TD>>>>)
 344          (ELSE
 345           <EMIT <INSTRUCTION `MOVE
 346                              <ACSYM <COND (<TYPE? .NDAT DATUM> <DATVAL .NDAT>)
 347                                           (ELSE .NDAT)>>
 348                              !<ADDR:VALUE1
 349                                <COND (<TYPE? .DAT DATUM> <DATVAL .DAT>)>>>>
 350           <EMIT <INSTRUCTION `HRRZ
 351                              <ACSYM <COND (<TYPE? .NDAT DATUM> <DATVAL .NDAT>)
 352                                           (ELSE .NDAT)>>
 353                              (<ADDRSYM <COND (<TYPE? .NDAT DATUM>
 354                                               <DATVAL .NDAT>)
 355                                              (ELSE .NDAT)>>)
 356                              <COND (<EMPTY? <2 .TD>> 0) (ELSE -1)>>>)>>
 357
 358 <DEFINE BYTE (BOUND SIZE "TUPLE" LOC)
 359         [<FORM (<+ <* .BOUND 4096> <* .SIZE 64>>) !.LOC>]>
 360
 361 <ENDPACKAGE>