; addra000 sqr_ equ $a000 ;addra000 ; addra003 power_ ; addra006 exp_ ; addra009 log_ ; addra00c atn_ ; addra00f cos_ ; addra012 sin_ ; addra015 fload_ ; addra018 fload2_ ; addra01b fstore_ ; addra01e cnvfi_ ; addra021 fraction_ ; addra024 fzero_ ; addra027 exponent_ ; addra02a trflf2_ ; addra02d cnvif_ ; addra030 fadd_ ; addra033 fadd2_ ; addra036 fsub_ ; addra039 fsub2_ ; addra03c fcmp_ ; addra03f ftest_ ; addra042 fmul_ ; addra045 fmulby_ ; addra048 fdiv_ ; addra04b fdivby_ ; addra04e fneg_ ; addra051 cnvs2f_ ; addra054 cnvf2s_ ; addra057 shiftl ; addra05a addacc ; addra05d fmul10 ; addra060 fdiv10 ; addra063 ffloor_ ; addra066 faddhalf_ ; addra069 fcompare ; addra06c finteger ; addra098 cnvnorm ; addra0c9 roundit ; addra0cc cnvtoint ; addra0e8 cnvfac1 ; addra147 addecac1 ; addra15a cnvexpon ; addra182 dectable ; addra1a6 bilmione ; addra1ac hmmitnth ; addra1b1 billion ; addra1b7 cnvs2f ; addra20f endnumbr ; addra235 tstfsign ; addra245 getexpon ; addra27d tstdigit ; addra283 tstdigtx ; addra28e chkdigtx ; addra2a0 getunget ; addra2a7 skipspcs ; addra2b0 maxreal ; addra2b5 overflow ; addra2b9 floadmax ; addra2bc fload ; addra2be floadx ; addra2db fload2 ; addra2dd fload2x ; addra2fa fstore ; addra2fc fstorex ; addra314 cnvfi ; addra33f fraction ; addra35d exponent ; addra36b ffmul10 ; addra385 mul10ret ; addra386 trflf2 ; addra389 qktrflf2 ; addra39a cnvif ; addra3ac underflo ; addra3b0 fzero ; addra3bc compfac1 ; addra3cd kilguard ; addra3d5 froundup ; addra3e4 fcmp ; addra3e7 ffcompar ; addra41a ftest ; addra426 half ; addra42b fsub2 ; addra430 fsub ; addra434 fadd2 ; addra439 faddhalf ; addra43c faddx ; addra43f fadd ; addra475 normaliz ; addra49b chkrange ; addra4a8 chkguard ; addra4b6 fshiftl ; addra4c3 fmulby ; addra4c5 fmulbyx ; addra4c8 fmul ; addra4fb fmulbyte ; addra51b chkmulrg ; addra54b fdivby ; addra550 ten ; addra555 ffdiv10 ; addra558 fdivx ; addra55b fdiv ; addra5af divend ; addra5c5 chkdivac ; addra5e6 fneg ; addra5ed shiftacc ; addra613 faddacc ; addra62c rshiftac ; addra62e rotateac ; addra644 subacc ; addra65d sqr ; addra666 power ; addra6e2 exp ; addra739 log ; addra74b findlog ; addra799 atn ; addra7d7 cos ; addra7dd sin ; addra81c odexpand ; addra83d expand ; addra83f expandx ; addra872 pihalf ; addra877 twopi ; addra87c quarter ; addra881 half ; addra886 sin45 ; addra88b sqrtof2 ; addra890 ln_of_2 ; addra895 minhalf ; addra89a ln_of_e ; addra89f sintable ; addra8be atntable ; addra8f6 one ; addra8fb logtable ; addra90b halfln_e ; addra910 exptable ; addra934 onefloat ; addra939 ffloor ; addra93e ffintgr ; addra990 startup ; addra99f mainnmi ; addra9af maininit ; addra9d1 chekretc ; addra9da docode1 ; addra9eb docode2 ; addra9f0 docode3 ; addra9f3 execcode ; addra9da docode1 ; addra9f7 doexit ; addra9fa decodeit ; addraa0f docode8 ; addraa14 setmem ; addraa1f decodtbl ; addraa27 menulist ; addraa62 resident ; addraa66 showmemu ; addrabf2 menuhead ; addrac18 default_ ; addrac20 loadcmd ; addrac59 loadprog ; addrace7 loaderr1 ; addracef loadend ; addracfc progread ; addrad0e loadmsg ; addrad1d prglmode ; addrad1f nofndprg ; addrad33 badldmsg ; addrad48 setup_ ; addrad57 setup ; addrad5e shosetup ; addrad7a getsetup ; addrad97 redoseup ; addrae5d parsbaud ; addrae84 parsprty ; addraed4 parsprmt ; addraeec setupret ; addraeee parslnen ; addraf07 parsrspn ; addraf1e setupsav ; addraf27 setupby1 ; addraf2b setuperr ; addraf2f setupend ; addraf31 checkhex ; addraf51 setupbye ; addraf53 hexerror ; addraf55 setupexi ; addraf5b keyboard ; addraf64 writmode ; addraf66 setupmsg ; addrafaa systabs ; addrafbd setfuncs ; addrafbc paritabl ; addrafd1 paritval ; addrafd6 bankcall ; addrb000 spawn_ ; addrb003 suicide_ ; addrb006 conbint_ ; addrb009 banksw ; addrb00c bankinit_ ; addrb00f stoi_ ; addrb012 itos_ ; addrb015 itohs_ ; addrb018 hex_ ; addrb01b btohs_ ; addrb01e hstob_ ; addrb021 isalpha_ ; addrb024 isdigit_ ; addrb027 isdelim_ ; addrb02a ishex_ ; addrb02d isupper_ ; addrb030 islower_ ; addrb033 upper_ ; addrb036 lower_ ; addrb039 zlostr_ ; addrb03c zupstr_ ; addrb03f streq_ ; addrb042 equal_ ; addrb045 length_ ; addrb048 copystr_ ; addrb04b copy_ ; addrb04e prefixst_ ; addrb051 suffixst_ ; addrb054 decimal_ ; addrb057 tableloo_ ; addrb05a ___ret ; addrb05d ___ret2 ; addrb060 ___mul ; addrb063 ___neg ; addrb066 ___div ; addrb069 ___mod ; addrb06c _rshift ; addrb06f _lshift ; addrb072 carryset_ ; addrb075 passthru_ ; addrb078 tioinit_ ; addrb07b tputchr_ ; addrb07e tgetchr_ ; addrb081 tbreak_ ; addrb084 tgetcurs_ ; addrb087 tputcurs_ ; addrb08a tsetchar_ ; addrb08d tabset_ ; addrb090 tabget_ ; addrb093 sioinit_ ; addrb096 sputchr_ ; addrb099 sgetchr_ ; addrb09c sbreak_ ; addrb09f diropenf_ ; addrb0a2 dirreadf_ ; addrb0a5 dirclose_ ; addrb0a8 sysioini_ ; addrb0ab initstd_ ; addrb0ae openf_ ; addrb0b1 closef_ ; addrb0b4 fseek_ ; addrb0b7 printf_ ; addrb0ba putrec_ ; addrb0bd putchar_ ; addrb0c0 putnl_ ; addrb0c3 getrec_ ; addrb0c6 getchar_ ; addrb0c9 fprintf_ ; addrb0cc fputrec_ ; addrb0cf fputchar_ ; addrb0d2 fputnl_ ; addrb0d5 fgetrec_ ; addrb0d8 fgetchar_ ; addrb0db eor_ ; addrb0de eof_ ; addrb0e1 errorf_ ; addrb0e4 errormsg_ ; addrb0e7 mount_ ; addrb0ea scratchf_ ; addrb0ed renamef_ ; addrb0f0 request_ ; addrb0f3 setdate_ ; addrb0f6 getdate_ ; addrb0f9 settime_ ; addrb0fc gettime_ ; addrb0ff kbenable_ ; addrb102 kbdisabl_ ; addrb105 timeout_ ; addrb108 sysread_ ; addrb10b syswrite_ ; addrb10e sysnl_ ; addrb124 devices_ ; addrb155 devcode_ ; addrb15d ioformat ; addrb172 ioformc ; addrb176 filespec ; addrb187 filespcc ; addrb18c filecmod ; addrb1b1 ; addrb1ea putchar ; addrb289 ; addrb28c ; addrb292 closef ; addrb29c ; addrb2f6 ; addrb2fa ; addrb2fd fputchar ; addrb324 fputnl ; addrb3aa fprintf ; addrb3b7 ; addrb3ce ; addrb47d ; addrb48d ; addrb493 ; addrb49f ; addrb4a3 fseek ; addrb4bd ; addrb4c1 ; addrb4c9 eor ; addrb4d3 eof ; addrb4db ; addrb4e5 errorf ; addrb503 ; addrb50a ; addrb50a ioreturn ; addrb510 errormsg ; addrb515 ; addrb518 scratchf ; addrb543 renamef ; addrb58b mount ; addrb5b2 ; addrb5b9 ; addrb5bd timeout ; addrb5d2 diropenf ; addrb610 dirreadf ; addrb627 dirclosef ; addrb633 ; addrb636 ; addrb63e ; addrb650 ; addrb653 ; addrb666 ; addrb66a str_ioto ; addrb677 __ret ; addrb67f __ret2 ; addrb687 __mul ; addrb6b7 ; addrb6bc ; addrb6c4 carryset ; addrb6ce __div ; addrb6d8 __mod ; addrb6dc ; addrb6e0 ; addrb6e3 ; addrb6e6 ; addrb6e8 ; addrb6f1 ; addrb719 ; addrb742 __neg ; addrb748 rshift ; addrb74a lshift ; addrb774 ; addrb77d ; addrb782 streq ; addrb7a7 ; addrb7ab ; addrb7b1 length ; addrb7ce equal ; addrb7ff copystr ; addrb80a prefixst ; addrb824 ; addrb832 suffixst ; addrb84a decimal ; addrb852 ; addrb87e stoi ; addrb8e6 btohs ; addrb900 ; addrb946 hstob ; addrb9c2 ; addrb9c4 ; addrb9c7 ; addrb9d8 isalpha ; addrb9ee islower ; addrb9fa isupper ; addrba06 isdigit ; addrba10 ; addrba14 isdelim ; addrba24 ; addrba27 ; addrba2a ; addrba2d ishex ; addrba50 ; addrba58 hex ; addrba77 zupstr ; addrba79 ; addrba8d upper ; addrba9e zlostr ; addrbab4 lower ; addrbac3 ; addrbac5 ; addrbac8 ; addrbacb itos ; addrbb48 itohs ; addrbb68 copy ; addrbb97 ; addrbb9f ; addrbba7 tableloo ; addrbbe2 ; addrbbe6 ; addrbbf1 bankswi ; addrbc1f ; addrbc21 bankinit ; addrbc2d conbint ; addrbc4f ; addrbc66 ; addrbc67 ; addrbc69 ; addrbc75 spawn ; addrbcab suicide ; addrbcd0 filopen ; addrbd11 filclose ; addrbd51 ieeeOpen ; addrbd90 ; addrbd93 ; addrbd96 ; addrbdc0 ; addrbdc6 ; addrbdec ; addrbe23 ; addrbe4c ; addrbe53 ; addrbe5a ; addrbe5f ; addrbe6c ; addrbe6f ByteOut_ ; addrbeea ; addrbefb ; addrbf4b ; addrbf7c ; addrbf85 ; addrbf98 ; addrbfef ; addrc000 ; addrc06b ; addrc072 SetLstnr ; addrc0d0 UNListen ; addrc0dd SetTalkr ; addrc10d ; addrc137 SetFin_ ; addrc139 ; addrc13c UNTalk_ ; addrc147 CMDFin_ ; addrc14f ATNDown_ ; addrc16e ATNUp_ ; addrc176 EOIDown_ ; addrc17e EOIUp_ ; addrc184 EOISet_ ; addrc188 IEEEInit ; addrc1c4 ; addrc1db ; addrc1de ; addrc1e1 request ; addrc1f5 sysioini ; addrc244 sysopen ; addrc2a5 sysclose ; addrc2d8 sysread ; addrc451 sysread2 ; addrc458 sysread3 ; addrc483 sysread4 ; addrc4bb sysread5 ; addrc4cd sysread6 ; addrc4d2 sysread7 ; addrc4f2 ; addrc4ff ; addrc50a ; addrc51d ; addrc526 ; addrc52c syswrite ; addrc666 ; addrc669 outbyte ; addrc6ba keyoutb ; addrc6c3 outbytrt ; addrc6c6 sysnl ; addrc6e7 ; addrc6ff ; addrc773 ; addrc78e ; addrc793 ; addrc79a ; addrc7a7 ; addrc7b9 ; addrc7c1 ; addrc7c6 ; addrc7e6 ; addrc7f4 ; addrc7f7 sysskip ; addrc843 sysskprt ; addrc846 sysseek ; addrc8bc pop4 ; addrc8bf norandom ; addrc8c9 sysscrat ; addrc90a sysrenam ; addrc957 ; addrc95f ; addrc961 ; addrc963 sysmount ; addrc9a0 ; addrc9a3 ; addrc9a5 getacmod ; addrc9d6 geterror ; addrca12 ; addrca15 chekcod2 ; addrca20 chekcod1 ; addrca29 setret ; addrca31 pop2 ; addrca34 crtinit1 ; addrca57 msginvac ; addrca66 msg50 ; addrca69 msgtrunc ; addrca73 msgnornd ; addrca7e msgnosup ; addrca8c msginvmd ; addrca99 sysdirop ; addrcaea sysdirrd ; addrcb8b dohstdir ; addrcb98 sysdircl ; addrcbc5 pop4a ; addrcbc8 msgspace ; addrcbca msgalpha ; addrcbda init2400 ; addrcc13 hstopen ; addrcce3 ; addrcce6 hstwrbuf ; addrcd26 hstendln ; addrcd57 ; addrcd5a hstread ; addrcda6 ; addrcdc2 hstestfl ; addrcdd6 ; addrcddc hstrlsfl ; addrcdec ; addrce0b hstcheck ; addrce16 hstsndob ; addrce4b hstrdob ; addrce66 hsttobuf ; addrce8b hstfrmbf ; addrcebe hstrqust ; addrcef6 ; addrcef9 hstseek ; addrcf2a ; addrcf3d ; addrcf49 hstclose ; addrcf64 hstscr ; addrcf71 ; addrcf85 hstrenam ; addrcf92 ; addrcfa4 ; addrcfbd ; addrcfd0 hsrdirop ; addrcfdd ; addrcfef hstdirrd ; addrd00e ; addrd02a ; addrd02d ; addrd032 hstdircl ; addrd03c ; addrd03f ; addrd047 userchek ; addrd051 ; addrd054 syscheck ; addrd06a ; addrd075 ; addrd07b ; addrd081 hstemsg ; addrd086 ; addrd09a ; addrd09c ; addrd09f emptybuf ; addrd0aa ; addrd0ab hstsend ; addrd0b3 ; addrd0b9 ; addrd0e4 ; addrd119 ; addrd11c hstvrify ; addrd124 ; addrd12a ; addrd153 ; addrd179 hstrdlin ; addrd18c ; addrd18f ; addrd192 hstsndwt ; addrd1a6 ; addrd1b3 ; addrd1b6 hstwtpmt ; addrd1bc ; addrd1e6 ; addrd23c ; addrd23f hstchksm ; addrd245 ; addrd275 ; addrd27b msghex ; addrd28c ieeopen ; addrd2b3 ; addrd2bd ; addrd2c5 ; addrd2cc ; addrd2db ; addrd2fa ; addrd2fd ; addrd2ff ; addrd308 ; addrd31d ; addrd331 ; addrd33b ; addrd33c ; addrd351 ; addrd375 ; addrd37b ; addrd398 ; addrd3a2 ; addrd3af ; addrd3b7 ; addrd3bf ; addrd3c2 ; addrd3c6 ; addrd3d6 ; addrd3de ; addrd3ee ; addrd3f8 ; addrd3fb ; addrd3fd ; addrd400 ; addrd403 ; addrd406 initfcbs ; addrd412 asignfcb ; addrd41b ; addrd42e ; addrd442 ; addrd45a ; addrd466 ; addrd475 ; addrd47f ; addrd483 freefcb ; addrd490 ; addrd49e ; addrd4aa ; addrd4bb ; addrd4be ; addrd4cc tioinit ; addrd4d2 tgetchr ; addrd4f0 tputchr ; addrd500 tgetcurs ; addrd509 tputcurs ; addrd518 tbreak ; addrd521 tsetchar ; addrd539 tsetcha1 ; addrd53c tab_baud ; addrd55c sioinit ; addrd598 sputchr ; addrd5bb sgetchr ; addrd5dc leas3ret ; addrd5df srdport ; addrd628 srdport1 ; addrd62e sbreak ; addrd63a crtinit ; addrd695 TSETASCI ; addrd69c TSETAPL ; addrd6a3 TSETVIA ; addrd6a7 TRMGETCH ; addrd709 TRMGETC1 ; addrd714 TERMPUTC ; addrD721 TRMDORGT ; addrd729 TRMDOUP ; addrd731 TRMDODEL ; addrD743 TRMDOLFT ; addrd74b TRMDOHOM ; addrd74d TMOVECSR ; addrd750 TRMNOP ; addrd751 TERMOUTC ; addrd77a tputcdo ; addrd793 tcalcurs ; addrd7be tputcur1 ; addrd7e3 tabset ; addrd814 tabset1 ; addrd817 tabget ; addrd81b TRMCHOUT ; addrd828 DOAPLOVR ; addrd83c DOAPLOV1 ; addrd872 TRMDOCR ; addrD887 TRMDODWN ; addrd88d MOVECSR ; addrd8fd MOVECSR1 ; addrd945 TRMDOTAB ; addrd9a9 TRMDOCLR ; addrd9de TRMDOINS ; addrda4d MOVCSR_1 ; addrda53 TRMDODL ; addrdb30 TRMDOEOL ; addrdb92 MOVCSR_2 ; addrdb98 ; addrdc1f ; addrdc30 ; addrdc45 ; addrdc4a TRMDSPTB ; addrdd48 ; addrdd75 ; addrdd82 kbdread ; addrdda7 ; addrddad kbdwrite ; addrddd8 dotbreak ; addrde01 kbenable ; addrde07 kbdisabl ; addrde0b sysirq ; addrde6d ; addrde70 ; addrde7b ; addrde7d ; addrde80 MAPKEY ; addrdea7 ; addrdecd ; addrdef3 SCANKEYB ; addrdf3f -- Data byte (-1) ; addrdf40 MAPKYASC ; -- Data table ; addrdfe2 MAPKYAPL ; -- Data table ; addre084 APLOVER ; -- Data table ; addre0bd CRTREGS ; -- Data table ; addre0cf ; addre0d0 ; addre0d1 ; addre0d5 ; addre0da ; addre0f4 settime ; addre107 setdate ; addre109 ; addre13c gettime ; addre14d ; addre158 getdate ; addre15f passthru ; addre168 ; addre17d ; addre191 ; addre1aa ; addre1c4 ; addre1c7 sysnextp ; addre1e9 ; addre1ee chkfname ; addre226 ; addre23b ; addre243 ; addre252 ; addre276 ; addre27f ; addre28a ; addre299 ; addre29e ; addre2a2 ; addre2a7 ; addre2af ; addre2b5 ; addre2b8 ; addre2de ; addre2eb ; addre2ee chkdirpm ; addre312 ; addre31a ; addre337 ; addre352 ; addre359 ; addre364 ; addre367 ; addre373 chkdevnm ; addre3d1 chkieedv ; addre404 ; addre408 chkieesa ; addre442 ; addre444 chkdskdr ; addre46d ; addre473 ; addre476 invfname ; addre47d chddevcd ; addre4b1 ; addre4b9 ; addre4c6 chkrcdsz ; addre4df ; addre56a ; addre56d ; addre570 ieegetsa ; addre57a ; addre5b6 ; addre5b9 ieedname ; addre623 ; addre675 ; addre6bd ; addre6c0 ; addre6d5 ; addre6ea ; addre6f1 ; addre6ff ; addre702 ; addre705 ; addre713 ; addre724 ; addre731 ; addre738 ; addre73b ; addre73e ; addre743 ; addre748 ; addre756 ; addre765 ; addre768 ; addre76b usrhook_ ; addre77a ; addre7c6 ; addre7d7 ; ; addrf000 restart1 ; addrf020 monitor_ ; addrf03d msgbadrq ; addrf05c ; addrf0cd ; addrf11b ; addrf120 ; addrf123 STR_WATL ; addrf13d ; addrf13f cm_bank ; 'b' command ; addrf153 ; addrf15d cm_clear ; 'c' command ; addrf160 cm_clea1 ; addrf184 cm_dump ; 'd' command ; addrf1bd ; addrf1c0 ; addrf24e ; addrf250 ; addrf256 ; addrf25a ; addrf25c ; addrf25f ; addrf261 ; addrf264 cm_fill ; 'f' command ; addrf2a2 cm_go ; 'g' command ; addrf303 cm_load ; 'l' command ; addrf394 ; addrf39a ; addrf39e ; addrf3f2 ; addrf3fb ; addrf41b ; addrf41d ; addrf431 ; addrf443 ; addrF458 cmd_mod ; 'm' command ; addrf499 ; addrF4B9 cmd_reg ; 'r' command ; addrf4bc ; addrf4c5 prtrgttl ; addrf4c8 ; addrf4cb prtregs ; addrf598 ; addrf59e ; addrF53E cmd_asmb ; addrf5a4 ; addrf5a7 str_5n ; addrf5aa str_regs ; addrf5d1 str_cln ; addrf5d3 str_5h0 ; addrf5d6 str_5h_ ; addrf5e8 ; addrf5f6 ; addrf5fd ; addrf60d ; addrf611 ; addrf617 ; addrf63e ; addrf640 ; addrf679 ; addrf67f ; addrf682 MONBREAK ; addrf6c2 ; addrf6d7 ; addrf6dd ; addrf6e0 str_intn ; addrF6EC dcodtb1 ; addrf718 dcodtb2 ; addrF748 dcodtb3 ; addrF77D dcodtb04 ; addrF7A5 dcodtb8b ; addrf7e5 dcodtbcf ; addrf825 TABINST ; addrf865 INST_ILL ; addrf86d ; addrf871 cmd_tran ; addrf8a1 ; addrf8a8 ; addrf8c3 ; addrf936 PRTILLIN ; addrf945 DISIMM8C ; addrf96a DISIMM_1 ; addrF96D DISDIR0C ; addrF96F DISDIR8C ; addrF977 DISEXT7 ; addrF979 DISEXT8C ; addrf982 PRMONBH1 ; addrf985 DISPRSPC ; addrF98B ; addrf98d DISIDX8C ; addrf9ec ; addrf9f4 ; addrfa00 ; addrfa09 ; addrfa0a ; addrfa0e ; addrfa17 ; addrfa20 ; addrfa27 ; addrfa2a ; addrfa41 ; addrfa48 ; addrfa4b ; addrfa55 ; addrfa5d ; addrfa74 ; addrfa7d ; addrfa84 ; addrfa87 ; addrfa9e ; addrfab0 ; addrfac5 ; addrfaea ; addrFAF2 ; addrfaf5 ; addrFAF8 DISDIR1 ; addrfb0b ; addrfb0f ; addrfb17 ; addrfb1d ; addrfb25 ; addrfb39 ; addrfb3f ; addrfb41 ; addrfb49 ; addrfb4c PRMONBHX ; addrfb59 GETMONBY ; addrfb73 ; addrfb9e ; addrfbac ; addrfbb5 ; addrfbc4 ; addrfbc9 ; addrfbd8 ; addrfbdb ; addrfc04 ; addrfc07 ; addrfc0a ; addrfc0d DISEXT11 ; addrfc52 BADEXT11 ; addrfc55 CPRINTF1 ; addrfc5a ; addrfc63 ; addrfc69 ; addrfc82 ; addrfc84 ; addrfc87 PRTDISOP ; addrfcab str_5h5h ; addrfcb2 str_bsr ; addrfcb6 str_qqqq ; addrfcbb str_5n ; addrfCBE str_34 ; addrfCC2 str__4 ; addrfCC5 str_spc ; addrfCC7 str_45h ; addrfCCB str_lbrk ; addrfCCd str_dol ; addrfCCf str_B ; addrfCD1 str_A ; addrfCD3 str_D ; addrfCD5 str_coma ; addrfCD7 str_dash ; addrfCD9 str_2dsh ; addrfCDC str_PCR ; addrfCE0 str_5c ; addrfCE3 str_plus ; addrfCE5 str_2pls ; addrfCE8 str_rbrk ; addrfCEA str_d25h ; addrfCF2 str_x25d ; addrfCF9 str_5h ; addrfCFC str_L ; addrfCFe str_CMPD ; addrfD03 str_CMPY ; addrfD08 str_LDY_ ; addrfD0D str_LDS_ ; addrfD12 str_STY_ ; addrfD17 str_STS_ ; addrfD1C str_CMPU ; addrfD21 str_CMPS ; addrfd26 mongethx ; read a hex byte from the command line ; addrfd60 ; addrfd66 mongthxd ; Get Hex data bytes ; addrfd9d mongthxc ; addrfdbd mondrain ; flush all remaining input ; addrfdc6 bad_cmd ; addrfdcc str_invc ; addrfdde INT_BRKP ; addrfe17 INT_RETB ; addrfe3c TBMONCMD ; addrfe74 moniniti ; addrfec5 DATENONE ; addrff80 RESET ; addrff97 CONBSET ; addrffa2 GEN_INT ; addrffae ACKIRQ ; addrffb1 RESETRTS ; addrffb2 DO_IRMOT ; Reserved by motorola ; addrffb4 DO_SWI3 ; SWI3 instruction interrupt vector ; addrffb6 DO_SWI2 ; SWI2 instruction interrupt vector ; addrffb8 DO_FIRQ ; Fast hardware interrupt vector (FIRQ) ; addrffba DO_IRQ ; Hardware interrupt vector (IRQ) ; addrffbc DO_SWI ; SWI Instruction interrupt vector ; addrffbe DO_NMI ; Non-maskable interrupt vector (NMI) BLANK EQU $20 ;Low Memory CONBTAB EQU $0100 CONBSWI3 EQU $0102 CONBSWI2 EQU $0104 CONBFIRQ EQU $0106 CONBIRQ EQU $0108 CONBSWI EQU $010A CONBNMI EQU $010C APLCHSET EQU $0128 ; 0 Indicates ASCII, $FF indicates APL CURSOR EQU $0122 ; This is the current cursor character location to blink MON_ADDR EQU $0170 ; Current address to process in the monitor NUMBREAK EQU 4 ; Number of supported breakpoints MONBRKA1 EQU $0176 ; Break point 1 address MONBRKA2 EQU $0178 ; Break point 2 address MONBRKA3 EQU $017A ; Break point 3 address MONBRKA4 EQU $017C ; Break point 4 address MONBRKD1 EQU $017e ; Break point 1 data byte MONBRKD2 EQU $017f ; Break point 2 data byte MONBRKD3 EQU $0180 ; Break point 3 data byte MONBRKD4 EQU $0181 ; Break point 4 data byte MON_SVPC EQU $0182 ; Program counter saved from current step MON_SV_D EQU $0184 ; D Register saved from current step MON_SV_X EQU $0186 ; X Register saved from current step MON_SV_Y EQU $0188 ; Y Register saved from current step MON_SV_U EQU $018a ; U Register saved from current step MON_SV_S EQU $018C ; S Register saved from current step MON_SVCC EQU $018e ; CC Register saved from current step MON_SVDP EQU $018f ; DP Register saved from current step MON_CNT EQU $0190 ; Number of bytes left to process in the monitor DISPMEM EQU $8000 DISPCOLS EQU 80 DISPROWS EQU 25 DISPSIZE EQU (DISPCOLS*DISPROWS) ; Types of interrupts for the CONBINT_ routine INT_SWI3 EQU 2 INT_SWI2 EQU 4 INT_FIRQ EQU 6 INT_IRQ EQU 8 INT_SWI EQU 10 INT_NMI EQU 12 ; Registers PIA1_R0 EQU $E810 PIA1_R1 EQU $E811 PIA1_R2 EQU $E812 PIA1_R3 EQU $E813 PIA2_R0 EQU $E820 PIA2_R1 EQU $E821 PIA2_R2 EQU $E822 PIA2_R3 EQU $E823 VIA_R0 EQU $E840 VIA_CSET EQU $E84C CRTC_R0 EQU $E880 CRTC_R1 EQU $E881 ACIA_R0 EQU $EFF0 ACIA_R1 EQU $EFF1 BANKSEL EQU $EFFC ORG $A000 sqr_ JMP sqr power_ JMP power exp_ JMP exp log_ JMP log atn_ JMP atn cos_ JMP cos sin_ JMP sin fload_ JMP fload fload2_ JMP fload2 fstore_ JMP fstore cnvfi_ JMP cnvfi fraction_ JMP fraction fzero_ JMP fzero exponent_ JMP exponent trflf2_ JMP trflf2 cnvif_ JMP cnvif fadd_ JMP fadd fadd2_ JMP fadd2 fsub_ JMP fsub fsub2_ JMP fsub2 fcmp_ JMP fcmp ftest_ JMP ftest fmul_ JMP fmul fmulby_ JMP fmulby fdiv_ JMP fdiv fdivby_ JMP fdivby fneg_ JMP fneg cnvs2f_ JMP cnvs2f cnvf2s_ JMP cnvf2s shiftl JMP fshiftl addacc JMP faddacc fmul10 JMP ffmul10 fdiv10 JMP ffdiv10 ffloor_ JMP ffloor faddhalf_ JMP faddhalf fcompare JMP ffcompar finteger JMP ffintgr ; ;convert a floating point number to an ascii text string ;parameter : D - Address of 20 byte buffer to put string ; FPAC1 contains the value to be converted ;returns : D - points to the last character in the converted string ;destroyed : FPAC1, X, FPAC2 cnvf2s TFR D,X ;point to area to save number LDA #BLANK ;assume positive for a leading space TST $80 ;get sign byte of FPAC1 IF MI ;negative? LDA #'-' ;use a leading minus sign CLR $80 ;and make the number positive ENDIF STA ,X ;output the character LEAX 1,X STX $8a ;save the output pointer LDA $81 ;get the mantissa IF EQ ;true zero? LDA #1 ;yes, one digit to output STA $88 CLR $89 ;and no leading decimal point ELSE CALLS cnvnorm ;non zero, 'normalize' it for output ENDIF ;at this point, we have the integer representation of the number ;in FPAC1, normalized between 100,000,000 and 999,999,999 with ;the number of decimal places in $89 and the number of digits in $88 CALLS cnvfac1 ;now that it looks right, output LDX $8a ;get the final output pointer CLR ,X ;and add a trailing null LDD $8a ;return the pointer to the last character in the stri RTS ;parameter : a - exponent of number to convert ; FPAC1 - floating number to convert ;returns : FPAC1 - integer representation of 'normalized' number. ; $88 - 'normalized' exponent ; $89 - number of places before decimal point cnvnorm CLRB ;no exponent offset CMPA #$80 ;is the number <= 1 IF LS LDX #billion ;yes x*1e9 CALL fmulbyx LDB #-9 ;and set exponent offset ENDIF STB $88 ;save exponent offset ;now normalize between 100,000,000 and 999,999,999 LOOP LDX #bilmione ;compare to 999,999,999 CALL ffcompar BEQ cnvtoint ;if equal, got it, convert it IF MI ;-- ;too small? LOOP ;yes, keep multiplying until too large LDX #hmmitnth ;compare to 100,000,000 CALL ffcompar IF NE ;larger than it finally? BPL roundit ;yes, round it up ENDIF CALL ffmul10 ;no multiply by 10 and try again DEC $88 ;keep track with exponent offset ENDLOOP ENDIF CALL ffdiv10 ;larger than 999,999,999 so divide by 10 INC $88 ;and track exponent offset ENDLOOP roundit CALL faddhalf ;add .5 for rounding cnvtoint CALL ffintgr ;convert the floating number to an integer LDB #1 ;assume decimal point at start LDA $88 ;get the exponent offset ADDA #13 ;will the decimal point appear in 13 digits of output IF PL ;possibly on the low end CMPA #14 ;high enough? IF CS ;yes SUBA #4 ;offset -4 TFR A,B ;for the decimal point place LDA #5 ;set the new exponent offset to be canceled out ENDIF ENDIF SUBA #5 ;exponent+13-5=exponent-8 or number of places on outp STA $89 ;save exponent STB $88 ;and decimal point location RTS ; ;parameter : FPAC1 contains integer representation of number ; $88 = exponent offset n>0 decimal point n places from left ; n<0 -n leading zeros ; $89 = 'normalized' exponent. 0 implies no exponent part on outp ; $8a = address of area to put string ;returns : $8a points to last character in converted string ;destroyed : FPAC1, X, D cnvfac1 LDA $88 ;get decimal point position DECA IF MI ;-- ;in first position? LDX $8a ;point to output area LDA #'.' ;put a decimal point STA ,X LEAX 1,X LDA #'0' ;now see how many leading zeros to put LDB $88 ;get count LOOP QUIF EQ ;no more, quit STA ,X ;put a zero LEAX 1,X INCB ;and decrement count ENDLOOP STX $8a ;save output pointer ENDIF LDX #dectable ;point to decimal conversion table ;in converting, just keep adding the table entry until it underflows ;or overflows the current value. alternating negative and positive ;values handle the overflow/underflow without necessity of an addback LOOP LDA ,X ;test sign of conversion value IF PL ;positive ones go here LDA #10 ;start at ten LOOP DECA ;decrement count CALLS addecac1 ;and add the current entry UNTIL CS ;until it over flows ELSE ;negative ones are done here LDA #-1 ;start at minus 1 LOOP INCA ;increment count CALLS addecac1 ;and add current negative value UNTIL CC ;until it under flows ENDIF ADDA #'0' ;convert count to character LEAX 1,X ;point to next table entry LEAX 1,X LEAX 1,X LEAX 1,X PSHS X LDX $8a ;get output pointer STA ,X ;output the character LEAX 1,X DEC $88 ;time to put a decimal point? IF EQ LDA #'.' ;yes, so put one out STA ,X LEAX 1,X ENDIF STX $8a ;save the output pointer PULS X CMPX #bilmione ;until we have processed all table entries UNTIL EQ LDB $89 ;get the exponent IF NE ;need to print it? CALLS cnvexpon ;yes, so do so ENDIF RTS ;add the table entry pointed to by x to the current integer value in FPAC1 addecac1 PSHS A ;preserve contents of a LDD $84 ;add lower oeder two bytes ADDD 2,X STD $84 LDD $82 ADCB 1,X ;add carry and high order two bytes ADCA ,X ;don't lose the carry, return it to the caller STD $82 PULS A ;and restore contents of a RTS ;parameter : b - exponent ; $8a - address to place output cnvexpon LDA #'E' ;append the 'e' LDX $8a ;get the output pointer STA ,X LEAX 1,X LDA #'+' ;add the positive TSTB IF MI ;-- LDA #'-' ;or negative sign NEGB ENDIF STA ,X ;to the exponent field LEAX 1,X LDA #'0-1 ;load a test output first digit exponent LOOP INCA ;increment exponent character SUBB #10 ;and decrement exponent by 10 UNTIL MI ;until we underflow STA ,X ;output the character LEAX 1,X ADDB #'0+10 ;convert the rest of the exponent STB ,X ;and output it LEAX 1,X STX $8a ;save the output pointer RTS dectable FCB $fa,$0a,$1f,$00 ;-100000000 FCB $00,$98,$96,$80 ; 10000000 FCB $ff,$f0,$bd,$c0 ;-1000000 FCB $00,$01,$86,$a0 ; 100000 FCB $ff,$ff,$d8,$f0 ;-10000 FCB $00,$00,$03,$e8 ; 1000 FCB $ff,$ff,$ff,$9c ;-100 FCB $00,$00,$00,$0a ; 10 FCB $ff,$ff,$ff,$ff ;-1 bilmione FCB $00,$9e,$ee,$6b,$27,$fd ;1e9-1 internal format = 999,999,999 hmmitnth FCB $00,$9b,$be,$bc,$1f,$fd ;1e8 internal format = 100,000,000 billion FCB $4f,$6e,$6b,$28,$00 ;1e9 ; ;convert a string to its floating point representation ;parameter : d - points to the start of the string ; top of stack - points to the end of the string ;returns : d - points past last character converted ; FPAC1 contains the converted number ;destroyed : FPAC2, X, $88, $89, $8a/b, $8c/d, cnvs2f STD $8a ;save start of string TFR S,X LDD 2,X ;get end of string STD $8e CALL fzero ;start with a zero accumulator CLR $88 ;no digits to right of decimal point CLR $89 ;no exponent CALL chkdigtx ;get the first character CALL skipspcs ;ignore leading blanks CALLS tstfsign ;and see if it was a leading sign TFR A,B ;save flag LOOP CALL tstdigit ;get the next character IF CS ;a digit? TSTB ;yes, have wee seen a decimal point? IF MI ;-- INC $88 ;increment our count of digits ENDIF PSHS B ;save flags SUBA #'0' ;convert character to binary PSHS A ;and save CALL ffmul10 ;multiply current total by ten CALL trflf2 CLRA PULS B ;get the number to add TSTB IF NE ;non zero? CALL cnvif ;convert it to floating point CALL fadd ;and add to the running total ENDIF PULS B ;restore flags ELSE CMPA #'.' ;decimal point? IF EQ EORB #$80 ;yes set/reset flag BPL endnumbr ;quit on multiple occurances ELSE CALL skipspcs ;not a digit or decimal point, ignore blanks ORA #$20 ;convert to lower case CMPA #'e' ;is it the exponent designation? BNE endnumbr ;no, get out of here CALLS getexpon ;convert the exponent BRA endnumbr ;and leave ENDIF ENDIF ENDLOOP endnumbr PSHS B ;save flags LDA $89 ;get current exponent SUBA $88 ;offset by number of digits to right of decimal STA $89 ;and save as the new exponent IF MI ;-- ;adjust value down? LOOP CALL ffdiv10 ;x/10 INC $89 ;increment temporary exponent UNTIL EQ ;until we have what we want ENDIF IF NE ;otherwisr adjust up LOOP CALL ffmul10 ;x*10 DEC $89 ;decrement temporary exponent UNTIL EQ ;until all is done ENDIF PULS B ;get the flags BITB #$01 ;leading mnus sign given? IF NE CALL fneg ;yes, negate final result ENDIF LDD $8c ;get final input pointer RTS tstfsign CMPA #'-' ;negative? IF EQ LDA #$01 ;set flag ELSE SUBA #'+' ;positive? IF NE ;no, put the character back to be seen again CALLS getunget CLRA ENDIF ENDIF RTS getexpon LDX $8c ;get current input pointer PSHS X ;and save CALLS tstdigit ;get the next character CALLS tstfsign ;sign specified? IF NE ;yes, set flag if negative ORB #$02 ENDIF PSHS B ;save flags CALLS tstdigit ;get the next character IF CS ;number? LOOP SUBA #'0' ;convert to binary LDB $89 ;old exponent value LSLB ;old*2 LSLB ;old*4 ADDB $89 ;old*4+old=old*5 LSLB ;old*10 STB $89 ADDA $89 ;add new value STA $89 CALLS tstdigit ;and get the next character UNTIL CC ;until we run out of numbers ORCC #$01 ;set the carry ENDIF PULS B ;restore flags PULS X ;get original pointer IF CC ;proper conversion? STX $8c ;no restore original pointer ELSE BITB #2 ;exponent negative? IF NE NEG $89 ;yes, negate it ENDIF ENDIF RTS tstdigit LDX $8a ;get input pointer LEAX 1,X ;point to next STX $8c ;and save tstdigtx LDX $8A ;get input pointer CLRA CMPX $8e ;past end of input string? IF NE ;no LEAX 1,X ;point to the next character STX $8a ;and save pointer chkdigtx LDX $8a ;get the input pointer CLRA CMPX $8e ;past end of string? IF NE LDA ,X ;no, get the next character CMPA #'9+1 ;is it a digit? IF CS ;low enough, is it high enough SUBA #'0 ;do a round about way to set the condition SUBA #256-'0 ;code without changing the value ENDIF ENDIF ENDIF RTS getunget LDX $8a ;get the current pointer LEAX -1,X ;and move it back one STX $8a RTS skipspcs LOOP CMPA #BLANK ;is it a space QUIF NE ;no, let them use it CALLS tstdigtx ;yes, skip it and get the next ENDLOOP RTS maxreal FCB $7f,$ff,$ff,$ff,$ff ;1e+38 overflow LDA #2 STA $87 floadmax LDD #maxreal ; ; MODULE : fload/floadx ; PURPOSE : load a floating point number into FPAC1 ; PARAMETERS : address of 5 byte floating point number ; RETURNED : CC reflecting ZERO/NON ZERO value loaded ; REGISTERS DESTROYED : X ; MEMORY REFERENCED : $80-$85 Floating point accumulator 1 ; fload TFR D,X ;point to parameter floadx LDD 3,X ;move low order 4 bytes(mantissa) STD $84 LDD 1,X STD $82 LDB ,X ;get high order byte(exponent&sign) CLRA STA $86 ;clear low byte of mantissa LSL $82 ;get low order byte of exponent ROLB ;sign extend the exponent IF CS COMA ENDIF STD $80 ;save sign and exponent TSTB IF NE ;set cc to reflect current exponent ORCC #$01 ENDIF ROR $82 ;restore high order byte of mantissa RTS ; ; module : fload2/fload2x ; purpose : load fpac2 ; parameters : address of floating point number ; returned : cc reflecting zero/non zero value loaded ; registers destroyed : x ; memory referenced : $90-$96 FPAC#2 ; fload2 TFR D,X fload2x LDD 3,X STD $94 LDD 1,X STD $92 LDB ,X CLRA STA $96 LSL $92 ROLB IF CS COMA ENDIF STD $90 TSTB IF NE ORCC #$01 ENDIF ROR $92 RTS ; ; routine : fstore ; parameters : D register points to area to store floating point ; value present in the floating point accumulator at $0080 ; registers destroyed: X ; fstore TFR D,X ;put address in a pointer register fstorex CALL chkguard ;round it properly for storing LDD $84 ;get the low order byte of the mantissa STD 3,X ;and store it LDD $82 ;get the high order byte of the mantissa STD 1,X ;store it LDA $81 ;get the exponent STA ,X ;and save it LSL 1,X ASR $80 ;get the sign ROR ,X ;save it ROR 1,X ;and shift the rest of the exponent in RTS ;convert the floating point value in FPAC1 to it's integer representation ;parameter : FPAC1 - floating value to convert ;returns : FPAC1 - converted value ; D - Converted value cnvfi LDA $81 ;get the exponent CMPA #$81 ;value < 1 IF CS ;yes CLRA ;converted value = 0 CLRB ELSE CMPA #$8f ;value > 32768? IF HI ;yes LDA #2 ;set overflow flag STA $87 LDD $82 ;and just get whatever is there ELSE ;value is in range, so convert it LOOP ;normalize the number LSR $82 ;value/2 ROR $83 INCA ;increment our exponent value CMPA #$90 ;until we have 16 bits of significance UNTIL EQ LDD $82 ;get the converted value TST $80 ;check the sign bit IF MI ;-- ;convert to two's compliment if necessary COMA COMB ADDD #1 ENDIF ENDIF ENDIF RTS ;removes any non fractional parts from the number in FPAC1 ;parameter : FPAC1 - floating point number ;returns : FPAC1 - fractional part of original number fraction LDA $81 ;get the exponent CMPA #$a0 ;any fractional part in the current number? IF CC ;not in the slightest CALLS fzero ;so the fractional part is 0 ELSE ;otherwise, shift out the non fractional parts LOOP LDA $81 ;get the current exponent CMPA #$80 ;is the number <0 QUIF LS ;yes, we've done it CALL fshiftl ;no, shift it left one bit DEC $81 ;and adjust the exponent ENDLOOP CALL normaliz ENDIF CLRA LDB $81 RTS ; routine : exponent ; parameters : none ; returns : exponent of the present value in the floating point ; accumulator in the D register exponent CLRA LDB $81 IF NE ;not absolute zero? SUBB #$81 ;convert to integer format IF CS DECA ;make it two's complement ENDIF ENDIF ADDD #0 ;set the zero flag if necessary RTS ; ;multiply a number by ten ;parameter : FPAC1 - value ;returns : FPAC1 - value*10 ;destroyed : FPAC2 ffmul10 CALLS trflf2 ;copy the value IF EQ ;zero? BRA mul10ret ;yes, we're done ENDIF GUESS LDA $81 ;get the exponent ADDA #2 ;+2 to multiply value*4 QUIF CS ;if too large, overflow STA $81 ;save it CALL fadd ;add value again to get value*5 INC $81 ;exponent+1 to make value*10 QUIF EQ ;too large, then overflow ADMIT JMP overflow ;set the overflow flag and reload FPAC1 ENDGUESS mul10ret RTS ; ;transfer the contents of FPAC1 to FPAC2 ;parameter : FPAC1 - value ;returns : FPAC2 - transfered value, rounded up as necessary ; CC - sign of MANTISSA reflecting value of transferred number trflf2 CALL chkguard ;make sure we can drop the guard bits. qktrflf2 LDD $85 ;transfer low order bytes STD $95 LDD $83 ;transfer middle bytes STD $93 LDA $80 ;transfer sign STA $90 LDD $81 ;get exponent STD $91 RTS ; ;convert an integer to floating point representation ;parameter : D - value to convert ;returns : FPAC1 - converted value ;destroyed : X cnvif CALLS fzero ;start with a clean accumulator STD $82 ;put number to convert into the mantissa IF NE ;value non zero? IF MI ;-- ;negative? CALLS compfac1 ;yes, compliment FPAC1 ENDIF LDA #$90 ;set exponent to indicate value STA $81 CALL normaliz ;and normalize the accumulator ENDIF RTS ; ;accumulator underflow, set it to zero ;parameter : none ;returns : FPAC1 set to 0, error flag $87 set to overflow ;destroys : X underflo LDA #1 ;set the overflow flag STA $87 fzero LDX #0 STX $80 ;clear sign and exponent STX $82 ;and the mantissa STX $84 STX $85 RTS ; ;negate the value in FPAC1 ;parameter : FPAC1 - value ;returns : FPAC1 - negative value compfac1 COM $80 ;negate the sign COM $82 ;and the mantissa COM $83 COM $84 COM $85 NEG $86 ;negate the guard bits IF EQ ;any cleared? CALLS froundup ;yes, round up the accumulator ENDIF RTS ; ;remove any guard bits set ;parameter : FPAC1 - value ;returns : FPAC1 - rounded value without any guard bits set kilguard CALLS froundup ; IF EQ ;any overflow CALL rshiftac ;yes, normalize the accumulator ENDIF RTS ; ;module : froundup ;purpose : rounds FPAC #1 up to 4 mantissa bytes of precision ;parameters : none ;returned : CC reflecting overflow froundup INC $85 ;we rounded up, add 1 to low order byte IF EQ INC $84 ;and those above as needed IF EQ INC $83 IF EQ INC $82 ;remember to save the overflow ENDIF ENDIF ENDIF RTS ; ;module : fcmp ;purpose : compares contents of fpac1 and fpac2 ;parameters : FPAC1, FPAC2 - values ;returned : cc=eq(FPAC1=FPAC2) lt(FPAC1FPAC2) ;destroys : X fcmp LDX #$0090 ;point to fpac2 ffcompar LDA $80 ;get sign byte CMPA ,X IF NE ;same? TSTA ;no, which is lower? IF EQ LDB #1 ;FPAC2 ELSE LDB #-1 ;FPAC1 ENDIF ELSE GUESS ;compare the mantissas LDA $81 CMPA 1,X QUIF NE LDD $82 SUBD 2,X QUIF NE LDD $84 SUBD 4,X QUIF NE ADMIT LDA $80 ;mantissas don't match, check signs again. IF CS ;don't forget borrow before COMA ENDIF IF EQ ;who is lower? LDB #1 ;FPAC2 ELSE LDB #-1 ;FPAC1 ENDIF ENDGUESS ENDIF RTS ; ; module : ftest ; purpose : test contents of FPAC1 ; parameters : FPAC1 - value ; returned : CC = relationship to zero ; registers destroyed : none ; memory referenced : $80-$81 FPAC1 ftest LDB $80 ;get the sign LDA $81 ;and mantissa IF NE ;non zero? LDA $80 ;yes, test sign IF EQ ;positive? INCB ;yes, set the appropriate flags ENDIF ENDIF RTS half FCB $40,$00,$00,$00,$00 ;.5 ; ;subtract value from FPAC1 ;parameter : FPAC1 - value to subtract from ; for FSUB2 : D - address of value to subtract ; for FSUB : FPAC2 - value to subtract ;returns : FPAC1 - result ;destroys : FPAC2, X ;method : add the negation of the value to subtract to the original value fsub2 TFR D,X ;point to value to subtract CALL fload2x ;and load it into the accumulator fsub COM $90 ;negate the value in FPAC2 BRA fadd ;and add it. ; ;add value to FPAC1 ;parameter : FPAC1 - value to add to ; for fadd2 : D - address of floating point value to add ; for faddX : X - address of floating point value to add ; for faddhalf : none ; for fadd : FPAC2 - value to add ;returns : FPAC1 - result ;destroys : X, FPAC2 fadd2 CALL fload2 ;load the value into the FPAC2 BRA fadd ;and add it faddhalf LDX #half ;get address of .5 faddx CALL fload2x ;load value into FPAC2 fadd LDA $91 ;get the exponent of the value to add IF NE ;non zero? LDB $81 ;get exponent of FPAC1 SUBB $91 ;compare to that of FPAC2 IF NE ;do we have to adjust one? IF HI ;yes, which one? LDX #$0090 ;FPAC2 to the right ELSE NEGB ;negate the difference STA $81 ;and save as the new exponent LDX #$0080 ;and FPAC1 goes to the right ENDIF CMPB #40 ;will we be shifting everything out? IF HI LDB #40 ;yes, so only shift that far ENDIF CALL shiftacc ;now shift the accumulators ENDIF LDA $80 ;get sign of FPAC1 CMPA $90 ;and of FPAC2 IF EQ ;are they the same? CALL faddacc ;yes, add the two directly CALL rotateac ;and preserve any carry from the add ELSE CALL fsubacc ;different signs, so subtract the two IF CS ;result negative? CALL compfac1 ;yes, compliment the accumulator ENDIF ENDIF ENDIF ;normalize the value in FPAC1 normaliz CLRA ;count of number of shifts LOOP LDB $82 ;get the high order byte of the mantissa QUIF MI ;when set, its normalized IF EQ ;high byte have anything in it? PSHS A ;save the shift count LDD $83 ;shift left a full byte STD $82 LDD $85 STD $84 CLR $86 ;zero out low order byte PULS A ;restore count ADDA #8 ;increment to reflect the number of shifts CMPA #32 IF EQ ;have we shifetd out all significance LDA $81 ;get the current mantissa BRA chkrange ;and quit ENDIF ELSE CALLS fshiftl ;shift everything left one bit INCA ;and increment the shift count ENDIF ENDLOOP ;parameter : A - number of shifts done chkrange SUBA $81 ;subtract the current mantissa IF CC ;is the result insignificant? CALL fzero ;yes, set it to zero ELSE NEGA ;no, set the proper mantissa STA $81 ENDIF RTS ; ;remove any guard bits in fpac1 to prepare it for saving ;parameter : FPAC1 - value to check ;returns : FPAC1 - value with no guard bits set ;destroyed : X only if the final result is zero chkguard TST $81 ;get the mantissa IF NE ;value non zero? LSL $86 ;test high bit of mantissa guard byte IF CS ;set? CALL kilguard ;yes, remove it and adjust FPAC1 ENDIF ENDIF CLR $86 ;clear the guard bit RTS ; ;shift FPAC1 mantissa left one bit ;parameter : FPAC1 - value ;returns : FPAC1 - shifted value ; CC - carry indicating bit shifted out of high order position fshiftl ANDCC #$fe ;clear the carry flag ROL $86 ;rotate the mantissa left ROL $85 ROL $84 ROL $83 ROL $82 ;returning the final carry bit RTS ; ;multiply FPAC1 by a value ;parameter : FPAC1 - value to multiply ( multiplicand ) ; for fmulby : D - address of multiplier ; for fmulbyx : X - address of multiplier ; for fmul : FPAC2 - multiplier ;returns : FPAC2 - result ;destroys : FPAC2, X fmulby TFR D,X fmulbyx CALL fload2x fmul LDA $91 ;get exponent of multiplier IF EQ ;zero? JMP fzero ;yes, set result to zero ENDIF CALLS chkmulrg ;check the values. ; if we return here, then the values are ok. LDB #5 ;number of bytes in mantissa LDX #$0082 ;address of start of mantissa LOOP ;stack all the bytes of the mantissa with low order on LDA ,X ;get the next byte PSHS A ;save it CLR ,X ;erase where it was LEAX 1,X ;point to the next oue DECB ;decrement byte count UNTIL EQ ;until they are all stacked LDX #$0080 ;point to FPAC1 PULS B ;get low order byte CALLS fmulbyte ;multiply FPAC1 by it PULS B ;and so on of all 5 bytes CALLS fmulbyte PULS B CALLS fmulbyte PULS B CALLS fmulbyte PULS B CALLS fmulbyte JMP normaliz ;now normalize the result ; ;multiply FPAC2 by a byte, adding the result to an area ;parameter : X - address of running total ; B - byte to multiply FPAC2 by (factor) ; FPAC2 - value to be multiplied and added to FPAC1 ;returns : FPAC1 - result fmulbyte TSTB ;is the factor zero? IF EQ LDB #8 ;yes, shift the result area right 8 CALL shiftacc ELSE ;standard algorithm: shift right, add value when bit is set LSRB ;shift out low order bit of factor ORB #$80 ;and set high order bit to ensure we go 8 times LOOP IF CS ;do we need to add? CALL faddacc ;yes, do so ENDIF ROR 2,X ;shift result area right one bit ROR 3,X ROR 4,X ROR 5,X ROR 6,X LSRB ;get next bit of factor UNTIL EQ ;until we have done all 8 ENDIF RTS ; ;check the range of two multiplicands ;parameter : FPAC1, FPAC2 - address of two multiplicands ;returns : to caller if values are ok ; otherwise calls appropriate error routines and returns ; to the caller's caller. ;destroys : X chkmulrg LDA $81 ;get the exponent of FPAC1 IF NE ;FPAC1 = 0? LDB $90 ;no, check sign of FPAC2 IF NE ;negative? COM $80 ;yes, then FPAC1's sign will switch ENDIF LDB $80 ;duplicate the signs for both accumulators STB $90 ADDA $91 ;compare two exponents IF CS ;overflow? IF MI ;-- ;too large? PULS X ;yes, remove return address CALL overflow ;overflow FPAC1 LDB $90 ;and set the proper sign STB $80 RTS ;return to caller's caller ENDIF ELSE IF PL ;sign bit swapped? PULS X ;yes, remove return address JMP underflo ;and underflow FPAC1 ENDIF ENDIF ADDA #$80 ;ok, calculate final exponent STA $81 ;and save it ELSE PULS X ;final result will be zero, which we have, so leave ENDIF RTS ; ;divide FPAC1 by a value ;parameter : FPAC1 - dividend ; for fdivby : d - address of divisor ; for ffdiv10 : none ; for fdivx : x - address of divisor ; for fdiv : FPAC2 - divisor ;returns : FPAC1 - result ;destroys : FPAC2, X fdivby CALL fload2 ;load the value BRA fdiv ;and let div do the work ten FCB $42,$20,$00,$00,$00 ;1e1 = 10 ffdiv10 LDX #ten ;point to a representation of 10 fdivx CALL fload2x ;load the value fdiv LDA $91 ;get exponent of divisor IF EQ ;division by zero? LDA #3 ;yes set error flag STA $87 LDA $80 ;get sign of current value PSHS A CALL floadmax ;load infinity (or equivalent) PULS A ;and restore the sign STA $80 RTS ;and return ENDIF CALL chkguard ;clear any guard bits set NEG $91 CALLS chkmulrg ;make sure that it is within range INC $81 ;make sure result will fit IF EQ CALL overflow ;over flow the value LDB $90 ;and restore the sign STB $80 ENDIF LDB #1 ;set bit flag to tell when result byte is filled LDX #4 ;set count of number of bytes to divide ;this is basically a subtract until no more room to subtract loop ;with the result bytes pushed onto the stack as they are filled up LOOP CALLS chkdivac ;compare the two accumulators LOOP LOOP TFR CC,A ;save result of the compare ROLB ;and put the carry into the result byte IF CS ;result byte filled up? PSHS B ;yes, save it LEAX -1,X ;decrement the byte division count IF EQ ;done? LDB #$40 ;yes, set flag to gather 2 more bits ELSE LEAX 1,X ;no, are we past done BEQ divend ;YES, cleanup LEAX -1,X ;no, restore the byte division count LDB #1 ;and setup to collect 8 more bits ENDIF ENDIF TFR A,CC ;restore result of the compare IF CS ;should we subtract FPAC2? CALL fsubacc ;yes, do so ENDIF CALL fshiftl ;shift FPAC1 left UNTIL CC ;until we shift something out UNTIL MI ;or we can still subtract it ENDLOOP divend PULS B ;get the guard bit LSRB ;and fix it up RORB RORB PULS A ;as well as the low order byte of mantissa STD $85 PULS B ;get middle bytes PULS A STD $83 PULS A ;and high order byte STA $82 JMP normaliz ;then normalize the result ; ;compare the two floating point accumulators to see if we can ;subtract FPAC2 from FPAC1 without a borrow. ;parameter : FPAC1, FPAC2 - values ;returns : carry bit set to 1 if subtraction can be done chkdivac LDA $92 ;compare high order bytes CMPA $82 ;remember carry is set correctly if they don't match IF EQ ;if they match then try the next bytes LDA $93 CMPA $83 IF EQ LDA $94 CMPA $84 IF EQ LDA $95 CMPA $85 IF EQ LDA $96 ;until we hit the last bytes CMPA $86 IF EQ ;if they match ORCC #1 ;then force the carry ENDIF ENDIF ENDIF ENDIF ENDIF RTS ; ;negate the contents of FPAC1 ;parameter : FPAC1 - value ;returns : FPAC1 - negated value fneg LDA $81 ;get the exponent IF NE ;value non zero? COM $80 ;yes, so negate it ENDIF RTS ; ;shift FPAC1 right a specified number of bits ;parameter : FPAC1 - value to shift ; B - number of bits to shift right ;returns : FPAC1 - shifted value, exponent unchanged shiftacc LOOP ;try to shift whole bytes first SUBB #8 ;a byte left to shift? QUIF MI ;no, quit PSHS B ;save shift count LDD 4,X ;move whole bytes over STD 5,X LDD 2,X STD 3,X CLR 2,X ;and clear out the high order byte PULS B ;restore the shift count ENDLOOP ADDB #8 ;restore remainder of the shift value LOOP ;so we can shift bits DECB ;any more bits? QUIF MI ;no, quit LSR 2,X ;shift everything right bit, shifting in a 0 ROR 3,X ;propagating the carry ROR 4,X ROR 5,X ROR 6,X ;and ignoring the final carry ENDLOOP RTS ; ;add the two floating point accumulators without any checking ;parameter : FPAC1, FPAC2 - values ;returns : FPAC1 - value, exponent unchanged ;note : B register is preserved as FMULBYTE uses it as a factor faddacc PSHS B ;save the factor LDD $85 ;add lower order bytes ADDD $95 STD $85 LDD $83 ;add middle bytes with carry ADCB $94 ADCA $93 STD $83 LDA $82 ;add high order byte with carry ADCA $92 STA $82 PULS B ;restore the factor RTS ; ;shift FPAC1 right one bit ;parameter : FPAC1 - value to shift ; carry bit set to indicate if shift is to be done ;returns : FPAC1 - shifted value rshiftac ORCC #1 ;set the carry to force shifting rotateac IF CS INC $81 ;increment the exponent IF EQ ;wrapped around? CALL overflow ;oops, set the overflow ELSE ROR $82 ;ok, rotate all bits right one ROR $83 ROR $84 ROR $85 ROR $86 ENDIF ENDIF RTS ; ;subtract FPAC2 from FPAC1 without any checking ;parameter : FPAC1, FPAC2 - values ;returns : FPAC1 - result ;note : B register is preserved because FDIV uses it to hold a result fsubacc PSHS B ;save the result LDD $85 ;subtract the lower order bytes SUBD $95 STD $85 LDD $83 SBCB $94 ;subtract the middle bytes and borrow SBCA $93 STD $83 LDA $82 ;subtract the high order byte and borrow SBCA $92 STA $82 PULS B ;restore the result RTS ; ;calculate the squar root of a number ;parameter : FPAC1 - number to take square root of ;returns : FPAC1 - result ;destroys : X, FPAC2 sqr CALL trflf2 ;compute as value to 1/2 power LDX #half2 CALL floadx ; ;compute a value raised to a power ;parameter : FPAC1 - power to raise value to ; FPAC2 - value to raise to power ;returns : FPAC1 - result ;destroys : FPAC2, X power LDA $81 ;get exponent of power IF NE ;power non zero? LEAS -12,S ;yes, get some working space LDA $91 ;get exponent of value IF EQ ;value non zero? LDA $80 ;no, test sign IF MI ;-- ;negative? CALL overflow ;yes, overflow result ELSE CALL fzero ;no, result is zero ENDIF ELSE TFR S,X ;get address of work area CLR 5,X ;set result sign positive CALL fstorex ;save original power GUESS LDA $90 ;get sign of value QUIF EQ ;non negative, compute the power TFR S,X ;see if it is an integer negative power LDD $90 ;copy the value STD 6,X LDD $92 STD 8,X LDD $94 STD 10,X CALL trflf2 ;duplicate the power CALL ffintgr ;integerize it CLR $86 ;remove any guard bits LDA $85 ;get low order bit of integer ANDA #$01 ;and see if it is an even or odd power IF NE TFR S,X ;for odd powers, negate the result COM 5,X ENDIF CALL normaliz ;normalize the integer CALL fcmp ;and see if it is what we started with IF EQ ;it is, so restore the value TFR S,X LDD 6,X STD $90 LDD 8,X STD $92 LDD 10,X STD $94 CLRA ;set the condition codes ENDIF QUIF EQ ;if ok at theis point, then calculate away LDA #4 ;negative, non integer power, set error flag STA $87 ADMIT ;calculate x**y as ext(y*ln(x)) CLR $90 ;take abs(value) CALL findlog ;get log of the value TFR S,X CALL fmulbyx ;multiply by the power CALLS exp ;and get the inverse log TFR S,X LDA 5,X STA $80 ;and set the sign correctly ENDGUESS ENDIF TFR S,X ;release our stack space LDB #12 ABX TFR X,S RTS ENDIF ; ;compute the inverse natural log of a number. ;parameter : PFAC1 contains the number ;returns : FPAC1 contains the calculated inverse natural log. ;destroyed : FPAC2, X exp LDX #ln_of_e ;x*ln(e) CALL fmulbyx LDA $86 ;get least significant byte of mantissa ADDA #$50 ;need to round up? IF CS ;yes CALL kilguard ;do so ENDIF PSHS A ;save least significant byte CALL qktrflf2 ;transfer everything to FPAC2 PULS A STA $96 ;including the last byte GUESS ;now see how we mangle the number LDA $81 ;get the mantissa CMPA #$88 ;within a valid range? QUIF CC ;no, make it zero or overflow CALL ffloor ;get the integer part CALL cnvfi ;convert to an integer value PSHS B CALL cnvif ;and then put it back PULS B ADDB #$81 ;is the number too large? QUIF EQ ;yes, out of range DECB ; PSHS B CALL fsub ;int(x)-x CALL fneg ;x-int(x) LDX #exptable ;expand using the exponent table CALL expand PULS A ;get the previous integer part ADDA $81 ;add in the current mantissa ADDA #$80 ;convert to excess 128 notation STA $81 ;save as new mantissa, result*int(x) CLR $80 ;make final result positive ADMIT ;trouble here, too high or low LDA $80 ;get the sign IF EQ ;which is it? CALL overflow ;too small ELSE CALL underflo ;too large ENDIF ENDGUESS RTS ; ;compute the natural log of a number ;parameter : FPAC1 contains number to compute ln of ;returns : FPAC1 contains log of the number ;destroyed : FPAC2, X ;errors : $0087 set to 4 if an invalid parameter not positive log GUESS LDA $81 ;get the exponent QUIF EQ ;it must be nonzero LDA $80 ;get the sign QUIF NE ;it must be non negative ADMIT LDA #4 ;invalid parameter, set error code STA $87 RTS ENDGUESS CALL trflf2 ; ;calculate the natural log of a number ;parameter : FPAC2 contains value to compute ln of ;returns : FPAC1 contains the result ;destroyed : x, FPAC2 ;method : the mantissa is saved, the value is mangled and the ; base 2 log is calculated. The mantissa is added to the ; result and finally multiplied by the ln(2) to give the right ln. findlog LDA $91 ;get current mantissa SUBA #$80 ;change to non excess 128 notation PSHS A ;and save LDA #$80 ;get a neutral mantissa STA $91 ;and save it. value is now between .5 and 1 LDX #sin45 CALL floadx CALL fadd ;x+sqrt(.5) CALL trflf2 LDX #sqrtof2 CALL floadx CALL fdiv ;sqrt(2)/(x+sqrt(.5)) CALL trflf2 LDX #one CALL floadx CALL fsub ;1-sqrt(2)/(x+sqrt(.5)) LDX #logtable CALL oddexpnd ;expand using the log table LDX #minhalf CALL faddx ;expansion-.5 CALL trflf2 CLRA PULS B ;get the original mantissa TSTB IF MI ;-- DECA ;and sign extend it ENDIF CALL cnvif ;convert the mantissa to its floating point representati CALL fadd ;and add to the calculated ln LDX #ln_of_2 ;and multiply final result by ln(2) CALL fmulbyx ;to get back to the natural log RTS ; ;Compute ATN(value) ;parameter : FPAC1 contains value to take ATN of ;returns : FPAC1 contains the ATN of the value ;destroyed : FPAC2, X ;Method : This is a modified Gregory series. atn LDA $80 ;get the sign PSHS A ;and save it IF MI ;-- ;convert to positive values:atn(-x)=-atn(x) CALL fneg ENDIF LDA $81 ;get the exponent PSHS A CMPA #$81 ;greater than 1? IF CC ;yes, take inverse CALL trflf2 LDX #one CALL floadx CALL fdiv ;x=1/x ENDIF LDX #atntable ;expand using the atn table CALL oddexpnd PULS A ;get the original exponent CMPA #$81 IF CC ;did we take the inverse? CALL trflf2 ;yes, LDX #pihalf CALL floadx CALL fsub ;x=2*pi/x ENDIF PULS A ;get original sign TSTA ;negative? IF MI ;-- ;yes, negate final result CALL fneg ENDIF RTS ; ;routines: cos and sin ;purpose: compute sin/cos of the number in FPAC1 leaving ; the result in FPAC1 using a taylors series of 5 expansions ; cos works by adding pi/2 and then taking the sin ;parameters : FPAC1 contains the number ;returns : FPAC1 contains computed function ;destroyed : x, FPAC2 cos LDX #pihalf ;add pi/2 CALL faddx sin LDX #twopi ;divide by 2 pi CALL fdivx CALL trflf2 ;normalize on (0,1) by taking the fractional part CALL ffloor ;get int(x) CALL fsub ;int(x)-x CALL fneg ;x-int(x) to give frational ;now normalize to the first quadrant CALL trflf2 LDX #quarter ;subtract from 1/4 to separate 1st quadrant CALL floadx CALL fsub LDA $80 ;get sign of result PSHS A IF MI ;-- ;and add 1/2 to split 3rd and 4th quadrants CALL faddhalf LDA $80 ENDIF IF PL ;negate positive ones to separate 2nd and 3rd quads CALL fneg ENDIF LDX #quarter ;normalize up to 1st quadrant CALL faddx PULS A TSTA IF MI ;-- ;and fix final quadrants: CALL fneg ENDIF ;at this point for each quadrent we have done: ; 1st = x 2nd = 1/2-x 3rd = x-1/2 4th = 1-x LDX #sintable ;expand using the sin table coefficients ; ;this routine expands odd coefficients of a series ;in the form ax+bx^3+cx^5+.... ;parameter: x points to coefficient table ; FPAC1 contains x ;returns: FPAC1 contains polynomial, FPAC2 is destroyed oddexpnd STX $8e ;save address of table PSHS X ;get space for saving x PSHS X LEAS -1,S TFR S,X CALL fstorex ;copy x into work space CALL trflf2 ;duplicate x CALL fmul ;x*x CALLS expandx ;a+bx^2+cx^4+... TFR S,X CALL fmulbyx ;*x = ax+bx^3+cx^5+... PULS X ;remove work area PULS X LEAS 1,S RTS ; ;expand a polynomial to the form a+bx+cx^2+... ;parameter: x register points to the coefficient table ; fpac1 contains x ;returns : fpac1 contains the polynomial ;a+bx+cx^2+... is computed by ((...+c)*x+b)*x+a expand STX $8e ;save address of coefficient table expandx PSHS X ;get storage space for x PSHS X PSHS X TFR S,X CALL fstorex ;and copy FPAC1 into it LDX $8e ;address of coefficient table LDA ,X ;get number of entries LEAX 1,X STX $8e ;save table start TFR S,X STA 5,X ;and number of iterations LDX $8e ;get table start LOOP CALL fmulbyx ;first time multyply x by last coefficient ;second and subsequent times multiply total by x LDX $8e ;get current table index LDB #$05 ;and point to next entry ABX STX $8e CALL faddx ;and add to the current sum TFR S,X ;point to x for next time around loop DEC 5,X UNTIL EQ PULS X ;get rid of our storage PULS X PULS X RTS pihalf FCB $40,$c9,$0f,$da,$a2 ;pi/2 = 1.570796320 twopi FCB $41,$c9,$0f,$da,$a2 ;2*pi = 6.283185300 quarter FCB $3f,$80,$00,$00,$00 ;.25e0 = 1/4 = 0.250000000 half2 FCB $40,$00,$00,$00,$00 ;.5e0 = 1/2 = 0.500000000 sin45 FCB $40,$35,$04,$f3,$34 ;1/sqrt(2) = sin(45) = 0.707106781 sqrtof2 FCB $40,$b5,$04,$f3,$34 ;sqrt(2) = 1.414213560 ln_of_2 FCB $40,$31,$72,$17,$f8 ;ln(2) = 0.693147180 minhalf FCB $c0,$00,$00,$00,$00 ;-.5e0 = -1/2 = -0.500000000 ln_of_e FCB $40,$b8,$aa,$3b,$29 ;ln(e) base 2=1/ln(2)= 1.442695040 sintable FCB 5 FCB $c2,$66,$1a,$2d,$1b ;-(2*pi)^11/11! = -14.3813906 FCB $43,$28,$07,$fb,$f8 ;(2*pi)^9/9! = 42.0077971 FCB $c3,$99,$68,$89,$01 ;-(2*pi)^7/7! = -76.7041702 FCB $43,$a3,$35,$df,$e1 ;(2*pi)^5/5! = 81.6052236 FCB $c3,$25,$5d,$e7,$28 ;-(2*pi)^3/3! = -41.3417021 FCB $41,$c9,$0f,$da,$a2 ; ?????? atntable FCB 11 ;number of coefficients FCB $bb,$33,$83,$bd,$d3 ;-1/23 + c = -.000684793911 FCB $3c,$9e,$f4,$a6,$f5 ; 1/21 + c = .004850942150 FCB $bd,$83,$fc,$b0,$10 ;-1/19 + c = -.016111701800 FCB $3e,$0c,$1f,$67,$ca ; 1/17 + c = .034209638000 FCB $be,$5e,$53,$cb,$c1 ;-1/15 + c = -.054279132700 FCB $3e,$94,$64,$70,$4c ; 1/13 + c = .072457196500 FCB $be,$b7,$ea,$51,$7a ;-1/11 + c = -.089802395400 FCB $3e,$e3,$30,$88,$7e ; 1/9 + c = .110932413000 FCB $bf,$12,$44,$99,$3a ;-1/7 + c = -.142839807000 FCB $3f,$4c,$cc,$91,$c7 ; 1/5 + c = .199999120000 FCB $bf,$aa,$aa,$aa,$13 ;-1/3 + c = -.333333315000 one FCB $40,$80,$00,$00,$00 ; 1 logtable FCB 3 ;number of coefficients FCB $3f,$de,$56,$cb,$79 ;??? = .434255942 FCB $40,$13,$9b,$0b,$64 ;??? = .576584541 FCB $40,$76,$38,$93,$16 ;??? = .961800759 halfln_e FCB $41,$38,$aa,$3b,$20 ;ln(e)/2 = 2/ln(2) = 2.88539007 exptable FCB 7 ;number of coefficients FCB $38,$b4,$58,$3e,$56 ;(ln(2)^7)/7! = .0000214987637 FCB $3a,$16,$7e,$b3,$1b ;(ln(2)^6)/6! = .0001435231400 FCB $3b,$af,$ee,$e3,$85 ;(ln(2)^5)/5! = .0013422634800 FCB $3d,$1d,$84,$1c,$2a ;(ln(2)^4)/4! = .0096140170100 FCB $3e,$63,$59,$58,$0a ;(ln(2)^3)/3! = .0555051268000 FCB $3f,$75,$fd,$e7,$c6 ;(ln(2)^2)/2! = .2402263840000 FCB $40,$31,$72,$18,$10 ;(ln(2)^1)/1! = .6931471860000 onefloat FCB $40,$80,$00,$00,$00 ;1 ;compute the floor of a value ;parameter : FPAC1 - value ;returns : FPAV1 - result ;destroys : X ffloor CALLS ffintgr ;integerize JMP normaliz ;and normalize ; ;compute the integer representation of a floating point number ;no normalization is performed and the integer is right justified in the ;4 bytes making up the mantissa. ;parameter : FPAC1 - value to integerize ;returns : FPAC1 - integerized value ;destroys : X ffintgr GUESS LDA $81 ;check the exponent QUIF NE ;quit for zero, since it is an integer ADMIT CMPA #$81 IF CS ;value < 1 LDA $80 ;get sign IF EQ ;value < 0 CALL fzero ;no, set it to zero ELSE CALL cnvif,#-1 ;yes, set it to -1 ENDIF ELSE CMPA #$a0 ;is the room to fit the integerized value IF CS ;if not, then don't even try LEAS -1,S ;get space for the bit bucket TFR S,X CLR ,X ;and initialize it empty LOOP LSR $82 ;shift everything right one bit ROR $83 ROR $84 ROR $85 IF CS ;catching any that fall out ROR ,X ENDIF INCA CMPA #$a0 ;until it is right justified0in the mantissa UNTIL EQ STA $81 ;save the resulting mantissa LDA $80 ;get the sign bit IF NE ;negative? ROL ,X ;yes, check to see if anything got dropped IF CS CALL froundup ;if so, then round up ENDIF ENDIF LEAS 1,S ;remove our bit bucket CLR $86 ;and clear the guard bits ENDIF ENDIF ENDGUESS RTS addra986 FCB $aa,$aa,$aa,$aa,$aa,$aa,$aa,$aa,$aa,$aa ;main restart routine startup LDS #$09ff ;initialize the stack CALL bankinit_ ;and banks CLRA CLRB CALL maininit SWI BRA startup mainnmi LDS #$09ff CALL bankinit_ CALL maininit,#-1 SWI BRA mainnmi ; parameters : 0 = normal, -1=nmi call maininit PSHS D ;save flag (0 or -1) CALL initstd_ CALL conbint_,#mainnmi,#12 ;initialize nmi vector LDB 1,S ;pop the flag CMPB #-1 ;nmi? IF EQ LDB #1 ;yes, do a code 1 restart STB $32 ELSE CALLS setmem ;clear memory, do a normal restart CLR $32 ENDIF chekretc LDB $32 ;check restart flag CMPB #8 BEQ docode8 CLRA BRA decodeit ;command was loaded successfully docode1 CLRA LDB 3,S ;parameter to command is address PSHS D LDD #1 LDX $2a ;where is the command CALL ,X ;do it. LEAS 2,S CLR 3,S RTS docode2 LDD #2 BRA execcode docode3 LDD #3 execcode LDX $2a JMP ,X doexit CLR $32 RTS ;parameter: code to execute decodeit LDX #doexit ;point to default routine GUESS ;make sure it is range 0-3 TSTA QUIF LT ;way out, use default routine CMPB #3 QUIF HI ;too high, use default LDX #decodtbl ;point to lookup table ABX ABX ;index into table LDX ,X ;get routine address ENDGUESS CALL ,X ;call the one we want BRA chekretc ;quick return docode8 CLRA CLRB LEAS 2,S RTS ;set the start and end of memory setmem LDD #$0a00 ;0a00 is the first available STD $20 ADDD #$75ff ;0a00+75ff=7fff the last available STD $22 RTS decodtbl fdb showmenu fdb docode1 fdb docode2 fdb docode3 menulist FCS "sETUP" FCS "mONITOR" FCS "aPL" FCS "bASIC" FCS "eDIT" FCS "fORTRAN" FCS "pASCAL" FCS "dEVELOPMENT" FCB $00,$00,$00 resident FDB setup_,monitor_ ;this is the normal startup, called when $32 is set to 0 showmenu LEAS -11,S LOOP CALL printf_,#menuhead ;print the menu top LDD #menulist ;point to start of the menu STD 3,S LOOP CALL putchar_,#BLANK ;put two blanks at start CALL putchar_,#BLANK LOOP ;print a menu item CLRA LDB [3,S] ;get the next character CALL lower_ ;convert it CALL putchar_ ;and print it LDD 3,S ;point to next char ADDD #1 STD 3,S PSHS D PULS X LDB ,X ;is it a null? UNTIL EQ ;yes, thats the end of the item LDD 3,S ;skip the null ADDD #1 STD 3,S CALL putnl_ ;terminate the line LDB [3,S] ;test for a terminating null UNTIL EQ ;none found, it's another item CALL putnl_ ;put a blank line to separate the input LOOP CALL getchar_ ;skip over any leading blanks in their command STB ,S CMPB #BLANK UNTIL NE CMPB #13 ; null response? QUIF NE ;no, process the command CALL putchar_,#12 ;yes clear the screen and start again ENDLOOP ;now that we know they typed something, see what it is LDD #$0400 ;find a place to put their command STD 5,S ;save starting address STD 3,S ;and current ending address LOOP LDB ,S ;get the character that they typed CMPB #BLANK ;blank? QUIF EQ ;yes, end of their command CMPB #13 ;? QUIF EQ ;yes, end also LDD 3,S ;get pointer to place to put it PSHS D ;save place ADDD #1 ;point to next available STD 5,S ;and update end pointer CLRA LDB 2,S ;get the character PULS X ;get the place to put it STB ,X ;and do so CALL getchar_ ;read the next character STB ,S ENDLOOP CLR [3,S] ;add a trailing null LDD 5,S ;point to the start of the string LOOP ;search for the first non alphabetic character STD 3,S ;save current index CLRA LDB [3,S] ;get the character JSR isalpha_ ;is it alphabetic QUIF EQ ;no, quit LDD 3,S ;point to the next character ADDD #1 ENDLOOP LDD 3,S ;calculate string length SUBD 5,S PSHS D LDD 7,S ;get start of string PSHS D CALL tableloo_,#devices_ ;did they specify a device? LEAS 4,S IF EQ ;none specified CALL prefixst_,#default_,(5,S) ;prefix it with the default ENDIF LDD 5,S ;point to start of string STD 3,S ;point to location of first nonalphabetic LOOP LDD 3,S ;get next location PSHS D ;save it ADDD #1 ;and increment pointer STD 5,S PULS X LDB ,X ;get character there CMPB #'.' ;end of device spcification? QUIF EQ ;yes, quit LDB [3,S] ;no go to next character UNTIL EQ ;until the end of the string CLRA ;clear out routine to call CLRB STD $2a CALL length_,(3,S) ;find out how long filename part is PSHS D LDD 5,S PSHS D CALL tableloo_,#menulist ;look for it in the main menu LEAS 4,S STD 1,S ;save location IF NE SUBD #2 ;0=setup, 1=monitor both resident IF GT ;non resident? ; move through the menu list looking for the name LDD #menulist ;yes, reconstruct the correct name LOOP STD 9,S ;save current location in menu list LDD 1,S ;decrement the lookup count ADDD #-1 STD 1,S QUIF EQ ;until we have found it LDD 9,S ;see where we are PSHS D CALL length_,(11,S) ;see how long the current entry is ADDD #1 ;and move to the next entry ADDD ,S PULS X ENDLOOP ;replace the string they entered with the full qualified one CALL copystr_,(11,S),(3,S) ;from the table CALL zupstr_,(3,S) ;don't forget the files are in upper ca ELSE LDD 1,S ;get the index LSLB ;multiply by two ROLA ADDD #resident-2 ;index the jump table PSHS D PULS X LDD ,X ;get address of the routine STD $2a ;and save it ENDIF ENDIF LDD #$0400 ;point to the start of the file string PSHS D CALL length_,(7,S) ;see how long it is ADDD ,S ;add to the start PULS X ADDD #1 ;point past the end of the command STD 7,S ;and save start of new area STD 3,S ;as well as a current pointer LOOP ;read in the rest of their line LDB ,S ;get the next character CMPB #13 ; quit at eoln QUIF EQ LDD 3,S ;see where to put it PSHS D ADDD #1 ;increment current pointer STD 5,S CLRA LDB 2,S PULS X STB ,X ;save the character CALL getchar_ ;get the next STB ,S ENDLOOP ;and go again CLRA CLRB STD 3,S ;zero out current pointer CALL putchar_,#12 ;cls LDB #$01 ;tell it to do a restart 1 STB $32 LDD $2a ;to the address in $2a IF EQ ;did we find a routine already? CALL loadcmd,(5,S) ;no, load the command IF EQ ;load ok? CLR $32 ;no, do a system restart ENDIF ENDIF CALLN copystr_,(9,S),(5,S) ;copy their parameter string to the buffer $0400 LEAS 13,S RTS menuhead FCS "Waterloo microSystems%n%nSelect :%n%n" default_ FCS "disk/1." loadcmd PSHS D ;save address of program name LEAS -3,S CALL printf_,#loadmsg,(3,S) ;verify what we are loading CALL openf_,(5,S),#prglmode ;open the file STD ,S ;and save address of fcb IF EQ ;could we open it? CALL printf_,#nofndprg ;no, tell them so CLR 2,S ;set return code ELSE CALLS loadprog ;try to load it STB 2,S ;save the return code CALL closef_,(,S) ;and close the file ENDIF CLRA ;get the return code LDB 2,S LEAS 5,S RTS ;load a program ;parameter: d=fcb of the file to load from loadprog PSHS D ;save the fcb address LEAS -13,S ;get us some space CLRA ;reset the program start vector CLRB STD $2a TFR S,X ;find place to put 6 bytes read in from the program LDB #7 ABX ;which will be at 7 from the stack top PSHS X PULS D STD 5,S ;save a pointer to that location LOOP CALL progread,(17,S),(7,S),#6 ;read 6 bytes from the program CALL errorf_,(13,S) ;did an error occur? BNE loaderr1 ;yes, quit LDX 5,S ;no, get where they were read in LDB 4,X ;find the command code CMPB #2 ;code to quit? QUIF EQ ;yes, we're done LDD $2a ;has the program start been set? IF EQ ;not yet ;find out where the program starts and set $2a to it ;for bank programs, we must build a dummy program to call it. LDB 4,X ;get the command code CMPB #1 ;was it a bank call? IF EQ CALL copy_,#bankcall,#$0039,#6 ;yes copy over dummy call CLRA LDX 5,S LDB 5,X ;get the bank STB $3c ;and put it in the cal LDD ,X ;get the starting address STD $3d ;and put it in too LDD #$0039 ELSE LDD [5,S] ;get the start of the program ENDIF STD $2a ;save the start ENDIF LDB 4,X ;get the command code CMPB #1 ;bank load? IF EQ CLRA LDB 5,X ;get the bank STD BANKSEL ;and select it ENDIF CALLS progread,(17,S),(,X),(2,X) ;read in the rest of the block CALL errorf_,(13,S) ;check for errors BNE loaderr1 ;abort if any occur ENDLOOP ;and go back for the next block LDB #-1 ;set a good return code STB 4,S BRA loadend loaderr1 CALL printf_,#badldmsg CLR 4,S ;set bad return code loadend CLRA ;select bank 0 CLRB STD BANKSEL CLR $0220 ;and tell the system that's what it is. LDB 4,S ;get the return code LEAS 15,S RTS ;parameters: fcb address, buffer address, length ;returns : nothing... progread PSHS D ;save the address of the fcb LDD 6,S ;get the length PSHS D LDD 6,S ;get the buffer address PSHS D LDD 4,S ;get fcb address again CALL sysread_ LEAS 6,S RTS loadmsg FCS "Loading '%s'%n" prglmode FCS "L" nofndprg FCS "Program not found%n" badldmsg FCS "error loading file%n" ;parameters : D=1 to invoke setup call ;returned : none setup_ PSHS D ;save the function code LDB 1,S CMPB #1 ;is it the only available function (1)? IF EQ CALLS setup ;yes, so perform the setup ENDIF CLR $32 ;clear the return code LEAS 2,S ;and leave RTS setup CALLS shosetup ;format the screen for them CALLS getsetup ;get what they want, and set it that way JMP tioinit_ ;and reset the terminal to its defaults shosetup CALL tabset_,#systabs ;set the tabs for the menu CALL length_,#setupmsg ;see how long the setup message is PSHS D CALL putrec_,#setupmsg ;and print it out LEAS 2,S LDD #$0115 ;put the cursor on the first data field JMP tputcurs_ getsetup LEAS -21,S ;get some work space TFR S,X ;allocate a temporary buffer LDB #12 ;at s+12 ABX PSHS X PULS D STD 10,S ;and save a pointer to it CALL openf_,#keyboard,#writmode ;open up the keyboard for writing STD 6,S ;and save the fcb address redosetp LOOP ;let them edit and change the screen while we CALL getchar_ ;skip over all characters they type SUBD #13 ;until we see a carriage return UNTIL EQ ;they've done their editing, now see what it says LDD #1 ;start on line 1 LOOP STD ,S ;save the current line SUBD #6 ;past the last one? QUIF GT ;; BGT addrae18 ;yes, quit LDD ,S ;no, what line are on? TFR B,A ;format to set the line CLRB ADDD #1 ;and column 1 CALL tputcurs_ ;so that the cursor is on that line CALL fputchar_,(8,S),#13 ;and stuff a in the input buffer LDD #21 ;see how many characters we skip over STD 2,S ;save the count LOOP LDD 2,S ;decrement the skip count ADDD #-1 STD 2,S QUIF EQ ;until we've gotten them all CALL getchar_ ;get the next character ENDLOOP LDD 10,S ;get address of the work area STD 8,S ;and set a pointer to it LOOP CALL getchar_ STB [8,S] CMPB #13 ; QUIF EQ LDD 2,S ;get the line SUBD #8 ;why is this 8 the comparison value??????????? IF LT ;do we need to increment the buffer pointer LDD 8,S ;increment our buffer pointer ADDD #1 STD 8,S ENDIF LDD 2,S ;increment the count of the number read ADDD #1 STD 2,S ENDLOOP CLR [8,S] ;add a trailing null to their input LDD ,S ;see what line we are on LSLB ;convert to a table offset ROLA ADDD #setfuncs-2 ;add to the table start (not 0 indexed) PSHS D ;save address of offset PULS X LDD ,X ;get address of the routine STD 4,S LDD 10,S ;get the address of string we pulled from their inp CALL [4,S] ;and call the proper processing routine QUIF NE ;quit on an error LDD ,S ;and go on to the next line ADDD #1 ENDLOOP LDD ,S ;see what line we ended up on SUBD #7 ;was it the last? IF NE LDD ,S ;no, so put the cursor on that line TFR B,A CLRB ADDD #21 ;in the column over the offending data CALL tputcurs_ CALL putchar_,#'?' ;put a question mark there CALL putchar_,#6 ;erase to end of line CALL putchar_,#8 ;back space over the question mark JMP redosetp ;and read the screen again ENDIF CLRA LDB $a3 ;get the stopbits PSHS D LDB $a2 ;get the parity PSHS D LDD $a0 ;get the baud rate PSHS D CALL sioinit_,#ACIA_R0 ;set up the port LEAS 6,S CALL closef_,(6,S) ;close the terminal file LEAS 21,S RTS parsbaud PSHS D ;save the address of the string LEAS -1,S CALL stoi_,(1,S) ;convert the baud rate to a integer STD $a0 ;and save it LOOP ;now that we did that, see if the string was valid LDD 1,S ;get location of next character PSHS D ADDD #1 ;increment string pointer STD 3,S PULS X CLRA LDB ,X ;get the character CALL isdigit_ ;see if it is a digit LBEQ setuperr ;if not, then get out of here LDB [1,S] ;check the next character UNTIL EQ ;until we hit the end of the string BRA setupret ;and return parsprty PSHS D ;save the string address LEAS -3,S CLR ,S ;reset the return code CALL length_,(3,S) ;see how long the string is PSHS D LDD 5,S ;get the address of the string PSHS D CALL tableloo_,#paritabl ;and look for it in the table LEAS 4,S STD 1,S ;save the offset found IF NE ;was it found? ADDD #paritvals ;use as an offset into the parity table PSHS D CLRA PULS X LDB ,X ;get the proper parity value STB $a2 ;and save ELSE LDB #$ff ;set a bad return code STB ,S ENDIF CLRA LDB ,S ;get the return code LEAS 5,S RTS ;parse the stop bits specified. only posibilities are '1' or '2' parsstop PSHS D LEAS -1,S CLR ,S ;reset to a good return code LDB [1,S] ;get the first character typed CMPB #'1' ;1 stop bit IF EQ CLR $a3 ;yes, set the system value for 1 stop bit BRA setupend ;and return ENDIF CMPB #'2' ;not one, so try 2 BNE setuperr ;no, we don't handle it LDB #$80 ;set value for 2 stop bits STB $a3 BRA setupbye parsprmt PSHS D ;save address of the string LEAS -1,S CALLS checkhex,(1,S) ;make sure it is a hex string BEQ setuperr ;if not then give them an error CALL hstob_,(3,S),#$037c ;convert it and save the prompt value STB $7c ;save the length of the prompt setupret BRA setupby1 ;parse the line end character. it must be a single hex byte parslnen PSHS D ;save the address of the string LEAS -1,S CALLS checkhex,(1,S) ;verify that the string is hex BEQ setuperr ;otherwise, give them an error CALL length_,(1,S) ;how long is it? SUBD #2 ;no more than two chars BGT setuperr ;or they get an error LDD #$007b ;its good, so copy it to $007b BRA setupsav ;parse the response character. it must be a single hex byte parsrspn PSHS D ;save the address of the string LEAS -1,S CALLS checkhex,(1,S) ;make sure it is hex BEQ setuperr ;otherwise generate an error CALL length_,(1,S) ;check the length SUBD #2 ;no more than two characters BGT setuperr ;or it is an error LDD #$007d ;good, copy it to $007d ;convert the hex string at (1,S) to copy to the address in the D register setupsav PSHS D ;destination address CALL hstob_,(3,S) ;let the system routine do the conversion LEAS 2,S setupby1 CLR ,S ;clear the return code BRA setupexi ;and quit setuperr LDB #$ff ;set a bad return code STB ,S setupend BRA setupexi ;and quit ;verify that the string pointed to by the D register is a valid string checkhex PSHS D ;save the address of the string LEAS -1,S LOOP CLRA ;get the next character LDB [1,S] CALL ishex_ ;make sure it is a hex character BEQ hexerror ;otherwise generate an error LDD 1,S ;point to the next character ADDD #1 STD 1,S PSHS D PULS X LDB ,X UNTIL EQ ;until we hit the end of the string LDB #$ff ;set a good return code STB ,S setupbye BRA setupexi ;and return hexerror CLR ,S ;set a bad return code setupexi CLRA ;get the return code LDB ,S LEAS 3,S ;clean up the stack RTS ;and return keyboard FCS "keyboard" writmode FCS "W" setupmsg FCB $0C FCB 'B,'A,'U,'D FCB 9 ; FCB '2,'4,'0,'0 FCB 13 ; FCB 'P,'A,'R,'I,'T,'Y FCB 9 ; FCB 'E,'V,'E,'N FCB 13 ; FCB 'S,'T,'O,'P,'B,'I,'T,'S FCB 9 ; FCB '1 FCB 13 ; FCB 'P,'R,'O,'M,'P,'T FCB 9 ; FCB '1,'1 FCB 13 ; FCB 'L,'I,'N,'E,'E,'N,'D FCB 9 ; FCB '0,'D FCB 13 ; FCB 'R,'E,'S,'P,'O,'N,'S,'E FCB 9 ; FCB '1,'3 FCB 13 ; FCB $00 systabs fcb 0,21,0 addrafad fcs "e" addrafaf FCB 0 setfuncs FDB parsbaud FDB parsprty FDB parsstop FDB parsprmt FDB parslnen FDB parsrspn paritabl FCS "odd" FCS "even" FCS "mark" FCS "space" FCB 0 paritvals FCB $00,$20,$60,$a0,$e0 bankcall CALL banksw FCB 0 ;bank 0 FDB $9000 ;at the start of the bank ADDRAFDC FCB $dc,$83,$d2,$94 addrafe0 FCB $ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff FCB $ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff FCB $ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff FCB $ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff spawn_ JMP spawn suicide_ JMP suicide conbint_ JMP conbint banksw JMP bankswi bankinit_ JMP bankinit stoi_ JMP stoi itos_ JMP itos itohs_ JMP itohs hex_ JMP hex btohs_ JMP btohs hstob_ JMP hstob isalpha_ JMP isalpha isdigit_ JMP isdigit isdelim_ JMP isdelim ishex_ JMP ishex isupper_ JMP isupper islower_ JMP islower upper_ JMP upper lower_ JMP lower zlostr_ JMP zlostr zupstr_ JMP zupstr streq_ JMP streq equal_ JMP equal length_ JMP length copystr_ JMP copystr copy_ JMP copy prefixst_ JMP prefixst suffixst_ JMP suffixst decimal_ JMP decimal tableloo_ JMP tableloo ___ret JMP __ret ___ret2 JMP __ret2 ___mul JMP __mul ___neg JMP __neg ___div JMP __div ___mod JMP __mod _rshift JMP rshift _lshift JMP lshift carryset_ JMP carryset passthru_ JMP passthru tioinit_ JMP tioinit tputchr_ JMP tputchr tgetchr_ JMP tgetchr tbreak_ JMP tbreak tgetcurs_ JMP tgetcurs tputcurs_ JMP tputcurs tsetchar_ JMP tsetchar tabset_ JMP tabset tabget_ JMP tabget sioinit_ JMP sioinit sputchr_ JMP sputchr sgetchr_ JMP sgetchr sbreak_ JMP sbreak diropenf_ JMP diropenf dirreadf_ JMP dirreadf dirclose_ JMP dirclosef sysioini_ JMP sysioini initstd_ JMP initstd openf_ JMP openf closef_ JMP closef fseek_ JMP fseek printf_ JMP printf putrec_ JMP putrec putchar_ JMP putchar putnl_ JMP putnl getrec_ JMP getrec getchar_ JMP getchar fprintf_ JMP fprintf fputrec_ JMP fputrec fputchar_ JMP fputchar fputnl_ JMP fputnl fgetrec_ JMP fgetrec fgetchar_ JMP fgetchar eor_ JMP eor eof_ JMP eof errorf_ JMP errorf errormsg_ JMP errormsg mount_ JMP mount scratchf_ JMP scratchf renamef_ JMP renamef request_ JMP request setdate_ JMP setdate getdate_ JMP getdate settime_ JMP settime gettime_ JMP gettime kbenable_ JMP kbenable kbdisabl_ JMP kbdisabl timeout_ JMP timeout sysread_ JMP sysread syswrite_ JMP syswrite sysnl_ JMP sysnl addrb111 FCB $00,$00 addrb113 FCB $00,$00 addrb115 FCB $00,$00 addrb117 FCB $00,$00 addrb119 FCB $00 addrb11a FDB 10000,1000,100,10,1 devices_ FCS "disk" FCS "printer" FCS "ieee" FCS "host" FCS "terminal" FCS "serial" FCS "keyboard" FCB $00 devcode_ FCB $00,$81,$82,$83,$04,$05,$06,$07 ioformat FCS "fIXED" FCS "tEXT" FCS "vARIABLE" FCB $00 ioformc FCB $00,'f,'t,'v filespec FCS "rel" FCS "seq" FCS "prg" FCS "usr" FCB $00 filespcc FCB $00,$08,$10,$20,$10 filecmod FCS "rEAD" FCS "wRITE" FCS "uPDATE" FCS "aPPEND" FCS "lOAD" FCS "sTORE" FCB $00 addrb1b1 FCB $00,$01,$02,$03,$06,$81,$42 terminal FCS "terminal" ; initstd_ ; parameters : none initstd CALL initfcbs ;clear out all fcbs CLRA CLRB STD $6b ;zero out the default input file CALLS openf,#terminal,#read ;open the terminal for input STD $6b ;and save as the default input CALLS openf,#terminal,#write ;open up the terminal for output STD $6d ;save as default output RTS ; getchar ;returns : character read from default input getchar LDD $6b ;get default input fcb JMP fgetchar ;and read character from it ; putchar ;parameters : character to output putchar PSHS D ;save character passed CLRA LDB 1,S ;make sure ther high order byte isn't set PSHS D CALL fputchar,$6D ;and write out the character to the default output fcb LEAS 4,S RTS ; putnl ;puts new-line on the default output device putnl LDD $6d ;get the default output device JMP fputnl ;and put a new-line to it ; getrec ;parameters: address of buffer, length of buffer ;we cannot just call fgetrec because the pc is pushed on the stack getrec PSHS D ;save buffer address CALLN fgetrec,$6B,(2,S),(4,S) ;get the record(default input fcb, buffer address, length) BRA recret ; putrec ;parameters: address of record, length of record ;cannot call fputrec directly because of pc on stack putrec PSHS D ;save the address CALLN fputrec,$6D,(2,S),(4,S) ;and output the record - Default output FCS, address, length recret LEAS 6,S RTS ; printf_ ;parameters: format string, ... ;we don't know how many parameters there are, so move the pc to the top printf PULS X ;get the return pc PSHS D ;save address of format string PSHS X ;and address of pc return TFR S,X ;save pointer to parmaeter block LDB #2 ABX PSHS X CALL sprintf,$6d ;and let printf handle it to the default output fcb LEAS 2,S PULS X ;get the return address LEAS 2,S JMP ,X ;and return to the calling program ; openf ;parameters : address of filename, address of filemode ;returns address of fcb openf PSHS D ;save the address of the file name LEAS -54,S ;get some work space CALL asignfcb ;allocate an fcb STD ,S ;and save address of it IF NE ;make sure we got one TFR S,X ;locate our workspace LDB #2 ;at s+2 ABX PSHS X ;and save it ;!!!assumption : the filename is less than 40 characters!!! ;!!!if not, it will bomb this routine out!!!!!!!!!!!!!!!!!! CALL copystr,(56,S) ;to copy the file name into it LEAS 2,S TFR S,X ;find some more space LDB #43 ;at s+43 ABX PSHS X CALL copystr,(60,S) ;to copy the file mode to LEAS 2,S TFR S,X ;get address of the file mode LDB #43 ;at s+43 ABX PSHS X TFR S,X ;and address of our fcb LDB #4 ;now at s+4 ABX PSHS X CALL sysopen,(4,S) ;and open up the file LEAS 4,S CALL geterror,(,S) ;check to see if an error occured IF EQ BRA openferr ;if not then return ENDIF CALL freefcb,(,S) ;get rid of the allocated fcb CLRA CLRB STD ,S ;and null out what we return ENDIF openferr LDD ,S ;get the fcb allocated(or none) LEAS 56,S RTS ; closef ;parameter: address of fcb closef PSHS D ;save address of the fcb CALL sysclose,(,S) ;close the file CALL geterror,(,S) ;check for any errors CALL freefcb,(,S) ;and free the fcb LEAS 2,S RTS ; fgetchar ;parameter : D - FCB address ;returns : B - Next character from file ;destroys : X fgetchar PSHS D ;save address of fcb LEAS -1,S LDX 1,S ;point to fcb LDB [4,X] ;get status flag CMPB #1 ;eor? IF EQ ;yes LDB 3,X ;check buffer flag CMPB #1 ;eor set? IF NE ;no LDB #1 ;set eor flag STB 3,X BRA loadcret ;and give them a carriage return ENDIF ENDIF LDD #1 ;number of characters to read PSHS D TFR S,X ;put the character at S+2 (the top of our stack) LDB #2 ABX PSHS X CALL sysread,(5,S) ;read the next character from the file LEAS 4,S LDX 1,S ;get the address of the FCB CLRA LDB [4,X] ;get the return code STB 3,X ;and set the fcb flag CMPB #1 ;eor? IF EQ ;yes LDB ,X ;get the file type CMPB #'t' ;text? IF EQ ;yes LDX 4,X ;get address of parameter block LDB 2,X ;get the device type CMPB #4 ;host? BNE fgetretn ;yes, quit ENDIF LDX 1,S ;get address of fcb CLR 3,X ;clear buffer flag ELSE LDB 3,X ;get the buffer flag IF NE ;eof/eor? loadcret LDB #13 ; STB ,S ;give them a carriage return ENDIF ENDIF fgetretn JMP ioreturn ; Fputchar ;parameters : D - Address of FCB ; Stack - Character to output ;returns : D - Return code from read ;destroys : X fputchar PSHS D ;save address of FCB LEAS -1,S CLRA ;get the character LDB 6,S STB ,S ;save it LDD #1 ;one character to write PSHS D TFR S,X ;get address of character LDB #2 ;which is at s+2 ABX PSHS X CALL syswrite,(5,S) ;write the character LEAS 4,S LDX 1,S ;get address of FCB CLRA LDB [4,X] ;get the return code STB 3,X ;and save it in the FCB LEAS 3,S RTS ; fputnl ;parameter : D - address of FCB fputnl PSHS D ;save address of FCB CALLN sysnl,(2,S),#-1 ;and put a new line there to the FCB JMP addrb4bd ; fgetrec fgetrec PSHS D LEAS -2,S CLRA CLRB STD ,S CALL sysskip,(2,S) LDX 2,S CLRA LDB [4,X] STB 3,X IF EQ CALL sysread,(6,S),(8,S),(8,S) STD ,S LDX 2,S CLRA LDB [4,X] STB 3,X ENDIF LDD ,S BRA addrb3b7 ; fputrec fputrec PSHS D CALL sysskip,(,S) LDX ,S CLRA LDB [4,X] STB 3,X CMPB #$03 LBEQ addrb515 CALL syswrite,(4,S),(6,S),(6,S) LDX ,S CLRA LDB [4,X] STB 3,X CLRB PSHS D CALL sysnl,(2,S) LEAS 2,S LDX ,S LDB 3,X CMPB #$03 LBEQ addrb515 JMP addrb4c1 ; fprintf fprintf PSHS D TFR S,X LDB #$04 ABX PSHS X CALLS sprintf,(2,S) addrb3b7 LEAS 4,S RTS ; subroutine for printf/fprintf sprintf PSHS D LEAS -27,S LDD [31,S] STD 24,S LDD 31,S ADDD #2 STD 31,S addrb3ce CLRA LDB [24,S] STB 21,S LBEQ addrb49f CMPB #$25 LBNE addrb47d LDD 24,S ADDD #1 STD 24,S CLRA LDB [24,S] STB 21,S CALL lower STB 26,S CMPB #$6e LBEQ addrb48d CMPB #$63 IF EQ LDD [31,S] STB 21,S LDD 31,S ADDD #2 STD 31,S ELSE CMPB #$64 IF EQ TFR S,X PSHS X PULS D STD 22,S CALL itos,(24,S),[31,S] ELSE CMPB #$68 IF EQ TFR S,X PSHS X PULS D STD 22,S PSHS D LDD #1 PSHS D LDD 35,S ADDD #1 CALL btohs LEAS 4,S ELSE CMPB #$73 BNE addrb47d LDD [31,S] STD 22,S ENDIF ENDIF LDD 31,S ADDD #2 STD 31,S LOOP LDX 22,S LDB ,X BEQ addrb493 CLRA PSHS D CALL fputchar,(29,S) LEAS 2,S LDD 22,S ADDD #1 STD 22,S ENDLOOP ENDIF addrb47d CLRA LDB 21,S PSHS D CALL fputchar,(29,S) LEAS 2,S BRA addrb493 addrb48d CALL fputnl,(27,S) addrb493 LDD 24,S ADDD #1 STD 24,S JMP addrb3ce addrb49f LEAS 29,S addrb4a2 RTS ; fseek fseek PSHS D CALL sysskip,(,S) LDX ,S CLRA LDB [4,X] STB 3,X BNE addrb515 CALLN addrc846,(2,S),(4,S) addrb4bd LEAS 2,S LDX ,S addrb4c1 CLRA LDB [4,X] STB 3,X BRA addrb515 ; eor eor PSHS D LDX ,S LDB 3,X CMPB #$01 BRA addrb4db ; eof eof PSHS D LDX ,S LDB 3,X CMPB #$02 addrb4db IF EQ LDA #$ff FCB $21 ;trick - skip the next byte - code for a brn ENDIF CLRA TFR A,B BRA addrb515 ; errorf errorf PSHS D LEAS -1,S LDD 1,S IF EQ CLRA LDB $6a STB ,S ELSE CALL geterror LDX 1,S STB 3,X CMPB #$02 BEQ addrb503 CMPB #$03 IF EQ addrb503 CLRA STB ,S ELSE CLR ,S ENDIF ENDIF ioreturn CLRA LDB ,S LEAS 3,S RTS ; errormsg errormsg PSHS D addrb512 LDD #$0300 ; common return point addrb515 LEAS 2,S addrb517 RTS ; scratchf scratchf PSHS D LEAS -43,S ;$ffd5 CALL asignfcb STD ,S LBEQ addrb5b9 TFR S,X LDB #$02 ABX PSHS X CALL copystr,(45,S) LEAS 2,S TFR S,X LDB #$02 ABX PSHS X CALL sysscrat,(2,S) BRA addrb5b2 ; renamef renamef PSHS D LEAS -84,S CALL asignfcb STD ,S IF NE TFR S,X LDB #$02 ABX PSHS X CALL copystr,(86,S) LEAS 2,S TFR S,X LDB #$2b ABX PSHS X LDD $005a,S CALL copystr LEAS 2,S TFR S,X LDB #$2b ABX PSHS X TFR S,X LDB #$04 ABX PSHS X LDD 4,S CALL sysrenam LEAS 4,S LDD ,S CALL freefcb ENDIF LEAS $0056,S RTS ; mount mount PSHS D LEAS -43,S CALL asignfcb STD ,S BEQ addrb5b9 TFR S,X LDB #$02 ABX PSHS X LDD $002d,S CALL copystr LEAS 2,S TFR S,X LDB #$02 ABX PSHS X LDD 2,S CALL sysmount ; common return point addrb5b2 LEAS 2,S LDD ,S CALL freefcb ; common return point addrb5b9 LEAS $002d,S RTS ; timeout timeout PSHS D LDX ,S LDX 4,X PSHS X LDD 6,S PULS X STD 7,X LEAS 2,S RTS read FCS "R" write FCS "W" ; diropenf diropenf PSHS D LEAS -43,S CALL asignfcb STD ,S LDB $6a IF EQ TFR S,X LDB #$02 ABX PSHS X LDD 45,S CALL copystr LEAS 2,S TFR S,X LDB #$02 ABX PSHS X LDD 2,S CALL sysdirop LEAS 2,S LDB $6a IF NE LDD ,S CALL freefcb CLRA CLRB STD ,S ENDIF ENDIF LDD ,S LEAS 45,S RTS ; dirreadf dirreadf PSHS D LDD 4,S PSHS D LDD 2,S CALL sysdirrd LEAS 2,S LDX ,S CLRA LDB [4,X] STB 3,X BRA addrb633 ; dirclosef dirclosef PSHS D LDD ,S CALL sysdircl LDD ,S CALL freefcb ; common return addrb633 LEAS 2,S RTS addrb636 CLR $6a LDX #$0300 CLR ,X RTS addrb63e LDB #2 STB $6a CALL copystr,#addrb666,#$0300 RTS addrb650 LDD #str_ioto addrb653 PSHS D LDB #3 STB $6a CALLN copystr,(2,S),#$0300 LEAS 4,S RTS addrb666 FCS "eof" str_ioto FCS "I/O time-out" ; ___ret ;parameter : x register = number of bytes to pop from the stack __ret LOOP LEAS 1,S LEAX -1,X UNTIL EQ BRA addrb6e8 ; ___ret2 ;parameter: x register = number of bytes to pop from stack __ret2 LOOP LEAS 1,S LEAX -1,X UNTIL EQ BRA addrb6e0 ; ___mul __mul CALLS addrb6f1 TFR S,X LDB 1,X ANDB #$01 STB 1,X CLRB addrb692 LOOP LSR 2,X ROR 3,X IF CS ADDD 6,X CALLS addrb6b7 ENDIF TST 2,X IF EQ TST 3,X QUIF EQ ENDIF LSL 7,X ROL 6,X CALLS addrb6b7 ENDLOOP ROR 1,X IF CS CALL __neg ENDIF ROR 1,X BRA addrb6dc ; subroutine for ___mul addrb6b7 IF MI ;-- PSHS B LDB 1,X ORB #$02 STB 1,X PULS B ENDIF RTS ; carryset carryset IF CC CLRA CLRB ELSE LDD #-1 ENDIF RTS ; ___div __div CALLS addrb6f1 CALLS addrb719 TFR S,X LDD 6,X BRA addrb6dc ; ___mod __mod CALLS addrb6f1 CALLS addrb719 ; common exit point addrb6dc PULS X PULS X addrb6e0 PULS X LEAS 1,S LEAS 1,S addrb6e6 PSHS X addrb6e8 PSHS X TFR S,X STD ,X PULS X RTS ; setup subroutine for ___mod, ___div, ___mul addrb6f1 PULS X PSHS B PSHS A LDD #$0010 PSHS A PSHS B PSHS X TFR S,X LDD 4,X IF MI ;-- CALLS __neg STD 4,X INC 3,X ENDIF LDD 8,X IF MI ;-- CALLS __neg STD 8,X INC 3,X ENDIF CLRA CLRB RTS ; subroutine for ___div, ___mod addrb719 LOOP LSL 9,X ROL 8,X ROLB ROLA SUBD 4,X IF MI ;-- ADDD 4,X ELSE INC 9,X IF EQ INC 8,X ENDIF ENDIF DEC 2,X UNTIL EQ ROR 3,X IF CS CALLS __neg STD 4,X LDD 8,X CALLS __neg STD 8,X LDD 4,X ENDIF RTS ; ___neg __neg COMA COMB ADDD #1 RTS ; rshift rshift CALLS __neg ; lshift lshift TFR S,X TSTA IF MI ;-- CALLS __neg CALLS addrb774 LOOP TSTB QUIF EQ LSR 2,X ROR 3,X DECB ENDLOOP ELSE CALLS addrb774 LOOP TSTB QUIF EQ LSL 3,X ROL 2,X DECB ENDLOOP ENDIF PULS X PULS A PULS B JMP addrb6e6 ; subroutine for rshift/lshift addrb774 TSTA IF EQ CMPB #$0f BHI addrb77d ELSE addrb77d CLRA CLRB STD 4,X ENDIF RTS ; streq streq PSHS D LEAS -1,S LOOP LDB [1,S] CMPB [5,S] QUIF NE LDB [1,S] BEQ addrb7a7 LDD 1,S ADDD #1 STD 1,S LDD 5,S ADDD #1 STD 5,S ENDLOOP CLR ,S BRA addrb7ab addrb7a7 LDB #$ff STB ,S addrb7ab CLRA LDB ,S LEAS 3,S RTS ; length_ length PSHS D LEAS -2,S CLRA CLRB LOOP STD ,S LDB [2,S] LBEQ $b9c2 LDD 2,S ADDD #1 STD 2,S LDD ,S ADDD #1 ENDLOOP ; equal equal PSHS D LOOP LDD 6,S QUIF EQ LDB [,S] CMPB [4,S] QUIF NE LDD ,S ADDD #1 STD ,S LDD 4,S ADDD #1 STD 4,S LDD 6,S ADDD #-1 STD 6,S ENDLOOP LDD 6,S IF EQ LDA #$ff FCB $21 ; brn instruction - skip the clra ENDIF CLRA TFR A,B LEAS 2,S RTS ; copystr_ copystr PSHS D LDD ,S CALLS length ADDD #1 BRA addrb824 ; prefixst prefixst PSHS D LDD 4,S PSHS D LDD 2,S CALLS length ADDD ,S PULS X PSHS D LDD 6,S CALLS copystr LEAS 2,S LDD ,S CALLS length addrb824 PSHS D LDD 6,S PSHS D LDD 4,S CALL copy LEAS 6,S RTS ; suffixst suffixst PSHS D LDD 4,S PSHS D LDD 6,S CALL length ADDD ,S PULS X PSHS D LDD 2,S CALLS copystr JMP addrb9c4 ; decimal decimal PSHS D LEAS -2,S CLRA CLRB STD ,S LOOP LDD 6,S LBEQ addrb9c2 ADDD #-1 STD 6,S LDD ,S PSHS D LDD #10 CALL __mul PSHS D CLRA LDB [$0004,S] ANDB #$0f ADDD ,S PULS X STD ,S LDD 2,S ADDD #1 STD 2,S ENDLOOP ; stoi stoi PSHS D LEAS -4,S CLRA CLRB STD 2,S STD ,S LDB [4,S] CMPB #$2b IF EQ LDD 4,S ADDD #1 STD 4,S ELSE CMPB #$2d IF EQ LDD 4,S ADDD #1 STD 4,S LDD #-1 STD 2,S ENDIF ENDIF LOOP LDX 4,S LDB ,X CMPB #$30 QUIF CS CMPB #$39 QUIF HI LDD ,S PSHS D LDD #10 CALL __mul PSHS D CLRA LDB [6,S] ADDD #$ffd0 ADDD ,S PULS X STD ,S LDD 4,S ADDD #1 STD 4,S ENDLOOP LDD 2,S IF NE LDD ,S CALL __neg STD ,S ENDIF LDD ,S LEAS 6,S RTS ; btohs btohs PSHS D LEAS -3,S LDD #addrb9c7 STD ,S LOOP LDD 7,S QUIF EQ b940 ADDD #-1 STD 7,S CLRA LDB [3,S] STB 2,S LDD 3,S ADDD #1 STD 3,S CLRA LDB 2,S LSRA RORB LSRA RORB LSRA RORB LSRA RORB CLRA ANDB #$0f ADDD ,S PSHS D CLRA PULS X LDB ,X STB [9,S] LDD 9,S ADDD #1 STD 9,S CLRA LDB 2,S ANDB #$0f ADDD ,S PSHS D CLRA PULS X LDB ,X STB [9,S] LDD 9,S ADDD #1 STD 9,S ENDLOOP CLR [9,S] LEAS 5,S RTS ; hstob hstob PSHS D LEAS -2,S CLRA CLRB STD ,S LDD 2,S CALL length PSHS D LDD #$0002 ; hex addrb958 CALL __mod IF NE CLRA LDB [2,S] CALL hex STB [6,S] LDD 6,S ADDD #1 STD 6,S LDD ,S ADDD #1 STD ,S LDD 2,S ADDD #1 STD 2,S ENDIF LOOP LDX 2,S LDB ,X QUIF EQ CLRA CALL hex LSLB ROLA LSLB ROLA LSLB ROLA LSLB ROLA STB [6,S] LDD 2,S ADDD #1 STD 2,S CLRA LDB [6,S] PSHS D LDB [4,S] CALL hex ADDD ,S PULS X STB [6,S] LDD 2,S ADDD #1 STD 2,S LDD 6,S ADDD #1 STD 6,S LDD ,S ADDD #1 STD ,S ENDLOOP addrb9c2 LDD ,S addrb9c4 LEAS 4,S RTS addrb9c7 FCS "0123456789abcdef" ; isalpha isalpha PSHS D CLRA LDB 1,S CALLS islower PSHS D CLRA LDB 3,S CALLS isupper ORA ,S ORB 1,S PULS X BRA addrba2a ; islower islower PSHS D LDB 1,S CMPB #$61 BCS addrba27 CMPB #$7a BRA addrba10 ; isupper isupper PSHS D LDB 1,S CMPB #$41 BCS addrba27 CMPB #$5a BRA addrba10 ; isdigit isdigit PSHS D LDB 1,S CMPB #$30 BCS addrba27 CMPB #$39 ; common range test for is... addrba10 BHI addrba27 BRA addrba24 ; isdelim isdelim PSHS D CLRA LDB 1,S CALLS isalpha BNE addrba27 CLRA LDB 1,S CALLS isdigit ; common return for is... IF EQ addrba24 LDA #$ff FCB $21 ; brn instruction to skip the clra instruction ENDIF addrba27 CLRA TFR A,B addrba2a JMP addrbac8 ; ishex ishex PSHS D LEAS -1,S LDB #$ff STB ,S CLRA LDB 2,S CALLS isdigit IF EQ CLRA LDB 2,S CALLS lower SUBD #$0061 BLT addrba50 CLRA LDB 2,S CALLS lower SUBD #$0066 IF GT addrba50 CLR ,S ENDIF ENDIF CLRA LDB ,S LEAS 3,S RTS ; subrout for hex hex PSHS D ;save the character CLRA LDB 1,S ;get the character CALLS ishex ;make sure it is a hex character BEQ addrbac5 CLRA LDB 1,S CALLS isdigit IF EQ CLRA LDB 1,S ADDD #$0009 STB 1,S ENDIF CLRA LDB 1,S ANDB #$0f BRA addrbac3 ; zupstr zupstr PSHS D LOOP LDX ,S LDB ,X BEQ addrbac8 CLRA CALLS upper STB [,S] LDD ,S ADDD #1 STD ,S ENDLOOP ; upper upper PSHS D CLRA LDB 1,S CALL islower BEQ addrbac5 CLRA LDB 1,S ANDB #$df BRA addrbac3 ; zlostr zlostr PSHS D LOOP LDX ,S LDB ,X BEQ addrbac8 CLRA CALLS lower STB [,S] LDD ,S ADDD #1 STD ,S ENDLOOP ; lower lower PSHS D CLRA LDB 1,S CALL isupper IF NE CLRA LDB 1,S ORB #$20 addrbac3 STB 1,S ENDIF ; common return point addrbac5 CLRA LDB 1,S ; common return point addrbac8 LEAS 2,S RTS ; itos itos PSHS D LEAS -4,S LDD 8,S IF LT LDB #'- STB [4,S] LDD 4,S ADDD #1 STD 4,S LDD 8,S CALL __neg STD 8,S ELSE LDD 8,S IF EQ LDB #'0 STB [4,S] LDD 4,S ADDD #1 STD 4,S ENDIF ENDIF LDD #$b11a STD ,S LDB #'0 STB 3,S LOOP LDB #'0 LOOP STB 2,S LDD 8,S LDX ,S SUBD ,X QUIF LT LDD 8,S SUBD ,X STD 8,S CLRA LDB 2,S ADDD #1 ENDLOOP CLRA LDB 3,S ORB 2,S STB 3,S CMPB #'0 IF NE LDB 2,S STB [4,S] LDD 4,S ADDD #1 STD 4,S ENDIF LDD [,S] SUBD #1 QUIF EQ LDD ,S ADDD #$0002 STD ,S ENDLOOP CLR [4,S] LEAS 6,S RTS ; itohs itohs PSHS D LEAS -2,S LDD 6,S STD ,S LDD 2,S PSHS D LDD #$0002 PSHS D TFR S,X LDB #$04 ABX PSHS X PULS D CALL btohs LEAS 8,S RTS ; copy copy TFR D,X LDY 2,S SUBD 2,S IF HI LDD #addrbb97 PSHS D ELSE LDD 4,S LEAX D,X LEAY D,Y LDD #addrbb9f PSHS D ENDIF LOOP DEC 6,S IF PL CLRB ELSE LDB 7,S QUIF EQ CLR 7,S ENDIF JSR [,S] ENDLOOP PULS D RTS ; subroutine for copy addrbb97 LOOP LDA ,X+ STA ,Y+ DECB UNTIL EQ RTS ; subroutine for copy addrbb9f LOOP LDA ,-X STA ,-Y DECB UNTIL EQ RTS ; tableloo tableloo TFR D,Y CLR ,-S LOOP INC ,S LDX 3,S LDB 6,S LOOP LDA ,X+ TSTB IF EQ CLRA ENDIF CALLS makeupper PSHS A LDA ,Y CALLS makeupper CMPA ,S+ QUIF NE TSTB BEQ addrbbe2 DECB LEAY 1,Y ENDLOOP TSTB IF EQ LDA ,Y CMPA #'A IF CC CMPA #'Z BLS addrbbe2 ENDIF ENDIF LOOP LDA ,Y+ UNTIL EQ LDA ,Y UNTIL EQ CLR ,S addrbbe2 CLRA LDB ,S+ RTS makeupper CMPA #'a ;Make uppercase from lower IF CC CMPA #'z IF LS ANDA #$5f ENDIF ENDIF RTS ; banksw Perform bankswitched call. bankswi PULS Y,X ; Pop two RTS addrs. PSHS D ; Save Dacc LDB ,X+ ; Get bank # (& pt to in-bank addrs) LDX ,X ; Get address CMPB $0220 ; Same as current bank? IF NE ; No LDA $0220 ;Save current bank # PSHU Y,A ; on usr stack STB $0220 ;Mark switch STB BANKSEL ;& make it PULS D ;Restore Dacc JSR ,X ;Do subr. PSHS D ;Save Dacc (only) PULU Y,B ;Get back orig. bank & caller's caller's addrs STB $0220 ;Put it back STB BANKSEL LDD ,S++ ;Restore D (& set Z flag) & pop SP JMP ,Y ;Back to caller ENDIF PULS D ; No need to switch banks PSHS Y ; Restore RTS addrs JMP ,X ; Go to subr. ; bankinit bankinit LDU #$02ff ; Start stk ptr @ 2ff LDB #$00 ; & with bank #0 STB $0220 STB BANKSEL RTS ; conbint conbint LDX 2,S PSHS D TFR X,D LSRB ABX LEAX $0223,X LDB $0220 STB ,X+ PULS D STD ,X LDD 2,S PSHS D ADDD #addrbc67 CALL CONBSET PULS D RTS ; addrbc4f PULS D SUBD #addrbc69 TFR D,X LSRB ABX LEAX $0223,X LDD #addrbc66 PSHS D PSHS X JMP bankswi addrbc66 RTS ; addrbc67 CALLS addrbc4f addrbc69 CALLS addrbc4f CALLS addrbc4f CALLS addrbc4f CALLS addrbc4f CALLS addrbc4f CALLS addrbc4f ; spawn spawn PSHS B PSHS A LEAS -5,S LDD $2c STD ,S STS $2c LDD $33 STD 2,S STU $33 CLRA LDB $0220 STB 4,S LDX 5,S CALL ,X LDD ,S STD $2c LDD 2,S STD $33 CLRA LDB 4,S STB $0220 CLRA LDB 4,S STB BANKSEL CLRA CLRB LEAS 7,S RTS ; suicide suicide PSHS B PSHS A LEAS -5,S LDS $2c ;,DP LDD ,S STD $2c ;,DP LDU $33 ;,DP LDD 2,S STD $33 ;,DP CLRA LDB 4,S STB $0220 CLRA LDB 4,S STB BANKSEL LDD #1 LEAS 7,S RTS ; filopen PSHS D LEAS -2,S CALL usrhook_,#20 LDD $68 ;,DP STD ,S LDB [,S] LBEQ addrbd93 LDD #$00f0 PSHS D LDD 4,S CALL SetLstnr LEAS 2,S LOOP LDD ,S ADDD #1 PSHS D PULS X LDB ,X QUIF EQ CLRA LDB [,S] CALL ByteOut_ LDD ,S ADDD #1 STD ,S ENDLOOP CLRA LDB [,S] BRA addrbd90 ; filclose PSHS D CALL usrhook_,#21 LDX ,S LDB 2,X CMPB #$81 IF EQ CLRA LDB 12,X ANDB #$40 IF NE LDD #$00e0 PSHS D LDD 2,S CALL SetLstnr LEAS 2,S ENDIF ENDIF LDD ,S SUBD $02 ;,DP LBNE addrbe6c LDB $77 ;,DP CMPB #$40 IF EQ CALL UNTalk_ JMP addrbe6c ENDIF CMPB #$20 LBNE addrbe6c JMP addrbe5a ;ieeeOpen ieeeOpen PSHS D LEAS -2,S CALL usrhook_,#22 LDD $68 ;,DP STD ,S LDD #$00f0 PSHS D LDD 4,S CALL SetLstnr LEAS 2,S LOOP CLRA LDB [,S] CALL ByteOut_ LDB [,S] CMPB #', QUIF EQ LDD ,S ADDD #1 STD ,S ENDLOOP CALL ByteOut_,#$4c CALL ByteOut_,#$2c LDX 2,S LDD 5,X addrbd90 CALL addrbe53 ; common return point addrbd93 LEAS 4,S ;***** RTS ; addrbd96 PSHS D LDB #$0f LDX ,S STB 10,X LDD #$0060 PSHS D LDD 2,S CALL SetLstnr LEAS 2,S LDD #$0053 CALL ByteOut_ LOOP LDX $68 ;,DP LDB ,X CMPB #', LBEQ addrbe4c CLRA CALL ByteOut_ LDX $68 ;,DP LEAX 1,X STX $68 ;,DP ENDLOOP ; addrbdc6 PSHS D LDB #$0f LDX ,S STB 10,X LDD #$0060 PSHS D LDD 2,S CALL SetLstnr LEAS 2,S LDD #$0052 CALL ByteOut_ CLRA LDX $68 ;,DP LDB ,X CALL ByteOut_ LDX $68 ;,DP LEAX 1,X STX $68 ;,DP CLRA LDB ,X CALLS ByteOut_ LDX $68 ;,DP LEAX 1,X STX $68 ;,DP LOOP LDX 4,S LDB ,X QUIF EQ CLRA CALLS ByteOut_ LDD 4,S ADDD #1 STD 4,S ENDLOOP LDD #$003d CALLS ByteOut_ LOOP LDX $68 ;,DP LDB ,X CMPB #', BEQ addrbe4c CLRA CALLS ByteOut_ LDX $68 ;,DP LEAX 1,X STX $68 ;,DP ENDLOOP addrbe23 PSHS D LDB #$0f LDX ,S STB 10,X LDD #$0060 PSHS D LDD 2,S CALL SetLstnr LEAS 2,S LDD #$0049 CALLS ByteOut_ LDX ,S LDB 11,X IF EQ LDD #$0030 ELSE LDD #$0031 ENDIF CALLS ByteOut_ ; common exit point addrbe4c LDD #$000d CALLS addrbe53 BRA addrbe6c ; addrbe53 PSHS D CLRA LDB 1,S CALLS addrbe5f addrbe5a CALL UNListen BRA addrbe6c ; addrbe5f PSHS D CALL EOIDown_ CLRA LDB 1,S CALLS ByteOut_ CALL EOIUp_ ; common return addrbe6c LEAS 2,S RTS ;IEEEWriteByte ByteOut_ PSHS D CALL usrhook_,#23 LDX $02 ; ;,DP LDB ,X BNE addrbeea CLRA LDB PIA2_R3 ORB #$08 STB PIA2_R3 LDB VIA_R0 ANDB #$41 SUBD #$0041 IF EQ LDD #$c1c8 CALL addrb653 ELSE LDD #-1 SUBB 1,S SBCA #$00 STB PIA2_R2 LOOP CLRA LDB VIA_R0 ANDB #$40 UNTIL NE LDB PIA2_R3 ANDB #$f7 STB PIA2_R3 LDD 7,X STD $06 ;,DP IF EQ LOOP CLRA LDB VIA_R0 ANDB #$01 UNTIL NE BRA addrbeea ENDIF LOOP LDD #$0c80 STD $04 ;,DP LOOP CLRA LDB VIA_R0 ANDB #$01 BNE addrbeea LDD $04 ;,DP ADDD #-1 STD $04 ;,DP UNTIL EQ LDD $06 ;,DP ADDD #-1 STD $06 ;,DP UNTIL EQ CALL addrb650 ENDIF LDB #$03 LDX $02 ;,DP STB ,X ; common exit addrbeea CLRA LDB PIA2_R3 ORB #$08 STB PIA2_R3 LDB #$ff STB PIA2_R2 LEAS 2,S RTS ;IEEEReadByte addrbefb LEAS -1,S CALL usrhook_,#24 LDX $02 ;,DP LDB ,X BNE addrbf85 CLRA LDB PIA2_R1 ANDB #$f7 STB PIA2_R1 LDB VIA_R0 ORB #$02 STB VIA_R0 LDD 7,X STD $06 ;,DP IF EQ LOOP CLRA LDB VIA_R0 ANDB #$80 BEQ addrbf4b ENDLOOP ENDIF LOOP LDD #$0c80 STD $04 ;,DP LOOP CLRA LDB VIA_R0 ANDB #$80 BEQ addrbf4b LDD $04 ;,DP ADDD #-1 STD $04 ;,DP UNTIL EQ LDD $06 ;,DP ADDD #-1 STD $06 ;,DP BEQ addrbf7c ENDLOOP ; addrbf4b LDB VIA_R0 ;cont. of ieee byte-in routine ANDB #$fd ;assert NRFD STB VIA_R0 LDB PIA1_R0 ANDB #$40 ;check for EOI IF EQ ; yes EOI asserted LDB 12,X ORB #$01 STB 12,X ENDIF LDD #-1 SUBB PIA2_R0 ;get and invert byte (!!!) SBCA #$00 ;(ldb PIA2_R0/comb) STB ,S CLRA LDB PIA2_R1 ;raise NDAC ORB #$08 STB PIA2_R1 LOOP LDB VIA_R0 ANDB #$80 UNTIL NE ;DAV hi BRA addrbf85 ; addrbf7c JSR addrb650 LDB #$03 LDX $02 STB ,X ;Set status error addrbf85 CLRA LDB PIA2_R1 ANDB #$f7 STB PIA2_R1 ;assert NDAC LDB #$ff STB PIA2_R2 ;raise all data lines LDB ,S ;retrieve byte LEAS 1,S RTS ;IEEESeek addrbf98 PSHS D ;Set up RECORD of REL file LEAS -17,S CALL usrhook_,#25 CLRA LDX 17,S LDB 9,X STB 9,S LDD 7,X STD 7,S CLR ,S LDB #$0f STB 10,S LDD #$60 PSHS D TFR S,X LDB #$02 ABX PSHS X PULS D ;Grrrrrr JSR SetLstnr LEAS 2,S CALL ByteOut_,#'P CLRA LDX 17,S LDB 10,X JSR ByteOut_ CALL ByteOut_,(21,S) LDD 21,S TFR A,B ;now send hi byte CLRA JSR ByteOut_ CLRA CLRB JSR addrbe53 LEAS 19,S RTS ; IEEE15Status addrbfef PSHS D ;Check disk status LEAS -19,S CALL usrhook_,#26 CLRA LDX 19,S LDB 9,X addrc000 STB 11,S LDD 7,X STD 9,S CLR 2,S LDB #$0f STB 12,S TFR S,X LDB #2 ABX PSHS X ;Grrrrrr PULS D JSR SetTalkr LDD #$0300 LOOP STD ,S JSR addrbefb ;get byte of message LDX ,S STB ,X ;save it LDB $6a ;is status OK? BNE addrc06b LDB ,X CMPB #$0d ;EOM? QUIF EQ LDD ,S ADDD #1 ;set for next ENDLOOP CLR [,S] ;mark EOS JSR UNTalk_ GUESS ;is msg '00'? CALL equal,#addrc1db,#$0300,#2 QUIF NE ;yes ('NE'=true) CALL equal,#addrc1de,#$0300,#2 QUIF NE ;'01' is OK too LDB #$03 ;oops, error--flag it STB $6a ADMIT JSR addrb636 ;clear status ENDGUESS addrc06b CLRA LDB $6a ;ret status LEAS 21,S RTS SetLstnr PSHS D ;set active listener CALL usrhook_,#27 ;check for user hook LDD ,S STD $02 LDB $77 CMPB #$20 ;is listener active IF EQ ;yes LDX $02 ;already have the one we want? LDB 9,X CMPB $79 IF EQ ;maybe LDB 10,X CMPB $7a IF EQ LDB $78 ;still maybe CMPB 5,S LBEQ SetTdone ;yes, no action required ENDIF ENDIF CALLS UNListen ;tell other listener to stop (differs from ELSE ; CBM usage) CMPB #$40 ;talker active? IF EQ CALL UNTalk_ ;make it stop ENDIF ENDIF LDB #$20 ;flag listener active STB $77 CLRA LDB 5,S STB $78 LDX $02 LDB 9,X STB $79 ;set prim. addr. LDB 10,X STB $7a ;set sec. addr. JSR ATNDown_ ;assert ATN CLRA LDB $79 ADDD #$20 JSR ByteOut_ ;send MLA CLRA LDB $7a ;? get MSA ADDB $78 ;add MSA offset ADCA #$00 ;(Do we care?) JSR ByteOut_ ;send MSA BRA SetFin_ ; UNLISTEN UNListen CALL usrhook_,#28 ;check for user hook CALLS ATNDown_ ;assert ATN LDD #$3f ;UNListen BRA CMDFin_ SetTalkr PSHS D ;set active talker CALL usrhook_,#29 ;check for user hook LDD ,S STD $02 LDB $77 CMPB #$40 ;talker active? IF EQ ;yes LDX $02 ;but, is the one we want? LDB 9,X CMPB $79 IF EQ LDB 10,X CMPB $7a BEQ SetTdone ;OK, no action required ENDIF CALLS UNTalk_ ;New talker, tell old to stop ELSE CMPB #$20 ;listener active? IF EQ CALLS UNListen ENDIF ENDIF LDB #$40 ;flag talker active STB $77 LDB #$60 addrc10d STB $78 CLRA LDX $02 LDB 9,X STB $79 LDB 10,X STB $7a CALLS ATNDown_ ;assert ATN CLRA LDB $79 ADDD #$40 JSR ByteOut_ ;send MTA CLRA LDB $7a ADDD #$60 JSR ByteOut_ ;send MSA CLRA LDB VIA_R0 ANDB #$fd STB VIA_R0 ;set NRFD ;common return points SetFin_ CALLS ATNUp_ ;rel. ATN SetTdone LEAS 2,S RTS UNTalk_ CALL usrhook_,#30 ;check for user hook CALLS ATNDown_ ;Get tlkr to stop & assert ATN LDD #$5f ;UNTalk CMDFin_ CALL ByteOut_ ;output char CALLS ATNUp_ ;raise ATN CLR $77 ;clr file active flag RTS ATNDown_ CLRA ;Stop talker & assert ATN LDB VIA_R0 ORB #$02 STB VIA_R0 LDB PIA2_R1 ORB #$08 STB PIA2_R1 LOOP LDB VIA_R0 ANDB #$80 UNTIL NE LDB VIA_R0 ANDB #$fb ;assert ATN BRA ATNSet_ ATNUp_ CLRA ;release ATN LDB VIA_R0 ORB #$04 BRA ATNSet_ EOIDown_ CLRA ;assert EOI LDB PIA1_R1 ANDB #$f7 BRA EOISet_ EOIUp_ CLRA ;rel. EOI LDB PIA1_R1 ORB #$08 EOISet_ STB PIA1_R1 RTS IEEEInit CLR $77 ;clr file active flag CLRA LDB PIA1_R1 ORB #$38 STB PIA1_R1 ;rel. EOI & access DDRA CLR PIA1_R0 ;all bits input ORB #$04 STB PIA1_R1 ;back to port A access LDB #$38 ;ditto for PIA2 STB PIA2_R1 CLR PIA2_R0 ORB #$04 STB PIA2_R1 LDB #$38 STB PIA2_R3 LDB #$ff STB PIA2_R2 ;all outputs PIA2 B LDB PIA2_R3 ORB #$04 STB PIA2_R3 LDB #$ff STB PIA2_R2 ;all bits hi LDB #$06 STB $E842 ;only bits 1,2 output (why tape doesn't run) ATNSet_ STB VIA_R0 ;ATN,NRFD hi RTS addrc1c8 FCS "Device not present" addrc1db FCS "00" addrc1de FCS "01" request PSHS D LDD 6,S PSHS D LDD 6,S PSHS D CLRA LDB 5,S LDX $2a CALL ,X LEAS 6,S RTS sysioini CALL addre77a CLRA CLRB PSHS D LDD #$0060 PSHS D LDD #$012c PSHS D CALL sioinit,#ACIA_R0 LEAS 6,S CLRA CLRB PSHS D LDD #$0060 PSHS D CALL init2400,#$0960 LEAS 4,S CLRA CLRB PSHS D LDD #$0060 PSHS D CALL tioinit,#$2580 LEAS 4,S CALL IEEEInit LDB #$02 STB $7e LDB #$0d STB $0378 LDB #$0a addrc23e STB $0379 JMP crtinit1 ; sysopen - high level file open ; parameters : D - FCB address sysopen PSHS D ;save address of FCB LEAS -2,S ;get some space on the stack CLRA CLRB JSR usrhook_ ;check for indirect JSR addrb636 ;6A,300 <-- 0 (clear status) LDX 2,S ;get address of FCB LDD 4,X ;point to FCB+4 (status) STD ,S ;save for indexing CLR [,S] ;zero out FCB+4 (status) LDD 6,S STD $68 LDD 8,S PSHS D CALL getacmod,(2,S) ;check mode and parse. if bad, [6a]<-^0, error ;message set to [300] "invalid mode" LEAS 2,S LDB $6a ;error occurred ? IF EQ ;no, continue on CALL chkfname,(2,S) ;parse and check device and filename LDB $6a ;get error code IF EQ ;no error? CLRA ;get the device code LDX ,S LDB 2,X ANDB #$80 IF NE ;IEEE device? CALL ieeopen,(,S) ;yes, let IEEOPEN handle it ELSE LDB 2,X ;non IEEE CMPB #$04 ;HOST device? IF EQ ;yes LDB [8,S] ;convert the type CALL lower PSHS D CLRA ;get the file format LDB [4,S] PSHS D CALL hstopen,(4,S) ;call the host open routine LEAS 4,S ENDIF ENDIF ENDIF ENDIF CLRA LDB $6a ;get the last error code JMP addrc95f ;and return ; sysclose ; parameters: D register - FCB of the file to close sysclose PSHS D LEAS -2,S ;allocate some space on the stack CALL usrhook_,#1 ;check for user hook CALL addrb636 LDX 2,S ;reset error buffer location to zero LDD 4,X STD ,S LDX ,S ;point to the parameter block CLR ,X CLRA LDB 2,X ;get the device type ANDB #$80 IF NE ;IEEE device? CALL addrd331,(,S) ;call IEEEclose ELSE LDB 2,X ;host device ? CMPB #$04 IF EQ ;yes CALL hstclose,(,S) ;call hostclose ENDIF ENDIF LEAS 4,S ;remove the space on the stack RTS ; sysread ; parameters - D register sysread PSHS D LEAS -4,S ;allocate some space on the stack CALL usrhook_,#2 ;check for user hook CALL addrb636 ;reset error LDX 4,S ;point to fcb LDD 4,X STD ,S LDX ,S ;point to the parameter block CLR ,X ;clear error status CLRA LDB 1,X ;get access mode ANDB #$10 ;at mid record? IF NE CALL sysskip,(4,S) ;position to start of next record ENDIF CLRA LDX ,S ;get the access mode LDB 1,X ANDB #$01 IF EQ ;invalid access (not a readable access) CALL addrb653,#msginvac ;codes= 02 write, 06 append, 42 store LDB #$03 ;load the error message flag STB [,S] JMP sysread6 ;and exit quickly ENDIF LDB 2,X ;get the device code ANDB #$80 ;IEEE device? IF NE CALL SetTalkr,(,S) ;command talk to the bus ENDIF CLRA LDX ,S ;get the access mode (again!) LDB 1,X ANDB #$08 IF EQ ;init record access ? (acc <> 8 ) LDB 1,X ORB #$08 ;set the flag STB 1,X LDX 4,S ;get the record size LDD 1,X LDX ,S ;point to the parameter block STD 5,X ;and save as the lrecl LDB 2,X ;get the device CMPB #$81 ;disk device? IF EQ ;yes LDB [4,S] ;get the device specific status CMPB #$76 ;variable format? IF EQ CALL addrd33b,(,S) ;IEEE read char and status LDX ,S ;point to the parameters STD 5,X ;set the record size CALL chekcod1,(4,S) ;check EOR error code IF NE CALL addrbfef,(,S) ;IEEE error message CALL addrb63e ; "EOF" LDB #$02 ;set the status to 2 STB [,S] CLRA CLRB STD 10,S ;set the size to zero ELSE LDX ,S ;point to the parameter block LDD 5,X ;get the lrecl TFR B,A CLRB PSHS D CALL addrd33b,(2,S) ;IEEE get the record size byte ADDD ,S PULS X LDX ,S ;point to the parameter block STD 5,X ;and set the record size IF EQ ;was it zero? CLRA ;yes, set the size to zero CLRB STD 10,S LDB #$01 ;set the status to 1, EOR STB ,X ENDIF ENDIF ENDIF ;variable format ENDIF ;disk ENDIF ;acc mode <> 8 CLRA CLRB STD 2,S LDX ,S ;point to the parameter block LDB 1,X ;get the present access mode ANDB #$20 ;EOR on a Fixed record at the last record ? LBNE sysread3 ;yes, quit LOOP LDD 10,S ;get the size of the read buffer QUIF LE CALL sysrdbyt,(4,S) ;read a character STB [8,S] ;and store it in the buffer LDX ,S ;point to the parameter block LDB ,X ;check the status flag CMPB #$02 ;EOF? QUIF EQ CMPB #$03 ;OK? QUIF EQ GUESS LDB [4,S] ;check the file format CMPB #'t' ;Text file? QUIF NE CLRA LDB 1,X ;get the access mode ANDB #$c0 ;load or store format? QUIF NE LDB [8,S] CMPB #$0d ;character just read a carriage return? QUIF NE LDB #$01 ;set the status to 1 - EOR STB [,S] ADMIT GUESS LDB 2,X ;get the device CMPB #$05 ;a terminal? QUIF NE ;no, so quit CALL chekcod1,(4,S) ;check st=EOR QUIF EQ ;no, so quit ADMIT GUESS LDX ,S ;point to the parameter block LDD 5,X ;check the lrecl QUIF EQ LDD 3,X ;get the number of bytes red for this record ADDD #1 STD 3,X SUBD 5,X ;compare against the lrecl QUIF LE LDB #$01 ;st = EOR STB ,X LDD 2,S ;set the number of bytes read ADDD #1 STD 2,S ADMIT LDD 2,S ;set number of bytes read ADDD #1 STD 2,S LDD 10,S ;set the buffer space remaining ADDD #-1 STD 10,S LDD 8,S ;set the buffer pointer ADDD #1 STD 8,S ENDGUESS ENDGUESS ENDGUESS CALL chekcod1,(4,S) ;check for EOR UNTIL NE ;until it is encountered GUESS CALL chekcod1,(4,S) ;did we hit EOR? QUIF EQ ;no LDX ,S ;point to parameter block LDB 2,X ;get the device CMPB #$81 ;is it the disk? QUIF NE ;no, quit CLRA LDB 12,X ;get the file type ANDB #$08 ;is it a relative file? QUIF EQ ;no, quit LDD 3,X ;get number of bytes read this record SUBD #2 ;variable size IF EQ LDD 8,S ;point to the last character ADDD #-1 PSHS D PULS X LDB ,X ;get the last character CMPB #$ff ;was it an undefined record? BEQ sysread2 ;yes, goto EOF routine ENDIF CALL addrbfef,(,S) ;get ieee error message CALL equal,#msg50,#$0300,#2 ;compare QUIF EQ ;at end of file sysread2 LDB #$02 ;set eof flag STB [,S] CALL addrb63e ;and reset error ENDGUESS sysread3 GUESS LDB [4,S] ;get the access mode CMPB #'f' ;fixed format? QUIF NE ;no, so quit LDX ,S ;point to the parameter block LDB ,X ;get the status CMPB #$03 ;OK? QUIF EQ ;yes, quit CMPB #$02 ;EOF ? QUIF EQ ;yes, quit LDD 3,X ;get the number of bytes read so far SUBD 5,X ;subtract the lrecl IF LE ;more to go? CALL chekcod1,(4,S) ;check EOR flag IF NE ;yes, hit EOR LDX ,S ;point to the parameters CLR ,X ;clear the status flags CLRA LDB 1,X ;get the access mode ORB #$20 ;and set the EOR bit on STB 1,X ENDIF ENDIF sysread4 LOOP LDD 10,S ;get the buffer size remaining QUIF LE ;none remaining, quit CALL chekcod1,(4,S) ;EOR? QUIF NE ;yes, quit LDB #BLANK ;pad with a blank STB [8,S] LDD 8,S ;increment the buffer pointer ADDD #1 STD 8,S LDD 2,S ;increment the bytes recl ADDD #1 STD 2,S LDD 10,S ;decrement the buffer size remaining ADDD #-1 STD 10,S LDX ,S ;point to the parameter block LDD 3,X ;increment the byte position in the record ADDD #1 STD 3,X SUBD 5,X ;compare against the lrecl BLE sysread4 ;and loop back for more to go LDB #$01 ;set the status to EOR STB ,X ENDLOOP ENDGUESS sysread5 LDX ,S ;point to the parameters LDB ,X ;get the status IF NE CLRA ;reset the access bits LDB 1,X ANDB #$d7 STB 1,X LDD #1 ;reset the position in the record to 1 STD 3,X ENDIF sysread6 LDD 2,S ;get the number of bytes read for the return code LEAS 6,S ;release all the temporary storage RTS sysrdbyt PSHS D LEAS -3,S CALL usrhook_,#6 ;check for user hook LDX 3,S LDD 4,X STD ,S CLRA LDX ,S ;point to the parameter block LDB 2,X ;get the device type ANDB #$80 ;ieee device? IF NE CALL addrd33b,(,S) ;yes, let IEEE routine handle it ELSE LDB 2,X ;get device type CMPB #$04 ;host device? IF EQ CALL hstread,(,S) ;yes, let the host routine handle it ELSE CMPB #$05 ;terminal? IF EQ CALL tgetchr,(,S) ;yes, let terminal routine handle it ELSE CMPB #$06 ;serial port ? IF EQ LOOP ;yes... CALL sgetchr,(,S) ;let the serial routine get a char STB 2,S ;save it BNE addrc526 ;did we get one? LDB [,S] ;check retcode UNTIL NE BRA addrc526 ;we give up, so quit ENDIF CMPB #$07 ;keyboard? BNE addrc526 ;no, so skedaddle CALL kbdread ;get the character ENDIF ENDIF ENDIF STB 2,S ;save the character addrc526 CLRA LDB 2,S ;get the character read LEAS 5,S ;release stack space RTS syswrite PSHS D LEAS -3,S ;get some stack space CALL usrhook_,#3 ;check for user hook CALL addrb636 ;reset the error flag LDX 3,S ;point to fcb LDD 4,X ;point to the parameters STD ,S LDX ,S CLR ,X ;reset the status CLRA LDB 1,X ;get the access mode ANDB #$08 ;have we initiated read access to the current record? IF NE ;yes, so... CALL sysskip,(3,S) ;force us to next record before writing ENDIF CLRA LDX ,S ;point to the parameter block LDB 1,X ;get the access mode ANDB #$02 ;is it a write mode? IF EQ CALL addrb653,#msginvac ;no, tell them so LDB #$03 STB [,S] JMP addrc666 ENDIF LDB 2,X ;get the device code ANDB #$80 ;is it an ieee device? IF NE CALL SetLstnr,(2,S),#$0060 ;yes, form an ieee command line ENDIF CLRA LDX ,S ;point to parameter block LDB 1,X ;get the access mode ANDB #$10 ;are we at the beginning of a record? IF EQ ;yes... LDB 1,X ;set the mid record flag ORB #$10 STB 1,X LDX 3,S ;point to fcb LDD 1,X ;get record size LDX ,S ;point to parameters STD 5,X ;and save as the number of bytes in the record IF NE LDB 2,X ;get the device code CMPB #$81 ;is it a disk? IF EQ ;yes... LDB [3,S] ;get the format CMPB #'v' ;is it variable IF EQ ;yes... LDD 5,X ;actual space is lrecl-2 for this format ADDD #-2 STD 5,X ENDIF ENDIF ENDIF ENDIF LDD 5,X ;get the present record size IF NE SUBD 3,X ;subtract the current position in the record ADDD #1 PSHS D ;save it LDD 11,S ;get the count to write SUBD ,S ; -(current position+1) PULS X ;is it too long? IF GT ;yes... LDX ,S ;point to the parameter block LDD 5,X ;get the record size SUBD 3,X ;subtract current position ADDD #1 ;+1 STD 9,S ;and save as the present count CALL addrb653,#msgtrunc ;tell them it was truncated LDB #$03 ;set the error flag STB [,S] ENDIF ENDIF LDX ,S ;point to the parameters LDB 2,X ;get the device code CMPB #$81 ;is it the disk? IF EQ ;yes... LDB [3,S] ;get the record type CMPB #'v' ;variable format? IF EQ ;yes... LDD 9,S ;get the count TFR A,B ;transfer high byte to low byte CLRA PSHS D CALL addrd37b,(2,S) ;write the high byte LEAS 2,S CALL addrd37b,(2,S),(9,S) ;write the low byte LDX ,S ;point to parameters LDD 5,X ;get the lrecl IF NE ;was it designated? LDD 9,S ;get the count STD 5,X ;make it the lrecl ENDIF ENDIF ENDIF LOOP LDD 9,S ;get the count QUIF LE ;<=0, quit LDD 5,X ;get the lrecl IF NE LDD 3,X ;get the current position SUBD 5,X ;compare to the lrecl QUIF GE ;not past the end of buffer... ENDIF CLRA LDB [7,S] ;get the char PSHS D CALLS outbyte,(5,S) ;and output it LEAS 2,S LDX ,S ;point to the parameters LDD 3,X ;increment current position in record ADDD #1 STD 3,X LDD 7,S ;increment pointer to char ADDD #1 STD 7,S LDD 9,S ;decrement the count ADDD #-1 STD 9,S ENDLOOP LDD 9,S ;get the count IF GT ;limit exceeded? LDD 3,X ;get current postion SUBD 5,X ;compare to end of buffer IF LE ;before end of the buffer? LDD 3,X ;increment the current position ADDD #1 STD 3,X GUESS LDB 2,X ;get the device code CMPB #$81 ;disk? QUIF NE ;no, quit LDB 12,X ;get the disk file status IF NE LDD #8 ;set to disk unit 8 QUIF EQ ENDIF CLRA LDB [7,S] ;get last byte CALL addrbe5f ;and output it ADMIT CLRA LDB [7,S] ;get last byte PSHS D CALLS outbyte,(5,S) ;and output it LEAS 2,S ENDGUESS ENDIF ENDIF addrc666 LEAS 5,S ;release our storage RTS outbyte PSHS D LEAS -2,S ;get some space CALL usrhook_,#7 ;check for user hook LDX 2,S ;point to fcb LDD 4,X ;get pointer to parameters STD ,S ;and save it CLRA LDX ,S ;point to parameters LDB 2,X ;get the device code ANDB #$80 ;ieee device? IF NE ;yes... LDB 7,S ;get the byte PSHS D CALL addrd37b,(2,S) ;and write it to IEEE ELSE LDB 2,X ;get device code CMPB #$04 ;host? IF EQ ;yes... LDB 7,S ;get the byte PSHS D CALL hstwrbuf,(2,S) ;and write it to the host ELSE CMPB #$05 ;terminal? IF EQ ;yes... LDB 7,S ;get the byte CALL tputchr ;and write to the terminal BRA outbytrt ENDIF CMPB #$06 ;serial port? BNE keyoutb ;no, it must be the keyboard LDB 7,S ;get the byte PSHS D CALL sputchr,(2,S) ;and write it to the serial port ENDIF ENDIF LEAS 2,S ;get rid of our stack space BRA outbytrt ;and return keyoutb CMPB #$07 ;is it the keyboard? IF EQ ;yes... LDB 7,S ;get the byte CALL kbdwrite ;and 'write' it out ENDIF outbytrt LEAS 4,S ;get rid of our space RTS sysnl PSHS D LEAS -4,S ;get us some space CALL usrhook_,#8 ;check for user hook LDX 4,S ;point to the fcb LDD 4,X ;point to the parameter block STD ,S ;save for later LDB 9,S ;get the reset status flag IF NE CALL addrb636 ;reset the error flags CLR [,S] ENDIF CLRA LDX ,S ;point to parameter block LDB 1,X ;get the access mode ANDB #$08 ;are we reading the record? IF NE ;yes... CALL sysskip,(4,S) ;skip to the end of it ENDIF CLRA LDX ,S ;point to the parameters LDB 1,X ;get access mode ANDB #$02 ;do we have write access? IF EQ ;no... CALL addrb653,#msginvac ;tell them LDB #$03 ;set error flag STB [,S] JMP addrc7f4 ;and get out of here ENDIF LDB 2,X ;get the device code ANDB #$80 ;IEEE device? IF NE ;yes... CALL SetLstnr,(2,S),#$0060 ;command listen ENDIF CLRA LDX ,S ;point to parameter block LDB 1,X ;get the access mode ANDB #$10 ;at EOR? IF EQ ;yes... LDX 4,S ;point to fcb LDD 1,X ;get record size LDX ,S ;point to parameter block STD 5,X ;and save as bytes remaining in the record ENDIF LDB [4,S] ;get the format CMPB #'f' ;fixed format? IF EQ ;yes... LOOP LDD 3,X ;get current byte position SUBD 5,X ;compare to bytes remaining QUIF GE ;record overfilled? CALL outbyte,(6,S),#$0020 ;output a byte to fill the record LDX ,S ;point to parameters LDD 3,X ;increment current byte position ADDD #1 STD 3,X ENDLOOP ;until we fill the record GUESS LDD 3,X ;get current byte position SUBD 5,X ;compare to bytes remaining ;; QUIF NE ;record filled, quit BNE EXIT22 LDB 2,X ;get device code CMPB #$81 ;is it the disk? QUIF NE ;no, quit LDB 12,X ;get disk SA IF NE ;assigned? LDD #8 ;no, choose SA 8 QUIF EQ ENDIF CALL addrbe5f,#$0020 ;send the byte ADMIT CALL outbyte,(6,S),#$0020 ;send the byte ENDGUESS ENDIF EXIT22 LDX ,S ;point to the parameter block LDB 2,X ;get the device code CMPB #$81 ;is it the disk drive? IF EQ LDB [4,S] ;get the file format CMPB #'t' ;text file? BNE addrc7e6 ;no, quit LDD 5,X ;any remaining text? BEQ addrc793 ;no, quit LDD 3,X ;get the current position SUBD 5,X ;compare to bytes remaining BGT addrc7e6 ;past it, quit BRA addrc793 ;AOK, continue on ENDIF CLRA ANDB #$80 ;ieee device? IF NE ;yes... addrc793 CALL addrd3de,(,S) ;let IEEE routine handle it ELSE LDB 2,X ;get device code CMPB #$04 ;host device? IF EQ ;yes... CALL hstendln,(,S) ;let host routine handle it ELSE CMPB #$05 ;terminal? IF EQ ;yes... LDB [4,S] ;get the file type CMPB #'f' ;fixed format? IF EQ ;yes... LDD 5,X ;get the present position SUBD #80 ;past end of the screen line? BGE addrc7e6 ;yes, no cr necessary ENDIF CALL tputchr,#$000d ;print the carriage return ELSE CMPB #$06 ;serial device? IF EQ ;yes... CLRB LOOP STD 2,S CMPB $7e ; ;,DP QUIF CC ADDD #$0378 PSHS D CLRA PULS X LDB ,X PSHS D CALL sputchr,(2,S) LEAS 2,S LDD 2,S ADDD #1 ENDLOOP ENDIF ENDIF ENDIF ENDIF addrc7e6 CLRA LDX ,S ;point to the parameter block LDB 1,X ;get the status flags ANDB #$ef ;set the EOR flag STB 1,X LDD #1 ;set the status to EOR STD 3,X addrc7f4 LEAS 6,S ;release our storage RTS sysskip PSHS D LEAS -3,S ;get us some stack space CALL usrhook_,#9 ;check for user hook CALL addrb636 ;reset the error flags LDX 3,S ;get pointer to the FCB LDD 4,X ;get pointer to the parmameter block STD ,S ;and save it LDX ,S ;point to parameter block CLR ,X ;clear error flag CLRA LDB 1,X ;get the access mode ANDB #$08 ;did we just do a new line? IF NE ;yes... LOOP ;for a relative file, read to the end of a record LDD #1 ;load read count PSHS D TFR S,X LDB #$04 ABX PSHS X CALL sysread,(7,S) ;read a byte LEAS 4,S LDB [,S] ;until the status is not 0 (error, EOF, EOR) UNTIL NE LDX ,S ;point to parameter block LDB ,X ;get the status flag CMPB #$01 ;hit eor? BNE sysskprt ;yes, so quit CLR ,X ;clear the status flag ELSE LDB 1,X ;get status flag ANDB #$10 ;at mid record? IF NE ;yes... CALL sysnl,(3,S) ;skip to the end of the record ENDIF ENDIF sysskprt LEAS 5,S ;release our storage RTS addrc846 PSHS D LEAS -2,S CALL usrhook_,#10 ;check for user hook CALL addrb636 ;reset the error flags LDX 2,S ;point to the FCB LDD 4,X ;get pointer to the parameter block STD ,S ;and save it LDX ,S ;point to the parameter block CLR ,X ;and set the status to zero LDB 2,X ;get the device type CMPB #$05 ;terminal? IF EQ ;yes... LDD 6,S ;get the line to seek to TFR B,A ;convert to a col, line format CLRB ADDD #$0101 ;transmute to absolute cursor addressing CALL tputcurs ;and 'seek' the cursor ELSE CMPB #$04 ;is it the host? IF EQ ;yes... CALL hstseek,(2,S),(6,S) ;let the host do it ELSE CMPB #$81 ;disk drive? BNE norandom ;no, we can't do a seek on anything else CLRA LDB 12,X ;get the file status word ANDB #$08 ;relative file? BEQ norandom ;no, we can't seek that either LDD 6,S ;get the record number ADDD #1 ;convert to absolute record PSHS D CALL addrbf98,(2,S) ;and position the record LEAS 2,S LDB $6a ;check the return code IF EQ ;uh, oh there was an error CALL addrbfef,(,S) ;check for error 50, (past eof) CALL equal,#msg50,#$0300,#$0002 ;was that it? IF NE ;yes... CALL addrb636 ;reset the error message CLR [,S] ENDIF ENDIF ENDIF ENDIF pop4 JMP addrca12 norandom LDB #$03 ;set the status flag to error STB [,S] LDD #msgnornd ;tell them it isn't a random file JMP addrc9a0 sysscrat PSHS D LEAS -2,S ;allocate some storage CALL usrhook_,#11 ;check for user hook CALL addrb636 ;clear the error flags LDX 2,S ;point to the FCB LDD 4,X ;point to the parameter block STD ,S ;and save CLR [,S] ;clear out error flag LDD 6,S ;get address of filename STD $68 ;and save CALL chkfname,(2,S) ;parse the file name LDX ,S ;point to the parameter block LDB 2,X ;get the device code CMPB #$81 ;disk? IF EQ ;yes... CALL addrbd96,(,S) ;call the IEEE scratch routine LDB $6a ;was there an error? BNE addrc961 ;no, so quit CALL addrbfef,(,S) ;print out the error message BRA addrc961 ;and get out of here ENDIF CMPB #$04 ;host device? BNE addrc957 ;no, tell them that we don't support it CALL hstscr,(,S) ;let the host scratch the file BRA addrc961 ;and quit sysrenam PSHS D LEAS -2,S CALL usrhook_,#12 ;check for user hook CALL addrb636 ;clear the error flags LDX 2,S ;point to the FCB LDD 4,X ;point to the parameter block STD ,S ;and save it CLR [,S] ;clear the error flag LDD 6,S ;get address of file name STD $68 ;and save it CALL chkfname,(2,S) ;parse the filename LDX ,S ;point to parameters LDB 2,X ;get the device code CMPB #$81 ;disk? IF EQ ;yes... CALL addrbdc6,(2,S),(8,S) ;let the IEEE routine rename it LDB $6a ;was there an error? BNE addrc9a3 ;no, quit CALL addrbfef,(,S) ;print out the error message BRA addrc9a3 ;and quit ENDIF CMPB #$04 ;host device? IF EQ ;yes CALL hstrenam,(2,S),(8,S) ;let the host rename it BRA addrc9a3 ENDIF addrc957 CALL addrb653,#msgnosup ;we don't support that device, tell them LDB #$03 addrc95f STB [,S] addrc961 BRA addrc9a3 sysmount PSHS D LEAS -2,S ;get us some space CALL usrhook_,#13 ;check for user hook CALL addrb636 ;clear error flag LDX 2,S ;point to FCB LDD 4,X ;point to parameter block STD ,S ;and save CLR [,S] ;clear the error flag LDD 6,S ;get address of filename STD $68 ;and save CALL chkdirpm,(2,S) ;parse the name LDB $6a ;error occured? IF EQ ;no... LDX ,S ;point to parameter block LDB 2,X ;get device type CMPB #$81 ;disk? IF EQ yes... CALL addrbe23,(,S) ;mount it LDB $6a ;error occured? BNE addrca12 ;no CALL addrbfef,(,S) ;print out the error message BRA addrca12 ENDIF addrc99d LDD #msgnosup ;we fell through, it isn't supported. addrc9a0 CALL addrb653 ;print out error message ENDIF addrc9a3 BRA addrca12 getacmod PSHS D CALL length,(4,S) ;how long is the mode? PSHS D ;save length LDD 6,S ;and address of the name PSHS D CALL tableloo,#filecmod ;and find out what type it is LEAS 4,S ADDD #addrb1b1 ;convert lookup value into a table offset PSHS D CLRA PULS X LDB ,X ;get access code from the table LDX ,S ;point to parameter block STB 1,X ;and save in the access code for the FCB BNE pop2 ;if it is valid, then return CALL addrb653,#msginvmd ;tell them it's no good LDB #$03 ;set the error flag STB [,S] BRA pop2 ;and return geterror PSHS D LEAS -2,S ;get us some space CALL usrhook_,#14 ;check for user hook LDX 2,S ;get pointer to the FCB LDD 4,X ;get pointer to the parameter block STD ,S ;save for reference LDX ,S ;point to parameter block LDB ,X ;check status flag IF EQ ;error occured? LDB 2,X ;get device type CMPB #$81 ;disk? IF EQ ;yes... CLRA LDB 12,X ;get file status word ANDB #$04 ;error message read? IF EQ ;no... LDB 12,X ;get file status word ANDB #$02 ;message read already?... IF EQ ;no... CALL addrbfef,(,S) ;read the ieee error message LDX ,S ;point to parameter block STB ,X ;save return code as status CLRA LDB 12,X ;set file status word to indicate message r ORB #$06 STB 12,X ENDIF ENDIF ENDIF ENDIF CLRA LDB [,S] ;get the error code to return addrca12 LEAS 4,S ;release our storage RTS chekcod2 PSHS D LDX ,S ;point to FCB LDB [4,X] ;get the status CMPB #$02 ;was it EOF BRA setret chekcod1 PSHS D LDX ,S ;point to FCB LDB [4,X] ;get the status CMPB #$01 ;was it EOR setret IF EQ ;test the result of the last comparison LDA #$ff ;true, set the EQ/NEQ flag FCB $21 ;this is a trick to skip the CLRA ENDIF CLRA TFR A,B ;D will now have either -1 or a 0 pop2 LEAS 2,S ;clean up the stack and return RTS crtinit1 LDD #$0014 STD $0368 STD $036a CLRA CLRB STD $036c STD $036e LDD #$0064 STD $0370 CLRA CLRB STD $0372 STD $0374 STD $0376 RTS msginvac FCS "invalid access" msg50 FCS "50" msgtrunc FCS "truncated" msgnornd FCS "Not Random" msgnosup FCS "not supported" msginvmd FCS "invalid mode" sysdirop PSHS D LEAS -2,S ;get us some space CALL usrhook_,#17 ;check for user hook CALL addrb636 ;reset error flag LDX 2,S ;get address of FCB LDD 4,X ;get address of parameter block STD ,S ;and save for reference LDX ,S ;get address of parameter block CLR ,X ;and clear out status flag LDD 6,S ;get address of string STD $68 ;and save CLR 1,X ;clear out access mode CALL chkdirpm,(2,S) ;parse the device string LDB $6a ;did an error occur? IF EQ ;no... LDX ,S ;point to parameter block LDB 2,X ;get device code CMPB #$81 ;disk? IF EQ ;yes... CALL filopen,(,S) ;open the file CALL SetTalkr,(,S) ;command talk to the bus CALL addrbefb ;get the data CALL addrbefb ELSE CMPB #$04 ;host? IF EQ ;yes... CALL hsrdirop,(,S) ;let the host open it up ENDIF ENDIF ENDIF CLRA LDB $6a ;get the error code STB [,S] ;and save in the status byte LEAS 4,S RTS sysdirrd PSHS D LEAS -2,S ;get us some space on the stack CALL usrhook_,#18 ;check for user hook CALL addrb636 ;clear the error flags LDX 2,S ;get address of FCB LDD 4,X ;get address of parameter block STD ,S ;and save for use LDX ,S ;point to parameter block CLR ,X ;clear out status flags LDB 2,X ;get device code CMPB #$81 ;disk? LBNE dohstdir ;no, assume it is the host CLRA LDB 12,X ;get the file status word ANDB #$01 ;eof hit on a read? IF EQ ;no... CALL SetTalkr,(,S) ;command talk on the bus CALL addrbefb ;read the data CALL addrbefb CLRA LDX ,S ;point to the parameter block LDB 12,X ;get the file status word ANDB #$01 ;EOF? IF EQ CALL addrbefb ;get a char PSHS D ;save it CALL addrbefb ;get another one TFR B,A ;put as the high order byte CLRB ADDD ,S ;and make the first one the low order byte PULS X ;remove byte from the stack PSHS D CALL itos,(8,S) ;convert word read to a string LEAS 2,S CALL suffixst,#msgspace,(6,S) ;pad with a blank LDD 6,S PSHS D CALL length,(8,S) ;and find out how long it is ADDD ,S ;compute end of the string PULS X ;remove value from stack LOOP STD 6,S CALL addrbefb ;get a character LDX 6,S ;add to end of the string STB ,X LDB $6a ;did an error occur? QUIF NE ;yes, quit LDB ,X ;was the character a null (EOL) QUIF EQ ;yes, quit CMPB #$12 ;was it a CBM RVS? IF EQ ;yes... LDB #BLANK ;convert it to a space STB ,X ENDIF LDD 6,S ;increment the pointer to the string ADDD #1 ENDLOOP LDB $6a ;did an error occur? BNE pop4a ;yes, quit LDB #$01 ;set eor flag STB [,S] BRA pop4a ENDIF ENDIF CLR [6,S] LDB #$02 ;set EOF flag STB [,S] CALL addrb63e BRA pop4a dohstdir CALL hstdirrd,(2,S),(6,S) ;read the directory from the host BRA pop4a sysdircl PSHS D LEAS -2,S ;allocate some storage CALL usrhook_,#19 ;check for user hook CALL addrb636 ;reset the error flags LDX 2,S ;get address of FCB LDD 4,X ;get address of parameter block STD ,S ;and save for use LDX ,S ;point to parameter block CLR ,X ;clear status flag LDB 2,X ;get device code CMPB #$81 ;disk? IF EQ ;yes... CALL filclose,(,S) ;close it ELSE CMPB #$04 ;host? IF EQ ;yes... CALL hstdircl,(,S) ;close it ENDIF ENDIF pop4a LEAS 4,S ;release our stack space RTS msgspace FCS " " msgalpha FCC "ABCDEFGHIJKLMNOP" init2400 PSHS D LDD #$004f ;set up serial buffer size STD $0a CLRA CLRB STD $0c ;set up ? STD $0e CLR $10 STD $08 ;set owner of host link serial FCB LDB #$13 ;load default response character STB $7d LDB #$0d ;load default linend character STB $7b LDB #$01 ;load default prompt count STB $7c LDB #$11 ;load default prompt LDX #$037c STB ,X LDB 7,S addrcc00 PSHS D LDB 7,S PSHS D LDD 4,S PSHS D CALL sioinit,#ACIA_R0 ;initialize the serial I/O port LEAS 8,S RTS hstopen PSHS D LEAS -13,S ;get us some stack space CALL usrhook_,#31 ;check for user hook CALL hstrlsfl,(13,S) ;release the host channel CALL hsttobuf,#'v' ;set up to write a 'v80' to the host CALL hsttobuf,#'8' CALL hsttobuf,#'0' CALL hstsend ;send the buffer CALL userchek ;check the error code STB [13,S] ;save in the status LDB $6a ;check the return code LBNE addrcce3 ;error occurred, so quit CALL hstrlsfl,(13,S) ;release the host channel CALL hsttobuf,#'o' ;start the open command format CLRA LDB 20,S ;get the mode CALL hsttobuf ;and put in buffer LDX 13,S ;point to parameter block LDB 16,X ;check the code type IF NE LDD #'b' ;binary file ELSE LDD #'t' ;text file ENDIF CALL hsttobuf ;put the code type into the command CALL hsttobuf,#BLANK ;followed by a space CALL hsttobuf,#'(' ;left parenthesis CLRA LDB 18,S ;get the file format CALL hsttobuf ;and add to the command LDX 13,S ;point to the parameter block LDD 5,X ;get the LRECL IF NE ;variable format? PSHS D ;save lrecl TFR S,X ;find out where we can put the string LDB #$04 ;why not on the stack? at S+4 ABX PSHS X PULS D CALL itos ;convert the LRECL LEAS 2,S CALL hsttobuf,#':' ;put a colon in to separate it TFR S,X ;now where did we put the string? LDB #$02 ;We found it at S+2 (phew!) ABX PSHS X PULS D ;point the the string LOOP STD ,S LDX ,S LDB ,X ;get the next character from the converted string QUIF EQ ;end of the string, quit CLRA CALL hsttobuf ;put it in the buffer to go out LDD ,S ;increment pointer to the string ADDD #1 ENDLOOP ENDIF CALL hsttobuf,#')' ; finish it off with a right parenthesis LOOP LDX $68 ;point to file identifier LDB ,X ;get a char QUIF EQ ;end of string, quit CLRA CALL hsttobuf ;put character into the buffer LDX $68 ;increment file identifier pointer LEAX 1,X STX $68 ENDLOOP CALL hstsend ;send the buffer CALL syscheck ;check the return message from the host STB [13,S] ;save return code in the status LDB $6a ;did an error occur? IF EQ ;no.... CALL hstfrmbf ;get the host file ID from the buffer LDX 13,S ;point to the parameter block STB 11,X ;save as host file ID for this FCB CLR 12,X ;reset the pre-empt flag CALL emptybuf ;and clean out the buffer ENDIF addrcce3 LEAS 15,S ;release our storage RTS hstwrbuf PSHS D CALL usrhook_,#32 ;check for user hook CALL hstestfl,(,S) ;establish the link to the host file LDB #$02 ;establish file as a host user STB $10 LDD $0e ;is there a buffer write command in progress? IF EQ ;no... CALL hsttobuf,#'p' ;format start of buffer write command CLRA LDX $08 ;get current host user LDB 11,X ;get associated host ID CALL hsttobuf ;put it into the buffer CALL hsttobuf,#'n' ;rest of the buffer write command ENDIF addrcd0f LDX ,S ;point to parameter block LDB $0010,X ;check to see if the file is a PRG or TXT file IF NE ;binary... CLRA ;get byte LDB 5,S CALL hstsndob ;write it to the buffer as ascii text BRA addrcd57 ENDIF addrcd1e CLRA LDB 5,S ;get the character CALL hsttobuf ;and put it into the buffer BRA addrcd57 hstendln PSHS D CALL usrhook_,#33 ;check for user hook CALL hstestfl,(,S) ;establish the file as a host user LDD $0e ;is the buffer empty? IF EQ ;yes... CALL hsttobuf,#'p' ;format start of the newline command CLRA LDX $08 ;point to current user LDB 11,X ;get host file ID CALL hsttobuf ;and put it into the buffer CALL hsttobuf,#'z' ;finish up the command ELSE LDB #'z' ;buffer wasn't empty, save flag STB $0382 ENDIF CLR $10 ;set access style to neutral CALL hstcheck ;send and check error addrcd57 LEAS 2,S RTS hstread PSHS D LEAS -1,S CALL usrhook_,#34 ;check for user hook CALLS hstestfl,(1,S) ;establish file as host user link IF NE ;different file? LDX $08 ;point to parameter block LDB 12,X ;get pre-empted flag IF NE ;was it interrupted? CALL hstrqust,#-1 ;request that the host sent it again LDX $08 ;point to parameter block CLR 12,X ;reset pre-empt flag LDD 13,X ;get the buffer pointer STD $0e ;and restore it ENDIF ENDIF LDD $0e ;get buffer pointer SUBD $0c ;is the buffer empty? IF GE ;yes... CLRA ;have the host send the next record CLRB CALL hstrqust ENDIF LDB #$01 ;set file access state to reading STB $10 LDD $0e ;get buffer pointer SUBD $0c ;see if it is empty IF LT ;no... LDX $08 ;get pointer to parameter block LDB $0010,X ;is it a binary file? IF NE ;yes... CALL hstrdob ;read as a binary file BRA addrcda6 ENDIF CALL hstfrmbf ELSE LDB #BLANK ;empty, give them a blank ENDIF addrcda6 STB ,S ;save the character LDD $0e ;get buffer pointer SUBD $0c ;is the buffer empty? BNE addrcdd6 ;yes, quit LDX $08 ;point to the parameter block LDB 15,X ;EOR recieved from the host? CMPB #$ff IF EQ ;yes LDB ,X ;status <> OK? IF EQ ;no... LDB #$01 ;set status to EOR STB ,X ENDIF ENDIF addrcdbe CLR $10 ;set access mode flag to normal BRA addrcdd6 hstestfl PSHS D LEAS -1,S ;get some stack space CLR ,S ;set switched flag to false LDD $08 ;get parameter block of link owner SUBD 1,S ;same person? IF NE ;no... CALLS hstrlsfl,(1,S) ;so switch owners LDB #$ff ;set switched flag to true STB ,S ENDIF addrcdd6 CLRA ;get switched flag LDB ,S LEAS 3,S RTS hstrlsfl PSHS D GUESS LDD $0e ;is there any data present? QUIF LE ;yes, save it LDB $10 ;is the buffer set for write access? CMPB #$02 QUIF NE ;no, check it out CALLS hstcheck ;force the last buffer out ADMIT LDB $10 ;is the buffer set for read access? CMPB #$01 IF EQ ;yes... LDB #$ff ;set the pre-empt flag LDX $08 STB 12,X LDD $0e ;save the present buffer pointer STD 13,X ENDIF ENDGUESS CLR $10 ;set the access flag to neutral CLRA CLRB STD $0c ;initialize for a new file STD $0e ;set the buffer pointer to be empty LDD ,S ;get pointer to FCB STD $08 ;and save as working for the host LEAS 2,S ;release our storage RTS hstcheck CALL hstsend ;send the present serial buffer CALL userchek ;check the error code returned LDX $08 ;get pointer to working FCB STB ,X ;and save return code as the status RTS hstsndob PSHS D LEAS -2,S ;get us some storage LDD #msghex ;get pointer to translation table STD ,S CLRA LDB 3,S ;get byte to translate LSRA ;shift high nybble to low nybble place RORB LSRA RORB LSRA RORB LSRA RORB CLRA ANDB #$0f ;mask off any extraneous bits set ADDD ,S ;form an index into the translation table PSHS D CLRA PULS X LDB ,X ;get the translated character CALLS hsttobuf ;and put into the buffer CLRA LDB 3,S ;get the byte to translate again ANDB #$0f ;mask off all but the low order nybble ADDD ,S ;form index into the translation table PSHS D CLRA PULS X LDB ,X ;get the translated character CALLS hsttobuf ;and put it into the buffer LEAS 4,S ;release our storage RTS hstrdob CALLS hstfrmbf ;get a char from the host CALL hex ;convert to the hex equivalent LSLB ;move the high order nybble ROLA LSLB ROLA LSLB ROLA LSLB ROLA PSHS D ;and save CALLS hstfrmbf ;get the next char CALL hex ;convert to its hex equivalent ORA ,S ;and mask in the first nybble ORB 1,S PULS X ;releasing the space on the stack RTS hsttobuf PSHS D ;save the character LDD $0e ;point to next position in the buffer PSHS D ADDD #1 STD $0e PULS D ;get the present offset in the buffer ADDD #$0380 ;compute absolute position PSHS D ;and save CLRA LDB 3,S ;get the character PULS X ;and where to put it STB ,X ;then put it there LDD $0e ;get the present index SUBD $0a ;compare to the size BLT addrcef6 ;not to the end yet, quit CALLS hstcheck ;send the buffer and check the error code CLR $10 BRA addrcef6 hstfrmbf LEAS -1,S ;get us a little space LDD $0e ;get the present index SUBD $0c ;past end of what they sent us? IF GE ;yes... CALL hstvrify ;so do something about it ENDIF addrce96 LDD $0e ;increment the present buffer index PSHS D ADDD #1 STD $0e PULS D ;get the present index ADDD #$0380 ;and compute actual location of the character PSHS D CLRA PULS X LDB ,X ;get the character at that location STB ,S ;and save LDD $0e ;get the present index SUBD $0c ;compare to length of the buffer IF GE CLR $10 ;say the buffer is empty CLRA CLRB STD $0c ;set both input and output lengths to zero STD $0e ENDIF JMP addrd18c hstrqust PSHS D CALLS hsttobuf,#'g ;format start of host request command CLRA LDX $08 ;point to working FCB LDB 11,X ;get the assigned host fileid CALLS hsttobuf ;and put it into the buffer LDB 1,S ;check request code IF NE ;nonzero?, yes CALLS hsttobuf,#'l ;add a 'l' to the command ENDIF addrced5 CALL hstsend ;send the buffer CALL syscheck ;and get the system error message LDX $08 ;point to working FCB STB ,X ;and set the error status LDB $6a ;did an error occur? IF EQ ;no... CALLS hstfrmbf ;get the first byte from the buffer SUBD #'z ;did they send a 'z' back? IF EQ ;yes... LDB #$ff ;set the EOR flag in the FCB LDX $08 STB 15,X ELSE LDX $08 ;reset the EOR flag in the FCB CLR 15,X ENDIF ENDIF addrcef6 JMP addrd09c hstseek PSHS D LEAS -13,S ;get us some working space CALL usrhook_,#35 ;check for user hook CALL hstrlsfl,(13,S) ;establish the link as the present FCB LDD 17,S ;get the record to seek PSHS D ;now where can we put the converted string? TFR S,X ;how about S+4? LDB #4 ABX PSHS X PULS D ;now that we know where to put it CALL itos ;and convert the record number to an ascii string LEAS 2,S CALL hsttobuf,#'r' ;format the host seek command TFR S,X ;now where did we put that string? LDB #2 ;got it at S+2 ABX PSHS X PULS D ;point to the string LOOP STD ,S ;save our pointer LDX ,S LDB ,X ;get the character at that position QUIF EQ ;end of string, quit CLRA CALL hsttobuf ;put it into the buffer LDD ,S ;increment our index into the string ADDD #1 ENDLOOP CALL hstsend ;send the buffer CALL userchek ;check the return code STB [13,S] ;and save as the status bute of the wroking FCB LEAS 15,S ;get rid of our stack space RTS hstclose PSHS D CALL usrhook_,#36 ;check for user hook CALL hstrlsfl,(,S) ;establish the link to the host CALL hsttobuf,#'c' ;format start of the close command CLRA LDX ,S ;get the assigned host file ID LDB 11,X JMP addrd03c ;and let someone else send it out hstscr PSHS D CALL hstrlsfl,(,S) ;establish the link to the host CALL hsttobuf,#'y' ;format start of the scratch command LOOP addrcf71 LDX $68 ;get the address of the file to scratch LDB ,X ;get the next character LBEQ addrd03f ;end of string, quit CLRA CALL hsttobuf ;put it into the buffer LDX $68 ;and increment the pointer into the file stri LEAX 1,X STX $68 ENDLOOP hstrenam PSHS D CALL hstrlsfl,(,S) ;establish link to host CALL hsttobuf,#'w' ;format start of the rename command LOOP LDX $68 ;get pointer to file to rename LDB ,X ;get next character QUIF EQ ;end of string, quit CLRA CALL hsttobuf ;put the character in the buffer LDX $68 ;increment pointer to the file name LEAX 1,X STX $68 ENDLOOP CALL hstsend ;send the command CALL userchek ;and check the return from the host STB [,S] ;saving in the status flag for working FCB LDB $6a ;did an error occur? LBNE addrd09c ;yes, quit CALL hstrlsfl,(,S) ;release the file link CALL hsttobuf,#'b' ;format the command for the new filename LOOP LDX 4,S ;point to the new name string LDB ,X ;get the next character from it BEQ addrd03f ;end of string, quit and send it CLRA CALL hsttobuf ;put the character into the buffer LDD 4,S ;and increment pointer to the string ADDD #1 STD 4,S ENDLOOP hsrdirop PSHS D CALL hstrlsfl,(,S) ;release the present working FCB CALL hsttobuf,#'d' ;format start of the host directory open command LOOP LDX $68 ;point to string to send LDB ,X ;get the next character BEQ addrd03f ;end of string, quit and send it CLRA CALL hsttobuf ;put the character into the buffer LDX $68 ;and increment pointer to the string LEAX 1,X STX $68 ENDLOOP hstdirrd PSHS D LEAS -2,S ;get us some space on the stack CALL hstrlsfl,(2,S) ;release the present host link CLRA CLRB STD ,S ;set the length of the string read to zero CALL hsttobuf,#'f' ;format the host directory read command CALL hstsend ;and send it CALLS syscheck ;check the return message STB [2,S] ;and save the return code in the status byte LDB $6a ;did an error occur? IF EQ ;no...quit LOOP LDD $0e ;get the pointer in the return buffer SUBD $0c ;reached the end? QUIF GE ;yes, quit LDD ,S ;increment the length count ADDD #1 STD ,S CALL hstfrmbf ;get a character from the buffer STB [6,S] ;and save in buffer supplied LDD 6,S ;increment output buffer pointer ADDD #1 STD 6,S ENDLOOP CLR [6,S] ;set the end of the string to a null ENDIF addrd02d LDD ,S ;get the length of the string found LEAS 4,S RTS hstdircl PSHS D CALL hstrlsfl,(,S) ;release the present host file link LDD #'k' ;prepare for a host directory close command addrd03c CALL hsttobuf ;and put it in the buffer addrd03f CALLS hstsend ;send the present buffer CALLS userchek ;check what they sent back STB [,S] ;and save in the status byte BRA addrd09c userchek LEAS -1,S ;get a little space CALLS syscheck ;see what the host has to say STB ,S ;save the return code IF EQ ;error? CALLS emptybuf ;yes, clean out the buffer ENDIF addrd051 JMP addrd18c syscheck LEAS -1,S ;get us a little space LDB $6a ;get the present error flag CMPB #$03 ;error occurred? IF NE ;no... CALL hstfrmbf ;get the first character returned STB ,S ;and save CMPB #'b' ;OK? IF EQ ;yes... CALL addrb636 ;reset the error flag ELSE CMPB #'e' ;EOF? IF EQ ;yes... CALL addrb63e ;set the EOF message CALLS emptybuf ;and clean out the buffer ELSE ;otherwise... LDB #$03 ;set the error flag STB $6a CALLS hstemsg ;and get the message from the host ENDIF ENDIF ENDIF CLRA LDB $6a ;get the present error code LEAS 1,S ;remove our space on the stack RTS hstemsg LEAS -2,S ;get us a little space LDD #$0300 ;point to the emsg buffer LOOP STD ,S ;save our pointer LDD $0e ;get positon within buffer SUBD $0c ;past end of buffer? QUIF GE ;yes, quit CALL hstfrmbf ;get the next character from the host STB [,S] ;save it LDD ,S ;increment our buffer pointer ADDD #1 ENDLOOP addrd09a CLR [,S] ;add a null to signal end of string addrd09c LEAS 2,S ;and get rid of our storage RTS emptybuf LOOP LDD $0e ;get the present buffer index SUBD $0c ;past end of the buffer? QUIF GE ;it's empty, quit CALL hstfrmbf ;get another character out of the buffer ENDLOOP addrd0aa RTS hstsend LEAS -4,S CALL usrhook_,#37 ;check for user hook LOOP CLR 1,S ;reset the CRC value CLRA ;set index into buffer to zero CLRB STD 2,S LOOP LDD 2,S ;get our present index SUBD $0e ;reached end of the buffer? QUIF GE ;yes, quit LDD 2,S ;get present index ADDD #$0380 ;compute address of character PSHS D CLRA PULS X LDB ,X ;get the character STB ,S LDB 1,S ;get the present CRC value ADDB ,S ;add in this character ADCA #0 STB 1,S ;and save CRC value LDD 2,S ;increment the buffer index ADDD #1 STD 2,S CLRA LDB ,S ;get the character to send CALL hstsndwt ;and send it out the serial port ENDLOOP CLRA ;get the CRC value LDB 1,S ANDB #$0f ;mask off all but the last nybble STB 1,S ADDD #msgalpha ;compute address of corresponding checksun charac PSHS D CLRA PULS X LDB ,X ;get checksun character CALL hstsndwt ;and send to the host CLRA LDB $7b ;get the present linend character CALL hstsndwt ;and send it to the host CLRA LDB $0380 ;get the first character STB ,S ;and save it CALLS hstvrify ;get the host's response LDB $0380 CMPB #'N' ;was it valid? QUIF NE ;yes, no need to retry CLRA LDB ,S STB $0380 ;restore the first character LDD 2,S ;restore the count STD $0e ENDLOOP ;and try again LEAS 4,S ;release our storage RTS hstvrify LEAS -1,S CALL usrhook_,#38 ;check for user hook LOOP CLRA CLRB STD $0e ;reset length of input ans buffer pointers STD $0c LOOP CALLS hstrdlin ;read a line from the host STB ,S ;save the character LDB $6a ;check the error flag CMPB #$03 ;error? BEQ addrd18f ;yes, quit LDB ,S ;get the character CMPB #$0d ;carriage return QUIF EQ ;yes, quit LDD $0c ;increment the input buffer length PSHS D ADDD #1 STD $0c PULS D ;get the index into the buffer ADDD #$0380 ;compute address to put character PSHS D CLRA LDB 2,S ;get the character PULS X STB ,X ;and save in the buffer ENDLOOP LDB $0380 ;get the first character from the buffer CMPB #'N' ;retransmit request? BEQ addrd18f ;yes, quit LDD $0c ;decrement the input length to ignore checksum ADDD #-1 STD $0c PSHS D CALL hstchksm,#$0380 ;compute the checksum on the buffer LEAS 2,S BNE addrd18f ;checksum ok, quit CALLS hstsndwt,#'N ;tell him to try again. CLRA LDB $7b CALLS hstsndwt ENDLOOP hstrdlin LEAS -1,S ;get a little stack space CALL sgetchr,($08 ) ;get a character from the host STB ,S ;and save the character CMPB $7b ;is it the linend character? IF EQ ;yes... CALLS hstwtpmt ;wait for their prompt LDB #$0d ;and return the charcter as a carriage return STB ,S ENDIF addrd18c CLRA LDB ,S ;get the character addrd18f LEAS 1,S ;release our stack space RTS hstsndwt PSHS D ;save the character to send CLRA LDB 1,S ;get the character PSHS D CALL sputchr,($08 ) ;and write it out the host serial port LEAS 2,S LDB 1,S CMPB $7b ;was the character a linend character? IF EQ ;yes... LOOP ;until the host returns the response character LDB $6a ;error occured? QUIF NE ;yes, quit CALL sgetchr,($08 ) ;get another character form the port CMPB $7d ;response character? UNTIL EQ ENDIF LEAS 2,S ;release our storage RTS hstwtpmt LEAS -7,S ;get us some stack space CLRA ;set count to zero CLRB STD ,S LOOP PSHS D ;save the count TFR S,X ;where can we put what the host sends back? LDB #$04 ;try S+4 ABX PSHS X PULS D ADDD ,S ;use our count as an index into the space PULS X ;throw away the copy of the count PSHS D ;save the location to put the character CALL sgetchr,($08 ) ;get a character form the host PULS X ;get the location to store it STB ,X ;and save it LDD ,S ;increment the count ADDD #1 STD ,S CMPB $7c ;got the number setup for the host prompt? UNTIL EQ ;no, keep getting them ADDD #-1 ;decrement our count to adjust for the extra increment STD ,S LOOP CLRA LDB $7c ;get the number of prompt characters PSHS D LDD #$037c ;get the location of the prompt PSHS D TFR S,X ;where is what we read in from the host? LDB #6 ;at S+6 ABX PSHS X PULS D CALL equal ;does our prompt match what was desired? LEAS 4,S QUIF NE ;yes, gotit, so quit LDD ,S ;get the count PSHS D TFR S,X ;get the location of the setup prompt buffer LDB #4 ;at S+4 ABX PSHS X TFR S,X ;get the location of the returned buffer LDB #6 ;at S+6 ABX PSHS X PULS D ADDD #1 ;and we want remove the first byte from it CALL copy ;so move it up destructively LEAS 4,S LDD ,S ;get the present index PSHS D TFR S,X ;point to the location of the return buffer LDB #$04 ABX PSHS X PULS D ADDD ,S ;find the end of the buffer to put the new character PULS X PSHS D CALL sgetchr,($08 ) ;get the character PULS X STB ,X ;and save into the buffer LDB $6a ;did an error occur? UNTIL NE ;no, try again LEAS 7,S ;remove our storage RTS hstchksm PSHS D ;save the address of the buffer LEAS -1,S ;get space for the CRC CLR ,S ;set CRC to zero LOOP CLRA LDB ,S ;get the present CRC ADDB [1,S] ;add in the next charcter in the buffer ADCA #0 STB ,S ;save the CRC LDD 1,S ;increment the buffer pointer ADDD #1 STD 1,S LDD 5,S ;decrement the buffer length ADDD #-1 STD 5,S UNTIL LE ;until we have done the entire buffer CLRA LDB ,S ;get the CRC ANDB #$0f ;mask out all but the low order nybble ADDD #msgalpha ;compute offset into the checksum array PSHS D LDB [3,S] ;get the checksum from the host buffer PULS X CMPB ,X ;compare to the checksum character according to CRC IF EQ ;the same? LDA #$ff ;yes, set a true flag FCB $21 ;BRN instruction - skip the CLRA ENDIF ;not the same, set a false flag CLRA TFR A,B ;duplicate return flag LEAS 3,S ;release our storage RTS msghex FCS "0123456789ABCDEF" ieeopen PSHS D LDX ,S LDB 2,X CMPB #$81 addrd294 BNE addrd308 CLRA LDB 12,X ANDB #$40 BEQ addrd308 LDB 1,X ANDB #$40 IF NE LDB #$01 STB 10,X LDD $68 PSHS D CALL prefixst,#addrd3fb BRA addrd2fd ENDIF addrd2b3 LDB 1,X ANDB #$80 BEQ addrd2bd CLR 10,X BRA addrd2ff addrd2bd LDB 1,X ANDB #$01 BEQ addrd2cc LDD $68 addrd2c5 PSHS D LDD #addrd3fd BRA addrd2fa addrd2cc LDB 1,X ANDB #$04 BEQ addrd2db LDD $68 PSHS D LDD #addrd400 BRA addrd2fa addrd2db LDB 1,X ANDB #$02 BEQ addrd2ff LDB 12,X ANDB #$08 BNE addrd2ff CALL prefixst,#addrd3fb,($68 ) LDD $68 PSHS D LDD #addrd403 addrd2fa CALL suffixst addrd2fd LEAS 2,S addrd2ff CLRA LDX ,S LDB 12,X ANDB #$f9 STB 12,X addrd308 LDB 2,X CMPB #$81 IF EQ CLRA LDB 12,X ANDB #$08 IF NE CALL ieeeOpen,(,S) JMP addrd3f8 ENDIF ENDIF addrd31d CALL filopen,(,S) LDX ,S LDB 2,X CMPB #$82 LBNE addrd3f8 CLR 11,X JMP addrd3ee addrd331 PSHS D CALL filclose,(,S) LEAS 2,S RTS addrd33b PSHS D LEAS -1,S CLRA LDX 1,S LDB 12,X ANDB #$01 BEQ addrd351 LDB #$02 STB ,X CALL addrb63e BRA addrd375 addrd351 LDB 12,X ANDB #$f9 STB 12,X CALL addrbefb STB ,S CLRA LDX 1,S LDB 12,X ANDB #$01 BEQ addrd375 LDB 12,X ANDB #$08 BEQ addrd375 LDB #$01 STB ,X LDB 12,X ANDB #$fe STB 12,X addrd375 CLRA LDB ,S LEAS 3,S RTS addrd37b PSHS D CLRA LDX ,S LDB 12,X ANDB #$f9 STB 12,X LDB 2,X CMPB #$82 BNE addrd3d6 LDB 11,X BEQ addrd398 CLR 11,X LDD #$0011 CALL ByteOut_ addrd398 LDB 5,S CMPB #$41 BCS addrd3a2 CMPB #$5a BLS addrd3bf addrd3a2 CMPB #$61 BCS addrd3af CMPB #$7a BHI addrd3af CLRA ANDB #$df BRA addrd3c2 addrd3af CMPB #$5f BNE addrd3b7 LDB #$64 BRA addrd3c2 addrd3b7 CMPB #$5b BCS addrd3c6 CMPB #$5e BHI addrd3c6 addrd3bf CLRA ORB #$80 addrd3c2 STB 5,S BRA addrd3d6 addrd3c6 CMPB #$0d BNE addrd3d6 LDX ,S LDB 10,X CMPB #$02 BCC addrd3d6 LDB #$ff STB 11,X addrd3d6 CLRA LDB 5,S CALL ByteOut_ BRA addrd3f8 addrd3de PSHS D LDD #$000d CALL addrbe5f LDX ,S LDB 2,X CMPB #$82 BNE addrd3f8 addrd3ee LDB 10,X CMPB #$02 BCC addrd3f8 LDB #$ff STB 11,X addrd3f8 LEAS 2,S RTS addrd3fb FCS "@" addrd3fd FCS ",R" addrd400 FCS ",A" addrd403 FCS ",W" initfcbs LDD #$57F STD $75 STD $73 LDX $73 CLR ,X RTS asignfcb LEAS -6,S CALL addrb636 ;clear status LDD $75 STD ,S addrd41b LDD ,S SUBD $73 BEQ addrd42e LDD ,S ADDD #-26 STD ,S LDB [,S] CMPB #$01 BNE addrd41b addrd42e LDB [,S] BNE addrd442 LDD ,S ADDD #-26 STD ,S SUBD #$0480 BCS addrd475 LDD ,S STD $73 addrd442 CLR [,S] LDD ,S ADDD #1 STD 2,S ADDD #$0008 STD 4,S LDD $6b BNE addrd45a LDD 2,S LDX 2,S BRA addrd466 addrd45a LDX $6b LDD 6,X LDX 2,S STD 6,X LDD 2,S LDX $6b addrd466 STD 6,X LDD 4,S LDX 2,S STD 4,X CLR 3,X CLR [$04,S] BRA addrd47f addrd475 CLRA CLRB STD 2,S LDD #addrd4be CALL addrb653 addrd47f LDD 2,S BRA addrd4bb freefcb PSHS D LEAS -4,S LDD 4,S ADDD #-1 STD ,S LDD 4,S addrd490 STD 2,S LDX 2,S LDD 6,X SUBD 4,S BEQ addrd49e LDD 6,X BRA addrd490 addrd49e LDX 4,S LDD 6,X LDX 2,S STD 6,X LDB #$01 STB [,S] addrd4aa LDX $73 LDB ,X CMPB #$01 BNE addrd4bb LDD $73 ADDD #$001a STD $73 BRA addrd4aa addrd4bb LEAS 6,S RTS addrd4be FCS "out of memory" tioinit JSR crtinit JMP addrdd48 tgetchr PSHS D LEAS -1,S CALL usrhook_,#39 CALL TRMGETCH STB ,S CMPB #$0d IF EQ LDB #$01 STB [$0001,S] ENDIF CLRA LDB ,S LEAS 3,S RTS tputchr PSHS D CALL usrhook_,#40 CLRA LDB 1,S CALL TERMPUTC BRA tsetcha1 tgetcurs CALL usrhook_,#41 JMP tcalcurs tputcurs PSHS D CALL usrhook_,#42 LDD ,S CALL tputcur1 BRA tsetcha1 tbreak CALL usrhook_,#43 JMP dotbreak ; Sets the screen's character set. If the value is 1, the screen is to display the ASCII ; character set. if the value is 2 the screen is to display the APL character set tsetchar PSHS D GUESS LDD ,S SUBD #1 QUIF NE CALL TSETASCI ; Display ASCII Character set ADMIT LDD ,S SUBD #2 QUIF NE CALL TSETAPL ; Display APL Character set ENDGUESS tsetcha1 LEAS 2,S RTS tab_baud FDB 0 FDB 50 FDB 75 FDB 110 FDB 135 FDB 150 FDB 300 FDB 600 FDB 1200 FDB 1800 FDB 2400 FDB 3600 FDB 4800 FDB 7200 FDB 9600 FDB 19200 sioinit PSHS D LEAS -1,S CLR ,S LOOP CLRA LDB ,S LSLB ROLA ADDD #tab_baud PSHS D PULS X LDD ,X SUBD 5,S QUIF EQ CLRA LDB ,S ADDD #1 STB ,S CMPB #$0f UNTIL EQ LDB #$ff LDX 1,S STB 1,X LDD #$000b ORB 8,S STB 2,X LDD #$0030 ORB ,S ORB 10,S STB 3,X BRA leas3ret sputchr PSHS D GUESS LDB [,S] QUIF NE LDD #$0010 PSHS D LDD 2,S CALLS srdport LEAS 2,S QUIF NE LDX ,S LDX 9,X PSHS X CLRA LDB 7,S PULS X STB ,X ENDGUESS LEAS 2,S RTS sgetchr PSHS D LEAS -1,S LDB [1,S] IF EQ CALLS srdport,(3,S),#8 IF EQ LDX 1,S CLRA LDB [9,X] STB ,S ENDIF ENDIF CLRA LDB ,S leas3ret LEAS 3,S RTS srdport PSHS D LEAS -3,S LDX 3,S LDD 9,X STD 1,S CLR ,S LDD 7,X STD $06 IF EQ LOOP CLRA LDX 1,S LDB 1,X ANDB 8,S UNTIL NE ELSE LOOP LDD #$0a60 STD $04 LOOP CLRA LDX 1,S LDB 1,X ANDB 8,S BNE srdport1 LDD $04 ADDD #-1 STD $04 UNTIL EQ LDD $06 ADDD #-1 STD $06 UNTIL EQ CALL addrb650 LDB #$03 STB [3,S] LDB #$ff STB ,S ENDIF srdport1 CLRA LDB ,S LEAS 5,S RTS sbreak PSHS D CLRA LDX ,S LDB 1,X ANDB #$02 LEAS 2,S RTS crtinit LEAS -5,S LDB addrdf3f IF NE LDB #$11 STB ,S LOOP CLRA STB CRTC_R0 ADDD #CRTREGS PSHS D CLRA PULS X LDB ,X STB CRTC_R1 LDB ,S ADDD #-1 STB ,S UNTIL LT ENDIF CLRA CLRB STD 1,S STD 3,S LOOP LDD 3,S LSLB ROLA ADDD #$010e PSHS D LDD 3,S PULS X STD ,X LDD 1,S ADDD #$0008 STD 1,S LDD 3,S ADDD #1 STD 3,S SUBD #$000a UNTIL EQ CALLS TSETASCI CLR $0127 CLR $0126 CALL TRMDOCLR LEAS 5,S RTS TSETASCI CLR APLCHSET LDB #$0c BRA TSETVIA TSETAPL LDB #$ff STB APLCHSET LDB #$0e TSETVIA STB VIA_CSET ; Select the character set by setting the VIA register RTS ; Terminal Line input TRMGETCH LEAS -1,S CALL usrhook_,#4 LDB $0126 IF EQ LOOP CALL kbdread STB ,S CMPB #$0d QUIF EQ CMPB #$03 QUIF EQ CMPB #$80 QUIF CC CLRA CALL TRMCHOUT ENDLOOP CMPB #$03 IF NE LDD CURSOR PSHS D CALL __div,#DISPCOLS PSHS D CALL __mul,#DISPCOLS STD $0124 LDB #$ff STB $0126 ENDIF LDB ,S CMPB #$0d BNE TRMGETC1 CALL TRMDOCR LDD $0124 SUBD CURSOR IF EQ LDD $0124 SUBD #DISPCOLS STD $0124 ENDIF ENDIF CALL addrdb98 STB ,S TRMGETC1 CMPB #$0d IF EQ CLR $0126 ENDIF CLRA JMP addrdc45 TERMPUTC PSHS D CALL usrhook_,#5 ; Check for user hook CLRA LDB 1,S BRA tputcdo TRMDORGT LDD CURSOR ADDD #1 BRA TMOVECSR TRMDOUP LDD CURSOR SUBD #DISPCOLS BRA TMOVECSR TRMDODEL LDD CURSOR ADDD #-1 ADDD #DISPMEM PSHS D LDD #BLANK PULS X STB ,X TRMDOLFT LDD CURSOR ADDD #-1 BRA TMOVECSR TRMDOHOM CLRA CLRB TMOVECSR JMP MOVECSR TRMNOP RTS TERMOUTC LDB APLCHSET IF NE CLRA LDB 3,S CALL DOAPLOVR STB 3,S ENDIF LDD CURSOR ADDD #1 CALL MOVECSR LDD CURSOR ADDD #-1 ADDD #DISPMEM PSHS D CLRA LDB 5,S PULS X STB ,X RTS ; This takes what is in D and indexes the table at TRMDSPTB to call the corresponding routine ;for outputting a terminal character tputcdo LDX #TERMOUTC ADDD #-1 TSTA IF EQ CMPB #$7e IF LS LDX #TRMDSPTB ABX ABX LDX ,X ENDIF ENDIF CALL ,X LEAS 2,S RTS tcalcurs LEAS -4,S LDD CURSOR PSHS D CALL __div,#DISPCOLS ADDD #1 STD ,S LDD CURSOR PSHS D CALL __mod,#DISPCOLS ADDD #1 STD 2,S LDD ,S TFR B,A CLRB ADDD 2,S BRA tabset1 tputcur1 PSHS D LEAS -4,S LDD 4,S TFR A,B CLRA ADDD #-1 STD ,S LDD 4,S CLRA ADDD #-1 STD 2,S LDD ,S PSHS D CALL __mul,#DISPCOLS ADDD 2,S JMP MOVCSR_1 ; Calls MoveCurs tabset PSHS D LEAS -2,S CLRA CLRB STD ,S LOOP LDD ,S LSLB ROLA ADDD #$010e PSHS D LDD 4,S PSHS D ADDD #$0002 STD 6,S PULS X LDD ,X ADDD #-1 PULS X STD ,X LDD ,S ADDD #1 STD ,S SUBD #$000a UNTIL EQ tabset1 LEAS 4,S RTS tabget LDD #$010e RTS TRMCHOUT PSHS D LDB 1,S IF NE CLRA CALL TERMPUTC ENDIF LEAS 2,S RTS ; Substitute an APL character if it would over strike what is on the screen DOAPLOVR PSHS D LEAS -3,S LDD #APLOVER STD ,S LDD CURSOR STD $0124 CALL addrdc30 STB 2,S DOAPLOV1 GUESS LDX ,S LDB ,X CMPB 4,S IF EQ LDB 1,X CMPB 2,S QUIF EQ ENDIF LDB ,X CMPB 2,S IF EQ LDB 1,X CMPB 4,S QUIF EQ ENDIF LDD ,S ADDD #3 STD ,S PSHS D PULS X LDD ,X BNE DOAPLOV1 ADMIT CLRA LDB 2,X STB 4,S ENDGUESS CLRA LDB 4,S LEAS 5,S RTS TRMDOCR LDD CURSOR PSHS D CALL __div,#DISPCOLS PSHS D CALL __mul,#DISPCOLS CALLS MOVECSR TRMDODWN LDD CURSOR ADDD #DISPCOLS ; Parameter D register ; Takes what is at DISPMEM+*CURSOR and flips the high bit MOVECSR PSHS D LDD CURSOR ADDD #DISPMEM PSHS D PULS X CLRA LDB ,X ANDB #$80 IF NE LDD CURSOR ADDD #DISPMEM PSHS D LDD CURSOR ADDD #DISPMEM PSHS D PULS X CLRA LDB ,X ANDB #$7f ELSE LDD CURSOR ADDD #DISPMEM PSHS D LDD CURSOR ADDD #DISPMEM PSHS D PULS X CLRA LDB ,X ORB #$80 ENDIF PULS X STB ,X GUESS LDD ,S ; Get our input parameter QUIF LT SUBD #DISPSIZE QUIF CC LDD ,S ADMIT LDD ,S BLE MOVECSR1 SUBD #DISPSIZE BCS MOVECSR1 CALL addrdecd LDD ,S SUBD #DISPSIZE BNE MOVECSR1 LDD #DISPSIZE SUBD #DISPCOLS ENDGUESS STD CURSOR MOVECSR1 LDD CURSOR ADDD #DISPMEM PSHS D PULS X CLRA LDB ,X ANDB #$80 IF NE LDD CURSOR ADDD #DISPMEM PSHS D LDD CURSOR ADDD #DISPMEM PSHS D PULS X CLRA LDB ,X ANDB #$7f ELSE LDD CURSOR ADDD #DISPMEM PSHS D LDD CURSOR ADDD #DISPMEM PSHS D PULS X CLRA LDB ,X ORB #$80 ENDIF PULS X STB ,X LEAS 2,S RTS TRMDOTAB LEAS -4,S LDD CURSOR PSHS D CALL __mod,#DISPCOLS STD ,S CLRA CLRB STD 2,S LOOP LDD 2,S LSLB ROLA ADDD #$010e PSHS D PULS X LDD ,X SUBD ,S QUIF GT LDD 2,S ADDD #1 STD 2,S SUBD #$000a UNTIL EQ LDD 2,S SUBD #$000a IF EQ CLRA CLRB STD 2,S ENDIF LDD 2,S LSLB ROLA ADDD #$010e PSHS D PULS X LDD ,X PSHS D LDD CURSOR PSHS D CALL __div,#DISPCOLS PSHS D CALL __mul,#DISPCOLS ADDD ,S PULS X JMP MOVCSR_2 ; Calls MOVECSR TRMDOCLR LEAS -2,S CLRA CLRB CALL MOVECSR LDD #DISPMEM ADDD #DISPSIZE ADDD #1 STD ,S LOOP LDD ,S ADDD #-1 STD ,S PSHS D LDD #$0020 PULS X STB ,X LDD ,S SUBD #DISPMEM UNTIL EQ CLRA LDB DISPMEM ORB #$80 STB DISPMEM LEAS 2,S RTS TRMDOINS LEAS -6,S LDD #DISPMEM PSHS D LDD CURSOR PSHS D CALL __div,#DISPCOLS ADDD #1 PSHS D CALL __mul,#DISPCOLS ADDD ,S PULS X STD 2,S ADDD #-1 STD ,S LDD CURSOR ADDD #DISPMEM STD 4,S LDD ,S SUBD 4,S IF EQ LDB #$a0 STB [,S] ELSE LOOP LDD ,S SUBD 4,S QUIF EQ LDD 2,S ADDD #-1 STD 2,S PSHS D LDD 2,S ADDD #-1 STD 2,S PSHS D PULS X CLRA LDB ,X PULS X STB ,X ENDLOOP LDB #BLANK STB [,S] LDD CURSOR ADDD #1 STD CURSOR ADDD #-1 MOVCSR_1 CALL MOVECSR ENDIF LEAS 6,S RTS TRMDODL LEAS -6,S LDD #DISPMEM PSHS D LDD CURSOR PSHS D CALL __div,#DISPCOLS ADDD #1 PSHS D CALL __mul,#DISPCOLS ADDD ,S PULS X STD ,S LDD #DISPMEM ADDD CURSOR STD 2,S LOOP LDD ,S ADDD #-1 STD ,S SUBD 2,S QUIF EQ LDB [,S] CMPB #BLANK UNTIL NE LDB [,S] CMPB #$a0 IF EQ LDD CURSOR PSHS D CALL __mod,#DISPCOLS IF NE LDD CURSOR ADDD #-1 ADDD #DISPMEM PSHS D LDD #$0020 PULS X STB ,X LDD CURSOR ADDD #-1 CALL MOVECSR ENDIF ELSE LDD #DISPCOLS ADDD #-1 PSHS D LDD CURSOR PSHS D CALL __mod,#DISPCOLS PSHS D LDD 2,S SUBD ,S PULS X PULS X STD 4,S IF EQ LDB #$a0 STB [$0002,S] ELSE LDD 2,S ADDD #1 STD ,S LDD CURSOR ADDD #1 CALL MOVECSR LOOP LDD 4,S QUIF EQ LDD 2,S PSHS D ADDD #1 STD 4,S LDD 2,S PSHS D ADDD #1 STD 4,S PULS X CLRA LDB ,X PULS X STB ,X LDD 4,S ADDD #-1 STD 4,S ENDLOOP LDB #BLANK STB [2,S] LDD CURSOR ADDD #-1 STD CURSOR ENDIF ENDIF addrdb2d LEAS 6,S RTS TRMDOEOL LEAS -4,S LDD #DISPCOLS ADDD #1 PSHS D LDD CURSOR PSHS D CALL __mod,#DISPCOLS PSHS D LDD 2,S SUBD ,S PULS X PULS X STD 2,S LDD CURSOR ADDD #DISPMEM STD ,S LOOP LDD 2,S ADDD #-1 STD 2,S QUIF EQ LDD ,S PSHS D ADDD #1 STD 2,S LDD #$0020 PULS X STB ,X ENDLOOP LDD CURSOR ADDD #DISPMEM PSHS D LDD CURSOR ADDD #DISPMEM PSHS D PULS X CLRA LDB ,X ORB #$80 PULS X STB ,X LDD CURSOR MOVCSR_2 CALL MOVECSR LEAS 4,S RTS addrdb98 LEAS -6,S LDB $0127 IF NE CLR $0127 BRA addrdc1f ENDIF GUESS CALL addrdc30 STB ,S LDD $0124 PSHS D CALL __mod,#DISPCOLS PSHS D LDD #DISPCOLS ADDD #-1 PSHS D LDD 2,S SUBD ,S PULS X PULS X QUIF EQ LDD $0124 ADDD #1 STD 2,S PSHS D CALL __div,#DISPCOLS ADDD #1 PSHS D CALL __mul,#DISPCOLS SUBD 2,S LOOP STD 4,S LDD 4,S QUIF EQ LDD 2,S PSHS D ADDD #1 STD 4,S PULS D ADDD #DISPMEM PSHS D PULS X LDB ,X CMPB #BLANK QUIF NE LDD 4,S ADDD #-1 ENDLOOP LDD 4,S QUIF EQ LDD $0124 ADDD #1 STD $0124 ADMIT LDB ,S CMPB #BLANK IF EQ addrdc1f LDB #$0d STB ,S ELSE LDB #$ff STB $0127 ENDIF ENDGUESS CLRA LDB ,S LEAS 6,S RTS addrdc30 LEAS -1,S LDD $0124 ADDD #DISPMEM PSHS D CLRA PULS X LDB ,X STB ,S ANDB #$7f STB ,S addrdc45 LDB ,S LEAS 1,S RTS TRMDSPTB FDB TRMDOHOM ; 1 ^A - HOME Key FDB TRMNOP ; 2 ^B - NOP FDB TRMNOP ; 3 ^C - NOP FDB TRMDODL ; 4 ^D FDB TRMDOINS ; 5 ^E FDB TRMDOEOL ; 6 ^F FDB TRMDORGT ; 7 ^G (Bell) FDB TRMDOLFT ; 8 ^H (Backspace) FDB TRMDOTAB ; 9 ^I (Tab) FDB TRMDODWN ; A ^J (New Line) FDB TRMDOUP ; B ^K (Vertical Tab) FDB TRMDOCLR ; C ^L (Form Feed) FDB TRMDOCR ; D ^M (Carriage Return) FDB TERMOUTC ; E ^N (Shift Out) FDB TERMOUTC ; F ^O (Shift In) FDB TERMOUTC ; 10 ^P FDB TERMOUTC ; 11 ^Q FDB TERMOUTC ; 12 ^R FDB TERMOUTC ; 13 ^S FDB TERMOUTC ; 14 ^T FDB TERMOUTC ; 15 ^U FDB TERMOUTC ; 16 ^V FDB TERMOUTC ; 17 ^W FDB TERMOUTC ; 18 ^X FDB TERMOUTC ; 19 ^Y FDB TERMOUTC ; 1A ^Z FDB TERMOUTC ; 1B Escape FDB TERMOUTC ; 1C FS FDB TERMOUTC ; 1D GS FDB TERMOUTC ; 1E RS FDB TERMOUTC ; 1F US FDB TERMOUTC ; 20 Space FDB TERMOUTC ; 21 ! FDB TERMOUTC ; 22 " FDB TERMOUTC ; 23 # FDB TERMOUTC ; 24 $ FDB TERMOUTC ; 25 % FDB TERMOUTC ; 26 & FDB TERMOUTC ; 27 ' FDB TERMOUTC ; 28 ( FDB TERMOUTC ; 29 ) FDB TERMOUTC ; 2A * FDB TERMOUTC ; 2B + FDB TERMOUTC ; 2C , FDB TERMOUTC ; 2D - FDB TERMOUTC ; 2E . FDB TERMOUTC ; 2F / FDB TERMOUTC ; 30 0 FDB TERMOUTC ; 31 1 FDB TERMOUTC ; 32 2 FDB TERMOUTC ; 33 3 FDB TERMOUTC ; 34 4 FDB TERMOUTC ; 35 5 FDB TERMOUTC ; 36 6 FDB TERMOUTC ; 37 7 FDB TERMOUTC ; 38 8 FDB TERMOUTC ; 39 9 FDB TERMOUTC ; 3A : FDB TERMOUTC ; 3B ; FDB TERMOUTC ; 3C < FDB TERMOUTC ; 3D = FDB TERMOUTC ; 3E > FDB TERMOUTC ; 3F ? FDB TERMOUTC ; 40 @ FDB TERMOUTC ; 41 A FDB TERMOUTC ; 42 B FDB TERMOUTC ; 43 C FDB TERMOUTC ; 44 D FDB TERMOUTC ; 45 E FDB TERMOUTC ; 46 F FDB TERMOUTC ; 47 G FDB TERMOUTC ; 48 H FDB TERMOUTC ; 49 I FDB TERMOUTC ; 4A J FDB TERMOUTC ; 4B K FDB TERMOUTC ; 4C L FDB TERMOUTC ; 4D M FDB TERMOUTC ; 4E N FDB TERMOUTC ; 4F O FDB TERMOUTC ; 50 P FDB TERMOUTC ; 51 Q FDB TERMOUTC ; 52 R FDB TERMOUTC ; 53 S FDB TERMOUTC ; 54 T FDB TERMOUTC ; 55 U FDB TERMOUTC ; 56 V FDB TERMOUTC ; 57 W FDB TERMOUTC ; 58 X FDB TERMOUTC ; 59 Y FDB TERMOUTC ; 5A Z FDB TERMOUTC ; 5B [ FDB TERMOUTC ; 5C \ FDB TERMOUTC ; 5D ] FDB TERMOUTC ; 5E ^ FDB TERMOUTC ; 5F _ FDB TERMOUTC ; 60 ` FDB TERMOUTC ; 61 a FDB TERMOUTC ; 62 b FDB TERMOUTC ; 63 c FDB TERMOUTC ; 64 d FDB TERMOUTC ; 65 e FDB TERMOUTC ; 66 f FDB TERMOUTC ; 67 g FDB TERMOUTC ; 68 h FDB TERMOUTC ; 69 i FDB TERMOUTC ; 6A j FDB TERMOUTC ; 6B k FDB TERMOUTC ; 6C l FDB TERMOUTC ; 6D m FDB TERMOUTC ; 6E n FDB TERMOUTC ; 6F o FDB TERMOUTC ; 70 p FDB TERMOUTC ; 71 q FDB TERMOUTC ; 72 r FDB TERMOUTC ; 73 s FDB TERMOUTC ; 74 t FDB TERMOUTC ; 75 u FDB TERMOUTC ; 76 v FDB TERMOUTC ; 77 w FDB TERMOUTC ; 78 x FDB TERMOUTC ; 79 y FDB TERMOUTC ; 7A z FDB TERMOUTC ; 7B { FDB TERMOUTC ; 7C | FDB TERMOUTC ; 7D | FDB TERMOUTC ; 7E ~ FDB TRMDODEL ; 7F DEL addrdd48 LDB #$1e STB $012a CLR $012b CALL CONBSET,#sysirq,#INT_IRQ CALL kbenable LDD #$010e ADDD #$0022 STD $012c LDD #$010e ADDD #$0022 STD $012e LDB #$0f STB PIA1_R0 LDB #$3c STB PIA1_R1 LDB #$3d STB PIA1_R3 RTS kbdread LEAS -1,S CLR ,S LOOP LOOP LDD $012c SUBD $012e BEQ addrdda7 LDX $012c CLRA LDB ,X STB ,S CALL addrdea7,$012c STD $012c LDB ,S UNTIL NE CMPB #$ff UNTIL NE addrdda7 CLRA LDB ,S LEAS 1,S RTS kbdwrite PSHS D LEAS -2,S CALL addre768 CALL addrdea7,$012e STD ,S SUBD $012c IF NE LDX $012e PSHS X CLRA LDB 5,S PULS X STB ,X LDD ,S STD $012e ENDIF CALL addre765 LEAS 4,S RTS dotbreak LEAS -3,S CLR 2,S LDD $012c LOOP STD ,S SUBD $012e QUIF EQ LDX ,S LDB ,X CMPB #$03 IF EQ LDB #$ff STB 2,S CLR ,X ENDIF CALL addrdea7,(,S) ENDLOOP CLRA LDB 2,S LEAS 3,S RTS kbenable LDB #$ff STB $0129 RTS kbdisabl CLR $0129 RTS sysirq LEAS -1,S CLRA LDB PIA1_R3 ANDB #$80 IF EQ LDB ACIA_R1 BRA addrde7b ENDIF CALL addre0cf LDB $0129 IF NE CALL SCANKEYB STB ,S BEQ addrde6d CMPB $012b IF EQ CLRA LDB $012a ADDD #-1 STB $012a BNE addrde7d CLRA LDB ,S CALLS MAPKEY CALL kbdwrite LDB #$04 ELSE CLRA LDB $012b ADDD #-81 PSHS D CLRA LDB 2,S SUBD ,S PULS X IF EQ CLRA LDB ,S STB $012b ELSE CLRA LDB ,S STB $012b CALLS MAPKEY CALL kbdwrite BRA addrde70 addrde6d CLR $012b ENDIF addrde70 LDB #$1e ENDIF addrde72 STB $012a ELSE addrde77 CLRA LDB PIA1_R2 addrde7b STB ,S ENDIF addrde7d LEAS 1,S RTS MAPKEY PSHS D LEAS -1,S LDB APLCHSET CMPB #$ff IF EQ CLRA LDB 2,S ADDD #MAPKYAPL ELSE CLRA LDB 2,S ADDD #MAPKYASC ENDIF PSHS D CLRA PULS X LDB ,X STB ,S LDB ,S LEAS 3,S RTS addrdea7 PSHS D LDD ,S ADDD #1 STD ,S LDD #$010e ADDD #$004a PSHS D LDD 2,S SUBD ,S PULS X IF EQ LDD #$010e ADDD #$0022 STD ,S ENDIF LDD ,S LEAS 2,S RTS ; This scrolls everything up a line and replaces the bottom line with spaces addrdecd LDD #DISPSIZE SUBD #DISPCOLS TFR D,Y LDX #DISPMEM LOOP ; LDB DISPCOLS,X FCB $E6,$89,$00,$50 ; KLUDGE TO GET THE LOCATIONS TO MATCH UP STB ,X+ LEAY -1,Y QUIF EQ ENDLOOP LDY #DISPCOLS LDB #$20 LOOP STB ,X+ LEAY -1,Y QUIF EQ ENDLOOP RTS SCANKEYB LDA #0 PSHS A STA PIA1_R0 LDY #0 LDX #80 LOOP LDA #8 LOOP LDB PIA1_R2 CMPB PIA1_R2 QUIF EQ ENDLOOP CMPB #$ff IF EQ LEAX -8,X ELSE LOOP LSRB IF CC TST $DF40,X ;;MAPKYASC,X KLUDGE - FIX ASSEMBLER TO HANDLE THIS IF EQ INC ,S ELSE TFR X,Y ENDIF ENDIF LEAX -1,X DECA QUIF EQ ENDLOOP ENDIF LEAX ,X QUIF EQ INC PIA1_R0 ENDLOOP PULS A TSTA IF NE LEAY $0051,Y ENDIF TFR Y,D RTS addrdf3f FCB $FF ; ! " # $ % ' & \ ( ) <- ^s ^q ^] ^t ; q w e r t y u i o p ^ 7 8 9 / ; a s d f g h j k l : ^m 4 5 6 * ; z x c v b n m , ; ? ^m 1 2 3 + ; LS ^r @ [ ] SPACE < > ^c RS 0 . - = ; ;The keyboard is scanned by writing the row number into the row select port ;(PIA1_R0), then reading the column bits (PIA1_R2). Each bit that reads 0 ;represents a pressed key. ; ; 00 = Shift ; 10 = Repeat ; 80 flags unshiftable key ; FF = No key ; ; Business keyboard decoding table: ; ;----+------------------------ ;row | 7 6 5 4 3 2 1 0 ;----+------------------------ ; 9 | 16 04 3A 03 39 36 33 DF ; | ^V -- : ^C 9 6 3 <- ^V = TAB + <- + DEL, ^C = STOP, ; | <- = left arrow ; 8 | B1 2F 15 13 4D 20 58 12 ; | k1 / ^U ^S m sp x ^R k9 = keypad 9, ^U = RVS + A + L, ; | ^S = HOME, sp = space, ^R = RVS ; 7 | B2 10 0F B0 2C 4E 56 5A ^O = Z + A + L, rp = repeat ; | k2 rp ^O k0 , n v z ; | ; 6 | B3 00 19 AE 2E 42 43 00 ; | k3 rs ^Y k. . b c ls ^Y = left shift + TAB + I, k. = keypad . ; | ls = left shift, rs = right shift ; 5 | B4 DB 4F 11 55 54 45 51 ^Q = cursor down ; | k4 [ o ^Q u t e q ; | 5D] ; 4 | 14 50 49 DC 59 52 57 09 ; | ^T p i \ y r w ^I ^T = DEL, ^I = TAB ; | C0@ ; 3 | B6 C0 4C 0D 4A 47 44 41 ; | k6 @ l ^M j g d a ^M = return ; | 5B[ ; 2 | B5 3B 4B DD 48 46 53 9B ; | k5 ; k ] h f s ^[ ^[ = ESC ; | 5C\ 3B; ; 1 | B9 06 DE B7 B0 37 34 31 ; | k9 -- ^ k7 0 7 4 1 ; | ; 0 | 05 0E 1D B8 2D 38 35 32 ; | . ^N ^] k8 - 8 5 2 ^N = both shifts + 2, ^] = cursor right ;----+------------------------ MAPKYASC FCB $00 FCB $FF,$FF,$3A,$03,$39,$36,$33,$5F FCB $31,$2F,$FF,$01,$6D,$20,$78,$FF FCB $32,$7F,$FF,$30,$2C,$6E,$76,$7A FCB $33,$00,$FF,$2E,$2E,$62,$63,$00 FCB $34,$5B,$6F,$0A,$75,$74,$65,$71 FCB $04,$70,$69,$5C,$79,$72,$77,$09 FCB $36,$40,$6C,$0D,$6A,$67,$64,$61 FCB $35,$3B,$6B,$5D,$68,$66,$73,$06 FCB $39,$FF,$5E,$37,$30,$37,$34,$31 FCB $FF,$FF,$07,$38,$2D,$38,$35,$32 FCB $00 FCB $FF,$FF,$2A,$02,$29,$26,$23,$5F FCB $81,$3F,$FF,$0C,$4D,$20,$58,$FF FCB $82,$7F,$FF,$8A,$3C,$4E,$56,$5A FCB $83,$00,$FF,$8B,$3E,$42,$43,$00 FCB $84,$7B,$4F,$0B,$55,$54,$45,$51 FCB $05,$50,$49,$7C,$59,$52,$57,$09 FCB $86,$60,$4C,$0D,$4A,$47,$44,$41 FCB $85,$2B,$4B,$7D,$48,$46,$53,$06 FCB $89,$FF,$7E,$87,$30,$27,$24,$21 FCB $FF,$FF,$08,$88,$3D,$28,$25,$22 MAPKYAPL FCB $00 FCB $FF,$FF,$2D,$03,$39,$36,$33,$FF FCB $31,$2F,$FF,$01,$6D,$20,$78,$FF FCB $32,$7F,$FF,$30,$2C,$6E,$76,$7A FCB $33,$00,$FF,$2E,$2E,$62,$63,$00 FCB $34,$5B,$6F,$0A,$75,$74,$65,$71 FCB $04,$70,$69,$5C,$79,$72,$77,$09 FCB $36,$27,$6C,$0D,$6A,$67,$64,$61 FCB $35,$3B,$6B,$7B,$68,$66,$73,$06 FCB $39,$FF,$60,$37,$30,$37,$34,$31 FCB $FF,$FF,$07,$38,$3D,$38,$35,$32 FCB $00 FCB $FF,$FF,$5F,$02,$28,$5E,$23,$FF FCB $81,$3F,$FF,$0C,$4D,$20,$58,$FF FCB $82,$7F,$FF,$8A,$3C,$4E,$56,$5A FCB $83,$00,$FF,$8B,$3E,$42,$43,$00 FCB $84,$5D,$4F,$0B,$55,$54,$45,$51 FCB $05,$50,$49,$7C,$59,$52,$57,$09 FCB $86,$22,$4C,$0D,$4A,$47,$44,$41 FCB $85,$3A,$4B,$7D,$48,$46,$53,$06 FCB $89,$FF,$7E,$87,$29,$26,$24,$21 FCB $FF,$FF,$08,$88,$2B,$2A,$25,$40 ; APL Overstrike table. If the new character and the exiting character are there as the ; first two in the entry, it is replaced with the third entry. APLOVER FCB $28,$54,$0E ; V ~ FCB $29,$54,$0F ; ^ ~ FCB $47,$4D,$10 ; G | (Triangle pointing down) FCB $48,$4D,$11 ; H | (Triangle pointing up) FCB $4F,$4D,$12 ; O | FCB $4F,$3F,$13 ; O - FCB $4F,$5F,$14 ; O \ FCB $4F,$50,$15 ; O * FCB $47,$54,$16 ; G ~ (Triangle pointing down) FCB $42,$4A,$17 ; B O (Upside down T) FCB $4E,$4A,$18 ; T O FCB $3F,$5F,$19 ; \ - FCB $2F,$5F,$1A ; / - FCB $43,$4A,$1B ; C o Hump with curve up FCB $4C,$4B,$1C ; L ' Square FCB $4B,$2E,$1D ; ' . FCB $4C,$2B,$1E ; L _ Square Divided FCB $4E,$42,$1F ; T B (T and Upside down T) FCB $00,$00,$00 ; Register values to initialize CRTC_R0/CRTC_R1 CRTREGS FCB $31 ; $00 FCB $28 ; $01 FCB $29 ; $02 FCB $0F ; $03 FCB $20 ; $04 FCB $03 ; $05 FCB $19 ; $06 FCB $1D ; $07 FCB $00 ; $08 FCB $09 ; $09 FCB $00 ; $0a FCB $00 ; $0b FCB $30 ; $0c FCB $00 ; $0d FCB $00 ; $0e FCB $00 ; $0f FCB $00 ; $10 FCB $00 ; $11 addre0cf LDX $015e LEAX 1,X CMPX #$02ef IF GE LDX #$0000 ELSE LDY #$0163 LDA #$3c LOOP INC ,Y CMPA ,Y QUIF GT CLR ,Y LEAY -1,Y ENDLOOP ENDIF STX $015e RTS settime PSHS D CALL addre768 LDD #$0004 PSHS D LDD #$0160 PSHS D LDD 4,S BRA addre14d setdate PSHS D addre109 LEAS -2,S CALL length,(2,S) STD ,S SUBD #$000b IF GT LDD #$000b STD ,S ENDIF CALL copy,(6,S),#$0164,(,S) LDD ,S ADDD #$0164 PSHS D CLRA CLRB PULS X STB ,X LEAS 4,S RTS gettime PSHS D CALL addre768 LDD #4 PSHS D LDD 2,S PSHS D LDD #$0160 addre14d CALL copy LEAS 4,S CALL addre765 LEAS 2,S RTS getdate LDD #$015e ADDD #$0006 RTS passthru LEAS -9,S LDD #$0400 STD ,S STD 2,S LOOP LOOP LOOP LOOP CALL kbdread ; Get a character STB 6,S CMPB #$03 ; is it a break? ; QUIF EQ ; yes so abort BEQ EXIT23 LDB 6,S IF NE CMPB #$7f ; Delete character? IF NE CLRA CALL TERMPUTC ; Display it ENDIF CLRA LDB 6,S STB [2,S] CALLS sysnextp,(2,S) STD 4,S SUBD ,S IF NE LDD 4,S STD 2,S ENDIF ENDIF GUESS LDD ,S SUBD 2,S QUIF EQ CLRA LDB ACIA_R1 ANDB #$10 QUIF EQ LDB [,S] STB ACIA_R0 CALLS sysnextp,(,S) STD ,S ENDGUESS CLRA LDB ACIA_R1 ANDB #$08 UNTIL NE LDB ACIA_R0 ANDB #$7f STB 6,S UNTIL NE CMPB #$0a UNTIL NE CALL TERMPUTC ENDLOOP EXIT23 LEAS 9,S RTS sysnextp PSHS D LDD ,S ADDD #1 STD ,S PSHS D LDD #$0400 ADDD #80 PSHS D LDD 2,S SUBD ,S PULS X PULS X IF EQ LDD #$0400 STD ,S ENDIF LDD ,S LEAS 2,S RTS chkfname PSHS D ;save addres of FCB CALL usrhook_,#15 ;check for user hook LDD ,S ;get address of FCB STD $11 ;save as working FCB LDX $11 ;point to FCB LDD 4,X ;get address of parameter block STD $13 ;save it also CALL addre4df ;check the type prefix '(type:size)' LDB $6a ;error? LBNE addre2eb ;yes, quit CALL chkdevnm ;convert the device name to a device type GUESS ;now what type is it? CLRA LDX $13 ;point to parameter block LDB 2,X ;get device code ANDB #$80 ;IEEE device? QUIF EQ ;no, get out of here CALL chkieedv ;convert the device number CALL chkieesa ;convert the secondary address (if any) LDX $13 ;point to parameters LDB 2,X ;get device type CMPB #$81 ;disk? QUIF NE ;no, get out of here CALL chkdskdr ;convert the drive number ENDGUESS LDX $13 ;point to params LDB 2,X ;get the device type CMPB #$81 ;disk? IF EQ ;yes... CLR 12,X LDX $68 LDB ,X IF NE CALL ieedname ;form the disk file string BRA addre299 ENDIF LDB #$0f LDX $13 STB 10,X BRA addre299 ENDIF CMPB #$83 ;IEEE device? IF EQ ;yes... LDX $68 LDB ,X BEQ addre2b8 CALL chddevcd ;check the device code ELSE CMPB #$04 ;host device? IF EQ ;yes... CALL chddevcd ;check the device code LDD #ACIA_R0 ;set the port address LDX $13 STD 9,X GUESS ;find out the type of file LDX $11 LDB ,X CMPB #'t' ;text? QUIF NE ;no, quit CLRA LDX $13 ;set the access mode flags LDB 1,X ANDB #$c0 ;to QUIF NE CLR $0010,X BRA addre2b8 ENDGUESS LDB #$ff ;set the file to a load/store mode LDX $13 STB $0010,X ELSE CMPB #$06 ;is it the serial port? IF EQ ;yes... LDD #ACIA_R0 ;get the port address STD 9,X ;and save it BRA addre2a2 ENDIF LDB 2,X ;check the device code IF EQ ;zero? CLR 12,X CALL ieedname ;check the device name LDB #$81 ;set device code for disk LDX $13 STB 2,X addre299 LDD #254 ;set the record size to 254 BRA addre2b5 ENDIF CMPB #$82 ;printer? IF EQ ;no... addre2a2 CALL invfname ;tell them we don't recognize it. ELSE CMPB #$05 ;terminal? IF NE ;no... CMPB #$07 ;keyboard? BNE addre2b8 ;no, quit ENDIF CALL invfname ;we didn't recognize it, so say so. LDD #80 ;set the record size to 80 addre2b5 CALL chkrcdsz ENDIF ENDIF ENDIF addre2b8 GUESS ;find a disk file with variable length format LDX $13 ;get the device code LDB 2,X CMPB #$81 ;disk? QUIF NE ;no, fall through CLRA LDB 12,X ;set the appropriate disk flag bits in the fcb ORB #$06 STB 12,X LDX $11 LDB ,X ;get the record format CMPB #'v' ;varying? QUIF NE ;no, quit LDX ,S LDD 1,X QUIF EQ LDX $11 ;allow smoe extra bytes to account for the LDD 1,X ;variable record length ADDD #2 STD 1,X ENDGUESS LDX $11 ;copy the record length for the system LDD 1,X LDX $13 STD 5,X LDD #1 STD 3,X addre2eb LEAS 2,S ;release our storage RTS chkdirpm PSHS D CALL usrhook_,#16 ;check for user hook LDD ,S STD $11 LDX $11 LDD 4,X STD $13 CALLS chkdevnm ;scan the device name LDX $13 LDB 2,X ;get the device code CMPB #$81 ;disk? IF EQ ;yes... CALL chkieedv ;get the ieee device # CALL chkdskdr ;get the disk drive ELSE ;non disk from the name, so... LDB 2,X ;does it have a given device? IF EQ ;no, so... LDB #$81 ;set the default device to the disk. STB 2,X ENDIF ENDIF LDX $13 LDB 2,X ;get the device code CMPB #$04 ;is it a host device? IF EQ ;yes... LDD #ACIA_R0 ;get the serial port address STD 9,X ;and put into the fcb LDX $68 ;point to the rest of the directory string LDB ,X ;get the next character CMPB #'.' ;did they give a directory pattern? BNE addre364 ;no, quit CALL addre6f1,#1 ;yes, add to the directory search string. ELSE ;non host CMPB #$81 ;disk device? BNE addre367 ;no, we can't do a directory on it LDX $68 LDB ,X ;did they give any search string? BNE addre367 ;yes, we can't handle that either. LDX $13 CLR 10,X LDB 11,X ;get the drive number IF EQ ;which one? LDD $68 ;drive 0... PSHS D LDD #addre6ff ;directory command is '$0' ELSE LDD $68 ;drive 1... PSHS D LDD #addre702 ;directory command is '$1' ENDIF CALL copystr ;copy the string for the directory search LEAS 2,S LDB #$46 ;set the flag bits for the directory file LDX $13 STB 12,X ENDIF addre364 JMP addre56d addre367 LDB #$03 ;set the error flag for the fcb LDX $13 STB ,X LDD #addre705 ;and tell them we don't support it. JMP addre56a chkdevnm LEAS -2,S ;get us some space LDX $13 CLR 2,X GUESS CALL addre6c0 ;find the first non alphabetic character STD ,S ;save the offset to it QUIF EQ ;we don't like null length strings. SUBD #10 ;or those longer than 10 characters QUIF GT CALL tableloo,#devices_,($68),(,S) ;look it up in the table ADDD #devcode_ ;compute an index according to the look up PSHS D CLRA PULS X ;get a device code accoding to the index LDB ,X LDX $13 STB 2,X ;and save in the fcb QUIF EQ ;if not a valid device, quit CALL addre6f1,(,S) ;make a copy of the device name ADMIT ;bad device name, so it must be a file name LDB #$08 ;set the default unit to 8 LDX $13 STB 9,X CALL ieegetsa ;get them a secondary address LDX $13 ;and a drive numner CLR 11,X ENDGUESS CLRA ;all we do here is get the device code LDX $13 LDB 2,X ANDB #$7f ;strip off any ay ieee flag bits LSLB ;shift left to form an offset ROLA ADDD #$0368 ;and index into a table PSHS D PULS X LDD ,X ;get the lookup value LDX $13 STD 7,X ;and save in the device dependent parameter portion BRA addre442 chkieedv LEAS -2,S ;get some space CALL addre6d5 ;find the first digit STD ,S ;save the offset IF NE ;any found,?? PSHS D CALL decimal,$68 ;get the digit and convert it to decimal LEAS 2,S LDX $13 STB 9,X ;save as the unit number CALL addre6f1,(,S) ;copy past the number BRA addre46d ;and quit ENDIF LDX $13 ;we didn't find one, so let's make one up LDB 2,X CMPB #$81 ;disk device? IF EQ LDB #$08 ;yes, so give it unit #8 ELSE CMPB #$82 ;printer device? BNE addre404 ;no, quit LDB #$04 ;yes, give it unit #8 ENDIF STB 9,X ;save the unit number BRA addre473 addre404 CLR 9,X ;we don't know what they want, so give them unit 0 BRA addre473 chkieesa LEAS -2,S ;get us some space LDX $68 ;point to the next part of the string to parse LDB ,X ;get the next character CMPB #'-' ;did they specify a SA? IF EQ ;yes... CALL addre6f1,#1 ;copy the secondary address CALL addre6d5 ;find the first non digit STD ,S ;save the offset to it IF NE ;was there anything there? PSHS D LDD $68 ;get the pointer into the string CALL decimal ;convert the SA to decimal LEAS 2,S LDX $13 ;save the converted SA STB 10,X CALL addre6f1,(,S) ;copy out the SA BRA addre473 ;and quit ENDIF ENDIF ;they didn't specify a SA, so let's fake it. LDX $13 LDB 2,X ;get the device code CMPB #$81 ;disk? IF EQ ;yes CALL ieegetsa ;assign them a SA. BRA addre473 ;and quit ENDIF CLR 10,X ;we don't know what they wanted, so give them no S addre442 BRA addre473 chkdskdr LEAS -2,S ;get us some space GUESS LDX $68 ;get the next character in the filename string LDB ,X CMPB #'/' ;is it a slash to indicate a drive number specifie QUIF NE ;no, so quit CALL addre6f1,#1 ;skip over the slash CALL addre6d5 ;find the next non numeric character STD ,S ;save the length QUIF EQ ;null length implies they forget the disk drive so quit PSHS D CALL decimal,($68 ) ;convert the drive to decimal LEAS 2,S LDX $13 ;and save in the FCB STB 11,X CALL addre6f1,(,S) ;skip over the drive number in the string addre46d ADMIT LDX $13 ;no drive given, so assume drive 0 CLR 11,X ENDGUESS addre473 LEAS 2,S ;release our space RTS invfname LDX $68 ;they gave an invalid file name, LDB ,X ;so point to it BNE addre4b9 ;and tell them what we didn't like. RTS chddevcd LDX $13 LDB 2,X ;get the device code IF EQ ;none specified? LDX $68 ;yes, so check for a . in the file name LDB ,X CMPB #'.' BEQ addre4b9 ;there, so the file name is invalid ELSE LDX $68 ;they did specify a device code, so LDB ,X ;did they specify a file? CMPB #'.' BNE addre4b9 ;no, so it's also invalid CALL addre6f1,#1 ;otherwise we just skip the . ENDIF addre49b LDX $68 ;they specified a . so lets look at the rest LDB ,X ;have we hit the end of the string? BEQ addre4b9 ;yes, it's invalid CMPB #', ;is there a comma after the dot? BEQ addre4b9 ;yes, it's also invlaid LDX $13 LDB 2,X ;check the device code CMPB #$81 ;disk device? BEQ addre4b1 ;yes, LDB 2,X ;how about just plain no device IF EQ ;yes, it's the same as a disk addre4b1 CLRA LDB 12,X ;set a flag to indicate a disk device of null devi ORB #$40 STB 12,X ENDIF RTS addre4b9 LDB #$03 ;set the error flag LDX $13 STB ,X LDD #addre713 ;point to the appropriate error message JMP addrb653 ;and print it out. RTS chkrcdsz PSHS D ;save the record size LDX $11 LDD 1,X ;get the record size specified in the open. SUBD ,S ;too big? IF GT ;yes... CALL addrb653,#addre724 ;so tell them so LDB #$03 ;and set the error flag LDX $13 STB ,X ENDIF LEAS 2,S ;release our space RTS addre4df LEAS -2,S ;get us some space CLRA CLRB LDX $11 STD 1,X LDB #'t' STB ,X LDX $68 ;point to the next part of the filename string LDB ,X ;get the next character CMPB #'(' ;did the specify a type modifier? IF EQ ;yes... GUESS CALL addre6f1,#1 ;skip over the left paren CALL addre6c0 ;find the next delimiter STD ,S ;save the length QUIF EQ ;it cannot be null. SUBD #10 QUIF GT ;nor greater than 10 CALL tableloo,#ioformat,$68,(,S) ;look up the format ADDD #ioformc ;and convert type into a table index PSHS D CLRA PULS X LDB ,X ;look up the type code in a table LDX $11 STB ,X ;and save the type code in the FCB QUIF EQ ;make sure it was a good type before we continue CALL addre6f1,(,S) ;skip the type specifier LDX $68 ;get the next character in the string LDB ,X CMPB #':' ;did they specify a length modifier? IF EQ ;yes... CALL addre6f1,#1 ;skip the separator CALL addre6d5 ;find the next non numeric STD ,S ;save the length PSHS D CALL decimal,($68 ) ;and convert the modifier LEAS 2,S LDX $11 ;saving the length in the FCB STD 1,X QUIF EQ ;was there anything to skip CALL addre6f1,(,S) ;yes, so skip the length text ENDIF LDX $68 LDB ,X CMPB #')' ;did they remember the closing paren? QUIF NE ;yes... CALL addre6f1,#1 ;so skip past it ADMIT addre561 LDB #$03 ;set the error flag LDX $13 STB ,X LDD #addre713 ;point to the appropriate error message addre56a CALL addrb653 ;and print it out ENDGUESS ENDIF addre56d LEAS 2,S RTS ieegetsa LEAS -4,S ;get us some working space LDB #$02 ;try for SA = 2 first. LDX $13 LOOP ;traverse the fcb list STB 10,X LDX $6b ;point to start of fcb list addre57a LDD 6,X STD ,S SUBD $6b ;check to see if we reached the end yet BEQ addre5b6 ;and quit when we do LDX ,S LDD 4,X ;point to the file data block STD 2,S SUBD $13 ;ignore it if it is the block of the current file QUIF EQ LDX 2,S LDB 2,X CMPB #$81 ;ignore it if it is not a disk file QUIF NE LDX $13 ;,DP LDB 9,X ;compare the ieee unit # LDX 2,S CMPB 9,X ;and ignore if not the same QUIF NE LDX $13 ;,DP ;compare the SA LDB 10,X LDX 2,S CMPB 10,X ;and ignore if not the same as the trial one QUIF NE CLRA ;it is the same SA, so try the next higher SA LDX $13 ;,DP LDB 10,X ADDD #1 ENDLOOP LDX ,S BRA addre57a addre5b6 LEAS 4,S ;release our space. RTS ieedname CALL chddevcd ;check the device code first LDX $11 ;,DP LDX 4,X LDB 11,X ;get the drive number IF EQ ;which drive is is? LDD $68 ;,DP ;drive 0 - the default PSHS D LDD #addre738 ;string will start with '0:' ELSE LDD $68 ;,DP ;drive 1 PSHS D LDD #addre73b ;string will start with '1:' ENDIF CALL prefixst ;prefix the file name string with the drive text LEAS 2,S LEAS -5,S ;get us some more working space LDD $68 ;,DP ;and copy the rest of the filename over LOOP STD ,S LDX ,S LDB ,X QUIF EQ CMPB #', ;remember to stop at any commas BEQ addre623 LDD ,S ADDD #1 ENDLOOP CLRA LDX $13 ;,DP LDB 1,X ;get the open mode ANDB #$c0 ;is it a store or load? IF EQ ;no... CALL suffixst,#addre73e,($68 ;,DP) ;add a ',SEQ' to the file name CLRA LDX $13 ;,DP LDB 12,X ORB #$10 ;set the status flag to indicate a seq file BRA addre675 ;and quit ENDIF ;it's a STORE/LOAD file CALL suffixst,#addre743,($68 ;,DP) ;so add a ',PRG' to the file name CLRA LDX $13 ;,DP LDB 12,X ORB #$20 ;set the status flag to indicate a prg file. BRA addre675 addre623 LDD ,S ;they specified some file specs, so parse them ADDD #1 ;point to the next character in the string STD ,S STD 2,S ;save the current position LOOP CLRA ;get the next character LDB [,S] CALL isalpha ;and it better be a alphabetic character QUIF EQ ;otherwise we get out of here LDD ,S ;keep going until we run out of alphabetic charact ADDD #1 STD ,S ENDLOOP GUESS ;now look at the first character LDB [,S] ;end of the string there? QUIF NE ;yes, so quit LDD ,S SUBD 2,S SUBD #3 ;make sure it is exactly 3 characters long QUIF NE ;otherwise it is invalid CALL tableloo,#filespec,(4,S),#3 ;look up the spec in a table ADDD #filespcc ;convert the type to an index PSHS D CLRA PULS X LDB ,X ;look up the type STB 4,S QUIF EQ ;make sure it is valid before going on. CALL zupstr,(2,S) ;convert the type to upper case CLRA LDX $13 ;,DP ;and save the type in the FCB LDB 12,X ORB 4,S addre675 STB 12,X ADMIT LDB #$03 ;set the error flag LDX $13 ;,DP STB ,X CALL addrb653,#addre748 ;and tell them it's a bad filetype ENDGUESS addre685 CLRA LDX $13 ;,DP ;get the file type LDB 12,X ANDB #$08 ;is it a relative file IF EQ ;no... LDB 1,X ;set the open mode ANDB #$03 SUBD #3 ;check the not update flag IF EQ ;not set? LDB #$03 ;set the error message STB ,X CALL addrb653,#addre756 ;and issue the invalid access message ENDIF ENDIF CLRA LDX $13 ;,DP LDB 12,X ;get the mode ANDB #$08 ;relative access ? IF EQ ;no... LDX $11 ;,DP LDB ,X CMPB #'f' ;fixed format file? BNE addre6bd ;no, quit ENDIF addre6b2 LDX $11 ;,DP ;get the record size LDD 1,X ;was one specified? IF EQ ;no LDD #80 ;set the default to 80 STD 1,X ENDIF addre6bd LEAS 5,S RTS addre6c0 LEAS -2,S ;get some working space LDD $68 ;,DP ;point to the nesx position in the file string LOOP STD ,S ;save our index CLRA LDB [,S] CALL isalpha ;is the present character alphabetic? BEQ addre6ea ;no, we found the end so quit. LDD ,S ADDD #1 ;try the next character ENDLOOP addre6d5 LEAS -2,S ;get us some space LDD $68 ;,DP ;point to the next place in the filename string LOOP STD ,S ;save our position CLRA LDB [,S] ;get the next character CALL isdigit ;is it a numeric? QUIF EQ ;no, we've found the end so quit LDD ,S ADDD #1 ;point to the next character an try again ENDLOOP addre6ea LDD ,S ;get our present pointer SUBD $68 ;,DP ;subtract the start of the string to compute an offset LEAS 2,S ;remove our workspace RTS ;and return the index. addre6f1 PSHS D ;save the skip value LDD $68 ;,DP ;get the present file name string pointer PSHS D ADDD 2,S ;add the skip value CALL copystr ;and skip over the text LEAS 4,S RTS addre6ff FCS "$0" addre702 FCS "$1" addre705 FCS "not supported" addre713 FCS "invalid filename" addre724 FCS "invalid record size" addre738 FCS "0:" addre73b FCS "1:" addre73e FCS ",SEQ" addre743 FCS ",PRG" addre748 FCS "bad file type" addre756 FCS "invalid access" addre765 ANDCC #$ef ;SEI equivalent RTS addre768 ORCC #$10 ;CLI equivalent RTS usrhook_ TFR D,X ;use the hook value as an index LDB $0580,X ;load the hook flag IF NE ;is it set? TFR D,X ;yes, so let's see where to jump JMP [$05c0,X] ;call the user routine instead of the given one. ENDIF RTS addre77a LEAS -2,S ;get some temporary storage LDD #$0580 ;get start of hook flag table LOOP STD ,S ;save present index SUBD #$0600 ;reached end of the table? QUIF CC ;yes, quit CLR [,S] ;clear out this hook flag LDD ,S ADDD #1 ;point to the next entry ENDLOOP LEAS 2,S ;release our storage RTS addre792 CMPD #$9000 ;make sure the string is in a bank. IF CC CMPD #$9fff IF LS TFR D,X ;it is so first get the bank number LDB ,U PSHS B STB BANKSEL LDB 4,S IF EQ LOOP ;search for the first zero byte TST B,X QUIF EQ INCB ENDLOOP INCB STB 4,S ENDIF ABX LOOP ;move from the bank to the user stack LDA ,-X STA ,-U DECB QUIF EQ ENDLOOP TFR U,X LDB 4,S STB ,-U LDD #addre7d7 ;restore the location STD ,--U PULS B STB ,-U LDB $0220 STB BANKSEL TFR X,D ENDIF ENDIF RTS addre7d7 PSHS D LDB ,U+ ;pop the user stack LEAU B,U PULU Y,B STB $0220 ;restore the bank STB BANKSEL LDD ,S++ ;restore D, pop the stack JMP ,Y STD ,S LDD ,S LSLB ROLA ADDD #$010e PSHS D LDD 4,S PSHS D ADDD #$0002 STD 6,S PULS X FCB $EC ;*********F000 ROM************ ORG $F000 restart1 LDS #$0220 CALL moniniti CALL bankinit_ CALL sysioini_ JMP startup addrf010 FCB $AA,$AA,$AA,$AA,$AA,$AA,$AA,$AA,$AA,$AA,$AA,$AA,$AA,$AA,$AA,$AA ; Parameters: B - Better be a 1 ; A - ???? monitor_ PSHS B,A ; Save our locals LDB 1,S CMPB #$01 IF EQ CALL addrf05c ELSE CLRA PSHS D CALL printf_,#msgbadrq LEAS 2,S ; Pop both parameters from the stack ENDIF CLR $32 ;,DP LEAS 2,S RTS msgbadrq FCS "Unable to perform request %d%n" addrf05c LEAS -2,S CALL initstd_ CALL cm_clea1 CLRA CLRB STD ,S LOOP LDD ,S LSLB ROLA ADDD #MON_SVPC PSHS D CLRA CLRB PULS X STD ,X LDD ,S ADDD #1 STD ,S SUBD #5 UNTIL EQ LDD #5 LSLB ROLA ADDD #MON_SVPC PSHS D LDD #$0220 PULS X STD ,X LDD #6 LSLB ROLA ADDD #MON_SVPC PSHS D LDD #addrc000 PULS X STD ,X CALL CONBSET,#INT_BRKP,#INT_SWI CALLN CONBSET,#INT_BRKP,#INT_NMI addrf0bd LEAS 2,S CALL printf_,#STR_WATL CALL spawn_,#addrf0cd BRA addrf120 addrf0cd LEAS -2,S LOOP LOOP LOOP CALL printf_,#addrf13d CALL getchar_ STB $0175 CMPB #$3e IF EQ CALL getchar_ STB $0175 ENDIF CMPB #$0d UNTIL NE CLRA ORB #$20 STB $0175 CMPB #$71 IF EQ CALL mondrain CALL suicide_ ENDIF LDD #TBMONCMD LOOP STD ,S LDX ,S LDD ,X QUIF EQ CLRA LDB $0175 SUBD ,X BEQ addrf11b LDD ,S ADDD #$0004 ENDLOOP CALL mondrain CALL bad_cmd ENDLOOP addrf11b CALL [2,X] ENDLOOP addrf120 LEAS 2,S RTS STR_WATL FCS "Waterloo microMonitor%n%n" addrf13d FCS ">" ; Bank command ; Syntax: ; b ; Should be a hexidecimal number between 0 and F cm_bank CALL mongethx LDB $0174 IF EQ LDD MON_ADDR ELSE CALL mondrain JMP bad_cmd RTS ENDIF addrf153 PSHS D LDD ,S STB BANKSEL LEAS 2,S RTS ; Clear Command ; Syntax ; c ; Clears all breakpoints (set by s ) cm_clear CALL mondrain cm_clea1 LEAS -2,S CLRA CLRB STD ,S LOOP LDD ,S LSLB ROLA ADDD #MONBRKA1 PSHS D CLRA CLRB PULS X STD ,X LDD ,S ADDD #1 STD ,S SUBD #NUMBREAK UNTIL EQ LEAS 2,S RTS ; 'd' command comes here ; Dump command ; Syntax ; d ; or ; d - ; or ; d . ; cm_dump LEAS -2,S CALL mongethx LDB $0174 IF EQ LDD $0172 SUBD MON_ADDR LSRA RORB LSRA RORB LSRA RORB STD ,S LOOP CALLS addrf1c0 CALL tbreak_ BNE addrf1bd LDD MON_ADDR ADDD #$0008 STD MON_ADDR LDD ,S ADDD #-1 STD ,S UNTIL LT ELSE CALL mondrain CALL bad_cmd ENDIF addrf1bd LEAS 2,S RTS addrf1c0 LEAS -4,S LDD MON_ADDR STD ,S CALL printf_,#addrf24e LDD ,S PSHS D LDD 2,S TFR A,B CLRA PSHS D CALL printf_,#addrf250 LEAS 4,S LDD #8 STD 2,S LOOP LDD ,S PSHS D ADDD #1 STD 2,S PULS X CLRA LDB ,X PSHS D CALL printf_,#addrf256 LEAS 2,S LDD 2,S ADDD #-1 STD 2,S UNTIL EQ CALL printf_,#addrf25a LDD MON_ADDR STD ,S LDD #8 STD 2,S LOOP LDX ,S GUESS LDB ,X CMPB #BLANK QUIF CS CMPB #$7e QUIF HI CLRA PSHS D CALL printf_,#addrf25c LEAS 2,S ADMIT CALL printf_,#addrf25f ENDGUESS LDD ,S ADDD #1 STD ,S LDD 2,S ADDD #-1 STD 2,S UNTIL EQ CALL printf_,#addrf261 LEAS 4,S RTS addrf24e FCS ";" addrf250 FCS "%h%h " addrf256 FCS "%h " addrf25a FCS "*" addrf25c FCS "%c" addrf25f FCS "." addrf261 FCS "%n" ; Fill command ; Syntax ; f - ; or ; f . cm_fill LEAS -4,S GUESS CALL mongethx LDB $0174 QUIF NE CALL mongthxd STD ,S SUBD #$00ff QUIF GT LDD $0172 SUBD MON_ADDR STD 2,S LOOP LDD MON_ADDR PSHS D ADDD #1 STD MON_ADDR LDD 2,S PULS X STB ,X LDD 2,S ADDD #-1 STD 2,S UNTIL LE ADMIT CALL bad_cmd ENDGUESS LEAS 4,S RTS ; Go Command ; Syntax ; g cm_go LEAS -4,S CALL mongethx LDB $0174 IF EQ LDD MON_ADDR IF NE CLRA CLRB LSLB ROLA ADDD #MON_SVPC PSHS D LDD MON_ADDR PULS X STD ,X ENDIF CLRA CLRB STD 2,S LOOP LDD 2,S LSLB ROLA ADDD #MONBRKA1 PSHS D PULS X LDD ,X STD ,S QUIF EQ LDD 2,S ADDD #MONBRKD1 PSHS D CLRA LDB [2,S] PULS X STB ,X LDB #$3f ; SWI STB [,S] LDD 2,S ADDD #1 STD 2,S SUBD #NUMBREAK UNTIL EQ CALL INT_RETB ELSE CALL mondrain CALL bad_cmd ENDIF LEAS 4,S RTS ; Load command ; l ; This will load the specified load module into memory at the address designated by ; the 'org' line in the '.cmd' file used by the linker in creating the load module. In order ; to run the program, the g command will then need to be entered. cm_load LEAS -26,S LOOP CALL getchar_ STB ,S CMPB #BLANK UNTIL NE CLRA CLRB STD 1,S LOOP LDB ,S CMPB #$0d QUIF EQ LDD 1,S PSHS D TFR S,X LDB #$07 ABX PSHS X PULS D ADDD ,S PULS X PSHS D CLRA LDB 2,S PULS X STB ,X CALL getchar_ STB ,S LDD 1,S ADDD #1 STD 1,S SUBD #$0014 UNTIL EQ LDB ,S CMPB #$0d BNE addrf394 LDD 1,S PSHS D TFR S,X LDB #$07 ABX PSHS X PULS D ADDD ,S PULS X PSHS D CLRA CLRB PULS X STB ,X LDD #addrf41b PSHS D TFR S,X LDB #$07 ABX PSHS X PULS D CALL openf_ LEAS 2,S STD 3,S IF EQ TFR S,X LDB #$05 ABX PSHS X CALL printf_,#addrf41d LEAS 2,S ELSE CALLS addrf39e CALL closef_,(3,S) BRA addrf39a addrf394 CALL printf_,#addrf431 ENDIF addrf39a LEAS $001a,S RTS addrf39e PSHS D LEAS -12,S TFR S,X LDB #$06 ABX PSHS X PULS D STD 4,S LOOP LDD #$0006 PSHS D LDD 6,S PSHS D CALLS addrf3fb,(16,S) LEAS 4,S CALL errorf_,(12,S) QUIF NE LDX 4,S LDB 4,X CMPB #$02 BEQ addrf3f2 CMPB #$01 IF EQ CLRA LDB 5,X STB BANKSEL ENDIF LDD 2,X PSHS D LDD ,X PSHS D CALLS addrf3fb,(16,S) LEAS 4,S CALL errorf_,(12,S) UNTIL NE CALL printf_,#addrf443 addrf3f2 CLR BANKSEL CLR $0220 LEAS 14,S RTS addrf3fb PSHS D LOOP LDD 4,S PSHS D ADDD #1 STD 6,S CALL fgetchar_,(2,S) PULS X STB ,X LDD 6,S ADDD #-1 STD 6,S UNTIL EQ LEAS 2,S RTS addrf41b FCS "L" addrf41d FCS "unable to open %s%n" addrf431 FCS "invalid command%n" addrf443 FCS "error loading file%n" ; Modify command ; Syntax ; m ,,,... ; cmd_mod LEAS -2,S JSR mongethx LDB $0174 BNE addrf499 addrf462 LOOP CALL mongthxd STD ,S LDB $0175 CMPB #BLANK QUIF NE LDD ,S SUBD #$00ff BGT addrf499 LDD MON_ADDR PSHS D ADDD #1 STD MON_ADDR LDD 2,S PULS X STB ,X ENDLOOP CMPB #$0d IF EQ LDX MON_ADDR PSHS X LDD 2,S PULS X STB ,X ELSE addrf499 LDB $0175 CMPB #$2a IF EQ CALL mondrain ELSE CALL mondrain CALL bad_cmd ENDIF ENDIF LEAS 2,S RTS addrf4ae LOOP CALL getchar_ SUBD #$000d UNTIL EQ addrf4b6 JMP passthru_ ; Registers command ; Syntax: ; r ; Displays the contents of the registers on the screen cmd_reg CALL mondrain addrf4bc CALLS prtrgttl CALLS prtregs LDD #str_5na BRA addrf4c8 prtrgttl LDD #str_regs addrf4c8 JMP printf_ ; Prints out the current registers prtregs LEAS -4,S CALL printf_,#str_cln LDD #$0006 STD 2,S LDD #MON_ADDR ADDD #MON_SVPC-MON_ADDR STD ,S LOOP LDD ,S PSHS D ADDD #1 STD 2,S PULS X CLRA LDB ,X PSHS D CALL printf_,#str_5h0 LEAS 2,S LDD ,S PSHS D ADDD #1 STD 2,S PULS X CLRA LDB ,X PSHS D CALL printf_,#str_5h_ LEAS 2,S LDD 2,S ADDD #-1 STD 2,S UNTIL EQ LDD ,S PSHS D ADDD #1 STD 2,S PULS X CLRA LDB ,X PSHS D CALL printf_,#str_5h_ LEAS 2,S CLRA LDB [,S] PSHS D CALL printf_,#str_5h0 BRA addrf5a4 ; Alias for assemble cmd_asmb LEAS -6,S LDD #$0006 STD 4,S LDD #MON_ADDR ADDD #MON_SVPC-MON_ADDR STD ,S LOOP LDD ,S PSHS D ADDD #2 STD 2,S CALL mongthxd PULS X STD ,X LDB $0175 CMPB #BLANK BNE addrf598 LDD 4,S ADDD #-1 STD 4,S UNTIL EQ LDD ,S STD 2,S LDD #$0002 STD 4,S LOOP addrf576 LDD 2,S PSHS D ADDD #1 STD 4,S CALL mongthxd PULS X STB ,X LDB $0175 CMPB #BLANK BNE addrf598 LDD 4,S ADDD #-1 STD 4,S UNTIL EQ BRA addrf5a4 addrf598 CMPB #$0d BNE addrf59e BRA addrf5a4 addrf59e CALL mondrain CALL bad_cmd addrf5a4 LEAS 6,S RTS str_5na FCS "%n" str_regs FCS " PC D X Y U S CC DP%n" str_cln FCS ":" str_5h0 FCS "%h" str_5h_ FCS "%h " ; Stop command ; Syntax ; s ; or ; s ; s by itself will display all breakpoints ; while the second form will set a breakpoint at ; cmd_stop LEAS -2,S CALL mongethx LDB $0174 LBNE addrf679 LDD MON_ADDR IF NE CLRA CLRB STD ,S LOOP LDD ,S LSLB ROLA ADDD #MONBRKA1 PSHS D PULS X LDD ,X QUIF EQ LDD ,S ADDD #1 STD ,S SUBD #NUMBREAK UNTIL EQ LDD ,S SUBD #4 IF LT LDD ,S LSLB ROLA ADDD #MONBRKA1 PSHS D LDD MON_ADDR PULS X STD ,X ELSE CALL printf_,#addrf6c2 ENDIF ENDIF CLRA CLRB STD ,S LOOP LDD ,S LSLB ROLA ADDD #MONBRKA1 PSHS D PULS X LDD ,X QUIF EQ LDD ,S LSLB ROLA ADDD #MONBRKA1 PSHS D PULS X LDD ,X PSHS D LDD 2,S LSLB ROLA ADDD #MONBRKA1 PSHS D PULS X LDD ,X TFR A,B CLRA PSHS D CALL printf_,#addrf6d7 LEAS 4,S LDD ,S ADDD #1 STD ,S SUBD #NUMBREAK UNTIL EQ addrf671 CALL printf_,#addrf6dd BRA addrf67f addrf679 CALL mondrain CALL bad_cmd addrf67f LEAS 2,S RTS ; Monitor break point has been hit, let the user know and process commands MONBREAK LEAS -4,S CALL printf_,#str_intn CALL addrf4bc CLRA CLRB STD 2,S LOOP LDD 2,S LSLB ROLA ADDD #MONBRKA1 PSHS D PULS X LDD ,X STD ,S IF NE LDD 2,S ADDD #MONBRKD1 PSHS D CLRA PULS X LDB ,X STB [,S] ENDIF LDD 2,S ADDD #1 STD 2,S SUBD #NUMBREAK UNTIL EQ CALL addrf0cd LEAS 4,S RTS addrf6c2 FCS "too many stops set%n" addrf6d7 FCS "%h%h " addrf6dd FCS "%n" str_intn FCS "interrupt%n" ; Disassembly lookup tables ; Each opcode has the high order bit set to indicate the end of the string. dcodtb1 FCB '?|$80 ; 10 FCB '?|$80 ; 11 FCB 'N,'O,'P|$80 ; 12 FCB 'S,'Y,'N,'C|$80 ; 13 FCB '?|$80 ; 14 FCB '?|$80 ; 15 FCB 'L,'B,'R,'A|$80 ; 16 FCB 'L,'B,'S,'R|$80 ; 17 FCB '?|$80 ; 18 FCB 'D,'A,'A|$80 ; 19 FCB 'O,'R,'C,'C|$80 ; 1A FCB '?|$80 ; 1B FCB 'A,'N,'D,'C,'C|$80 ; 1C FCB 'S,'E,'X|$80 ; 1D FCB 'E,'X,'G,BLANK|$80 ; 1E FCB 'T,'F,'R,BLANK|$80 ; 1F dcodtb2 FCB 'B,'R,'A|$80 ; 20 FCB 'B,'R,'N|$80 ; 21 FCB 'B,'H,'I|$80 ; 22 FCB 'B,'L,'S|$80 ; 23 FCB 'B,'H,'S|$80 ; 24 FCB 'B,'L,'O|$80 ; 25 FCB 'B,'N,'E|$80 ; 26 FCB 'B,'E,'Q|$80 ; 27 FCB 'B,'V,'C|$80 ; 28 FCB 'B,'V,'S|$80 ; 29 FCB 'B,'P,'L|$80 ; 2A FCB 'B,'M,'I|$80 ; 2B FCB 'B,'G,'E|$80 ; 2C FCB 'B,'L,'T|$80 ; 2D FCB 'B,'G,'T|$80 ; 2E FCB 'B,'L,'E|$80 ; 2F dcodtb3 FCB 'L,'E,'A,'X|$80 ; 30 FCB 'L,'E,'A,'Y|$80 ; 31 FCB 'L,'E,'A,'S|$80 ; 32 FCB 'L,'E,'A,'U|$80 ; 33 FCB 'P,'S,'H,'S|$80 ; 34 FCB 'P,'U,'L,'S|$80 ; 35 FCB 'P,'S,'H,'U|$80 ; 36 FCB 'P,'U,'L,'U|$80 ; 37 FCB '?|$80 ; 38 FCB 'R,'T,'S|$80 ; 39 FCB 'A,'B,'X|$80 ; 3A FCB 'R,'T,'I|$80 ; 3B FCB 'C,'W,'A,'I|$80 ; 3C FCB 'M,'U,'L|$80 ; 3D FCB '?|$80 ; 3E FCB 'S,'W,'I|$80 ; 3F dcodtb04 FCB 'N,'E,'G|$80 ; 00 40 50 60 70 FCB '?|$80 ; 01 41 51 61 71 FCB '?|$80 ; 02 42 52 62 72 FCB 'C,'O,'M|$80 ; 03 43 53 63 73 FCB 'L,'S,'R|$80 ; 04 44 54 64 74 FCB '?|$80 ; 05 45 55 65 75 FCB 'R,'O,'R|$80 ; 06 46 56 66 76 FCB 'A,'S,'R|$80 ; 07 47 57 67 77 FCB 'A,'S,'L|$80 ; 08 48 58 68 78 FCB 'R,'O,'L|$80 ; 09 49 59 69 79 FCB 'D,'E,'C|$80 ; 0A 4A 5A 6A 7A FCB '?|$80 ; 0B 4B 5B 6B 7B FCB 'I,'N,'C|$80 ; 0C 4C 5C 6C 7C FCB 'T,'S,'T|$80 ; 0D 4D 5D 6D 7D FCB 'J,'M,'P|$80 ; 0E 4E 5E 6E 7E FCB 'C,'L,'R|$80 ; 0F 4F 5F 6F 7F dcodtb8b FCB 'S,'U,'B,'A|$80 ; 80 90 A0 B0 FCB 'C,'M,'P,'A|$80 ; 81 91 A1 B1 FCB 'S,'B,'C,'A|$80 ; 82 92 A2 B2 FCB 'S,'U,'B,'D|$80 ; 83 93 A3 B3 FCB 'A,'N,'D,'A|$80 ; 84 94 A4 B4 FCB 'B,'I,'T,'A|$80 ; 85 95 A5 B5 FCB 'L,'D,'A,BLANK|$80 ; 86 96 A6 B6 FCB 'S,'T,'A,BLANK|$80 ; 87 97 A7 B7 FCB 'E,'O,'R,'A|$80 ; 88 98 A8 B8 FCB 'A,'D,'C,'A|$80 ; 89 99 A9 B9 FCB 'O,'R,'A,BLANK|$80 ; 8A 9A AA BA FCB 'A,'D,'D,'A|$80 ; 8B 9B AB BB FCB 'C,'M,'P,'X|$80 ; 8C 9C AC BC FCB 'J,'S,'R,BLANK|$80 ; 8D 9D AD BD FCB 'L,'D,'X,BLANK|$80 ; 8E 9E AE BE FCB 'S,'T,'X,BLANK|$80 ; 8F 9F AF BF dcodtbcf FCB 'S,'U,'B,'B|$80 ; C0 D0 E0 F0 FCB 'C,'M,'P,'B|$80 ; C1 D1 E1 F1 FCB 'S,'B,'C,'B|$80 ; C2 D2 E2 F2 FCB 'A,'D,'D,'D|$80 ; C3 D3 E3 F3 FCB 'A,'N,'D,'B|$80 ; C4 D4 E4 F4 FCB 'B,'I,'T,'B|$80 ; C5 D5 E5 F5 FCB 'L,'D,'B,BLANK|$80 ; C6 D6 E6 F6 FCB 'S,'T,'B,BLANK|$80 ; C7 D7 E7 F7 FCB 'E,'O,'R,'B|$80 ; C8 D8 E8 F8 FCB 'A,'D,'C,'B|$80 ; C9 D9 E9 F9 FCB 'O,'R,'B,BLANK|$80 ; CA DA EA FA FCB 'A,'D,'D,'B|$80 ; CB DB EB FB FCB 'L,'D,'D,BLANK|$80 ; CC DC EC FC FCB 'S,'T,'D,BLANK|$80 ; CD DD ED FD FCB 'L,'D,'U,BLANK|$80 ; CE DE EE FE FCB 'S,'T,'U,BLANK|$80 ; CF DF EF FF ; This table tells us how to decode an instuction and the parameters ; The first address is the decode table for the instruction itself. The table ; has a series of strings where the last character in the string has the hig ; bit set. ; The second address is the routine to call to decode the parameters to thi ; instruction TABINST FDB dcodtb04,DISDIR0C ; 0X - 00 FDB dcodtb1,DISDIR1 ; 1X - 04 FDB dcodtb2,addrFA9E ; 2X - 08 FDB dcodtb3,addrFB25 ; 3X - 0C FDB dcodtb04,addrFAED ; 4X - 10 FDB dcodtb04,addrFAF2 ; 5X - 14 FDB dcodtb04,addrF98B ; 6X - 18 FDB dcodtb04,DISEXT7 ; 7X - 1C - Extended FDB dcodtb8b,DISIMM8C ; 8X - 20 - Immediate FDB dcodtb8b,DISDIR8C ; 9X - 24 - DIRECT FDB dcodtb8b,DISIDX8C ; AX - 28 - INDEXED FDB dcodtb8b,DISEXT8C ; BX - 2C - EXTENDED FDB dcodtbcf,DISIMM8C ; CX - 30 FDB dcodtbcf,DISDIR8C ; DX - 34 FDB dcodtbcf,DISIDX8C ; EX - 38 FDB dcodtbcf,DISEXT8C ; FX - 3C ; These are the illegal instructions INST_ILL FCB $4E,$5E,$87,$8F,$C7,$CD,$CF,0 addrf86d FCC "XYUS" ; Translate command ; Syntax ; t ; or ; t - ; or ; t . ; cmd_tran CALL mongethx LDB $0174 BNE addrf8a1 LDD $0172 SUBD MON_ADDR STD MON_CNT LOOP LDD MON_ADDR PSHS D TFR A,B CLRA PSHS D CALL printf_,#str_5h5h LEAS 4,S CALLS addrf8a8 CALL tbreak_ QUIF NE LDD MON_CNT UNTIL LE RTS addrf8a1 CALL mondrain JMP bad_cmd RTS addrf8a8 LEAS -5,S CALL GETMONBY STB ,S LDD #INST_ILL STD 1,S LOOP LDB [1,S] QUIF EQ LDD 1,S PSHS D ADDD #1 STD 3,S PULS X LDB ,S CMPB ,X BEQ PRTILLIN ENDLOOP LDB ,S CMPB #$8d IF EQ CALL printf_,#str_bsr CALL addrfa9e ELSE CMPB #$10 IF EQ CALL addrfb73 ELSE CMPB #$11 IF EQ CALL DISEXT11 ELSE CLRA ANDB #$f0 LSRA RORB LSRA RORB LSRA RORB STD 3,S LSLB ROLA ADDD #TABINST PSHS D PULS X LDD ,X PSHS D CLRA LDB 2,S CALL addrfc5a LEAS 2,S STD 1,S LDB [1,S] CMPB #$bf IF NE CALL PRTDISOP,(1,S) CLRA LDB ,S PSHS D LDD 5,S ADDD #1 LSLB ROLA ADDD #TABINST PSHS D PULS X PULS D CALL [,X] ELSE PRTILLIN CALL printf_,#str_qqqq ENDIF ENDIF ENDIF ENDIF CALL printf_,#str_5n LEAS 5,S RTS ; Dissassembles the immediate portion of an instruction. ; Parameters: D holds the instruction byte to decode ; Depending on the instruction it will either print 1 or two hex bytes after a #$ DISIMM8C PSHS D CALL printf_,#str_34 CALL PRMONBHX ; See if we need to print out a second byte CLRA LDB 1,S ANDB #$0f STB 1,S CMPB #$03 IF NE CMPB #$0c IF NE CMPB #$0d IF NE CMPB #$0e BNE DISIMM_1 ENDIF ENDIF ENDIF CALL PRMONBHX DISIMM_1 LEAS 2,S RTS ; Print out a direct which is a $ followed by 2 Hex Digits DISDIR0C CALLS DISPRSPC ; We need an extra space because opcodes are 3 characters DISDIR8C CALL printf_,#str__4 ; Print a dollar sign BRA PRMONBH1 ; Followed by the 2 hex digits ; Prints out an extended address of a # followed by 4 HEX digits DISEXT7 CALLS DISPRSPC DISEXT8C CALL printf_,#str__4 CALL PRMONBHX PRMONBH1 JMP PRMONBHX ; Print out a single space DISPRSPC LDD #BLANK JMP putchar_ addrf98b CALLS DISPRSPC ; This disassembles an indexed instruction byte DISIDX8C LEAS -4,S CALL GETMONBY STB ,S CALL printf_,#str_spc CLRA LDB ,S ANDB #$60 LSRA RORB LSRA RORB LSRA RORB LSRA RORB LSRA RORB STB 3,S CLRA LDB ,S ANDB #$0f STB 1,S LDB ,S ANDB #$80 IF EQ LDB ,S ANDB #$1f STB 2,S CMPB #$0f IF HI ORB #$e0 STB 2,S ENDIF PSHS D CALL printf_,#str_45h LEAS 2,S LDB #$04 STB 1,S ELSE LDB ,S ANDB #$10 IF NE CALL printf_,#str_lbrk ENDIF ENDIF LDB 1,S CMPB #$08 BEQ addrf9ec CMPB #$0c BNE addrf9f4 addrf9ec CALL printf_,#str_dol BRA addrfa09 addrf9f4 CMPB #$09 BEQ addrfa00 CMPB #$0d BEQ addrfa00 CMPB #$0f BNE addrfa0e addrfa00 CALL printf_,#str_dol CALL PRMONBHX addrfa09 CALL PRMONBHX BRA addrfa2a addrfa0e CMPB #$05 BNE addrfa17 LDD #str_B BRA addrfa27 addrfa17 CMPB #$06 BNE addrfa20 LDD #str_A BRA addrfa27 addrfa20 CMPB #$0b BNE addrfa2a LDD #str_D addrfa27 CALL printf_ addrfa2a LDB 1,S CMPB #$0f BEQ addrfa74 CALL printf_,#str_coma LDB 1,S CMPB #$02 BNE addrfa41 LDD #str_dash BRA addrfa48 addrfa41 CMPB #$03 BNE addrfa4b LDD #str_2dsh addrfa48 CALL printf_ addrfa4b LDB 1,S CMPB #$0c BEQ addrfa55 CMPB #$0d BNE addrfa5d addrfa55 CALL printf_,#str_PCR BRA addrfa74 addrfa5d CLRA LDB 3,S ADDD #addrf86d PSHS D CLRA PULS X LDB ,X PSHS D CALL printf_,#str_5c LEAS 2,S addrfa74 LDB 1,S BNE addrfa7d LDD #str_plus BRA addrfa84 addrfa7d CMPB #$01 BNE addrfa87 LDD #str_2pls addrfa84 CALL printf_ addrfa87 CLRA LDB ,S ANDB #$10 LBEQ addrfc84 LDB ,S ANDB #$80 LBEQ addrfc84 LDD #str_rbrk JMP CPRINTF1 addrfa9e LEAS -2,S CALL GETMONBY STD ,S SUBD #$007f BLE addrfab0 LDD ,S ORA #$ff STD ,S addrfab0 LDD ,S ADDD MON_ADDR STD ,S PSHS D LDD 2,S TFR A,B CLRA PSHS D LDD #str_d25h BRA addrfaea addrfac5 LEAS -2,S LDX MON_ADDR LDD ,X STD ,S LDD MON_ADDR ADDD #$0002 STD MON_ADDR LDD ,S ADDD MON_ADDR STD ,S PSHS D LDD 2,S TFR A,B CLRA PSHS D LDD #str_x25d addrfaea JMP addrfc07 addrfaed LDD #str_A BRA addrfaf5 addrfaf2 LDD #str_B addrfaf5 JMP printf_ DISDIR1 PSHS D LEAS -1,S CLRA LDB 2,S ANDB #$0f STB ,S CMPB #$06 BEQ addrfb0b CMPB #$07 BNE addrfb0f addrfb0b CALLS addrfac5 BRA addrfb49 addrfb0f CMPB #$0a BEQ addrfb17 CMPB #$0c BNE addrfb1d addrfb17 CLRB CALL DISIMM8C BRA addrfb49 addrfb1d CMPB #$0e BEQ addrfb41 CMPB #$0f BRA addrfb3f addrfb25 PSHS D LEAS -1,S CLRA LDB 2,S ANDB #$0f STB ,S CMPB #$03 BHI addrfb39 CALL DISIDX8C BRA addrfb49 addrfb39 CMPB #$07 BLS addrfb41 CMPB #$0c addrfb3f BNE addrfb49 addrfb41 CALL printf_,#str__4 CALLS PRMONBHX addrfb49 LEAS 3,S RTS ; prints the next mon byte character as a 2 character hex digit PRMONBHX CALLS GETMONBY PSHS D CALL printf_,#str_5h LEAS 2,S RTS ; Gets the next byte to process in the monitor. ; It gets the byte pointed to by MON_ADDR and then ; decrements the MON_CNT indicating that it has been consumed GETMONBY LDD MON_CNT ADDD #-1 STD MON_CNT LDD MON_ADDR PSHS D ADDD #1 STD MON_ADDR PULS X CLRA LDB ,X RTS addrfb73 LEAS -6,S CALLS GETMONBY STB ,S CMPB #$21 BCS addrfb9e CMPB #$2f BHI addrfb9e CALL printf_,#str_L LDD #dcodtb2 PSHS D CLRA LDB 2,S CALL addrfc5a LEAS 2,S STD 2,S CALL PRTDISOP CALL addrfac5 BRA addrfc0a addrfb9e CLRA ANDB #$0f STB 1,S CMPB #$03 BNE addrfbac LDD #str_CMPD BRA addrfbdb addrfbac CMPB #$0c BNE addrfbb5 LDD #str_CMPY BRA addrfbdb addrfbb5 CMPB #$0e BNE addrfbc9 LDB ,S ANDB #$40 BNE addrfbc4 LDD #str_LDY_ BRA addrfbdb addrfbc4 LDD #str_LDS_ BRA addrfbdb addrfbc9 CMPB #$0f BNE addrfc04 LDB ,S ANDB #$40 BNE addrfbd8 LDD #str_STY_ BRA addrfbdb addrfbd8 LDD #str_STS_ addrfbdb CALL printf_ CLRA LDB ,S ANDB #$f0 LSRA RORB LSRA RORB LSRA RORB STD 4,S CLRA LDB ,S PSHS D LDD 6,S ADDD #1 LSLB ROLA ADDD #TABINST PSHS D PULS X PULS D CALL [,X] BRA addrfc0a addrfc04 LDD #str_qqqq addrfc07 CALL printf_ addrfc0a LEAS 6,S RTS ; Disassembles extended opcodes ; 11 3F - SWI3 ; 11 83 nn nn - CMPU #nnnn Immediate ; 11 8C nn nn - CMPS #nnnn Immediate ; 11 93 dd - CMPU dd ;,DP Direct ; 11 9C dd - CMPS dd ;,DP Direct ; 11 A3 ii - CMPU -- Indexed ; 11 AC ii - CMPS -- Indexed ; 11 B3 ee ee - CMPU [eeee] Extended ; 11 BC ee ee - CMPS [eeee] Extended DISEXT11 LEAS -4,S CALL GETMONBY STB ,S CLRA ANDB #$0f STB 1,S CMPB #$03 ; is it a CMPU series? IF EQ LDD #str_CMPU ELSE CMPB #$0c ; How about a CMPS BNE BADEXT11 ; No so bail LDD #str_CMPS ENDIF CALL printf_ CLRA LDB ,S ; Get the instruction byte again ANDB #$f0 ; Extract the top nibble; 80=Immediate 90=Direct A0=Indexed B0=Extended LSRA RORB LSRA RORB LSRA RORB ; Now we have 10=Immediate 12=Direct 14=Indexed 16=Extended STD 2,S ; Save it CLRA LDB ,S PSHS D ; Push the byte opcode LDD 4,S ; Get back our extacted nibble ADDD #1 ; Now we have 11=Immediate 13=Direct 15=Indexed 17=Extended ; This is the offset in the table to get to the function to call LSLB ROLA ; Finally we have 22=Immediate 26=Direct 2A=Indexed 2E=Extended ; This corresponds to disassembling the 80, 90, A0 and B0 Opcodes ADDD #TABINST ; Call the PSHS D PULS X PULS D CALL [,X] BRA addrfc84 BADEXT11 LDD #str_qqqq CPRINTF1 CALL printf_ BRA addrfc84 addrfc5a PSHS D LEAS -2,S CLRA LDB 3,S ANDB #$0f addrfc63 STD ,S LDD ,S BEQ addrfc82 addrfc69 LDD 6,S PSHS D ADDD #1 STD 8,S PULS X CLRA LDB ,X ANDB #$80 BEQ addrfc69 LDD ,S ADDD #-1 BRA addrfc63 addrfc82 LDD 6,S addrfc84 LEAS 4,S RTS ; This prints a disassembly opcode starting at the address in the D register ; and going until it sees the high order bit on a character set PRTDISOP PSHS D LOOP CLRA LDB [,S] ; Get the next character ANDB #$7f ; And mask off the high order big PSHS D CALL printf_,#str_5c ; printf ("%c", char) LEAS 2,S CLRA LDB [,S] ANDB #$80 ; And see if this was the last characer because it had the high bit set QUIF NE LDD ,S ; No, so advance to the next character ADDD #1 STD ,S ENDLOOP LEAS 2,S RTS ; String table str_5h5h FCS "%h%h " str_bsr FCS "BSR" str_qqqq FCS "????" str_5n FCS "%n" str_34 FCS " #$" str__4 FCS " $" str_spc FCS " " str_45h FCS "$%h" str_lbrk FCS "[" ; addrfCCB str_dol FCS "$" str_B FCS "B" str_A FCS "A" str_D FCS "D" str_coma FCS "," str_dash FCS "-" str_2dsh FCS "--" str_PCR FCS "PCR" str_5c FCS "%c" str_plus FCS "+" str_2pls FCS "++" str_rbrk FCS "]" str_d25h FCS " $%h%h" str_x25d FCS " $%h%h" str_5h FCS "%h" str_L FCS "L" str_CMPD FCS "CMPD" str_CMPY FCS "CMPY" str_LDY_ FCS "LDY " str_LDS_ FCS "LDS " str_STY_ FCS "STY " str_STS_ FCS "STS " str_CMPU FCS "CMPU" str_CMPS FCS "CMPS" ; ; Read a hex byte from the command line ; If a valid byte is found, store it at ?? ; Set $0174 to $00 for success $ff for failure ; Set MON_ADDR to the value found mongethx BSR mongthxd STD MON_ADDR LDB $0175 CMPB #$2e IF EQ LDD MON_ADDR PSHS D CALLS mongthxd ADDD ,S PULS X ELSE CMPB #$2d IF EQ CALLS mongthxd ELSE LDD MON_ADDR ENDIF ENDIF STD $0172 LDB $0175 CMPB #BLANK IF NE CMPB #$0d IF NE CMPB #', BNE addrfd60 ENDIF ENDIF CLR $0174 RTS addrfd60 LDB #$ff STB $0174 RTS mongthxd LEAS -4,S CLRA CLRB STD 2,S LOOP CALL getchar_ STB $0175 CMPB #BLANK UNTIL NE LOOP CALLS mongthxc STD ,S LDB $0174 QUIF NE LDD 2,S LSLB ROLA LSLB ROLA LSLB ROLA LSLB ROLA ADDD ,S STD 2,S CALL getchar_ STB $0175 ENDLOOP CLR $0174 LDD 2,S LEAS 4,S RTS ; Gets looks at the current character at $0175 ; if it is a hex character, converts it to the decimal ; equivalent and returns it in D ; In case of failure $0174 is set FF, otherwise it is set ; to 0 indicating success mongthxc LEAS -1,S CLRA LDB $0175 STB ,S CALL ishex_ IF NE CLR $0174 ELSE LDB #$ff STB $0174 ENDIF CLRA LDB ,S CALL hex_ LEAS 1,S RTS ; Drain out any remaining input characters until the end of the line ; mondrain CALL getchar_ SUBD #$000d BNE mondrain RTS bad_cmd LDD #str_invc JMP printf_ str_invc FCS "Invalid command%n" ; Default breakpoint interrupt handler for SWI/NMI ; This goes into the monitor to handle single steps, breakpoints, etc INT_BRKP PULS D PULS A STA MON_SVCC PULS D STD MON_SV_D PULS A STA MON_SVDP PULS U,Y,X STX MON_SV_X STY MON_SV_Y STU MON_SV_U PULS X LEAX -1,X LDA #$3f CMPA ,X IF NE LEAX 1,X ENDIF STX MON_SVPC STS MON_SV_S LDS #$021f ANDCC #$ef JMP MONBREAK ; Return from a breakpoint into the monitor and continue execution INT_RETB LDS MON_SV_S LDD MON_SVPC PSHS D LDX MON_SV_X LDY MON_SV_Y LDU MON_SV_U PSHS U,Y,X LDA MON_SVDP PSHS A LDD MON_SV_D PSHS D LDA MON_SVCC PSHS A RTI TBMONCMD FDB 'b,cm_bank ; 'b' - Bank command FDB 'c,cm_clear ; c FDB 'd,cm_dump ; d FDB 'f,cm_fill ; f FDB 'g,cm_go ; g FDB 'l,cm_load ; l FDB 'm,cmd_mod ; m FDB ';,cmd_mod ; ; FDB 'p,passthru_ ; p FDB 'r,cmd_reg ; r FDB ':,cmd_asmb ; : FDB 's,cmd_stop ; s FDB 't,cmd_tran ; t FDB 0,0 ; Intializes some basic IO moniniti LEAS -7,S LDB #$FF STB ACIA_R1 CLR PIA1_R1 CLR PIA1_R3 CLR PIA1_R0 CLR PIA1_R2 CLRA CLRB STD ,S LOOP LDD ,S PSHS D TFR S,X LDB #$04 ABX PSHS X PULS D ADDD ,S PULS X PSHS D CLRA CLRB PULS X STB ,X LDD ,S ADDD #1 STD ,S SUBD #4 UNTIL GT TFR S,X LDB #$02 ABX PSHS X PULS D CALL settime_ CALL setdate_,#DATENONE LEAS 7,S RTS DATENONE FCB $00,$00 adrfcec7 FCB $ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff adrfced0 FCB $ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff adrfcee0 FCB $ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff adrfcef0 FCB $ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff adrfcf00 FCB $ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff adrfcf10 FCB $ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff adrfcf20 FCB $ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff adrfcf30 FCB $ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff adrfcf40 FCB $ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff adrfcf50 FCB $ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff adrfcf60 FCB $ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff adrfcf70 FCB $ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff ; routine for power on reset RESET LDX #RESETRTS ;get the address of an RTS LDB #$07 ;there are 7 vectored interrupts LDY #CONBTAB ;starting at based of the CONB Table LOOP STX ,Y++ ;initialize appendage to the RTS statement DECB ;for all 7 of them UNTIL EQ LDX #ACKIRQ ;special vector for the IRQ STX CONBIRQ JMP restart1 ;call the rest of the initialization ; Sets up the Interrupt redirection table ; Parameters: D - Address of routine to be called from that interrupt ; Stack - Which interrupt to be vectored ; CONBSET ORCC #$10 ; This appears to do nothing useful LDX 2,S ; Get the interrupt they want to set STD CONBTAB,X ; And store the function at that address ANDCC #$ef ; Also useless RTS ; general interrupt handler GEN_INT PULS D ;get the address called from SUBD #DO_IRMOT+2 ;compute an offset into the handler table LDX #CONBTAB ;get address of table ABX ;and add in the offset CALL [,X] ;and call the routine RTI ; vector for the IRQ request ACKIRQ TST ACIA_R1 ; Acknowledge the IRQ RESETRTS RTS ; interupt vector jumps DO_IRMOT CALLS GEN_INT DO_SWI3 CALLS GEN_INT DO_SWI2 CALLS GEN_INT DO_FIRQ CALLS GEN_INT DO_IRQ CALLS GEN_INT DO_SWI CALLS GEN_INT DO_NMI CALLS GEN_INT ; space left over ;; RMB 48 FILL 0,48 ; hardware interrupt vectors addrfff0 FDB DO_IRMOT ; Reserved by motorola addrfff2 FDB DO_SWI3 ; SWI3 instruction interrupt vector addrfff4 FDB DO_SWI2 ; SWI2 instruction interrupt vector addrfff6 FDB DO_FIRQ ; Fast hardware interrupt vector (FIRQ) addrfff8 FDB DO_IRQ ; Hardware interrupt vector (IRQ) addrfffa FDB DO_SWI ; SWI Instruction interrupt vector addrfffc FDB DO_NMI ; Non-maskable interrupt vector (NMI) addrfffe FDB RESET ; Reset vector END