$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;