[squeak-dev] The Trunk: Compiler-eem.211.mcz

commits at source.squeak.org commits at source.squeak.org
Fri Jul 8 20:30:38 UTC 2011


Eliot Miranda uploaded a new version of Compiler to project The Trunk:
http://source.squeak.org/trunk/Compiler-eem.211.mcz

==================== Summary ====================

Name: Compiler-eem.211
Author: eem
Time: 8 July 2011, 1:30:12.579 pm
UUID: 500dbdbf-02ba-4414-a482-34f50dafbd38
Ancestors: Compiler-ul.210

Parse error: keyword in FFI pragmas/method tags.  Requires
FFI-Kernel-eem.24/FFI-Pools-eem.3.

Fix BlockLocalTempCounter for all-return case statements.

Make sure define class uses the non-meta-class.

=============== Diff against Compiler-ul.210 ===============

Item was changed:
  ----- Method: BlockLocalTempCounter>>doJoin (in category 'private') -----
  doJoin
  	scanner pc < blockEnd ifTrue:
+ 		[stackPointer := joinOffsets at: scanner pc ifAbsent: [scanner followingPc]]
+ 
+ 	"the ifAbsent: handles a caseOf:otherwise: where all cases return, which results
+ 	 in the branch around the otherwise being unreached.  e.g. in the following
+ 		jumpTo: L2
+ 	 is unreached.
+ 
+ 		| t |
+ 		t caseOf: { [nil] -> [^thisContext method abstractSymbolic] }
+ 		  otherwise: ['Oh no Mr Bill!!']
+ 
+ 		pushTemp: 0
+ 		pushConstant: nil
+ 		send: #= (1 arg)
+ 		jumpFalseTo: L1
+ 		pushThisContext: 
+ 		send: #method (0 args)
+ 		send: #abstractSymbolic (0 args)
+ 		returnTop
+ 		jumpTo: L2
+ 	L1:
+ 		pushConstant: 'Oh no Mr Bill!!'
+ 	L2:
+ 		returnTop"!
- 		[stackPointer := joinOffsets at: scanner pc]!

Item was changed:
  ----- Method: Parser>>defineClass: (in category 'error correction') -----
  defineClass: className 
  	"prompts the user to define a new class,  
  	asks for it's category, and lets the users edit further  
  	the definition"
  	| sym cat def d2 |
  	sym := className asSymbol.
+ 	cat := UIManager default request: 'Enter class category : ' initialAnswer: self encoder classEncoding theNonMetaClass category.
- 	cat := UIManager default request: 'Enter class category : ' initialAnswer: self encoder classEncoding category.
  	cat
  		ifEmpty: [cat := 'Unknown'].
  	def := 'Object subclass: #' , sym , '
  		instanceVariableNames: '''' 
  		classVariableNames: ''''
  		poolDictionaries: ''''
  		category: ''' , cat , ''''.
  	d2 := UIManager default request: 'Edit class definition : ' initialAnswer: def.
  	d2
  		ifEmpty: [d2 := def].
  	Compiler evaluate: d2.
  	^ encoder
  		global: (Smalltalk globals associationAt: sym)
  		name: sym!

Item was changed:
  ----- Method: Parser>>externalFunctionDeclaration (in category 'primitives') -----
  externalFunctionDeclaration
  	"Parse the function declaration for a call to an external library."
+ 	| descriptorClass callType modifier retType externalName args argType module fn |
- 	| descriptorClass callType retType externalName args argType module |
  	descriptorClass := Smalltalk at: #ExternalFunction ifAbsent:[nil].
  	descriptorClass == nil ifTrue:[^false].
  	callType := descriptorClass callingConventionFor: here.
  	callType == nil ifTrue:[^false].
+ 	[modifier := descriptorClass callingConventionModifierFor: token.
+ 	 modifier notNil] whileTrue:
+ 		[self advance.
+ 		 callType := callType bitOr: modifier].
  	"Parse return type"
  	self advance.
  	retType := self externalType: descriptorClass.
  	retType == nil ifTrue:[^self expected:'return type'].
  	"Parse function name or index"
  	externalName := here.
  	(self match: #string) 
  		ifTrue:[externalName := externalName asSymbol]
  		ifFalse:[(self match:#number) ifFalse:[^self expected:'function name or index']].
  	(self matchToken: #'(') ifFalse:[^self expected:'argument list'].
  	args := WriteStream on: Array new.
  	[here == #')'] whileFalse:[
  		argType := self externalType: descriptorClass.
  		argType == nil ifTrue:[^self expected:'argument'].
  		argType isVoid & argType isPointerType not ifFalse:[args nextPut: argType].
  	].
+ 	(self matchToken: #')') ifFalse:[^self expected:')'].
- 	(args position = self properties selector numArgs) ifFalse:[
- 		^self expected: 'Matching number of arguments'
- 	].
- 	(self matchToken:#')') ifFalse:[^self expected:')'].
  	(self matchToken: 'module:') ifTrue:[
  		module := here.
  		(self match: #string) ifFalse:[^self expected: 'String'].
  		module := module asSymbol].
+ 	Smalltalk at: #ExternalLibraryFunction ifPresent:[:xfn|
- 	Smalltalk at: #ExternalLibraryFunction ifPresent:[:xfn| | fn |
  		fn := xfn name: externalName 
  				module: module 
  				callType: callType
  				returnType: retType
  				argumentTypes: args contents.
  		self allocateLiteral: fn.
  	].
+ 	(self matchToken: 'error:')
+ 		ifTrue:
+ 			[| errorCodeVariable |
+ 			 errorCodeVariable := here.
+ 			(hereType == #string
+ 			 or: [hereType == #word]) ifFalse:[^self expected: 'error code (a variable or string)'].
+ 			 self advance.
+ 			 self addPragma: (Pragma keyword: #primitive:error: arguments: (Array with: 120 with: errorCodeVariable)).
+ 			 fn ifNotNil: [fn setErrorCodeName: errorCodeVariable]]
+ 		ifFalse:
+ 			[self addPragma: (Pragma keyword: #primitive: arguments: #(120))].
+ 	^true
+ !
- 	self addPragma: (Pragma keyword: #primitive: arguments: #(120)).
- 	^true!




More information about the Squeak-dev mailing list