Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
  • 3 commits
  • 4 files changed
  • 0 comments
  • 1 contributor
27  SPC.pas
... ...
@@ -0,0 +1,27 @@
  1
+PROGRAM SPC;
  2
+
  3
+	Var debugmode: boolean;
  4
+
  5
+{$include 'scanner.pas';}
  6
+{$include 'parser.pas';}
  7
+ 
  8
+
  9
+	BEGIN
  10
+		debugmode := true;
  11
+
  12
+	    scannerInit();
  13
+	    parserInit();
  14
+
  15
+
  16
+    if ParamCount < 2 then
  17
+    begin
  18
+        writeln('Not enough parameters given. Usage: ' + ParamStr(0) + ' input.pas output.out');
  19
+        halt(1);
  20
+    end
  21
+    else begin
  22
+		(* scan( ParamStr(1), ParamStr(2) ) *)
  23
+		parse( ParamStr(1), ParamStr(2) );
  24
+    end;
  25
+
  26
+  END.
  27
+
27  ScanWrapper.pas
... ...
@@ -0,0 +1,27 @@
  1
+PROGRAM SPC;
  2
+
  3
+	Var debugmode: boolean;
  4
+
  5
+{$include 'scanner.pas';}
  6
+{$include 'parser.pas';}
  7
+ 
  8
+
  9
+	BEGIN
  10
+		debugmode := true;
  11
+
  12
+	    scannerInit();
  13
+	    parserInit();
  14
+
  15
+
  16
+    if ParamCount < 2 then
  17
+    begin
  18
+        writeln('Not enough parameters given. Usage: ' + ParamStr(0) + ' input.pas output.out');
  19
+        halt(1);
  20
+    end
  21
+    else begin
  22
+		scan( ParamStr(1), ParamStr(2) );
  23
+//		parse( ParamStr(1), ParamStr(2) );
  24
+    end;
  25
+
  26
+  END.
  27
+
947  parser.pas
... ...
@@ -0,0 +1,947 @@
  1
+	(***************************************************************)
  2
+	(* Beginn Parser *)
  3
+	
  4
+	function parseCodeBlock : longint; forward;
  5
+	function parseDeclaration : longint; forward;
  6
+  
  7
+	procedure parserErrorStr( errMsg : String);
  8
+	begin
  9
+		writeln( errMsg);
  10
+	end;
  11
+	procedure parserErrorInt( errCode : longint);
  12
+	begin
  13
+		writeln( errCode);
  14
+	end;
  15
+	
  16
+
  17
+	procedure parserDebugStr( msg: String);
  18
+	begin
  19
+		//writeln( msg);
  20
+	end;
  21
+	procedure parserDebugInt( code: longint);
  22
+	begin
  23
+		//writeln( code);
  24
+	end;
  25
+	procedure parserDebugStrInt( msg : String; code: longint);
  26
+	begin
  27
+		(*
  28
+		write( msg);
  29
+		write( ' ');
  30
+		write( code);
  31
+		writeln( );
  32
+		*)
  33
+	end;
  34
+	
  35
+	
  36
+	
  37
+	function parseSymbol( s : longint) : longint;
  38
+		var symFound : longint; (* ob Symbol in case verarbeitet *)
  39
+	begin
  40
+		symFound := cFalse;
  41
+		getSymbol;
  42
+		if sym = s then begin
  43
+			parseSymbol := cTrue;
  44
+		end
  45
+		else begin
  46
+			if sym <> s then begin
  47
+				parseSymbol := cFalse;
  48
+				if s = cSemicolon then begin
  49
+					parserErrorStr( '91 121 Semicolon missing');
  50
+					symFound := cTrue;
  51
+				end;
  52
+				if s = cPeriod then begin
  53
+					parserErrorStr( '91 122 Period missing');
  54
+					symFound := cTrue;
  55
+				end;
  56
+				if s = cProgram then begin
  57
+					parserErrorStr( '91 123 PROGRAM missing');
  58
+					symFound := cTrue;
  59
+				end;
  60
+				if s = cUses then begin
  61
+					parserErrorStr( '91 124 USES missing');
  62
+					symFound := cTrue;
  63
+				end;
  64
+				if s = cType then begin
  65
+					parserErrorStr( '91 125 TYPE missing');
  66
+					symFound := cTrue;
  67
+				end;
  68
+				if symFound = cFalse then begin
  69
+					parserErrorStr( '91 139 Symbol missing');
  70
+					parserErrorInt( s);
  71
+				end;
  72
+			end;
  73
+		end;
  74
+	end;
  75
+	
  76
+	function parseIsSymbol( s : longint) : longint;
  77
+	begin
  78
+		peekSymbol;
  79
+		parseIsSymbol := cFalse;
  80
+		if sym = s then begin
  81
+			parseIsSymbol := cTrue;
  82
+		end;
  83
+	end;
  84
+
  85
+	(* Identifiers *)
  86
+	function parseIdentifier : longint;
  87
+		var ret : longint;
  88
+	begin
  89
+		getSymbol;
  90
+		if sym = cIdent then begin
  91
+			ret := cTrue;
  92
+		end
  93
+		else begin
  94
+			ret := cFalse;
  95
+		end;
  96
+		
  97
+		parseIdentifier := ret;
  98
+	end;
  99
+	
  100
+	function parsePgmIdentifier : longint;
  101
+		var ret : longint;
  102
+	begin
  103
+		ret := parseIdentifier;
  104
+		if ret = cFalse then begin
  105
+			parserErrorStr( '91 101 PgmIdentifier missing');
  106
+		end;
  107
+		parsePgmIdentifier := ret;
  108
+	end;
  109
+	
  110
+	function parseUseIdentifier : longint;
  111
+		var ret : longint;
  112
+	begin
  113
+		ret := parseIdentifier;
  114
+		if ret = cFalse then begin
  115
+			parserErrorStr( '91 103 UseIdentifier missing');
  116
+		end;
  117
+		parseUseIdentifier := ret;
  118
+	end;
  119
+	
  120
+	function parseUnitIdentifier : longint;
  121
+		var ret : longint;
  122
+	begin
  123
+		ret := parseIdentifier;
  124
+		if ret = cFalse then begin
  125
+			parserErrorStr( '91 103 UseIdentifier missing');
  126
+		end;
  127
+		parseUnitIdentifier := ret;
  128
+	end;
  129
+	
  130
+	function parseVarIdentifier : longint;
  131
+		var ret : longint;
  132
+	begin
  133
+
  134
+		ret := parseIdentifier;
  135
+		if ret = cFalse then begin
  136
+			parserErrorStr( '91 105 VarIdentifier missing');
  137
+		end;
  138
+		parseVarIdentifier := ret;
  139
+
  140
+	end;
  141
+	
  142
+	function parseTypeIdentifier : longint;
  143
+		var ret : longint;
  144
+	begin
  145
+		ret := parseIdentifier;
  146
+		if ret = cFalse then begin
  147
+			parserErrorStr( '91 107 TypeIdentifier missing');
  148
+		end;
  149
+		parseTypeIdentifier := ret;
  150
+	end;
  151
+	
  152
+	function parseProcIdentifier : longint;
  153
+		var ret : longint;
  154
+	begin
  155
+		ret := parseIdentifier;
  156
+		if ret = cFalse then begin
  157
+			parserErrorStr( '91 109 ProcIdentifier missing');
  158
+		end;
  159
+		parseProcIdentifier := ret;
  160
+	end;
  161
+	
  162
+	function parseFuncIdentifier : longint;
  163
+		var ret : longint;
  164
+	begin
  165
+		ret := parseIdentifier;
  166
+		if ret = cFalse then begin
  167
+			parserErrorStr( '91 111 FuncIdentifier missing');
  168
+		end;
  169
+		parseFuncIdentifier := ret;
  170
+	end;
  171
+	
  172
+	
  173
+
  174
+		
  175
+	
  176
+	
  177
+	function parseDefParameters : longint;
  178
