+TITLE. * MN_FIT 4.07/35 17/09/2003 10.52.58 +PATCH,MNCDE. +DECK,dbcde. +KEEP,DBCDE. * * Common block for L3 database display stuff * INTEGER MDBASE PARAMETER (MDBASE = 7) CHARACTER*4 TDBASE,TYRDB,TYEARDB INTEGER IOPDB,IUNDB,LUNDB,LYEARDB REAL ALIMDB COMMON/M9DBC1/ IOPDB(MDBASE),IUNDB(MDBASE),LUNDB,LYEARDB + ,ALIMDB(2) COMMON/M9DBC2/ TDBASE(MDBASE),TYRDB(MDBASE),TYEARDB +DECK,gks$dev. +KEEP,GKS$DEV,IF=HIGZ,IF=GKSGRAL,IF=VMS. INCLUDE 'GKS$GTSDEV' +KEEP,GKS$DEV,IF=HIGZ,IF=GKSGRAL,IF=UNIX. %INCLUDE '/cern/gks/pro/utl/gks$gtsdev' +KEEP,GKS$DEV,IF=-HIGZ,-GKSGRAL. +DECK,gks$enum. +KEEP,GKS$ENUM,IF=HIGZ,IF=GKSGRAL,IF=VMS. INCLUDE 'GKS$ENUM' +KEEP,GKS$ENUM,IF=HIGZ,IF=DECGKS,IF=VMS. INCLUDE 'SYS$LIBRARY:GKSDEFS.BND' +KEEP,GKS$ENUM,IF=HIGZ,IF=DGKS3D,IF=VMS. INCLUDE 'SYS$LIBRARY:GKS3D$FORBND.FOR' INCLUDE 'SYS$LIBRARY:GKS3D$DEFS.FOR' +KEEP,GKS$ENUM,IF=HIGZ,IF=DGKS3D,IF=DECS. INCLUDE '/usr/include/GKS3D/GKS3Dforbnd.f' #include "/usr/include/GKS3D/GKS3Dgksbnd_defs.h" +KEEP,GKS$ENUM,IF=HIGZ,IF=GKSGRAL,IF=UNIX. %INCLUDE '/cern/gks/pro/utl/gks$enum' +KEEP,GKS$ENUM,IF=HIGZ,IF=X11,DI3000. +KEEP,GKS$ENUM,IF=-HIGZ. +DECK,hbcdes_93,if=v93. +KEEP,HCBITS INTEGER I1, I2, I3, I4, I5, I6, I7, I8, + I9, I10, I11, I12, I13, I14, I15, I16, +I17, I18, I19, I20, I21, I22, I23, I24, I25, I26, I27, +I28, I29, I30, I31, I32, I33, I34, I35, I123, I230 COMMON / HCBITS / I1, I2, I3, I4, I5, I6, I7, I8, + I9, I10, I11, I12, I13, I14, I15, I16, +I17, I18, I19, I20, I21, I22, I23, I24, I25, I26, I27, +I28, I29, I30, I31, I32, I33, I34, I35, I123, I230 +DECK,hcdir,if=v93. +KEEP,HCDIR. integer nlpatm, mxfiles PARAMETER (NLPATM=100, MXFILES=50) integer nlcdir, nlndir, nlpat, icdir, nchtop, ichtop, + ichtyp, ichlun COMMON /HCDIRN/NLCDIR,NLNDIR,NLPAT,ICDIR,NCHTOP,ICHTOP(MXFILES) + ,ICHTYP(MXFILES),ICHLUN(MXFILES) CHARACTER*16 CHNDIR, CHCDIR, CHPAT ,CHTOP COMMON /HCDIRC/CHCDIR(NLPATM),CHNDIR(NLPATM),CHPAT(NLPATM) + ,CHTOP(NLPATM) CHARACTER*80 HFNAME COMMON /HCFILE/HFNAME(MXFILES) +DECK,hicdes_93,if=v93. +KEEP,HIFLAG. COMMON /HIFLAG/ GFLAG,GLFLAG,ZFLAG,PFLAG,MFLAG,TFLAG +,ASFLAG,GRFLAG,AXFLAG LOGICAL GFLAG,GLFLAG,ZFLAG,PFLAG,MFLAG,TFLAG +,ASFLAG,GRFLAG,AXFLAG +KEEP,HIATT. Attributes list COMMON /HIATT/ INTR,XRATIO,YRATIO +,RWXMIN,RWXMAX,RWYMIN,RWYMAX,RVXMIN,RVXMAX,RVYMIN,RVYMAX +,RDWXMI,RDWXMA,RDWYMI,RDWYMA,RDVXMI,RDVXMA,RDVYMI,RDVYMA +,RMDSX ,RMDSY ,IWTYPE,IDID ,IDTY +,ILOPWK(10),ACWKFL(10),NODRFL(10),IWTYL(10) ,INOPWK +,XWKSIZ(10),YWKSIZ(10),WKMAX(10) ,IWINID(10),XWKR(10),YWKR(10) +,XWKW1(10),YWKW1(10),XWKV1(10),YWKV1(10) +,XWKW2(10),YWKW2(10),XWKV2(10),YWKV2(10) +,IPICT,ICLIP,REDIT,NT0PRI +,RMKSC ,RLWSC ,RBSL ,RANGLE,RCHH ,RCSHIF,RBOF ,RBWD +,RAWL ,RTMS ,RALH ,RALD ,REAATT(18) +,IPLCI ,ILN ,IPMCI ,IMK ,IFACI ,IFAIS ,IFASI ,ITXCI +,ITXALG,IFTPR ,INPASS,IBORD ,INLINE,INTATT(17) +,IFONT,IPREC,ITXALH,ITXALV,RCHUX,RCHUY +,IDIM,INBCOL LOGICAL ACWKFL,NODRFL +KEEP,HIMDOS. COMMON /HIMDOS/ IPICNM,SCMETA +KEEP,HIMETA. COMMON /HIMETA/ IDMETA,XMFACT,YMFACT,TEKACT,METACT,FILOPN INTEGER IDMETA REAL XMFACT,YMFACT LOGICAL TEKACT,METACT,FILOPN COMMON /HIMETC/ CHMETA CHARACTER*24 CHMETA +SEQ,HIMDOS,IF=MSDOS. +DECK,mncmd. +KEEP,MNCMD. CHARACTER*10 COMND1,COMND2,COMND3 common /m9cmd0/ comnd1,comnd2,comnd3 C LOGICAL QRFILE,QABORT INTEGER LUNDMP COMMON/M9CMD1/QRFILE,LUNDMP,QABORT C INTEGER MDRAW,MLOG,MSMOD,MHBP,MCUT,MORD,MNTO,MTBL PARAMETER (MDRAW = 20) PARAMETER (MLOG = 9) PARAMETER (MSMOD = 6) PARAMETER (MHBP = 9) PARAMETER (MCUT = 7) PARAMETER (MORD = 20) PARAMETER (MNTO = 13) PARAMETER (MTBL = 17) C C MCOL Maximum number of colours C integer mcol parameter (mcol = 50) C INTEGER MDRW_LINE, MDRW_ARROW, MDRW_BOX, MDRW_TRIANGLE + ,MDRW_POLYGON,MDRW_POLYLINE + ,MDRW_CIRCLE, MDRW_ARC, MDRW_SINE, MDRW_GLUON, MDRW_SYMBOL + ,MDRW_ELLIPSE,MDRW_SEG PARAMETER (MDRW_LINE = 1) PARAMETER (MDRW_ARROW = 2) PARAMETER (MDRW_BOX = 3) PARAMETER (MDRW_TRIANGLE = 4) PARAMETER (MDRW_POLYGON = 5) PARAMETER (MDRW_POLYLINE = 6) PARAMETER (MDRW_CIRCLE = 7) PARAMETER (MDRW_ARC = 8) PARAMETER (MDRW_SINE = 9) PARAMETER (MDRW_GLUON =10) PARAMETER (MDRW_SYMBOL =11) PARAMETER (MDRW_ELLIPSE =12) PARAMETER (MDRW_SEG =13) C CHARACTER*10 DRWNAM,LOGNAM,SCLMOD + ,OPTNAM,UNTNAM + ,ORDNAM,NTONAM + ,COLNAM + ,TBLNAM CHARACTER*4 CUTNAM CHARACTER*2 CUTNM2 CHARACTER*3 ANDNAM CHARACTER*4 HBPNAM CHARACTER*2 TSPSYM CHARACTER*5 TCMSYM CHARACTER*11 TCTSYM CHARACTER*3 THPSYM CHARACTER*20 TSDSCN,TSVSCN,TS2SCN,TS3SCN,TS4SCN C COMMON/M9CMD2/DRWNAM(MDRAW),LOGNAM(MLOG),SCLMOD(MSMOD) + ,OPTNAM(5),UNTNAM(3) + ,ORDNAM(MORD),NTONAM(MNTO),COLNAM(0:MCOL),TBLNAM(MTBL,2) + ,CUTNAM(MCUT),CUTNM2(MCUT),ANDNAM(3) + ,HBPNAM(MHBP) C common /m9cmd3/ + TSPSYM,TCMSYM,TCTSYM,THPSYM + ,TSDSCN + ,TSVSCN,TS2SCN,TS3SCN,TS4SCN C INTEGER IPNTD,MDUMMY COMMON/M9CMD4/IPNTD(5),MDUMMY C INTEGER MTBL2D,MTBL3D,MTBLEGO,MTBSURF COMMON/M9CMD5/MTBL2D,MTBL3D,MTBLEGO,MTBSURF * integer ncoldef real colfrc common /m9cmd6/ ncoldef,colfrc(3,0:mcol) +DECK,mncmt. C C Comment and continuation line characters C +KEEP,MNCMT. CHARACTER*1 TSCOMM,TSCONT COMMON /M9CMT1/ TSCOMM,TSCONT +DECK,mncndj. +KEEP,MNCNDJ,IF=VAX. INTEGER SS$_USRBASE,SS$_USRCTLC PARAMETER (SS$_USRBASE='08008000'X) PARAMETER (SS$_USRCTLC=SS$_USRBASE+'00000012'X) INTEGER NCTCHN,ICTPAR,IARITH LOGICAL QBREAK,QERROR,QTRAP,QBRKEN COMMON /MNCNDJ/ NCTCHN,ICTPAR,QBREAK,QERROR,QTRAP,QBRKEN,IARITH VOLATILE /MNCNDJ/ +KEEP,MNCNDJ,IF=-VAX. INTEGER NCTCHN,ICTPAR,IARITH LOGICAL QBREAK,QERROR,QTRAP,QBRKEN COMMON /MNCNDJ/ NCTCHN,ICTPAR,QBREAK,QERROR,QTRAP,QBRKEN,IARITH +DECK,mncpc. +KEEP,MNCPC. C C Common blocks for use with CPC C MNCPC_CMD contains the commands being passed to Mn_Fit C MNCPC_MES contains information being sent back C MNCPC_FLG contains the event flag number, infocache contents C and the CPU node C TCPC_FLG says what is being sent (P, E, M, R) or any combination C TCPC_MES contains any messages C INTEGER MCPC_MES PARAMETER (MCPC_MES=20) * INTEGER IF_CMD,IL_CMD CHARACTER*80 TCPC_CMD COMMON/MNCPC_CMD/ IF_CMD,TCPC_CMD,IL_CMD(128) CDEC$ PSECT /MNCPC_CMD/ ALIGN=9 C INTEGER IF_MES,IL_MES CHARACTER*4 TCPC_FLG CHARACTER*80 TCPC_MES COMMON/MNCPC_MES/ IF_MES,TCPC_FLG,TCPC_MES(MCPC_MES),IL_MES(128) CDEC$ PSECT /MNCPC_MES/ ALIGN=9 C INTEGER ICR INTEGER*2 ICMD(8),IMES(8) CHARACTER*6 MNFIT_NODE_NAME COMMON/MNCPC_FLG/ ICR,ICMD,IMES,MNFIT_NODE_NAME C CHARACTER*20 MNFIT_CMD_CLUSCOM_NAME,MNFIT_MES_CLUSCOM_NAME CHARACTER*40 MNFIT_CMD_CLUSCOM_FILE,MNFIT_MES_CLUSCOM_FILE CHARACTER*20 MNFIT_CMD_IC_NAME,MNFIT_MES_IC_NAME COMMON/MNCPC_NAM/ + MNFIT_CMD_CLUSCOM_NAME,MNFIT_CMD_CLUSCOM_FILE,MNFIT_CMD_IC_NAME +,MNFIT_MES_CLUSCOM_NAME,MNFIT_MES_CLUSCOM_FILE,MNFIT_MES_IC_NAME +DECK,mncpc_g. +KEEP,MNCPC_G. C C Common block containing local copy of command for use with CPC C CHARACTER*80 TMN_CMD COMMON/M9CPC_G/ TMN_CMD +DECK,mncpc_m. +KEEP,MNCPC_M. C C Common block containing local copy of flag and message C INTEGER MMN_MES,MMN_MSTACK PARAMETER (MMN_MES=20) PARAMETER (MMN_MSTACK=20) C INTEGER MN_MES CHARACTER*4 TMN_FLG,TMN_FLG_LAST CHARACTER*80 TMN_MES COMMON/M9CPC_M/ MN_MES,TMN_FLG(MMN_MSTACK) + ,TMN_MES(MMN_MES,MMN_MSTACK),TMN_FLG_LAST +DECK,mncut. +KEEP,MNCUT. C C STORAGE OF CUTS *ICTYPE = 1 means simple cut, variable and value *ICTYPE = 2 means an expression for variable then value *ICTYPE = 3 means an expression for value also *ICTYPE = 4 means a COMIS function, compiled in MN_PRJ C INTEGER NCCUT,NCUSE,ICTYPE,ICVAR,ICCOND,ICAND,ICPARI,ICPARO,ICUSE INTEGER ICVAL COMMON/M9CUTA/NCCUT,NCUSE,ICTYPE(MCUTMX),ICVAR(10,MCUTMX) 1 ,ICCOND(MCUTMX),ICVAL(10,MCUTMX) 2 ,ICAND(MCUTMX),ICPARI(MCUTMX) 3 ,ICPARO(MCUTMX),ICUSE(MCUTMX) REAL RCVAL(10,MCUTMX) EQUIVALENCE(ICVAL(1,1),RCVAL(1,1)) CHARACTER*10 TCNAM CHARACTER*255 TCVAR CHARACTER*255 TCVAL COMMON /M9CUTB/ TCNAM(MCUTMX),TCVAR(MCUTMX),TCVAL(MCUTMX) C C Common for parsed CUT expressions C INTEGER MCESUB PARAMETER (MCESUB = 50) C INTEGER NCEXPR,LCEXPR,ICETYP,ICETP,ICETF,ICETV COMMON/M9CUTC/NCEXPR,LCEXPR(MCUTMX) + ,ICETYP(MCESUB,MCUTMX),ICETP(MCESUB,MCUTMX) + ,ICETF(MCESUB,MCUTMX),ICETV(10,MCESUB,MCUTMX) +DECK,mncwn. +keep,mncwn. * * Common Blocks for CWN's * * PAW common blocks for the CWN integer mcr4mx,mcr8mx,mcchmx parameter (mcr4mx = 100000) parameter (mcr8mx = 10000) parameter (mcchmx = 5000) real ar4 common /pawcr4/ ar4(mcr4mx) double precision zr8 common /pawcr8/ zr8(mcr8mx) character*4 cch common /pawcch/ cch(mcchmx) integer ir4(mcr4mx) logical qr4(mcr4mx) * equivalence (ar4(1),ir4(1)) equivalence (ar4(1),qr4(1)) * * CWN structure in terms of variable number * integer nwr4sv,nwr8sv,nwchsv + ,ivsub,ivtype,ivsize,ivelem,ivposn common /m8cwn1/ nwr4sv,nwr8sv,nwchsv + ,ivsub(10,mdimmx),ivtype(mdimmx),ivsize(mdimmx) + ,ivelem(mdimmx),ivposn(mdimmx) * * CWN variables in order that they are asked for. * 1st variables to project onto * 2nd extra variables needed for variables length arrays * 3rd cut variables * 4th extra variables from SET NTUPLE VARIABLE command * integer nvcwn,ivcwn,iecwn common /m8cwn2/ nvcwn,ivcwn(mdimmx),iecwn(9,mdimmx) character chcwn*32,chblk*8,chcwnv*32,cvdesc*40 common /m8cwn3/ chcwn(mdimmx),chblk(mdimmx),chcwnv(mdimmx) + ,cvdesc(mdimmx) * * Extra variables to fetch from SET NTUPLE VARIABLE command * integer mcwn_x,ncwn_x parameter (mcwn_x = 20) common /m8cwn4/ ncwn_x character tcwn_x*32 common /m8cwn5/ tcwn_x(mcwn_x) +DECK,mndat. +KEEP,MNDAT. C C MAIN DATA STORAGE C REAL RDAT COMMON/M9DAT/RDAT(MHSTWD) INTEGER*2 IDAT2(2*MHSTWD) EQUIVALENCE(RDAT,IDAT2) C INTEGER NHSTWD,NDPTE,NDHIS,NDIDB,NIDADT,NIDBDT,NNHDT COMMON/M9DATA/NHSTWD,NDPTE,NDHIS,NDIDB,NIDADT,NIDBDT,NNHDT INTEGER IDIDA,IDIDB,IDPTRH,IDPTRD COMMON/M9DATB/IDIDA(MHSTMX),IDIDB(MHSTMX),IDPTRH(MHSTMX) 1 ,IDPTRD(MHSTMX) C C TDTIT is the plot title C TDFIL is the filename for the plot C TDDIR is the HBOOK directory it is in C TDNAM are the names of the variables C CHARACTER*80 TDTIT CHARACTER*80 TDFIL CHARACTER*40 TDDIR CHARACTER*32 TDNAM COMMON/M9DATC/TDTIT(MHSTMX),TDFIL(MHSTMX),TDDIR(MHSTMX) + ,TDNAM(MDIMMX,MHSTMX) +DECK,mndbg. +KEEP,MNDBG. C C Debug flag for Mn_Fit and COMIS. C To get Mn_Fit debug output set NDEBUG > 100. C LOGICAL QDEBUG INTEGER NDEBUG COMMON/MNDBG/QDEBUG,NDEBUG +DECK,mndir. +KEEP,MNDIR. C C DIRECTORY WHERE CODE AND NECESSARY FILES ARE KEPT C CHARACTER TMNDIR*80,TMNHLP*80,TMNHOM*80,TMNDOC*80 COMMON /M9DIR1/ TMNDIR,TMNHLP,TMNHOM,TMNDOC C INTEGER LMNDIR,LMNHLP,LMNHOM,LMNDOC COMMON /M9DIR2/ LMNDIR,LMNHLP,LMNHOM,LMNDOC +DECK,mndsp. +KEEP,MNDSP,IF=L3DSP_SRC. INTEGER MDET,MDSPAR,MDSKEY PARAMETER (MDET=9, MDSPAR=20, MDSKEY=10) C INTEGER NDSPTP,IDSPTP + ,IPARL3,IPARTE,IPAREC,IPARHC,IPARMU,IPARFB,IPARFW,IPARFS REAL PRD_L3,PRS_L3,PRU_L3,PRP_L3 + ,PRD_TE,PRS_TE,PRU_TE,PRP_TE + ,PRD_EC,PRS_EC,PRU_EC,PRP_EC + ,PRD_HC,PRS_HC,PRU_HC,PRP_HC + ,PRD_MU,PRS_MU,PRU_MU,PRP_MU + ,PRD_FB,PRS_FB,PRU_FB,PRP_FB + ,PRD_FW,PRS_FW,PRU_FW,PRP_FW + ,PRD_FS,PRS_FS,PRU_FS,PRP_FS COMMON/M9DSP1/NDSPTP,IDSPTP(MHPLT) + ,IPARL3(MDSPAR),PRD_L3(MDSPAR),PRS_L3(MDSPAR),PRU_L3(MDSPAR) + ,PRP_L3(MDSPAR,MHPLT) + ,IPARTE(MDSPAR),PRD_TE(MDSPAR),PRS_TE(MDSPAR),PRU_TE(MDSPAR) + ,PRP_TE(MDSPAR,MHPLT) + ,IPAREC(MDSPAR),PRD_EC(MDSPAR),PRS_EC(MDSPAR),PRU_EC(MDSPAR) + ,PRP_EC(MDSPAR,MHPLT) + ,IPARHC(MDSPAR),PRD_HC(MDSPAR),PRS_HC(MDSPAR),PRU_HC(MDSPAR) + ,PRP_HC(MDSPAR,MHPLT) + ,IPARMU(MDSPAR),PRD_MU(MDSPAR),PRS_MU(MDSPAR),PRU_MU(MDSPAR) + ,PRP_MU(MDSPAR,MHPLT) + ,IPARFB(MDSPAR),PRD_FB(MDSPAR),PRS_FB(MDSPAR),PRU_FB(MDSPAR) + ,PRP_FB(MDSPAR,MHPLT) + ,IPARFW(MDSPAR),PRD_FW(MDSPAR),PRS_FW(MDSPAR),PRU_FW(MDSPAR) + ,PRP_FW(MDSPAR,MHPLT) + ,IPARFS(MDSPAR),PRD_FS(MDSPAR),PRS_FS(MDSPAR),PRU_FS(MDSPAR) + ,PRP_FS(MDSPAR,MHPLT) C CHARACTER*4 DETNAM CHARACTER*10 TPARL3,TPARTE,TPAREC,TPARHC,TPARMU + ,TPARFB,TPARFW,TPARFS C COMMON/M9DSP2/DETNAM(MDET),TPARL3(MDSPAR) + ,TPARTE(MDSPAR),TPAREC(MDSPAR),TPARHC(MDSPAR),TPARMU(MDSPAR) + ,TPARFB(MDSPAR),TPARFW(MDSPAR),TPARFS(MDSPAR) C CHARACTER*15 TKYSL3,TKYUL3,TKYPL3,TKYSTE,TKYUTE,TKYPTE + ,TKYSEC,TKYUEC,TKYPEC,TKYSHC,TKYUHC,TKYPHC + ,TKYSMU,TKYUMU,TKYPMU,TKYSFB,TKYUFB,TKYPFB + ,TKYSFW,TKYUFW,TKYPFW,TKYSFS,TKYUFS,TKYPFS COMMON/M9DSP3/ + TKYSL3(MDSKEY),TKYUL3(MDSKEY),TKYPL3(MDSKEY,MHPLT) + ,TKYSTE(MDSKEY),TKYUTE(MDSKEY),TKYPTE(MDSKEY,MHPLT) + ,TKYSEC(MDSKEY),TKYUEC(MDSKEY),TKYPEC(MDSKEY,MHPLT) + ,TKYSHC(MDSKEY),TKYUHC(MDSKEY),TKYPHC(MDSKEY,MHPLT) + ,TKYSMU(MDSKEY),TKYUMU(MDSKEY),TKYPMU(MDSKEY,MHPLT) + ,TKYSFB(MDSKEY),TKYUFB(MDSKEY),TKYPFB(MDSKEY,MHPLT) + ,TKYSFW(MDSKEY),TKYUFW(MDSKEY),TKYPFW(MDSKEY,MHPLT) + ,TKYSFS(MDSKEY),TKYUFS(MDSKEY),TKYPFS(MDSKEY,MHPLT) +KEEP,MNDSP,IF=ZEUSDSP_SRC. INTEGER MDET,MDSPAR,MDSKEY PARAMETER (MDET=4, MDSPAR=20, MDSKEY=10) C INTEGER NDSPTP,IDSPTP + ,IPARFD,IPARFT,IPARTR REAL PRD_FD,PRS_FD,PRU_FD,PRP_FD + ,PRD_FT,PRS_FT,PRU_FT,PRP_FT + ,PRD_TR,PRS_TR,PRU_TR,PRP_TR COMMON/M9DSP1/NDSPTP,IDSPTP(MHPLT) + ,IPARFD(MDSPAR),PRD_FD(MDSPAR),PRS_FD(MDSPAR),PRU_FD(MDSPAR) + ,PRP_FD(MDSPAR,MHPLT) + ,IPARFT(MDSPAR),PRD_FT(MDSPAR),PRS_FT(MDSPAR),PRU_FT(MDSPAR) + ,PRP_FT(MDSPAR,MHPLT) + ,IPARTR(MDSPAR),PRD_TR(MDSPAR),PRS_TR(MDSPAR),PRU_TR(MDSPAR) + ,PRP_TR(MDSPAR,MHPLT) C CHARACTER*4 DETNAM CHARACTER*10 TPARFD,TPARFT,TPARTR C COMMON/M9DSP2/DETNAM(MDET),TPARFD(MDSPAR) + ,TPARFT(MDSPAR),TPARTR(MDSPAR) C CHARACTER*15 TKYSFD,TKYUFD,TKYPFD,TKYSFT,TKYUFT,TKYPFT + ,TKYSTR,TKYUTR,TKYPTR COMMON/M9DSP3/ + TKYSFD(MDSKEY),TKYUFD(MDSKEY),TKYPFD(MDSKEY,MHPLT) + ,TKYSFT(MDSKEY),TKYUFT(MDSKEY),TKYPFT(MDSKEY,MHPLT) + ,TKYSTR(MDSKEY),TKYUTR(MDSKEY),TKYPTR(MDSKEY,MHPLT) +DECK,mnfit. +KEEP,MNFIT. INTEGER MFINTG PARAMETER (MFINTG = 50) C Maximum number of constraints and the depth of each INTEGER MCNSTR,MCNSUB PARAMETER (MCNSTR = 20, MCNSUB = 100) C Maximum number of steps in convoluting function with a Gaussian INTEGER MFCONV PARAMETER (MFCONV = 100) C C STORAGE FOR HISTOGRAMS TO BE FIT C INTEGER NDFIT,NFPTE COMMON/M9FITA/NDFIT,NFPTE C REAL RFIT COMMON/M9FITB/RFIT(MFITWD) C C NFITTP Fit type C NPARTP Type of parameters 0 = Normal C 1 = Fractions + overall normalization C JMINFX,JMINPX Cross-reference from MINUIT to Mn_Fit parameter numbers C INTEGER NFITTP,NPARTP,NHFIT,IDFITA,IDFITB,IFPTRH,IFPTRD + ,IFNDIM,IFWPPT,IFPFIT,IFPUSE + ,IXEXCL,IYEXCL,IXINCL,IYINCL + ,IASSF,IDBCKA,IDBCKB + ,JMINFX,JMINPX REAL XLEXCL,XHEXCL,YLEXCL,YHEXCL,XLINCL,XHINCL,YLINCL,YHINCL + ,XFTPAR COMMON/M9FITC/NFITTP,NPARTP,NHFIT,IDFITA(MFITMX),IDFITB(MFITMX) 1 ,IFPTRH(MFITMX),IFPTRD(MFITMX) 1 ,IFNDIM(MFITMX),IFWPPT(MFITMX),IFPFIT(MFITMX),IFPUSE(MFITMX) 3 ,IXEXCL(MFITMX),XLEXCL(10,MFITMX),XHEXCL(10,MFITMX) 3 ,IYEXCL(MFITMX),YLEXCL(10,MFITMX),YHEXCL(10,MFITMX) 3 ,IXINCL(MFITMX),XLINCL(10,MFITMX),XHINCL(10,MFITMX) 3 ,IYINCL(MFITMX),YLINCL(10,MFITMX),YHINCL(10,MFITMX) 4 ,XFTPAR(20,MFITMX),IASSF(MFUNMX,MFITMX) 6 ,IDBCKA(MFITMX),IDBCKB(MFITMX) + ,JMINFX(MINMAX),JMINPX(MINMAX) C CHARACTER*80 TFTIT CHARACTER*80 TFFIL CHARACTER*32 TFNAM COMMON/M9FITD/TFTIT(MFITMX),TFFIL(MFITMX) 1 ,TFNAM(MDIMMX,MFITMX) C C Fit results C INTEGER NPAR_MN,NFRE_MN,NPTTOT REAL CHI2_MN,ALIK_MN,CONLEV,FICHI,FILIK COMMON/M9FITE/NPAR_MN,CHI2_MN,ALIK_MN,NFRE_MN,CONLEV 1 ,NPTTOT 1 ,FICHI(MFITMX),FILIK(MFITMX) C C QFITER Flag if fit iterations should be shown C QSEXCL C NDMODE Mode for displaying the results of a fit C QSORTH Flag if orthogonality limits have been set C QSNORM Flag if overall normalization factor should be applied C QSBACK Flag if background functions have been specified C QRATIO Flag if ratio of areas used when fitting multiple histograms C QFINTG Flag if function should be integrated across each bin C NFINTG Number of intervals in each bin for integration C QFBINW Use bin width when calculating function value C QFCONV Convolute the function with a Gaussian C RFCONV Width of the Gaussians to convolute C QFAREA Calculate the AREA when using fragmentation functions and C dipion invariant mass functions C QMNCHGE Number of functions or fitting method changed C LOGICAL QFITER,QSEXCL,QSORTH,QSNORM,QSBACK,QRATIO,QFINTG,QFBINW + ,QFCONV,QFAREA,QMNCHGE INTEGER NFITER,NDMODE,NFINTG REAL RFCONV COMMON/M9FITF/QFITER,NFITER,QSEXCL,NDMODE + ,QSORTH,QSNORM,QSBACK,QRATIO,QFINTG,NFINTG,QFBINW + ,QFCONV,RFCONV(10),QFAREA,QMNCHGE C C Constraints C NCNSTR Number of constraints to be applied to the parameters C LCNSTR Length of each constraint C ICNTYP,ICNTP,ICNTF,ICNTV The constraint in form for AM_EXP C JCNSTX Cross-reference from MINUIT parameter to constraint number INTEGER NCNSTR,LCNSTR,ICNPAR,ICNTYP,ICNTP,ICNTF,ICNTV,JCNSTX COMMON/M9FITG/NCNSTR + ,LCNSTR(MCNSTR),ICNPAR(MCNSTR) + ,ICNTYP(MCNSUB,MCNSTR),ICNTP(MCNSUB,MCNSTR),ICNTF(MCNSUB,MCNSTR) + ,ICNTV(10,MCNSUB,MCNSTR) + ,JCNSTX(MINMAX) C CHARACTER*80 TCNSTR COMMON/M9FITH/ TCNSTR(MCNSTR) +DECK,mnflg. +KEEP,MNFLG. C C UNITS FOR READING AND WRITING PLOTS C INTEGER LUNHIN,LUNAIN,LUNDIN,LUNMIN,LUNSIN,LUNFIN + ,LUNYIN + ,LUNHOU,LUNMOU,LUNFOU,LUNPIN,LUNPOU,NRCLHB,npath COMMON/M9JNKT/LUNHIN,LUNAIN,LUNDIN,LUNMIN,LUNSIN,LUNFIN 1 ,LUNYIN 1 ,LUNHOU,LUNMOU,LUNFOU,LUNPIN,LUNPOU,NRCLHB,npath C integer mpath parameter (mpath = 10) CHARACTER*80 FIL_HB,FIL_AV,FIL_DT,FIL_MN,FIL_SC,FIL_FI 1 ,FIL_HY 1 ,FIL_HO,FIL_MO,FIL_FO,FIL_DP,FIL_PI,FIL_PO + ,DIR_HB,DIR_HC,DIR_WD,tpath COMMON/M9JNKU/FIL_HB,FIL_AV,FIL_DT,FIL_MN,FIL_SC,FIL_FI 1 ,FIL_HY 1 ,FIL_HO,FIL_MO,FIL_FO,FIL_DP,FIL_PI,FIL_PO + ,DIR_HB,DIR_HC,DIR_WD,tpath(mpath) C CHARACTER*20 TEDIT CHARACTER*20 TSHELL character tpager*40 COMMON/M9JNKW/TEDIT,TSHELL,tpager C C QHSTAT Use HBOOK statistics rather than Mn_Fit C QMOUSE Use the mouse to get x,y positions C QBREAK Break handling turned on or off C QAFETCH Automatic refetching of Ntuples C QTKTCL Turn on/off TK/TCL interface C IORDMN Expected order of variables for DAT_FETCH C INTPMN Variable specification for plotting Ntuples directly C LOGICAL QSHIST,QHBPRT,QENULL,QHSTAT,QMOUSE,QBREAK,QAFETCH + ,QTKTCL INTEGER IORDMN,INTPMN COMMON/M9JNKX/QSHIST,QHBPRT,QENULL,QHSTAT,QMOUSE,QBREAK,QAFETCH + ,QTKTCL + ,IORDMN(20),INTPMN(9) C C NINTFT Number of intervals when intgrating a function in the parser C FNSTEP Step size when calculating function derivatives in the parser C INTEGER NINTFT REAL FNSTEP COMMON/M9CLC2/NINTFT,FNSTEP +DECK,mnfun. +KEEP,MNFUN. C C STORAGE FOR THE FUNCTION VALUES C C USED FUNCTIONS C INTEGER NFUN_MN,NFUSEM,NFUSEL + ,INUMF,IPARF,IUSEF REAL FPAR,DFPAR,DPFPAR,DNFPAR,FPARLO,FPARHI,XFXPAR INTEGER ISIGF,IBCKF,IADRF,ISFPAR REAL F00,DF00,DPF00,DNF00,F00LO,F00HI INTEGER ISF00 C COMMON/M9FUNA/NFUN_MN,NFUSEM,NFUSEL 1 ,INUMF(MFUNMX),IPARF(MFUNMX),IUSEF(MFUNMX) 1 ,FPAR(20,MFUNMX),DFPAR(20,MFUNMX) 1 ,DPFPAR(20,MFUNMX),DNFPAR(20,MFUNMX) 1 ,FPARLO(20,MFUNMX),FPARHI(20,MFUNMX) 2 ,XFXPAR(20,MFUNMX),ISFPAR(20,MFUNMX) 3 ,ISIGF(MFUNMX),IBCKF(MFUNMX),IADRF(MFUNMX) 4 ,F00,DF00,DPF00,DNF00,F00LO,F00HI,ISF00 C CHARACTER*10 TPARF,TNAMF CHARACTER*80 TUSEF,TFILF C COMMON/M9FUNB/TPARF(20,MFUNMX),TUSEF(MFUNMX),TFILF(MFUNMX) 1 ,TNAMF(MFUNMX) C C Smooth histograms as functions C INTEGER MHPTMX,MHSMMX PARAMETER (MHPTMX = 500) PARAMETER (MHSMMX = 10) INTEGER IHSMOO,IHPSMO DOUBLE PRECISION XHSMOO,AHSMOO,BHSMOO,CHSMOO,DHSMOO COMMON /M9FUNC/ IHSMOO(MHSMMX),IHPSMO(MHSMMX) + ,XHSMOO(0:MHPTMX,MHSMMX) + ,AHSMOO(MHPTMX,MHSMMX),BHSMOO(MHPTMX,MHSMMX) + ,CHSMOO(MHPTMX,MHSMMX),DHSMOO(MHPTMX,MHSMMX) C C DRAWN FUNCTIONS C INTEGER NDFUN REAL AFTTOT,AFFTOT,AHTTOT,AHFTOT C COMMON/M9FUND/NDFUN + ,AFTTOT(MFNHMX,MFITMX),AFFTOT(MFNHMX,MFITMX) + ,AHTTOT(MFITMX),AHFTOT(MFITMX) C C DEFINED FUNCTIONS C INTEGER MMPIPI,MMFRAG PARAMETER (MMPIPI=10) PARAMETER (MMFRAG=10) INTEGER NFNDMX,IFPAR,IPPIPI,IPFRAG INTEGER LFPEXP,LFTRIG,LFPIPI,LFFRAG,LFXRES,LFXCNT,LFUSER + ,LFHFUN,LFHSMO + ,LFCMIS,LFARGU,LFCONV,LF2DIM INTEGER LFGAUSS,LFPOLY,LFCHEB,LFEXP C COMMON/M9FUNE/NFNDMX,IFPAR(MFNDMX),IPPIPI(MMPIPI),IPFRAG(MMFRAG) + ,LFPEXP,LFTRIG,LFPIPI,LFFRAG,LFXRES,LFXCNT,LFUSER + ,LFHFUN,LFHSMO + ,LFCMIS,LFARGU,LFCONV,LF2DIM + ,LFGAUSS,LFPOLY,LFCHEB,LFEXP C CHARACTER*35 TFNNAM CHARACTER*20 TPIPI,TFRAG CHARACTER*10 TFPNAM,TPPIPI,TPFRAG COMMON/M9FUNF/TFNNAM(MFNDMX),TFPNAM(20,MFNDMX) + ,TPIPI(MMPIPI),TPPIPI(20,MMPIPI) + ,TFRAG(MMFRAG),TPFRAG(20,MMFRAG) +DECK,mngrn. +KEEP,MNGRN. INTEGER MPTOT,MTEKDV,MAXPVI,MDISP0 PARAMETER (MPTOT=25,MTEKDV=10,MAXPVI=12,MDISP0=3) INTEGER MPDEV,MPSOF,MPHRD,LPUNIT,LPDEV,IPDEV,IPUNIT,ICONID + ,IPLPOS,NPCMD,NSPAPER,NTEKDV,ITEKDV,JTEKDV + ,ITNR,NP113,NDVLST REAL SZMAX,OFSET + ,XOF_GR,YOF_GR, XSC_GR,YSC_GR, X0_GR, Y0_GR + ,CMTOIN,GRWIND + ,ANTVP LOGICAL QPDEV,QPOP,QPVERT,QSAMDV,QASWCH,QAWAIT,QCOLOUR,QIGARC COMMON/M9GRN/ MPDEV,MPSOF,MPHRD + ,LPUNIT, LPDEV + ,IPDEV(MPTOT), IPUNIT(MPTOT), ICONID(MPTOT) + ,QPDEV(MPTOT), QPOP(MPTOT), QPVERT(MPTOT) + ,SZMAX(2,MPTOT), OFSET(2,MPTOT), IPLPOS(2,MPTOT) + ,XOF_GR, YOF_GR, XSC_GR, YSC_GR, X0_GR, Y0_GR + ,CMTOIN, GRWIND(4) C Paper size + ,NPCMD,NSPAPER C PLOTS ARE ON SAME DEVICE AS TEXT + ,QSAMDV C AUTOMATICALLY SWITCH BETWEEN PLOTTING WINDOWS + ,QASWCH C Wait for a before making next plot + ,QAWAIT C Colour is turned on or off + ,QCOLOUR C Use HIGZ or my circle drawing routines 1 ,QIGARC C KNOWN TEKTRONIX DEVICES + ,NTEKDV,ITEKDV(MTEKDV),JTEKDV(MTEKDV) C Normalization Transformation and Workstation Viewport for IGTABL + ,ITNR,ANTVP(4) C Number of pages of an Encapsulated Postscript plot and last device + ,NP113,NDVLST C CHARACTER*10 TGVERS CHARACTER*40 TPDEV,TPSOF,TPHRD CHARACTER*80 TPNAM,TFHRD COMMON/M9GNM/ TGVERS,TPDEV(MPTOT),TPSOF(MPTOT),TPHRD(MPTOT) + ,TPNAM(MPTOT),TFHRD +DECK,mnhpj. +KEEP,MNHPJ. C C COMMON BLOCKS FOR PLOTTING C SUFFIX U MEANS SIZES ETC TO BE USED IN CURRENT PLOT C S MEANS VALUES SET IN MN_SET WITH SET COMMAND C D MEANS DEFAULT SIZES C W ARE THE MARGIN AND OVERALL PLOT SIZE FOR WINDOWING C P ARE THE SIZES FOR EACH PLOT C C REAL SIZEU,SIZES,SIZED + ,AMRGU,AMRGS,AMRGD,WMRGU,WMRGS,WMRGD + ,HSZEU,HSZES,HSZED,WSZEU,WSZES,WSZED + ,ALIMU,ALIMS,ALIMD + ,ALEGU,ALEGS,ALEGD INTEGER ISIZEN,IMRGN,IHSZEN,ILIMN,ILEGN + ,NSYMU,NSYMS,NSYMD, NHATU,NHATS,NHATD, NPATU,NPATS,NPATD + ,NCLRU, NLEGU LOGICAL + QLIMCU c COMMON/M9HPJA/ C OVERALL PLOT SIZE 1 SIZEU(2),SIZES(2),SIZED(2) ,ISIZEN(2) C MARGIN SIZE 1 ,AMRGU(2),AMRGS(2),AMRGD(2),WMRGU(2),WMRGS(2),WMRGD(2),IMRGN(2) C PLOT SIZE 1 ,HSZEU(2),HSZES(2),HSZED(2),WSZEU(2),WSZES(2),WSZED(2),IHSZEN(2) C PLOT LIMITS 1 ,ALIMU(2,3),ALIMS(2,3),ALIMD(2,3) ,QLIMCU(3) ,ILIMN(10) C PLOT SYMBOL hatch and patterns 1 ,NSYMU,NSYMS,NSYMD ,NHATU,NHATS,NHATD ,NPATU,NPATS,NPATD C CLEAR FLAG, LEGO PLOT FLAG and angles 1 ,NCLRU ,NLEGU ,ALEGU(10),ALEGS(10),ALEGD(10) ,ILEGN(10) C REAL TSZEU,TSZES,TSZED INTEGER IZEROU,IZEROS,IZEROD + ,IGRIDU,IGRIDS,IGRIDD + ,IPWNDU,IPWNDS,IPWNDD LOGICAL QZEROU,QZEROS,QZEROD COMMON/M9HPJB/ C TEXT SIZES 1 = TITLE C 2 = SMALL TEXT IN DISPLAY C 3 = HEADER TEXT SIZE C 4 = SYMBOL SIZE C 5 = LINE UNIT SIZE C 6 = PEN WIDTH C 7 = DOT SCALE FACTOR C 8 = Rotation angle C 9 = Footer size + TSZEU(10),TSZES(10),TSZED(10) C DRAW LINE AT X OR Y = 0 AND SYMBOL + ,QZEROU(2),QZEROS(2),QZEROD(2) ,IZEROU(2),IZEROS(2),IZEROD(2) C Draw a grid - 0 means no grid, otherwise it gives the symbol to use C Window numbers + ,IGRIDU(2,3),IGRIDS(2,3),IGRIDD(2,3) + ,IPWNDU(2),IPWNDS(2),IPWNDD(2) C REAL TICKU,TICKS,TICKD + ,SCALU,SCALS,SCALD + ,ALABLU,ALABLS,ALABLD + ,TITLU,TITLS,TITLD + ,TITGU,TITGS,TITGD + ,ATHKU,ATHKS,ATHKD + ,ABINU,ABINS,ABIND INTEGER ITICKN + ,ISMODU,ISMODS,ISMODD, ISMODN + ,ISCALN + ,ILABLU,ILABLS,ILABLD, ILABLN + ,ICOMMN,IDRWN,IPOSN + ,ITITLN + ,ICOLU,ICOLS,ICOLD, ICOLN + ,ITHKN + ,IFNTU,IFNTS,IFNTD, IFNTN + ,INTPU,INTPS,INTPD, INEVU,INEVS,INEVD + ,IBINN LOGICAL + QFRAMU,QFRAMS,QFRAMD + ,QTICKU,QTICKS,QTICKD + ,QSCALU,QSCALS,QSCALD + ,QLABLU,QLABLS,QLABLD + ,QTITLU,QTITLS,QTITLD C COMMON/M9HPJC/ C Frame around plot + QFRAMU(10,3),QFRAMS(10,3),QFRAMD(10,3) C TICK NUMBERS, SPACING, LIMITS AND OPTIONS 1 ,TICKU(10,3),TICKS(10,3),TICKD(10,3) 1 ,QTICKU(10,3),QTICKS(10,3),QTICKD(10,3) ,ITICKN(10) C SCALE POSITION AND TEXT SIZE AND OPTIONS 1 ,ISMODU(3),ISMODS(3),ISMODD(3) ,ISMODN(1) 1 ,SCALU(10,3),SCALS(10,3),SCALD(10,3) 1 ,QSCALU(10,3),QSCALS(10,3),QSCALD(10,3) ,ISCALN(10) C AXIS LABEL, POSITION SIZE AND OPTIONS 1 ,ILABLU(3),ILABLS(3),ILABLD(3) + ,ALABLU(10,3),ALABLS(10,3),ALABLD(10,3) 1 ,QLABLU(10,3),QLABLS(10,3),QLABLD(10,3) ,ILABLN(10) C Type of COMMENT and KEY parameters, drawing parameters C Title position and options 1 ,ICOMMN(12), IDRWN(10,5), IPOSN(10) + ,TITLU(10),TITLS(10),TITLD(10) + ,TITGU(10),TITGS(10),TITGD(10) 1 ,QTITLU(10),QTITLS(10),QTITLD(10) ,ITITLN(10) C COLOUR NUMBER 1 ,ICOLU(20),ICOLS(20),ICOLD(20) ,ICOLN(20) C LINE THICKNESSES 1 ,ATHKU(10),ATHKS(10),ATHKD(10) ,ITHKN(10) C Fonts 1 ,IFNTU(10),IFNTS(10),IFNTD(10) ,IFNTN(10) C Ntuple parameters and event numbers 1 ,INTPU(9),INTPS(9),INTPD(9) ,INEVU(9),INEVS(9),INEVD(9) C Bin shrink factor and offset + ,ABINU(10),ABINS(10),ABIND(10) ,IBINN(10) * * Array elements for colour * integer mcol_all,mcol_sym + ,mcol_bgd,mcol_on,mcol_off,mcol_def,mcol_rep common /m9hpjc2/ mcol_all, mcol_sym + ,mcol_bgd,mcol_on,mcol_off,mcol_def,mcol_rep C CHARACTER*20 1 TSIZEN,TMRGN,THSZEN,TLEGN 1 ,TLIMN,TTICKN,TSMODN,TSCALN,TLABLN,TTITLN,TCOMMN,TDRWN,TPOSN 1 ,TCOLN,TTHKN,TFNTN,TBINN CHARACTER*80 1 TLABLU,TLABLS,TLABLD C COMMON/M9HPJD/ C NAMES FOR OVERALL PICTURE SIZE, MARGIN AND PLOT SIZE 1 TSIZEN(2) ,TMRGN(2) ,THSZEN(2) C NAMES FOR LEGO PLOT ANGLES, LIMITS AND TICK PARAMETERS 1 ,TLEGN(10) ,TLIMN(10) ,TTICKN(10) C NAMES FOR SCALE PARAMETERS, LABEL PARAMETERS AND TITLE PARAMETER 1 ,TSMODN(1) ,TSCALN(10) ,TLABLN(10) ,TTITLN(10) C Names for COMMENT and KEY parameters, drawing parameters C colours and line thicknesses, fonts 1 ,TCOMMN(12), TDRWN(10,5), TPOSN(10) + ,TCOLN(20), TTHKN(10), TFNTN(10) C Bin shrink factor and offset + ,TBINN(10) C TEXT FOR AXIS LABELS 1 ,TLABLU(3), TLABLS(3), TLABLD(3) C INTEGER NHPLT,IPLTIA,IPLTIB,IPLTSY,IPLTHA,IPLTPA,IPLTCO + ,IPLTFL,IPLTCL,IPLTLG INTEGER IZEROP,IGRIDP,IPWNDP + ,ISMODP,ILABLP + ,NPLTCM,IPLTCM,NPLTKY,IPLTKY,LPLTKY + ,INTPP,INEVP + ,ICOLP,IFNTP REAL ALEGP,AMRGP,WMRGP,HSZEP,WSZEP + ,ALIMP + ,TSZEP + ,TICKP,SCALP,ALABLP + ,RPLTCM,RPLTKY,TITLP,TITGP + ,ATHKP,ABINP LOGICAL QLIMCP,QFRAMP,QTICKP,QSCALP,QLABLP,QTITLP,QZEROP C COMMON/M9HPJE/NHPLT C PLOT IDENTIFIERS 1 ,IPLTIA(MHPLT),IPLTIB(MHPLT) C SYMBOL, HATCH, PATTERN, COLOUR + ,IPLTSY(MHPLT) ,IPLTHA(MHPLT) ,IPLTPA(MHPLT) ,IPLTCO(3,MHPLT) C FLAG FOR TYPE, CLEAR SCREEN BEFORE PLOTTING OR NOT, LEGO FLAG 1 ,IPLTFL(MHPLT) ,IPLTCL(MHPLT) ,IPLTLG(MHPLT) C LEGO PLOT ANGLES 1 ,ALEGP(10,MHPLT) C MARGIN SIZE AND PLOT SIZE 1 ,AMRGP(2,MHPLT),WMRGP(2,MHPLT) ,HSZEP(2,MHPLT),WSZEP(2,MHPLT) C PLOT LIMITS 1 ,ALIMP(2,3,MHPLT),QLIMCP(3,MHPLT) C LINE AT X OR Y = 0 WITH SYMBOL + ,QZEROP(2,MHPLT) ,IZEROP(2,MHPLT) C Draw a grid - 0 means no grid, otherwise it gives the symbol to use + ,IGRIDP(2,3,MHPLT) C TEXT SIZES, WINDOW NUMBER, FRAME OR NOT 1 ,TSZEP(10,MHPLT) ,IPWNDP(2,MHPLT) ,QFRAMP(10,3,MHPLT) C TICK NUMBERS, SPACING LIMITS AND OPTIONS 1 ,TICKP(10,3,MHPLT) ,QTICKP(10,3,MHPLT) C SCALE POSITION, TEXT SIZE AND OPTIONS 1 ,ISMODP(3,MHPLT) ,SCALP(10,3,MHPLT) ,QSCALP(10,3,MHPLT) C AXIS LABEL, POSITION, SIZE AND OPTIONS 1 ,ILABLP(3,MHPLT) ,ALABLP(10,3,MHPLT) ,QLABLP(10,3,MHPLT) C COMMENTS 1 ,NPLTCM(MHPLT),IPLTCM(MCPLT,MHPLT),RPLTCM(11,MCPLT,MHPLT) C KEYS 1 ,NPLTKY(MHPLT),IPLTKY(MCPLT,MHPLT),LPLTKY(MCPLT,MHPLT) 1 ,RPLTKY(11,MCPLT,MHPLT) C TITLE POSITION AND OPTIONS 1 ,TITLP(10,MHPLT),TITGP(10,MHPLT),QTITLP(10,MHPLT) + ,INTPP(9,MHPLT),INEVP(9,MHPLT) C Colours, line thicknesses and fonts 1 ,ICOLP(20,MHPLT) ,ATHKP(10,MHPLT), IFNTP(10,MHPLT) C Bin shrink and offset factors + ,ABINP(10,MHPLT) C C LINES, ARROWS ETC C INTEGER NDRWLN,IDRWTP REAL RDRWPM,XDRWPT,YDRWPT COMMON/M9HPJF/ 1 NDRWLN,IDRWTP(MCLIN) ,RDRWPM(20,MCLIN) 1 ,XDRWPT(MCPNT,MCLIN),YDRWPT(MCPNT,MCLIN) C CHARACTER*80 TLABLP,TPLTCM,TPLTKY COMMON/M9HPJG/ C AXIS LABELS 1 TLABLP(3,MHPLT) C COMMENTS 1 ,TPLTCM(MCPLT,MHPLT) C KEYS 1 ,TPLTKY(MCPLT,MHPLT) C INTEGER NSHEAD,NSID,NSFOOT LOGICAL QSTEXT,QTUSER,QTGLBL,QSBOX,QWIND 1 ,QDFIT,QLEGO,QDFUN,QSNULL,QPIPLT,QASCAL,QATRIM C COMMON/M9HPJH/ C SHOW HEADER TEXT IN DISPLAY ON SCREEN 1 QSTEXT C SHOW HEADER TEXT IN DISPLAY ANYWHERE 1 ,NSHEAD C SHOW FILENAME AND HISTOGRAM NUMBERS 1 ,NSID C Show footer in a picture + ,NSFOOT C USE THE USER TITLE OR NOT 1 ,QTUSER C Put on a global title 1 ,QTGLBL C DRAW A BOX AROUND THE WHOLE PLOT 1 ,QSBOX C WINDOWING ON OR OFF 1 ,QWIND C LAST PICTURE WAS A DISPLAY OR NOT 1 ,QDFIT C LAST PICTURE WAS A LEGO PLOT OR NOT 1 ,QLEGO C Last picture was plotting a function 1 ,QDFUN C SHOW POINTS WITH ZERO ERRORS 1 ,QSNULL C Use pi as a symbol in the scale if possible 1 ,QPIPLT C Automatically rescale text sizes when windowing 1 ,QASCAL C Trim off the last number when windowing with zero spacing 1 ,QATRIM C INTEGER IWIND REAL WSPACE COMMON/M9HPJI/ 1 IWIND(2),WSPACE(2) C CHARACTER*80 TITUSR,TSFOOT COMMON/M9HPJJ/TITUSR,TSFOOT C REAL XLO,XHI,YLO,YHI,ZLO,ZHI + ,XPLO,XPHI,YPLO,YPHI + ,ZLLO COMMON/M9HPJK/XLO,XHI,YLO,YHI,ZLO,ZHI + ,XPLO,XPHI,YPLO,YPHI + ,ZLLO C C SIZES FOR THE DISPLAY C REAL FSIZE,PSIZE,FSIZED + ,FHSZE,PHSZE,FHSZED + ,FAMRG,PAMRG,FAMRGD + ,WPSPAC INTEGER NFSID,NPSID + ,IPWIND LOGICAL QFSTIT,QPSTIT,QFWIND,QPWIND COMMON/M9HPJL/FSIZE(2),PSIZE(2),FSIZED(2) + ,FHSZE(2),PHSZE(2),FHSZED(2) + ,FAMRG(2),PAMRG(2),FAMRGD(2) + ,NFSID,NPSID,QFSTIT,QPSTIT,QFWIND,QPWIND + ,IPWIND(2),WPSPAC(2) C C Parameters for IGTABL C INTEGER MIGPAR PARAMETER (MIGPAR = 100) INTEGER NIGPARU,NIGPARS,NIGPARD,NIGPARP + ,LIGOPTU,LIGOPTS,LIGOPTD,LIGOPTP REAL AIGPARU,AIGPARS,AIGPARD,AIGPARP + ,AJGPAR COMMON/M9HPJM/ NIGPARU,NIGPARS,NIGPARD,NIGPARP(MHPLT) + ,AIGPARU(MIGPAR),AIGPARS(MIGPAR),AIGPARD(MIGPAR) + ,AIGPARP(MIGPAR,MHPLT) + ,AJGPAR(MIGPAR) + ,LIGOPTU,LIGOPTS,LIGOPTD,LIGOPTP(MHPLT) C CHARACTER*10 TIGOPTU,TIGOPTS,TIGOPTD,TIGOPTP COMMON/M9HPJN/ TIGOPTU,TIGOPTS,TIGOPTD,TIGOPTP(MHPLT) +DECK,mninf. +KEEP,MNINF. C C Information on the last plot for which MN_HGT was called C INTEGER IDAC,IDBC,NHC,NPTRH,NPTRD,NDIM,NWPPT,NPNT,NBPPT,NWDAT + ,NHDATE,NHTIME,NSDATE,NSTIME,NTMODE + ,IDBIN REAL EDENT,EDLO,EDHI,ADLO,ADHI,AMEAN,ASIG,ACONT COMMON/M9INF/IDAC,IDBC,NHC,NPTRH,NPTRD,NDIM,NWPPT,NPNT,NBPPT,NWDAT + ,NHDATE,NHTIME,NSDATE,NSTIME,NTMODE + ,EDENT,EDLO,EDHI,IDBIN(MDIMMX),ADLO(MDIMMX),ADHI(MDIMMX) + ,AMEAN(MDIMMX),ASIG(MDIMMX),ACONT(3**3) +DECK,mnleg. +KEEP,MNLEG. * * Common Information to pass from lego/surface plots to co-ordinate * transformations * REAL COSA,SINA COMMON /M9LEG2/ COSA,SINA +DECK,mnlst. +KEEP,MNLST. C C Last plot for which AMNE,AMNX, etc. have been called C INTEGER NHALST,IDAL,IDBL,NPTRHL,NPTRDL,NPNTL + ,NWPPTL,NDIML,NBPPTL,NWDATL REAL EDENTL,EDLOL,EDHIL logical qcwntpl INTEGER IDBINL REAL ADLOL,ADHIL COMMON/M9LST/NHALST,IDAL,IDBL,NPTRHL,NPTRDL,NPNTL + ,NWPPTL,NDIML,NBPPTL,NWDATL,EDENTL,EDLOL,EDHIL,qcwntpl + ,IDBINL(MDIMMX),ADLOL(MDIMMX),ADHIL(MDIMMX) +DECK,mnluj. +KEEP,MNLUJ. integer irun_lu,ievt_lu,lmod_pi,nres_lu,lmod_1p real xpar_pi,resmas * common/m9luj1/irun_lu,ievt_lu,lmod_pi,xpar_pi 1 ,nres_lu,resmas(13),lmod_1p * character resnam*10 common/m9luj2/ resnam(13) +DECK,mnlun. +KEEP,MNLUN. C INTEGER LUNTTI, LUNTTO, LUNLPT, LUNERR, LUNTMP, LUNPUN C COMMON /M9LUNA/ LUNTTI, LUNTTO, LUNLPT, LUNERR, LUNTMP, LUNPUN C CHARACTER*255 TXTERR,TXTMES COMMON /M9LUNB/ TXTERR,TXTMES +DECK,mnpar. +KEEP,MNSIZ,IF=VMS. PARAMETER (MHSTMX=500,MHSTWD=500 000) PARAMETER (MHBKWD=500 000, MHGZWD=10 000) +KEEP,MNSIZ,IF=UNIX,IF=CLEO. PARAMETER (MHSTMX=2000,MHSTWD=4 000 000) PARAMETER (MHBKWD=4 000 000, MHGZWD=10 000) +KEEP,MNSIZ,IF=UNIX,IF=-CLEO. PARAMETER (MHSTMX=1000,MHSTWD=1 500 000) PARAMETER (MHBKWD=1 500 000, MHGZWD=10 000) +KEEP,MNPAR. C C MHSTMX = Maximum number of plots in memory C MHSTWD = Space in memory for plots C MDIMMX = Maximum number of Ntuple dimensions C MCUTMX = Maximum number of cuts C MHBKWD = Space in memory for HBOOK plots C INTEGER MHSTMX,MHSTWD,MDIMMX,MCUTMX,MNBLOK INTEGER MHBKWD,MHGZWD C +CDE,MNSIZ. C PARAMETER (MDIMMX=1024) PARAMETER (MCUTMX=100) PARAMETER (MNBLOK=1024) C C MINMAX Maximum number of MINUIT parameters C MFITMX Maximum number of plots to fit simultaneously C MFITWD Maximum number of words for plots being fit C MFUNMX Maximum number of function used to fit with C MFNDMX Maximum number of defined functions C MFNPAR Maximum number of parameters in a function C MFNHMX Maximum number of histograms used as functions C MFNPMX Maximum number of points in histograms used as functions C INTEGER MINMAX,MFITMX,MFITWD,MFUNMX,MFNDMX,MFNPAR + ,MFNHMX,MFNPMX PARAMETER (MINMAX=100) PARAMETER (MFITMX=5, MFITWD=50000) PARAMETER (MFUNMX=20, MFNDMX=50, MFNPAR=20) PARAMETER (MFNHMX=10, MFNPMX=1000) C C Parameters for the pictures C C MHPLT Maximum number of plots in a picture C MCPLT Maximum number of comments/keys C MCPNT Maximum number of points/lines in a shape C MCLIN Maximum number of shapes to draw C INTEGER MHPLT,MCPLT,MCPNT,MCLIN PARAMETER(MHPLT= 200,MCPLT= 100,MCPNT=200,MCLIN= 2000) +DECK,mnpij. +KEEP,MNPIJ. REAL PI,TWOPI,PIHALF,RDEG,DRAD PARAMETER (PI = 3.1415927) PARAMETER (TWOPI = 6.2831853) PARAMETER (PIHALF = 1.5707963) PARAMETER (RDEG = 57.29578) PARAMETER (DRAD = 0.0174532) +DECK,mnplt. +KEEP,MNPLT. C C Number of points for drawing functions C INTEGER NFPNT COMMON /M9PLT/ NFPNT +DECK,mnprj. +KEEP,MNPRJ. C Variables needed for passing to parsing when parsing cuts C QPROJ In the process of doing a projection. Ntuple variable names are C allowed when parsing expressions. C NHP The Ntuple number (position in RDAT) LOGICAL QPROJ INTEGER NHP COMMON/M9PRJ/QPROJ,NHP C C Storage of parsed expressions for variables C MVEXPR is maximum number of expressions C MVESUB is the maximum depth of each C LVEXPR is the depth of the parsed expression C IVETYP,IVETP,IVETF,IVETV are arrays for the expressions C TVEXPR is the expression C INTEGER MVEXPR,MVESUB PARAMETER (MVEXPR = 5, MVESUB = 50) C INTEGER NVEXPR,LVEXPR,IVETYP,IVETP,IVETF,IVETV COMMON/MNPR2/NVEXPR,LVEXPR(MVEXPR) + ,IVETYP(MVESUB,MVEXPR),IVETP(MVESUB,MVEXPR) + ,IVETF(MVESUB,MVEXPR),IVETV(10,MVESUB,MVEXPR) C CHARACTER*40 TVEXPR COMMON/MNPR3/TVEXPR(MVEXPR) C INTEGER MWEXPR,MWESUB PARAMETER (MWEXPR = 2, MWESUB = 20) C INTEGER NWEXPR,LWEXPR,IWETYP,IWETP,IWETF,IWETV COMMON/MNPR4/NWEXPR,LWEXPR(MWEXPR) + ,IWETYP(MWESUB,MWEXPR),IWETP(MWESUB,MWEXPR) + ,IWETF(MWESUB,MWEXPR),IWETV(10,MWESUB,MWEXPR) C CHARACTER*40 TWEXPR COMMON/MNPR5/TWEXPR(MWEXPR) +DECK,mnprs. +KEEP,MNPRS. C C MREGUS is the number of user registers C MREGIS is the total number of registers C MVAR0 is the start of variables - 1 C MTCLC is the number of operations in the parser C MNTP0 is the command number for Ntuple variable - 1 C INTEGER MREGUS,MREGIS,MVAR0,MNTP0,MTCLC PARAMETER (MREGUS = 99) PARAMETER (MREGIS = 500) PARAMETER (MVAR0 = 300) PARAMETER (MNTP0 = 1000) PARAMETER (MTCLC = 100) C C MPRSE are the number of standard variable names C INTEGER MPRSE,MDEPI,MVARBL,MCALC,MDEPO,MREG1 INTEGER MOP PARAMETER (MPRSE = 29, MDEPI = 16, MVARBL=200) PARAMETER (MOP = 10) PARAMETER (MCALC = MPRSE + MDEPI + MVARBL + 1) PARAMETER (MDEPO = MDEPI + MVARBL + 1) PARAMETER (MREG1 = MPRSE + 1) C CHARACTER*1 BLANK PARAMETER (BLANK = ' ') C C NVARBL is the number of variables defined C MP_REG is the position of register (R) in DPINAM C MP_NTP is the position of ntuple contents (X) in DPINAM C REAL REGIS COMMON/MNREGI/REGIS(0:MREGIS) C INTEGER NVARBL,MP_REG,MP_NTP COMMON/M9REG1/NVARBL,MP_REG,MP_NTP C C PRSNAM contains intrinsic functions - SIN, COS TAN etc. C DPINAM contains standard variables, R,P,X etc. C VARNAM contains extra variable names C CHARACTER*8 PRSNAM,DPINAM,VARNAM,TDUMMY CHARACTER*8 CLCNAM(MCALC),DEPNAM(MDEPO) COMMON/M9REG2/PRSNAM(MPRSE),DPINAM(MDEPI),VARNAM(MVARBL),TDUMMY EQUIVALENCE(CLCNAM(1),PRSNAM(1)) EQUIVALENCE(DEPNAM(1),DPINAM(1)) C INTEGER ISTYP,ISTP,ISTF,ISTV COMMON/M9PRS1/ISTYP(MTCLC),ISTP(MTCLC),ISTF(MTCLC),ISTV(10,MTCLC) C INTEGER NCOMMA,NREMN,NOP,NBINRY,IOP,LEVEL + ,LSTOP,LSTLEV,LSTFUN,LSTVAR COMMON/M9PRS2/ C # OF COMMAS * NCOMMA, C # OF UNPAIRED OPERANDS * NREMN, C LENGTH OF OPERATOR LIST * NOP, C # BINARY OPERATORS * NBINRY, C CURRENT OPERATOR * IOP, C PARENTHESIS LEVEL * LEVEL, C LIST OF OPERATORS * LSTOP(MOP), C LIST OF OPERATOR LEVELS * LSTLEV(MOP), C LIST OF FUNCTION NUMBERS * LSTFUN(MOP), C LIST OF VARIABLE NUMBERS * LSTVAR(10,MOP) +DECK,mnscr. +KEEP,MNSCR. REAL SCRATCH COMMON/M9SCR/SCRATCH(101000) +DECK,mnseg. +KEEP,MNSEG. C C Common block containing variables associated with segments C LOGICAL QSGOPEN INTEGER NSGOPEN COMMON/M9SEG/QSGOPEN,NSGOPEN +DECK,mntim. +KEEP, MNTIM. C C Parameters needed for plotting vs. time C INTEGER NMTIME,NDTREF,NTMREF COMMON/M9TIM1/ NMTIME,NDTREF,NTMREF C INTEGER MTIM PARAMETER (MTIM = 5) CHARACTER*10 TIMNAM COMMON/M9TIM2/ TIMNAM(MTIM) +DECK,mntmp. +KEEP,MNTMP. INTEGER MXUBIN PARAMETER (MXUBIN=10) LOGICAL QMNOPN,QMNLOC INTEGER LUNMNU COMMON/M9TMP1/QMNOPN,QMNLOC,LUNMNU INTEGER NUBIN,IDTA,IDTB,IPTR,IDWR REAL RTMP COMMON/M9TMP2/NUBIN,IDTA(MXUBIN),IDTB(MXUBIN),IPTR(MXUBIN) 1 ,IDWR(MXUBIN) 1 ,RTMP(MNBLOK+MDIMMX,MXUBIN) CHARACTER*32 TNDEF,TNNTP COMMON/M9TMP3/TNDEF(MDIMMX),TNNTP(MDIMMX) +DECK,mntpl. +KEEP,MNTPL. * * Contains information on the Ntuple for the COMIS routine called when * scanning it. * INTEGER IDNEVT REAL VIDN1,VIDN2,VIDN3,RVAL COMMON/PAWIDN/IDNEVT,VIDN1,VIDN2,VIDN3,RVAL(MDIMMX) * INTEGER ID,NVAR REAL RLIM COMMON/MNTPL1/ID,NVAR,RLIM(2*MDIMMX) * CHARACTER*80 TITLE CHARACTER*32 TAGS COMMON/MNTPL2/TITLE,TAGS(MDIMMX) +DECK,mntyq. +KEEP,MNTYQ. INTEGER MOPR,MOPRBF,MTCMD,MTDEP,MTPARM,MFORDP,MALIAS,MXIFLV PARAMETER (MOPR=150,MOPRBF=1500) PARAMETER (MTCMD=100,MTDEP=10,MTPARM=9,MFORDP=10,MALIAS=100) PARAMETER (MXIFLV = 20) C C QECHO Echo commands to the terminal when reading from a file C QALOG Log all commands in a file MN_LOG.LOG C QMANUAL Add ## after the prompt when echoing, which is used to C recognize a prompt when making demonstration files C LOGICAL QTREAD,QTLOOP,QECHO,QDSKIP,QALOG,QALIAS,QMANUAL INTEGER NTCMD,NTDEP,LUNCMD,LUNJNK,LUNLOG 1 ,IUNCMD,IUNREC 1 ,NPRCMD,NPMCMD,IPMCMD 1 ,IP1CMD,IP2CMD,NOPR,IOPRP1,IOPRP2 1 ,NFORDP,IFORBG,IFORVL,IFORMX,IFORST + ,NALIAS,LALCMD COMMON /M9TYQ1/ QTREAD,QTLOOP,NTCMD,NTDEP,LUNCMD,LUNJNK,LUNLOG 1 ,IUNCMD(MTDEP),IUNREC(MTDEP) 1 ,NPRCMD,NPMCMD(MTDEP),IPMCMD(MTPARM,MTDEP) 2 ,IP1CMD(MTDEP),IP2CMD(MTDEP) 3 ,NOPR,IOPRP1(MOPR),IOPRP2(MOPR) 4 ,NFORDP(MTDEP),IFORBG(MFORDP,MTDEP),IFORVL(MFORDP,MTDEP) 4 ,IFORMX(MFORDP,MTDEP),IFORST(MFORDP,MTDEP) + ,QECHO,QDSKIP,QALOG,QMANUAL + ,QALIAS,NALIAS,LALCMD(MALIAS) C C Variables used for IF conditional block manipulation. C LOGICAL QIF, QCOND, QCONDI INTEGER IIFLV, IFIIFL COMMON /M9TYQ3/ QIF(MTDEP) + ,QCOND(MXIFLV,MTDEP), QCONDI(MXIFLV,MTDEP) + ,IIFLV(MTDEP), IFIIFL(MTDEP) C CHARACTER*80 TPRCMD CHARACTER*255 TXTCMD,TOPRBF,STRING CHARACTER*80 TPMCMD CHARACTER*10 OPRNAM CHARACTER*1 TFORNM CHARACTER*20 TALIAS CHARACTER*80 TALCMD COMMON /M9TYQ2/ TPRCMD,TXTCMD(MTCMD),TPMCMD(MTPARM,MTDEP) 1 ,STRING 2 ,OPRNAM(MOPR),TOPRBF(MOPRBF) 3 ,TFORNM(MFORDP,MTDEP) + ,TALIAS(MALIAS),TALCMD(MALIAS) C C Stack of commands to execute when starting MINUIT C INTEGER NFSTKD,NFSTKU COMMON /M9TYQ4/ NFSTKD,NFSTKU C INTEGER MFSTK PARAMETER (MFSTK = 10) CHARACTER*80 TFSTK COMMON /M9TYQ5/ TFSTK(MFSTK) +DECK,mnusr. +KEEP,MNUSR. C C COMMON BLOCK WITH ORTHOGONALITY LIMITS AND BIN WIDTHS C FOR THE PLOT YOU ARE FITTING C XMINNM,XMAXNM are the orthogonality limits for the x axis C YMINNM,YMAXNM are the orthogonality limits for the y axis C XBINNM is the bin width for the x axis C YBINNM is the bin width for the y axis C REAL XMINNM,XMAXNM,XBINNM,YMINNM,YMAXNM,YBINNM COMMON/MNUSR/XMINNM,XMAXNM,XBINNM,YMINNM,YMAXNM,YBINNM +DECK,quest. +KEEP,QUEST. INTEGER IQUEST COMMON/QUEST/IQUEST(100) REAL RQUEST(100) EQUIVALENCE(IQUEST(1),RQUEST(1)) +DECK,slate. +KEEP,SLATE. * * Slate common block used by CHPACK routines * integer nd,ne,nf,ng,num,dummy COMMON /SLATE/ ND,NE,NF,NG,NUM(2),DUMMY(34) +DECK,mntimd. +KEEP, MNTIMD. INTEGER MXSEC,MXMIN,MXHOU,MXDAY,MXMON PARAMETER (MXSEC=61, MXMIN=61, MXHOU=25, MXDAY=32, MXMON=13) integer mdayy parameter (mdayy = 100) INTEGER IDAYY(mdayy), IDAYM(12,2) SAVE IDAYY, IDAYM DATA IDAYY / + 366, 731, 1096, 1461, 1827, + 2192, 2557, 2922, 3288, 3653, + 4018, 4383, 4749, 5114, 5479, + 5844, 6210, 6575, 6940, 7305, + 7671, 8036, 8401, 8766, 9132, + 9497, 9862,10227,10593,10958, + 11323,11688,12054,12419,12784, + 13149,13515,13880,14245,14610, + 14976,15341,15706,16071,16437, + 16802,17167,17532,17898,18263, + 18628,18993,19359,19724,20089, + 20454,20820,21185,21550,21915, + 22281,22646,23011,23376,23742, + 24107,24472,24837,25203,25568, + 25933,26298,26664,27029,27394, + 27759,28125,28490,28855,29220, + 29586,29951,30316,30681,31047, + 31412,31777,32142,32508,32873, + 33238,33603,33969,34334,34699, + 35064,35430,35795,36160,36525/ DATA IDAYM / 0, 31, 59, 90, 120, 151, 181, 212, 243, 1 273, 304, 334, 0, 31, 60, 91, 121, 152, 2 182, 213, 244, 274, 305, 335/ +DECK,mnpltd. +KEEP,MNPLTD. C C Tick and scale limit parameters C INTEGER NGSCAL PARAMETER (NGSCAL=19) REAL YGSCAL(NGSCAL) INTEGER IGSCAL(NGSCAL),ITSCAL(NGSCAL),IBSCAL(NGSCAL) DATA YGSCAL/ 0.,10.,12.,15.,16.,18.,20.,24.,25.,30. 1 ,36.,40.,50.,60.,70.,75.,80.,90.,100./ DATA IGSCAL/ 0, 10, 12, 15, 16, 18, 20, 24, 25, 30 1 ,36, 40, 50, 60, 70, 75, 80, 90, 100/ DATA ITSCAL/ 0, 20, 12, 15, 16, 16, 20, 24, 25, 15 1 ,16, 16, 25, 12, 14, 15, 16, 18, 20/ DATA IBSCAL/ 0, 5, 2, 5, 4, 4, 5, 4, 5, 5 1 , 4, 4, 5, 2, 4, 4, 4, 4, 5/ +DECK,MNCHAR. +KEEP,MNCHAR. * * Special characters used in making the manual * CHARACTER*1 TAB,BSL COMMON /M9CHAR/ TAB,BSL +PATCH,HKUIP,T=XCC, INCL. +DECK,hkuip_93d,IF=93D. +KEEP,KHAIX370 #ifndef AIX370 # define AIX370 #endif +KEEP,KHAPOFTN #ifndef APOLLO_FTN # define APOLLO_FTN #endif +KEEP,KHIBMVM #ifndef IBMVM # define IBMVM #endif +KEEP,KHIBMMVS #ifndef IBMMVS # define IBMMVS #endif +KEEP,KHNEWLIB #ifndef NEWLIB # define NEWLIB #endif +KEEP,KUIP_H /* kuip.h: system dependent defines */ /* update version if structures have changed */ #define KUIP_VERSION 921023 /* identify system if not possible from preprocessor defines */ +SEQ,KHAIX370,IF=AIX370 +SEQ,KHAPOFTN,IF=APOFTN +SEQ,KHIBMVM ,IF=IBMVM +SEQ,KHIBMMVS,IF=IBMMVS +SEQ,KHNEWLIB,IF=NEWLIB #ifdef AIX370 # define MACHINE_NAME "IBMAIX" # define UNIX # define F77_EXTERN_INDIRECT #endif #if defined(apollo) || defined(__apollo) # define MACHINE_NAME "APOLLO" # define APOLLO # define UNIX # include # include # include # include # include # include # ifdef APOLLO_FTN /* using /com/ftn instead of /bin/f77 */ # define F77_CHAR_LEN_IND short # define F77_EXTERN_LOWERCASE # endif # define F77_EXTERN_INDIRECT # define F77_COMMON(name) name __attribute((__section(name))) # ifndef EXTERN # define EXTERN /* essential for accessing COMMON blocks */ # endif # define FATAL_SIGFPE # define HAVE_MEMMOVE # define HAVE_STRCASECMP # define HAVE_STRDUP # define NO_DIRENT_H # define TERMIO_BSD /* for getline we must compile under bsd4.3 */ #endif #if defined(__convexc__) # define CONVEX # define MACHINE_NAME "CONVEX" # define UNIX # define HAVE_MEMMOVE # define HAVE_STRCASECMP # define HAVE_STRDUP # define MATCH_RE_COMP /* use re_comp/re_exec */ # define F77_BLOCK(name,NAME) F77_NAME(ConCat(_,name),NAME) #endif #ifdef CRAY # define MACHINE_NAME "CRAY" # define UNIX # include # define F77_EXTERN_UPPERCASE # define F77_CHAR_DSC_CRAY # ifndef EXTERN # define EXTERN /* essential for accessing COMMON blocks */ # endif # define HAVE_STRCASECMP # define HAVE_STRDUP # define NO_EDIT_SERVER #endif #if defined(hpux) || defined(__hpux) # define MACHINE_NAME "HPUX" # define HPUX # define UNIX # ifdef hpux /* cc -Ac */ # define NO_ANSI_CPP # define NO_PROTOTYPES # endif # ifndef _HPUX_SOURCE # define _HPUX_SOURCE # endif # define FATAL_SIGFPE /* needs f77 +T and ON REAL UNDERFLOW IGNORE */ # define HAVE_MEMMOVE # define HAVE_STRCASECMP # define HAVE_STRDUP # define HAVE_STRRSTR #endif #ifdef _IBMR2 # define IBMRT # define MACHINE_NAME "IBMRT" # define UNIX # define HAVE_MEMMOVE # define HAVE_STRCASECMP # define HAVE_STRDUP #endif #ifdef IBMVM # define ARG_STYLE_CMS # define MACHINE_NAME "IBM" # define OS_NAME "VM" # ifndef IBM370 # define IBM370 # endif #endif #ifdef IBMMVS # define MACHINE_NAME "IBMMVS" # define OS_NAME "MVS" # ifndef IBM370 # define IBM370 # endif #endif #ifdef IBM370 # define F77_CHAR_LEN_IND int /* each parameter has a length argument ! */ # define F77_XXXX_ARG_LEN(x) F77_CHAR_ARG_LEN(x) # define F77_EXTERN_INDIRECT # define F77_EXTERN_UPPERCASE # define NO_FCNTL_H # define NO_UNISTD_H # define SIGNAL_V7 #endif #ifdef linux # define LINUX # define MACHINE_NAME "LINUX" # define UNIX # define HAVE_MEMMOVE # define HAVE_STRCASECMP # define HAVE_STRDUP #endif #ifdef MSDOS # define MACHINE_NAME "MSDOS" # define UNIX # define NO_EDIT_SERVER # define NO_SOCKET_H # define NO_SYS_TIME_H # define SIGNAL_V7 #endif #ifdef WIN32 # define WINNT # define MACHINE_NAME "WNT" # define UNIX # define MSDOS # include # include # include # define text_mode__() # define NO_EDIT_SERVER # define NO_SOCKET_H # define NO_SYS_TIME_H # define NO_UNISTD_H # define SIGNAL_V7 #endif #ifdef NeXT # define MACHINE_NAME "NEXT" # define UNIX # define getcwd(path,maxlen) getwd(path) # define F77_BLOCK(lc,uc) lc # define F77_EXTERN_INDIRECT /* each parameter has a length argument ! */ # define F77_XXXX_ARG_LEN(x) F77_CHAR_ARG_LEN(x) # define F77_XXXX_USE_LEN(x) ,286716 /* don't know if value matters */ # define HAVE_MEMMOVE # define HAVE_VFORK # define MATCH_RE_COMP /* use re_comp/re_exec */ # define NO_DIRENT_H # define NO_UNISTD_H # define SIGNAL_BSD # define TERMIO_BSD #endif #ifdef __osf__ # define UNIX # ifdef __alpha # define ALPHA # define MACHINE_NAME "ALPHA" # endif # define const /* wrong prototype for strdup() in string.h */ # define HAVE_MEMMOVE # define HAVE_STRCASECMP # define HAVE_STRDUP #endif #if defined(sgi) || defined(__sgi) # define MACHINE_NAME "SGI" # define SGI # define UNIX # ifndef __sgi /* Irix 3 */ # define NO_ANSI_CPP # define NO_PROTOTYPES # endif # define HAVE_MEMMOVE # define HAVE_STRCASECMP # define HAVE_STRDUP #endif #if defined(sun) || defined(__sun) # define MACHINE_NAME "SUN" # define SUN # define UNIX # ifndef __STDC__ /* cc vs. acc */ # define NO_ANSI_CPP # define NO_PROTOTYPES # else # define const /* wrong prototype for strdup() in string.h */ # endif # define HAVE_STRCASECMP # define HAVE_STRDUP # define HAVE_VFORK # include # define MATCH_RE_COMP /* use re_comp/re_exec */ #endif #if defined(ultrix) || defined(__ultrix) # define MACHINE_NAME "DECS" # define ULTRIX # define UNIX # ifndef __ultrix /* cc vs. c89 */ # define NO_ANSI_CPP # define NO_PROTOTYPES # endif # define HAVE_MEMMOVE # define HAVE_STRCASECMP # define HAVE_VFORK # define TERMIO_BSD #endif #ifdef vms # define OS_NAME "VMS" # ifdef __ALPHA # define ALPHA # define MACHINE_NAME "ALPHA" # pragma extern_model common_block # include /* inside descrip.h on VAX */ # else # define MACHINE_NAME "VAX" # define NO_ANSI_CPP # define raise gsignal /* raise() not in library ? */ # endif # include # include # include /* lib$... prototypes */ # include # include # include # include # include # include # include # include /* sys$... prototypes */ # include # include # include # ifndef R_OK /* no access() modes in unixio.h on VAX/VMS */ # define F_OK 0 # define X_OK 1 # define W_OK 2 # define R_OK 4 # endif # define ARG_STYLE_VMS # define F77_CHAR_DSC_VMS # define F77_EXTERN_LOWERCASE # define HAVE_MEMMOVE # define HAVE_STAT_H # define HAVE_VFORK /* actually have only vfork */ # define NO_FCNTL_H # define NO_UNISTD_H # define SIGNAL_BSD # define sigmask(sig) (1L << (sig-1)) /* should be in signal.h */ # define USE_EDIT_SERVER /* only for TPU/DISPLAY=MOTIF */ #endif /* vms */ #include #include #include #ifndef NO_FCNTL_H #include #endif #include /* contains strtod() and strtol() on some systems */ #include #include #include #include #include #include #ifndef NO_UNISTD_H #include #endif #ifndef HAVE_VFORK # define vfork fork #endif #ifdef UNIX # define OS_NAME "UNIX" # include # include # ifndef NO_SYS_TIME_H # include /* struct timeval */ # endif # ifndef MSDOS # if !defined(TERMIO_BSD) && !defined(TERMIO_SYSV) # define TERMIO_POSIX # endif # include # ifndef NO_DIRENT_H /* POSIX opendir() */ # include # else /* BSD opendir() */ # include /* plus */ # define dirent direct /* struct dirent... */ # ifndef S_IRUSR # define S_IRUSR (S_IREAD) /* read permission, owner */ # define S_IWUSR (S_IWRITE) /* write permission, owner */ # define S_IXUSR (S_IEXEC) /* execute/search permission, owner */ # endif # endif # endif # define HAVE_STAT_H # ifndef NO_EDIT_SERVER # define USE_EDIT_SERVER # ifndef F_LOCK /* BSD file locking */ # include # define lockf(fd,op,offs) flock(fd,op) # define F_LOCK LOCK_EX # define F_ULOCK LOCK_UN # endif # endif #endif #ifdef SUN # ifndef CLOCKS_PER_SEC # define CLOCKS_PER_SEC 1000000 /* missing in time.h */ # define difftime(t1,t0) ((double)(t1-t0)) # define raise(sig) kill(getpid(),sig) # endif #endif #ifndef CLOCKS_PER_SEC # define CLOCKS_PER_SEC 100 /* missing in VAX/VMS time.h */ #endif #ifdef HAVE_STAT_H # define KmTimeStamp struct stat # define get_stamp(path,stamp) stat(path,stamp) # define cmp_stamp(stamp1,stamp2) ((stamp2)->st_mtime == (stamp1)->st_mtime) #endif #ifndef KmTimeStamp # define KmTimeStamp int # define get_stamp(path,stamp) 0 # define cmp_stamp(stamp1,stamp2) 0 #endif #ifdef MATCH_RE_COMP extern char *re_comp(); extern int re_exec(); #else extern char *regcmp(); extern char *regex(); #endif /* command line arguments recognized by KUARGS */ #if !defined(ARG_STYLE_CMS) && !defined(ARG_STYLE_VMS) # define ARG_STYLE_UNIX #endif #ifndef MACHINE_NAME # define MACHINE_NAME "UNKNOWN" /* value returned by $MACHINE */ #endif #ifndef OS_NAME # define OS_NAME "UNKNOWN" /* value returned by $OS */ #endif /* #define EXTERN must be in one routine to allocate space for globals */ #ifndef EXTERN # define EXTERN extern #endif /* #define STATIC extern if debugger does not see static functions */ #ifndef STATIC # define STATIC static #endif #if defined(__GNUC__) || defined(__STDC__) # ifdef NO_ANSI_CPP # undef NO_ANSI_CPP # endif # ifdef NO_PROTOTYPES # undef NO_PROTOTYPES # endif #endif /* * Preprocessor syntax for token concatenation */ #ifndef NO_ANSI_CPP # define ConCat(con,cat) con##cat #else # define ConCat(con,cat) con/**/cat #endif /* * Prototyping for C functions */ #ifndef NO_PROTOTYPES # define C_PROTO_0(name) \ name(void) # define C_PROTO_1(name,arg1) \ name(arg1) # define C_PROTO_2(name,arg1,arg2) \ name(arg1,arg2) # define C_PROTO_3(name,arg1,arg2,arg3) \ name(arg1,arg2,arg3) # define C_PROTO_4(name,arg1,arg2,arg3,arg4) \ name(arg1,arg2,arg3,arg4) # define C_PROTO_5(name,arg1,arg2,arg3,arg4,arg5) \ name(arg1,arg2,arg3,arg4,arg5) # define C_PROTO_6(name,arg1,arg2,arg3,arg4,arg5,arg6) \ name(arg1,arg2,arg3,arg4,arg5,arg6) # define C_PROTO_7(name,arg1,arg2,arg3,arg4,arg5,arg6,arg7) \ name(arg1,arg2,arg3,arg4,arg5,arg6,arg7) # define C_PROTO_8(name,arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8) \ name(arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8) # define C_PROTO_9(name,arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8,arg9) \ name(arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8,arg9) # define C_PROTO_13(name,a1,a2,a3,a4,a5,a6,a7,a8,a9,b0,b1,b2,b3) \ name(a1,a2,a3,a4,a5,a6,a7,a8,a9,b0,b1,b2,b3) # define C_PROTO_16(name,a1,a2,a3,a4,a5,a6,a7,a8,a9,b0,b1,b2,b3,b4,b5,b6) \ name(a1,a2,a3,a4,a5,a6,a7,a8,a9,b0,b1,b2,b3,b4,b5,b6) # define C_PROTO_17(name,a1,a2,a3,a4,a5,a6,a7,a8,a9,b0,b1,b2,b3,b4,b5,b6,b7) \ name(a1,a2,a3,a4,a5,a6,a7,a8,a9,b0,b1,b2,b3,b4,b5,b6,b7) # define C_DECL_0(name) \ name() # define C_DECL_1(name,t1,p1) \ name(t1 p1) # define C_DECL_2(name,t1,p1,t2,p2) \ name(t1 p1,t2 p2) # define C_DECL_3(name,t1,p1,t2,p2,t3,p3) \ name(t1 p1,t2 p2,t3 p3) # define C_DECL_4(name,t1,p1,t2,p2,t3,p3,t4,p4) \ name(t1 p1,t2 p2,t3 p3,t4 p4) # define C_DECL_5(name,t1,p1,t2,p2,t3,p3,t4,p4,t5,p5) \ name(t1 p1,t2 p2,t3 p3,t4 p4,t5 p5) # define C_DECL_6(name,t1,p1,t2,p2,t3,p3,t4,p4,t5,p5,t6,p6) \ name(t1 p1,t2 p2,t3 p3,t4 p4,t5 p5,t6 p6) # define C_DECL_7(name,t1,p1,t2,p2,t3,p3,t4,p4,t5,p5,t6,p6,t7,p7) \ name(t1 p1,t2 p2,t3 p3,t4 p4,t5 p5,t6 p6,t7 p7) # define C_DECL_8(name,t1,p1,t2,p2,t3,p3,t4,p4,t5,p5,t6,p6,t7,p7,t8,p8) \ name(t1 p1,t2 p2,t3 p3,t4 p4,t5 p5,t6 p6,t7 p7,t8 p8) # define C_DECL_9(name,t1,p1,t2,p2,t3,p3,t4,p4,t5,p5,t6,p6,t7,p7,t8,p8,t9,p9)\ name(t1 p1,t2 p2,t3 p3,t4 p4,t5 p5,t6 p6,t7 p7,t8 p8,t9 p9) # define C_DECL_13(name,t1,p1,t2,p2,t3,p3,t4,p4,t5,p5,t6,p6,t7,p7,t8,p8,\ t9,p9,t10,p10,t11,p11,t12,p12,t13,p13) \ name(t1 p1,t2 p2,t3 p3,t4 p4,t5 p5,t6 p6,t7 p7,t8 p8,\ t9 p9,t10 p10,t11 p11,t12 p12,t13 p13) #else # define const # define C_PROTO_0(name) \ name() # define C_PROTO_1(name,arg1) \ name() # define C_PROTO_2(name,arg1,arg2) \ name() # define C_PROTO_3(name,arg1,arg2,arg3) \ name() # define C_PROTO_4(name,arg1,arg2,arg3,arg4) \ name() # define C_PROTO_5(name,arg1,arg2,arg3,arg4,arg5) \ name() # define C_PROTO_6(name,arg1,arg2,arg3,arg4,arg5,arg6) \ name() # define C_PROTO_7(name,arg1,arg2,arg3,arg4,arg5,arg6,arg7) \ name() # define C_PROTO_8(name,arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8) \ name() # define C_PROTO_9(name,arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8,arg9) \ name() # define C_PROTO_13(name,a1,a2,a3,a4,a5,a6,a7,a8,a9,b0,b1,b2,b3) \ name() # define C_PROTO_16(name,a1,a2,a3,a4,a5,a6,a7,a8,a9,b0,b1,b2,b3,b4,b5,b6) \ name() # define C_PROTO_17(name,a1,a2,a3,a4,a5,a6,a7,a8,a9,b0,b1,b2,b3,b4,b5,b6,b7) \ name() # define C_DECL_0(name) \ name() # define C_DECL_1(name,t1,p1) \ name( p1) \ t1 p1; # define C_DECL_2(name,t1,p1,t2,p2) \ name( p1, p2) \ t1 p1;t2 p2; # define C_DECL_3(name,t1,p1,t2,p2,t3,p3) \ name( p1, p2, p3) \ t1 p1;t2 p2;t3 p3; # define C_DECL_4(name,t1,p1,t2,p2,t3,p3,t4,p4) \ name( p1, p2, p3, p4) \ t1 p1;t2 p2;t3 p3;t4 p4; # define C_DECL_5(name,t1,p1,t2,p2,t3,p3,t4,p4,t5,p5) \ name( p1, p2, p3, p4, p5) \ t1 p1;t2 p2;t3 p3;t4 p4;t5 p5; # define C_DECL_6(name,t1,p1,t2,p2,t3,p3,t4,p4,t5,p5,t6,p6) \ name( p1, p2, p3, p4, p5, p6) \ t1 p1;t2 p2;t3 p3;t4 p4;t5 p5;t6 p6; # define C_DECL_7(name,t1,p1,t2,p2,t3,p3,t4,p4,t5,p5,t6,p6,t7,p7) \ name( p1, p2, p3, p4, p5, p6, p7) \ t1 p1;t2 p2;t3 p3;t4 p4;t5 p5;t6 p6;t7 p7; # define C_DECL_8(name,t1,p1,t2,p2,t3,p3,t4,p4,t5,p5,t6,p6,t7,p7,t8,p8) \ name( p1, p2, p3, p4, p5, p6, p7, p8) \ t1 p1;t2 p2;t3 p3;t4 p4;t5 p5;t6 p6;t7 p7;t8 p8; # define C_DECL_9(name,t1,p1,t2,p2,t3,p3,t4,p4,t5,p5,t6,p6,t7,p7,t8,p8,t9,p9)\ name( p1, p2, p3, p4, p5, p6, p7, p8, p9)\ t1 p1;t2 p2;t3 p3;t4 p4;t5 p5;t6 p6;t7 p7;t8 p8;t9 p9; # define C_DECL_13(name,A,a,B,b,C,c,D,d,E,e,F,f,G,g,H,h,I,i,J,j,K,k,L,l,M,m)\ name( a, b, c, d, e, f, g, h, i, j, k, l, m)\ A a;B b;C c;D d;E e;F f;G g;H h;I i;J j;K k;L l;M m; #endif typedef int IntFunc(); typedef char* CharFunc(); typedef char** pCharFunc(); #define KUMAC_UNWIND -30041961 /* error status to quit macro execution */ /* * convenience functions from kkern.c */ extern C_PROTO_2(char* fexpand, const char*, const char*); extern C_PROTO_1(char* fsymlink, const char*); extern C_PROTO_3(char* fsearch, const char*, const char*, const char*); extern C_PROTO_2(char* fstrdup, const char*, size_t); extern C_PROTO_2(char* fstr0dup, const char*, size_t); extern C_PROTO_2(char* fstrtrim, const char*, size_t); extern C_PROTO_2(char* fstr0trim, const char*, size_t); extern C_PROTO_2(size_t fstrlen, const char*, size_t); extern C_PROTO_3(size_t fstrset, char*, size_t, const char*); extern C_PROTO_2(double fstrtod, char*, char**); extern C_PROTO_2(int fstrtoi, char*, char**); extern C_PROTO_3(char* fstrvec, char**, int, int*); #ifndef HAVE_MEMMOVE extern C_PROTO_3(void* memmove, void*, const void*, size_t); #endif #ifndef HAVE_STRCASECMP extern C_PROTO_2(int strcasecmp, const char*, const char*); extern C_PROTO_3(int strncasecmp, const char*, const char*, size_t); #endif #ifndef HAVE_STRDUP extern C_PROTO_1(char* strdup, const char*); #endif #ifndef HAVE_STRRSTR extern C_PROTO_2(char* strrstr, const char*, const char*); #endif extern C_PROTO_1(char* str0dup, const char*); extern C_PROTO_2(char* str2dup, const char*, const char*); extern C_PROTO_3(char* str3dup, const char*, const char*, const char*); extern C_PROTO_4(char* str4dup, const char*, const char*, const char*, const char*); extern C_PROTO_5(char* str5dup, const char*, const char*, const char*, const char*, const char*); extern C_PROTO_2(char* strndup, const char*, int); extern C_PROTO_2(char* mstrcat, char*, const char*); extern C_PROTO_3(char* mstr2cat, char*, const char*, const char*); extern C_PROTO_4(char* mstr3cat, char*, const char*, const char*, const char*); extern C_PROTO_5(char* mstr4cat, char*, const char*, const char*, const char*, const char*); extern C_PROTO_3(char* mstrncat, char*, const char*, int); extern C_PROTO_3(char* mstrccat, char*, int, int); extern C_PROTO_2(char* mstricat, char*, int); extern C_PROTO_2(int mstrlen, char**, int); extern C_PROTO_1(char* strqtok, char*); extern C_PROTO_1(char* strlower, char*); extern C_PROTO_1(char* strupper, char*); extern C_PROTO_2(char* strfromd, double, int); extern C_PROTO_2(char* strfromi, int, int); /* * C-interface functions */ extern C_PROTO_0(char* k_getar); extern C_PROTO_2(void k_setar, int, char**); extern C_PROTO_0(char* k_userid); extern C_PROTO_0(void ku_alfa); extern C_PROTO_2(char* ku_appl, int*, int*); extern C_PROTO_1(void ku_cmdl, char*); extern C_PROTO_2(int ku_edit, char*, int); extern C_PROTO_1(char* ku_eval, char*); extern C_PROTO_1(int ku_exec, char*); extern C_PROTO_1(int ku_exel, char*); extern C_PROTO_0(char* ku_getc); extern C_PROTO_0(char* ku_gete); extern C_PROTO_0(char* ku_getf); extern C_PROTO_0(int ku_geti); extern C_PROTO_0(char* ku_getl); extern C_PROTO_0(char* ku_getq); extern C_PROTO_0(double ku_getr); extern C_PROTO_0(char* ku_gets); extern C_PROTO_1(char* ku_fcase, char*); extern C_PROTO_2(char* ku_home, char*, char*); extern C_PROTO_1(int ku_intr, int); extern C_PROTO_1(void ku_last, char*); extern C_PROTO_2(int ku_more, char*, char*); extern C_PROTO_0(int ku_npar); extern C_PROTO_2(void ku_pad, char*, int); extern C_PROTO_0(char* ku_path); extern C_PROTO_2(void ku_piaf, int, void(*)()); extern C_PROTO_2(char* ku_proc, char*, char*); extern C_PROTO_2(char* ku_prof, char*, char*); extern C_PROTO_2(int ku_proi, char*, int); extern C_PROTO_1(char* ku_prop, char*); extern C_PROTO_2(double ku_pror, char*, double); extern C_PROTO_2(char* ku_pros, char*, char*); extern C_PROTO_0(char** ku_qenv); extern C_PROTO_1(char* ku_qexe, char*); extern C_PROTO_2(int ku_sapp, char*, char*); extern C_PROTO_0(void ku_shut); extern C_PROTO_1(int ku_stop, int); extern C_PROTO_2(void ku_time, time_t, clock_t); extern C_PROTO_2(void ku_trap, int, int); extern C_PROTO_1(int ku_vqaddr, char*); extern C_PROTO_1(int ku_vtype, char*); extern C_PROTO_2(int ku_vvalue, char*, double*); extern C_PROTO_0(void ku_whag); extern C_PROTO_1(void ku_what, void(*)()); extern C_PROTO_1(char* getline, char*); extern C_PROTO_2(void gl_config, char*, int); extern C_PROTO_1(void gl_histadd, char*); extern C_PROTO_1(void gl_setwidth, int); extern C_PROTO_2(char* input_line, char*, int); extern C_PROTO_0(void leave_kuip); extern C_PROTO_2(int len_alias, char*, int); extern C_PROTO_1(int len_sysfun, char*); extern C_PROTO_1(int len_vector, char*); extern C_PROTO_2(char* quote_string, char*, int); extern C_PROTO_0(void reset_break); extern C_PROTO_1(void signal_handler, int ); extern C_PROTO_2(int vms_signal_handler, void*, void* ); +KEEP,KFOR_H /* kfor.h: Fortran-C interface */ /* * Fortran data types */ typedef int INTEGER; typedef int LOGICAL; typedef float REAL; typedef double DBLPREC; typedef INTEGER INT_FUNCTION(); typedef INT_FUNCTION *INT_FUNCPTR; typedef void (*SUBRPTR)(); typedef void SUBROUTINE(); #ifdef IBM370 #pragma linkage(SUBROUTINE,FORTRAN) #pragma linkage(INT_FUNCTION,FORTRAN) #pragma map(__CTOF,"@@CTOF") extern INTEGER __CTOF( INT_FUNCPTR, ... ); #endif typedef union _EQUIV_INT_REAL { INTEGER i; LOGICAL l; REAL r; } EQUIV_INT_REAL; /* * Mapping of C-routine name for Fortran CALL SUB * * #define F77_EXTERN_LOWERCASE ==> void sub() * #define F77_EXTERN_UPPERCASE ==> void SUB() * otherwise ==> void sub_() */ #ifdef F77_EXTERN_UPPERCASE # define F77_NAME(name,NAME) NAME #else # ifdef F77_EXTERN_LOWERCASE # define F77_NAME(name,NAME) name # else # define F77_NAME(name,NAME) ConCat(name,_) # endif #endif #ifndef F77_BLOCK # define F77_BLOCK(name,NAME) F77_NAME(name,NAME) #endif #ifndef F77_COMMON # define F77_COMMON(name) name #endif /* * Routine address in CALL SUB(FUN) ; EXTERNAL FUN * * #define F77_EXTERN_INDIRECT ==> void (**fun)(); * otherwise ==> void (*fun)(); */ #ifdef F77_EXTERN_INDIRECT # define F77_EXTERN_ARG(e) ConCat(e,_dsc) # define F77_EXTERN_DCL(e) SUBROUTINE **ConCat(e,_dsc); # define F77_EXTERN_DEF(e) SUBROUTINE *e = *ConCat(e,_dsc); #else # define F77_EXTERN_ARG(e) e # define F77_EXTERN_DCL(e) SUBROUTINE *e; # define F77_EXTERN_DEF(e) #endif #define F77_EXTERN2ARG(e1,e2) F77_EXTERN_ARG(e1),F77_EXTERN_ARG(e2) #define F77_EXTERN2DCL(e1,e2) F77_EXTERN_DCL(e1) F77_EXTERN_DCL(e2) #define F77_EXTERN2DEF(e1,e2) F77_EXTERN_DEF(e1) F77_EXTERN_DEF(e2) #define F77_EXTERN3ARG(e1,e2,e3) F77_EXTERN_ARG(e1),F77_EXTERN2ARG(e2,e3) #define F77_EXTERN3DCL(e1,e2,e3) F77_EXTERN_DCL(e1) F77_EXTERN2DCL(e2,e3) #define F77_EXTERN3DEF(e1,e2,e3) F77_EXTERN_DEF(e1) F77_EXTERN2DEF(e2,e3) #define F77_EXTERN4ARG(e1,e2,e3,e4) F77_EXTERN_ARG(e1),F77_EXTERN3ARG(e2,e3,e4) #define F77_EXTERN4DCL(e1,e2,e3,e4) F77_EXTERN_DCL(e1) F77_EXTERN3DCL(e2,e3,e4) #define F77_EXTERN4DEF(e1,e2,e3,e4) F77_EXTERN_DEF(e1) F77_EXTERN3DEF(e2,e3,e4) /* * Access to Fortran CHARACTER arguments */ #ifdef F77_CHAR_DSC_VMS /* VMS string descriptors */ # define F77_CHAR_ARG_PTR(s) ConCat(s,_dsc) # define F77_CHAR_ARG_LEN(s) # define F77_CHAR_ARG_DCL(s) struct dsc$descriptor_s *ConCat(s,_dsc); # define F77_CHAR_ARG_DEF(s) char *s = ConCat(s,_dsc)->dsc$a_pointer; \ int ConCat(len_,s) = ConCat(s,_dsc)->dsc$w_length; # define F77_CHAR_DEF_DSC(s,p,l) struct dsc$descriptor_s ConCat(s,__dsc); # define F77_CHAR_ASS_DSC(s,p,l) ConCat(s,__dsc).dsc$w_length = l; \ ConCat(s,__dsc).dsc$b_dtype = DSC$K_DTYPE_T;\ ConCat(s,__dsc).dsc$b_class = DSC$K_CLASS_S;\ ConCat(s,__dsc).dsc$a_pointer = p; # define F77_CHAR_USE_PTR(s,p,l) &ConCat(s,__dsc) # define F77_CHAR_USE_LEN(s,p,l) #endif #ifdef F77_CHAR_DSC_CRAY /* Cray string descriptors */ # define F77_CHAR_ARG_PTR(s) ConCat(s,_dsc) # define F77_CHAR_ARG_LEN(s) # define F77_CHAR_ARG_DCL(s) _fcd ConCat(s,_dsc); # define F77_CHAR_ARG_DEF(s) char *s = _fcdtocp(ConCat(s,_dsc)); \ int ConCat(len_,s) = _fcdlen(ConCat(s,_dsc)); # define F77_CHAR_DEF_DSC(s,p,l) # define F77_CHAR_ASS_DSC(s,p,l) # define F77_CHAR_USE_PTR(s,p,l) _cptofcd(p,l) # define F77_CHAR_USE_LEN(s,p,l) #endif #ifdef F77_CHAR_LEN_IND /* string length passed by reference */ /* * The IBM C/370 compiler passes the Fortran CHARACTER pointer directly * instead of making a private copy. Therefore we have to do the copy * char *s = s_ptr ourself in case the routine uses s as local variable. */ # define F77_CHAR_ARG_PTR(s) ConCat(s,_ptr) # define F77_CHAR_ARG_LEN(s) , ConCat(s,_dsc) # define F77_CHAR_ARG_DCL(s) char *ConCat(s,_ptr); \ F77_CHAR_LEN_IND *ConCat(s,_dsc); # define F77_CHAR_ARG_DEF(s) char *s = ConCat(s,_ptr); \ int ConCat(len_,s) = *ConCat(s,_dsc); # define F77_CHAR_DEF_DSC(s,p,l) F77_CHAR_LEN_IND ConCat(s,__dsc) = l; # define F77_CHAR_ASS_DSC(s,p,l) # define F77_CHAR_USE_PTR(s,p,l) p # define F77_CHAR_USE_LEN(s,p,l) , &ConCat(s,__dsc) #endif #ifndef F77_CHAR_ARG_PTR /* string length passed by value */ # define F77_CHAR_ARG_PTR(s) s # define F77_CHAR_ARG_LEN(s) , ConCat(len_,s) # define F77_CHAR_ARG_DCL(s) char *s; int ConCat(len_,s); # define F77_CHAR_ARG_DEF(s) # define F77_CHAR_DEF_DSC(s,p,l) # define F77_CHAR_ASS_DSC(s,p,l) # define F77_CHAR_USE_PTR(s,p,l) p # define F77_CHAR_USE_LEN(s,p,l) , l #endif #ifndef F77_XXXX_ARG_LEN /* length argument of non-CHARACTER arguments */ # define F77_XXXX_ARG_LEN(x) /* nil */ # define F77_XXXX_USE_LEN(x) /* nil */ #endif /* * Fortran-calls-C interface * * To define a C function called by Fortran CALL SUB(A,B,C): * * #define Sub F77_NAME(sub,SUB) * #pragma linkage(SUB,FORTRAN) // for IBM C/370 compiler * * F77_ENTRY_xyz(Sub,a,b,c) // opening { contained in macro * // body ... * } * * Each character in xyz declares the type of the corresponding parameter: * * C = CHARACTER * D = DOUBLE PRECISION * E = EXTERNAL * I = INTEGER * L = LOGICAL * R = REAL * X = COMPLEX * * If a parameter PAR is declared as CHARACTER the macro defines: * * char *PAR; // pointer to string (not terminated by \0 !!!) * int len_PAR; // length of string as defined by Fortran's LEN(PAR) * * The name PAR_dsc is reserved for internal use. * * Note: The function body follows the F77_ENTRY_... macro call directly. * The opening { is generated by the macro. */ #define F77_CHAR_ARG2PTR(c1,c2) \ F77_CHAR_ARG_PTR(c1),F77_CHAR_ARG_PTR(c2) #define F77_CHAR_ARG2LEN(c1,c2) \ F77_CHAR_ARG_LEN(c1) F77_CHAR_ARG_LEN(c2) #define F77_XXXX_ARG2LEN(c1,c2) \ F77_XXXX_ARG_LEN(c1) F77_XXXX_ARG_LEN(c2) #define F77_CHAR_ARG2DCL(c1,c2) \ F77_CHAR_ARG_DCL(c1) F77_CHAR_ARG_DCL(c2) #define F77_CHAR_ARG2DEF(c1,c2) \ F77_CHAR_ARG_DEF(c1) F77_CHAR_ARG_DEF(c2) #define F77_CHAR_ARG3PTR(c1,c2,c3) \ F77_CHAR_ARG2PTR(c1,c2),F77_CHAR_ARG_PTR(c3) #define F77_CHAR_ARG3LEN(c1,c2,c3) \ F77_CHAR_ARG2LEN(c1,c2) F77_CHAR_ARG_LEN(c3) #define F77_XXXX_ARG3LEN(c1,c2,c3) \ F77_XXXX_ARG2LEN(c1,c2) F77_XXXX_ARG_LEN(c3) #define F77_CHAR_ARG3DCL(c1,c2,c3) \ F77_CHAR_ARG2DCL(c1,c2) F77_CHAR_ARG_DCL(c3) #define F77_CHAR_ARG3DEF(c1,c2,c3) \ F77_CHAR_ARG2DEF(c1,c2) F77_CHAR_ARG_DEF(c3) #define F77_CHAR_ARG4PTR(c1,c2,c3,c4) \ F77_CHAR_ARG3PTR(c1,c2,c3),F77_CHAR_ARG_PTR(c4) #define F77_CHAR_ARG4LEN(c1,c2,c3,c4) \ F77_CHAR_ARG3LEN(c1,c2,c3) F77_CHAR_ARG_LEN(c4) #define F77_XXXX_ARG4LEN(c1,c2,c3,c4) \ F77_XXXX_ARG3LEN(c1,c2,c3) F77_XXXX_ARG_LEN(c4) #define F77_CHAR_ARG4DCL(c1,c2,c3,c4) \ F77_CHAR_ARG3DCL(c1,c2,c3) F77_CHAR_ARG_DCL(c4) #define F77_CHAR_ARG4DEF(c1,c2,c3,c4) \ F77_CHAR_ARG3DEF(c1,c2,c3) F77_CHAR_ARG_DEF(c4) #define F77_CHAR_ARG5PTR(c1,c2,c3,c4,c5) \ F77_CHAR_ARG4PTR(c1,c2,c3,c4),F77_CHAR_ARG_PTR(c5) #define F77_CHAR_ARG5LEN(c1,c2,c3,c4,c5) \ F77_CHAR_ARG4LEN(c1,c2,c3,c4) F77_CHAR_ARG_LEN(c5) #define F77_CHAR_ARG5DCL(c1,c2,c3,c4,c5) \ F77_CHAR_ARG4DCL(c1,c2,c3,c4) F77_CHAR_ARG_DCL(c5) #define F77_CHAR_ARG5DEF(c1,c2,c3,c4,c5) \ F77_CHAR_ARG4DEF(c1,c2,c3,c4) F77_CHAR_ARG_DEF(c5) #define F77_ENTRY_C(name,c1) \ name( F77_CHAR_ARG_PTR(c1) F77_CHAR_ARG_LEN(c1) ) \ F77_CHAR_ARG_DCL(c1) \ { F77_CHAR_ARG_DEF(c1) #define F77_ENTRY_CC(name,c1,c2) \ name( F77_CHAR_ARG2PTR(c1,c2) F77_CHAR_ARG2LEN(c1,c2) ) \ F77_CHAR_ARG2DCL(c1,c2) \ { F77_CHAR_ARG2DEF(c1,c2) #define F77_ENTRY_C3(name,c1,c2,c3) \ name( F77_CHAR_ARG3PTR(c1,c2,c3) \ F77_CHAR_ARG3LEN(c1,c2,c3) ) \ F77_CHAR_ARG3DCL(c1,c2,c3) \ { F77_CHAR_ARG3DEF(c1,c2,c3) #define F77_ENTRY_C5(name,c1,c2,c3,c4,c5) \ name( F77_CHAR_ARG5PTR(c1,c2,c3,c4,c5) \ F77_CHAR_ARG5LEN(c1,c2,c3,c4,c5) ) \ F77_CHAR_ARG5DCL(c1,c2,c3,c4,c5) \ { F77_CHAR_ARG5DEF(c1,c2,c3,c4,c5) #define F77_ENTRY_C4E(name,c1,c2,c3,c4,e5) \ name( F77_CHAR_ARG4PTR(c1,c2,c3,c4),F77_EXTERN_ARG(e5) \ F77_CHAR_ARG4LEN(c1,c2,c3,c4) ) \ F77_CHAR_ARG4DCL(c1,c2,c3,c4) F77_EXTERN_DCL(e5) \ { F77_CHAR_ARG4DEF(c1,c2,c3,c4) F77_EXTERN_DEF(e5) #define F77_ENTRY_C4I(name,c1,c2,c3,c4,i5) \ name( F77_CHAR_ARG4PTR(c1,c2,c3,c4), i5 \ F77_CHAR_ARG4LEN(c1,c2,c3,c4) ) \ F77_CHAR_ARG4DCL(c1,c2,c3,c4) INTEGER *i5; \ { F77_CHAR_ARG4DEF(c1,c2,c3,c4) #define F77_ENTRY_C5E(name,c1,c2,c3,c4,c5,e6) \ name( F77_CHAR_ARG5PTR(c1,c2,c3,c4,c5),F77_EXTERN_ARG(e6) \ F77_CHAR_ARG5LEN(c1,c2,c3,c4,c5) ) \ F77_CHAR_ARG5DCL(c1,c2,c3,c4,c5) F77_EXTERN_DCL(e6) \ { F77_CHAR_ARG5DEF(c1,c2,c3,c4,c5) F77_EXTERN_DEF(e6) #define F77_ENTRY_CCE(name,c1,c2,e3) \ name( F77_CHAR_ARG2PTR(c1,c2),F77_EXTERN_ARG(e3) \ F77_CHAR_ARG2LEN(c1,c2) ) \ F77_CHAR_ARG2DCL(c1,c2) F77_EXTERN_DCL(e3) \ { F77_CHAR_ARG2DEF(c1,c2) F77_EXTERN_DEF(e3) #define F77_ENTRY_CCEE(name,c1,c2,e3,e4) \ name( F77_CHAR_ARG2PTR(c1,c2),F77_EXTERN2ARG(e3,e4) \ F77_CHAR_ARG2LEN(c1,c2) ) \ F77_CHAR_ARG2DCL(c1,c2) F77_EXTERN2DCL(e3,e4) \ { F77_CHAR_ARG2DEF(c1,c2) F77_EXTERN2DEF(e3,e4) #define F77_ENTRY_CCI(name,c1,c2,i3) \ name( F77_CHAR_ARG2PTR(c1,c2), i3 \ F77_CHAR_ARG2LEN(c1,c2) ) \ F77_CHAR_ARG2DCL(c1,c2) INTEGER *i3; \ { F77_CHAR_ARG2DEF(c1,c2) #define F77_ENTRY_CCIC(name,c1,c2,i3,c4) \ name( F77_CHAR_ARG2PTR(c1,c2), i3, F77_CHAR_ARG_PTR(c4) \ F77_CHAR_ARG2LEN(c1,c2) \ F77_XXXX_ARG_LEN(i3) \ F77_CHAR_ARG_LEN(c4) ) \ F77_CHAR_ARG3DCL(c1,c2,c4) INTEGER *i3; \ { F77_CHAR_ARG3DEF(c1,c2,c4) #define F77_ENTRY_CCIRCC(name,c1,c2,i3,r4,c5,c6) \ name( F77_CHAR_ARG2PTR(c1,c2), i3, r4, F77_CHAR_ARG2PTR(c5,c6) \ F77_CHAR_ARG2LEN(c1,c2) \ F77_XXXX_ARG2LEN(i3,r4) \ F77_CHAR_ARG2LEN(c5,c6) ) \ F77_CHAR_ARG4DCL(c1,c2,c5,c6) INTEGER *i3; REAL *r4; \ { F77_CHAR_ARG4DEF(c1,c2,c5,c6) #define F77_ENTRY_CE(name,c1,e2) \ name( F77_CHAR_ARG_PTR(c1),F77_EXTERN_ARG(e2) \ F77_CHAR_ARG_LEN(c1) ) \ F77_CHAR_ARG_DCL(c1) F77_EXTERN_DCL(e2) \ { F77_CHAR_ARG_DEF(c1) F77_EXTERN_DEF(e2) #define F77_ENTRY_CI(name,c1,i2) \ name( F77_CHAR_ARG_PTR(c1), i2 F77_CHAR_ARG_LEN(c1) ) \ INTEGER *i2; F77_CHAR_ARG_DCL(c1) \ { F77_CHAR_ARG_DEF(c1) #define F77_ENTRY_CICI(name,c1,i2,c3,i4) \ name( F77_CHAR_ARG_PTR(c1), i2, F77_CHAR_ARG_PTR(c3), i4 \ F77_CHAR_ARG_LEN(c1) \ F77_XXXX_ARG_LEN(i2) \ F77_CHAR_ARG_LEN(c3) ) \ F77_CHAR_ARG2DCL(c1,c3) INTEGER *i2, *i4; \ { F77_CHAR_ARG2DEF(c1,c3) #define F77_ENTRY_CII(name,c1,i2,i3) \ name( F77_CHAR_ARG_PTR(c1), i2, i3 \ F77_CHAR_ARG_LEN(c1) ) \ F77_CHAR_ARG_DCL(c1) INTEGER *i2, *i3; \ { F77_CHAR_ARG_DEF(c1) #define F77_ENTRY_CIIC(name,c1,i2,i3,c4) \ name( F77_CHAR_ARG_PTR(c1), i2, i3, F77_CHAR_ARG_PTR(c4) \ F77_CHAR_ARG_LEN(c1) \ F77_XXXX_ARG2LEN(i2,i3) \ F77_CHAR_ARG_LEN(c4) ) \ F77_CHAR_ARG2DCL(c1,c4) INTEGER *i2, *i3; \ { F77_CHAR_ARG2DEF(c1,c4) #define F77_ENTRY_CR(name,c1,r2) \ name( F77_CHAR_ARG_PTR(c1), r2 F77_CHAR_ARG_LEN(c1) ) \ REAL *r2; F77_CHAR_ARG_DCL(c1) \ { F77_CHAR_ARG_DEF(c1) #define F77_ENTRY_E(name,e1) \ name( F77_EXTERN_ARG(e1) ) \ F77_EXTERN_DCL(e1) \ { F77_EXTERN_DEF(e1) #define F77_ENTRY_E4(name,e1,e2,e3,e4) \ name( F77_EXTERN4ARG(e1,e2,e3,e4) ) \ F77_EXTERN4DCL(e1,e2,e3,e4) \ { F77_EXTERN4DEF(e1,e2,e3,e4) #define F77_ENTRY_IC(name,i1,c2) \ name( i1, F77_CHAR_ARG_PTR(c2) \ F77_XXXX_ARG_LEN(i1) \ F77_CHAR_ARG_LEN(c2) ) \ INTEGER *i1; F77_CHAR_ARG_DCL(c2) \ { F77_CHAR_ARG_DEF(c2) #define F77_ENTRY_ICI(name,i1,c2,i3) \ name( i1, F77_CHAR_ARG_PTR(c2), i3 \ F77_XXXX_ARG_LEN(i1) \ F77_CHAR_ARG_LEN(c2) ) \ INTEGER *i1, *i3; F77_CHAR_ARG_DCL(c2) \ { F77_CHAR_ARG_DEF(c2) #define F77_ENTRY_IIC(name,i1,i2,c3) \ name( i1, i2, F77_CHAR_ARG_PTR(c3) \ F77_XXXX_ARG2LEN(i1,i2) \ F77_CHAR_ARG_LEN(c3) ) \ INTEGER *i1, *i2; F77_CHAR_ARG_DCL(c3) \ { F77_CHAR_ARG_DEF(c3) #define F77_ENTRY_I3C(name,i1,i2,i3,c4) \ name( i1, i2, i3, F77_CHAR_ARG_PTR(c4) \ F77_XXXX_ARG3LEN(i1,i2,i3) \ F77_CHAR_ARG_LEN(c4) ) \ INTEGER *i1, *i2, *i3; \ F77_CHAR_ARG_DCL(c4) \ { F77_CHAR_ARG_DEF(c4) #define F77_ENTRY_I4CCC(name,i1,i2,i3,i4,c5,c6,c7) \ name( i1, i2, i3, i4, F77_CHAR_ARG3PTR(c5,c6,c7) \ F77_XXXX_ARG4LEN(i1,i2,i3,i4) \ F77_CHAR_ARG3LEN(c5,c6,c7) ) \ INTEGER *i1, *i2, *i3, *i4; \ F77_CHAR_ARG3DCL(c5,c6,c7) \ { F77_CHAR_ARG3DEF(c5,c6,c7) #define F77_CHAR_DEF2DSC(s1,p1,l1,s2,p2,l2) \ F77_CHAR_DEF_DSC(s1,p1,l1) F77_CHAR_DEF_DSC(s2,p2,l2) #define F77_CHAR_ASS2DSC(s1,p1,l1,s2,p2,l2) \ F77_CHAR_ASS_DSC(s1,p1,l1) F77_CHAR_ASS_DSC(s2,p2,l2) #define F77_CHAR_USE2PTR(s1,p1,l1,s2,p2,l2) \ F77_CHAR_USE_PTR(s1,p1,l1),F77_CHAR_USE_PTR(s2,p2,l2) #define F77_CHAR_USE2LEN(s1,p1,l1,s2,p2,l2) \ F77_CHAR_USE_LEN(s1,p1,l1) F77_CHAR_USE_LEN(s2,p2,l2) #define F77_XXXX_USE2LEN(x1,x2) \ F77_XXXX_USE_LEN(x1) F77_XXXX_USE_LEN(x2) #define F77_CHAR_DEF3DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3) \ F77_CHAR_DEF2DSC(s1,p1,l1,s2,p2,l2) F77_CHAR_DEF_DSC(s3,p3,l3) #define F77_CHAR_ASS3DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3) \ F77_CHAR_ASS2DSC(s1,p1,l1,s2,p2,l2) F77_CHAR_ASS_DSC(s3,p3,l3) #define F77_CHAR_USE3PTR(s1,p1,l1,s2,p2,l2,s3,p3,l3) \ F77_CHAR_USE2PTR(s1,p1,l1,s2,p2,l2),F77_CHAR_USE_PTR(s3,p3,l3) #define F77_CHAR_USE3LEN(s1,p1,l1,s2,p2,l2,s3,p3,l3) \ F77_CHAR_USE2LEN(s1,p1,l1,s2,p2,l2) F77_CHAR_USE_LEN(s3,p3,l3) #define F77_XXXX_USE3LEN(x1,x2,x3) \ F77_XXXX_USE2LEN(x1,x2) F77_XXXX_USE_LEN(x3) #define F77_CHAR_DEF4DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3,s4,p4,l4) \ F77_CHAR_DEF3DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3) F77_CHAR_DEF_DSC(s4,p4,l4) #define F77_CHAR_ASS4DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3,s4,p4,l4) \ F77_CHAR_ASS3DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3) F77_CHAR_ASS_DSC(s4,p4,l4) #define F77_CHAR_USE4PTR(s1,p1,l1,s2,p2,l2,s3,p3,l3,s4,p4,l4) \ F77_CHAR_USE3PTR(s1,p1,l1,s2,p2,l2,s3,p3,l3),F77_CHAR_USE_PTR(s4,p4,l4) #define F77_CHAR_USE4LEN(s1,p1,l1,s2,p2,l2,s3,p3,l3,s4,p4,l4) \ F77_CHAR_USE3LEN(s1,p1,l1,s2,p2,l2,s3,p3,l3) F77_CHAR_USE_LEN(s4,p4,l4) #define F77_XXXX_USE4LEN(x1,x2,x3,x4) \ F77_XXXX_USE3LEN(x1,x2,x3) F77_XXXX_USE_LEN(x4) #define F77_XXXX_USE5LEN(x1,x2,x3,x4,x5) \ F77_XXXX_USE4LEN(x1,x2,x3,x4) F77_XXXX_USE_LEN(x5) #define F77_XXXX_USE6LEN(x1,x2,x3,x4,x5,x6) \ F77_XXXX_USE5LEN(x1,x2,x3,x4,x5) F77_XXXX_USE_LEN(x6) #define F77_XXXX_USE7LEN(x1,x2,x3,x4,x5,x6,x7) \ F77_XXXX_USE6LEN(x1,x2,x3,x4,x5,x6) F77_XXXX_USE_LEN(x7) #define F77_XXXX_USE8LEN(x1,x2,x3,x4,x5,x6,x7,x8) \ F77_XXXX_USE7LEN(x1,x2,x3,x4,x5,x6,x7) F77_XXXX_USE_LEN(x8) #ifdef IBM370 #pragma linkage(K77C,FORTRAN) #define F77_CALL_C(name,p1,l1) do { \ SUBROUTINE *F77 = name; \ K77C(&F77,p1,l1); } while(0) #else #define F77_CALL_C(name,p1,l1) do { \ F77_CHAR_DEF_DSC(s1,p1,l1) \ F77_CHAR_ASS_DSC(s1,p1,l1) \ name( F77_CHAR_USE_PTR(s1,p1,l1) \ F77_CHAR_USE_LEN(s1,p1,l1) \ ); } while(0) #endif #if 0 #ifdef IBM370 #pragma linkage(K77CC,FORTRAN) #define F77_CALL_CC(name,p1,l1,p2,l2) do { \ SUBROUTINE *F77 = name; \ K77CC(&F77,p1,l1,p2,l2); } while(0) #else #define F77_CALL_CC(name,p1,l1,p2,l2) do { \ F77_CHAR_DEF2DSC(s1,p1,l1,s2,p2,l2) \ F77_CHAR_ASS2DSC(s1,p1,l1,s2,p2,l2) \ name( F77_CHAR_USE2PTR(s1,p1,l1,s2,p2,l2) \ F77_CHAR_USE2LEN(s1,p1,l1,s2,p2,l2) \ ); } while(0) #endif #else #ifdef IBM370 #pragma linkage(K77CC,FORTRAN) #define F77_IFUN_CC(i0,name,p1,l1,p2,l2) do { \ i0 = K77CC(&name,p1,l1,p2,l2); } while(0) #else #define F77_IFUN_CC(i0,name,p1,l1,p2,l2) do { \ F77_CHAR_DEF2DSC(s1,p1,l1,s2,p2,l2) \ F77_CHAR_ASS2DSC(s1,p1,l1,s2,p2,l2) \ i0 = (*name)( \ F77_CHAR_USE2PTR(s1,p1,l1,s2,p2,l2) \ F77_CHAR_USE2LEN(s1,p1,l1,s2,p2,l2) \ ); } while(0) #endif #define F77_CALL_CC(name,p1,l1,p2,l2) do { \ INT_FUNCPTR _p0_ = (INT_FUNCPTR)name; \ INTEGER _i0_; \ F77_IFUN_CC(_i0_,_p0_,p1,l1,p2,l2); \ } while(0) #endif #ifdef IBM370 #pragma linkage(K77C3,FORTRAN) #define F77_CALL_C3(name,p1,l1,p2,l2,p3,l3) do { \ SUBROUTINE *F77 = name; \ K77C3(&F77,p1,l1,p2,l2,p3,l3); } while(0) #else #define F77_CALL_C3(name,p1,l1,p2,l2,p3,l3) do { \ F77_CHAR_DEF3DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3) \ F77_CHAR_ASS3DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3) \ name( F77_CHAR_USE3PTR(s1,p1,l1,s2,p2,l2,s3,p3,l3) \ F77_CHAR_USE3LEN(s1,p1,l1,s2,p2,l2,s3,p3,l3) \ ); } while(0) #endif #ifdef IBM370 #pragma linkage(K77C7,FORTRAN) #define F77_CALL_C7(name,p1,l1,p2,l2,p3,l3,p4,l4,p5,l5,p6,l6,p7,l7) do { \ SUBROUTINE *F77 = name; \ K77C7(&F77,p1,l1,p2,l2,p3,l3,p4,l4,p5,l5,p6,l6,p7,l7); } while(0) #else #define F77_CALL_C7(name,p1,l1,p2,l2,p3,l3,p4,l4,p5,l5,p6,l6,p7,l7) do { \ F77_CHAR_DEF4DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3,s4,p4,l4) \ F77_CHAR_DEF3DSC(s5,p5,l5,s6,p6,l6,s7,p7,l7) \ F77_CHAR_ASS4DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3,s4,p4,l4) \ F77_CHAR_ASS3DSC(s5,p5,l5,s6,p6,l6,s7,p7,l7) \ name( F77_CHAR_USE4PTR(s1,p1,l1,s2,p2,l2,s3,p3,l3,s4,p4,l4), \ F77_CHAR_USE3PTR(s5,p5,l5,s6,p6,l6,s7,p7,l7) \ F77_CHAR_USE4LEN(s1,p1,l1,s2,p2,l2,s3,p3,l3,s4,p4,l4) \ F77_CHAR_USE3LEN(s5,p5,l5,s6,p6,l6,s7,p7,l7) \ ); } while(0) #endif #ifdef IBM370 #pragma linkage(K77CCx,FORTRAN) #define F77_CALL_CCx(name,p1,l1,p2,l2,x3) do { \ SUBROUTINE *F77 = name; \ K77CCx(&F77,p1,l1,p2,l2,x3); } while(0) #else #define F77_CALL_CCx(name,p1,l1,p2,l2,x3) do { \ F77_CHAR_DEF2DSC(s1,p1,l1,s2,p2,l2) \ F77_CHAR_ASS2DSC(s1,p1,l1,s2,p2,l2) \ name( F77_CHAR_USE2PTR(s1,p1,l1,s2,p2,l2), \ x3 \ F77_CHAR_USE2LEN(s1,p1,l1,s2,p2,l2) \ F77_XXXX_USE_LEN(x3) \ ); } while(0) #endif #ifdef IBM370 #pragma linkage(K77CCx3,FORTRAN) #define F77_CALL_CCx3(name,p1,l1,p2,l2,x3,x4,x5) do { \ SUBROUTINE *F77 = name; \ K77CCx3(&F77,p1,l1,p2,l2,x3,x4,x5); } while(0) #else #define F77_CALL_CCx3(name,p1,l1,p2,l2,x3,x4,x5) do { \ F77_CHAR_DEF2DSC(s1,p1,l1,s2,p2,l2) \ F77_CHAR_ASS2DSC(s1,p1,l1,s2,p2,l2) \ name( F77_CHAR_USE2PTR(s1,p1,l1,s2,p2,l2), \ x3,x4,x5 \ F77_CHAR_USE2LEN(s1,p1,l1,s2,p2,l2) \ F77_XXXX_USE3LEN(x3,x4,x5) \ ); } while(0) #endif #ifdef IBM370 #pragma linkage(K77Cx,FORTRAN) #define F77_IFUN_Cx(i0,name,p1,l1,x2) do { \ i0 = K77Cx(&name,p1,l1,x2); } while(0) #else #define F77_IFUN_Cx(i0,name,p1,l1,x2) do { \ F77_CHAR_DEF_DSC(s1,p1,l1) \ F77_CHAR_ASS_DSC(s1,p1,l1) \ i0 = (*name)( \ F77_CHAR_USE_PTR(s1,p1,l1), \ x2 \ F77_CHAR_USE_LEN(s1,p1,l1) \ F77_XXXX_USE_LEN(x2) \ ); } while(0) #endif #define F77_CALL_Cx(name,p1,l1,x2) do { \ INT_FUNCPTR _p0_ = (INT_FUNCPTR)name; \ INTEGER _i0_; \ F77_IFUN_Cx(_i0_,_p0_,p1,l1,x2); \ } while(0) #ifdef IBM370 #pragma linkage(K77CxC,FORTRAN) #define F77_CALL_CxC(name,p1,l1,x2,p3,l3) do { \ SUBROUTINE *F77 = name; \ K77CxC(&F77,p1,l1,x2,p3,l3); } while(0) #else #define F77_CALL_CxC(name,p1,l1,x2,p3,l3) do { \ F77_CHAR_DEF2DSC(s1,p1,l1,s3,p3,l3) \ F77_CHAR_ASS2DSC(s1,p1,l1,s3,p3,l3) \ name( F77_CHAR_USE_PTR(s1,p1,l1), \ x2, \ F77_CHAR_USE_PTR(s3,p3,l3) \ F77_CHAR_USE_LEN(s1,p1,l1) \ F77_XXXX_USE_LEN(x2) \ F77_CHAR_USE_LEN(s3,p3,l3) \ ); } while(0) #endif #ifdef IBM370 #pragma linkage(K77Cxx,FORTRAN) #define F77_CALL_Cxx(name,p1,l1,x2,x3) do { \ SUBROUTINE *F77 = name; \ K77Cxx(&F77,p1,l1,x2,x3); } while(0) #else #define F77_CALL_Cxx(name,p1,l1,x2,x3) do { \ F77_CHAR_DEF_DSC(s1,p1,l1) \ F77_CHAR_ASS_DSC(s1,p1,l1) \ name( F77_CHAR_USE_PTR(s1,p1,l1), \ x2,x3 \ F77_CHAR_USE_LEN(s1,p1,l1) \ F77_XXXX_USE2LEN(x2,x3) \ ); } while(0) #endif #ifdef IBM370 #pragma linkage(K77xC,FORTRAN) #define F77_CALL_xC(name,x1,p2,l2) do { \ SUBROUTINE *F77 = name; \ K77xC(&F77,x1,p2,l2); } while(0) #else #define F77_CALL_xC(name,x1,p2,l2) do { \ F77_CHAR_DEF_DSC(s2,p2,l2) \ F77_CHAR_ASS_DSC(s2,p2,l2) \ name( x1, \ F77_CHAR_USE_PTR(s2,p2,l2) \ F77_XXXX_USE_LEN(x1) \ F77_CHAR_USE_LEN(s2,p2,l2) \ ); } while(0) #endif #ifdef IBM370 #pragma linkage(K77xCCx,FORTRAN) #define F77_CALL_xCCx(name,x1,p2,l2,p3,l3,x4) do { \ SUBROUTINE *F77 = name; \ K77xCCx(&F77,x1,p2,l2,p3,l3,x4); } while(0) #else #define F77_CALL_xCCx(name,x1,p2,l2,p3,l3,x4) do { \ F77_CHAR_DEF2DSC(s2,p2,l2,s3,p3,l3) \ F77_CHAR_ASS2DSC(s2,p2,l2,s3,p3,l3) \ name( x1, \ F77_CHAR_USE2PTR(s2,p2,l2,s3,p3,l3), \ x4 \ F77_XXXX_USE_LEN(x1) \ F77_CHAR_USE2LEN(s2,p2,l2,s3,p3,l3) \ F77_XXXX_USE_LEN(x4) \ ); } while(0) #endif #ifdef IBM370 #pragma linkage(K77xCx,FORTRAN) #define F77_IFUN_xCx(i0,name,x1,p2,l2,x3) do { \ i0 = K77xCx(&name,x1,p2,l2,x3); } while(0) #else #define F77_IFUN_xCx(i0,name,x1,p2,l2,x3) do { \ F77_CHAR_DEF_DSC(s2,p2,l2) \ F77_CHAR_ASS_DSC(s2,p2,l2) \ i0 = (*name)( x1, \ F77_CHAR_USE_PTR(s2,p2,l2), \ x3 \ F77_XXXX_USE_LEN(x1) \ F77_CHAR_USE_LEN(s2,p2,l2) \ F77_XXXX_USE_LEN(x3) \ ); } while(0) #endif #define F77_CALL_xCx(name,x1,p2,l2,x3) do { \ INT_FUNCPTR _p0_ = (INT_FUNCPTR)name; \ INTEGER _i0_; \ F77_IFUN_xCx(_i0_,_p0_,x1,p2,l2,x3); \ } while(0) #ifdef IBM370 #pragma linkage(K77x4C,FORTRAN) #define F77_CALL_x4C(name,x1,x2,x3,x4,p5,l5) do { \ SUBROUTINE *F77 = name; \ K77x4C(&F77,x1,x2,x3,x4,p5,l5); } while(0) #else #define F77_CALL_x4C(name,x1,x2,x3,x4,p5,l5) do { \ F77_CHAR_DEF_DSC(s5,p5,l5) \ F77_CHAR_ASS_DSC(s5,p5,l5) \ name( x1,x2,x3,x4, \ F77_CHAR_USE_PTR(s5,p5,l5) \ F77_XXXX_USE4LEN(x1,x2,x3,x4) \ F77_CHAR_USE_LEN(s5,p5,l5) \ ); } while(0) #endif #ifdef IBM370 #pragma linkage(K77x4Cxx,FORTRAN) #define F77_CALL_x4Cxx(name,x1,x2,x3,x4,p5,l5,x6,x7) do { \ SUBROUTINE *F77 = name; \ K77x4Cxx(&F77,x1,x2,x3,x4,p5,l5,x6,x7); } while(0) #else #define F77_CALL_x4Cxx(name,x1,x2,x3,x4,p5,l5,x6,x7) do { \ F77_CHAR_DEF_DSC(s5,p5,l5) \ F77_CHAR_ASS_DSC(s5,p5,l5) \ name( x1,x2,x3,x4, \ F77_CHAR_USE_PTR(s5,p5,l5), \ x6,x7 \ F77_XXXX_USE4LEN(x1,x2,x3,x4) \ F77_CHAR_USE_LEN(s5,p5,l5) \ F77_XXXX_USE2LEN(x6,x7) \ ); } while(0) #endif #ifdef IBM370 #pragma linkage(KIGMENU,FORTRAN) /* 1 2 3 4 5 6 7 8 9 10 11 12 13 14 */ #define F77_CALL_xCx5CxC3xC(name,a,b,B,c,d,e,f,g,h,H,i,j,J,k,K,l,L,m,n,N) do {\ SUBROUTINE *F77 = name; \ KIGMENU(&F77,a,b,B,c,d,e,f,g,h,H,i,j,J,k,K,l,L,m,n,N); } while(0) #else #define F77_CALL_xCx5CxC3xC(name,a,b,B,c,d,e,f,g,h,H,i,j,J,k,K,l,L,m,n,N) do {\ F77_CHAR_DEF_DSC(sb,b,B) \ F77_CHAR_DEF_DSC(sh,h,H) \ F77_CHAR_DEF3DSC(sj,j,J,sk,k,K,sl,l,L) \ F77_CHAR_DEF_DSC(sn,n,N) \ F77_CHAR_ASS_DSC(sb,b,B) \ F77_CHAR_ASS_DSC(sh,h,H) \ F77_CHAR_ASS3DSC(sj,j,J,sk,k,K,sl,l,L) \ F77_CHAR_ASS_DSC(sn,n,N) \ name( a, \ F77_CHAR_USE_PTR(sb,b,B), \ c,d,e,f,g, \ F77_CHAR_USE_PTR(sh,h,H), \ i, \ F77_CHAR_USE3PTR(sj,j,J,sk,k,K,sl,l,L), \ m, \ F77_CHAR_USE_PTR(sn,n,N) \ F77_XXXX_USE_LEN(a) \ F77_CHAR_USE_LEN(sb,b,B) \ F77_XXXX_USE5LEN(c,d,e,f,g) \ F77_CHAR_USE_LEN(sh,h,H) \ F77_XXXX_USE_LEN(i) \ F77_CHAR_USE3LEN(sj,j,J,sk,k,K,sl,l,L) \ F77_XXXX_USE_LEN(m) \ F77_CHAR_USE_LEN(sn,n,N) \ ); } while(0) #endif #ifdef IBM370 #define F77_IFUN_x(i0,name,x1) i0 = __CTOF(name,x1) #else #define F77_IFUN_x(i0,name,x1) i0 = (*name)(x1) #endif #ifdef IBM370 #define F77_IFUN_xx(i0,name,x1,x2) i0 = __CTOF(name,x1,x2) #else #define F77_IFUN_xx(i0,name,x1,x2) i0 = (*name)(x1,x2) #endif #ifdef IBM370 #pragma linkage(K77xCx8,FORTRAN) #define F77_IFUN_xCx8(i0,name,x1,p2,l2,x3,x4,x5,x6,x7,x8,x9,x10) do { \ i0 = K77xCx8(&name,x1,p2,l2,x3,x4,x5,x6,x7,x8,x9,x10); } while(0) #else #define F77_IFUN_xCx8(i0,name,x1,p2,l2,x3,x4,x5,x6,x7,x8,x9,x10) do { \ F77_CHAR_DEF_DSC(s2,p2,l2) \ F77_CHAR_ASS_DSC(s2,p2,l2) \ i0 = (*name)( x1, \ F77_CHAR_USE_PTR(s2,p2,l2), \ x3,x4,x5,x6,x7,x8,x9,x10 \ F77_XXXX_USE_LEN(x1) \ F77_CHAR_USE_LEN(s2,p2,l2) \ F77_XXXX_USE8LEN(x3,x4,x5,x6,x7,x8,x9,x10) \ ); } while(0) #endif /* * routines called by Fortran */ #define Errrun F77_NAME(errrun,ERRRUN) #define Fmemcpy F77_NAME(fmemcpy,FMEMCPY) #define Getarg F77_NAME(getarg,GETARG) extern SUBROUTINE Getarg; #define Goparm F77_NAME(goparm,GOPARM) extern SUBROUTINE Goparm; #define Gl_char_cleanup F77_NAME(gl_char_cleanup,GL_CHAR_CLEANUP) #define Gl_reset F77_NAME(gl_reset,GL_RESET) #define Gl_reinit F77_NAME(gl_reinit,GL_REINIT) #define Iclrwk F77_NAME(iclrwk,ICLRWK) extern SUBROUTINE Iclrwk; #define Iginit F77_NAME(iginit,IGINIT) extern SUBROUTINE Iginit; #define Igmenu F77_NAME(igmenu,IGMENU) extern SUBROUTINE Igmenu; #define Igrng F77_NAME(igrng,IGRNG) extern SUBROUTINE Igrng; #define Igsse F77_NAME(igsse,IGSSE) extern SUBROUTINE Igsse; #define Igsrap F77_NAME(igsrap,IGSRAP) extern SUBROUTINE Igsrap; #define Igwkty F77_NAME(igwkty,IGWKTY) extern SUBROUTINE Igwkty; #define Kcexec F77_NAME(kcexec,KCEXEC) #define Kdialo F77_NAME(kdialo,KDIALO) extern SUBROUTINE Kdialo; #define Kgetar F77_NAME(kgetar,KGETAR) #define Kialid F77_NAME(kialid,KIALID) #define Kiargc F77_NAME(kiargc,KIARGC) extern INT_FUNCTION Kiargc; #define Kibres F77_NAME(kibres,KIBRES) extern SUBROUTINE Kibres; #define Kiclos F77_NAME(kiclos,KICLOS) extern SUBROUTINE Kiclos; #define Kicomv F77_NAME(kicomv,KICOMV) #define Kidtab F77_NAME(kidtab,KIDTAB) #define Kierrf F77_NAME(kierrf,KIERRF) extern SUBROUTINE Kierrf; #define Kiinit F77_NAME(kiinit,KIINIT) extern SUBROUTINE Kiinit; #define Kilun F77_NAME(kilun,KILUN) extern SUBROUTINE Kilun; #define Kimath F77_NAME(kimath,KIMATH) #define Kimdef F77_NAME(kimdef,KIMDEF) #define Kimexe F77_NAME(kimexe,KIMEXE) #define Kipawc F77_NAME(kipawc,KIPAWC) #define Kipiaf F77_NAME(kipiaf,KIPIAF) #define Kiprmt F77_NAME(kiprmt,KIPRMT) #define Kirtim F77_NAME(kirtim,KIRTIM) #define Kisigm F77_NAME(kisigm,KISIGM) #define Kivect F77_NAME(kivect,KIVECT) #define Kmpst2 F77_NAME(kmpst2,KMPST2) #define Kmpst3 F77_NAME(kmpst3,KMPST3) #define Kmpx22 F77_NAME(kmpx22,KMPX22) #define Kmpx23 F77_NAME(kmpx23,KMPX23) #define Kmvsed F77_NAME(kmvsed,KMVSED) extern SUBROUTINE Kmvsed; #define Kmvspg F77_NAME(kmvspg,KMVSPG) extern SUBROUTINE Kmvspg; #define Kmvssh F77_NAME(kmvssh,KMVSSH) extern SUBROUTINE Kmvssh; #define Ksvpar F77_NAME(ksvpar,KSVPAR) #define Kuach F77_NAME(kuach,KUACH) #define Kuact F77_NAME(kuact,KUACT) #define Kualfa F77_NAME(kualfa,KUALFA) #define Kuappl F77_NAME(kuappl,KUAPPL) #define Kuargs F77_NAME(kuargs,KUARGS) #define Kubrek F77_NAME(kubrek,KUBREK) #define Kubrof F77_NAME(kubrof,KUBROF) #define Kubron F77_NAME(kubron,KUBRON) #define Kucmd F77_NAME(kucmd,KUCMD) #define Kucmdl F77_NAME(kucmdl,KUCMDL) #define Kucomv F77_NAME(kucomv,KUCOMV) #define Kuedit F77_NAME(kuedit,KUEDIT) #define Kuesvr F77_NAME(kuesvr,KUESVR) #define Kueusr F77_NAME(kueusr,KUEUSR) #define Kuexec F77_NAME(kuexec,KUEXEC) #define Kuexel F77_NAME(kuexel,KUEXEL) #define Kuexit F77_NAME(kuexit,KUEXIT) #define Kufcas F77_NAME(kufcas,KUFCAS) #define Kufdef F77_NAME(kufdef,KUFDEF) #define Kugetc F77_NAME(kugetc,KUGETC) #define Kugete F77_NAME(kugete,KUGETE) #define Kugetf F77_NAME(kugetf,KUGETF) #define Kugeti F77_NAME(kugeti,KUGETI) #define Kugetl F77_NAME(kugetl,KUGETL) #define Kugetq F77_NAME(kugetq,KUGETQ) #define Kugetr F77_NAME(kugetr,KUGETR) #define Kugets F77_NAME(kugets,KUGETS) #define Kugrfl F77_NAME(kugrfl,KUGRFL) #define Kuguid F77_NAME(kuguid,KUGUID) #define Kuhelp F77_NAME(kuhelp,KUHELP) #define Kuhome F77_NAME(kuhome,KUHOME) #define Kuidf1 F77_NAME(kuidf1,KUIDF1) extern SUBROUTINE Kuidf1; #define Kuidf2 F77_NAME(kuidf2,KUIDF2) extern SUBROUTINE Kuidf2; #define Kuidfm F77_NAME(kuidfm,KUIDFM) #define Kuinim F77_NAME(kuinim,KUINIM) #define Kuinit F77_NAME(kuinit,KUINIT) #define Kulun F77_NAME(kulun,KULUN) #define Kumloc F77_NAME(kumloc,KUMLOC) #define Kumout F77_NAME(kumout,KUMOUT) #define Kumpad F77_NAME(kumpad,KUMPAD) #define Kumpst F77_NAME(kumpst,KUMPST) #define Kumpx2 F77_NAME(kumpx2,KUMPX2) #define Kundpv F77_NAME(kundpv,KUNDPV) #define Kunpar F77_NAME(kunpar,KUNPAR) #define Kunwg F77_NAME(kunwg,KUNWG) #define Kuopen F77_NAME(kuopen,KUOPEN) extern SUBROUTINE Kuopen; #define Kupad F77_NAME(kupad,KUPAD) #define Kupar F77_NAME(kupar,KUPAR) #define Kupath F77_NAME(kupath,KUPATH) #define Kupatl F77_NAME(kupatl,KUPATL) #define Kuproc F77_NAME(kuproc,KUPROC) #define Kuprof F77_NAME(kuprof,KUPROF) #define Kuproi F77_NAME(kuproi,KUPROI) #define Kuprop F77_NAME(kuprop,KUPROP) #define Kupror F77_NAME(kupror,KUPROR) #define Kupros F77_NAME(kupros,KUPROS) #define Kumess F77_NAME(kumess,KUMESS) #define Kupval F77_NAME(kupval,KUPVAL) #define Kuqcas F77_NAME(kuqcas,KUQCAS) #define Kuqenv F77_NAME(kuqenv,KUQENV) #define Kuqexe F77_NAME(kuqexe,KUQEXE) #define Kuqsvr F77_NAME(kuqsvr,KUQSVR) #define Kuquit F77_NAME(kuquit,KUQUIT) #define Kusapp F77_NAME(kusapp,KUSAPP) #define Kuser F77_NAME(kuser,KUSER) #define Kuserid F77_NAME(kuserid,KUSERID) #define Kusibr F77_NAME(kusibr,KUSIBR) #define Kusigm F77_NAME(kusigm,KUSIGM) #define Kuspy F77_NAME(kuspy,KUSPY) #define Kustat F77_NAME(kustat,KUSTAT) #define Kustop F77_NAME(kustop,KUSTOP) #define Kuterm F77_NAME(kuterm,KUTERM) #define Kutime F77_NAME(kutime,KUTIME) #define Kutim0 F77_NAME(kutim0,KUTIM0) extern SUBROUTINE Kutim0; #define Kutrue F77_NAME(kutrue,KUTRUE) #define Kuvcre F77_NAME(kuvcre,KUVCRE) extern SUBROUTINE Kuvcre; #define Kuvdel F77_NAME(kuvdel,KUVDEL) extern SUBROUTINE Kuvdel; #define Kuvect F77_NAME(kuvect,KUVECT) extern SUBROUTINE Kuvect; #define Kuvnam F77_NAME(kuvnam,KUVNAM) #define Kuwhag F77_NAME(kuwhag,KUWHAG) #define Kuwham F77_NAME(kuwham,KUWHAM) #define Kuwhat F77_NAME(kuwhat,KUWHAT) #define Kxali1 F77_NAME(kxali1,KXALI1) #define Kxcrv2 F77_NAME(kxcrv2,KXCRV2) extern SUBROUTINE Kxcrv2; #define Macdef F77_NAME(macdef,MACDEF) extern SUBROUTINE Macdef; #define Mdmenu F77_NAME(mdmenu,MDMENU) #define Mhi_close F77_NAME(mhi_close,MHI_CLOSE) extern SUBROUTINE Mhi_close; #define Mhi_open F77_NAME(mhi_open,MHI_OPEN) extern SUBROUTINE Mhi_open; #define Mzwipe F77_NAME(mzwipe,MZWIPE) extern SUBROUTINE Mzwipe; #define Traceq F77_NAME(traceq,TRACEQ) extern SUBROUTINE Traceq; #define Xuflow F77_NAME(xuflow,XUFLOW) extern SUBROUTINE Xuflow; #ifdef IBM370 # pragma linkage(ERRRUN,FORTRAN) # pragma linkage(FMEMCPY,FORTRAN) # pragma linkage(GOPARM,FORTRAN) # pragma linkage(ICLRWK,FORTRAN) # pragma linkage(IGINIT,FORTRAN) # pragma linkage(IGMENU,FORTRAN) # pragma linkage(IGRNG,FORTRAN) # pragma linkage(IGSSE,FORTRAN) # pragma linkage(IGSRAP,FORTRAN) # pragma linkage(IGWKTY,FORTRAN) # pragma linkage(KCEXEC,FORTRAN) # pragma linkage(KDIALO,FORTRAN) # pragma linkage(KGETAR,FORTRAN) # pragma linkage(KIALID,FORTRAN) # pragma linkage(KIBRES,FORTRAN) # pragma linkage(KICLOS,FORTRAN) # pragma linkage(KICOMV,FORTRAN) # pragma linkage(KIDTAB,FORTRAN) # pragma linkage(KIERRF,FORTRAN) # pragma linkage(KIINIT,FORTRAN) # pragma linkage(KILUN,FORTRAN) # pragma linkage(KIMATH,FORTRAN) # pragma linkage(KIMDEF,FORTRAN) # pragma linkage(KIMEXE,FORTRAN) # pragma linkage(KIPAWC,FORTRAN) # pragma linkage(KIPIAF,FORTRAN) # pragma linkage(KIPRMT,FORTRAN) # pragma linkage(KIRTIM,FORTRAN) # pragma linkage(KISIGM,FORTRAN) # pragma linkage(KIVECT,FORTRAN) # pragma linkage(KMPST2,FORTRAN) # pragma linkage(KMPST3,FORTRAN) # pragma linkage(KMPX22,FORTRAN) # pragma linkage(KMPX23,FORTRAN) # pragma linkage(KMVSED,FORTRAN) # pragma linkage(KMVSPG,FORTRAN) # pragma linkage(KMVSSH,FORTRAN) # pragma linkage(KSVPAR,FORTRAN) # pragma linkage(KUACH,FORTRAN) # pragma linkage(KUACT,FORTRAN) # pragma linkage(KUALFA,FORTRAN) # pragma linkage(KUAPPL,FORTRAN) # pragma linkage(KUARGS,FORTRAN) # pragma linkage(KUBREK,FORTRAN) # pragma linkage(KUBROF,FORTRAN) # pragma linkage(KUBRON,FORTRAN) # pragma linkage(KUCMD,FORTRAN) # pragma linkage(KUCMDL,FORTRAN) # pragma linkage(KUCOMV,FORTRAN) # pragma linkage(KUEDIT,FORTRAN) # pragma linkage(KUESVR,FORTRAN) # pragma linkage(KUEUSR,FORTRAN) # pragma linkage(KUEXEC,FORTRAN) # pragma linkage(KUEXEL,FORTRAN) # pragma linkage(KUEXIT,FORTRAN) # pragma linkage(KUFCAS,FORTRAN) # pragma linkage(KUFDEF,FORTRAN) # pragma linkage(KUGETC,FORTRAN) # pragma linkage(KUGETE,FORTRAN) # pragma linkage(KUGETF,FORTRAN) # pragma linkage(KUGETI,FORTRAN) # pragma linkage(KUGETL,FORTRAN) # pragma linkage(KUGETQ,FORTRAN) # pragma linkage(KUGETR,FORTRAN) # pragma linkage(KUGETS,FORTRAN) # pragma linkage(KUGRFL,FORTRAN) # pragma linkage(KUGUID,FORTRAN) # pragma linkage(KUHELP,FORTRAN) # pragma linkage(KUHOME,FORTRAN) # pragma linkage(KUIDF1,FORTRAN) # pragma linkage(KUIDF2,FORTRAN) # pragma linkage(KUIDFM,FORTRAN) # pragma linkage(KUINIM,FORTRAN) # pragma linkage(KUINIT,FORTRAN) # pragma linkage(KULUN,FORTRAN) # pragma linkage(KUMLOC,FORTRAN) # pragma linkage(KUMOUT,FORTRAN) # pragma linkage(KUMPAD,FORTRAN) # pragma linkage(KUMPST,FORTRAN) # pragma linkage(KUMPX2,FORTRAN) # pragma linkage(KUNDPV,FORTRAN) # pragma linkage(KUNPAR,FORTRAN) # pragma linkage(KUNWG,FORTRAN) # pragma linkage(KUOPEN,FORTRAN) # pragma linkage(KUPAD,FORTRAN) # pragma linkage(KUPAR,FORTRAN) # pragma linkage(KUPATH,FORTRAN) # pragma linkage(KUPATL,FORTRAN) # pragma linkage(KUPROC,FORTRAN) # pragma linkage(KUPROF,FORTRAN) # pragma linkage(KUPROI,FORTRAN) # pragma linkage(KUPROP,FORTRAN) # pragma linkage(KUPROR,FORTRAN) # pragma linkage(KUPROS,FORTRAN) # pragma linkage(KUPVAL,FORTRAN) # pragma linkage(KUQCAS,FORTRAN) # pragma linkage(KUQENV,FORTRAN) # pragma linkage(KUQEXE,FORTRAN) # pragma linkage(KUQSVR,FORTRAN) # pragma linkage(KUQUIT,FORTRAN) # pragma linkage(KUSAPP,FORTRAN) # pragma linkage(KUSIBR,FORTRAN) # pragma linkage(KUSIGM,FORTRAN) # pragma linkage(KUSPY,FORTRAN) # pragma linkage(KUSTAT,FORTRAN) # pragma linkage(KUSTOP,FORTRAN) # pragma linkage(KUTERM,FORTRAN) # pragma linkage(KUTIME,FORTRAN) # pragma linkage(KUTIM0,FORTRAN) # pragma linkage(KUTRUE,FORTRAN) # pragma linkage(KUSER,FORTRAN) # pragma linkage(KUVCRE,FORTRAN) # pragma linkage(KUVDEL,FORTRAN) # pragma linkage(KUVECT,FORTRAN) # pragma linkage(KUVNAM,FORTRAN) # pragma linkage(KUWHAG,FORTRAN) # pragma linkage(KUWHAM,FORTRAN) # pragma linkage(KUWHAT,FORTRAN) # pragma linkage(KXALI1,FORTRAN) # pragma linkage(KXCRV2,FORTRAN) # pragma linkage(MACDEF,FORTRAN) # pragma linkage(MDMENU,FORTRAN) # pragma linkage(MHI_CLOSE,FORTRAN) # pragma linkage(MHI_OPEN,FORTRAN) # pragma linkage(MZWIPE,FORTRAN) # pragma linkage(TRACEQ,FORTRAN) # pragma linkage(XUFLOW,FORTRAN) #endif #define MAXCMD 512 /* max length of a command line */ #define MAXEDT 32 /* max length of names in edit server */ #define MAXLEV 10 /* max levels of command name path */ #define MAXSVR 20 /* max number of edit server processes */ /* * The PAWC common is referenced through a pointer to allow the use of * dynamic common blocks on IBM systems. */ #define Pawc kc_pawc EXTERN struct COMMON_PAWC { INTEGER NWPAR; INTEGER IXPAWC; INTEGER IHBOOK; INTEGER IXHIGZ; INTEGER IXKUIP; INTEGER IFENCE[5]; INTEGER LQ[8]; INTEGER DATA[999]; } *Pawc; #define IQ(n) Pawc->DATA[n-1] #define Q(n) (((REAL*)(Pawc->DATA))[n-1]) +KEEP,KCOM_H /* kcom.h: Fortran COMMON blocks */ #define Kcalia F77_BLOCK(kcalia,KCALIA) #define MALIAS 200 EXTERN struct { INTEGER NALIAS; LOGICAL ALIFLG; INTEGER ALITYP[MALIAS]; } F77_COMMON(Kcalia); #define Kcalic F77_BLOCK(kcalic,KCALIC) EXTERN struct { char ALINAM[MALIAS][60]; char ALIVAL[MALIAS][80]; } F77_COMMON(Kcalic); #define Kcbrek F77_BLOCK(kcbrek,KCBREK) EXTERN struct { LOGICAL TRAP; /* flag if signal trapping is enabled */ LOGICAL BRKEN; /* not used, always true */ LOGICAL FIRST; /* only used for Apollo */ LOGICAL FIRSG; /* only used for Apollo */ LOGICAL CLWHAT; /* flag if KUWHAT installed break handler */ LOGICAL CLWHAG; /* flag if KUWHAG installed break handler */ LOGICAL TBFLAG; /* flag if traceback should be printed */ } F77_COMMON(Kcbrek); #define Kcefil F77_BLOCK(kcefil,KCEFIL) EXTERN struct { char EDTFIL[MAXSVR][MAXEDT]; /* file name */ char EDTCMD[MAXSVR][MAXEDT]; /* KUIP command */ } F77_COMMON(Kcefil); #define Kcesvr F77_BLOCK(kcesvr,KCESVR) EXTERN struct { INTEGER NSVFIL; /* number of edited file */ INTEGER NSVCUR; /* pointer to current file */ SUBRPTR IESADD; /* routine set by KUEUSR */ LOGICAL SERVER; /* flag if edit server is used */ } F77_COMMON(Kcesvr); #define Kcexit F77_BLOCK(kcexit,KCEXIT) EXTERN struct { SUBRPTR IEXADD; /* routine set by KUEXIT */ SUBRPTR IUSADD; /* routine set by KUSER */ SUBRPTR NEXADD; /* routine set by KUNEXT */ SUBRPTR IUTADD; /* routine set by KUTERM */ SUBRPTR IQUADD; /* routine set by KUQUIT */ SUBRPTR IBRADD; /* routine set by KUBREK */ LOGICAL LICALL; LOGICAL LICAL2; LOGICAL LICAL3; } F77_COMMON(Kcexit); #define Kcmac F77_BLOCK(kcmac,KCMAC) EXTERN struct { LOGICAL MACTAB; INTEGER NSTLEV; LOGICAL QUITFL; LOGICAL WAITFL; LOGICAL WAITFF; LOGICAL DEBTAB; LOGICAL SKIPFL; LOGICAL HEADFL; INTEGER IONERF; LOGICAL NOEXEC; } F77_COMMON(Kcmac); #define Kcparc F77_BLOCK(kcparc,KCPARC) EXTERN struct { char PARLST[512]; /* interface block for KUSER */ char CLIST[80]; char NOALIN[512]; char COMAND[80]; char CHLAST[512]; char NONPOS[512]; } F77_COMMON(Kcparc); #define Kcsigm F77_BLOCK(kcsigm,KCSIGM) EXTERN struct { SUBRPTR ISIADD; /* routine set by KUSIGM */ INTEGER NVSIGM; /* number of temp vectors create for $SIGMA */ } F77_COMMON(Kcsigm); #define Kcutil F77_BLOCK(kcutil,KCUTIL) EXTERN struct { INTEGER NCMD; INTEGER IWD; INTEGER LUNFIL; INTEGER LPRMPT; LOGICAL TIMING; LOGICAL TRACE; INTEGER CALMOD; INTEGER NVADD; INTEGER IREPET; INTEGER IREFAC; INTEGER IBRAK; LOGICAL TIMALL; INTEGER LENTER; LOGICAL UNIQUE; INTEGER LENMUL; LOGICAL MULTFL; LOGICAL HISTOK; LOGICAL NOHIST; INTEGER LENMUM; LOGICAL FILCAS; LOGICAL MEXEFL; } F77_COMMON(Kcutil); #define Kcvect F77_BLOCK(kcvect,KCVECT) EXTERN struct { INTEGER NUMVEC; /* number of vectors stored */ INTEGER TOTPAV; INTEGER GETPAV; LOGICAL TVECFL; } F77_COMMON(Kcvect); #define Quest F77_BLOCK(quest,QUEST) EXTERN struct { INTEGER DATA[100]; } F77_COMMON(Quest); #define IQUEST(n) Quest.DATA[n-1] #define Sikuip F77_BLOCK(sikuip,SIKUIP) EXTERN struct { char CHSIGM[80]; /* command string passed to SIGMA */ } F77_COMMON(Sikuip); +KEEP,KSIG_H /* ksig.h: signal and break handling */ /* * Available signal handling package * * #define SIGNAL_POSIX ==> sigaction() for Unix * #define SIGNAL_BSD ==> sigvec() for VMS and NeXT * #define SIGNAL_V7 ==> signal() */ #if !defined(SIGNAL_BSD) && !defined(SIGNAL_V7) # define SIGNAL_POSIX #else # define sigjmp_buf jmp_buf # define sigsetjmp(buf,save) setjmp(buf) # define siglongjmp(buf,val) longjmp(buf,val) # ifdef vms # define sv_flags sv_onstack # endif #endif EXTERN struct { int trap_enabled; /* flag if exceptions should be trapped */ int traceback; /* print traceback on signal */ char *error_msg; /* messages is handler cannot do print */ int intr_count; /* count number of consecutive ^C interrupts */ int soft_intr; /* flag to stop at a convenient point */ int jump_set; /* flag if stack has been setup */ sigjmp_buf stack; int sockfd; /* socket descriptor and routine to */ void (*piaf_sync)(); /* resynchronize Piaf communication */ } kc_break; +KEEP,KBROW_H /* kbrow.h: browser definitions */ #define KBROW_H1 \ +SEQ,KBROW_H1 KBROW_H1 #define KBROW_H2 \ +SEQ,KBROW_H2 KBROW_H2 typedef struct _KmObject { struct _KmObject *next; /* link to next object definition */ char *name; /* unique identifier name */ char *stext; /* short description text */ char *ltext; /* long description text */ KmClass *class; /* pointer to objects's class structure */ } KmObject; typedef struct _BrVariable { struct _BrVariable *next; /* link to next variable definition */ char *name; /* variable name */ char *value; /* replacement value */ } BrVariable; typedef struct _BrObject { struct _BrObject *next; /* link to next browsable object */ char *name; /* name of the browsable object */ BrClass *class; /* pointer to browsable's class structure */ BrVariable *vars; /* linked list of variable substitutions */ } BrObject; typedef struct _BrClientdata { BrActTag tag; char *brobj; char *brcls; char *path; char *kmobj; char *kmcls; char *stext; char *ltext; char *mtext; } BrClientdata; EXTERN BrClass *brclasses; EXTERN KmObject *kmobjects; EXTERN KmButton *kmbuttons; extern C_PROTO_2(void klnkbrcl, BrClass*, int); extern C_PROTO_2(void klnkkmcl, KmClass*, int); extern C_PROTO_2(void klnkicon, KmIcon*, int); extern C_PROTO_2(void klnkbutt, KmButton*, int); extern C_PROTO_6(void exec_action, BrAction*, char*, char*, int, KmWidget, KmCalldata); extern C_PROTO_2(KmWidget find_button, char*, char*); extern C_PROTO_1(KmIcon* find_kmicon, char*); extern C_PROTO_1(KmClass* find_kmclass, char*); extern C_PROTO_1(BrObject* find_brobject, char*); extern C_PROTO_2(char* get_variable, char*, char*); extern C_PROTO_0(BrObject* scan_brobjects); extern C_PROTO_3(KmObject* scan_kmobjects, char*, char*, int); extern C_PROTO_7(int set_action, char*, int, int, char*, char*, int, int); extern C_PROTO_3(void set_variable, BrObject*, char*, char*); +KEEP,KLINK_H /* klink.h: demand linking of special routines */ #define KLINK_H1 EXTERN \ +SEQ,KLINK_H1 KLINK_H1 EXTERN struct { SUBROUTINE *user_exit_F; /* set by KUEXIT */ SUBROUTINE *user_quit_F; /* set by KUQUIT */ SUBROUTINE *user_break_F; /* set by KUBREK */ SUBROUTINE *user_edit_F; /* set by KUEUSR */ SUBROUTINE *user_comis_F; /* set by KUCOMV */ SUBROUTINE *user_sigma_F; /* set by KUSIGM */ SUBROUTINE *user_grfl_F; /* set by KUGRFL */ SUBROUTINE *user_term_F; /* set by KUTERM */ SUBROUTINE *user_input_F; /* set by KUSER */ SUBROUTINE *user_locate_F; /* set by KUMLOC */ /* indirect calls to avoid linking Motif */ IntFunc *disp_panel_C; /* display command panel (km_display_cmdpan) */ IntFunc *disp_kpanel_C; /* display KUIP panel (km_display_kpanel) */ IntFunc *disp_text_C; /* display text widget (km_display_sctext) */ IntFunc *disp_choice_C; /* display a choice of commands (?) */ IntFunc *disp_clean_C; /* clean before action (km_destroy_all_popup)*/ IntFunc *disp_flush_C; /* flush event queue (FlushEvents) */ IntFunc *disp_busy_C; /* show busy cursor (km_all_cursor) */ IntFunc *disp_exit_C; /* ask confirmation for exit */ IntFunc *disp_quit_C; /* ask confirmation for exit */ IntFunc *disp_select_C; /* select from a number of buttons */ IntFunc *disp_cmd_list_C; /* display list of commands (km_print_list) */ CharFunc *disp_prompt_C; /* prompt for input */ CharFunc *disp_passwd_C; /* prompt for password input */ /* indirect calls to avoid linking HIGZ without style G */ IntFunc *higz_init_C; /* initialize menu mode */ SUBROUTINE *higz_menu_F; /* IGMENU */ } kjmpaddr; +KEEP,KFLAG_H typedef enum { KmMACRO_COMMAND = 0, /* don't look for macros */ KmMACRO_AUTO, /* look for macros before commands */ KmMACRO_AUTOREVERSE /* look for macros after commands */ } KmMacOrder; typedef enum { KmSTYLE_A = 0x0001, /* Alpha menus */ KmSTYLE_C = 0x0002, /* Command line */ KmSTYLE_G = 0x0004, /* Graphics menus */ KmSTYLE_M = 0x0008, /* Model Human Interface */ KmSTYLE_U = 0x0010, /* User */ KmSTYLE_XM = 0x0020, /* Motif/X11 */ KmSTYLE_major = 0x00FF, /* A..X are mutually exclusive */ KmSTYLE_xL = 0x0100, /* Alpha Letter menus */ KmSTYLE_xP = 0x0200, /* Panel style GP or MP */ KmSTYLE_xS = 0x0400, /* Graphics with Software fonts */ KmSTYLE_xW = 0x0800 /* Graphics with shadowed Width */ } KmStyleFlag; typedef enum { KmTIMING_OFF, /* no timing */ KmTIMING_ON, /* time typed commands */ KmTIMING_ALL /* time individual commands inside macro */ } KmTiming; EXTERN struct { LOGICAL f77_true; /* value of .TRUE. */ LOGICAL f77_false; /* value of .FALSE. */ int do_exit; /* set by KXEXIT */ int do_quit; /* set by KXQUIT */ char *curr_prompt; /* current prompt string */ char *last_cmd; /* last command for $LAST */ KmTiming timing; /* timing on/off/all */ time_t real_time; /* real time at last timing off */ clock_t user_time; /* CPU time at last timing off */ int in_macro; /* command executed in macro */ int in_application; /* application mode is active */ int appl_called; /* application is executing */ char *appl_exit; /* string which leaves application mode */ KmCommand *appl_cmd; /* command which handles application */ char appl_file[256]; /* temporary file to pass application text */ FILE *appl_stream; /* C stream used for writing appl_file */ int appl_luno; /* Fortran logical unit opened for appl_file */ char help_file[256]; /* temporary file to view help text */ char uhlp_file[256]; /* temporary file to get user help text */ int uhlp_luno; /* Fortran logical unit opened for user help */ int in_motif; /* Motif mode is active */ int echo_command; /* echo commands in Motif mode */ char *echo_prompt; /* prompt string for echo commands */ KmStyleFlag style; /* input mode */ int keep_fcase; /* flag if no case conversion for filenames */ int use_kxterm; /* flag if kxterm should be used */ int use_server; /* flag if edit server should be used */ int editor_exit; /* flag set if edit server sent SIGUSR1 */ char *editor_cbuf; /* buffer of for edit servers commands */ char *macro_path; /* MACRO/DEFAULT search path */ KmMacOrder macro_search; /* MACRO/DEFAULT search order */ int temp_vectors; /* number of ?SIGMA vectors */ char init_wdir[256]; /* initial working directory */ } kc_flags; EXTERN struct { char *set_break; /* SET_SHOW/BREAK */ char set_columns[8]; /* SET_SHOW/COLUMNS */ char *set_command; /* SET_SHOW/COMMAND */ char *set_filecase; /* SET_SHOW/FILECASE */ char *set_host_editor; /* SET_SHOW/HOST_EDITOR */ char *set_host_pager; /* SET_SHOW/HOST_PAGER */ char *set_host_shell; /* SET_SHOW/HOST_SHELL */ char *set_prompt; /* SET_SHOW/PROMPT */ char *set_recall_style; /* SET_SHOW/RECALL_STYLE */ char set_recording[8]; /* SET_SHOW/RECORDING */ char *set_root; /* SET_SHOW/ROOT */ char *set_style; /* SET_SHOW/STYLE */ char *set_timing; /* SET_SHOW/TIMING */ char *help_edit; /* HELP edit mode */ char *defaults_path; /* MACRO/DEFAULTS search path */ char *defaults_order; /* MACRO/DEFAULTS search order */ } kc_value; typedef struct { int top; int left; int width; int height; } KmWindowDsc; EXTERN struct { KmWindowDsc edit_pad; /* coordinates for edit window */ KmWindowDsc help_pad; /* coordinates for readonly window */ int voffset; /* vertical offset */ int hoffset; /* horizontal offset */ int shift_max; /* maximum number of shifted pads */ int shift_now; /* current shift count */ int shift_dir; /* shift direction +/-1 */ int is_a_pad; /* flag if running in an Apollo DM pad */ int is_a_tty; /* flag if stdin and stdout at terminal */ int use_getline; /* flag for using getline() or normal read */ int use_no_echo; /* flag for using no echo in password prompt */ int term_width; /* terminal width in columns */ int kuwhag_called; /* allow style G */ float sgylen; float sgsize; float sgyspa; float sgbord; int panel_rows; /* number of rows in style GP panel */ int *panel_cols; /* number of columns in each row */ char ***panel_keys; /* key labels */ char *panel_keynum; /* value of $KEYNUM */ char *panel_keyval; /* value of $KEYVAL */ } kc_window; extern C_PROTO_1(char* style_name, KmStyleFlag); +KEEP,KMENU_H /* kmenu.h: data structures for menu and command definitions */ #define KMENU_H1 \ +SEQ,KMENU_H1 KMENU_H1 #define KMENU_H2 \ +SEQ,KMENU_H2 KMENU_H2 #define KMENU_H3 \ +SEQ,KMENU_H3 KMENU_H3 /* * temporary fix until we can reserve an extra word in KmCommand structure * to count keyboard and macro commands separately */ #define XCOUNT_SHIFT 10 #define XCOUNT_OFFSET (1 << XCOUNT_SHIFT) #define XCOUNT_MASK (XCOUNT_OFFSET - 1) extern C_PROTO_2(void check_version, int, int); extern C_PROTO_0(void check_edit_server); extern C_PROTO_3(int exec_cmd_string, char*, int, int(*)()); extern C_PROTO_1(int exec_decoded_cmd, KmCommand*); extern C_PROTO_1(KmMenu* find_submenu, char*); extern C_PROTO_2(char* fmt_cmd_help, KmCommand*, int); extern C_PROTO_0(void menu_style); extern C_PROTO_2(void print_cmd_list, KmCommand**, char*); extern C_PROTO_1(void reset_arg_list, KmCommand*); extern C_PROTO_1(KmMenu** root_menu_list, char*); extern C_PROTO_2(KmCommand* search_command, char*, KmCommand***); +KEEP,KHASH_H /* khash.h: hash table management */ typedef struct _HashArray { char *name; /* symbol name */ void *value; /* symbol value */ } HashArray; typedef struct _HashEntry { struct _HashEntry *next; /* link to next entry */ char *name; /* symbol name */ void *value; /* symbol value */ } HashEntry; typedef struct { int size; /* table size should be a prime number */ HashEntry **entries; /* pointer to array of size entries */ int nentries; /* number of entries */ int copy; /* flag if strdup/free(value) should be used */ } HashTable; #define ALIAS_TABLE_SIZE 97 /* should be a prime */ EXTERN struct { int translate; /* flag if translation wanted */ int substitutions; /* how many more before recursive alarm */ HashTable *arg_table; /* Argument alias table */ HashTable *cmd_table; /* Command alias table */ HashTable *var_table; /* macro variables */ } kc_alias; extern C_PROTO_2(HashTable* hash_create, int, int); extern C_PROTO_1(void hash_clear, HashTable*); extern C_PROTO_1(void hash_destroy, HashTable*); extern C_PROTO_3(void hash_insert, HashTable*, const char*, void*); extern C_PROTO_2(void hash_remove, HashTable*, const char*); extern C_PROTO_2(void* hash_lookup, HashTable*, const char*); extern C_PROTO_1(int hash_entries, HashTable*); extern C_PROTO_1(HashArray* hash_array, HashTable*); extern C_PROTO_1(int match_paren, char*); extern C_PROTO_1(char* repl_variable, char*); extern C_PROTO_2(char* repl_sysfun, char*, int); extern C_PROTO_1(char* subst_arg_alias, char*); extern C_PROTO_1(char* subst_cmd_alias, char*); extern C_PROTO_1(char* subst_var_alias, char*); extern C_PROTO_2(char* subst_sysfun, char*, int); extern C_PROTO_1(char* var_value, char*); +KEEP,MKTERM. #define ESCAPE "#@" typedef void (*KxtermActionProc)( #ifndef NO_PROTOTYPES char** /* params */, int /* num_params */ #endif ); typedef struct _KxtermActionsRec{ char *string; KxtermActionProc proc; } KxtermActionsRec; typedef KxtermActionsRec *KxtermActionList; extern C_PROTO_1(void kxterm_add_actions, KxtermActionList); extern C_PROTO_1(void handle_kxterm_action, char *); extern C_PROTO_1(void send_kxterm_cmd, char**); extern C_PROTO_1(void send_single_kxterm_cmd, char*); +DECK,hkuip_93b,IF=93B. +KEEP,KHAIX370 #ifndef AIX370 # define AIX370 #endif +KEEP,KHAPOFTN #ifndef APOLLO_FTN # define APOLLO_FTN #endif +KEEP,KHIBMVM #ifndef IBMVM # define IBMVM #endif +KEEP,KHIBMMVS #ifndef IBMMVS # define IBMMVS #endif +KEEP,KHNEWLIB #ifndef NEWLIB # define NEWLIB #endif +KEEP,KUIP_H #ifndef KUIP_H_INCLUDED #define KUIP_H_INCLUDED /* kuip.h: system dependent defines */ /* update version if structures have changed */ #define KUIP_VERSION 921023 /* identify system if not possible from preprocessor defines */ +SEQ,KHAIX370,IF=AIX370 +SEQ,KHAPOFTN,IF=APOFTN +SEQ,KHIBMVM ,IF=IBMVM +SEQ,KHIBMMVS,IF=IBMMVS +SEQ,KHNEWLIB,IF=NEWLIB #ifdef AIX370 # define MACHINE_NAME "IBMAIX" # define UNIX # define F77_EXTERN_INDIRECT #endif #if defined(apollo) || defined(__apollo) # define MACHINE_NAME "APOLLO" # define APOLLO # define UNIX # include # include # include # include # include # ifdef APOLLO_FTN /* using /com/ftn instead of /bin/f77 */ # define F77_CHAR_LEN_IND short # define F77_EXTERN_LOWERCASE # endif # define F77_EXTERN_INDIRECT # define F77_COMMON(name) name __attribute((__section(name))) # ifndef EXTERN # define EXTERN /* essential for accessing COMMON blocks */ # endif # define FATAL_SIGFPE # define HAVE_STRCASECMP # define HAVE_STRDUP #endif #ifdef CRAY # define MACHINE_NAME "CRAY" # define UNIX # include # define F77_EXTERN_UPPERCASE # define F77_CHAR_DSC_CRAY # ifndef EXTERN # define EXTERN /* essential for accessing COMMON blocks */ # endif # define HAVE_STRCASECMP # define HAVE_STRDUP # define NO_EDIT_SERVER #endif #if defined(hpux) || defined(__hpux) # define MACHINE_NAME "HPUX" # define HPUX # define UNIX # ifdef hpux /* cc -Ac */ # define NO_ANSI_CPP # define NO_PROTOTYPES # endif # ifndef _HPUX_SOURCE # define _HPUX_SOURCE # endif # define FATAL_SIGFPE /* needs f77 +T and ON REAL UNDERFLOW IGNORE */ # define HAVE_STRCASECMP # define HAVE_STRDUP # define HAVE_STRRSTR #endif #ifdef _IBMR2 # define IBMRT # define MACHINE_NAME "IBMRT" # define UNIX # define HAVE_STRCASECMP # define HAVE_STRDUP #endif #ifdef IBMVM # define ARG_STYLE_CMS # define MACHINE_NAME "IBM" # define OS_NAME "VM" # ifndef IBM370 # define IBM370 # endif #endif #ifdef IBMMVS # define MACHINE_NAME "IBMMVS" # define OS_NAME "MVS" # ifndef IBM370 # define IBM370 # endif #endif #ifdef IBM370 # define F77_CHAR_LEN_IND int /* each parameter has a length argument ! */ # define F77_XXXX_ARG_LEN(x) F77_CHAR_ARG_LEN(x) # define F77_EXTERN_INDIRECT # define F77_EXTERN_UPPERCASE # define NO_FCNTL_H # define NO_UNISTD_H # define SIGNAL_V7 #endif #ifdef MSDOS # define MACHINE_NAME "MSDOS" # include # define F77_INTEGER_IS_LONG # define SIGNAL_V7 #endif #ifdef NeXT # define MACHINE_NAME "NEXT" # define UNIX # define getcwd(path,maxlen) getwd(path) # define F77_BLOCK(lc,uc) lc # define F77_EXTERN_INDIRECT /* each parameter has a length argument ! */ # define F77_XXXX_ARG_LEN(x) F77_CHAR_ARG_LEN(x) # define F77_XXXX_USE_LEN(x) ,286716 /* don't know if value matters */ # define HAVE_VFORK # define MATCH_RE_COMP /* use re_comp/re_exec */ # define NO_DIRENT_H # define NO_UNISTD_H # define SIGNAL_BSD #endif #ifdef __osf__ # define UNIX # ifdef __alpha # define ALPHA # define MACHINE_NAME "ALPHA" # endif # include /* struct timeval for gettimeofday() */ # define const /* wrong prototype for strdup() in string.h */ # define HAVE_STRCASECMP # define HAVE_STRDUP #endif #if defined(sgi) || defined(__sgi) # define MACHINE_NAME "SGI" # define SGI # define UNIX # ifndef __sgi /* Irix 3 */ # define NO_ANSI_CPP # define NO_PROTOTYPES # endif # define HAVE_STRCASECMP # define HAVE_STRDUP #endif #if defined(sun) || defined(__sun) # define MACHINE_NAME "SUN" # define SUN # define UNIX # ifndef __STDC__ /* cc vs. acc */ # define NO_ANSI_CPP # define NO_PROTOTYPES # else # define const /* wrong prototype for strdup() in string.h */ # endif # define HAVE_STRCASECMP # define HAVE_STRDUP # define HAVE_VFORK # include # define MATCH_RE_COMP /* use re_comp/re_exec */ #endif #if defined(ultrix) || defined(__ultrix) # define MACHINE_NAME "DECS" # define ULTRIX # define UNIX # ifndef __ultrix /* cc vs. c89 */ # define NO_ANSI_CPP # define NO_PROTOTYPES # endif # define HAVE_STRCASECMP # define HAVE_VFORK #endif #ifdef vms # define OS_NAME "VMS" # ifdef __ALPHA # define ALPHA # define MACHINE_NAME "ALPHA" # pragma extern_model common_block # else # define MACHINE_NAME "VAX" # define NO_ANSI_CPP # define raise gsignal /* raise() not in library ? */ # endif # include # include /* lib$... prototypes */ # include # include # include # include /* sys$... prototypes */ # include # include # include # ifndef R_OK /* no access() modes in unixio.h on VAX/VMS */ # define F_OK 0 # define X_OK 1 # define W_OK 2 # define R_OK 4 # endif # define ARG_STYLE_VMS # define F77_CHAR_DSC_VMS # define F77_EXTERN_LOWERCASE # define HAVE_STAT_H # define HAVE_VFORK /* actually have only vfork */ # define NO_FCNTL_H # define NO_UNISTD_H # define SIGNAL_BSD # define sigmask(sig) (1L << (sig-1)) /* should be in signal.h */ #endif /* vms */ #include #include #include #ifndef NO_FCNTL_H #include #endif #include /* contains strtod() and strtol() on some systems */ #include #include #include #include #include #include #ifndef NO_UNISTD_H #include #endif #ifndef HAVE_VFORK # define vfork fork #endif #ifdef UNIX # define OS_NAME "UNIX" # ifndef unix # define unix # endif # include # include # include # ifndef NO_DIRENT_H /* POSIX opendir() */ # include # else /* BSD opendir() */ # include /* plus */ # define dirent direct /* struct dirent... */ # define S_IRUSR (S_IREAD) /* read permission, owner */ # define S_IWUSR (S_IWRITE) /* write permission, owner */ # define S_IXUSR (S_IEXEC) /* execute/search permission, owner */ # endif # define HAVE_STAT_H # ifndef NO_EDIT_SERVER # define USE_EDIT_SERVER # endif #endif #ifdef SUN # ifndef CLOCKS_PER_SEC # define CLOCKS_PER_SEC 1000000 /* missing in time.h */ # define difftime(t1,t0) ((double)(t1-t0)) # define raise(sig) kill(getpid(),sig) # endif #endif #ifndef CLOCKS_PER_SEC # define CLOCKS_PER_SEC 100 /* missing in VAX/VMS time.h */ #endif #ifdef HAVE_STAT_H # define KmTimeStamp struct stat # define get_stamp(path,stamp) stat(path,stamp) # define cmp_stamp(stamp1,stamp2) ((stamp2)->st_mtime == (stamp1)->st_mtime) #endif #ifndef KmTimeStamp # define KmTimeStamp int # define get_stamp(path,stamp) 0 # define cmp_stamp(stamp1,stamp2) 0 #endif #ifdef MATCH_RE_COMP extern char *re_comp(); extern int re_exec(); #else extern char *regcmp(); extern char *regex(); #endif /* command line arguments recognized by KUARGS */ #if !defined(ARG_STYLE_CMS) && !defined(ARG_STYLE_VMS) # define ARG_STYLE_UNIX #endif #ifndef MACHINE_NAME # define MACHINE_NAME "UNKNOWN" /* value returned by $MACHINE */ #endif #ifndef OS_NAME # define OS_NAME "UNKNOWN" /* value returned by $OS */ #endif /* #define EXTERN must be in one routine to allocate space for globals */ #ifndef EXTERN # define EXTERN extern #endif /* #define STATIC extern if debugger does not see static functions */ #ifndef STATIC # define STATIC static #endif #if defined(__GNUC__) || defined(__STDC__) # ifdef NO_ANSI_CPP # undef NO_ANSI_CPP # endif # ifdef NO_PROTOTYPES # undef NO_PROTOTYPES # endif #endif /* * Preprocessor syntax for token concatenation */ #ifndef NO_ANSI_CPP # define ConCat(con,cat) con##cat #else # define ConCat(con,cat) con/**/cat #endif /* * Prototyping for C functions */ #ifndef NO_PROTOTYPES # define C_PROTO_0(name) \ name(void) # define C_PROTO_1(name,arg1) \ name(arg1) # define C_PROTO_2(name,arg1,arg2) \ name(arg1,arg2) # define C_PROTO_3(name,arg1,arg2,arg3) \ name(arg1,arg2,arg3) # define C_PROTO_4(name,arg1,arg2,arg3,arg4) \ name(arg1,arg2,arg3,arg4) # define C_PROTO_5(name,arg1,arg2,arg3,arg4,arg5) \ name(arg1,arg2,arg3,arg4,arg5) # define C_PROTO_6(name,arg1,arg2,arg3,arg4,arg5,arg6) \ name(arg1,arg2,arg3,arg4,arg5,arg6) # define C_PROTO_7(name,arg1,arg2,arg3,arg4,arg5,arg6,arg7) \ name(arg1,arg2,arg3,arg4,arg5,arg6,arg7) # define C_PROTO_8(name,arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8) \ name(arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8) # define C_PROTO_9(name,arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8,arg9) \ name(arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8,arg9) # define C_PROTO_13(name,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13) \ name(a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13) # define \ C_PROTO_16(name,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14,a15,a16) \ name(a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14,a15,a16) # define C_DECL_0(name) \ name() # define C_DECL_1(name,t1,p1) \ name(t1 p1) # define C_DECL_2(name,t1,p1,t2,p2) \ name(t1 p1,t2 p2) # define C_DECL_3(name,t1,p1,t2,p2,t3,p3) \ name(t1 p1,t2 p2,t3 p3) # define C_DECL_4(name,t1,p1,t2,p2,t3,p3,t4,p4) \ name(t1 p1,t2 p2,t3 p3,t4 p4) # define C_DECL_5(name,t1,p1,t2,p2,t3,p3,t4,p4,t5,p5) \ name(t1 p1,t2 p2,t3 p3,t4 p4,t5 p5) # define C_DECL_6(name,t1,p1,t2,p2,t3,p3,t4,p4,t5,p5,t6,p6) \ name(t1 p1,t2 p2,t3 p3,t4 p4,t5 p5,t6 p6) # define C_DECL_7(name,t1,p1,t2,p2,t3,p3,t4,p4,t5,p5,t6,p6,t7,p7) \ name(t1 p1,t2 p2,t3 p3,t4 p4,t5 p5,t6 p6,t7 p7) # define C_DECL_8(name,t1,p1,t2,p2,t3,p3,t4,p4,t5,p5,t6,p6,t7,p7,t8,p8) \ name(t1 p1,t2 p2,t3 p3,t4 p4,t5 p5,t6 p6,t7 p7,t8 p8) # define C_DECL_9(name,t1,p1,t2,p2,t3,p3,t4,p4,t5,p5,t6,p6,t7,p7,t8,p8,t9,p9)\ name(t1 p1,t2 p2,t3 p3,t4 p4,t5 p5,t6 p6,t7 p7,t8 p8,t9 p9) # define C_DECL_13(name,t1,p1,t2,p2,t3,p3,t4,p4,t5,p5,t6,p6,t7,p7,t8,p8,\ t9,p9,t10,p10,t11,p11,t12,p12,t13,p13) \ name(t1 p1,t2 p2,t3 p3,t4 p4,t5 p5,t6 p6,t7 p7,t8 p8,\ t9 p9,t10 p10,t11 p11,t12 p12,t13 p13) #else # define const # define C_PROTO_0(name) \ name() # define C_PROTO_1(name,arg1) \ name() # define C_PROTO_2(name,arg1,arg2) \ name() # define C_PROTO_3(name,arg1,arg2,arg3) \ name() # define C_PROTO_4(name,arg1,arg2,arg3,arg4) \ name() # define C_PROTO_5(name,arg1,arg2,arg3,arg4,arg5) \ name() # define C_PROTO_6(name,arg1,arg2,arg3,arg4,arg5,arg6) \ name() # define C_PROTO_7(name,arg1,arg2,arg3,arg4,arg5,arg6,arg7) \ name() # define C_PROTO_8(name,arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8) \ name() # define C_PROTO_9(name,arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8,arg9) \ name() # define C_PROTO_13(name,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13) \ name() #define C_PROTO_16(name,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14,a15,a16)\ name() # define C_DECL_0(name) \ name() # define C_DECL_1(name,t1,p1) \ name( p1) \ t1 p1; # define C_DECL_2(name,t1,p1,t2,p2) \ name( p1, p2) \ t1 p1;t2 p2; # define C_DECL_3(name,t1,p1,t2,p2,t3,p3) \ name( p1, p2, p3) \ t1 p1;t2 p2;t3 p3; # define C_DECL_4(name,t1,p1,t2,p2,t3,p3,t4,p4) \ name( p1, p2, p3, p4) \ t1 p1;t2 p2;t3 p3;t4 p4; # define C_DECL_5(name,t1,p1,t2,p2,t3,p3,t4,p4,t5,p5) \ name( p1, p2, p3, p4, p5) \ t1 p1;t2 p2;t3 p3;t4 p4;t5 p5; # define C_DECL_6(name,t1,p1,t2,p2,t3,p3,t4,p4,t5,p5,t6,p6) \ name( p1, p2, p3, p4, p5, p6) \ t1 p1;t2 p2;t3 p3;t4 p4;t5 p5;t6 p6; # define C_DECL_7(name,t1,p1,t2,p2,t3,p3,t4,p4,t5,p5,t6,p6,t7,p7) \ name( p1, p2, p3, p4, p5, p6, p7) \ t1 p1;t2 p2;t3 p3;t4 p4;t5 p5;t6 p6;t7 p7; # define C_DECL_8(name,t1,p1,t2,p2,t3,p3,t4,p4,t5,p5,t6,p6,t7,p7,t8,p8) \ name( p1, p2, p3, p4, p5, p6, p7, p8) \ t1 p1;t2 p2;t3 p3;t4 p4;t5 p5;t6 p6;t7 p7;t8 p8; # define C_DECL_9(name,t1,p1,t2,p2,t3,p3,t4,p4,t5,p5,t6,p6,t7,p7,t8,p8,t9,p9)\ name( p1, p2, p3, p4, p5, p6, p7, p8, p9)\ t1 p1;t2 p2;t3 p3;t4 p4;t5 p5;t6 p6;t7 p7;t8 p8;t9 p9; # define C_DECL_13(name,A,a,B,b,C,c,D,d,E,e,F,f,G,g,H,h,I,i,J,j,K,k,L,l,M,m)\ name( a, b, c, d, e, f, g, h, i, j, k, l, m)\ A a;B b;C c;D d;E e;F f;G g;H h;I i;J j;K k;L l;M m; #endif typedef int IntFunc(); typedef char* CharFunc(); typedef char** pCharFunc(); /* valid characters to build KUIP identifiers */ #define isident(c) ( isalnum(c) || ((c)=='_') || ((c)=='@') || ((c)==('$')) ) #define KUMAC_UNWIND -30041961 /* error status to quit macro execution */ /* * convenience functions from kkern.c */ extern C_PROTO_2(char* fexpand, const char*, const char*); extern C_PROTO_3(char* fsearch, const char*, const char*, const char*); extern C_PROTO_2(char* fstrdup, const char*, size_t); extern C_PROTO_2(char* fstr0dup, const char*, size_t); extern C_PROTO_2(char* fstrtrim, const char*, size_t); extern C_PROTO_2(char* fstr0trim, const char*, size_t); extern C_PROTO_2(size_t fstrlen, const char*, size_t); extern C_PROTO_3(size_t fstrset, char*, size_t, const char*); extern C_PROTO_2(double fstrtod, char*, char**); extern C_PROTO_2(int fstrtoi, char*, char**); extern C_PROTO_3(char* fstrvec, char**, int, int*); #ifndef HAVE_STRCASECMP extern C_PROTO_2(int strcasecmp, const char*, const char*); extern C_PROTO_3(int strncasecmp, const char*, const char*, size_t); #endif #ifndef HAVE_STRDUP extern C_PROTO_1(char* strdup, const char*); #endif #ifndef HAVE_STRRSTR extern C_PROTO_2(char* strrstr, const char*, const char*); #endif extern C_PROTO_1(char* str0dup, const char*); extern C_PROTO_2(char* str2dup, const char*, const char*); extern C_PROTO_3(char* str3dup, const char*, const char*, const char*); extern C_PROTO_4(char* str4dup, const char*, const char*, const char*, const char*); extern C_PROTO_5(char* str5dup, const char*, const char*, const char*, const char*, const char*); extern C_PROTO_2(char* strndup, const char*, int); extern C_PROTO_2(char* mstrcat, char*, const char*); extern C_PROTO_3(char* mstr2cat, char*, const char*, const char*); extern C_PROTO_4(char* mstr3cat, char*, const char*, const char*, const char*); extern C_PROTO_5(char* mstr4cat, char*, const char*, const char*, const char*, const char*); extern C_PROTO_3(char* mstrncat, char*, const char*, int); extern C_PROTO_3(char* mstrccat, char*, int, int); extern C_PROTO_2(char* mstricat, char*, int); extern C_PROTO_2(int mstrlen, char**, int); extern C_PROTO_1(char* strqtok, char*); extern C_PROTO_1(char* strlower, char*); extern C_PROTO_1(char* strupper, char*); extern C_PROTO_2(char* strfromd, double, int); extern C_PROTO_2(char* strfromi, int, int); /* * C-interface functions */ extern C_PROTO_0(char* k_getar); extern C_PROTO_2(void k_setar, int, char**); extern C_PROTO_0(void ku_alfa); extern C_PROTO_2(char* ku_appl, int*, int*); extern C_PROTO_1(void ku_cmdl, char*); extern C_PROTO_2(int ku_edit, char*, int); extern C_PROTO_1(int ku_exec, char*); extern C_PROTO_1(int ku_exel, char*); extern C_PROTO_0(char* ku_getc); extern C_PROTO_0(char* ku_gete); extern C_PROTO_0(char* ku_getf); extern C_PROTO_0(int ku_geti); extern C_PROTO_0(char* ku_getl); extern C_PROTO_0(char* ku_getq); extern C_PROTO_0(double ku_getr); extern C_PROTO_0(char* ku_gets); extern C_PROTO_1(char* ku_fcase, char*); extern C_PROTO_2(char* ku_home, char*, char*); extern C_PROTO_1(int ku_intr, int); extern C_PROTO_2(int ku_more, char*, char*); extern C_PROTO_0(int ku_npar); extern C_PROTO_2(void ku_pad, char*, int); extern C_PROTO_0(char* ku_path); extern C_PROTO_2(char* ku_proc, char*, char*); extern C_PROTO_2(int ku_proi, char*, int); extern C_PROTO_2(double ku_pror, char*, double); extern C_PROTO_2(char* ku_pros, char*, char*); extern C_PROTO_0(char** ku_qenv); extern C_PROTO_1(char* ku_qexe, char*); extern C_PROTO_2(int ku_sapp, char*, char*); extern C_PROTO_0(void ku_shut); extern C_PROTO_2(void ku_time, time_t, clock_t); extern C_PROTO_2(void ku_trap, int, int); extern C_PROTO_0(void ku_whag); extern C_PROTO_1(void ku_what, void(*)()); extern C_PROTO_1(char* getline, char*); extern C_PROTO_2(void gl_config, char*, int); extern C_PROTO_1(void gl_histadd, char*); extern C_PROTO_1(void gl_setwidth, int); extern C_PROTO_2(char* input_line, char*, int); extern C_PROTO_0(void leave_kuip); extern C_PROTO_0(void reset_break); #endif +KEEP,KFOR_H #ifndef KFOR_H_INCLUDED #define KFOR_H_INCLUDED /* kfor.h: Fortran-C interface */ /* * Fortran data types */ typedef int INTEGER; typedef int LOGICAL; typedef float REAL; typedef void (*SUBRPTR)(); typedef void SUBROUTINE(); typedef INTEGER INTEGER_FUNCTION(); #ifdef IBM370 #pragma linkage(SUBROUTINE,FORTRAN) #pragma linkage(INTEGER_FUNCTION,FORTRAN) #endif /* * Mapping of C-routine name for Fortran CALL SUB * * #define F77_EXTERN_LOWERCASE ==> void sub() * #define F77_EXTERN_UPPERCASE ==> void SUB() * otherwise ==> void sub_() */ #ifdef F77_EXTERN_UPPERCASE # define F77_NAME(name,NAME) NAME #else # ifdef F77_EXTERN_LOWERCASE # define F77_NAME(name,NAME) name # else # define F77_NAME(name,NAME) ConCat(name,_) # endif #endif #ifndef F77_BLOCK # define F77_BLOCK(name,NAME) F77_NAME(name,NAME) #endif #ifndef F77_COMMON # define F77_COMMON(name) name #endif /* * Routine address in CALL SUB(FUN) ; EXTERNAL FUN * * #define F77_EXTERN_INDIRECT ==> void (**fun)(); * otherwise ==> void (*fun)(); */ #ifdef F77_EXTERN_INDIRECT # define F77_EXTERN_ARG(e) ConCat(e,_dsc) # define F77_EXTERN_DCL(e) SUBROUTINE **ConCat(e,_dsc); # define F77_EXTERN_DEF(e) SUBROUTINE *e = *ConCat(e,_dsc); #else # define F77_EXTERN_ARG(e) e # define F77_EXTERN_DCL(e) SUBROUTINE *e; # define F77_EXTERN_DEF(e) #endif #define F77_EXTERN2ARG(e1,e2) F77_EXTERN_ARG(e1),F77_EXTERN_ARG(e2) #define F77_EXTERN2DCL(e1,e2) F77_EXTERN_DCL(e1) F77_EXTERN_DCL(e2) #define F77_EXTERN2DEF(e1,e2) F77_EXTERN_DEF(e1) F77_EXTERN_DEF(e2) /* * Access to Fortran CHARACTER arguments */ #ifdef F77_CHAR_DSC_VMS /* VMS string descriptors */ # define F77_CHAR_ARG_PTR(s) ConCat(s,_dsc) # define F77_CHAR_ARG_LEN(s) # define F77_CHAR_ARG_DCL(s) struct dsc$descriptor_s *ConCat(s,_dsc); # define F77_CHAR_ARG_DEF(s) char *s = ConCat(s,_dsc)->dsc$a_pointer; \ int ConCat(len_,s) = ConCat(s,_dsc)->dsc$w_length; # define F77_CHAR_DEF_DSC(s,p,l) struct dsc$descriptor_s ConCat(s,__dsc); # define F77_CHAR_ASS_DSC(s,p,l) ConCat(s,__dsc).dsc$w_length = l; \ ConCat(s,__dsc).dsc$b_dtype = DSC$K_DTYPE_T;\ ConCat(s,__dsc).dsc$b_class = DSC$K_CLASS_S;\ ConCat(s,__dsc).dsc$a_pointer = p; # define F77_CHAR_USE_PTR(s,p,l) &ConCat(s,__dsc) # define F77_CHAR_USE_LEN(s,p,l) #endif #ifdef F77_CHAR_DSC_CRAY /* Cray string descriptors */ # define F77_CHAR_ARG_PTR(s) ConCat(s,_dsc) # define F77_CHAR_ARG_LEN(s) # define F77_CHAR_ARG_DCL(s) _fcd ConCat(s,_dsc); # define F77_CHAR_ARG_DEF(s) char *s = _fcdtocp(ConCat(s,_dsc)); \ int ConCat(len_,s) = _fcdlen(ConCat(s,_dsc)); # define F77_CHAR_DEF_DSC(s,p,l) # define F77_CHAR_ASS_DSC(s,p,l) # define F77_CHAR_USE_PTR(s,p,l) _cptofcd(p,l) # define F77_CHAR_USE_LEN(s,p,l) #endif #ifdef F77_CHAR_LEN_IND /* string length passed by reference */ /* * The IBM C/370 compiler passes the Fortran CHARACTER pointer directly * instead of making a private copy. Therefore we have to do the copy * char *s = s_ptr ourself in case the routine uses s as local variable. */ # define F77_CHAR_ARG_PTR(s) ConCat(s,_ptr) # define F77_CHAR_ARG_LEN(s) , ConCat(s,_dsc) # define F77_CHAR_ARG_DCL(s) char *ConCat(s,_ptr); \ F77_CHAR_LEN_IND *ConCat(s,_dsc); # define F77_CHAR_ARG_DEF(s) char *s = ConCat(s,_ptr); \ int ConCat(len_,s) = *ConCat(s,_dsc); # define F77_CHAR_DEF_DSC(s,p,l) F77_CHAR_LEN_IND ConCat(s,__dsc) = l; # define F77_CHAR_ASS_DSC(s,p,l) # define F77_CHAR_USE_PTR(s,p,l) p # define F77_CHAR_USE_LEN(s,p,l) , &ConCat(s,__dsc) #endif #ifndef F77_CHAR_ARG_PTR /* string length passed by value */ # define F77_CHAR_ARG_PTR(s) s # define F77_CHAR_ARG_LEN(s) , ConCat(len_,s) # define F77_CHAR_ARG_DCL(s) char *s; int ConCat(len_,s); # define F77_CHAR_ARG_DEF(s) # define F77_CHAR_DEF_DSC(s,p,l) # define F77_CHAR_ASS_DSC(s,p,l) # define F77_CHAR_USE_PTR(s,p,l) p # define F77_CHAR_USE_LEN(s,p,l) , l #endif #ifndef F77_XXXX_ARG_LEN /* length argument of non-CHARACTER arguments */ # define F77_XXXX_ARG_LEN(x) /* nil */ # define F77_XXXX_USE_LEN(x) /* nil */ #endif /* * Fortran-calls-C interface * * To define a C function called by Fortran CALL SUB(A,B,C): * * #define Sub F77_NAME(sub,SUB) * #pragma linkage(SUB,FORTRAN) // for IBM C/370 compiler * * F77_ENTRY_xyz(Sub,a,b,c) // opening { contained in macro * // body ... * } * * Each character in xyz declares the type of the corresponding parameter: * * C = CHARACTER * D = DOUBLE PRECISION * E = EXTERNAL * I = INTEGER * L = LOGICAL * R = REAL * X = COMPLEX * * If a parameter PAR is declared as CHARACTER the macro defines: * * char *PAR; // pointer to string (not terminated by \0 !!!) * int len_PAR; // length of string as defined by Fortran's LEN(PAR) * * The name PAR_dsc is reserved for internal use. * * Note: The function body follows the F77_ENTRY_... macro call directly. * The opening { is generated by the macro. */ #define F77_CHAR_ARG2PTR(c1,c2) \ F77_CHAR_ARG_PTR(c1),F77_CHAR_ARG_PTR(c2) #define F77_CHAR_ARG2LEN(c1,c2) \ F77_CHAR_ARG_LEN(c1) F77_CHAR_ARG_LEN(c2) #define F77_XXXX_ARG2LEN(c1,c2) \ F77_XXXX_ARG_LEN(c1) F77_XXXX_ARG_LEN(c2) #define F77_CHAR_ARG2DCL(c1,c2) \ F77_CHAR_ARG_DCL(c1) F77_CHAR_ARG_DCL(c2) #define F77_CHAR_ARG2DEF(c1,c2) \ F77_CHAR_ARG_DEF(c1) F77_CHAR_ARG_DEF(c2) #define F77_CHAR_ARG3PTR(c1,c2,c3) \ F77_CHAR_ARG2PTR(c1,c2),F77_CHAR_ARG_PTR(c3) #define F77_CHAR_ARG3LEN(c1,c2,c3) \ F77_CHAR_ARG2LEN(c1,c2) F77_CHAR_ARG_LEN(c3) #define F77_XXXX_ARG3LEN(c1,c2,c3) \ F77_XXXX_ARG2LEN(c1,c2) F77_XXXX_ARG_LEN(c3) #define F77_CHAR_ARG3DCL(c1,c2,c3) \ F77_CHAR_ARG2DCL(c1,c2) F77_CHAR_ARG_DCL(c3) #define F77_CHAR_ARG3DEF(c1,c2,c3) \ F77_CHAR_ARG2DEF(c1,c2) F77_CHAR_ARG_DEF(c3) #define F77_CHAR_ARG4PTR(c1,c2,c3,c4) \ F77_CHAR_ARG3PTR(c1,c2,c3),F77_CHAR_ARG_PTR(c4) #define F77_CHAR_ARG4LEN(c1,c2,c3,c4) \ F77_CHAR_ARG3LEN(c1,c2,c3) F77_CHAR_ARG_LEN(c4) #define F77_XXXX_ARG4LEN(c1,c2,c3,c4) \ F77_XXXX_ARG3LEN(c1,c2,c3) F77_XXXX_ARG_LEN(c4) #define F77_CHAR_ARG4DCL(c1,c2,c3,c4) \ F77_CHAR_ARG3DCL(c1,c2,c3) F77_CHAR_ARG_DCL(c4) #define F77_CHAR_ARG4DEF(c1,c2,c3,c4) \ F77_CHAR_ARG3DEF(c1,c2,c3) F77_CHAR_ARG_DEF(c4) #define F77_CHAR_ARG5PTR(c1,c2,c3,c4,c5) \ F77_CHAR_ARG4PTR(c1,c2,c3,c4),F77_CHAR_ARG_PTR(c5) #define F77_CHAR_ARG5LEN(c1,c2,c3,c4,c5) \ F77_CHAR_ARG4LEN(c1,c2,c3,c4) F77_CHAR_ARG_LEN(c5) #define F77_CHAR_ARG5DCL(c1,c2,c3,c4,c5) \ F77_CHAR_ARG4DCL(c1,c2,c3,c4) F77_CHAR_ARG_DCL(c5) #define F77_CHAR_ARG5DEF(c1,c2,c3,c4,c5) \ F77_CHAR_ARG4DEF(c1,c2,c3,c4) F77_CHAR_ARG_DEF(c5) #define F77_ENTRY_C(name,c1) \ name( F77_CHAR_ARG_PTR(c1) F77_CHAR_ARG_LEN(c1) ) \ F77_CHAR_ARG_DCL(c1) \ { F77_CHAR_ARG_DEF(c1) #define F77_ENTRY_CC(name,c1,c2) \ name( F77_CHAR_ARG2PTR(c1,c2) F77_CHAR_ARG2LEN(c1,c2) ) \ F77_CHAR_ARG2DCL(c1,c2) \ { F77_CHAR_ARG2DEF(c1,c2) #define F77_ENTRY_C3(name,c1,c2,c3) \ name( F77_CHAR_ARG3PTR(c1,c2,c3) \ F77_CHAR_ARG3LEN(c1,c2,c3) ) \ F77_CHAR_ARG3DCL(c1,c2,c3) \ { F77_CHAR_ARG3DEF(c1,c2,c3) #define F77_ENTRY_C5(name,c1,c2,c3,c4,c5) \ name( F77_CHAR_ARG5PTR(c1,c2,c3,c4,c5) \ F77_CHAR_ARG5LEN(c1,c2,c3,c4,c5) ) \ F77_CHAR_ARG5DCL(c1,c2,c3,c4,c5) \ { F77_CHAR_ARG5DEF(c1,c2,c3,c4,c5) #define F77_ENTRY_C4E(name,c1,c2,c3,c4,e5) \ name( F77_CHAR_ARG4PTR(c1,c2,c3,c4),F77_EXTERN_ARG(e5) \ F77_CHAR_ARG4LEN(c1,c2,c3,c4) ) \ F77_CHAR_ARG4DCL(c1,c2,c3,c4) F77_EXTERN_DCL(e5) \ { F77_CHAR_ARG4DEF(c1,c2,c3,c4) F77_EXTERN_DEF(e5) #define F77_ENTRY_C4I(name,c1,c2,c3,c4,i5) \ name( F77_CHAR_ARG4PTR(c1,c2,c3,c4), i5 \ F77_CHAR_ARG4LEN(c1,c2,c3,c4) ) \ F77_CHAR_ARG4DCL(c1,c2,c3,c4) INTEGER *i5; \ { F77_CHAR_ARG4DEF(c1,c2,c3,c4) #define F77_ENTRY_C5E(name,c1,c2,c3,c4,c5,e6) \ name( F77_CHAR_ARG5PTR(c1,c2,c3,c4,c5),F77_EXTERN_ARG(e6) \ F77_CHAR_ARG5LEN(c1,c2,c3,c4,c5) ) \ F77_CHAR_ARG5DCL(c1,c2,c3,c4,c5) F77_EXTERN_DCL(e6) \ { F77_CHAR_ARG5DEF(c1,c2,c3,c4,c5) F77_EXTERN_DEF(e6) #define F77_ENTRY_CCEE(name,c1,c2,e3,e4) \ name( F77_CHAR_ARG2PTR(c1,c2),F77_EXTERN2ARG(e3,e4) \ F77_CHAR_ARG2LEN(c1,c2) ) \ F77_CHAR_ARG2DCL(c1,c2) F77_EXTERN2DCL(e3,e4) \ { F77_CHAR_ARG2DEF(c1,c2) F77_EXTERN2DEF(e3,e4) #define F77_ENTRY_CCI(name,c1,c2,i3) \ name( F77_CHAR_ARG2PTR(c1,c2), i3 \ F77_CHAR_ARG2LEN(c1,c2) ) \ F77_CHAR_ARG2DCL(c1,c2) INTEGER *i3; \ { F77_CHAR_ARG2DEF(c1,c2) #define F77_ENTRY_CCIC(name,c1,c2,i3,c4) \ name( F77_CHAR_ARG2PTR(c1,c2), i3, F77_CHAR_ARG_PTR(c4) \ F77_CHAR_ARG2LEN(c1,c2) \ F77_XXXX_ARG_LEN(i3) \ F77_CHAR_ARG_LEN(c4) ) \ F77_CHAR_ARG3DCL(c1,c2,c4) INTEGER *i3; \ { F77_CHAR_ARG3DEF(c1,c2,c4) #define F77_ENTRY_CCIRCC(name,c1,c2,i3,r4,c5,c6) \ name( F77_CHAR_ARG2PTR(c1,c2), i3, r4, F77_CHAR_ARG2PTR(c5,c6) \ F77_CHAR_ARG2LEN(c1,c2) \ F77_XXXX_ARG2LEN(i3,r4) \ F77_CHAR_ARG2LEN(c5,c6) ) \ F77_CHAR_ARG4DCL(c1,c2,c5,c6) INTEGER *i3; REAL *r4; \ { F77_CHAR_ARG4DEF(c1,c2,c5,c6) #define F77_ENTRY_CE(name,c1,e2) \ name( F77_CHAR_ARG_PTR(c1),F77_EXTERN_ARG(e2) \ F77_CHAR_ARG_LEN(c1) ) \ F77_CHAR_ARG_DCL(c1) F77_EXTERN_DCL(e2) \ { F77_CHAR_ARG_DEF(c1) F77_EXTERN_DEF(e2) #define F77_ENTRY_CI(name,c1,i2) \ name( F77_CHAR_ARG_PTR(c1), i2 F77_CHAR_ARG_LEN(c1) ) \ INTEGER *i2; F77_CHAR_ARG_DCL(c1) \ { F77_CHAR_ARG_DEF(c1) #define F77_ENTRY_CICI(name,c1,i2,c3,i4) \ name( F77_CHAR_ARG_PTR(c1), i2, F77_CHAR_ARG_PTR(c3), i4 \ F77_CHAR_ARG_LEN(c1) \ F77_XXXX_ARG_LEN(i2) \ F77_CHAR_ARG_LEN(c3) ) \ F77_CHAR_ARG2DCL(c1,c3) INTEGER *i2, *i4; \ { F77_CHAR_ARG2DEF(c1,c3) #define F77_ENTRY_CII(name,c1,i2,i3) \ name( F77_CHAR_ARG_PTR(c1), i2, i3 \ F77_CHAR_ARG_LEN(c1) ) \ F77_CHAR_ARG_DCL(c1) INTEGER *i2, *i3; \ { F77_CHAR_ARG_DEF(c1) #define F77_ENTRY_CIIC(name,c1,i2,i3,c4) \ name( F77_CHAR_ARG_PTR(c1), i2, i3, F77_CHAR_ARG_PTR(c4) \ F77_CHAR_ARG_LEN(c1) \ F77_XXXX_ARG2LEN(i2,i3) \ F77_CHAR_ARG_LEN(c4) ) \ F77_CHAR_ARG2DCL(c1,c4) INTEGER *i2, *i3; \ { F77_CHAR_ARG2DEF(c1,c4) #define F77_ENTRY_CR(name,c1,r2) \ name( F77_CHAR_ARG_PTR(c1), r2 F77_CHAR_ARG_LEN(c1) ) \ REAL *r2; F77_CHAR_ARG_DCL(c1) \ { F77_CHAR_ARG_DEF(c1) #define F77_ENTRY_E(name,e1) \ name( F77_EXTERN_ARG(e1) ) \ F77_EXTERN_DCL(e1) \ { F77_EXTERN_DEF(e1) #define F77_ENTRY_IC(name,i1,c2) \ name( i1, F77_CHAR_ARG_PTR(c2) \ F77_XXXX_ARG_LEN(i1) \ F77_CHAR_ARG_LEN(c2) ) \ INTEGER *i1; F77_CHAR_ARG_DCL(c2) \ { F77_CHAR_ARG_DEF(c2) #define F77_ENTRY_ICI(name,i1,c2,i3) \ name( i1, F77_CHAR_ARG_PTR(c2), i3 \ F77_XXXX_ARG_LEN(i1) \ F77_CHAR_ARG_LEN(c2) ) \ INTEGER *i1, *i3; F77_CHAR_ARG_DCL(c2) \ { F77_CHAR_ARG_DEF(c2) #define F77_ENTRY_IIC(name,i1,i2,c3) \ name( i1, i2, F77_CHAR_ARG_PTR(c3) \ F77_XXXX_ARG2LEN(i1,i2) \ F77_CHAR_ARG_LEN(c3) ) \ INTEGER *i1, *i2; F77_CHAR_ARG_DCL(c3) \ { F77_CHAR_ARG_DEF(c3) #define F77_ENTRY_I3C(name,i1,i2,i3,c4) \ name( i1, i2, i3, F77_CHAR_ARG_PTR(c4) \ F77_XXXX_ARG3LEN(i1,i2,i3) \ F77_CHAR_ARG_LEN(c4) ) \ INTEGER *i1, *i2, *i3; \ F77_CHAR_ARG_DCL(c4) \ { F77_CHAR_ARG_DEF(c4) #define F77_ENTRY_I4CCC(name,i1,i2,i3,i4,c5,c6,c7) \ name( i1, i2, i3, i4, F77_CHAR_ARG3PTR(c5,c6,c7) \ F77_XXXX_ARG4LEN(i1,i2,i3,i4) \ F77_CHAR_ARG3LEN(c5,c6,c7) ) \ INTEGER *i1, *i2, *i3, *i4; \ F77_CHAR_ARG3DCL(c5,c6,c7) \ { F77_CHAR_ARG3DEF(c5,c6,c7) #define F77_CHAR_DEF2DSC(s1,p1,l1,s2,p2,l2) \ F77_CHAR_DEF_DSC(s1,p1,l1) F77_CHAR_DEF_DSC(s2,p2,l2) #define F77_CHAR_ASS2DSC(s1,p1,l1,s2,p2,l2) \ F77_CHAR_ASS_DSC(s1,p1,l1) F77_CHAR_ASS_DSC(s2,p2,l2) #define F77_CHAR_USE2PTR(s1,p1,l1,s2,p2,l2) \ F77_CHAR_USE_PTR(s1,p1,l1),F77_CHAR_USE_PTR(s2,p2,l2) #define F77_CHAR_USE2LEN(s1,p1,l1,s2,p2,l2) \ F77_CHAR_USE_LEN(s1,p1,l1) F77_CHAR_USE_LEN(s2,p2,l2) #define F77_XXXX_USE2LEN(x1,x2) \ F77_XXXX_USE_LEN(x1) F77_XXXX_USE_LEN(x2) #define F77_CHAR_DEF3DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3) \ F77_CHAR_DEF2DSC(s1,p1,l1,s2,p2,l2) F77_CHAR_DEF_DSC(s3,p3,l3) #define F77_CHAR_ASS3DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3) \ F77_CHAR_ASS2DSC(s1,p1,l1,s2,p2,l2) F77_CHAR_ASS_DSC(s3,p3,l3) #define F77_CHAR_USE3PTR(s1,p1,l1,s2,p2,l2,s3,p3,l3) \ F77_CHAR_USE2PTR(s1,p1,l1,s2,p2,l2),F77_CHAR_USE_PTR(s3,p3,l3) #define F77_CHAR_USE3LEN(s1,p1,l1,s2,p2,l2,s3,p3,l3) \ F77_CHAR_USE2LEN(s1,p1,l1,s2,p2,l2) F77_CHAR_USE_LEN(s3,p3,l3) #define F77_XXXX_USE3LEN(x1,x2,x3) \ F77_XXXX_USE2LEN(x1,x2) F77_XXXX_USE_LEN(x3) #define F77_CHAR_DEF4DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3,s4,p4,l4) \ F77_CHAR_DEF3DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3) F77_CHAR_DEF_DSC(s4,p4,l4) #define F77_CHAR_ASS4DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3,s4,p4,l4) \ F77_CHAR_ASS3DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3) F77_CHAR_ASS_DSC(s4,p4,l4) #define F77_CHAR_USE4PTR(s1,p1,l1,s2,p2,l2,s3,p3,l3,s4,p4,l4) \ F77_CHAR_USE3PTR(s1,p1,l1,s2,p2,l2,s3,p3,l3),F77_CHAR_USE_PTR(s4,p4,l4) #define F77_CHAR_USE4LEN(s1,p1,l1,s2,p2,l2,s3,p3,l3,s4,p4,l4) \ F77_CHAR_USE3LEN(s1,p1,l1,s2,p2,l2,s3,p3,l3) F77_CHAR_USE_LEN(s4,p4,l4) #define F77_XXXX_USE4LEN(x1,x2,x3,x4) \ F77_XXXX_USE3LEN(x1,x2,x3) F77_XXXX_USE_LEN(x4) #define F77_XXXX_USE5LEN(x1,x2,x3,x4,x5) \ F77_XXXX_USE4LEN(x1,x2,x3,x4) F77_XXXX_USE_LEN(x5) #ifdef IBM370 #pragma linkage(K77C,FORTRAN) #define F77_CALL_C(name,p1,l1) do { \ SUBROUTINE *F77 = name; \ K77C(&F77,p1,l1); } while(0) #else #define F77_CALL_C(name,p1,l1) do { \ F77_CHAR_DEF_DSC(s1,p1,l1) \ F77_CHAR_ASS_DSC(s1,p1,l1) \ name( F77_CHAR_USE_PTR(s1,p1,l1) \ F77_CHAR_USE_LEN(s1,p1,l1) \ ); } while(0) #endif #ifdef IBM370 #pragma linkage(K77CC,FORTRAN) #define F77_CALL_CC(name,p1,l1,p2,l2) do { \ SUBROUTINE *F77 = name; \ K77CC(&F77,p1,l1,p2,l2); } while(0) #else #define F77_CALL_CC(name,p1,l1,p2,l2) do { \ F77_CHAR_DEF2DSC(s1,p1,l1,s2,p2,l2) \ F77_CHAR_ASS2DSC(s1,p1,l1,s2,p2,l2) \ name( F77_CHAR_USE2PTR(s1,p1,l1,s2,p2,l2) \ F77_CHAR_USE2LEN(s1,p1,l1,s2,p2,l2) \ ); } while(0) #endif #ifdef IBM370 #pragma linkage(K77C3,FORTRAN) #define F77_CALL_C3(name,p1,l1,p2,l2,p3,l3) do { \ SUBROUTINE *F77 = name; \ K77C3(&F77,p1,l1,p2,l2,p3,l3); } while(0) #else #define F77_CALL_C3(name,p1,l1,p2,l2,p3,l3) do { \ F77_CHAR_DEF3DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3) \ F77_CHAR_ASS3DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3) \ name( F77_CHAR_USE3PTR(s1,p1,l1,s2,p2,l2,s3,p3,l3) \ F77_CHAR_USE3LEN(s1,p1,l1,s2,p2,l2,s3,p3,l3) \ ); } while(0) #endif #ifdef IBM370 #pragma linkage(K77C7,FORTRAN) #define F77_CALL_C7(name,p1,l1,p2,l2,p3,l3,p4,l4,p5,l5,p6,l6,p7,l7) do { \ SUBROUTINE *F77 = name; \ K77C7(&F77,p1,l1,p2,l2,p3,l3,p4,l4,p5,l5,p6,l6,p7,l7); } while(0) #else #define F77_CALL_C7(name,p1,l1,p2,l2,p3,l3,p4,l4,p5,l5,p6,l6,p7,l7) do { \ F77_CHAR_DEF4DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3,s4,p4,l4) \ F77_CHAR_DEF3DSC(s5,p5,l5,s6,p6,l6,s7,p7,l7) \ F77_CHAR_ASS4DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3,s4,p4,l4) \ F77_CHAR_ASS3DSC(s5,p5,l5,s6,p6,l6,s7,p7,l7) \ name( F77_CHAR_USE4PTR(s1,p1,l1,s2,p2,l2,s3,p3,l3,s4,p4,l4), \ F77_CHAR_USE3PTR(s5,p5,l5,s6,p6,l6,s7,p7,l7) \ F77_CHAR_USE4LEN(s1,p1,l1,s2,p2,l2,s3,p3,l3,s4,p4,l4) \ F77_CHAR_USE3LEN(s5,p5,l5,s6,p6,l6,s7,p7,l7) \ ); } while(0) #endif #ifdef IBM370 #pragma linkage(K77CCx,FORTRAN) #define F77_CALL_CCx(name,p1,l1,p2,l2,x3) do { \ SUBROUTINE *F77 = name; \ K77CCx(&F77,p1,l1,p2,l2,x3); } while(0) #else #define F77_CALL_CCx(name,p1,l1,p2,l2,x3) do { \ F77_CHAR_DEF2DSC(s1,p1,l1,s2,p2,l2) \ F77_CHAR_ASS2DSC(s1,p1,l1,s2,p2,l2) \ name( F77_CHAR_USE2PTR(s1,p1,l1,s2,p2,l2), \ x3 \ F77_CHAR_USE2LEN(s1,p1,l1,s2,p2,l2) \ F77_XXXX_USE_LEN(x3) \ ); } while(0) #endif #ifdef IBM370 #pragma linkage(K77CCx3,FORTRAN) #define F77_CALL_CCx3(name,p1,l1,p2,l2,x3,x4,x5) do { \ SUBROUTINE *F77 = name; \ K77CCx3(&F77,p1,l1,p2,l2,x3,x4,x5); } while(0) #else #define F77_CALL_CCx3(name,p1,l1,p2,l2,x3,x4,x5) do { \ F77_CHAR_DEF2DSC(s1,p1,l1,s2,p2,l2) \ F77_CHAR_ASS2DSC(s1,p1,l1,s2,p2,l2) \ name( F77_CHAR_USE2PTR(s1,p1,l1,s2,p2,l2), \ x3,x4,x5 \ F77_CHAR_USE2LEN(s1,p1,l1,s2,p2,l2) \ F77_XXXX_USE3LEN(x3,x4,x5) \ ); } while(0) #endif #ifdef IBM370 #pragma linkage(K77Cx,FORTRAN) #define F77_CALL_Cx(name,p1,l1,x2) do { \ SUBROUTINE *F77 = name; \ K77Cx(&F77,p1,l1,x2); } while(0) #else #define F77_CALL_Cx(name,p1,l1,x2) do { \ F77_CHAR_DEF_DSC(s1,p1,l1) \ F77_CHAR_ASS_DSC(s1,p1,l1) \ name( F77_CHAR_USE_PTR(s1,p1,l1), \ x2 \ F77_CHAR_USE_LEN(s1,p1,l1) \ F77_XXXX_USE_LEN(x2) \ ); } while(0) #endif #ifdef IBM370 #pragma linkage(K77Cxx,FORTRAN) #define F77_CALL_Cxx(name,p1,l1,x2,x3) do { \ SUBROUTINE *F77 = name; \ K77Cxx(&F77,p1,l1,x2,x3); } while(0) #else #define F77_CALL_Cxx(name,p1,l1,x2,x3) do { \ F77_CHAR_DEF_DSC(s1,p1,l1) \ F77_CHAR_ASS_DSC(s1,p1,l1) \ name( F77_CHAR_USE_PTR(s1,p1,l1), \ x2,x3 \ F77_CHAR_USE_LEN(s1,p1,l1) \ F77_XXXX_USE2LEN(x2,x3) \ ); } while(0) #endif #ifdef IBM370 #pragma linkage(K77xC,FORTRAN) #define F77_CALL_xC(name,x1,p2,l2) do { \ SUBROUTINE *F77 = name; \ K77xC(&F77,x1,p2,l2); } while(0) #else #define F77_CALL_xC(name,x1,p2,l2) do { \ F77_CHAR_DEF_DSC(s2,p2,l2) \ F77_CHAR_ASS_DSC(s2,p2,l2) \ name( x1, \ F77_CHAR_USE_PTR(s2,p2,l2) \ F77_XXXX_USE_LEN(x1) \ F77_CHAR_USE_LEN(s2,p2,l2) \ ); } while(0) #endif #ifdef IBM370 #pragma linkage(K77xCCx,FORTRAN) #define F77_CALL_xCCx(name,x1,p2,l2,p3,l3,x4) do { \ SUBROUTINE *F77 = name; \ K77xCCx(&F77,x1,p2,l2,p3,l3,x4); } while(0) #else #define F77_CALL_xCCx(name,x1,p2,l2,p3,l3,x4) do { \ F77_CHAR_DEF2DSC(s2,p2,l2,s3,p3,l3) \ F77_CHAR_ASS2DSC(s2,p2,l2,s3,p3,l3) \ name( x1, \ F77_CHAR_USE2PTR(s2,p2,l2,s3,p3,l3), \ x4 \ F77_XXXX_USE_LEN(x1) \ F77_CHAR_USE2LEN(s2,p2,l2,s3,p3,l3) \ F77_XXXX_USE_LEN(x4) \ ); } while(0) #endif #ifdef IBM370 #pragma linkage(K77xCx,FORTRAN) #define F77_CALL_xCx(name,x1,p2,l2,x3) do { \ SUBROUTINE *F77 = name; \ K77xCx(&F77,x1,p2,l2,x3); } while(0) #else #define F77_CALL_xCx(name,x1,p2,l2,x3) do { \ F77_CHAR_DEF_DSC(s2,p2,l2) \ F77_CHAR_ASS_DSC(s2,p2,l2) \ name( x1, \ F77_CHAR_USE_PTR(s2,p2,l2), \ x3 \ F77_XXXX_USE_LEN(x1) \ F77_CHAR_USE_LEN(s2,p2,l2) \ F77_XXXX_USE_LEN(x3) \ ); } while(0) #endif #ifdef IBM370 #pragma linkage(K77x4C,FORTRAN) #define F77_CALL_x4C(name,x1,x2,x3,x4,p5,l5) do { \ SUBROUTINE *F77 = name; \ K77x4C(&F77,x1,x2,x3,x4,p5,l5); } while(0) #else #define F77_CALL_x4C(name,x1,x2,x3,x4,p5,l5) do { \ F77_CHAR_DEF_DSC(s5,p5,l5) \ F77_CHAR_ASS_DSC(s5,p5,l5) \ name( x1,x2,x3,x4, \ F77_CHAR_USE_PTR(s5,p5,l5) \ F77_XXXX_USE4LEN(x1,x2,x3,x4) \ F77_CHAR_USE_LEN(s5,p5,l5) \ ); } while(0) #endif #ifdef IBM370 #pragma linkage(KIGMENU,FORTRAN) /* 1 2 3 4 5 6 7 8 9 10 11 12 13 14 */ #define F77_CALL_xCx5CxC3xC(name,a,b,B,c,d,e,f,g,h,H,i,j,J,k,K,l,L,m,n,N) do {\ SUBROUTINE *F77 = name; \ KIGMENU(&F77,a,b,B,c,d,e,f,g,h,H,i,j,J,k,K,l,L,m,n,N); } while(0) #else #define F77_CALL_xCx5CxC3xC(name,a,b,B,c,d,e,f,g,h,H,i,j,J,k,K,l,L,m,n,N) do {\ F77_CHAR_DEF_DSC(sb,b,B) \ F77_CHAR_DEF_DSC(sh,h,H) \ F77_CHAR_DEF3DSC(sj,j,J,sk,k,K,sl,l,L) \ F77_CHAR_DEF_DSC(sn,n,N) \ F77_CHAR_ASS_DSC(sb,b,B) \ F77_CHAR_ASS_DSC(sh,h,H) \ F77_CHAR_ASS3DSC(sj,j,J,sk,k,K,sl,l,L) \ F77_CHAR_ASS_DSC(sn,n,N) \ name( a, \ F77_CHAR_USE_PTR(sb,b,B), \ c,d,e,f,g, \ F77_CHAR_USE_PTR(sh,h,H), \ i, \ F77_CHAR_USE3PTR(sj,j,J,sk,k,K,sl,l,L), \ m, \ F77_CHAR_USE_PTR(sn,n,N) \ F77_XXXX_USE_LEN(a) \ F77_CHAR_USE_LEN(sb,b,B) \ F77_XXXX_USE5LEN(c,d,e,f,g) \ F77_CHAR_USE_LEN(sh,h,H) \ F77_XXXX_USE_LEN(i) \ F77_CHAR_USE3LEN(sj,j,J,sk,k,K,sl,l,L) \ F77_XXXX_USE_LEN(m) \ F77_CHAR_USE_LEN(sn,n,N) \ ); } while(0) #endif /* * routines called by Fortran */ #define Errrun F77_NAME(errrun,ERRRUN) #define Fmemcpy F77_NAME(fmemcpy,FMEMCPY) #define Getarg F77_NAME(getarg,GETARG) extern SUBROUTINE Getarg; #define Goparm F77_NAME(goparm,GOPARM) extern SUBROUTINE Goparm; #define Gl_char_cleanup F77_NAME(gl_char_cleanup,GL_CHAR_CLEANUP) #define Gl_reset F77_NAME(gl_reset,GL_RESET) #define Gl_reinit F77_NAME(gl_reinit,GL_REINIT) #define Iclrwk F77_NAME(iclrwk,ICLRWK) extern SUBROUTINE Iclrwk; #define Iginit F77_NAME(iginit,IGINIT) extern SUBROUTINE Iginit; #define Igmenu F77_NAME(igmenu,IGMENU) extern SUBROUTINE Igmenu; #define Igrng F77_NAME(igrng,IGRNG) extern SUBROUTINE Igrng; #define Igsse F77_NAME(igsse,IGSSE) extern SUBROUTINE Igsse; #define Igsrap F77_NAME(igsrap,IGSRAP) extern SUBROUTINE Igsrap; #define Igwkty F77_NAME(igwkty,IGWKTY) extern SUBROUTINE Igwkty; #define Kcexec F77_NAME(kcexec,KCEXEC) #define Kdialo F77_NAME(kdialo,KDIALO) extern SUBROUTINE Kdialo; #define Kgetar F77_NAME(kgetar,KGETAR) #define Kialid F77_NAME(kialid,KIALID) #define Kiargc F77_NAME(kiargc,KIARGC) extern INTEGER_FUNCTION Kiargc; #define Kibres F77_NAME(kibres,KIBRES) extern SUBROUTINE Kibres; #define Kiclos F77_NAME(kiclos,KICLOS) extern SUBROUTINE Kiclos; #define Kierrf F77_NAME(kierrf,KIERRF) extern SUBROUTINE Kierrf; #define Kiinit F77_NAME(kiinit,KIINIT) extern SUBROUTINE Kiinit; #define Kilun F77_NAME(kilun,KILUN) extern SUBROUTINE Kilun; #define Kimdef F77_NAME(kimdef,KIMDEF) #define Kimexe F77_NAME(kimexe,KIMEXE) #define Kipawc F77_NAME(kipawc,KIPAWC) #define Kiprmt F77_NAME(kiprmt,KIPRMT) #define Kirtim F77_NAME(kirtim,KIRTIM) #define Kisigm F77_NAME(kisigm,KISIGM) #define Kmpst2 F77_NAME(kmpst2,KMPST2) #define Kmpst3 F77_NAME(kmpst3,KMPST3) #define Kmpx22 F77_NAME(kmpx22,KMPX22) #define Kmpx23 F77_NAME(kmpx23,KMPX23) #define Kmvsed F77_NAME(kmvsed,KMVSED) extern SUBROUTINE Kmvsed; #define Kmvspg F77_NAME(kmvspg,KMVSPG) extern SUBROUTINE Kmvspg; #define Kmvssh F77_NAME(kmvssh,KMVSSH) extern SUBROUTINE Kmvssh; #define Ksvpar F77_NAME(ksvpar,KSVPAR) #define Kuach F77_NAME(kuach,KUACH) #define Kuact F77_NAME(kuact,KUACT) #define Kualfa F77_NAME(kualfa,KUALFA) #define Kuappl F77_NAME(kuappl,KUAPPL) #define Kuargs F77_NAME(kuargs,KUARGS) #define Kubrek F77_NAME(kubrek,KUBREK) #define Kubrof F77_NAME(kubrof,KUBROF) #define Kubron F77_NAME(kubron,KUBRON) #define Kucmd F77_NAME(kucmd,KUCMD) #define Kucmdl F77_NAME(kucmdl,KUCMDL) #define Kuedit F77_NAME(kuedit,KUEDIT) #define Kuesvr F77_NAME(kuesvr,KUESVR) #define Kueusr F77_NAME(kueusr,KUEUSR) #define Kuexec F77_NAME(kuexec,KUEXEC) #define Kuexel F77_NAME(kuexel,KUEXEL) #define Kuexit F77_NAME(kuexit,KUEXIT) #define Kufcas F77_NAME(kufcas,KUFCAS) #define Kugetc F77_NAME(kugetc,KUGETC) #define Kugete F77_NAME(kugete,KUGETE) #define Kugetf F77_NAME(kugetf,KUGETF) #define Kugeti F77_NAME(kugeti,KUGETI) #define Kugetl F77_NAME(kugetl,KUGETL) #define Kugetq F77_NAME(kugetq,KUGETQ) #define Kugetr F77_NAME(kugetr,KUGETR) #define Kugets F77_NAME(kugets,KUGETS) #define Kugrfl F77_NAME(kugrfl,KUGRFL) #define Kuguid F77_NAME(kuguid,KUGUID) #define Kuhelp F77_NAME(kuhelp,KUHELP) #define Kuhome F77_NAME(kuhome,KUHOME) #define Kuidf1 F77_NAME(kuidf1,KUIDF1) extern SUBROUTINE Kuidf1; #define Kuidf2 F77_NAME(kuidf2,KUIDF2) extern SUBROUTINE Kuidf2; #define Kuidfm F77_NAME(kuidfm,KUIDFM) #define Kuinim F77_NAME(kuinim,KUINIM) #define Kuinit F77_NAME(kuinit,KUINIT) #define Kulun F77_NAME(kulun,KULUN) #define Kumloc F77_NAME(kumloc,KUMLOC) #define Kumout F77_NAME(kumout,KUMOUT) #define Kumpad F77_NAME(kumpad,KUMPAD) #define Kumpst F77_NAME(kumpst,KUMPST) #define Kumpx2 F77_NAME(kumpx2,KUMPX2) #define Kundpv F77_NAME(kundpv,KUNDPV) #define Kunpar F77_NAME(kunpar,KUNPAR) #define Kunwg F77_NAME(kunwg,KUNWG) #define Kuopen F77_NAME(kuopen,KUOPEN) extern SUBROUTINE Kuopen; #define Kupad F77_NAME(kupad,KUPAD) #define Kupar F77_NAME(kupar,KUPAR) #define Kupath F77_NAME(kupath,KUPATH) #define Kupatl F77_NAME(kupatl,KUPATL) #define Kuproc F77_NAME(kuproc,KUPROC) #define Kuproi F77_NAME(kuproi,KUPROI) #define Kupror F77_NAME(kupror,KUPROR) #define Kupros F77_NAME(kupros,KUPROS) #define Kupval F77_NAME(kupval,KUPVAL) #define Kuqcas F77_NAME(kuqcas,KUQCAS) #define Kuqenv F77_NAME(kuqenv,KUQENV) #define Kuqexe F77_NAME(kuqexe,KUQEXE) #define Kuqsvr F77_NAME(kuqsvr,KUQSVR) #define Kuquit F77_NAME(kuquit,KUQUIT) #define Kusapp F77_NAME(kusapp,KUSAPP) #define Kusibr F77_NAME(kusibr,KUSIBR) #define Kusigm F77_NAME(kusigm,KUSIGM) #define Kuspy F77_NAME(kuspy,KUSPY) #define Kustat F77_NAME(kustat,KUSTAT) #define Kuterm F77_NAME(kuterm,KUTERM) #define Kutime F77_NAME(kutime,KUTIME) #define Kutim0 F77_NAME(kutim0,KUTIM0) extern SUBROUTINE Kutim0; #define Kutrue F77_NAME(kutrue,KUTRUE) #define Kuser F77_NAME(kuser,KUSER) #define Kuvcre F77_NAME(kuvcre,KUVCRE) extern SUBROUTINE Kuvcre; #define Kuvdel F77_NAME(kuvdel,KUVDEL) extern SUBROUTINE Kuvdel; #define Kuvect F77_NAME(kuvect,KUVECT) extern SUBROUTINE Kuvect; #define Kuwhag F77_NAME(kuwhag,KUWHAG) #define Kuwham F77_NAME(kuwham,KUWHAM) #define Kuwhat F77_NAME(kuwhat,KUWHAT) #define Kxali1 F77_NAME(kxali1,KXALI1) #define Kxpanlm F77_NAME(kxpanlm,KXPANLM) extern SUBROUTINE Kxpanlm; #define Macdef F77_NAME(macdef,MACDEF) extern SUBROUTINE Macdef; #define Mdmenu F77_NAME(mdmenu,MDMENU) #define Mhi_close F77_NAME(mhi_close,MHI_CLOSE) extern SUBROUTINE Mhi_close; #define Mhi_open F77_NAME(mhi_open,MHI_OPEN) extern SUBROUTINE Mhi_open; #define Mzwipe F77_NAME(mzwipe,MZWIPE) extern SUBROUTINE Mzwipe; #define Traceq F77_NAME(traceq,TRACEQ) extern SUBROUTINE Traceq; #ifdef IBM370 # pragma linkage(ERRRUN,FORTRAN) # pragma linkage(FMEMCPY,FORTRAN) # pragma linkage(GOPARM,FORTRAN) # pragma linkage(ICLRWK,FORTRAN) # pragma linkage(IGINIT,FORTRAN) # pragma linkage(IGMENU,FORTRAN) # pragma linkage(IGRNG,FORTRAN) # pragma linkage(IGSSE,FORTRAN) # pragma linkage(IGSRAP,FORTRAN) # pragma linkage(IGWKTY,FORTRAN) # pragma linkage(KCEXEC,FORTRAN) # pragma linkage(KDIALO,FORTRAN) # pragma linkage(KGETAR,FORTRAN) # pragma linkage(KIALID,FORTRAN) # pragma linkage(KIBRES,FORTRAN) # pragma linkage(KICLOS,FORTRAN) # pragma linkage(KIERRF,FORTRAN) # pragma linkage(KIINIT,FORTRAN) # pragma linkage(KILUN,FORTRAN) # pragma linkage(KIMDEF,FORTRAN) # pragma linkage(KIMEXE,FORTRAN) # pragma linkage(KIPAWC,FORTRAN) # pragma linkage(KIPRMT,FORTRAN) # pragma linkage(KIRTIM,FORTRAN) # pragma linkage(KISIGM,FORTRAN) # pragma linkage(KMPST2,FORTRAN) # pragma linkage(KMPST3,FORTRAN) # pragma linkage(KMPX22,FORTRAN) # pragma linkage(KMPX23,FORTRAN) # pragma linkage(KMVSED,FORTRAN) # pragma linkage(KMVSPG,FORTRAN) # pragma linkage(KMVSSH,FORTRAN) # pragma linkage(KSVPAR,FORTRAN) # pragma linkage(KUACH,FORTRAN) # pragma linkage(KUACT,FORTRAN) # pragma linkage(KUALFA,FORTRAN) # pragma linkage(KUAPPL,FORTRAN) # pragma linkage(KUARGS,FORTRAN) # pragma linkage(KUBREK,FORTRAN) # pragma linkage(KUBROF,FORTRAN) # pragma linkage(KUBRON,FORTRAN) # pragma linkage(KUCMD,FORTRAN) # pragma linkage(KUCMDL,FORTRAN) # pragma linkage(KUEDIT,FORTRAN) # pragma linkage(KUESVR,FORTRAN) # pragma linkage(KUEUSR,FORTRAN) # pragma linkage(KUEXEC,FORTRAN) # pragma linkage(KUEXEL,FORTRAN) # pragma linkage(KUEXIT,FORTRAN) # pragma linkage(KUFCAS,FORTRAN) # pragma linkage(KUGETC,FORTRAN) # pragma linkage(KUGETE,FORTRAN) # pragma linkage(KUGETF,FORTRAN) # pragma linkage(KUGETI,FORTRAN) # pragma linkage(KUGETL,FORTRAN) # pragma linkage(KUGETQ,FORTRAN) # pragma linkage(KUGETR,FORTRAN) # pragma linkage(KUGETS,FORTRAN) # pragma linkage(KUGRFL,FORTRAN) # pragma linkage(KUGUID,FORTRAN) # pragma linkage(KUHELP,FORTRAN) # pragma linkage(KUHOME,FORTRAN) # pragma linkage(KUIDF1,FORTRAN) # pragma linkage(KUIDF2,FORTRAN) # pragma linkage(KUIDFM,FORTRAN) # pragma linkage(KUINIM,FORTRAN) # pragma linkage(KUINIT,FORTRAN) # pragma linkage(KULUN,FORTRAN) # pragma linkage(KUMLOC,FORTRAN) # pragma linkage(KUMOUT,FORTRAN) # pragma linkage(KUMPAD,FORTRAN) # pragma linkage(KUMPST,FORTRAN) # pragma linkage(KUMPX2,FORTRAN) # pragma linkage(KUNDPV,FORTRAN) # pragma linkage(KUNPAR,FORTRAN) # pragma linkage(KUNWG,FORTRAN) # pragma linkage(KUOPEN,FORTRAN) # pragma linkage(KUPAD,FORTRAN) # pragma linkage(KUPAR,FORTRAN) # pragma linkage(KUPATH,FORTRAN) # pragma linkage(KUPATL,FORTRAN) # pragma linkage(KUPROC,FORTRAN) # pragma linkage(KUPROI,FORTRAN) # pragma linkage(KUPROR,FORTRAN) # pragma linkage(KUPROS,FORTRAN) # pragma linkage(KUPVAL,FORTRAN) # pragma linkage(KUQCAS,FORTRAN) # pragma linkage(KUQENV,FORTRAN) # pragma linkage(KUQEXE,FORTRAN) # pragma linkage(KUQSVR,FORTRAN) # pragma linkage(KUQUIT,FORTRAN) # pragma linkage(KUSAPP,FORTRAN) # pragma linkage(KUSIBR,FORTRAN) # pragma linkage(KUSIGM,FORTRAN) # pragma linkage(KUSPY,FORTRAN) # pragma linkage(KUSTAT,FORTRAN) # pragma linkage(KUTERM,FORTRAN) # pragma linkage(KUTIME,FORTRAN) # pragma linkage(KUTIM0,FORTRAN) # pragma linkage(KUTRUE,FORTRAN) # pragma linkage(KUSER,FORTRAN) # pragma linkage(KUVCRE,FORTRAN) # pragma linkage(KUVDEL,FORTRAN) # pragma linkage(KUVECT,FORTRAN) # pragma linkage(KUWHAG,FORTRAN) # pragma linkage(KUWHAM,FORTRAN) # pragma linkage(KUWHAT,FORTRAN) # pragma linkage(KXALI1,FORTRAN) # pragma linkage(KXPANLM,FORTRAN) # pragma linkage(MACDEF,FORTRAN) # pragma linkage(MDMENU,FORTRAN) # pragma linkage(MHI_CLOSE,FORTRAN) # pragma linkage(MHI_OPEN,FORTRAN) # pragma linkage(MZWIPE,FORTRAN) # pragma linkage(TRACEQ,FORTRAN) #endif #define MAXCMD 512 /* max length of a command line */ #define MAXEDT 32 /* max length of names in edit server */ #define MAXLEV 10 /* max levels of command name path */ #define MAXSVR 20 /* max number of edit server processes */ /* * The PAWC common is referenced through a pointer to allow the use of * dynamic common blocks on IBM systems. */ #define Pawc kc_pawc EXTERN struct COMMON_PAWC { INTEGER NWPAR; INTEGER IXPAWC; INTEGER IHBOOK; INTEGER IXHIGZ; INTEGER IXKUIP; INTEGER IFENCE[5]; INTEGER LQ[8]; INTEGER DATA[999]; } *Pawc; #define IQ(n) Pawc->DATA[n-1] #define Q(n) (((REAL*)(Pawc->DATA))[n-1]) #endif +KEEP,KCOM_H #ifndef KCOM_H_INCLUDED #define KCOM_H_INCLUDED /* kcom.h: Fortran COMMON blocks */ #define Kcalia F77_BLOCK(kcalia,KCALIA) #define MALIAS 200 EXTERN struct { INTEGER NALIAS; LOGICAL ALIFLG; INTEGER ALITYP[MALIAS]; } F77_COMMON(Kcalia); #define Kcalic F77_BLOCK(kcalic,KCALIC) EXTERN struct { char ALINAM[MALIAS][60]; char ALIVAL[MALIAS][80]; } F77_COMMON(Kcalic); #define Kcbrek F77_BLOCK(kcbrek,KCBREK) EXTERN struct { LOGICAL TRAP; /* flag if signal trapping is enabled */ LOGICAL BRKEN; /* not used, always true */ LOGICAL FIRST; /* only used for Apollo */ LOGICAL FIRSG; /* only used for Apollo */ LOGICAL CLWHAT; /* flag if KUWHAT installed break handler */ LOGICAL CLWHAG; /* flag if KUWHAG installed break handler */ LOGICAL TBFLAG; /* flag if traceback should be printed */ } F77_COMMON(Kcbrek); #define Kcefil F77_BLOCK(kcefil,KCEFIL) EXTERN struct { char EDTFIL[MAXSVR][MAXEDT]; /* file name */ char EDTCMD[MAXSVR][MAXEDT]; /* KUIP command */ } F77_COMMON(Kcefil); #define Kcesvr F77_BLOCK(kcesvr,KCESVR) EXTERN struct { INTEGER NSVFIL; /* number of edited file */ INTEGER NSVCUR; /* pointer to current file */ SUBRPTR IESADD; /* routine set by KUEUSR */ LOGICAL SERVER; /* flag if edit server is used */ } F77_COMMON(Kcesvr); #define Kcexit F77_BLOCK(kcexit,KCEXIT) EXTERN struct { SUBRPTR IEXADD; /* routine set by KUEXIT */ SUBRPTR IUSADD; /* routine set by KUSER */ SUBRPTR NEXADD; /* routine set by KUNEXT */ SUBRPTR IUTADD; /* routine set by KUTERM */ SUBRPTR IQUADD; /* routine set by KUQUIT */ SUBRPTR IBRADD; /* routine set by KUBREK */ LOGICAL LICALL; LOGICAL LICAL2; LOGICAL LICAL3; } F77_COMMON(Kcexit); #define Kcmac F77_BLOCK(kcmac,KCMAC) EXTERN struct { LOGICAL MACTAB; INTEGER NSTLEV; LOGICAL QUITFL; LOGICAL WAITFL; LOGICAL WAITFF; LOGICAL DEBTAB; LOGICAL SKIPFL; LOGICAL HEADFL; INTEGER IONERF; LOGICAL NOEXEC; } F77_COMMON(Kcmac); #define Kcparc F77_BLOCK(kcparc,KCPARC) EXTERN struct { char PARLST[512]; /* interface block for KUSER */ char CLIST[80]; char NOALIN[512]; char COMAND[80]; char CHLAST[512]; char NONPOS[512]; } F77_COMMON(Kcparc); #define Kcsigm F77_BLOCK(kcsigm,KCSIGM) EXTERN struct { SUBRPTR ISIADD; /* routine set by KUSIGM */ INTEGER NVSIGM; /* number of temp vectors create for $SIGMA */ } F77_COMMON(Kcsigm); #define Kcutil F77_BLOCK(kcutil,KCUTIL) EXTERN struct { INTEGER NCMD; INTEGER IWD; INTEGER LUNFIL; INTEGER LPRMPT; LOGICAL TIMING; LOGICAL TRACE; INTEGER CALMOD; INTEGER NVADD; INTEGER IREPET; INTEGER IREFAC; INTEGER IBRAK; LOGICAL TIMALL; INTEGER LENTER; LOGICAL UNIQUE; INTEGER LENMUL; LOGICAL MULTFL; LOGICAL HISTOK; LOGICAL NOHIST; INTEGER LENMUM; LOGICAL FILCAS; LOGICAL MEXEFL; } F77_COMMON(Kcutil); #define Kcvect F77_BLOCK(kcvect,KCVECT) EXTERN struct { INTEGER NUMVEC; /* number of vectors stored */ INTEGER TOTPAV; INTEGER GETPAV; LOGICAL TVECFL; } F77_COMMON(Kcvect); #define Quest F77_BLOCK(quest,QUEST) EXTERN struct { INTEGER DATA[100]; } F77_COMMON(Quest); #define IQUEST(n) Quest.DATA[n-1] #define Sikuip F77_BLOCK(sikuip,SIKUIP) EXTERN struct { char CHSIGM[80]; /* command string passed to SIGMA */ } F77_COMMON(Sikuip); #endif +KEEP,KSIG_H #ifndef KSIG_H_INCLUDED #define KSIG_H_INCLUDED /* ksig.h: signal and break handling */ /* * Available signal handling package * * #define SIGNAL_POSIX ==> sigaction() for Unix * #define SIGNAL_BSD ==> sigvec() for VMS and NeXT * #define SIGNAL_V7 ==> signal() */ #if !defined(SIGNAL_BSD) && !defined(SIGNAL_V7) # define SIGNAL_POSIX #else # define sigjmp_buf jmp_buf # define sigsetjmp(buf,save) setjmp(buf) # define siglongjmp(buf,val) longjmp(buf,val) # ifdef vms # define sv_flags sv_onstack # endif #endif EXTERN struct { int trap_enabled; /* flag if exceptions should be trapped */ int traceback; /* print traceback on signal */ int intr_count; /* count number of consecutive ^C interrupts */ int jump_set; /* flag if stack has been setup */ sigjmp_buf stack; } kc_break; #endif +KEEP,KBROW_H1 typedef unsigned long KmPixmap; /* Pixmap from */ \ typedef void *KmWidget; /* Widget from */ \ typedef void *KmCalldata; /* XmAnyCallbackStruct from */ \ /* */ \ typedef enum { /* */ \ BRACT_OPEN = 0, /* */ \ BRACT_ROOT = 1, /* */ \ BRACT_CONT = 2, /* */ \ BRACT_GRAF = 3 /* */ \ } BrActTag; /* */ \ /* */ \ typedef enum { /* */ \ BrActUpdate = 0x01, /* browser window has to be updated ('!') */ \ BrActSeparator = 0x02, /* put separator in menu ('/') */ \ BrActToggle = 0x04, /* register as toggle button */ \ BrActToggleOn = 0x08, /* toggle state is on */ \ BrActSensitive = 0x10 /* button is sensitive */ \ } BrActFlag; /* */ \ /* */ \ typedef struct _BrAction { /* */ \ struct _BrAction *next; /* link to next action binding */ \ BrActFlag flags; /* */ \ char *text; /* text line in menu */ \ char *user_text; /* user text overriding CDF text (malloced)*/ \ char *accel; /* accelerator */ \ char *exec; /* action commands */ \ SUBROUTINE *call_F; /* action routine */ \ IntFunc *call_C; /* action function */ \ BrActTag tag; /* for which window the action is defined */ \ struct _BrClass *class; /* pointer to BrClass in case of open menu */ \ } BrAction; /* */ \ /* */ \ typedef struct _BrClass { /* */ \ struct _BrClass *next; /* link to next browsable class */ \ char *name; /* unique identifier name */ \ char *title; /* title for popup menu (maybe NULL) */ \ SUBROUTINE *scan_km_F; /* user function scanning the directory */ \ pCharFunc *scan_km_C; /* user function scanning the directory */ \ SUBROUTINE *scan_br_F; /* user function scanning for browsables */ \ pCharFunc *scan_br_C; /* user function scanning for browsables */ \ BrAction *root; /* list of actions in root window */ \ BrAction *open; /* list of actions in open menu */ \ } BrClass; /* */ \ /* */ \ +KEEP,KBROW_H2 typedef struct _KmIcon { /* */ \ struct _KmIcon *next; /* link to next icon */ \ char *name; /* unique identifier name */ \ int width; /* width of the pixmap */ \ int height; /* height of the pixmap */ \ char *bitmap; /* bitmap data */ \ KmPixmap pix; /* filled in Motif part */ \ KmPixmap hi_pix; /* high lighted pixmap */ \ } KmIcon; /* */ \ /* */ \ typedef struct _KmClass { /* */ \ struct _KmClass *next; /* link to next object class */ \ int is_dir; /* flag if class has is a directory */ \ char *name; /* unique identifier name */ \ char *title; /* title for popup menu (maybe NULL) */ \ char *big_icon; /* name of the big icon */ \ KmIcon *bicon; /* pointer to the big icon structure */ \ char *sm_icon; /* name of the small icon */ \ KmIcon *sicon; /* pointer to the small icon structure */ \ SUBROUTINE *user_icon_F; /* user function to return icon bitmap */ \ IntFunc *user_icon_C; /* user function to return icon bitmap */ \ BrAction *cont; /* list of actions in content window */ \ BrAction *graf; /* list of actions in graphics window */ \ int obj_count; /* number of objects in content window */ \ } KmClass; /* */ \ /* */ \ typedef enum { /* */ \ KmButtSensitive = 0x00, /* sensitive button */ \ KmButtNonSensitive = 0x01, /* non-sensitive button ('NS') */ \ KmButtToggleSensitive = 0x02, /* toggle-sensitive button ('TS') */ \ KmButtSensitivityMask = 0x03, /* mask for sensitivity type */ \ KmButtSeparator = 0x04 /* put separator in menu ('/') */ \ } KmButtFlag; /* */ \ /* */ \ typedef struct _KmButton { /* */ \ struct _KmButton *next; /* button label or menu item */ \ char *label; /* button label or menu item */ \ char *menu; /* menu name or NULL for buttons */ \ KmButtFlag flags; /* sensitivity type etc. */ \ SUBROUTINE *action_F; /* Fortran routine called with (LABEL,MENU)*/ \ IntFunc *action_C; /* C function called with (label,menu) */ \ KmWidget widget; /* Motif widget ID */ \ } KmButton; /* */ \ +KEEP,KBROW_Q1 "\ +SEQ,KBROW_H1 " +KEEP,KBROW_Q2 "\ +SEQ,KBROW_H2 " +KEEP,KBROW_H #ifndef KBROW_H_INCLUDED #define KBROW_H_INCLUDED /* kbrow.h: browser definitions */ #define KBROW_H1 \ +SEQ,KBROW_H1 KBROW_H1 #define KBROW_H2 \ +SEQ,KBROW_H2 KBROW_H2 typedef struct _KmObject { struct _KmObject *next; /* link to next object definition */ char *name; /* unique identifier name */ char *stext; /* short description text */ char *ltext; /* long description text */ KmClass *class; /* pointer to objects's class structure */ } KmObject; typedef struct _BrVariable { struct _BrVariable *next; /* link to next variable definition */ char *name; /* variable name */ char *value; /* replacement value */ } BrVariable; typedef struct _BrObject { struct _BrObject *next; /* link to next browsable object */ char *name; /* name of the browsable object */ BrClass *class; /* pointer to browsable's class structure */ BrVariable *vars; /* linked list of variable substitutions */ } BrObject; typedef struct _BrClientdata { BrActTag tag; char *brobj; char *brcls; char *path; char *kmobj; char *kmcls; char *stext; char *ltext; char *mtext; } BrClientdata; EXTERN BrClass *brclasses; EXTERN KmObject *kmobjects; EXTERN KmButton *kmbuttons; extern C_PROTO_2(void klnkbrcl, BrClass*, int); extern C_PROTO_2(void klnkkmcl, KmClass*, int); extern C_PROTO_2(void klnkicon, KmIcon*, int); extern C_PROTO_2(void klnkbutt, KmButton*, int); extern C_PROTO_6(void exec_action, BrAction*, char*, char*, int, KmWidget, KmCalldata); extern C_PROTO_2(KmWidget find_button, char*, char*); extern C_PROTO_1(KmIcon* find_kmicon, char*); extern C_PROTO_1(KmClass* find_kmclass, char*); extern C_PROTO_1(BrObject* find_brobject, char*); extern C_PROTO_2(char* get_variable, char*, char*); extern C_PROTO_0(BrObject* scan_brobjects); extern C_PROTO_3(KmObject* scan_kmobjects, char*, char*, int); extern C_PROTO_7(int set_action, char*, int, int, char*, char*, int, int); extern C_PROTO_3(void set_variable, BrObject*, char*, char*); #endif +KEEP,KLINK_H1 struct { /* */ \ /* indirect calls to avoid linking HIGZ */ \ IntFunc *graf_info_C; /* pass display, open and close (ixmotif) */ \ SUBROUTINE *graf_size_F; /* resize window (IGRSIZ) */ \ SUBROUTINE *graf_pick_F; /* identifying graphics objects (IGOBJ) */ \ SUBROUTINE *graf_attr_F; /* set attributes (IGSET) */ \ SUBROUTINE *graf_close_F; /* close workstation (ICLWK) */ \ /* optional routines for Motif customization */ \ pCharFunc *user_FallBk_C; /* get application fallbacks */ \ IntFunc *user_TopWid_C; /* pass toplevel widget identifiers */ \ } klnkaddr; /* */ \ +KEEP,KLINK_Q1 "extern \ +SEQ,KLINK_H1 " +KEEP,KLINK_H #ifndef KLINK_H_INCLUDED #define KLINK_H_INCLUDED /* klink.h: demand linking of special routines */ #define KLINK_H1 EXTERN \ +SEQ,KLINK_H1 KLINK_H1 EXTERN struct { SUBROUTINE *user_exit_F; /* set by KUEXIT */ SUBROUTINE *user_quit_F; /* set by KUQUIT */ SUBROUTINE *user_break_F; /* set by KUBREK */ SUBROUTINE *user_edit_F; /* set by KUEUSR */ SUBROUTINE *user_sigma_F; /* set by KUSIGM */ SUBROUTINE *user_grfl_F; /* set by KUGRFL */ SUBROUTINE *user_term_F; /* set by KUTERM */ SUBROUTINE *user_input_F; /* set by KUSER */ SUBROUTINE *user_locate_F; /* set by KUMLOC */ /* indirect calls to avoid linking Motif */ IntFunc *disp_panel_C; /* display command panel (km_display_cmdpan) */ IntFunc *disp_text_C; /* display text widget (km_display_sctext) */ IntFunc *disp_choice_C; /* display a choice of commands (?) */ IntFunc *disp_clean_C; /* clean before action (km_destroy_all_popup)*/ IntFunc *disp_flush_C; /* flush event queue (FlushEvents) */ IntFunc *disp_busy_C; /* show busy cursor (km_all_cursor) */ IntFunc *disp_exit_C; /* ask confirmation for exit */ IntFunc *disp_quit_C; /* ask confirmation for exit */ IntFunc *disp_select_C; /* select from a number of buttons */ CharFunc *disp_prompt_C; /* prompt for input */ /* indirect calls to avoid linking HIGZ without style G */ IntFunc *higz_init_C; /* initialize menu mode */ SUBROUTINE *higz_menu_F; /* IGMENU */ } kjmpaddr; #endif +KEEP,KFLAG_H #ifndef KFLAG_H_INCLUDED #define KFLAG_H_INCLUDED typedef enum { KmMACRO_COMMAND = 0, /* don't look for macros */ KmMACRO_AUTO, /* look for macros before commands */ KmMACRO_AUTOREVERSE /* look for macros after commands */ } KmMacOrder; typedef enum { KmSTYLE_A = 0x0001, /* Alpha menus */ KmSTYLE_C = 0x0002, /* Command line */ KmSTYLE_G = 0x0004, /* Graphics menus */ KmSTYLE_M = 0x0008, /* Model Human Interface */ KmSTYLE_U = 0x0010, /* User */ KmSTYLE_XM = 0x0020, /* Motif/X11 */ KmSTYLE_major = 0x00FF, /* A..X are mutually exclusive */ KmSTYLE_xL = 0x0100, /* Alpha Letter menus */ KmSTYLE_xP = 0x0200, /* Panel style GP or MP */ KmSTYLE_xS = 0x0400, /* Graphics with Software fonts */ KmSTYLE_xW = 0x0800 /* Graphics with shadowed Width */ } KmStyleFlag; typedef enum { KmTIMING_OFF, /* no timing */ KmTIMING_ON, /* time typed commands */ KmTIMING_ALL /* time individual commands inside macro */ } KmTiming; EXTERN struct { LOGICAL f77_true; /* value of .TRUE. */ LOGICAL f77_false; /* value of .FALSE. */ int do_exit; /* set by KXEXIT */ int do_quit; /* set by KXQUIT */ char *curr_prompt; /* current prompt string */ char *last_cmd; /* last command for $LAST */ KmTiming timing; /* timing on/off/all */ time_t real_time; /* real time at last timing off */ clock_t user_time; /* CPU time at last timing off */ int in_macro; /* command executed in macro */ int in_application; /* application mode is active */ int appl_called; /* application is executing */ char *appl_exit; /* string which leaves application mode */ KmCommand *appl_cmd; /* command which handles application */ char *appl_file; /* temporary file to pass application text */ FILE *appl_stream; /* C stream used for writing appl_file */ int appl_luno; /* Fortran logical unit opened for appl_file */ char *help_file; /* temporary file to view help text */ char *uhlp_file; /* temporary file to get user help text */ int uhlp_luno; /* Fortran logical unit opened for user help */ int in_motif; /* Motif mode is active */ int echo_command; /* echo commands in Motif mode */ char *echo_prompt; /* prompt string for echo commands */ KmStyleFlag style; /* input mode */ int keep_fcase; /* flag if no case conversion for filenames */ int use_server; /* flag if edit server should be used */ int use_kxterm; /* flag if kxterm should be used */ int editor_exit; /* flag set if edit server sent SIGUSR1 */ char *macro_path; /* MACRO/DEFAULT search path */ KmMacOrder macro_search; /* MACRO/DEFAULT search order */ int temp_vectors; /* number of ?SIGMA vectors */ } kc_flags; EXTERN struct { char *set_break; /* SET_SHOW/BREAK */ char set_columns[8]; /* SET_SHOW/COLUMNS */ char *set_command; /* SET_SHOW/COMMAND */ char *set_filecase; /* SET_SHOW/FILECASE */ char *set_host_editor; /* SET_SHOW/HOST_EDITOR */ char *set_host_pager; /* SET_SHOW/HOST_PAGER */ char *set_host_shell; /* SET_SHOW/HOST_SHELL */ char *set_prompt; /* SET_SHOW/PROMPT */ char *set_recall_style; /* SET_SHOW/RECALL_STYLE */ char set_recording[8]; /* SET_SHOW/RECORDING */ char *set_root; /* SET_SHOW/ROOT */ char *set_style; /* SET_SHOW/STYLE */ char *set_timing; /* SET_SHOW/TIMING */ char *help_edit; /* HELP edit mode */ char *defaults_path; /* MACRO/DEFAULTS search path */ char *defaults_order; /* MACRO/DEFAULTS search order */ } kc_value; typedef struct { int top; int left; int width; int height; } KmWindowDsc; EXTERN struct { KmWindowDsc edit_pad; /* coordinates for edit window */ KmWindowDsc help_pad; /* coordinates for readonly window */ int voffset; /* vertical offset */ int hoffset; /* horizontal offset */ int shift_max; /* maximum number of shifted pads */ int shift_now; /* current shift count */ int shift_dir; /* shift direction +/-1 */ int is_a_pad; /* flag if running in an Apollo DM pad */ int is_a_tty; /* flag if stdin and stdout at terminal */ int use_getline; /* flag for using getline() or normal read */ int term_width; /* terminal width in columns */ int kuwhag_called; /* allow style G */ float sgylen; float sgsize; float sgyspa; float sgbord; int panel_rows; /* number of rows in style GP panel */ int *panel_cols; /* number of columns in each row */ char ***panel_keys; /* key labels */ char *panel_keynum; /* value of $KEYNUM */ char *panel_keyval; /* value of $KEYVAL */ } kc_window; extern C_PROTO_1(char* style_name, KmStyleFlag); #endif +KEEP,KMENU_H1 typedef enum { /* */ \ KmFLAG_FORGET = 0x01, /* last value is not kept for Motif panels */ \ KmFLAG_MINUS = 0x02, /* -VALUE is not an abbrev for CHOPT=VALUE */ \ KmFLAG_QUOTE = 0x04, /* do not remove quotes */ \ KmFLAG_VARARG = 0x08 /* append additional args to this param. */ \ } KmParFlag; /* */ \ /* */ \ typedef enum { /* */ \ KmTYPE_CHAR = 'C', /* character string */ \ KmTYPE_FILE = 'F', /* file name */ \ KmTYPE_INT = 'I', /* integer */ \ KmTYPE_OPTION = 'O', /* option */ \ KmTYPE_REAL = 'R' /* real */ \ } KmParType; /* */ \ /* */ \ typedef struct { /* file name */ \ char *filter_default; /* filter wildcard */ \ char *filter_current; /* current filter */ \ } KmParFile; /* */ \ /* */ \ typedef struct { /* */ \ char *range_lower; /* lower value of range */ \ char *range_upper; /* upper value of range */ \ char *slider_lower; /* lower limit for slider */ \ char *slider_upper; /* upper limit for slider */ \ int decimals; /* number of decimals used for slider */ \ } KmParInt; /* */ \ /* */ \ typedef struct { /* option */ \ char **text; /* explanations (parallel to range_value) */ \ int *mutex; /* mutex group to which text belongs */ \ int *radio; /* radio group to which text belongs */ \ } KmParOption; /* */ \ /* */ \ typedef KmParInt KmParReal; /* real and int have the same fields */ \ /* */ \ typedef struct { /* */ \ char *name; /* parameter name */ \ int abbrev; /* minimum length that name is recognized */ \ char *prompt; /* prompt string */ \ char *dfault; /* default value */ \ char *last; /* last value for Motif panel (malloced) */ \ int width; /* width of input field */ \ int range_count; /* number of items in range_value */ \ char **range_value; /* list of allowed values */ \ int select_count; /* number of items in select_count */ \ char **select_value; /* list of values for selection box */ \ KmParFlag flags; /* special flags */ \ KmParType type; /* parameter type */ \ void *ptype; /* structure pointer selected by type */ \ } KmParameter; /* */ \ +KEEP,KMENU_H2 typedef struct _KmCommand { /* */ \ struct _KmCommand *next; /* link to next command */ \ char *path; /* command path */ \ char *name; /* command name */ \ int hidden; /* flag if command is invisible */ \ int level; /* depth of submenus */ \ int total; /* total number of parameters */ \ int mandatory; /* number of mandatory parameters */ \ KmParameter **par; /* list of total parameter descriptions */ \ int list_par; /* index+1 of parameter taking a list */ \ int xcount; /* count number of action calls */ \ SUBROUTINE *action_F; /* action routine */ \ IntFunc *action_C; /* action routine */ \ SUBROUTINE *user_help_F; /* user help routine */ \ IntFunc *user_help_C; /* user help routine */ \ int nguidance; /* number of lines in guidance text */ \ char **guidance; /* help text */ \ int argc; /* number of arguments entered */ \ char **argv; /* argc argument values */ \ char *argline; /* argument line as entered */ \ int *argoffs; /* argc offsets into argline for KUGETE */ \ } KmCommand; /* */ \ /* */ \ typedef struct _KmMenu { /* */ \ struct _KmMenu *next; /* link to next menu */ \ struct _KmMenu *down; /* link to submenu */ \ char *path; /* path of parent menu */ \ char *name; /* menu name */ \ int level; /* depth of submenus */ \ KmCommand *cmds; /* link to first command */ \ int nguidance; /* number of lines in guidance text */ \ char **guidance; /* help text */ \ } KmMenu; /* */ \ /* */ \ extern void klnkbrcl(); /* */ \ extern void klnkicon(); /* */ \ extern void klnkkmcl(); /* */ \ extern void klnkmenu(); /* */ \ +KEEP,KMENU_Q1 "\ +SEQ,KMENU_H1 " +KEEP,KMENU_Q2 "\ +SEQ,KMENU_H2 " +KEEP,KMENU_H #ifndef KMENU_H_INCLUDED #define KMENU_H_INCLUDED /* kmenu.h: data structures for menu and command definitions */ #define KMENU_H1 \ +SEQ,KMENU_H1 KMENU_H1 #define KMENU_H2 \ +SEQ,KMENU_H2 KMENU_H2 /* * temporary fix until we can reserve an extra word in KmCommand structure * to count keyboard and macro commands separately */ #define XCOUNT_SHIFT 10 #define XCOUNT_OFFSET (1 << XCOUNT_SHIFT) #define XCOUNT_MASK (XCOUNT_OFFSET - 1) extern C_PROTO_2(void check_version, int, int); extern C_PROTO_0(void check_edit_server); extern C_PROTO_3(int exec_cmd_string, char*, int, int(*)()); extern C_PROTO_1(int exec_decoded_cmd, KmCommand*); extern C_PROTO_1(KmMenu* find_submenu, char*); extern C_PROTO_2(char* fmt_cmd_help, KmCommand*, int); extern C_PROTO_0(void menu_style); extern C_PROTO_2(void print_cmd_list, KmCommand**, char*); extern C_PROTO_1(void reset_arg_list, KmCommand*); extern C_PROTO_1(KmMenu** root_menu_list, char*); extern C_PROTO_2(KmCommand* search_command, char*, KmCommand***); #endif +KEEP,KHASH_H #ifndef KHASH_H_INCLUDED #define KHASH_H_INCLUDED /* khash.h: hash table management */ typedef struct _HashEntry { struct _HashEntry *next; /* link to next entry */ char *name; /* symbol name */ void *value; /* symbol value */ } HashEntry; typedef struct { int size; /* table size should be a prime number */ HashEntry **entries; /* pointer to array of size entries */ int nentries; /* number of entries */ int copy; /* flag if strdup/free(value) should be used */ } HashTable; #define ALIAS_TABLE_SIZE 3 /* should be a prime */ EXTERN struct { int translate; /* flag if translation wanted */ int substitutions; /* how many more before recursive alarm */ HashTable *arg_table; /* Argument alias table */ HashTable *cmd_table; /* Command alias table */ HashTable *var_table; /* macro variables */ } kc_alias; extern C_PROTO_2(HashTable* hash_create, int, int); extern C_PROTO_1(void hash_clear, HashTable*); extern C_PROTO_1(void hash_destroy, HashTable*); extern C_PROTO_3(void hash_insert, HashTable*, const char*, void*); extern C_PROTO_2(void hash_remove, HashTable*, const char*); extern C_PROTO_2(void* hash_lookup, HashTable*, const char*); extern C_PROTO_1(int hash_entries, HashTable*); extern C_PROTO_1(char** hash_names, HashTable*); extern C_PROTO_1(void** hash_values, HashTable*); extern C_PROTO_1(char* subst_arg_alias, char*); extern C_PROTO_1(char* subst_cmd_alias, char*); extern C_PROTO_1(char* subst_var_alias, char*); extern C_PROTO_1(char* subst_sys_fun, char*); #endif +KEEP,MKTERM. #ifndef MKTERM_INCLUDED #define MKTERM_INCLUDED #define ESCAPE "#@" typedef void (*KxtermActionProc)( #ifndef NO_PROTOTYPES char** /* params */, int /* num_params */ #endif ); typedef struct _KxtermActionsRec{ char *string; KxtermActionProc proc; } KxtermActionsRec; typedef KxtermActionsRec *KxtermActionList; extern C_PROTO_1(void kxterm_add_actions, KxtermActionList); extern C_PROTO_1(void handle_kxterm_action, char *); extern C_PROTO_1(void send_kxterm_cmd, char**); extern C_PROTO_1(void send_single_kxterm_cmd, char*); #endif +DECK,hkuip_t,IF=TEST. +KEEP,KHAIX370 #ifndef AIX370 # define AIX370 #endif +KEEP,KHAPOFTN #ifndef APOLLO_FTN # define APOLLO_FTN #endif +KEEP,KHIBMVM #ifndef IBMVM # define IBMVM #endif +KEEP,KHIBMMVS #ifndef IBMMVS # define IBMMVS #endif +KEEP,KHNEWLIB #ifndef NEWLIB # define NEWLIB #endif +KEEP,KUIP_H /* kuip.h: system dependent defines */ /* update version if structures have changed */ #define KUIP_VERSION 921023 /* identify system if not possible from preprocessor defines */ +SEQ,KHAIX370,IF=AIX370 +SEQ,KHAPOFTN,IF=APOFTN +SEQ,KHIBMVM ,IF=IBMVM +SEQ,KHIBMMVS,IF=IBMMVS +SEQ,KHNEWLIB,IF=NEWLIB #ifdef AIX370 # define MACHINE_NAME "IBMAIX" # define UNIX # define F77_EXTERN_INDIRECT #endif #if defined(apollo) || defined(__apollo) # define MACHINE_NAME "APOLLO" # define APOLLO # define UNIX # include # include # include # include # include # include # ifdef APOLLO_FTN /* using /com/ftn instead of /bin/f77 */ # define F77_CHAR_LEN_IND short # define F77_EXTERN_LOWERCASE # endif # define F77_EXTERN_INDIRECT # define F77_COMMON(name) name __attribute((__section(name))) # ifndef EXTERN # define EXTERN /* essential for accessing COMMON blocks */ # endif # define FATAL_SIGFPE # define HAVE_MEMMOVE # define HAVE_STRCASECMP # define HAVE_STRDUP # define NO_DIRENT_H # define TERMIO_BSD /* for getline we must compile under bsd4.3 */ #endif #if defined(__convexc__) # define CONVEX # define MACHINE_NAME "CONVEX" # define UNIX # define HAVE_MEMMOVE # define HAVE_STRCASECMP # define HAVE_STRDUP # define MATCH_RE_COMP /* use re_comp/re_exec */ # define F77_BLOCK(name,NAME) F77_NAME(ConCat(_,name),NAME) #endif #ifdef CRAY # define MACHINE_NAME "CRAY" # define UNIX # include # define F77_EXTERN_UPPERCASE # define F77_CHAR_DSC_CRAY # ifndef EXTERN # define EXTERN /* essential for accessing COMMON blocks */ # endif # define HAVE_STRCASECMP # define HAVE_STRDUP # define NO_EDIT_SERVER #endif #if defined(hpux) || defined(__hpux) # define MACHINE_NAME "HPUX" # define HPUX # define UNIX # ifdef hpux /* cc -Ac */ # define NO_ANSI_CPP # define NO_PROTOTYPES # endif # ifndef _HPUX_SOURCE # define _HPUX_SOURCE # endif # define FATAL_SIGFPE /* needs f77 +T and ON REAL UNDERFLOW IGNORE */ # define HAVE_MEMMOVE # define HAVE_STRCASECMP # define HAVE_STRDUP # define HAVE_STRRSTR #endif #ifdef _IBMR2 # define IBMRT # define MACHINE_NAME "IBMRT" # define UNIX # define HAVE_MEMMOVE # define HAVE_STRCASECMP # define HAVE_STRDUP #endif #ifdef IBMVM # define ARG_STYLE_CMS # define MACHINE_NAME "IBM" # define OS_NAME "VM" # ifndef IBM370 # define IBM370 # endif #endif #ifdef IBMMVS # define MACHINE_NAME "IBMMVS" # define OS_NAME "MVS" # ifndef IBM370 # define IBM370 # endif #endif #ifdef IBM370 # define F77_CHAR_LEN_IND int /* each parameter has a length argument ! */ # define F77_XXXX_ARG_LEN(x) F77_CHAR_ARG_LEN(x) # define F77_EXTERN_INDIRECT # define F77_EXTERN_UPPERCASE # define NO_FCNTL_H # define NO_UNISTD_H # define SIGNAL_V7 #endif #ifdef linux # define LINUX # define MACHINE_NAME "LINUX" # define UNIX # define HAVE_MEMMOVE # define HAVE_STRCASECMP # define HAVE_STRDUP #endif #ifdef MSDOS # define MACHINE_NAME "MSDOS" # define UNIX # define NO_EDIT_SERVER # define NO_SOCKET_H # define NO_SYS_TIME_H # define SIGNAL_V7 #endif #ifdef WIN32 # define WINNT # define MACHINE_NAME "WNT" # define UNIX # define MSDOS # include # include # include # define text_mode__() # define NO_EDIT_SERVER # define NO_SOCKET_H # define NO_SYS_TIME_H # define NO_UNISTD_H # define SIGNAL_V7 #endif #ifdef NeXT # define MACHINE_NAME "NEXT" # define UNIX # define getcwd(path,maxlen) getwd(path) # define F77_BLOCK(lc,uc) lc # define F77_EXTERN_INDIRECT /* each parameter has a length argument ! */ # define F77_XXXX_ARG_LEN(x) F77_CHAR_ARG_LEN(x) # define F77_XXXX_USE_LEN(x) ,286716 /* don't know if value matters */ # define HAVE_MEMMOVE # define HAVE_VFORK # define MATCH_RE_COMP /* use re_comp/re_exec */ # define NO_DIRENT_H # define NO_UNISTD_H # define SIGNAL_BSD # define TERMIO_BSD #endif #ifdef __osf__ # define UNIX # ifdef __alpha # define ALPHA # define MACHINE_NAME "ALPHA" # endif # define const /* wrong prototype for strdup() in string.h */ # define HAVE_MEMMOVE # define HAVE_STRCASECMP # define HAVE_STRDUP #endif #if defined(sgi) || defined(__sgi) # define MACHINE_NAME "SGI" # define SGI # define UNIX # ifndef __sgi /* Irix 3 */ # define NO_ANSI_CPP # define NO_PROTOTYPES # endif # define HAVE_MEMMOVE # define HAVE_STRCASECMP # define HAVE_STRDUP #endif #if defined(sun) || defined(__sun) # define MACHINE_NAME "SUN" # define SUN # define UNIX # ifndef __STDC__ /* cc vs. acc */ # define NO_ANSI_CPP # define NO_PROTOTYPES # else # define const /* wrong prototype for strdup() in string.h */ # endif # define HAVE_STRCASECMP # define HAVE_STRDUP # define HAVE_VFORK # include # define MATCH_RE_COMP /* use re_comp/re_exec */ #endif #if defined(ultrix) || defined(__ultrix) # define MACHINE_NAME "DECS" # define ULTRIX # define UNIX # ifndef __ultrix /* cc vs. c89 */ # define NO_ANSI_CPP # define NO_PROTOTYPES # endif # define HAVE_MEMMOVE # define HAVE_STRCASECMP # define HAVE_VFORK # define TERMIO_BSD #endif #ifdef vms # define OS_NAME "VMS" # ifdef __ALPHA # define ALPHA # define MACHINE_NAME "ALPHA" # pragma extern_model common_block # include /* inside descrip.h on VAX */ # else # define MACHINE_NAME "VAX" # define NO_ANSI_CPP # define raise gsignal /* raise() not in library ? */ # endif # include # include # include /* lib$... prototypes */ # include # include # include # include # include # include # include # include /* sys$... prototypes */ # include # include # include # ifndef R_OK /* no access() modes in unixio.h on VAX/VMS */ # define F_OK 0 # define X_OK 1 # define W_OK 2 # define R_OK 4 # endif # define ARG_STYLE_VMS # define F77_CHAR_DSC_VMS # define F77_EXTERN_LOWERCASE # define HAVE_MEMMOVE # define HAVE_STAT_H # define HAVE_VFORK /* actually have only vfork */ # define NO_FCNTL_H # define NO_UNISTD_H # define SIGNAL_BSD # define sigmask(sig) (1L << (sig-1)) /* should be in signal.h */ # define USE_EDIT_SERVER /* only for TPU/DISPLAY=MOTIF */ #endif /* vms */ #include #include #include #ifndef NO_FCNTL_H #include #endif #include /* contains strtod() and strtol() on some systems */ #include #include #include #include #include #include #ifndef NO_UNISTD_H #include #endif #ifndef HAVE_VFORK # define vfork fork #endif #ifdef UNIX # define OS_NAME "UNIX" # include # include # ifndef NO_SYS_TIME_H # include /* struct timeval */ # endif # ifndef MSDOS # if !defined(TERMIO_BSD) && !defined(TERMIO_SYSV) # define TERMIO_POSIX # endif # include # ifndef NO_DIRENT_H /* POSIX opendir() */ # include # else /* BSD opendir() */ # include /* plus */ # define dirent direct /* struct dirent... */ # ifndef S_IRUSR # define S_IRUSR (S_IREAD) /* read permission, owner */ # define S_IWUSR (S_IWRITE) /* write permission, owner */ # define S_IXUSR (S_IEXEC) /* execute/search permission, owner */ # endif # endif # endif # define HAVE_STAT_H # ifndef NO_EDIT_SERVER # define USE_EDIT_SERVER # ifndef F_LOCK /* BSD file locking */ # include # define lockf(fd,op,offs) flock(fd,op) # define F_LOCK LOCK_EX # define F_ULOCK LOCK_UN # endif # endif #endif #ifdef SUN # ifndef CLOCKS_PER_SEC # define CLOCKS_PER_SEC 1000000 /* missing in time.h */ # define difftime(t1,t0) ((double)(t1-t0)) # define raise(sig) kill(getpid(),sig) # endif #endif #ifndef CLOCKS_PER_SEC # define CLOCKS_PER_SEC 100 /* missing in VAX/VMS time.h */ #endif #ifdef HAVE_STAT_H # define KmTimeStamp struct stat # define get_stamp(path,stamp) stat(path,stamp) # define cmp_stamp(stamp1,stamp2) ((stamp2)->st_mtime == (stamp1)->st_mtime) #endif #ifndef KmTimeStamp # define KmTimeStamp int # define get_stamp(path,stamp) 0 # define cmp_stamp(stamp1,stamp2) 0 #endif #ifdef MATCH_RE_COMP extern char *re_comp(); extern int re_exec(); #else extern char *regcmp(); extern char *regex(); #endif /* command line arguments recognized by KUARGS */ #if !defined(ARG_STYLE_CMS) && !defined(ARG_STYLE_VMS) # define ARG_STYLE_UNIX #endif #ifndef MACHINE_NAME # define MACHINE_NAME "UNKNOWN" /* value returned by $MACHINE */ #endif #ifndef OS_NAME # define OS_NAME "UNKNOWN" /* value returned by $OS */ #endif /* #define EXTERN must be in one routine to allocate space for globals */ #ifndef EXTERN # define EXTERN extern #endif /* #define STATIC extern if debugger does not see static functions */ #ifndef STATIC # define STATIC static #endif #if defined(__GNUC__) || defined(__STDC__) # ifdef NO_ANSI_CPP # undef NO_ANSI_CPP # endif # ifdef NO_PROTOTYPES # undef NO_PROTOTYPES # endif #endif /* * Preprocessor syntax for token concatenation */ #ifndef NO_ANSI_CPP # define ConCat(con,cat) con##cat #else # define ConCat(con,cat) con/**/cat #endif /* * Prototyping for C functions */ #ifndef NO_PROTOTYPES # define C_PROTO_0(name) \ name(void) # define C_PROTO_1(name,arg1) \ name(arg1) # define C_PROTO_2(name,arg1,arg2) \ name(arg1,arg2) # define C_PROTO_3(name,arg1,arg2,arg3) \ name(arg1,arg2,arg3) # define C_PROTO_4(name,arg1,arg2,arg3,arg4) \ name(arg1,arg2,arg3,arg4) # define C_PROTO_5(name,arg1,arg2,arg3,arg4,arg5) \ name(arg1,arg2,arg3,arg4,arg5) # define C_PROTO_6(name,arg1,arg2,arg3,arg4,arg5,arg6) \ name(arg1,arg2,arg3,arg4,arg5,arg6) # define C_PROTO_7(name,arg1,arg2,arg3,arg4,arg5,arg6,arg7) \ name(arg1,arg2,arg3,arg4,arg5,arg6,arg7) # define C_PROTO_8(name,arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8) \ name(arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8) # define C_PROTO_9(name,arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8,arg9) \ name(arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8,arg9) # define C_PROTO_13(name,a1,a2,a3,a4,a5,a6,a7,a8,a9,b0,b1,b2,b3) \ name(a1,a2,a3,a4,a5,a6,a7,a8,a9,b0,b1,b2,b3) # define C_PROTO_16(name,a1,a2,a3,a4,a5,a6,a7,a8,a9,b0,b1,b2,b3,b4,b5,b6) \ name(a1,a2,a3,a4,a5,a6,a7,a8,a9,b0,b1,b2,b3,b4,b5,b6) # define C_PROTO_17(name,a1,a2,a3,a4,a5,a6,a7,a8,a9,b0,b1,b2,b3,b4,b5,b6,b7) \ name(a1,a2,a3,a4,a5,a6,a7,a8,a9,b0,b1,b2,b3,b4,b5,b6,b7) # define C_DECL_0(name) \ name() # define C_DECL_1(name,t1,p1) \ name(t1 p1) # define C_DECL_2(name,t1,p1,t2,p2) \ name(t1 p1,t2 p2) # define C_DECL_3(name,t1,p1,t2,p2,t3,p3) \ name(t1 p1,t2 p2,t3 p3) # define C_DECL_4(name,t1,p1,t2,p2,t3,p3,t4,p4) \ name(t1 p1,t2 p2,t3 p3,t4 p4) # define C_DECL_5(name,t1,p1,t2,p2,t3,p3,t4,p4,t5,p5) \ name(t1 p1,t2 p2,t3 p3,t4 p4,t5 p5) # define C_DECL_6(name,t1,p1,t2,p2,t3,p3,t4,p4,t5,p5,t6,p6) \ name(t1 p1,t2 p2,t3 p3,t4 p4,t5 p5,t6 p6) # define C_DECL_7(name,t1,p1,t2,p2,t3,p3,t4,p4,t5,p5,t6,p6,t7,p7) \ name(t1 p1,t2 p2,t3 p3,t4 p4,t5 p5,t6 p6,t7 p7) # define C_DECL_8(name,t1,p1,t2,p2,t3,p3,t4,p4,t5,p5,t6,p6,t7,p7,t8,p8) \ name(t1 p1,t2 p2,t3 p3,t4 p4,t5 p5,t6 p6,t7 p7,t8 p8) # define C_DECL_9(name,t1,p1,t2,p2,t3,p3,t4,p4,t5,p5,t6,p6,t7,p7,t8,p8,t9,p9)\ name(t1 p1,t2 p2,t3 p3,t4 p4,t5 p5,t6 p6,t7 p7,t8 p8,t9 p9) # define C_DECL_13(name,t1,p1,t2,p2,t3,p3,t4,p4,t5,p5,t6,p6,t7,p7,t8,p8,\ t9,p9,t10,p10,t11,p11,t12,p12,t13,p13) \ name(t1 p1,t2 p2,t3 p3,t4 p4,t5 p5,t6 p6,t7 p7,t8 p8,\ t9 p9,t10 p10,t11 p11,t12 p12,t13 p13) #else # define const # define C_PROTO_0(name) \ name() # define C_PROTO_1(name,arg1) \ name() # define C_PROTO_2(name,arg1,arg2) \ name() # define C_PROTO_3(name,arg1,arg2,arg3) \ name() # define C_PROTO_4(name,arg1,arg2,arg3,arg4) \ name() # define C_PROTO_5(name,arg1,arg2,arg3,arg4,arg5) \ name() # define C_PROTO_6(name,arg1,arg2,arg3,arg4,arg5,arg6) \ name() # define C_PROTO_7(name,arg1,arg2,arg3,arg4,arg5,arg6,arg7) \ name() # define C_PROTO_8(name,arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8) \ name() # define C_PROTO_9(name,arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8,arg9) \ name() # define C_PROTO_13(name,a1,a2,a3,a4,a5,a6,a7,a8,a9,b0,b1,b2,b3) \ name() # define C_PROTO_16(name,a1,a2,a3,a4,a5,a6,a7,a8,a9,b0,b1,b2,b3,b4,b5,b6) \ name() # define C_PROTO_17(name,a1,a2,a3,a4,a5,a6,a7,a8,a9,b0,b1,b2,b3,b4,b5,b6,b7) \ name() # define C_DECL_0(name) \ name() # define C_DECL_1(name,t1,p1) \ name( p1) \ t1 p1; # define C_DECL_2(name,t1,p1,t2,p2) \ name( p1, p2) \ t1 p1;t2 p2; # define C_DECL_3(name,t1,p1,t2,p2,t3,p3) \ name( p1, p2, p3) \ t1 p1;t2 p2;t3 p3; # define C_DECL_4(name,t1,p1,t2,p2,t3,p3,t4,p4) \ name( p1, p2, p3, p4) \ t1 p1;t2 p2;t3 p3;t4 p4; # define C_DECL_5(name,t1,p1,t2,p2,t3,p3,t4,p4,t5,p5) \ name( p1, p2, p3, p4, p5) \ t1 p1;t2 p2;t3 p3;t4 p4;t5 p5; # define C_DECL_6(name,t1,p1,t2,p2,t3,p3,t4,p4,t5,p5,t6,p6) \ name( p1, p2, p3, p4, p5, p6) \ t1 p1;t2 p2;t3 p3;t4 p4;t5 p5;t6 p6; # define C_DECL_7(name,t1,p1,t2,p2,t3,p3,t4,p4,t5,p5,t6,p6,t7,p7) \ name( p1, p2, p3, p4, p5, p6, p7) \ t1 p1;t2 p2;t3 p3;t4 p4;t5 p5;t6 p6;t7 p7; # define C_DECL_8(name,t1,p1,t2,p2,t3,p3,t4,p4,t5,p5,t6,p6,t7,p7,t8,p8) \ name( p1, p2, p3, p4, p5, p6, p7, p8) \ t1 p1;t2 p2;t3 p3;t4 p4;t5 p5;t6 p6;t7 p7;t8 p8; # define C_DECL_9(name,t1,p1,t2,p2,t3,p3,t4,p4,t5,p5,t6,p6,t7,p7,t8,p8,t9,p9)\ name( p1, p2, p3, p4, p5, p6, p7, p8, p9)\ t1 p1;t2 p2;t3 p3;t4 p4;t5 p5;t6 p6;t7 p7;t8 p8;t9 p9; # define C_DECL_13(name,A,a,B,b,C,c,D,d,E,e,F,f,G,g,H,h,I,i,J,j,K,k,L,l,M,m)\ name( a, b, c, d, e, f, g, h, i, j, k, l, m)\ A a;B b;C c;D d;E e;F f;G g;H h;I i;J j;K k;L l;M m; #endif typedef int IntFunc(); typedef char* CharFunc(); typedef char** pCharFunc(); #define KUMAC_UNWIND -30041961 /* error status to quit macro execution */ /* * convenience functions from kkern.c */ extern C_PROTO_2(char* fexpand, const char*, const char*); extern C_PROTO_1(char* fsymlink, const char*); extern C_PROTO_3(char* fsearch, const char*, const char*, const char*); extern C_PROTO_2(char* fstrdup, const char*, size_t); extern C_PROTO_2(char* fstr0dup, const char*, size_t); extern C_PROTO_2(char* fstrtrim, const char*, size_t); extern C_PROTO_2(char* fstr0trim, const char*, size_t); extern C_PROTO_2(size_t fstrlen, const char*, size_t); extern C_PROTO_3(size_t fstrset, char*, size_t, const char*); extern C_PROTO_2(double fstrtod, char*, char**); extern C_PROTO_2(int fstrtoi, char*, char**); extern C_PROTO_3(char* fstrvec, char**, int, int*); #ifndef HAVE_MEMMOVE extern C_PROTO_3(void* memmove, void*, const void*, size_t); #endif #ifndef HAVE_STRCASECMP extern C_PROTO_2(int strcasecmp, const char*, const char*); extern C_PROTO_3(int strncasecmp, const char*, const char*, size_t); #endif #ifndef HAVE_STRDUP extern C_PROTO_1(char* strdup, const char*); #endif #ifndef HAVE_STRRSTR extern C_PROTO_2(char* strrstr, const char*, const char*); #endif extern C_PROTO_1(char* str0dup, const char*); extern C_PROTO_2(char* str2dup, const char*, const char*); extern C_PROTO_3(char* str3dup, const char*, const char*, const char*); extern C_PROTO_4(char* str4dup, const char*, const char*, const char*, const char*); extern C_PROTO_5(char* str5dup, const char*, const char*, const char*, const char*, const char*); extern C_PROTO_2(char* strndup, const char*, int); extern C_PROTO_2(char* mstrcat, char*, const char*); extern C_PROTO_3(char* mstr2cat, char*, const char*, const char*); extern C_PROTO_4(char* mstr3cat, char*, const char*, const char*, const char*); extern C_PROTO_5(char* mstr4cat, char*, const char*, const char*, const char*, const char*); extern C_PROTO_3(char* mstrncat, char*, const char*, int); extern C_PROTO_3(char* mstrccat, char*, int, int); extern C_PROTO_2(char* mstricat, char*, int); extern C_PROTO_2(int mstrlen, char**, int); extern C_PROTO_1(char* strqtok, char*); extern C_PROTO_1(char* strlower, char*); extern C_PROTO_1(char* strupper, char*); extern C_PROTO_2(char* strfromd, double, int); extern C_PROTO_2(char* strfromi, int, int); /* * C-interface functions */ extern C_PROTO_0(char* k_getar); extern C_PROTO_2(void k_setar, int, char**); extern C_PROTO_0(char* k_userid); extern C_PROTO_0(void ku_alfa); extern C_PROTO_2(char* ku_appl, int*, int*); extern C_PROTO_1(void ku_cmdl, char*); extern C_PROTO_2(int ku_edit, char*, int); extern C_PROTO_1(char* ku_eval, char*); extern C_PROTO_1(int ku_exec, char*); extern C_PROTO_1(int ku_exel, char*); extern C_PROTO_0(char* ku_getc); extern C_PROTO_0(char* ku_gete); extern C_PROTO_0(char* ku_getf); extern C_PROTO_0(int ku_geti); extern C_PROTO_0(char* ku_getl); extern C_PROTO_0(char* ku_getq); extern C_PROTO_0(double ku_getr); extern C_PROTO_0(char* ku_gets); extern C_PROTO_1(char* ku_fcase, char*); extern C_PROTO_2(char* ku_home, char*, char*); extern C_PROTO_1(int ku_intr, int); extern C_PROTO_1(void ku_last, char*); extern C_PROTO_2(int ku_more, char*, char*); extern C_PROTO_0(int ku_npar); extern C_PROTO_2(void ku_pad, char*, int); extern C_PROTO_0(char* ku_path); extern C_PROTO_2(void ku_piaf, int, void(*)()); extern C_PROTO_2(char* ku_proc, char*, char*); extern C_PROTO_2(char* ku_prof, char*, char*); extern C_PROTO_2(int ku_proi, char*, int); extern C_PROTO_1(char* ku_prop, char*); extern C_PROTO_2(double ku_pror, char*, double); extern C_PROTO_2(char* ku_pros, char*, char*); extern C_PROTO_0(char** ku_qenv); extern C_PROTO_1(char* ku_qexe, char*); extern C_PROTO_2(int ku_sapp, char*, char*); extern C_PROTO_0(void ku_shut); extern C_PROTO_1(int ku_stop, int); extern C_PROTO_2(void ku_time, time_t, clock_t); extern C_PROTO_2(void ku_trap, int, int); extern C_PROTO_1(int ku_vqaddr, char*); extern C_PROTO_1(int ku_vtype, char*); extern C_PROTO_2(int ku_vvalue, char*, double*); extern C_PROTO_0(void ku_whag); extern C_PROTO_1(void ku_what, void(*)()); extern C_PROTO_1(char* getline, char*); extern C_PROTO_2(void gl_config, char*, int); extern C_PROTO_1(void gl_histadd, char*); extern C_PROTO_1(void gl_setwidth, int); extern C_PROTO_2(char* input_line, char*, int); extern C_PROTO_0(void leave_kuip); extern C_PROTO_2(int len_alias, char*, int); extern C_PROTO_1(int len_sysfun, char*); extern C_PROTO_1(int len_vector, char*); extern C_PROTO_2(char* quote_string, char*, int); extern C_PROTO_0(void reset_break); extern C_PROTO_1(void signal_handler, int ); extern C_PROTO_2(int vms_signal_handler, void*, void* ); +KEEP,KFOR_H /* kfor.h: Fortran-C interface */ /* * Fortran data types */ typedef int INTEGER; typedef int LOGICAL; typedef float REAL; typedef double DBLPREC; typedef INTEGER INT_FUNCTION(); typedef INT_FUNCTION *INT_FUNCPTR; typedef void (*SUBRPTR)(); typedef void SUBROUTINE(); #ifdef IBM370 #pragma linkage(SUBROUTINE,FORTRAN) #pragma linkage(INT_FUNCTION,FORTRAN) #pragma map(__CTOF,"@@CTOF") extern INTEGER __CTOF( INT_FUNCPTR, ... ); #endif typedef union _EQUIV_INT_REAL { INTEGER i; LOGICAL l; REAL r; } EQUIV_INT_REAL; /* * Mapping of C-routine name for Fortran CALL SUB * * #define F77_EXTERN_LOWERCASE ==> void sub() * #define F77_EXTERN_UPPERCASE ==> void SUB() * otherwise ==> void sub_() */ #ifdef F77_EXTERN_UPPERCASE # define F77_NAME(name,NAME) NAME #else # ifdef F77_EXTERN_LOWERCASE # define F77_NAME(name,NAME) name # else # define F77_NAME(name,NAME) ConCat(name,_) # endif #endif #ifndef F77_BLOCK # define F77_BLOCK(name,NAME) F77_NAME(name,NAME) #endif #ifndef F77_COMMON # define F77_COMMON(name) name #endif /* * Routine address in CALL SUB(FUN) ; EXTERNAL FUN * * #define F77_EXTERN_INDIRECT ==> void (**fun)(); * otherwise ==> void (*fun)(); */ #ifdef F77_EXTERN_INDIRECT # define F77_EXTERN_ARG(e) ConCat(e,_dsc) # define F77_EXTERN_DCL(e) SUBROUTINE **ConCat(e,_dsc); # define F77_EXTERN_DEF(e) SUBROUTINE *e = *ConCat(e,_dsc); #else # define F77_EXTERN_ARG(e) e # define F77_EXTERN_DCL(e) SUBROUTINE *e; # define F77_EXTERN_DEF(e) #endif #define F77_EXTERN2ARG(e1,e2) F77_EXTERN_ARG(e1),F77_EXTERN_ARG(e2) #define F77_EXTERN2DCL(e1,e2) F77_EXTERN_DCL(e1) F77_EXTERN_DCL(e2) #define F77_EXTERN2DEF(e1,e2) F77_EXTERN_DEF(e1) F77_EXTERN_DEF(e2) #define F77_EXTERN3ARG(e1,e2,e3) F77_EXTERN_ARG(e1),F77_EXTERN2ARG(e2,e3) #define F77_EXTERN3DCL(e1,e2,e3) F77_EXTERN_DCL(e1) F77_EXTERN2DCL(e2,e3) #define F77_EXTERN3DEF(e1,e2,e3) F77_EXTERN_DEF(e1) F77_EXTERN2DEF(e2,e3) #define F77_EXTERN4ARG(e1,e2,e3,e4) F77_EXTERN_ARG(e1),F77_EXTERN3ARG(e2,e3,e4) #define F77_EXTERN4DCL(e1,e2,e3,e4) F77_EXTERN_DCL(e1) F77_EXTERN3DCL(e2,e3,e4) #define F77_EXTERN4DEF(e1,e2,e3,e4) F77_EXTERN_DEF(e1) F77_EXTERN3DEF(e2,e3,e4) /* * Access to Fortran CHARACTER arguments */ #ifdef F77_CHAR_DSC_VMS /* VMS string descriptors */ # define F77_CHAR_ARG_PTR(s) ConCat(s,_dsc) # define F77_CHAR_ARG_LEN(s) # define F77_CHAR_ARG_DCL(s) struct dsc$descriptor_s *ConCat(s,_dsc); # define F77_CHAR_ARG_DEF(s) char *s = ConCat(s,_dsc)->dsc$a_pointer; \ int ConCat(len_,s) = ConCat(s,_dsc)->dsc$w_length; # define F77_CHAR_DEF_DSC(s,p,l) struct dsc$descriptor_s ConCat(s,__dsc); # define F77_CHAR_ASS_DSC(s,p,l) ConCat(s,__dsc).dsc$w_length = l; \ ConCat(s,__dsc).dsc$b_dtype = DSC$K_DTYPE_T;\ ConCat(s,__dsc).dsc$b_class = DSC$K_CLASS_S;\ ConCat(s,__dsc).dsc$a_pointer = p; # define F77_CHAR_USE_PTR(s,p,l) &ConCat(s,__dsc) # define F77_CHAR_USE_LEN(s,p,l) #endif #ifdef F77_CHAR_DSC_CRAY /* Cray string descriptors */ # define F77_CHAR_ARG_PTR(s) ConCat(s,_dsc) # define F77_CHAR_ARG_LEN(s) # define F77_CHAR_ARG_DCL(s) _fcd ConCat(s,_dsc); # define F77_CHAR_ARG_DEF(s) char *s = _fcdtocp(ConCat(s,_dsc)); \ int ConCat(len_,s) = _fcdlen(ConCat(s,_dsc)); # define F77_CHAR_DEF_DSC(s,p,l) # define F77_CHAR_ASS_DSC(s,p,l) # define F77_CHAR_USE_PTR(s,p,l) _cptofcd(p,l) # define F77_CHAR_USE_LEN(s,p,l) #endif #ifdef F77_CHAR_LEN_IND /* string length passed by reference */ /* * The IBM C/370 compiler passes the Fortran CHARACTER pointer directly * instead of making a private copy. Therefore we have to do the copy * char *s = s_ptr ourself in case the routine uses s as local variable. */ # define F77_CHAR_ARG_PTR(s) ConCat(s,_ptr) # define F77_CHAR_ARG_LEN(s) , ConCat(s,_dsc) # define F77_CHAR_ARG_DCL(s) char *ConCat(s,_ptr); \ F77_CHAR_LEN_IND *ConCat(s,_dsc); # define F77_CHAR_ARG_DEF(s) char *s = ConCat(s,_ptr); \ int ConCat(len_,s) = *ConCat(s,_dsc); # define F77_CHAR_DEF_DSC(s,p,l) F77_CHAR_LEN_IND ConCat(s,__dsc) = l; # define F77_CHAR_ASS_DSC(s,p,l) # define F77_CHAR_USE_PTR(s,p,l) p # define F77_CHAR_USE_LEN(s,p,l) , &ConCat(s,__dsc) #endif #ifndef F77_CHAR_ARG_PTR /* string length passed by value */ # define F77_CHAR_ARG_PTR(s) s # define F77_CHAR_ARG_LEN(s) , ConCat(len_,s) # define F77_CHAR_ARG_DCL(s) char *s; int ConCat(len_,s); # define F77_CHAR_ARG_DEF(s) # define F77_CHAR_DEF_DSC(s,p,l) # define F77_CHAR_ASS_DSC(s,p,l) # define F77_CHAR_USE_PTR(s,p,l) p # define F77_CHAR_USE_LEN(s,p,l) , l #endif #ifndef F77_XXXX_ARG_LEN /* length argument of non-CHARACTER arguments */ # define F77_XXXX_ARG_LEN(x) /* nil */ # define F77_XXXX_USE_LEN(x) /* nil */ #endif /* * Fortran-calls-C interface * * To define a C function called by Fortran CALL SUB(A,B,C): * * #define Sub F77_NAME(sub,SUB) * #pragma linkage(SUB,FORTRAN) // for IBM C/370 compiler * * F77_ENTRY_xyz(Sub,a,b,c) // opening { contained in macro * // body ... * } * * Each character in xyz declares the type of the corresponding parameter: * * C = CHARACTER * D = DOUBLE PRECISION * E = EXTERNAL * I = INTEGER * L = LOGICAL * R = REAL * X = COMPLEX * * If a parameter PAR is declared as CHARACTER the macro defines: * * char *PAR; // pointer to string (not terminated by \0 !!!) * int len_PAR; // length of string as defined by Fortran's LEN(PAR) * * The name PAR_dsc is reserved for internal use. * * Note: The function body follows the F77_ENTRY_... macro call directly. * The opening { is generated by the macro. */ #define F77_CHAR_ARG2PTR(c1,c2) \ F77_CHAR_ARG_PTR(c1),F77_CHAR_ARG_PTR(c2) #define F77_CHAR_ARG2LEN(c1,c2) \ F77_CHAR_ARG_LEN(c1) F77_CHAR_ARG_LEN(c2) #define F77_XXXX_ARG2LEN(c1,c2) \ F77_XXXX_ARG_LEN(c1) F77_XXXX_ARG_LEN(c2) #define F77_CHAR_ARG2DCL(c1,c2) \ F77_CHAR_ARG_DCL(c1) F77_CHAR_ARG_DCL(c2) #define F77_CHAR_ARG2DEF(c1,c2) \ F77_CHAR_ARG_DEF(c1) F77_CHAR_ARG_DEF(c2) #define F77_CHAR_ARG3PTR(c1,c2,c3) \ F77_CHAR_ARG2PTR(c1,c2),F77_CHAR_ARG_PTR(c3) #define F77_CHAR_ARG3LEN(c1,c2,c3) \ F77_CHAR_ARG2LEN(c1,c2) F77_CHAR_ARG_LEN(c3) #define F77_XXXX_ARG3LEN(c1,c2,c3) \ F77_XXXX_ARG2LEN(c1,c2) F77_XXXX_ARG_LEN(c3) #define F77_CHAR_ARG3DCL(c1,c2,c3) \ F77_CHAR_ARG2DCL(c1,c2) F77_CHAR_ARG_DCL(c3) #define F77_CHAR_ARG3DEF(c1,c2,c3) \ F77_CHAR_ARG2DEF(c1,c2) F77_CHAR_ARG_DEF(c3) #define F77_CHAR_ARG4PTR(c1,c2,c3,c4) \ F77_CHAR_ARG3PTR(c1,c2,c3),F77_CHAR_ARG_PTR(c4) #define F77_CHAR_ARG4LEN(c1,c2,c3,c4) \ F77_CHAR_ARG3LEN(c1,c2,c3) F77_CHAR_ARG_LEN(c4) #define F77_XXXX_ARG4LEN(c1,c2,c3,c4) \ F77_XXXX_ARG3LEN(c1,c2,c3) F77_XXXX_ARG_LEN(c4) #define F77_CHAR_ARG4DCL(c1,c2,c3,c4) \ F77_CHAR_ARG3DCL(c1,c2,c3) F77_CHAR_ARG_DCL(c4) #define F77_CHAR_ARG4DEF(c1,c2,c3,c4) \ F77_CHAR_ARG3DEF(c1,c2,c3) F77_CHAR_ARG_DEF(c4) #define F77_CHAR_ARG5PTR(c1,c2,c3,c4,c5) \ F77_CHAR_ARG4PTR(c1,c2,c3,c4),F77_CHAR_ARG_PTR(c5) #define F77_CHAR_ARG5LEN(c1,c2,c3,c4,c5) \ F77_CHAR_ARG4LEN(c1,c2,c3,c4) F77_CHAR_ARG_LEN(c5) #define F77_CHAR_ARG5DCL(c1,c2,c3,c4,c5) \ F77_CHAR_ARG4DCL(c1,c2,c3,c4) F77_CHAR_ARG_DCL(c5) #define F77_CHAR_ARG5DEF(c1,c2,c3,c4,c5) \ F77_CHAR_ARG4DEF(c1,c2,c3,c4) F77_CHAR_ARG_DEF(c5) #define F77_ENTRY_C(name,c1) \ name( F77_CHAR_ARG_PTR(c1) F77_CHAR_ARG_LEN(c1) ) \ F77_CHAR_ARG_DCL(c1) \ { F77_CHAR_ARG_DEF(c1) #define F77_ENTRY_CC(name,c1,c2) \ name( F77_CHAR_ARG2PTR(c1,c2) F77_CHAR_ARG2LEN(c1,c2) ) \ F77_CHAR_ARG2DCL(c1,c2) \ { F77_CHAR_ARG2DEF(c1,c2) #define F77_ENTRY_C3(name,c1,c2,c3) \ name( F77_CHAR_ARG3PTR(c1,c2,c3) \ F77_CHAR_ARG3LEN(c1,c2,c3) ) \ F77_CHAR_ARG3DCL(c1,c2,c3) \ { F77_CHAR_ARG3DEF(c1,c2,c3) #define F77_ENTRY_C5(name,c1,c2,c3,c4,c5) \ name( F77_CHAR_ARG5PTR(c1,c2,c3,c4,c5) \ F77_CHAR_ARG5LEN(c1,c2,c3,c4,c5) ) \ F77_CHAR_ARG5DCL(c1,c2,c3,c4,c5) \ { F77_CHAR_ARG5DEF(c1,c2,c3,c4,c5) #define F77_ENTRY_C4E(name,c1,c2,c3,c4,e5) \ name( F77_CHAR_ARG4PTR(c1,c2,c3,c4),F77_EXTERN_ARG(e5) \ F77_CHAR_ARG4LEN(c1,c2,c3,c4) ) \ F77_CHAR_ARG4DCL(c1,c2,c3,c4) F77_EXTERN_DCL(e5) \ { F77_CHAR_ARG4DEF(c1,c2,c3,c4) F77_EXTERN_DEF(e5) #define F77_ENTRY_C4I(name,c1,c2,c3,c4,i5) \ name( F77_CHAR_ARG4PTR(c1,c2,c3,c4), i5 \ F77_CHAR_ARG4LEN(c1,c2,c3,c4) ) \ F77_CHAR_ARG4DCL(c1,c2,c3,c4) INTEGER *i5; \ { F77_CHAR_ARG4DEF(c1,c2,c3,c4) #define F77_ENTRY_C5E(name,c1,c2,c3,c4,c5,e6) \ name( F77_CHAR_ARG5PTR(c1,c2,c3,c4,c5),F77_EXTERN_ARG(e6) \ F77_CHAR_ARG5LEN(c1,c2,c3,c4,c5) ) \ F77_CHAR_ARG5DCL(c1,c2,c3,c4,c5) F77_EXTERN_DCL(e6) \ { F77_CHAR_ARG5DEF(c1,c2,c3,c4,c5) F77_EXTERN_DEF(e6) #define F77_ENTRY_CCE(name,c1,c2,e3) \ name( F77_CHAR_ARG2PTR(c1,c2),F77_EXTERN_ARG(e3) \ F77_CHAR_ARG2LEN(c1,c2) ) \ F77_CHAR_ARG2DCL(c1,c2) F77_EXTERN_DCL(e3) \ { F77_CHAR_ARG2DEF(c1,c2) F77_EXTERN_DEF(e3) #define F77_ENTRY_CCEE(name,c1,c2,e3,e4) \ name( F77_CHAR_ARG2PTR(c1,c2),F77_EXTERN2ARG(e3,e4) \ F77_CHAR_ARG2LEN(c1,c2) ) \ F77_CHAR_ARG2DCL(c1,c2) F77_EXTERN2DCL(e3,e4) \ { F77_CHAR_ARG2DEF(c1,c2) F77_EXTERN2DEF(e3,e4) #define F77_ENTRY_CCI(name,c1,c2,i3) \ name( F77_CHAR_ARG2PTR(c1,c2), i3 \ F77_CHAR_ARG2LEN(c1,c2) ) \ F77_CHAR_ARG2DCL(c1,c2) INTEGER *i3; \ { F77_CHAR_ARG2DEF(c1,c2) #define F77_ENTRY_CCIC(name,c1,c2,i3,c4) \ name( F77_CHAR_ARG2PTR(c1,c2), i3, F77_CHAR_ARG_PTR(c4) \ F77_CHAR_ARG2LEN(c1,c2) \ F77_XXXX_ARG_LEN(i3) \ F77_CHAR_ARG_LEN(c4) ) \ F77_CHAR_ARG3DCL(c1,c2,c4) INTEGER *i3; \ { F77_CHAR_ARG3DEF(c1,c2,c4) #define F77_ENTRY_CCIRCC(name,c1,c2,i3,r4,c5,c6) \ name( F77_CHAR_ARG2PTR(c1,c2), i3, r4, F77_CHAR_ARG2PTR(c5,c6) \ F77_CHAR_ARG2LEN(c1,c2) \ F77_XXXX_ARG2LEN(i3,r4) \ F77_CHAR_ARG2LEN(c5,c6) ) \ F77_CHAR_ARG4DCL(c1,c2,c5,c6) INTEGER *i3; REAL *r4; \ { F77_CHAR_ARG4DEF(c1,c2,c5,c6) #define F77_ENTRY_CE(name,c1,e2) \ name( F77_CHAR_ARG_PTR(c1),F77_EXTERN_ARG(e2) \ F77_CHAR_ARG_LEN(c1) ) \ F77_CHAR_ARG_DCL(c1) F77_EXTERN_DCL(e2) \ { F77_CHAR_ARG_DEF(c1) F77_EXTERN_DEF(e2) #define F77_ENTRY_CI(name,c1,i2) \ name( F77_CHAR_ARG_PTR(c1), i2 F77_CHAR_ARG_LEN(c1) ) \ INTEGER *i2; F77_CHAR_ARG_DCL(c1) \ { F77_CHAR_ARG_DEF(c1) #define F77_ENTRY_CICI(name,c1,i2,c3,i4) \ name( F77_CHAR_ARG_PTR(c1), i2, F77_CHAR_ARG_PTR(c3), i4 \ F77_CHAR_ARG_LEN(c1) \ F77_XXXX_ARG_LEN(i2) \ F77_CHAR_ARG_LEN(c3) ) \ F77_CHAR_ARG2DCL(c1,c3) INTEGER *i2, *i4; \ { F77_CHAR_ARG2DEF(c1,c3) #define F77_ENTRY_CII(name,c1,i2,i3) \ name( F77_CHAR_ARG_PTR(c1), i2, i3 \ F77_CHAR_ARG_LEN(c1) ) \ F77_CHAR_ARG_DCL(c1) INTEGER *i2, *i3; \ { F77_CHAR_ARG_DEF(c1) #define F77_ENTRY_CIIC(name,c1,i2,i3,c4) \ name( F77_CHAR_ARG_PTR(c1), i2, i3, F77_CHAR_ARG_PTR(c4) \ F77_CHAR_ARG_LEN(c1) \ F77_XXXX_ARG2LEN(i2,i3) \ F77_CHAR_ARG_LEN(c4) ) \ F77_CHAR_ARG2DCL(c1,c4) INTEGER *i2, *i3; \ { F77_CHAR_ARG2DEF(c1,c4) #define F77_ENTRY_CR(name,c1,r2) \ name( F77_CHAR_ARG_PTR(c1), r2 F77_CHAR_ARG_LEN(c1) ) \ REAL *r2; F77_CHAR_ARG_DCL(c1) \ { F77_CHAR_ARG_DEF(c1) #define F77_ENTRY_E(name,e1) \ name( F77_EXTERN_ARG(e1) ) \ F77_EXTERN_DCL(e1) \ { F77_EXTERN_DEF(e1) #define F77_ENTRY_E4(name,e1,e2,e3,e4) \ name( F77_EXTERN4ARG(e1,e2,e3,e4) ) \ F77_EXTERN4DCL(e1,e2,e3,e4) \ { F77_EXTERN4DEF(e1,e2,e3,e4) #define F77_ENTRY_IC(name,i1,c2) \ name( i1, F77_CHAR_ARG_PTR(c2) \ F77_XXXX_ARG_LEN(i1) \ F77_CHAR_ARG_LEN(c2) ) \ INTEGER *i1; F77_CHAR_ARG_DCL(c2) \ { F77_CHAR_ARG_DEF(c2) #define F77_ENTRY_ICI(name,i1,c2,i3) \ name( i1, F77_CHAR_ARG_PTR(c2), i3 \ F77_XXXX_ARG_LEN(i1) \ F77_CHAR_ARG_LEN(c2) ) \ INTEGER *i1, *i3; F77_CHAR_ARG_DCL(c2) \ { F77_CHAR_ARG_DEF(c2) #define F77_ENTRY_IIC(name,i1,i2,c3) \ name( i1, i2, F77_CHAR_ARG_PTR(c3) \ F77_XXXX_ARG2LEN(i1,i2) \ F77_CHAR_ARG_LEN(c3) ) \ INTEGER *i1, *i2; F77_CHAR_ARG_DCL(c3) \ { F77_CHAR_ARG_DEF(c3) #define F77_ENTRY_I3C(name,i1,i2,i3,c4) \ name( i1, i2, i3, F77_CHAR_ARG_PTR(c4) \ F77_XXXX_ARG3LEN(i1,i2,i3) \ F77_CHAR_ARG_LEN(c4) ) \ INTEGER *i1, *i2, *i3; \ F77_CHAR_ARG_DCL(c4) \ { F77_CHAR_ARG_DEF(c4) #define F77_ENTRY_I4CCC(name,i1,i2,i3,i4,c5,c6,c7) \ name( i1, i2, i3, i4, F77_CHAR_ARG3PTR(c5,c6,c7) \ F77_XXXX_ARG4LEN(i1,i2,i3,i4) \ F77_CHAR_ARG3LEN(c5,c6,c7) ) \ INTEGER *i1, *i2, *i3, *i4; \ F77_CHAR_ARG3DCL(c5,c6,c7) \ { F77_CHAR_ARG3DEF(c5,c6,c7) #define F77_CHAR_DEF2DSC(s1,p1,l1,s2,p2,l2) \ F77_CHAR_DEF_DSC(s1,p1,l1) F77_CHAR_DEF_DSC(s2,p2,l2) #define F77_CHAR_ASS2DSC(s1,p1,l1,s2,p2,l2) \ F77_CHAR_ASS_DSC(s1,p1,l1) F77_CHAR_ASS_DSC(s2,p2,l2) #define F77_CHAR_USE2PTR(s1,p1,l1,s2,p2,l2) \ F77_CHAR_USE_PTR(s1,p1,l1),F77_CHAR_USE_PTR(s2,p2,l2) #define F77_CHAR_USE2LEN(s1,p1,l1,s2,p2,l2) \ F77_CHAR_USE_LEN(s1,p1,l1) F77_CHAR_USE_LEN(s2,p2,l2) #define F77_XXXX_USE2LEN(x1,x2) \ F77_XXXX_USE_LEN(x1) F77_XXXX_USE_LEN(x2) #define F77_CHAR_DEF3DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3) \ F77_CHAR_DEF2DSC(s1,p1,l1,s2,p2,l2) F77_CHAR_DEF_DSC(s3,p3,l3) #define F77_CHAR_ASS3DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3) \ F77_CHAR_ASS2DSC(s1,p1,l1,s2,p2,l2) F77_CHAR_ASS_DSC(s3,p3,l3) #define F77_CHAR_USE3PTR(s1,p1,l1,s2,p2,l2,s3,p3,l3) \ F77_CHAR_USE2PTR(s1,p1,l1,s2,p2,l2),F77_CHAR_USE_PTR(s3,p3,l3) #define F77_CHAR_USE3LEN(s1,p1,l1,s2,p2,l2,s3,p3,l3) \ F77_CHAR_USE2LEN(s1,p1,l1,s2,p2,l2) F77_CHAR_USE_LEN(s3,p3,l3) #define F77_XXXX_USE3LEN(x1,x2,x3) \ F77_XXXX_USE2LEN(x1,x2) F77_XXXX_USE_LEN(x3) #define F77_CHAR_DEF4DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3,s4,p4,l4) \ F77_CHAR_DEF3DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3) F77_CHAR_DEF_DSC(s4,p4,l4) #define F77_CHAR_ASS4DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3,s4,p4,l4) \ F77_CHAR_ASS3DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3) F77_CHAR_ASS_DSC(s4,p4,l4) #define F77_CHAR_USE4PTR(s1,p1,l1,s2,p2,l2,s3,p3,l3,s4,p4,l4) \ F77_CHAR_USE3PTR(s1,p1,l1,s2,p2,l2,s3,p3,l3),F77_CHAR_USE_PTR(s4,p4,l4) #define F77_CHAR_USE4LEN(s1,p1,l1,s2,p2,l2,s3,p3,l3,s4,p4,l4) \ F77_CHAR_USE3LEN(s1,p1,l1,s2,p2,l2,s3,p3,l3) F77_CHAR_USE_LEN(s4,p4,l4) #define F77_XXXX_USE4LEN(x1,x2,x3,x4) \ F77_XXXX_USE3LEN(x1,x2,x3) F77_XXXX_USE_LEN(x4) #define F77_XXXX_USE5LEN(x1,x2,x3,x4,x5) \ F77_XXXX_USE4LEN(x1,x2,x3,x4) F77_XXXX_USE_LEN(x5) #define F77_XXXX_USE6LEN(x1,x2,x3,x4,x5,x6) \ F77_XXXX_USE5LEN(x1,x2,x3,x4,x5) F77_XXXX_USE_LEN(x6) #define F77_XXXX_USE7LEN(x1,x2,x3,x4,x5,x6,x7) \ F77_XXXX_USE6LEN(x1,x2,x3,x4,x5,x6) F77_XXXX_USE_LEN(x7) #define F77_XXXX_USE8LEN(x1,x2,x3,x4,x5,x6,x7,x8) \ F77_XXXX_USE7LEN(x1,x2,x3,x4,x5,x6,x7) F77_XXXX_USE_LEN(x8) #ifdef IBM370 #pragma linkage(K77C,FORTRAN) #define F77_CALL_C(name,p1,l1) do { \ SUBROUTINE *F77 = name; \ K77C(&F77,p1,l1); } while(0) #else #define F77_CALL_C(name,p1,l1) do { \ F77_CHAR_DEF_DSC(s1,p1,l1) \ F77_CHAR_ASS_DSC(s1,p1,l1) \ name( F77_CHAR_USE_PTR(s1,p1,l1) \ F77_CHAR_USE_LEN(s1,p1,l1) \ ); } while(0) #endif #if 0 #ifdef IBM370 #pragma linkage(K77CC,FORTRAN) #define F77_CALL_CC(name,p1,l1,p2,l2) do { \ SUBROUTINE *F77 = name; \ K77CC(&F77,p1,l1,p2,l2); } while(0) #else #define F77_CALL_CC(name,p1,l1,p2,l2) do { \ F77_CHAR_DEF2DSC(s1,p1,l1,s2,p2,l2) \ F77_CHAR_ASS2DSC(s1,p1,l1,s2,p2,l2) \ name( F77_CHAR_USE2PTR(s1,p1,l1,s2,p2,l2) \ F77_CHAR_USE2LEN(s1,p1,l1,s2,p2,l2) \ ); } while(0) #endif #else #ifdef IBM370 #pragma linkage(K77CC,FORTRAN) #define F77_IFUN_CC(i0,name,p1,l1,p2,l2) do { \ i0 = K77CC(&name,p1,l1,p2,l2); } while(0) #else #define F77_IFUN_CC(i0,name,p1,l1,p2,l2) do { \ F77_CHAR_DEF2DSC(s1,p1,l1,s2,p2,l2) \ F77_CHAR_ASS2DSC(s1,p1,l1,s2,p2,l2) \ i0 = (*name)( \ F77_CHAR_USE2PTR(s1,p1,l1,s2,p2,l2) \ F77_CHAR_USE2LEN(s1,p1,l1,s2,p2,l2) \ ); } while(0) #endif #define F77_CALL_CC(name,p1,l1,p2,l2) do { \ INT_FUNCPTR _p0_ = (INT_FUNCPTR)name; \ INTEGER _i0_; \ F77_IFUN_CC(_i0_,_p0_,p1,l1,p2,l2); \ } while(0) #endif #ifdef IBM370 #pragma linkage(K77C3,FORTRAN) #define F77_CALL_C3(name,p1,l1,p2,l2,p3,l3) do { \ SUBROUTINE *F77 = name; \ K77C3(&F77,p1,l1,p2,l2,p3,l3); } while(0) #else #define F77_CALL_C3(name,p1,l1,p2,l2,p3,l3) do { \ F77_CHAR_DEF3DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3) \ F77_CHAR_ASS3DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3) \ name( F77_CHAR_USE3PTR(s1,p1,l1,s2,p2,l2,s3,p3,l3) \ F77_CHAR_USE3LEN(s1,p1,l1,s2,p2,l2,s3,p3,l3) \ ); } while(0) #endif #ifdef IBM370 #pragma linkage(K77C7,FORTRAN) #define F77_CALL_C7(name,p1,l1,p2,l2,p3,l3,p4,l4,p5,l5,p6,l6,p7,l7) do { \ SUBROUTINE *F77 = name; \ K77C7(&F77,p1,l1,p2,l2,p3,l3,p4,l4,p5,l5,p6,l6,p7,l7); } while(0) #else #define F77_CALL_C7(name,p1,l1,p2,l2,p3,l3,p4,l4,p5,l5,p6,l6,p7,l7) do { \ F77_CHAR_DEF4DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3,s4,p4,l4) \ F77_CHAR_DEF3DSC(s5,p5,l5,s6,p6,l6,s7,p7,l7) \ F77_CHAR_ASS4DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3,s4,p4,l4) \ F77_CHAR_ASS3DSC(s5,p5,l5,s6,p6,l6,s7,p7,l7) \ name( F77_CHAR_USE4PTR(s1,p1,l1,s2,p2,l2,s3,p3,l3,s4,p4,l4), \ F77_CHAR_USE3PTR(s5,p5,l5,s6,p6,l6,s7,p7,l7) \ F77_CHAR_USE4LEN(s1,p1,l1,s2,p2,l2,s3,p3,l3,s4,p4,l4) \ F77_CHAR_USE3LEN(s5,p5,l5,s6,p6,l6,s7,p7,l7) \ ); } while(0) #endif #ifdef IBM370 #pragma linkage(K77CCx,FORTRAN) #define F77_CALL_CCx(name,p1,l1,p2,l2,x3) do { \ SUBROUTINE *F77 = name; \ K77CCx(&F77,p1,l1,p2,l2,x3); } while(0) #else #define F77_CALL_CCx(name,p1,l1,p2,l2,x3) do { \ F77_CHAR_DEF2DSC(s1,p1,l1,s2,p2,l2) \ F77_CHAR_ASS2DSC(s1,p1,l1,s2,p2,l2) \ name( F77_CHAR_USE2PTR(s1,p1,l1,s2,p2,l2), \ x3 \ F77_CHAR_USE2LEN(s1,p1,l1,s2,p2,l2) \ F77_XXXX_USE_LEN(x3) \ ); } while(0) #endif #ifdef IBM370 #pragma linkage(K77CCx3,FORTRAN) #define F77_CALL_CCx3(name,p1,l1,p2,l2,x3,x4,x5) do { \ SUBROUTINE *F77 = name; \ K77CCx3(&F77,p1,l1,p2,l2,x3,x4,x5); } while(0) #else #define F77_CALL_CCx3(name,p1,l1,p2,l2,x3,x4,x5) do { \ F77_CHAR_DEF2DSC(s1,p1,l1,s2,p2,l2) \ F77_CHAR_ASS2DSC(s1,p1,l1,s2,p2,l2) \ name( F77_CHAR_USE2PTR(s1,p1,l1,s2,p2,l2), \ x3,x4,x5 \ F77_CHAR_USE2LEN(s1,p1,l1,s2,p2,l2) \ F77_XXXX_USE3LEN(x3,x4,x5) \ ); } while(0) #endif #ifdef IBM370 #pragma linkage(K77Cx,FORTRAN) #define F77_IFUN_Cx(i0,name,p1,l1,x2) do { \ i0 = K77Cx(&name,p1,l1,x2); } while(0) #else #define F77_IFUN_Cx(i0,name,p1,l1,x2) do { \ F77_CHAR_DEF_DSC(s1,p1,l1) \ F77_CHAR_ASS_DSC(s1,p1,l1) \ i0 = (*name)( \ F77_CHAR_USE_PTR(s1,p1,l1), \ x2 \ F77_CHAR_USE_LEN(s1,p1,l1) \ F77_XXXX_USE_LEN(x2) \ ); } while(0) #endif #define F77_CALL_Cx(name,p1,l1,x2) do { \ INT_FUNCPTR _p0_ = (INT_FUNCPTR)name; \ INTEGER _i0_; \ F77_IFUN_Cx(_i0_,_p0_,p1,l1,x2); \ } while(0) #ifdef IBM370 #pragma linkage(K77CxC,FORTRAN) #define F77_CALL_CxC(name,p1,l1,x2,p3,l3) do { \ SUBROUTINE *F77 = name; \ K77CxC(&F77,p1,l1,x2,p3,l3); } while(0) #else #define F77_CALL_CxC(name,p1,l1,x2,p3,l3) do { \ F77_CHAR_DEF2DSC(s1,p1,l1,s3,p3,l3) \ F77_CHAR_ASS2DSC(s1,p1,l1,s3,p3,l3) \ name( F77_CHAR_USE_PTR(s1,p1,l1), \ x2, \ F77_CHAR_USE_PTR(s3,p3,l3) \ F77_CHAR_USE_LEN(s1,p1,l1) \ F77_XXXX_USE_LEN(x2) \ F77_CHAR_USE_LEN(s3,p3,l3) \ ); } while(0) #endif #ifdef IBM370 #pragma linkage(K77Cxx,FORTRAN) #define F77_CALL_Cxx(name,p1,l1,x2,x3) do { \ SUBROUTINE *F77 = name; \ K77Cxx(&F77,p1,l1,x2,x3); } while(0) #else #define F77_CALL_Cxx(name,p1,l1,x2,x3) do { \ F77_CHAR_DEF_DSC(s1,p1,l1) \ F77_CHAR_ASS_DSC(s1,p1,l1) \ name( F77_CHAR_USE_PTR(s1,p1,l1), \ x2,x3 \ F77_CHAR_USE_LEN(s1,p1,l1) \ F77_XXXX_USE2LEN(x2,x3) \ ); } while(0) #endif #ifdef IBM370 #pragma linkage(K77xC,FORTRAN) #define F77_CALL_xC(name,x1,p2,l2) do { \ SUBROUTINE *F77 = name; \ K77xC(&F77,x1,p2,l2); } while(0) #else #define F77_CALL_xC(name,x1,p2,l2) do { \ F77_CHAR_DEF_DSC(s2,p2,l2) \ F77_CHAR_ASS_DSC(s2,p2,l2) \ name( x1, \ F77_CHAR_USE_PTR(s2,p2,l2) \ F77_XXXX_USE_LEN(x1) \ F77_CHAR_USE_LEN(s2,p2,l2) \ ); } while(0) #endif #ifdef IBM370 #pragma linkage(K77xCCx,FORTRAN) #define F77_CALL_xCCx(name,x1,p2,l2,p3,l3,x4) do { \ SUBROUTINE *F77 = name; \ K77xCCx(&F77,x1,p2,l2,p3,l3,x4); } while(0) #else #define F77_CALL_xCCx(name,x1,p2,l2,p3,l3,x4) do { \ F77_CHAR_DEF2DSC(s2,p2,l2,s3,p3,l3) \ F77_CHAR_ASS2DSC(s2,p2,l2,s3,p3,l3) \ name( x1, \ F77_CHAR_USE2PTR(s2,p2,l2,s3,p3,l3), \ x4 \ F77_XXXX_USE_LEN(x1) \ F77_CHAR_USE2LEN(s2,p2,l2,s3,p3,l3) \ F77_XXXX_USE_LEN(x4) \ ); } while(0) #endif #ifdef IBM370 #pragma linkage(K77xCx,FORTRAN) #define F77_IFUN_xCx(i0,name,x1,p2,l2,x3) do { \ i0 = K77xCx(&name,x1,p2,l2,x3); } while(0) #else #define F77_IFUN_xCx(i0,name,x1,p2,l2,x3) do { \ F77_CHAR_DEF_DSC(s2,p2,l2) \ F77_CHAR_ASS_DSC(s2,p2,l2) \ i0 = (*name)( x1, \ F77_CHAR_USE_PTR(s2,p2,l2), \ x3 \ F77_XXXX_USE_LEN(x1) \ F77_CHAR_USE_LEN(s2,p2,l2) \ F77_XXXX_USE_LEN(x3) \ ); } while(0) #endif #define F77_CALL_xCx(name,x1,p2,l2,x3) do { \ INT_FUNCPTR _p0_ = (INT_FUNCPTR)name; \ INTEGER _i0_; \ F77_IFUN_xCx(_i0_,_p0_,x1,p2,l2,x3); \ } while(0) #ifdef IBM370 #pragma linkage(K77x4C,FORTRAN) #define F77_CALL_x4C(name,x1,x2,x3,x4,p5,l5) do { \ SUBROUTINE *F77 = name; \ K77x4C(&F77,x1,x2,x3,x4,p5,l5); } while(0) #else #define F77_CALL_x4C(name,x1,x2,x3,x4,p5,l5) do { \ F77_CHAR_DEF_DSC(s5,p5,l5) \ F77_CHAR_ASS_DSC(s5,p5,l5) \ name( x1,x2,x3,x4, \ F77_CHAR_USE_PTR(s5,p5,l5) \ F77_XXXX_USE4LEN(x1,x2,x3,x4) \ F77_CHAR_USE_LEN(s5,p5,l5) \ ); } while(0) #endif #ifdef IBM370 #pragma linkage(K77x4Cxx,FORTRAN) #define F77_CALL_x4Cxx(name,x1,x2,x3,x4,p5,l5,x6,x7) do { \ SUBROUTINE *F77 = name; \ K77x4Cxx(&F77,x1,x2,x3,x4,p5,l5,x6,x7); } while(0) #else #define F77_CALL_x4Cxx(name,x1,x2,x3,x4,p5,l5,x6,x7) do { \ F77_CHAR_DEF_DSC(s5,p5,l5) \ F77_CHAR_ASS_DSC(s5,p5,l5) \ name( x1,x2,x3,x4, \ F77_CHAR_USE_PTR(s5,p5,l5), \ x6,x7 \ F77_XXXX_USE4LEN(x1,x2,x3,x4) \ F77_CHAR_USE_LEN(s5,p5,l5) \ F77_XXXX_USE2LEN(x6,x7) \ ); } while(0) #endif #ifdef IBM370 #pragma linkage(KIGMENU,FORTRAN) /* 1 2 3 4 5 6 7 8 9 10 11 12 13 14 */ #define F77_CALL_xCx5CxC3xC(name,a,b,B,c,d,e,f,g,h,H,i,j,J,k,K,l,L,m,n,N) do {\ SUBROUTINE *F77 = name; \ KIGMENU(&F77,a,b,B,c,d,e,f,g,h,H,i,j,J,k,K,l,L,m,n,N); } while(0) #else #define F77_CALL_xCx5CxC3xC(name,a,b,B,c,d,e,f,g,h,H,i,j,J,k,K,l,L,m,n,N) do {\ F77_CHAR_DEF_DSC(sb,b,B) \ F77_CHAR_DEF_DSC(sh,h,H) \ F77_CHAR_DEF3DSC(sj,j,J,sk,k,K,sl,l,L) \ F77_CHAR_DEF_DSC(sn,n,N) \ F77_CHAR_ASS_DSC(sb,b,B) \ F77_CHAR_ASS_DSC(sh,h,H) \ F77_CHAR_ASS3DSC(sj,j,J,sk,k,K,sl,l,L) \ F77_CHAR_ASS_DSC(sn,n,N) \ name( a, \ F77_CHAR_USE_PTR(sb,b,B), \ c,d,e,f,g, \ F77_CHAR_USE_PTR(sh,h,H), \ i, \ F77_CHAR_USE3PTR(sj,j,J,sk,k,K,sl,l,L), \ m, \ F77_CHAR_USE_PTR(sn,n,N) \ F77_XXXX_USE_LEN(a) \ F77_CHAR_USE_LEN(sb,b,B) \ F77_XXXX_USE5LEN(c,d,e,f,g) \ F77_CHAR_USE_LEN(sh,h,H) \ F77_XXXX_USE_LEN(i) \ F77_CHAR_USE3LEN(sj,j,J,sk,k,K,sl,l,L) \ F77_XXXX_USE_LEN(m) \ F77_CHAR_USE_LEN(sn,n,N) \ ); } while(0) #endif #ifdef IBM370 #define F77_IFUN_x(i0,name,x1) i0 = __CTOF(name,x1) #else #define F77_IFUN_x(i0,name,x1) i0 = (*name)(x1) #endif #ifdef IBM370 #define F77_IFUN_xx(i0,name,x1,x2) i0 = __CTOF(name,x1,x2) #else #define F77_IFUN_xx(i0,name,x1,x2) i0 = (*name)(x1,x2) #endif #ifdef IBM370 #pragma linkage(K77xCx8,FORTRAN) #define F77_IFUN_xCx8(i0,name,x1,p2,l2,x3,x4,x5,x6,x7,x8,x9,x10) do { \ i0 = K77xCx8(&name,x1,p2,l2,x3,x4,x5,x6,x7,x8,x9,x10); } while(0) #else #define F77_IFUN_xCx8(i0,name,x1,p2,l2,x3,x4,x5,x6,x7,x8,x9,x10) do { \ F77_CHAR_DEF_DSC(s2,p2,l2) \ F77_CHAR_ASS_DSC(s2,p2,l2) \ i0 = (*name)( x1, \ F77_CHAR_USE_PTR(s2,p2,l2), \ x3,x4,x5,x6,x7,x8,x9,x10 \ F77_XXXX_USE_LEN(x1) \ F77_CHAR_USE_LEN(s2,p2,l2) \ F77_XXXX_USE8LEN(x3,x4,x5,x6,x7,x8,x9,x10) \ ); } while(0) #endif /* * routines called by Fortran */ #define Errrun F77_NAME(errrun,ERRRUN) #define Fmemcpy F77_NAME(fmemcpy,FMEMCPY) #define Getarg F77_NAME(getarg,GETARG) extern SUBROUTINE Getarg; #define Goparm F77_NAME(goparm,GOPARM) extern SUBROUTINE Goparm; #define Gl_char_cleanup F77_NAME(gl_char_cleanup,GL_CHAR_CLEANUP) #define Gl_reset F77_NAME(gl_reset,GL_RESET) #define Gl_reinit F77_NAME(gl_reinit,GL_REINIT) #define Iclrwk F77_NAME(iclrwk,ICLRWK) extern SUBROUTINE Iclrwk; #define Iginit F77_NAME(iginit,IGINIT) extern SUBROUTINE Iginit; #define Igmenu F77_NAME(igmenu,IGMENU) extern SUBROUTINE Igmenu; #define Igrng F77_NAME(igrng,IGRNG) extern SUBROUTINE Igrng; #define Igsse F77_NAME(igsse,IGSSE) extern SUBROUTINE Igsse; #define Igsrap F77_NAME(igsrap,IGSRAP) extern SUBROUTINE Igsrap; #define Igwkty F77_NAME(igwkty,IGWKTY) extern SUBROUTINE Igwkty; #define Kcexec F77_NAME(kcexec,KCEXEC) #define Kdialo F77_NAME(kdialo,KDIALO) extern SUBROUTINE Kdialo; #define Kgetar F77_NAME(kgetar,KGETAR) #define Kialid F77_NAME(kialid,KIALID) #define Kiargc F77_NAME(kiargc,KIARGC) extern INT_FUNCTION Kiargc; #define Kibres F77_NAME(kibres,KIBRES) extern SUBROUTINE Kibres; #define Kiclos F77_NAME(kiclos,KICLOS) extern SUBROUTINE Kiclos; #define Kicomv F77_NAME(kicomv,KICOMV) #define Kidtab F77_NAME(kidtab,KIDTAB) #define Kierrf F77_NAME(kierrf,KIERRF) extern SUBROUTINE Kierrf; #define Kiinit F77_NAME(kiinit,KIINIT) extern SUBROUTINE Kiinit; #define Kilun F77_NAME(kilun,KILUN) extern SUBROUTINE Kilun; #define Kimath F77_NAME(kimath,KIMATH) #define Kimdef F77_NAME(kimdef,KIMDEF) #define Kimexe F77_NAME(kimexe,KIMEXE) #define Kipawc F77_NAME(kipawc,KIPAWC) #define Kipiaf F77_NAME(kipiaf,KIPIAF) #define Kiprmt F77_NAME(kiprmt,KIPRMT) #define Kirtim F77_NAME(kirtim,KIRTIM) #define Kisigm F77_NAME(kisigm,KISIGM) #define Kivect F77_NAME(kivect,KIVECT) #define Kmpst2 F77_NAME(kmpst2,KMPST2) #define Kmpst3 F77_NAME(kmpst3,KMPST3) #define Kmpx22 F77_NAME(kmpx22,KMPX22) #define Kmpx23 F77_NAME(kmpx23,KMPX23) #define Kmvsed F77_NAME(kmvsed,KMVSED) extern SUBROUTINE Kmvsed; #define Kmvspg F77_NAME(kmvspg,KMVSPG) extern SUBROUTINE Kmvspg; #define Kmvssh F77_NAME(kmvssh,KMVSSH) extern SUBROUTINE Kmvssh; #define Ksvpar F77_NAME(ksvpar,KSVPAR) #define Kuach F77_NAME(kuach,KUACH) #define Kuact F77_NAME(kuact,KUACT) #define Kualfa F77_NAME(kualfa,KUALFA) #define Kuappl F77_NAME(kuappl,KUAPPL) #define Kuargs F77_NAME(kuargs,KUARGS) #define Kubrek F77_NAME(kubrek,KUBREK) #define Kubrof F77_NAME(kubrof,KUBROF) #define Kubron F77_NAME(kubron,KUBRON) #define Kucmd F77_NAME(kucmd,KUCMD) #define Kucmdl F77_NAME(kucmdl,KUCMDL) #define Kucomv F77_NAME(kucomv,KUCOMV) #define Kuedit F77_NAME(kuedit,KUEDIT) #define Kuesvr F77_NAME(kuesvr,KUESVR) #define Kueusr F77_NAME(kueusr,KUEUSR) #define Kuexec F77_NAME(kuexec,KUEXEC) #define Kuexel F77_NAME(kuexel,KUEXEL) #define Kuexit F77_NAME(kuexit,KUEXIT) #define Kufcas F77_NAME(kufcas,KUFCAS) #define Kufdef F77_NAME(kufdef,KUFDEF) #define Kugetc F77_NAME(kugetc,KUGETC) #define Kugete F77_NAME(kugete,KUGETE) #define Kugetf F77_NAME(kugetf,KUGETF) #define Kugeti F77_NAME(kugeti,KUGETI) #define Kugetl F77_NAME(kugetl,KUGETL) #define Kugetq F77_NAME(kugetq,KUGETQ) #define Kugetr F77_NAME(kugetr,KUGETR) #define Kugets F77_NAME(kugets,KUGETS) #define Kugrfl F77_NAME(kugrfl,KUGRFL) #define Kuguid F77_NAME(kuguid,KUGUID) #define Kuhelp F77_NAME(kuhelp,KUHELP) #define Kuhome F77_NAME(kuhome,KUHOME) #define Kuidf1 F77_NAME(kuidf1,KUIDF1) extern SUBROUTINE Kuidf1; #define Kuidf2 F77_NAME(kuidf2,KUIDF2) extern SUBROUTINE Kuidf2; #define Kuidfm F77_NAME(kuidfm,KUIDFM) #define Kuinim F77_NAME(kuinim,KUINIM) #define Kuinit F77_NAME(kuinit,KUINIT) #define Kulun F77_NAME(kulun,KULUN) #define Kumloc F77_NAME(kumloc,KUMLOC) #define Kumout F77_NAME(kumout,KUMOUT) #define Kumpad F77_NAME(kumpad,KUMPAD) #define Kumpst F77_NAME(kumpst,KUMPST) #define Kumpx2 F77_NAME(kumpx2,KUMPX2) #define Kundpv F77_NAME(kundpv,KUNDPV) #define Kunpar F77_NAME(kunpar,KUNPAR) #define Kunwg F77_NAME(kunwg,KUNWG) #define Kuopen F77_NAME(kuopen,KUOPEN) extern SUBROUTINE Kuopen; #define Kupad F77_NAME(kupad,KUPAD) #define Kupar F77_NAME(kupar,KUPAR) #define Kupath F77_NAME(kupath,KUPATH) #define Kupatl F77_NAME(kupatl,KUPATL) #define Kuproc F77_NAME(kuproc,KUPROC) #define Kuprof F77_NAME(kuprof,KUPROF) #define Kuproi F77_NAME(kuproi,KUPROI) #define Kuprop F77_NAME(kuprop,KUPROP) #define Kupror F77_NAME(kupror,KUPROR) #define Kupros F77_NAME(kupros,KUPROS) #define Kumess F77_NAME(kumess,KUMESS) #define Kupval F77_NAME(kupval,KUPVAL) #define Kuqcas F77_NAME(kuqcas,KUQCAS) #define Kuqenv F77_NAME(kuqenv,KUQENV) #define Kuqexe F77_NAME(kuqexe,KUQEXE) #define Kuqsvr F77_NAME(kuqsvr,KUQSVR) #define Kuquit F77_NAME(kuquit,KUQUIT) #define Kusapp F77_NAME(kusapp,KUSAPP) #define Kuser F77_NAME(kuser,KUSER) #define Kuserid F77_NAME(kuserid,KUSERID) #define Kusibr F77_NAME(kusibr,KUSIBR) #define Kusigm F77_NAME(kusigm,KUSIGM) #define Kuspy F77_NAME(kuspy,KUSPY) #define Kustat F77_NAME(kustat,KUSTAT) #define Kustop F77_NAME(kustop,KUSTOP) #define Kuterm F77_NAME(kuterm,KUTERM) #define Kutime F77_NAME(kutime,KUTIME) #define Kutim0 F77_NAME(kutim0,KUTIM0) extern SUBROUTINE Kutim0; #define Kutrue F77_NAME(kutrue,KUTRUE) #define Kuvcre F77_NAME(kuvcre,KUVCRE) extern SUBROUTINE Kuvcre; #define Kuvdel F77_NAME(kuvdel,KUVDEL) extern SUBROUTINE Kuvdel; #define Kuvect F77_NAME(kuvect,KUVECT) extern SUBROUTINE Kuvect; #define Kuvnam F77_NAME(kuvnam,KUVNAM) #define Kuwhag F77_NAME(kuwhag,KUWHAG) #define Kuwham F77_NAME(kuwham,KUWHAM) #define Kuwhat F77_NAME(kuwhat,KUWHAT) #define Kxali1 F77_NAME(kxali1,KXALI1) #define Kxcrv2 F77_NAME(kxcrv2,KXCRV2) extern SUBROUTINE Kxcrv2; #define Macdef F77_NAME(macdef,MACDEF) extern SUBROUTINE Macdef; #define Mdmenu F77_NAME(mdmenu,MDMENU) #define Mhi_close F77_NAME(mhi_close,MHI_CLOSE) extern SUBROUTINE Mhi_close; #define Mhi_open F77_NAME(mhi_open,MHI_OPEN) extern SUBROUTINE Mhi_open; #define Mzwipe F77_NAME(mzwipe,MZWIPE) extern SUBROUTINE Mzwipe; #define Traceq F77_NAME(traceq,TRACEQ) extern SUBROUTINE Traceq; #define Xuflow F77_NAME(xuflow,XUFLOW) extern SUBROUTINE Xuflow; #ifdef IBM370 # pragma linkage(ERRRUN,FORTRAN) # pragma linkage(FMEMCPY,FORTRAN) # pragma linkage(GOPARM,FORTRAN) # pragma linkage(ICLRWK,FORTRAN) # pragma linkage(IGINIT,FORTRAN) # pragma linkage(IGMENU,FORTRAN) # pragma linkage(IGRNG,FORTRAN) # pragma linkage(IGSSE,FORTRAN) # pragma linkage(IGSRAP,FORTRAN) # pragma linkage(IGWKTY,FORTRAN) # pragma linkage(KCEXEC,FORTRAN) # pragma linkage(KDIALO,FORTRAN) # pragma linkage(KGETAR,FORTRAN) # pragma linkage(KIALID,FORTRAN) # pragma linkage(KIBRES,FORTRAN) # pragma linkage(KICLOS,FORTRAN) # pragma linkage(KICOMV,FORTRAN) # pragma linkage(KIDTAB,FORTRAN) # pragma linkage(KIERRF,FORTRAN) # pragma linkage(KIINIT,FORTRAN) # pragma linkage(KILUN,FORTRAN) # pragma linkage(KIMATH,FORTRAN) # pragma linkage(KIMDEF,FORTRAN) # pragma linkage(KIMEXE,FORTRAN) # pragma linkage(KIPAWC,FORTRAN) # pragma linkage(KIPIAF,FORTRAN) # pragma linkage(KIPRMT,FORTRAN) # pragma linkage(KIRTIM,FORTRAN) # pragma linkage(KISIGM,FORTRAN) # pragma linkage(KIVECT,FORTRAN) # pragma linkage(KMPST2,FORTRAN) # pragma linkage(KMPST3,FORTRAN) # pragma linkage(KMPX22,FORTRAN) # pragma linkage(KMPX23,FORTRAN) # pragma linkage(KMVSED,FORTRAN) # pragma linkage(KMVSPG,FORTRAN) # pragma linkage(KMVSSH,FORTRAN) # pragma linkage(KSVPAR,FORTRAN) # pragma linkage(KUACH,FORTRAN) # pragma linkage(KUACT,FORTRAN) # pragma linkage(KUALFA,FORTRAN) # pragma linkage(KUAPPL,FORTRAN) # pragma linkage(KUARGS,FORTRAN) # pragma linkage(KUBREK,FORTRAN) # pragma linkage(KUBROF,FORTRAN) # pragma linkage(KUBRON,FORTRAN) # pragma linkage(KUCMD,FORTRAN) # pragma linkage(KUCMDL,FORTRAN) # pragma linkage(KUCOMV,FORTRAN) # pragma linkage(KUEDIT,FORTRAN) # pragma linkage(KUESVR,FORTRAN) # pragma linkage(KUEUSR,FORTRAN) # pragma linkage(KUEXEC,FORTRAN) # pragma linkage(KUEXEL,FORTRAN) # pragma linkage(KUEXIT,FORTRAN) # pragma linkage(KUFCAS,FORTRAN) # pragma linkage(KUFDEF,FORTRAN) # pragma linkage(KUGETC,FORTRAN) # pragma linkage(KUGETE,FORTRAN) # pragma linkage(KUGETF,FORTRAN) # pragma linkage(KUGETI,FORTRAN) # pragma linkage(KUGETL,FORTRAN) # pragma linkage(KUGETQ,FORTRAN) # pragma linkage(KUGETR,FORTRAN) # pragma linkage(KUGETS,FORTRAN) # pragma linkage(KUGRFL,FORTRAN) # pragma linkage(KUGUID,FORTRAN) # pragma linkage(KUHELP,FORTRAN) # pragma linkage(KUHOME,FORTRAN) # pragma linkage(KUIDF1,FORTRAN) # pragma linkage(KUIDF2,FORTRAN) # pragma linkage(KUIDFM,FORTRAN) # pragma linkage(KUINIM,FORTRAN) # pragma linkage(KUINIT,FORTRAN) # pragma linkage(KULUN,FORTRAN) # pragma linkage(KUMLOC,FORTRAN) # pragma linkage(KUMOUT,FORTRAN) # pragma linkage(KUMPAD,FORTRAN) # pragma linkage(KUMPST,FORTRAN) # pragma linkage(KUMPX2,FORTRAN) # pragma linkage(KUNDPV,FORTRAN) # pragma linkage(KUNPAR,FORTRAN) # pragma linkage(KUNWG,FORTRAN) # pragma linkage(KUOPEN,FORTRAN) # pragma linkage(KUPAD,FORTRAN) # pragma linkage(KUPAR,FORTRAN) # pragma linkage(KUPATH,FORTRAN) # pragma linkage(KUPATL,FORTRAN) # pragma linkage(KUPROC,FORTRAN) # pragma linkage(KUPROF,FORTRAN) # pragma linkage(KUPROI,FORTRAN) # pragma linkage(KUPROP,FORTRAN) # pragma linkage(KUPROR,FORTRAN) # pragma linkage(KUPROS,FORTRAN) # pragma linkage(KUPVAL,FORTRAN) # pragma linkage(KUQCAS,FORTRAN) # pragma linkage(KUQENV,FORTRAN) # pragma linkage(KUQEXE,FORTRAN) # pragma linkage(KUQSVR,FORTRAN) # pragma linkage(KUQUIT,FORTRAN) # pragma linkage(KUSAPP,FORTRAN) # pragma linkage(KUSIBR,FORTRAN) # pragma linkage(KUSIGM,FORTRAN) # pragma linkage(KUSPY,FORTRAN) # pragma linkage(KUSTAT,FORTRAN) # pragma linkage(KUSTOP,FORTRAN) # pragma linkage(KUTERM,FORTRAN) # pragma linkage(KUTIME,FORTRAN) # pragma linkage(KUTIM0,FORTRAN) # pragma linkage(KUTRUE,FORTRAN) # pragma linkage(KUSER,FORTRAN) # pragma linkage(KUVCRE,FORTRAN) # pragma linkage(KUVDEL,FORTRAN) # pragma linkage(KUVECT,FORTRAN) # pragma linkage(KUVNAM,FORTRAN) # pragma linkage(KUWHAG,FORTRAN) # pragma linkage(KUWHAM,FORTRAN) # pragma linkage(KUWHAT,FORTRAN) # pragma linkage(KXALI1,FORTRAN) # pragma linkage(KXCRV2,FORTRAN) # pragma linkage(MACDEF,FORTRAN) # pragma linkage(MDMENU,FORTRAN) # pragma linkage(MHI_CLOSE,FORTRAN) # pragma linkage(MHI_OPEN,FORTRAN) # pragma linkage(MZWIPE,FORTRAN) # pragma linkage(TRACEQ,FORTRAN) # pragma linkage(XUFLOW,FORTRAN) #endif #define MAXCMD 512 /* max length of a command line */ #define MAXEDT 32 /* max length of names in edit server */ #define MAXLEV 10 /* max levels of command name path */ #define MAXSVR 20 /* max number of edit server processes */ /* * The PAWC common is referenced through a pointer to allow the use of * dynamic common blocks on IBM systems. */ #define Pawc kc_pawc EXTERN struct COMMON_PAWC { INTEGER NWPAR; INTEGER IXPAWC; INTEGER IHBOOK; INTEGER IXHIGZ; INTEGER IXKUIP; INTEGER IFENCE[5]; INTEGER LQ[8]; INTEGER DATA[999]; } *Pawc; #define IQ(n) Pawc->DATA[n-1] #define Q(n) (((REAL*)(Pawc->DATA))[n-1]) +KEEP,KCOM_H /* kcom.h: Fortran COMMON blocks */ #define Kcalia F77_BLOCK(kcalia,KCALIA) #define MALIAS 200 EXTERN struct { INTEGER NALIAS; LOGICAL ALIFLG; INTEGER ALITYP[MALIAS]; } F77_COMMON(Kcalia); #define Kcalic F77_BLOCK(kcalic,KCALIC) EXTERN struct { char ALINAM[MALIAS][60]; char ALIVAL[MALIAS][80]; } F77_COMMON(Kcalic); #define Kcbrek F77_BLOCK(kcbrek,KCBREK) EXTERN struct { LOGICAL TRAP; /* flag if signal trapping is enabled */ LOGICAL BRKEN; /* not used, always true */ LOGICAL FIRST; /* only used for Apollo */ LOGICAL FIRSG; /* only used for Apollo */ LOGICAL CLWHAT; /* flag if KUWHAT installed break handler */ LOGICAL CLWHAG; /* flag if KUWHAG installed break handler */ LOGICAL TBFLAG; /* flag if traceback should be printed */ } F77_COMMON(Kcbrek); #define Kcefil F77_BLOCK(kcefil,KCEFIL) EXTERN struct { char EDTFIL[MAXSVR][MAXEDT]; /* file name */ char EDTCMD[MAXSVR][MAXEDT]; /* KUIP command */ } F77_COMMON(Kcefil); #define Kcesvr F77_BLOCK(kcesvr,KCESVR) EXTERN struct { INTEGER NSVFIL; /* number of edited file */ INTEGER NSVCUR; /* pointer to current file */ SUBRPTR IESADD; /* routine set by KUEUSR */ LOGICAL SERVER; /* flag if edit server is used */ } F77_COMMON(Kcesvr); #define Kcexit F77_BLOCK(kcexit,KCEXIT) EXTERN struct { SUBRPTR IEXADD; /* routine set by KUEXIT */ SUBRPTR IUSADD; /* routine set by KUSER */ SUBRPTR NEXADD; /* routine set by KUNEXT */ SUBRPTR IUTADD; /* routine set by KUTERM */ SUBRPTR IQUADD; /* routine set by KUQUIT */ SUBRPTR IBRADD; /* routine set by KUBREK */ LOGICAL LICALL; LOGICAL LICAL2; LOGICAL LICAL3; } F77_COMMON(Kcexit); #define Kcmac F77_BLOCK(kcmac,KCMAC) EXTERN struct { LOGICAL MACTAB; INTEGER NSTLEV; LOGICAL QUITFL; LOGICAL WAITFL; LOGICAL WAITFF; LOGICAL DEBTAB; LOGICAL SKIPFL; LOGICAL HEADFL; INTEGER IONERF; LOGICAL NOEXEC; } F77_COMMON(Kcmac); #define Kcparc F77_BLOCK(kcparc,KCPARC) EXTERN struct { char PARLST[512]; /* interface block for KUSER */ char CLIST[80]; char NOALIN[512]; char COMAND[80]; char CHLAST[512]; char NONPOS[512]; } F77_COMMON(Kcparc); #define Kcsigm F77_BLOCK(kcsigm,KCSIGM) EXTERN struct { SUBRPTR ISIADD; /* routine set by KUSIGM */ INTEGER NVSIGM; /* number of temp vectors create for $SIGMA */ } F77_COMMON(Kcsigm); #define Kcutil F77_BLOCK(kcutil,KCUTIL) EXTERN struct { INTEGER NCMD; INTEGER IWD; INTEGER LUNFIL; INTEGER LPRMPT; LOGICAL TIMING; LOGICAL TRACE; INTEGER CALMOD; INTEGER NVADD; INTEGER IREPET; INTEGER IREFAC; INTEGER IBRAK; LOGICAL TIMALL; INTEGER LENTER; LOGICAL UNIQUE; INTEGER LENMUL; LOGICAL MULTFL; LOGICAL HISTOK; LOGICAL NOHIST; INTEGER LENMUM; LOGICAL FILCAS; LOGICAL MEXEFL; } F77_COMMON(Kcutil); #define Kcvect F77_BLOCK(kcvect,KCVECT) EXTERN struct { INTEGER NUMVEC; /* number of vectors stored */ INTEGER TOTPAV; INTEGER GETPAV; LOGICAL TVECFL; } F77_COMMON(Kcvect); #define Quest F77_BLOCK(quest,QUEST) EXTERN struct { INTEGER DATA[100]; } F77_COMMON(Quest); #define IQUEST(n) Quest.DATA[n-1] #define Sikuip F77_BLOCK(sikuip,SIKUIP) EXTERN struct { char CHSIGM[80]; /* command string passed to SIGMA */ } F77_COMMON(Sikuip); +KEEP,KSIG_H /* ksig.h: signal and break handling */ /* * Available signal handling package * * #define SIGNAL_POSIX ==> sigaction() for Unix * #define SIGNAL_BSD ==> sigvec() for VMS and NeXT * #define SIGNAL_V7 ==> signal() */ #if !defined(SIGNAL_BSD) && !defined(SIGNAL_V7) # define SIGNAL_POSIX #else # define sigjmp_buf jmp_buf # define sigsetjmp(buf,save) setjmp(buf) # define siglongjmp(buf,val) longjmp(buf,val) # ifdef vms # define sv_flags sv_onstack # endif #endif EXTERN struct { int trap_enabled; /* flag if exceptions should be trapped */ int traceback; /* print traceback on signal */ char *error_msg; /* messages is handler cannot do print */ int intr_count; /* count number of consecutive ^C interrupts */ int soft_intr; /* flag to stop at a convenient point */ int jump_set; /* flag if stack has been setup */ sigjmp_buf stack; int sockfd; /* socket descriptor and routine to */ void (*piaf_sync)(); /* resynchronize Piaf communication */ } kc_break; +KEEP,KBROW_H /* kbrow.h: browser definitions */ #define KBROW_H1 \ +SEQ,KBROW_H1 KBROW_H1 #define KBROW_H2 \ +SEQ,KBROW_H2 KBROW_H2 typedef struct _KmObject { struct _KmObject *next; /* link to next object definition */ char *name; /* unique identifier name */ char *stext; /* short description text */ char *ltext; /* long description text */ KmClass *class; /* pointer to objects's class structure */ } KmObject; typedef struct _BrVariable { struct _BrVariable *next; /* link to next variable definition */ char *name; /* variable name */ char *value; /* replacement value */ } BrVariable; typedef struct _BrObject { struct _BrObject *next; /* link to next browsable object */ char *name; /* name of the browsable object */ BrClass *class; /* pointer to browsable's class structure */ BrVariable *vars; /* linked list of variable substitutions */ } BrObject; typedef struct _BrClientdata { BrActTag tag; char *brobj; char *brcls; char *path; char *kmobj; char *kmcls; char *stext; char *ltext; char *mtext; } BrClientdata; EXTERN BrClass *brclasses; EXTERN KmObject *kmobjects; EXTERN KmButton *kmbuttons; extern C_PROTO_2(void klnkbrcl, BrClass*, int); extern C_PROTO_2(void klnkkmcl, KmClass*, int); extern C_PROTO_2(void klnkicon, KmIcon*, int); extern C_PROTO_2(void klnkbutt, KmButton*, int); extern C_PROTO_6(void exec_action, BrAction*, char*, char*, int, KmWidget, KmCalldata); extern C_PROTO_2(KmWidget find_button, char*, char*); extern C_PROTO_1(KmIcon* find_kmicon, char*); extern C_PROTO_1(KmClass* find_kmclass, char*); extern C_PROTO_1(BrObject* find_brobject, char*); extern C_PROTO_2(char* get_variable, char*, char*); extern C_PROTO_0(BrObject* scan_brobjects); extern C_PROTO_3(KmObject* scan_kmobjects, char*, char*, int); extern C_PROTO_7(int set_action, char*, int, int, char*, char*, int, int); extern C_PROTO_3(void set_variable, BrObject*, char*, char*); +KEEP,KLINK_H /* klink.h: demand linking of special routines */ #define KLINK_H1 EXTERN \ +SEQ,KLINK_H1 KLINK_H1 EXTERN struct { SUBROUTINE *user_exit_F; /* set by KUEXIT */ SUBROUTINE *user_quit_F; /* set by KUQUIT */ SUBROUTINE *user_break_F; /* set by KUBREK */ SUBROUTINE *user_edit_F; /* set by KUEUSR */ SUBROUTINE *user_comis_F; /* set by KUCOMV */ SUBROUTINE *user_sigma_F; /* set by KUSIGM */ SUBROUTINE *user_grfl_F; /* set by KUGRFL */ SUBROUTINE *user_term_F; /* set by KUTERM */ SUBROUTINE *user_input_F; /* set by KUSER */ SUBROUTINE *user_locate_F; /* set by KUMLOC */ /* indirect calls to avoid linking Motif */ IntFunc *disp_panel_C; /* display command panel (km_display_cmdpan) */ IntFunc *disp_kpanel_C; /* display KUIP panel (km_display_kpanel) */ IntFunc *disp_text_C; /* display text widget (km_display_sctext) */ IntFunc *disp_choice_C; /* display a choice of commands (?) */ IntFunc *disp_clean_C; /* clean before action (km_destroy_all_popup)*/ IntFunc *disp_flush_C; /* flush event queue (FlushEvents) */ IntFunc *disp_busy_C; /* show busy cursor (km_all_cursor) */ IntFunc *disp_exit_C; /* ask confirmation for exit */ IntFunc *disp_quit_C; /* ask confirmation for exit */ IntFunc *disp_select_C; /* select from a number of buttons */ IntFunc *disp_cmd_list_C; /* display list of commands (km_print_list) */ CharFunc *disp_prompt_C; /* prompt for input */ CharFunc *disp_passwd_C; /* prompt for password input */ /* indirect calls to avoid linking HIGZ without style G */ IntFunc *higz_init_C; /* initialize menu mode */ SUBROUTINE *higz_menu_F; /* IGMENU */ } kjmpaddr; +KEEP,KFLAG_H typedef enum { KmMACRO_COMMAND = 0, /* don't look for macros */ KmMACRO_AUTO, /* look for macros before commands */ KmMACRO_AUTOREVERSE /* look for macros after commands */ } KmMacOrder; typedef enum { KmSTYLE_A = 0x0001, /* Alpha menus */ KmSTYLE_C = 0x0002, /* Command line */ KmSTYLE_G = 0x0004, /* Graphics menus */ KmSTYLE_M = 0x0008, /* Model Human Interface */ KmSTYLE_U = 0x0010, /* User */ KmSTYLE_XM = 0x0020, /* Motif/X11 */ KmSTYLE_major = 0x00FF, /* A..X are mutually exclusive */ KmSTYLE_xL = 0x0100, /* Alpha Letter menus */ KmSTYLE_xP = 0x0200, /* Panel style GP or MP */ KmSTYLE_xS = 0x0400, /* Graphics with Software fonts */ KmSTYLE_xW = 0x0800 /* Graphics with shadowed Width */ } KmStyleFlag; typedef enum { KmTIMING_OFF, /* no timing */ KmTIMING_ON, /* time typed commands */ KmTIMING_ALL /* time individual commands inside macro */ } KmTiming; EXTERN struct { LOGICAL f77_true; /* value of .TRUE. */ LOGICAL f77_false; /* value of .FALSE. */ int do_exit; /* set by KXEXIT */ int do_quit; /* set by KXQUIT */ char *curr_prompt; /* current prompt string */ char *last_cmd; /* last command for $LAST */ KmTiming timing; /* timing on/off/all */ time_t real_time; /* real time at last timing off */ clock_t user_time; /* CPU time at last timing off */ int in_macro; /* command executed in macro */ int in_application; /* application mode is active */ int appl_called; /* application is executing */ char *appl_exit; /* string which leaves application mode */ KmCommand *appl_cmd; /* command which handles application */ char appl_file[256]; /* temporary file to pass application text */ FILE *appl_stream; /* C stream used for writing appl_file */ int appl_luno; /* Fortran logical unit opened for appl_file */ char help_file[256]; /* temporary file to view help text */ char uhlp_file[256]; /* temporary file to get user help text */ int uhlp_luno; /* Fortran logical unit opened for user help */ int in_motif; /* Motif mode is active */ int echo_command; /* echo commands in Motif mode */ char *echo_prompt; /* prompt string for echo commands */ KmStyleFlag style; /* input mode */ int keep_fcase; /* flag if no case conversion for filenames */ int use_kxterm; /* flag if kxterm should be used */ int use_server; /* flag if edit server should be used */ int editor_exit; /* flag set if edit server sent SIGUSR1 */ char *editor_cbuf; /* buffer of for edit servers commands */ char *macro_path; /* MACRO/DEFAULT search path */ KmMacOrder macro_search; /* MACRO/DEFAULT search order */ int temp_vectors; /* number of ?SIGMA vectors */ char init_wdir[256]; /* initial working directory */ } kc_flags; EXTERN struct { char *set_break; /* SET_SHOW/BREAK */ char set_columns[8]; /* SET_SHOW/COLUMNS */ char *set_command; /* SET_SHOW/COMMAND */ char *set_filecase; /* SET_SHOW/FILECASE */ char *set_host_editor; /* SET_SHOW/HOST_EDITOR */ char *set_host_pager; /* SET_SHOW/HOST_PAGER */ char *set_host_shell; /* SET_SHOW/HOST_SHELL */ char *set_prompt; /* SET_SHOW/PROMPT */ char *set_recall_style; /* SET_SHOW/RECALL_STYLE */ char set_recording[8]; /* SET_SHOW/RECORDING */ char *set_root; /* SET_SHOW/ROOT */ char *set_style; /* SET_SHOW/STYLE */ char *set_timing; /* SET_SHOW/TIMING */ char *help_edit; /* HELP edit mode */ char *defaults_path; /* MACRO/DEFAULTS search path */ char *defaults_order; /* MACRO/DEFAULTS search order */ } kc_value; typedef struct { int top; int left; int width; int height; } KmWindowDsc; EXTERN struct { KmWindowDsc edit_pad; /* coordinates for edit window */ KmWindowDsc help_pad; /* coordinates for readonly window */ int voffset; /* vertical offset */ int hoffset; /* horizontal offset */ int shift_max; /* maximum number of shifted pads */ int shift_now; /* current shift count */ int shift_dir; /* shift direction +/-1 */ int is_a_pad; /* flag if running in an Apollo DM pad */ int is_a_tty; /* flag if stdin and stdout at terminal */ int use_getline; /* flag for using getline() or normal read */ int use_no_echo; /* flag for using no echo in password prompt */ int term_width; /* terminal width in columns */ int kuwhag_called; /* allow style G */ float sgylen; float sgsize; float sgyspa; float sgbord; int panel_rows; /* number of rows in style GP panel */ int *panel_cols; /* number of columns in each row */ char ***panel_keys; /* key labels */ char *panel_keynum; /* value of $KEYNUM */ char *panel_keyval; /* value of $KEYVAL */ } kc_window; extern C_PROTO_1(char* style_name, KmStyleFlag); +KEEP,KMENU_H /* kmenu.h: data structures for menu and command definitions */ #define KMENU_H1 \ +SEQ,KMENU_H1 KMENU_H1 #define KMENU_H2 \ +SEQ,KMENU_H2 KMENU_H2 #define KMENU_H3 \ +SEQ,KMENU_H3 KMENU_H3 /* * temporary fix until we can reserve an extra word in KmCommand structure * to count keyboard and macro commands separately */ #define XCOUNT_SHIFT 10 #define XCOUNT_OFFSET (1 << XCOUNT_SHIFT) #define XCOUNT_MASK (XCOUNT_OFFSET - 1) extern C_PROTO_2(void check_version, int, int); extern C_PROTO_0(void check_edit_server); extern C_PROTO_3(int exec_cmd_string, char*, int, int(*)()); extern C_PROTO_1(int exec_decoded_cmd, KmCommand*); extern C_PROTO_1(KmMenu* find_submenu, char*); extern C_PROTO_2(char* fmt_cmd_help, KmCommand*, int); extern C_PROTO_0(void menu_style); extern C_PROTO_2(void print_cmd_list, KmCommand**, char*); extern C_PROTO_1(void reset_arg_list, KmCommand*); extern C_PROTO_1(KmMenu** root_menu_list, char*); extern C_PROTO_2(KmCommand* search_command, char*, KmCommand***); +KEEP,KHASH_H /* khash.h: hash table management */ typedef struct _HashArray { char *name; /* symbol name */ void *value; /* symbol value */ } HashArray; typedef struct _HashEntry { struct _HashEntry *next; /* link to next entry */ char *name; /* symbol name */ void *value; /* symbol value */ } HashEntry; typedef struct { int size; /* table size should be a prime number */ HashEntry **entries; /* pointer to array of size entries */ int nentries; /* number of entries */ int copy; /* flag if strdup/free(value) should be used */ } HashTable; #define ALIAS_TABLE_SIZE 97 /* should be a prime */ EXTERN struct { int translate; /* flag if translation wanted */ int substitutions; /* how many more before recursive alarm */ HashTable *arg_table; /* Argument alias table */ HashTable *cmd_table; /* Command alias table */ HashTable *var_table; /* macro variables */ } kc_alias; extern C_PROTO_2(HashTable* hash_create, int, int); extern C_PROTO_1(void hash_clear, HashTable*); extern C_PROTO_1(void hash_destroy, HashTable*); extern C_PROTO_3(void hash_insert, HashTable*, const char*, void*); extern C_PROTO_2(void hash_remove, HashTable*, const char*); extern C_PROTO_2(void* hash_lookup, HashTable*, const char*); extern C_PROTO_1(int hash_entries, HashTable*); extern C_PROTO_1(HashArray* hash_array, HashTable*); extern C_PROTO_1(int match_paren, char*); extern C_PROTO_1(char* repl_variable, char*); extern C_PROTO_2(char* repl_sysfun, char*, int); extern C_PROTO_1(char* subst_arg_alias, char*); extern C_PROTO_1(char* subst_cmd_alias, char*); extern C_PROTO_1(char* subst_var_alias, char*); extern C_PROTO_2(char* subst_sysfun, char*, int); extern C_PROTO_1(char* var_value, char*); +KEEP,MKTERM. #define ESCAPE "#@" typedef void (*KxtermActionProc)( #ifndef NO_PROTOTYPES char** /* params */, int /* num_params */ #endif ); typedef struct _KxtermActionsRec{ char *string; KxtermActionProc proc; } KxtermActionsRec; typedef KxtermActionsRec *KxtermActionList; extern C_PROTO_1(void kxterm_add_actions, KxtermActionList); extern C_PROTO_1(void handle_kxterm_action, char *); extern C_PROTO_1(void send_kxterm_cmd, char**); extern C_PROTO_1(void send_single_kxterm_cmd, char*); +DECK,hkuip_94a,if=94a. +KEEP,KHAIX370 #ifndef AIX370 # define AIX370 #endif +KEEP,KHAPOFTN #ifndef APOLLO_FTN # define APOLLO_FTN #endif +KEEP,KHIBMVM #ifndef IBMVM # define IBMVM #endif +KEEP,KHIBMMVS #ifndef IBMMVS # define IBMMVS #endif +KEEP,KHNEWLIB #ifndef NEWLIB # define NEWLIB #endif +KEEP,KUIP_H /* kuip.h: system dependent defines */ /* update version if structures have changed */ #define KUIP_VERSION 921023 /* identify system if not possible from preprocessor defines */ +SEQ,KHAIX370,IF=AIX370 +SEQ,KHAPOFTN,IF=APOFTN +SEQ,KHIBMVM ,IF=IBMVM +SEQ,KHIBMMVS,IF=IBMMVS +SEQ,KHNEWLIB,IF=NEWLIB #ifdef AIX370 # define MACHINE_NAME "IBMAIX" # define UNIX # define F77_EXTERN_INDIRECT #endif #if defined(apollo) || defined(__apollo) # define MACHINE_NAME "APOLLO" # define APOLLO # define UNIX # include # include # include # include # include # include # ifdef APOLLO_FTN /* using /com/ftn instead of /bin/f77 */ # define F77_CHAR_LEN_IND # define F77_CHAR_LEN_TYPE short # define F77_EXTERN_LOWERCASE # endif # define F77_EXTERN_INDIRECT # define F77_COMMON(name) name __attribute((__section(name))) # ifndef EXTERN # define EXTERN /* essential for accessing COMMON blocks */ # endif # define FATAL_SIGFPE # define HAVE_MEMMOVE # define HAVE_STRCASECMP # define HAVE_STRDUP # define NO_DIRENT_H # define TERMIO_BSD /* for getline we must compile under bsd4.3 */ #endif #if defined(__convexc__) # define CONVEX # define MACHINE_NAME "CONVEX" # define UNIX # define F77_BLOCK(name,NAME) _##name##_ # define F77_ARG_CONSTANT # ifndef EXTERN # define EXTERN /* essential for accessing COMMON blocks */ # endif # define FATAL_SIGFPE # define BROKEN_STRDUP /* wrong prototype for strdup() in string.h */ # define HAVE_MEMMOVE # define HAVE_STRCASECMP # define HAVE_STRNCASECMP # define HAVE_SELECT # define HAVE_VFORK # define MATCH_RE_COMP /* use re_comp/re_exec */ # define TERMIO_MAP_NL /* need to map NL to NL-CR on output */ # define USE_EDIT_SERVER #endif #ifdef CRAY # define MACHINE_NAME "CRAY" # define UNIX # include # define F77_EXTERN_UPPERCASE # ifndef EXTERN # define EXTERN /* essential for accessing COMMON blocks */ # endif # define HAVE_STRCASECMP # define HAVE_STRDUP # define NO_EDIT_SERVER #endif #if defined(hpux) || defined(__hpux) # define MACHINE_NAME "HPUX" # define HPUX # define UNIX # ifdef hpux /* cc -Ac */ # define NO_ANSI_CPP # define NO_PROTOTYPES # endif # ifndef _HPUX_SOURCE # define _HPUX_SOURCE # endif # define FATAL_SIGFPE /* needs f77 +T and ON REAL UNDERFLOW IGNORE */ # define HAVE_MEMMOVE # define HAVE_STRCASECMP # define HAVE_STRDUP # define HAVE_STRRSTR # define HAVE_SELECT # define SELECT_CAST(fds) (int*)fds #endif #ifdef _IBMR2 # define IBMRT # define MACHINE_NAME "IBMRT" # define UNIX # define HAVE_MEMMOVE # define HAVE_STRCASECMP # define HAVE_STRDUP # include # define HAVE_SELECT # define BROKEN_F77_IO #endif #ifdef IBMVM # define ARG_STYLE_CMS # define MACHINE_NAME "IBM" # define OS_NAME "VM" # ifndef IBM370 # define IBM370 # endif #endif #ifdef IBMMVS # define MACHINE_NAME "IBMMVS" # define OS_NAME "MVS" # ifndef IBM370 # define IBM370 # endif #endif #ifdef IBM370 # define F77_ARG_CONSTANT # define F77_CHAR_LEN_IND /* each parameter has a length argument ! */ # define F77_XXXX_ARG_LEN(x) F77_CHAR_ARG_LEN(x) # define F77_EXTERN_INDIRECT # define F77_EXTERN_UPPERCASE # define NO_FCNTL_H # define NO_UNISTD_H # define SIGNAL_V7 #endif #ifdef linux # define LINUX # define MACHINE_NAME "LINUX" # define UNIX # define HAVE_MEMMOVE # define HAVE_STRCASECMP # define HAVE_STRDUP # define HAVE_SELECT #endif #ifdef MSDOS # define MACHINE_NAME "IBMPC" # define OS_NAME "MSDOS" # define UNIX # define NO_EDIT_SERVER # define NO_SOCKET_H # define NO_SYS_TIME_H # define SIGNAL_V7 # define SLASHES "\\/" # define TERMIO_MAP_NL /* need to map NL to NL-CR on output */ #endif #ifdef WIN32 # define WINNT # ifdef _ALPHA_ # define MACHINE_NAME "ALPHA" # else # define MACHINE_NAME "IBMPC" # endif # define OS_NAME "WINNT" # define UNIX # define MSDOS # include # include # include # include # define text_mode__() # define NO_EDIT_SERVER # define NO_SOCKET_H # define NO_SYS_TIME_H # define NO_UNISTD_H # define SIGNAL_V7 # define SLASHES "\\" #endif #ifdef NeXT # define MACHINE_NAME "NEXT" # define UNIX # define getcwd(path,maxlen) getwd(path) # define F77_BLOCK(lc,uc) lc # define F77_EXTERN_INDIRECT /* each parameter has a length argument ! */ # define F77_XXXX_ARG_LEN(x) F77_CHAR_ARG_LEN(x) # define F77_XXXX_USE_LEN(x) ,286716 /* don't know if value matters */ # define HAVE_MEMMOVE # define HAVE_VFORK # define MATCH_RE_COMP /* use re_comp/re_exec */ # define NO_DIRENT_H # define NO_UNISTD_H # define SIGNAL_BSD # define TERMIO_BSD #endif #ifdef __osf__ # define UNIX # ifdef __alpha # define ALPHA # define MACHINE_NAME "ALPHA" # endif # define BROKEN_STRDUP /* wrong prototype for strdup() in string.h */ # define HAVE_MEMMOVE # define HAVE_STRCASECMP # define HAVE_SELECT # define BROKEN_F77_IO #endif #if defined(sgi) || defined(__sgi) # define MACHINE_NAME "SGI" # define SGI # define UNIX # ifndef __sgi /* Irix 3 */ # define NO_ANSI_CPP # define NO_PROTOTYPES # endif # define HAVE_MEMMOVE # define HAVE_STRCASECMP # define HAVE_STRDUP # define HAVE_SELECT #endif #if defined(sun) || defined(__sun) # define SUN # define UNIX # ifdef Solaris2 # define MACHINE_NAME "SOLARIS" # define SOLARIS # define HAVE_MEMMOVE # define HAVE_SELECT # define HAVE_STRCASECMP # define HAVE_STRDUP # define HAVE_VFORK # else # define MACHINE_NAME "SUN" # ifndef __STDC__ /* cc vs. acc */ # define NO_ANSI_CPP # define NO_PROTOTYPES # endif # define HAVE_SELECT # define HAVE_STRCASECMP # define HAVE_STRDUP # define HAVE_VFORK # include # define MATCH_RE_COMP /* use re_comp/re_exec */ # endif #endif #if defined(ultrix) || defined(__ultrix) # define MACHINE_NAME "DECS" # define ULTRIX # define UNIX # ifndef __ultrix /* cc vs. c89 */ # define NO_ANSI_CPP # define NO_PROTOTYPES # endif # define HAVE_MEMMOVE # define HAVE_STRCASECMP # define HAVE_VFORK # define TERMIO_BSD # define BROKEN_F77_IO #endif #ifdef vms # define OS_NAME "VMS" # ifdef __ALPHA # define ALPHA # define MACHINE_NAME "ALPHA" # pragma extern_model common_block # include /* inside descrip.h on VAX */ # else # define MACHINE_NAME "VAX" # define NO_ANSI_CPP # endif # include # include # include /* lib$... prototypes */ # include # include # include # include # include # include # include # include # include /* sys$... prototypes */ # include # include # include # include # include # ifndef R_OK /* no access() modes in unixio.h on VAX/VMS */ # define F_OK 0 # define X_OK 1 # define W_OK 2 # define R_OK 4 # endif # define ARG_STYLE_VMS # define F77_EXTERN_LOWERCASE # define HAVE_MEMMOVE # define HAVE_STAT_H # define HAVE_VFORK /* actually have only vfork */ # define NO_FCNTL_H # define NO_UNISTD_H # define SIGNAL_BSD # define sigmask(sig) (1L << (sig-1)) /* should be in signal.h */ # define USE_EDIT_SERVER /* only for TPU/DISPLAY=MOTIF */ # define fix_descriptor(dsc,str,n) \ do { \ dsc.dsc$b_dtype = DSC$K_DTYPE_T; \ dsc.dsc$b_class = DSC$K_CLASS_S; \ dsc.dsc$a_pointer = str; \ dsc.dsc$w_length = n; \ } while( 0 ) # define var_descriptor(dsc,str) \ do { \ dsc.dsc$b_dtype = DSC$K_DTYPE_T; \ dsc.dsc$b_class = DSC$K_CLASS_S; \ dsc.dsc$a_pointer = str; \ dsc.dsc$w_length = strlen( dsc.dsc$a_pointer ); \ } while( 0 ) #endif /* vms */ #include #include #include #ifndef NO_FCNTL_H #include #endif #include /* contains strtod() and strtol() on some systems */ #include #include #include #include #include #include #ifndef NO_UNISTD_H #include #endif #ifndef HAVE_VFORK # define vfork fork #endif #ifdef UNIX /* also defined for MSDOS and Windows/NT*/ # ifndef OS_NAME # define OS_NAME "UNIX" # endif # include # include # ifndef NO_SYS_TIME_H # include /* struct timeval */ # endif # ifndef MSDOS # ifdef TERMIO_BSD # define TERMIO_MAP_NL /* need to map NL to NL-CR on output */ # define HAVE_SELECT # endif # if defined(HAVE_SELECT) && !defined(SELECT_CAST) # define SELECT_CAST(fds) fds # endif # if !defined(TERMIO_BSD) && !defined(TERMIO_SYSV) # define TERMIO_POSIX # endif # include # ifndef NO_DIRENT_H /* POSIX opendir() */ # include # else /* BSD opendir() */ # include /* plus */ # define dirent direct /* struct dirent... */ # ifndef S_IRUSR # define S_IRUSR (S_IREAD) /* read permission, owner */ # define S_IWUSR (S_IWRITE) /* write permission, owner */ # define S_IXUSR (S_IEXEC) /* execute/search permission, owner */ # endif # endif # endif # define HAVE_STAT_H # ifndef NO_EDIT_SERVER # define USE_EDIT_SERVER # ifndef F_LOCK /* BSD file locking */ # include # define lockf(fd,op,offs) flock(fd,op) # define F_LOCK LOCK_EX # define F_ULOCK LOCK_UN # endif # endif # ifndef SLASHES # define SLASHES "/" # endif #endif #ifdef SUN # ifndef CLOCKS_PER_SEC # define CLOCKS_PER_SEC 1000000 /* missing in time.h */ # define difftime(t1,t0) ((double)(t1-t0)) # define raise(sig) kill(getpid(),sig) # endif #endif #ifndef CLOCKS_PER_SEC # define CLOCKS_PER_SEC 100 /* missing in VAX/VMS time.h */ #endif #ifdef HAVE_STAT_H # define KmTimeStamp struct stat # define get_stamp(path,stamp) stat(path,stamp) # define cmp_stamp(stamp1,stamp2) ((stamp2)->st_mtime == (stamp1)->st_mtime) #endif #ifndef KmTimeStamp # define KmTimeStamp int # define get_stamp(path,stamp) 0 # define cmp_stamp(stamp1,stamp2) 0 #endif #ifdef MATCH_RE_COMP extern char *re_comp(); extern int re_exec(); #else extern char *regcmp(); extern char *regex(); #endif /* command line arguments recognized by KUARGS */ #if !defined(ARG_STYLE_CMS) && !defined(ARG_STYLE_VMS) # define ARG_STYLE_UNIX #endif #ifndef MACHINE_NAME # define MACHINE_NAME "UNKNOWN" /* value returned by $MACHINE */ #endif #ifndef OS_NAME # define OS_NAME "UNKNOWN" /* value returned by $OS */ #endif /* #define EXTERN must be in one routine to allocate space for globals */ #ifndef EXTERN # define EXTERN extern #endif /* #define STATIC extern if debugger does not see static functions */ #ifndef STATIC # define STATIC static #endif #if defined(__GNUC__) || defined(__STDC__) # ifdef NO_ANSI_CPP # undef NO_ANSI_CPP # endif # ifdef NO_PROTOTYPES # undef NO_PROTOTYPES # endif #endif /* * Preprocessor syntax for token concatenation */ #ifndef NO_ANSI_CPP # define ConCat(con,cat) con##cat #else # define ConCat(con,cat) con/**/cat #endif /* * Prototyping for C functions */ #ifndef NO_PROTOTYPES # define C_PROTO_0(name) \ name(void) # define C_PROTO_1(name,arg1) \ name(arg1) # define C_PROTO_2(name,arg1,arg2) \ name(arg1,arg2) # define C_PROTO_3(name,arg1,arg2,arg3) \ name(arg1,arg2,arg3) # define C_PROTO_4(name,arg1,arg2,arg3,arg4) \ name(arg1,arg2,arg3,arg4) # define C_PROTO_5(name,arg1,arg2,arg3,arg4,arg5) \ name(arg1,arg2,arg3,arg4,arg5) # define C_PROTO_6(name,arg1,arg2,arg3,arg4,arg5,arg6) \ name(arg1,arg2,arg3,arg4,arg5,arg6) # define C_PROTO_7(name,arg1,arg2,arg3,arg4,arg5,arg6,arg7) \ name(arg1,arg2,arg3,arg4,arg5,arg6,arg7) # define C_PROTO_8(name,arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8) \ name(arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8) # define C_PROTO_9(name,arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8,arg9) \ name(arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8,arg9) # define C_PROTO_13(name,a1,a2,a3,a4,a5,a6,a7,a8,a9,b0,b1,b2,b3) \ name(a1,a2,a3,a4,a5,a6,a7,a8,a9,b0,b1,b2,b3) # define C_PROTO_16(name,a1,a2,a3,a4,a5,a6,a7,a8,a9,b0,b1,b2,b3,b4,b5,b6) \ name(a1,a2,a3,a4,a5,a6,a7,a8,a9,b0,b1,b2,b3,b4,b5,b6) # define C_PROTO_17(name,a1,a2,a3,a4,a5,a6,a7,a8,a9,b0,b1,b2,b3,b4,b5,b6,b7) \ name(a1,a2,a3,a4,a5,a6,a7,a8,a9,b0,b1,b2,b3,b4,b5,b6,b7) # define C_DECL_0(name) \ name() # define C_DECL_1(name,t1,p1) \ name(t1 p1) # define C_DECL_2(name,t1,p1,t2,p2) \ name(t1 p1,t2 p2) # define C_DECL_3(name,t1,p1,t2,p2,t3,p3) \ name(t1 p1,t2 p2,t3 p3) # define C_DECL_4(name,t1,p1,t2,p2,t3,p3,t4,p4) \ name(t1 p1,t2 p2,t3 p3,t4 p4) # define C_DECL_5(name,t1,p1,t2,p2,t3,p3,t4,p4,t5,p5) \ name(t1 p1,t2 p2,t3 p3,t4 p4,t5 p5) # define C_DECL_6(name,t1,p1,t2,p2,t3,p3,t4,p4,t5,p5,t6,p6) \ name(t1 p1,t2 p2,t3 p3,t4 p4,t5 p5,t6 p6) # define C_DECL_7(name,t1,p1,t2,p2,t3,p3,t4,p4,t5,p5,t6,p6,t7,p7) \ name(t1 p1,t2 p2,t3 p3,t4 p4,t5 p5,t6 p6,t7 p7) # define C_DECL_8(name,t1,p1,t2,p2,t3,p3,t4,p4,t5,p5,t6,p6,t7,p7,t8,p8) \ name(t1 p1,t2 p2,t3 p3,t4 p4,t5 p5,t6 p6,t7 p7,t8 p8) # define C_DECL_9(name,t1,p1,t2,p2,t3,p3,t4,p4,t5,p5,t6,p6,t7,p7,t8,p8,t9,p9)\ name(t1 p1,t2 p2,t3 p3,t4 p4,t5 p5,t6 p6,t7 p7,t8 p8,t9 p9) # define C_DECL_13(name,t1,p1,t2,p2,t3,p3,t4,p4,t5,p5,t6,p6,t7,p7,t8,p8,\ t9,p9,t10,p10,t11,p11,t12,p12,t13,p13) \ name(t1 p1,t2 p2,t3 p3,t4 p4,t5 p5,t6 p6,t7 p7,t8 p8,\ t9 p9,t10 p10,t11 p11,t12 p12,t13 p13) #else # define const # define C_PROTO_0(name) \ name() # define C_PROTO_1(name,arg1) \ name() # define C_PROTO_2(name,arg1,arg2) \ name() # define C_PROTO_3(name,arg1,arg2,arg3) \ name() # define C_PROTO_4(name,arg1,arg2,arg3,arg4) \ name() # define C_PROTO_5(name,arg1,arg2,arg3,arg4,arg5) \ name() # define C_PROTO_6(name,arg1,arg2,arg3,arg4,arg5,arg6) \ name() # define C_PROTO_7(name,arg1,arg2,arg3,arg4,arg5,arg6,arg7) \ name() # define C_PROTO_8(name,arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8) \ name() # define C_PROTO_9(name,arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8,arg9) \ name() # define C_PROTO_13(name,a1,a2,a3,a4,a5,a6,a7,a8,a9,b0,b1,b2,b3) \ name() # define C_PROTO_16(name,a1,a2,a3,a4,a5,a6,a7,a8,a9,b0,b1,b2,b3,b4,b5,b6) \ name() # define C_PROTO_17(name,a1,a2,a3,a4,a5,a6,a7,a8,a9,b0,b1,b2,b3,b4,b5,b6,b7) \ name() # define C_DECL_0(name) \ name() # define C_DECL_1(name,t1,p1) \ name( p1) \ t1 p1; # define C_DECL_2(name,t1,p1,t2,p2) \ name( p1, p2) \ t1 p1;t2 p2; # define C_DECL_3(name,t1,p1,t2,p2,t3,p3) \ name( p1, p2, p3) \ t1 p1;t2 p2;t3 p3; # define C_DECL_4(name,t1,p1,t2,p2,t3,p3,t4,p4) \ name( p1, p2, p3, p4) \ t1 p1;t2 p2;t3 p3;t4 p4; # define C_DECL_5(name,t1,p1,t2,p2,t3,p3,t4,p4,t5,p5) \ name( p1, p2, p3, p4, p5) \ t1 p1;t2 p2;t3 p3;t4 p4;t5 p5; # define C_DECL_6(name,t1,p1,t2,p2,t3,p3,t4,p4,t5,p5,t6,p6) \ name( p1, p2, p3, p4, p5, p6) \ t1 p1;t2 p2;t3 p3;t4 p4;t5 p5;t6 p6; # define C_DECL_7(name,t1,p1,t2,p2,t3,p3,t4,p4,t5,p5,t6,p6,t7,p7) \ name( p1, p2, p3, p4, p5, p6, p7) \ t1 p1;t2 p2;t3 p3;t4 p4;t5 p5;t6 p6;t7 p7; # define C_DECL_8(name,t1,p1,t2,p2,t3,p3,t4,p4,t5,p5,t6,p6,t7,p7,t8,p8) \ name( p1, p2, p3, p4, p5, p6, p7, p8) \ t1 p1;t2 p2;t3 p3;t4 p4;t5 p5;t6 p6;t7 p7;t8 p8; # define C_DECL_9(name,t1,p1,t2,p2,t3,p3,t4,p4,t5,p5,t6,p6,t7,p7,t8,p8,t9,p9)\ name( p1, p2, p3, p4, p5, p6, p7, p8, p9)\ t1 p1;t2 p2;t3 p3;t4 p4;t5 p5;t6 p6;t7 p7;t8 p8;t9 p9; # define C_DECL_13(name,A,a,B,b,C,c,D,d,E,e,F,f,G,g,H,h,I,i,J,j,K,k,L,l,M,m)\ name( a, b, c, d, e, f, g, h, i, j, k, l, m)\ A a;B b;C c;D d;E e;F f;G g;H h;I i;J j;K k;L l;M m; #endif typedef int IntFunc(); typedef char* CharFunc(); typedef char** pCharFunc(); #define KUMAC_UNWIND -30041961 /* error status to quit macro execution */ /* * convenience functions from kkern.c */ extern C_PROTO_2(char* fexpand, const char*, const char*); extern C_PROTO_1(char* fsymlink, const char*); extern C_PROTO_3(char* fsearch, const char*, const char*, const char*); extern C_PROTO_2(char* fstrdup, const char*, size_t); extern C_PROTO_2(char* fstr0dup, const char*, size_t); extern C_PROTO_2(char* fstrtrim, const char*, size_t); extern C_PROTO_2(char* fstr0trim, const char*, size_t); extern C_PROTO_2(size_t fstrlen, const char*, size_t); extern C_PROTO_3(size_t fstrset, char*, size_t, const char*); extern C_PROTO_2(double fstrtod, char*, char**); extern C_PROTO_2(int fstrtoi, char*, char**); extern C_PROTO_3(char* fstrvec, char**, int, int*); #ifndef HAVE_MEMMOVE extern C_PROTO_3(void* memmove, void*, const void*, size_t); #endif #ifndef HAVE_STRCASECMP extern C_PROTO_2(int strcasecmp, const char*, const char*); extern C_PROTO_3(int strncasecmp, const char*, const char*, size_t); #endif #ifndef HAVE_STRDUP #ifdef BROKEN_STRDUP /* prototype without const */ # define strdup Strdup #endif extern C_PROTO_1(char* strdup, const char*); #endif #ifndef HAVE_STRRSTR extern C_PROTO_2(char* strrstr, const char*, const char*); #endif extern C_PROTO_2(char* strrpbrk, const char*, const char*); extern C_PROTO_1(char* str0dup, const char*); extern C_PROTO_2(char* str2dup, const char*, const char*); extern C_PROTO_3(char* str3dup, const char*, const char*, const char*); extern C_PROTO_4(char* str4dup, const char*, const char*, const char*, const char*); extern C_PROTO_5(char* str5dup, const char*, const char*, const char*, const char*, const char*); extern C_PROTO_2(char* strndup, const char*, int); extern C_PROTO_2(char* mstrcat, char*, const char*); extern C_PROTO_3(char* mstr2cat, char*, const char*, const char*); extern C_PROTO_4(char* mstr3cat, char*, const char*, const char*, const char*); extern C_PROTO_5(char* mstr4cat, char*, const char*, const char*, const char*, const char*); extern C_PROTO_3(char* mstrncat, char*, const char*, int); extern C_PROTO_3(char* mstrccat, char*, int, int); extern C_PROTO_2(char* mstricat, char*, int); extern C_PROTO_2(int mstrlen, char**, int); extern C_PROTO_1(char* strqtok, char*); extern C_PROTO_1(char* strlower, char*); extern C_PROTO_1(char* strupper, char*); extern C_PROTO_1(char* struntab, char*); extern C_PROTO_2(char* strfromd, double, int); extern C_PROTO_2(char* strfromi, int, int); /* * C-interface functions */ extern C_PROTO_0(char* k_getar); extern C_PROTO_2(void k_setar, int, char**); extern C_PROTO_0(char* k_userid); extern C_PROTO_0(void ku_alfa); extern C_PROTO_2(char* ku_appl, int*, int*); extern C_PROTO_1(int ku_close, int); extern C_PROTO_1(void ku_cmdl, char*); extern C_PROTO_2(int ku_edit, char*, int); extern C_PROTO_1(char* ku_eval, char*); extern C_PROTO_1(int ku_exec, char*); extern C_PROTO_1(int ku_exel, char*); extern C_PROTO_0(char* ku_getc); extern C_PROTO_0(char* ku_gete); extern C_PROTO_0(char* ku_getf); extern C_PROTO_0(int ku_geti); extern C_PROTO_0(char* ku_getl); extern C_PROTO_0(char* ku_getq); extern C_PROTO_0(double ku_getr); extern C_PROTO_0(char* ku_gets); extern C_PROTO_1(char* ku_fcase, char*); extern C_PROTO_2(char* ku_home, char*, char*); extern C_PROTO_1(int ku_inqf, char*); extern C_PROTO_1(int ku_intr, int); extern C_PROTO_1(void ku_last, char*); extern C_PROTO_2(int ku_more, char*, char*); extern C_PROTO_0(int ku_npar); extern C_PROTO_3(int ku_open, int, char*, char*); extern C_PROTO_2(void ku_pad, char*, int); extern C_PROTO_0(char* ku_path); extern C_PROTO_2(void ku_piaf, int, void(*)()); extern C_PROTO_2(char* ku_proc, char*, char*); extern C_PROTO_2(char* ku_prof, char*, char*); extern C_PROTO_2(int ku_proi, char*, int); extern C_PROTO_1(char* ku_prop, char*); extern C_PROTO_2(double ku_pror, char*, double); extern C_PROTO_2(char* ku_pros, char*, char*); extern C_PROTO_0(char** ku_qenv); extern C_PROTO_1(char* ku_qexe, char*); extern C_PROTO_3(int ku_read, int, char*, int); extern C_PROTO_2(int ku_sapp, char*, char*); extern C_PROTO_0(void ku_shut); extern C_PROTO_1(int ku_stop, int); extern C_PROTO_2(void ku_time, time_t, clock_t); extern C_PROTO_2(void ku_trap, int, int); extern C_PROTO_1(int ku_vqaddr, char*); extern C_PROTO_1(int ku_vtype, char*); extern C_PROTO_2(int ku_vvalue, char*, double*); extern C_PROTO_0(void ku_whag); extern C_PROTO_1(void ku_what, void(*)()); extern C_PROTO_2(void ku_write, int, char*); extern C_PROTO_1(char* getline, char*); extern C_PROTO_2(void gl_config, char*, int); extern C_PROTO_1(void gl_histadd, char*); extern C_PROTO_1(void gl_setwidth, int); extern C_PROTO_2(char* input_line, char*, int); extern C_PROTO_0(void leave_kuip); extern C_PROTO_2(int len_alias, char*, int); extern C_PROTO_1(int len_sysfun, char*); extern C_PROTO_1(int len_vector, char*); extern C_PROTO_2(char* quote_string, char*, int); extern C_PROTO_0(void reset_break); #ifndef vms extern C_PROTO_1(void signal_handler, int ); #else extern C_PROTO_2(int signal_handler, void*, void* ); extern C_PROTO_1(int control_C_ast, int ); #endif +KEEP,KFOR_H /* kfor.h: Fortran-C interface */ /* * Fortran data types */ typedef int INTEGER; typedef int LOGICAL; typedef float REAL; typedef double DBLPREC; typedef struct { REAL re; REAL im; } COMPLEX; typedef INTEGER INT_FUNCTION(); typedef INT_FUNCTION *INT_FUNCPTR; typedef void (*SUBRPTR)(); typedef void SUBROUTINE(); #ifdef IBM370 #pragma linkage(SUBROUTINE,FORTRAN) #pragma linkage(INT_FUNCTION,FORTRAN) #pragma map(__CTOF,"@@CTOF") extern INTEGER __CTOF( INT_FUNCPTR, ... ); #endif typedef union _EQUIV_INT_REAL { INTEGER i; LOGICAL l; REAL r; } EQUIV_INT_REAL; /* * Mapping of C-routine name for Fortran CALL SUB * * #define F77_EXTERN_LOWERCASE ==> void sub() * #define F77_EXTERN_UPPERCASE ==> void SUB() * otherwise ==> void sub_() */ #ifdef F77_EXTERN_UPPERCASE # define F77_NAME(name,NAME) NAME #else # ifdef F77_EXTERN_LOWERCASE # define F77_NAME(name,NAME) name # else # define F77_NAME(name,NAME) ConCat(name,_) # endif #endif #ifndef F77_BLOCK # define F77_BLOCK(name,NAME) F77_NAME(name,NAME) #endif #ifndef F77_COMMON # define F77_COMMON(name) name #endif /* * Routine address in CALL SUB(FUN) ; EXTERNAL FUN * * #define F77_EXTERN_INDIRECT ==> void (**fun)(); * otherwise ==> void (*fun)(); */ #ifdef F77_EXTERN_INDIRECT # define F77_EXTERN_ARG(e) ConCat(e,_ptr) # define F77_EXTERN_DCL(e) SUBROUTINE **ConCat(e,_ptr); # define F77_EXTERN_DEF(e) SUBROUTINE *e = *ConCat(e,_ptr); #else # define F77_EXTERN_ARG(e) e # define F77_EXTERN_DCL(e) SUBROUTINE *e; # define F77_EXTERN_DEF(e) #endif #define F77_EXTERN2ARG(e1,e2) F77_EXTERN_ARG(e1),F77_EXTERN_ARG(e2) #define F77_EXTERN2DCL(e1,e2) F77_EXTERN_DCL(e1) F77_EXTERN_DCL(e2) #define F77_EXTERN2DEF(e1,e2) F77_EXTERN_DEF(e1) F77_EXTERN_DEF(e2) #define F77_EXTERN3ARG(e1,e2,e3) F77_EXTERN_ARG(e1),F77_EXTERN2ARG(e2,e3) #define F77_EXTERN3DCL(e1,e2,e3) F77_EXTERN_DCL(e1) F77_EXTERN2DCL(e2,e3) #define F77_EXTERN3DEF(e1,e2,e3) F77_EXTERN_DEF(e1) F77_EXTERN2DEF(e2,e3) #define F77_EXTERN4ARG(e1,e2,e3,e4) F77_EXTERN_ARG(e1),F77_EXTERN3ARG(e2,e3,e4) #define F77_EXTERN4DCL(e1,e2,e3,e4) F77_EXTERN_DCL(e1) F77_EXTERN3DCL(e2,e3,e4) #define F77_EXTERN4DEF(e1,e2,e3,e4) F77_EXTERN_DEF(e1) F77_EXTERN3DEF(e2,e3,e4) #ifdef F77_ARG_CONSTANT /* * If the Fortran compiler (e.g. VSFORTRAN and Convex fc without -sa option) * uses constant argument blocks we have to make a private copy in case the * routine uses the arguments as local variables. */ # define F77_XXXX_ARG_PTR(t,x) ConCat(x,_ptr) # define F77_XXXX_ARG_DCL(t,x) t *ConCat(x,_ptr); # define F77_XXXX_ARG_DEF(t,x) t *x = ConCat(x,_ptr); #else # define F77_XXXX_ARG_PTR(t,x) x # define F77_XXXX_ARG_DCL(t,x) t *x; # define F77_XXXX_ARG_DEF(t,x) #endif #define F77_REAL_ARG_PTR(r) F77_XXXX_ARG_PTR(REAL,r) #define F77_REAL_ARG_DCL(r) F77_XXXX_ARG_DCL(REAL,r) #define F77_REAL_ARG_DEF(r) F77_XXXX_ARG_DEF(REAL,r) #define F77_INTG_ARG_PTR(i) F77_XXXX_ARG_PTR(INTEGER,i) #define F77_INTG_ARG_DCL(i) F77_XXXX_ARG_DCL(INTEGER,i) #define F77_INTG_ARG_DEF(i) F77_XXXX_ARG_DEF(INTEGER,i) #define F77_INTG_ARG2PTR(i1,i2) F77_INTG_ARG_PTR(i1),F77_INTG_ARG_PTR(i2) #define F77_INTG_ARG2DCL(i1,i2) F77_INTG_ARG_DCL(i1) F77_INTG_ARG_DCL(i2) #define F77_INTG_ARG2DEF(i1,i2) F77_INTG_ARG_DEF(i1) F77_INTG_ARG_DEF(i2) #define F77_INTG_ARG3PTR(i1,i2,i3) F77_INTG_ARG_PTR(i1),F77_INTG_ARG2PTR(i2,i3) #define F77_INTG_ARG3DCL(i1,i2,i3) F77_INTG_ARG_DCL(i1) F77_INTG_ARG2DCL(i2,i3) #define F77_INTG_ARG3DEF(i1,i2,i3) F77_INTG_ARG_DEF(i1) F77_INTG_ARG2DEF(i2,i3) #define F77_INTG_ARG4PTR(i1,i2,i3,i4) F77_INTG_ARG_PTR(i1), \ F77_INTG_ARG3PTR(i2,i3,i4) #define F77_INTG_ARG4DCL(i1,i2,i3,i4) F77_INTG_ARG_DCL(i1) \ F77_INTG_ARG3DCL(i2,i3,i4) #define F77_INTG_ARG4DEF(i1,i2,i3,i4) F77_INTG_ARG_DEF(i1) \ F77_INTG_ARG3DEF(i2,i3,i4) /* * Access to Fortran CHARACTER arguments */ #ifdef vms /* VMS string descriptors */ # define F77_CHAR_ARG_PTR(s) ConCat(s,_ptr) # define F77_CHAR_ARG_LEN(s) # define F77_CHAR_ARG_DCL(s) struct dsc$descriptor_s *ConCat(s,_ptr); # define F77_CHAR_ARG_DEF(s) char *s = ConCat(s,_ptr)->dsc$a_pointer; \ int ConCat(len_,s) = ConCat(s,_ptr)->dsc$w_length; # define F77_CHAR_DEF_DSC(s,p,l) struct dsc$descriptor_s ConCat(s,_dsc); # define F77_CHAR_ASS_DSC(s,p,l) ConCat(s,_dsc).dsc$w_length = l; \ ConCat(s,_dsc).dsc$b_dtype = DSC$K_DTYPE_T;\ ConCat(s,_dsc).dsc$b_class = DSC$K_CLASS_S;\ ConCat(s,_dsc).dsc$a_pointer = p; # define F77_CHAR_USE_PTR(s,p,l) &ConCat(s,_dsc) # define F77_CHAR_USE_LEN(s,p,l) #else #ifdef CRAY /* Cray string descriptors */ # define F77_CHAR_ARG_PTR(s) ConCat(s,_ptr) # define F77_CHAR_ARG_LEN(s) # define F77_CHAR_ARG_DCL(s) _fcd ConCat(s,_ptr); # define F77_CHAR_ARG_DEF(s) char *s = _fcdtocp(ConCat(s,_ptr)); \ int ConCat(len_,s) = _fcdlen(ConCat(s,_ptr)); # define F77_CHAR_DEF_DSC(s,p,l) # define F77_CHAR_ASS_DSC(s,p,l) # define F77_CHAR_USE_PTR(s,p,l) _cptofcd(p,l) # define F77_CHAR_USE_LEN(s,p,l) #else /* length passed as additional argument */ # ifdef F77_CHAR_LEN_IND /* length passed by reference */ # define F77_CHAR_LEN_STAR(len) *len # else # define F77_CHAR_LEN_STAR(len) len # endif # ifndef F77_CHAR_LEN_TYPE # define F77_CHAR_LEN_TYPE int # endif # ifdef F77_ARG_CONSTANT # define F77_CHAR_ARG_PTR(s) ConCat(s,_ptr) # define F77_CHAR_ARG_LEN(s) , ConCat(s,_len) # define F77_CHAR_ARG_DCL(s) char *ConCat(s,_ptr); \ F77_CHAR_LEN_TYPE F77_CHAR_LEN_STAR(ConCat(s,_len)); # define F77_CHAR_ARG_DEF(s) char *s = ConCat(s,_ptr); \ int ConCat(len_,s) = F77_CHAR_LEN_STAR(ConCat(s,_len)); # else # ifdef F77_CHAR_LEN_IND # define F77_CHAR_ARG_PTR(s) s # define F77_CHAR_ARG_LEN(s) , ConCat(s,_len) # define F77_CHAR_ARG_DCL(s) char *s; \ F77_CHAR_LEN_TYPE F77_CHAR_LEN_STAR(ConCat(s,_len)); # define F77_CHAR_ARG_DEF(s) \ int ConCat(len_,s) = F77_CHAR_LEN_STAR(ConCat(s,_len)); # else # define F77_CHAR_ARG_PTR(s) s # define F77_CHAR_ARG_LEN(s) , ConCat(len_,s) # define F77_CHAR_ARG_DCL(s) char *s; int ConCat(len_,s); # define F77_CHAR_ARG_DEF(s) # endif # endif # if defined(F77_CHAR_LEN_IND) # define F77_CHAR_DEF_DSC(s,p,l) F77_CHAR_LEN_TYPE ConCat(s,_dsc) = l; # define F77_CHAR_ASS_DSC(s,p,l) # define F77_CHAR_USE_PTR(s,p,l) p # define F77_CHAR_USE_LEN(s,p,l) , &ConCat(s,_dsc) # else # define F77_CHAR_DEF_DSC(s,p,l) # define F77_CHAR_ASS_DSC(s,p,l) # define F77_CHAR_USE_PTR(s,p,l) p # define F77_CHAR_USE_LEN(s,p,l) , l # endif #endif #endif #ifndef F77_XXXX_ARG_LEN /* length argument of non-CHARACTER arguments */ # define F77_XXXX_ARG_LEN(x) /* nil */ # define F77_XXXX_USE_LEN(x) /* nil */ #endif #define F77_CHAR_ARG2PTR(c1,c2) \ F77_CHAR_ARG_PTR(c1),F77_CHAR_ARG_PTR(c2) #define F77_CHAR_ARG2LEN(c1,c2) \ F77_CHAR_ARG_LEN(c1) F77_CHAR_ARG_LEN(c2) #define F77_XXXX_ARG2LEN(c1,c2) \ F77_XXXX_ARG_LEN(c1) F77_XXXX_ARG_LEN(c2) #define F77_CHAR_ARG2DCL(c1,c2) \ F77_CHAR_ARG_DCL(c1) F77_CHAR_ARG_DCL(c2) #define F77_CHAR_ARG2DEF(c1,c2) \ F77_CHAR_ARG_DEF(c1) F77_CHAR_ARG_DEF(c2) #define F77_CHAR_ARG3PTR(c1,c2,c3) \ F77_CHAR_ARG2PTR(c1,c2),F77_CHAR_ARG_PTR(c3) #define F77_CHAR_ARG3LEN(c1,c2,c3) \ F77_CHAR_ARG2LEN(c1,c2) F77_CHAR_ARG_LEN(c3) #define F77_XXXX_ARG3LEN(c1,c2,c3) \ F77_XXXX_ARG2LEN(c1,c2) F77_XXXX_ARG_LEN(c3) #define F77_CHAR_ARG3DCL(c1,c2,c3) \ F77_CHAR_ARG2DCL(c1,c2) F77_CHAR_ARG_DCL(c3) #define F77_CHAR_ARG3DEF(c1,c2,c3) \ F77_CHAR_ARG2DEF(c1,c2) F77_CHAR_ARG_DEF(c3) #define F77_CHAR_ARG4PTR(c1,c2,c3,c4) \ F77_CHAR_ARG3PTR(c1,c2,c3),F77_CHAR_ARG_PTR(c4) #define F77_CHAR_ARG4LEN(c1,c2,c3,c4) \ F77_CHAR_ARG3LEN(c1,c2,c3) F77_CHAR_ARG_LEN(c4) #define F77_XXXX_ARG4LEN(c1,c2,c3,c4) \ F77_XXXX_ARG3LEN(c1,c2,c3) F77_XXXX_ARG_LEN(c4) #define F77_CHAR_ARG4DCL(c1,c2,c3,c4) \ F77_CHAR_ARG3DCL(c1,c2,c3) F77_CHAR_ARG_DCL(c4) #define F77_CHAR_ARG4DEF(c1,c2,c3,c4) \ F77_CHAR_ARG3DEF(c1,c2,c3) F77_CHAR_ARG_DEF(c4) #define F77_CHAR_ARG5PTR(c1,c2,c3,c4,c5) \ F77_CHAR_ARG4PTR(c1,c2,c3,c4),F77_CHAR_ARG_PTR(c5) #define F77_CHAR_ARG5LEN(c1,c2,c3,c4,c5) \ F77_CHAR_ARG4LEN(c1,c2,c3,c4) F77_CHAR_ARG_LEN(c5) #define F77_CHAR_ARG5DCL(c1,c2,c3,c4,c5) \ F77_CHAR_ARG4DCL(c1,c2,c3,c4) F77_CHAR_ARG_DCL(c5) #define F77_CHAR_ARG5DEF(c1,c2,c3,c4,c5) \ F77_CHAR_ARG4DEF(c1,c2,c3,c4) F77_CHAR_ARG_DEF(c5) /* * Fortran-calls-C interface * * To define a C function called by Fortran CALL SUB(A,B,C): * * #define Sub F77_NAME(sub,SUB) * #pragma linkage(SUB,FORTRAN) // for IBM C/370 compiler * * F77_ENTRY_xyz(Sub,a,b,c) // opening { contained in macro * // body ... * } * * Each character in xyz declares the type of the corresponding parameter: * * C = CHARACTER * E = EXTERNAL * I = INTEGER * R = REAL * * If a parameter PAR is declared as CHARACTER the macro defines: * * char *PAR; // pointer to string (not terminated by \0 !!!) * int len_PAR; // length of string as defined by Fortran's LEN(PAR) * * The names PAR_dsc and PAR_ptr are reserved for internal use. * * Note: The function body follows the F77_ENTRY_... macro call directly. * The opening { is generated by the macro. */ #define F77_ENTRY_C(name,c1) \ name( F77_CHAR_ARG_PTR(c1) F77_CHAR_ARG_LEN(c1) ) \ F77_CHAR_ARG_DCL(c1) \ { F77_CHAR_ARG_DEF(c1) #define F77_ENTRY_CC(name,c1,c2) \ name( F77_CHAR_ARG2PTR(c1,c2) F77_CHAR_ARG2LEN(c1,c2) ) \ F77_CHAR_ARG2DCL(c1,c2) \ { F77_CHAR_ARG2DEF(c1,c2) #define F77_ENTRY_C3(name,c1,c2,c3) \ name( F77_CHAR_ARG3PTR(c1,c2,c3) \ F77_CHAR_ARG3LEN(c1,c2,c3) ) \ F77_CHAR_ARG3DCL(c1,c2,c3) \ { F77_CHAR_ARG3DEF(c1,c2,c3) #define F77_ENTRY_C5(name,c1,c2,c3,c4,c5) \ name( F77_CHAR_ARG5PTR(c1,c2,c3,c4,c5) \ F77_CHAR_ARG5LEN(c1,c2,c3,c4,c5) ) \ F77_CHAR_ARG5DCL(c1,c2,c3,c4,c5) \ { F77_CHAR_ARG5DEF(c1,c2,c3,c4,c5) #define F77_ENTRY_C4E(name,c1,c2,c3,c4,e5) \ name( F77_CHAR_ARG4PTR(c1,c2,c3,c4),F77_EXTERN_ARG(e5) \ F77_CHAR_ARG4LEN(c1,c2,c3,c4) ) \ F77_CHAR_ARG4DCL(c1,c2,c3,c4) F77_EXTERN_DCL(e5) \ { F77_CHAR_ARG4DEF(c1,c2,c3,c4) F77_EXTERN_DEF(e5) #define F77_ENTRY_C4I(name,c1,c2,c3,c4,i5) \ name( F77_CHAR_ARG4PTR(c1,c2,c3,c4),F77_INTG_ARG_PTR(i5) \ F77_CHAR_ARG4LEN(c1,c2,c3,c4) ) \ F77_CHAR_ARG4DCL(c1,c2,c3,c4) F77_INTG_ARG_DCL(i5) \ { F77_CHAR_ARG4DEF(c1,c2,c3,c4) F77_INTG_ARG_DEF(i5) #define F77_ENTRY_C5E(name,c1,c2,c3,c4,c5,e6) \ name( F77_CHAR_ARG5PTR(c1,c2,c3,c4,c5),F77_EXTERN_ARG(e6) \ F77_CHAR_ARG5LEN(c1,c2,c3,c4,c5) ) \ F77_CHAR_ARG5DCL(c1,c2,c3,c4,c5) F77_EXTERN_DCL(e6) \ { F77_CHAR_ARG5DEF(c1,c2,c3,c4,c5) F77_EXTERN_DEF(e6) #define F77_ENTRY_CCE(name,c1,c2,e3) \ name( F77_CHAR_ARG2PTR(c1,c2),F77_EXTERN_ARG(e3) \ F77_CHAR_ARG2LEN(c1,c2) ) \ F77_CHAR_ARG2DCL(c1,c2) F77_EXTERN_DCL(e3) \ { F77_CHAR_ARG2DEF(c1,c2) F77_EXTERN_DEF(e3) #define F77_ENTRY_CCEE(name,c1,c2,e3,e4) \ name( F77_CHAR_ARG2PTR(c1,c2),F77_EXTERN2ARG(e3,e4) \ F77_CHAR_ARG2LEN(c1,c2) ) \ F77_CHAR_ARG2DCL(c1,c2) F77_EXTERN2DCL(e3,e4) \ { F77_CHAR_ARG2DEF(c1,c2) F77_EXTERN2DEF(e3,e4) #define F77_ENTRY_CCI(name,c1,c2,i3) \ name( F77_CHAR_ARG2PTR(c1,c2),F77_INTG_ARG_PTR(i3) \ F77_CHAR_ARG2LEN(c1,c2) ) \ F77_CHAR_ARG2DCL(c1,c2) F77_INTG_ARG_DCL(i3) \ { F77_CHAR_ARG2DEF(c1,c2) F77_INTG_ARG_DEF(i3) #define F77_ENTRY_CCIC(name,c1,c2,i3,c4) \ name( F77_CHAR_ARG2PTR(c1,c2),F77_INTG_ARG_PTR(i3),F77_CHAR_ARG_PTR(c4) \ F77_CHAR_ARG2LEN(c1,c2) F77_XXXX_ARG_LEN(i3) F77_CHAR_ARG_LEN(c4) ) \ F77_CHAR_ARG3DCL(c1,c2,c4) F77_INTG_ARG_DCL(i3) \ { F77_CHAR_ARG3DEF(c1,c2,c4) F77_INTG_ARG_DEF(i3) #define F77_ENTRY_CCI3(name,c1,c2,i3,i4,i5) \ name( F77_CHAR_ARG2PTR(c1,c2),F77_INTG_ARG3PTR(i3,i4,i5) \ F77_CHAR_ARG2LEN(c1,c2) ) \ F77_CHAR_ARG2DCL(c1,c2) F77_INTG_ARG3DCL(i3,i4,i5) \ { F77_CHAR_ARG2DEF(c1,c2) F77_INTG_ARG3DEF(i3,i4,i5) #define F77_ENTRY_CCIRCC(name,c1,c2,i3,r4,c5,c6) \ name( F77_CHAR_ARG2PTR(c1,c2), \ F77_INTG_ARG_PTR(i3),F77_REAL_ARG_PTR(r4),F77_CHAR_ARG2PTR(c5,c6) \ F77_CHAR_ARG2LEN(c1,c2) \ F77_XXXX_ARG2LEN(i3,r4) F77_CHAR_ARG2LEN(c5,c6) ) \ F77_CHAR_ARG4DCL(c1,c2,c5,c6) \ F77_INTG_ARG_DCL(i3) F77_REAL_ARG_DCL(r4) \ { F77_CHAR_ARG4DEF(c1,c2,c5,c6) \ F77_INTG_ARG_DEF(i3) F77_REAL_ARG_DEF(r4) \ #define F77_ENTRY_CE(name,c1,e2) \ name( F77_CHAR_ARG_PTR(c1),F77_EXTERN_ARG(e2) \ F77_CHAR_ARG_LEN(c1) ) \ F77_CHAR_ARG_DCL(c1) F77_EXTERN_DCL(e2) \ { F77_CHAR_ARG_DEF(c1) F77_EXTERN_DEF(e2) #define F77_ENTRY_CI(name,c1,i2) \ name( F77_CHAR_ARG_PTR(c1),F77_INTG_ARG_PTR(i2) \ F77_CHAR_ARG_LEN(c1) ) \ F77_CHAR_ARG_DCL(c1) F77_INTG_ARG_DCL(i2) \ { F77_CHAR_ARG_DEF(c1) F77_INTG_ARG_DEF(i2) #define F77_ENTRY_CICI(name,c1,i2,c3,i4) \ name( F77_CHAR_ARG_PTR(c1),F77_INTG_ARG_PTR(i2), \ F77_CHAR_ARG_PTR(c3),F77_INTG_ARG_PTR(i4) \ F77_CHAR_ARG_LEN(c1) F77_XXXX_ARG_LEN(i2) \ F77_CHAR_ARG_LEN(c3) ) \ F77_CHAR_ARG2DCL(c1,c3) F77_INTG_ARG2DCL(i2,i4) \ { F77_CHAR_ARG2DEF(c1,c3) F77_INTG_ARG2DEF(i2,i4) #define F77_ENTRY_CII(name,c1,i2,i3) \ name( F77_CHAR_ARG_PTR(c1),F77_INTG_ARG2PTR(i2,i3) \ F77_CHAR_ARG_LEN(c1) ) \ F77_CHAR_ARG_DCL(c1) F77_INTG_ARG2DCL(i2,i3) \ { F77_CHAR_ARG_DEF(c1) F77_INTG_ARG2DEF(i2,i3) #define F77_ENTRY_CIIC(name,c1,i2,i3,c4) \ name( F77_CHAR_ARG_PTR(c1),F77_INTG_ARG2PTR(i2,i3),F77_CHAR_ARG_PTR(c4) \ F77_CHAR_ARG_LEN(c1) F77_XXXX_ARG2LEN(i2,i3) F77_CHAR_ARG_LEN(c4) ) \ F77_CHAR_ARG2DCL(c1,c4) F77_INTG_ARG2DCL(i2,i3) \ { F77_CHAR_ARG2DEF(c1,c4) F77_INTG_ARG2DEF(i2,i3) #define F77_ENTRY_CR(name,c1,r2) \ name( F77_CHAR_ARG_PTR(c1),F77_REAL_ARG_PTR(r2) \ F77_CHAR_ARG_LEN(c1) ) \ F77_CHAR_ARG_DCL(c1) F77_REAL_ARG_DCL(r2) \ { F77_CHAR_ARG_DEF(c1) F77_REAL_ARG_DEF(r2) #define F77_ENTRY_E(name,e1) \ name( F77_EXTERN_ARG(e1) ) \ F77_EXTERN_DCL(e1) \ { F77_EXTERN_DEF(e1) #define F77_ENTRY_E4(name,e1,e2,e3,e4) \ name( F77_EXTERN4ARG(e1,e2,e3,e4) ) \ F77_EXTERN4DCL(e1,e2,e3,e4) \ { F77_EXTERN4DEF(e1,e2,e3,e4) #define F77_ENTRY_IC(name,i1,c2) \ name( F77_INTG_ARG_PTR(i1),F77_CHAR_ARG_PTR(c2) \ F77_XXXX_ARG_LEN(i1) F77_CHAR_ARG_LEN(c2) ) \ F77_INTG_ARG_DCL(i1) F77_CHAR_ARG_DCL(c2) \ { F77_INTG_ARG_DEF(i1) F77_CHAR_ARG_DEF(c2) #define F77_ENTRY_ICI(name,i1,c2,i3) \ name( F77_INTG_ARG_PTR(i1), F77_CHAR_ARG_PTR(c2),F77_INTG_ARG_PTR(i3) \ F77_XXXX_ARG_LEN(i1) F77_CHAR_ARG_LEN(c2) ) \ F77_INTG_ARG2DCL(i1,i3) F77_CHAR_ARG_DCL(c2) \ { F77_INTG_ARG2DEF(i1,i3) F77_CHAR_ARG_DEF(c2) #define F77_ENTRY_IIC(name,i1,i2,c3) \ name( F77_INTG_ARG2PTR(i1,i2),F77_CHAR_ARG_PTR(c3) \ F77_XXXX_ARG2LEN(i1,i2) F77_CHAR_ARG_LEN(c3) ) \ F77_INTG_ARG2DCL(i1,i2) F77_CHAR_ARG_DCL(c3) \ { F77_INTG_ARG2DEF(i1,i2) F77_CHAR_ARG_DEF(c3) #define F77_ENTRY_I3C(name,i1,i2,i3,c4) \ name( F77_INTG_ARG3PTR(i1,i2,i3),F77_CHAR_ARG_PTR(c4) \ F77_XXXX_ARG3LEN(i1,i2,i3) F77_CHAR_ARG_LEN(c4) ) \ F77_INTG_ARG3DCL(i1,i2,i3) F77_CHAR_ARG_DCL(c4) \ { F77_INTG_ARG3DEF(i1,i2,i3) F77_CHAR_ARG_DEF(c4) #define F77_ENTRY_I4CCC(name,i1,i2,i3,i4,c5,c6,c7) \ name( F77_INTG_ARG4PTR(i1,i2,i3,i4),F77_CHAR_ARG3PTR(c5,c6,c7) \ F77_XXXX_ARG4LEN(i1,i2,i3,i4) F77_CHAR_ARG3LEN(c5,c6,c7) ) \ F77_INTG_ARG4DCL(i1,i2,i3,i4) F77_CHAR_ARG3DCL(c5,c6,c7) \ { F77_INTG_ARG4DEF(i1,i2,i3,i4) F77_CHAR_ARG3DEF(c5,c6,c7) #define F77_CHAR_DEF2DSC(s1,p1,l1,s2,p2,l2) \ F77_CHAR_DEF_DSC(s1,p1,l1) F77_CHAR_DEF_DSC(s2,p2,l2) #define F77_CHAR_ASS2DSC(s1,p1,l1,s2,p2,l2) \ F77_CHAR_ASS_DSC(s1,p1,l1) F77_CHAR_ASS_DSC(s2,p2,l2) #define F77_CHAR_USE2PTR(s1,p1,l1,s2,p2,l2) \ F77_CHAR_USE_PTR(s1,p1,l1),F77_CHAR_USE_PTR(s2,p2,l2) #define F77_CHAR_USE2LEN(s1,p1,l1,s2,p2,l2) \ F77_CHAR_USE_LEN(s1,p1,l1) F77_CHAR_USE_LEN(s2,p2,l2) #define F77_XXXX_USE2LEN(x1,x2) \ F77_XXXX_USE_LEN(x1) F77_XXXX_USE_LEN(x2) #define F77_CHAR_DEF3DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3) \ F77_CHAR_DEF2DSC(s1,p1,l1,s2,p2,l2) F77_CHAR_DEF_DSC(s3,p3,l3) #define F77_CHAR_ASS3DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3) \ F77_CHAR_ASS2DSC(s1,p1,l1,s2,p2,l2) F77_CHAR_ASS_DSC(s3,p3,l3) #define F77_CHAR_USE3PTR(s1,p1,l1,s2,p2,l2,s3,p3,l3) \ F77_CHAR_USE2PTR(s1,p1,l1,s2,p2,l2),F77_CHAR_USE_PTR(s3,p3,l3) #define F77_CHAR_USE3LEN(s1,p1,l1,s2,p2,l2,s3,p3,l3) \ F77_CHAR_USE2LEN(s1,p1,l1,s2,p2,l2) F77_CHAR_USE_LEN(s3,p3,l3) #define F77_XXXX_USE3LEN(x1,x2,x3) \ F77_XXXX_USE2LEN(x1,x2) F77_XXXX_USE_LEN(x3) #define F77_CHAR_DEF4DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3,s4,p4,l4) \ F77_CHAR_DEF3DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3) F77_CHAR_DEF_DSC(s4,p4,l4) #define F77_CHAR_ASS4DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3,s4,p4,l4) \ F77_CHAR_ASS3DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3) F77_CHAR_ASS_DSC(s4,p4,l4) #define F77_CHAR_USE4PTR(s1,p1,l1,s2,p2,l2,s3,p3,l3,s4,p4,l4) \ F77_CHAR_USE3PTR(s1,p1,l1,s2,p2,l2,s3,p3,l3),F77_CHAR_USE_PTR(s4,p4,l4) #define F77_CHAR_USE4LEN(s1,p1,l1,s2,p2,l2,s3,p3,l3,s4,p4,l4) \ F77_CHAR_USE3LEN(s1,p1,l1,s2,p2,l2,s3,p3,l3) F77_CHAR_USE_LEN(s4,p4,l4) #define F77_XXXX_USE4LEN(x1,x2,x3,x4) \ F77_XXXX_USE3LEN(x1,x2,x3) F77_XXXX_USE_LEN(x4) #define F77_XXXX_USE5LEN(x1,x2,x3,x4,x5) \ F77_XXXX_USE4LEN(x1,x2,x3,x4) F77_XXXX_USE_LEN(x5) #define F77_XXXX_USE6LEN(x1,x2,x3,x4,x5,x6) \ F77_XXXX_USE5LEN(x1,x2,x3,x4,x5) F77_XXXX_USE_LEN(x6) #define F77_XXXX_USE7LEN(x1,x2,x3,x4,x5,x6,x7) \ F77_XXXX_USE6LEN(x1,x2,x3,x4,x5,x6) F77_XXXX_USE_LEN(x7) #define F77_XXXX_USE8LEN(x1,x2,x3,x4,x5,x6,x7,x8) \ F77_XXXX_USE7LEN(x1,x2,x3,x4,x5,x6,x7) F77_XXXX_USE_LEN(x8) #ifdef IBM370 #pragma linkage(K77C,FORTRAN) #define F77_CALL_C(name,p1,l1) do { \ SUBROUTINE *F77 = name; \ K77C(&F77,p1,l1); } while(0) #else #define F77_CALL_C(name,p1,l1) do { \ F77_CHAR_DEF_DSC(s1,p1,l1) \ F77_CHAR_ASS_DSC(s1,p1,l1) \ name( F77_CHAR_USE_PTR(s1,p1,l1) \ F77_CHAR_USE_LEN(s1,p1,l1) \ ); } while(0) #endif #if 0 #ifdef IBM370 #pragma linkage(K77CC,FORTRAN) #define F77_CALL_CC(name,p1,l1,p2,l2) do { \ SUBROUTINE *F77 = name; \ K77CC(&F77,p1,l1,p2,l2); } while(0) #else #define F77_CALL_CC(name,p1,l1,p2,l2) do { \ F77_CHAR_DEF2DSC(s1,p1,l1,s2,p2,l2) \ F77_CHAR_ASS2DSC(s1,p1,l1,s2,p2,l2) \ name( F77_CHAR_USE2PTR(s1,p1,l1,s2,p2,l2) \ F77_CHAR_USE2LEN(s1,p1,l1,s2,p2,l2) \ ); } while(0) #endif #else #ifdef IBM370 #pragma linkage(K77CC,FORTRAN) #define F77_IFUN_CC(i0,name,p1,l1,p2,l2) do { \ i0 = K77CC(&name,p1,l1,p2,l2); } while(0) #else #define F77_IFUN_CC(i0,name,p1,l1,p2,l2) do { \ F77_CHAR_DEF2DSC(s1,p1,l1,s2,p2,l2) \ F77_CHAR_ASS2DSC(s1,p1,l1,s2,p2,l2) \ i0 = (*name)( \ F77_CHAR_USE2PTR(s1,p1,l1,s2,p2,l2) \ F77_CHAR_USE2LEN(s1,p1,l1,s2,p2,l2) \ ); } while(0) #endif #define F77_CALL_CC(name,p1,l1,p2,l2) do { \ INT_FUNCPTR _p0_ = (INT_FUNCPTR)name; \ INTEGER _i0_; \ F77_IFUN_CC(_i0_,_p0_,p1,l1,p2,l2); \ } while(0) #endif #ifdef IBM370 #pragma linkage(K77C3,FORTRAN) #define F77_CALL_C3(name,p1,l1,p2,l2,p3,l3) do { \ SUBROUTINE *F77 = name; \ K77C3(&F77,p1,l1,p2,l2,p3,l3); } while(0) #else #define F77_CALL_C3(name,p1,l1,p2,l2,p3,l3) do { \ F77_CHAR_DEF3DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3) \ F77_CHAR_ASS3DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3) \ name( F77_CHAR_USE3PTR(s1,p1,l1,s2,p2,l2,s3,p3,l3) \ F77_CHAR_USE3LEN(s1,p1,l1,s2,p2,l2,s3,p3,l3) \ ); } while(0) #endif #ifdef IBM370 #pragma linkage(K77C7,FORTRAN) #define F77_CALL_C7(name,p1,l1,p2,l2,p3,l3,p4,l4,p5,l5,p6,l6,p7,l7) do { \ SUBROUTINE *F77 = name; \ K77C7(&F77,p1,l1,p2,l2,p3,l3,p4,l4,p5,l5,p6,l6,p7,l7); } while(0) #else #define F77_CALL_C7(name,p1,l1,p2,l2,p3,l3,p4,l4,p5,l5,p6,l6,p7,l7) do { \ F77_CHAR_DEF4DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3,s4,p4,l4) \ F77_CHAR_DEF3DSC(s5,p5,l5,s6,p6,l6,s7,p7,l7) \ F77_CHAR_ASS4DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3,s4,p4,l4) \ F77_CHAR_ASS3DSC(s5,p5,l5,s6,p6,l6,s7,p7,l7) \ name( F77_CHAR_USE4PTR(s1,p1,l1,s2,p2,l2,s3,p3,l3,s4,p4,l4), \ F77_CHAR_USE3PTR(s5,p5,l5,s6,p6,l6,s7,p7,l7) \ F77_CHAR_USE4LEN(s1,p1,l1,s2,p2,l2,s3,p3,l3,s4,p4,l4) \ F77_CHAR_USE3LEN(s5,p5,l5,s6,p6,l6,s7,p7,l7) \ ); } while(0) #endif #ifdef IBM370 #pragma linkage(K77CCx,FORTRAN) #define F77_CALL_CCx(name,p1,l1,p2,l2,x3) do { \ SUBROUTINE *F77 = name; \ K77CCx(&F77,p1,l1,p2,l2,x3); } while(0) #else #define F77_CALL_CCx(name,p1,l1,p2,l2,x3) do { \ F77_CHAR_DEF2DSC(s1,p1,l1,s2,p2,l2) \ F77_CHAR_ASS2DSC(s1,p1,l1,s2,p2,l2) \ name( F77_CHAR_USE2PTR(s1,p1,l1,s2,p2,l2), \ x3 \ F77_CHAR_USE2LEN(s1,p1,l1,s2,p2,l2) \ F77_XXXX_USE_LEN(x3) \ ); } while(0) #endif #ifdef IBM370 #pragma linkage(K77CCx3,FORTRAN) #define F77_CALL_CCx3(name,p1,l1,p2,l2,x3,x4,x5) do { \ SUBROUTINE *F77 = name; \ K77CCx3(&F77,p1,l1,p2,l2,x3,x4,x5); } while(0) #else #define F77_CALL_CCx3(name,p1,l1,p2,l2,x3,x4,x5) do { \ F77_CHAR_DEF2DSC(s1,p1,l1,s2,p2,l2) \ F77_CHAR_ASS2DSC(s1,p1,l1,s2,p2,l2) \ name( F77_CHAR_USE2PTR(s1,p1,l1,s2,p2,l2), \ x3,x4,x5 \ F77_CHAR_USE2LEN(s1,p1,l1,s2,p2,l2) \ F77_XXXX_USE3LEN(x3,x4,x5) \ ); } while(0) #endif #ifdef IBM370 #pragma linkage(K77Cx,FORTRAN) #define F77_IFUN_Cx(i0,name,p1,l1,x2) do { \ i0 = K77Cx(&name,p1,l1,x2); } while(0) #else #define F77_IFUN_Cx(i0,name,p1,l1,x2) do { \ F77_CHAR_DEF_DSC(s1,p1,l1) \ F77_CHAR_ASS_DSC(s1,p1,l1) \ i0 = (*name)( \ F77_CHAR_USE_PTR(s1,p1,l1), \ x2 \ F77_CHAR_USE_LEN(s1,p1,l1) \ F77_XXXX_USE_LEN(x2) \ ); } while(0) #endif #define F77_CALL_Cx(name,p1,l1,x2) do { \ INT_FUNCPTR _p0_ = (INT_FUNCPTR)name; \ INTEGER _i0_; \ F77_IFUN_Cx(_i0_,_p0_,p1,l1,x2); \ } while(0) #ifdef IBM370 #pragma linkage(K77CxC,FORTRAN) #define F77_CALL_CxC(name,p1,l1,x2,p3,l3) do { \ SUBROUTINE *F77 = name; \ K77CxC(&F77,p1,l1,x2,p3,l3); } while(0) #else #define F77_CALL_CxC(name,p1,l1,x2,p3,l3) do { \ F77_CHAR_DEF2DSC(s1,p1,l1,s3,p3,l3) \ F77_CHAR_ASS2DSC(s1,p1,l1,s3,p3,l3) \ name( F77_CHAR_USE_PTR(s1,p1,l1), \ x2, \ F77_CHAR_USE_PTR(s3,p3,l3) \ F77_CHAR_USE_LEN(s1,p1,l1) \ F77_XXXX_USE_LEN(x2) \ F77_CHAR_USE_LEN(s3,p3,l3) \ ); } while(0) #endif #ifdef IBM370 #pragma linkage(K77Cxx,FORTRAN) #define F77_CALL_Cxx(name,p1,l1,x2,x3) do { \ SUBROUTINE *F77 = name; \ K77Cxx(&F77,p1,l1,x2,x3); } while(0) #else #define F77_CALL_Cxx(name,p1,l1,x2,x3) do { \ F77_CHAR_DEF_DSC(s1,p1,l1) \ F77_CHAR_ASS_DSC(s1,p1,l1) \ name( F77_CHAR_USE_PTR(s1,p1,l1), \ x2,x3 \ F77_CHAR_USE_LEN(s1,p1,l1) \ F77_XXXX_USE2LEN(x2,x3) \ ); } while(0) #endif #ifdef IBM370 #pragma linkage(K77xC,FORTRAN) #define F77_CALL_xC(name,x1,p2,l2) do { \ SUBROUTINE *F77 = name; \ K77xC(&F77,x1,p2,l2); } while(0) #else #define F77_CALL_xC(name,x1,p2,l2) do { \ F77_CHAR_DEF_DSC(s2,p2,l2) \ F77_CHAR_ASS_DSC(s2,p2,l2) \ name( x1, \ F77_CHAR_USE_PTR(s2,p2,l2) \ F77_XXXX_USE_LEN(x1) \ F77_CHAR_USE_LEN(s2,p2,l2) \ ); } while(0) #endif #ifdef IBM370 #pragma linkage(K77xCCx,FORTRAN) #define F77_CALL_xCCx(name,x1,p2,l2,p3,l3,x4) do { \ SUBROUTINE *F77 = name; \ K77xCCx(&F77,x1,p2,l2,p3,l3,x4); } while(0) #else #define F77_CALL_xCCx(name,x1,p2,l2,p3,l3,x4) do { \ F77_CHAR_DEF2DSC(s2,p2,l2,s3,p3,l3) \ F77_CHAR_ASS2DSC(s2,p2,l2,s3,p3,l3) \ name( x1, \ F77_CHAR_USE2PTR(s2,p2,l2,s3,p3,l3), \ x4 \ F77_XXXX_USE_LEN(x1) \ F77_CHAR_USE2LEN(s2,p2,l2,s3,p3,l3) \ F77_XXXX_USE_LEN(x4) \ ); } while(0) #endif #ifdef IBM370 #pragma linkage(K77xCC,FORTRAN) #define F77_IFUN_xCC(i0,name,x1,p2,l2,p3,l3) do { \ i0 = K77xCC(&name,x1,p2,l2,p3,l3); } while(0) #else #define F77_IFUN_xCC(i0,name,x1,p2,l2,p3,l3) do { \ F77_CHAR_DEF2DSC(s2,p2,l2,s3,p3,l3) \ F77_CHAR_ASS2DSC(s2,p2,l2,s3,p3,l3) \ i0 = (*name)( x1, \ F77_CHAR_USE2PTR(s2,p2,l2,s3,p3,l3) \ F77_XXXX_USE_LEN(x1) \ F77_CHAR_USE2LEN(s2,p2,l2,s3,p3,l3) \ ); } while(0) #endif #define F77_CALL_xCC(name,x1,p2,l2,p3,l3) do { \ INT_FUNCPTR _p0_ = (INT_FUNCPTR)name; \ INTEGER _i0_; \ F77_IFUN_xCC(_i0_,_p0_,x1,p2,l2,p3,l3); \ } while(0) #ifdef IBM370 #pragma linkage(K77xCx,FORTRAN) #define F77_IFUN_xCx(i0,name,x1,p2,l2,x3) do { \ i0 = K77xCx(&name,x1,p2,l2,x3); } while(0) #else #define F77_IFUN_xCx(i0,name,x1,p2,l2,x3) do { \ F77_CHAR_DEF_DSC(s2,p2,l2) \ F77_CHAR_ASS_DSC(s2,p2,l2) \ i0 = (*name)( x1, \ F77_CHAR_USE_PTR(s2,p2,l2), \ x3 \ F77_XXXX_USE_LEN(x1) \ F77_CHAR_USE_LEN(s2,p2,l2) \ F77_XXXX_USE_LEN(x3) \ ); } while(0) #endif #define F77_CALL_xCx(name,x1,p2,l2,x3) do { \ INT_FUNCPTR _p0_ = (INT_FUNCPTR)name; \ INTEGER _i0_; \ F77_IFUN_xCx(_i0_,_p0_,x1,p2,l2,x3); \ } while(0) #ifdef IBM370 #pragma linkage(K77x4C,FORTRAN) #define F77_CALL_x4C(name,x1,x2,x3,x4,p5,l5) do { \ SUBROUTINE *F77 = name; \ K77x4C(&F77,x1,x2,x3,x4,p5,l5); } while(0) #else #define F77_CALL_x4C(name,x1,x2,x3,x4,p5,l5) do { \ F77_CHAR_DEF_DSC(s5,p5,l5) \ F77_CHAR_ASS_DSC(s5,p5,l5) \ name( x1,x2,x3,x4, \ F77_CHAR_USE_PTR(s5,p5,l5) \ F77_XXXX_USE4LEN(x1,x2,x3,x4) \ F77_CHAR_USE_LEN(s5,p5,l5) \ ); } while(0) #endif #ifdef IBM370 #pragma linkage(K77x4Cxx,FORTRAN) #define F77_CALL_x4Cxx(name,x1,x2,x3,x4,p5,l5,x6,x7) do { \ SUBROUTINE *F77 = name; \ K77x4Cxx(&F77,x1,x2,x3,x4,p5,l5,x6,x7); } while(0) #else #define F77_CALL_x4Cxx(name,x1,x2,x3,x4,p5,l5,x6,x7) do { \ F77_CHAR_DEF_DSC(s5,p5,l5) \ F77_CHAR_ASS_DSC(s5,p5,l5) \ name( x1,x2,x3,x4, \ F77_CHAR_USE_PTR(s5,p5,l5), \ x6,x7 \ F77_XXXX_USE4LEN(x1,x2,x3,x4) \ F77_CHAR_USE_LEN(s5,p5,l5) \ F77_XXXX_USE2LEN(x6,x7) \ ); } while(0) #endif #ifdef IBM370 #pragma linkage(KIGMENU,FORTRAN) /* 1 2 3 4 5 6 7 8 9 10 11 12 13 14 */ #define F77_CALL_xCx5CxC3xC(name,a,b,B,c,d,e,f,g,h,H,i,j,J,k,K,l,L,m,n,N) do {\ SUBROUTINE *F77 = name; \ KIGMENU(&F77,a,b,B,c,d,e,f,g,h,H,i,j,J,k,K,l,L,m,n,N); } while(0) #else #define F77_CALL_xCx5CxC3xC(name,a,b,B,c,d,e,f,g,h,H,i,j,J,k,K,l,L,m,n,N) do {\ F77_CHAR_DEF_DSC(sb,b,B) \ F77_CHAR_DEF_DSC(sh,h,H) \ F77_CHAR_DEF3DSC(sj,j,J,sk,k,K,sl,l,L) \ F77_CHAR_DEF_DSC(sn,n,N) \ F77_CHAR_ASS_DSC(sb,b,B) \ F77_CHAR_ASS_DSC(sh,h,H) \ F77_CHAR_ASS3DSC(sj,j,J,sk,k,K,sl,l,L) \ F77_CHAR_ASS_DSC(sn,n,N) \ name( a, \ F77_CHAR_USE_PTR(sb,b,B), \ c,d,e,f,g, \ F77_CHAR_USE_PTR(sh,h,H), \ i, \ F77_CHAR_USE3PTR(sj,j,J,sk,k,K,sl,l,L), \ m, \ F77_CHAR_USE_PTR(sn,n,N) \ F77_XXXX_USE_LEN(a) \ F77_CHAR_USE_LEN(sb,b,B) \ F77_XXXX_USE5LEN(c,d,e,f,g) \ F77_CHAR_USE_LEN(sh,h,H) \ F77_XXXX_USE_LEN(i) \ F77_CHAR_USE3LEN(sj,j,J,sk,k,K,sl,l,L) \ F77_XXXX_USE_LEN(m) \ F77_CHAR_USE_LEN(sn,n,N) \ ); } while(0) #endif #ifdef IBM370 #define F77_IFUN_x(i0,name,x1) i0 = __CTOF(name,x1) #else #define F77_IFUN_x(i0,name,x1) i0 = (*name)(x1) #endif #ifdef IBM370 #define F77_IFUN_xx(i0,name,x1,x2) i0 = __CTOF(name,x1,x2) #else #define F77_IFUN_xx(i0,name,x1,x2) i0 = (*name)(x1,x2) #endif #ifdef IBM370 #pragma linkage(K77xCx8,FORTRAN) #define F77_IFUN_xCx8(i0,name,x1,p2,l2,x3,x4,x5,x6,x7,x8,x9,x10) do { \ i0 = K77xCx8(&name,x1,p2,l2,x3,x4,x5,x6,x7,x8,x9,x10); } while(0) #else #define F77_IFUN_xCx8(i0,name,x1,p2,l2,x3,x4,x5,x6,x7,x8,x9,x10) do { \ F77_CHAR_DEF_DSC(s2,p2,l2) \ F77_CHAR_ASS_DSC(s2,p2,l2) \ i0 = (*name)( x1, \ F77_CHAR_USE_PTR(s2,p2,l2), \ x3,x4,x5,x6,x7,x8,x9,x10 \ F77_XXXX_USE_LEN(x1) \ F77_CHAR_USE_LEN(s2,p2,l2) \ F77_XXXX_USE8LEN(x3,x4,x5,x6,x7,x8,x9,x10) \ ); } while(0) #endif /* * routines called by Fortran */ #define Errrun F77_NAME(errrun,ERRRUN) #define Fmemcpy F77_NAME(fmemcpy,FMEMCPY) #define Getarg F77_NAME(getarg,GETARG) extern SUBROUTINE Getarg; #define Goparm F77_NAME(goparm,GOPARM) extern SUBROUTINE Goparm; #define Gl_char_cleanup F77_NAME(gl_char_cleanup,GL_CHAR_CLEANUP) #define Gl_reset F77_NAME(gl_reset,GL_RESET) #define Gl_reinit F77_NAME(gl_reinit,GL_REINIT) #define Iclrwk F77_NAME(iclrwk,ICLRWK) extern SUBROUTINE Iclrwk; #define Iginit F77_NAME(iginit,IGINIT) extern SUBROUTINE Iginit; #define Igmenu F77_NAME(igmenu,IGMENU) extern SUBROUTINE Igmenu; #define Igrng F77_NAME(igrng,IGRNG) extern SUBROUTINE Igrng; #define Igsse F77_NAME(igsse,IGSSE) extern SUBROUTINE Igsse; #define Igsrap F77_NAME(igsrap,IGSRAP) extern SUBROUTINE Igsrap; #define Igwkty F77_NAME(igwkty,IGWKTY) extern SUBROUTINE Igwkty; #define Kcexec F77_NAME(kcexec,KCEXEC) #define Kdialo F77_NAME(kdialo,KDIALO) extern SUBROUTINE Kdialo; #define Kgetar F77_NAME(kgetar,KGETAR) #define Kialid F77_NAME(kialid,KIALID) #define Kiargc F77_NAME(kiargc,KIARGC) extern INT_FUNCTION Kiargc; #define Kibres F77_NAME(kibres,KIBRES) extern SUBROUTINE Kibres; #define Kiclos F77_NAME(kiclos,KICLOS) extern SUBROUTINE Kiclos; #define Kicomv F77_NAME(kicomv,KICOMV) #define Kidtab F77_NAME(kidtab,KIDTAB) #define Kierrf F77_NAME(kierrf,KIERRF) extern SUBROUTINE Kierrf; #define Kiinit F77_NAME(kiinit,KIINIT) extern SUBROUTINE Kiinit; #define Kilun F77_NAME(kilun,KILUN) extern SUBROUTINE Kilun; #define Kimath F77_NAME(kimath,KIMATH) #define Kimdef F77_NAME(kimdef,KIMDEF) #define Kimexe F77_NAME(kimexe,KIMEXE) #define Kipawc F77_NAME(kipawc,KIPAWC) #define Kipiaf F77_NAME(kipiaf,KIPIAF) #define Kiprmt F77_NAME(kiprmt,KIPRMT) #define Kirtim F77_NAME(kirtim,KIRTIM) #define Kisigm F77_NAME(kisigm,KISIGM) #define Kivect F77_NAME(kivect,KIVECT) #define Kmpst2 F77_NAME(kmpst2,KMPST2) #define Kmpst3 F77_NAME(kmpst3,KMPST3) #define Kmpx22 F77_NAME(kmpx22,KMPX22) #define Kmpx23 F77_NAME(kmpx23,KMPX23) #define Kmvsed F77_NAME(kmvsed,KMVSED) extern SUBROUTINE Kmvsed; #define Kmvspg F77_NAME(kmvspg,KMVSPG) extern SUBROUTINE Kmvspg; #define Kmvssh F77_NAME(kmvssh,KMVSSH) extern SUBROUTINE Kmvssh; #define Ksvpar F77_NAME(ksvpar,KSVPAR) #define Kuach F77_NAME(kuach,KUACH) #define Kuact F77_NAME(kuact,KUACT) #define Kualfa F77_NAME(kualfa,KUALFA) #define Kuappl F77_NAME(kuappl,KUAPPL) #define Kuargs F77_NAME(kuargs,KUARGS) #define Kubrek F77_NAME(kubrek,KUBREK) #define Kubrof F77_NAME(kubrof,KUBROF) #define Kubron F77_NAME(kubron,KUBRON) #define Kucmd F77_NAME(kucmd,KUCMD) #define Kucmdl F77_NAME(kucmdl,KUCMDL) #define Kucomv F77_NAME(kucomv,KUCOMV) #define Kuedit F77_NAME(kuedit,KUEDIT) #define Kuesvr F77_NAME(kuesvr,KUESVR) #define Kueusr F77_NAME(kueusr,KUEUSR) #define Kuexec F77_NAME(kuexec,KUEXEC) #define Kuexel F77_NAME(kuexel,KUEXEL) #define Kuexit F77_NAME(kuexit,KUEXIT) #define Kufcas F77_NAME(kufcas,KUFCAS) #define Kufdef F77_NAME(kufdef,KUFDEF) #define Kugetc F77_NAME(kugetc,KUGETC) #define Kugete F77_NAME(kugete,KUGETE) #define Kugetf F77_NAME(kugetf,KUGETF) #define Kugeti F77_NAME(kugeti,KUGETI) #define Kugetl F77_NAME(kugetl,KUGETL) #define Kugetq F77_NAME(kugetq,KUGETQ) #define Kugetr F77_NAME(kugetr,KUGETR) #define Kugets F77_NAME(kugets,KUGETS) #define Kugrfl F77_NAME(kugrfl,KUGRFL) #define Kuguid F77_NAME(kuguid,KUGUID) #define Kuhelp F77_NAME(kuhelp,KUHELP) #define Kuhome F77_NAME(kuhome,KUHOME) #define Kuidf1 F77_NAME(kuidf1,KUIDF1) extern SUBROUTINE Kuidf1; #define Kuidf2 F77_NAME(kuidf2,KUIDF2) extern SUBROUTINE Kuidf2; #define Kuidfm F77_NAME(kuidfm,KUIDFM) #define Kuinim F77_NAME(kuinim,KUINIM) #define Kuinit F77_NAME(kuinit,KUINIT) #define Kuinqf F77_NAME(kuinqf,KUINQF) extern SUBROUTINE Kuinqf; #define Kulun F77_NAME(kulun,KULUN) #define Kumloc F77_NAME(kumloc,KUMLOC) #define Kumout F77_NAME(kumout,KUMOUT) #define Kumpad F77_NAME(kumpad,KUMPAD) #define Kumpst F77_NAME(kumpst,KUMPST) #define Kumpx2 F77_NAME(kumpx2,KUMPX2) #define Kundpv F77_NAME(kundpv,KUNDPV) #define Kunpar F77_NAME(kunpar,KUNPAR) #define Kunwg F77_NAME(kunwg,KUNWG) #define Kuopen F77_NAME(kuopen,KUOPEN) extern SUBROUTINE Kuopen; #define Kupad F77_NAME(kupad,KUPAD) #define Kupar F77_NAME(kupar,KUPAR) #define Kupath F77_NAME(kupath,KUPATH) #define Kupatl F77_NAME(kupatl,KUPATL) #define Kuproc F77_NAME(kuproc,KUPROC) #define Kuprof F77_NAME(kuprof,KUPROF) #define Kuproi F77_NAME(kuproi,KUPROI) #define Kuprop F77_NAME(kuprop,KUPROP) #define Kupror F77_NAME(kupror,KUPROR) #define Kupros F77_NAME(kupros,KUPROS) #define Kumess F77_NAME(kumess,KUMESS) #define Kupval F77_NAME(kupval,KUPVAL) #define Kuqcas F77_NAME(kuqcas,KUQCAS) #define Kuqenv F77_NAME(kuqenv,KUQENV) #define Kuqexe F77_NAME(kuqexe,KUQEXE) #define Kuqsvr F77_NAME(kuqsvr,KUQSVR) #define Kuquit F77_NAME(kuquit,KUQUIT) #define Kuread F77_NAME(kuread,KUREAD) extern SUBROUTINE Kuread; #define Kusapp F77_NAME(kusapp,KUSAPP) #define Kuser F77_NAME(kuser,KUSER) #define Kuserid F77_NAME(kuserid,KUSERID) #define Kusibr F77_NAME(kusibr,KUSIBR) #define Kusigm F77_NAME(kusigm,KUSIGM) #define Kuspy F77_NAME(kuspy,KUSPY) #define Kustat F77_NAME(kustat,KUSTAT) #define Kustop F77_NAME(kustop,KUSTOP) #define Kuterm F77_NAME(kuterm,KUTERM) #define Kutime F77_NAME(kutime,KUTIME) #define Kutim0 F77_NAME(kutim0,KUTIM0) extern SUBROUTINE Kutim0; #define Kutrue F77_NAME(kutrue,KUTRUE) #define Kuvcre F77_NAME(kuvcre,KUVCRE) extern SUBROUTINE Kuvcre; #define Kuvdel F77_NAME(kuvdel,KUVDEL) extern SUBROUTINE Kuvdel; #define Kuvect F77_NAME(kuvect,KUVECT) extern SUBROUTINE Kuvect; #define Kuvnam F77_NAME(kuvnam,KUVNAM) #define Kuwhag F77_NAME(kuwhag,KUWHAG) #define Kuwham F77_NAME(kuwham,KUWHAM) #define Kuwhat F77_NAME(kuwhat,KUWHAT) #define Kuwrit F77_NAME(kuwrit,KUWRIT) extern SUBROUTINE Kuwrit; #define Kxali1 F77_NAME(kxali1,KXALI1) #define Kxcrv2 F77_NAME(kxcrv2,KXCRV2) extern SUBROUTINE Kxcrv2; #define Macdef F77_NAME(macdef,MACDEF) extern SUBROUTINE Macdef; #define Mdmenu F77_NAME(mdmenu,MDMENU) #define Mhi_close F77_NAME(mhi_close,MHI_CLOSE) extern SUBROUTINE Mhi_close; #define Mhi_open F77_NAME(mhi_open,MHI_OPEN) extern SUBROUTINE Mhi_open; #define Mzwipe F77_NAME(mzwipe,MZWIPE) extern SUBROUTINE Mzwipe; #define Traceq F77_NAME(traceq,TRACEQ) extern SUBROUTINE Traceq; #define Xuflow F77_NAME(xuflow,XUFLOW) extern SUBROUTINE Xuflow; #ifdef IBM370 # pragma linkage(ERRRUN,FORTRAN) # pragma linkage(FMEMCPY,FORTRAN) # pragma linkage(GOPARM,FORTRAN) # pragma linkage(ICLRWK,FORTRAN) # pragma linkage(IGINIT,FORTRAN) # pragma linkage(IGMENU,FORTRAN) # pragma linkage(IGRNG,FORTRAN) # pragma linkage(IGSSE,FORTRAN) # pragma linkage(IGSRAP,FORTRAN) # pragma linkage(IGWKTY,FORTRAN) # pragma linkage(KCEXEC,FORTRAN) # pragma linkage(KDIALO,FORTRAN) # pragma linkage(KGETAR,FORTRAN) # pragma linkage(KIALID,FORTRAN) # pragma linkage(KIBRES,FORTRAN) # pragma linkage(KICLOS,FORTRAN) # pragma linkage(KICOMV,FORTRAN) # pragma linkage(KIDTAB,FORTRAN) # pragma linkage(KIERRF,FORTRAN) # pragma linkage(KIINIT,FORTRAN) # pragma linkage(KILUN,FORTRAN) # pragma linkage(KIMATH,FORTRAN) # pragma linkage(KIMDEF,FORTRAN) # pragma linkage(KIMEXE,FORTRAN) # pragma linkage(KIPAWC,FORTRAN) # pragma linkage(KIPIAF,FORTRAN) # pragma linkage(KIPRMT,FORTRAN) # pragma linkage(KIRTIM,FORTRAN) # pragma linkage(KISIGM,FORTRAN) # pragma linkage(KIVECT,FORTRAN) # pragma linkage(KMPST2,FORTRAN) # pragma linkage(KMPST3,FORTRAN) # pragma linkage(KMPX22,FORTRAN) # pragma linkage(KMPX23,FORTRAN) # pragma linkage(KMVSED,FORTRAN) # pragma linkage(KMVSPG,FORTRAN) # pragma linkage(KMVSSH,FORTRAN) # pragma linkage(KSVPAR,FORTRAN) # pragma linkage(KUACH,FORTRAN) # pragma linkage(KUACT,FORTRAN) # pragma linkage(KUALFA,FORTRAN) # pragma linkage(KUAPPL,FORTRAN) # pragma linkage(KUARGS,FORTRAN) # pragma linkage(KUBREK,FORTRAN) # pragma linkage(KUBROF,FORTRAN) # pragma linkage(KUBRON,FORTRAN) # pragma linkage(KUCMD,FORTRAN) # pragma linkage(KUCMDL,FORTRAN) # pragma linkage(KUCOMV,FORTRAN) # pragma linkage(KUEDIT,FORTRAN) # pragma linkage(KUESVR,FORTRAN) # pragma linkage(KUEUSR,FORTRAN) # pragma linkage(KUEXEC,FORTRAN) # pragma linkage(KUEXEL,FORTRAN) # pragma linkage(KUEXIT,FORTRAN) # pragma linkage(KUFCAS,FORTRAN) # pragma linkage(KUFDEF,FORTRAN) # pragma linkage(KUGETC,FORTRAN) # pragma linkage(KUGETE,FORTRAN) # pragma linkage(KUGETF,FORTRAN) # pragma linkage(KUGETI,FORTRAN) # pragma linkage(KUGETL,FORTRAN) # pragma linkage(KUGETQ,FORTRAN) # pragma linkage(KUGETR,FORTRAN) # pragma linkage(KUGETS,FORTRAN) # pragma linkage(KUGRFL,FORTRAN) # pragma linkage(KUGUID,FORTRAN) # pragma linkage(KUHELP,FORTRAN) # pragma linkage(KUHOME,FORTRAN) # pragma linkage(KUIDF1,FORTRAN) # pragma linkage(KUIDF2,FORTRAN) # pragma linkage(KUIDFM,FORTRAN) # pragma linkage(KUINIM,FORTRAN) # pragma linkage(KUINIT,FORTRAN) # pragma linkage(KUINQF,FORTRAN) # pragma linkage(KULUN,FORTRAN) # pragma linkage(KUMLOC,FORTRAN) # pragma linkage(KUMOUT,FORTRAN) # pragma linkage(KUMPAD,FORTRAN) # pragma linkage(KUMPST,FORTRAN) # pragma linkage(KUMPX2,FORTRAN) # pragma linkage(KUNDPV,FORTRAN) # pragma linkage(KUNPAR,FORTRAN) # pragma linkage(KUNWG,FORTRAN) # pragma linkage(KUOPEN,FORTRAN) # pragma linkage(KUPAD,FORTRAN) # pragma linkage(KUPAR,FORTRAN) # pragma linkage(KUPATH,FORTRAN) # pragma linkage(KUPATL,FORTRAN) # pragma linkage(KUPROC,FORTRAN) # pragma linkage(KUPROF,FORTRAN) # pragma linkage(KUPROI,FORTRAN) # pragma linkage(KUPROP,FORTRAN) # pragma linkage(KUPROR,FORTRAN) # pragma linkage(KUPROS,FORTRAN) # pragma linkage(KUPVAL,FORTRAN) # pragma linkage(KUQCAS,FORTRAN) # pragma linkage(KUQENV,FORTRAN) # pragma linkage(KUQEXE,FORTRAN) # pragma linkage(KUQSVR,FORTRAN) # pragma linkage(KUQUIT,FORTRAN) # pragma linkage(KUREAD,FORTRAN) # pragma linkage(KUSAPP,FORTRAN) # pragma linkage(KUSIBR,FORTRAN) # pragma linkage(KUSIGM,FORTRAN) # pragma linkage(KUSPY,FORTRAN) # pragma linkage(KUSTAT,FORTRAN) # pragma linkage(KUSTOP,FORTRAN) # pragma linkage(KUTERM,FORTRAN) # pragma linkage(KUTIME,FORTRAN) # pragma linkage(KUTIM0,FORTRAN) # pragma linkage(KUTRUE,FORTRAN) # pragma linkage(KUSER,FORTRAN) # pragma linkage(KUVCRE,FORTRAN) # pragma linkage(KUVDEL,FORTRAN) # pragma linkage(KUVECT,FORTRAN) # pragma linkage(KUVNAM,FORTRAN) # pragma linkage(KUWHAG,FORTRAN) # pragma linkage(KUWHAM,FORTRAN) # pragma linkage(KUWHAT,FORTRAN) # pragma linkage(KUWRIT,FORTRAN) # pragma linkage(KXALI1,FORTRAN) # pragma linkage(KXCRV2,FORTRAN) # pragma linkage(MACDEF,FORTRAN) # pragma linkage(MDMENU,FORTRAN) # pragma linkage(MHI_CLOSE,FORTRAN) # pragma linkage(MHI_OPEN,FORTRAN) # pragma linkage(MZWIPE,FORTRAN) # pragma linkage(TRACEQ,FORTRAN) # pragma linkage(XUFLOW,FORTRAN) #endif #define MAXCMD 512 /* max length of a command line */ #define MAXEDT 32 /* max length of names in edit server */ #define MAXLEV 10 /* max levels of command name path */ #define MAXSVR 20 /* max number of edit server processes */ /* * The PAWC common is referenced through a pointer to allow the use of * dynamic common blocks on IBM systems. */ #define Pawc kc_pawc EXTERN struct COMMON_PAWC { INTEGER NWPAR; INTEGER IXPAWC; INTEGER IHBOOK; INTEGER IXHIGZ; INTEGER IXKUIP; INTEGER IFENCE[5]; INTEGER LQ[8]; INTEGER DATA[999]; } *Pawc; #define IQ(n) Pawc->DATA[n-1] #define Q(n) (((REAL*)(Pawc->DATA))[n-1]) +KEEP,KCOM_H /* kcom.h: Fortran COMMON blocks */ #define Kcalia F77_BLOCK(kcalia,KCALIA) #define MALIAS 200 EXTERN struct { INTEGER NALIAS; LOGICAL ALIFLG; INTEGER ALITYP[MALIAS]; } F77_COMMON(Kcalia); #define Kcalic F77_BLOCK(kcalic,KCALIC) EXTERN struct { char ALINAM[MALIAS][60]; char ALIVAL[MALIAS][80]; } F77_COMMON(Kcalic); #define Kcbrek F77_BLOCK(kcbrek,KCBREK) EXTERN struct { LOGICAL TRAP; /* flag if signal trapping is enabled */ LOGICAL BRKEN; /* not used, always true */ LOGICAL FIRST; /* only used for Apollo */ LOGICAL FIRSG; /* only used for Apollo */ LOGICAL CLWHAT; /* flag if KUWHAT installed break handler */ LOGICAL CLWHAG; /* flag if KUWHAG installed break handler */ LOGICAL TBFLAG; /* flag if traceback should be printed */ } F77_COMMON(Kcbrek); #define Kcefil F77_BLOCK(kcefil,KCEFIL) EXTERN struct { char EDTFIL[MAXSVR][MAXEDT]; /* file name */ char EDTCMD[MAXSVR][MAXEDT]; /* KUIP command */ } F77_COMMON(Kcefil); #define Kcesvr F77_BLOCK(kcesvr,KCESVR) EXTERN struct { INTEGER NSVFIL; /* number of edited file */ INTEGER NSVCUR; /* pointer to current file */ SUBRPTR IESADD; /* routine set by KUEUSR */ LOGICAL SERVER; /* flag if edit server is used */ } F77_COMMON(Kcesvr); #define Kcexit F77_BLOCK(kcexit,KCEXIT) EXTERN struct { SUBRPTR IEXADD; /* routine set by KUEXIT */ SUBRPTR IUSADD; /* routine set by KUSER */ SUBRPTR NEXADD; /* routine set by KUNEXT */ SUBRPTR IUTADD; /* routine set by KUTERM */ SUBRPTR IQUADD; /* routine set by KUQUIT */ SUBRPTR IBRADD; /* routine set by KUBREK */ LOGICAL LICALL; LOGICAL LICAL2; LOGICAL LICAL3; } F77_COMMON(Kcexit); #define Kcmac F77_BLOCK(kcmac,KCMAC) EXTERN struct { LOGICAL MACTAB; INTEGER NSTLEV; LOGICAL QUITFL; LOGICAL WAITFL; LOGICAL WAITFF; LOGICAL DEBTAB; LOGICAL SKIPFL; LOGICAL HEADFL; INTEGER IONERF; LOGICAL NOEXEC; } F77_COMMON(Kcmac); #define Kcparc F77_BLOCK(kcparc,KCPARC) EXTERN struct { char PARLST[512]; /* interface block for KUSER */ char CLIST[80]; char NOALIN[512]; char COMAND[80]; char CHLAST[512]; char NONPOS[512]; } F77_COMMON(Kcparc); #define Kcsigm F77_BLOCK(kcsigm,KCSIGM) EXTERN struct { SUBRPTR ISIADD; /* routine set by KUSIGM */ INTEGER NVSIGM; /* number of temp vectors create for $SIGMA */ } F77_COMMON(Kcsigm); #define Kcutil F77_BLOCK(kcutil,KCUTIL) EXTERN struct { INTEGER NCMD; INTEGER IWD; INTEGER LUNFIL; INTEGER LPRMPT; LOGICAL TIMING; LOGICAL TRACE; INTEGER CALMOD; INTEGER NVADD; INTEGER IREPET; INTEGER IREFAC; INTEGER IBRAK; LOGICAL TIMALL; INTEGER LENTER; LOGICAL UNIQUE; INTEGER LENMUL; LOGICAL MULTFL; LOGICAL HISTOK; LOGICAL NOHIST; INTEGER LENMUM; LOGICAL FILCAS; LOGICAL MEXEFL; } F77_COMMON(Kcutil); #define Kcvect F77_BLOCK(kcvect,KCVECT) EXTERN struct { INTEGER NUMVEC; /* number of vectors stored */ INTEGER TOTPAV; INTEGER GETPAV; LOGICAL TVECFL; } F77_COMMON(Kcvect); #define Kcwork F77_BLOCK(kcwork,KCWORK) EXTERN struct { REAL VECTOR[100]; /* vector '?' */ } F77_COMMON(Kcwork); #define Quest F77_BLOCK(quest,QUEST) EXTERN struct { INTEGER DATA[100]; } F77_COMMON(Quest); #define IQUEST(n) Quest.DATA[n-1] #define Sikuip F77_BLOCK(sikuip,SIKUIP) EXTERN struct { char CHSIGM[80]; /* command string passed to SIGMA */ } F77_COMMON(Sikuip); +KEEP,KSIG_H /* ksig.h: signal and break handling */ /* * Available signal handling package * * #define SIGNAL_POSIX ==> sigaction() for Unix * #define SIGNAL_BSD ==> sigvec() for VMS and NeXT * #define SIGNAL_V7 ==> signal() */ #if !defined(SIGNAL_BSD) && !defined(SIGNAL_V7) # define SIGNAL_POSIX #else # define sigjmp_buf jmp_buf # define sigsetjmp(buf,save) setjmp(buf) # define siglongjmp(buf,val) longjmp(buf,val) # ifdef vms # define sv_flags sv_onstack # endif #endif EXTERN struct { int trap_enabled; /* flag if exceptions should be trapped */ int intr_enabled; /* flag if ^C delivery is allowed */ int intr_pending; /* flag if ^C happened while disabled */ int intr_count; /* count number of consecutive ^C interrupts */ int traceback; /* print traceback on signal */ char *error_msg; /* messages is handler cannot do print */ int soft_intr; /* flag to stop at a convenient point */ int jump_set; /* flag if stack has been setup */ sigjmp_buf stack; int sockfd; /* socket descriptor and routine to */ void (*piaf_sync)(); /* resynchronize Piaf communication */ } kc_break; +KEEP,KBROW_H /* kbrow.h: browser definitions */ #define KBROW_H1 \ +SEQ,KBROW_H1 KBROW_H1 #define KBROW_H2 \ +SEQ,KBROW_H2 KBROW_H2 #define KBROW_H3 \ +SEQ,KBROW_H3 KBROW_H3 #define KBROW_H4 \ +SEQ,KBROW_H4 KBROW_H4 typedef struct _KmObject { struct _KmObject *next; /* link to next object definition */ char *name; /* unique identifier name */ char *stext; /* short description text */ char *ltext; /* long description text */ KmClass *class; /* pointer to objects's class structure */ } KmObject; typedef struct _BrVariable { struct _BrVariable *next; /* link to next variable definition */ char *name; /* variable name */ char *value; /* replacement value */ } BrVariable; typedef struct _BrObject { struct _BrObject *next; /* link to next browsable object */ char *name; /* name of the browsable object */ BrClass *class; /* pointer to browsable's class structure */ BrVariable *vars; /* linked list of variable substitutions */ } BrObject; typedef struct _BrClientdata { BrActTag tag; char *brobj; char *brcls; char *path; char *kmobj; char *kmcls; char *stext; char *ltext; char *mtext; } BrClientdata; EXTERN BrClass *brclasses; EXTERN KmObject *kmobjects; EXTERN KmButton *kmbuttons; extern C_PROTO_2(void klnkbrcl, BrClass*, int); extern C_PROTO_2(void klnkkmcl, KmClass*, int); extern C_PROTO_2(void klnkicon, KmIcon*, int); extern C_PROTO_2(void klnkbutt, KmButton*, int); extern C_PROTO_6(void exec_action, BrAction*, char*, char*, int, KmWidget, KmCalldata); extern C_PROTO_2(KmWidget find_button, char*, char*); extern C_PROTO_1(KmIcon* find_kmicon, char*); extern C_PROTO_1(KmClass* find_kmclass, char*); extern C_PROTO_1(BrObject* find_brobject, char*); extern C_PROTO_2(char* get_variable, char*, char*); extern C_PROTO_0(BrObject* scan_brobjects); extern C_PROTO_3(KmObject* scan_kmobjects, char*, char*, int); extern C_PROTO_7(int set_action, char*, int, int, char*, char*, int, int); extern C_PROTO_3(void set_variable, BrObject*, char*, char*); +KEEP,KLINK_H /* klink.h: demand linking of special routines */ #define KLINK_H1 EXTERN \ +SEQ,KLINK_H1 KLINK_H1 EXTERN struct { SUBROUTINE *user_exit_F; /* set by KUEXIT */ SUBROUTINE *user_quit_F; /* set by KUQUIT */ SUBROUTINE *user_break_F; /* set by KUBREK */ SUBROUTINE *user_edit_F; /* set by KUEUSR */ SUBROUTINE *user_comis_F; /* set by KUCOMV */ SUBROUTINE *user_sigma_F; /* set by KUSIGM */ SUBROUTINE *user_grfl_F; /* set by KUGRFL */ SUBROUTINE *user_term_F; /* set by KUTERM */ SUBROUTINE *user_input_F; /* set by KUSER */ SUBROUTINE *user_locate_F; /* set by KUMLOC */ /* indirect calls to avoid linking Motif */ IntFunc *disp_panel_C; /* display command panel (km_display_cmdpan) */ IntFunc *disp_kpanel_C; /* display KUIP panel (km_display_kpanel) */ IntFunc *close_kpanel_C; /* close KUIP panel (km_close_kpanel) */ IntFunc *disp_text_C; /* display text widget (km_display_sctext) */ IntFunc *disp_choice_C; /* display a choice of commands (?) */ IntFunc *disp_clean_C; /* clean before action (km_destroy_all_popup)*/ IntFunc *disp_flush_C; /* flush event queue (FlushEvents) */ IntFunc *disp_busy_C; /* show busy cursor (km_all_cursor) */ IntFunc *disp_exit_C; /* ask confirmation for exit */ IntFunc *disp_quit_C; /* ask confirmation for exit */ IntFunc *disp_select_C; /* select from a number of buttons */ IntFunc *disp_cmd_list_C; /* display list of commands (km_print_list) */ CharFunc *disp_prompt_C; /* prompt for input */ CharFunc *disp_passwd_C; /* prompt for password input */ /* indirect calls to avoid linking HIGZ without style G */ IntFunc *higz_init_C; /* initialize menu mode */ SUBROUTINE *higz_menu_F; /* IGMENU */ } kjmpaddr; +KEEP,KFLAG_H typedef enum { KmMACRO_COMMAND = 0, /* don't look for macros */ KmMACRO_AUTO, /* look for macros before commands */ KmMACRO_AUTOREVERSE /* look for macros after commands */ } KmMacOrder; typedef enum { KmSTYLE_A = 0x0001, /* Alpha menus */ KmSTYLE_C = 0x0002, /* Command line */ KmSTYLE_G = 0x0004, /* Graphics menus */ KmSTYLE_M = 0x0008, /* Model Human Interface */ KmSTYLE_U = 0x0010, /* User */ KmSTYLE_XM = 0x0020, /* Motif/X11 */ KmSTYLE_major = 0x00FF, /* A..X are mutually exclusive */ KmSTYLE_xL = 0x0100, /* Alpha Letter menus */ KmSTYLE_xP = 0x0200, /* Panel style GP or MP */ KmSTYLE_xS = 0x0400, /* Graphics with Software fonts */ KmSTYLE_xW = 0x0800 /* Graphics with shadowed Width */ } KmStyleFlag; typedef enum { KmTIMING_OFF, /* no timing */ KmTIMING_ON, /* time typed commands */ KmTIMING_ALL /* time individual commands inside macro */ } KmTiming; EXTERN struct { LOGICAL f77_true; /* value of .TRUE. */ LOGICAL f77_false; /* value of .FALSE. */ int do_exit; /* set by KXEXIT */ int do_quit; /* set by KXQUIT */ char *curr_prompt; /* current prompt string */ char *last_cmd; /* last command for $LAST */ KmTiming timing; /* timing on/off/all */ time_t real_time; /* real time at last timing off */ clock_t user_time; /* CPU time at last timing off */ int in_macro; /* command executed in macro */ int in_application; /* application mode is active */ int appl_called; /* application is executing */ char *appl_exit; /* string which leaves application mode */ KmCommand *appl_cmd; /* command which handles application */ char appl_file[256]; /* temporary file to pass application text */ FILE *appl_stream; /* C stream used for writing appl_file */ int appl_luno; /* Fortran logical unit opened for appl_file */ char help_file[256]; /* temporary file to view help text */ char uhlp_file[256]; /* temporary file to get user help text */ int uhlp_luno; /* Fortran logical unit opened for user help */ int in_motif; /* Motif mode is active */ int action_nesting; /* levels of nested ku_exec() calls */ int echo_command; /* echo commands in Motif mode */ char *echo_prompt; /* prompt string for echo commands */ KmStyleFlag style; /* input mode */ int keep_fcase; /* flag if no case conversion for filenames */ int use_kxterm; /* flag if kxterm should be used */ int use_server; /* flag if edit server should be used */ int editor_exit; /* flag set if edit server sent SIGUSR1 */ char *editor_cbuf; /* buffer of for edit servers commands */ char *macro_path; /* MACRO/DEFAULT search path */ KmMacOrder macro_search; /* MACRO/DEFAULT search order */ int temp_vectors; /* number of ?SIGMA vectors */ char init_wdir[256]; /* initial working directory */ int vread_luno; /* Fortran logical unit for VECTOR/READ */ int vwrite_luno; /* Fortran logical unit for VECTOR/WRITE */ } kc_flags; EXTERN struct { char *set_break; /* SET_SHOW/BREAK */ char set_columns[8]; /* SET_SHOW/COLUMNS */ char *set_command; /* SET_SHOW/COMMAND */ char *set_filecase; /* SET_SHOW/FILECASE */ char *set_host_editor; /* SET_SHOW/HOST_EDITOR */ char *set_host_psviewer; /* SET_SHOW/HOST_PSVIEWER */ char *set_host_pager; /* SET_SHOW/HOST_PAGER */ char *set_host_shell; /* SET_SHOW/HOST_SHELL */ char *set_prompt; /* SET_SHOW/PROMPT */ char *set_recall_style; /* SET_SHOW/RECALL_STYLE */ char set_recording[8]; /* SET_SHOW/RECORDING */ char *set_root; /* SET_SHOW/ROOT */ char *set_style; /* SET_SHOW/STYLE */ char *set_timing; /* SET_SHOW/TIMING */ char *help_edit; /* HELP edit mode */ char *defaults_path; /* MACRO/DEFAULTS search path */ char *defaults_order; /* MACRO/DEFAULTS search order */ int idle_time; /* IDLE timer in seconds */ char *idle_cmd; /* IDLE command */ char **set_print_cmds; /* SET_SHOW/HOST_PRINTER commands */ char **set_print_exts; /* ... depending on file extension */ } kc_value; typedef struct { int top; int left; int width; int height; } KmWindowDsc; EXTERN struct { KmWindowDsc edit_pad; /* coordinates for edit window */ KmWindowDsc help_pad; /* coordinates for readonly window */ int voffset; /* vertical offset */ int hoffset; /* horizontal offset */ int shift_max; /* maximum number of shifted pads */ int shift_now; /* current shift count */ int shift_dir; /* shift direction +/-1 */ int is_a_pad; /* flag if running in an Apollo DM pad */ int is_a_tty; /* flag if stdin and stdout at terminal */ int use_getline; /* flag for using getline() or normal read */ int use_no_echo; /* flag for using no echo in password prompt */ int term_width; /* terminal width in columns */ int kuwhag_called; /* allow style G */ float sgylen; float sgsize; float sgyspa; float sgbord; int panel_rows; /* number of rows in style GP panel */ int *panel_cols; /* number of columns in each row */ char ***panel_keys; /* key labels */ char *panel_keynum; /* value of $KEYNUM */ char *panel_keyval; /* value of $KEYVAL */ char ***panel_icons; /* key icons */ } kc_window; extern C_PROTO_1(char* style_name, KmStyleFlag); +KEEP,KMENU_H /* kmenu.h: data structures for menu and command definitions */ #define KMENU_H1 \ +SEQ,KMENU_H1 KMENU_H1 #define KMENU_H2 \ +SEQ,KMENU_H2 KMENU_H2 #define KMENU_H3 \ +SEQ,KMENU_H3 KMENU_H3 #define KMENU_H4 \ +SEQ,KMENU_H4 KMENU_H4 #define KMENU_H5 \ +SEQ,KMENU_H5 KMENU_H5 /* * temporary fix until we can reserve an extra word in KmCommand structure * to count keyboard and macro commands separately */ #define XCOUNT_SHIFT 10 #define XCOUNT_OFFSET (1 << XCOUNT_SHIFT) #define XCOUNT_MASK (XCOUNT_OFFSET - 1) extern C_PROTO_2(void check_version, int, int); extern C_PROTO_0(void check_edit_server); extern C_PROTO_3(int exec_cmd_string, char*, int, int(*)()); extern C_PROTO_1(int exec_decoded_cmd, KmCommand*); extern C_PROTO_1(KmMenu* find_submenu, char*); extern C_PROTO_2(char* fmt_cmd_help, KmCommand*, int); extern C_PROTO_0(void menu_style); extern C_PROTO_2(void print_cmd_list, KmCommand**, char*); extern C_PROTO_1(void reset_arg_list, KmCommand*); extern C_PROTO_1(KmMenu** root_menu_list, char*); extern C_PROTO_2(KmCommand* search_command, char*, KmCommand***); +KEEP,KHASH_H /* khash.h: hash table management */ typedef struct _HashArray { char *name; /* symbol name */ void *value; /* symbol value */ } HashArray; typedef struct _HashEntry { struct _HashEntry *next; /* link to next entry */ char *name; /* symbol name */ void *value; /* symbol value */ } HashEntry; typedef struct { int size; /* table size should be a prime number */ HashEntry **entries; /* pointer to array of size entries */ int nentries; /* number of entries */ int copy; /* flag if strdup/free(value) should be used */ } HashTable; #define ALIAS_TABLE_SIZE 97 /* should be a prime */ EXTERN struct { int translate; /* flag if translation wanted */ int substitutions; /* how many more before recursive alarm */ HashTable *arg_table; /* Argument alias table */ HashTable *cmd_table; /* Command alias table */ HashTable *var_table; /* macro variables */ } kc_alias; #define PAWID_TABLE_SIZE 97 static HashTable *kmpawid; /* list of panels with their name */ extern C_PROTO_2(HashTable* hash_create, int, int); extern C_PROTO_1(void hash_clear, HashTable*); extern C_PROTO_1(void hash_destroy, HashTable*); extern C_PROTO_3(void hash_insert, HashTable*, const char*, void*); extern C_PROTO_2(void hash_remove, HashTable*, const char*); extern C_PROTO_2(void* hash_lookup, HashTable*, const char*); extern C_PROTO_1(int hash_entries, HashTable*); extern C_PROTO_1(HashArray* hash_array, HashTable*); extern C_PROTO_1(int match_paren, char*); extern C_PROTO_1(char* repl_variable, char*); extern C_PROTO_2(char* repl_sysfun, char*, int); extern C_PROTO_1(char* subst_arg_alias, char*); extern C_PROTO_1(char* subst_cmd_alias, char*); extern C_PROTO_1(char* subst_var_alias, char*); extern C_PROTO_2(char* subst_sysfun, char*, int); extern C_PROTO_1(char* var_value, char*); +KEEP,MKTERM. #define ESCAPE "#@" typedef void (*KxtermActionProc)( #ifndef NO_PROTOTYPES char** /* params */, int /* num_params */ #endif ); typedef struct _KxtermActionsRec{ char *string; KxtermActionProc proc; } KxtermActionsRec; typedef KxtermActionsRec *KxtermActionList; extern C_PROTO_1(void kxterm_add_actions, KxtermActionList); extern C_PROTO_1(void handle_kxterm_action, char *); extern C_PROTO_1(void send_kxterm_cmd, char**); extern C_PROTO_1(void send_single_kxterm_cmd, char*); +DECK,hkuip_94b,if=94b. +KEEP,KHAIX370 #ifndef AIX370 # define AIX370 #endif +KEEP,KHAPOFTN #ifndef APOLLO_FTN # define APOLLO_FTN #endif +KEEP,KHIBMVM #ifndef IBMVM # define IBMVM #endif +KEEP,KHIBMMVS #ifndef IBMMVS # define IBMMVS #endif +KEEP,KHNEWLIB #ifndef NEWLIB # define NEWLIB #endif +KEEP,KSYS_H /* ksys.h: system dependent defines */ /* update version if structures have changed */ #define KUIP_VERSION 921023 /* identify system if not possible from preprocessor defines */ +SEQ,KHAIX370,IF=AIX370 +SEQ,KHAPOFTN,IF=APOFTN +SEQ,KHIBMVM ,IF=IBMVM +SEQ,KHIBMMVS,IF=IBMMVS +SEQ,KHNEWLIB,IF=NEWLIB #ifdef AIX370 # define MACHINE_NAME "IBMAIX" # define UNIX # define F77_EXTERN_INDIRECT #endif #if defined(apollo) || defined(__apollo) # define MACHINE_NAME "APOLLO" # define APOLLO # define UNIX # include # include # include # include # include # include # ifdef APOLLO_FTN /* using /com/ftn instead of /bin/f77 */ # define F77_CHAR_LEN_IND # define F77_CHAR_LEN_TYPE short # define F77_EXTERN_LOWERCASE # endif # define F77_EXTERN_INDIRECT # define F77_COMMON(name) name __attribute((__section(name))) # ifndef EXTERN # define EXTERN /* essential for accessing COMMON blocks */ # endif # define FATAL_SIGFPE # define HAVE_MEMMOVE # define HAVE_STRCASECMP # define NO_DIRENT_H # define TERMIO_BSD /* for getline we must compile under bsd4.3 */ #endif #if defined(__convexc__) # define CONVEX # define MACHINE_NAME "CONVEX" # define UNIX # define F77_BLOCK(name,NAME) _##name##_ # define F77_ARG_CONSTANT # ifndef EXTERN # define EXTERN /* essential for accessing COMMON blocks */ # endif # define FATAL_SIGFPE # define HAVE_MEMMOVE # define HAVE_STRCASECMP # define HAVE_SELECT # define HAVE_VFORK # define MATCH_RE_COMP /* use re_comp/re_exec */ # define TERMIO_MAP_NL /* need to map NL to NL-CR on output */ # define USE_EDIT_SERVER #endif #ifdef CRAY # define MACHINE_NAME "CRAY" # define UNIX # include # define F77_EXTERN_UPPERCASE # ifndef EXTERN # define EXTERN /* essential for accessing COMMON blocks */ # endif # define HAVE_STRCASECMP # define NO_EDIT_SERVER #endif #if defined(__hpux) # define MACHINE_NAME "HPUX" # define HPUX # define UNIX # ifndef _HPUX_SOURCE # define _HPUX_SOURCE # endif # define FATAL_SIGFPE /* needs f77 +T and ON REAL UNDERFLOW IGNORE */ # define HAVE_MEMMOVE # define HAVE_STRCASECMP # define HAVE_STRRSTR # define HAVE_SELECT # define SELECT_CAST(fds) (int*)fds #endif #ifdef _IBMR2 # define IBMRT # define MACHINE_NAME "IBMRT" # define UNIX # define HAVE_MEMMOVE # define HAVE_STRCASECMP # include # define HAVE_SELECT # define BROKEN_F77_IO #endif #ifdef IBMVM # define ARG_STYLE_CMS # define MACHINE_NAME "IBM" # define OS_NAME "VM" # ifndef IBM370 # define IBM370 # endif # define KmTimeStamp TimeStamp typedef char TimeStamp[24]; extern int get_stamp(char*,TimeStamp*); # define same_stamp(stamp1,stamp2) (strcmp(*(stamp1),*(stamp2)) == 0) #endif #ifdef IBMMVS # define MACHINE_NAME "IBMMVS" # define OS_NAME "MVS" # ifndef IBM370 # define IBM370 # endif #endif #ifdef IBM370 # define F77_ARG_CONSTANT # define F77_CHAR_LEN_IND /* each parameter has a length argument ! */ # define F77_XXXX_ARG_LEN(x) F77_CHAR_ARG_LEN(x) # define F77_EXTERN_INDIRECT # define F77_EXTERN_UPPERCASE # define NO_FCNTL_H # define NO_UNISTD_H # define SIGNAL_V7 # define ALLOC_MIN_BYTES 128 # define STUPID_MALLOC #endif #ifdef linux # define LINUX # define MACHINE_NAME "LINUX" # define UNIX # define HAVE_MEMMOVE # define HAVE_STRCASECMP # define HAVE_SELECT #endif #ifdef MSDOS # define MACHINE_NAME "IBMPC" # define OS_NAME "MSDOS" # define UNIX # define NO_EDIT_SERVER # define NO_SOCKET_H # define NO_SYS_TIME_H # define SIGNAL_V7 # define SLASHES "\\/" # define TERMIO_MAP_NL /* need to map NL to NL-CR on output */ #endif #ifdef WIN32 # define WINNT # ifdef _ALPHA_ # define MACHINE_NAME "ALPHA" # else # define MACHINE_NAME "IBMPC" # endif # define OS_NAME "WINNT" # define UNIX # define MSDOS # include # include # include # include # define text_mode__() # define NO_EDIT_SERVER # define NO_SOCKET_H # define NO_SYS_TIME_H # define NO_UNISTD_H # define SIGNAL_V7 # define SLASHES "\\" #endif #ifdef NeXT # define MACHINE_NAME "NEXT" # define UNIX # define getcwd(path,maxlen) getwd(path) # define F77_BLOCK(lc,uc) lc # define F77_EXTERN_INDIRECT /* each parameter has a length argument ! */ # define F77_XXXX_ARG_LEN(x) F77_CHAR_ARG_LEN(x) # define F77_XXXX_USE_LEN(x) ,286716 /* don't know if value matters */ # define HAVE_MEMMOVE # define HAVE_VFORK # define MATCH_RE_COMP /* use re_comp/re_exec */ # define NO_DIRENT_H # define NO_UNISTD_H # define SIGNAL_BSD # define TERMIO_BSD # define GETPGRP_BSD /* BSD getpgrp(pid) vs. POSIX getpgrp(void) */ #endif #ifdef __osf__ # define UNIX # ifdef __alpha # define ALPHA # define MACHINE_NAME "ALPHA" # endif # define HAVE_MEMMOVE # define HAVE_STRCASECMP # define HAVE_SELECT # define BROKEN_F77_IO #endif #if defined(__sgi) # define MACHINE_NAME "SGI" # define SGI # define UNIX # define HAVE_MEMMOVE # define HAVE_STRCASECMP # define HAVE_SELECT #endif #if defined(sun) || defined(__sun) # define SUN # define UNIX # ifdef Solaris2 # define MACHINE_NAME "SOLARIS" # define SOLARIS # define HAVE_MEMMOVE # define HAVE_SELECT # define HAVE_STRCASECMP # define HAVE_VFORK # else # define MACHINE_NAME "SUN" # define HAVE_SELECT # define HAVE_STRCASECMP # define HAVE_VFORK # include # define MATCH_RE_COMP /* use re_comp/re_exec */ # define GETPGRP_BSD /* BSD getpgrp(pid) vs. POSIX getpgrp(void) */ # endif #endif #if defined(__ultrix) # define MACHINE_NAME "DECS" # define ULTRIX # define UNIX # define HAVE_MEMMOVE # define HAVE_STRCASECMP # define HAVE_VFORK # define NEED_STRDUP # define TERMIO_BSD # define GETPGRP_BSD /* BSD getpgrp(pid) vs. POSIX getpgrp(void) */ # define BROKEN_F77_IO #endif #ifdef vms # define OS_NAME "VMS" # ifdef __ALPHA # define ALPHA # define MACHINE_NAME "ALPHA" # else # define MACHINE_NAME "VAX" # define ConCat(con,cat) con/**/cat # endif # include # include # include /* lib$... prototypes */ # include # include # include # include # include # include # include # include # include /* sys$... prototypes */ # include # include # include # include # include # ifndef R_OK /* no access() modes in unixio.h on VAX/VMS */ # define F_OK 0 # define X_OK 1 # define W_OK 2 # define R_OK 4 # endif # define ARG_STYLE_VMS # define F77_EXTERN_LOWERCASE # define HAVE_MEMMOVE # define HAVE_STAT_H # define HAVE_VFORK /* actually have only vfork */ # define NO_FCNTL_H # define NO_UNISTD_H # define SIGNAL_BSD # define sigmask(sig) (1L << (sig-1)) /* should be in signal.h */ # define USE_EDIT_SERVER /* only for TPU/DISPLAY=MOTIF */ # if defined(VAXC) && !defined(__DECC) # define STUPID_MALLOC # endif # define fix_descriptor(dsc,str,n) \ do { \ dsc.dsc$b_dtype = DSC$K_DTYPE_T; \ dsc.dsc$b_class = DSC$K_CLASS_S; \ dsc.dsc$a_pointer = str; \ dsc.dsc$w_length = n; \ } while( 0 ) # define var_descriptor(dsc,str) \ do { \ dsc.dsc$b_dtype = DSC$K_DTYPE_T; \ dsc.dsc$b_class = DSC$K_CLASS_S; \ dsc.dsc$a_pointer = str; \ dsc.dsc$w_length = strlen( dsc.dsc$a_pointer ); \ } while( 0 ) #endif /* vms */ #include #include #include #ifndef NO_FCNTL_H #include #endif #include /* contains strtod() and strtol() on some systems */ #include #include #include #ifdef DBMALLOC #include "dbmalloc.h" /* debug malloc */ extern char* getenv(const char*); extern double strtod(const char*, char**); #else #include #endif #include #ifndef NO_UNISTD_H #include #endif #ifndef HAVE_VFORK # define vfork fork #endif #ifdef UNIX /* also defined for MSDOS and Windows/NT*/ # ifndef OS_NAME # define OS_NAME "UNIX" # endif # include # include # ifndef NO_SYS_TIME_H # include /* struct timeval */ # endif # ifndef MSDOS # include # ifdef TERMIO_BSD # define TERMIO_MAP_NL /* need to map NL to NL-CR on output */ # define HAVE_SELECT # endif # if !defined(TERMIO_BSD) && !defined(TERMIO_SYSV) # define TERMIO_POSIX # endif # if defined(HAVE_SELECT) && !defined(SELECT_CAST) # define SELECT_CAST(fds) fds # endif # include # ifndef NO_DIRENT_H /* POSIX opendir() */ # include # else /* BSD opendir() */ # include /* plus */ # define dirent direct /* struct dirent... */ # ifndef S_IRUSR # define S_IRUSR (S_IREAD) /* read permission, owner */ # define S_IWUSR (S_IWRITE) /* write permission, owner */ # define S_IXUSR (S_IEXEC) /* execute/search permission, owner */ # endif # endif # endif # define HAVE_STAT_H # ifndef NO_EDIT_SERVER # define USE_EDIT_SERVER # ifndef F_LOCK /* BSD file locking */ # include # define lockf(fd,op,offs) flock(fd,op) # define F_LOCK LOCK_EX # define F_ULOCK LOCK_UN # endif # endif # ifndef SLASHES # define SLASHES "/" # endif #endif #ifdef SUN # ifndef CLOCKS_PER_SEC # define CLOCKS_PER_SEC 1000000 /* missing in time.h */ # define difftime(t1,t0) ((double)(t1-t0)) # define raise(sig) kill(getpid(),sig) # endif #endif #ifndef CLOCKS_PER_SEC # define CLOCKS_PER_SEC 100 /* missing in VAX/VMS time.h */ #endif #ifdef HAVE_STAT_H # define KmTimeStamp struct stat # define get_stamp(path,stamp) stat(path,stamp) # define same_stamp(stamp1,stamp2) ((stamp2)->st_mtime == (stamp1)->st_mtime) #endif #ifndef KmTimeStamp # define KmTimeStamp int # define get_stamp(path,stamp) (*(stamp) = checksum(path)) # define same_stamp(stamp1,stamp2) (*(stamp1) == *(stamp2)) #endif #ifdef MATCH_RE_COMP extern char *re_comp(); extern int re_exec(); #else extern char *regcmp(); extern char *regex(); #endif /* command line arguments recognized by KUARGS */ #if !defined(ARG_STYLE_CMS) && !defined(ARG_STYLE_VMS) # define ARG_STYLE_UNIX #endif #ifndef MACHINE_NAME # define MACHINE_NAME "UNKNOWN" /* value returned by $MACHINE */ #endif #ifndef OS_NAME # define OS_NAME "UNKNOWN" /* value returned by $OS */ #endif /* #define EXTERN must be in one routine to allocate space for globals */ #ifndef EXTERN # define EXTERN extern #endif /* * Preprocessor syntax for token concatenation */ #ifndef ConCat # define ConCat(con,cat) con##cat #endif /* * Prototyping for C functions */ #define C_PROTO_0(name) \ name(void) #define C_PROTO_1(name,arg1) \ name(arg1) #define C_PROTO_2(name,arg1,arg2) \ name(arg1,arg2) #define C_PROTO_3(name,arg1,arg2,arg3) \ name(arg1,arg2,arg3) #define C_PROTO_4(name,arg1,arg2,arg3,arg4) \ name(arg1,arg2,arg3,arg4) #define C_PROTO_5(name,arg1,arg2,arg3,arg4,arg5) \ name(arg1,arg2,arg3,arg4,arg5) #define C_PROTO_6(name,arg1,arg2,arg3,arg4,arg5,arg6) \ name(arg1,arg2,arg3,arg4,arg5,arg6) #define C_PROTO_7(name,arg1,arg2,arg3,arg4,arg5,arg6,arg7) \ name(arg1,arg2,arg3,arg4,arg5,arg6,arg7) #define C_PROTO_8(name,arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8) \ name(arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8) #define C_PROTO_9(name,arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8,arg9) \ name(arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8,arg9) #define C_PROTO_13(name,a1,a2,a3,a4,a5,a6,a7,a8,a9,b0,b1,b2,b3) \ name(a1,a2,a3,a4,a5,a6,a7,a8,a9,b0,b1,b2,b3) #define C_DECL_1(name,t1,p1) \ name(t1 p1) #define C_DECL_2(name,t1,p1,t2,p2) \ name(t1 p1,t2 p2) #define C_DECL_3(name,t1,p1,t2,p2,t3,p3) \ name(t1 p1,t2 p2,t3 p3) #define C_DECL_4(name,t1,p1,t2,p2,t3,p3,t4,p4) \ name(t1 p1,t2 p2,t3 p3,t4 p4) #define C_DECL_5(name,t1,p1,t2,p2,t3,p3,t4,p4,t5,p5) \ name(t1 p1,t2 p2,t3 p3,t4 p4,t5 p5) #define C_DECL_6(name,t1,p1,t2,p2,t3,p3,t4,p4,t5,p5,t6,p6) \ name(t1 p1,t2 p2,t3 p3,t4 p4,t5 p5,t6 p6) #define C_DECL_7(name,t1,p1,t2,p2,t3,p3,t4,p4,t5,p5,t6,p6,t7,p7) \ name(t1 p1,t2 p2,t3 p3,t4 p4,t5 p5,t6 p6,t7 p7) #define C_DECL_8(name,t1,p1,t2,p2,t3,p3,t4,p4,t5,p5,t6,p6,t7,p7,t8,p8) \ name(t1 p1,t2 p2,t3 p3,t4 p4,t5 p5,t6 p6,t7 p7,t8 p8) #define C_DECL_9(name,t1,p1,t2,p2,t3,p3,t4,p4,t5,p5,t6,p6,t7,p7,t8,p8,t9,p9)\ name(t1 p1,t2 p2,t3 p3,t4 p4,t5 p5,t6 p6,t7 p7,t8 p8,t9 p9) #define C_DECL_13(name,t1,p1,t2,p2,t3,p3,t4,p4,t5,p5,t6,p6,t7,p7,t8,p8,\ t9,p9,t10,p10,t11,p11,t12,p12,t13,p13) \ name(t1 p1,t2 p2,t3 p3,t4 p4,t5 p5,t6 p6,t7 p7,t8 p8,\ t9 p9,t10 p10,t11 p11,t12 p12,t13 p13) typedef int IntFunc(); typedef char* CharFunc(); typedef char** pCharFunc(); +KEEP,KSTRING_H. #include #ifdef __cplusplus extern "C" { #endif /* * quasi-standard functions missing in some C-libraries */ extern void* memmove( void* dst, const void* src, size_t n ); #if !defined(__convexc__) extern int strcasecmp( const char* str1, const char* str2 ); extern int strncasecmp( const char* str1, const char* str2, size_t n ); #endif extern char* strrstr( const char* str1, const char* str2 ); #define strdup Strdup /* prototype without const */ extern char* strdup( const char* str ); /* * convenience functions from kkern.c */ extern char* str0dup( const char* str ); extern char* str2dup( const char* str1, const char* str2 ); extern char* str3dup( const char* str1, const char* str2, const char* str3 ); extern char* str4dup( const char* str1, const char* str2, const char* str3, const char* str4 ); extern char* str5dup( const char* str1, const char* str2, const char* str3, const char* str4, const char* str5 ); extern char* strndup( const char* buf, size_t n ); extern char* stridup( int i ); extern char* mstrcat( char* ptr, const char* str ); extern char* mstr2cat( char* ptr, const char* str1, const char* str2 ); extern char* mstr3cat( char* ptr, const char* str1, const char* str2, const char* str3); extern char* mstr4cat( char* ptr, const char* str1, const char* str2, const char* str3, const char* str4 ); extern char* mstrncat( char* ptr, const char* buf, size_t n ); extern char* mstrccat( char* ptr, char c, size_t n ); extern char* mstricat( char* ptr, int i ); extern char* strrpbrk( const char* str1, const char* str2 ); extern char* strqtok( char* str ); extern char* strlower( char* str ); extern char* strupper( char* str ); extern char* strtrim( char* str ); extern char* struntab( char* str ); extern char* strfromd( double d, size_t prec ); extern char* strfromi( int i, size_t prec ); extern int shsystem( const char* shell, const char* cmd ); extern int checksum( const char* path ); extern char* fexpand( const char* fname, const char* ftype ); extern char* fsearch( const char* fname, const char* ftype, const char* path ); extern char* fsymlink( const char* path ); extern char* fstrdup( const char* buf, size_t len ); extern char* fstr0dup( const char* buf, size_t len ); extern char* fstrtrim( const char* buf, size_t len ); extern char* fstr0trim( const char* buf, size_t len ); extern size_t fstrlen( const char* buf, size_t len ); extern size_t fstrset( char* buf, size_t len, const char* str ); extern double fstrtod( const char* str, char** tail ); extern int fstrtoi( const char* str, char** tail ); extern char* fstrvec( char** pstr, size_t n, size_t* len ); extern size_t mstrlen( char** pstr, size_t n ); #ifdef __cplusplus } #endif +KEEP,KUSER_H. #define KUMAC_UNWIND -30041961 /* error status to quit macro execution */ #ifdef __cplusplus extern "C" { #endif /* * C-interface functions */ extern char* k_getar(void); extern void k_setar( size_t, char** ); extern char* k_userid(void); extern void ku_alfa(void); extern char* ku_appl( int* luno, int* inmacro ); extern int ku_bool( const char* expr ); extern int ku_close( int luno ); extern void ku_cmdl( const char* template ); extern int ku_edit( const char* path, int use_server ); extern char* ku_eval( const char* expr ); extern int ku_exec( const char* cmd ); extern int ku_exel( const char* cmd ); extern char* ku_expr( const char* expr ); extern char* ku_getc(void); extern char* ku_gete(void); extern char* ku_getf(void); extern int ku_geti(void); extern char* ku_getl(void); extern double ku_getr(void); extern char* ku_gets(void); extern char* ku_fcase( char* path ); extern char* ku_home( const char* fname, const char* ftype ); extern char* ku_inps( const char* prompt ); extern int ku_inqf( const char* path ); extern int ku_intr( int enable ); extern void ku_last( const char* cmd ); extern int ku_math( const char* expr, double* result ); extern int ku_more( const char* question, const char* line ); extern int ku_npar(void); extern int ku_open( int luno, const char* path, const char* mode ); extern void ku_pad( const char* path, int delete ); extern char* ku_path(void); extern void ku_piaf( int socket, void(*sync)() ); extern char* ku_proc( const char* prompt, const char* dfault ); extern char* ku_prof( const char* prompt, const char* dfault ); extern int ku_proi( const char* prompt, int dfault ); extern char* ku_prop( const char* prompt ); extern double ku_pror( const char* prompt, double dfault ); extern char* ku_pros( const char* prompt, const char* dfault ); extern char** ku_qenv(void); extern char* ku_qexe( const char* fname ); extern int ku_qkey(void); extern int ku_qmac( const char* mname ); extern int ku_read( int luno, char* buf, size_t len ); extern int ku_sapp( const char* path, const char* exit ); extern void ku_shut(void); extern void ku_sibr(void); extern void ku_spy( const char* option ); extern int ku_stop( int set ); extern void ku_time( time_t, clock_t ); extern void ku_trap( int enable, int traceback ); extern int ku_vqaddr( const char* vname ); extern int ku_vtype( const char* vname ); extern int ku_vvalue( const char* vname, double* value ); extern void ku_whag(void); extern void ku_what( void(*styleG)() ); extern void ku_write( int, const char* line ); extern int km_icon( const char*, const char* ); #ifdef __cplusplus } #endif +KEEP,KPROTO_H extern char* clean_word( char* ); extern char* format_prompt( const char* ); extern char* getline( const char* ); extern void gl_config( const char*, int ); extern void gl_histadd( const char* ); extern void gl_setwidth( int ); extern char* input_line( const char*, char ); extern void leave_kuip(void); extern int len_alias( const char*, int ); extern int len_sysfun( const char* ); extern int len_vector( const char* ); extern char* quote_string( char*, int ); extern void reset_break(void); extern char* split_at_semicolon( char* ); extern void k_parse_args( const char*, char**, int* ); #ifndef vms extern void signal_handler( int ); #else extern int signal_handler( const void*, const void* ); extern int control_C_ast( int ); #endif +KEEP,KUIP_H +SEQ,KSYS_H +SEQ,KSTRING_H +SEQ,KUSER_H +SEQ,KPROTO_H +KEEP,KFOR_H /* kfor.h: Fortran-C interface */ /* * Fortran data types */ typedef int INTEGER; typedef int LOGICAL; typedef float REAL; typedef double DBLPREC; typedef struct { REAL re; REAL im; } COMPLEX; typedef INTEGER INT_FUNCTION(); typedef INT_FUNCTION *INT_FUNCPTR; typedef void (*SUBRPTR)(); typedef void SUBROUTINE(); #ifdef IBM370 #pragma linkage(SUBROUTINE,FORTRAN) #pragma linkage(INT_FUNCTION,FORTRAN) #pragma map(__CTOF,"@@CTOF") extern INTEGER __CTOF( INT_FUNCPTR, ... ); #endif typedef union _EQUIV_INT_REAL { INTEGER i; LOGICAL l; REAL r; } EQUIV_INT_REAL; /* * Mapping of C-routine name for Fortran CALL SUB * * #define F77_EXTERN_LOWERCASE ==> void sub() * #define F77_EXTERN_UPPERCASE ==> void SUB() * otherwise ==> void sub_() */ #ifdef F77_EXTERN_UPPERCASE # define F77_NAME(name,NAME) NAME #else # ifdef F77_EXTERN_LOWERCASE # define F77_NAME(name,NAME) name # else # define F77_NAME(name,NAME) ConCat(name,_) # endif #endif #ifndef F77_BLOCK # define F77_BLOCK(name,NAME) F77_NAME(name,NAME) #endif #ifndef F77_COMMON # define F77_COMMON(name) name #endif /* * Routine address in CALL SUB(FUN) ; EXTERNAL FUN * * #define F77_EXTERN_INDIRECT ==> void (**fun)(); * otherwise ==> void (*fun)(); */ #ifdef F77_EXTERN_INDIRECT # define F77_EXTERN_ARG(e) ConCat(e,_ptr) # define F77_EXTERN_DCL(e) SUBROUTINE **ConCat(e,_ptr); # define F77_EXTERN_DEF(e) SUBROUTINE *e = *ConCat(e,_ptr); #else # define F77_EXTERN_ARG(e) e # define F77_EXTERN_DCL(e) SUBROUTINE *e; # define F77_EXTERN_DEF(e) #endif #define F77_EXTERN2ARG(e1,e2) F77_EXTERN_ARG(e1),F77_EXTERN_ARG(e2) #define F77_EXTERN2DCL(e1,e2) F77_EXTERN_DCL(e1) F77_EXTERN_DCL(e2) #define F77_EXTERN2DEF(e1,e2) F77_EXTERN_DEF(e1) F77_EXTERN_DEF(e2) #define F77_EXTERN3ARG(e1,e2,e3) F77_EXTERN_ARG(e1),F77_EXTERN2ARG(e2,e3) #define F77_EXTERN3DCL(e1,e2,e3) F77_EXTERN_DCL(e1) F77_EXTERN2DCL(e2,e3) #define F77_EXTERN3DEF(e1,e2,e3) F77_EXTERN_DEF(e1) F77_EXTERN2DEF(e2,e3) #define F77_EXTERN4ARG(e1,e2,e3,e4) F77_EXTERN_ARG(e1),F77_EXTERN3ARG(e2,e3,e4) #define F77_EXTERN4DCL(e1,e2,e3,e4) F77_EXTERN_DCL(e1) F77_EXTERN3DCL(e2,e3,e4) #define F77_EXTERN4DEF(e1,e2,e3,e4) F77_EXTERN_DEF(e1) F77_EXTERN3DEF(e2,e3,e4) #ifdef F77_ARG_CONSTANT /* * If the Fortran compiler (e.g. VSFORTRAN and Convex fc without -sa option) * uses constant argument blocks we have to make a private copy in case the * routine uses the arguments as local variables. */ # define F77_XXXX_ARG_PTR(t,x) ConCat(x,_ptr) # define F77_XXXX_ARG_DCL(t,x) t *ConCat(x,_ptr); # define F77_XXXX_ARG_DEF(t,x) t *x = ConCat(x,_ptr); #else # define F77_XXXX_ARG_PTR(t,x) x # define F77_XXXX_ARG_DCL(t,x) t *x; # define F77_XXXX_ARG_DEF(t,x) #endif #define F77_REAL_ARG_PTR(r) F77_XXXX_ARG_PTR(REAL,r) #define F77_REAL_ARG_DCL(r) F77_XXXX_ARG_DCL(REAL,r) #define F77_REAL_ARG_DEF(r) F77_XXXX_ARG_DEF(REAL,r) #define F77_INTG_ARG_PTR(i) F77_XXXX_ARG_PTR(INTEGER,i) #define F77_INTG_ARG_DCL(i) F77_XXXX_ARG_DCL(INTEGER,i) #define F77_INTG_ARG_DEF(i) F77_XXXX_ARG_DEF(INTEGER,i) #define F77_INTG_ARG2PTR(i1,i2) F77_INTG_ARG_PTR(i1),F77_INTG_ARG_PTR(i2) #define F77_INTG_ARG2DCL(i1,i2) F77_INTG_ARG_DCL(i1) F77_INTG_ARG_DCL(i2) #define F77_INTG_ARG2DEF(i1,i2) F77_INTG_ARG_DEF(i1) F77_INTG_ARG_DEF(i2) #define F77_INTG_ARG3PTR(i1,i2,i3) F77_INTG_ARG_PTR(i1),F77_INTG_ARG2PTR(i2,i3) #define F77_INTG_ARG3DCL(i1,i2,i3) F77_INTG_ARG_DCL(i1) F77_INTG_ARG2DCL(i2,i3) #define F77_INTG_ARG3DEF(i1,i2,i3) F77_INTG_ARG_DEF(i1) F77_INTG_ARG2DEF(i2,i3) #define F77_INTG_ARG4PTR(i1,i2,i3,i4) F77_INTG_ARG_PTR(i1), \ F77_INTG_ARG3PTR(i2,i3,i4) #define F77_INTG_ARG4DCL(i1,i2,i3,i4) F77_INTG_ARG_DCL(i1) \ F77_INTG_ARG3DCL(i2,i3,i4) #define F77_INTG_ARG4DEF(i1,i2,i3,i4) F77_INTG_ARG_DEF(i1) \ F77_INTG_ARG3DEF(i2,i3,i4) /* * Access to Fortran CHARACTER arguments */ #ifdef vms /* VMS string descriptors */ # define F77_CHAR_ARG_PTR(s) ConCat(s,_ptr) # define F77_CHAR_ARG_LEN(s) # define F77_CHAR_ARG_DCL(s) struct dsc$descriptor_s *ConCat(s,_ptr); # define F77_CHAR_ARG_DEF(s) char *s = ConCat(s,_ptr)->dsc$a_pointer; \ int ConCat(len_,s) = ConCat(s,_ptr)->dsc$w_length; # define F77_CHAR_DEF_DSC(s,p,l) struct dsc$descriptor_s ConCat(s,_dsc); # define F77_CHAR_ASS_DSC(s,p,l) ConCat(s,_dsc).dsc$w_length = l; \ ConCat(s,_dsc).dsc$b_dtype = DSC$K_DTYPE_T;\ ConCat(s,_dsc).dsc$b_class = DSC$K_CLASS_S;\ ConCat(s,_dsc).dsc$a_pointer = (char*)p; # define F77_CHAR_USE_PTR(s,p,l) &ConCat(s,_dsc) # define F77_CHAR_USE_LEN(s,p,l) #else #ifdef CRAY /* Cray string descriptors */ # define F77_CHAR_ARG_PTR(s) ConCat(s,_ptr) # define F77_CHAR_ARG_LEN(s) # define F77_CHAR_ARG_DCL(s) _fcd ConCat(s,_ptr); # define F77_CHAR_ARG_DEF(s) char *s = _fcdtocp(ConCat(s,_ptr)); \ int ConCat(len_,s) = _fcdlen(ConCat(s,_ptr)); # define F77_CHAR_DEF_DSC(s,p,l) # define F77_CHAR_ASS_DSC(s,p,l) # define F77_CHAR_USE_PTR(s,p,l) _cptofcd(p,l) # define F77_CHAR_USE_LEN(s,p,l) #else /* length passed as additional argument */ # ifdef F77_CHAR_LEN_IND /* length passed by reference */ # define F77_CHAR_LEN_STAR(len) *len # else # define F77_CHAR_LEN_STAR(len) len # endif # ifndef F77_CHAR_LEN_TYPE # define F77_CHAR_LEN_TYPE int # endif # ifdef F77_ARG_CONSTANT # define F77_CHAR_ARG_PTR(s) ConCat(s,_ptr) # define F77_CHAR_ARG_LEN(s) , ConCat(s,_len) # define F77_CHAR_ARG_DCL(s) char *ConCat(s,_ptr); \ F77_CHAR_LEN_TYPE F77_CHAR_LEN_STAR(ConCat(s,_len)); # define F77_CHAR_ARG_DEF(s) char *s = ConCat(s,_ptr); \ int ConCat(len_,s) = F77_CHAR_LEN_STAR(ConCat(s,_len)); # else # ifdef F77_CHAR_LEN_IND # define F77_CHAR_ARG_PTR(s) s # define F77_CHAR_ARG_LEN(s) , ConCat(s,_len) # define F77_CHAR_ARG_DCL(s) char *s; \ F77_CHAR_LEN_TYPE F77_CHAR_LEN_STAR(ConCat(s,_len)); # define F77_CHAR_ARG_DEF(s) \ int ConCat(len_,s) = F77_CHAR_LEN_STAR(ConCat(s,_len)); # else # define F77_CHAR_ARG_PTR(s) s # define F77_CHAR_ARG_LEN(s) , ConCat(len_,s) # define F77_CHAR_ARG_DCL(s) char *s; int ConCat(len_,s); # define F77_CHAR_ARG_DEF(s) # endif # endif # if defined(F77_CHAR_LEN_IND) # define F77_CHAR_DEF_DSC(s,p,l) F77_CHAR_LEN_TYPE ConCat(s,_dsc) = l; # define F77_CHAR_ASS_DSC(s,p,l) # define F77_CHAR_USE_PTR(s,p,l) p # define F77_CHAR_USE_LEN(s,p,l) , &ConCat(s,_dsc) # else # define F77_CHAR_DEF_DSC(s,p,l) # define F77_CHAR_ASS_DSC(s,p,l) # define F77_CHAR_USE_PTR(s,p,l) p # define F77_CHAR_USE_LEN(s,p,l) , l # endif #endif #endif #ifndef F77_XXXX_ARG_LEN /* length argument of non-CHARACTER arguments */ # define F77_XXXX_ARG_LEN(x) /* nil */ # define F77_XXXX_USE_LEN(x) /* nil */ #endif #define F77_CHAR_ARG2PTR(c1,c2) \ F77_CHAR_ARG_PTR(c1),F77_CHAR_ARG_PTR(c2) #define F77_CHAR_ARG2LEN(c1,c2) \ F77_CHAR_ARG_LEN(c1) F77_CHAR_ARG_LEN(c2) #define F77_XXXX_ARG2LEN(c1,c2) \ F77_XXXX_ARG_LEN(c1) F77_XXXX_ARG_LEN(c2) #define F77_CHAR_ARG2DCL(c1,c2) \ F77_CHAR_ARG_DCL(c1) F77_CHAR_ARG_DCL(c2) #define F77_CHAR_ARG2DEF(c1,c2) \ F77_CHAR_ARG_DEF(c1) F77_CHAR_ARG_DEF(c2) #define F77_CHAR_ARG3PTR(c1,c2,c3) \ F77_CHAR_ARG2PTR(c1,c2),F77_CHAR_ARG_PTR(c3) #define F77_CHAR_ARG3LEN(c1,c2,c3) \ F77_CHAR_ARG2LEN(c1,c2) F77_CHAR_ARG_LEN(c3) #define F77_XXXX_ARG3LEN(c1,c2,c3) \ F77_XXXX_ARG2LEN(c1,c2) F77_XXXX_ARG_LEN(c3) #define F77_CHAR_ARG3DCL(c1,c2,c3) \ F77_CHAR_ARG2DCL(c1,c2) F77_CHAR_ARG_DCL(c3) #define F77_CHAR_ARG3DEF(c1,c2,c3) \ F77_CHAR_ARG2DEF(c1,c2) F77_CHAR_ARG_DEF(c3) #define F77_CHAR_ARG4PTR(c1,c2,c3,c4) \ F77_CHAR_ARG3PTR(c1,c2,c3),F77_CHAR_ARG_PTR(c4) #define F77_CHAR_ARG4LEN(c1,c2,c3,c4) \ F77_CHAR_ARG3LEN(c1,c2,c3) F77_CHAR_ARG_LEN(c4) #define F77_XXXX_ARG4LEN(c1,c2,c3,c4) \ F77_XXXX_ARG3LEN(c1,c2,c3) F77_XXXX_ARG_LEN(c4) #define F77_CHAR_ARG4DCL(c1,c2,c3,c4) \ F77_CHAR_ARG3DCL(c1,c2,c3) F77_CHAR_ARG_DCL(c4) #define F77_CHAR_ARG4DEF(c1,c2,c3,c4) \ F77_CHAR_ARG3DEF(c1,c2,c3) F77_CHAR_ARG_DEF(c4) #define F77_CHAR_ARG5PTR(c1,c2,c3,c4,c5) \ F77_CHAR_ARG4PTR(c1,c2,c3,c4),F77_CHAR_ARG_PTR(c5) #define F77_CHAR_ARG5LEN(c1,c2,c3,c4,c5) \ F77_CHAR_ARG4LEN(c1,c2,c3,c4) F77_CHAR_ARG_LEN(c5) #define F77_CHAR_ARG5DCL(c1,c2,c3,c4,c5) \ F77_CHAR_ARG4DCL(c1,c2,c3,c4) F77_CHAR_ARG_DCL(c5) #define F77_CHAR_ARG5DEF(c1,c2,c3,c4,c5) \ F77_CHAR_ARG4DEF(c1,c2,c3,c4) F77_CHAR_ARG_DEF(c5) /* * Fortran-calls-C interface * * To define a C function called by Fortran CALL SUB(A,B,C): * * #define Sub F77_NAME(sub,SUB) * #pragma linkage(SUB,FORTRAN) // for IBM C/370 compiler * * F77_ENTRY_xyz(Sub,a,b,c) // opening { contained in macro * // body ... * } * * Each character in xyz declares the type of the corresponding parameter: * * C = CHARACTER * E = EXTERNAL * I = INTEGER * R = REAL * * If a parameter PAR is declared as CHARACTER the macro defines: * * char *PAR; // pointer to string (not terminated by \0 !!!) * int len_PAR; // length of string as defined by Fortran's LEN(PAR) * * The names PAR_dsc and PAR_ptr are reserved for internal use. * * Note: The function body follows the F77_ENTRY_... macro call directly. * The opening { is generated by the macro. */ #define F77_ENTRY_C(name,c1) \ name( F77_CHAR_ARG_PTR(c1) F77_CHAR_ARG_LEN(c1) ) \ F77_CHAR_ARG_DCL(c1) \ { F77_CHAR_ARG_DEF(c1) #define F77_ENTRY_CC(name,c1,c2) \ name( F77_CHAR_ARG2PTR(c1,c2) F77_CHAR_ARG2LEN(c1,c2) ) \ F77_CHAR_ARG2DCL(c1,c2) \ { F77_CHAR_ARG2DEF(c1,c2) #define F77_ENTRY_C3(name,c1,c2,c3) \ name( F77_CHAR_ARG3PTR(c1,c2,c3) \ F77_CHAR_ARG3LEN(c1,c2,c3) ) \ F77_CHAR_ARG3DCL(c1,c2,c3) \ { F77_CHAR_ARG3DEF(c1,c2,c3) #define F77_ENTRY_C5(name,c1,c2,c3,c4,c5) \ name( F77_CHAR_ARG5PTR(c1,c2,c3,c4,c5) \ F77_CHAR_ARG5LEN(c1,c2,c3,c4,c5) ) \ F77_CHAR_ARG5DCL(c1,c2,c3,c4,c5) \ { F77_CHAR_ARG5DEF(c1,c2,c3,c4,c5) #define F77_ENTRY_C4E(name,c1,c2,c3,c4,e5) \ name( F77_CHAR_ARG4PTR(c1,c2,c3,c4),F77_EXTERN_ARG(e5) \ F77_CHAR_ARG4LEN(c1,c2,c3,c4) ) \ F77_CHAR_ARG4DCL(c1,c2,c3,c4) F77_EXTERN_DCL(e5) \ { F77_CHAR_ARG4DEF(c1,c2,c3,c4) F77_EXTERN_DEF(e5) #define F77_ENTRY_C4I(name,c1,c2,c3,c4,i5) \ name( F77_CHAR_ARG4PTR(c1,c2,c3,c4),F77_INTG_ARG_PTR(i5) \ F77_CHAR_ARG4LEN(c1,c2,c3,c4) ) \ F77_CHAR_ARG4DCL(c1,c2,c3,c4) F77_INTG_ARG_DCL(i5) \ { F77_CHAR_ARG4DEF(c1,c2,c3,c4) F77_INTG_ARG_DEF(i5) #define F77_ENTRY_C5E(name,c1,c2,c3,c4,c5,e6) \ name( F77_CHAR_ARG5PTR(c1,c2,c3,c4,c5),F77_EXTERN_ARG(e6) \ F77_CHAR_ARG5LEN(c1,c2,c3,c4,c5) ) \ F77_CHAR_ARG5DCL(c1,c2,c3,c4,c5) F77_EXTERN_DCL(e6) \ { F77_CHAR_ARG5DEF(c1,c2,c3,c4,c5) F77_EXTERN_DEF(e6) #define F77_ENTRY_CCE(name,c1,c2,e3) \ name( F77_CHAR_ARG2PTR(c1,c2),F77_EXTERN_ARG(e3) \ F77_CHAR_ARG2LEN(c1,c2) ) \ F77_CHAR_ARG2DCL(c1,c2) F77_EXTERN_DCL(e3) \ { F77_CHAR_ARG2DEF(c1,c2) F77_EXTERN_DEF(e3) #define F77_ENTRY_CCEE(name,c1,c2,e3,e4) \ name( F77_CHAR_ARG2PTR(c1,c2),F77_EXTERN2ARG(e3,e4) \ F77_CHAR_ARG2LEN(c1,c2) ) \ F77_CHAR_ARG2DCL(c1,c2) F77_EXTERN2DCL(e3,e4) \ { F77_CHAR_ARG2DEF(c1,c2) F77_EXTERN2DEF(e3,e4) #define F77_ENTRY_CCI(name,c1,c2,i3) \ name( F77_CHAR_ARG2PTR(c1,c2),F77_INTG_ARG_PTR(i3) \ F77_CHAR_ARG2LEN(c1,c2) ) \ F77_CHAR_ARG2DCL(c1,c2) F77_INTG_ARG_DCL(i3) \ { F77_CHAR_ARG2DEF(c1,c2) F77_INTG_ARG_DEF(i3) #define F77_ENTRY_CCIC(name,c1,c2,i3,c4) \ name( F77_CHAR_ARG2PTR(c1,c2),F77_INTG_ARG_PTR(i3),F77_CHAR_ARG_PTR(c4) \ F77_CHAR_ARG2LEN(c1,c2) F77_XXXX_ARG_LEN(i3) F77_CHAR_ARG_LEN(c4) ) \ F77_CHAR_ARG3DCL(c1,c2,c4) F77_INTG_ARG_DCL(i3) \ { F77_CHAR_ARG3DEF(c1,c2,c4) F77_INTG_ARG_DEF(i3) #define F77_ENTRY_CCI3(name,c1,c2,i3,i4,i5) \ name( F77_CHAR_ARG2PTR(c1,c2),F77_INTG_ARG3PTR(i3,i4,i5) \ F77_CHAR_ARG2LEN(c1,c2) ) \ F77_CHAR_ARG2DCL(c1,c2) F77_INTG_ARG3DCL(i3,i4,i5) \ { F77_CHAR_ARG2DEF(c1,c2) F77_INTG_ARG3DEF(i3,i4,i5) #define F77_ENTRY_CCIRCC(name,c1,c2,i3,r4,c5,c6) \ name( F77_CHAR_ARG2PTR(c1,c2), \ F77_INTG_ARG_PTR(i3),F77_REAL_ARG_PTR(r4),F77_CHAR_ARG2PTR(c5,c6) \ F77_CHAR_ARG2LEN(c1,c2) \ F77_XXXX_ARG2LEN(i3,r4) F77_CHAR_ARG2LEN(c5,c6) ) \ F77_CHAR_ARG4DCL(c1,c2,c5,c6) \ F77_INTG_ARG_DCL(i3) F77_REAL_ARG_DCL(r4) \ { F77_CHAR_ARG4DEF(c1,c2,c5,c6) \ F77_INTG_ARG_DEF(i3) F77_REAL_ARG_DEF(r4) \ #define F77_ENTRY_CE(name,c1,e2) \ name( F77_CHAR_ARG_PTR(c1),F77_EXTERN_ARG(e2) \ F77_CHAR_ARG_LEN(c1) ) \ F77_CHAR_ARG_DCL(c1) F77_EXTERN_DCL(e2) \ { F77_CHAR_ARG_DEF(c1) F77_EXTERN_DEF(e2) #define F77_ENTRY_CI(name,c1,i2) \ name( F77_CHAR_ARG_PTR(c1),F77_INTG_ARG_PTR(i2) \ F77_CHAR_ARG_LEN(c1) ) \ F77_CHAR_ARG_DCL(c1) F77_INTG_ARG_DCL(i2) \ { F77_CHAR_ARG_DEF(c1) F77_INTG_ARG_DEF(i2) #define F77_ENTRY_CICI(name,c1,i2,c3,i4) \ name( F77_CHAR_ARG_PTR(c1),F77_INTG_ARG_PTR(i2), \ F77_CHAR_ARG_PTR(c3),F77_INTG_ARG_PTR(i4) \ F77_CHAR_ARG_LEN(c1) F77_XXXX_ARG_LEN(i2) \ F77_CHAR_ARG_LEN(c3) ) \ F77_CHAR_ARG2DCL(c1,c3) F77_INTG_ARG2DCL(i2,i4) \ { F77_CHAR_ARG2DEF(c1,c3) F77_INTG_ARG2DEF(i2,i4) #define F77_ENTRY_CII(name,c1,i2,i3) \ name( F77_CHAR_ARG_PTR(c1),F77_INTG_ARG2PTR(i2,i3) \ F77_CHAR_ARG_LEN(c1) ) \ F77_CHAR_ARG_DCL(c1) F77_INTG_ARG2DCL(i2,i3) \ { F77_CHAR_ARG_DEF(c1) F77_INTG_ARG2DEF(i2,i3) #define F77_ENTRY_CIIC(name,c1,i2,i3,c4) \ name( F77_CHAR_ARG_PTR(c1),F77_INTG_ARG2PTR(i2,i3),F77_CHAR_ARG_PTR(c4) \ F77_CHAR_ARG_LEN(c1) F77_XXXX_ARG2LEN(i2,i3) F77_CHAR_ARG_LEN(c4) ) \ F77_CHAR_ARG2DCL(c1,c4) F77_INTG_ARG2DCL(i2,i3) \ { F77_CHAR_ARG2DEF(c1,c4) F77_INTG_ARG2DEF(i2,i3) #define F77_ENTRY_CR(name,c1,r2) \ name( F77_CHAR_ARG_PTR(c1),F77_REAL_ARG_PTR(r2) \ F77_CHAR_ARG_LEN(c1) ) \ F77_CHAR_ARG_DCL(c1) F77_REAL_ARG_DCL(r2) \ { F77_CHAR_ARG_DEF(c1) F77_REAL_ARG_DEF(r2) #define F77_ENTRY_E(name,e1) \ name( F77_EXTERN_ARG(e1) ) \ F77_EXTERN_DCL(e1) \ { F77_EXTERN_DEF(e1) #define F77_ENTRY_E4(name,e1,e2,e3,e4) \ name( F77_EXTERN4ARG(e1,e2,e3,e4) ) \ F77_EXTERN4DCL(e1,e2,e3,e4) \ { F77_EXTERN4DEF(e1,e2,e3,e4) #define F77_ENTRY_IC(name,i1,c2) \ name( F77_INTG_ARG_PTR(i1),F77_CHAR_ARG_PTR(c2) \ F77_XXXX_ARG_LEN(i1) F77_CHAR_ARG_LEN(c2) ) \ F77_INTG_ARG_DCL(i1) F77_CHAR_ARG_DCL(c2) \ { F77_INTG_ARG_DEF(i1) F77_CHAR_ARG_DEF(c2) #define F77_ENTRY_ICI(name,i1,c2,i3) \ name( F77_INTG_ARG_PTR(i1), F77_CHAR_ARG_PTR(c2),F77_INTG_ARG_PTR(i3) \ F77_XXXX_ARG_LEN(i1) F77_CHAR_ARG_LEN(c2) ) \ F77_INTG_ARG2DCL(i1,i3) F77_CHAR_ARG_DCL(c2) \ { F77_INTG_ARG2DEF(i1,i3) F77_CHAR_ARG_DEF(c2) #define F77_ENTRY_IIC(name,i1,i2,c3) \ name( F77_INTG_ARG2PTR(i1,i2),F77_CHAR_ARG_PTR(c3) \ F77_XXXX_ARG2LEN(i1,i2) F77_CHAR_ARG_LEN(c3) ) \ F77_INTG_ARG2DCL(i1,i2) F77_CHAR_ARG_DCL(c3) \ { F77_INTG_ARG2DEF(i1,i2) F77_CHAR_ARG_DEF(c3) #define F77_ENTRY_I3C(name,i1,i2,i3,c4) \ name( F77_INTG_ARG3PTR(i1,i2,i3),F77_CHAR_ARG_PTR(c4) \ F77_XXXX_ARG3LEN(i1,i2,i3) F77_CHAR_ARG_LEN(c4) ) \ F77_INTG_ARG3DCL(i1,i2,i3) F77_CHAR_ARG_DCL(c4) \ { F77_INTG_ARG3DEF(i1,i2,i3) F77_CHAR_ARG_DEF(c4) #define F77_ENTRY_I4CCC(name,i1,i2,i3,i4,c5,c6,c7) \ name( F77_INTG_ARG4PTR(i1,i2,i3,i4),F77_CHAR_ARG3PTR(c5,c6,c7) \ F77_XXXX_ARG4LEN(i1,i2,i3,i4) F77_CHAR_ARG3LEN(c5,c6,c7) ) \ F77_INTG_ARG4DCL(i1,i2,i3,i4) F77_CHAR_ARG3DCL(c5,c6,c7) \ { F77_INTG_ARG4DEF(i1,i2,i3,i4) F77_CHAR_ARG3DEF(c5,c6,c7) #define F77_CHAR_DEF2DSC(s1,p1,l1,s2,p2,l2) \ F77_CHAR_DEF_DSC(s1,p1,l1) F77_CHAR_DEF_DSC(s2,p2,l2) #define F77_CHAR_ASS2DSC(s1,p1,l1,s2,p2,l2) \ F77_CHAR_ASS_DSC(s1,p1,l1) F77_CHAR_ASS_DSC(s2,p2,l2) #define F77_CHAR_USE2PTR(s1,p1,l1,s2,p2,l2) \ F77_CHAR_USE_PTR(s1,p1,l1),F77_CHAR_USE_PTR(s2,p2,l2) #define F77_CHAR_USE2LEN(s1,p1,l1,s2,p2,l2) \ F77_CHAR_USE_LEN(s1,p1,l1) F77_CHAR_USE_LEN(s2,p2,l2) #define F77_XXXX_USE2LEN(x1,x2) \ F77_XXXX_USE_LEN(x1) F77_XXXX_USE_LEN(x2) #define F77_CHAR_DEF3DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3) \ F77_CHAR_DEF2DSC(s1,p1,l1,s2,p2,l2) F77_CHAR_DEF_DSC(s3,p3,l3) #define F77_CHAR_ASS3DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3) \ F77_CHAR_ASS2DSC(s1,p1,l1,s2,p2,l2) F77_CHAR_ASS_DSC(s3,p3,l3) #define F77_CHAR_USE3PTR(s1,p1,l1,s2,p2,l2,s3,p3,l3) \ F77_CHAR_USE2PTR(s1,p1,l1,s2,p2,l2),F77_CHAR_USE_PTR(s3,p3,l3) #define F77_CHAR_USE3LEN(s1,p1,l1,s2,p2,l2,s3,p3,l3) \ F77_CHAR_USE2LEN(s1,p1,l1,s2,p2,l2) F77_CHAR_USE_LEN(s3,p3,l3) #define F77_XXXX_USE3LEN(x1,x2,x3) \ F77_XXXX_USE2LEN(x1,x2) F77_XXXX_USE_LEN(x3) #define F77_CHAR_DEF4DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3,s4,p4,l4) \ F77_CHAR_DEF3DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3) F77_CHAR_DEF_DSC(s4,p4,l4) #define F77_CHAR_ASS4DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3,s4,p4,l4) \ F77_CHAR_ASS3DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3) F77_CHAR_ASS_DSC(s4,p4,l4) #define F77_CHAR_USE4PTR(s1,p1,l1,s2,p2,l2,s3,p3,l3,s4,p4,l4) \ F77_CHAR_USE3PTR(s1,p1,l1,s2,p2,l2,s3,p3,l3),F77_CHAR_USE_PTR(s4,p4,l4) #define F77_CHAR_USE4LEN(s1,p1,l1,s2,p2,l2,s3,p3,l3,s4,p4,l4) \ F77_CHAR_USE3LEN(s1,p1,l1,s2,p2,l2,s3,p3,l3) F77_CHAR_USE_LEN(s4,p4,l4) #define F77_XXXX_USE4LEN(x1,x2,x3,x4) \ F77_XXXX_USE3LEN(x1,x2,x3) F77_XXXX_USE_LEN(x4) #define F77_XXXX_USE5LEN(x1,x2,x3,x4,x5) \ F77_XXXX_USE4LEN(x1,x2,x3,x4) F77_XXXX_USE_LEN(x5) #define F77_XXXX_USE6LEN(x1,x2,x3,x4,x5,x6) \ F77_XXXX_USE5LEN(x1,x2,x3,x4,x5) F77_XXXX_USE_LEN(x6) #define F77_XXXX_USE7LEN(x1,x2,x3,x4,x5,x6,x7) \ F77_XXXX_USE6LEN(x1,x2,x3,x4,x5,x6) F77_XXXX_USE_LEN(x7) #define F77_XXXX_USE8LEN(x1,x2,x3,x4,x5,x6,x7,x8) \ F77_XXXX_USE7LEN(x1,x2,x3,x4,x5,x6,x7) F77_XXXX_USE_LEN(x8) EXTERN INTEGER F77_i0; /* dummy */ #ifdef IBM370 #pragma linkage(K77C,FORTRAN) #define F77_IFUN_C(i0,name,p1,l1) do { \ i0 = K77C(&name,p1,l1); } while(0) #else #define F77_IFUN_C(i0,name,p1,l1) do { \ F77_CHAR_DEF_DSC(s1,p1,l1) \ F77_CHAR_ASS_DSC(s1,p1,l1) \ i0 = (*name)( \ F77_CHAR_USE_PTR(s1,p1,l1) \ F77_CHAR_USE_LEN(s1,p1,l1) \ ); } while(0) #endif #define F77_CALL_C(name,p1,l1) do { \ INT_FUNCPTR _p0_ = (INT_FUNCPTR)name; \ F77_IFUN_C(F77_i0,_p0_,p1,l1); \ } while(0) #ifdef IBM370 #pragma linkage(K77CC,FORTRAN) #define F77_IFUN_CC(i0,name,p1,l1,p2,l2) do { \ i0 = K77CC(&name,p1,l1,p2,l2); } while(0) #else #define F77_IFUN_CC(i0,name,p1,l1,p2,l2) do { \ F77_CHAR_DEF2DSC(s1,p1,l1,s2,p2,l2) \ F77_CHAR_ASS2DSC(s1,p1,l1,s2,p2,l2) \ i0 = (*name)( \ F77_CHAR_USE2PTR(s1,p1,l1,s2,p2,l2) \ F77_CHAR_USE2LEN(s1,p1,l1,s2,p2,l2) \ ); } while(0) #endif #define F77_CALL_CC(name,p1,l1,p2,l2) do { \ INT_FUNCPTR _p0_ = (INT_FUNCPTR)name; \ F77_IFUN_CC(F77_i0,_p0_,p1,l1,p2,l2); \ } while(0) #ifdef IBM370 #pragma linkage(K77C3,FORTRAN) #define F77_IFUN_C3(i0,name,p1,l1,p2,l2,p3,l3) do { \ i0 = K77C3(&name,p1,l1,p2,l2,p3,l3); } while(0) #else #define F77_IFUN_C3(i0,name,p1,l1,p2,l2,p3,l3) do { \ F77_CHAR_DEF3DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3) \ F77_CHAR_ASS3DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3) \ i0 = (*name)( \ F77_CHAR_USE3PTR(s1,p1,l1,s2,p2,l2,s3,p3,l3) \ F77_CHAR_USE3LEN(s1,p1,l1,s2,p2,l2,s3,p3,l3) \ ); } while(0) #endif #define F77_CALL_C3(name,p1,l1,p2,l2,p3,l3) do { \ INT_FUNCPTR _p0_ = (INT_FUNCPTR)name; \ F77_IFUN_C3(F77_i0,_p0_,p1,l1,p2,l2,p3,l3); \ } while(0) #ifdef IBM370 #pragma linkage(K77C7,FORTRAN) #define F77_IFUN_C7(i0,name,p1,l1,p2,l2,p3,l3,p4,l4,p5,l5,p6,l6,p7,l7) do { \ i0 = K77C7(&name,p1,l1,p2,l2,p3,l3,p4,l4,p5,l5,p6,l6,p7,l7); } while(0) #else #define F77_IFUN_C7(i0,name,p1,l1,p2,l2,p3,l3,p4,l4,p5,l5,p6,l6,p7,l7) do { \ F77_CHAR_DEF4DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3,s4,p4,l4) \ F77_CHAR_DEF3DSC(s5,p5,l5,s6,p6,l6,s7,p7,l7) \ F77_CHAR_ASS4DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3,s4,p4,l4) \ F77_CHAR_ASS3DSC(s5,p5,l5,s6,p6,l6,s7,p7,l7) \ i0 = (*name)( \ F77_CHAR_USE4PTR(s1,p1,l1,s2,p2,l2,s3,p3,l3,s4,p4,l4), \ F77_CHAR_USE3PTR(s5,p5,l5,s6,p6,l6,s7,p7,l7) \ F77_CHAR_USE4LEN(s1,p1,l1,s2,p2,l2,s3,p3,l3,s4,p4,l4) \ F77_CHAR_USE3LEN(s5,p5,l5,s6,p6,l6,s7,p7,l7) \ ); } while(0) #endif #define F77_CALL_C7(name,p1,l1,p2,l2,p3,l3,p4,l4,p5,l5,p6,l6,p7,l7) do { \ INT_FUNCPTR _p0_ = (INT_FUNCPTR)name; \ F77_IFUN_C7(F77_i0,_p0_,p1,l1,p2,l2,p3,l3,p4,l4,p5,l5,p6,l6,p7,l7); \ } while(0) #ifdef IBM370 #pragma linkage(K77CCx,FORTRAN) #define F77_CALL_CCx(name,p1,l1,p2,l2,x3) do { \ SUBROUTINE *F77 = name; \ K77CCx(&F77,p1,l1,p2,l2,x3); } while(0) #else #define F77_CALL_CCx(name,p1,l1,p2,l2,x3) do { \ F77_CHAR_DEF2DSC(s1,p1,l1,s2,p2,l2) \ F77_CHAR_ASS2DSC(s1,p1,l1,s2,p2,l2) \ name( F77_CHAR_USE2PTR(s1,p1,l1,s2,p2,l2), \ x3 \ F77_CHAR_USE2LEN(s1,p1,l1,s2,p2,l2) \ F77_XXXX_USE_LEN(x3) \ ); } while(0) #endif #ifdef IBM370 #pragma linkage(K77CCxx,FORTRAN) #define F77_IFUN_CCxx(i0,name,p1,l1,p2,l2,x3,x4) do { \ i0 = K77CCxx(&name,p1,l1,p2,l2,x3,x4); } while(0) #else #define F77_IFUN_CCxx(i0,name,p1,l1,p2,l2,x3,x4) do { \ F77_CHAR_DEF2DSC(s1,p1,l1,s2,p2,l2) \ F77_CHAR_ASS2DSC(s1,p1,l1,s2,p2,l2) \ i0 = (*name)( \ F77_CHAR_USE2PTR(s1,p1,l1,s2,p2,l2), \ x3,x4 \ F77_CHAR_USE2LEN(s1,p1,l1,s2,p2,l2) \ ); } while(0) #endif #define F77_CALL_CCxx(name,p1,l1,p2,l2,x3,x4) do { \ INT_FUNCPTR _p0_ = (INT_FUNCPTR)name; \ F77_IFUN_CCxx(F77_i0,_p0_,p1,l1,p2,l2,x3,x4); \ } while(0) #ifdef IBM370 #pragma linkage(K77CCx3,FORTRAN) #define F77_IFUN_CCx3(i0,name,p1,l1,p2,l2,x3,x4,x5) do { \ i0 = K77CCx3(&name,p1,l1,p2,l2,x3,x4,x5); } while(0) #else #define F77_IFUN_CCx3(i0,name,p1,l1,p2,l2,x3,x4,x5) do { \ F77_CHAR_DEF2DSC(s1,p1,l1,s2,p2,l2) \ F77_CHAR_ASS2DSC(s1,p1,l1,s2,p2,l2) \ i0 = (*name)( \ F77_CHAR_USE2PTR(s1,p1,l1,s2,p2,l2), \ x3,x4,x5 \ F77_CHAR_USE2LEN(s1,p1,l1,s2,p2,l2) \ ); } while(0) #endif #define F77_CALL_CCx3(name,p1,l1,p2,l2,x3,x4,x5) do { \ INT_FUNCPTR _p0_ = (INT_FUNCPTR)name; \ F77_IFUN_CCx3(F77_i0,_p0_,p1,l1,p2,l2,x3,x4,x5); \ } while(0) #ifdef IBM370 #pragma linkage(K77Cx,FORTRAN) #define F77_IFUN_Cx(i0,name,p1,l1,x2) do { \ i0 = K77Cx(&name,p1,l1,x2); } while(0) #else #define F77_IFUN_Cx(i0,name,p1,l1,x2) do { \ F77_CHAR_DEF_DSC(s1,p1,l1) \ F77_CHAR_ASS_DSC(s1,p1,l1) \ i0 = (*name)( \ F77_CHAR_USE_PTR(s1,p1,l1), \ x2 \ F77_CHAR_USE_LEN(s1,p1,l1) \ F77_XXXX_USE_LEN(x2) \ ); } while(0) #endif #define F77_CALL_Cx(name,p1,l1,x2) do { \ INT_FUNCPTR _p0_ = (INT_FUNCPTR)name; \ F77_IFUN_Cx(F77_i0,_p0_,p1,l1,x2); \ } while(0) #ifdef IBM370 #pragma linkage(K77CxC,FORTRAN) #define F77_CALL_CxC(name,p1,l1,x2,p3,l3) do { \ SUBROUTINE *F77 = name; \ K77CxC(&F77,p1,l1,x2,p3,l3); } while(0) #else #define F77_CALL_CxC(name,p1,l1,x2,p3,l3) do { \ F77_CHAR_DEF2DSC(s1,p1,l1,s3,p3,l3) \ F77_CHAR_ASS2DSC(s1,p1,l1,s3,p3,l3) \ name( F77_CHAR_USE_PTR(s1,p1,l1), \ x2, \ F77_CHAR_USE_PTR(s3,p3,l3) \ F77_CHAR_USE_LEN(s1,p1,l1) \ F77_XXXX_USE_LEN(x2) \ F77_CHAR_USE_LEN(s3,p3,l3) \ ); } while(0) #endif #ifdef IBM370 #pragma linkage(K77Cxx,FORTRAN) #define F77_CALL_Cxx(name,p1,l1,x2,x3) do { \ SUBROUTINE *F77 = name; \ K77Cxx(&F77,p1,l1,x2,x3); } while(0) #else #define F77_CALL_Cxx(name,p1,l1,x2,x3) do { \ F77_CHAR_DEF_DSC(s1,p1,l1) \ F77_CHAR_ASS_DSC(s1,p1,l1) \ name( F77_CHAR_USE_PTR(s1,p1,l1), \ x2,x3 \ F77_CHAR_USE_LEN(s1,p1,l1) \ F77_XXXX_USE2LEN(x2,x3) \ ); } while(0) #endif #ifdef IBM370 #pragma linkage(K77xC,FORTRAN) #define F77_CALL_xC(name,x1,p2,l2) do { \ SUBROUTINE *F77 = name; \ K77xC(&F77,x1,p2,l2); } while(0) #else #define F77_CALL_xC(name,x1,p2,l2) do { \ F77_CHAR_DEF_DSC(s2,p2,l2) \ F77_CHAR_ASS_DSC(s2,p2,l2) \ name( x1, \ F77_CHAR_USE_PTR(s2,p2,l2) \ F77_XXXX_USE_LEN(x1) \ F77_CHAR_USE_LEN(s2,p2,l2) \ ); } while(0) #endif #ifdef IBM370 #pragma linkage(K77xCCx,FORTRAN) #define F77_CALL_xCCx(name,x1,p2,l2,p3,l3,x4) do { \ SUBROUTINE *F77 = name; \ K77xCCx(&F77,x1,p2,l2,p3,l3,x4); } while(0) #else #define F77_CALL_xCCx(name,x1,p2,l2,p3,l3,x4) do { \ F77_CHAR_DEF2DSC(s2,p2,l2,s3,p3,l3) \ F77_CHAR_ASS2DSC(s2,p2,l2,s3,p3,l3) \ name( x1, \ F77_CHAR_USE2PTR(s2,p2,l2,s3,p3,l3), \ x4 \ F77_XXXX_USE_LEN(x1) \ F77_CHAR_USE2LEN(s2,p2,l2,s3,p3,l3) \ F77_XXXX_USE_LEN(x4) \ ); } while(0) #endif #ifdef IBM370 #pragma linkage(K77xCC,FORTRAN) #define F77_IFUN_xCC(i0,name,x1,p2,l2,p3,l3) do { \ i0 = K77xCC(&name,x1,p2,l2,p3,l3); } while(0) #else #define F77_IFUN_xCC(i0,name,x1,p2,l2,p3,l3) do { \ F77_CHAR_DEF2DSC(s2,p2,l2,s3,p3,l3) \ F77_CHAR_ASS2DSC(s2,p2,l2,s3,p3,l3) \ i0 = (*name)( x1, \ F77_CHAR_USE2PTR(s2,p2,l2,s3,p3,l3) \ F77_XXXX_USE_LEN(x1) \ F77_CHAR_USE2LEN(s2,p2,l2,s3,p3,l3) \ ); } while(0) #endif #define F77_CALL_xCC(name,x1,p2,l2,p3,l3) do { \ INT_FUNCPTR _p0_ = (INT_FUNCPTR)name; \ F77_IFUN_xCC(F77_i0,_p0_,x1,p2,l2,p3,l3); \ } while(0) #ifdef IBM370 #pragma linkage(K77xCx,FORTRAN) #define F77_IFUN_xCx(i0,name,x1,p2,l2,x3) do { \ i0 = K77xCx(&name,x1,p2,l2,x3); } while(0) #else #define F77_IFUN_xCx(i0,name,x1,p2,l2,x3) do { \ F77_CHAR_DEF_DSC(s2,p2,l2) \ F77_CHAR_ASS_DSC(s2,p2,l2) \ i0 = (*name)( x1, \ F77_CHAR_USE_PTR(s2,p2,l2), \ x3 \ F77_XXXX_USE_LEN(x1) \ F77_CHAR_USE_LEN(s2,p2,l2) \ F77_XXXX_USE_LEN(x3) \ ); } while(0) #endif #define F77_CALL_xCx(name,x1,p2,l2,x3) do { \ INT_FUNCPTR _p0_ = (INT_FUNCPTR)name; \ F77_IFUN_xCx(F77_i0,_p0_,x1,p2,l2,x3); \ } while(0) #ifdef IBM370 #pragma linkage(K77x4C,FORTRAN) #define F77_CALL_x4C(name,x1,x2,x3,x4,p5,l5) do { \ SUBROUTINE *F77 = name; \ K77x4C(&F77,x1,x2,x3,x4,p5,l5); } while(0) #else #define F77_CALL_x4C(name,x1,x2,x3,x4,p5,l5) do { \ F77_CHAR_DEF_DSC(s5,p5,l5) \ F77_CHAR_ASS_DSC(s5,p5,l5) \ name( x1,x2,x3,x4, \ F77_CHAR_USE_PTR(s5,p5,l5) \ F77_XXXX_USE4LEN(x1,x2,x3,x4) \ F77_CHAR_USE_LEN(s5,p5,l5) \ ); } while(0) #endif #ifdef IBM370 #pragma linkage(K77x4Cxx,FORTRAN) #define F77_CALL_x4Cxx(name,x1,x2,x3,x4,p5,l5,x6,x7) do { \ SUBROUTINE *F77 = name; \ K77x4Cxx(&F77,x1,x2,x3,x4,p5,l5,x6,x7); } while(0) #else #define F77_CALL_x4Cxx(name,x1,x2,x3,x4,p5,l5,x6,x7) do { \ F77_CHAR_DEF_DSC(s5,p5,l5) \ F77_CHAR_ASS_DSC(s5,p5,l5) \ name( x1,x2,x3,x4, \ F77_CHAR_USE_PTR(s5,p5,l5), \ x6,x7 \ F77_XXXX_USE4LEN(x1,x2,x3,x4) \ F77_CHAR_USE_LEN(s5,p5,l5) \ F77_XXXX_USE2LEN(x6,x7) \ ); } while(0) #endif #ifdef IBM370 #pragma linkage(KIGMENU,FORTRAN) /* 1 2 3 4 5 6 7 8 9 10 11 12 13 14 */ #define F77_CALL_xCx5CxC3xC(name,a,b,B,c,d,e,f,g,h,H,i,j,J,k,K,l,L,m,n,N) do {\ SUBROUTINE *F77 = name; \ KIGMENU(&F77,a,b,B,c,d,e,f,g,h,H,i,j,J,k,K,l,L,m,n,N); } while(0) #else #define F77_CALL_xCx5CxC3xC(name,a,b,B,c,d,e,f,g,h,H,i,j,J,k,K,l,L,m,n,N) do {\ F77_CHAR_DEF_DSC(sb,b,B) \ F77_CHAR_DEF_DSC(sh,h,H) \ F77_CHAR_DEF3DSC(sj,j,J,sk,k,K,sl,l,L) \ F77_CHAR_DEF_DSC(sn,n,N) \ F77_CHAR_ASS_DSC(sb,b,B) \ F77_CHAR_ASS_DSC(sh,h,H) \ F77_CHAR_ASS3DSC(sj,j,J,sk,k,K,sl,l,L) \ F77_CHAR_ASS_DSC(sn,n,N) \ name( a, \ F77_CHAR_USE_PTR(sb,b,B), \ c,d,e,f,g, \ F77_CHAR_USE_PTR(sh,h,H), \ i, \ F77_CHAR_USE3PTR(sj,j,J,sk,k,K,sl,l,L), \ m, \ F77_CHAR_USE_PTR(sn,n,N) \ F77_XXXX_USE_LEN(a) \ F77_CHAR_USE_LEN(sb,b,B) \ F77_XXXX_USE5LEN(c,d,e,f,g) \ F77_CHAR_USE_LEN(sh,h,H) \ F77_XXXX_USE_LEN(i) \ F77_CHAR_USE3LEN(sj,j,J,sk,k,K,sl,l,L) \ F77_XXXX_USE_LEN(m) \ F77_CHAR_USE_LEN(sn,n,N) \ ); } while(0) #endif #ifdef IBM370 #define F77_IFUN_x(i0,name,x1) i0 = __CTOF(name,x1) #else #define F77_IFUN_x(i0,name,x1) i0 = (*name)(x1) #endif #ifdef IBM370 #define F77_IFUN_xx(i0,name,x1,x2) i0 = __CTOF(name,x1,x2) #else #define F77_IFUN_xx(i0,name,x1,x2) i0 = (*name)(x1,x2) #endif #ifdef IBM370 #pragma linkage(K77xCx8,FORTRAN) #define F77_IFUN_xCx8(i0,name,x1,p2,l2,x3,x4,x5,x6,x7,x8,x9,x10) do { \ i0 = K77xCx8(&name,x1,p2,l2,x3,x4,x5,x6,x7,x8,x9,x10); } while(0) #else #define F77_IFUN_xCx8(i0,name,x1,p2,l2,x3,x4,x5,x6,x7,x8,x9,x10) do { \ F77_CHAR_DEF_DSC(s2,p2,l2) \ F77_CHAR_ASS_DSC(s2,p2,l2) \ i0 = (*name)( x1, \ F77_CHAR_USE_PTR(s2,p2,l2), \ x3,x4,x5,x6,x7,x8,x9,x10 \ F77_XXXX_USE_LEN(x1) \ F77_CHAR_USE_LEN(s2,p2,l2) \ F77_XXXX_USE8LEN(x3,x4,x5,x6,x7,x8,x9,x10) \ ); } while(0) #endif extern LOGICAL ku_true( int return_true ); /* * routines called by Fortran */ #define Errrun F77_NAME(errrun,ERRRUN) #define Fmemcpy F77_NAME(fmemcpy,FMEMCPY) #define Getarg F77_NAME(getarg,GETARG) extern SUBROUTINE Getarg; #define Goparm F77_NAME(goparm,GOPARM) extern SUBROUTINE Goparm; #define Iclrwk F77_NAME(iclrwk,ICLRWK) extern SUBROUTINE Iclrwk; #define Iginit F77_NAME(iginit,IGINIT) extern SUBROUTINE Iginit; #define Igmenu F77_NAME(igmenu,IGMENU) extern SUBROUTINE Igmenu; #define Igrng F77_NAME(igrng,IGRNG) extern SUBROUTINE Igrng; #define Igsse F77_NAME(igsse,IGSSE) extern SUBROUTINE Igsse; #define Igsrap F77_NAME(igsrap,IGSRAP) extern SUBROUTINE Igsrap; #define Igwkty F77_NAME(igwkty,IGWKTY) extern SUBROUTINE Igwkty; #define Kcexec F77_NAME(kcexec,KCEXEC) #define Kdialo F77_NAME(kdialo,KDIALO) extern SUBROUTINE Kdialo; #define Kgetar F77_NAME(kgetar,KGETAR) #define Kiargc F77_NAME(kiargc,KIARGC) extern INT_FUNCTION Kiargc; #define Kibres F77_NAME(kibres,KIBRES) extern SUBROUTINE Kibres; #define Kiclos F77_NAME(kiclos,KICLOS) extern SUBROUTINE Kiclos; #define Kicomv F77_NAME(kicomv,KICOMV) #define Kierrf F77_NAME(kierrf,KIERRF) extern SUBROUTINE Kierrf; #define Kiinit F77_NAME(kiinit,KIINIT) extern SUBROUTINE Kiinit; #define Kilun F77_NAME(kilun,KILUN) extern SUBROUTINE Kilun; #define Kimtch F77_NAME(kimtch,KIMTCH) extern SUBROUTINE Kimtch; #define Kipawc F77_NAME(kipawc,KIPAWC) #define Kipiaf F77_NAME(kipiaf,KIPIAF) #define Kiprmt F77_NAME(kiprmt,KIPRMT) #define Kirtim F77_NAME(kirtim,KIRTIM) #define Kisigm F77_NAME(kisigm,KISIGM) #define Kivect F77_NAME(kivect,KIVECT) #define Kmbrset F77_NAME(kmbrset,KMBRSET) #define Kmvsed F77_NAME(kmvsed,KMVSED) extern SUBROUTINE Kmvsed; #define Kmvspg F77_NAME(kmvspg,KMVSPG) extern SUBROUTINE Kmvspg; #define Kmvssh F77_NAME(kmvssh,KMVSSH) extern SUBROUTINE Kmvssh; #define Ksvpar F77_NAME(ksvpar,KSVPAR) #define Kuach F77_NAME(kuach,KUACH) #define Kuact F77_NAME(kuact,KUACT) #define Kualfa F77_NAME(kualfa,KUALFA) #define Kuappl F77_NAME(kuappl,KUAPPL) #define Kuargs F77_NAME(kuargs,KUARGS) #define Kubrek F77_NAME(kubrek,KUBREK) #define Kubrof F77_NAME(kubrof,KUBROF) #define Kubron F77_NAME(kubron,KUBRON) #define Kuclos F77_NAME(kuclos,KUCLOS) extern SUBROUTINE Kuclos; #define Kucmd F77_NAME(kucmd,KUCMD) #define Kucmdl F77_NAME(kucmdl,KUCMDL) #define Kucomv F77_NAME(kucomv,KUCOMV) #define Kuedit F77_NAME(kuedit,KUEDIT) #define Kuesvr F77_NAME(kuesvr,KUESVR) #define Kueusr F77_NAME(kueusr,KUEUSR) #define Kuexec F77_NAME(kuexec,KUEXEC) #define Kuexel F77_NAME(kuexel,KUEXEL) #define Kuexit F77_NAME(kuexit,KUEXIT) #define Kufcas F77_NAME(kufcas,KUFCAS) #define Kufdef F77_NAME(kufdef,KUFDEF) #define Kugetc F77_NAME(kugetc,KUGETC) #define Kugete F77_NAME(kugete,KUGETE) #define Kugetf F77_NAME(kugetf,KUGETF) #define Kugeti F77_NAME(kugeti,KUGETI) #define Kugetl F77_NAME(kugetl,KUGETL) #define Kugetr F77_NAME(kugetr,KUGETR) #define Kugets F77_NAME(kugets,KUGETS) #define Kugrfl F77_NAME(kugrfl,KUGRFL) #define Kuguid F77_NAME(kuguid,KUGUID) #define Kuhelp F77_NAME(kuhelp,KUHELP) #define Kuhome F77_NAME(kuhome,KUHOME) #define Kuidf1 F77_NAME(kuidf1,KUIDF1) extern SUBROUTINE Kuidf1; #define Kuidf2 F77_NAME(kuidf2,KUIDF2) extern SUBROUTINE Kuidf2; #define Kuidfm F77_NAME(kuidfm,KUIDFM) #define Kuinim F77_NAME(kuinim,KUINIM) #define Kuinit F77_NAME(kuinit,KUINIT) #define Kuinps F77_NAME(kuinps,KUINPS) #define Kuinqf F77_NAME(kuinqf,KUINQF) extern SUBROUTINE Kuinqf; #define Kulun F77_NAME(kulun,KULUN) #define Kumloc F77_NAME(kumloc,KUMLOC) #define Kumout F77_NAME(kumout,KUMOUT) #define Kundpv F77_NAME(kundpv,KUNDPV) #define Kunpar F77_NAME(kunpar,KUNPAR) #define Kunwg F77_NAME(kunwg,KUNWG) #define Kuopen F77_NAME(kuopen,KUOPEN) extern SUBROUTINE Kuopen; #define Kupad F77_NAME(kupad,KUPAD) #define Kupar F77_NAME(kupar,KUPAR) #define Kupath F77_NAME(kupath,KUPATH) #define Kupatl F77_NAME(kupatl,KUPATL) #define Kuproc F77_NAME(kuproc,KUPROC) #define Kuprof F77_NAME(kuprof,KUPROF) #define Kuproi F77_NAME(kuproi,KUPROI) #define Kuprop F77_NAME(kuprop,KUPROP) #define Kupror F77_NAME(kupror,KUPROR) #define Kupros F77_NAME(kupros,KUPROS) #define Kumess F77_NAME(kumess,KUMESS) #define Kupval F77_NAME(kupval,KUPVAL) #define Kuqcas F77_NAME(kuqcas,KUQCAS) #define Kuqenv F77_NAME(kuqenv,KUQENV) #define Kuqexe F77_NAME(kuqexe,KUQEXE) #define Kuqkey F77_NAME(kuqkey,KUQKEY) #define Kuqsvr F77_NAME(kuqsvr,KUQSVR) #define Kuquit F77_NAME(kuquit,KUQUIT) #define Kuqvar F77_NAME(kuqvar,KUQVAR) #define Kuread F77_NAME(kuread,KUREAD) extern SUBROUTINE Kuread; #define Kusapp F77_NAME(kusapp,KUSAPP) #define Kuser F77_NAME(kuser,KUSER) #define Kuserid F77_NAME(kuserid,KUSERID) #define Kusibr F77_NAME(kusibr,KUSIBR) #define Kusigm F77_NAME(kusigm,KUSIGM) #define Kuspy F77_NAME(kuspy,KUSPY) #define Kustat F77_NAME(kustat,KUSTAT) #define Kustop F77_NAME(kustop,KUSTOP) #define Kuterm F77_NAME(kuterm,KUTERM) #define Kutime F77_NAME(kutime,KUTIME) #define Kutim0 F77_NAME(kutim0,KUTIM0) extern SUBROUTINE Kutim0; #define Kutrue F77_NAME(kutrue,KUTRUE) #define Kuvar F77_NAME(kuvar,KUVAR) #define Kuvcre F77_NAME(kuvcre,KUVCRE) extern SUBROUTINE Kuvcre; #define Kuvdel F77_NAME(kuvdel,KUVDEL) extern SUBROUTINE Kuvdel; #define Kuvect F77_NAME(kuvect,KUVECT) extern SUBROUTINE Kuvect; #define Kuvnam F77_NAME(kuvnam,KUVNAM) #define Kuwhag F77_NAME(kuwhag,KUWHAG) #define Kuwham F77_NAME(kuwham,KUWHAM) #define Kuwhat F77_NAME(kuwhat,KUWHAT) #define Kuwrit F77_NAME(kuwrit,KUWRIT) extern SUBROUTINE Kuwrit; #define Kxcrv2 F77_NAME(kxcrv2,KXCRV2) extern SUBROUTINE Kxcrv2; #define Macdef F77_NAME(macdef,MACDEF) extern SUBROUTINE Macdef; #define Mdmenu F77_NAME(mdmenu,MDMENU) #define Mhi_close F77_NAME(mhi_close,MHI_CLOSE) extern SUBROUTINE Mhi_close; #define Mhi_open F77_NAME(mhi_open,MHI_OPEN) extern SUBROUTINE Mhi_open; #define Mzwipe F77_NAME(mzwipe,MZWIPE) extern SUBROUTINE Mzwipe; #define Traceq F77_NAME(traceq,TRACEQ) extern SUBROUTINE Traceq; #define Xuflow F77_NAME(xuflow,XUFLOW) extern SUBROUTINE Xuflow; #ifdef IBM370 # pragma linkage(ERRRUN,FORTRAN) # pragma linkage(FMEMCPY,FORTRAN) # pragma linkage(GOPARM,FORTRAN) # pragma linkage(ICLRWK,FORTRAN) # pragma linkage(IGINIT,FORTRAN) # pragma linkage(IGMENU,FORTRAN) # pragma linkage(IGRNG,FORTRAN) # pragma linkage(IGSSE,FORTRAN) # pragma linkage(IGSRAP,FORTRAN) # pragma linkage(IGWKTY,FORTRAN) # pragma linkage(KCEXEC,FORTRAN) # pragma linkage(KDIALO,FORTRAN) # pragma linkage(KGETAR,FORTRAN) # pragma linkage(KIBRES,FORTRAN) # pragma linkage(KICLOS,FORTRAN) # pragma linkage(KICOMV,FORTRAN) # pragma linkage(KIERRF,FORTRAN) # pragma linkage(KIINIT,FORTRAN) # pragma linkage(KILUN,FORTRAN) # pragma linkage(KIMTCH,FORTRAN) # pragma linkage(KIPAWC,FORTRAN) # pragma linkage(KIPIAF,FORTRAN) # pragma linkage(KIPRMT,FORTRAN) # pragma linkage(KIRTIM,FORTRAN) # pragma linkage(KISIGM,FORTRAN) # pragma linkage(KIVECT,FORTRAN) # pragma linkage(KMBRSET,FORTRAN) # pragma linkage(KMVSED,FORTRAN) # pragma linkage(KMVSPG,FORTRAN) # pragma linkage(KMVSSH,FORTRAN) # pragma linkage(KSVPAR,FORTRAN) # pragma linkage(KUACH,FORTRAN) # pragma linkage(KUACT,FORTRAN) # pragma linkage(KUALFA,FORTRAN) # pragma linkage(KUAPPL,FORTRAN) # pragma linkage(KUARGS,FORTRAN) # pragma linkage(KUBREK,FORTRAN) # pragma linkage(KUBROF,FORTRAN) # pragma linkage(KUBRON,FORTRAN) # pragma linkage(KUCLOS,FORTRAN) # pragma linkage(KUCMD,FORTRAN) # pragma linkage(KUCMDL,FORTRAN) # pragma linkage(KUCOMV,FORTRAN) # pragma linkage(KUEDIT,FORTRAN) # pragma linkage(KUESVR,FORTRAN) # pragma linkage(KUEUSR,FORTRAN) # pragma linkage(KUEXEC,FORTRAN) # pragma linkage(KUEXEL,FORTRAN) # pragma linkage(KUEXIT,FORTRAN) # pragma linkage(KUFCAS,FORTRAN) # pragma linkage(KUFDEF,FORTRAN) # pragma linkage(KUGETC,FORTRAN) # pragma linkage(KUGETE,FORTRAN) # pragma linkage(KUGETF,FORTRAN) # pragma linkage(KUGETI,FORTRAN) # pragma linkage(KUGETL,FORTRAN) # pragma linkage(KUGETR,FORTRAN) # pragma linkage(KUGETS,FORTRAN) # pragma linkage(KUGRFL,FORTRAN) # pragma linkage(KUGUID,FORTRAN) # pragma linkage(KUHELP,FORTRAN) # pragma linkage(KUHOME,FORTRAN) # pragma linkage(KUIDF1,FORTRAN) # pragma linkage(KUIDF2,FORTRAN) # pragma linkage(KUIDFM,FORTRAN) # pragma linkage(KUINIM,FORTRAN) # pragma linkage(KUINIT,FORTRAN) # pragma linkage(KUINPS,FORTRAN) # pragma linkage(KUINQF,FORTRAN) # pragma linkage(KULUN,FORTRAN) # pragma linkage(KUMLOC,FORTRAN) # pragma linkage(KUMOUT,FORTRAN) # pragma linkage(KUNDPV,FORTRAN) # pragma linkage(KUNPAR,FORTRAN) # pragma linkage(KUNWG,FORTRAN) # pragma linkage(KUOPEN,FORTRAN) # pragma linkage(KUPAD,FORTRAN) # pragma linkage(KUPAR,FORTRAN) # pragma linkage(KUPATH,FORTRAN) # pragma linkage(KUPATL,FORTRAN) # pragma linkage(KUPROC,FORTRAN) # pragma linkage(KUPROF,FORTRAN) # pragma linkage(KUPROI,FORTRAN) # pragma linkage(KUPROP,FORTRAN) # pragma linkage(KUPROR,FORTRAN) # pragma linkage(KUPROS,FORTRAN) # pragma linkage(KUPVAL,FORTRAN) # pragma linkage(KUQCAS,FORTRAN) # pragma linkage(KUQENV,FORTRAN) # pragma linkage(KUQEXE,FORTRAN) # pragma linkage(KUQKEY,FORTRAN) # pragma linkage(KUQSVR,FORTRAN) # pragma linkage(KUQUIT,FORTRAN) # pragma linkage(KUQVAR,FORTRAN) # pragma linkage(KUREAD,FORTRAN) # pragma linkage(KUSAPP,FORTRAN) # pragma linkage(KUSIBR,FORTRAN) # pragma linkage(KUSIGM,FORTRAN) # pragma linkage(KUSPY,FORTRAN) # pragma linkage(KUSTAT,FORTRAN) # pragma linkage(KUSTOP,FORTRAN) # pragma linkage(KUTERM,FORTRAN) # pragma linkage(KUTIME,FORTRAN) # pragma linkage(KUTIM0,FORTRAN) # pragma linkage(KUTRUE,FORTRAN) # pragma linkage(KUSER,FORTRAN) # pragma linkage(KUVAR,FORTRAN) # pragma linkage(KUVCRE,FORTRAN) # pragma linkage(KUVDEL,FORTRAN) # pragma linkage(KUVECT,FORTRAN) # pragma linkage(KUVNAM,FORTRAN) # pragma linkage(KUWHAG,FORTRAN) # pragma linkage(KUWHAM,FORTRAN) # pragma linkage(KUWHAT,FORTRAN) # pragma linkage(KUWRIT,FORTRAN) # pragma linkage(KXCRV2,FORTRAN) # pragma linkage(MACDEF,FORTRAN) # pragma linkage(MDMENU,FORTRAN) # pragma linkage(MHI_CLOSE,FORTRAN) # pragma linkage(MHI_OPEN,FORTRAN) # pragma linkage(MZWIPE,FORTRAN) # pragma linkage(TRACEQ,FORTRAN) # pragma linkage(XUFLOW,FORTRAN) #endif #define MAXCMD 512 /* max length of a command line */ #define MAXEDT 32 /* max length of names in edit server */ #define MAXLEV 10 /* max levels of command name path */ #define MAXSVR 20 /* max number of edit server processes */ /* * The PAWC common is referenced through a pointer to allow the use of * dynamic common blocks on IBM systems. */ #define Pawc kc_pawc EXTERN struct COMMON_PAWC { INTEGER NWPAR; INTEGER IXPAWC; INTEGER IHBOOK; INTEGER IXHIGZ; INTEGER IXKUIP; INTEGER IFENCE[5]; INTEGER LQ[8]; INTEGER DATA[999]; } *Pawc; #define IQ(n) Pawc->DATA[n-1] #define Q(n) (((REAL*)(Pawc->DATA))[n-1]) +KEEP,KCOM_H /* kcom.h: Fortran COMMON blocks */ #define Kcparc F77_BLOCK(kcparc,KCPARC) EXTERN struct { char PARLST[512]; /* interface block for KUSER */ char CLIST[80]; char NOALIN[512]; char COMAND[80]; char CHLAST[512]; char NONPOS[512]; } F77_COMMON(Kcparc); #define Kcutil F77_BLOCK(kcutil,KCUTIL) EXTERN struct { INTEGER NCMD; INTEGER IWD; INTEGER LUNFIL; INTEGER LPRMPT; LOGICAL TIMING; LOGICAL TRACE; INTEGER CALMOD; INTEGER NVADD; INTEGER IREPET; INTEGER IREFAC; INTEGER IBRAK; LOGICAL TIMALL; INTEGER LENTER; LOGICAL UNIQUE; INTEGER LENMUL; LOGICAL MULTFL; LOGICAL HISTOK; LOGICAL NOHIST; INTEGER LENMUM; LOGICAL FILCAS; LOGICAL MEXEFL; } F77_COMMON(Kcutil); #define Kcvect F77_BLOCK(kcvect,KCVECT) EXTERN struct { INTEGER NUMVEC; /* number of vectors stored */ INTEGER TOTPAV; INTEGER GETPAV; LOGICAL TVECFL; } F77_COMMON(Kcvect); #define Kcwork F77_BLOCK(kcwork,KCWORK) EXTERN struct { REAL VECTOR[100]; /* vector '?' */ } F77_COMMON(Kcwork); #define Quest F77_BLOCK(quest,QUEST) EXTERN struct { INTEGER DATA[100]; } F77_COMMON(Quest); #define IQUEST(n) Quest.DATA[n-1] #define Sikuip F77_BLOCK(sikuip,SIKUIP) EXTERN struct { char CHSIGM[80]; /* command string passed to SIGMA */ } F77_COMMON(Sikuip); +KEEP,KSIG_H /* ksig.h: signal and break handling */ /* * Available signal handling package * * #define SIGNAL_POSIX ==> sigaction() for Unix * #define SIGNAL_BSD ==> sigvec() for VMS and NeXT * #define SIGNAL_V7 ==> signal() */ #if !defined(SIGNAL_BSD) && !defined(SIGNAL_V7) # define SIGNAL_POSIX #else # define sigjmp_buf jmp_buf # define sigsetjmp(buf,save) setjmp(buf) # define siglongjmp(buf,val) longjmp(buf,val) # ifdef vms # define sv_flags sv_onstack # endif #endif EXTERN struct { int trap_enabled; /* flag if exceptions should be trapped */ int intr_enabled; /* flag if ^C delivery is allowed */ int intr_pending; /* flag if ^C happened while disabled */ int intr_count; /* count number of consecutive ^C interrupts */ int traceback; /* print traceback on signal */ char *error_msg; /* messages is handler cannot do print */ int soft_intr; /* flag to stop at a convenient point */ int jump_set; /* flag if stack has been setup */ sigjmp_buf stack; int sockfd; /* socket descriptor and routine to */ void (*piaf_sync)(); /* resynchronize Piaf communication */ } kc_break; +DECK,hkuip_95a,if=95a,96a,97a,98,99,2000,00. +KEEP,KHAIX370 #ifndef AIX370 # define AIX370 #endif +KEEP,KHAPOFTN #ifndef APOLLO_FTN # define APOLLO_FTN #endif +KEEP,KHIBMVM #ifndef IBMVM # define IBMVM #endif +KEEP,KHIBMMVS #ifndef IBMMVS # define IBMMVS #endif +KEEP,KHNEWLIB #ifndef NEWLIB # define NEWLIB #endif +KEEP,KSYS_H /* ksys.h: system dependent defines */ /* update version if structures have changed */ #define KUIP_VERSION 921023 /* identify system if not possible from preprocessor defines */ +SEQ,KHAIX370,IF=AIX370 +SEQ,KHAPOFTN,IF=APOFTN +SEQ,KHIBMVM ,IF=IBMVM +SEQ,KHIBMMVS,IF=IBMMVS +SEQ,KHNEWLIB,IF=NEWLIB #ifdef AIX370 # define MACHINE_NAME "IBMAIX" # define UNIX # define F77_EXTERN_INDIRECT #endif #if defined(apollo) || defined(__apollo) # define MACHINE_NAME "APOLLO" # define APOLLO # define UNIX # include # include # include # include # include # include # ifdef APOLLO_FTN /* using /com/ftn instead of /bin/f77 */ # define F77_CHAR_LEN_IND # define F77_CHAR_LEN_TYPE short # define F77_EXTERN_LOWERCASE # endif # define F77_EXTERN_INDIRECT # define F77_COMMON(name) name __attribute((__section(name))) # ifndef EXTERN # define EXTERN /* essential for accessing COMMON blocks */ # endif # define FATAL_SIGFPE # define HAVE_MEMMOVE # define HAVE_STRCASECMP # define NO_DIRENT_H # define TERMIO_BSD /* for getline we must compile under bsd4.3 */ #endif #if defined(__convexc__) # define CONVEX # define MACHINE_NAME "CONVEX" # define UNIX # define F77_BLOCK(name,NAME) _##name##_ # define F77_ARG_CONSTANT # ifndef EXTERN # define EXTERN /* essential for accessing COMMON blocks */ # endif # define FATAL_SIGFPE # define HAVE_MEMMOVE # define HAVE_STRCASECMP # define HAVE_SELECT # define HAVE_VFORK # define MATCH_RE_COMP /* use re_comp/re_exec */ # define TERMIO_MAP_NL /* need to map NL to NL-CR on output */ # define USE_EDIT_SERVER #endif #ifdef CRAY # define MACHINE_NAME "CRAY" # define UNIX # include # define F77_EXTERN_UPPERCASE # ifndef EXTERN # define EXTERN /* essential for accessing COMMON blocks */ # endif # define HAVE_STRCASECMP # define NO_EDIT_SERVER #endif #if defined(__hpux) # define MACHINE_NAME "HPUX" # define HPUX # define UNIX # ifndef _HPUX_SOURCE # define _HPUX_SOURCE # endif # define FATAL_SIGFPE /* needs f77 +T and ON REAL UNDERFLOW IGNORE */ # define HAVE_MEMMOVE # define HAVE_STRCASECMP # define HAVE_STRRSTR # define HAVE_SELECT # define SELECT_CAST(fds) (int*)fds #endif #ifdef _IBMR2 # define IBMRT # define MACHINE_NAME "IBMRT" # define UNIX # define HAVE_MEMMOVE # define HAVE_STRCASECMP # include # define HAVE_SELECT # define BROKEN_F77_IO #endif #ifdef IBMVM # define ARG_STYLE_CMS # define MACHINE_NAME "IBM" # define OS_NAME "VM" # ifndef IBM370 # define IBM370 # endif # define KmTimeStamp TimeStamp typedef char TimeStamp[24]; extern int get_stamp(char*,TimeStamp*); # define same_stamp(stamp1,stamp2) (strcmp(*(stamp1),*(stamp2)) == 0) #endif #ifdef IBMMVS # define MACHINE_NAME "IBMMVS" # define OS_NAME "MVS" # ifndef IBM370 # define IBM370 # endif #endif #ifdef IBM370 # define F77_ARG_CONSTANT # define F77_CHAR_LEN_IND /* each parameter has a length argument ! */ # define F77_XXXX_ARG_LEN(x) F77_CHAR_ARG_LEN(x) # define F77_EXTERN_INDIRECT # define F77_EXTERN_UPPERCASE # define NO_FCNTL_H # define NO_UNISTD_H # define SIGNAL_V7 # define ALLOC_MIN_BYTES 128 # define STUPID_MALLOC #endif #ifdef linux # define LINUX # define MACHINE_NAME "LINUX" # define UNIX # define HAVE_MEMMOVE # define HAVE_STRCASECMP # define HAVE_SELECT #endif #ifdef MSDOS # define MACHINE_NAME "IBMPC" # define OS_NAME "MSDOS" # define UNIX # define NO_EDIT_SERVER # define NO_SOCKET_H # define NO_SYS_TIME_H # define SIGNAL_V7 # define SLASHES "\\/" # define TERMIO_MAP_NL /* need to map NL to NL-CR on output */ #endif #ifdef WIN32 # define WINNT # ifdef _ALPHA_ # define MACHINE_NAME "ALPHA" # else # define MACHINE_NAME "IBMPC" # endif # define OS_NAME "WINNT" # define UNIX # define MSDOS # include # include # include # include # define text_mode__() # define NO_EDIT_SERVER # define NO_SOCKET_H # define NO_SYS_TIME_H # define NO_UNISTD_H # define SIGNAL_V7 # define SLASHES "\\" #endif #ifdef NeXT # define MACHINE_NAME "NEXT" # define UNIX # define getcwd(path,maxlen) getwd(path) # define F77_BLOCK(lc,uc) lc # define F77_EXTERN_INDIRECT /* each parameter has a length argument ! */ # define F77_XXXX_ARG_LEN(x) F77_CHAR_ARG_LEN(x) # define F77_XXXX_USE_LEN(x) ,286716 /* don't know if value matters */ # define HAVE_MEMMOVE # define HAVE_VFORK # define MATCH_RE_COMP /* use re_comp/re_exec */ # define NO_DIRENT_H # define NO_UNISTD_H # define SIGNAL_BSD # define TERMIO_BSD # define GETPGRP_BSD /* BSD getpgrp(pid) vs. POSIX getpgrp(void) */ #endif #ifdef __osf__ # define UNIX # ifdef __alpha # define ALPHA # define MACHINE_NAME "ALPHA" # endif # define HAVE_MEMMOVE # define HAVE_STRCASECMP # define HAVE_SELECT # define BROKEN_F77_IO #endif #if defined(__sgi) # define MACHINE_NAME "SGI" # define SGI # define UNIX # define HAVE_MEMMOVE # define HAVE_STRCASECMP # define HAVE_SELECT #endif #if defined(sun) || defined(__sun) # define SUN # define UNIX # if defined(Solaris2) || defined(__svr4__) # define MACHINE_NAME "SOLARIS" # define SOLARIS # define HAVE_MEMMOVE # define HAVE_SELECT # define HAVE_STRCASECMP # define HAVE_VFORK # else # define MACHINE_NAME "SUN" # define HAVE_SELECT # define HAVE_STRCASECMP # define HAVE_VFORK # include # define MATCH_RE_COMP /* use re_comp/re_exec */ # define GETPGRP_BSD /* BSD getpgrp(pid) vs. POSIX getpgrp(void) */ # endif #endif #if defined(__ultrix) # define MACHINE_NAME "DECS" # define ULTRIX # define UNIX # define HAVE_MEMMOVE # define HAVE_STRCASECMP # define HAVE_VFORK # define NEED_STRDUP # define TERMIO_BSD # define GETPGRP_BSD /* BSD getpgrp(pid) vs. POSIX getpgrp(void) */ # define BROKEN_F77_IO #endif #ifdef vms # define OS_NAME "VMS" # ifdef __ALPHA # define ALPHA # define MACHINE_NAME "ALPHA" # else # define MACHINE_NAME "VAX" # define ConCat(con,cat) con/**/cat # endif # include # include # include /* lib$... prototypes */ # include # include # include # include # include # include # include # include # include /* sys$... prototypes */ # include # include # include # include # include # ifndef R_OK /* no access() modes in unixio.h on VAX/VMS */ # define F_OK 0 # define X_OK 1 # define W_OK 2 # define R_OK 4 # endif # define ARG_STYLE_VMS # define F77_EXTERN_LOWERCASE # define HAVE_MEMMOVE # define HAVE_STAT_H # define HAVE_VFORK /* actually have only vfork */ # define NO_FCNTL_H # define NO_UNISTD_H # define SIGNAL_BSD # define sigmask(sig) (1L << (sig-1)) /* should be in signal.h */ # define USE_EDIT_SERVER /* only for TPU/DISPLAY=MOTIF */ # if defined(VAXC) && !defined(__DECC) # define STUPID_MALLOC # endif # define fix_descriptor(dsc,str,n) \ do { \ dsc.dsc$b_dtype = DSC$K_DTYPE_T; \ dsc.dsc$b_class = DSC$K_CLASS_S; \ dsc.dsc$a_pointer = str; \ dsc.dsc$w_length = n; \ } while( 0 ) # define var_descriptor(dsc,str) \ do { \ dsc.dsc$b_dtype = DSC$K_DTYPE_T; \ dsc.dsc$b_class = DSC$K_CLASS_S; \ dsc.dsc$a_pointer = str; \ dsc.dsc$w_length = strlen( dsc.dsc$a_pointer ); \ } while( 0 ) #endif /* vms */ #include #include #include #ifndef NO_FCNTL_H #include #endif #include /* contains strtod() and strtol() on some systems */ #include #include #include #ifdef DBMALLOC #include "dbmalloc.h" /* debug malloc */ extern char* getenv(const char*); extern double strtod(const char*, char**); #else #include #endif #include #ifndef NO_UNISTD_H #include #endif #ifndef HAVE_VFORK # define vfork fork #endif #ifdef UNIX /* also defined for MSDOS and Windows/NT*/ # ifndef OS_NAME # define OS_NAME "UNIX" # endif # include # include # ifndef NO_SYS_TIME_H # include /* struct timeval */ # endif # ifndef MSDOS # include # ifdef TERMIO_BSD # define TERMIO_MAP_NL /* need to map NL to NL-CR on output */ # define HAVE_SELECT # endif # if !defined(TERMIO_BSD) && !defined(TERMIO_SYSV) # define TERMIO_POSIX # endif # if defined(HAVE_SELECT) && !defined(SELECT_CAST) # define SELECT_CAST(fds) fds # endif # include # ifndef NO_DIRENT_H /* POSIX opendir() */ # include # else /* BSD opendir() */ # include /* plus */ # define dirent direct /* struct dirent... */ # ifndef S_IRUSR # define S_IRUSR (S_IREAD) /* read permission, owner */ # define S_IWUSR (S_IWRITE) /* write permission, owner */ # define S_IXUSR (S_IEXEC) /* execute/search permission, owner */ # endif # endif # endif # define HAVE_STAT_H # ifndef NO_EDIT_SERVER # define USE_EDIT_SERVER # ifndef F_LOCK /* BSD file locking */ # include # define lockf(fd,op,offs) flock(fd,op) # define F_LOCK LOCK_EX # define F_ULOCK LOCK_UN # endif # endif # ifndef SLASHES # define SLASHES "/" # endif #endif #ifdef SUN # ifndef CLOCKS_PER_SEC # define CLOCKS_PER_SEC 1000000 /* missing in time.h */ # define difftime(t1,t0) ((double)(t1-t0)) # define raise(sig) kill(getpid(),sig) # endif #endif #ifndef CLOCKS_PER_SEC # define CLOCKS_PER_SEC 100 /* missing in VAX/VMS time.h */ #endif #ifdef HAVE_STAT_H # define KmTimeStamp struct stat # define get_stamp(path,stamp) stat(path,stamp) # define same_stamp(stamp1,stamp2) ((stamp2)->st_mtime == (stamp1)->st_mtime) #endif #ifndef KmTimeStamp # define KmTimeStamp int # define get_stamp(path,stamp) (*(stamp) = checksum(path)) # define same_stamp(stamp1,stamp2) (*(stamp1) == *(stamp2)) #endif #ifdef MATCH_RE_COMP extern char *re_comp(); extern int re_exec(); #else extern char *regcmp(); extern char *regex(); #endif /* command line arguments recognized by KUARGS */ #if !defined(ARG_STYLE_CMS) && !defined(ARG_STYLE_VMS) # define ARG_STYLE_UNIX #endif #ifndef MACHINE_NAME # define MACHINE_NAME "UNKNOWN" /* value returned by $MACHINE */ #endif #ifndef OS_NAME # define OS_NAME "UNKNOWN" /* value returned by $OS */ #endif /* #define EXTERN must be in one routine to allocate space for globals */ #ifndef EXTERN # define EXTERN extern #endif /* * Preprocessor syntax for token concatenation */ #ifndef ConCat # define ConCat(con,cat) con##cat #endif /* * Prototyping for C functions */ #define C_PROTO_0(name) \ name(void) #define C_PROTO_1(name,arg1) \ name(arg1) #define C_PROTO_2(name,arg1,arg2) \ name(arg1,arg2) #define C_PROTO_3(name,arg1,arg2,arg3) \ name(arg1,arg2,arg3) #define C_PROTO_4(name,arg1,arg2,arg3,arg4) \ name(arg1,arg2,arg3,arg4) #define C_PROTO_5(name,arg1,arg2,arg3,arg4,arg5) \ name(arg1,arg2,arg3,arg4,arg5) #define C_PROTO_6(name,arg1,arg2,arg3,arg4,arg5,arg6) \ name(arg1,arg2,arg3,arg4,arg5,arg6) #define C_PROTO_7(name,arg1,arg2,arg3,arg4,arg5,arg6,arg7) \ name(arg1,arg2,arg3,arg4,arg5,arg6,arg7) #define C_PROTO_8(name,arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8) \ name(arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8) #define C_PROTO_9(name,arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8,arg9) \ name(arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8,arg9) #define C_PROTO_13(name,a1,a2,a3,a4,a5,a6,a7,a8,a9,b0,b1,b2,b3) \ name(a1,a2,a3,a4,a5,a6,a7,a8,a9,b0,b1,b2,b3) #define C_DECL_1(name,t1,p1) \ name(t1 p1) #define C_DECL_2(name,t1,p1,t2,p2) \ name(t1 p1,t2 p2) #define C_DECL_3(name,t1,p1,t2,p2,t3,p3) \ name(t1 p1,t2 p2,t3 p3) #define C_DECL_4(name,t1,p1,t2,p2,t3,p3,t4,p4) \ name(t1 p1,t2 p2,t3 p3,t4 p4) #define C_DECL_5(name,t1,p1,t2,p2,t3,p3,t4,p4,t5,p5) \ name(t1 p1,t2 p2,t3 p3,t4 p4,t5 p5) #define C_DECL_6(name,t1,p1,t2,p2,t3,p3,t4,p4,t5,p5,t6,p6) \ name(t1 p1,t2 p2,t3 p3,t4 p4,t5 p5,t6 p6) #define C_DECL_7(name,t1,p1,t2,p2,t3,p3,t4,p4,t5,p5,t6,p6,t7,p7) \ name(t1 p1,t2 p2,t3 p3,t4 p4,t5 p5,t6 p6,t7 p7) #define C_DECL_8(name,t1,p1,t2,p2,t3,p3,t4,p4,t5,p5,t6,p6,t7,p7,t8,p8) \ name(t1 p1,t2 p2,t3 p3,t4 p4,t5 p5,t6 p6,t7 p7,t8 p8) #define C_DECL_9(name,t1,p1,t2,p2,t3,p3,t4,p4,t5,p5,t6,p6,t7,p7,t8,p8,t9,p9)\ name(t1 p1,t2 p2,t3 p3,t4 p4,t5 p5,t6 p6,t7 p7,t8 p8,t9 p9) #define C_DECL_13(name,t1,p1,t2,p2,t3,p3,t4,p4,t5,p5,t6,p6,t7,p7,t8,p8,\ t9,p9,t10,p10,t11,p11,t12,p12,t13,p13) \ name(t1 p1,t2 p2,t3 p3,t4 p4,t5 p5,t6 p6,t7 p7,t8 p8,\ t9 p9,t10 p10,t11 p11,t12 p12,t13 p13) typedef int IntFunc(); typedef char* CharFunc(); typedef char** pCharFunc(); +KEEP,KSTRING_H. #include #ifdef __cplusplus extern "C" { #endif /* * quasi-standard functions missing in some C-libraries */ extern void* memmove( void* dst, const void* src, size_t n ); #if !defined(__convexc__) extern int strcasecmp( const char* str1, const char* str2 ); extern int strncasecmp( const char* str1, const char* str2, size_t n ); #endif extern char* strrstr( const char* str1, const char* str2 ); #define strdup Strdup /* prototype without const */ extern char* strdup( const char* str ); /* * convenience functions from kkern.c */ extern char* str0dup( const char* str ); extern char* str2dup( const char* str1, const char* str2 ); extern char* str3dup( const char* str1, const char* str2, const char* str3 ); extern char* str4dup( const char* str1, const char* str2, const char* str3, const char* str4 ); extern char* str5dup( const char* str1, const char* str2, const char* str3, const char* str4, const char* str5 ); extern char* strndup( const char* buf, size_t n ); extern char* stridup( int i ); extern char* mstrcat( char* ptr, const char* str ); extern char* mstr2cat( char* ptr, const char* str1, const char* str2 ); extern char* mstr3cat( char* ptr, const char* str1, const char* str2, const char* str3); extern char* mstr4cat( char* ptr, const char* str1, const char* str2, const char* str3, const char* str4 ); extern char* mstrncat( char* ptr, const char* buf, size_t n ); extern char* mstrccat( char* ptr, char c, size_t n ); extern char* mstricat( char* ptr, int i ); extern char* strrpbrk( const char* str1, const char* str2 ); extern char* strqtok( char* str ); extern char* strlower( char* str ); extern char* strupper( char* str ); extern char* strtrim( char* str ); extern char* struntab( char* str ); extern char* strfromd( double d, size_t prec ); extern char* strfromi( int i, size_t prec ); extern char* strblk0( char* str ); extern int shsystem( const char* shell, const char* cmd ); extern int checksum( const char* path ); extern char* fexpand( const char* fname, const char* ftype ); extern char* fsearch( const char* fname, const char* ftype, const char* path ); extern char* fsymlink( const char* path ); extern char* fstrdup( const char* buf, size_t len ); extern char* fstr0dup( const char* buf, size_t len ); extern char* fstrtrim( const char* buf, size_t len ); extern char* fstr0trim( const char* buf, size_t len ); extern size_t fstrlen( const char* buf, size_t len ); extern size_t fstrset( char* buf, size_t len, const char* str ); extern double fstrtod( const char* str, char** tail ); extern int fstrtoi( const char* str, char** tail ); extern char* fstrvec( char** pstr, size_t n, size_t* len ); extern size_t mstrlen( char** pstr, size_t n ); #ifdef __cplusplus } #endif +KEEP,KUSER_H. #define KUMAC_UNWIND -30041961 /* error status to quit macro execution */ #ifdef __cplusplus extern "C" { #endif /* * C-interface functions */ extern char* k_getar(void); extern void k_setar( size_t, char** ); extern char* k_userid(void); extern void ku_alfa(void); extern char* ku_appl( int* luno, int* inmacro ); extern int ku_bool( const char* expr ); extern int ku_close( int luno ); extern void ku_cmdl( const char* template ); extern int ku_edit( const char* path, int use_server ); extern char* ku_eval( const char* expr ); extern int ku_exec( const char* cmd ); extern int ku_exel( const char* cmd ); extern char* ku_expr( const char* expr ); extern char* ku_getc(void); extern char* ku_gete(void); extern char* ku_getf(void); extern int ku_geti(void); extern char* ku_getl(void); extern double ku_getr(void); extern char* ku_gets(void); extern char* ku_fcase( char* path ); extern char* ku_home( const char* fname, const char* ftype ); extern char* ku_inps( const char* prompt ); extern int ku_inqf( const char* path ); extern int ku_intr( int enable ); extern void ku_last( const char* cmd ); extern int ku_match( const char* string, const char* pattern, int ignore_case ); extern int ku_math( const char* expr, double* result ); extern int ku_more( const char* question, const char* line ); extern int ku_npar(void); extern int ku_open( int luno, const char* path, const char* mode ); extern void ku_pad( const char* path, int delete ); extern char* ku_path(void); extern void ku_piaf( int socket, void(*sync)() ); extern char* ku_proc( const char* prompt, const char* dfault ); extern char* ku_prof( const char* prompt, const char* dfault ); extern int ku_proi( const char* prompt, int dfault ); extern char* ku_prop( const char* prompt ); extern double ku_pror( const char* prompt, double dfault ); extern char* ku_pros( const char* prompt, const char* dfault ); extern char** ku_qenv(void); extern char* ku_qexe( const char* fname ); extern int ku_qkey(void); extern int ku_qmac( const char* mname ); extern int ku_read( int luno, char* buf, size_t len ); extern int ku_sapp( const char* path, const char* exit ); extern void ku_shut(void); extern void ku_sibr(void); extern void ku_spy( const char* option ); extern int ku_stop( int set ); extern void ku_time( time_t, clock_t ); extern void ku_trap( int enable, int traceback ); extern int ku_vqaddr( const char* vname ); extern int ku_vtype( const char* vname ); extern int ku_vvalue( const char* vname, double* value ); extern void ku_whag(void); extern void ku_what( void(*styleG)() ); extern void ku_write( int, const char* line ); extern int km_icon( const char*, const char* ); #ifdef __cplusplus } #endif +KEEP,KPROTO_H extern char* clean_word( char* ); extern char* format_prompt( const char* ); extern char* getline( const char* ); extern void gl_config( const char*, int ); extern void gl_histadd( const char* ); extern void gl_setwidth( int ); extern char* input_line( const char*, char ); extern void leave_kuip(void); extern int len_alias( const char*, int ); extern int len_sysfun( const char* ); extern int len_vector( const char* ); extern char* quote_string( char*, int ); extern void reset_break(void); extern char* split_at_semicolon( char* ); extern void k_parse_args( const char*, char**, int* ); #ifndef vms extern void signal_handler( int ); #else extern int signal_handler( const void*, const void* ); extern int control_C_ast( int ); #endif +KEEP,KUIP_H +SEQ,KSYS_H +SEQ,KSTRING_H +SEQ,KUSER_H +SEQ,KPROTO_H +KEEP,KFOR_H /* kfor.h: Fortran-C interface */ /* * Fortran data types */ typedef int INTEGER; typedef int LOGICAL; typedef float REAL; typedef double DBLPREC; typedef struct { REAL re; REAL im; } COMPLEX; typedef INTEGER INT_FUNCTION(); typedef INT_FUNCTION *INT_FUNCPTR; typedef void (*SUBRPTR)(); typedef void SUBROUTINE(); #ifdef IBM370 #pragma linkage(SUBROUTINE,FORTRAN) #pragma linkage(INT_FUNCTION,FORTRAN) #pragma map(__CTOF,"@@CTOF") extern INTEGER __CTOF( INT_FUNCPTR, ... ); #endif typedef union _EQUIV_INT_REAL { INTEGER i; LOGICAL l; REAL r; } EQUIV_INT_REAL; /* * Mapping of C-routine name for Fortran CALL SUB * * #define F77_EXTERN_LOWERCASE ==> void sub() * #define F77_EXTERN_UPPERCASE ==> void SUB() * otherwise ==> void sub_() */ #ifdef F77_EXTERN_UPPERCASE # define F77_NAME(name,NAME) NAME #else # ifdef F77_EXTERN_LOWERCASE # define F77_NAME(name,NAME) name # else # define F77_NAME(name,NAME) ConCat(name,_) # endif #endif #ifndef F77_BLOCK # define F77_BLOCK(name,NAME) F77_NAME(name,NAME) #endif #ifndef F77_COMMON # define F77_COMMON(name) name #endif /* * Routine address in CALL SUB(FUN) ; EXTERNAL FUN * * #define F77_EXTERN_INDIRECT ==> void (**fun)(); * otherwise ==> void (*fun)(); */ #ifdef F77_EXTERN_INDIRECT # define F77_EXTERN_ARG(e) ConCat(e,_ptr) # define F77_EXTERN_DCL(e) SUBROUTINE **ConCat(e,_ptr); # define F77_EXTERN_DEF(e) SUBROUTINE *e = *ConCat(e,_ptr); #else # define F77_EXTERN_ARG(e) e # define F77_EXTERN_DCL(e) SUBROUTINE *e; # define F77_EXTERN_DEF(e) #endif #define F77_EXTERN2ARG(e1,e2) F77_EXTERN_ARG(e1),F77_EXTERN_ARG(e2) #define F77_EXTERN2DCL(e1,e2) F77_EXTERN_DCL(e1) F77_EXTERN_DCL(e2) #define F77_EXTERN2DEF(e1,e2) F77_EXTERN_DEF(e1) F77_EXTERN_DEF(e2) #define F77_EXTERN3ARG(e1,e2,e3) F77_EXTERN_ARG(e1),F77_EXTERN2ARG(e2,e3) #define F77_EXTERN3DCL(e1,e2,e3) F77_EXTERN_DCL(e1) F77_EXTERN2DCL(e2,e3) #define F77_EXTERN3DEF(e1,e2,e3) F77_EXTERN_DEF(e1) F77_EXTERN2DEF(e2,e3) #define F77_EXTERN4ARG(e1,e2,e3,e4) F77_EXTERN_ARG(e1),F77_EXTERN3ARG(e2,e3,e4) #define F77_EXTERN4DCL(e1,e2,e3,e4) F77_EXTERN_DCL(e1) F77_EXTERN3DCL(e2,e3,e4) #define F77_EXTERN4DEF(e1,e2,e3,e4) F77_EXTERN_DEF(e1) F77_EXTERN3DEF(e2,e3,e4) #ifdef F77_ARG_CONSTANT /* * If the Fortran compiler (e.g. VSFORTRAN and Convex fc without -sa option) * uses constant argument blocks we have to make a private copy in case the * routine uses the arguments as local variables. */ # define F77_XXXX_ARG_PTR(t,x) ConCat(x,_ptr) # define F77_XXXX_ARG_DCL(t,x) t *ConCat(x,_ptr); # define F77_XXXX_ARG_DEF(t,x) t *x = ConCat(x,_ptr); #else # define F77_XXXX_ARG_PTR(t,x) x # define F77_XXXX_ARG_DCL(t,x) t *x; # define F77_XXXX_ARG_DEF(t,x) #endif #define F77_REAL_ARG_PTR(r) F77_XXXX_ARG_PTR(REAL,r) #define F77_REAL_ARG_DCL(r) F77_XXXX_ARG_DCL(REAL,r) #define F77_REAL_ARG_DEF(r) F77_XXXX_ARG_DEF(REAL,r) #define F77_INTG_ARG_PTR(i) F77_XXXX_ARG_PTR(INTEGER,i) #define F77_INTG_ARG_DCL(i) F77_XXXX_ARG_DCL(INTEGER,i) #define F77_INTG_ARG_DEF(i) F77_XXXX_ARG_DEF(INTEGER,i) #define F77_INTG_ARG2PTR(i1,i2) F77_INTG_ARG_PTR(i1),F77_INTG_ARG_PTR(i2) #define F77_INTG_ARG2DCL(i1,i2) F77_INTG_ARG_DCL(i1) F77_INTG_ARG_DCL(i2) #define F77_INTG_ARG2DEF(i1,i2) F77_INTG_ARG_DEF(i1) F77_INTG_ARG_DEF(i2) #define F77_INTG_ARG3PTR(i1,i2,i3) F77_INTG_ARG_PTR(i1),F77_INTG_ARG2PTR(i2,i3) #define F77_INTG_ARG3DCL(i1,i2,i3) F77_INTG_ARG_DCL(i1) F77_INTG_ARG2DCL(i2,i3) #define F77_INTG_ARG3DEF(i1,i2,i3) F77_INTG_ARG_DEF(i1) F77_INTG_ARG2DEF(i2,i3) #define F77_INTG_ARG4PTR(i1,i2,i3,i4) F77_INTG_ARG_PTR(i1), \ F77_INTG_ARG3PTR(i2,i3,i4) #define F77_INTG_ARG4DCL(i1,i2,i3,i4) F77_INTG_ARG_DCL(i1) \ F77_INTG_ARG3DCL(i2,i3,i4) #define F77_INTG_ARG4DEF(i1,i2,i3,i4) F77_INTG_ARG_DEF(i1) \ F77_INTG_ARG3DEF(i2,i3,i4) /* * Access to Fortran CHARACTER arguments */ #ifdef vms /* VMS string descriptors */ # define F77_CHAR_ARG_PTR(s) ConCat(s,_ptr) # define F77_CHAR_ARG_LEN(s) # define F77_CHAR_ARG_DCL(s) struct dsc$descriptor_s *ConCat(s,_ptr); # define F77_CHAR_ARG_DEF(s) char *s = ConCat(s,_ptr)->dsc$a_pointer; \ int ConCat(len_,s) = ConCat(s,_ptr)->dsc$w_length; # define F77_CHAR_DEF_DSC(s,p,l) struct dsc$descriptor_s ConCat(s,_dsc); # define F77_CHAR_ASS_DSC(s,p,l) ConCat(s,_dsc).dsc$w_length = l; \ ConCat(s,_dsc).dsc$b_dtype = DSC$K_DTYPE_T;\ ConCat(s,_dsc).dsc$b_class = DSC$K_CLASS_S;\ ConCat(s,_dsc).dsc$a_pointer = (char*)p; # define F77_CHAR_USE_PTR(s,p,l) &ConCat(s,_dsc) # define F77_CHAR_USE_LEN(s,p,l) #else #ifdef CRAY /* Cray string descriptors */ # define F77_CHAR_ARG_PTR(s) ConCat(s,_ptr) # define F77_CHAR_ARG_LEN(s) # define F77_CHAR_ARG_DCL(s) _fcd ConCat(s,_ptr); # define F77_CHAR_ARG_DEF(s) char *s = _fcdtocp(ConCat(s,_ptr)); \ int ConCat(len_,s) = _fcdlen(ConCat(s,_ptr)); # define F77_CHAR_DEF_DSC(s,p,l) # define F77_CHAR_ASS_DSC(s,p,l) # define F77_CHAR_USE_PTR(s,p,l) _cptofcd(p,l) # define F77_CHAR_USE_LEN(s,p,l) #else /* length passed as additional argument */ # ifdef F77_CHAR_LEN_IND /* length passed by reference */ # define F77_CHAR_LEN_STAR(len) *len # else # define F77_CHAR_LEN_STAR(len) len # endif # ifndef F77_CHAR_LEN_TYPE # define F77_CHAR_LEN_TYPE int # endif # ifdef F77_ARG_CONSTANT # define F77_CHAR_ARG_PTR(s) ConCat(s,_ptr) # define F77_CHAR_ARG_LEN(s) , ConCat(s,_len) # define F77_CHAR_ARG_DCL(s) char *ConCat(s,_ptr); \ F77_CHAR_LEN_TYPE F77_CHAR_LEN_STAR(ConCat(s,_len)); # define F77_CHAR_ARG_DEF(s) char *s = ConCat(s,_ptr); \ int ConCat(len_,s) = F77_CHAR_LEN_STAR(ConCat(s,_len)); # else # ifdef F77_CHAR_LEN_IND # define F77_CHAR_ARG_PTR(s) s # define F77_CHAR_ARG_LEN(s) , ConCat(s,_len) # define F77_CHAR_ARG_DCL(s) char *s; \ F77_CHAR_LEN_TYPE F77_CHAR_LEN_STAR(ConCat(s,_len)); # define F77_CHAR_ARG_DEF(s) \ int ConCat(len_,s) = F77_CHAR_LEN_STAR(ConCat(s,_len)); # else # define F77_CHAR_ARG_PTR(s) s # define F77_CHAR_ARG_LEN(s) , ConCat(len_,s) # define F77_CHAR_ARG_DCL(s) char *s; int ConCat(len_,s); # define F77_CHAR_ARG_DEF(s) # endif # endif # if defined(F77_CHAR_LEN_IND) # define F77_CHAR_DEF_DSC(s,p,l) F77_CHAR_LEN_TYPE ConCat(s,_dsc) = l; # define F77_CHAR_ASS_DSC(s,p,l) # define F77_CHAR_USE_PTR(s,p,l) p # define F77_CHAR_USE_LEN(s,p,l) , &ConCat(s,_dsc) # else # define F77_CHAR_DEF_DSC(s,p,l) # define F77_CHAR_ASS_DSC(s,p,l) # define F77_CHAR_USE_PTR(s,p,l) p # define F77_CHAR_USE_LEN(s,p,l) , l # endif #endif #endif #ifndef F77_XXXX_ARG_LEN /* length argument of non-CHARACTER arguments */ # define F77_XXXX_ARG_LEN(x) /* nil */ # define F77_XXXX_USE_LEN(x) /* nil */ #endif #define F77_CHAR_ARG2PTR(c1,c2) \ F77_CHAR_ARG_PTR(c1),F77_CHAR_ARG_PTR(c2) #define F77_CHAR_ARG2LEN(c1,c2) \ F77_CHAR_ARG_LEN(c1) F77_CHAR_ARG_LEN(c2) #define F77_XXXX_ARG2LEN(c1,c2) \ F77_XXXX_ARG_LEN(c1) F77_XXXX_ARG_LEN(c2) #define F77_CHAR_ARG2DCL(c1,c2) \ F77_CHAR_ARG_DCL(c1) F77_CHAR_ARG_DCL(c2) #define F77_CHAR_ARG2DEF(c1,c2) \ F77_CHAR_ARG_DEF(c1) F77_CHAR_ARG_DEF(c2) #define F77_CHAR_ARG3PTR(c1,c2,c3) \ F77_CHAR_ARG2PTR(c1,c2),F77_CHAR_ARG_PTR(c3) #define F77_CHAR_ARG3LEN(c1,c2,c3) \ F77_CHAR_ARG2LEN(c1,c2) F77_CHAR_ARG_LEN(c3) #define F77_XXXX_ARG3LEN(c1,c2,c3) \ F77_XXXX_ARG2LEN(c1,c2) F77_XXXX_ARG_LEN(c3) #define F77_CHAR_ARG3DCL(c1,c2,c3) \ F77_CHAR_ARG2DCL(c1,c2) F77_CHAR_ARG_DCL(c3) #define F77_CHAR_ARG3DEF(c1,c2,c3) \ F77_CHAR_ARG2DEF(c1,c2) F77_CHAR_ARG_DEF(c3) #define F77_CHAR_ARG4PTR(c1,c2,c3,c4) \ F77_CHAR_ARG3PTR(c1,c2,c3),F77_CHAR_ARG_PTR(c4) #define F77_CHAR_ARG4LEN(c1,c2,c3,c4) \ F77_CHAR_ARG3LEN(c1,c2,c3) F77_CHAR_ARG_LEN(c4) #define F77_XXXX_ARG4LEN(c1,c2,c3,c4) \ F77_XXXX_ARG3LEN(c1,c2,c3) F77_XXXX_ARG_LEN(c4) #define F77_CHAR_ARG4DCL(c1,c2,c3,c4) \ F77_CHAR_ARG3DCL(c1,c2,c3) F77_CHAR_ARG_DCL(c4) #define F77_CHAR_ARG4DEF(c1,c2,c3,c4) \ F77_CHAR_ARG3DEF(c1,c2,c3) F77_CHAR_ARG_DEF(c4) #define F77_CHAR_ARG5PTR(c1,c2,c3,c4,c5) \ F77_CHAR_ARG4PTR(c1,c2,c3,c4),F77_CHAR_ARG_PTR(c5) #define F77_CHAR_ARG5LEN(c1,c2,c3,c4,c5) \ F77_CHAR_ARG4LEN(c1,c2,c3,c4) F77_CHAR_ARG_LEN(c5) #define F77_CHAR_ARG5DCL(c1,c2,c3,c4,c5) \ F77_CHAR_ARG4DCL(c1,c2,c3,c4) F77_CHAR_ARG_DCL(c5) #define F77_CHAR_ARG5DEF(c1,c2,c3,c4,c5) \ F77_CHAR_ARG4DEF(c1,c2,c3,c4) F77_CHAR_ARG_DEF(c5) /* * Fortran-calls-C interface * * To define a C function called by Fortran CALL SUB(A,B,C): * * #define Sub F77_NAME(sub,SUB) * #pragma linkage(SUB,FORTRAN) // for IBM C/370 compiler * * F77_ENTRY_xyz(Sub,a,b,c) // opening { contained in macro * // body ... * } * * Each character in xyz declares the type of the corresponding parameter: * * C = CHARACTER * E = EXTERNAL * I = INTEGER * R = REAL * * If a parameter PAR is declared as CHARACTER the macro defines: * * char *PAR; // pointer to string (not terminated by \0 !!!) * int len_PAR; // length of string as defined by Fortran's LEN(PAR) * * The names PAR_dsc and PAR_ptr are reserved for internal use. * * Note: The function body follows the F77_ENTRY_... macro call directly. * The opening { is generated by the macro. */ #define F77_ENTRY_C(name,c1) \ name( F77_CHAR_ARG_PTR(c1) F77_CHAR_ARG_LEN(c1) ) \ F77_CHAR_ARG_DCL(c1) \ { F77_CHAR_ARG_DEF(c1) #define F77_ENTRY_CC(name,c1,c2) \ name( F77_CHAR_ARG2PTR(c1,c2) F77_CHAR_ARG2LEN(c1,c2) ) \ F77_CHAR_ARG2DCL(c1,c2) \ { F77_CHAR_ARG2DEF(c1,c2) #define F77_ENTRY_C3(name,c1,c2,c3) \ name( F77_CHAR_ARG3PTR(c1,c2,c3) \ F77_CHAR_ARG3LEN(c1,c2,c3) ) \ F77_CHAR_ARG3DCL(c1,c2,c3) \ { F77_CHAR_ARG3DEF(c1,c2,c3) #define F77_ENTRY_C5(name,c1,c2,c3,c4,c5) \ name( F77_CHAR_ARG5PTR(c1,c2,c3,c4,c5) \ F77_CHAR_ARG5LEN(c1,c2,c3,c4,c5) ) \ F77_CHAR_ARG5DCL(c1,c2,c3,c4,c5) \ { F77_CHAR_ARG5DEF(c1,c2,c3,c4,c5) #define F77_ENTRY_C4E(name,c1,c2,c3,c4,e5) \ name( F77_CHAR_ARG4PTR(c1,c2,c3,c4),F77_EXTERN_ARG(e5) \ F77_CHAR_ARG4LEN(c1,c2,c3,c4) ) \ F77_CHAR_ARG4DCL(c1,c2,c3,c4) F77_EXTERN_DCL(e5) \ { F77_CHAR_ARG4DEF(c1,c2,c3,c4) F77_EXTERN_DEF(e5) #define F77_ENTRY_C4I(name,c1,c2,c3,c4,i5) \ name( F77_CHAR_ARG4PTR(c1,c2,c3,c4),F77_INTG_ARG_PTR(i5) \ F77_CHAR_ARG4LEN(c1,c2,c3,c4) ) \ F77_CHAR_ARG4DCL(c1,c2,c3,c4) F77_INTG_ARG_DCL(i5) \ { F77_CHAR_ARG4DEF(c1,c2,c3,c4) F77_INTG_ARG_DEF(i5) #define F77_ENTRY_C5E(name,c1,c2,c3,c4,c5,e6) \ name( F77_CHAR_ARG5PTR(c1,c2,c3,c4,c5),F77_EXTERN_ARG(e6) \ F77_CHAR_ARG5LEN(c1,c2,c3,c4,c5) ) \ F77_CHAR_ARG5DCL(c1,c2,c3,c4,c5) F77_EXTERN_DCL(e6) \ { F77_CHAR_ARG5DEF(c1,c2,c3,c4,c5) F77_EXTERN_DEF(e6) #define F77_ENTRY_CCE(name,c1,c2,e3) \ name( F77_CHAR_ARG2PTR(c1,c2),F77_EXTERN_ARG(e3) \ F77_CHAR_ARG2LEN(c1,c2) ) \ F77_CHAR_ARG2DCL(c1,c2) F77_EXTERN_DCL(e3) \ { F77_CHAR_ARG2DEF(c1,c2) F77_EXTERN_DEF(e3) #define F77_ENTRY_CCEE(name,c1,c2,e3,e4) \ name( F77_CHAR_ARG2PTR(c1,c2),F77_EXTERN2ARG(e3,e4) \ F77_CHAR_ARG2LEN(c1,c2) ) \ F77_CHAR_ARG2DCL(c1,c2) F77_EXTERN2DCL(e3,e4) \ { F77_CHAR_ARG2DEF(c1,c2) F77_EXTERN2DEF(e3,e4) #define F77_ENTRY_CCI(name,c1,c2,i3) \ name( F77_CHAR_ARG2PTR(c1,c2),F77_INTG_ARG_PTR(i3) \ F77_CHAR_ARG2LEN(c1,c2) ) \ F77_CHAR_ARG2DCL(c1,c2) F77_INTG_ARG_DCL(i3) \ { F77_CHAR_ARG2DEF(c1,c2) F77_INTG_ARG_DEF(i3) #define F77_ENTRY_CCIC(name,c1,c2,i3,c4) \ name( F77_CHAR_ARG2PTR(c1,c2),F77_INTG_ARG_PTR(i3),F77_CHAR_ARG_PTR(c4) \ F77_CHAR_ARG2LEN(c1,c2) F77_XXXX_ARG_LEN(i3) F77_CHAR_ARG_LEN(c4) ) \ F77_CHAR_ARG3DCL(c1,c2,c4) F77_INTG_ARG_DCL(i3) \ { F77_CHAR_ARG3DEF(c1,c2,c4) F77_INTG_ARG_DEF(i3) #define F77_ENTRY_CCI3(name,c1,c2,i3,i4,i5) \ name( F77_CHAR_ARG2PTR(c1,c2),F77_INTG_ARG3PTR(i3,i4,i5) \ F77_CHAR_ARG2LEN(c1,c2) ) \ F77_CHAR_ARG2DCL(c1,c2) F77_INTG_ARG3DCL(i3,i4,i5) \ { F77_CHAR_ARG2DEF(c1,c2) F77_INTG_ARG3DEF(i3,i4,i5) #define F77_ENTRY_CCIRCC(name,c1,c2,i3,r4,c5,c6) \ name( F77_CHAR_ARG2PTR(c1,c2), \ F77_INTG_ARG_PTR(i3),F77_REAL_ARG_PTR(r4),F77_CHAR_ARG2PTR(c5,c6) \ F77_CHAR_ARG2LEN(c1,c2) \ F77_XXXX_ARG2LEN(i3,r4) F77_CHAR_ARG2LEN(c5,c6) ) \ F77_CHAR_ARG4DCL(c1,c2,c5,c6) \ F77_INTG_ARG_DCL(i3) F77_REAL_ARG_DCL(r4) \ { F77_CHAR_ARG4DEF(c1,c2,c5,c6) \ F77_INTG_ARG_DEF(i3) F77_REAL_ARG_DEF(r4) \ #define F77_ENTRY_CE(name,c1,e2) \ name( F77_CHAR_ARG_PTR(c1),F77_EXTERN_ARG(e2) \ F77_CHAR_ARG_LEN(c1) ) \ F77_CHAR_ARG_DCL(c1) F77_EXTERN_DCL(e2) \ { F77_CHAR_ARG_DEF(c1) F77_EXTERN_DEF(e2) #define F77_ENTRY_CI(name,c1,i2) \ name( F77_CHAR_ARG_PTR(c1),F77_INTG_ARG_PTR(i2) \ F77_CHAR_ARG_LEN(c1) ) \ F77_CHAR_ARG_DCL(c1) F77_INTG_ARG_DCL(i2) \ { F77_CHAR_ARG_DEF(c1) F77_INTG_ARG_DEF(i2) #define F77_ENTRY_CICI(name,c1,i2,c3,i4) \ name( F77_CHAR_ARG_PTR(c1),F77_INTG_ARG_PTR(i2), \ F77_CHAR_ARG_PTR(c3),F77_INTG_ARG_PTR(i4) \ F77_CHAR_ARG_LEN(c1) F77_XXXX_ARG_LEN(i2) \ F77_CHAR_ARG_LEN(c3) ) \ F77_CHAR_ARG2DCL(c1,c3) F77_INTG_ARG2DCL(i2,i4) \ { F77_CHAR_ARG2DEF(c1,c3) F77_INTG_ARG2DEF(i2,i4) #define F77_ENTRY_CII(name,c1,i2,i3) \ name( F77_CHAR_ARG_PTR(c1),F77_INTG_ARG2PTR(i2,i3) \ F77_CHAR_ARG_LEN(c1) ) \ F77_CHAR_ARG_DCL(c1) F77_INTG_ARG2DCL(i2,i3) \ { F77_CHAR_ARG_DEF(c1) F77_INTG_ARG2DEF(i2,i3) #define F77_ENTRY_CIIC(name,c1,i2,i3,c4) \ name( F77_CHAR_ARG_PTR(c1),F77_INTG_ARG2PTR(i2,i3),F77_CHAR_ARG_PTR(c4) \ F77_CHAR_ARG_LEN(c1) F77_XXXX_ARG2LEN(i2,i3) F77_CHAR_ARG_LEN(c4) ) \ F77_CHAR_ARG2DCL(c1,c4) F77_INTG_ARG2DCL(i2,i3) \ { F77_CHAR_ARG2DEF(c1,c4) F77_INTG_ARG2DEF(i2,i3) #define F77_ENTRY_CR(name,c1,r2) \ name( F77_CHAR_ARG_PTR(c1),F77_REAL_ARG_PTR(r2) \ F77_CHAR_ARG_LEN(c1) ) \ F77_CHAR_ARG_DCL(c1) F77_REAL_ARG_DCL(r2) \ { F77_CHAR_ARG_DEF(c1) F77_REAL_ARG_DEF(r2) #define F77_ENTRY_E(name,e1) \ name( F77_EXTERN_ARG(e1) ) \ F77_EXTERN_DCL(e1) \ { F77_EXTERN_DEF(e1) #define F77_ENTRY_E4(name,e1,e2,e3,e4) \ name( F77_EXTERN4ARG(e1,e2,e3,e4) ) \ F77_EXTERN4DCL(e1,e2,e3,e4) \ { F77_EXTERN4DEF(e1,e2,e3,e4) #define F77_ENTRY_IC(name,i1,c2) \ name( F77_INTG_ARG_PTR(i1),F77_CHAR_ARG_PTR(c2) \ F77_XXXX_ARG_LEN(i1) F77_CHAR_ARG_LEN(c2) ) \ F77_INTG_ARG_DCL(i1) F77_CHAR_ARG_DCL(c2) \ { F77_INTG_ARG_DEF(i1) F77_CHAR_ARG_DEF(c2) #define F77_ENTRY_ICI(name,i1,c2,i3) \ name( F77_INTG_ARG_PTR(i1), F77_CHAR_ARG_PTR(c2),F77_INTG_ARG_PTR(i3) \ F77_XXXX_ARG_LEN(i1) F77_CHAR_ARG_LEN(c2) ) \ F77_INTG_ARG2DCL(i1,i3) F77_CHAR_ARG_DCL(c2) \ { F77_INTG_ARG2DEF(i1,i3) F77_CHAR_ARG_DEF(c2) #define F77_ENTRY_IIC(name,i1,i2,c3) \ name( F77_INTG_ARG2PTR(i1,i2),F77_CHAR_ARG_PTR(c3) \ F77_XXXX_ARG2LEN(i1,i2) F77_CHAR_ARG_LEN(c3) ) \ F77_INTG_ARG2DCL(i1,i2) F77_CHAR_ARG_DCL(c3) \ { F77_INTG_ARG2DEF(i1,i2) F77_CHAR_ARG_DEF(c3) #define F77_ENTRY_I3C(name,i1,i2,i3,c4) \ name( F77_INTG_ARG3PTR(i1,i2,i3),F77_CHAR_ARG_PTR(c4) \ F77_XXXX_ARG3LEN(i1,i2,i3) F77_CHAR_ARG_LEN(c4) ) \ F77_INTG_ARG3DCL(i1,i2,i3) F77_CHAR_ARG_DCL(c4) \ { F77_INTG_ARG3DEF(i1,i2,i3) F77_CHAR_ARG_DEF(c4) #define F77_ENTRY_I4CCC(name,i1,i2,i3,i4,c5,c6,c7) \ name( F77_INTG_ARG4PTR(i1,i2,i3,i4),F77_CHAR_ARG3PTR(c5,c6,c7) \ F77_XXXX_ARG4LEN(i1,i2,i3,i4) F77_CHAR_ARG3LEN(c5,c6,c7) ) \ F77_INTG_ARG4DCL(i1,i2,i3,i4) F77_CHAR_ARG3DCL(c5,c6,c7) \ { F77_INTG_ARG4DEF(i1,i2,i3,i4) F77_CHAR_ARG3DEF(c5,c6,c7) #define F77_CHAR_DEF2DSC(s1,p1,l1,s2,p2,l2) \ F77_CHAR_DEF_DSC(s1,p1,l1) F77_CHAR_DEF_DSC(s2,p2,l2) #define F77_CHAR_ASS2DSC(s1,p1,l1,s2,p2,l2) \ F77_CHAR_ASS_DSC(s1,p1,l1) F77_CHAR_ASS_DSC(s2,p2,l2) #define F77_CHAR_USE2PTR(s1,p1,l1,s2,p2,l2) \ F77_CHAR_USE_PTR(s1,p1,l1),F77_CHAR_USE_PTR(s2,p2,l2) #define F77_CHAR_USE2LEN(s1,p1,l1,s2,p2,l2) \ F77_CHAR_USE_LEN(s1,p1,l1) F77_CHAR_USE_LEN(s2,p2,l2) #define F77_XXXX_USE2LEN(x1,x2) \ F77_XXXX_USE_LEN(x1) F77_XXXX_USE_LEN(x2) #define F77_CHAR_DEF3DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3) \ F77_CHAR_DEF2DSC(s1,p1,l1,s2,p2,l2) F77_CHAR_DEF_DSC(s3,p3,l3) #define F77_CHAR_ASS3DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3) \ F77_CHAR_ASS2DSC(s1,p1,l1,s2,p2,l2) F77_CHAR_ASS_DSC(s3,p3,l3) #define F77_CHAR_USE3PTR(s1,p1,l1,s2,p2,l2,s3,p3,l3) \ F77_CHAR_USE2PTR(s1,p1,l1,s2,p2,l2),F77_CHAR_USE_PTR(s3,p3,l3) #define F77_CHAR_USE3LEN(s1,p1,l1,s2,p2,l2,s3,p3,l3) \ F77_CHAR_USE2LEN(s1,p1,l1,s2,p2,l2) F77_CHAR_USE_LEN(s3,p3,l3) #define F77_XXXX_USE3LEN(x1,x2,x3) \ F77_XXXX_USE2LEN(x1,x2) F77_XXXX_USE_LEN(x3) #define F77_CHAR_DEF4DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3,s4,p4,l4) \ F77_CHAR_DEF3DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3) F77_CHAR_DEF_DSC(s4,p4,l4) #define F77_CHAR_ASS4DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3,s4,p4,l4) \ F77_CHAR_ASS3DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3) F77_CHAR_ASS_DSC(s4,p4,l4) #define F77_CHAR_USE4PTR(s1,p1,l1,s2,p2,l2,s3,p3,l3,s4,p4,l4) \ F77_CHAR_USE3PTR(s1,p1,l1,s2,p2,l2,s3,p3,l3),F77_CHAR_USE_PTR(s4,p4,l4) #define F77_CHAR_USE4LEN(s1,p1,l1,s2,p2,l2,s3,p3,l3,s4,p4,l4) \ F77_CHAR_USE3LEN(s1,p1,l1,s2,p2,l2,s3,p3,l3) F77_CHAR_USE_LEN(s4,p4,l4) #define F77_XXXX_USE4LEN(x1,x2,x3,x4) \ F77_XXXX_USE3LEN(x1,x2,x3) F77_XXXX_USE_LEN(x4) #define F77_XXXX_USE5LEN(x1,x2,x3,x4,x5) \ F77_XXXX_USE4LEN(x1,x2,x3,x4) F77_XXXX_USE_LEN(x5) #define F77_XXXX_USE6LEN(x1,x2,x3,x4,x5,x6) \ F77_XXXX_USE5LEN(x1,x2,x3,x4,x5) F77_XXXX_USE_LEN(x6) #define F77_XXXX_USE7LEN(x1,x2,x3,x4,x5,x6,x7) \ F77_XXXX_USE6LEN(x1,x2,x3,x4,x5,x6) F77_XXXX_USE_LEN(x7) #define F77_XXXX_USE8LEN(x1,x2,x3,x4,x5,x6,x7,x8) \ F77_XXXX_USE7LEN(x1,x2,x3,x4,x5,x6,x7) F77_XXXX_USE_LEN(x8) EXTERN INTEGER F77_i0; /* dummy */ #ifdef IBM370 #pragma linkage(K77C,FORTRAN) #define F77_IFUN_C(i0,name,p1,l1) do { \ i0 = K77C(&name,p1,l1); } while(0) #else #define F77_IFUN_C(i0,name,p1,l1) do { \ F77_CHAR_DEF_DSC(s1,p1,l1) \ F77_CHAR_ASS_DSC(s1,p1,l1) \ i0 = (*name)( \ F77_CHAR_USE_PTR(s1,p1,l1) \ F77_CHAR_USE_LEN(s1,p1,l1) \ ); } while(0) #endif #define F77_CALL_C(name,p1,l1) do { \ INT_FUNCPTR _p0_ = (INT_FUNCPTR)name; \ F77_IFUN_C(F77_i0,_p0_,p1,l1); \ } while(0) #ifdef IBM370 #pragma linkage(K77CC,FORTRAN) #define F77_IFUN_CC(i0,name,p1,l1,p2,l2) do { \ i0 = K77CC(&name,p1,l1,p2,l2); } while(0) #else #define F77_IFUN_CC(i0,name,p1,l1,p2,l2) do { \ F77_CHAR_DEF2DSC(s1,p1,l1,s2,p2,l2) \ F77_CHAR_ASS2DSC(s1,p1,l1,s2,p2,l2) \ i0 = (*name)( \ F77_CHAR_USE2PTR(s1,p1,l1,s2,p2,l2) \ F77_CHAR_USE2LEN(s1,p1,l1,s2,p2,l2) \ ); } while(0) #endif #define F77_CALL_CC(name,p1,l1,p2,l2) do { \ INT_FUNCPTR _p0_ = (INT_FUNCPTR)name; \ F77_IFUN_CC(F77_i0,_p0_,p1,l1,p2,l2); \ } while(0) #ifdef IBM370 #pragma linkage(K77C3,FORTRAN) #define F77_IFUN_C3(i0,name,p1,l1,p2,l2,p3,l3) do { \ i0 = K77C3(&name,p1,l1,p2,l2,p3,l3); } while(0) #else #define F77_IFUN_C3(i0,name,p1,l1,p2,l2,p3,l3) do { \ F77_CHAR_DEF3DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3) \ F77_CHAR_ASS3DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3) \ i0 = (*name)( \ F77_CHAR_USE3PTR(s1,p1,l1,s2,p2,l2,s3,p3,l3) \ F77_CHAR_USE3LEN(s1,p1,l1,s2,p2,l2,s3,p3,l3) \ ); } while(0) #endif #define F77_CALL_C3(name,p1,l1,p2,l2,p3,l3) do { \ INT_FUNCPTR _p0_ = (INT_FUNCPTR)name; \ F77_IFUN_C3(F77_i0,_p0_,p1,l1,p2,l2,p3,l3); \ } while(0) #ifdef IBM370 #pragma linkage(K77C7,FORTRAN) #define F77_IFUN_C7(i0,name,p1,l1,p2,l2,p3,l3,p4,l4,p5,l5,p6,l6,p7,l7) do { \ i0 = K77C7(&name,p1,l1,p2,l2,p3,l3,p4,l4,p5,l5,p6,l6,p7,l7); } while(0) #else #define F77_IFUN_C7(i0,name,p1,l1,p2,l2,p3,l3,p4,l4,p5,l5,p6,l6,p7,l7) do { \ F77_CHAR_DEF4DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3,s4,p4,l4) \ F77_CHAR_DEF3DSC(s5,p5,l5,s6,p6,l6,s7,p7,l7) \ F77_CHAR_ASS4DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3,s4,p4,l4) \ F77_CHAR_ASS3DSC(s5,p5,l5,s6,p6,l6,s7,p7,l7) \ i0 = (*name)( \ F77_CHAR_USE4PTR(s1,p1,l1,s2,p2,l2,s3,p3,l3,s4,p4,l4), \ F77_CHAR_USE3PTR(s5,p5,l5,s6,p6,l6,s7,p7,l7) \ F77_CHAR_USE4LEN(s1,p1,l1,s2,p2,l2,s3,p3,l3,s4,p4,l4) \ F77_CHAR_USE3LEN(s5,p5,l5,s6,p6,l6,s7,p7,l7) \ ); } while(0) #endif #define F77_CALL_C7(name,p1,l1,p2,l2,p3,l3,p4,l4,p5,l5,p6,l6,p7,l7) do { \ INT_FUNCPTR _p0_ = (INT_FUNCPTR)name; \ F77_IFUN_C7(F77_i0,_p0_,p1,l1,p2,l2,p3,l3,p4,l4,p5,l5,p6,l6,p7,l7); \ } while(0) #ifdef IBM370 #pragma linkage(K77CCx,FORTRAN) #define F77_CALL_CCx(name,p1,l1,p2,l2,x3) do { \ SUBROUTINE *F77 = name; \ K77CCx(&F77,p1,l1,p2,l2,x3); } while(0) #else #define F77_CALL_CCx(name,p1,l1,p2,l2,x3) do { \ F77_CHAR_DEF2DSC(s1,p1,l1,s2,p2,l2) \ F77_CHAR_ASS2DSC(s1,p1,l1,s2,p2,l2) \ name( F77_CHAR_USE2PTR(s1,p1,l1,s2,p2,l2), \ x3 \ F77_CHAR_USE2LEN(s1,p1,l1,s2,p2,l2) \ F77_XXXX_USE_LEN(x3) \ ); } while(0) #endif #ifdef IBM370 #pragma linkage(K77CCxx,FORTRAN) #define F77_IFUN_CCxx(i0,name,p1,l1,p2,l2,x3,x4) do { \ i0 = K77CCxx(&name,p1,l1,p2,l2,x3,x4); } while(0) #else #define F77_IFUN_CCxx(i0,name,p1,l1,p2,l2,x3,x4) do { \ F77_CHAR_DEF2DSC(s1,p1,l1,s2,p2,l2) \ F77_CHAR_ASS2DSC(s1,p1,l1,s2,p2,l2) \ i0 = (*name)( \ F77_CHAR_USE2PTR(s1,p1,l1,s2,p2,l2), \ x3,x4 \ F77_CHAR_USE2LEN(s1,p1,l1,s2,p2,l2) \ ); } while(0) #endif #define F77_CALL_CCxx(name,p1,l1,p2,l2,x3,x4) do { \ INT_FUNCPTR _p0_ = (INT_FUNCPTR)name; \ F77_IFUN_CCxx(F77_i0,_p0_,p1,l1,p2,l2,x3,x4); \ } while(0) #ifdef IBM370 #pragma linkage(K77CCx3,FORTRAN) #define F77_IFUN_CCx3(i0,name,p1,l1,p2,l2,x3,x4,x5) do { \ i0 = K77CCx3(&name,p1,l1,p2,l2,x3,x4,x5); } while(0) #else #define F77_IFUN_CCx3(i0,name,p1,l1,p2,l2,x3,x4,x5) do { \ F77_CHAR_DEF2DSC(s1,p1,l1,s2,p2,l2) \ F77_CHAR_ASS2DSC(s1,p1,l1,s2,p2,l2) \ i0 = (*name)( \ F77_CHAR_USE2PTR(s1,p1,l1,s2,p2,l2), \ x3,x4,x5 \ F77_CHAR_USE2LEN(s1,p1,l1,s2,p2,l2) \ ); } while(0) #endif #define F77_CALL_CCx3(name,p1,l1,p2,l2,x3,x4,x5) do { \ INT_FUNCPTR _p0_ = (INT_FUNCPTR)name; \ F77_IFUN_CCx3(F77_i0,_p0_,p1,l1,p2,l2,x3,x4,x5); \ } while(0) #ifdef IBM370 #pragma linkage(K77Cx,FORTRAN) #define F77_IFUN_Cx(i0,name,p1,l1,x2) do { \ i0 = K77Cx(&name,p1,l1,x2); } while(0) #else #define F77_IFUN_Cx(i0,name,p1,l1,x2) do { \ F77_CHAR_DEF_DSC(s1,p1,l1) \ F77_CHAR_ASS_DSC(s1,p1,l1) \ i0 = (*name)( \ F77_CHAR_USE_PTR(s1,p1,l1), \ x2 \ F77_CHAR_USE_LEN(s1,p1,l1) \ F77_XXXX_USE_LEN(x2) \ ); } while(0) #endif #define F77_CALL_Cx(name,p1,l1,x2) do { \ INT_FUNCPTR _p0_ = (INT_FUNCPTR)name; \ F77_IFUN_Cx(F77_i0,_p0_,p1,l1,x2); \ } while(0) #ifdef IBM370 #pragma linkage(K77CxC,FORTRAN) #define F77_CALL_CxC(name,p1,l1,x2,p3,l3) do { \ SUBROUTINE *F77 = name; \ K77CxC(&F77,p1,l1,x2,p3,l3); } while(0) #else #define F77_CALL_CxC(name,p1,l1,x2,p3,l3) do { \ F77_CHAR_DEF2DSC(s1,p1,l1,s3,p3,l3) \ F77_CHAR_ASS2DSC(s1,p1,l1,s3,p3,l3) \ name( F77_CHAR_USE_PTR(s1,p1,l1), \ x2, \ F77_CHAR_USE_PTR(s3,p3,l3) \ F77_CHAR_USE_LEN(s1,p1,l1) \ F77_XXXX_USE_LEN(x2) \ F77_CHAR_USE_LEN(s3,p3,l3) \ ); } while(0) #endif #ifdef IBM370 #pragma linkage(K77Cxx,FORTRAN) #define F77_CALL_Cxx(name,p1,l1,x2,x3) do { \ SUBROUTINE *F77 = name; \ K77Cxx(&F77,p1,l1,x2,x3); } while(0) #else #define F77_CALL_Cxx(name,p1,l1,x2,x3) do { \ F77_CHAR_DEF_DSC(s1,p1,l1) \ F77_CHAR_ASS_DSC(s1,p1,l1) \ name( F77_CHAR_USE_PTR(s1,p1,l1), \ x2,x3 \ F77_CHAR_USE_LEN(s1,p1,l1) \ F77_XXXX_USE2LEN(x2,x3) \ ); } while(0) #endif #ifdef IBM370 #pragma linkage(K77xC,FORTRAN) #define F77_CALL_xC(name,x1,p2,l2) do { \ SUBROUTINE *F77 = name; \ K77xC(&F77,x1,p2,l2); } while(0) #else #define F77_CALL_xC(name,x1,p2,l2) do { \ F77_CHAR_DEF_DSC(s2,p2,l2) \ F77_CHAR_ASS_DSC(s2,p2,l2) \ name( x1, \ F77_CHAR_USE_PTR(s2,p2,l2) \ F77_XXXX_USE_LEN(x1) \ F77_CHAR_USE_LEN(s2,p2,l2) \ ); } while(0) #endif #ifdef IBM370 #pragma linkage(K77xCCx,FORTRAN) #define F77_CALL_xCCx(name,x1,p2,l2,p3,l3,x4) do { \ SUBROUTINE *F77 = name; \ K77xCCx(&F77,x1,p2,l2,p3,l3,x4); } while(0) #else #define F77_CALL_xCCx(name,x1,p2,l2,p3,l3,x4) do { \ F77_CHAR_DEF2DSC(s2,p2,l2,s3,p3,l3) \ F77_CHAR_ASS2DSC(s2,p2,l2,s3,p3,l3) \ name( x1, \ F77_CHAR_USE2PTR(s2,p2,l2,s3,p3,l3), \ x4 \ F77_XXXX_USE_LEN(x1) \ F77_CHAR_USE2LEN(s2,p2,l2,s3,p3,l3) \ F77_XXXX_USE_LEN(x4) \ ); } while(0) #endif #ifdef IBM370 #pragma linkage(K77xCC,FORTRAN) #define F77_IFUN_xCC(i0,name,x1,p2,l2,p3,l3) do { \ i0 = K77xCC(&name,x1,p2,l2,p3,l3); } while(0) #else #define F77_IFUN_xCC(i0,name,x1,p2,l2,p3,l3) do { \ F77_CHAR_DEF2DSC(s2,p2,l2,s3,p3,l3) \ F77_CHAR_ASS2DSC(s2,p2,l2,s3,p3,l3) \ i0 = (*name)( x1, \ F77_CHAR_USE2PTR(s2,p2,l2,s3,p3,l3) \ F77_XXXX_USE_LEN(x1) \ F77_CHAR_USE2LEN(s2,p2,l2,s3,p3,l3) \ ); } while(0) #endif #define F77_CALL_xCC(name,x1,p2,l2,p3,l3) do { \ INT_FUNCPTR _p0_ = (INT_FUNCPTR)name; \ F77_IFUN_xCC(F77_i0,_p0_,x1,p2,l2,p3,l3); \ } while(0) #ifdef IBM370 #pragma linkage(K77xCx,FORTRAN) #define F77_IFUN_xCx(i0,name,x1,p2,l2,x3) do { \ i0 = K77xCx(&name,x1,p2,l2,x3); } while(0) #else #define F77_IFUN_xCx(i0,name,x1,p2,l2,x3) do { \ F77_CHAR_DEF_DSC(s2,p2,l2) \ F77_CHAR_ASS_DSC(s2,p2,l2) \ i0 = (*name)( x1, \ F77_CHAR_USE_PTR(s2,p2,l2), \ x3 \ F77_XXXX_USE_LEN(x1) \ F77_CHAR_USE_LEN(s2,p2,l2) \ F77_XXXX_USE_LEN(x3) \ ); } while(0) #endif #define F77_CALL_xCx(name,x1,p2,l2,x3) do { \ INT_FUNCPTR _p0_ = (INT_FUNCPTR)name; \ F77_IFUN_xCx(F77_i0,_p0_,x1,p2,l2,x3); \ } while(0) #ifdef IBM370 #pragma linkage(K77x4C,FORTRAN) #define F77_CALL_x4C(name,x1,x2,x3,x4,p5,l5) do { \ SUBROUTINE *F77 = name; \ K77x4C(&F77,x1,x2,x3,x4,p5,l5); } while(0) #else #define F77_CALL_x4C(name,x1,x2,x3,x4,p5,l5) do { \ F77_CHAR_DEF_DSC(s5,p5,l5) \ F77_CHAR_ASS_DSC(s5,p5,l5) \ name( x1,x2,x3,x4, \ F77_CHAR_USE_PTR(s5,p5,l5) \ F77_XXXX_USE4LEN(x1,x2,x3,x4) \ F77_CHAR_USE_LEN(s5,p5,l5) \ ); } while(0) #endif #ifdef IBM370 #pragma linkage(K77x4Cxx,FORTRAN) #define F77_CALL_x4Cxx(name,x1,x2,x3,x4,p5,l5,x6,x7) do { \ SUBROUTINE *F77 = name; \ K77x4Cxx(&F77,x1,x2,x3,x4,p5,l5,x6,x7); } while(0) #else #define F77_CALL_x4Cxx(name,x1,x2,x3,x4,p5,l5,x6,x7) do { \ F77_CHAR_DEF_DSC(s5,p5,l5) \ F77_CHAR_ASS_DSC(s5,p5,l5) \ name( x1,x2,x3,x4, \ F77_CHAR_USE_PTR(s5,p5,l5), \ x6,x7 \ F77_XXXX_USE4LEN(x1,x2,x3,x4) \ F77_CHAR_USE_LEN(s5,p5,l5) \ F77_XXXX_USE2LEN(x6,x7) \ ); } while(0) #endif #ifdef IBM370 #pragma linkage(KIGMENU,FORTRAN) /* 1 2 3 4 5 6 7 8 9 10 11 12 13 14 */ #define F77_CALL_xCx5CxC3xC(name,a,b,B,c,d,e,f,g,h,H,i,j,J,k,K,l,L,m,n,N) do {\ SUBROUTINE *F77 = name; \ KIGMENU(&F77,a,b,B,c,d,e,f,g,h,H,i,j,J,k,K,l,L,m,n,N); } while(0) #else #define F77_CALL_xCx5CxC3xC(name,a,b,B,c,d,e,f,g,h,H,i,j,J,k,K,l,L,m,n,N) do {\ F77_CHAR_DEF_DSC(sb,b,B) \ F77_CHAR_DEF_DSC(sh,h,H) \ F77_CHAR_DEF3DSC(sj,j,J,sk,k,K,sl,l,L) \ F77_CHAR_DEF_DSC(sn,n,N) \ F77_CHAR_ASS_DSC(sb,b,B) \ F77_CHAR_ASS_DSC(sh,h,H) \ F77_CHAR_ASS3DSC(sj,j,J,sk,k,K,sl,l,L) \ F77_CHAR_ASS_DSC(sn,n,N) \ name( a, \ F77_CHAR_USE_PTR(sb,b,B), \ c,d,e,f,g, \ F77_CHAR_USE_PTR(sh,h,H), \ i, \ F77_CHAR_USE3PTR(sj,j,J,sk,k,K,sl,l,L), \ m, \ F77_CHAR_USE_PTR(sn,n,N) \ F77_XXXX_USE_LEN(a) \ F77_CHAR_USE_LEN(sb,b,B) \ F77_XXXX_USE5LEN(c,d,e,f,g) \ F77_CHAR_USE_LEN(sh,h,H) \ F77_XXXX_USE_LEN(i) \ F77_CHAR_USE3LEN(sj,j,J,sk,k,K,sl,l,L) \ F77_XXXX_USE_LEN(m) \ F77_CHAR_USE_LEN(sn,n,N) \ ); } while(0) #endif #ifdef IBM370 #define F77_IFUN_x(i0,name,x1) i0 = __CTOF(name,x1) #else #define F77_IFUN_x(i0,name,x1) i0 = (*name)(x1) #endif #ifdef IBM370 #define F77_IFUN_xx(i0,name,x1,x2) i0 = __CTOF(name,x1,x2) #else #define F77_IFUN_xx(i0,name,x1,x2) i0 = (*name)(x1,x2) #endif #ifdef IBM370 #pragma linkage(K77xCx8,FORTRAN) #define F77_IFUN_xCx8(i0,name,x1,p2,l2,x3,x4,x5,x6,x7,x8,x9,x10) do { \ i0 = K77xCx8(&name,x1,p2,l2,x3,x4,x5,x6,x7,x8,x9,x10); } while(0) #else #define F77_IFUN_xCx8(i0,name,x1,p2,l2,x3,x4,x5,x6,x7,x8,x9,x10) do { \ F77_CHAR_DEF_DSC(s2,p2,l2) \ F77_CHAR_ASS_DSC(s2,p2,l2) \ i0 = (*name)( x1, \ F77_CHAR_USE_PTR(s2,p2,l2), \ x3,x4,x5,x6,x7,x8,x9,x10 \ F77_XXXX_USE_LEN(x1) \ F77_CHAR_USE_LEN(s2,p2,l2) \ F77_XXXX_USE8LEN(x3,x4,x5,x6,x7,x8,x9,x10) \ ); } while(0) #endif extern LOGICAL ku_true( int return_true ); /* * routines called by Fortran */ #define Errrun F77_NAME(errrun,ERRRUN) #define Fmemcpy F77_NAME(fmemcpy,FMEMCPY) #define Getarg F77_NAME(getarg,GETARG) extern SUBROUTINE Getarg; #define Goparm F77_NAME(goparm,GOPARM) extern SUBROUTINE Goparm; #define Iclrwk F77_NAME(iclrwk,ICLRWK) extern SUBROUTINE Iclrwk; #define Iginit F77_NAME(iginit,IGINIT) extern SUBROUTINE Iginit; #define Igmenu F77_NAME(igmenu,IGMENU) extern SUBROUTINE Igmenu; #define Igrng F77_NAME(igrng,IGRNG) extern SUBROUTINE Igrng; #define Igsse F77_NAME(igsse,IGSSE) extern SUBROUTINE Igsse; #define Igsrap F77_NAME(igsrap,IGSRAP) extern SUBROUTINE Igsrap; #define Igwkty F77_NAME(igwkty,IGWKTY) extern SUBROUTINE Igwkty; #define Kcexec F77_NAME(kcexec,KCEXEC) #define Kdialo F77_NAME(kdialo,KDIALO) extern SUBROUTINE Kdialo; #define Kgetar F77_NAME(kgetar,KGETAR) #define Kiargc F77_NAME(kiargc,KIARGC) extern INT_FUNCTION Kiargc; #define Kibres F77_NAME(kibres,KIBRES) extern SUBROUTINE Kibres; #define Kiclos F77_NAME(kiclos,KICLOS) extern SUBROUTINE Kiclos; #define Kicomv F77_NAME(kicomv,KICOMV) #define Kierrf F77_NAME(kierrf,KIERRF) extern SUBROUTINE Kierrf; #define Kiinit F77_NAME(kiinit,KIINIT) extern SUBROUTINE Kiinit; #define Kilun F77_NAME(kilun,KILUN) extern SUBROUTINE Kilun; #define Kipawc F77_NAME(kipawc,KIPAWC) #define Kipiaf F77_NAME(kipiaf,KIPIAF) #define Kiprmt F77_NAME(kiprmt,KIPRMT) #define Kirtim F77_NAME(kirtim,KIRTIM) #define Kisigm F77_NAME(kisigm,KISIGM) #define Kivect F77_NAME(kivect,KIVECT) #define Kmbrset F77_NAME(kmbrset,KMBRSET) #define Kmvsed F77_NAME(kmvsed,KMVSED) extern SUBROUTINE Kmvsed; #define Kmvspg F77_NAME(kmvspg,KMVSPG) extern SUBROUTINE Kmvspg; #define Kmvssh F77_NAME(kmvssh,KMVSSH) extern SUBROUTINE Kmvssh; #define Ksvpar F77_NAME(ksvpar,KSVPAR) #define Kuach F77_NAME(kuach,KUACH) #define Kuact F77_NAME(kuact,KUACT) #define Kualfa F77_NAME(kualfa,KUALFA) #define Kuappl F77_NAME(kuappl,KUAPPL) #define Kuargs F77_NAME(kuargs,KUARGS) #define Kubrek F77_NAME(kubrek,KUBREK) #define Kubrof F77_NAME(kubrof,KUBROF) #define Kubron F77_NAME(kubron,KUBRON) #define Kuclos F77_NAME(kuclos,KUCLOS) extern SUBROUTINE Kuclos; #define Kucmd F77_NAME(kucmd,KUCMD) #define Kucmdl F77_NAME(kucmdl,KUCMDL) #define Kucomv F77_NAME(kucomv,KUCOMV) #define Kuedit F77_NAME(kuedit,KUEDIT) #define Kuesvr F77_NAME(kuesvr,KUESVR) #define Kueusr F77_NAME(kueusr,KUEUSR) #define Kuexec F77_NAME(kuexec,KUEXEC) #define Kuexel F77_NAME(kuexel,KUEXEL) #define Kuexit F77_NAME(kuexit,KUEXIT) #define Kufcas F77_NAME(kufcas,KUFCAS) #define Kufdef F77_NAME(kufdef,KUFDEF) #define Kugetc F77_NAME(kugetc,KUGETC) #define Kugete F77_NAME(kugete,KUGETE) #define Kugetf F77_NAME(kugetf,KUGETF) #define Kugeti F77_NAME(kugeti,KUGETI) #define Kugetl F77_NAME(kugetl,KUGETL) #define Kugetr F77_NAME(kugetr,KUGETR) #define Kugets F77_NAME(kugets,KUGETS) #define Kugrfl F77_NAME(kugrfl,KUGRFL) #define Kuguid F77_NAME(kuguid,KUGUID) #define Kuhelp F77_NAME(kuhelp,KUHELP) #define Kuhome F77_NAME(kuhome,KUHOME) #define Kuidf1 F77_NAME(kuidf1,KUIDF1) extern SUBROUTINE Kuidf1; #define Kuidf2 F77_NAME(kuidf2,KUIDF2) extern SUBROUTINE Kuidf2; #define Kuidfm F77_NAME(kuidfm,KUIDFM) #define Kuinim F77_NAME(kuinim,KUINIM) #define Kuinit F77_NAME(kuinit,KUINIT) #define Kuinps F77_NAME(kuinps,KUINPS) #define Kuinqf F77_NAME(kuinqf,KUINQF) extern SUBROUTINE Kuinqf; #define Kulun F77_NAME(kulun,KULUN) #define Kumloc F77_NAME(kumloc,KUMLOC) #define Kumout F77_NAME(kumout,KUMOUT) #define Kundpv F77_NAME(kundpv,KUNDPV) #define Kunpar F77_NAME(kunpar,KUNPAR) #define Kunwg F77_NAME(kunwg,KUNWG) #define Kuopen F77_NAME(kuopen,KUOPEN) extern SUBROUTINE Kuopen; #define Kupad F77_NAME(kupad,KUPAD) #define Kupar F77_NAME(kupar,KUPAR) #define Kupath F77_NAME(kupath,KUPATH) #define Kupatl F77_NAME(kupatl,KUPATL) #define Kuproc F77_NAME(kuproc,KUPROC) #define Kuprof F77_NAME(kuprof,KUPROF) #define Kuproi F77_NAME(kuproi,KUPROI) #define Kuprop F77_NAME(kuprop,KUPROP) #define Kupror F77_NAME(kupror,KUPROR) #define Kupros F77_NAME(kupros,KUPROS) #define Kumess F77_NAME(kumess,KUMESS) #define Kupval F77_NAME(kupval,KUPVAL) #define Kuqcas F77_NAME(kuqcas,KUQCAS) #define Kuqenv F77_NAME(kuqenv,KUQENV) #define Kuqexe F77_NAME(kuqexe,KUQEXE) #define Kuqkey F77_NAME(kuqkey,KUQKEY) #define Kuqsvr F77_NAME(kuqsvr,KUQSVR) #define Kuquit F77_NAME(kuquit,KUQUIT) #define Kuqvar F77_NAME(kuqvar,KUQVAR) #define Kuread F77_NAME(kuread,KUREAD) extern SUBROUTINE Kuread; #define Kusapp F77_NAME(kusapp,KUSAPP) #define Kuser F77_NAME(kuser,KUSER) #define Kuserid F77_NAME(kuserid,KUSERID) #define Kusibr F77_NAME(kusibr,KUSIBR) #define Kusigm F77_NAME(kusigm,KUSIGM) #define Kuspy F77_NAME(kuspy,KUSPY) #define Kustat F77_NAME(kustat,KUSTAT) #define Kustop F77_NAME(kustop,KUSTOP) #define Kuterm F77_NAME(kuterm,KUTERM) #define Kutime F77_NAME(kutime,KUTIME) #define Kutim0 F77_NAME(kutim0,KUTIM0) extern SUBROUTINE Kutim0; #define Kutrue F77_NAME(kutrue,KUTRUE) #define Kuvar F77_NAME(kuvar,KUVAR) #define Kuvcre F77_NAME(kuvcre,KUVCRE) extern SUBROUTINE Kuvcre; #define Kuvdel F77_NAME(kuvdel,KUVDEL) extern SUBROUTINE Kuvdel; #define Kuvect F77_NAME(kuvect,KUVECT) extern SUBROUTINE Kuvect; #define Kuvnam F77_NAME(kuvnam,KUVNAM) #define Kuwhag F77_NAME(kuwhag,KUWHAG) #define Kuwham F77_NAME(kuwham,KUWHAM) #define Kuwhat F77_NAME(kuwhat,KUWHAT) #define Kuwrit F77_NAME(kuwrit,KUWRIT) extern SUBROUTINE Kuwrit; #define Kxcrv2 F77_NAME(kxcrv2,KXCRV2) extern SUBROUTINE Kxcrv2; #define Macdef F77_NAME(macdef,MACDEF) extern SUBROUTINE Macdef; #define Mdmenu F77_NAME(mdmenu,MDMENU) #define Mhi_close F77_NAME(mhi_close,MHI_CLOSE) extern SUBROUTINE Mhi_close; #define Mhi_open F77_NAME(mhi_open,MHI_OPEN) extern SUBROUTINE Mhi_open; #define Mzwipe F77_NAME(mzwipe,MZWIPE) extern SUBROUTINE Mzwipe; #define Traceq F77_NAME(traceq,TRACEQ) extern SUBROUTINE Traceq; #define Xuflow F77_NAME(xuflow,XUFLOW) extern SUBROUTINE Xuflow; #ifdef IBM370 # pragma linkage(ERRRUN,FORTRAN) # pragma linkage(FMEMCPY,FORTRAN) # pragma linkage(GOPARM,FORTRAN) # pragma linkage(ICLRWK,FORTRAN) # pragma linkage(IGINIT,FORTRAN) # pragma linkage(IGMENU,FORTRAN) # pragma linkage(IGRNG,FORTRAN) # pragma linkage(IGSSE,FORTRAN) # pragma linkage(IGSRAP,FORTRAN) # pragma linkage(IGWKTY,FORTRAN) # pragma linkage(KCEXEC,FORTRAN) # pragma linkage(KDIALO,FORTRAN) # pragma linkage(KGETAR,FORTRAN) # pragma linkage(KIBRES,FORTRAN) # pragma linkage(KICLOS,FORTRAN) # pragma linkage(KICOMV,FORTRAN) # pragma linkage(KIERRF,FORTRAN) # pragma linkage(KIINIT,FORTRAN) # pragma linkage(KILUN,FORTRAN) # pragma linkage(KIPAWC,FORTRAN) # pragma linkage(KIPIAF,FORTRAN) # pragma linkage(KIPRMT,FORTRAN) # pragma linkage(KIRTIM,FORTRAN) # pragma linkage(KISIGM,FORTRAN) # pragma linkage(KIVECT,FORTRAN) # pragma linkage(KMBRSET,FORTRAN) # pragma linkage(KMVSED,FORTRAN) # pragma linkage(KMVSPG,FORTRAN) # pragma linkage(KMVSSH,FORTRAN) # pragma linkage(KSVPAR,FORTRAN) # pragma linkage(KUACH,FORTRAN) # pragma linkage(KUACT,FORTRAN) # pragma linkage(KUALFA,FORTRAN) # pragma linkage(KUAPPL,FORTRAN) # pragma linkage(KUARGS,FORTRAN) # pragma linkage(KUBREK,FORTRAN) # pragma linkage(KUBROF,FORTRAN) # pragma linkage(KUBRON,FORTRAN) # pragma linkage(KUCLOS,FORTRAN) # pragma linkage(KUCMD,FORTRAN) # pragma linkage(KUCMDL,FORTRAN) # pragma linkage(KUCOMV,FORTRAN) # pragma linkage(KUEDIT,FORTRAN) # pragma linkage(KUESVR,FORTRAN) # pragma linkage(KUEUSR,FORTRAN) # pragma linkage(KUEXEC,FORTRAN) # pragma linkage(KUEXEL,FORTRAN) # pragma linkage(KUEXIT,FORTRAN) # pragma linkage(KUFCAS,FORTRAN) # pragma linkage(KUFDEF,FORTRAN) # pragma linkage(KUGETC,FORTRAN) # pragma linkage(KUGETE,FORTRAN) # pragma linkage(KUGETF,FORTRAN) # pragma linkage(KUGETI,FORTRAN) # pragma linkage(KUGETL,FORTRAN) # pragma linkage(KUGETR,FORTRAN) # pragma linkage(KUGETS,FORTRAN) # pragma linkage(KUGRFL,FORTRAN) # pragma linkage(KUGUID,FORTRAN) # pragma linkage(KUHELP,FORTRAN) # pragma linkage(KUHOME,FORTRAN) # pragma linkage(KUIDF1,FORTRAN) # pragma linkage(KUIDF2,FORTRAN) # pragma linkage(KUIDFM,FORTRAN) # pragma linkage(KUINIM,FORTRAN) # pragma linkage(KUINIT,FORTRAN) # pragma linkage(KUINPS,FORTRAN) # pragma linkage(KUINQF,FORTRAN) # pragma linkage(KULUN,FORTRAN) # pragma linkage(KUMLOC,FORTRAN) # pragma linkage(KUMOUT,FORTRAN) # pragma linkage(KUNDPV,FORTRAN) # pragma linkage(KUNPAR,FORTRAN) # pragma linkage(KUNWG,FORTRAN) # pragma linkage(KUOPEN,FORTRAN) # pragma linkage(KUPAD,FORTRAN) # pragma linkage(KUPAR,FORTRAN) # pragma linkage(KUPATH,FORTRAN) # pragma linkage(KUPATL,FORTRAN) # pragma linkage(KUPROC,FORTRAN) # pragma linkage(KUPROF,FORTRAN) # pragma linkage(KUPROI,FORTRAN) # pragma linkage(KUPROP,FORTRAN) # pragma linkage(KUPROR,FORTRAN) # pragma linkage(KUPROS,FORTRAN) # pragma linkage(KUPVAL,FORTRAN) # pragma linkage(KUQCAS,FORTRAN) # pragma linkage(KUQENV,FORTRAN) # pragma linkage(KUQEXE,FORTRAN) # pragma linkage(KUQKEY,FORTRAN) # pragma linkage(KUQSVR,FORTRAN) # pragma linkage(KUQUIT,FORTRAN) # pragma linkage(KUQVAR,FORTRAN) # pragma linkage(KUREAD,FORTRAN) # pragma linkage(KUSAPP,FORTRAN) # pragma linkage(KUSIBR,FORTRAN) # pragma linkage(KUSIGM,FORTRAN) # pragma linkage(KUSPY,FORTRAN) # pragma linkage(KUSTAT,FORTRAN) # pragma linkage(KUSTOP,FORTRAN) # pragma linkage(KUTERM,FORTRAN) # pragma linkage(KUTIME,FORTRAN) # pragma linkage(KUTIM0,FORTRAN) # pragma linkage(KUTRUE,FORTRAN) # pragma linkage(KUSER,FORTRAN) # pragma linkage(KUVAR,FORTRAN) # pragma linkage(KUVCRE,FORTRAN) # pragma linkage(KUVDEL,FORTRAN) # pragma linkage(KUVECT,FORTRAN) # pragma linkage(KUVNAM,FORTRAN) # pragma linkage(KUWHAG,FORTRAN) # pragma linkage(KUWHAM,FORTRAN) # pragma linkage(KUWHAT,FORTRAN) # pragma linkage(KUWRIT,FORTRAN) # pragma linkage(KXCRV2,FORTRAN) # pragma linkage(MACDEF,FORTRAN) # pragma linkage(MDMENU,FORTRAN) # pragma linkage(MHI_CLOSE,FORTRAN) # pragma linkage(MHI_OPEN,FORTRAN) # pragma linkage(MZWIPE,FORTRAN) # pragma linkage(TRACEQ,FORTRAN) # pragma linkage(XUFLOW,FORTRAN) #endif #define MAXCMD 512 /* max length of a command line */ #define MAXEDT 32 /* max length of names in edit server */ #define MAXLEV 10 /* max levels of command name path */ #define MAXSVR 20 /* max number of edit server processes */ /* * The PAWC common is referenced through a pointer to allow the use of * dynamic common blocks on IBM systems. */ #define Pawc kc_pawc EXTERN struct COMMON_PAWC { INTEGER NWPAR; INTEGER IXPAWC; INTEGER IHBOOK; INTEGER IXHIGZ; INTEGER IXKUIP; INTEGER IFENCE[5]; INTEGER LQ[8]; INTEGER DATA[999]; } *Pawc; #define IQ(n) Pawc->DATA[n-1] #define Q(n) (((REAL*)(Pawc->DATA))[n-1]) +KEEP,KCOM_H /* kcom.h: Fortran COMMON blocks */ #define Kcparc F77_BLOCK(kcparc,KCPARC) EXTERN struct { char PARLST[512]; /* interface block for KUSER */ char CLIST[80]; char NOALIN[512]; char COMAND[80]; char CHLAST[512]; char NONPOS[512]; } F77_COMMON(Kcparc); #define Kcutil F77_BLOCK(kcutil,KCUTIL) EXTERN struct { INTEGER NCMD; INTEGER IWD; INTEGER LUNFIL; INTEGER LPRMPT; LOGICAL TIMING; LOGICAL TRACE; INTEGER CALMOD; INTEGER NVADD; INTEGER IREPET; INTEGER IREFAC; INTEGER IBRAK; LOGICAL TIMALL; INTEGER LENTER; LOGICAL UNIQUE; INTEGER LENMUL; LOGICAL MULTFL; LOGICAL HISTOK; LOGICAL NOHIST; INTEGER LENMUM; LOGICAL FILCAS; LOGICAL MEXEFL; } F77_COMMON(Kcutil); #define Kcvect F77_BLOCK(kcvect,KCVECT) EXTERN struct { INTEGER NUMVEC; /* number of vectors stored */ INTEGER TOTPAV; INTEGER GETPAV; LOGICAL TVECFL; } F77_COMMON(Kcvect); #define Kcwork F77_BLOCK(kcwork,KCWORK) EXTERN struct { REAL VECTOR[100]; /* vector '?' */ } F77_COMMON(Kcwork); #define Quest F77_BLOCK(quest,QUEST) EXTERN struct { INTEGER DATA[100]; } F77_COMMON(Quest); #define IQUEST(n) Quest.DATA[n-1] #define Sikuip F77_BLOCK(sikuip,SIKUIP) EXTERN struct { char CHSIGM[80]; /* command string passed to SIGMA */ } F77_COMMON(Sikuip); +KEEP,KSIG_H /* ksig.h: signal and break handling */ /* * Available signal handling package * * #define SIGNAL_POSIX ==> sigaction() for Unix * #define SIGNAL_BSD ==> sigvec() for VMS and NeXT * #define SIGNAL_V7 ==> signal() */ #if !defined(SIGNAL_BSD) && !defined(SIGNAL_V7) # define SIGNAL_POSIX #else # define sigjmp_buf jmp_buf # define sigsetjmp(buf,save) setjmp(buf) # define siglongjmp(buf,val) longjmp(buf,val) # ifdef vms # define sv_flags sv_onstack # endif #endif EXTERN struct { int trap_enabled; /* flag if exceptions should be trapped */ int intr_enabled; /* flag if ^C delivery is allowed */ int intr_pending; /* flag if ^C happened while disabled */ int intr_count; /* count number of consecutive ^C interrupts */ int traceback; /* print traceback on signal */ char *error_msg; /* messages is handler cannot do print */ int soft_intr; /* flag to stop at a convenient point */ int jump_set; /* flag if stack has been setup */ sigjmp_buf stack; int sockfd; /* socket descriptor and routine to */ void (*piaf_sync)(); /* resynchronize Piaf communication */ } kc_break; +DECK,kuip_h. +seq,kuip_h. +DECK,kfor_h. +seq,kfor_h. +DECK,kcom_h. +seq,kcom_h. +DECK,ksig_h. +seq,ksig_h. +PATCH,MAIN,IF=MAIN_N,MAIN_K. +DECK,mn_main. PROGRAM MN_MAIN +SELF,IF=UNIX,IF=HPUX. CALL ERRREC +SELF. +SELF,IF=MAIN_K. CALL MN_CALL +SELF,IF=MAIN_N. CALL MN_FIT +SELF. END +PATCH,MAIN_CC,T=XCC,IF=MAIN_CC. +DECK,mn_main. +SELF,IF=PATCHY5. +INCLUDE,KUIP_H +INCLUDE,KFOR_H +INCLUDE,KCOM_H +INCLUDE,KSIG_H. +SELF,IF=-PATCHY5. +SEQ,KUIP_H +SEQ,KFOR_H +SEQ,KCOM_H +SEQ,KSIG_H. +SELF. main (argc, argv) int argc; char **argv; { void errrec(); void mn_call(void); +self,if=unix,if=hpux. errrec_ (); +self. mn_call (); exit (0); } +DECK,mn_call. void mn_call(void) { void m_start_(); int what_loop(void); void m_stop_(); m_start_ (); ku_trap( 1, -1); /* Install signal handler */ while( 1 ) { if( what_loop() == 1 ) break; else { /* this branch is for VMS exceptions only */ reset_break(); } } m_stop_ (); kc_break.jump_set = 0; ku_trap( 0, -1 ); /* remove signal handler */ ku_shut(); /* clean up the mess */ } int what_loop() { void m_run_(); #ifdef vms /* * The signal handler calls LIB$SIG_TO_RET which lets what_loop return * the error number ( 1 == SS$_NORMAL ) */ +SELF,IF=93D. VAXC$ESTABLISH( vms_signal_handler ); +SELF,IF=-93D. VAXC$ESTABLISH( signal_handler ); +SELF. #endif /* catch exceptions saving signal mask */ if( sigsetjmp( kc_break.stack, 1 ) != 0 ) { /* saving signal mask */ /* longjmp happened */ reset_break(); } kc_break.jump_set = 1; m_run_ (); kc_break.intr_count = 0; /* reset the ^C counter */ return 1; } +PATCH,MN_FIT. +DECK,hyf909. SUBROUTINE HYF909(INAME,ITYPE,IX,IDESC) DIMENSION IX(1) MAXI=999999999 MAXPOS=0 DO K=1,300 J=K-25 1 IF(IX(J+25).NE.0) THEN J=IX(J+25) IF(MOD(IX(J+1),10).EQ.ITYPE) THEN NAME=IX(J+1)/10 IF(NAME.GT.INAME.AND.NAME.LT.MAXI) THEN MAXI=NAME MAXPOS=J ENDIF GOTO 1 ENDIF ENDIF ENDDO INAME=MAXI IF(INAME.EQ.999999999) INAME=0 IDESC=MAXPOS RETURN END +DECK,hyfet. C--------------------------------- SUBROUTINE HYFET(NAME,ITYPE,NUMCAL,NUMBIN, * XYLO,XYHI,WTUNDR,WTINSD,WTOVER,TITLE,IERR) C DIMENSION NUMBIN(2),XYLO(2),XYHI(2) CHARACTER*(*) TITLE C +CDE,MNSCR. INTEGER IPTR,ISPACE(1),IDESC EQUIVALENCE(SCRATCH(1),IPTR) EQUIVALENCE(SCRATCH(2),ISPACE) EQUIVALENCE(SCRATCH(3),IDESC) C COMMON/MNSCR/IPTR,ISPACE(1),IDESC REAL SPACE(1) EQUIVALENCE (SPACE,ISPACE) C NAMEX=NAME*10+ITYPE NN1=NAMEX*17 IDESC=NN1-(NN1/300)*300-24 IERR=1 1 IDESC=ISPACE(IPTR+IDESC+25) IF(IDESC.EQ.0) RETURN IF(ISPACE(IPTR+IDESC+1).NE.NAMEX) GOTO 1 IERR=0 IF(ITYPE.EQ.1) THEN NUMBIN(1)=ISPACE(IPTR+IDESC+5) XYLO(1)=SPACE(IPTR+IDESC+3) XYHI(1)=XYLO(1)+NUMBIN(1)*SPACE(IPTR+IDESC+4) NUMCAL=ISPACE(IPTR+IDESC+10) WTUNDR=SPACE(IPTR+IDESC+12) WTOVER=SPACE(IPTR+IDESC+13) WTINSD=SPACE(IPTR+IDESC+11)-(WTUNDR+WTOVER) JT=ISPACE(IPTR+IDESC+7) ELSEIF(ITYPE.EQ.2) THEN NUMBIN(1)=ISPACE(IPTR+IDESC+5) NUMBIN(2)=ISPACE(IPTR+IDESC+8) XYLO(1)=SPACE(IPTR+IDESC+3) XYLO(2)=SPACE(IPTR+IDESC+6) XYHI(1)=XYLO(1)+NUMBIN(1)*SPACE(IPTR+IDESC+4) XYHI(2)=XYLO(2)+NUMBIN(2)*SPACE(IPTR+IDESC+7) NUMCAL=ISPACE(IPTR+IDESC+16) WTUNDR=0. WTOVER=SPACE(IPTR+IDESC+18) WTINSD=SPACE(IPTR+IDESC+17)-(WTUNDR+WTOVER) JT=ISPACE(IPTR+IDESC+11) ENDIF TITLE=' ' IF(JT.GT.0) THEN MK=0 JT=JT+IPTR 33 MK=MK+4 JT=JT+1 WRITE(TITLE(MK-3:MK),'(A4)') ISPACE(JT) IF(INDEX(TITLE(MK-3:MK),';').EQ.0) GOTO 33 JT=INDEX(TITLE(1:MK),';') TITLE(JT:)=' ' ENDIF END +DECK,hyfnxt. C--------------------------------- SUBROUTINE HYFNXT(INAME,ITYPE) C +CDE,MNSCR. INTEGER IPTR,ISPACE(1),IDESC EQUIVALENCE(SCRATCH(1),IPTR) EQUIVALENCE(SCRATCH(2),ISPACE) EQUIVALENCE(SCRATCH(3),IDESC) C COMMON/MNSCR/IPTR,ISPACE(1),IDESC REAL SPACE(1) EQUIVALENCE (SPACE,ISPACE) C CALL HYF909(INAME,ITYPE,ISPACE(IPTR+1),IDESC) RETURN END +DECK,hyread. SUBROUTINE HYREAD(IUNIT,IERR) C C ROUTINE FOR READING IN CHRIS RIPPICH'S HYBRID PLOTS C C C COMMON/MNSCR/IPTR,ISPACE(1) +CDE,MNSCR. INTEGER IPTR,ISPACE(1) EQUIVALENCE(SCRATCH(1),IPTR) EQUIVALENCE(SCRATCH(2),ISPACE) CCC COMMON/CXYHYZ/IX(300),NSPACE,NSTR,NEXT,NFIRST DIMENSION IX(304) C READ(IUNIT,ERR=99) IX NEXT=IX(303) CALL MN_ROM(NEXT,NGOT,IPTR) IF(NGOT.LT.NEXT.OR.IPTR.LE.0) GOTO 99 DO K=1,304 ISPACE(IPTR+K)=IX(K) ENDDO READ(IUNIT,ERR=99) (ISPACE(IPTR+K),K=305,NEXT) IERR=0 RETURN 99 IERR=1 RETURN END +DECK,hyupak. C------------------------------ SUBROUTINE HYUPAK(RDAT,WATMIN,WATMAX) C +CDE,MNSCR. INTEGER IPTR,ISPACE(1),IDESC EQUIVALENCE(SCRATCH(1),IPTR) EQUIVALENCE(SCRATCH(2),ISPACE) EQUIVALENCE(SCRATCH(3),IDESC) C COMMON/MNSCR/IPTR,ISPACE(1),IDESC REAL SPACE(1) EQUIVALENCE (SPACE,ISPACE) C CALL HYUPK1(RDAT,ISPACE(IPTR+1),ISPACE(IPTR+1),IDESC, * WATMIN,WATMAX) RETURN END +DECK,hyupk1. SUBROUTINE HYUPK1(RDAT,IX,X,IDESC,WATMIN,WATMAX) DIMENSION RDAT(1),IX(1),X(1) C ITYP=MOD(IX(IDESC+1),10) C C IF(ITYP.EQ.+1) THEN IP=IX(IDESC+6) NP=IX(IDESC+5) DO K=1,NP RDAT(K)=X(IP+K) ENDDO C ELSE C IP=IX(IDESC+10) C IF(IP.LT.0) THEN IP=-IP NP=IX(IDESC+9) DO K=1,NP RDAT(K)=X(IP+K) ENDDO C ELSE C NX=IX(IDESC+5) NY=IX(IDESC+8) NP=NX*NY DO K=1,NX*NY RDAT(K)=0. ENDDO 33 IF(IP.EQ.0) GOTO 34 IP1=IP+3 IP2=IP+IX(IP+1)*3 DO K=IP1,IP2,3 IBXY=IX(K) IBY=IBXY/1000 IBX=2*(IBXY-IBY*1000) RDAT((IBY-1)*NX+IBX+1)=X(K+1) RDAT((IBY-1)*NX+IBX+2)=X(K+2) ENDDO IP=IX(IP+2) GOTO 33 ENDIF ENDIF C 34 WATMIN=RDAT(1) WATMAX=RDAT(1) DO K=2,NP WATMIN=AMIN1(WATMIN,RDAT(K)) WATMAX=AMAX1(WATMAX,RDAT(K)) ENDDO RETURN END +DECK,mn_avf. SUBROUTINE MN_AVF(IDELIM) C implicit none C +CDE,MNPAR. +CDE,MNDAT. +CDE,MNFLG. +CDE,MNCMD. +CDE,MNLUN. C integer mpntmx PARAMETER (MPNTMX=20000) C COMMON/MNSCR/BUFDAT(MPNTMX) +CDE,MNSCR. REAL BUFDAT(MPNTMX) EQUIVALENCE(SCRATCH(1),BUFDAT(1)) C INTEGER IBFDAT(MPNTMX) EQUIVALENCE (BUFDAT,IBFDAT) C integer mavef PARAMETER (MAVEF=6) CHARACTER*1 AVENAM(MAVEF) C INTEGER IDBIN(2) REAL ADLO(2),ADHI(2) REAL ACONT(3**2) C CHARACTER*32 TNDEF(2) C CHARACTER*80 TITLE CHARACTER*132 ATEXT INTEGER IDLST1(MHSTMX),IDLST2(MHSTMX) LOGICAL QZERO * integer idelim,njunk,ndhis0,ierr,nidl,nidr,ida1,idb1,ida2,idb2 + ,nnid,ida,idb,lena,lent,lnblnk + ,idf,il,it,ntype,nbinx,nbiny,nnum,ndim,nwppt,nwrd,nbppt,nbppta + ,nwave,ibmsk,ii,jj,ncpos,indx,ind,ntmode,nh,nptrh,nptrd,nwh + ,n1,n2,n3,n4,npnt,nwpt,nline,nxb,nyb,nnxy,nptb,nptr + ,nw1,nw2,nb1,nshft,ient,nwdat,nwtot,nhdate,nhtime,nsdate,nstime real xflo,yflo,dfx,dfy,xxlo,xxhi,yylo,yyhi,x,dx,ee,dee + ,edlo,edhi,edent * integer inttyq,inttyp,nchscn real reltyp external inttyq,inttyp,nchscn,reltyp C DATA AVENAM/'*','/','+','%','&',' '/ DATA TNDEF/'X', 'Y'/ C +SELF,IF=UNIX,IF=LINUX. CALL MN_ERR('MN_AVF','Avehist files not supported under Linux') RETURN +SELF,IF=-UNIX,-LINUX. C IF(IDELIM.EQ.0) THEN NJUNK = INTTYQ(.TRUE.,IDELIM) CALL RESTYQ ENDIF C NDHIS0 = NDHIS C IF(FIL_AV.EQ.' ' .OR. 1 (IDELIM.GT.0 .AND. IDELIM.NE.ICHAR(':'))) THEN CALL MN_FIL(2,LUNAIN,FIL_AV,IDELIM,IERR) IF(IERR.NE.0) GOTO 9000 ELSE REWIND LUNAIN ENDIF C NIDL = 0 NIDR = 0 QZERO = .FALSE. 2000 CONTINUE CALL WAITYQ('Give histogram number(s): ') CALL MN_HRN(IDA1,IDA2,IDB1,IDB2,IDELIM,NNID) IF(NNID.LE.0) GOTO 8000 IF(NNID.GT.1) THEN CALL M_EMSG('MN_AVF','AVEHST does not know about' // 1 ' secondary identifiers') CALL MN_ERR('MN_AVF','It will be ignored') ENDIF C IF(NIDL.GE.100) THEN CALL M_EMSG('MN_AVF','Ran out of space to store plot' // 1 ' numbers to get') CALL MN_ERR('MN_AVF' + ,'Issue AVE_FETCH command again to get more plots.') GOTO 2200 ENDIF C IF(IDA1.EQ.0 .OR. IDA1.NE.IDA2) QZERO = .TRUE. NIDL = NIDL + 1 IDLST1(NIDL) = IDA1 IDLST2(NIDL) = IDA2 IF(IDELIM.GE.0) GOTO 2000 2200 CONTINUE IF(NIDL.LE.0) GOTO 8000 C C READ IN THE DATA C IDB = NDIDB 2500 CONTINUE READ(LUNAIN,'(A)',ERR=9100,END=2461) ATEXT LENA = LNBLNK(ATEXT) GOTO 2465 2461 CONTINUE IF(.NOT.QZERO) CALL MN_MES(LUNTTO,'ME',' End of file reached') GOTO 8000 C C SEE IF THIS IS THE HISTOGRAM DEFINITION CARD C 2465 CONTINUE C C Data - with a compressed file it can start in column 1 C IF(ATEXT(1:1).EQ.' ' .OR. + (ATEXT(1:1).GE.'0' .AND. ATEXT(1:1).LE.'9') .OR. + ATEXT(1:1).EQ.'-') THEN GOTO 2500 C C COMMENT CARD C ELSEIF(ATEXT(1:1).EQ.';') THEN GOTO 2500 ENDIF C C CARD MUST BE A HISTOGRAM DEFINITION CARD C CALL QUOTYP(ATEXT(2:LENA)) IDF = INTTYP(.TRUE.,IDELIM) IF(IDELIM.GT.0) GOTO 9100 CALL RESTYP CICB READ(ATEXT(2:),*,ERR=9100) IDF IF(IDLST1(1).NE.0) THEN DO 2470 IL=1,NIDL IF(IDLST1(IL).EQ.0 .OR. 1 (IDF.GE.IDLST1(IL) .AND. IDF.LE.IDLST2(IL))) THEN GOTO 2550 ENDIF 2470 CONTINUE GOTO 2500 ENDIF 2550 CONTINUE C C SEE IF THIS HISTOGRAM TYPE IS SUPPORTED C NTYPE = 0 DO 2560 IT=1,MAVEF-1 IF(ATEXT(1:1).EQ.AVENAM(IT)) THEN NTYPE = IT GOTO 2570 ENDIF 2560 CONTINUE CALL MN_ERR('MN_AVF','Histogram type ' // ATEXT(1:1) // + ' not supported') GOTO 6000 2570 CONTINUE C C TYPE 1 IS A HISTOGRAM WITHOUT ERROR BARS C TYPE 2 IS A HISTOGRAM WITH ERROR BARS C TYPE 3 IS A HISTOGRAM WITH ERROR BARS C TYPE 4 IS A VARIABLE BINNED HISTOGRAM C TYPE 5 IS A SCATTER PLOT C IF(NTYPE.LE.3) THEN C '(I,F,F,I,A)' 2600 IDA = INTTYP(.TRUE.,IDELIM) IF(IDELIM.GT.0) GOTO 9100 IF(IDA.EQ.0 .AND. NCHSCN().EQ.0) GOTO 2600 2610 XFLO = RELTYP(.TRUE.,IDELIM) IF(IDELIM.GT.0) GOTO 9100 IF(XFLO.EQ.0.0 .AND. NCHSCN().EQ.0) GOTO 2610 2620 DFX = RELTYP(.TRUE.,IDELIM) IF(IDELIM.GT.0) GOTO 9100 IF(DFX.EQ.0.0 .AND. NCHSCN().EQ.0) GOTO 2620 2630 NBINX = INTTYP(.TRUE.,IDELIM) IF(IDELIM.GT.0) GOTO 9100 IF(NBINX.EQ.0 .AND. NCHSCN().EQ.0) GOTO 2630 CICB READ(ATEXT(2:),*,ERR=9100) IDA,XFLO,DFX,NBINX NNUM = 4 NDIM = 1 NWPPT = 2 NWRD = NWPPT*NBINX ELSEIF(NTYPE.EQ.4) THEN C '(1X,I12,I12,A)' 2700 IDA = INTTYP(.TRUE.,IDELIM) IF(IDELIM.