\def\date{03 Dec 2011}\def\source{V1, p.\ 168}\def\author{Udo Wermuth}\input mmix =-5
!!\clearline{\tenbf Program A} ({\tenit Multiplication of permutations in cycle form\/})\smallskip\startnumbering
t IS $255
tt GREG 0
_lpren GREG #20202028 !! ``\vs\vs\vs(''
_rpren GREG #20202029 !! ``\vs\vs\vs)''
_tag GREG #80000000 !! Set MSB of a tetra
_untag GREG #7FFFFFFF !! Turn off the MSB of a tetra
_nlnull GREG #0a000000 !! Newline and a zero byte
ip IS $2 !! Pointer for input permutation
op IS $3 !! Pointer for output permutation
p IS $4 !! A symbol of the permutation
size IS $5 !! The size of the input permutation
start IS $6 !! The variables of the algorithm
current IS $7
LOC Data_Segment
GREG @
NoArg BYTE "Missing argument: file with input permutation expected",#a,0
NoFile BYTE "Can't open the file given in first argument.",#a,0
BUFSIZE IS 80+1+1 !! 80 Bytes plus newline can be read
INP IS 3 !! Handle for input file
ArgIn OCTA 0,TextRead !! First octabyte is later filled with argument
ArgRead OCTA 0,BUFSIZE !! Ditto
Perm GREG @ !! Location to store the permutations
LOC #100
Error1 LDA t,NoArg
JMP PrtAns
Error2 LDA t,NoFile
JMP PrtAns
Main SET tt,Perm
LDO t,$1,8
BZ t,Error1 !! No argument: error
STO t,ArgIn !! Otherwise use the argument.
0H LDA t,ArgIn !! Open input file.
TRAP 0,Fopen,INP
BN t,Error2 !! $-1$ indicates an error.
ReadLine STO tt,ArgRead !! Read the input.
LDA t,ArgRead
TRAP 0,Fgets,INP
BN t,EndRead
ADD tt,tt,t
SUB t,tt,t !! Output the input line.
TRAP 0,Fputs,StdOut
SUB tt,tt,1 !! Remove the newline byte.
JMP ReadLine
EndRead TRAP 0,Fclose,INP !! Close the input file.
SUB op,tt,Perm !1! Start output after the equal sign.
SUB size,op,4 !1!
SET ip,0 !1! $\mm ip\gets0$.
A1 LDT p,Perm,ip !A! \step A1. First pass. Load symbol into \m p.
CMP t,p,_lpren !A! Is \m p a left parenthesis?
PBNZ t,0F !A!\bad B\bad No, jump to test for right parenthesis.
OR p,p,_tag !B! Yes, tag the left parenthesis.
STTU p,Perm,ip !B!
ADD ip,ip,4 !B!
LDT p,Perm,ip !B! Get the next symbol and
OR tt,p,_tag !B! \quad add a tag to it.
0H CMP t,p,_rpren !C! Is it a right parenthesis?
PBNZ t,0F !C!\bad D\bad No, test if the end is reached.
STTU tt,Perm,ip !D! Yes, replace this parenthesis.
0H ADD ip,ip,4 !C!
CMP t,ip,size !C!
PBNZ t,A1 !C!\bad 1\bad
JMP A2 !1!
A6 STT _rpren,Perm,op !R! \step A6. Close. Output a right parenthesis.
ADD op,op,4 !R!
SUB tt,op,3*4 !R! Check for singleton cycle.
LDT p,Perm,tt !R!
CMP t,p,_lpren !R! Appears a `(' two tetras earlier?
CSZ op,t,tt !R! Reset \mm op if yes.
A2 SET ip,0 !E! \step A2. Open. Set \mm ip to the first element.
0H ADD ip,ip,4 !F! The leftist parenthesis is skipped.
CMP t,ip,size !F!
BZ t,Done !F!\bad 1\bad Exit at the end of input.
LDT p,Perm,ip !G! Search untagged symbol.
PBN p,0B !G!\bad H\bad Loop if tagged.
SET start,p !H! Set \mb{start}.
STT _lpren,Perm,op !H! Output a left parenthesis.
ADD op,op,4 !H!
STT p,Perm,op !H! Output the element
ADD op,op,4 !H!
OR p,p,_tag !H! \quad and tag it.
STTU p,Perm,ip !H!
A3 ADD ip,ip,4 !J! \step A3. Set \mb{CURRENT}.
LDT p,Perm,ip !J! Get next element and
AND current,p,_untag !J! \quad store it without a tag in \mb{current}.
STT current,Perm,size !J! Store it as sentinel.
A4 ADD ip,ip,4 !K! \step A4. Scan formula.
LDT p,Perm,ip !K! Load next symbol
AND p,p,_untag !K! \quad remove possible tag
CMP t,p,current !K! \quad and compare it to \mb{current}.
PBNZ t,A4 !K!\bad L\bad
CMP t,ip,size !L!
BNN t,A5 !L!\bad P\bad Branch if sentinel is reached.
OR p,p,_tag !O! Element \m p equals \mb{current} so tag it.
STTU p,Perm,ip !O!
JMP A3 !O!
A5 CMP t,current,start !P! \steq A5. $\mb{CURRENT} = \mb{START}$?
BZ t,A6 !P!\bad R\bad Yes, close the output cycle.
STT current,Perm,op !Q! No, output \mb{current}.
ADD op,op,4 !Q!
SET ip,0 !Q! Start in A4 from the left.
JMP A4 !Q!
Done ADD size,size,4
LDA t,Perm,size !! Start output after the equal sign.
CMP tt,op,size !! Test if output is empty.
BNZ tt,1F
STT _lpren,t,0 !! Yes, so output the identity permutation.
STT _rpren,t,4
ADD op,size,8
1H STT _nlnull,Perm,op !! Add newline and a null byte to output string.
PrtAns TRAP 0,Fputs,StdOut
TRAP 0,Halt,0 !! \eop
!!\endwAoA\bye