Copyright © 1988, 2007 by Gil Hagiz
Certificate of Registration No. TXu 894-323
United States Copyright Office
The code below is part of the copyright registration
That's about 10% of the entire code
{NCPLUS.PAS Copyright (C) 1988, 1999 by Gil Hagiz}
Program NCPLUS;
{$I nodebug}
{$M $8000, $20000, $A0000}
uses
Dos,
crt,
ed, {link to the editor}
ugrp, {screen}
uvar, {nc vars}
ini, {read INI file}
tbu, {Teach box unit}
ncpar, {parameter table}
tools, {tool file}
Errors, {alpha-graphic messages}
math, {arithmetics}
coord, {AZ,EL,CYL}
trans, {Transformation}
loc, {location file}
iop, {I/O}
cpl, {compiler}
jigs,
ncrun, {runtime lib}
ncg, {G code dispatcher}
nc, {display, main loops}
logo; {log on, log out}
BEGIN
NCversion:= 'NCPLUS 2000';
logon;
repeat
cncmain;
until logoff;
END.
{LOGO.PAS Copyright (C) 1988, 1999 by Gil Hagiz}
Unit logo;
interface
{$I nodebug}
Uses
dos,
crt,
screen,
files,
ugrp,
windows,
kboard,
cvar,
mesg,
parser,
helpme,
ed,
uvar,
ini,
tbu,
errors,
trans,
iop,
cpl,
ncrun,
nc;
procedure logon;
function logoff:boolean;
(*============================================================*)
Implementation
{$I Copyrt}
const
secretcode = '123';
devOK:boolean=false;
procedure openscreen(col,cursor:word);
var txt:linestr;
begin
openwindow(10,9,70,16,col,cursor);
getini('vendor',txt);
title(txt);
center(NCversion,1);
center(CR,2);
end;
procedure fatalerror(const s:string);
begin
BootLog(getmessage(807)+s,11);
offline:=true;
directvideo:=false; checksnow:=false;
openscreen(bkred+7,$2000);
center(getmessage(807),4);
center(getmessage(808),6);
textattr:=bkred+white; center(s,5);
ouch; ouch;
while keyready do ;
inkey; halt(12);
end;
procedure isSuper(su:boolean);
begin
if prog1='' then begin
security:= 2-byte(su or (inkey=secretkey)); {security= 1 or 2}
if security=superuser then begin
center(getmessage(804),6);
inkey;
end;
end else
inkey;
closewindow;
oldscreen;
end;
function copyparam:char; assembler; {txtl:=copy(txtl,2,length(txtl))}
ASM;
cld
les si,txtladdr
mov di,si
xor ax,ax
lodsb
dec ax
mov cx,ax
stosb {set length; inc di}
lodsb {al= first char; inc si}
rep movsb
and al,5Fh
end;
function opendev:boolean; assembler; {read data from device}
ASM; {read constants}
mov ax,04402h {read device IOCTL}
mov cx,5 {byte count}
mov bx,word ptr cncdrv
push ds
mov dx,seg cmd9A
mov ds,dx
mov dx,offset cmd9A {cmd=9Ah}
int 21h
pop ds
jc @err
mov ax,04402h {read device IOCTL}
mov cx,7 {byte count}
mov dx,offset devdata {NCRUN, ds= segment}
mov bx,word ptr cncdrv {handle}
int 21h {DS:DX= ptr to data block}
@err:
mov al,1 {CF=1 @ error}
sbb al,0
mov devOK,al
end;
procedure logon;
var i,j : word;
e:extstr;
binfile:boolean;
src:text;
txt:linestr;
label portsOK;
begin
ASM; {increase number of file handles to 30}
mov ax,6700h
mov bx,30
int 21h
@1:
end;
selfdir:='';
INIfile:=myname+'.INI';
boot(true); {open boot log file}
BootLog(Fexpand(paramstr(0)),10);
for i:=1 to paramcount do begin
txtl:=paramstr(i);
BootLog(' '+txtl,10);
case copyparam of
'S': if txtl=secretcode then security:=superuser;
'O': offline:=true;
'@': begin
Fsplit(fexpand(txtl),selfdir,txtl,e);
if length(txtl) or length(e) <>0 then INIfile:=txtl+e;
end;
end; {case}
end;
bootLog('',11);
i:=1;
if selfdir='' then begin
selfdir:=mydir; dec(i);
end else
HelpDir:=@selfdir;
Fassign(INIsrc,selfdir+INIfile);
txt:=getmessage(809)+INIsrc.pname;
j:=word(dostype(INIsrc.pname)=1);
if i>j then fatalerror(txt);
BootLog(txt,j);
readINIfile;
txt:=Mydir+Modelname;
if not SetModel(modelname) then fatalerror(txt);
if modelname<>'' then BootLog(txt,1);
txt2long;
openscreen(bkblue+white,$2000);
if not offline then begin
reset(cncdrv);
offline:=ioresult<>0;
end;
if offline then begin
ASM or pflags,20h end;
center(getmessage(805),4);
end;
if not (offline or opendev) then fatalerror('CNCSERVO');
feed60:=65536.0/(60*irqs);
ASM;
mov bx,-1
mov ax,MemSeg
mov di,wr16
call dword ptr IOdd
jc portsOK
end;
fatalerror('CNCPORTS');
portsOK:
MavLen:=MavBuff*2 div irqt;
getmem(Mav,MavLen*(axes+1)); {Moving Average and output buffers}
fillchar(Mav^,MavLen*(axes+1),0);
setTB; {must be before CNX}
{load CNX file}
if catch(exception) or runcc then begin
BootLog(Xfile.pname,0);
if security<>superuser then fatalerror(CNXfile);
error:=false;
end;
{load the PLC file}
LoadPLC;
BootLog(selfdir+PLCfile,word(not error));
if error and (security<>superuser) then fatalerror(PLCfile);
error:=false;
if not loadgraph then fatalerror(mydir+vgafile);
BootLog(mydir+vgafile,1);
if not offline then LeadInit;
fillchar(home,sizeof(home),#0);
assign(src,selfdir+updatefile);
reset(src); tic:=ioresult;
if tic=0 then begin
for j:=1 to maxhomes do begin
for i:=1 to sysaxes do read(src,home[j,i]);
readln(src);
end;
for i:=1 to sysaxes do readln(src,xpos[i],oldcorr[i]);
readln(src,curHH);
inc(tic,ioresult); close(src);
end;
beep(1000,200);
if tic<>0 then beep(1000,200);
BootLog(selfdir+updatefile,word(tic=0));
for i:=1 to axes do
if (xpos[i]<nlimit[i]) or (xpos[i]>plimit[i]) then
xpos[i]:=(plimit[i]+nlimit[i]) div 2;
delay(1000);
center(getmessage(469),6);
isSuper(security=superuser);
BootLog(getmessage(811),word(devok)); {servo}
BootLog(getmessage(812),word(TBOK)); {TB}
BootLog(getmessage(813),word(IOok)); {IO}
BootLog(getmessage(820)+stgi(Memram),11); {Free Ram}
boot(false); {close boot log file}
CNCinit;
end; {logon}
function logoff:boolean;
begin
openscreen(bkred+white,$607);
warning(idw,$104);
center(getmessage(806),6); gotoxy(wherex-2,wherey);
isSuper(false);
logoff:=key or $20 = byte('y');
end;
END.
{NC.PAS Copyright (C) 1988, 1998 by Gil Hagiz}
Unit nc;
INTERFACE
{$I debug}
{.$DEFINE Mtst} {call motion not from interrupt}
{.$DEFINE DISK} {Virtual disk for a host}
Uses
Dos,
crt,
files, {virtual files}
screen, {screen routines}
ghmouse, {mouse support}
ugrp, {VGA interface}
windows, {A/N windows}
Dosshell, {Find, copy, shell}
kboard, {Key-board}
cvar, {common vars}
edscrn1, {Fast screen routines}
Helpme, {display help}
mesg, {messages pickup}
dir, {dir pickup}
parser, {Line parsing}
table, {table routines}
ed, {Editor}
uvar, {nc vars}
{$IFDEF DISK}
udisk, {virtual disk}
{$ENDIF}
ini, {read INI file}
tbu, {Teach box unit}
ncpar, {parameter table}
tools, {Tool table}
Errors, {screen messages A/N and graphics}
math, {sin, cos, tan}
coord, {AZ, EL, CYL}
trans, {Robot transformations}
loc, {location handling}
iop, {Input/Outout}
cpl, {compliler}
ncrun, {Run time lib}
ncg; {G code dispatcher}
procedure CNCinit;
procedure leadinit;
procedure cncmain;
procedure oldscreen;
function runcc:boolean;
procedure writetime;
procedure cmd9A; {far}
var
cncdrv: file;
(* ========================================================== *)
IMPLEMENTATION
var
zooming, xzoom,yzoom,zzoom:double;
xyzzoom : array[0..2] of double absolute xzoom;
exitsave: pointer;
oldint70: pointer;
oldint00: pointer;
Ndisplay: longint;
pixels : longint;
OldFeedLow, OldFeedMult, oldoffs, old399 : word;
FewBuffers, tracerr, timer, timer0, oldtimer0, oldtimer1:word;
xcar,ycar,xiso,yiso : integer;
zoomst : string[5];
htab, lastaxis, oldsngle : byte;
findv : boolean;
DosDir : dirstr;
var
Csize:array[0..2] of word;
Cshift:array[0..2] of word;
Cneg :array[0..2] of integer;
corr0:array[0..2] of integer;
CorFile : Frec;
timeoffs:word;
timeattr:byte;
const
LeadPtr : array [1..sysaxes] of bufptr=(nil,nil,nil,nil,nil,nil,nil,nil);
LeadNow : array [1..sysaxes] of word= (0,0,0,0,0,0,0,0);
zoom : allaxes = (400,400,400,400, 400,400,400,400);
trctmp : array [1..sysaxes] of word= (0,0,0,0, 0,0,0,0);
sn30 : single=0.5;
cs30 : single=0.866;
oldindex: longint=-1;
accel : word = $80;
decel : word = $80;
vtime : word = 50; { .01 sec for dwell }
vref : word = 50;
spind : word = 0;
HW : integer=0; {hand wheel}
fe : integer = 0; {following error}
axis : word = 0;
zoomc : integer = 0;
oldaxes : word = $FFFF;
myAxis : word = $FFFF; {used in Axis Misc}
ModuloN : word = 1; {used in simulation}
divisor : word = 20; {20 ms time-constant for simulation}
feedstr : string[12]=' Feed= . %'; {mesg 410}
oldmode : modet = none;
modename: modet = none;
TBold : byte = 0;
CorrFlag :boolean = false;
ntsflName: array [1..5] of char = 'NTSFL';
modecol : array [modet] of word=(
{auto} bkblue +white,
{manual} bkgreen+white,
{chktrc} bkmagenta+white,
{chkref} bkgreen,
{setref} bkred+white,
{sethome} bkwhite+blink+red,
{mdi} bkcyan+blue,
{teach} bkred+blink+yellow,
{none} bkblue+blue); {%%%1-29-96}
modeHlp : array [modet] of string[10]=(
{auto} '[GENERAL]',
{manual} '[GENERAL]',
{chktrc} '[CHKTRC]',
{chkref} '[CHKREF]',
{setref} '[SETREF]',
{sethome} '[SETHOME]',
{mdi} '[MDI]',
{teach} '[TEACH]',
{nop} '');
topcolor : array [boolean] of byte = (bkcyan,bkblue+white);
axiscolor: array [boolean] of byte = (yellow, lightcyan);
imstr : array [boolean] of string[6] = (' MM ',' INCH ');
firstaxis: byte = 1;
SecondTime:boolean=false;
{$L ncl}
procedure myint15; external;
procedure oldint15; external;
procedure clrbuff; external;
procedure motion; far; external;
procedure Simulation; external;
procedure res70; external;
procedure prep70; external;
procedure cmd9A; external;
procedure clrtrc; far; external;
procedure skip; external;
procedure newfeed; external;
procedure updateX(xxDI:word);far; external;
procedure GoASM; external;
function trace:boolean; external;
function trcerr(axs:word):integer;FAR; external;
function ready:boolean; external;
procedure writetime; external;
{ write BIOS time directly to screen}
procedure CMOSwr; external;
function CMOSrd:byte; external;
procedure graphics(s:boolean); forward;
procedure corr3d(on:boolean); FAR; forward;
procedure PLCmesg; FAR; {called from KBOARD}
begin
if trace then begin
if not SecondTime then begin
SecondTime:=true; {avoid recursive calls}
callcc(106);
error:=true; {to skip BreakP}
errors.err(199+byte(Moving>0),-1,axisname[tracerr]);
end;
end else
SecondTime:=false;
if MousEvent=0 then begin
GetMouseEvent(plcvars[90]);
if InWindow and 2 <> 0 then begin
MousMove:=$FF; {non active}
if (MousLft>=2) and (MousRegion<>EntryNo) then KB(1220+MousRegion);
if MousLft=1 then {Release Left Button}
if Mousregion=0 then KB(27) else KB(13);
end;
end;
if plc1flag<>0 then plc02;
{$IFDEF DISK}
if diskOK then getKB; {get char from virtual drive}
{$ENDIF}
end;
{$IFDEF Mtst}
procedure motion1; FAR ;assembler;
ASM;
end;
{$ENDIF}
procedure spoil(num:word); assembler;
const spoiler : longint = $795B3D1F;
{olds[num]:=olds[num] xor spoiler}
ASM;
mov ax,word ptr spoiler
mov bx,num
add bx,bx
xor word ptr [bx+olds-18],ax {olds[9..vars]}
db 66h
ror word ptr spoiler,1
end;
function diowrite:boolean; assembler;
const
devcmd : word = 0; {driver write data block}
{$IFDEF Mtst}
devptr : pointer= @motion1;
{$ELSE}
devptr : pointer= @motion; {first byte of devcmd is junk}
{$ENDIF}
ASM; {now enable interrupts}
mov ax,04403h {write device IOCTL}
mov cx,5 {byte count}
mov dx,offset devcmd+1 {ds= segment}
mov bx,word ptr cncdrv
int 21h {DS:DX= ptr to data block}
mov al,0 {CF=1 @ error}
rcl al,1
end;
(**************************************************************)
procedure initalways;
{for CS after Hold or CS in MDI}
(**************************************************************)
begin
clrbuff;
buffers[0].feed:=vtime;
buffers[0].feedratio:=100; {non zero}
skipPort:=0;
end;
(**************************************************************)
procedure shortbuff(short:byte); FAR;
(**************************************************************)
begin
if short in [1..maxbuffers-1] then begin
if tracing=0 then begin
tracing:=short; v64H:=1; fewbuffers:=short;
Buffers[tracing].next:=ofs(buffers);
end;
end else begin {default}
Buffers[tracing].next:=ofs(buffers[succ(tracing)]);
tracing:=0; v64H:=0; fewbuffers:=maxbuffers;
end;
initalways;
end;
(**************************************************************)
procedure init;
(**************************************************************)
begin
shortbuff(0); {does InitAlways}
ToolComp:=false; prevtc:=0; rt:=0; par[prt]:=0;
ptr0:=0; ptr1:=0;
end;
procedure initCS; assembler;
ASM;
call init
call runinit
end;
procedure irqon;
begin
{$IFNDEF Mtst}
if offline then
prep70
else begin
reset(cncdrv);
InOutRes:=0;;
diowrite; {enable interrupts}
end;
{$ENDIF}
irq:=true;
if not graphnow then loader; {%%%02-05-94}
end;
procedure irqoff;
begin
if Ractual or Rdesired <> 0 then RotExactStop;
if offline then res70
else close(cncdrv);
InOutRes:=0;
irq:=false;
end;
procedure cc100(k:integer); {call cc-100 with #199:=k}
begin
dbli(par[199])[1]:=k;
dbli(par[199])[4]:=-1;
callcc(100); {#199=k}
end;
function runcc:boolean; {true --> error}
begin
{Run the CNX file, assume failure}
runcc:=true;
Fassign(Xfile,selfdir+CNXFile);
Fptr:=@Xfile;
if getCPLfile=0 then begin
initCS;
while Readline do CNC;
BootLog(Xfile.pname,1);
runcc:=false;
if TBnew then cc100(-1);
end;
end; {runcc}
procedure indicator(i:runmodet);
begin
if error then exit;
runmode:=i;
writetext(getmessage(400+word(runmode)), 44, 1, topcolor[runmode in
[reseti,runi]]);
end;
procedure isometric;
begin
if graphic then begin
iso:=not iso;
pageselect(iso);
end;
end;
procedure dryrn(s:integer);
begin
if mode=setref then s:=0; {%%%06-17-96}
tac:=dryrun;
if s>=0 then begin
if dryrun<>s then dryrun:=s else dryrun:=0;
end else
if not graphnow and (dryrun>=2) then dryrun:=0;
case dryrun of
0 : writetext(' ',25,1,bkblue); { 9 }
1 : writetext(getmessage(412),25,1,bkcyan); {DRYRUN}
2,6: begin
if not graphic then graphics(true);
word(pixels):=0;
if dbli(par[stop])[4]<0 then
pixels:=round(-par[stop]); {in search}
writetext(getmessage(413),25,1,white); {TEST}
end;
end;
if (tac>=2) or (dryrun>=2) then updatepos;
end;
procedure restoreNTSFL;
var j:word;
begin
if GraphScr then exit;
for j:=11 to 15 do begin
if big[j]<>0 then bigtext(ntsflName[j-10],hor[j],ver[j],yellow,big[j]);
end;
imdisplay:=true; {restores NTSFL}
for tic:=9 to vars do spoil(tic);
ASM
db 66h
inc word ptr Ndisplay
end;
resNTSFL:=false;
end;
procedure restoreaxes(key:integer);
var tmpaxes:byte;
col : byte;
i,j : byte;
visible:boolean;
begin
if (CurWindow<>0) or graphScr then exit;
if mode=chktrc then tmpaxes:=0 else tmpaxes:=displayaxes-1;
case key of
(*1072 {UP} : if firstaxis>1 then dec(firstaxis);
1080 {DN} : inc(firstaxis);*)
1..8 : if key<firstaxis
then firstaxis:=key
else if key>lastaxis then firstaxis:=key-tmpaxes;
{else : re-display }
end; {case}
if firstaxis>axes-tmpaxes then firstaxis:=axes-tmpaxes;
lastaxis:=firstaxis+tmpaxes;
axis:=firstaxis-1;
if (tmpaxes=0) and not (mode in [auto,MDI]) then handaxis:=firstaxis;
oldhand:=handaxis;
visible:=false;
for i:=firstaxis to lastaxis do {Display axis names}
if big[i]<>0 then begin
j:=i-firstaxis+1;
if i=handaxis then begin
col:=$8F;
visible:=true; {blink the selected axis}
end else
col:=axiscolor[xlat[i] and raxes <> 0];
bigtext(axisname[i],hor[j],ver[j],col,big[i]);
end;
if not visible then handaxis:=0;
disflagset;
end;
procedure writemode;
begin
writetext(getmessage(490+word(modename)),65,1,modecol[modename]);
end;
procedure writeUnit;
begin
writetext(imstr[inchNow],2,1,topcolor[inchsys=inchNow]);
end;
procedure GetHoldMode; {Reset or Hold}
begin
with Fptr^ do
RunMode:=runmodet((mode=$D7B3) and ((block<>0) or (BufPos<>prg00)));
end;
procedure topline; {re-write top line}
begin
edsetcursor($2000); { no cursor }
BlueTop;
dryrn(-1);
inc(OldFeedMult);
writemode;
writeUnit;
indicator(RunMode);
inc(oldoffs,10);
inc(oldsngle);
oldaxes:=useH;
end; {TopLine}
procedure newplace;
begin
if mode <>MDI then begin
if not graphnow then
ASM; {clear screen}
mov es,segb800
mov di,160 {row=2}
mov cx,80*23 {23 rows}
xor ax,ax
CLD
rep stosw {clear 23 rows}
cmp kanji,0
jz @9
mov di,160 {if Kanji, copy to screen}
mov cx,80*23
mov ah,0FFh
int 10h
@9:
end;
fillchar(big,sizeof(big),#0);
end;
dbli(par[190])[4]:=-1;
dblw(par[190])[1]:=word(mode)+2;
if graphic then dbli(par[190])[1]:=1;
RST:=0;
callcc(114); {sets places}
oldhand:=$FFFF; {calls restoreaxes() later}
resNTSFL:=true; {calls restoreNTSFL later}
end;
procedure drawscreen;
var i:integer;
begin
nosound;
if not error then topline;
imdisplay:=true;
newplace;
if modename<>MDI then WRprogname;
end;
procedure ProgReset;
begin
repeat until PopPrg=0; spp:=0;
toolcomp:=false;
getprogname;
end;
procedure M2;
begin
callcc(2);
ExactStop;
ProgReset;
Nrun:=0;
Npof:=0;
initCS;
callcc(107);
end;
procedure runauto;
begin
if Fptr^.mode<>$D7B3 then Exit;
if RunMode=Reseti then begin
initCS;
Nrun:=0;
Npof:=0;
if dryrun>=2 then movfam(ofs(grany),ofs(grand));
end else begin
initalways;
dooffset(o);
end;
if key<>1198 then begin
callcc(107); {if not running CNX file}
indicator(runi); {change mode after cc-107}
end else
runmode:=edit; {for run-time errors}
repeat
if not Readline then break; {false if RST or EOF}
Hold:=0;
CNC;
until hold <> 0;
ExactStop;
if RST=0 then begin
case hold of
0,1 : begin {End, Single,m0}
if dryrun>=2 then begin
for tic:=1 to axes do grand[tic]:=grand[tic]+flzero[tic];
end;
if Model='C' then grand[Z3]:=grand[Z3]-ZT;
home[posHome]:=grand;
curHH:=Vaxes;
callcc(0);
exit;
end;
2 : M2;
end;
if Curwindow<>0 then begin
CloseAllWin;
oldscreen;
end;
end;
end; { RunAuto }
procedure runMDI;
begin
initalways;
Hold:=0;
CNC; { line has already been read }
ExactStop;
if RST=0 then
if hold=2 then M2;
mode:=savemode;
end; { runMDI }
procedure cycle_start;
begin
if mode=Auto then begin
runAuto;
end else begin
indicator(runi);
case mode of
MDI : runMDI;
setref : begin initCS; No_stop:=false; Corr3d(false); callcc(103); end;
chkref : begin initCS; No_stop:=false; callcc(113); end;
else ouch;
end;
end;
GetHoldMode;
indicator(RunMode);
No_stop:=true;
end;
procedure goedit(run_error:boolean);
begin
error:=false;
if mode=MDI then begin
doMDI(run_error);
GetHoldMode;
drawscreen;
end else begin
IrqOff; {disable interrupts}
mode:=auto;
if not graphic then begin
textmode(co80); directvideo:=not Kanji; checksnow:=false;
end;
prgsp:=0;
runmode:=edit; {indication for the error routine}
doedit(run_error);
IrqOn; {enable interrupts, Loader}
GetHoldMode;
if graphic then
graphics(false)
else
drawscreen;
end;
if v70<>0 then getwheel;
end; {goedit}
function grp:boolean; assembler;
const msw=$819E; {exp*2 of 15872}
ASM;
mov ax,word ptr xzoom+6
add ax,ax
cmp ax,msw
jae @exit
mov ax,word ptr yzoom+6
add ax,ax
cmp ax,msw
jae @exit
mov ax,word ptr zzoom+6
add ax,ax
cmp ax,msw
jb @0
@exit:
mov al,1
jmp @9
@0:
{ycar:=y*aspect;}
fld aspect {a }
fld yzoom {a,y }
fld st {a,y,y }
fmul st,st(2) {a,y, y*a }
fistp ycar {a,y }
{xcar:=x;}
fld xzoom
fist xcar {a,y,x }
{xiso:=(y+x) * cos(30);}
fld st(1) {a,y,x,y }
fadd st,st(1) {a,y,x, x+y}
fmul cs30
fistp xiso {a,y,x }
{yiso:=((y-x)*sin(30)+z ) * aspect;}
fsub {a,y-x }
fmul sn30 {a,(y-x)/2 }
fadd zzoom {a,(y-x)/2+z }
fmul
fistp yiso
xor ax,ax
@9:
end;
procedure setzoom;
begin {zoom= .010 to 10.0}
zooming:=exp(ln10*zoomc/6);
str(zooming:5:(12-zoomc) div 6, zoomst); { (12-zoomc) div 6 --> 1,2,3}
zooming:=zoomratio*zooming;
for tic:=1 to axes do zoom[tic]:=zooming*MetricS[tic];
writetext(getmessage(485)+zoomst,65,2,white);
end;
procedure graphline; FAR;
const
oldxc:integer=0;
oldyc:integer=0;
oldxi:integer=0;
oldyi:integer=0;
label Exitpoint;
begin
if not graphnow then exit;
xzoom:=(grand[xyz[17]]-testzero[xyz[17]])*zooming;
yzoom:=(grand[xyz[18]]-testzero[xyz[18]])*zooming;
if zh=0 then dblw(zzoom)[4]:=0
else zzoom:=(grand[xyz[19]]-testzero[xyz[19]])*zooming;
if grp then goto ExitPoint;
case gg of
0,10,20 : graphptr^.style:=LEDs;
else graphptr^.style:=$FFFF;
end;
setline(hx+oldxc, hy-oldyc, hx+xcar, hy-Ycar,2);
setline(hx+oldxi, hy-oldyi, hx+xiso, hy-yiso,4);
oldxc:=xcar; oldyc:=Ycar;
oldxi:=xiso; oldyi:=yiso;
Exitpoint:
if (abs(xcar)<word(pixels)) and (abs(ycar)<word(pixels)) then sngle:=3;
hold:=sngle and 1;
end;
procedure dographic;
begin
xzoom:=(xpos[xyz[17]]-graphzero[xyz[17]])*zoom[xyz[17]];
yzoom:=(xpos[xyz[18]]-graphzero[xyz[18]])*zoom[xyz[18]];
if zh=0 then
dblw(zzoom)[4]:=0
else
zzoom:=(xpos[xyz[19]]-graphzero[xyz[19]])*zoom[xyz[19]];
if grp then exit;
setpixel(hx+xcar, hy-Ycar, 2);
setpixel(hx+xiso, hy-yiso, 4);
end;
procedure restorefeed;
const feedaddr : pointer=@feedstr[7];
var col:word;
begin
OldFeedMult:=FeedMult; OldFeedLow:=FeedLow;
ASM;
mov ax,feedMult
mov bx,2000
mul bx
add ax,ax
adc dx,0
mov tic,dx
end;
case tic of
0 : col:=bkred+blink+white;
1..999 : col:=bkcyan;
1000 : col:=bkblue+white;
else col:=bkwhite+red;
end; {case}
if FeedLow=0 then col:=bkred+blink+white
else if FeedLow<FeedMult then col:=bkred+white;
case FeedLow of
0 : col:=bkred+blink+white;
1 : col:=bkblue+white;
else
if FeedLow<FeedMult then
col:=bkred+white
else
case tic of
0 : col:=bkred+blink+white;
1..999 : col:=bkcyan;
1000 : col:=bkblue+white;
else col:=bkwhite+red;
end; {case}
end;
str(tic:4, TBfeed);
ASM;
or TBset,1 {flag for TB display}
mov si,offset TBfeed+1
les di,feedaddr
cld
movsw
movsb
inc di {skip the decimal point}
movsb
end;
writetext(FeedStr, 52,1, col); { 12 }
end;
procedure SaveUpdateFile;
var dst:text; i,j:integer;
begin
assign(dst,selfdir+updatefile);
rewrite(dst);
if IOresult=0 then begin
for j:=1 to maxhomes do begin
for i:=1 to sysaxes do write(dst,' ',home[j,i]:10:4);
writeln(dst);
end;
for i:=1 to sysaxes do writeln(dst,xpos[i],' ',oldcorr[i]);
writeln(dst,curHH);
close(dst); InOutRes:=0;;
end;
end;
procedure dotopline;
begin
if error then exit; {do not overwrite error message}
if (Vaxes<>oldaxes) and (useH<>0) then begin
oldaxes:=Vaxes; str(VaxesL, TBhh);
writetext('H'+char($2B+vaxesH shl 1)+TBhh,9,1,bkblue+white);
ASM; or TBset,8; end; {flag for TB display}
end;
if offsno<>oldoffs then begin
oldoffs:=offsno;
writetext(getmessage(414)+stg(offsno)+' ',13,1,topcolor[offsNo=o]);
end;
if sngle<>oldsngle then begin
oldsngle:=sngle;
if odd(sngle) then writetext(getmessage(411),35,1, bkcyan) { 8 SINGLE}
else writetext(' ',35,1, bkblue);
end;
if mode<>oldmode then begin
if mode>none then mode:=none;
if modename<>teach then modename:=mode;
if (mode<>MDI) or (oldmode<>sethome) then writemode;
if (mode=sethome) and (oldmode=mdi) then SaveUpdateFile;
OneAxis:=false;
case mode of
chktrc,
chkref, {%%%05-09-93}
setref : begin
oneaxis:=true;
vaxes:=0; dooffset(0);
if (mode=chktrc) or graphic then
graphics(graphic); {A/N}
end;
sethome : begin
if graphic then graphics(true);
disflagset;
if offsno<3 then dooffset(4);
end;
MDI : begin
savemode:=oldmode;
if graphic then begin
graphics(true);
Exit; {update axis display}
end;
end;
end; {case mode}
if oldmode=MDI then EDchangeattribute(80,1,2,black);
handaxis:=0;
CorrFlag:=false;
dryrn(0); {%%%06-17-96}
oldmode:=mode;
disflagset;
newplace;
if mode=MDI then
goedit(false)
else begin
WRprogname;
end;
if LinTC<>oldTC then TConst(oldTC);
end; {oldmode<>mode}
if (FeedMult<>OldFeedMult) or (FeedLow<>OldFeedLow) then RestoreFeed;
end;
procedure addcorr; assembler;
{ax= new correction
si= axis 0,2,4,...}
ASM;
mov [si+offset corrPLC],ax {corrPLC[axis]:=newcorr}
mov bx,si
cmp CorrFlag,0
jnz @1
mov dx,ax {DX too}
xchg dx,[si+offset oldcorr] {oldcorr[axis]:=newcorr}
sub ax,dx {AX= newcorr-oldcorr[axis]}
add [si+bx+offset corr],ax {inc(twoint(corr[axis]).lo, dcorr)}
ret
@1:
mov [si+offset oldcorr],ax {oldcorr[axis]:=newcorr}
db 66h,98h {cwde}
db 66h
sub word ptr [si+bx+Xpos],ax {one command}
end;
procedure AxisMisc; assembler;
var tmp:longint;
const an360:single=360.0;
ASM;
xor cx,cx
mov di,myAxis
inc di
cmp di,axes
jb @1
je @3D {3D correction}
xor di,di
@1:
mov myAxis,di {myAxis= 0..axes-1}
mov si,di {SI= byte ptr}
shl di,2 {DI= dword ptr}
{must be one command or use CLI/STI}
xchg cx,word ptr [di+corr+2] {+1 or -1}
test cx,cx
jz @99 {exit if no motion}
{flag for updating the display, written here for time saving}
mov al,byte ptr [si+xlat+1] {xlat begins from zero}
or disflag,al {al= 1,2,4,8..$80}
mov ah,1
or Moving,ax
lea bx,[si+1] {BX= axis - 1..axes}
cmp bx,ASpin
jne @noSpin
{correct Xpos +-180 deg for Spindle}
fild Sp360 {Sp360}
cli
{*********************** no interrupts}
fild dword ptr [di+xpos] {Sp360, Xpos}
db 0D9h,0F5h {fprem1} {Sp360, Remainder(st/st(1))}
cmp Ractual,0 {is spindle running?}
jz @Stand {jmp if not}
fist dword ptr [di+xpos] {corrected Xpos- +- 180}
@Stand:
{*********************** no interrupts end}
sti
fstp st(1) {pop Sp360}
cmp bx,BSpin
jne @noSpin1
fmul an360 {mul by 360 for RPM spindle}
jmp @noSpin1 {Xpos}
@noSpin: {regular axis}
{convert position to mm}
fild dword ptr [di+xpos] {Xpos}
@noSpin1:
mov bx,di {DI+BX= qword ptr}
fmul qword ptr [di+bx+metricS]
fistp dword ptr tmp {tmp:=round(xpos[i]*metricS[i])}
{time saving before wait}
add si,si {SI= word ptr}
fwait
mov ax,word ptr tmp {AX= current position mm}
mov [si+offset v21],ax {PLC #21 to #28}
and cl,corr1 {0 or 1}
test cx,[si+offset LeadNow] {0=no table}
jz @99 {exit if no table}
{find table}
les di,[di+offset LeadPtr] {ES:DI= ptr to table}
{Table Rec= Max:word, shr:word, Negative:word; data:array[0..Max] of word}
mov cx,es:[di+2] {CX= shift const}
mov bx,word ptr tmp {BX= current position mm}
sub bx,es:[di+4] {BX= ofs from most negative}
jg @3 {jmp if position > negative}
xor bx,bx
@3:
clc {in case cl=0}
shr bx,cl {BX= weighted current position}
adc bx,0 {rounding}
add bx,bx {byte to word ptr}
cmp bx,es:[di] {cmp bx,Max byte}
jb @4
mov bx,es:[di] {if BX > Max then BX:= Max}
@4:
mov ax,es:[di+bx+6] {AX= new correction}
call addcorr {SI= axis- 0,2,4..}
jmp @99
@3D:
{3D correction} {CX=0}
mov myAxis,di {myAxis= 0..axes}
cmp corr3,cl
jz @99
mov di,4 {begin with Z}
xor ax,ax
xor dx,dx
jmp @11
@10: {loop for z,y,x index}
mov cx,word ptr [di+offset Csize]
inc cx
mul cx {dx=0 until 3rd mul}
@11:
mov si,[di+offset v21] {PLC #21 to #28}
mov cx,[di+offset Cshift] {CX= shift const}
sub si,[di+offset Cneg]
jg @13
xor si,si {if SI < Min then SI:=0}
@13:
clc {in case cl=0}
shr si,cl {SI= weighted current position}
adc si,0 {rounding}
cmp si,[di+offset Csize] {cmp SI,Max}
jb @14
mov si,[di+offset Csize] {if SI > Max then SI:= Max}
@14:
add ax,si
adc dx,0
sub di,2
jns @10 {loop for table's z,y,x}
cmp ax,word ptr oldindex {dx:ax= new index}
jne @15
cmp dx,word ptr oldindex+2
je @99
@15:
mov word ptr oldindex,ax
mov word ptr oldindex+2,dx
push ds
push offset corfile
push dx
push ax
call Rseek
push ds
push offset corfile
push ds
push offset corr0
call readR {read record into corr0}
mov si,4 {SI= axis- 4,2,0}
@16:
mov ax,[si+offset corr0] {AX= new correction}
call addcorr
sub si,2
jns @16
@99:
end;
(**************************************************************)
procedure display;
(**************************************************************)
{ 6 9 3 15 8 25 9 35 8 44 8 53 11 65 16
INCH | H+5 | OFFS #1 | DRY-RUN | SINGLE | HOLD | FEED=12.3%| REFERENCE
TEST
}
const
feedL : word=0;
feedH : integer=0;
numstr : string[79]='';
var
trcmm : double;
XDisplay : double;
longfeed : longint absolute feedL;
trcunit : longint;
trc,vtab : integer;
hpos,vpos: byte;
TBmodeW : word absolute TBmode;
size : byte;
color : byte;
sign : shortint;
minstr,maxstr:string[20];
label noN;
begin
if CurWindow>0 then exit;
if (TBnow xor TBold) >=$80 then begin
TBold:=TBnow;
modename:=none;
if oldmode=mode then oldmode:=none;
if TBnow>=$80 then begin
if graphic then graphics(true);
dryrn(0);
modename:=teach;
end;
if TBnew then cc100(-1); {update TB screen}
end;
DoTopLine; {%%%1998-03-18}
if (dryrun>=2) and not odd(sngle) then exit;
if (TBmodeW and $8080 =$8000) and (TBset<>0) and (TBout=0) then TBupdate;
if resNTSFL then restoreNTSFL;
if handaxis<>oldhand then begin
if handaxis>axes then handaxis:=0;
restoreaxes(handaxis);
if handaxis=0 then oneaxis:=false;
end;
if axis<lastaxis then begin
inc(axis);
tic:=axis-firstaxis+1;
vpos:=ver[tic];
hpos:=hor[tic];
size:=big[tic] and 3;
if (disflag and xlat[axis] <> 0 ) or (mode=chktrc) then begin
disflag:=disflag and not xlat[axis];
case mode of
setref:XDisplay:=(xpos[axis]-abszero[axis])*scaled[axis];
chktrc:begin
trc:=trcerr(axis);
XDisplay:=scaled[axis]*trc;
if vactual<=1 then begin
if Pflags<0 then
ASM;
mov ax,trc
cwd
add ax,dx
xor ax,dx {ax= abs(trc)}
shl ax,6 {ax*64}
push ax
call sound
end;
end else begin {vactual>1 , vactual = mm/min }
trcmm:=abs(MetricS[axis]*fe);
if jogL<>0 then begin
str(trcmm*60000/feed:wd+2:1,maxstr);
bigtext(maxstr,hor[12]+big[12],ver[12],yellow,big[12]);
end;
timer0:=timer shr 5;
if timer0<>oldtimer0 then begin
oldtimer0:=timer0;
inc(htab);if htab>79 then htab:=79;
trcunit:=round(trcmm*points*ffg0[axis]);
vtab:=word(trcunit) div points;
if vtab>23 then vtab:=23;
writepel(char(word(trcunit) mod points + $A0),
htab,24-vtab,yellow);
end;
end;
end; {chktrc}
else {not chktrc or setref}
if mode=sethome then begin
str((nlimit[axis]-xpos[axis])*scaled[axis]:dig:fd,minstr);
str((plimit[axis]-xpos[axis])*scaled[axis]:dig:fd,maxstr);
writetext(getmessage(483)+maxstr,50,vpos,lightgreen);
writetext(getmessage(484)+minstr,50,succ(vpos),lightred);
end;
if dryrun and 2 <> 0 then begin
v399:=0;
XDisplay:=grany[axis]/metricS[axis]*scaleD[axis];
end else begin
XDisplay:= scaled[axis] * xpos[axis];
if axis=diff1 then
XDisplay:=XDisplay - xpos[diff0] * DiffScale;
if Model<>'M' then
XDisplay:=XDisplay - FixD[axis];
if (Model='C') and (axis=Z3) and (g53F<>0) then
Xdisplay:=Xdisplay - par[pzt];
end;
if v399=1 then
XDisplay:=
(daddy[axis]+flaxis[axis])/metricS[axis]*scaleD[axis]-XDisplay;
end; {case mode}
if size<>0 then begin
{$IFDEF DISK}
if diskOK then Disk^.AxisPos[axis]:=XDisplay;
{$ENDIF}
str(XDisplay:dig:fd,numst);
bignum(axis,hpos+size,vpos,
axiscolor[xlat[axis] and raxes <> 0],size);
end;
end; {disflag<>0}
end else begin
axis:=pred(firstaxis);
timer0:=timer and $1FF;
if not graphnow and (timer0<>oldtimer1) then begin
oldtimer1:=timer0; writetime;
end;
if v399<>old399 then begin
old399:=v399;
disflagset;
end;
if imdisplay then begin
disflag:=$FF;
ASM
db 66h
inc word ptr Ndisplay
end;
for tic:=12 to 15 do begin
spoil(tic);
size:=big[tic];
if size<>0 then
bigtext(' ',hor[tic]+(byte(tic=14) shl 1 + 5) * size,
ver[tic],black,size);
end;
if not error then writeUnit; {do not overwrite error message}
imdisplay:=false;
end;
if big[11]<>0 then begin {N display}
ASM;
mov ax,v390
dec ax
jz @1
jns @2
@0:
db 66h
mov ax,word ptr nn {#390=0}
jmp @9
@2: {#390=2}
db 66h
mov ax,word ptr Npof
jmp @9
@1: {#390=1}
db 66h
mov ax,word ptr Nrun
@9:
db 66h
cmp word ptr Ndisplay,ax
je noN
db 66h
mov word ptr Ndisplay,ax
end;
str(nn:5,TBnn); str(Ndisplay:wd,numstr);
size:=big[11] and 3;
bigtext(numstr+' ',hor[11]+size,ver[11],yellow,size);
ASM; or TBset,2; end; {flag for TB display}
noN:
end;
if (curtool<>olds[12]) and (big[12]<>0) then begin
olds[12]:=curtool;
size:=big[12] and 3;
str(curtool:wd,numstr);
bigtext(numstr,hor[12]+size,ver[12],yellow,size);
end;
if (spindle<>olds[13]) and (big[13]<>0) then begin
olds[13]:=spindle; str(spindle:wd, numstr);
size:=big[13] and 3;
bigtext(numstr,hor[13]+size,ver[13],yellow,size);
end;
feedL:=feed; {08-23-92}
if (feedL<>olds[14]) and (big[14]<>0) then begin
olds[14]:=feedL;
if inchNow then str(FintF*0.03937*longfeed:8:2,numstr) { 1/25.4 }
else str(feedL:6,numstr);
size:=big[14] and 3;
bigtext(numstr,hor[14]+size,ver[14],yellow,size);
end;
if (l<>olds[15]) and (big[15]<>0) then begin
olds[15]:=l; str(l:5,TBll);
size:=big[15] and 3;
bigtext(MMspace+TBll,hor[15]+size,ver[15],yellow,size);
ASM; or TBset,4; end; {flag for TB display}
end;
for tic:=16 to vars do
if big[tic]<>0 then begin
tac:=word(plcvars[tic+PLCbase]);
if tac<>olds[tic] then begin
olds[tic]:=tac;
sign:=shortint(big[tic]);
size:=abs(sign);
toe:=wd;
color:=Pcol[tic];
if size>=$10 then begin
toe:=size shr 4;
size:=size and 7;
end;
if byte(sign)=$80 then begin
numstr:=GetPLCmesg(tac and $FF,false);
if hi(tac)<>0 then color:=hi(tac);
writetext(numstr,hor[tic]+1,ver[tic],color);
end else begin
if sign<0 then
str(integer(tac):toe,numstr)
else
str(tac:toe,numstr);
bigtext(numstr,hor[tic]+size,ver[tic],color,size);
end;
end;
end;
{====================}
{ DoTopLine; %%%1998-03-18}
end;
end;
{$I graph0} {%%%01-31-94}
(**************************************************************)
procedure background; FAR;
(**************************************************************)
const oldtime:word=0;
begin
{$IFDEF Mtst}
{for tic:=1 to 10000 do ;Simulation;}
if movinf<>0 then PAR[1]:=PAR[1]+20;
for tic:=1 to 20 do motion;
{$ENDIF}
goASM;
ASM;
mov cx,v70
jcxz @9
mov ax,timer
shr ax,cl {check every 2**n msec}
cmp ax,oldtime
je @9
mov oldtime,ax
call getwheel
add HandWheel,ax
@9:
end;
if HW<>0 then newfeed;
TBloop;
AxisMisc; {%%%05-14-95}
if not GraphScr then begin {%%%01-31-94}
display;
if graphnow then dographic;
end else begin
DoTopLine;
DoGraph0; {in Graph0.pas}
end;
end; { background }
procedure graphics(s:boolean);
var x,y:word;
begin
graphic:=graphic xor s;
if graphic then begin
gograph;
pageselect(iso);
drawscreen;
setzoom;
end else begin
goAlpha; {graphnow:=false}
checksnow:=false;
loader;
drawscreen;
end;
end; {graphics}
procedure oldscreen; assembler;
ASM;
mov al,kanji
or al,graphic
jz @0
push 0
call graphics {if Kanji or graphic then draw screen}
@0:
end;
procedure test(sw:word); FAR;
begin
case sw of
0 : if graphic then graphics(true); {Alpha}
1 : begin
CloseAllWin;
if dryrun<2 then dryrn(6); {set test}
graphics(false); {clear screen}
end;
2,3: pageselect(boolean(sw-2));
end; {case}
end; {test}
procedure getTBfeed; assembler;
{ key:=key-1200;
if lo(key)<=TeachTable[0] then begin
FeedSelector:=TeachTable[key];
FeedMult:=FeedTable[FeedSelector]
end;}
ASM;
mov ax,key
mov bx,offset TeachTable
sub ax,1200 {AX= 1..10}
cmp al,[bx] {length of table}
ja @exit
xlat {get value from table}
mov FeedSelector,ax
add ax,ax {byte to word}
mov bx,ax
mov ax,word ptr [bx+FeedTable]
mov FeedMult,ax
@exit:
end;
procedure ChkJogReleased; {called if JogL<>0}
begin
if TBnow>=$80 then begin
TBloop;
if TBkey<>0 then Exit;
end else begin
if (mem[seg0040:$17] and $C = $C) or (JogL>=$80) then Exit;
end;
SKP:=true;
JogL:=0; {Don't call again}
end;
function buffClear:boolean; assembler;
ASM;
xor ax,ax
mov bx,axes
les si,mav
cld
@loop:
mov di,si
mov cx,LinTC0
repz scasw
jnz @exit0
add si,mavLen
dec bx
jnz @loop
inc ax
@exit0:
end;
(**************************************************************
W A I T I N G L O O P
***************************************************************)
procedure go_wait(ExitFlag:word); FAR;
var done:boolean;
begin
RSTer:=0; {flag to disable RST}
repeat
goASM;
plcmesg;
if (JogL<>0) and (jogH=0) then ChkJogReleased;
{SKP:=(RST<>0) or SKP or
(skipPort<>0) and ((port[skipPort] and mask0)=mask1);
Port returns True data %%%12-23-92
Skip:= port and mask0 = mask1;
mask0= bits to detect.
off:mask1=0 --> detects comp bits
on: mask1=bits --> detects true bits,
all:mask1=bits, mask0=FF}
ASM;
xor ax,ax
cmp SKP,al
jnz @9 {already done - exit}
cmp RST,al
jnz @8 {SKP:=RST}
mov bx,SkipPort
cmp bx,ax {no port}
jz @9
cmp bl,inport
jbe @1 {jmp if real port}
add bx,bx {PLC var - byte to word offset}
mov ax,word ptr [bx+plcvars]
jmp @2
@1:
mov di,rd8
call dword ptr IOdd
@2:
and ax,mask0
cmp ax,mask1
lahf {40h=equal}
xor ah,mask2 {40h for Toggle}
test ah,40h
je @9
@8:
mov SKP,1
@9:
end;
{findv--> false enables assignment into vhigh}
findv:=not SKP and (runmode<>dwelli);
if SKP then begin
vhigh:=1; {decel and stop}
no_decel:=false;
if (RST=0) and (dblw(par[190])[1]=0) and (dbli(par[190])[4]=-1) then begin
skip;
inc(dblw(par[190])[1]); {#190:=1}
end;
if Vactual<=1 then clrbuff; {and exit by 'if READY'}
end;
if ready then begin
case ExitFlag of
0: done:=true;
1: done:=decelflag and (Vactual<=minfeed);
{%%%05-21-1999: don't build buffers if feed=0}
else done:=(FeedMult<>0) or SKP;
end;
if done then begin
if Pflags<0 then nosound;
if no_decel or BuffClear then begin
if SKP then
{for i:=1 to axes do
if g53f=0 then
par[190+i]:=xskip[i]*metricS[i]
else
par[190+i]:=xskip[i]*scaled[i])-fixD[i];}
ASM;
xor bx,bx
xor cx,cx
xor di,di
mov si,offset MetricS
cmp g53F,cl
jz @1
inc cx
mov si,offset scaleD
@1:
fild dword ptr [bx+xskip]
fmul qword ptr [si]
jcxz @2
fsub qword ptr [di+fixD]
@2:
fstp qword ptr [di+par+191*8]
add di,8
add si,8
add bx,4
cmp bx,axis4
jb @1
end;
Exit;
end;
end;
end;
if Pflags<0 then sound(Vactual shr 4);
if keyready then begin {Keypressed}
CurKey:=0;
case key of
1063 : {F5 } dryrn(1);
1201..1210 : getTBfeed;
1111 : {ALT-F8} SKP:=skipPort>0;
(* 1072 , {UP ARROW}
1080 : {DN ARROW} if handaxis=0 then restoreaxes(key); *)
1112 : {ALT-F9} if runmode=dwelli then begin
SKP:=true;
Exit;
end else
feedMult:=feedtable[feedselector];
1106 : {ALT-F3} isometric;
$1B : {ESC} RST:=1;
else CurKey:=Key;
end;
end; {if keypressed}
background;
until false;
end;
procedure breakNow; FAR;
begin
exactstop;
toolcomp:=false;
updatepos;
end; { breakNow }
procedure dwell(dly:double); FAR;
var numstr:string[20]; tmp:double; time:longint;
oldfeed0,i,q:word; oldmode:runmodet; oldstop:boolean;
begin
{timer:=0;}
if not irq then exit;
if dryrun=2 then dly:=0.05;
oldstop:=no_stop;
oldfeed0:=feed0;
no_stop:=false;
exactstop;
oldmode:=runmode; runmode:=dwelli;
dly:=dly*10;
fillchar(xnew,axes*4,#0);
findv:=false;
feed0:=vtime; {1 pulse per 0.01 sec}
vactual:=vtime; vhigh:=vtime; vdesired:=vtime;
lenRatio:=1; {Feed display = 0 %%%10-23-97}
largest:=round(frac(dly)*10);
feedratio:=round(131.0*1024/irqs);
dly:=int(dly);
moving:=$8000;
no_decel:=dly>=1;
if largest>0 then begin makebuffer; go_wait(0); end;
if no_decel then begin
indicator(dwelli);
largest:=10; tmp:=dly;
while (dly>-Fewbuffers) and not SKP do begin
makebuffer; go_wait(0); dly:=dly-1;
q:=0;
for i:=0 to fewbuffers do inc(q, buffers[i].qCnt);
tmp:=abs((q/10+dly)/10);
str(tmp:12:1,numstr);
writetext(numstr+' ', 51,1, yellow); { 13 }
end;
clrbuff;
inc(OldFeedMult);
indicator(oldmode);
RestoreFeed;
end;
runmode:=oldmode;
SKP:=false; skipPort:=0;
no_stop:=oldstop;
feed0:=oldfeed0;
moving:=0;
(*writetext(stg(timer),2,23,yellow);*)
end;
(**********************************************************
*************** J O G G I N G *******************
JOG********************************************************)
procedure jog(JogLo:byte); FAR;
var
tmploc:locrec;
label exitpoint;
begin
updatepos;
if (word(handaxis-1)>=axes) and (JogLo<6) then goto exitpoint;
case mode of
mdi,auto,sethome : goto exitpoint;
chktrc : begin drawscreen; htab:=0; end;
end; {case}
if (word(handaxis-1) < 3) and wristmode and (JogLo<5) then begin
wrist; {trans %%%02-14-1999, axis and direction are taken from PLC}
end else begin
ZerInc1:=false;
case JogLo of
2,3 : begin
daddy[handaxis]:= 0;
if handaxis=ASpin then ZerInc1:=true;
end;
1 : begin
if (Vaxes=0) or ((VaxesL or 1 <>5 ) and (handaxis or 1 =5)) then
if mode<>setref then begin
daddy[handaxis]:=
plimit[handaxis]*MetricS[handaxis]-flzero[handaxis];
if (Model='C') and (g53F<>0)
and (handaxis=Z3) then daddy[Z3]:=daddy[Z3]-zt;
end else
daddy[handaxis]:= daddy[handaxis]+
(plimit[handaxis]-nlimit[handaxis])*MetricS[handaxis]
else
daddy[handaxis]:=postravel[handaxis];
if (mode<>setref) and (grany[handaxis]>daddy[handaxis]) then
errors.err(127,0,axisname[handaxis]);
end;
4 : begin
if (Vaxes=0) or ((VaxesL or 1 <>5 ) and (handaxis or 1 =5)) then
if mode<>setref then begin
daddy[handaxis]:=
nlimit[handaxis]*MetricS[handaxis]-flzero[handaxis];
if (Model='C') and (g53F<>0)
and (handaxis=Z3) then daddy[Z3]:=daddy[Z3]-zt;
end else
daddy[handaxis]:=daddy[handaxis]-
(plimit[handaxis]-nlimit[handaxis])*MetricS[handaxis]
else
daddy[handaxis]:=negtravel[handaxis];
if (mode<>setref) and (grany[handaxis]<daddy[handaxis]) then
errors.err(128,0,axisname[handaxis]);
end;
6,7 : begin
if prgname='' then goto exitpoint;
getloc(L,tmploc,true);
if not validH(abs(tmploc.h)) then goto exitpoint;
Vaxes:=tmploc.h;
move(tmploc.x,daddy,sizeof(axes5));
if Vaxes<>oldVax then begin
oldVax:=Vaxes;
getGrany;
end;
end;
end; {case}
end;
{Manual and Teach Motion}
lineaxes:=$FF; {all axes}
if (Vaxes<>0) or (mode=chktrc) and (DryRun=0) then begin
feed0:=Fmax;
if LinTC<>oldTC then TConst(oldTC);
g1;
end else begin
g0;
end;
exactstop;
updatepos;
if (jogLo<>0) and (TBnow>=$80) then begin
TBnow:=$81;
if TBnew then cc100(0);
end;
exitpoint:
while jogL<>0 do begin background; ChkJogReleased; end;
{topline;}
end; { JOG }
(**************************************************************)
procedure manual_command(manualaxis:word); FAR;
(**************************************************************)
begin
if (mode=mdi) or (mode=auto) or (manualaxis>axes) then
ouch
else begin
if toolcomp then errors.err(203,-1,'');
handaxis:=manualaxis;
end;
end;
procedure doreset;
var saveL:word; saveNN:longint;
begin
RST:=0;
error:=false;
outfree:=$FFFF;
KillGraph0;
CloseAllWin;
nosound;
handaxis:=0;
par[stop]:=0;
saveNN:=nn;
ProgReset;
if not graphnow then begin
oldscreen;
if not (graphic or Kanji) then drawscreen;
end;
updatepos;
case mode of
MDI : mode:=auto;
SetHome: ;
else
callcc(102);
saveL:=L;
initCS;
l:=saveL;
ll:=l;
nn:=saveNN;
end;
indicator(reseti);
end; { do reset }
function cncDOS(txt:comstr; clr:boolean):integer; FAR;
{if no extension then load command.com }
var dir0:pathstr; name:namestr; ext:extstr;
Space:integer;
begin
if no_decel then exactstop; {%%%12-13-94}
{Strip leading blanks}
while (txt<>'') and (txt[1]=' ') do Delete(txt,1,1);
{Find end of command}
Space:=pos(' ',txt)-1;
if Space<0 then Space:=length(txt);
Fsplit(copy(txt,1,Space),dir0,name,ext);
if ext<>'' then begin
txt:=copy(txt, Space+2,length(txt));
if dir0='' then dir0:=mydir;
ASM;
mov ax,5F5Fh
and [bp+offset ext+2],ax
and [bp+offset ext+4],al
end;
if (ext<>'.EXE') and (ext<>'.COM') then errors.err(153,n,ext);
dir0:=dir0+name+ext;
end else
dir0:='';
if not irq then {while in Boot}
dbli(par[DosErr])[1]:=execdos(dir0,txt)
else begin
if clr then
if graphnow then
goAlpha
else begin
textmode(co80); directvideo:=not kanji; checksnow:=false;
end;
IrqOff;
dbli(par[DosErr])[1]:=execdos(dir0,txt);
IrqOn;
if clr then begin
graphics(false);
putdate;
end;
end;
DosExit:=DosExitCode; {%%% 01-09-93}
cncDOS:=dbli(par[DosErr])[1]; {%%% 09-20-92}
dbli(par[DosErr])[4]:=-1;
RST:=0;
end; {cncDOS}
procedure getsecurity;
begin
if (prog1<>'') and (cncDOS(prog1,true)=0) then begin
DosExit:=DosExit and $F; {%%% 02-28-97}
if DosExit>0 then security:=DosExit;
end;
end;
procedure newpath;
begin
ChangePath;
getdir(0,curdir);
putINI(curdir,'Dir');
putINI(DefExtension,'Ext');
end;
function MainMenu:boolean;
begin
KillGraph0;
MainMenu:=false;
goAlpha;
dbli(par[190])[4]:=-1; dblw(par[190])[1]:=1;
callcc(110);
{ =110
openwindow( ) This is programmed in the CNX file
print menu
#190=readkey
closewindow
local routines
mend
}
CloseAllWin; {For RST<>0}
keyready; {if KB was used}
case key of
1200 : kb(key); {RUN}
$30 : GetSecurity;
$31 : mode:=modet(2);
$32 : mode:=modet(3);
$34 : GOIOTest;
$35 : begin newpath; topline; end;
secretkey: if compiled then begin
ErrorPtr:=round(par[200]);
GoEdit(true);
end;
1068 : begin
GoEdit(false);
mode:=auto; {%%%04-17-94}
exit;
end;
1079 : begin MainMenu:=true; EXIT; end; {LogOff}
end;
oldscreen;
end; { Main Menu }
procedure saveloc; {@F4}
var exist : boolean;
begin
exist:=false;
case TBnow and $8F of
0 : begin
save_loc(exist);
if exist then begin {location exists}
char(Key):= 'Y'; {Assume 'Y', if CC not found}
dbli(par[190])[4]:=-1;
dblw(par[190])[1]:=2;
callcc(110); {ask Yes or No}
{ openwindow( ) programmed in CNX file
print menu
#190=readkey
closewindow
mend
}
if Curwindow<>0 then begin
CloseAllWin;
oldscreen;
end;
keyready;
if char(key and $5F) = 'Y' then begin
save_loc(exist); {overwrite location}
end;
end;
Exit; {%%%02-18-96}
end;
$80: begin
if not save_loc(exist) then Exit;
ASM;
mov al,exist {if exist then inc(TBnow,3)}
add ax,ax {else inc(TBnow,1)}
inc ax {81--> beep, OK, 80}
add TBnow,al {83--> beep, sure?, 82}
end;
end;
$82: begin
exist:=true;
save_loc(exist);
dec(TBnow); {81--> beep, OK, 80}
end;
end;
if not exist or TBnew then cc100(0) {%%%06-23-93 02-18-96}
{print SURE? or OK}
end;
(**************************************************************)
procedure leadinit; {called from LogOn}
begin
txtl:=selfdir+leadcorr+'.0';
for tic:=1 to axes do begin
inc(txtl[leng]);
LeadNow[tic]:=integer(getfile(txtl,LeadPtr[tic])<>0); {0 or 1}
if LeadNow[tic]<>0 then BootLog(txtl,1);
end;
fassign(corfile,selfdir+leadcorr+'.XYZ');
if dostype(corfile.pname)=1 then BootLog(corfile.pname,1);
end;
procedure CNCinit; {called from LogOn}
begin
while keyready do;
if security<>superuser then getsecurity;
inchNow:=not inchsys; initCS; {forces unitIM to re-calculate}
if curdir='' then newpath;
pc:=0;
Fptr:=@Cfile;
irqOn; {enable interrupts}
graphics(false); {draw screen}
breakNow;
while mode<>oldmode do begin
error:=false;
background;
end;
end;
(**************************************************************)
procedure disprogram(MCC:boolean); { display program listing }
(**************************************************************)
type stp=^string;
var i: word;
linenum:longint; j,pp:word;
begin
if MCC then begin
Fptr:=@Xfile;
end else begin
Fptr:=@Cfile;
end;
if Fptr^.mode=$D7B3 then begin
SavePtr:=Fptr^.CurPos;
openwindow(1,3,80,24, white,$2000);
writeln('Len= ',Fsize(Fptr^));
Rseek(Fptr^,prg00);
while not feof(Fptr^) do begin
readP(Fptr^,prgP);
if prgL=0 then begin
writeln('Text');
linenum:=0;
readB(Cfile,linenum,3);
Rseek(Cfile,linenum);
continue;
end;
pp:=4;
ASM;
mov ax,word ptr [prgB+2]
xor dx,dx
mov dl,byte ptr [prgB+1]
cmp dl,0FFh
jne @1
mov pp,2
xor ax,ax
xor dx,dx
@1:
mov word ptr linenum+2,dx
mov word ptr linenum,ax
end;
write(linenum:8,': ');
if wptr(@prgb[1])^=$BDFF then {prog name}
write(stp(@prgP[3])^)
else
while pp<=prgL do begin
write(hexb(prgB[pp]),' ');
inc(pp);
end;
if keyready and (key=$1B) then break;
writeln; delay(50);
end;
Bseek(Fptr^,SavePtr);
inkey; closewindow;
end;
Fptr:=@Cfile;
end;
(**************************************************************)
procedure cncmain;
begin {CNCMAIN}
repeat { Main Waiting loop }
if catch(exception) and error then begin {Trap for Run time error}
JogL:=0;
ASM;
les bx,Fptr
mov ax,Frec(es:[bx]).block
mul BufSize
add ax,Frec(es:[bx]).BufPos
xor bx,bx {DX:AX= file position for next line}
mov bl,prgL
add bx,1
sub bx,pc {BX = positive}
sub ax,bx
sbb dx,0
mov word ptr Errorptr+2,dx
mov word ptr Errorptr,ax
end;
if (runmode>=runi) {Run, Dwell}
and
((word(Fptr)<>ofs(Xfile))) {not inside CC}
and
Compiled {source exists in editor}
and
(security<=superuser+1)
and
(TBnow<$80) {not in Teach}
and
(mode in [Auto,MDI]) then begin {we are here if there are no Calls}
goedit(true); {will draw screen}
{return here from a run-time error.
GoEdit sets a new exception so a fresh start is required}
continue;
end else begin
tmpstr:=Fptr^.pname;
par[200]:=ErrorPtr;
ProgReset;
oldscreen; {draws graphic screen}
callcc(108); {display error message}
end;
end;
if odd(RST) then KB(27); {2= ESC pressed}
ASM;
{vactual:=0; RST:=0; SKP:=false; byte(lineaxes):=0;}
{Override:=$FFFF}
xor ax,ax
cmp byte ptr RST,al
jz @1
mov byte ptr lineaxes,al {do not cancel in HOLD}
@1:
cmp Vactual,1
ja @2
mov lenR,ax
@2:
mov word ptr RST,ax
mov skp,al
mov Moving,ax
dec ax
mov Override,ax
end;
background;
if sngle=3 then begin {end of Search}
Sngle:=1; callcc(112);
end;
if KBflag and $1008 = $1008 then callcc(105);
if Vaxes<>oldVax then begin {after incHH or H in MDI}
oldVax:=Vaxes;
transforward;
end;
if (TBnow<$80) and (mode<>auto) and (mem[seg0040:$17] and $C = $C) then
if handaxis<>0 then
JogL:=succ(mem[seg0040:$18] and 3)
else
if (security=superuser) and (modename=manual) then
JogL:=5+mem[seg0040:$18] and 3; {%%%5-23-92}
if (TBnow>=$80) or TBnew then begin
if TBpressed<>0 then begin
TBpressed:=0;
cc100(TBkey);
end;
end;
if JogL<>0 then begin
init;
if JogH = 0 then JOG(JogL and $7F)
else begin
callcc(111);
while jogL<>0 do begin background; ChkJogReleased; end;
end;
continue;
end;
if keyready then begin {Keypressed}
if word(kbd-$61)<$1A then dec(Kbd,$20); {upcase}
callcc(101);
case Kbd of
0 : ;
$1B : DoReset;
1198..1200: begin {%%%12-05-92 1198 for CNX}
RST:=0;
mode:=auto;
if key=1199 then progreset;
if key=1198 then Fptr:=@CPLfile;
cycle_start;
end;
1059: begin {F1}
RunMode:=Edit;
goAlpha;
if TBnow>=$80 then begin
ASM; and TBnow,7Fh; end;
if not Help(modeHlp[teach],454) then
ASM; or TBnow,80h; end;
end else begin
if (mode<>auto) or (prgname='') or
(GetHelp(Cfile, prgLong^[1],word(prgLong^[2]),453)) then
Help(modeHlp[modename],0);
end;
GetHoldMode;
oldscreen;
end;
$21,$22 : if security=superuser then disprogram(Kbd=$22);
1060: {F2} begin
KillGraph0;
goAlpha;
dbli(par[190])[4]:=-1; dblw(par[190])[1]:=3;
tmpstr:=CPLdir+'*'+CPLext;
callcc(110); {%%%03-18-94}
{=110
The last command should be:
putstr('') (to ignore directory)
or
putstr(CPLdir$+'........')
mend}
CloseAllWin; {For RST<>0}
if (tmpstr<>'') and (RST=0) and PickDir(tmpstr) then begin
{for ESC}
Fclose(Cfile);
Fptr:=@Cfile;
getCPL(tmpStr,0);
end;
oldscreen;
end;
1061: {F3} graphics(dryrun<2);
1106:{@F3} isometric;
1065: {F7} mode:=manual;
13, 1066: {F8} mode:=MDI;
1067: {F9} mode:=auto;
1110:{@F7} mode:=setref;
1111:{@F8} mode:=sethome;
1112:{@F9} cycle_start;
1068:{F10} if MainMenu then EXIT; {LogOff} {%%%01-25-93}
1133:{F11} if prog3<>'' then cncDOS(prog3,true);
1139:{@F11}if prog4<>'' then cncDOS(prog4,true);
1138:{^F12} begin
goAlpha;
EditTool;
RST:=0;
callcc(119);
oldscreen;
end;
1134:{F12} if prgname<>'' then begin
goAlpha;
Editloc;
oldscreen;
end else ouch;
1140:{@F12} begin
goAlpha;
Editpar;
oldscreen;
end;
1120..1129: {alt1..alt0}
begin
dec(Kbd,1119);
if Kbd=10 then Kbd:=0;
dooffset(Kbd);
if runmode=reseti then o:=Kbd;
end;
1077 : if graphnow and (zoomc<6) then begin inc(zoomc); setzoom; end;
{right arrow}
1075 : if graphnow and (zoomc>-12) then begin dec(zoomc); setzoom;
end;
{left arrow}
(* 1072 {UP},
1080 {DN} : restoreaxes(key); *)
$41..$43, {ABC UVW XYZ}
$55..$5A : manual_command(caddr[Kbd]-7);
1201..1210: getTBfeed;
else
if mode=manual then
case Kbd of {case 3}
1107:{@F4} saveloc;
1063: {F5} if word(l-1)<65533 then inc(l);
1108:{@F5} if l>1 then dec(l);
{F5 canceled}
end {case 3}
else
case Kbd of {case 4}
1063: {F5} dryrn(1);
1108:{@F5} dryrn(2);
end; {case 4}
end; {case 1}
end else begin {if no keypressed}
Kbd:=0;
if not error then callcc(101); {%%% 1998-08-10}
end;
until false;
end;
{$R-,S-}
Procedure divZ; assembler;
{
caller flags BP+6
caller seg BP+4
caller ofs BP+2
caller bp BP pushed by this routine
upon entry: DX:AX - Caller data
RET address- beginning of the div instruction, including prefixes}
ASM;
push bp {save bp}
mov bp,sp {set up stack frame}
push ds {save ds}
push si {save si}
mov si,[bp+2]
mov ds,[bp+4] {DS:SI= ptr to offending instruction}
cld
@1:
lodsb {Search F6 - div command}
and al,0F6h
cmp al,0F6h
jne @1 {loop indefinitely, nothing else can be done}
lodsb {load second instruction byte}
and al,0C7h {mask mode, r/m}
cmp al,6
je @2 {2 byte direct memory operand}
and al,0C0h
cmp al,080h
jne @3
@2:
inc si {2 byte indirect mem operand}
jmp @4
@3:
cmp al,040h
jne @5 {no displacement}
@4:
inc si {1 byte indirect}
@5:
mov [bp+2],si {new return address}
sar dx,15 {DX= sign}
mov ax,7FFFh {AX=7FFFh}
add ax,dx {AX=7FFFh or 7FFEh}
xor ax,dx {AX=8001h if negative}
pop si {resume saved registers}
pop ds
pop bp
IRET
end;
procedure cleanup; FAR;
begin
exitproc:=exitsave;
ASM;
mov ax,4Fh
mov es,ax
xor di,di
cld
mov ax,exitcode
stosw
db 66h
mov ax,word ptr erroraddr
db 66h
stosw
end;
setintvec($15,pointer(@oldint15^));
Setintvec(0,oldint00);
if offline then res70
else close(cncdrv);
InOutRes:=0;
SaveUpdateFile;
ChDir(DosDir);
IOcleanup; {Disable PLC, clear digital IO}
callcc(125);
nosound;
textmode(OrigMode);
end;
{$IFDEF debug}
{$R+}
{$ENDIF}
procedure initialization;
var i,j,io:word;
const xc = 68;
yc = 1; { xc=69-1, yc=2-1; time position }
begin
getdir(0,DosDir);
timeoffs:=yc*160+2*xc;
timeattr:=lightgreen;
getintvec($15,pointer(@oldint15^));
setintvec($15,@myint15);
getintvec($70,oldint70);
getintvec(0,oldint00);
setintvec(0,@divZ);
exitsave:=exitproc;
exitproc:=@cleanup;
xold:=xpos; fillchar(oldb,sizeof(oldb),#0);
assign(cncdrv,'CNCSERVO'); {device driver}
getwheel;
getwheel;
end;
procedure Pscreen; FAR;
var oldcursor : word absolute 0:$460;
cursorsaved:word;
const st:string[2]='00';
begin
if prog2<>'' then begin
cursorsaved:=oldcursor;
beep(1034,100);
irqoff;
byte(st[1]):=$30+byte(graphnow or Kanji or GraphScr); {0 = alpha}
byte(st[2]):=$30+byte(graphnow and not GraphScr);
if st[2]<>'0' then inc(st[2],byte(iso));
{0=normal, 1=proj, 2=iso}
if execdos(prog2, st)<>0 then ouch else beep(1034,100);
irqon;
edsetcursor(cursorsaved);
nosound;
end;
end;
procedure SetRefCorr;
var i:word;
begin
CorrFlag:=true;
MyAxis:=$FFFF;
for i:=1 to axes do begin
twoint(corr[i]).hi:=1;
AxisMisc;
end;
oldindex:=-1;
AxisMisc;
CorrFlag:=false;
end;
procedure Corr3D(on:boolean);
begin
corr3:=0;
corr1:=byte(on);
if on then begin
freset(corfile,6);
if ioresult=0 then begin
corr3:=1;
readb(Corfile,Csize,18);
corfile.base:=18;
end;
SetRefCorr;
{for tic:=1 to axes+1 do begin
oldcorr[tic]:=corr;
dec(xpos[tic],oldcorr[tic]);
disflag:=...
end;}
end else begin
Fclose(Corfile);
for tic:=1 to axes do begin
inc(xpos[tic],oldcorr[tic]);
oldcorr[tic]:=0;
corrPLC[tic]:=0;
asm; or disflag,0FFh end;
end;
end;
corr13d:=corr13;
updatepos;
end;
BEGIN
dwellp :=dwell; {NCRUN, NCG}
graphlinep:=graphline;
go_waitp :=go_wait; {NCG}
breakp :=breakNow; {NCG}
clrtrcp :=clrtrc; {NCRUN}
oldscreenp:=oldscreen; {NCRUN}
cncdosp :=cncdos; {NCRUN}
updatep :=updateX; {NCRUN}
shortbuffP:=shortbuff; {NCRUN}
PLCmesgp :=PLCmesg; {KBOARD}
Pscreenp :=Pscreen; {KBOARD}
Graph0P :=Graph0; {RUNTIME}
backP :=background;{RUNTIME}
corr3dP :=corr3D; {RUNTIME}
trcerrP :=trcerr; {RUNTIME}
testP :=test; {RUNTIME}
plcfunc[-10]:=@clrtrc;
initialization;
feedstr:=getmessage(410);
END.
Title NCL.ASM, CNC Motion routines, Copyright 1988, 1999 by Gil Hagiz
.386
Include buffer.asm
dseg segment dword public 'data' use16
extrn dryrun:byte, handaxis:word, TBnow:byte
extrn oldw:byte, OneAxis:word, FeedLow:word
extrn FeedMult:word, FeedSelector:word, FeedTable:word
extrn xpos:word, abszero:dword, PosBuf:word, remain:word
extrn vdesired:word,accel:word, decel:word, override:word
extrn oldint70:word, vactual:word,axes:word
extrn vfrac:word, vhigh:word, fe:word, findv:byte
extrn outgroup:dword, outnow:word, outbits:word, outfree:word
extrn buffin:word, buffout:word, buffers:word
extrn par:word, lenR:word, decelflag:byte, PLCtrc:word
extrn no_decel:byte, RST:byte, SKP:byte;
extrn tracerr:word, float:byte, disflag:byte
extrn corr:word, timer:word, timer1:word, xskip:dword
extrn totalAS:word, axis4:word, irqt:word
extrn trctmp:word, oldcorr:word, LinTC0:word
extrn Plimit:word, Nlimit:word, plc0:dword,PLCin:word
extrn Fcorr1:word, Follower:word, Fgain1:word
extrn Fcorr2:word, Follower2:word, Fgain2:word
extrn Mav:dword, rem:word, totMav:word, Lcount:word
extrn HW:word, HandWheel:word, mavLen:word
extrn ASpin:word, Rdesired:word, Ractual:word,Raccel:word
extrn Rratio:word, fmode:word, Spindle:word
extrn LowX:word, Fly:word, FLrate:word
extrn divisor:word, ModuloN:word,feeds100:word, feedtime:word
extrn Kanji:byte, TimeOffs:word, TimeAttr:byte, segB800:word
Rfrac dw (?)
Zfrc1 dw (?)
Zfrc2 dw (?)
frc3 dw (?)
frc4 dw (?)
align 4
position dd 0,0,0,0,0,0,0,0 ;absolute position
servo dd 0,0,0,0,0,0,0,0 ;servo - trace error
total dd 0,0,0,0,0,0,0,0 ;trace error fractions
dseg ends
extrn doOutput:far
eoi equ 20h
inta00 equ 20h
intb00 equ 0A0h
intb01 equ 0A1h
;--------------------------------------;
code segment dword public use16
assume cs:code, ds:dseg, es:dseg
public newfeed, myint15, oldint15, Motion
public ready, Simulation, skip, goASM, cmd9A, updateX
public trace, clrbuff, clrtrc, trcerr, prep70, res70
public writetime,CMOSwr, CMOSrd
;---------------------------------------;
db 'Copyright (C) 1988 by Gil Hagiz '
;---------------------------------------;
; clear buffer
;buffout:=ofs(buffers); buffin:=buffout;
;q0:=0; q1:=0; q2:=0; q3:=0; q4:=0;....... qlast:=0;
;TotalAS:=0;
;---------------------------------------;
clrbuff proc near
cli
mov ax,offset buffers
mov buffin,ax
mov buffout,ax
mov dx,ax
mov di,ax
xor eax,eax
mov dword ptr totalAS,eax
clr0:
mov [di+qq],eax
mov [di+qOut],ax
mov di,[di]
cmp di,dx
jne short clr0
sti
ret
clrbuff endp
;---------------------------------------;
; waiting loop
;
;This function returns Buffer-Ready.
;If No_decel is true then ready is true when at least
;one buffer is empty.
;If No_decel is false then ready is true when all
;buffers are empty
;
;---------------------------------------;
ready proc near
xor eax,eax ;assume false
mov si,buffin
mov bx,buffout
cmp bx,[si] ;ptr to next buffer
je short ready1 ;all buffers are full
add al, no_decel ;zero= deceleration
jnz short ready1 ;ready:=no_decel
mov si, buffout ;wait for all buffers empty
cmp si, buffin ;equal= last buffer
jne short ready1
cmp eax,[si+qq] ;is buffer empty?
jnz short ready1
inc ax
ready1:
ret
ready endp
;---------------------------------------;
; update floating axes and outputs
;---------------------------------------;
goASM proc near ;delayed output
BSF bx,outnow ;bx= bit position 0..F
jz short Floats ;if zero BX= no change
BTS outfree,bx
BTR outnow,bx
shl bx,2
xor eax,eax
xchg [bx+outgroup],eax
push eax
call doOutput
jmp short goASM ;see if more
Floats:
mov bl,1
mov bh,float
xor di,di
float1:
test bl,bh
jz short float2 ;not floating
or cx,-1
stc ;CF=1
call cs:dword ptr drvofs ;cx=-1
test ax,ax
jz short float2 ;no change
sub [di+xpos], ax ;update absolute position
sbb [di+xpos+2],dx
or disflag,bl ;update display flag
float2:
shl bl,1
add di,4
cmp di,axis4
jb short float1
ret
goASM endp