Commit c9f7153b authored by John Spikowski's avatar John Spikowski

O2 Self Compile 20181211 Update

parent a2049b35
......@@ -21,6 +21,7 @@ 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)
23:14 10/12/2018 Fix Macro ops handling funcs in expressions (hlex owa)
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
......
......@@ -180,6 +180,23 @@
endif
ret
'
converterh: 'subroutine
=======================
m=typc
newcleanvar(owa,wr,m) 'new owa and wr
if findop(m,a,"constructor",w2)
if a
hlex+=w2+"("+owa+cm+w4")"+cr
else
hlex+=owa+".constructor("+w4+")"+cr
endif
endif
rps=1
w1=""
typ=typc
typa=typc
ret
'
'saveregacc: 'subroutine
=======================
'
......@@ -370,7 +387,7 @@
opo=op
op=0
nst++
w1=express(s,i,0) 'RECURSE
w1=express(s,i,typx) 'RECURSE
nst--
op=opo
'accum operand wg
......@@ -384,22 +401,8 @@
'
'TYPE CONVERSION REQUIRED
if typa<>typc
'type conversion
m=typc
newcleanvar(owa,wr,m) 'new owa and wr
if findop(m,a,"constructor",w2)
if a
hlex+=w2+"("+owa+cm+w4")"+cr
else
hlex+=owa+".constructor("+w4+")"+cr
endif
endif
rps=1
w1=""
typ=typc
typa=typc
gosub converterh
endif
'
endif
'
if typ>=typh
......@@ -706,9 +709,16 @@
goto doneprocs 'NOTIONAL RETURN TYPE
endif
'
if (typ>=typh)and(indt=0)
if (typc>=typh)and(typ>=typh)and(indt=0)
'
wr=wg
wt+=wp
'
'TYPE CONVERSION REQUIRED
if typ<>typc
w4=owa
gosub converterh
endif
hiex+=storecode(wp) 'preprocess
gosub operationsh
if ert
jmp fwd exitexpr
......@@ -3517,7 +3527,7 @@ function subsas(string*s, int*i, string*ur,*v, int igb) as int
if (indt=0)and(nobj=0)
'ALLOCATE RETURN VAR AND CLEAR IT
m=typ
newcleanvar(w5,w4,m) 'w5 not used
newcleanvar(owa,w4,m)
'
if (cc=2)or(cc=3)
w6="lea rdx,"+w4+cr+
......
......@@ -17,7 +17,7 @@
end extern
uses TimeUtil
$ o2version chr(34)+"0.1.0 2018-11-13T12:00:00"+chr(34)
$ o2version chr(34)+"0.1.0 2018-12-11T12:00:00"+chr(34)
'
'DEFINITIONS GROUP
'=================
......@@ -38,7 +38,7 @@
'
uses meta 'META-PROGRAMMING
uses decl 'DECLARATIVES
uses enco 'ENCODING FUNCTIONS
uses enco 'ASM ENCODING FUNCTIONS
uses expl 'LOWER EXPRESSIONS
uses expr 'HIGHER EXPRESSIONS
uses tran 'TOP TRANSLATION LAYER
......
'/*
'10:45 10/12/2018
'OPERATIONS USING CPU REGISTERS
'save
type azm
int v
......@@ -18,6 +21,10 @@ macro azm_op(a,b,c)
imul eax,b.v
end macro
'
macro ./ (b,a)
idiv eax,b.v
end macro
'
macro .save(b,a)
mov a.v,eax
end macro
......@@ -27,11 +34,43 @@ end macro
'#recordof azm
'#recordof azm_op
function f()
function f() as azm
===================
function.v=99
end function
function tt()
azm a,b,c,d
#show a=b+(c*d)
'#show a=b+(c/d)
'#show a=f()
#show a=b+c*(f()+d)
end function
'print 123
'*/
/*
'11:38 11/12/2018
'implement bycopy
$filename "c.exe"
'uses ..\rtl64
sub f(string *s){s+=s+s}
string s="ok"
'f s
f bycopy s
print s
*/
/*
'11:37 11/12/2018
'check literals passed byref
$filename "c.exe"
uses ..\rtl64
string f(string *s){s+=s+s : return s}
#show print f "ok"
*/
/*
'09:07 10/12/2018
$filename "c.exe"
......@@ -40,6 +79,237 @@ long var=2
print string(var,"0")
*/
/*
' 22:16 10/12/2018
' Od_Combbox.o2bas
' Owner drawn Combobox
' Thanxx to my boss Paul who is an inspiration in this work
$ filename "Od_Combbox.exe"
use rtl64
#lookahead
arrayc
' %review
uses O2Common
uses dialogs
' identifiers
% IDC_Combobox = 101
' The program logo icon is obtained from the resource file
' the 400 must corespondence to the 400 in the rc file
% IDI_LOGO 400
sys hDlg , hCombobox
' Will need this Array dimensioning macro
' otherwise results would be garbage
Dim_zstring ArrayCB , 20, 30
int i
string ArrayCB(20) : for i=1 to 20 : ArrayCB="" : next
'=======================
FUNCTION O2Main
Dialog( 150, 70, 160, 75, "Ownerdrawn ComboBox ", WS_CAPTION OR WS_SYSMENU )
' Add in the combo box
sys CBBStyle = WS_CHILD or WS_VSCROLL or WS_TABSTOP OR CBS_DROPDOWNLIST OR _
CBS_HASSTRINGS or CBS_OWNERDRAWFIXED
COMBOBOX( "" ,IDC_Combobox, 10, 10, 60, 50, CBBStyle, WS_EX_CLIENTEDGE or WS_EX_ACCEPTFILES , 0 )
sys ebStyle = WS_CHILDWINDOW or WS_VISIBLE or BS_DEFPUSHBUTTON or WS_DLGFRAME
CONTROL "Exit", IDCANCEL,"Button", ebStyle , 85, 35, 30, 14
hDlg = CreateModalDialog( 0, @DlgProc, 0 )
END FUNCTION
'============================
' Main callback function
Function DlgProc( hDlg, uint uMsg, sys wParam, lParam ) as sys callback
zstring SelString , wAnswer
Long jj , CBIndex
hCombobox = GetDlgItem(hDlg, IDC_Combobox)
SELECT CASE uMsg
CASE WM_INITDIALOG
' display the program icon
sys hInstance = GetModuleHandle(NULL)
sys hIcon = LoadIcon(hInstance, IDI_Logo)
'Set Icon to Main Window
SendMessage(hDlg, WM_SETICON, ICON_BIG, hIcon)
' Setup the combobox elements
BuildArrayCB
For jj = 1 to 20
SendMessage(hCombobox, CB_ADDSTRING, 0, ArrayCB[jj] )
Next jj
' set cursor to the first element of the combobox
SendMessage(hCombobox, CB_SETCURSEL, 0, 0)
CASE WM_ERASEBKGND
' added to display background color for the main window
' for a Light Yellow background
MainWindBGColor = 6
hBGDC = wParam
' Pass the DC of the region to be repaint
DrawGradient hBGDC
FUNCTION = 1
EXIT FUNCTION
CASE WM_COMMAND
SELECT CASE LOword(wParam)
CASE IDCANCEL
EndDialog( hDlg, null )
CASE IDC_Combobox
IF HIWORD(WPARAM) = CBN_SELENDOK THEN
' user selected something
CBindex = SendMessage(hComboBox, CB_GETCURSEL, 0, 0)
SendMessage(hComboBox, CB_GETLBTEXT, CBindex, @SelString)
wAnswer = TRIM(SelString)
Mbox " Selected : " + wAnswer , 0
END IF
END SELECT
CASE WM_DRAWITEM
' for owner drawn combo box
IF LOword(wParam) = IDC_Combobox THEN
OwnerDrwCombo hCombobox, WPARAM, LPARAM
END IF
END SELECT
END FUNCTION
'===================================
' Owner drawn procedure for the combo box
FUNCTION OwnerDrwCombo(sys BYVAL hWnd , sys BYVAL wParam , sys BYVAL lParam ) AS LONG
Zstring zTxt
RECT rct
DRAWITEMSTRUCT lpdis at lParam
IF lpdis.itemID = &HFFFFFFFF& THEN
'When it is an empty list -- just exit
EXIT FUNCTION
END IF
SELECT CASE lpdis.itemAction
CASE ODA_DRAWENTIRE, ODA_SELECT
'CLEAR BACKGROUND
IF ( lpdis.itemState AND ODS_SELECTED) = 0 OR _
( lpdis.itemState AND ODS_COMBOBOXEDIT) THEN
'When not selected
'text background
SetBkColor lpdis.hDC, O2c_AZURE
'text color
SetTextColor lpdis.hDC, GetSysColor( COLOR_WINDOWTEXT)
'clear background
FillRect lpdis.hDC, lpdis.rcItem,GetSysColorBrush( COLOR_WINDOW)
ELSE
' When the item is selected
' set the text background
SetBkColor lpdis.hDC, O2c_Light_Yellow
'set the text color
SetTextColor lpdis.hDC, O2c_MAGENTA
END IF
'Get the item text
SendMessage hWnd, CB_GETLBTEXT, lpdis.itemID, VARPTR(zTxt)
DrawText lpdis.hDC, zTxt, LEN(zTxt), lpdis.rcItem, _
DT_SINGLELINE OR DT_LEFT OR DT_VCENTER
' Focus rectangle and bullet must be drawn after the text
' otherwise these will overlap by the text
IF ( lpdis.itemState AND ODS_SELECTED) THEN
' when selected , set cordinates of bullet
' Draw the bullet pointer at the right end
' Note that you need to adjust these parameters to suit the
' size of each combobox and do some tests to fine tune
rct.Left = +106
rct.Right = lpdis.rcItem.Right + 25
rct.top = lpdis.rcItem.top +6
rct.bottom = lpdis.rcItem.bottom - 6
'Draw a round focus rectangle -- make it look like a bullet
RoundRect( lpdis.hDC, rct.Left, rct.top, rct.Right, rct.bottom, 48, 48)
'draw a focus rectangle around all
CALL DrawFocusRect( lpdis.hDC, lpdis.rcItem)
END IF
FUNCTION = TRUE
END SELECT
END FUNCTION
'====================================
Sub BuildArrayCB
' Setup the Combobox elements
' using ArrayCB
ArrayCB[1] = "One"
ArrayCB[2] = "Two"
ArrayCB[3] = "Three"
ArrayCB[4] = "Four"
ArrayCB[5] = "Five"
ArrayCB[6] = "Six"
ArrayCB[7] = "Seven"
ArrayCB[8] = "Eight"
ArrayCB[9] = "Nine"
ArrayCB[10] = "Ten"
ArrayCB[11] = "Eleven"
ArrayCB[12] = "Twelve"
ArrayCB[13] = "Thirteen"
ArrayCB[14] = "Fourteen"
ArrayCB[15] = "Fifteen"
ArrayCB[16] = "Sixteen"
ArrayCB[17] = "Seventeen"
ArrayCB[18] = "Eighteen"
ArrayCB[19] = "Nineteen"
ArrayCB[20] = "Twenty"
End Sub
'----------------------------------
' Program starts
init_common_controls()
O2Main
*/
/*
'10:29 09/12/2018
'fix creating class in child macro
......
No preview for this file type
......@@ -2635,6 +2635,16 @@ function pword(string*s, int*i) as string
if wr="byval"
bvg=1 : ty=cpuw : continue do
endif
if wr="bycopy"
wr=wordahead(s,i)
wr=mword(wr,1)
wr=newtmpvar(sog)
a=i : captsx(s,i)
hiex+=wr+"="+mid(s,a,i-a)+cr
rps=1
inserts(s,wr,i)
continue do
endif
endif
'
'DETECT EXPLICIT CASTING
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment