Скачиваний:
31
Добавлен:
01.05.2014
Размер:
3.64 Кб
Скачать
Unit Corout;

{$F+}

Interface

Type
ArPtr = ^ArType;
ArType = Array [0..999] of Word; {Ї®¤ б⥪ - 1000 б«®ў}

TProcedure = Procedure;

DescPtr = ^ProcDesc;
ProcDesc = Object
SSReg,
SPReg : Word;
Stack : ArPtr;
Constructor Init( Body:TProcedure );
Destructor Done;
End;

Procedure Transfer(OldProc,NewProc:descptr);

Const NumProc = 3;
Var
Proc : Array [1..NumProc] of descptr;
CurProc : LongInt; { Ќ®¬Ґа ⥪г饣® Їа®жҐбб  }

{ ‡¤Ґбм Ўг¤Ґ¬ еа ­Ёвм бв ал© ®Ўа Ў®взЁЄ ЇаҐалў ­Ёп 08 }
Var Int08Save : Pointer;

{ -= "‡ ЇаҐвЁвм ЇаҐалў ­Ёп" =- }
Procedure Disable_Interrupt; far;

{ -= Џа®жҐ¤га -®Ўа Ў®взЁЄ ЇаҐалў ­Ёп ®в в ©¬Ґа  =- }
Procedure Handler; Interrupt;

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

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

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

Var DirectS : TDirectS;

Var main : descptr;

{--------------------------------------------------------------------------}
Implementation

Constructor ProcDesc.Init( Body:TProcedure );
Begin
New(Stack);
SSReg := seg(Stack^);
SPReg := ofs(Stack^) + 1998 - 14;
memw[ssreg:spreg+2] := ofs(body);
memw[ssreg:spreg+4] := seg(body);
End;

{--------------------------------------------------------------------------}
Destructor ProcDesc.Done;
Begin
Dispose(Stack)
End;

{-----------------------------------------------------}
{$F+}
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;}
sti { ђ §аҐи Ґ¬ ЇаҐалў ­Ёп !!! Џ®пў«пҐвбп, ­ зЁ­ п б « Ўл 2 }
pop bp {ўлв «ЄЁў ­ЁҐ bp ўлў®¤Ёв б⥪ ­   ¤аҐб ў®§ўа в }
ret 8
{§ в®«Є­г«Ё 8 Ў ©в®ў - 4 б«®ў  - §­ зҐ­Ёп oldproc Ё newproc}
End {Transfer};

{ -= "‡ ЇаҐвЁвм ЇаҐалў ­Ёп" =- }
Procedure Disable_Interrupt; Assembler;
Asm
cli { CLose Interrupts }
End;

{--------------------------------------------------------------------------}
Procedure Handler;
Var PrevProc : Longint;
Begin
{ ‚лзЁб«пҐ¬ ­®¬Ґа Їа®жҐбб , ў Є®в®ал© Ўг¤Ґ¬ ЇҐаҐЄ«оз вмбп }
PrevProc := CurProc;
CurProc := CurProc+1;
If CurProc>NumProc then CurProc:=1;
{ ‚л§лў Ґ¬ бв ал© ®Ўа Ў®взЁЄ в ©¬Ґа  (Є®в®ал© ¬л § ¬ҐбвЁ«Ё) }
Asm
Int 60h
End;
{ ‡ ЇаҐй Ґ¬ ЇаҐалў ­Ёп }
Disable_Interrupt;
{ ‚лЎа вм б«Ґ¤гойго б®Їа®Ја ¬¬г }
Transfer(Proc[PrevProc],Proc[CurProc]);
End;

{-----------------------------------------------------}
Constructor TDirectS.Init;
Var I,J : Word;
Begin

For I:=6 to 24 do
For J:=0 to 79 do
With TextScreenBuffer[I,J] do
Begin
Data := ' ';
Attr := $07; { ЃҐ«л¬ Ї® зҐа­®¬г }
End;
ScrRow := 6;
ScrCol := 0;
End;

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

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


Соседние файлы в папке LAB2