*DECK CONVERT 
USETEXT TDESATT 
USETEXT TENVIRN 
USETEXT TINDTBL 
      PROC CONVERT (PARAMETER,RC);
      BEGIN 
CONTROL NOLIST;                    #CCONVERT  -- LISTED IN SYNTAX      # CONVERT
*CALL CCONVERT                                                           CONVERT
CONTROL LIST;                                                            CONVERT
 #
 0        CONVERT - MAIN ENTRY POINT FOR CONVERSION/EDITING PROCESSING. 
                    CONVERT IS CALLED WITH 2 PARAMETERS, THE ADDRESS OF 
                    A REPORTLIST-FORMATTED ENTRY WHICH CONTAINS ALL THE 
                    INFORMATION PERTINENT TO A CONVERSION AND THE 
                    ADDRESS OF AN ITEM WHICH MAY RECEIVE AN ERROR RETURN
                    CODE.  CONVERT UNPACKS THE INFORMATION FROM THE RE- 
                    PORTLIST ENTRY INTO THE CCONVERT COMMON AREA AND
                    CALLS THE APPROPRIATE CONVERSION PROCEDURE. 
 #
 #
          RULES FOLLOWED BY CONVERT IN INTERPRETING THE FIELDS IN A 
          REPORTLIST ENTRY PASSED AS A PARAMETER IN THE CALL TO CONVERT.
          X = CHARACTER (CODE=0)   E = NORMALIZED       (4) 
          N = NUMERIC       (1)    D = DOUBLE PRECISION (5) 
          I = BINARY INTEGER(2)    C = COMPLEX          (6) 
          U = UNNORMALIZED  (3)    L = LOGICAL          (7) 
          SOURCE = ADDRESS OF SOURCE. SINK = ADDRESS OF RESULT. 
          DNPTR = POINTER TO ATTRIBUTES ENTRY FOR AN ITEM.
          **************************************************************
          CONVERT CONVERT  EDITFLAG=ON MEANING    EDITFLAG=OFF MEANING
          CODE    MAPPING  FROMWORD   TOWORD      FROMWORD   TOWORD 
           01      X_X     DNPTR(X)   SINK        SOURCE     DNPTR(X2)
           02      X_N     ILLEGAL    ILLEGAL     SOURCE     DNPTR(N) 
           03      X_I     ILLEGAL    ILLEGAL     SOURCE     DNPTR(I) 
           04      X_U     ILLEGAL    ILLEGAL     SOURCE     DNPTR(U) 
           05      X_E     ILLEGAL    ILLEGAL     SOURCE     DNPTR(E) 
           06      X_D     ILLEGAL    ILLEGAL     SOURCE     DNPTR(D) 
           07      X_C     ILLEGAL    ILLEGAL     SOURCE     DNPTR(C) 
           10      X_L     DNPTR(X)   DNPTR(L) IF SOURCE     DNPTR(L) IF
                                      USECONVERT,            USECONVERT,
                                      ELSE SINK              ELSE SINK
           11      N_N     DNPTR(N)   SINK        DNPTR(N1)  DNPTR(N2)
           12      N_I     DNPTR(N)   DNPTR(I)    DNPTR(N)   DNPTR(I) 
           13      N_U     DNPTR(N)   DNPTR(U)    DNPTR(N)   DNPTR(U) 
           14      N_E     DNPTR(N)   SINK        DNPTR(N)   SINK 
           15      N_D     DNPTR(N)   SINK        DNPTR(N)   SINK 
           16      N_C     DNPTR(N)   SINK        DNPTR(N)   SINK 
           17      I_N     DNPTR(I)   DNPTR(N)    DNPTR(I)   DNPTR(N) 
           20      I_I     DNPTR(I1)  SINK        DNPTR(I1)  DNPTR(I2)
           21      I_U     DNPTR(I)   DNPTR(U)    DNPTR(I)   DNPTR(U) 
           22      I_E     DNPTR(I)   SINK        DNPTR(I)   SINK 
           23      I_D     DNPTR(I)   SINK        DNPTR(I)   SINK 
           24      I_C     DNPTR(I)   SINK        DNPTR(I)   SINK 
           25      U_N     DNPTR(U)   DNPTR(N)    DNPTR(U)   DNPTR(N) 
           26      U_I     DNPTR(U)   DNPTR[I]    DNPTR(U)   DNPTR(I) 
           27      U_U     DNPTR(U)   SINK        DNPTR(U1)  DNPTR(U2)
           30      U_E     DNPTR(U)   SINK        DNPTR(U)   SINK 
           31      U_D     DNPTR(U)   SINK        DNPTR(U)   SINK 
           32      U_C     DNPTR(U)   SINK        DNPTR(U)   SINK 
           33      E_N     SOURCE     DNPTR(N)    SOURCE     DNPTR(N) 
           34      E_I     ILLEGAL    ILLEGAL     SOURCE     DNPTR(I) 
           35      E_U     SOURCE     DNPTR(U)    SOURCE     DNPTR(U) 
           36      E_E     DNPTR(E)   SINK        SOURCE     SINK 
           37      E_D     ILLEGAL    ILLEGAL     SOURCE     SINK 
           40      E_C     ILLEGAL    ILLEGAL     SOURCE     SINK 
           41      D_N     SOURCE     DNPTR(N)    SOURCE     DNPTR(N) 
           42      D_I     ILLEGAL    ILLEGAL     SOURCE     DNPTR(I) 
           43      D_U     SOURCE     DNPTR(U)    SOURCE     DNPTR(U) 
           44      D_E     ILLEGAL    ILLEGAL     SOURCE     SINK 
           45      D_D     DNPTR(D)   SINK        SOURCE     SINK 
           46      D_C     ILLEGAL    ILLEGAL     SOURCE     SINK 
           47      C_N     SOURCE     DNPTR(N)    SOURCE     DNPTR(N) 
           50      C_I     ILLEGAL    ILLEGAL     SOURCE     DNPTR(I) 
           51      C_U     SOURCE     DNPTR(U)    SOURCE     DNPTR(U) 
           52      C_E     ILLEGAL    ILLEGAL     SOURCE     SINK 
           53      C_D     ILLEGAL    ILLEGAL     SOURCE     SINK 
           54      C_C     DNPTR(C)   SINK        SOURCE     SINK 
           55      L_L     DNPTR(L)   SINK        SOURCE     SINK 
          **************************************************************
          IN GENERAL THE CONVERSION REQUEST CODE IS OBTAINED FROM THE 
          ARRAY NAMED "CONVERSIONS" USING THE FOLLOWING STATEMENT:  
          CODE = B<(OUTPUT DATA USAGE)*6,6>CCODE[INPUT DATA TYPE] 
          CONVERSION OF DATA FOR DISPLAY OR REPORT PURPOSES IS ACHIEVED 
          BY TURNING ON THE EDITFLAG AND USING THE APPROPRIATE REQUEST
          CODE FROM THE FOLLOWING LIST OF CODES: 1,11,20,27,36,45,54,55.
  
          CONVERSION OF NUMERIC DATA FROM EDITED DISPLAY FORMAT SHOULD
          EVENTUALLY BE ACCOMPLISHED BY TURNING ON THE EDITFLAG, USING
          A REQUEST CODE FROM 1 TO 10 AND CALLING A YET-TO-BE-DESIGNED
          ROUTINE CALLED DEEDIT.  HOWEVER AN INTERIM CAPABILITY EXISTS
          TO PERFORM LIMITED DEEDITING BY SKIPPING BLANKS, AND THIS IS
          ACCOMPLISHED BY USING REQUEST CODES 12 THRU 16. 
  
          CONVERSION OF UNEDITED DISPLAY DATA TO INTERNAL USAGE FORMATS 
          IS ACCOMPLISHED BY CALLING CONVERT WITH A REQUEST CODE FROM 1 
          THRU 10.
  
          CONVERSION FROM ONE INTERNAL USAGE FORMAT TO ANOTHER MAY BE 
          EFFECTED BY USING THE APPROPRIATE REQUEST CODE. THE EDITFLAG
          SHOULD BE TURNED OFF FOR SAFETY"S SAKE, THOUGH IT MAY MAKE NO 
          DIFFERENCE. NOTE THAT THE ATTRIBUTES ENTRY FOR AN ITEM IS 
          NEEDED FOR X,I,N, AND U USAGE. FOR I,N, AND U SOME INFORMATION
          THAT WAS CONTAINED IN THE PICTURE MUST BE PASSED TO THE CON-
          VERSION PROCESS VIA THE ATTRIBUTES ENTRY. FOR X, THE OUTPUT 
          LENGTH IS TAKEN FROM THE ATTRIBUTES ENTRY AND THE INPUT LENGTH
          FROM THE PARAMETER IN THE CALL TO CONVERT.
 #
      ARRAY PARAMETER [0:0] S(2); 
          ITEM   EDIT        B(0, 3, 1),
                 FROMCHAR    U(0, 4, 4),
                 TOCHAR      U(0, 8, 4),
                 NBCHAR      U(0,12,12),
                 FROMWORD    U(0,24,18),
                 TOWORD      U(0,42,18),
                 CONVERTCODE U(1, 0, 6),
      FROMPTR U(1,24,18), 
                 TOPTR       U(1,42,18);
      ITEM RC;        # RETURN CODE SET TO
                                   0  CONVERSION SUCCESSFUL 
                      # 
      XDEF BEGIN                       # REFERENCED IN QU2CONV.        #
          ITEM UPPERINT,               # 54 MOST SIGNIFICANT BITS.     #
               LOWERINT,               # 54 LEAST SIGNIFICANT BITS.    #
               EXPONENT,               # POWER OF 10 EXPONENT.         #
               SIGN,                   # SIGN OF MANTISSA.             #
               FLAGE B,                # CONVERSION REQUEST FLAG, TRUE #
                                       # = SINGLE PRECISION REQUESTED. #
               MANTISSA R,             # SINGLE PRECISION RESULT.      #
               DOUBLE R;               # 2ND WORD OF DOUBLE PRECISION. #
           END
      XREF PROC QU2CONV;
      XREF PROC QU2KOD; 
      XREF PROC ALPHAED;               # CHARACTER EDITING PROCEDURE.  #
      XREF PROC NUMERED;               # NUMERIC EDITING PROCEDURE.    #
      XREF FUNC SCALEINT R;            # INTEGER SCALING FUNCTION.     #001350
      XREF FUNC SCALEFLT R;            # FLOATING PT SCALING FUNCTION. #001360
      XREF PROC CMOVE;                 # CHARACTER MOVE PROCEDURE.     #
      XREF ITEM USECONVERT B;      # *CONVERT* CALLED BY *USINGEX*     # QU3A094
  
      BASED ARRAY FROMFLD;  ITEM FWA, 
                                   FREAL R, FINTEGER, FSIGN B(0,0,1), 
                                   FMANTISSA U(0,18,42);
      BASED ARRAY TOFLD;  ITEM TWA, 
                                   TREAL R, TINTEGER I, TSIGN B(0,0,1), 
                                   TMANTISSA U(0,18,42);
      BASED ARRAY BSTATUS;;        # E OR D, DISPLAY CODED NUMBER,     #
                                   # ETC. FROM QU2KOD                  #
  
      DEF FUZZ#0.0002#;            # THE VALUE USED FOR DETERMINING    # QU3A094
                                   # WHETHER OR NOT TWO FLOATING       #
                                   # NUMBERS ARE EQUAL.                #
      ITEM CHAR,                       # SOURCE CHARACTER.             #
           FLAGD B,                    # TRUE IF "D" IN SOURCE.        #
           FLAGI B = FALSE,            # TRUE IF "I" LEGAL IN SOURCE.  #
           FLAGU B = FALSE,            # TRUE IF UNNORMALIZED RESULT.  #
           INTEGER,                    # INTEGER CONVERSION RESULT.    #
           NEGEXPONENT B,              # TRUE IF NEGATIVE EXPONENT.    #
           NEGMANTISSA B,              # TRUE IF NEGATIVE MANTISSA.    #
           EXPONSIGN B,            # TRUE IF SIGN IS INVALID ON EXPON. #
           MANTSIGN B,             # TRUE IF SIGN IS INVALID ON MANT.  #
           PERIOD B,                   # TRUE IF SOURCE CONTAINS "."   #
           QUOTIENT;
      ITEM FINISHED     B;         # LOOP CONTROL FLAG                 #
      ITEM I,J,K,L;                    # SCRATCH ITEMS.                #001420
      ITEM INTFLAG B;              # TRUE IF PACKANDSCALE WRITING      #
                                   # INTEGER AND MUST NOT ADD 2000...  #
      ITEM INTMURAL = O"51003777774000000001";# DEFAULT INTEGER MURAL. #001430
      ITEM FIXMURAL = O"51003777700000000001";# DEFAULT FIXED PT MURAL.#001440
      ITEM FLTMURAL = O"51003777530300000001";# DEFAULT FLOATING MURAL.#001450
      ITEM DOUBLEMURAL = O"51003777530374000001";#DEFAULT DBL PREC MRL.#001460
      ITEM TRUECHARS C(5) = "TRUE ";
      ITEM FALSECHARS C(5) = "FALSE"; 
      ARRAY SCRATCH[2]; 
        ITEM SCRATCHWD; 
      ARRAY BLANKS[4];                                                  001490
        ITEM BLKS C(,,10) = [5("          ")];                          001500
          SWITCH CONVERTRTN  BADREQUEST, # INVALID CONVERSION.        0#
                             CHARCHAR,   # CHARACTER TO CHARACTER.    1#
                             CHARNUM,    # DISPLAY TO NUMERIC.        2#
                             CHARINT,    # DISPLAY TO INTEGER.        3#
                             CHARUNNORM, # DISPLAY TO UNNORMALIZED.   4#
                             CHARSINGLE, # DISPLAY TO NORMALIZED.     5#
                             CHARDOUBLE, # DISPLAY TO DOUBLE.         6#
                             CHARCOMPLEX,# DISPLAY TO COMPLEX.        7#
                             CHARLOGICAL,# CHARACTER TO LOGICAL.     10#
                             NUMNUM,     # NUMERIC TO NUMERIC.       11#
                             NUMINT,     # NUMERIC TO INTEGER.       12#
                             NUMUNNORM,  # NUMERIC TO UNNORMALIZED.  13#
                             NUMSINGLE,  # NUMERIC TO NORMALIZED.    14#
                             NUMDOUBLE,  # NUMERIC TO DOUBLE.        15#
                             NUMCOMPLEX, # NUMERIC TO COMPLEX.       16#
                             INTNUM,     # INTEGER TO NUMERIC.       17#
                             INTINT,     # INTEGER TO INTEGER.       20#
                             INTUNNORM,  # INTEGER TO UNNORMALIZED.  21#
                             INTSINGLE,  # INTEGER TO NORMALIZED.    22#
                             INTDOUBLE,  # INTEGER TO DOUBLE.        23#
                             INTCOMPLEX, # INTEGER TO COMPLEX.       24#
                             UNNORMNUM,  # UNNORMALIZED TO NUMERIC.  25#
                             UNNORMINT,  # UNNORMALIZED TO INTEGER.  26#
                             UNNORMUNNORM,#UNNORMALIZED TO UNNORM.   27#
                             UNNORMSGL,  # UNNORMALIZED TO SINGLE.   30#
                             UNNORMDBL,  # UNNORMALIZED TO DOUBLE.   31#
                             UNNORMCPLX, # UNNORMALIZED TO COMPLEX.  32#
                             SINGLENUM,  # SINGLE TO NUMERIC.        33#
                             SINGLEINT,  # SINGLE TO INTEGER.        34#
                             SGLUNNORM,  # SINGLE TO UNNORMALIZED.   35#
                             SGLSINGLE,  # SINGLE TO SINGLE.         36#
                             SGLDOUBLE,  # SINGLE TO DOUBLE.         37#
                             SGLCOMPLEX, # SINGLE TO COMPLEX.        40#
                             DOUBLENUM,  # DOUBLE TO NUMERIC.        41#
                             DOUBLEINT,  # DOUBLE TO INTEGER.        42#
                             DBLUNNORM,  # DOUBLE TO UNNORMALIZED.   43#
                             DBLSINGLE,  # DOUBLE TO SINGLE.         44#
                             DBLDOUBLE,  # DOUBLE TO DOUBLE.         45#
                             DBLCOMPLEX, # DOUBLE TO COMPLEX.        46#
                             COMPLEXNUM, # COMPLEX TO NUMERIC.       47#
                             COMPLEXINT, # COMPLEX TO INTEGER.       50#
                             CPLXUNNORM, # COMPLEX TO UNNORMALIZED.  51#
                             CPLXSINGLE, # COMPLEX TO SINGLE.        52#
                             CPLXDOUBLE, # COMPLEX TO DOUBLE.        53#
                             CPLXCOMPLEX,# COMPLEX TO COMPLEX        54#
                             LOGLOGICAL; # LOGICAL TO CHARACTER.     55#
      BASED ARRAY BASEPTR;             # ACCESSES BASE ADDRESS FOR     #
                                       # RELATIVE ADDRESSING           # QU3A094
        BEGIN                                                            QU3A094
        ITEM BASE I(00,42,18);     # 18 BIT POINTER VALUE              # QU3A094
        END                                                              QU3A094
                                                                         QU3A094
          ITEM ZERO = 0;
         ITEM FROMNUM B;
      ITEM LEADING$BLNK B;         # TRUE IF LEADING BLANKS POSSIBLE   #
  
    # 
             CCC    OOO   N   N  V   V  EEEEE  RRRR   TTTTT 
            C   C  O   O  NN  N  V   V  E      R   R    T 
            C      O   O  N N N  V   V  EEEE   RRRR     T 
            C   C  O   O  N  NN   V V   E      R  R     T 
             CCC    OOO   N   N    V    EEEEE  R   R    T 
      # 
          FROMNUM = FALSE;
          REQUESTCODE = CONVERTCODE[0];# UNPACK CONVERSION/EDITING     #
          SOURCEWORD = FROMWORD[0];    # PARAMETERS FROM TABLE ENTRY   #
          SOURCEBYTE = FROMCHAR[0];    # INTO CCONVERT COMMON AREA.    #
          SOURCELENG = NBCHAR[0]; 
          SINKWORD = TOWORD[0]; 
          SINKBYTE = TOCHAR[0]; 
          SINKLENG = SOURCELENG;
          EDITING = EDIT[0];
          EXPONENT = 0; 
          INTFLAG = FALSE;
          P<BASEPTR> = FROMPTR[0];     # IF SOURCE LOCATION IS RELATIVE#
          IF P<BASEPTR> NQ 0 THEN      # TO SOME BASE, CALCULATE THE   #
            SOURCEWORD = SOURCEWORD + BASE[0];#      CURRENT LOCATION. #
          P<BASEPTR> = TOPTR[0];       # IF SINK LOCATION IS RELATIVE  #
          IF P<BASEPTR> NQ 0 THEN      # TO SOME BASE, CALCULATE THE   #
            SINKWORD = SINKWORD + BASE[0];#          CURRENT LOCATION. #
          RETURNCODE = 0;              # INITIALIZE ERROR RETURN CODE. #
      RC = 0; 
          IF REQUESTCODE LS 1 OR       # DIAGNOSE INVALID REQUESTS.    #
             REQUESTCODE GR O"55" THEN
               GOTO BADREQUEST; 
          GOTO CONVERTRTN[REQUESTCODE]; 
  
  
      BADREQUEST: 
          RC = 53;                     # INVALID CONVERSION REQUEST.   #
          RETURN; 
  
  
      CHARCHAR: 
 #
 0        CHARCHAR - MOVES DATA FROM ONE CHARACTER FIELD TO ANOTHER OR
                    EDITS CHARACTER DATA ACCORDING TO AN EDIT MURAL.
 #
          IF EDITING THEN              # UNPACK THE ATTRIBUTES OF THE  #
            FROMATTRIB;                # SINK AND SOURCE FIELDS FROM   #
          ELSE TOATTRIB;               # THEIR DESCRIPTION TABLES.     #
      LOGCHAR:  
          IF EDITING THEN 
          BEGIN 
            IF SINKLENG LS SOURCELENG THEN # PASS LESSER LENGTH.       #
              SOURCELENG = SINKLENG;
            IF MURALADDR GR 0 THEN     # CALL ALPHAED IF EDIT MURAL.   #
            BEGIN 
              ALPHAED;                 # EDIT SOURCE ACCORDING TO MURAL#
              RC = RETURNCODE;
              RETURN; 
            END 
            SOURCELENG = DPICSIZ[0];   # IF NO EDITING, MOVE PICTURED  #
          END                          # SIZE SPECIFIED.               #
          P<FROMFLD> = SOURCEWORD;
          P<TOFLD> = SINKWORD;
          RC = 0; 
          IF SOURCELENG GQ SINKLENG THEN # IF FIELD SIZES DIFFER,      #001520
                                         # EITHER TRUNCATE OR PAD.     #
            BEGIN 
            IF RIGHTJUST           # IF JUSTIFIED RIGHT                #
            THEN
              BEGIN 
              L = SOURCELENG - SINKLENG;  # OFFSET FOR BEGINNING CHAR  #
                                          # POSITION OF SOURCE ITEM    #
              CMOVE(FROMFLD, SOURCEBYTE + L, SINKLENG, TOFLD, SINKBYTE);
              RETURN; 
              END 
            ELSE
              BEGIN 
              CMOVE (FROMFLD, SOURCEBYTE, SINKLENG, TOFLD, SINKBYTE); 
              RETURN; 
              END 
            END 
          L = SINKLENG - SOURCELENG;  # OFFSET FOR BEGINNING CHARACTER #
                                      # POSITION OF SINK ITEM AS WELL  #
                                      # AS AMT OF BLANK PADDING NEEDED #
          IF RIGHTJUST             # IF JUSTIFIED RIGHT                #
          THEN
            BEGIN 
            CMOVE (FROMFLD, SOURCEBYTE, SOURCELENG, TOFLD,SINKBYTE + L);
            SINKBYTE = 0;          # BEGINNING CHAR POSITION FOR BLANK #
                                   # PADDING                           #
            END 
          ELSE
            BEGIN 
            CMOVE (FROMFLD, SOURCEBYTE, SINKLENG, TOFLD, SINKBYTE); 
            SINKBYTE = SINKBYTE + SOURCELENG;  # BEGINNING CHARACTER   #
                                               # POS FOR BLANK PADDING #
            END 
      MOVEBLANKS:                                                       001570
          IF L GR 50 THEN                                               001580
            K = 50;                                                     001590
          ELSE K = L;                                                   001600
          CMOVE(BLANKS,ZERO,K,TOFLD,SINKBYTE); # MOVE BLANKS TO SINK.  #001610
          SINKBYTE = SINKBYTE + K;                                      001620
          L = L - K;                                                    001630
          IF L GR 0 THEN                                                001640
            GOTO MOVEBLANKS;                                            001650
          RETURN; 
  
  
      CHARNUM:  
 #
 0        CHARNUM - CONVERTS UNEDITED DISPLAY NUMERIC DATA INTO COMPU-
                    TATIONAL FORMAT (SIGN OVERPUNCH). 
 #
          IF EDITING THEN 
            GOTO BADREQUEST;
          P<DESATT1> = TOWORD[0];                                        QU3A094
          IF ITEMSIZE              # IF SEP ITEM-SIZE IS ON            # QU3A094
            AND USECONVERT         # AND WE ARE PROCESSING USING OPTION# QU3A094
            AND DOVERPUN           # AND SINK FIELD HAS SIGN OVERPUNCH # QU3A094
          THEN                                                           QU3A094
            BEGIN                                                        QU3A094
            FROMNUM = TRUE;        # TREAT INPUT AS NUMERIC FIELD      # QU3A094
            END                                                          QU3A094
          TOATTRIB;                # UNPACK SINK ATTRIBUTES            # QU3A094
          DISPLAYTOBIN;            # CONVERT CHAR TO FLOATING          # QU3A094
          GOTO SGLENUM1;           # CONVERT FLOATING TO NUMERIC       # QU3A094
                                   # THIS ALLOWS DECIMAL POINTS AND E  # QU3A094
                                   # TO BE USED.  ALSO THIS ELIMINATES # QU3A094
                                   # PROBLEMS WITH LEADING AND TRAILING# QU3A094
                                   # ZEROS.                            # QU3A094
  
  
      CHARINT:  
 #
 0        CHARINT - CONVERTS UNEDITED DISPLAY NUMERIC DATA INTO BINARY
                    INTEGER DATA. 
 #
          INTFLAG =TRUE;
          GOTO CHARUNNORM;
  
  
      CHARUNNORM: 
 #
 0        CHARUNNORM - CONVERTS UNEDITED DISPLAY NUMERIC DATA INTO
                    BINARY FLOATING POINT FORMAT, UNNORMALIZED AND
                    SCALED ACCORDING TO THE ATTRIBUTE DESCRIPTION.
 #
          IF EDITING THEN 
            GOTO BADREQUEST;
