*DECK,LISTLNK 
          IDENT  LISTLNK
 LISTLNK  SECT   (MISC OUTPUT ROUTINES) 
**        LISTLNK EXISTS TO SHORTEN THE (0,0) OVERLAY, I.E., IT 
*         RESIDES ON THE (1,0) AND THE (2,0) AFTER *UTILITY*. 
  
  
  
*         IN FTN
          EXT    TIME1,TIMER,CPTIM
  
*         IN PUC
          EXT    BLNKCOM,COMSIZ,CO.PS,PIA,SUM.LBT,T.BLKS,WO.LOA,LCNT
  
*         IN UTILITY
          EXT    CDD
 OCTAL    SPACE  4,10 
**        OCTAL - CONVERT AND FORMAT OCTAL STATISTIC. 
* 
*         CONVERT NUMBER STORED AT *FROM* TO OCTAL DPC,FORMAT THE 
*         RESULT FOR PRINTING, STORE IT AT *TO*.
* 
*         OCTAL  FROM,TO
* 
*         USES   A1-2,6,  X0-2,6-7,  B7.
*         CALLS  PIA
  
  
 OCTAL    MACRO  FROM,TO
          =A1    FROM        FETCH NUMBER 
          PIA                CONVERT IT 
          =X0    1R=&1R 
          BX6    X0-X6       CHANGE LAST BLANK TO = 
          SA6    TO 
 OCTAL    ENDM
 DECML    SPACE  4,10 
**        DECML - CONVERT AND FORMAT DECIMAL STATISTIC. 
* 
*         CONVERT NUMBER STORED AT *FROM* TO DECML DPC, FORMAT
*         RESULT FOR PRINTING, STORE IT AT *TO*.
* 
*         DECML  FROM,TO
* 
*         USES   X1,X4,X6,A1
*         CALLS  CDD
  
  
 DECML    MACRO  FROM,TO
          =A1    FROM 
          CALL   CDD
          LX4    -2*CHAR
          BX6    X4 
          SA6    TO 
 DECML    ENDM
 LUS      SPACE  4,10 
