#PROGRAM       /GFUNPACK8(15AM,22AM,DBM,EBM)
#PAGE

#INCLUDE       STACK(/DEFS)

#PROGRAM

#              Unpack 8 bit bytes from a buffer

#              gf unpack8 (int *from, int pos, int *to, int len)

#SET           ARGS=0

#DEFINE        ARGFROM=ARGS
#SET           ARGS=ARGS+1

#DEFINE        ARGPOS=ARGS
#SET           ARGS=ARGS+1

#DEFINE        ARGTO=ARGS
#SET           ARGS=ARGS+1

#DEFINE        ARGLEN=ARGS
#SET           ARGS=ARGS+1

#              Stack frame

#SET           STFRAME=SXFRAME

#              First the arguments:

#DEFINE        STFROM=SXPAR1  
#SET           STFRAME=STFRAME+1

#DEFINE        STPOS=SXPAR2
#SET           STFRAME=STFRAME+1

#DEFINE        STTO=SXPAR3
#SET           STFRAME=STFRAME+1

#DEFINE        STLEN=SXPAR4
#SET           STFRAME=STFRAME+1

#              Now local vars:

#              Pick up call by value parameters

      STACK 2
      OBEY     ARGLEN(1)
      LDX   0  0(3) 
      STO   0  STLEN(2)

      OBEY     ARGPOS(1) 
      LDX   0  0(3)
      STO   0  STPOS(2)

#              Pick up call by name parameeters

      OBEY     ARGFROM(1)
      ARRAY 3                        [ it's array elem or name
      STACK 2                        [ restore stack top
      STO   3  STFROM(2)

      OBEY     ARGTO(1)
      ARRAY 3                        [ array elem or name
      STACK 2                        [ restore stack top
      STO   3  STTO(2)

      ADN   1  ARGS

#              Now Pascal entry point

#CUE           GPUNPACK8

      BEGIN 2  3,1,STFRAME

      LDX   5  STLEN(2)
      SBNC  5  1
      BCS      BYE                   [ do nothing if length 0

      LDX   1  STFROM(2)
      LDX   3  STTO(2)

      LDX   7  STPOS(2)              [ get input pos
      BZE   7  WORD                  [ optimise frequent case

      LDN   0  3
      DVS   6  0                     [ x7 = pos/3, x6 = remainder

      ADX   1  7                     [ add word offset to input ptr
      BZE   6  WORD                  [ jump if want leftmost byte

      LDX   0  0(1)                  [ get word

      LDN   4  3
      SBN   4  6                     [ # bytes in 1st word (2 or 1)

      SBNC  6  2                     [ x6 is 1 (middle) or 2 (right)
      BCS      *+2
      SLL   0  8                     [ want bottom byte
      SLL   0  8                     [ want middle byte
      BRN      BYTE

WORD  LDX   0  0(1)                  [ get word of 3 bytes
      LDN   4  3

BYTE  SLC   0  8                     [ get MSB to bottom
      LDN   6  255
      ANDX  6  0                     [ get byte to X6
      STO   6  0(3)
      SBNC  5  1                     [ Done?
      BCS      BYE
      ADN   3  1                     [ bump output pointer
      BCT   4  BYTE                  [ loop for bytes in word

      ADN   1  1                     [ bump input pointer
      BRN      WORD
 
BYE   END   2  1,0

#END
#FINISH