Source code in the pl/m programming language

100H: /* SOLVE THE 4 RINGS OR 4 SQUARES PUZZLE                              */

   DECLARE FALSE LITERALLY '0';
   DECLARE TRUE  LITERALLY '0FFH';

   /* CP/M SYSTEM CALL AND I/O ROUTINES                                     */
   BDOS:      PROCEDURE( FN, ARG ); DECLARE FN BYTE, ARG ADDRESS; GOTO 5; END;
   PR$CHAR:   PROCEDURE( C ); DECLARE C BYTE;    CALL BDOS( 2, C );  END;
   PR$STRING: PROCEDURE( S ); DECLARE S ADDRESS; CALL BDOS( 9, S );  END;
   PR$NL:     PROCEDURE;   CALL PR$CHAR( 0DH ); CALL PR$CHAR( 0AH ); END;
   PR$NUMBER: PROCEDURE( N ); /* PRINTS A NUMBER IN THE MINIMUN FIELD WIDTH */
      DECLARE N ADDRESS;
      DECLARE V ADDRESS, N$STR ( 6 )BYTE, W BYTE;
      V = N;
      W = LAST( N$STR );
      N$STR( W ) = '$';
      N$STR( W := W - 1 ) = '0' + ( V MOD 10 );
      DO WHILE( ( V := V / 10 ) > 0 );
         N$STR( W := W - 1 ) = '0' + ( V MOD 10 );
      END;
      CALL PR$STRING( .N$STR( W ) );
   END PR$NUMBER;

   /* FIND SOLUTIONS TO THE EQUATIONS:                                      */
   /*       A + B = B + C + D = D + E + F = F + G                           */
   /* WHERE A, B, C, D, E, F, G IN LO : HI ( NOT NECESSARILY UNIQUE )       */
   /* DEPENDING ON SHOW, THE SOLUTIONS WILL BE PRINTED OR NOT               */
   FOUR$RINGS: PROCEDURE( LO, HI, ALLOW$DUPLICATES, SHOW );
      DECLARE ( LO, HI ) ADDRESS;
      DECLARE ( ALLOW$DUPLICATES, SHOW ) BYTE;
      DECLARE ( SOLUTIONS, A, B, C, D, E, F, G, T ) ADDRESS;
      SOLUTIONS = 0;
      DO A = LO TO HI;
         DO B = LO TO HI;
            IF ALLOWDUPLICATES OR A <> B THEN DO;
               T = A + B;
               DO C = LO TO HI;
                  IF ALLOWDUPLICATES OR ( A <> C AND B <> C ) THEN DO;
                     D = T - ( B + C );
                     IF  D >= LO AND D <= HI
                     AND (  ALLOW$DUPLICATES
                         OR ( A <> D AND B <> D AND C <> D )
                         )
                     THEN DO;
                        DO E = LO TO HI;
                           IF ALLOWDUPLICATES
                           OR (   A <> E AND B <> E
                              AND C <> E AND D <> E
                              )
                           THEN DO;
                              G = D + E;
                              F = T - G;
                              IF  F >= LO AND F <= HI
                              AND G >= LO AND G <= HI
                              AND (  ALLOWDUPLICATES
                                  OR (   A <> F AND B <> F AND C <> F
                                     AND D <> F AND E <> F
                                     AND A <> G AND B <> G AND C <> G
                                     AND D <> G AND E <> G AND F <> G
                                     )
                                 )
                              THEN DO;
                                 SOLUTIONS = SOLUTIONS + 1;
                                 IF SHOW THEN DO;
                                    CALL PR$CHAR( ' ' ); CALL PR$NUMBER( A );
                                    CALL PR$CHAR( ' ' ); CALL PR$NUMBER( B );
                                    CALL PR$CHAR( ' ' ); CALL PR$NUMBER( C );
                                    CALL PR$CHAR( ' ' ); CALL PR$NUMBER( D );
                                    CALL PR$CHAR( ' ' ); CALL PR$NUMBER( E );
                                    CALL PR$CHAR( ' ' ); CALL PR$NUMBER( F );
                                    CALL PR$CHAR( ' ' ); CALL PR$NUMBER( G );
                                    CALL PR$NL;
                                 END;
                              END;
                           END;
                        END;
                     END;
                  END;
               END;
            END;
         END;
      END;
      CALL PR$NUMBER( SOLUTIONS );
      IF ALLOW$DUPLICATES THEN CALL PR$STRING( .' NON-UNIQUE$' );
                          ELSE CALL PR$STRING( .' UNIQUE$'     );
      CALL PR$STRING( .' SOLUTIONS IN $' );
      CALL PR$NUMBER( LO );
      CALL PR$STRING( .' TO $' );
      CALL PR$NUMBER( HI );
      CALL PR$NL;
      CALL PR$NL;
    END FOUR$RINGS;

    /* FIND THE SOLUTIONS AS REQUIRED FOR THE TASK */
    CALL FOUR$RINGS( 1, 7, FALSE, TRUE  );
    CALL FOUR$RINGS( 3, 9, FALSE, TRUE  );
    CALL FOUR$RINGS( 0, 9, TRUE,  FALSE );
EOF