+- HP Forums (https://www.hpmuseum.org/forum)
+-- Forum: HP Software Libraries (/forum-10.html)
+--- Forum: HP Prime Software Library (/forum-15.html)
+--- Thread: FTN IO API (/thread-7606.html)
FTN IO API - StephenG1CMZ - 01-16-2017 05:53 PM
Some routines that might help parse Fortran-formatted data.
A work in progress that acts as a reminder of what popular formatting codes mean.
Parsing these comprehensively will never be completed, but some of the simpler formats are handled.
Just to be clear...
The aim is that if you read a data file specifying I8, you can call FTN-I(8) to read the number...
Not to parse FORMAT(I8) in the Fortran source.
RE: FTN IO API - StephenG1CMZ - 01-16-2017 05:55 PM
Version 0.001
Code:
//Fortran IO 2017 StephenG1CMZ
FTN_FMT_SP(); //FORWARD
FTN_FMT_SS(); //FORWARD
LOCAL SP:=" ";
LOCAL STMINUS:="-"; //IN IO TEXT MAY USE -
LOCAL STNEGATE:="−"; //WHEN PARSING USE NEGATE PLUSMINUS
LOCAL STMINUSES:=STMINUS+STNEGATE;
LOCAL STPLUSES :="+ ";
//CUSTOMISE
LOCAL FTN_SIGNALLING_NAN:=0; //
LOCAL AVOID_IE; //1 0 PREVENT EG 1ᴇ12 ON INTEGER OUT
//LOCAL STMINUSOUT:=STNEGATE;//USE THIS ON OUTPUT
LOCAL CHPLUS_DEFAULT:=FTN_FMT_SS(); //_SP OR _SS
LOCAL CHNEGS_DEFAULT:=STNEGATE; // NEGATE OR MINUS OUT
LOCAL LimRec:=128;//LIMIT RECURSION
//END CUSTOM
LOCAL STPOS;
LOCAL CHNEGS:=CHNEGS_DEFAULT;
LOCAL CHPLUS:=CHPLUS_DEFAULT;//CURRENT USAGE
LOCAL ZNaN;
NOTIMP()
BEGIN
MSGBOX("FTN: FMT NOT IMPLEMENTED");
END;
PAD(Ncopies,CH)
//GENERATE NN COPIES OF CH (CH NORMALLY 1CH)
BEGIN
LOCAL NN:=MIN(LimRec,Ncopies);//AVOID EXCESS RECURSION
//LOCAL ST:="";
//LOCAL COUNT:=NN;
RETURN IFTE(NN>0,CH+PAD(NN-1,CH),"");
END;
RAISE_NAN()
BEGIN
ZNaN:=ZNaN+1;
IF FTN_SIGNALLING_NAN THEN
MSGBOX("NaN:"+ZNaN);
END;
END;
PLAYFMT(RL,ST)
//JUST TRY SYNTAX
//RL:REAL
//ST:En or Fn or Sn
BEGIN
//LOCAL RL:=#2;
MSGBOX(CAS(format(RL,ST)));
RETURN 1;
END;
//SUPPLEMENTARY HANDLING
FTN_FMT_S()
//FTN: RESET SHOWPLUSSIGN (TO OUR CHOSEN DEFAULT DEFINED HERE)
//(APPLIES:MANTISSA; EE N/A)
BEGIN
CHPLUS:=CHPLUS_DEFAULT;
END;
FTN_FMT_SP()
//FTN: SET SHOWPLUSSIGN
BEGIN
CHPLUS:="+";
END;
FTN_FMT_SS()
//FTN:SUPPRESS SHOWPLUSSIGN
BEGIN
CHPLUS:=" ";
END;
FTN_FMT_IN_BLANK(ST)
//HANDLE BLANK CHARS ON INPUT
//HANDLE FMT BLANKS:B BN BZ
BEGIN
IF INSTRING(ST,"BZ") THEN
NOTIMP();
END;
END;
FTN_FMT_OUT_NUMSIGN(ST)
//HANDLE FMT SIGNS: S SP SS
//Z:NULL ST=RESET
//INSTRING DETECTION EG "I SP" OK
BEGIN
FTN_FMT_S();//SIGN: OUR SYSTEM DEFAULT
CASE
IF INSTRING(ST,"SP") THEN
FTN_FMT_SP();
END;
IF INSTRING(ST,"SS") THEN
FTN_FMT_SS();
END;
DEFAULT
END;
END;
EXPORT FTN_FMT_II (FWIDTH,STR)
//FTN: INPUT ST: INTEGER
//GET INTEGER FROM STR OF FWIDTH DIGITS
//FWIDTH:1..N INCLUDES SIGN
//FWIDTH 0:F90: PARSE INTEGER IN STR
//(SHOULD PARSE DIGITS. FOR NOW JUST EXPR ENTIRE STR)
//STR:INCLUDES INTEGER,SPACE=0,*=OVERFLOW IN STR FORMAT
BEGIN
LOCAL ST;
LOCAL INUM:=0;
LOCAL FW:=IP(FWIDTH);
FTN_FMT_IN_BLANK("");//WHERE TO GET INPUT FORMAT FROM?
//IGNORE WSP
ST:=REPLACE(STR,SP,"");
ST:=REPLACE(ST,STMINUS,STNEGATE);
IF SIZE(ST) THEN
IF FW THEN
ST:=MID(ST,FW);
END;
IF INSTRING(ST,"*") THEN
//NAN- 0
RAISE_NAN;
ELSE //ASSUME DECIMAL NUM
INUM:=EXPR(ST);
END;
ELSE //WSP==0
END;
RETURN IP(INUM);
END;
EXPORT FTN_FMT_A(FWIDTH,STR)
//FTN:IO AN ST: ALPHA STRNG WIDTH FW
//FTN:0: NO PADDING OR TRUNC
BEGIN
LOCAL FW:=IP(FWIDTH);
LOCAL ST:=IFTE(FW,MID(STR,1,FW),STR);//TRUNC
IF FW THEN
IF FW-DIM(STR)>0 THEN
//PAD TBD FW-LEN SP AT LEFT
ST:=ST;
END;
END;
RETURN ST;
END;
EXPORT FTN_FMT_I(FMTLST,INUM)
//FTN:OUTPUT ST: INTEGER
//FMTLST:"MAX.MIN" WIDTHS AS LIST
//F90: MAX 0=NO PADDING
//INUM:INTEGER
BEGIN
LOCAL SCHAR;
LOCAL ST:="";
LOCAL FMT_ST;//PARAM TBD
LOCAL FW:=0; //MAXWIDTH
LOCAL FM:=0; //MINWIDTH
//LOCAL FM:=5;//TEST
LOCAL NUM:=IP(INUM); //INGUARD
LOCAL POSNUM:=ABS(NUM);
LOCAL MODE_STD:=1; //STANDARD NUM FMT
IF SIZE(FMTLST) THEN
FMT_ST:=FMTLST(1);
FW:=IP(FMTLST(2));//MAXWIDTH
IF SIZE(FMTLST)>2 THEN
FM:=FMTLST(3);
END;
ELSE //EMPTY LIST:DEFAULTS?
END;
FTN_FMT_OUT_NUMSIGN(FMT_ST);
ST:=STRING(POSNUM,MODE_STD); //POSNUM
IF FM THEN //MIN FIELD WIDTH
ST:=PAD(FM-DIM(ST),"0")+ST; //INSERT LEADING ZEROS AS REQD
//POSNUM WITH ANY LEADING ZEROS
END;
IF (NUM≥0) AND (DIM(ST)==FW) THEN
SCHAR:=""; //SUPPRESS "+ " WHEN NEEDED TO FIT
ELSE
SCHAR:=IFTE(NUM≥0,CHPLUS,CHNEGS); //SELECT CURRENT SIGN
END;
ST:=SCHAR+ST;//SIGNED NUM WITH LEADING ZEROS
IF AVOID_IE AND INSTRING(ST,"ᴇ") THEN
//Bug: THE INSTRING HANDLES SYSTEMS LIKE HP
//WHICH DELIVER INTEGERS WITH EXPONENTS
//FORMATTED LIKE 1ᴇ12 IT MIGHT FIT
//NB THE POINT AT WHICH HP STRING(N) RETURNS 1ᴇ12
//IS GOVERNED BY N, IRRESPECTIVE OF FW
ST:=PAD(MAX(FW,1),"*"); //OVERFLOW:STR TOO LARGE FOR HP INTEGER
//IF FW 0 EMIT ONE *
END;
IF FW THEN //MAX FIELD WIDTH CHECKS
CASE
IF DIM(ST)>FW THEN
ST:=PAD(FW,"*"); //OVERFLOW
END;
IF DIM(ST)<FW THEN
ST:=PAD(FW-DIM(ST)," ")+ST; //PAD LEFT WITH SP
END;
DEFAULT
//FITTED JUST RIGHT
END;
END;
RETURN ST;
END;
EXPORT FTN_FMT_F()
//FTN:OUTPUT ST: REAL FLOATING
BEGIN
END;
EXPORT FTN_FMT_E()
//FTN:OUTPUT REAL EXPONENTIAL
BEGIN
END;
EXPORT FTN_FMT_G()
//FTN:OUTPUT GENERAL REAL (E/F PER SIZE)
BEGIN
END;
//END FTN FMT API
FTN_IO_RESET()
//OUR COMMAND: RESET FTN DEFAULTS
BEGIN
END;
EXPORT FTNIO()
BEGIN
STPOS:=1;
FTN_IO_RESET();
PLAYFMT(STPOS,"S0");
END;