*DECK DD$CCON 
      PROC DD$CCON(ERRCODE,SRCLASS,TGCLASS,SRLOC,TGLOC,SRBIT,TGBIT, 
                   SRBLENG,TGBLENG,SRJRIGHT,TGJRIGHT,SRDECPT,TGDECPT, 
                   SRXDEC,TGXDEC,SRSIGNED,TGSIGNED);
      BEGIN 
  
# ******************************************************************** #
#     THE FOLLOWING CODE IS EXCERPTED FROM DECK DM$CONV ON CY 27 OF    #
#     CDCS 1.0 PROGRAM LIBRARY, BY DELETING UNNEEDED ROUTINES AND      #
#     ITEMS, AND REPLACING SWITCH VECTORS WITH -IF- CONDITIONS.        #
#     THIS VERSION WILL SUPPORT SOURCE ITEM CLASS CODE 3 OR 4          #
#     AND TARGET ITEM CLASS CODE 3,4,12,13, OR 14.                     #
# ******************************************************************** #
  
 #
  *   DM$CONV - CONVERSION ROUTINES FOR CDCS 1.0
* *   C C CHOW      6/13/74 
* 
* DC  PURPOSE 
*       PERFORM DATA CONVERSION FOR CDCS 1.0. 
* 
* DC  LANGUAGE
*       SYMPL 
* 
* DC  ENTRY CONDITIONS
*       PARAMETERS PASSED 
*         SRCLASS  = SOURCE DATA CLASS CODE.
*         TGCLASS  = TARGET DATA CLASS CODE.
*         SRLOC    = SOURCE LOCATION. 
*         TGLOC    = TARGET LOCATION. 
*         SRBIT    = SOURCE BEGINNING BIT POSITION. 
*         TGBIT    = TARGET BEGINNING BIT POSITION. 
*         SRBLENG  = SOURCE LENGTH IN BITS. 
*         TGBLENG  = TARGET LENGTH IN BITS. 
*         SRJRIGHT = SOURCE JUSTIFIED RIGHT IF SET. 
*         TGJRIGHT = TARGET JUSTIFIED RIGHT IF SET. 
*         SRDECPT  = SOURCE DECIMAL PT POSITION.
*                    +VE - POINTS TO LEFT OF RIGHTMOST DIGIT. 
*                    -VE - POINTS TO RIGHT OF RIGHTMOST DIGIT.
*         TGDECPT  = TARGET DECIMAL PT POSITION.
*         SRXDEC   = SOURGE EXPLICITLY DECIMALED IF SET.
*         TGXDEC   = TARGET EXPLICITLY DECIMALED IF SET.
*         SRSIGNED = SOURCE IS SIGNED (OVERPUNCH FOR CURRENT RELEASE).
*         TGSIGNED = TARGET IS SIGNED.
*       SOURCE DATA IS CONTAINED IN LOCATION/POSITION SPECIFIED.
* 
* DC  EXIT CONDITIONS 
*       NORMAL: 
*         TARGET DATA STORED INTO LOCATION/POSITION SPECIFIED.
*         ERRCODE = 0.
*       ERROR:  
*         ERRCODE = CDCS ERROR CODE.
* 
* DC  DESCRIPTIONS
*       CDCS SUPPORTS 8 DATA CLASSES, EACH WITH A UNIQUE CLASS CODE 
*     FOR IDENTIFICATION. THEY ARE: 
*         0  - DISPLAY ALPHANUMERIC:  
*              ALPHANUMERIC CHARACTERS WITH DISPLAY CODE 00 - 77. 
*         1  - DISPLAY ALPHABETIC:  
*              ALPHABETIC CHARACTERS WITH DISPLAY CODE 01 - 32, AND 55. 
*         3  - DISPLAY NUMERIC(INTEGER):  
*              MAX 18 CHARS INTEGER NUMERIC STRING IN DISPLAY CODE
*              33 - 44. LAST (RIGHTMOST) DIGIT MAY BE SIGN-OVER-PUNCH.
*              NO EXPLICIT SIGN. NO LEADING BLANK.
*         4  - DISPLAY FIXED POINT: 
*              MAX 18 CHARS NUMERIC STRING IN DISPLAY CODE 33 - 44 WITH 
*              ONE DECIMAL PT (IMPLICIT OR EXPLICIT WITH DISPLAY CODE 
*              57). RIGHTMOST DIGIT (OR IF IT IS EXPLICIT DECIMAL PT, 
*              THE 2ND RIGHTMOST), MAY BE SIGN-OVER-PUNCH. NO EXPLICIT
*              SIGN. NO LEADING BLANK. LEADING OR TRAILING ZEROS COULD
*              BE IMPLIED BY SPECIFYING DECIMAL +OSITION BEYOND STRING. 
*         10 - INTEGER: 
*              48 BIT BINARY INTEGER, RIGHT JUSTIFIED (COBOL 5 COMP-1)
*         12 - CODED UNNORMALIZED FLOATING POINT: 
*              FLOATING PT NUMBER IN A 60 BIT WORD WITH EXPONENT OF 
*              EITHER O"2000" (+VE) OR O"5777" (-VE). 
*         13 - CODED NORMALIZED FLOATING POINT: 
*              60 BIT NORMALIZED FLOATING PT NUMBER.
*         14 - CODED DOUBLE PRECISION:  
*              2 NORMALIZED FLOATING PT NUMBERS, WITH EXPONENT OF 2ND 
*              WORD O"60" LESS THAN THAT OF THE 1ST. IF EXPONENT OF 1ST 
*              IS LESS THAN O"60", EXPONENT OF 2ND WILL BE 0. 
* 
*     CONVERSIONS SUPPORTED IN THIS EXCERPTED VERSION ARE 
* 
*     3 - 3   DISPLAY NUMERIC TO DISPLAY NUMERIC. 
*             DATA STRING IS MOVED DIRECTLY TO TARGET WITH ZERO-PADDING 
*           IF NECESSARY. TRUNCATION OTHER THAN THAT OF LEADING ZEROS 
*           WILL CAUSE TERMINATION WITH ERROR CODE 666. IF SOURCE IS
*           SIGNED AND TARGET IS NOT, SOURCE SIGN WILL BE IGNORED.
*     3 - 4   DISPLAY NUMERIC TO DISPLAY FIXED POINT. 
*             DIGITS TO RIGHT OF DECIMAL PT IN TARGET IS FILLED WITH
*           DISPLAY CODE ZERO. DATA STRING IS MOVED RIGHT JUSTIFIED TO
*           THE LEFT OF TARGET DECIMAL PT WITH ZERO-PADDING IF
*           NECESSARY. TRUNCATION OTHER THAN THAT OF LEADING-ZEROS WILL 
*           CAUSE TERMINATION WITH ERROR CODE 666. IF TARGET IS SIGNED, 
*           IT WILL HAVE SIGN-OVER-PUNCH IN RIGHTMOST DIGIT. IF 
*           UNSIGNED, SOURCE SIGN WILL BE IGNORED.
*     3 - 10  DISPLAY NUMERIC TO BINARY INTEGER.
*             SOURCE DATA STRING IS CONVERTED INTO BINARY INTEGER, WHICH
*           IS SCALED AND CONVERTED INTO TARGET CLASS.  IF SCALED DATA
*           STRING GREATER THAN 48 BITS, TERMINATE WITH ERROR CODE 666. 
*           IF SOURCE IS NEG, TARGET IS COMPLIMENTED. 
*     3 - 13  DISPLAY NUMERIC TO CODED NORMALIZED.
*             SOURCE DATA IS CONVERTED TO BINARY, AND THEN TO FLOATING
*           NORMALIZED, COMPLIMENTED IF -VE. LOSS OF SIGNIFICANCE 
*           DURING CONVERSION WILL CAUSE TERMINATION WITH ERROR CODE
*           666.
*     3 - 14  DISPLAY NUMERIC TO DOUBLE PRECISION.
*             SOURCE DATA IS CONVERTED TO BINARY, AND THEN TO DOUBLE
*           PRECISION (WITH SCALING) IN 2 NORMALIZED FLOATING PT NUMBER,
*           COMPLIMENTED IF -VE. LOSS OF SIGNIFICANCE WILL CAUSE
*           TERMINATION WITH ERROR CODE 666.
*     4 - 3   DISPLAY FIXED POINT TO DISPLAY NUMERIC. 
*             INTEGER PART OF SOURCE IS MOVED RIGHT JUSTIFIED ZERO- 
*           FILLED TO TARGET, ROUNDING ON LEAST SIGNIFICANT DIGIT 
*           ACCORDING TO DECIMAL PART OF SOURCE, AND SUPPLYING SIGN-
*           OVER-PUNCH IF SPECIFIED. TRUNCATION OF INTEGER PART OF DATA 
*           WILL CAUSE TERMINATION WITH ERROR CODE 666. 
*     4 - 4   DISPLAY FIXED POINT TO DISPLAY FIXED POINT. 
*             DATA IS MOVED JUSTIFIED ON DECIMAL PT POSITION, DISPLAY 
*           CODE ZERO FILLING BOTH ENDS, ROUNDING ON LEAST SIGNIFICANT
*           DIGIT IF NECESSARY, AND SUPPLYING SIGN-OVER-PUNCH IF
*           SPECIFIED. TRUNCATION OF INTEGER PART OF DATA WILL CAUSE
*           TERMINATION WITH ERROR CODE 666.
*     4 - 10  DISPLAY FIXED POINT TO BINARY INTEGER.
*             SOURCE DATA IS CONVERTED TO BINARY INTEGER.  A SCALING
*           FACTOR IS DERIVED FROM SOURCE AND TARGET DECIMAL POSITION.
*           RESULT IS COMPLEMENTED IF SOURCE IS NEG.  IF SCALED BINARY
*           STRING GREATER THAN 48 BITS, TERMINATE WITH ERROR CODE 666. 
*     4 - 13  DISPLAY FIXED PT TO CODED NORMALIZED FLOATING.
*             SOURCE DATA IS CONVERTED TO BINARY INTEGER, AND THEN
*           TO NORMALIZED FLOATING PT, COMPLIMENTED IF -VE. LOSS OF 
*           SIGNIFICANCE WILL CAUSE TERMINATION WITH ERROR CODE 666.
*     4 - 14  DISPLAY FIXED PT TO DOUBLE PRECISION. 
*             SOURCE DATA IS CONVERTED TO BINARY INTEGER, AND THEN TO 
*           DOUBLE PRECISION (SCALED) IN 2 NORM FLOATING PT NUMBERS,
*           COMPLIMENTED IF -VE. LOSS OF SIGNIFICANCE WILL CAUSE
*           TERMINATION WITH ERROR CODE 666.
*     PROGRAM CONTROL IN THIS EXCERPTED VERSION IS BY WAY OF -IF- 
*     STATEMENTS, USING VALUE OF SOURCE CLASS CODE AND TARGET 
*     CLASS CODE. 
* 
*       IN CASES WHERE THE SPECIFIED CONVERSION IS NOT SUPPORTED, THE 
*     SWITCHES WILL SEND CONTROL TO LABEL "NONSUPPORT", WHERE ERROR 
*     EXIT WILL BE TAKEN WITH CODE 663. 
* 
*       ONE OTHER LABEL OF SIGNIFICANCE IN THE PROCEDURE IS "CONV$EXIT".
*     IT IS JUMPED TO FROM VARIOUS EMBEDDED PROCS. WHENEVER AN EMBEDDED 
*     PROC DETECTS AN ERROR DURING CONVERSION, "ERRCODE" WILL BE SET
*     AND CONTROL WILL JUMP OUT OF THE EMBEDDED PROC TO "CONV$EXIT" TO
*     RETURN TO CALLING PROGRAM.
* 
*       THE CONVERSION ROUTINE UTILIZES AN INTERNAL BUFFER "INTERBUF" 
*     OF SIZE 20 CHARS. IN CASES WHERE ROUNDING OR SIGNING OR ZERO- 
*     FILLING MAY NEED TO BE DONE BEFORE MOVING TO TARGET, THE DATA 
*     IS MOVED INTO "INTERBUF" FIRST (LENGTH MOVED IS TARGET LENGTH + 1,
*     OR RIGHT JUSTIFED TO IT IF DATA STRING IS NOT AS LONG). "INTERBUF"
*     WOULD HAVE ALREADY BEEN ZERO-FILLED. THEN ROUNDING WILL BE DONE 
*     IF NECESSARY, AND SIGN-OVER-PUNCH EXTRACTED OR ADDED IF REQD. THE 
*     DATA STRING WILL THEN BE MOVED FROM "INTERBUF" TO TARGET. AN ITEM 
*     "LOCINTERBUF" WILL BE SET TO ABS LOC OF "INTERBUF" FOR USE BY 
*     OUR PROGRAM.
* 
*       EVERY TIME "DM$CONV" IS CALLED, IT WILL FIRSTLY STORE SOME
*     PARAMETERS INTO LOCAL ITEMS FOR EASE OF REFERENCE AND 
*     MODIFICATION. THE LOCAL ITEMS ARE "SCURLOC", "SCURBYTE",
*     "SCURLENG", "SRDECPOS", "SRXPLICD", "TCURLOC", "TCURBYTE",
*     "TCURLENG", "TGDECPOS", AND "TGXPLICD". THUS IN CASE SOME OF
*     THESE REFERENCED PARAMETERS ARE NOT GIVEN IN CALLING SEQUENCE,
*     AN ARITHMETIC MODE ERROR MAY OCCUR. IN OTHER WORDS, ALL PARAMETERS
*     UP TO AND INCLUDING "TGXDEC" MUST BE SPECIFIED. 
* 
*       "INTERBUF" IS ZERO-FILLED EVERY TIME, EVEN THOUGH IT MAY NOT BE 
*     USED IN SOME PARTICULAR CONVERSIONS.
 #
  
  
      ITEM ERRCODE,          #RETURN ERROR CODE.                       #
           SRCLASS,          #SOURCE DATA CLASS.  REQD BY ALL CLASSES. #
           TGCLASS,          #TARGET DATA CLASS.  REQD BY ALL CLASSES. #
           SRLOC,            #SOURCE LOCATION.  REQD BY ALL CLASSES.   #
           TGLOC,            #TARGET LOCATION.                         #
           SRBIT,            #SOURCE BEGINNING BIT POSITION. 0-59.     #
                             #REQD BY ALL CLASSES.                     #
           TGBIT,            #TARGET BEGINNING BIT POSITION. 0-59.     #
           SRBLENG,          #SOURCE LENGTH IN BITS.  REQD BY ALL.     #
           TGBLENG,          #TARGET LENGTH IN BITS.                   #
           SRJRIGHT B,       #TRUE - SOURCE IS JUSTIFIED RIGHT.        #
                             #REQD BY ALL.                             #
           TGJRIGHT B,       #TARGET JUSTIFIED RIGHT.                  #
           SRDECPT,          #SOURCE DECIMAL POINT POSITION.
                              +VE - POINTS TO LEFT OF RIGHTMOST DIGIT.
                              -VE - POINTS TO RIGHT OF RIGHTMOST DIGIT.#
                             #REQD BY  4,12.                           #
           TGDECPT,          #TARGET DECIMAL POINT POSITION.           #
           SRXDEC B,         #TRUE - SOURCE IS EXPLICITLY DECIMALED.   #
                             #REQD BY  4.                              #
           TGXDEC B,         #TARGET EXPLICITLY DECIMALED.             #
           SRSIGNED B,       #SOURCE IS SIGNED.  REQD BY  3,4.         #
           TGSIGNED B;       #TARGET IS SIGNED.                        #
  
      DEF CALL # #; 
      DEF XCALL # #;
      DEF THRU #STEP 1 UNTIL#;
  
      COMMON DM$CMBF;        #COMMON FOR BINARY TO FLOATING CONVER.    #
        BEGIN 
        ITEM UPINT;          #UPPER 54 BITS OF 108 BIT INTEGER.        #
        ITEM LOWINT;         #LOWER 54 BITS OF 108 BIT INTEGER.        #
        ITEM EXPONEN;        #SCALING FACTOR.  POWER OF 10.            #
        ITEM SIGN;           #SIGN.  0 +VE.  COMPLEMENT -VE.           #
        ITEM FLAGDBL B;      #TRUE - DOUBLE PRECISION DESIRED.         #
        ITEM SINGLE R;       #SINGLE PRECISION RESULT.                 #
        ITEM DOUBLE R;       #DOUBLE PRECISION RESULT. (LOWER HALF).   #
        ITEM RETURNC;        #RETURN CODE.                             #
        END 
  
      XREF PROC DM$BTOF;     #COMPASS ROUTINE FOR CONVERTING 108 BIT
                              BINARY TO FLOATING PT NUMBER.            #
      XREF PROC DM$FTOF;     #COMPASS ROUTINE TO CONVERT FLOATING PT TO 
                              FLOATING PT, EITHER SINGLE OR DOUBLE, 
                              NORMALIZED OR UNNORMALIZED.              #
  
      BASED ARRAY SRFIELD;             #SOURCE FIELD.                  #
        BEGIN 
        ITEM SRCHAR C(0,0,10);         #SOURCE IN 10-CHAR STRING.      #
        ITEM SRINTEGER I(0,0,60);      #SOURCE IN INTEGER.             #
        ITEM SRREAL R(0,0,60);         #SOURCE IN REAL.                #
        END 
      BASED ARRAY TGFIELD;             #TARGET FIELD.                  #
        BEGIN 
        ITEM TGCHAR C(0,0,10);
        ITEM TGINTEGER I(0,0,60); 
        ITEM TGREAL R(0,0,60);
        END 
  
      ITEM SCURLOC,          #SIGNIGICANT SOURCE LOCATION.             #
           SCURBYTE,         #SIGNIFICANT SOURCE STARTING BYTE.        #
           SCURLENG,         #SIGNIFICANT SOURCE LENGTH IN 6-BIT BYTE. #
           SRDECPOS,         #SOURCE DECIMAL POSITION.                 #
           SRXPLICD B,       #TRUE - SOURCE EXPLICITLY DECIMALED.      #
           TCURLOC, 
           TCURBYTE,
           TCURLENG,
           TGDECPOS,
           TGXPLICD B;
  
      ITEM I;                #SCRATCH VARIABLE.                        #
      ITEM J;                #SCRATCH VARIABLE.                        #
      ITEM K;                #SCRATCH VARIABLE.                        #
      ITEM RI R;             #REAL SCRATCH VARIABLE.                   #
      ITEM TEMP;             #TEMP STOR FOR CL 10 AND 12 SOURCE        #
  
      ITEM ASSUMELEFT;       #COUNT OF ASSUMED LEFT ZEROS. FOR CLASS 4.#
      ITEM ASSUMERIGHT;      #COUNT OF ASSUMED RIGHT ZEROS. CLASS 4.   #
      ITEM CHAR;             #CURRENT CHARACTER IN SOURCE STRING.      #
      ITEM DECDIGITS;        #COUNT OF DECIMAL DIGITS IN CURRENT
                              NUMERIC STRING.                          #
      ITEM DECIMALED B;      #TRUE - CURRENT NUMERIC STRING HAS DECIMAL 
                                     POINT.                            #
      ITEM GETBYTE;          #BYTE IN "SRFIELD" TO BE ACCESSED.        #
      ITEM INTERBUF C(20);   #INTERMEDIATE BUFFER FOR MOVING SOURCE TO
                              TARGET, WHERE EDITING WILL BE DONE.      #
      ITEM LEADZEROS;        #COUNT OF LEADING ZEROS IN CURRENT NUMERIC 
                              STRING.                                  #
      ITEM LENGDIFF;        #LENGTH DIFFERENCE. USED IN VARIOUS PLACES.#
      ITEM LOCINTERBUF;      #LOC OF ARRAY "INTERBUF".                 #
      ITEM SGNTDIGITS;       #COUNT OF SIGNIFICANT DIGITS IN CURRENT
                              NUMERIC STRING (INTEGER PART EXCLUDING
                              LEADING ZEROS.                           #
      ITEM SIGNPLUS B;       #TRUE - CURRENT NUMERIC STRING IS +VE.    #
                             #FALSE- CURRENT NUMERIC STRING IS -VE.    #
      ITEM TASMLEFT;         #TARGET ASSUMED LEFT ZERO COUNT.          #
      ITEM TASMRIGHT;        #TARGET ASSUMED RIGHT ZERO COUNT.         #
      ITEM TDECLEN;          #COUNT OF DECIMAL DIGITS IN TARGET, NOT
                              INCLUDING IMPLIED LEFT ZEROS.            #
      ITEM TSGNTLEN;         #COUNT OF SIGNIFICANT DIGITS IN TARGET,
                              NOT INCLUDING IMPLIED RIGHT ZEROS.       #
      CONTROL EJECT;
  
      ERRCODE=0;
  
      IF SRCLASS GR 14 OR TGCLASS GR 14 THEN     #TRUE - DATA CLASS 
                                                         NOT SUPPORTED.#
        GOTO NONSUPPORT;
  
      SCURLOC=SRLOC;
      SCURBYTE=SRBIT/6; 
      SCURLENG=SRBLENG/6; 
      SRDECPOS=SRDECPT; 
      SRXPLICD=SRXDEC;
      TCURLOC=TGLOC;
      TCURBYTE=TGBIT/6; 
      TCURLENG=TGBLENG/6; 
      TGDECPOS=TGDECPT; 
      TGXPLICD=TGXDEC;
  
      LOCINTERBUF=LOC(INTERBUF);      #SET "LOCINTERBUF" FOR LATER USE.#
  
# ZERO FILL "INTERBUF".                                                #
  
      INTERBUF="00000000000000000000";
  
      IF SRCLASS EQ 3 THEN
        GOTO SRDNUMERIC;
      ELSE
        IF SRCLASS EQ 4 THEN
          GOTO SRDFIXEDPT;
        ELSE
          GOTO NONSUPPORT;
      CONTROL EJECT;
  
SRDNUMERIC:                  #SOURCE DISPLAY-NUMERIC CLASS 3.          #
  
 #
  *   SRDNUMERIC - SOURCE DISPLAY NUMERIC CLASS 3 
* *   C C CHOW      6/15/74 
* 
* DC  PURPOSE 
*       CALIDATE CLASS 3 SOURCE DATA AND BRANCH ACCORDING TO TARGET 
*     DATA CLASS. 
* 
* DC  ENTRY CONDITIONS
*       SCURLOC  = SOURCE LOCATION. 
*       SCURBYTE = SOURCE BEGINNING BYTE POSITION.
*       SCURLENG = SOURCE LENGTH IN BYTES.
*       TGCLASS  = TARGET DATA CLASS. 
* 
* DC  EXIT CONDITIONS 
*       DECDIGITS  = NUMBER OF DECIMAL DIGITS. SET TO 0.
*       SGNTDIGITS = NUMBER OF SIGNIFICANT DIGITS IN SOURCE DATA. 
*       LEADZEROS  = NUMBER OF LEADING ZEROS IN SOURCE DATA.
*       SIGNPLUS   = TRUE IF SOURCE DATA IS +VE.
* 
* DC  CALLED ROUTINES 
*       CHECKCLS3 - CHECK SOURCE CLASS 3. 
* 
* DC  DESCRIPTIONS
*       CALL "CHECKCLS3" TO VERIFY THAT SOURCE DATA IS LEGAL CLASS 3. 
*       SET "SGNTDIGITS" TO INDICATE NUMBER OF SIGNIFICANT DIGITS OTHER 
*     THAN LEADING ZEROS. 
*       SET "DECDIGITS" TO 0. 
*       BRANCH ACCORDING TO TARGET CLASS. 
 #
  
  
      CALL CHECKCLS3;        #CHECK IF SOURCE IS LEGAL CLASS 3.        #
      SGNTDIGITS=SCURLENG-LEADZEROS;   #SIGNIFICANT DIGITS COUNT.      #
      DECDIGITS=0;                     #DECIMAL DIGITS COUNT.          #
  
      IF TGCLASS EQ 3 THEN
        GOTO DNUMTODNUM;
      IF TGCLASS EQ 4 THEN
        GOTO DNUMTODFXPT; 
      IF TGCLASS EQ 10 THEN 
        GOTO DNUMTOINT; 
      IF TGCLASS EQ 13 THEN 
        GOTO DNUMTONORM;
      IF TGCLASS EQ 14 THEN 
        GOTO DNUMTODOUBL; 
      GOTO NONSUPPORT;     #ERROR#
      CONTROL EJECT;
  
SRDFIXEDPT:                  #SOURCE DISPLAY FIXED POINT. CLASS 4.     #
  
 #
  *   SRFIXEDPT - SOURCE DISPLAY FIXED PT CLASS 4 
* *   C C CHOW      6/15/74 
* 
* DC  PURPOSE 
*       VALIDATE CLASS 4 SOURCE DATA, AND GET READY FOR BRANCHING 
*     ACCORDING TO TARGET CLASS.
* 
* DC  ENTRY CONDITIONS
*       SCURLOC  = SOURCE LOCATION. 
*       SCURBYTE = SOURCE BEGINNING BYTE POSITION.
*       SCURLENG = SOURCE LENGTH IN BYTES.
*       SRDECPOS = SOURCE DECIMAL PT POSITION.
*       SRXPLICD = TRUE IF SOURCE IS EXPLICITLY DECIMALED.
* 
* DC  EXIT CONDITIONS 
*       SIGNPLUS  = TRUE IF SOURCE IS +VE.
*       LEADZEROS = NUMBER OF LEADING ZEROS IN SOURCE. INCLUDES ONLY
*                   EXPLICIT LEADING ZEROS OF INTEGER PART. 
*       ASSUMELEFT  = NUMBER OF ASSUMED LEFT ZEROS TO DECIMAL PT. 
*       ASSUMERIGHT = NUMBER OF ASSUMED RIGHT ZEROS.
*       SGNTDIGITS = NUMBER OF SIGNIFICANT DIGITS IN EXPLICIT INTEGER 
*                    PART OF SOURCE.
*       DECDIGITS  = NUMBER OF DECIMAL DIGITS IN EXPLICIT DECIMAL PART
*                    OF SOURCE. 
* 
* DC  DESCRIPTIONS
*       CALL "CHECKCLS4" TO VERIFY THAT SOURCE IS LEGAL CLASS 4.
*       SET "ASSUMERIGHT", "ASSUMELEFT", "SGNTDIGITS", AND "DECDIGITS". 
*       BRANCH ACCORDING TO TARGET CLASS. 
 #
  
  
      CALL CHECKCLS4;        #CHECK IF SOURCE IS LEGAL CLASS 4.        #
  
      ASSUMERIGHT=0;
      ASSUMELEFT=0; 
      IF SRDECPOS LS 0 THEN 
        BEGIN 
        SGNTDIGITS=SCURLENG-LEADZEROS;
        ASSUMERIGHT=-SRDECPOS;
        DECDIGITS=0;
        END 
      ELSE
        BEGIN 
        IF SRDECPOS GR SCURLENG THEN
          BEGIN 
          SGNTDIGITS=0; 
          DECDIGITS=SCURLENG; 
          ASSUMELEFT=SRDECPOS-SCURLENG; 
          END 
        ELSE
          BEGIN 
          DECDIGITS=SRDECPOS; 
          IF SRXPLICD THEN
            SGNTDIGITS=SCURLENG-LEADZEROS-DECDIGITS-1;
          ELSE
            SGNTDIGITS=SCURLENG-LEADZEROS-DECDIGITS;
          END 
        END 
  
      IF TGCLASS EQ 3 THEN
        GOTO DFXPTTODNUM; 
      IF TGCLASS EQ 4 THEN
        GOTO DFXPTTODFXPT;
      IF TGCLASS EQ 10 THEN 
        GOTO DFXPTTOINT;
      IF TGCLASS EQ 13 THEN 
        GOTO DFXPTTONORM; 
      IF TGCLASS EQ 14 THEN 
        GOTO DFXPTTODOUBL;
      CONTROL EJECT;
  
ALNUMTODNUM:                 #ALPHANUMERIC TO DISPLAY NUMERIC.         #
  
DNUMTODNUM:                  #DISPLAY NUMERIC TO DISPLAY NUMERIC.      #
  
 #
  *   ALNUMTODNUM - CONVERSION 0 - 3
* *   DNUMTODNUM  - CONVERSION 3 - 3
* *   C C CHOW      6/15/74 
* 
* DC  PURPOSE 
*       PERFORM CONVERSION FROM ALPHANUMERIC/DISPLAY-NUMERIC TO 
*     DISPLAY NUMERIC.
* 
* DC  ENTRY CONDITIONS
*       SCURLOC/SCURBYTE/SCURLENG CONTAINS SOURCE DATA. 
*       LEADZEROS = COUNT OF LEADING ZEROS IN SOURCE INTEGER PART.
*       SGNTDIGITS = COUNT OF SIGNIFICANT DIGITS IN SOURCE. 
*       DECDIGITS = COUNT OF DECIMAL DIGITS IN SOURCE.
*       SIGNPLUS = TRUE IF SOURCE DATA +VE. 
*       TCURLOC = TARGET LOCATION.
*       TCURBYTE = TARGET BEGINNING BYTE POSITION.
*       TCURLENG = TARGET LENGTH IN BYTES.
*       LOCINTERBUF = ABS LOC OF DM$CONV INTERNAL BUFFER "INTERBUF".
* 
* DC  EXIT CONDITIONS 
*       NORMAL: 
*         SOURCE DATA STRING CONVERTED TO TARGET AS REQD. 
*       ERROR:  
*         ERRCODE = O"666". 
* 
* DC  DESCRIPTIONS
*       CHECK IF TARGET SIZE LARGE ENOUGH TO HOLD SIGNIFICANT PART OF 
*     SOURCE. IF NOT, ERROR EXIT WITH CODE 666. 
*       MOVE SIGNIFICANT PART OF SOURCE DATA INTO "INTERBUF" RIGHT
*     JUSTIFIED TO TARGET LENGTH AND ZERO-FILLING ON LEFT.
*       IF SOURCE DATA HAS DECIMAL PART, MOVE MOST SIGNIFICANT DECIMAL
*     DIGIT INTO "INTERBUF" RIGHT AFTER THE SIGNIFICANT PART. 
*       CALL "EXTRACTSOP", "ROUND", AND "STORESOP" TO EXTRACT S-O-P,
*     ROUND DATA, AND STORE S-O-P, IF NECESSARY.
*       MOVE DATA STRING FROM "INTERBUF" TO TARGET. 
 #
  
  
      IF TCURLENG LS SGNTDIGITS THEN
        BEGIN 
        ERRCODE=O"666";      #LOSS OF DIGIT OF SIGNIFICANCE.           #
        RETURN; 
        END 
  
      CALL CMOVE(SCURLOC,SCURBYTE+LEADZEROS,SGNTDIGITS,LOCINTERBUF, 
                 TCURLENG-SGNTDIGITS); #MOVE SIGNIFICANT PART FROM
                                        SOURCE INTO "INTERBUF".        #
      IF DECDIGITS EQ 0 THEN           #YES - NO DECIMAL DIGITS.       #
        CALL EXTRACTSOP(TCURLENG-1);   #EXTRACT SOP AT IT"S ONE 
                                        PROBABLE POSITION.             #
      ELSE
        BEGIN 
        CALL CMOVE(SCURLOC,SCURBYTE+SCURLENG-DECDIGITS,1,LOCINTERBUF, 
                   TCURLENG);          #GET MOST SIGNIFICANT DEC DIGIT.#
        CALL EXTRACTSOP(TCURLENG);     #THIS DIGIT COULD BE LAST DIGIT
                                        IN STRING AND THUS MAY BE SOP. #
        CALL ROUND(TCURLENG);          #ROUND OF THIS LAST DIGIT.      #
        END 
  
      CALL STORESOP(TCURLENG-1);       #STORE SOP, IF NEEDED.          #
      CALL CMOVE(LOCINTERBUF,0,TCURLENG,TCURLOC,TCURBYTE);
                                       #MOVE FROM "INTERBUF" TO TARGET.#
      RETURN; 
      CONTROL EJECT;
  
DNUMTODFXPT:                 #DISPLAY NUMERIC TO DISPLAY FIXED POINT.  #
  
 #
  *   DNUMTODFXPT - CONVERSION 3 - 4
* *   C C CHOW      6/15/74 
* 
* DC  PURPOSE 
*       PERFORM CONVERSION FROM DISPLAY NUMERIC TO DISPLAY FIXED PT.
* 
* DC  ENTRY CONDITIONS
*       SCURLOC/SCURBYTE/SCURLENG CONTAINS SOURCE DATA. 
*       SIGNPLUS = TRUE IF SOURCE +VE.
*       LEADZEROS = COUNT OF LEADING ZEROS IN SOURCE. 
*       SGNTDIGITS = COUNT OF SIGNIFICANT DIGITS IN SOURCE. 
*       DECDIGITS = COUNT OF DECIMAL DIGITS IN SOURCE. SET TO 0.
*       TCURLOC/TCURBYTE/TCURLENG/TGXPLICD/TGDECPOS/TGSIGNED INDICATE 
*     TARGET LOCATION AND FORMAT. 
* 
* DC  EXIT CONDITIONS 
*       ASSUMELEFT  = COUNT OF SOURCE ASSUMED LEFT ZEROS SET TO 0.
*       ASSUMERIGHT = COUNT OF SOURCE ASSUMED RIGHT ZEROS SET TO 09 
* 
* DC  DESCRIPTIONS
*       PROCEDURE FOR CONVERSION 3-4 IS A SUBSET OF CONVERSION 4-4, 
*     WHEN SOURCE IS IMPLICITLY DECIMALED WITH DECIMAL POSITION 0.
*     THUS "ASSUMERIGHT" AND "ASSUMELEFT" WILL BE SET TO 0 TO INDICATE
*     THIS FACT, AND WILL BRANCH TO 4-4 CONVERSION MODULE.
 #
  
  
# PROCEDURE IS SAME AS CONVERTING FROM DISPLAY FIXED PT TO DISPLAY
  FIXED PT WITH 0 .LQ. SRDECPOS .LQ. SCURLENG.                         #
      ASSUMERIGHT=0;         #IMPLIES  0 .LQ. SRDECPOS.                #
      ASSUMELEFT=0;          #IMPLIES  SRDECPOS .LQ. SCURLENG.         #
      GOTO DFXPTTODFXPT;     #PERFORM PROCEDURE FOR DFXPT-DFXPT.       #
      CONTROL EJECT;
  
DNUMTOUNORM:                 #DISPLAY NUMERIC TO UNNORMALIZED.         #
  
DNUMTOINT:                   #DISPLAY NUMERIC TO BINARY INTEGER        #
DFXPTTOINT:                  #DISPLAY FIXED PT. TO BINARY INTEGER      #
DFXPTTOUNORM:                #DISPLAY FIXED PT TO UNNORMALIZED.        #
  
 #
  *   DNUMTOINT - CONVERSION 3 - 10 
  *   DNUMTOUNORM - CONVERSION 3 - 12 
  *   DFXPTTOINT - CONVERSION 4 - 10
* *   DFXPTTOUNORM - CONVERSION 4 - 12
* *   C C CHOW      6/15/74 
* 
* DC  PURPOSE 
*       PERFORM CONVERSION FROM DISPLAY NUMERIC (CLASS 3) OR DISPLAY
*     FIXED PT (CLASS 4) TO BINARY INTEGER (CLASS 10).
* 
* DC  ENTRY CONDITIONS
*       SCURLOC/SCURBYTE/SCURLENG GIVES LOCATION OF SOURCE DATA.
*       SRDECPOS/SRXPLICD GIVE DECIMAL PT INFO OF CLASS 4 SOURCE. 
*       TCURLOC/TGDECPOS GIVE LOCATION AND FORMAT OF TARGET.
*       LEADZEROS = COUNT OF LEADING ZEROS IN SOURCE. 
*       SIGNPLUS = TRUE IF SOURCE +VE.
* 
* DC  EXIT CONDITIONS 
*         SOURCE DATA CONVERTED AND MOVED TO TARGET 
* 
* DC  NON-LOCAL VARIABLES 
*       DM$CMBF 
*         EXPONEN - PARAMETER FOR "DM$BTOF". SCALING FACTOR.
*         FLAGDBL - PARAMETER FOR "DM$BTOF". DOUBLE PRECISION FLAG. 
*         SINGLE  - SINGLE PRECISION RESULT OF "DM$BTOF". 
*         RETURNC - RETURN CODE FORM "DM$BTOF". 0 - NORMAL. 
*       RI - REAL SCRATCH VARIABLE. 
*       I  - INTEGER SCRATCH VARIABLE.
*       BASED ARRAY "TGFIELD".
* 
* DC  CALLED ROUTINES 
*       DISPLAYTOBIN - DISPLAY TO BINARY CONVERSION.
*       DM$BTOF - BUNARY TO FLOATING CONVERSION.
* 
* DC  DESCRIPTIONS
*       CALL "DISPLAYTOBIN" TO CONVERT SOURCE DISPLAY CODE TO BINARY
*     INTEGER.
*       WITH SCALING FACTOR SET IN "EXPONEN" BASED ON SOURCE AND TARGET 
*     DECIMAL POSITION, CALL "DM$BTOF" TO CONVERT BINARY INTEGER INTO 
*     NORMALIZED FLOATING PT. THE INTEGER PART OF THIS NORMALIZED 
*     FLOATING PT REPRESENTS THE VALUE OF THE MANTISSA OF THE DESIRED 
*     UNNORMALIZED FLOATING PT. 
*       CHECK IF THIS VALUE COULD BE FIT IN 48 BITS AS THE MANTISSA. IF 
*     NOT,ERROR EXIT WITH CODE 666, IF TARGET CLASS IS 12.
*       CONVERT THE NORMALIZED FLOATING PT TO BINARY INTEGER, AND PACK
*     IT WITH EXPONENT O"2000" IF TARGET CLASS IS CLASS 12. 
*       MOVE TO TARGET. COMPLIMENT IF -VE.
 #
  
  
      CALL DISPLAYTOBIN;     #CONVERT SOURCE INTO 108 BIT BINARY.      #
      EXPONEN=TGDECPOS+EXPONEN;        #SET SCALING FACTOR.            #
      FLAGDBL=FALSE;         #SET FLAG TO INDICATE SINGLE PRECISION.   #
      CALL DM$BTOF;          #CONVERT BINARY TO FLOATING PT NUMBER.    #
      IF RETURNC NQ 0 THEN   #YES - DM$BTOF DETECTS ERROR.             #
        BEGIN 
        ERRCODE=RETURNC;
        RETURN; 
        END 
      RI=ABS(SINGLE)+0.5;    #ROUNDING. RI IS SCRATCH VARIABLE.        #
      P<TGFIELD>=TCURLOC; 
      TGINTEGER[0] = RI;               #CONVERT TO INTEGER             #
      IF SINGLE LS 0. THEN             #YES - NEGATIVE VALUE.          #
        TGINTEGER[0] = -TGINTEGER[0]; 
      RETURN; 
      CONTROL EJECT;
  
DNUMTONORM:                  #DISPLAY NUMERIC TO NORMALIZED.           #
  
DFXPTTONORM:                 #DISPLAY FIXED PT TO NORMALEZED.          #
  
 #
  *   DNUMTONORM - CONVERSION 3 - 13
* *   DFXPTTONORM - CONVERSION 4 - 13 
* *   C C CHOW      6/15/74 
* 
* DC  PURPOSE 
*       PERFORM CONVERSION FROM DISPLAY NUMERIC (CLASS 3) OR DISPLAY
*     FIXED PT (CLASS 4) TO NORMALIZED FLOATING PT (CLASS 13).
* 
* DC  ENTRY CONDITIONS
*       SCURLOC/SCURBYTE/SCURLENG GIVE LOCATION OF SOURCE DATA. 
*       SRDECPOS/SRXPLICD GIVE DEC PT INFO OF CLASS 4 SOURCE. 
*       TCURLOC = LOCATION OF TARGET. 
*       LEADZEROS = COUNT OF LEADING ZEROS IN SOURCE. 
*       SIGNPLUS = TRUE IF SOURCE +VE.
* 
* DC  EXIT CONDITIONS 
*       SOURCE DATA CONVERTED TO NORMALIZED FLOATING FORM AND MOVED 
*     TO TARGET.
* 
* DC  NON-LOCAL VARIABLES 
*       DM$CMBF 
*         FLAGDBL - DOUBLE PRECISION FLAG.
*         SINGLE  - SINGLE PRECISION RESULT.
*         RETURNC - RETURN CODE FROM "DM$BTOF". 0 - NORMAL. 
*       BASED ARRAY "TGFIELD".
* 
* DC  CALLED ROUTINES 
*       DISPLAYTOBIN - DISPLAY TO BINARY CONVERSION.
*       DM$BTOF - BINARY TO FLOATING CONVERSION.
* 
* DC  DESCRIPTIONS
*       CALL "DISPLAYTOBIN" TO CONVERT SOURCE DISPLAY CODE TO BINARY
*     INTEGER.
*       CALL "DM$BTOF" TO CONVERT THE BINARY INTEGER TO NORMALIZED
*     FLOATING PT, AND MOVE IT TO TARGET. IF "DM$BTOF" RETURNS ERROR, 
*     ERROR EXIT. 
 #
  
  
      CALL DISPLAYTOBIN;     #CONVERT SOURCE INTO 108 BIT BINARY.      #
      FLAGDBL=FALSE;
      CALL DM$BTOF;          #CONVERT BINARY TO FLOATING.              #
      IF RETURNC NQ 0 THEN   #YES - DM$BTOF DETECTS ERROR.             #
        BEGIN 
        ERRCODE=RETURNC;
        RETURN; 
        END 
      P<TGFIELD>=TCURLOC; 
      TGREAL[0]=SINGLE; 
      RETURN; 
      CONTROL EJECT;
  
DNUMTODOUBL:                 #DISPLAY NUMERIC TO DOUBLE PRECISION.     #
  
DFXPTTODOUBL:                #DISPLAY FIXED PT TO DOUBLE PRECISION.    #
  
 #
  *   DNUMTODOUBL - CONVERSION 3 - 14 
* *   DFXPTTODOUBL - CONVERSION 4 - 14
* *   C C CHOW      6/15/74 
* 
* DC  PURPOSE 
*       PERFORM CONVERSION FROM DISPLAY NUMERIC (CLASS 3) OR DISPLAY
*     FIXED PT (CLASS 4) TO DOUBLE PRECISION (CLASS 14).
* 
* DC  ENTRY CONDITIONS
*       SCURLOC/SCURBYTE/SCURLENG GIVE LOCATION OF SOURCE DATA. 
*       SRDECPOS/SRXPLICD GIVE DEC PT INFO OF CLASS 4 SOURCE. 
*       TCURLOC = LOCATION OF TARGET. 
*       LEADZEROS = COUNT OF LEADING ZEROS IN SOURCE. 
*       SIGNPLUS = TRUE IF SOURCE +VE.
* 
* DC  EXIT CONDITIONS 
*       SOURCE DATA CONVERTED TO DOUBLE PRECISION FORM AND MOVED TO 
*     TARGET. 
* 
* DC  NON-LOCAL VARIABLES 
*       DM$CMBF 
*         FLAGDBL - DOUBLE PRECISION FLAG.
*         SINGLE - SINGLE PRECISION RESULT. 
*         DOUBLE - DOUBLE PRECISION RESULT. 
*         RETURNC - RETURN CODE FROM "DM$BTOF". 
*       BASED ARRAY "TGFIELD".
* 
* DC  CALLED ROUTINES 
*       DISPLAYTOBIN - DISPLAY TO BINARY CONVERSION.
*       DM$BTOF - BINARY TO FLOATING CONVERSION.
* 
* DC  DESCRIPTIONS
*       CALL "DISPLAYTOBIN" TO CONVERT SOURCE DISPLAY CODE TO BINARY
*     INTEGER.
*     SET SCALING FACTOR IN "EXPONEN", AND CALL "DM$BTOF" TO CONVERT
*     THE BINARY INTEGER TO DOUBLE PRECISION. MOVE RESULT TO TARGET.
*     IF "DM$BTOF" RETURNS ERROR, ERROR EXIT. 
 #
  
  
      CALL DISPLAYTOBIN;     #CONVERT SOURCE INTO 108 BIT BINARY.      #
      EXPONEN=TGDECPOS+EXPONEN;        #SET SCALING FACTOR.            #
      FLAGDBL=TRUE;          #SET FLAG TO INDICATE DOUBLE PRECISION.   #
      CALL DM$BTOF;          #CONVERT BINARY TO FLOATING.              #
      IF RETURNC NQ 0 THEN   #YES - DM$BTOF DETECTS ERROR.             #
        BEGIN 
        ERRCODE=RETURNC;
        RETURN; 
        END 
      P<TGFIELD>=TCURLOC; 
      TGREAL[0]=SINGLE;      #1ST DOUBLE PRECISION WORD.               #
      TGREAL[1]=DOUBLE;      #2ND DOUBLE PRECISION WORD.               #
      RETURN; 
      CONTROL EJECT;
  
DFXPTTODNUM:                 #DISPLAY FIXED PT TO DISPLAY NUMERIC.     #
  
 #
  *   DFXPTTODNUM - CONVERSION 4 - 3
* *   C C CHOW      6/15/74 
* 
* DC  PURPOSE 
*       PERFORM CONVERSION FROM DISPLAY FIXED PT (CLASS 4) TO DISPLAY 
*     NUMERIC (CLASS 3).
* 
* DC  ENTRY CONDITIONS
*       SCURLOC/SCURBYTE/SCURLENG CONTAINS SOURCE DATA. 
*       ASSUMERIGHT = COUNT OF SOURCE ASSUMED RIGHT ZEROS.
*       ASSUMELEFT = 3OUNT OF SOURCE ASSUMED LEFT ZEROS.
*       SGNTDIGITS = COUNT OF SOURCE SIGNIFICANT DIGITS.
*       DECDIGITS = COUNT OF SOURCE DECIMAL DIGITS. 
*       LEADZEROS = COUNT OF SOURCE LEADING ZEROS.
*       TCURLOC/TCURBYTE/TCURLENG GIVE LOCATION OF TARGET.
* 
* DC  EXIT CONDITIONS 
*       NORMAL: 
*         SOURCE DATA CONVERTED AND MOVED TO TARGET.
*       ERROR:  
*         ERRCODE = O"666". 
*       IF NO ASSUMED ZEROS, CONTROL TO "ALNUMTODNUM".
* 
* DC  CALLED ROUTINES 
*       IF NO ASSUMED ZERO IN SOURCE, PROCEDURE REMAINING IDENTICAL 
*     TO THAT OF CONVERSION 0 - 3. GOTO "ALNUMTODNUM".
*       IF SOURCE HAS ASSUMED LEFT ZEROS, TARGET VALUE WILL BE 0. 
*       IF SOURCE HAS ASSUMED RIGHT ZEROS, CHECK IF TARGET LARGE ENOUGH 
*     TO HOLD SOURCE VALUE. IF NOT, ERROR EXIT WITH CODE 666. IF YES, 
*     MOVE DATA INTO "INTERBUF" WITH TRAILING ZEROS IN PLACE. EXTRACT 
*     S-O-P IF NECESSARY. 
*       STORE S-O-P IF REQD AND MOVE DATA FROM "INTERBUF" TO TARGET.
 #
  
  
      IF ASSUMERIGHT EQ 0 THEN         #TRUE - SRDECPOS .GQ. 0.        #
        BEGIN 
        IF ASSUMELEFT EQ 0 THEN        #TRUE - SRDECPOS .LQ. SCURLENG. #
          GOTO ALNUMTODNUM;  #PROCEDURE SAME AS ALPHANUM TO DISPLAYNUM.#
        END 
      ELSE                             #SRDECPOS .LS. 0.               #
        BEGIN 
        IF TCURLENG LS (SGNTDIGITS+ASSUMERIGHT) THEN
          BEGIN 
          ERRCODE=O"666";    #LOSS OF SIGNIFICANT DIGITS.              #
          RETURN; 
          END 
        CALL CMOVE(SCURLOC,SCURBYTE+LEADZEROS,SGNTDIGITS, 
                   LOCINTERBUF,TCURLENG-SGNTDIGITS-ASSUMERIGHT);
        CALL EXTRACTSOP(TCURLENG-ASSUMERIGHT-1);
        END 
      CALL STORESOP(TCURLENG-1);
      CALL CMOVE(LOCINTERBUF,0,TCURLENG,TCURLOC,TCURBYTE);
      RETURN; 
      CONTROL EJECT;
  
DFXPTTODFXPT:                #DISPLAY FIXED POINT TO DISPLAY FIXED PT. #
  
 #
  *   DFXPTTODFXPT - CONVERSION 4 - 4 
* *   C C CHOW      6/15/74 
* 
* DC  PURPOSE 
*       PERFORM CONVERSION FROM DISPLAY FIXED PT (CLASS 4) TO DISPLAY 
*     FIXED PT (CLASS 4). 
* 
* DC  ENTRY CONDITIONS
*       SCURLOC/SCURBYTE/SCURLENG CONTAINS SOURCE DATA. 
*       SGNTDIGITS = COUNT OF SIGNIFICANT DIGITS IN SOURCE. 
*       DECDIGITS = COUNT OF DECIMAL DIGITS IN SOURCE.
*       LEADZEROS - COUNT OF LEADING ZEROS IN SOURCE. 
*       SIGNPLUS = TRUE IF SOURCE +VE.
*       TCURLOC/TCURBYTE/TCURLENG/TGXPLICD/TGDECPOS GIVE LOCATION AND 
*     FORMAT OF TARGET. 
* 
* DC  EXIT CONDITIONS 
*       NORMAL: 
*         SOURCE DATA CONVERTED AND MOVED TO TARGET.
*       ERROR:  
*         ERRCODE = O"666". 
* 
* DC  NON-LOCAL VARIABLES 
*       TSGNTLEN - COUNT OF SIGNIFICANT DIGITS IN TARGET. 
*       TDECLEN - COUNT OF DECIMAL DIGITS IN TARGET.
*       TASMRIGHT - COUNT OF ASSUMED RIGHT ZERO IN TARGET.
*       TASMLEFT - COUNT OF ASSUMED LEFT ZEROS IN TARGET. 
*       LENGDIFF - TARGET/SOURCE LENGTH DIFFERENCE. 
*       I - SCRATCH ITEM. 
*       J - SCRATCH ITEM. 
* 
* DC  CALLED ROUTINES 
*       TG4INITIAL - TARGET CLASS 4 INITIALIZATION. 
*       CMOVE - CHARACTER MOVE. 
*       CHECKALLZERO - CHECK SPECIFIED STRING FOR ALL ZEROS.
*       EXTRACTSOP - EXTRACT SIGN OVER PUNCH. 
*       STORESOP - STORE SIGN OVER PUNCH. 
*       ROUND - ROUND NUMERIC STRING. 
* 
* DC  DESCRIPTIONS
*       CALL "TG4INITIAL" TO SET UP DESCRIPTIONS OF TARGET FORMAT.
*       CHECK IF TARGET SIZE LARGE ENOUGH TO HOLD DATA. IF NOT, ERROR 
*     EXIT WITH CODE 666. 
*       DEPENDING ON SOURCE DECIMAL POSITION, ONE OF 3 PATHS WILL BE
*     TAKEN. THEY ARE:  
*       (1). SRDECPOS < 0.
*       (2). SRDECPOS > SCURLENG. 
*       (3). 0 .LQ. SRDECPOS .LQ. SCURLENG. 
*       THEN FROM EACH OF THESE, AGAIN ONE OF 3 PATHS WILL BE TAKEN,
*     THIS TIME BASED ON TARGET DECIMAL POSITION: 
*       (1). TGDECPOS < 0.
*       (2). TGDECPOS > TCURLENG. 
*       (3). 0 .LA. TGDECPOS .LQ. TCURLENG. 
*       IN EACH OF THESE SUBPARTS, THE SOURCE DATA IS MOVED, PART BY
*     PART IF NECESSARY, INTO "INTERBUF" BASED ON TARGET FORMAT. SIGN-
*     EXTRACTING, ROUNDING, SIGN-INSERTING, AND DECIMAL-INSERTING ARE 
*     DONE IF REQD. THE DATA IS THEN MOVED FROM "INTERBUF" TO TARGET. 
 #
  
  
      CALL TG4INITIAL;       #INITIALIZATION FOR TARGET CLASS 4.       #
      LENGDIFF=TSGNTLEN+TASMRIGHT-SGNTDIGITS-ASSUMERIGHT; 
      IF LENGDIFF LS 0 THEN  #TRUE - TARGET NOT LARGE ENOUGH FOR
                                     SIGNIFICANT SOURCE PART.          #
        BEGIN 
        ERRCODE=O"666"; 
        RETURN; 
        END 
  
# THIS MODULE WILL BE IN 3 PARTS, DEPENDING ON SOURCE DECIMAL POSITION. 
    (1).  SRDECPOS < 0. 
    (2).  SRDECPOS > SCURLENG.
    (3).  0 @ SRDECPOS @ SCURLENG.
  EACH PART WILL IN TURN BE IN 3 SUBPARTS.
    (1).  TGDECPOS < 0. 
    (2).  TGDECPOS > TCURLENG.
    (3).  0 @ TGDECPOS @ TCURLENG.                                     #
  
      IF ASSUMERIGHT NQ 0 THEN         #TRUE - SRDECPOS < 0.           #
        BEGIN 
        IF SGNTDIGITS NQ 0 THEN        #TRUE - VALUE OF SOURCE NOT 0.  #
          BEGIN 
          IF TASMRIGHT GR ASSUMERIGHT THEN       #DECIDE MOVE LENGTH.  #
            I=SGNTDIGITS+ASSUMERIGHT-TASMRIGHT+1; 
          ELSE
            I=SGNTDIGITS; 
          CALL CMOVE(SCURLOC,SCURBYTE+LEADZEROS,I,LOCINTERBUF,LENGDIFF);
          CALL EXTRACTSOP(LENGDIFF+I-1);
          END 
        IF TGXPLICD THEN               #TRUE - 0 @ TGDECPOS @ TCURLENG.#
          C<TSGNTLEN>INTERBUF=O"57";             #STORE DECIMAL POINT. #
        END 
      ELSE
        BEGIN 
        IF ASSUMELEFT NQ 0 THEN        #TRUE - SRDECPOS > SCURLENG.    #
          BEGIN 
  
          IF TASMRIGHT EQ 0 THEN       #TRUE - TARGET HAS DEC DIGITS.  #
            BEGIN 
            LENGDIFF=TASMLEFT-ASSUMELEFT; 
            IF LENGDIFF GR 0 THEN 
              BEGIN 
              IF LENGDIFF GR SCURLENG THEN
                J=SCURLENG; 
              ELSE
                J=LENGDIFF; 
              CALL CHECKALLZERO(SCURLOC,SCURBYTE,J);
                             #CHECK IF IMPLIED PART IN TARGET ALL 0.   #
              IF TCURLENG LS (SCURLENG-LENGDIFF) THEN 
                I=TCURLENG+1; 
              ELSE
                I=SCURLENG-LENGDIFF;
              CALL CMOVE(SCURLOC,SCURBYTE+LENGDIFF,I,LOCINTERBUF,0);
              CALL EXTRACTSOP(I-1); 
              END 
            ELSE
              BEGIN 
              IF TDECLEN  LS (SCURLENG-LENGDIFF) THEN 
                I=TDECLEN +LENGDIFF+1;
              ELSE
                I=SCURLENG; 
              J=TCURLENG-TDECLEN -LENGDIFF; 
              CALL CMOVE(SCURLOC,SCURBYTE,I,LOCINTERBUF,J); 
              CALL EXTRACTSOP(J+I-1); 
              END 
            IF TGXPLICD THEN
              C<TSGNTLEN>INTERBUF=O"57";
            END 
          END 
        ELSE                 # 0 @ SRDECPOS @ SCURLENG.                #
          BEGIN 
          IF TASMRIGHT GR 0 THEN
            BEGIN 
            CALL CMOVE(SCURLOC,SCURBYTE+LEADZEROS,
                       SGNTDIGITS-TASMRIGHT+1,LOCINTERBUF,
                       TCURLENG+TASMRIGHT-SGNTDIGITS);
            CALL EXTRACTSOP(TCURLENG);
            END 
          ELSE
            BEGIN 
            IF TASMLEFT GR 0 THEN 
              BEGIN 
              IF TASMLEFT GR DECDIGITS THEN 
                J=DECDIGITS;
              ELSE
                J=TASMLEFT; 
              CALL CHECKALLZERO(SCURLOC,SCURBYTE+SCURLENG-DECDIGITS,J); 
              IF TCURLENG LS (DECDIGITS-TASMLEFT) THEN
                I=TCURLENG+1; 
              ELSE
                I=DECDIGITS-TASMLEFT; 
              CALL CMOVE(SCURLOC,SCURBYTE+SCURLENG-DECDIGITS+TASMLEFT,
                         I,LOCINTERBUF,0);
              CALL EXTRACTSOP(I-1); 
              END 
            ELSE             # 0 @ TGDECPOS @ TCURLENG.                #
              BEGIN 
              CALL CMOVE(SCURLOC,SCURBYTE+LEADZEROS,SGNTDIGITS, 
                         LOCINTERBUF,TSGNTLEN-SGNTDIGITS);
              IF TGXPLICD THEN
                C<TSGNTLEN>INTERBUF=O"57";
              IF TDECLEN LS DECDIGITS THEN
                I=TDECLEN+1;
              ELSE
                I=DECDIGITS ; 
              CALL CMOVE(SCURLOC,SCURBYTE+SCURLENG-DECDIGITS,I, 
                         LOCINTERBUF,TCURLENG-TDECLEN); 
              CALL EXTRACTSOP(TCURLENG-TDECLEN+I-1);
              END 
            END 
          END 
        END 
  
      CALL ROUND(TCURLENG); 
      CALL STORESOP(TCURLENG-1);
      CALL CMOVE(LOCINTERBUF,0,TCURLENG,TCURLOC,TCURBYTE);
      RETURN; 
      CONTROL EJECT;
  
NONSUPPORT:                  #NON-SUPPORTED CONVERSION.                #
  
      ERRCODE=O"663"; 
  
  
  
CONV$EXIT:                   #CONVERSION ROUTINE EXIT.                 #
  
      RETURN; 
      CONTROL EJECT;
  
      PROC CHECKCLS3;        #CHECK-SOURCE-CLASS3.                     #
      BEGIN 
  
 #
  *   CHECKCLS3 - CHECK SOURCE CLASS 3
* *   C C CHOW      6/15/74 
* 
* DC  PURPOSE 
*       VERIFY THAT SOURCE DATA IS LEGAL CLASS 3. 
* 
* DC  ENTRY CONDITIONS
*       SCURLOC  = SOURCE LOCATION. 
*       SCURBYTE = SOURCE BEGINNING BYTE POSITION.
*       SCURLENG = SOURCE LENGTH IN BYTES.
* 
* DC  EXIT CONDITIONS 
*       NORMAL: 
*         SIGNPLUS  = TRUE IF SOURCE DATA +VE.
*         LEADZEROS = NUMBER OF LEADING ZEROS IN SOURCE DATA. 
*       ERROR:  
*         ERRCODE = O"664". 
* 
* DC  NON-LOCAL VARIABLES 
*       GETBYTE - PARAMETER FOR "GETSRCHAR". POSITION OF BYTE TO GET. 
*       CHAR    - SET BY "GETSRCHAR" TO VALUE OF CURRENT SOURCE BYTE. 
* 
* DC  CALLING ROUTINES
*       MODULE "SRDNUMERIC".
* 
* DC  CALLED ROUTINES 
*       GETSRCHAR - GET SOURCE CHARACTER. 
* 
* DC  DESCRIPTIONS
*       SCAN SOURCE DATA STRING CHAR BY CHAR AND CHECK IF EACH IS 
*     DISPLAY CODE 0 TO 9. IF NOT, CHECK IF IT IS LAST DIGIT AND SIGN-
*     OVER-PUNCH, AND IF IT IS NOT, EXIT WITH ERRCODE 664.
*       SET "SIGNPLUS" AND "LEADZEROS" TO INDICATE SOURCE SIGN AND
*     NUMBER OF LEADING ZEROS, IF ANY.
 #
  
  
      SIGNPLUS=TRUE;         #INITIALIZE SIGN TO +VE.                  #
      LEADZEROS=0;           #NO LEADING ZEROS.                        #
  
# IDENTIFY LEADING ZEROS.                                              #
  
      P<SRFIELD>=SCURLOC; 
      GETBYTE=SCURBYTE; 
      FOR I=1 THRU SCURLENG DO
        BEGIN 
        CALL GETSRCHAR;      #GET CHAR FROM SOURCE.                    #
        IF CHAR NQ O"33" THEN          #YES - NOT ZERO.                #
          BEGIN 
          GETBYTE=GETBYTE-1;
          GOTO THRULEADZERO; #THRU WITH IDENTIFYING LEADING ZEROS.     #
          END 
        LEADZEROS=LEADZEROS+1;         #INCREMENT LEADING ZERO COUNT.  #
        END 
      RETURN;                #WHOLE SOURCE STRING HAS BEEN SCANNED. IN
                              THIS CASE, IT"S ALL ZEROS.               #
  
THRULEADZERO:                #LEADING ZEROS HAVE BEEN IDENTIFIED. NOW 
                              CONTINUE WITH REST OF SOURCE STRING.     #
      FOR J=I THRU SCURLENG DO
        BEGIN 
        CALL GETSRCHAR; 
  
# CHECK FOR LEGAL NUMERIC DIGITS "0" TO "9"                            #
  
        IF CHAR GQ O"33" AND CHAR LQ O"44" THEN  #YES - LEGAL NUMERIC. #
          TEST; 
  
# CHECK IF IT IS LAST DIGIT AND SIGN-OVER-PUNCH.                       #
  
        IF J EQ SCURLENG THEN          #YES - LAST DIGIT.              #
          BEGIN 
          IF CHAR EQ O"72" OR CHAR EQ O"66" THEN        #YES - SOP "0".#
            BEGIN 
            IF J EQ I THEN   #YES - BYTE RIGHT AFTER LEADING ZEROS.    #
              LEADZEROS=LEADZEROS+1;
            IF CHAR EQ O"66" THEN 
              SIGNPLUS=FALSE; 
            RETURN; 
            END 
          IF CHAR GQ O"01" AND CHAR LQ O"11" THEN       #YES - +VE SOP.#
            RETURN; 
          IF CHAR GQ O"12" AND CHAR LQ O"22" THEN       #YES - -VE SOP.#
            BEGIN 
            SIGNPLUS=FALSE; 
            RETURN; 
            END 
          END 
  
        ERRCODE=O"664";      #ILLEGAL SOURCE STRING ERROR.             #
        GOTO CONV$EXIT;      #RETURN TO CALLER.                        #
        END 
      END 
      CONTROL EJECT;
  
      PROC CHECKCLS4;        #CHECK-SOURCE-CLASS4.                     #
      BEGIN 
  
 #
  *   CHECKCLS4 - CHECK SOURCE CLASS 4
* *   C C CHOW      6/15/74 
* 
* DC  PURPOSE 
*       VERIFY THAT SOURCE DATA IS LEGAL CLASS 4. 
* 
* DC  ENTRY CONDITIONS
*       SCURLOC  = SOURCE LOCATION. 
*       SCURBYTE = SOURCE BEGINNING BYTE POSITION.
*       SCURLENG = SOURCE LENGTH IN BYTES.
*       SRDECPOS = SOURCE DECIMAL PT POSITION.
*       SRXPLICD = TRUE IF SOURCE EXPLICITLY DECIMALED. 
* 
* DC  EXIT CONDITIONS 
*       NORMAL: 
*         SIGNPLUS  = TRUE IF SOURCE DATA +VE.
*         LEADZEROS = NUMBER OF LEADING ZEROS IN SOURCE. WILL INCLUDE 
*                     ONLY THE EXPLICIT LEADING ZEROS OF INTEGER PART.
*       ERROR:  
*         ERRCODE = O"664". 
* 
* DC  NON-LOCAL VARIABLES 
*       GETBYTE - PARAMETER FOR "GETSRCHAR". POSITION OF BYTE TO GET. 
*       CHAR    - SET BY "GETSRCHAR" TO VALUE OF CURRENT SOURCE BYTE. 
* 
* DC  CALLING ROUTINE 
*       MODULE "SRDFIXEDPT".
* 
* DC  CALLED ROUTINES 
*       GETSRCHAR - GET SOURCE CHARACTER. 
* 
* DC  DESCRIPTIONS
*       SCAN SOURCE DATA STRING CHAR BY CHAR AND VERIFY THAT IT CONTAINS
*     ONLY DISPLAY CODE 0 TO 9, WITH OPTIONAL DECIMAL PT AND LAST DIGIT 
*     SIGN-OVER-PUNCH IF SPECIFIED. IN CASE LAST DIGIT IS EXPLICIT
*     DECIMAL POINT, WIGN-OVER-PUNCH MAY BE AT 2ND LAST POSITION. 
*       SET "SIGNPLUS" AND "LEADZEROS" TO INDICATE SOURCE SIGN AND
*     NUMBER OF LEADING ZEROS. ("LEADZEROS" WILL ONLY INCLUDE THE 
*     EXPLICIT LEADING ZEROS OF THE INTEGER PART OF SOURCE.)
 #
  
  
      SIGNPLUS=TRUE;         #INITIALIZE TO INDICATE +VE SIGN.         #
      LEADZEROS=0;           #INITIALIZE LEADING ZERO COUNT TO ZERO.   #
  
# IDENTIFY LEADING ZEROS.                                              #
  
      P<SRFIELD>=SCURLOC; 
      GETBYTE=SCURBYTE; 
      IF SRDECPOS GQ SCURLENG THEN     #DEC PT IS LEFT OF SOURCE.      #
        BEGIN 
        LEADZEROS=0;
        I=SCURLENG;          #SET "I" FOR LATER USE.                   #
        END 
      ELSE
        BEGIN 
        FOR I=SCURLENG STEP -1 UNTIL 1 DO 
          BEGIN 
          IF I EQ SRDECPOS THEN        #YES - ALL ZEROS BEFORE DEC PT. #
            BEGIN 
            IF SRXPLICD THEN           #YEW - SOURCE EXPLICITLY DEC.   #
              BEGIN 
              ERRCODE=O"664";          #A "0" WAS WHERE "." SHOULD BE. #
              GOTO CONV$EXIT; 
              END 
            GOTO OVERLEADZERO;
            END 
          CALL GETSRCHAR; 
          IF CHAR NQ O"33" THEN 
            BEGIN 
            GETBYTE=GETBYTE-1;
            GOTO OVERLEADZERO;
            END 
          LEADZEROS=LEADZEROS+1;
          END 
        RETURN;              #SOURCE STRING IS ALL ZEROS.              #
        END 
  
OVERLEADZERO:                #DONE WITH IDENTIFYING LEADING ZEROS.     #
  
      FOR J=I STEP -1 UNTIL 1 DO
        BEGIN 
        CALL GETSRCHAR; 
  
# CHECK FOR EXPLICIT DECIMAL POINT.                                    #
  
        IF SRXPLICD THEN     #YES - SOURCE EXPLICITLY DECIMALED.       #
          BEGIN 
          IF SRDECPOS EQ (J-1) THEN    #YES - AT DECIMAL POSITION.     #
            BEGIN 
            IF CHAR EQ O"57" THEN      #YES - DECIMAL PT.              #
              TEST; 
            ELSE
              BEGIN 
              ERRCODE=O"664"; 
              GOTO CONV$EXIT; 
              END 
            END 
          END 
  
# CHECK FOR LEGAL NUMERIC DIGITS "0" TO "9".                           #
  
        IF CHAR GQ O"33" AND CHAR LQ O"44" THEN  #YES - LEGAL NUMERIC. #
          TEST; 
  
# CHECK IF IT IS LAST DIGIT AND SIGN-OVER-PUNCH.                       #
  
        IF J EQ 1 OR                   #YES - LAST BYTE IN SOURCE.     #
           (J EQ 2 AND SRDECPOS EQ 0 AND SRXPLICD) THEN 
                             #YES - LAST BYTE AHEAD OF DECIMAL.        #
          BEGIN 
          IF CHAR EQ O"72" OR CHAR EQ O"66" THEN        #YES - SOP "0".#
            BEGIN 
            IF J EQ I THEN   #YES - BYTE RIGHT AFTER LEADING ZEROS.    #
              LEADZEROS=LEADZEROS+1;
            IF CHAR EQ O"66" THEN 
              SIGNPLUS=FALSE; 
            TEST; 
            END 
          IF CHAR GQ O"01" AND CHAR LQ O"11" THEN       #YES - +VE SOP.#
            TEST; 
          IF CHAR GQ O"12" AND CHAR LQ O"22" THEN       #YES - -VE SOP.#
            BEGIN 
            SIGNPLUS=FALSE; 
            TEST; 
            END 
          END 
  
        ERRCODE=O"664";      #ILLEGAL SOURCE STRING ERROR.             #
        GOTO CONV$EXIT; 
        END 
      END 
      CONTROL EJECT;
  
      PROC CMOVE(SLOC,SBYTE,MVLENG,TLOC,TBYTE); 
      BEGIN 
  
 #
  *   CMOVE - CHARACTER MOVE
* *   C C CHOW      6/15/74 
* 
* DC  PURPOSE 
*       MOVE A SPECIFIED LENGTH OF DATA STRING FROM ONE LOCATION/ 
*     POSITION TO ANOTHER.
* 
* DC  ENTRY CONDITIONS
*       PARAMETERS PASSED:  
*         SLOC   = SOURCE LOCATION. 
*         SBYTE  = SOURCE BEGINNING BYTE POSITION.
*         MVLENG = LENGTH TO BE MOVED IN BYTES. 
*         TLOC   = TARGET LOCATION. 
*         TBYTE  = TARGET BEGINNING BYTE POSITION.
* 
* DC  EXIT CONDITIONS 
*       DATA STRING MOVED TO TLOC/TBYTE, LENGTH "MVLENG". 
* 
* DC  NON-LOCAL VARIABLES 
*       BASED ARRAY "SRFIELD".
*       BASED ARRAY "TGFIELD".
* 
* DC  DESCRIPTIONS
*       IF "MVLENG" EQ 0, RETURN. 
*       BYTE BY BYTE, "MVLENG" CHARS WERE MOVED FROM SOURCE TO TARGET.
 #
  
  
      ITEM SLOC;             #SOURCE LOCATION.                         #
      ITEM SBYTE;            #SOURCE BYTE.                             #
      ITEM MVLENG;           #LENGTH OF STRING TO BE MOVED.            #
      ITEM TLOC;             #TARGET LOCATION.                         #
      ITEM TBYTE;            #TARGET BYTE.                             #
  
      ITEM LENGMVED;         #LENGTH MOVED SO FAR.                     #
      ITEM MVSRBYTE;         #CURRENT SOURCE BYTE TO BE MOVED.         #
      ITEM MVTGBYTE;         #CURRENT TARGET BYTE.                     #
  
      IF MVLENG LQ 0 THEN    #TRUE - NOTHING TO BE MOVED.              #
        RETURN; 
  
      P<SRFIELD>=SLOC;
      P<TGFIELD>=TLOC;
      LENGMVED=0; 
      MVSRBYTE=SBYTE; 
      MVTGBYTE=TBYTE; 
  
      FOR K=K WHILE LENGMVED LS MVLENG DO 
        BEGIN 
  
        FOR K=K WHILE MVSRBYTE GR 9 DO #UPDATE "SRFIELD" AND "MVSRBYTE"#
          BEGIN 
          MVSRBYTE=MVSRBYTE-10; 
          P<SRFIELD>=LOC(SRFIELD)+1;
          END 
        FOR K=K WHILE MVTGBYTE GR 9 DO
          BEGIN 
          MVTGBYTE=MVTGBYTE-10; 
          P<TGFIELD>=LOC(TGFIELD)+1;
          END 
  
        C<MVTGBYTE>TGCHAR[0]=C<MVSRBYTE>SRCHAR[0];    #MOVE CHAR.      #
  
        MVTGBYTE=MVTGBYTE+1;
        MVSRBYTE=MVSRBYTE+1;
        LENGMVED=LENGMVED+1;
        END 
  
      END 
      CONTROL EJECT;
  
      PROC GETSRCHAR;        #GET-SOURCE-CHARACTER.                    #
  
      BEGIN 
  
 #
  *   GETSRCHAR - GET SOURCE CHARACTER
* *   C C CHOW      6/15/74 
* 
* DC  PURPOSE 
*       GET CURRENT CHAR BEING SCANNED FROM SOURCE. 
* 
* DC  ENTRY CONDITIONS
*       BASED ARRAY "SRFIELD" POINTS TO SOURCE DATA.
*       GETBYTE = CURRENT BYTE POSITION IN SOURCE WORD. 
* 
* DC  EXIT CONDITIONS 
*       CHAR = DISPLAY CODE VALUE OF CURRENT SOURCE CHAR. 
*       GETBYTE = BYTE POSITION OF NEXT CHAR TO BE SCANNED. 
*       P<SRFIELD> INCREMENTED BY 1 IF NECESSARY. 
* 
* DC  NON-LOCAL VARIABLES 
*       K - LOOP VARIABLE.
* 
* DC  CALLING ROUTINES
*       CHECKSRNUM - CHECK SOURCE NUMERIC.
*       CHECKCLS3 - CHECK SOURCE CHARS 3. 
*       CHECKCLS4 - CHECK SOURCE CLASS 4. 
*       CHECKSRALPHA - CHECK SOURCE ALPHABETIC. 
*       DISPLAYTOBIN - DISPLAY TO BINARY. 
* 
* DC  DESCRIPTIONS
*       IF "GETBYTE" GR 9, SET "SRFIELD" BASE TO NEXT WORD AND SET
*     "GETBYTE" TO 0. 
*       SET "CHAR" TO VALUE OF BYTE SPECIFIED BY "GETBYTE". 
*       INCREMENT "GETBYTE" BY 1. 
 #
  
  
      FOR K=0 WHILE GETBYTE GR 9 DO 
        BEGIN 
        GETBYTE=GETBYTE-10; 
        P<SRFIELD>=LOC(SRFIELD)+1;
        END 
      CHAR=C<GETBYTE>SRCHAR[0]; 
      GETBYTE=GETBYTE+1;
      END 
      CONTROL EJECT;
  
      PROC TG4INITIAL;       #TARGET CLASS 4 INITIALIZATION.           #
      BEGIN 
  
 #
  *   TG4INITIAL - TARGET CLASS 4 INITIALIZATION
* *   C C CHOW      6/15/74 
* 
* DC  PURPOSE 
*       STUDY DISPLAY FIXED PT TARGET (CLASS 4) FORMAT AND SET ITEMS
*     DESCRIBING IT FOR LATER USE.
* 
* DC  ENTRY CONDITIONS
*       TCURLENG = TARGET LENGTH IN BYTES.
*       TGDECPOS = TARGET DECIMAL PT POSITION.
*       TGXPLICD = TRUE IF TARGET EXPLICITLY DECIMALED. 
* 
* DC  EXIT CONDITIONS 
*       TSGNTLEN = COUNT OF SIGNIFICANT DIGITS IN TARGET. 
*       TDECLEN = COUNT OF DECIMAL DIGITS IN TARGET.
*       TASMRIGHT = COUNT OF ASSUMED RIGHT ZEROS IN TARGET. 
*       TASMLEFT = COUNT OF ASSUMED LEFT ZEROS IN TARGET. 
* 
* DC  CALLING ROUTINES
*       MODULE "DFXPTTODFXPT".
* 
* DC  DESCRIPTIONS
*       BASED ON TARGET FORMAT DESCRIPTION, "TSGNTLEN", "TDECLEN",
*     "TASMRIGHT", AND "TASMLEFT" ARE SET.
 #
  
  
      TSGNTLEN=0;            #TARGET EXPLICIT SIGNIFICANT DIGIT COUNT. #
      TDECLEN=0;             #TARGET EXPLICIT DECIMAL DIGIT COUNT.     #
      TASMRIGHT=0;           #TARGET ASSUMED RIGHT ZERO COUNT.         #
      TASMLEFT=0;            #TARGET ASSUMED LEFT ZERO COUNT.          #
  
      IF TGDECPOS LS 0 THEN 
        BEGIN 
        TASMRIGHT=-TGDECPOS;
        TSGNTLEN=TCURLENG;
        END 
      ELSE
        BEGIN 
        IF TGDECPOS GR TCURLENG THEN
          BEGIN 
          TASMLEFT=TGDECPOS-TCURLENG; 
          TDECLEN=TCURLENG; 
          END 
        ELSE                 # 0 .LQ. TGDECPOS .LQ. TCURLENG.          #
          BEGIN 
          TDECLEN=TGDECPOS; 
          IF TGXPLICD THEN
            TSGNTLEN=TCURLENG-TDECLEN-1;
          ELSE
            TSGNTLEN=TCURLENG-TDECLEN;
          END 
        END 
      END 
  
      CONTROL EJECT;
  
      PROC CHECKALLZERO(LOCN,BYTE,LENG);         #CHECK-ALL-ZEROS.     #
      BEGIN 
  
 #
  *   CHECKALLZERO - CHECK ALL ZEROS
* *   C C CHOW      6/15/74 
* 
* DC  PURPOSE 
*       CHECK IF SPECIFIED STRING CONTAINS ALL DISPLAY CODE ZEROS.
* 
* DC  ENTRY CONDITIONS
*       PARAMETERS PASSED:  
*         LOCN = LOCATION STARTING WHERE CHECKING IS TO BE DONE.
*         BYTE = BYTE POSITION AT WHICH CHECKING IS TO START. 
*         LENG = LENGTH IN CHARS OF STRING TO BE CHECKED. 
* 
* DC  EXIT CONDITIONS 
*       NORMAL: 
*         SPECIFIED STRING VERIFIED TO BE ALL DISPLAY CODE ZEROS. 
*       ERROR:  
*         ERRCODE = O"666". 
* 
* DC  NON-LOCAL VARIABLES 
*       BASED ARRAY "TGFIELD".
*       K - LOOP VARIABLE.
* 
* DC  CALLING ROUTINES
*       MODULE "DFXPTTODFXPT".
* 
* DC  DESCRIPTIONS
*       STARTING AT LOCATION AND BYTE POSITION SPECIFIED, CHECK BYTE BY 
*     BYTE FOR NON-ZERO UNTIL SPECIFIED LENGTH EXHAUSTED. IF NON-ZERO 
*     DETECTED, ERROR EXIT WITH CODE 666. 
 #
  
  
      ITEM LOCN;             #LOCATION AT WHICH CHECKING IS TO BE DONE.#
      ITEM BYTE;             #BYTE AT WHICH CHECKING IS TO START.      #
      ITEM LENG;             #LENGTH IN BYTES TO BE CHECKED.           #
      ITEM CHKBYTE;          #BYTE CURRENTLY CHECKING.                 #
      CHKBYTE=BYTE; 
      P<TGFIELD>=LOCN;
      FOR K=1 THRU LENG DO
        BEGIN 
        IF CHKBYTE GR 9 THEN
          BEGIN 
          P<TGFIELD>=LOC(TGFIELD)+1;
          CHKBYTE=CHKBYTE-10; 
          END 
        IF C<CHKBYTE>TGCHAR[0] NQ O"33" THEN     #YES - NONZERO.       #
          BEGIN 
          ERRCODE=O"666";    #LOSS OF SIGNIFICANT DIGITS.              #
          GOTO CONV$EXIT; 
          END 
        CHKBYTE=CHKBYTE+1;
        END 
      END 
      CONTROL EJECT;
  
      PROC ROUND(POS);
      BEGIN 
  
 #
  *   ROUND - PERFORM ROUNDING OF DATA
* *   C C CHOW      6/15/74 
* 
* DC  PURPOSE 
*       ROUND DATA IN "INTERBUF" AT POSITION SPECIFIED. "INTERBUF" IS 
*     A 20 CHAR CONVERSION ROUTINE INTERNAL BUFFER. 
* 
* DC  ENTRY CONDITIONS
*       PARAMETER PASSED: 
*         POS - BYTE POSITION IN "INTERBUF" WHERE ROUNDING TO BE DONE.
*       "INTERBUF" CONTAINS DISPLAY CODE NUMERIC STRING.
* 
* DC  EXIT CONDITIONS 
*       NORMAL: 
*         DATA STRING IN "INTERBUF" ROUNDED.
*       ERROR:  
*         ERRCODE = O"666". 
* 
* DC  NON-LOCAL VARIABLES 
*       CHAR - VALUE OF CURRENTLY SCANNED CHAR IN "INTERBUF". 
*       K - LOOP VARIABLE.
* 
* DC  CALLING ROUTINES
*       MODULE "ALNUMTODNUM"/"DNUMTODNUM".
*       MODULE "DFXPTTODFXPT".
* 
* DC  DESCRIPTIONS
*       EXAMINE BYTE "POS" IN "INTERBUF". IF LESS THAN DISPLAY CODE 5,
*     NO ROUNDING NEEDED AND EXIT, OTHERWISE CONTINUE.
*       ADD 1 TO BYTE ("POS"-1), CARRY OVER TO THE NEXT BYTE IF 
*     NECESSARY. CONTINUE WITH THE CARRY OVER UNTIL IT STOPS. IF THIS 
*     RESULT IN "INTERBUF" OVERFLOW (WHEN ALL DIGITS ORIGINALLY 9"S), 
*     ERROR EXIT WITH CODE 666. IF DECIMAL PT HIT DURING PROCESS, 
*     SKIP OVER IT. 
 #
  
  
      ITEM POS; 
      IF C<POS>INTERBUF LS O"40" THEN      # < "5". NO ROUNDING NEEDED.#
        RETURN; 
      FOR K=(POS-1) STEP -1 UNTIL 0 DO
        BEGIN 
        CHAR=C<K>INTERBUF;
        IF CHAR EQ O"57" THEN          #YES - DECIMAL POINT.           #
          TEST;              #CONTINUE WITH NEXT DIGIT.                #
        CHAR=CHAR+1;
        IF CHAR LQ O"44" THEN          #ROUNDING PROCESS FINISHED.     #
          BEGIN 
          C<K>INTERBUF=CHAR;
          RETURN; 
          END 
        C<K>INTERBUF=O"33"; 
        END 
  
# IF LOOP FALLS THRU, TARGET SIZE NOT LARGE ENOUGH FOR ROUNDED RESULT. #
  
      ERRCODE=O"666";        #LOSS OF SIGNIFICANCE.                    #
      GOTO CONV$EXIT; 
      END 
      CONTROL EJECT;
  
      PROC STORESOP(POS);              #STORE SIGN-OVER-PUNCH.         #
      BEGIN 
  
 #
  *   STORESOP - STORE SIGN OVER PUNCH
* *   C C CHOW      6/15/74 
* 
* DC  PURPOSE 
*       ADD SIGN-OVER-PUNCH TO DATA STRING IN "INTERBUF" AT POSITION
*     SPECIFIED, IF TARGET IS TO BE SIGNED. 
* 
* DC  ENTRY CONDITIONS
*       PARAMETER PASSED: 
*         POS = POSITION IN "INTERBUF" THAT SOP IS TO BE ADDED. 
*       SIGNPLUS = TRUE IF DATA IS +VE. 
*       TGSIGNED = TRUE IF TARGET IS TO BE SIGNED.
*       "INTERBUF" CONTAINS DISPLAY CODE NUMERIC STRING.
* 
* DC  EXIT CONDITIONS 
*       SIGN-OVER-PUNCH ADDED TO DATA STRING IN "INTERBUF" AT POSITION
*     SPECIFIED, IF TARGET IS TO BE SIGNED. 
* 
* DC  NON-LOCAL VARIABLES 
*       CHAR - VALUE OF CURRENT BYTE IN "INTERBUF" STRING.
*       K - SCRATCH ITEM. 
* 
* DC  CALLING ROUTINES
*       MODULE "ALNUMTODNUM"/"DNUMTODNUM".
*       MODULE "DFXPTTODNUM". 
*       MODULE "DFXPTTODFXPT".
* 
* DC  DESCRIPTIONS
*       IF TARGET IS NOT TO BE SIGNED, EXIT.
*       AT POSITION SPECIFIED IN "INTERBUF", CHECK VALUE OF THE DIGIT,
*     AND SET IT TO APPROPRIATE VALUE TO INDICATE SIGN-OVER-PUNCH AS
*     GIVEN BY "SIGNPLUS".
*       IF POSITION SPECIFIED IS DECIMAL POINT, STORE SOP AT POSITION 
*     ("POS"-1). IF LENGTH OF STRING IS 1, AND IT CONTAINS THIS DECIMAL 
*     PT, JUST EXIT.
 #
  
  
      ITEM POS; 
      IF NOT TGSIGNED THEN
        RETURN; 
      K=POS;
      IF K LS 0 THEN
        RETURN; 
      IF C<K>INTERBUF EQ O"57" THEN 
        BEGIN 
        K=K-1;
        IF K LS 0 THEN
          RETURN; 
        END 
      CHAR=C<K>INTERBUF;
      IF CHAR EQ O"33" THEN            #YES - NUMERIC "0".             #
        BEGIN 
        IF NOT SIGNPLUS THEN
          C<K>INTERBUF=O"66"; 
        END 
      ELSE
        BEGIN 
        IF CHAR LQ O"44" AND CHAR GQ O"34" THEN  #YES - NUMERIC 1 - 9. #
          BEGIN 
        IF NOT SIGNPLUS THEN
          C<K>INTERBUF=CHAR-O"22";           # -VE SOP #
          END 
        END                  #IF NONE OF ABOVE, MUST BE SOP ALREADY.   #
      END 
      CONTROL EJECT;
  
      PROC EXTRACTSOP(POS);            #EXTRACT SIGN-OVER-PUNCH.       #
      BEGIN 
  
 #
  *   EXTRACTSOP - EXTRACT SIGN OVER PUNCH
* *   C C CHOW      6/15/74 
* 
* DC  PURPOSE 
*       REPLACE SIGN OVER PUNCH DIGIT AT SPECIFIED POSITION WITH THE
*     DIGIT VALUE WITHOUT THE SOP.
* 
* DC  ENTRY CONDITIONS
*       PARAMETER PASSED: 
*         POS - BYTE POSITION IN "INTERBUF" THAT SOP IS TO BE EXTRACTED.
*       "INTERBUF" CONTAINS DISPLAY CODE NUMERIC CHARS. 
* 
* DC  NON-LOCAL VARIABLES 
*       CHAR - VALUE OF CURRENT BYTE IN "INTERBUF" STRING.
*       K - SCRATCH ITEM. 
* 
* DC  CALLING ROUTINES
*       MODULE "ALNUMTODNUM"/"DNUMTODNUM".
*       MODULE "DFXPTTODNUM". 
*       MODULE "DFXPTTODFXPT".
* 
* DC  DESCRIPTIONS
*       IF POSITION SPECIFIED LESS THAN 0, EXIT.
*       IF BYTE AT POSITION SPECIFIED IS A DECIMAL PT, CHECK BYTE BEFORE
*     IT. 
*       IF BYTE AT POSITION SPECIFIED IS SOP, REPLACE IT WITH THE DIGIT 
*     VALUE WITHOUT SOP.
 #
  
  
      ITEM POS;              #BYTE POSITION IN "INTERBUF" THAT WILL 
                              BE EXAMINED FOR S-O-P.                   #
      K=POS;
      IF K LS 0 THEN
        RETURN; 
      IF C<K>INTERBUF EQ O"57" THEN              #YES - DECIMAL PT.    #
        BEGIN 
        K=K-1;               #WE WILL EXAMINE THE CHAR BEFORE DEC PT.  #
        IF K LS 0 THEN
          RETURN; 
        END 
      CHAR=C<K>INTERBUF;
      IF CHAR GR O"44" THEN  #YES - SOP "0". SINCE STRING IS LEGAL
                                    NUMERIC AND DEC PT HAS BEEN IDENT. #
        C<K>INTERBUF=O"33";            #REPLACE WITH NUMERIC "0".      #
      ELSE
        BEGIN 
        IF CHAR LQ O"11" THEN                    #YES - +VE SOP.       #
          C<K>INTERBUF=CHAR+O"33";
        ELSE
          BEGIN 
          IF CHAR LQ O"22" THEN                  #YES - -VE SOP.       #
            C<K>INTERBUF=CHAR+O"22";
          END 
        END 
      END 
      CONTROL EJECT;
  
      PROC DISPLAYTOBIN;     #DISPLAT-TO-BINARY.                       #
      BEGIN 
  
 #
  *   DISPLAYTOBIN - DISPLAY TO BINARY CONVERSION 
* *   C C CHOW      6/15/74 
* 
* DC  PURPOSE 
*       CONVERT A DISPLAY CODE NUMERIC STRING TO 108 BIT BINARY INTEGER.
* 
* DC  ENTRY CONDITIONS
*       SCURLOC/SCURBYTE/SCURLENG CONTAINS DISPLAY CODE NUMERIC STRING. 
*       SIGNPLUS = TRUE IF DATA +VE.
*       SRCLASS = SOURCE CLASS. 
*       SRDECPOS = SOURCE DECIMAL POSITION IF SOURCE CLASS 4. 
*       SGNTDIGITS = COUNT OF SOURCE SIGNIFICANT DIGITS.
*       LEADZEROS = COUNT OF SOURCE LEADING ZEROS.
* 
* DC  EXIT CONDITIONS 
*       DM$CMBF 
*         UPINT = UPPER 54 BITS OF 108 BIT INTEGER. 
*         LOWINT = LOWER 54 BITS OF 108 BIT INTEGER.
*         EXPONEN = -VE POWER OF 10 FOR THE BINARY INTEGER MAGNITUDE. 
*         SIGN = 0 IF +VE, COMPLIMENT OF 0 IF -VE.
* 
* DC  NON-LOCAL VARIABLES 
*       DECIMALED - TO INDICATE THAT DECIMAL PT HAS BEEN SCANNED. 
*       DECDIGITS - COUNT OF DEC DIGITS SCANNED. FOR SETTING "EXPONEN". 
*       CHAR - TO HOLD VALUE OF DIGIT CURRENTLY SCANNING. 
*       I - LOOP VARIABLE.
*       J - SCRATCH ITEM. 
*       K - SCRATCH ITEM. 
* 
* DC  CALLING ROUTINES
*       MODULE "DNUMTOUNORM"/"DFXPTTOUNORM".
*       MODULE "DNUMTONORM"/"DFXPTTONORM".
*       MODULE "DNUMTODOUBL"/"DFXPTTODOUBL".
* 
* DC  DESCRIPTIONS
*       THIS PROC CONVERTS A DISPLAY CODE NUMERIC STRING INTO AN 108
*     BIT BINARY INTEGER, STORED IN THE LOWER 54 BITS OF 2 WORDS, 
*     "UPINT" AND "LOWINT". "EXPONEN" WILL KEEP TRACK OF THE MAGNITUDE
*     OF THIS BINARY INTEGER IN POWER OF 10. "SIGN" WILL SHOW THE SIGN
*     OF THE NUMBER.
*       THE CONVERSION IS DONE BY CONVERTING THE SOURCE NUMERIC STRING
*     DIGIT BY DIGIT, STARTING WITH THE LEFTMOST ONE. THE CONVERTING
*     VALUE IS STORED INTO "LOWINT". AS MORE AND MORE DIGITS ARE
*     CONVERTED, VALUE IN "LOWINT" INCREASES. AS THE VALUE IN "LOWINT"
*     GETS LARGER THAN 54 BITS, THE MORE SIGNIFICANT BITS WILL BE SAVED 
*     IN "UPINT", AND PROCESS CONTINUES. THE NUMBER OF DECIMAL DIGITS 
*     INVOLVED IN THE CONVERSION IS NOTED, SO THAT AT END OF CONVERSION,
*     "EXPONEN" COULD BE SET TO INDICATE POWER OF 10 MAGNITUDE. IF THE
*     54 BITS IN "UPINT" OVERFLOW, CONVERSION WILL STOP, AND "EXPONEN"
*     WILL BE SET TO INDICATE APPROPRIATE MAGNITUDE OF THE NUMBER.
 #
  
  
# INITIALIZE...                                                        #
  
      DECIMALED=FALSE;       #INDICATES IF DECIMAL PT HAS BEEN SCANNED.#
      DECDIGITS=0;           #DECIMAL DIGITS.                          #
      UPINT=0;               #UPPER 54 BITS OF DESIRED 108 BIT BINARY. #
      LOWINT=0;              #LOWER 54 BITS OF DESIRED 108 BIT BINARY. #
  
      P<SRFIELD>=SCURLOC; 
      GETBYTE=SCURBYTE+LEADZEROS;      #SKIP LEADING ZEROS.            #
  
      FOR I=LEADZEROS+1 THRU SCURLENG DO
        BEGIN 
        CALL GETSRCHAR;      #GET SOURCE CURRENT CHAR.                 #
        IF CHAR LS O"33" OR CHAR GR O"44" THEN   #TRUE - NOT NUMERIC.  #
          BEGIN 
          IF CHAR EQ O"57" THEN        #TRUE - DECIMAL POINT.          #
            BEGIN 
            DECIMALED=TRUE; 
            TEST; 
            END 
          IF CHAR GR O"11" THEN        #TRUE - NOT +VE SOP 1 THRU 9.   #
            BEGIN 
            IF CHAR LQ O"22" THEN      #TRUE -MUST BE -VE SOP 1 THRU 9.#
              CHAR=CHAR-O"11";
            ELSE             #MUST BE EITHER +VE OR -VE SOP 0.         #
              CHAR=0; 
            END 
          END 
        ELSE                 #CHAR IS NUMERIC DISPLAY CODE.            #
          CHAR=CHAR-O"33";
  
        J=LOWINT*10+CHAR;    #ADD CURRENT CHAR TO BINARY INTEGER.      #
                             #SCRATCH ITEM J REPRESENTS UPDATED LOWINT.#
        IF B<0,6>J NQ 0 THEN #TRUE - MORE THAN 54 BITS IN BINARY.      #
          BEGIN 
          K=UPINT*10;        #SCRATCH ITEM K REPRESENTS UPDATED UPINT. #
          K=K+B<0,6>J;
          IF B<0,6>K NQ 0 THEN         #TRUE - 108 BIT BINARY OVERFLOW.#
                                       #QUIT. SIGNIFICANCE UPTO CURRENT#
                                       #DIGIT.                         #
            BEGIN            #SET "EXPONEN" TO -VE POWER OF 10.        #
            IF DECIMALED THEN 
              EXPONEN=DECDIGITS;
            ELSE
              EXPONEN=I-SGNTDIGITS+1-LEADZEROS; 
            GOTO SETSIGN; 
            END 
          B<0,6>J=0;
          UPINT=K;
          END 
        LOWINT=J; 
        IF DECIMALED THEN 
          DECDIGITS=DECDIGITS+1;
        END 
  
# SET "EXPONEN" TO INDICATE -VE POWER OF 10.                           #
  
      IF SRCLASS EQ 4 THEN
        EXPONEN=SRDECPOS; 
      ELSE
        EXPONEN=DECDIGITS;
  
SETSIGN:                     #SET "SIGN" FOR LATER CONVERSION USE.     #
      IF SIGNPLUS THEN
        SIGN=0; 
      ELSE
        SIGN=LNO(0);
  
# COMPLIMENT "EXPONEN" FOR CALL TO "DM$BTOF".                          #
  
      EXPONEN=-EXPONEN; 
  
      END 
  
  
  
      END  #DM$CONV#
      TERM
