------------------------------------------------------------------------------- |-- Module : Data.SBV.Examples.BitPrecise.Legato-- Copyright : (c) Levent Erkok-- License : BSD3-- Maintainer : erkokl@gmail.com-- Stability : experimental---- An encoding and correctness proof of Legato's multiplier in Haskell. Bill Legato came-- up with an interesting way to multiply two 8-bit numbers on Mostek, as described here:-- <http://www.cs.utexas.edu/~moore/acl2/workshop-2004/contrib/legato/Weakest-Preconditions-Report.pdf>---- Here's Legato's algorithm, as coded in Mostek assembly:---- @-- step1 : LDX #8 ; load X immediate with the integer 8 -- step2 : LDA #0 ; load A immediate with the integer 0 -- step3 : LOOP ROR F1 ; rotate F1 right circular through C -- step4 : BCC ZCOEF ; branch to ZCOEF if C = 0 -- step5 : CLC ; set C to 0 -- step6 : ADC F2 ; set A to A+F2+C and C to the carry -- step7 : ZCOEF ROR A ; rotate A right circular through C -- step8 : ROR LOW ; rotate LOW right circular through C -- step9 : DEX ; set X to X-1 -- step10: BNE LOOP ; branch to LOOP if Z = 0 -- @---- This program came to be known as the Legato's challenge in the community, where-- the challenge was to prove that it indeed does perform multiplication. This file-- formalizes the Mostek architecture in Haskell and proves that Legato's algorithm-- is indeed correct.-----------------------------------------------------------------------------moduleData.SBV.Examples.BitPrecise.LegatowhereimportData.Array(Array,Ix(..),(!),(//),array)importData.SBV-------------------------------------------------------------------- * Mostek architecture-------------------------------------------------------------------- | The memory is addressed by 32-bit words.typeAddress=SWord32-- | We model only two registers of Mostek that is used in the above algorithm, can add more.dataRegister=RegX|RegAderiving(Eq,Ord,Ix,Bounded,Enum)-- | The carry flag ('FlagC') and the zero flag ('FlagZ')dataFlag=FlagC|FlagZderiving(Eq,Ord,Ix,Bounded,Enum)-- | Mostek was an 8-bit machine.typeValue=SWord8-- | Convenient synonym for symbolic machine bits.typeBit=SBool-- | Register banktypeRegisters=ArrayRegisterValue-- | Flag banktypeFlags=ArrayFlagBit-- | The memory maps 32-bit words to 8-bit words. (The 'Model' data-type is-- defined later, depending on the verification model used.)typeMemory=ModelWord32Word8-- Model defined later-- | Abstraction of the machine: The CPU consists of memory, registers, and flags.-- Unlike traditional hardware, we assume the program is stored in some other memory area that-- we need not model. (No self modifying programs!)dataMostek=Mostek{memory::Memory,registers::Registers,flags::Flags}-- | Given a machine state, compute a value out of ittypeExtracta=Mostek->a-- | Programs are essentially state transformers (on the machine state)typeProgram=Mostek->MostekinstanceMergeableMostekwheresymbolicMergebm1m2=Mostek{memory=symbolicMergeb(memorym1)(memorym2),registers=symbolicMergeb(registersm1)(registersm2),flags=symbolicMergeb(flagsm1)(flagsm2)}-------------------------------------------------------------------- * Low-level operations-------------------------------------------------------------------- | Get the value of a given registergetReg::Register->ExtractValuegetRegrm=registersm!r-- | Set the value of a given registersetReg::Register->Value->ProgramsetRegrvm=m{registers=registersm//[(r,v)]}-- | Get the value of a flaggetFlag::Flag->ExtractBitgetFlagfm=flagsm!f-- | Set the value of a flagsetFlag::Flag->Bit->ProgramsetFlagfbm=m{flags=flagsm//[(f,b)]}-- | Read memorypeek::Address->ExtractValuepeekam=readArray(memorym)a-- | Write to memorypoke::Address->Value->Programpokeavm=m{memory=writeArray(memorym)av}-- | Checking overflow. In Legato's multipler the @ADC@ instruction-- needs to see if the expression x + y + c overflowed, as checked-- by this function. Note that we verify the correctness of this check-- separately below in `checkOverflowCorrect`.checkOverflow::SWord8->SWord8->SBool->SBoolcheckOverflowxyc=s.<x|||s.<y|||s'.<swheres=x+ys'=s+itec10-- | Correctness theorem for our `checkOverflow` implementation.---- We have:---- >>> checkOverflowCorrect-- Q.E.D.checkOverflowCorrect::IOThmResultcheckOverflowCorrect=checkOverflow===overflowwhere-- Reference spec for overflow. We do the addition-- using 16 bits and check that it's larger than 255overflow::SWord8->SWord8->SBool->SBooloverflowxyc=(0#x)+(0#y)+itec10.>255-------------------------------------------------------------------- * Instruction set-------------------------------------------------------------------- | An instruction is modeled as a 'Program' transformer. We model-- mostek programs in direct continuation passing style.typeInstruction=Program->Program-- | LDX: Set register @X@ to value @v@ldx::Value->Instructionldxvk=k.setRegRegXv-- | LDA: Set register @A@ to value @v@lda::Value->Instructionldavk=k.setRegRegAv-- | CLC: Clear the carry flagclc::Instructionclck=k.setFlagFlagCfalse-- | ROR, memory version: Rotate the value at memory location @a@-- to the right by 1 bit, using the carry flag as a transfer position.-- That is, the final bit of the memory location becomes the new carry-- and the carry moves over to the first bit. This very instruction-- is one of the reasons why Legato's multiplier is quite hard to understand-- and is typically presented as a verification challenge.rorM::Address->InstructionrorMakm=k.setFlagFlagCc'.pokeav'$mwherev=peekamc=getFlagFlagCmv'=setBitTo(v`rotateR`1)7cc'=sbvTestBitv0-- | ROR, register version: Same as 'rorM', except through register @r@.rorR::Register->InstructionrorRrkm=k.setFlagFlagCc'.setRegrv'$mwherev=getRegrmc=getFlagFlagCmv'=setBitTo(v`rotateR`1)7cc'=sbvTestBitv0-- | BCC: branch to label @l@ if the carry flag is falsebcc::Program->Instructionbcclkm=ite(c.==false)(lm)(km)wherec=getFlagFlagCm-- | ADC: Increment the value of register @A@ by the value of memory contents-- at address @a@, using the carry-bit as the carry-in for the addition.adc::Address->Instructionadcakm=k.setFlagFlagZ(v'.==0).setFlagFlagCc'.setRegRegAv'$mwherev=peekamra=getRegRegAmc=getFlagFlagCmv'=v+ra+itec10c'=checkOverflowvrac-- | DEX: Decrement the value of register @X@dex::Instructiondexkm=k.setFlagFlagZ(x.==0).setRegRegXx$mwherex=getRegRegXm-1-- | BNE: Branch if the zero-flag is falsebne::Program->Instructionbnelkm=ite(z.==false)(lm)(km)wherez=getFlagFlagZm-- | The 'end' combinator "stops" our program, providing the final continuation-- that does nothing.end::Programend=id-------------------------------------------------------------------- * Legato's algorithm in Haskell/SBV-------------------------------------------------------------------- | Parameterized by the addresses of locations of the factors (@F1@ and @F2@),-- the following program multiplies them, storing the low-byte of the result-- in the memory location @lowAddr@, and the high-byte in register @A@. The-- implementation is a direct transliteration of Legato's algorithm given-- at the top, using our notation.legato::Address->Address->Address->Programlegatof1Addrf2AddrlowAddr=startwherestart=ldx8$lda0$looploop=rorMf1Addr$bcczeroCoef$clc$adcf2Addr$zeroCoefzeroCoef=rorRRegA$rorMlowAddr$dex$bneloop$end-------------------------------------------------------------------- * Verification interface-------------------------------------------------------------------- | Given address/value pairs for F1 and F2, and the location of where the low-byte-- of the result should go, @runLegato@ takes an arbitrary machine state @m@ and-- returns the high and low bytes of the multiplication.runLegato::(Address,Value)->(Address,Value)->Address->Mostek->(Value,Value)runLegato(f1Addr,f1Val)(f2Addr,f2Val)loAddrm=(getRegRegAmFinal,peekloAddrmFinal)wherem0=pokef1Addrf1Val$pokef2Addrf2ValmmFinal=legatof1Addrf2AddrloAddrm0-- | Helper synonym for capturing relevant bits of MostektypeInitVals=(Value-- Content of Register X,Value-- Content of Register A,Value-- Initial contents of memory,Bit-- Value of FlagC,Bit-- Value of FlagZ)-- | Create an instance of the Mostek machine, initialized by the memory and the relevant-- values of the registers and the flagsinitMachine::Memory->InitVals->MostekinitMachinemem(rx,ra,mc,fc,fz)=Mostek{memory=resetArraymemmc,registers=array(minBound,maxBound)[(RegX,rx),(RegA,ra)],flags=array(minBound,maxBound)[(FlagC,fc),(FlagZ,fz)]}-- | The correctness theorem. For all possible memory configurations, the factors (@x@ and @y@ below), the location-- of the low-byte result and the initial-values of registers and the flags, this function will return True only if-- running Legato's algorithm does indeed compute the product of @x@ and @y@ correctly.legatoIsCorrect::Memory->(Address,Value)->(Address,Value)->Address->InitVals->SBoollegatoIsCorrectmem(addrX,x)(addrY,y)addrLowinitVals=allDifferent[addrX,addrY,addrLow]-- note the conditional: addresses must be distinct!==>result.==expectedwhere(hi,lo)=runLegato(addrX,x)(addrY,y)addrLow(initMachinememinitVals)-- NB. perform the comparison over 16 bit values to avoid overflow!-- If Value changes to be something else, modify this accordingly.result,expected::SWord16result=256*(0#hi)+(0#lo)expected=(0#x)*(0#y)-------------------------------------------------------------------- * Verification-------------------------------------------------------------------- | Choose the appropriate array model to be used for modeling the memory. (See 'Memory'.)-- The 'SFunArray' is the function based model. 'SArray' is the SMT-Lib array's based model.typeModel=SFunArray-- type Model = SArray-- | The correctness theorem.-- On a decent MacBook Pro, this proof takes about 3 minutes with the 'SFunArray' memory model-- and about 30 minutes with the 'SArray' model, using yices as the SMT solvercorrectnessTheorem::IOThmResultcorrectnessTheorem=proveWithyices{timing=True}$forAll["mem","addrX","x","addrY","y","addrLow","regX","regA","memVals","flagC","flagZ"]legatoIsCorrect-------------------------------------------------------------------- * C Code generation-------------------------------------------------------------------- | Generate a C program that implements Legato's algorithm automatically.legatoInC::IO()legatoInC=compileToCNothing"runLegato"$dox<-cgInput"x"y<-cgInput"y"let(hi,lo)=runLegato(0,x)(1,y)2(initMachine(mkSFunArray(const0))(0,0,0,false,false))cgOutput"hi"hicgOutput"lo"lo{-# ANN legato "HLint: ignore Redundant $" #-}{-# ANN module "HLint: ignore Reduce duplication" #-}