home *** CD-ROM | disk | FTP | other *** search
/ 64'er Special 21 / 64er_Magazin_Sonderheft_21_19xx_Markt__Technik_de_Side_B.d64 / hypra-konv.src (.txt) < prev    next >
Encoding:
Commodore BASIC  |  1990-01-01  |  13.9 KB  |  872 lines
  1. 10 ;---------------------------------
  2. 11 ;
  3. 12 ; ----------------------
  4. 13 ; hypra-ass quelltext
  5. 14 ; konvertierungsprogramm
  6. 15 ; ----------------------
  7. 16 ;
  8. 17 ; programmiert von thomas dachsel
  9. 18 ; am 20. - 21. juni 1987
  10. 19 ;
  11. 20 ; dieses programm wandelt einen
  12. 21 ; hypra-ass quelltext in einen
  13. 22 ; giga-ass quelltext um, welcher
  14. 23 ; direkt auf diskette geschrieben
  15. 24 ; wird.
  16. 25 ;
  17. 26 ; starten sie dieses programm mit
  18. 27 ; <f3>. es werden dann alle not-
  19. 28 ; wendigen eingaben abgefragt.
  20. 29 ;
  21. 30 ;---------------------------------
  22. 100 +$6000
  23. 110 usr$6000
  24. 120 ;
  25. 130 ; -----------------------------
  26. 140 ; label- und makro-definitionen
  27. 150 ; -----------------------------
  28. 160 ;
  29. 170 tostartadr=$801
  30. 180 ;
  31. 190 tab(cnt=count
  32. 200 tab(ip=inchars
  33. 210 tab(op=outchars
  34. 220 tab(inbuf=lib
  35. 230 tab(outbuf=lob
  36. 240 ;
  37. 250 getreadchar
  38. 260  (NULL)get
  39. 270  peekip
  40. 280  (NULL)inbuf,x
  41. 290  right$ip
  42. 300 new
  43. 310 ;
  44. 320 getkey
  45. 330  prnclosekeytx
  46. 340 wait stoclose198,0
  47. 350  eqbclose198,*
  48. 360  cnqclose631,$d,wait
  49. 370  (NULL)leave
  50. 380 keytx not"__   <return> druecken"
  51. 390 leave stoclose198,0
  52. 400 new
  53. 410 ;
  54. 1000 ; -------------
  55. 1010 ; hauptprogramm
  56. 1020 ; -------------
  57. 1030 ;
  58. 1040 ; 1. eingabe der file-namen
  59. 1050 ;
  60. 1060  (NULL)clall
  61. 1070  prnclosestx
  62. 1080  rfnclosehqfn
  63. 1090  prnclosentx
  64. 1100  rfncloseaqfn
  65. 1110 ;
  66. 1120 ; 2. oeffnen der files
  67. 1130 ;
  68. 1140  prncloseo1tx
  69. 1150  prnclosehqfn
  70. 1160  prncloseo2tx
  71. 1170  openfileclose1,8,0,hqfn
  72. 1180  prncloseo3tx
  73. 1190  key
  74. 1200  prncloseo1tx
  75. 1210  prncloseaqfn
  76. 1220  prncloseo4tx
  77. 1230  openfileclose2,8,1,aqfn
  78. 1240  prncloseo3tx
  79. 1250  key
  80. 1260  prnclosemtx
  81. 1270  prncloseaqfn
  82. 1280  prnclosettx
  83. 1290 ;
  84. 1300 ; 3. initialisiere count
  85. 1320 ;
  86. 1330  dstclosecount,startadr
  87. 1331  mid$#$ff
  88. 1332  (NULL)lnr
  89. 1333  (NULL)lnr+1
  90. 1340 ;
  91. 1350 ; 4. schreibe neue startadresse
  92. 1360 ;
  93. 1370  peek#2
  94. 1380  (NULL)ckout
  95. 1390  outclose<(startadr)
  96. 1400  outclose>(startadr)
  97. 1410 ;
  98. 1420 ; 5. ueberlies alte startadresse
  99. 1430 ;
  100. 1440  peek#1
  101. 1450  (NULL)chkin
  102. 1460  (NULL)get
  103. 1470  (NULL)get
  104. 1480 ;
  105. 1490 ; 6. erste koppeladresse einlesen
  106. 1500 ;
  107. 1501  stocloseip,0
  108. 1510  readchar
  109. 1520  readchar
  110. 1530 ;
  111. 1540 ; 7. zeilennummer (l/h) einlesen
  112. 1550 ;
  113. 1560 contread readchar
  114. 1570  readchar
  115. 1580 ;
  116. 1590 ; 8. rest der zeile einlesen
  117. 1600 ;
  118. 1610 loop readchar
  119. 1620  str$#0
  120. 1630  (NULL)loop
  121. 1640 ;
  122. 1650 ; 9. rufe convline auf
  123. 1660 ;
  124. 1670  peek#2
  125. 1680  (NULL)ckout
  126. 1690  (NULL)convline
  127. 1700 ;
  128. 1710 ;10. setze pufferzeiger auf
  129. 1720 ;    pufferanfang zurueck
  130. 1730 ;
  131. 1740  stocloseip,0
  132. 1750 ;
  133. 1760 ;11. lies koppeladresse der
  134. 1770 ;    naechsten zeile ein
  135. 1780 ;
  136. 1790  peek#1
  137. 1800  (NULL)chkin
  138. 1810  readchar
  139. 1820  readchar
  140. 1830 ;
  141. 1840 ;12. check ob quelltext-ende
  142. 1850 ;
  143. 1860  mid$inbuf
  144. 1870  (NULL)contread
  145. 1880  mid$inbuf+1
  146. 1890  (NULL)contread
  147. 1900 ;
  148. 1910 ;13. schreibe 00 00 fuer
  149. 1920 ;    quelltext-ende
  150. 1930 ;
  151. 1940  peek#2
  152. 1950  (NULL)ckout
  153. 1960  outclose0
  154. 1970  outclose0
  155. 1980 ;
  156. 1990 ;14. schliesse die files, setze
  157. 2000 ;    ein-/ausgabe zurueck
  158. 2010 ;
  159. 2020  mid$#1
  160. 2030  (NULL)close
  161. 2040  mid$#2
  162. 2050  (NULL)close
  163. 2060  (NULL)clrch
  164. 2070 ;
  165. 2080 ; -----------------------
  166. 2090 ; ende des hauptprogramms
  167. 2100 ; -----------------------
  168. 2110 ;
  169. 3000 ; -----------------
  170. 3010 ; mnemonics - texte
  171. 3020 ; -----------------
  172. 3030 ;
  173. 3040 mnemonics not"cpxcpyldxldycmpadcanddeceorincldaaslbitlsr
  174. 3050  [168]"orarolrorsbcstastxstyjmpjsrtxataxtyataytsx
  175. 3060  not"txsphpplpphaplabrkrtirtsnopclcseccliseiclv
  176. 3070  [168]"cldseddeyinydexinxbplbmibvcbvsbccbcsbnebeq
  177. 3080 ;
  178. 3090 ; ----------------------
  179. 3100 ; pseudo-befehls - texte
  180. 3110 ; ----------------------
  181. 3120 ;
  182. 3130 pseudos not"..martgleqbywodstxobbaco
  183. 3140  [168]"ongoifeleisylienst
  184. 3150 endpseudos
  185. 4000 getgtc
  186. 4010  peekip
  187. 4020  mid$inbuf,x
  188. 4030  right$ip
  189. 4040 new
  190. 4050 getptc
  191. 4060  peekop
  192. 4070  (NULL)outbuf,x
  193. 4080  right$op
  194. 4090  icdclosecnt
  195. 4100 new
  196. 4110 getxfer
  197. 4120  gtc
  198. 4130  ptc
  199. 4140 new
  200. 4150 convline stocloseip,2
  201. 4160  stocloseop,2
  202. 4170 ;
  203. 4180 ; zeilennummer transferieren
  204. 4190 ;
  205. 4200  xfer
  206. 4210  xfer
  207. 4220 ;
  208. 4230 ; erstes zeichen der zeile:
  209. 4240 ; semikolon, dann kommentarzeile
  210. 4250 ; punkt, dann pseudo
  211. 4260 ; space, dann ueberlesen
  212. 4270 ;        und zum 2. feld gehen
  213. 4280 ; sonst: label ueberlesen
  214. 4290 ;
  215. 4300  gtc
  216. 4310  cbnclose59,nocomm
  217. 4320  ptc
  218. 4330  (NULL)rlop
  219. 4340 nocomm cbnclose".",nopsd
  220. 4350  (NULL)ipsc
  221. 4360 nopsd ptc
  222. 4370  cbeclose32,secfield
  223. 4380  cbnclose0,*+7;end of
  224. 4390  (NULL)endline;line ?
  225. 4400 labelloop xfer
  226. 4410  cbnclose0,*+7;end of
  227. 4420  (NULL)endline;line ?
  228. 4430  cbnclose32,labelloop
  229. 4440 ;
  230. 4450 ; zweites feld:
  231. 4460 ; eventuell label, aber sicher
  232. 4470 ; ein space bereits uebertragen
  233. 4480 ;
  234. 4490 ; jetzt entweder pseudo oder
  235. 4500 ; mnemonic
  236. 4510 ;
  237. 4520 secfield gtc
  238. 4530  cbnclose".",*+7
  239. 4540  (NULL)ipsc
  240. 4550  peekip;x zeigt
  241. 4560  len#0;auf 2.
  242. 4570  (NULL)mc;zeichen
  243. 4580 search mid$inbuf-1,x
  244. 4590  str$mnemonics,y
  245. 4600  (NULL)nextone
  246. 4610  mid$inbuf,x
  247. 4620  str$mnemonics+1,y
  248. 4630  (NULL)nextone
  249. 4640  mid$inbuf+1,x
  250. 4650  str$mnemonics+2,y
  251. 4660  (NULL)found
  252. 4670 nextone (NULL)
  253. 4680  (NULL)
  254. 4690  (NULL)
  255. 4700  right$mc
  256. 4710  atn#pseudos-mnemonics
  257. 4720  (NULL)search
  258. 4730 ;
  259. 4740 ; mnemonic nicht gefunden:
  260. 4750 ; fehlerhafte zeile, wird ganz
  261. 4760 ; ueberlesen
  262. 4770 ;
  263. 4780  (NULL)rlop
  264. 4790 found mid$mc;mnemonic-
  265. 4800  (NULL)#$c0;code ab-
  266. 4810  ptc;legen
  267. 4820  gtc;3 zeichen
  268. 4830  gtc;skippen
  269. 4840  (NULL)rlop
  270. 5000 ;
  271. 5010 ; ------------------
  272. 5020 ; insert pseudo-code
  273. 5030 ; ------------------
  274. 5040 ; ip zeigt auf das erste der
  275. 5050 ; beiden pseudo-befehlszeichen
  276. 5060 ;
  277. 5070 ipsc len#0
  278. 5080  peekip
  279. 5090 comploop mid$inbuf,x
  280. 5100  str$pseudos,y
  281. 5110  (NULL)nexttext
  282. 5120  mid$inbuf+1,x
  283. 5130  str$pseudos+1,y
  284. 5140  (NULL)foundpsd
  285. 5150 nexttext (NULL)
  286. 5160  (NULL)
  287. 5170  atn#endpseudos-pseudos
  288. 5180  (NULL)comploop
  289. 5190 ;
  290. 5200 ; pseudo nicht gefunden:
  291. 5210 ; fehlerhafte zeile, wird
  292. 5220 ; ganz ueberlesen
  293. 5230 ;
  294. 5240 notfound
  295. 5250  mid$#"."
  296. 5260  ptc
  297. 5270  (NULL)rlop
  298. 5280 foundpsd gtc
  299. 5290  gtc
  300. 5300  (NULL)
  301. 5310  (NULL);pseudo-
  302. 5320  (NULL)#$a0;code in a
  303. 5330 ;
  304. 5340 ; nur speichern, falls kein
  305. 5350 ; macro call -- ausser der makro-
  306. 5360 ; name beginnt mit mnemonic
  307. 5370 ;
  308. 5380  cbnclose$a0,storepsc
  309. 5390  peekip
  310. 5400  len#0
  311. 5410 occurschk mid$inbuf,x
  312. 5420  (NULL)storepsc-3
  313. 5430  str$mnemonics,y
  314. 5440  (NULL)nextmnemo
  315. 5450  mid$inbuf+1,x
  316. 5460  str$mnemonics+1,y
  317. 5470  (NULL)nextmnemo
  318. 5480  mid$inbuf+2,x
  319. 5490  str$mnemonics+2,y
  320. 5500  (NULL)nextmnemo
  321. 5510  mid$#$a0
  322. 5520  (NULL)storepsc
  323. 5530 nextmnemo (NULL)
  324. 5540  (NULL)
  325. 5550  (NULL)
  326. 5560  atn#pseudos-mnemonics
  327. 5570  (NULL)occurschk
  328. 5580  (NULL)l1
  329. 5590 storepsc ptc
  330. 5600 ;
  331. 5610 ; falls .text-pseudo, eventuelles
  332. 5620 ; abschliessendes hochkomma ent-
  333. 5630 ; fernen
  334. 5640 ;
  335. 5650  cbnclose$a8,skip
  336. 5660 tl1 gtc
  337. 5670  cbnclose0,*+7;end of
  338. 5680  (NULL)put0;line ?
  339. 5690  ptc
  340. 5700  cbnclose34,tl1
  341. 5710 tl2 gtc
  342. 5720  cbnclose0,*+7;end of
  343. 5730  (NULL)put0;line ?
  344. 5740  cbnclose34,*+7
  345. 5750  (NULL)rlop
  346. 5760  ptc
  347. 5770  (NULL)tl2
  348. 5780 ;
  349. 5790 ; falls makro-definition oder
  350. 5800 ; -aufruf, klammern wandeln
  351. 5810 ;
  352. 5820 ; es wird die erste klammer auf
  353. 5830 ; in $a0 (shift space) gewandelt
  354. 5840 ; und die letzte klammer zu
  355. 5850 ; geloescht (syntaktisch richtige
  356. 5860 ; klammerung der makro-parameter
  357. 5870 ; vorausgesetzt)
  358. 5880 ;
  359. 5890 skip str$#$a2
  360. 5900  (NULL)rlop
  361. 5910 l1 gtc
  362. 5920  cbnclose0,*+7
  363. 5930  (NULL)put0
  364. 5940  cbeclose"(",l2
  365. 5950  ptc
  366. 5960  (NULL)l1
  367. 5970 l2 mid$#$a0;1. "("
  368. 5980  ptc; --> $a0
  369. 5990  stoclosemc,0
  370. 6000 l3 gtc
  371. 6010  cbeclose0,put0
  372. 6020  cbnclose"(",*+9
  373. 6030  right$mc
  374. 6040  (NULL)*+11
  375. 6050  cbnclose")",*+9
  376. 6060  chr$mc;delete
  377. 6070  (NULL)rlop;last ")"
  378. 6080  ptc
  379. 6090  (NULL)l3
  380. 9000 ;
  381. 9010 ; transfer rest of line
  382. 9020 ;
  383. 9030 rlop xfer
  384. 9040  str$#0
  385. 9050  (NULL)rlop
  386. 9060 ;
  387. 9070 ; fuege null-byte an
  388. 9080 ;
  389. 9090  mid$#0
  390. 9100 put0 ptc
  391. 9110 ;
  392. 9120 ; speichere koppeladresse
  393. 9130 ;
  394. 9140 endline icdclosecount
  395. 9150  mvdclosecount,outbuf
  396. 9160 ;
  397. 9170 ; check ob zeile schon einmal
  398. 9180 ; uebertragen
  399. 9190 ;
  400. 9200  mid$outbuf+2
  401. 9210  str$lnr
  402. 9220  (NULL)sendline
  403. 9230  mid$outbuf+3
  404. 9240  str$lnr+1
  405. 9250  (NULL)sendline
  406. 9260  (NULL)
  407. 9270 sendline mvdcloseoutbuf+2,lnr
  408. 9280 ;
  409. 9290 ; schicke zeile zur floppy
  410. 9300 ;
  411. 9310  peek#0
  412. 9320 sendlop mid$outbuf,x
  413. 9330  (NULL)chrout
  414. 9340  (NULL);4 bytes
  415. 9350  tan#5;always
  416. 9360  (NULL)sendlop
  417. 9370  str$#0
  418. 9380  (NULL)sendlop
  419. 9390  (NULL)
  420. 10000 ; -----
  421. 10010 ; texte
  422. 10020 ; -----
  423. 10030 ;
  424. 10040 stx fn$93
  425. 10050  not"__   konvertierungsprogramm
  426. 10060  [168]"__   zum wandeln eines hypra-ass
  427. 10070  not"__   quelltextes in das giga-ass format
  428. 10080  [168]"___   legen sie die diskette mit dem
  429. 10090  not"_   hypra-ass quelltext in das laufwerk
  430. 10100  [168]"_   und geben sie den filenamen des
  431. 10110  not"_   hypra-ass quelltextes ein!__   "
  432. 10120 ntx not"__   geben sie nun bitte den namen
  433. 10130  [168]"_   fuer den giga-ass quelltext ein.__   "
  434. 10140 o1tx [165]$93
  435. 10150  [168]"__   es wird versucht, das file__   "
  436. 10160 o2tx [168]"__   zum lesen zu oeffnen.__   "
  437. 10170 o3tx [168]"__   das oeffnen war erfolgreich."
  438. 10180 o4tx [168]"__   zum schreiben zu oeffnen.__   "
  439. 10190 mtx [165]$93
  440. 10200  [168]"__   der angegebene quelltext wird nun
  441. 10210  not"__   in einen giga-ass quelltext mit__   dem namen "
  442. 10220 ttx not"__   umgewandelt.__"
  443. 20000 ;
  444. 20010 ; ------------
  445. 20020 ; datenbereich
  446. 20030 ; ------------
  447. 20040 ;
  448. 20041 count then2
  449. 20042 lnr then2
  450. 20043 mc then1
  451. 20050 hqfn then21
  452. 20060 aqfn then21
  453. 20070 inchars then1
  454. 20080 lib then80
  455. 20081 outchars then1
  456. 20082 lob then80
  457. 50000 ;---------------------------------
  458. 50010 ;
  459. 50020 ; merge file #1: kernel jump table
  460. 50030 ;
  461. 50040 ;---------------------------------
  462. 50050 tab(acptr=$ffa5
  463. 50060 tab(ciout=$ffa8
  464. 50070 tab(untalk=$ffab
  465. 50080 tab(unlisten=$ffae
  466. 50090 tab(listen=$ffb1
  467. 50100 tab(talk=$ffb4
  468. 50110 tab(status=$ffb7
  469. 50120 tab(setlfs=$ffba
  470. 50130 tab(setnam=$ffbd
  471. 50140 tab(open=$ffc0
  472. 50150 tab(close=$ffc3
  473. 50160 tab(chkin=$ffc6
  474. 50170 tab(ckout=$ffc9
  475. 50180 tab(clrch=$ffcc
  476. 50190 tab(basin=$ffcf
  477. 50200 tab(chrout=$ffd2
  478. 50210 tab(load=$ffd5
  479. 50220 tab(save=$ffd8
  480. 50230 tab(settim=$ffdb
  481. 50240 tab(gettim=$ffde
  482. 50250 tab(stopkey=$ffe1
  483. 50260 tab(get=$ffe4
  484. 50270 tab(clall=$ffe7
  485. 50280 tab(udtim=$ffea
  486. 50290 tab(screen=$ffed
  487. 50300 tab(cursor=$fff0
  488. 51000 ;---------------------------------
  489. 51010 ;
  490. 51020 ; merge file #2: low-level macros
  491. 51030 ;
  492. 51040 ;---------------------------------
  493. 51050 getstoclosea,v
  494. 51060  mid$#v
  495. 51070  (NULL)a
  496. 51080 new
  497. 51090 getdstclosea,dv
  498. 51100  mid$#<(dv)
  499. 51110  (NULL)a
  500. 51120  mid$#>(dv)
  501. 51130  (NULL)a+1
  502. 51140 new
  503. 51150 getmovclosef,t
  504. 51160  mid$f
  505. 51170  (NULL)t
  506. 51180 new
  507. 51190 getmdiclosea,p
  508. 51200  mid$a
  509. 51210  (NULL)&p,y
  510. 51220 new
  511. 51230 getmidclosep,a
  512. 51240  mid$&p,y
  513. 51250  (NULL)a
  514. 51260 new
  515. 51270 getmvdclosef,t
  516. 51280  mid$f
  517. 51290  peekf+1
  518. 51300  (NULL)t
  519. 51310  (NULL)t+1
  520. 51320 new
  521. 51330 getcbeclosev,a
  522. 51340  str$#v
  523. 51350  (NULL)a
  524. 51360 new
  525. 51370 getcbnclosev,a
  526. 51380  str$#v
  527. 51390  (NULL)a
  528. 51400 new
  529. 51410 getcnqclosea,v,b
  530. 51420  mid$a
  531. 51430  str$#v
  532. 51440  (NULL)b
  533. 51450 new
  534. 51460 geteqbclosea,b
  535. 51470  mid$a
  536. 51480  (NULL)b
  537. 51490 new
  538. 51500 getnqbclosea,b
  539. 51510  mid$a
  540. 51520  (NULL)b
  541. 51530 new
  542. 51540 getldwclosea
  543. 51550  mid$a
  544. 51560  lena+1
  545. 51570 new
  546. 51580 getstwclosea
  547. 51590  (NULL)a
  548. 51600  (NULL)a+1
  549. 51610 new
  550. 51620 geticdclosea
  551. 51630  right$a
  552. 51640  (NULL)end
  553. 51650  right$a+1
  554. 51660 end
  555. 51670 new
  556. 51680 getpshclosea
  557. 51690  mid$a
  558. 51700  (NULL)
  559. 51710 new
  560. 51720 getpllclosea
  561. 51730  (NULL)
  562. 51740  (NULL)a
  563. 51750 new
  564. 51760 getphx
  565. 51770  (NULL)
  566. 51780  (NULL)
  567. 51790 new
  568. 51800 getplx
  569. 51810  (NULL)
  570. 51820  (NULL)
  571. 51830 new
  572. 51840 getphy
  573. 51850  (NULL)
  574. 51860  (NULL)
  575. 51870 new
  576. 51880 getply
  577. 51890  (NULL)
  578. 51900  (NULL)
  579. 51910 new
  580. 51920 getprncloset
  581. 51930  mid$#<(t)
  582. 51940  len#>(t)
  583. 51950  (NULL)$ab1e
  584. 51960 new
  585. 51970 getoutclosea
  586. 51980  mid$#a
  587. 51990  (NULL)$ffd2
  588. 52000 new
  589. 52010 getmbyclosenr,code
  590. 52020  toc=nr
  591. 52030  *c=0,52070
  592. 52040  fncode
  593. 52050  toc=c-1
  594. 52060  /52030
  595. 52070 new
  596. 55000 ;---------------------------------
  597. 55010 ;
  598. 55020 ; merge file #3: high-level macros
  599. 55030 ;
  600. 55040 ;---------------------------------
  601. 55050 ;*********************************
  602. 55060 ;
  603. 55070 ; relative load (rld)
  604. 55080 ; -------------
  605. 55090 ; ein file wird relativ in den
  606. 55100 ; speicher ab adresse "adr" ge-
  607. 55110 ; laden. der name des files muss
  608. 55120 ; ab der adresse "filename"
  609. 55130 ; im speicher stehen.
  610. 55140 ; hinter dem letzten zeichen des
  611. 55150 ; namens muss ein nullbyte folgen.
  612. 55160 ;
  613. 55170 ; benoetigt das merge-file #1.
  614. 55180 ;
  615. 55190 ;*********************************
  616. 55200 getrldclosefilename,adr
  617. 55210  mid$#1;lfn
  618. 55220  peek#8;dev
  619. 55230  len#0;sa
  620. 55240  (NULL)setlfs
  621. 55250 ;
  622. 55260 ; laenge des filenamens bestimmen
  623. 55270 ;
  624. 55280  peek#0
  625. 55290 testchar mid$filename,x
  626. 55300  (NULL)setlen
  627. 55310  (NULL)
  628. 55320  (NULL)testchar
  629. 55330 setlen (NULL)
  630. 55340  peek#<(filename)
  631. 55350  len#>(filename)
  632. 55360  (NULL)setnam
  633. 55370  mid$#0
  634. 55380  peek#<(adr)
  635. 55390  len#>(adr)
  636. 55400  (NULL)load
  637. 55410 new
  638. 55420 ;*********************************
  639. 55430 ;
  640. 55440 ; read filename (rfn)
  641. 55450 ; -------------
  642. 55460 ; ein filename wird von der tasta-
  643. 55470 ; tur eingelesen und ab der adres-
  644. 55480 ; se "adr" in den speicher abge-
  645. 55490 ; legt.
  646. 55500 ; hinter dem letzten zeichen des
  647. 55510 ; namens wird ein nullbyte ange-
  648. 55520 ; fuegt.
  649. 55530 ;
  650. 55540 ; benoetigt merge-files #1 und #2.
  651. 55550 ;
  652. 55560 ;*********************************
  653. 55570 getrfncloseadr
  654. 55580 ;
  655. 55590 ; tastatur-file oeffnen
  656. 55600 ;
  657. 55610  mid$#"t";lfn
  658. 55620  peek#0;dev
  659. 55630  len#0;sa
  660. 55640  (NULL)setlfs
  661. 55650  (NULL)open
  662. 55660  peek#"t"
  663. 55670  (NULL)chkin
  664. 55680 ;
  665. 55690 ; bildschirm-file oeffnen
  666. 55700 ;
  667. 55710  mid$#"b";lfn
  668. 55720  peek#3;dev
  669. 55730  len#0;sa
  670. 55740  (NULL)setlfs
  671. 55750  (NULL)open
  672. 55760  peek#"b"
  673. 55770  (NULL)ckout
  674. 55780 ;
  675. 55790 ; prompt und input-zeile ausgeben
  676. 55800 ;
  677. 55810  prncloseprompt
  678. 55820  (NULL)getline
  679. 55830 prompt not"filename?
  680. 55840  [165]32
  681. 55850  mby[160]16,$a4
  682. 55860  mby[160]16,$9d
  683. 55870 revchar [165]$12,$20,$92,$9d,0
  684. 55880 delchar [165]$a4,$9d,$9d,0
  685. 55890 ;
  686. 55900 ; maximal 16 zeichen holen
  687. 55910 ;
  688. 55920 getline sto[160]chars,0
  689. 55930 getchar [214]get
  690. 55940  [247]*-3
  691. 55950  [198]#$7f
  692. 55960  cbn[160]20,checkkey
  693. 55970  [194]chars
  694. 55980  [247]getchar
  695. 55990  [192]#16
  696. 56000  [244]*+5
  697. 56010  [199]chars
  698. 56020  [199]chars
  699. 56030  prn[160]delchar
  700. 56040  prn[160]revchar
  701. 56050  [213]getchar
  702. 56060 checkkey [196]#32
  703. 56070  [244]nonprint
  704. 56080  [194]chars
  705. 56090  [192]#16
  706. 56100  [244]*+3
  707. 56110  [238]
  708. 56120  [210]adr,x
  709. 56130  [214]chrout
  710. 56140  [194]chars
  711. 56150  [192]#16
  712. 56160  [245]*+5
  713. 56170  [201]chars
  714. 56180  [192]#15
  715. 56190  [245]lastchar
  716. 56200  prn[160]revchar
  717. 56210  [213]getchar
  718. 56220 lastchar out[160]$9d
  719. 56230  [213]getchar
  720. 56240 nonprint [196]#$d
  721. 56250  [246]getchar
  722. 56260  [194]chars
  723. 56270  [192]#16
  724. 56280  [245]*+7
  725. 56290  out[160]$a4
  726. 56300  [202]#0
  727. 56310  [210]adr,x
  728. 56320 ;
  729. 56330 ; files schliessen
  730. 56340 ;
  731. 56350  [202]#"t"
  732. 56360  [214]close
  733. 56370  [202]#"b"
  734. 56380  [214]close
  735. 56390  [213]*+4
  736. 56400 chars [167]1
  737. 56410 [162]
  738. 56420 ;*********************************
  739. 56430 ;
  740. 56440 ; get disk status (gds)
  741. 56450 ; ---------------
  742. 56460 ;
  743. 56470 ; dieser makro holt den disk-
  744. 56480 ; status in den speicherbereich,
  745. 56490 ; der durch adresse "adr" spezi-
  746. 56500 ; fiziert ist. hinter das letzte
  747. 56510 ; zeichen wird ein nullbyte
  748. 56520 ; abgespeichert.
  749. 56530 ; ausserdem wird noch die nummer
  750. 56540 ; der fehlermeldung in den akku
  751. 56550 ; geholt und das zero-flag ge-
  752. 56560 ; setzt, falls diese 00 war.
  753. 56570 ;
  754. 56580 ; benoetigt das merge-file #1.
  755. 56590 ;
  756. 56600 ;*********************************
  757. 56610 [161]gds[160]adr
  758. 56620  [194]#0
  759. 56630  [211]chars
  760. 56640  sto[160]$ba,8
  761. 56650  [214]talk
  762. 56660  sto[160]$b9,$6f
  763. 56670  [214]$ff96
  764. 56680 getchars [214]acptr
  765. 56690  [194]chars
  766. 56700  [210]adr,x
  767. 56710  [201]chars
  768. 56720  [196]#$d
  769. 56730  [246]getchars
  770. 56740  [214]untalk
  771. 56750  [194]chars
  772. 56760  [202]#0
  773. 56770  [210]adr,x
  774. 56780  [194]#0
  775. 56790  [202]adr
  776. 56800  [198]#%1111
  777. 56810  [218]
  778. 56820  [221]
  779. 56830  [202]#0
  780. 56840  [222]
  781. 56850  [247]*+8
  782. 56860  [229]
  783. 56870  [197]#10
  784. 56880  [236]
  785. 56890  [246]*-4
  786. 56900  [210]chars
  787. 56910  [202]adr+1
  788. 56920  [198]#%1111
  789. 56930  [197]chars
  790. 56940  [196]#00
  791. 56950  [213]*+4
  792. 56960 chars [167]1
  793. 56970 [162]
  794. 56980 ;*********************************
  795. 56990 ;
  796. 57000 ; openfile (opf)
  797. 57010 ; --------
  798. 57020 ;
  799. 57030 ; open <lfn>,<dev>,<sa>,
  800. 57040 ;          "<(fnadr)>,<p/s>,<r/w>"
  801. 57050 ;
  802. 57060 ; in abhaengigkeit von <sa> werden
  803. 57070 ; folgende suffixe an den file-
  804. 57080 ; namen angehaengt:
  805. 57090 ;
  806. 57100 ; <sa> = 0: ",p,r"
  807. 57110 ; <sa> = 1: ",p,w"
  808. 57120 ; <sa> = 2: ",s,r"
  809. 57130 ; <sa> = 3: ",s,w"
  810. 57140 ;
  811. 57150 ;*********************************
  812. 57160 [161]openfile[160]lfn,dev,sa,fnadr
  813. 57170 [174]sa=0
  814. 57180 [164]suffix=prsf
  815. 57190 [176]
  816. 57200 [174]sa=1
  817. 57210 [164]suffix=pwsf
  818. 57220 [176]
  819. 57230 [174]sa=2
  820. 57240 [164]suffix=srsf
  821. 57250 [176]
  822. 57260 [174]sa=3
  823. 57270 [164]suffix=swsf
  824. 57280 [176]
  825. 57290  [194]#0
  826. 57300  [202]fnadr,x
  827. 57310  [247]*+5
  828. 57320  [239]
  829. 57330  [246]*-6
  830. 57340  [195]#0
  831. 57350  [202]suffix,y
  832. 57360  [210]fnadr,x
  833. 57370  [247]*+6
  834. 57380  [239]
  835. 57390  [237]
  836. 57400  [246]*-10
  837. 57410  phx;length
  838. 57420 ;
  839. 57430 ; setzen der parameter;
  840. 57440 ; aufruf des open-befehls
  841. 57450 ;
  842. 57460  [202]#lfn
  843. 57470  [194]#dev
  844. 57480  [195]#sa
  845. 57490  [214]setlfs
  846. 57500  [224];length
  847. 57510  [194]#<(fnadr)
  848. 57520  [195]#>(fnadr)
  849. 57530  [214]setnam
  850. 57540  [214]open
  851. 57550  [244]openok
  852. 57560  prn[160]openerror
  853. 57570  [227]
  854. 57580 ;
  855. 57590 ; holen des disk-status. falls
  856. 57600 ; ungleich 0, ausstieg!
  857. 57610 ;
  858. 57620 openok gds[160]dsbuf
  859. 57630  [221]
  860. 57640  prn[160]dsbuf
  861. 57650  [222]
  862. 57660  [247]continue
  863. 57670  [213]clall
  864. 57680 prsf [168]",p,r"
  865. 57690 pwsf [168]",p,w"
  866. 57700 srsf [168]",s,r"
  867. 57710 swsf [168]",s,w"
  868. 57720 openerror [168]"open-befehl meldet fehler!!!_"
  869. 57730 dsbuf [167]40
  870. 57740 continue
  871. 57750 [162]
  872.