**        LUS -  LIST UNIT STATISTICS.
* 
*         ENTRY  (X1) = MAX CORE REQUIRED BY CURRENT PROGRAM UNIT.
* 
*         USES   A0-4,A6-7,  X0-7,  B1-2,B6.
*         CALLS  PLINE,CDD,PIA,CPTIM,TIMER,OCTAL,DECML
  
  
 LUS      SUBR   =           ENTRY/EXIT...
          SA2    WO.LOA 
          ZR     X2,EXIT.    IF LO=-A 
          MX7    0
          SA7    LUSTL
          SA7    LUSTS       INITIALIZE COMMON LENGTH STORAGE CELLS 
          BX6    X1 
          SA6    LUSD+3      SAVE X1
          SB7    7           BASE LENGTH OF STATISTICS
  
 .TEST    IFEQ   TEST,ON     ACCOUNT FOR TEST MODE MESSAGES 
          SB7    B7+B1       NR OF ALLOCS 
          SA1    MOVES
          ZR     X1,LUS02    IF NO TABLE CRASHES
          SB7    B7+B1       NR OF TABLE CRASHES
  
 LUS02    SB7    B7+B1       LARGEST PARSED FILE LENGTH 
 .TEST    ENDIF 
  
          SA1    BLNKCOM
          MX2    0           SCM BLANK COMMON LENGTH
          MX3    0           LCM BLANK COMMON LENGTH
          ZR     X1,LUS06    IF NO BLANK COMMON 
          SX1    X1-2 
          SA2    T.BLKS 
          SX2    X2+Z=BLKS   FWA OF COMMON BLOCKS 
          IX3    X2+X1       ADDRESS OF BLANK COMMON
          SA4    X3+CB.W     FETCH WORD B 
          BX5    X4          SAVE COPY
          MX0    -CB.BLENL
          LX4    -CB.BLENP
          BX2    -X0*X4      ISOLATE SCM BLOCK LENGTH 
          MX3    0
          HX5    CB.LCM 
          PL     X5,LUS04    IF SCM 
          BX3    X2          SET LCM LENGTH 
          MX2    0           SET SCM LENGTH 
  
 LUS04    SB7    B7+B1       BLANK COMMON MESSAGE 
  
 LUS06    SA1    COMSIZ 
          IX1    X1-X2       SUBTRACT BLANK COMMON LENGTH 
          ZR     X1,LUS08    IF NO LABELLED SCM 
          SB7    B7+B1       SCM LABELLED COMMON MSG
  
 LUS08    SA1    COMSIZ+B1
          IX1    X1-X3       SUBTRACT BLANK COMMON LENGTH 
          ZR     X1,LUS09    IF NO LABELLED LCM 
          SB7    B7+B1       LCM LABELLED COMMON MSG
  
 LUS09    SA1    LCNT 
          SA2    CO.PS
          IX1    X1-X2
          SB2    X1+B7       ADD NUMBER OF LINES REQUIRED 
          MI     B2,LUS10    IF SUFFICIENT ROOM 
          SX7    X2+B1
          SA7    A1 
 LUS10    PLINE  LUSF,2,2    PRINT HEADING
          SB2    =10H 
          PLINE  B2,1        PRINT BLANK LINE 
 .TEST    IFEQ   TEST,ON     TEST MODE MESSAGES 
          SA1    ALC=CNT     (X1) = NR OF *ALLOC*S
          CALL   CDD         CONVERT BINARY TO DECIMAL DPC
          LX4    -2*CHAR
          BX6    X4 
          SA6    A1 
          PLINE  LUSAL,5     PRINT NR OF ALLOCS 
  
          SA1    MOVES
          ZR     X1,LUS20    IF NO TABLE CRASHES
          CALL   CDD
          LX4    -2*CHAR     FORMAT PROPERLY
          BX6    X4 
          SA6    A1 
          PLINE  LUSTC,5      PRINT TABLE CRASHES 
 LUS20    DECML  PARSLEN,PARSLEN+B1   CONVERT PARSLEN TO DECML DPC
          OCTAL  PARSLEN,PARSLEN   CONVERT IT TO  OCTAL DPC 
          PLINE  LUSPF,5      OUTPUT THE MESSAGE
 .TEST    ENDIF 
  
**        PIECE TOGETHER AND OUTPUT PROGRAM UNIT LENGTH MESSAGE 
  
          OCTAL  SUM.LBT,LUSA+3   FORMAT AND PLACE OCTAL CONVERSION 
          DECML SUM.LBT,LUSA+4   SAME FOR DECML CONVERSION
          PLINE  LUSA,5 
  
**        PIECE TOGETHER AND OUTPUT BLANK COMMON LENGTH MESSAGE 
  
          SA1    BLNKCOM
          ZR     X1,LUS35    IF NO BLANK COMMON 
          SX1    X1-2 
          SA2    T.BLKS 
          SX2    X2+Z=BLKS   FWA OF COMMON BLOCKS 
          IX3    X2+X1       ADDRESS OF BLANK COMMON
          SA4    X3+CB.W     FETCH WORD B 
          BX5    X4          KEEP EXTRA COPY
          MX0    -CB.BLENL
          LX4    -CB.BLENP
          BX1    -X0*X4      ISOLATE BLOCK LENGTH 
          BX6    X1 
          SA6    LUSTS      SAVE COPY FOR LATER USE 
          HX5    CB.LCM 
          SB5    LUSB 
          SB6    B5+3        ASSUME BLOCK IS CM/SCM 
          PL     X5,LUS30    IF ASSUMPTION CORRECT... 
          SB5    LUSBB
          SB6    B5+3        IF NOT 
          SA6    LUSTL
          MX6    0
          SA6    LUSTS
 LUS30    BX3    X1          SAVE COPY OF LENGTH
          OCTAL  A1,B6
          BX1    X3 
          DECML  A1,B6+B1 
          PLINE  B5,5      OUTPUT MESSAGE 
  
