%include "inc:util.imp"
%begin

   %constant %byte %integer cr = 16_0D
   %string(255)s

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

   %routine open files;
      %integer i
      %string(255) %name file
      %string(255) params, object, low, high, dummy

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

      %predicate matches(%string(255) source, pattern,
                      %integer min, %integer %name i)
         %integer l
         l = length(pattern)
         %if length(pattern)>=length(source) %start
            l = length(source)
         %else
            l = length(pattern)
         %finish
         %for i = 1, 1, l %cycle
            %unless charno(source, i)=charno(pattern, i) %start
               %if 'a'<=charno(source, i)<='z' %start
                  %false
               %finish %else %if i<=min %start
                   %false
               %else
                  %true
               %finish
            %finish
         %repeat
         i = i+1
         %false %if i<=min
         %true
      %end
   !---------------------------------------------------------------------------

      %string(255) %function lc(%string(255) source)
         %string(255) result
         %integer i

         result = ""
         %for i = 1, 1, length(source) %cycle
            %if 'A'<=charno(source, i)&127<='Z' %start
               result = result.tostring((charno(source, i)&127)-'A'+'a')
            %else
               result = result.tostring(charno(source, i)&127)
            %finish
         %repeat
         %result = result
      %end
   !---------------------------------------------------------------------------

      %predicate is typed(%string(255) source, %string(255)%name file)
      %integer sym,pos
         file = source
         %for pos = 1,1,length(source) %cycle
           %trueif charno(source,pos)='.'
         %repeat
         %false
!         %string(255) directory
!         %if source->directory.("]").source %start
!            directory = directory."]"
!         %else
!            directory = ""
!         %finish
!         %if source->file.(".").source %start
!            file = directory.file
!            %true
!         %else
!            file = directory.source
!            %false
!         %finish
      %end
   !---------------------------------------------------------------------------

      params = lc(cliparam)
      object = ""
      low = ""
      high = ""
      dummy = ""
      %cycle
         i = 1
         i = i+1 %while i<=length(params) %and charno(params, i)=' '
         %exit %if i>length(params)
         params = substring(params, i, length(params))
         %if charno(params, 1)='/' %start
            params = substring(params, 2, length(params))
            %if matches(params, "low", 1, i) %start
               low = ""
               file == low
            %finish %else %if matches(params, "high", 1, i) %start
               high = ""
               file == high
            %finish %else %if matches(params, "nolow", 3, i) %start
               low = ":n"
               file == dummy
            %finish %else %if matches(params, "nohigh", 3, i) %start
               high = ":n"
               file == dummy
            %else
               i = 1
               file == dummy
            %finish
            %exit %if i>length(params)
            params = substring(params, i, length(params))
            %continue %unless charno(params, 1)='='
            %if length(params)>1 %start
               params = substring(params, 2, length(params))
            %else
               params = ""
            %finish
         %else
            file == object
         %finish
         i = 1
         i = i+1 %while i<=length(params) %and charno(params, i)#' ' %and %c
                                            charno(params, i)#'/'
         file = substring(params, 1, i-1) %if i>1
         %exit %if i>length(params)
         params = substring(params, i, length(params))
      %repeat

      %if object="" %start
         select output(0)
         print string("No source object file specified.")
         newline
         %stop
      %finish

      object = object.".mob" %unless is typed(object, params)

      low   = params %if low=""
      high = params %if high=""
      low = low.".lsb" %unless is typed(low, dummy)
      high = high.".msb" %unless is typed(high, dummy)

      %if exists(object) %start
         open input(1, object)
         open output(1, high)
         open output(2, low)
      %else
         select output(0)
         print string(object." does not exist.")
         new line
         %stop
      %finish
   %end
!------------------------------------------------------------------------------

   %byte %integer %array obj q(0:1, 1:16)
   %own %integer %array obj q ptr(0:1) = 0(*)
   %own %integer %array obj output(0:1) = 0(*)
   %own %integer %array out base(0:1) = 0(*)
   %own %integer %array checkout(0:1) = 0(*)
   %integer %array pc v(0:1)
   %integer pc, i
   %byte %integer sym, checkin, length

   %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, s)

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

   %routine purge obj q(%integer s)
      %integer i

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

   %routine close
      %integer s

      %for s = 0, 1, 1 %cycle
         purge obj q(s)
         %unless obj output(s)=0 %start
            select output(s+1)
            print string("S9030000FC")
            print symbol(cr)
            newline
         %finish
      %repeat
   %end
!------------------------------------------------------------------------------

   %routine put byte(%integer v, s)

      purge obj q(s) %unless out base(s)+obj q ptr(s)=pc v(s)
      pc v(s) = pc v(s)+1
      obj q ptr(s) = obj q ptr(s)+1
      obj q(s, obj q ptr(s)) = v&255
      purge obj q(s) %if obj q ptr(s)=16
   %end
!------------------------------------------------------------------------------
   %routine read nib(%byte %integer %name nib)

      read symbol(nib) %until '0'<=nib<='9' %or 'A'<=nib<='F'
      %if '0'<=nib<='9' %start
         nib = nib-'0'
      %else
         nib = nib-'A'+10
      %finish
   %end
!------------------------------------------------------------------------------

   %routine read hex(%byte %integer %name sym)
      %byte %integer ch

      read nib(ch)
      read nib(sym)
      sym = ch<<4+sym
      checkin = (checkin+sym)&255
   %end
!------------------------------------------------------------------------------

   %on %event 9 %start
      close
      %stop
   %finish

   open files
   select input(1)
   %cycle
      read symbol(sym) %until sym='S'
      read symbol(sym)
      %if '1'<=sym<='2' %start
         checkin = 1
         read hex(length)
         %if sym='2' %start
            length = length-1
            read hex(sym)
            pc = sym
         %else
            pc = 0
         %finish
         read hex(sym)
         pc = pc<<8+sym
         read hex(sym)
         pc = pc<<8+sym
         pc v(0) = pc//2
         pc v(1) = pc//2
         %for i = 1, 1, length-3 %cycle
            read hex(sym)
            put byte(sym, pc&1)
            pc = pc+1
         %repeat
         read hex(sym)
         %unless checkin=0 %start
            select output(0)
            print string("Checksum failure!")
            newline
            %exit
         %finish
      %finish
   %repeat
%end %of %program
