c***********************************************************************
c      program bugloop.for
c***********************************************************************
      integer*1 ich(80)
      nchmax=80
c
c----------------------------- creation of the assembly file (zasm.s)
c
      write(*,1000)
 1000 format($,'  The jump will be 5*n+2 bytes; input n: ')
      read *,n 
c
      open(unit=2,file='zasm.s',status='unknown',access='sequential',
     1 form='formatted')

      write(2,1100) '#************************************************',
     1 '***********************'
 1100 format(a,a)
      write(2,1100) '#       subroutine zasm(ival)'
      write(2,1100) '#       ival is the returned value'
      write(2,1100) '#************************************************',
     1 '***********************'
      write(2,1100) '.text'
      write(2,1100) '.global zasm_'
      write(2,1100) 'zasm_:'
      write(2,1100)
      write(2,1100) '         push   %ebp'
      write(2,1100) '         mov    %esp,%ebp'
      write(2,1100)
      write(2,1100) '         xor    %eax,%eax'
      write(2,1100) '         mov    $0x02,%ecx'
      write(2,1100)
      write(2,1100) 'bugloop:'
c
      do 10 i=1,n
   10 write(2,1100) '         add    $0x10000,%eax'
c
      write(2,1100) '         loop   bugloop'
      write(2,1100) '         shr    $0x11,%eax'
      write(2,1100)
      write(2,1100) '         mov    0x8(%ebp),%edx         # ival'
      write(2,1100) '         mov    %eax,(%edx)'
      write(2,1100)
      write(2,1100) '         leave'
      write(2,1100) '         ret'
c
      close(unit=2)
c
c----------------------------- as of the file (zasm.o)
c
      call system('as zasm.s -o zasm.o\0')
c
c----------------------------- objdump of the file (zasm.d)
c
      call system('objdump -d zasm.o > zasm.d\0')
c
c----------------------------- extraction of the loop line of the dump file
c
      open(unit=3,file='zasm.d',status='old',access='direct',
     1 form='unformatted',recl=1)
      line=0
      nbread=0
c
   20 call readline(3,line,ich,nch,nchmax,nbread,ierr)
      if(ierr.eq.1) go to 22
      if(nch.lt.32) go to 20
      if(ich(29).ne.ichar('l')) go to 20
      if(ich(30).ne.ichar('o')) go to 20
      if(ich(31).ne.ichar('o')) go to 20
      if(ich(32).eq.ichar('p')) go to 25
c
   22 stop '  loop line not found in the disassembled file'
c
   25 close(unit=3)
      print *,'   disassembled loop line'
      print *,' '
      write(*,1010) (ich(i),i=1,nch)
 1010 format(80a1)
      print *,' '
c
c----------------------------- compilation
c
      call system('g77 -o bugloop2 bugloop2.for zasm.o >& /dev/null\0')
c
c----------------------------- execution
c
      call system('bugloop2\0')
c
      end
c
c***********************************************************************
      subroutine readline(iunit,line,ich,nch,nchmax,nbread,ierr)
c      read a line of the logical unit "iunit" file into the array "ich"
c      "line" is the number of the line and "nch" its number of characters
c      "nbread" is the total number of read bytes of the file
c      "ierr" is returned 1 in case of unexpected end of file
c
c      carriage return are dropped
c
c      the file is to be opened 'direct', 'unformatted', recl=1
c      "line" and "nbread" must be set to 0
c      "nchmax" is the size of the array ich
c
      integer*1 icar,ich(1)
c
      ierr=0
      nch=0
      line=line+1
c
   10 nbread=nbread+1
      read(iunit,rec=nbread,err=20) icar
c
      if(icar.eq.13) go to 10
      if(icar.eq.10) return
c
      nch=nch+1
      if(nch.lt.nchmax) go to 12
      write(*,1200) nchmax,line,iunit
 1200 format('  too many chars (max=',i3,') at line',i6,' iunit=',i3)
      stop
c
   12 ich(nch)=icar
      go to 10
c
   20 ierr=1
      return
      end