Set consolidation: Difference between revisions

=={{header|PL/M}}==

<syntaxhighlight lang="plm">100H:

BDOS: PROCEDURE (F,A); DECLARE F BYTE, A ADDRESS; GO TO 5; END BDOS;

EXIT: PROCEDURE; GO TO 0; END EXIT;

PUTC: PROCEDURE (C); DECLARE C BYTE; CALL BDOS(2, C); END PUTC;

PUTS: PROCEDURE (S); DECLARE S ADDRESS; CALL BDOS(9, S); END PUTS;

BIT: PROCEDURE (I) ADDRESS;

DECLARE I BYTE;

IF I=0 THEN RETURN 1;

RETURN SHL(DOUBLE(1), I);

END BIT;

PRINT$SET: PROCEDURE (SET);

DECLARE SET ADDRESS, I BYTE;

CALL PUTC('(');

DO I=0 TO 15;

IF (BIT(I) AND SET) <> 0 THEN CALL PUTC('A' + I);

END;

CALL PUTC(')');

END PRINT$SET;

MAKE$SET: PROCEDURE (SETSTR) ADDRESS;

DECLARE SETSTR ADDRESS, ITEM BASED SETSTR BYTE;

DECLARE SET ADDRESS, POS ADDRESS;

SET = 0;

DO WHILE ITEM <> '$';

POS = ITEM - 'A';

IF POS < 16 THEN SET = SET OR BIT(POS);

SETSTR = SETSTR + 1;

END;

RETURN SET;

END MAKE$SET;

CONSOLIDATE: PROCEDURE (SETS, N) BYTE;

DECLARE (SETS, S BASED SETS) ADDRESS;

DECLARE (N, I, J, CHANGE) BYTE;

STEP:

CHANGE = 0;

DO I=0 TO N-1;

DO J=I+1 TO N-1;

IF (S(I) AND S(J)) <> 0 THEN DO;

S(I) = S(I) OR S(J);

S(J) = 0;

CHANGE = 1;

END;

END;

END;

IF CHANGE THEN GO TO STEP;

DO I=0 TO N-1;

IF S(I)=0 THEN

DO J=I+1 TO N-1;

S(J-1) = S(J);

END;

END;

DO I=0 TO N-1;

IF S(I)=0 THEN RETURN I;

END;

RETURN N;

END CONSOLIDATE;

TEST: PROCEDURE (SETS, N);

DECLARE (SETS, S BASED SETS) ADDRESS;

DECLARE (N, I) BYTE;

DO I=0 TO N-1;

CALL PRINT$SET(S(I));

END;

CALL PUTS(.' -> $');

N = CONSOLIDATE(SETS, N);

DO I=0 TO N-1;

CALL PRINT$SET(S(I));

END;

CALL PUTS(.(13,10,'$'));

END TEST;

DECLARE S (5) ADDRESS;

S(0) = MAKE$SET(.'AB$'); S(1) = MAKE$SET(.'CD$');

CALL TEST(.S, 2);

S(0) = MAKE$SET(.'AB$'); S(1) = MAKE$SET(.'BD$');

CALL TEST(.S, 2);

S(0) = MAKE$SET(.'AB$'); S(1) = MAKE$SET(.'CD$');

S(2) = MAKE$SET(.'DB$');

CALL TEST(.S, 3);

S(0) = MAKE$SET(.'HIK$'); S(1) = MAKE$SET(.'AB$');

S(2) = MAKE$SET(.'CD$'); S(3) = MAKE$SET(.'DB$');

S(4) = MAKE$SET(.'FGH$');

CALL TEST(.S, 5);

CALL EXIT;

EOF</syntaxhighlight>

{{out}}

<pre>(AB)(CD) -> (AB)(CD)

(AB)(BD) -> (ABD)

(AB)(CD)(BD) -> (ABCD)

(HIK)(AB)(CD)(BD)(FGH) -> (FGHIK)(ABCD)</pre>