!Utility to analyse a file whatever it is and print out something sensible.
!Various bits hacked from ANAL, NANAL, NLINES, DUMP, I:ANAL20, MOBANAL, MEXANAL
!etc courtesy of RWT, RMM, HMD etc.

!J.Butler Oct 29 84
!Modded JHB 18/2/87: -c option counts less likely to run into each other


%begin
   %include "inc:chario.imp"
   %include "inc:util.imp"
   %include "inc:fs.imp"
   %include "inc:fsutil.imp"

   %ownstring(255)s="", outfile="",eventmess=""
   %string (80) %array Files (1 : 110)
   %integer Number of Files

   %constinteger vbrief = 0
   %constinteger brief  = 1
   %constinteger normal = 2
   %constinteger full   = 3
   %constinteger dump   = 4
   %constinteger count  = 5

   %ownbyte options = full
   %string (255) File, File 1, defext
   %integer I, cc, lc, start, filelen, sym, hpos=1
   %integer File Number = 0, Wild Lines = 0, Wild Chars = 0

   
   ! -- Dump stuff from DUMP


%string (255) %fn existance(%string (127) s)
!This is a special version of EXISTS. Basically it does exactly the same as
!EXISTS but keeps the string it got back for displaying to the user.
%integer xno,pos
  %integerfn h
  %integer n=0,k
    %cycle
      %result = n %if pos>length(s); pos = pos+1; k = charno(s,pos-1)-'0'
      %result = n %if k<0; n = n<<4+k
    %repeat
  %end
  pos=1
  s = "S".tostring(userno+'0').s.snl
  etherwrite(fsport,charno(s,1),length(s))
  length(s) = etherread(fsport,charno(s,1),127)
  %result = s %if charno(s,1)='-'
  xno = h
  pos = fcomm('K0'+xno,"")
  %result = ""
%end

%routine countfile(%integer from, size)
   %integer p,q,r,max
   %constbytearray hex(0:15) = %c
   '0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F'
   %integerarray tot(0:255), wid(0:15)
   %for p=0,1,255 %cycle; tot(p)=0; %repeat
   %for q=from,1,from+size-1 %cycle
      tot(byteinteger(q)) = tot(byteinteger(q))+1
   %repeat
   max=0
   %for q=0,1,15 %cycle; wid(q)=0; %repeat
   %for p=0,1,15 %cycle
   %for q=0,1,15 %cycle; wid(q)=tot(p*16+q) %if tot(p*16+q)>wid(q); %repeat
   %repeat
   %for q=0,1,15 %cycle
      p=0; r=1
      p=p+1 %and r=r*10 %while r-1<wid(q)
      %if p>2 %then wid(q)=p %else wid(q)=2
   %repeat
   newline; spaces(3)
   %for p=0,1,15 %cycle; spaces(wid(p)-1); printsymbol('-'); printsymbol(hex(p)); %repeat
   newlines(2)
   %for p=0,1,15 %cycle
      printsymbol(hex(p)); printsymbol('-'); space
      %for q=0,1,15 %cycle; write(tot(p*16+q), -(wid(q)+1)); %repeat
      newline
   %repeat
%end


%routine dumpfile(%integer from,size)
   %integer p,q
   p = from
   newline
   %cycle
     phex(p-from); spaces(2)
     %for q=p,1,p+15 %cycle
       sym = byteinteger(q); sym = '_' %unless ' '<=sym&16_7f<='~'
       %if q >= from+size %then space %else printsymbol(sym&16_7f)
     %repeat
     space
     %for q = p,1,p+15 %cycle
       space
       %if q >= from+size %then newline %and %return %else phex2(byteinteger(q))
     %repeat
     p = p + 16
     newline
  %repeat