+		var ret : longint;
  179
+		var again : longint;
  180
+		var bTry : longint;
  181
+		var bParse : longint;
  182
+	begin
  183
+		parserDebugStr( 'parseDefParameters');
  184
+		ret := parseIsSymbol( cLParen);
  185
+		
  186
+		if ret = cTrue then begin
  187
+			getSymbol; // ist '('
  188
+			
  189
+			
  190
+			
  191
+			ret := parseDeclaration;
  192
+			
  193
+			bTry := parseIsSymbol( cSemicolon); 
  194
+			again := bTry;
  195
+			while (again = cTrue) do begin
  196
+				if bTry = cTrue then begin
  197
+					bParse := parseSymbol( cSemicolon);
  198
+					if bParse = cTrue then begin
  199
+						bParse := parseDeclaration;
  200
+					end;
  201
+				end;
  202
+				if bParse = cTrue then begin
  203
+					bTry := parseIsSymbol( cSemicolon);
  204
+					again := bTry;
  205
+				end
  206
+				else begin
  207
+					again := cFalse;
  208
+				end;
  209
+			end;
  210
+		
  211
+			if bTry = cFalse then begin
  212
+				ret := cTrue;
  213
+			end
  214
+			else begin
  215
+				ret := bParse;
  216
+			end;
  217
+			
  218
+			if ret = cTrue then begin
  219
+				ret := parseSymbol( cRParen); 
  220
+			end	
  221
+		end
  222
+		
  223
+		else begin
  224
+			ret := cTrue;
  225
+		end;
  226
+		
  227
+		parserDebugStrInt( 'parseDefParameters', ret);
  228
+		parseDefParameters := ret;
  229
+	end;
  230
+	
  231
+	function parseType : longint;
  232
+		var ret : longint;
  233
+	begin
  234
+		getSymbol;
  235
+		ret := cTrue;
  236
+		parseType := ret;
  237
+	end;
  238
+	
  239
+	
  240
+	
  241
+	function parseDeclaration : longint;
  242
+		var ret : longint;
  243
+	begin
  244
+		parserDebugStr( 'parseDeclaration');
  245
+		ret := parseVarIdentifier;
  246
+		write( ' *** VAR ', id);
  247
+		
  248
+		if ret = cTrue then begin
  249
+			ret := parseSymbol( cColon);
  250
+		end;
  251
+		
  252
+		if ret = cTrue then begin
  253
+			ret := parseType;
  254
+			writeln( ' ', id);
  255
+		end;
  256
+		
  257
+		parserDebugStrInt( 'parseDeclaration', ret);
  258
+		parseDeclaration := ret;
  259
+	end;
  260
+	
  261
+	
  262
+	function parseRecordType : longint;
  263
+		var ret : longint;
  264
+		var again : longint;
  265
+		var bTry : longint;
  266
+		var bParse : longint;
  267
+	begin
  268
+		parserDebugStr( 'parseRecordType');
  269
+		ret := parseSymbol( cRecord);
  270
+		
  271
+		if ret = cTrue then begin
  272
+			ret := parseDeclaration;
  273
+		end;
  274
+
  275
+		bTry := parseIsSymbol( cSemicolon); 
  276
+		again := bTry;
  277
+		while (again = cTrue) do begin
  278
+			if bTry = cTrue then begin
  279
+				bParse := parseSymbol( cSemicolon);
  280
+				if bParse = cTrue then begin
  281
+					bParse := parseDeclaration;
  282
+				end;
  283
+			end;
  284
+			if bParse = cTrue then begin
  285
+				bTry := parseIsSymbol( cSemicolon);
  286
+				again := bTry;
  287
+			end
  288
+			else begin
  289
+				again := cFalse;
  290
+			end;
  291
+		end;
  292
+		
  293
+		if bTry = cFalse then begin
  294
+			ret := cTrue;
  295
+		end
  296
+		else begin
  297
+			ret := bParse;
  298
+		end;
  299
+		
  300
+		if ret = cTrue then begin
  301
+			ret := parseSymbol( cEnd); 
  302
+		end;
  303
+		
  304
+		if ret = cTrue then begin
  305
+			ret := parseSymbol( cSemicolon); 
  306
+		end;
  307
+		
  308
+		parserDebugStrInt( 'parseRecordType', ret);
  309
+		parseRecordType := ret;
  310
+	end;
  311
+
  312
+
  313
+
  314
+
  315
+
  316
+	
  317
+	
  318
+	
  319
+	
  320
+	function parseProcCallTry : longint;
  321
+		var ret : longint;
  322
+	begin
  323
+		parserDebugStr( 'parseProcCallTry');
  324
+		ret := cFalse;
  325
+		
  326
+		parserDebugStrInt( 'parseProcCallTry', ret);
  327
+		parseProcCallTry := ret;
  328
+	end;
  329
+	
  330
+	function parseProcCall : longint;
  331
+		var ret : longint;
  332
+	begin
  333
+		ret := cFalse;
  334
+		
  335
+		parseProcCall := ret;
  336
+	end;
  337
+
  338
+
  339
+	function parseWhileStatementTry : longint;
  340
+		var ret : longint;
  341
+	begin
  342
+		parserDebugStr( 'parseWhileStatementTry');
  343
+		ret := parseIsSymbol( cWhile);
  344
+		
  345
+		parserDebugStrInt( 'parseWhileStatementTry', ret);
  346
+		parseWhileStatementTry := ret;
  347
+	end;
  348
+	
  349
+	function parseWhileStatement : longint;
  350
+		var ret : longint;
  351
+	begin
  352
+		ret := parseSymbol( cWhile);
  353
+		
  354
+		if ret = cTrue then begin
  355
+			ret := parseSymbol( cDo);
  356
+		end;
  357
+		
  358
+		if ret = cTrue then begin
  359
+			ret := parseCodeBlock;
  360
+		end;
  361
+		
  362
+		if ret = cTrue then begin
  363
+			ret := parseSymbol( cSemicolon);
  364
+		end;
  365
+		
  366
+		parseWhileStatement := ret;
  367
+	end;
  368
+	
  369
+
  370
+	function parseIfStatementTry : longint;
  371
+		var ret : longint;
  372
+	begin
  373
+		parserDebugStr( 'parseIfStatementTry');
  374
+		ret := parseIsSymbol( cIf);
  375
+		
  376
+		parserDebugStrInt( 'parseIfStatementTry', ret);
  377
+		parseIfStatementTry := ret;
  378
+	end;
  379
+	
  380
+	function parseIfStatement : longint;
  381
+		var ret : longint;
  382
+	begin
  383
+		ret := parseSymbol( cIf);
  384
+		
  385
+		if ret = cTrue then begin
  386
+			ret := parseSymbol( cThen);
  387
+		end;
  388
+		
  389
+		if ret = cTrue then begin
  390
+			ret := parseCodeBlock;
  391
+		end;
  392
+		
  393
+		if ret = cTrue then begin
  394
+			ret := parseSymbol( cSemicolon);
  395
+		end;
  396
+		
  397
+		parseIfStatement := ret;
  398
+	end;
  399
+
  400
+
  401
+	function parseSimpleStatementTry : longint;
  402
+		var ret : longint;
  403
+	begin
  404
+		parserDebugStr( 'parseSimpleStatementTry');
  405
+		ret := cFalse;
  406
+		
  407
+		parserDebugStrInt( 'parseSimpleStatementTry', ret);
  408
+		parseSimpleStatementTry := ret;
  409
+	end;
  410
+	
  411
+	function parseSimpleStatement : longint;
  412
+		var ret : longint;
  413
+	begin
  414
+		ret := cFalse;
  415
+		
  416
+		parseSimpleStatement := ret;
  417
+	end;
  418
+
  419
+
  420
+	function parseStatementTry : longint;
  421
+		var ret : longint;
  422
+	begin
  423
+		parserDebugStr( 'parseStatementTry');
  424
+		ret := parseSimpleStatementTry;
  425
