6502/VolksForth
1
0
Fork 0
mirror of https://github.com/forth-ev/VolksForth.git synced 2024-06-14 16:29:26 +00:00
Code Issues Projects Releases Wiki Activity
352036bb6e
VolksForth/6502/UltraForth/CLV/EH-TERM.387
Carsten Strotmann 352036bb6e Old Ultraforth cleanup
2020-07-15 09:27:49 +02:00

174 lines
170 KiB
Plaintext
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

leer clv02feb88 \ Directory 13.5.87 ccclv8feb89 listbufs 2 frei 3-4 fehlerbehandlung-test 5-11 kw fehlerbehandlung-funktioniert 12-19 fehlerbeh 6 20-26 frei 27 SKIP[ ]SKIP 28 frei 29-32 fehlerbeh. mit tabort" 33-37 fehler (err in quit.. 38-44 backup ..R/W 45-53 frei 54-59 Terminal 60 \ listbufs clv14mar88 : listbufs prev BEGIN @ dup WHILE \ liste cr dup u. dup 2+ @ 1+ IF dup 2+ 2+ @ blk/drv /mod u. ." :" u. THEN stop? UNTIL drop ; clv8feb89 clv8feb89 \ fehlerbeh. test clv24nov87 .( fehlerbeh EXITS FAILS ;THEN ) cr .( 1.5 scr + 2 scr ueberdefinieren) : repare ['] (error errorhandler ! [ ' quit >body dup @ ] Literal Literal ! [ ' abort" >body dup @ ] Literal Literal ! [ ' error" >body 2+ @ >body dup @ ] Literal Literal ! ; : old repare ['] repare >name 4 - (forget save quit ; 1 5 +thru 6 +load \ beispiel ' throw errorhandler ! ' nquit ' quit >body ! \ patch ' n(abort" ' (abort" >body ! ' n(err" ' error" >body 2+ @ >body ! save quit \ ep eClrS throw catch clv19nov87 ( | ) User ep 0 ep ! ( | ) User eClrS eClrS on ( | ) : throw ep @ rp! r> ep ! r> [ last @ name> >body ] Literal >r >r ; \ rstack: ... throw catchAdr \ ' throw errorhandler ! \ (error Abort" Error" clv16nov87 : n(error ( string -- ) standardi/o space here .name count type space ?cr blk @ ?dup IF scr ! >in @ r# ! THEN eClrS @ IF clearstack THEN quit ; \\ : (abort" "lit swap IF eClrS on errorhandler perform exit THEN drop ; restrict | : (err" "lit swap IF eClrS off errorhandler perform exit THEN drop ; restrict : Abort" compile (abort" ," ; immediate restrict : Error" compile (err" ," ; immediate restrict \ clv16nov87 \ FAILS clv16nov87 Create: unfails r> ep ! rdrop ; Create: unexits r> ep ! ; : (fails ( --) r> dup 2+ >r ep @ >r rp@ ep ! unfails >r dup @ + >r ; restrict : (exits ( --) r> dup 2+ >r ep @ >r rp@ ep ! unexits >r dup @ + >r ; restrict \ branchtarget & catchpart follows \ rstack: ... adr oldep uncatch cont \ ep ---^ : FAILS compile (fails >mark -1 ; immediate restrict : EXITS compile (exits >mark -1 ; immediate restrict : ;THEN compile exit [compile] THEN ; immediate restrict \ quit clv16nov87 \ patches: : n(abort" rdrop "lit swap IF eClrS on errorhandler perform exit THEN drop ; restrict | : n(err" rdrop "lit swap IF eClrS off errorhandler perform exit THEN drop ; restrict : nquit rdrop r0 @ rp! [compile] [ FAILS n(error THEN 'quit ; \ installs toplevel errorhandling \ fehlerbeh. beispiel clv17nov87 : devon ." device ist on " ; : devoff ." device ist off " ; : mistake? ." Fehler=y " key capital Ascii Y = abort" aborted" ; : tf ." t-1 " devon FAILS ." t-f " devoff ;THEN ." t-2 " mistake? ." t-3 " devoff ; : te ." t-1 " devon EXITS ." t-f " devoff ;THEN ." t-2 " mistake? ." t-3 " ; : t cr ." mit FAILS:" tf cr tf cr cr ." mit EXITS:" te cr te ; \ fehlerbeh. 2 clv07feb88 .( fehlerbeh EXITS #FAILS END ) cr .( 4 scr + 1 scr ueberdefinieren) 1 5 +thru 6 7 +thru \ beispiel ' noop errorhandler ! ' nquit ' quit >body ! \ patch ' n(abort" ' (abort" >body ! ' n(err" ' error" >body 2+ @ >body ! save quit (c) clv 1988 \ pointer and rstack-handl. clv07feb88 ( | ) User ep \ error-return-pointer User err err off \ error-message User eClr eClr off \ error-clearstack Create: uncatch r> r> ep ! rp! ; ( |) Variable catchrp : <catch r> rp@ catchrp ! >r ; restrict : catch> r> ep @ >r rp@ ep ! catchrp @ >r uncatch >r >r ; restrict \ throw (exits (fails clv07feb88 : throw rdrop err @ 0= ?exit ep @ rp! r> ep ! ; restrict : (exits r> dup 2+ >r <catch catch> dup @ + >r ; restrict : (fails r> <catch dup 2+ >r catch> dup @ + >r ; restrict \ (#fails clv07feb88 : move>r ( from count--) r> -rot rp@ over - under rp! cmove >r ; restrict : r>move ( to count--) r> -rot under rp@ -rot cmove rp@ + rp! >r ; restrict create: getargs s0 @ r> - sp! sp@ r@ 1+ 2* r>move ; : (#fails ( ..args.. n--..args..) >r r@ sp@ s0 @ swap - sp@ r> 2+ 2* ( .args. n depth from bytes) r> <catch dup 2+ >r -rot move>r nip nip getargs >r catch> dup @ + >r ; restrict \ FAILS EXITS #FAILS END clv07feb88 : EXITS compile (exits >mark -1 ; immediate restrict : FAILS [compile] BEGIN compile (fails >mark -1 2swap ; immediate restrict : #FAILS ( n--) [compile] BEGIN compile (#fails >mark -1 2swap ; immediate restrict : END dup 2 = IF 2drop THEN abs 1 ?pairs compile throw >resolve ; immediate restrict \ (error (abort" quit clv07feb88 : n(error standardi/o space here .name err @ count type space ?cr err off blk @ ?dup IF scr ! >in @ r# ! THEN eClr @ IF clearstack THEN quit ; : n(abort" rdrop "lit swap IF err ! eClr on errorhandler perform throw THEN drop ; restrict | : n(err" rdrop "lit swap IF err ! eClr off errorhandler perform throw THEN drop ; restrict : nquit rdrop r0 @ rp! [compile] [ FAILS n(error END 'quit ; \ installs toplevel errorhandling \\ die RDROP sind nur wg. Patch \ fehlerbeh. beispiel clv19nov87 : devon ." device ist on " ; : devoff ." device ist off " ; : mistake? ." Fehler=y " key capital Ascii Y = abort" aborted" ; : tf ." t-1 " devon FAILS ." t-f " devoff END ." t-2 " mistake? ." t-3 " devoff ; : te ." t-1 " devon EXITS ." t-f " devoff END ." t-2 " mistake? ." t-3 " ; : t cr ." mit FAILS:" tf cr tf cr cr ." mit EXITS:" te cr te ; \ fhler test #FAILS clv07feb88 \ Fuer Neugierige: : .rs r0 @ rp@ DO cr I dup . ." :" @ dup . dup 2- @ uncatch 2- @ = IF ." -" 2- ELSE @ THEN >name .name 2 +LOOP ; : .stack ." Stack:" .s ; : action ( n1 n2 n3--nSum) ." action:" .stack + + mistake? ; : t#fails 1 2 3 3 #FAILS ." F:" .stack ." retry=y?" key Ascii y - UNTIL END action ." successfull:" .stack drop ; \ EH:LOADs exception handling clv24feb88 User ep \ error-return-pointer User err err off \ error-message 1 3 +thru \ throw EXITS #FAILS RETRY 4 +load \ patches (abort" (err" quit \ 5 7 +thru \ beispiel save quit \\ (c) 1988 volksFORTH83-Autoren in der Forth-Gesellschaft e.V. enwickelt von Claus Vogt, 1988 unter ultraFORTH83 Vs 3.8 auf CBM +4 Thanks to Klaus Schleisiek and TLC-Lisp \ EH:returnstack catch-throw clv24feb88 : <rstack r> rp@ >r >r ; restrict : ,r ( u--) r> r> rot >r >r >r ; restrict : rmove ( adr u --) r> r> rp@ 3 pick - rp! rp@ -rot >r >r swap cmove ; restrict Create: unstack r> rp! ; Create: uncatch r> r> ep ! rp! ; : rstack> r> unstack >r >r ; restrict : catch> r> r> ep @ >r rp@ ep ! >r uncatch >r >r ; restrict : throw err @ IF ep @ rp! r> ep ! ELSE rdrop THEN ; restrict : ?throw ( flag--) IF rdrop throw THEN ; restrict \ EH:(exits (fails (#fails clv24feb88 : (exits \ frame to be executed after \ error or exit r> err @ IF err dup push off THEN dup 2+ >r <rstack catch> dup @ + >r ; restrict : (fails \ frame executes after error r> <rstack dup 2+ ,r catch> dup @ + >r ; restrict Create: getargs \ restore: s0 @ r> 2* - sp! \ stack-pointer sp@ rp@ swap r@ 1+ 2* cmove \ values r> 2* rp@ + rp! ; \ returnstack : (#fails ( u*args u--u*args) >r sp@ r> \ saves also arguments r> <rstack dup 2+ ,r -rot under 2* rmove ,r depth ,r getargs ,r catch> dup @ + >r ; restrict \ EH:FAILS EXITS #FAILS RETRY clv24feb88 : EXITS compile (exits >mark -1 ; immediate restrict : FAILS compile (fails >mark -1 ; immediate restrict : #FAILS ( n--) compile (#fails >mark -1 ; immediate restrict : RETRY compile branch over 2- <resolve [compile] THEN ; immediate restrict \\ use: EXITS ... throw THEN ... (#)FAILS ... ?throw ... RETRY ... don't use: IF ... ELSE ... RETRY !!!! \ EH:(error (abort" quit clv24feb88 ' noop errorhandler ! | : err! ( flag--) rdrop "lit swap IF dup err ! errorhandler perform drop throw THEN drop ; restrict : n(abort" rdrop ( * ) err! ; restrict ' n(abort" ' (abort" >body ! : n(err" rdrop ( * ) err! ; restrict ' error" >body 2+ @ | Alias (err" ' n(err" ' (err" >body ! : .err space here .name err @ count type space ?cr ; : nquit rdrop ( * ) r0 @ rp! FAILS standardi/o .err blk @ ?dup IF scr ! >in @ r# ! THEN err @ 2- @ ['] (err" - IF clearstack THEN RETRY err off [compile] [ 'quit ; ' nquit ' quit >body ! \ EH:sample.. clv24feb88 : devon ." aktion begonnen " cr ; : devoff ." aktion beendet " cr ; : .ok ." alles erfolgreich" cr ; : .handle ." Ausnahmebehandlung: " ; : .stack ." Stack:" .s cr ; : ?y? ( --flag) ." =y " key capital Ascii Y = dup 0= IF del del ." n " THEN cr ; : ok? ." Fehler?" ?y? abort" abbruch" ; : retry? ( --flag) ." nochmal?" ?y? ; : action ( n1 n2 n3--nSum) devon .stack + + ok? devoff ; \ EH:..sample clv24feb88 : tf ." t-1 " devon FAILS .handle devoff throw THEN ." t-2 " ok? ." t-3 " devoff .ok ; : te ." t-1 " devon EXITS .handle devoff throw THEN ." t-2 " ok? .ok ; : t# 1111 2222 3333 3 #FAILS .handle .stack retry? 0= ?throw cr RETRY action .ok .stack drop ; : test 0 #FAILS cr cr ." alles" retry? 0= ?throw cr RETRY cr ." mit FAILS:" cr tf cr cr ." mit EXITS:" cr te cr cr ." mit #FAILS:" cr t# cr ; \ EH:ouput of returnstack clv24feb88 \ Fuer Neugierige: : tab at? &22 umax at ; : ?.n ( adr string--) swap >name ?dup IF swap count type tab .name rdrop exit THEN drop ; restrict : ?.name ( adr--) dup 2- " pfa of" ?.n dup 2- @ " " ?.n dup 4 - @ " data of" ?.n tab ." ???" ; : .rs r0 @ rp@ \ gibt rstack aus DO cr I 6 u.r I @ 6 u.r space I @ ?.name drop 2 +LOOP cr ep @ 6 u.r ." ep ! " ; \ SKIP[ ]SKIP clv13feb88 : ]SKIP 4 ?pairs >resolve ] ; : SKIP[ reveal compile branch >mark 4 [compile] [ ; immediate restrict \\ : t ." hier t" SKIP[ : t2 ." hier t2 " ; ]SKIP ." hier noch t" ; leer clv02feb88 leer clv02feb88 leer clv02feb88 leer clv02feb88 \ fehlerbeh. 4 clv22feb88 \ mit tabort" \ nur Studie, da nicht patchbar \ Beispiel wie gehabt 1 3 +thru \ EXITS #FAILS END 4 +load \ systemaenderungen \\ Veraenderungen im System: errorhandler wird leider gestrichen quit abort" (abort" error" (err" anders (error wird in quit integriert \ pointer and rstack-handl. clv22feb88 User ep ep off \ Error-Ret-Ptr Create: uncatch r> r> ep ! rp! ; ( |) Variable catchrp : <catch r> rp@ catchrp ! 0 >r >r ; restrict : catch> r> ep @ >r rp@ ep ! catchrp @ >r uncatch >r >r ; restrict : move>r ( from count--) r> -rot rp@ over - under rp! cmove >r ; restrict : r>move ( to count--) r> -rot under rp@ -rot cmove rp@ + rp! >r ; restrict \ throw (exits (fails (#fails clv22feb88 | : rdo ( pfa--pfa) r> swap 2+ >r >r ; | : rskip ( pfa--) rdrop dup @ + >r ; : (exits rdo rskip ; restrict : EXITS compile (exits >mark -1 ; immediate restrict : (fails r> <catch rdo catch> rskip ; restrict : (#fails ( ..args.. n--..args..) >r r@ sp@ s0 @ swap - sp@ r> 2+ 2* ( .args. n depth from bytes) r> <catch rdo -rot move>r nip nip EXITS s0 @ r> - sp! sp@ r@ 1+ 2* r>move exit THEN catch> rskip ; restrict \ FAILS #FAILS END clv22fclv22feb88 : FAILS [compile] BEGIN compile (fails >mark -1 2swap ; immediate restrict : #FAILS ( n--) [compile] BEGIN compile (#fails >mark -1 2swap ; immediate restrict : END dup 2 = IF 2drop THEN abs 1 ?pairs >resolve ; immediate restrict \ (error (abort" quit clv22feb88 : throw rdrop r> 2- \ points to tabort" ep @ 2- rp! r> 2- ! \ error-exit-pfa r> ep ! ; restrict : (tabort" throw ; restrict : (terr" throw ; restrict : abort" ( flag -- ) [compile] IF compile (tabort" ," [compile] THEN ; immediate restrict : error" ( flag -- ) [compile] IF compile (terr" ," [compile] THEN ; immediate restrict : quit r0 @ rp! \ kann ev weg FAILS standardi/o space here .name r> dup 2+ count type space dup ." at:" u. ?cr blk @ ?dup IF scr ! >in @ r# ! THEN ['] (tabort" = IF clearstack THEN REPEAT THEN [compile] [ 'quit ; \ fehlerbeh. 5 clv23feb88 \ (errror in quit, User: ep / err 1 3 +thru \ EXITS #FAILS END 4 +load \ patches (abort" (err" quit 5 6 +thru \ beispiel \\ ab hier wird gepatched: : -!- dup @ -rot , , , ; Variable patches ' noop errorhandler -!- ' nquit ' quit >body -!- ' n(abort" ' (abort" >body -!- ' n(err" ' error" >body 2+ @ >body -!- here patches ! : patch patches @ patches 2+ DO I 2 + @ I @ ! 6 +LOOP ; : unpatch patches @ patches 2+ DO I 4 + @ I @ ! 6 +LOOP ; \\ patch save quit \\ unpatch ' ep >name 4 - (forget save 0 +load \ pointer and rstack-handl. clv23feb88 ( | ) User ep \ error-return-pointer User err err off \ points to message Create: uncatch r> r> ep ! rp! ; ( |) Variable catchrp : <catch r> rp@ catchrp ! >r ; restrict : catch> r> ep @ >r rp@ ep ! catchrp @ >r uncatch >r >r ; restrict : move>r ( from count--) r> -rot rp@ over - under rp! cmove >r ; restrict : r>move ( to count--) r> -rot under rp@ -rot cmove rp@ + rp! >r ; restrict \ throw (exits (fails (#fails clv07feb88 : throw rdrop err @ 0= ?exit ep @ rp! r> ep ! ; restrict : (exits r> dup 2+ >r <catch catch> dup @ + >r ; restrict : (fails r> <catch dup 2+ >r catch> dup @ + >r ; restrict create: getargs s0 @ r> - sp! sp@ r@ 1+ 2* r>move ; : (#fails ( ..args.. n--..args..) >r r@ sp@ s0 @ swap - sp@ r> 2+ 2* ( .args. n depth from bytes) r> <catch dup 2+ >r -rot move>r nip nip getargs >r catch> dup @ + >r ; restrict \ FAILS EXITS #FAILS END clv07feb88 : EXITS compile (exits >mark -1 ; immediate restrict : FAILS [compile] BEGIN compile (fails >mark -1 2swap ; immediate restrict : #FAILS ( n--) [compile] BEGIN compile (#fails >mark -1 2swap ; immediate restrict : END dup 2 = IF 2drop THEN abs 1 ?pairs compile throw >resolve ; immediate restrict \ (error (abort" quit clv23feb88 | : err! ( flag--) rdrop ( deletes (ABORT" ) "lit swap IF err ! errorhandler perform throw THEN drop ; restrict : n(abort" rdrop err! ; restrict : n(err" rdrop err! ; restrict : .err space here .name err @ count type space ." AT:" err @ u. ?cr ; : nquit rdrop r0 @ rp! FAILS standardi/o .err blk @ ?dup IF scr ! >in @ r# ! THEN err @ 2- @ ['] (abort" = IF clearstack THEN REPEAT THEN err off [compile] [ 'quit ; \\ die RDROP sind nur wg. Patch \ fehlerbeh. beispiel clv07feb88 : devon ." device ist on " ; : devoff ." device ist off " ; : mistake? ." Fehler=y " key capital Ascii Y = abort" aborted" ; : tf ." t-1 " devon FAILS ." t-f " devoff END ." t-2 " mistake? ." t-3 " devoff ; : te ." t-1 " devon EXITS ." t-f " devoff END ." t-2 " mistake? ." t-3 " ; : t cr ." mit FAILS:" tf cr tf cr cr ." mit EXITS:" te cr te ; \ fhler test #FAILS clv07feb88 \ Fuer Neugierige: : .rs r0 @ rp@ DO cr I dup . ." :" @ dup . dup 2- @ uncatch 2- @ = IF ." -" 2- ELSE @ THEN >name .name 2 +LOOP ; : .stack ." Stack:" .s ; : action ( n1 n2 n3--nSum) ." action:" .stack + + mistake? ; : t#fails 1 2 3 3 #FAILS ." F:" .stack ." retry=y?" key Ascii y - UNTIL END action ." successfull:" .stack drop ; \ uniR/W clv15mar88 \ Zum Kopieren Disk/Tape \needs Code .( ?!! Code !!?) quit \needs s#>t+s (16 $46ee Alias s#>t+s C) \needs 2@ : 2@ dup 2+ @ swap @ ; 1 6 +thru \ diverse r/w's 7 8 +thru \ backup ' uniR/W Is r/w ' patch-sbufs ' save-buffers >body ! : uniIni supertape r/wf on virInit ; uniIni ' uniIni ' drvinit >body ! save \ tapeR/W clv14mar88 : nofile ( f--) abort" nofile" ; | Create blk. ," blk." Variable r/wf r/wf on \ greift auf interne Block-struktur!!! \ blk $ffff laedt naechsten block : ?r/wf ( rw/f--) dup r/wf @ - IF ." Press stop" key drop THEN r/wf ! ; : tapeR/W ( adr blk file r/wf -- flag) swap nofile dup ?r/wf IF swap dup 2- 2- blk. count bload over 2- off \ no flags over - b/blk - abort" block-crash" over true = IF 2drop false exit THEN 2- 2- @ 2dup - IF ." not" u. ." ! " u. true exit THEN 2drop ELSE drop dup 2- 2- swap b/blk + blk. count bsave THEN false ; \ blk# nofile ?dev clv14mar88 \ : blk# ( --blk) prev @ 2+ 2+ @ ; $FFB1 >label LISTEN $FF93 >label SECOND $FFAE >label UNLSN | Code (dev? sp x) lda $90 stx (16 $ae sta rom C) LISTEN jsr \ wg. Fehler im Betr.syst. $60 # lda SECOND jsr UNLSN jsr 0 # ldx 1 # ldy (16 ram C) $90 lda sp x) sta sp )y sta Next jmp end-code : dev? ( dev -- flag) i/o lock (dev? 0= i/o unlock ; \\ : ?device ( dev --) dev? ?exit buffers unlock true abort" no device" ; \ leer clv14mar88 \ simuliert mehrere Laufwerke auf Drv#0 Variable #drv Variable lastdrv : virInit 4 0 DO I 8 + dev? 0= IF I #drv ! leave THEN LOOP lastdrv on ; : virDrv ( drv--) dup 1 #drv @ uwithin IF (drv ! exit THEN (drv off lastdrv @ over - IF cr ." Insert disk#" dup u. lastdrv ! key THEN drop ; : virBlk ( blk--blkOnDrv) blk/drv /mod virDrv ; \ diskR/W clv14mar88 | $100 Constant b/sek : 1551r/w ( adr blk file r/wf -- flag) swap nofile -rot virBlk diskopen IF drop nip exit THEN 0 swap 2* 2* 4 bounds DO drop 2dup I rot IF s#>t+s readsector ELSE s#>t+s writesector THEN >r b/sek + r> dup IF LEAVE THEN LOOP -rot 2drop diskclose ; \ dirR/W clv15mar88 \ Benutzt blk als Laufwerksnummer : dirR/W ( adr blk file r/wf -- flag) -rot nofile virDrv ( adr r/wf) diskopen IF drop exit THEN 3 0 \ Directorie nur $300 lang !! DO ( adr r/wf) 2dup IF &18 I readsector ELSE &18 I writesector THEN IF 2drop false false leave THEN swap b/sek + swap LOOP drop 0= diskclose ; \ uniR/W clv15mar88 4 Constant tape $f Constant dir : info 2 pick IF ." r:" ELSE ." w:" THEN 2dup 3 u.r ." :" 3 u.r 10 spaces cr $91 ( CurUp ) con! ; : uniR/W ( adr blk file r/wf -- flag) 2 pick blk/drv /mod info dir case? IF tape case? IF tapeR/W exit THEN -rot 3 roll drop dirR/W exit THEN tape case? IF $ff = IF rot drop true -rot THEN tapeR/W exit THEN dup 4 u< IF drop drop 1551r/w exit THEN drop drop ramR/W ; \ sort-buffers clv15mar88 : du> ( d1 d2 --flag) rot 2dup - IF u< nip nip exit THEN drop drop u> ; | : swap? ( adr--flag) @ dup 2+ @ -1 = IF drop false exit THEN dup 2+ 2@ rot @ 2+ 2@ du> ; | : swapbufs ( adr--) dup @ dup @ dup @ >r swap r> over ! over ! over ! drop ; : sort-buffers prev BEGIN dup @ @ 0= IF drop exit THEN dup swap? IF swapbufs prev ELSE @ THEN REPEAT ; : patch-sbufs sort-buffers [ ' save-buffers >body @ , ] ; \ backup clv14mar88 : backup ( fromDrv toDrv--) lastdrv on over dir >drive over dir >drive copy >r >r 0 r@ >drive blk/drv 1- r> >drive 0 r> >drive convey ; \\ Drv 0..3: reelle/virtuelle Disks Drv 4 : tape-DEVICE Drv 15 : Directories \\ supertape 0 4 backup \ Disk-->Tape supertape 4 0 backup \ Tape-->Disk 0 1 backup \ Disk-->Disk leer clv14mar88 leer clv02feb88 leer clv02feb88 leer clv02feb88 leer clv02feb88 leer clv02feb88 \ TM:Terminal Loadscreen cclv28feb89 1 &11 +thru \ serial interface &12 +load \ cbm ascii conversion &13 +load \ tx more than byte &14 +load \ dumb terminal \ TM:Serielle Schnittstelle clv28feb89 | Variable INT \ location of interrupt | $fd00 Constant Port@ \ 6551 | $fd10 Constant uport@ \ cts-port | Variable ctrl | $314 Constant sint@ | sint@ @ >Label oldSint | $fcbe >Label intEnd \ system-depend \ interrupt end routine Create Queue 0 , $80 allot \\ 0 1 2 130 byte adr len out 128-byte-queue len ::= number of characters queued out ::= relative address of next output character (len+out)mod 128 = relative address of first byte empty \ TM:Serielle Schnittstelle clv8feb89 : tx ( c -- ) port@ c! ; : tx? ( -- f ) port@ 1+ c@ $10 and 0<> uport@ c@ $02 and 0<> and ; \\ | Label no 0 # lda | Label pushaa sp 2dec sp )y sta puta jmp end-code Code tx? ( -- f ) port@ 1+ lda $10 # and no beq \ ok? uport@ lda $02 # and no beq \ cts? | Label yes $ff # lda pushaa bne end-code Code tx ( c -- ) port@ sta pop jmp end-code \ TM:Serielle Schnittstelle clv28feb89 : +dtr port@ 2+ dup c@ 1 or swap c! ; : -dtr port@ 2+ dup c@ $fe and swap c! ; : +rts port@ 2+ dup c@ $04 or swap c! ; : -rts port@ 2+ dup c@ $f3 and swap c! ; \\ Code +dtr port@ 2+ lda $1 # or port@ 2+ sta next jmp end-code Code -dtr port@ 2+ lda $fe # and port@ 2+ sta next jmp end-code \ TM:Serielle Schnittstelle clv8feb89 | Label s-int port@ 1+ lda 0>= ?[ oldSint jmp ]? $08 # and 0= ?[ intEnd jmp ]? tya pha queue lda $68 # cmp 0>= ?[ port@ 2+ lda $f2 # and port@ 2+ sta ]? \ -dtr -rts clc queue 1+ adc $7f # and tay queue inc port@ lda queue 2+ ,y sta pla tay intEnd jmp end-code \ TM:Serielle Schnittstelle clv8feb89 : rx? ( -- f ) queue c@ ; Code sei sei next jmp end-code Code cli cli next jmp end-code : rx ( -- c ) queue c@ 0= IF +dtr +rts BEGIN queue c@ UNTIL THEN sei queue dup 1+ c@ + 2+ c@ -1 queue +! 1 queue 1+ +! cli ; \\ Code rx? ( -- f ) queue lda pushaa jmp end-code Code rx ( -- c ) queue lda 0= ?[ port@ 2+ lda 5 # or port@ 2+ sta \ +dtr +rts [[ queue lda 0<> ?] ]? sei queue 1+ ldy queue 2+ ,y lda queue dec queue 1+ inc cli push0a jmp end-code \ TM:Serielle Schnittstelle clv228feb89 : s-init s-int sint@ ! \ new interrupt ctrl @ port@ 2+ ! +dtr +rts ; : bye 0 port@ 2+ c! bye ; \ -dtr -rts -rxint \ clv228feb89 \ TM: ctrl: clv228feb89 | : ctrl: ( adr 8b -- ) Create not c, , does> ( 8b -- ) Create dup c@ c, 1+ @ , c, does> dup c@ over 1+ @ c@ and over 3+ c@ or swap 1+ @ c! ; \ The only meta-defining-word I ever saw \ TM: baudrate clclv8feb89 | ctrl 1+ %00011111 ctrl: bd: $11 bd: 50baud $12 bd: 75baud $13 bd: 110baud $14 bd: 135baud $15 bd: 150baud $16 bd: 300baud $17 bd: 600baud $18 bd: 1200baud $19 bd: 1800baud $1a bd: 2400baud $1b bd: 3600baud $1c bd: 4800baud $1d bd: 7200baud $1e bd: 9600baud $1f bd: 19200baud \ TM: bits stopbits clv228feb89 | ctrl 1+ %01100000 ctrl: ln: $00 ln: 8bits $20 ln: 7bits $40 ln: 6bits $60 ln: 5bits | ctrl 1+ %10000000 ctrl: st: $80 st: 1stop $00 st: xstop \\ xStop gives: 8 bit+1 parity -> 1stop 5 bit+0 parity -> 1.5 other -> 2stop \ TM: parity clv228feb89 | ctrl %11100000 ctrl: pa: $00 pa: noParity $80 pa: oddParity $c0 pa: evenParity $a0 pa: 1Parity $e0 pa: 0Parity | ctrl %00010000 ctrl: ec: $10 ec: +echo \ only if -rts !! $00 ec: -echo \\ 1parity means: send and receive high parity but no parity-check \ TM: cbm>asc asc>cbm cclv28feb89 : cbm>asc ( c -- c' ) dup $41 $5b uwithin IF $20 + exit THEN dup $61 $7b uwithin IF $60 + exit THEN dup $c1 $db uwithin IF $7f and exit THEN $dc case? IF $7c exit THEN $7c case? IF $dc exit THEN $14 case? IF $08 exit THEN $08 case? IF $14 exit THEN ; : asc>cbm ( c -- c' ) dup $41 $5b uwithin IF $80 or exit THEN dup $61 $7b uwithin IF $20 - exit THEN dup $c1 $db uwithin IF $60 - exit THEN $dc case? IF $7c exit THEN $7c case? IF $dc exit THEN $14 case? IF $08 exit THEN $08 case? IF $14 exit THEN ; \ TM: txType txblocks clv28feb89 $1a Constant #EOF | : ?break key? abort" ***aborted***" ; | : ?tx ( c -- ) BEGIN ?break tx? UNTIL cbm>asc #EOF case? IF $ff THEN tx ; : txType ( adr count -- ) bounds DO I c@ ?tx LOOP ; : txblocks ( fromBlk toBlk -- ) 2dup u> abort" nein!" s-init 1+ swap DO I block b/blk txType LOOP #EOF ?tx ; : txDisk 0 $a9 txBlocks ; \ TM: dumb Terminal clclv8feb89 \ Sample for an easy Terminal \needs #LF $0a Constant #LF | : ?rx pause rx? 0= ?exit rx asc>cbm #LF case? IF cr exit THEN #CR case? IF row 0 at exit THEN #BS case? IF del exit THEN emit ; | : ?tx ( c --) cbm>asc BEGIN ?rx tx? UNTIL tx ; 300baud noparity 1stop 8bits -echo : dumb s-init BEGIN BEGIN ?rx key? UNTIL key $1b case? IF -dtr exit THEN #cr case? IF #CR ?tx #LF THEN ?tx REPEAT ; clv8feb89 clv8feb89 clv8feb89 clv8feb89 clv8feb89 clv8feb89 clv20may87 clv8feb89 clv8feb89 clv8feb89 clv8feb89 clv8feb89 clv8feb89 clv8feb89 clv8feb89 \\ zu fehlerbeh. clv16nov87 ziel: CATCH (catch ---+ ... ... ! TO branch -- ! ---+ uncatch <-+ ! ... ... ! ENDCATCH throw ! uncatch <------+ ONERROR (catch ----+ branch --- ! --+ uncatch <--+ ! ... ... ! ENDONERROR throw <------+ ... ... ( ; macht uncatch ) \\ zu fehler clv16nov87 TRY <#> put# (catch -- <word> <word> branch -- uncatch ... ... RETRY get branch -- unstack uncatch ( .status push load clv20may87 Defer .status ' noop Is .status | Create pull 0 ] r> r> ! ; : push ( addr -- ) r> swap dup >r @ >r pull >r >r ; restrict : load ( blk --) ?dup 0= ?exit blk push blk ! >in push >in off .status interpret ; 

<00>(4112)<00>l<EFBFBD>@<40>lxal{ b6{{<>_<00>cbz.3>\ultraFOR<07>l<00><07><07><00>l #<00>2+ <17>P<>#3+<17>PS<17>PM$<17>PG#1-18<><07><01>l<00><07><07><00>l #*2-o<18><>$hTRUEy+<2B><>$tFALSEy+$<00>"-1[$<00>!0<>$<00>1y+$<00>2y+$<00>3y+$<00>4y+$<00>ON +[s$$<00>OFF +<2B>s$%<00><17>CLITT<17>8<><02><07>F<14><0E><07><><07>P<02>l WAND<4E>H<>1<07><07><><07>1<07>l<> <00>XORH<>q<07><07><><07>q<07>l<>!-3H<>8<><07>H<><07><01><07><03>l<>!-NOTs<18><><07><07><><07>l !kNEGATE<54>8<><38>"<00>DNEGATEH8<48><38><07>H<><48><07><07><><07><07><01><><07>l
<EFBFBD><EFBFBD><EFBFBD><EFBFBD><07>$<00><10><><18><07><07><02><14><00>`"<00>D+<2B><16> <20>H<><18>&<26>H<><07>'<27><07><07>$<24><07><01><07>%<25>l #<00>1+<2B><16><18>\\ zu ONERROR clv16nov87 : ONERROR \\ zu FAILS clv16nov87 --Quelltext-- --Compilat----- FAILS catch ## -----! <errorWords> <errorWords> ! ;THEN exit ! <continue> <-------------! EXITS catch ## -----! <errorWords> <errorWords> ! ;THEN exit ! <continue> <-------------! \ test clv22may87 : getbufs \ [from to] -- 1+ swap ?DO I dup . block drop LOOP ; 4a 4a getbufs 40 46 getbufs 20 2a getbufs 50 59 getbufs \\ zu fehlerbeh.2 clv07feb88 Ermoeglicht das Behandeln eines abort" oder error" in einer der auesseren Routinen. Die Behandlung kann sich im einfachen Fall auf das Abschliessen bestimmter Prozesse (z.B. Schliessen von Geraeten) beschraenken, kann aber ggf. auch einen weiteren Versuch starten. Die Benutzung geschieht mittels Kontrollstrukturen \\ clv07feb88 to linked List on return-stack adress of abort" - message =true after abort" / =false after error" temporary \\ Mit: ...<CATCH ..rstackmanipul.. CATCH> wird eine Sequenz auf den rstack gelegt, die im Fehlerfalle ausgefuehrt wird. Im normalen Exitfall wird sie von UNCATCH entfernt rstack: ... oldep oldrp uncatch-pfa --> ^ ep @ points to ^ oldep is old value of ep oldrp is rstack-Pointer before <CATCH \\ zu throw (exits (fails clv07feb88 THROW wirkt im Normalfall wie EXIT. wenn sich das System nach ABORT" oder ERROR" im Fehlerbehandlungszustand befindet, aktiviert es die naechst-aussere Fehlerbehandlungsroutine (EXITS wird von EXITS compiliert. Es installiert bei Ausfuehrung die ihm folgende Sequenz als Fehler- und Exit-Routine und branched ueber sie hinweg. Der Returnstack nach (EXITS: ... exit-pfa oldep oldrp uncatch-pfa ^ / ^<<<<<<<<<<<<</ (FAILS wird von FAILS compiliert. Es installiert bei Ausfuehrung die ihm folgende Sequenz als Fehler- Routine und branched ueber sie hinweg. Der Returnstack nach (FAILS: ... fails-pfa oldep oldrp uncatch-pfa ^ / ^<<<<<<<<<<<<<<<<<</ \\ zu (#fails clv07feb88 (#FAILS ( ..args.. u--..args..) wird von #FAILS compiliert. Es installiert bei Ausfuehrung die ihm folgende Sequenz als Fehler- Routine und branched ueber sie hinweg. Ausserdem sichert es die u obersten Elemente und die Tiefe des Datenstacks, sodass die Fehler- Routine als oberste Elemente auf dem Stack vorfindet: ( ..U*ARGS.. U) Der Returnstack nach (#FAILS: ... ..U*args.. U depth getargs-pfa ^ fails-pfa oldep oldrp uncatch-pfa ^ / ^<<<<<<<<<<<<<<<<<</ \\ zu Kontrollstrukturen clv07feb88 \\ Benutzung: EXITS ... END \ ... bei exit und error FAILS ... END \ ... bei error #FAILS .. END \ ... bei error mit args (#)FAILS .. WHILE .. WHILE .. REPEAT END ermoeglicht wiederholung Abschluss mit THEN geht auch, aber Benutzerverantwortung! sinnlos: IF BEGIN END EXITS THEN macht zweimal das gleiche \ zu den patches clv07feb88 Unterschiede zu Systemroutinen: (ERROR ist nicht mehr ERRORHANDLER, sondern wird von QUIT installiert. Die Message wird in ERR uebergeben, es fuehrt jetzt ggf. CLEARSTACK aus. (ABORT" und (ERR" setzen Message und ein Flag zum Thema Clearstack und fuehren dann THROW aus. \ clv19nov87 \ rstack: ... oldrp oldep uncatch Create: uncatch r> ep! r> rp! ; Create: catch ( ret oldrp --) >r ep @ >r rp@ ep ! uncatch >r >r ; : (fails ( --) r> rp@ over 2+ >r \ fails-ip swap dup @ + swap catch ; \ rstack: fails oldrp oldep uncatch : (exits ( --) rp@ r> dup 2+ >r \ exits-ip dup @ + swap catch ; \ rstack: exits oldrp oldep uncatch : (#fails ( n--) r> rp@ over 2+ >r \ fails-ip saveargs swap dup @ + swap catch ; \ clv19nov87 Variable lastrp : <catch r> rp@ lastrp ! >r ; : catch> r> lastrp @ >r ep @ >r rp@ ep ! uncatch >r >r ; : (fails ( --) r> <catch dup 2+ >r \ fails-ip catch> dup @ + >r ; \ rstack: fails oldrp oldep uncatch : (exits ( --) <catch r> dup 2+ >r \ exits-ip catch> dup @ + >r ; \ rstack: exits oldrp oldep uncatch : (#fails ( n--) r> rp@ over 2+ >r \ fails-ip saveargs swap dup @ + swap catch ; \\ EH:the concept clv24feb88 This level-(and sytem-!!)-dependant, nestable exception-handler is able to reconstruct stack-pointer and stack-datas. It uses a structured syntax opened by FAILS, #FAILS ( u--), EXITS closed by THEN, RETRY The opening word installs the following clause as errorhandler and continues execution after the closing words. If ABORT" or ERROR" is invoked during this execution the installed errorclause is executed. It may RETRY execution or THROW away execution to the surrounding errorhandler, which may be for example the top-level errorhandler installed by QUIT. It remains the possiblitity to install a post-mortom-handler on lowest level. \\ EH:returnstack catch-throw clv24feb88 r( --f) begins frame r( f--u f) adds word to frame r( f--u*Bytes f) adds bytes at addr removes frame r( f--f unstack-pfa) ends frame r( f--f errorLink uncatch-pfa) continues execution at installed error-h andling-clause if ERR. Else like EXIT. -------------------------------------- f is the rstack-pointer above frame ep points to a linked list of errorhandling-frames frame means a data-block on retStack \\ EH:(exits (fails (#fails clv24feb88 RSTACK after execution of: (exits (fails (#fails ----------- --------- --------- ........... ......... ......... ........... ......... .... <--+ ........... ......... arg1 ^ ...rstack.. ..rstack. arg2 ^ ...before.. ..before. .. ^ ...(exits.. ..(fails. argU ^ ........... ......... u ^ ........... ......... sDepth ^ ........... .... <--+ GETARGS ^ handle <--+ handle ^ handle ^ f -->-->-+ f -->--+ f -->--+ +->oldEP oldEP oldEP--> ^ UNCATCH UNCATCH UNCATCH ^ ! ! ! ^ ! ! ! ^ V V V ^ EP @ \\ EH:FAILS EXITS #FAILS RETRYclv24feb88 Syntax: : name clause1 beg handle-clause end clause2 ; beg::= EXITS / FAILS / u #FAILS end::= THEN / RETRY handle-clause may contain THROW, ?THROW or other words. It is invoked, if ABORT" or ERROR" is called during execution of clause2. compiles to: (EXITS +--> (FAILS / (#fails ptr ->-+ ^ ptr ->-+ ... ! ^ ... ! THROW ! ^ ?THROW ! ... <--+ ^ ... ! ^ BRANCH ! +--<- ptr ! ... <--+ \\ EH:patches for volksFORTH clv24feb88 ERRORHANDLER called on low level. May used to output post-mortem-information (ABORT" and (ERR" must be patched. Stores following string, performs ERRORHANDLER and THROWs to outer level error-clauses. QUIT must be patched. Installs top-level errorhandler-clause, which executes the same as the old (ERROR-handler, which can be omitted. It also demonstrates the (perhaps only) use of .. FAILS ... RETRY ... ( * ) RDROPs with this mark are necessary when patching words \\ EH:sample.. clv24feb88 DEVON is an example for an action, which must be closed by another: DEVOFF Used to demonstrate EXITS and FAILS .OK .HANDLE .STACK prints silly texts ?Y? prompts for Yes/No and displays the answer OK? is an example for any action, that may cause an error. It asks the User to produce an error or not. ACTION is an example for any action which consumes some arguments and may cause an error. Used to demonstrate #FAILS \\ EH:..sample clv24feb88 TF demonstrates how to use FAILS ... THEN to close an action if an error occures TE demonstrates how to use EXITS ... THEN for the same purpose T# demonstrates how to use u #FAILS ... ?throw ... THEN to save stack-pointer and arguments, so that the error-causing action may be RETRYd after the handling clause decided not to THROW up execution. TEST puts TF, TE, T# in one word \\ EH:ouput of returnstack clv24feb88 ?.N tries to output the name corresponding to adr witch comment string and leaves if possible ?.NAME detects names of PFAs ( ie created bye CREATE:) normal colon-definitions words like BRANCH and (DO with data and nothing else .RS outputs adresses, contents and perhaps right names on retStack and the contents of EP which points to a linked list of errorframes placed on returnstack. <07>l<00><07><07><00>l #<00>2+ <17>P<>#3+<17>PS<17>PM$<17>PG#1-18<><07><01>l<00><07><07><00>l #*2-o<18><>$hTRUEy+<2B><>$tFALSEy+$<00>"-1[$<00>!0<>$<00>1y+$<00>2y+$<00>3y+$<00>4y+$<00>ON +[s$$<00>OFF +<2B>s$%<00><17>CLITT<17>8<><02><07>F<14><0E><07><><07>P<02>l <1F><08>l<EFBFBD>l 6
^WATCH' +<2B>^<08>^ V.z^_c$6<00>^CONT +^<5E><13>^ z^$ +<2B><08>5<>$:$ +<2B><08>R5$ +<2B><08><13>5$ +R$w?1<16><17>(4$7<00>^S +<2B>^4F^<5E>(4<>* ?<3F><08><13><15>R^$7<00>^N +<2B>^<5E>^<5E>(4<><08>u*G* R^$7 _L +<2B>^<5E>^ R^$8'_D +<2B>s<08>^<5E>(4s<08>)<29>
F^<5E><16><><EFBFBD><EFBFBD><EFBFBD>(4"<02>$<24>%<25><07><01>$<24>H<><07>%<25><07><07><04><07><07>%<25><07>l <00>-ROT +<2B><08>$NIP +sh$,UNDER +s<08>$<PICK +<2B><16><12><15>$nROLL +<2B><08>u<12> O<12><16><1D>h$<00>2SWAP +<2B><08><12>O$<00>2DROP<4F><00>2DUP +<2B><08>$ <00>+AH<><07><07><07><><07><03><07>l<> <00>OR<4F>H<><07><07><><07><07>l<>  %K<17>LIT<49><17>8<><02><07>F<14><0E><07><0E><07><18><02><0E><02>l %<00>GLITERAL +<2B><08><00><>b
<00> <20>I $<13> R| $&0<m<18><03><>$<24><>l&f0=<3D><18><07><>P<EFBFBD>&\UWITHIN<49><18> <20><16><01>E$<24><07>%<25>
<EFBFBD>E&<26><07>'<27><>lt'<00><<3C><18><07>$<24><07>%<25><18><02><07><02><14>%q0<><30>E$<24><07>%lo'<00>U<L<18><07>$<24><07>%<25><18><02><07><02><14>E$<24><07>%<25>lql0<>2<EFBFBD>2<EFBFBD>]<5D>\<5C><15>C<EFBFBD><08>l<EFBFBD>l 4<00>\TRACE' +<2B>md\V.<2E>]_c$4{]<5D>BREAK +<2B> d\<08>]$4<00>]TRACEL: +<2B>)I <20>(l<>(<28>d\#$4<00>]+DOD]<5D><>4Q]-DOD]4<00>]+RD]<5D><>4<00>]-RD]4<00>]+PUSHD]<5D><>4<00>]-PUSHD]Z)
^A<><18><02><0E><02><0F>^<5E>$<24>^<5E>%<25>$M^<5E><15><02>f\<5C><03>g\<5C>\<5C><15>C<EFBFBD>l<>\<5C>$M^P<>l\^<5E>^<5E><15><07>$l<00><00>!<08><07>$<24><07>%H<><07>$H<><07><01>$l<><13><00>+!%<08><07>$<24><07>%H<><18>$<24>$H<><07><01>$lDROP}aSWAPu<08><07><><03><07>$<24><><07>$<24><01>H<><00><07>$<24><07><07><>$llDUP<55><08>8<><02><07>F<14><03><07><01>H<><07>l<00>?DUP<55><08>Pl l<><00>OVER<45><08>8<><02><07>F<14><04><07>H<><07><01>l <00>ROT<4F><08><03><07>%<25><01><07><03><07><05> t(E> +s<08>$(<00>0> +<2B>k$(<00>0<> +<2B>q$(U> +sJ$(= +1<16>$(-D0= +|<15>$(;D= +}<16>a$(kD< +<2B><08>1b <00>22 <00>J$ +bsh$)\MIN +<2B><15>})<00>MAX +<2B><15>})<00>UMAX +<2B>J})<00>UMIN +<2B>#})<00>EXTEND +<2B>k$)ODABS +<07>c\<5C>lZ)h\Z)<29>* <20><15><15>Os<08>$2NPUSH +O"<15><08><12><12><08>1<16><08> <20>\<5C><12>$ +<2B>14<>!<21>/<2F>~<7E><> $<13><18><02><0E><02><0F>Mf\<5C>l<00>Mg\P<><50>f\<5C><1C>b\<5C><1D>c\ <20><11><12>\<5C><12><11>1<EFBFBD>bT<11>1<EFBFBD>[?m<17><08>5<><13>R5<>(4u*G*Rw?1<16><17>(4[5<>#<23>1<EFBFBD>!<21>1<EFBFBD>!<21>1<EFBFBD><17>2<EFBFBD>1<EFBFBD>u/<2F>1
!<21>1<EFBFBD>!
!<21><13>\<5C><11>1<EFBFBD><12>R<17><> <20><17>\<5C><14><12>8<><02><07>F<14><02><07>l<00><12>RDROP<4F>EXIT&<13><02><0E><02>l<>?EXIT=<13><14><18><02><07><02>(PVl 3EXECUTE<54><13><07><1C><07><1D><18><02><07><02>luPERFORM +<2B>_$<00>C@<40><13><07>$<24><07>%<25><00><07>$l<00>C!<21><13><07>$<24><07>%H<><07>$<24><><18><04><07><02>l <00>CTOGGLE +d<15>s<08>$<13>L@<40><13><07>$<24><07>%<25>$<24>Xb}$)<00>ABS +Xb<00>$ +O <17><08><12><08>s<08><12>$*<00><19>(DO +<2B>1 <09>*#<23><>(?DO +<2B>1<16>b <09>O<12><08><13><15>h$*3<>BOUNDS +<2B><08>s$*x<><78>ENDLOOP<4F><50><EFBFBD>l<>+<00><><EFBFBD>(LOOP<4F><50><18><01><02><02> <0B><02><00><02>l <00><05><02><0F><><02><0E>l +<00><><EFBFBD>(+LOOP<4F><50><18><07><02><02><07><02><02>q<14><18><02><07><02>(Dl ,<00><><EFBFBD>I<EFBFBD><49><EFBFBD><00>
ER +<2B>zm[T$m_[DISPLAY +?<3F>d<EFBFBD>c$n<00>[B/SCRy+n<00>[.LINE +<2B>9s<08>5<EFBFBD><1D><15>5/?$n<00>[.=== +Rp<>)<29> R=<3D>><3E><><EFBFBD><EFBFBD>$n<00>[PRLIST +<2B><08>9h<08>[R<0E>><3E>$ Screen Nr. <20>=5R<08>>?<3F>[R<19>)<29><00><><EFBFBD><08>[?<3F><><EFBFBD><EFBFBD>h<08>[???<3F>[$0X[TOOLS<4C>,<2C>_<EFBFBD>_zzZ)Z)<29><>j\Nf\<5C><02><0E><02><0F><18><02><02><02><03>b\<5C> VOC-LINKV+<00>UDPV+<2B>
SP@<12><07>$<24><14>%<25>$<24>8<><02><07>F<14><01><07><00>lSP!g<12><07><><07><14><07>l ?UP@_<12>l'w<12>UP!<21><12><04><07><01><><07><00><00><01><18><02><07><02>l <00>RP@<40><12>l'<00><12>RP!<21><12>l<><00><12>>R<><12>8<><02><02>F<03><07><02><07>l}<00><12>R>Q<12>8<><02><07>F<14><02><07><02><07><18><02><02><02>l JR@8<><02><07>F<18>HH<48><02><07><>HH<48><02><01>l ,<00><><EFBFBD>J<1B>PR- <1B>BRANCH"<18><0E><0E>$<24><0F><0E><0F>$<24>l -<1B>?BRANCHd<1B><14><18><02><07><02>(<28>Kl .8>MARK +<2B> <20>I $.\>RESOLVE +<2B> <20>1s$.<00><MARK +<2B> $.<00><RESOLVE +<2B> 1I $.<00>?PAIRS +1<16>3 unstructured$Ih<><68>l<EFBFBD>h<><00><>8<><02><07>F<14><><01>Ȣl/<00>CASE?<1C> <20><16>$AP <09>%QPlq<18>lZ0<00>BIF +<2B> b<1B><1B>$0<00>DTHEN +<2B><19><17>{$0-DELSE +<2B><17><1B> <1B>s{[$0bEBEGIN +<2B><1B>$0_EWHILE +<2B><17><1B><17> b<1B><1B><17><><EFBFBD>$ +<2B><1B><08><17><>1b
h{ <1B><>$0<00>FREPEAT +<2B><17><1B> <1B>$0<00>EUNTIL +<2B><17><1B> b<1B>$1DBDO +<2B> TH-83 3.51 clv13.4.87*C16+*<2A><><EFBFBD><EFBFBD><0E><1D><><EFBFBD><EFBFBD><18><0E><02><0E><03><><EFBFBD><EFBFBD><0F><> END-TRACEe<11><><EFBFBD><13><0E><08>Ʌ<15><02>l 7RECOVERZ)ȅȅ<1D>PFFl +zNOOP <00>ORIGINy+<00>S0V+<00>R0V+
<00>DPV+ <00>OFFSETV+<00>BASEV+<00>OUTPUTV+KINPUTV+Y ERRORHANDLERV+<00>)<29><><1B>$1|C?DO +<2B> :<3A><><1B>$1<00>DLOOP +<2B><17><1B> <20><><EFBFBD> <20><>{$1E+LOOP +<2B><17><1B> <20><><EFBFBD> <20><>{$1<1D>LEAVE +<2B><>Om<17><08><13><15>$2:UM*^<1D><07>$<24><07>%H<>&<26>'<27>'&&&%&$<24><18><07>'<27>'H<><07><>&<26>&<26><06>%P<02>$JP|<7C>'<27>H<>&<26><07><01>$<24><07>%<25>l 3vM* +<2B>k<18><08>b<00>s<08>kb
<00>Oq<16>\Ob}$3<00>* !l4#<23><04>$%<25>=<3D>&QP<11>&P<02>'<27>$PF%F$l<>"<22>&<26>(<28>'<27>)<29>&Q<14>&P<02>'<27>$PF%F$(<28><14>*<2A>$%P<>8<EFBFBD><02>&<26><07><>!H<>'<27><07><>!<18><04><07><07><02><14> <0C><04><07>$H<><04><01><07>%<25><>*<2A>$<24>(HF*<10><> <20>$<24>l b<00>"SOURCE +<2B>!<21><13>b<00>9d$<13>!
!<21>$b<00>#WORD +<2B>#<23>"$b<00>#PARSE +<2B><12>#<23>!<21>2"<22>sOQ!<21><12>1<16>O1<16>!#$b<00>#NAME R(h`'<27>I <20>(l<>(<28>)<29><07>(<28><07>)<29><18><02><07><02><14><07>&<26><07>'&Plt<18>&<26><07>%<25>&<26><07>$%Pl <00>$<18><02>$<24><02>%<25>$h8)<1F>$<24>$<24><02>%<25>) <20>
<EFBFBD>$h<>$<24>$ȅ%<25>$E(P<><50>%E)P<>l n<00>)>NAME +<12><13>b<00><15>1s<08>)<29>b"<15>$ <1B><>2$ +* R<1F><15>$nm*NAME> +<2B>*s<08>R <20>b<00>$n<00>*>BODY + $n<00>*.NAME +1$ +<2B> R<17><>R<17>1b<00><08><08><16> <20>1<16><16><1F>*'#<08><17> $k<00>(?HEADZ)k)| +
)<29>;[
)$l)WARNINGZ) +0)<29>;*'<27>o,<2C>T-2b4*'<27>G*<2A>$exists <20>>$l&)CREATE +<2B> <20>!<21>I o,<2C><13>I V#<23><13><08>R <20>q<16>3 invalid name<6D> *'<08><16> 4)
)<29>b<00>
)#<08><08>(I j(R <20>'<27>(<28> <00><08><13>1b/s<08>s <1B><>$<J!SKIP +<2B><12>b<1B><00><08><13>1b/s<08>s <1B><>$<<00>!/STRING +<2B>E<19><08><08>"1$h)<29>Ia<49> I[<5B><05>ɀ`<60>`=("CAPITAL<41>"<22> d"<22>l >x"
CAPITALIZE"<22><07>$<24><07>%<25>$<24>&<26>D&P<05>l H<>$ d"<22>$l<>"<22>"<22>*<2A><03><07>$<00><10><><18><>!<21>&<26>&<26><>!<21>'<27>'8<>$<24><>!<21>$<24>%<25><>!<21>%<25>
<EFBFBD><07><>!<21><07><>\\ shadow zu 110 clv14may87 rdfirst=0 ==> nicht initialisiert BasisadresLEARSTACKZ'<27><14><04>H<><04><14>l iK'HALLOT +<2B><11><13>1s <17><08>1<16><08><08>u<15>1<16>X'<27>$i<00>'HEAP +<2B><11>"$i%(HEAP? +,(]<12>$ +<2B><08> <20>1<16><08>',(s<08>,(<28>1*'#`'$<13>8<><02><02>F<03><0F><02><0E><18><1C><03><0E><><1C><0F><18>h<><68>l<> +O*'<27><13>*$j8(EDOES> +<2B> <20>(Rl| <20> <20>($ +<2B>R<17><>R<17>1+<2B> <20><13><17> $:W <20>COMPILE +O<12> <17><12>I $;<00> #TIBZ);!>TIBZ)!savesystem clv16may87;!>INZ);<00>!BLKZ);<00>!SPANZ);<00>!TIB +<2B>!<21>$;<00>!QUERY +<2B>!RpF?<3F>!<21>
!<08>!<21><17>!<21>$<<00>!SCAN +<2B><12>b<1B>' mit false antwortet. Terminiert mit false, wenn alle Bloecke durch sind und mit <> false, wenn 'cfa' ein true zuruecklie fert %<25>R%<25>%<25>&<26>%<25>%<25>%%%<25>b<1B><><EFBFBD>%o&<26>R%N%<25><17>%<25>%<25>% T<>$g}&NUMBER +<2B>&<26><08><18>3?kbX$h'LASTZ) +*'<27><13>$h#'HIDE +.'b m<17>o,<2C>$h:'REVEAL +.'b
mo,<2C>$hw'IRECURSIVE +`'$ +.'b d<15>|<15><08>h$h<00>' IMMEDIATE +R@<40>'$h<00>'RESTRICT +R<17><>'$i<00>'
C 7<00>MOVE +<2B><12>JbO<12>$O<12>$8<00>PLACE +<2B><08><12><08><08>O<12><1F>$8 COUNT, <20><07>$<18><01><07><07>%<25><00><07>8<><02><07>Fl<>8" ERASE +<2B><17> $9m FILL<4C> <20> <20><16><>$<24>'<27>
<EFBFBD>(HP<48><50>)JP<4A><50>&<26><06>(HJP<4A><50>l :_ HERE +<2B><11>$:<00> PAD +<2B> Rb<>$:<00> ALLOT +<2B>#$:<00> , +<2B> <08><17> $:E C, +b <13>h<13>$ +b hOb}<16>hN%<25><13><16>;h[$ +R&<26>b R
[$R$<24>b R[$RH<>b R[$R%<25>b<00>[$<13>$ +R,<2C>1sR.1|$ +N%<25>[1;<13>N%#$Z)gH%NUMBER? +F<11>1<EFBFBD>* <20>&N%<25><17><17>RR<00><08>%R%<25>%R-<2D>b[<17><12>%R%<25>%
&b F<08>%R%<25>%% ʑ<07><07>l6V/MOD +<2B>XO<12>$6<00>/ +<2B>2$6MOD +<2B>h$6*/MOD +<2B><12>O<12>$6 */ +(2$66U/MOD +<2B>s%$6eUD/MOD +<2B><12><17>%Os<08>%O$7yCMOVE<56><1F> <20><16>D$P F%<05>l <00>(<28>&HP<48><50>)<29>'l<>7<00>CMOVE><3E><1F> <20><18>%<25>'<27>'<18>%<25>)<29>)<29>%<25>$<18><05><>(<28>&<26>P<EFBFBD>F'F)F%P<><50>l  dF$\NEEDS +V#<23>.2b<00>$$dW$HEX +RF$d<00>$DECIMAL +R
F$e%DIGIT? +R01<16>R #bR<17>1<16>R #bF<11><13>#<19>;h<08>$e%
ACCUMULATE +s<08>sF<11>\h<08>F<11>\<1D>O$e[%CONVERT +<2B>* %%b<00>% <1B><>/$ +<2B>&<26><13>$ +* [<17>&#$ +/* $f<00>%DPLZ)<29><>  +\h$3<00>2*<2A><1D>
<EFBFBD><07>*<2A>l +[<17>3division overflow$4<00>UM/MOD'<1E><07>)<29><07>(<28><18><02><07><02><14><07>%<25><07>$H<><07>'H<><07>&<26><18>*8<>%<25>)<29><>$<24>(<28>&*<2A><04>$<24>%&'&&&%&$JPߠ<01>$<24>%<25> <20>$<13>&<26>H<>%<25>H<>$<24><07><01>'l5M/MOD +<2B><08><12><19>kbd<15>s%<1E>kb<00><16>b s<08><12>s/$5<00>2/<2F><1E>
<EFBFBD>
SER +<2B>)<29><17>+| <20>(<28>8<><02><07>F<14><02><18><04><07>H<EFBFBD><05><01>l pC+ALIAS +<2B>)*'<27><13><08>R <20>b <00><17><><EFBFBD> R <20>'*$q<00>+VPZ)--<2D>]m<>-q,,CURRENTZ)-qe,CONTEXT +1,<2C><08><13> $ +1, _,$qu,ALSO +1,<2C>R
<EFBFBD>~3Vocabulary stack full_,<2C><13>1,#_,$q<00>,TOSS +<2B><17><>1,#+C3<43>#}"$$cO#STATEZ)c<00>#eASCII +C3<43>#<23><16><13>#<23>b&$c<00>#," +R"<22>#<23> <20><08><16> $c$<24>"LIT +OOd* <20><15><12>$c,$<24>(" +3$$cg$A" +<2B> l$$$dt$<24>(." +3$* ?$d<00>$B." +<2B> <20>$$$d<00>$a( +R)<29>#<23>$d<00>$b.( +R)<29>#?$d<00>$a\ +<2B>!<21><13>5<1F><16>5<EFBFBD><1D>!$d<00>$b\\ +d<>!$<10>b<00>@(b<00>$|* R<1F>? <00>$???4$o<00>*: +<2B>)a'o,<2C>_,)0<><17>(<28>8<><02><02>F<03><0E><02><0F><02><18><02><0E><><1D>l o<00>*A; +<2B><17><1B> $0`'$o0+CONSTANT +<2B>)I <20>(<28>8<><02><07>F<14><02><1C>H<><1C><01>l of+VARIABLE +<2B>)<29><17> $p<00>+UALLOT +<2B><12><13>R<17>#<19>3
Userarea full<12>s#$p<00>+U clv22feb88 clv22feb88 \\ shadow zu 116 clv14may87 Uebertraegt den Block mit Nummer 'blk' in den Bereich ab ['toadr'. Falls Block nicht vorhanden: leeren Block uebertragen. Falls Laenge des uebertragenen Blocks > 1024 ist der Blockmechanismus " damaged". Uebertraegt den Block der Nummer 'blk' nach ['fromadr' in die Ramdisk. Er wird falls bereits vorhanden erst geloescht. clv23feb88 create: getargs s0 @ r> - sp! sp@ r@ 1+ 2* r>move ; : (#fails ( ..args.. n--..args..) >r r@ sp@ s0 @ swap - sp@ r> 2+ 2* ( .args. n depth from bytes) r> <catch dup 2+ >r -rot move>r nip nip getargs >r catch> dup @ + >r ; restrict \\ shadow rdboot clv14may87 weitere Versuche: 2e/f loescht die RamDisk, wenn vorhanden. Fuehrt beim Booten (1.Kaltstart) aus: : rdboot limit $c000 u> IF $c000 $533 ! ELSE limit rdfirst ! $fd00 rdlimit ! rdnew 'rdboot THEN ; versetzt das System in einen Vor-Boot- Zustand, wie er von SAVESYSTEM gebraucht wird \\ shadow zu 119 clv14may87 Druckt die wichtigsten Ramdisk-Zeiger aus und prueft sie auf Konsistenz. Muss ggf. angepasst werden. - rdfirst = off: " not initialized" - Pointer drucken - " - " - Pointer gegeneinander pruefen .. " pointer error" - Ramdisk-Bereich oberhalt von limit?? .. sonst " limit too big" - aktuelles R/W drucken .. wenn oberhalb 'here' " forgotten" \\ shadow zu 11a clv14may87 Testet einen Block auf Konsistenz druckt Block-Nummer druckt Block-Basisadresse druckt Laenge Expandiert Testweise druckt die ersten Zeichen des Block druckt expandierte Laenge. Ist sie " too big" ? Falls der Block zu lang expandiert, wuerde er beim Lesen den Block-Mechanismus zerstoeren. In diesem Fall die Laenge ' n Basisadresse ! ' korrigieren oder den Block und alle folgenden aus der RamDisk loeschen mit: ' basisadresse rdafter ! ' \\ shadow zu 11b clv14may87 Prueft die Konsistenz der Ramdisk und druckt alle zentralen Daten aus. Es aendert nichts. Dies muss der Benutzer anschliessend tun. Zur Uebersicht: limit error == limit > rdfirst pointer error == rdfirst > rdafter oder rdafter > rdlast forgotten error == R/W-Zeiger falsch len error == Block zu lang end error == EndeDesLezten Blocks > rdafter \\ shadow zu 11c clv14may87 keine ramdisk=>abort / namen wird .. .. dem Betriebssystem uebergeben .. Geraet setzen (Supertape) .. Endadr+1 .. Anfangsadr .. binaer sichern beim ersten cold wird ramdisk geladen und screen 100 ausgefuehrt. \ shadow zu rdboot-test clv14may87 Funktionen: - loeschen einer vorhandenen Ramdisk - Erzeugen einer neuen (limit pruefen) - & loadDown SER +<2B>)<29><17>+| <20>(<28>8<><02><07>F<14><02><18><04><07>H<EFBFBD><05><01>l pC+ALIAS +<2B>)*'<27><13><08>R <20>b <00><17><><EFBFBD> R <20>'*$q<00>+VPZ)q,,CURRENTZ)qe,CONTEXT +1,<2C><08><13> $ +1, _,$qu,ALSO +1,<2C>R
<EFBFBD>~3Vocabulary stack full_,<2C><13>1,#_,$q<00>,TOSS +<2B><17><>1,#<04><08><13>1b/s<08>s <1B><>$<J!SKIP +<2B><12>b<1B><00><08><13>1b/s<08>s <1B><>$<<00>!/STRING +<2B>E<19><08><08>"1$h)<29>Ia<49> I[<5B><05>ɀ`<60>`=("CAPITAL<41>"<22> d"<22>l >x"
CAPITALIZE"<22><07>$<24><07>%<25>$<24>&<26>D&P<05>l H<>$ d"<22>$l<>"<22>"<22>*<2A><03><07>$<00><10><><18><>!<21>&<26>&<26><>!<21>'<27>'8<>$<24><>!<21>$<24>%<25><>!<21>%<25>
<EFBFBD><07><>!<21><07><><05>b<00>@(b<00>$|* R<1F>? <00>$???4$o<00>*: +<2B>)a'o,<2C>_,)0<><17>(<28>8<><02><02>F<03><0E><02><0F><02><18><02><0E><><1D>l o<00>*A; +<2B><17><1B> $0`'$o0+CONSTANT +<2B>)I <20>(<28>8<><02><07>F<14><02><1C>H<><1C><01>l of+VARIABLE +<2B>)<29><17> $p<00>+UALLOT +<2B><12><13>R<17>#<19>3
Userarea full<12>s#$p<00>+U+<2B> <20><13><17> $:W <20>COMPILE +O<12> <17><12>I $;<00> #TIBZ);!>TIBZ)!;!>INZ);<00>!BLKZ);<00>!SPANZ);<00>!TIB +<2B>!<21>$;<00>!QUERY +<2B>!RpF?<3F>!<21>
!<08>!<21><17>!<21>$<<00>!SCAN +<2B><12>b<1B> clv15may87  LEARSTACKZ'<27><14><04>H<><04><14>l iK'HALLOT +<2B><11><13>1s <17><08>1<16><08><08>u<15>1<16>X'<27>$i<00>'HEAP +<2B><11>"$i%(HEAP? +,(]<12>$ +<2B><08> <20>1<16><08>',(s<08>,(<28>1*'#`'$<13>8<><02><02>F<03><0F><02><0E><18><1C><03><0E><><1C><0F><18>h<><68>l<> +O*'<27><13>*$j8(EDOES> +<2B> <20>(Rl| <20> <20>($ +<2B>R<17><>R<17>1 +\h$3<00>2*<2A><1D>
<EFBFBD><07>*<2A>l +[<17>3division overflow$4<00>UM/MOD'<1E><07>)<29><07>(<28><18><02><07><02><14><07>%<25><07>$H<><07>'H<><07>&<26><18>*8<>%<25>)<29><>$<24>(<28>&*<2A><04>$<24>%&'&&&%&$JPߠ<01>$<24>%<25> <20>$<13>&<26>H<>%<25>H<>$<24><07><01>'l5M/MOD +<2B><08><12><19>kbd<15>s%<1E>kb<00><16>b s<08><12>s/$5<00>2/<2F><1E>
<EFBFBD>
%<25>R%<25>%<25>&<26>%<25>%<25>%%%<25>b<1B><><EFBFBD>%o&<26>R%N%<25><17>%<25>%<25>% T<>$g}&NUMBER +<2B>&<26><08><18>3?kbX$h'LASTZ) +*'<27><13>$h#'HIDE +.'b m<17>o,<2C>$h:'REVEAL +.'b
mo,<2C>$hw'IRECURSIVE +`'$ +.'b d<15>|<15><08>h$h<00>' IMMEDIATE +R@<40>'$h<00>'RESTRICT +R<17><>'$i<00>'
Csm <1B><>2<15>$v<00>.' +V#<23>.<2E><18>3Haeh?$vR.I[COMPILE] +V.I $v<00>.C['] +V.&$v/ NULLSTRING? +<2B><08><13><18>b2$H<18><1C><02>H<><1C><00><0F>l w/
>INTERPRET0/<2F>/xf/NOTFOUND]0<>/xy/
NO.EXTENSIONS +~3Haeh?$x<00>/ INTERPRET +s/ +-1V#<23>.<2E>b<00><17>b_s/<2F>3 compile on+b <13>h<13>$ +b hOb}<16>hN%<25><13><16>;h[$ +R&<26>b R
[$R$<24>b R[$RH<>b R[$R%<25>b<00>[$<13>$ +R,<2C>1sR.1|$ +N%<25>[1;<13>N%#$Z)gH%NUMBER? +F<11>1<EFBFBD>* <20>&N%<25><17><17>RR<00><08>%R%<25>%R-<2D>b[<17><12>%R%<25>%
&b F<08>%R%<25>%%6<><03><07>$<00><10><><18><04>&<26>&H<><04>'<27>'<27><>6<EFBFBD>(<28><>6<EFBFBD>) <20>6P<1D><18><02><07><02><14><01><18>(<28><07>)<29><00>l&<13>(<28>*<2A>)<29>+<2B>*<2A>(<28><01>*<2A>)(Pl <20>6P<36><50>(<28>*<2A><01>(<28>*<2A><>6<EFBFBD>(<28><>6<EFBFBD>(<28>(<28><>6<EFBFBD>)<29><>6l<36>6 +<2B><17>s <17>p$ +<2B><08><11><13><15><08>6<EFBFBD>77b<13><15>6<EFBFBD>R<14>$<13><15><12><11><13><15><12>6<EFBFBD><13><08><13><08>b
h$<13>OO<12><15><12><12>77<37>b2 R<><52>?<00><00>?KEY?<3F>?<02><00>?DECODE<44>?<04><00>?EXPECT<43>?<06>SEAL +<2B><17>-<2D>*$<13>K?$ONLY-<2D><00>?%FORTH-<2D><00>?%WORDS<44>-<2D><00>?$ALSO<53>,<2C>@+DEFINITIONSz- +<12><13>m<17><13><08>1<08><13><08>b<1B><>$ +<2B><17>6;*;I;$<13><00>?'COLD]01i + @@@'?\@>-<2D>$ultraFORTH-83 rev 3.5??a<>t@'RESTART]01i +<2B>l5<6C>$Dr hd=5<>5<EFBFBD>)<29>&?<3F><><EFBFBD>543<><13>9<EFBFBD><39><EFBFBD>5<EFBFBD><1D><15>5/U3?<3F><><EFBFBD><EFBFBD>?$<13><00>5PAUSE <00><00>5LOCK +<2B><08>]1bh$<13><08>b<00>5 <1B><>]s$<13><00>5UNLOCK +<2B>6<>$<13>8<EFBFBD><05><04><><00><05>l<EFBFBD><04><06><04>H<><04><14><01><07><02><07><03><18><02><07><02><14>l<><12>/6FILEV+<1C><00>6PREVZ)Z)<00><00>6B/BUFy+<04><02>(Y"PH<>P<>`<60>?CR +w?<3F>5R
1#b?$ +<2B>)<29>| <17>(l<>(<28>T<11><13><15>$<13><00>>OUTPUT: +<2B>))0<>(l<>(T$<13>V>EMITE><00><00>>CRE><02><00>>TYPEE><04> ?DELE><06>?PAGEE><14> ?ATE>
<EFBFBD>,?AT?E> <0C>6?ROW +<?h$<13>a?COL +<?2$ +<2B>)<29>| <17>(l<>(<28><13><11><13><15>$<13>q?INPUT: +<2B>))0<>(l<>(<28>$<13><00>?KEY<45><17><>R0<>i4$<13><00>4#S +<2B>4<EFBFBD>ab<1B><>$<13>D4D.R +"d<15>`4I4<49><08>4<EFBFBD>4<EFBFBD><08><08><19>1(4?$<13>Y4.R +sX<19><08>4$<13>5U.R +<2B>s<08>4$<13>5D. +<2B><17>44$<13>(5. +X-5$<13>95U. +<2B>-5$<13>g5.S +<12><11><13>1R E<19><>:<3A><00><><EFBFBD>l5<6C><17><><EFBFBD><EFBFBD>$<13>v5C/Ly+)<00><00>5L/Sy+<00><00>5LIST +3<08>$Scr 3<><13><00>=(FORGET +<2B>@(<28>3 is symbol<6F>;<3B>=$<13><00>=FORGET +V.<2E><08>$<10>J<18>3 protectedu*<2A>@(b<00>* mm<17>=$<13>H=EMPTY +<2B>$<10>]<12>=<3D>2<10>$<13>>SAVE +<2B> ]<12>=<12><13>mm<17><13>m<08><13><08>b<1B><>]<12><11><01>$<13>'>BYE +g:
>Wc$ +<2B>?<3F>1b[$<13>`>STOP? +<2B>?b<00>><3E>><3E>$<13><00>>3$$`<00>3BLy+ `<00>3 -TRAILINGW3<57> <20><16><07>&<18><07>%<25>'<27>$<18><13><>&I <20> HP<02>%<25>h<EFBFBD>%l<><1B>P<EFBFBD>F'F%<10><>lZ<1B>I3SPACE +C3<43>>$<13>
4SPACES +<2B>:<3A>4<><34><EFBFBD><EFBFBD>$ +<2B> m$<13>4HOLD +[84#84<38><13>$<13>b4<# +8484$<13>[4#> +<2B>84<38>84<38>1$<13><00>4SIGN +kbR-i4$<13><00>4# +F<11><13><1F>R <09><08>bR-<2D>'l<><<3C>(E,<2C>)<29>-<2D> <0B>,<2C>$<24>,<2C>$lH<<3C>,<2C>$<24>-<2D>%l<><l} +<12><13>b<00><08><12>1<16><O <1B><>$ +]<12><16><08>]1b(<00><15>s<08> <20>b<00><08><13><16><13>/ <00> N<><4E>$ +<12><<3C>,)<29> <00><15><><EFBFBD>"<15>b
<00>-<2D><><08><17><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>o,<2C>"<15>b
<00>-o,$ +<2B><08><(=N<,(s1<16>'<27><08>*'$<13><00>;CLEAR +<2B> <20>]<12>=<3D>$<13>QUIT +<2B><11><13>0<>2^<00>2 STANDARDI/O +<2B>*T<11><17>$^K2'ABORT]0<>^<00>2ABORT +X'c<11>2Y2<59>2_<00>2SCRZ)_3R#Z)_<00>3(ERROR +Y24<> G** ?4<>><3E>!<21><13>b3<08>!<21>3<08>2_%3<>(ABORT" +3$sb<00>X'O<12><11>$h$ +3$sb<00><11>$h$_z3FABORT" +<2B> <20>3$$_<00>3FERROR" +<2B> ~*;<3B><13>s<08>6*;#$<13><00>; ALL-BUFFERS +*;<3B>>;*;<3B>1b<1B><>$ +<2B>R <20>$ +<2B>*d<15>Js@(|$ +,(<12><13>O<12><13>b^<00><08><12>1<16>O<12><13><12>/<17><08>Js<08> <17>*J<18>b.<00>@(bZ<><5A> <17>;b<00><08> <17>;b <00> * <17> <1B><> <1B><>$<13><<3C><05><07>$<00><10><><18><04><06>*H<><04><00>+<2B><01>$<24>,<2C>$<24>-,<2C>5<EFBFBD>,E*<2A>-<2D>+<2B> <0B>,E&<26><14>!<08>!<21>1<EFBFBD>!<21><17>1<EFBFBD>/$]<00>1+LOAD +<2B>!<21><13><15>1$]O1THRU +<2B>s)<29>
<00><><EFBFBD>1<EFBFBD><31><EFBFBD><EFBFBD>$]<00>1+THRU +<2B>s)<29>
<00><>W1<57><31><EFBFBD><EFBFBD>$]2c--> +<2B><17>!#<08>!<21><17>1$] 2RDEPTH +<2B><11><13> 1<16>$]82DEPTH +<12><11>s1<16>$ +<2B>#<23>b<00>$
compiling$<13>$ ok$^s2(QUIT +<2B>1?<3F>!<21>/<2F>2 <1B><>^<00>2'QUIT]0<>2^<00>2 [<17><17><><EFBFBD><16>o:<3A><><EFBFBD><EFBFBD> O<12>:<3A><00>o:<3A><17><17><16><><EFBFBD><EFBFBD><EFBFBD>9<EFBFBD>$<13>?:COPY +<2B>}:$<13><00>:CONVEY +s<08><16>u1<16>q<16>3nein}:$<13><00>:LIMITy+<00><>;FIRSTZ)<00>"; ALLOTBUFFER +*;<3B><13><11>1<16>6 J;<13>6<EFBFBD>*;#*;<3B><13><08>8<EFBFBD>6<EFBFBD><13><08>6$<13>0;
FREEBUFFER +*;<3B>;<3B>61Jb(<00>9<EFBFBD><08>*;<3B>1b<00> <1B><>
V.<2E><08>0<EFBFBD>*<2A>#<23>b
<00> <20>0I $$ +[2R <20><18>3 tight stack`'.'b<00>@(b<00>* <00>1<16>=[<17>3dictionary full$[<00>0?STACK/1<> 8<><07><04>$H<><14>P <09> <20>Y0$<13><14>EH<><04><14><01>l <20>[<17>3 stack empty\$1.STATUS]0<>Z)OO$\<00>1<EFBFBD>PUSH +Os<08><08><12><13>}1<><12>$\<00>1LOAD +<2B><08>;<13>!<21>1 R +<2B>9<EFBFBD>9$<13><00>9BLOCK +<2B>9<EFBFBD>9$<13><00>9UPDATE +R<17><>6<EFBFBD>"<17><16>$<13>H9 SAVE-BUFFERS +<2B>669<>b,8 <1B><><EFBFBD>686$<13><00>9
EMPTY-BUFFERS +<2B>66<>6<EFBFBD><13>b
<00><08>8 <1B><><EFBFBD>686$<13>:FLUSH +<2B>9:$ +<2B><08>9y9b<00>6<EFBFBD><13>879b<00>9<EFBFBD><11><13>s<08>9mmQ9$ +<2B>9<EFBFBD><12><08><12><15>#<19><12>JO<12>b$<00><12><12>O<12>:<3A> ly/;<13>&<26>b<00>/s/ +-1V#<23>.<2E>bb_s/I s//;<13>&<26>bbs&& <00>/s/y<00>/a[ +<2B><17>/<2F>0u/<2F>#<23>$y0] +<2B>Q/<2F>0u/<2F>#<23>$ +[<17>3Crash$z%0DEFER +<2B>)<29>90I <20>(<28><02>hH<68><1C>ȅ<1C>lzi0(IS +O<12> <17><12>$ +<2B><13><17>/<2F><13>1s<08>s/<2F>1|q<16>3 not deferred$z<00>0bIS +
<15><08>R<14>"<15>(8b<00>$read 8 Y<>O$ +<2B>6<EFBFBD><08>b<00><13> <17>[1b<1B><><EFBFBD>66<>,8$ + <17><12><15><08><11><13><15> O<17><17>686$ +<2B>6<EFBFBD><13>b<00>"<17>kb<1B><>$ +<2B>6<EFBFBD><13><08><13>b<1B><>"<17>k$<13>"8CORE? +i7<69><15>$<13>q9(BUFFER +i7S8<53>8 <1B><><EFBFBD><00>9(BLOCK +i7S8<53>8<EFBFBD>8 <1B><><EFBFBD>9<EFBFBD><1C>hH<68>l<><1B>}9BUFFE<17>2<EFBFBD>0<EFBFBD>2<EFBFBD>d<EFBFBD>@<40>.<10><13><08><17><11>0<EFBFBD>23<><00>@COLDG@<40>@h<><68>h Xix<69><18> <10><06>$<24>!<10><00>%<25><10>$HP<48> Xi<58><1B><11><00><10><18> <10><06><04>!<10><00><05><14><04>H<><04><14>
<EFBFBD><04>H<><04><03><00><01><><02>ȅȅ<0F><00>l <00><00>@RESTARTaa<61>@h<><68>hl<68>@~5aC64KEY?xa<78><61>
]<05><02><>hl<68>~laGETKEY<45>a<EFBFBD>><3E> <20><><EFBFBD>?<3F>lZ<00>aCURON<4F>a<EFBFBD>J<18>H<EFBFBD>
<EFBFBD><EFBFBD>I<EFBFBD><00> <0B> <0C><08><13><08>6<EFBFBD><13><08>6 <1B><><EFBFBD><00>6(DISKERR +<2B>$error ! r to retry <20>?<3F>Rr1sRR1|q<16>3aborted$<13>L7DISKERR]0W7<57>8R/W]0<>g +<2B>"<17>kbj <17><08><13>b3<00><11>1T<11>1Y2<59>"<17> <17><13>u<15><13>(8b<00>$write 8 <1B><>R<17><><17>Vh$ + <17><08><17>$ +<2B><08>8<EFBFBD><11>1T<11>1Y2<59><12><08><11><13>INDEX +<2B>h)<29>!?<3F><><EFBFBD>5<><35><EFBFBD>9<EFBFBD>R%?<3F>>bb<1D><><EFBFBD><EFBFBD>$<13><00>hFINDEX +<2B>gb<00>$<13>h)<29>1?<3F><><EFBFBD>5<> <20><08><><EFBFBD><1D>Pfg<><12>R%?O<12>>|bb<1D><><EFBFBD><EFBFBD>Gg$<13><00>hINK-POTZ)<29><><00><><00><><00>
iC64INIT3iآ<69><D8A2><EFBFBD>><3E> <20><><EFBFBD>?<3F><>><3E> <20><><EFBFBD>?<3F><>i<><19><><EFBFBD>i<EFBFBD><15><>i<>;<05><><EFBFBD>@<05><13> <04><13>xl,a<>'i(BSAVE<56>i<EFBFBD><69><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>><3E> X<><58>?<3F><>

<00>(2064)<00>lG8<47>la9l{ b.{{<>bF;<3B>:.+<2B>a$volksFORed<7F>5;f$<13>?gDISKOPEN +dR
teR#Ced;f$<13><00>g DISKCLOSE +dR
<EFBFBD>ed$<13><00>g1541R/W +s<08>3no file"<15>c<EFBFBD><1E><08>c<08>#b<1B>=5<>$beyond capacity2$<13>gbh2$<13>s<08><1D><1D><17><>)<29>.h<08><15><><EFBFBD>b
Pfg Pfmg<6D><12>f<EFBFBD>O<12>bb<1D><><EFBFBD><EFBFBD>"<15>Gg$ +R<17>EsR<17>E<19><15>bs<08>s$<13>VgTH-83 3.51 c64 clv9.4.87 <20><><EFBFBD><EFBFBD><0E><1D><><EFBFBD><EFBFBD><18><0E><02><0E><03><><EFBFBD><EFBFBD><0F><> END-TRACEe <09><><EFBFBD><13><0E><08>Ʌ<15><02>l 7 RECOVERZ!ȅȅ<1D>PFFl #z NOOP <00> ORIGINy#<00> S0V#<00> R0V#
<00> DPV# <00> OFFSETV#<00> BASEV#<00> OUTPUTV#K INPUTV#Y ERRORHANDLERV#<00>b<00>f1R<13>R<11>$<13><08>fJb<00>f1R<12>R<18>$<13>f1R<11>R<1E>$ +<2B>f<EFBFBD>s$ +F<11>1%<25>`4I4hR,i4I4<49>4$y+<01>1f
READSECTOR +dR>el$u1:13,0,* <20>eZf<5A>ed<7F>5;f;dR
<EFBFBD>e<EFBFBD>ffd<7F>$<13><00>f WRITESECTOR +<2B>dR>el$b-p:13,0* <20>eddR
>e<>f<EFBFBD>eddR>el$u2:13,0,* <20>eZf<5A> VOC-LINKV#<00> UDPV#<23>
SP@
<EFBFBD><07>$<24><14>%<25>$<24>8<><02><07>F<14><01><07><00>l
SP!g
<EFBFBD><07><><07><14><07>l ?
UP@_
<EFBFBD>l'
w
<EFBFBD>UP!<21>
<EFBFBD><04><07><01><><07><00><00><01><18><02><07><02>l <00>
RP@<40>
<EFBFBD>l'
<00>
<EFBFBD>RP!<21>
<EFBFBD>l<>
<00>
<EFBFBD>>R<>
<EFBFBD>8<><02><02>F<03><07><02><07>l}
<00>
<EFBFBD>R>Q
<EFBFBD>8<><02><07>F<14><02><07><02><07><18><02><02><02>l J
R@$ `<60>><3E> <20><><EFBFBD>?<3F><>&<26><>l,a<><00>eBUSIN +<2B>d6<>e$<13><00>eBUS!Ee<45><07>><3E> <20><><EFBFBD>?<3F>l<EFBFBD><12><00>eBUSTYPE +<2B><>:<3A> <00><><EFBFBD>Ce<43><65><EFBFBD><EFBFBD><EFBFBD>5$<13>UeBUS@f<>><3E> <20><><EFBFBD>?<3F>lZ<1B><00>eBUSINPUT +<2B><>:<3A> <00>e<EFBFBD><65><EFBFBD><13><><EFBFBD><EFBFBD><EFBFBD>5$<13>fDERROR? +dR<0F>e<EFBFBD>e<EFBFBD>R01b<00>><3E>e<EFBFBD><08>a1b<1B><><EFBFBD>?<3F>d$y+<2B>y+<2B>y+v +<2B><08>fJb R<15>$<13><17><15><08>fJ <09>
<EFBFBD>8<><02><07>F<14><02><07>l<00>
<EFBFBD>RDROP<EFBFBD>
 EXIT& <0B><02><0E><02>l<>
 ?EXIT= <0B><14><18><02><07><02>(PVl 3 EXECUTE<54> <0B><07><1C><07><1D><18><02><07><02>lu PERFORM #<23> _ $ <00> C@<40> <0B><07>$<24><07>%<25><00><07>$l<00> C!<21> <0B><07>$<24><07>%H<><07>$<24><><18><04><07><02>l <00> CTOGGLE #d
<EFBFBD> s <0C> $ <0B>L @<40> <0B><07>$<24><07>%<25>$<24>$<13><00> <20>d<7F>686[<17>3 no device<63><65><EFBFBD>><3E> <20><><EFBFBD>?<3F><>`<60>><3E> <20><><EFBFBD>?<3F><>><3E> <20><><EFBFBD>?<3F><><EFBFBD><EFBFBD><05><>l<EFBFBD>d`<60>d<EFBFBD> <20>d<EFBFBD><18><02><07><02>l<>d<EFBFBD><00>d?DEVICE +<2B>d6<>d$e<><65><EFBFBD> <20><16>& <20>d<EFBFBD>&<26>><3E> <20><><EFBFBD>?<3F><>$ `<60>><3E> <20><><EFBFBD>?<3F><>&<26><>l,a<><00>dBUSOUT +<2B>d6e$<13>5eBUSOPEN +R<17>|>e$<13>jeBUSCLOSE +R<17>|>ed${e<><65><EFBFBD> <20><16>& <20>d<EFBFBD>&<26>><3E> <20><><EFBFBD>?<3F><> <07>$l<00><00> ! <0C><07>$<24><07>%H<><07>$H<><07><01>$l<> <0B><00> +!% <0C><07>$<24><07>%H<><18>$<24>$H<><07><01>$l  DROP}
a SWAPu <0C><07><><03><07>$<24><><07>$<24><01>H<><00><07>$<24><07><07><>$ll DUP<55> <0C>8<><02><07>F<14><03><07><01>H<><07>l<00> ?DUP<55> <0C>Pl l<> <00> OVER<45> <0C>8<><02><07>F<14><04><07>H<><07><01>l <00> ROT<4F> <0C><03><07>%<25><01><07><03><07><05><14> <20><16>D$<24><16>& <20>b<EFBFBD><02>.<2E>><3E> l<><6C>?<3F>Hl<48>cl<63>b<EFBFBD><00>cDISPLAY<41>><3E>b<EFBFBD>b<EFBFBD>c c(c;c^cYc<59>><3E>lr<6C><72><00>cB/BLKy+<04><00>cBLK/DRVy+<2B>Z) +<2B>c<EFBFBD>R<14>$<13><00>cDRIVE +<2B>c<EFBFBD><1D>$<13>d>DRIVE +<2B>c<EFBFBD><1D><15><11>1$<13>&dDRV? +<2B><11><13><15>c$<13>adDRVINIT +<2B>$<13>xdI/OZ)<00><00>dBUSOFF<46>d<EFBFBD>><3E> L<><4C>?<3F><><01> <20><11>d86
<EFBFBD>$<24>%<25><07><01>$<24>H<><07>%<25><07><07><04><07><07>%<25><07>l <00> -ROT #<23> <0C> $ 
NIP #s h $ ,
UNDER #s <0C> $ <
PICK #<23><0E>
<EFBFBD>
<EFBFBD> $ n
ROLL #<23> <0C>
u

<EFBFBD> O
<EFBFBD><0E><15>h $ <00>
2SWAP #<23> <0C>
<EFBFBD> O
$ <00>
2DROP<4F> <00>
2DUP #<23> <0C> $ <00>
+A
H<><07><07><07><><07><03><07>l<>
<00>
OR<4F>
H<EFBFBD><07><07><><07><07>l<>

<EFBFBD><14>K<EFBFBD>O<EFBFBD> <20><11>5$I<><49>I `I<><49>I<>``<60><00>b
PRINTABLE?Ib<49> <20>b<EFBFBD>J<>lP<1B><00>bC64EMIT<49>b<EFBFBD> <20>b<EFBFBD><02>.l<>b<EFBFBD>WbC64CR +<2B>a<EFBFBD>b$<13><00>bC64DEL +R<17><>b4R<17><>b$<13>cC64PAGE +R<17><>b$<13>cC64AT=c<> <20><16>&<26>$<18>><3E> <20><><EFBFBD>?<3F>l,a<>3cC64AT?`c<>8<><02><07>F<14><>8<>><3E> <20><><EFBFBD>?<3F><>(<28><><02>(h<><68><00><07>lZ<1B>ucC64TYPE<50>cW
AND<4E>
H<EFBFBD>1<07><07><><07>1<07>l<>
<00>
XORH<>q<07><07><><07>q<07>l<>
!-3H<>8<><07>H<><07><01><07><03>l<>
!-NOTs<18><><07><07><><07>l !kNEGATE<54>8<><38>"<00>DNEGATEH8<48><38><07>H<><48><07><07><><07><07><01><><07>l
<EFBFBD><EFBFBD><EFBFBD><EFBFBD><07>$<00><10><><18><07><07><02><14><00>`"<00>D+<2B><0E> <20>H<><18>&<26>H<><07>'<27><07><07>$<24><07><01><07>%<25>l #<00>1+<2B><0E><18> l <00>aCUROFF<46>a<EFBFBD><61><EFBFBD> <0C><>
<EFBFBD>l <00><00>aC64KEY +<2B>a<EFBFBD>5vab<1B><><EFBFBD>a<EFBFBD>a$<13><00>a#BSy+<00>Ua#CRy+
<00><00>a C64DECODE +<2B>a<EFBFBD>b<00>b?/$<13>a<EFBFBD>b
<00><08>!$<13><12><15><15>s<08>O<12>><3E>$<13><00>a C64EXPECT +<2B>!<08><17><08>!<21>Jb
<00>?<3F>? <1B><><EFBFBD>4$<13>5bKEYBOARD<52>?Aava<76>aab<61><00>bCON!<21>b<EFBFBD><07>><3E> l<><6C>?<3F><><18><02><07>yPUTAy+{<00>jWy+{<00>jSETUPy+<2B>{<00>jNEXTy+ {<00>jXYNEXTy+,a{<00>jPOPTWOy+<2B>{HjPOPy+}<12><><1D>Pfg<><12>R%?O<12>>|bb<1D><><EFBFBD><EFBFBD>Gg$<13><00>hINK-POTZ)<29><><00><><00><><00>
iC64INIT3iآ<69><D8A2><EFBFBD>><3E> <20><><EFBFBD>?<3F><>><3E> <20><><EFBFBD>?<3F><>i<><19><><EFBFBD>i<EFBFBD><15><>i<>;<05><><EFBFBD>@<05><13> <04><13>xl,a<>'i(BSAVE<56>i<EFBFBD><69><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>><3E> X<><58>?<3F><><07>l<00><07><07><00>l #<00>2+ <0F>P<>#3+<0F>PS<0F>PM$<0F>PG#1-18<><07><01>l<00><07><07><00>l #*2-o<18><>$hTRUEy#<23><>$tFALSEy#$<00>"-1[$<00>!0<>$<00>1y#$<00>2y#$<00>3y#$<00>4y#$<00>ON #[s  $ $<00>OFF #<23>s  $ %<00><0F>CLITT<0F>8<><02><07>F<14><0E><07><><07>P<02>l <05>lP<1B><>lP<1B><00>i(BLOAD<41>i<EFBFBD><69><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><00>><3E> U<><55>?<3F>l<EFBFBD>i<EFBFBD>><3E><><07><07>h<>h<><68>h<><00>l<><6C><EFBFBD>?<3F>@8<>><3E> <20><><EFBFBD>;<3B>;<3B><1E><>i<EFBFBD><07><10><><07><><EFBFBD><EFBFBD><00><><EFBFBD><EFBFBD>?<3F>`<60><00>iFORTH-83 +${j ASSEMBLER<45>,Wj-{PUSHAy+P{'jPUSH0Ay+Z{5jPUSHy+<2B>{djRPy+{qjUPy+{\jSPy+{<00>jIPy+{<00>jNy+${}jʑ<07><07>l6V/MOD #<23>
XO
<EFBFBD>$ 6<00>/ #<23>2
$ 6MOD #<23>h $ 6*/MOD #<23>
<EFBFBD>O
<EFBFBD>$ 6 */ #(2
$ 66U/MOD #<23>s %$ 6eUD/MOD #<23>
<EFBFBD><0F>
%O
s <0C>
%O
$ 7yCMOVE<56><17> <20><0E>D$P F%<05>l <00>(<28>&HP<48><50>)<29>'l<>7<00>CMOVE><3E><17> <20><18>%<25>'<27>'<18>%<25>)<29>)<29>%<25>$<18><05><>(<28>&<26>P<EFBFBD>F'F)F%P<><50>lLEARSTACKZ<1F><14><04>H<><04><14>l iKHALLOT #<23> <09> <0B> 1s 
<0F> <0C> 1<0E> <0C>  <0C>u
<EFBFBD> 1<0E>X<1F>  $ i<00>HEAP #<23> <09> "$ i% HEAP? #, ]
<EFBFBD>$ #<23> <0C><18> 1<0E> <0C>, s <0C>, <20> 1*# `$ <0B>8<><02><02>F<03><0F><02><0E><18><1C><03><0E><><1C><0F><18>h<><68>l<> #O
*<1F> <0B>" $ j8 EDOES> #<23><18> Rl|<18><18> $ #<23> R<0F><>
R<0F>1#\h $ 3<00>2*<2A><15>
<EFBFBD><07>*<2A>l #[<0F>+division overflow$ 4<00>UM/MOD'<16><07>)<29><07>(<28><18><02><07><02><14><07>%<25><07>$H<><07>'H<><07>&<26><18>*8<>%<25>)<29><>$<24>(<28>&*<2A><04>$<24>%&'&&&%&$JPߠ<01>$<24>%<25> <20> $ <0B>&<26>H<>%<25>H<>$<24><07><01>'l5M/MOD #<23> <0C>
<EFBFBD><11> kbd
<EFBFBD>
s %<16>
kb<00><0E> b s <0C>
<EFBFBD>
s / $ 5<00>2/<2F><16>
<EFBFBD><1D>R<1D><1D><1E><1D><1D>%<1D>b<13><><EFBFBD>o<1E>RN<1D><0F><1D><1D> T<>$ g}NUMBER #<23><1E> <0C><10>+?kbX$ hLASTZ! #*<1F> <0B> $ h#HIDE #.b m<0F> o$<24>  $ h:REVEAL #.b
mo$<24>  $ hwIRECURSIVE #`$ #.b d
<EFBFBD> |
<EFBFBD> <0C> h $ h<00> IMMEDIATE #R@<40>$ h<00>RESTRICT #R<0F><>$ i<00>
C)<12><13>$ 1|C?DO #<23>:<12><13>$ 1<00>DLOOP #<23><0F><13><18><12><18>{$ 1E+LOOP #<23><0F><13><18><12><18>{$ 1<15>LEAVE #<23>O
m<0F> <0C> <0B>
<EFBFBD>
$ 2:UM*^<15><07>$<24><07>%H<>&<26>'<27>'&&&%&$<24><18><07>'<27>'H<><07><>&<26>&<26><06>%P<02>$JP|<7C>'<27>H<>&<26><07><01>$<24><07>%<25>l 3vM* #<23> k<10> <0C>
b<00>s <0C> kb
<00>O
q<0E>
\O
b}$ 3<00>* #b  <0B>
h  <0B>$ #b  h O
b}<0E> h N<1D> <0B><0E> ; h [$ #R&<26>b R
[$ R$<24>b R[$ RH<>b R[$ R%<25>b<00>[$ <0B>$ #R,<2C> 1s R.1|
$ #N<1D> [1; <0B>N# $ Z!gHNUMBER? #F <09>)<29> *<18> N<1D><0F><0F>
RR<00> <0C>R<1D>R-<2D>b [<0F>
<EFBFBD>R<1D>
b F  <0C>R<1D>%F<14><><01>Ȣl/<00>CASE?<08> <20><0E>$AP <09>%QPlq<10>lZ0<00>BIF #<23>b<13><13>$ 0<00>DTHEN #<23><11><0F>{$ 0-DELSE #<23><0F><13> <13>s {[$ 0bEBEGIN #<23><13>$ 0_EWHILE #<23><0F><13><0F>b<13><13><0F><><EFBFBD>
$ #<23><13> <0C><0F><>1b
h { <13><>$ 0<00>FREPEAT #<23><0F><13> <13>$ 0<00>EUNTIL #<23><0F><13>b<13>$ 1DBDO #<23>dF\NEEDS #V<1B>&2
b<00>$ dWHEX #RF  $ d<00>DECIMAL #R
F  $ eDIGIT? #R01<0E> R #bR<0F>1<0E> R #bF <09> <0B> #<11> ; h <0C>$ e
ACCUMULATE #s <0C>
s F <09> \h <0C> F <09> \<15>O
$ e[CONVERT #<23>*%b<00> <13><>/$ #<23><1E> <0B>$ #*[<0F># $ #/*$ f<00>DPLZ!<21><> 8<><02><07>F<18>HH<48><02><07><>HH<48><02><01>l ,<00><12>J<13>PR- <13>BRANCH"<18><0E><0E>$<24><0F><0E><0F>$<24>l -<13>?BRANCHd<13><14><18><02><07><02>(<28>Kl .8>MARK #<23><18>I$ .\>RESOLVE #<23><18> 1s  $ .<00><MARK #<23>$ .<00><RESOLVE #<23>1I$ .<00>?PAIRS #1<0E>+ unstructured$ Ih<><68>l<EFBFBD>h<><00><>8<><02><07>#C+<2B>}<7D>$ $ cOSTATEZ!c<00>eASCII #C+<2B><1B><0E> <0B><1B> b&$ c<00>," #R"<22><1B><18> <0C><0E> $ c<1C>"LIT #O
O
d
*<18>
<EFBFBD>
<EFBFBD>
$ c,<1C>(" #3$ cgA" #<23>l$ dt<1C>(." #3*7$ d<00>B." #<23><18>$ d<00>a( #R)<29><1B>
$ d<00>b.( #R)<29>7$ d<00>a\ #<23><19> <0B>-<17><0E>-<2D><15> $ d<00>b\\ #<23>;<3B> $ Xb}$ )<00>ABS #Xb<00>$ # O
<0F> <0C>
<EFBFBD> <0C>
s <0C>
<EFBFBD>
$ *<00><11>(DO #<23> 1 *#<12>(?DO #<23> 1<0E> b O
<EFBFBD> <0C> <0B>
<EFBFBD>
h $ *3BOUNDS #<23> <0C>
s $ *x<12>ENDLOOP<4F><12>l<>
+<00><12>(LOOP<4F><18><01><02><02> <0B><02><00><02>l <00><05><02><0F><><02><0E>l +<00><12>(+LOOP<4F><18><07><02><02><07><02><02>q<14><18><02><07><02>(Dl ,<00><12>I<EFBFBD><12><00> l4<1B><04>$%<25>=<3D>&QP<11>&P<02>'<27>$PF%F$l<><6C><EFBFBD>&<26>(<28>'<27>)<29>&Q<14>&P<02>'<27>$PF%F$(<28><14>*<2A>$%P<>8<EFBFBD><02>&<26><07><>H<>'<27><07><><18><04><07><07><02><14> <0C><04><07>$H<><04><01><07>%<25><>*<2A>$<24>(HF*<10><> <20>$<24>l b<00><>SOURCE #<23><19> <0B> b<00>1<EFBFBD>;$ <0B>
<19> $ b<00>WORD #<23><1B><>$ b<00>PARSE #<23>
<EFBFBD><1B><19> 2<><32> s O
Q<19>
<EFBFBD> 1<0E> O
1<0E># $ b<00>NAME 
t(E> #s <0C>$ (<00>0> #<23>k$ (<00>0<> #<23>q$ (U> #s J$ (= #1<0E>$ (-D0= #|
<EFBFBD>$ (;D= #}<0E>a$ (kD< #<23> <0C>
1b <00>2
2
<00>
J$ # bs h $ )\MIN #<23>
<EFBFBD>})<00>MAX #<23>
<EFBFBD>})<00>UMAX #<23>
J})<00>UMIN #<23>
#})<00>EXTEND #<23> k$ )ODABS # <0B> <0C> <0B>
1b/s <0C>s <13><> $ <JSKIP #<23>
<EFBFBD> b<13><00> <0C> <0B>
1b/s <0C>s <13><> $ <<00>/STRING #<23> E<11> <0C> <0C>
"
1$ h)<29>Ia<49> I[<5B><05>ɀ`<60>`=(<28>CAPITAL<41><4C><EFBFBD> d<><64>l >x<>
CAPITALIZE<EFBFBD><EFBFBD><07>$<24><07>%<25>$<24>&<26>D&P<05>l H<>$ d<><64>$l<><6C><EFBFBD><EFBFBD><EFBFBD>*<2A><03><07>$<00><10><><18><><19>&<26>&<26><><19>'<27>'8<>$<24><><19>$<24>%<25><><19>%<25>
<EFBFBD><07><><19><07><> %K<0F>LIT<49><0F>8<><02><07>F<14><0E><07><0E><07><18><02><0E><02>l %<00>GLITERAL #<23> <0C><00><>
b
<00><18>I$ <0B>R|$ &0<m<10><03><>$<24><>l&f0=<3D><10><07><>P<EFBFBD>&\UWITHIN<49><10> <20><0E><01>E$<24><07>%<25>
<EFBFBD>E&<26><07>'<27><>lt'<00><<3C><10><07>$<24><07>%<25><18><02><07><02><14>%q0<><30>E$<24><07>%lo'<00>U<L<10><07>$<24><07>%<25><18><02><07><02><14>E$<24><07>%<25>lql
#<23><18> <0B><0F>$ :W<18>COMPILE #O
<EFBFBD> <0F>
<EFBFBD> I$ ;<00>#TIBZ!;>TIBZ!;>INZ!;<00>BLKZ!;<00>SPANZ!;<00>TIB #<23><19> $ ;<00>QUERY #<23>RpF7<46><19>
 <0C><19><0F><19>$ <<00>SCAN #<23>
<EFBFBD> b<13>1$ #<23>R<0F><>
R<0F>1b<00> <0C> <0C><0E><18> 1<0E><0E><17>*# <0C><0F>$ k<00> ?HEADZ!k!| #
!<21> ; [
! $ l!WARNINGZ! #0!<21> ; *<1F> o$<24> T%2
b,*<1F> G"<22>exists <20>6$ l&!CREATE #<23><18><19> Io$<24> <0B> IV<1B> <0B> <0C>R <20>q<0E>+ invalid name<6D>* <0C><0E>4!
!<21> b<00>
!# <0C> <0C> Ij R <20><1F> <20>   7<00>MOVE #<23>
<EFBFBD>
JbO
<EFBFBD>$ O
<EFBFBD>$ 8<00>PLACE #<23> <0C>
<EFBFBD> <0C> <0C>O
<EFBFBD><17> $ 8COUNT,<18><07>$<18><01><07><07>%<25><00><07>8<><02><07>Fl<> 8"ERASE #<23><0F>$ 9mFILL<4C><18> <20><0E><>$<24>'<27>
<EFBFBD>(HP<48><50>)JP<4A><50>&<26><06>(HJP<4A><50>l :_HERE #<23> <09> $ :<00>PAD #<23>Rb<>
$ :<00>ALLOT #<23> # $ :<00>, #<23> <0C><0F>$ :EC, 
<EFBFBD> <0C>
R<14>
"
<EFBFBD>(0b<00>read 0 Y<>O
$ #<23>.<2E> <0C> b<00> <0B> <0F> [1b<13><><EFBFBD>..<2E> ,0$ # <0F>
<EFBFBD>
<EFBFBD>
 <0C> <09> <0B>
<EFBFBD>
 O
<0F><0F>.8.$ #<23>.<2E> <0B> b<00> "<0F> kb<13><>$ #<23>.<2E> <0B> <0C> <0B>b<13><>"<0F> k$ <0B>"0CORE? #i/<2F>
<EFBFBD>$ <0B>q1(BUFFER #i/S0<53>0 <13><><EFBFBD><00>1(BLOCK #i/S0<53>0<EFBFBD>0 <13><><EFBFBD>1<EFBFBD><1C>hH<68>l<><13>}1BUFFE clv8feb89 clv8feb89 clv8feb89 clv8feb89 clv8feb89 clv8feb89 clv8feb89 clv8feb89 clv8feb89 clv8feb89 clv8feb89 clv8feb89 clv8feb89 clv8feb89 clv8feb89 clv8feb89 clv8feb89 clv8feb89 clv8feb89 clv8feb89 clv8feb89 <20>
Reference in New Issue View Git Blame Copy Permalink