\def\date{10 Dec 2011}\def\source{V1, p.\ 174}\def\author{Udo Wermuth}\input mmix =-5 !!\clearline{\tenbf Program B} ({\tenit Multiplication of permutations in cycle form\/})\smallskip\startnumbering MAXWDS IS 1200 !! Maximal size for table $T$ t IS $255 tt GREG 0 _lpren GREG #20202028 !! ``\vs\vs\vs('' _rpren GREG #20202029 !! ``\vs\vs\vs)'' _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 length of the input permutation x IS $6 !! An element of the names table z IS $7 !! The variables of the algorithm. i IS $8 j IS $9 n IS $10 !! The number of different elements 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 X GREG @ !! Location to store the different elements LOC @+MAXWDS T GREG @ !! Location to store table $T$ LOC @+MAXWDS 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. SET size,op !1! Remember the length of the permutation. SUB ip,size,8 !1! $\mm ip\gets\rb{last symbol of permutation}$. SET n,4 !1! $n\gets 1$, ready to store an element. Right SET z,0 !A! Prepare for step B2, set $Z\gets0$. B2 LDT p,Perm,ip !B! \step B2. Next element. SUB ip,ip,4 !B! CMP t,p,_rpren !B! Is it a right parenthesis? BZ t,Right !B!\bad B-D\bad CMP t,p,_lpren !D! Is it a left parenthesis? BZ t,B4 !D!\bad L\bad Search_p SET i,n !E! Prepare to search names table. 1H SUB i,i,4 !F! BNP i,New_x !F!\bad H\bad Branch if end of table is reached. LDT x,X,i !G! Get a known $x_i$. CMP t,p,x !G! Is it a match? PBNZ t,1B !G!\bad J-H\bad No, continue search. B3 LDT p,T,i !J! \step B3. Change $T[i]$. SET t,z !J! Save the value of $Z$. STT z,T,i !J! Exchange $Z$ with $T[i]$. SET z,p !J! PBNZ t,B2 !J!\bad K\bad Test former value of $Z$. SET j,i !K! $Z$ was zero, so $j\gets i$. JMP B2 !K! New_x STT p,X,n !H! Insert a new element in names table. STT n,T,n !H! Initialize $T[n]$. SET i,n !H! $i\gets n$. ADD n,n,4 !H! $n\gets n+1$. JMP B3 !H! Now continue with step B3. B4 STT z,T,j !L! \step B4. Change $T[j]$. PBP ip,B2 !L!\bad 1\bad Output SET i,n !1! Output the permutation in cycle form. 0H STT _lpren,Perm,op !P! Start with a cycle. ADD op,op,4 !P! 1H SUB i,i,4 !Q! BNP i,Done !Q!\bad 1\bad Branch if table of names is processed. LDT x,X,i !T! Get an element name. BN x,1B !T!\bad Q-P\bad Branch if it already tagged. 2H STT x,Perm,op !R! Otherwise output the element. ADD op,op,4 !R! NEG x,0,x !R! Tag element STT x,X,i !R! \quad and store it. LDT i,T,i !R! Load the successor. LDT x,X,i !R! Load the name of that element. PBP x,2B !R!\bad S\bad Branch if name is not tagged. STT _rpren,Perm,op !S! Otherwise close cycle. ADD op,op,4 !S! SUB tt,op,3*4 !S! Check for singleton cycle. LDT p,Perm,tt !S! CMP t,p,_lpren !S! Appears a `(' two tetras earlier? CSZ op,t,tt !S! Reset \mm op if yes. JMP 0B !S! Done LDA t,Perm,size !! Start output after the equal sign. SUB op,op,4 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