1. { Multitasking in pascal }
2. { In this version you can NOT use floatingpoint! }
3. { Supports use of 32bits registers }
4.  
5. uses Dos, Crt;
6.  
7. {$S-,R-}
8. {$M 1024, 0, 655350}
9. type
10.     task_type = record
11.                       stack: array[0..1023] of byte;
12.                       eax, ebx, ecx, edx, esi, edi, ebp, esp, eip, flags: longint;
13.                       es, ds, cs, ss, fs, gs: word;
14.                  end;
15.     task_type_ptr = ^task_type;
16.  
17. var
18.    Stack: array[0..1023] of byte;
19.    Tasks: array[0..7] of task_type_ptr;
20.    Key: char;
21.    Int8_Save: pointer;
22.    a, ss_save, sp_save, bp_save: word;
23.    scr: array[0..24, 0..79] of word ABSOLUTE $b800:0;
24.  
25. procedure MTaskHandler; far; forward;
26. procedure MainProc; far; forward;
27.  
28. procedure KeybHandler; far;
29. begin
30.      Key:= #0;
31.      repeat
32.            asm
33.               mov ah, 1
34.               int 16h
35.               jz  @@1
36.               xor ax, ax
37.               int 16h
38.               mov Key, al
39.            @@1:
40.            end;
41.      until false;
42. end;
43.  
44. { function to set up a new task }
45. procedure SetupTask(task_num: word; routine: pointer);
46. var
47.    f: longint;
48.  
49. begin
50.      asm
51.         db $66; pushf
52.         db $66; pop word ptr [f]
53.  
54.         cli
55.      end;
56.  
57.      new(Tasks[task_num]);
58.      Tasks[task_num]^.ss:= Seg(Tasks[task_num]^.Stack);
59.      Tasks[task_num]^.cs:= Seg(routine^);
60.      Tasks[task_num]^.ds:= Seg(Tasks[0]);
61.  
62.      Tasks[task_num]^.ebp:= 1022;
63.      Tasks[task_num]^.esp:= 1022;
64.      Tasks[task_num]^.eip:= Ofs(routine^);
65.      Tasks[task_num]^.flags:= f;
66.  
67.      asm
68.         sti
69.      end;
70. end;
71.  
72. { used to close down a task }
73. procedure CloseTask(task_num: word);
74. begin
75.      asm
76.         cli
77.      end;
78.  
79.      dispose(Tasks[task_num]);
80.      Tasks[task_num]:= nil;
81.  
82.      asm
83.         sti
84.      end;
85. end;
86.  
87. { used to initialize the task }
88. procedure Init_Tasks;
89. var
90.    a: word;
91. begin
92.      for a:= 0 to 7 do
93.          Tasks[a]:= nil;
94.      SetupTask(0, @MainProc);
95.      SetupTask(1, @KeybHandler);
96. end;
97.  
98. procedure Destuct_Tasks;
99. var
100.    a: word;
101. begin
102.      for a:= 0 to 7 do
103.          if Tasks[a] <> nil then
104.             CloseTask(a);
105. end;
106.  
107. procedure MainProc;
108. begin
109.      a:= $feff;
110.      repeat
111.            a:= a - 1;
112.      until Key = chr(27);
113.  
114.      SetIntVec($8, Int8_Save);
115.  
116.      Destuct_Tasks;
117.      asm
118.         mov ax, 3
119.         int 10h
120.      end;
121.  
122. end;
123.  
124. procedure MTaskHandler; assembler;
125. asm
126.    cli
127. {  save vital information }
128. {
129.    eax, ebx, ecx, edx, esi, edi, ebp, esp, eip, dflags: longint;
130.    es, ds, cs, ss, fs, gs: word;
131. }
132.    db $66; mov word ptr [@@tmp], ax
133.    db $66; mov word ptr [@@tmp+4], bx
134.    db $66; mov word ptr [@@tmp+8], cx
135.    db $66; mov word ptr [@@tmp+12], dx
136.    db $66; mov word ptr [@@tmp+16], si
137.    db $66; mov word ptr [@@tmp+20], di
138.  
139. {  get ip }
140.    db $66; xor ax, ax
141.    pop ax { pop the ip from stack }
142.    db $66; mov word ptr [@@tmp+32], ax { ip }
143.  
144. {  get cs }
145.    pop dx
146.  
147. {  get flags }
148.    db $66; pushf
149.    db $66; pop ax
150.    pop ax
151.    db $66; mov word ptr [@@tmp+36], ax { dflags }
152.  
153. {  save bp and sp after the modification }
154.    db $66; mov word ptr [@@tmp+24], bp
155.    db $66; mov word ptr [@@tmp+28], sp
156.  
157.    mov word ptr [@@tmp+40], es
158.    mov word ptr [@@tmp+42], ds
159.    mov word ptr [@@tmp+44], dx  { cs }
160.    mov word ptr [@@tmp+46], ss
161.  
162. {  setup own stack }
163.    db $66; mov word ptr [@@bp], bp
164.    db $66; mov word ptr [@@sp], sp
165.    mov word ptr [@@ss], ss
166.  
167.    db $66; xor bp, bp
168.    db $66; xor sp, sp
169.    mov sp, offset Stack + 1022
170.    mov bp, sp
171.    mov ax, seg Stack
172.    mov ss, ax
173.  
174. {  restore data segment }
175.    mov ax, seg @data
176.    mov ds, ax
177.  
178. {  call old interrupt }
179.  
180.    pushf
181.    call dword ptr Int8_Save
182.  
183. {  save task info }
184.    mov  dx, word ptr [@@cur_t]
185.    mov  bx, dx
186.    shl  bx, 2
187.  
188.    les  di, dword ptr Tasks[bx]
189.    {
190.    inc  dx
191.    and  dx, 7
192.    mov  word ptr [@@cur_t], dx
193.    }
194.  
195. {  skip stack }
196.    add  di, 1024
197.  
198. {  save register info }
199.    mov  cx, 13
200.    push ds
201.    mov  ax, cs
202.    mov  ds, ax
203.    mov  si, offset @@tmp
204.    db $66; rep  movsw
205.    pop  ds
206.  
207. {  get next task }
208.    mov  dx, word ptr [@@cur_t]
209.  
210. @@task_loop:
211.  
212.    inc  dx
213.    and  dx, 7
214.    mov  bx, dx
215.    shl  bx, 2
216.  
217. {  load task info pointer }
218.    les  di, dword ptr Tasks[bx]
219.  
220. {  if valid task, go out }
221.    mov  ax, es
222.    cmp  ax, 0
223.    jne  @@got_task
224.  
225. {  if looped, exit }
226.    cmp  dx, word ptr [@@cur_t]
227.    je   @@exit
228.  
229.    jmp  @@task_loop
230.  
231. @@got_task:
232. {  save new task id }
233.    mov  word ptr [@@cur_t], dx
234.  
235.    jmp  @@exit
236.  
237. @@exit:
238. {  restore information }
239.    mov  dx, es
240.    mov  si, di
241.  
242. {  skip stack }
243.    add  si, 1024
244.  
245. {  save register info }
246.    mov  cx, 13
247.  
248.    mov  ds, dx
249.    mov  ax, cs
250.    mov  es, ax
251.    mov  di, offset @@tmp
252.    db $66; rep  movsw
253.  
254. {  restore registers from prev. task }
255.    db $66; mov bx, word ptr [@@tmp+4]
256.    db $66; mov cx, word ptr [@@tmp+8]
257.    db $66; mov dx, word ptr [@@tmp+12]
258.    db $66; mov si, word ptr [@@tmp+16]
259.    db $66; mov di, word ptr [@@tmp+20]
260.    db $66; mov bp, word ptr [@@tmp+24]
261.    db $66; mov sp, word ptr [@@tmp+28]
262.  
263.    mov es, word ptr [@@tmp+40]
264.    mov ds, word ptr [@@tmp+42]
265.    mov ax, word ptr [@@tmp+46]
266.    mov ss, ax
267.  
268.    xor ax, ax
269.    xor ax, ax
270.  
271. {  set new return address and return the proper way }
272.    mov ax, word ptr [@@tmp+36]
273.    push ax
274.    mov ax, word ptr [@@tmp+44]
275.    push ax
276.    mov ax, word ptr [@@tmp+32]
277.    push ax
278.  
279. {  restore used register }
280.    db $66; mov ax, word ptr [@@tmp]
281.  
282.    iret
283.  
284. {  temporary storage }
285. @@tmp:
286. {
287.    eax, ebx, ecx, edx, esi, edi, ebp, esp, eip, dflags: longint;
288.    es, ds, cs, ss, fs, gs: word;
289. }
290.    dd 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
291.    dw 0, 0, 0, 0, 0, 0
292. {  current task }
293. @@cur_t:
294.    dw 0
295.  
296. @@bp:
297.    dd 0
298.  
299. @@sp:
300.    dd 0
301. @@ss:
302.    dw 0
303.  
304. end;
305.  
306. procedure DoStuff1; far;
307. var
308.    x, y: word;
309. begin
310.      x:= 0;
311.      y:= 0;
312.      repeat
313.            scr[y, x]:= a;
314.            x:= x + 1;
315.            if x = 80 then
316.            begin
317.                 x:= 0;
318.                 y:= y + 1;
319.                 if y = 25 then y:= 0;
320.            end;
321.      until false;
322. end;
323.  
324. begin
325.      Init_Tasks;
326.      SetupTask(2, @DoStuff1);
327.  
328.      GetIntVec($8, Int8_Save);
329.      SetIntVec($8, @MTaskHandler);
330.      MainProc;
331. end.