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 >
Wrap
Commodore BASIC
|
2022-10-26
|
14KB
|
872 lines
10 ;---------------------------------
11 ;
12 ; ----------------------
13 ; hypra-ass quelltext
14 ; konvertierungsprogramm
15 ; ----------------------
16 ;
17 ; programmiert von thomas dachsel
18 ; am 20. - 21. juni 1987
19 ;
20 ; dieses programm wandelt einen
21 ; hypra-ass quelltext in einen
22 ; giga-ass quelltext um, welcher
23 ; direkt auf diskette geschrieben
24 ; wird.
25 ;
26 ; starten sie dieses programm mit
27 ; <f3>. es werden dann alle not-
28 ; wendigen eingaben abgefragt.
29 ;
30 ;---------------------------------
100 +$6000
110 usr$6000
120 ;
130 ; -----------------------------
140 ; label- und makro-definitionen
150 ; -----------------------------
160 ;
170 tostartadr=$801
180 ;
190 tab(cnt=count
200 tab(ip=inchars
210 tab(op=outchars
220 tab(inbuf=lib
230 tab(outbuf=lob
240 ;
250 getreadchar
260 (NULL)get
270 peekip
280 (NULL)inbuf,x
290 right$ip
300 new
310 ;
320 getkey
330 prnclosekeytx
340 wait stoclose198,0
350 eqbclose198,*
360 cnqclose631,$d,wait
370 (NULL)leave
380 keytx not"__ <return> druecken"
390 leave stoclose198,0
400 new
410 ;
1000 ; -------------
1010 ; hauptprogramm
1020 ; -------------
1030 ;
1040 ; 1. eingabe der file-namen
1050 ;
1060 (NULL)clall
1070 prnclosestx
1080 rfnclosehqfn
1090 prnclosentx
1100 rfncloseaqfn
1110 ;
1120 ; 2. oeffnen der files
1130 ;
1140 prncloseo1tx
1150 prnclosehqfn
1160 prncloseo2tx
1170 openfileclose1,8,0,hqfn
1180 prncloseo3tx
1190 key
1200 prncloseo1tx
1210 prncloseaqfn
1220 prncloseo4tx
1230 openfileclose2,8,1,aqfn
1240 prncloseo3tx
1250 key
1260 prnclosemtx
1270 prncloseaqfn
1280 prnclosettx
1290 ;
1300 ; 3. initialisiere count
1320 ;
1330 dstclosecount,startadr
1331 mid$#$ff
1332 (NULL)lnr
1333 (NULL)lnr+1
1340 ;
1350 ; 4. schreibe neue startadresse
1360 ;
1370 peek#2
1380 (NULL)ckout
1390 outclose<(startadr)
1400 outclose>(startadr)
1410 ;
1420 ; 5. ueberlies alte startadresse
1430 ;
1440 peek#1
1450 (NULL)chkin
1460 (NULL)get
1470 (NULL)get
1480 ;
1490 ; 6. erste koppeladresse einlesen
1500 ;
1501 stocloseip,0
1510 readchar
1520 readchar
1530 ;
1540 ; 7. zeilennummer (l/h) einlesen
1550 ;
1560 contread readchar
1570 readchar
1580 ;
1590 ; 8. rest der zeile einlesen
1600 ;
1610 loop readchar
1620 str$#0
1630 (NULL)loop
1640 ;
1650 ; 9. rufe convline auf
1660 ;
1670 peek#2
1680 (NULL)ckout
1690 (NULL)convline
1700 ;
1710 ;10. setze pufferzeiger auf
1720 ; pufferanfang zurueck
1730 ;
1740 stocloseip,0
1750 ;
1760 ;11. lies koppeladresse der
1770 ; naechsten zeile ein
1780 ;
1790 peek#1
1800 (NULL)chkin
1810 readchar
1820 readchar
1830 ;
1840 ;12. check ob quelltext-ende
1850 ;
1860 mid$inbuf
1870 (NULL)contread
1880 mid$inbuf+1
1890 (NULL)contread
1900 ;
1910 ;13. schreibe 00 00 fuer
1920 ; quelltext-ende
1930 ;
1940 peek#2
1950 (NULL)ckout
1960 outclose0
1970 outclose0
1980 ;
1990 ;14. schliesse die files, setze
2000 ; ein-/ausgabe zurueck
2010 ;
2020 mid$#1
2030 (NULL)close
2040 mid$#2
2050 (NULL)close
2060 (NULL)clrch
2070 ;
2080 ; -----------------------
2090 ; ende des hauptprogramms
2100 ; -----------------------
2110 ;
3000 ; -----------------
3010 ; mnemonics - texte
3020 ; -----------------
3030 ;
3040 mnemonics not"cpxcpyldxldycmpadcanddeceorincldaaslbitlsr
3050 [168]"orarolrorsbcstastxstyjmpjsrtxataxtyataytsx
3060 not"txsphpplpphaplabrkrtirtsnopclcseccliseiclv
3070 [168]"cldseddeyinydexinxbplbmibvcbvsbccbcsbnebeq
3080 ;
3090 ; ----------------------
3100 ; pseudo-befehls - texte
3110 ; ----------------------
3120 ;
3130 pseudos not"..martgleqbywodstxobbaco
3140 [168]"ongoifeleisylienst
3150 endpseudos
4000 getgtc
4010 peekip
4020 mid$inbuf,x
4030 right$ip
4040 new
4050 getptc
4060 peekop
4070 (NULL)outbuf,x
4080 right$op
4090 icdclosecnt
4100 new
4110 getxfer
4120 gtc
4130 ptc
4140 new
4150 convline stocloseip,2
4160 stocloseop,2
4170 ;
4180 ; zeilennummer transferieren
4190 ;
4200 xfer
4210 xfer
4220 ;
4230 ; erstes zeichen der zeile:
4240 ; semikolon, dann kommentarzeile
4250 ; punkt, dann pseudo
4260 ; space, dann ueberlesen
4270 ; und zum 2. feld gehen
4280 ; sonst: label ueberlesen
4290 ;
4300 gtc
4310 cbnclose59,nocomm
4320 ptc
4330 (NULL)rlop
4340 nocomm cbnclose".",nopsd
4350 (NULL)ipsc
4360 nopsd ptc
4370 cbeclose32,secfield
4380 cbnclose0,*+7;end of
4390 (NULL)endline;line ?
4400 labelloop xfer
4410 cbnclose0,*+7;end of
4420 (NULL)endline;line ?
4430 cbnclose32,labelloop
4440 ;
4450 ; zweites feld:
4460 ; eventuell label, aber sicher
4470 ; ein space bereits uebertragen
4480 ;
4490 ; jetzt entweder pseudo oder
4500 ; mnemonic
4510 ;
4520 secfield gtc
4530 cbnclose".",*+7
4540 (NULL)ipsc
4550 peekip;x zeigt
4560 len#0;auf 2.
4570 (NULL)mc;zeichen
4580 search mid$inbuf-1,x
4590 str$mnemonics,y
4600 (NULL)nextone
4610 mid$inbuf,x
4620 str$mnemonics+1,y
4630 (NULL)nextone
4640 mid$inbuf+1,x
4650 str$mnemonics+2,y
4660 (NULL)found
4670 nextone (NULL)
4680 (NULL)
4690 (NULL)
4700 right$mc
4710 atn#pseudos-mnemonics
4720 (NULL)search
4730 ;
4740 ; mnemonic nicht gefunden:
4750 ; fehlerhafte zeile, wird ganz
4760 ; ueberlesen
4770 ;
4780 (NULL)rlop
4790 found mid$mc;mnemonic-
4800 (NULL)#$c0;code ab-
4810 ptc;legen
4820 gtc;3 zeichen
4830 gtc;skippen
4840 (NULL)rlop
5000 ;
5010 ; ------------------
5020 ; insert pseudo-code
5030 ; ------------------
5040 ; ip zeigt auf das erste der
5050 ; beiden pseudo-befehlszeichen
5060 ;
5070 ipsc len#0
5080 peekip
5090 comploop mid$inbuf,x
5100 str$pseudos,y
5110 (NULL)nexttext
5120 mid$inbuf+1,x
5130 str$pseudos+1,y
5140 (NULL)foundpsd
5150 nexttext (NULL)
5160 (NULL)
5170 atn#endpseudos-pseudos
5180 (NULL)comploop
5190 ;
5200 ; pseudo nicht gefunden:
5210 ; fehlerhafte zeile, wird
5220 ; ganz ueberlesen
5230 ;
5240 notfound
5250 mid$#"."
5260 ptc
5270 (NULL)rlop
5280 foundpsd gtc
5290 gtc
5300 (NULL)
5310 (NULL);pseudo-
5320 (NULL)#$a0;code in a
5330 ;
5340 ; nur speichern, falls kein
5350 ; macro call -- ausser der makro-
5360 ; name beginnt mit mnemonic
5370 ;
5380 cbnclose$a0,storepsc
5390 peekip
5400 len#0
5410 occurschk mid$inbuf,x
5420 (NULL)storepsc-3
5430 str$mnemonics,y
5440 (NULL)nextmnemo
5450 mid$inbuf+1,x
5460 str$mnemonics+1,y
5470 (NULL)nextmnemo
5480 mid$inbuf+2,x
5490 str$mnemonics+2,y
5500 (NULL)nextmnemo
5510 mid$#$a0
5520 (NULL)storepsc
5530 nextmnemo (NULL)
5540 (NULL)
5550 (NULL)
5560 atn#pseudos-mnemonics
5570 (NULL)occurschk
5580 (NULL)l1
5590 storepsc ptc
5600 ;
5610 ; falls .text-pseudo, eventuelles
5620 ; abschliessendes hochkomma ent-
5630 ; fernen
5640 ;
5650 cbnclose$a8,skip
5660 tl1 gtc
5670 cbnclose0,*+7;end of
5680 (NULL)put0;line ?
5690 ptc
5700 cbnclose34,tl1
5710 tl2 gtc
5720 cbnclose0,*+7;end of
5730 (NULL)put0;line ?
5740 cbnclose34,*+7
5750 (NULL)rlop
5760 ptc
5770 (NULL)tl2
5780 ;
5790 ; falls makro-definition oder
5800 ; -aufruf, klammern wandeln
5810 ;
5820 ; es wird die erste klammer auf
5830 ; in $a0 (shift space) gewandelt
5840 ; und die letzte klammer zu
5850 ; geloescht (syntaktisch richtige
5860 ; klammerung der makro-parameter
5870 ; vorausgesetzt)
5880 ;
5890 skip str$#$a2
5900 (NULL)rlop
5910 l1 gtc
5920 cbnclose0,*+7
5930 (NULL)put0
5940 cbeclose"(",l2
5950 ptc
5960 (NULL)l1
5970 l2 mid$#$a0;1. "("
5980 ptc; --> $a0
5990 stoclosemc,0
6000 l3 gtc
6010 cbeclose0,put0
6020 cbnclose"(",*+9
6030 right$mc
6040 (NULL)*+11
6050 cbnclose")",*+9
6060 chr$mc;delete
6070 (NULL)rlop;last ")"
6080 ptc
6090 (NULL)l3
9000 ;
9010 ; transfer rest of line
9020 ;
9030 rlop xfer
9040 str$#0
9050 (NULL)rlop
9060 ;
9070 ; fuege null-byte an
9080 ;
9090 mid$#0
9100 put0 ptc
9110 ;
9120 ; speichere koppeladresse
9130 ;
9140 endline icdclosecount
9150 mvdclosecount,outbuf
9160 ;
9170 ; check ob zeile schon einmal
9180 ; uebertragen
9190 ;
9200 mid$outbuf+2
9210 str$lnr
9220 (NULL)sendline
9230 mid$outbuf+3
9240 str$lnr+1
9250 (NULL)sendline
9260 (NULL)
9270 sendline mvdcloseoutbuf+2,lnr
9280 ;
9290 ; schicke zeile zur floppy
9300 ;
9310 peek#0
9320 sendlop mid$outbuf,x
9330 (NULL)chrout
9340 (NULL);4 bytes
9350 tan#5;always
9360 (NULL)sendlop
9370 str$#0
9380 (NULL)sendlop
9390 (NULL)
10000 ; -----
10010 ; texte
10020 ; -----
10030 ;
10040 stx fn$93
10050 not"__ konvertierungsprogramm
10060 [168]"__ zum wandeln eines hypra-ass
10070 not"__ quelltextes in das giga-ass format
10080 [168]"___ legen sie die diskette mit dem
10090 not"_ hypra-ass quelltext in das laufwerk
10100 [168]"_ und geben sie den filenamen des
10110 not"_ hypra-ass quelltextes ein!__ "
10120 ntx not"__ geben sie nun bitte den namen
10130 [168]"_ fuer den giga-ass quelltext ein.__ "
10140 o1tx [165]$93
10150 [168]"__ es wird versucht, das file__ "
10160 o2tx [168]"__ zum lesen zu oeffnen.__ "
10170 o3tx [168]"__ das oeffnen war erfolgreich."
10180 o4tx [168]"__ zum schreiben zu oeffnen.__ "
10190 mtx [165]$93
10200 [168]"__ der angegebene quelltext wird nun
10210 not"__ in einen giga-ass quelltext mit__ dem namen "
10220 ttx not"__ umgewandelt.__"
20000 ;
20010 ; ------------
20020 ; datenbereich
20030 ; ------------
20040 ;
20041 count then2
20042 lnr then2
20043 mc then1
20050 hqfn then21
20060 aqfn then21
20070 inchars then1
20080 lib then80
20081 outchars then1
20082 lob then80
50000 ;---------------------------------
50010 ;
50020 ; merge file #1: kernel jump table
50030 ;
50040 ;---------------------------------
50050 tab(acptr=$ffa5
50060 tab(ciout=$ffa8
50070 tab(untalk=$ffab
50080 tab(unlisten=$ffae
50090 tab(listen=$ffb1
50100 tab(talk=$ffb4
50110 tab(status=$ffb7
50120 tab(setlfs=$ffba
50130 tab(setnam=$ffbd
50140 tab(open=$ffc0
50150 tab(close=$ffc3
50160 tab(chkin=$ffc6
50170 tab(ckout=$ffc9
50180 tab(clrch=$ffcc
50190 tab(basin=$ffcf
50200 tab(chrout=$ffd2
50210 tab(load=$ffd5
50220 tab(save=$ffd8
50230 tab(settim=$ffdb
50240 tab(gettim=$ffde
50250 tab(stopkey=$ffe1
50260 tab(get=$ffe4
50270 tab(clall=$ffe7
50280 tab(udtim=$ffea
50290 tab(screen=$ffed
50300 tab(cursor=$fff0
51000 ;---------------------------------
51010 ;
51020 ; merge file #2: low-level macros
51030 ;
51040 ;---------------------------------
51050 getstoclosea,v
51060 mid$#v
51070 (NULL)a
51080 new
51090 getdstclosea,dv
51100 mid$#<(dv)
51110 (NULL)a
51120 mid$#>(dv)
51130 (NULL)a+1
51140 new
51150 getmovclosef,t
51160 mid$f
51170 (NULL)t
51180 new
51190 getmdiclosea,p
51200 mid$a
51210 (NULL)&p,y
51220 new
51230 getmidclosep,a
51240 mid$&p,y
51250 (NULL)a
51260 new
51270 getmvdclosef,t
51280 mid$f
51290 peekf+1
51300 (NULL)t
51310 (NULL)t+1
51320 new
51330 getcbeclosev,a
51340 str$#v
51350 (NULL)a
51360 new
51370 getcbnclosev,a
51380 str$#v
51390 (NULL)a
51400 new
51410 getcnqclosea,v,b
51420 mid$a
51430 str$#v
51440 (NULL)b
51450 new
51460 geteqbclosea,b
51470 mid$a
51480 (NULL)b
51490 new
51500 getnqbclosea,b
51510 mid$a
51520 (NULL)b
51530 new
51540 getldwclosea
51550 mid$a
51560 lena+1
51570 new
51580 getstwclosea
51590 (NULL)a
51600 (NULL)a+1
51610 new
51620 geticdclosea
51630 right$a
51640 (NULL)end
51650 right$a+1
51660 end
51670 new
51680 getpshclosea
51690 mid$a
51700 (NULL)
51710 new
51720 getpllclosea
51730 (NULL)
51740 (NULL)a
51750 new
51760 getphx
51770 (NULL)
51780 (NULL)
51790 new
51800 getplx
51810 (NULL)
51820 (NULL)
51830 new
51840 getphy
51850 (NULL)
51860 (NULL)
51870 new
51880 getply
51890 (NULL)
51900 (NULL)
51910 new
51920 getprncloset
51930 mid$#<(t)
51940 len#>(t)
51950 (NULL)$ab1e
51960 new
51970 getoutclosea
51980 mid$#a
51990 (NULL)$ffd2
52000 new
52010 getmbyclosenr,code
52020 toc=nr
52030 *c=0,52070
52040 fncode
52050 toc=c-1
52060 /52030
52070 new
55000 ;---------------------------------
55010 ;
55020 ; merge file #3: high-level macros
55030 ;
55040 ;---------------------------------
55050 ;*********************************
55060 ;
55070 ; relative load (rld)
55080 ; -------------
55090 ; ein file wird relativ in den
55100 ; speicher ab adresse "adr" ge-
55110 ; laden. der name des files muss
55120 ; ab der adresse "filename"
55130 ; im speicher stehen.
55140 ; hinter dem letzten zeichen des
55150 ; namens muss ein nullbyte folgen.
55160 ;
55170 ; benoetigt das merge-file #1.
55180 ;
55190 ;*********************************
55200 getrldclosefilename,adr
55210 mid$#1;lfn
55220 peek#8;dev
55230 len#0;sa
55240 (NULL)setlfs
55250 ;
55260 ; laenge des filenamens bestimmen
55270 ;
55280 peek#0
55290 testchar mid$filename,x
55300 (NULL)setlen
55310 (NULL)
55320 (NULL)testchar
55330 setlen (NULL)
55340 peek#<(filename)
55350 len#>(filename)
55360 (NULL)setnam
55370 mid$#0
55380 peek#<(adr)
55390 len#>(adr)
55400 (NULL)load
55410 new
55420 ;*********************************
55430 ;
55440 ; read filename (rfn)
55450 ; -------------
55460 ; ein filename wird von der tasta-
55470 ; tur eingelesen und ab der adres-
55480 ; se "adr" in den speicher abge-
55490 ; legt.
55500 ; hinter dem letzten zeichen des
55510 ; namens wird ein nullbyte ange-
55520 ; fuegt.
55530 ;
55540 ; benoetigt merge-files #1 und #2.
55550 ;
55560 ;*********************************
55570 getrfncloseadr
55580 ;
55590 ; tastatur-file oeffnen
55600 ;
55610 mid$#"t";lfn
55620 peek#0;dev
55630 len#0;sa
55640 (NULL)setlfs
55650 (NULL)open
55660 peek#"t"
55670 (NULL)chkin
55680 ;
55690 ; bildschirm-file oeffnen
55700 ;
55710 mid$#"b";lfn
55720 peek#3;dev
55730 len#0;sa
55740 (NULL)setlfs
55750 (NULL)open
55760 peek#"b"
55770 (NULL)ckout
55780 ;
55790 ; prompt und input-zeile ausgeben
55800 ;
55810 prncloseprompt
55820 (NULL)getline
55830 prompt not"filename?
55840 [165]32
55850 mby[160]16,$a4
55860 mby[160]16,$9d
55870 revchar [165]$12,$20,$92,$9d,0
55880 delchar [165]$a4,$9d,$9d,0
55890 ;
55900 ; maximal 16 zeichen holen
55910 ;
55920 getline sto[160]chars,0
55930 getchar [214]get
55940 [247]*-3
55950 [198]#$7f
55960 cbn[160]20,checkkey
55970 [194]chars
55980 [247]getchar
55990 [192]#16
56000 [244]*+5
56010 [199]chars
56020 [199]chars
56030 prn[160]delchar
56040 prn[160]revchar
56050 [213]getchar
56060 checkkey [196]#32
56070 [244]nonprint
56080 [194]chars
56090 [192]#16
56100 [244]*+3
56110 [238]
56120 [210]adr,x
56130 [214]chrout
56140 [194]chars
56150 [192]#16
56160 [245]*+5
56170 [201]chars
56180 [192]#15
56190 [245]lastchar
56200 prn[160]revchar
56210 [213]getchar
56220 lastchar out[160]$9d
56230 [213]getchar
56240 nonprint [196]#$d
56250 [246]getchar
56260 [194]chars
56270 [192]#16
56280 [245]*+7
56290 out[160]$a4
56300 [202]#0
56310 [210]adr,x
56320 ;
56330 ; files schliessen
56340 ;
56350 [202]#"t"
56360 [214]close
56370 [202]#"b"
56380 [214]close
56390 [213]*+4
56400 chars [167]1
56410 [162]
56420 ;*********************************
56430 ;
56440 ; get disk status (gds)
56450 ; ---------------
56460 ;
56470 ; dieser makro holt den disk-
56480 ; status in den speicherbereich,
56490 ; der durch adresse "adr" spezi-
56500 ; fiziert ist. hinter das letzte
56510 ; zeichen wird ein nullbyte
56520 ; abgespeichert.
56530 ; ausserdem wird noch die nummer
56540 ; der fehlermeldung in den akku
56550 ; geholt und das zero-flag ge-
56560 ; setzt, falls diese 00 war.
56570 ;
56580 ; benoetigt das merge-file #1.
56590 ;
56600 ;*********************************
56610 [161]gds[160]adr
56620 [194]#0
56630 [211]chars
56640 sto[160]$ba,8
56650 [214]talk
56660 sto[160]$b9,$6f
56670 [214]$ff96
56680 getchars [214]acptr
56690 [194]chars
56700 [210]adr,x
56710 [201]chars
56720 [196]#$d
56730 [246]getchars
56740 [214]untalk
56750 [194]chars
56760 [202]#0
56770 [210]adr,x
56780 [194]#0
56790 [202]adr
56800 [198]#%1111
56810 [218]
56820 [221]
56830 [202]#0
56840 [222]
56850 [247]*+8
56860 [229]
56870 [197]#10
56880 [236]
56890 [246]*-4
56900 [210]chars
56910 [202]adr+1
56920 [198]#%1111
56930 [197]chars
56940 [196]#00
56950 [213]*+4
56960 chars [167]1
56970 [162]
56980 ;*********************************
56990 ;
57000 ; openfile (opf)
57010 ; --------
57020 ;
57030 ; open <lfn>,<dev>,<sa>,
57040 ; "<(fnadr)>,<p/s>,<r/w>"
57050 ;
57060 ; in abhaengigkeit von <sa> werden
57070 ; folgende suffixe an den file-
57080 ; namen angehaengt:
57090 ;
57100 ; <sa> = 0: ",p,r"
57110 ; <sa> = 1: ",p,w"
57120 ; <sa> = 2: ",s,r"
57130 ; <sa> = 3: ",s,w"
57140 ;
57150 ;*********************************
57160 [161]openfile[160]lfn,dev,sa,fnadr
57170 [174]sa=0
57180 [164]suffix=prsf
57190 [176]
57200 [174]sa=1
57210 [164]suffix=pwsf
57220 [176]
57230 [174]sa=2
57240 [164]suffix=srsf
57250 [176]
57260 [174]sa=3
57270 [164]suffix=swsf
57280 [176]
57290 [194]#0
57300 [202]fnadr,x
57310 [247]*+5
57320 [239]
57330 [246]*-6
57340 [195]#0
57350 [202]suffix,y
57360 [210]fnadr,x
57370 [247]*+6
57380 [239]
57390 [237]
57400 [246]*-10
57410 phx;length
57420 ;
57430 ; setzen der parameter;
57440 ; aufruf des open-befehls
57450 ;
57460 [202]#lfn
57470 [194]#dev
57480 [195]#sa
57490 [214]setlfs
57500 [224];length
57510 [194]#<(fnadr)
57520 [195]#>(fnadr)
57530 [214]setnam
57540 [214]open
57550 [244]openok
57560 prn[160]openerror
57570 [227]
57580 ;
57590 ; holen des disk-status. falls
57600 ; ungleich 0, ausstieg!
57610 ;
57620 openok gds[160]dsbuf
57630 [221]
57640 prn[160]dsbuf
57650 [222]
57660 [247]continue
57670 [213]clall
57680 prsf [168]",p,r"
57690 pwsf [168]",p,w"
57700 srsf [168]",s,r"
57710 swsf [168]",s,w"
57720 openerror [168]"open-befehl meldet fehler!!!_"
57730 dsbuf [167]40
57740 continue
57750 [162]