{------------------------------------}
{                                    }
{ Motorola M68000 series assemblers. }
{ Common Code.                       }
{                                    }
{ Copyright M.R.King, 1984.          }
{ All rights reserved.               }
{                                    }
{------------------------------------}

   %constant %byte %integer nl = 16_0A,
                            ff = 16_0C,
                            cr = 16_0D

   %const %integer byte    = 0,
                   default = 3,
                   long    = 2,
                   short   = 4,
                   word    = 1
!------------------------------------------------------------------------------

   %integer pass, page control, i
   %own %integer line count = 0, lines per page = 62, line length = 78,
      page no = 0
   %own %string(127) header=""

   %routine start line
      %string(127) local header

      %if line count=0 %start
         print symbol(ff) %unless page no=0
         page no = page no+1
         %unless page control=0 %start
            local header = header
            %unless length(local header)<=line length-37 %start
               length(local header) = line length-37
            %finish
            print string(program title)
            spaces((line length-37-length(header))//2)
            print string(header)
            spaces((line length-36-length(header))//2)
            print string(" Page")
            write(page no, 3)
         %finish
         new lines(2)
         line count = 2
      %else
         new line
         line count = rem(line count+1, lines per page)
      %finish
   %end
!------------------------------------------------------------------------------

   %integer %array faults(1:max faults+1)
   %integer fault ptr, no faults, no warnings

   %routine fault(%integer fault no)

      %if fault ptr<max faults %start
         fault ptr = fault ptr+1
      %else
         fault no = 59
      %finish
      faults(fault ptr) = fault no
      %if fault no<0 %start
         no warnings = no warnings+1
      %else
         no faults = no faults+1
      %finish
   %end
!------------------------------------------------------------------------------

   %const %integer defined     = 16_01,
                   predefined  = 16_02,
                   multiple    = 16_03,
                   set         = 16_04,
                   lost        = 16_05

   %string(32) %array names(0:max names)
   %byte %integer %array state(-1:max names)
   %integer %array name v(-1:max names)
   %byte %integer %array name reg(-1:max names)
   %byte %integer %array name ind(-1:max names)
   %byte %integer %array name t(-1:max names)
   %byte %integer %array op t(-1:max names)
   %byte %integer %array op o(-1:max names)
   %integer %array op v(-1:max names)
   %integer %array op ve(-1:max names)
   %integer %array link(1-max hash:max names)
   %own %integer name lim = 0, table overflow = 0

   %routine init symbol table
      %integer i
      names(i) = "" %for i = 0, 1, max names
      %for i = -1, 1, max names %cycle
         state(i) = 0
         name v(i) = 0
         name reg(i) = 0
         name ind(i) = 0
         name t(i) = 0
         op o(i) = 0
         op t(i) = 0
         op v(i) = 0
         op ve(i) = 0
      %repeat
      link(i) = 0 %for i = 1-max hash, 1, max names
   %end

!------------------------------------------------------------------------

   %integer %function lookup(%string(32) name)
      %integer i, this, last

      last = 0
      last = last<<1+charno(name, i) %for i = 1, 1, length(name)
      last = -last %if last<0
      last = -rem(last, max hash)
      this = link(last)
      last = this %and this = link(this) %while this#0 %and names(this)#name
      %if this=0 %start
         %if name lim<max names %start
            name lim = name lim+1
            names(name lim) = name
            link(last) = name lim
            %result = name lim
         %else
            fault(34) %if table overflow=0
            table overflow = 1
            state(-1) = lost
            name v(-1) = 0
            name reg(-1) = 0
            name ind(-1) = 0
            name t(-1) = 0
            op o(-1) = 0
            op t(-1) = 0
            op v(-1) = 0
            op ve(-1) = 0
            fault(35)
            %result = -1
         %finish
      %else
         %result = this
      %finish
   %end
!------------------------------------------------------------------------------

   %byte %integer %array obj q(1:16)
   %own %integer obj q ptr = 0, obj output = 0,
      out base = 0, checksum = 0
   %integer pc v, obj control, output style

   %routine put nib(%integer v)

      v = v&15
      %if v>9 %start
         print symbol('A'+v-10)
      %else
         print symbol('0'+v)
      %finish
   %end
!------------------------------------------------------------------------------

   %routine put hex(%integer v)

      checksum = checksum-v
      put nib(v>>4)
      put nib(v)
   %end
!------------------------------------------------------------------------------

   %routine purge obj q
      %integer i

      %unless obj q ptr=0 %start
         %if output style=0 %start
            select output(1)
            %if obj output=0 %start
               print string("S00600004844521B")
               print symbol(cr)
               new line
            %finish
            obj output = 1
            checksum = -1
            print symbol('S')
            %if 0<=out base<=65535 %start
               print symbol('1')
               put hex(obj q ptr+3)
            %else
               print symbol('2')
               put hex(obj q ptr+4)
               put hex(out base>>16)
            %finish
            put hex(out base>>8)
            put hex(out base)
            put hex(obj q(i)) %for i = 1, 1, obj q ptr
            put hex(checksum)
            print symbol(cr)
            new line
            obj q ptr = 0
            select output(2)
         %else %if output style=2
            select output(1)
            %unless obj q ptr&1=0 %start
               obj q ptr=obj q ptr+1
               obj q(obj q ptr) = 255
            %finish
            %for i = 2, 2, obj q ptr %cycle
               print string("*=16_")
               put hex(obj q(i-1))
               put hex(obj q(i))
               print string(";")
            %repeat
            new line
            obj q ptr = 0
            select output(2)
         %finish
      %finish
      out base = pc v
   %end
!------------------------------------------------------------------------------

   %routine close

      purge obj q
      %unless obj output=0 %start
         %if output style=0 %start
            select output(1)
            print string("S9030000FC")
            print symbol(cr)
            newline
            select output(2)
         %finish
      %finish
   %end
!------------------------------------------------------------------------------

   %routine put byte(%integer v)
      %integer i

      %if pass=2 %and obj control=1 %start
         %if output style=0 %start
            purge obj q %unless out base+obj q ptr=pc v
            pc v = pc v+1
            obj q ptr = obj q ptr+1
            obj q(obj q ptr) = v&255
            purge obj q %if obj q ptr=16
         %else %if output style=1
            select output(1)
            %unless obj output=0 %or out base=pc v %start
               %if pc v<out base %start
                  fault(80)
               %finish %else %start
                  print symbol(16_FF) %for i = out base, 1, pc v-1
               %finish
            %finish
            obj output = 1
            print symbol(v)
            pc v = pc v+1
            out base = pc v
            select output(2)
         %else
            %unless obj output=0 %or out base+obj q ptr=pc v %start
               %if pc v<out base+obj q ptr %start
                  fault(80)
               %else
                  %for i = out base+obj q ptr, 1, pc v-1 %cycle
                     obj q ptr = obj q ptr+1
                     obj q(obj q ptr) = 255
                     purge obj q %if obj q ptr=8
                  %repeat
               %finish
            %finish
            pc v = pc v+1
            obj q ptr = obj q ptr+1
            obj q(obj q ptr) = v&255
            purge obj q %if obj q ptr=8
         %finish
      %else
         pc v = pc v+1
      %finish
   %end
!------------------------------------------------------------------------------

   %byte %integer pres char, curr char
   %byte %integer %array text(1:max text+1)
   %integer %array line nos(1:max include)
   %own %integer mac sp = 0, text lim = 0, text overflow = 0
   %integer line start, line lim, line ptr, print lim, print ptr,
      print q base, list flag, curr line, print q lim, quoted,
      include flag, print q ptr, print pc, no lines, no stmts,
      label end, opcode end, tab control, cycle control,
      operand pres, tab enable, macro call
   %integer %name line no
   %integer %array mac p ptr, mac p end(1:max mac lev, 0:11)
   %byte %integer %array mac p valid(1:max mac lev, 0:11)
   %integer %array mac ptr, mac end, mac ret(1:max mac lev)
   %byte %integer %array print q(1:10)

   %constant %integer max ass faults = 88
   %constant %string(63) %array fault mess(1:max ass faults) = %c
      "Byte mode not allowed",
      "Word mode not allowed",
      "Long mode not allowed",
      "Mode must be byte",
      "Mode must be word",
      "Mode must be long",
      "Size mode not allowed for this opcode",
      "Unknown opcode",
      "Short mode only allowed on braches",
      "If size specified it must be short",
      "Label missing",
      "Multiple macro definition",
      "Redefinition of assembler mnemonic",
      "Misplaced (nested) macro definition",
      "Misplaced ENDM",
      "Misplaced MEXIT",
      "Expanded call of multiply defined macro",
      "Unexpanded call of multiply defined macro",
      "Unexpanded forward macro call",
      "One or more missing ENDC's",
      "Missing ENDM",
      "END missing, generated by assembler",
      "Phase error",
      "Multiply defined symbol",
      "Vector constant out of range",
      "Shift constant out of range",
      "Quick constant out of range",
      "Short branch out of range",
      "Branch out of range",
      "Byte constant out of range",
      "Word constant out of range",
      "Unaligned instruction",
      "Branch type different from pc type",
      "Symbol table overflow, symbols may be lost",
      "Lost symbol",
      "Text overflow, macros may be truncated",
      "Truncated macro",
      "Unexpanded call of truncated macro",
      "Undefined symbol",
      "Illegal character",
      "Forward reference in symbol definition",
      "Assembler directive cannot be labelled",
      "Macro parameter not specified in call",
      "Macro expansion stack overflow",
      "Illegal macro parameter symbol",
      "Illegal index length qualifier",
      "Base must be address register",
      "Base length must be long",
      "Index must be register",
      "Closing parenthesis missing",
      "Second operand missing",
      "Displacement out of range",
      "Forward reference to long absolute symbol",
      "Indexed displacement out of range",
      "Relative displacement out of range",
      "Indexed relative displacement out of range",
      "Destination cannot be USP",
      "Destination must be data alterable or SR",
      "Too many errors for one line . . ",
      "Illegal size mode",
      "Destination must be alterable",
      "Source must be immediate or data register",
      "Source cannot be SR or USP",
      "Destination must be address register",
      "Source must be immediate",
      "Destination must be data alterable",
      "Source must be data regsiter or pre-decrement",
      "Destination must be data register or pre-decrement",
      "Source and destination must be same mode",
      "Memory shifts must be single bit",
      "Source must be data",
      "Destination must be data register",
      "Destination must be memory alterable",
      "Destination must be a register",
      "Operands must be post-increment",
      "Source must be a data register",
      "Source must be a register",
      "Destination must be control mode",
      "Source must be control mode",
      "Code in not monotonic",
      "All of SR must be used as source",
      "Destination must be displacement mode",
      "Terminating ' missing",
      "Condition stack overflow",
      "Multiple ESLE's",
      "Misplaced ELSE",
      "Misplaced ENDC",
      "Closing '>' missing"

   %routine print faults
      %integer i

      %if pass=2 %start
         %unless fault ptr=0 %start
            select output(0)
            write(line no, 4)
            space
            print symbol(text(i)) %for i = line start+1, 1, line lim-1
            new line
            select output(2)
         %finish
         %for i = 1, 1, fault ptr %cycle
            start line
            print string("**** ")

            %if faults(i)<0 %start
               print string("WARNING:")
               select output(0)
               print string("WARNING:")
               faults(i) = -faults(i)
            %else
               print string("ERROR  :")
               select output(0)
               print string("ERROR  :")
            %finish
            write(faults(i), 4)
            select output(2)
            write(faults(i), 4)
            %if 1<=faults(i)<=max ass faults %start
               space
               print string(fault mess(faults(i)))
               select output(0)
               space
               print string(fault mess(faults(i)))
            %else
               select output(0)
            %finish
            print symbol('.')
            new line
            select output(2)
            print symbol('.')
         %repeat
      %finish
   %end
!------------------------------------------------------------------------------

! line format is
!  1- 4 line no
!  6-11 PC
! 13-24 code
! 26-33 label
! 35-40 opcode
! 43-63 operands
! 65-   comment

   %routine print line
      %integer i

      %if pass=2 %and (list flag=1 %or fault ptr>0)  %start
         start line
         %if list flag=0 %and fault ptr>0 %start
            write(line no, 4)
         %else %if curr line=0
            spaces(5)
         %else
            write(curr line, 4)
         %finish
         %if print ptr=line start %start
            %if include flag=0 %start
               space
            %else
               print symbol('&')
            %finish
         %else
            print symbol('+')
         %finish
         space
         %if print pc=0 %start
            spaces(6)
         %else
            print pc = 0
            put hex(print q base>>16)
            put hex(print q base>>8)
            put hex(print q base)
         %finish
         space
         i = 0
         %while print q ptr<print q lim %and i<6 %cycle
            print q ptr = print q ptr+1
            put hex(print q(print q ptr))
            i = i+1
         %repeat
         %if print q ptr=print q lim %start
            print q lim = 0
            print q ptr = 0
         %finish
         %while i<6 %cycle
            spaces(2)
            i = i+1
         %repeat
         space
         i = 27
         %unless tab enable=0 %start
            %while print ptr<line lim %and text(print ptr+1)&127=' ' %cycle
               print ptr = print ptr+1
            %repeat
            %while i<line length %and print ptr<label end %cycle
               print ptr= print ptr+1
               print symbol(text(print ptr))
               i = i+1
            %repeat
            %cycle
               print symbol(' ')
               i = i+1
            %repeat %until i>34
            %while print ptr<line lim %and text(print ptr+1)&127=' ' %cycle
               print ptr = print ptr+1
            %repeat
            %while i<line length %and print ptr<opcode end %cycle
               print ptr = print ptr+1
               print symbol(text(print ptr))
               i = i+1
            %repeat
            %cycle
               print symbol(' ')
               i = i+1
            %repeat %until i>42
            %unless operand pres=0 %start
               %while print ptr<line lim %and text(print ptr+1)&127=' ' %cycle
                  print ptr = print ptr+1
               %repeat
               %while i<line length %cycle
                  print ptr = print ptr+1
                  operand pres=0 %and %exit %if print ptr>=line lim %or %c
                            (text(print ptr)&127=' ' %and quoted=0)
                  print symbol(text(print ptr))
                  i = i+1
                  %if text(print ptr)&127='''' %start
                     %if quoted=0 %start
                        quoted = 1
                     %else %if quoted = 1
                        quoted = 0
                     %finish
                  %else %if text(print ptr)&127='<'
                     quoted = 2 %unless macro call=0
                  %else %if text(print ptr)&127='>'
                     quoted = 0 %unless macro call=0
                  %finish
               %repeat
            %finish
            %cycle
               print symbol(' ')
               i = i+1
            %repeat %until i>57
            %while print ptr<line lim %and text(print ptr+1)=' ' %cycle
               print ptr = print ptr+1
            %repeat
         %finish
         %while i<line length %cycle
            print ptr = print ptr+1
            %exit %unless print ptr<line lim
            print symbol(text(print ptr))
            i = i+1
         %repeat
         print ptr = line lim %if print ptr>=line lim-1
         line count = 0 %if text(print ptr)=ff
      %else
         print q ptr = 0
         print q lim = 0
         print ptr = line lim
      %finish
   %end
!------------------------------------------------------------------------------

   %routine print byte(%integer v, ppc)

      print pc = print pc!ppc
      print q base = pc v %if print q lim=0
      print q lim = print q lim+1
      print q(print q lim) = v&255
   %end
!------------------------------------------------------------------------------

   %routine print long(%integer v, ppc)

      print byte(v>>24, ppc)
      print byte(v>>16, ppc)
      print byte(v>>8, ppc)
      print byte(v, ppc)
   %end
!------------------------------------------------------------------------------

   %routine next char

      %const %byte %integer %array translate(0:255) = %c
          0,  1,  2,  3,  4,  5,  6,  7,  8, 32, 10, 11, 10, 13, 14, 15,
         16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31,
         32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47,
         48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63,
         64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79,
         80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95,
         96, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79,
         80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 123, 124, 125, 126, 127,
          0,  1,  2,  3,  4,  5,  6,  7,  8, 32, 10, 11, 10, 13, 14, 15,
         16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31,
         32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47,
         48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63,
         64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79,
         80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95,
         96, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79,
         80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 123, 124, 125, 126, 127

      %if pres char=nl %start
         curr char=nl
      %else
         line ptr = line ptr+1
         curr char = text(line ptr)
      %finish
      pres char = translate(curr char)
   %end
!------------------------------------------------------------------------------

   %routine put sym(%byte %integer sym)

      %if line lim<max text %start
         line lim = line lim+1
         text(line lim) = sym
      %else %if line lim=max text
         text overflow = 1
         line lim = line lim+1
         text(line lim) = nl
         fault(36)
      %finish
   %end
!------------------------------------------------------------------------------

   %routine put call(%integer call)

      put call(call//10) %if call>9
      put sym('0'+rem(call, 10))
   %end
!------------------------------------------------------------------------------

   %byte %integer file ended

   %routine read line
      %byte %integer sym

      %constant %byte %integer %array line term(0:255) = %c
            0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 0, 0,
            0(112),
            0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 0, 0,
            0(112)

   !---------------------------------------------------------------------------

      %routine push par(%integer par no)
         %integer i

         %if mac p valid(mac sp, par no)=0 %start
            fault(43)
         %else %if mac sp<max mac lev
            mac sp = mac sp+1
            %for i = 0, 1, 11 %cycle
               mac p ptr(mac sp, i) = mac p ptr(mac sp-1, i)
               mac p end(mac sp, i) = mac p end(mac sp-1, i)
               mac p valid(mac sp, i) = mac p valid(mac sp-1, i)
            %repeat
            mac ptr(mac sp) = mac p ptr(mac sp, par no)
            mac end(mac sp) = mac p end(mac sp, par no)
            mac ret(mac sp) = text lim
         %else
            fault(44)
         %finish
      %end
   !---------------------------------------------------------------------------

      %routine get sym

         %integer %name ptr

         %while mac sp>0 %cycle
            ptr == mac ptr(mac sp)
            %exit %if ptr<mac end(mac sp)
            text lim = mac ret(mac sp)
            mac sp = mac sp-1
         %repeat
         %if mac sp=0 %start
            sym = nl
         %else
            ptr = ptr+1
            sym = text(ptr)
            %if sym&127='\' %start
               get sym
               sym = sym&127
               %if sym='@' %start
                  push par(10)
               %else %if sym='*'
                  push par(11)
                  get sym
               %else %if '0'<=sym<='9'
                  push par(sym-'0')
                  get sym
                %else
                  fault(45)
               %finish
            %finish
            %while mac sp>0 %cycle
               %exit %if mac ptr(mac sp)<mac end(mac sp)
               text lim = mac ret(mac sp)
               mac sp = mac sp-1
            %repeat
         %finish
      %end
   !---------------------------------------------------------------------------

      %on %event 9 %start
         file ended = 1
         ->clean %if line lim=line start
         put sym(nl)
         ->dirty
      %finish

      line start = text lim
      print lim = text lim
      print ptr = text lim
      line lim = text lim
      line ptr = text lim
      print q base = 0
      print q lim = 0
      print q ptr = 0
      print pc = 0
clean:%unless mac sp=0 %start
         curr line = 0
         %cycle
            get sym
            %if line lim<max text %start
               line lim = line lim+1
               text(line lim) = sym
            %else %if line lim=max text
               text overflow = 1
               line lim = line lim+1
               text(line lim) = nl
               fault(26)
            %finish
         %repeat %until line term(sym)#0
      %else %unless file ended=0
         curr line = 0
         put sym(' ')
         put sym('e')
         put sym('n')
         put sym('d')
         put sym(nl)
         fault(-22)
      %else
         %cycle
            read symbol(sym)
            %if line lim<max text %start
               line lim = line lim+1
               text(line lim) = sym
            %else %if line lim=max text
               text overflow = 1
               line lim = line lim+1
               text(line lim) = nl
               fault(26)
            %finish
         %repeat %until line term(sym)#0
         no lines = no lines+1
         line no = line no+1
         curr line = line no
      %finish
dirty:
      pres char = ' '
      next char
   %end
!------------------------------------------------------------------------------

   %routine get def
      %byte %integer sym
      %integer tag, temp

      %routine get tag
         %string(7) tag text

         tag text = ""
         read symbol(sym) %while sym=' '
         %while sym#' ' %cycle
            tag text = tag text.to string(sym)
            read symbol(sym)
         %repeat
         tag = lookup(tag text)
      %end

      %routine get hex(%integer %name val)

         val = 0
         read symbol(sym) %while sym=' '
         %cycle
            %if '0'<=sym<='9' %start
               val = val<<4+sym-'0'
            %else %if 'A'<=sym<='F'
               val = val<<4+sym-'A'+10
            %else
               %return
            %finish
            read symbol(sym)
         %repeat
      %end

      %on %event 9 %start
         -> exit
      %finish

      select input(2)

      %cycle
         sym=' '
         get tag
         get hex(temp)
         op t(tag) = temp&255
         get hex(op v(tag))
         get hex(op ve(tag))
         get hex(name v(tag))
         get hex(temp)
         name reg(tag) = temp&255
         name ind(tag) = 0
         get hex(temp)
         name t(tag) = temp&255
         get hex(temp)
         state(tag) = temp&255
         get hex(temp)
         op o(tag) = temp&255
         read symbol(sym) %while sym#nl
      %repeat
exit:
   %end
!------------------------------------------------------------------------------

   %integer pc t, pc l, blank

   %routine get tag(%integer %name tag)
      %string(32) tag text

      %if '@'<=pres char<='Z' %start
         tag text=""
         %cycle
            tag text = tag text.to string(pres char) %if length(tag text)<32
            next char
         %repeat %until %not('@'<=pres char<='Z' %or '0'<=pres char<='9')
         tag = look up(tag text)
         next char %while pres char=blank
      %else
         tag = 0
      %finish
   %end
!------------------------------------------------------------------------------

   %predicate its(%byte %integer sym)

      %if pres char=sym %start
         next char %until pres char#blank
         %true
      %else
         %false
      %finish
    %end
!------------------------------------------------------------------------------

   %const %integer reglist     = 16_41,
                   specreg     = 16_7C,
                   immediate   = 16_3C,
                   relindex    = 16_3B,
                   relative    = 16_3A,
                   abslong     = 16_39,
                   absolute    = 16_38,
                   index       = 16_30,
                   displace    = 16_28,
                   predec      = 16_20,
                   postinc     = 16_18,
                   addrind     = 16_10,
                   addreg      = 16_08,
                   datareg     = 16_00

   %predicate is absolute(%integer type)

      type = type&16_7F
      %if type=absolute %start
         %true
      %else
         %false
      %finish
   %end
!------------------------------------------------------------------------------

   %predicate is numeric(%integer type)

      type = type&16_7F
      %if absolute<=type<=relative %start
         %true
      %else
         %false
      %finish
   %end
!------------------------------------------------------------------------------

   %predicate is relative(%integer type)

      type = type&16_7F
      %if type=relative %start
         %true
      %else
         %false
      %finish
   %end
!------------------------------------------------------------------------------

   %predicate is data(%integer type)

      type = type&16_7F
      %if type=datareg %or addrind<=type<=immediate %start
         %true
      %else
         %false
      %finish
   %end
!------------------------------------------------------------------------------

   %predicate is memory(%integer type)

      type = type&16_7F
      %if addrind<=type<=immediate %start
         %true
      %else
         %false
      %finish
   %end
!------------------------------------------------------------------------------

   %predicate is control(%integer type)

      type = type&16_7F
      %if type=addrind %or displace<=type<=relindex %start
         %true
      %else
         %false
      %finish
   %end
!------------------------------------------------------------------------------

   %predicate is alterable(%integer type)

      type = type&16_7F
      %if datareg<=type<=absolute %start
         %true
      %else
         %false
      %finish
   %end
!------------------------------------------------------------------------------

   %routine %spec get expr(%integer %name val, reg, ind, type)

   %routine get ind(%integer %name reg, type, length)
      %integer dum1, dum2

      get expr(dum1, reg, dum2, type)
      %if its('.') %start
         %if its('W') %start
            length = 0
         %else %if its('L')
            length = 1
         %else
            fault(46)
         %finish
      %finish
   %end
!------------------------------------------------------------------------------

   %routine get term(%integer %name val, reg, ind, type)
      %integer count, err, ind t, ind l

      err = 0
      %cycle
         %if its('-') %start
            get term(val, reg, ind, type)
            %if type=addrind %start
               type = predec
            %else %if is numeric(type)
               val = -val
               type = absolute!type&16_80
            %else
               fault(231)
            %finish
         %else %if its('+')
            get term(val, reg, ind, type)
            fault(204) %unless is numeric(type)
         %else %if its('#')
            get expr(val, reg, ind, type)
            %if is numeric(type) %start
               type = immediate!type&16_80
            %else
               fault(231)
            %finish
         %else %if its('(')
            get expr(val, reg, ind, type)
            %if type=addreg %start
               type = addrind
               %if its(',') %start
                  type = index
                  ind l = 2
                  get ind(ind, ind t, ind l)
                  ind = ind<<1!ind l&1
                  %if ind t=addreg %start
                     ind = 16_10!ind
                  %else %unless ind t=datareg
                     fault(49)
                  %finish
               %finish
            %else %unless is numeric(type)
               fault(204)
            %finish
            %unless its(')') %start
               fault(40)
               next char %while pres char#')' %and pres char#nl
               fault(50) %unless its(')')
            %finish
         %else %if its('$')
            val = 0
            reg = 0
            ind = 0
            type = -1
            %cycle
               %if '0'<=pres char<='9' %start
                  val = val<<4+pres char-'0'
               %else %if 'A'<=pres char<='F'
                  val = val<<4+pres char-'A'+10
               %else
                  %exit
               %finish
               type = absolute
               next char
            %repeat
            fault(204) %and type=absolute %if type=-1
         %else %if its('%')
            val = 0
            reg = 0
            ind = 0
            type = -1
            %cycle
               %if '0'<=pres char<='1' %start
                  val = val<<1+pres char-'0'
               %else
                  %exit
               %finish
               type = absolute
               next char
            %repeat
            fault(204) %and type=absolute %if type=-1
         %else %if its('*')
            val = pc v
            reg = 0
            ind = 0
            type = pc t
         %else %if pres char=''''
            val = 0
            reg = 0
            ind = 0
            type = absolute
            count = 0
            %cycle
               next char
               %while pres char#'''' %and pres char#nl %cycle
                  val = val<<8+curr char
                  count = count+1 %if count<=4
                  next char
               %repeat
               fault(203) %unless its('''')
               %if pres char='''' %start
                  val = val<<8+curr char
                  count = count+1 %if count<=4
               %else
                  %exit
               %finish
            %repeat
            fault(204) %unless count<=4
         %else %if '0'<=pres char<='9'
            val = 0
            reg = 0
            ind = 0
            type = absolute
            %cycle
               val = val*10+pres char-'0'
               next char
            %repeat %until %not '0'<=pres char<='9'
         %else %if '@'<=pres char<='Z'
            get tag(val)
            type = name t(val)
            %if state(val)=0 %start
               name t(val) = pc t!16_80 %if type&16_80=0
               type = pc t!16_80
               fault(39)
            %else %if state(val)=set %or %not is numeric(type)
               %unless type&16_80=0 %start
                  type = pc t!16_80
                  fault(202)
               %finish
            %finish
            reg = name reg(val)
            ind = name ind(val)
            val = name v(val)
         %else %if pres char=nl
            err = 1
            val = 0
            reg = 0
            ind = 0
            type = 0
         %else
            err = 1
            next char
            %continue
         %finish
         %exit
      %repeat
      fault(40) %unless err=0
   %end
!------------------------------------------------------------------------------

   %routine form reg list(%integer %name v, reg, t)

      %if t=datareg %start
         v = 1<<reg
         reg = 0
         t = reglist
      %else %if t=addreg
         v = 16_100<<reg
         reg = 0
         t = reglist
      %else %unless t=reglist
         fault(204)
      %finish
   %end
!------------------------------------------------------------------------------

   %routine get expr(%integer %name val, reg, ind, type)
      %integer %array v stack(0:9), r stack(0:9), t stack(0:9),
                      i stack(0:8), o s(0:8), p s(0:8)
      %integer sp, op, prio, ind reg, ind t, ind l

   !---------------------------------------------------------------------------

      %routine evaluate
         %switch opcode(1:11)
         %integer r v, r r, r i, r t, i
         %integer %name l v, l r, l i, l t

         rv = v stack(sp)
         r r = r stack(sp)
         r i = i stack(sp)
         r t = t stack(sp)
         sp = sp-1
         l v == v stack(sp)
         l r == r stack(sp)
         l i == i stack(sp)
         l t == t stack(sp)

         ->opcode(os(sp))
opcode(1):  ! +
            l v = l v+r v
            l r = 0
            l i = 0
            %if (is relative(l t) %and is absolute(r t)) %or %c
                  (is relative(r t) %and is absolute(l t)) %start
               l t = relative!r t&16_80!l t&16_80
            %else
               fault(231) %unless is absolute(l t) %and is absolute(r t)
               l t = absolute!r t&16_80!l t&16_80
            %finish
            %return
opcode(2):  ! - register list
            %if r t=addreg %start
               r r = r r+8
            %else %unless r t=datareg
               fault(204)
               %return
            %finish
            l r = l r+8 %if l t=addreg
            %if l r<r r %start
               i = l r
               l r = r r
               r r = i
            %finish
            l v = 0
            r v = 1<<r r
            %for i = r r, 1, l r %cycle
               l v = l v!r v
               r v = r v<<1
            %repeat
            l r = 0
            l i = 0
            l t = reglist
            %return
opcode(3):  ! - normal
            l v = l v-r v
            l r = 0
            l i = 0
            %if is relative(l t) %and is absolute(r t) %start
               l t = relative!r t&16_80!l t&16_80
            %else
               %unless (is absolute(l t) %and is absolute(r t)) %or %c
                     (is relative(l t) %and is relative(r t)) %start
                  fault(231)
               %finish
               l t = absolute!r t&16_80!l t&16_80
            %finish
            %return
opcode(4):  ! *
            l v = lv*r v
            ->exit
opcode(5):  ! / register list
            form reg list(l v, l r, l t)
            form reg list(r v, r r, r t)
            l v = l v!r v
            %return
opcode(6):  ! / normal
            l v = l v//r v
            ->exit
opcode(7):  ! &
            l v = l v&r v
            ->exit
opcode(8):  ! !!
            l v = l v!!r v
            ->exit
opcode(9):  ! !
            l v = l v!r v
            -> exit
opcode(10): ! <<
            l v = l v<<r v
            ->exit
opcode(11): ! >>
            l v = l v>>r v
exit :   fault(231) %unless is absolute(l t) %and is absolute(r t)
         l r = 0
         l i = 0
         l t = absolute!r t&16_80!l t&16_80
      %end

      sp = 0

      %cycle
         get term(v stack(sp), r stack(sp), i stack(sp), type)
         %if type=addrind %start
            type = postinc %if its('+')
         %finish
         t stack(sp) = type
         %if its('+') %start
            op = 1
            prio = 1
         %else %if its('-')
            %if type=datareg %or type=addreg %start
               op = 2
               prio = 8
            %else
               op = 3
               prio = 1
            %finish
         %else %if its('*')
            op = 4
            prio = 2
         %else %if its('/')
            %if type=datareg %or type=addreg %or type=reglist %start
               op = 5
               prio = 7
            %else
               op = 6
               prio = 2
            %finish
         %else %if its('&')
            op = 7
            prio = 5
         %else %if its('!')
hmd frig 1:
            %if its('!') %start
               op = 8
               prio = 3
            %else
               op = 9
               prio = 4
            %finish
         %else %if its('<')
hmd frig 2:
            %if its('<') %start
               op = 10
               prio = 6
            %else
               fault(204)
               %exit
            %finish
         %else %if its('>')
hmd frig 3:
            %if its('>') %start
               op = 11
               prio = 6
            %else
               fault(204)
               %exit
            %finish
         %else
            %exit
         %finish
         %while sp>0 %cycle
            %exit %if p s(sp-1)<prio
            evaluate
         %repeat
         o s(sp) = op
         p s(sp) = prio
         sp = sp+1
      %repeat
      evaluate %while sp>0
      val = v stack(0)
      reg = r stack(0)
      ind = i stack(0)
      type = t stack(0)
      %if its('(') %start
         ind l = 2
         get ind(ind reg, ind t, ind l)
         %if its(',') %start
            fault(47) %unless ind t=addreg
            fault(48) %if indl=0
            fault(0) %unless is absolute(type)
            reg = ind reg
            type = index
            ind l = 2
            get ind(ind reg, ind t, ind l)
            ind = ind reg<<1!ind l&1
            %if ind t=addreg %start
               ind = 16_10!ind
            %else %unless ind t=datareg
               fault(49)
            %finish
         %else %if is relative(type)
            type = relindex
            ind = ind reg<<1!ind l&1
            %if ind t=addreg %start
               ind = 16_10!ind
            %else %unless ind t=datareg
               fault(49)
            %finish
         %else %if is absolute(type)
            reg = ind reg
            %if val=0 %and type&16_80=0 %start
               type = addrind
            %else
               type = displace
            %finish
            ind = 0
            fault(48) %if ind l=0
            fault(47) %unless ind t=addreg
         %else
            fault(0)
         %finish
         %unless its(')') %start
            fault(40)
            next char %while pres char#')' %and pres char#nl
            fault(50) %unless its(')')
         %finish
      %finish
   %end
!------------------------------------------------------------------------------

   %routine get second(%integer %name v, reg, ind, t, %integer def t)

      %unless its(',') %start
         next char %while pres char#',' %and preschar#nl
         %if its(',') %start
            fault(40)
            get expr(v, reg, ind, t)
         %else
            fault(51)
            t = def t
            reg = 0
            ind = 0
            v = 0
         %finish
      %else
         get expr(v, reg, ind, t)
      %finish
   %end
!------------------------------------------------------------------------------

   %integer label

   %routine set lab
      %unless label=0 %start
         %if pass=1 %start
            %if state(label)=0 %start
               name v(label) = pc v
               name reg(label) = 0
               name ind(label) = 0
               name t(label) = pc t
               state(label) = defined
            %else
               state(label) = multiple %unless state(label)=predefined
            %finish
         %else %if state(label)=defined
            fault(23) %unless name v(label)=pc v
            name t(label) = pc t
         %else
            fault(24) %unless state(label)=lost
         %finish
         label = 0
      %finish
   %end
!------------------------------------------------------------------------------

   %routine put(%integer v)

      %unless pc v&1=0 %start
         fault(32)
         put byte(0)
      %finish
      print byte(v>>8, 1)
      print byte(v, 1)
      put byte(v>>8)
      put byte(v)
   %end
!------------------------------------------------------------------------------

   %routine set src(%integer %name v, reg, ea)
      %byte %integer trunc ea

      trunc ea = ea&16_7F
      %if datareg<=trunc ea<=index %start
         ea = ea&16_38
      %else %if trunc ea=absolute
         %unless ea&16_80=0 %start
            %if pc t=absolute %and pc l=1 %start
               ea = abslong
            %else
               ea = absolute
            %finish
         %else %unless -32768<=v<=32767
            ea = abslong
         %else
            ea = absolute
         %finish
         reg = 0
      %else %if trunc ea=relative
         %if ea&16_80#0 %and pc t=absolute %and pc t=1 %start
            ea = abslong
         %else
            ea = relative
         %finish
         reg = 0
      %else %if relindex<=trunc ea<=immediate
         ea = ea&16_3F
         reg = 0
      %else
         fault(63)
         ea = datareg
         reg = 0
      %finish
   %end
!------------------------------------------------------------------------------

   %routine put src(%integer o v, v, reg, %integer %name ea)

      set src(v, reg, ea)
      put(ov!ea!reg)
   %end
!------------------------------------------------------------------------------

   %routine set dest(%integer %name v, reg, ea)
      %byte %integer trunc ea

      trunc ea = ea&16_7F
      %if datareg<=trunc ea<=index %start
         ea = ea&16_38
      %else %if trunc ea=absolute
         %unless ea&16_80=0 %start
            %if pc t=absolute %and pc l=1 %start
               ea = abslong
            %else
               ea = absolute
            %finish
         %else %unless -32768<=v<=32767
            ea = abslong
         %else
            ea = absolute
         %finish
         reg = 0
      %else
         fault(61)
         %if trunc ea=relative %start
            %if ea&16_80#0 %and pc t=absolute %and pc l=1 %start
               ea = abslong
            %else
               ea = absolute
            %finish
            reg = 0
         %else %if trunc ea=relindex
            ea = index
            v = 0
            reg = 0
         %else
            ea = datareg
            reg = 0
         %finish
      %finish
   %end
!------------------------------------------------------------------------------

   %routine put dest(%integer ov, %integer %name v,
                     %integer reg, %integer %name ea)

      set dest(v, reg, ea)
      put(o v!ea!reg)
   %end
!------------------------------------------------------------------------------

   %routine put constant(%integer val, size)

      %if size=long %start
         put(val>>16)
      %else %if size=word
         fault(31) %unless -32768<=val<=65535
      %else
         fault(30) %unless -128<=val<=255
         val = val&255
      %finish
      put(val)
   %end
!------------------------------------------------------------------------------

   %routine put tail(%integer v, i, t, size)
      %if t=displace %start
         fault(52) %unless -32768<=v<=32767
         put(v)
      %else %if t=absolute
         fault(53) %unless -32768<=v<=32768
         put(v)
      %else %if t=index
         fault(54) %unless -128<=v<=127
         put(i<<11!v&255)
      %else %if t=abslong
         put(v>>16)
         put(v)
      %else %if t=relative
         v = v-pc v
         fault(55) %unless -32768<=v<=32767
         put(v)
      %else %if t=relindex
         v = v-pc v
         fault(56) %unless -128<=v<=127
         put(i<<11!v&255)
      %else %if t&16_7F=immediate
         put constant(v, size)
      %finish
   %end
!------------------------------------------------------------------------------

   %routine check data(%integer %name t)
      %byte %integer trunc t

      trunc t = t&16_7F
      %if trunc t=addreg %or trunc t>immediate %start
         fault(58)
         t = datareg
      %finish
   %end
!------------------------------------------------------------------------------

   %routine check control(%integer %name t)
      %byte %integer trunc t

      trunc t = t&16_7F
      %if datareg<=trunc t<=addreg %or postinc<=trunc t<=predec %or %c
            trunc t>=immediate %start
         fault(79)
         t = addrind
      %finish
   %end
!------------------------------------------------------------------------------

   %routine assemble
      %integer i, tag, size, mode, src v, src reg, src ind, src t,
          dest v, dest reg, dest ind, dest t, o v, o ve, macdef,
          dumw, out ifs, cond sp, gen control, list control, header set,
          finished, size ptr, size end, mac call, curr mac beg, llen set,
          in stream no, macgen control, label ptr, label lim, cgen control,
          in mac
      %integer %name curr mac lim
      %byte %integer dumb
      %byte %integer %name pres cond, curr mac t
      %byte %integer %array cond stack(1:max cond+1)
      %string(127) incfile
      %switch op act(0:68), if act(0:5), set flag(0:25)

   !---------------------------------------------------------------------------

      %routine set size(%integer default size)

         %if size=default %start
            size = default size
         %else %if size=short
            fault(-9)
            size = default size
         %finish
      %end
   !---------------------------------------------------------------------------

      %routine check logical dest

         %if dest t=spec reg %start
            %if dest reg=0 %start
               set size(byte)
               fault(-4) %unless size=byte
            %else %if dest reg=1
               set size(word)
               fault(-5) %unless size=word
            %else
               fault(57)
               dest t = datareg
               set size(word)
            %finish
         %else
            set size(word)
         %finish
      %end
   !---------------------------------------------------------------------------

      in stream no = 1
      include flag = 0
      select input(in stream no)
      line no == line nos(in stream no)
      table overflow = 0
      macdef = 0
      curr mac lim == dumw
      curr mac t == dumb
      curr mac beg = 0
      pres cond == cond stack(1)
      mac call = 0
      cond sp = 0
      pres cond = 0
      out ifs = 0
      no warnings = 0
      no faults = 0
      file ended = 0
      finished = 0
      no lines = 0
      no stmts = 0
      line no = 0
      gen control = 0
      macgen control = 0
      cgen control = 0
      tab control = 0
      cycle control = 0
      header set = 0
      llen set = 0
      page control = 1
      list control = 1
      obj control = 1
      output style = 0
      pc v = 0
      pc t = relative
      pc l = 0
      blank = 256

      fault(36) %unless text overflow=0

      %cycle
         fault ptr = 0
         %if mac sp>0 %start
            in mac = 1
         %else
            in mac = 0
         %finish
         %if list control=0 %start
            list flag = 0
         %finish %else %if pres cond&1#0 %start
            %if in mac#0 %and macgen control=0 %start
               list flag = 0
            %else
               list flag = cgen control
            %finish
         %finish %else %if in mac#0 %start
            list flag = macgen control
         %else
            list flag = 1
         %finish
         read line
         no stmts = no stmts+1
         quoted = 0
         label end = 0
         opcode end = 0
         macro call = 0
         tab enable = 0
         %unless pres char='*' %or pres char=nl %start
            tab enable = tab control
            %if pres char#' ' %start
               label ptr = line ptr-1
               get tag(label)
               label lim = line ptr-1
               next char %if pres char=':'
               next char %while pres char#' ' %and pres char#nl %and mac def#0
               label end = line ptr-1
               next char %while pres char=' '
               get tag(tag)
            %else
               next char %until pres char#' '
               label ptr = line ptr-1
               get tag(tag)
               %if pres char=':' %start
                  label lim = line ptr-1
                  label end = line ptr
                  label = tag
                  next char %until pres char#' '
                  get tag(tag)
               %else
                  label ptr = 0
                  label lim = 0
                  label = 0
               %finish
            %finish
            next char %while pres char#' ' %and pres char#nl  %and %c
                                            pres char#'.' %and mac def#0
            %if preschar='.' %start
               size ptr = line ptr-1
               next char %until preschar#' '
               size end = line ptr
               %if its('B') %start
                  size = byte
               %else %if its('L')
                  size = long
               %else %if its('S')
                  size = short
               %else %if its('W')
                  size = word
               %else
                  fault(60)
                  size ptr = 0
                  size end = 0
                  size = default
               %finish
            %else
               size ptr = 0
               size end = 0
               size = default
            %finish
            next char %while pres char#' ' %and pres char#nl %and mac def#0
            opcode end = line ptr-1
            next char %while pres char=' '
            %unless op o(tag)=0 %start
               %if op o(tag)=1 %start
                  operand pres = 0
               %else
                  operand pres = 1
                  quoted = 7
               %finish
            %else
               operand pres = 1
            %finish
            %unless macdef=0 %start
               %unless (op t(tag)=16_38 %and op v(tag)=16_09) %c
                       %or op t(tag)=16_3A %or op t(tag)=16_32 %start
                  %if pass=1 %start
                     %if line lim<=max text %start
                        curr mac lim = line lim
                        text lim = line lim
                     %else
                        curr mac t = 16_44
                        text lim = curr mac beg
                     %finish
                  %finish
                  ->exit
               %finish
            %else %unless prescond&1=0
               ->exit %unless (op t(tag)=16_38 %and 16_0B<=op v(tag)<=16_0E) %c
                         %or op t(tag)=16_32
            %finish
            o v = op v(tag)
            o ve = op ve(tag)
            -> op act(op t(tag))

op act(*):     ! Unknown Operation
               set lab
               fault(8)
               -> exit

op act(16_01): ! ABCD, SBCD
               set lab
               set size(byte)
               fault(-4) %and size=byte %unless size=byte
               ->extend

op act(16_02): ! ADD, SUB
               set lab
               set size(word)
               get expr(src v, src reg, src ind, src t)
               get second(dest v, dest reg, dest ind, dest t, datareg)
               %if size=byte %and (src t=addreg %or dest t=addreg) %start
                  fault(1)
                  size = word
               %finish
               %if dest t=addreg %start
                  mode = size<<1!3
               %else %if dest t=datareg
                  mode = size
               %else
                  mode = size!4
               %finish
               %if src t&16_7F=immediate %start
                  %if 1<=src v<=8 %and src t&16_80=0 %start
                     put dest(16_5000!(src v&7)<<9!(\o v>>6)&16_100!size<<6,
                                                  dest v, dest reg, dest t)
                     put tail(dest v, dest ind, dest t, size)
                  %else %if dest t=datareg %or dest t=addreg
                     put(o v!dest reg<<9!mode<<6!16_3C)
                     put constant(src v, size)
                  %else
                     put dest(o ve!size<<6, dest v, dest reg, dest t)
                     put constant(src v, size)
                     put tail(dest v, dest ind, dest t, size)
                  %finish
               %else
                  %if dest t=addreg %or dest t=datareg %start
                     put src(o v!dest reg<<9!mode<<6, src v, src reg, src t)
                     put tail(src v, src ind, src t, size)
                  %else
                     fault(62) %unless src t=datareg
                     put dest(o v!src reg<<9!mode<<6, dest v, dest reg, dest t)
                     put tail(dest v, dest ind, dest t, size)
                  %finish
               %finish
               ->exit

op act(16_03): ! ADDA, CMPA, SUBA
               set lab
               set size(word)
               %if size=word %start
                  mode = 3
               %else %if size=long
                  mode = 7
               %else
                  fault(1)
                  mode = 3
               %finish
               get expr(src v, src reg, src ind, src t)
               get second(dest v, dest reg, dest ind, dest t, addreg)
               fault(64) %unless dest t=addreg
               put src(o v!dest reg<<9!mode<<6, src v, src reg, src t)
               put tail(src v, src ind, src t, size)
               ->exit

op act(16_04): ! ADDI, CMPI, SUBI
               set lab
               set size(word)
               get expr(src v, src reg, src ind, src t)
               fault(65) %unless src t&16_7F=immediate
               get second(dest v, dest reg, dest ind, dest t, datareg)
               check data(dest t)
               put dest(o v!size<<6, dest v, dest reg, dest t)
               put constant(src v, size)
               put tail(dest v, dest ind, dest t, size)
               ->exit

op act(16_05): ! ADDQ, SUBQ
               set lab
               set size(word)
               get expr(src v, src reg, src ind, src t)
               %if src t&16_7F=immediate %start
                  fault(27) %unless 1<=src v<=8
               %else
                  fault(66)
               %finish
               get second(dest v, dest reg, dest ind, dest t, data reg)
               fault(1) %and size=word %if size=byte %and dest t=addreg
               put dest(o v!(src v&7)<<9!size<<6, dest v, dest reg, dest t)
               put tail(dest v, dest ind, dest t, size)
               ->exit

op act(16_06): ! ADDX, SUBX and ABCD, SBCD at entry extend.
               set lab
               set size(word)
extend:        get expr(src v, src reg, src ind, src t)
               fault(67) %unless src t=datareg %or src t=predec
               get second(dest v, dest reg, dest ind, dest t, src t)
               %if dest t=datareg %or dest t=predec %start
                  fault(69) %unless dest t=src t
               %else
                  fault(68)
               %finish
               o v = o v!16_8 %if src t=predec
               put(o v!dest reg<<9!size<<6!src reg)
               -> exit

op act(16_07): ! AND, OR
               set lab
               get expr(src v, src reg, src ind, src t)
               get second(dest v, dest reg, dest ind, dest t, datareg)
               %if src t&16_7F=immediate %start
                  check logical dest
                  %if dest t=datareg %start
                     put(o v!dest reg<<9!size<<6!16_3C)
                     put constant(src v, size)
                  %else %if dest t=spec reg
                     put(o ve!size<<6!16_3C)
                     put constant(src v, size)
                  %else
                     check data(dest t)
                     put dest(o ve!size<<6, dest v, dest reg, dest t)
                     put constant(src v, size)
                     put tail(dest v, dest ind, dest t, size)
                  %finish
               %else
                  set size(word)
                  %if dest t=datareg %start
                     check data(src t)
                     put src(o v!dest reg<<9!size<<6, src v, src reg, src t)
                     put tail(src v, src ind, src t, size)
                 %else
                     fault(62) %unless src t=datareg
                     check data(dest t)
                     put dest(o v!src reg<<9!16_100!size<<6, dest v,
                                                       dest reg, dest t)
                     put tail(dest v, dest ind, dest t, size)
                  %finish
               %finish
               ->exit

op act(16_08): ! ANDI, EORI, ORI
               set lab
               get expr(src v, src reg, src ind, src t)
               fault(65) %unless src t&16_7F=immediate
               get second(dest v, dest reg, dest ind, dest t, datareg)
               check logical dest
               %if dest t=specreg %start
                  put(o v!size<<6!16_3C)
                  put constant(src v, size)
               %else
                  check data(dest t)
                  put dest(o v!size<<6, dest v, dest reg, dest t)
                  put constant(src v, size)
                  put tail(dest v, dest ind, dest t, size)
               %finish
               ->exit

op act(16_09): ! shift, rotate
               set lab
               set size(word)
               get expr(src v, src reg, src ind, src t)
               check data(src t)
               %if src t&16_7F=immediate %start
                  get second(dest v, dest reg, dest ind, dest t, datareg)
                  check data(dest t)
                  %if dest t=datareg %start
                     fault(26) %unless 1<=src v<=8
                     put(o v!(src v&7)<<9!size<<6!dest reg)
                  %else
                     fault(5) %unless size=word
                     fault(70) %unless src v=1
                     put dest(o ve, dest v, dest reg, dest t)
                     put tail(dest v, dest ind, dest t, word)
                  %finish
               %else %if src t=datareg
                  %if its(',') %start
                     get expr(dest v, dest reg, dest ind, dest t)
                     fault(72) %unless dest t=datareg
                     put(o v!src reg<<9!size<<6!16_20!dest reg)
                  %else
                     put(o v!16_200!size<<6!src reg)
                  %finish
               %else
                  fault(5) %unless size=word
                  put dest(o ve, src v, src reg, src t)
                  put tail(src v, src ind, src t, word)
               %finish
               ->exit

op act(16_0A): ! Bcc, BRA, BSR
               set lab
               fault(10) %if size=byte %or size=long
               get expr(src v, src reg, src ind, src t)
               %unless is numeric(src t) %start
                  fault(200)
                  src v = -2
               %else
                  fault(-33) %unless src t&16_7F=pc t
                  src v = src v-pc v-2
               %finish
               %if size=short %or %c
                     (size=default %and src t&16_80=0 %and %c
                     src v#0 %and -128<=src v<=127) %start
                  fault(28) %unless src v#0 %and -128<=src v<=127
                  put(o v!src v&255)
               %else
                  src v = src v
                  fault(29) %unless -32768<=src v<=32767
                  put(o v)
                  put(src v)
               %finish
               ->exit

op act(16_0B): ! BCHG, BCLR, BSET
               set lab
               get expr(src v, src reg, src ind, src t)
               get second(dest v, dest reg, dest ind, dest t, datareg)
               %if dest t=datareg %start
                  set size(long)
                  fault(-6) %unless size=long
               %else %if dest t=addreg %or dest t>immediate
                  fault(58)
                  dest t = datareg
               %else
                  set size(byte)
                  fault(-4) %unless size=byte
               %finish
               %if src t&16_7F=immediate %start
                  put dest(o ve, dest v, dest reg, dest t)
                  put(src v&255)
                  put tail(dest v, dest ind, dest t, byte)
               %else
                  fault(62) %unless src t=datareg
                  put dest(o v!src reg<<9, dest v, dest reg, dest t)
                  put tail(dest v, dest ind, dest t, byte)
               %finish
               ->exit

op act(16_0C): ! BTST
               set lab
               get expr(src v, src reg, src ind, src t)
               get second(dest v, dest reg, dest ind, dest t, datareg)
               %if dest t=datareg %start
                  set size(long)
                  fault(-6) %unless size=long
               %else %if dest t=addreg %or dest t>immediate
                  fault(58)
                  dest t = datareg
               %else
                  set size(byte)
                  fault(-4) %unless size=byte
               %finish
               %if src t&16_7F=immediate %start
                  %if dest t&16_7F=immediate %start
                     fault(72)
                     dest t = datareg
                  %finish
                  put src(o ve, dest v, dest reg, dest t)
                  put(src v)
                  put tail(dest v, dest ind, dest t, byte)
               %else
                  fault(72) %unless src t=datareg
                  put src(o v!src reg<<9, dest v, dest reg, dest t)
                  put tail(dest v, dest ind, dest t, byte)
               %finish
               ->exit

op act(16_0D): ! CHK, DIVs, MULs
               set lab
               set size(word)
               fault(-5) %unless size=word
               get expr(src v, src reg, src ind, src t)
               check data(src t)
               get second(dest v, dest reg, dest ind, dest t, datareg)
               fault(72) %unless dest t = datareg
               put src(o v!dest reg<<9, src v, src reg, src t)
               put tail(src v, src ind, src t, word)
               -> exit

op act(16_0E): ! CLR, NEGx, NOT, TST and NBCD, Scc, TAS at entry single.
               set lab
               set size(word)
single:        get expr(dest v, dest reg, dest ind, dest t)
               check data(dest t)
               put dest(o v!size<<6, dest v, dest reg, dest t)
               put tail(dest v, dest ind, dest t, size)
               -> exit

op act(16_0F): ! CMP
               set lab
               set size(word)
               get expr(src v, src reg, src ind, src t)
               get second(dest v, dest reg, dest ind, dest t, datareg)
               %if size=byte %and (src t=addreg %or dest t=addreg) %start
                  fault(1)
                  size = word
               %finish
               %if dest t=addreg %start
                  mode = size<<1!3
               %else
                  mode = size
               %finish
               %if src t&16_7F=immediate %start
                  %if dest t=datareg %or dest t=addreg %start
                     put(o v!dest reg<<9!mode<<6!16_3C)
                     put constant(src v, size)
                  %else
                     put dest(o ve!size<<6, dest v, dest reg, dest t)
                     put constant(src v, size)
                     put tail(dest v, dest ind, dest t, size)
                  %finish
               %else
                  fault(74) %unless dest t=datareg %or dest t=addreg
                  put src(o v!dest reg<<9!mode<<6, src v, src reg, src t)
                  put tail(src v, src ind, src t, size)
               %finish
               ->exit

op act(16_10): ! CMPM
               set lab
               set size(word)
               get expr(src v, src reg, src ind, src t)
               fault(75) %unless src t=postinc
               get second(dest v, dest reg, dest ind, dest t, postinc)
               fault(75) %unless dest t=postinc
               put(o v!dest reg<<9!size<<6!src reg)
               ->exit

op act(16_11): ! DBcc
               set lab
               set size(word)
               fault(-5) %unless size=word
               get expr(src v, src reg, src ind, src t)
               fault(76) %unless src t=datareg
               get second(dest v, dest reg, dest ind, dest t, pc t)
               %if is numeric(dest t) %start
                  fault(-33) %unless dest t&16_7F=pc t
                  dest v = dest v-pc v-2
               %else
                  fault(200)
                  dest v = -2
               %finish
               fault(29) %unless -32768<=dest v<=32767
               put(o v!src reg)
               put(dest v)
               ->exit

op act(16_12): ! EOR
               set lab
               get expr(src v, src reg, src ind, src t)
               get second(dest v, dest reg, dest ind, dest t, datareg)
               %if src t&16_7F=immediate %start
                  check logical dest
                  %if dest t=spec reg %start
                     put(o ve!size<<6!16_3C)
                     put constant(src v, size)
                  %else
                     put dest(ov e!size<<6, dest v, dest reg, dest t)
                     put constant(src v, size)
                     put tail(dest v, dest ind, dest t, size)
                  %finish
               %else
                  set size(word)
                  fault(62) %unless src t=datareg
                  check data(dest t)
                  put dest(o v!src reg<<9!size<<6, dest v, dest reg, dest t)
                  put tail(dest v, dest ind, dest t, size)
               %finish
               ->exit

op act(16_13): ! EXG
               set lab
               set size(long)
               fault(-6) %unless size=long
               get expr(src v, src reg, src ind, src t)
               fault(77) %unless src t=datareg %or src t=addreg
               get second(dest v, dest reg, dest ind, dest t, datareg)
               fault(74) %unless dest t=datareg %or dest t=addreg
               %if src t=datareg %start
                  %if dest t=datareg %start
                     put(o v!src reg<<9!16_40!dest reg)
                  %else
                     put(o v!src reg<<9!16_88!dest reg)
                  %finish
               %else %if dest t=datareg
                  put(o v!dest reg<<9!16_88!src reg)
               %else
                  put(o v!dest reg<<9!16_48!src reg)
               %finish
               ->exit

op act(16_14): ! EXT
               set lab
               set size(word)
               %if size=byte %start
                  fault(1)
                  mode = 2
               %else %if size=word
                  mode = 2
               %else
                  mode = 3
               %finish
               get expr(dest v, dest reg, dest ind, dest t)
               fault(72) %unless dest t=datareg
               put(o v!mode<<6!dest reg)
               ->exit

op act(16_15): ! JMP, JSR and PEA at entry jump.
               set lab
               fault(-7) %unless size=default
jump:          get expr(dest v, dest reg, dest ind, dest t)
               check control(dest t)
               put src(o v, dest v, dest reg, dest t)
               put tail(dest v, dest ind, dest t, word)
               ->exit

op act(16_16): ! LEA
               set lab
               set size(long)
               fault(-6) %unless size=long
               get expr(src v, src reg, src ind, src t)
               check control(src t)
               get second(dest v, dest reg, dest ind, dest t, addreg)
               fault(64) %unless dest t=addreg
               put src(o v!dest reg<<9, src v, src reg, src t)
               put tail(src v, src ind, src t, long)
               ->exit

op act(16_17): ! LINK
               set lab
               fault(-7) %unless size=default
               get expr(dest v, dest reg, dest ind, dest t)
               fault(64) %unless dest t=addreg
               get second(src v, src reg, src ind, src t, immediate)
               %unless src t&16_7F=immediate %start
                  fault(65)
               %else %unless -32768<=src v<=32767
                  fault(31)
               %finish
               put(o v!dest reg)
               put(src v)
               ->exit

op act(16_18): ! MOVE (MC68000)
               set lab
               get expr(src v, src reg, src ind, src t)
               %if src t=spec reg %start
                  %if src reg=2 %start
                     set size(long)
                     fault(-6) %unless size=long
                     get second(dest v, dest reg, dest ind, dest t, addreg)
                     fault(64) %unless dest t=addreg
                     put(16_4E68!dest reg)
                  %else
                     set size(word)
                     fault(-5) %unless size=word
!                     fault(81) %unless src reg=1
                     get second(dest v, dest reg, dest ind, dest t, datareg)
                     check data(dest t)
                     put dest(16_40C0, dest v, dest reg, dest t)
                     put tail(dest v, dest ind, dest t, word)
                  %finish
               %else %if src t=addreg
                  get second(dest v, dest reg, dest ind, dest t, addreg)
                  %if dest t=spec reg %and dest reg=2 %start
                     set size(long)
                     fault(-6) %unless size=long
                     put(16_4E60!src reg)
                  %else
                     set size(word)
                     %if size=byte %start
                        fault(1)
                        size = word
                     %finish
                     set dest(dest v, dest reg, dest t)
                     put src((size!2)<<12!(dest reg!dest t&7)<<9! %c
                           (dest t&16_38)<<3, src v, src reg, src t)
                     put tail(dest v, dest ind, dest t, size)
                  %finish
               %else
                  set size(word)
                  check data(src t)
                  get second(dest v, dest reg, dest ind, dest t, datareg)
                  %if dest t=spec reg %and dest reg<=1 %start
                     fault(-5) %unless size=word
                     put src(16_44C0!dest reg<<9, src v, src reg, src t)
                     put tail(src v, src ind, src t, word)
                  %else %if src t=immediate %and size=long %and %c
                        dest t=datareg %and -128<=src v<=127
                     put(16_7000!dest reg<<9!(src v&255))
                  %else
                     %if size=word %start
                        o v = 16_3000
                     %else %if size=long
                        o v = 16_2000
                     %else %if dest t=addreg
                        fault(1)
                        o v = 16_3000
                     %else
                        o v = 16_1000
                     %finish
                     set dest(dest v, dest reg, dest t)
                     put src(o v!(dest reg!dest t&7)<<9!(dest t&16_38)<<3,
                                            src v, src reg, src t)
                     put tail(src v, src ind, src t, size)
                     put tail(dest v, dest ind, dest t, size)
                  %finish
               %finish
               ->exit

op act(16_19): ! MOVE (MC68010)
               set lab
               get expr(src v, src reg, src ind, src t)
               %if src t=spec reg %start
                  %if src reg=0 %start
                     set size(word)
                     fault(-5) %unless size=word
                     get second(dest v, dest reg, dest ind, dest t, datareg)
                     check data(dest t)
                     put dest(16_42C0, dest v, dest reg, dest t)
                     put tail(dest v, dest ind, dest t, word)
                  %else %if src reg=1
                     set size(word)
                     fault(-5) %unless size=word
                     get second(dest v, dest reg, dest ind, dest t, datareg)
                     check data(dest t)
                     put dest(16_40C0, dest v, dest reg, dest t)
                     put tail(dest v, dest ind, dest t, word)
                  %else %if src reg=2
                     set size(long)
                     fault(-6) %unless size=long
                     get second(dest v, dest reg, dest ind, dest t, addreg)
                     %if dest t=data reg %start
                        put(16_4E7A)
                        put((dest reg<<12)!16_0800)
                     %else
                        fault(74) %unless dest t=addreg
                        put(16_4E68!dest reg)
                     %finish
                  %else %if src reg=3
                     set size(long)
                     fault(-6) %unless size=long
                     put(16_4E7A)
                     get second(dest v, dest reg, dest ind, dest t, data reg)
                     %if dest t=add reg %start
                        put((dest reg<<12)!16_8801)
                     %else
                        fault(74) %unless dest t=data reg
                        put((dest reg<<12)!16_0801)
                     %finish
                  %else %if 4<=src reg<=5
                     set size(long)
                     fault(-6) %unless size=long
                     put(16_4E7A)
                     get second(dest v, dest reg, dest ind, dest t, data reg)
                     %if dest t=add reg %start
                        put((dest reg<<12)!(src reg&1)!16_8000)
                     %else
                        fault(74) %unless dest t=data reg
                        put((dest reg<<12)!(src reg&1))
                     %finish
                  %else
                     fault(0)
                  %finish
               %else %if src t=addreg
                  get second(dest v, dest reg, dest ind, dest t, addreg)
                  %if dest t=spec reg %start
                     %if dest reg=2 %start
                        set size(long)
                        fault(-6) %unless size=long
                        put(16_4E60!src reg)
                     %else %if dest reg=3
                        set size(long)
                        fault(-6) %unless size=long
                        put(16_4E7B)
                        put((src reg<<12)!16_8801)
                     %else %if 4<=dest reg<=5
                        set size(long)
                        fault(-6) %unless size=long
                        put(16_4E7B)
                        put((src reg<<12)!(dest reg&1)!16_8000)
                     %else
                        fault(0)
                     %finish
                  %else
                     set size(word)
                     %if size=byte %start
                        fault(1)
                        size = word
                     %finish
                     set dest(dest v, dest reg, dest t)
                     put src((size!2)<<12!(dest reg!dest t&7)<<9! %c
                           (dest t&16_38)<<3, src v, src reg, src t)
                     put tail(dest v, dest ind, dest t, size)
                  %finish
               %else
                  check data(src t)
                  get second(dest v, dest reg, dest ind, dest t, datareg)
                  %if dest t=spec reg %start
                     %if dest reg<=1 %start
                        set size(word)
                        fault(-5) %unless size=word
                        put src(16_44C0!dest reg<<9, src v, src reg, src t)
                        put tail(src v, src ind, src t, word)
                     %else %if 2<=dest reg<=3
                        set size(long)
                        fault(-6) %unless size=long
                        put(16_4E7B)
                        put((src reg<<12)!(dest reg&1)!16_0800)
                     %else %if 4<=dest reg<=5
                        set size(long)
                        fault(-6) %unless size=long
                        put(16_4E7B)
                        put((src reg<<12)!(dest reg&1))
                     %else
                        fault(0)
                     %finish
                  %else
                     set size(word)
                     %if src t=immediate %and size=long %and %c
                           dest t=datareg %and -128<=src v<=127 %start
                        put(16_7000!dest reg<<9!(src v&255))
                     %else
                        %if size=word %start
                           o v = 16_3000
                        %else %if size=long
                           o v = 16_2000
                        %else %if dest t=addreg
                           fault(1)
                           o v = 16_3000
                        %else
                           o v = 16_1000
                        %finish
                        set dest(dest v, dest reg, dest t)
                        put src(o v!(dest reg!dest t&7)<<9!(dest t&16_38)<<3,
                                               src v, src reg, src t)
                        put tail(src v, src ind, src t, size)
                        put tail(dest v, dest ind, dest t, size)
                     %finish
                  %finish
               %finish
               ->exit

op act(16_1A): ! MOVEA
               set lab
               set size(word)
               %if size=byte %start
                  fault(1)
                  size=word
               %finish
               get expr(src v, src reg, src ind, src t)
               get second(dest v, dest reg, dest ind, dest t, addreg)
               fault(64) %unless dest t=addreg
               put src(o v!size<<12!dest reg, src v, src reg, src t)
               put tail(src v, src ind, src t, size)
               ->exit

op act(16_1B): ! MOVEC
               set lab
               set size(long)
               fault(-6) %unless size=long
               get expr(src v, src reg, src ind, src t)
               get second(dest v, dest reg, dest ind, dest t, datareg)
               %if src t=spec reg %start
                  %if 2<=src reg<=3 %start
                     src reg = src reg&1!16_800
                  %else %if 4<=src reg<=5
                     src reg = src reg&1
                  %else
                     fault(0)
                     src reg = 0
                  %finish
                  %if dest t=datareg %start
                     src reg = src reg!(dest reg<<12)
                  %else %if dest t=addreg
                     src reg = src reg!(dest reg<<12)!16_8000
                  %else
                     fault(0)
                  %finish
                  put(o v)
                  put(src reg)
               %else
                  %if dest t=spec reg %start
                     %if 2<=dest reg<=3 %start
                        dest reg = dest reg&1!16_800
                     %else %if 4<=dest reg<=5
                        dest reg = dest reg&1
                     %else
                        fault(0)
                        dest reg = 0
                     %finish
                  %else
                     fault(0)
                     dest reg = 0
                  %finish
                  %if src t=datareg %start
                     dest reg = dest reg!(src reg<<12)
                  %else %if src t=addreg
                     dest reg = dest reg!(src reg<<12)!16_8000
                  %else
                     fault(0)
                  %finish
                  put(o v!1)
                  put(dest reg)
               %finish
               ->exit

op act(16_1C): ! MOVEM
               set lab
               set size(word)
               %if size=long %start
                  mode = 16_40
               %else
                  mode = 0
                  fault(1) %if size=byte
               %finish
               get expr(src v, src reg, src ind, src t)
               %if src t=postinc %or is control(src t) %start
                  get second(dest v, dest reg, dest ind, dest t, datareg)
                  form reg list(dest v, dest reg, dest t)
                  put src(o ve!mode, src v, src reg, src t)
                  put(dest v)
                  put tail(src v, src ind, src t, size)
               %else
                  form reg list(src v, src reg, src t)
                  get second(dest v, dest reg, dest ind, dest t, addrind)
                  %if dest t=predec %start
                     dest v = src v
                     src v = 0
                     %for i = 1, 1, 16 %cycle
                        src v = src v<<1!dest v&1
                        dest v = dest v>>1
                     %repeat
                  %else
                     check control(dest t)
                  %finish
                  put dest(o v!mode, dest v, dest reg, dest t)
                  put(src v)
                  put tail(dest v, dest ind, dest t, size)
               %finish
               ->exit

op act(16_1D): ! MOVEP
               set lab
               set size(word)
               %if size=long %start
                  mode = 16_40
               %else
                  mode = 0
                  fault(1) %if size=byte
               %finish
               get expr(src v, src reg, src ind, src t)
               %if src t&16_7F=displace %or src t=addrind %start
                  get second(dest v, dest reg, dest ind, dest t, datareg)
                  fault(72) %unless dest t=datareg
                  put(o v!dest reg<<9!mode!src reg)
                  put(src v)
               %else
                  fault(76) %unless src t=datareg
                  get second(dest v, dest reg, dest ind, dest t, addrind)
                  fault(82) %unless dest t&16_7F=displace %or dest t=addrind
                  put(o ve!src reg<<9!mode!dest reg)
                  put(dest v)
               %finish
               ->exit

op act(16_1E): ! MOVEQ
               set lab
               set size(long)
               fault(-6) %unless size=long
               get expr(src v, src reg, src ind, src t)
               %if src t&16_7F=immediate %start
                  fault(30) %unless -128<=src v<=127
               %else
                  fault(65)
               %finish
               get second(dest v, dest reg, dest ind, dest t, datareg)
               fault(0) %unless dest t=datareg
               put(o v!dest reg<<9!src v&255)
               ->exit

op act(16_1F): ! MOVES
               set lab
               set size(word)
               get expr(src v, src reg, src ind, src t)
               %if src t=data reg %or src t=addreg %start
                  get second(dest v, dest reg, dest ind, dest t, addr ind)
                  fault(73) %unless is memory(dest t) %and is alterable(dest t)
                  put src(o v!(size<<6), dest v, dest reg, dest t)
                  %if src t=data reg %start
                     put((src reg<<12)!16_800)
                  %else
                     put((src reg<<12)!16_8800)
                  %finish
                  put tail(dest v, dest ind, dest t, size)
               %else
                  fault(73) %unless is memory(src t) %and is alterable(src t)
                  get second(dest v, dest reg, dest ind, dest t, data reg)
                  fault(74) %unless dest t=data reg %or dest t=add reg
                  put src(ov!(size<<6), src v, src reg, src t)
                  %if dest t=data reg %start
                     put(dest reg<<12)
                  %else
                     put((dest reg<<12)!16_8000)
                  %finish
                  put tail(src v, src ind, src t, size)
               %finish
               ->exit

op act(16_20): ! NBCD, Scc, TAS
               set lab
               set size(byte)
               fault(-4) %and size=byte %unless size=byte
               -> single

op act(16_21): ! NOP, RESET, RTE, RTR, RTS, TRAPV, Illegals
               set lab
               fault(-7) %unless size=default
               put(o v)
               -> exit

op act(16_22): ! PEA
               set lab
               set size(long)
               fault(-6) %unless size=long
               ->jump

op act(16_23): ! RTD
               set lab
               fault(-7) %unless size=default
               get expr(src v, src reg, src ind, src t)
               %unless src t&16_7F=immediate %start
                  fault(65)
               %else %unless -32768<=src v<=32767
                  fault(31)
               %finish
               put(o v)
               put(src v)
               ->exit

op act(16_24): ! STOP
               set lab
               get expr(dest v, dest reg, dest ind, dest t)
               %unless dest t&16_7F=immediate %start
                  fault(65)
               %else %unless -32768<=dest v<=65535
                  fault(31)
               %finish
               put(o v)
               put(dest v)
               ->exit

op act(16_25): ! SWAP
               set lab
               set size(word)
               fault(-5) %unless size=word
               get expr(dest v, dest reg, dest ind, dest t)
               fault(72) %unless dest t=data reg
               put(o v!dest reg)
               ->exit

op act(16_26): ! TRAP, BREAKPOINT
               set lab
               fault(-7) %unless size=default
               get expr(dest v, dest reg, dest ind, dest t)
               %unless dest t&16_7F=immediate %start
                  fault(65)
               %else %unless -7<=dest v<=15
                  fault(25)
               %finish
               put(o v!dest v&16_F)
               ->exit

op act(16_27): ! UNLK
               set lab
               fault(-7) %unless size=default
               get expr(dest v, dest reg, dest ind, dest t)
               fault(64) %unless dest t=addreg
               put(o v!dest reg)
               ->exit

op act(16_30): ! ORG
               fault(42) %unless label=0
               set size(word)
               pc t = absolute
               %if size=long %start
                  pc l = 1
               %else
                  fault(1) %if size=byte
                  pc l = 0
               %finish
               get expr(src v, src reg, src ind, src t)
               %if is numeric(src t) %start
                  %if src t&16_80=0 %start
                     pc v = src v
                  %else
                     fault(0)
                  %finish
               %else
                  fault(0)
               %finish
               print long(pc v, 0)
               -> exit

op act(16_31): ! RORG
               fault(42) %unless label=0
               set size(word)
               fault(-5) %unless size=word
               pc t = relative
               get expr(src v, src reg, src ind, src t)
               %if is numeric(src t) %start
                  %if src t&16_80=0 %start
                     pc v = src v
                  %else
                     fault(0)
                  %finish
               %else
                  fault(0)
               %finish
               print long(pc v, 0)
               ->exit

op act(16_32): ! END
               list flag = list control
               fault(42) %unless label=0
               fault(-7) %unless size=default
               %if in stream no=1 %start
                  finished = 1
                  fault(20) %unless cond sp=0
                  fault(21) %unless macdef=0
               %else
                  close input
                  in stream no = in stream no-1
                  select input(in stream no)
                  line no == line nos(in stream no)
                  file ended = 0
               %finish
               ->exit

op act(16_33): ! EQU
               fault(-7) %unless size=default
               %unless label=0 %start
                  get expr(src v, src reg, src ind, src t)
                  print long(src v, 0)
                  %if pass=1 %start
                     %if state(label)=0 %start
                        name t(label) = src t
                        name v(label) = src v
                        name reg(label) = src reg
                        name ind(label) = src ind
                        state(label) = defined
                     %else %unless state(label)=predefined %c
                           %or state(label)=set
                        state(label) = multiple
                     %finish
                  %else
                     %if state(label)=defined %start
                        %if src t&16_80=0 %start
                           fault(23) %unless name v(label)=src v %and %c
                                         name reg(label)=src reg %and %c
                                         name ind(label)=src ind %and %c
                                         name t(label)&16_7F=src t&16_7F
                           name t(label)=name t(label)&16_7F
                        %else
                           fault(41)
                        %finish
                     %else
                        fault(24) %unless state(label)=lost
                     %finish
                  %finish
               %else
                  fault(11)
               %finish
               ->exit

op act(16_34): ! SET
               fault(7) %unless size=default
               %unless label=0 %start
                  get expr(src v, src reg, src ind, src t)
                  print long(src v, 0)
                  %if state(label)=0 %or state(label)=set %start
                     fault(41) %unless src t&16_80=0
                     name t(label) = src t&16_7F
                     name v(label) = src v
                     name reg(label) = src reg
                     name ind(label) = src ind
                     state(label) = set
                  %else
                     fault(24) %unless state(label)=lost
                     state(label) = multiple %unless state(label)=predefined
                  %finish
               %else
                  fault(11)
               %finish
               ->exit

op act(16_35):! DC
               set size(word)
               put byte(0) %unless size=byte %or pc v&1=0
               set lab
               %cycle
                  %if pres char='''' %start
                     %cycle
                        i = 0
                        next char
                        %while pres char#'''' %and pres char#nl %cycle
                           i = i+1
                           %unless list flag=0 %start
                              print byte(curr char, 1)
                              print line
                              list flag = gen control %unless print ptr<line lim
                           %finish
                           put byte(curr char)
                           next char
                        %repeat
                        fault(83) %unless its('''')
                        %if pres char='''' %start
                           i = i+1
                           %unless list flag=0 %start
                              print byte(curr char, 1)
                              print line
                              list flag = gen control %unless print ptr<line lim
                           %finish
                           put byte(curr char)
                        %else
                           %exit
                        %finish
                     %repeat
                     put byte(0) %unless size=byte %or i&1=0
                     put(0) %if size=long %and i&2#0
                  %else
                     get expr(src v, src reg, src ind, src t)
                     fault(0) %unless is numeric(src t)
                     %if size=byte %start
                        fault(30) %unless -128<=src v<=255
                        %unless list flag=0 %start
                           print byte(src v, 1)
                           print line
                           list flag = gen control %unless print ptr<line lim
                        %finish
                        put byte(src v)
                     %else %if size=word
                        fault(31) %unless -32768<=src v<=65535
                        %unless list flag=0 %start
                           print byte(src v>>8, 1)
                           print byte(src v, 0)
                           print line
                           list flag = gen control %unless print ptr<line lim
                        %finish
                        put byte(src v>>8)
                        put byte(src v)
                     %else
                        %unless list flag=0 %start
                           print byte(src v>>24, 1)
                           print byte(src v>>16, 0)
                           print byte(src v>>8, 0)
                           print byte(src v, 0)
                           print line
                           list flag = gen control %unless print ptr<line lim
                        %finish
                        put byte(src v>>24)
                        put byte(src v>>16)
                        put byte(src v>>8)
                        put byte(src v)
                     %finish
                  %finish
               %repeat %until %not its(',')
               -> exit

op act(16_36): ! DS
               set size(word)
               pc v = pc v+pc v&1 %unless size=byte
               set lab
               get expr(src v, src reg, src ind, src t)
               fault(0) %unless is numeric(src t)
               print long(src v<<size, 1)
               pc v = pc v+src v<<size
               ->exit

op act(16_37): ! PAGE
               line count = 0 %if pass=2
               %continue %if size=default %and label=0
               fault(42) %unless label=0
               fault(-7) %unless size=default
               ->exit

op act(16_38): ! Simple Assembler Directives
               fault(42) %unless label=0
               fault(-7) %unless size=default
               ->set flag(o v)

set flag(16_00): ! LIST
                 list control = 1
                 ->exit

set flag(16_01): ! NOLIST
                 print line
                 list control = 0
                 ->exit

set flag(16_02): ! NOPAGE
                 page control = 0
                 ->exit

set flag(16_03): ! LLEN
                 get expr(src v, src reg, src ind, src t)
                 %if is numeric(src t) %and 50<=src v<=136 %start
                    line length = src v %unless pass=1 %and llen set=1
                    llen set = 1
                 %else
                    fault(0)
                 %finish
                 ->exit

set flag(16_04): ! TTL
                 %if pass=2 %or header set=0 %start
                    header = ""
                    %while pres char#nl %cycle
                       header=header.to string(curr char) %if length(header)<64
                       next char
                    %repeat
                    i = length(header)
                    %while i>0 %cycle
                       %exit %unless charno(header, i)=' '
                       i = i-1
                    %repeat
                    length(header) = i
                    header set = 1
                 %finish
                 ->exit

set flag(16_05): ! NOOBJ
                 obj control = 0
                 ->exit

set flag(16_06): ! FAIL
                 get expr(src v, src reg, src ind, src t)
                 fault(0) %unless is numeric(src t)
                 fault(src v)
                 ->exit

set flag(16_07): ! G
                 gen control = 1
                 ->exit

set flag(16_08): ! NOG
                 gen control = 0
                 ->exit

set flag(16_09): ! ENDM
                 fault(15) %unless macdef=1
                 macdef = 0
                 ->exit

set flag(16_0A): ! MEXIT
                 fault(19) %unless mac sp>0
                 %while mac sp>0 %cycle
                    %exit %if mac ret(mac sp)<text lim
                    mac sp = mac sp-1
                 %repeat
                 %if mac sp>0 %start
                    text lim = mac ret(mac sp)
                    mac sp = mac sp-1
                 %finish
                 ->exit

set flag(16_0B): ! IFc
                 %unless cond sp>=max cond %start
                    cond sp = cond sp+1
                    pres cond == cond stack(cond sp+1)
                    pres cond = cond stack(cond sp)&1!2
                    %if pres cond&1=0 %start
                       get expr(src v, src reg, src ind, src t)
                       fault(0) %unless src t&16_80=0
                       ->if act(o ve)
                    %finish
                 %else
                    fault(84)
                    pres cond = 3
                    out ifs = out ifs+1
                 %finish
                 ->exit

set flag(16_0C): ! ELFc
                 %if cond sp>0 %start
                    %if pres cond&6=0 %start
                       pres cond = cond stack(cond sp)&1!2
                       %if pres cond&1=0 %start
                          get expr(src v, src reg, src ind, src t)
                          fault(0) %unless src t&16_80=0
                          ->if act(o ve)
                       %finish
                    %else
                       fault(85) %unless pres cond&4=0
                       pres cond = pres cond!3
                    %finish
                 %else
                    fault(86)
                 %finish
                 ->condexit

if act(0): pres cond = pres cond!!3 %unless src v=0 %and src t=absolute
           ->condexit
if act(1): pres cond = pres cond!!3 %unless src v#0 %or src t#absolute
           ->condexit
if act(2): fault(-0) %unless src t=absolute
           pres cond = pres cond!!3 %unless src v<0 %and src t=absolute
           ->condexit
if act(3): fault(-0) %unless src t=absolute
           pres cond = pres cond!!3 %unless src v<=0 %and src t=absolute
           ->condexit
if act(4): fault(-0) %unless src t=absolute
           pres cond = pres cond!!3 %unless src v>=0 %and src t=absolute
           ->condexit
if act(5): fault(-0) %unless src t=absolute
           pres cond = pres cond!!3 %unless src v>0 %and src t=absolute
           ->condexit

set flag(16_0D): ! ELSE
                 %if cond sp>0 %start
                    %if pres cond&6=0 %start
                       pres cond = (pres cond!!1)!6 %if cond stack(cond sp)&1=0
                    %else
                       fault(85) %unless pres cond&4=0
                       pres cond = 7
                    %finish
                 %else
                    fault(86)
                 %finish
                 ->condexit

set flag(16_0E): ! ENDC
                 %if cond sp>0 %start
                    %if out ifs>0 %start
                       out ifs = out ifs-1
                    %else
                       pres cond == condstack(cond sp)
                       cond sp = cond sp-1
                    %finish
                 %else
                    fault(87)
                 %finish
                 ->condexit

condexit:      %if pres cond&1=0 %and list control=1 %start
                  %if in mac#0 %start
                     list flag = macgen control
                  %else
                     list flag = 1
                  %finish
               %finish
               ->exit

set flag(16_0F): ! INCL
                 incfile = ""
                 %while pres char#nl %cycle
                    incfile=incfile.to string(curr char) %if length(incfile)<64
                    next char
                 %repeat
                 in stream no = in stream no+1
                 %if open include file(in stream no, incfile) %start
                    line no == line nos(in stream no)
                    line no = 0
                 %else
                    in stream no = instream no-1
                    select input(in stream no)
                    fault(0)
                 %finish
                 ->exit

set flag(16_10): ! MACGEN
                 macgen control = 1
                 ->exit

set flag(16_11): ! NOMACG
                 macgen control = 0
                 ->exit

set flag(16_12): ! CGEN
                 cgen control = 1
                 ->exit

set flag(16_13): ! NOCGEN
                 cgen control = 0
                 ->exit

set flag(16_14): ! BIN
                 %if obj output=0 %start
                    output style = 1
                 %finish %else %start
                    fault(0)
                 %finish
                 ->exit

set flag(16_15): ! TAB
                 tab control = 1
                 ->exit

set flag(16_16): ! NOTAB
                 tab control = 0
                 ->exit

set flag(16_17): ! CYCLES
                 cycle control = 1
                 ->exit

set flag(16_18): ! NOCYCLES
                 cycle control = 0
                 ->exit

set flag(16_19): ! IMP
                 %if obj output=0 %start
                    output style = 2
                 %else
                    fault(0)
                 %finish
                 ->exit

op act(16_39): ! SPC
               get expr(src v, src reg, src ind, src t)
               %if pass=2 %and is numeric(src t) %and list control#0 %start
                  %for i = 1, 1, src v %cycle
                     start line
                     %exit %if line count=0
                  %repeat
               %finish
               %continue %if size=default %and is numeric(src t) %and label=0
               fault(42) %unless label=0
               fault(-7) %unless size=default
               ->exit

op act(16_3A): ! MACRO
               fault(-7) %unless size=default
               %if macdef=0 %start
                  %if pass=1 %start
                     %if label=0 %start
                        curr mac beg = text lim
                        curr mac lim == dumw
                        curr mac t == dumb
                     %else %if op t(label)=0
                        op t(label) = 16_40
                        op v(label) = text lim
                        curr mac beg = text lim
                        curr mac lim == op ve(label)
                        curr mac t == op t(label)
                     %else
                        op t(label) = 16_41 %if op t(label)=16_40
                        curr mac beg = text lim
                        curr mac lim == dumw
                        curr mac t == dumb
                     %finish
                  %else %if label=0
                     fault(11); ! No macro label
                  %else %if op t(label)=16_41
                     fault(-12); ! - Multiply defined macro
                     op t(label) = 16_3F
                  %else %if op t(label)=16_43
                     op t(label) = 16_40
                  %else %if op t(label)=16_3F %or op t(label)=16_41
                     fault(12); ! 2nd Definition
                     op t(label) = 16_41
                  %else %if op t(label)=16_44
                     fault(37)
                  %else
                     fault(13) %unless state(label)=lost
                  %finish
                  macdef = 1
               %else
                  fault(14)
               %finish
               ->exit

op act(16_3F): ! call of multiply defined macro (before 2nd definition)
               fault(-17)

op act(16_40): ! macro call
               ! fault(42) %unless label=0 Non-standard Extension
               macro call = 1
               %if mac sp<max mac lev %start
                   mac call = mac call+1
                   mac sp = mac sp+1
                   mac p valid(mac sp, i) = 0 %for i = 1, 1, 9
                   mac p valid(mac sp, 0) = 1
                   mac p ptr(mac sp, 0) = size ptr
                   mac p end(mac sp, 0) = size end
                   mac p valid(mac sp, 11) = 1
                   mac p ptr(mac sp, 11) = label ptr
                   mac p end(mac sp, 11) = label lim
                   %for i = 1, 1, 9 %cycle
                      mac p valid(mac sp, i) = 1
                      %if pres char='<' %start
                         mac p ptr(mac sp, i) = line ptr
                         next char %until pres char='>' %or pres char=nl
                         mac p end(mac sp, i) = line ptr-1
                         fault(88) %unless its('>')
                      %else
                         mac p ptr(mac sp, i) = line ptr-1
                         next char %while pres char#',' %and pres char#nl %c
                                          %and pres char#' '
                         mac p end(mac sp, i) = line ptr-1
                      %finish
                      %exit %unless its(',')
                   %repeat
                   mac ptr(mac sp) = o v
                   mac end(mac sp) = o ve
                   mac ret(mac sp) = line start
                   mac p valid(mac sp, 10) = 1
                   mac p ptr(mac sp, 10) = line lim
                   put call(mac call)
                   mac p end(mac sp, 10) = line lim
                   text lim = mac p end(mac sp, 10)
                   line lim = mac p ptr(mac sp, 10)
                %else
                   fault(44)
                %finish
               -> exit

op act(16_41): ! call of multiply defined macro
               fault(42) %unless label=0
               fault(18)
               ->exit

op act(16_42): ! Forward call of multiply defined macro.
               fault(-18)

op act(16_43): ! Forward macro call
               fault(19)
               fault(42) %unless label=0
               ->exit

op act(16_44): ! Call truncated macro
               fault(42) %unless label=0
               fault(38)
               ->exit

exit:    %finish
         %while (print ptr<line lim) %or %c
               ((list flag=1) %and (print q ptr<print q lim)) %cycle
            print line
            list flag = gen control %unless print ptr<line lim
         %repeat
         print faults
         %if in stream no=1 %start
            include flag = 0
         %else
            include flag = 1
         %finish
      %repeat %until finished=1
   %end
 !------------------------------------------------------------------------------

   open files
   init symbol table
   get def
   close input
   select output(2)
   pass = 1
   assemble
   reset input
   %for i = 1, 1, name lim %cycle
      %if op t(i) = 16_40 %start
         op t(i) = 16_43
      %else %if op t(i)=16_41
         op t(i) = 16_42
      %finish
      name t(i) = name t(i)!16_80 %unless state(i)=predefined
   %repeat
   pass = 2
   assemble
   close
   start line
   start line
   %if no faults = 0 %start
      print string("No")
   %else
      write(no faults, 0)
   %finish
   print string(" fault")
   print symbol('s') %unless no faults=1
   print string(" and ")
   %if no warnings = 0 %start
      print string("no")
   %else
      write(no warnings, 0)
   %finish
   print string(" warning")
   print symbol('s') %unless no warnings=1
   print string(" in this assembly.")
   new line
   select output(0)
   write(no lines, 0)
   print string(" lines (")
   write(no stmts, 0)
   print string(" statements) assembled, ")
   write(no faults, 0)
   print string(" faults and ")
   write(no warnings, 0)
   print string(" warnings.")
   newline
%end %of %file
