!
! SPECIAL SERVICE ROUTINES FOR ALGOL(J)    PDS 14.07.77
!
%SYSTEMINTEGERFN JREADOINT(%LONGREAL C0)
!***********************************************************************
!*    CHOP C0 DOWN TO 32 BITS (SHORT REAL)  AND RETURN AS INTEGER      *
!***********************************************************************
      *LSS_C0; *EXIT_-64
%END
%SYSTEMLONGREALFN JINTDOREA(%INTEGER C0)
!***********************************************************************
!*    C0 IS REALLY A SHORT REAL: EXPAND TO 64 BITS AND RETURN          *
!***********************************************************************
      *LSS_0; *LUH_C0; *EXIT_-64
%END
%SYSTEMINTEGERFN JSPOJILIP(%INTEGER IL,IP)
!***********************************************************************
!*    PACK IL & IP INTO LEFT & RIGHT 16 BITS OF A 32 BIT INTEGER       *
!***********************************************************************
      *LSS_IP; *AND_X'FFFF'
      *SLSS_IL; *USH_16
      *OR_%TOS; *EXIT_-64
%END
%SYSTEMINTEGERFN JSETILEVE(%INTEGER KAM,IL)
!***********************************************************************
!*    SET IL AS LEFT 16 BITS OF KAM-- RIGHT 16 BITS UNCHANGED          *
!***********************************************************************
      *LSS_KAM; *AND_X'FFFF'
      *SLSS_IL; *USH_16
      *OR_%TOS; *EXIT_-64
%END
%SYSTEMINTEGERFN JSETIPRAV(%INTEGER KAM,IP)
!***********************************************************************
!*    STORE IP AS RIGHTHAND 16 BITS OF KAM--LEFT 16 BITS UNCHANGED     *
!***********************************************************************
      *LSS_IP; *AND_X'FFFF'
      *SLSS_KAM; *AND_X'FFFF0000'
      *OR_%TOS; *EXIT_-64
%END
%SYSTEMINTEGERFN JEXTILEVE(%INTEGER KDE)
!***********************************************************************
!*    EXTRACT LEFT 16 BIT INTEGER FROM PARAMETER & STRETCH TO 32 BITS  *
!***********************************************************************
      *LSS_KDE; *ISH_-16; *EXIT_-64
%END
%SYSTEMINTEGERFN JETIRPRAV(%INTEGER KDE)
!***********************************************************************
!*    EXTRACT RIGHT 16 BITS FROM PARAMETER & STRETCH TO 32 BITS        *
!***********************************************************************
      *LSS_KDE; *USH_16; *ISH_-16; *EXIT_-64
%END
%SYSTEMINTEGERFN JCISPOLE(%LONGREAL KDE)
!***********************************************************************
!*    EXTRACT BYTES 5&6 FROM KDE AND RETURN AS UNSIGNED INTEGER        *
!***********************************************************************
      *LSS_KDE+4; *USH_-8
      *AND_X'FFFF'; *EXIT_-64
%END
%SYSTEMINTEGERFN JCISRADEK(%LONGREAL KDE)
!***********************************************************************
!*    EXTRACT 7TH(FINAL) BYTE OF KDE & RETURN AS UNSIGNED INTEGER      *
!***********************************************************************
      *LSS_KDE+4; *AND_X'FF'; *EXIT_-64
%END
%SYSTEMLONGREALFN JSIIDOREA(%INTEGER LEV,PRA)
!***********************************************************************
!*    CONSTRUCT A LONGREAL OUT OF TWO SPECIFIED HALVES                 *
!***********************************************************************
      *LSS_PRA; *LUH_LEV; *EXIT_-64
%END
%SYSTEMLONGREALFN JSETILREA(%LONGREAL KAM,%INTEGER IL)
!***********************************************************************
!*    STORE IL INTO LEFT 32 BITS OF KAM & RETURN AS REAL               *
!***********************************************************************
      *LSS_KAM+4; *LUH_IL; *EXIT_-64
%END
%SYSTEMLONGREALFN JSETIPREA(%LONGREAL KAM,%INTEGER IP)
!***********************************************************************
!*    STORE IP INTO RIGHT 32 BITS OF KAM AND RETURN AS LONGREAL        *
!***********************************************************************
      *LSS_IP; *LUH_KAM; *EXIT_-64
%END
%SYSTEMINTEGERFN JEXILZREA(%LONGREAL KDE)
!***********************************************************************
!*    RETURN LEFTHAND 32 BITS OF KDE AS AN INTEGER                     *
!***********************************************************************
      *LSS_KDE; *EXIT_-64
%END
%SYSTEMINTEGERFN JEXIPZREA(%LONGREAL KDE)
!***********************************************************************
!*    RETURN RIGHT HAND 32 BITS OF KDE AS AN INTEGER                   *
!***********************************************************************
      *LSS_KDE+4; *EXIT_-64
%END
%SYSTEMLONGREALFN JSPOJRLRP(%LONGREAL RL,RP)
!***********************************************************************
!*    SHORTEN PARAMS TO 32 BITS AND PACK INTO ONE 64BIT REAL           *
!***********************************************************************
      *LSS_RP; *LUH_RL; *EXIT_-64
%END
%SYSTEMLONGREALFN JSETRLEVE(%LONGREAL KAM,RL)
!***********************************************************************
!*    OVERWRITE LEFT 32 BITS OF KAM WITH LEFT 32 BITS OF RL            *
!***********************************************************************
      *LSS_KAM+4; *LUH_RL; *EXIT_-64
%END
%SYSTEMLONGREALFN JSETRPRAV(%LONGREAL KAM,RP)
!***********************************************************************
!*    OVERWRITE RIHGT 32 BITS OF KAM WITH LEFT 32 BITS OF RP)          *
!***********************************************************************
      *LSS_RP; *LUH_KAM; *EXIT_-64
%END
%SYSTEMLONGREALFN JEXTRLEVE(%LONGREAL KDE)
!***********************************************************************
!*    EXTRACT THE SHORT REAL IN LH 32 BITS OF KDE & EXPAND TO 64 BITS  *
!***********************************************************************
      *LSS_0; *LUH_KDE; *EXIT_-64
%END
%SYSTEMLONGREALFN JEXTRPRAV(%LONGREAL KDE)
!***********************************************************************
!*    EXTRACT THE SHORT REAL IN RH 32 BITS OF KDE & EXPAND TO 64 BITS  *
!***********************************************************************
      *LSS_0; *LUH_KDE+4; *EXIT_-64
%END
%ENDOFFILE