home *** CD-ROM | disk | FTP | other *** search
/ Frozen Fish 1: Amiga / FrozenFish-Apr94.iso / bbs / alib / d5xx / d512 / m2pascal.lha / M2Pascal / src / scan.mod < prev    next >
Text File  |  1991-07-20  |  27KB  |  939 lines

  1. IMPLEMENTATION MODULE scan;
  2.  
  3. (* 
  4.  
  5.                       **********
  6.                       ** SCAN **     ( BETA version )
  7.                       **********
  8.  
  9.              by : Greg Mumm
  10.  
  11.  
  12.       This lex. scanner reads multiple symbols one by one on a per line basis.
  13.  
  14.       The look-ahead buffer is organized like this: ( Each character
  15.       represents one line of the source data )
  16.  
  17.                    ---                             <<     Never read again
  18.                     *    <-- PermanentPtr          ---
  19.                     B                                 \
  20.                     U                                  >  Full of data
  21.                     F    <-- AheadFrontPtr            /   to be read again
  22.                     F                                /
  23.                     E    <-- AheadRearPtr          --
  24.                     R    
  25.                     *
  26.                     *
  27.                     *    <-- BUFFERSIZE
  28.                     ---   
  29.  
  30.                         All of the above data is used to set "BufferIndex"
  31.                         which points to the correct line in the buffer.
  32.  
  33. *)
  34.  
  35.  
  36. FROM FileSystem  IMPORT ReadChar,         File,             Response,
  37.                         Lookup,           Close,            WriteChar;
  38. FROM InOut       IMPORT WriteString,      WriteCard,        ReadString;
  39. FROM Strings     IMPORT CompareString,    Relation,         CopyString;
  40. FROM errors      IMPORT FatalError,       ErrorMessage,     ErrorType,
  41.                         ErrorFileMessage, internal;
  42. FROM heap        IMPORT ALLOCATE,         DEALLOCATE;
  43.  
  44. CONST 
  45.       BUFFERSIZE = 8;      (* size of look-ahead buffer: Stores BUFFERSIZE - 1
  46.                               lines for "look-ahead"  *)
  47.  
  48.  
  49. TYPE
  50.      AccessType    = ( normal  ,       ScanAhead                   );
  51.      ReadStatusType= ( permanent,      AheadFront,    AheadRear    );
  52.      LineArray     = ARRAY  [ 1..StringMax ] OF CHAR;
  53.      LineRecType   = RECORD 
  54.                        line          :  LineArray;
  55.                        PermanentPtr  :  CARDINAL;
  56.                        AheadFrontPtr :  CARDINAL;
  57.                        AheadRearPtr  :  CARDINAL;
  58.      END;
  59.      LineBufferType = ARRAY [ 1..BUFFERSIZE ] OF  LineRecType;
  60. (*
  61.      ScanFileRec = RECORD
  62.                        FileData      :  File;
  63.                        LineBuffer    :  LineBufferType;
  64.                        LineNumber    :  CARDINAL;
  65.                        PermanentPtr  :  CARDINAL;
  66.                        AheadFrontPtr :  CARDINAL;
  67.                        AheadRearPtr  :  CARDINAL;
  68.                        EndLine       :  BOOLEAN;
  69.                        EndLineAhead  :  BOOLEAN;
  70.                        EndFile       :  BOOLEAN;
  71.                        EndFileAhead  :  BOOLEAN;
  72.                        BufferFull    :  BOOLEAN;
  73.                        LastAccess    :  AccessType;
  74.                     END;
  75. *)
  76.  
  77.  
  78. VAR
  79.       PermanentPtr,
  80.       AheadFrontPtr,
  81.       AheadRearPtr,
  82.       PermanentStore,
  83.       AheadFrontStore,
  84.       AheadRearStore,
  85.       BufferIndex    :  CARDINAL;
  86.       LineBuffer     :  LineBufferType;  (* List of lines we're working on *)
  87.       InFile         :  File;         (* The AmigaDos file we're working on *)
  88.       OutFile        :  File;
  89.       ch             :  CHAR;
  90.       SymbolPtr      :  CARDINAL;
  91.       CharPtr        :  CARDINAL;
  92.       indent         :  IndentArray;  (* Margin information before 1'st symol *)
  93.       InName         :  NameString;
  94.       OutName        :  NameString;
  95.       EndLine        ,
  96.       EndFile        ,
  97.       EndLineAhead   ,
  98.       EndFileAhead   :  BOOLEAN;
  99.       EndLineStore   ,
  100.       EndFileStore   ,
  101.       EndLineAheadStore ,
  102.       EndFileAheadStore :  BOOLEAN;
  103.       LineNumber     :  CARDINAL;
  104.       BufferFull     :  BOOLEAN;
  105.       LastAccess     :  AccessType;
  106.       status         :  ReadStatusType;
  107.       ahead          :  BOOLEAN;
  108.       DebugOutput    :  BOOLEAN;
  109.        
  110. (*
  111.  -------------------------------------------------------------------------
  112.                        General file usage procedures.
  113. *)
  114.  
  115.  
  116.  (* 
  117.    Store "new" to proper value. ( Store it to flag or FlagAhead ). "flag"
  118.    represents EndLine or EndFile.
  119.  *)
  120. PROCEDURE SetVal ( VAR flag , FlagAhead : BOOLEAN;  new, ahead : BOOLEAN );
  121. BEGIN
  122.       IF ( NOT ahead ) THEN
  123.             flag      := new;
  124.       ELSE
  125.             FlagAhead := new;
  126.       END;
  127. END SetVal;
  128.  
  129.  
  130. PROCEDURE BlankOutBuffer ();
  131.  VAR i,j : CARDINAL;
  132. BEGIN
  133.  FOR i := 1 TO BUFFERSIZE DO
  134.      FOR j := 1 TO StringMax DO
  135.           LineBuffer [ i ].line[ j ]         := 0C;
  136.      END;
  137.      LineBuffer [ i ].PermanentPtr           := 1;          
  138.      LineBuffer [ i ].AheadFrontPtr          := 1;          
  139.      LineBuffer [ i ].AheadRearPtr           := 1;          
  140.  END;
  141. END BlankOutBuffer ;
  142.  
  143.  
  144.  (* This procedure determines where the data requested is to be read from.
  145.     There are three possibities of output:    
  146.     
  147.                        PermanentData     ( Return this data and never come
  148.                                            back. )
  149.                        AheadFront        ( Return data to be re-read later.
  150.                                            If read before, send it again. )
  151.                        AheadRear         ( Return data to be re-read later.
  152.                                            Use data that hasn't been 
  153.                                            read before.)
  154.     Input : ahead , LastAccess.
  155.  *)
  156.  
  157. PROCEDURE ReadStatus () : ReadStatusType;
  158. BEGIN
  159.      IF ( NOT ahead ) THEN
  160.                      RETURN permanent;
  161.      ELSE
  162.           IF ( LastAccess = normal ) THEN
  163.                      RETURN AheadFront;
  164.           ELSE
  165.                         RETURN AheadRear;
  166.           END;
  167.      END;
  168. END ReadStatus;
  169.  
  170.  
  171. PROCEDURE DataSet() : BOOLEAN;
  172. BEGIN
  173.     RETURN InName[0] <> 0C;
  174. END DataSet;
  175.  
  176.  
  177. PROCEDURE DetermineEof (ahead:BOOLEAN) : BOOLEAN;
  178.  VAR ReturnVal : BOOLEAN;
  179. BEGIN
  180.     ReturnVal := FALSE;
  181.     IF DataSet() THEN
  182.         IF ( NOT ahead ) THEN
  183.             ReturnVal := EndFileStore;
  184.         ELSE
  185.             ReturnVal := EndFileAheadStore;
  186.         END;
  187.     END;
  188.     RETURN ReturnVal ;
  189. END DetermineEof;
  190.  
  191.  
  192. PROCEDURE DetermineEoln ( ahead : BOOLEAN ) : BOOLEAN;
  193.  VAR ReturnVal : BOOLEAN;
  194. BEGIN
  195.     ReturnVal := FALSE;
  196.     IF DataSet () THEN
  197.         IF ( NOT ahead ) THEN
  198.             ReturnVal := EndLineStore;
  199.         ELSE
  200.             ReturnVal := EndLineAheadStore;
  201.         END;
  202.     END;
  203.     RETURN ReturnVal;
  204. END DetermineEoln;
  205.  
  206.  
  207.  
  208. PROCEDURE eof () : BOOLEAN;
  209. BEGIN
  210.   RETURN DetermineEof ( FALSE );
  211. END eof;
  212.  
  213.  
  214. PROCEDURE EofAhead () : BOOLEAN;
  215. BEGIN
  216.   RETURN DetermineEof ( TRUE );
  217. END EofAhead;
  218.  
  219.  
  220. PROCEDURE eoln () : BOOLEAN;
  221. BEGIN
  222.   RETURN DetermineEoln ( FALSE );
  223. END eoln;
  224.  
  225.  
  226. PROCEDURE EolnAhead ( ) : BOOLEAN;
  227. BEGIN
  228.   RETURN DetermineEoln ( TRUE );
  229. END EolnAhead;
  230.  
  231.  
  232.  
  233. PROCEDURE HitABrickWall ( ) :  BOOLEAN;
  234. BEGIN
  235.   RETURN ( eof () OR  eoln () );
  236. END HitABrickWall;
  237.  
  238.  
  239.  (* The two following procedured don't work! 
  240.     An attempt was made to find a solution to
  241.     the problem of ReadingAhead after a ReadAhead command. In the 
  242.     second case we wish to read the same symbol as the first case.
  243. *)
  244. PROCEDURE rewind ();
  245. BEGIN
  246.     LastAccess    := normal ;
  247. END rewind;
  248.  
  249.  
  250. PROCEDURE FastForward ();
  251. BEGIN
  252.  LastAccess := ScanAhead ;
  253. END FastForward;
  254.  
  255.  
  256. (*
  257.    Was look-ahead buffer full?
  258. *)
  259. PROCEDURE TooFar () : BOOLEAN;
  260. BEGIN
  261.     IF DataSet () THEN
  262.          RETURN BufferFull;
  263.     ELSE
  264.          RETURN TRUE;
  265.     END;
  266. END TooFar;
  267.  
  268.  
  269. PROCEDURE OpenFile (     name     : ARRAY OF CHAR;
  270.                      VAR FileData : File; 
  271.                        DeleteFile : BOOLEAN ) : BOOLEAN;
  272. BEGIN
  273.      Lookup ( FileData , name, DeleteFile ); 
  274.      RETURN ( FileData.res = done );
  275. END OpenFile;
  276.  
  277.  
  278. PROCEDURE OpenInFile (    FileName   : NameString  ;
  279.                           DeleteFile : BOOLEAN     ;
  280.                       VAR opened     : BOOLEAN      ) ;
  281. BEGIN
  282.      opened := OpenFile(FileName,InFile,DeleteFile);
  283.      IF opened THEN
  284.               CopyString(InName,FileName);
  285.               BlankOutBuffer ();
  286.               LineNumber          := 0;          (* Just read this line *)
  287.               PermanentPtr        := 1;
  288.               AheadFrontPtr       := 1;
  289.               AheadRearPtr        := 1;
  290.               PermanentStore      := 1;
  291.               AheadFrontStore     := 1;
  292.               AheadRearStore      := 1;
  293.               EndFile             := FALSE;
  294.               EndFileAhead        := FALSE;
  295.               EndLine             := FALSE;
  296.               EndLineAhead        := FALSE;
  297.               EndFileStore        := FALSE;
  298.               EndFileAheadStore   := FALSE;
  299.               EndLineStore        := FALSE;
  300.               EndLineAheadStore   := FALSE;
  301.               BufferFull          := FALSE;
  302.               LastAccess          := normal;
  303.       ELSE
  304.               InName[0]:=0C;
  305.       END;
  306. END OpenInFile;
  307.  
  308.  
  309. PROCEDURE OpenOutFile (    FileName   : NameString  ;
  310.                           DeleteFile  : BOOLEAN     ;
  311.                       VAR opened      : BOOLEAN      ) ;
  312. BEGIN
  313.      opened := OpenFile(FileName,OutFile,DeleteFile);
  314.      IF opened THEN
  315.               CopyString(OutName,FileName);
  316.      ELSE
  317.               OutName[0]:=0C;
  318.      END;
  319. END OpenOutFile;
  320.  
  321.  
  322.  
  323. PROCEDURE CloseAllFiles ();
  324.  VAR successful:BOOLEAN;
  325. BEGIN
  326.      IF (InName[0]<>0C) THEN 
  327.           Close ( InFile );
  328.           successful := ( InFile.res = done ) OR  ( InFile.eof = TRUE );
  329.           IF NOT successful THEN ErrorMessage ( FileClose );   END;
  330.           InName[0]:=0C;
  331.      END;
  332.      IF (OutName[0]<>0C) THEN
  333.           Close ( OutFile );
  334.           successful := ( OutFile.res = done ) OR  ( OutFile.eof = TRUE );
  335.           IF NOT successful THEN ErrorMessage ( FileClose );   END;
  336.           OutName[0]:=0C;
  337.      END;
  338. END CloseAllFiles;
  339.  
  340.  
  341. (*
  342.  ---------------------------------------------------------------------------
  343.        Read from file into one line of information.
  344. \/     \/     \/    \/    \/    \/    \/    \/    \/    \/    \/    \/    \/
  345. *)
  346.  
  347.  
  348.  
  349. (* 
  350.   This procedure reads in another character from the InFile.
  351. *)
  352. PROCEDURE NextCh ( VAR ptr     : CARDINAL;    
  353.                    VAR ch      : CHAR );
  354. BEGIN
  355.         LineBuffer [ BufferIndex ]. line [ ptr ] := ch;
  356.         ReadChar ( InFile, ch );
  357.         INC (ptr);
  358. END NextCh;
  359.  
  360.  
  361.  
  362. (*
  363.    Setup global values to be used by internal procedures and setup
  364.    externally visible variables.
  365. *)
  366. PROCEDURE LineSetGlobal ();
  367. BEGIN
  368.     BufferFull           := FALSE;
  369.     EndLine              := FALSE;
  370.     EndFile              := FALSE;
  371.     PermanentPtr         := PermanentStore;
  372.     AheadFrontPtr        := AheadFrontStore;
  373.     AheadRearPtr         := AheadRearStore;
  374.     status               := ReadStatus ();
  375. END LineSetGlobal;
  376.  
  377.  
  378.  
  379. (* 
  380.    Determine which line in buffer we should be accessing next.
  381. *)
  382. PROCEDURE SetBufferIndex () : CARDINAL;
  383. BEGIN
  384.      IF     ( status = permanent )  THEN
  385.           IF     ( PermanentPtr <> AheadRearPtr )  THEN
  386.            INC    ( PermanentPtr , 1 );
  387.           ELSE
  388.                PermanentPtr  := 1;
  389.                AheadFrontPtr := 1;
  390.                AheadRearPtr  := 1;
  391.           END;
  392.           RETURN        PermanentPtr;
  393.      ELSIF ( status = AheadRear )  THEN
  394.           INC    ( AheadRearPtr );
  395.           IF     ( AheadRearPtr > BUFFERSIZE ) THEN
  396.                BufferFull := TRUE;
  397.            RETURN 0;               
  398.           END;
  399.           RETURN AheadRearPtr;
  400.      ELSE
  401.           INC    ( AheadFrontPtr );
  402.           RETURN AheadFrontPtr;
  403.      END;
  404. END SetBufferIndex;
  405.  
  406.  
  407.  (* Print INPUT line
  408.   *)
  409. PROCEDURE DebugPrintLine ( indent : IndentArray );
  410.  VAR    i : CARDINAL ; 
  411. BEGIN
  412.      (* 
  413.         note: line numbers NOT accurate after a readAHEADline
  414.      *)
  415.         WriteString("\n--------");WriteString(InName);
  416.         WriteCard ( LineNumber , 3 );
  417.         WriteString("---");WriteString("\n");
  418.         i := 1;
  419.         REPEAT
  420.            ch := LineBuffer [ BufferIndex ] . line [ i ] ;
  421.            IF  ch = EOLN THEN
  422.                WriteString("\n");
  423.            ELSIF ch = 0C THEN
  424.                WriteString("<eof> OR 0C\n");
  425.            ELSE
  426.                WriteString( ch );
  427.            END;
  428.            INC( i );
  429.         UNTIL ( ch=EOLN )  OR ( ch = 0C );
  430.         WriteString("----------------------------------------------------\n"); 
  431. END DebugPrintLine;
  432.  
  433.  
  434.  (* Print all data sent to OUTPUT (object) file. Set this and you're
  435.     looking at the file as it is being written to disk.
  436.   *)
  437. PROCEDURE DebugOutputToggle ();
  438. BEGIN
  439.     IF DebugOutput THEN
  440.         WriteString("DebugOutputToggle. Output to screen OFF.\n");
  441.         DebugOutput := FALSE;
  442.     ELSE
  443.         WriteString("DebugOutputToggle executed. All data sent to \n");
  444.         WriteString("a file is being printed to screen also.\n\n");
  445.         DebugOutput := TRUE;
  446.     END;
  447. END DebugOutputToggle;
  448.  
  449. (*
  450.    What line number are we processing. Add offset if we're looking ahead.
  451.    ( internal use )
  452. *)
  453. PROCEDURE GetLineNumber ( ) : CARDINAL;
  454.  VAR status : ReadStatusType;
  455. BEGIN
  456.      IF NOT ahead THEN 
  457.           RETURN LineNumber;
  458.      ELSE
  459.           status :=  ReadStatus ();
  460.           IF ( status = AheadFront ) THEN
  461.                  RETURN ( LineNumber + 
  462.                         ( AheadFrontPtr - PermanentPtr ) );
  463.           ELSE
  464.                  RETURN ( LineNumber + 
  465.                         ( AheadFrontPtr - PermanentPtr ) );
  466.           END;
  467.      END;
  468. END GetLineNumber;
  469.  
  470.  
  471.  
  472. PROCEDURE PrintLineNumber ();
  473. BEGIN
  474.      IF ( NOT DebugOutput ) THEN
  475.       WriteString("\n");
  476.           WriteCard(LineNumber,1);    
  477.      END;
  478. END PrintLineNumber;
  479.  
  480.  
  481.  
  482.  
  483. PROCEDURE ScanLine ( VAR indent : IndentArray;  VAR good : BOOLEAN  ;
  484.                          ahead  : BOOLEAN );
  485.  VAR i, ptr, IndentPtr : CARDINAL; ch : CHAR;
  486. BEGIN
  487.       i := 1; ptr := 1; IndentPtr := 1; ch := 0C;
  488.  
  489.       (* set 'indent' *)
  490.      ReadChar ( InFile, ch );
  491.      WHILE ( ((ch = SPACE) OR ( ch = TAB ))  AND (InFile.res = done)  )  DO
  492.                 indent [ IndentPtr ] := ch;
  493.                 INC    ( IndentPtr,  1 );
  494.                 NextCh ( ptr,        ch );
  495.      END;
  496.  
  497.  
  498.       (* Read in rest of line *)
  499.      WHILE   ( (InFile.res = done) & 
  500.                ( (( NOT InFile.eof) & (ch <> EOLN)) & (ptr < StringMax ) ) ) DO
  501.                 NextCh ( ptr, ch );
  502.      END; 
  503.  
  504.  
  505.      IF InFile.eof THEN
  506.                 EndFile                                   := TRUE;
  507.                 LineBuffer [ BufferIndex ] . line [ ptr ] := 0C;
  508.  
  509.      ELSIF  InFile.res <> done   THEN
  510.                 good  := FALSE;
  511.  
  512.       ELSIF ( ch = EOLN ) THEN
  513.                 LineBuffer [ BufferIndex ] . line [ ptr ]     := EOLN;
  514.  
  515.  
  516.      ELSIF ( ptr >=  StringMax ) THEN  
  517.                 ErrorFileMessage ( Scan_DataPastEndOfLine , 
  518.                                    InName,
  519.                                    GetLineNumber () );
  520.                 LineBuffer [ BufferIndex ] . line [ ptr ]     := EOLN;
  521.      END;
  522.      
  523.      indent [ IndentPtr ] := 0C;     
  524.  
  525. END ScanLine;
  526.  
  527.  
  528.  
  529. (*
  530.    Save the global data to FileInfo after reading a line.
  531.    (Return value of items).
  532. *)
  533. PROCEDURE LineReadGlobal ();
  534. BEGIN
  535.      SetVal ( EndFileStore , EndFileAheadStore, EndFile, ahead );
  536.      SetVal ( EndLineStore , EndLineAheadStore, EndLine, ahead );
  537.      AheadFrontStore :=    AheadFrontPtr;
  538.      AheadRearStore  :=    AheadRearPtr;
  539.      PermanentStore  :=    PermanentPtr;
  540.      
  541.      IF ( status = permanent ) THEN
  542.           LastAccess    := normal;
  543.      ELSE
  544.           LastAccess    := ScanAhead;
  545.      END;
  546.      LineBuffer[ BufferIndex ] . PermanentPtr  :=    1;
  547.      LineBuffer[ BufferIndex ] . AheadFrontPtr :=    1;
  548.      LineBuffer[ BufferIndex ] . AheadRearPtr  :=    1;
  549. END LineReadGlobal;
  550.  
  551.  
  552.  
  553.  
  554. (* Read from the file or buffer?
  555. *)
  556. PROCEDURE ReadInFileData () : BOOLEAN;
  557. BEGIN
  558.      RETURN   ( BufferIndex = 1    )   OR
  559.               ( status = AheadRear ) ;
  560. END ReadInFileData;
  561.  
  562.  
  563.  
  564. (*
  565.    Read in one line from input file.
  566. *)
  567. PROCEDURE ReadInLine (   ahead : BOOLEAN ;  
  568.                       VAR good : BOOLEAN ;   VAR indent   : IndentArray );
  569. BEGIN
  570.  LineSetGlobal  ();
  571.  BufferIndex    := SetBufferIndex ( );
  572.  
  573.  IF NOT BufferFull THEN
  574.     IF ReadInFileData () THEN 
  575.          LineBuffer [ BufferIndex ] . line [ StringMax ] := 0C;
  576.          ScanLine   ( indent , good, ahead );
  577.     END;
  578.     IF good THEN LineReadGlobal (); END;
  579.  END;
  580. END ReadInLine;
  581.  
  582.  
  583.  
  584. PROCEDURE ReadLine ( VAR indent     : IndentArray  ) : BOOLEAN ;
  585.  VAR     ptr : CARDINAL;     i : CARDINAL;    ch : CHAR;   IndentPtr : CARDINAL;
  586.         good : BOOLEAN;
  587. BEGIN
  588.  good := TRUE;
  589.  IF NOT DataSet () THEN 
  590.         ErrorMessage( FileNotOpened );
  591.         good := FALSE;
  592.  END;
  593.  
  594.  ahead := FALSE;
  595.  IF good THEN
  596.     ReadInLine ( ahead, good, indent );
  597.     INC ( LineNumber )
  598.  END;
  599.  RETURN good;
  600. END ReadLine;
  601.  
  602.  
  603.  
  604. PROCEDURE ReadAheadLine ( VAR indent  : IndentArray  ) : BOOLEAN ;
  605.  VAR     ptr : CARDINAL;     i : CARDINAL;    ch : CHAR;   IndentPtr : CARDINAL;
  606.         good : BOOLEAN;
  607. BEGIN
  608.  good := TRUE;
  609.  IF NOT DataSet () THEN 
  610.         ErrorMessage( FileNotOpened );
  611.         good := FALSE;
  612.  END;
  613.  
  614.  ahead := TRUE;
  615.  IF good AND ( NOT eof () ) THEN
  616.       ReadInLine ( ahead, good, indent );
  617.  END;
  618.  RETURN ( good )  AND  ( NOT BufferFull )  ;
  619. END ReadAheadLine;
  620.  
  621.  
  622.  
  623.  
  624. (*
  625.   --------------------------------------------------------------------------
  626.                        Symbol processing procedures.
  627. \/     \/     \/    \/    \/    \/    \/    \/    \/    \/    \/    \/    \/
  628. *)
  629.  
  630.  
  631.  
  632.  
  633. (*
  634.    Add 'ch' to the symbol and get next 'ch'.
  635. *)
  636.  
  637. PROCEDURE AddChar ( VAR symbol     : STRING );
  638. BEGIN
  639.         symbol [ SymbolPtr ] := ch;
  640.         INC ( SymbolPtr , 1 );
  641.         INC ( CharPtr   , 1 );
  642.         ch := LineBuffer [ BufferIndex ] . line [ CharPtr ];
  643. END AddChar;
  644.  
  645.  
  646. (*
  647.    Reads in a literal. ( Charcters between and including quotes )
  648. *)
  649. PROCEDURE ScanLiteral ( VAR symbol   :   STRING;  VAR correct    : BOOLEAN  );
  650.  VAR   working        : BOOLEAN;
  651.        i              : CARDINAL;
  652.        quote          : CHAR;
  653.        CharPtrStart   : CARDINAL;
  654.        SymbolPtrStart : CARDINAL;
  655. BEGIN
  656.      working         := TRUE;
  657.      ch              := LineBuffer [ BufferIndex ] . line [ CharPtr ];
  658.      quote           := ch ;
  659.      correct         := TRUE;
  660.  
  661.      AddChar ( symbol );
  662.  
  663.       (* Save location in case no end quote found *)
  664.      CharPtrStart    := CharPtr;    
  665.      SymbolPtrStart  := SymbolPtr;
  666.  
  667.      WHILE  (  working & ( CharPtr < StringMax )  &
  668.             ( ( ch <> 0C ) OR ( ch <> EOLN ) ) )          DO
  669.  
  670.                 IF  ( ch = quote ) THEN
  671.                         working :=  
  672.                               LineBuffer [ BufferIndex ] . 
  673.                                line [ CharPtr + 1 ] = quote ;
  674.                         IF  working THEN    (* double quote *)
  675.                                 AddChar ( symbol );
  676.                         END;
  677.                 END;
  678.  
  679.                 IF (( CharPtr < StringMax ) & 
  680.                    ( ( ch <> 0C ) OR ( ch <> EOLN )))     THEN
  681.  
  682.                     AddChar ( symbol );
  683.                 END;
  684.      END;
  685.  
  686.      IF working & ( CharPtr = StringMax  ) THEN
  687.                 (* second quote not detected *)
  688.                 correct   := FALSE;
  689.                 CharPtr   := CharPtrStart;
  690.                 SymbolPtr := SymbolPtrStart;
  691.      END;
  692.  
  693.      symbol [ SymbolPtr ]  := 0C;     
  694. END ScanLiteral;
  695.  
  696.  
  697.  
  698. PROCEDURE BLANKS ( ch : CHAR ) : BOOLEAN;
  699. BEGIN
  700.     RETURN  ( ch =  SPACE ) OR ( ch =  TAB )
  701. END BLANKS;
  702.  
  703.  
  704.  
  705. PROCEDURE alphabetic ( ch : CHAR ) : BOOLEAN;
  706. BEGIN
  707.          (* It's confussing looking, but it's fast, and it works... *)
  708.         RETURN  (  (( ch >= "a" ) &  ( ch <= "z" )) OR 
  709.                    (( ch >= "A" ) &  ( ch <= "Z" )) OR
  710.                     ( ch =  "_" )                    OR
  711.                     ( ch =  "'" )                    OR
  712.                     ( ch =  '"' )                     );
  713. END alphabetic;
  714.  
  715.  
  716. (*
  717.    Extra characters are allowed after the first character is read
  718.    in. ( For instance  the "_" character ) . This procedure excludes
  719.    these characters.
  720.  *)
  721. PROCEDURE StartAlphabetic ( ch : CHAR ) : BOOLEAN;
  722. BEGIN
  723.         RETURN (  ( ( ch >= "a" ) &  ( ch <= "z" ) ) OR 
  724.                   ( ( ch >= "A" ) &  ( ch <= "Z" ) ) );
  725.  
  726. END StartAlphabetic;
  727.  
  728.  
  729.  
  730.  
  731. PROCEDURE numeric ( ch : CHAR ) : BOOLEAN;
  732. BEGIN
  733.       RETURN    ( (( ch >='0' ) & ( ch <= '9' ))  OR
  734.                    ( ch = '.' )                   OR
  735.                    ( ch = 'e' )                   OR
  736.                    ( ch = 'E' )                   OR
  737.                    ( ch = '+' )                   OR
  738.                    ( ch = '-' ) );
  739. END numeric;
  740.  
  741.  
  742.  
  743.  (* Test if character is a number while searching an identifier.
  744.     Decimal points etc are NOT included
  745.   *)
  746. PROCEDURE digit ( ch : CHAR ) : BOOLEAN;
  747. BEGIN
  748.       RETURN    ( ( ch >='0' ) & ( ch <= '9' ) );
  749. END digit;
  750.  
  751.  
  752.  
  753. (*
  754.    Set output of SetPtr is based on  "ahead" and LastAccess.
  755.  
  756.    Each line looks like this:
  757.        
  758.            [ x x x x x x x x x x x x x x x x x x x x ...]
  759.                ^             ^               ^
  760.                PermanentPtr  AheadFrontPtr   AheadRearPtr
  761.  
  762.            where: Anything left of PermanentPtr has been read and is gone 
  763.                    forever.
  764.                   Anything between PermanentPtr & AheadRearPtr has been
  765.                    read from the file already and is waiting to be processed.
  766.                   AheadFrontPtr is used when scanning ahead when there is
  767.                    scanned ahead data to read.
  768. *)
  769. PROCEDURE SetPtr () : CARDINAL;
  770. BEGIN
  771.      IF     ( status = permanent )  THEN
  772.                RETURN PermanentPtr;
  773.      ELSIF  ( status = AheadRear )  THEN
  774.                RETURN AheadRearPtr;
  775.      ELSE
  776.                RETURN AheadFrontPtr;               
  777.      END;
  778. END SetPtr;
  779.  
  780.  
  781. PROCEDURE SetBufferIndexForSymbol () : CARDINAL;
  782. BEGIN
  783.      IF     ( status = permanent )  THEN
  784.                RETURN PermanentStore;
  785.      ELSIF  ( status = AheadRear )  THEN
  786.                RETURN AheadRearStore;
  787.      ELSE
  788.                RETURN AheadFrontStore;               
  789.      END;
  790. END SetBufferIndexForSymbol;
  791.  
  792.  
  793. PROCEDURE SymbolSetGlobal (  VAR LiteralCorrect  : BOOLEAN );
  794. BEGIN
  795.         status               := ReadStatus ();
  796.         BufferIndex          := SetBufferIndexForSymbol ();
  797.         PermanentPtr         := LineBuffer [ BufferIndex ] . 
  798.                                  PermanentPtr;
  799.         AheadFrontPtr        := LineBuffer [ BufferIndex ] . 
  800.                                  AheadFrontPtr;
  801.         AheadRearPtr         := LineBuffer [ BufferIndex ] . 
  802.                                  AheadRearPtr;
  803.         SymbolPtr            := 0;
  804.         LiteralCorrect       := FALSE;
  805.         CharPtr              := SetPtr ();
  806.         ch                   := LineBuffer [ BufferIndex ]. line  [ CharPtr ] ;
  807. END SymbolSetGlobal;
  808.  
  809.  
  810.  
  811.  
  812. PROCEDURE ReadInSymbol (  VAR symbol         : STRING; 
  813.                           VAR SymbolClass    : SymbolType ;
  814.                           VAR LiteralCorrect : BOOLEAN );
  815. BEGIN
  816.         IF BLANKS(ch) THEN
  817.                 WHILE ( BLANKS ( ch )  &  ( CharPtr < StringMax ) ) DO
  818.                    AddChar ( symbol );
  819.                 END;
  820.                 SymbolClass          := blanks;      
  821.                 symbol [ SymbolPtr ] := 0C;
  822.         ELSIF StartAlphabetic ( ch ) THEN       
  823.                 WHILE ( ( alphabetic ( ch ) OR digit ( ch ) &  
  824.                       ( CharPtr < StringMax ) ) )   DO
  825.                   AddChar ( symbol );
  826.                 END;
  827.                         SymbolClass          := identifier;  
  828.                         symbol [ SymbolPtr ] := 0C;
  829.         ELSIF numeric ( ch ) THEN
  830.                 WHILE  ( numeric ( ch ) &  ( CharPtr < StringMax ) ) DO
  831.                    AddChar ( symbol );
  832.                 END;
  833.                         SymbolClass          := number;      
  834.                         symbol [ SymbolPtr ] := 0C;
  835.         ELSIF ( ( ch = "'" ) OR ( ch = '"') ) THEN
  836.                 ScanLiteral ( symbol , LiteralCorrect );
  837.                 IF LiteralCorrect THEN  SymbolClass  := literal;
  838.                 ELSE                    SymbolClass  := other  ;   END;
  839.          (* eoln or eof *)
  840.         ELSIF ( ( ch = EOLN ) OR ( ch = 0C ) ) THEN
  841.                 EndLine              := TRUE;
  842.                 SymbolClass          := end;
  843.                 symbol [ SymbolPtr ] := EOLN;
  844.                 IF SymbolPtr < StringMax THEN
  845.                      INC    ( SymbolPtr );
  846.                      symbol [ SymbolPtr ] := 0C;
  847.                 END;
  848.         ELSE
  849.                 AddChar ( symbol );
  850.                 SymbolClass           := other;
  851.                 symbol  [ SymbolPtr ] := 0C;
  852.         END;
  853. END ReadInSymbol;
  854.  
  855.  
  856.  (* Store the global data we modified when reading a symbol 
  857.     back to FileInfo.
  858.   *)
  859. PROCEDURE SymbolReadGlobal ();
  860. BEGIN
  861.       IF    ( status = permanent ) THEN
  862.               LastAccess := normal;
  863.               LineBuffer [ BufferIndex ] . PermanentPtr  := CharPtr;
  864.               IF    ( CharPtr > AheadFrontPtr ) THEN
  865.                    LineBuffer [ BufferIndex ] . AheadFrontPtr  := CharPtr; 
  866.               END;
  867.               IF ( CharPtr > AheadRearPtr  ) THEN
  868.                    LineBuffer [ BufferIndex ] . AheadRearPtr   := CharPtr; 
  869.               END;
  870.       ELSIF ( status = AheadRear ) THEN
  871.               LastAccess := ScanAhead;
  872.               LineBuffer [ BufferIndex ] . AheadRearPtr  := CharPtr;
  873.       ELSE
  874.               LastAccess := ScanAhead;
  875.               LineBuffer [ BufferIndex ] . AheadFrontPtr  := CharPtr;
  876.               IF    ( CharPtr > AheadRearPtr ) THEN
  877.                    LineBuffer [ BufferIndex ] . AheadRearPtr  := CharPtr; 
  878.               END;
  879.      END;
  880.      SetVal ( EndLineStore , EndLineAheadStore , EndLine, ahead );
  881. END SymbolReadGlobal;
  882.  
  883.  
  884.  
  885. (*
  886.   Input : one line.
  887.   Output: One symbol and it's class.
  888. *)
  889. PROCEDURE ReadSymbol ( VAR  symbol        : STRING;
  890.                        VAR  SymbolClass   : SymbolType );
  891.  VAR     LiteralCorrect :  BOOLEAN;  
  892. BEGIN
  893.         ahead := FALSE;
  894.         SymbolSetGlobal    ( LiteralCorrect );
  895.         ReadInSymbol       ( symbol,  SymbolClass, LiteralCorrect );
  896.         SymbolReadGlobal   ();
  897. END ReadSymbol;
  898.  
  899.  
  900.  
  901.  
  902.  
  903. PROCEDURE ReadAheadSymbol ( VAR  symbol        : STRING;
  904.                             VAR  SymbolClass   : SymbolType );
  905.  VAR     LiteralCorrect :  BOOLEAN;  
  906. BEGIN
  907.         ahead := TRUE;
  908.         SymbolSetGlobal  ( LiteralCorrect );
  909.         ReadInSymbol     ( symbol, SymbolClass, LiteralCorrect ); 
  910.         SymbolReadGlobal ();
  911. END ReadAheadSymbol;
  912.  
  913.  
  914.  
  915. (*
  916.   ---------------------------------------------------------------------------
  917.                                     File Output.
  918. *)
  919. PROCEDURE write ( ch : CHAR ) ;
  920. BEGIN
  921.     IF OutName[0]<>0C THEN
  922.          WriteChar ( OutFile, ch );
  923.      IF DebugOutput THEN WriteString ( ch ); END;
  924.          IF OutFile.res <> done THEN
  925.              IF OutFile.res = nomemory THEN
  926.                    FatalError ( OutOfMemory  );
  927.              ELSE
  928.                    FatalError ( FileError );
  929.              END;
  930.          END;  
  931.      END;
  932. END write;
  933.  
  934. BEGIN
  935.    InName[0]     :=  0C;
  936.    OutName[0]    :=  0C;
  937.    DebugOutput   :=  FALSE;
  938. END scan.
  939.