*DECK             LIST
  PROC   LIST  (IN);
   BEGIN
ITEM IN;
$BEGIN
*CALL FMTSCN
         BASED  ARRAY  $ ;  ; 
         SWITCH CODES:FMTCDE
                      ENDC   : END   ,
                      AC     : A     ,
                    EC   : E     ,
                      FC     : F     ,
                      HC     : H     ,
                      IC     : I     ,
                      OC     : O     ,
                      REPC   : REP   ,
                      EREPC  : EREP  ,
                      SLASHC : SLASH ,
                      XC     : X     ;
         ITEM  V1,            # VAL1 FOR CURRENT FORMAT ITEM #
               V2,            # VAL2 FOR CURRENT FORMAT ITEM #
               POS,           # WHERE IN LINE TO START ITEM  #
               SW;            # ENDL VS. LIST SWITCH         #
         XREF  PROC CHRCHR; 
         XREF  PROC BINOCT; 
         XREF  PROC BINDEC; 
         SWITCH ENDLSW:FMTCDE 
                        ITE :   H     , 
                        ITE :   REP   , 
                        ITE :   EREP  , 
                        ITE :   SLASH , 
                        ITE :   X     , 
                        ENDLD:  END   , 
                        ENDLD:  A     , 
                    ENDLD: E     ,
                        ENDLD:  F     , 
                        ENDLD:  I     , 
                        ENDLD:  O     ; 
         IF ERRCD THEN RETURN;     SW=0;
    ITE:  V1=VAL1[IND]; V2=VAL2[IND]; POS=LINECH; 
         GOTO  CODES[CODE[IND]];
         #   #
    AC:     #  A TYPE FORMAT #
               CHRCHR (LINE,POS,IN,V1); 
         GOTO ENDD; 
    ENDC:   #  END OF FORMAT REACHER- REPEAT WHOLE FORMAT # 
         IND=-1;
         GOTO  SLASHC;  # WANT TO OUTPUT LINE # 
    EREPC:   #  END REPLICATION # 
#SUNDAY 12-23-68#  IF VAL2[V1]GR 1 THEN BEGIN 
                                    VAL2[V1]=VAL2[V1]-1;
                                    IND=V1+1; 
                              IF SW EQ 0 THEN GOTO ITE; 
                                   ELSE GOTO ENDLSW[CODE[IND]]; 
                               END
         IND=IND+1; 
         IF SW EQ 1 THEN GOTO ENDLCT; 
         GOTO  ITE ;
         ## # ONLY SINGLE PRECISION FLOATING ITEMS                 # ## 
         ITEM  INT, R R;
   EC:   #  E  TYPE FORMAT CODE  #
##       DEF  ELGTH #4#; # NUMBER OF SPACES FOR E FIELD # 
         #  CHANGE TO NORMALIZED NUMBER IN R
               WITH EXPONENT IN EX                # 
         B<0,BITWD>R=B<0,BITWD>IN;
         IF R LS 0 THEN R=-R; 
         ITEM  EX ; 
         EX=0;
         IF R LS 0.1 THEN BEGIN 
                             EXLP1: EX=EX-1;
                                    R=R*10.0; 
                                    IF R LS 0.1 THEN GOTO EXLP1;
                                                ELSE GOTO EXEND;
                          END 
                     ELSE BEGIN 
                               EXPL2: EX=EX+1;
                                      IF R/10**EX GQ 1.0 THEN GOTO
                                                              EXPL2;
                                      R=R/10**EX; 
                          END 
         EXEND: 
       #  NORMALIZED NUMBER NOW R AND EXPONENT IN EX  # 
          BINDEC(LINE,POS+V1-ELGTH,EX,ELGTH); # PUT IN EXPONENT # 
          CHRCHR(LINE,POS+V1-ELGTH-1,"E",1);  # PUT IN E        # 
          LINECH=LINECH+ELGTH+1;              # ADJUST COUNTERS # 
          V1=V1-ELGTH-1;                      #  SO CAN USE     # 
          IF IN LS 0 THEN R=-R;               #  F FORMAT CODE  # 
          GOTO FC1;                           #  FOR FRACTION   # 
    FC:     #  F TYPE FORMAT CODE  #
         B<0,BITWD>R=B<0,BITWD>IN; # MOVE VALUE TO REAL ITEM AS IS #
     FC1:INT=R; 
         BINDEC(LINE,POS,INT,V1-V2-1); # PLACE INTEGER PART # 
               IF INT EQ 0 AND R LS 0.0 THEN # PUT IN MINUS ZERO #
                 BEGIN
                   IF V1-V2-2 GQ 1 THEN # HAVE ROOM FOR MINUS # 
                     BEGIN
                       EX=POS+V1-V2-3;
                       C<EX-(EX/BYTWD)*BYTWD,1>OUT[EX/BYTWD]="-"; 
                     END
                 END
         POS=POS+V1-V2-1; 
         IF IN  LS 0 THEN BEGIN R=-R; INT=-INT; END 
         INT=(R-INT+2.0000001)*10**V2; # GET FRACTIONAL VALUE PLUS A 1# 
         BINDEC(LINE,POS,INT,V2+1);    # PLACE FRACTIONAL PART #
         CHRCHR(LINE,POS,".",1);       # PLACE PERIOD  #
         GOTO  ENDD;
    HC:     #  H TYPE FORMAT  # 
           P<$>=LOC(FORMAT[IND+1]); 
           CHRCHR(LINE,POS,$,V1); 
         IND=IND+V2;
       LINECH=LINECH+V1;
         GOTO  ENDN;
    IC:     #  I TYPE FORMAT  # 
##       IF V1 GQ 6  THEN V1=6; 
         BINDEC(LINE,POS,IN,V1);
         GOTO  ENDD;
    OC:     #  O TYPE FORMAT  # 
         IF V1 GQ BITWD/3 THEN V1=(BITWD+2)/3;
         BINOCT(LINE,POS,IN,V1);
         GOTO  ENDD;
    REPC:   #  BEGIN REPLICATION #
         VAL2[IND]=VAL1[IND]; 
         IND=IND+1; 
         GOTO  ITE ;
    SLASHC: #  OUTPUT LINE #
           IF LINECH EQ 0 THEN LINECH=1;
#6600#  POS=POS+2;
         PTLSTV(LINE,(POS+BYTWD-1)/BYTWD);
         FOR V1=0 STEP 1 UNTIL NWDLN DO  OUT[V1]=" "; 
         LINECH=0;
         GOTO  ENDN;
    XC:     #  X FORMAT ITEM  # 
       LINECH=LINECH+V1;
   ENDN:    #  END NON-DATA FORMAT ITEM # 
         IND=IND+1; 
         SWITCH ENDSW  ITE , ENDLCT;
         GOTO  ENDSW[SW]; 
   ENDD:    #  END DATA TYPE FORMAT ITEM #
       LINECH=LINECH+V1;
         IND=IND+1; 
         RETURN;
         #   #
         #   #
$END
         #   #
  ENTRY  PROC ENDL; 
$BEGIN
         IF  ERRCD THEN RETURN; 
         ERRCD= TRUE; SW=1; 
     ENDLCT:#  SEE IF NON-DATA ITEMS TO PROCESS    #
         GOTO  ENDLSW[CODE[IND]]; 
         #   #
     ENDLD: #  ALL READY TO OUTPUT #
#6600#  LINECH=LINECH+2;
         PTLSTV (LINE,(LINECH+BYTWD-1)/BYTWD);
         RETURN;
$END
   END
 TERM 
