REM fec2.bas Jim FitzSimons 24 May, 2000
FUNCTION PBMAIN
CLS
PRINT "number of bits in the code? ";
LINE INPUT temp$
bi& = VAL(temp$) 'Convert number of bits to a 32 bit integer.
PRINT "maximum number of bits in sequence? ";
LINE INPUT temp$
bis% = VAL(temp$) + 1'Convert number of bits.
bis1% = (bis% - 1) \ 2 + 1
b0$ = STRING$(bis%,"0")
b1$ = STRING$(bis%,"1")
b2$ = STRING$(bis1%,"0")
b3$ = STRING$(bis1%,"1")
PRINT "Do you want instant clock Yes/No? ";
LINE INPUT temp$
instant% = UCASE$(LEFT$(temp$,1))<>"N"
PRINT "number of errors to correct? ";
LINE INPUT temp$
fec% = VAL(temp$)
n& = 2 ^ bi& 'Calculate the total number of codes.
m&& = n& - 1 'This is the mask for the 64 bit shift register.
transform$=STR$(1113190842)
PRINT "transformation to change the starting code"
PRINT "Press Enter for default? ";transform$;" ";
LINE INPUT temp$
IF temp$ = "" THEN
   temp$ = transform$
END IF
trans& = VAL(temp$)
IF trans& < 0& THEN
   FOR i& = 1& TO -trans&
      tt& = RND(0,n&)
   NEXT i&
   trans& = tt&
END IF
'This the transformation to give code a different starting point.
mm& = trans& AND m&&
PRINT "transformation is ";BIN$(mm&,bi&)
DIM a?(n&-1) 'This is a 8 bit flag for valid codes.
'Find all numbers that have more 1's than allowed.
count& = 0
fec2% = fec% * 2
IF fec% > 0 THEN
   FOR i& = 1 TO n& - 1
      dif% = 0
      kk& = 1
      FOR l& = 1 TO bi&
         IF (i& AND kk&) <> 0 THEN
            INCR dif%
            IF dif% > fec2% THEN EXIT FOR
         END IF
         SHIFT LEFT kk&, 1
      NEXT l&
      IF dif% <= fec2% THEN
         a?(i&) = 1 'Set codes as 1=valid.
         INCR count&
      END IF
   NEXT i&
   DIM aa&(count& - 1) 'Select valid codes.
   k&=0&
   FOR i& = 0 TO n& - 1
      IF a?(i&) <> 0 THEN
         aa&(k&) = i&
         INCR k&
         a?(i&) = 0
      END IF
   NEXT i&
END IF
'Randomize the bits.
DIM b%(bi&-1),bb%(bi&-1),bbb&(bi&-1) 'This is the bit location and inverse.
k& = 1
FOR i& = 0 TO bi& - 1
   bb%(i&)=-1
NEXT i&
FOR i& = 0 TO bi& - 1
   bbb&(i&)=k&
   SHIFT LEFT k&,1
   DO
      ri% = RND(0&,bi&-1)
      IF bb%(ri%)=-1 THEN
         b%(i&)=ri%
         bb%(ri%)=i&
         EXIT DO
      END IF
   LOOP
NEXT i&
'Find all numbers that have more 1's or 0's than allowed.
FOR i& = 0 TO n& - 1
   ii&=0
   FOR l&=0 TO bi&-1
      IF (i& AND bbb&(l&))<>0 THEN
         ii&=ii&+bbb&(b%(l&))
      END IF
   NEXT l&
   ii& = ii& XOR mm&
   aaa$ = BIN$(ii&,bi&)
   la$ = LEFT$(aaa$,bis1%)
   ra$ = RIGHT$(aaa$,bis1%)
   IF (INSTR(aaa$,b0$) = 0) AND (INSTR(aaa$,b1$) = 0) AND (la$ <> b2$) AND (ra$ <> b2$) AND (la$ <> b3$) AND (ra$ <> b3$) THEN
      a?(i&) = 1 'Set codes as 1=valid.
   END IF
