1:- module(canny_endian, [byte//1, big_endian//2, little_endian//2]).

Big- and little-endian grammars

The endian predicates unify big- and little-endian words, longs and long words with lists of octets by applying shifts and masks to correctly align integer values with their endian-specific octet positions. They utilise integer-relational finite domain CLP(FD) predicates in order to implement forward and reverse translation between octets and integers.

Use of CLP allows the DCG clauses to express the integer relations between octets and their integer interpretations implicitly. The constraints simultaneously define a byte in terms of an octet and vice versa.

/

   19:- use_module(library(clpfd)).   20
   21%!  byte(?Byte:integer)// is semidet.
   22%
   23%   Parses or generates an octet for Byte. Bytes are eight bits wide and
   24%   unify with octets between 0  and   255  inclusive.  Fails for octets
   25%   falling outside this valid range.
   26%
   27%   @arg Byte value of octet.
   28
   29byte(Byte) -->
   30    { Byte #= Octet /\ 0xff,      Octet #= Byte /\ 0xff      % Unifies a byte with an octet and vice versa. Succeeds only when the      % octet fits within eight bits and so also the byte. Octets outside the      % range 0 through 255 inclusive fail to match the byte size requirements.    },    [Octet].
 big_endian(?Width:integer, ?Word:integer)// is semidet
Unifies big-endian words with octets.

Example as follows: four octets to one big-endian 32-bit word.

?- phrase(big_endian(32, A), [4, 3, 2, 1]),
   format('~16r~n', [A]).
4030201
   48big_endian(16, Word16) -->
   49    { high_low(16, High, Low, Word16)
   50    },
   51    byte(High),
   52    byte(Low).
   53big_endian(32, Word32) -->
   54    { high_low(32, High, Low, Word32)
   55    },
   56    big_endian(16, High),
   57    big_endian(16, Low).
   58big_endian(64, Word64) -->
   59    { high_low(64, High, Low, Word64)
   60    },
   61    big_endian(32, High),
   62    big_endian(32, Low).
 little_endian(?Width:integer, ?Word:integer)// is semidet
Unifies little-endian words with octet stream.
   68little_endian(16, Word16) -->
   69    { high_low(16, High, Low, Word16)
   70    },
   71    byte(Low),
   72    byte(High).
   73little_endian(32, Word32) -->
   74    { high_low(32, High, Low, Word32)
   75    },
   76    little_endian(16, Low),
   77    little_endian(16, High).
   78little_endian(64, Word64) -->
   79    { high_low(64, High, Low, Word64)
   80    },
   81    little_endian(32, Low),
   82    little_endian(32, High).
   83
   84%!  high_low(?Width:integer,
   85%!           ?High:integer,
   86%!           ?Low:integer,
   87%!           ?Word:integer) is semidet.
   88%
   89%   Unifies High and Low with Word over Width bits.
   90%
   91%   Matches High and Low with Word depending on endian-order. Big-endian
   92%   words map to octets where  the   most-significant  precede the least
   93%   significant.  Little-endian  words   reverse    this   ordering.  By
   94%   convention, many network-oriented octet   streams  prefer big-endian
   95%   because it reads more naturally when you dump the octets in progress
   96%   order.
   97%
   98%   @arg Width of Word: 16, 32 or 64 bits.
   99%   @arg High half of Word.
  100%   @arg Low half of Word.
  101%   @arg Word value of one or more octets.
  102
  103high_low(16, High, Low, Word16) :-
  104    Low #= Word16 /\ 0xff,
  105    High #= (Word16 // (1 << 8)) /\ 0xff,
  106    Word16 #= (High << 8) \/ Low.
  107high_low(32, High, Low, Word32) :-
  108    Low #= Word32 /\ 0xffff,
  109    High #= (Word32 // (1 << 16)) /\ 0xffff,
  110    Word32 #= (High << 16) \/ Low.
  111high_low(64, High, Low, Word64) :-
  112    Low