allow <primitive>
authorClaus Gittinger <cg@exept.de>
Thu, 26 Apr 2001 14:21:28 +0200
changeset 1155 8cea56f32c57
parent 1154 8c8787349aaf
child 1156 b491528ad92b
allow <primitive>
Parser.st
--- a/Parser.st	Wed Apr 11 13:50:38 2001 +0200
+++ b/Parser.st	Thu Apr 26 14:21:28 2001 +0200
@@ -3431,7 +3431,7 @@
      and to mark resource methods (image, menu or canvas resources).
 
      prim ::= st80Primitive | st80Pragma | stxPragma
-              squeakPrimitive | resourceDecl
+              squeakPrimitive | newSTXPrimitive | resourceDecl
 
      st80Primitive ::= 'primitive:' INTEGER
      st80Pragma    ::= 'exception:' ( 'handle | 'raise' | 'unwind' )
@@ -3439,13 +3439,15 @@
 
      squeakPrimitive ::= 'primitive:' STRING
 
+     newSTXPrimitive ::= 'primitive'
+
      resourceDecl ::= 'resource:' SYMBOL       - leave SYMBOL in primitiveResource
                     | 'resource:' SYMBOL (...) - leave (SYMBOL (...)) in primitiveResource
     "
 
     |primNumber keys resource resourceValue pragmaType cString cParser cType|
 
-    (tokenType ~~ #Keyword) ifTrue:[
+    (tokenType == #Keyword or:[tokenType == #Identifier]) ifFalse:[
         self parseError:'bad primitive definition (keyword expected)'.
         ^ #Error
     ].
@@ -3481,86 +3483,91 @@
             ].
         ]
     ] ifFalse:[
-        (tokenName = 'resource:') ifTrue:[
-            self nextToken.
-            (tokenType ~~ #Symbol) ifTrue:[
-                self parseError:'symbol expected'.
-                ^ #Error
-            ].
-            primNumber := -1.
-            resource := tokenValue.
-            resourceValue := true.
-
+        (tokenName = 'primitive') ifTrue:[
             self nextToken.
-
-            tokenType == $( ifTrue:[
-                self nextToken.
-                keys := OrderedCollection new.
-                [(tokenType == $)) or:[tokenType == #EOF] ] whileFalse:[
-                    keys add:tokenValue.
-                    self nextToken.
-                ].
-                resourceValue := keys.
-                (tokenType == $)) ifFalse:[
-                    self parseError:'unterminated primitive/spec (missing '')'')'.
-                ].
-                self nextToken.
-            ].
-
-            primitiveResource isNil ifTrue:[
-                primitiveResource := IdentityDictionary new.
-            ].
-            primitiveResource at:(resource asSymbol) put:resourceValue.
+            primNumber := 0.
         ] ifFalse:[
-            (tokenName = 'exception:' 
-            or:[tokenName = 'context:']) ifTrue:[
-                pragmaType := tokenName.
-
+            (tokenName = 'resource:') ifTrue:[
                 self nextToken.
                 (tokenType ~~ #Symbol) ifTrue:[
                     self parseError:'symbol expected'.
                     ^ #Error
                 ].
-
-                ((pragmaType = 'exception:'
-                    and:[tokenValue == #'handle'
-                         or:[tokenValue == #'raise'
-                         or:[tokenValue == #'unwind']]])
-                or:[
-                    pragmaType = 'context:'
-                    and:[(tokenValue == #'return')]])
-
-                ifTrue:[
-                    primitiveContextInfo isNil ifTrue:[
-                        primitiveContextInfo := Set new.
-                    ].
-                    primitiveContextInfo add:(pragmaType->tokenValue).
-                ] ifFalse:[
-                    self parseError:'unrecognized exception pragma: ' , tokenValue.
-                ].
+                primNumber := -1.
+                resource := tokenValue.
+                resourceValue := true.
+
                 self nextToken.
-            ] ifFalse:[
-                (tokenName = 'C:') ifTrue:[
-                    cString := source upTo:$>.
+
+                tokenType == $( ifTrue:[
                     self nextToken.
-                    "/ generate that type
-                    cParser := CParser parse:(cString , ';').
-                    cType := cParser types first.
-                    primitiveResource "primitiveType" := cType.
-                    ^ -1
-                ] ifFalse:[
-                    self parseError:'unrecognized pragma: ' , tokenName.
-
-                    "/ skip
-                    [tokenType ~~ #EOF] whileTrue:[
-                        ((tokenType == #BinaryOperator) and:[tokenName = '>']) ifTrue:[
-                            self nextToken.
-                            ^ -1 "/ primNr.
-                        ].
+                    keys := OrderedCollection new.
+                    [(tokenType == $)) or:[tokenType == #EOF] ] whileFalse:[
+                        keys add:tokenValue.
                         self nextToken.
                     ].
+                    resourceValue := keys.
+                    (tokenType == $)) ifFalse:[
+                        self parseError:'unterminated primitive/spec (missing '')'')'.
+                    ].
+                    self nextToken.
                 ].
-            ]
+
+                primitiveResource isNil ifTrue:[
+                    primitiveResource := IdentityDictionary new.
+                ].
+                primitiveResource at:(resource asSymbol) put:resourceValue.
+            ] ifFalse:[
+                (tokenName = 'exception:' 
+                or:[tokenName = 'context:']) ifTrue:[
+                    pragmaType := tokenName.
+
+                    self nextToken.
+                    (tokenType ~~ #Symbol) ifTrue:[
+                        self parseError:'symbol expected'.
+                        ^ #Error
+                    ].
+
+                    ((pragmaType = 'exception:'
+                        and:[tokenValue == #'handle'
+                             or:[tokenValue == #'raise'
+                             or:[tokenValue == #'unwind']]])
+                    or:[
+                        pragmaType = 'context:'
+                        and:[(tokenValue == #'return')]])
+
+                    ifTrue:[
+                        primitiveContextInfo isNil ifTrue:[
+                            primitiveContextInfo := Set new.
+                        ].
+                        primitiveContextInfo add:(pragmaType->tokenValue).
+                    ] ifFalse:[
+                        self parseError:'unrecognized exception pragma: ' , tokenValue.
+                    ].
+                    self nextToken.
+                ] ifFalse:[
+                    (tokenName = 'C:') ifTrue:[
+                        cString := source upTo:$>.
+                        self nextToken.
+                        "/ generate that type
+                        cParser := CParser parse:(cString , ';').
+                        cType := cParser types first.
+                        primitiveResource "primitiveType" := cType.
+                        ^ -1
+                    ] ifFalse:[
+                        self parseError:'unrecognized pragma: ' , tokenName.
+
+                        "/ skip
+                        [tokenType ~~ #EOF] whileTrue:[
+                            ((tokenType == #BinaryOperator) and:[tokenName = '>']) ifTrue:[
+                                self nextToken.
+                                ^ -1 "/ primNr.
+                            ].
+                            self nextToken.
+                        ].
+                    ].
+                ]
+            ].
         ].
     ].
 
@@ -3601,8 +3608,13 @@
                     wmsg := 'ST-80/Squeak directive ignored'.
                 ].
             ] ifFalse:[
-                primitiveNr := primNr.
-                wmsg := 'ST-80 primitive may not work'
+                primNr > 0 ifTrue:[
+                    primitiveNr := primNr.
+                    wmsg := 'ST-80 primitive may not work'
+                ] ifFalse:[
+                    primitiveNr := primNr.
+                    wmsg := 'ST/X primitives only work in rel5 and newer'
+                ]
             ].
         ].
         wmsg notNil ifTrue:[self warning:wmsg position:pos]
@@ -5761,6 +5773,6 @@
 !Parser class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.281 2001-03-19 09:18:05 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.282 2001-04-26 12:21:28 cg Exp $'
 ! !
 Parser initialize!