*DECK,PTLST 
          IDENT  PTLST
          TITLE  PTLST - WRITE A LINE TO OUTPUT 
          COMMENT  PTLST - WRITE A LINE TO OUTPUT 
          SST 
          LIST   F
          SPACE  4
*    PTLST ACCEPTS BCD CODED (I.E. DISPLAY) PRINTER OUTPUT AND BLOCK IT 
*        TO THE CURRENT OUTPUT FILE.
* 
*         PTLST HAS THE FOLLOWING ENTRY POINTS- 
* 
*        1.    PTLSTV(ARRAY,WORDS)
*                   WHERE-
*                         ARRAY IS ADDRESS OF CODED IMAGE 
*                         WORDS IS COUNT OF WORDS IN IMAGE
* 
*        2.    PTLST(ARRAY) 
*                   WHERE-
*                         ARRAY IS ADDRESS OF CODED IMAGE 
* 
*        3.    FLUSH
*                   WHICH WRITES AN END OF LOGICAL RECORD MARK ON THE 
*                   CURRENT OUTPUT STREAM.
*        4.    EJECTP 
*                        WHICH EJECTS THE OUTPUT STREAM TO TOP OF FORM
*                        AND OUTPUT A HEADING 
* 
*        PTLST ALSO FORMATS THE OUTPUT AND SUPPLIES AN APPROPRIATE
*        HEADING FOR EACH TYPE OF COMPILER OUTPUT 
* 
*         WHCHED=   0-SOURCE LISTING
*                   2-DIAGNOSTICS 
*                   4-ALLOCATION
*                   6-OPTIMIZATION
*                   8-OBJECT CODE 
*                   10-MAP
*                   12-CROSS REFERENCE
*                   14-COMMON BLOCKS
* 
          SPACE  4
 THISOVL  MICRO  1,, 00      THIS DECK,S OVLY RESIDENCE (FOR CCON MACRO) 21FEB77
          SPACE  4                                                       21FEB77
*         COMDECKS
  
*CALL COMSTUF 
          SPACE  4
*         DEFINE DEFAULT NUMBER OF WORDS IN LINE
  
 G.OUTL   EQU    12 
  
          TITLE  PTLSTV - OUTPUT A LINE GIVEN LENGTH
**        PTLSTV - WRITE A LINE TO OUTPUT GIVEN LENGTH
* 
*         THIS IS THE SYMPL INTERFACE ROUTINE CALLED TO OUTPUT A LINE 
*         OF GIVEN LENGTH.  THE SYMPL CALLING SEQUENCE IS-
*                XREF PTLSTV; 
*                PTLSTV (ARRAY,NWDS); 
*                WHERE
*                ARRAY = WORKING STORAGE BUFFER 
*                NWDS = NUMBER OF WORDS IN ARRAY
* 
*         HENCE THE REGISTER SETUP ON ENTRY IS- 
*                A1 = POINTER TO APLIST 
*                X1 = FWA OF ARRAY
* 
  
 PTLSTV   ENTRY. ** 
          SA3    A1+1 
          SA2    X3          NO OF WORDS IN LINE
          SA5    PTLSTV 
          BX7    X5 
          SA7    PTLST       PLUG RETURN
          BX6    X2 
          SA6    LINELNG
          EQ     PT1
          SPACE  4
**        PTLST - WRITE A LINE TO OUTPUT OF DEFAULT LENGTH
* 
*         THIS IS THE SYMPL INTERFACE ROUTINE CALLED TO OUTPUT A LINE 
*         OF DEFAULT SIZE.  THE SYMPL CALLING SEQUENCE IS-
*                XREF PTLST;
*                PTLST (ARRAY); 
*                WHERE
*                ARRAY = WORKING STORAGE BUFFER 
* 
*         HENCE THE REGISTER SETUP ON ENTRY IS- 
*                A1 = POINTER TO APLIST 
*                X1 = FWA OF ARRAY
* 
  
 PTLST    ENTRY. ** 
          SX6    G.OUTL      DEFAULT SIZE OF LINE 
          SA6    LINELNG
 PT1      BSS    0
          SA1    A1 
          SA5    LINES
          SX7    X5+1 
          SA7    A5          UPDATE LINE COUNT
          SA3    =XJPS       GET PAGE SIZE
          IX7    X7-X3
          SB7    X7 
          SA4    X1 
          MX5    6
          BX5    X5*X4
          LX5    6
          SB1    X5-1R1      IF EJECTING GIVE HEADER
          NZ     B1,PT4 
          SX7    21B
          LX7    54 
          IX7    X7+X4
          SA7    A4          EJECT WITH HEADER
          SB7    B0 
 PT4      BSS    0
          NG     B7,PT2      IF NOT LINE LIMIT
          BX6    X1 
          SA6    TEMPX1 
          RJ     EJECTP      EJECT PAGE HEADER
          SA1    TEMPX1 
 PT2      BSS    0
  
