*DECK FMUTIL
      PROC  FM$UTIL;         #  COLLECTION OF UTILITY ROUTINES FOR FORM#
      BEGIN 
#CALL FMCOM                                                            #
*CALL FMCOM 
CONTROL EJECT;
 #
* *   FMUTIL - FORM UTILITY PROCEDURES                         PAGE  1
* *   M.T. KAUFMAN
* 1DC FMUTIL
* 
* DC  FUNCTION
* 
*     FMUTIL IS NOT ITSELF A CALLED PROCEDURE.  IT IS A COLLECTION POINT
*     FOR A NUMBER OF GENERAL UTILITY PROCEDURES USED THROUGHOUT THE
*     FORM PACKAGE: 
* 
*       NAME    CALLED(DEF)      USE
*       ----    -----------      -----------------------
* 
*     FM$THIS     THIS           GET CURRENT CHARACTER FROM STRING
*     FM$NEXT     NEXT           GET NEXT CHARACTER AND ADVANCE POINTER 
*     FM$TNBL     TNBL           GET NON-BLANK CHAR, STARTING WITH THIS 
*     FM$NNBL     NNBL           GET NON-BLANK CHAR, STARTING WITH NEXT 
* 
*     FM$GTNM     GETNUM         PARSE INTEGER FROM SOURCE STRING 
*     FM$GTST     GETSTRING      PARSE DELIMITED STRING FROM SOURCE 
*     FM$CV5D     FM$CV5D        CONVERT INTEGER TO 5 DIGIT STRING
* 
*     FM$MIN      MIN            RETURN MINIMUM OF TWO INTEGERS 
*     FM$MAX      MAX            RETURN MAXIMUM OF TWO INTEGERS 
*     FM$MOD      MOD            PERFORM INTEGER MODULUS FUNCTION 
* 
* DC  ENTRY CONDITIONS
* 
*     FUNCTIONS REQUIRING SOURCE STRINGS EXPECT A POINTER PARAMETER 
*     OF THE FOLLOWING TYPE:  
* 
*      59                                   23    17               0
*       I-----------------------------------I-----I----------------I
*       I  RESIDUAL SIZE (BITS)             I UBC I   ADDRESS      I
*       I-----------------------------------I-----I----------------I
* 
*     UBC IS THE OFFSET IN [ADDRESS] TO THE START OF THE STRING, IN BITS
* 
* DC  EXIT CONDITIONS 
* 
*     NONE. 
* 
* DC  ERROR CONDITIONS
* 
*     NONE. 
* 
* DC  CALLED ROUTINES 
* 
*     NONE. 
* 
 #
CONTROL EJECT;
  
#  LOCAL DEFINITIONS                                                   #
  
      XDEF FUNC  FM$THIS S:CH;  #  GET CURRENT CHARACTER               #
      XDEF FUNC  FM$NEXT S:CH;  #  GET NEXT CHARACTER                  #
      XDEF FUNC  FM$TNBL S:CH;  #  GET NON-BLANK, STARTING FROM CURRENT#
      XDEF FUNC  FM$NNBL S:CH;  #  GET NON-BLANK, STARTING FROM NEXT   #
      XDEF FUNC  FM$GTNM I;  #  GET NUMERIC FIELD                      #
      XDEF PROC  FM$GTST;    #  GET STRING VALUE                       #
      XDEF FUNC  FM$MIN I;   #  MINIMUM VALUE                          #
      XDEF FUNC  FM$MAX I;   #  MAXIMUM VALUE                          #
      XDEF FUNC  FM$MOD I;   #  INTEGER MODULUS                        #
      XDEF FUNC  FM$CV5D C(5); # CONVERT INTEGER TO 5-DIGIT STRING     #
        XDEF PROC PUTSTR; 
        XDEF PROC PUTLIN; 
        XDEF PROC PUTDEC; 
        XDEF PROC PUTCHR; 
  
