*
* $Id: sbytpk.s,v 1.1.1.1 1996/02/15 17:54:50 mclareni Exp $
*
* $Log: sbytpk.s,v $
* Revision 1.1.1.1  1996/02/15 17:54:50  mclareni
* Kernlib
*
*
       MODULE M_SBYTPK
%
% CERN PROGLIB# M422    SBYTPK          .VERSION KERNNOR  1.01  800718
% ORIG.  H.OVERAS, CERN, 791213
%
% CALL SBYTPK(IM,XVM,J,MPAK)   SET PACKED BYTE
%                              MPAK=NBIT,INWORD
%
       EXPORT SBYTPK
       ROUTINE SBYTPK
       LIB SBYTPK
VBAS:  STACK FIXED
PAR:   W BLOCK 4
INWORD:W BLOCK 1
NBIT:  BY BLOCK 1
       ENDSTACK
SBYTPK:  ENTF VBAS
       W BYCONV IND(B.PAR+12),B.NBIT
       IF>GO L11
       BY SET1 B.NBIT
       W MOVE 32,B.INWORD
       GO L12
L11:   W4:=1
       W MOVE IND(B.PAR+12)(R4),B.INWORD
L12:   W4:=IND(B.PAR+8)
       W4-1
       IF<=GO L17
       W3 DIV4 R4,B.INWORD,R1
       BY3*B.NBIT
       GO L24
L17:   W1 CLR
       W3 CLR
L24:   W4:=IND(B.PAR)
       W4 PUTBF IND(B.PAR+4)(R1),BY3,B.NBIT
       RET
       ENDROUTINE
       ENDMODULE
#ifdef CERNLIB_TCGEN_SBYTPK
#undef CERNLIB_TCGEN_SBYTPK
#endif