mim/development/mim/vaxc/asmgen.mud

   1
   2 "CODE IS STORED IN A LIST OF UVECTORS.  EACH INSTRUCTION IS A FIX.  THE
   3  INSTRUCTION CONTAINS THE INSTRUCTION BYTE (8 BITS) + INFORMATION TO FIX UP THE
   4  INSTRUCTION.  WHEN AN INSTRUCTION DOES NOT FIT INTO A SINGLE FIX IT IS
   5  FOLLOWED BY ADDITIONAL FIXES.  EVERY INSTRUCTION TAKES UP AN INTEGER NUMBER OF
   6  FIXES EVEN THOUGH THE OUTPUT VERSION MAY BE DIFFERENT.  THERE IS A TEMPORARY
   7  FIXUP TABLE WHICH IS USED TO DETERMINE THE LOCATION OF THE TEMPORARIES AND
   8  ALSO A LABEL FIXUP TABLE TO KEEP TRACK OF THE LABELS.  THE SYSTEM ATTEMPTS
   9  TO FIX UP LABELS IN PARTICULAR INTERVALS SO THAT IT DOESN'T HAVE TO KEEP
  10  TRACK OF TOO MANY LABELS.  ANY NON-LOOPING LABELS WILL BE FLUSHED AS SOON
  11  AS THEY ARE FIXED UP.  THERE IS ALSO A CONSTANT TABLE WHICH KEEPS TRACK OF
  12  THE LOCATION OF ALL FULL-WORD CONSTANTS.  THESE ARE FIXED UP LIKE LABELS.  IN
  13  GENERAL THE FIRST OCCURANCE OF A 32 BIT CONSTANT WILL BE OUTPUT AS AN
  14  IMMEDIATE INSTRUCTION.  ALL OTHER OCCURANCES WILL BE OUTPUT AS A REFERENCE
  15  TO THAT CONSTANT IN PC-RELATIVE MODE (THIS WILL BE AN OPTION.  WE MAY
  16  EVENTUALLY GENERATE ALL CONSTANTS IMMEDIATE IF THAT PROVES TO GENERATE
  17  FASTER RUNNING CODE"
  18
  19 <DEFINE INIT-CODE ()
  20         <SETG CURRENT-CODE <IUVECTOR ,CODEVEC-LENGTH 0>>
  21         <SETG CODE-LIST (,CURRENT-CODE)>
  22         <SETG CODE-COUNT 1>>
  23
  24 <DEFINE RESET-CODE ()
  25         <SETG CURRENT-CODE <1 ,CODE-LIST>>
  26         <SETG CODE-COUNT 1>
  27         <SETG SAVED-CODE-COUNT <>>
  28         <SETG SAVED-CODE-STACK ()>>
  29
  30 <DEFINE NTH-CODE (NUM "AUX" (CL ,CODE-LIST))
  31         #DECL ((NUM) FIX (CL) <LIST [REST CODEVEC]>)
  32         <REPEAT ((PTR .NUM))
  33                 <COND (<L=? .PTR ,CODEVEC-LENGTH> <RETURN <NTH <1 .CL> .PTR>>)>
  34                 <COND (<EMPTY? <SET CL <REST .CL>>>
  35                        <ERROR OUT-OF-BOUNDS .NUM NTH-CODE>)>
  36                 <SET PTR <- .PTR ,CODEVEC-LENGTH>>>>
  37
  38 <DEFINE PUT-CODE (NUM VAL "AUX" (CL ,CODE-LIST))
  39         #DECL ((NUM VAL) FIX (CL) <LIST [REST CODEVEC]>)
  40         <REPEAT ((PTR .NUM))
  41                 <COND (<L=? .PTR ,CODEVEC-LENGTH>
  42                        <PUT <1 .CL> .PTR .VAL>
  43                        <RETURN>)>
  44                 <COND (<EMPTY? <SET CL <REST .CL>>>
  45                        <ERROR OUT-OF-BOUNDS .NUM>)>
  46                 <SET PTR <- .PTR ,CODEVEC-LENGTH>>>>
  47
  48 <DEFINE ADD-WORD-TO-CODE (WD
  49                           "AUX" RLST (CCODE ,CURRENT-CODE)
  50                                 (COUNT ,CODE-COUNT))
  51         #DECL ((WD) FIX)
  52         <COND (<EMPTY? .CCODE>
  53                <SET RLST
  54                     <REST ,CODE-LIST <- </ <- .COUNT 1> ,CODEVEC-LENGTH> 1>>>
  55                <COND (<1? <LENGTH .RLST>>
  56                       <SET CCODE <IUVECTOR ,CODEVEC-LENGTH 0>>
  57                       <PUTREST .RLST (.CCODE)>)
  58                      (ELSE <SET CCODE <2 .RLST>>)>)>
  59         <PUT .CCODE 1 .WD>
  60         <SETG CURRENT-CODE <REST .CCODE>>
  61         <SETG CODE-COUNT <+ .COUNT 1>>>
  62
  63 <DEFINE PRINT-SPEC-LABEL (X "AUX" (OUTCHAN .OUTCHAN))
  64         #DECL ((X) SPEC-LABEL)
  65         <PRINC "ITAG" .OUTCHAN>
  66         <PRIN1 <CHTYPE .X FIX> .OUTCHAN>>
  67
  68 <COND (<GASSIGNED? PRINT-SPEC-LABEL> <PRINTTYPE SPEC-LABEL ,PRINT-SPEC-LABEL>)>
  69
  70 <DEFINE PRINT-LABEL-REF (LREF "AUX" (OUTCHAN .OUTCHAN))
  71         #DECL ((LREF) LABEL-REF)
  72         <PRINC "#LABEL-REF " .OUTCHAN>
  73         <PRIN1 <LABEL-REF-NAME .LREF> .OUTCHAN>>
  74
  75 <COND (<GASSIGNED? PRINT-LABEL-REF> <PRINTTYPE LABEL-REF ,PRINT-LABEL-REF>)>
  76
  77 <DEFINE INIT-LABEL-TABLE (RESTART "AUX" TMP LAB)
  78         <SETG LABEL-TABLE ()>
  79         <SET LAB <CREATE-LABEL-REF \ >>
  80         <SET TMP <IVECTOR ,MAX-OUTST-LABELS '.LAB>>
  81         <SETG OUTST-LABEL-TABLE <REST .TMP <LENGTH .TMP>>>
  82         <AND .RESTART <SETG CURRENT-SLABEL 0>>
  83         <SETG PTNS-TABLE ()>
  84         <SETG PTNS-COUNT 1>>
  85
  86 <DEFINE MAKE-LABEL ("OPTIONAL" (ATM? <>) "AUX" STR
  87                     (NUM <COND (<NOT <GASSIGNED? CURRENT-SLABEL>> 0)
  88                                (,CURRENT-SLABEL)>))
  89         <SET NUM <+ .NUM 1>>
  90         <SETG CURRENT-SLABEL .NUM>
  91         <COND (.ATM?
  92                <COND (<NOT <TYPE? .ATM? STRING>> <SET ATM? "ITAG">)>
  93                <SET STR <STRING .ATM? <UNPARSE .NUM>>>
  94                <OR <LOOKUP .STR ,VAR-OBLIST> <INSERT .STR ,VAR-OBLIST>>)
  95               (<CHTYPE .NUM SPEC-LABEL>)>>
  96
  97 <DEFINE COPY-PSAVE (PSAVE NCODE "AUX" RES INST)
  98         #DECL ((PSAVE) PTN-SAVE (NCODE) CODEVEC)
  99         <SET RES
 100              <CHTYPE <VECTOR .NCODE
 101                              <PTNS-VAR .PSAVE>
 102                              <PTNS-KIND .PSAVE>
 103                              <PTNS-USE .PSAVE>
 104                              ()>
 105                      PTN-SAVE>>
 106         <PUT .PSAVE ,PTNS-SUBS (.RES !<PTNS-SUBS .PSAVE>)>
 107         <SETG PTNS-TABLE (.RES !,PTNS-TABLE)>
 108         <SET INST <PUT-RHW ,INST-PSTORE ,PTNS-COUNT>>
 109         <SETG PTNS-COUNT <+ ,PTNS-COUNT 1>>
 110         .INST>
 111
 112 <DEFINE KILL-PSAVE (PSAVE)
 113         #DECL ((PSAVE) PTN-SAVE)
 114         <PUT .PSAVE ,PTNS-USE <>>
 115         <MAPF <> <FCN (SPS) <PUT .SPS ,PTNS-USE <>>> <PTNS-SUBS .PSAVE>>>
 116
 117 <DEFINE EMIT-POTENTIAL-STORE (CODE KIND LVAR "AUX" PTN)
 118         #DECL ((CODE) CODEVEC (KIND) ATOM (LVAR) LINKVAR)
 119         <SET PTN
 120              <CHTYPE <VECTOR .CODE <LINKVAR-VAR .LVAR> .KIND T ()> PTN-SAVE>>
 121         <SETG PTNS-TABLE (.PTN !,PTNS-TABLE)>
 122         <ADD-WORD-TO-CODE <CHTYPE <ORB <LSH ,INST-PSTORE 24>
 123                                        ,PTNS-COUNT>
 124                                   FIX>>
 125         <SETG PTNS-COUNT <+ ,PTNS-COUNT 1>>
 126         <MAPF <>
 127               <FCN (XREF "AUX" (CPSAVE <XREF-INFO-PSAVES .XREF>))
 128                    <PUT .XREF ,XREF-INFO-PSAVES (.PTN !.CPSAVE)>>
 129               <LINKVAR-POTENTIAL-SAVES .LVAR>>>
 130
 131 <DEFINE GET-PTNS (NUM) <NTH ,PTNS-TABLE <- ,PTNS-COUNT .NUM>>>
 132
 133 <DEFINE SAVE-XREF-AC-INFO (XREF SSTATE SLSTATE)
 134         #DECL ((XREF) XREF-INFO (SSTATE) AC-STATE (SLSTATE) SLOAD-STATE)
 135         <PUT .XREF ,XREF-INFO-SAVED-AC-INFO .SSTATE>
 136         <PUT .XREF ,XREF-INFO-SLSTATE .SLSTATE>>
 137
 138 <DEFINE PRINT-XREF-INFO (XREF "AUX" (OUTCHAN .OUTCHAN))
 139         #DECL ((XREF) XREF-INFO)
 140         <PRINC "#XREF-INFO " .OUTCHAN>
 141         <PRIN1 <LABEL-REF-NAME <XREF-INFO-LABEL .XREF>> .OUTCHAN>
 142         <PRINC " " .OUTCHAN>
 143         <PRIN1 <XREF-INFO-POINT .XREF> .OUTCHAN>>
 144
 145 <COND (<GASSIGNED? PRINT-XREF-INFO> <PRINTTYPE XREF-INFO ,PRINT-XREF-INFO>)>
 146
 147 "UPDATE THE LABEL TABLES FOR A BRANCH"
 148
 149 <DEFINE UPDLT-BRANCH (LABEL CODEPTR STATUS? LILEN FORCEL?
 150                       "AUX" NLREF (OUTST ,OUTST-LABEL-TABLE) XREF)
 151         #DECL ((LABEL) <OR ATOM SPEC-LABEL> (CODEPTR) FIX (FORCEL?) BOOLEAN)
 152         <SET NLREF <GET-LREF .LABEL>>
 153         <ADD-XREF .NLREF .CODEPTR .STATUS? .LILEN .FORCEL?>>
 154
 155 <DEFINE GET-LREF GL (LABEL "OPTIONAL" (JUST-LOOKING? <>) "AUX" NLR)
 156   #DECL ((LABEL) <OR ATOM SPEC-LABEL>)
 157   <MAPF <>
 158     <FUNCTION (LREF)
 159       #DECL ((LREF) LABEL-REF)
 160       <COND (<==? <LABEL-REF-NAME .LREF> .LABEL>
 161              <COND (<NOT .JUST-LOOKING?>
 162                     <LABEL-REF-NOT-REAL .LREF <>>)>
 163              <RETURN .LREF .GL>)>>
 164     ,OUTST-LABEL-TABLE>
 165   <SET NLR <CREATE-LABEL-REF .LABEL>>
 166   <LABEL-REF-NOT-REAL .NLR .JUST-LOOKING?>
 167   <ADD-OUTSTANDING-LABEL .NLR>
 168   .NLR>
 169
 170 <DEFINE CREATE-LABEL-REF (NAME)
 171         #DECL ((NAME) <OR ATOM SPEC-LABEL>)
 172         <CHTYPE [.NAME () -1 0 <> <> () () <>] LABEL-REF>>
 173
 174 <DEFINE ADD-OUTSTANDING-LABEL (LREF "AUX" (OUTST ,OUTST-LABEL-TABLE) NOUTST)
 175         #DECL ((LREF) LABEL-REF)
 176         <COND (<==? .OUTST <TOP .OUTST>>
 177                <SET NOUTST <VECGROW .OUTST ,MAX-OUTST-LABELS>>
 178                <SET NOUTST <REST .NOUTST <- ,MAX-OUTST-LABELS 1>>>
 179                <PUT .NOUTST 1 .LREF>
 180                <SUBSTRUC .OUTST 0 <LENGTH .OUTST> <REST .NOUTST>>
 181                <SETG OUTST-LABEL-TABLE .NOUTST>)
 182               (ELSE
 183                <SET OUTST <BACK .OUTST>>
 184                <PUT .OUTST 1 .LREF>
 185                <SETG OUTST-LABEL-TABLE .OUTST>)>>
 186
 187 "FINDS AND REMOVES A LABEL FROM THE OUTSTANDING LABEL TABLE.  THE LABEL WILL
 188  NOT BE REMOVED IF IT IS A LOOP LABEL"
 189
 190 <DEFINE REMOVE-OUTSTANDING-LABEL (LABEL "AUX" (OUTST ,OUTST-LABEL-TABLE))
 191         #DECL ((LABEL) <OR SPEC-LABEL ATOM> (OUTST) <VECTOR [REST LABEL-REF]>
 192                (VALUE) <OR FALSE LABEL-REF>)
 193         <REPEAT ((PTR 1) LREF (LEN <LENGTH .OUTST>))
 194                 <COND (<G? .PTR .LEN> <RETURN <>>)>
 195                 <SET LREF <NTH .OUTST .PTR>>
 196                 <COND (<==? <LABEL-REF-NAME .LREF> .LABEL>
 197                        <COND (<OR <LABEL-REF-LOOP-LABEL .LREF>
 198                                   <LABEL-REF-NOT-REAL .LREF>>
 199                               <RETURN .LREF>)
 200                              (<==? .PTR 1>
 201                               <SETG OUTST-LABEL-TABLE <REST .OUTST>>
 202                               <RETURN .LREF>)
 203                              (ELSE
 204                               <SUBSTRUC .OUTST 0 <- .PTR 1> <REST .OUTST>>
 205                               <SETG OUTST-LABEL-TABLE <REST .OUTST>>
 206                               <RETURN .LREF>)>)>
 207                 <SET PTR <+ .PTR 1>>>>
 208
 209 "UPDATE LABEL TABLES WHEN ENCOUNTERING AN ACTUAL LABEL"
 210
 211 <DEFINE UPDLT-LABEL (LABEL CODEPTR LOOP?
 212                      "AUX" LREF (LTAB ,LABEL-TABLE)
 213                            (TABPTR <+ <LENGTH .LTAB> 1>))
 214         #DECL ((LABEL) <OR ATOM SPEC-LABEL> (CODEPTR) FIX
 215                (LOOP?) <OR FALSE AC-STATE ATOM>)
 216         <SET LREF <REMOVE-OUTSTANDING-LABEL .LABEL>>
 217         <COND (<NOT .LREF>
 218                <SET LREF <CREATE-LABEL-REF .LABEL>>
 219                <ADD-OUTSTANDING-LABEL .LREF>)
 220               (<LABEL-REF-NOT-REAL .LREF <>>)>
 221         <PUT .LREF ,LABEL-REF-CODE-PTR .CODEPTR>
 222         <PUT .LREF ,LABEL-REF-LOOP-LABEL .LOOP?>
 223         <COND (<EMPTY? .LTAB> <SETG LABEL-TABLE (.LREF)>)
 224               (<PUTREST <REST .LTAB <- <LENGTH .LTAB> 1>> (.LREF)>)>
 225         <FIXUP-BRANCH-REFERENCES <LABEL-REF-XREFS .LREF> .TABPTR>
 226         <LABEL-REF-LIVE-VARS .LREF ()>
 227         <LABEL-REF-DEAD-VARS .LREF ()>
 228         .LREF>
 229
 230 <DEFINE FIXUP-BRANCH-REFERENCES (XREFS TABPTR)
 231         #DECL ((XREFS) <LIST [REST XREF-INFO]> (TABPTR) FIX)
 232         <MAPF <>
 233               <FCN (XREF "AUX" (CODPTR <XREF-INFO-POINT .XREF>) INST)
 234                    <SET INST
 235                         <CHTYPE <ORB <NTH-CODE .CODPTR> .TABPTR> FIX>>
 236                    <PUT-CODE .CODPTR .INST>>
 237               .XREFS>>
 238
 239 <DEFINE ADD-XREF (LREF CODPTR STATUS? LILEN FORCEL? "AUX" XREF)
 240         #DECL ((LREF) LABEL-REF (CODPTR) FIX (VALUE) XREF-INFO (STATUS?) ANY
 241                (LILEN) FIX (FORCEL?) BOOLEAN)
 242         <SET XREF
 243              <CHTYPE <VECTOR .LREF
 244                              .CODPTR
 245                              <>
 246                              <>
 247                              <>
 248                              0
 249                              .STATUS?
 250                              .LILEN
 251                              ,CODE-COUNT
 252                              <>
 253                              ()
 254                              .FORCEL?>
 255                      XREF-INFO>>
 256         <PUT .LREF ,LABEL-REF-XREFS (.XREF !<LABEL-REF-XREFS .LREF>)>
 257         .XREF>
 258
 259 <DEFINE EMIT-BRANCH (INST LABEL STATUS? LILEN
 260                      "OPTIONAL" (ACNUM <>) (FORCEL? <>) (XT <>)
 261                      "AUX" XREF (CNT 1) LREF)
 262         #DECL ((INST) FIX (LABEL) <OR ATOM SPEC-LABEL> (XREF) XREF-INFO
 263                (FORCEL?) BOOLEAN)
 264         <SET INST <CHTYPE <LSH .INST 24> FIX>>
 265         <SET XREF <UPDLT-BRANCH .LABEL ,CODE-COUNT .STATUS? .LILEN .FORCEL?>>
 266         <SET LREF <XREF-INFO-LABEL .XREF>>
 267         <COND (<NOT <0? <LABEL-REF-CODE-PTR .LREF>>>
 268                <MAPF <>
 269                      <FUNCTION (TREF)
 270                              <COND (<==? .TREF .LREF> <MAPLEAVE>)>
 271                              <SET CNT <+ .CNT 1>>>
 272                      ,LABEL-TABLE>
 273                <SET INST <CHTYPE <ORB .INST .CNT> FIX>>)>
 274         <COND (.ACNUM <SET INST <CHTYPE <ORB .INST <LSH .ACNUM -8>> FIX>>)>
 275         <ADD-WORD-TO-CODE .INST>
 276         <SETG LAST-INST-LENGTH 1>
 277         .XREF>
 278
 279 <DEFINE EMIT-LABEL (LABEL LOOP?)
 280         #DECL ((LABEL) <OR ATOM SPEC-LABEL> (LOOP?) <OR FALSE AC-STATE ATOM>)
 281         <UPDLT-LABEL .LABEL ,CODE-COUNT .LOOP?>>
 282
 283 "THE CONSTANT TABLE CONSISTS OF CONSTANT ADDRESS PAIRS.  THE ADDRESS MAY HAVE
 284  3 STATES.  IF IT IS NON-ZERO. THEN IT IS THE ADDRESS OF THE MOST RECENT
 285  EMITTED VERSION OF A CONSTANT.  IF IT IS ZERO THEN IT INDICATES THAT A VERSION
 286  OF THE CONSTANT WILL BE EMITTED BY SOME INSTRUCTION IN THE CURRENT SUBROUTINE
 287  -1 IS USED BY THE SCAN PASS TO INDICATE THAT THE CONSTANT WILL HAVE BEEN
 288  BEEN EMITTED BY A PREVIOUS INSTRUCTION"
 289
 290 <DEFINE INIT-CONSTANTS ()
 291         <SETG CONSTANT-POINTER 1>
 292         <SETG CONSTANT-TABLE <IUVECTOR ,CONSTANT-TABLE-SIZE 0>>>
 293
 294 <DEFINE RESET-CONSTANTS () <SETG CONSTANT-POINTER 1>>
 295
 296 "WARNING: THIS ADDS AN ENTRY  TO THE CONSTANT TABLE  IF IT IS NOT
 297   ALREADY THERE.  THE INITIAL VERSION OF THIS ALGORITHM USES LINEAR
 298   SEARCH.  THIS MAY SLOW DOWN THE WORLD"
 299
 300 <DEFINE AGEN-CONST (NUM "AUX" (TAB ,CONSTANT-TABLE) NTAB)
 301    #DECL ((NUM) FIX)
 302    <REPEAT ((PTR 1))
 303            <COND
 304             (<==? .PTR ,CONSTANT-POINTER>
 305              <COND (<G? .PTR <LENGTH .TAB>>
 306                     <SET NTAB
 307                          <IUVECTOR <+ <LENGTH .TAB> ,CONSTANT-TABLE-INCREMENT>
 308                                    0>>
 309                     <MAPR <>
 310                           <FCN (TAB1 TAB2) <PUT .TAB1 1 <1 .TAB2>>>
 311                           .TAB
 312                           .NTAB>
 313                     <SET TAB .NTAB>
 314                     <SETG CONSTANT-TABLE .TAB>)>
 315              <PUT ,CONSTANT-TABLE .PTR .NUM>
 316              <PUT ,CONSTANT-TABLE <+ .PTR 1> 0>
 317              <SETG CONSTANT-POINTER <+ ,CONSTANT-POINTER 2>>
 318              <RETURN .PTR>)
 319             (<==? .NUM <NTH .TAB .PTR>> <RETURN .PTR>)>
 320            <SET PTR <+ .PTR 2>>>>
 321
 322 <DEFINE INIT-PATCH-TABLE () <SETG PATCH-TABLE ()> <SETG NUM-PATCH 1>>
 323
 324 <DEFINE ADD-PATCH (PATCHTYPE "AUX" NPATCH INST (NUM ,NUM-PATCH))
 325         #DECL ((PATCHTYPE) ATOM)
 326         <SET NPATCH <CHTYPE <VECTOR ![!] .PATCHTYPE> PATCH>>
 327         <SETG PATCH-TABLE (.NPATCH !,PATCH-TABLE)>
 328         <SET INST <CHTYPE <ORB <LSH ,INST-PATCH 24> .NUM> FIX>>
 329         <ADD-WORD-TO-CODE .INST>
 330         <SETG NUM-PATCH <+ .NUM 1>>
 331         .NUM>
 332
 333 <DEFINE GET-PATCH (NUM "AUX" (TAB ,PATCH-TABLE))
 334         #DECL ((NUM) FIX (CDV) CODEVEC)
 335         <NTH .TAB <- <LENGTH .TAB> <- .NUM 1>>>>
 336
 337 <DEFINE INSERT-PATCH (NUM CDV "AUX" PATCH)
 338         #DECL ((NUM) FIX (CDV) CODEVEC)
 339         <SET PATCH <GET-PATCH .NUM>>
 340         <PUT .PATCH ,PATCH-CODE .CDV>>
 341
 342 <DEFINE EMIT (INST "TUPLE" FIELDS)
 343         <COND (<MEMQ .INST ,SPECIAL-OPS>
 344                <ADD-WORD-TO-CODE
 345                 <CHTYPE <ORB <LSH .INST 24> <ANDB .INST *7777*>> FIX>>)
 346               (ELSE <REAL-EMIT .INST .FIELDS <>>)>>
 347
 348 <GDECL (LAST-INST-LENGTH) FIX>
 349
 350
 351 <DEFINE REAL-EMIT (INST FIELDS WHERE
 352                    "AUX" (INST-INFO <GET-INST-INFO .INST>)
 353                          (NUM-OPS <CHTYPE <LSH <2 .INST-INFO> <- ,INIT-SHIFT>>
 354                                           FIX>)
 355                          (SHFT 16) (FNUM 1))
 356    #DECL ((FNUM INST NUM-OPS SHFT) FIX (WHERE) <OR FALSE FIX>
 357           (INST-INFO) <UVECTOR [3 FIX]> (FIELDS) TUPLE)
 358    <SET INST <CHTYPE <LSH .INST 24> FIX>>
 359    <COND (<NOT .WHERE> <SETG LAST-INST-LENGTH 0>)>
 360    <MAPF <>
 361          <FCN (FLD "AUX" REG-OR-LIT EAC SIZC MODC OPREQ (NBYTES 0) IMWRD)
 362               #DECL ((REG-OR-LIT EAC SIZC MODC OPREQ NBYTES IMWRD) FIX)
 363               <COND (<0? .NUM-OPS>
 364                      <ERROR TOO-MANY-OPERANDS!-ERRORS .INST !.FIELDS>)>
 365               <COND (<NOT <TYPE? .FLD EFF-ADDR LADDR>>
 366                      <ERROR BAD-CALL-TO-EMIT!-ERRORS .INST !.FIELDS>)>
 367               <COND (<TYPE? .FLD LADDR>
 368                      <SET IMWRD <CHTYPE <2 .FLD> FIX>>
 369                      <SET FLD <CHTYPE <LSH <1 .FLD> -24> FIX>>)
 370                     (ELSE
 371                      <SET IMWRD <CHTYPE <LSH .FLD 8> FIX>>
 372                      ; "??? May be loser"
 373                      <SET FLD <CHTYPE <LSH .FLD -24> FIX>>)>
 374               <SET EAC <CHTYPE <ANDB .FLD 240> FIX>>
 375               <SET REG-OR-LIT <CHTYPE <ANDB .FLD 15> FIX>>
 376               <COND (<N==? .EAC ,AM-INX>
 377                      <SET NUM-OPS <- .NUM-OPS 1>>
 378                      <SET OPREQ <GET-OP-INFO .FNUM .INST-INFO>>
 379                      <SET SIZC <CHTYPE <ANDB .OPREQ 7> FIX>>
 380                      <SET MODC <CHTYPE <LSH .OPREQ -3> FIX>>
 381                      <SET FNUM <+ .FNUM 1>>)>
 382               <COND (<AND <G=? .EAC ,AM-INX>
 383                           <L=? .EAC ,AM-ADEC>
 384                           <==? .REG-OR-LIT ,NAC-PC>>
 385                      <ERROR CANT-INDEX-PC!-ERRORS .INST !.FIELDS>)
 386                     (<G=? .EAC ,AM-AINC>
 387                      <COND (<OR <AND <OR <==? .EAC ,AM-AINCD>
 388                                          <AND <==? .EAC ,AM-AINC>
 389                                               <OR <==? .SIZC ,SZ-L>
 390                                                   <==? .SIZC ,SZ-F>>>>
 391                                      <==? .REG-OR-LIT ,NAC-PC>>
 392                                 <==? .EAC ,AM-LD>
 393                                 <==? .EAC ,AM-LDD>>
 394                             <SET NBYTES 4>)
 395                            (<OR <==? .EAC ,AM-WD>
 396                                 <==? .EAC ,AM-WDD>
 397                                 <AND <==? .EAC ,AM-AINC>
 398                                      <==? .SIZC ,SZ-W>
 399                                      <==? .REG-OR-LIT ,NAC-PC>>>
 400                             <SET NBYTES 2>)
 401                            (<OR <==? .EAC ,AM-BD>
 402                                 <==? .EAC ,AM-BDD>
 403                                 <AND <==? .EAC ,AM-AINC>
 404                                      <==? .SIZC ,SZ-B>
 405                                      <==? .REG-OR-LIT ,NAC-PC>>>
 406                             <SET NBYTES 1>)
 407                            (<AND <==? .EAC ,AM-AINC> <==? .REG-OR-LIT ,NAC-PC>>
 408                             <COND (<OR <==? .SIZC ,SZ-Q> <==? .SIZC ,SZ-D>>
 409                                    <SET NBYTES 8>)
 410                                   (<==? .SIZC ,SZ-O> <SET NBYTES 16>)
 411                                   (ELSE <ERROR FOO!-ERRORS>)>)
 412                            (ELSE <SET NBYTES 0>)>)
 413                     (ELSE <SET NBYTES 0>)>
 414               <SET INST <CHTYPE <ORB .INST <LSH .FLD .SHFT>> FIX>>
 415               <COND (<L? <SET SHFT <- .SHFT 8>> 0>
 416                      <SET SHFT 24>
 417                      <COND (.WHERE
 418                             <PUT-CODE .WHERE .INST>
 419                             <SET WHERE <+ .WHERE 1>>)
 420                            (ELSE
 421                             <ADD-WORD-TO-CODE .INST>
 422                             <SETG LAST-INST-LENGTH <+ ,LAST-INST-LENGTH 1>>)>
 423                      <SET INST 0>)>
 424               <REPEAT ()
 425                       <COND (<L? <SET NBYTES <- .NBYTES 1>> 0> <RETURN>)>
 426                       <SET INST
 427                            <CHTYPE <ORB .INST
 428                                         <LSH <ANDB .IMWRD *37700000000*>
 429                                              <- .SHFT 24>>>
 430                                    FIX>>
 431                       <SET IMWRD <CHTYPE <LSH .IMWRD 8> FIX>>
 432                       <COND (<L? <SET SHFT <- .SHFT 8>> 0>
 433                              <COND (.WHERE
 434                                     <PUT-CODE .WHERE .INST>
 435                                     <SET WHERE <+ .WHERE 1>>)
 436                                    (ELSE
 437                                     <ADD-WORD-TO-CODE .INST>
 438                                     <SETG LAST-INST-LENGTH
 439                                           <+ ,LAST-INST-LENGTH 1>>)>
 440                              <SET SHFT 24>
 441                              <SET INST 0>)>>>
 442          .FIELDS>
 443    <COND (<N==? .NUM-OPS 0> <ERROR TOO-FEW-FIELDS!-ERRORS .INST !.FIELDS>)>
 444    <COND (<N==? .SHFT 24>
 445           <COND (.WHERE <PUT-CODE .WHERE .INST> <SET WHERE <+ .WHERE 1>>)
 446                 (ELSE
 447                  <ADD-WORD-TO-CODE .INST>
 448                  <SETG LAST-INST-LENGTH <+ ,LAST-INST-LENGTH 1>>)>)>>
 449
 450
 451 <DEFINE EMIT-LABEL-WORD (LABEL "AUX" XREF LREF (INST 0) (CNT 1))
 452         #DECL ((LABEL) ATOM (XREF) XREF-INFO)
 453         <SET XREF <UPDLT-BRANCH .LABEL ,CODE-COUNT NORMAL 1 <>>>
 454         <SET LREF <XREF-INFO-LABEL .XREF>>
 455         <COND (<NOT <0? <LABEL-REF-CODE-PTR .LREF>>>
 456                <MAPF <>
 457                      <FUNCTION (TREF)
 458                              <COND (<==? .TREF .LREF> <MAPLEAVE>)>
 459                              <SET CNT <+ .CNT 1>>>
 460                      ,LABEL-TABLE>
 461                <SET INST <CHTYPE <ORB .INST .CNT> FIX>>)>
 462         <ADD-WORD-TO-CODE .INST>
 463         <SETG LAST-INST-LENGTH 1>
 464         .XREF>
 465
 466
 467 <DEFINE BAD-MOVE (EA1 EA2 MSIZE "OPT" EXTRA "AUX" INST)
 468         #DECL ((MSIZE) ATOM)
 469         <COND (<==? .MSIZE ZWL> <SET INST ,INST-MOVZWL>)
 470               (<==? .MSIZE LONG> <SET INST ,INST-MOVL>)
 471               (<==? .MSIZE WORD> <SET INST ,INST-MOVW>)
 472               (<==? .MSIZE BYTE> <SET INST ,INST-MOVB>)
 473               (<==? .MSIZE DOUBLE> <SET INST ,INST-MOVQ>)>
 474         <COND (<AND <ASSIGNED? EXTRA> .EXTRA>
 475                <COND (<N==? <PRIMTYPE .EXTRA> FIX>
 476                       <EMIT .INST .EA1 !.EXTRA .EA2>)
 477                      (T
 478                       <EMIT .INST .EA1 .EXTRA .EA2>)>)
 479               (T
 480                <EMIT .INST .EA1 .EA2>)>>
 481
 482 <DEFINE RE-EMIT-MOVE (PTR EA1 EA2 MSIZE "AUX" INST (X <TUPLE .EA1 .EA2>))
 483         #DECL ((EA1 EA2) EFF-ADDR (MSIZE) ATOM (PTR) FIX)
 484         <SET PTR <- .PTR 2>>
 485         <COND (<==? .MSIZE LONG> <SET INST ,INST-MOVL>)
 486               (<==? .MSIZE WORD> <SET INST ,INST-MOVW>)
 487               (<==? .MSIZE BYTE> <SET INST ,INST-MOVB>)
 488               (<==? .MSIZE DOUBLE> <SET INST ,INST-MOVQ>)>
 489         <REAL-EMIT .INST .X .PTR>>
 490
 491 "MAKE SURE CONSTANT IS CORRECT IF IMMEDIATE.  IF LONG WORD OPERATION
 492  SHOULD USE CONSTANT TABLE"
 493
 494 <DEFINE IMM-CHECK (EA SIZE "AUX" FLD NUM)
 495         #DECL ((EA) EFF-ADDR (SIZE) ATOM)
 496         <SET FLD <GET-FIELD .EA ,EA-FIELD>>
 497         <COND (<==? .SIZE LONG>
 498                <COND (<==? .FLD ,ADDRESS-IMM-LONG>
 499                       <CHTYPE <PUTBITS .EA ,EA-FIELD ,ADDRESS-IMM> EFF-ADDR>)
 500                      (<==? .FLD ,ADDRESS-IMM>
 501                       <SET NUM <EXTEND <LHW .EA>>>
 502                       <SET NUM <AGEN-CONST .NUM>>
 503                       <CHTYPE <PUT-LHW .FLD .NUM> EFF-ADDR>)
 504                      (.EA)>)
 505               (<==? .FLD ,ADDRESS-IMM-LONG>
 506                <ERROR "CANT USE LONG CONSTANT" .EA .SIZE IMM-CHECK>)
 507               (.EA)>>
 508
 509 <DEFINE START-CODE-INSERT ("AUX" (CNT ,SAVED-CODE-COUNT))
 510         <COND (.CNT <SETG SAVED-CODE-STACK (.CNT !,SAVED-CODE-STACK)>)>
 511         <SETG SAVED-CODE-COUNT ,CODE-COUNT>>
 512
 513 <DEFINE END-CODE-INSERT ("AUX" (CCOUNT ,CODE-COUNT) RES
 514                                (START ,SAVED-CODE-COUNT))
 515         #DECL ((VALUE) CODEVEC)
 516         <SET RES
 517              <MAPF ,UVECTOR
 518                    <FCN ("AUX" EL)
 519                         <COND (<==? .CCOUNT .START> <MAPSTOP>)>
 520                         <SET EL <NTH-CODE .START>>
 521                         <SET START <+ .START 1>>
 522                         <MAPRET .EL>>>>
 523         <SETG CODE-COUNT ,SAVED-CODE-COUNT>
 524         <REPEAT ((PTR ,CODE-COUNT) (CL ,CODE-LIST))
 525                 #DECL ((CL) <LIST [REST UVECTOR]>)
 526                 <COND (<L=? <- .PTR 1> ,CODEVEC-LENGTH>
 527                        <SETG CURRENT-CODE <REST <1 .CL> <- .PTR 1>>>
 528                        <RETURN>)>
 529                 <COND (<EMPTY? <SET CL <REST .CL>>>
 530                        <ERROR OUT-OF-BOUNDS END-CODE-INSERT>)>
 531                 <SET PTR <- .PTR ,CODEVEC-LENGTH>>>
 532         <COND (<EMPTY? ,SAVED-CODE-STACK> <SETG SAVED-CODE-COUNT <>>)
 533               (ELSE
 534                <SETG SAVED-CODE-COUNT <1 ,SAVED-CODE-STACK>>
 535                <SETG SAVED-CODE-STACK <REST ,SAVED-CODE-STACK>>)>
 536         .RES>
 537
 538 <DEFINE EMIT-MOVE GM (EA1 EA2 SZ "OPT" (EXTRA <>) "AUX" TMP (ISZ .SZ) ABS TB
 539                       INST)
 540   <COND (<AND <NOT .EXTRA>
 541               <TYPE? .EA1 LADDR>
 542               <==? <1 .EA1> <MA-AINC ,AC-PC>>
 543               <==? <LENGTH .EA1> 2>
 544               <N==? .SZ ZWL>>
 545          ; "Get constant back"
 546          <SET TMP <CHTYPE <LREV <2 .EA1>> FIX>>
 547          <IFSYS ("TOPS20"
 548                  ; "Do sign-extension"
 549                  <COND (<NOT <0? <ANDB .TMP *020000000000*>>>
 550                         <SET TMP <PUTBITS .TMP <BITS 4 32> -1>>)>)>
 551          <SET ABS <ABS .TMP>>
 552          <COND (<AND <L? .TMP 256>
 553                      <G? .TMP -128>>
 554                 <SET ISZ BYTE>)
 555                (<AND <L? .TMP 65536>
 556                      <G? .TMP -32768>>
 557                 <SET ISZ WORD>)
 558                (T
 559                 <SET ISZ LONG>)>)
 560         (<AND <TYPE? .EA1 EFF-ADDR>
 561               <L=? <SET TMP <LREV .EA1>> *77*>
 562               <G=? .TMP 0>>
 563          <SET ABS .TMP>
 564          <SET ISZ BYTE>)
 565         (T
 566          ; "can't do anything here"
 567          <BAD-MOVE .EA1 .EA2 .SZ .EXTRA>
 568          <RETURN T .GM>)>
 569   <COND (<==? .TMP 0>
 570          <SET INST <COND (<==? .SZ BYTE> ,INST-CLRB)
 571                      (<==? .SZ WORD> ,INST-CLRW)
 572                      (<==? .SZ LONG> ,INST-CLRL)
 573                      (<==? .SZ DOUBLE> ,INST-CLRQ)>>
 574          <EMIT .INST .EA2>)
 575         (<AND <L=? .ABS *77*>
 576               <G=? .ABS 0>>
 577          <SET EA1 <MA-LIT .ABS>>
 578          <COND (<G? .TMP 0>
 579                 <BAD-MOVE .EA1 .EA2 .SZ .EXTRA>)
 580                (T
 581                 <SET INST <COND (<==? .SZ BYTE> ,INST-MNEGB)
 582                                 (<==? .SZ WORD> ,INST-MNEGW)
 583                                 (<==? .SZ LONG> ,INST-MNEGL)>>
 584                 <EMIT .INST .EA1 .EA2>)>)
 585         (<==? .SZ .ISZ>
 586          <BAD-MOVE .EA1 .EA2 .SZ .EXTRA>)
 587         (T
 588          <COND (<==? .ISZ BYTE>
 589                 <SET TB ,BYTE-TAB>)
 590                (<==? .ISZ WORD>
 591                 <SET TB ,WORD-TAB>)>
 592          <COND (<L? .TMP 0>
 593                 <SET TB <1 .TB>>)
 594                (T
 595                 <SET TB <2 .TB>>)>
 596          <EMIT <COND (<==? .SZ WORD> <1 .TB>)
 597                      (T <2 .TB>)>
 598                <COND (<==? .ISZ BYTE> <MA-BYTE-IMM .TMP>)
 599                      (<==? .ISZ WORD> <MA-WORD-IMM .TMP>)
 600                      (<==? .ISZ LONG> <MA-LONG-IMM .TMP>)>
 601                .EA2>)>>
 602
 603 <DEFINE EMIT-PUSH EP (EADDR SZ "AUX" TMP (ISZ .SZ) ABS TB)
 604         #DECL ((EADDR) <OR EFF-ADDR LADDR> (SZ) ATOM (TB) VECTOR)
 605         <EMIT-MOVE .EADDR <MA-AINC ,AC-TP> .SZ>>
 606
 607 <SETG BYTE-TAB [[,INST-CVTBW ,INST-CVTWL]
 608                 [,INST-MOVZBW ,INST-MOVZBL]]>
 609 <SETG WORD-TAB [[0 ,INST-CVTWL]
 610                 [0 ,INST-MOVZWL]]>
 611
 612 <DEFINE EMIT-POP (EADDR SZ)
 613         #DECL ((EADDR) <OR AC EFF-ADDR> (SZ) ATOM)
 614         <COND (<TYPE? .EADDR EFF-ADDR> <EMIT-MOVE <MA-ADEC ,AC-TP> .EADDR .SZ>)
 615               (ELSE <EMIT-MOVE  <MA-ADEC ,AC-TP> <MA-REG .EADDR> .SZ>)>>
 616
 617 <DEFINE CLEAR-PUSH ("OPTIONAL" (LENGTH LONG))
 618         <EMIT <COND (<==? .LENGTH LONG> ,INST-CLRL)
 619                     (<==? .LENGTH WIRD> ,INST-CLRW)
 620                     (<==? .LENGTH BYTE> ,INST-CLRB)
 621                     (<==? .LENGTH DOUBLE> ,INST-CLRQ)
 622                     (ELSE ,INST-CLRO)>
 623               <MA-AINC ,AC-TP>>>
 624
 625 <DEFINE FIND-CALL-ENTRY (NAME)
 626         #DECL ((NAME) ATOM)
 627         <MAPF <>
 628               <FCN (CE)
 629                    <COND (<SAME-NAME? <CET-MSUBR-NAME .CE> .NAME>
 630                           <MAPLEAVE .CE>)>>
 631               ,CALL-ENTRY-TABLE>>
 632
 633 <DEFINE FIND-CALL-POINT (NAME NARGS "AUX" CE)
 634         #DECL ((NAME) ATOM (NARGS) FIX)
 635         <COND (<SET CE <FIND-CALL-ENTRY .NAME>> <FIND-ENTRY-LOC .CE .NARGS>)>>
 636
 637 <DEFINE FIND-ENTRY-LOC (CE NARGS "AUX" (CUV <CET-DISPATCH .CE>))
 638         #DECL ((CE) CALL-ENTRY (NARGS) FIX)
 639         <REPEAT ((FINAL <>))
 640                 <AND <==? <1 .CUV> .NARGS> <RETURN <2 .CUV>>>
 641                 <AND <==? <1 .CUV> -1> <SET FINAL <2 .CUV>>>
 642                 <COND (<AND <==? .NARGS -1> .FINAL> <RETURN .FINAL>)
 643                       (<AND <==? <LENGTH .CUV> 2> <G? .NARGS <1 .CUV>>>
 644                        <RETURN <2 .CUV>>)
 645                       (<EMPTY? .CUV> <RETURN .FINAL>)>
 646                 <SET CUV <REST .CUV 2>>>>
 647
 648 <DEFINE INIT-INTERNAL-ENTRYS () <SETG INTERNAL-ENTRY-TABLE ()>>
 649
 650 <DEFINE INIT-CALL-ENTRYS () <SETG CALL-ENTRY-TABLE ()>>
 651
 652 <DEFINE ADD-INTERNAL-ENTRY (NUMARGS LABEL "AUX" IE)
 653         #DECL ((NUMARGS) FIX (LABEL) <OR ATOM SPEC-LABEL>)
 654         <MAPF <>
 655               <FCN (LREF)
 656                    <COND (<==? <LABEL-REF-NAME .LREF> .LABEL>
 657                           <SET IE <CHTYPE <VECTOR .NUMARGS .LREF> INT-ENTRY>>
 658                           <SETG INTERNAL-ENTRY-TABLE
 659                                 (.IE !,INTERNAL-ENTRY-TABLE)>)>>
 660               ,OUTST-LABEL-TABLE>>
 661
 662 <DEFINE UPDATE-CALL-ENTRY-TABLE (FNAME "AUX" CUV CE)
 663         #DECL ((FNAME) ATOM)
 664         <SET CUV
 665              <MAPF ,UVECTOR
 666                    <FCN (IE
 667                          "AUX"
 668                          (NARGS <IE-NUMBER-ARGS .IE>)
 669                          (LABEL <IE-LABEL-REF .IE>))
 670                         <MAPRET .NARGS <LABEL-REF-REL-ADDR .LABEL>>>
 671                    ,INTERNAL-ENTRY-TABLE>>
 672         <SET CE <CHTYPE <VECTOR .FNAME .CUV> CALL-ENTRY>>
 673         <SETG CALL-ENTRY-TABLE (.CE !,CALL-ENTRY-TABLE)>
 674         .CE>
 675
 676 <SETG CALL-TABLE <IVECTOR ,CT-NUMBER-CALLS <>>>
 677
 678 <DEFINE RESET-CALL-TABLE ()
 679         <SETG CALL-POINTER 1>
 680         <MAPR <> <FCN (X) <PUT .X 1 <>>> ,CALL-TABLE>>
 681
 682 <DEFINE EMIT-CALL (FCN NUMARGS
 683                    "AUX" UC (CNT ,CALL-POINTER) (TAB ,CALL-TABLE) INST)
 684         #DECL ((FCN) ATOM (NUMARGS) FIX)
 685         <SET UC <CHTYPE <VECTOR .FCN .NUMARGS 0 0> UNRESOLVED-CALL>>
 686         <COND (<G? .CNT <LENGTH .TAB>>
 687                <SETG CALL-TABLE <VECGROW ,CALL-TABLE ,CT-NUMBER-CALLS>>)>
 688         <PUT ,CALL-TABLE .CNT .UC>
 689         <SETG CALL-POINTER <+ .CNT 1>>
 690         <ADD-WORD-TO-CODE <CHTYPE <ORB <LSH ,INST-CALL 24>
 691                                        .CNT>
 692                                   FIX>>
 693         T>
 694
 695 <DEFINE VECGROW (TAB INCR "AUX" NEWVEC)
 696         #DECL ((INCR) FIX (TAB) VECTOR)
 697         <SET NEWVEC <IVECTOR <+ <LENGTH .TAB> .INCR>>>
 698         <MAPR <> <FCN (OVEC NVEC) <PUT .NVEC 1 <1 .OVEC>>> .TAB .NEWVEC>
 699         .NEWVEC>
 700
 701 <SETG PUSH-LABEL-TABLE <IVECTOR 100 <>>>
 702
 703 <DEFINE RESET-PUSH-LABEL-TABLE () <SETG PUSH-LABEL-COUNT 1>>
 704
 705 <DEFINE EMIT-PUSH-LABEL (LABEL
 706                          "AUX" (CNT ,PUSH-LABEL-COUNT) (TAB ,PUSH-LABEL-TABLE)
 707                                INST NLREF)
 708         #DECL ((LABEL) <OR ATOM SPEC-LABEL>)
 709         <SET NLREF <CREATE-LABEL-REF .LABEL>>
 710         <ADD-OUTSTANDING-LABEL .NLREF>
 711         <COND (<G? .CNT <LENGTH .TAB>>
 712                <SETG PUSH-LABEL-TABLE <VECGROW .TAB 100>>)>
 713         <PUT ,PUSH-LABEL-TABLE .CNT .NLREF>
 714         <SETG PUSH-LABEL-COUNT <+ .CNT 1>>
 715         <ADD-WORD-TO-CODE <CHTYPE <ORB <LSH ,INST-PUSHLAB 24> .CNT>
 716                                   FIX>>
 717         T>
 718
 719 <SETG MOVE-LABEL-TABLE <IVECTOR 100 <>>>
 720
 721 <DEFINE RESET-MOVE-LABEL-TABLE () <SETG MOVE-LABEL-COUNT 1>>
 722
 723 <DEFINE EMIT-MOVE-LABEL (LABEL EA
 724                          "AUX" (CNT ,MOVE-LABEL-COUNT) (TAB ,MOVE-LABEL-TABLE)
 725                                INST NLREF)
 726         #DECL ((LABEL) <OR ATOM SPEC-LABEL>)
 727         <SET NLREF <CREATE-LABEL-REF .LABEL>>
 728         <ADD-OUTSTANDING-LABEL .NLREF>
 729         <COND (<G? .CNT <LENGTH .TAB>>
 730                <SETG MOVE-LABEL-TABLE <VECGROW .TAB 100>>)>
 731         <PUT ,MOVE-LABEL-TABLE .CNT .NLREF>
 732         <SETG MOVE-LABEL-COUNT <+ .CNT 1>>
 733         <ADD-WORD-TO-CODE <CHTYPE <ORB <LSH ,INST-MOVELAB 24>
 734                                        <LSH <ANDB .EA *37700000000*> -8>
 735                                        .CNT> FIX>>
 736         T>