Commit a2049b35 authored by John Spikowski's avatar John Spikowski

O2 Self Compile 20181210 Update

parent 3361755c
del c.exe
del co2???.exe
del oxygen??.dll
......@@ -21,6 +21,14 @@ itr 10:17 18/11/2018 Fix multiply unsigned by number (oper w1="mul ")
itr 16:07 16/11/2018 Rework rtl321 and rtl641 cats. expose char count. (catbufprp badcatl3 joinsi)
11:43 10/12/2018 Change expression order (expr.inc hlex hiex)
10:49 10/12/2018 Support "save" operation for register-based accumulators ("save")
01:18 10/12/2018 Revokevoke support for primitive down-converting load
10:57 09/12/2018 Refactor typa1 htyp (typx typh)
10:31 09/12/2018 Fix macromember name search (pars.bas rmk)
02:48 08/12/2018 Suppress del / destructor nullify call
18:19 07/12/2018 Add nullify function to wrap _nullify (tran.inc lang.inc)
13:45 06/12/2018 Jit mode early copy call vectors (posbin(3) pvd)
05:29 05/12/2018 Support redim string s(n) clear (lang.inc clear)
04:44 05/12/2018 Fix redim to include nullify for UDTs (lang.inc)
04:41 05/12/2018 Fix match and leftmatch (removing noquotes) (meta.inc)
......
......@@ -281,7 +281,7 @@ function encodele(string*wm, int*k, string*ty, int n, vtl, vtp, string*ws) as st
if vtl>1 then m=9 else m=8 'method / procedure
w5=" 0 "
else
if (n>=htyp)or(indt>0) then m=3 else m=1 'pointer / direct
if (n>=typh)or(indt>0) then m=3 else m=1 'pointer / direct
w5=" 0 "
endif
'
......@@ -316,8 +316,8 @@ function encodele(string*wm, int*k, string*ty, int n, vtl, vtp, string*ws) as st
'
'n = 0x01.. 0xff primitive / 0x11f procedure / 0x200.. higher type
'
if n>=htyp
w3=str(n) 'higher types (location+htyp)
if n>=typh
w3=str(n) 'higher types (location+typh)
elseif ty
w3=ty
else
......@@ -526,7 +526,7 @@ sub vars(string*s)
' maco 2 offset
' maco 3 indirection level of variable
' maco 4 type indirection level
' maco 5 type code >=htyp = user defined
' maco 5 type code >=typh = user defined
'------------------------------
'
i=1
......@@ -568,7 +568,7 @@ sub vars(string*s)
'
w=lent
'
if it>=htyp
if it>=typh
k=it 'CLASS OR UDT
if ndstr=0 then hasd=findop(it,a,"destructor",dstr)
endif
......@@ -922,7 +922,9 @@ sub vars(string*s)
if ise(ascn)=0
mc=0 : goto varss 'FURTHER VAR STATEMENTS
endif
if lclv=0 then aoffs=aoff
if lclv=0
aoffs=aoff
endif
end sub
......@@ -1509,8 +1511,8 @@ sub types(int unip,vtp,*ttc,*tuc)
'
'COMPOUND OR CUSTOM TYPE
'
if a>=htyp
m=macio(a-htyp,0)
if a>=typh
m=macio(a-typh,0)
'
'FUNCTION TYPES
'
......@@ -1519,7 +1521,7 @@ sub types(int unip,vtp,*ttc,*tuc)
bb=pk
'itr overload matching
string wt1
nextproc(macso(a-htyp,1),1,wt1,0)
nextproc(macso(a-typh,1),1,wt1,0)
if (sig="#@")or(sig="") then sig=","
'if priv=0 then priv=0x39
'
......@@ -1537,7 +1539,7 @@ sub types(int unip,vtp,*ttc,*tuc)
typebfna: 'TYPE BEFORE NAME (C STYLE)
'=========
'
if ((a<>0)and(a<0x100))or(a>=htyp)
if ((a<>0)and(a<0x100))or(a>=typh)
typ=a
m=isptr(wm,k)
if ascn<>lbr
......@@ -1683,7 +1685,7 @@ sub types(int unip,vtp,*ttc,*tuc)
if wr="void" then typ=cpuw : lent=0 'IN THIS CONTEXT
v=lent : n=typ ': midspace(wm,b,k)
'
elseif n<htyp
elseif n<typh
'
'A PRIMITIVE TYPE OR PART OF MULTIELEMENT
'----------------------------------------
......@@ -1711,7 +1713,7 @@ sub types(int unip,vtp,*ttc,*tuc)
endif
v=lent
'
else 'n>=htyp
else 'n>=typh
'
'CHECK IF POINTER TO ANOTHER STRUCTURE
'-------------------------------------
......@@ -1724,12 +1726,12 @@ sub types(int unip,vtp,*ttc,*tuc)
endif
endif
'
if macio(n-htyp,0)=-33
if macio(n-typh,0)=-33
n=4 : v=4 'ENUMERATIONS ASSUME LONG TYPE
endif
'
'
endif 'n, htyp
endif 'n, typh
'
m=1
do
......@@ -1762,7 +1764,7 @@ sub types(int unip,vtp,*ttc,*tuc)
'
'POINTER TO ANOTHER STRUCT
'
if sni>=htyp
if sni>=typh
'itr auto single-level indirect in encodE ele()
v=0
if ascn=42
......@@ -1774,8 +1776,8 @@ sub types(int unip,vtp,*ttc,*tuc)
v=cpuw
endif
'
'if v or (sni<htyp)
if (v=0)and(sni>=htyp) then goto ncompor
'if v or (sni<typh)
if (v=0)and(sni>=typh) then goto ncompor
'
'
'AUTO-ADJUST BOUNDARY ALIGNMENT (PADDING)
......@@ -1946,7 +1948,7 @@ sub types(int unip,vtp,*ttc,*tuc)
endif
endif
'
a=sni-htyp 'STRUCTURE INDEX
a=sni-typh 'STRUCTURE INDEX
'
if a>0 then e=1 else e=0
if e=0 then ers="Undefined "+ty : ert=10 : exit sub
......@@ -2283,11 +2285,6 @@ sub types(int unip,vtp,*ttc,*tuc)
'
endif
'
'INITIAL ASSIGNMENT OF MEMBER VALUES
'===================================
'
'hiex+="def "+macso(b,0)+"_init"+cr+vlist+"end def"+cr
'rps=1
'
end sub
......@@ -2476,7 +2473,7 @@ sub makeheaders(string*s,*w4,*w3, int mo)
'--------------------------
'
a=0
if idt>=htyp
if idt>=typh
if ascn<>42 then a=1
'elseif instrword(" static of from has incl ",w1)
elseif instrword(" of from has incl ",w1) 'members removed
......
......@@ -496,7 +496,7 @@ function oper(int qp,tp, string*wk) as string
case -1 : exit function
end select
'
if tp>=htyp
if tp>=typh
'exit function 'IGNORE
tp=cpuw 'ASSUME VALUE IS IN ACCUM
endif
......@@ -1300,7 +1300,7 @@ function cvta(int typa,typb) as string
'HIGHER TYPE CHECK
'=================
'
if (typa>=htyp)or(typb>=htyp)
if (typa>=typh)or(typb>=typh)
if typb<>typa
'ers="type mismatch " : ert=98
'ASSUME NO CONVERSION REQUIRED
......
......@@ -375,7 +375,7 @@ sub prepforlocalspace(int pn)
a=typp
w3=" returnvar"
'
if a<htyp
if a<typh
if a=&h40 then a=&h68 : wva(1)="double" 'fpu return type using qword slot
a and=31
vars(wva(1)+w3)
......@@ -462,7 +462,7 @@ sub noprototype(string*wd,*w1)
endif
elseif (isstr(typg)<>0)or(wg=qedi)
typg=cpuw
elseif (typg>=htyp)and(bvg=0) 'bvg: null flag
elseif (typg>=typh)and(bvg=0) 'bvg: null flag
'passing direct higher types: rect etc
if wpfx=""
wd=leaedi(wg) : w1=qedi : typg=cpuw
......@@ -487,7 +487,7 @@ sub newcleanvar(string *wn,*wr,int p)
=====================================
wn=newtmpvar(typename(p))
wr=macso(me-1,1) 'vector
if p<htyp
if p<typh
exit sub
endif
int n=macio(me-1,1) 'size
......@@ -529,7 +529,7 @@ function buildparamblock(int pb, cc) as string
mpfx=left(mpfx,m-1)+w3+mid(mpfx,m+5)
endif
pas(d)=w2
if pat(d)>=htyp
if pat(d)>=typh
pat(d)=cpuw
endif
next
......@@ -709,7 +709,7 @@ function preparecall(string*wp,*w4,*wm, int cc) as string
'COMPOSE THE CALL INCLUDING 'THIS' IN THE ECX REGISTER
'
if asc(pls)=48
pls=","+macso(macio(mp,0)-htyp,0)+"."+wm 'FWD REF REQUIRES NAMED CLASS.PROCEDURE
pls=","+macso(macio(mp,0)-typh,0)+"."+wm 'FWD REF REQUIRES NAMED CLASS.PROCEDURE
endif
'
w5=pls+" "+w5+" "+hex(nsi)+" "+hex(nsp)
......@@ -1020,7 +1020,7 @@ function compatsig(string*p1,*p2, int pb) as int
'NULL OR BYVAL V, REQUIRING EXTRA STACK
'exclude byval double or extended
if d=95
if m>=htyp then goto nxtel
if m>=typh then goto nxtel
'ALLOW FLOAT CONVERSION
if e>0 then n=cpuw
if isfloat(n)=0 then n=cpuw
......@@ -1042,7 +1042,7 @@ function compatsig(string*p1,*p2, int pb) as int
if d>48 then a=1 : d-- : e-- : m=cpuw 'VOID* TO int
elseif m=cpuw
if d=48 then a=1 : e-- 'ALLOW BYVAL int TYPES TO BE TREATED LIKE VOID*
elseif m>=htyp
elseif m>=typh
if d>48 then a=1 : m=cpuw 'VOID* COMPATIBILITY
endif
if a then n=cpuw 'TREAT AS int TYPES (HANDLES ETC) itr
......@@ -1052,7 +1052,7 @@ function compatsig(string*p1,*p2, int pb) as int
if b<a
m=cpuw : n=cpuw 'NO UP CONVERSION CODE REQUIRED
endif
elseif n>=htyp 'up-convert
elseif n>=typh 'up-convert
if uk and 2
if findop(n,a,"constructor",w1)
'deferred object creation
......@@ -1070,23 +1070,23 @@ function compatsig(string*p1,*p2, int pb) as int
k=0 : exit function
endif
endif
elseif m>=htyp
'n<htyp 'down-convert
elseif m>=typh
'n<typh 'down-convert
if uk and 2
if findop(m,a,"load",w1)
'deferred object creation
paj(pa)=n
mpfx+=por(pa)+".load(#obj#)"+cr
pas(pa)=operi(1,n,"#obj#")+cr
pav(pa)=callcnvi(c,n,e)
k=2
goto nxtel
else
'if findop(m,a,"load",w1)
' 'deferred object creation
' paj(pa)=n
' mpfx+=por(pa)+".load(#obj#)"+cr
' pas(pa)=operi(1,n,"#obj#")+cr
' pav(pa)=callcnvi(c,n,e)
' k=2
' goto nxtel
'else
if (d<=48)or(e<=48)
k=0 : exit function
endif
'allow vectors to pass as floats etc
endif
'endif
endif
endif
'
......@@ -1445,7 +1445,7 @@ function compatsig(string*p1,*p2, int pb) as int
a=asc(wg)
b=0
'
if typg>=htyp
if typg>=typh
goto nxtel 'ALLOW HIGHER TYPE TO PASS TO PRIMITIVE PARAM
elseif opg>1
b=1
......
This diff is collapsed.
......@@ -72,7 +72,7 @@
'GENERAL CONSTANTS
'=================
int htyp=512 'HIGHER TYPES BASE
int typh=512 'HIGHER TYPES BASE
int hasa=124 ' | HIGH ASSEMBLER INSTRUCTION CODE
string she=chr(248) '#show DELIMITER
int iqi=250 'INTERNAL QUOTE CODE
......@@ -170,6 +170,7 @@
========================================================
'
sys pvm[255] 'POINTERS TO VIRTUALALLOC MEMORY
sys pvd[255] 'POINTERS TO VIRTUALALLOC MEMORY BSSDATA
sys lbuf[255] 'LENGTH OF SELECTED PVM
string dbuf 'BUFFER FOR COMPILE CODE
int ibuf 'INDEX FOR SELECTED BUFFER
......@@ -573,7 +574,7 @@
int nsto,stkb,parx,divi,met,newline,pakd,arf,ccx,casg
int nobr,ebdi,nmac,nstod,cboolf,convs,plistend,clistend,dlistend,plp,plq
int compact,tranpass,preproc,asxp,elct,elsz,ctal,cpoint
int nsi,nsp,nsq,rps,tyd,hix,independent,cnsl,eord,noco
int nsi,nsp,nsq,rps,tyd,independent,cnsl,eord,noco
int omo,ert,epif,epli,epgi,nobj,ndstr,coret
......
......@@ -864,14 +864,9 @@ endif
'
'PROGRAM ENTRY FOR PRIMARY COMPILED CODE:
'CREATE BSS STATIC SPACE FOR GLOBALS ETC
'COPY RUNTIME LIBRARY INTO BSS
'
aoff+=15 : aoff and= 0xfffffff0 'ROUND UP TO NEAREST 16
'
'JIT MODE:
'copy 0-512 and 2048 to 4095 of the RTFT
'the .bss section is assumed to be pre-initialised with nulls
'
ddat="._data_"+cr+left(dats,dati)+cr+"00 01 `end_of_data` 01 /+1000"+cr
udat=".bssdata"+cr+"$"+hex(sizebss())+cr
string cpuws=str(cpuw)
......@@ -905,40 +900,12 @@ sub rbx,here
add rbx,bssdata
ret
'
'COPY ALL CALL-VECTORS INTO PROGS BBSSDATA SPACE
'===============================================
.CopyLib
mov rsi,rbx 'PARENT BSSDATA
call _mem
mov rdi,rbx
mov ecx,192 'COPY FROM 0 TO 767
(
mov eax,[rsi]
mov [rdi],eax
add rsi,4
add rdi,4
dec ecx
jg repeat
)
add rsi,1280
add rdi,1280
mov ecx,150 'COPY FROM 2048 TO 2647
(
mov eax,[rsi]
mov [rdi],eax
add rsi,4
add rdi,4
dec ecx
jg repeat
)
ret
'
'
'MAIN ENTRY POINT
'================
._initjit
push rbp : mov rbp,rsp
call CopyLib
'call CopyLib
'SPACE FOR GLOBAL BUFFER POINTERS
push 0
push 0
......@@ -983,42 +950,12 @@ jmp fwd _initjit
._mem
lea rip rbx,bssdata
ret
'
'COPY ALL CALL-VECTORS INTO PROGS BBSSDATA SPACE
'===============================================
.CopyLib
mov rsi,rbx 'PARENT BSSDATA
call _mem
mov rdi,rbx
mov ecx,192 'COPY FROM 0 TO 767
(
mov eax,[rsi]
mov [rdi],eax
add rsi,4
add rdi,4
dec ecx
jg repeat
)
add rsi,1280
add rdi,1280
mov ecx,150 'COPY FROM 2048 TO 2647
(
mov eax,[rsi]
mov [rdi],eax
add rsi,4
add rdi,4
dec ecx
jg repeat
)
ret
'
'
'MAIN ENTRY POINT
'================
._initjit
push rbp : mov rbp,rsp
call CopyLib
'SPACE FOR GLOBAL BUFFER POINTERS
push 0
push 0
......@@ -1059,7 +996,9 @@ function="
"+asms+"
o2 (
/+1000
"+ddat+udat+"
"+ddat+"
o2 p3
"+udat+"
)
"
exit function 'JIT MODE
......
......@@ -229,10 +229,6 @@ redim 18
#ifdef %1.destructor
%2[_i_].destructor
#endif
sys _p_=@%2[_i_]
mov rcx,_p_
mov edx,sizeof %2
nullify
#elseif typecodeof(%2)>=0xa0
%2[_i_]=""
#else
......@@ -328,7 +324,6 @@ copyn 4 72
copy 4 72
mbox 4 2048 'mboxa
comparestr 4 2192 ' comps ' COMPARING BSTRS
nullify 4 _nullify
'=============================
'>>COMMON RESERVED WORDS
......
......@@ -416,8 +416,9 @@ do ' main loop
'
case 0x70
'
a=wdval(s,i+1,i)
posbin(a)=j
i++
a=readint(s,i)
posbin(a)=j-1
exit do
'
'
......
......@@ -125,7 +125,8 @@
endif
pam=VirtualAlloc 0,lam,0x1000,0X40 'MEM_COMMIT, PAGE_EXECUTE_READWRITE
lbuf[ibuf]=lam
pvm[ibuf]=pam
pvm[ibuf]=pam 'BASE (ALSO ENTRY POINT)
pvd[ibuf]=pam+posbin[3] 'BSSDATA
copy pam,pbuf,lam
end sub
......@@ -138,7 +139,7 @@
return 0 'EXCLUDE (AFTER MAKING A PE FILE)
endif
'
sys mbx
sys mbx,nbx
'
if p=0
p=pvm[ibuf]
......@@ -147,8 +148,10 @@
endif
endif
'
mov rax,0
mov mbx,rbx
nbx=pvd[ibuf]
mov rbx,nbx
mov rax,0
call p
mov rbx,mbx
return
......@@ -273,6 +276,11 @@
endif
endif
'
'JIT MODE
if len(dbuf)>0x1000
'copy over runtime links
copy strptr(dbuf)+posbin[3],rbx,0xc00 '3k
endif
SetExecSpace()
'
end sub
......
......@@ -56,12 +56,12 @@ function multiassign(string*s, int *i,tp) as string
asgk=0
asgl=0
'
if tp>=htyp
asgs=macso(tp-htyp,1)
if tp>=typh
asgs=macso(tp-typh,1)
elseif tp>0x100
'
elseif tp>=0xe0
w2=mid(macso(tp-htyp,1),3,3)
w2=mid(macso(tp-typh,1),3,3)
if w2="bp-"
asgl=1 'LOCAL(ELSE GLOBAL) ARRAY
endif
......@@ -69,8 +69,8 @@ function multiassign(string*s, int *i,tp) as string
'
nextinstruct(s,i)
'
if (tp>=htyp)and(ascn=123)
w2=macso(tp-htyp,2) 'TYPE DEFAULT EXPRESSIONS
if (tp>=typh)and(ascn=123)
w2=macso(tp-typh,2) 'TYPE DEFAULT EXPRESSIONS
if w2
i++ : skiplspace(s,i)
string wt1 'sink
......@@ -110,8 +110,8 @@ end function
function expandexpr(string*s, int*i, typa1) as int
==================================================
function expandexpr(string*s, int*i, typx) as int
=================================================
'
int a,b,p,m,n,bg,ndo
string wr,wt,w1,w2,w3,w4,w5
......@@ -160,7 +160,7 @@ do
if ndo
i++ 'SKIP ')'
endif
a=typa1
a=typx
if a<=0 'DETERMINE TYPE FROM EXPRESSION
wt=w3
nsto=1 : wt=express(wt,1,0) : jn=0 : epfx="" : nsto=0
......@@ -455,7 +455,7 @@ function findop(int ty, *mo, string*name,*mthd) as int
int i,a,n,u
mthd=""
mo=0
u=ty-htyp
u=ty-typh
s=macso(u,1)
i=instrevn(-1,s,rmk+name+" ")
if i
......@@ -477,7 +477,7 @@ function findop(int ty, *mo, string*name,*mthd) as int
if a
mthd=name
w=macso(a,1)
mo=instr(w,rmk+mthd+" ") 'LOCATE OPERATOR / FUNCTION MACROMEMBER
mo=instrword(w,rmk+mthd) 'LOCATE OPERATOR / FUNCTION MACROMEMBER
if mo
mthd=ts+"_op."+qu+mthd+qu
else
......
'save
type azm
int v
end type
macro azm_op(a,b,c)
===================
'
macro .load(b,a)
mov eax,b.v
end macro
'
macro .+ (b,a)
add eax,b.v
end macro
macro .* (b,a)
imul eax,b.v
end macro
'
macro .save(b,a)
mov a.v,eax
end macro
'
end macro
'#recordof azm
'#recordof azm_op
function f()
azm a,b,c,d
#show a=b+(c*d)
end function
/*
'09:07 10/12/2018
$filename "c.exe"
uses ..\rtl64
long var=2
print string(var,"0")
*/
/*
'10:29 09/12/2018
'fix creating class in child macro
macro myclasses(a,b,c,d)
macro .create(a,b,c,d)
class a
sys bu
int n
int e
'
function constructor(b*c,int d)
e=d*sizeof b
bu=getmemory e
copy bu,@c,e
n=d
end function
'
function destructor()
freememory bu
end function
end class
end macro
end macro
#recordof myclasses
myclasses.create(cfloat,float,f,nf)
#recordof cfloat
*/
/*
Class StringBuf
===============
sys bu
int mx
int le
int qu
int wi
'
function constructor(string*s)
==============================
int ls=len s
wstring ws=s
qu=512
mx=qu+(ls*2)
le=ls
wi=2
bu=getmemory mx*2
copy bu,strptr(ws),ls*2
end function
'
function constructor(wstring*s)
===============================
int ls=len s
qu=512
mx=qu+(ls*2)
le=ls
wi=2
bu=getmemory mx*2
copy bu,strptr(s),ls*2
end function
'
function constructor(stringbuf*b)
=================================
le=b.le
mx=b.mx
wi=b.wi
qu=b.qu
bu=getmemory mx*2
copy bu,b.bu,le*2
end function
'
function destructor()
=====================
freememory bu
bu=0 : mx=0
end function
'
function primitive() as wstring
===============================
return left( cast(bstring2) bu, le)
end function
'
operator load(wstring*s)
========================
s=left( cast(bstring2) bu, le)
end function
'
operator load(stringbuf*a)
==========================
sys abu=a.bu
int amx=a.mx
if le>amx
amx=a.qu+(le*2)
abu=getmemory amx*2
copy abu,bu,le*2
freememory a.bu
a.bu=abu
a.mx=amx
else
copy a.bu,bu,le*2
end if
a.le=le
end operator
'
operator + (stringbuf*a)
========================
sys abu=a.bu
int amx=a.mx
if le+a.le>amx
amx+=a.qu+(le*2)
sys abu=getmemory amx*2
copy abu,a.bu,a.le*2
copy abu+(a.le*2),bu,le*2
freememory a.bu
a.bu=abu
a.mx=amx
else
copy abu+a.le*2,bu,le*2
end if
a.le+=le
end operator
end class
*/
/*
'07:01 05/12/2018
'TEST REDIM DESTRUCTORS
......@@ -2167,58 +2332,6 @@ finit
*/
/*
sub ddestructors(sys b,d,z,n)
=============================
sys i
sys s
'dual 32/64 direct
for i=1 to n
mov s,rsp
sub rsp,32
mov rcx,b
mov [rsp],rcx
call d
mov rsp,s
b+=z
next
end sub
sub nullify(sys p, int n)
=========================
mov rdx,p
mov ecx,n
(
mov byte [rdx],0
inc rdx
dec ecx
jg repeat
)
end function
function isnull(sys p, int n) as int
====================================
mov rdx,p
mov ecx,n
(
cmp byte [rdx],0
jnz exit
inc rdx
dec ecx
jg repeat
return 1
)
return 0
end function
print "ok"
*/
/*
extern lib "t.dll"
! hello()
......
No preview for this file type
......@@ -9,7 +9,7 @@
! stodata(string*s) as string
! arrayres(string*s, int*i, string*wr) as string
! procedures(string*s, int*i, string*wr) as string