NEXT i&
FOR i& = 0 TO n& - 1 'Check each code.
   IF a?(i&) <> 0 THEN 'Skip invalid codes.
      ii&=0
      FOR l&=0 TO bi&-1
         IF (i& AND bbb&(l&))<>0 THEN
            ii&=ii&+bbb&(b%(l&))
         END IF
      NEXT l&
      ii& = ii& XOR mm&
      IF instant% <> 0 THEN
         FOR j& = 0 TO i& 'Compare with all valid codes.
            IF a?(j&) <> 0 THEN 'Skip invalid codes.
               'Put the code and a valid code in shift register.
               jj&=0
               FOR l&=0 TO bi&-1
                  IF (j& AND bbb&(l&))<>0 THEN
                     jj&=jj&+bbb&(b%(l&))
                  END IF
               NEXT l&
               jj& = jj& XOR mm&
               c&& = ii&
               SHIFT LEFT c&&,bi&
               c&& = c&& OR jj&
               FOR l& = 1 TO bi& - 1
                  SHIFT RIGHT c&&,1 'Try all shifted combinations.
                  k& = (m&& AND c&&) XOR mm&  'Mask off the shifted code.
                  kk&=0
                  FOR ll&=0 TO bi&-1
                     IF (k& AND bbb&(ll&))<>0 THEN
                        kk&=kk&+bbb&(bb%(ll&))
                     END IF
                  NEXT ll&
                  IF kk& >= i& THEN  'Do not delete valid codes.
                     a?(kk&) = 0     'Delete invalid code.
                  END IF
                  IF a?(i&) = 0 THEN EXIT FOR 'Current code is invalid.
               NEXT l&
               IF a?(i&) = 0 THEN EXIT FOR 'Current code is invalid.
               'Put the code and a valid code in shift register
               'in reversed order.
               c&& = jj&
               SHIFT LEFT c&&,bi&
               c&& = c&& OR ii&
               FOR l& = 1 TO bi& - 1
                  SHIFT RIGHT c&&,1 'Try all shifted combinations.
                  k& = (m&& AND c&&) XOR mm&  'Mask off the shifted code.
                  kk&=0
                  FOR ll&=0 TO bi&-1
                     IF (k& AND bbb&(ll&))<>0 THEN
                        kk&=kk&+bbb&(bb%(ll&))
                     END IF
                  NEXT ll&
                  IF kk& >= i& THEN  'Do not delete valid codes.
                     a?(k&) = 0     'Delete invalid code.
                  END IF
                  IF a?(i&) = 0 THEN EXIT FOR 'Current code is invalid.
               NEXT l&
               IF a?(i&) = 0 THEN EXIT FOR 'Current code is invalid.
            END IF
         NEXT j&
      END IF
      IF fec% > 0 THEN
         IF a?(i&)<> 0 THEN 'Skip if current code is invalid.
            'Set all codes to seperated by less than
            '2*fec% bit changes to invalid.
            FOR j& = 0 TO count& - 1
               k& = (ii& XOR aa&(j&)) XOR mm&
               kk&=0
               FOR ll&=0 TO bi&-1
                  IF (k& AND bbb&(ll&))<>0 THEN
                     kk&=kk&+bbb&(bb%(ll&))
                  END IF
               NEXT ll&
               a?(kk&) = 0
            NEXT j&
         END IF
      END IF
   END IF
NEXT i&
k& = 0 'Number of items on a line.
count& = 0 'Number of valid codes.
OPEN "fec2.out" FOR OUTPUT AS #1
OPEN "fec2.bin" FOR BINARY AS #2
FOR i& = 0 TO n& - 1
   IF a?(i&) <> 0 THEN 'Only print the valid codes.
      ii&=0
      FOR l&=0 TO bi&-1
         IF (i& AND bbb&(l&))<>0 THEN
            ii&=ii&+bbb&(b%(l&))
         END IF
      NEXT l&
      ii& = ii& XOR mm&
      E$ = BIN$(ii&,bi&)
      PRINT #1, E$; " ";
      PUT #2,,ii&
      INCR count& 'Count number of valid codes.
      INCR k&     'Count number of items on a line.
      IF k& = 4 THEN 'Maximum of 4 items on a line.
         PRINT #1, ""
         k& = 0
      END IF
   END IF
NEXT i&
CLOSE #2
lcount# = LOG(count&)/LOG(2)
PRINT #1,""
PRINT
PRINT #1,"These codes will correct ";fec%;" errors."
PRINT "These codes will correct ";fec%;" errors."
PRINT #1, "number of codes";count&;"number of bits";lcount#
PRINT "number of codes";count&;"number of bits";lcount#
CLOSE #1
IF fec% > 0 THEN
   PRINT "Do you want to verify code Yes/No? ";
   LINE INPUT temp$
   IF UCASE$(LEFT$(temp$,1))="Y" THEN
      REDIM aa&(count& - 1) 'Select valid codes.
      k&=0&
      FOR i& = 0 TO n& - 1
         IF a?(i&) <> 0 THEN
            ii&=0
            FOR l&=0 TO bi&-1
               IF (i& AND bbb&(l&))<>0 THEN
                  ii&=ii&+bbb&(b%(l&))
               END IF
            NEXT l&
            ii& = ii& XOR mm&
            aa&(k&) = ii&
            INCR k&
         END IF
      NEXT i&
      OPEN "error" FOR OUTPUT AS #1
      FOR i& = 0 TO n& - 1 'Check error correction.
         mindif% = bi&
         mindifj& = -1
         FOR j& = 0 TO count& - 1
            k& = i& XOR aa&(j&)
            dif% = 0
            kk& = 1
            FOR l& = 1 TO bi&
               IF (k& AND kk&) <> 0 THEN
                  INCR dif%
               END IF
               SHIFT LEFT kk&, 1
            NEXT l&
            IF dif% < mindif% THEN
               mindif% = dif%
               mindifj& = j&
            ELSEIF (dif% = mindif%) AND (mindif% < 2) THEN
               PRINT #1,BIN$(i&,bi&);mindif%;" ";BIN$(aa&(mindifj&),bi&)
               PRINT #1, "Error cannot be resolved."
               PRINT BIN$(i&,bi&);mindif%;" ";BIN$(aa&(mindifj&),bi&)
               PRINT "Error cannot be resolved."
               mindifj& = j&
               PRINT #1,BIN$(i&,bi&);mindif%;" ";BIN$(aa&(mindifj&),bi&)
               PRINT BIN$(i&,bi&);mindif%;" ";BIN$(aa&(mindifj&),bi&)
               dif% = -1
               EXIT FOR
            END IF
         NEXT j&
         IF dif% = -1 THEN EXIT FOR
      NEXT i&
      CLOSE #1
   END IF
END IF
END FUNCTION