home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware 1 2 the Maxx
/
sw_1.zip
/
sw_1
/
PROGRAM
/
FORTHCMP.ZIP
/
MULTI.4TH
< prev
next >
Wrap
Text File
|
1992-03-30
|
11KB
|
416 lines
\ ForthCMP Multitasking Module
\ Copyright 1987 (C) By Thomas Almy. All rights reserved.
\ Permission is granted to registered users of ForthCMP to sell or distribute
\ computer programs incorporating the compiled contents of this file.
\ IBM BIOS is used for terminal I/O.
\ See the manual for usage of this module.
\ IBM is a trademark of International Business Machines, Inc.
.( LOADING MULTI) CR
INCLUDE INTS
INCLUDE FARMEM1
10
DECIMAL
0 0 IN/OUT NEED SINGLE
0 0 IN/OUT NEED MULTI
0 0 IN/OUT NEED PAUSE
0 0 IN/OUT NEED end-timer
0 0 IN/OUT NEED start-timer
VARIABLE ?multi \ true if multitasking turned on
VARIABLE user \ disp into user segment--used at compile time
VARIABLE CTASK \ pointer to task list
VARIABLE dispused \ semaphore for display output
VARIABLE inexpect \ executing EXPECT -- only one at a time, please!
\ Semaphores
1 0 IN/OUT
: SEMA BEGIN DUP @ WHILE PAUSE REPEAT ON ;
1 0 IN/OUT
: PHORE OFF PAUSE ;
0 0 IN/OUT
: BYE end-timer bye ;
\ Memory management interface
1 1 IN/OUT
: GET malloc IF ." OUT OF MEMORY " BYE THEN ;
\ USER VARIABLES
H: UALLOT DSEG user @ + user ! ;
1 2 IN/OUT
H: UCREATE user @ CONSTANT ;
H: UVARIABLE UCREATE 2 UALLOT ;
H: URESET DSEG 0 user ! ;
URESET
\ redefinition of primitive I/O functions
HEX
0 0 IN/OUT
CODE setcursor \ set the cursor to the correct location
CTASK [] BX MOV
CS: 12 +[BX] DH MOV \ Y value
CS: 14 +[BX] DL MOV \ X value
BH BH XOR
2 # AH MOV
10 INT
RET
END-CODE \ setcursor
0 0 IN/OUT
CODE getcursor \ get the correct cursor coordinates
3 # AH MOV
BH BH XOR
10 INT
CTASK [] BX MOV
DH CS: 12 +[BX] MOV \ Y value
DL CS: 14 +[BX] MOV \ X value
RET
END-CODE \ getcursor
2 0 IN/OUT
: GOTOXY CTASK @ 12 + CS: 2! ;
0 2 IN/OUT
: ?XY CTASK @ 12 + CS: 2@ ;
1 0 IN/OUT
CODE emit
0E # AH MOV
BX BX XOR
10 INT
RET
END-CODE
0 0 IN/OUT
CODE CLS
3 # AX MOV
10 INT
RET
END-CODE
0 1 IN/OUT
CODE ?TERMINAL
CALL' PAUSE \ allow another task to execute
1 # AH MOV
16 INT
0 # AX MOV
=0 ~ IF, AX DEC THEN,
RET
END-CODE \ ?TERMINAL
: PAD CTASK @ 16 + CS: @ ;
DECIMAL
: EMIT
dispused SEMA
setcursor
emit
getcursor
dispused PHORE ;
: TYPE
dispused SEMA
setcursor
0 ?DO COUNT emit LOOP DROP
getcursor
dispused PHORE ;
: CS:TYPE
dispused SEMA
setcursor
0 ?DO CS: COUNT emit LOOP DROP
getcursor
dispused PHORE ;
: SPACES \ send out all characters in a burst
dispused SEMA
setcursor
DUP 0> IF 0 DO BL emit LOOP ELSE DROP THEN
getcursor
dispused PHORE ;
: KEY BEGIN ?TERMINAL setcursor UNTIL 0 8 BDOS ;
\ EXPECT
FIND SPAN #IF DROP #ELSE VARIABLE SPAN #THEN
0 0 IN/OUT
: bu 8 emit BL emit 8 emit -1 SPAN +! ;
: EXPECT
inexpect SEMA \ too hard if two or more tasks want input at once!
>R SPAN OFF
BEGIN
SPAN @ R@ < WHILE \ more room on line
KEY dispused SEMA setcursor CASE
27 OF BEGIN SPAN @ 0> WHILE bu REPEAT ENDOF
8 OF SPAN @ 0> IF bu THEN ENDOF
13 OF BL emit
R> DROP DROP
getcursor
dispused PHORE
inexpect PHORE
EXIT ENDOF
( ELSE ) DUP emit
OVER SPAN @ + C!
1 SPAN +!
0 ENDCASE
getcursor dispused PHORE
REPEAT
inexpect PHORE
R> 2DROP ;
\ TASK CREATION
HEX
H: TASK \ values after INIT-TASKS:
CSEG FORCE CREATE HERE E92E , \ DISP 0 -- JMP ( task asleep )
DSEG CTASK @ , CTASK ! \ 02 -- relative addr nxt task
user @ , \ 04 -- size of user area (not used?)
0 , \ 06 -- SS register contents
user @ pssize 10 * + , \ 08 -- SP register contents
user @ pssize 10 * + rssize + , \ 0A -- BP register contents
, \ 0C -- PC contents
\ the following fields are for per-task variables
\ and could be selectively elimiated if not needed if space is
\ at a premium. In that case, offsets may need to be adjusted
\ for words which use latter fields.
0 , \ 0E -- Message list
0 , \ 10 -- Timer
0 , \ 12 -- Y cursor coordinate
0 , \ 14 -- X cursor coordinate
DSEG HERE 80 ALLOT 20 + , \ 16 -- PAD, a per-task work area
;
0 #IF
Initially, DISP 2 has absolute address of next task.
This value as well as DISP 6 get
filled in by INIT-TASKS when application is run.
#THEN
CSEG FORCE HERE CREATE MAIN-TASK \ Give it a name
DSEG CTASK ! \ Task list points to it
80CD , \ DISP 0 -- INT 80 (task awake)
0 , \ 02 -- relative addr next task
0 , \ 04 -- NOT USED
0 , \ 06 -- SS register contents
0 , \ 08 -- SP register contents
0 , \ 0A -- BP register contents
0 , \ 0C -- PC contents
0 , \ 0E -- Message list
0 , \ 10 -- Timer
0 , \ 12 -- Y cursor coordinate
0 , \ 14 -- X cursor coordinate
DSEG HERE 80 ALLOT 20 + , \ 16 -- PAD, a per-task work area
0 #IF
DISP-2, 6, 12, and 14 get filled in by INIT-TASK. -8 -0A and -0C
are filled by first task swap (which is done by INIT-TASK).
#THEN
\ TASK INITIALIZATION
0 0 IN/OUT
: INIT-TASKS \ This MUST be executed to start multitasking
CTASK @
BEGIN ?DUP WHILE \ for each task DO:
2+ DUP CS: @ IF \ one follows, this isn't main task
DUP 8 + CS: @ 10 + 4 >> GET
OVER 4 + CS: ! \ stackseg
DUP CS: @ TUCK \ next task
ELSE
0 SWAP CTASK @ \ next task is head of list
THEN
OVER - 2- SWAP CS: !
REPEAT
MAIN-TASK CTASK !
getcursor \ sets main task cursor
?SS: MAIN-TASK 6 + CS: ! \ sets main task stack segment
start-timer
MULTI ( GO!!! ) ;
\ TASK DISPATCHER
CODE PAUSE
0 # ?multi [] CMP
=0 IF, RET THEN,
CTASK [] BX MOV \ current task
CS: 0C +[BX] POP \ save PC
BP CS: 0A +[BX] MOV \ save BP
SP CS: 08 +[BX] MOV \ save SP
CS: 2 +[BX] BX ADD
4 # BX ADD
CLI \ no ints during dispatch
BX JMPI ( dispatch )
END-CODE \ PAUSE
0 #IF
Tasks are linked together so that jumping to a task will cause
jumping to the next if it is asleep, or doing an INT 80 if it
is awake. Thanks to Henry Laxen's Forth 83 model for the
technique.
#THEN
L: start-task ( the INT80 routine )
BX POP
BX DEC
BX DEC \ Pointer to the task
CS: 6 +[BX] SS >SEG \ restore stack segment
CS: 8 +[BX] SP MOV \ restore SP
STI \ Interrupts are safe now
CS: 0A +[BX] BP MOV \ restore BP
BX CTASK [] MOV \ current task
CS: 0C +[BX] JMPI \ go!
FORTH \ start-task
0 #IF
This code starts up a new task by setting up all registers,
fixing CTASK, and jumping to where we left off.
#THEN
\ TASK MANAGEMENT
: SINGLE ?multi OFF ;
: MULTI ?multi ON
?CS: start-task 0 200 2!L \ install interrupt vector
PAUSE \ start with a task swap
;
1 0 IN/OUT
: WAKE 80CD CS: <- ;
1 0 IN/OUT
\ the 2e prefix byte (CS override) makes the jmp instruction 4 bytes long
: SLEEP ( task -- ) E92E CS: <- ;
1 1 IN/OUT
: WAITING? 10 + CS: @ 0<> ;
0 0 IN/OUT
: STOP CTASK @ SLEEP PAUSE ;
0 1 IN/OUT
: ACTIVE-TASKS
0 CTASK @
BEGIN
DUP WAITING? IF SWAP 1+ SWAP ELSE
DUP CS: @ 80CD = IF SWAP 1+ SWAP THEN THEN \ check for active
DUP 2+ CS: @ + 4 + \ address of next task
DUP CTASK @ = UNTIL \ Loop until back to start
DROP ( task address )
;
\ MESSAGE PASSING
0 1 IN/OUT
: MESSAGE? CTASK @ 0E + CS: @ ;
0 1 IN/OUT
: GET-MESSAGE
BEGIN MESSAGE? ?DUP 0= WHILE STOP REPEAT
DUP 0 @L CTASK @ 0E + CS: ! \ Unlink message
;
1 1 IN/OUT
: MESSAGES
0 SWAP 0E + CS: @ ?DUP IF
BEGIN SWAP 1+ SWAP 0 @L ?DUP 0= UNTIL
THEN ;
2 0 IN/OUT
: SEND-MESSAGE
OVER 0 SWAP 0 !L \ set message's next field to NIL
DUP WAITING? NOT IF DUP WAKE THEN \ fire up receiving task
\ unless waiting for timer
0E + DUP CS: @ ?DUP IF \ Existing messages in queue
NIP
BEGIN DUP 0 @L ?DUP WHILE NIP REPEAT \ find end of list
0 !L \ store message at end of list
ELSE
CS: ! \ no existing messages, put at head of queue.
THEN
PAUSE ; \ Give it a chance to run
\ control-break handler
\ always gets control and (currently) dumps task information
2VARIABLE cb_save
1B CONSTANT cb_int
0 0 IN/OUT
: cbt
CLS
SINGLE
end-timer
." Task statistics: "
MAIN-TASK \ start with first
BEGIN CR
HEX DUP 0 <# # # # # #> TYPE SPACE \ address
DUP WAITING? IF ." Waiting " DUP 10 + CS: @ . ." ticks" ELSE
DUP CS: @ 80CD = IF ." Active" ELSE ." Sleeping" THEN THEN
DUP 2+ CS: @ + 4 + \ address of next task
DUP MAIN-TASK = UNTIL \ Loop until back to start
DROP ( task address )
bye
;
' cbt TASK cb-task
L: cb_handler ( actual interrupt handler )
80CD # CS: cb-task [] MOV \ wake cb task
STI
IRET FORTH
\ timer
1C CONSTANT t_int \ timer interupt vector number
CSEG FORCE
CREATE t_save 4 ALLOT \ original interupt vector
L: t_handler
PUSHF CS: t_save CALLF \ do original functions
BX PUSH
MAIN-TASK # BX MOV ( start of list )
BEGIN,
CS: 0 # 10 +[BX] CMP =0 ~ IF, ( non_zero time )
CS: 10 +[BX] DEC ( count down )
=0 IF, 80CD # CS: [BX] MOV THEN, ( wake task )
THEN,
CS: 2 +[BX] BX ADD
4 # BX ADD ( next task )
MAIN-TASK # BX CMP
=0 UNTIL, ( back at start? )
BX POP
IRET
FORTH \ t_handler
\ timer start and end 08:09 11/18/85
: start-timer \ and control-break handler
t_int get-handler t_save CS: 2!
?CS: t_handler t_int set-handler
cb_int get-handler cb_save 2!
?CS: cb_handler cb_int set-handler
;
: end-timer
t_save CS: 2@ t_int set-handler
cb_save 2@ cb_int set-handler
;
2 0 IN/OUT
: TIME-OUT ( ticks task -- ) DUP SLEEP 10 + CS: ! ;
: WAIT ( ticks -- ) CTASK @ TIME-OUT PAUSE ;
DSEG 0A = #IF DECIMAL #THEN