+		
  426
+		if ret = cFalse then begin
  427
+			ret := parseIfStatementTry;
  428
+		end;
  429
+		
  430
+		if ret = cFalse then begin
  431
+			ret := parseWhileStatementTry;
  432
+		end;
  433
+		
  434
+		if ret = cFalse then begin
  435
+			ret := parseProcCallTry;
  436
+		end;
  437
+		
  438
+		parserDebugStrInt( 'parseStatementTry', ret);
  439
+		parseStatementTry := ret;
  440
+	end;
  441
+	
  442
+	function parseStatement : longint;
  443
+		var ret : longint;
  444
+		var bTry : longint;
  445
+	begin
  446
+		parserDebugStr( 'parseStatement');
  447
+		ret := cTrue;
  448
+		bTry := parseSimpleStatementTry;
  449
+		if bTry = cTrue then begin
  450
+			ret := parseSimpleStatement;
  451
+		end
  452
+		else begin
  453
+			bTry := parseIfStatementTry;
  454
+			if bTry = cTrue then begin
  455
+				ret := parseIfStatement;
  456
+			end
  457
+			else begin
  458
+				bTry := parseWhileStatementTry;
  459
+				if bTry = cTrue then begin
  460
+					ret := parseWhileStatement;
  461
+				end
  462
+				else begin
  463
+					bTry := parseProcCallTry;
  464
+					if bTry = cTrue then begin
  465
+						ret := parseProcCall;
  466
+					end
  467
+					else begin
  468
+						parserErrorStr( 'parseStatement');
  469
+						ret := cFalse;
  470
+					end;
  471
+				end;
  472
+			end;
  473
+		end;
  474
+		
  475
+		parserDebugStrInt( 'parseStatement', ret);
  476
+		parseStatement := ret;
  477
+	end;
  478
+	
  479
+	
  480
+	function parseStatements : longint;
  481
+		var ret : longint;
  482
+		var again : longint;
  483
+		var bTry : longint;
  484
+		var bParse : longint;
  485
+	begin
  486
+		parserDebugStr( 'parseStatements');
  487
+		bTry := parseStatementTry; 
  488
+		again := bTry;
  489
+		while (again = cTrue) do begin
  490
+			if bTry = cTrue then begin
  491
+				bParse := parseStatement;
  492
+			end;
  493
+			if bParse = cTrue then begin
  494
+				bTry := parseStatementTry;
  495
+				again := bTry;
  496
+			end
  497
+			else begin
  498
+				again := cFalse;
  499
+			end;
  500
+		end;
  501
+		if bTry = cFalse then begin
  502
+			ret := cTrue;
  503
+		end
  504
+		else begin
  505
+			ret := bParse;
  506
+		end;
  507
+		
  508
+		parserDebugStrInt( 'parseStatements', ret);
  509
+		parseStatements := ret;
  510
+	end;
  511
+
  512
+	
  513
+	function parseCodeBlock : longint;
  514
+		var ret : longint;
  515
+	begin
  516
+		parserDebugStr( 'parseCodeBlock');
  517
+		ret := parseSymbol( cBegin);
  518
+		
  519
+		if ret = cTrue then begin
  520
+			ret := parseStatements;
  521
+		end;
  522
+		
  523
+		if ret = cTrue then begin
  524
+			ret := parseSymbol( cEnd); 
  525
+		end;
  526
+		
  527
+		parseCodeBlock := ret;
  528
+		parserDebugStrInt( 'parseCodeBlock', ret);
  529
+	end;
  530
+	
  531
+		
  532
+	function parseTypeDeclarationTry : longint;
  533
+		var ret : longint;
  534
+	begin
  535
+		parserDebugStr( 'parseTypeDeclarationTry');
  536
+		ret := parseIsSymbol( cType);
  537
+		
  538
+		parserDebugStrInt( 'parseTypeDeclarationTry', ret);
  539
+		parseTypeDeclarationTry := ret;
  540
+	end;
  541
+	
  542
+	function parseTypeDeclaration : longint;
  543
+		var ret : longint;
  544
+	begin
  545
+		ret := parseSymbol( cType);
  546
+		
  547
+		if ret = cTrue then begin
  548
+			ret := parseTypeIdentifier;
  549
+		end;
  550
+		
  551
+		if ret = cTrue then begin
  552
+			ret := parseSymbol( cEql);
  553
+		end;
  554
+		
  555
+		if ret = cTrue then begin
  556
+			ret := parseRecordType;
  557
+		end;
  558
+		
  559
+		parseTypeDeclaration := ret;
  560
+	end;
  561
+	
  562
+	
  563
+	function parseVarDeclarationTry : longint;
  564
+		var ret : longint;
  565
+	begin
  566
+		parserDebugStr( 'parseVarDeclarationTry');
  567
+		ret := parseIsSymbol( cVar);
  568
+		
  569
+		parserDebugStrInt( 'parseVarDeclarationTry', ret);
  570
+		parseVarDeclarationTry := ret;
  571
+	end;
  572
+	
  573
+	function parseVarDeclaration : longint;
  574
+		var ret : longint;
  575
+	begin
  576
+		ret := parseSymbol( cVar);
  577
+		
  578
+		if ret = cTrue then begin
  579
+			ret := parseDeclaration;
  580
+		end;
  581
+		
  582
+		if ret = cTrue then begin
  583
+			ret := parseSymbol( cSemicolon);
  584
+		end;
  585
+		
  586
+		parseVarDeclaration := ret;
  587
+	end;
  588
+	
  589
+	
  590
+	function parseVarDeclarations : longint;
  591
+		var ret : longint;
  592
+		var again : longint;
  593
+		var bTry : longint;
  594
+		var bParse : longint;
  595
+	begin
  596
+		bTry := parseVarDeclarationTry; 
  597
+		again := bTry;
  598
+		while (again = cTrue) do begin
  599
+			if bTry = cTrue then begin
  600
+				bParse := parseVarDeclaration;
  601
+			end;
  602
+			if bParse = cTrue then begin
  603
+				bTry := parseVarDeclarationTry; 
  604
+				again := bTry;
  605
+			end
  606
+			else begin
  607
+				again := cFalse;
  608
+			end;
  609
+		end;
  610
+		if bTry = cFalse then begin
  611
+			ret := cTrue;
  612
+		end
  613
+		else begin
  614
+			ret := bParse;
  615
+		end;
  616
+		
  617
+		parseVarDeclarations := ret;
  618
+	end;
  619
+	
  620
+
  621
+	function parseFuncHeading : longint;
  622
+		var ret : longint;
  623
+	begin	
  624
+		ret := parseSymbol( cFunction);
  625
+		
  626
+		if ret = cTrue then begin
  627
+			ret := parseFuncIdentifier;
  628
+		end;
  629
+		
  630
+		if ret = cTrue then begin
  631
+			ret := parseDefParameters; 
  632
+		end;
  633
+		
  634
+		if ret = cTrue then begin
  635
+			ret := parseSymbol( cColon); 
  636
+		end;
  637
+		
  638
+		if ret = cTrue then begin
  639
+			ret := parseType; 
  640
+		end;
  641
+		
  642
+		if ret = cTrue then begin
  643
+			ret := parseSymbol( cSemicolon); 
  644
+		end;
  645
+		
  646
+		parseFuncHeading := ret;
  647
+	end;
  648
+	
  649
+	
  650
+	function parseFuncDeclarationTry : longint;
  651
+		var ret : longint;
  652
+	begin
  653
+		parserDebugStr( 'parseFuncDeclarationTry');
  654
+		ret := parseIsSymbol( cFunction);
  655
+		
  656
+		parserDebugStrInt( 'parseFuncDeclarationTry', ret);
  657
+		parseFuncDeclarationTry := ret;
  658
+	end;
  659
+	
  660
+	function parseFuncDeclaration : longint;
  661
+		var ret : longint;
  662
+	begin
  663
+		ret := parseFuncHeading;
  664