%end

   %routine Do one File (%string (255) File)
      %record (finfof) r
      %integer limit,integer i,j, p
      %string (255) s, dir, f, ext



      %routine count lines and junk(%integername lines, %realname junkfract, %c
      %integername maxline)
         %integer junk, ok, p, q
         lines = 0; junk = 0; ok = 0; maxline = 0; q=start
         %for p = start, 1, limit-1 %cycle
            %if byteinteger(p) = nl %start
               lines = lines + 1
               %if p-q>maxline %then maxline=p-q; q=p+1

            %elseif byteinteger(p) = 9 %or byteinteger(p) = 12 %or %c
            byteinteger(p) = 13 %or ' ' <= byteinteger(p) <= 126
               ok = ok + 1 

            %else
              junk = junk + 1
            %finish
         %repeat
         %if junk+ok = 0 %then junkfract = 0 %else junkfract = junk/(junk+ok)
         Wild Lines = Wild Lines + lines
      %end

      %routine genanal(%string (63) text)
         %integer lc,maxline
         %real jfract
         printstring("File is a")
         count  lines and junk(lc, jfract, maxline); write(lc, 1)
         print string ("-line "); printstring(text)
         %if jfract*100 < 1 %start
            printstring(" (longest = "); write(maxline, -1)
            printstring(" characters)")
         %else
            printstring(" ("); print(jfract*100, 0, 0)
            printstring("% unprintable)")
         %finish
         newline
      %end

      %routine mexanal
         %constinteger current flavour = 16_02
         %recordformat hf(%byte mark, version,%short checks,export,import,
                    %integer codesize,
                    %short reset,main,%integer ownsize,stacksize,spare1,spare2)
         %record(hf)%name header
         %integer i, offset

         %routine show entry(%integername i)
           %integer k
           phex(integer(i)); phex(integer(i+4))
           space; phex(integer(i+8)+offset)
           space; printstring(string(i+12))
           newline
           i = (i+byteinteger(i+12)+14)&\1
         %end


         %routine SHOW CHECKS(%integer bits)
         !Courtesy HMD
         %integer PROBE=16_8000, I=1
         %const%string TEXT = %c
         "-ARR-LOOP-CAP-OVER-ASS-STRASS-SASS-BASS-LINE-DIAG-TRACE-STACK-"
           printstring("Checks set at end:")
           %if bits = 0 %start
             printstring("none")
           %else
             %cycle
               %cycle
                 printsymbol(charno(text,i)) %if bits&probe # 0
                 i = i+1
               %repeat %until charno(text,i) = '-'
               probe = probe>>1
             %repeat %until probe = 16_0008
           %finish
           newline
         %end

         header == record(start)
         printstring("File is a Version"); write(header_version, 1)
         printstring(" (current)") %if header_version = current flavour
         printstring(" object module")
         newlines(2)
         i = sizeof(header)+header_export+header_import+header_codesize
         %unless i=filelen %start
            printstring("File is ")
            write(filelen-i,0); printstring(" bytes too long"); newline
         %finish
         show checks(header_checks)
         printstring("Code size "); phex(header_codesize)
         printstring("  Data size "); phex(header_ownsize); newline
         printstring("Stack size ") %and phex(header_stacksize) %and %c
         newline %unless header_stacksize=0
         printstring("Entries:"); newline
         offset = sizeof(header)+header_export+header_import
         spaces(17); phex(header_reset<<1+offset); printstring(" {reset}"); newline
         spaces(17); phex(header_main<<1+offset); printstring(" {main}"); newline
         i = start+sizeof(header); j = i+header_export
         show entry(i) %while i<j %and integer(i)<0
         printstring("References:"); newline
         i = j; j = i+header_import
         show entry(i) %while i<j %and integer(i)<0
      %end

      %routine mobanal
         %integer n, p, q, refs
         printstring("File is a Version 0 object module"); newlines(2)
         p = start+2
         printstring("Entries:            "); n = 1; refs = 0
       
         %while 0<byteinteger(p)<12 %cycle
           space %unless n=0; n = n+1; refs = refs + 1

       {}  phex(integer(p+12)); space
           printstring(string(p))
           %if n=3{6} %then newline %and n = 0 %else spaces(11-byteinteger(p))
           p = p+20
         %repeat
       
         p = p+2
         printstring(" none") %if refs = 0
         newline %unless n=0
         printstring("Code size: ");
         q = limit-2+shortinteger(limit-2)+40
         q = q-4 %if shortinteger(q-8)=16_6100
         phex(q-40-p)

         printstring("  Data size: ");phex(limit-4-q); newline

         printstring("References:         "); n = 1; refs = 0
       
         %while 0<byteinteger(q)<12 %cycle
           space %unless n=0; n = n+1; refs = refs + 1
       {}  phex(integer(q+12)); space
           printstring(string(q))
           %if n=3{6} %then newline %and n = 0 %else spaces(11-byteinteger(q))
           q = q+20
         %repeat
       
         q = q+2
         printstring(" none") %if refs = 0
         newline %unless n=0
      %end

      %routine cmobanal
         %constinteger entptoffset = 28
         %integer p

         %routine showval(%integername p, %string (63) text)
            printstring(text); space; phex(integer(p))
            %if p-start # entptoffset %start ;!Not meaningful for entry point
               %if integer(p) # 0 %start
                  printstring(" ("); write(integer(p), 0); printstring(")")
               %finish
               printstring(" bytes")
            %finish
            newline
            p = p + 4
         %end

         printstring("File is a 'C' object module"); newlines(2)

         p = start + 4
         showval(p, "text size:                     ")
         showval(p, "data size:                     ")
         showval(p, "blank data size:               ")
         showval(p, "symbol table size:             ")
         showval(p, "text relocation directory size:")
         showval(p, "data relocation directory size:")
         showval(p, "entry point:                   ")
      %end

      %integer check

      %routine rhex1(%integername p, val)
         eventmess = "Unterminated" %and %signal 15 %if p >= start+filelen
         val = byteinteger(p); p = p + 1
         val = val - '0'; val = val - 7 %if val > 9
      %end
      
      %routine rhex2(%integername p, val)
         %integer a
         rhex1(p, val); rhex1(p, a)
         val = val<<4 + a
         check = check + val
      %end
      
      %routine rhex4(%integername p, val)
         %integer a
         rhex2(p, val); rhex2(p, a)
         val = val<<8 + a
      %end
      
      %predicate looks like an m68 file(%integername p)
         %integer c, i, lgth, q
         p = start
         p = p + 1 %while byteinteger(p) = 13 %or byteinteger(p) = nl
         %false %unless byteinteger(p) = 'S' %and byteinteger(p+1) = '0'
         q = p+2; check = 0
         rhex2(q, lgth)
         %for i = 1,1,lgth %cycle; rhex2(q, c); %repeat
         check = check + 1
         %false %unless check & 255 = 0
         %true
      %end


      %routine m68mobanal(%integer p)
         %integer i, s, type, offset, add, lgth
         %integerarray buffer(0:255)
         
         %routine fail(%string (63) text)
            eventmess = text
            %signal 15
         %end
         
         %on %event 15 %start; -> abort; %finish

         printstring("File is a Motorola M6800")
         %if p = start %then printsymbol('0')
         printstring(" OMF file"); newlines(2)
         add = -1
         %cycle
            s = byteinteger(p); p = p + 1; fail("'S' Missing") %if s # 'S'
            type = byteinteger(p); p = p + 1 ; fail("Funny Type value") %c
            %unless '0' <= type <= '9'
            check = 0
            rhex2(p, lgth); rhex4(p, offset)
            %for i = 0, 1, lgth-3 %cycle
               rhex2(p, buffer(i))
            %repeat
            check = check + 1
            fail("Checksum failure") %if check&255 # 0
            %if type = '0' %start
               printstring("Module Name: ")
               %for i = 0, 1, lgth-4 %cycle; printsymbol(buffer(i)); %repeat
               newline
            
            %elseif type = '1'
               %if offset # add %start
                  %if add = -1 %start
                     printstring("Areas loaded:")
                  %else
                     phex4(add-1)
                  %finish

                  newline
                  phex4(offset); printstring(" - ")
                  add = offset
               %finish
               add = add + lgth - 3
            
            %elseif type = '9'
               %exit
            
            %finish
            p = p + 1 %while byteinteger(p) < ' ' %and p < start+filelen
            fail("Unterminated") %if p >= start + filelen
         %repeat
         phex4(add-1); newline
         %return

