/* Copyright (C) 1996 by Thomas Glen Smith. All Rights Reserved. */ /* integes APL2 V1.0.0 ************************************************* * Called by integer to finish processing after output Aplcb is alloc. * ***********************************************************************/ #define INCLUDES APLCB #include "includes.h" Aplcb integes(rite, out) Aplcb rite,out; { Dabsx; Errstop; Intcopy; Inttran; extern double fuzz; extern int aplerr; Aplcb *ip,wrk; double *fin,fwrk[2]; int i=out->aplcount, *op=out->aplptr.aplint; switch (rite->aplflags & (APLMASK + APLAPL)) { case APLINT: intcopy(op, rite->aplptr.aplint, i, 1); break; case APLCHAR: aplerr = 19; break; case APLNUMB: inttran(op, rite->aplptr.apldata, i, 1); break; case APLCPLX: fin = rite->aplptr.apldata; while (i--) { dabsx(fin, fwrk); fin += 2; *op++ = *fwrk; } break; case APLAPL: ip = rite->aplptr.aplapl; while(i-- && aplerr == 0) { wrk = *ip++; if (wrk->aplcount > 1) { aplerr = 125; break; } switch (wrk->aplflags & APLMASK) { case APLINT: *op++ = *(wrk->aplptr.aplint); break; case APLCPLX: dabsx(wrk->aplptr.apldata,fwrk); *op++ = *fwrk; break; case APLCHAR: aplerr = 19; break; case APLNUMB: inttran(op++, wrk->aplptr.apldata, 1, 1); break; default: aplerr = 999; break; } /* end switch */ } break; default: aplerr = 999; break; } /* end switch */ return(errstop(0,NULL,rite,out)); }