[INHERIT ('SYS$LIBRARY:STARLET.PEN')]
MODULE Shift_Command;

{ Routines for performing the SHIFT command }

(****************** Declare External Variables and Constants ******************)

%INCLUDE 'HEX$DIRECTORY:HEXGLOB.INC/NOLIST'

(********************* External RTL Routine Declarations **********************)

%INCLUDE 'HEX$DIRECTORY:LIB.INC/NOLIST'

(****************** External Homemade Routine Declarations ********************)

[EXTERNAL] PROCEDURE Check_Extra_Chars; EXTERN;

(******************************************************************************)
(*									      *)
(*	 		    Function Shift_Right			      *)
(*									      *)
(******************************************************************************)

FUNCTION Shift_Right(Byte_1: Unsigned_Byte; Byte_2: Unsigned_Byte): Unsigned_Byte;

{ This function returns a byte containing the value of Byte_1 shifted right
  Byte_2 times. If the global variable SIGNED is set the sign bit is replicated
  in bit 7. }

VAR
	I		: Unsigned_Byte;

BEGIN

  IF (Byte_2 > 7) THEN Byte_2 := 8;

  IF (Byte_2 <> 0) THEN
    FOR I := 1 TO Byte_2 DO
      BEGIN
	IF (Signed) AND (Byte_1 >= 128) THEN
	  Byte_1 := 128 + (Byte_1 DIV 2)
	ELSE
	  Byte_1 := Byte_1 DIV 2;
      END;

  Shift_Right := Byte_1;

END;


(******************************************************************************)
(*									      *)
(*	 		    Function Shift_Left				      *)
(*									      *)
(******************************************************************************)

FUNCTION Shift_Left(Byte_1: Unsigned_Byte; Byte_2: Unsigned_Byte): Unsigned_Byte;

{ This function returns a byte containing the value of Byte_1 shifted left
  Byte_2 times. }

VAR
	I		: Unsigned_Byte;

BEGIN

  IF (Byte_2 > 7) THEN Byte_2 := 8;

  IF (Byte_2 <> 0) THEN
    FOR I := 1 TO Byte_2 DO
      Byte_1 := (Byte_1 * 2);

  Shift_Left := Byte_1;

END;


(******************************************************************************)
(*									      *)
(*			    Procedure Do_Shift				      *)
(*									      *)
(******************************************************************************)

[GLOBAL] FUNCTION Do_Shift: INTEGER;

{ This function shifts the designated range of virtual memory in the designated
  direction by the specified amount. }

VAR
	I		: UNSIGNED;
	VM_Index	: INTEGER;
	Temp		: INTEGER;

BEGIN

  I := From;
  WHILE (I <= Thru) DO
    BEGIN
      VM_Index := (I - Offset)::INTEGER;
      IF (Direction = Right) THEN
	VM[VM_Index] := Shift_Right(VM[VM_Index],With_Param)
      ELSE
	VM[VM_Index] := Shift_Left(VM[VM_Index],With_Param);
      I := I + Step_Param;
    END;
  Check_Extra_Chars;
  Do_Shift := SS$_NORMAL;

END;

(******************************************************************************)

END. { module shift }