Screen 0 not modified 0 \ ks 11 mai 88 1 Dieses File enth„lt Definitionen, die zum Laden der weiteren 2 System- und Applikationsfiles ben”tigt werden. 3 4 Unter anderem finden sich hier auch MS-DOS spezifische 5 Befehle wie zum Beispiel das Allokieren von Speicher- 6 platz ausserhalb des auf 64k begrenzten Forthsystems 7 und einige Routinen, die das Arbeiten mit dem Video- 8 Display erleichtern sowie einige Operatoren zur String- 9 manipulation. 10 11 12 13 14 15 Screen 1 not modified 0 \ loadscreen for often used words ks cas 25sep16 1 2 Onlyforth \needs Assembler 2 loadfrom asm.fb 3 4 ' save-buffers Alias sav 5 6 ' name &12 + Constant 'name 7 8 ' page Alias cls 9 10 1 8 +thru .( Systemerweiterung geladen) cr 11 12 13 14 15 Screen 2 not modified 0 \ Postkernel words ks 22 dez 87 1 2 : blank ( addr quan -- ) bl fill ; 3 4 Code stash ( u1 u2 -- u1 u1 u2 ) 5 S W mov W ) push Next end-code 6 \ : stash ( u1 u2 -- u1 u1 u2 ) over swap ; 7 8 : >expect ( addr len -- ) stash expect span @ over place ; 9 10 : .field ( addr len quan -- ) 11 over - >r type r> 0 max spaces ; 12 13 : tab ( n -- ) col - 0 max spaces ; 14 15 Screen 3 not modified 0 \ postkernel ks 08 m„r 89 1 \ hier sollte END-CODE eigentlich aehem, also z.B. -TRANSIENT 2 3 \needs end-code : end-code toss also ; 4 5 : u? ( addr -- ) @ u. ; 6 7 : adr ' >body state @ 0=exit [compile] Literal ; immediate 8 9 : Abort( ( f -- ) IF [compile] .( true abort" !" THEN 10 [compile] ( ; 11 12 : arguments ( n -- ) 13 depth 1- > Error" zu wenige Parameter" ; 14 15 Screen 4 not modified 0 \ MS-DOS memory management 1 2 Code lallocate ( pages -- seg ff / rest err# ) 3 R push D R mov $48 # A+ mov $21 int CS 4 ?[ A D xchg A pop R push A R xchg 5 ][ R pop A push 0 # D mov ]? Next end-code 6 7 Code lfree ( seg -- err# ) 8 E: push D E: mov $49 # A+ mov $21 int CS 9 ?[ A D xchg ][ 0 # D mov ]? E: pop Next end-code 10 11 12 13 14 15 Screen 5 not modified 0 \ postkernel ks 03 aug 87 1 2 c/row c/col * 2* Constant c/dis \ characters per display 3 4 Code video@ ( -- seg ) D push R D mov $F # A+ mov 5 $10 int R D xchg 0 # D- mov 7 # A- cmp 6 0= ?[ $B0 # D+ mov ][ $B8 # D+ add ]? Next 7 end-code 8 9 : savevideo ( -- seg / ff ) 10 [ c/dis b/seg /mod swap 0<> - ] Literal lallocate 11 IF drop false exit THEN video@ 0 2 pick 0 c/dis lmove ; 12 13 : restorevideo ( seg -- ) ?dup 0=exit 14 dup 0 video@ 0 c/dis lmove lfree drop ; 15 Screen 6 not modified 0 \ string operators append attach ks 21 jun 87 1 2 | : .stringoverflow true Abort" String zu lang" ; 3 4 Code append ( char addr -- ) 5 D W mov D pop W ) A- mov 1 # A- add CS 6 ?[ ;c: .stringoverflow ; Assembler ]? 7 A- W ) mov 0 # A+ mov A W add 8 D- W ) mov D pop Next end-code 9 10 Code attach ( addr len addr1 -- ) D W mov C pop 11 I D mov I pop W ) A- mov A- A+ mov C- A+ add CS 12 ?[ ;c: .stringoverflow ; Assembler ]? 13 A+ W ) mov A+ A+ xor A+ C+ mov A W add W inc 14 rep byte movs D I mov D pop Next end-code 15 Screen 7 not modified 0 \\ string operators append attach detract ks 21 jun 87 1 2 : append ( char addr -- ) 3 under count + c! dup c@ 1+ swap c! ; 4 5 : attach ( addr len addr.to -- ) 6 >r under r@ count + swap move r@ c@ + r> c! ; 7 8 : detract ( addr -- char ) 9 dup c@ 1- dup 0> and over c! 10 count >r dup count -rot swap r> cmove ; 11 12 13 14 15 Screen 8 not modified 0 \ ?" string operator ks 09 feb 88 1 2 \ : (?" ( 8b -- index ) "lit under count rot 3 \ scan IF swap - exit THEN 2drop false ; 4 5 | Create months ," janfebm„raprmaijunjulaugsepoktnovdez" 6 7 : >months ( n -- addr len ) 3 * 2- months + 3 ; 8 9 | Code (?" ( 8b -- index ) 10 A D xchg I ) C- mov 0 # C+ mov C I add 11 I W mov I inc std 0<>rep byte scas cld 12 0= ?[ C inc ]? C D mov Next 13 end-code 14 15 : ?" compile (?" ," align ; immediate restrict Screen 9 not modified 0 \ Conditional compilation ks 12 dez 88 1 | Defer cond 2 3 : .THEN ; immediate 4 5 : .ELSE ( -- ) 0 6 BEGIN name nullstring? IF drop exit THEN 7 find IF cond -1 case? ?exit ELSE drop THEN 8 REPEAT ; immediate 9 10 : .IF ( f -- ) ?exit [compile] .ELSE ; immediate 11 12 | : (cond ( n cfa -- n' ) 13 ['] .THEN case? IF 1- exit THEN 14 ['] .ELSE case? IF dup 0= + exit THEN 15 ['] .IF = 0=exit 1+ ; ' (cond is cond Screen 10 not modified 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15