*DECK             PRINT 
  PROC   PRINT (FORMA); 
   BEGIN
ARRAY FORMA[0:0] S(1);
      ITEM FM C(0,0,10);
$BEGIN
*CALL FMTSCN
         ITEM  WD,            # WORD OF FORMA BEING PROCESSED # 
               CH,            # CHAR OF FORMA BEING PROCESSED # 
               INT,           # INTEGER VALUE FOUND IN FORMA  # 
               CHAR C(1),     # CHARACTER VALUE               # 
               PLEV,          # PARENTHESIS PD LIST POINTER   # 
               I, 
               J; 
##       DEF  LETVAL  #O"01"#; # VALUE FOR LETTER A # 
##     # SWITCH "CODES" ASSUMES LETTERS IN SEQUENCE - INTERNAL VALUE #
         SWITCH CODES 
               ACODE,ERROR, 
               CCODE,ERROR, 
               ECODE, 
               FCODE,ERROR, 
               HCODE, 
               ICODE,ERROR,ERROR, 
               LCODE,ERROR, 
               NCODE, 
               OCODE,ERROR,ERROR, 
               RCODE, 
               SCODE,ERROR,ERROR,ERROR,ERROR, 
               XCODE,ERROR,ERROR; 
         #   #
 ##       FUNC NXTCHR  I;  # RETURNS NEXT TOKEN CODE FAILS IF C,1. #     PSRSIA 
         BEGIN         #    SETS VALUE IN "INT" ALSO #
               ITEM  CHAR; # INTEGER VALUE OF CHAR BEING EXAMINED # 