**        PIECE TOGETHER AND OUTPUT LABELED COMMON LENGTH MESSAGE 
  
 LUS35    SA1    COMSIZ 
          SA2    LUSTS
          IX1    X1-X2       SUBTRACT BLANK COMMON LENGTH 
          ZR     X1,LUS40    IF NO SCM COMMON 
          BX3    X1          PIA WONT DESTROY THIS REGISTER 
          OCTAL  A1,LUSC+3
          BX1    X3 
          DECML  A1,LUSC+4
          PLINE  LUSC,5 
 LUS40    SA1    COMSIZ+B1
          SA2    LUSTL
          IX1    X1-X2       SUBTRACT BLANK COMMON LENGTH 
          ZR     X1,LUS50    IF NO LCM COMMON 
          BX3    X1          PIA WONT DESTROY THIS REG
          OCTAL  A1,LUSCC+3 
          BX1    X3 
          DECML  A1,LUSCC+4 
          PLINE  LUSCC,5
  
**        PIECE TOGETHER AND OUTPUT STORAGE USED MESSAGE
  
 LUS50    DECML  LUSD+3,LUSD+4
          OCTAL  LUSD+3,LUSD+3
          PLINE  LUSD,5 
  
**        PIECE TOGETHER AND OUTPUT CP TIME MESSAGE 
  
          SA2    TIME1       PROGRAM UNIT START TIME
          CALL   CPTIM       ELAPSED TIME F10.3 FORMAT IN X6
          BX7    X6 
          CALL   TIMER
          SA6    TIME1       RESET START TIME 
          BX6    X7 
          MX7    0
          SA7    LUSE+2 
          SA7    A7+B1
          SA7    A7+B1       ERASE PREVIOUS MESSAGE 
          MX0    3*CHAR 
          BX7    X0*X6       GRAB 3 LEFTMOST CHARACTERS 
          LX7    3*CHAR 
          SA1    =7L
          BX7    X7+X1
          SA7    LUSE+2      STORE THEM IN MESSAGE
          BX6    -X0*X6      GRAB LAST 7 CHARACTERS 
          LX6    3*CHAR 
          SA1    =3R SE 
          BX6    X6+X1
          SA6    A7+B1       STORE THEM IN MESSAGE
          SA1    =10HCONDS
          BX6    X1 
          SA6    A6+B1       COMPLETE THE MESSAGE 
          PLINE  LUSE,5      OUTPUT IT
          EQ     EXIT.       EXIT...
  
  
**        MESSAGES AND CONSTANTS NEEDED TO PRODUCE STATISTICS OUTPUT
  
  
 .TEST    IFEQ   TEST,ON     IF TEST MODE 
 LUSAL    DIS    4,   NR OF ALLOCS
 ALC=CNT  CONENT 0
 LUSTC    DIS    4,   TABLE CRASHES 
 MOVES    CONENT 0
 LUSPF    DIS    3,   LARGEST PARSED FILE LENGTH
 PARSLEN  CONENT 0
          CON    0
 .TEST    ENDIF 
  
 LUSA     DIS    3,   PROGRAM-UNIT LENGTH 
          BSS    2
  
 LUSB     DIS    3,   "SCM" BLANK COMMON LENGTH 
          BSS    2
 LUSBB    DIS    3,   "LCM" BLANK COMMON LENGTH 
          BSS    2
  
 LUSC     DIS    3,   "SCM" LABELLED COMMON LENGTH
          BSS    2
 LUSCC    DIS    3,   "LCM" LABELLED COMMON LENGTH
          BSS    2
  
 LUSD     DIS    3,   "SCM" STORAGE USED
          BSS    2
  
 LUSE     DIS    2,   COMPILE TIME
          BSS    3
  
 LUSF     DIS    2, --STATISTICS--
  
 .TEST    IFEQ   TEST,ON
 NUMLINES EQU    12 
 .TEST    ELSE
 NUMLINES EQU    10 
 .TEST    ENDIF 
 LUSTS    BSSZ   1           TEMPORARY FOR LENGTH SCM BLANK COMMON
 LUSTL    BSSZ   1           TEMPORARY FOR LENGTH LCM BLANK COMMON
          END 
