11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 1 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00001 PROGRAM CALC2 00002 00003 C Calculator emulator (2-4-84 Greg Janee) 00004 C January, 1987 David Deley 00005 C June, 1988 David Deley 00006 C July, 1990 David Deley (add vt300 series) 00007 00008 EXTERNAL HANDLER 00009 00010 CHARACTER MODE*1,STRING*37 00011 LOGICAL BLACK,WHITE,ERROR,ERR_CHECK 00012 INTEGER DISPLAY1, DISPLAY2, DISPLAY3, DISPLAY4, DISPLAY5, 00013 * DISPLAY6 00014 INTEGER SMG$PUT_CHARS,TERM_CHAR, SMG$READ_KEYSTROKE,KEYBOARD1 00015 INTEGER KEY 00016 INTEGER SMG$CREATE_VIRTUAL_KEYBOARD 00017 00018 COMMON / DISP / ERROR,MODE,STRING 00019 COMMON / DISPLAYS / DISPLAY1,DISPLAY2,DISPLAY3,DISPLAY4,DISPLAY5, 00020 * DISPLAY6 00021 COMMON / ERROR / ERR_CHECK 00022 COMMON / STATE / WHITE,BLACK 00023 COMMON / KEYBOARD / KEYBOARD1 00024 COMMON / TERM / VT200 00025 00026 CALL LIB$ESTABLISH ( HANDLER ) 00027 CALL INITIALIZE 00028 00029 BLACK = .FALSE. 00030 WHITE = .FALSE. 00031 00032 C+ 00033 C Create a virtual keyboard. 00034 C- 00035 ISTATUS = SMG$CREATE_VIRTUAL_KEYBOARD ( KEYBOARD1) 00036 00037 C 00038 C --- MAIN LOOP -------------------------------------------------------- 00039 C 00040 00041 1000 CONTINUE 00042 00043 C+ 00044 C Read a key stroke from the virtual keyboard. 00045 C- 00046 CALL SMG$READ_KEYSTROKE ( KEYBOARD1, KEY ) 00047 ERR_CHECK = .FALSE. 00048 IF ( ERROR ) CALL ERR_HAND ( 0 ) 00049 CALL CASE( KEY ) 00050 GOTO 1000 00051 END CALC2 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 2 01 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 83 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 4 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 48 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD 3 DISP 42 PIC OVR REL GBL SHR NOEXE RD WRT QUAD 4 DISPLAYS 24 PIC OVR REL GBL SHR NOEXE RD WRT QUAD 5 ERROR 4 PIC OVR REL GBL SHR NOEXE RD WRT QUAD 6 STATE 8 PIC OVR REL GBL SHR NOEXE RD WRT QUAD 7 KEYBOARD 4 PIC OVR REL GBL SHR NOEXE RD WRT QUAD 8 TERM 4 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 221 ENTRY POINTS Address Type Name 0-00000000 CALC2 VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 6-00000004 L*4 BLACK 4-00000000 I*4 DISPLAY1 4-00000004 I*4 DISPLAY2 4-00000008 I*4 DISPLAY3 4-0000000C I*4 DISPLAY4 4-00000010 I*4 DISPLAY5 4-00000014 I*4 DISPLAY6 3-00000000 L*4 ERROR 5-00000000 L*4 ERR_CHECK ** I*4 ISTATUS 2-00000000 I*4 KEY 7-00000000 I*4 KEYBOARD1 3-00000004 CHAR MODE ** I*4 SMG$PUT_CHARS 3-00000005 CHAR STRING ** I*4 TERM_CHAR 8-00000000 R*4 VT200 6-00000000 L*4 WHITE LABELS Address Label 0-0000002C 1000 FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name CASE ERR_HAND HANDLER INITIALIZE LIB$ESTABLISH I*4 SMG$CREATE_VIRTUAL_KEYBOARD SMG$READ_KEYSTROKE 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 3 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00002 SUBROUTINE ABS_VALUE 00003 00004 C Calculates | X | 00005 00006 REAL*8 X,Y,Z,T,LASTX 00007 BYTE LAST 00008 LOGICAL PUSH_FLAG,RADS,D_OK 00009 00010 COMMON / STACK / X,Y,Z,T,LASTX,PUSH_FLAG,LAST,RADS,D_OK 00011 00012 IF ( .NOT.PUSH_FLAG ) CALL LOAD_X_REG 00013 00014 X = DABS( X ) 00015 00016 PUSH_FLAG = .TRUE. 00017 LAST = 0 00018 00019 CALL DISPLAY 00020 00021 RETURN 00022 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 56 PIC CON REL LCL SHR EXE RD NOWRT QUAD 3 STACK 53 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 109 ENTRY POINTS Address Type Name 0-00000000 ABS_VALUE VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 3-00000031 L*4 D_OK 3-0000002C L*1 LAST 3-00000020 R*8 LASTX 3-00000028 L*4 PUSH_FLAG 3-0000002D L*4 RADS 3-00000018 R*8 T 3-00000000 R*8 X 3-00000008 R*8 Y 3-00000010 R*8 Z ABS_VALUE 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 4 01 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name R*8 DABS DISPLAY LOAD_X_REG 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 5 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00002 SUBROUTINE ADD 00003 00004 C Adds the Y register to the X register 00005 00006 REAL*8 X,Y,Z,T,LASTX 00007 BYTE LAST 00008 LOGICAL PUSH_FLAG,RADS,D_OK 00009 00010 COMMON / STACK / X,Y,Z,T,LASTX,PUSH_FLAG,LAST,RADS,D_OK 00011 00012 C Load the X register if necessary 00013 00014 IF ( .NOT.PUSH_FLAG ) CALL LOAD_X_REG 00015 00016 X = X + Y 00017 Y = Z 00018 Z = T 00019 T = 0. 00020 00021 PUSH_FLAG = .TRUE. 00022 LAST = 0 00023 00024 CALL DISPLAY 00025 00026 RETURN 00027 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 52 PIC CON REL LCL SHR EXE RD NOWRT QUAD 3 STACK 53 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 105 ENTRY POINTS Address Type Name 0-00000000 ADD VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 3-00000031 L*4 D_OK 3-0000002C L*1 LAST 3-00000020 R*8 LASTX 3-00000028 L*4 PUSH_FLAG 3-0000002D L*4 RADS 3-00000018 R*8 T 3-00000000 R*8 X 3-00000008 R*8 Y 3-00000010 R*8 Z ADD 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 6 01 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name DISPLAY LOAD_X_REG 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 7 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00002 SUBROUTINE ADD_DIGIT ( DIGIT ) 00003 00004 C Adds a digit to the current display 00005 00006 PARAMETER CARR_RETURN = '0000000D'X 00007 00008 REAL*8 X,Y,Z,T,LASTX 00009 BYTE LAST 00010 CHARACTER STRING*37,DIGIT*1,MODE*1 00011 LOGICAL PUSH_FLAG,ERROR,RADS,D_OK 00012 INTEGER DISPLAY1, DISPLAY2, DISPLAY3, DISPLAY4, DISPLAY5, 00013 * DISPLAY6 00014 00015 COMMON / DISP / ERROR,MODE,STRING 00016 COMMON / STACK / X,Y,Z,T,LASTX,PUSH_FLAG,LAST,RADS,D_OK 00017 COMMON / DISPLAYS / DISPLAY1,DISPLAY2,DISPLAY3,DISPLAY4,DISPLAY5, 00018 * DISPLAY6 00019 00020 IF ( LAST .EQ. CARR_RETURN ) THEN 00021 X = 0. 00022 STRING = ' ' 00023 ISTATUS = SMG$PUT_CHARS( DISPLAY1, STRING, 2, 3) 00024 CALL MOVE_TO ( 24,1 ) 00025 END IF 00026 00027 IF ( PUSH_FLAG ) THEN 00028 CALL PUSH_STACK 00029 STRING = ' ' 00030 ISTATUS = SMG$PUT_CHARS( DISPLAY1, STRING, 2, 3) 00031 CALL MOVE_TO ( 24,1 ) 00032 PUSH_FLAG = .FALSE. 00033 END IF 00034 00035 IF ( STRING(1:1) .NE. ' ' ) THEN 00036 CALL ERR_HAND ( -5 ) 00037 ELSE 00038 STRING = STRING(2:37)//DIGIT 00039 ISTATUS = SMG$PUT_CHARS( DISPLAY1, STRING, 2, 3) 00040 CALL MOVE_TO ( 24,1 ) 00041 D_OK = .TRUE. 00042 END IF 00043 00044 LAST = 0 00045 00046 RETURN 00047 END ADD_DIGIT 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 8 01 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 180 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 20 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 120 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD 3 DISP 42 PIC OVR REL GBL SHR NOEXE RD WRT QUAD 4 STACK 53 PIC OVR REL GBL SHR NOEXE RD WRT QUAD 5 DISPLAYS 24 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 439 ENTRY POINTS Address Type Name 0-00000000 ADD_DIGIT VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name AP-00000004@ CHAR DIGIT 5-00000000 I*4 DISPLAY1 5-00000004 I*4 DISPLAY2 5-00000008 I*4 DISPLAY3 5-0000000C I*4 DISPLAY4 5-00000010 I*4 DISPLAY5 5-00000014 I*4 DISPLAY6 4-00000031 L*4 D_OK 3-00000000 L*4 ERROR ** I*4 ISTATUS 4-0000002C L*1 LAST 4-00000020 R*8 LASTX 3-00000004 CHAR MODE 4-00000028 L*4 PUSH_FLAG 4-0000002D L*4 RADS 3-00000005 CHAR STRING 4-00000018 R*8 T 4-00000000 R*8 X 4-00000008 R*8 Y 4-00000010 R*8 Z FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name Type Name ERR_HAND MOVE_TO PUSH_STACK R*4 SMG$PUT_CHARS 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 9 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00001 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 10 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00003 SUBROUTINE ARC_COSINE 00004 00005 C Calculates ARCCOS( X ) 00006 00007 REAL*8 X,Y,Z,T,LASTX 00008 BYTE LAST 00009 LOGICAL PUSH_FLAG,RADS,D_OK 00010 00011 COMMON / STACK / X,Y,Z,T,LASTX,PUSH_FLAG,LAST,RADS,D_OK 00012 00013 IF ( .NOT.PUSH_FLAG ) CALL LOAD_X_REG 00014 00015 IF ( RADS ) THEN 00016 X = DACOS( X ) 00017 ELSE 00018 X = DACOSD( X ) 00019 END IF 00020 00021 PUSH_FLAG = .TRUE. 00022 LAST = 0 00023 00024 CALL DISPLAY 00025 00026 RETURN 00027 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 67 PIC CON REL LCL SHR EXE RD NOWRT QUAD 3 STACK 53 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 120 ENTRY POINTS Address Type Name 0-00000000 ARC_COSINE VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 3-00000031 L*4 D_OK 3-0000002C L*1 LAST 3-00000020 R*8 LASTX 3-00000028 L*4 PUSH_FLAG 3-0000002D L*4 RADS 3-00000018 R*8 T 3-00000000 R*8 X 3-00000008 R*8 Y 3-00000010 R*8 Z ARC_COSINE 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 11 01 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name Type Name R*8 DACOS R*8 DACOSD DISPLAY LOAD_X_REG 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 12 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00002 SUBROUTINE ARC_SINE 00003 00004 C Calculates ARCSIN( X ) 00005 00006 REAL*8 X,Y,Z,T,LASTX 00007 BYTE LAST 00008 LOGICAL PUSH_FLAG,RADS,D_OK 00009 00010 COMMON / STACK / X,Y,Z,T,LASTX,PUSH_FLAG,LAST,RADS,D_OK 00011 00012 IF ( .NOT.PUSH_FLAG ) CALL LOAD_X_REG 00013 00014 IF ( RADS ) THEN 00015 X = DASIN( X ) 00016 ELSE 00017 X = DASIND( X ) 00018 END IF 00019 00020 PUSH_FLAG = .TRUE. 00021 LAST = 0 00022 00023 CALL DISPLAY 00024 00025 RETURN 00026 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 67 PIC CON REL LCL SHR EXE RD NOWRT QUAD 3 STACK 53 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 120 ENTRY POINTS Address Type Name 0-00000000 ARC_SINE VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 3-00000031 L*4 D_OK 3-0000002C L*1 LAST 3-00000020 R*8 LASTX 3-00000028 L*4 PUSH_FLAG 3-0000002D L*4 RADS 3-00000018 R*8 T 3-00000000 R*8 X 3-00000008 R*8 Y 3-00000010 R*8 Z ARC_SINE 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 13 01 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name Type Name R*8 DASIN R*8 DASIND DISPLAY LOAD_X_REG 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 14 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00002 SUBROUTINE ARC_TANGENT 00003 00004 C Calculates ARCTAN( X ) 00005 00006 REAL*8 X,Y,Z,T,LASTX 00007 BYTE LAST 00008 LOGICAL PUSH_FLAG,RADS,D_OK 00009 00010 COMMON / STACK / X,Y,Z,T,LASTX,PUSH_FLAG,LAST,RADS,D_OK 00011 00012 IF ( .NOT.PUSH_FLAG ) CALL LOAD_X_REG 00013 00014 IF ( RADS ) THEN 00015 X = DATAN( X ) 00016 ELSE 00017 X = DATAND( X ) 00018 END IF 00019 00020 PUSH_FLAG = .TRUE. 00021 LAST = 0 00022 00023 CALL DISPLAY 00024 00025 RETURN 00026 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 67 PIC CON REL LCL SHR EXE RD NOWRT QUAD 3 STACK 53 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 120 ENTRY POINTS Address Type Name 0-00000000 ARC_TANGENT VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 3-00000031 L*4 D_OK 3-0000002C L*1 LAST 3-00000020 R*8 LASTX 3-00000028 L*4 PUSH_FLAG 3-0000002D L*4 RADS 3-00000018 R*8 T 3-00000000 R*8 X 3-00000008 R*8 Y 3-00000010 R*8 Z ARC_TANGENT 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 15 01 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name Type Name R*8 DATAN R*8 DATAND DISPLAY LOAD_X_REG 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 16 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00002 SUBROUTINE CASE(KEY) 00003 00004 LOGICAL BLACK,WHITE 00005 INTEGER KEY, DISPLAY1, DISPLAY2, DISPLAY3, DISPLAY4, DISPLAY5, 00006 * DISPLAY6 00007 CHARACTER*1 CHARACTER, INPUT 00008 COMMON / STATE / WHITE,BLACK 00009 COMMON / DISPLAYS / DISPLAY1,DISPLAY2,DISPLAY3,DISPLAY4, 00010 * DISPLAY5,DISPLAY6 00011 INCLUDE '($SMGDEF)' 00889 C PARAMETER SMG$K_TRM_EXCLAMATION_POINT = '00000021'X ! ! 00890 C PARAMETER SMG$K_TRM_LEFT_PAREN = '00000028'X ! ( 00891 C PARAMETER SMG$K_TRM_RIGHT_PAREN = '00000029'X ! ) 00892 C PARAMETER SMG$K_TRM_PLUS_SIGN = '0000002B'X ! + 00893 C PARAMETER SMG$K_TRM_ZERO = '00000030'X ! 0 00894 CASE 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 17 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00896 IF ( BLACK ) THEN 00897 C ****************************************************************** 00898 C ****************** IF STATE BLACK ******************************** 00899 C ****************************************************************** 00900 00901 C -------------- CONTROL CHARACTERS 000 - 031 --------------------- 00902 IF ( KEY .LT. SMG$K_TRM_SPACE ) THEN !CONTROL CHARACTERS 00903 00904 IF ( KEY .EQ. SMG$K_TRM_CTRLR ) THEN 00905 CALL RESET 00906 ELSEIF ( KEY .EQ. SMG$K_TRM_CTRLW ) THEN 00907 CALL RESET 00908 ELSEIF ( KEY .EQ. SMG$K_TRM_CTRLZ ) THEN 00909 CALL CLEAR_SCREEN 00910 CALL SYS$EXIT (%VAL(1) ) 00911 ENDIF 00912 00913 00914 C -------------MISCELANEOUS !"#$%&'()*+,-./ ------------------------ 00915 ELSEIF ( KEY .LT. SMG$K_TRM_ZERO ) THEN !MISC 00916 00917 00918 C --------------- NUMBERS 0-9 -------------------------------------- 00919 ELSEIF ( KEY .LE. SMG$K_TRM_NINE ) THEN !NUMBERS 00920 00921 00922 C ------------- MISCELLANEOUS :;<=>?@ ------------------------------ 00923 ELSEIF ( KEY .LT. SMG$K_TRM_UPPERCASE_A) THEN !MISC 00924 00925 00926 C -------------- LETTERS A-Z --------------------------------------- 00927 ELSEIF ( KEY .LE. SMG$K_TRM_UPPERCASE_Z) THEN !UPPERCAE ALPHABET 00928 00929 00930 C ---------------- MISCELANEOUS [\]^_` ----------------------------- 00931 ELSEIF ( KEY .LT. SMG$K_TRM_LOWERCASE_A) THEN !MISC 00932 00933 00934 C ---------------- lowercase letters a-z --------------------------- 00935 ELSEIF ( KEY .LE. SMG$K_TRM_LOWERCASE_Z) THEN !lowercase alphabet 00936 00937 00938 C ----------------- MISCELLANEOUS {|}~ del ------------------------- 00939 ELSEIF ( KEY .LT. SMG$K_TRM_PF1) THEN !MISC 00940 00941 00942 C ------------------ KEYPAD PF1-PF4 -------------------------------- 00943 ELSEIF ( KEY .LE. SMG$K_TRM_PF4) THEN !PF1-PF4 00944 00945 IF ( KEY .EQ. SMG$K_TRM_PF1 ) THEN 00946 BLACK = .TRUE. 00947 CALL SMG$PUT_CHARS( DISPLAY4, 'B', 2, 28) 00948 CALL MOVE_TO ( 24,1 ) 00949 ELSEIF ( KEY .EQ. SMG$K_TRM_PF2 ) THEN 00950 WHITE = .TRUE. 00951 CALL SMG$PUT_CHARS( DISPLAY4, 'W', 2, 31) CASE 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 18 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00952 CALL MOVE_TO ( 24,1 ) 00953 ELSEIF ( KEY .EQ. SMG$K_TRM_PF3 ) THEN 00954 CALL LOG_10 00955 ELSEIF ( KEY .EQ. SMG$K_TRM_PF4 ) THEN 00956 CALL LOG_E 00957 ENDIF 00958 00959 00960 C --------------------- KEYPAD 0-9 --------------------------------- 00961 ELSEIF ( KEY .LE. SMG$K_TRM_KP9) THEN !KP0-KP9 00962 00963 IF ( KEY .EQ. SMG$K_TRM_KP0) THEN 00964 CALL CLEAR_X_REG 00965 ELSEIF ( KEY .EQ. SMG$K_TRM_KP1) THEN 00966 CALL ROLL_DOWN 00967 ELSEIF ( KEY .EQ. SMG$K_TRM_KP2) THEN 00968 CALL OUT_CHAR ( 8,71,1,'Q' ) 00969 CALL ERR_HAND ( -1 ) 00970 CALL GET_INPUT ( INPUT ) 00971 CALL FIX ( INPUT ) 00972 CALL OUT_CHAR ( 8,71,1,' ' ) 00973 ELSEIF ( KEY .EQ. SMG$K_TRM_KP3) THEN 00974 CALL LAST_X 00975 ELSEIF ( KEY .EQ. SMG$K_TRM_KP4) THEN 00976 CALL SQUARE_ROOT 00977 ELSEIF ( KEY .EQ. SMG$K_TRM_KP5) THEN 00978 CALL INVERT 00979 ELSEIF ( KEY .EQ. SMG$K_TRM_KP6) THEN 00980 CALL CHANGE_SIGN 00981 ELSEIF ( KEY .EQ. SMG$K_TRM_KP7) THEN 00982 CALL SINE 00983 ELSEIF ( KEY .EQ. SMG$K_TRM_KP8) THEN 00984 CALL COSINE 00985 ELSEIF ( KEY .EQ. SMG$K_TRM_KP9) THEN 00986 CALL TANGENT 00987 END IF 00988 00989 00990 C --------------------- MISCELLANEOUS ------------------------------ 00991 ELSEIF ( KEY .LT. SMG$K_TRM_F1) THEN !MISC 00992 00993 IF (KEY .EQ. SMG$K_TRM_ENTER ) THEN 00994 C CALL OUT_CHAR ( 8,71,1,'Q' ) 00995 C CALL ERR_HAND ( -2 ) 00996 C CALL GET_INPUT ( INPUT ) 00997 C CALL HELP ( INPUT ) 00998 ELSEIF ( KEY .EQ. SMG$K_TRM_MINUS ) THEN 00999 CALL CHANGE_TRIG ( 'RAD',1 ) 01000 ELSEIF ( KEY .EQ. SMG$K_TRM_COMMA ) THEN 01001 CALL INTEGER 01002 ELSEIF ( KEY .EQ. SMG$K_TRM_PERIOD ) THEN 01003 CALL PI 01004 ELSEIF ( KEY .EQ. SMG$K_TRM_UP ) THEN 01005 CALL ADD 01006 ELSEIF ( KEY .EQ. SMG$K_TRM_DOWN ) THEN 01007 CALL SUBTRACT 01008 ELSEIF ( KEY .EQ. SMG$K_TRM_LEFT ) THEN CASE 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 19 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 01009 CALL MULTIPLY 01010 ELSEIF ( KEY .EQ. SMG$K_TRM_RIGHT ) THEN 01011 CALL DIVIDE 01012 ENDIF 01013 01014 01015 C -------------- END CASE IF BLACK --------------------------------- 01016 ELSE 01017 CALL ERR_HAND ( -3 ) 01018 END IF 01019 BLACK = .FALSE. 01020 ISTATUS = SMG$PUT_CHARS( DISPLAY4, ' ', 2, 28) 01021 CALL MOVE_TO ( 24,1 ) 01022 01023 CASE 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 20 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 01025 ELSEIF ( WHITE ) THEN 01026 C ****************************************************************** 01027 C ****************** IF STATE WHITE ******************************** 01028 C ****************************************************************** 01029 01030 C -------------- CONTROL CHARACTERS 000 - 031 --------------------- 01031 IF ( KEY .LT. SMG$K_TRM_SPACE ) THEN !CONTROL CHARACTERS 01032 01033 IF ( KEY .EQ. SMG$K_TRM_CR ) THEN 01034 CALL CLEAR_SCREEN 01035 CALL SYS$EXIT ( %VAL(1) ) 01036 ELSEIF ( KEY .EQ. SMG$K_TRM_CTRLR ) THEN 01037 CALL RESET 01038 ELSEIF ( KEY .EQ. SMG$K_TRM_CTRLW ) THEN 01039 CALL RESET 01040 ELSEIF ( KEY .EQ. SMG$K_TRM_CTRLZ ) THEN 01041 CALL CLEAR_SCREEN 01042 CALL SYS$EXIT (%VAL(1) ) 01043 ENDIF 01044 01045 01046 C -------------MISCELANEOUS !"#$%&'()*+,-./ ------------------------ 01047 ELSEIF ( KEY .LT. SMG$K_TRM_ZERO ) THEN !MISC 01048 01049 01050 C --------------- NUMBERS 0-9 -------------------------------------- 01051 ELSEIF (KEY .LE. SMG$K_TRM_NINE) THEN !NUMBERS 01052 01053 01054 C ------------- MISCELLANEOUS :;<=>?@ ------------------------------ 01055 ELSEIF ( KEY .LT. SMG$K_TRM_UPPERCASE_A) THEN !MISC 01056 01057 01058 C -------------- LETTERS A-Z --------------------------------------- 01059 ELSEIF ( KEY .LE. SMG$K_TRM_UPPERCASE_Z ) THEN !UPPERCAE ALPHABET 01060 01061 01062 C ---------------- MISCELANEOUS [\]^_` ----------------------------- 01063 ELSEIF ( KEY .LT. SMG$K_TRM_LOWERCASE_A ) THEN !MISC 01064 01065 01066 C ---------------- lowercase letters a-z --------------------------- 01067 ELSEIF ( KEY .LE. SMG$K_TRM_LOWERCASE_Z) THEN !lowercase alphabet 01068 01069 01070 C ----------------- MISCELLANEOUS {|}~ del ------------------------- 01071 ELSEIF ( KEY .LT. SMG$K_TRM_PF1 ) THEN !MISC 01072 01073 01074 C ------------------ KEYPAD PF1-PF4 -------------------------------- 01075 ELSEIF ( KEY .LE. SMG$K_TRM_PF4) THEN !PF1-PF4 01076 01077 IF ( KEY .EQ. SMG$K_TRM_PF1 ) THEN 01078 BLACK = .TRUE. 01079 CALL SMG$PUT_CHARS( DISPLAY4, 'B', 2, 28) 01080 CALL MOVE_TO ( 24,1 ) CASE 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 21 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 01081 ELSEIF ( KEY .EQ. SMG$K_TRM_PF2 ) THEN 01082 WHITE = .TRUE. 01083 CALL SMG$PUT_CHARS( DISPLAY4, 'W', 2, 31) 01084 CALL MOVE_TO ( 24,1 ) 01085 ELSEIF ( KEY .EQ. SMG$K_TRM_PF3 ) THEN 01086 CALL POWER_10 01087 ELSEIF ( KEY .EQ. SMG$K_TRM_PF4 ) THEN 01088 CALL POWER_E 01089 ENDIF 01090 01091 01092 C --------------------- KEYPAD 0-9 --------------------------------- 01093 ELSEIF ( KEY .LE. SMG$K_TRM_KP9 ) THEN !KP0-KP9 01094 01095 IF ( KEY .EQ. SMG$K_TRM_KP0 ) THEN 01096 CALL CLEAR_STACK 01097 ELSEIF ( KEY .EQ. SMG$K_TRM_KP1 ) THEN 01098 CALL ROLL_UP 01099 ELSEIF ( KEY .EQ. SMG$K_TRM_KP2 ) THEN 01100 CALL EXCHANGE 01101 ELSEIF ( KEY .EQ. SMG$K_TRM_KP3 ) THEN 01102 CALL RESET 01103 ELSEIF ( KEY .EQ. SMG$K_TRM_KP4 ) THEN 01104 CALL SQUARE_X 01105 ELSEIF ( KEY .EQ. SMG$K_TRM_KP5 ) THEN 01106 CALL EXPONENT 01107 ELSEIF ( KEY .EQ. SMG$K_TRM_KP6 ) THEN 01108 CALL ABS_VALUE 01109 ELSEIF ( KEY .EQ. SMG$K_TRM_KP7 ) THEN 01110 CALL ARC_SINE 01111 ELSEIF ( KEY .EQ. SMG$K_TRM_KP8 ) THEN 01112 CALL ARC_COSINE 01113 ELSEIF ( KEY .EQ. SMG$K_TRM_KP9 ) THEN 01114 CALL ARC_TANGENT 01115 END IF 01116 01117 01118 C --------------------- MISCELLANEOUS ------------------------------ 01119 ELSEIF ( KEY .LT. SMG$K_TRM_F1 ) THEN !MISC 01120 01121 IF ( KEY .EQ. SMG$K_TRM_ENTER ) THEN 01122 CALL CLEAR_SCREEN 01123 CALL SYS$EXIT ( %VAL(1) ) 01124 ELSEIF ( KEY .EQ. SMG$K_TRM_MINUS ) THEN 01125 CALL CHANGE_TRIG ( 'DEG',1 ) 01126 ELSEIF ( KEY .EQ. SMG$K_TRM_COMMA ) THEN 01127 CALL FRACTION 01128 ELSEIF ( KEY .EQ. SMG$K_TRM_PERIOD ) THEN 01129 CALL E 01130 ELSEIF ( KEY .EQ. SMG$K_TRM_UP ) THEN 01131 CALL ADD 01132 ELSEIF ( KEY .EQ. SMG$K_TRM_DOWN ) THEN 01133 CALL SUBTRACT 01134 ELSEIF ( KEY .EQ. SMG$K_TRM_LEFT ) THEN 01135 CALL MULTIPLY 01136 ELSEIF ( KEY .EQ. SMG$K_TRM_RIGHT ) THEN 01137 CALL DIVIDE CASE 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 22 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 01138 ENDIF 01139 01140 01141 C -------------- END CASE ------------------------------------------ 01142 ELSE 01143 CALL ERR_HAND ( -3 ) 01144 END IF 01145 WHITE = .FALSE. 01146 ISTATUS = SMG$PUT_CHARS( DISPLAY4, ' ', 2, 31) 01147 CALL MOVE_TO ( 24,1 ) 01148 01149 CASE 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 23 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 01151 ELSE 01152 C ****************************************************************** 01153 C ***********************IF STATE OFF ****************************** 01154 C ****************************************************************** 01155 C -------------- CONTROL CHARACTERS 000 - 031 --------------------- 01156 IF ( KEY .LT. SMG$K_TRM_SPACE ) THEN !CONTROL CHARACTERS 01157 01158 IF ( KEY .EQ. SMG$K_TRM_CTRLB ) THEN 01159 CALL CHANGE_MODE ('B',1 ) 01160 ELSEIF ( KEY .EQ. SMG$K_TRM_CTRLE ) THEN 01161 CALL CHANGE_MODE ('E',1 ) 01162 ELSEIF ( KEY .EQ. SMG$K_TRM_CTRLF ) THEN 01163 CALL CHANGE_MODE ('F',1 ) 01164 ELSEIF ( KEY .EQ. SMG$K_TRM_CTRLH ) THEN 01165 CALL CHANGE_MODE ('H',1 ) 01166 ELSEIF ( KEY .EQ. SMG$K_TRM_CTRLI ) THEN 01167 CALL CHANGE_MODE ('I',1 ) 01168 ELSEIF ( KEY .EQ. SMG$K_TRM_CR ) THEN 01169 CALL ENTER 01170 ELSEIF ( KEY .EQ. SMG$K_TRM_CTRLR ) THEN 01171 CALL RESET 01172 ELSEIF ( KEY .EQ. SMG$K_TRM_CTRLW ) THEN 01173 CALL RESET 01174 ELSEIF ( KEY .EQ. SMG$K_TRM_CTRLZ ) THEN 01175 CALL CLEAR_SCREEN 01176 CALL SYS$EXIT (%VAL(1) ) 01177 ENDIF 01178 01179 01180 C -------------MISCELANEOUS !"#$%&'()*+,-./ ------------------------ 01181 ELSEIF ( KEY .LT. SMG$K_TRM_ZERO ) THEN !MISC 01182 01183 IF ( KEY .EQ. SMG$K_TRM_ASTERISK ) THEN 01184 CALL MULTIPLY 01185 ELSEIF ( KEY .EQ. SMG$K_TRM_PLUS_SIGN ) THEN 01186 CALL ADD 01187 ELSEIF ( KEY .EQ. SMG$K_TRM_DASH ) THEN 01188 CALL SUBTRACT 01189 ELSEIF ( KEY .EQ. SMG$K_TRM_DOT ) THEN 01190 CHARACTER = CHAR( KEY ) 01191 CALL DIGIT( CHARACTER ) 01192 ELSEIF ( KEY .EQ. SMG$K_TRM_SLASH ) THEN 01193 CALL DIVIDE 01194 ENDIF 01195 01196 C --------------- NUMBERS 0-9 -------------------------------------- 01197 ELSEIF ( KEY .LE. SMG$K_TRM_NINE ) THEN !NUMBERS 01198 CHARACTER = CHAR( KEY ) 01199 CALL DIGIT( CHARACTER ) 01200 01201 01202 C ------------- MISCELLANEOUS :;<=>?@ ------------------------------ 01203 ELSEIF ( KEY .LT. SMG$K_TRM_UPPERCASE_A ) THEN !MISC 01204 01205 01206 C -------------- LETTERS A-Z --------------------------------------- CASE 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 24 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 01207 ELSEIF ( KEY .LE. SMG$K_TRM_UPPERCASE_Z) THEN !UPPERCAE ALPHABET 01208 IF ( KEY .EQ. SMG$K_TRM_UPPERCASE_O) THEN 01209 CALL CHANGE_MODE ('O',1 ) 01210 ELSE 01211 CHARACTER = CHAR( KEY ) 01212 CALL DIGIT( CHARACTER ) 01213 ENDIF 01214 01215 C ---------------- MISCELANEOUS [\]^_` ----------------------------- 01216 ELSEIF ( KEY .LT. SMG$K_TRM_LOWERCASE_A ) THEN !MISC 01217 01218 01219 C ---------------- lowercase letters a-z --------------------------- 01220 ELSEIF ( KEY .LE. SMG$K_TRM_LOWERCASE_Z ) THEN !lowercase alphabet 01221 IF ( KEY .EQ. SMG$K_TRM_LOWERCASE_O) THEN 01222 CALL CHANGE_MODE ('O',1 ) 01223 ELSE 01224 CHARACTER = CHAR( KEY ) 01225 CALL STR$UPCASE ( CHARACTER, CHARACTER ) 01226 CALL DIGIT( CHARACTER) 01227 ENDIF 01228 01229 C ----------------- MISCELLANEOUS {|}~ del ------------------------- 01230 ELSEIF ( KEY .LT. SMG$K_TRM_PF1 ) THEN !MISC 01231 01232 IF ( KEY .EQ. SMG$K_TRM_DELETE ) THEN 01233 CALL DELETE_DIGIT 01234 ENDIF 01235 01236 01237 C ------------------ KEYPAD PF1-PF4 -------------------------------- 01238 ELSEIF ( KEY .LE. SMG$K_TRM_PF4 ) THEN !PF1-PF4 01239 01240 IF ( KEY .EQ. SMG$K_TRM_PF1 ) THEN 01241 BLACK = .TRUE. 01242 CALL SMG$PUT_CHARS( DISPLAY4, 'B', 2, 28) 01243 CALL MOVE_TO ( 24,1 ) 01244 ELSEIF ( KEY .EQ. SMG$K_TRM_PF2 ) THEN 01245 WHITE = .TRUE. 01246 CALL SMG$PUT_CHARS( DISPLAY4, 'W', 2, 31) 01247 CALL MOVE_TO ( 24,1 ) 01248 ENDIF 01249 01250 01251 C --------------------- KEYPAD 0-9 --------------------------------- 01252 ELSEIF ( KEY .LE. SMG$K_TRM_KP9 ) THEN !KP0-KP9 01253 IF ( KEY .EQ. SMG$K_TRM_KP0 ) THEN 01254 CHARACTER = '0' 01255 CALL DIGIT( CHARACTER ) 01256 ELSEIF ( KEY .EQ. SMG$K_TRM_KP1 ) THEN 01257 CHARACTER = '1' 01258 CALL DIGIT ( CHARACTER ) 01259 ELSEIF ( KEY .EQ. SMG$K_TRM_KP2 ) THEN 01260 CHARACTER = '2' 01261 CALL DIGIT ( CHARACTER ) 01262 ELSEIF ( KEY .EQ. SMG$K_TRM_KP3 ) THEN 01263 CHARACTER = '3' CASE 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 25 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 01264 CALL DIGIT ( CHARACTER ) 01265 ELSEIF ( KEY .EQ. SMG$K_TRM_KP4 ) THEN 01266 CHARACTER = '4' 01267 CALL DIGIT ( CHARACTER ) 01268 ELSEIF ( KEY .EQ. SMG$K_TRM_KP5 ) THEN 01269 CHARACTER = '5' 01270 CALL DIGIT (CHARACTER) 01271 ELSEIF ( KEY .EQ. SMG$K_TRM_KP6 ) THEN 01272 CHARACTER = '6' 01273 CALL DIGIT ( CHARACTER ) 01274 ELSEIF ( KEY .EQ. SMG$K_TRM_KP7 ) THEN 01275 CHARACTER = '7' 01276 CALL DIGIT ( CHARACTER ) 01277 ELSEIF ( KEY .EQ. SMG$K_TRM_KP8 ) THEN 01278 CHARACTER = '8' 01279 CALL DIGIT ( CHARACTER ) 01280 ELSEIF ( KEY .EQ. SMG$K_TRM_KP9 ) THEN 01281 CHARACTER = '9' 01282 CALL DIGIT ( CHARACTER ) 01283 END IF 01284 01285 01286 C --------------------- MISCELLANEOUS ------------------------------ 01287 ELSEIF ( KEY .LT. SMG$K_TRM_F1 ) THEN !MISC 01288 01289 IF ( KEY .EQ. SMG$K_TRM_ENTER ) THEN 01290 CALL ENTER 01291 ELSEIF ( KEY .EQ. SMG$K_TRM_PERIOD ) THEN 01292 CHARACTER = '.' 01293 CALL DIGIT( CHARACTER ) 01294 ELSEIF ( KEY .EQ. SMG$K_TRM_UP ) THEN 01295 CALL ADD 01296 ELSEIF ( KEY .EQ. SMG$K_TRM_DOWN ) THEN 01297 CALL SUBTRACT 01298 ELSEIF ( KEY .EQ. SMG$K_TRM_LEFT ) THEN 01299 CALL MULTIPLY 01300 ELSEIF ( KEY .EQ. SMG$K_TRM_RIGHT ) THEN 01301 CALL DIVIDE 01302 ENDIF 01303 01304 01305 C -------------- END CASE ------------------------------------------ 01306 ENDIF 01307 01308 01309 C ----- END CASES BLACK, WHITE, OFF ----- 01310 ENDIF 01311 RETURN 01312 END CASE 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 26 01 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 2514 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 62 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 788 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD 3 STATE 8 PIC OVR REL GBL SHR NOEXE RD WRT QUAD 4 DISPLAYS 24 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 3396 ENTRY POINTS Address Type Name 0-00000000 CASE VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 3-00000004 L*4 BLACK 2-00000000 CHAR CHARACTER 4-00000000 I*4 DISPLAY1 4-00000004 I*4 DISPLAY2 4-00000008 I*4 DISPLAY3 4-0000000C I*4 DISPLAY4 4-00000010 I*4 DISPLAY5 4-00000014 I*4 DISPLAY6 2-00000001 CHAR INPUT ** I*4 ISTATUS AP-00000004@ I*4 KEY 3-00000000 L*4 WHITE FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name Type Name Type Name Type Name ABS_VALUE ADD ARC_COSINE ARC_SINE ARC_TANGENT CHANGE_MODE CHANGE_SIGN CHANGE_TRIG CHAR CHAR CLEAR_SCREEN CLEAR_STACK CLEAR_X_REG COSINE DELETE_DIGIT DIGIT DIVIDE E ENTER ERR_HAND EXCHANGE EXPONENT FIX FRACTION GET_INPUT INTEGER INVERT LAST_X LOG_10 LOG_E MOVE_TO MULTIPLY OUT_CHAR PI POWER_10 POWER_E RESET ROLL_DOWN ROLL_UP SINE R*4 SMG$PUT_CHARS SQUARE_ROOT SQUARE_X STR$UPCASE SUBTRACT SYS$EXIT TANGENT 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 27 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00001 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 28 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00003 SUBROUTINE CHANGE_MODE ( NEW_MODE,FLAG ) 00004 00005 C Changes the display mode as follows: 00006 C 00007 C I Decimal integer 00008 C B Binary integer 00009 C O Octal integer -- NOT AVAILABLE 00010 C H Hexadecimal integer 00011 C F Floating point (decimal) 00012 C E Exponential floating point (decimal) 00013 00014 INTEGER FLAG 00015 REAL*8 X,Y,Z,T,LASTX 00016 LOGICAL PUSH_FLAG,ERROR,RADS,D_OK 00017 BYTE LAST 00018 CHARACTER MODE*1,NEW_MODE*1,STRING*37 00019 INTEGER DISPLAY1, DISPLAY2, DISPLAY3, DISPLAY4, DISPLAY5, PASTE1, 00020 * DISPLAY6 00021 INTEGER SMG$PUT_CHARS 00022 00023 COMMON / DISPLAYS / DISPLAY1,DISPLAY2,DISPLAY3,DISPLAY4,DISPLAY5, 00024 * DISPLAY6 00025 COMMON / DISP / ERROR,MODE,STRING 00026 COMMON / STACK / X,Y,Z,T,LASTX,PUSH_FLAG,LAST,RADS,D_OK 00027 00028 IF ( .NOT.PUSH_FLAG ) CALL LOAD_X_REG 00029 00030 IF ( NEW_MODE .EQ. 'I' ) THEN 00031 ISTATUS = SMG$PUT_CHARS( DISPLAY4, 'Integer mode ', 2, 2) 00032 MODE = NEW_MODE 00033 ELSEIF ( NEW_MODE .EQ. 'B' ) THEN 00034 ISTATUS = SMG$PUT_CHARS( DISPLAY4, 'Binary integer mode ', 2, 2) 00035 MODE = NEW_MODE 00036 ELSEIF ( NEW_MODE .EQ. 'O' ) THEN 00037 ISTATUS = SMG$PUT_CHARS( DISPLAY4, 'Octal integer mode ', 2, 2) 00038 MODE = NEW_MODE 00039 ELSEIF ( NEW_MODE .EQ. 'H' ) THEN 00040 ISTATUS = SMG$PUT_CHARS( DISPLAY4, 'Hexadecimal integer mode', 2, 2) 00041 MODE = NEW_MODE 00042 ELSEIF ( NEW_MODE .EQ. 'F' ) THEN 00043 ISTATUS = SMG$PUT_CHARS( DISPLAY4, 'Floating point mode ', 2, 2) 00044 MODE = NEW_MODE 00045 ELSEIF ( NEW_MODE .EQ. 'E' ) THEN 00046 ISTATUS = SMG$PUT_CHARS( DISPLAY4, 'Exponential mode ', 2, 2) 00047 MODE = NEW_MODE 00048 END IF 00049 CALL MOVE_TO ( 24,1 ) 00050 00051 PUSH_FLAG = .TRUE. 00052 LAST = 0 00053 00054 IF ( FLAG .EQ. 1 ) CALL DISPLAY 00055 00056 RETURN 00057 END CHANGE_MODE 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 29 01 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 232 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 162 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 188 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD 3 DISPLAYS 24 PIC OVR REL GBL SHR NOEXE RD WRT QUAD 4 DISP 42 PIC OVR REL GBL SHR NOEXE RD WRT QUAD 5 STACK 53 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 701 ENTRY POINTS Address Type Name 0-00000000 CHANGE_MODE VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 3-00000000 I*4 DISPLAY1 3-00000004 I*4 DISPLAY2 3-00000008 I*4 DISPLAY3 3-0000000C I*4 DISPLAY4 3-00000010 I*4 DISPLAY5 3-00000014 I*4 DISPLAY6 5-00000031 L*4 D_OK 4-00000000 L*4 ERROR AP-00000008@ I*4 FLAG ** I*4 ISTATUS 5-0000002C L*1 LAST 5-00000020 R*8 LASTX 4-00000004 CHAR MODE AP-00000004@ CHAR NEW_MODE ** I*4 PASTE1 5-00000028 L*4 PUSH_FLAG 5-0000002D L*4 RADS 4-00000005 CHAR STRING 5-00000018 R*8 T 5-00000000 R*8 X 5-00000008 R*8 Y 5-00000010 R*8 Z FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name Type Name DISPLAY LOAD_X_REG MOVE_TO I*4 SMG$PUT_CHARS 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 30 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00001 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 31 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00003 SUBROUTINE CHANGE_SIGN 00004 00005 C Changes the sign of the X register 00006 00007 REAL*8 X,Y,Z,T,LASTX 00008 BYTE LAST 00009 LOGICAL PUSH_FLAG,RADS,D_OK 00010 00011 COMMON / STACK / X,Y,Z,T,LASTX,PUSH_FLAG,LAST,RADS,D_OK 00012 00013 IF ( .NOT.PUSH_FLAG ) CALL LOAD_X_REG 00014 00015 X = - X 00016 00017 PUSH_FLAG = .TRUE. 00018 LAST = 0 00019 00020 CALL DISPLAY 00021 00022 RETURN 00023 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 48 PIC CON REL LCL SHR EXE RD NOWRT QUAD 3 STACK 53 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 101 ENTRY POINTS Address Type Name 0-00000000 CHANGE_SIGN VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 3-00000031 L*4 D_OK 3-0000002C L*1 LAST 3-00000020 R*8 LASTX 3-00000028 L*4 PUSH_FLAG 3-0000002D L*4 RADS 3-00000018 R*8 T 3-00000000 R*8 X 3-00000008 R*8 Y 3-00000010 R*8 Z CHANGE_SIGN 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 32 01 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name DISPLAY LOAD_X_REG 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 33 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00002 SUBROUTINE CHANGE_TRIG ( MODE,FLAG ) 00003 00004 C Changes from degrees to radians, and vice-versa 00005 00006 INTEGER FLAG 00007 REAL*8 X,Y,Z,T,LASTX 00008 BYTE LAST 00009 CHARACTER MODE*3 00010 LOGICAL PUSH_FLAG,RADS,D_OK 00011 INTEGER DISPLAY1, DISPLAY2, DISPLAY3, DISPLAY4, DISPLAY5, PASTE1, 00012 * DISPLAY6 00013 INTEGER SMG$PUT_CHARS 00014 00015 COMMON / DISPLAYS / DISPLAY1,DISPLAY2,DISPLAY3,DISPLAY4,DISPLAY5, 00016 * DISPLAY6 00017 COMMON / STACK / X,Y,Z,T,LASTX,PUSH_FLAG,LAST,RADS,D_OK 00018 00019 IF ( .NOT.PUSH_FLAG ) CALL LOAD_X_REG 00020 00021 IF ( MODE .EQ. 'DEG' ) THEN 00022 RADS = .FALSE. 00023 ISTATUS = SMG$PUT_CHARS( DISPLAY4, 'DEG', 2, 38) 00024 ELSE 00025 RADS = .TRUE. 00026 ISTATUS = SMG$PUT_CHARS( DISPLAY4, 'RAD', 2, 38) 00027 END IF 00028 CALL MOVE_TO ( 24,1 ) 00029 00030 PUSH_FLAG = .TRUE. 00031 LAST = 0 00032 IF ( FLAG .EQ. 1 ) CALL DISPLAY 00033 00034 RETURN 00035 END CHANGE_TRIG 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 34 01 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 110 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 24 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 76 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD 3 DISPLAYS 24 PIC OVR REL GBL SHR NOEXE RD WRT QUAD 4 STACK 53 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 287 ENTRY POINTS Address Type Name 0-00000000 CHANGE_TRIG VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 3-00000000 I*4 DISPLAY1 3-00000004 I*4 DISPLAY2 3-00000008 I*4 DISPLAY3 3-0000000C I*4 DISPLAY4 3-00000010 I*4 DISPLAY5 3-00000014 I*4 DISPLAY6 4-00000031 L*4 D_OK AP-00000008@ I*4 FLAG ** I*4 ISTATUS 4-0000002C L*1 LAST 4-00000020 R*8 LASTX AP-00000004@ CHAR MODE ** I*4 PASTE1 4-00000028 L*4 PUSH_FLAG 4-0000002D L*4 RADS 4-00000018 R*8 T 4-00000000 R*8 X 4-00000008 R*8 Y 4-00000010 R*8 Z FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name Type Name DISPLAY LOAD_X_REG MOVE_TO I*4 SMG$PUT_CHARS 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 35 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00001 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 36 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00003 SUBROUTINE CLEAR_SCREEN 00004 00005 C Clears the screen 00006 00007 INTEGER SMG$ERASE_PASTEBOARD, PASTE1 00008 COMMON / PASTE / PASTE1 00009 00010 C Clear the screen 00011 ISTATUS = SMG$ERASE_PASTEBOARD( PASTE1 ) 00012 00013 RETURN 00014 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 17 PIC CON REL LCL SHR EXE RD NOWRT QUAD 2 $LOCAL 8 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD 3 PASTE 4 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 29 ENTRY POINTS Address Type Name 0-00000000 CLEAR_SCREEN VARIABLES Address Type Name Address Type Name ** I*4 ISTATUS 3-00000000 I*4 PASTE1 FUNCTIONS AND SUBROUTINES REFERENCED Type Name I*4 SMG$ERASE_PASTEBOARD 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 37 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00001 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 38 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00003 SUBROUTINE CLEAR_STACK 00004 00005 C Resets the stack 00006 00007 REAL*8 X,Y,Z,T,LASTX 00008 BYTE LAST 00009 LOGICAL PUSH_FLAG,RADS,D_OK 00010 00011 COMMON / STACK / X,Y,Z,T,LASTX,PUSH_FLAG,LAST,RADS,D_OK 00012 00013 X = 0. 00014 Y = 0. 00015 Z = 0. 00016 T = 0. 00017 LASTX = 0. 00018 00019 PUSH_FLAG = .TRUE. 00020 LAST = 0 00021 00022 CALL DISPLAY 00023 00024 RETURN 00025 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 53 PIC CON REL LCL SHR EXE RD NOWRT QUAD 3 STACK 53 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 106 ENTRY POINTS Address Type Name 0-00000000 CLEAR_STACK VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 3-00000031 L*4 D_OK 3-0000002C L*1 LAST 3-00000020 R*8 LASTX 3-00000028 L*4 PUSH_FLAG 3-0000002D L*4 RADS 3-00000018 R*8 T 3-00000000 R*8 X 3-00000008 R*8 Y 3-00000010 R*8 Z CLEAR_STACK 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 39 01 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 FUNCTIONS AND SUBROUTINES REFERENCED Type Name DISPLAY 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 40 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00002 SUBROUTINE CLEAR_X_REG 00003 00004 C Clears the X register 00005 00006 PARAMETER CARR_RETURN = '0000000D'X 00007 00008 CHARACTER MODE*1,STRING*37 00009 LOGICAL ERROR,PUSH_FLAG,RADS,D_OK 00010 BYTE LAST 00011 REAL*8 X,Y,Z,T,LASTX 00012 00013 COMMON / DISP / ERROR,MODE,STRING 00014 COMMON / STACK / X,Y,Z,T,LASTX,PUSH_FLAG,LAST,RADS,D_OK 00015 00016 X = 0. 00017 00018 PUSH_FLAG = .FALSE. 00019 LAST = CARR_RETURN 00020 00021 CALL DISPLAY 00022 00023 RETURN 00024 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 29 PIC CON REL LCL SHR EXE RD NOWRT QUAD 3 DISP 42 PIC OVR REL GBL SHR NOEXE RD WRT QUAD 4 STACK 53 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 124 ENTRY POINTS Address Type Name 0-00000000 CLEAR_X_REG VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 4-00000031 L*4 D_OK 3-00000000 L*4 ERROR 4-0000002C L*1 LAST 4-00000020 R*8 LASTX 3-00000004 CHAR MODE 4-00000028 L*4 PUSH_FLAG 4-0000002D L*4 RADS 3-00000005 CHAR STRING 4-00000018 R*8 T 4-00000000 R*8 X 4-00000008 R*8 Y 4-00000010 R*8 Z CLEAR_X_REG 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 41 01 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 FUNCTIONS AND SUBROUTINES REFERENCED Type Name DISPLAY 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 42 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00002 SUBROUTINE COSINE 00003 00004 C Calculates COS( X ) 00005 00006 REAL*8 X,Y,Z,T,LASTX 00007 BYTE LAST 00008 LOGICAL PUSH_FLAG,RADS,D_OK 00009 00010 COMMON / STACK / X,Y,Z,T,LASTX,PUSH_FLAG,LAST,RADS,D_OK 00011 00012 IF ( .NOT.PUSH_FLAG ) CALL LOAD_X_REG 00013 00014 IF ( RADS ) THEN 00015 X = DCOS( X ) 00016 ELSE 00017 X = DCOSD( X ) 00018 END IF 00019 00020 PUSH_FLAG = .TRUE. 00021 LAST = 0 00022 00023 CALL DISPLAY 00024 00025 RETURN 00026 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 67 PIC CON REL LCL SHR EXE RD NOWRT QUAD 3 STACK 53 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 120 ENTRY POINTS Address Type Name 0-00000000 COSINE VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 3-00000031 L*4 D_OK 3-0000002C L*1 LAST 3-00000020 R*8 LASTX 3-00000028 L*4 PUSH_FLAG 3-0000002D L*4 RADS 3-00000018 R*8 T 3-00000000 R*8 X 3-00000008 R*8 Y 3-00000010 R*8 Z COSINE 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 43 01 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name Type Name R*8 DCOS R*8 DCOSD DISPLAY LOAD_X_REG 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 44 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00001 00002 SUBROUTINE CREATE_DISPLAYS 00003 00004 C DISPLAY4 - BACKGROUND BORDER OF CALCULATOR KEYS 00005 C DISPLAY2 - CALCULATOR KEYS 00006 C DISPLAY1 - CALCULATOR OUTPUT DISPLAY AT TOP 00007 C DISPLAY3 - CALCULATOR INFORMATION ON SIDE 00008 C DISPLAY5 - ERROR TEXT AT TOP OF CALCULATOR 00009 C DISPLAY6 - ARROW KEY DEFINITIONS 00010 00011 INCLUDE '($SMGDEF)' 00889 LOGICAL CRT, VT200 00890 INTEGER SMG$CREATE_VIRTUAL_DISPLAY, SMG$CREATE_PASTEBORD 00891 INTEGER DISPLAY1, DISPLAY2, DISPLAY3, DISPLAY4, DISPLAY5, 00892 * DISPLAY6 00893 INTEGER PASTE1, KEYBOARD1, ROWS, COLUMNS, TERM_CHAR 00894 00895 COMMON / DISPLAYS / DISPLAY1,DISPLAY2,DISPLAY3,DISPLAY4,DISPLAY5, 00896 * DISPLAY6 00897 COMMON / PASTE / PASTE1 00898 00899 if ( .not. crt() ) then 00900 print*, 'You must use a DEC CRT terminal' 00901 call exit 00902 endif 00903 00904 C+ 00905 C Create the pasteboard. 00906 C- 00907 ISTATUS = SMG$CREATE_PASTEBOARD (PASTE1) 00908 00909 C+ 00910 C Create the virtual displays. 00911 C- 00912 ROWS = 3 00913 COLUMNS = 41 00914 ISTATUS = SMG$CREATE_VIRTUAL_DISPLAY( ROWS, COLUMNS, DISPLAY1 ) 00915 00916 ROWS = 16 00917 COLUMNS = 41 00918 ISTATUS = SMG$CREATE_VIRTUAL_DISPLAY( ROWS, COLUMNS, DISPLAY2 ) 00919 00920 ROWS = 11 00921 COLUMNS = 33 00922 ISTATUS = SMG$CREATE_VIRTUAL_DISPLAY( ROWS, COLUMNS, DISPLAY3 ) 00923 00924 ROWS = 16 00925 COLUMNS = 41 00926 ISTATUS = SMG$CREATE_VIRTUAL_DISPLAY 00927 * ( ROWS, COLUMNS, DISPLAY4, SMG$M_BORDER ) 00928 00929 ROWS = 1 00930 COLUMNS = 41 00931 ISTATUS = SMG$CREATE_VIRTUAL_DISPLAY( ROWS, COLUMNS, DISPLAY5 ) 00932 00933 ROWS = 9 00934 COLUMNS = 33 CREATE_DISPLAYS 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 45 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00935 ISTATUS = SMG$CREATE_VIRTUAL_DISPLAY( ROWS, COLUMNS, DISPLAY6 ) 00936 00937 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 153 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 35 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 132 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD 3 DISPLAYS 24 PIC OVR REL GBL SHR NOEXE RD WRT QUAD 4 PASTE 4 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 348 ENTRY POINTS Address Type Name 0-00000000 CREATE_DISPLAYS VARIABLES Address Type Name Address Type Name 2-00000004 I*4 COLUMNS 3-00000000 I*4 DISPLAY1 3-00000004 I*4 DISPLAY2 3-00000008 I*4 DISPLAY3 3-0000000C I*4 DISPLAY4 3-00000010 I*4 DISPLAY5 3-00000014 I*4 DISPLAY6 ** I*4 ISTATUS ** I*4 KEYBOARD1 4-00000000 I*4 PASTE1 2-00000000 I*4 ROWS ** I*4 SMG$CREATE_PASTEBORD ** I*4 TERM_CHAR ** L*4 VT200 FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name L*4 CRT EXIT R*4 SMG$CREATE_PASTEBOARD I*4 SMG$CREATE_VIRTUAL_DISPLAY 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 46 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00001 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 47 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00003 logical function crt 00004 00005 include '($dvidef)' 00249 include '($ttdef)' 00455 include '($tt2def)' 00561 00562 logical VT200 00563 integer*2 b2(14) 00564 integer*4 b4(7), buf, len_buf, sys$getdviw, dev_type, len_dev_type 00565 logical*4 for$bjtest, istat 00566 00567 equivalence ( b4(1), b2(1) ) 00568 00569 COMMON / TERM / VT200 00570 00571 b2(1) = 4 00572 b2(2) = dvi$_devdepend2 00573 b4(2) = %loc( buf ) 00574 b4(3) = %loc( len_buf ) 00575 00576 b2(7) = 4 00577 b2(8) = dvi$_devtype 00578 b4(5) = %loc( dev_type ) 00579 b4(6) = %loc( len_dev_type ) 00580 00581 b4(7) = 0 00582 00583 istat = sys$getdviw( ,, 'SYS$COMMAND', b4,,,, ) 00584 00585 crt = ( for$bjtest( buf, tt2$v_deccrt ) .or. 00586 . dev_type .eq. tt$_vt52 ) 00587 VT200 = ((dev_type .eq. tt$_vt200_series) 00588 * .OR. (dev_type .eq. tt$_vt300_series)) 00589 00590 return 00591 end CRT 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 48 01 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 123 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 16 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 104 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD 3 TERM 4 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 247 ENTRY POINTS Address Type Name 0-00000000 L*4 CRT VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 2-00000020 I*4 BUF 2-00000028 I*4 DEV_TYPE ** L*4 ISTAT 2-00000024 I*4 LEN_BUF ** I*4 LEN_DEV_TYP 2-0000002C I*4 LEN_DEV_TYPE 3-00000000 L*4 VT200 ARRAYS Address Type Name Bytes Dimensions 2-00000000 I*2 B2 28 (14) 2-00000000 I*4 B4 28 (7) FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name L*4 FOR$BJTEST I*4 SYS$GETDVIW 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 49 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00002 SUBROUTINE DELETE_DIGIT 00003 00004 C Deletes a digit from the current display 00005 00006 PARAMETER CARR_RETURN = '0000000D'X 00007 00008 REAL*8 X,Y,Z,T,LASTX 00009 BYTE LAST 00010 CHARACTER MODE*1,STRING*37 00011 LOGICAL PUSH_FLAG,RADS,ERROR,D_OK 00012 INTEGER DISPLAY1, DISPLAY2, DISPLAY3, DISPLAY4, DISPLAY5, 00013 * DISPLAY6 00014 00015 COMMON / DISP / ERROR,MODE,STRING 00016 COMMON / STACK / X,Y,Z,T,LASTX,PUSH_FLAG,LAST,RADS,D_OK 00017 COMMON / DISPLAYS / DISPLAY1,DISPLAY2,DISPLAY3,DISPLAY4,DISPLAY5, 00018 * DISPLAY6 00019 00020 IF ( D_OK ) THEN 00021 STRING = ' '//STRING(1:36) 00022 IF ( STRING(37:37) .EQ. ' ' ) THEN 00023 CALL DISPLAY 00024 LAST = CARR_RETURN 00025 ELSE 00026 ISTATUS = SMG$PUT_CHARS( DISPLAY1, STRING, 2, 3) 00027 CALL MOVE_TO ( 24,1 ) 00028 END IF 00029 ELSE 00030 CALL ERR_HAND ( -4 ) 00031 END IF 00032 00033 RETURN 00034 END DELETE_DIGIT 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 50 01 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 97 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 20 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 48 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD 3 DISP 42 PIC OVR REL GBL SHR NOEXE RD WRT QUAD 4 STACK 53 PIC OVR REL GBL SHR NOEXE RD WRT QUAD 5 DISPLAYS 24 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 284 ENTRY POINTS Address Type Name 0-00000000 DELETE_DIGIT VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 5-00000000 I*4 DISPLAY1 5-00000004 I*4 DISPLAY2 5-00000008 I*4 DISPLAY3 5-0000000C I*4 DISPLAY4 5-00000010 I*4 DISPLAY5 5-00000014 I*4 DISPLAY6 4-00000031 L*4 D_OK 3-00000000 L*4 ERROR ** I*4 ISTATUS 4-0000002C L*1 LAST 4-00000020 R*8 LASTX 3-00000004 CHAR MODE 4-00000028 L*4 PUSH_FLAG 4-0000002D L*4 RADS 3-00000005 CHAR STRING 4-00000018 R*8 T 4-00000000 R*8 X 4-00000008 R*8 Y 4-00000010 R*8 Z FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name Type Name DISPLAY ERR_HAND MOVE_TO R*4 SMG$PUT_CHARS 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 51 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00002 SUBROUTINE DIGIT ( CHAR ) 00003 00004 C Determines if the character is a valid digit 00005 00006 PARAMETER CARR_RETURN = '0000000D'X 00007 00008 CHARACTER MODE*1,CHAR*1,STRING*37 00009 REAL*8 X,Y,Z,T,LASTX 00010 BYTE LAST 00011 INTEGER STR$POSITION 00012 LOGICAL PUSH_FLAG,ERROR,RADS,D_OK,FLAG 00013 00014 COMMON / DISP / ERROR,MODE,STRING 00015 COMMON / STACK / X,Y,Z,T,LASTX,PUSH_FLAG,LAST,RADS,D_OK 00016 00017 IF ( LAST .EQ. CARR_RETURN ) THEN 00018 FLAG = .TRUE. 00019 ELSE 00020 FLAG = PUSH_FLAG 00021 END IF 00022 00023 IF ( MODE .EQ. 'I' ) THEN 00024 00025 IF ( CHAR.GE.'0' .AND. CHAR.LE.'9' ) THEN 00026 CALL ADD_DIGIT ( CHAR ) 00027 ELSE 00028 CALL ERR_HAND ( -6 ) 00029 END IF 00030 00031 ELSEIF ( MODE .EQ. 'B' ) THEN 00032 00033 IF ( CHAR.GE.'0' .AND. CHAR.LE.'1' ) THEN 00034 CALL ADD_DIGIT ( CHAR ) 00035 ELSE 00036 CALL ERR_HAND ( -6 ) 00037 END IF 00038 00039 ELSEIF ( MODE .EQ. 'O' ) THEN 00040 00041 IF ( CHAR.GE.'0' .AND. CHAR.LE.'7' ) THEN 00042 CALL ADD_DIGIT ( CHAR ) 00043 ELSE 00044 CALL ERR_HAND ( -6 ) 00045 END IF 00046 00047 ELSEIF ( MODE .EQ. 'H' ) THEN 00048 00049 IF ( (CHAR.GE.'0' .AND. CHAR.LE.'9') .OR. 00050 . (CHAR.GE.'A' .AND. CHAR.LE.'F') ) THEN 00051 CALL ADD_DIGIT ( CHAR ) 00052 ELSE 00053 CALL ERR_HAND ( -6 ) 00054 END IF 00055 00056 ELSEIF ( MODE .EQ. 'F' ) THEN 00057 DIGIT 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 52 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00058 IF ( CHAR.GE.'0' .AND. CHAR.LE.'9' ) THEN 00059 CALL ADD_DIGIT ( CHAR ) 00060 ELSEIF ( CHAR .EQ. '.' ) THEN 00061 IF ( FLAG ) THEN 00062 CALL ADD_DIGIT ( CHAR ) 00063 ELSE 00064 IF ( STR$POSITION( STRING,'.' ) .EQ. 0 ) THEN 00065 CALL ADD_DIGIT ( CHAR ) 00066 ELSE 00067 CALL ERR_HAND ( -7 ) 00068 END IF 00069 END IF 00070 ELSE 00071 CALL ERR_HAND ( -6 ) 00072 END IF 00073 00074 ELSEIF ( MODE .EQ. 'E' ) THEN 00075 00076 IF ( CHAR.GE.'0' .AND. CHAR.LE.'9' ) THEN 00077 IF ( FLAG ) THEN 00078 CALL ADD_DIGIT ( CHAR ) 00079 ELSE 00080 I = STR$POSITION( STRING,'E' ) 00081 IF ( I .NE. 0 ) THEN 00082 CALL STR$TRIM ( STRING,STRING,J ) 00083 IF ( J-I .LE. 1 ) THEN 00084 CALL ADD_DIGIT ( CHAR ) 00085 ELSE 00086 IF ( J-I.EQ.2 .AND. STRING(36:36).EQ.'-' ) THEN 00087 CALL ADD_DIGIT ( CHAR ) 00088 ELSE 00089 CALL ERR_HAND ( -8 ) 00090 END IF 00091 END IF 00092 ELSE 00093 CALL ADD_DIGIT ( CHAR ) 00094 END IF 00095 END IF 00096 ELSEIF ( CHAR .EQ. 'E' ) THEN 00097 IF ( .NOT.FLAG ) THEN 00098 IF ( STR$POSITION( STRING,'E' ) .EQ. 0 ) THEN 00099 CALL ADD_DIGIT ( CHAR ) 00100 ELSE 00101 CALL ERR_HAND ( -9 ) 00102 END IF 00103 ELSE 00104 CALL ERR_HAND ( -10 ) 00105 END IF 00106 ELSEIF ( CHAR .EQ. '.' ) THEN 00107 IF ( FLAG ) THEN 00108 CALL ADD_DIGIT ( CHAR ) 00109 ELSE 00110 IF ( STR$POSITION( STRING,'.' ) .EQ. 0 ) THEN 00111 IF ( STR$POSITION( STRING,'E' ) .EQ. 0 ) THEN 00112 CALL ADD_DIGIT ( CHAR ) 00113 ELSE 00114 CALL ERR_HAND ( -11 ) DIGIT 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 53 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00115 END IF 00116 ELSE 00117 CALL ERR_HAND ( -7 ) 00118 END IF 00119 END IF 00120 ELSE 00121 CALL ERR_HAND ( -6 ) 00122 END IF 00123 00124 END IF 00125 00126 RETURN 00127 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 622 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 28 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 344 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD 3 DISP 42 PIC OVR REL GBL SHR NOEXE RD WRT QUAD 4 STACK 53 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 1089 ENTRY POINTS Address Type Name 0-00000000 DIGIT VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name AP-00000004@ CHAR CHAR 4-00000031 L*4 D_OK 3-00000000 L*4 ERROR ** L*4 FLAG ** I*4 I 2-00000000 I*4 J 4-0000002C L*1 LAST 4-00000020 R*8 LASTX 3-00000004 CHAR MODE 4-00000028 L*4 PUSH_FLAG 4-0000002D L*4 RADS 3-00000005 CHAR STRING 4-00000018 R*8 T 4-00000000 R*8 X 4-00000008 R*8 Y 4-00000010 R*8 Z FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name Type Name ADD_DIGIT ERR_HAND I*4 STR$POSITION STR$TRIM 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 54 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00001 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 55 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00003 SUBROUTINE DISPLAY 00004 00005 C Displays the contents of the X register 00006 00007 REAL*8 X,Y,Z,T,LASTX 00008 INTEGER I_X,IO_CHAN,TT_TYPE,FIX_NUM,SMG$PUT_CHARS 00009 BYTE LAST 00010 CHARACTER MODE*1,STRING*37 00011 LOGICAL FLAG,MINUS,PUSH_FLAG,ERROR,RADS,D_OK 00012 INTEGER DISPLAY1, DISPLAY2, DISPLAY3, DISPLAY4, DISPLAY5, 00013 * DISPLAY6 00014 00015 COMMON / DISPLAYS / DISPLAY1,DISPLAY2,DISPLAY3,DISPLAY4,DISPLAY5, 00016 * DISPLAY6 00017 COMMON / STACK / X,Y,Z,T,LASTX,PUSH_FLAG,LAST,RADS,D_OK 00018 COMMON / DISP / ERROR,MODE,STRING 00019 COMMON / SCREEN / IO_CHAN,TT_TYPE,FIX_NUM 00020 00021 1000 IF ( MODE .EQ. 'I' ) THEN 00022 IF ( DABS( X ) .GE. 2147483647. ) GO TO 1200 00023 ENCODE ( 37,10,STRING,ERR=1200 ) JIDNNT( X ) 00024 ELSEIF ( MODE.EQ.'B' .OR. MODE.EQ.'O' .OR. MODE.EQ.'H' ) THEN 00025 IF ( DABS( X ) .GE. 2147483647. ) GO TO 1200 00026 I_X = JIDNNT( X ) 00027 IF ( I_X .LT. 0 ) THEN 00028 MINUS = .TRUE. 00029 I_X = -I_X 00030 ELSE 00031 MINUS = .FALSE. 00032 END IF 00033 IF ( MODE .EQ. 'B' ) THEN 00034 FLAG = .FALSE. 00035 DO I = 30, 0, -1 00036 IF ( I_X .GE. 2**I ) THEN 00037 FLAG = .TRUE. 00038 STRING(37-I:37-I) = '1' 00039 I_X = I_X - 2**I 00040 ELSE 00041 IF ( FLAG ) THEN 00042 STRING(37-I:37-I) = '0' 00043 ELSE 00044 STRING(37-I:37-I) = ' ' 00045 END IF 00046 END IF 00047 END DO 00048 STRING(1:6) = ' ' 00049 IF ( STRING(37:37) .EQ. ' ' ) STRING(37:37) = '0' 00050 ELSEIF ( MODE .EQ. 'O' ) THEN 00051 ENCODE ( 37,20,STRING,ERR=1200 ) I_X 00052 ELSEIF ( MODE .EQ. 'H' ) THEN 00053 ENCODE ( 37,30,STRING,ERR=1200 ) I_X 00054 END IF 00055 IF ( MINUS ) THEN 00056 DO I = 2, 37 00057 IF ( STRING(I:I) .NE. ' ' ) GO TO 1100 00058 END DO DISPLAY 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 56 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00059 1100 STRING(I-1:I-1) = '-' 00060 END IF 00061 ELSEIF ( MODE .EQ. 'E' ) THEN 00062 ENCODE ( 37,40,STRING,ERR=1200 ) X 00063 STRING(34:34) = ' ' 00064 IF ( STRING(35:35) .EQ. '+' ) STRING(35:35) = ' ' 00065 ELSEIF ( MODE .EQ. 'F' ) THEN 00066 ENCODE ( 37,50,STRING,ERR=1200 ) X 00067 END IF 00068 00069 ISTATUS = SMG$PUT_CHARS( DISPLAY1, STRING, 2, 3) 00070 CALL MOVE_TO ( 24,1 ) 00071 00072 D_OK = .FALSE. 00073 RETURN 00074 00075 C Encoding error 00076 00077 1200 CALL ERR_HAND ( -5 ) 00078 X = 0. 00079 00080 GO TO 1000 00081 00082 10 FORMAT ( I37 ) 00083 20 FORMAT ( O37 ) 00084 30 FORMAT ( Z37 ) 00085 40 FORMAT ( E37. ) 00086 50 FORMAT ( F37. ) 00087 00088 END DISPLAY 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 57 01 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 601 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 45 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 48 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD 3 DISPLAYS 24 PIC OVR REL GBL SHR NOEXE RD WRT QUAD 4 STACK 53 PIC OVR REL GBL SHR NOEXE RD WRT QUAD 5 DISP 42 PIC OVR REL GBL SHR NOEXE RD WRT QUAD 6 SCREEN 12 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 825 ENTRY POINTS Address Type Name 0-00000000 DISPLAY VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 3-00000000 I*4 DISPLAY1 3-00000004 I*4 DISPLAY2 3-00000008 I*4 DISPLAY3 3-0000000C I*4 DISPLAY4 3-00000010 I*4 DISPLAY5 3-00000014 I*4 DISPLAY6 4-00000031 L*4 D_OK 5-00000000 L*4 ERROR 6-00000008 I*4 FIX_NUM ** L*4 FLAG ** I*4 I 6-00000000 I*4 IO_CHAN ** I*4 ISTATUS ** I*4 I_X 4-0000002C L*1 LAST 4-00000020 R*8 LASTX ** L*4 MINUS 5-00000004 CHAR MODE 4-00000028 L*4 PUSH_FLAG 4-0000002D L*4 RADS 5-00000005 CHAR STRING 4-00000018 R*8 T 6-00000004 I*4 TT_TYPE 4-00000000 R*8 X 4-00000008 R*8 Y 4-00000010 R*8 Z LABELS Address Label Address Label Address Label Address Label Address Label Address Label 1-00000014 10' 1-00000017 20' 1-0000001A 30' 1-0000001D 40' 1-00000025 50' 0-00000010 1000 0-0000019F 1100 0-00000224 1200 FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name Type Name Type Name R*8 DABS ERR_HAND I*4 JIDNNT MOVE_TO I*4 SMG$PUT_CHARS 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 58 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00001 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 59 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00003 SUBROUTINE DIVIDE 00004 00005 C Divides Y by X 00006 00007 REAL*8 X,Y,Z,T,LASTX 00008 BYTE LAST 00009 LOGICAL PUSH_FLAG,RADS,D_OK 00010 00011 COMMON / STACK / X,Y,Z,T,LASTX,PUSH_FLAG,LAST,RADS,D_OK 00012 00013 C Load the X register if necessary 00014 00015 IF ( .NOT.PUSH_FLAG ) CALL LOAD_X_REG 00016 00017 X = Y / X 00018 Y = Z 00019 Z = T 00020 T = 0. 00021 00022 PUSH_FLAG = .TRUE. 00023 LAST = 0 00024 00025 CALL DISPLAY 00026 00027 RETURN 00028 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 53 PIC CON REL LCL SHR EXE RD NOWRT QUAD 3 STACK 53 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 106 ENTRY POINTS Address Type Name 0-00000000 DIVIDE VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 3-00000031 L*4 D_OK 3-0000002C L*1 LAST 3-00000020 R*8 LASTX 3-00000028 L*4 PUSH_FLAG 3-0000002D L*4 RADS 3-00000018 R*8 T 3-00000000 R*8 X 3-00000008 R*8 Y 3-00000010 R*8 Z DIVIDE 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 60 01 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name DISPLAY LOAD_X_REG 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 61 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00002 SUBROUTINE DRAW_CALC 00003 00004 C DISPLAY4 - BACKGROUND BORDER OF CALCULATOR KEYS 00005 C DISPLAY2 - CALCULATOR KEYS 00006 C DISPLAY1 - CALCULATOR OUTPUT DISPLAY AT TOP 00007 C DISPLAY3 - CALCULATOR INFORMATION ON SIDE 00008 C DISPLAY5 - ERROR TEXT AT TOP OF CALCULATOR 00009 C DISPLAY6 - ARROW KEY DEFINITIONS 00010 00011 INCLUDE '($SMGDEF)' 00889 LOGICAL VT200 00890 INTEGER SMG$PASTE_VIRTUAL_DISPLAY, SMG$PUT_LINE 00891 INTEGER DISPLAY1, DISPLAY2, DISPLAY3, DISPLAY4, DISPLAY5, 00892 * DISPLAY6 00893 INTEGER PASTE1, KEYBOARD1, ROWS, COLUMNS 00894 00895 COMMON / DISPLAYS / DISPLAY1,DISPLAY2,DISPLAY3,DISPLAY4,DISPLAY5, 00896 * DISPLAY6 00897 COMMON / TERM / VT200 00898 00899 parameter PF1_U = ' BLACK ' 00900 parameter PF1_L = ' ' 00901 parameter PF2_U = ' ' 00902 parameter PF2_L = ' WHITE ' 00903 parameter PF3_U = ' LOG ' 00904 parameter PF3_L = ' 10^X ' 00905 parameter PF4_U = ' LN ' 00906 parameter PF4_L = ' EXP ' 00907 parameter KP1_U = ' RDN ' 00908 parameter KP1_L = ' RUP ' 00909 parameter KP2_U = ' FIX ' 00910 parameter KP2_L = ' X<>Y ' 00911 parameter KP3_U = ' LASTX ' 00912 parameter KP3_L = ' RESET ' 00913 parameter KP4_U = ' SQRT ' 00914 parameter KP4_L = ' X^2 ' 00915 parameter KP5_U = ' 1/X ' 00916 parameter KP5_L = ' Y^X ' 00917 parameter KP6_U = ' +/- ' 00918 parameter KP6_L = ' |X| ' 00919 parameter KP7_U = ' SIN ' 00920 parameter KP7_L = ' ASIN ' 00921 parameter KP8_U = ' COS ' 00922 parameter KP8_L = ' ACOS ' 00923 parameter KP9_U = ' TAN ' 00924 parameter KP9_L = ' ATAN ' 00925 parameter MINUS_U = ' RAD ' 00926 parameter MINUS_L = ' DEG ' 00927 parameter COMMA_U = ' INT ' 00928 parameter COMMA_L = ' FRAC ' 00929 parameter ENTER_U = ' ' 00930 parameter ENTER_L = ' EXIT ' 00931 parameter PERIOD_U = ' PI ' 00932 parameter PERIOD_L = ' e ' 00933 parameter KP0_U = ' CL X ' 00934 parameter KP0_L = ' CLST ' DRAW_CALC 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 62 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00935 00936 C .BEGIN 00937 00938 C Draw box around calculator output display 00939 ISTATUS = SMG$DRAW_LINE ( DISPLAY1, 1, 1, 1, 41) 00940 ISTATUS = SMG$DRAW_LINE ( DISPLAY1, 3, 1, 3, 41) 00941 ISTATUS = SMG$DRAW_LINE ( DISPLAY1, 1, 1, 3, 1) 00942 ISTATUS = SMG$DRAW_LINE ( DISPLAY1, 1, 41, 3, 41) 00943 00944 C Draw the keys on display2 00945 00946 ISTATUS = SMG$DRAW_LINE ( DISPLAY2, 1, 1, 1, 41) 00947 ISTATUS = SMG$DRAW_LINE ( DISPLAY2, 4, 1, 4, 41) 00948 ISTATUS = SMG$DRAW_LINE ( DISPLAY2, 7, 1, 7, 41) 00949 ISTATUS = SMG$DRAW_LINE ( DISPLAY2, 10, 1, 10, 41) 00950 ISTATUS = SMG$DRAW_LINE ( DISPLAY2, 13, 1, 13, 31) 00951 ISTATUS = SMG$DRAW_LINE ( DISPLAY2, 16, 1, 16, 41) 00952 ISTATUS = SMG$DRAW_LINE ( DISPLAY2, 1, 1, 16, 1) 00953 ISTATUS = SMG$DRAW_LINE ( DISPLAY2, 1, 11, 13, 11) 00954 ISTATUS = SMG$DRAW_LINE ( DISPLAY2, 1, 21, 16, 21) 00955 ISTATUS = SMG$DRAW_LINE ( DISPLAY2, 1, 31, 16, 31) 00956 ISTATUS = SMG$DRAW_LINE ( DISPLAY2, 1, 41, 16, 41) 00957 00958 C Label the keys 00959 00960 ISTATUS = SMG$PUT_CHARS( DISPLAY2, PF1_U, 2, 2) 00961 ISTATUS = SMG$PUT_CHARS( DISPLAY2, PF1_L, 3, 2) 00962 ISTATUS = SMG$PUT_CHARS( DISPLAY2, PF2_U, 2, 12, , SMG$M_REVERSE) 00963 ISTATUS = SMG$PUT_CHARS( DISPLAY2, PF2_L, 3, 12, , SMG$M_REVERSE) 00964 ISTATUS = SMG$PUT_CHARS( DISPLAY2, PF3_U, 2, 22) 00965 ISTATUS = SMG$PUT_CHARS( DISPLAY2, PF3_L, 3, 22, , SMG$M_REVERSE) 00966 ISTATUS = SMG$PUT_CHARS( DISPLAY2, PF4_U, 2, 32) 00967 ISTATUS = SMG$PUT_CHARS( DISPLAY2, PF4_L, 3, 32, , SMG$M_REVERSE) 00968 ISTATUS = SMG$PUT_CHARS( DISPLAY2, KP1_U, 11, 2) 00969 ISTATUS = SMG$PUT_CHARS( DISPLAY2, KP1_L, 12, 2, , SMG$M_REVERSE) 00970 ISTATUS = SMG$PUT_CHARS( DISPLAY2, KP2_U, 11, 12) 00971 ISTATUS = SMG$PUT_CHARS( DISPLAY2, KP2_L, 12, 12, , SMG$M_REVERSE) 00972 ISTATUS = SMG$PUT_CHARS( DISPLAY2, KP3_U, 11, 22) 00973 ISTATUS = SMG$PUT_CHARS( DISPLAY2, KP3_L, 12, 22, , SMG$M_REVERSE) 00974 ISTATUS = SMG$PUT_CHARS( DISPLAY2, KP4_U, 8, 2) 00975 ISTATUS = SMG$PUT_CHARS( DISPLAY2, KP4_L, 9, 2, , SMG$M_REVERSE) 00976 ISTATUS = SMG$PUT_CHARS( DISPLAY2, KP5_U, 8, 12) 00977 ISTATUS = SMG$PUT_CHARS( DISPLAY2, KP5_L, 9, 12, , SMG$M_REVERSE) 00978 ISTATUS = SMG$PUT_CHARS( DISPLAY2, KP6_U, 8, 22) 00979 ISTATUS = SMG$PUT_CHARS( DISPLAY2, KP6_L, 9, 22, , SMG$M_REVERSE) 00980 ISTATUS = SMG$PUT_CHARS( DISPLAY2, KP7_U, 5, 2) 00981 ISTATUS = SMG$PUT_CHARS( DISPLAY2, KP7_L, 6, 2, , SMG$M_REVERSE) 00982 ISTATUS = SMG$PUT_CHARS( DISPLAY2, KP8_U, 5, 12) 00983 ISTATUS = SMG$PUT_CHARS( DISPLAY2, KP8_L, 6, 12, , SMG$M_REVERSE) 00984 ISTATUS = SMG$PUT_CHARS( DISPLAY2, KP9_U, 5, 22) 00985 ISTATUS = SMG$PUT_CHARS( DISPLAY2, KP9_L, 6, 22, , SMG$M_REVERSE) 00986 ISTATUS = SMG$PUT_CHARS( DISPLAY2, MINUS_U, 5, 32) 00987 ISTATUS = SMG$PUT_CHARS( DISPLAY2, MINUS_L, 6, 32, , SMG$M_REVERSE) 00988 ISTATUS = SMG$PUT_CHARS( DISPLAY2, COMMA_U, 8, 32) 00989 ISTATUS = SMG$PUT_CHARS( DISPLAY2, COMMA_L, 9, 32, , SMG$M_REVERSE) 00990 ISTATUS = SMG$PUT_CHARS( DISPLAY2, ENTER_U, 12, 32) 00991 ISTATUS = SMG$PUT_CHARS( DISPLAY2, ENTER_L, 14, 32, , SMG$M_REVERSE) DRAW_CALC 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 63 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00992 ISTATUS = SMG$PUT_CHARS( DISPLAY2, PERIOD_U, 14, 22) 00993 ISTATUS = SMG$PUT_CHARS( DISPLAY2, PERIOD_L, 15, 22, , SMG$M_REVERSE) 00994 ISTATUS = SMG$PUT_CHARS( DISPLAY2, KP0_U, 14, 2) 00995 ISTATUS = SMG$PUT_CHARS( DISPLAY2, KP0_L, 15, 2, , SMG$M_REVERSE) 00996 00997 C Calculator information on display3 00998 00999 ISTATUS = SMG$PUT_CHARS( DISPLAY3,'Integer modes:', 1, 1) 01000 ISTATUS = SMG$PUT_CHARS( DISPLAY3,'Ctrl-I (Decimal)', 3, 3) 01001 ISTATUS = SMG$PUT_CHARS( DISPLAY3, 'Ctrl-B Binary', 4, 3) 01002 ISTATUS = SMG$PUT_CHARS( DISPLAY3, ' O Octal', 5, 3) 01003 ISTATUS = SMG$PUT_CHARS( DISPLAY3, 'Ctrl-H Hexadecimal', 6, 3) 01004 ISTATUS = SMG$PUT_CHARS( DISPLAY3, 'Real modes:', 8, 1) 01005 ISTATUS = SMG$PUT_CHARS( DISPLAY3, 'Ctrl-F Floating point', 10, 3) 01006 ISTATUS = SMG$PUT_CHARS( DISPLAY3, 'Ctrl-E Exponential', 11, 3) 01007 01008 C Draw boxes for arrow keys ( + - * / ) 01009 01010 IF (VT200) THEN !If VT200 series terminal then draw arrows differently) 01011 ISTATUS = SMG$PUT_CHARS( DISPLAY6, '(arrows)', 1, 14) 01012 ISTATUS = SMG$PUT_CHARS( DISPLAY6, 'up', 2, 17) 01013 ISTATUS = SMG$PUT_CHARS( DISPLAY6, 'down', 9, 17) 01014 ISTATUS = SMG$PUT_CHARS( DISPLAY6, '<--', 9, 9) 01015 ISTATUS = SMG$PUT_CHARS( DISPLAY6, '-->', 9, 25) 01016 ISTATUS = SMG$PUT_CHARS( DISPLAY6, '+', 4, 18) 01017 ISTATUS = SMG$PUT_CHARS( DISPLAY6, '-', 7, 18) 01018 ISTATUS = SMG$PUT_CHARS( DISPLAY6, '*', 7, 10) 01019 ISTATUS = SMG$PUT_CHARS( DISPLAY6, '/', 7, 26) 01020 01021 ISTATUS = SMG$DRAW_LINE ( DISPLAY6, 3, 15, 3, 21) 01022 ISTATUS = SMG$DRAW_LINE ( DISPLAY6, 3, 21, 5, 21) 01023 ISTATUS = SMG$DRAW_LINE ( DISPLAY6, 3, 15, 5, 15) 01024 ISTATUS = SMG$DRAW_LINE ( DISPLAY6, 5, 15, 5, 21) 01025 01026 ISTATUS = SMG$DRAW_LINE ( DISPLAY6, 6, 7, 6, 13) 01027 ISTATUS = SMG$DRAW_LINE ( DISPLAY6, 6, 13, 8, 13) 01028 ISTATUS = SMG$DRAW_LINE ( DISPLAY6, 6, 7, 8, 7) 01029 ISTATUS = SMG$DRAW_LINE ( DISPLAY6, 8, 7, 8, 13) 01030 01031 ISTATUS = SMG$DRAW_LINE ( DISPLAY6, 6, 15, 6, 21) 01032 ISTATUS = SMG$DRAW_LINE ( DISPLAY6, 6, 21, 8, 21) 01033 ISTATUS = SMG$DRAW_LINE ( DISPLAY6, 6, 15, 8, 15) 01034 ISTATUS = SMG$DRAW_LINE ( DISPLAY6, 8, 15, 8, 21) 01035 01036 ISTATUS = SMG$DRAW_LINE ( DISPLAY6, 6, 23, 6, 29) 01037 ISTATUS = SMG$DRAW_LINE ( DISPLAY6, 6, 29, 8, 29) 01038 ISTATUS = SMG$DRAW_LINE ( DISPLAY6, 6, 23, 8, 23) 01039 ISTATUS = SMG$DRAW_LINE ( DISPLAY6, 8, 23, 8, 29) 01040 01041 ELSE !Else not VT200 series terminal. Draw arrows normally) 01042 ISTATUS = SMG$PUT_CHARS( DISPLAY6, '(arrows)', 4, 14) 01043 ISTATUS = SMG$PUT_CHARS( DISPLAY6, 'up', 5, 4) 01044 ISTATUS = SMG$PUT_CHARS( DISPLAY6, 'down', 5, 11) 01045 ISTATUS = SMG$PUT_CHARS( DISPLAY6, '<--', 5, 21) 01046 ISTATUS = SMG$PUT_CHARS( DISPLAY6, '-->', 5, 28) 01047 ISTATUS = SMG$PUT_CHARS( DISPLAY6, '+', 7, 5) 01048 ISTATUS = SMG$PUT_CHARS( DISPLAY6, '-', 7, 13) DRAW_CALC 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 64 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 01049 ISTATUS = SMG$PUT_CHARS( DISPLAY6, '*', 7, 22) 01050 ISTATUS = SMG$PUT_CHARS( DISPLAY6, '/', 7, 30) 01051 01052 ISTATUS = SMG$DRAW_LINE ( DISPLAY6, 6, 2, 6, 8) 01053 ISTATUS = SMG$DRAW_LINE ( DISPLAY6, 6, 8, 8, 8) 01054 ISTATUS = SMG$DRAW_LINE ( DISPLAY6, 6, 2, 8, 2) 01055 ISTATUS = SMG$DRAW_LINE ( DISPLAY6, 8, 2, 8, 8) 01056 01057 ISTATUS = SMG$DRAW_LINE ( DISPLAY6, 6, 10, 6, 16) 01058 ISTATUS = SMG$DRAW_LINE ( DISPLAY6, 6, 16, 8, 16) 01059 ISTATUS = SMG$DRAW_LINE ( DISPLAY6, 6, 10, 8, 10) 01060 ISTATUS = SMG$DRAW_LINE ( DISPLAY6, 8, 10, 8, 16) 01061 01062 ISTATUS = SMG$DRAW_LINE ( DISPLAY6, 6, 19, 6, 25) 01063 ISTATUS = SMG$DRAW_LINE ( DISPLAY6, 6, 25, 8, 25) 01064 ISTATUS = SMG$DRAW_LINE ( DISPLAY6, 6, 19, 8, 19) 01065 ISTATUS = SMG$DRAW_LINE ( DISPLAY6, 8, 19, 8, 25) 01066 01067 ISTATUS = SMG$DRAW_LINE ( DISPLAY6, 6, 27, 6, 33) 01068 ISTATUS = SMG$DRAW_LINE ( DISPLAY6, 6, 33, 8, 33) 01069 ISTATUS = SMG$DRAW_LINE ( DISPLAY6, 6, 27, 8, 27) 01070 ISTATUS = SMG$DRAW_LINE ( DISPLAY6, 8, 27, 8, 33) 01071 ENDIF 01072 01073 C+ 01074 C Paste the virtual displays. 01075 ISTATUS = SMG$PASTE_VIRTUAL_DISPLAY ( DISPLAY4, PASTE1, 7, 38) 01076 ISTATUS = SMG$PASTE_VIRTUAL_DISPLAY ( DISPLAY2, PASTE1, 9, 38) 01077 ISTATUS = SMG$PASTE_VIRTUAL_DISPLAY ( DISPLAY1, PASTE1, 5, 38) 01078 ISTATUS = SMG$PASTE_VIRTUAL_DISPLAY ( DISPLAY5, PASTE1, 4, 38) 01079 ISTATUS = SMG$PASTE_VIRTUAL_DISPLAY ( DISPLAY3, PASTE1,13, 3) 01080 ISTATUS = SMG$PASTE_VIRTUAL_DISPLAY ( DISPLAY6, PASTE1, 3, 3) 01081 END DRAW_CALC 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 65 01 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 1060 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 662 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 3132 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD 3 DISPLAYS 24 PIC OVR REL GBL SHR NOEXE RD WRT QUAD 4 TERM 4 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 4882 ENTRY POINTS Address Type Name 0-00000000 DRAW_CALC VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name ** I*4 COLUMNS 3-00000000 I*4 DISPLAY1 3-00000004 I*4 DISPLAY2 3-00000008 I*4 DISPLAY3 3-0000000C I*4 DISPLAY4 3-00000010 I*4 DISPLAY5 3-00000014 I*4 DISPLAY6 ** I*4 ISTATUS ** I*4 KEYBOARD1 2-00000000 I*4 PASTE1 ** I*4 ROWS ** I*4 SMG$PUT_LINE 4-00000000 L*4 VT200 FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name R*4 SMG$DRAW_LINE I*4 SMG$PASTE_VIRTUAL_DISPLAY R*4 SMG$PUT_CHARS 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 66 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00002 SUBROUTINE DRAW_HELP ( FLAG ) 00003 C THIS ROUTINE HAS BEEN DISABLED 00004 00005 C Draws the bottom part of the help display 00006 00007 PARAMETER DT$_VT100 = '00000060'X 00008 PARAMETER DT$_VT52 = '00000040'X 00009 00010 INTEGER IO_CHAN,TT_TYPE,FIX_NUM 00011 BYTE G_ON(3),G_OFF(3) 00012 LOGICAL FLAG 00013 00014 DATA G_ON / 27,'(','0' / 00015 DATA G_OFF / 27,'(','B' / 00016 00017 COMMON / SCREEN / IO_CHAN,TT_TYPE,FIX_NUM 00018 00019 IF ( TT_TYPE .EQ. DT$_VT100 ) THEN 00020 CALL OUT_BYTE ( 3,G_ON ) 00021 CALL OUT_CHAR ( 20, 1,34,'qqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqq' ) 00022 CALL OUT_CHAR ( 20,35,34,'qqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqq' ) 00023 CALL OUT_CHAR ( 20,69,11,'qqqqqqqqqqq' ) 00024 CALL OUT_BYTE ( 3,G_OFF ) 00025 ELSEIF ( TT_TYPE .EQ. DT$_VT52 ) THEN 00026 CALL OUT_CHAR ( 20, 1,34,'----------------------------------' ) 00027 CALL OUT_CHAR ( 20,35,34,'----------------------------------' ) 00028 CALL OUT_CHAR ( 20,69,11,'-----------' ) 00029 END IF 00030 IF ( FLAG ) THEN 00031 CALL OUT_CHAR ( 21,13,34,'Type A SPACE to continue the o' ) 00032 CALL OUT_CHAR ( 21,47,10,'utput; or,' ) 00033 ELSE 00034 CALL OUT_CHAR ( 22,13,4,'Type' ) 00035 END IF 00036 CALL OUT_CHAR ( 22,18,37,'ANOTHER KEY for help on that key; or,' ) 00037 CALL OUT_CHAR ( 23,18,29,'A CTRL-Z to return to CALC' ) 00038 CALL MOVE_TO ( 24,1 ) 00039 00040 RETURN 00041 END DRAW_HELP 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 67 01 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 165 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 285 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 352 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD 3 SCREEN 12 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 814 ENTRY POINTS Address Type Name 0-00000000 DRAW_HELP VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 3-00000008 I*4 FIX_NUM AP-00000004@ L*4 FLAG 3-00000000 I*4 IO_CHAN 3-00000004 I*4 TT_TYPE ARRAYS Address Type Name Bytes Dimensions 2-00000003 L*1 G_OFF 3 (3) 2-00000000 L*1 G_ON 3 (3) FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name MOVE_TO OUT_BYTE OUT_CHAR 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 68 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00002 SUBROUTINE E 00003 00004 C Puts E in the X register and in LASTX 00005 00006 REAL*8 X,Y,Z,T,LASTX 00007 BYTE LAST 00008 LOGICAL PUSH_FLAG,RADS,D_OK 00009 00010 COMMON / STACK / X,Y,Z,T,LASTX,PUSH_FLAG,LAST,RADS,D_OK 00011 00012 IF ( .NOT.PUSH_FLAG ) CALL LOAD_X_REG 00013 00014 CALL PUSH_STACK 00015 X = 2.71828182845904523536 00016 LASTX = X 00017 00018 PUSH_FLAG = .TRUE. 00019 LAST = 0 00020 00021 CALL DISPLAY 00022 00023 RETURN 00024 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 74 PIC CON REL LCL SHR EXE RD NOWRT QUAD 3 STACK 53 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 127 ENTRY POINTS Address Type Name 0-00000000 E VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 3-00000031 L*4 D_OK 3-0000002C L*1 LAST 3-00000020 R*8 LASTX 3-00000028 L*4 PUSH_FLAG 3-0000002D L*4 RADS 3-00000018 R*8 T 3-00000000 R*8 X 3-00000008 R*8 Y 3-00000010 R*8 Z E 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 69 01 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name DISPLAY LOAD_X_REG PUSH_STACK 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 70 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00002 SUBROUTINE ENTER 00003 00004 C Enters the display into the stack 00005 00006 PARAMETER CARR_RETURN = '0000000D'X 00007 00008 REAL*8 X,Y,Z,T,LASTX 00009 BYTE LAST 00010 LOGICAL PUSH_FLAG,RADS,D_OK 00011 00012 COMMON / STACK / X,Y,Z,T,LASTX,PUSH_FLAG,LAST,RADS,D_OK 00013 00014 IF ( .NOT.PUSH_FLAG ) CALL LOAD_X_REG 00015 00016 CALL PUSH_STACK 00017 X = Y 00018 00019 PUSH_FLAG = .FALSE. 00020 LAST = CARR_RETURN 00021 00022 CALL DISPLAY 00023 00024 RETURN 00025 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 55 PIC CON REL LCL SHR EXE RD NOWRT QUAD 3 STACK 53 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 108 ENTRY POINTS Address Type Name 0-00000000 ENTER VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 3-00000031 L*4 D_OK 3-0000002C L*1 LAST 3-00000020 R*8 LASTX 3-00000028 L*4 PUSH_FLAG 3-0000002D L*4 RADS 3-00000018 R*8 T 3-00000000 R*8 X 3-00000008 R*8 Y 3-00000010 R*8 Z ENTER 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 71 01 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name DISPLAY LOAD_X_REG PUSH_STACK 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 72 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00002 SUBROUTINE ERR_HAND ( CODE ) 00003 00004 C CALC's error handler 00005 00006 INTEGER CODE,LENGTH, SMG$PUT_CHARS 00007 INTEGER DISPLAY1, DISPLAY2, DISPLAY3, DISPLAY4, DISPLAY5, 00008 * DISPLAY6 00009 CHARACTER MODE*1,STRING*37,LINE*67 00010 LOGICAL ERROR,BELL 00011 00012 COMMON / DISPLAYS / DISPLAY1,DISPLAY2,DISPLAY3,DISPLAY4,DISPLAY5, 00013 * DISPLAY6 00014 COMMON / DISP / ERROR,MODE,STRING 00015 00016 IF ( CODE .EQ. 0 ) THEN 00017 LINE = ' ' 00018 BELL = .FALSE. 00019 ERROR = .FALSE. 00020 ELSE 00021 ERROR = .TRUE. 00022 IF ( CODE .EQ. -1 ) THEN 00023 LINE = 'Enter a hexadecimal digit between 1 and F' 00024 BELL = .FALSE. 00025 ELSEIF ( CODE .EQ. -2 ) THEN 00026 LINE = 'Type a key for help on that key ' 00027 BELL = .FALSE. 00028 ELSEIF ( CODE .EQ. -3 ) THEN 00029 LINE = 'Unrecognized input' 00030 BELL = .TRUE. 00031 ELSEIF ( CODE .EQ. -4 ) THEN 00032 LINE = 'Delete not allowed now' 00033 BELL = .TRUE. 00034 ELSEIF ( CODE .EQ. -5 ) THEN 00035 LINE = 'Display overflow' 00036 BELL = .TRUE. 00037 ELSEIF ( CODE .EQ. -6 ) THEN 00038 LINE = 'Invalid digit for this mode' 00039 BELL = .TRUE. 00040 ELSEIF ( CODE .EQ. -7 ) THEN 00041 LINE = 'Decimal point already entered' 00042 BELL = .TRUE. 00043 ELSEIF ( CODE .EQ. -8 ) THEN 00044 LINE = 'Exponent limited to 2 digits' 00045 BELL = .TRUE. 00046 ELSEIF ( CODE .EQ. -9 ) THEN 00047 LINE = 'Exponent delimiter already entered' 00048 BELL = .TRUE. 00049 ELSEIF ( CODE .EQ. -10 ) THEN 00050 LINE = 'Numeric digit must precede E' 00051 BELL = .TRUE. 00052 ELSEIF ( CODE .EQ. -11 ) THEN 00053 LINE = 'Decimal point not allowed in exponent' 00054 BELL = .TRUE. 00055 ELSEIF ( CODE .EQ. -12 ) THEN 00056 LINE = 'Bad FIX precision parameter' 00057 BELL = .TRUE. ERR_HAND 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 73 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00058 ELSEIF ( CODE .EQ. -13 ) THEN 00059 LINE = 'Internal overflow' 00060 BELL = .TRUE. 00061 ELSEIF ( CODE .EQ. -14 ) THEN 00062 LINE = 'Arithmetic error' 00063 BELL = .TRUE. 00064 ELSEIF ( CODE .EQ. -15 ) THEN 00065 C LINE = 'Type ? for general instructions' !HELP HAS BEEN DISABLED 00066 LINE = ' ' 00067 BELL = .FALSE. 00068 ELSE 00069 CALL SYS$GETMSG ( %VAL(CODE),LENGTH,LINE,%VAL(1), ) 00070 LINE(LENGTH+1:67) = ' ' 00071 BELL = .TRUE. 00072 END IF 00073 CALL STR$TRIM ( LINE,LINE,LENGTH ) 00074 END IF 00075 00076 IF ( BELL ) CALL SMG$RING_BELL( DISPLAY5 ) 00077 ISTATUS = SMG$PUT_CHARS( DISPLAY5, LINE, 1, 1) 00078 CALL MOVE_TO ( 24,1 ) 00079 00080 RETURN 00081 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 567 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 380 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 160 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD 3 DISPLAYS 24 PIC OVR REL GBL SHR NOEXE RD WRT QUAD 4 DISP 42 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 1173 ENTRY POINTS Address Type Name 0-00000000 ERR_HAND VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name ** L*4 BELL AP-00000004@ I*4 CODE 3-00000000 I*4 DISPLAY1 3-00000004 I*4 DISPLAY2 3-00000008 I*4 DISPLAY3 3-0000000C I*4 DISPLAY4 3-00000010 I*4 DISPLAY5 3-00000014 I*4 DISPLAY6 4-00000000 L*4 ERROR ** I*4 ISTATUS 2-00000044 I*4 LENGTH 2-00000000 CHAR LINE 4-00000004 CHAR MODE 4-00000005 CHAR STRING ERR_HAND 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 74 01 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name Type Name Type Name MOVE_TO I*4 SMG$PUT_CHARS SMG$RING_BELL STR$TRIM SYS$GETMSG 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 75 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00001 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 76 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00003 SUBROUTINE EXCHANGE 00004 00005 C Exchanges the X and Y registers 00006 00007 REAL*8 X,Y,Z,T,Q,LASTX 00008 BYTE LAST 00009 LOGICAL PUSH_FLAG,RADS,D_OK 00010 00011 COMMON / STACK / X,Y,Z,T,LASTX,PUSH_FLAG,LAST,RADS,D_OK 00012 00013 IF ( .NOT.PUSH_FLAG ) CALL LOAD_X_REG 00014 00015 Q = X 00016 X = Y 00017 Y = Q 00018 00019 PUSH_FLAG = .TRUE. 00020 LAST = 0 00021 00022 CALL DISPLAY 00023 00024 RETURN 00025 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 62 PIC CON REL LCL SHR EXE RD NOWRT QUAD 3 STACK 53 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 115 ENTRY POINTS Address Type Name 0-00000000 EXCHANGE VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 3-00000031 L*4 D_OK 3-0000002C L*1 LAST 3-00000020 R*8 LASTX 3-00000028 L*4 PUSH_FLAG ** R*8 Q 3-0000002D L*4 RADS 3-00000018 R*8 T 3-00000000 R*8 X 3-00000008 R*8 Y 3-00000010 R*8 Z EXCHANGE 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 77 01 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name DISPLAY LOAD_X_REG 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 78 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00002 SUBROUTINE EXPONENT 00003 00004 C Calculates Y**X 00005 00006 REAL*8 X,Y,Z,T,LASTX 00007 BYTE LAST 00008 LOGICAL PUSH_FLAG,RADS,D_OK 00009 00010 COMMON / STACK / X,Y,Z,T,LASTX,PUSH_FLAG,LAST,RADS,D_OK 00011 00012 IF ( .NOT.PUSH_FLAG ) CALL LOAD_X_REG 00013 00014 IF ( X .LT. 0. ) THEN 00015 X = 1. / (Y**(-X)) 00016 ELSE 00017 X = Y**X 00018 END IF 00019 Y = Z 00020 Z = T 00021 T = 0. 00022 00023 PUSH_FLAG = .TRUE. 00024 LAST = 0 00025 00026 CALL DISPLAY 00027 00028 RETURN 00029 END EXPONENT 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 79 01 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 89 PIC CON REL LCL SHR EXE RD NOWRT QUAD 3 STACK 53 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 142 ENTRY POINTS Address Type Name 0-00000000 EXPONENT VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 3-00000031 L*4 D_OK 3-0000002C L*1 LAST 3-00000020 R*8 LASTX 3-00000028 L*4 PUSH_FLAG 3-0000002D L*4 RADS 3-00000018 R*8 T 3-00000000 R*8 X 3-00000008 R*8 Y 3-00000010 R*8 Z FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name DISPLAY LOAD_X_REG 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 80 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00002 SUBROUTINE FIX ( NEW_NUM ) 00003 00004 C Changes the number of decimal digits in 'E' and 'F' modes 00005 00006 CHARACTER NEW_NUM*1 00007 INTEGER FIX_NUM,IO_CHAN,TT_TYPE,TEMP 00008 REAL*8 X,Y,Z,T,LASTX 00009 BYTE LAST 00010 LOGICAL PUSH_FLAG,RADS,D_OK 00011 00012 COMMON / SCREEN / IO_CHAN,TT_TYPE,FIX_NUM 00013 COMMON / STACK / X,Y,Z,T,LASTX,PUSH_FLAG,LAST,RADS,D_OK 00014 00015 IF ( .NOT.PUSH_FLAG ) CALL LOAD_X_REG 00016 00017 DECODE ( 1,10,NEW_NUM,ERR=1000 ) TEMP 00018 10 FORMAT ( Z1 ) 00019 00020 IF ( TEMP.GT.0 .AND. TEMP.LE.15 ) THEN 00021 CALL ERR_HAND ( 0 ) 00022 FIX_NUM = TEMP 00023 ELSE 00024 1000 CALL ERR_HAND ( 0 ) 00025 CALL ERR_HAND ( -12 ) 00026 END IF 00027 00028 PUSH_FLAG = .TRUE. 00029 LAST = 0 00030 00031 CALL DISPLAY 00032 00033 RETURN 00034 END FIX 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 81 01 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 133 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 11 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 36 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD 3 SCREEN 12 PIC OVR REL GBL SHR NOEXE RD WRT QUAD 4 STACK 53 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 245 ENTRY POINTS Address Type Name 0-00000000 FIX VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 4-00000031 L*4 D_OK 3-00000008 I*4 FIX_NUM 3-00000000 I*4 IO_CHAN 4-0000002C L*1 LAST 4-00000020 R*8 LASTX AP-00000004@ CHAR NEW_NUM 4-00000028 L*4 PUSH_FLAG 4-0000002D L*4 RADS 4-00000018 R*8 T 2-00000000 I*4 TEMP 3-00000004 I*4 TT_TYPE 4-00000000 R*8 X 4-00000008 R*8 Y 4-00000010 R*8 Z LABELS Address Label Address Label 1-00000008 10' 0-00000060 1000 FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name DISPLAY ERR_HAND LOAD_X_REG 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 82 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00002 SUBROUTINE FRACTION 00003 00004 C Strips off the integer part of X 00005 00006 REAL*8 X,Y,Z,T,LASTX 00007 BYTE LAST 00008 LOGICAL PUSH_FLAG,RADS,D_OK 00009 00010 COMMON / STACK / X,Y,Z,T,LASTX,PUSH_FLAG,LAST,RADS,D_OK 00011 00012 IF ( .NOT.PUSH_FLAG ) CALL LOAD_X_REG 00013 00014 X = X - DFLOTJ( JIDINT(X) ) 00015 00016 PUSH_FLAG = .TRUE. 00017 LAST = 0 00018 00019 CALL DISPLAY 00020 00021 RETURN 00022 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 54 PIC CON REL LCL SHR EXE RD NOWRT QUAD 3 STACK 53 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 107 ENTRY POINTS Address Type Name 0-00000000 FRACTION VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 3-00000031 L*4 D_OK 3-0000002C L*1 LAST 3-00000020 R*8 LASTX 3-00000028 L*4 PUSH_FLAG 3-0000002D L*4 RADS 3-00000018 R*8 T 3-00000000 R*8 X 3-00000008 R*8 Y 3-00000010 R*8 Z FRACTION 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 83 01 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name Type Name R*8 DFLOTJ DISPLAY I*4 JIDINT LOAD_X_REG 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 84 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00002 SUBROUTINE GET_INPUT ( INPUT ) 00003 00004 C Asks for and analyzes a character from the keyboard 00005 00006 INCLUDE '($SMGDEF)' 00884 C PARAMETER SMG$K_TRM_EXCLAMATION_POINT = '00000021'X ! ! 00885 C PARAMETER SMG$K_TRM_LEFT_PAREN = '00000028'X ! ( 00886 C PARAMETER SMG$K_TRM_RIGHT_PAREN = '00000029'X ! ) 00887 C PARAMETER SMG$K_TRM_PLUS_SIGN = '0000002B'X ! + 00888 C PARAMETER SMG$K_TRM_ZERO = '00000030'X ! 0 00889 00890 CHARACTER INPUT*1 00891 LOGICAL ERR_CHECK 00892 INTEGER SMG$READ_KEYSTROKE, KEY 00893 00894 COMMON / ERROR / ERR_CHECK 00895 COMMON / KEYBOARD / KEYBOARD1 00896 00897 ERR_CHECK = .FALSE. 00898 00899 CALL SMG$READ_KEYSTROKE ( KEYBOARD1, KEY ) 00900 00901 INPUT = 'X' !This should cause an error unless input is changed 00902 !upon parsing the keystroke below. A bit kludgy. 00903 00904 C ****************************************************************** 00905 C -------------- CONTROL INPUTS 000 - 031 --------------------- 00906 IF ( KEY .LT. SMG$K_TRM_SPACE ) THEN !CONTROL INPUTS 00907 00908 00909 C -------------MISCELANEOUS !"#$%&'()*+,-./ ------------------------ 00910 ELSEIF ( KEY .LT. SMG$K_TRM_ZERO ) THEN !MISC 00911 00912 00913 C --------------- NUMBERS 0-9 -------------------------------------- 00914 ELSEIF ( KEY .LE. SMG$K_TRM_NINE ) THEN !NUMBERS 00915 INPUT = CHAR( KEY ) 00916 00917 00918 C ------------- MISCELLANEOUS :;<=>?@ ------------------------------ 00919 ELSEIF ( KEY .LT. SMG$K_TRM_UPPERCASE_A ) THEN !MISC 00920 00921 00922 C -------------- LETTERS A-Z --------------------------------------- 00923 ELSEIF ( KEY .LE. SMG$K_TRM_UPPERCASE_Z) THEN !UPPERCAE ALPHABET 00924 INPUT = CHAR( KEY ) 00925 00926 00927 C ---------------- MISCELANEOUS [\]^_` ----------------------------- 00928 ELSEIF ( KEY .LT. SMG$K_TRM_LOWERCASE_A ) THEN !MISC 00929 00930 00931 C ---------------- lowercase letters a-z --------------------------- 00932 ELSEIF ( KEY .LE. SMG$K_TRM_LOWERCASE_Z ) THEN !lowercase alphabet 00933 INPUT = CHAR( KEY ) 00934 CALL STR$UPCASE ( INPUT, INPUT ) GET_INPUT 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 85 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00935 00936 00937 C ----------------- MISCELLANEOUS {|}~ del ------------------------- 00938 ELSEIF ( KEY .LT. SMG$K_TRM_PF1 ) THEN !MISC 00939 00940 00941 C ------------------ KEYPAD PF1-PF4 -------------------------------- 00942 ELSEIF ( KEY .LE. SMG$K_TRM_PF4 ) THEN !PF1-PF4 00943 00944 00945 00946 C --------------------- KEYPAD 0-9 --------------------------------- 00947 ELSEIF ( KEY .LE. SMG$K_TRM_KP9 ) THEN !KP0-KP9 00948 IF ( KEY .EQ. SMG$K_TRM_KP0 ) THEN 00949 INPUT = '0' 00950 ELSEIF ( KEY .EQ. SMG$K_TRM_KP1 ) THEN 00951 INPUT = '1' 00952 ELSEIF ( KEY .EQ. SMG$K_TRM_KP2 ) THEN 00953 INPUT = '2' 00954 ELSEIF ( KEY .EQ. SMG$K_TRM_KP3 ) THEN 00955 INPUT = '3' 00956 ELSEIF ( KEY .EQ. SMG$K_TRM_KP4 ) THEN 00957 INPUT = '4' 00958 ELSEIF ( KEY .EQ. SMG$K_TRM_KP5 ) THEN 00959 INPUT = '5' 00960 ELSEIF ( KEY .EQ. SMG$K_TRM_KP6 ) THEN 00961 INPUT = '6' 00962 ELSEIF ( KEY .EQ. SMG$K_TRM_KP7 ) THEN 00963 INPUT = '7' 00964 ELSEIF ( KEY .EQ. SMG$K_TRM_KP8 ) THEN 00965 INPUT = '8' 00966 ELSEIF ( KEY .EQ. SMG$K_TRM_KP9 ) THEN 00967 INPUT = '9' 00968 END IF 00969 00970 00971 C --------------------- MISCELLANEOUS ------------------------------ 00972 ELSEIF ( KEY .LT. SMG$K_TRM_F1 ) THEN !MISC 00973 00974 C -------------- END CASE ------------------------------------------ 00975 ENDIF 00976 00977 RETURN 00978 END GET_INPUT 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 86 01 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 341 PIC CON REL LCL SHR EXE RD NOWRT QUAD 2 $LOCAL 36 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD 3 ERROR 4 PIC OVR REL GBL SHR NOEXE RD WRT QUAD 4 KEYBOARD 4 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 385 ENTRY POINTS Address Type Name 0-00000000 GET_INPUT VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 3-00000000 L*4 ERR_CHECK AP-00000004@ CHAR INPUT 2-00000000 I*4 KEY 4-00000000 I*4 KEYBOARD1 FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name CHAR CHAR SMG$READ_KEYSTROKE STR$UPCASE 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 87 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00001 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 88 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00003 INTEGER FUNCTION HANDLER ( SIGARGS,MECHARGS ) 00004 00005 C Error condition handler 00006 00007 EXTERNAL PATCH_FAULT 00008 00009 PARAMETER SS$_CONTINUE = '00000001'X 00010 PARAMETER SS$_RESIGNAL = '00000918'X 00011 PARAMETER SS$_FLTDIV_F = '000004BC'X 00012 PARAMETER SS$_FLTOVF_F = '000004B4'X 00013 PARAMETER SS$_FLTUND_F = '000004C4'X 00014 00015 INTEGER SIGARGS(1:*),MECHARGS(1:*) 00016 LOGICAL ERR_CHECK 00017 00018 COMMON / ERROR / ERR_CHECK 00019 00020 ERR_CHECK = .NOT.ERR_CHECK 00021 IF ( .NOT.ERR_CHECK ) THEN 00022 00023 C If HANDLER has been called twice in a row, the condition must 00024 C be unrecoverable 00025 00026 HANDLER = SS$_RESIGNAL 00027 00028 ELSE 00029 00030 C Otherwise, attempt to recover 00031 00032 IF ( SIGARGS(2) .EQ. SS$_FLTOVF_F ) THEN 00033 CALL ERR_HAND ( -13 ) 00034 ELSE 00035 CALL ERR_HAND ( -14 ) 00036 END IF 00037 00038 IF ( SIGARGS(2).EQ.SS$_FLTDIV_F .OR. 00039 . SIGARGS(2).EQ.SS$_FLTOVF_F .OR. 00040 . SIGARGS(2).EQ.SS$_FLTUND_F ) THEN 00041 00042 HANDLER = LIB$DECODE_FAULT ( SIGARGS, 00043 . MECHARGS, 00044 . %DESCR(PATCH_FAULT),, ) 00045 00046 ELSE 00047 00048 MECHARGS(3) = '00000000'X 00049 MECHARGS(4) = '00000000'X 00050 HANDLER = SS$_CONTINUE 00051 00052 END IF 00053 00054 END IF 00055 00056 RETURN 00057 END HANDLER 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 89 01 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 167 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 8 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 92 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD 3 ERROR 4 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 271 ENTRY POINTS Address Type Name 0-00000000 I*4 HANDLER VARIABLES Address Type Name 3-00000000 L*4 ERR_CHECK ARRAYS Address Type Name Bytes Dimensions AP-00000008@ I*4 MECHARGS ** (*) AP-00000004@ I*4 SIGARGS ** (*) FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name ERR_HAND I*4 LIB$DECODE_FAULT PATCH_FAULT 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 90 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00002 SUBROUTINE HELP ( KEY ) 00003 C HELP HAS BEEN DISABLED 00004 C Functions as an online help facility 00005 00006 PARAMETER DT$_VT100 = '00000060'X 00007 PARAMETER DT$_VT52 = '00000040'X 00008 PARAMETER CARR_RETURN = '0000000D'X 00009 PARAMETER LBR$C_READ = '00000001'X 00010 PARAMETER LBR$C_TYP_TXT = '00000004'X 00011 PARAMETER LBR$_NORMAL = '00268001'X 00012 PARAMETER SS$_NORMAL = '00000001'X 00013 PARAMETER RMS$_EOF = '0001827A'X 00014 PARAMETER DELETE = '0000007F'X 00015 PARAMETER CTRL_B = '00000002'X 00016 PARAMETER CTRL_E = '00000005'X 00017 PARAMETER CTRL_F = '00000006'X 00018 PARAMETER CTRL_H = '00000008'X 00019 PARAMETER CTRL_I = '00000009'X 00020 PARAMETER CTRL_O = '0000000F'X 00021 PARAMETER CTRL_Z = '0000001A'X 00022 00023 CHARACTER KEY*1,LINE*67,LIBKEY*6 00024 INTEGER IO_CHAN,TT_TYPE,FIX_NUM,INDEX,STATUS,LBR$OPEN,RFA(2), 00025 . LBR$LOOKUP_KEY,LBR$GET_RECORD,O_STAT,STR$POSITION 00026 LOGICAL MORE 00027 00028 COMMON / SCREEN / IO_CHAN,TT_TYPE,FIX_NUM 00029 00030 C Open CALC's help library 00031 00032 CALL LBR$INI_CONTROL ( INDEX,LBR$C_READ,LBR$C_TYP_TXT, ) 00033 O_STAT = LBR$OPEN ( INDEX,'CALC$HELPFILE',,,,, ) 00034 00035 C Help loop 00036 00037 1000 CONTINUE 00038 00039 IF ( KEY .EQ. CHAR( CARR_RETURN ) ) THEN 00040 LIBKEY = 'CR' 00041 ELSEIF ( KEY .EQ. CHAR( DELETE ) ) THEN 00042 LIBKEY = 'DEL' 00043 ELSEIF ( KEY .EQ. CHAR( CTRL_B ) ) THEN 00044 LIBKEY = 'CTRL_B' 00045 ELSEIF ( KEY .EQ. CHAR( CTRL_E ) ) THEN 00046 LIBKEY = 'CTRL_E' 00047 ELSEIF ( KEY .EQ. CHAR( CTRL_F ) ) THEN 00048 LIBKEY = 'CTRL_F' 00049 ELSEIF ( KEY .EQ. CHAR( CTRL_H ) ) THEN 00050 IF ( TT_TYPE .EQ. DT$_VT100 ) THEN 00051 LIBKEY = 'BS100' 00052 ELSEIF ( TT_TYPE .EQ. DT$_VT52 ) THEN 00053 LIBKEY = 'BS52' 00054 END IF 00055 ELSEIF ( KEY .EQ. CHAR( CTRL_I ) ) THEN 00056 LIBKEY = 'CTRL_I' 00057 ELSEIF ( KEY .EQ. CHAR( CTRL_O ) ) THEN HELP 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 91 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00058 LIBKEY = 'CTRL_O' 00059 ELSEIF ( KEY .EQ. ',' ) THEN 00060 LIBKEY = 'COMMA' 00061 ELSEIF ( KEY .EQ. '+' ) THEN 00062 LIBKEY = 'PLUS' 00063 ELSEIF ( KEY .EQ. '-' ) THEN 00064 LIBKEY = 'MINUS' 00065 ELSEIF ( KEY .EQ. '*' ) THEN 00066 LIBKEY = 'STAR' 00067 ELSEIF ( KEY .EQ. '/' ) THEN 00068 LIBKEY = 'SLASH' 00069 ELSE 00070 LIBKEY = KEY 00071 END IF 00072 00073 STATUS = LBR$LOOKUP_KEY ( INDEX,LIBKEY,RFA ) 00074 IF ( STATUS .EQ. SS$_NORMAL ) THEN 00075 00076 1100 CALL CLEAR_SCREEN 00077 MORE = .TRUE. 00078 DO I = 1, 18 00079 LINE = ' ' 00080 STATUS = LBR$GET_RECORD ( INDEX,LINE, ) 00081 IF ( STATUS .EQ. RMS$_EOF ) THEN 00082 MORE = .FALSE. 00083 GO TO 1400 00084 ELSE 00085 IF ( TT_TYPE .EQ. DT$_VT52 ) THEN 00086 1200 CONTINUE 00087 J = STR$POSITION( LINE,'BLACK' ) 00088 IF ( J .NE. 0 ) THEN 00089 LINE(J:J+4) = 'UPPER' 00090 ELSE 00091 J = STR$POSITION( LINE,'WHITE' ) 00092 IF ( J .NE. 0 ) THEN 00093 LINE(J:J+4) = 'LOWER' 00094 ELSE 00095 GO TO 1300 00096 END IF 00097 END IF 00098 GO TO 1200 00099 END IF 00100 1300 CALL STR$TRIM ( LINE,LINE,J ) 00101 CALL OUT_CHAR ( I,13,J,LINE ) 00102 END IF 00103 END DO 00104 00105 ELSE 00106 00107 CALL CLEAR_SCREEN 00108 MORE = .FALSE. 00109 IF ( O_STAT .NE. LBR$_NORMAL ) THEN 00110 CALL OUT_CHAR ( 4,13,25,'Unable to open help file:' ) 00111 CALL ERR_HAND ( O_STAT ) 00112 ELSE 00113 CALL OUT_CHAR ( 4,13,29,'That key does nothing; typing' ) 00114 CALL OUT_CHAR ( 4,42,28,' it will result in an error' ) HELP 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 92 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00115 END IF 00116 00117 END IF 00118 00119 1400 CALL DRAW_HELP ( MORE ) 00120 CALL GET_INPUT ( KEY ) 00121 IF ( MORE .AND. KEY.EQ.' ' ) THEN 00122 GO TO 1100 00123 ELSEIF ( KEY .EQ. CHAR( CTRL_Z ) ) THEN 00124 CALL LBR$CLOSE ( INDEX ) 00125 CALL RESET 00126 RETURN 00127 END IF 00128 00129 GO TO 1000 00130 00131 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 647 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 215 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 412 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD 3 SCREEN 12 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 1286 ENTRY POINTS Address Type Name 0-00000000 HELP VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 3-00000008 I*4 FIX_NUM 2-00000060 I*4 I 2-00000054 I*4 INDEX 3-00000000 I*4 IO_CHAN 2-00000064 I*4 J AP-00000004@ CHAR KEY 2-0000004B CHAR LIBKEY 2-00000008 CHAR LINE 2-0000005C L*4 MORE 2-00000058 I*4 O_STAT ** I*4 STATUS 3-00000004 I*4 TT_TYPE ARRAYS Address Type Name Bytes Dimensions 2-00000000 I*4 RFA 8 (2) HELP 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 93 01 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 LABELS Address Label Address Label Address Label Address Label Address Label 0-00000028 1000 0-000001CE 1100 ** 1200 0-00000250 1300 0-000001AC 1400 FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name CHAR CHAR CLEAR_SCREEN DRAW_HELP ERR_HAND GET_INPUT LBR$CLOSE I*4 LBR$GET_RECORD LBR$INI_CONTROL I*4 LBR$LOOKUP_KEY I*4 LBR$OPEN OUT_CHAR RESET I*4 STR$POSITION STR$TRIM 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 94 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00002 SUBROUTINE INITIALIZE 00003 00004 C Initializes the calculator 00005 00006 INTEGER IO_CHAN,TT_TYPE,FIX_NUM 00007 REAL*8 X,Y,Z,T,LASTX 00008 BYTE LAST 00009 LOGICAL PUSH_FLAG,RADS,D_OK 00010 00011 COMMON / SCREEN / IO_CHAN,TT_TYPE,FIX_NUM 00012 COMMON / STACK / X,Y,Z,T,LASTX,PUSH_FLAG,LAST,RADS,D_OK 00013 COMMON / PASTE / PASTE1 00014 00015 C Establish a channel to the terminal 00016 00017 CALL SYS$ASSIGN ( 'SYS$COMMAND',IO_CHAN,, ) 00018 00019 C Set the defaults and clear the stack 00020 00021 FIX_NUM = 4 00022 LAST = 0 00023 D_OK = .FALSE. 00024 00025 C Write out the display 00026 CALL CREATE_DISPLAYS 00027 CALL ERR_HAND ( -15 ) 00028 CALL DRAW_CALC 00029 CALL CHANGE_MODE ( 'F',0 ) 00030 CALL CHANGE_TRIG ( 'RAD',0 ) 00031 CALL CLEAR_STACK 00032 CALL MOVE_TO (1,1) 00033 00034 RETURN 00035 END INITIALIZE 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 95 01 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 90 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 30 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 88 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD 3 SCREEN 12 PIC OVR REL GBL SHR NOEXE RD WRT QUAD 4 STACK 53 PIC OVR REL GBL SHR NOEXE RD WRT QUAD 5 PASTE 4 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 277 ENTRY POINTS Address Type Name 0-00000000 INITIALIZE VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 4-00000031 L*4 D_OK 3-00000008 I*4 FIX_NUM 3-00000000 I*4 IO_CHAN 4-0000002C L*1 LAST 4-00000020 R*8 LASTX 5-00000000 R*4 PASTE1 4-00000028 L*4 PUSH_FLAG 4-0000002D L*4 RADS 4-00000018 R*8 T 3-00000004 I*4 TT_TYPE 4-00000000 R*8 X 4-00000008 R*8 Y 4-00000010 R*8 Z FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name CHANGE_MODE CHANGE_TRIG CLEAR_STACK CREATE_DISPLAYS DRAW_CALC ERR_HAND MOVE_TO SYS$ASSIGN 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 96 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00001 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 97 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00003 SUBROUTINE INTEGER 00004 00005 C Integerizes the X register 00006 00007 REAL*8 X,Y,Z,T,LASTX 00008 BYTE LAST 00009 LOGICAL PUSH_FLAG,RADS,D_OK 00010 00011 COMMON / STACK / X,Y,Z,T,LASTX,PUSH_FLAG,LAST,RADS,D_OK 00012 00013 IF ( .NOT.PUSH_FLAG ) CALL LOAD_X_REG 00014 00015 X = DFLOTJ( JIDINT(X) ) 00016 00017 PUSH_FLAG = .TRUE. 00018 LAST = 0 00019 00020 CALL DISPLAY 00021 00022 RETURN 00023 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 51 PIC CON REL LCL SHR EXE RD NOWRT QUAD 3 STACK 53 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 104 ENTRY POINTS Address Type Name 0-00000000 INTEGER VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 3-00000031 L*4 D_OK 3-0000002C L*1 LAST 3-00000020 R*8 LASTX 3-00000028 L*4 PUSH_FLAG 3-0000002D L*4 RADS 3-00000018 R*8 T 3-00000000 R*8 X 3-00000008 R*8 Y 3-00000010 R*8 Z INTEGER 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 98 01 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name Type Name R*8 DFLOTJ DISPLAY I*4 JIDINT LOAD_X_REG 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 99 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00002 SUBROUTINE INVERT 00003 00004 C Calculates 1 / X 00005 00006 REAL*8 X,Y,Z,T,LASTX 00007 BYTE LAST 00008 LOGICAL PUSH_FLAG,RADS,D_OK 00009 00010 COMMON / STACK / X,Y,Z,T,LASTX,PUSH_FLAG,LAST,RADS,D_OK 00011 00012 IF ( .NOT.PUSH_FLAG ) CALL LOAD_X_REG 00013 00014 X = 1. / X 00015 00016 PUSH_FLAG = .TRUE. 00017 LAST = 0 00018 00019 CALL DISPLAY 00020 00021 RETURN 00022 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 49 PIC CON REL LCL SHR EXE RD NOWRT QUAD 3 STACK 53 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 102 ENTRY POINTS Address Type Name 0-00000000 INVERT VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 3-00000031 L*4 D_OK 3-0000002C L*1 LAST 3-00000020 R*8 LASTX 3-00000028 L*4 PUSH_FLAG 3-0000002D L*4 RADS 3-00000018 R*8 T 3-00000000 R*8 X 3-00000008 R*8 Y 3-00000010 R*8 Z INVERT 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 100 01 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name DISPLAY LOAD_X_REG 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 101 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00002 SUBROUTINE LAST_X 00003 00004 C Puts the last-entered number in the X register 00005 00006 REAL*8 X,Y,Z,T,LASTX 00007 BYTE LAST 00008 LOGICAL PUSH_FLAG,RADS,D_OK 00009 00010 COMMON / STACK / X,Y,Z,T,LASTX,PUSH_FLAG,LAST,RADS,D_OK 00011 00012 IF ( .NOT.PUSH_FLAG ) CALL LOAD_X_REG 00013 00014 CALL PUSH_STACK 00015 X = LASTX 00016 00017 PUSH_FLAG = .TRUE. 00018 LAST = 0 00019 00020 CALL DISPLAY 00021 00022 RETURN 00023 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 55 PIC CON REL LCL SHR EXE RD NOWRT QUAD 3 STACK 53 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 108 ENTRY POINTS Address Type Name 0-00000000 LAST_X VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 3-00000031 L*4 D_OK 3-0000002C L*1 LAST 3-00000020 R*8 LASTX 3-00000028 L*4 PUSH_FLAG 3-0000002D L*4 RADS 3-00000018 R*8 T 3-00000000 R*8 X 3-00000008 R*8 Y 3-00000010 R*8 Z LAST_X 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 102 01 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name DISPLAY LOAD_X_REG PUSH_STACK 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 103 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00002 SUBROUTINE LOAD_X_REG 00003 00004 C Loads the X register 00005 00006 PARAMETER CARR_RETURN = '0000000D'X 00007 00008 CHARACTER STRING*37,MODE*1 00009 REAL*8 X,Y,Z,T,LASTX 00010 BYTE LAST 00011 INTEGER I_X,STR$POSITION 00012 LOGICAL PUSH_FLAG,ERROR,MINUS,RADS,D_OK 00013 00014 COMMON / STACK / X,Y,Z,T,LASTX,PUSH_FLAG,LAST,RADS,D_OK 00015 COMMON / DISP / ERROR,MODE,STRING 00016 00017 IF ( LAST .EQ. CARR_RETURN ) RETURN 00018 00019 IF ( MODE .EQ. 'I' ) THEN 00020 DECODE ( 37,10,STRING,ERR=1100 ) I_X 00021 X = DFLOTJ( I_X ) 00022 ELSEIF ( MODE.EQ.'B' .OR. MODE.EQ.'O' .OR. MODE.EQ.'H' ) THEN 00023 MINUS = .FALSE. 00024 DO I = 1, 37 00025 IF ( STRING(I:I) .EQ. '-' ) THEN 00026 STRING(I:I) = ' ' 00027 MINUS = .TRUE. 00028 GO TO 1000 00029 END IF 00030 END DO 00031 1000 IF ( MODE .EQ. 'B' ) THEN 00032 I_X = 0 00033 DO I = 7, 37 00034 IF ( STRING(I:I) .EQ. '1' ) THEN 00035 I_X = I_X + 2**(37-I) 00036 END IF 00037 END DO 00038 X = DFLOTJ( I_X ) 00039 ELSEIF ( MODE .EQ. 'O' ) THEN 00040 DECODE ( 37,20,STRING,ERR=1100 ) I_X 00041 X = DFLOTJ( I_X ) 00042 ELSEIF ( MODE .EQ. 'H' ) THEN 00043 DECODE ( 37,30,STRING,ERR=1100 ) I_X 00044 X = DFLOTJ( I_X ) 00045 END IF 00046 IF ( MINUS ) X = -X 00047 ELSEIF ( MODE .EQ. 'F' ) THEN 00048 IF ( STR$POSITION( STRING,'.' ) .EQ. 0 ) THEN 00049 STRING = STRING(2:37)//'.' 00050 END IF 00051 DECODE ( 37,40,STRING,ERR=1100 ) X 00052 ELSEIF ( MODE .EQ. 'E' ) THEN 00053 IF ( STRING(33:33).NE.' ' .AND. STRING(34:34).EQ.' ' ) THEN 00054 STRING(34:34) = 'D' 00055 IF ( STRING(35:35) .EQ. ' ' ) STRING(35:35) = '+' 00056 ELSE 00057 IF ( STR$POSITION( STRING,'.' ) .EQ. 0 ) THEN LOAD_X_REG 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 104 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00058 I = STR$POSITION( STRING,'E' ) 00059 IF ( I .EQ. 0 ) THEN 00060 STRING = STRING(2:37)//'.' 00061 ELSE 00062 STRING(1:I-1) = STRING(2:I-1)//'.' 00063 END IF 00064 END IF 00065 END IF 00066 DECODE ( 37,50,STRING,ERR=1100 ) X 00067 END IF 00068 00069 LASTX = X 00070 RETURN 00071 00072 C Error in decoding 00073 00074 1100 CALL ERR_HAND ( -5 ) 00075 X = 0. 00076 00077 RETURN 00078 00079 10 FORMAT ( I37 ) 00080 20 FORMAT ( O37 ) 00081 30 FORMAT ( Z37 ) 00082 40 FORMAT ( F37.16 ) 00083 50 FORMAT ( E37.16 ) 00084 00085 END LOAD_X_REG 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 105 01 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 565 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 25 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 80 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD 3 STACK 53 PIC OVR REL GBL SHR NOEXE RD WRT QUAD 4 DISP 42 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 765 ENTRY POINTS Address Type Name 0-00000000 LOAD_X_REG VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 3-00000031 L*4 D_OK 4-00000000 L*4 ERROR ** I*4 I 2-00000000 I*4 I_X 3-0000002C L*1 LAST 3-00000020 R*8 LASTX ** L*4 MINUS 4-00000004 CHAR MODE 3-00000028 L*4 PUSH_FLAG 3-0000002D L*4 RADS 4-00000005 CHAR STRING 3-00000018 R*8 T 3-00000000 R*8 X 3-00000008 R*8 Y 3-00000010 R*8 Z LABELS Address Label Address Label Address Label Address Label Address Label Address Label 1-00000008 10' 1-0000000B 20' 1-0000000E 30' 1-00000011 40' 1-00000015 50' 0-00000090 1000 0-00000224 1100 FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name R*8 DFLOTJ ERR_HAND I*4 STR$POSITION 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 106 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00002 SUBROUTINE LOG_10 00003 00004 C Calculates LOG( X ) 00005 00006 REAL*8 X,Y,Z,T,LASTX 00007 BYTE LAST 00008 LOGICAL PUSH_FLAG,RADS,D_OK 00009 00010 COMMON / STACK / X,Y,Z,T,LASTX,PUSH_FLAG,LAST,RADS,D_OK 00011 00012 IF ( .NOT.PUSH_FLAG ) CALL LOAD_X_REG 00013 00014 X = DLOG10( X ) 00015 00016 PUSH_FLAG = .TRUE. 00017 LAST = 0 00018 00019 CALL DISPLAY 00020 00021 RETURN 00022 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 57 PIC CON REL LCL SHR EXE RD NOWRT QUAD 3 STACK 53 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 110 ENTRY POINTS Address Type Name 0-00000000 LOG_10 VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 3-00000031 L*4 D_OK 3-0000002C L*1 LAST 3-00000020 R*8 LASTX 3-00000028 L*4 PUSH_FLAG 3-0000002D L*4 RADS 3-00000018 R*8 T 3-00000000 R*8 X 3-00000008 R*8 Y 3-00000010 R*8 Z LOG_10 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 107 01 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name DISPLAY R*8 DLOG10 LOAD_X_REG 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 108 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00002 SUBROUTINE LOG_E 00003 00004 C Calculates LN( X ) 00005 00006 REAL*8 X,Y,Z,T,LASTX 00007 BYTE LAST 00008 LOGICAL PUSH_FLAG,RADS,D_OK 00009 00010 COMMON / STACK / X,Y,Z,T,LASTX,PUSH_FLAG,LAST,RADS,D_OK 00011 00012 IF ( .NOT.PUSH_FLAG ) CALL LOAD_X_REG 00013 00014 X = DLOG( X ) 00015 00016 PUSH_FLAG = .TRUE. 00017 LAST = 0 00018 00019 CALL DISPLAY 00020 00021 RETURN 00022 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 57 PIC CON REL LCL SHR EXE RD NOWRT QUAD 3 STACK 53 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 110 ENTRY POINTS Address Type Name 0-00000000 LOG_E VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 3-00000031 L*4 D_OK 3-0000002C L*1 LAST 3-00000020 R*8 LASTX 3-00000028 L*4 PUSH_FLAG 3-0000002D L*4 RADS 3-00000018 R*8 T 3-00000000 R*8 X 3-00000008 R*8 Y 3-00000010 R*8 Z LOG_E 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 109 01 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name DISPLAY R*8 DLOG LOAD_X_REG 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 110 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00002 SUBROUTINE MOVE_TO ( LINE,COLUMN ) 00003 00004 C Moves the cursor out of the way. Line and column are not used. 00005 00006 INTEGER LINE, COLUMN 00007 INTEGER SMG$SET_CURSOR_ABS 00008 INTEGER DISPLAY1, DISPLAY2, DISPLAY3, DISPLAY4, DISPLAY5, 00009 * DISPLAY6 00010 COMMON / DISPLAYS / DISPLAY1,DISPLAY2,DISPLAY3,DISPLAY4,DISPLAY5, 00011 * DISPLAY6 00012 00013 ISTATUS = SMG$SET_CURSOR_ABS( DISPLAY3, 11, 1 ) 00014 RETURN 00015 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 17 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 8 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 16 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD 3 DISPLAYS 24 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 65 ENTRY POINTS Address Type Name 0-00000000 MOVE_TO VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name AP-00000008@ I*4 COLUMN 3-00000000 I*4 DISPLAY1 3-00000004 I*4 DISPLAY2 3-00000008 I*4 DISPLAY3 3-0000000C I*4 DISPLAY4 3-00000010 I*4 DISPLAY5 3-00000014 I*4 DISPLAY6 ** I*4 ISTATUS AP-00000004@ I*4 LINE FUNCTIONS AND SUBROUTINES REFERENCED Type Name I*4 SMG$SET_CURSOR_ABS 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 111 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00001 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 112 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00003 SUBROUTINE MULTIPLY 00004 00005 C Multiplies X by Y 00006 00007 REAL*8 X,Y,Z,T,LASTX 00008 BYTE LAST 00009 LOGICAL PUSH_FLAG,RADS,D_OK 00010 00011 COMMON / STACK / X,Y,Z,T,LASTX,PUSH_FLAG,LAST,RADS,D_OK 00012 00013 C Load the X register if necessary 00014 00015 IF ( .NOT.PUSH_FLAG ) CALL LOAD_X_REG 00016 00017 X = X * Y 00018 Y = Z 00019 Z = T 00020 T = 0. 00021 00022 PUSH_FLAG = .TRUE. 00023 LAST = 0 00024 00025 CALL DISPLAY 00026 00027 RETURN 00028 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 52 PIC CON REL LCL SHR EXE RD NOWRT QUAD 3 STACK 53 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 105 ENTRY POINTS Address Type Name 0-00000000 MULTIPLY VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 3-00000031 L*4 D_OK 3-0000002C L*1 LAST 3-00000020 R*8 LASTX 3-00000028 L*4 PUSH_FLAG 3-0000002D L*4 RADS 3-00000018 R*8 T 3-00000000 R*8 X 3-00000008 R*8 Y 3-00000010 R*8 Z MULTIPLY 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 113 01 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name DISPLAY LOAD_X_REG 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 114 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00002 SUBROUTINE OUT_BYTE ( LENGTH,STRING ) 00003 00004 C THIS SUBROUTINE SHOULD NO LONGE BE CALLED. USE SMG SERVICES INSTEAD 00005 C Writes out a byte string of given length 00006 00007 PARAMETER IO$_WRITEVBLK = '00000030'X 00008 PARAMETER IO$M_NOFORMAT = '00000100'X 00009 PARAMETER IO$M_CANCTRLO = '00000040'X 00010 00011 BYTE STRING(100) 00012 INTEGER IO_CHAN,LENGTH,TT_TYPE,FIX_NUM 00013 00014 COMMON / SCREEN / IO_CHAN,TT_TYPE,FIX_NUM 00015 00016 CALL SYS$QIOW ( %VAL(0), 00017 . %VAL(IO_CHAN), 00018 . %VAL(IO$_WRITEVBLK+ 00019 . IO$M_CANCTRL0+ 00020 . IO$M_NOFORMAT),,,, 00021 . STRING, 00022 . %VAL(LENGTH),,,, ) 00023 00024 RETURN 00025 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 59 PIC CON REL LCL SHR EXE RD NOWRT QUAD 2 $LOCAL 76 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD 3 SCREEN 12 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 147 ENTRY POINTS Address Type Name 0-00000000 OUT_BYTE VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 3-00000008 I*4 FIX_NUM 2-00000000 I*4 IO$M_CANCTRL0 3-00000000 I*4 IO_CHAN AP-00000004@ I*4 LENGTH 3-00000004 I*4 TT_TYPE OUT_BYTE 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 115 01 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 ARRAYS Address Type Name Bytes Dimensions AP-00000008@ L*1 STRING 100 (100) FUNCTIONS AND SUBROUTINES REFERENCED Type Name SYS$QIOW 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 116 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00002 SUBROUTINE OUT_CHAR ( X,Y,LENGTH,STRING ) 00003 C THIS SUBROUTINE SHOULD NO LONGE BE CALLED. USE SMG SERVICES INSTEAD 00004 00005 C Writes out a character string of given length at (X,Y) 00006 00007 PARAMETER IO$_WRITEVBLK = '00000030'X 00008 PARAMETER IO$M_NOFORMAT = '00000100'X 00009 PARAMETER IO$M_CANCTRLO = '00000040'X 00010 00011 CHARACTER STRING*100 00012 INTEGER IO_CHAN,LENGTH,TT_TYPE,FIX_NUM,X,Y 00013 00014 COMMON / SCREEN / IO_CHAN,TT_TYPE,FIX_NUM 00015 00016 CALL MOVE_TO ( X,Y ) 00017 00018 CALL SYS$QIOW ( %VAL(0), 00019 . %VAL(IO_CHAN), 00020 . %VAL(IO$_WRITEVBLK+ 00021 . IO$M_CANCTRLO+ 00022 . IO$M_NOFORMAT),,,, 00023 . %REF(STRING), 00024 . %VAL(LENGTH),,,, ) 00025 00026 RETURN 00027 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 62 PIC CON REL LCL SHR EXE RD NOWRT QUAD 2 $LOCAL 72 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD 3 SCREEN 12 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 146 ENTRY POINTS Address Type Name 0-00000000 OUT_CHAR VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 3-00000008 I*4 FIX_NUM 3-00000000 I*4 IO_CHAN AP-0000000C@ I*4 LENGTH AP-00000010@ CHAR STRING 3-00000004 I*4 TT_TYPE AP-00000004@ I*4 X AP-00000008@ I*4 Y OUT_CHAR 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 117 01 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name MOVE_TO SYS$QIOW 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 118 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00002 INTEGER FUNCTION PATCH_FAULT ( OPCODE,PC,PSL,REGISTERS,OP_COUNT, 00003 . OP_TYPES,READ_OPS,WRITE_OPS, 00004 . SIGARGS,SIGNAL,CONTEXT,USERARG ) 00005 00006 C Dummy routine needed by LIB$DECODE_FAULT 00007 00008 PARAMETER SS$_CONTINUE = '00000001'X 00009 00010 INTEGER OPCODE,PC,PSL,REGISTERS(15),OP_COUNT,OP_TYPES(1:*), 00011 . READ_OPS(1:*),WRITE_OPS(1:*),SIGARGS(1:*),SIGNAL, 00012 . CONTEXT,USERARG 00013 00014 PATCH_FAULT = SS$_CONTINUE 00015 00016 RETURN 00017 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 68 PIC CON REL LCL SHR EXE RD NOWRT QUAD 2 $LOCAL 104 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 172 ENTRY POINTS Address Type Name 0-00000000 I*4 PATCH_FAULT VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name AP-0000002C@ I*4 CONTEXT AP-00000004@ I*4 OPCODE AP-00000014@ I*4 OP_COUNT AP-00000008@ I*4 PC AP-0000000C@ I*4 PSL AP-00000028@ I*4 SIGNAL AP-00000030@ I*4 USERARG ARRAYS Address Type Name Bytes Dimensions AP-00000018@ I*4 OP_TYPES ** (*) AP-0000001C@ I*4 READ_OPS ** (*) AP-00000010@ I*4 REGISTERS 60 (15) AP-00000024@ I*4 SIGARGS ** (*) AP-00000020@ I*4 WRITE_OPS ** (*) 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 119 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00002 SUBROUTINE PI 00003 00004 C Puts PI in the X register and in LASTX 00005 00006 REAL*8 X,Y,Z,T,LASTX 00007 BYTE LAST 00008 LOGICAL PUSH_FLAG,RADS,D_OK 00009 00010 COMMON / STACK / X,Y,Z,T,LASTX,PUSH_FLAG,LAST,RADS,D_OK 00011 00012 IF ( .NOT.PUSH_FLAG ) CALL LOAD_X_REG 00013 00014 CALL PUSH_STACK 00015 X = 3.1415926535897932384626433 00016 LASTX = X 00017 00018 PUSH_FLAG = .TRUE. 00019 LAST = 0 00020 00021 CALL DISPLAY 00022 00023 RETURN 00024 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 74 PIC CON REL LCL SHR EXE RD NOWRT QUAD 3 STACK 53 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 127 ENTRY POINTS Address Type Name 0-00000000 PI VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 3-00000031 L*4 D_OK 3-0000002C L*1 LAST 3-00000020 R*8 LASTX 3-00000028 L*4 PUSH_FLAG 3-0000002D L*4 RADS 3-00000018 R*8 T 3-00000000 R*8 X 3-00000008 R*8 Y 3-00000010 R*8 Z PI 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 120 01 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name DISPLAY LOAD_X_REG PUSH_STACK 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 121 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00002 SUBROUTINE POWER_10 00003 00004 C Calculates 10**X 00005 00006 REAL*8 X,Y,Z,T,LASTX 00007 BYTE LAST 00008 LOGICAL PUSH_FLAG,RADS,D_OK 00009 00010 COMMON / STACK / X,Y,Z,T,LASTX,PUSH_FLAG,LAST,RADS,D_OK 00011 00012 IF ( .NOT.PUSH_FLAG ) CALL LOAD_X_REG 00013 00014 IF ( X .LT. 0. ) THEN 00015 X = 1. / 10.**(-X) 00016 ELSE 00017 X = 10.**X 00018 END IF 00019 00020 PUSH_FLAG = .TRUE. 00021 LAST = 0 00022 00023 CALL DISPLAY 00024 00025 RETURN 00026 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 75 PIC CON REL LCL SHR EXE RD NOWRT QUAD 3 STACK 53 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 128 ENTRY POINTS Address Type Name 0-00000000 POWER_10 VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 3-00000031 L*4 D_OK 3-0000002C L*1 LAST 3-00000020 R*8 LASTX 3-00000028 L*4 PUSH_FLAG 3-0000002D L*4 RADS 3-00000018 R*8 T 3-00000000 R*8 X 3-00000008 R*8 Y 3-00000010 R*8 Z POWER_10 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 122 01 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name DISPLAY LOAD_X_REG 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 123 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00002 SUBROUTINE POWER_E 00003 00004 C Calculates E**X 00005 00006 REAL*8 X,Y,Z,T,LASTX 00007 BYTE LAST 00008 LOGICAL PUSH_FLAG,RADS,D_OK 00009 00010 COMMON / STACK / X,Y,Z,T,LASTX,PUSH_FLAG,LAST,RADS,D_OK 00011 00012 IF ( .NOT.PUSH_FLAG ) CALL LOAD_X_REG 00013 00014 IF ( X .LT. 0. ) THEN 00015 X = 1. / DEXP( -X ) 00016 ELSE 00017 X = DEXP( X ) 00018 END IF 00019 00020 PUSH_FLAG = .TRUE. 00021 LAST = 0 00022 00023 CALL DISPLAY 00024 00025 RETURN 00026 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 67 PIC CON REL LCL SHR EXE RD NOWRT QUAD 3 STACK 53 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 120 ENTRY POINTS Address Type Name 0-00000000 POWER_E VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 3-00000031 L*4 D_OK 3-0000002C L*1 LAST 3-00000020 R*8 LASTX 3-00000028 L*4 PUSH_FLAG 3-0000002D L*4 RADS 3-00000018 R*8 T 3-00000000 R*8 X 3-00000008 R*8 Y 3-00000010 R*8 Z POWER_E 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 124 01 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name R*8 DEXP DISPLAY LOAD_X_REG 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 125 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00002 SUBROUTINE PUSH_STACK 00003 00004 C Pushes the stack up 00005 00006 REAL*8 X,Y,Z,T,LASTX 00007 BYTE LAST 00008 LOGICAL PUSH_FLAG,RADS,D_OK 00009 00010 COMMON / STACK / X,Y,Z,T,LASTX,PUSH_FLAG,LAST,RADS,D_OK 00011 00012 T = Z 00013 Z = Y 00014 Y = X 00015 X = 0. 00016 00017 RETURN 00018 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 42 PIC CON REL LCL SHR EXE RD NOWRT QUAD 3 STACK 53 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 95 ENTRY POINTS Address Type Name 0-00000000 PUSH_STACK VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 3-00000031 L*4 D_OK 3-0000002C L*1 LAST 3-00000020 R*8 LASTX 3-00000028 L*4 PUSH_FLAG 3-0000002D L*4 RADS 3-00000018 R*8 T 3-00000000 R*8 X 3-00000008 R*8 Y 3-00000010 R*8 Z 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 126 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00002 SUBROUTINE RESET 00003 00004 C Resets the display 00005 00006 INTEGER PASTE1, SMG$REPAINT_SCREEN 00007 COMMON / PASTE / PASTE1 00008 00009 C Write out the display 00010 ISTATUS = SMG$REPAINT_SCREEN( PASTE1 ) 00011 RETURN 00012 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 17 PIC CON REL LCL SHR EXE RD NOWRT QUAD 2 $LOCAL 8 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD 3 PASTE 4 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 29 ENTRY POINTS Address Type Name 0-00000000 RESET VARIABLES Address Type Name Address Type Name ** I*4 ISTATUS 3-00000000 I*4 PASTE1 FUNCTIONS AND SUBROUTINES REFERENCED Type Name I*4 SMG$REPAINT_SCREEN 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 127 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00001 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 128 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00003 SUBROUTINE ROLL_DOWN 00004 00005 C Rolls the stack down 00006 00007 REAL*8 X,Y,Z,T,Q,LASTX 00008 BYTE LAST 00009 LOGICAL PUSH_FLAG,RADS,D_OK 00010 00011 COMMON / STACK / X,Y,Z,T,LASTX,PUSH_FLAG,LAST,RADS,D_OK 00012 00013 IF ( .NOT.PUSH_FLAG ) CALL LOAD_X_REG 00014 00015 Q = X 00016 X = Y 00017 Y = Z 00018 Z = T 00019 T = Q 00020 00021 PUSH_FLAG = .TRUE. 00022 LAST = 0 00023 00024 CALL DISPLAY 00025 00026 RETURN 00027 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 56 PIC CON REL LCL SHR EXE RD NOWRT QUAD 3 STACK 53 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 109 ENTRY POINTS Address Type Name 0-00000000 ROLL_DOWN VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 3-00000031 L*4 D_OK 3-0000002C L*1 LAST 3-00000020 R*8 LASTX 3-00000028 L*4 PUSH_FLAG ** R*8 Q 3-0000002D L*4 RADS 3-00000018 R*8 T 3-00000000 R*8 X 3-00000008 R*8 Y 3-00000010 R*8 Z ROLL_DOWN 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 129 01 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name DISPLAY LOAD_X_REG 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 130 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00002 SUBROUTINE ROLL_UP 00003 00004 C Rolls the stack up 00005 00006 REAL*8 X,Y,Z,T,Q,LASTX 00007 BYTE LAST 00008 LOGICAL PUSH_FLAG,RADS,D_OK 00009 00010 COMMON / STACK / X,Y,Z,T,LASTX,PUSH_FLAG,LAST,RADS,D_OK 00011 00012 IF ( .NOT.PUSH_FLAG ) CALL LOAD_X_REG 00013 00014 Q = T 00015 T = Z 00016 Z = Y 00017 Y = X 00018 X = Q 00019 00020 PUSH_FLAG = .TRUE. 00021 LAST = 0 00022 00023 CALL DISPLAY 00024 00025 RETURN 00026 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 56 PIC CON REL LCL SHR EXE RD NOWRT QUAD 3 STACK 53 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 109 ENTRY POINTS Address Type Name 0-00000000 ROLL_UP VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 3-00000031 L*4 D_OK 3-0000002C L*1 LAST 3-00000020 R*8 LASTX 3-00000028 L*4 PUSH_FLAG ** R*8 Q 3-0000002D L*4 RADS 3-00000018 R*8 T 3-00000000 R*8 X 3-00000008 R*8 Y 3-00000010 R*8 Z ROLL_UP 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 131 01 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name DISPLAY LOAD_X_REG 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 132 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00002 SUBROUTINE SINE 00003 00004 C Calculates SIN( X ) 00005 00006 REAL*8 X,Y,Z,T,LASTX 00007 BYTE LAST 00008 LOGICAL PUSH_FLAG,RADS,D_OK 00009 00010 COMMON / STACK / X,Y,Z,T,LASTX,PUSH_FLAG,LAST,RADS,D_OK 00011 00012 IF ( .NOT.PUSH_FLAG ) CALL LOAD_X_REG 00013 00014 IF ( RADS ) THEN 00015 X = DSIN( X ) 00016 ELSE 00017 X = DSIND( X ) 00018 END IF 00019 00020 PUSH_FLAG = .TRUE. 00021 LAST = 0 00022 00023 CALL DISPLAY 00024 00025 RETURN 00026 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 67 PIC CON REL LCL SHR EXE RD NOWRT QUAD 3 STACK 53 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 120 ENTRY POINTS Address Type Name 0-00000000 SINE VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 3-00000031 L*4 D_OK 3-0000002C L*1 LAST 3-00000020 R*8 LASTX 3-00000028 L*4 PUSH_FLAG 3-0000002D L*4 RADS 3-00000018 R*8 T 3-00000000 R*8 X 3-00000008 R*8 Y 3-00000010 R*8 Z SINE 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 133 01 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name Type Name DISPLAY R*8 DSIN R*8 DSIND LOAD_X_REG 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 134 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00002 SUBROUTINE SQUARE_ROOT 00003 00004 C Calculates the square root of X 00005 00006 REAL*8 X,Y,Z,T,LASTX 00007 BYTE LAST 00008 LOGICAL PUSH_FLAG,RADS,D_OK 00009 00010 COMMON / STACK / X,Y,Z,T,LASTX,PUSH_FLAG,LAST,RADS,D_OK 00011 00012 IF ( .NOT.PUSH_FLAG ) CALL LOAD_X_REG 00013 00014 X = DSQRT( X ) 00015 00016 PUSH_FLAG = .TRUE. 00017 LAST = 0 00018 00019 CALL DISPLAY 00020 00021 RETURN 00022 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 57 PIC CON REL LCL SHR EXE RD NOWRT QUAD 3 STACK 53 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 110 ENTRY POINTS Address Type Name 0-00000000 SQUARE_ROOT VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 3-00000031 L*4 D_OK 3-0000002C L*1 LAST 3-00000020 R*8 LASTX 3-00000028 L*4 PUSH_FLAG 3-0000002D L*4 RADS 3-00000018 R*8 T 3-00000000 R*8 X 3-00000008 R*8 Y 3-00000010 R*8 Z SQUARE_ROOT 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 135 01 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name DISPLAY R*8 DSQRT LOAD_X_REG 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 136 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00002 SUBROUTINE SQUARE_X 00003 00004 C Calculates X**2 00005 00006 REAL*8 X,Y,Z,T,LASTX 00007 BYTE LAST 00008 LOGICAL PUSH_FLAG,RADS,D_OK 00009 00010 COMMON / STACK / X,Y,Z,T,LASTX,PUSH_FLAG,LAST,RADS,D_OK 00011 00012 IF ( .NOT.PUSH_FLAG ) CALL LOAD_X_REG 00013 00014 X = X**2. 00015 00016 PUSH_FLAG = .TRUE. 00017 LAST = 0 00018 00019 CALL DISPLAY 00020 00021 RETURN 00022 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 48 PIC CON REL LCL SHR EXE RD NOWRT QUAD 3 STACK 53 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 101 ENTRY POINTS Address Type Name 0-00000000 SQUARE_X VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 3-00000031 L*4 D_OK 3-0000002C L*1 LAST 3-00000020 R*8 LASTX 3-00000028 L*4 PUSH_FLAG 3-0000002D L*4 RADS 3-00000018 R*8 T 3-00000000 R*8 X 3-00000008 R*8 Y 3-00000010 R*8 Z SQUARE_X 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 137 01 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name DISPLAY LOAD_X_REG 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 138 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00002 SUBROUTINE SUBTRACT 00003 00004 C Subtracts X from Y 00005 00006 REAL*8 X,Y,Z,T,LASTX 00007 BYTE LAST 00008 CHARACTER MODE*1,STRING*37 00009 LOGICAL PUSH_FLAG,ERROR,RADS,D_OK 00010 00011 COMMON / STACK / X,Y,Z,T,LASTX,PUSH_FLAG,LAST,RADS,D_OK 00012 COMMON / DISP / ERROR,MODE,STRING 00013 00014 C Load the X register if necessary 00015 00016 LAST = 0 00017 IF ( .NOT.PUSH_FLAG ) THEN 00018 IF ( MODE .EQ. 'E' ) THEN 00019 IF ( STRING(37:37) .EQ. 'E' ) THEN 00020 CALL ADD_DIGIT ( '-' ) 00021 RETURN 00022 ELSE 00023 CALL LOAD_X_REG 00024 END IF 00025 ELSE 00026 CALL LOAD_X_REG 00027 END IF 00028 END IF 00029 00030 X = Y - X 00031 Y = Z 00032 Z = T 00033 T = 0. 00034 00035 PUSH_FLAG = .TRUE. 00036 CALL DISPLAY 00037 00038 RETURN 00039 END SUBTRACT 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 139 01 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 101 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 2 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 16 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD 3 STACK 53 PIC OVR REL GBL SHR NOEXE RD WRT QUAD 4 DISP 42 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 214 ENTRY POINTS Address Type Name 0-00000000 SUBTRACT VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 3-00000031 L*4 D_OK 4-00000000 L*4 ERROR 3-0000002C L*1 LAST 3-00000020 R*8 LASTX 4-00000004 CHAR MODE 3-00000028 L*4 PUSH_FLAG 3-0000002D L*4 RADS 4-00000005 CHAR STRING 3-00000018 R*8 T 3-00000000 R*8 X 3-00000008 R*8 Y 3-00000010 R*8 Z FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name ADD_DIGIT DISPLAY LOAD_X_REG 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 140 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 00002 SUBROUTINE TANGENT 00003 00004 C Calculates TAN( X ) 00005 00006 REAL*8 X,Y,Z,T,LASTX 00007 BYTE LAST 00008 LOGICAL PUSH_FLAG,RADS,D_OK 00009 00010 COMMON / STACK / X,Y,Z,T,LASTX,PUSH_FLAG,LAST,RADS,D_OK 00011 00012 IF ( .NOT.PUSH_FLAG ) CALL LOAD_X_REG 00013 00014 IF ( RADS ) THEN 00015 X = DTAN( X ) 00016 ELSE 00017 X = DTAND( X ) 00018 END IF 00019 00020 PUSH_FLAG = .TRUE. 00021 LAST = 0 00022 00023 CALL DISPLAY 00024 00025 RETURN 00026 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 67 PIC CON REL LCL SHR EXE RD NOWRT QUAD 3 STACK 53 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 120 ENTRY POINTS Address Type Name 0-00000000 TANGENT VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 3-00000031 L*4 D_OK 3-0000002C L*1 LAST 3-00000020 R*8 LASTX 3-00000028 L*4 PUSH_FLAG 3-0000002D L*4 RADS 3-00000018 R*8 T 3-00000000 R*8 X 3-00000008 R*8 Y 3-00000010 R*8 Z TANGENT 11-Oct-1993 12:29:15 VAX FORTRAN V5.8-155 Page 141 01 4-Oct-1993 15:00:08 [DELEYD.LADONE.GREG.CALC2]CALC2.FOR_VAX;2 FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name Type Name DISPLAY R*8 DTAN R*8 DTAND LOAD_X_REG COMMAND QUALIFIERS FORTRAN/LIST=.LIS_VAX/OBJECT=.OBJ_VAX CALC2.FOR_VAX /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=DISK3:[DELEYD.LADONE.GREG.CALC2]CALC2.LIS_VAX;1 /OBJECT=DISK3:[DELEYD.LADONE.GREG.CALC2]CALC2.OBJ_VAX;1 COMPILATION STATISTICS Run Time: 9.57 seconds Elapsed Time: 44.35 seconds Page Faults: 1284 Dynamic Memory: 1284 pages