perm filename UML.SAI[3,PMP] blob
sn#011783 filedate 1972-11-09 generic text, type T, neo UTF8
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;