##             # MACHINE DEPENDENT VALUES FOLLOW  # 
##             DEF NUM0  # O"33" # ; # NUMBER 0 # 
##             DEF NUM9  # O"44" # ; # NUMBER 9 # 
##             DEF LETA  # O"01" # ; # LETTER A # 
##             DEF LETZ  # O"32" # ; # LETTER Z # 
##             DEF BLANK # O"55" # ; # BLANK CODE # 
##             # LOGIC OF THIS PROC ASSUMES NUM9-NUM0=9 AND      #
##             #    NUMBERS IN ORDER - IT ALSO ASSUMES THAT      #
##             #        "CHAR GQ LETA AND CHAR LQ LETZ"          #
##             #    IS TRUE ONLY FOR LETTERS                     #
               ITEM DUMMY C(1); 
           BCK: DUMMY=C<CH,1>FM[WD]; CHAR=DUMMY;
                                   IF CHAR EQ BLANK THEN
                                      BEGIN CH=CH+1;
                                        IF CH GQ BYTWD THEN 
                                          BEGIN CH=0; WD=WD+1; END
                                        GOTO BCK; 
                                      END 
               IF CHAR GQ LETA AND CHAR LQ LETZ THEN GOTO DONE; 
               IF CHAR GQ NUM0 AND CHAR LQ NUM9 THEN
                    BEGIN # HAVE TO CONVERT A NUMBER #
                         INT=CHAR-NUM0; 
                    INCR:CH=CH+1; 
                         IF CH GQ BYTWD THEN BEGIN CH=0; WD=WD+1; END 
                        DUMMY=C<CH,1>FM[WD]; CHAR=DUMMY;
                         IF NOT(CHAR GQ NUM0 AND CHAR LQ NUM9)
                             THEN BEGIN CHAR="N"; GOTO DONE2; END 
                         INT=INT*10+CHAR-NUM0;
                         GOTO INCR; 
                    END 
               # HAVE A SPECIAL CHARACTER # 
               IF CHAR EQ "," THEN BEGIN CHAR="C"; GOTO DONE; END 
               IF CHAR EQ ")" THEN BEGIN CHAR="R"; GOTO DONE; END 
               IF CHAR EQ "(" THEN BEGIN CHAR="L"; GOTO DONE; END 
               IF CHAR EQ "/" THEN BEGIN CHAR="S"; GOTO DONE; END 
               IF CHAR EQ "." THEN BEGIN CHAR="."; GOTO DONE; END 
               # ILLEGAL CHARACTER #
               CHAR="Z";
               # ALL READY TO RETURN #
           DONE: CH=CH+1; 
                 IF CH GQ BYTWD THEN BEGIN  CH=0; WD=WD+1; END
           DONE2: NXTCHR=CHAR;
         END   # NXTCHR # 
         #   #
               WD=0; CH=0;  PLEV=-1;
         IF  NOT(NXTCHR EQ "L") THEN  GOTO ERROR; 
         IND=-1;  ERRCD=FALSE;
         # FORMAT STARTED OK #
  NEXT:  IND=IND+1; IF IND GR FMTSZE THEN GOTO  ERROR;
       MORE:  
         GOTO  CODES[NXTCHR-LETVAL];
    ACODE:  #  A TYPE FORMAT ITEM # 
         CODE[IND]=FMTCDE"A"; 
     NUM:IF NOT(NXTCHR EQ "N") THEN  GOTO ERROR;
         VAL1[IND]=INT; 
         GOTO  NEXT;
    CCODE:  #  COMMA  # 
           GOTO MORE; 
    ECODE: CODE[IND]=FMTCDE"E"; 
           GOTO F1; 
    FCODE:  #  F TYPE FORMAT ITEM  - F VAL1.VAL2   #
         CODE[IND]=FMTCDE"F"; 
       F1: IF NOT(NXTCHR EQ "N") THEN GOTO ERROR; 
         VAL1[IND]=INT; 
         IF NOT(NXTCHR EQ ".") THEN GOTO ERROR; 
         IF NOT(NXTCHR EQ "N") THEN GOTO ERROR; 
         VAL2[IND]=INT; 
         GOTO  NEXT;
    HCODE:  #  H TYPE FORMAT CODE  #
            #  SET VAL1  TO FIELD WIDTH  #
            #  SET VAL2  TO NUMBER OF WORDS OF CHARACTERS  #
            #  PUT STRING IN FORMAT[IND+1] TO FORMAT[IND+VAL2[IND]] # 
         CODE[IND]=FMTCDE"H"; 
         VAL1[IND]=INT; 
         VAL2[IND]=(INT+BYTWD-1)/BYTWD; 
         J=BYTWD+1; 
           FOR I=1 STEP 1 UNTIL INT DO
           BEGIN
               IF J GQ BYTWD THEN BEGIN IND=IND+1; J=0; 
                                        IF IND GR FMTSZE THEN 
                                          GOTO ERROR; 
                                   END
               C<J,1>VALC[IND]=C<CH,1>FM[WD]; 
               J=J+1; 
               CH=CH+1; 
               IF CH GQ BYTWD THEN BEGIN WD=WD+1; CH=0; END 
           END
         GOTO  NEXT;
    ICODE:  #  I TYPE FORMAT CODE  #
         CODE[IND]=FMTCDE"I"; 
         GOTO  NUM; 
    LCODE:  #  LEFT PARENTHESIS   # 
            #  *******************************************************# 
            #  ASSUME A REPLICATION FACTOR PRESENT                    # 
            #  *******************************************************# 
         CODE[IND]=FMTCDE"REP"; 
         VAL1[IND]=INT; 
         VAL2[IND]=PLEV; # KEEP TRACK OF LEFT PARENS IN PDL # 
         PLEV=IND;       #  USING VAL2 FOR LIST # 
         GOTO  NEXT;
    NCODE:  #  NUMBER FOUND - BEFORE X,H, (   # 
           GOTO MORE;   # LEAVE VALUE IN INT #
    OCODE:  #  O TYPE FORMAT (OCTAL) #
         CODE[IND]=FMTCDE"O"; 
         GOTO  NUM; 
    RCODE:  #  RIGHT PARENTHESIS  # 
               IF PLEV NQ -1 THEN  # END OF REPLICATION # 
               BEGIN  CODE[IND]=FMTCDE"EREP"; 
                      VAL1[IND]=PLEV; # POINTS TO  REP #
                      PLEV=VAL2[PLEV];
                      GOTO NEXT;
               END
         # END OF FORMAT #
         CODE[IND]=FMTCDE"END"; 
         FOR I=0 STEP 1 UNTIL NWDLN DO OUT[I]=" ";
         LINECH=0;
         IND=0; 
         RETURN;
    SCODE:  #  SLASH IN FORMAT #
         CODE[IND]=FMTCDE"SLASH"; 
         GOTO  NEXT;
    XCODE:  #  X TYPE FORMAT  # 
         CODE[IND]=FMTCDE"X"; 
         VAL1[IND]=INT; 
         GOTO  NEXT;
         #   #
         #   #
    ERROR:     # FORMAT IN ERROR #
         ERRCD=TRUE;
         PTLSTV(" ERROR IN FORMAT STATEMENT",(26+BYTWD-1)/BYTWD); 
         RETURN;
         #   #
$END
   END
TERM