*         INSURE ZERO TERMINATOR ON LINE IMAGE
  
          SA2    LINELNG     NO. WORDS IN LINE
          SB7    X2-1 
          MX7    48 
          SA5    X1+B7       LAST WORD IN LINE IMAGE                     DON/D
          BX4    -X7*X5      LAST TWO CHARS OF LINE                      DON/D
          ZR     X4,PT7      IF ALREADY LINE TERMINATOR                  DON/D
                                                                         DON/D
*         NEED TO APPEND A LINE TERMINATOR                               DON/D
                                                                         DON/D
          SA5    A5+1        SAVE LAST+1 WORD OF LINE FOR AFTER WRITEC   DON/D
          SA4    =8L                                                     DON/D
          BX7    X4                                                      DON/D
          SA7    A5          PUT IN LINE TERMINATOR WORD                 DON/D
          SX2    X2+1        BUMP WORD COUNT                             DON/D
 PT7      BSS    0                                                       DON/D
          WRITEC =XF.OUT,X1,X2
          BX7    X5                                                      DON/D
          SA7    A5          RESTORE LAST (+1) WORD OF LINE              DON/D
          EQ     PTLST       RETURN 
          EJECT 
**        EJECTP - EJECT LISTING AND PRINT HEADER 
* 
  
 EJECTP   ENTRY. ** 
          SA4    WHCHED      HEADING TYPE STATUS
          SA3    CURNHED     HEADING SET 4 PRINTING 
          SB1    1
          IX5    X4-X3
          ZR     X5,CALLIT
          SA3    NEWHEAD+X4 
          SX6    X4 
          SA6    CURNHED     MAKE CURRENT LATEST REQUESTED TYPE 
          SX7    X4 
          BX6    X3 
          SA1    A3+B1       WORD TWO OF TYPE 
          BX7    X1 
          SA6    HEADTYP     SET HEADING SUBFIELD 
          SA7    A6+B1
 CALLIT   RJ     EJ1
          EQ     CLK
          SPACE  4
**        EJ1 - PUT NAME AND TYPE OF MODULE INTO HEADER LINE.            SMPA075
*                                                                        SMPA075
                                                                         SMPA075
 EJ1      ENTRY. ** 
          SA2    SCPN        SYM TAB PTR TO MODULE NAME                  SMPA075
          SA3    NAMEID      DISPLAY CODE NAME OF MODULE                 SMPA075
          ZR     X2,EJ1      RETURN IF MODULE NAME IS STILL UNKNOWN      SMPA075
          SA4    =10H 
          IX3    X3-X4
          NZ     X3,EJ1      RETURN IF MODULE NAME IS ALREADY IN HEADER  SMPA075
                                                                         SMPA075
*         GET WORD 0 OF MODULE NAME ENTRY                                SMPA075
  
 #LEV     IFEQ   SYMTBLV,0
          SA2    X2+COM08 
 #LEV     ELSE
          SX2    X2+COM08 
          RX2    X2 
 #LEV     ENDIF 
  
          LX2    NNAM 
          PL     X2,NAIM     JIF MODULE HAS A NAME                       SMPA075
                                                                         SMPA075
