$TITLE('==>  C G R E A T  <==  CHKLOD')

CGREAT: DO;

/************************************************************************/
/*																		*/
/*     'Copyright 1981,1983 Intel Corporation'.  All rights reserved.	*/
/*      No part of this program or publication may be reproduced,		*/
/*      transmitted, transcribed, stored in a retrievel system, or		*/
/*      translated into any language or computer language, in any		*/
/*      form or by any means, electronic, mechanical, magnetic,			*/
/*      optical, chemical, manual or otherwise, without the prior		*/
/*      written permission of Intel Corporation, 3065 Bowers			*/
/*      Avenue, Santa Clara, California, 95051, Attn: Software			*/
/*      License Administration.											*/
/*																		*/
/************************************************************************/


/*******  EXTERNALS  *******/

/*  UTIL.LIB  */

DECLARE obuf$p ADDRESS EXTERNAL;
DECLARE scan$p ADDRESS EXTERNAL;
ddigch: PROCEDURE BYTE EXTERNAL; END;
decin: PROCEDURE ADDRESS EXTERNAL; END;
forcup$string: PROCEDURE EXTERNAL; END;
out$chars: PROCEDURE (count,char) EXTERNAL; DECLARE (count,char) BYTE; END;
out$crlf: PROCEDURE EXTERNAL; END;
out$print: PROCEDURE (ptr) EXTERNAL; DECLARE ptr ADDRESS; END;
scan$match: PROCEDURE (ptr) BYTE EXTERNAL; DECLARE ptr ADDRESS; END;
scan$while: PROCEDURE (proc$addr) EXTERNAL; DECLARE proc$addr ADDRESS; END;

/*   SYS.LIB  */

writec: PROCEDURE (src,count) EXTERNAL; DECLARE (src,count) ADDRESS; END;
writeo: PROCEDURE (src,count) EXTERNAL; DECLARE (src,count) ADDRESS; END;

/* CSORT2.A80 */

sort: PROCEDURE (ptr,count,proc$addr) EXTERNAL;
  DECLARE (ptr,count,proc$addr) ADDRESS;
END;

/* CHKLOD.P80 */

DECLARE marked$file$names$ptrs (512) ADDRESS EXTERNAL;
DECLARE mfn$counter ADDRESS EXTERNAL;

/* CINVOK.P80 */

DECLARE listing BYTE EXTERNAL;
DECLARE sorting BYTE EXTERNAL;
DECLARE listing$not$to$co BYTE EXTERNAL;

/* CMOVEM.P80 */

movem: PROCEDURE (c,s,d) EXTERNAL; DECLARE (c,s,d) ADDRESS; END;

/*******  END OF EXTERNALS  *******/


/*******  PUBLICS  *******/

DECLARE has$greatest$numeric$ext (512) BYTE PUBLIC;
DECLARE last$index ADDRESS PUBLIC;

/*******  END OF PUBLICS  *******/


DECLARE true  LITERALLY '0FFH',
        false LITERALLY '0',
        null  LITERALLY '0',
        CR    LITERALLY '0DH',
        LF    LITERALLY '0AH';

DECLARE name1 (15) BYTE,
        name2 (15) BYTE;

DECLARE duplicate$flags (512) ADDRESS;
DECLARE top  ADDRESS,
        next ADDRESS;

DECLARE we$have$a$duplicate BYTE INITIAL (false);
DECLARE warning$string  (*) BYTE INITIAL (CR,LF,
        'WARNING: respecification of source version information encountered',
         CR,LF,0);


greater$than: PROCEDURE (sptr1,sptr2) BYTE;
  DECLARE (sptr1,sptr2) ADDRESS;
  DECLARE ptr1 BASED sptr1 ADDRESS,
          ptr2 BASED sptr2 ADDRESS;
  DECLARE (nptr1,nptr2) ADDRESS;
  DECLARE i BYTE;

  /* the sptr's (from sort) point to the
     file name ptrs, which point to the file names
  */
  nptr1 = (nptr1 := ptr1) + 4;  /* ignore leading :f?: field */
  nptr2 = (nptr2 := ptr2) + 4;
  CALL movem (11, nptr1, (scan$p := .name1));
  CALL forcup$string;     /* uppercase name for comparison */
  CALL movem (11, nptr2, (scan$p := .name2));
  CALL forcup$string;
  i = 0;
  DO WHILE name1(i) = name2(i);
    IF (i := i + 1) > 9 THEN
      RETURN true;
  END;
  RETURN (name1(i) > name2(i));
END greater$than;


sort$names$for$listing: PROCEDURE PUBLIC;

  CALL sort (.marked$file$names$ptrs, mfn$counter, .greater$than);
END sort$names$for$listing;



