You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

6471 lines
261 KiB

( disk A, side 0)
addto sys68 vocabulary targ
sys68 addto targ deactivate sys68
+target ( compile into shadow ram area )
saveapplic applic 0a move ( move headers to target area )
0 org ( begin compiling at target )
here applic over - ff fill
targeting on ( switch to target compiling mode )
0c0 48pointers ( these point into ROM )
( starting at 0c0 for debugging vectors )
30 6 * allot ( rom jsr table array )
( loaded by patchromvectors )
.xplntbl target + 80 2* 0 fill ( can't be done by the TC disk )
( SETUP command arrays )
frag <setdata> to ;c ( default setup state.)
setv&tlim 2* allot
frag <settokens> to ;c ( setup token list)
setv&tlim 2* allot
frag <groups> to ;c ( groups)
grouplim gpwidth * allot
frag <himsetup> to ;c ( hidden internal modem setup info )
decimal
2 w, 1 w, 1 w, 15000 w, 20000 w, 6000 w, 7000 w, 60 w, 120 w,
56 w, 37 w, 700 w, 0 w, 1 w, 1 w,
hex
himsetuplim 2* <himsetup> here target - - - allot ( remaining space )
( preassign the one byte tokens )
0 targvoc ( Store forth's token into the target vocabulary list )
token 0 forth
token 1 tier1
token 2 tier2
token 3 tier3
token 4 tier4
token 5 tier5
token 6 tier6
token 7 tier7
token 8 tier8
token 9 tier9
token A tiera
token B tierb
token C tierc
token D tierd
token E tiere
token F tierf
token 10 int0
token 11 int1
token 12 int2
token 13 int3
token 14 int4
token 15 int5
token 16 int6
token 17 int7
token 18 int8
token 19 int9
token 1A inta
token 1B intb
token 1C intc
token 1D intd
token 1E inte
token 1F intf
token 20 blit
token 21 wlit
token 22 lit
token 23 <do>
token 24 <loop>
token 25 <+loop>
token 26 <;>
token 27 <;lp>
token 28 <exit>
token 29 <exitlp>
token 2A <bran>
token 2B <0bran>
token 2C <branl>
token 2D <0branl>
token 2E <leave>
token 2F <0leave>
token 30 <leavel>
token 31 <0leavel>
token 32 <local>
token 33 <locals>
token 34 <loc0>
token 35 <loc1>
token 36 vocab
token 37 <">
token 38 <abort">
token 39 to
token 3A and
token 3B or
token 3C xor
token 3D not
token 3E dup
token 3F 2dup
token 40 drop
token 41 2drop
token 42 nip
token 43 swap
token 44 2swap
token 45 rot
token 46 over
token 47 ?dup
token 48 >r
token 49 r>
token 4A r@
token 4B i
token 4C 1-
token 4D 1+
token 4E 2-
token 4F 2+
token 50 -1
token 51 0
token 52 1
token 53 2*
token 54 2/
token 55 c@
token 56 w@
token 57 @
token 58 c!
token 59 w!
token 5A !
token 5B and!
token 5C or!
token 5D xor!
token 5E not!
token 5F +to
token 60 on
token 61 off
token 62 +
token 63 -
token 64 negate
token 65 abs
token 66 +!
token 67 min
token 68 max
token 69 noop
token 6A fill
token 6B type
token 6C ?ev
token 6D ?auto
token 6E set-auto
token 6F clear-auto
token 70 ion
token 71 ioff
token 72 cr
token 73 <step>
token 74 shl
token 75 shr
token 76 =
token 77 <>
token 78 0=
token 79 0<
token 7A <
token 7B >
token 7C u<
token 7D *
token 7E inrange
token 7F cmove
token 80 move
token 81 /mod
token 82 /
token 83 mod
token 84 execute
token 85 +table
token 86 <find>
token 87 <word>
token 88 word
token 89 hex
token 8A decimal
token 8B open?
token 8C needtext
token 8D needforth
token 8E blinkruler
token 8F error
token 90 <abort>
token 91 abort
token 92 outofroom
token 93 froom?
token 94 allot
token 95 c,
token 96 w,
token 97 ,
token 98 ms
token 99 @k
token 9A ?kval
token 9B down?
token 9C ?shift
token 9D ?ctl
token 9E ?lex
token 9F ?rex
token A0 <<?k>>
token A1 clr-kbd
token A2 <?k>
token A3 <key>
token A4 ?k
token A5 key
token A6 ?t
token A7 ?panic
token A8 ?keystep
token A9 beep
token AA emit
token AB home
token AC page
token AD space
token AE spaces
token AF .r
token B0 u.r
token B1 .
token B2 u.
token B3 call
token B4 compile
token B5 <addto>
token B6 [']
token B7 "to
token B8 ?diskerror
token B9 sign
token BA ?stack
token BB <becode>
token BC temp
token BD <bevoc>
token BE diff?
token BF same?
token C0 encode
token C1 goto
token C2 exit
token C3 "hold
token C4 hold
token C5 <#
token C6 #
token C7 #s
token C8 #>
token C9 exa
token CA recal
token CB don
token CC cls
token CD von
token CE vopen
token CF ?0
token D0 prevchar
token D1 ^prevchar
token D2 nextchar
token D3 prevbrk
token D4 prevsep
token D5 nextdoc
token D6 nextsep
token D7 break?
token D8 disp
token D9 setdata@
token DA $>lbuff
token DB findchar
token DC rule
token DD indicate
token DE selsize
token DF !ptr
token E0 @ptr
token E1 clearundo
token E2 checkanswer
token E3 placeanswer
token E4 forwarderror
token E5 aencode
token E6 alit
token E7 a+
token E8 a-
token E9 a*
token EA a/
token EB a%
token EC aneg
token ED a<
token EE a>
token EF a=
token F0 a~
token F1 a|
token F2 a&
token F3 aabs
token F4 aint
token F5 asqrt
token F6 unop
token F7 <sum>
token F8 <avg>
token F9 numerical
token FA message
token FB user
token FC arithmetic
token FD function
token FE debug
token FF asmb68
( preassign the Setup string tokens )
token 100 mCCat
token 101 mL2
token 102 mL3
token 103 mL4
token 104 mL5
token 105 mPER
token 106 mLet
token 107 mLeg
token 108 mA4
token 109 mB5
token 10A mHL
token 10B mSta
token 10C mA5
token 10D mB6
token 10E m2/4
token 10F m3/4
token 110 m4/4
token 111 m5/4
token 112 m6/4
token 113 m7/4
token 114 m8/4
token 115 mUS
token 116 mCA
token 117 mLA
token 118 mDN
token 119 mNW
token 11A mD/N
token 11B mS
token 11C mNL
token 11D mD
token 11E mCH
token 11F mF
token 120 mUK
token 121 mIB
token 122 mI
token 123 mSA
token 124 mJ
token 125 mAS
token 126 mDV
token 127 mBoW
token 128 mWoB
token 129 mBp
token 12A mV
token 12B mBaV
token 12C mon
token 12D moff
token 12E mrgs
token 12F mrgm
token 130 mrgf
token 131 mrgsf
token 132 mrgmf
token 133 mrgff
token 134 mDA
token 135 m1rg
token 136 m3rg
token 137 m5rg
token 138 m7rg
token 139 m1m
token 13A m3m
token 13B m5m
token 13C m15m
token 13D m30m
token 13E m60m
token 13F mInf
token 140 mYes
token 141 mNo
token 142 mYes1
token 143 mcd
token 144 mdc
token 145 mad
token 146 m1rt
token 147 m2rt
token 148 m3rt
token 149 mChP
token 14A mLMO
token 14B m10p
token 14C m12p
token 14D m15p
token 14E m16.3p
token 14F m16.8p
token 150 mBid
token 151 mUnid
token 152 mGot
token 153 mPic
token 154 mEli
token 155 mCou
token 156 mA
token 157 mB
token 158 mA+B
token 159 mStd
token 15A mSec
token 15B m110
token 15C m300
token 15D m600
token 15E m1200
token 15F m2400
token 160 m4800
token 161 m9600
token 162 m19200
token 163 m38400
token 164 mCCITT22b
token 165 m7b
token 166 m8b
token 167 mNon
token 168 mEve
token 169 mOdd
token 16A m1b
token 16B m1.5b
token 16C m2b
token 16D mPP
token 16E mSP
token 16F mCR
token 170 mCL
token 171 m2s
token 172 m30s
token 173 m60s
token 174 m180s
token 175 mDDS
token 176 mDS
token 177 mFP#
token 178 mPP#
token 179 mPL
token 17A mTM
token 17B mBM
token 17C mBMS
token 17D mKbd
token 17E mTYM
token 17F mCSM
token 180 mEI
token 181 mSBT
token 182 mLSpD
token 183 mLSeD
token 184 mDNP
token 185 mDiC
token 186 mSRS
token 187 mDPX
token 188 mFD
token 189 mHD
token 18A mCC
token 18B mCCITT22
token 18C mBELL2
token 18D mMS
token 18E mEM
token 18F mEMS
token 190 mpc.0
token 191 mpc.1
token 192 mpc.2
token 193 mpc.3
token 194 mpc.4
token 195 mpc.5
token 196 mpc.6
token 197 mpc.c
token 198 mpc.n
token 199 m180
token 19A mDW
token 19B mPM
token 19C mCSF
token 19D mTS
token 19E mPBS
token 19F mLB
token 1A0 mFX
token 1A1 mITLC
token 1A2 mCF
token 1A3 mChS
token 1A4 mAP4
token 1A5 mAP3
token 1A6 mAP1
token 1A7 mNAP
token 1A8 mBJ
token 1A9 mSPS
token 1AA mBR
token 1AB mDBL
token 1AC mPty
token 1AD mSB
token 1AE mMPS
token 1AF mCT
token 1B0 mPT
token 1B1 mSPC
token 1B2 mAP
token 1B3 mAPS
token 1B4 mAPP
token 1B5 mSC
token 1B6 mSSU
token 1B7 mABK
token 1B8 mLT
token 1B9 mRING
token 1BA mRA
token 1BB mIMS
token 1BC mNCT
token 1BD mSPKR
token 1BE mPRO
token 1BF mMNP
token 1C0 mMCP
token 1C1 m3LANG
token 1C2 mGERM
token 1C3 mFREN
token 1C4 mITAL
token 1C5 mCFC
token 1C6 mascii
token 1C7 mibm
token 1C8 mAUTO
token 1C9 mP/L
token 1CA mPORT
token 1CB mLAND
( preassign the explain and help message tokens )
token 200 defmsg
token 201 leapmsg
token 202 nocopy
token 203 copyuplock
token 204 romcopyup
token 205 verifyerror
token 206 mCRSS
token 207 notanswer
token 208 titlemsg
token 209 kbdmsg
token 20A copymsg
token 20B capsmsg
token 20C underlinemsg
token 20D boldmsg
token 20E marginmsg
token 20F stylemsg
token 210 tabmsg
token 211 spacingmsg
token 212 printmsg
token 213 sendmsg
token 214 phonemsg
token 215 controlmsg
token 216 diskmsg
token 217 sortmsg
token 218 learnmsg
token 219 undomsg
token 21A addspellmsg
token 21B setupmsg
token 21C lockmsg
token 21D localmsg
token 21E calcmsg
token 21F erasemsg
token 220 lexerr
token 221 noroom
token 222 lockedtext
token 223 nolearnroom
token 224 nocopyuproom
token 225 noanswer
token 226 nodial
token 227 svcorrupt
token 228 interruption
token 229 badtransmit
token 22A noconnect
token 22B nomodem
token 22C carrierlost
token 22D telconnect
token 22E writeprotect
token 22F nodisk
token 230 noprinter
token 231 riskytext
token 232 nodiskroom
token 233 nontextdisk
token 234 blankdisk
token 235 funkydisk
token 236 notsorted
token 237 notcalculated
token 238 longname
token 239 notokens
token 23A needsglobal
token 23B reservedname
token 23C usedname
token 23D badname
token 23E extradigits
token 23F recursing
token 240 syntaxerr
token 241 toomanyrefs
token 242 trykillagain
token 243 nosort
token 244 ambiguity
token 245 syserror
token 246 unimplement
token 247 getfwdmsg
token 248 nonblankdisk
token 249 explainmsg
( preassign the two byte tokens )
msgend tokens to ( msgend = 280 )
assigntokens
choicedisp choicecode widecursor extendedcursor narrowcursor narrowcursor?
resetcursor preset killivls printerinfo put" inwindow getdata refresh movegap
selected fpkt? update! reverse ^nextchar brk+ wrap build redisplay ?extended
seek makepkt rxch? loadline partknown txchr rewindow eou makespace altptr
modifiers collapse ultype vline hline extend rxget scancode firstbreak ubufsize
gpdaddr invert.chars thislearn #>lbuff8 myesno mticks@ mticks! <printc> ga2opr@
ga2opr! new-display t. visible? $>char mainptr <#defaults> stripshifts
insertblock reform lrncmd preform createrror stype ^sk> storeline cursoron
page? <swappkt> display advanceptr movetext savepos rtrk motion recycle
pktbytes putivl search>
<string> tip 3dup swab raddr addr digit number <"to> !char compromise afilter
sp@ sp! rp! do-event sync-shiftkeys finish-lex learnstrings reset-vticks
draw.screensave <screen-save> screen-save voff playback? playback record setcur
<demit> crlfscroll semit pemit eemit demit window <cksum> <cksum4> romchecksum
ramchecksum decode $char? toggle name compile, assign create '
move&adjust doff stepin stepout side0 side1 save? format idblock <deactivate>
vocab? freetoken ] [ fnderr find [compile] recycledtoken align forward integer
array literal c' n' sw ?stackerr depth .s doloc interpret emptyvoc ?pairs !csp
?csp backelse {loop} {while} {elsethen} local nest unnest if else then do loop
+loop begin again until while leave immediate stub : ; scanfor " ascii +bit7
check ctl -trailing ( ;s ." abort" string becomes <csize> csize retop
setcodesize oddadjust packforth unpackforth addto invoc deactivate <behead>
behead <eta> eta safety bevoc <purge> purge empty <empty> createvoc vocabulary
searched existing rub doit <quit> quit dump words restore ga3pr.cont@
ga3pr.cont! opcr.copy@ opcr.copy! bticks@ bticks! rticks@ rticks! vticks@
vticks! kticks@ kticks! dticks@ dticks! csf? nearchar putchar delchar topos
rubout toleft nuline inittype lto tcr numsg tscreen
<format> sound.on sound.addr@ sound.addr! ?sound 'beep 'boop boop acr@ acr!
ringcount@ ringcount! ticks@ ticks! auto shiftstate char char? kstat kval 1200?
answer? trained? modem.speed? ringsound-slow ringsound-med ringsound-fast
sound-off ringstate 1200! answer! trained! modem.speed! rings@ rings! offhook?
rxd.enable rxd.disable tx.mark.enable tx.mark.disable energy@ psk.dmd@
psk.uscr@ fsk.dmd@ random? valid.fsk.orig valid.fsk.ans valid.psk reset.modem
modem.300 modem.1200 train.orig train.ans.300 train.ans.1200 train.ans
checkcarrier cts.on rts.on dsr.on dtr.on ser.xon.tx.on ser.xon.rx.on cts.off
rts.off dsr.off dtr.off ser.xon.tx.off ser.xon.rx.off ser.xon.reset
ph.xon.reset xon.reset txbreak ser.?2chrs @ser.peek ph.?2chrs @ph.peek
2legalchrs? ser.peek ph.peek rxpeek ser.?full ph.?full rxfull? ser.pointers
ph.pointers rxpointers baud-rates stop-bits data-bits parity print.buf.free
print.empty quit.print restore.print pbuf! print.serial print.parallel print?
print.dev? set.dtr clr.dtr tst.dtr tst.dcd enablexternal disablexternal carrier?
cwides rulersmarts goldenbytes <statuslights> <maptable> <cursorimage> ~disp
halfdisp ~showrule ~showstatus initruler >status bl# checkline# newgauge?
checkgauge checkbattery adjust indentsize pbpat ^sk< ^fmt> vtline unvtline
getkey initkey uppercase lowercase extramods movewith movenotwith getpkt
savepkts swappkts lastbreak nextbrk update? prevwrap <cursoron> <cursoroff>
intext? prevmatch nextmatch hideivls badivl knownplace nearivl goodivl line>ivl
nearinterval wrapthru fixivl findline nextivl previvl nextpage prevpage prevdoc
differs? stepback stepahead blink cursoroff getwidth cursorline real?
nextdsorcalc findwidth findsplit findnarrow findwide <search>> <search<>
search< bare? accentable? pattadd pattdel buildtable realign enoughtext ?split
?expanded widecursor? splitcursor lastknownline eos-display scrolldown scrollup
pushpos enoughforth shiftkey? lockedtext? setgap resetselection? movepkt
swappkt copypkt rotatepkts accent Insert clearlearn end-search start-search
expand research leave-extended unmove <uncreep> uncreep tapmove lex-tap
end-drag drag-forward drag-backward start-drag drag undrag init-lex unexpand
searching do-lex do-cmd ?blinks ?voff phonetest eventlist periodicevents
trimselection removeselection restoreselection ungobble regobble gobble Erase
maxundo Caps cformat1 cformat2 cformat3 Bold Under pformat1 pformat2 unformat
nextab addtab deltab repos initset marginloop tabloop fixindent fixleft
fixright fixtabs fixspacing fixjustify Spacing Justify Defleft Left Defindent
Indent Defright Right Deftabs Tabs Copy Kb1/2 Undo adjustleaprange local/global
sho ww wws pp pps csho notimplemented learnsize newlearn newplayback Learn
0-cmd 1-cmd 2-cmd 3-cmd 4-cmd 5-cmd 6-cmd 7-cmd 8-cmd 9-cmd initedde cleanedde
retp@ retp! stack! Ans Forth Escape setlearn query cut-ans see$ <save>
<restore> initprint" userinit" leftfoot" rightfoot" leftfrill" rightfrill"
topofform" endprint" endline" halfline" oldhalfline" startline" +underline"
-underline" +bold" -bold" backspace" overstrike" unoverstrike" hmi"
evenhalfspace" oddhalfspace" printreverse" printforward" modemdefault$
modeminit$ sendend$ lastphone answerback screensave$ learn0 learn1 learn2
learn3 learn4 learn5 learn6 learn7 learn8 learn9 getforward move&adjusttext
<line> <point> <box> <kcodes> clear-shifts ?kb2 ?shiftlock ?shifted mask
toshiftlock rulerfont >lbuff attribute attribable? continueinsert? scrollback
scrollfwd lex-scroll cold unscroll Uncopy ^dfmt makedpkt getdpkt getdocpak
savedpkts swapdpkts dpktbytes seenlines fit-display swappos swappos2 savepos2
upkey? lockedrange? lockedsel <removeselection> findds redoc findpkt samepkt?
compress undoclock DocLock <insertcopy> insertcopy undolocal/global numberkeys
#key? showlearn setuf aftererase
Send waitkey attribregion capregion fixcursor rnd hangup connectone setmodem
trainanswer verifyfmtpkt unhidebyte verifycalc verifybreak verifydoc
verifynonaccentable verifyaccentable verifychar ctocreceive <receive> deepsend
specialctrl SendCtrl SendPswrd
<svtest> <ramtest> reset.hardware fixcalcs findcalc diskaddr disk>mem <<cold>>
initkeyboard initvocab initstate initnumbers inittables initstrings initialize
<cold> <equit> equit re go compatibility nativerom initmsgs getmsgs svmsg?
kbdcompatible?
chksumbyte invert-screen char>lbuff blank-lbuff pat1 !H stop pat2 !# pat3 .line
inverse-line boldtolbuf bold-line pat4 crt-test dm1 dm2 dm3 dm4 dm5 dm6 test1
test2 test3 test4 test5 test6 diskadj-menu disk-adjust testline .stepin
.stepin/out .fixed .wr .rd .rw .retry .recal .curtest field0-msg field1-msg
field2-msg field3-msg field4-msg field5-msg fixed-data .trk# .sect# .field-info
.status disktest-menu ?number update-field0 update-field1 update-field2
update-field3 update-field4 update-field5 update-field +field -field
dtest-status-msg #>lbuff .dtest-status .dpass scroll-dtest-window .diskerr
fixed-test stepin-test stepin/out-test start-test disktest disk-clean ?svlist
@checksum.0high @checksum.0low @checksum.1high @checksum.1low chksm+chksm
.svroms $kbtest $crtadj $fddadj $fddtest $fddclean $format main-menu @keyscan
@keypos @keyrow clr-keytest ?keytest setkey $undo $tab $erase $lock $return $sh
$shift $use-front $space-bar $lleap $rleap $page key$ @key$ !doublechar @attrib
setkey$ kb-row1 kb-row2 kb-row3 kb-row4 kb-row5 kb-row6 .kb-row nextkey
keyboard-test main-test
shadow-t/s savebasis loadbasis rambasis
<trackdump> rheader <rsector> <vsector> <wsector> crc ?trk0 ?wprot ?diskrdy
drive0 drive1 trackdump rsector vsector wsector wtrk romanfont boldfont <remit>
diskcmd? allselected cleantext? save backup displaydisk nontextdisk? ?textdisk
samedisk? emptytext? driveA driveB notepointers noteramsize packtext unpacktext
copyup !id backupdisk? showdisk <Disk> Disk Disk1 DiskB DiskB1 <Bdisk> Bdisk
BdiskB Bdisk1 BdiskB1 <write55> write55 ?index unpackcopiedup savenew
save&backup killdisk verify&erase <rtrk> <vtrk> <wtrk> vtrk ready talk mute
offhook onhook tt.enable tt.disable txcr.enable txcr.disable scrambler.enable
scrambler.disable pll.fast pll.slow wordlen modem.psk modem.fsk modem.ans
modem.orig analog.loop.on analog.loop.off digital.loop.on digital.loop.off
sp1.on sp1.off sp2.on sp2.off filter.high filter.low thres.48 thres.43
send.tone valid.tone.table char>tone pulses char>pulses dialchar <dial>
ser.?txrdy ph.?txrdy memit ser.?rxrdy ph.?rxrdy @ser.char @ph.char ser.rx ph.rx
rp@ rdepth
Phone Uncformat Titles receivable? unreceive receive sendtable selected?
displaybos halfwide? sendline formattedsend unformattedsend redraw
resetphonelight sendstring matchanswerback checklocallight
<sortmap> sort aSort dSort comparestrings signed? checksigns @digit?
comparenumbers $< nextfield getstring nextrecord buildlist moverecords undosort
shuffle presort swaplinks redosort findfield quicksort prevpkt? newnode
countlist scansublist prevrec insertrec selectionsort largestrec moverecord
moveunsorted preshuffle postshuffle prevrecsep initinterruptvecs initbuffers
initsystem <disk-clean> badname? builduplinks adjustsortlist adjustleadingbrks
adjustrailingbrks adjustformats
Calc autopush clause showpocket redefinerror alast adrop anew NaN uNaN afalse
0. acompare ?aflag atrue <muls> <a*> <a/> #table textify nextcalc aexec
findmarker adecode placemarker precalc aftercalc showcalc prescan panicmaybe?
recalc a@ a! a, ?arithmetic remove-word remove-body -reftokens -ref? <<-refs>>
<-refs> showredef compilerror op+tokens findtoken optable <preparse> parsenext
preparse packstring pack allot# name|function clausep? begincompile ucreate
acreate forwardrefs? buildbody acompile pocket? =name? =clause? -pocket
namedclause? redefine pushpocket -expression immediacy pushclause @pocket
getselect popped? resultchars? popsep? pop|recalc push|pop prepush fcalc
moreclause? compileop factor product exponential value atranscribe totab
endsum? ?tab scan >pack aconvert endrel? <rel> relative showselen redefinerror?
redefpopsep? +ref -refs receivetoken <relrounded> tscan encalc !pocket
prevcalc? ^nextcalc inresult? hidebyte initcalc removecalcs linkcalc unlinkcalc
nextcalc? stripattr newname usetoken copypopped copypushed copypocket
preimmediate pretextify syntaxerror -oldef accenterror autopushedaccent
noroomcalc digitserror resetcalc getremains justmovetext pastresult multipop
multipush push|multipop adup aswap aover arot patchforward addpopsep
@calctoken? @element showaftercalc ignoretable sepchars initpocket get#error
get#s ascan1 ascan2 noroomcalc? badnamerror? needsglobal? <sumrounded>
+userounded -userounded get( getphrase interpretphrase
16bitsignex 2nybs 3nybs <bonw> <choose#> <mbmargin> <mpagelen> <mtmargin>
<setline> <wonb> AP3 AP4 AP100 aptroff BJP bonw buildnumber CAT180 checknumber
clearlines clippage#to dispbjgutter dispcomgutter dispgutter displaygroup
exitsetup FX80 gutters LBP m#punct m#sortb m18csf m18d m18dw m18g m18pbs
m18pitch mAB makedefdpkt manswer map map3csf map3d map3dw map3g map3pbs
map3pitch map3tray map4csf map4d map4dw map4g map4pbs map4pitch map4tray
map100dw map100g map100pbs map100pitch mapc mapct mapp mappc mappct mbjpcs
mbjpd mbjpg mbjppbs mbjppitch mbotmgn mdbotmgn mdecimals mdfirstpage# mdpagelen
mdprintpage# mdtopmgn mdirection mdisplay mDWchoice merror mfirstpage# mfxd
mfxg mfxpbs mfxpitch mfxpl mimab mimbpw mimct mimdpx mimlt mimpty mimra mims
mkeyboard mlbpcf mlbpg mlbpl mlbppitch mlineterm mmp mmpc mmpcon mmpct
mnewapcsf mnewapd mnewapdw mnewapg mnewappbs mnewappitch mnewaptray mpagelen
mpitch mprintpage# mring mscdpx mspbps mspbpw mspcon msppty msps mssetup
msspell mtab mtimeout mtlt mtopmgn newAP NON numberdisp oldsetdata pchoicecode
perusecode presetgplines printercode printerport schoicecode scode sendcommand
serialport setblanks setline Setup set-modem set-serial setupcat setx si<>#hl
thisdocdata tolbuf wonb topmsg mpc0 mpc1 mpc2 mpc3 mpc4 mpc5 mpc6 mpcc mpcn
mimcfc mtyper #defaults Defsetup getsetupspell himsetup initsetup initsvram
parksafe rom>svsetup! rom>svsetup? savesetup savespell setupcs svid svid! svid@
svsetupcs! svsetupcs@ spellcs svspellcs! svspellcs@ svramspell>temp
temp>svramspell svramsetup>temp temp>svramsetup setup>temp temp>setup wheel!
wheel@ checkspell! checkspell@ kbdI/II! kbdI/II@ kbdcountry defcountry
mlanguage mspsb mimsb mlbpp/l
<chksumroms> <ramsize> normal-screen pat2odd pat2even diskadj-keywait
fill-disktest cls-dtest chksum<> country.list country.name .systemram
tst.highspeed trainexternal savedigit externaldial Redial DiskTitle transend
special.dw ascii.dw qume.dw portugal.dw oldhalfline
Expl <explain> extexpl #defmsg version# msgtbl eggmsg fedmsg defaultmsg
vanilla.unbuild BJ80.printer unbuild printerror newline newhalfline backspace
halfspace printc paperlength toline formfeed page#string printfooter newpage?
pagebreak showpage skippage pagebreak? overstrike white? print print" render
lbuffend printblanks tocol seektime printposition startline trimline
<printline> UnPanicPrint printline printify initprinter KillPrint UnPrint
<Print> cat180setup lbpsmarts lbp8setup notyet ap400setup ap300setup newapsetup
wheel>country ap100setup bj80setup printers pickprinter setprinter Print
AltPrint daisymagic daisy.printer usa.dw DW.countries setcountry countries
LBPmagic LBP.printer bjsecond.dw trim1 trim2 trim3 trim4 wheel>iso CATdocbreak
LBPpaper LBPdocbreak fx80setup noprintersetup patchprint makeprinttable
fx80magic fx80.printer norway.dw holland.dw afrikaans.dw latin.dw spain.dw
sweden.dw uk.dw german.dw italy.dw france.dw swiss.dw japan.dw canada.dw short?
<<Print>> daisyoverstrike ETWdocbreak apsetup bj80docbreak
typer
spellcode spellchars spellaccents nextnonsep prevnonsep sepchar? spellcheck
addspell deletespell initdictionary spellcheck< spellcheck> translatespell
spellcheckgap spellcheckleap spellcheckagain addspelling deletespelling
emptycheck translategap nextsep? tohyphen spellcheck- spellcheckgap-
endspellcheck undospell dospelling
displaytrace tracenest tracenext traceoff displaycodetrace codetrace
triggernest triggernext tracetier1 tracetier2 tracetier3 tracetier4 tracetier5
tracetier6 tracetier7 tracetier8 tracetier9 tracetiera tracetierb tracetierc
tracetierd tracetiere tracetierf
dbs dbsc dbk dbkc rcvb_read dbn stk_db clear_flags clean_up reset_all cal_crc
xmp_adv ld_char shp_adv lds_char build_lr_skel build_ld_skel build_ln build_lna
build_laf build_las chk_timer set_timer to_idle no_ch_ex flag_stat inp_adv
lin_char build_laf_frame build_lr_frame build_lt_frame build_nglt_frame
build_ln_frame build_lna_frame rxchar xmtb_frd rcfull? recch? rcpeek recget
sendchr 2legalc? clear_buff clear_buffers init_mnp dle_parsing send_it send_ld
send_shut frame_disassembly move_ptrs bad_parm data_state link_establishment
count_gen ltx_adv ldlt_char send_lt build_lt_skel ship_lt data_transmission
mnp_manager crc16table crc16
symbols? phonelight indphone ph1200 ph300 phring phbusy phwait phdial indlearn#
indlocal indspell indaddspell inddelspell indcalc indforth indprint inderase
inddisk indbackup indsort indrecover indtransfer
emptyheadless
cpmcount@ cpmcount! cpmhticks@ cpmlticks@ cpmhstatus@ cpmlstatus@ initcpmstatus
filterhigh? enablecpm? filterhigh! enablecpm! sendchar rechar? rechar
frag code
<uncode> uncode a. getn .code .body .see see swapbytes newbug @regs <.regs>
.saveregs .regs ?tabcol traceon tracetest tracetotext tracetoscr resume newsp
continue @nesxt rdump tracing <trace> trace try sitem .slist slist olist unlist
<intlsortmap>
receivetable modemconnect? waitdialtone checkcpm noreceiving? 2sendtable
mCCITT21 mBELL1
<showcalc> <resetcalc> nextcalcorlockedcalc
3@ 3! import
intvaddr i' tromaddr' tc' t' +ttable ,s { mkmsg patchrom
sset <get> get sendchsx sendchx sendleader sendselection sendimage
thelastword
( backslash integers used by the target compiler control structures )
t' lit \lit to t' <do> \do to t' <leave> \leave to
t' wlit \wlit to t' <loop> \loop to t' <leavel> \leavel to
t' blit \blit to t' <+loop> \+loop to t' <0leave> \0leave to
t' type \type to t' <locals> \locals to t' <0leavel> \0leavel to
t' <"> \" to t' <local> \local to t' <abort"> \abort" to
t' <;> \; to t' <loc0> \loc0 to t' <exitlp> \exitlp to
t' <;lp> \;lp to t' <loc1> \loc1 to t' vocab \voctok to
t' <exit> \exit to t' <bran> \bran to t' <branl> \branl to
t' int0 \int to t' <0bran> \0bran to t' <0branl> \0branl to
( SET \voctok BEFORE USING tvocabulary )
tvocabulary asmb68
taddto asmb68
assigntokens
ccode ?dreg ?areg ?big ?lit ?byte ?word ?sbyte ?sword dataalterable alterable
warncommon .b .w .l size d0 d1 d2 d3 d4 d5 d6 d7 a0 a1 a2 a3 a4 a5 a6 a7 bp iv
ct sa sp rp ip nx np vp ) )+ -) pc)d )d pc,xw)d pc,xl)d xw)d xl)d #n begin, if,
lif, <th> then, else, lelse, until, again, while, lwhile, -until, leave,
lleave, getcom getsrc getdst xsrc xdst <src> <dst> <ea> dst rte, rtr, rts, nop,
trapv, reset, shift asr, asl, lsr, lsl, roxr, roxl, ror, rol, sz/ea neg, negx,
not, tst, r/ea mulu, muls, divu, divs, chk, \ea jsr, jmp, pea, \\ea nbcd, tas,
quick address normal fimmed immed <xt> addsub andoreor add, addq, adda, addi,
abcd, addx, sub, subq, suba, subi, sbcd, subx, and, andi, or, ori, eor, eori,
<cmpa> <cmpi> <cmpm> <cmp> cmp, cmpa, cmpi, cmpm, clr, bit bchg, bclr, bset,
btst, lea, link, unlk, swap, ext, (regs rev16 <to/fro> to) from) movem, movep,
ccr/sr>ea ea>ccr/sr usp<->Ar sdmove mquick moveq, maddr move, exg, trap, stop,
set, rtd, clr :l bra, bsr, dbra, jmp2 jumpto active? asmb68? <code> <frag>
next, ;c next;
thelastword
tdeactivate asmb68
taddtoforth
tvocabulary debug
taddto debug
assigntokens
opcode-map w. &ocw= subf eareg sourcereg eamode sourcemode destreg datareg
opmode destmode data 8-bit-dispf sizef qdata ir >d-regf sz rm dr ccf ex-type
ms-type rs-type vector cc-names condition displacement size dindex xsize <ea>>
<ea> ea easource eadest bitype <ocm-imm> ocm0 ocm1 ocm2 ocm3 ocma ocmf ocm5
ocm6 ocm7 miscellany ocm4 negx sr>move chk lea clr ccr>move neg >ccrmove not,
>srmove nbcd link pea tst tas sickbird trap movec reset nop unlk rte rtd rts
trapv rtr swap, jsr jmp ext.word ext.long >uspmove usp>move reg-list to]-movem
from]-movem ocm8 ocm9 ocmb <ocmc> ocmc ocmd ocme ocm-token ?int ?brans ?branls
?loops ?locs ?; ?btoken .name @token .<#> .lit .wlit .blit .loc .<"> .loops
.ctrl .ctrll .; .voc .ints .compile unpack .alit .refs .checkanswer .extender
toklentable tokenlen .calcstuff .next2 .next .romint .ramint surrogatable
oldtiertable returntrace ascendtrace ctraceoff saveUregs c-trace hl-trace
@rtnaddr swapenviron getchoice .statbit .statreg tracecodeline traceline
<rdump> forthloop dochoice docodechoice
thelastword
tdeactivate debug
taddtoforth
( Create a rom image of user, arithmetic and function )
applic dup @ + 4 + target - .vocimage to ( store top of image )
tvocabulary function ( creat function vocabulary )
taddto function ( open function )
assigntokens
sum sumdisplay avg average abs int sqrt use usedisplay
thelastword ( preassign names )
: sum ( == a ) compile r@ compile <sum> ;
: sumdisplay ( == a ) compile r@ compile <sumrounded> ;
: avg ( == a ) compile r@ compile <avg> ;
: average ( == a ) avg ;
: abs ( -a == a ) 0 numerical compile aabs ;
: int ( a == integerpartof[a] ) 0 numerical compile aint ;
: sqrt ( a == sqrt[a] ) 0 numerical compile asqrt ;
: use ( y x -- | == a ) get( ascii ) getphrase interpretphrase ;
: usedisplay ( y x -- | == a ) +userounded use -userounded ;
taddtoforth ( return to compiling in forth )
tdeactivate function ( not confuse its "abs" with forth's )
tvocabulary arithmetic ( creat arithmetic )
tvocabulary user ( and user vocabulary )
applic dup @ + 4 + target - ( bottom of image )
.vocimage over - .voclen to ( store size of image )
.vocimage to ( store bottom of image )
( assign the forth 0ints )
tokens marker to ( save until after the ints are assigned )
\int swab tokens to ( this must be here's token, 1b00 )
( First the '0int's are defined. Then the 'ints' that take a value. )
0int here ( this token must be 1b00 for this forth implementation )
0int base ( set in init )
0int state ( sys state flag, compile or interpret )
0int nesting ( sys state flag, compiling temp or interp )
0int x ( forth's column output position )
0int y ( forth's row output position )
0int bound
0int csp ( stack security for compiling )
0int locals
0int localvoc
0int applic
0int origin
0int loops
0int hld
0int lasttok ( last token )
0int newest ( token of the most recently defined word )
0int in
0int limit
0int str
0int len
0int panicked
0int lp ( if true, send output to line printer )
0int ser ( if true, send output to serial port )
0int edde ( if true, send output to edde )
0int location ( # of local variables, used by local & ; )
0int nestype
0int targeting ( target compiling flag )
0int jdn ( Julian day number )
0int last4thline ( last forth display line )
0int savenest ( save nesting state flag )
0int saveiv ( trace support )
0int savesr
0int saveip
0int tracepointer
0int toggletrace
0int codetoken ( trace support )
0int traceiling
0int ctrace
0int stepping
0int oldsp@
0int oldrp@
0int do# ( needed for see )
0int decoding
0int disaddr ( opcode word, address and limit for this opcode )
0int dislim
0int opcode-word
0int mode ( The ea is figured from these values )
0int reg
0int osize ( *** )
0int temp0
0int temp1
0int inct
0int diskbou ( addr locating bou on disk image )
0int disk#
0int oldisk#
0int lstat
0int unstat
0int unget
0int time0
0int time1
0int sendport? ( contains imdm, xmdm, sprt, or none )
0int ibmsend? ( true: translate to IBM char set, false: ASCII)
0int xplint ( explain addr )
0int xplen ( explain length )
0int trkbuf ( trackbuffer up in the system.status area )
0int drive ( saved drive type )
0int diskerror# ( holds most recient disk error number )
( Diagnostics integers 3/16/87 MT)
0int trk#
0int sect#
0int rw
0int field
0int diskerr
0int dpass
0int rd/wr
0int current-key
0int prepkt ( first packet before the selection )
0int postpkt ( first packet after the selection )
0int eosline ( line in window table containing the eos )
0int middle ( line offset to new display line )
0int markpoint ( place beyond which to seek pb/ds in wrap )
0int pgchrs
0int fmtchrs ( number of format chars erased )
0int patlen ( the length of the pattern )
0int oldcstate
( Cursor blinking: )
0int cpos ( the address in the text of the cursor )
0int cstate ( -1=split, 0=narrow, 1=wide, 2=extended )
0int cursorstate ( 0=cursor off, 1=cursor on )
0int blinktime ( how much longer until the next blink )
0int cx ( x position of the cursor )
0int cy ( y position of the cursor )
0int cwidth ( the width of the cursor. 0=1/2, 1=full )
0int cursorblock ( when true, cursor won't blink )
( system variables )
0int bou ( beginning of undo buffer )
0int wraplim ( stopping point for wrap )
0int beotivl ( interval corresponding to beot address )
0int gapivl ( interval corresponding to gap address )
0int forceop ( true if typing should force movement of op )
0int lbufwidth ( the width at the last real char in lbuff )
0int oldeos ( holds position of the eos )
0int oldbos ( holds position of bos )
0int bor ( beginning of range for searching )
0int eor ( end of range for searching )
0int bosptr ( pointer into lbuff for bos )
0int eosptr ( pointer into lbuff for eos )
0int beepflag ( true if passed text region where formats stay same)
0int lbound ( left bound for vertical formatting bar )
0int rbound ( right bound for vertical formatting bar )
0int iposit ( initial position for vertical bar )
0int lastkey ( previous key processed in formatting loop )
0int thiskey ( most recently processed key in formatting loop )
0int posit ( instantaneous position of vertical bar )
0int oldshiftlock ( true if shiftlock was set before this cmd )
0int ufpressed? ( true if the use-front key has been pressed again )
( ruler 0ints )
0int oldlnl ( check against #lnl to detect change)
0int gaugesize ( indicates if 256k or 384k ramsize )
0int oldgauge ( previously displayed gauge value)
0int blackruler
0int ruleblink ( 'on' when status line is a different color from ruler )
0int blackscreen ( true if white characters on a black screen )
0int text ( addr of absolute start of text area )
0int endtext ( addr of byte just past absolute end of text )
0int endtextivl ( pointer to the interval for endtext in #itbl )
0int disktext ( start of text area on disk )
0int pagesfull ( flag )
0int ledge
0int undlng?
0int temp-rp
0int nbufflen
0int temp-sp
0int rptemp
0int sptemp
0int extbos ( stationary bos in split cursor )
0int savebos ( moving bos in split cursor )
0int rsplit ( ruler )
0int xsplit ( split cursor offset in line buffer )
0int ysplit ( window line of split cursor )
0int lbuflen ( length of lbuff, build sets, print uses )
0int onimplicit ( flag if lex landed on implicit page )
0int dirtytext? ( flag to say if the text is changed )
0int disk-id ( identifier for the disk loaded from )
0int digits ( count of digits in page number array )
0int lopage ( lowest page number to show on screen )
0int lastop ( the last action to take place in editor )
0int curop ( current operation taking place )
0int undop ( operation needed to undo last command )
0int spellop ( undo token for undospelling )
0int leftlex? ( true of the left lex key was first pressed )
0int bos ( beginning of selection )
0int eos ( address beyond end of selection )
0int bosl ( bottom of sorted list for shuffling )
0int eosl ( top of sorted list for shuffling )
0int upp ( upper partition pointer )
0int lpp ( lower partition pointer )
0int hpl ( high partition limit )
0int lpl ( low partition limit )
0int focal ( record which quicksort compares with )
0int sortbot ( bottom of sorted list )
0int sorttop ( top of sorted list )
0int lines ( total text line count )
0int pages ( total text page count )
0int bot ( beginning of text )
0int beot ( beginning of second partition of text )
0int eot ( address beyond end of text )
0int gap ( address beyond of first partition of text )
0int topline ( line number of first line in window )
0int gapline ( eos line relative to window )
0int xcur ( display character offset to cursor )
0int ycur ( window line offset to cursor )
0int xnar ( offset to narrow cursor )
0int ynar ( window line to narrow cursor )
0int rnar ( ruler )
0int rwide ( ruler )
0int blinks ( counter for blinking cursor )
0int direction ( 0=search left, -1=search right )
0int pattlen ( bytes in current search pattern )
0int cursor? ( if true, cursor is visible )
0int norefresh ( if true, refreshes won't happen )
0int showmove? ( flags display during move&adjusttext )
0int rcursor ( ruler )
0int lexxing ( -1:in middle of lex operation )
0int newlex ( -1:new search pattern not yet entered )
0int matched ( address of last pattern found )
0int p ( place )
0int op ( old place )
0int pop ( previous old place )
0int po ( pointer )
0int xpos ( address where cursor char inserted )
0int ypos ( screen line where cursor blinks )
0int defleft
0int defindent
0int defspace
0int learning?
0int learnbuff
0int curlearn
0int learnpos
0int learnerror ( flag, true if learn stopped recording )
0int descending ( flag, true if sort in descending order )
0int tab# ( tab stop for field )
0int undolist ( head of sorted list for undoing )
0int intlspecial
( Calc variables )
0int sumcount
0int savesp
0int precis
0int lastcalc
0int pass
0int intlen
0int scanner
0int parsed
0int selen
0int astring
0int alen
0int aintlen
0int textify?
0int mover
0int marker
0int scanbot
0int oldpocket
0int pocketname
0int commas
0int oldvoc
0int redef
0int aerror#
0int references
0int redefpopped ( for recovery of copied up syntax errors )
0int userounded? ( distinguish between sum and sumrounded )
0int eraselist ( top of erasable chain of calctokens )
0int badcalc? ( flag, true if tab automatically added by pass 3 )
0int calcinterrupted? ( flag, true if calc was interrupted )
0int dotted ( flag, true if selection contains dotted underline )
0int wrapdone ( signals completion of page table wrap )
0int newpiece ( page table place where split piece found )
0int oldpiece ( page table place where split piece put )
0int cutlines ( number of lines in split off piece )
0int cutpages ( number of pages in split off piece )
0int old0
0int old1
0int newtab
0int oldop ( to save state of op for undo )
0int oldpop ( same for pop )
0int oldcursor ( and cursor )
0int oldtopline ( and same for topline )
0int oldop2 ( for uncreep and unscroll )
0int oldpop2
0int oldcstate2
0int oldbos2
0int oldeos2
0int oldtopline2
0int dtmf ( DTMF dial flag )
0int seed ( random number seed )
0int sending
0int answerback? ( if true, will respond to ENQ with answerback message )
0int cattocat? ( if true, sending cat to cat )
0int trycattocat? ( if true, should attempt cat to cat communications )
0int halfduplex? ( if true, sending half duplex )
0int txenabled?
0int ringsound ( address of current ring sound )
0int phonetimer
0int changetone
0int %pwrap ( prev array, wrap address )
0int side# ( side of disk )
0int drive# ( which disk drive )
0int idadvance ( flag, if true should advance disk id )
0int auto-answer? ( flag, true if last going off hook was auto-answer )
0int oldrxptrs ( old copies of rxpointers to see if they changed )
( assembler 0ints )
0int asmb68kill ( the assembler abort flag )
0int smode ( source addressing mode )
0int sreg ( " register )
0int sxtra ( extra source data )
0int dmode ( destination addressing mode )
0int dreg ( " register )
0int dxtra ( extra destination data )
0int quickop ( holds specific 'quick' opcode )
0int immedop ( " 'immediate' opcode )
0int addrop ( " 'address' opcode )
0int normalop ( " add or subtract opcode )
0int iccrop ( " 'ccr' opcode )
0int isrop ( " 'sr' opcode )
0int tr ( Condition Code for 'always true' )
( SETUP command integers )
0int ipage# ( the initial page number)
0int iprint# ( the initial printing page number)
0int hllong ( the number of half lines for a page job87apr10)
0int hlabove ( the number of half lines for top margin job87apr10)
0int hlbelow ( the number of half lines for bottom margin job87apr10)
0int numbr ( holds the number currently being worked on)
0int choicelimit ( the limit on the number of choices)
0int cflag ( The choice flag. On when a user choice is solicited.)
0int exitsc ( so group display can tell which exit key was pressed)
0int delta# ( the delta to add when choosing numbers)
0int #autos ( the number of auto repeats for delta acceleration)
0int groupstartl# ( the line # to start displaying this group)
0int maxgpline ( the maximum number of group lines for blanking)
0int mingpline ( the minimum number of group lines for blanking)
0int oldend ( Remembers the old string end for blanking it)
0int atrib ( A place to assemble attributes for the displayed chs )
0int group# ( holds the current group number )
0int printer ( the anothergroup number of the main printer)
0int aprinter ( a flag to indicate if a printer is attached )
( 0Ints for printing -- 26feb87/dab )
( Exports from printer setup to Print )
0int whichprinter ( flag for main/alt printer usage)
0int printertable ( xlate from a long char code to a printer)
0int unbuildtable ( xlate from lbuff back to an long code)
0int 'weirdprint ( punts on printer codes 00xx-1Fxx )
0int 'docbreak ( execution vector for printing document breaks )
0int oldcountry ( what country is the LBP set to? )
0int rightstop ( kludge to help mimic weird printer firmware )
0int steps/line ( printer steps per line feed)
0int boustrophedon ( manually bidirectional printing)
0int char/inch ( print pitch)
0int pageprint ( are we doing single-page printing? )
0int gutter ( left margin offset in halfchars )
0int braindamaged ( printer can't reverse or bi-dir print)
0int fullcrtime ( tuning factor for logic seeking )
0int knowstof? ( is printer aware of form feeds? )
0int knowsbold? ( can it boldface on its own? )
0int knowsul? ( can it underline? )
0int knowsos? ( does it prefer overstrike to backspace?)
0int knowshmi? ( uses diablo-like HMI setting )
0int steps/inch ( granularity of the HMI setting)
0int hmiseek ( seek rate when moving by inches )
0int seekrate ( seekrate when moving by chars)
0int ulinehack? ( translate ul'ed whitespace to ul )
0int paperpos ( location where paper is 'top of form')
0int papershort ( number of lines 'missing' from the page)
( coming soon! 'knowshowtoprint?' and 'knowsanythingatall?' )
( The following ints are private to the printer code)
0int backwards ( currently printing backwards?)
0int oddhalfspace ( true if next halfspace is odd #)
0int printnext ( next char to print in lbuff)
0int prcol ( current print column)
0int prline ( half-line of the page)
0int underlined ( currently underlining stuff?)
0int bolded ( currently making things 'bold' )
0int printlimit ( end of the lbuff)
0int stopprint ( switch for early escape from Print)
( more private stuff, comunicating from 'unbuild' to 'render')
0int prchar ( cur. print code *not* a text code)
0int proldflags ( flag byte for previous character)
0int prsmall? ( is this a half character? )
0int printed? ( is this char part of the selection? )
0int prwhite? ( is this char white?)
0int pr\bold/ ( is this a font transition?)
0int pr\uline/ ( is this an underlining transition?)
0int pr\dline/ ( is this a dotted-underline edge?)
0int diabolical ( if true, daisy-wheel printing works as for a diablo )
( typewriter mode variables )
0int status ( bold and underline status for typer )
0int pitch ( pixel width of characters )
0int tpos ( current typewriter head position in 1/120" )
0int leftside ( current left margin in 1/120" )
0int bufsize ( size of delete buffer to erase characters )
0int capstat ( status of caps type mode [caps lock] )
0int typermode ( true if in typewriter mode )
( MNP variables 3/8/88)
0int false
0int curchar ( current character from rxget )
0int curval ( current value, CRC calculation )
0int fr.timer ( frame disassembly timer )
0int hdrlen ( header length of the current PDU )
0int la.retry.ctr ( LA retry counter )
0int la.timer ( lost LA timer - prevents deadlock )
0int ln.retry.ctr ( LN initiater retry counter )
0int ln.timer ( LN timer )
0int local.cred ( number of LTs we will accept )
0int local.seqn ( sequence number for LTs, LAs we send )
0int lr.init.timer ( LR initiater retransmission timer )
0int lr.mdata.lo ( LR max user data size - low byte )
0int lr.retry.ctr ( LR initiater retry counter )
0int lt.retry.ctr ( LT retry counter )
0int lt.timer ( LT retransmission timer )
0int out.count ( count of chars in the output buffer )
0int pdutyp ( type of the current PDU )
0int rcv.count ( count of chars in a receive frame )
0int rem.ln.seqn ( sequence number from the LNs we receive )
0int remote.cred ( No. of LTs remote MNP will accept )
0int remote.seqn ( sequence number from the LAs we receive )
0int sflg.retry.ctr ( SYN DLE STX search retry counter )
0int sht.count ( count of chars in shutup buffer )
0int mnp.state ( state of link establishment process )
0int xmt.count ( count of chars in a transmit frame )
0int asap.req ( send now flag. Send/receive sets to request immediate
transmission of chars passed to MNP so far. MNP clears. )
0int break.ind ( break indication flag. MNP sets when an LN is received.
Send/receive clears. )
0int break.req ( break request flag. Send/receive sets, MNP clears after
sending LN and receiving LNA )
0int connect.ind ( connection indication flag. MNP sets when link established
on remote request. MNP clears when disconnection occurs. )
0int connect.req ( connection request flag. Send/receive sets, MNP clears
when link established. If no link, MNP clears it and sets discon.ind )
0int discon.ind ( disconnection indication flag. MNP sets, send/receive
clears. )
0int discon.req ( disconnection request flag. Send/receive
sets, MNP clears after sending LD. )
0int endflag.req ( frame end flag. Set by lower layer IRQ routine when the
frame end sequence [DLE ETX] has been detected. MNP clears. )
0int shutup.req ( shutup request flag. Send/receive sets, clears )
0int no.xmit.ind ( no transmit flag. MNP sets if it cannot transmit chars,
clears when transmission is OK. )
0int data.in ( incoming data flag - if on, we are receiving )
0int data.out ( outgoing data flag - if on, we are sending )
0int data.up ( data for upper layer flag - if on, the upper layer can get
LT data via rec_get )
0int gotframe ( frame flag - if on, SYN DLE STX has been found )
0int no.char ( no character flag - if on, no chars from rxget, exit MNP )
0int outbuf.full ( outbuff full flag - if on, LT buffer full of chars)
0int shutup ( shutup flag - if off, no shut up, normal ops )
0int start.lt ( start LT flag - if on, a new LT is being started )
0int frame.stat ( frame disassembly error status. -1 frame good, 0
unfinished, >1 bad )
( send and receive integers )
0int execution
0int break
0int spare2
0int spare1
0int dataaddr
0int datasize
( the initialized int's )
tokens .inttok to ( needed to initialize ram integer table )
lbuff int lbuff ( edde line buffer )
#lbls int #lbls ( maximum # of labels )
lbls int lbls ( data array for labels )
-1 int asmb68warn ( assembler warning message flag )
80 int <size> ( operand size )
-9 int usp ( User Stack Pointer indicator )
-a int sr ( Status Register indicator )
-b int ccr ( Condition Code Register indicator )
100 int nt ( Condition Code for 'never true or false' )
200 int hi ( Condition Code for 'high' )
300 int ls ( Condition Code for 'low or same' )
400 int nc ( Condition Code for 'no carry = clear' )
500 int cs ( Condition Code for 'carry set' )
600 int ne ( Condition Code for 'not equal' )
700 int eq ( Condition Code for 'equal' )
800 int nv ( Condition Code for 'no overflow = clear' )
900 int vs ( Condition Code for 'overflow set' )
a00 int pl ( Condition Code for 'plus' )
b00 int mi ( Condition Code for 'minus' )
c00 int ge ( Condition Code for 'greater or equal' )
d00 int lt ( Condition Code for 'less than' )
e00 int gt ( Condition Code for 'greater than' )
f00 int le ( Condition Code for 'less or equal' )
( the following are values put into curop to identify the current operation.
The only other values in curop will be the character hit when a command is
executed. Since command keys have different values when used in different
countries, some commands must specifically set the curop to a known value.
Otherwise, the only test that can be safely performed is to see if
curop=lastop. Because keys have values up to FF88, all values below are >FFFF.)
10000 int %explain
10001 int %disk
10002 int %scroll
10003 int %lex
10004 int %erase
10005 int %undo
10006 int %insert
10007 int %setl
10008 int %seti
10009 int %setr
1000a int %sett
1000b int %pfmt
1000c int %cfmt
1000d int %print
1000e int %dfmt
1000f int %sets
10010 int %setj
#window int #window
statbuff int statbuff ( status line 'lbuff' )
#nextwr int #nextwr
#ctrl int #ctrl
#pctrl int #pctrl
##ctrl int ##ctrl
#wtable int #wtable
#update int #update
workpkt int workpkt
sparepkt int sparepkt ( so SORT protects format packets properly )
saveregs int saveregs ( for stack frame during trace )
uraniumregs int uraniumregs ( for trace )
-1 int tracecrt ( default: display trace results NOT in text )
0 int tracedde ( default: " )
0 int toklens ( value created on disk C1 )
#itbl int #itbl
btable int btable
ticks/min int ticks/min ( ticks per minute )
100 int blinkct ( blnktime )
30 int happyct ( happycursor )
-1 int rulerblink? ( if true, blink in ruler when blink text )
1 int beepblink ( 1=error beeps, 2=blink, 3=both )
.idtable int idtable ( table of disk id's )
.ramcmds int cmds
.xplntbl int xplntbl ( extended explain token table )
temptabs int temptabs
deftabs int deftabs
0a int pagebase
2 int footpos ( posn of print footer on paper )
pgs int pgs ( number of pages )
we int we ( window entry size )
pe int pe ( page table entry size )
fte int fte ( format table entry size )
wl int wl ( window array line count )
13e int redge
-1 int parallel
1e int carriertimeout ( time to wait after picking up the phone - 30
seconds)
4 int pcwidth
80 int lexop ( a value for lastop to indicate lexxing )
0 int Answer? ( if true, answer is enabled )
0 int Forth? ( if true, forth command is enabled )
( MT 3/17 )
( Integers for diagnostics )
1 int #retry
1 int #recal
1 int dtest#
( integers redefining constants and arrays from target compiler )
esize int esize ( entry size in bytes for window and interval tables )
pktsize int pktsize ( size of a packet in text )
dpktsize int dpktsize ( size of a document packet in text )
lbufwide int lbufwide ( size of a character in lbuff )
lastline int lastline ( last line in window table )
vbheight int vbheight ( pixel height of vertical bar )
screenstart int screenstart ( where is the display?)
lines/screen int lines/screen ( character lines on the screen)
scans/image int scans/image ( height of a character)
tophalf int tophalf ( height/2 of character)
bytes/image int bytes/image ( NOTE: code assumes this value!)
isize int isize ( size of text interval represented by table entry )
system.status int system.status ( Mino's system area )
.shadow int shadow ( where the shadow ram is located )
40000 int shadowsize ( the size of the shadow ram: 256k )
( control/format array )
%pg int %pg
%pgl int %pgl
%wr int %wr
%ln int %ln
%lnl int %lnl
%spr int %spr
( format variables )
%lsp int %lsp
%oldlsp int %oldlsp
%left int %left
%wide int %wide
%indent int %indent
%iwide int %iwide
%just int %just
%tabs int %tabs
%long int %long
%above int %above
%below int %below
%lock int %lock
%ipage int %ipage
%iprint int %iprint
#pg int #pg
#pgl int #pgl
#wr int #wr
#ln int #ln
#lnl int #lnl
#spr int #spr
( format variables )
#lsp int #lsp
#oldlsp int #oldlsp
#left int #left
#wide int #wide
#indent int #indent
#iwide int #iwide
#just int #just
#tabs int #tabs
#long int #long
#above int #above
#below int #below
#lock int #lock
#sort int #sort
#ipage int #ipage
#iprint int #iprint
#prec int #prec
( Globals & constants for 'disp' )
invbit int invbit
ulinebit int ulinebit
dlinebit int dlinebit
boldbit int boldbit
stopbit int stopbit
smallbit int smallbit
patternsize int patternsize
&horiz int &horiz ( horizontal half-characters displayed )
ds int ds ( the break characters )
pb int pb
mpb int mpb
rtn int rtn
tb int tb
spc int spc
pattern int pattern
nbuff int nbuff
2e int dot
tabsize int tabsize
<wordbuff> int wordbuff
800 int learnop
1000 int maxlearn
0a int #learns
4 int ulink ( reverse order link )
8 int olink ( original order link )
c int recaddr ( address of actual record )
10 int reclen ( length of record )
12 int foffset ( offset to field in the record )
14 int flen ( length of the field )
16 int rsize ( the size of the nodes in the list )
1 int sortbreaks ( number of breaks to be a record )
( spelling verifier work area declarations )
svwork int svwork ( scratchpad used by spelling verifier roms )
svbuf int svbuf ( translation buffer )
( constants needed for Calc )
ascii . int dpoint ( reassignable decimal point char )
ascii , int commapun ( reassignable thousands place char )
ascii , swab ascii . + int oldpuns ( last punctuation used )
ascii # int markerchar ( place marker character )
ascii _ int popsep
87654321 int magic#1
12345678 int magic#2
2 int precision
4 int #reftokens
#op+tokens int #op+tokens
#chars int #chars
bac int #ignorable ( # of chars ignorable by sum, etc )
bac int #sepchars ( # of seperator characters )
opchars int opchars
adeep int adeep ( number of elements )
awide int awide ( stack width )
awhole int awhole ( nybbles in whole part )
aacum int aacum
aresult int aresult
around int around
atemp int atemp
mtable int mtable
abuffer int abuffer
astack int astack
astack int asp ( stack pointer )
14 int tabcount ( allowed number of tab stops )
10 int firstseen ( first window table line on video display )
36 int lastseen ( last window table line on video display )
19 int ontime ( how long to wait after turning cursor on )
19 int offtime ( how long to wait after turning cursor off )
markbl int markbl ( used in build only, as a space char )
lok int lok ( the character for the locked text border )
tab0 int tab0 ( a pseudo '-' part of a displayed tab )
tab1 int tab1 ( a pseudo-arrowhead in tab display )
tabspace int tabspace ( blank indicating an unselected tab in lbuff)
locktop int locktop ( top of locked document )
lockend int lockend ( end of locked document )
lockbar int lockbar ( frame for locked text )
erase int erase ( the erase key )
undo int undo ( the undo key )
4 int overscanwidth ( size of overscan [grey] areal on each line)
0f int markerspace ( a place holder for bare accent chars )
0c int hardpage ( page break display character )
0e int softpage ( implicit page display character )
0b int docpage ( display document character )
$inv int $inv ( display mod bit for inverse )
$uln int $uln ( display mod bit for underline )
$dln int $dln ( display mod bit for dotted underline )
$bold int $bold ( display mod bit for bold font )
$end int $end ( last display character in line )
$half int $half ( display mod bit for half-wide char )
( text command tokens )
&skip int &skip
&fmt int &fmt
&calc int &calc
&lockedcalc int &lockedcalc
&attr int &attr
&dln int &dln
&lastasc int &lastasc
&lastchr int &lastchr
&firstacc int &firstacc
&lastacc int &lastacc
&firstcmd int &firstcmd
&lastcmd int &lastcmd
&firsthid int &firsthid
&attr int Font ( used to modify eemit attributes )
&attr int plain ( this is the plain font )
&attr $bold 1 shr or int bold ( these can be applied to Font )
&attr $uln 1 shr or int uln
( constants for the ruler )
( Status line display )
3 int line#pos ( offset of line# data in statbuff )
( SETUP command integers )
" imdm" drop @ int imdm ( internal modem flag)
" xmdm" drop @ int xmdm ( external modem flag. someday, maby)
" none" drop @ int none ( not connected flag)
" pprt" drop @ int pprt ( parallel port flag)
" sprt" drop @ int sprt ( serial port flag)
bac int #halflines ( the number of half lines for each paper size)
32 int choicex ( the x position to display the setup choices )
( MNP integers 3/8/88)
5 int assem.delay ( maximum time to assemble a frame )
12 int cred.off ( offset to credit allocation parm in LR )
19 int daphop.off ( offset to data phase optimization parm in LR )
5 int data.off ( offset to data in fixed field LT )
10 int DLE
03 int ETX
FF int frame.limit ( max frame size )
FF00 int hi.mask ( mask for MS byte of 16 bit quantity )
4 int l.seqn.off ( offset to sequence number in fixed field LA, LT )
5 int la.cred.off ( offset to credit allocation in fixed field LA )
3C int la.delay ( time we wait before sending another LA )
5 int la.pdu ( Link Acknowledgement, LA, PDU functional type )
2 int ld.pdu ( Link Disconnect, LD, PDU functional type )
2 int ld.rsn.inc ( LD reason code - incompatible level )
1 int ld.rsn.nlr ( LD reason code - 3-way hndshk err - PDU not an LR )
4 int ld.rsn.rex ( LD reason code - retransmission limit reached )
3 int ld.rsn.unk ( LD reason code - unknown LR parms )
FF int ld.rsn.usr ( LD reason code - user requested termination )
1 int len.1 ( PDU parm length of 1 )
2 int len.2 ( PDU parm length of 2 )
A int ln.delay ( delay before LN retransmission )
6 int ln.pdu ( Link Attention, LN, PDU functional type )
6 int ln.seqn.off ( offset to sequence number in LN )
7 int lna.pdu ( Link Attention Ack, LNA, PDU functional type )
FF int lo.mask ( mask for LS byte of 16 bit quantity )
3 int lr.cred.code ( LR credit allocation parm code )
8 int lr.daphop.code ( LR data phase optimization parm code )
A int lr.delay ( delay before LR retransmission )
4 int lr.maxdat.code ( LR max user data size parm code )
1 int lr.pdu ( Link Request, LR, PDU functional type )
2 int lr.svclas.code ( LR service class parm code )
7 int lt.delay ( delay before LT retransmission )
3 int lt.hdr ( number of non-data bytes, fixed field LT header )
105 int lt.limit ( max number of data chars in an LT )
4 int lt.pdu ( Link Data, LT, PDU functional type )
1 int max.lr.ret ( max number of times to retry sending LR )
11 int max.retries ( max number of times to retry sending a PDU )
15 int maxd.off ( offset to max user data size lo byte parm in LR )
5 int ngf.code ( bad frame, parm code is bad )
2 int ngf.crc ( bad frame, CRC is bad )
9 int ngf.cred ( bad frame, wrong credit allocation )
11 int ngf.dap ( bad frame, wrong data phase optimization )
3 int ngf.flim ( bad frame, chars in frame more than max )
6 int ngf.len ( bad frame, parm length wrong )
10 int ngf.mdata ( bad frame, wrong max user data )
12 int ngf.nlat ( bad frame, not LA or LT )
13 int ngf.nlr ( bad frame, not an LR in LR_RESP_WAIT )
8 int ngf.prot ( bad frame, wrong protocol level )
4 int ngf.retries ( bad frame, too many retries to assemble frame )
7 int ngf.svc.cla ( bad frame, wrong service class )
1 int ngf.time ( bad frame, timeout )
7 int ngt.asap ( received an asap.req but no LT in process )
6 int ngt.la.ret ( more than max.retries lost LA retransmissions )
5 int ngt.ln.seq ( we got an LNA with seq number mismatch )
2 int ngt.nak ( we got a NAK, resending old LT )
3 int ngt.not.lt ( we got a non-LT PDU when we shouldn't have )
4 int ngt.pdu ( received illegal PDU )
1 int ngt.seqn ( bad received LT, sequence number mismatch )
3 int one.dle ( bad frame, illegal single DLE )
4 int prol.off ( offset to protocol level parm code in LR )
FF int seqn.limit ( max value, sequence number )
5 int st.data ( DATA state, link establishment complete )
1 int st.idle ( IDLE state in link establishment )
4 int st.la.wait ( LA_WAIT state in link establishment )
2 int st.lr.resp.wait ( LR_RESP_WAIT initiater state, link estab. )
3 int st.parms.nego ( PARMS_NEGO state in link establishment )
02 int STX
F int svcl.off ( offset to service class parm in LR )
16 int SYN
33 int ticks/sec ( ticks per second. 51 base 10, measured 9/29/87 )
-1 int true
3 int weird.parm ( unknown/incompatible parms reason code for LD )
xmitbufsize int xmitbufsize ( size of transmit buffer for 1 max-length
frame )
rcvbufsize int rcvbufsize ( size of frame buffer for 1 max-length frame )
shutbufsize int shutbufsize ( size of canned shut up LA frame buffer )
FF int curstrt ( initial value, CRC calculation )
4 int dbug.lev ( DB debug level, controls debug printing )
3 int dv1 ( various debug levels )
5 int dv2
7 int dv3
1 int ld.reason ( reason code for an LD LPDU )
1 int ln.att.type ( LN attention type - always destructive, expedited )
1 int loc.ln.seqn ( sequence number for LNs we send )
1 int lr.crd.allo ( LR credit allocation. we want 1 )
3 int lr.data.ph ( LR data phase optimization. we want 3 )
4 int lr.mdata.hi ( LR max user data size - high byte )
2 int lr.prot.lvl ( LR protocol level. we want 2 )
2 int lr.svc.clas ( LR service class )
B int retry.lim ( retry limit )
-1 int trans.stat ( transmission failure status. If -1 no failure, > 1
various flavors of fail )
ltxbuff int ltxbuff ( buffer for building an LT )
outbuff int outbuff ( buffer for characters provided to upper layer )
rcvbuff int rcvbuff ( buffer for incoming characters from modem )
shutbuff int shutbuff ( buffer for 'canned' shut up LA )
xmitbuff int xmitbuff ( buffer for outgoing frame to modem )
inputbuff int inputbuff ( dummy input buffer )
ltxbuff int ltxptr ( pointer into ltxbuff )
outbuff int outptr ( pointer into outbuff )
rcvbuff int rcvptr ( pointer into rcvbuff )
shutbuff int shtptr ( pointer into shutbuff )
xmitbuff int xmtptr ( pointer into xmitbuff )
inputbuff int mnpinptr ( pointer into inputbuff )
3 int diskoffset
trkbuflen int trkbuflen
ramstart int ramstart
ramend int ramend
ramsize int ramsize
screensize int screensize
screen int screen ( start of display area )
/scan int /scan
-1 int t#on ( track # current drive is on)
-1 int t#on0 ( track# for drive 0 )
-1 int t#on1 ( track# for drive 1 )
-1 int savestate
-1 int crt
.itx int itx
.exec int execbuf
3b00 int vdelay ( delay time for video on )
300 int senddelay ( time to wait after sending for extra chars )
intv int intexecvecs ( interrupt execution vectors )
.endtable int endtable
.endtable int strings
cbuff int cbuff ( keyboard circular buffer )
special int special ( keyboard 'special' array )
.pad int pad
.act int active
.ext int extant ( vocabulary ints )
text int top
stacksize int stacksize ( size of the data stack )
rstacksize int rstacksize ( size of the return stack )
largestacksize int largestacksize ( maximum permissible stack size )
stackcopy int stackcopy ( array for copy of data stack )
rstackcopy int rstackcopy ( array for copy of return stack )
sp0 int sp0
rp0 int rp0 ( the base of the return stack )
1b int ESC ( some values )
7f int DEL
20 int BL
09 int TAB
0d int CR
a5a55a5a int string: ( Stack marker for becomes )
xlate int xlate ( arrays needed for "Fast Serial" to Mac *** )
leader int leader ( arrays needed for "Fast Serial" to Mac *** )
trailer int trailer ( arrays needed for "Fast Serial" to Mac *** )
( These ints are 'back patched' and are not really set to bac )
bac int ffont ( edde font pointers, patched later )
bac int qfont ( the font used by the 'quit' loop )
bac int tfont ( the font used by 'type', etc. )
bac int font ( the current display font )
bac int vfont
bac int next
i' next intnextaddr to ( holds rom addr of next )
bac int current ( set only after user's token is assigned )
bac int kcodes ( keyboard codes )
bac int tokens
bac int ramtoken0
bac int maptable
bac int sortmap ( map table for sort )
bac int intlsortmap
bac int statuslights
bac int cursorimage
bac int wcursorimage ( cursor image for wide cursor )
bac int ncursorimage ( cursor image for narrow cursor )
tokens 4 - .intend to ( needed to initialize ram integer table )
marker tokens to ( in case a word isn't preassigned )
( Some very fundimental forth code)
frag .nest to ( do the : nesting. forth's next follows nest)
sa ip .w sub, ( make the delta ip) ip rp -) .w move, ( save the delta ip)
ct rp -) .w move, ( save lover 16 bits of the token pointer)
a1 2 )d ip lea, ( load ip with code address)
a1 sa move, ( save ip) a0 ct move, ( save token pointer)
here target - tromaddr' next ! ( address of next into int)
ip )+ bp .b move, ( 1 byte token to base reg, upper 3 preset)
bp a0 move, ( work register, all 4 bytes meaningfull now)
a0 a0 .w add, a0 a0 .w add, ( low part *4 to get 32-bit addr.)
a0 ) a1 move, ( code address ) a1 ) jmp, ( execution begins) ;c
frag .ramint to ( code for ram integers. a copy of next follows this too)
2 #n a1 addq, ( point to parameter field)
a1 ) sp -) move, ( push value)
a1 iv move, ( integer variable code ptr)
ip )+ bp .b move, ( 1 byte token to base reg, upper 3 preset)
bp a0 move, ( work register, all 4 bytes meaningfull now)
a0 a0 .w add, a0 a0 .w add, ( low part *4 to get 32-bit addr.)
a0 ) a1 move, ( code address ) a1 ) jmp, ( execution begins) ;c
( interrupt code, first the generalized interrupt caller: nzexec
nzexec is entered like this:
first set d0 to the desired execution address xxx d0 move,
then jump to nzexec's entrance nzexec jmp, )
frag nzexec to ( address of nzexec, to generalized interrupt caller)
ne if, ( addr in d0 is non-zero) d0 a0 move,
a0 ) jmp, ( go run this interrupt handler, rts from there)
then, ( the address is zero, just return from here)
rts, ;c
( begin defining the words)
code forth ( principal vocabulary, header)
np ) jmp, ( jump to nest)
0 c, ( backpatch vocab here)
0 c, ( a filler to make an even byte boundry)
0 w, ( token for forth)
0 , ( size of code portion, 32 bits)
;c
0 ( floating entry address seed for stack security)
code tier1 ( tier 1, the first of the tokens that read another token)
.tbl 100 + #n d0 move,
drop here target - ( entry for the other tiers)
ip )+ d0 .b move, d0 a0 move,
a0 a0 .w add, a0 a0 .w add, a0 ) a1 move, a1 ) jmp,
;c
code tier2 .tbl 200 + #n d0 move, dup jmp, ( into tier1) ;c
code tier3 .tbl 300 + #n d0 move, dup jmp, ;c
code tier4 .tbl 400 + #n d0 move, dup jmp, ;c
code tier5 .tbl 500 + #n d0 move, dup jmp, ;c
code tier6 .tbl 600 + #n d0 move, dup jmp, ;c
code tier7 .tbl 700 + #n d0 move, dup jmp, ;c
code tier8 .tbl 800 + #n d0 move, dup jmp, ;c
code tier9 .tbl 900 + #n d0 move, dup jmp, ;c
code tiera .tbl a00 + #n d0 move, dup jmp, ;c
code tierb .tbl b00 + #n d0 move, dup jmp, ;c
code tierc .tbl c00 + #n d0 move, dup jmp, ;c
code tierd .tbl d00 + #n d0 move, dup jmp, ;c
code tiere .tbl e00 + #n d0 move, dup jmp, ;c
code tierf .tbl f00 + #n d0 move, dup jmp, ;c
drop ( floating entry address)
0 ( floating entry address seed for code definition's stack security )
code int0 ( The first of several specialized tokens that do the integer
execution. The token for this word must be 1b.)
.int 000 + #n iv move,
drop here target - ( entry -- from int1 through int6 )
ip )+ iv .b move, iv a0 move, a0 ) sp -) move, next;
code int1 .int 100 + #n iv move, dup jmp, ( into int0 ) ;c
code int2 .int 200 + #n iv move, dup jmp, ;c
code int3 .int 300 + #n iv move, dup jmp, ;c
code int4 .int 400 + #n iv move, dup jmp, ;c
code int5 .int 500 + #n iv move, dup jmp, ;c
code int6 .int 600 + #n iv move, dup jmp, ;c
code int7 .int 700 + #n iv move, dup jmp, ;c
code int8 .int 800 + #n iv move, dup jmp, ;c
code int9 .int 900 + #n iv move, dup jmp, ;c
code inta .int a00 + #n iv move, dup jmp, ;c
code intb .int b00 + #n iv move, dup jmp, ;c
code intc .int c00 + #n iv move, dup jmp, ;c
code intd .int d00 + #n iv move, dup jmp, ;c
code inte .int e00 + #n iv move, dup jmp, ;c
code intf .int f00 + #n iv move, dup jmp, ;c
drop ( floating entry address )
( The following disk code **MUST** be located below $8000 )
( it uses absolute .w jmp, instructions to transfer between fragments.)
frag <wsync> to ( write n bytes of zeros to the disk )
( d0 = number of times to be written )
( a4 = pointer to disk data register )
4e #n d1 .l moveq, ( 4 write 4E )
0 :l d1 a4 ) .b move, ( 8 write to disk register )
01 #n d0 .w subq, ( 4 decrement count )
2 eq .b bra, ( 8 still in loop so delay )
2a #n d1 .l moveq, ( 4 set delay to 92 )
d1 d1 .l lsr, ( 92 delay )
0d #n d0 .w cmpi, ( 8 start writing 00's ? )
1 mi .b bra, ( 8 branch if taken )
3 #n d1 .l lsr, ( 14 delay )
4e #n d1 .l moveq, ( 4 write a 4e )
0 .b bra, ( 10 write again )
1 :l 1 #n d1 .l lsr, ( 10 delay )
d1 .l clr, ( 6 delay )
0 .b bra, ( 10 write again )
2 :l a0 ) jmp, ( 8 return to caller )
;c
frag <wbyte> to ( writes a byte of data to the disk )
( a3 = pointer to crctable )
( a4 = pointer to disk data register )
( d0 = the byte to be written with upper bits = 0 )
( d3 = contains the current crc value )
d0 a4 ) .b move, ( 8 write to disk controller )
8 #n d3 .w rol, ( 22 rotate crc )
d0 d3 .b eor, ( 4 xor to x8-x15 )
d3 d0 .b move, ( 4 copy low byte of crc )
ff #n d0 .w andi, ( 8 mask low byte )
1 #n d0 .w lsl, ( 8 multiply by 2 )
a3 d0 0 xw)d d0 .w move, ( 14 get xor data )
d0 d3 .w eor, ( 4 xor to crc )
a0 ) jmp, ( 8 return to caller )
;c ( 80 )
frag <rbyte> to ( writes a byte of data to the disk )
( a3 = pointer to crctable )
( a4 = pointer to disk data register )
( d3 = contains the current crc value )
a4 ) d0 .b move, ( 8 read to disk controller )
8 #n d3 .w ror, ( 22 rotate crc )
d0 d3 .b eor, ( 4 xor data to x15-x8 )
d3 d1 .b move, ( 4 copy low byte of crc )
1 #n d1 .w lsl, ( 8 multiply by 2 )
a3 d1 0 xw)d d1 .w move, ( 14 get xor data )
d1 d3 .w eor, ( 4 xor to crc )
a0 ) jmp, ( 8 return to caller )
;c
frag <wdata> to ( writes a data field onto the disk using the table )
( pointed to by a5 )
( a1 pointer to data )
( a2 return address )
( a3 pointer to crc table )
( a4 pointer to disk data register )
( a6 pointer to wbyte routine )
ramstart d0 .b move, ( sync to ram )
d0 .l clr, ( 6 number of ss bytes )
01 #n ga3 fd.cont + .b bset, ( 24 turn on write gate )
10 #n d0 .l moveq, ( 4 set # of syncs )
6 pc)d a0 .l lea, ( 8 get return address )
<wsync> jmp, ( 22 )
( 22 )
-1 #n d3 .l moveq, ( 4 clear crc )
22 #n d0 .l moveq, ( 4 set delay to 76 )
d0 d0 .l lsr, ( 76 delay )
03 #n d1 .w move, ( 8 loop three times )
begin, 3 #n d0 .l lsr, ( 14 delay )
A1 #n d0 .b move, ( 8 write a a1 )
4 pc)d a0 .l lea, ( 8 get return address )
a6 ) jmp, ( 16 write to controller )
( 72 )
6 #n d0 .l lsr, ( 20 delay )
a4 ) d0 .b move, ( 8 read to drop bit )
01 #n d1 .w subq, ( 4 decrement count )
eq until, ( 10 loop until done )
( 160 )
( 108 )
2 #n d0 .l lsr, ( 12 delay )
00 #n d0 .l moveq, ( 4 delay )
fb #n d0 .w move, ( 8 write data marker )
4 pc)d a0 .l lea, ( 8 get return address )
a6 ) jmp, ( 16 write byte )
( 160 )
( 72 )
0d #n d1 .l moveq, ( 4 set delay to 34 )
d1 d1 .l lsr, ( 34 delay )
00 #n d0 .l moveq, ( 4 delay )
200 #n d6 .w move, ( 8 number of bytes to write )
begin, d0 .l clr, ( 6 delay )
a1 )+ d0 .b move, ( 8 get data from ram )
4 pc)d a0 .l lea, ( 8 get return address )
a6 ) jmp, ( 16 )
( 72 )
00 #n d1 .l moveq, ( 4 delay )
0a #n d0 .l moveq, ( 4 set delay to 28 )
d0 d0 .l lsr, ( 28 delay )
01 #n d6 .w subq, ( 4 decrement count )
eq until, ( 10 loop until done )
( 160 )
( 120 )
02 #n d1 .l moveq, ( 4 loop twice )
begin, 8 #n d3 .w rol, ( 22 get byte )
d0 .l clr, ( 6 delay )
d3 a4 ) .b move, ( 8 write to disk controller )
2f #n d0 .l moveq, ( 4 delay 102 cycles )
d0 d0 .l lsr, ( 102 delay )
01 #n d1 .w subi, ( 8 decrement count )
eq until, ( 10 loop until done )
( 160 )
( 122 )
4 #n d0 .w move, ( 8 get gap length )
6 pc)d a0 .l lea, ( 8 get return address )
<wsync> jmp, ( 22 goto sync )
01 #n ga3 fd.cont + .b bclr, ( turn off write gate )
a2 ) jmp, ( return to caller )
;c
frag <wtrack> to ( writes one track of data to the disk. )
( a1 = pointer to data )
( a2 = return address )
( a3 = pointer to crctable )
( a4 = pointer to disk data register )
( a5 = pointer to format information )
( a6 = pointer to wbyte )
( d2 = starting address information )
( a0,a1,a5,d0,d1,d3,d4,d5,d6 are altered )
ramstart d0 .b move, ( sync to RAM )
2 #n d1 .w lsr, ( 10 sync to RAM )
a5 )+ d0 .w move, ( 8 get pre-index gap )
01 #n ga3 fd.cont + .b bset, ( 24 turn on write gate )
6 pc)d a0 .l lea, ( 8 get return address )
<wsync> jmp, ( 22 goto write sync routine )
( 22 )
1A #n d0 .l moveq, ( 4 set delay to 60 )
d0 d0 .l lsr, ( 60 delay )
03 #n d1 .w move, ( 8 loop 3 times )
begin, 13 #n d0 .l moveq, ( 4 set delay to 46 )
d0 d0 .l lsr, ( 46 delay )
C2 #n d0 .b move, ( 8 write a c2 )
d0 a4 ) .b move, ( 8 write to controller )
1e #n d0 .l moveq, ( 4 set delay to 68 )
d0 d0 .l lsr, ( 68 delay )
a4 ) d0 .b move, ( 8 read to drop bit )
01 #n d1 .w subq, ( 4 subtract from count )
eq until, ( 10 loop until done )
( 92 )
14 #n d0 .l moveq, ( 4 set delay to 48 )
d0 d0 .l lsr, ( 48 delay )
fc #n d0 .w move, ( 8 write a index mark )
d0 a4 ) .b move, ( 8 write to disk controller )
a5 )+ d5 .w move, ( 8 get number of sectors )
00 #n d1 .l moveq, ( 4 delay )
31 #n d0 .l moveq, ( 4 set delay to 106 )
d0 d0 .l lsr, ( 106 delay )
begin, a5 )+ d0 .w move, ( 8 get sync count )
6 pc)d a0 .l lea, ( 8 get return address )
<wsync> jmp, ( 22 )
( 22 )
-1 #n d3 .l moveq, ( 4 clear crc )
24 #n d0 .l moveq, ( 4 set delay to 80 )
d0 d0 .l lsr, ( 80 delay )
03 #n d1 .l moveq, ( 4 loop three times )
begin, 1 #n d0 .l lsr, ( 10 delay )
00 #n d0 .l moveq, ( 4 delay )
A1 #n d0 .b move, ( 8 write a a1 )
4 pc)d a0 .l lea, ( 8 get return address )
a6 ) jmp, ( 16 write to controller )
( 72 )
6 #n d0 .l lsr, ( 20 delay )
a4 ) d0 .b move, ( 8 read to drop bit )
01 #n d1 .w subq, ( 4 decrement count )
eq until, ( 10 loop until done )
( 112 )
00 #n d0 .l moveq, ( 4 delay )
02 #n d1 .l lsr, ( 12 delay )
fe #n d0 .w move, ( 8 write address mark )
4 pc)d a0 .l lea, ( 8 get return address )
a6 ) jmp, ( 16 )
( 72 )
00 #n d0 .w move, ( 8 delay )
a5 )+ d4 .l move, ( 12 get address offset info )
d2 d4 .l add, ( 8 add start info and offset )
04 #n d6 .l moveq, ( 4 loop 4 times )
begin, 8 #n d4 .l rol, ( 24 get high byte )
00 #n d0 .l moveq, ( 4 delay )
d4 d0 .b move, ( 4 copy byte )
4 pc)d a0 .l lea, ( 8 get return address )
a6 ) jmp, ( 16 )
( 72 )
01 #n d0 .l lsr, ( 10 delay )
00 #n d0 .l moveq, ( 4 delay )
00 #n d1 .l moveq, ( 4 delay )
01 #n d6 .w subq, ( 4 decrement count )
eq until, ( 10 loop until done )
( 102 )
02 #n d1 .l moveq, ( 4 loop twice )
begin, 00 #n d0 .l moveq, ( 4 delay )
6 #n d0 .l lsr, ( 20 delay )
8 #n d3 .w rol, ( 22 get high byte of crc )
d3 a4 ) .b move, ( 8 write to disk controller )
28 #n d0 .l moveq, ( 4 set delay to 88 )
d0 d0 .l lsr, ( 88 delay )
01 #n d1 .w subq, ( 4 decrement count )
eq until, ( 10 loop until done )
( 104 )
5 #n d0 .l lsr, ( 18 delay )
a5 )+ d0 .w move, ( 8 get gap length )
6 pc)d a0 .l lea, ( 8 get return address )
<wsync> jmp, ( 22 )
( 22 )
-1 #n d3 .l moveq, ( 4 clear crc )
24 #n d0 .l moveq, ( 4 set delay to 80 )
d0 d0 .l lsr, ( 80 delay )
03 #n d1 .l moveq, ( 8 loop three times )
begin, 3 #n d0 .l lsr, ( 14 delay )
A1 #n d0 .b move, ( 8 write a a1 )
4 pc)d a0 .l lea, ( 8 get return address )
a6 ) jmp, ( 16 write to controller )
( 72 )
6 #n d0 .l lsr, ( 20 delay )
a4 ) d0 .b move, ( 8 read to drop bit )
01 #n d1 .w subq, ( 4 decrement count )
eq until, ( 10 loop until done )
( 108 )
2 #n d0 .l lsr, ( 12 delay )
00 #n d0 .l moveq, ( 4 delay )
fb #n d0 .w move, ( 8 write data marker )
4 pc)d a0 .l lea, ( 8 get return address )
a6 ) jmp, ( 16 write byte )
( 72 )
03 #n d1 .l moveq, ( 4 set delay to 14 )
d1 d1 .l lsr, ( 14 delay )
a5 )+ d0 .l move, ( 12 get source offset )
d0 a1 .l add, ( 8 add offset to pointer )
200 #n d6 .w move, ( 8 write 512 bytes )
00 #n d0 .l moveq, ( 4 delay )
begin, d0 .l clr, ( 6 delay )
a1 )+ d0 .b move, ( 8 get data from ram )
4 pc)d a0 .l lea, ( 8 get return address )
a6 ) jmp, ( 16 )
( 72 )
00 #n d0 .w move, ( 8 delay )
00 #n d1 .w move, ( 8 delay )
6 #n d0 .l lsr, ( 20 delay )
01 #n d6 .w subq, ( 4 decrement count )
eq until, ( 10 loop until done )
( 120 )
00 #n d1 .l moveq, ( 4 delay )
8 #n d3 .w rol, ( 22 get byte )
d0 .l clr, ( 6 delay )
d3 a4 ) .b move, ( 8 write to disk controller )
38 #n d0 .l moveq, ( 5 delay 120 cycles )
d0 d0 .l lsr, ( 120 delay )
8 #n d3 .w rol, ( 22 get byte )
d0 .l clr, ( 6 delay )
d3 a4 ) .b move, ( 8 write to disk controller )
30 #n d0 .l moveq, ( 4 set delay to 104 )
d0 d0 .l lsr, ( 104 delay )
01 #n d5 .w subq, ( 4 decrement count )
eq until, ( 10 loop until done )
( 38 return for next sector )
( 122 )
a5 )+ d0 .w move, ( 8 get gap length )
6 pc)d a0 .l lea, ( 8 get return address )
<wsync> jmp, ( 22 goto sync )
( 22 )
01 #n ga3 fd.cont + .b bclr, ( turn off write gate )
a2 ) jmp, ( return to caller )
;c
frag <rheader> to
( d2 returns with the address info or -1 if not found )
( a6 = address of rbyte )
( a5 = address of disk status register )
( a4 = disk data register address )
( a3 = CRC table address )
( a2 = return address )
( d0,d1,d2,d3,d4,d5,a2,a3,a4 used )
4 #n d5 .l move, ( try at least 5 sectors worth )
begin, 00 #n ga3 fd.cont + .b bclr, a4 ) d0 .b move, 00 #n d0 .l moveq,
1800 #n d1 .w move, ( try for a sectors worth )
begin, 06 #n a5 ) .b btst, d1 ne
-until, 0 eq .b bra, a4 ) d0 .b move, 04 #n d4 .l moveq,
begin, B230 #n d3 .w move, 2c #n d1 .l moveq,
begin, a5 ) d0 .b move, d1 mi
-until, 0 pl .b bra, a4 ) d0 .b move, fe #n d0 .b cmpi, d4 eq
-until, 0 ne .b bra, 03 #n d2 moveq,
begin, 2c #n d1 .l moveq, 8 #n d0 lsl,
begin, a5 ) d0 .b move, d1 mi
-until, 0 pl .b bra, 4 pc)d a0 .l lea, a6 ) jmp, d2 nt
-until, d0 d2 move, 2c #n d1 .l moveq,
begin, a5 ) d0 .b move, d1 mi
-until, 0 pl .b bra, a4 ) d0 .b move, 8 #n d0 .w lsl, 2c #n d1 .l moveq,
begin, a5 ) d0 .b move, d1 mi
-until, 0 pl .b bra, a4 ) d0 .b move, d0 d3 .w cmp, eq
if, a2 ) jmp,
then, -2 #n d2 moveq, a2 ) jmp, ( set crc error and exit )
0 :l d5 nt
-until, -4 #n d2 moveq, a2 ) jmp, ( set no headers foune and exit )
;c
( MT 4/14/87 )
frag <rdata> to
( d2 = -1 if invalid crc or data field not found )
( d3 = low word is crc read. high word is crc calculated )
( a6 = address of rbyte )
( a5 = address of disk status register )
( a4 = disk data register address )
( a3 = CRC table address )
( a2 = return address )
( a1 = buffer address )
( d0,d1,d2,d3,d4,d5,a1,a2,a3,a4 used )
30 #n d5 .l moveq,
begin, 00 #n ga3 fd.cont + .b bclr, a4 ) d0 .b move, 00 #n d0 moveq,
200 #n d1 .w move,
begin, 06 #n a5 ) .b btst, d1 ne
-until, 1 eq .b bra, a4 ) d0 .b move, 04 #n d4 .l moveq,
begin, E295 #n d3 .w move, 1ff #n d2 .w move, 28 #n d1 .l moveq,
begin, a5 ) d0 .b move, d1 mi
-until, 1 pl .b bra, a4 ) d0 .b move, fb #n d0 .b cmpi, d4 eq
-until, 0 ne .b bra, 17 #n d1 .l moveq,
begin,
begin, a5 ) d0 .b move, d1 mi
-until, 1 pl .b bra, a4 ) d0 .b move, 8 #n d3 .w ror,
d0 d3 .b eor, d3 d1 .b move, 1 #n d1 .w lsl,
a3 d1 0 xw)d d1 .w move, d1 d3 .w eor,
13 #n d1 .l moveq, d0 a1 )+ .b move, d2 nt
-until,
begin, a5 ) d0 .b move, d1 mi
-until, 1 pl .b bra,
a4 ) d0 .b move, 8 #n d0 .w lsl, 16 #n d1 .l moveq,
begin, a5 ) d0 .b move, d1 mi
-until, 1 pl .b bra,
a4 ) d0 .b move, d0 d3 .w cmp, eq
if, 00 #n d2 .l moveq,
else, -7 #n d2 .l moveq, ( Set Data Field CRC error )
then, a2 ) jmp,
0 :l d5 nt
-until,
1 :l -6 #n d2 moveq, a2 ) jmp,
;c
( MT 4/14/87 )
frag <vdata> to
( d2 = -1 if invalid crc or data field not found )
( d3 = low word is crc read. high word is crc calculated )
( a6 = address of rbyte )
( a5 = address of disk status register )
( a4 = disk data register address )
( a3 = CRC table address )
( a2 = return address )
( a1 = buffer address )
( d0,d1,d2,d3,d4,d5,a1,a2,a3,a4 used )
30 #n d5 .l moveq,
begin, 01 #n ga3 fd.cont + .b bclr, a4 ) d0 .b move, 00 #n d0 moveq,
200 #n d1 .w move,
begin, 06 #n a5 ) .b btst, d1 ne
-until, 1 eq .b bra, a4 ) d0 .b move, 04 #n d4 .l moveq,
begin, E295 #n d3 .w move, 1ff #n d2 .w move, 28 #n d1 .l moveq,
begin, a5 ) d0 .b move, d1 mi
-until, 1 pl .b bra, a4 ) d0 .b move, fb #n d0 .b cmpi, d4 eq
-until, 0 ne .b bra, 17 #n d1 .l moveq,
begin,
begin, a5 ) d0 .b move, d1 mi
-until, 1 pl .b bra, a4 ) d0 .b move, 8 #n d3 .w ror,
d0 d3 .b eor, d3 d1 .b move, 1 #n d1 .w lsl,
a3 d1 0 xw)d d1 .w move, d1 d3 .w eor,
13 #n d1 .l moveq, a1 )+ d0 .b sub, d2 ne
-until, ( 2 ne .b bra, ''' don't give special message, just chksum err )
begin, a5 ) d0 .b move, d1 mi
-until, 1 pl .b bra,
a4 ) d0 .b move, 8 #n d0 .w lsl, 16 #n d1 .l moveq,
begin, a5 ) d0 .b move, d1 mi
-until, 1 pl .b bra,
a4 ) d0 .b move, d0 d3 .w cmp, eq
if, 00 #n d2 .l moveq,
else, -7 #n d2 .l moveq,
then, a2 ) jmp,
0 :l d5 nt
-until,
1 :l -6 #n d2 moveq, a2 ) jmp,
2 :l -8 #n d2 moveq, a2 ) jmp,
;c
8000 herelt
( This is the 'high level' part of the disk code. It can be located anywhere)
frag iai-trk to
( pre-index gap ) 0200 w,
( number of sectors ) 000a w,
( pre-address field gap ) 0030 w,
( address info offset ) 0000 ,
( pre-data field gap ) 0020 w,
( source address offset ) 0000 ,
( pre-address field gap ) 0030 w,
( address info offset ) 0100 ,
( pre-data field gap ) 0020 w,
( source address offset ) 0000 ,
( pre-address field gap ) 0030 w,
( address info offset ) 0200 ,
( pre-data field gap ) 0020 w,
( source address offset ) 0000 ,
( pre-address field gap ) 0030 w,
( address info offset ) 0300 ,
( pre-data field gap ) 0020 w,
( source address offset ) 0000 ,
( pre-address field gap ) 0030 w,
( address info offset ) 0400 ,
( pre-data field gap ) 0020 w,
( source address offset ) 0000 ,
( pre-address field gap ) 0030 w,
( address info offset ) 0500 ,
( pre-data field gap ) 0020 w,
( source address offset ) 0000 ,
( pre-address field gap ) 0030 w,
( address info offset ) 0600 ,
( pre-data field gap ) 0020 w,
( source address offset ) 0000 ,
( pre-address field gap ) 0030 w,
( address info offset ) 0700 ,
( pre-data field gap ) 0020 w,
( source address offset ) 0000 ,
( pre-address field gap ) 0030 w,
( address info offset ) 0800 ,
( pre-data field gap ) 0020 w,
( source address offset ) 0000 ,
( pre-address field gap ) 0030 w,
( address info offset ) 0900 ,
( pre-data field gap ) 0020 w,
( source address offset ) 0000 ,
( post data field gap ) 0002 w, ;c
( This is the track formating data that puts the same data into every sector of
a track and makes all sectors the save sector number )
frag id-trk to
( pre-index gap ) 0200 w,
( number of sectors ) 000a w,
( pre-address field gap ) 0030 w,
( address info offset ) 0000 ,
( pre-data field gap ) 0020 w,
( source address offset ) 0000 ,
( pre-address field gap ) 0030 w,
( address info offset ) 0000 ,
( pre-data field gap ) 0020 w,
( source address offset ) -200 ,
( pre-address field gap ) 0030 w,
( address info offset ) 0000 ,
( pre-data field gap ) 0020 w,
( source address offset ) -200 ,
( pre-address field gap ) 0030 w,
( address info offset ) 0000 ,
( pre-data field gap ) 0020 w,
( source address offset ) -200 ,
( pre-address field gap ) 0030 w,
( address info offset ) 0000 ,
( pre-data field gap ) 0020 w,
( source address offset ) -200 ,
( pre-address field gap ) 0030 w,
( address info offset ) 0000 ,
( pre-data field gap ) 0020 w,
( source address offset ) -200 ,
( pre-address field gap ) 0030 w,
( address info offset ) 0000 ,
( pre-data field gap ) 0020 w,
( source address offset ) -200 ,
( pre-address field gap ) 0030 w,
( address info offset ) 0000 ,
( pre-data field gap ) 0020 w,
( source address offset ) -200 ,
( pre-address field gap ) 0030 w,
( address info offset ) 0000 ,
( pre-data field gap ) 0020 w,
( source address offset ) -200 ,
( pre-address field gap ) 0030 w,
( address info offset ) 0000 ,
( pre-data field gap ) 0020 w,
( source address offset ) -200 ,
( post data field gap ) 0002 w, ;c
frag crctable to
0 w, 1020 w, 2040 w, 3060 w, 4080 w, 50A0 w, 60C0 w, 70E0 w,
8100 w, 9120 w, A140 w, B160 w, C180 w, D1A0 w, E1C0 w, F1E0 w,
1221 w, 201 w, 3261 w, 2241 w, 52A1 w, 4281 w, 72E1 w, 62C1 w,
9321 w, 8301 w, B361 w, A341 w, D3A1 w, C381 w, F3E1 w, E3C1 w,
2442 w, 3462 w, 402 w, 1422 w, 64C2 w, 74E2 w, 4482 w, 54A2 w,
A542 w, B562 w, 8502 w, 9522 w, E5C2 w, F5E2 w, C582 w, D5A2 w,
3663 w, 2643 w, 1623 w, 603 w, 76E3 w, 66C3 w, 56A3 w, 4683 w,
B763 w, A743 w, 9723 w, 8703 w, F7E3 w, E7C3 w, D7A3 w, C783 w,
4884 w, 58A4 w, 68C4 w, 78E4 w, 804 w, 1824 w, 2844 w, 3864 w,
C984 w, D9A4 w, E9C4 w, F9E4 w, 8904 w, 9924 w, A944 w, B964 w,
5AA5 w, 4A85 w, 7AE5 w, 6AC5 w, 1A25 w, A05 w, 3A65 w, 2A45 w,
DBA5 w, CB85 w, FBE5 w, EBC5 w, 9B25 w, 8B05 w, BB65 w, AB45 w,
6CC6 w, 7CE6 w, 4C86 w, 5CA6 w, 2C46 w, 3C66 w, C06 w, 1C26 w,
EDC6 w, FDE6 w, CD86 w, DDA6 w, AD46 w, BD66 w, 8D06 w, 9D26 w,
7EE7 w, 6EC7 w, 5EA7 w, 4E87 w, 3E67 w, 2E47 w, 1E27 w, E07 w,
FFE7 w, EFC7 w, DFA7 w, CF87 w, BF67 w, AF47 w, 9F27 w, 8F07 w,
9108 w, 8128 w, B148 w, A168 w, D188 w, C1A8 w, F1C8 w, E1E8 w,
1008 w, 28 w, 3048 w, 2068 w, 5088 w, 40A8 w, 70C8 w, 60E8 w,
8329 w, 9309 w, A369 w, B349 w, C3A9 w, D389 w, E3E9 w, F3C9 w,
229 w, 1209 w, 2269 w, 3249 w, 42A9 w, 5289 w, 62E9 w, 72C9 w,
B54A w, A56A w, 950A w, 852A w, F5CA w, E5EA w, D58A w, C5AA w,
344A w, 246A w, 140A w, 42A w, 74CA w, 64EA w, 548A w, 44AA w,
A76B w, B74B w, 872B w, 970B w, E7EB w, F7CB w, C7AB w, D78B w,
266B w, 364B w, 62B w, 160B w, 66EB w, 76CB w, 46AB w, 568B w,
D98C w, C9AC w, F9CC w, E9EC w, 990C w, 892C w, B94C w, A96C w,
588C w, 48AC w, 78CC w, 68EC w, 180C w, 82C w, 384C w, 286C w,
CBAD w, DB8D w, EBED w, FBCD w, 8B2D w, 9B0D w, AB6D w, BB4D w,
4AAD w, 5A8D w, 6AED w, 7ACD w, A2D w, 1A0D w, 2A6D w, 3A4D w,
FDCE w, EDEE w, DD8E w, CDAE w, BD4E w, AD6E w, 9D0E w, 8D2E w,
7CCE w, 6CEE w, 5C8E w, 4CAE w, 3C4E w, 2C6E w, 1C0E w, C2E w,
EFEF w, FFCF w, CFAF w, DF8F w, AF6F w, BF4F w, 8F2F w, 9F0F w,
6EEF w, 7ECF w, 4EAF w, 5E8F w, 2E6F w, 3E4F w, E2F w, 1E0F w,
;c
( 6/29 Changed to new disk map )
( Leap from this Document to the next Document Break to select the moved items)
frag .<step> to
05 #n ga3 fd.cont + .b bset, ( do the step )
05 #n ga3 fd.cont + .b bclr,
ACB #n .scratch 54 + move, ( Delay 21us )
begin, 1 #n .scratch 54 + subq, eq ( Decrement count )
until, 3 #n ga3 fd.cont + .b btst, ne
if, 1 #n .scratch 50 + addq, ( Increment current track number )
else, 1 #n .scratch 50 + subq, ( Decrement current track number )
then, a0 ) jmp, ( Return to caller )
frag .<seek> to
( Seeks to track specified in d0 )
.scratch 50 + d0 sub, mi ( How many tracks to step )
if, d0 neg, 3 #n ga3 fd.cont + .b bclr, ( Step out )
else, 3 #n ga3 fd.cont + .b bset, ( Step in )
then,
begin,
02 #n ga3 fd.status + .b btst, ne ( If eq then ok )
if, -1 #n d0 moveq, 0 bra,
then,
d0 tst, ne
while,
05 #n ga3 fd.cont + .b bset, ( do the step )
05 #n ga3 fd.cont + .b bclr,
315 #n .scratch 54 + move, ( Delay 6ms )
begin, 1 #n .scratch 54 + subq, eq ( Decrement count )
until, 3 #n ga3 fd.cont + .b btst, ne
if, 1 #n .scratch 50 + addq, ( Increment current track number )
else, 1 #n .scratch 50 + subq, ( Decrement current track number )
then, 1 #n d0 subq,
again,
0 :l a1 ) jmp,
frag ~wimage to
(regs d2 d3 d4 d5 d6 a1 a2 a3 a4 a5 a6 to) .scratch movem,
d1 .scratch 40 + move, ne ( save side number )
if,
03010002 #n d2 move,
04 #n ga3 fd.cont + .b bset, ( set to side 1 )
else,
03000002 #n d2 move,
04 #n ga3 fd.cont + .b bclr, ( set to side 0 )
then,
d2 .scratch 48 + move, ( save address info )
d0 .scratch 44 + .w move, ( save the number of tracks to write )
a0 a1 move, ( copy pointer to image )
crctable #n a3 move, ga3 fd.dwr + #n a4 move, <wbyte> #n a6 move,
begin,
.scratch 48 + d2 move,
iai-trk #n a5 move,
i' system.status a2 move, ( get the system status area )
a2 ga2opr )d d0 .b move, ( get the current opr value )
8 #n d0 .b or, d0 opr .b move, ( and reset the watchdog timer )
<wtrack> jmp2, ( write track )
1000000 #n .scratch 48 + add, ( next track number )
1 #n .scratch 44 + .w sub, ne ( subtract from count )
while, 1f4 #n d0 .w move, ( Set delay to 1 ms )
begin, d0 nt -until, ( Delay loop )
02 #n ga3 fd.status + .b btst, ne ( If eq then ok )
if, -1 #n d0 moveq, 0 bra,
then,
03 #n ga3 fd.cont + .b bset,
.<step> jmp0,
again,
d0 clr, ( no errors on write for now )
0 :l -1 #n d1 moveq, ( Returning from ~wimage )
(regs d2 d3 d4 d5 d6 a1 a2 a3 a4 a5 a6 from) .scratch movem,
a1 ) jmp, ( return to calling routine )
;c
frag ~rimage to
(regs d2 d3 d4 d5 d6 d7 a1 a2 a3 a4 a5 a6 to) .scratch movem,
d1 .scratch 40 + move, ne ( save side number )
if,
.s/r ramstart - 200 / 9 + 1+ a / 3 +
18 shl 10002 + ( calculate where to start reading )
#n d2 move, ( 9 assumes we read starting at trk 9)
04 #n ga3 fd.cont + .b bset, ( set to side 1 )
else,
.s/r ramstart - 200 / 9 + 1+ a / 3 +
18 shl 00002 + ( calculate where to start reading )
#n d2 move, ( 9 means i/o starts at track 9 )
04 #n ga3 fd.cont + .b bclr, ( set to side 0 )
then,
d2 .scratch 48 + move, ( save address info )
d0 .scratch 44 + .w move, ( save the number of tracks to write )
a0 .scratch 4C + move, ( save pointer )
crctable #n a3 move, ga3 fd.drd + #n a4 move,
ga3 fd.status + #n a5 move,
<rbyte> #n a6 move,
i' system.status a2 move, ( get system.status )
a2 ga2opr )d d7 .b move, ( get old copy of opr )
8 #n d7 .b or, d7 opr .b move, ( reset watchdog timer )
d7 screenend 1- .b move, ( and save it off somewhere )
begin, 0a #n .scratch 46 + .w move, ( set sector count )
begin, 00040000 #n d7 move, ( Set data retry to 4 )
1 :l FFFF0000 #n d7 andi, ( Header retry to 20 )
20 #n d7 .w move,
begin,
screenend 1- opr .b move, ( reset watchdog timer )
<rheader> jmp2, d2 tst, mi
if, <rheader> jmp2, d2 tst, mi
if, d2 d0 move, 0 bra,
then,
then, .scratch 48 + d2 cmp, d7 eq
-until, ne
if, -9 #n d0 move, 0 bra,
then, .scratch 4c + a1 move, ( get pointer into RAM )
<rdata> jmp2, d2 d0 move, ne
if, d7 swap,
1 #n d7 .w subq, 0 eq bra,
d7 swap, 1 bra,
then,
00000100 #n .scratch 48 + add, ( next sector number )
200 #n .scratch 4c + add, ( update RAM pointer )
1 #n .scratch 46 + .w sub, eq ( subtract from sector count )
until, 01000000 #n .scratch 48 + add, ffff00ff #n .scratch 48 + andi,
1 #n .scratch 44 + .w sub, ne ( subtract from track count )
while,
screenend 1- opr .b move, ( reset watchdog timer )
03 #n ga3 fd.cont + .b bset,
.<step> jmp0,
again,
d0 clr, ( no errors on write for now )
0 :l 0 #n d1 moveq, ( Returning from ~rimage )
(regs d2 d3 d4 d5 d6 d7 a1 a2 a3 a4 a5 a6 from) .scratch movem,
a1 ) jmp, ( return to calling routine )
;c
frag ~vimage to
( On entry d1 holds the side number )
( d0 holds the number of tracks to verify )
( a0 holds the starting address )
(regs d2 d3 d4 d5 d6 d7 a1 a2 a3 a4 a5 a6 to) .scratch movem,
d1 .scratch 40 + move, ne ( save side number )
if,
.s/r ramstart - 200 / 9 + 1+ a / 3 +
18 shl 10002 + ( calculate where to start reading )
#n d2 move, ( 9 assumes we read starting at trk 9)
04 #n ga3 fd.cont + .b bset, ( set to side 1 )
else,
.s/r ramstart - 200 / 9 + 1+ a / 3 +
18 shl 00002 + ( calculate where to start reading )
#n d2 move, ( 9 means i/o starts at track 9 )
04 #n ga3 fd.cont + .b bclr, ( set to side 0 )
then,
d2 .scratch 48 + move, ( save address info )
d0 .scratch 44 + .w move, ( save the number of tracks to write )
a0 .scratch 4C + move, ( save pointer )
crctable #n a3 move, ga3 fd.drd + #n a4 move,
ga3 fd.status + #n a5 move,
<rbyte> #n a6 move,
i' system.status a2 move, ( get system.status )
a2 ga2opr )d d7 .b move, ( get old copy of opr )
8 #n d7 .b or, d7 opr .b move, ( reset watchdog timer )
d7 screenend 1- .b move, ( and save it off somewhere )
begin, 0a #n .scratch 46 + .w move, ( set sector count )
begin, 00040000 #n d7 move, ( Set data retry to 4 )
1 :l ffff0000 #n d7 andi, 20 #n d7 .w move,
begin,
screenend 1- opr .b move, ( reset watchdog timer )
<rheader> jmp2, d2 tst, mi
if, <rheader> jmp2, d2 tst, mi
if, d2 d0 move, 0 bra,
then,
then, .scratch 48 + d2 cmp, d7 eq
-until, ne
if, -9 #n d0 move, 0 bra,
then, .scratch 4c + a1 move, ( get pointer into RAM )
<vdata> jmp2, d2 d0 move, ne
if, -8 #n d2 cmp, 0 eq bra,
d7 swap,
1 #n d7 .w subq, 0 eq bra,
d7 swap, 1 bra,
then, 00000100 #n .scratch 48 + add, ( next sector number )
200 #n .scratch 4c + add, ( update RAM pointer )
1 #n .scratch 46 + .w sub, eq ( subtract from sector count )
until, 01000000 #n .scratch 48 + add, ffff00ff #n .scratch 48 + andi,
1 #n .scratch 44 + .w sub, ne ( subtract from track count )
while,
screenend 1- opr .b move, ( reset watchdog timer )
03 #n ga3 fd.cont + .b bset,
.<step> jmp0,
again,
d0 clr, ( no errors on write for now )
0 :l
(regs d2 d3 d4 d5 d6 d7 a1 a2 a3 a4 a5 a6 from) .scratch movem,
a1 ) jmp, ( return to calling routine )
;c
frag ~writeid to ( a1=address, a0=return address, d2=track info )
a0 d7 move, ( hold onto return address )
crctable #n a3 move,
ga3 fd.dwr + #n a4 move,
id-trk #n a5 move, ( write id's where all sectors are the same )
<wbyte> #n a6 move,
<wtrack> jmp2,
1f4 #n d0 .w move, ( wait 1 ms after writing )
begin, d0 nt -until,
d7 a0 move, a0 ) jmp, ;c ( and return )
frag .<save> to ( save subroutine address )
sr .s/r 64 + .w move, ( save 68008 status register)
(regs a0 a1 a2 a3 a4 a5 a6 a7 to) .s/r 00 + movem,
(regs d0 d1 d2 d3 d4 d5 d6 d7 to) .s/r 20 + movem,
( .s/r 66 + is set by high level forth to the Swift disk type)
( .s/r 6a + to .s/r 7f + is reserved for future Swift hardware stuff!)
i' t#on d0 move, ( Get the current track number )
d0 .scratch 50 + move, ( Save in scratch area )
0700 #n sr .w ori, ( interrupts off )
i' system.status a1 move, ( get the base of system status area )
a1 ga2opr )d d0 .b move, ( get old opr )
8 #n d0 .b or, d0 opr .b move, ( reset the watchdog timer )
02 #n ga3 fd.status + .b btst, ne ( If eq then ok )
if, -1 #n d0 moveq, 0 bra, then,
2904 #n d1 .w move, ( wait another 15 ms )
begin, d1 nt -until,
.s/r #n a1 move, ( write on first track )
i' side# tst, ne ( select side )
if, 00010102 #n d2 move,
else, 00000102 #n d2 move,
then,
~writeid jmp0,
i' system.status a1 move, ( get the base of system status area )
a1 ga2opr )d d0 .b move, ( get old opr )
8 #n d0 .b or, d0 opr .b move, ( reset the watchdog timer )
02 #n ga3 fd.status + .b btst, ne ( If eq then ok )
if, -1 #n d0 moveq, 0 bra, then,
( Write the last $C00 bytes onto track 1 )
i' trkbuf a0 move, svram trkbuflen 2* + #n a1 move, C00 4 / 1- #n d1 .w move,
begin, a1 0 )d d0 movep, d0 a0 )+ move, 8 #n a1 addq, d1 nt -until,
03 #n ga3 fd.cont + .b bset,
.<step> jmp0, ( Step to next track )
i' side# tst, ne ( select side )
if, 01010002 #n d2 move,
else, 01000002 #n d2 move,
then, i' trkbuf a1 move,
crctable #n a3 move,
ga3 fd.dwr + #n a4 move, iai-trk #n a5 move, <wbyte> #n a6 move,
<wtrack> jmp2,
i' system.status a1 move, ( get the base of system status area )
a1 ga2opr )d d0 .b move, ( get old opr )
8 #n d0 .b or, d0 opr .b move, ( reset the watchdog timer )
( Write $1400 bytes onto track 2 )
i' trkbuf a0 move, svram #n a1 move, trkbuflen 4 / 1- #n d1 .w move,
begin, a1 0 )d d0 movep, d0 a0 )+ move, 8 #n a1 addq, d1 nt -until,
02 #n ga3 fd.status + .b btst, ne ( If eq then ok )
if, -1 #n d0 moveq, 0 bra, then,
.<step> jmp0,
i' side# tst, ne ( select side )
if,
02010002 #n d2 move,
else,
02000002 #n d2 move,
then, i' trkbuf a1 move,
crctable #n a3 move,
ga3 fd.dwr + #n a4 move, iai-trk #n a5 move, <wbyte> #n a6 move,
<wtrack> jmp2,
1f4 #n d0 .w move, ( Set delay to 1 ms )
begin, d0 nt -until, ( Delay loop )
02 #n ga3 fd.status + .b btst, ne ( If eq then ok )
if, -1 #n d0 moveq, 0 bra, then,
03 #n ga3 fd.cont + .b bset,
.<step> jmp0,
( load registers for the disk routines)
ramstart #n a0 move, ( starting ram address)
.s/r 68 + d0 .w move, ( number of tracks)
i' side# d1 move, ( side number)
~wimage jmp1, ( write the image out )
d0 tst, 0 ne bra, ( Exit if error )
d1 tst, 0 eq bra, ( Don't verify after a ~rimage )
i' Forth? tst, 0 ne bra, ( if Forth is enabled, don't verify )
i' system.status a0 move,
a0 svspare )d .b tst, 0 ne bra, ( if svForth is enabled, don't verify )
screenend 200 + 13FF + ramstart - 1400 / 3 + #n d0 move,
.<seek> jmp1,
d0 tst, 0 ne bra,
screenend 200 + #n a0 move, ( Starting address )
.s/r 68 + d0 .w move, ( Get number of tracks to verify )
screenend 200 + 13FF + ramstart - 1400 / #n d0 .w sub,
( Subtract screen tracks )
i' side# d1 move, ( Get side number )
~vimage jmp1, ( Verify the image )
0 :l d0 .scratch 58 + move, ( Save error status )
( f8ff #n sr .w andi, ( interrupts on )
( restore the registers to return ok from a save operation)
(regs a0 a1 a2 a3 a4 a5 a6 a7 from) .s/r 00 + movem,
(regs d0 d1 d2 d3 d4 d5 d6 d7 from) .s/r 20 + movem,
.s/r 64 + sr .w move, ( restore status register)
rts, ( returns to the call word in save. Restore does too)
;c ( end code fragment)
frag .<restore> to ( restore subroutine )
2700 #n sr .w move, ( no interrupts allowed)
.restart clr, ( reset the auto-getforward flag)
( copy just in case we restart )
i' system.status a0 move,
a0 .scratch 7C + move,
.scratch 80 + #n a1 move,
system.status.len 1- #n d0 move,
begin, a0 )+ a1 )+ .b move, d0 nt -until,
i' t#on .scratch 50 + move, ( Copy current track # )
.s/r 200 + #n a0 move, ( starting ram address)
.s/r 68 + d0 .w move, ( number of tracks )
i' side# d1 move, ( which disk side )
~rimage jmp1,
d0 .scratch 58 + move, ( store the error flag, and tests )
ne if, magic#2 #n .restart move,
here 2+ restart.err to 12345678 jmp,
then, ( Restart if error in restoring. This will be patched later )
;s
ne if, magic#2 #n .restart move, reset, then,
( system is hosed, go back around and try to getforward next time )
a1 )+ a0 ) .b move, 10 #n a0 add, ( not while debugging)
(regs a0 a1 a2 a3 a4 a5 a6 a7 from) .s/r 00 + movem,
(regs d0 d1 d2 d3 d4 d5 d6 d7 from) .s/r 20 + movem,
.scratch 7c + i' system.status move, ( restore proper value to system.status)
.s/r 64 + sr .w move, ( restore saved status register value)
rts, ( the stack is now the same as when save was executed so this rts will
return to the call word in save and exit from there)
;c ( end code fragment)
code blit
ip )+ d0 .b move, d0 .w ext, d0 .l ext, d0 sp -) move, next;
code wlit
0 #n d0 moveq, ip )+ d1 .b move,
ip )+ d0 .b move, d0 sp -) move, d1 sp 2 )d .b move, next;
code lit
4 #n sp subq, ip )+ sp ) .b move, ip )+ sp 1 )d .b move,
ip )+ sp 2 )d .b move, ip )+ sp 3 )d .b move, next;
code <do>
ip rp -) move, sp )+ d0 move, ( start)
sp )+ d1 move, ( limit ) d1 rp -) move, ( limit>>R)
d1 d0 sub, d0 rp -) move, ( start-limit) next;
code <loop>
1 #n rp ) addi, eq if, 6 #n rp addq, 6 #n rp addq, next, then,
rp 8 )d ip move, next;
code <+loop>
sp )+ d0 move, mi
if, d0 rp ) add, cs if, rp 8 )d ip move, next, then,
6 #n rp addq, 6 #n rp addq, next,
then, d0 rp ) add, cs if, 6 #n rp addq, 6 #n rp addq, next, then,
rp 8 )d ip move, next;
code <;>
<code> <exit>
rp )+ ct .w move, ( restore token pointer)
rp )+ a0 .w move, ( restore delta ip)
ct a1 move, ( pointer to begining address of the word)
a1 ) sa move, ( the actual begining address of the word)
a0 sa 0 xl)d ip lea, ( add them & put into ip)
next;
code <;lp>
<code> <exitlp>
0 #n d0 moveq, ip )+ d0 .b move, d0 rp add,
rp )+ ct .w move, rp )+ a0 .w move, ct a1 move,
a1 ) sa move, a0 sa 0 xl)d ip lea,
next;
code <">
0 #n d0 moveq, ip )+ d0 .b move,
ip sp -) move, d0 ip add, d0 sp -) move, next;
code <local>
0 #n iv moveq, ip )+ iv .b move, rp iv add,
iv a0 move, a0 ) sp -) move, next;
code <locals>
0 #n d0 moveq, ip )+ d0 .b move, d0 rp sub, next;
code <loc0>
rp iv move, rp ) sp -) move, next;
code <loc1>
rp 4 )d a0 lea, a0 ) sp -) move, a0 iv move, next;
code <bran>
ip ) d0 .b move, d0 .w ext, d0 .l ext, d0 ip add, next;
code <0bran>
sp )+ tst, eq if, ip ) d0 .b move, d0 .w ext, d0 .l ext, d0 ip add, next,
then, 1 #n ip addq, next;
code <branl>
ip )+ d0 .b move, 8 #n d0 .w lsl, ip )+ d0 .b move, d0 .l ext, d0 ip add,
next;
code <0branl>
sp )+ d0 move, ne if, 2 #n ip addq, next, then,
ip )+ d0 .b move, 8 #n d0 .w lsl, ip ) d0 .b move, d0 .l ext, d0 ip add, next;
code <leave>
0 #n d0 moveq, ip ) d0 .b move, d0 ip add, 6 #n rp addq, 6 #n rp addq, next;
code <0leave>
sp )+ d0 move, eq if, ip ) d0 .b move, d0 ip add,
6 #n rp addq, 6 #n rp addq, next,
then, 1 #n ip addq, next;
code <leavel>
0 #n d0 moveq, ip )+ d0 .b move, 8 #n d0 .w lsl,
ip ) d0 .b move, d0 ip add, 6 #n rp addq, 6 #n rp addq, next;
code <0leavel>
sp )+ d0 move, ne if, 2 #n ip addq, next, then,
ip )+ d0 .b move, 8 #n d0 .w lsl, ip ) d0 .b move, d0 ip add,
6 #n rp addq, 6 #n rp addq, next;
code rheader ( --> addr-info )
sr sp -) .w move, 2700 #n sr .w move,
(regs d4 d5 a2 a3 a4 a5 a6 to) sp -) movem,
crctable #n a3 move, ga3 fd.drd + #n a4 move,
ga3 fd.status + #n a5 move, <rbyte> #n a6 move,
i' system.status a2 move, ( get system.status )
a2 ga2opr )d d0 .b move, ( get copy of opr )
8 #n d0 .b or, d0 opr .b move, ( reset watchdog timer )
<rheader> jmp2,
(regs d4 d5 a2 a3 a4 a5 a6 from) sp )+ movem,
sp )+ sr .w move, d2 sp -) move, next;
code <rtrk> ( addr addr-info -> errcode ) ( MT 7/11 )
sp )+ d0 move, sp )+ a1 move,
(regs d4 d5 d6 d7 a2 a3 a4 a5 a6 to) sp -) movem,
sr sp -) .w move, 2700 #n sr .w move,
crctable #n a3 move, ga3 fd.drd + #n a4 move,
ga3 fd.status + #n a5 move, <rbyte> #n a6 move,
d0 d7 move, 00 #n d6 moveq, a1 sp -) move,
begin, i' system.status a0 move, a0 d6 track.err xw)d d0 .b move, ne
if, d6 swap, 30 #n d6 .w move, sp ) a1 move,
begin, i' system.status a2 move, ( get system.status )
a2 ga2opr )d d0 .b move, ( get old opr )
8 #n d0 .b or, d0 opr .b move, ( reset watchdog timer )
<rheader> jmp2, d2 tst, 0 mi bra,
d2 d7 cmp, d6 eq
-until, eq
if, <rdata> jmp2,
else, -9 #n d2 moveq,
then,
0 :l d6 swap, i' system.status a0 move, d2 a0 d6 track.err xw)d .b move,
then, 200 #n sp ) add, 100 #n d7 add, 1 #n d6 .w add, 0A #n d6 .w cmp, eq
until, 4 #n sp .l addq, a0 track.err )d a0 lea, 0 #n d2 moveq,
begin, a0 )+ d2 .b or, 1 #n d6 .w subq, eq
until, sp )+ sr .w move, (regs d4 d5 d6 d7 a2 a3 a4 a5 a6 from) sp )+ movem,
d2 sp -) move, next;
code <vtrk> ( addr addr-info -> errcode ) ( MT 7/11 )
sp )+ d0 move, sp )+ a1 move, sr sp -) .w move, 2700 #n sr .w move,
(regs d4 d5 d6 d7 a2 a3 a4 a5 a6 to) sp -) movem,
crctable #n a3 move, ga3 fd.drd + #n a4 move,
ga3 fd.status + #n a5 move, <rbyte> #n a6 move,
d0 d7 move, 00 #n d6 moveq, a1 sp -) move,
begin, i' system.status a0 move, a0 d6 track.err xw)d d0 .b move, ne
if, d6 swap, 30 #n d6 .w move, sp ) a1 move,
begin, i' system.status a2 move, ( get system.status )
a2 ga2opr )d d0 .b move, ( get old opr )
8 #n d0 .b or, d0 opr .b move, ( reset watchdog timer )
<rheader> jmp2, d2 tst, 0 mi bra,
d2 d7 cmp, d6 eq
-until, eq
if, <vdata> jmp2,
else, -9 #n d2 moveq,
then,
0 :l d6 swap, i' system.status a0 move, d2 a0 d6 track.err xw)d .b move,
then, 200 #n sp ) add, 100 #n d7 add, 1 #n d6 .w add, 0A #n d6 .w cmp, eq
until, 4 #n sp addq, a0 track.err )d a0 lea, 0 #n d2 moveq,
begin, a0 )+ d2 .b or, 1 #n d6 .w subq, eq
until, (regs d4 d5 d6 d7 a2 a3 a4 a5 a6 from) sp )+ movem,
sp )+ sr .w move, d2 sp -) move, next;
code <wtrk> ( addr addr-info -> | write track using iai format to disk )
sp )+ d2 move, sp )+ a1 move, sr sp -) .w move, 2700 #n sr .w move,
(regs d4 d5 d6 a2 a3 a4 a5 a6 to) sp -) movem, crctable #n a3 move,
ga3 fd.dwr + #n a4 move, iai-trk #n a5 move, <wbyte> #n a6 move,
i' system.status a2 move, ( get system.status )
a2 ga2opr )d d0 .b move, ( get old opr )
8 #n d0 .b or, d0 opr .b move, ( reset watchdog timer )
<wtrack> jmp2,
(regs d4 d5 d6 a2 a3 a4 a5 a6 from) sp )+ movem,
sp )+ sr .w move, next;
code <rsector> ( addr addr-info -> errcode ) ( MT 4/14/87 )
sp )+ d0 move, sp )+ a1 move, sr sp -) .w move, 2700 #n sr .w move,
(regs d4 d5 d6 d7 a2 a3 a4 a5 a6 to) sp -) movem,
crctable #n a3 move,
ga3 fd.drd + #n a4 move, ga3 fd.status + #n a5 move,
<rbyte> #n a6 move, d0 d7 move, 1e #n d6 .l moveq,
begin, <rheader> jmp2, d2 d7 cmp, eq
if, <rdata> jmp2, 0 bra,
then, -4 #n d2 .l cmpi, 0 eq bra, ( exit if no header found )
i' system.status a2 move, ( start of system.status )
a2 ga2opr )d d0 .b move, ( get the copy of the opr )
8 #n d0 .b or, d0 opr .b move, ( reset the watchdog timer )
d6 nt ( try again if just wrong header )
-until, -9 #n d2 moveq, ( set incorrect headers found )
0 :l (regs d4 d5 d6 d7 a2 a3 a4 a5 a6 from) sp )+ movem,
sp )+ sr .w move, d2 sp -) move, next;
code <vsector> ( addr addr-info -> errcode ) ( MT 4/14/87 )
sp )+ d0 move, sp )+ a1 move, sr sp -) .w move, 2700 #n sr .w move,
(regs d4 d5 d6 d7 a2 a3 a4 a5 a6 to) sp -) movem,
crctable #n a3 move,
ga3 fd.drd + #n a4 move, ga3 fd.status + #n a5 move,
<rbyte> #n a6 move, d0 d7 move, 1e #n d6 .l moveq,
begin, <rheader> jmp2, d2 d7 cmp, eq
if, <vdata> jmp2, 0 bra,
then, -4 #n d2 .l cmpi, 0 eq bra, ( exit if no header found )
d6 nt ( try again if just wrong header )
-until, -9 #n d2 moveq, ( set incorrect headers found )
0 :l (regs d4 d5 d6 d7 a2 a3 a4 a5 a6 from) sp )+ movem,
sp )+ sr .w move, d2 sp -) move, next;
code <wsector> ( addr addr-info -> errcode ) ( MT 4/14/87 )
sp )+ d0 move, sp )+ a1 move, sr sp -) .w move, 2700 #n sr .w move,
(regs d4 d5 d6 d7 a2 a3 a4 a5 a6 to) sp -) movem,
crctable #n a3 move,
ga3 fd.dwr + #n a4 move, ga3 fd.status + #n a5 move,
<rbyte> #n a6 move, d0 d7 move, 1e #n d6 .w move,
begin, i' system.status a2 move, ( get system.status )
a2 ga2opr )d d0 .b move, ( get old opr )
8 #n d0 .b or, d0 opr .b move, ( reset watchdog timer )
<rheader> jmp2, d2 d7 cmp, eq
if, <wbyte> #n a6 move,
<wdata> jmp2, 0 #n d2 moveq, 0 bra,
then, -4 #n d2 .l cmpi, 0 eq bra, ( exit if no header was found )
d6 nt ( try again if just the wrong header or crc error ... )
-until, -9 #n d2 moveq, ( set wrong headers found )
0 :l (regs d4 d5 d6 d7 a2 a3 a4 a5 a6 from) sp )+ movem,
sp )+ sr .w move, d2 sp -) move, next;
( rearranged these words down past the critical area code )
code crc ( cur data -- crc )
sp )+ d0 move, sp )+ d3 move, crctable #n a1 move, 8 #n d3 .w ror,
d0 d3 .b eor, d3 d1 .b move, ff #n d1 andi, 1 #n d1 .w lsl,
a1 d1 0 xw)d d1 .w move, d1 d3 .w eor,
d3 sp -) move, next;
code <step> ( -> | Step the drive head with interrupts off, save&rest. sr)
sr sp -) .w move, 2700 #n sr .w move, 05 #n ga3 fd.cont + .b bset,
05 #n ga3 fd.cont + .b bclr, sp )+ sr .w move,
i' system.status a0 move, ( get system.status )
a0 ga2opr )d d0 .b move, ( get old opr )
8 #n d0 .b or, d0 opr .b move, next; ( reset watchdog timer )
code <trackdump> ( addr len -- | read a raw track into addr for len bytes )
sp )+ d1 move, 1 #n d1 subq, sp )+ a0 move, ( get addr & len from stack )
sr sp -) .w move,
2700 #n sr .w move,
begin,
begin, ga3 fd.status + d0 .b move, mi
until, ga3 fd.drd + a0 )+ .b move, d1 nt
-until, sp )+ sr .w move, next;
code <write55> ( | writes one track worth of 55's on the current track *mt)
sr sp -) .w move, ( save status register )
2700 #n sr .w move, ( turn off interrupts )
1926 #n d0 .w move, ( set up count )
55 #n d1 .l moveq, ( set up data )
ga3 fd.dwr + #n a0 move, ( set up disk data register address )
01 #n ga3 fd.cont + .b bset, ( turn on write current )
begin, d1 a0 ) .b move, ( 8 write to disk controller )
3f #n d2 .w move, ( 8 set delay to 134 )
d2 d2 .l lsr, ( 134 delay )
d0 nt -until, ( 10 loop )
01 #n ga3 fd.cont + .b bclr, ( turn off write current )
i' system.status a0 move, ( get system.status )
a0 ga2opr )d d0 .b move, ( get old opr )
8 #n d0 .b or, d0 opr .b move, ( reset watchdog timer )
sp )+ sr .w move, next;
code stepin ( -> | set dir signal to step in )
03 #n ga3 fd.cont + .b bset, next;
code stepout
03 #n ga3 fd.cont + .b bclr, next;
code ?trk0 ( -> flag | returns a -1 if on track zero )
04 #n ga3 fd.status + .b btst, eq
if, -1 #n sp -) move,
else, 0 #n sp -) move,
then, next;
code ?index ( -> flag | returns a -1 during an index pulse )
05 #n ga3 fd.status + .b btst, eq
if, -1 #n sp -) move,
else, 0 #n sp -) move,
then, next;
code ?wprot ( -> flag | returns a -1 if write protected )
03 #n ga3 fd.status + .b btst, eq
if, -1 #n sp -) move,
else, 0 #n sp -) move,
then, next;
code ?diskrdy ( -> flag | returns a -1 if the disk is ready )
02 #n ga3 fd.status + .b btst, eq
if, -1 #n sp -) move,
else, 0 #n sp -) move,
then, next;
: ?diskerror ( error -- \ tell the user what type of disk error happened )
?dup
if ion
dup -1 = if drop nodisk error abort then
dup -3 = if drop writeprotect error abort then
dup -4 = abort" Disk Error: no headers"
dup -9 = abort" Disk Error: wrong headers"
dup -5 = abort" Disk Error: wrong header crc"
dup -6 = abort" Disk Error: no data"
dup -7 = abort" Disk error: data crc"
dup -8 = abort" Disk error: verify error"
dup -2 = abort" Disk error: seek error"
abort" Disk error: track error or unspecified value!"
then ;
: side0 ef [ ga3 fd.cont + ] literal and! side# off ;
: side1 10 [ ga3 fd.cont + ] literal or! 1 side# to ;
: drive0 80 [ ga3 fd.cont + ] literal or! ;
: drive1 7f [ ga3 fd.cont + ] literal and! ;
: don ( MT 4/14/87 Returns -1 if disk is not ready )
drive# 0=
if drive0
else drive1
then 40 [ ga3 fd.cont + ] literal or!
300
begin dup ?diskrdy not and while
1 ms 1-
again 0= ( no longer aborts )
dticks@ 33 max dticks! ; ( time out value is 1 second, or dticks )
: doff 0 dticks! 1d [ ga3 fd.cont + ] literal and! ;
: recal ( MT 4/14/87 Returns error codes )
don ?dup
if exit ( Return with a -1 if disk is not ready )
then ?trk0
if stepin 12 ms 4 ioff
begin <step> 6 ms ?trk0
while 1- dup 0=
until ion 0=
if -2 exit ( Return with a -2 if drive is not responding )
then
then don ?dup
if exit ( Return with a -1 if disk is not ready )
then stepout 12 ms 54 ioff
begin <step> 6 ms ?trk0 0=
while 1- dup 0=
until ion 0=
if -2 exit
then 0 t#on off ; ( Return with a 0 if everything is OK )
: seek ( track# -> | steps to track# ) ( MT 4/14/87 Returns error )
dup t#on =
if drop don
else t#on dup 0< swap 50 > or
if recal ?dup ( recal if invalid track number)
if swap drop exit ( Exit with error code returned by recal )
then
then dup t#on - dup 0<
if negate stepout
else stepin
then ?dup
if don ?dup
if swap drop swap drop exit
then ( don't step w/o disk) 0 ioff
do 3 ms <step> 3 ms ( changed the times a little )
loop 12 ms ion t#on to
else drop
then 0
then ;
: <format>
trkbuf 1400 spc fill ioff recal ?dup
if ion exit
then ?wprot
if ion -3 exit
then 100 ms 0
begin ?index
until
begin trkbuf over 18 shl 2 or <wtrk> 1+ dup 50 = not
while dup seek ?dup
if ion exit
then
again ion drop 0 ;
: format ( Formats a disk checking wprot and the like MT 4/14/87 )
<format> ?diskerror ;
: trackdump don ?diskerror 100 ms trkbuf 1400 <trackdump> ;
: write55 ( writes one track of 55 on the current track MT 4/14/87)
don
if beep
else ?wprot
if beep
else <write55>
then
then ;
( MT 3/17 Change to work with diagnostics code ) ( MT 4/14/87 )
: rsector ( address sector# --> error-code )
local address local sector local addr-info
local retry-count local recal-count
sector to address to #retry retry-count to #recal recal-count to
sector [ sectors ] literal /mod dup seek ?dup
if swap drop swap drop exit
then 18 shl swap 8 shl or 2 or side# 10 shl or addr-info to
begin address addr-info <rsector> dup
while retry-count
if -1 retry-count +to
else recal-count
if -1 recal-count +to #retry retry-count to recal ?dup
if swap drop exit
then sector [ sectors ] literal / seek ?dup
if swap drop exit
then
else 0
then
then 0=
until ;
: vsector ( address sector# --> error-code )
local address local sector local addr-info
local retry-count local recal-count
sector to address to #retry retry-count to #recal recal-count to
sector [ sectors ] literal /mod dup seek ?dup
if swap drop swap drop exit
then 18 shl swap 8 shl or 2 or side# 10 shl or addr-info to
begin address addr-info <vsector> dup
while retry-count
if -1 retry-count +to
else recal-count
if -1 recal-count +to #retry retry-count to recal ?dup
if swap drop exit
then sector [ sectors ] literal / seek ?dup
if swap drop exit
then
else 0
then
then 0=
until ;
: wsector ( address sector# --> error-code )
local address local sector local addr-info
local retry-count local recal-count
sector to address to #retry retry-count to #recal recal-count to
sector [ sectors ] literal /mod dup seek ?dup
if swap drop swap drop exit
then 18 shl swap 8 shl or 2 or side# 10 shl or addr-info to
begin address addr-info <wsector> dup
while retry-count
if -1 retry-count +to
else recal-count
if -1 recal-count +to #retry retry-count to recal ?dup
if swap drop exit
then sector [ sectors ] literal / seek ?dup
if swap drop exit
then
else 0
then
then 0=
until ;
: rtrk ( address track --> error-code ) ( MT 5/28/87 )
local recal-count local retry-count
local addr-info local address local track local err
track to address to #recal recal-count to
begin track seek ?dup
if exit
then #retry retry-count to
begin address track 18 shl side# 10 shl or
2 or system.status [ track.err ] literal + 0a ff fill <rtrk> dup err to 0=
if 0 exit
then retry-count
if -1 retry-count +to 0
else -1
then
until recal-count 0=
if err exit
then -1 recal-count +to recal ?dup
if exit
then
again ;
: vtrk ( address track --> error-code ) ( MT 5/28/87 )
local recal-count local retry-count
local addr-info local address local track local err
track to address to #recal recal-count to
begin track seek ?dup
if exit
then #retry retry-count to
begin address track 18 shl side# 10 shl or
2 or system.status [ track.err ] literal + 0a ff fill <vtrk> dup err to 0=
if 0 exit
then retry-count
if -1 retry-count +to 0
else -1
then
until recal-count 0=
if err exit
then -1 recal-count +to recal ?dup
if exit
then
again ;
: wtrk ( address track --> error-code ) ( MT 4/14/87 )
don ?dup
if swap drop swap drop exit
then ?wprot
if drop drop -3 exit
then dup seek ?dup
if swap drop swap drop exit
then 18 shl side# 10 shl or 2 or <wtrk> 0 ;
: parksafe ( -- errorcode ) 3 seek ;
: ?textdisk ( Returns a true if it is a save text disk MT 3/5 )
idblock 0=
if [ .s/r 66 + ] literal w@ 3325 =
else 0
then ;
( The following stuff is for shadow ram MT 3/5 )
: shadow-t/s ( size - tracks sectors )
( Calcs tracks and sectors of shadow area )
dup 0= abort" Shadow RAM set to zero bytes." 1400 /mod swap 200 / ;
: savebasis ( Saves the basis image onto a disk MT 3/5 )
local tracks local sectors
shadowsize shadow-t/s sectors to tracks to
?textdisk
if cr beep
." This is a text disk!" cr
." Press return to continue or erase to abort."
begin key dup 7f = if cr abort then 0d =
until
then
trkbuf 1400 53 fill ( Fill RAM with S's )
shadowsize trkbuf ! ( Save size of shadow ram on disk )
0a sectors - 200 * trkbuf +
shadow swap sectors 200 * move
trkbuf 0 wtrk ?diskerror
sectors 200 * shadow + tracks 0
do i 1400 * over + trkbuf 1400 move ( move data into trkbuf )
trkbuf i 1+ wtrk ?diskerror
loop drop ;
: loadbasis ( Restore saved image onto a disk MT 3/5 )
local tracks local sectors
trkbuf 0 rtrk ?diskerror ( Get basis id image )
trkbuf 4 + @ 53535353 = not abort" Basis not saved on this disk."
trkbuf @ dup shadowsize to
shadow-t/s sectors to tracks to
0a sectors - 200 * trkbuf + shadow sectors 200 * move
sectors 200 * shadow + tracks 0
do dup 1400 + swap i 1+ rtrk ?diskerror
loop drop ;
: rambasis ( Jumps to the Shadow RAM environment MT 3/5 )
ioff align
here 13C0 w, 3FFFF , ( MOVE.B D0,$3FFFF There's no place like home )
13C0 w, 3FFFF , ( MOVE.B D0,$3FFFF There's no place like home )
13C0 w, 3FFFF , ( MOVE.B D0,$3FFFF There's no place like home )
13C0 w, 3FFFF , ( MOVE.B D0,$3FFFF There's no place like home... )
2E78 w, 0 w, ( MOVE.L $00,A7 ... not home yet... )
2078 w, 4 w, ( MOVE.L $04,A0 ... still waiting... )
4ED0 w, ( Auntie Em! Auntie Em! )
call ; ( THE END )
: ready ( -- ) loadbasis rambasis ;
: save? ( -> | Aborts if the disk is write protected) ( MT 4/14/87 )
don ?diskerror ?wprot if -3 ?diskerror then ;
code ms ( n -- | waits for n ms. doesn't take into account interrupts )
sp )+ d0 move, ( find out how many milliseconds are wanted )
ne ( a zero just returns)
if, begin, ( wait for 1 ms )
1ef #n d1 move, ( 5mhz/500=10000 cycles/sec )
begin, ( so, we want 1000th=10 cycles/loop )
d1 nt -until, ( 10 cycles )
1 #n d0 subq, eq ( Loop until done )
until,
then,
next;
: reset-vticks
vdelay vticks! ;
: draw.screensave
ramstart screensize 0 fill von blank-lbuff inverse-line
screensave$ [ $inv $bold or ] literal over 54 swap - rnd $>char 30 rnd disp ;
: <screen-save>
voff
blackscreen if <bonw> then ( if inverse screen, flip it )
begin ticks@ 7f and 0=
if draw.screensave
then <?k> rings@ 0= or rxch? or
until
voff
blackscreen if <wonb> then ; ( and reset when done )
: screen-save
offhook? 0= if <screen-save> rewindow refresh resetcursor rule von then
reset-vticks ;
: von ( -> | Turn the video display on and off, decide in high level )
ga2opr@ 04 or ga2opr! ( turn the video back on )
vdelay vticks! ( reset timer) ;
: voff
ga2opr@ fb and ga2opr! ( turn video off)
0 vticks! ( zero timer) ;
( Sound stuff )
code sound.on
i' system.status a0 move, ( Get the system base address )
begin, a0 isb )d d0 move, ( Get the ISB )
sound.en #n d0 .l btst, eq ( Wait until current sound is done )
until,
sp )+ d0 move, ( Get the starting address )
sr sp -) .w move, ( Save the status reg )
2700 #n sr .w move, ( Turn off interrupts )
d0 a0 sound.addr )d move, ( Store the address )
a0 isb )d d0 move, ( Get the ISB )
sound.en #n d0 .l bset, ( Turn on the sound )
d0 a0 isb )d move, ( Save the ISB )
0008 #n a0 int.mask )d .w ori, ( Enable the timer interrupt )
a0 opcr.copy )d d0 .b move,
F7 #n d0 .b andi,
04 #n d0 .b ori,
d0 a0 opcr.copy )d .b move,
d0 duart ser.opcr + .b move,
00 #n duart ser.cth + .b move,
02 #n duart ser.ctl + .b move,
duart ser.cstart + d0 .b move,
sp )+ sr .w move, ( Restore the status register )
next;
code sound.addr@
i' system.status a0 move, ( Get the system base address )
a0 sound.addr )d sp -) move, ( Put the current address on the stack )
next;
code sound.addr!
i' system.status a0 move, ( Get the system base address )
sp )+ a0 sound.addr )d move, ( Store the sound address )
next;
code ?sound
i' system.status a0 move,
-1 #n d1 moveq,
a0 isb )d d0 move,
sound.en #n d0 .l btst, eq
if, 0 #n d1 moveq,
then, d1 sp -) move, next;
code 'beep
nx ) jsr, ;c 0 w, 80 w, 700 w, 1 w, 0 w, 0 ,
code 'boop
nx ) jsr, ;c 0 w, C0 w, 1400 w, 1 w, 0 w, 0 ,
code sound-off
nx ) jsr, ;c
0 ,
code ringsound-slow
nx ) jsr, ;c
0 w, 20 w, 0 w, 30 w, e80 w, 10000 , 0 w, 30 w, 1180 w, 10000 , 10000 , 0 ,
code ringsound-med
nx ) jsr, ;c
0 w, 20 w, 0 w, 20 w, e80 w, 10000 , 0 w, 20 w, 1180 w, 10000 , 10000 , 0 ,
code ringsound-fast
nx ) jsr, ;c
0 w, 20 w, 0 w, 10 w, e80 w, 10000 , 0 w, 10 w, 1180 w, 10000 , 10000 , 0 ,
: beep
'beep sound.on begin ?sound not until ;
: boop
'boop sound.on begin ?sound not until ;
( this code goes right over )
( I/O interrupt service code [all on Level 1 autovector] )
frag .level1 to ( the level 1 interrupt entrance) ( MT 5/28/87 7:25 PM )
(regs a0 a1 a2 d0 d1 d2 d3 d4 d6 d7 to) sp -) movem,
i' system.status a1 .l move, ( Get the paramater base address )
duart #n a0 .l move, ( Get the DUART base address )
a0 ser.ipcr )d d7 .w movep, ( Get the DUART IPCR and ISR )
a1 isb )d d6 .l move, ( Get the system Interrupt Status Bits )
a1 int.mask )d d7 .w andi, ( Keep Only Active Interrupts )
d7 d0 .w move, ( Copy the IPCR and ISR )
22 #n d0 .w andi, ne ( Was it either of the RX INT )
( Serial Port Receive Interrupt )
lif, a0 ser.sra )d d0 .b move, ( Get status of the port )
00 #n d0 .l btst, ne ( Something in the RX register )
lif, a0 ser.rhra )d d0 .b move, ( Read the RX Register )
ser.xon.tx.en #n d6 .l btst, ne ( Is XON/XOFF TX Handshake Enabled )
if, xoff #n d0 .b cmpi, eq ( Was a XOFF received )
if, ser.xon.tx #n d6 .l bset, ( Set XOFF received flag )
0 bra, ( Exit RX Interrupt )
then, xon #n d0 .b cmpi, eq ( Was a XON received )
if, ser.xon.tx #n d6 .l bclr, ( Clear XOFF received flag )
0 bra, ( Exit RX Interrupt )
then,
then, a1 ser.rxptr )d d1 .w move, ( Get current Index Pointer )
a1 ser.rxbuf )d a2 .l move, ( Get the address of the buffer )
d0 a2 d1 0 xw)d .b move, ( Save the received character )
1 #n d1 .w addq, ( Increment the received character )
a1 ser.rxbuf.len )d d1 .w cmp, eq ( End of the buffer )
if, d1 .w clr, ( If end of buffer reset index to 00 )
then, a1 ser.rxchar )d d2 .w move, ( Get the current character position )
d1 d2 .w sub, eq ( Did we overrun the buffer )
if, ser.overrun #n d6 .l bset, ( Set overrun bit )
else, mi ( Did we wrap at end of buffer )
if, a1 ser.rxbuf.len )d d2 .w add, ( Adjust to get positive number)
then, 10 #n d2 .w subq, mi ( Almost at the end of the buffer? )
if, ser.xon.rx.en #n d6 .l btst, ne ( RX XON/XOFF Handshaking enabled)
if, ser.xon.pend #n d6 .l bclr, eq ( Is a XON pending? )
if, ser.xon.rx #n d6 .l btst, eq ( No XOFF sent? )
if, ser.xoff.pend #n d6 .l bset, ( Set XOFF pending )
0001 #n a1 int.mask )d .w ori, ( Set TX INT )
then,
else, FFFE #n a1 int.mask )d .w andi, ( Clear TX INT )
then,
then, ser.rts.en #n d6 .l btst, ne ( Is RTS Handshaking enabled )
if, 01 #n a0 ser.ropb )d .b move, ( Set RTS in the DUART )
ser.rts #n d6 .l bset, ( Set RTS in ISB )
then, ser.dtr.en #n d6 .l btst, ne ( Is DTR Handshaking enabled )
if, 02 #n a0 ser.ropb )d .b move, ( Set DTR in the DUART )
ser.dtr #n d6 .l bset, ( Set DTR in ISB )
then,
then, d1 a1 ser.rxptr )d .w move, ( Save index )
then,
then,
0 :l ( Exit point for RX interrupt )
( Phone Port Receive Interrupt )
a0 ser.srb )d d0 .b move, ( Get status of the port )
00 #n d0 .l btst, ne ( Something in the RX register )
lif, a0 ser.rhrb )d d0 .b move, ( Read the RX Register )
a1 modem.energy )d d1 .w move, ( Get the energy status )
0FFF #n d1 .w ori, ( Mask out old status )
-1 #n d1 .w cmpi, 1 ne bra, ( Exit if data is invalid )
ph.xon.tx.en #n d6 .l btst, ne ( Is XON/XOFF TX Handshake Enabled )
if, xoff #n d0 .b cmpi, eq ( Was a XOFF received )
if, ph.xon.tx #n d6 .l bset, ( Set XOFF received flag )
1 bra, ( Exit RX Interrupt )
then, xon #n d0 .b cmpi, eq ( Was a XON received )
if, ph.xon.tx #n d6 .l bclr, ( Clear XOFF received flag )
1 bra, ( Exit RX Interrupt )
then,
then, a1 ph.rxptr )d d1 .w move, ( Get current Index Pointer )
a1 ph.rxbuf )d a2 .l move, ( Get the address of the buffer)
d0 a2 d1 0 xw)d .b move, ( Save the received character )
1 #n d1 .w addq, ( Increment the received character )
a1 ph.rxbuf.len )d d1 .w cmp, eq ( End of the buffer )
if, d1 .w clr, ( If end of buffer reset index to 00 )
then, a1 ph.rxchar )d d2 .w move, ( Get the current character position )
d1 d2 .w sub, eq ( Did we overrun the buffer )
if, ph.overrun #n d6 .l bset, ( Set overrun bit )
else, mi ( Did we wrap at end of buffer )
if, a1 ph.rxbuf.len )d d2 .w add, ( Adjust to get positive number)
then, 10 #n d2 .w subq, mi ( Almost at the end of the buffer? )
if, ph.xon.rx.en #n d6 .l btst, ne ( RX XON/XOFF Handshaking enabled )
if, ph.xon.pend #n d6 .l bclr, eq ( Is a XON pending? )
if, ph.xon.rx #n d6 .l btst, eq ( No XOFF sent? )
if, ph.xoff.pend #n d6 .l bset, ( Set XOFF pending )
0010 #n a1 int.mask )d .w ori, ( Set TX INT )
then,
else, FFEF #n a1 int.mask )d .w andi, ( Clear TX INT )
then,
then,
then, d1 a1 ph.rxptr )d .w move, ( Save index )
then,
then,
1 :l ( Exit point for RX interrupt )
then, ( Then for RX INT test )
( Handle Serial XOFF/XON Pending )
d6 d0 .w move, ( Copy the low word of the ISB )