\ Forth source for the hexdump of my HHC Monitor 'ROM' program \ \ Provided here for guidance only - this source was developed \ using my own Cross-Assembly/Cross-Compiler software written \ in Forth \ \ NB. - the syntax will need to be customised for your \ development system; \ - you provide & link code definitions for:- \ KEY, EMIT, PAGE & INIT \ \ sr hex 0010 CONSTANT params ( startup parameter list addr. ) hcode hard-reset ( NB. discard CFA pointer so that ) dis 00 c, ( code starts at addr. 0000h ) 0020 lbr end-code hcode inext ( NB. discard CFA pointer, overwrite with code ) pcr sep ( Inext entry: ) i lda w phi i lda w plo ( 'execute' entry: ) w lda pcr phi w lda pcr plo 'inext 1- br end-code ( startup parameter list located at 0010h ) 0000 , ( mon PFA 0309h in this listing ) 0000 , ( Pstack {32C0h on HHC} ) 0000 , ( Rstack {3380h " } ) 0000 , ( key CFA Link to code which drives i/o h/w ) 0000 , ( emit CFA " ) 0000 , ( page CFA " ) 0000 , ( init CFA " ) 0000 , ( reserved ) ( Position Setup code to follow parameter list ) hcode setup ( NB. discard CFA pointer, overwrite with code ) here 07 + dup a.1 ldi pcr phi a.0 ldi pcr plo pcr sep ( setup Program counter to addr. following ) params dup a.1 ldi w phi a.0 ldi w plo w lda i phi w lda i plo ( setup I ) w lda s phi w lda s plo s sex ( setup S ) w lda r phi w lda r plo ( setup R ) ' inext 01 + dup a.1 ldi r8 phi ( get Inext addr. ) a.0 ldi r8 plo seq next end-code hcode docol ( runtime code for ':' ) i glo r dec r str i ghi r dec r str w glo i plo w ghi i phi next end-code hcode docon ( runtime code for 'constant' ) w lda ra phi w lda s dec stxd ra ghi s str next end-code hcode (;s) ( runtime code for ';' ) r lda i phi r lda i plo next end-code hcode execute ( runtime code for 'execute' CFA on TOS ) ldxa w phi ldxa w plo 'inext 04 ^+ DUP a.1 ldi ra phi a.0 ldi ra plo ra sep end-code hcode branch ( runtime code for 'branch' structure ) i lda ra phi i lda i plo ra ghi i phi next end-code hcode 0branch ( runtime code for conditional 'branch' ) ldxa or irx 'branch lbz i inc i inc next end-code hcode lit ( runtime code for inline literal value ) i lda ra phi i lda s dec stxd ra ghi s str next end-code code not 00 ldi ra plo ldxa or 0=if, 01 ldi ra plo then, ra glo stxd s str next end-code code over irx irx ldxa ra phi ldx s dec s dec s dec s dec stxd ra ghi s str next end-code code swap ldxa ra phi ldxa ra plo ldxa rb phi ldx rb plo ra glo stxd ra ghi stxd rb glo stxd rb ghi s str next end-code 20 constant bl ( regular constant for ASCII space, or 'blank' ) 00 constant 0 ( " " " integer 0 value ) code rot ldxa ra phi ldxa ra plo ldxa rb phi ldxa rb plo ldxa rc phi ldx rc plo rb glo stxd rb ghi stxd ra glo stxd ra ghi stxd rc glo stxd rc ghi s str next end-code code and ldxa ra phi ldxa irx and stxd ra ghi and s str next end-code code drop irx irx next end-code code dup ldxa ra phi ldx s dec s dec stxd ra ghi s str next end-code code c@ ldxa ra phi ldx ra plo ra ldn stxd 00 ldi s str next end-code code c! ldxa ra phi ldxa ra plo irx ldxa ra str next end-code code @ ldxa ra phi ldx ra plo ra lda rb phi ra ldn stxd rb ghi s str next end-code code + ldxa ra phi ldxa irx add stxd ra ghi adc s str next end-code code - ldxa ra phi ldxa irx sd stxd ra ghi sdb s str next end-code code > 00 ldi rc plo ldxa ra phi ldxa irx sm s dec s ldn rb phi ra ghi smb 80 ani rc phi 0<>if, rc inc then, rc glo irx stxd 00 ldi stxd ra ghi s str rb ghi xor stxd rc ghi s str ra ghi xor irx and 80 ani irx 0<>if, irx 01 ldi xor stxd then, next end-code code 2* ldxa ra phi ldx shl stxd ra ghi shlc s str next end-code code 2/ ldxa shr ra phi ldx shrc stxd ra ghi s str next end-code code = 00 ldi w plo ldxa ra phi ldxa irx xor 0=if, s dec ra ghi xor irx 0=if, 01 ldi w plo then, then, w glo stxd 00 ldi s str next end-code hcode reboot ( structured call to Reboot ) 0002 lbr end-code : key ( indirect runtime call to key ) [ params 06 + ] literal @ execute ; : emit ( indirect runtime call to emit ) [ params 08 + ] literal @ execute ; : page ( indirect runtime call to page ) [ params 0A + ] literal @ execute ; h: init ( indirect runtime call to init ) [ params 0C + ] literal @ execute ; h: inval ( i/p ascii hex digits & convert to integer value ) 0 dup begin key dup 1B = if reboot then dup 1F > while dup emit dup 39 > if 07 - then 30 - rot 2* 2* 2* 2* + swap 01 + repeat drop dup not if drop then bl emit ; h: hexout ( o/p TOS value as fieldwidth of ascii hex digits ) 0 rot rot begin swap dup 0F and dup 09 > if 07 + then 30 + swap 2/ 2/ 2/ 2/ rot 01 - dup not until drop drop begin emit dup not until drop bl emit ; h: mon ( loop to display Addr. contents or Run a CFA link ) init begin page ascii > emit key dup emit dup ascii A = if drop inval drop begin page dup 04 hexout dup c@ 02 hexout inval if over c! then 01 + again else ascii R = if inval drop execute then then again ; ( NB. Setup PFA addr. 0309h for Mon into parameter list above )