/* FMS TEST */ TFMS: PROCEDURE OPTIONS(MAIN); DCL (FCLRSH,FSTAT,FSHOW,FLEN,FGET,FPFT,FLOPEN,FLCHAN) ENTRY OPTIONS(FORTRAN); DCL FINIT ENTRY(*,BIN(15),BIN(15)) OPTIONS(FORTRAN); DCL FIDATA ENTRY(BIN(15),*) OPTIONS(FORTRAN); DCL WTQIO ENTRY(BIN(15),BIN(15),BIN(15)); DCL FNDLUN ENTRY(FIXED BIN(15)); CALL WTQIO(768,5,5); DCL IMPURE CHAR(1000), V CHAR(10), (T,FMSLUN) FIXED BIN(15); DCL (STAT1,STAT2,STAT3,ISIZE) FIXED BIN(15); DCL LINE CHAR(80) VARYING, FORMLIB CHAR(50); DCL NULL CHAR(1) BASED(NULLPTR), NULLBYTE BIN(7) STATIC INITIAL(0); NULLPTR=ADDR(NULLBYTE); DCL ITRUE BIN INITIAL(1), IFALSE BIN INITIAL(0); YES: PROCEDURE(PROMPT) RETURNS(BIN); DCL PROMPT CHAR(*); DCL ANS CHAR(5); PUT SKIP LIST(PROMPT); GET LIST(ANS); IF SUBSTR(ANS,1,1)='Y' THEN RETURN(ITRUE); ELSE RETURN(IFALSE); END; IF YES('UNINITIALIZED IMPURE?')=ITRUE THEN CALL FCLRSH('WBMAIN'); IF YES('SET IMPURE SIZE?')=ITRUE THEN DO; GETSIZE: PUT SKIP LIST('SIZE(<=1000): '); GET LIST(ISIZE); CALL FINIT(IMPURE,ISIZE,STAT1); CALL FSTAT(STAT2,STAT3); PUT SKIP LIST('FINIT STATUS:',STAT1,STAT2,STAT3); IF STAT1<0 THEN GOTO GETSIZE; END; CALL FINIT(IMPURE,1000,T); IF YES('FLOPEN?')=ITRUE THEN DO; CALL FNDLUN(FMSLUN); CALL FLCHAN(FMSLUN); CALL FSTAT(STAT1); PUT SKIP LIST('FLCHAN STATUS:',STAT1); PUT SKIP LIST('FILE?'); GET LIST(LINE); FORMLIB=LINE!!NULL; CALL FLOPEN(FORMLIB); CALL FSTAT(STAT1,STAT2); PUT SKIP LIST('STATUS:',STAT1,STAT2); END; IF YES('FCLRSH?')=ITRUE THEN CALL FCLRSH('WBMAIN'); IF YES('WRONG # ARGS?')=ITRUE THEN CALL FCLRSH; CALL FGET(V,T,'CURPGM'); CALL FPUTL('RETURNED VALUE: '''!!V!!''''); IF YES('FGET 2 ARGS?')=ITRUE THEN CALL FGET(V,T); END;