*DECK COBOLSS 
USETEXT CCTTEXT 
USETEXT SSTEXT
PROC COBOLSS; 
  BEGIN 
  
  
  
  
*CALL HASHTAB 
CONTROL EJECT;
  
  
      # EXTERNAL PROCS CALLED BY COBOLSS #
      XREF
        BEGIN 
          PROC  ABORTSS;     # ABORT SOURCE SCANNER  (DEBUG-ONLY)      #
          PROC  BKSPSQ;      # BACKSPACE ONE LINE ON SEQUENTIAL FILE   #
          PROC  BUG020SET;   # SET DEBUG FLAGS                         #
          PROC CBLIST;        # OUTPUTS SOURCE LINES AND TITLES # 
          FUNC  CMM$AGR      I;        # ACQUIRE GROUP-ID              #
          PROC  CMM$ALV;               # ALLOCATE VARYING-POS BLOCK    #
          PROC  CMM$FGR;               # FREE GROUP OF BLOCKS          #
          PROC  INTERCEPTOR;    # DIAGNSTIC PROCESSOR # 
          PROC INTERPRETTER;  # MAIN INTERPRETTER ROUTINE # 
          PROC DATE;          # ACCESS CURRENT DATE # 
          PROC  PRINTIT;     # PRINT LAST LINE(S)                      #
          PROC  PUTSQ;       #WRITE A RECORD #
          PROC  RETRN;       #RETURN A FILE OR THE FILES BUFFER        #
          PROC  SETLINE;     # PREPARE TKNCLASSIFIER, SET EODFLAG/...  #
          PROC TIME;          # ACCESS CURRENT TIME # 
          PROC PUTMSG;        # OUTPUT DAYFILE MESSAGE #
        END 
  
      # DEFINE EXTERNAL ITEMS USED BY SSCANNER #
      XDEF
        BEGIN 
          ITEM QUOTE    C(1); # REAL QUOTE MARK # 
          ITEM CURSIGN  C(1); # REAL CURRENCY SIGN #
          ITEM DECPOINT C(1); # REAL DECIMAL POINT #
          ITEM COPYDONE  B; 
          ITEM SSGRPID I;  # CMM GROUP ID FOR SS BLOCKS # 
        END 
  
      # DECLARE TEMPORARIES # 
  
          ITEM I;             # LOOP CONTROL INDEX #
          ITEM DAYMSG   C(40) # DAYFILE MESSAGE # 
                        = "E M P T Y   S O U R C E   F I L E       "; 
          ITEM   $$DUMMY$$   I = 0;    #TERMINATE MESSAGE#
CONTROL EJECT;
  
      # DECLARE AND INITIALIZE SOURCE LINE IMAGE BOUNDARIES # 
      XDEF
        BEGIN 
          ITEM CMARGIN  U = 6; # COMMENT CONTINUATION MARGIN #
          ITEM AMARGIN  U = 7; # A-AREA MARGIN #
          ITEM BMARGIN  U = 11;# B-AREA MARGIN #
          ITEM RMARGIN  U = 72;# RIGHT MARGIN # 
        END 
  
      # OPTIONALLY DEFINE SSCANNER"S TRACE FLAGS AND PARAMETER AREA # 
      $BEGIN
      XDEF
        BEGIN 
          ITEM INDEBUG  B;    # INTERPRETTER TRACE #
          ITEM DDLDEBUG B;  #DDL DEBUG# 
        END 
      COMMON PARAMS;
        BEGIN 
          ARRAY PARAMT[0:7];
          ITEM  PARAMC  C(0,0,10);
        END 
      $END
  
      # DEFINE SOURCE LISTING SAVE AREAS #
      XREF
        BEGIN 
          ITEM LISTHED C(80); # LISTING PAGE HEADER # 
          ITEM LISTDAT C(10); # CURRENT DATE #
          ITEM LISTTIM C(10); # CURRENT TIME #
        END 
CONTROL EJECT;
  
*CALL SYSFET
  
CONTROL EJECT;
          XDEF PROC SSDIAGS;
          PROC SSDIAGS (DIAGNBR); 
          BEGIN 
 #   OUTPUT DIAGNOSTICS FOR SSCANNER - DIAGNOSTIC NUMBER IS INPUT # 
 #   USES LINE NUMBER FROM CLALINE AND COL FROM CLACOLUMN   # 
  
          ITEM DIAGNBR; 
  
          INTERCEPTOR (CLACOLUMN, CLALINE, DIAGNBR, 0); 
          RETURN; 
          END 
