%EXTERNALINTEGERFNSPEC SMADDR(%INTEGER CHAN,%INTEGERNAME LEN)
!%EXTERNALROUTINESPEC CLOSESM(%INTEGER CHAN)
%EXTERNALROUTINESPEC prompt %ALIAS "S#PROMPT"(%STRING (255) s)
%BEGIN

   %OWNINTEGER CHECKSUM
   %OWNBYTEINTEGERARRAY STORE(-40:K'177777')
   %OWNINTEGER BASE=0
   %OWNINTEGER RA,SA,FA
   %OWNSTRING (255) ST
   %OWNINTEGER I,J,HIGH ADDRESS,START ADDRESS,COMMAND,CH,X


   %ROUTINE WRITE OCTAL(%INTEGER NO)
!=================================
      %INTEGER I

      NO = NO&K'177777'
      %CYCLE I = 15,-3,0
         PRINTSYMBOL((NO>>I)&7+'0')
      %REPEAT
   %END




   %ROUTINE put(%INTEGER ch)
      print ch(ch)
      checksum = checksum+ch
   %END

   %ROUTINE DUMP(%INTEGER BOTTOM,TOP)
!=======================================

! This routine dumps a DEC PDP11 loader format
! file.

      %INTEGER ADDR,SIZE,I

      select output(6)
      %IF bottom<-40 %OR top>k'177776' %OR bottom>top %START
         select output(0)
         printstring("Dump disaster")
         newline
         %MONITOR
         %STOP
      %FINISH

      ADDR = BOTTOM
      size = top-addr+1

      %CYCLE I = 1,1,2; PRINT CH(0); %REPEAT
      CHECKSUM = 0

! Do header

      PUT(1); PUT(0)

! Do size

      PUT((SIZE+6)&K'377'); PUT((SIZE+6)>>8)

! Do address

      %IF addr=-40 %THEN i = 0 %ELSE i = addr
      PUT(i&K'377'); PUT(i>>8)

! Now do DATA

      %CYCLE I = 1,1,SIZE
         PUT(STORE(ADDR))
         ADDR = ADDR+1
      %REPEAT

! Finally put the   checksum

      PUT((-CHECKSUM)&K'377')

   %END

   %ROUTINE LOAD
!=============
      %OWNINTEGER ST,FIN
      %INTEGER SIZE,ADDR,X1,X2,I,K
      %INTEGER HEADER

      %INTEGERFN GET
         %INTEGER I
         %IF ST<=FIN %THEN I = BYTEINTEGER(ST) %AND ST = ST+1 %ELSE %C
            %SIGNALEVENT 9
         CHECKSUM = CHECKSUM+I
         %RESULT = I
      %END

      HEADER = 0
      ST=SMADDR(5,I)
      FIN = ST+I-1
      HIGH ADDRESS = 0
      K = 1
      %CYCLE;                            !OVER ALLINPUT BLOCKS
         I = GET %UNTIL I=1;             !SKIP TO LIKELY START
         %SIGNALEVENT 12,I %UNLESS GET=0; !CONFIRM O.K.
         CHECKSUM = 1;                   !INITIALISE CHECKSUM

!GET SIZE OF THIS BLOCK
         X1 = GET; X2 = GET; SIZE = X2<<8+X1-6

!GET ADDRESS OF THIS BLOCK

         X1 = GET; X2 = GET; ADDR = X2<<8+X1

         %IF SIZE=0 %START;              !LOAD BLOCK
            START ADDRESS = ADDR
                                         !CLOSESM(5)
            %RETURN
         %FINISH

         %IF HEADER=0 %START {First block is DEIMOS HEADER}
            ADDR = -40
            HEADER = 1
         %FINISH
         %WHILE SIZE>0 %CYCLE
            STORE(ADDR) = GET
            ADDR = ADDR+1
            SIZE = SIZE-1
         %REPEAT
         I = GET
         %SIGNALEVENT 13,CHECKSUM&K'377' %IF CHECKSUM&K'377'#0
         HIGH ADDRESS = ADDR %IF HIGH ADDRESS<ADDR

      %REPEAT
   %END
   %ROUTINE scan
!============
!
!scans through image of pdp11 store putting out contiguous blocks of non-zero
!bytes in dec loader format
!
      %INTEGER p {pointer to current byte}
      %INTEGER b {pointer to begining of block of non-zeroes}
      %INTEGER e {pointer to end of block of non-zeroes}
      %INTEGER nb {length of current block}
      %INTEGER nz {length of contiguous zeros}
      %INTEGER state {=1 skipping for non-zero, =2 in block, =3 in block with zeros}
      %INTEGER action {=0, read a zero; =1 read non zero}
      %CONSTINTEGER max size= k'200'
      %SWITCH x(1:6)

      state = 1
      p = -1

      %CYCLE
         p = p+1
         %IF p>=k'200000' %START
            %IF state>1 %START
               dump(b,e)
            %FINISH
            %EXIT
         %FINISH
         %IF store(p)=0 %THEN action = 0 %ELSE action = 1

         ->x(3*action+state)

x(1):    {found zero when skipping for non-zero; do nothing}
         %CONTINUE

x(2):    {found zero when in block, last thing was non zero}
         state = 3
         nz = 1
         ->check l

x(3):    {zero when in block, last thing was a zero}
         nz = nz+1
         %IF nz>10 %START
            dump(b,e)
            state = 1
            %CONTINUE
         %FINISH
         ->check l

x(4):    {first non-zero character in block}
         b = p; e = p
         state = 2
         nb = 1
         %CONTINUE

x(5):    {non-zero in block}
x(6):    {ditto, last thing was zero}

         e = p
check l:
         nb = nb+1
         %IF nb=max size %START
            dump(b,e)
            state = 1
         %FINISH

      %REPEAT

   %END
   %ROUTINE dump start(%INTEGER start)

      print ch(0); print ch(0)
      checksum = 0
      put(1); put(0); put(6); put(0)
      put(start&k'377')
      put(start>>8)
      put((-checksum)&k'377')

   %END


   %STRING (20) input,output

   load
   select output(6)
   dump(-40,-1);                         !dump deimos header
   scan
   dump start(start address)

%ENDOFPROGRAM