home *** CD-ROM | disk | FTP | other *** search
Text File | 1993-07-15 | 36.5 KB | 1,280 lines |
- "Sun-1.2"
-
- "Copyright 1992 Sun Microsystems, Inc. and Stanford University.
- See the LICENSE file for license information."
-
- "CAUTION: This file is not part of the documented Self world. It may be
- be changed or removed at any time, and it will not be documented. Don't
- try to learn good Self style from this file.
-
- This file can be removed from all.self without affecting the Self world,
- except for tests.wrappers.self which uses it for testing purposes."
-
- "
- This program is an attempt to make it easier to add primitives to Self.
- It reads primitive templates and creates the self glue code, the
- primitive table entries, and the C++ headers, glue functions, and glue
- macros.
-
- To read primitive templates construct a file whose name ends with
- ``.self''.
- The file should have the following format:
-
- primitiveMaker reader copy [staticLinking|dynamicLinking]
- create: 'fileNamePrefix' From: '
-
- template1
- template2
- template3a \
- template3b
- ...
- templateN
- '
-
- Then use the _RunScript primitive from the shell to execute your file.
- This program will write out two files:
- fileNamePrefix.{wrappers.self,primMaker.h}.
-
- Blank lines are ignored.
- Any line starting with ``//'' is ignored.
- Any line starting with ``--'' is inserted as a comment in the output files.
-
- A template is a sequence of nonwhite tokens, or anything inside of
- curly brackets.
-
- Three special templates specify supplemental information:
- traits: <self-path>
-
- specifies the self traits object that will be the target of
- the _AddSlots for the wrappers.
-
- macroName: <macro-name>
-
- specifies the base name of the macro that will be defined to
- hold all the lines of glue or primitive entries
- (macro-name_glue or macro-name_entries)
-
- glueLibaryName: <glue-library-name>
-
- (This template applies only to dynamic linking.)
- specifies the file name of the glue library.
-
- The syntax of the other templates is:
- [_|^] <wrapper-spec> = <resultType> <type-of-prim> <c-name> <primTableInfo>
-
- <wrapper-spec> gives the name of the Self-wrapper, and the argument
- type conversion specs. It is a sequence of keywords, interspersed with
- type conversion specs. The first spec may be void to force the
- wrapper to discard the receiver.
-
- Type conversion specs:
- This package knows about the following type conversions:
-
- oop any_oop smi
- void any
- bool
-
- float double long_double
-
- char signed_char unsigned_char
- short signed_short unsigned_short
- int signed_int unsigned_int int_or_errno
- long signed_long unsigned_long
-
- string string_len string_null string_len_null
-
- * bv bv_len bv_null bv_len_null
- * cbv cbv_len cbv_null cbv_len_null
-
- + proxy proxy_null proxy_or_errno
- + fct_proxy fct_proxy_null
-
- + aClassName
-
- * byteVectors require a pointer type, e.g., <bv_len char*>
-
- + Using <aClassName> specifies a pointer to the class or structure.
- So does <proxy aClassName* sealName>.
- Using <proxy aClassName sealName> specifies the class or structure.
-
- <resultType> is the type conversion for the primitive result.
-
- <type-of-prim> = get[Member] | set[Member] | call[Member] | new | delete.
-
- <cname> is the name of the C function or varaible. Omitted for new, delete.
-
- <primTableInfo> = [canAWS] [cannotFail] [passFailHandle]
- The next token may be cannotFail, if the C primitive cannotFail.
- Or it may be canAWS, if the C primitive can abort, walk the stack or
- scavenge.
- Or it may be passFailHandle to pass a failure handle as the last
- argument.
-
-
- To test this out, type ``primitiveMaker reader copy staticLinking test''.
- "
-
- traits applications _AddSlotsIfAbsent: (| primitiveMaker = () |)
- prototypes applications _AddSlotsIfAbsent: (| primitiveMaker = () |)
-
-
- traits primitiveMaker _AddSlotsIfAbsent: ( |
- abstractLinking = ().
- staticLinking = ().
- dynamicLinking = ().
-
- reader = ().
- parser = ().
- cvts = ().
- msg = ().
- typeTraits = ().
- | )
-
- prototypes primitiveMaker _AddSlotsIfAbsent: ( |
- generator = ().
- reader = ().
- parser = ().
- cvts = ().
- msg = ().
- | )
-
-
- traits primitiveMaker abstractLinking _AddSlotsIfAbsent: ( |
- generator = ().
- | )
-
- traits primitiveMaker staticLinking _AddSlotsIfAbsent: ( |
- generator = ().
- | )
-
- traits primitiveMaker dynamicLinking _AddSlotsIfAbsent: ( |
- generator = ().
- | )
-
-
- traits primitiveMaker reader _Define: ( |
- _ parent* = traits clonable.
- _ ignoredCommentPrefix = '//'.
- _ includedCommentPrefix = '--'.
-
- ^ create: filePrefix From: inputString = (
- create: filePrefix From: inputString Writing: true ).
-
- ^ create: filePrefix From: in Writing: doWrite = (
- setupFileHeaders.
- read: in.
- doWrite ifTrue: [ write: filePrefix ].
- self).
-
- _ write: prefix = (
- " convert to strings so each character isn't output individually "
- " (eliminate when printOnFile: uses buffered files) "
-
- wrappers asString printOnFile: prefix, '.wrappers.self'.
-
- (entries, '\n\n', glue) asString printOnFile: prefix, '.primMaker.h'.
- self).
-
-
- _ read: in = ( | inList. token. line. r. |
- inList: list copyRemoveAll.
- r: list copyRemoveAll.
-
- in: in WithoutEscNLDo: [|:c| inList addLast: c].
-
- line: list copyRemoveAll.
- [|:exit|
- [
- inList isEmpty || ['\n' = inList first] ifTrue: [
- processTemplate: line.
- inList isEmpty ifTrue: exit.
- line: list copyRemoveAll.
- ].
- '\t \n' includes: inList first
- ] whileTrue: [inList removeFirst].
-
- token: list copyRemoveAll.
- inList first = '{' ifTrue: [
- inList removeFirst.
- [|:exitBracketToken. c |
- inList isEmpty ifTrue: [^error: 'open { but no closing }'].
- c: inList removeFirst.
- c = '}' ifTrue: exitBracketToken.
- token addLast: c.
- ] loopExit.
- ] False: [
- [|:exitToken. |
- inList isEmpty ifTrue: exitToken.
- ('\t \n' includes: inList first) ifTrue: exitToken.
- token addLast: inList removeFirst.
- ] loopExit.
- ].
- line addLast: token asString.
- ] loopExit.
-
- processEnd).
-
-
- _ in: in WithoutEscNLDo: b = ( | lastWasBackslash <- false |
- in do: [|:c|
- lastWasBackslash ifFalse: [b value: c] True: [
- '\n' = c ifFalse: [
- b value: '\n' first.
- b value: c.
- ].
- ].
- lastWasBackslash: '\\' = c
- ].
- b value: '\n' first. "needed for tokenize"
- self).
-
-
- _ setupFileHeaders = (
- | warning = 'This information was generated by the primitive maker',
- ' (primitiveMaker.self).\nPlease do not change it',
- ' manually. -- dmu 12/91 '.
- pragma = '# pragma interface\n\n'.
- |
- comment: warning.
- appendToMacros: pragma).
-
- _ appendToMacros: s = (entries: entries, s. glue: glue, s).
-
- _ comment: c = (
- wrappers: wrappers, sComment: c.
- appendToMacros: cComment: c).
-
-
- _ sComment: c = ('" ' , c, ' "\n\n' ).
- _ cComment: c = ('/* ', c, ' */\\\n\\\n').
-
- _ processTemplate: line = ( | p. g |
- feedback: 'processing ', (line printStringSize: infinity).
- line isEmpty ifTrue: [^self].
- line first = ignoredCommentPrefix ifTrue: [^self].
- line first = includedCommentPrefix ifTrue: [| s <- ''. |
- line doFirst: [] MiddleLast: [|:t| s: s, t, ' '] IfEmpty: [].
- ^ comment: s.
- ].
- line first = 'traits:' ifTrue: [^processTraits: line].
- line first = 'macroName:' ifTrue: [^processMacroName: line].
- line first = 'glueLibraryName:' ifTrue: [^processGlueLibraryName: line].
- p: primitiveMaker parser copy.
- p tokenList: line.
- p parse.
-
- g: primitiveMaker generator copy.
- g reader: self.
- g parser: p.
- g generate.
-
- appendFrom: g.
- self).
-
- ^ appendFrom: gen = (
- wrappers: wrappers, gen wrapper.
- glue: glue, gen glue.
- entries: entries, gen entry).
-
-
- _ processTraits: line = (
- line removeFirst.
- endOfWrappers.
- line do: [|:tok| wrappers: wrappers, tok, ' '].
- wrappers: wrappers, '_AddSlots: ( |\n\n'.
- isInAddSlots: true).
-
- _ processMacroName: line = (
- line removeFirst.
- endOfMacros.
- macroName: line first.
- line removeFirst.
- isInDefine: true).
-
- _ macroName: n = (
- glue: glue, '# define ', n, '_glue \\\n\\\n'.
- entries: entries, '# define ', n, '_entries \\\n\\\n').
-
- _ processEnd = (endOfWrappers).
-
- _ endOfWrappers = (
- isInAddSlots ifTrue: [wrappers: wrappers, '| )\n\n'. isInAddSlots: false].
- self).
-
- _ endOfMacros = (
- isInDefine ifTrue: [appendToMacros: '\n\n'. isInDefine: false].
- self).
-
- ^ test = ( test: true ).
-
- ^ test: doWrite = ( | reader |
- reader: copy.
- reader staticLinking.
- reader cDirectory: ''.
- reader create: 'test' From: '
-
- // a comment that is ignored
- -- a comment that is included in the output
-
- traits: fribble frabble
- macroName: smortlehoffer
-
- void copy_color: color Shape: shape = Inode {inodeProto deadCopy} new
-
- _ Inode delete = void delete
-
- ^ void errorNumber = int get errno
- void errorNumber: int = void set errno
-
- Pixrect pr_zap = frob frobToSideEffect getMember bark
- Pixrect pr_zap: int = frob frobToSideEffect setMember bark
- Pixrect pr_zap: int = frob {frob xroto} callMember bark
-
-
- void time = int call ftime
-
- ^ void open: string Mode: int = int call open
- ^ void open: string \
- Mode: int = proxy int int_seal pToSideEffect call open
-
- _ void exit: int = void call exit canAWS cannotFail
- _ void exit: any_oop = void call exit canAWS cannotFail passFailHandle
-
- ' Writing: doWrite.
- self).
-
- _ noisy = ( | _ feedback: string = ( string printLine. self ). | ).
- _ quiet = ( | _ feedback: string = ( self ). | ).
-
- _ feedingBack* <- ().
-
- ^ beNoisy = (feedingBack: noisy).
- ^ beQuiet = (feedingBack: quiet).
-
- ^ staticLinking = (
- generatorTraits: traits primitiveMaker staticLinking generator.
- cDirectory: 'prims').
-
- ^ dynamicLinking = (
- generatorTraits: traits primitiveMaker dynamicLinking generator.
- cDirectory: 'self').
-
- _ processGlueLibraryName: line = (
- line removeFirst.
- glueLibraryName: line first).
-
-
- _ glueLibraryName: n = ( glueLibraryNameSlot: '\'', n, '\'' ).
-
- _ noGlueLibraryName = 'user must specify me'.
-
- _ initializeGlueLibraryName = (glueLibraryNameSlot: noGlueLibraryName).
-
- ^ glueLibraryName = (
- glueLibraryNameSlot = noGlueLibraryName
- ifFalse: [glueLibraryNameSlot]
- True: [
- error:
- 'You must include a \"glueLibraryName:\" template',
- ' for dyanamic linking. ',
- 'The library name gives the name of the .so file containing the',
- ' glue.'
- ]).
- | ) beNoisy
-
-
- primitiveMaker reader _Define: ( |
- _ parent* = traits primitiveMaker reader.
-
- _ selfDirectory <- 'self'.
- _ cDirectory <- 'self'.
-
- ^ wrappers <- ''.
- ^ entries <- ''.
- ^ glue <- ''.
-
- ^ isInAddSlots <- false.
- ^ isInDefine <- false.
-
- ^_ generatorTraits <- ().
- _ glueLibraryNameSlot <- ''.
- | )
-
-
- "==============================================="
- traits primitiveMaker parser _Define: ( |
- _ parent** = traits clonable.
-
- ^ copy = ((
- resend.copy keywords: keywords copyRemoveAll)
- argCvts: argCvts copyRemoveAll).
-
- ^ parse = (
- ('_^' includes: tokenList first first) ifTrue: [
- privacy: tokenList removeFirst.
- ].
- [|:exit|
- argCvts addLast: selectCvt parseArgFrom: tokenList.
- tokenList first = '=' ifTrue: exit.
- keywords addLast: tokenList removeFirst.
- tokenList first = '=' ifTrue: exit.
- ] loopExit.
- tokenList removeFirst. "rm = "
-
- resultCvt: selectCvt parseResFrom: tokenList.
- primType: tokenList removeFirst.
- cName: (primType = 'new' ) ifTrue: 'new' False: [
- (primType = 'delete') ifTrue: 'delete' False: [
- tokenList removeFirst]].
-
- [tokenList isEmpty] whileFalse: [
- tokenList removeFirst, ':' sendTo: self With: true.
- ].
- self).
-
- _ selectCvt = ( | c <- '' |
- c: tokenList removeFirst.
- '_' = c ifTrue: [primitiveMaker cvts proxyForClass: c]
- False: [c sendTo: primitiveMaker cvts]).
- | )
-
- primitiveMaker parser _Define: ( |
- _ parent* = traits primitiveMaker parser.
-
- _^ tokenList <- list.
- ^_ privacy <- ''.
- ^_ keywords <- list.
- ^_ argCvts <- list.
- ^_ resultCvt <- ().
- ^_ primType <- 'call'.
- ^_ cName <- 'open'.
-
- " sendTo's"
-
- ^ canAWS <- false.
- ^ cannotFail <- false.
- ^ passFailHandle <- false.
- | )
-
-
- "========================================================"
- traits primitiveMaker abstractLinking generator _Define: ( |
- _ parent* = traits clonable.
-
- ^ generate = (
- typeParent: parser primType sendTo: traits primitiveMaker typeTraits.
- generatorParent: reader generatorTraits.
- gen).
-
-
- _ cName = (parser cName).
- _ argCvts = (parser argCvts).
- _ resultCvt = (parser resultCvt).
- _ className = (argCvts first className).
-
- _ gluePrefix = (
- cName = '' ifTrue: [className ] False: [
- className = '' ifTrue: [ cName ] False: [
- cName = className ifTrue: [ cName ] False: [
- className, '_', cName]]]).
- _ gen = (
- "ordering is essential"
- buildGlueName.
- buildWrapper.
- self).
-
-
- _ buildGlueName = (
- glueName: gluePrefix.
- glueName isEmpty ifFalse: [glueName: glueName, '_'].
- parser keywords do: [|:k|
- glueName: glueName,
- (k last = ':' ifTrue: [k copyWithoutLast, '_'] False: k)
- capitalize.
- ].
- glueName: glueName, '_glue').
-
-
- _ buildWrapper = (
- buildWrapperToDefaultFailBlock.
- buildWrapperToCallC).
-
- _ buildWrapperToDefaultFailBlock = (
- wrapperNoFailDcl: wrapperNoFailDcl copy keywords: parser keywords
- Cvts: argCvts.
- wrapperNoFailDcl privacy: parser privacy.
-
- wrapperFailSend: wrapperNoFailDcl copy.
- wrapperFailSend addLastKeyword: 'IfFail'
- Arg: '[|:e| ^error: \'',
- wrapperNoFailDcl selector,
- ' failed: \', e]'.
-
- wrapper: ' ', (wrapperNoFailDcl dcl: 4 WithPrivacy: true), ' = (',
- (wrapperFailSend send: 6), ').\n\n'.
- self).
-
- _ buildWrapperToCallC = (
- wrapperFailDcl: wrapperNoFailDcl copy addLastKeyword: 'IfFail'
- Arg: 'failBlock'.
-
- wrapper: wrapper, ' ', (wrapperFailDcl dcl: 4 WithPrivacy: true),
- '= ('.
-
- glueSend: wrapperNoFailDcl copy.
- argCvts first isVoid ifTrue: [
- glueSend removeFirst.
- argCvts removeFirst.
- ].
- resultCvt isProxy ifTrue: [
- glueSend addLastKeyword: 'ResultProxy'
- Arg: resultCvt resultArg.
- ].
- glueSend addSelectorPrefix: gluePrefix.
- primName: glueSend selector.
- glueSend addSelectorPrefix: '_'.
-
- fixupGlueSendForDynamicLinking.
-
- glueSend addLastKeyword: 'IfFail' Arg: wrapperFailDcl args last.
- glueSend hasCoercions ifTrue: [
- glueSendWiCvts: glueSend copy applyCvts.
- glueSend replaceLastArgWith:
- '\n [|:e| (\'badTypeError\' isPrefixOf: e)',
- '\n || [\'deadProxyError\' isPrefixOf: e]',
- '\n ifFalse: [^failBlock value: e] ',
- '\n True: [',
- (glueSendWiCvts send: 18),
- '\n ]]'.
- ].
-
- makeSlotForForeignFct. "uses glueSend"
-
- wrapper: wrapper, (glueSend send: 6).
- resultCvt isVoid ifTrue: [wrapper: wrapper, '.\n self'].
- wrapper: wrapper, ').\n\n\n'.
- self).
-
- _ primOrGlueCanFail = (
- parser cannotFail not || [resultCvt resCanFail || [
- resultCvt isProxy || [
- argCvts findFirst: [|:cvt| cvt argCanFail]
- IfPresent: true
- IfAbsent: false]]]).
-
- _ glueCount = ('_', argCvts size printString).
-
- _ glueArgCvts: start = ( | v. r <- '' |
- v: argCvts asVector.
- start upTo: v size Do: [|:i. a|
- a: v at: i.
- r: r, ', ', a glueify.
- ].
- r).
-
- | )
-
-
- traits primitiveMaker staticLinking generator _Define: ( |
- _ parent* = traits primitiveMaker abstractLinking generator.
-
- _ makeSlotForForeignFct = (self).
-
- _ fixupGlueSendForDynamicLinking = (self).
-
- ^ entry = (
- '\"', primName, '\", \\\n',
- 'fntype(&', glueName, '), \\\n',
- 'ExternalPrimitive, \\\n',
- resultCvt primTableRetType, ', \\\n',
-
- primOrGlueCanFail printString, ', /* can fail */ \\\n',
- parser canAWS printString, ', /* can scavenge */ \\\n',
- false printString, ', /* can be constant folded */ \\\n',
- true printString, ', /* cannot be moved or cut */ \\\n',
- parser canAWS printString, ', /* can walk stack */ \\\n',
- parser canAWS printString, ', /* can abort process */ \\\n',
- ' \\\n').
- | )
-
- traits primitiveMaker dynamicLinking generator _Define: ( |
- _ parent* = traits primitiveMaker abstractLinking generator.
-
- _ fct = 'myFctObj'.
-
- _ makeSlotForForeignFct = ( | dummyFF. dummySel. |
- dummySel: glueSend copy.
- dummySel makeArgs.
- dummySel args removeLast.
- dummySel args addLast: 'fb'.
- dummyFF: '[ ( | copyName: n = (self). ', (dummySel send: 13),
- '= (fb value: \'could not link\'). | ) ]'.
- wrapper: wrapper,
- '\n | ', fct, ' =',
- ((primitiveMaker msg copy
- receiver: 'foreignFct'
- K: 'copyName:' A: '\'', glueName, '\''
- K: 'Path:' A: reader glueLibraryName
- K: 'IfFail:' A: dummyFF) send: 6),
- '\n |\n'.
- self).
-
- _ fixupGlueSendForDynamicLinking = (
- glueSend addFirstReceiver: fct Keyword: 'value'.
- glueSend valueWithify.
- self).
-
- ^ entry = ''.
- | )
-
- primitiveMaker generator _Define: ( |
- _ typeParent* <- ().
- _ generatorParent** <- ().
- _ parent*** = traits primitiveMaker abstractLinking generator.
-
- parser <- primitiveMaker parser.
- reader <- primitiveMaker reader.
-
- glueName <- ''.
- primName <- ''.
-
- wrapperNoFailDcl <- primitiveMaker msg.
- wrapperFailSend <- primitiveMaker msg.
- wrapperFailDcl <- primitiveMaker msg.
-
- glueSend <- primitiveMaker msg.
- glueSendWiCvts <- primitiveMaker msg.
-
- wrapper <- ''.
- | )
-
-
- "======================================================================"
-
- traits primitiveMaker msg _Define: ( |
- _ parent* = traits clonable.
-
- _ lotsOargs = ( |
- _ parent* = traits primitiveMaker msg.
-
- ^ addLastKeyword: k Arg: a = (
- args addLast: a.
- keywords addLast: k, ':'.
- cvts addLast: primitiveMaker cvts none.
- self).
-
- ^ addFirstReceiver: rcv Keyword: k = (
- args addFirst: rcv.
- keywords addFirst: k, ':'.
- cvts addFirst: primitiveMaker cvts none.
- self).
-
- ^ removeFirst = (
- args removeFirst.
- cvts removeFirst.
- keywords addFirst:
- args size = 1
- ifTrue: [ keywords removeFirst copyWithoutLast]
- False: [ keywords removeFirst copyWithoutLast,
- keywords removeFirst].
- setMode).
-
- ^ valueWithify = (
- keywords removeFirst.
- keywords: keywords copyMappedBy: ['With:'].
- keywords addFirst: 'value:'.
- self).
-
- ^ dcl: indent WithPrivacy: pri = (
- | a. in <- ''. r <- ''. col <- 0. toks. |
- in: in copySize: indent.
- a: args copy.
- a removeFirst.
- toks: list copyRemoveAll.
- keywords with: a Do: [|:k. :a|
- toks addLast: k.
- toks addLast: a.
- ].
- toks do: [|:t|
- (t size succ + col) > width ifTrue: [
- r: r, '\n', in.
- col: in size.
- ].
- r: r, t, ' '.
- col: col + t size succ.
- ].
- pri ifTrue: [ r: privacy, ' ', r ].
- r ).
-
- _ width = 60.
- | ).
-
- _ unary = ( |
- _ parent* = traits primitiveMaker msg.
-
- ^ addLastKeyword: k Arg: a = (
- args addLast: a.
- cvts addLast: primitiveMaker cvts none.
- keywords addFirst: keywords removeFirst, k, ':'.
- setMode).
-
- ^ addFirstReceiver: rcv Keyword: k = (
- args addFirst: rcv.
- cvts addFirst: primitiveMaker cvts none.
- keywords removeFirst.
- keywords addFirst: k, ':'.
- setMode).
-
- ^ removeFirst = (
- args removeFirst. args addFirst: ignored.
- cvts removeFirst. cvts addFirst: primitiveMaker cvts none.
- setMode).
-
- ^ valueWithify = (
- keywords removeFirst.
- keywords addFirst: 'value'.
- self).
-
- ^ dcl: indent WithPrivacy: pri = (
- pri ifTrue: [ privacy, ' ', keywords first ]
- False: [ keywords first ] ).
- | ).
- | )
-
- traits primitiveMaker msg _AddSlots: ( |
-
- _ nullary = ( |
- _ parent* = traits primitiveMaker msg unary.
-
- ^ addLastKeyword: k Arg: a = (
- k = 'IfFail' ifTrue: [^resend.addLastKeyword: k Arg: a].
- args removeFirst. args addLast: a.
- cvts removeFirst. cvts addLast: primitiveMaker cvts none.
- keywords addFirst: keywords removeFirst, k.
- setMode).
-
- ^ addFirstReceiver: rcv Keyword: k = (
- args removeFirst.
- cvts removeFirst.
- keywords removeFirst.
- args addFirst: rcv.
- cvts addFirst: primitiveMaker cvts none.
- keywords addFirst: k.
- setMode).
-
- ^ removeFirst = (self).
- | ).
-
- _ setMode = (
- mode: args size > 1 ifTrue: [lotsOargs] False: [
- args first = ignored ifTrue: [nullary] False: [unary]]).
-
- ^ copy = (((
- resend.copy keywords: keywords copy)
- cvts: cvts copy)
- args: args copy).
-
- ^ receiver: r K: k1 A: a1 K: k2 A: a2 K: k3 A: a3 = (
- args removeAll.
- args addLast: r.
- args addLast: a1.
- args addLast: a2.
- args addLast: a3.
-
- keywords removeAll.
- keywords addLast: k1.
- keywords addLast: k2.
- keywords addLast: k3.
-
- cvts removeAll.
- args size do: [cvts addLast: primitiveMaker cvts none].
- setMode).
-
-
- ^ makeArgs = (
- args removeAll.
- cvts size pred do: [|:i| args addLast: 't', i printString].
- args addFirst: 'self'.
- setMode.
- self).
-
- ^ keywords: ks Cvts: cs = (
- keywords: ks copy.
- cvts: cs copy.
- makeArgs).
-
- _ ignored = '"ignored"'.
-
- "indent is indent of rest of line"
- ^ send: indent = ( | rcvr <- '' |
- args first = 'self' ifFalse: [ rcvr: args first ].
- '\n', ('' copySize: (indent - 2) max: 0), rcvr, ' ',
- (dcl: indent WithPrivacy: false)).
-
- ^ addSelectorPrefix: p = (
- (p isPrefixOf: keywords first) ifTrue: [^self].
- keywords addFirst: p, keywords removeFirst.
- self).
-
- ^ selector = ( | r <- '' |
- keywords do: [|:k| r: r, k].
- r).
-
- ^ hasCoercions = (
- cvts findFirst: [|:a| (a selfConversion: 'fisk') != 'fisk']
- IfPresent: true
- IfAbsent: false).
-
- ^ applyCvts = ( | a. c |
- a: args.
- c: cvts.
- args: a copyRemoveAll.
- cvts: c copyRemoveAll.
- a with: c Do: [|:a. :c|
- args addLast: c selfConversion: a.
- cvts addLast: primitiveMaker cvts none.
- ].
- self).
-
- ^ replaceLastArgWith: a = (
- args removeLast.
- args addLast: a.
- self).
- | )
-
-
- primitiveMaker msg _Define: ( |
- _ mode* <- traits primitiveMaker msg unary.
-
- ^ privacy <- ''.
- ^_ keywords <- list copy addLast: 'not'.
- ^_ args <- list copy addLast: 'snort'.
- ^_ cvts <- list copy "addLast: primitiveMaker cvts none".
- | )
-
-
- traits primitiveMaker typeTraits _Define: ( |
-
- ^ get = ( |
- _ className = ''.
- ^ glue = (
- ' C_get_var( ', resultCvt glueify, ', ',
- cName, ', ', glueName, ') \\\n' ).
- | ).
- ^ getMember = ( |
- ^ glue = (
- ' C_get_comp( ', resultCvt glueify, ', ',
- argCvts first glueify,
- ', ', '.', cName, ', ', glueName, ') \\\n' ).
- | ).
- ^ set = ( |
- _ className = ''.
-
- ^ glue = (
- ' C_set_var( ', cName, ', ', argCvts first glueify, ', ',
- glueName, ') \\\n' ).
- | ).
- ^ setMember = ( |
- ^ glue = (
- ' C_set_comp( ', argCvts first glueify,
- ', ', '.', cName, ', ',
- argCvts last glueify, ', ',
- glueName, ') \\\n' ).
- | ).
- ^ call = ( |
- _ className = ''.
- ^ glue = (
- ' C_func', glueCount,
- '( ', resultCvt glueify, ', ', cName, ', ',
- glueName, ', ',
- (parser passFailHandle ifTrue: 'fail' False: ''),
- (glueArgCvts: 0), ') \\\n').
- | ).
- ^ callMember = ( |
- ^ glue = (
- ' CC_mber', glueCount,
- '( ', resultCvt glueify, ', ',
- argCvts first glueify, ', ',
- cName, ', ',
- glueName, ', ',
- (parser passFailHandle ifTrue: 'fail' False: ''),
- (glueArgCvts: 1), ') \\\n').
- | ).
- ^ new = ( |
- _ className = (resultCvt className).
-
- ^ glue = (
- ' CC_new', glueCount, '( ', resultCvt glueify, ', ',
- className, ', ',
- glueName,
- (glueArgCvts: 0), ') \\\n').
- | ).
- ^ delete = ( |
- ^ glue = (
- ' CC_delete( ', argCvts first glueify, ', ', glueName, ') \\\n').
- | ).
-
- ^ undefinedSelector: sel Type: t Delegatee: d MethodHolder: mh
- Arguments: a = (
- sel error: 'is a bad template type: ', sel).
-
- ^ performTypeErrorSelector: sel Type: t Delegatee: d MethodHolder: mh
- Arguments: a = (
- sel error: 'is a bad template type: ', sel).
- | )
-
- traits primitiveMaker cvts _Define: ( |
- general = ( |
- ^ massageResult: r = (r).
-
- ^ isVoid = false.
- ^ glueify = (main, ',', glueifiedAux).
- ^ primTableRetType = (ptBaseType, 'PrimType').
- _ ptBaseType = 'Unknown'.
- ^ argCanFail = true.
- ^ resCanFail = true.
- ^ selfConversion: a = (a).
- ^ parseArgFrom: tokList = (parseFrom: tokList).
- ^ parseResFrom: tokList = (parseFrom: tokList).
- ^ className = (
- error: 'cannot deduce class name from ', main, ' conversion').
- ^ isProxy = false.
- | ).
- | )
-
-
- traits primitiveMaker cvts _AddSlots: ( |
- noAux = ( |
- _ cloning* = traits oddball.
- _ p2* = traits primitiveMaker cvts general.
- ^ parseFrom: tokList = (self).
- _ glueifiedAux = ''.
- | ).
-
- aux = ( |
- _ cloning* = traits clonable.
- _ p2* = traits primitiveMaker cvts general.
- ^ parseFrom: tokList = (copy setFrom: tokList).
- | ).
- | )
-
-
- traits primitiveMaker cvts _AddSlots: ( |
- ints = ( |
- _ parent* = traits primitiveMaker cvts noAux.
- _ ptBaseType = 'Integer'.
- ^ selfConversion: a = (a, ' asSmallInteger').
- | ).
-
- floats = ( |
- _ parent* = traits primitiveMaker cvts noAux.
- _ ptBaseType = 'Float'.
- ^ selfConversion: a = (a, ' asFloat').
- | ).
-
- strings = ( |
- _ parent* = traits primitiveMaker cvts noAux.
- ^ selfConversion: a = (a, ' asByteVector').
- | ).
-
- byteVectors = ( |
- _ parent* = traits primitiveMaker cvts aux.
- _ ptBaseType = 'ByteVector'.
- _ setFrom: tokList = (
- tokList isEmpty ifTrue: [^error: 'byteVectors need ptr type'].
- ptrType: tokList removeFirst.
- self).
- _ glueifiedAux = (ptrType).
- ^ selfConversion: a = (a, ' asByteVector').
- | ).
-
- proxies = ( |
- _ parent* = traits primitiveMaker cvts aux.
- _ setFrom: tokList = (
- tokList size < 2
- ifTrue: [^error: 'proxies need ptr type and type seal'].
- ptrType: tokList removeFirst.
- typeSeal: tokList removeFirst.
- self).
- ^ parseArgFrom: tokList = (copy setFrom: tokList).
- ^ parseResFrom: tokList = (
- (parseArgFrom: tokList) setResultProxyFrom: tokList).
- _ setResultProxyFrom: tokList = (
- tokList isEmpty ifTrue: [
- ^error: 'returned proxy need result proxy'
- ].
- resultProxy: tokList removeFirst.
- self).
- _ glueifiedAux = ('(', ptrType, ',', typeSeal, ')').
- ^ isProxy = true.
- ^ resultArg = (resultProxy).
- ^ selfConversion: a = ( | rcvr <- '' |
- a = 'self' ifFalse: [ rcvr: a ].
- '(', rcvr, ' reviveIfFail: [|:e| ^ failBlock value: e])' ).
- | ).
- | )
-
-
- traits primitiveMaker cvts _AddSlots: ( |
- fctProxies = ( |
- _ parent* = traits primitiveMaker cvts proxies.
- _ setFrom: tokList = (
- resend.setFrom: tokList.
- tokList isEmpty ifTrue: [^error: 'fctProxies need argCount'].
- argCount: tokList removeFirst.
- self).
- _ glueifiedAux = ('(', ptrType, ',', typeSeal, ',', argCount, ')').
- | ).
- | )
-
-
- primitiveMaker cvts _Define: ( |
-
- ^ none = ( |
- p* = traits oddball.
- selfConversion: a = (a).
- isVoid = false.
- | ).
-
- ^ oop = ( |
- _ auxp* = traits primitiveMaker cvts aux.
- _ main = 'oop'.
- oopSubtype <- ''.
- _ setFrom: tokList = (
- tokList isEmpty ifTrue: [^error: 'oop needs oopSubtype'].
- oopSubtype: tokList removeFirst.
- self).
- ^ parseResFrom: tokList = (self).
- _ glueifiedAux = (oopSubtype).
- | ).
- ^ any_oop = ( |
- _ auxp* = traits primitiveMaker cvts noAux.
- _ main = 'any_oop'.
- ^ argCanFail = false.
- | ).
- ^ any = ( |
- _ auxp* = traits primitiveMaker cvts aux.
- _ main = 'any'.
- _ setFrom: tokList = (
- tokList isEmpty ifTrue: [^error: 'any needs C type'].
- cType: tokList removeFirst.
- self).
- _ glueifiedAux = (cType).
- _ cType <- ''
- | ).
- ^ void = ( |
- _ auxp* = traits primitiveMaker cvts noAux.
- ^ massageResult: r = (r, '.\n self').
- ^ isVoid = true.
-
- _ main = 'void'.
- _ ptBaseType = 'Unknown'.
- ^ resCanFail = false.
- | ).
- ^ bool = ( |
- _ auxp* = traits primitiveMaker cvts noAux.
- _ ptBaseType = 'Boolean'.
- _ main = 'bool'.
- ^ resCanFail = false.
- | ).
-
- ^ float = ( |
- _ auxp* = traits primitiveMaker cvts floats.
- _ main = 'float'.
- | ).
- ^ double = ( |
- _ auxp* = traits primitiveMaker cvts floats.
- _ main = 'double'
- | ).
- ^ long_double = ( |
- _ auxp* = traits primitiveMaker cvts floats.
- _ main = 'long_double'.
- | ).
-
- ^ char = ( |
- _ rtp* = traits primitiveMaker cvts ints.
- _ main = 'char'.
- ^ resCanFail = false.
- | ).
- ^ short = ( |
- _ rtp* = traits primitiveMaker cvts ints.
- _ main = 'short'.
- ^ resCanFail = false.
- | ).
- ^ int_or_errno = ( |
- _ rtp* = traits primitiveMaker cvts aux.
- _ ptBaseType = 'Integer'.
- ^ selfConversion: a = (a, ' asSmallInteger').
- _ main = 'int_or_errno'.
- _ glueifiedAux = (errorValue).
- _ setFrom: tokList = (
- tokList isEmpty ifTrue: [^error: main, ' needs errorValue'].
- errorValue: tokList removeFirst.
- self).
- _ errorValue.
- | ).
- ^ int = ( |
- _ rtp* = traits primitiveMaker cvts ints.
- _ main = 'int'.
- | ).
- ^ smi = ( |
- _ rtp* = traits primitiveMaker cvts ints.
- _ main = 'smi'.
- | ).
- ^ long = ( |
- _ rtp* = traits primitiveMaker cvts ints.
- _ main = 'long'.
- | ).
- ^ signed_char = ( |
- _ rtp* = traits primitiveMaker cvts ints.
- _ main = 'signed_char'.
- ^ resCanFail = false.
- | ).
- ^ signed_short = ( |
- _ rtp* = traits primitiveMaker cvts ints.
- _ main = 'signed_short'.
- ^ resCanFail = false.
- | ).
- ^ signed_int = ( |
- _ rtp* = traits primitiveMaker cvts ints.
- _ main = 'signed_int'.
- | ).
- ^ signed_long = ( |
- _ rtp* = traits primitiveMaker cvts ints.
- _ main = 'signed_long'.
- | ).
- ^ unsigned_char = ( |
- _ rtp* = traits primitiveMaker cvts ints.
- _ main = 'unsigned_char'.
- ^ resCanFail = false.
- | ).
- ^ unsigned_short = ( |
- _ rtp* = traits primitiveMaker cvts ints.
- _ main = 'unsigned_short'.
- ^ resCanFail = false.
- | ).
- ^ unsigned_int = ( |
- _ rtp* = traits primitiveMaker cvts ints.
- _ main = 'unsigned_int'.
- | ).
- ^ unsigned_long = ( |
- _ rtp* = traits primitiveMaker cvts ints.
- _ main = 'unsigned_long'.
- | ).
-
- ^ string = ( |
- _ auxp* = traits primitiveMaker cvts strings.
- _ main = 'string'.
- | ).
- ^ string_len = ( |
- _ auxp* = traits primitiveMaker cvts strings.
- _ main = 'string_len'.
- | ).
- ^ string_null = ( |
- _ auxp* = traits primitiveMaker cvts strings.
- _ main = 'string_null'.
- | ).
- ^ string_len_null = ( |
- _ auxp* = traits primitiveMaker cvts strings.
- _ main = 'string_len_null'.
- | ).
- ^ bv = ( |
- _ auxp* = traits primitiveMaker cvts byteVectors.
- _ main = 'bv'.
- _ ptrType.
- | ).
- ^ bv_len = ( |
- _ auxp* = traits primitiveMaker cvts byteVectors.
- _ main = 'bv_len'.
- _ ptrType.
- | ).
- ^ bv_null = ( |
- _ auxp* = traits primitiveMaker cvts byteVectors.
- _ main = 'bv_null'.
- _ ptrType.
- | ).
- ^ bv_len_null = ( |
- _ auxp* = traits primitiveMaker cvts byteVectors.
- _ main = 'bv_len_null'.
- _ ptrType.
- | ).
- ^ cbv = ( |
- _ auxp* = traits primitiveMaker cvts byteVectors.
- _ main = 'cbv'.
- _ ptrType.
- | ).
- ^ cbv_len = ( |
- _ auxp* = traits primitiveMaker cvts byteVectors.
- _ main = 'cbv_len'.
- _ ptrType.
- | ).
- ^ cbv_null = ( |
- _ auxp* = traits primitiveMaker cvts byteVectors.
- _ main = 'cbv_null'.
- _ ptrType.
- | ).
- ^ cbv_len_null = ( |
- _ auxp* = traits primitiveMaker cvts byteVectors.
- _ main = 'cbv_len_null'.
- _ ptrType.
- | ).
- ^ autoProxy = ( |
- _ auxp* = traits primitiveMaker cvts proxies.
- _ main = 'proxy'.
- ^ className. _ resultProxy.
- _ ptrType = (className, '*').
- _ typeSeal = (className, '_seal').
- ^ parseArgFrom: tokList = (self).
- ^ parseResFrom: tokList = (setResultProxyFrom: tokList).
- | ).
- ^ proxy = ( |
- _ auxp* = traits primitiveMaker cvts proxies.
- _ main = 'proxy'.
- _ ptrType. _ typeSeal. _ resultProxy.
- | ).
- ^ proxy_null = ( |
- _ auxp* = traits primitiveMaker cvts proxies.
- _ main = 'proxy_null'.
- _ ptrType. _ typeSeal. _ resultProxy.
- | ).
- ^ proxy_or_errno = ( |
- _ auxp* = traits primitiveMaker cvts proxies.
- _ main = 'proxy_or_errno'.
- _ setFrom: tokList = (
- resend.setFrom: tokList.
- tokList isEmpty ifTrue: [^error: main, ' needs errorValue'].
- errorValue: tokList removeFirst.
- self).
- _ glueifiedAux = ( '(', ptrType, ',', typeSeal, ',', errorValue, ')').
- _ ptrType. _ typeSeal. _ resultProxy. _ errorValue.
- | ).
- ^ fct_proxy = ( |
- _ auxp* = traits primitiveMaker cvts fctProxies.
- _ main = 'fct_proxy'.
- _ ptrType. _ typeSeal. _ argCount. _ resultProxy.
- | ).
- ^ fct_proxy_null = ( |
- _ auxp* = traits primitiveMaker cvts fctProxies.
- _ main = 'fct_proxy_null'.
- _ ptrType. _ typeSeal. _ argCount. _ resultProxy.
- | ).
- ^ fct_proxy_or_errno = ( |
- _ auxp* = traits primitiveMaker cvts fctProxies.
- _ main = 'fct_proxy_or_errno'.
- _ ptrType. _ typeSeal. _ argCount. _ resultProxy.
- | ).
-
- ^ proxyForClass: name = (autoProxy copy className: name).
-
- ^ undefinedSelector: sel Type: t Delegatee: d MethodHolder: mh
- Arguments: a = (
- proxyForClass: sel).
-
- ^ performTypeErrorSelector:sel Type:t Delegatee:d MethodHolder: mh
- Arguments: a = (
- proxyForClass: sel).
- | )
-
-
- "primitiveMaker reader test"
-