void
do_call(int *ip)
{
struct t_proc *ptr;
int value;
/* define label */
labldef(loccnt, 1);
/* update location counter */
data_loccnt = loccnt;
loccnt += 3;
/* generate code */
if (pass == LAST_PASS) {
/* skip spaces */
while (isspace(prlnbuf[*ip]))
(*ip)++;
/* extract name */
if (!colsym(ip)) {
if (symbol[0] == 0)
fatal_error("Syntax error!");
return;
}
/* check end of line */
check_eol(ip);
/* lookup proc table */
if((ptr = proc_look())) {
/* check banks */
if (bank == ptr->bank)
value = ptr->org + 0xA000;
else {
/* different */
if (ptr->call)
value = ptr->call;
else {
/* new call */
value = call_ptr + 0x8000;
ptr->call = value;
/* init */
if (call_ptr == 0) {
call_bank = ++max_bank;
}
/* install */
poke(call_ptr++, 0xA8); // tay
poke(call_ptr++, 0x43); // tma #5
poke(call_ptr++, 0x20);
poke(call_ptr++, 0x48); // pha
poke(call_ptr++, 0xA9); // lda #...
poke(call_ptr++, ptr->bank+bank_base);
poke(call_ptr++, 0x53); // tam #5
poke(call_ptr++, 0x20);
poke(call_ptr++, 0x98); // tya
poke(call_ptr++, 0x20); // jsr ...
poke(call_ptr++, (ptr->org & 0xFF));
poke(call_ptr++, (ptr->org >> 8) + 0xA0);
poke(call_ptr++, 0xA8); // tay
poke(call_ptr++, 0x68); // pla
poke(call_ptr++, 0x53); // tam #5
poke(call_ptr++, 0x20);
poke(call_ptr++, 0x98); // tya
poke(call_ptr++, 0x60); // rts
}
}
}
else {
/* lookup symbol table */
if ((lablptr = stlook(0)) == NULL) {
fatal_error("Undefined destination!");
return;
}
/* get symbol value */
value = lablptr->value;
}
/* opcode */
putbyte(data_loccnt, 0x20);
putword(data_loccnt+1, value);
/* output line */
println();
}
short IGcges(
char *typ,
pm_ptr pplist)
/* Creates, executes and adds a geometric statement
* to end of active module.
*
* In: typ => MBS procedure name ie. "POI_FREE"
* pplist => PM ptr to parameter list
*
* Error: IG5213 = Error from pmcges()
* IG5222 = Error intepreting %s-statement
* IG5233 = Error from pmlmst()
*
* (C)microform ab 3/9/85 J. Kjellander
*
* 2004-02-21 pmmark()+pmrele(), J.Kjellander
* 2007-07-28 1.19, J.Kjellander
*
******************************************************!*/
{
char mesbuf[2*V3STRLEN],mbsbuf[5*V3STRLEN];
pmseqn geid;
pm_ptr retla,ref;
stidcl kind;
/*
***Create a new unused ID.
*/
geid = IGgnid();
/*
***Mark current PM-stack pointer.
*/
pmmark();
/*
***Create the statement.
*/
stlook(typ,&kind,&ref);
if ( pmcges(ref,geid,pplist,(pm_ptr)NULL,&retla) < 0)
return(erpush("IG5213",typ));
/*
***Try to execute.
*/
if ( inssta(retla) < 0)
{
pmrele();
return(erpush("IG5222",typ));
}
/*
***Update WPRWIN's.
*/
WPrepaint_RWIN(RWIN_ALL,FALSE);
/*
***Confirmational message. In explicit mode prettyprint
***must be done before pmrele(). pprsts() needs a buffer
***which is long enough to hold the full MBS statement but
***here we truncate long statements to V3STRLEN characters.
*/
strncpy(mesbuf,IGgtts(58),V3STRLEN);
pprsts(retla,mbsbuf,5*V3STRLEN);
mbsbuf[V3STRLEN] = '\0';
strncat(mesbuf,mbsbuf,V3STRLEN);
WPaddmess_mcwin(mesbuf,WP_MESSAGE);
/*
***Everything ok, add statement to end of module. In RIT-mode,
***reset PM stack pointer.
*/
if ( sysmode & GENERIC )
{
if ( pmlmst(actmod, retla) < 0 ) return(erpush("IG5233",typ));
}
else
{
pmrele();
}
/*
***The end.
*/
return(0);
}
int
push_val(int type)
{
unsigned int mul, val;
int op;
char c;
val = 0;
c = *expr;
switch (type) {
/* program counter */
case T_PC:
if (data_loccnt == -1)
val = (loccnt + (page << 13));
else
val = (data_loccnt + (page << 13));
expr++;
break;
/* char ascii value */
case T_CHAR:
expr++;
val = *expr++;
if ((*expr != c) || (val == 0)) {
error("Syntax Error!");
return (0);
}
expr++;
break;
/* symbol */
case T_SYMBOL:
/* extract it */
if (!getsym())
return (0);
/* an user function? */
if (func_look()) {
if (!func_getargs())
return (0);
expr_stack[func_idx++] = expr;
expr = func_ptr->line;
return (1);
}
/* a predefined function? */
op = check_keyword();
if (op) {
if (!push_op(op))
return (0);
else
return (1);
}
/* search the symbol */
expr_lablptr = stlook(1);
/* check if undefined, if not get its value */
if (expr_lablptr == NULL)
return (0);
else if (expr_lablptr->type == UNDEF)
undef++;
else if (expr_lablptr->type == IFUNDEF)
undef++;
else
val = expr_lablptr->value;
/* remember we have seen a symbol in the expression */
expr_lablcnt++;
break;
/* binary number %1100_0011 */
case T_BINARY:
mul = 2;
goto extract;
/* hexa number $15AF */
case T_HEXA:
mul = 16;
goto extract;
/* decimal number 48 (or hexa 0x5F) */
case T_DECIMAL:
if ((c == '0') && (toupper(expr[1]) == 'X')) {
mul = 16;
expr++;
}
else {
mul = 10;
val = c - '0';
}
/* extract a number */
extract:
for (;;) {
expr++;
c = *expr;
if (isdigit(c))
c -= '0';
else if (isalpha(c)) {
c = toupper(c);
if (c < 'A' && c > 'F')
break;
else {
c -= 'A';
c += 10;
}
}
else if (c == '_' && mul == 2)
continue;
else
break;
if (c >= mul)
break;
val = (val * mul) + c;
}
break;
}
/* check for too big expression */
if (val_idx == 63) {
error("Expression too complex!");
return (0);
}
/* push the result on the value stack */
val_idx++;
val_stack[val_idx] = val;
/* next must be an operator */
need_operator = 1;
/* ok */
return (1);
}
short IGcprs(
char *typ,
pm_ptr pplist)
/* Creates, executes and adds a procedure statement
* to end of active module.
*
* In: typ => Typ av procedursats, tex. "MODE_LOCAL"
* pplist => Pekare till parameterlista.
*
* Ut: Inget.
*
* Felkod: IG5253 = Fel fr�n pmcges i IGcprs
* IG5222 = Fel vid interpretering av %s-sats
* IG5263 = Fel fr�n pmlmst i IGcprs
*
* (C)microform ab 3/9/85 J. Kjellander
*
* 15/3/88 Ritpaketet, J. Kjellander
* 2004-02-21 pmmark()+pmrele(), J.Kjellander
* 2007-07-28 1.19, J.Kjellander
*
******************************************************!*/
{
char mesbuf[2*V3STRLEN],mbsbuf[V3STRLEN];
pm_ptr retla,ref;
stidcl kind;
/*
***Mark current PM-stack pointer.
*/
pmmark();
/*
***Create the statement.
*/
stlook( typ, &kind, &ref);
if ( pmcprs(ref,pplist,&retla) < 0 ) return(erpush("IG5253",typ));
/*
***Try to execute.
*/
if ( inssta(retla) < 0)
{
pmrele();
return(erpush("IG5222",typ));
}
/*
***Everything ok, add procedure call to end of module. In RIT-mode,
***reset PM stack pointer.
*/
if ( sysmode & GENERIC )
{
if ( pmlmst(actmod, retla) < 0 ) return(erpush("IG5263",typ));
}
else
{
pmrele();
}
/*
***Confirmational message.
*/
strcpy(mesbuf,IGgtts(58));
pprsts(retla,mbsbuf,V3STRLEN);
strcat(mesbuf,mbsbuf);
WPaddmess_mcwin(mesbuf,WP_MESSAGE);
/*
***The end.
*/
return(0);
}
void angprc(
pm_ptr *rptr,
ANFSET *follow)
/* Analyse geometric procedure call.
*
* geo_proc_call ::= identifier '(' parameter list Ä namned_params Å ')'
*
* In: *follow => Follower set.
*
* Out: *rptr => Pointer to procedure call.
*
* (C)microform ab 1985-09-23 Mats Nelson
*
* 1999-04-26 Rewritten, R. Svedin
*
******************************************************!*/
{
char pronam[ANSYNLEN+1]; /* local proc. name copy */
ANATTR a_attrs[ANPARMAX]; /* parameter actual attributes */
ANATTR dumatt; /* dummy attribute */
ANATTR pnatt; /* Part-namn attribut */
short acount = 0; /* parameter actual count */
char prtnam[ANSYNLEN+1]; /* module name if part procedure */
char *pnamptr=NULL; /* ptr to part nam if VPART */
pmseqn seqnum=0; /* sequence number */
pm_ptr mlptr = (pm_ptr)NULL; /* PM_pointer to module params. if part */
pm_ptr lrptr = (pm_ptr)NULL; /* PM-pointer to actual parameter list */
pm_ptr nlptr = (pm_ptr)NULL; /* PM-pointer to named parameter list */
short prolin,procol; /* procedure source position */
short namlin,namcol; /* part name source position */
ANFSET locfol1; /* local follow set */
ANFSET locfol2; /* local follow set */
ANFSET pnfoll; /* Follow-set för part-namn */
stidcl st_typ,id_typ; /* identifier type */
pm_ptr proptr,idptr; /* ST procedure entry point */
pm_ptr funtyp; /* PM-pekare till funktionstyp */
pmvaty valtyp; /* Typ av funktion */
short dummy; /* Används ej */
STPROC pattr,func; /* ST-data om rutin proc/func */
STVAR var; /* ST-data om en variabel */
STCONST konst; /* ST-data om en konstant */
STTYTBL type; /* Typ-info */
pm_ptr pnexpr; /* Pekare till part-namnsuttryck */
char eristr[32]; /* error insert string */
char tstr1[32],tstr2[32]; /* insert-strängar */
short i; /* loop */
short pcount = 1; /* number of parameters outside list */
bool exprfl = FALSE; /* Part-namn har getts som expression */
/*
***Save procedure name
*/
strcpy(pronam,sy.syval.name);
/*
***Create local followset
*/
ancset(&locfol1,follow,1,ANSYRPAR,0,0,0,0,0,0,0);
ancset(&locfol2,follow,3,ANSYRPAR,ANSYCOL,ANSYCOM,0,0,0,0,0);
/*
***Set ST-info on procedure
*/
stlook(sy.syval.name,&st_typ,&proptr);
strrou(proptr,&pattr);
/*
***Save procedure source position for error messages
*/
prolin=sy.sypos.srclin;
procol=sy.sypos.srccol;
/*
***Eat "("
*/
anascan(&sy);
if ( sy.sytype == ANSYLPAR )
anascan(&sy);
else
anperr("AN9172","(",NULL,sy.sypos.srclin,sy.sypos.srccol);
/*
***Eat reference
*/
if ( sy.sytype == ANSYREFL )
{
seqnum = sy.syval.rval.seq_val;
/*
***Global ref or #0 not allowed here. 3/11-94 JK
*/
if ( sy.syval.rval.seq_val < 0 )
anperr("AN9452","",NULL,sy.sypos.srclin,sy.sypos.srccol);
if ( sy.syval.rval.seq_val == 0 )
anperr("AN9462","",NULL,sy.sypos.srclin,sy.sypos.srccol);
if ( sy.syval.rval.ord_val != 0 )
anperr("AN9392","",NULL,sy.sypos.srclin,sy.sypos.srccol);
if ( seqnum >= 1 && anstyp == ANRDFIL )
ancsnd(sy.sypos.srclin,sy.sypos.srccol,(short)seqnum);
anascan(&sy);
}
else
anperr("AN9122","",&locfol2,sy.sypos.srclin,sy.sypos.srccol);
/*
***Kolla att nästa token är ett komma. Scanna inte igen dock eftersom
***detta skall göras olika för part och geometriprocedur.
*/
if (sy.sytype != ANSYCOM )
anperr("AN9172",",",NULL,sy.sypos.srclin,sy.sypos.srccol);
/*
***Speciell hantering av PART. Titta på nästa token.
*/
if ( pattr.kind_pr == VPART )
{
anascan(&sy);
/*
***Nu gäller det att avgöra vilken av de två tillåtna formerna
***av part-anrop det handlar om. Om part-namnet inte kan anses
***vara en identifierare provar vi att tolka det som ett uttryck.
*/
if ( sy.sytype != ANSYID ) exprfl = TRUE;
/*
***Om det är en identifierare måste vi kolla vilken typ av identi-
***fierare det ät frågan om. Variabel, konstant och funktion av typen
***STRING implicerar att part-namnet skall parsas som ett uttryck.
*/
else
{
stlook(sy.syval.name,&id_typ,&idptr);
if ( idptr != (pm_ptr)NULL )
{
switch ( id_typ )
{
case ST_VAR:
strvar(idptr,&var);
strtyp(var.type_va,&type);
if ( type.kind_ty == ST_STR ) exprfl = TRUE;
break;
case ST_CONST:
strcon(idptr,&konst);
strtyp(konst.type_co,&type);
if ( type.kind_ty == ST_STR ) exprfl = TRUE;
break;
case ST_FUNC:
strrou(idptr,&func);
stsrou(func.kind_pr);
stgret(&funtyp,&valtyp,&dummy);
if ( valtyp == C_STR_VA ) exprfl = TRUE;
break;
}
}
}
/*
***Om exprfl är TRUE skall vi tolka partnamnet som ett uttryck.
***anarex börjar då med sist scannade token och slutar med 1:a
***icke godkända. Detta skall vara ett kommatecken.
*/
if ( exprfl )
{
namlin = sy.sypos.srclin;
namcol = sy.sypos.srccol;
ancset(&pnfoll,follow,1,ANSYCOM,0,0,0,0,0,0,0);
anarex(&pnexpr,&pnatt,&pnfoll);
if ( sy.sytype != ANSYCOM )
anperr("AN2282","",NULL,sy.sypos.srclin,sy.sypos.srccol);
pnamptr = NULL;
/*
***Kolla uttryckets typ.
*/
if ( !aneqty(pnatt.type,ststrp) )
{
angtps(pnatt.type,tstr1);
angtps(ststrp,tstr2);
sprintf(eristr,"%s\004%s",tstr2,tstr1);
anperr("AN9292",eristr,NULL,namlin,namcol);
}
}
/*
***Annars tolkar vi det som vi alltid gjorde före version 1.12.
*/
else
{
strcpy(prtnam,sy.syval.name);
pnamptr = prtnam;
pnexpr = (pm_ptr)NULL;
}
/*
***Parameterlistans vänster-parentes.
*/
anascan(&sy);
if ( sy.sytype == ANSYLPAR )
anascan(&sy);
else
anperr("AN9172","(",NULL,sy.sypos.srclin,sy.sypos.srccol);
/*
***Den anropade partens parameterlista.
*/
anparl(&mlptr,a_attrs,&i,&locfol1);
/*
***Parameterlistans högerparentes.
*/
if ( sy.sytype == ANSYRPAR )
anascan(&sy);
else
anperr("AN9172",")",NULL,sy.sypos.srclin,sy.sypos.srccol);
/*
***Kanske finns ett kommatecken och en REF till lokalt koordinatsystem.
*/
if ( sy.sytype == ANSYCOM)
/*
*** "," found, continue with the parameter list
*/
anascan(&sy);
else
/*
*** no "," found, assume : no more parameters
*/
goto lab1;
}
/*
***S**t part. Om det är en vanlig geometri-procedur scannar vi
***vidare som vanligt.
*/
else anascan(&sy);
/*
***Analyse the parameter list
*/
anparl(&lrptr,a_attrs,&acount,&locfol2);
/*
***Analyse named parameters (if any)
*/
lab1:
if ( sy.sytype == ANSYCOL )
{
anascan(&sy);
annaml(&nlptr,&locfol1,pattr.kind_pr);
}
/*
***Eat ")"
*/
if ( sy.sytype == ANSYRPAR )
anascan(&sy);
else
anperr("AN9172",")",NULL,sy.sypos.srclin,sy.sypos.srccol);
/*
***Check parameter list
*/
ancpar(a_attrs,acount,proptr,prolin,procol,pcount,&dumatt);
/*
***Skapa PM-träd. Om det är ett part-anrop skickar vi fr.o.m.
***version 1.12 med både pekare till namn-sträng och pekare till
***namnuttryck, pnamptr och pnexpr.
*/
if ( pattr.kind_pr == VPART )
pmcpas(seqnum,pnamptr,pnexpr,mlptr,lrptr,nlptr,rptr);
/*
***Om det är en vanlig geometriprocedur gör vi som vanligt.
*/
else pmcges(proptr,seqnum,lrptr,nlptr,rptr);
/*
***S**t.
*/
return;
}
void anoprc(
pm_ptr *rptr,
ANFSET *follow)
/* Analyse ordinary procedure call.
*
* ord_proc_call ::= identifier '(' parameter list ')'
*
* In: *follow => Follower set.
*
* Out: *rptr => Pointer to procedure call.
*
* (C)microform ab 1985-09-23 Mats Nelson
*
* 1999-04-26 Rewritten, R. Svedin
*
******************************************************!*/
{
char pronam[ANSYNLEN+1]; /* local proc. name copy */
ANATTR a_attrs[ANPARMAX]; /* parameter actual attributes */
ANATTR dumatt; /* dummy attribute */
short acount; /* parameter actual count */
pm_ptr lrptr; /* PM-pointer to parameter list */
short prolin,procol; /* procedure source position */
ANFSET locfol1; /* local follow set */
stidcl st_typ; /* identifier type */
pm_ptr proptr; /* ST procedure entry point */
STPROC pattr; /* procedure attributes */
/*
***Save procedure name
*/
strcpy(pronam,sy.syval.name);
/*
***Create local followset
*/
ancset(&locfol1,follow,1,ANSYRPAR,0,0,0,0,0,0,0);
/*
***Save procedure source position for error messages
*/
prolin = sy.sypos.srclin;
procol = sy.sypos.srccol;
/*
***Get ST-info on procedure
*/
stlook(sy.syval.name,&st_typ,&proptr);
strrou(proptr,&pattr);
/*
***Eat "("
*/
anascan(&sy);
if ( sy.sytype == ANSYLPAR )
anascan(&sy);
else
anperr("AN9172","(",NULL,sy.sypos.srclin,sy.sypos.srccol);
/*
***Analyse the parameter list
*/
#ifdef VARKON
if ( pattr.kind_pr == VSET || pattr.kind_pr == VSETB )
/*
***Special treatement for the set-procedure
***Set_basic, 2/6/91 JK
*/
{
annaml(&lrptr,&locfol1,pattr.kind_pr);
acount = 0;
}
else
#endif
/*
***Normal treatement for other ordinary procedure call
*/
anparl(&lrptr,a_attrs,&acount,&locfol1);
/*
***Eat ")"
*/
if ( sy.sytype == ANSYRPAR )
anascan(&sy);
else
anperr("AN9172",")",NULL,sy.sypos.srclin,sy.sypos.srccol);
/*
***Check parameter list
*/
ancpar(a_attrs,acount,proptr,prolin,procol,0,&dumatt);
/*
***Create the PM tree
*/
pmcprs(proptr,lrptr,rptr);
return;
}
void anunst(
pm_ptr *rptr,
ANFSET *follow)
/* Analyse an unlabeled statement
*
* unlabeled_statement ::= if_statement ! for_statement !
* goto_statement ! empty_statement !
* ord_proc_call ! geo_proc_call !
* assignment_statement
*
* In: *follow => Follower set.
*
* Out: *rptr => Pointer to unlabeled statement.
*
* (C)microform ab 1985-09-23 Mats Nelson
*
* 1999-04-26 Rewritten, R. Svedin
*
******************************************************!*/
{
stidcl st_typ; /* identifier type */
pm_ptr st_ent; /* ST entry point */
STPROC pattr; /* procedure attributes */
struct ANSYREC psy; /* local token structure */
/*
***Select function from statement syntax and semantics
*/
switch(sy.sytype)
{
/*
***Empty statement
*/
case ANSYSEMI:
*rptr = (pm_ptr)NULL;
break;
/*
****IF statement
*/
case ANSYIF:
anifst(rptr,follow);
break;
/*
***FOR statement
*/
case ANSYFOR:
anfost(rptr,follow);
break;
/*
***GOTO statement
*/
case ANSYGOTO:
angost(rptr,follow);
break;
/*
***Identifier
*/
case ANSYID:
/*
***Take a look in ST
*/
stlook(sy.syval.name,&st_typ,&st_ent); /* consult symbol table */
/*
***Peek next token
*/
anapeek(&psy);
/*
***Next token ":=" ?
***Next token "." ?
*/
if ( (psy.sytype == ANSYASGN) || (psy.sytype == ANSYDOT) )
{
/*
***Syntax -> assignment statement
*/
if ( st_typ == ST_VAR )
anasst(rptr,follow); /* analyse assignment statement */
else
{
/*
***Identifier not a variable
*/
anperr("AN9242",sy.syval.name,follow,
sy.sypos.srclin,sy.sypos.srccol);
return;
}
}
/*
***Next token "(" ?
*/
else if ( psy.sytype == ANSYLPAR )
{
/*
***Syntax -> assignment or procedure statement
*/
if ( st_typ == ST_VAR )
/*
***Assignment statement !
*/
anasst(rptr,follow); /* analyse assignment statement */
else if ( st_typ == ST_PROC )
/*
***Procedure statement !
*/
{
strrou(st_ent,&pattr); /* get procedure attributes */
if ( pattr.class_pr == ST_ORD )
{
/*
***Analyse ordinary procedure call
*/
anoprc(rptr,follow);
}
else /* pattr.class_pr == ST_GEO */
{
/*
***Analyse geometric procedure call
*/
angprc(rptr,follow);
}
}
else
{
/*
***Unrecognised statement, report error and skip
*/
anperr("AN9202","",follow,sy.sypos.srclin,sy.sypos.srccol);
}
}
else
{
/*
***Unrecognised statement, report error and skip
*/
anperr("AN9202","",follow,sy.sypos.srclin,sy.sypos.srccol);
}
break;
/*
***Unrecognised statement, report error and skip
*/
default:
anperr("AN9202","",follow,sy.sypos.srclin,sy.sypos.srccol);
break;
}
return;
}
void anlast(
pm_ptr *rptr,
ANFSET *follow,
pm_ptr *labptr)
/* Analyse a labeled statement.
*
* labeled_statement ::= identifier ':' unlabeled_statement
*
* In: *follow => Follower set.
*
* Out: *rptr => Pointer to labeled statement.
* *labptr => ST label entry.
*
* (C)microform ab 1985-09-23 Mats Nelson
*
* 1999-04-26 Rewritten, R. Svedin
*
******************************************************!*/
{
char labnam[ANSYNLEN]; /* local copy of label name */
pm_ptr lrptr; /* PM-pointer to unlabeled statement */
stidcl st_typ; /* identifier type */
STLABEL labattr; /* ST label attributes */
short lablin,labcol; /* label source position */
/*
***Save label name
*/
strcpy(labnam,sy.syval.name);
/*
***Save label source position for error messages
*/
lablin = sy.sypos.srclin;
labcol = sy.sypos.srccol;
/*
***Analyse the (unlabeled) statement
*/
anascan(&sy); /* consume identifier and ':' */
anascan(&sy);
anunst(&lrptr,follow);
/*
***If new name: create "undefined","unreferensed" label
***if old name: check for type "STLABEL" and attr.: "undefined"
*/
stlook(labnam,&st_typ,labptr); /* consult symbol table */
if ( *labptr == (pm_ptr)NULL )
/*
***New name, create new ST entry
*/
stclab(labnam,labptr);
else if ( st_typ == ST_LABEL )
/*
***Old label, check undefined
*/
{
strlab(*labptr,&labattr);
if ( labattr.def_la == TRUE )
/*
***Error - level multiply defined
*/
{
anperr("AN9212",labnam,NULL,lablin,labcol);
*labptr=(pm_ptr)NULL;
}
}
else
/*
***Error - identifier multiply defined
*/
{
anperr("AN9212",labnam,NULL,lablin,labcol);
*labptr = (pm_ptr)NULL;
}
/*
***Create PM labeled statement
*/
pmclas(*labptr,lrptr,rptr);
/*
***Update label info.
*/
/*
***This is made bye ansmts() via parameter labptr
*/
return;
}
