home *** CD-ROM | disk | FTP | other *** search
/ GEMini Atari / GEMini_Atari_CD-ROM_Walnut_Creek_December_1993.iso / files / language / forst / appskel.s < prev    next >
Encoding:
Text File  |  1993-10-23  |  2.6 KB  |  121 lines
  1. ( appskel.s: skeleton for compilation of stand-alone application code )
  2.  
  3. decimal macros
  4.  
  5. ( critical allocation of work space: )
  6.  
  7. 1024 constant return_stack
  8. 1024 constant data_stack
  9. return_stack data_stack +  constant work_space
  10.  
  11. variable patch ( holds address of branch to top-level application code )
  12.  
  13. vector >type    
  14. vector >number    
  15. vector >.    
  16. vector >(")
  17.  
  18. : even  dup 1 and + ;
  19. : ", 34 word dup c@ 2+  even dup >r
  20.    here swap cmove  r> allot ;
  21. : ."  delay >(")  ",  delay >type ;  immediate
  22.  
  23. : another  ( replicate code from ForST system)
  24.  
  25.   { 6 regs  cfa dest
  26.     headstart headlength
  27.     codesize codestart
  28.     1 local  codeoffset }
  29.  
  30.   head  to cfa
  31.   cfa 4 - w@ 1023 and  to codesize
  32.   
  33.   codesize if
  34.   
  35.     codesize 1 + 2*  to codesize  ( full code size in bytes)
  36.     cfa 5 - -1 traverse  to headstart
  37.     cfa 4 + @  a5 +  to codestart
  38.     cfa 8 + w@ 2+  to headlength
  39.  
  40.     cp @ to codeoffset  
  41.     codestart here codesize cmove  codesize cp +!
  42.     
  43.     headstart there headlength cmove
  44.     headlength hp +!
  45.     
  46.     there 10 - to dest ( point to new cfa)
  47.     codeoffset dest inc ! ( cfa) codeoffset dest ! ( pfa)
  48.  
  49.   else
  50.  
  51.     ." not suitable for duplication"
  52.  
  53.   then
  54. ;
  55.  
  56. : called  0 there 14 - ! ; ( make sure last word cannot be expanded )
  57.  
  58. ( macros for application code)
  59.  
  60. : appsave
  61.   origin @  here over -  blksave ;
  62.  
  63. : textsize  here origin @ -  origin @ 2+ ! ;
  64.  
  65. ( application header )
  66.  
  67. hex
  68. here origin !
  69.  
  70.     ( tos header: branch plus 6 long words and a word flag)
  71.     
  72. 601a w,  ( branch)
  73. 0 ,    ( size of text)
  74. 0 ,    ( size of data)
  75. work_space ,    ( default size of bss)
  76. 0 ,    ( size of symbol table)
  77. 0 , 0 ,    ( reserved)
  78. ffff w, ( flag)
  79.  
  80. : start  a7 4 + @ to a2    ( ^ code header)
  81. a2 100 + to a6        ( temp data stack ptr)
  82. a6 to a5        ( index pointer)
  83. a2 0c + @ to d2        ( text size)
  84. a2 14 + @ addto d2    ( data size)
  85. a2 1c + @ addto d2    ( bss size)
  86. 100 addto d2        ( base page size)
  87. a2 d2 + to a7        ( stack at top of ^code+size)
  88. d2 a7 dec !        ( size)
  89. a2 a7 dec !        ( ^code)
  90. 0 a7 dec w!        ( ??)
  91. 4a a7 dec w!        ( shrink memory function)
  92. gemdos            ( do it)
  93. 0c addto a7        ( correct stack)
  94. a7 return_stack - to a6    ( final data stack ptr) 
  95.  
  96. [ 6100 w,  here patch !  0 w,    ( bsr to application) ] ;
  97.  
  98. -2 allot ( drop RTS)    
  99.  
  100. ( code will normally drop through to appabort)
  101.  
  102. : appabort
  103.   0 a7 dec w!  4c a7 dec w!  gemdos ( pterm) ;
  104.  
  105. \ load a:\forth\apputils.s 
  106.  
  107. \ load conio.s
  108. \   head type is >type    
  109. \   head (") is >(")
  110.  
  111. \ load intout.s
  112. \   head . is >.
  113.  
  114. \ load appfilin.s
  115.  
  116. \ load dump1.s
  117.  
  118.  
  119. textsize  ( poke application code size into header)
  120. ' main patch @ -  patch @ w!  ( patch the branch to MAIN)
  121.