Continuation.st
author Stefan Vogel <sv@exept.de>
Wed, 22 Sep 2004 16:42:22 +0200
changeset 8586 a38e882affa5
parent 8582 115869898a97
child 8596 5433434a9bf0
permissions -rw-r--r--
take care of time-wrap in #millisecondsToRun:
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
8554
8fc9c321feb8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8553
diff changeset
     1
"
8fc9c321feb8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8553
diff changeset
     2
 COPYRIGHT (c) 2004 by eXept Software AG
8fc9c321feb8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8553
diff changeset
     3
              All Rights Reserved
8fc9c321feb8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8553
diff changeset
     4
8fc9c321feb8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8553
diff changeset
     5
 This software is furnished under a license and may be used
8fc9c321feb8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8553
diff changeset
     6
 only in accordance with the terms of that license and with the
8fc9c321feb8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8553
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
8fc9c321feb8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8553
diff changeset
     8
 be provided or otherwise made available to, or used by, any
8fc9c321feb8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8553
diff changeset
     9
 other person.  No title to or ownership of the software is
8fc9c321feb8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8553
diff changeset
    10
 hereby transferred.
8fc9c321feb8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8553
diff changeset
    11
"
8fc9c321feb8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8553
diff changeset
    12
8553
1cf4acd5102a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    13
"{ Package: 'stx:libbasic' }"
1cf4acd5102a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    14
1cf4acd5102a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    15
Object subclass:#Continuation
1cf4acd5102a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    16
	instanceVariableNames:'process id suspendContext'
1cf4acd5102a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    17
	classVariableNames:''
1cf4acd5102a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    18
	poolDictionaries:''
1cf4acd5102a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    19
	category:'Kernel-Processes'
1cf4acd5102a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    20
!
1cf4acd5102a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    21
8554
8fc9c321feb8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8553
diff changeset
    22
!Continuation class methodsFor:'documentation'!
8fc9c321feb8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8553
diff changeset
    23
8fc9c321feb8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8553
diff changeset
    24
copyright
8fc9c321feb8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8553
diff changeset
    25
"
8fc9c321feb8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8553
diff changeset
    26
 COPYRIGHT (c) 2004 by eXept Software AG
8fc9c321feb8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8553
diff changeset
    27
              All Rights Reserved
8fc9c321feb8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8553
diff changeset
    28
8fc9c321feb8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8553
diff changeset
    29
 This software is furnished under a license and may be used
8fc9c321feb8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8553
diff changeset
    30
 only in accordance with the terms of that license and with the
8fc9c321feb8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8553
diff changeset
    31
 inclusion of the above copyright notice.   This software may not
8fc9c321feb8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8553
diff changeset
    32
 be provided or otherwise made available to, or used by, any
8fc9c321feb8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8553
diff changeset
    33
 other person.  No title to or ownership of the software is
8fc9c321feb8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8553
diff changeset
    34
 hereby transferred.
8fc9c321feb8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8553
diff changeset
    35
"
8fc9c321feb8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8553
diff changeset
    36
!
8fc9c321feb8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8553
diff changeset
    37
8fc9c321feb8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8553
diff changeset
    38
documentation
8fc9c321feb8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8553
diff changeset
    39
"
8fc9c321feb8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8553
diff changeset
    40
    Initial attempt - Contnuations do not work yet.
8fc9c321feb8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8553
diff changeset
    41
8fc9c321feb8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8553
diff changeset
    42
    [Instance variables:]
8fc9c321feb8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8553
diff changeset
    43
8fc9c321feb8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8553
diff changeset
    44
        id                     <SmallInteger>   a unique continuation-id;
8fc9c321feb8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8553
diff changeset
    45
                                                Used to identify a corresponding 
8fc9c321feb8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8553
diff changeset
    46
                                                data-structure in the VM.
8fc9c321feb8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8553
diff changeset
    47
8fc9c321feb8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8553
diff changeset
    48
        process                <Process>        the process which created this continuation.
8fc9c321feb8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8553
diff changeset
    49
8fc9c321feb8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8553
diff changeset
    50
    [Class variables:]
8fc9c321feb8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8553
diff changeset
    51
8fc9c321feb8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8553
diff changeset
    52
    [see also:]
8fc9c321feb8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8553
diff changeset
    53
        Process Context Block
8fc9c321feb8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8553
diff changeset
    54
8fc9c321feb8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8553
diff changeset
    55
    [author:]
8fc9c321feb8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8553
diff changeset
    56
        Claus Gittinger
8fc9c321feb8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8553
diff changeset
    57
"
8582
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
    58
!
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
    59
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
    60
supported
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
    61
    ^ false
8554
8fc9c321feb8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8553
diff changeset
    62
! !
8553
1cf4acd5102a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    63
8557
931a24890c1f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8554
diff changeset
    64
!Continuation class methodsFor:'instance creation'!
931a24890c1f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8554
diff changeset
    65
8582
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
    66
current
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
    67
	^ self fromContext: thisContext sender
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
    68