*         MODULE DOESN"T HAVE A NAME- USE DEFAULT                        SMPA075
                                                                         SMPA075
          SA4    =XPGNAIM 
          MX6    54 
          SA3    =9R
          LX6    54 
 NMRPT    BX5    X4*X6
          ZR     X5,NMOK
          AX6    6
          AX3    6
          EQ     NMRPT
 NMOK     BX7    X4+X3
          SA7    NAMEID 
          EQ     EJ1
 NAIM     BSS    0
          SA1    FINDPLS
          RJ     =XFIND      GET SYM TAB PTR TO NAME ENTRY               SMPA075
          SA1    NP 
  
 #LEV     IFEQ   SYMTBLV,0
          SA2    X1+COM08+1 
 #LEV     ELSE
          SX2    X1+COM08+1 
          RX2    X2 
 #LEV     ENDIF 
  
          BX7    X2 
          SA7    NAMEID      PUT MODULE NAME IN HEADER LINE.             SMPA075
                                                                         SMPA075
SRCHLP    BSS    0           TOP OF SEARCH LOOP                          SMPA075
          SA1    FINDPTR
          RJ     =XSRCH      GET NEXT ENTRY WITH SAME NAME               SMPA075
          SA2    PTR
  
 #LEV     IFEQ   SYMTBLV,0
          SA5    X2+COM08    GET CLAS(PTR)                               SMPA075
 #LEV     ELSE
          SX5    X2+COM08    GET CLAS(PTR)
          RX5    X5 
 #LEV     ENDIF 
  
*         NOW THAT WE HAVE THE NEXT ENTRY WITH THE SAME NAME AS THE      SMPA075
*         MODULE, WE HAVE TO INSURE IT IS THE ENTRY FOR THE MODULE       SMPA075
*         (CLAS = PROC/FUNC/PROG).  NOTE THE FOLLOWING CODE DEPENDS ON   SMPA075
*         THE CURRENT DECLARATION OF CLAS AND QCLAS.                     SMPA075
                                                                         SMPA075
          MX0    6                                                       SMPA075
          BX4    X0*X5       LEFT-JUSTIFIED CLAS                         SMPA075
          SX0    11B         QCLAS=PROC                                  SMPA075
          LX4    6           RIGHT-JUSTIFY CLAS                          SMPA075
          IX3    X4-X0                                                   SMPA075
          ZR     X3,FNDMOD   JIF THIS IS A PROC ENTRY                    SMPA075
          SX0    12B         QCLAS=FUNC                                  SMPA075
          IX3    X4-X0                                                   SMPA075
          ZR     X3,FNDMOD   JIF THIS IS A FUNC ENTRY                    SMPA075
          SX0    20B         QCLAS=PROG                                  SMPA075
          IX3    X4-X0                                                   SMPA075
          ZR     X3,FNDMOD   JIF THIS IS A PROG ENTRY                    SMPA075
          BX6    X2          THIS ENTRY NOT MODULE HEADER-               SMPA075
          SA6    NP          SRCH FINDS NEXT ENTRY FROM NP               SMPA075
          EQ     SRCHLP      KEEP SEARCHING                              SMPA075
                                                                         SMPA075
FNDMOD    BSS    0           FOUND MODULE HEADER ENTRY                   SMPA075
          SB1    1
          LX5    3           GET CLAS 
          AX5    56 
          SA4    X5+TYPETAB 
          SA5    A4+B1
          BX6    X4 
          LX7    X5 
          SA6    TYPE 
          SA7    A6+B1
          EQ     EJ1
