mirror of https://github.com/wwarthen/RomWBW.git
Browse Source
Updated Cowgol disk image with the latest distribution from Ladislau Szilagyi. Co-Authored-By: ladislau szilagyi <87603175+Laci1953@users.noreply.github.com>pull/517/head v3.5.0-rc.2
Wayne Warthen
10 months ago
44 changed files with 5663 additions and 4026 deletions
Binary file not shown.
Binary file not shown.
File diff suppressed because it is too large
@ -1,2 +1,2 @@ |
|||
COWGOL -O ADVENT.COW ADVMAIN.COW XRND.AS |
|||
COWGOL -O MISC.COO STRING.COO RANFILE.COO ADVENT.COW ADVTRAV.COW ADVMAIN.COW |
|||
|
|||
File diff suppressed because it is too large
@ -0,0 +1,587 @@ |
|||
## |
|||
## This is Daimler's 350-point "Adventure" (circa June 1990, according |
|||
## to Russel Dalenberg). Its version information lists |
|||
## |
|||
## -Conversion to BDS C by J. R. Jaeger |
|||
## -Unix standardization by Jerry D. Pohl. |
|||
## -OS/2 Conversion by Martin Heller |
|||
## -Conversion to TurboC 2.0 by Daimler |
|||
## |
|||
## It contains Jerry Pohl's original ADVENT.DOC (dated 12 JUNE 1984), |
|||
## plus comments from Martin Heller (dated 30-Aug-1988). Strangely for |
|||
## an expansion, Daimler's version actually introduces a number of typos |
|||
## into the data files, and disables a handful of inessential verbs |
|||
## (READ, EAT, FILL) with the comment that there is "no room" for them |
|||
## (presumably in the PC's limited memory). |
|||
## ------------------------------------------------------------------- |
|||
## Adapted for HiTech C Z80 under CP/M by Ladislau Szilagyi, Oct. 2023 |
|||
## Uncommented Daimler's disabled verbs - game is complete again ! |
|||
## Added a new pseudo-random number generator (Xorshift) |
|||
## Adapted to Cowgol language by Ladislau Szilagyi, Feb. 2025 |
|||
|
|||
include "misc.coh"; |
|||
include "string.coh"; |
|||
|
|||
@decl sub get_dbugflg(): (ret: int16) @extern("get_dbugflg"); |
|||
@decl sub bug(n: uint8) @extern("bug"); |
|||
@decl sub set_newloc(v: int16) @extern("set_newloc"); |
|||
@decl sub set_oldloc(v: int16) @extern("set_oldloc"); |
|||
@decl sub set_oldloc2(v: int16) @extern("set_oldloc2"); |
|||
@decl sub toting(item: uint16): (ret: uint8) @extern("toting"); |
|||
@decl sub at(item: uint16): (ret: uint8) @extern("at"); |
|||
@decl sub get_prop(obj: uint8): (ret: int16) @extern("get_prop"); |
|||
@decl sub badmove(motion: int16, verb: int16) @extern("badmove"); |
|||
@decl sub rspeak(msg: uint8) @extern("rspeak"); |
|||
@decl sub spcmove(rdest: uint16) @extern("spcmove"); |
|||
@decl sub forced(atloc: uint16): (ret: uint8) @extern("forced"); |
|||
@decl sub set_motion(v: int16) @extern("set_motion"); |
|||
|
|||
var dummy: [uint8]; |
|||
|
|||
const MAXTRAV := (16+1); # max # of travel directions from loc |
|||
# +1 for terminator travel[x].tdest=-1 |
|||
record trav is |
|||
tdest: int16; |
|||
tverb: int16; |
|||
tcond: int16; |
|||
end record; |
|||
|
|||
var travel: trav[MAXTRAV]; |
|||
|
|||
# WARNING: the travel array for the cave is stored as MAXLOC |
|||
# strings. the strings are an array of 1..MAXTRAV |
|||
# LONG INTEGERS. this requires 32 bit LONG INTEGERS. |
|||
# these values are used in database.c "gettrav". |
|||
# tdset*1000000 + tverb*1000 + tcond = value stored |
|||
|
|||
var cave: [uint8][] := |
|||
{ |
|||
"2002,2044,2029,3003,3012,3019,3043,4005,4013,4014,4046,4030,5006,5045,5043,8063,", |
|||
"1002000,1012000,1007000,1043000,1045000,1030000,5006000,5045000,5046000,", |
|||
"1003000,1011000,1032000,1044000,11062000,33065000,79005000,79014000,", |
|||
"1004000,1012000,1045000,5006000,5043000,5044000,5029000,7005000,7046000,7030000,8063000,", |
|||
"4009000,4043000,4030000,5006050,5007050,5045050,6006000,5044000,5046000,", |
|||
"1002000,1045000,4009000,4043000,4044000,4030000,5006000,5046000,", |
|||
"1012000,4004000,4045000,5006000,5043000,5044000,8005000,8015000,8016000,8046000,595060000,595014000,595030000,", |
|||
"5006000,5043000,5046000,5044000,1012000,7004000,7013000,7045000,9003303,9019303,9030303,593003000,", |
|||
"8011303,8029303,593011000,10017000,10018000,10019000,10044000,14031000,11051000,", |
|||
"9011000,9020000,9021000,9043000,11019000,11022000,11044000,11051000,14031000,", |
|||
"8063303,9064000,10017000,10018000,10023000,10024000,10043000,12025000,12019000,12029000,12044000,3062000,14031000,", |
|||
"8063303,9064000,11030000,11043000,11051000,13019000,13029000,13044000,14031000,", |
|||
"8063303,9064000,11051000,12025000,12043000,14023000,14031000,14044000,", |
|||
"8063303,9064000,11051000,13023000,13043000,20030150,20031150,20034150,15030000,16033000,16044000,", |
|||
"1803,1804,1700,1703,1704,1901,1903,1904,2202,2203,2203,2203,2202,2204,1402,3405,", |
|||
"14001000,", |
|||
"15038000,15043000,596039312,21007412,597041412,597042412,597044412,597069412,27041000,", |
|||
"15038000,15011000,15045000,", |
|||
"15010000,15029000,15043000,28045311,28036311,29046311,29037311,30044311,30007311,32045000,74049035,32049211,74066000,", |
|||
"001000,", |
|||
"001000,", |
|||
"15001000,", |
|||
"67043000,67042000,68044000,68061000,25030000,25031000,648052000,", |
|||
"67029000,67011000,", |
|||
"23029000,23011000,31056724,26056000,", |
|||
"88001000,", |
|||
"596039312,21007412,597041412,597042412,597043412,597069412,17041000,40045000,41044000,", |
|||
"19038000,19011000,19046000,33045000,33055000,36030000,36052000,", |
|||
"19038000,19011000,19045000,", |
|||
"19038000,19011000,19043000,62044000,62029000,", |
|||
"89001524,90001000,", |
|||
"19001000,", |
|||
"3065000,28046000,34043000,34053000,34054000,35044000,302071159,100071000,", |
|||
"33030000,33055000,15029000,", |
|||
"33043000,33055000,20039000,", |
|||
"37043000,37017000,28029000,28052000,39044000,65070000,", |
|||
"36044000,36017000,38030000,38031000,38056000,", |
|||
"37056000,37029000,37011000,595060000,595014000,595030000,595004000,595005000,", |
|||
"36043000,36023000,64030000,64052000,64058000,65070000,", |
|||
"41001000,", |
|||
"42046000,42029000,42023000,42056000,27043000,59045000,60044000,60017000,", |
|||
"41029000,42045000,43043000,45046000,80044000,", |
|||
"42044000,44046000,45043000,", |
|||
"43043000,48030000,50046000,82045000,", |
|||
"42044000,43045000,46043000,47046000,87029000,87030000,", |
|||
"45044000,45011000,", |
|||
"45043000,45011000,", |
|||
"44029000,44011000,", |
|||
"50043000,51044000,", |
|||
"44043000,49044000,51030000,52046000,", |
|||
"49044000,50029000,52043000,53046000,", |
|||
"50044000,51043000,52046000,53029000,55045000,86030000,", |
|||
"51044000,52045000,54046000,", |
|||
"53044000,53011000,", |
|||
"52044000,55045000,56030000,57043000,", |
|||
"55029000,55011000,", |
|||
"13030000,13056000,55044000,58046000,83045000,84043000,", |
|||
"57043000,57011000,", |
|||
"27001000,", |
|||
"41043000,41029000,41017000,61044000,62045000,62030000,62052000,", |
|||
"60043000,62045000,107046100,", |
|||
"60044000,63045000,30043000,61046000,", |
|||
"62046000,62011000,", |
|||
"39029000,39056000,39059000,65044000,65070000,103045000,103074000,106043000,", |
|||
"64043000,66044000,556046080,68061000,556029080,70029050,39029000,556045060,72045075,71045000,556030080,106030000,", |
|||
"65047000,67044000,556046080,77025000,96043000,556050050,97072000,", |
|||
"66043000,23044000,23042000,24030000,24031000,", |
|||
"23046000,69029000,69056000,65045000,", |
|||
"68030000,68061000,120046331,119046000,109045000,113075000,", |
|||
"71045000,65030000,65023000,111046000,", |
|||
"65048000,70046000,110045000,", |
|||
"65070000,118049000,73045000,97048000,97072000,", |
|||
"72046000,72017000,72011000,", |
|||
"19043000,120044331,121044000,75030000,", |
|||
"76046000,77045000,", |
|||
"75045000,", |
|||
"75043000,78044000,66045000,66017000,", |
|||
"77046000,", |
|||
"3001000,", |
|||
"42045000,80044000,80046000,81043000,", |
|||
"80044000,80011000,", |
|||
"44046000,44011000,", |
|||
"57046000,84043000,85044000,", |
|||
"57045000,83044000,114050000,", |
|||
"83043000,83011000,", |
|||
"52029000,52011000,", |
|||
"45029000,45030000,", |
|||
"25030000,25056000,25043000,20039000,92044000,92027000,", |
|||
"25001000,", |
|||
"23001000,", |
|||
"95045000,95073000,95023000,72030000,72056000,", |
|||
"88046000,93043000,94045000,", |
|||
"92046000,92027000,92011000,", |
|||
"92046000,92027000,92023000,95045309,95003309,95073309,611045000,", |
|||
"94046000,94011000,92027000,91044000,", |
|||
"66044000,66011000,", |
|||
"66048000,72044000,72017000,98029000,98045000,98073000,", |
|||
"97046000,97072000,99044000,", |
|||
"98050000,98073000,301043000,301023000,100043000,", |
|||
"301044000,301023000,301011000,99044000,302071159,33071000,101047000,101022000,", |
|||
"100046000,100071000,100011000,", |
|||
"103030000,103074000,103011000,", |
|||
"102029000,102038000,104030000,618046114,619046115,64046000,", |
|||
"103029000,103074000,105030000,", |
|||
"104029000,104011000,103074000,", |
|||
"64029000,65044000,108043000,", |
|||
"131046000,132049000,133047000,134048000,135029000,136050000,137043000,138044000,139045000,61030000,", |
|||
"556043095,556045095,556046095,556047095,556048095,556049095,556050095,556029095,556030095,106043000,626044000,", |
|||
"69046000,113045000,113075000,", |
|||
"71044000,20039000,", |
|||
"70045000,50030040,50039040,50056040,53030050,45030000,", |
|||
"131049000,132045000,133043000,134050000,135048000,136047000,137044000,138030000,139029000,140046000,", |
|||
"109046000,109011000,109109000,", |
|||
"84048000,", |
|||
"116049000,", |
|||
"115047000,593030000,", |
|||
"118049000,660041233,660042233,660069233,660047233,661041332,303041000,21039332,596039000,", |
|||
"72030000,117029000,", |
|||
"69045000,69011000,653043000,65307000,", |
|||
"69045000,74043000,", |
|||
"74043000,74011000,653045000,653007000,", |
|||
"123047000,660041233,660042233,660069233,660049233,303041000,596039000,124077000,126028000,129040000,", |
|||
"122044000,124043000,124077000,126028000,129040000,", |
|||
"123044000,125047000,125036000,128048000,128037000,128030000,126028000,129040000,", |
|||
"124046000,124077000,126045000,126028000,127043000,127017000,", |
|||
"125046000,125023000,125011000,124077000,610030000,610039000,", |
|||
"125044000,125011000,125017000,124077000,126028000,", |
|||
"124045000,124029000,124077000,129046000,129030000,129040000,126028000,", |
|||
"128044000,128029000,124077000,130043000,130019000,130040000,130003000,126028000,", |
|||
"129044000,124077000,126028000,", |
|||
"107044000,132048000,133050000,134049000,135047000,136029000,137030000,138045000,139046000,112043000,", |
|||
"107050000,131029000,133045000,134046000,135044000,136049000,137047000,138043000,139030000,112048000,", |
|||
"107029000,131030000,132044000,134047000,135049000,136043000,137045000,138050000,139048000,112046000,", |
|||
"107047000,131045000,132050000,133048000,135043000,136030000,137046000,138029000,139044000,112049000,", |
|||
"107045000,131048000,132030000,133046000,134043000,136044000,137049000,138047000,139050000,112029000,", |
|||
"107043000,131044000,132029000,133049000,134030000,135046000,137050000,138048000,139047000,112045000,", |
|||
"107048000,131047000,132046000,133030000,134029000,135050000,136045000,138049000,139043000,112044000,", |
|||
"107030000,131043000,132047000,133029000,134044000,135045000,136046000,137048000,139049000,112050000,", |
|||
"107049000,131050000,132043000,133044000,134045000,135030000,136048000,137029000,138046000,112047000,", |
|||
"112045000,112011000," |
|||
}; |
|||
|
|||
var caveend: [uint8][] := |
|||
{ |
|||
"000,000,000,000,000,000,000,000,000,000,000,000,000,000,000,000,", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
"6000,6000,7000,8000,4000,0000,0000,5000,9150,1150,4150,5150,3150,3150,9000,5000,", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
",", |
|||
"," |
|||
}; |
|||
|
|||
# Routine to fill travel array for a given location |
|||
sub gettrav(loc: uint8) @extern("gettrav") is |
|||
var i: uint8; |
|||
var t: int32; |
|||
var p1: [uint8]; |
|||
var q1: [uint8]; |
|||
var p2: [uint8]; |
|||
var q2: [uint8]; |
|||
var buf1: uint8[256]; |
|||
var buf2: uint8[256]; |
|||
var aptr: [uint8]; |
|||
var atrav: uint8[256]; |
|||
var hasend: uint8 := 1; |
|||
|
|||
dummy := strcpy(&buf1[0], cave[loc - 1]); |
|||
p1 := &buf1[0]; |
|||
|
|||
dummy := strcpy(&buf2[0], caveend[loc - 1]); |
|||
p2 := &buf2[0]; |
|||
|
|||
if [p2] == ',' then |
|||
hasend := 0; |
|||
end if; |
|||
|
|||
aptr := &atrav[0]; |
|||
|
|||
q1 := strchr(p1, ','); |
|||
while q1 != nil loop |
|||
[q1] := 0; |
|||
dummy := strcpy(aptr, p1); |
|||
p1 := q1 + 1; |
|||
|
|||
if hasend == 1 then |
|||
q2 := strchr(p2, ','); |
|||
[q2] := 0; |
|||
dummy := strcat(aptr, p2); |
|||
p2 := q2 + 1; |
|||
end if; |
|||
|
|||
q1 := strchr(p1, ','); |
|||
#print(aptr); print_nl(); |
|||
aptr := aptr + strlen(aptr) + 1; |
|||
end loop; |
|||
[aptr] := 0; |
|||
|
|||
aptr := &atrav[0]; |
|||
|
|||
i := 0; |
|||
while i < MAXTRAV loop |
|||
t := atol(aptr); # convert to long int |
|||
travel[i].tcond := (t % 1000) as int16; |
|||
t := t / 1000; |
|||
travel[i].tverb := (t % 1000) as int16; |
|||
t := t / 1000; |
|||
travel[i].tdest := (t % 1000) as int16; |
|||
|
|||
aptr := aptr + strlen(aptr) + 1; |
|||
|
|||
if [aptr] == 0 then |
|||
i := i + 1; |
|||
travel[i].tdest := -1; # end of array |
|||
if get_dbugflg() == 1 then |
|||
i := 0; |
|||
while travel[i].tdest != -1 loop |
|||
print("cave["); |
|||
print(itoa(loc as int16)); |
|||
print("] = "); |
|||
print(itoa(travel[i].tdest)); |
|||
print_char(' '); |
|||
print(itoa(travel[i].tverb)); |
|||
print_char(' '); |
|||
print(itoa(travel[i].tcond)); |
|||
print_nl(); |
|||
i := i + 1; |
|||
end loop; |
|||
end if; |
|||
return; |
|||
end if; |
|||
i := i + 1; |
|||
end loop; |
|||
bug(33); |
|||
end sub; |
|||
|
|||
# Routine to figure out a new location |
|||
# given current location and a motion. |
|||
sub dotrav(loc: int16, motion: int16, verb:int16) @extern("dotrav") is |
|||
var mvflag: uint8; |
|||
var hitflag: uint8; |
|||
var kk: uint8; |
|||
var rdest: int16; |
|||
var rverb: int16; |
|||
var rcond: int16; |
|||
var robject: int16; |
|||
var pctt: uint16; |
|||
|
|||
set_newloc(loc); |
|||
mvflag := 0; |
|||
hitflag := 0; |
|||
pctt := xrnd() % 100; |
|||
|
|||
kk := 0; |
|||
while travel[kk].tdest >= 0 and mvflag == 0 loop |
|||
rdest := travel[kk].tdest; |
|||
rverb := travel[kk].tverb; |
|||
rcond := travel[kk].tcond; |
|||
robject := rcond % 100; |
|||
|
|||
if get_dbugflg() == 1 then |
|||
print("rdest = "); |
|||
print(itoa(rdest)); |
|||
print(", rverb = "); |
|||
print(itoa(rverb)); |
|||
print(", rcond = "); |
|||
print(itoa(rcond)); |
|||
print(", robject = "); |
|||
print(itoa(robject)); |
|||
print(" in dotrav\n"); |
|||
end if; |
|||
|
|||
if rverb != 1 and rverb != motion and hitflag == 0 then |
|||
kk := kk + 1; |
|||
continue; |
|||
end if; |
|||
|
|||
hitflag := hitflag + 1; |
|||
|
|||
var r := rcond; |
|||
r := r / 100; |
|||
if r == 3 or r == 4 or r == 5 then r := 7; end if; |
|||
case r is |
|||
when 0: |
|||
if rcond == 0 or pctt < rcond as uint16 then |
|||
mvflag := mvflag + 1; |
|||
end if; |
|||
if rcond == 1 and get_dbugflg() == 1 then |
|||
print("%% move "); |
|||
print(itoa(pctt as int16)); |
|||
print_char(' '); |
|||
print(itoa(mvflag as int16)); |
|||
print_nl(); |
|||
end if; |
|||
when 1: |
|||
if robject == 0 or toting(robject as uint16) == 1 then |
|||
mvflag := mvflag + 1; |
|||
end if; |
|||
when 2: |
|||
if toting(robject as uint16) == 1 or at(robject as uint16) == 1 then |
|||
mvflag := mvflag + 1; |
|||
end if; |
|||
#when 3: |
|||
#when 4: |
|||
#when 5: |
|||
when 7: |
|||
if get_prop(robject as uint8) != (rcond/100)-3 then |
|||
mvflag := mvflag + 1; |
|||
end if; |
|||
when else: |
|||
bug(37); |
|||
end case; |
|||
kk := kk + 1; |
|||
end loop; |
|||
|
|||
if mvflag == 0 then |
|||
badmove(motion, verb); |
|||
elseif rdest > 500 then |
|||
rspeak((rdest-500) as uint8); |
|||
elseif rdest>300 then |
|||
spcmove(rdest as uint16); |
|||
else |
|||
set_newloc(rdest); |
|||
if get_dbugflg() == 1 then |
|||
print("newloc in dotrav = "); |
|||
print(itoa(rdest)); #newloc |
|||
print_nl(); |
|||
end if; |
|||
end if; |
|||
end sub; |
|||
|
|||
# Routine to copy a travel array |
|||
sub copytrv(trav1: [trav], trav2: [trav]) is |
|||
var i: uint8; |
|||
|
|||
i := 0; |
|||
while i < MAXTRAV loop |
|||
[trav2].tdest := [trav1].tdest; |
|||
[trav2].tverb := [trav1].tverb; |
|||
[trav2].tcond := [trav1].tcond; |
|||
trav1 := @next trav1; |
|||
trav2 := @next trav2; |
|||
i := i + 1; |
|||
end loop; |
|||
end sub; |
|||
|
|||
# Routine to handle request to return |
|||
# from whence we came! |
|||
sub goback(loc: int16, oldloc: int16, oldloc2: int16, verb: int16) @extern("goback") is |
|||
var kk: uint8; |
|||
var k2: uint8; |
|||
var want: int16; |
|||
var temp: int16; |
|||
var strav: trav[MAXTRAV]; |
|||
|
|||
if forced(oldloc as uint16) == 1 then |
|||
want := oldloc2; |
|||
else |
|||
want := oldloc; |
|||
end if; |
|||
set_oldloc2(oldloc); |
|||
oldloc2 := oldloc; |
|||
set_oldloc(loc); |
|||
oldloc := loc; |
|||
k2 := 0; |
|||
if want == loc then |
|||
rspeak(91); |
|||
return; |
|||
end if; |
|||
copytrv(&travel[0], &strav[0]); |
|||
kk := 0; |
|||
while travel[kk].tdest != 0xFFFF loop |
|||
if travel[kk].tcond == 0 and travel[kk].tdest == want then |
|||
set_motion(travel[kk].tverb); |
|||
dotrav(loc, travel[kk].tverb, verb); |
|||
return; |
|||
end if; |
|||
if travel[kk].tcond == 0 then |
|||
k2 := kk; |
|||
temp := travel[kk].tdest; |
|||
gettrav(temp as uint8); |
|||
if forced(temp as uint16) == 1 and travel[0].tdest == want then |
|||
k2 := temp as uint8; |
|||
end if; |
|||
copytrv(&strav[0], &travel[0]); |
|||
end if; |
|||
kk := kk + 1; |
|||
end loop; |
|||
if k2 > 0 then |
|||
set_motion(travel[k2].tverb); |
|||
dotrav(loc, travel[k2].tverb, verb); |
|||
else |
|||
rspeak(140); |
|||
end if; |
|||
end sub; |
|||
|
|||
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
@ -0,0 +1,32 @@ |
|||
include "misc.coh"; |
|||
|
|||
var fp: int16; |
|||
|
|||
sub factorial(n: int16): (ret: int16) is |
|||
var tmp: int16; |
|||
|
|||
if n == 1 then |
|||
ret := 1; |
|||
else |
|||
# ret := n * factorial(n - 1); |
|||
@asm "ld hl,(", n, ")"; |
|||
@asm "push hl"; |
|||
n := n - 1; |
|||
@asm "ld hl,(", n, ")"; |
|||
@asm "ld ix,(", fp, ")"; |
|||
@asm "ld de, 1f"; |
|||
@asm "push de"; |
|||
@asm "jp (ix)"; |
|||
@asm "1:"; |
|||
@asm "ld (", tmp, "),hl"; #tmp = factorial(n-1) |
|||
@asm "pop hl"; |
|||
@asm "ld (", n, "),hl"; |
|||
ret := n * tmp; |
|||
end if; |
|||
end sub; |
|||
|
|||
#setup pointer to factorial |
|||
@asm "ld hl,", factorial; |
|||
@asm "ld (", fp, "),hl"; |
|||
|
|||
print_i16(factorial(5)); |
|||
Binary file not shown.
@ -1,2 +1,2 @@ |
|||
COWGOL HEXDUMP.COW |
|||
COWGOL -M HEXDUMP.COW |
|||
|
|||
@ -0,0 +1,17 @@ |
|||
sub Exit() is |
|||
@asm "rst 0"; |
|||
end sub; |
|||
|
|||
sub MemSet(buf: [uint8], ch: uint8, len: uint16) is |
|||
# A=ch, HL=buf |
|||
@asm "ld de,(", len, ")"; # DE=len |
|||
@asm "jp __MemSet"; |
|||
end sub; |
|||
|
|||
sub MemCopy(src: [uint8], len: uint16, dest: [uint8]) is |
|||
# HL=src |
|||
@asm "ld de,(", dest, ")"; # DE=dest |
|||
@asm "ld bc,(", len, ")"; # BC=len |
|||
@asm "jp __MemCopy"; |
|||
end sub; |
|||
|
|||
@ -0,0 +1,19 @@ |
|||
sub BiosSetup() is |
|||
@asm "jp __BiosSetup"; |
|||
end sub; |
|||
|
|||
sub ConOut(ch: uint8) is |
|||
@asm "jp __ConOut"; |
|||
end sub; |
|||
|
|||
sub ConIn(): (ret: uint8) is |
|||
@asm "jp __ConIn"; |
|||
end sub; |
|||
|
|||
sub ConSts(): (ret: uint8) is |
|||
@asm "jp __ConSts"; |
|||
end sub; |
|||
|
|||
sub putstr(str: [uint8]) is |
|||
@asm "jp __putstr"; |
|||
end sub; |
|||
@ -0,0 +1,35 @@ |
|||
sub get_char(): (ch: uint8) is |
|||
@asm "jp __get_char"; |
|||
end sub; |
|||
|
|||
sub get_str(buf: [uint8]) is |
|||
@asm "jp __get_str"; |
|||
end sub; |
|||
|
|||
sub print_char(ch: uint8) is |
|||
@asm "jp __print_char"; |
|||
end sub; |
|||
|
|||
sub print(buf: [uint8]) is |
|||
@asm "jp __print"; |
|||
end sub; |
|||
|
|||
sub print_nl() is |
|||
@asm "jp __print_nl"; |
|||
end sub; |
|||
|
|||
sub print_i8(n: int8) is |
|||
@asm "jp __print_i8"; |
|||
end sub; |
|||
|
|||
sub print_i16(n: int16) is |
|||
@asm "jp __print_i16"; |
|||
end sub; |
|||
|
|||
sub print_hex_i8(n: int8) is |
|||
@asm "jp __print_hex_i8"; |
|||
end sub; |
|||
|
|||
sub print_hex_i16(n: int16) is |
|||
@asm "jp __print_hex_i16"; |
|||
end sub; |
|||
@ -0,0 +1,41 @@ |
|||
sub positive(fp: int16): (ret: int16) is |
|||
@asm "jp __positive"; |
|||
end sub; |
|||
|
|||
sub neg(fp: int16): (ret: int16) is |
|||
@asm "jp __neg"; |
|||
end sub; |
|||
|
|||
sub fpmul(fp1: int16, fp2: int16): (ret: int16) is |
|||
# HL=fp1 |
|||
@asm "ld de,(", fp2, ")"; # DE=fp2 |
|||
@asm "jp __fpmul"; |
|||
end sub; |
|||
|
|||
sub fpdiv(fp1: int16, fp2: int16): (ret: int16) is |
|||
# HL=fp1 |
|||
@asm "ld de,(", fp2, ")"; # DE=fp2 |
|||
@asm "jp __fpdiv"; |
|||
end sub; |
|||
|
|||
sub fpsqrt(fp: int16): (ret: int16) is |
|||
@asm "jp __fpsqrt"; |
|||
end sub; |
|||
|
|||
sub fpsin(fp: int16): (ret: int16) is |
|||
@asm "jp __fpsin"; |
|||
end sub; |
|||
|
|||
sub fpcos(fp: int16): (ret: int16) is |
|||
@asm "jp __fpcos"; |
|||
end sub; |
|||
|
|||
sub fparctan(fp: int16): (ret: int16) is |
|||
@asm "jp __fparctan"; |
|||
end sub; |
|||
|
|||
sub xdivytofp(x: int16, y: int16): (ret: int16) is |
|||
# HL=x |
|||
@asm "ld bc,(", y, ")"; # BC=y |
|||
@asm "jp __xdivytofp"; |
|||
end sub; |
|||
Binary file not shown.
@ -0,0 +1,35 @@ |
|||
sub IsDigit(ch: uint8): (ret: uint8) is |
|||
# A=ch |
|||
@asm "jp __IsDigit"; |
|||
end sub; |
|||
|
|||
sub ToLower(c: uint8): (cc: uint8) is |
|||
# A=ch |
|||
@asm "jp __ToLower"; |
|||
end sub; |
|||
|
|||
sub CopyString(src: [uint8], dest: [uint8]) is |
|||
# HL=src |
|||
@asm "ld de,(", dest, ")"; # DE=dest |
|||
@asm "jp __CopyString"; |
|||
end sub; |
|||
|
|||
sub StrCmp(s1: [uint8], s2: [uint8]): (res: int8) is |
|||
# HL=s1 |
|||
@asm "ld de,(", s2, ")"; # DE=s2 |
|||
@asm "jp __StrCmp"; |
|||
end sub; |
|||
|
|||
sub StrICmp(s1: [uint8], s2: [uint8]): (res: int8) is |
|||
# HL=s1 |
|||
@asm "ld de,(", s2, ")"; # DE=s2 |
|||
@asm "jp __StrICmp"; |
|||
end sub; |
|||
|
|||
sub StrLen(s: [uint8]): (size: uint16) is |
|||
# HL = s |
|||
@asm "jp __StrLen"; |
|||
end sub; |
|||
|
|||
|
|||
|
|||
@ -0,0 +1,36 @@ |
|||
@decl sub exit() @extern("exit"); |
|||
|
|||
@decl sub get_char(): (c: uint8) @extern("get_char"); |
|||
@decl sub get_line(p: [uint8]) @extern("get_line"); |
|||
@decl sub print_char(c: uint8) @extern("print_char"); |
|||
@decl sub print(ptr: [uint8]) @extern("print"); |
|||
@decl sub print_nl() @extern("print_nl"); |
|||
|
|||
@decl sub print_hex_i8(char: uint8) @extern("print_hex_i8"); |
|||
@decl sub print_hex_i16(word: uint16) @extern("print_hex_i16"); |
|||
@decl sub print_hex_i32(dword: uint32) @extern("print_hex_i32"); |
|||
|
|||
@decl sub print_i8(v: int8) @extern("print_i8"); |
|||
@decl sub print_i16(v: int16) @extern("print_i16"); |
|||
|
|||
@decl sub isdigit(ch: uint8): (ret: uint8) @extern("isdigit"); |
|||
|
|||
@decl sub itoa(i: int16): (pbuf: [uint8]) @extern("itoa"); |
|||
@decl sub uitoa(i: uint16): (pbuf: [uint8]) @extern("uitoa"); |
|||
@decl sub ltoa(i: int32): (pbuf: [uint8]) @extern("ltoa"); |
|||
@decl sub atoi(p: [uint8]): (ret: int16) @extern("atoi"); |
|||
@decl sub atol(p: [uint8]): (ret: int32) @extern("atol"); |
|||
|
|||
@decl sub atofixed(p: [uint8]): (ret: uint16) @extern("atofixed"); |
|||
|
|||
# fdigits: number of digits in fractional part |
|||
@decl sub fixedtoa(f: uint16, fdigits: uint8): (ret: [uint8]) @extern("fixedtoa"); |
|||
|
|||
@decl sub memcpy(dest: [uint8], src: [uint8], size: uint16): (ret: [uint8]) @extern("memcpy"); |
|||
@decl sub memset(dest: [uint8], char: uint8, size: uint16): (ret: [uint8]) @extern("memset"); |
|||
|
|||
@decl sub xrnd() :(ret: uint16) @extern("xrnd"); |
|||
@decl sub xrndseed() @extern("xrndseed"); |
|||
|
|||
@decl sub ArgvInit() @extern("ArgvInit"); |
|||
@decl sub ArgvNext(): (arg: [uint8]) extern("ArgvNext"); |
|||
Binary file not shown.
@ -0,0 +1,646 @@ |
|||
sub exit() @extern("exit") is |
|||
@asm "rst 0"; |
|||
end sub; |
|||
|
|||
sub get_char(): (c: uint8) @extern("get_char") is |
|||
@asm "ld c, 1"; |
|||
@asm "call 5"; |
|||
@asm "ld (", c, "), a"; |
|||
end sub; |
|||
|
|||
sub print_char(c: uint8) @extern("print_char") is |
|||
if c == 10 then |
|||
@asm "ld e, 13"; |
|||
@asm "ld c, 2"; |
|||
@asm "call 5"; |
|||
end if; |
|||
@asm "ld a, (", c, ")"; |
|||
@asm "ld e, a"; |
|||
@asm "ld c, 2"; |
|||
@asm "call 5"; |
|||
end sub; |
|||
|
|||
sub print(ptr: [uint8]) @extern("print") is |
|||
var ch: uint8; |
|||
@asm "ld hl,(", ptr, ")"; |
|||
@asm "1:"; |
|||
@asm "ld a,(hl)"; |
|||
@asm "or a"; |
|||
@asm "ret z"; |
|||
@asm "ld (", ch, "), a"; |
|||
@asm "push hl"; |
|||
print_char(ch); |
|||
@asm "pop hl"; |
|||
@asm "inc hl"; |
|||
@asm "jr 1b"; |
|||
end sub; |
|||
|
|||
sub print_nl() @extern("print_nl") is |
|||
print_char('\n'); |
|||
end sub; |
|||
|
|||
sub print_hex_i8(char: uint8) @extern("print_hex_i8") is |
|||
var ra: uint8; |
|||
@asm "call Bin2Hex"; |
|||
@asm "push bc"; |
|||
@asm "ld (", ra, "),a"; |
|||
print_char(ra); |
|||
@asm "pop bc"; |
|||
@asm "ld a,c"; |
|||
@asm "ld (", ra, "),a"; |
|||
print_char(ra); |
|||
@asm "ret"; |
|||
@asm "Bin2Hex:"; |
|||
@asm "ld c,a"; |
|||
@asm "and 0FH"; |
|||
@asm "call nibble2hex"; |
|||
@asm "ld a,c"; |
|||
@asm "ld c,b"; |
|||
@asm "and 0F0H"; |
|||
@asm "rrca"; |
|||
@asm "rrca"; |
|||
@asm "rrca"; |
|||
@asm "rrca"; |
|||
@asm "nibble2hex:"; |
|||
@asm "add a,090h"; |
|||
@asm "daa"; |
|||
@asm "adc a,040h"; |
|||
@asm "daa"; |
|||
@asm "ld b,a"; |
|||
@asm "ret"; |
|||
end sub; |
|||
|
|||
sub print_hex_i16(word: uint16) @extern("print_hex_i16") is |
|||
var ra: uint8; |
|||
@asm "ld a,(", word, "+1)"; |
|||
@asm "ld (", ra, "),a"; |
|||
print_hex_i8(ra); |
|||
@asm "ld a,(", word, ")"; |
|||
@asm "ld (", ra, "),a"; |
|||
print_hex_i8(ra); |
|||
end sub; |
|||
|
|||
sub print_hex_i32(dword: uint32) @extern("print_hex_i32") is |
|||
var v16: uint16; |
|||
@asm "ld hl,(", dword, "+2)"; |
|||
@asm "ld (", v16, "),hl"; |
|||
print_hex_i16(v16); |
|||
@asm "ld hl,(", dword, ")"; |
|||
@asm "ld (", v16, "),hl"; |
|||
print_hex_i16(v16); |
|||
end sub; |
|||
|
|||
sub Bn2Dec() is |
|||
@asm "ld (bufptr),hl"; |
|||
@asm "ld (buffer),hl"; |
|||
@asm "ex de,hl"; |
|||
@asm "xor a"; |
|||
@asm "ld (curlen),a"; |
|||
@asm "cnvert:"; |
|||
@asm "ld e,0"; |
|||
@asm "ld b,16"; |
|||
@asm "or a"; |
|||
@asm "dvloop:"; |
|||
@asm "rl l"; |
|||
@asm "rl h"; |
|||
@asm "rl e"; |
|||
@asm "ld a,e"; |
|||
@asm "sub 10"; |
|||
@asm "ccf"; |
|||
@asm "jr nc,deccnt"; |
|||
@asm "ld e,a"; |
|||
@asm "deccnt:"; |
|||
@asm "djnz dvloop"; |
|||
@asm "rl l"; |
|||
@asm "rl h"; |
|||
@asm "chins:"; |
|||
@asm "ld a,e"; |
|||
@asm "add a,30h"; |
|||
@asm "call insert"; |
|||
@asm "ld a,h"; |
|||
@asm "or l"; |
|||
@asm "jr nz,cnvert"; |
|||
@asm "ld hl,(buffer)"; |
|||
@asm "ld c,(hl)"; |
|||
@asm "ld b,0"; |
|||
@asm "ld d,h"; |
|||
@asm "ld e,l"; |
|||
@asm "inc hl"; |
|||
@asm "ldir"; |
|||
@asm "xor a"; |
|||
@asm "ld (de),a"; |
|||
@asm "ret"; |
|||
@asm "insert:"; |
|||
@asm "push hl"; |
|||
@asm "push af"; |
|||
@asm "ld hl,(bufptr)"; |
|||
@asm "ld d,h"; |
|||
@asm "ld e,l"; |
|||
@asm "inc de"; |
|||
@asm "ld (bufptr),de"; |
|||
@asm "ld a,(curlen)"; |
|||
@asm "or a"; |
|||
@asm "jr z,exitmr"; |
|||
@asm "ld c,a"; |
|||
@asm "ld b,0"; |
|||
@asm "lddr"; |
|||
@asm "exitmr:"; |
|||
@asm "ld a,(curlen)"; |
|||
@asm "inc a"; |
|||
@asm "ld (curlen),a"; |
|||
@asm "ld (hl),a"; |
|||
@asm "ex de,hl"; |
|||
@asm "pop af"; |
|||
@asm "ld (hl),a"; |
|||
@asm "pop hl"; |
|||
@asm "ret"; |
|||
@asm "buffer: defs 2"; |
|||
@asm "bufptr: defs 2"; |
|||
@asm "curlen: defs 1"; |
|||
end sub; |
|||
|
|||
var buf12:uint8[12]; |
|||
|
|||
sub print_i8(v: int8) @extern("print_i8") is |
|||
@asm "ld hl,", buf12 ; |
|||
@asm "ld a,(", v, ")"; |
|||
@asm "or a"; |
|||
@asm "jp p,1f"; |
|||
@asm "ld (hl),'-'"; |
|||
@asm "inc hl"; |
|||
@asm "neg"; |
|||
@asm "1:"; |
|||
@asm "ld e,a"; |
|||
@asm "ld d,0"; |
|||
Bn2Dec(); |
|||
print(&buf12[0]); |
|||
@asm "ret"; |
|||
end sub; |
|||
|
|||
sub print_i16(v: int16) @extern("print_i16") is |
|||
@asm "ld hl,", buf12 ; |
|||
@asm "ld de,(", v, ")"; |
|||
@asm "bit 7,d"; |
|||
@asm "jr z,1f"; |
|||
@asm "xor a"; |
|||
@asm "ld hl,0"; |
|||
@asm "sbc hl,de"; |
|||
@asm "ex de,hl"; |
|||
@asm "ld hl,", buf12 ; |
|||
@asm "ld (hl),'-'"; |
|||
@asm "inc hl"; |
|||
@asm "1:"; |
|||
Bn2Dec(); |
|||
print(&buf12[0]); |
|||
@asm "ret"; |
|||
end sub; |
|||
|
|||
sub get_line(p: [uint8]) @extern("get_line") is |
|||
var ch: uint8; |
|||
|
|||
loop |
|||
ch := get_char(); |
|||
if ch == '\r' then |
|||
print_nl(); |
|||
[p] := 0; |
|||
return; |
|||
end if; |
|||
[p] := ch; |
|||
p := p + 1; |
|||
end loop; |
|||
end sub; |
|||
|
|||
sub itoa(i: int16): (pbuf: [uint8]) @extern("itoa") is |
|||
var sign: uint8; |
|||
|
|||
pbuf := &buf12[8]; # points to terminating zero |
|||
[pbuf] := 0; |
|||
|
|||
if (i >= 0) then |
|||
sign := 0; |
|||
else |
|||
i := -i; sign := 1; |
|||
end if; |
|||
|
|||
loop |
|||
pbuf := pbuf - 1; |
|||
[pbuf] := '0' + ((i % 10) as uint8); |
|||
i := i / 10; |
|||
if i == 0 then break; end if; |
|||
end loop; |
|||
|
|||
if (sign == 1) then |
|||
pbuf := pbuf - 1; [pbuf] := '-'; |
|||
end if; |
|||
end sub; |
|||
|
|||
sub uitoa(i: uint16): (pbuf: [uint8]) @extern("uitoa") is |
|||
pbuf := &buf12[8]; # points to terminating zero |
|||
[pbuf] := 0; |
|||
|
|||
loop |
|||
pbuf := pbuf - 1; |
|||
[pbuf] := '0' + ((i % 10) as uint8); |
|||
i := i / 10; |
|||
if i == 0 then break; end if; |
|||
end loop; |
|||
end sub; |
|||
|
|||
sub ltoa(i: int32): (pbuf: [uint8]) @extern("ltoa") is |
|||
var sign: uint8 := 0; |
|||
|
|||
if i < 0 then |
|||
sign := 1; |
|||
end if; |
|||
|
|||
pbuf := &buf12[11]; # points to terminating zero |
|||
[pbuf] := 0; |
|||
|
|||
loop |
|||
pbuf := pbuf - 1; |
|||
[pbuf] := '0' + ((i % 10) as uint8); |
|||
i := i / 10; |
|||
if i == 0 then break; end if; |
|||
end loop; |
|||
|
|||
if sign == 1 then |
|||
pbuf := pbuf - 1; |
|||
[pbuf] := '-'; |
|||
end if; |
|||
end sub; |
|||
|
|||
sub isdigit(ch: uint8): (ret: uint8) @extern("isdigit") is |
|||
@asm "ld a,(", ch, ")"; |
|||
@asm "cp 30h"; |
|||
@asm "jr c,1f"; |
|||
@asm "cp 3Ah"; |
|||
@asm "jr nc,1f"; |
|||
@asm "ld a,1"; |
|||
@asm "ret"; |
|||
@asm "1:"; |
|||
@asm "xor a"; |
|||
@asm "ret"; |
|||
end sub; |
|||
|
|||
sub atoi(p: [uint8]): (ret: int16) @extern("atoi") is |
|||
var sign: uint8 := 0; |
|||
ret := 0; |
|||
|
|||
if [p] == '-' then |
|||
sign := 1; |
|||
p := p + 1; |
|||
elseif [p] == '+' then |
|||
p := p + 1; |
|||
end if; |
|||
|
|||
while [p] != 0 loop |
|||
if isdigit([p]) == 1 then |
|||
ret := ret * 10 + (([p] - '0') as int16); |
|||
p := p + 1; |
|||
else |
|||
break; |
|||
end if; |
|||
end loop; |
|||
|
|||
if sign == 1 then |
|||
ret := -ret; |
|||
end if; |
|||
end sub; |
|||
|
|||
sub atol(p: [uint8]): (ret: int32) @extern("atol") is |
|||
var sign: uint8 := 0; |
|||
|
|||
ret := 0; |
|||
if [p] == '-' then |
|||
sign := 1; |
|||
p := p + 1; |
|||
end if; |
|||
while [p] != 0 loop |
|||
if isdigit([p]) == 1 then |
|||
ret := ret * 10 + (([p] - '0') as int32); p := p + 1; |
|||
else |
|||
ret := -1; return; |
|||
end if; |
|||
end loop; |
|||
if sign == 1 then |
|||
ret := -ret; |
|||
end if; |
|||
end sub; |
|||
|
|||
# accepts [+|-]iii[.ddd] min -127.999 max 127.999 |
|||
sub atofixed(p: [uint8]): (ret: uint16) @extern("atofixed") is |
|||
var intp: int16 := 0; |
|||
var dec: uint16 := 0; |
|||
var sign: uint8 := 0; |
|||
var i: uint8; |
|||
|
|||
sub check_int(): (isok: uint8) is |
|||
isok := 1; |
|||
if intp > 127 then |
|||
ret := 0; |
|||
isok := 0; |
|||
end if; |
|||
end sub; |
|||
|
|||
sub set_sign() is |
|||
if sign == 1 then |
|||
intp := -intp; |
|||
end if; |
|||
end sub; |
|||
|
|||
sub get_dec(): (isok: uint8) is |
|||
var s16: uint16 := 0; |
|||
var f: uint16 := 1000; |
|||
|
|||
i := 0; |
|||
while i<3 loop |
|||
if isdigit([p]) == 1 then |
|||
s16 := s16 + ([p] - '0') as uint16 * f; |
|||
f := f / 10; |
|||
p := p + 1; |
|||
elseif [p] == 0 then |
|||
if s16 == 0 then isok := 1; return; end if; |
|||
break; |
|||
else |
|||
isok := 0; |
|||
return; |
|||
end if; |
|||
i := i + 1; |
|||
end loop; |
|||
|
|||
if s16 >= 5000 then |
|||
dec := dec | 0b10000000; |
|||
s16 := s16 - 5000; |
|||
end if; |
|||
|
|||
if s16 >= 2500 then |
|||
dec := dec | 0b01000000; |
|||
s16 := s16 - 2500; |
|||
end if; |
|||
|
|||
if s16 >= 1250 then |
|||
dec := dec | 0b00100000; |
|||
s16 := s16 - 1250; |
|||
end if; |
|||
|
|||
if s16 >= 0625 then |
|||
dec := dec | 0b00010000; |
|||
s16 := s16 - 0625; |
|||
end if; |
|||
|
|||
if s16 >= 0312 then |
|||
dec := dec | 0b00001000; |
|||
s16 := s16 - 0312; |
|||
end if; |
|||
|
|||
if s16 >= 0156 then |
|||
dec := dec | 0b00000100; |
|||
s16 := s16 - 0156; |
|||
end if; |
|||
|
|||
if s16 >= 0078 then |
|||
dec := dec | 0b00000010; |
|||
s16 := s16 - 0078; |
|||
end if; |
|||
|
|||
if s16 >= 0039 then |
|||
dec := dec | 0b00000001; |
|||
end if; |
|||
|
|||
isok := 1; |
|||
end sub; |
|||
|
|||
if [p] == '+' then |
|||
p := p + 1; |
|||
elseif [p] == '-' then |
|||
sign := 1; |
|||
p := p + 1; |
|||
end if; |
|||
|
|||
i := 0; |
|||
while i < 3 loop |
|||
if isdigit([p]) == 1 then |
|||
intp := intp * 10; |
|||
intp := intp + ([p] - '0') as int16; |
|||
p := p + 1; |
|||
elseif [p] == '.' then |
|||
p := p + 1; |
|||
if check_int() == 0 then return; end if; |
|||
set_sign(); |
|||
if get_dec() == 0 then return; end if; |
|||
ret := (intp << 8) as uint16 | dec; |
|||
return; |
|||
elseif [p] == 0 then |
|||
if check_int() == 0 then return; end if; |
|||
set_sign(); |
|||
ret := (intp << 8) as uint16; |
|||
return; |
|||
else |
|||
ret := 0; |
|||
return; |
|||
end if; |
|||
i := i + 1; |
|||
end loop; |
|||
|
|||
if check_int() == 0 then return; end if; |
|||
|
|||
if [p] == '.' then |
|||
p := p + 1; |
|||
set_sign(); |
|||
if get_dec() == 0 then return; end if; |
|||
ret := (intp << 8) as uint16 | dec; |
|||
elseif [p] == 0 then |
|||
set_sign(); |
|||
ret := (intp << 8) as uint16; |
|||
else |
|||
ret := 0; |
|||
end if; |
|||
end sub; |
|||
|
|||
sub fixedtoa(f: uint16, fdigits: uint8): (ret: [uint8]) @extern("fixedtoa") is |
|||
var intp: int8; |
|||
var sign: uint8 := 0; |
|||
var dec: uint8; |
|||
var vdec: uint32 := 0; |
|||
var pbuf: [uint8] := &buf12[4]; # position of . |
|||
var i: uint8; |
|||
|
|||
if fdigits > 3 then fdigits := 3; end if; |
|||
|
|||
intp := (f >> 8) as int8; |
|||
dec := f as uint8; |
|||
|
|||
if intp < 0 then |
|||
intp := - intp; |
|||
sign := 1; |
|||
end if; |
|||
|
|||
#first the integer part, without leading zeros |
|||
loop |
|||
pbuf := pbuf - 1; |
|||
[pbuf] := '0' + ((intp % 10) as uint8); |
|||
intp := intp / 10; |
|||
if intp == 0 then break; end if; |
|||
end loop; |
|||
|
|||
if (sign == 1) then |
|||
pbuf := pbuf - 1; [pbuf] := '-'; |
|||
end if; |
|||
|
|||
ret := pbuf; #to be returned... |
|||
|
|||
#fractional part requested...? |
|||
|
|||
if fdigits == 0 then |
|||
buf12[4] := 0; #...no, keep only the integer part |
|||
return; |
|||
end if; |
|||
|
|||
#...yes, build fractional part |
|||
|
|||
pbuf := &buf12[4]; |
|||
[pbuf] := '.'; |
|||
|
|||
if dec & 0b00000001 != 0 then vdec := vdec + 00390625; end if; |
|||
if dec & 0b00000010 != 0 then vdec := vdec + 00781250; end if; |
|||
if dec & 0b00000100 != 0 then vdec := vdec + 01562500; end if; |
|||
if dec & 0b00001000 != 0 then vdec := vdec + 03125000; end if; |
|||
if dec & 0b00010000 != 0 then vdec := vdec + 06250000; end if; |
|||
if dec & 0b00100000 != 0 then vdec := vdec + 12500000; end if; |
|||
if dec & 0b01000000 != 0 then vdec := vdec + 25000000; end if; |
|||
if dec & 0b10000000 != 0 then vdec := vdec + 50000000; end if; |
|||
|
|||
vdec := vdec / 100000; #keep only the 3 top digits |
|||
|
|||
pbuf := &buf12[8]; |
|||
i := 0; |
|||
while i < 3 loop |
|||
pbuf := pbuf - 1; |
|||
[pbuf] := '0' + ((vdec % 10) as uint8); |
|||
vdec := vdec / 10; |
|||
i := i + 1; |
|||
end loop; |
|||
|
|||
# keep only 'fdigits' digits |
|||
|
|||
buf12[4+fdigits+1] := 0; |
|||
end sub; |
|||
|
|||
sub memcpy(dest: [uint8], src: [uint8], size: uint16): (ret: [uint8]) @extern("memcpy") is |
|||
@asm "ld hl,(", src, ")"; |
|||
@asm "ld de,(", dest, ")"; |
|||
@asm "ld bc,(", size, ")"; |
|||
@asm "push de"; |
|||
@asm "ld a,b"; |
|||
@asm "or c"; |
|||
@asm "jr z,1f"; |
|||
@asm "ldir"; |
|||
@asm "1:"; |
|||
@asm "pop hl"; |
|||
@asm "ret"; |
|||
end sub; |
|||
|
|||
sub memset(dest: [uint8], char: uint8, size: uint16): (ret: [uint8]) @extern("memset") is |
|||
@asm "ld hl,(", dest, ")"; |
|||
@asm "ld bc,(", size, ")"; |
|||
@asm "ld a,(", char, ")"; |
|||
@asm "ld e,a"; |
|||
@asm "push hl"; |
|||
@asm "2:"; |
|||
@asm "ld a,b"; |
|||
@asm "or c"; |
|||
@asm "jr z,1f"; |
|||
@asm "ld (hl),e"; |
|||
@asm "inc hl"; |
|||
@asm "dec bc"; |
|||
@asm "jr 2b"; |
|||
@asm "1:"; |
|||
@asm "pop hl"; |
|||
@asm "ret"; |
|||
end sub; |
|||
|
|||
var random: uint16; |
|||
|
|||
sub xrnd(): (ret: uint16) @extern("xrnd") is |
|||
@asm " ld hl,(", random, ")"; |
|||
@asm " ld a,h "; |
|||
@asm " rra "; |
|||
@asm " ld a,l "; |
|||
@asm " rra "; |
|||
@asm " xor h "; |
|||
@asm " ld h,a "; |
|||
@asm " ld a,l "; |
|||
@asm " rra "; |
|||
@asm " ld a,h "; |
|||
@asm " rra "; |
|||
@asm " xor l "; |
|||
@asm " ld l,a "; |
|||
@asm " xor h "; |
|||
@asm " ld h,a "; |
|||
@asm " ld (", random, "),hl "; |
|||
@asm " res 7,h "; |
|||
@asm " ld (", ret, "),hl"; |
|||
@asm " ret "; |
|||
end sub; |
|||
|
|||
sub xrndseed() @extern("xrndseed") is |
|||
@asm " ld a,r "; |
|||
@asm " ld l,a "; |
|||
@asm " ld a,r "; |
|||
@asm " ld h,a "; |
|||
@asm " or l "; |
|||
@asm " jr nz,1f "; |
|||
@asm " inc hl "; |
|||
@asm " 1: "; |
|||
@asm " ld (", random, "),hl "; |
|||
@asm " ret "; |
|||
end sub; |
|||
|
|||
var argv_pointer: [uint8]; |
|||
|
|||
sub ArgvInit() @extern("ArgvInit") is |
|||
argv_pointer := 0x81 as [uint8]; |
|||
[argv_pointer + [0x80 as [uint8]] as intptr] := 0; |
|||
end sub; |
|||
|
|||
# Returns null is there's no next argument. |
|||
sub ArgvNext(): (arg: [uint8]) extern("ArgvNext") is |
|||
# No more arguments? |
|||
|
|||
if argv_pointer == (0 as [uint8]) then |
|||
arg := argv_pointer; |
|||
return; |
|||
end if; |
|||
|
|||
# Skip leading whitespace. |
|||
|
|||
var c: uint8; |
|||
loop |
|||
c := [argv_pointer]; |
|||
if c != ' ' then |
|||
break; |
|||
end if; |
|||
argv_pointer := argv_pointer + 1; |
|||
end loop; |
|||
|
|||
arg := argv_pointer; |
|||
|
|||
# Skip to end of word and terminate. |
|||
|
|||
loop |
|||
c := [argv_pointer]; |
|||
if (c == ' ') or (c == '\n') or (c == 0) then |
|||
break; |
|||
end if; |
|||
argv_pointer := argv_pointer + 1; |
|||
end loop; |
|||
[argv_pointer] := 0; |
|||
|
|||
if c == ' ' then |
|||
argv_pointer := argv_pointer + 1; |
|||
else |
|||
argv_pointer := 0 as [uint8]; |
|||
end if; |
|||
end sub; |
|||
|
|||
|
|||
Binary file not shown.
@ -0,0 +1,10 @@ |
|||
@decl sub FCBOpenIn(fcb: [FCB], filename: [uint8]): (errno: uint8) @extern("FCBOpenIn"); |
|||
@decl sub FCBOpenUp(fcb: [FCB], filename: [uint8]): (errno: uint8) @extern("FCBOpenUp"); |
|||
@decl sub FCBOpenOut(fcb: [FCB], filename: [uint8]): (errno: uint8) @extern("FCBOpenOut"); |
|||
@decl sub FCBClose(fcb: [FCB]): (errno: uint8) @extern("FCBClose"); |
|||
@decl sub FCBSeek(fcb: [FCB], pos: uint32) @extern("FCBSeek"); |
|||
@decl sub FCBPos(fcb: [FCB]): (pos: uint32) @extern("FCBPos"); |
|||
@decl sub FCBExt(fcb: [FCB]): (len: uint32) @extern("FCBExt"); |
|||
@decl sub FCBGetChar(fcb: [FCB]): (c: uint8) @extern("FCBGetChar"); |
|||
@decl sub FCBPutChar(fcb: [FCB], c: uint8) @extern("FCBPutChar"); |
|||
|
|||
Binary file not shown.
@ -0,0 +1,214 @@ |
|||
sub memset(dest: [uint8], char: uint8, size: uint16) is |
|||
@asm "ld hl,(", dest, ")"; |
|||
@asm "ld bc,(", size, ")"; |
|||
@asm "ld a,(", char, ")"; |
|||
@asm "ld e,a"; |
|||
@asm "2:"; |
|||
@asm "ld a,b"; |
|||
@asm "or c"; |
|||
@asm "ret z"; |
|||
@asm "ld (hl),e"; |
|||
@asm "inc hl"; |
|||
@asm "dec bc"; |
|||
@asm "jr 2b"; |
|||
end sub; |
|||
|
|||
# file I/O support --------------------------------------------------------- |
|||
|
|||
record CpmFCB is |
|||
dr: uint8; |
|||
f: uint8[11]; |
|||
ex: uint8; |
|||
s1: uint8; |
|||
s2: uint8; |
|||
rc: uint8; |
|||
d: uint8[16]; |
|||
cr: uint8; |
|||
r: uint16; |
|||
r2: uint8; |
|||
end record; |
|||
|
|||
record FCB is |
|||
bufferptr: uint8; # byte just read |
|||
dirty: uint8; |
|||
cpm: CpmFCB; |
|||
buffer: uint8[128]; |
|||
end record; |
|||
|
|||
sub file_i_init(fcb: [FCB], filename: [uint8]) is |
|||
sub fill(dest: [uint8], src: [uint8], len: uint8): (srcout: [uint8]) is |
|||
loop |
|||
var c := [src]; |
|||
if (c < 32) or (c == '.') then |
|||
c := ' '; |
|||
elseif (c == '*') then |
|||
c := '?'; |
|||
else |
|||
src := src + 1; |
|||
end if; |
|||
if (c >= 'a') and (c <= 'z') then |
|||
c := c - ('a' - 'A'); |
|||
end if; |
|||
[dest] := c; |
|||
dest := dest + 1; |
|||
|
|||
len := len - 1; |
|||
if len == 0 then |
|||
break; |
|||
end if; |
|||
end loop; |
|||
srcout := src; |
|||
end sub; |
|||
|
|||
memset(fcb as [uint8], 0, @bytesof FCB); |
|||
memset(&fcb.cpm.f[0] as [uint8], ' ', 11); |
|||
filename := fill(&fcb.cpm.f[0], filename, 8); |
|||
|
|||
var c: uint8; |
|||
loop |
|||
c := [filename]; |
|||
if (c < 32) or (c == '.') then |
|||
break; |
|||
end if; |
|||
filename := filename + 1; |
|||
end loop; |
|||
|
|||
if c == '.' then |
|||
filename := fill(&fcb.cpm.f[8], filename+1, 3); |
|||
end if; |
|||
|
|||
fcb.cpm.r := 0xffff; |
|||
fcb.bufferptr := 127; |
|||
end sub; |
|||
|
|||
sub fcb_i_gbpb(fcb: [FCB], c: uint8) is |
|||
var cpmfcb := &fcb.cpm; |
|||
var dma := &fcb.buffer[0]; |
|||
|
|||
@asm "ld c, 26"; # SET DMA |
|||
@asm "ld de, (", dma, ")"; |
|||
@asm "call 5"; |
|||
|
|||
@asm "ld a, (", c, ")"; |
|||
@asm "ld c, a"; |
|||
@asm "ld de, (", cpmfcb, ")"; |
|||
@asm "call 5"; |
|||
end sub; |
|||
|
|||
sub fcb_i_blockin(fcb: [FCB]) is |
|||
memset(&fcb.buffer[0], 0, 128); |
|||
fcb_i_gbpb(fcb, 33); # READ RANDOM |
|||
fcb.dirty := 0; |
|||
end sub; |
|||
|
|||
sub fcb_i_blockout(fcb: [FCB]) is |
|||
if fcb.dirty != 0 then |
|||
fcb_i_gbpb(fcb, 34); # WRITE RANDOM |
|||
fcb.dirty := 0; |
|||
end if; |
|||
end sub; |
|||
|
|||
sub fcb_i_changeblock(fcb: [FCB], newblock: uint16) is |
|||
if newblock != fcb.cpm.r then |
|||
fcb_i_blockout(fcb); |
|||
fcb.cpm.r := newblock; |
|||
fcb_i_blockin(fcb); |
|||
end if; |
|||
end sub; |
|||
|
|||
sub fcb_a_to_error() is |
|||
@asm "cp 0xff"; |
|||
@asm "ld a, 0"; |
|||
@asm "ret nz"; |
|||
@asm "inc a"; |
|||
end sub; |
|||
|
|||
sub FCBOpenIn(fcb: [FCB], filename: [uint8]): (errno: uint8) @extern("FCBOpenIn") is |
|||
file_i_init(fcb, filename); |
|||
|
|||
var cpmfcb := &fcb.cpm; |
|||
@asm "ld c, 15"; # OPEN_FILE |
|||
@asm "ld de, (", cpmfcb, ")"; |
|||
@asm "call 5"; |
|||
@asm "call", fcb_a_to_error; |
|||
@asm "ld (", errno, "), a"; |
|||
end sub; |
|||
|
|||
sub FCBOpenUp(fcb: [FCB], filename: [uint8]): (errno: uint8) @extern("FCBOpenUp") is |
|||
(errno) := FCBOpenIn(fcb, filename); |
|||
end sub; |
|||
|
|||
sub FCBOpenOut(fcb: [FCB], filename: [uint8]): (errno: uint8) @extern("FCBOpenOut") is |
|||
file_i_init(fcb, filename); |
|||
|
|||
var cpmfcb := &fcb.cpm; |
|||
@asm "ld c, 19"; # DELETE_FILE |
|||
@asm "ld de, (", cpmfcb, ")"; |
|||
@asm "call 5"; |
|||
|
|||
@asm "ld c, 22"; # CREATE_FILE |
|||
@asm "ld de, (", cpmfcb, ")"; |
|||
@asm "call 5"; |
|||
@asm "call", fcb_a_to_error; |
|||
@asm "ld (", errno, "), a"; |
|||
end sub; |
|||
|
|||
sub FCBClose(fcb: [FCB]): (errno: uint8) @extern("FCBClose") is |
|||
fcb_i_blockout(fcb); |
|||
|
|||
var cpmfcb := &fcb.cpm; |
|||
@asm "ld c, 16"; # CLOSE_FILE |
|||
@asm "ld de, (", cpmfcb, ")"; |
|||
@asm "call 5"; |
|||
@asm "call", fcb_a_to_error; |
|||
@asm "ld (", errno, "), a"; |
|||
end sub; |
|||
|
|||
sub FCBSeek(fcb: [FCB], pos: uint32) @extern("FCBSeek") is |
|||
pos := pos - 1; # seek to *previous* character |
|||
var newblock := (pos >> 7) as uint16; |
|||
var newptr := (pos as uint8) & 127; |
|||
fcb_i_changeblock(fcb, newblock); |
|||
fcb.bufferptr := newptr; |
|||
end sub; |
|||
|
|||
sub FCBPos(fcb: [FCB]): (pos: uint32) @extern("FCBPos") is |
|||
pos := (((fcb.cpm.r as uint32) << 7) | (fcb.bufferptr as uint32)) + 1; |
|||
end sub; |
|||
|
|||
sub FCBExt(fcb: [FCB]): (len: uint32) @extern("FCBExt") is |
|||
var oldblock := fcb.cpm.r; |
|||
var cpmfcb := &fcb.cpm; |
|||
|
|||
@asm "ld c, 16"; # CLOSE_FILE (actually flushing it to disk) |
|||
@asm "ld de, (", cpmfcb, ")"; |
|||
@asm "call 5"; |
|||
|
|||
@asm "ld c, 35"; # COMPUTE FILE SIZE |
|||
@asm "ld de, (", cpmfcb, ")"; |
|||
@asm "call 5"; |
|||
|
|||
len := ([&fcb.cpm.r as [uint32]] & 0x00ffffff) << 7; |
|||
fcb.cpm.r := oldblock; |
|||
end sub; |
|||
|
|||
sub fcb_i_nextchar(fcb: [FCB]) is |
|||
fcb.bufferptr := fcb.bufferptr + 1; |
|||
if fcb.bufferptr == 128 then |
|||
fcb_i_changeblock(fcb, fcb.cpm.r + 1); |
|||
fcb.bufferptr := 0; |
|||
end if; |
|||
end sub; |
|||
|
|||
sub FCBGetChar(fcb: [FCB]): (c: uint8) @extern("FCBGetChar") is |
|||
fcb_i_nextchar(fcb); |
|||
c := fcb.buffer[fcb.bufferptr]; |
|||
end sub; |
|||
|
|||
sub FCBPutChar(fcb: [FCB], c: uint8) @extern("FCBPutChar") is |
|||
fcb_i_nextchar(fcb); |
|||
fcb.buffer[fcb.bufferptr] := c; |
|||
fcb.dirty := 1; |
|||
end sub; |
|||
|
|||
# --------------------------------------------------------- |
|||
@ -0,0 +1,63 @@ |
|||
# CP/M Z80 sequential files |
|||
# |
|||
# supports two kind of files: text files (0x1A is EOF) & binary files (0 is EOF) |
|||
# |
|||
# FCBOpenIn : opens specified existing file for read (type: IO_TEXT or IO_BIN) |
|||
# FCBOpenOut : opens new, empty specified file for write (creates file) (type: IO_TEXT or IO_BIN) |
|||
# FCBOpenInOut : opens existing specified file for read/write (just opens, NOT creates file) (type: IO_TEXT or IO_BIN) |
|||
# FCBOpenForAppend : opens existing specified binary file for write & positions the write cursor after the last actual 128-bytes record, |
|||
# : or creates a new, empty binary file, if the specified file was not found |
|||
# FCBClose : closes the specified file (writing all the file data to disk if the file was opened for write) |
|||
# FCBRewind : equivalent to FCBClose + FCBOpenIn, works only for files already opened for read |
|||
# FCBGetChar : reads a byte from a file already opened for read or read/write |
|||
# FCBPutChar : writes a byte to a file already opened for write or read/write |
|||
# |
|||
|
|||
record CpmFCB is |
|||
dr: uint8; |
|||
f: uint8[11]; |
|||
ex: uint8; |
|||
s1: uint8; |
|||
s2: uint8; |
|||
rc: uint8; |
|||
d: uint8[16]; |
|||
cr: uint8; |
|||
r0: uint8; |
|||
r1: uint8; |
|||
r2: uint8; |
|||
end record; |
|||
|
|||
record FCB is |
|||
bufferptr: uint8; # offset in buffer |
|||
iotype: uint8; |
|||
datatype: uint8; |
|||
cpm: CpmFCB; |
|||
buffer: uint8[128]; |
|||
end record; |
|||
|
|||
# file types |
|||
const IO_TEXT := 0; |
|||
const IO_BIN := 1; |
|||
|
|||
# I/O return codes (error numbers) |
|||
const SUCCESS := 0; |
|||
const ERR_NO_FILE := 1; |
|||
const ERR_BAD_IO := 2; |
|||
const ERR_DIR_FULL := 3; |
|||
const ERR_DISK_FULL := 4; |
|||
const ERR_EOF := 5; |
|||
|
|||
@decl sub FCBOpenIn(fcb: [FCB], filename: [uint8], filetype: uint8): (errno: uint8) @extern("FCBOpenIn"); |
|||
@decl sub FCBOpenOut(fcb: [FCB], filename: [uint8], filetype: uint8): (errno: uint8) @extern("FCBOpenOut"); |
|||
@decl sub FCBOpenInOut(fcb: [FCB], filename: [uint8], filetype: uint8): (errno: uint8) @extern("FCBOpenInOut"); |
|||
|
|||
#only for binary files |
|||
@decl sub FCBOpenForAppend(fcb: [FCB], filename: [uint8]): (errno: uint8) @extern("FCBOpenForAppend"); |
|||
|
|||
@decl sub FCBGetChar(fcb: [FCB]): (c: uint8, errno: uint8) @extern("FCBGetChar"); |
|||
@decl sub FCBPutChar(fcb: [FCB], c: uint8): (errno: uint8) @extern("FCBPutChar"); |
|||
|
|||
@decl sub FCBClose(fcb: [FCB]): (errno: uint8) @extern("FCBClose"); |
|||
|
|||
# only for files open for READ |
|||
@decl sub FCBRewind(fcb: [FCB]): (errno: uint8) @extern("FCBRewind"); |
|||
Binary file not shown.
@ -0,0 +1,390 @@ |
|||
|
|||
const IO_READ := 0; |
|||
const IO_WRITE := 1; |
|||
const IO_READ_WRITE := 2; |
|||
|
|||
const IO_TEXT := 0; |
|||
const IO_BIN := 1; |
|||
|
|||
const SUCCESS := 0; |
|||
const ERR_NO_FILE := 1; |
|||
const ERR_BAD_IO := 2; |
|||
const ERR_DIR_FULL := 3; |
|||
const ERR_DISK_FULL := 4; |
|||
const ERR_EOF := 5; |
|||
|
|||
const CHAR_EOF := 0x1A; |
|||
|
|||
record CpmFCB is |
|||
dr: uint8; |
|||
f: uint8[11]; |
|||
ex: uint8; |
|||
s1: uint8; |
|||
s2: uint8; |
|||
rc: uint8; |
|||
d: uint8[16]; |
|||
cr: uint8; |
|||
r0: uint8; |
|||
r1: uint8; |
|||
r2: uint8; |
|||
end record; |
|||
|
|||
record FCB is |
|||
bufferptr: uint8; # offset in buffer |
|||
iotype: uint8; |
|||
datatype: uint8; |
|||
cpm: CpmFCB; |
|||
buffer: uint8[128]; |
|||
end record; |
|||
|
|||
sub MemSet(p:[uint8], char:uint8, size:uint16) is |
|||
@asm "ld a,(", char, ")"; |
|||
@asm "ld de,(", size, ")"; |
|||
@asm "ld hl,(", p, ")"; |
|||
@asm "ld c,a"; |
|||
@asm "loopm:"; |
|||
@asm "ld a,e"; |
|||
@asm "or d"; |
|||
@asm "ret z"; |
|||
@asm "ld (hl),c"; |
|||
@asm "inc hl"; |
|||
@asm "dec de"; |
|||
@asm "jr loopm"; |
|||
end sub; |
|||
|
|||
sub MemCopy(src: [uint8], size: intptr, dest: [uint8]) is |
|||
@asm "ld de,(", dest, ")"; |
|||
@asm "ld hl,(", src, ")"; |
|||
@asm "ld bc,(", size, ")"; |
|||
@asm "ld a,b"; |
|||
@asm "or c"; |
|||
@asm "ret z"; |
|||
@asm "ldir"; |
|||
@asm "ret"; |
|||
end sub; |
|||
|
|||
sub fcb_init(fcb: [FCB], filename: [uint8]) is |
|||
sub fill(dest: [uint8], src: [uint8], len: uint8): (srcout: [uint8]) is |
|||
loop |
|||
var c := [src]; |
|||
if (c < 32) or (c == '.') then |
|||
c := ' '; |
|||
elseif (c == '*') then |
|||
c := '?'; |
|||
else |
|||
src := src + 1; |
|||
end if; |
|||
if (c >= 'a') and (c <= 'z') then |
|||
c := c - ('a' - 'A'); |
|||
end if; |
|||
[dest] := c; |
|||
dest := dest + 1; |
|||
|
|||
len := len - 1; |
|||
if len == 0 then |
|||
break; |
|||
end if; |
|||
end loop; |
|||
srcout := src; |
|||
end sub; |
|||
|
|||
MemSet(fcb as [uint8], 0, @bytesof FCB); |
|||
MemSet(&fcb.cpm.f[0] as [uint8], ' ', 11); |
|||
filename := fill(&fcb.cpm.f[0], filename, 8); |
|||
|
|||
var c: uint8; |
|||
loop |
|||
c := [filename]; |
|||
if (c < 32) or (c == '.') then |
|||
break; |
|||
end if; |
|||
filename := filename + 1; |
|||
end loop; |
|||
|
|||
if c == '.' then |
|||
filename := fill(&fcb.cpm.f[8], filename+1, 3); |
|||
end if; |
|||
end sub; |
|||
|
|||
sub FCBOpenIn(fcb: [FCB], filename: [uint8], type: uint8): (errno: uint8) @extern("FCBOpenIn") is |
|||
var cpmfcb := &fcb.cpm; |
|||
var cpmerr: uint8; |
|||
|
|||
fcb_init(fcb, filename); |
|||
fcb.iotype := IO_READ; |
|||
fcb.datatype := type; |
|||
|
|||
@asm "ld c, 15"; # OPEN_FILE |
|||
@asm "ld de, (", cpmfcb, ")"; |
|||
@asm "call 5"; |
|||
@asm "ld (", cpmerr, "), a"; |
|||
|
|||
if cpmerr == 0xFF then |
|||
errno := ERR_NO_FILE; |
|||
else |
|||
errno := SUCCESS; |
|||
end if; |
|||
end sub; |
|||
|
|||
sub FCBOpenRW(fcb: [FCB], type: uint8, iotype: uint8): (errno: uint8) is |
|||
var cpmfcb := &fcb.cpm; |
|||
var cpmerr: uint8; |
|||
var c: uint8; |
|||
|
|||
fcb.iotype := iotype; |
|||
fcb.datatype := type; |
|||
|
|||
if iotype == IO_WRITE then |
|||
@asm "ld c, 19"; # DELETE_FILE |
|||
@asm "ld de, (", cpmfcb, ")"; |
|||
@asm "call 5"; |
|||
|
|||
@asm "ld c, 22"; # CREATE_FILE |
|||
@asm "ld de, (", cpmfcb, ")"; |
|||
@asm "call 5"; |
|||
@asm "ld (", cpmerr, "), a"; |
|||
|
|||
if cpmerr == 0xFF then |
|||
errno := ERR_DIR_FULL; |
|||
else |
|||
errno := SUCCESS; |
|||
end if; |
|||
else #IO_READ_WRITE |
|||
@asm "ld c, 15"; # OPEN_FILE |
|||
@asm "ld de, (", cpmfcb, ")"; |
|||
@asm "call 5"; |
|||
@asm "ld (", cpmerr, "), a"; |
|||
|
|||
if cpmerr == 0xFF then |
|||
errno := ERR_NO_FILE; |
|||
else |
|||
errno := SUCCESS; |
|||
end if; |
|||
end if; |
|||
|
|||
if fcb.datatype == IO_TEXT then |
|||
c := CHAR_EOF; |
|||
else |
|||
c := 0; |
|||
end if; |
|||
|
|||
MemSet(&fcb.buffer[0], c, 128); |
|||
end sub; |
|||
|
|||
sub FCBOpenOut(fcb: [FCB], filename: [uint8], type: uint8): (errno: uint8) @extern("FCBOpenOut") is |
|||
fcb_init(fcb, filename); |
|||
errno := FCBOpenRW(fcb, type, IO_WRITE); |
|||
end sub; |
|||
|
|||
sub FCBOpenInOut(fcb: [FCB], filename: [uint8], type: uint8): (errno: uint8) @extern("FCBOpenInOut") is |
|||
fcb_init(fcb, filename); |
|||
errno := FCBOpenRW(fcb, type, IO_READ_WRITE); |
|||
end sub; |
|||
|
|||
sub FCBOpenForAppend(fcb: [FCB], filename: [uint8]): (errno: uint8) @extern("FCBOpenForAppend") is |
|||
var cpmfcb := &fcb.cpm; |
|||
var cpmerr: uint8; |
|||
|
|||
fcb_init(fcb, filename); |
|||
|
|||
@asm "ld c, 17"; # SEARCH_FILE |
|||
@asm "ld de, (", cpmfcb, ")"; |
|||
@asm "call 5"; |
|||
@asm "ld (", cpmerr, "), a"; |
|||
|
|||
if cpmerr == 0xFF then |
|||
# not found, open it for write |
|||
errno := FCBOpenRW(fcb, IO_BIN, IO_WRITE); |
|||
else |
|||
# found, open it for read/write |
|||
errno := FCBOpenRW(fcb, IO_BIN, IO_READ_WRITE); |
|||
|
|||
# errno should be SUCCESS |
|||
if errno != SUCCESS then |
|||
return; |
|||
end if; |
|||
|
|||
var dma := &fcb.buffer[0]; |
|||
@asm "ld c, 26"; # SET DMA |
|||
@asm "ld de, (", dma, ")"; |
|||
@asm "call 5"; |
|||
|
|||
@asm "ld c, 35"; # COMPUTE FILE SIZE |
|||
@asm "ld de, (", cpmfcb, ")"; |
|||
@asm "call 5"; |
|||
|
|||
MemSet(&fcb.buffer[0] as [uint8], 0, 128); |
|||
|
|||
@asm "ld c, 34"; # WRITE RANDOM |
|||
@asm "ld de, (", cpmfcb, ")"; |
|||
@asm "call 5"; |
|||
|
|||
errno := SUCCESS; |
|||
end if; |
|||
end sub; |
|||
|
|||
sub FCBGetChar(fcb: [FCB]): (c: uint8, errno: uint8) @extern("FCBGetChar") is |
|||
|
|||
if fcb.iotype == IO_WRITE then |
|||
errno := ERR_BAD_IO; |
|||
c := 0; |
|||
return; |
|||
end if; |
|||
|
|||
var index: uint8 := fcb.bufferptr; |
|||
|
|||
if index == 0 then |
|||
var cpmfcb := &fcb.cpm; |
|||
var cpmerr: uint8; |
|||
|
|||
var dma := &fcb.buffer[0]; |
|||
@asm "ld c, 26"; # SET DMA |
|||
@asm "ld de, (", dma, ")"; |
|||
@asm "call 5"; |
|||
|
|||
@asm "ld c, 20"; # READ SEQ |
|||
@asm "ld de, (", cpmfcb, ")"; |
|||
@asm "call 5"; |
|||
@asm "ld (", cpmerr, "),a"; |
|||
|
|||
if cpmerr != 0 then |
|||
c := 0; |
|||
errno := ERR_EOF; |
|||
return; |
|||
end if; |
|||
|
|||
c := fcb.buffer[0]; |
|||
fcb.bufferptr := 1; |
|||
else |
|||
c := fcb.buffer[index]; |
|||
|
|||
if index == 127 then |
|||
fcb.bufferptr := 0; |
|||
else |
|||
fcb.bufferptr := index + 1; |
|||
end if; |
|||
end if; |
|||
|
|||
if fcb.datatype == IO_TEXT and c == CHAR_EOF then |
|||
errno := ERR_EOF; |
|||
else |
|||
errno := SUCCESS; |
|||
end if; |
|||
end sub; |
|||
|
|||
sub FCBPutChar(fcb: [FCB], c: uint8): (errno: uint8) @extern("FCBPutChar") is |
|||
|
|||
if fcb.iotype == IO_READ then |
|||
errno := ERR_BAD_IO; |
|||
return; |
|||
end if; |
|||
|
|||
var index: uint8 := fcb.bufferptr; |
|||
fcb.buffer[index] := c; |
|||
|
|||
if index == 127 then |
|||
var cpmfcb := &fcb.cpm; |
|||
var cpmerr: uint8; |
|||
|
|||
var dma := &fcb.buffer[0]; |
|||
@asm "ld c, 26"; # SET DMA |
|||
@asm "ld de, (", dma, ")"; |
|||
@asm "call 5"; |
|||
|
|||
@asm "ld c, 21"; # WRITE SEQ |
|||
@asm "ld de, (", cpmfcb, ")"; |
|||
@asm "call 5"; |
|||
@asm "ld (", cpmerr, "),a"; |
|||
|
|||
if cpmerr != 0 then |
|||
errno := ERR_DISK_FULL; |
|||
return; |
|||
end if; |
|||
|
|||
fcb.bufferptr := 0; |
|||
|
|||
if fcb.datatype == IO_TEXT then |
|||
c := CHAR_EOF; |
|||
else |
|||
c := 0; |
|||
end if; |
|||
|
|||
MemSet(&fcb.buffer[0], c, 128); |
|||
else |
|||
fcb.bufferptr := index + 1; |
|||
end if; |
|||
|
|||
errno := SUCCESS; |
|||
end sub; |
|||
|
|||
sub FCBClose(fcb: [FCB]): (errno: uint8) @extern("FCBClose") is |
|||
var cpmfcb := &fcb.cpm; |
|||
var closeerr: uint8; |
|||
var writeerr: uint8 := 0; |
|||
|
|||
errno := SUCCESS; |
|||
|
|||
if fcb.iotype == IO_READ then |
|||
return; |
|||
end if; |
|||
|
|||
if fcb.bufferptr != 0 then |
|||
var dma := &fcb.buffer[0]; |
|||
@asm "ld c, 26"; # SET DMA |
|||
@asm "ld de, (", dma, ")"; |
|||
@asm "call 5"; |
|||
|
|||
@asm "ld c, 21"; # WRITE SEQ |
|||
@asm "ld de, (", cpmfcb, ")"; |
|||
@asm "call 5"; |
|||
@asm "ld (", writeerr, "),a"; |
|||
end if; |
|||
|
|||
@asm "ld c, 16"; # CLOSE_FILE |
|||
@asm "ld de, (", cpmfcb, ")"; |
|||
@asm "call 5"; |
|||
@asm "ld (", closeerr, "),a"; |
|||
|
|||
if writeerr != 0 then |
|||
errno := ERR_DISK_FULL; |
|||
return; |
|||
end if; |
|||
|
|||
if closeerr == 0xFF then |
|||
errno := ERR_NO_FILE; |
|||
end if; |
|||
end sub; |
|||
|
|||
# only for files open for READ |
|||
sub FCBRewind(fcb: [FCB]): (errno: uint8) @extern("FCBRewind") is |
|||
var cpmfcb := &fcb.cpm; |
|||
var cpmerr: uint8; |
|||
|
|||
if fcb.iotype != IO_READ then |
|||
errno := ERR_BAD_IO; |
|||
return; |
|||
end if; |
|||
|
|||
errno := FCBClose(fcb); |
|||
|
|||
if errno != SUCCESS then |
|||
return; |
|||
end if; |
|||
|
|||
var file: uint8[11]; |
|||
MemCopy(&cpmfcb.f[0], 11, &file[0]); |
|||
MemSet(cpmfcb as [uint8], 0, @bytesof CpmFCB); |
|||
MemCopy(&file[0], 11, &cpmfcb.f[0]); |
|||
fcb.bufferptr := 0; |
|||
|
|||
@asm "ld c, 15"; # OPEN_FILE |
|||
@asm "ld de, (", cpmfcb, ")"; |
|||
@asm "call 5"; |
|||
@asm "ld (", cpmerr, "), a"; |
|||
|
|||
if cpmerr == 0xFF then |
|||
errno := ERR_NO_FILE; |
|||
else |
|||
errno := SUCCESS; |
|||
end if; |
|||
end sub; |
|||
@ -0,0 +1,8 @@ |
|||
@decl sub strlen(str: [uint8]): (len: uint16) @extern("strlen"); |
|||
@decl sub strcpy(dest: [uint8], src: [uint8]): (ret: [uint8]) @extern("strcpy"); |
|||
@decl sub strcat(dest: [uint8], src: [uint8]): (ret: [uint8]) @extern("strcat"); |
|||
@decl sub strcmp(str1: [uint8], str2: [uint8]): (ret: int8) @extern("strcmp"); |
|||
@decl sub strcasecmp(str1: [uint8], str2: [uint8]): (ret: int8) @extern("strcasecmp"); |
|||
@decl sub strstr(str: [uint8], tosearch: [uint8]): (ret: [uint8]) @extern("strstr"); |
|||
@decl sub strchr(str: [uint8], tosearch: uint8): (ret: [uint8]) @extern("strchr"); |
|||
@decl sub tolower(char: uint8): (ret: uint8) @extern("tolower"); |
|||
Binary file not shown.
@ -0,0 +1,192 @@ |
|||
sub strlen(str: [uint8]): (len: uint16) @extern("strlen") is |
|||
@asm "ld de,(", str, ")"; |
|||
@asm "ld hl,0"; |
|||
@asm "1:"; |
|||
@asm "ld a,(de)"; |
|||
@asm "or a"; |
|||
@asm "ret z"; |
|||
@asm "inc de"; |
|||
@asm "inc hl"; |
|||
@asm "jr 1b"; |
|||
end sub; |
|||
|
|||
# returns dest |
|||
sub strcpy(dest: [uint8], src: [uint8]): (ret: [uint8]) @extern("strcpy") is |
|||
@asm "ld hl,(", src, ")"; |
|||
@asm "ld de,(", dest, ")"; |
|||
@asm "push de"; |
|||
@asm "1:"; |
|||
@asm "ld a,(hl)"; |
|||
@asm "ld (de),a"; |
|||
@asm "or a"; |
|||
@asm "jr z,2f"; |
|||
@asm "inc hl"; |
|||
@asm "inc de"; |
|||
@asm "jr 1b"; |
|||
@asm "2:"; |
|||
@asm "pop hl"; |
|||
@asm "ret"; |
|||
end sub; |
|||
|
|||
# returns dest |
|||
sub strcat(dest: [uint8], src: [uint8]): (ret: [uint8]) @extern("strcat") is |
|||
@asm "ld hl,(", src, ")"; |
|||
@asm "ld de,(", dest, ")"; |
|||
@asm "push de"; |
|||
@asm "1:"; |
|||
@asm "ld a,(de)"; |
|||
@asm "inc de"; |
|||
@asm "or a"; |
|||
@asm "jr nz,1b"; |
|||
@asm "dec de"; |
|||
@asm "2:"; |
|||
@asm "ld a,(hl)"; |
|||
@asm "ld (de),a"; |
|||
@asm "or a"; |
|||
@asm "jr z,3f"; |
|||
@asm "inc hl"; |
|||
@asm "inc de"; |
|||
@asm "jr 2b"; |
|||
@asm "3:"; |
|||
@asm "pop hl"; |
|||
@asm "ret"; |
|||
end sub; |
|||
|
|||
# returns 0 if equal, 1 if greather, else -1 |
|||
sub strcmp(str1: [uint8], str2: [uint8]): (ret: int8) @extern("strcmp") is |
|||
@asm "ld de,(", str1, ")"; |
|||
@asm "ld hl,(", str2, ")"; |
|||
@asm "1:"; |
|||
@asm "ld a,(de)"; |
|||
@asm "cp (hl)"; |
|||
@asm "jr nz,2f"; |
|||
@asm "or a"; |
|||
@asm "ret z"; |
|||
@asm "jr 3f"; |
|||
@asm "2:"; |
|||
@asm "jr nc,4f"; |
|||
@asm "ld a,-1"; |
|||
@asm "ret"; |
|||
@asm "3:"; |
|||
@asm "inc hl"; |
|||
@asm "inc de"; |
|||
@asm "jr 1b"; |
|||
@asm "4:"; |
|||
@asm "ld a,1"; |
|||
@asm "ret"; |
|||
end sub; |
|||
|
|||
sub tolower(char: uint8): (ret: uint8) @extern("tolower") is |
|||
@asm "ld a,(", char, ")"; |
|||
@asm "cp 41H"; |
|||
@asm "ret c"; |
|||
@asm "cp 5AH+1"; |
|||
@asm "ret nc"; |
|||
@asm "or 20H"; |
|||
@asm "ret"; |
|||
end sub; |
|||
|
|||
# case insensitive, returns 0 if equal, 1 if greather, else -1 |
|||
sub strcasecmp(str1: [uint8], str2: [uint8]): (ret: uint8) @extern("strcasecmp") is |
|||
var c1: uint8; |
|||
var c2: uint8; |
|||
@asm "ld de,(", str1, ")"; |
|||
@asm "ld hl,(", str2, ")"; |
|||
@asm "1:"; |
|||
@asm "ld a,(hl)"; |
|||
@asm "call tolower"; |
|||
@asm "ld c,a"; |
|||
@asm "ld a,(de)"; |
|||
@asm "call tolower"; |
|||
@asm "cp c"; |
|||
@asm "jr nz,2f"; |
|||
@asm "or a"; |
|||
@asm "ret z"; |
|||
@asm "jr 3f"; |
|||
@asm "2:"; |
|||
@asm "jr nc,4f"; |
|||
@asm "ld a,-1"; |
|||
@asm "ret"; |
|||
@asm "3:"; |
|||
@asm "inc hl"; |
|||
@asm "inc de"; |
|||
@asm "jr 1b"; |
|||
@asm "4:"; |
|||
@asm "ld a,1"; |
|||
@asm "ret"; |
|||
@asm "tolower:"; |
|||
@asm "cp 41H"; |
|||
@asm "ret c"; |
|||
@asm "cp 5AH+1"; |
|||
@asm "ret nc"; |
|||
@asm "or 20H"; |
|||
@asm "ret"; |
|||
end sub; |
|||
|
|||
sub strstr(str: [uint8], tosearch: [uint8]): (ret: [uint8]) @extern("strstr") is |
|||
@asm "ld de,(", tosearch, ")"; |
|||
@asm "ld hl,(", str, ")"; |
|||
@asm "1:"; |
|||
@asm "ld a,(de)"; |
|||
@asm "cp (hl)"; |
|||
@asm "jr z,2f"; |
|||
@asm "inc hl"; |
|||
@asm "ld a,(hl)"; |
|||
@asm "or a"; |
|||
@asm "jr nz,1b"; |
|||
@asm "3:"; |
|||
@asm "ld hl,0"; |
|||
@asm "ret"; |
|||
@asm "2:"; |
|||
@asm "ld b,d"; |
|||
@asm "ld c,e"; |
|||
@asm "inc de"; |
|||
@asm "ld a,(de)"; |
|||
@asm "or a"; |
|||
@asm "ret z"; |
|||
@asm "push hl"; |
|||
@asm "inc hl"; |
|||
@asm "6:"; |
|||
@asm "ld a,(de)"; |
|||
@asm "cp (hl)"; |
|||
@asm "jr nz,4f"; |
|||
@asm "inc hl"; |
|||
@asm "inc de"; |
|||
@asm "ld a,(de)"; |
|||
@asm "or a"; |
|||
@asm "jr z,5f"; |
|||
@asm "ld a,(hl)"; |
|||
@asm "or a"; |
|||
@asm "jr nz,6b"; |
|||
@asm "pop hl"; |
|||
@asm "jr 3b"; |
|||
@asm "5:"; |
|||
@asm "pop hl"; |
|||
@asm "ret"; |
|||
@asm "4:"; |
|||
@asm "pop hl"; |
|||
@asm "inc hl"; |
|||
@asm "ld a,(hl)"; |
|||
@asm "or a"; |
|||
@asm "jr z,3b"; |
|||
@asm "ld d,b"; |
|||
@asm "ld e,c"; |
|||
@asm "jr 1b"; |
|||
end sub; |
|||
|
|||
sub strchr(str: [uint8], tosearch: uint8): (ret: [uint8]) @extern("strchr") is |
|||
@asm "ld a,(", tosearch, ")"; |
|||
@asm "ld c,a"; |
|||
@asm "ld hl,(", str, ")"; |
|||
@asm "1:"; |
|||
@asm "ld a,c"; |
|||
@asm "cp (hl)"; |
|||
@asm "ret z"; |
|||
@asm "inc hl"; |
|||
@asm "ld a,(hl)"; |
|||
@asm "or a"; |
|||
@asm "jr nz,1b"; |
|||
@asm "ld hl,0"; |
|||
@asm "ret"; |
|||
end sub; |
|||
|
|||
@ -0,0 +1,3 @@ |
|||
sub Test() is |
|||
@asm "call _xrndseed"; |
|||
end sub; |
|||
@ -0,0 +1,2 @@ |
|||
COWGOL TESTAS.COW RAND.AS |
|||
|
|||
@ -1,53 +0,0 @@ |
|||
; Xorshift is a class of pseudorandom number generators discovered |
|||
; by George Marsaglia and detailed in his 2003 paper, Xorshift RNGs. |
|||
; |
|||
; 16-bit xorshift pseudorandom number generator by John Metcalf |
|||
; returns hl = pseudorandom number |
|||
; corrupts a |
|||
|
|||
; generates 16-bit pseudorandom numbers with a period of 65535 |
|||
; using the xorshift method: |
|||
|
|||
; hl ^= hl << 7 |
|||
; hl ^= hl >> 9 |
|||
; hl ^= hl << 8 |
|||
|
|||
; some alternative shift triplets which also perform well are: |
|||
; 6, 7, 13; 7, 9, 13; 9, 7, 13. |
|||
|
|||
psect text |
|||
|
|||
GLOBAL _xrnd, _xrndseed |
|||
|
|||
_xrnd: |
|||
ld hl,1 ; seed must not be 0 |
|||
ld a,h |
|||
rra |
|||
ld a,l |
|||
rra |
|||
xor h |
|||
ld h,a |
|||
ld a,l |
|||
rra |
|||
ld a,h |
|||
rra |
|||
xor l |
|||
ld l,a |
|||
xor h |
|||
ld h,a |
|||
ld (_xrnd+1),hl |
|||
res 7,h ;make-it positive... |
|||
ret |
|||
|
|||
_xrndseed: |
|||
ld a,r |
|||
ld l,a |
|||
ld a,r |
|||
ld h,a |
|||
or l ; HL must be not NULL |
|||
jr nz,1f |
|||
inc hl |
|||
1: |
|||
ld (_xrnd+1),hl |
|||
ret |
|||
|
|||
Loading…
Reference in new issue