From ca0ec4afaf398bcbd3e787b323cc82310a02dda6 Mon Sep 17 00:00:00 2001 From: slava Date: Mon, 27 Mar 2006 00:47:51 +0000 Subject: [PATCH] Changed alien constructor behavior, new-style string mode parsing for C enums and unions (C-ENUM: and C-UNION: words) --- TODO.FACTOR.txt | 2 +- contrib/cairo/cairo.factor | 162 ++++++++++++++--------------- library/alien/aliens.factor | 3 +- library/alien/syntax.factor | 38 +++---- library/freetype/freetype.factor | 14 +-- library/syntax/parse-syntax.factor | 1 + library/test/alien.factor | 2 + library/x11/xlib.factor | 107 ++++++------------- native/alien.c | 5 +- 9 files changed, 143 insertions(+), 191 deletions(-) diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index 00f6835fce..53ea653064 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -66,7 +66,7 @@ - FIELD: char key_vector[32]; - FIELD: union { char b[20]; short s[10]; long l[5]; } data; - MEMBER: long pad[24]; -- C structs, enums, unions: use new-style string mode parsing +- C structs: use new-style string mode parsing - [ [ dup call ] dup call ] infer hangs - the invalid recursion form case needs to be fixed, for inlines too - code gc diff --git a/contrib/cairo/cairo.factor b/contrib/cairo/cairo.factor index 2ee87ce5b8..1149ab3114 100644 --- a/contrib/cairo/cairo.factor +++ b/contrib/cairo/cairo.factor @@ -28,68 +28,68 @@ USE: syntax USE: sequences ! cairo_status_t -BEGIN-ENUM: 0 - ENUM: CAIRO_STATUS_SUCCESS - ENUM: CAIRO_STATUS_NO_MEMORY - ENUM: CAIRO_STATUS_INVALID_RESTORE - ENUM: CAIRO_STATUS_INVALID_POP_GROUP - ENUM: CAIRO_STATUS_NO_CURRENT_POINT - ENUM: CAIRO_STATUS_INVALID_MATRIX - ENUM: CAIRO_STATUS_NO_TARGET_SURFACE - ENUM: CAIRO_STATUS_NULL_POINTER - ENUM: CAIRO_STATUS_INVALID_STRING -END-ENUM +C-ENUM: + CAIRO_STATUS_SUCCESS + CAIRO_STATUS_NO_MEMORY + CAIRO_STATUS_INVALID_RESTORE + CAIRO_STATUS_INVALID_POP_GROUP + CAIRO_STATUS_NO_CURRENT_POINT + CAIRO_STATUS_INVALID_MATRIX + CAIRO_STATUS_NO_TARGET_SURFACE + CAIRO_STATUS_NULL_POINTER + CAIRO_STATUS_INVALID_STRING +; ! cairo_operator_t -BEGIN-ENUM: 0 - ENUM: CAIRO_OPERATOR_CLEAR - ENUM: CAIRO_OPERATOR_SRC - ENUM: CAIRO_OPERATOR_DST - ENUM: CAIRO_OPERATOR_OVER - ENUM: CAIRO_OPERATOR_OVER_REVERSE - ENUM: CAIRO_OPERATOR_IN - ENUM: CAIRO_OPERATOR_IN_REVERSE - ENUM: CAIRO_OPERATOR_OUT - ENUM: CAIRO_OPERATOR_OUT_REVERSE - ENUM: CAIRO_OPERATOR_ATOP - ENUM: CAIRO_OPERATOR_ATOP_REVERSE - ENUM: CAIRO_OPERATOR_XOR - ENUM: CAIRO_OPERATOR_ADD - ENUM: CAIRO_OPERATOR_SATURATE -END-ENUM +C-ENUM: + CAIRO_OPERATOR_CLEAR + CAIRO_OPERATOR_SRC + CAIRO_OPERATOR_DST + CAIRO_OPERATOR_OVER + CAIRO_OPERATOR_OVER_REVERSE + CAIRO_OPERATOR_IN + CAIRO_OPERATOR_IN_REVERSE + CAIRO_OPERATOR_OUT + CAIRO_OPERATOR_OUT_REVERSE + CAIRO_OPERATOR_ATOP + CAIRO_OPERATOR_ATOP_REVERSE + CAIRO_OPERATOR_XOR + CAIRO_OPERATOR_ADD + CAIRO_OPERATOR_SATURATE +; ! cairo_line_cap_t -BEGIN-ENUM: 0 - ENUM: CAIRO_LINE_CAP_BUTT - ENUM: CAIRO_LINE_CAP_ROUND - ENUM: CAIRO_LINE_CAP_SQUARE -END-ENUM +C-ENUM: + CAIRO_LINE_CAP_BUTT + CAIRO_LINE_CAP_ROUND + CAIRO_LINE_CAP_SQUARE +; ! cair_line_join_t -BEGIN-ENUM: 0 - ENUM: CAIRO_LINE_JOIN_MITER - ENUM: CAIRO_LINE_JOIN_ROUND - ENUM: CAIRO_LINE_JOIN_BEVEL -END-ENUM +C-ENUM: + CAIRO_LINE_JOIN_MITER + CAIRO_LINE_JOIN_ROUND + CAIRO_LINE_JOIN_BEVEL +; ! cairo_fill_rule_t -BEGIN-ENUM: 0 - ENUM: CAIRO_FILL_RULE_WINDING - ENUM: CAIRO_FILL_RULE_EVEN_ODD -END-ENUM +C-ENUM: + CAIRO_FILL_RULE_WINDING + CAIRO_FILL_RULE_EVEN_ODD +; ! cairo_font_slant_t -BEGIN-ENUM: 0 - ENUM: CAIRO_FONT_SLANT_NORMAL - ENUM: CAIRO_FONT_SLANT_ITALIC - ENUM: CAIRO_FONT_SLANT_OBLIQUE -END-ENUM +C-ENUM: + CAIRO_FONT_SLANT_NORMAL + CAIRO_FONT_SLANT_ITALIC + CAIRO_FONT_SLANT_OBLIQUE +; ! cairo_font_weight_t -BEGIN-ENUM: 0 - ENUM: CAIRO_FONT_WEIGHT_NORMAL - ENUM: CAIRO_FONT_WEIGHT_BOLD -END-ENUM +C-ENUM: + CAIRO_FONT_WEIGHT_NORMAL + CAIRO_FONT_WEIGHT_BOLD +; BEGIN-STRUCT: cairo_font_t FIELD: int refcount @@ -149,45 +149,45 @@ BEGIN-STRUCT: cairo_t END-STRUCT ! cairo_format_t -BEGIN-ENUM: 0 - ENUM: CAIRO_FORMAT_ARGB32 - ENUM: CAIRO_FORMAT_RGB24 - ENUM: CAIRO_FORMAT_A8 - ENUM: CAIRO_FORMAT_A1 -END-ENUM +C-ENUM: + CAIRO_FORMAT_ARGB32 + CAIRO_FORMAT_RGB24 + CAIRO_FORMAT_A8 + CAIRO_FORMAT_A1 +; ! cairo_antialias_t -BEGIN-ENUM: 0 - ENUM: CAIRO_ANTIALIAS_DEFAULT - ENUM: CAIRO_ANTIALIAS_NONE - ENUM: CAIRO_ANTIALIAS_GRAY - ENUM: CAIRO_ANTIALIAS_SUBPIXEL -END-ENUM +C-ENUM: + CAIRO_ANTIALIAS_DEFAULT + CAIRO_ANTIALIAS_NONE + CAIRO_ANTIALIAS_GRAY + CAIRO_ANTIALIAS_SUBPIXEL +; ! cairo_subpixel_order_t -BEGIN-ENUM: 0 - ENUM: CAIRO_SUBPIXEL_ORDER_DEFAULT - ENUM: CAIRO_SUBPIXEL_ORDER_RGB - ENUM: CAIRO_SUBPIXEL_ORDER_BGR - ENUM: CAIRO_SUBPIXEL_ORDER_VRGB - ENUM: CAIRO_SUBPIXEL_ORDER_VBGR -END-ENUM +C-ENUM: + CAIRO_SUBPIXEL_ORDER_DEFAULT + CAIRO_SUBPIXEL_ORDER_RGB + CAIRO_SUBPIXEL_ORDER_BGR + CAIRO_SUBPIXEL_ORDER_VRGB + CAIRO_SUBPIXEL_ORDER_VBGR +; ! cairo_hint_style_t -BEGIN-ENUM: 0 - ENUM: CAIRO_HINT_STYLE_DEFAULT - ENUM: CAIRO_HINT_STYLE_NONE - ENUM: CAIRO_HINT_STYLE_SLIGHT - ENUM: CAIRO_HINT_STYLE_MEDIUM - ENUM: CAIRO_HINT_STYLE_FULL -END-ENUM +C-ENUM: + CAIRO_HINT_STYLE_DEFAULT + CAIRO_HINT_STYLE_NONE + CAIRO_HINT_STYLE_SLIGHT + CAIRO_HINT_STYLE_MEDIUM + CAIRO_HINT_STYLE_FULL +; ! cairo_hint_metrics_t -BEGIN-ENUM: 0 - ENUM: CAIRO_HINT_METRICS_DEFAULT - ENUM: CAIRO_HINT_METRICS_OFF - ENUM: CAIRO_HINT_METRICS_ON -END-ENUM +C-ENUM: + CAIRO_HINT_METRICS_DEFAULT + CAIRO_HINT_METRICS_OFF + CAIRO_HINT_METRICS_ON +; : cairo_create ( cairo_surface_t -- cairo_t ) "cairo_t*" "cairo" "cairo_create" [ "void*" ] alien-invoke ; compiled diff --git a/library/alien/aliens.factor b/library/alien/aliens.factor index 81e2f1068d..7b684072e6 100644 --- a/library/alien/aliens.factor +++ b/library/alien/aliens.factor @@ -4,8 +4,7 @@ IN: alien USING: arrays hashtables io kernel lists math namespaces parser sequences ; -: ( address -- alien ) - dup zero? [ drop f ] [ f ] if ; inline +: ( address -- alien ) f ; inline UNION: c-ptr byte-array alien ; diff --git a/library/alien/syntax.factor b/library/alien/syntax.factor index 674c114564..d765c838ac 100644 --- a/library/alien/syntax.factor +++ b/library/alien/syntax.factor @@ -43,30 +43,16 @@ sequences syntax words ; : END-STRUCT ( length -- ) define-struct-type ; parsing -: BEGIN-UNION: ( -- max ) - scan "struct-name" set 0 ; parsing +: C-UNION: ( -- max ) + scan "struct-name" set + string-mode on [ + string-mode off + 0 [ define-member ] reduce define-struct-type + ] [ ] ; parsing -: MEMBER: ( max -- max ) - scan define-member ; parsing - -: END-UNION ( max -- ) - define-struct-type ; parsing - -: BEGIN-ENUM: - #! C-style enumerations. Their use is not encouraged unless - #! it is for C library interfaces. Used like this: - #! - #! BEGIN-ENUM 0 - #! ENUM: x - #! ENUM: y - #! ENUM: z - #! END-ENUM - #! - #! This is the same as : x 0 ; : y 1 ; : z 2 ;. - scan string>number ; parsing - -: ENUM: - dup CREATE swap unit define-compound 1+ ; parsing - -: END-ENUM - drop ; parsing +: C-ENUM: + string-mode on [ + string-mode off 0 [ + create-in swap [ unit define-compound ] keep 1+ + ] reduce drop + ] [ ] ; parsing diff --git a/library/freetype/freetype.factor b/library/freetype/freetype.factor index f47da95276..2bb6150df1 100644 --- a/library/freetype/freetype.factor +++ b/library/freetype/freetype.factor @@ -162,13 +162,13 @@ FUNCTION: FT_Error FT_Set_Char_Size ( face* face, FT_F26Dot6 char_width, FT_F26D FUNCTION: FT_Error FT_Load_Char ( face* face, FT_ULong charcode, FT_Int32 load_flags ) ; -BEGIN-ENUM: 0 - ENUM: FT_RENDER_MODE_NORMAL - ENUM: FT_RENDER_MODE_LIGHT - ENUM: FT_RENDER_MODE_MONO - ENUM: FT_RENDER_MODE_LCD - ENUM: FT_RENDER_MODE_LCD_V -END-ENUM +C-ENUM: + FT_RENDER_MODE_NORMAL + FT_RENDER_MODE_LIGHT + FT_RENDER_MODE_MONO + FT_RENDER_MODE_LCD + FT_RENDER_MODE_LCD_V +; FUNCTION: int FT_Render_Glyph ( glyph* slot, int render_mode ) ; diff --git a/library/syntax/parse-syntax.factor b/library/syntax/parse-syntax.factor index c6d773cac2..9ea405b51b 100644 --- a/library/syntax/parse-syntax.factor +++ b/library/syntax/parse-syntax.factor @@ -46,6 +46,7 @@ SYMBOL: t : flushable word t "flushable" set-word-prop ; parsing : foldable word t "foldable" set-word-prop ; parsing : SYMBOL: CREATE dup reset-generic define-symbol ; parsing + DEFER: PRIMITIVE: parsing : DEFER: CREATE dup reset-generic drop ; parsing : : CREATE dup reset-generic [ define-compound ] [ ] ; parsing diff --git a/library/test/alien.factor b/library/test/alien.factor index 22824df233..5f05284481 100644 --- a/library/test/alien.factor +++ b/library/test/alien.factor @@ -4,6 +4,8 @@ USING: alien arrays kernel kernel-internals namespaces test ; [ t ] [ 0 0 = ] unit-test [ f ] [ 0 1024 = ] unit-test [ f ] [ "hello" 1024 = ] unit-test +[ f ] [ 0 ] unit-test +[ f ] [ 0 f ] unit-test ! Testing the various bignum accessor 10 "dump" set diff --git a/library/x11/xlib.factor b/library/x11/xlib.factor index cf59e57b57..664f681e5e 100644 --- a/library/x11/xlib.factor +++ b/library/x11/xlib.factor @@ -999,79 +999,40 @@ BEGIN-STRUCT: XKeymapEvent FIELD: int pad END-STRUCT -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -! BEGIN-UNION: XEvent -! int type; -! XAnyEvent xany; -! XKeyEvent xkey; -! XButtonEvent xbutton; -! XMotionEvent xmotion; -! XCrossingEvent xcrossing; -! XFocusChangeEvent xfocus; -! XExposeEvent xexpose; -! XGraphicsExposeEvent xgraphicsexpose; -! XNoExposeEvent xnoexpose; -! XVisibilityEvent xvisibility; -! XCreateWindowEvent xcreatewindow; -! XDestroyWindowEvent xdestroywindow; -! XUnmapEvent xunmap; -! XMapEvent xmap; -! XMapRequestEvent xmaprequest; -! XReparentEvent xreparent; -! XConfigureEvent xconfigure; -! XGravityEvent xgravity; -! XResizeRequestEvent xresizerequest; -! XConfigureRequestEvent xconfigurerequest; -! XCirculateEvent xcirculate; -! XCirculateRequestEvent xcirculaterequest; -! XPropertyEvent xproperty; -! XSelectionClearEvent xselectionclear; -! XSelectionRequestEvent xselectionrequest; -! XSelectionEvent xselection; -! XColormapEvent xcolormap; -! XClientMessageEvent xclient; -! XMappingEvent xmapping; -! XErrorEvent xerror; -! XKeymapEvent xkeymap; -! long pad[24]; -! END-UNION - -BEGIN-UNION: XEvent - MEMBER: int - MEMBER: XAnyEvent -! MEMBER: XKeyEvent - MEMBER: XButtonEvent -! MEMBER: XMotionEvent -! MEMBER: XCrossingEvent -! MEMBER: XFocusChangeEvent -! MEMBER: XExposeEvent -! MEMBER: XGraphicsExposeEvent -! MEMBER: XNoExposeEvent -! MEMBER: XVisibilityEvent -! MEMBER: XCreateWindowEvent -! MEMBER: XDestroyWindowEvent -! MEMBER: XUnmapEvent -! MEMBER: XMapEvent -! MEMBER: XMapRequestEvent -! MEMBER: XReparentEvent -! MEMBER: XConfigureEvent -! MEMBER: XGravityEvent -! MEMBER: XResizeRequestEvent -! MEMBER: XConfigureRequestEvent -! MEMBER: XCirculateEvent -! MEMBER: XCirculateRequestEvent -! MEMBER: XPropertyEvent -! MEMBER: XSelectionClearEvent -! MEMBER: XSelectionRequestEvent -! MEMBER: XSelectionEvent -! MEMBER: XColormapEvent -! MEMBER: XClientMessageEvent -! MEMBER: XMappingEvent -! MEMBER: XErrorEvent -! MEMBER: XKeymapEvent -! long pad[24]; -END-UNION +C-UNION: XEvent + int + XAnyEvent + XKeyEvent + XButtonEvent + XMotionEvent + XCrossingEvent + XFocusChangeEvent + XExposeEvent + XGraphicsExposeEvent + XNoExposeEvent + XVisibilityEvent + XCreateWindowEvent + XDestroyWindowEvent + XUnmapEvent + XMapEvent + XMapRequestEvent + XReparentEvent + XConfigureEvent + XGravityEvent + XResizeRequestEvent + XConfigureRequestEvent + XCirculateEvent + XCirculateRequestEvent + XPropertyEvent + XSelectionClearEvent + XSelectionRequestEvent + XSelectionEvent + XColormapEvent + XClientMessageEvent + XMappingEvent + XErrorEvent + XKeymapEvent +; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! 11 - Event Handling Functions diff --git a/native/alien.c b/native/alien.c index 1700522fea..5e41b0839b 100644 --- a/native/alien.c +++ b/native/alien.c @@ -80,7 +80,10 @@ void primitive_displaced_alien(void) maybe_gc(sizeof(ALIEN)); alien = dpop(); displacement = unbox_unsigned_cell(); - dpush(tag_object(make_alien(alien,displacement))); + if(alien == F && displacement == 0) + dpush(F); + else + dpush(tag_object(make_alien(alien,displacement))); } /* address of an object representing a C pointer */