+		
  665
+		if ret = cTrue then begin
  666
+			ret := parseVarDeclarations;
  667
+		end;
  668
+		
  669
+		if ret = cTrue then begin
  670
+			ret := parseCodeBlock;
  671
+		end;
  672
+		
  673
+		if ret = cTrue then begin
  674
+			ret := parseSymbol( cSemicolon);
  675
+		end;
  676
+		
  677
+		parseFuncDeclaration := ret;
  678
+	end;
  679
+
  680
+
  681
+	
  682
+	function parseProcHeading : longint;
  683
+		var ret : longint;
  684
+	begin
  685
+		parserDebugStr( 'parseProcHeading');
  686
+		ret := parseSymbol( cProcedure);
  687
+		
  688
+		if ret = cTrue then begin
  689
+			ret := parseProcIdentifier;
  690
+		end;
  691
+		
  692
+		if ret = cTrue then begin
  693
+			ret := parseDefParameters; 
  694
+		end;
  695
+		
  696
+		if ret = cTrue then begin
  697
+			ret := parseSymbol( cSemicolon); 
  698
+		end;
  699
+		
  700
+		parserDebugStrInt( 'parseProcHeading', ret);
  701
+		parseProcHeading := ret;
  702
+	end;
  703
+	
  704
+	
  705
+	function parseProcDeclarationTry : longint;
  706
+		var ret : longint;
  707
+	begin
  708
+		parserDebugStr( 'parseProcDeclarationTry');
  709
+		ret := parseIsSymbol( cProcedure);
  710
+		
  711
+		parserDebugStrInt( 'parseProcDeclarationTry', ret);
  712
+		parseProcDeclarationTry := ret;
  713
+	end;
  714
+	
  715
+	function parseProcDeclaration : longint;
  716
+		var ret : longint;
  717
+	begin
  718
+		parserDebugStr( 'parseProcDeclaration');
  719
+		ret := parseProcHeading;
  720
+		
  721
+		if ret = cTrue then begin
  722
+			ret := parseVarDeclarations;
  723
+		end;
  724
+		
  725
+		if ret = cTrue then begin
  726
+			ret := parseCodeBlock;
  727
+		end;
  728
+		
  729
+		if ret = cTrue then begin
  730
+			ret := parseSymbol( cSemicolon);
  731
+		end;
  732
+		
  733
+		parserDebugStrInt( 'parseProcDeclaration', ret);
  734
+		parseProcDeclaration := ret;
  735
+	end;
  736
+	
  737
+	
  738
+	function parsePgmDeclarationTry : longint;
  739
+		var ret : longint;
  740
+	begin
  741
+		parserDebugStr( 'parsePgmDeclarationTry');
  742
+		ret := parseVarDeclarationTry;
  743
+		
  744
+		if ret = cFalse then begin
  745
+			ret := parseTypeDeclarationTry;
  746
+		end;
  747
+		
  748
+		if ret = cFalse then begin
  749
+			ret := parseProcDeclarationTry;
  750
+		end;
  751
+		
  752
+		if ret = cFalse then begin
  753
+			ret := parseFuncDeclarationTry;
  754
+		end;
  755
+		
  756
+		parserDebugStrInt( 'parsePgmDeclarationTry', ret);
  757
+		parsePgmDeclarationTry := ret;
  758
+	end;
  759
+	
  760
+	function parsePgmDeclaration : longint;
  761
+		var ret : longint;
  762
+		var bTry : longint;
  763
+	begin
  764
+		parserDebugStr( 'parsePgmDeclaration');
  765
+		ret := cTrue;
  766
+		bTry := parseVarDeclarationTry;
  767
+		if bTry = cTrue then begin
  768
+			ret := parseVarDeclaration;
  769
+		end
  770
+		else begin
  771
+			bTry := parseTypeDeclarationTry;
  772
+			if bTry = cTrue then begin
  773
+				ret := parseTypeDeclaration;
  774
+			end
  775
+			else begin
  776
+				bTry := parseProcDeclarationTry;
  777
+				if bTry = cTrue then begin
  778
+					ret := parseProcDeclaration;
  779
+				end
  780
+				else begin
  781
+					bTry := parseFuncDeclarationTry;
  782
+					if bTry = cTrue then begin
  783
+						ret := parseFuncDeclaration;
  784
+					end
  785
+					else begin
  786
+						parserErrorStr( 'parsePgmDeclaration');
  787
+						ret := cFalse;
  788
+					end;
  789
+				end;
  790
+			end;
  791
+		end;
  792
+		
  793
+		parserDebugStrInt( 'parsePgmDeclaration', ret);
  794
+		parsePgmDeclaration := ret;
  795
+	end;
  796
+	
  797
+	
  798
+	function parsePgmDeclarations : longint;
  799
+		var ret : longint;
  800
+		var again : longint;
  801
+		var bTry : longint;
  802
+		var bParse : longint;
  803
+	begin
  804
+		parserDebugStr( 'parsePgmDeclarations');
  805
+		bTry := parsePgmDeclarationTry; 
  806
+		again := bTry;
  807
+		while (again = cTrue) do begin
  808
+			if bTry = cTrue then begin
  809
+				bParse := parsePgmDeclaration;
  810
+			end;
  811
+			if bParse = cTrue then begin
  812
+				(* procDeclaration is parsable *)
  813
+				bTry := parsePgmDeclarationTry;
  814
+				again := bTry;
  815
+			end
  816
+			else begin
  817
+				again := cFalse;
  818
+			end;
  819
+		end;
  820
+		if bTry = cFalse then begin
  821
+			ret := cTrue;
  822
+		end
  823
+		else begin
  824
+			ret := bParse;
  825
+		end;
  826
+		
  827
+		parserDebugStrInt( 'parsePgmDeclarations', ret);
  828
+		parsePgmDeclarations := ret;
  829
+	end;
  830
+	
  831
+	
  832
+	function parsePgmHeading : longint;
  833
+		var ret : longint;
  834
+	begin
  835
+		parserDebugStr( 'parsePgmHeading');
  836
+		ret := parseSymbol( cProgram);
  837
+		
  838
+		if ret = cTrue then begin
  839
+			ret := parsePgmIdentifier;
  840
+		end;
  841
+		
  842
+		if ret = cTrue then begin
  843
+			ret := parseSymbol( cSemicolon); 
  844
+		end;
  845
+		
  846
+		parsePgmHeading := ret;
  847
+		parserDebugStrInt( 'parsePgmHeading', ret);
  848
+	end;
  849
+	
  850
+	(*
  851
+	function parsePgmUsesTry : longint;
  852
+		var ret : longint;
  853
+	begin
  854
+		ret := parseIsSymbol( cUses);
  855
+		parsePgmUsesTry := ret;
  856
+	end;
  857
+	
  858
+	function parsePgmUses : longint;
  859
+		var ret : longint;
  860
+		var again : longint;
  861
+		var bTry : longint;
  862
+		var bParse : longint;
  863
+	begin
  864
+		ret := parseSymbol( cUses);
  865
+		
  866
+		if ret = cTrue then begin
  867
+			ret := parseUseIdentifier;
  868
+		end;
  869
+		
  870
+		bTry := parseIsSymbol( cComma); 
  871
+		again := bTry;
  872
+		while (again = cTrue) do begin
  873
+			if bTry = cTrue then begin
  874
+				bParse := parseSymbol( cComma);
  875
+				if bParse = cTrue then begin
  876
+					bParse := parseUseIdentifier;
  877
+				end;
  878
+			end;
  879
+			if bParse = cTrue then begin
  880
+				bTry := parseIsSymbol( cComma);;
  881
+				again := bTry;
  882
+			end
  883
+			else begin
  884
+				again := cFalse;
  885
+			end;
  886
+		end;
  887
+		if bTry = cFalse then begin
  888
+			ret := cTrue;
  889
+		end
  890
+		else begin
  891
+			ret := bParse;
  892
+		end;
  893
+		
  894
+		parsePgmUses := ret;
  895
+	end;
  896
+	*)
  897
