- Timestamp:
- Jul 26, 2017, 11:35:26 PM (7 years ago)
- Location:
- branches/interpreter/interpreter4
- Files:
-
- 4 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/interpreter/interpreter4/Execute.pas
r107 r108 8 8 type 9 9 TVariableValue = record 10 VarRef: PVariable ;10 VarRef: PVariableRef; 11 11 BaseType: TBaseType; 12 12 case Integer of … … 254 254 begin 255 255 case GetValue.ReadType of 256 rtVariable: AssignVariable(Value, ExecutionContextCurrent^.VariableValues.GetByName(GetValue.Variable ^.Name));256 rtVariable: AssignVariable(Value, ExecutionContextCurrent^.VariableValues.GetByName(GetValue.VariableRef^.Variable^.Name)); 257 257 //rtConstant: Value := ExecutionContextCurrent^.VariableValues.GetByName(GetValue.Variable^.Name); 258 258 rtExpression: ExecuteExpression(GetValue.Expression, Value); … … 352 352 Param := @Execution^.Parameters.Items[I]; 353 353 if (Param.ReadType = rtVariable) then 354 AssignVariable(ExecutionContextCurrent^.VariableValues.GetByName(Param.Variable .Name), DestVar)354 AssignVariable(ExecutionContextCurrent^.VariableValues.GetByName(Param.VariableRef^.Variable^.Name), DestVar) 355 355 else ShowError('Function var parameter can be only variable'); 356 356 end; … … 362 362 SrcVariable: TVariableValue; 363 363 begin 364 DestVariable := ExecutionContextCurrent^.VariableValues.GetByName(Assignment^.Destination^. Name);365 WriteLn('Assignment to ' + Assignment^.Destination^. Name);364 DestVariable := ExecutionContextCurrent^.VariableValues.GetByName(Assignment^.Destination^.Variable^.Name); 365 WriteLn('Assignment to ' + Assignment^.Destination^.Variable^.Name); 366 366 FillChar(SrcVariable, SizeOf(TVariableValue), 0); 367 367 ExecuteGetValue(@Assignment^.Source, @SrcVariable); … … 395 395 begin 396 396 I := 0; 397 while (I < Length(Items)) and (Items[I].VarRef^. Name <> Name) do Inc(I);397 while (I < Length(Items)) and (Items[I].VarRef^.Variable^.Name <> Name) do Inc(I); 398 398 if I < Length(Items) then Result := @Items[I] 399 399 else Result := nil; -
branches/interpreter/interpreter4/Parser.pas
r107 r108 51 51 function ParseTypeFunction(TypeItem: PType; WithName: Boolean = True): Boolean; forward; 52 52 function ParseTypeProcedure(TypeItem: PType; WithName: Boolean = True): Boolean; forward; 53 function ParseVariable (out Variable: PVariable): Boolean; forward;53 function ParseVariableRef(VariableRef: PVariableRef): Boolean; forward; 54 54 function ParseExpression(Expression: PExpression): Boolean; forward; 55 55 … … 129 129 end; 130 130 131 function GetPosText: string; 132 begin 133 Result := InputTextFileName + ' (' + IntToStr(InputTextPos.Y) + ',' + IntToStr(InputTextPos.X) + ')'; 134 end; 135 131 136 procedure ShowError(Text: string); 132 137 begin 133 WriteLn( InputTextFileName + ' (' + IntToStr(InputTextPos.Y) + ',' + IntToStr(InputTextPos.X) + ') ' +Text);138 WriteLn(GetPosText + ' ' + Text); 134 139 WriteLn(Copy(InputText, InputTextPos.Index, 50)); 135 140 Halt; … … 288 293 begin 289 294 Result := ReadNextInternal; 290 //WriteLn('ReadNext: ' + Result);295 WriteLn(GetPosText + ' ReadNext: ' + Result); 291 296 end; 292 297 … … 300 305 Result := Next = Text; 301 306 InputTextPos := OldPos; 302 WriteLn( 'Check: ' + Next);307 WriteLn(GetPosText + ' Check: ' + Next + ', ' + Text); 303 308 end; 304 309 … … 308 313 begin 309 314 Next := ReadNextInternal; 310 WriteLn( 'Expect: ' + Next);315 WriteLn(GetPosText + ' Expect: ' + Next + ', ' + Text); 311 316 if Next <> Text then 312 317 ShowError('Expected ' + Text + ' but found ' + Next); 318 end; 319 320 function CheckNextExpect(Text: string): Boolean; 321 var 322 Next: string; 323 OldPos: TTextPos; 324 begin 325 OldPos := InputTextPos; 326 Next := ReadNextInternal; 327 Result := Next = Text; 328 if not Result then InputTextPos := OldPos; 329 WriteLn(GetPosText + 'CheckExpect: ' + Next + ', ' + Text); 313 330 end; 314 331 … … 325 342 end; 326 343 327 function ParseVariable(out Variable: PVariable): Boolean; 344 procedure AssignGetValue(Dest, Source: PGetValue); 345 begin 346 Dest^.Value := Source^.Value; 347 Dest^.VariableRef := Source^.VariableRef; 348 Dest^.Constant := Source^.Constant; 349 Dest^.Expression := Source^.Expression; 350 Dest^.FunctionCall := Source^.FunctionCall; 351 Dest^.ReadType := Source^.ReadType; 352 end; 353 354 procedure AssignVariableRef(Dest, Source: PVariableRef); 355 begin 356 Dest^.Index := Source^.Index; 357 Dest^.Variable := Source^.Variable; 358 Dest^.Field := Source^.Field; 359 end; 360 361 function ParseVariableRef(VariableRef: PVariableRef): Boolean; 328 362 var 329 363 OldPos: TTextPos; … … 331 365 SelfVariable: PVariable; 332 366 IndexValue: TGetValue; 367 FieldType: PType; 368 Variable: PVariable; 333 369 begin 334 370 OldPos := InputTextPos; 335 Variable := nil;336 371 repeat 337 372 Next := ReadNext; 338 if Assigned(Variable) and (Variable^.DataType^.BaseType = btRecord) then begin 339 // if FunctionContext = nil then 340 // Variable := MainProgram^.Variables.GetByName(Next) 341 // else Variable := FunctionContext^.Variables.GetByName(Next); 373 if Assigned(VariableRef^.Variable) and (VariableRef^.Variable^.DataType^.BaseType = btRecord) then begin 374 VariableRef^.Field := VariableRef^.Variable^.DataType^.Fields^.GetByName(Next); 342 375 end else begin 343 if FunctionContext = nil then 344 Variable := MainProgram^.Variables.GetByName(Next) 345 else begin 346 Variable := FunctionContext^.Variables.GetByName(Next); 347 if (Variable = nil) then begin 348 SelfVariable := FunctionContext^.Variables.GetByName('Self'); 349 if (SelfVariable <> nil) and (SelfVariable^.Value.ValueRecord <> nil) then begin 350 Variable := SelfVariable^.Value.ValueRecord^.GetByName(Next); 351 end; 376 if FunctionContext = nil then begin 377 Variable := MainProgram^.Variables.GetByName(Next); 378 VariableRef^.Variable := Variable; 379 end else begin 380 Variable := FunctionContext^.Variables.GetByName(Next); 381 if (Variable = nil) then begin 382 SelfVariable := FunctionContext^.Variables.GetByName('Self'); 383 if (SelfVariable <> nil) and (SelfVariable^.Value.ValueRecord <> nil) then begin 384 Variable := SelfVariable^.Value.ValueRecord^.GetByName(Next); 385 if Variable <> nil then 386 VariableRef^.Variable := Variable; 352 387 end; 353 end; 388 end else VariableRef^.Variable := Variable; 389 end; 354 390 end; 355 if Variable <> nil then begin391 if VariableRef^.Variable <> nil then begin 356 392 Result := True; 357 393 if CheckNext('[') then begin 358 if Variable ^.DataType^.BaseType = btArray then begin394 if VariableRef^.Variable^.DataType^.BaseType = btArray then begin 359 395 Expect('['); 360 396 if ParseGetValue(@IndexValue) then begin 361 //Variable := Variable^. 397 VariableRef^.Index := GetMem(SizeOf(TGetValue)); 398 AssignGetValue(VariableRef^.Index, @IndexValue); 362 399 end else ShowError('Expected index value but found ' + ReadNext); 363 400 Expect(']'); 364 401 end else ShowError('Unexpected array index'); 365 402 end; 366 if CheckNext ('.') then begin367 Expect('.'); 403 if CheckNextExpect('.') then begin 404 368 405 Continue; 369 406 end else Break; … … 376 413 end; 377 414 378 function ParseVariablePointer( out Variable: PVariable): Boolean;415 function ParseVariablePointer(Variable: PVariableRef): Boolean; 379 416 begin 380 417 Result := False; … … 382 419 Expect('@'); 383 420 Result := True; 384 ParseVariable (Variable);421 ParseVariableRef(Variable); 385 422 end; 386 423 end; … … 481 518 FoundOperator := False; 482 519 repeat 520 FillChar(GetValue, SizeOf(TGetValue), 0); 483 521 if CheckNext('(') then begin 484 522 Expect('('); … … 570 608 function ParseGetValue(GetValue: PGetValue; NoExpression: Boolean = False): Boolean; 571 609 var 572 Variable : PVariable;610 VariableRef: TVariableRef; 573 611 Constant: PConstant; 574 612 FunctionCall: TExecution; … … 579 617 FillChar(FunctionCall, SizeOf(TFunctionCall), 0); 580 618 FillChar(Value, SizeOf(TConstant), 0); 619 FillChar(VariableRef, SizeOf(TVariableRef), 0); 581 620 582 621 Result := True; … … 588 627 //AssignExpression(GetValue^.Expression, @Expression); 589 628 end else 590 if ParseVariable (Variable) then begin629 if ParseVariableRef(@VariableRef) then begin 591 630 GetValue^.ReadType := rtVariable; 592 GetValue^.Variable := Variable; 631 GetValue^.VariableRef := GetMem(SizeOf(TVariableRef)); 632 AssignVariableRef(GetValue^.VariableRef, @VariableRef); 593 633 end else 594 634 if ParseConstant(Constant) then begin … … 600 640 GetValue^.Value := Value; 601 641 end else 602 if ParseVariablePointer( Variable) then begin642 if ParseVariablePointer(@VariableRef) then begin 603 643 GetValue^.ReadType := rtValue; 604 GetValue^.Value := Value; 644 GetValue^.VariableRef := GetMem(SizeOf(TVariableRef)); 645 AssignVariableRef(GetValue^.VariableRef, @VariableRef); 605 646 end else 606 647 if ParseExecution(@FunctionCall) then begin … … 615 656 function ParseAssignment(Assignment: PAssignment): Boolean; 616 657 var 617 Variable: PVariable; 618 begin 619 if ParseVariable(Variable) then begin 620 Result := True; 621 Assignment^.Destination := Variable; 658 Variable: TVariableRef; 659 begin 660 FillChar(Variable, SizeOf(TVariableRef), 0); 661 if ParseVariableRef(@Variable) then begin 662 Result := True; 663 Assignment^.Destination := GetMem(SizeOf(TVariable)); 664 AssignVariableRef(Assignment^.Destination, @Variable); 622 665 Expect(':='); 623 666 ParseGetValue(@Assignment^.Source); … … 723 766 function ParseWhileDo(WhileDo: PWhileDo): Boolean; 724 767 begin 725 if CheckNext('while') then begin 726 Result := True; 727 Expect('while'); 768 if CheckNextExpect('while') then begin 769 Result := True; 728 770 ParseGetValue(@WhileDo.Condition); 729 771 Expect('do'); … … 736 778 Command: TCommand; 737 779 begin 738 if CheckNext('begin') then begin 739 Result := True; 740 Expect('begin'); 780 if CheckNextExpect('begin') then begin 781 Result := True; 741 782 SetLength(BeginEnd^.Commands, 0); 742 783 repeat … … 986 1027 function ParseDirective(Directive: PDirective): Boolean; 987 1028 begin 988 if CheckNext('{$') then begin 989 Expect('{$'); 1029 if CheckNextExpect('{$') then begin 990 1030 Directive^.Name := ReadNext; 991 1031 Directive^.Value := ReadNext; … … 1138 1178 begin 1139 1179 CaseActivated := False; 1140 if CheckNext('record') then begin 1141 Result := True; 1142 Expect('record'); 1180 if CheckNextExpect('record') then begin 1181 Result := True; 1143 1182 TypeItem^.BaseType := btRecord; 1144 1183 TypeItem^.Fields := GetMem(SizeOf(TTypes));; … … 1265 1304 end; 1266 1305 1267 function ParseUnit(UnitItem: PUnit; FileName : string): Boolean;1306 function ParseUnit(UnitItem: PUnit; FileName, ShortFileName: string): Boolean; 1268 1307 var 1269 1308 OldInputText: string; 1270 1309 OldInputTextPos: TTextPos; 1310 OldInputTextFileName: string; 1271 1311 UnitFile: Text; 1272 1312 Directive: TDirective; … … 1276 1316 OldInputText := InputText; 1277 1317 OldInputTextPos := InputTextPos; 1318 OldInputTextFileName := InputTextFileName; 1319 1320 InputTextFileName := ShortFileName; 1278 1321 1279 1322 AssignFile(UnitFile, FileName); … … 1329 1372 InputText := OldInputText; 1330 1373 InputTextPos := OldInputTextPos; 1374 InputTextFileName := OldInputTextFileName; 1331 1375 end; 1332 1376 … … 1336 1380 UnitItem: PUnit; 1337 1381 begin 1338 if CheckNext('uses') then begin 1339 Result := True; 1340 Expect('uses'); 1382 if CheckNextExpect('uses') then begin 1383 Result := True; 1341 1384 repeat 1342 1385 Next := ReadNext; … … 1347 1390 if UnitItem = nil then begin 1348 1391 SetLength(MainProgram.Units.Items, Length(MainProgram.Units.Items) + 1); 1349 ParseUnit(@MainProgram.Units.Items[Length(MainProgram.Units.Items) - 1], MainProgram.BaseDir + '/' + Next + '.pas' );1392 ParseUnit(@MainProgram.Units.Items[Length(MainProgram.Units.Items) - 1], MainProgram.BaseDir + '/' + Next + '.pas', Next + '.pas'); 1350 1393 end; 1351 1394 … … 1386 1429 1387 1430 SetLength(ProgramCode^.Variables.Items, 0); 1431 1432 SetLength(ProgramCode^.Constants.Items, 0); 1433 ProgramCode^.Constants.Add(ConstantCreate('nil', nil)); 1388 1434 1389 1435 SetLength(ProgramCode^.Functions.Items, 0); … … 1418 1464 ParserInit(ProgramCode); 1419 1465 ReadInputAll(Input); 1420 if CheckNext('program') then begin1421 Expect('program');1466 InputTextFileName := 'Input'; 1467 if CheckNextExpect('program') then begin 1422 1468 ProgramCode.Name := ReadNext; 1423 1469 Expect(';'); -
branches/interpreter/interpreter4/Source.pas
r106 r108 9 9 PAssignment = ^TAssignment; 10 10 PVariable = ^TVariable; 11 PVariableRef = ^TVariableRef; 11 12 PConstant = ^TConstant; 12 13 PIfThenElse = ^TIfThenElse; … … 19 20 PFunction = ^TFunction; 20 21 PVariables = ^TVariables; 21 22 TOperator = (opNone, opAdd, opSubtract, opAnd, opOr, opNot, opEqual, opNotEqual); 22 PGetValue = ^TGetValue; 23 24 TOperator = (opNone, opAdd, opSubtract, opAnd, opOr, opNot, opEqual, opNotEqual, 25 opLess, opGreater, opLessOrEqual, opGreaterOrEqual); 23 26 24 27 TBaseType = (btNone, btBoolean, btInteger, btChar, btShortString, btArray, … … 94 97 end; 95 98 99 TVariableRef = record 100 Variable: PVariable; 101 case TBaseType of 102 btRecord: (Field: PType); 103 btArray: (Index: PGetValue); 104 end; 105 96 106 TFunctionParameter = record 97 107 Name: string; … … 135 145 ReadType: TReadType; 136 146 case TReadType of 137 rtVariable: (Variable : PVariable);147 rtVariable: (VariableRef: PVariableRef); 138 148 rtConstant: (Constant: PConstant); 139 149 rtExpression: (Expression: PExpression); … … 141 151 rtValue: (Value: TConstant); 142 152 end; 143 PGetValue = ^TGetValue;144 153 145 154 TExpNodeType = (ntNone, ntValue, ntOperator); … … 155 164 156 165 TAssignment = record 157 Destination: PVariable ;166 Destination: PVariableRef; 158 167 Source: TGetValue; 159 168 end; … … 249 258 var 250 259 OperatorString: array[TOperator] of string = ('', '+', '-', 'and', 'or', 'not', 251 '=', '<>' );260 '=', '<>', '<', '>', '<=', '>='); 252 261 253 262 const 254 OperatorPrecedence: array[0.. 6] of TOperator = (opNot, opAnd, opOr, opAdd,255 opSubtract, opEqual, opNotEqual );263 OperatorPrecedence: array[0..10] of TOperator = (opNot, opAnd, opOr, opAdd, 264 opSubtract, opEqual, opNotEqual, opLess, opGreater, opLessOrEqual, opGreaterOrEqual); 256 265 Keywords: array[0..18] of string = ('begin', 'end', 'if', 'then', 'else', 'while', 257 266 'do', 'type', 'var', 'const', 'uses', 'unit', 'program', 'array', 'procedure', -
branches/interpreter/interpreter4/interpreter.lpi
r107 r108 101 101 <StackChecks Value="True"/> 102 102 </Checks> 103 <VerifyObjMethodCallValidity Value="True"/> 103 104 </CodeGeneration> 104 105 </CompilerOptions>
Note:
See TracChangeset
for help on using the changeset viewer.