cvsuser 03/06/08 10:25:26
Modified: languages/BASIC/compiler COMP_expressions.pm
COMP_parsefuncs.pm RT_initialize.pasm
RT_platform.pasm RT_platform_ANSIscreen.pasm
RT_platform_win32.pasm compile.pl
Log:
Screen libraries work again, at least under Win32
Revision Changes Path
1.10 +6 -1 parrot/languages/BASIC/compiler/COMP_expressions.pm
Index: COMP_expressions.pm
===================================================================
RCS file: /cvs/public/parrot/languages/BASIC/compiler/COMP_expressions.pm,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -w -r1.9 -r1.10
--- COMP_expressions.pm 8 Jun 2003 14:30:24 -0000 1.9
+++ COMP_expressions.pm 8 Jun 2003 17:25:25 -0000 1.10
@@ -273,7 +273,12 @@
CODE
},
'.' => "NULL",
- 'mod' => "MOD",
+ 'mod' => sub {
+ my($a1,$a2,$result)[EMAIL PROTECTED];
+ return(<<CODE, $result);
+ cmod $result, $a2, $a1
+CODE
+ },
'^' => "POW",
);
%opsubs=(%opsubs,
1.13 +47 -66 parrot/languages/BASIC/compiler/COMP_parsefuncs.pm
Index: COMP_parsefuncs.pm
===================================================================
RCS file: /cvs/public/parrot/languages/BASIC/compiler/COMP_parsefuncs.pm,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -w -r1.12 -r1.13
--- COMP_parsefuncs.pm 8 Jun 2003 14:30:24 -0000 1.12
+++ COMP_parsefuncs.pm 8 Jun 2003 17:25:25 -0000 1.13
@@ -257,92 +257,73 @@
sub parse_locate { # locate x,y | locate x | locate ,y
my($x,$y);
my(@e2);
- @e=();
+ my($resulty, $typey, @codey);
+ my($resultx, $typex, @codex);
if ($type[NEXT] =~ /PUN/) { # Y only
feedme();
- @e2=EXPRESSION(); # Y (only)
+ ($resulty, $typey, @codey)=EXPRESSION(); # Y (only)
} else {
- @e=EXPRESSION(); # X
+ ($resultx, $typex, @codex)=EXPRESSION(); # X
if ($type[NEXT] =~ /PUN/) {
feedme();
- @e2=EXPRESSION();
+ ($resulty, $typey, @codey)=EXPRESSION();
}
}
- if (@e and @e2) { # X and Y
- print CODE<<XANDY;
[EMAIL PROTECTED] bsr DEREF
- bsr CAST_TO_INT
- set P7, P6
- pushp
[EMAIL PROTECTED] bsr DEREF # Got both
- bsr CAST_TO_INT
- save P6
- popp
- restore P6
- bsr SCREEN_LOCATE
+ if (@codey and @codex) { # X and Y
+
+ push @{$code{$seg}->{code}},<<XANDY;
[EMAIL PROTECTED]
+ set \$N100, $resulty
[EMAIL PROTECTED]
+ set \$N101, $resultx
+ .arg \$N100
+ .arg \$N101
+ call _screen_locate
XANDY
- } elsif (@e2 and not @e) {
- print CODE<<YNOTX;
[EMAIL PROTECTED] bsr DEREF
- bsr CAST_TO_INT
- bsr SCREEN_SETYCUR
+ } elsif (@codey and not @codex) {
+ push @{$code{$seg}->{code}},<<YNOTX;
[EMAIL PROTECTED] .arg $resulty # Broke!
+ call _screen_locate
YNOTX
- } elsif (@e and not @e2) {
- print CODE<<XNOTY;
[EMAIL PROTECTED] bsr DEREF
- bsr CAST_TO_INT
- bsr SCREEN_SETXCUR
+ } elsif (@codex and not @codey) {
+ push @{$code{$seg}->{code}},<<XNOTY;
[EMAIL PROTECTED] .arg $resultx # Broke!
+ call _screen_locate
XNOTY
}
}
sub parse_color {
my($f,$b);
- my(@e2);
- @e=();
+ my($resultb, $typeb, @codeb);
+ my($resultf, $typef, @codef);
+
if ($type[NEXT] =~ /PUN/) { # Back only
feedme();
- @e2=EXPRESSION(); # Back (only)
+ ($resultb, $typeb, @codeb)=EXPRESSION(); # Back (only)
} else {
- @e=EXPRESSION(); # Fore
+ ($resultf, $typef, @codef)=EXPRESSION(); # Fore
if ($type[NEXT] =~ /PUN/) {
feedme();
- @e2=EXPRESSION();
+ ($resultb, $typeb, @codeb)=EXPRESSION();
}
}
- if (@e and @e2) { # F and B
-print CODE<<FANDB;
[EMAIL PROTECTED] bsr DEREF
- bsr CAST_TO_INT
- set P7, P6
- pushp
[EMAIL PROTECTED] bsr DEREF # Got both
- bsr CAST_TO_INT
- save P6
- popp
- restore P6
- bsr SCREEN_COLOR
+ if (@codeb and @codef) { # F and B
+ push @{$code{$seg}->{code}},<<FANDB;
[EMAIL PROTECTED] set \$N100, $resultb
[EMAIL PROTECTED] set \$N101, $resultf
+ .arg \$N100
+ .arg \$N101
+ call _screen_color
FANDB
- } elsif (@e2 and not @e) {
- print CODE<<BNOTF;
- bsr SCREEN_GETFORE # B and no F
- set P7, P6
[EMAIL PROTECTED] bsr DEREF
- bsr CAST_TO_INT
- bsr SCREEN_COLOR
+ } elsif (@codeb and not @codef) {
+ push @{$code{$seg}->{code}},<<BNOTF;
[EMAIL PROTECTED] .arg $resultb
+ call _screen_color # Broke!
BNOTF
- } elsif (@e and not @e2) {
- print CODE<<FNOTB;
- bsr SCREEN_GETBACK # F and no B
- set P8, P6
- pushp
[EMAIL PROTECTED] bsr DEREF
- bsr CAST_TO_INT
- save P6
- popp
- restore P6
- set P7, P6
- set P6, P8
- bsr SCREEN_COLOR
+ } elsif (@codef and not @codeb) {
+ push @{$code{$seg}->{code}},<<FNOTB;
[EMAIL PROTECTED] .arg $resultf
+ call _screen_color # Broke!
FNOTB
}
}
@@ -350,8 +331,8 @@
if (! $type[NEXT] =~ /STMT|COMM|COMP/) { # No arg version
@e=EXPRESSION();
}
- print CODE <<CLS;
- bsr SCREEN_CLEAR
+ push @{$code{$seg}->{code}},<<CLS;
+ call _screen_clear
CLS
feedme();
}
1.5 +1 -71 parrot/languages/BASIC/compiler/RT_initialize.pasm
Index: RT_initialize.pasm
===================================================================
RCS file: /cvs/public/parrot/languages/BASIC/compiler/RT_initialize.pasm,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -w -r1.4 -r1.5
--- RT_initialize.pasm 6 Jun 2003 21:25:56 -0000 1.4
+++ RT_initialize.pasm 8 Jun 2003 17:25:25 -0000 1.5
@@ -23,78 +23,8 @@
JUMPLABEL = ""
call _data
-
- # Globals of note:
- # P8, P9 -- Working stacks for Postfix Machine
- #
- # Generally, anything above x14 belongs to BASIC for future use.
- #
- #
- # Set up new program space
- #
- #sweepoff
- #collectoff
- #set I25, -1 # Current stack frame
- #new P10, .PerlArray # Variables
- #new P11, .PerlArray # Loop memory
-
- #new P24, .PerlHash # Platform-specific storage
- #bsr PLATFORM_SETUP # FIXME
- #new P25, .PerlHash # Debugger's space
-
-
- #new P17, .PerlHash # File Descriptors, key is BASIC data is FD
- # data is 0 (closed)
or Ix FD
-
- #bsr DATA_SETUP
- #bsr DEBUG_INIT
- #bsr NEWFRAME
+ call _platform_setup
call _basicmain
end
-
- # Start a new stack frame
-NEWFRAME:
- print "ERROR, NO LONGER USED"
- end
-# inc I25
-# new P0, .PerlHash
-# new P1, .PerlArray
-# set P0["expr"], P1
-# new P1, .PerlArray
-# set P0["exprwork"], P1
-# new P1, .PerlHash
-# set P0["expr_lhs"], 0
-#
-# set P0["STRING"], P1
-# new P1, .PerlHash
-# set P0["FLO"], P1
-# new P1, .PerlHash
-# set P0["INT"], P1
-# new P1, .PerlHash
-# set P0["USER"], P1
-# new P1, .PerlHash
-# set P0["ARRAY"], P1
-#
-# new P1, .PerlHash
-# set P0["SELECTS"], P1
-#
-# ne I25, 0, NEWF
-# new P1, .PerlHash
-# set P0["types"], P1
-#
-#NEWF: set P10[I25], P0
-# new P1, .PerlHash
-# new P0, .PerlHash
-# new P2, .PerlHash
-# set P0["INT"], P2
-# new P2, .PerlHash
-# set P0["FLO"], P2
-# set P1["FOR"], P0
-# set P11[I25], P1
-# ret
-#ENDFRAME:
-# set P10, I25
-# dec I25
-# ret
.end
1.10 +94 -65 parrot/languages/BASIC/compiler/RT_platform.pasm
Index: RT_platform.pasm
===================================================================
RCS file: /cvs/public/parrot/languages/BASIC/compiler/RT_platform.pasm,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -w -r1.9 -r1.10
--- RT_platform.pasm 6 Jun 2003 21:25:56 -0000 1.9
+++ RT_platform.pasm 8 Jun 2003 17:25:25 -0000 1.10
@@ -1,71 +1,100 @@
- # Platform-Specific stuff
- # There needs to be a dispatcher to make the runtime do various things
- # based on platform type.
-
- # Do anything here that needs to be done for your platform to run properly
- # If Win32, use those routines
- # Otherwise assume an ANSI terminal
.include "RT_platform_win32.pasm"
.include "RT_platform_ANSIscreen.pasm"
-PLATFORM_SETUP:
- sysinfo S0, 4
- eq S0, "MSWin32", WIN32_SETUP
- branch ANSI_SETUP
-
-SCREEN_CLEAR:
- set I14, 0 # Column position for tab()
- sysinfo S0, 4
- eq S0, "MSWin32", WIN32_SCREEN_CLEAR
- branch ANSI_SCREEN_CLEAR
-
-SCREEN_SETXCUR:
- set I1, P6[.VALUE]
- sysinfo S0, 4
- eq S0, "MSWin32", WIN32_SCREEN_SETXCUR
- branch ANSI_SCREEN_SETXCUR
-
-SCREEN_SETYCUR:
- set I1, P6[.VALUE]
- sysinfo S0, 4
- eq S0, "MSWin32", WIN32_SCREEN_SETYCUR
- branch ANSI_SCREEN_SETYCUR
-
- # X in P7, Y in P6
-SCREEN_LOCATE:
- set I1, P6[.VALUE]
- set I0, P7[.VALUE]
- set I14, I1
+.sub _platform_setup # void platform_setup(void)
+ saveall
sysinfo S0, 4
- eq S0, "MSWin32", WIN32_SCREEN_LOCATE
- branch ANSI_SCREEN_LOCATE
-
-SCREEN_COLOR:
- set I1, P6[.VALUE]
- set I0, P7[.VALUE]
- sysinfo S0, 4
- eq S0, "MSWin32", WIN32_SCREEN_COLOR
- branch ANSI_SCREEN_COLOR
-
-
-# Problem in ANSI
-SCREEN_GETFORE:
- sysinfo S0, 4
- set I0, 0
- ne S0, "MSWin32", SCREEN_GETFORE_NOTWIN
- bsr WIN32_SCREEN_GETFORE
-SCREEN_GETFORE_NOTWIN:
- new P6, .PerlArray
- set P6[.TYPE], "INT"
- set P6[.VALUE], I0
+ ne S0, "MSWin32", NOTWIN
+ call _win32_setup
+ branch END
+NOTWIN: call _ansi_setup
+END: restoreall
+ ret
+.end
+.sub _screen_clear
+ saveall
+ find_global $P0, "PRINTCOL"
+ set $P0["value"], 0
+ store_global "PRINTCOL", $P0
+ sysinfo S0, 4
+ ne S0, "MSWin32", NOTWIN
+ call _win32_screen_clear
+ branch END
+NOTWIN: call _ansi_screen_clear
+END: restoreall
ret
+.end
-SCREEN_GETBACK:
- sysinfo S0, 4
- set I0, 0
- ne S0, "MSWin32", SCREEN_GETBACK_NOTWIN
- bsr WIN32_SCREEN_GETBACK
-SCREEN_GETBACK_NOTWIN:
- new P6, .PerlArray
- set P6[.TYPE], "INT"
- set P6[.VALUE], I0
+#SCREEN_SETXCUR:
+# set I1, P6[.VALUE]
+# sysinfo S0, 4
+# eq S0, "MSWin32", WIN32_SCREEN_SETXCUR
+# branch ANSI_SCREEN_SETXCUR
+#
+#SCREEN_SETYCUR:
+# set I1, P6[.VALUE]
+# sysinfo S0, 4
+# eq S0, "MSWin32", WIN32_SCREEN_SETYCUR
+# branch ANSI_SCREEN_SETYCUR
+#
+# # X in P7, Y in P6
+.sub _screen_locate # void screen_locate(float x, float y)
+ saveall
+ .param float xf
+ .param float yf
+ .local int x
+ .local int y
+ .local string sys
+ set x, xf
+ set y, yf
+ sysinfo sys, 4
+
+ .arg y
+ .arg x
+ ne sys, "MSWin32", NOTWIN
+ call _WIN32_SCREEN_LOCATE
+ branch END
+NOTWIN: call _ANSI_SCREEN_LOCATE
+END: restoreall
+ ret
+.end
+.sub _screen_color # void screen_color(float fore, float back)
+ saveall
+ .param float foref
+ .param float backf
+ .local int fore
+ .local int back
+ .local string sys
+ set back, backf
+ set fore, foref
+ .arg back
+ .arg fore
+ sysinfo sys, 4
+ ne sys, "MSWin32", NOTWIN
+ call _WIN32_SCREEN_COLOR
+ branch END
+NOTWIN: call _ANSI_SCREEN_COLOR
+END: restoreall
ret
+.end
+## Problem in ANSI
+#SCREEN_GETFORE:
+# sysinfo S0, 4
+# set I0, 0
+# ne S0, "MSWin32", SCREEN_GETFORE_NOTWIN
+# bsr WIN32_SCREEN_GETFORE
+#SCREEN_GETFORE_NOTWIN:
+# new P6, .PerlArray
+# set P6[.TYPE], "INT"
+# set P6[.VALUE], I0
+# ret
+#
+#SCREEN_GETBACK:
+# sysinfo S0, 4
+# set I0, 0
+# ne S0, "MSWin32", SCREEN_GETBACK_NOTWIN
+# bsr WIN32_SCREEN_GETBACK
+#SCREEN_GETBACK_NOTWIN:
+# new P6, .PerlArray
+# set P6[.TYPE], "INT"
+# set P6[.VALUE], I0
+# ret
1.4 +92 -93 parrot/languages/BASIC/compiler/RT_platform_ANSIscreen.pasm
Index: RT_platform_ANSIscreen.pasm
===================================================================
RCS file: /cvs/public/parrot/languages/BASIC/compiler/RT_platform_ANSIscreen.pasm,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -w -r1.3 -r1.4
--- RT_platform_ANSIscreen.pasm 13 May 2003 02:13:41 -0000 1.3
+++ RT_platform_ANSIscreen.pasm 8 Jun 2003 17:25:25 -0000 1.4
@@ -1,113 +1,112 @@
- # ANSIScreen Specific routines
- # P24 is ours to use, but I don't really know why we'd need it.
-.constant BLACK 0
-.constant RED 1
-.constant GREEN 2
-.constant YELLOW 3
-.constant BLUE 4
-.constant MAGENTA 5
-.constant CYAN 6
-.constant WHITE 7
-ANSI_SETUP:
- new P24, .PerlHash
- new P0, .PerlArray
- set P0[0], .BLACK
- set P0[1], .BLUE
- set P0[2], .GREEN
- set P0[3], .CYAN
- set P0[4], .RED
- set P0[5], .MAGENTA
- set P0[6], .YELLOW
- set P0[7], .WHITE
- set P24["fgcolors"], P0
- new P0, .PerlArray
- set P0[0], .BLACK
- set P0[1], .BLUE
- set P0[2], .GREEN
- set P0[3], .CYAN
- set P0[4], .RED
- set P0[5], .MAGENTA
- set P0[6], .YELLOW
- set P0[7], .WHITE
- set P0[8], .BLACK
- set P0[9], .BLUE
- set P0[10], .GREEN
- set P0[11], .CYAN
- set P0[12], .RED
- set P0[13], .MAGENTA
- set P0[14], .YELLOW
+.const int BLACK = 0
+.const int RED = 1
+.const int GREEN = 2
+.const int YELLOW = 3
+.const int BLUE = 4
+.const int MAGENTA= 5
+.const int CYAN = 6
+.const int WHITE = 7
+.sub _ansi_setup
+ saveall
+ $P0=new PerlArray
+ set P0[0], BLACK
+ set P0[1], BLUE
+ set P0[2], GREEN
+ set P0[3], CYAN
+ set P0[4], RED
+ set P0[5], MAGENTA
+ set P0[6], YELLOW
+ set P0[7], WHITE
+ store_global "ANSI_fgcolors", $P0
+
+ $P0=new PerlArray
+ set P0[0], BLACK
+ set P0[1], BLUE
+ set P0[2], GREEN
+ set P0[3], CYAN
+ set P0[4], RED
+ set P0[5], MAGENTA
+ set P0[6], YELLOW
+ set P0[7], WHITE
+ set P0[8], BLACK
+ set P0[9], BLUE
+ set P0[10], GREEN
+ set P0[11], CYAN
+ set P0[12], RED
+ set P0[13], MAGENTA
+ set P0[14], YELLOW
set P0[15], 8
- set P24["bgcolors"], P0
+ store_global "ANSI_bgcolors", $P0
+ restoreall
ret
-
-ANSI_SCREEN_CLEAR:
+.end
+.sub _ansi_screen_clear
print "\e[2J"
print "\e[H"
ret
-
-# These don't work exactly right. ANSI would require that I send
-# \e[6n and read the input stream for a \e[row;colR reply from the
-# terminal. I *really* can't do that until IO is fixed, because STDIN
-# is line-buffered and asking the user to press return after each cursor
-# positioning is lame.
-ANSI_SCREEN_SETXCUR:
- print "\e[;"
- print I1
- print "H"
- ret
-
-ANSI_SCREEN_SETYCUR:
- print "\e["
- print I1
- print ";H"
- ret
-
- # I0,I1
- # QB origin is 1,1
-ANSI_SCREEN_LOCATE:
+.end
+.sub _ANSI_SCREEN_LOCATE # void ansi_screen_locate (int x, int y)
+ saveall
+ .param int x
+ .param int y
print "\e["
- print I0
+ print x
print ";"
- print I1
+ print y
print "H"
+ restoreall
ret
-
-# QB.exe
-# 0 = black 4 = red 8 = grey 12 = light red
-# 1 = blue 5 = magenta 9 = light blue 13 = light magenta
-# 2 = green 6 = brown 10 = light green 14 = yellow
-# 3 = cyan 7 = white 11 = light cyan 15 = bright white
-
-ANSI_SCREEN_COLOR:
- #print "\e[m"
- #print I0
- #print " "
+.end
+## These don't work exactly right. ANSI would require that I send
+## \e[6n and read the input stream for a \e[row;colR reply from the
+## terminal. I *really* can't do that until IO is fixed, because STDIN
+## is line-buffered and asking the user to press return after each cursor
+## positioning is lame.
+#ANSI_SCREEN_SETXCUR:
+# print "\e[;"
+# print I1
+# print "H"
+# ret
+#
+#ANSI_SCREEN_SETYCUR:
+# print "\e["
#print I1
- #print " "
- #bsr ANSI_SCREEN_COLOR2
+# print ";H"
+# ret
+#
+# # I0,I1
+# # QB origin is 1,1
+
+## QB.exe
+## 0 = black 4 = red 8 = grey 12 = light red
+## 1 = blue 5 = magenta 9 = light blue 13 = light magenta
+## 2 = green 6 = brown 10 = light green 14 = yellow
+## 3 = cyan 7 = white 11 = light cyan 15 = bright white
+#
+.sub _ANSI_SCREEN_COLOR # void ansi_screen_color(int fg, int bg)
+ saveall
+ .param int fore
+ .param int back
print "\e"
- bsr ANSI_SCREEN_COLOR2
- ret
-
-
- # foreground in I0
- # background in I1
-ANSI_SCREEN_COLOR2:
+# # foreground in I0
+# # background in I1
print "[0;"
- set P0, P24["fgcolors"]
- lt I0, 8, ANSI_FG
- sub I0, I0, 8
+ find_global $P0, "ANSI_fgcolors"
+ lt fore, 8, ANSI_FG
+ sub fore, fore, 8
print "1;" # Turn on high intensity
-ANSI_FG: set I3, P0[I0]
+ANSI_FG: set $I3, $P0[fore]
print "3"
- print I3
+ print $I3
print ";"
# Background
-ANSI_BG:set P0, P24["bgcolors"]
- set I3, P0[I1]
+ANSI_BG:find_global $P0, "ANSI_bgcolors"
+ set $I3, P0[back]
print "4"
- print I3
+ print $I3
print "m"
+ restoreall
ret
+.end
1.8 +178 -139 parrot/languages/BASIC/compiler/RT_platform_win32.pasm
Index: RT_platform_win32.pasm
===================================================================
RCS file: /cvs/public/parrot/languages/BASIC/compiler/RT_platform_win32.pasm,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -w -r1.7 -r1.8
--- RT_platform_win32.pasm 13 May 2003 00:15:04 -0000 1.7
+++ RT_platform_win32.pasm 8 Jun 2003 17:25:25 -0000 1.8
@@ -1,89 +1,102 @@
- # Win32 Specific routines
-.constant SIZEOF_CONSOLE_SCREEN_BUFFER_INFO 22
-.constant SIZEOF_DWORD 4
-
-WIN32_SETUP:
- noop
-WIN32_CONSOLE_SETUP:
+.const int SIZEOF_CONSOLE_SCREEN_BUFFER_INFO = 22
+.const int SIZEOF_DWORD = 4
+.sub _win32_setup # void win32_setup(void)
+ saveall
loadlib P1, "kernel32.dll"
dlfunc P0, P1, "GetStdHandle", "pi"
set I0, 1
set I5, -11
invoke
- set P24["kernel32"], P1
- set P24["handle"], P5
- new P0, .PerlHash
- set P24["console"], P0
- bsr WIN32_CONSOLE_INFO
- ret
-
-WIN32_CONSOLE_INFO:
- pushi
- set P1, P24["kernel32"] # 65
+ store_global "kernel32", P1
+ store_global "Win32handle", P5
+ $P0= new PerlHash
+ store_global "Win32console", $P0
+ call _WIN32_CONSOLE_INFO
+ restoreall
+ ret
+.end
+.sub _WIN32_CONSOLE_INFO # void WIN32_CONSOLE_INFO(void)
+ saveall
+ find_global P1, "kernel32"
dlfunc P0, P1, "GetConsoleScreenBufferInfo", "ipp"
- set P5, P24["handle"]
- new P6, .ManagedStruct
- set P6, .SIZEOF_CONSOLE_SCREEN_BUFFER_INFO
+ find_global P5, "Win32handle"
+ P6=new ManagedStruct
+ set P6, SIZEOF_CONSOLE_SCREEN_BUFFER_INFO
set I0, 1
invoke
set P5, P6
- set P0, P24["console"]
- set I0, 0 # dwSize.X
- bsr UMS_GET_SHORT
- set P0["xbuf"], I1
- set I0, 2 # dwSize.Y
- bsr UMS_GET_SHORT
- set P0["ybuf"], I1
- set I0, 4 # dwCursorPosition.X
- bsr UMS_GET_SHORT
- inc I1
- set P0["curx"], I1
- set I0, 6 # dwCursorPosition.Y
- bsr UMS_GET_SHORT
- inc I1
- set P0["cury"], I1
- set I1, P5[8]
- set P0["attr"], I1 # wAttributes
- popi
- ret
-
- # P5 ManagedStruct
- # I0 offset in UMS
- # I1 return
-UMS_GET_SHORT:
- pushi
- set I2, P5[I0]
- inc I0
- set I3, P5[I0]
- shl I3, I3, 8
- add I3, I3, I2
- save I3
- popi
- restore I1
- ret
-
-WIN32_SCREEN_CLEAR:
- bsr WIN32_CONSOLE_CLEAR
- bsr WIN32_CONSOLE_HOME
- ret
+ find_global P0, "Win32console"
-WIN32_CONSOLE_HOME:
- set P2, P24["kernel32"]
+ .arg P5
+ .arg 0 # dwSize.X
+ call _UMS_GET_SHORT
+ .result $I1
+ set P0["xbuf"], $I1
+
+ .arg P5
+ .arg 2 # dwSize.Y
+ call _UMS_GET_SHORT
+ .result $I1
+ set P0["ybuf"], $I1
+
+ .arg P5
+ .arg 4
+ call _UMS_GET_SHORT
+ .result $I1
+ inc $I1
+ set P0["curx"], $I1
+
+ .arg P5
+ .arg 4
+ call _UMS_GET_SHORT
+ .result $I1
+ inc $I1
+ set P0["cury"], $I1
+
+ set $I1, P5[8]
+ set P0["attr"], $I1 # wAttributes
+ restoreall
+ ret
+.end
+.sub _UMS_GET_SHORT # int value ums_get_short(int offset, ManagedStruct
buf)
+ saveall
+ .param int offset
+ .param ManagedStruct buf
+ set $I2, buf[offset]
+ inc offset
+ set $I3, buf[offset]
+ shl $I3, $I3, 8
+ add $I3, $I3, $I2
+ .return $I3
+ restoreall
+ ret
+.end
+.sub _win32_screen_clear # void _WIN32_SCREEN_CLEAR(void)
+ call _WIN32_CONSOLE_CLEAR
+ call _WIN32_CONSOLE_HOME
+ ret
+.end
+.sub _WIN32_CONSOLE_HOME # void Win32_console_home(void)
+ saveall
+ find_global P2, "kernel32"
dlfunc P0, P2, "SetConsoleCursorPosition", "ipi"
set I0, 1
- set P5, P24["handle"]
+ find_global P5, "Win32handle"
set I5, 0
invoke
+ restoreall
ret
+.end
-WIN32_CONSOLE_CLEAR:
- set P1, P24["console"]
- set P2, P24["kernel32"]
+.sub _WIN32_CONSOLE_CLEAR # void Win32_console_clear(void)
+ saveall
+ find_global P1, "Win32console"
+ find_global P2, "kernel32"
dlfunc P0, P2, "FillConsoleOutputCharacterA", "ipcilp"
set I0, 1
- set P5, P24["handle"]
- new P6, .ManagedStruct
- set P6, .SIZEOF_DWORD
+ find_global P5, "Win32handle"
+ P6=new ManagedStruct
+ set P6, SIZEOF_DWORD
set I5, 32 # Char (space)
set I1, P1["xbuf"]
set I2, P1["ybuf"]
@@ -94,60 +107,82 @@
# in effect.
dlfunc P0, P2, "FillConsoleOutputAttribute", "ipiilp"
set I0, 1
- set P5, P24["handle"] # Handle
-
- new P6, .ManagedStruct
- set P6, .SIZEOF_DWORD
+ find_global P5, "Win32handle"
+ P6= new ManagedStruct
+ set P6, SIZEOF_DWORD
set I5, P1["attr"] # Attrib
set I1, P1["xbuf"]
set I2, P1["ybuf"]
mul I6, I1, I2 # Length
set I7, 0 # Coords
-
invoke
+ restoreall
ret
-
-WIN32_SCREEN_FINDPOS: # Find the X,Y position on the screen
- bsr WIN32_CONSOLE_INFO
- ret
-WIN32_SCREEN_GETXCUR:
- set P1, P24["console"]
- set I0, P1["curx"]
- ret
-WIN32_SCREEN_GETYCUR:
- set P1, P24["console"]
- set I0, P1["cury"]
- ret
-
- # Call with I1 as the Y
-WIN32_SCREEN_SETXCUR:
- bsr WIN32_SCREEN_FINDPOS
- bsr WIN32_SCREEN_GETYCUR
- bsr WIN32_SCREEN_LOCATE
- ret
- # Call with I1 as the X
-WIN32_SCREEN_SETYCUR:
- set I2, I1
- bsr WIN32_SCREEN_FINDPOS
- bsr WIN32_SCREEN_GETXCUR
- set I1, I0
- set I0, I2
- bsr WIN32_SCREEN_LOCATE
- ret
-
-WIN32_SCREEN_LOCATE:
- dec I0 # 1,1 is the origin in QuickBASIC
- dec I1
- set I5, I0
+.end
+.sub _WIN32_SCREEN_FINDPOS # void Win32_screen_findpos(void)
+ call _WIN32_CONSOLE_INFO
+ ret
+.end
+.sub _WIN32_SCREEN_GETXCUR # int win32_screen_getxcur(void)
+ saveall
+ find_global P1, "Win32console"
+ set $I0, P1["curx"]
+ .return $I0
+ restoreall
+ ret
+.end
+.sub _WIN32_SCREEN_GETYCUR # int win32_screen_getycur(void)
+ saveall
+ find_global P1, "Win32console"
+ set $I0, P1["cury"]
+ .return $I0
+ restoreall
+ ret
+.end
+.sub _WIN32_SCREEN_SETXCUR # void win32_screen_setxcur(int x)
+ saveall
+ .param int x
+ .local int y
+ call _WIN32_SCREEN_FINDPOS
+ call _WIN32_SCREEN_GETYCUR
+ .result y
+ .arg y
+ .arg x
+ call _WIN32_SCREEN_LOCATE
+ restoreall
+ ret
+.end
+.sub _WIN32_SCREEN_SETYCUR # void win32_screen_setycur(int y)
+ saveall
+ .param int y
+ .local int x
+ call _WIN32_SCREEN_FINDPOS
+ call _WIN32_SCREEN_GETXCUR
+ .result x
+ .arg y
+ .arg x
+ call _WIN32_SCREEN_LOCATE
+ restoreall
+ ret
+.end
+.sub _WIN32_SCREEN_LOCATE # void win32_screen_locate(int x, int y)
+ saveall
+ .param int x
+ .param int y
+ dec x
+ dec y
+ set I5, x
shl I5, I5, 16
- add I5, I5, I1
- set P1, P24["console"]
- set P2, P24["kernel32"]
+ add I5, I5, y
+ find_global P1, "Win32console"
+ find_global P2, "kernel32"
dlfunc P0, P2, "SetConsoleCursorPosition", "ipi"
set I0, 1
- set P5, P24["handle"]
+ find_global P5, "Win32handle"
invoke
+ restoreall
ret
+.end
#SCREEN Mode 0 Syntax: COLOR [foreground][,[background][,border]]
# � foreground is the text color (range = 0-31, with 16-31 blinking)
@@ -157,35 +192,39 @@
# 1 = blue 5 = magenta 9 = light blue 13 = light magenta
# 2 = green 6 = brown 10 = light green 14 = yellow
# 3 = cyan 7 = white 11 = light cyan 15 = bright white
-.constant FOREGROUND_BLUE 1
-.constant FOREGROUND_GREEN 2
-.constant FOREGROUND_RED 4
-.constant FOREGROUND_INTENSITY 8
-.constant BACKGROUND_BLUE 16
-.constant BACKGROUND_GREEN 32
-.constant BACKGROUND_RED 64
-.constant BACKGROUND_INTENSITY 128
-WIN32_SCREEN_GETFORE:
- set P1, P24["console"]
- set I0, P1["attr"]
- band I0, I0, 15
- ret
-WIN32_SCREEN_GETBACK:
- set P1, P24["console"]
- set I0, P1["attr"]
- shr I0, I0, 4
- ret
- # Call with the foreground in I0
- # background in I1
- # "border" is not obeyed here.
-WIN32_SCREEN_COLOR:
- shl I5, I1, 4
- add I5, I5, I0
- set P1, P24["console"]
- set P2, P24["kernel32"]
+.const int FOREGROUND_BLUE = 1
+.const int FOREGROUND_GREEN = 2
+.const int FOREGROUND_RED = 4
+.const int FOREGROUND_INTENSITY = 8
+.const int BACKGROUND_BLUE = 16
+.const int BACKGROUND_GREEN = 32
+.const int BACKGROUND_RED = 64
+.const int BACKGROUND_INTENSITY = 128
+#WIN32_SCREEN_GETFORE:
+# set P1, P24["console"]
+# set I0, P1["attr"]
+# band I0, I0, 15
+# ret
+#WIN32_SCREEN_GETBACK:
+# set P1, P24["console"]
+# set I0, P1["attr"]
+# shr I0, I0, 4
+# ret
+# # Call with the foreground in I0
+# # background in I1
+# # "border" is not obeyed here.
+.sub _WIN32_SCREEN_COLOR # void Win32_screen_color(int fore, int back)
+ saveall
+ .param int fore
+ .param int back
+ shl I5, back, 4
+ add I5, I5, fore
+ find_global P2, "kernel32"
dlfunc P0, P2, "SetConsoleTextAttribute", "ipi"
- set P5, P24["handle"]
+ find_global P5, "Win32handle"
set I0, 1
invoke
- bsr WIN32_CONSOLE_INFO # refresh this.
+ call _WIN32_CONSOLE_INFO # refresh this.
+ restoreall
ret
+.end
1.7 +1 -1 parrot/languages/BASIC/compiler/compile.pl
Index: compile.pl
===================================================================
RCS file: /cvs/public/parrot/languages/BASIC/compiler/compile.pl,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -w -r1.6 -r1.7
--- compile.pl 8 Jun 2003 14:30:24 -0000 1.6
+++ compile.pl 8 Jun 2003 17:25:25 -0000 1.7
@@ -108,7 +108,7 @@
.include "RT_aggregates.pasm"
.include "RT_support.pasm"
.include "RT_io.pasm"
-#.include "RT_platform.pasm"
+.include "RT_platform.pasm"
.include "RT_debugger.pasm"
#
# Pull in user-defined functions
