diff --git a/Makefile b/Makefile index 21c36cd..18a2ee1 100644 --- a/Makefile +++ b/Makefile @@ -139,6 +139,7 @@ build/src/7.1/as0/%.o: OPTFLAGS := -O2 build/src/7.1/as1/%.o: OPTFLAGS := -O2 build/src/7.1/cfe/%.o: OPTFLAGS := -O2 build/src/7.1/ugen/%.o: OPTFLAGS := -O2 +build/src/7.1/libu/%.o: OPTFLAGS := -O2 # Targets diff --git a/src/libu/bread.p b/src/libu/bread.p index 47d255b..eb09410 100644 --- a/src/libu/bread.p +++ b/src/libu/bread.p @@ -33,7 +33,7 @@ var procedure fix_infinity(var str: Stringtext; var len: integer); internal; begin - if + if ((len = 8) and (str.ss[1] = 'I') and (str.ss[2] = 'n') @@ -96,7 +96,7 @@ begin u.Intarray[2] := ugetint(); urec := utab[u.Opc]; instlength := urec.instlength; - + i := 3; while i <> instlength + 1 do begin u.Intarray[i] := ugetint(); @@ -109,7 +109,7 @@ begin u.Intarray[instlength + 2] := ugetint(); if ((u.Dtype in [Mdt, Qdt, Rdt, Sdt, Xdt]) or (u.Opc = Ucomm)) then begin - + strlength := (u.Intarray[instlength + 1] + 3) div 4; if ((strlength & 1) <> 0) then begin @@ -147,7 +147,7 @@ begin datachars := ['A', 'C', 'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'P', 'Q', 'R', 'S', 'W', 'X', 'Z']; memorychars := ['A', 'M', 'P', 'R', 'S', 'Z']; setconstantchars := ['0'..'9', 'A'..'F']; - + dtytype['A'] := Adt; dtytype['C'] := Cdt; dtytype['F'] := Fdt; @@ -181,7 +181,7 @@ begin u.Length := u.Length * 8; return; end; - + if (u.Opc in [Uildv, Uilod, Uistr, Uistv, Urldc]) then begin u.I1 := u.I1 * 8; u.Length := u.Length * 8; @@ -199,7 +199,7 @@ begin u.I1 := u.I1 * 8; return; end; - + if (u.Opc in [Udef, Udif, Ufill, Uiequ, Uigeq, Uigrt, Uileq, Uiles, Uineq, Uinn, Uint, Ulca, Uldc, Umov, Usdef, Usgs, Uuni]) then begin u.Length := u.Length * 8; diff --git a/src/libu/bwri.p b/src/libu/bwri.p new file mode 100644 index 0000000..8bc5ac0 --- /dev/null +++ b/src/libu/bwri.p @@ -0,0 +1,235 @@ +#include "cmplrs/usys.h" +#include "cmplrs/ucode.h" + +procedure uputinit(var ObjectName : Filename); external; +procedure uputint(i: integer); external; +procedure uputkill(); external; +procedure uputclose(); external; + +var + dtyname: Array [first(Datatype)..last(Datatype)] of char; + mtyname: Array [first(Memtype)..last(Memtype)] of char; + noerrorsyet: boolean; + u_indent: integer; + Utab: extern array[first(Uopcode)..last(Uopcode)] of Utabrec; + +procedure inituwrite(var arg0: Filename); +begin + noerrorsyet := true; + uputinit(arg0); + + dtyname[Cdt] := 'C'; + dtyname[Fdt] := 'F'; + dtyname[Gdt] := 'G'; + dtyname[Hdt] := 'H'; + dtyname[Zdt] := 'Z'; + dtyname[Adt] := 'A'; + dtyname[Jdt] := 'J'; + dtyname[Ldt] := 'L'; + dtyname[Mdt] := 'M'; + dtyname[Ndt] := 'N'; + dtyname[Pdt] := 'P'; + dtyname[Qdt] := 'Q'; + dtyname[Rdt] := 'R'; + dtyname[Sdt] := 'S'; + dtyname[Xdt] := 'X'; + dtyname[Idt] := 'I'; + dtyname[Kdt] := 'K'; + dtyname[Wdt] := 'W'; + + mtyname[Zmt] := 'Z'; + mtyname[Mmt] := 'M'; + mtyname[Rmt] := 'R'; + mtyname[Smt] := 'S'; + mtyname[Pmt] := 'P'; + mtyname[Amt] := 'A'; + + u_indent := 0; +end; + +function idlen(var id: Identname): integer; +var + len: integer; +begin + for len := Identlength downto 1 do begin + if (id[len] <> ' ') then begin + return len; + end; + end; + return 0; +end; + +function fnamelen(fname: Filename): integer; +var + len: integer; +begin + len := 0; + + while (len < Filenamelen) do begin + if (fname[len + 1] = ' ') then begin + return len; + end; + len := len + 1; + end; + + return Filenamelen; +end; + +procedure uwrite(var u: Bcrec); +var + i: integer; + pad: integer; + urec: UtabRec; + strlength: integer; + str: Stringtextptr; +begin + if noerrorsyet then begin + urec := utab[u.Opc]; + i := 1; + while (i <> (urec.instlength + 1)) do begin + uputint(u.Intarray[i]); + uputint(u.Intarray[i + 1]); + i := i + 2; + end; + + if (urec.hasconst) then begin + uputint(u.Intarray[urec.instlength + 1]); + uputint(u.Intarray[urec.instlength + 2]); + if ((u.Dtype in [Mdt, Qdt, Rdt, Sdt, Xdt]) or (u.Opc = Ucomm)) then begin + if (u.Opc = Uinit) then begin + strlength := (u.Initval.Ival + 3) div 4; + end else begin + strlength := (u.Constval.Ival + 3) div 4; + end; + + if (strlength & 1 <> 0) then begin + strlength := strlength + 1; + end; + + if (u.Opc = Uinit) then begin + str := u.Initval.Chars; + end else begin + str := u.Constval.Chars; + end; + + i := 1; + while (i <> (strlength + 1)) do begin + uputint(str^.ssarray[i]); + uputint(str^.ssarray[i + 1]); + i := i + 2; + end; + end; + end; + end; +end; + +function getdtyname(Dtyp: Datatype): char; +begin + getdtyname := dtyname[Dtyp]; +end; + +function getmtyname(Mtyp: Memtype): char; +begin + getmtyname := mtyname[Mtyp]; +end; + +procedure ucoid(Tag: Identname); +var + i: integer; + u: Bcrec; +begin + for i := 1 to Maxinstlength do begin + u.Intarray[i] := 0; + end; + + new(u.Constval.Chars); + + { Skip end spaces } + while ((u.Constval.Ival > 0) and (Tag[u.Constval.Ival] = ' ')) do begin + u.Constval.Ival := u.Constval.Ival - 1; + end; + + for i := 1 to u.Constval.Ival do begin + u.Constval.Chars^.ss[i] := Tag[i]; + end; + + u.Opc := Ucomm; + u.Dtype := Mdt; + uwrite(u); + dispose(u.Constval.Chars); +end; + +procedure ucofname(fname: Filename); +var + i: integer; + u: Bcrec; +begin + for i := 1 to Maxinstlength do begin + u.Intarray[i] := 0; + end; + + new(u.Constval.Chars); + u.Constval.Ival := fnamelen(fname); + + if (u.Constval.Ival >= (Filenamelen + 1)) then begin + u.Constval.Ival := Filenamelen; + end; + + for i := 1 to u.Constval.Ival do begin + u.Constval.Chars^.ss[i] := fname[i]; + end; + + u.Opc := Ucomm; + u.Dtype := Mdt; + uwrite(u); + dispose(u.Constval.Chars); +end; + +procedure stopucode(); +begin + uputkill(); + noerrorsyet := false; +end; + +procedure ubittobyte(var u: Bcrec); +begin + if (u.Opc in [Uadj, Uisld, Uisst, Ulod, Umpmv, Upar, Updef, Upmov, Uregs, Urlda, Urpar, Ustr, Uvreg]) then begin + u.Offset := u.Offset div 8; + u.Length := u.Length div 8; + return; + end; + + if (u.Opc in [Uildv, Uilod, Uistr, Uistv, Urldc]) then begin + u.I1 := u.I1 div 8; + u.Length := u.Length div 8; + return; + end; + + if (u.Opc in [Uilda, Ulda, Urlod, Urstr]) then begin + u.Offset := u.Offset div 8; + u.Length := u.Length div 8; + u.Offset2 := u.Offset2 div 8; + return; + end; + + if (u.Opc in [Uidx, Uixa]) then begin + u.I1 := u.I1 div 8; + return; + end; + + if (u.Opc in [Udef, Udif, Ufill, Uiequ, Uigeq, Uigrt, Uileq, Uiles, Uineq, Uinn, Uint, Ulca, Uldc, Umov, Umus, Usdef, Usgs, Uuni]) then begin + u.Length := u.Length div 8; + end else if (u.Opc = Uinit) then begin + u.Offset := u.Offset div 8; + u.Length := u.Length div 8; + u.Offset2 := u.Offset2 div 8; + u.Constval.dwval_l := u.Constval.dwval_l div 8; + end else if (u.Opc = Uoptn) and (u.I1 = 1) then begin + u.Length := u.Length div 8; + end; +end; + +procedure set_u_indent(ident: integer); +begin + {u_ident := ident} (* Possible implementation of this 'useless' function *) +end; diff --git a/src/libu/uscan.p b/src/libu/uscan.p new file mode 100644 index 0000000..7787dc9 --- /dev/null +++ b/src/libu/uscan.p @@ -0,0 +1,50 @@ +#include "cmplrs/usys.h" +#include "cmplrs/ucode.h" + +procedure abort(); +begin + halt(-1); +end; + +procedure openstdout(var f: Text); +begin +end; + +procedure opnstdin(var f: Text); +begin +end; + +procedure openinput(var f: Text; fname: Filename); +begin + reset(f, fname); +end; + +procedure openoutput(var f: Text; fname: Filename); +begin + rewrite(f, fname); +end; + +function getclock(): integer; +begin + getclock := clock(1); +end; + +function eopage(var f: text): boolean; +begin + eopage := f^ = chr(12); +end; + +procedure readpage(var f: Text); +begin + get(f); +end; + +procedure printdate(var fil: text); +begin + +end; + +procedure printtime(var fil: text); +begin + +end; diff --git a/src/ugen/fold.p b/src/ugen/fold.p index 5e59a88..b525d32 100644 --- a/src/ugen/fold.p +++ b/src/ugen/fold.p @@ -26,7 +26,7 @@ end; function is_constant(arg0: Ptree): boolean; begin - return (arg0^.u.Opc = Uldc) and (arg0^.u.Dtype in [Adt, Hdt, Idt, Jdt, Kdt, Ldt, Wdt]); {Maybe a special data type is missing...} + return (arg0^.u.Opc = Uldc) and (arg0^.u.Dtype in [Adt, Hdt, Idt, Jdt, Kdt, Ldt, Wdt]); end; function llconst(p_tree: Ptree; dtype: Datatype): integer64; diff --git a/src/ugen/ugen.p b/src/ugen/ugen.p index 0b7a847..eedc0a2 100644 --- a/src/ugen/ugen.p +++ b/src/ugen/ugen.p @@ -15,7 +15,7 @@ #define ARG_OPT(index, opt) (arg[index] = opt) #define IS_OPT(opt) streq(arg, opt) -#define CONSUME_WHITESPACE(len, line) len := sizeof(line); \ +#define SKIP_END_SPACES(len, line) len := sizeof(line); \ while ((len <> 0) and (line[len] = ' ')) do begin \ len := len - 1; \ end; \ @@ -103,7 +103,7 @@ var #define ARG_OPT(index, opt) (arg[index] = opt) #define IS_OPT(opt) streq(arg, opt) -#define CONSUME_WHITESPACE(len, line) len := sizeof(line); \ +#define SKIP_END_SPACES(len, line) len := sizeof(line); \ while ((len <> 0) and (line[len] = ' ')) do begin \ len := len - 1; \ end; \ @@ -680,7 +680,7 @@ begin if ((xpg_env = true) and ARG_OPT(3, '-')) then begin argv(index, sp108); - CONSUME_WHITESPACE(var_s1, sp108); + SKIP_END_SPACES(var_s1, sp108); if (var_s1 <> 0) then begin sp108[var_s1+1] := chr(0); @@ -701,7 +701,7 @@ begin end else begin argv(index, sp15C0); - CONSUME_WHITESPACE(var_s1, sp15C0); + SKIP_END_SPACES(var_s1, sp15C0); end; index := index + 1; @@ -729,7 +729,7 @@ begin end; if (ascii_out) then begin - CONSUME_WHITESPACE(var_v0_3, spDC0); + SKIP_END_SPACES(var_v0_3, spDC0); spDC0[var_v0_3 + 1] := chr(0); rewrite(sp534, spDC0); @@ -764,7 +764,7 @@ begin sp11C0[var_s1] := 'G'; {binasm extension} var_v0_3 := var_s1; end else begin - CONSUME_WHITESPACE(var_v0_3, sp11C0); + SKIP_END_SPACES(var_v0_3, sp11C0); end; sp11C0[var_v0_3 + 1] := chr(0); @@ -772,7 +772,7 @@ begin if (temp_fname[1] = chr(0)) then begin create_temp_file(); end else begin - CONSUME_WHITESPACE(var_v0_4, temp_fname); + SKIP_END_SPACES(var_v0_4, temp_fname); temp_fname[var_v0_4 + 1] := chr(0); end;