check$duplicate$file$names: PROCEDURE PUBLIC;
  DECLARE first BYTE;

  IF mfn$counter < 2 THEN  /* only one file name */
    RETURN;
  last$index = mfn$counter - 1;
  DO next = 0 TO last$index;  /* initialize array */
    duplicate$flags (next) = next;  /* each one duplicate of itself */
  END;

  DO top = 0 TO last$index - 1;
    CALL movem (15, marked$file$names$ptrs(top), (scan$p := .name1));
    CALL forcup$string;
    name1(10) = 0;    /* set dot to null */
    DO next = top + 1 TO last$index;
      IF duplicate$flags (next) = next THEN /* not same as anything else yet */
        DO;
          CALL movem (15, marked$file$names$ptrs(next), (scan$p := .name2));
          CALL forcup$string;
          name2(10) = 0;
          scan$p = .name2(4);  /* skip device part */
          IF scan$match (.name1(4)) THEN
            DO;
              duplicate$flags (next) = top;
              duplicate$flags (top) = 0FFFFH;
              we$have$a$duplicate = true;
            END;
        END;
    END;
  END;

  IF we$have$a$duplicate THEN
    DO;
      obuf$p = .memory;
      CALL out$print (.warning$string);
      DO top = 0 TO last$index - 1;
        IF duplicate$flags (top) = 0FFFFH THEN  /* this one same as others */
          DO;
            CALL out$print (.(CR,LF,'SOURCE FILE NAME: ',0));
            CALL out$print (marked$file$names$ptrs(top));
            CALL out$crlf;
            CALL out$print (.(' DUPLICATE NAMES: ',0));
            first = true;
            DO next = top + 1 TO last$index;
              IF duplicate$flags (next) = top THEN
                DO;
                  IF first THEN
                    first = false;
                  ELSE
                    CALL out$chars (18, ' ');
                  CALL out$print (marked$file$names$ptrs(next));
                  CALL out$crlf;
                END;
            END;
            CALL writec (.memory, obuf$p - .memory);
            IF listing$not$to$co THEN
              CALL writeo (.memory, obuf$p - .memory);
            obuf$p = .memory;
          END;
      END;
    END;
END check$duplicate$file$names;




numeric$extension: PROCEDURE ADDRESS PUBLIC;
  DECLARE start$scan ADDRESS;

  /*  assumes scan$p already pointing at extension chars
      returns 0FFFFH if not numeric extension
      otherwise returns decimal value             */

  start$scan = scan$p;
  CALL scan$while (.ddigch);
  IF (start$scan + 3) <> scan$p THEN
    RETURN 0FFFFH;
  ELSE
    DO;
      scan$p = start$scan;
      RETURN decin;
    END;
END numeric$extension;



get$greatest$numeric$exts: PROCEDURE PUBLIC;
  DECLARE last$name$equal$to$top ADDRESS,
          greatest$ext$val       ADDRESS,
          greatest$ext           ADDRESS,
          ext$val                ADDRESS;

  set$null$and$forcup: PROCEDURE (index);
    DECLARE index    ADDRESS,
            dot$ptr  ADDRESS,
            dot$byte BASED dot$ptr BYTE;
    dot$ptr = (scan$p := marked$file$names$ptrs(index)) + 6;
    dot$byte = null;
    CALL forcup$string;
  END set$null$and$forcup;

  IF (NOT listing) OR (NOT sorting) THEN  /* sort the names, easier to match */
    CALL sort$names$for$listing;

  /*  initialize array that marks greatest extensions
      and reset name ptrs past :f?: part    */

  last$index = mfn$counter - 1;
  DO next = 0 TO last$index;
    has$greatest$numeric$ext (next) = 80H;  /* haven't looked at it yet */
    marked$file$names$ptrs (next) = marked$file$names$ptrs (next) + 4;
  END;

  DO top = 0 TO last$index;
    IF has$greatest$numeric$ext (top) = 80H THEN
      DO;
        CALL set$null$and$forcup (top);
        last$name$equal$to$top = top;
        /* now mark off all file names equal to top's name
           since they're sorted, just go down the list  */
        DO WHILE true;
          IF (next := last$name$equal$to$top + 1) > last$index THEN /* top is last */
            GO TO no$more$duplicates;
          CALL set$null$and$forcup (next);
          IF scan$match (marked$file$names$ptrs(top)) THEN /* duplicate */
            last$name$equal$to$top = next;
          ELSE  /* not duplicate, give up */
            GO TO no$more$duplicates;
        END;
no$more$duplicates:
        /* find the greatest numeric extension for the current file name */
        greatest$ext$val = 0;
        greatest$ext = 0FFFFH;
        DO next = top TO last$name$equal$to$top;
          scan$p = marked$file$names$ptrs (next) + 7;  /* point at extension */
          IF (ext$val := numeric$extension) <> 0FFFFH THEN  /* it's numeric */
            DO;
              IF ext$val >= greatest$ext$val THEN  /* save this one */
                DO;
                  greatest$ext$val = ext$val;
                  greatest$ext = next;
                END;
            END;
        END;
        DO next = top TO last$name$equal$to$top;
          has$greatest$numeric$ext (next) = (next = greatest$ext);
        END;
      END;
  END; /* top = 0 TO last$index */
END get$greatest$numeric$exts;

END;