CONTROL EJECT;
      BEGIN 
        XDEF ARRAY OUTLINE [0:14] S(1); 
          ITEM
            OUT$TXT C(0,0,137); 
  
        XREF PROC PUT;
  
        ITEM OCUR I = 1;
        ITEM MAXLINE I = 137; 
      END;
  
  
      PROC PUTSTR(PCHARS,LEN);  #DEBUGGING TOOL - OUTPUT A STRING#
      ITEM
        PCHARS   C(20), 
        LEN      I; 
      BEGIN 
        IF OCUR + LEN LS  MAXLINE THEN
          BEGIN 
            C<OCUR,LEN> OUT$TXT[0] = C<0,LEN>PCHARS;
            OCUR = OCUR + LEN;
          END;
        RETURN; 
      END;  #  PUTSTR          #
  
  
      PROC PUTLIN;  #DEBUGGING TOOL - OUTPUT A LINE#
      BEGIN 
        PUT(FM$LFDB,OUT$TXT[0],OCUR); 
        OCUR = 1; 
        RETURN; 
      END;   #  PUTLIN            # 
  
  
      PROC PUTCHR(NUMBER);  #DEBUGGING TOOL - OUTPUT A CHARACTER# 
      ITEM
        NUMBER   U; 
      BEGIN 
        ITEM XCHR   C(1) = " "; 
  
  
        B<0,6>XCHR = B<54,6>NUMBER; 
        PUTSTR(XCHR,1); 
        RETURN; 
      END;
  
  
      PROC PUTDEC(NUMBER,LEN);  #DEBUGGING TOOL - OUTPUT A NUMBER#
      ITEM
        NUMBER    I,
        LEN       I;
      BEGIN 
        ITEM
          I         I,
          J         I,
          K         I,
          NCH       C(10) = "0123456789", 
          ONES      C(2) = "#1",
          PCHARS    C(20);
  
  
        PCHARS = "                    ";
        IF NUMBER EQ ALLONES  AND  B<0,1>NUMBER EQ 1 THEN 
          BEGIN 
            C<MAX(0,LEN - 2),2>PCHARS = C<0,2>ONES; 
            PUTSTR(PCHARS,LEN); 
            RETURN; 
          END;
        IF LEN GR 20 OR LEN LS 1 OR OCUR + LEN GR MAXLINE THEN
          BEGIN 
            PUTSTR("LEN ERROR",9);
            RETURN; 
          END;
        J = NUMBER; 
        IF J LS 0 THEN
          J = -J; 
        IF J GR 2 ** 47 THEN
          BEGIN 
            PUTSTR("NONINTEGER",10);
            RETURN; 
          END;
        I = LEN - 1;
  
        IF J EQ 0 THEN
          BEGIN 
            C<I>PCHARS = C<0>NCH; 
            PUTSTR(PCHARS,LEN); 
            RETURN; 
          END;
  
        FOR I = I STEP -1 WHILE J GR 0 AND I GR -1  DO
          BEGIN 
            IF J GR 0 THEN
              BEGIN 
                K = J / 10; 
                K = J - K * 10; 
                J = J / 10; 
                C<I>PCHARS = C<K>NCH; 
              END;
          END;
        IF NUMBER LS 0 THEN 
          BEGIN 
            IF I GR -1 THEN 
              C<I>PCHARS = "-"; 
          END;
        IF J GR 1 THEN
          PCHARS = "********************";
        PUTSTR(PCHARS,LEN); 
        RETURN; 
      END;  #   PUTDEC        # 
  