!
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
    69
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
    70
currentDo: aBlock
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
    71
	^ aBlock value: (self fromContext: thisContext sender)
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
    72
!
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
    73
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
    74
fromContext: aStack
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
    75
	^self new initializeFromContext: aStack
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
    76
!
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
    77
8557
931a24890c1f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8554
diff changeset
    78
new
931a24890c1f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8554
diff changeset
    79
    |cont id|
931a24890c1f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8554
diff changeset
    80
8558
09e2910c1e4f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8557
diff changeset
    81
    cont := super new.
8557
931a24890c1f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8554
diff changeset
    82
%{
931a24890c1f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8554
diff changeset
    83
    int __cId;
8559
aca77c69cd91 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8558
diff changeset
    84
    extern int __continuationCreate();
8557
931a24890c1f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8554
diff changeset
    85
8559
aca77c69cd91 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8558
diff changeset
    86
    __cId = __continuationCreate(cont);
8557
931a24890c1f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8554
diff changeset
    87
    if (__cId) {
931a24890c1f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8554
diff changeset
    88
        id = __MKSMALLINT(__cId);
931a24890c1f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8554
diff changeset
    89
    }
931a24890c1f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8554
diff changeset
    90
%}.
931a24890c1f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8554
diff changeset
    91
    id isNil ifTrue:[
931a24890c1f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8554
diff changeset
    92
        self error:'could not create continuation' mayProceed:true.
931a24890c1f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8554
diff changeset
    93
        ^ nil.
931a24890c1f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8554
diff changeset
    94
    ].
931a24890c1f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8554
diff changeset
    95
    cont setId:id process:(Processor activeProcess).
931a24890c1f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8554
diff changeset
    96
    ^ cont
931a24890c1f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8554
diff changeset
    97
! !
931a24890c1f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8554
diff changeset
    98
8582
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
    99
!Continuation methodsFor:'as yet unclassified'!
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
   100
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
   101
restoreValues
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
   102
self halt.
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
   103
"/        | valueStream context |
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
   104
"/
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
   105
"/        valueStream _ values readStream.
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
   106
"/        [valueStream atEnd] whileFalse:
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
   107
"/                [context _ valueStream next.
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
   108
"/                1 to: context class instSize do: [:i | context instVarAt: i put: valueStream next].
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
   109
"/                1 to: context localSize do: [:i | context localAt: i put: valueStream next]]
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
   110
! !
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
   111
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
   112
!Continuation methodsFor:'invocation'!
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
   113
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
   114
numArgs
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
   115
	^ 1
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
   116
!
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
   117
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
   118
value
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
   119
	self value: nil
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
   120
!
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
   121
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
   122
value: v
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
   123
self halt.
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
   124
"/        self terminate: thisContext.
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
   125
"/        self restoreValues.
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
   126
"/        thisContext swapSender: values first.
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
   127
"/        ^v
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
   128
!
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
   129
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
   130
valueWithArguments: v
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
   131
	v size == 1 ifFalse: [^self error: 'continuations can only be resumed with one argument'].
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
   132
	self value: v first
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
   133
! !
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
   134
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
   135
!Continuation methodsFor:'private'!
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
   136
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
   137
initializeFromContext: aContext
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
   138
self halt.
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
   139
"/        | valueStream context |
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
   140
"/
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
   141
"/        valueStream _ WriteStream on: (Array new: 20).
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
   142
"/        context _ aContext.
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
   143
"/        [context notNil] whileTrue:
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
   144
"/                [valueStream nextPut: context.
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
   145
"/                1 to: context class instSize do: [:i | valueStream nextPut: (context instVarAt: i)].
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
   146
"/                1 to: context localSize do: [:i | valueStream nextPut: (context localAt: i)].
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
   147
"/                context _ context sender].
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
   148
"/        values _ valueStream contents
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
   149
!
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
   150
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
   151
terminate: aContext
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
   152
self halt.
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
   153
"/        | context |
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
   154
"/        context _ aContext.
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
   155
"/        [context notNil] whileTrue: [context _ context swapSender: nil]
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
   156
! !
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
   157
8557
931a24890c1f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8554
diff changeset
   158
!Continuation methodsFor:'private accessing'!
931a24890c1f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8554
diff changeset
   159
931a24890c1f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8554
diff changeset
   160
setId:idArg process:aProcess
931a24890c1f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8554
diff changeset
   161
    id := idArg.
931a24890c1f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8554
diff changeset
   162
    process := aProcess.
931a24890c1f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8554
diff changeset
   163
! !
931a24890c1f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8554
diff changeset
   164
8553
1cf4acd5102a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   165
!Continuation class methodsFor:'documentation'!
1cf4acd5102a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   166
1cf4acd5102a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   167
version
8582
115869898a97 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8559
diff changeset
   168
    ^ '$Header: /cvs/stx/stx/libbasic/Continuation.st,v 1.6 2004-09-22 11:52:26 cg Exp $'
8553
1cf4acd5102a initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   169
! !