CHARUNNORM1:                       # ENTRY FOR DIS FIXED CONVERSION    # QU3A094
          FLAGU = TRUE;                # TURN ON UNNORMALIZE FLAG, AND #
          REQUESTCODE = 3;             # REQUEST AN INTEGER RESULT.    #
          DISPLAYTOBIN;                # CONVERT TO BINARY.            #
          FLAGU = FALSE;               # TURN OFF UNNORMALIZED FLAG.   #
          IF ITEMSIZE              # IF SEP ITEM-SIZE IS ON            # QU3A094
            AND USECONVERT         # IF *USINGEX* CALLED CONVERT       # QU3A094
            AND NOT PERIOD         # AND NO DECIMAL POINT OCCURED      # QU3A094
            AND TOWORD NQ 0        # IF ATTRIBUTE POINTER EXISTS       # QU3A094
          THEN                     # THEN IGNORE SCALING               # QU3A094
            BEGIN                                                        QU3A094
            P<DESATT1> = TOWORD[0];                                      QU3A094
            J = DPTLOC[0];         # ASSUME DECIMAL POINT WAS GIVEN IN # QU3A094
            EXPONENT = 0;          # THE APPROPRIATE PLACE             # QU3A094
            END                                                          QU3A094
          PACKANDSCALE;                # PACK, SCALE AND STORE VALUE.  #
          RETURN; 
  
  
      CHARSINGLE: 
 #
 0        CHARSINGLE - CONVERTS AN UNEDITED DISPLAY CODE NUMERIC FIELD
                    INTO A BINARY, NORMALIZED, FLOATING POINT VALUE.
 #
          IF EDITING THEN 
            GOTO BADREQUEST;
          TOATTRIB;                # UNPACK SINK ATTRIBUTES            #
