mim/development/mim/vaxc/postload.mud

   1
   2 <SETG DEAD-MIM-CODES
   3       <UVECTOR ,ADD!-MIMOP ,SUB!-MIMOP ,AND!-MIMOP ,XOR!-MIMOP ,EQV!-MIMOP>>
   4
   5 <MSETG FT-ADDR <TYPE-CODE FALSE EXTWORD>>
   6
   7 <SET REDEFINE T>
   8
   9 ;<DEFINE FLOATCONVERT (CNS "AUX" RES)
  10         #DECL ((CNS) <OR FIX FLOAT>)
  11         <COND (<==? .CNS 0.0000000> 0)
  12               (ELSE
  13                <SET RES
  14                     <COND (<L? .CNS 0.0000000> <PUTBITS 0 <BITS 1 15> 1>)
  15                           (ELSE 0)>>
  16                <SET CNS <CHTYPE <ABS .CNS> FIX>>
  17                <COND (<NOT <0? <CHTYPE <ANDB .CNS 4> FIX>>>
  18                       <SET CNS <+ .CNS 8>>)>
  19                <SET RES
  20                     <PUTBITS .RES <BITS 8 7> <GET-FIELD .CNS <BITS 8 27>>>>
  21                <SET RES <PUTBITS .RES <BITS 16 16>
  22                                  <GET-FIELD .CNS <BITS 16 2>>>>
  23                <CHTYPE <PUTBITS .RES <BITS 7> <GET-FIELD .CNS <BITS 7 19>>>
  24                        FIX>)>>
  25
  26 ;<DEFINE FLOAT-IMM (X) #DECL ((X) FIX)
  27         <COND (<AND <0? <CHTYPE <ANDB .X *777777736017*> FIX>>
  28                     <NOT <0? <CHTYPE <ANDB .X *40000*> FIX>>>>
  29                <MA-IMM <CHTYPE <GETBITS .X <BITS 6 4>> FIX>>)
  30               (ELSE <MA-IMM .X>)>>
  31
  32 ;<DEFINE FIX-CONSTANT? (CONST)
  33         #DECL ((CONST) ANY)
  34         <COND (<TYPE? .CONST FLOAT> <FLOATCONVERT .CONST>)
  35               (<==? <TYPEPRIM <TYPE .CONST>> FIX>
  36                <SET CONST <CHTYPE .CONST FIX>>
  37                <COND (<==? .CONST <CHTYPE <MIN> FIX>> ,32MIN)
  38                      (<==? .CONST <CHTYPE <MAX> FIX>> ,32MAX)
  39                      (.CONST)>)
  40               (<AND <==? <TYPEPRIM <TYPE .CONST>> LIST> <EMPTY? .CONST>> 0)>>
  41
  42
  43 <SET REDEFINE <>>