+	
  898
+	function parsePgm : longint;
  899
+		var ret : longint;
  900
+		(*var pgmUsesTry : longint;*)
  901
+	begin
  902
+		ret := parsePgmHeading;
  903
+		
  904
+		(*
  905
+		if ret = cTrue then begin
  906
+			pgmUsesTry := parsePgmUsesTry;
  907
+			if pgmUsesTry = cTrue then begin
  908
+				ret := parsePgmUses;
  909
+			end;
  910
+		end;
  911
+		*)
  912
+		
  913
+		if ret = cTrue then begin
  914
+			ret := parsePgmDeclarations;
  915
+		end;
  916
+		
  917
+		if ret = cTrue then begin
  918
+			ret := parseCodeBlock;
  919
+		end;
  920
+		
  921
+		parsePgm := ret;
  922
+	end;
  923
+	
  924
+	
  925
+	PROCEDURE Parse( inputFile: String; outputFile: String );
  926
+	BEGIN
  927
+
  928
+		Assign( R, inputFile);
  929
+		Reset( R); NextChar;
  930
+
  931
+		Assign( W, outputFile);
  932
+		Rewrite( W);
  933
+		
  934
+		writeln( parsePgm);
  935
+		
  936
+		close( R); close( W);
  937
+	end;
  938
+
  939
+	(* end Parser *)
  940
+	(***************************************************************)
  941
+    Procedure ParserInit();
  942
+    Begin
  943
+        (* 
  944
+        All die Initialisierung, die auf jeden Fall ausgeführt werden muss am Anfang,
  945
+        damit der Parser benutzt werden kann. Egal ob für Testing oder Compiling.
  946
+        *)
  947
+    End;
568  scanner.pas
... ...
@@ -1,80 +1,87 @@
1  
-PROGRAM SPC;
2  
-
3 1
 	CONST
4  
-		debug = true;
5 2
 		(* größte Zahl, die im Source angegeben werden darf *)
6 3
 		cMaxNumber = 1000000;
7 4
 		(* weder letter noch digit, um Ende eines Keywords zu kennzeichnen *)
8 5
 		cChr0 = #0;
9  
-
10  
-		cIdLen = 16; (* maximale Länge von Schlüsselwörter und Variablen etc. *)
  6
+		cIdLen = 32; (* maximale Länge von Schlüsselwörter und Variablen etc. *)
11 7
 		cKWMaxNumber = 34; (* Anzahl der Key- Wörter *)
12 8
 		cStrLen = 1024; (* maximale Länge von Strings *)
13 9
 
14 10
 		(* symbols *)
15  
-		cNull = 0;
16  
-		cTimes = 1;
17  
-		cDiv = 3; 
18  
-		cMod = 4;
19  
-		cAnd = 5; 
20  
-		cPlus = 6; 
21  
-		cMinus = 7;
22  
-		cOr = 8;	
23  
-		cEql = 9; 
24  
-		cNeq = 10;
25  
-		cLss = 11; 
26  
-		cGeq = 12; 
27  
-		cLeq = 13; 
28  
-		cGtr = 14;
29  
-		cPeriod = 18; 
30  
-		cComma = 19; 
31  
-		cColon = 20;
32  
-		cRparen = 22; 
33  
-		cRbrak = 23; 
34  
-		cOf = 25;
35  
-		cThen = 26;
36  
-		cDo = 27;
37  
-		cLparen = 29;		
38  
-		cLbrak = 30;
39  
-		cNot = 32;
40  
-		cBecomes = 33;
41  
-		cNumber = 34;
42  
-		cIdent = 37;
43  
-		cSemicolon = 38;
44  
-		cEnd = 40;		
45  
-		cElse = 41; 
46  
-		cElsif = 42;
47  
-		cIf = 44; 
48  
-		cWhile = 46;
49  
-		cArray = 54;
50  
-		cRecord = 55;
51  
-		cConst = 57;
52  
-		cType = 58;
53  
-		cVar = 59;
54  
-		cProcedure = 60;
55  
-		cBegin = 61;
56  
-		cProgram = 62;
57  
-		cModule = 63;
58  
-		cEof = 64;
  11
+		cNull = 0; // Unknown
  12
+		cTimes = 1; // *
  13
+		cDiv = 3; // DIV
  14
+		cMod = 4;// MOD
  15
+		cAnd = 5; // &
  16
+		cPlus = 6; // +
  17
+		cMinus = 7; // -
  18
+		cOr = 8; // OR
  19
+		cEql = 9; // =
  20
+		cNeq = 10; // #
  21
+		cLss = 11; // <
  22
+		cGeq = 12; // >=
  23
+		cLeq = 13; // <=
  24
+		cGtr = 14; // >
  25
+		cPeriod = 18; // .
  26
+		cComma = 19; // ,
  27
+		cColon = 20; // :
  28
+		cRparen = 22; // )
  29
+		cRbrak = 23; // ]
  30
+		cOf = 25; // OF
  31
+		cThen = 26; // THEN
  32
+		cDo = 27; // DO
  33
+		cLparen = 29; // (
  34
+		cLbrak = 30; // [
  35
+		cNot = 32; // ~
  36
+		cBecomes = 33; // :=
  37
+		cNumber = 34; // decimal number
  38
+		cIdent = 37; // some identifier
  39
+		cSemicolon = 38; // ;
  40
+		cEnd = 40; // END
  41
+		cElse = 41; // ELSE
  42
+		cElsif = 42; // ELSIF
  43
+		cIf = 44; // IF
  44
+		cWhile = 46; // WHILE
  45
+		cArray = 54; // ARRAY
  46
+		cRecord = 55; // RECORD
  47
+		cConst = 57; // CONST
  48
+		cType = 58; // TYPE
  49
+		cVar = 59; // VAR
  50
+		cProcedure = 60; // PROCEDURE
  51
+		cBegin = 61; // BEGIN
  52
+		cProgram = 62; // PROGRAM
  53
+		cModule = 63; // MODULE
  54
+		cEof = 64; // EOF
  55