CONTROL EJECT;
      FUNC  FM$THIS (PTR) S:CH;  # GET CURRENT CHARACTER               #
      ITEM  PTR B;
      BEGIN 
        IF  RESIDUAL(PTR) GR 0
          THEN  THIS = BPCHAR(PTR); 
          ELSE  THIS = CH"EOS";  ;      # OUT OF RANGE CHARACTER       #
      END;
  
  
  
  
      FUNC  FM$NEXT (PTR) S:CH;  # GET NEXT CHARACTER                  #
      ITEM PTR; 
      BEGIN 
        ADVANCE(PTR); 
        NEXT = THIS(PTR); 
      END;
  
  
  
  
      FUNC  FM$TNBL (PTR) S:CH;  # GET NON-BLANK, STARTING FROM CURRENT#
      ITEM PTR; 
      BEGIN 
        WHYLE  THIS(PTR) EQ CH"SPACE"  DO ADVANCE(PTR); 
        TNBL = THIS(PTR); 
      END;
  
  
  
  
      FUNC  FM$NNBL (PTR) S:CH;  # GET NON-BLANK, STARTING FROM NEXT   #
      ITEM PTR; 
      BEGIN 
        ADVANCE(PTR); 
        NNBL = TNBL(PTR); 
      END;
CONTROL EJECT;
  
  
  
  
      FUNC  FM$GTNM (PTR) I; # GET NUMERIC FIELD                       #
      ITEM PTR; 
      BEGIN 
        ITEM  K  I; 
        ITEM  C  S:CH;
        K = 0;
        FOREVER DO
          BEGIN 
          C = TNBL( PTR );
          IF NUMERIC( C ) 
          THEN
            BEGIN 
            K = 10*K + C - CH"ZERO";
            ADVANCE( PTR ); 
            TEST; 
            END 
          GETNUM = K; 
          RETURN; 
          END 
      END 
  
  
  
  
      PROC  FM$GTST (PTR);   # GET STRING VALUE                        #
      ITEM PTR; 
      BEGIN 
        ITEM  CHR I,  K I,  DELIM I;
  
        DELIM = THIS(PTR);  ADVANCE(PTR); 
        FOR K=0 STEP 1 WHILE K LS T$STRING$MAX AND RESIDUAL(PTR) NQ 0 DO
        BEGIN 
          IF (THIS(PTR) EQ DELIM) THEN
            BEGIN 
              ADVANCE(PTR); 
              IF (THIS(PTR) NQ DELIM) OR(RESIDUAL(PTR) EQ 0) THEN 
                BEGIN 
                  T$M2 = K; 
                  RETURN; 
                END 
            END 
          C<K>T$STRING = PCHAR(PTR);  ADVANCE(PTR); 
        END 
        T$M2 = T$STRING$MAX;
        IF  THIS(PTR) EQ DELIM THEN ADVANCE(PTR); 
      END 
      FUNC  FM$CV5D((VAL))  C(5); # CONVERT VALUE TO CHARACTER STRING  #
        ITEM  VAL  U; 
      BEGIN 
        ITEM  T C(5),  I U; 
  
        T = "00000";         # LEADING ZEROS NEEDED                    #
        FOR  I = 24 STEP -6  WHILE VAL NQ 0  DO 
          BEGIN 
            B<I,6>T = B<I,6>T + MOD(VAL,10);
            VAL = VAL / 10; 
          END 
        FM$CV5D = T;
      END 
CONTROL EJECT;
      FUNC  FM$MIN (A,B) I;  # MINIMUM VALUE                           #
      ITEM  A I, B I; 
      BEGIN 
        IF A LS B  THEN  MIN = A;  ELSE  MIN = B; 
      END 
  
  
  
  
      FUNC  FM$MAX (A,B) I;  # MAXIMUM VALUE                           #
      ITEM  A I, B I; 
      BEGIN 
        IF A GR B  THEN  MAX = A;  ELSE  MAX = B; 
      END 
  
  
  
  
      FUNC  FM$MOD (A, M) I; # INTEGER MODULUS                         #
      ITEM  A I, M I; 
      BEGIN 
        ITEM  I I, J I, K I;
  
        K = 0;
        IF  M NQ 0  AND  A NQ 0  THEN 
          BEGIN 
            IF  M GQ 0
              THEN  BEGIN  I = A; J = M; END
              ELSE  BEGIN  I =-A; J =-M; END
            IF  I LS 0  THEN  I = I + J*((J-I)/J);
            K = I - J*(I/J);
            IF  M LS 0  THEN  K = -K; 
          END 
        MOD = K;
      END 
  
  
  
  
      END  # FM$UTIL #
      TERM