CHARSINGLE1:                       # ENTRY FOR DIS FLOAT CONVERSION    # QU3A094
          DISPLAYTOBIN;                # CONVERT SOURCE TO BINARY.     #
          TREAL[0] = MANTISSA;         # STORE RESULT IN SINK FIELD.   #
          RC = RETURNCODE;             # RETURN ERROR CODE.            #
          RETURN; 
  
  
      CHARDOUBLE: 
 #
 0        CHARDOUBLE - CONVERTS AN UNEDITTED DISPLAY CODE NUMERIC FIELD 
                    INTO A DOUBLE PRECISION FLOATING POINT VALUE. 
 #
          IF EDITING THEN 
            GOTO BADREQUEST;
          TOATTRIB;                # UNPACK SINK ATTRIBUTES            #
CHARDOUBLE1:                       # ENTRY FOR DIS DOUBLE CONVERSION   # QU3A094
          DISPLAYTOBIN;                # CONVERT SOURCE TO BINARY.     #
          TREAL[0] = MANTISSA;         # STORE RESULT IN SINK FIELD.   #
          TREAL[1] = DOUBLE;
          RC = RETURNCODE;
          RETURN; 
  
  
      CHARCOMPLEX:                     #                               #
 #
 0        CHARCOMPLEX - CONVERTS AN UNEDITED DISPLAY CODE NUMERIC FIELD 
                    INTO A FLOATING POINT COMPLEX REPRESENTATION. 
 #
          IF EDITING THEN 
            GOTO BADREQUEST;
          TOATTRIB;                # UNPACK SINK ATTRIBUTES            #
CHARCOMPLEX1:                      # ENTRY FOR DIS COMPLEX CONVERSION  # QU3A094
          FLAGI = TRUE;                # "I" IS LEGAL IN SOURCE.       #
          DISPLAYTOBIN;                # CONVERT REAL PART TO BINARY.  #
          TREAL[0] = MANTISSA;         # STORE REAL PART IN SINK FIELD.#
          IF RETURNCODE LQ 0 THEN      # IF NO ERROR IN REAL PART THEN #
          BEGIN                        # CONVERT IMAGINARY PART TO BIN.#
          EXPONENT = 0; 
            DISPLAYTOBIN;              # CONVERT IMAGINARY PART.       #
            TREAL[1] = MANTISSA;       # STORE IMAGINARY PART IN SINK. #
          END 
          ELSE TREAL[1] = 0;
          FLAGI = FALSE;
          RC = RETURNCODE;
          RETURN; 
  
  
      CHARLOGICAL:                     #                               #
 #
 0        CHARLOGICAL - CONVERTS AN ALPHANUMERIC CHARACTER DATA FIELD 
                    TO A BINARY LOGICAL VALUE.
 #
          IF EDITING THEN              # DE-EDITING ACCOMPLISHED BY    #
          BEGIN FROMATTRIB;                                             001600
                IF DISPLAYSIZE[0] NQ DPICSIZ[0] THEN                    001610
            GOTO BADREQUEST;           # CALLING "DEEDIT".             #
          END                                                           001630
          P<FROMFLD> = SOURCEWORD;
          IF SOURCELENG GQ 6 THEN 
            SOURCELENG = 5; 
          IF C<SOURCEBYTE,1>FWA[0] EQ "T" THEN # CHECK FOR POSSIBLE    #
            P<TOFLD> = LOC(TRUECHARS); # TRUE OR FALSE.                #
          ELSE IF C<SOURCEBYTE,1>FWA[0] EQ "F" THEN 
            P<TOFLD> = LOC(FALSECHARS); 
               ELSE BEGIN 
      BADCHARLOG:     RC = 55;         # DATA INCOMPATIBLE WITH DIREC- #
                      RETURN;          # TORY DESCRIPTION.             #
                    END 
          J = 0;
          FOR L=1 STEP 1 UNTIL SOURCELENG-1 DO # CHECK REST OF SOURCE  #
          BEGIN                        # AGAINST "TRUE" OR "FALSE".    #
            SOURCEBYTE = SOURCEBYTE + 1;
            IF SOURCEBYTE GQ 10 THEN
            BEGIN 
              J = 1;
              SOURCEBYTE = 0; 
            END 
            IF C<SOURCEBYTE,1>FWA[J] NQ C<L,1>TWA[0] THEN 
              GOTO BADCHARLOG;
          END 
          IF USECONVERT            # IF CALLED FROM USINGEX            #
          THEN
            BEGIN 
            TOATTRIB;              # UNPACK SINK ATTRIBUTES            #
            END 
          P<FROMFLD> = SINKWORD;
          IF P<TOFLD> EQ LOC(TRUECHARS) THEN # IF SOURCE WAS "TRUE"    #
          FWA[0]=-1;                                                    002160
          ELSE FWA[0] = 0;             # ELSE STORE 0 BITS.            #
          RC = 0;                      # NO ERROR.                     #
          RETURN; 
  
  
      NUMNUM: 
 #
 0        NUMNUM - CONVERTS ONE NUMERIC FIELD"S VALUE TO CONFORM TO 
                    ANOTHER NUMERIC FIELD"S DEFINITION OR EDITS A NU- 
                    MERIC FIELD FOR DISPLAY.
 #
          IF NOT EDITING           # IF WE ARE NOT DISPLAYING THIS ITEM# QU3A301
          THEN                                                           QU3A301
            BEGIN                                                        QU3A301
            NUMTOI;                # CONVERT NUMERIC TO INTEGER        # QU3A301
                                   # THIS ASSUMES THAT THE NUMERIC WILL# QU3A301
                                   # FIT INTO THE LOWER 48 BITS OF A   # QU3A301
                                   # 60 BIT WORD ELSE SCALING WILL     # QU3A301
                                   # CAUSE LOSS OF SIGNIFICANCE        # QU3A301
            EXPONENT = DPTLOC[0];  # GET SCALING FACTOR FROM SOURCE    # QU3A301
            GOTO INTNUM1;          # CONVERT INTEGER TO NUMERIC        # QU3A301
                                   # THIS ALLOWS US TO RESCALE NUMERIC # QU3A301
                                   # TO NUMERIC CONVERSIONS WITHOUT    # QU3A301
                                   # THE COMPLICATED CHECKING FOR      # QU3A301
                                   # LEADING/TRAILING ZEROS BEING      # QU3A301
                                   # TRUNCATED.                        # QU3A301
          END 
          FROMATTRIB;              # UNPACK THE SOURCE ATTRIBUTES      # QU3A301
          EXTRACTSIGN;                 # EXTRACT SIGN FROM INPUT FIELD.#
      NUMERICEDIT:                     #                               #001670
          IF MURALADDR NQ 0 THEN       # IF EDIT MURAL PROVIDED, CALL  #001680
          BEGIN                        # NUMERED TO PERFORM EDITING.   #001690
          IF SIGN LS 0 AND (DOVERPUN[0] OR REQUESTCODE NQ 9) THEN 
            BEGIN                                                       001710
              SCRATCHWD[1] = -SCRATCHWD[1];                             001720
              SCRATCHWD[2] = -SCRATCHWD[2];                             001730
            END                                                         001740
            SOURCEWORD = LOC(SCRATCHWD[1]);                             001750
            SOURCELENG = DISPLAYSIZE[0];                                001760
            IF SOURCELENG GR 19 THEN   # SOMEDAY NUMERED SHOULD BE MOD-#001770
              SOURCELENG = 19;         # IFIED TO HANDLE LARGER VALUES.#001780
            NUMERED;                                                    001800
          END                                                           001810
          ELSE                                                          001820
          BEGIN                                                         001830
          J = DPICSIZ[0]; 
            P<TOFLD> = SINKWORD;                                        001890
            CMOVE(SCRATCH,30-J,J,TOFLD,SINKBYTE);                       001900
          END                                                           001910
          RC = RETURNCODE;             # RETURN ERROR CODE.            #
          RETURN; 
  
  
      NUMINT: 
 #
 0        NUMINT - CONVERTS A COMPUTATIONAL FIELD INTO BINARY INTEGER 
                    DATA. 
 #
          INTFLAG = TRUE; 
          GOTO NUMUNNORM1;
  
  
      NUMUNNORM:  
 #
 0        NUMUNNORM - CONVERTS A COMPUTATIONAL VALUE INTO A COMP-1
                    FORMAT. 
 #
          IF EDITING               # DISPLAY FIXED TO BE CONVERTED     # QU3A094
          THEN                                                           QU3A094
            BEGIN                                                        QU3A094
            FROMATTRIB;            # USE SOURCE ATTRIBUTES TO SCALE    # QU3A094
            GOTO CHARUNNORM1;      # COVERT CHAR TO FIXED              # QU3A094
            END                                                          QU3A094
