File: MULTI8.LS of Disk: V50/Source/Source-Listing-RALF-1
(Source file text)
RALF V50A 8-APR-92 PAGE 1
/GENERAL MULTI8 BACKGROUND FUNCTIONS
/
/
/ VERSION 50A 29-MAY-80 WVDM
/
/
/THE FOLLOWING IS A SET OF 8 MODE (RALF TYPE)
/ROUTINES THAT ENABLE MULTI8 BACKGROUND FUNCTIONS
/THESE ROUTINES ARE CALLABLE AT THE FORTRAN LEVEL
/
/ CALL MULTI8(OPTION,VALUE1,VALUE2)
/
/THE FOLLOWING OPTIONS ARE SUPPORTED:
/
/ 0 READ TIME OF DAY (HOURS,MINUTES)
/ 1 MACHINE (BACKGROUND, TERMINAL)
/ 2 DISABLE KEYBOARD ECHO (NO VALUES)
/ 3 ENABLE KEYBOARD ECHO (NO VALUES)
/ 4 NOT IMPLEMENTED
/ 5 NOT IMPLEMENTED
/ 6 SLEEP (NUMBER OF SECONDS,...)
/ 7 MULTI8 LOGICAL (LOGICAL,...)
/ 8 CPU TIME (VALUE [.1SECS],...)
/ 9 NOT IMPLEMENTED
/ 10 MULTI8 VERSION (VERSION CHAR,EDIT #)
/ 11 RELEASE !ALL! DEVICES (NO VALUES)
/
RALF V50A 8-APR-92 PAGE 2
SECT8 MULTI8
BSW=7002
MQA=7501
/
BASE 0
00000 0006 STARTD
00001 1100 SETX XR0
00002 0167
00003 0610 FLDA% 0,1 /GET PTR TO FUNCTION ARG
00004 6201 FSTA 3
00005 0005 STARTF
00006 0601 FLDA% 3 /USER ARG TO FAC
00007 1050 JLT ERROR /NEGATIVE FUNCTION ?
00010 0072
00011 0020 ATX 0 /INTEGER AND PASS TO 8 CODE
00012 0030 XTA 0 /FP INTERPRETER
00013 2400 FSUB MXFUN /TOO BIG ?
00014 0067
00015 1060 JGT ERROR /YES, FATAL
00016 0072
00017 0006 STARTD
00020 0620 FLDA% 0,2 /GET FIRST EXTRA ARG
00021 6201 FSTA 3 /LEAVE 3 POINTING AT ARG FOR END
00022 0005 STARTF
00023 0601 FLDA% 3 /FIRST EXTRA ARG TO XR4
00024 0024 ATX 4
00025 0030 XTA 0 /GET BACK FUNCTION
00026 0017 ALN 7 /*2
00027 0006 STARTD
00030 1400 FADD JATAB /ADD BASE OF DISPATCH TABLE
00031 0041
00032 6400 FSTA DISPA
00033 0035
00034 0005 STARTF
00035 1030 DISPA, JA .
00036 0035
RALF V50A 8-APR-92 PAGE 3
00037 1030 M8TBL, JA TIME /0:
00040 0117
00041 1030 JATAB, JA M8TBL /1: BG&TERM SAME FORMAT AS TIME
00042 0037
00043 1030 JA NOECH /2:
00044 0074
00045 1030 JA NOECH /3: ECHOON SAME FORMAT AS NOECHO
00046 0074
00047 1030 JA ERROR /4:
00050 0072
00051 1030 JA ERROR /5:
00052 0072
00053 1030 JA TIME /6: SLEEP SAME AS TIME
00054 0117
00055 1030 JA M8TES /7:
00056 0100
00057 1030 JA MACCR /8:
00060 0104
00061 1030 JA ERROR /9:
00062 0072
00063 1030 JA TIME /10:VERSION SAME FORMAT AS TIME
00064 0117
00065 1030 JA NOECH /11:RELEASE SAME AS NOECH
00066 0074
00067 0004 MXFUN, F 11.0
00070 2600
00071 0000
RALF V50A 8-APR-92 PAGE 4
EXTERN #ARGER
00072 4000 ERROR, TRAP4 #ARGER
00073 0000
/
00074 4000 NOECH, TRAP4 GIOT
00075 0143
00076 1030 JA GOBAK /NO ARGS
00077 0131
/
00100 4000 M8TES, TRAP4 M8T8
00101 0133
00102 1030 JA CONT
00103 0121
/
00104 4000 MACCR, TRAP4 GIOT
00105 0143
/MQ IS IN LOW-ORDER XR6
00106 0030 XTA 0
00107 0025 ATX 5 /AC TO HIGH-ORDER XR5
00110 0104 LDX 27,4 /27 TO EXP XR4
00111 0027
00112 0400 FLDA XR4 /NOW GET FP NUMBER
00113 0173
00114 0004 FNORM
00115 1030 JA CONT2 /GIVE BACK VALUE
00116 0122
/
00117 4000 TIME, TRAP4 GIOT
00120 0143
/ ...
00121 0034 CONT, XTA 4 /ANSWER IS IN XR4,XR5
00122 6601 CONT2, FSTA% 3 /GIVE ANS TO CALLER (3 STILL SET!)
00123 0006 STARTD
00124 0630 FLDA% 0,3 /THIRD ARGUMENT
00125 6201 FSTA 3
00126 0005 STARTF
00127 0035 XTA 5
00130 6601 FSTA% 3 /GIVE BACK THIRD ARG OR RUBBISH
00131 0210 GOBAK, FLDA 30 /RTN TO CALLER
00132 0007 JAC
RALF V50A 8-APR-92 PAGE 5
00133 0000 M8T8, 0
00134 7201 CLA IAC
00135 6254 6254 /SKIP ON MULTI8
00136 7200 CLA
00137 3373 DCA XR4 /SET LEFT BYTE
00140 3374 DCA XR5 /CLEAR RIGHT BYTE
00141 6203 CIF CDF 0
00142 5733 JMP% M8T8
/
00143 0000 GIOT, 0
00144 1373 TAD XR4 /GET ARG TO GIOT
00145 3351 DCA GARG
00146 1367 TAD XR0
00147 6770 6770
00150 5352 JMP .+2
00151 7402 GARG, HLT
00152 3367 DCA XR0 /NOW XR0 = GIOT AC
00153 1367 TAD XR0
00154 0366 AND M77
00155 3374 DCA XR5 /RIGHT BYTE
00156 1367 TAD XR0
00157 7002 BSW
00160 0366 AND M77
00161 3373 DCA XR4 /LEFT BYTE
00162 7501 MQA
00163 3375 DCA XR6 /MQ CONTENTS
00164 6203 CIF CDF 0
00165 5743 JMP% GIOT
00166 0077 M77, 77
/
00167 0000 XR0, 0 /GETS FUNCTION ON INPUT, GIOT AC ON OUTPUT
00170 0001 XR1, 1 /FOR ARG1
00171 0002 XR2, 2 /FOR ARG2
00172 0003 XR3, 3 /FOR ARG3
00173 0000 XR4, 0 /GETS LEFT BYTE ALSO: FP EXP
00174 0000 XR5, 0 /GETS RIGHT BYTE FP HI
00175 0000 XR6, 0 /GETS GIOT MQ FP LO
00176 0026 XR7, 26 /FOR MULTIPLYING INTEGER
RALF V50A 8-APR-92 PAGE 5-1
NO ERRORS
28 SYMBOLS, NO ABS REFS
# C 00000 #ARGER X 00000 #MAIN S 00000 BSW 07002
CONT 00121 CONT2 00122 DISPA 00035 ERROR 00072
GARG 00151 GIOT 00143 GOBAK 00131 JATAB 00041
MACCR 00104 MQA 07501 MULTI8 8 00177 MXFUN 00067
M77 00166 M8TBL 00037 M8TES 00100 M8T8 00133
NOECH 00074 TIME 00117 XR0 00167 XR1 00170
XR2 00171 XR3 00172 XR4 00173 XR5 00174
XR6 00175 XR7 00176