1106 EMULATING OBJECT TECHNOLOGY IN NON-O-O ENVIRONMENTS $34.3 A Fortran routine and its entry points must be either all subroutines,or all functions.Here since EMPTY and /TEM must be functions,all other entries are also declared as functions, including M4KE whose result is useless. -IMPLEMENTATION OF ONE --REMOVE TOP ITEM A stack module C --ABSTRACT STACK OF REALS emulation in C ENTRY REMOVE (X Fortran INTEGER FUNCTION RSTACK IF (LAST .NE.0)THEN PARAMETER (SIZE=1000) REMOVE=.TRUE. C LAST=LAST-1 C --REPRESENTATION ELSE C REMOVE=.FALSE REAL IMPL (SIZE) END IF INTEGER LAST RETURN SAVE IMPL,LAST C C C --TOP ITEM C --ENTRY POINT DECLARATIONS C ENTRY ITEM( LOGICAL MAKE IF (LAST .NE.0)THEN LOGICAL PUT ITEM=IMPL (LAST) LOGICAL REMOVE ELSE REAL ITEM CALL ERROR LOGICAL EMPTY 兴 (ITEM:EMPTY STACK) C END IF REAL X RETURN C C C -STACK CREATION C --IS STACK EMPTY? C C ENTRY MAKE() ENTRY EMPTY ( MAKE=.TRUE. EMPTY=(LAST .EO.0) LAST=0 RETURN RETURN C C END C --PUSH AN ITEM C ENTRY PUT(X) IF (LAST .LT.SIZE)THEN PUT=.TRUE LAST=LAST +1 IMPL (LAST)=X ELSE PUT=.FALSE. END IF RETURN1106 EMULATING OBJECT TECHNOLOGY IN NON-O-O ENVIRONMENTS §34.3 A Fortran routine and its entry points must be either all subroutines, or all functions. Here since EMPTY and ITEM must be functions, all other entries are also declared as functions, including MAKE whose result is useless. C -- IMPLEMENTATION OF ONE C -- ABSTRACT STACK OF REALS C INTEGER FUNCTION RSTACK () PARAMETER (SIZE=1000) C C -- REPRESENTATION C REAL IMPL (SIZE) INTEGER LAST SAVE IMPL, LAST C C -- ENTRY POINT DECLARATIONS C LOGICAL MAKE LOGICAL PUT LOGICAL REMOVE REAL ITEM LOGICAL EMPTY C REAL X C C -- STACK CREATION C ENTRY MAKE () MAKE = .TRUE. LAST = 0 RETURN C C -- PUSH AN ITEM C ENTRY PUT (X) IF (LAST .LT. SIZE) THEN PUT = .TRUE. LAST = LAST + 1 IMPL (LAST) = X ELSE PUT = .FALSE. END IF RETURN C -- REMOVE TOP ITEM C ENTRY REMOVE (X) IF (LAST .NE. 0) THEN REMOVE = .TRUE. LAST = LAST – 1 ELSE REMOVE = .FALSE. END IF RETURN C C -- TOP ITEM C ENTRY ITEM () IF (LAST .NE. 0) THEN ITEM = IMPL (LAST) ELSE CALL ERROR ✽ ('ITEM: EMPTY STACK') END IF RETURN C C -- IS STACK EMPTY? C ENTRY EMPTY () EMPTY = (LAST .EQ. 0) RETURN C END A stack module emulation in Fortran