handle I/O on closed ports gracefully
Slava Pestov
parent
a97c50abd0
commit
6b3c4eccfb
|
|
@ -1,5 +1,6 @@
|
|||
- quot>interp needs to go
|
||||
- nodes: lazily create history, class/literal map hashes
|
||||
- delete no longer infers
|
||||
- write tests for callcc and catch inference
|
||||
|
||||
+ ui:
|
||||
|
||||
|
|
|
|||
|
|
@ -8,7 +8,7 @@ sequences sequences-internals words ;
|
|||
: pull-in ( ? list -- )
|
||||
swap [
|
||||
[
|
||||
dup print run-resource
|
||||
dup print [ dup run-resource ] try drop
|
||||
] each
|
||||
] [
|
||||
drop
|
||||
|
|
|
|||
|
|
@ -1,14 +1,14 @@
|
|||
! Copyright (C) 2003, 2004 Slava Pestov.
|
||||
! See http://factor.sf.net/license.txt for BSD license.
|
||||
IN: command-line
|
||||
USING: io kernel kernel-internals lists namespaces parser
|
||||
USING: errors io kernel kernel-internals lists namespaces parser
|
||||
sequences strings ;
|
||||
|
||||
! This file is run as the last stage of boot.factor; it relies
|
||||
! on all other words already being defined.
|
||||
|
||||
: ?run-file ( file -- )
|
||||
dup exists? [ run-file ] [ drop ] ifte ;
|
||||
dup exists? [ [ dup run-file ] try drop ] [ drop ] ifte ;
|
||||
|
||||
: run-user-init ( -- )
|
||||
#! Run user init file if it exists
|
||||
|
|
|
|||
|
|
@ -109,14 +109,6 @@ M: object peek ( sequence -- element )
|
|||
#! Get value at end of sequence and remove it.
|
||||
dup peek swap pop* ;
|
||||
|
||||
: adjoin ( elt seq -- )
|
||||
2dup member? [ 2drop ] [ push ] ifte ;
|
||||
|
||||
: prune ( seq -- seq )
|
||||
[
|
||||
dup length <vector> swap [ over adjoin ] each
|
||||
] keep like ; flushable
|
||||
|
||||
: join ( seq glue -- seq )
|
||||
#! The new sequence is of the same type as glue.
|
||||
swap dup empty? [
|
||||
|
|
|
|||
|
|
@ -3,30 +3,39 @@
|
|||
IN: kernel
|
||||
USING: arrays errors lists namespaces sequences words vectors ;
|
||||
|
||||
TUPLE: interp data call name catch ;
|
||||
TUPLE: continuation data c call name catch ;
|
||||
|
||||
: c-stack ( -- c-stack )
|
||||
#! In the interpreter, this is a no-op. The compiler has an
|
||||
#! an intrinsic for this word.
|
||||
f ;
|
||||
|
||||
: set-c-stack ( c-stack -- )
|
||||
[ "not supported" throw ] when ;
|
||||
|
||||
: continuation ( -- interp )
|
||||
#! The continuation is reified from after the *caller* of
|
||||
#! this word returns.
|
||||
datastack callstack dup pop* dup pop*
|
||||
namestack catchstack <interp> ;
|
||||
datastack c-stack callstack dup pop* dup pop*
|
||||
namestack catchstack <continuation> ; inline
|
||||
|
||||
: >interp< ( interp -- data call name catch )
|
||||
[ interp-data ] keep
|
||||
[ interp-call ] keep
|
||||
[ interp-name ] keep
|
||||
interp-catch ;
|
||||
: >continuation< ( continuation -- data c call name catch )
|
||||
[ continuation-data ] keep
|
||||
[ continuation-c ] keep
|
||||
[ continuation-call ] keep
|
||||
[ continuation-name ] keep
|
||||
continuation-catch ; inline
|
||||
|
||||
: continue ( continuation -- )
|
||||
#! Restore a continuation.
|
||||
>interp<
|
||||
set-catchstack set-namestack set-callstack set-datastack ;
|
||||
>continuation< set-catchstack set-namestack set-callstack
|
||||
>r set-datastack r> set-c-stack ;
|
||||
|
||||
: continue-with ( object continuation -- object )
|
||||
#! Restore a continuation, and place the object in the
|
||||
#! restored data stack.
|
||||
>interp< set-catchstack set-namestack
|
||||
>r swap >r set-datastack r> r> set-callstack ;
|
||||
>continuation< set-catchstack set-namestack set-callstack
|
||||
>r swap >r set-datastack r> r> set-c-stack ;
|
||||
|
||||
: (callcc) ( terminator balance -- | quot: continuation -- )
|
||||
#! Direct calls to this word will not compile correctly;
|
||||
|
|
@ -36,9 +45,8 @@ TUPLE: interp data call name catch ;
|
|||
#! The balance branch is never called, but it is there to
|
||||
#! give the callcc form a stack effect.
|
||||
>r >r
|
||||
continuation dup interp-call dup pop* pop*
|
||||
t r> r> ifte ;
|
||||
inline
|
||||
continuation dup continuation-call dup pop* pop*
|
||||
t r> r> ifte ; inline
|
||||
|
||||
: callcc0 ( quot -- | quot: continuation -- )
|
||||
#! Call a quotation with the current continuation, which may
|
||||
|
|
|
|||
|
|
@ -5,7 +5,7 @@ DEFER: callcc1
|
|||
DEFER: continue-with
|
||||
|
||||
IN: errors
|
||||
USING: kernel-internals lists ;
|
||||
USING: kernel-internals lists sequences ;
|
||||
|
||||
! This is a very lightweight exception handling system.
|
||||
|
||||
|
|
@ -20,13 +20,13 @@ TUPLE: no-method object generic ;
|
|||
: c> ( catch -- ) catchstack uncons set-catchstack ;
|
||||
|
||||
: (catch) ( try -- exception/f )
|
||||
[ >c call f c> drop f ] callcc1 nip ;
|
||||
[ >c call f c> drop f ] callcc1 nip ; inline
|
||||
|
||||
: catch ( try catch -- )
|
||||
#! Call the try quotation. If an error occurs restore the
|
||||
#! datastack, push the error, and call the catch block.
|
||||
#! If no error occurs, push f and call the catch block.
|
||||
>r (catch) r> call ;
|
||||
>r (catch) r> call ; inline
|
||||
|
||||
: rethrow ( error -- )
|
||||
#! Use rethrow when passing an error on from a catch block.
|
||||
|
|
|
|||
|
|
@ -39,14 +39,15 @@ SYMBOL: builtins
|
|||
#! Outputs a sequence of classes whose union is this class.
|
||||
[ (flatten) ] make-hash ;
|
||||
|
||||
DEFER: types
|
||||
|
||||
: (types) ( class -- )
|
||||
#! Only valid for a flattened class.
|
||||
dup superclass [ types % ] [ "type" word-prop , ] ?ifte ;
|
||||
flatten [
|
||||
car dup superclass
|
||||
[ (types) ] [ "type" word-prop dup set ] ?ifte
|
||||
] hash-each ;
|
||||
|
||||
: types ( class -- types )
|
||||
[ flatten hash-keys [ (types) ] each ] { } make prune ;
|
||||
[ (types) ] make-hash hash-keys ;
|
||||
|
||||
DEFER: class<
|
||||
|
||||
|
|
|
|||
|
|
@ -139,7 +139,7 @@ DEFER: show
|
|||
] show-final ;
|
||||
|
||||
: >callable ( quot|interp|f -- interp )
|
||||
dup interp? [
|
||||
dup continuation? [
|
||||
[ continue-with ] cons
|
||||
] when ;
|
||||
|
||||
|
|
|
|||
|
|
@ -510,3 +510,17 @@ prettyprint ;
|
|||
|
||||
\ array>vector [ [ array ] [ vector ] ] "infer-effect" set-word-prop
|
||||
\ array>vector t "flushable" set-word-prop
|
||||
|
||||
\ datastack [ [ ] [ vector ] ] "infer-effect" set-word-prop
|
||||
\ set-datastack [ [ vector ] [ ] ] "infer-effect" set-word-prop
|
||||
|
||||
\ callstack [ [ ] [ vector ] ] "infer-effect" set-word-prop
|
||||
\ set-callstack [ [ vector ] [ ] ] "infer-effect" set-word-prop
|
||||
|
||||
\ c-stack [
|
||||
"c-stack cannot be compiled (yet)" throw
|
||||
] "infer" set-word-prop
|
||||
|
||||
\ set-c-stack [
|
||||
"set-c-stack cannot be compiled (yet)" throw
|
||||
] "infer" set-word-prop
|
||||
|
|
|
|||
|
|
@ -13,22 +13,17 @@ sequences ;
|
|||
: SDL_EnableKeyRepeat ( delay interval -- )
|
||||
"int" "sdl" "SDL_EnableKeyRepeat" [ "int" "int" ] alien-invoke ;
|
||||
|
||||
: modifiers, ( mod -- )
|
||||
modifiers get [
|
||||
uncons pick bitand 0 = [ drop ] [ , ] ifte
|
||||
] each
|
||||
drop ;
|
||||
: modifier ( mod -- str )
|
||||
[ modifiers [ uncons rot bitand 0 > ?, ] each-with ] [ ] make ;
|
||||
|
||||
: keysym, ( sym -- )
|
||||
: keysym ( sym -- str )
|
||||
#! Return the original keysym number if its unknown.
|
||||
[ keysyms get hash dup ] keep ? , ;
|
||||
[ keysyms hash dup ] keep ? ;
|
||||
|
||||
: keyboard-event>binding ( event -- binding )
|
||||
#! Turn a key event into a binding, which is a list where
|
||||
#! all elements but the last one are modifier names looked
|
||||
#! up the modifiers alist, and the last element is a keysym
|
||||
#! look up in the keysyms hash.
|
||||
[
|
||||
dup keyboard-event-mod modifiers,
|
||||
keyboard-event-sym keysym,
|
||||
] [ ] make prune ;
|
||||
dup keyboard-event-mod modifier
|
||||
swap keyboard-event-sym keysym add ;
|
||||
|
|
|
|||
|
|
@ -5,267 +5,256 @@ IN: sdl USING: namespaces ;
|
|||
! Here we smash left/right control/shift/alt for convinience.
|
||||
! Later, something better needs to be done.
|
||||
|
||||
SYMBOL: modifiers
|
||||
: modifiers
|
||||
{
|
||||
[[ "SHIFT" HEX: 0003 ]]
|
||||
[[ "CTRL" HEX: 00c0 ]]
|
||||
[[ "ALT" HEX: 0300 ]]
|
||||
[[ "META" HEX: 0c00 ]]
|
||||
} ;
|
||||
|
||||
[
|
||||
[[ "SHIFT" HEX: 0001 ]]
|
||||
[[ "SHIFT" HEX: 0002 ]]
|
||||
[[ "CTRL" HEX: 0040 ]]
|
||||
[[ "CTRL" HEX: 0080 ]]
|
||||
[[ "ALT" HEX: 0100 ]]
|
||||
[[ "ALT" HEX: 0200 ]]
|
||||
[[ "META" HEX: 0400 ]]
|
||||
[[ "META" HEX: 0800 ]]
|
||||
! We ignore these two modifiers since they're mighty useless
|
||||
! [[ "NUM" HEX: 1000 ]]
|
||||
! [[ "CAPS" HEX: 2000 ]]
|
||||
[[ "MODE" HEX: 4000 ]]
|
||||
] modifiers set
|
||||
|
||||
SYMBOL: keysyms
|
||||
|
||||
{{
|
||||
! The keyboard syms have been cleverly chosen to map to ASCII
|
||||
[[ 0 "UNKNOWN" ]]
|
||||
! [[ 0 "FIRST" ]]
|
||||
[[ 8 "BACKSPACE" ]]
|
||||
[[ 9 "TAB" ]]
|
||||
[[ 12 "CLEAR" ]]
|
||||
[[ 13 "RETURN" ]]
|
||||
[[ 19 "PAUSE" ]]
|
||||
[[ 27 "ESCAPE" ]]
|
||||
[[ 32 "SPACE" ]]
|
||||
[[ 33 "EXCLAIM" ]]
|
||||
[[ 34 "QUOTEDBL" ]]
|
||||
[[ 35 "HASH" ]]
|
||||
[[ 36 "DOLLAR" ]]
|
||||
[[ 38 "AMPERSAND" ]]
|
||||
[[ 39 "QUOTE" ]]
|
||||
[[ 40 "LEFTPAREN" ]]
|
||||
[[ 41 "RIGHTPAREN" ]]
|
||||
[[ 42 "ASTERISK" ]]
|
||||
[[ 43 "PLUS" ]]
|
||||
[[ 44 "COMMA" ]]
|
||||
[[ 45 "MINUS" ]]
|
||||
[[ 46 "PERIOD" ]]
|
||||
[[ 47 "SLASH" ]]
|
||||
[[ 48 0 ]]
|
||||
[[ 49 1 ]]
|
||||
[[ 50 2 ]]
|
||||
[[ 51 3 ]]
|
||||
[[ 52 4 ]]
|
||||
[[ 53 5 ]]
|
||||
[[ 54 6 ]]
|
||||
[[ 55 7 ]]
|
||||
[[ 56 8 ]]
|
||||
[[ 57 9 ]]
|
||||
[[ 58 "COLON" ]]
|
||||
[[ 59 "SEMICOLON" ]]
|
||||
[[ 60 "LESS" ]]
|
||||
[[ 61 "EQUALS" ]]
|
||||
[[ 62 "GREATER" ]]
|
||||
[[ 63 "QUESTION" ]]
|
||||
[[ 64 "AT" ]]
|
||||
! Skip uppercase letters
|
||||
[[ 91 "LEFTBRACKET" ]]
|
||||
[[ 92 "BACKSLASH" ]]
|
||||
[[ 93 "RIGHTBRACKET" ]]
|
||||
[[ 94 "CARET" ]]
|
||||
[[ 95 "UNDERSCORE" ]]
|
||||
[[ 96 "BACKQUOTE" ]]
|
||||
[[ 97 "a" ]]
|
||||
[[ 98 "b" ]]
|
||||
[[ 99 "c" ]]
|
||||
[[ 100 "d" ]]
|
||||
[[ 101 "e" ]]
|
||||
[[ 102 "f" ]]
|
||||
[[ 103 "g" ]]
|
||||
[[ 104 "h" ]]
|
||||
[[ 105 "i" ]]
|
||||
[[ 106 "j" ]]
|
||||
[[ 107 "k" ]]
|
||||
[[ 108 "l" ]]
|
||||
[[ 109 "m" ]]
|
||||
[[ 110 "n" ]]
|
||||
[[ 111 "o" ]]
|
||||
[[ 112 "p" ]]
|
||||
[[ 113 "q" ]]
|
||||
[[ 114 "r" ]]
|
||||
[[ 115 "s" ]]
|
||||
[[ 116 "t" ]]
|
||||
[[ 117 "u" ]]
|
||||
[[ 118 "v" ]]
|
||||
[[ 119 "w" ]]
|
||||
[[ 120 "x" ]]
|
||||
[[ 121 "y" ]]
|
||||
[[ 122 "z" ]]
|
||||
[[ 127 "DELETE" ]]
|
||||
! End of ASCII mapped keysyms
|
||||
! International keyboard syms
|
||||
[[ 160 "WORLD_0" ]] ! 0xA0
|
||||
[[ 161 "WORLD_1" ]]
|
||||
[[ 162 "WORLD_2" ]]
|
||||
[[ 163 "WORLD_3" ]]
|
||||
[[ 164 "WORLD_4" ]]
|
||||
[[ 165 "WORLD_5" ]]
|
||||
[[ 166 "WORLD_6" ]]
|
||||
[[ 167 "WORLD_7" ]]
|
||||
[[ 168 "WORLD_8" ]]
|
||||
[[ 169 "WORLD_9" ]]
|
||||
[[ 170 "WORLD_10" ]]
|
||||
[[ 171 "WORLD_11" ]]
|
||||
[[ 172 "WORLD_12" ]]
|
||||
[[ 173 "WORLD_13" ]]
|
||||
[[ 174 "WORLD_14" ]]
|
||||
[[ 175 "WORLD_15" ]]
|
||||
[[ 176 "WORLD_16" ]]
|
||||
[[ 177 "WORLD_17" ]]
|
||||
[[ 178 "WORLD_18" ]]
|
||||
[[ 179 "WORLD_19" ]]
|
||||
[[ 180 "WORLD_20" ]]
|
||||
[[ 181 "WORLD_21" ]]
|
||||
[[ 182 "WORLD_22" ]]
|
||||
[[ 183 "WORLD_23" ]]
|
||||
[[ 184 "WORLD_24" ]]
|
||||
[[ 185 "WORLD_25" ]]
|
||||
[[ 186 "WORLD_26" ]]
|
||||
[[ 187 "WORLD_27" ]]
|
||||
[[ 188 "WORLD_28" ]]
|
||||
[[ 189 "WORLD_29" ]]
|
||||
[[ 190 "WORLD_30" ]]
|
||||
[[ 191 "WORLD_31" ]]
|
||||
[[ 192 "WORLD_32" ]]
|
||||
[[ 193 "WORLD_33" ]]
|
||||
[[ 194 "WORLD_34" ]]
|
||||
[[ 195 "WORLD_35" ]]
|
||||
[[ 196 "WORLD_36" ]]
|
||||
[[ 197 "WORLD_37" ]]
|
||||
[[ 198 "WORLD_38" ]]
|
||||
[[ 199 "WORLD_39" ]]
|
||||
[[ 200 "WORLD_40" ]]
|
||||
[[ 201 "WORLD_41" ]]
|
||||
[[ 202 "WORLD_42" ]]
|
||||
[[ 203 "WORLD_43" ]]
|
||||
[[ 204 "WORLD_44" ]]
|
||||
[[ 205 "WORLD_45" ]]
|
||||
[[ 206 "WORLD_46" ]]
|
||||
[[ 207 "WORLD_47" ]]
|
||||
[[ 208 "WORLD_48" ]]
|
||||
[[ 209 "WORLD_49" ]]
|
||||
[[ 210 "WORLD_50" ]]
|
||||
[[ 211 "WORLD_51" ]]
|
||||
[[ 212 "WORLD_52" ]]
|
||||
[[ 213 "WORLD_53" ]]
|
||||
[[ 214 "WORLD_54" ]]
|
||||
[[ 215 "WORLD_55" ]]
|
||||
[[ 216 "WORLD_56" ]]
|
||||
[[ 217 "WORLD_57" ]]
|
||||
[[ 218 "WORLD_58" ]]
|
||||
[[ 219 "WORLD_59" ]]
|
||||
[[ 220 "WORLD_60" ]]
|
||||
[[ 221 "WORLD_61" ]]
|
||||
[[ 222 "WORLD_62" ]]
|
||||
[[ 223 "WORLD_63" ]]
|
||||
[[ 224 "WORLD_64" ]]
|
||||
[[ 225 "WORLD_65" ]]
|
||||
[[ 226 "WORLD_66" ]]
|
||||
[[ 227 "WORLD_67" ]]
|
||||
[[ 228 "WORLD_68" ]]
|
||||
[[ 229 "WORLD_69" ]]
|
||||
[[ 230 "WORLD_70" ]]
|
||||
[[ 231 "WORLD_71" ]]
|
||||
[[ 232 "WORLD_72" ]]
|
||||
[[ 233 "WORLD_73" ]]
|
||||
[[ 234 "WORLD_74" ]]
|
||||
[[ 235 "WORLD_75" ]]
|
||||
[[ 236 "WORLD_76" ]]
|
||||
[[ 237 "WORLD_77" ]]
|
||||
[[ 238 "WORLD_78" ]]
|
||||
[[ 239 "WORLD_79" ]]
|
||||
[[ 240 "WORLD_80" ]]
|
||||
[[ 241 "WORLD_81" ]]
|
||||
[[ 242 "WORLD_82" ]]
|
||||
[[ 243 "WORLD_83" ]]
|
||||
[[ 244 "WORLD_84" ]]
|
||||
[[ 245 "WORLD_85" ]]
|
||||
[[ 246 "WORLD_86" ]]
|
||||
[[ 247 "WORLD_87" ]]
|
||||
[[ 248 "WORLD_88" ]]
|
||||
[[ 249 "WORLD_89" ]]
|
||||
[[ 250 "WORLD_90" ]]
|
||||
[[ 251 "WORLD_91" ]]
|
||||
[[ 252 "WORLD_92" ]]
|
||||
[[ 253 "WORLD_93" ]]
|
||||
[[ 254 "WORLD_94" ]]
|
||||
[[ 255 "WORLD_95" ]] ! 0xFF
|
||||
! Numeric keypad
|
||||
[[ 256 "KP0" ]]
|
||||
[[ 257 "KP1" ]]
|
||||
[[ 258 "KP2" ]]
|
||||
[[ 259 "KP3" ]]
|
||||
[[ 260 "KP4" ]]
|
||||
[[ 261 "KP5" ]]
|
||||
[[ 262 "KP6" ]]
|
||||
[[ 263 "KP7" ]]
|
||||
[[ 264 "KP8" ]]
|
||||
[[ 265 "KP9" ]]
|
||||
[[ 266 "KP_PERIOD" ]]
|
||||
[[ 267 "KP_DIVIDE" ]]
|
||||
[[ 268 "KP_MULTIPLY" ]]
|
||||
[[ 269 "KP_MINUS" ]]
|
||||
[[ 270 "KP_PLUS" ]]
|
||||
[[ 271 "KP_ENTER" ]]
|
||||
[[ 272 "KP_EQUALS" ]]
|
||||
! Arrows + Home/End pad
|
||||
[[ 273 "UP" ]]
|
||||
[[ 274 "DOWN" ]]
|
||||
[[ 275 "RIGHT" ]]
|
||||
[[ 276 "LEFT" ]]
|
||||
[[ 277 "INSERT" ]]
|
||||
[[ 278 "HOME" ]]
|
||||
[[ 279 "END" ]]
|
||||
[[ 280 "PAGEUP" ]]
|
||||
[[ 281 "PAGEDOWN" ]]
|
||||
! Function keys
|
||||
[[ 282 "F1" ]]
|
||||
[[ 283 "F2" ]]
|
||||
[[ 284 "F3" ]]
|
||||
[[ 285 "F4" ]]
|
||||
[[ 286 "F5" ]]
|
||||
[[ 287 "F6" ]]
|
||||
[[ 288 "F7" ]]
|
||||
[[ 289 "F8" ]]
|
||||
[[ 290 "F9" ]]
|
||||
[[ 291 "F10" ]]
|
||||
[[ 292 "F11" ]]
|
||||
[[ 293 "F12" ]]
|
||||
[[ 294 "F13" ]]
|
||||
[[ 295 "F14" ]]
|
||||
[[ 296 "F15" ]]
|
||||
! Key state modifier keys
|
||||
[[ 300 "NUMLOCK" ]]
|
||||
[[ 301 "CAPSLOCK" ]]
|
||||
[[ 302 "SCROLLOCK" ]]
|
||||
[[ 303 "RSHIFT" ]]
|
||||
[[ 304 "LSHIFT" ]]
|
||||
[[ 305 "RCTRL" ]]
|
||||
[[ 306 "LCTRL" ]]
|
||||
[[ 307 "RALT" ]]
|
||||
[[ 308 "LALT" ]]
|
||||
[[ 309 "RMETA" ]]
|
||||
[[ 310 "LMETA" ]]
|
||||
[[ 311 "LSUPER" ]] ! Left "Windows" key
|
||||
[[ 312 "RSUPER" ]] ! Right "Windows" key
|
||||
[[ 313 "MODE" ]] ! "Alt Gr" key
|
||||
[[ 314 "COMPOSE" ]] ! Multi-key compose key
|
||||
! Miscellaneous function keys
|
||||
[[ 315 "HELP" ]]
|
||||
[[ 316 "PRINT" ]]
|
||||
[[ 317 "SYSREQ" ]]
|
||||
[[ 318 "BREAK" ]]
|
||||
[[ 319 "MENU" ]]
|
||||
[[ 320 "POWER" ]] ! Power Macintosh power key
|
||||
[[ 321 "EURO" ]] ! Some european keyboards
|
||||
[[ 322 "UNDO" ]] ! Atari keyboard has Undo
|
||||
! Add any other keys here
|
||||
}} keysyms set
|
||||
: keysyms
|
||||
{{
|
||||
! The keyboard syms have been cleverly chosen to map to ASCII
|
||||
[[ 0 "UNKNOWN" ]]
|
||||
[[ 8 "BACKSPACE" ]]
|
||||
[[ 9 "TAB" ]]
|
||||
[[ 12 "CLEAR" ]]
|
||||
[[ 13 "RETURN" ]]
|
||||
[[ 19 "PAUSE" ]]
|
||||
[[ 27 "ESCAPE" ]]
|
||||
[[ 32 "SPACE" ]]
|
||||
[[ 33 "EXCLAIM" ]]
|
||||
[[ 34 "QUOTEDBL" ]]
|
||||
[[ 35 "HASH" ]]
|
||||
[[ 36 "DOLLAR" ]]
|
||||
[[ 38 "AMPERSAND" ]]
|
||||
[[ 39 "QUOTE" ]]
|
||||
[[ 40 "LEFTPAREN" ]]
|
||||
[[ 41 "RIGHTPAREN" ]]
|
||||
[[ 42 "ASTERISK" ]]
|
||||
[[ 43 "PLUS" ]]
|
||||
[[ 44 "COMMA" ]]
|
||||
[[ 45 "MINUS" ]]
|
||||
[[ 46 "PERIOD" ]]
|
||||
[[ 47 "SLASH" ]]
|
||||
[[ 48 0 ]]
|
||||
[[ 49 1 ]]
|
||||
[[ 50 2 ]]
|
||||
[[ 51 3 ]]
|
||||
[[ 52 4 ]]
|
||||
[[ 53 5 ]]
|
||||
[[ 54 6 ]]
|
||||
[[ 55 7 ]]
|
||||
[[ 56 8 ]]
|
||||
[[ 57 9 ]]
|
||||
[[ 58 "COLON" ]]
|
||||
[[ 59 "SEMICOLON" ]]
|
||||
[[ 60 "LESS" ]]
|
||||
[[ 61 "EQUALS" ]]
|
||||
[[ 62 "GREATER" ]]
|
||||
[[ 63 "QUESTION" ]]
|
||||
[[ 64 "AT" ]]
|
||||
! Skip uppercase letters
|
||||
[[ 91 "LEFTBRACKET" ]]
|
||||
[[ 92 "BACKSLASH" ]]
|
||||
[[ 93 "RIGHTBRACKET" ]]
|
||||
[[ 94 "CARET" ]]
|
||||
[[ 95 "UNDERSCORE" ]]
|
||||
[[ 96 "BACKQUOTE" ]]
|
||||
[[ 97 "a" ]]
|
||||
[[ 98 "b" ]]
|
||||
[[ 99 "c" ]]
|
||||
[[ 100 "d" ]]
|
||||
[[ 101 "e" ]]
|
||||
[[ 102 "f" ]]
|
||||
[[ 103 "g" ]]
|
||||
[[ 104 "h" ]]
|
||||
[[ 105 "i" ]]
|
||||
[[ 106 "j" ]]
|
||||
[[ 107 "k" ]]
|
||||
[[ 108 "l" ]]
|
||||
[[ 109 "m" ]]
|
||||
[[ 110 "n" ]]
|
||||
[[ 111 "o" ]]
|
||||
[[ 112 "p" ]]
|
||||
[[ 113 "q" ]]
|
||||
[[ 114 "r" ]]
|
||||
[[ 115 "s" ]]
|
||||
[[ 116 "t" ]]
|
||||
[[ 117 "u" ]]
|
||||
[[ 118 "v" ]]
|
||||
[[ 119 "w" ]]
|
||||
[[ 120 "x" ]]
|
||||
[[ 121 "y" ]]
|
||||
[[ 122 "z" ]]
|
||||
[[ 127 "DELETE" ]]
|
||||
! End of ASCII mapped keysyms
|
||||
! International keyboard syms
|
||||
[[ 160 "WORLD_0" ]] ! 0xA0
|
||||
[[ 161 "WORLD_1" ]]
|
||||
[[ 162 "WORLD_2" ]]
|
||||
[[ 163 "WORLD_3" ]]
|
||||
[[ 164 "WORLD_4" ]]
|
||||
[[ 165 "WORLD_5" ]]
|
||||
[[ 166 "WORLD_6" ]]
|
||||
[[ 167 "WORLD_7" ]]
|
||||
[[ 168 "WORLD_8" ]]
|
||||
[[ 169 "WORLD_9" ]]
|
||||
[[ 170 "WORLD_10" ]]
|
||||
[[ 171 "WORLD_11" ]]
|
||||
[[ 172 "WORLD_12" ]]
|
||||
[[ 173 "WORLD_13" ]]
|
||||
[[ 174 "WORLD_14" ]]
|
||||
[[ 175 "WORLD_15" ]]
|
||||
[[ 176 "WORLD_16" ]]
|
||||
[[ 177 "WORLD_17" ]]
|
||||
[[ 178 "WORLD_18" ]]
|
||||
[[ 179 "WORLD_19" ]]
|
||||
[[ 180 "WORLD_20" ]]
|
||||
[[ 181 "WORLD_21" ]]
|
||||
[[ 182 "WORLD_22" ]]
|
||||
[[ 183 "WORLD_23" ]]
|
||||
[[ 184 "WORLD_24" ]]
|
||||
[[ 185 "WORLD_25" ]]
|
||||
[[ 186 "WORLD_26" ]]
|
||||
[[ 187 "WORLD_27" ]]
|
||||
[[ 188 "WORLD_28" ]]
|
||||
[[ 189 "WORLD_29" ]]
|
||||
[[ 190 "WORLD_30" ]]
|
||||
[[ 191 "WORLD_31" ]]
|
||||
[[ 192 "WORLD_32" ]]
|
||||
[[ 193 "WORLD_33" ]]
|
||||
[[ 194 "WORLD_34" ]]
|
||||
[[ 195 "WORLD_35" ]]
|
||||
[[ 196 "WORLD_36" ]]
|
||||
[[ 197 "WORLD_37" ]]
|
||||
[[ 198 "WORLD_38" ]]
|
||||
[[ 199 "WORLD_39" ]]
|
||||
[[ 200 "WORLD_40" ]]
|
||||
[[ 201 "WORLD_41" ]]
|
||||
[[ 202 "WORLD_42" ]]
|
||||
[[ 203 "WORLD_43" ]]
|
||||
[[ 204 "WORLD_44" ]]
|
||||
[[ 205 "WORLD_45" ]]
|
||||
[[ 206 "WORLD_46" ]]
|
||||
[[ 207 "WORLD_47" ]]
|
||||
[[ 208 "WORLD_48" ]]
|
||||
[[ 209 "WORLD_49" ]]
|
||||
[[ 210 "WORLD_50" ]]
|
||||
[[ 211 "WORLD_51" ]]
|
||||
[[ 212 "WORLD_52" ]]
|
||||
[[ 213 "WORLD_53" ]]
|
||||
[[ 214 "WORLD_54" ]]
|
||||
[[ 215 "WORLD_55" ]]
|
||||
[[ 216 "WORLD_56" ]]
|
||||
[[ 217 "WORLD_57" ]]
|
||||
[[ 218 "WORLD_58" ]]
|
||||
[[ 219 "WORLD_59" ]]
|
||||
[[ 220 "WORLD_60" ]]
|
||||
[[ 221 "WORLD_61" ]]
|
||||
[[ 222 "WORLD_62" ]]
|
||||
[[ 223 "WORLD_63" ]]
|
||||
[[ 224 "WORLD_64" ]]
|
||||
[[ 225 "WORLD_65" ]]
|
||||
[[ 226 "WORLD_66" ]]
|
||||
[[ 227 "WORLD_67" ]]
|
||||
[[ 228 "WORLD_68" ]]
|
||||
[[ 229 "WORLD_69" ]]
|
||||
[[ 230 "WORLD_70" ]]
|
||||
[[ 231 "WORLD_71" ]]
|
||||
[[ 232 "WORLD_72" ]]
|
||||
[[ 233 "WORLD_73" ]]
|
||||
[[ 234 "WORLD_74" ]]
|
||||
[[ 235 "WORLD_75" ]]
|
||||
[[ 236 "WORLD_76" ]]
|
||||
[[ 237 "WORLD_77" ]]
|
||||
[[ 238 "WORLD_78" ]]
|
||||
[[ 239 "WORLD_79" ]]
|
||||
[[ 240 "WORLD_80" ]]
|
||||
[[ 241 "WORLD_81" ]]
|
||||
[[ 242 "WORLD_82" ]]
|
||||
[[ 243 "WORLD_83" ]]
|
||||
[[ 244 "WORLD_84" ]]
|
||||
[[ 245 "WORLD_85" ]]
|
||||
[[ 246 "WORLD_86" ]]
|
||||
[[ 247 "WORLD_87" ]]
|
||||
[[ 248 "WORLD_88" ]]
|
||||
[[ 249 "WORLD_89" ]]
|
||||
[[ 250 "WORLD_90" ]]
|
||||
[[ 251 "WORLD_91" ]]
|
||||
[[ 252 "WORLD_92" ]]
|
||||
[[ 253 "WORLD_93" ]]
|
||||
[[ 254 "WORLD_94" ]]
|
||||
[[ 255 "WORLD_95" ]] ! 0xFF
|
||||
! Numeric keypad
|
||||
[[ 256 "KP0" ]]
|
||||
[[ 257 "KP1" ]]
|
||||
[[ 258 "KP2" ]]
|
||||
[[ 259 "KP3" ]]
|
||||
[[ 260 "KP4" ]]
|
||||
[[ 261 "KP5" ]]
|
||||
[[ 262 "KP6" ]]
|
||||
[[ 263 "KP7" ]]
|
||||
[[ 264 "KP8" ]]
|
||||
[[ 265 "KP9" ]]
|
||||
[[ 266 "KP_PERIOD" ]]
|
||||
[[ 267 "KP_DIVIDE" ]]
|
||||
[[ 268 "KP_MULTIPLY" ]]
|
||||
[[ 269 "KP_MINUS" ]]
|
||||
[[ 270 "KP_PLUS" ]]
|
||||
[[ 271 "KP_ENTER" ]]
|
||||
[[ 272 "KP_EQUALS" ]]
|
||||
! Arrows + Home/End pad
|
||||
[[ 273 "UP" ]]
|
||||
[[ 274 "DOWN" ]]
|
||||
[[ 275 "RIGHT" ]]
|
||||
[[ 276 "LEFT" ]]
|
||||
[[ 277 "INSERT" ]]
|
||||
[[ 278 "HOME" ]]
|
||||
[[ 279 "END" ]]
|
||||
[[ 280 "PAGEUP" ]]
|
||||
[[ 281 "PAGEDOWN" ]]
|
||||
! Function keys
|
||||
[[ 282 "F1" ]]
|
||||
[[ 283 "F2" ]]
|
||||
[[ 284 "F3" ]]
|
||||
[[ 285 "F4" ]]
|
||||
[[ 286 "F5" ]]
|
||||
[[ 287 "F6" ]]
|
||||
[[ 288 "F7" ]]
|
||||
[[ 289 "F8" ]]
|
||||
[[ 290 "F9" ]]
|
||||
[[ 291 "F10" ]]
|
||||
[[ 292 "F11" ]]
|
||||
[[ 293 "F12" ]]
|
||||
[[ 294 "F13" ]]
|
||||
[[ 295 "F14" ]]
|
||||
[[ 296 "F15" ]]
|
||||
! Key state modifier keys
|
||||
[[ 300 "NUMLOCK" ]]
|
||||
[[ 301 "CAPSLOCK" ]]
|
||||
[[ 302 "SCROLLOCK" ]]
|
||||
[[ 303 "RSHIFT" ]]
|
||||
[[ 304 "LSHIFT" ]]
|
||||
[[ 305 "RCTRL" ]]
|
||||
[[ 306 "LCTRL" ]]
|
||||
[[ 307 "RALT" ]]
|
||||
[[ 308 "LALT" ]]
|
||||
[[ 309 "RMETA" ]]
|
||||
[[ 310 "LMETA" ]]
|
||||
[[ 311 "LSUPER" ]] ! Left "Windows" key
|
||||
[[ 312 "RSUPER" ]] ! Right "Windows" key
|
||||
[[ 313 "MODE" ]] ! "Alt Gr" key
|
||||
[[ 314 "COMPOSE" ]] ! Multi-key compose key
|
||||
! Miscellaneous function keys
|
||||
[[ 315 "HELP" ]]
|
||||
[[ 316 "PRINT" ]]
|
||||
[[ 317 "SYSREQ" ]]
|
||||
[[ 318 "BREAK" ]]
|
||||
[[ 319 "MENU" ]]
|
||||
[[ 320 "POWER" ]] ! Power Macintosh power key
|
||||
[[ 321 "EURO" ]] ! Some european keyboards
|
||||
[[ 322 "UNDO" ]] ! Atari keyboard has Undo
|
||||
! Add any other keys here
|
||||
}} ;
|
||||
|
|
|
|||
|
|
@ -64,8 +64,6 @@ unit-test
|
|||
[ @{ @{ 1 4 }@ @{ 2 5 }@ @{ 3 6 }@ }@ ]
|
||||
[ @{ @{ 1 2 3 }@ @{ 4 5 6 }@ }@ flip ] unit-test
|
||||
|
||||
[ [ "a" 43 [ ] ] ] [ [ "a" 43 43 43 [ ] 43 "a" [ ] ] prune ] unit-test
|
||||
|
||||
[ f ] [ [ { } { } "Hello" ] all-equal? ] unit-test
|
||||
[ f ] [ [ { 2 } { } { } ] all-equal? ] unit-test
|
||||
[ t ] [ [ ] all-equal? ] unit-test
|
||||
|
|
|
|||
|
|
@ -31,14 +31,6 @@ USE: test
|
|||
: multishot-test ( -- stack )
|
||||
[
|
||||
dup "cc" set 5 swap continue-with
|
||||
] callcc1 "cc" get interp-data ;
|
||||
] callcc1 "cc" get continuation-data ;
|
||||
|
||||
[ 5 { } ] [ multishot-test ] unit-test
|
||||
|
||||
[ ] [
|
||||
[
|
||||
global [ "x" set ] bind
|
||||
[ global [ "x" get ] bind continue ] quot>interp
|
||||
continue
|
||||
] callcc0 global [ "x" off ] bind
|
||||
] unit-test
|
||||
|
|
|
|||
|
|
@ -223,7 +223,6 @@ DEFER: agent
|
|||
[ @{ 1 1 }@ ] [ [ reverse ] infer ] unit-test
|
||||
[ @{ 2 1 }@ ] [ [ member? ] infer ] unit-test
|
||||
[ @{ 2 1 }@ ] [ [ remove ] infer ] unit-test
|
||||
[ @{ 1 1 }@ ] [ [ prune ] infer ] unit-test
|
||||
|
||||
: bad-code "1234" car ;
|
||||
|
||||
|
|
|
|||
|
|
@ -45,15 +45,17 @@ SYMBOL: meta-executing
|
|||
meta-cf get [ meta-cf [ uncons ] change ] [ up next ] ifte ;
|
||||
|
||||
: meta-interp ( -- interp )
|
||||
meta-d get meta-r get meta-n get meta-c get <interp> ;
|
||||
meta-d get f meta-r get meta-n get meta-c get
|
||||
<continuation> ;
|
||||
|
||||
: set-meta-interp ( interp -- )
|
||||
>interp< meta-c set meta-n set meta-r set meta-d set ;
|
||||
>continuation<
|
||||
meta-c set meta-n set meta-r set drop meta-d set ;
|
||||
|
||||
: host-word ( word -- )
|
||||
[
|
||||
\ call push-r continuation [
|
||||
continuation over interp-data push continue
|
||||
continuation over continuation-data push continue
|
||||
] cons cons push-r meta-interp continue
|
||||
] call set-meta-interp pop-d 2drop ;
|
||||
|
||||
|
|
|
|||
|
|
@ -25,7 +25,7 @@ C: hand ( world -- hand )
|
|||
dup hand-gadget over set-hand-clicked
|
||||
dup screen-loc over set-hand-click-loc
|
||||
dup hand-gadget over relative over set-hand-click-rel
|
||||
hand-buttons adjoin ;
|
||||
hand-buttons push ;
|
||||
|
||||
: button\ ( n hand -- )
|
||||
hand-buttons delete ;
|
||||
|
|
|
|||
|
|
@ -2,8 +2,8 @@
|
|||
! See http://factor.sf.net/license.txt for BSD license.
|
||||
IN: io-internals
|
||||
USING: alien arrays compiler-backend errors generic hashtables
|
||||
io kernel kernel-internals lists math parser sequences
|
||||
strings threads unix-internals vectors ;
|
||||
io kernel kernel-internals lists math parser sequences strings
|
||||
threads unix-internals vectors words ;
|
||||
|
||||
! We want namespaces::bind to shadow the bind system call from
|
||||
! unix-internals
|
||||
|
|
@ -49,7 +49,19 @@ SYMBOL: write-tasks
|
|||
: init-handle ( fd -- ) F_SETFL O_NONBLOCK fcntl io-error ;
|
||||
|
||||
! Common delegate of native stream readers and writers
|
||||
TUPLE: port handle buffer error timeout cutoff output? sbuf eof? ;
|
||||
SYMBOL: input
|
||||
SYMBOL: output
|
||||
SYMBOL: closed
|
||||
|
||||
TUPLE: port handle error timeout cutoff type sbuf eof? ;
|
||||
|
||||
: check-port ( port expected -- )
|
||||
>r port-type r> 2dup eq? [
|
||||
[
|
||||
"Cannot perform " % word-name %
|
||||
" on " % word-name % " port" %
|
||||
] "" make throw
|
||||
] unless 2drop ;
|
||||
|
||||
: make-buffer ( n -- buffer/f )
|
||||
dup 0 > [ <buffer> ] [ drop f ] ifte ;
|
||||
|
|
@ -150,7 +162,7 @@ GENERIC: task-container ( task -- vector )
|
|||
! Readers
|
||||
|
||||
: <reader> ( fd -- stream )
|
||||
buffered-port <line-reader> ;
|
||||
buffered-port input over set-port-type <line-reader> ;
|
||||
|
||||
: open-read ( path -- fd )
|
||||
O_RDONLY file-mode open dup io-error ;
|
||||
|
|
@ -212,10 +224,12 @@ M: read-task task-container drop read-tasks get ;
|
|||
] unless 2drop ;
|
||||
|
||||
M: port stream-read ( count stream -- string )
|
||||
dup input check-port
|
||||
[ wait-to-read ] keep dup port-eof?
|
||||
[ drop f ] [ port-sbuf >string ] ifte ;
|
||||
|
||||
M: port stream-read1 ( stream -- char/f )
|
||||
dup input check-port
|
||||
1 over wait-to-read dup port-eof?
|
||||
[ drop f ] [ port-sbuf first ] ifte ;
|
||||
|
||||
|
|
@ -226,7 +240,7 @@ M: port stream-read1 ( stream -- char/f )
|
|||
dup io-error ;
|
||||
|
||||
: <writer> ( fd -- writer )
|
||||
buffered-port t over set-port-output? ;
|
||||
buffered-port output over set-port-type ;
|
||||
|
||||
: write-step ( port -- )
|
||||
dup >port< dup buffer@ swap buffer-length write dup 0 >= [
|
||||
|
|
@ -272,25 +286,30 @@ M: write-task task-container drop write-tasks get ;
|
|||
] ifte* ;
|
||||
|
||||
M: port stream-flush ( stream -- )
|
||||
dup port-output? [
|
||||
[ swap <write-task> add-write-io-task stop ] callcc0
|
||||
] when drop ;
|
||||
dup output check-port
|
||||
[ swap <write-task> add-write-io-task stop ] callcc0 drop ;
|
||||
|
||||
M: port stream-finish ( stream -- ) drop ;
|
||||
M: port stream-finish ( stream -- ) output check-port ;
|
||||
|
||||
: wait-to-write ( len port -- )
|
||||
tuck can-write? [ dup stream-flush ] unless pending-error ;
|
||||
|
||||
M: port stream-write1 ( char writer -- )
|
||||
dup output check-port
|
||||
1 over wait-to-write ch>buffer ;
|
||||
|
||||
M: port stream-format ( string style writer -- )
|
||||
dup output check-port
|
||||
nip over length over wait-to-write >buffer ;
|
||||
|
||||
M: port stream-close ( stream -- )
|
||||
dup stream-flush
|
||||
dup port-handle close
|
||||
delegate [ buffer-free ] when* ;
|
||||
dup port-type closed eq? [
|
||||
dup port-type output eq? [ dup stream-flush ] when
|
||||
dup port-handle close
|
||||
dup delegate [ buffer-free ] when*
|
||||
f over set-delegate
|
||||
closed over set-port-type
|
||||
] unless drop ;
|
||||
|
||||
! Make a duplex stream for reading/writing a pair of fds
|
||||
|
||||
|
|
|
|||
|
|
@ -67,7 +67,8 @@ TUPLE: server client ;
|
|||
|
||||
C: server ( port -- server )
|
||||
#! Starts listening for TCP connections on localhost:port.
|
||||
[ >r server-socket 0 <port> r> set-delegate ] keep ;
|
||||
[ >r server-socket 0 <port> r> set-delegate ] keep
|
||||
server over set-port-type ;
|
||||
|
||||
IN: io-internals
|
||||
USE: unix-internals
|
||||
|
|
|
|||
|
|
@ -24,9 +24,11 @@ M: word set-word-xt ( xt w -- ) 7 set-integer-slot ;
|
|||
#! Outputs a list of words that this word directly calls.
|
||||
[
|
||||
dup word-def [
|
||||
dup word? [ 2dup eq? [ dup , ] unless ] when 2drop
|
||||
dup word?
|
||||
[ 2dup eq? [ dup dup set ] unless ] when
|
||||
2drop
|
||||
] tree-each-with
|
||||
] { } make prune ;
|
||||
] make-hash hash-keys ;
|
||||
|
||||
! The cross-referencer keeps track of word dependencies, so that
|
||||
! words can be recompiled when redefined.
|
||||
|
|
|
|||
Loading…
Reference in New Issue