\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