home *** CD-ROM | disk | FTP | other *** search
/ 8bitfiles.net/archives / archives.tar / archives / genie-commodore-file-library / C64-128Toolkit / BASIC-XREF (.txt) < prev    next >
Encoding:
Commodore BASIC  |  2019-04-13  |  10.1 KB  |  357 lines
  1. 10 REM*** AS OF 07/23/84 - 16.30
  2. 20 PN$="B A S I C   X R E F[146]":GOTO18000
  3. 100 REM*******************
  4. 101 REM*** GET A CHARACTER
  5. 102 REM*******************
  6. 120 GET#1,A$:IFA$=""THENA=0:A$=ZR$:RETURN
  7. 130 IFA$=" "ANDQF=0THEN100
  8. 150 A=ASC(A$):UL$=UL$+A$:RETURN
  9. 200 REM*******************
  10. 201 REM***SCAN TO END LINE
  11. 202 REM*******************
  12. 220 GOSUB100:IFA<>0THEN200
  13. 290 QF=0:RETURN
  14. 300 REM*******************
  15. 301 REM*** GET LINE NUMBER
  16. 302 REM*******************
  17. 310 GET#1,AL$,AH$:GOSUB600:L=NA:CL$=CHR$(AL)+CHR$(AH):L$=RIGHT$(S$+STR$(L),6)+" "
  18. 390 RETURN
  19. 400 REM********************
  20. 401 REM***SCAN TO END QUOTE
  21. 402 REM********************
  22. 420 GOSUB100:IFA=0THENUL$=UL$+CHR$(34):GOTO490
  23. 450 IFA$<>CHR$(34)THEN400
  24. 490 QF=0:RETURN
  25. 500 REM********************
  26. 501 REM***END OF VERB
  27. 502 REM********************
  28. 520 IFNV$<>""THENGOSUB3000:REM STORE #
  29. 550 IFAV$<>""THENGOSUB4000:REM STORE ALPHA
  30. 570 NV$="":AV$=""
  31. 590 RETURN
  32. 600 REM*********************************
  33. 601 REM*** CONVERT AL$/AH$ TO AL/AH > NA
  34. 602 REM*********************************
  35. 620 AL=ASC(AL$+ZR$):AH=ASC(AH$+ZR$):NA=AL+AH*256:RETURN
  36. 1000 REM******************
  37. 1001 REM*** START NEW LINE*
  38. 1002 REM******************
  39. 1010 GET#1,AL$,AH$:IFAL$=""ANDAH$=""THENGOSUB4600:EL=1:GOSUB7000:GOTO6000
  40. 1050 GOSUB500:GOSUB300:QF=0:V=0
  41. 1070 IFL<LSORL>LFTHENGOSUB200:UL$="":GOTO1000
  42. 1100 GOSUB4600
  43. 1110 IFFP$="Y"THENPRINT#4,L$;
  44. 1500 REM*****************
  45. 1501 REM***START NEW VERB
  46. 1502 REM*****************
  47. 1510 GOSUB100:IFA=0THEN1000:REM END LINE
  48. 1630 IFA=34THENQF=1:GOSUB500:GOSUB400:REM BEGIN QUOTE
  49. 1650 IFA=58ORA=44ORA=59THENGOSUB500
  50. 1710 IFA>127THENGOSUB4500:GOSUB500:IFA=143THENQF=1:GOSUB200:GOTO1000:REM STORE VERB
  51. 1730 IFA>47ANDA<58THEN2000:REM NUMERIC
  52. 1750 IFA>64ANDA<91THEN2500:REM ALPHA
  53. 1770 IFA=36ORA=37THEN2500:REM END ALPHA
  54. 1780 IFA=40ANDAV$<>""THENAV$=AV$+A$:GOSUB500
  55. 1950 IFA=0THEN1000:REM END LINE
  56. 1990 GOTO1500
  57. 2000 REM***********************
  58. 2001 REM*** TEST NUMERIC VALUES
  59. 2002 REM***********************
  60. 2100 IFV=9ORV=10ORV=13ORV=39THENNV$=NV$+A$:GOTO1500
  61. 2130 IFAV$<>""THENAV$=AV$+A$
  62. 2190 GOTO1500
  63. 2500 REM*********************
  64. 2502 REM*** TEST ALPHA VALUES
  65. 2504 REM*********************
  66. 2600 IFV=3THENGOTO1500:REM VERB = DATA BYPASS
  67. 2610 IFA=36ORA=37THENAV$=AV$+A$:GOTO1500
  68. 2700 IFAV$=""THENAV$=A$:GOTO1500
  69. 2730 IFRIGHT$(AV$,1)="$"ORRIGHT$(AV$,1)="%"THENGOSUB500:AV$=A$:GOTO1500
  70. 2750 AV$=AV$+A$
  71. 2790 GOTO1500
  72. 3000 REM*****************
  73. 3001 REM*** STORE NUMERIC VALUES
  74. 3002 REM*****************
  75. 3100 NA=VAL(NV$):J=0
  76. 3110 AH=INT(NA/256):AL=NA-AH*256
  77. 3120 AL$=CHR$(AL):AH$=CHR$(AH):NA$=AL$+AH$
  78. 3200 NS=ASC(LEFT$(GS$(J),1)+ZR$)
  79. 3240 IFNS=0THENGS$(J)=ZR$+NA$:GOTO3470
  80. 3250 IFNA$=MID$(GS$(J),2,2)THEN3400
  81. 3290 J=J+1:IFJ<121THEN3200
  82. 3350 PRINT"GO TO/SUB TABLE EXCEEDED":RETURN
  83. 3400 IFNS>126THENPRINT"GO TO/SUB" NV$ " EXCEEDS TABLE":RETURN
  84. 3470 NS=NS+1:GS$(J)=CHR$(NS)+MID$(GS$(J),2)+CL$
  85. 3490 RETURN
  86. 4000 REM********************
  87. 4002 REM*** STORE VAR VALUES
  88. 4004 REM********************
  89. 4050 J=0:AV$=LEFT$(AV$+S$,4)
  90. 4100 NS=ASC(LEFT$(AT$(J),1)+ZR$)
  91. 4200 IFNS=0THENAT$(J)=ZR$+AV$:GOTO4470
  92. 4230 IFAV$=MID$(AT$(J),2,4)THEN4400
  93. 4290 J=J+1:IFJ<121THEN4100
  94. 4350 PRINT"VAR TABLE EXCEEDED":RETURN
  95. 4400 IFNS>125THENPRINT"VAR "AV$" EXCEEDS TABLE":RETURN
  96. 4430 IFCL$=RIGHT$(AT$(J),2)THENRETURN
  97. 4470 NS=NS+1:AT$(J)=CHR$(NS)+MID$(AT$(J),2)+CL$
  98. 4490 RETURN
  99. 4500 REM************************
  100. 4501 REM*** STORE VERB & LINE #
  101. 4502 REM************************
  102. 4510 V=A-128:NS=ASC(LEFT$(VL$(V),1)+ZR$)
  103. 4520 IFNS=127THENPRINT"VERB "K$(V)" EXCEEDS TABLE":RETURN
  104. 4530 IFNS=0THEN4570
  105. 4540 IFCL$=RIGHT$(VL$(V),2)THENRETURN
  106. 4570 NS=NS+1:VL$(V)=CHR$(NS)+MID$(VL$(V),2)+CL$
  107. 4590 RETURN
  108. 4600 REM*********************
  109. 4601 REM*** FORMAT PRINT LINE
  110. 4602 REM*********************
  111. 4610 FL$="":REM CLEAR FORMATTED LINE
  112. 4620 IFUL$=""THENRETURN
  113. 4630 IFFP$="N"THENUL$="":PRINTL$:RETURN:REM BYPASS FORMATTED PROG LIST
  114. 4700 FORNS=1TOLEN(UL$)
  115. 4710 A$=MID$(UL$,NS,1):A=ASC(A$)
  116. 4730 IFA>127THENA$=K$(A-128)
  117. 4740 IFA=143THENA$=A$+RIGHT$(UL$,LEN(UL$)-NS):NS=LEN(UL$)
  118. 4800 IFA=34THENGOSUB5000:REM BEGIN QUOTE
  119. 4900 FL$=FL$+A$
  120. 4910 NEXT
  121. 4950 UL$="":IFLEN(FL$)>70THENGOSUB5500
  122. 4970 PRINT#4,FL$:NL=NL+1:IFNL>LPTHENGOSUB7000
  123. 4990 RETURN
  124. 5000 REM*******************************
  125. 5001 REM*** PROCESS QUOTE IN PRINT LINE
  126. 5002 REM*******************************
  127. 5010 QF$=A$:J=NS+1:CC=.:CT=.
  128. 5050 A$=MID$(UL$,J,1):A=ASC(A$)
  129. 5080 IFA=CCTHENCT=CT+1:GOTO5320:REM SAME CHAR
  130. 5090 IFCC=.THEN5200
  131. 5110 IFCC=32ANDCT=.THENQF$=QF$+" ":GOTO5200:REM 1 BLANK
  132. 5120 IFCT>.THENQF$=QF$+CC$+STR$(CT+1)+"]":CT=.:GOTO5200
  133. 5130 QF$=QF$+CC$+"]"
  134. 5200 CC=.
  135. 5210 IFA>32ANDA<128THEN5300:REM NUM C ALPHA
  136. 5215 FORXX=0TO40
  137. 5230 IFA=QW(XX)THENCC=A:CC$="["+QW$(XX):XX=40
  138. 5250 NEXT
  139. 5270 IFCC<>.THENA$=""
  140. 5300 QF$=QF$+A$
  141. 5310 IFA=34THEN5400:REM END QUOTE
  142. 5320 J=J+1
  143. 5330 GOTO5050
  144. 5400 NS=J
  145. 5470 A$=QF$
  146. 5490 RETURN
  147. 5500 REM**********************
  148. 5501 REM*** CHOP UP PRINT LINE
  149. 5502 REM**********************
  150. 5530 NS=70
  151. 5600 A$=MID$(FL$,NS,1):A=ASC(A$)
  152. 5610 IFA=32ANDNS<50THEN5700
  153. 5630 IF(A=58ORA=44ORA=59)THEN5700
  154. 5670 NS=NS-1:IFNS>40THEN5600
  155. 5690 NS=LEN(FL$)/2
  156. 5700 UL$=LEFT$(FL$,NS):FL$=RIGHT$(FL$,LEN(FL$)-NS)
  157. 5750 PRINT#4,UL$:NL=NL+1
  158. 5770 PRINT#4,S$;:UL$=""
  159. 5790 RETURN
  160. 6000 REM***********************
  161. 6001 REM*** PRINT VERB & LINE #
  162. 6002 REM***********************
  163. 6005 PRINT"[147]PRINTING":PRINT"   V E R B   LISTING.."
  164. 6010 TY$="VERB":HD$=" CROSS REFERENCE FOR PROGRAM ":GOSUB7000
  165. 6012 K$(36)=RIGHT$(K$(36),3):K$(39)=RIGHT$(K$(39),5):K$(41)=RIGHT$(K$(41),5)
  166. 6014 K$(47)=RIGHT$(K$(47),4):K$(48)=RIGHT$(K$(48),3)
  167. 6020 FORJ=0TO90:Y=0
  168. 6040 IFNL>LPTHENGOSUB7000
  169. 6050 READA:A=A-128:A$=VL$(A):NS=ASC(LEFT$(A$,1)+ZR$)
  170. 6070 IFNS=0THEN6150
  171. 6080 PRINT#4,LEFT$(K$(A)+S$,8);
  172. 6090 A=2:GOSUB7500
  173. 6150 NEXTJ:EL=1:GOSUB7000
  174. 6170 IFOD=4THEN6200
  175. 6175 PRINT"PRESS ANY KEY TO CONTINUE."
  176. 6180 GETA$:IFA$=""THEN6180
  177. 6200 REM*****************
  178. 6202 REM*** PRINT VAR REF
  179. 6204 REM*****************
  180. 6210 TY$="VARIABLES":GOSUB7000
  181. 6230 PRINT"[147]SORTING":PRINT"   V A R I A B L E S":GOSUB14000:REM SORT AT$
  182. 6235 PRINT"PRINTING":PRINT"   V A R I A B L E S"
  183. 6300 FORJ=0TO120:Y=0
  184. 6310 IFNL>LPTHENGOSUB7000
  185. 6320 A$=AT$(J):NS=ASC(LEFT$(A$,1)+ZR$)
  186. 6350 IFNS=0THEN6450
  187. 6370 AL$=MID$(A$,2,4)+LEFT$(S$,4)
  188. 6390 PRINT#4,AL$;
  189. 6395 A=6:GOSUB7500
  190. 6450 NEXTJ:EL=1:GOSUB7000
  191. 6460 IFOD=4THEN6500
  192. 6465 PRINT"PRESS ANY KEY TO CONTINUE."
  193. 6470 GETA$:IFA$=""THEN6470
  194. 6500 REM********************
  195. 6501 REM*** PRINT GOTO/SUB REF
  196. 6502 REM********************
  197. 6510 TY$="GOTO/SUB":GOSUB7000
  198. 6530 PRINT"[147]SORTING":PRINT"G O T O / S U B S":GOSUB12000:REM SORT GS$
  199. 6535 PRINT"PRINTING":PRINT"G O T O / S U B S"
  200. 6600 FORJ=0TO120:Y=0
  201. 6610 IFNL>LPTHENGOSUB7000
  202. 6620 A$=GS$(J)
  203. 6630 NS=ASC(LEFT$(A$,1)+ZR$)
  204. 6650 IFNS=0THEN6950
  205. 6670 AL$=MID$(A$,2,1):AH$=MID$(A$,3,1):GOSUB600
  206. 6690 PRINT#4,RIGHT$(S$+STR$(NA),8);
  207. 6695 A=4:GOSUB7500
  208. 6950 NEXTJ:EL=1:GOSUB7000
  209. 6960 IFNC=1THENGOTO6990
  210. 6970 NC=NC-1:RESTORE:FORJ=0TO40:READA:NEXT:FORJ=0TO40:READA$:NEXT:CLOSE15
  211. 6975 FORJ=0TO120:VL$(J)="":AT$(J)="":GS$(J)="":NEXT
  212. 6977 FORJ=121TO127:VL$(J)="":NEXT
  213. 6980 FORJ=30TO40:READA:NEXT:FORJ=30TO40:READA$:NEXT:CLOSE1:CLOSE4:GOSUB19000
  214. 6985 A$="Y":GOSUB19100:TY$="PROGRAM":HD$=" LIST FOR PROGRAM ":GOSUB300
  215. 6986 PRINT"[147]PRINTING":PRINT"P R O G R A M  LISTING.":GOSUB7000:GOTO1000
  216. 6990 CLOSE1:CLOSE4:CLOSE15:END
  217. 7000 REM********************
  218. 7001 REM*** SKIP TO NEW PAGE
  219. 7002 REM********************
  220. 7005 IFELTHENGOSUB7040:EL=0:NL=0:PN=1:RETURN
  221. 7007 IFNL>LPTHENGOSUB7040
  222. 7010 NL=0:PRINT#4,TY$HD$P$" AS OF "DA$;
  223. 7020 SP=80-(LEN(TY$)+LEN(HD$)+LEN(P$)+7+LEN(DA$))-9
  224. 7030 PRINT#4," "SPC(SP)"PAGE"PN:PRINT#4:NL=NL+2:PN=PN+1:RETURN
  225. 7040 FORPS=NL-LPTO5:PRINT#4:NEXT:RETURN
  226. 7500 REM***********************
  227. 7501 REM*** PRINT ARRAY ENTRIES
  228. 7502 REM***********************
  229. 7520 FORV=ATOLEN(A$)STEP2
  230. 7540 AL$=MID$(A$,V,1):AH$=MID$(A$,V+1,1):GOSUB600
  231. 7560 IFY<ZTHEN7650
  232. 7600 Y=0:PRINT#4:NL=NL+1:IFNL>LPTHENGOSUB7000
  233. 7630 PRINT#4,LEFT$(S$,8);
  234. 7650 PRINT#4,RIGHT$(S$+STR$(NA),6);:Y=Y+1
  235. 7670 NEXTV:PRINT#4:NL=NL+1:Y=0
  236. 7690 RETURN
  237. 12000 REM******************
  238. 12002 REM*** SORT GS$ ARRAY
  239. 12004 REM******************
  240. 12050 QF=0:REM SWITCH FLAG
  241. 12100 FORJ=0TO119
  242. 12130 IFGS$(J+1)=""THENJ=120:GOTO12250
  243. 12150 AL$=MID$(GS$(J+1),3,1)+MID$(GS$(J+1),2,1)
  244. 12160 AH$=MID$(GS$(J),3,1)+MID$(GS$(J),2,1)
  245. 12170 IFAL$>AH$THEN12250
  246. 12200 QF=1:A$=GS$(J):GS$(J)=GS$(J+1)
  247. 12220 GS$(J+1)=A$
  248. 12250 NEXTJ:IFQF=1THEN12000
  249. 12290 RETURN
  250. 14000 REM******************
  251. 14002 REM*** SORT AT$ ARRAY
  252. 14004 REM******************
  253. 14050 QF=0:REM SWITCH FLAG
  254. 14100 FORJ=0TO119
  255. 14130 IFAT$(J+1)=""THENJ=120:GOTO14250
  256. 14150 AL$=MID$(AT$(J+1),2,4)
  257. 14160 AH$=MID$(AT$(J),2,4)
  258. 14170 IFAL$>AH$THEN14250
  259. 14200 QF=1:A$=AT$(J):AT$(J)=AT$(J+1)
  260. 14220 AT$(J+1)=A$
  261. 14250 NEXTJ:IFQF=1THEN14000
  262. 14290 RETURN
  263. 16200 REM****************
  264. 16201 REM*** CURSOR WORDS
  265. 16202 REM****************
  266. 16210 DATA19,147,17,145,29,157,18,146,20,148,141,32
  267. 16220 DATA129,149,150,151,152,14,142,153,154,155:REM 64 STUFF
  268. 16230 DATA144,5,28,159,156,30,31,158,8,9,133,137,134,138,135,139,136,140,140
  269. 16240 DATAHOME,CLEAR,DOWN,UP,RIGHT,LEFT,RVS,RVOFF,DEL,INST,RETURN,SPACE,ORANGE
  270. 16250 DATABROWN,L.RED,GRAY1,GRAY2,TEXT,GRAPHIC,L.GRN,L.BLU,GRAY3,BLACK,WHITE,RED
  271. 16260 DATACYAN,MAGENTA,GREEN,BLUE,YELLOW,LOCK,UNLOCK,F1,F2,F3,F4,F5,F6,F7,F8,F8
  272. 16270 DATA7,21,149,22,150,14,142,25,153,15,143:REM 80 COL CURSOR STUFF
  273. 16280 DATABELL,D.LINE,I.LINE,ER.BEGIN,ER.END,TEXT,GRAPHIC,SCROLL.UP,SCROLL.DOWN
  274. 16290 DATATOP,BOTTOM:REM 80 COL CURSOR STUFF
  275. 17000 REM******************
  276. 17001 REM***VERB SEQ VALUES
  277. 17002 REM******************
  278. 17010 DATA182,175,198,193,199,160,156,157,154,190
  279. 17020 DATA131,150,134,128,189,165,129,184,161,203
  280. 17030 DATA141,137,139,133,132,181,200,195,136,155
  281. 17040 DATA147,188,202,162,130,168,145,159,176,194
  282. 17050 DATA151,185,153,152,135,143,140,142,201,187
  283. 17060 DATA138,148,180,191,166,186,169,144,196,158
  284. 17070 DATA163,192,167,164,183,197,149,146,204,205
  285. 17080 DATA206,170,171,172,173,174,177,178,179,207
  286. 17090 DATA208,209,210,211,212,213,214,215,216,217
  287. 17100 DATA218,219,220,221,222,223,224,225,226,227
  288. 17110 DATA228,229,230,231,232,233,234,235,236,237
  289. 17120 DATA238,239,240,241,242,243,244,245,246,247
  290. 17130 DATA248,249,250,251,252,253,254,255
  291. 18000 REM**************
  292. 18001 REM*** INITIALIZE
  293. 18002 REM**************
  294. 18003 FL$="":UL$=""
  295. 18005 A$="":S$="        ":ZR$=CHR$(0):HD$=" LIST FOR PROGRAM ":PN=1:CG=32768
  296. 18010 DIMK$(127),VL$(127),GS$(120),AT$(120),QW(40),QW$(40)
  297. 18025 PRINT"[147]"SPC(2)PN$:PRINT"ALL INPUT'S MUST END  WITH RETURN"
  298. 18030 PRINT"PROGRAM NAME;":INPUT"    ";P$:GOSUB19000:IFETHEN18030
  299. 18040 PRINT"DATE WITH SLASHES":INPUT"    ";DA$:GOSUB300
  300. 18050 PRINT"LOAD ADDRESS =";L$
  301. 18061 SY$="P":IFPEEK(61654)=82THENSY$="6"
  302. 18062 IFPEEK(65154)=144THENSY$="V"
  303. 18081 FORJ=0TO40:READQW(J):NEXTJ:FORJ=0TO40:READQW$(J):NEXTJ
  304. 18082 FORJ=30TO40:READA:IFSY$="P"THENQW(J)=A
  305. 18083 NEXT
  306. 18084 FORJ=30TO40:READA$:IFSY$="P"THENQW$(J)=A$
  307. 18085 NEXT:A$="":A=0
  308. 18100 PRINT"OK - SETTING UP..."
  309. 18110 IFSY$="V"THENAL=49310:AH=49565:Z=1
  310. 18120 IFSY$="P"THENAL=45234:AH=45500:Z=5
  311. 18130 IFSY$="6"THENAL=41118:AH=41373:Z=5
  312. 18137 A$="":A=0
  313. 18140 FORJ=ALTOAH:V=PEEK(J)
  314. 18150 IFV<128THENA$=A$+CHR$(V):GOTO18180
  315. 18160 A$=A$+(CHR$(V-128)):K$(A)=A$+" "
  316. 18170 A$="":A=A+1:NEXT
  317. 18180 NEXT
  318. 18185 INPUT"FORMATTED LIST (Y/N)";FP$
  319. 18190 INPUT"PRINTER OUTPUT (Y/N)";A$
  320. 18200 PRINT"LINE NUMBER RANGE?":LS=0:LF=1E9
  321. 18210 INPUT"START  0[157][157][157]";LS:INPUT"END  99999[157][157][157][157][157][157][157]";LF
  322. 18230 FORA=67TO74:K$(A)=LEFT$(K$(A),LEN(K$(A))-1):NEXT
  323. 18240 FORA=42TO45:K$(A)=LEFT$(K$(A),1):NEXT
  324. 18250 FORA=49TO51:K$(A)=LEFT$(K$(A),1):NEXT
  325. 18260 K$(36)=" "+K$(36):K$(39)=" "+K$(39):K$(41)=" "+K$(41)
  326. 18270 K$(47)=" "+K$(47):K$(48)=" "+K$(48):K$(127)="[255]"
  327. 18290 K$(35)=LEFT$(K$(35),4):K$(38)=LEFT$(K$(38),4)
  328. 18320 INPUT"LINES PER PAGE = 60[157][157][157][157]";LP
  329. 18340 INPUT"NUMBER OF COPIES  1[157][157][157]";NC:TC=NC
  330. 18345 INPUT"GRAPHICS OR TEXT  G[157][157][157]";G$
  331. 18347 SA=0:PRINTCHR$(142):IFASC(G$)=84THENSA=7:PRINTCHR$(14)
  332. 18348 GOSUB19100:IFOD=3THENLP=20
  333. 18355 TY$="PROGRAM":PRINT"[147]PRINTING":PRINT"  P R O G R A M   LIST":GOSUB7000:GOTO1000
  334. 19000 REM************************
  335. 19001 REM*** OPEN ROUTINES
  336. 19002 REM************************
  337. 19010 OPEN15,8,15,"IO":OPEN1,8,3,"0:"+P$+",P,R":INPUT#15,E,EM$
  338. 19020 IFETHENGOSUB19200
  339. 19030 RETURN
  340. 19100 OD=3:IFA$="Y"THENOD=4:Z=12
  341. 19110 OPEN4,OD,SA:RETURN
  342. 19200 REM************************
  343. 19201 REM*** DISK ERROR ROUTINE *
  344. 19202 REM************************
  345. 19210 PRINT"[147]DISK ERROR #"E;EM$:CLOSE1:CLOSE15:RETURN
  346. 20000 REM*** BASIC CROSS REFERENCE ***
  347. 20100 REM***                       ***
  348. 20200 REM***         BY            ***
  349. 20300 REM***                       ***
  350. 20400 REM***      BILL COLLINS     ***
  351. 20500 REM***                       ***
  352. 20600 REM***          &            ***
  353. 20650 REM***                       ***
  354. 20700 REM***    DICK MISHINSKI     ***
  355. 20800 REM***                       ***
  356. 20900 REM*****************************
  357.