*COMDECK     COMLISTR  - LISTING OUTPUT ROUTINES. 
#*        LISTER - LISTING OUTPUT ROUTINES. 
* 
*         R. H. GOODELL.     76/06/23.
* 
*         *LISTER* CONTAINS ALL ROUTINES FOR THE INITIALISATION,
*         CONTROL, AND FORMATTING OF PRINTED OUTPUT, EXCEPT FOR 
*         THE OBJECT CODE LISTING ROUTINES WHICH ARE IN *EDITOR*. 
* 
*         CONTENTS (XDEF ENTRY POINTS). 
* 
*         PROC   FEED        PRINT N BLANK LINES. 
*         PROC   LISTER      INITIALISE FOR LISTING OUTPUT. 
*         PROC   PUNT        PROCESS CODE GENERATOR INTERNAL ERROR. 
# 
  
  
*CALL     COMDDEF            GENERAL DEFINITIONS. 
  
     XREF BEGIN               # MANAGED TABLES #
  
*CALL     COMDTPAG           LISTING PAGE FOR PRINTING TWO COLUMNS. 
  
          END 
  
     XREF BEGIN               # OTHER EXTERNALS # 
  
          ARRAY EDICT ;            # ERROR DICTIONARY # 
               ITEM EDIC C (0,0,WC) ; 
          ARRAY E$ ;               # ERROR MESSAGE SKELETONS #
               BEGIN
               ITEM E$SV U (0, 0, 3) ;  # SEVERITY #
               ITEM E$WC U (0, 3, 9) ;  # WORD COUNT #
               ITEM E$WD U (0, 0,WL) ;  # SKELETON WORD # 
               END
          ITEM HDR3 C (WC) ;       # FIFTH WORD OF PAGE TITLE LINE #
          ITEM LINECT ;            # COUNT OF LOGICAL LINES IN *TPAG* # 
          ITEM LINECTR ;           # COUNT OF LINES ON CURRENT PAGE # 
          ITEM LINELIM ;           # MAX NUMBER OF LINES PER PAGE # 
          ITEM LOBJF B ;           # TRUE IF *LO=O* ON CONTROL CARD # 
          ITEM NOLIST B ;          # TRUE IF *L=0*  ON CONTROL CARD # 
          PROC ABRT4 ;             # ABORT WITH *COMPILATION ERRORS* #
          PROC ALLOC ;             # ALLOCATE TABLE SPACE # 
          PROC DDLPRNT ;           # PRINT A LINE (WOF) # 
  
          END 
  
  
          DEF  EJECT  #LINECTR = LINELIM# ;  # START NEW PAGE # 
  
  
*CALL     COMDCHAR           DISPLAY CODE CHARACTERS. 
  
  
#         LOCAL DATA. 
# 
          ARRAY PLINE (14) ;       # PHYSICAL PRINT LINE #
               BEGIN
               ITEM LEFT  C (0, 0, 70) ;     # LEFT  HALF-LINE #
               ITEM RIGHT C (7, 0, 70) ;     # RIGHT HALF-LINE #
               END
  
  
  
  
#***      LISTER - INITIALISE FOR LISTING OUTPUT. 
  
          PROC LISTER 
  
****
# 
          BEGIN 
  
          IF  NOLIST
          THEN LOBJF = FALSE ;          # IF OBJECT LISTING WANTED #
          IF  LOBJF 
          THEN BEGIN                         # ALLOCATE SPACE FOR # 
               ALLOC (P<TPAG>, LINELIM * 2 * 7) ;   # PAGE BUFFER # 
               HDR3 = "  * OBJECT" ;         # CHANGE TITLE LINE #
               EJECT ;                       # START NEW PAGE # 
               END
          RETURN ;
  
  
  
  
#***      DPAGE - DUMP PAGE OF OBJECT CODE LISTING. 
# 
          PROC DPAGE ;
  
#***
# 
          BEGIN 
  
          ITEM I ;                 # LOOP INDEX # 
          ITEM M ;                 # MIDPOINT OF PAGE # 
  
          IF  LINECT NE 0 
          THEN BEGIN
               IF  LINECT LT (LINELIM - 4)
               THEN BEGIN                         # ONE COLUMN #
                    FOR  I = 1 THRU LINECT  DO
                         CALL DDLPRNT (PAGELINE [I], 66) ;
                    END 
               ELSE BEGIN                         # TWO COLUMNS # 
                    M = (LINECT + 1) / 2 ;
                    FOR  I = 1 THRU M  DO 
                         BEGIN
                         LEFT = PAGELINE [I] ;         #LEFT #
                         IF  I + M LE LINECT
                         THEN BEGIN 
                              RIGHT = PAGELINE [I+M] ;      # RIGHT # 
                              CALL DDLPRNT (PLINE, 136) ; 
                              END 
                         ELSE CALL DDLPRNT (PLINE, 66) ;
                    END  END
               LINECT = 0 ; 
               END
          RETURN ;
  
          END 
  
  
  
  
