00100	BEGIN "UML"
00200	INTEGER I,J,EOF,NUMCT,K,L,M,N,ERRCT;
00300	STRING S1,S2;
00400	STRING ARRAY LET[1:18],NAM[1:8,1:16];
00500	INTEGER ARRAY PINS,SECTS[1:8,1:16],NUMS[1:3,1:2000],CEPS[1:216];
00550	INTEGER PROCEDURE LC(INTEGER A);
00575	    BEGIN INTEGER Q;
00587		Q←A;IF Q>6 THEN Q←Q-1;
00593		IF Q>7 THEN Q←Q-1;IF Q>12 THEN Q←Q-1;IF Q>13 THEN Q←Q-1;
00596		RETURN (Q);
00598	    END;
00600	
00700	I←0;
00750	ERRCT←0;
00800	OPEN(1,"TTY",0,1,0,20,J,I);
00900	OUTSTR("FILENAME?");
01000	SETBREAK(1,".["&13,10,"IRE");
01100	S1←INPUT (1,1);
01200	S2←S1;
01300	S1←S1&".TST";S2←S2&".UML";
01400	IF J="[" THEN S1←S1&INPUT(1,1);
01500	OPEN (2,"DSK",8,2,0,0,0,EOF);
01600	OPEN (3,"DSK",0,0,2,0,0,0);
01700	LOOKUP (2,S1,0);ENTER(3,S2,0);
01800	LET[1]←"A";LET[2]←"B";LET[3]←"C";LET[4]←"D";
01900	LET[5]←"E";LET[6]←"F";LET[7]←"H";LET[8]←"J";
02000	LET[9]←"K";LET[10]←"L";LET[11]←"M";LET[12]←"N";
02100	LET[13]←"P";LET[14]←"R";LET[15]←"S";LET[16]←"T";
02150	LET[17]←"U";LET[18]←"V";
02200	NUMCT←1;
02300	FOR I←1 STEP 1 UNTIL 8 DO
02400	 FOR J←1 STEP 1 UNTIL 16 DO
02500	  PINS[I,J]←SECTS[I,J]←0;
02600	FOR I←1 STEP 1 UNTIL 144 DO CEPS[I]←0;
02700	I←WORDIN(2);
02800	WHILE I≠0 DO
02900	    BEGIN
03000		S1←CVSTR(I);
03100		IF I LAND '376 ≠0 THEN S1←S1&CVSTR(WORDIN(2));
03200		I←WORDIN(2);
03300		NUMS[1,NUMCT]←I;I←WORDIN(2);
03350		IF I=0 THEN ERRCT←ERRCT+1
03375		 ELSE
03387		    BEGIN
03400			I←I/64;
03500			J←I/64;
03600			I←I-J*64;
03650			J←LC(J);
03700			NAM[I,J]←S1;
03800			NUMS[2,NUMCT]←I;
03900			NUMS[3,NUMCT]←J;
04000			SECTS[I,J]←SECTS[I,J]+1;
04050		    END;
04100		NUMCT←NUMCT+1;
04200		I←WORDIN(2);
04300	    END;
04400	I←WORDIN(2);
04500	WHILE I≠0 DO
04600	    BEGIN
04700		WHILE I≠0 DO
04800		    BEGIN
04900			J←I/'1000000;
05000			I←I-J*'1000000;
05100			IF J=0 THEN
05200			    BEGIN
05300				K←I/'10000;
05400				L←K;
05500				K←I/64-K*64;
05550				K←LC(K);
05575				L←LC(L)*36;
05600				L←L+K*2+(I LAND 3)-38;
05700				CEPS[L]←1;
05800			    END;
05900			I←WORDIN(2);
06000		    END;
06100		I←WORDIN(2);
06200	    END;
06240	FOR I←8 STEP -1 UNTIL 1 DO
06260	FOR J←1 STEP 1 UNTIL 16 DO
06270	    BEGIN
06280		S1←NAM[I,J];NAM[I,J]←NULL;
06282		L←LENGTH(S1);
06284		FOR M←1 STEP 1 UNTIL L DO
06286		    BEGIN
06288			N←LOP(S1);IF N≠0 THEN NAM[I,J]←NAM[I,J]&N;
06290		    END;
06292	    END;
06300	OUT(3,9&9&S2&13&10);
06400	OUT(3,13&10&13&10&13&10&13&10);
06500	FOR J←1 STEP 1 UNTIL 16 DO
06600	    BEGIN
06700		FOR I←8 STEP -1 UNTIL 1 DO
06800		 OUT(3,"__________    ");
06900		OUT(3,13&10);
07000		FOR I←8 STEP -1 UNTIL 1 DO
07100		    BEGIN
07200			IF SECTS[I,J]=0 THEN OUT(3,"|        |    ")
07300			 ELSE
07400			    BEGIN
07500				OUT(3,"| "&NAM[I,J]);
07600				FOR L←1 STEP 1 UNTIL 7-LENGTH(NAM[I,J]) DO OUT(3," ");
07700				OUT(3,"|    ");
07800			    END;
07900		    END;
08000		OUT (3,13&10);
08100		FOR I←8 STEP -1 UNTIL 1 DO IF SECTS[I,J]=0 THEN OUT(3,"|        |    ")
08120		 ELSE OUT(3,"|*      *|    ");
08140		OUT(3,13&10);
08200		FOR I←8 STEP -1 UNTIL 1 DO
08300		    BEGIN
08400			OUT(3,"|"&LET[J]&CVS(I)&"  ");
08500			IF SECTS[I,J]=0 THEN OUT(3,"    ")
08600			 ELSE
08700			    BEGIN
08800				OUT(3,CVS(SECTS[I,J]));
08900				FOR L←1 STEP 1 UNTIL 4-LENGTH(CVS(SECTS[I,J])) DO
09000				 OUT(3," ");
09100			    END;
09200			OUT(3,"|    ");
09300		    END;
09350		OUT(3,13&10);
09400		FOR I←1 STEP 1 UNTIL 8 DO
09500		 OUT(3,"----------    ");
09600		OUT (3,13&10);
09700		OUT (3,13&10&13&10);
09800	    END;
09900	OUT(3,13&12);
09950	FOR K←1 STEP 1 UNTIL 2 DO
10000	FOR I←1 STEP 1 UNTIL 18 DO
10050	    BEGIN
10100		FOR J←1 STEP 1 UNTIL 6 DO
10200		    BEGIN
10300			OUT(3,LET[J]&LET[I]&CVS(K)&"  ");
10400			IF CEPS[J*36+I*2+K-38]=0 THEN OUT(3,"               ")
10500			 ELSE OUT(3,"****%%%%$$$$   ");
10600		    END;
10700		OUT(3,13&10&13&10);
10800	    END;
10850	OUT(3,"DIPS WITH NO LOCATION -----    "&CVS(ERRCT)&13&10);
10900	RELEASE(2);RELEASE(3);RELEASE(1);
11000	END;END;END;END;END;
11100	END;