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

4424 lines
174 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 #
<EFBFBD>2+ <17>P<>#3+<17>PS<17>PM$<17>PG#
1-18<><07><01>l<00><07><07><00>l #*2-o<18><>$h
TRUEy+<2B><>$tFALSEy+$<00>"-1[$<00>!0<>$
<00>1y+$<00>2y+$<00>3y+$<00>4y+$
<EFBFBD>ON +[s$$<00>OFF +<2B>s$%<00><17>CLI
TT<17>8<><02><07>F<14><0E><07><><07>P<02>l WAND<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>D
NEGATEH8<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+
<EFBFBD>PS<17>PM$<17>PG#1-18<><07><01>l<00><07><07>
<EFBFBD>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>^
<EFBFBD>^ 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
<EFBFBD>)<29>
F^<5E><16><><EFBFBD><EFBFBD><EFBFBD>(4"<02>$<24>%<25><07><01>$<24>H<><07>%<25>
<EFBFBD><07><04><07><07>%<25><07>l <00>-ROT +<2B><08>$NI
P +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>GLI
TERAL +<2B><08><00><>b
<00> <20>I $<13> R| $&0
<m<18><03><>$<24><>l&f0=<3D><18><07><>P<EFBFBD>&\UWI
THIN<EFBFBD><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'
<EFBFBD>U<L<18><07>$<24><07>%<25><18><02><07><02><14>E$<24><07>%<25>lql
0<>2<EFBFBD>2<EFBFBD>]<5D>\<5C><15>C<EFBFBD><08>l<EFBFBD>l 4<00>\TRACE' +<2B>m
d\V.<2E>]_c$4{]<5D>BREAK +<2B> d\<08>]$4<00>
]TRACEL: +<2B>)I <20>(l<>(<28>d\#$4<00>]+DOD]<5D><>4
Q]-DOD]4<00>]+RD]<5D><>4<00>]-RD]4<00>]+PU
SHD]<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>$l
DROP}aSWAPu<08><07><><03><07>$<24><><07>$<24><01>
H<><00><07>$<24><07><07><>$llDUP<55><08>8<><02><07>F<14>
<EFBFBD><07><01>H<><07>l<00>?DUP<55><08>Pl l<><00>
OVER<EFBFBD><08>8<><02><07>F<14><04><07>H<><07><01>l <00>ROT
<EFBFBD><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>
<EFBFBD><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>
<EFBFBD>c\ <20><11><12>\<5C><12><11>1<EFBFBD>bT<11>1<EFBFBD>[?m<17><08>5<><13>R
5<>(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>
<EFBFBD><02>(PVl 3EXECUTE<54><13><07><1C><07><1D><18><02><07>
<EFBFBD>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>
<EFBFBD>(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>$ Sc
reen 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>
<EFBFBD>j\Nf\<5C><02><0E><02><0F><18><02><02><02><03>b\<5C> VOC-LIN
KV+<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
<EFBFBD>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>MA
RK +<2B> <20>I $.\>RESOLVE +<2B> <20>1s$.
<EFBFBD><MARK +<2B> $.<00><RESOLVE +<2B> 1I $.<00>
?PAIRS +1<16>3 unstructured$Ih<><68>l<EFBFBD>h<>
<EFBFBD><EFBFBD>8<><02><07>F<14><><01>Ȣl/<00>CASE?<1C> <20>
<16>$AP <09>%QPlq<18>lZ0<00>BIF +<2B> b<1B><1B>$0
<EFBFBD>DTHEN +<2B><19><17>{$0-DELSE +<2B><17><1B> <1B>s
{[$0bEBEGIN +<2B><1B>$0_EWHILE +<2B><17>
<EFBFBD><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 7RECOV
ERZ)ȅȅ<1D>PFFl +zNOOP <00>ORIG
INy+<00>S0V+<00>R0V+
<00>DPV+ <00>
OFFSETV+<00>BASEV+<00>OUTPUTV+KI
NPUTV+Y ERRORHANDLERV+<00>)<29><><1B>$1
|C?DO +<2B> :<3A><><1B>$1<00>DLOOP +<2B><17><1B> <20><><EFBFBD> <20>
<EFBFBD>{$1E+LOOP +<2B><17><1B> <20><><EFBFBD> <20><>{$1<1D>LEA
VE +<2B><>Om<17><08><13><15>$2:UM*^<1D><07>$<24><07>%H<>&
<EFBFBD>'<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>(
<EFBFBD>'<27>)<29>&Q<14>&P<02>'<27>$PF%F$(<28><14>*<2A>$%P<>8<EFBFBD><02>&<26>
<EFBFBD><EFBFBD>!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>#PARS
E +<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>$%P
l <00>$<18><02>$<24><02>%<25>$h8)<1F>$<24>$<24><02>%<25>) <20>
<EFBFBD>$h<>$<24>$<24>
<EFBFBD>%<25>$E(P<><50>%E)P<>l n<00>)>NAME +<12><13>b<00>
<EFBFBD>1s<08>)<29>b"<15>$ <1B><>2$ +* R<1F><15>$
nm*NAME> +<2B>*s<08>R <20>b<00>$n<00>*>BO
DY + $n<00>*.NAME +1$ +<2B> R<17><>R<17>1
b<00><08><08><16> <20>1<16><16><1F>*'#<08><17> $k<00>(?HEA
DZ)k)| +
)<29>;[
)$l)WARNINGZ)
+0)<29>;*'<27>o,<2C>T-2b4*'<27>G*<2A>$exis
ts <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>`=("CAPI
TAL<EFBFBD>"<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><>
<EFBFBD><EFBFBD>!<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 i
K'HALLOT +<2B><11><13>1s <17><08>1<16><08><08>u
<EFBFBD>1<16>X'<27>$i<00>'HEAP +<2B><11>"$i%(HEA
P? +,(]<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<EFBFBD><EFBFBD>l<> +O*'<27><13>*$j8(EDOES> +<2B> <20>(Rl|
<20> <20>($ +<2B>R<17><>R<17>1+<2B> <20><13><17> $:W <20>COM
PILE +O<12> <17><12>I $;<00> #TIBZ);!>TI
BZ)!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>%
<EFBFBD>% 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>$h
w'IRECURSIVE +`'$ +.'b d<15>|<15><08>h$
h<00>' IMMEDIATE +R@<40>'$h<00>'RESTRICT +R<17>
<EFBFBD>'$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>(H
P<EFBFBD><EFBFBD>)JP<4A><50>&<26><06>(HJP<4A><50>l :_ HERE +<2B><11>$:
<EFBFBD> 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[$R
H<EFBFBD>b R[$R%<25>b<00>[$<13>$ +R,<2C>1
sR.1|$ +N%<25>[1;<13>N%#$Z)gH%
NUMBER? +F<11>1<EFBFBD>* <20>&N%<25><17><17>RR<00><08>%R%
<EFBFBD>%R-<2D>b[<17><12>%R%<25>%
&b F<08>%R%<25>%%
 ʑ<07><07>l6V/MOD +<2B>XO<12>$6<00>/ +
<EFBFBD>2$6MOD +<2B>h$6*/MOD +<2B><12>O<12>
$6 */ +(2$66U/MOD +<2B>s%$6e
UD/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>CM
OVE><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>.2
b<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%
ACCUM
ULATE +s<08>sF<11>\h<08>F<11>\<1D>O$e[%C
ONVERT +<2B>* %%b<00>% <1B><>/$ +<2B>&<26><13>$ +*
[<17>&#$ +/* $f<00>%DPLZ)<29><>  +\h$3
<EFBFBD>2*<2A><1D>
<EFBFBD><07>*<2A>l +[<17>3division overf
low$4<00>UM/MOD'<1E><07>)<29><07>(<28><18><02><07><02><14><07>%
<EFBFBD><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>k
b<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>
<EFBFBD><01>l pC+ALIAS +<2B>)*'<27><13><08>R <20>b <00>
<EFBFBD><EFBFBD><EFBFBD> R <20>'*$q<00>+VPZ)--<2D>]m<>-
q,,CURRENTZ)-qe,CONTEXT +1,<2C><08><13>
$ +1, _,$qu,ALSO +1,<2C>R
<EFBFBD>~3Voca
bulary stack full_,<2C><13>1,#_,$q<00>,TOS
S +<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
<EFBFBD>$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
<EFBFBD>(<28>8<><02><07>F<14><02><1C>H<><1C><01>l of+VARIABL
E +<2B>)<29><17> $p<00>+UALLOT +<2B><12><13>R<17>#<19>3
U
serarea 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>
<EFBFBD><01>l pC+ALIAS +<2B>)*'<27><13><08>R <20>b <00>
<EFBFBD><EFBFBD><EFBFBD> R <20>'*$q<00>+VPZ)
q,,CURRENTZ)qe,CONTEXT +1,<2C><08><13>
$ +1, _,$qu,ALSO +1,<2C>R
<EFBFBD>~3Voca
bulary stack full_,<2C><13>1,#_,$q<00>,TOS
S +<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>
<EFBFBD>$<<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><>!
<EFBFBD>$<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
<EFBFBD>(<28>8<><02><07>F<14><02><1C>H<><1C><01>l of+VARIABL
E +<2B>)<29><17> $p<00>+UALLOT +<2B><12><13>R<17>#<19>3
U
serarea 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>!R
pF?<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<>
<EFBFBD><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>
<EFBFBD>)<29><07>(<28><18><02><07><02><14><07>%<25><07>$H<><07>'H<><07>&<26><18>*8
<EFBFBD>%<25>)<29><>$<24>(<28>&*<2A><04>$<24>%&'&&&%&$JPߠ<01>$<24>%<25> <20>
$<13>&<26>H<>%<25>H<>$<24><07><01>'l5M/MOD +<2B><08>
<EFBFBD><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 +
<EFBFBD>&<26><08><18>3?kbX$h'LASTZ) +*'<27><13>
$h#'HIDE +.'b m<17>o,<2C>$h:'REVEA
L +.'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[COMPI
LE] +V.I $v<00>.C['] +V.&$v/ NULLSTRIN
G? +<2B><08><13><18>b2$H<18><1C><02>H<><1C><00><0F>l w
/
>INTERPRET0/<2F>/xf/NOTFOUND]0<>/xy/
N
O.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>h
N%<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>R
R<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>*
<EFBFBD><EFBFBD>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>
<EFBFBD><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<EFBFBD>?<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 r
ev 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/U
3?<3F><><EFBFBD><EFBFBD>?$<13><00>5PAUSE <00><00>5LOCK +<2B><08>]1
bh$<13><08>b<00>5 <1B><>]s$<13><00>5UNLOC
K +<2B>6<>$<13>8<EFBFBD><05><04><><00><05>l<EFBFBD><04><06><04>H<><04><14><01>
<EFBFBD><02><07><03><18><02><07><02><14>l<><12>/6FILEV+<1C><00>6PR
EVZ)Z)<00><00>6B/BUFy+<04><02>(Y"PH<>P<>`<60>
?CR +w?<3F>5R
1#b?$ +<2B>)<29>| <17>(l<>(
<EFBFBD>T<11><13><15>$<13><00>>OUTPUT: +<2B>))0<>(l<>(T$
<EFBFBD>V>EMITE><00><00>>CRE><02><00>>TYPEE><04> ?DE
LE><06>?PAGEE><14> ?ATE>
<EFBFBD>,?AT?E> <0C>6?
ROW +<?h$<13>a?COL +<?2$ +<2B>)<29>| <17>(l
<EFBFBD>(<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<EFBFBD><17><><EFBFBD><EFBFBD>$<13>v5C/Ly+)<00><00>5L/Sy+<00><00>5LI
ST +3<08>$Scr 3<><13><00>=(FORGET +<2B>@(<28>3
is symbol<6F>;<3B>=$<13><00>=FORGET +V.<2E><08>$<10>J
<EFBFBD>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>
<EFBFBD>$<13>'>BYE +g:
>Wc$ +<2B>?<3F>1b[$<13>
`>STOP? +<2B>?b<00>><3E>><3E>$<13><00>>3$$`<00>3
BLy+ `<00>3 -TRAILINGW3<57> <20><16><07>&<18><07>%<25>'<27>$
<EFBFBD><13><>&I <20> HP<02>%<25>h<EFBFBD>%l<><1B>P<EFBFBD>F'F%<10><>lZ<1B>I3SP
ACE +C3<43>>$<13>
4SPACES +<2B>:<3A>4<><34><EFBFBD><EFBFBD>$ +<2B>
m$<13>4HOLD +[84#84<38><13>$<13>b4<# +84
84$<13>[4#> +<2B>84<38>84<38>1$<13><00>4SIGN +k
bR-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>/ 
<EFBFBD> N<><4E>$ +<12><<3C>,)<29> <00><15><><EFBFBD>"<15>b
<00>-<2D>
<EFBFBD><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 STANDARD
I/O +<2B>*T<11><17>$^K2'ABORT]0<>^<00>2ABOR
T +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> * 
<EFBFBD> <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<EFBFBD><EFBFBD><EFBFBD><EFBFBD>$]2c--> +<2B><17>!#<08>!<21><17>1$] 2RDEP
TH +<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><EFBFBD>9<EFBFBD>$<13>?:COPY +<2B>}:$<13><00>:CONVEY +s
<EFBFBD><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>1
b<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?STAC
K/1<> 8<><07><04>$H<><14>P <09> <20>Y0$<13><14>EH<><04><14>
<EFBFBD>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>6
86$<13>:FLUSH +<2B>9:$ +<2B><08>9y9b<00>6<EFBFBD><13>87
9b<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//;
<EFBFBD>&<26>bbs&& <00>/s/y<00>/a[ +<2B><17>/<2F>
0u/<2F>#<23>$y0] +<2B>Q/<2F>0u/<2F>#<23>$ +[<17>3Cra
sh$z%0DEFER +<2B>)<29>90I <20>(<28><02>hH<68><1C>ȅ<1C>
lzi0(IS +O<12> <17><12>$ +<2B><13><17>/<2F><13>1
s<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$ + 
<EFBFBD><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$
<EFBFBD>"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<>
<EFBFBD>}9BUFFE<17>2<EFBFBD>0<EFBFBD>2<EFBFBD>d<EFBFBD>@<40>.<10><13><08><17><11>0<EFBFBD>2
3<><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>
<EFBFBD>@RESTARTaa<61>@h<><68>hl<68>@~5aC64KEY?xa<78><61>
]<05>
<02><>hl<68>~laGETKEY<45>a<EFBFBD>><3E> <20><><EFBFBD>?<3F>lZ<00>aCURO
N<EFBFBD>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 r
etry <20>?<3F>Rr1sRR1|q<16>3aborted$<13>L7
DISKERR]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>h
FINDEX +<2B>gb<00>$<13>h)<29>1?<3F><><EFBFBD>5<> <20><08><><EFBFBD>
<EFBFBD>Pfg<><12>R%?O<12>>|bb<1D><><EFBFBD><EFBFBD>Gg$<13><00>hI
NK-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.{{<>b
F;<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>
<EFBFBD>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 RECOV
ERZ!ȅȅ<1D>PFFl #z NOOP <00> ORIG
INy#<00> S0V#<00> R0V#
<00> DPV# <00> 
OFFSETV#<00> BASEV#<00> OUTPUTV#K I
NPUTV#Y ERRORHANDLERV#<00>b<00>f1
R<13>R<11>$<13><08>fJb<00>f1R<12>R<18>$<13>f1
R<11>R<1E>$ +<2B>f<EFBFBD>s$ +F<11>1%<25>`4I4hR
,i4I4<49>4$y+<01>1f
READSECTOR +dR>el$u
1: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>e
ddR
>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>
<EFBFBD><EFBFBD><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>eB
USTYPE +<2B><>:<3A> <00><><EFBFBD>Ce<43><65><EFBFBD><EFBFBD><EFBFBD>5$<13>UeBUS@f<>>
<EFBFBD> <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>fJ
b 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 EXECUT
E<EFBFBD> <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>
<EFBFBD>$<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<EFBFBD>686[<17>3 no device<63><65><EFBFBD>><3E> <20><><EFBFBD>?<3F><>`<60>><3E> <20><><EFBFBD>?
<EFBFBD><EFBFBD>><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>d
6e$<13>5eBUSOPEN +R<17>|>e$<13>jeBUSCLOS
E +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>
<EFBFBD> +!% <0C><07>$<24><07>%H<><18>$<24>$H<><07><01>$l  DRO
P}
a SWAPu <0C><07><><03><07>$<24><><07>$<24><01>H<><00><07>$<24>
<EFBFBD><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>
<EFBFBD><07><03><07><05><14> <20><16>D$<24><16>& <20>b<EFBFBD><02>.<2E>><3E> l<><6C>?<3F>
Hl<EFBFBD>cl<EFBFBD>b<EFBFBD><00>cDISPLAY<41>><3E>b<EFBFBD>b<EFBFBD>c c(c;c^cYc<59>><3E>l
r<EFBFBD><EFBFBD><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>
<EFBFBD><07><04><07><07>%<25><07>l <00> -ROT #<23> <0C> $ 
NI
P #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>
<EFBFBD><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>Wb
C64CR +<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
<EFBFBD>><3E> <20><><EFBFBD>?<3F><>(<28><><02>(h<><68><00><07>lZ<1B>ucC64TYPE<50>c
W
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
<EFBFBD>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>
<EFBFBD>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>$
<EFBFBD><00>a C64EXPECT +<2B>!<08><17><08>!<21>Jb
<00>?<3F>? <1B>
<EFBFBD><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>
<EFBFBD><EFBFBD><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#$
<EFBFBD>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
<EFBFBD><EFBFBD>?<3F>l<EFBFBD>i<EFBFBD>><3E><><07><07>h<>h<><68>h<><00>l<><6C><EFBFBD>?<3F>@8<>>
<EFBFBD> <20><><EFBFBD>;<3B>;<3B><1E><>i<EFBFBD><07><10><><07><><EFBFBD><EFBFBD><00><><EFBFBD><EFBFBD>?<3F>`<60><00>iF
ORTH-83 +${j ASSEMBLER<45>,Wj-{PUS
HAy+P{'jPUSH0Ay+Z{5jPUSHy+<2B>{djRP
y+{qjUPy+{\jSPy+{<00>jIPy+{<00>j
Ny+${}jʑ<07><07>l6V/MOD #<23>
XO
<EFBFBD>
$ 6<00>/ #<23>2
$ 6MOD #<23>h $ 6*/MO
D #<23>
<EFBFBD>O
<EFBFBD>$ 6 */ #(2
$ 66U/MOD #<23>
s %$ 6eUD/MOD #<23>
<EFBFBD><0F>
%O
s <0C>
%O
$ 7
yCMOVE<56><17> <20><0E>D$P F%<05>l <00>(<28>&HP<48><50>)<29>'
l<EFBFBD>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
<EFBFBD> <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>
<EFBFBD><EFBFBD><1C><0F><18>h<><68>l<> #O
*<1F> <0B>" $ j8 EDOES>
#<23><18> Rl|<18><18> $ #<23> R<0F><>
R<0F>1#\h $ 3
<EFBFBD>2*<2A><15>
<EFBFBD><07>*<2A>l #[<0F>+division overf
low$ 4<00>UM/MOD'<16><07>)<29><07>(<28><18><02><07><02><14><07>%
<EFBFBD><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>
k
b<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>
<EFBFBD> T<>$ g}NUMBER #<23><1E> <0C><10>+?kbX$
hLASTZ! #*<1F> <0B> $ h#HIDE #.b m
<0F> o$<24>  $ h:REVEAL #.b
mo$<24>  $ h
wIRECURSIVE #`$ #.b d
<EFBFBD> |
<EFBFBD> <0C> h $
h<00> IMMEDIATE #R@<40>$ h<00>RESTRICT #R<0F>
<EFBFBD>$ 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&
<EFBFBD>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>
<EFBFBD>$ 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 #R
F  $ 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>
<EFBFBD>$<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$ I
h<><68>l<EFBFBD>h<><00><>8<><02><07>#C+<2B>}<7D>$ $ cOSTA
TEZ!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
<EFBFBD>ENDLOOP<EFBFBD><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>(
<EFBFBD>'<27>)<29>&Q<14>&P<02>'<27>$PF%F$(<28><14>*<2A>$%P<>8<EFBFBD><02>&<26>
<EFBFBD><EFBFBD>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>PARS
E #<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$ # b
s h $ )\MIN #<23>
<EFBFBD>})<00>MAX #<23>
<EFBFBD>})<00>
UMAX #<23>
J})<00>UMIN #<23>
#})<00>EXTEN
D #<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<>
<EFBFBD>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><>
<EFBFBD>'<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>GLI
TERAL #<23> <0C><00><>
b
<00><18>I$ <0B>R|$ &0
<m<10><03><>$<24><>l&f0=<3D><10><07><>P<EFBFBD>&\UWI
THIN<EFBFBD><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'
<EFBFBD>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>
<EFBFBD><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
<EFBFBD>+ invalid name<6D>* <0C><0E>4!
!<21> b<00>
!#
<EFBFBD> <0C> Ij R <20><1F> <20>   7<00>MOVE #<23>
<EFBFBD>
J
bO
<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>
<EFBFBD>Fl<> 8"ERASE #<23><0F>$ 9mFILL<4C><18> <20>
<EFBFBD><EFBFBD>$<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
<EFBFBD> <0B> <0F> [1b<13><><EFBFBD>..<2E> ,0$ # <0F>
<EFBFBD>
<EFBFBD>
 <0C> <09>
<0B>
<EFBFBD>
 O
<0F><0F>.8.$ #<23>.<2E> <0B> b<00> "<0F> k
b<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(BL
OCK #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
Reference in New Issue View Git Blame Copy Permalink