NUMUNNORM1: 
          NUMTOI;                      # CONVERT TO BINARY INTEGER.    #
          J = DPTLOC[0];           # SET SCALE FACTOR FOR PACKANDSCALE # QU3A094
          IF SIGN LS 0 THEN INTEGER = -INTEGER; 
          PACKANDSCALE;                # PACK, SCALE AND STORE VALUE.  #
          RETURN; 
  
  
      NUMSINGLE:  
 #
 0        NUMSINGLE - CONVERTS A COMPUTATIONAL FIELD INTO A BINARY, NOR-
                    MALIZED, FLOATING POINT VALUE.
 #
          IF EDITING               # DISPLAY FLOATING TO BE CONVERTED  # QU3A094
          THEN                                                           QU3A094
            BEGIN                                                        QU3A094
            FROMNUM = TRUE;        # THIS WILL ALLOW SIGN OVERPUNCH FOR# QU3A094
                                   # DISPLAY NUMERIC CONVERSION        # QU3A094
            FROMATTRIB;            # USE SOURCE ATTRIBUTES TO SCALE    # QU3A094
            GOTO CHARSINGLE1;      # COVERT CHAR TO SINGLE             # QU3A094
            END                                                          QU3A094
          NUMTOI;                      # CONVERT TO BINARY INTEGER.    #
          P<TOFLD> = SINKWORD;
          L = ABS(INTEGER); 
          IF B<0,12>L NQ 0 AND         # DIAGNOSE VALUE TRUNCATIONS.   #
             RETURNCODE EQ 0 THEN 
               RETURNCODE = 54; 
          I = -DPTLOC[0];                                               001900
          RC = SIGN;
          TREAL[0] = SCALEINT(INTEGER,I);                               001910
          IF RC LS 0 THEN TREAL[0] = -TREAL[0]; 
          RC = RETURNCODE;
          RETURN; 
  
  
      NUMDOUBLE:  
 #
 0        NUMDOUBLE - CONVERTS A COMPUTATIONAL FIELD INTO A DOUBLE PRE- 
                    CISION FLOATING POINT VALUE.
 #
          IF EDITING               # DISPLAY DOUBLE TO BE CONVERTED    # QU3A094
          THEN                                                           QU3A094
            BEGIN                                                        QU3A094
            FROMNUM = TRUE;        # THIS WILL ALLOW SIGN OVERPUNCH AND# QU3A094
                                   # PERMIT SCALING                    # QU3A094
            FROMATTRIB;            # USE SOURCE ATTRIBUTES TO SCALE    # QU3A094
            GOTO CHARDOUBLE1;      # CONVERT CHAR TO DOUBLE            # QU3A094
            END                                                          QU3A094
  
  
      NUMCOMPLEX: 
 #
 0        NUMCOMPLEX - CONVERTS A COMPUTATIONAL FIELD INTO A BINARY 
                    COMPLEX VALUE.
 #
          IF EDITING               # DISPLAY COMPLEX TO BE CONVERTED   # QU3A094
          THEN                                                           QU3A094
            BEGIN                                                        QU3A094
            FROMNUM = TRUE;        # THIS WILL ALLOW SIGN OVERPUNCH AND# QU3A094
                                   # PERMIT SCALING                    # QU3A094
            FROMATTRIB;            # USE SOURCE ATTRIBUTES TO SCALE    # QU3A094
            GOTO CHARCOMPLEX1;     # CONVERT CHAR TO COMPLEX           # QU3A094
            END                                                          QU3A094
          NUMTOI;                      # CONVERT TO BINARY INTEGER.    #
          P<TOFLD> = SINKWORD;
          IF REQUESTCODE EQ 0 THEN     # CHECK FOR VALUE TRUNCATION.   #
          BEGIN 
            L = ABS(INTEGER); 
            IF B<0,12>L NQ 0 THEN      # DIAGNOSE VALUE TRUNCATIONS.   #
              REQUESTCODE = 54; 
          END 
          I = - DPTLOC[0];                                              001950
          RC = SIGN;
          TREAL[0] = SCALEINT(INTEGER,I);                               001960
          TREAL[1] = 0; 
           IF RC LS 0 THEN BEGIN
              TREAL[0] = -TREAL[0]; TREAL[1] = -TREAL[1]; END 
          RC = RETURNCODE;
          RETURN; 
  
  
      INTNUM:                          #                               #
 #
 0        INTNUM - CONVERTS A BINARY INTEGER INTO COMPUTATIONAL FORMAT. 
 #
          FROMATTRIB;              # UNPACK ATTRIBUTES OF SOURCE       #
          EXPONENT = DPTLOC[0];    # SAVE SCALING FACTOR FROM SOURCE   #
          P<FROMFLD> = SOURCEWORD;
          SIGN = FINTEGER[0]; 
          INTEGER = ABS(SIGN);
INTNUM1:                           # ENTRY FOR CONVERTING INTEGER TO   # QU3A094
                                   # NUMERIC GIVEN:                    # QU3A094
                                   # INTEGER = UNSIGNED INTEGER TO BE  # QU3A094
                                   # CONVERTED.                        # QU3A094
                                   # SIGN = SIGN OF INTEGER.           # QU3A094
                                   # EXPONENT = SCALING FACTOR FROM    # QU3A094
                                   # SOURCE IF ANY.                    # QU3A094
          TOATTRIB;                    # FETCH ATTRIBUTES OF SINK.     #
          RC = SIGN;               # SAVE SIGN                         # QU3A094
          EXPONENT = DPTLOC[0] - EXPONENT;  # ACTUAL SCALING FACTOR    # QU3A094
          IF EXPONENT GR 0         # IF POSITIVE SCALING REQUIRED      # QU3A094
          THEN                     # I.E. PICTURE IS 9.99              # QU3A094
            BEGIN                                                        QU3A094
            INTEGER = SCALEINT(INTEGER,EXPONENT) + FUZZ/2;               QU3A094
            END                                                          QU3A094
          IF EXPONENT LS 0         # IF NEGATIVE SCALING REQUIRED      # QU3A094
          THEN                     # I.E. PICTURE IS 999PP             # QU3A094
            BEGIN                                                        QU3A094
                                   # SCALE AND ROUND INTEGER AND BEWARE#
                                   # OF .999999                        #
            INTEGER = SCALEINT(INTEGER,EXPONENT) + FUZZ/2 + 0.5;
            END                                                          QU3A094
          SIGN = RC;               # RESTORE SIGN                      # QU3A094
          ITONUM; 
          STORESIGN;
          RC = RETURNCODE;
          RETURN; 
  
  
      INTINT:                          #                               #
 #
 0        INTINT - MOVES DATA FROM ONE INTEGER FIELD TO ANOTHER OR EDITS
                    INTEGER DATA FOR OUTPUT.
 #
          FROMATTRIB;              # UNPACK ATTRIBUTES OF SOURCE       #
          INTFLAG = TRUE; 
          P<FROMFLD> = SOURCEWORD;
          P<TOFLD> = SINKWORD;
          INTEGER = FINTEGER[0];
          IF NOT EDITING THEN 
          BEGIN 
            GOTO UNNORMUNNOR2;
            END 
          ELSE
            BEGIN 
            SIGN = FINTEGER[0]; 
            GOTO UNNORMUNNOR1;
            END 
  
  
      INTUNNORM:  
 #
 0        INTUNNORM - CONVERTS A BINARY INTEGER INTO COMP-1 FORMAT. 
 #
          FROMATTRIB;              # UNPACK ATTRIBUTES OF SOURCE       #
          J = DPTLOC[0];           # SAVE SCALING FACTOR FROM SOURCE   #
          P<FROMFLD> = SOURCEWORD;
          INTEGER = FINTEGER[0];       # FETCH SOURCE VALUE.           #
          PACKANDSCALE;                # PACK, SCALE AND STORE VALUE.  #
          RETURN; 
  
  
      INTSINGLE:  
 #
 0        INTSINGLE - CONVERTS BINARY INTEGERS TO NORMALIZED FLOATING 
                    POINT.
 #
          FROMATTRIB;              # UNPACK ATTRIBUTES OF SOURCE       #
          P<FROMFLD> = SOURCEWORD;
          P<TOFLD> = SINKWORD;
          IF DPTLOC[0] NQ 0        # IF MUST SCALE                     #
          THEN
            BEGIN 
            TREAL = SCALEFLT(ABS(FINTEGER)+O"20000000000000000000", 
                             -DPTLOC[0]);  # SCALE BY 10**-DPTLOC      #
            IF FINTEGER LS 0       # IF NEGATIVE                       #
            THEN
              BEGIN 
              TREAL = -TREAL; 
              END 
            END 
          ELSE                     # IF NO SCALING REQUIRED            #
            BEGIN 
            TREAL[0] = FINTEGER[0]; 
            L = ABS(FINTEGER[0]); 
            IF B<0,12> L NQ 0      # DIAGNOSE VALUE TRUNCATIONS        #
            THEN
              BEGIN 
              RETURNCODE = 54;
              END 
            END 
          RC = RETURNCODE;
          RETURN; 
  
  
      INTDOUBLE:  
 #
 0        INTDOUBLE - CONVERTS BINARY INTEGER DATA TO NORMALIZED DOUBLE 
                    PRECISION FLOATING POINT. 
 #
  
  
      INTCOMPLEX: 
 #
 0        INTCOMPLEX - CONVERTS BINARY INTEGER DATA TO BINARY COMPLEX 
                    FORMAT. 
 #
          P<TOFLD> = SINKWORD;
          TREAL[1] = 0; 
          GOTO INTSINGLE; 
  
  
      UNNORMNUM:  
 #
 0        UNNORMNUM - CONVERTS A SCALED COMP-1 VALUE INTO NUMERIC 
                    DISPLAY CODE WITH SIGN OVER-PUNCH.
 #
          FROMATTRIB;                  # UNPACK ATTRIBUTES OF SOURCE.  #
          P<FROMFLD> = SOURCEWORD;     # FETCH SOURCE VALUE, THEN      #
          EXPONENT = DPTLOC[0];    # SAVE SCALING FACTOR FROM SOURCE   # QU3A094
          SIGN = FREAL;            # UNPACK FIXED POINT NUMBER         # QU3A094
          INTEGER = ABS(SIGN);         # REMOVE SIGN.                  #
          GOTO INTNUM1;            # CONVERT INTEGER TO NUMERIC        # QU3A094
  
  
      UNNORMINT:  
 #
 0        UNNORMINT - CONVERTS COMP-1 DATA TO BINARY INTEGER VALUES.
 #
          FROMATTRIB;                  # UNPACK ATTRIBUTES OF SOURCE.  #
          P<FROMFLD> = SOURCEWORD;
          INTEGER = FREAL[0];      # UNPACK SCALED SOURCE              #
          INTFLAG = TRUE;          # PACKANDSCALE WILL WRITE INTEGER   #
          GOTO UNNORMUNNOR2;
  
  
      UNNORMUNNORM:                    #                               #
 #
 0        UNNORMUNNORM - MOVE COMP-1 DATA FROM ONE FIELD TO ANOTHER,
                    CORRECTING FOR SCALE. 
 #
          FROMATTRIB;                  # UNPACK ATTRIBUTES OF SOURCE.  #
          P<FROMFLD> = SOURCEWORD;
          INTEGER = FREAL[0];          # UNPACK SCALED SOURCE.         #
          IF EDITING THEN              # IF EDITING OUTPUT, CONVERT TO #002000
          BEGIN                        # DISPLAY AND EDIT.             #002010
            SIGN = INTEGER;                                             002020
UNNORMUNNOR1: 
            INTEGER = ABS(INTEGER);                                     002030
            SINKLENG = DISPLAYSIZE[0];  # PIC SIZE LESS INSERTED CHARS #
            ITONUM;                                                     002040
            GOTO NUMERICEDIT;                                           002070
          END                                                           002080
UNNORMUNNOR2: 
          J = DPTLOC[0];               # SAVE SCALE FACTOR FOR SOURCE. #
          PACKANDSCALE;                # PACK, SCALE AND STORE VALUE.  #
          RETURN; 
  
  
      UNNORMSGL:  
 #
 0        UNNORMSGL - CONVERTS COMP-1 DATA TO NORMALIZED, UNSCALED
                    VALUES. 
 #
          FROMATTRIB;                  # UNPACK ATTRIBUTES OF SOURCE.  #
          P<TOFLD> = SINKWORD;
      UTOE: 
          P<FROMFLD> = SOURCEWORD;
          TREAL[0] = SCALEFLT(FREAL[0],-DPTLOC[0]);#SCALE BY 10**-PTLOC#002120
          RC = RETURNCODE;         # RETURN CODE " 0 IF ERROR          #
          RETURN; 
  
  
      UNNORMDBL:  
 #
 0        UNNORMDBL - CONVERTS COMP-1 DATA TO UNSCALED DOUBLE PRECISION 
                    FLOATING POINT VALUES.
 #
      UNNORMCPLX: 
 #
 0        UNNORMCPLX - CONVERTS COMP-1 DATA TO UNSCALED COMPLEX FLOATING
                    POINT VALUES. 
 #
          FROMATTRIB;                  # UNPACK ATTRIBUTES OF SOURCE.  #
          P<TOFLD> = SINKWORD;
          TREAL[1] = 0;                # STORE IN SINK FIELD.          #
          GOTO UTOE;
  
  
      SINGLENUM:  
 #
 0        SINGLENUM - CONVERTS NORMALIZED FLOATING POINT BINARY DATA
                    TO COMPUTATIONAL DATA.
 #
          P<FROMFLD> = SOURCEWORD;
          MANTISSA = FREAL;        # NUMBER TO BE CONVERTED            # QU3A094
          TOATTRIB;                    # FETCH ATTRIBUTES OF SINK.     #
