module  stack;
exports

imports perq_string from perq_string;
imports arith from arith;

type acb=record ep,rr,ra,rs,tl,gl,dl,lp,sl:fsbit16 end;
     acbptr=^acb;
     txtptr=^text;
var tin,tout,dfile,lfile:text;
    curout:txtptr;
    ss:fsbit16;
    dlist,listing:boolean;

procedure dumpseg(ssn,disp,len:fsbit16);
procedure dumpacb(ap:fsbit16);
function loadss:fsbit16;
function loadap:fsbit16;
function loadgp:fsbit16;
function topofstack:fsbit16;

private
function stoi(str:string):integer;
{ converts string to integer - returns -1 if invalid string }
label 999;
var l,i,num,dig:integer;
      neg:boolean;
begin
l:=length(str);
if l=0 then goto 999;
if str[1]='-' then
  begin
  l:=l-1;
  if l=0 then goto 999;
  neg:=true;
  str:=substr(str,2,l);
  end else neg:=false;
num:=0;
for i:=1 to l do
  begin
  dig:=ord(str[i])-ord('0');
  if (dig<0) or (dig>9) then goto 999;
  num:=num*10+dig;
  end;
if neg then num:=-num;
stoi:=num;
exit(stoi);
999:
stoi:=-1;
end; { stoi }

function loadss:fsbit16;
var ss:fsbit16;
begin
  inlinebyte(99); { lssn }
  storexpr(ss);
  loadss:=ss;
end;
 
function topofstack:fsbit16;
var ap,ss:fsbit16;
    tl:fsbit32;
begin
  inlinebyte(244); { ldap }
  storexpr(ap);
  ss:=loadss;
  tl:=makeptr(ss,ap+4,fsbit32);
  topofstack:=tl^;
end;

function loadap:fsbit16;
var ap,ss:fsbit16;
    dl:fsbit32;
begin
  inlinebyte(244); { ldap }
  storexpr(ap);
  ss:=loadss;
  dl:=makeptr(ss,ap+2,fsbit32);
  loadap:=dl^;
end;

function loadgp:fsbit16;
var ap,ss:fsbit16;
    gl:fsbit32;
begin
inlinebyte(244); { ldap }
storexpr(ap);
ss:=loadss;
gl:=makeptr(ss,ap+3,fsbit32);
loadgp:=gl^;
end;

procedure dumpacb;
var acb1:acbptr;
    sl,lp,dl,gl,tl,rs,ra,rr,ep:fsbit16;
begin
acb1:=makeptr(ss,ap,acbptr);
sl:=acb1^.sl; lp:=acb1^.lp;
dl:=acb1^.dl; gl:=acb1^.gl;
tl:=acb1^.tl; rs:=acb1^.rs;
ra:=acb1^.ra; rr:=acb1^.rr;
ep:=acb1^.ep;
writeln(curout^,' sl (',ap:4:-16,')',sl:5:-16,'   (',ap:5,')',sl:6);
writeln(curout^,' lp (',(ap+1):4:-16,')',lp:5:-16,'   (',(ap+1):5,')',lp:6);
writeln(curout^,' dl (',(ap+2):4:-16,')',dl:5:-16,'   (',(ap+2):5,')',dl:6);
writeln(curout^,' gl (',(ap+3):4:-16,')',gl:5:-16,'   (',(ap+3):5,')',gl:6);
writeln(curout^,' tl (',(ap+4):4:-16,')',tl:5:-16,'   (',(ap+4):5,')',tl:6);
writeln(curout^,' rs (',(ap+5):4:-16,')',rs:5:-16,'   (',(ap+5):5,')',rs:6);
writeln(curout^,' ra (',(ap+6):4:-16,')',ra:5:-16,'   (',(ap+6):5,')',ra:6);
writeln(curout^,' rr (',(ap+7):4:-16,')',rr:5:-16,'   (',(ap+7):5,')',rr:6);
writeln(curout^,' ep (',(ap+8):4:-16,')',ep:5:-16,'   (',(ap+8):5,')',ep:6);
end;

procedure dumpseg;
type arr8=array[1..8] of fsbit16;  
     arr8ptr=^arr8;
     char16=packed array[1..16] of char;
var darr:arr8ptr;
    charr:char16;
    i,j,lcount:integer;
begin
if ssn=0 then ssn:=ss;
lcount:=len div 8;
for i:=0 to lcount do
  begin
  write(curout^,'(',disp+i*8:4:-16,') (',i*8:5,') ');
  darr:=makeptr(ssn,disp+i*8,arr8ptr);
  for j:=1 to 8 do write(curout^,' ',darr^[j]:4:-16);
  charr:=recast(darr^,char16);
  write(curout^,'  [');
  for j:=1 to 8 do
    begin
    case charr[j] of
      'a'..'z','A'..'Z','0'..'9':write(curout^,charr[j]);
      otherwise:write(curout^,'.');
    end;
    end;
  writeln(curout^,']');
  end;
end. { dump }