Author: wmb Date: 2009-08-12 02:17:48 +0200 (Wed, 12 Aug 2009) New Revision: 1294
Modified: cpu/arm/kerncode.fth cpu/mips/kerncode.fth cpu/ppc/kerncode.fth cpu/x86/kerncode.fth forth/kernel/kernel.fth forth/lib/decomp.fth ofw/confvar/conftype.fth ofw/confvar/nameval.fth ofw/core/bootdev.fth ofw/core/bootparm.fth Log: OLPC trac 9435 - break the 256 character limit on command line strings, config-string configuration variables, and related properties in /chosen. The limit is now 1024 characters, but that new limit is due to buffer allocation that can be increased if necessary - it is no longer limited as before by the use of one-byte string length count fields.
Modified: cpu/arm/kerncode.fth =================================================================== --- cpu/arm/kerncode.fth 2009-08-09 04:02:23 UTC (rev 1293) +++ cpu/arm/kerncode.fth 2009-08-12 00:17:48 UTC (rev 1294) @@ -1014,6 +1014,14 @@ inc ip,#4 bic ip,ip,#3 c; +code (n") ( -- adr len) + psh tos,sp + ldr tos,[ip],#4 + psh ip,sp + add ip,ip,tos + inc ip,#4 + bic ip,ip,#3 +c; code traverse ( adr direction -- adr' ) mov r0,tos \ direction r0 pop tos,sp \ adr -> tos @@ -1030,6 +1038,11 @@ ldrb tos,[r0],#1 psh r0,sp c; +code ncount ( adr -- adr1 cnt ) + mov r0,tos + ldr tos,[r0],#4 + psh r0,sp +c;
: instruction! ( n adr -- ) tuck l! /cell sync-cache ;
Modified: cpu/mips/kerncode.fth =================================================================== --- cpu/mips/kerncode.fth 2009-08-09 04:02:23 UTC (rev 1293) +++ cpu/mips/kerncode.fth 2009-08-12 00:17:48 UTC (rev 1294) @@ -970,6 +970,20 @@ ip $at ip and c;
+code (n") (s -- adr len) + sp -8 sp addiu + tos sp 4 sw + ip 0 tos lw \ Get length word in tos + ip 4 ip addiu \ Address of data bytes + ip sp 0 sw \ Put adr on stack + + \ Now we have to skip the string + ip tos ip addu \ ip now points past the last data byte + ip #talign ip addiu \ Round up to a token boundary, plus null byte + $0 #talign negate $at addiu + ip $at ip and +c; + code count (s adr -- adr+1 len ) tos 1 tos addiu tos -1 t0 lbu @@ -977,6 +991,13 @@ t0 tos move c;
+code ncount (s adr -- adr+4 len ) + tos 4 tos addiu + tos -4 t0 lw + tos sp push + t0 tos move +c; + \ 0 constant origin \ here-t 4 - set-relocation-bit-t drop code origin (s -- addr )
Modified: cpu/ppc/kerncode.fth =================================================================== --- cpu/ppc/kerncode.fth 2009-08-09 04:02:23 UTC (rev 1293) +++ cpu/ppc/kerncode.fth 2009-08-12 00:17:48 UTC (rev 1294) @@ -878,12 +878,33 @@ rlwinm ip,ip,0,0,29 c;
+code (") (s -- adr len) + push-tos + lwzu tos,/token(ip) \ Get length byte in tos + addi ip,ip,1cell \ Address of data bytes + stwu ip,-1cell(sp) \ Push adr + + \ Now we have to skip the string + add ip,ip,tos \ ip now points past the last data byte + +\ ! We don't want to add 4 because IP is pre-incremented inside NEXT +\ addi ip,ip,4 \ Round up to a token boundary, plus null byte (#talign + + rlwinm ip,ip,0,0,29 +c; + code count (s adr -- adr+1 len ) addi tos,tos,1 lbz t0,-1(tos) push-tos mr tos,t0 c; +code ncount (s adr -- adr+1cell len ) + addi tos,tos,1cell + lwz t0,-1cell(tos) + push-tos + mr tos,t0 +c;
code origin (s -- addr ) push-tos mr tos,base c;
Modified: cpu/x86/kerncode.fth =================================================================== --- cpu/x86/kerncode.fth 2009-08-09 04:02:23 UTC (rev 1293) +++ cpu/x86/kerncode.fth 2009-08-12 00:17:48 UTC (rev 1294) @@ -708,7 +708,7 @@ ax 0 [rp] mov \ Put the modified ip back c; code (") (s -- addr len) - ax ax sub \ Clear high bytes + ax ax xor \ Clear high bytes al lodsb \ Get length byte in al ip push \ Push address of data bytes ax push \ Push length @@ -717,8 +717,19 @@ #talign-t negate # ip and \ Align c; code count (s addr -- addr+1 len ) - bx pop ax ax sub 0 [bx] al mov bx inc bx push 1push + bx pop ax ax xor 0 [bx] al mov bx inc bx push 1push c; +code (n") (s -- addr len) + ax lods \ Get length in ax + ip push \ Push address of data bytes + ax push \ Push length + ax ip add \ Skip the string + #talign-t # ip add \ Round up to token boundary + null byte + #talign-t negate # ip and \ Align +c; +code ncount (s addr -- addr+/n len ) + bx pop 0 [bx] ax mov /n [bx] bx lea bx push 1push +c;
\ code origin (s -- addr ) ax ax sub 1push c; \ origin is defined later as a constant
Modified: forth/kernel/kernel.fth =================================================================== --- forth/kernel/kernel.fth 2009-08-09 04:02:23 UTC (rev 1293) +++ forth/kernel/kernel.fth 2009-08-12 00:17:48 UTC (rev 1294) @@ -225,7 +225,7 @@ [ifndef] run-time 0 value "temp headerless -d# 258 constant /stringbuf +d# 1024 1+ /n-t + constant /stringbuf \ 1024 bytes + /n for length + 1 for null 0 value stringbuf 0 value $buf : init ( -- ) @@ -238,6 +238,24 @@ : switch-string ( -- ) stringbuf dup "temp = if /stringbuf + then is "temp ; + +: npack (s str-addr len to -- to ) + tuck ! ( str-adr to ) + tuck ncount move ( to ) + 0 over ncount + c! ( to ) +; + +: $nsave ( adr1 len1 adr2 -- adr2 len1 ) npack ncount ; + +: $ncat ( adr len npstr -- ) \ Append adr len to the end of npstr + >r r@ ncount + ( adr len end-adr ) ( r: npstr ) + swap dup >r ( adr endadr len ) ( r: npstr len ) + cmove r> r> ( len npstr ) + dup @ rot + over ! ( npstr ) + ncount + 0 swap c! \ Null-terminate the end for later convenience +; + + : $save ( adr1 len1 adr2 -- adr2 len1 ) pack count ;
: $cat ( adr len pstr -- ) \ Append adr len to the end of pstr @@ -249,7 +267,7 @@ ;
headerless -: add-char ( char -- ) $buf count + c! $buf c@ 1+ $buf c! ; +: add-char ( char -- ) $buf ncount + c! $buf @ 1+ $buf ! ;
: nextchar ( adr len -- false | adr' len' char true ) dup 0= if nip exit then ( adr len ) @@ -284,11 +302,11 @@ ;
headers -: get-string ( -- adr len ) - 0 $buf c! +: get-escaped-string ( -- adr len ) + 0 $buf ! begin - ascii " parse $buf $cat - get-char dup bl <= if drop $buf count exit then ( char ) + ascii " parse $buf $ncat + get-char dup bl <= if drop $buf ncount exit then ( char ) case ascii n of newline add-char endof ascii r of carret add-char endof @@ -317,9 +335,13 @@ dup 2+ taligned here swap note-string allot place ;
+: n", (s adr len -- ) + dup 1+ na1+ taligned here swap note-string allot nplace +; + [ifndef] run-time : ," \ string" (s -- ) - get-string ", + get-escaped-string ", ;
: ." \ string" (s -- ) @@ -328,9 +350,13 @@
: compile-string ( adr len -- ) state @ if - compile (") ", + dup d# 255 > if + compile (n") n", + else + compile (") ", + then else - switch-string "temp $save + switch-string "temp $nsave then ; : s" \ string (s -- adr len ) @@ -338,7 +364,7 @@ ; immediate
: " \ string" (s -- adr len ) - get-string compile-string + get-escaped-string compile-string ; immediate
: [""] \ word (s Compile-time: -- ) @@ -359,7 +385,7 @@ state @ if compile ("s) ", else - switch-string "temp pack + switch-string "temp npack then ; : "" \ name ( -- pstr ) @@ -367,7 +393,7 @@ ; immediate
: p" \ string" ( -- pstr ) - get-string compile-pstring + get-escaped-string compile-pstring ; immediate
: c" \ string" ( -- pstr ) @@ -380,6 +406,7 @@ \ Words for copying strings \ Places a series of bytes in memory at to as a packed string : place (s adr len to-adr -- ) pack drop ; +: nplace (s adr len to-adr -- ) npack drop ;
: place-cstr ( adr len cstr-adr -- cstr-adr ) >r tuck r@ swap cmove ( len ) r@ + 0 swap c! r> @@ -390,6 +417,8 @@ \ Nullfix : +str (s pstr -- adr ) count + 1+ taligned ;
+: +nstr (s pstr -- adr ) ncount + 1+ taligned ; + \ Copy a packed string from "from-pstr" to "to-pstr" : "copy (s from-pstr to-pstr -- ) >r count r> place ;
@@ -3076,7 +3105,7 @@ interact else ( adr len ) included -\ "temp pack "load ( ?? ) +\ "temp npack "load ( ?? ) then then ;
Modified: forth/lib/decomp.fth =================================================================== --- forth/lib/decomp.fth 2009-08-09 04:02:23 UTC (rev 1293) +++ forth/lib/decomp.fth 2009-08-12 00:17:48 UTC (rev 1294) @@ -295,6 +295,7 @@ : .compile ( ip -- ip' ) ." compile " ta1+ .word ; : skip-compile ( ip -- ip' ) ta1+ ta1+ ; : skip-string ( ip -- ip' ) ta1+ +str ; +: skip-nstring ( ip -- ip' ) ta1+ +nstr ; : .(') ( ip -- ip' ) ta1+ .." ['] " dup token@ .name ta1+ ; headers : skip-(') ( ip -- ip' ) ta1+ ta1+ ; @@ -303,6 +304,7 @@ : .string-tail ( ip -- ip' ) dup count type +str ; : .string ( ip -- ip' ) .cword .string-tail put" ; : .pstring ( ip -- ip' ) ?cr ." p" put" ta1+ .string-tail put" ; +: .nstring ( ip -- ip' ) ?cr put" ta1+ dup ncount type +nstr put" ;
\ Use this version of .branch if the structured conditional code is not used \ : .branch ( ip -- ip' ) .word dup <w@ . /branch + ; @@ -335,7 +337,7 @@ ( 18 ) [compile] (endof) ( 19 ) [compile] (endcase) ( 20 ) [compile] ("s) ( 21 ) [compile] (is) ( 22 ) [compile] (dlit) ( 23 ) [compile] (llit) - ( 24 ) [compile] dummy ( 25 ) [compile] dummy + ( 24 ) [compile] (n") ( 25 ) [compile] dummy ( 26 ) [compile] dummy ( 27 ) [compile] dummy ( 28 ) [compile] dummy ( 29 ) [compile] dummy
@@ -353,7 +355,7 @@ ( 18 ) .endof ( 19 ) .endcase ( 20 ) .pstring ( 21 ) .is ( 22 ) .dlit ( 23 ) .llit - ( 24 ) dummy ( 25 ) dummy + ( 24 ) .nstring ( 25 ) dummy ( 26 ) dummy ( 27 ) dummy ( 28 ) dummy ( 29 ) dummy ( default ) .word @@ -374,7 +376,7 @@ ( 18 ) skip-branch ( 19 ) skip-word ( 20 ) skip-string ( 21 ) skip-word ( 22 ) skip-dlit ( 23 ) skip-llit - ( 24 ) dummy ( 25 ) dummy + ( 24 ) skip-nstring ( 25 ) dummy ( 26 ) dummy ( 27 ) dummy ( 28 ) dummy ( 29 ) dummy ( default ) skip-word
Modified: ofw/confvar/conftype.fth =================================================================== --- ofw/confvar/conftype.fth 2009-08-09 04:02:23 UTC (rev 1293) +++ ofw/confvar/conftype.fth 2009-08-12 00:17:48 UTC (rev 1294) @@ -137,22 +137,35 @@ : config-int ( "name" default-value -- ) config-create use-actions , ; : nodefault-int ( "name" -- ) 0 config-int nodefault ;
+: ,cstr ( $ -- adr ) + here over 1+ taligned note-string allot ( $ new-adr ) + place-cstr ( adr ) +; + +: rel! ( adr1 adr2 -- ) tuck - swap ! ; +: rel@ ( adr2 -- adr1 ) dup @ + ; + 6 actions action: ( apf -- adr len ) cv-string@ ; action: ( adr len apf -- ) cv-string! ; action: ( apf -- adr ) cv-adr drop ; action: ( adr len apf -- adr len ) drop $cstr cscount 1+ ; action: ( adr len apf -- adr len ) drop -null ; -action: ( apf -- adr len ) la1+ count ; +action: ( apf -- adr len ) la1+ rel@ cscount ;
+\ This implementation of config-string ignores maxlen, using data representations +\ that do not require specifying a maximum length. : config-string ( "name" default-value$ maxlen -- ) - config-create use-actions drop ", + config-create use-actions ( default-value$ maxlen ) + drop ( default-value$ ) + here >r /n allot ( default-value$ r: where ) \ Place location of def$ + ,cstr r> rel! ( ) ; : nodefault-string ( "name" maxlen -- ) 0 0 swap config-string nodefault ;
: set-config-string-default ( new-default$ xt -- ) - >body la1+ 2dup c@ > abort" cannot increase size of default string" - place + >body la1+ >r ( new-default$ r: ptr-adr ) + ,cstr r> rel! ( ) ;
6 actions
Modified: ofw/confvar/nameval.fth =================================================================== --- ofw/confvar/nameval.fth 2009-08-09 04:02:23 UTC (rev 1293) +++ ofw/confvar/nameval.fth 2009-08-12 00:17:48 UTC (rev 1294) @@ -385,7 +385,7 @@ then ( ) ;
-: (cv-string@) ( apf -- adr len ) cv-adr if >cv$ unpack-env else count then ; +: (cv-string@) ( apf -- adr len ) cv-adr if >cv$ unpack-env else rel@ cscount then ; : (cv-string!) ( adr len apf -- ) (cv-bytes!) ;
' (cv-flag@) to cv-flag@
Modified: ofw/core/bootdev.fth =================================================================== --- ofw/core/bootdev.fth 2009-08-09 04:02:23 UTC (rev 1293) +++ ofw/core/bootdev.fth 2009-08-12 00:17:48 UTC (rev 1294) @@ -1,20 +1,19 @@ purpose: Default values for some configuration variables
headers -" disk net " -d# 256 config-string boot-device +" disk net" d# 256 config-string boot-device
-" " +" " d# 256 config-string boot-file
-" net " +" net" d# 256 config-string diag-device
-" " +" " d# 128 config-string diag-file false config-flag watchdog-reboot? true config-flag auto-boot? -" boot " +" boot" d# 64 config-string boot-command
Modified: ofw/core/bootparm.fth =================================================================== --- ofw/core/bootparm.fth 2009-08-09 04:02:23 UTC (rev 1293) +++ ofw/core/bootparm.fth 2009-08-12 00:17:48 UTC (rev 1294) @@ -62,11 +62,11 @@ headerless : !load-size ( len -- ) file-size ! ;
-d# 256 buffer: path-buf +d# 1024 buffer: path-buf headers ' path-buf " bootpath" chosen-string headerless -d# 256 buffer: args-buf +d# 1024 buffer: args-buf headers ' args-buf " bootargs" chosen-string
@@ -88,6 +88,12 @@ drop d# 255 then ; +: limit-1023 ( adr len -- adr len ) + dup d# 1023 > if + ." Warning: limiting string length to 1023 characters" cr + drop d# 1023 + then +;
: (boot-read) ( adr len -- ) opened-ih if ( adr len ) @@ -99,7 +105,7 @@ ( print-probe-list ) true abort" "r"nCan't open boot device"r"n" then ( fileid ) - dup ihandle>devname limit-255 load-path place-cstr drop ( fileid ) + dup ihandle>devname limit-1023 load-path place-cstr drop ( fileid ) >r ( ) load-started 0 !load-size load-base ( load-adr ) @@ -203,7 +209,7 @@ ." Arguments: " 2over type ( file-str device-str ) )collect ?show-message ( file-str device-str )
- 2swap limit-255 args-buf place-cstr drop ( device-str ) + 2swap limit-1023 args-buf place-cstr drop ( device-str )
boot-read ( ) ;