#***      FEED  -  PRINT N BLANK LINES OR EJECT.
# 
          XDEF PROC FEED ;
          PROC FEED (N, M) ;
  
          ITEM N ;                 # NUMBER OF BLANK LINES #
          ITEM M ;                 # MINIMUM LINES LEFT IN PAGE # 
#***
# 
          BEGIN 
  
          ITEM I ;
  
          CALL DPAGE ;                       # DUMP OBJECT LISTING #
          IF  LINECTR + N + M  GE  LINELIM
          THEN EJECT ;                       # START NEW PAGE # 
          ELSE BEGIN
               FOR  I = 1 THRU N  DO         # PRINT N BLANK LINES #
                    CALL DDLPRNT ("  ", 2) ;
               END
          RETURN ;
  
          END 
  
  
  
  
#***      FEM  -  FORMAT ERROR MESSAGE. 
# 
          PROC FEM ((E), LINE, L) ; 
  
          ITEM E I ;               # ERROR INDEX INTO E$ TABLE #
          ARRAY LINE [0:13] ;      # PRINT LINE IMAGE # 
               ITEM LW C (0,0,WC) ;     # WORD OF LINE #
          ITEM L I ;               # CHARACTER POSITION IN PRINT LINE # 
  
#         *FEM* GETS WORDS FROM THE ERROR DICTIONARY AS DIRECTED
*         BY THE MESSAGE SKELETON, AND APPENDS THEM SUCCESSIVELY
*         TO THE LINE IMAGE, STARTING AT (L).  UPON RETURN, (L) 
*         POINTS TO THE NEXT AVAILABLE CHARACTER POSITION.
*         SEE *EDICT* FOR DETAILS OF THE ERROR DICTIONARY AND 
*         MESSAGE SKELETONS.
****
# 
          BEGIN 
  
          ITEM C ;                 # CURRENT CHARACTER AS AN INTEGER #
          ITEM D ;                 # EDICT WORD INDEX # 
          ITEM DP ;                # EDICT WORD BIT POSITION #
          ITEM EP ;                # SKELETON WORD BIT POSITION # 
          ITEM LP ;                # PRINT LINE WORD BIT POSITION # 
          ITEM W ;                 # PRINT LINE WORD INDEX #
          ITEM WM ;                # NUMBER OF WORDS IN MESSAGE # 
  
          W = L / WC ;                       # CONVERT CHAR POINTER TO #
          LP = (L - W * WC) * CL ;            # WORD AND BIT POINTERS # 
          IF  LP EQ 0 
          THEN LW [W] = " " ;                # START NEW WORD # 
          EP = 0 ;
          FOR  WM = E$WC [E] STEP -1 UNTIL 1  DO
               BEGIN
               EP = EP + 12 ;                # ADVANCE SKEL BYTE PTR #
               IF  EP GE WL 
               THEN BEGIN 
                    EP = 0 ;                 # START NEW SKELETON WORD #
                    E = E + 1 ; 
                    END 
               D = B<EP,12> E$WD [E] ;       # SET DICTIONARY WORD #
               C = - 1 ;
               FOR  DP = 0  STEP CL 
                    WHILE  C NE CHARACTER"SPACE"  DO
                    BEGIN 
                    IF  DP EQ WL             # ADVANCE EDICT CHAR PTR # 
                    THEN BEGIN
                         DP = 0 ;            # START NEW EDICT WORD # 
                         D = D + 1 ;
                         END
                    C = B<DP,CL> EDIC [D] ;  # MOVE ONE CHARACTER FROM #
                    B<LP,CL> LW [W] = C ;     # EDICT TO PRINT LINE # 
                    LP = LP + CL ;
                    IF  LP EQ WL             # ADVANCE LINE CHAR PTR #
                    THEN BEGIN
                         LP = 0 ;            # START NEW PRT LINE WORD #
                         W = W + 1 ;
                         LW [W] = " " ; 
               END  END  END                 # LOOP UNTIL BLANK CHAR #
          L = W * WC + LP / CL ;             # UPDATE LINE LENGTH # 
          RETURN ;
  
          END 
  
  
  
  
#***      PUNT  -  PROCESS CODE GENERATOR INTERNAL ERROR. 
# 
          XDEF PROC PUNT ;
          PROC PUNT (E) ; 
  
          ITEM E I ;               # ERROR MESSAGE SKELETON INDEX # 
#***
# 
          BEGIN 
  
          ITEM L I ;
  
          CALL FEED (4, 4) ;                 # PRINT BL LINES OR EJECT #
          LEFT = "    CODE GENERATOR INTERNAL ERROR   -   " ; 
          L = 40 ;
          CALL FEM (LOC (E), PLINE, L) ;     # FORMAT ERROR MESSAGE # 
          CALL DDLPRNT (PLINE, L) ;          # PRINT THE LINE # 
          CALL ABRT4 ;                       # ABORT #
  
          END 
  
     END  TERM
