DataMuseum.dk

top - metrics - download

    Length: 3200 (0xc80)
    Types: TextFile
    Names: »VC-002.INC«

└─⟦398ae89d3⟧ Bits:30009789/_.ft.Ibm2.50007353.imd Mogens Pelles Zilog 80,000 / EOS projekt
    └─⟦this⟧ »VC-002.INC« 

TextFile

(******************************************************************************)
(*                                                                            *)
(*                                                                            *)
(*                  This file contains parts of the                           *)
(*                  source text for program VERSACON                          *)
(*                                                                            *)
(*        Copyright (C) 1985 by Lars G. Jakobsen and Metanic Aps.             *)
(*                                                                            *)
(*                                                                            *)
(******************************************************************************)



(******************************************************************************)
(*                                                                            *)
(*   UTILITY PROCEDURES                                                       *)
(*                                                                            *)
(******************************************************************************)

   FUNCTION sgn(arg: integer
               ): sgn_type;

     BEGIN (* SGN *)
      IF arg = 0 THEN
         sgn := zero
      ELSE IF arg > 0 THEN
         sgn := positive
      ELSE
         sgn := negative;
     END;  (* SGN *)


   FUNCTION equal_16(x: i_16
                    ;y: i_16
                    ): boolean;

     BEGIN (* equal_16 *)
      equal_16 := ( x(.rx1.) = y(.rx1.) ) and
                  ( x(.rx0.) = y(.rx0.) )
     END;  (* equal_16 *)


   FUNCTION equal_psn(x: psn_type
                     ;y: psn_type
                     ): boolean;

     BEGIN (* equal_psn *)
      equal_psn := ( x(.rx3.) = y(.rx3.) ) and
                   ( x(.rx2.) = y(.rx2.) ) and
                   ( x(.rx1.) = y(.rx1.) ) and
                   ( x(.rx0.) = y(.rx0.) )
     END;  (* equal_psn *)


   FUNCTION s_i_16(n: i_16
                  ): integer;

     BEGIN (* S_I_16 *)
      s_i_16 := 0;
      IF n(.rx1.) < 128 THEN
         s_i_16 := n(.rx1.) * 256 + n(.rx0.);
     END;  (* S_I_16 *)

   FUNCTION s_i_32(n: i_32
                  ): integer;

     BEGIN (* S_I_32 *)
      s_i_32 := 0;
      IF (n(.rx3.) = 0) and (n(.rx2.) = 0) and (n(.rx1.) < 128) THEN
         s_i_32 := n(.rx1.) * 256 + n(.rx0.);
     END;  (* S_I_32 *)

   PROCEDURE sum_32_i(VAR acc: i_32
                      ;    add: integer
                      );

      VAR
         i: base_32;
         temp: integer;
         carry: byte;
         add_32: psn_type;

     BEGIN (* SUM_32_i *)
      IF add > 0 THEN
        BEGIN
         add_32 := null_psn;
         add_32(.rx1.) := add div 256;
         add_32(.rx0.) := add mod 256;
         carry := 0;
         FOR i := rx0 DOWNTO rx3 DO
           BEGIN
            temp := acc(.i.) + add_32(.i.) + carry;
            acc(.i.) := temp mod 256;
            carry := temp div 256
           END;
        END
     END;  (* SUM_32_i *)
«eof»