+		cFunction = 97;
59 56
 		cString = 98; (* Strings beginnen und enden mit ' *)
60  
-		cQuote = 99;
61  
-
  57
+		cUses = 96;
  58
+		cUnit = 95;
  59
+		cInterface = 94;
  60
+		cImplementation = 93;
  61
+		cForward = 92;
62 62
 
63 63
 	TYPE
64 64
 		tInt = LONGINT;
65 65
 		tStrId = ARRAY [0..cIdLen - 1] OF CHAR;
66  
-
  66
+		tStr = ARRAY [0..cStrLen - 1] OF CHAR;
67 67
 
68 68
 	VAR
69  
-		debugmode: boolean;
70  
-		sym: tInt;
  69
+		(* Konstanten *)
  70
+		cTrue : longint;
  71
+		cFalse : longint;
  72
+
71 73
 		lineNr: tInt;
72 74
 		colNr: Integer;
73  
-		val: tInt;
74  
-		id: tStrId;
75  
-		error: BOOLEAN;
76 75
 
77  
-		ch: CHAR;
  76
+		sym: tInt; (* speichert das nächste Symbol des Scanners *)
  77
+		val: tInt; (* wenn sym = cNumber, dann speichert val den longint- Wert *)
  78
+		id: tStrId; (* wenn sym = cIdent, dann speichert id den Identifier *)
  79
+		str: tStr; (* wenn sym = cString, dann speichert str den string- Wert *)
  80
+		(* error: BOOLEAN; *)
  81
+
  82
+		lastSymWasPeek : longint; (* cTrue, falls sym durch Aufruf peekSymbol *)
  83
+
  84
+		ch: CHAR; (* UCase *)
78 85
 		nKW: tInt;
79 86
 		(*errpos: LONGINT;*) (* never used *)
80 87
 		R: Text;
@@ -85,22 +92,24 @@
85 92
 				id: tStrId;
86 93
 			END;
87 94
 
88  
-
89  
-	PROCEDURE Mark(msg: STRING);
  95
+	(***************************************************
  96
+	* IO
  97
+	***************************************************)
  98
+	PROCEDURE NextChar();
90 99
 	BEGIN
91  
-	    Write('Hey! Error at Pos ');
92  
-	    Write(lineNr);
93  
-	    Write(':');
94  
-	    Write(colNr);
95  
-	    Write(', ');
96  
-	    Writeln(msg);
  100
+		Read(R, ch);
  101
+		colNr := colNr + 1;
  102
+		IF ch = '' THEN BEGIN lineNr := lineNr + 1; colNr := 1; END;
97 103
 	END;
98 104
 
99  
-	PROCEDURE Next;
  105
+	PROCEDURE Mark(msg: STRING);
100 106
 	BEGIN
101  
-	    Read( R, ch);
102  
-	    colNr := colNr + 1;
103  
-	    IF ch = '' THEN BEGIN lineNr := lineNr + 1; colNr := 1; END;
  107
+		Write('Hey! Error at Pos ');
  108
+		Write(lineNr);
  109
+		Write(':');
  110
+		Write(colNr);
  111
+		Write(', ');
  112
+		Writeln(msg);
104 113
 	END;
105 114
 
106 115
 	(* true, falls ch eine Ziffer *)
@@ -121,50 +130,70 @@
121 130
 		isLetterOrDigit := isLetter( ch) or isDigit( ch);
122 131
 	END;
123 132
 
  133
+	FUNCTION UCase(c: CHAR) : CHAR;
  134
+	BEGIN
  135
+		IF( (c >= 'a') AND ( c <= 'z')) THEN
  136
+			UCase := chr( ord('A') + ord(c) - ord('a'))
  137
+		ELSE
  138
+			UCase := c;
  139
+	END;
  140
+
  141
+	(* true, falls beide ID's gleich sind *)
  142
+	(* nicht case sensitiv *)
  143
+	FUNCTION isEquStrId( id1: tStrId; id2: tStrId): BOOLEAN;
  144
+		VAR i: tInt;
  145
+		equal: BOOLEAN;
  146
+	BEGIN
  147
+		equal := TRUE; i := 1;
  148
+		WHILE isLetterOrDigit( id1[i]) AND equal DO
  149
+		BEGIN
  150
+			equal := ( UCase(id1[i]) = UCASE(id2[i]));
  151
+			i := i + 1;
  152
+		END;
  153
+
  154
+		equal := equal AND ( NOT isLetterOrDigit(id2[i]));
  155
+		isEquStrId := equal;
  156
+	END;
124 157
 
125 158
 	(* druckt ID aus *)
126 159
 	PROCEDURE printId(str: tStrId);
127  
-	VAR i: tInt;
  160
+		VAR i: tInt;
128 161
 	BEGIN
129 162
 		i := 0;
130 163
 		(* WHILE isLetterOrDigit( str[i]) DO *)
131  
-		WHILE NOT ( str[i] = cChr0 ) DO
  164
+		while not ( str[i] = cChr0 ) DO
132 165
 		BEGIN
133 166
 			WRITE( W, str[i]);
134  
-			IF debugmode then
135  
-			BEGIN
136  
-				WRITE( str[i]);
137  
-			END;
  167
+			if debugmode then WRITE( str[i]);
138 168
 			i := i + 1;
139 169
 		END;
140 170
 		writeln( W);
141 171
 		IF debugmode then writeln;
142 172
 	END;
143 173
 
144  
-	(* true, falls beide ID's gleich sind *)
145  
-	FUNCTION isEquStrId( id1: tStrId; id2: tStrId): BOOLEAN;
146  
-	VAR i: tInt;
147  
-		equal: BOOLEAN;
  174
+	(* druckt ID aus *)
  175
+	PROCEDURE printStr(str: tStr);
  176
+		VAR i: tInt;
148 177
 	BEGIN
149  
-		equal := TRUE; i := 1;
150  
-		WHILE isLetterOrDigit( id1[i]) AND equal DO
  178
+		i := 0;
  179
+		(* WHILE isLetterOrDigit( str[i]) DO *)
  180
+		while not ( str[i] = cChr0 ) DO
151 181
 		BEGIN
152  
-			equal := ( id1[i] = id2[i]);
  182
+			WRITE( W, str[i]);
  183
+			if debugmode then WRITE( str[i]);
153 184
 			i := i + 1;
154 185
 		END;
155  
-
156  
-		equal := equal AND ( NOT isLetterOrDigit(id2[i]));
157  
-		isEquStrId := equal;
  186
+		writeln( W);
158 187
 	END;
159 188
 
160  
-
161 189
 	(* Liefert das nächste Symbol aus der Input- Datei *)
162  
-	PROCEDURE getSymbol(VAR sym: tInt);
  190
+	(* PROCEDURE getSym(VAR sym: tInt); *)
  191
+	PROCEDURE getSymSub();forward;
163 192
 
164 193
 	(* falls beim Lesen erkannt wurde, dass es sich um ein Symbol handelt *)
165 194
 	(* z.B. Keyword oder Variable *)
166 195
 	PROCEDURE Ident;
167  
-	VAR i, k: tInt;
  196
+		VAR i, k: tInt;
168 197
 	BEGIN
169 198
 		i := 0;
170 199
 		REPEAT
@@ -173,46 +202,47 @@
173 202
 				id[i] := ch;
174 203
 				i := i + 1; (* INC(i); *)
175 204
 			END;
176  
-			Next;
  205
+			NextChar;
177 206
 
178 207
 		(* ??? UNTIL (ch < '0') OR (ch > '9') AND (CAP(ch) < 'A') OR (CAP(ch) > 'Z'); *)
179 208
 		UNTIL ( NOT isLetterOrDigit( ch));
180  
-			id[i] := cChr0;
181  
-			k := 0;
  209
+
  210
+		id[i] := cChr0;
  211
+		k := 0;
182 212
 
183 213
 		WHILE (k < nKW) AND (NOT isEquStrId(id, KWs[k].id)) DO
184 214
 		BEGIN
185 215
 			k := k + 1; (* INC(k); *)
186 216
 		END;
187 217
 
188  
-		IF k < nKW THEN sym := KWs[k].sym
189  
-		ELSE BEGIN sym := cIdent; END
190  
-		END;
  218
+		IF k < nKW THEN	sym := KWs[k].sym
  219
+		ELSE BEGIN sym := cIdent;	END
  220
+	END;
191 221
 
192 222
 	(* falls beim Lesen erkannt wurde, dass es sich um ein String handelt *)
193  
-    PROCEDURE getString;
194  
-    VAR	i : tInt;
195  
-    BEGIN
  223
+	PROCEDURE getString;
  224
+		var i: tInt;
  225
+	BEGIN
196 226
 		(* komsumiere "'" am Anfang *)
197  
-		Next;
  227
+		NextChar;
198 228
 		i := 0;
199 229
 		REPEAT
200 230
 			IF i < cStrLen THEN
201 231
 			BEGIN
202  
-				id[i] := ch;
  232
+				str[i] := ch;
203 233
 				i := i + 1; (* INC(i); *)
204  
-				IF ch = '''' then
205  
-				BEGIN
206  
-					Next;
207  
-				END;
  234
+				if ch = '''' then
  235
+				begin
  236
+					NextChar;
  237
+				end;
208 238
 			END;
209  
-			Next;
  239
+			NextChar;
210 240
 
211 241
 		(* ??? UNTIL (ch < '0') OR (ch > '9') AND (CAP(ch) < 'A') OR (CAP(ch) > 'Z'); *)
212 242
 		UNTIL ( ch = '''' );
213  
-			id[i] := cChr0;
214  
-			sym := cString;
215  
-			Next;
  243
+		str[i] := cChr0;
  244
+		sym := cString;
  245
+		NextChar;
216 246
 	END;
217 247
 
218 248
 	(* falls beim Lesen erkannt wurde, dass es sich um eine Zahl handelt *)
@@ -228,117 +258,146 @@
228 258
 				Mark( 'number too large');
229 259
 				val := 0
230 260
 			END ;
231  
-			Next;
  261
+			NextChar;
232 262
 		UNTIL ( NOT IsDigit(ch))
233 263
 	END;
234 264
 
235 265
 	(* falls beim Lesen erkannt wurde, dass es sich um einen Kommentar handelt *)
236  
-	PROCEDURE comment;
  266
+	Procedure comment;
  267
+		var inComment: BOOLEAN;
237 268
 	BEGIN
238  
-		Next;
239  
-		WHILE true DO
  269
+		inComment := TRUE;
  270
+		NextChar;
  271
+		WHILE inComment DO
240 272
 		BEGIN
241  
-			WHILE true DO
  273
+			if eof( R) THEN
242 274
 			BEGIN
243  
-			IF ch = '(' THEN
  275
+				Mark('ERROR: comment not terminated');
  276
+				EXIT
  277
+			END;
  278
+			IF( ch = '*') THEN
  279
+			BEGIN
  280
+				nextChar;
  281
+				if eof( R) THEN
244 282
 				BEGIN
245  
-				Next;
246  
-				IF ch = '*' THEN comment;
  283
+					Mark('ERROR: comment not terminated');
  284
+					EXIT
247 285
 				END;
248  
-				IF ch = '*' THEN BEGIN Next; EXIT END ;
249  
-
250  
-				IF eof( R) THEN EXIT;
251  
-				Next;
  286
+				inComment := (ch <> ')')
252 287
 			END;
253  
-
254  
-			IF ch = ')' THEN BEGIN Next; EXIT END ;
255  
-
256  
-			IF eof( R) THEN
257  
-			BEGIN
258  
-				Mark('comment not terminated');
259  
-				EXIT
260  
-			END
  288
+			nextChar;
261 289
 		END;
262 290
 	END;
263 291
 
264  
-
  292
+	(* Liefert das nächste Symbol aus der Input- Datei *)
  293
+	(* PROCEDURE getSym(VAR sym: tInt); *)
  294
+	PROCEDURE getSymSub;
265 295
 	BEGIN
266 296
 		(* WHILE ~R.eof & (ch <= " ") DO Texts.Read(R, ch) END; *)
267  
-		WHILE NOT EOF( R) AND ( ch <= ' ') DO BEGIN Next; END;
  297
+		WHILE NOT EOF( R) AND ( ch <= ' ') DO BEGIN NextChar; END;
268 298
 
269  
-		(* IF R.eof THEN sym := eof *)
  299
+		(* IF R.eot THEN sym := eof *)
270 300
 		IF EOF( R) THEN sym := cEof
271  
-		ELSE IF ch = '&' THEN BEGIN Next; sym := cAnd END
272  
-		ELSE IF ch = '*' THEN BEGIN Next; sym := cTimes END
273  
-		ELSE IF ch = '+' THEN BEGIN Next; sym := cPlus END
274  
-		ELSE IF ch = '-' THEN BEGIN Next; sym := cMinus END
275  
-		ELSE IF ch = '=' THEN BEGIN Next; sym := cEql END
276  
-		ELSE IF ch = '#' THEN BEGIN Next; sym := cNeq END
277  
-		ELSE IF ch = '<' THEN 
278  
-						BEGIN
279  
-							Next;
280  
-							IF ch = '=' THEN
281  
-							BEGIN
282  
-								Next;
283  
-								sym := cLeq
284  
-							END
285  
-							ELSE sym := cLss;
286  
-						END
287  
-		ELSE IF ch = '>' THEN 
288  
-						BEGIN
289  
-							Next;
290  
-							IF ch = '=' THEN
291  
-							BEGIN
292  
-								Next;
293  
-								sym := cGeq
294  
-							END
295  
-							ELSE sym := cGtr
296  
-						END
297  
-
298  
-		ELSE IF ch = ';' THEN BEGIN Next; sym := cSemicolon END
299  
-		ELSE IF ch = ',' THEN BEGIN Next; sym := cComma END
300  
-		ELSE IF ch = ':' THEN 
301  
-						BEGIN
302  
-							Next;
303  
-							IF ch = '=' THEN
304  
-							BEGIN
305  
-								Next;
306  
-								sym := cBecomes
307  
-							END
308  
-							ELSE sym := cColon
309  
-						END
310  
-		ELSE IF ch = '.' THEN BEGIN Next; sym := cPeriod END
  301
+
  302
+		ELSE IF ch = '&' THEN BEGIN NextChar; sym := cAnd END
  303
+		ELSE IF ch = '*' THEN BEGIN NextChar; sym := cTimes END
  304
+		ELSE IF ch = '+' THEN BEGIN NextChar;; sym := cPlus END
  305
+		ELSE IF ch = '-' THEN BEGIN NextChar; sym := cMinus END
  306
+		ELSE IF ch = '=' THEN BEGIN NextChar; sym := cEql END
  307
+		ELSE IF ch = '#' THEN BEGIN NextChar; sym := cNeq END
  308
+		ELSE IF ch = '<' THEN BEGIN
  309
+				NextChar;
  310
+				IF ch = '=' THEN
  311
+				BEGIN
  312
+					NextChar;
  313
+					sym := cLeq
  314
+				END
  315
+				ELSE sym := cLss;
  316
+			END
  317
+		ELSE IF ch = '>' THEN BEGIN
  318
+				NextChar;
  319
+				IF ch = '=' THEN
  320
+				BEGIN
  321
+					NextChar;
  322
+					sym := cGeq;
  323
+				END
  324
+				ELSE sym := cGtr;
  325
+			END
  326
+		ELSE IF ch = ';' THEN BEGIN NextChar; sym := cSemicolon; END
  327
+		ELSE IF ch = ',' THEN BEGIN NextChar; sym := cComma; END
  328
+		ELSE IF ch = ':' THEN BEGIN
  329
+				NextChar;
  330
+				IF ch = '=' THEN
  331
+				BEGIN
  332
+					NextChar;
  333
+					sym := cBecomes;
  334
+				END
  335
+				ELSE sym := cColon;
  336
+			END
  337
+		ELSE IF ch = '.' THEN BEGIN NextChar; sym := cPeriod; END
311 338
 		ELSE IF ch = '(' THEN BEGIN
312  
-									Next;
313  
-									IF ch = '*' THEN
314  
-									BEGIN
315  
-										comment;
316  
-										getSymbol(sym);
317  
-									END
318  
-									ELSE sym := cLparen
319  
-									END
320  
-		ELSE IF ch = ')' THEN BEGIN Next; sym := cRparen END
321  
-		ELSE IF ch = '[' THEN BEGIN Next; sym := cLbrak END
322  
-		ELSE IF ch = ']' THEN BEGIN Next; sym := cRbrak END
323  
-		ELSE IF ch = '''' THEN getString (* es war mal.. Next; sym := cQuote END*)
324  
-		ELSE IF isDigit( ch) THEN Number
325  
-		ELSE IF isLetter( ch) THEN Ident
326  
-		ELSE IF ch = '~' THEN BEGIN Next; sym := cNot END
327  
-
328  
-		ELSE BEGIN
329  
-				Next;	
330  
-				sym := cNull
  339
+				NextChar;
  340
+				IF ch = '*' THEN
  341
+				BEGIN
  342
+					comment;
  343
+					getSymSub;
  344
+				END
  345
+				ELSE sym := cLparen
  346
+			END
  347
+		ELSE IF ch = ')' THEN BEGIN NextChar; sym := cRparen; END
  348
+		ELSE IF ch = '[' THEN BEGIN NextChar; sym := cLbrak; END
  349
+		ELSE IF ch = ']' THEN BEGIN NextChar; sym := cRbrak; END
  350
+		ELSE IF ch = '''' THEN Begin getString; END
  351
+		ELSE IF isDigit(  ch) THEN Begin Number; END
  352
+		ELSE IF isLetter( ch) THEN Begin Ident; END
  353
+		ELSE IF ch = '~' THEN BEGIN NextChar; sym := cNot END
  354
+		ELSE IF ch = '/' THEN
  355
+		BEGIN
  356
+			NextChar;
  357
+			IF ch = '/' THEN BEGIN
  358
+				REPEAT
  359
+					NextChar;
  360
+				UNTIL (ch <> #13);
  361
+//				getSymbol(sym);
  362
+			END
  363
+			ELSE
  364
+				Mark('Unrecognized "/"');
  365
+			END
  366
+		ELSE Begin
  367
+			Mark('Unrecognized Symbol "' + ch + '"');
  368
+			NextChar;
  369
+			sym := cNull
331 370
 		END;
332 371
 
333  
-
334 372
 	END;
335 373
 
336  
-	(*PROCEDURE Init*(T: Texts.Text; pos: LONGINT);
  374
+	procedure getSymbol;
  375
+	begin
  376
+		if lastSymWasPeek = cTrue then begin
  377
+			(* Symbol steht schon in sym, da letzter Aufruf peekSymbol *)
  378
+			lastSymWasPeek := cFalse; (* nächster Aufruf holt neues Symbol *)
  379
+		end
  380
+		else begin
  381
+			getSymSub;
  382
+		end;
  383
+	end;
  384
+
  385
+	procedure peekSymbol;
  386
+	begin
  387
+		if lastSymWasPeek = cFalse then begin
  388
+			getSymbol;
  389
+			lastSymWasPeek := cTrue;
  390
+		end;
  391
+	end;
  392
+
  393
+	(*
  394
+	PROCEDURE Init*(T: Texts.Text; pos: LONGINT);
337 395
 	BEGIN error := FALSE; errpos := pos; Texts.OpenReader(R, T, pos); Texts.Read(R, ch)
338  
-	END Init;* *)
  396
+	END Init;
  397
+	*)
339 398
 
340 399
 	PROCEDURE copyKW( fromString: tStrID; VAR id: tStrID);
341  
-	VAR i : tInt;
  400
+		VAR i : tInt;
342 401
 	BEGIN
343 402
 		i := 0;
344 403
 		WHILE isLetterOrDigit( fromString[i]) DO
@@ -348,7 +407,6 @@
348 407
 		END;
349 408
 	END;
350 409
 
351  
-
352 410
 	PROCEDURE EnterKW( sym: tInt; name: tStrID);
353 411
 	BEGIN
354 412
 		KWs[nKW].sym := sym;
@@ -362,12 +420,60 @@
362 420
 		lineNr := 1;
363 421
 		colNr := 1;
364 422
 		Assign( R, inputFile);
365  
-		Reset( R); Next;
  423
+		Reset( R); NextChar;
366 424
 
367 425
 		Assign( W, outputFile);
368 426
 		Rewrite( W);
369 427
 
370  
-		Error := TRUE;
  428
+		getSymbol;
  429
+		while( sym <> cEOF) DO
  430
+		BEGIN
  431
+			if sym = cIdent then
  432
+			BEGIN
  433
+				write( W, sym);
  434
+				if debugmode then write(sym);
  435
+				write( W, '  ident = ');
  436
+				if debugmode then write( '  ident = ');
  437
+				printId( id);
  438
+			END
  439
+
  440
+			ELSE IF sym = cNumber then
  441
+			BEGIN
  442
+				write( W, sym);
  443
+				if debugmode then write( sym);
  444
+				write( W, '  ident = ');
  445
+				if debugmode then write( '  ident = ');
  446
+				writeln( W, val);
  447
+				if debugmode then writeln( val);
  448
+			END
  449
+
  450
+			ELSE IF sym = cString then
  451
+			BEGIN
  452
+				write( W, sym);
  453
+				if debugmode then write( sym);
  454
+				write( W, '  ident = ');
  455
+				if debugmode then write( '  ident = ');
  456
+				printStr( str);
  457
+			END
  458
+
  459
+			ELSE BEGIN
  460
+			  writeln( W, sym);
  461
+				if debugmode then writeln( sym);
  462
+			END;
  463
+			getSymbol;
  464
+		END;
  465
+		writeln( W, sym);
  466
+		if debugmode then writeln( sym);
  467
+
  468
+		close( R); close( W);
  469
+	END;
  470
+
  471
+	Procedure ScannerInit();
  472
+	Begin
  473
+		cTrue := 1;
  474
+		cFalse := 0;
  475
+		lastSymWasPeek := cFalse;
  476
+		// Counter für KeyWords
371 477
 		nKW := 0;
372 478
 		EnterKW( cNull, 'BY');
373 479
 		EnterKW( cDo, 'DO');
@@ -393,10 +499,10 @@
393 499
 		EnterKW( cConst, 'CONST');
394 500
 		EnterKW( cElsif, 'ELSIF');
395 501
 		EnterKW( cNull, 'IMPORT');
396  
-		EnterKW( cNull, 'UNTIL');
  502
+		EnterKW( cForward, 'FORWARD');
397 503
 		EnterKW( cWhile, 'WHILE');
398 504
 		EnterKW( cRecord, 'RECORD');
399  
-		EnterKW( cNull, 'REPEAT');
  505
+		EnterKW( cFunction, 'FUNCTION');
400 506
 		EnterKW( cNull, 'RETURN');
401 507
 		EnterKW( cNull, 'POINTER');
402 508
 		EnterKW( cProcedure, 'PROCEDURE');
@@ -404,66 +510,4 @@
404 510
 		EnterKW( cDiv, 'DIV');
405 511
 		EnterKW( cNull, 'LOOP');
406 512
 		EnterKW( cModule, 'MODULE');
407  
-
408  
-		getSymbol( sym);
409  
-		WHILE( sym <> cEOF) DO
410  
-		BEGIN
411  
-			IF sym = cIdent THEN
412  
-			BEGIN
413  
-				write( W, sym);
414  
-				IF debugmode THEN
415  
-					write(sym);
416  
-					write( W, ' ident = ');
417  
-					IF debugmode THEN
418  
-						write( ' ident = ');
419  
-						printId( id);
420  
-			END
421  
-			ELSE IF sym = cNumber then
422  
-			BEGIN
423  
-				write( W, sym);
424  
-				IF debugmode THEN
425  
-					write( sym);
426  
-					write( W, ' ident = ');
427  
-					IF debugmode THEN
428  
-						write( ' ident = ');
429  
-						writeln( W, val); 
430  
-						writeln( val);
431  
-			END
432  
-
433  
-			ELSE IF sym = cString THEN
434  
-			BEGIN
435  
-				write( W, sym);
436  
-				IF debugmode THEN
437  
-					write( sym);
438  
-					write( W, ' ident = ');
439  
-					IF debugmode THEN
440  
-						write( ' ident = ');
441  
-						printId( id);
442  
-			END
443  
-
444  
-			ELSE BEGIN
445  
-				writeln( W, sym);
446  
-				IF debugmode THEN
447  
-					writeln( sym);
448  
-			END;
449  
-			getSymbol( sym);
450  
-		END;
451  
-		writeln( W, sym);
452  
-		IF debugmode THEN
453  
-			writeln( sym);
454  
-			close( R); 
455  
-			close( W);
456  
-	END;
457  
-
458  
-	BEGIN
459  
-	    debugmode := debug;
460  
-		IF ParamCount < 2 THEN
461  
-			BEGIN
462  
-				writeln('Not enough parameters given. Usage: ' + ParamStr(0) + ' input.pas output.out');
463  
-				halt(1);
464  
-			END
465  
-		ELSE BEGIN
466  
-			scan( ParamStr(1), ParamStr(2) );
467  
-		END;
468  
-
469  
-  END.
  513
+	End;

No commit comments for this range

Something went wrong with that request. Please try again.