abort:
         printstring("(Corrupt: ".eventmess.")"); newline
      %end


      %on %event 3,9 %start ; -> filetoobig; %finish

      File Number = File Number + 1

      newline %if file number > 1
      s = existance(file)
      %if s = "" %start
         %if options = vbrief %then to lower(file) %and printstring(file) %elsestart
            ext = "" %unless file -> s.(".").ext
            i = 0 %while ext -> s.(".").ext
            to upper(ext)
            %if file -> dir.("$:").f %then s = "" %else s = ninfo(file)
            %if options = brief %then printstring(s) %elsestart
               unpack finfo(s, r)
               printstring("File: ".file); spaces(2)
               %if s # "" %start
                  printstring("  Last altered: "); printstring(r_date)
                  spaces(2); printstring(r_time); spaces(4)
                  newline
                  printstring("Permissions: Self: "); printsymbol(charno(r_perms, 1))
                  printstring("  Others: "); printsymbol(charno(r_perms, 2))
                  printstring("   Archive: "); printsymbol(charno(r_perms, 3))
               %finishelse printstring("is a pseudo-file")
               newline
               filelen = filesize(file)
               printstring("Size: "); phex(filelen)
               printstring(" ("); write(filelen, 0); printstring(") bytes")
               %if s # "" %start
                  printstring(" in ")
                  write(r_blocks, 0); printstring(" block")
                  %if r_blocks > 1 %then printstring("s, ") %else printstring(", ")
                  write(r_extents, 0); printstring(" extent")
                  printsymbol('s') %if r_extents > 1
               %finish
               newline
               Wild Chars = Wild Chars + filelen
         
            
               %if filelen # 0 %start
                  %if options > normal %start
                     connectfile(file,0,start,filelen); limit = filelen+start
                     %if options = dump %start
                        dumpfile(start, filelen)
                     %elseif options = count
                        countfile(start, filelen)
                     %else
                        %if {ext = "MOB" %or ext = "MEX") %and}%c
                        byteinteger(start) = 16_fe %start ;!Object module
             %if byteinteger(start+1) = 1 %or byteinteger(start+1) = 2 %start
                              !New format object module - various flavours
                              mexanal
               
                           %elseif byteinteger(start+1) = 0
                              mobanal
               
                           %elseif byteinteger(start+1) = 16_cc ;!C object module
                              cmobanal
               
                           %elseif byteinteger(start+1) = 16_bc
                              printstring("File is an M68000 assembler object module"); newline
            
               
                           %elseif byteinteger(start+1) = 16_fe
                              printstring("File is an S-Algol object module"); newline
               
                           %else
                              genanal("character file or object module of unknown type")
               
                           %finish
                           
                        %elseif (ext = "MOB" %and byteinteger(start) = '{') %or ext = "COM"
                           genanal("command file")
                        
                        %elseif ext = "MOB" %and byteinteger(start) = 'S'
                           m68mobanal(start)
                        
                        %elseif ext = "OBJ" %and looks like an M68 file(p)
                           m68mobanal(p)
            
                        %else
                           genanal("character file")
               
                        %finish
            
                        heapput(start)
                     %finish
                  %finish
               %else
                  printstring("File is empty"); newline
               %finish
      
            %finish
         %finish
   
      %else
         length(s) = length(s)-1 %if charno(s, length(s)) = nl
         printstring("No access to ".file." (""".s.""")"); newline
      %finish

      !Clear input buffer to allow ctrl-<thing> through
      %signal 15 %if 11 <= pendsymbol < ' '
      %return

file too big:
      printstring(" File too big to analyse"); newline
   %end
   
   
   %routine Do Wild Files (%string (80) Wild File)
      %string (127) Line, A, B, Directory
      %integer Flag = 0, Index


      %on 3,9 %start
         %if Flag = 0 %start
            Event_Message = "Rainer stole event_message again" %if Event_Message = ""
            Print String ("Analyse : ".Event_Message)
            New Line
            %return
         %finish
         -> End Load
      %finish

      Directory = ""
      %if Wild File -> Directory .(":"). Wild File %start; %finish
      Directory = Directory . ":" %if Directory # ""
      Open Input (3, Directory."Directory")
      Select Input (3)
      Flag = 1

      Index = 1
      Number of Files = 0
      %cycle
         Read Line (Line)
         %if Matches (Line, Wild File) %start
            %if Wild File = "*" %start
               %continue %if Line -> A .("."). B
            %finish
            Number of Files = Number of Files + 1
            Files (Number of Files) = Directory.Line
         %finish
         Index = Index + 1
      %repeat

End Load:
      Close Input
      Select Input (0)

      Index = 1
      %while Index <= Number of Files %cycle
         Do One File (Files (Index))
         Index = Index + 1
      %repeat
   %end

   %on %event 9, 15 %start
      -> abend
   %finish

   file = ""; defext = ""
   define param("FILE", file, pam major)
   define param("EXTension",defext,0)
   define param("OUT", outfile, pam new group)
   define enum param("VBrief,Brief,Normal,Full,Dump,Count", options, 0)
   process parameters(cli param)
   open output(1, outfile) %if outfile # ""
   prompt("File(s):")
   readline(file) %while file = ""

   %while File -> File 1 .(","). File %cycle
      file 1 = file 1.".".defext %unless defext = "" %or file 1 -> s.(".")
      %if Wildness (File 1) # 0 %then Do Wild Files (File 1) %c
                                %else Do One File (File 1)
   %repeat

   %if File # "" %start
      file = file.".".defext %unless defext = "" %or file -> s.(".")
      %if Wildness (File) # 0 %then Do Wild Files (File) %c
                                %else Do One File (File)
   %finish

   %if File Number > 1 %and options >= normal %start
      newline
      Print String ("Total of ")
      Write (Wild Chars, 0)
      Print String (" character")
      Print Symbol ('s') %if Wild Chars # 1
      %if options = full %start
         Print String (" on ")
         Write (Wild Lines, 0)
         Print String (" line")
         Print Symbol ('s') %if Wild Lines # 1
      %finish
      Print Symbol ('.')
   %finish

abend:
   New Line

%endofprogram