%%HP: T(3)A(R)F(.);
@ SYMBMAT2 by Marc E Blair
DIR
  \->q
    \<<
      IF QR
      THEN '\->q\[]'
DUP RCL SWAP PURGE
'\->q' STO
      ELSE '\->q' DUP
RCL SWAP PURGE
'\->q\[]' STO
      END QR NOT
'QR' STO
    \>>
  Rr
    \<< Dec \-> L S
      \<< S L \161RR 0 1
S
        FOR A A L *
A - 2 + PICK +
        NEXT
        IF ZRO?
SWAP DROP NOT
        THEN S L
\161RR
        END 1 L
        FOR A S
\->LIST L A - S * A +
ROLLD
        NEXT L
\->LIST
      \>>
    \>>
  det
    \<< Dec DROP MNN
    \>>
  EC
    \<< EVAL
      DO DUP EXPAN
DUP ROT
      UNTIL SIZE
SWAP SIZE ==
      END
      DO DUP COLCT
DUP ROT
      UNTIL SIZE
SWAP SIZE ==
      END
    \>>
  SIMEQ
    \<< DUP Dec DUP
      IF 6 <
      THEN DUP2 1 -
        IF ==
        THEN DROP \->
Ss
          \<< 0 Ss
            FOR Aa
Ss DUP * Ss
              FOR
Bb Bb Aa + PICK Ss
NEG
              STEP
Ss \->LIST Ss Ss 1 +
* 1 + ROLLD
            NEXT Ss
Ss 1 + * DROPN Ss 1
+ ROLL \-> Cc
            \<< Ss
DUPN Ss \->LIST det \->
Dd
              \<<
IF Dd ZRO? SWAP
DROP NOT
THEN 1 Ss
  FOR Aa Ss DUPN Aa
ROLL DROP Cc Aa
ROLLD Ss \->LIST det
Dd /
    IF QR
    THEN \->Q
    END Ss 1 +
ROLLD
  NEXT Ss DROPN Ss
\->LIST
ELSE Ss DROPN
"No Solution"
END
              \>>
            \>>
          \>>
        ELSE *
DROPN
"BAD # OF EQS"
        END SWAP
DROP
      ELSE * DROPN
SM2
      END
    \>>
  inv
    \<< Dec \-> S L
      \<< 0 L 1 -
        FOR A 0 S 1
-
          FOR B A B
== L S * L - 1 + A
L * - ROLLD
          NEXT
        NEXT L S
      \>> DUP + \-> L S
      \<< S L \161RR 1 L
        FOR A S 2 /
\->LIST L A - S * A +
S 2 / + ROLLD S 2 /
DROPN
        NEXT L
\->LIST
      \>>
    \>>
  MEC
    \<< OBJ\-> \-> A
      \<< 1 A 1 -
        FOR B +
        NEXT OBJ\-> \->
S
        \<< 1 S
          FOR C EC
S ROLLD
          NEXT 1 A
          FOR D S A
/ \->LIST S S A / D *
- D + ROLLD
          NEXT A
\->LIST
        \>>
      \>>
    \>>
  SM2
    \<< Rr 0 'ER' STO
{ } SWAP OBJ\-> \-> S
      \<< 1 S
        FOR A OBJ\->
\-> L
          \<< L S A -
- ROLL
            IF 1 \=/
            THEN 1
'ER' STO
            END S A
- L + ROLL + S A -
L 1 - + ROLLD 0 1 L
2 -
            FOR C +
            NEXT
            IF 0 \=/
            THEN 1
'ER' STO
            END
          \>>
        NEXT
        IF ER 1 ==
        THEN DROP
"NO SOLUTION"
        END 'ER'
PURGE
      \>>
    \>>
  Dec
    \<< OBJ\-> DUP TYPE
      IF 5 ==
      THEN EVAL
      ELSE \-> L
        \<< 1 L 1 -
          FOR A +
          NEXT OBJ\->
L / L SWAP
        \>>
      END
    \>>
  ZRO?
    \<< DUP TYPE 0
      IF \=/
      THEN 0
      ELSE DUP
        IF 0 \=/
        THEN 0
        ELSE 1
        END
      END
    \>>
  \161RR
    \<< \-> L S
      \<< 0 S 1 -
        FOR A S L *
A - DUP 1 + PICK \->
F M1
          \<< 1 S 1 -
            FOR B F
B L * - DUP 1 +
PICK \-> C M2
              \<< M2
ZRO?
IF NOT
THEN DROP 0 L 1 -
  FOR D C A + D -
ROLL M1 0 'DOIT'
STO ZRO?
    IF NOT
    THEN *
    ELSE DROP 1
'DOIT' STO
    END F A + D -
PICK M2 ZRO?
    IF NOT
    THEN *
    ELSE DROP 1
'DOIT' STO
    END - EXPAN
COLCT C A + D -
ROLLD
  NEXT
ELSE DROP
END
              \>>
            NEXT 1
L
            FOR Q S
L * ROLL
            NEXT
          \>> 'DOIT'
PURGE
        NEXT 0 S 1
-
        FOR B L S B
- * B - PICK S B -
L * \-> D F
          \<< 0 L 1 -
            FOR C F
C - ROLL
              IF D
TYPE 0 ==
              THEN
IF D 0 ==
THEN \oo *
ELSE D / COLCT
  IF QR
  THEN \->Q
  END DUP TYPE 9 ==
OVER EVAL DUP IP ==
AND
  IF DUP TYPE 0 ==
  THEN
    IF
    THEN EVAL
    END
  ELSE DROP
  END
END
              ELSE
D / COLCT
              END F
C - ROLLD
            NEXT
          \>>
        NEXT
      \>>
    \>>
  MNN
    \<< \-> Ss
      \<<
        IF Ss 3 ==
        THEN 6 DUPN
6 DUPN ROT DROP 4
ROLL * 3 ROLLD * -
SWAP DROP 16 PICK *
16 ROLLD SWAP DROP
4 ROLL DROP 4 ROLL
* 3 ROLLD * - 9
PICK * 10 ROLLD
DROP ROT DROP 4
ROLL * 3 ROLLD * -
* ROT DROP SWAP
DROP SWAP - +
        ELSE
          IF Ss 2
==
          THEN 4
ROLL * 3 ROLLD * -
          ELSE 1 Ss
            FOR Aa
Ss DUP DUP * SWAP -
DUPN Ss DUP * Ss 2
* - 0
              FOR
Bb Bb Aa + ROLL
DROP Ss NEG
              STEP
Ss 1 - MNN Ss DUP *
Ss - Aa + 1 + PICK
* -1 Aa Ss + ^ * Ss
Ss * 1 + ROLLD
            NEXT Ss
Ss * DROPN 1 Ss 1 -
            FOR Aa
+
            NEXT
          END
        END
      \>>
    \>>
  QR 0
END
