( appskel.s: skeleton for compilation of stand-alone application code )

decimal macros

( critical allocation of work space: )

1024 constant return_stack
1024 constant data_stack
return_stack data_stack +  constant work_space

variable patch ( holds address of branch to top-level application code )

vector >type	
vector >number	
vector >.	
vector >(")

: even  dup 1 and + ;
: ", 34 word dup c@ 2+  even dup >r
   here swap cmove  r> allot ;
: ."  delay >(")  ",  delay >type ;  immediate

: another  ( replicate code from ForST system)

  { 6 regs  cfa dest
    headstart headlength
    codesize codestart
    1 local  codeoffset }

  head  to cfa
  cfa 4 - w@ 1023 and  to codesize
  
  codesize if
  
    codesize 1 + 2*  to codesize  ( full code size in bytes)
    cfa 5 - -1 traverse  to headstart
    cfa 4 + @  a5 +  to codestart
    cfa 8 + w@ 2+  to headlength

    cp @ to codeoffset  
    codestart here codesize cmove  codesize cp +!
    
    headstart there headlength cmove
    headlength hp +!
    
    there 10 - to dest ( point to new cfa)
    codeoffset dest inc ! ( cfa) codeoffset dest ! ( pfa)

  else

    ." not suitable for duplication"

  then
;

: called  0 there 14 - ! ; ( make sure last word cannot be expanded )

( macros for application code)

: appsave
  origin @  here over -  blksave ;

: textsize  here origin @ -  origin @ 2+ ! ;

( application header )

hex
here origin !

	( tos header: branch plus 6 long words and a word flag)
	
601a w,  ( branch)
0 ,	( size of text)
0 ,	( size of data)
work_space ,	( default size of bss)
0 ,	( size of symbol table)
0 , 0 ,	( reserved)
ffff w, ( flag)

: start  a7 4 + @ to a2	( ^ code header)
a2 100 + to a6		( temp data stack ptr)
a6 to a5		( index pointer)
a2 0c + @ to d2		( text size)
a2 14 + @ addto d2	( data size)
a2 1c + @ addto d2	( bss size)
100 addto d2		( base page size)
a2 d2 + to a7		( stack at top of ^code+size)
d2 a7 dec !		( size)
a2 a7 dec !		( ^code)
0 a7 dec w!		( ??)
4a a7 dec w!		( shrink memory function)
gemdos			( do it)
0c addto a7		( correct stack)
a7 return_stack - to a6	( final data stack ptr) 

[ 6100 w,  here patch !  0 w,	( bsr to application) ] ;

-2 allot ( drop RTS)	

( code will normally drop through to appabort)

: appabort
  0 a7 dec w!  4c a7 dec w!  gemdos ( pterm) ;

\ load a:\forth\apputils.s 

\ load conio.s
\   head type is >type	
\   head (") is >(")

\ load intout.s
\   head . is >.

\ load appfilin.s

\ load dump1.s


textsize  ( poke application code size into header)
' main patch @ -  patch @ w!  ( patch the branch to MAIN)