* 
* 
 CLK      SA1    TIMHED 
          LX1    22          CHK FOR . INSTEAD OF BLANK 
          NG     X1,TIMOK 
          CLOCK  BCDTIME,RCL
          SA5    BCDTIME
          BX6    X5 
          SA6    TIMHED 
 TIMOK    BSS    0
          SA5    BINPAGE     BUMP (BINARY) PAGE COUNTER 
          SX6    X5+1        (IT IS NOT GOING TO EXCEED 2**18)
          SA6    A5 
          SA1    PGN         BUMP PAGE COUNT
          SA2    =7R0000001 
          SA4    =60606060606060B 
          IX7    X1+X2
          BX2    -X7*X4 
          IX6    X2+X7
          LX2    60-3 
          IX6    X6+X2
          SA5    =7R0000000 
          IX6    X6-X5
          SA6    A1 
          IX1    X6-X5
          NX5    X1,B5
          MX0    6
          AX0    X0,B5
          BX5    X0*X4
          BX7    X5-X6
          LX5    60-3 
          BX7    X5-X7
          MX0    42 
          LX7    3*6
          BX7    X0*X7
          SA7    PAGENUM
          SA1    =XSHRTLST   . CHECK FOR L=1 OR L=0 
          SX6    34B
          NG     X1,LISTIT   .DONT OUTPUT NEW PAGE IF L=0 
          SA1    FIRSTFLG    .EJECT ANYHOW IF FIRST CALL
          SA6    A1          .CLOSE THE GATE
          ZR,X1  LISTIT 
          SX6    1R 
 LISTIT   BSS    0
          SA3    HEAD 
          MX1    6
          BX3    -X1*X3 
          LX6    54 
          BX6    X6+X3
          SA6    A3 
          SA3    =XJPD       GET PRINT DENSITY FLAG 
          ZR     X3,PDOK     IF PRINT DENSITY ALREADY SET 
          WRITEC =XF.OUT,=XJPD,1
          MX6    0
          SA6    =XJPD       RESET PRINT DENSITY FLAG 
 PDOK     BSS    0
          WRITEC =XF.OUT,HEAD,(HEADEND-HEAD)
          WRITEC =XF.OUT,(=8L),1
          SX7    2
          SA5    WHCHED 
          AX5    1
          SA4    X5+SUBHEAD 
          SX6    X4 
          ZR     X6,NOSUB    IFZERO NO SUBHEAD
          AX4    30 
          WRITEC =XF.OUT,X4 
          WRITEC =XF.OUT,(=8L),1
          SX7    4
 NOSUB    BSS    0
          SA7    LINES
          EQ     EJECTP      RETURN 
          TITLE  PTLSTIN - INITIALIZE PTLST 
**        PTLSTIN - INITIALIZE PTLST
* 
*         CALLED TO INITIALIZE PTLST BEFORE COMPILATION OF EVERY PROGRAM
* 
  
 PTLSTIN  ENTRY. ** 
          SA5    =7R0000000 
          BX7    X5 
          SA7    PGN
          SX6    FRSTLNS
          SA6    LINES
          SX7    -1 
          SA7    CURNHED
          SX7    B0 
          SA7    WHCHED 
          SA7    BINPAGE
          SA1    =H+          + 
          BX6    X1 
          SA6    NAMEID 
          SA6    TIMHED 
          SA6    TYPE 
          EQ     PTLSTIN
          TITLE  MSG - WRITE MESSAGE TO DAYFILE 
**        MSG - WRITE MESSAGE TO DAYFILE
* 
  
 MSG      ENTRY. ** 
          SA1    X1 
          BX6    X1 
          SA6    MESS 
          SA5    PAGENUM
          SA4    =7L      1 
          BX4    X4-X5
          NZ     X4,NAMISOK 
          RJ     EJ1
 NAMISOK  BSS    0
          SA2    NAMEID 
          LX7    X2 
          SA7    MNAM 
          MESSAGE  MESSA,,R 
          EQ     MSG
          SPACE  4
*         MESSAGE SKELETON FOR MSG ROUTINE
  
 MESSA    DATA   10H -SYMPL-
 MESS     DATA   10H *** NNNN 
          DATA   10HERRORS IN 
 MNAM     DATA   10HAAAAAAAAAA
          DATA   0
          EJECT 
 TEMPX1   BSS    1
 TYPETAB  DATA   20HPROGRAM 
          DATA   20HPROCEDURE 
          DATA   20HFUNCTION
  
*         SKELETON FOR 1ST LINE OF SOURCE LISTING PAGE HEADER 
  
 HEAD     DATA   10H1 
 NAMEID   ENTRY. 10H
 TYPE     DATA   10H
          DATA   10H
 HEADTYP  DATA   20H* SOURCE LISTING *
          DATA   10H
          ENTRY  SYSID
 SYSID    DATA   10H SYMPL "SYMVER" 
          DATA   10H
          RMT 
