Лабораторная работа / COROUT

Unit Corout;
Interface
Type
arptr = ^artype;
artype = array[0..999] of word; {Ї®¤ б⥪ - 1000 б«®ў}

descptr = ^procdesc;
procdesc = record
ssreg,
spreg : word;
SaveArPtr : ArPtr;
end;

Procedure Transfer(OldProc,NewProc:descptr);

Procedure NewProcess(body:pointer; Var proc:descptr);
Procedure DelProcess( Var proc:descptr);

{ -= Џаאַ© ўлў®¤ ў ўЁ¤Ґ®Ї ¬пвм =- }
Type
TScreenChar = Record
Data : Char;
Attr : Byte;
End;

Var TextScreenBuffer : Array [0..24,0..79] of TScreenChar
Absolute $A000:$0000;

Type
TDirectS = Object
ScrCol,ScrRow : Word;
Constructor Init;
Procedure Out( C:Char );
End;

Var DirectS : TDirectS;

Var
main : descptr;
{--------------------------------------------------------------------------}
Implementation

Procedure NewProcess(body : pointer; Var proc : descptr);
Var
ar : arptr;
Begin
New(proc);
New(ar);
writeln('ar: ',seg(ar^),' ',ofs(ar^));
{ writeln('spreg: ',ofs(ar^) + 1998 - 14);}
with proc^ do begin
ssreg := seg(ar^);
spreg := ofs(ar^) + 1998 - 14;
memw[ssreg:spreg+2] := ofs(body^);
memw[ssreg:spreg+4] := seg(body^);
SaveArPtr := ar;
end {with};
writeln('+spreg: ',proc^.spreg);
End {NewProcess};
{--------------------------------------------------------------------------}
Procedure DelProcess( Var proc : descptr);
Var
ar : arptr;
Begin
with proc^ do
Dispose(SaveArPtr);
Dispose(proc);
End {DelProcess};
{-----------------------------------------------------}
Procedure Transfer(OldProc, NewProc : descptr);
Assembler;
Asm {Є®¬ЇЁ«пв®а Ї®б«Ґ Call Transfer
Ї®¤бв ў«пҐв push bp; mov bp,sp}
les di,oldproc
mov es:[di],ss {oldproc.ssreg := ss;}
mov es:[di+2],sp {oldproc.spreg := sp;  ¤аҐб ў®§ўа в  ў sp+2}
les di,newproc
mov ss,es:[di] {ss := newproc.ssreg;}
mov sp,es:[di+2] {sp := newproc.spreg;}
pop bp {ўлв «ЄЁў ­ЁҐ bp ўлў®¤Ёв б⥪ ­   ¤аҐб ў®§ўа в }
ret 8
{§ в®«Є­г«Ё 8 Ў ©в®ў - 4 б«®ў  - §­ зҐ­Ёп oldproc Ё newproc}
End {Transfer};
{-----------------------------------------------------}

Constructor TDirectS.Init;
Var I,J : Word;
Begin
For I:=0 to 24 do
For J:=0 to 79 do
With TextScreenBuffer[ScrRow,ScrCol] do
Begin
Data := ' ';
Attr := $07;
End;
ScrRow := 0;
ScrCol := 0;
End;

Procedure TDirectS.Out( C:Char );
Begin
If ScrRow>24 then Init;
TextScreenBuffer[ScrRow,ScrCol].Data := C;
Inc(ScrCol);
if ScrCol>79 then
Begin
ScrCol := 0;
Inc(ScrRow);
End;
End;

Begin
DirectS.Init;
New(main);
End {Corout}.