File: PSPEAK.LS of Disk: V50/Source/Source-Listing-FORTRAN-2
(Source file text)
RALF V50A 24-JUL-20 PAGE 1
SECT PSPEAK
/ SUBROUTINE PSPEAK(MSG,SKIP)
/ C
/ C FIND THE SKIP+1ST MESSAGE FOR OBJECT MSG AND PRINT IT.
/ C MSG SHOULD BE THE INDEX OF
/ C THE OBJECT. (INVEN+N+1 MESSAGE IS PROP=N MESSAGE).
/ C
/ IMPLICIT INTEGER (A-Z)
/ COMMON /TXTCOM/ RTEXT,LINES,ASCVAR
/ COMMON /PTXCOM/ PTEXT
/ DIMENSION RTEXT(205),LINES(36),PTEXT(100)
EXTERN IO
EXTERN SPEAK
00000 1030 JA #ST
00001 0071
#XR, ORG .+10
00012 2023 TEXT +PSPEAK+
00013 2005
00014 0113
00015 1100 #RET, SETX #XR
00016 0002
00017 1110 SETB #BASE
00020 0023
00021 1030 JA .+3
00022 0024
#BASE, ORG .+6
MSG, ORG .+3
SKIP, ORG .+3
00037 0001 ONE, F 1.0
00040 2000
00041 0000
#DOTMP, ORG .+3
OLDLOC, ORG .+3
ORG #BASE+30
00053 0040 FNOP
00054 1030 JA #RET
00055 0015
00056 0040 FNOP
00057 0000 #GOBAK, 0;0
00060 0000
I, ORG .+0003
M, ORG .+0003
#LBL=.
COMMON PTXCOM
PTEXT, ORG .+0454
COMMON TXTCOM
RTEXT, ORG .+1147
LINES, ORG .+0044
ASCVAR, ORG .+0003
TXTLOC, ORG .+0003
DATA, ORG .+0352
ORG #LBL
#RTN, BASE #BASE
00067 1030 JA #GOBAK
00070 0057
RALF V50A 24-JUL-20 PAGE 1-1
00071 0006 #ST, STARTD
00072 0210 0210
00073 6400 FSTA #GOBAK,0
00074 0057
00075 0200 0200
00076 1100 SETX #XR
00077 0002
00100 1110 SETB #BASE
00101 0023
00102 0101 LDX 0,1
00103 0000
00104 6200 FSTA #BASE
00105 0710 FLDA% #BASE,1+
00106 6202 FSTA MSG
00107 0710 FLDA% #BASE,1+
00110 6203 FSTA SKIP
00111 0005 STARTF
/ M=PTEXT(MSG)
00112 0602 FLDA% MSG
00113 0027 ATX 7
00114 0477 FLDA PTEXT-0003,7
00115 7775
00116 6213 FSTA M
/ IF(SKIP.LT.0)GOTO 9
00117 0603 FLDA% SKIP
00120 1050 JLT #9
00121 0163
/ OLDLOC=MSG
00122 0602 FLDA% MSG
00123 6206 FSTA OLDLOC
/ DO 3 I=1,SKIP+1
00124 0204 FLDA ONE
00125 6212 FSTA I
00126 0603 FLDA% SKIP
00127 1204 FADD ONE
00130 6205 FSTA #DOTMP
#G0001,
/ 1 READ(2'M)LOC,LINES
00131 1130 #1, JSR IO
00132 0000
00133 1030 JA .+0004
00134 0137
00135 1030 JA M
00136 0064
/ M = ASCVAR
00137 0213 FLDA M
00140 1204 FADD ONE
00141 6213 FSTA M
/ IF(LOC.EQ.OLDLOC) GO TO 1
00142 0400 FLDA TXTLOC
00143 1216
00144 2206 FSUB OLDLOC
00145 1000 JEQ #1
00146 0131
/ OLDLOC=LOC
RALF V50A 24-JUL-20 PAGE 1-2
00147 0400 FLDA TXTLOC
00150 1216
00151 6206 FSTA OLDLOC
/ 3 CONTINUE
00152 0212 #3, FLDA I
00153 1204 FADD ONE
00154 6212 FSTA I
00155 2205 FSUB #DOTMP
00156 1020 JLE #G0001
00157 0131
/ M=M-1
00160 0213 FLDA M
00161 2204 FSUB ONE
00162 6213 FSTA M
/ CALL SPEAK(M)
00163 1130 #9, JSR SPEAK
00164 0000
/ RETURN
/ END
00165 1030 JA #RTN
00166 0067
00167 1030 JA M
00170 0064
RALF V50A 24-JUL-20 PAGE 1-3
NO ERRORS
29 SYMBOLS, NO ABS REFS
# C 00000 #BASE 00023 #DOTMP 00042 #GOBAK 00057
#G0001 00131 #LBL 00067 #MAIN S 00000 #RET 00015
#RTN 00067 #ST 00071 #XR 00002 #1 00131
#3 00152 #9 00163 ASCVAR 01213 DATA 01221
I 00061 IO X 00000 LINES 01147 M 00064
MSG 00031 OLDLOC 00045 ONE 00037 PSPEAK S 00171
PTEXT 00000 PTXCOM C 00454 RTEXT 00000 SKIP 00034
SPEAK X 00000 TXTCOM C 01573 TXTLOC 01216