(* ************************************************************ *
 *								*	
 *	        Multiply permutations in cycle form		*
 *								*
 *	  Knuth's Program A in 'Fundamental Algorithms'	 	*
 *								*
 * ************************************************************ *)


		MIXAL

	16	EQU	cards		\ Unit number for card reader
	18 	EQU	printer		\ Unit number for printer

| ans		ORIG 	* 1000 +	\ Place for answer
| outbuf	ORIG	* 24 +		\ For copies of input
| perm		ORIG	* 1000 +	\ The input permutation

		FWD	equals
		FWD	lpren
		FWD	rpren
		FWD 	goes
		FWD	close
		FWD 	start
		FWD	size

| begins	IN	perm(cards)	\ read first card
		ENT2	0
		LDA	equals
| 1H		JBUS	*(cards) 	\ wait for cycle complete
		CMPA	perm 15 +,2
		JE	* 2+		\ Is it the last card?
					\ No, read another 
		IN	perm 16 +,2(cards)
		ENT1	outbuf
		JBUS	*(printer)	\ Print input card
		MOVE	perm,2(16)
		OUT	outbuf(printer)
		INC2	16
		JNE	1B		\ Repeat until input complete.
					\ At this point, (rI2) words of
		DEC2	1		\  input are in PERM, PERM+1..
		ST2	size
		ENT3	0		\ _A1. First pass_.
| 2H		LDAN	perm,3		\ Get next element of input.
		CMPA	lpren(1:5)	\ Is it "("?
		JNE	1F
		STA	perm,3		\ Tag it.
		INC3	1		\ Put next nonblank element
		LDXN	perm,3		\   in rX.
		JXZ	* 2-
| 1H		CMPA 	rpren(1:5)		
		JNE	* 2+
		STX	perm,3		\ Replace ")" by tagged rX.
		INC3	1
		CMP3	size		\ Have all elements been processed?
		JL	2B

		LDA	lpren		\ Prepare for main program
		ENT1	ans		\ rI1 = place to store next answer
| open		ENT3	0		\ _A2. Open._
| 1H		LDXN	perm,3		\ Look for untagged element.
		JXN	goes
		INC3	1
		CMP3	size
		JL	1B
					\ All are tagged. Now comes the output.
| done		CMP1	=ans=
		JNE	* 2+		\ Is answer the identity permutation?
		MOVE	lpren(3)	\ If so, change to "(1)"
		MOVE	=0=		\ Put 23 words of blanks after answer.
		MOVE	-1,1(22)
		ENT3	0
		OUT	ans,3(printer)
		INC3	24
		LDX	ans,3		\ Print as many lines as necessary.
		JXNZ	* 3 -
		HLT
| lpren		ALF     (		\ Constants used in program
		ALF   1   
| rpren		ALF )    
| equals	ALF     =

| goes		MOVE	lpren		\ Open a cycle in the output.
		MOVE	perm,3 
		STX	start
| succ		STX	perm,3		\ Tag an element.
		INC3	1		\ Move one step to the right
		LDXN	perm,3(1:5)	\ _A3. Set CURRENT_ (namely rX).
		JXN	1F		\ Skip past blanks.
		JMP	* 3 -
| 4H		CMPX	perm,3(1:5)	\ _A4. Scan formula_.
		JE	succ		\ Element = CURRENT?
| 1H		INC3	1		\ Move to right.
		CMP3	size		\ End of formula?
		JL	4B
		CMPX	start(1:5)	\ _A5. CURRENT = START?_
		JE	close
		STX	0,1		\ No, output CURRENT.
		INC1	1
		ENT3	0		\ Scan formula again
		JMP	4B		\ Go back to A4.
| close		MOVE	rpren		\ _A6. Close_.
		CMPA	-3,1		\ Note: rA = "(".
		JNE	open
		INC1	-3		\ Suppress singleton cycles.
		JMP 	open

		END	begins

\ The following input gives the result "( A D G ) ( C E B )", with lots of 
\ spaces of course.
\ Now dig the following simulated card reader input. One wrong space and 
\ you're dead :-)
\ Use 0CARDS to reset the card reader to the first card again.

0CARDS

\  0	     1	       2         3         4         5         6         7    
\  12345123451234512345123451234512345123451234512345123451234512345123451234512345
S"     (  A    C    F    G  )        (  B    C    D  )        (  A    E    D  )    " 
   >CARDS \ card1
S"     (  F    A    D    E  )        (  B    G    F    A    E  )                  =" 
   >CARDS \ card2

0CARDS

			        (* End of File *)