SGLENUM1:                          # USED FOR CONVERTING THE FLOATING  # QU3A094
                                   # NUMBER IN DOUBLE TO NUMERIC FORMAT# QU3A094
                                   # MANTISSA = NUMBER TO CONVERT      # QU3A094
          DOUBLE = MANTISSA;                                             QU3A094
          EXPONENT = DPTLOC[0];    # SET SCALING FACTOR                # QU3A094
          IF EXPONENT NQ 0         # IF SCALING IS REQUIRED            # QU3A094
          THEN                                                           QU3A094
            BEGIN                                                        QU3A094
            IF DOUBLE LS 0         # BEWARE THE -19.99999999 CASES     # QU3A094
            THEN                                                         QU3A094
              BEGIN                                                      QU3A094
              DOUBLE = SCALEFLT(DOUBLE,EXPONENT) - FUZZ/2;               QU3A094
              END                                                        QU3A094
            ELSE                                                         QU3A094
              BEGIN                                                      QU3A094
              DOUBLE = SCALEFLT(DOUBLE,EXPONENT) + FUZZ/2;               QU3A094
              END                                                        QU3A094
            IF RETURNCODE NQ 0     # IF ERROR                          #
            THEN
              BEGIN 
              RC = RETURNCODE;     # SET ERROR CODE                    #
              RETURN;              # QUIT                              #
              END 
            END                                                          QU3A094
          IF EXPONENT LS 0         # IF NEGATIVE SCALING IS REQUIRED   # QU3A094
          THEN                                                           QU3A094
            BEGIN                                                        QU3A094
            INTEGER = DOUBLE;                                            QU3A094
            IF ABS(MANTISSA - SCALEINT(INTEGER,-EXPONENT)) GR FUZZ       QU3A094
            THEN                   # IF WE ARE TRUNCATING THE DATA     # QU3A094
              BEGIN                                                      QU3A094
              RETURNCODE = 54;     # DIAGNOSE DATA TRUNCATION          # QU3A094
              END                                                        QU3A094
            END                                                          QU3A094
          IF DOUBLE LS 0           # IF A NEGATIVE NUMBER ROUND DOWN   #
          THEN
            BEGIN 
            SIGN = -1;             # SET FLAG FOR NEGATIVE NUMBER      # QU3A094
            INTEGER = DOUBLE - 0.5;  # CONVERT REAL TO INTEGER         # QU3A094
            END 
          ELSE
            BEGIN 
            SIGN = 1;              # SET FLAG FOR POSITIVE NUMBER      # QU3A094
            INTEGER = DOUBLE + 0.5;  # CONVERT REAL TO INTEGER         # QU3A094
            END 
          MANTISSA = INTEGER;      # CONVERT INTEGER TO REAL           # QU3A094
          INTEGER = ABS(INTEGER);  # INTEGER MUST BE POSITIVE          # QU3A094
          ITONUM;                      # CONVERT TO DISPLAY CODE.      #
          STORESIGN;
          RC = RETURNCODE;
          RETURN; 
  
  
      SINGLEINT:  
 #
 0        SINGLEINT - CONVERTS A REAL VALUE TO A BINARY INTEGER.
 #
          IF EDITING THEN 
            GOTO BADREQUEST;
          INTFLAG = TRUE; 
          GOTO SGLUNNORM; 
  
  
      SGLUNNORM:  
 #
 0        SGLUNNORM - CONVERTS UNSCALED FLOATING POINT DATA TO SCALED 
                    COMP-1 VALUES.
 #
          P<FROMFLD> = SOURCEWORD;
      ETOU: 
          TOATTRIB;                    # UNPACK ATTRIBUTES OF SINK.    #
          P<TOFLD> = SINKWORD;
          J = DPTLOC[0];               # FETCH SCALE FACTOR OF SINK.   #
          IF J LQ 0                # IF DECIMAL POINT IS TO THE RIGHT  #
          THEN
            BEGIN 
                                   # SCALE BY 10**J AND ROUND UP       #
            INTEGER = SCALEFLT(ABS(FREAL),J) + FUZZ/2 + 0.5;
            END 
          ELSE
            BEGIN 
            INTEGER = SCALEFLT(ABS(FREAL),J) + FUZZ/2;  #SCALE BY 10**J#
            END 
          IF RETURNCODE NQ 0       # IF ERROR                          #
          THEN
            BEGIN 
            RC = RETURNCODE;       # SET ERROR CODE                    #
            RETURN;                # QUIT                              #
            END 
          IF B<0,12>INTEGER NQ 0
          THEN                     # DATA TRUNCATION WILL OCCUR        # QU3A094
            RETURNCODE = 54;           # DURING SCALING.               #
          RC = RETURNCODE;
          B<0,60>MANTISSA = B<12,48>INTEGER;
          IF NOT INTFLAG
          THEN
            BEGIN 
            B<0,12>MANTISSA = O"2000";
            END 
          IF FREAL LS 0            # IF ARGUMENT WAS NEGATIVE          # QU3A094
          THEN                                                           QU3A094
            TREAL[0] = -MANTISSA;      # STORE RESULT IN SINK FIELD.   #
          ELSE TREAL[0] = MANTISSA; 
          RETURN; 
  
  
      SGLSINGLE:  
 #
 0        SGLSINGLE - CONVERTS FLOATING POINT BINARY TO EDITED DISPLAY
                    CODE OR MOVES A VALUE FROM ONE FIELD TO ANOTHER.
 #
          P<TOFLD> = SINKWORD;
          IF EDITING THEN 
          BEGIN 
            FROMATTRIB; 
      SGLEDIT:                                                          002200
            IF MURALADDR EQ 0 THEN     # DEFAULT FLOATING PT MURAL IS  #002210
          BEGIN IF (DISPLAYSIZE[0] EQ 0 AND DPICSIZ[0] EQ 0)
              OR DPOINT[0] THEN    # PICK UP DEFAULT MURAL             #
              MURALADDR = LOC(FLTMURAL);# -9(12).99                    #002220
            ELSE                                                        000140
            BEGIN ITEM TEMPMURAL;                                       000150
                  ITEM OCT7 = O"77777777777777777777";                  000160
                  TEMPMURAL = O"41000000000000000001";                  000170
                  K = DPICSIZ[0]-1;                                     000180
          IF REQUESTCODE EQ O"54" THEN K=K/2-1; 
           IF K GR 0 THEN                                               000190
                  B<13,K>TEMPMURAL = B<0,K>OCT7;                        000200
             ELSE TEMPMURAL = O"40100000000000000001";
                  MURALADDR=LOC(TEMPMURAL);                             000220
            END                                                         000230
      END                                                               000240
      FLTEDIT:                                                          002230
            P<FROMFLD> = SOURCEWORD;                                    002240
            K = DISPLAYSIZE[0];                                         002250
            SINKLENG = K + 7;          # 7 PLACES FOR +.N...NE+XXX     #002260
            IF DPTLOC[0] LS 0 THEN     # INCREASE SIZE IF SCALED.      #002270
              SINKLENG = SINKLENG - DPTLOC[0];                          002280
            IF SINKLENG GR 25 THEN                                      002290
              SINKLENG = 25;           # 18 SIGNIFICANT DIGITS MAX.    #002300
            ELSE IF SINKLENG LS 18 THEN #GET AT LEAST 11 SIGNIFICANT   #
                   SINKLENG = 18;      # DIGITS TO AVOID UNNECESSARY   #
                                       # ROUNDING.                     #
            QU2KOD(P<BSTATUS>);    # CONVERT TO DISPLAY CODE           #
                                   # QU2KOD WILL RETURN ADDRESS OF     #
                                   # BASED ARRAY BSTATUS               #
            SCRATCHWD[0] = O"33333333333333333333";                     002330
            SCRATCHWD[1] = O"33333333333333333333";                     002340
            L = 12;                    # PROCEED TO ALIGN DECIMAL POINT#002350
            SOURCELENG = K;                                             002360
          I = SOURCELENG;                                               001430
            J = SOURCELENG - DPTLOC[0];                                 002370
            IF J LS EXPONENT THEN      # EXPONENT = SOURCE SCALE FACTOR#002390
            BEGIN                                                       002400
            RETURNCODE = 54;       # DIAGNOSE DATA TRUNCATION          #
              L = L + EXPONENT - J;                                     002410
              J = SOURCELENG - (SINKLENG - 7) - (L - 12); 
              IF J GR 0 THEN
                SOURCELENG = SOURCELENG - J;
              I = K;
            END                                                         002440
            ELSE IF J GR EXPONENT THEN                                  002450
                 BEGIN
                   SOURCELENG = SOURCELENG - (J - EXPONENT);            002460
                   I = SOURCELENG;
                 END
          IF SOURCELENG GQ 0       # IF ANY SIGNIFICANT DIGITS CAN     #
                                   # EXIST (AFTER POSSIBLE ROUNDING)   #
          THEN
            BEGIN 
                                   # RIGHT JUSTIFY SIGNIFICANT DIGITS  #
                                   # INTO FIRST 2 WORDS OF SCRATCH AREA#
            CMOVE(BSTATUS, L, SOURCELENG + 1, SCRATCH, 20 - I); 
            IF C<0,1>SCRATCHWD[2] GQ "5"  # IF ROUNDING NEEDED...      #
            THEN
              BEGIN 
              FINISHED = FALSE;    # WE HAVENT FINISHED ROUNDING YET   #
              FOR I = 1 STEP -1    # FOR EACH SCRATCH WORD             #
              WHILE I GQ 0         # UNTIL FIRST SCRATCH WORD USED     #
                AND NOT FINISHED   # WHILE STILL ROUNDING              #
              DO
                BEGIN 
                FOR J = 9 STEP -1  # FOR EACH CHARACTER (RIGHT TO LEFT)#
                WHILE J GQ 0       # UNTIL LEFTMOST CHAR PROCESSED     #
                  AND NOT FINISHED # WHILE STILL ROUNDING              #
                DO
                  BEGIN 
                  L = C<J,1>SCRATCHWD[I];  # EXTRACT NEXT DIGIT CHAR.  #
                  IF L LS "9"      # IF LAST CARRY DOESNT CAUSE OVERFLO#
                  THEN
                    BEGIN          # NO CARRY PRODUCED                 #
                    L = L + 1;     # ADD IN PREVIOUS CARRY             #
                    FINISHED = TRUE;  # WERE DONE WITH ROUNDING        #
                    END 
                  ELSE
                    BEGIN          # CARRY PRODUCED                    #
                    L = "0";       # RESULT IS 10, STORE 0, CARRY 1    #
                    END 
                  C<J,1>SCRATCHWD[I] = L;  # STORE BACK DIGIT CHARACTER#
                  END              # END OF CHARACTER LOOP             #
                END                # END OF WORD LOOP                  #
              END                  # FINIS^ED WITH ROUNDING            #
            END                    # FINISHED WITH ALLIGNING NUMBER    #
          IF K GR 20 THEN 
          BEGIN K = K - 20; 
                SINKBYTE = SINKBYTE + K;
                IF SINKBYTE GR 9 THEN 
                BEGIN K = SINKBYTE / 10;
                      SINKWORD = SINKWORD + K;
                      SINKBYTE = SINKBYTE - K * 10; 
                END 
                K = 20; 
          END 
            SOURCELENG = K;                                             002530
            IF FREAL[0] LS 0 THEN                                       002540
            BEGIN                                                       002550
              SCRATCHWD[0] = -SCRATCHWD[0];                             002560
              SCRATCHWD[1] = -SCRATCHWD[1];                             002570
            END                                                         002580
            SOURCEWORD = LOC(SCRATCH);                                  002590
            NUMERED;                   # CALL EDITING ROUTINE.         #002610
            IF REQUESTCODE EQ O"54" THEN # IF EDITING A COMPLEX NUMBER #002620
              GOTO CPLXEDIT;           # DO IMAGINARY PART NEXT.       #002630
          END 
          ELSE
          BEGIN 
            P<FROMFLD> = SOURCEWORD;
            TREAL[0] = FREAL[0];
          END 
          RC = RETURNCODE;                                              002650
          RETURN; 
  
  
      SGLDOUBLE:  
 #
 0        SGLDOUBLE - CONVERTS SINGLE PRECISION TO DOUBLE PRECISION.
 #
  
  
      SGLCOMPLEX: 
 #
 0        SGLCOMPLEX - CONVERTS SINGLE PRECISION FLOATING POINT TO
                    COMPLEX FORMAT. 
 #
          IF EDITING THEN 
            GOTO BADREQUEST;
          P<FROMFLD> = SOURCEWORD;
          P<TOFLD> = SINKWORD;
          TREAL[0] = FREAL[0];
          TREAL[1] = 0; 
          RC = 0; 
          RETURN; 
  
  
      DOUBLENUM:  
 #
 0        DOUBLENUM - CONVERTS DOUBLE PRECISION FLOATING POINT VALUES TO
                    COMPUTATIONAL DATA. 
 #
  
  
      COMPLEXNUM: 
 #
 0        COMPLEXNUM - CONVERTS BINARY COMPLEX VALUES TO COMPUTATIONAL
                   DATA.
 #
          P<FROMFLD> = SOURCEWORD;
          IF FREAL[1] NQ 0         # IF IMAGINARY PART OR LOWER HALF IS#
          THEN                     # NON-ZERO THEN CONVERSION ERROR    #
            BEGIN 
            RETURNCODE = 54;       # DATA CONVERSION ERROR             #
            END 
          GOTO SINGLENUM;          # USE SINGLE TO NUMERIC CONVERSION  #
  
  
      DOUBLEINT:  
 #
 0        DOUBLEINT - CONVERTS DOUBLE PRECISION FLOATING POINT VALUES TO
                    BINARY INTEGER. 
 #
  
  
  
  
      COMPLEXINT: 
 #
 0        COMPLEXINT - CONVERTS BINARY COMPLEX VALUES TO BINARY 
                    INTEGERS. 
 #
          IF EDITING THEN 
            GOTO BADREQUEST;
          P<FROMFLD> = SOURCEWORD;
          IF FREAL[1] NQ 0         # IF IMAGINARY PART OR LOWER HALF IS#
          THEN                     # NON-ZERO THEN CONVERSION ERROR    #
            BEGIN 
            RC = 54;               # DATA CONVERSION ERROR             #
            END 
          INTFLAG = TRUE; 
          GOTO SGLUNNORM; 
  
  
      DBLUNNORM:  
 #
 0        DBLUNNORM - CONVERTS UNSCALED DOUBLE PRECISION FLOATING POINT 
                    DATA TO SCALED COMP-1 VALUES. 
 #
      CPLXUNNORM: 
 #
 0        CPLXUNNORM - CONVERTS UNSCALED COMPLEX FLOATING POINT DATA TO 
                    SCALED COMP-1 VALUES. 
 #
          P<FROMFLD> = SOURCEWORD;
          MANTISSA = ABS(FREAL[1]); 
          IF B<12,48>MANTISSA NQ 0 THEN # DIAGNOSE VALUE TRUNCATION IF #
            RETURNCODE = 54;           # MORE THAN 48 SIGNIFICANT BITS.#
          GOTO ETOU;                   # GO HANDLE 1ST WORD OF SOURCE. #
  
  
      DBLSINGLE:  
 #
 0        DBLSINGLE - CONVERTS DOUBLE PRECISION FLOATING POINT VALUES TO
                    SINGLE PRECISION. 
 #
  
  
      CPLXSINGLE: 
 #
 0        CPLXSINGLE - CONVERTS BINARY COMPLEX VALUES TO SINGLE 
                    PRECISION REAL VALUES.
 #
          IF EDITING THEN 
            GOTO BADREQUEST;
          P<FROMFLD> = SOURCEWORD;
          P<TOFLD> = SINKWORD;
          TREAL[0] = FREAL[0];         # STORE RESULT IN SINK FIELD.   #
          DOUBLE = ABS(FREAL[1]); 
          IF B<12,48>DOUBLE NQ 0 THEN 
            RC = 54;
          ELSE RC = 0;
          RETURN; 
  
  
      DBLDOUBLE:  
 #
 0        DBLDOUBLE - MOVES DATA FROM ONE DOUBLE PRECISION FIELD TO 
                    ANOTHER OR EDITS A DOUBLE PRECISION FIELD FOR 
                    DISPLAY.
 #
          P<TOFLD> = SINKWORD;
          IF EDITING THEN 
          BEGIN 
            FROMATTRIB;                # UNPACK ATTRIBUTES OF DATA.    #
            GOTO SGLEDIT; 
          END                                                           002700
          ELSE
          BEGIN 
            P<FROMFLD> = SOURCEWORD;
            TREAL[0] = FREAL[0];
            TREAL[1] = FREAL[1];
          END 
          RC = 0; 
          RETURN; 
  
  
      DBLCOMPLEX: 
 #
 0        DBLCOMPLEX - CONVERTS DOUBLE PRECISION FLOATING POINT TO
                    BINARY COMPLEX. 
 #
  
  
      CPLXDOUBLE: 
 #
 0        CPLXDOUBLE - CONVERTS BINARY COMPLEX VALUES TO DOUBLE PRE-
                    CISION FLOATING POINT.
 #
          IF EDITING THEN 
            GOTO BADREQUEST;
          P<FROMFLD> = SOURCEWORD;
          P<TOFLD> = SINKWORD;
          TREAL[0] = FREAL[0];         # STORE RESULT IN SINK FIELD.   #
          TREAL[1] = 0; 
          MANTISSA = ABS(FREAL[1]); 
          IF B<12,48>MANTISSA NQ 0 THEN # DIAGNOSE VALUE TRUNCATIONS.  #
            RC = 54;
          ELSE RC = 0;
          RETURN; 
  
  
      CPLXCOMPLEX:                     #                               #
 #
 0        CPLXCOMPLEX - MOVES DATA FROM ONE BINARY COMPLEX FIELD TO 
                    ANOTHER OR EDITS A BINARY COMPLEX FOR DISPLAY.
 #
          IF NOT EDITING THEN 
            GOTO DBLDOUBLE; 
          FROMATTRIB;                  # EXTRACT ATTRIBUTES OF SOURCE. #002720
          SOURCEBYTE = SOURCEWORD;     # SAVE SOURCE ADDRESS.          #002730
          GOTO SGLEDIT;                                                 002740
      CPLXEDIT:                                                         002750
          SOURCEWORD = SOURCEBYTE + 1; # ADDRESS OF IMAGINARY HALF.    #002760
          P<TOFLD> = SINKWORD;                                          002770
          J = DPICSIZ[0] / 2 +SINKBYTE; 
          CMOVE("I",0,1,TOFLD,J);      # MOVE "I" TO SINK.             #002790
          SINKBYTE = J + 1;                                             002800
          IF SINKBYTE GR 9 THEN 
          BEGIN                                                         002820
            J = SINKBYTE / 10;                                          002830
            SINKWORD = SINKWORD + J;                                    002840
            SINKBYTE = SINKBYTE - J * 10;                               002850
          END                                                           002860
          REQUESTCODE = 0;                                              002870
          GOTO FLTEDIT;                                                 002880
  
  
  
  
      LOGLOGICAL: 
 #
 0        LOGLOGICAL - MOVES LOGICAL DATA FROM ONE FIELD TO ANOTHER OR
                    EDITS A LOGICAL VALUE FOR DISPLAY.
 #
          IF EDITING THEN 
          BEGIN 
            FROMATTRIB;                # EXTRACT ATTRIBUTES OF FIELD.  #
            P<FROMFLD> = SOURCEWORD;
            IF FWA[0] NQ 0 THEN 
              SOURCEWORD = LOC(TRUECHARS);
            ELSE SOURCEWORD = LOC(FALSECHARS);
            SOURCELENG = 5; 
            GOTO LOGCHAR;              # MOVE CHARS TO SINK.           #
          END 
          P<FROMFLD> = SOURCEWORD;
          P<TOFLD> = SINKWORD;
          TINTEGER[0] = FINTEGER[0];
          RC = 0; 
          RETURN; 
  
  
  
  
      PROC FROMATTRIB;
 #
 0        FROMATTRIB - UNPACKS INFORMATION FROM THE ATTRIBUTES ENTRY
                    POINTED TO BY SOURCEWORD INTO THE SOURCE ITEMS OF 
                    THE CCONVERT COMMON AREA. 
 #
          BEGIN 
          SOURCEATTRIB = FROMWORD[0]; 
          P<DESATT1> = SOURCEATTRIB;
          SOURCEWORD = DEWPOS[0] + SOURCEWORD - SOURCEATTRIB;#FACTOR   #
                                       # OUT BASE ADDRESS FROM SOURCEWD#
          SOURCEBYTE = DBITPOS[0]/6;
          SOURCELENG = DECLSLG[0];
          IF EDITING THEN              # IF EDITING DESIRED THEN STORE #
            IF MURALPTR[0] EQ 0 THEN   # MURAL ADDRESS.                #
              MURALADDR = 0;           # USE DEFAULT MURAL.            #
            ELSE MURALADDR = MURALPTR[0] + P<DESATT1>;
          ELSE MURALADDR = -1;
          RETURN; 
          END 
  
  
      PROC TOATTRIB;
 #
 0        TOATTRIB - UNPACKS INFORMATION FROM THE ATTRIBUTES ENTRY
                    POINTED TO BY SINKWORD INTO THE SINK ITEMS OF THE 
                    CCONVERT COMMON AREA. 
 #
          BEGIN 
          SINKATTRIB = TOWORD[0]; 
          P<DESATT1> = SINKATTRIB;
          SINKWORD = DEWPOS[0] + SINKWORD - SINKATTRIB;# FACTOR OUT    #
                                       # BASE ADDRESS FROM SINKWORD.   #
          SINKBYTE = DBITPOS[0]/6;
          SINKLENG = DECLSLG[0];
          RIGHTJUST = JUSTRIGHT;   # TRUE IF JUSTIFIED RIGHT           #
          RETURN; 
          END 
  
  
      PROC EXTRACTSIGN; 
 #
 0        EXTRACTSIGN - REMOVES ANY SIGN OVERPUNCH FROM THE SOURCE DATA,
                    STORING THE SIGN IN "SIGN" AND THE SIGN-LESS DATA 
                    IN "SCRATCH", RIGHT-JUSTIFIED.
 #
          BEGIN 
          SCRATCHWD[0] = O"33333333333333333333"; 
          SCRATCHWD[1] = O"33333333333333333333"; 
          SCRATCHWD[2] = O"33333333333333333333"; 
          IF SOURCELENG GR 18      # MAX SIZE FOR NUMERIC IS 18 DIGITS # QU3A094
          THEN                                                           QU3A094
            BEGIN                                                        QU3A094
            RETURNCODE = 54;       # DATA TRUNCATION                   # QU3A094
            SOURCELENG = 18;       # USE MAX NUMBER OF DIGITS          # QU3A094
            END                                                          QU3A094
          P<FROMFLD> = SOURCEWORD;
          CMOVE(FROMFLD,SOURCEBYTE,SOURCELENG,SCRATCH,30-SOURCELENG); 
          SOURCEBYTE = 30 - SOURCELENG;  # NEW STARTING CHAR POSITION  # QU3A094
          SOURCEWORD = LOC(SCRATCH);  # NEW STARTING WORD POSITION     # QU3A094
          FOR SOURCEWORD = SOURCEWORD STEP 1                             QU3A094
            WHILE SOURCEBYTE GR 9  # CHAR POSITION MUST BE 0 TO 9      # QU3A094
          DO                                                             QU3A094
            BEGIN                                                        QU3A094
            SOURCEBYTE = SOURCEBYTE - 10;  # SKIP OVER 10 CHARACTERS   # QU3A094
            END                                                          QU3A094
          SIGN = +1;
          CHAR = B<54,6>SCRATCHWD[2]; 
          IF CHAR GQ O"33" AND
             CHAR LQ O"44" THEN 
               RETURN;
          IF CHAR GQ O"01" AND
             CHAR LQ O"11" THEN 
               CHAR = CHAR + O"33"; 
          ELSE IF CHAR GQ O"12" AND 
                  CHAR LQ O"22" THEN
               BEGIN
                 CHAR = CHAR + O"22"; 
                 SIGN = -1; 
               END
               ELSE IF CHAR EQ O"72" THEN 
                      CHAR = O"33"; 
                    ELSE IF CHAR EQ O"66" THEN
                         BEGIN
                           CHAR = O"33";
                           SIGN = -1; 
                         END
                         ELSE 
                           BEGIN
                           IF CHAR EQ O"55"     # IF LAST CHAR IS BLANK#
                           THEN 
                             BEGIN
                             CHAR = O"33";      # MOVE ZERO TO CHAR    #
                             END
                           ELSE 
                             BEGIN
                             RETURNCODE = 51;   # INVALID CHARACTER    #
                             END
                           END
          B<54,6>SCRATCHWD[2] = CHAR; 
          RETURN; 
          END 
  
  
      PROC STORESIGN; 
 #
 0        STORESIGN - STORES AN OVERPUNCHED SIGN IN THE PROPER POSITION 
                    IN "SCRATCH" AND MOVES THE NUMERIC DATA FROM
                    "SCRATCH" TO THE SINK FIELD.
 #
          BEGIN 
          # AN OVERPUNCH IS SET ATOP THE LAST DIGIT AS FOLLOWS. 
        IF NUMBER IS      AND LAST DIGIT IS     THEN LAST DIGIT BECOMES 
          POSITIVE            1 TO 9                  O"01" TO O"11"
          NEGATIVE            1 TO 9                  O"12" TO O"22"
          POSITIVE            0                       O"72" 
          NEGATIVE            0                       O"66"      #
          CHAR = B<54,6>SCRATCHWD[2]; 
          IF DOVERPUN[0] THEN BEGIN 
          IF SIGN GR 0 THEN 
          BEGIN 
            IF CHAR EQ O"33" THEN 
              CHAR = O"72"; 
            ELSE CHAR = CHAR - O"33"; 
          END 
          ELSE IF CHAR EQ O"33" THEN
                 CHAR = O"66";
               ELSE CHAR = CHAR - O"22";
          B<54,6>SCRATCHWD[2] = CHAR; 
          END 
          P<TOFLD> = SINKWORD;
          CMOVE(SCRATCH,30-SINKLENG,SINKLENG,TOFLD,SINKBYTE); 
          RETURN; 
          END 
  
          PROC CHKOVERPUN;
          BEGIN 
                IF DOVERPUN[0] THEN 
                BEGIN IF CHAR GR O"33" AND CHAR LS O"45" THEN 
                                   CHAR = CHAR - O"33"; 
                      ELSE IF CHAR EQ O"33" THEN CHAR = O"72";
                END 
                ELSE
                BEGIN IF CHAR LS O"12" AND CHAR GR 0 THEN 
                                   CHAR = CHAR + O"33"; 
                      ELSE IF CHAR GR O"11" AND CHAR LS O"23" THEN
                         CHAR = CHAR + O"22"; 
                      ELSE IF CHAR EQ O"66" OR CHAR EQ O"72" THEN 
                           CHAR = O"33";
                END 
          END 
  
      PROC ITONUM;
 #
 0        ITONUM - PROCEDURE FOR CONVERTING BINARY INTEGERS TO DISPLAY
                    CODE CHARACTERS.
 #
          BEGIN 
          SCRATCHWD[0] = O"33333333333333333333"; 
          SCRATCHWD[1] = O"33333333333333333333"; 
          SCRATCHWD[2] = O"33333333333333333333"; 
          J = 2;
          L = 54; 
          FOR SOURCELENG=1 STEP 1 DO
          BEGIN 
            QUOTIENT = INTEGER / 10;
            B<L,6>SCRATCHWD[J] = INTEGER - QUOTIENT*10 + O"33"; 
            IF L LQ 0 THEN
            BEGIN 
              J = J - 1;
              L = 54; 
            END 
            ELSE
              L = L - 6;
            IF QUOTIENT EQ 0 THEN 
              GOTO FOREXIT; 
            INTEGER = QUOTIENT; 
          END 
      FOREXIT:  
          IF SOURCELENG GR SINKLENG THEN #DIAGNOSE VALUES THAT WON"T   #
          BEGIN                        # FIT IN THE SINK FIELD.        #
            RETURNCODE = 54;
            SOURCELENG = SINKLENG;
          END 
          RETURN; 
          END 
  
  
      PROC NUMTOI;
 #
 0        NUMTOI - PROCEDURE FOR CONVERTING COMPUTATIONAL VALUES TO 
                    BINARY INTEGERS.
 #
          BEGIN 
          FROMATTRIB;                  # EXTRACT ATTRIBUTES OF FIELD.  #
          L = +1; 
          IF EDITING THEN 
          BEGIN                        # HAVE TO SKIP LEADING BLANKS.  #
            P<FROMFLD> = 0; 
      NEXTCHAR: 
            GETCHAR;                   # GET NEXT SOURCE CHAR.         #
            IF SOURCELENG LS 0 THEN  # IF ENTIRE FIELD WAS BLANK       #
              BEGIN 
              INTEGER = 0;           # MOVE 0 TO INTEGER               #
              RETURN; 
              END 
            IF CHAR EQ O"55" THEN 
              GOTO NEXTCHAR;
            IF SOURCEBYTE EQ 0 THEN    # RESET BYTE AND WORD POINTERS. #
            BEGIN 
              SOURCEBYTE = 9; 
              SOURCEWORD = SOURCEWORD - 1;
            END 
            ELSE SOURCEBYTE = SOURCEBYTE - 1; 
          SOURCELENG = SOURCELENG + 1;
            IF CHAR EQ O"45" THEN      # SKIP LEADING PLUS SIGN.       #
              GETCHAR;             # SKIP THIS CHARACTER               # QU3A094
            IF CHAR EQ O"46" THEN      # NOTE LEADING MINUS SIGN.      #
            BEGIN 
              L = -1; 
              GETCHAR;             # SKIP THIS CHARACTER               # QU3A094
            END 
          END 
          EXTRACTSIGN;                 # REMOVE SIGN OVER-PUNCH.       #
          IF L LS 0 THEN               # IF LEADING "-" THEN CHECK FOR #
          BEGIN                        # SIGN OVERPUNCH ALSO.          #
            IF SIGN LS 0 THEN          # DIAGNOSE DUPLICATE SIGNS.     #
              RETURNCODE = 55;
            SIGN = -1;
          END 
          P<FROMFLD> = 0;                                                QU3A094
          FOR INTEGER = 0          # START WITH INTEGER = 0            # QU3A094
            WHILE SOURCELENG GR 0  # LOOP THRU EACH DIGIT              # QU3A094
          DO                                                             QU3A094
          BEGIN 
            GETCHAR;                   # GET NEXT SOURCE CHAR (SCRATCH)#
            IF CHAR EQ O"55"       # IF SOURCE CHAR IS A BLANK         #
              AND RETURNCODE EQ 0  # AND ITS A LEADING BLANK BECAUSE   #
                                   # EXTRACTSIGN DID NOT SET RETURNCODE#
            THEN
              BEGIN 
              L = 0;               # TREAT BLANK AS A ZERO             #
              END 
            ELSE
              BEGIN 
              L = CHAR - O"33";    # SUBTRACT DIS CODE FOR 0 FROM CHAR #
              END 
            IF L LS 0 OR L GQ 10 THEN  # DIAGNOSE INVALID NUMERIC DATA.#
              RETURNCODE = 55;
            INTEGER = INTEGER * 10 + L; 
          END 
          RETURN; 
          END 
  
  
      PROC PACKANDSCALE;
 #
 0    PACKANDSCALE - SCALES A BINARY VALUE ACCORDING TO THE PICTURE OF
                    THE SINK FIELD, THEN PACKS THE SCALED VALUE AS AN 
                    UNNORMALIZED FLOATING POINT REPRESENTATION OF AN
                    INTEGER AND STORES IT INTO THE SINK FIELD.
 #
          BEGIN 
          TOATTRIB;                    # UNPACK ATTRIBUTES OF SINK.    #
          K = ABS(INTEGER); 
          I = DPTLOC[0] + (EXPONENT - J);# IF SCALE DIFFERS FROM ITEM  #
                                         # DESCRIPTION, MUST ADJUST.   #
          IF I GR 0                # IF SCALING BUT NO ROUNDING REQUIRD#
          THEN
            BEGIN 
            MANTISSA = SCALEINT(K,I) + FUZZ/2;  # SCALE BY 10**I       #
            K = ABS(MANTISSA);
            END 
          IF I LS 0                # IF ROUNDING AND SCALING REQUIRED  #
          THEN
            BEGIN 
            MANTISSA = SCALEINT(K,I) + FUZZ/2 + 0.5;  # SCALE BY 10**J #
                                                      # AND ROUND UP   #
            K = ABS(MANTISSA);
            END 
          P<TOFLD> = SINKWORD;
          TWA[0] = B<12,48>K;      # STORE SCALED VALUE IN SINK FIELD  #
          IF NOT INTFLAG           # IF WRITING UNNORM FLOATING POINT  #
          THEN
            BEGIN 
            TWA[0] = TWA[0] + O"20000000000000000000";
            END 
          IF INTEGER LS 0 THEN         # IF SIGN IS NEGATIVE THEN COM- #002970
            TREAL[0] = -TREAL[0];      # PLEMENT THE VALUE.            #
          RC = RETURNCODE;
          RETURN; 
          END 
                                                                        0004   5
  
  
      PROC DISPLAYTOBIN;
 #
 0        DISPLAYTOBIN - PROCEDURE FOR CONVERTING DISPLAY CODED NUMERIC 
                    VALUES TO BINARY CODED VALUES.
 #
          BEGIN 
                 MANTISSA=0.0;  PERIOD=FALSE;  NEGMANTISSA=FALSE;       0004  11
          EXPONSIGN = FALSE;
          MANTSIGN = FALSE; 
          NEGEXPONENT = FALSE;
          P<FROMFLD> = 0;              # SUBSCRIPTED BY "SOURCEWORD".  #
          P<TOFLD> = SINKWORD;
          UPPERINT = 0; 
          LOWERINT = 0; 
          FLAGE = FALSE;
          FLAGD = FALSE;
          J = 0;
          LEADING$BLNK = TRUE;     # LEADING BLANKS POSSIBLE           #
      NEXTCHAR: 
          IF SOURCELENG LS 1 THEN      # CHECK FOR END OF SOURCE INPUT.#
            GOTO PACKBINARY;
          GETCHAR;                     # GET NEXT SOURCE CHARACTER.    #
                                       # INTERPRET CHARACTER.          #
          IF FROMNUM AND SOURCELENG EQ 0 THEN 
          BEGIN 
          IF CHAR GQ O"01" AND
             CHAR LQ O"11" THEN 
               CHAR = CHAR + O"33"; 
          ELSE IF CHAR GQ O"12" AND 
                  CHAR LQ O"22" THEN
               BEGIN
                 CHAR = CHAR + O"22"; 
                 NEGMANTISSA = TRUE;
               END
               ELSE IF CHAR EQ O"72" THEN 
                      CHAR = O"33"; 
                    ELSE IF CHAR EQ O"66" THEN
                         BEGIN
                           CHAR = O"33";
                 NEGMANTISSA = TRUE;
          END 
          END 
          IF LEADING$BLNK THEN     # IF LEADING BLANKS POSSIBLE        #
            BEGIN 
            IF CHAR EQ O"55" THEN  # IF CHAR IS A BLANK                #
              BEGIN 
              GOTO NEXTCHAR;       # START ALL OVER                    # QU3A094
              END 
            ELSE
              BEGIN 
                                   # ANY BLANKS BEYOND THIS POINT WILL #
                                   # NOT BE LEADING BLANKS             #
              LEADING$BLNK = FALSE; 
              END 
            END 
          ELSE
            BEGIN 
            IF CHAR EQ O"55"       # IF EMBEDDED BLANK                 #
            THEN
              BEGIN 
              CHAR = O"33";        # TREAT BLANK AS ZERO               #
              END 
            END 
          IF CHAR GQ O"33" AND
             CHAR LQ O"44" THEN 
          BEGIN 
            IF FLAGD OR 
               FLAGE THEN 
            BEGIN                      # IF WORKING WITH EXPONENT, THEN#
              EXPONSIGN = TRUE;    # A SIGN IS NO LONGER VALID         #
              EXPONENT = EXPONENT * 10 + CHAR - O"33";
              GOTO NEXTCHAR;
            END 
            ELSE
              BEGIN 
              MANTSIGN = TRUE;     # A SIGN IS NO LONGER VALID         #
              END 
            IF PERIOD THEN             # KEEP COUNT OF DIGITS IN FRAC- #
              J = J + 1;               # TION PART FOR EXPONENT CALCU- #
                                       # LATION.                       #
            UPPERINT = UPPERINT * 10; 
            LOWERINT = LOWERINT * 10 + CHAR - O"33";
            IF B<0,6>LOWERINT NQ 0 THEN # IF LEAST SIGNIFICANT PART    #
            BEGIN                      # OVERFLOWS, MOVE OVERFLOW TO   #
              UPPERINT = UPPERINT + B<0,6>LOWERINT;# MOST SIGNIFICANT  #
              B<0,6>LOWERINT = 0;      # PART OF NUMBER.               #
              IF B<0,6>UPPERINT NQ 0 THEN # DIAGNOSE VALUES WHICH RE-  #
              BEGIN                    # QUIRE MORE THAN 108 BITS OF   #
                RETURNCODE = 54;       # SIGNIFICANCE AS OVERFLOWING.  #
                RETURN; 
              END 
            END 
            GOTO NEXTCHAR;
          END 
          IF CHAR EQ O"45" # + # THEN 
            BEGIN 
            IF FLAGE               # IF THIS IS AN EXPONENT            #
              OR FLAGD
            THEN
              BEGIN 
              IF NOT EXPONSIGN     # IF SIGN HAS NOT BEEN GIVEN BEFORE #
              THEN
                BEGIN 
                EXPONSIGN = TRUE;  # A SIGN IS NO LONGER VALID         #
                GOTO NEXTCHAR;
                END 
              END 
            ELSE
              BEGIN 
              IF NOT MANTSIGN      # IF SIGN HAS NOT BEEN SPECIFIED    #
              THEN
                BEGIN 
                MANTSIGN = TRUE;   # A SIGN IS NO LONGER VALID         #
                GOTO NEXTCHAR;
                END 
              END 
          END 
          IF CHAR EQ O"46" # - # THEN 
            BEGIN 
            IF FLAGE               # IF THIS IS AN EXPONENT            #
              OR FLAGD
            THEN
              BEGIN 
              IF NOT EXPONSIGN     # IF SIGN HAS NOT BEEN GIVEN BEFORE #
              THEN
                BEGIN 
                NEGEXPONENT = TRUE;  # FLAG THE EXPONENT AS NEGATIVE   #
                EXPONSIGN = TRUE;  # A SIGN IS NO LONGER VALID         #
                GOTO NEXTCHAR;
                END 
              END 
            ELSE
              BEGIN 
              IF NOT MANTSIGN      # IF SIGN HAS NOT BEEN SPECIFIED    #
              THEN
                BEGIN 
                NEGMANTISSA = TRUE;  # FLAG THE MANTISSA AS NEGATIVE   #
                MANTSIGN = TRUE;   # A SIGN IS NO LONGER VALID         #
                GOTO NEXTCHAR;
                END 
              END 
          END 
          IF CHAR EQ O"57"         # IF A PERIOD                       #
            AND NOT PERIOD         # AND NO PERIOD YET                 #
          THEN
          BEGIN 
            PERIOD = TRUE;
            GOTO NEXTCHAR;
          END 
          IF CHAR EQ O"05" # E # THEN 
          BEGIN 
            IF NOT FLAGE           # IF NO E BEFORE THIS               #
              AND NOT FLAGD        # AND NO D BEFORE THIS              #
            THEN
              BEGIN 
            FLAGE = TRUE; 
            GOTO NEXTCHAR;
              END 
          END 
          IF CHAR EQ O"04" # D # THEN 
          BEGIN 
            IF NOT FLAGE           # IF NO E BEFORE THIS               #
              AND NOT FLAGD        # AND NO D BEFORE THIS              #
            THEN
              BEGIN 
            FLAGD = TRUE; 
            GOTO NEXTCHAR;
              END 
          END 
          IF CHAR EQ O"11" # I # AND
             FLAGI THEN 
               GOTO FLOAT;
          RETURNCODE = 913;        # ILLEGAL INPUT IN SOURCE FIELD     #
          RETURN;                      # BESIDES 0-9,+,-,.,E,I AND D.  #
      PACKBINARY: 
          IF REQUESTCODE EQ 3 THEN     # IF CONVERTING TO INTEGER THEN #
          BEGIN                        # TAKE ALL 54 BITS OF LEAST SIG-#
            INTEGER = LOWERINT;        # NIFICANT PART AND LOWER 5 BITS#
            B<1,5>INTEGER = B<55,5>UPPERINT;# OF MOST SIGNIFICANT PART.#
            IF NEGMANTISSA THEN        # IF NEGATIVE THEN COMPLEMENT.  #
             INTEGER = -INTEGER;
            IF B<0,55>UPPERINT NQ 0 THEN # DIAGNOSE MORE THAN 59 BITS  #
              RETURNCODE = 54;         # OF SIGNICANCE AS OVERFLOW.    #
            IF PERIOD OR FLAGE OR      # IF E,., OR D FOUND IN SOURCE, #
               FLAGD THEN              # DIAGNOSE AS NOT MATCHING      #
            BEGIN                      # DIRECTORY DESCRIPTION.        #
              IF NOT FLAGU THEN        # IF TO BE UNNORMALIZED THEN E, #
              BEGIN                    # D AND . ARE O.K.              #
                INTEGER = 0;
                RETURNCODE = 55;
              END 
            END 
            RETURN; 
          END 
      FLOAT:  
          IF NEGEXPONENT THEN          # SET D = EXPONENT AS A POWER OF#
            EXPONENT = -(EXPONENT + J);# 10.                           #
          ELSE EXPONENT = EXPONENT - J; 
          IF NEGMANTISSA THEN          # IF MANTISSA IS NEGATIVE, SET  #
            SIGN = LNO(0);             # FLAG.                         #
          ELSE SIGN = 0;
          IF ITEMSIZE              # IF SEP ITEM-SIZE IS ON            # QU3A094
            AND USECONVERT         # IF *USINGEX* CALLED CONVERT       # QU3A094
            AND NOT PERIOD         # AND NO DECIMAL POINT OCCURED      # QU3A094
          THEN                     # THEN IGNORE SCALING               # QU3A094
            BEGIN                                                        QU3A094
            P<DESATT1> = TOWORD[0];                                      QU3A094
            EXPONENT = EXPONENT - DPTLOC[0];  # SCALE EXPONENT         # QU3A094
            END                                                          QU3A094
          IF FROMNUM               # IF SOURCE FIELD IS A NUMERIC      # QU3A094
            AND NOT PERIOD         # AND NO DECIMAL POINT              # QU3A094
            AND REQUESTCODE NQ 2   # IGNORE SCALING FOR CHAR TO NUMERIC# QU3A094
          THEN                     # TAKE SCALE FACTOR FROM SOURCE     # QU3A094
            BEGIN                  # ATTRIBUTE FIELD.  THIS PROCESSES  # QU3A094
            P<DESATT1> = FROMWORD; # DISPLAY NUMERIC FIELDS CORRECTLY  # QU3A094
            EXPONENT = EXPONENT - DPTLOC[0];  # SCALE EXPONENT         # QU3A094
            END                                                          QU3A094
          QU2CONV;                     # CALL COMPASS ROUTINE FOR PACK-#
                                   # ING AND SCALING                   # QU3A094
          RETURN; 
          END 
                                                                        0004  60
      PROC GETCHAR; 
 #
 0        GETCHAR - PROCEDURE FOR EXTRACTING THE NEXT CHARACTER FROM
                    THE SOURCE STRING.
 #
          BEGIN 
          CHAR = C<SOURCEBYTE,1>FWA[SOURCEWORD];
          IF SOURCEBYTE GQ 9 THEN 
          BEGIN 
            SOURCEWORD = SOURCEWORD + 1;
            SOURCEBYTE = 0; 
          END 
          ELSE SOURCEBYTE = SOURCEBYTE + 1; 
          SOURCELENG = SOURCELENG - 1;
          RETURN; 
          END 
  
  
  
          XDEF FUNC BINDEC C(10); 
          FUNC BINDEC(BIN,LG)  C(10); 
                 #THIS SIMPLIFIED FUNCTION CONVERTS A BINARY INTEGER
                  INTO 1 TO 10 DECIMAL DIGITS.  THE BINARY NUMBER TO
                  CONVERT AND THE EXPECTED NUMBER OF DIGITS TO OUTPUT 
                  ARE GIVEN AS PARAMETERS. THE RESULT IS LEFT JUSTIFIED 
                  IN THE FIRST LG POSITIONS OF THE OUTPUT FIELD.# 
          BEGIN 
                 ITEM BIN, LG;
                 ITEM K C(10);
                 INTEGER=BIN;    J=6*LG-6;
                 K=BLKS[0];    #CLEAR OUTPUT FIELD# 
                 FOR I=J STEP -6 UNTIL 0 DO 
                 BEGIN
                    QUOTIENT=INTEGER/10;
                    B<I,6>K=INTEGER-10*QUOTIENT+O"33";
                    INTEGER=QUOTIENT; 
                 END
                 BINDEC=K;    #ASSIGN RESULT# 
          END 
      XDEF PROC UPBUN;
      PROC UPBUN(TABLE, UB, BA, RC);
      BEGIN 
          ARRAY ATTR S(2);                                              000530
         ITEM AWPOS I(0,18,18),                                         000540
               ABPOS U(0,36,6),                                         000550
               ALG I(0,42,18),                                          000560
               ADS U(1,4,11),                                           000570
               ADSS I(1,27,15),                                         000580
              ACLS I(0,12,6);                                           000590
          ARRAY ATTR2 S(2);        # ATTRIBUTES USED FOR CONVERT       #
            BEGIN 
            ITEM AWPOS2 I(0,18,18);  # ADDRESS OF VALUE                #
            END 
          ARRAY P S(2); 
            ITEM PPEDIT B(0,3,1), 
                  PFROMCHAR U(0,4,4), 
                  PNBCHAR U(0,12,12), 
                  PFROMWORD U(0,24,18), 
                  PTOWORD U(0,42,18), 
                  PFROMPTR U(1,24,18),
                  PCONVERTCODE U(1,0,6),
                  PWORD1 U(0,0,60), 
                  PWORD2 U(1,0,60); 
          ITEM UB,BA,RC;
          BASED ARRAY II; 
            BEGIN 
            ITEM INTE      I(0,42,18);
            ITEM IIWORD    I(0,0,60); 
            END 
          ARRAY TABLE;; 
          ITEM SUB;                                                     000890
          ITEM I,J;                                                     000900
          P<INDTBL> = LOC(TABLE);  # POSITION INDEX TABLE              #
          RC = 0; 
          UB = UPBND[0];
          I = TBLGS[0] - 1;                                             000120
          FOR J = 0 STEP 1 UNTIL I DO                                   000130
          BEGIN IF DEPNDFG[J] THEN                                      000140
          BEGIN 
          IF DPTYPE[I] EQ 2        # IF INTEGER                        #
          THEN
            BEGIN 
            P<II> = INDCE[I]; 
            UB = IIWORD[0]; 
            END 
          ELSE
          BEGIN 
          AWPOS2[0] = LOC(UB);     # TO ADDRESS IN ATTRIB TABLE        #
          PTOWORD[0] = LOC(ATTR2) - 1;  # ADDR OF ATTRIB TBL IN CONVERT#
                                        # PARAMETER                    #
                PWORD2[0] = 0;
          PFROMPTR[0] = BA; 
          PCONVERTCODE[0] = C<2,1>CCODE[DPTYPE[I]]; 
          PFROMCHAR[0] = TBLGS[I];                                      000180
          PNBCHAR[0] = ENTYLG[I];                                       000190
          IF DPTYPE[I] EQ 1 OR DPTYPE[I] EQ 3 THEN                      000610
          BEGIN PFROMWORD[0] = LOC(ATTR)-1;                             000620
                AWPOS[0] = INDCE[I];                                    000630
                ABPOS[0] = PFROMCHAR[0] * 6;                            000640
                ALG[0] = PNBCHAR[0];                                    000650
                ADS[0] = ALG[0];                                        000660
                ADSS[0] = ALG[0];                                       000670
                ACLS[0] = DPTYPE[I];                                    000680
          END                                                           000690
          ELSE                                                          000700
          PFROMWORD[0] = INDCE[I];                                      000200
                CONVERT(P,RC);
                IF RC NQ 0 THEN RETURN; 
          END 
          IF UB GR UPBND[J] THEN                                        000220
          BEGIN RC = 941;                                               000130
                RETURN;                                                 000140
          END                                                           000150
                 I = I - 1;                                             000920
          END 
          ELSE
            BEGIN 
            UB = UPBND[J];         # UPPER BOUND                       #
            END 
          IF INTESUB[J] THEN                                            001020
          BEGIN P<II> = INDCE[J];                                       001030
                SUB = INTE[0];                                          001040
          END                                                           001050
          ELSE                                                          001060
          SUB = INDCE[J];                                               001070
          IF (INTESUB[J] OR CONSUB[J]) AND (SUB GR UB OR SUB LS 1)      001090
          THEN BEGIN RC=941; RETURN; END                                001100
          END                                                           000240
          END 
          END 
          TERM; 
