Input/output functions for E-MMI (Pascal source)

v.0.0 from 6 Jun. 2002
(see details on this page)
unit CPM; {$N+}
{Some primitive CP/M functions for computer models}

INTERFACE
uses crt, consts, mmixregs;

procedure RST05(par2,par3:byte);

IMPLEMENTATION
procedure ctrl_c(c:char);
begin if ord(c)=3 then
         begin writeln; write('Terminate program (y/n)? ');
               repeat until keypressed; c:=readKey;
               if (c='y') or (c='Y')
                  then ErrorMessage:='Program terminated'
         end
end;

function CPM1:char;
{CONSOLE INPUT: returns ASCII code from keyboard}
var c:char;
begin while not keyPressed do ; c:=readKey;
      if ord(c)>31 then write(c);
      CPM1:=c;
      ctrl_c(c);
end;

procedure CPM2(p:integer);
{CONSOLE OUTPUT: writes symbol to console}
begin write(chr(p))
end;

{procedure CPM5
LST OUTPUT}

procedure CPM6(var p:integer);
{DIREFCT CONSOLE I/O:
if i=$FF then input symbol to p else write p and set p=0}
var c:char;
begin if p<>$FF
         then begin write(chr(p)); p:=0
              end
         else p:=ord(readKey);
end;

procedure CPM9(s:string);
{STRING OUTPUT: writes string to console until '$'}
var p:integer;
begin p:=pos('$',s);
      if p=0 then write(s)
             else write(copy(s,1,p-1))
end;

function CPMA(maxLen:byte):string;
{BUFFERED INPUT: input string until ENTER;
maxLen - maximum length of string;
first byte is equal to number of symbols without CR}
var buf,s:string; i:integer;
var textLength:byte;
begin readln(buf);
      if length(buf)>maxLen then buf:=copy(buf,1,maxLen);
      textLength:=length(buf); s:=chr(maxlen)+chr(textLength);
      for i:=1 to TextLength do s:=s+buf[i];
      CPMA:=s+chr(13);
end;

function CPMB:byte;
{CONSOLE STATUS:
if keyboard symbol is ready, returns $FF else 0}
begin if keyPressed then CPMB:=$FF else CPMB:=0;
end;

function CPMC:string;
{GET VERSION: get CP/M functions version}
begin CPMC:='E.A.Eremin. 6 Jun. 2002'
end;

{###################################}
procedure executeCPMFunction(number:byte;
                             var parameter1:integer;
                             var parameter2:string);
{works with parameters and calls function}
begin case number of
        1: parameter1:=ord(CPM1);
        2: CPM2(parameter1);
        6: CPM6(parameter1);
        9: CPM9(parameter2);
       10: parameter2:=CPMA(parameter1);
       11: parameter1:=CPMB;
       12: writeln(CPMC);
     end
end;

{######################################}
function getRegister(k:integer):integer;
var m:m8;
begin myPack(r[k],m); getRegister:=m[0]
end;

function getPrintString(k:integer):string;
var a:ucMemAddress; b,c:byte; s:string;
begin a:=r[k]; s:=''; c:=0;
      repeat b:=ucMem.getByte(a);
             s:=s+chr(b); c:=c+1; a:=a+1;
      until  (chr(b)='$') or (c>250);
      getPrintString:=s;
end;

procedure putToRegister(a,v:integer);
var m:m8;
begin clear_m8(m); m[0]:=v; myUnPack(m,r[a]);
end;

procedure packInputString(k:integer; s:string);
var a:ucMemAddress; c,i:byte;
begin c:=ord(s[1])+2; a:=r[k]; i:=1;
      while c>0 do
            begin ucMem.putByte(a,ord(s[i]));
                  c:=c-1; a:=a+1; i:=i+1
            end;
end;

procedure RST05(par2,par3:byte);
var p1:integer; p2:string;
begin {p3 shows to register}
{##### input parameters #####}
      case par2 of
        2,6: p1:=getRegister(par3);
        9:   p2:=getPrintString(par3);
       10:   p1:=ucMem.getByte(getRegister(par3));
      end;
{##### execute #####}
      executeCPMFunction(par2,p1,p2);
{##### output parameters #####}
      case par2 of
       1,6,11: putToRegister(par3,p1);
       10:     packInputString(par3,p2);
      end;
end;

end.