CONTROL EJECT;
 #   START OF MAIN PROCEDURE   #
  
          $BEGIN
          P<APARRAY> = 0; 
          P<APNTKNS> = 0; 
          P<APSTRING> = 0;
          P<FPARRAY> = 0; 
          P<FPNTKNS> = 0; 
          P<FPSTRING> = 0;
          P<PL$> = 0; 
          P<PRTBUF> = 0;
          P<TARRAY> = 0;
          $END
          P<TSTRING> = 0;              # (CHECKED BY -SKIPCLA-)        #
          SRCLISTLINE = -1;            # NO PL$LINE CAN MATCH THIS     #
          SSGRPID = CMM$AGR (1);  # ASSIGN GRP ID FOR SS - BELOW HHA #
          GROUP$PRINT = SSGRPID;
          CMM$ALV (5, 1, 3, SSGRPID, P<PL$>, 0);  #ASGN PRINT LINE BUFF#
          CMM$ALV (50, 1, 3, SSGRPID, P<PRTBUF>, 0);
          PLN$UNUSED = 5; 
          READLIB = FALSE;
          ENDCHRS = FALSE;
          COPYDONE = FALSE; 
  
      # INITIALIZE THE HASH TABLE # 
      FOR I = 0 STEP 1 UNTIL HASHTABLENM1 + 1 
      DO
        HASHFWORD [I] = 0;
      # INITIALIZE FLAGS AND LENGTHS #
      EODFLAG = FALSE;
          SOURCELIST = CCTSOURCLIST;
      # INITIALIZE QUOTE DEPENDING ON CONTROL CARD PARAMETER #
      IF CCTQUOTEAPOS[0] THEN 
        QUOTE = O"70"; #APOSTROPHE# 
      ELSE
        QUOTE = O"64"; #QUOTE#
      # INITIALIZE CURRENCY SIGN AND DECIMAL POINT AS PER CCT # 
      CURSIGN = CCTCURRSIGN[0]; 
      DECPOINT = CCTDECPOINT[0];
  
#  SET DEBUGGING INFORMATION FROM /PARAMS/   (CHK-FILE)                #
  
      $BEGIN
      BUG020SET;
      $END
CONTROL EJECT;
  
      #INITIALIZE GET CHARACTER ROUTINE WHICH MAY SET EODFLAG # 
          SETLINE;
      IF EODFLAG THEN # END OF DATA # 
        BEGIN 
          # FORMAT MESSAGE IN SPECIAL FORM #
          C<37,2>DAYMSG = 0; # 12 BITS OF 0"S IN LAST WORD #
          # GENERATE DAYFILE MESSAGE #
          PUTMSG(DAYMSG); 
          # SET FLAG TO TERMINATE THE COMPILATION # 
          CCTABORT[0] = TRUE; 
        END 
      ELSE
        INTERPRETTER; 
  
#     ENSURE THAT ANY REMAINING LINES ARE PRINTED                      #
  
      IF EODFLAG  THEN
          BEGIN                        # NOT STACKED COMPILE           #
          I = PLI$FIRST;               # FIRST UNPRINTED LINE          #
          FOR I=I WHILE I NQ 0  DO
              BEGIN 
              PRINTIT(I);              # PRINT THE LINE                #
              I = PL$NEXT[I];          # GO TO NEXT LINE               #
              END 
          END 
      ELSE
          BEGIN 
          FOR I = PLI$FIRST  WHILE
             C<7,14>PL$10CHARS[I] NQ "IDENTIFICATION" AND 
             C<8,14>PL$10CHARS[I] NQ "IDENTIFICATION" AND 
             C<9,14>PL$10CHARS[I] NQ "IDENTIFICATION" AND 
             C<10,14>PL$10CHARS[I] NQ "IDENTIFICATION"
             DO 
              BEGIN 
              $BEGIN
              IF I EQ 0  THEN 
                  ABORTSS("COBOLSS-1"); 
              $END
              PRINTIT(I); 
              I = PL$NEXT[I]; 
              END 
          FOR I = I WHILE I NQ 0  DO
              BEGIN 
              BKSPSQ(INFET);           # BACKSPACE ONE LINE ON INPUT   #
              I = PL$NEXT[I];          # LINK TO NEXT LINE             #
              END 
          END 
      IF COPYDONE 
      THEN
          RETRN(LIBFET);   # RETURN COPY LIB IF COPIES IN PROG #
      CMM$FGR (SSGRPID);  # FREE ANY SS CMM BLOCKS #
      CBLIST(9, "OUTPUT", 6);          # TERMINATE THE LISTING         #
      IF CCTSOURCLIST 
      THEN
          BEGIN   #WRITE EOR AND RETURN BUFFER IF STUFF WRITTEN ON LIST#
          PUTSQ(OUTFET, 0, 0);   #FLUSH THE OUTPUT BUFFER#
          RETRN(OUTFET);   #RETURN THE BUFFER FOR THE OUTPUT FILE#
          END 
    END # OF COBOLSS #
  TERM