* 
*  SYSTEM IDENTIFICATION INFO 
* 
* 
          ENTRY  SYSID2,SYSID3
 SYSID2   DATA   10HSYMPL  "SYMVER" 
 SYSID3   DATA   H*XXXXX66XX *
*                    '    ' ' ' 
*                    1    2 3 4 
* 
*        1 = JULIAN DATE OF THIS COMPILER LEVELS BIRTH
*        2 = OPTIMUM TARGET MACHINE 
*        3 = ACCEPTABLE TARGET MACHINE
*        4 = 0
* 
          RMT 
          ENTRY  DATHED 
 DATHED   DATA   10H MM/DD/YY 
 TIMHED   DATA   10H                 HH.MM.SS.
          DATA   10H     PAGE 
 PAGENUM  DATA   7L      0
 BINPAGE  ENTRY.  0                PAGE NUMBER (IN BINARY)
 HEADEND  EQU    *
 G.XX     SET    HEADEND-HEAD 
 MASHEAD  VFD    60/G.XX*10 
 PGN      DATA   7R0000000
 FRSTLNS  EQU    99999       INITIALIZED TO CAUSE PAGE EJECT
 LINES    ENTRY. FRSTLNS        INITIALIZED TO CAUSE PAGE EJECT 
 BCDTIME  DATA   10H
 NEWHEAD  DATA   20H* SOURCE LISTING *
          DATA   20H* DIAGNOSTICS * 
          DATA   20H* ALLOCATION *
          DATA   20H* OPTIMIZATION *
          DATA   20H* OBJECT CODE * 
          DATA   20H* STORAGE MAP * 
          DATA   20H* CROSS REFERENCE * 
          DATA   H+* COMMON BLOCKS *   +
 MESOBJ   DATA   H+    LINE   LOCATION        OCTAL           LABEL  +
          DATA   C+     OP   OPERANDS+
 MESOBJE  EQU    *
MESMAP DATA H*  NAME:C(10) TYPE   M LOC     FBIT NUM    NAME:C(10) TYPE 
,  M LOC     FBIT NUM    NAME:C(10) TYPE   *
          DATA   C*M LOC     FBIT NUM*
 MESMAPE  EQU    *
          ENTRY  MESCRF 
          ENTRY  CRFPART
 MESCRF   DATA   H*       NAME:C(10) TYPE    M DEFINED     SCOPE     *
          DATA   H+SET/USED/ATTRIBUTE - *=USED,A=ATTRIBUTE           +
 CRFPART  DATA   C+          +
 MESCRFE  EQU    *
 MESCOM   DATA   H*    NUMBER      NAME         LENGTH         NUMBER*
          DATA   H*      NAME         LENGTH         NUMBER      NAME*
          DATA   C*         LENGTH* 
 MESCOME  EQU    *
 SUBHEAD  BSSZ   1           WCHED=0   SOURCE 
          BSSZ   3           2,4,6
 G.XX     SET    MESOBJE-MESOBJ 
          VFD    30/MESOBJ,30/G.XX*10     8   OBJECT CODE 
 G.XX     SET    MESMAPE-MESMAP 
          VFD    30/MESMAP,30/G.XX*10     10  MAP 
 G.XX     SET    MESCRFE-MESCRF 
          VFD    30/MESCRF,30/G.XX*10    12  CROSS REF
 G.XX     SET    MESCOME-MESCOM 
          VFD    30/MESCOM,30/G.XX*10            14    COMMON BLOCKS
 CURNHED  DATA   -1 
 WHCHED   ENTRY. 0
 FIRSTFLG DATA   0               FLAG TO FORCE EJECT THE FIRST TIME 
*                                      IF L=0 OR L=1
 FINDPLS  VFD    60/SCPN
          VFD    60/NP
 NP       BSS    1
 FINDPTR  VFD    60/NP
          VFD    60/BOOL
          VFD    60/PTR 
 BOOL     BSS    1
 PTR      BSS    1
  
 LINELNG  CON    G.OUTL      LENGTH OF LINE IN CHARS
          SPACE  2
          END 
