home *** CD-ROM | disk | FTP | other *** search
/ Set of Apple II Hard Drive Images / hard.hdv / HARD / FORTH / SOURCE / OBJECTS.WRD < prev    next >
Encoding:
Text File  |  1992-12-02  |  2.3 KB  |  95 lines  |  [04] ASCII Text (0x0000)
  1. \ OBJECTS - ASSEMBLER WORDS TO CREATE FORTH OBJECTS
  2.  
  3. \ WORDS ARE USED AS FOLLOWS:
  4. \
  5. \  <# BYTES IN PARM AREA>
  6. \  OBJECT <NAME OF OBJECT>
  7. \     <CODE TO FETCH PARAMETERS WHEN INVOKED FROM FORTH>
  8. \     <ADJUST STACK BY MANIPULATING X REGISTER>
  9. \     <DON'T NEED RTS, - WILL BE COMPILED BY OBJ-CODE WORD>
  10. \
  11. \  OBJ-CODE
  12. \     <SAVES X REGISTER, UPDATES CODE ADRS IN HEADER>
  13. \     <YOUR FUNCTION CODE GOES HERE>
  14. \
  15. \  OBJ-CALL <NAME OF OBJECT TO CALL>
  16. \     <TO JSR TO THE OBJ-CODE OF ANOTHER OBJECT>
  17. \
  18. \  OBJ-EXIT
  19. \     <USED IF FUNCTION EXITS IN MIDDLE OF CODE>
  20. \     < COMPILES CODE TO RESTORE X REGISTER & RTS >
  21. \
  22. \  OBJ-ENDCODE
  23. \     <RESTORES X REGISTER, RTS, AND END-CODE>
  24.  
  25.  
  26. ASSEMBLER DEFINITIONS
  27.  
  28. VARIABLE CODEADRS
  29. VARIABLE PARMLEN
  30.  
  31. : OBJ-HEADER
  32.    255 MIN 0 MAX       \ MAKE SURE PARM IS IN RANGE
  33.    PARMLEN !           \ SAVE THE PARM - & CLEANS UP STACK 
  34.    [COMPILE] CODE      \ GETS NAME OF OBJECT & CREATES HEADER
  35.    PARMLEN @ 
  36.    DUP HERE 13 + + JSR, \ CALC ADRS OF PARM MANIPULATION CODE
  37.    HERE 6 + JSR,        \ JSR TO CODEJUMP
  38.    NEXT JMP,            \ RETURNS TO FORTH
  39.    HERE 1+ CODEADRS !   \ SAVE CODE ADDRESS FOR LATER
  40.    HERE JMP,            \ COMPILE DUMMY CODE ADDRESS FOR NOW
  41.    DUP C, ALLOT         \ PUT IN PARM LENGTH AND ALLOCATE 
  42. ; IMMEDIATE                        \ PARM AREA
  43.  
  44. : OBJ-CODE
  45.    RTS,                 \ END THE PREVIOUS SECTION
  46.    HERE CODEADRS @ !    \ UPDATE THE CODEJUMP IN HEADER
  47.    XSAVE STX,           \ SAVE FORTH PARM STACK POINTER 
  48. ;
  49.  
  50. : OBJ-EXIT
  51.    XSAVE LDX,           \ RESTORE PARM STACK POINTER
  52.    RTS,                 \ EXIT THE SUBROUTINE
  53. ;
  54.  
  55. : OBJ-END
  56.    OBJ-EXIT
  57.    [COMPILE] END-CODE
  58. ; IMMEDIATE
  59.  
  60. : OBJ-CALL  \ FOLLOWED BY WORD OF OBJECT TO CALL
  61.    [COMPILE] ' ?DUP IF   \ GET PFA OF WORD & CHECK FOR ZERO
  62.      9 +         \ GET ADRS OF CODEJUMP
  63.      XSAVE LDX,     \ LOAD X REGISTER - SUB WILL SAVE IT
  64.      JSR,           \ JSR TO THE CODEJUMP ADDRESS
  65.    ELSE
  66.      3 ERROR
  67.    THEN
  68. ;
  69.  
  70. : PARM  ( N --- ADRS )  
  71. \ GET ADRS OF N'TH PARM OF CURRENT WORD BEING ASSEMBLED
  72. \ OR LAST WORD THAT WAS JUST ASSEMBLED
  73.    CODEADRS @ 2 + + 
  74. ;
  75.  
  76. FORTH DEFINITIONS
  77.  
  78. : 'PARM  ( N --- ADRS ) ( WORD )
  79. \ GET ADRS OF NTH PARM OF AN EXISTING WORD
  80.    [COMPILE] ' ?DUP IF
  81.      12 + +
  82.    ELSE
  83.      3 ERROR
  84.    THEN
  85. ;
  86.  
  87. : OBJECT
  88.     DEPTH 0= IF 3 ERROR THEN  \ CHECK IF PARM IS ON STACK
  89.     ASSEMBLER
  90.     [COMPILE] ASSEMBLER
  91.     [COMPILE] OBJ-HEADER
  92. ; IMMEDIATE
  93.  
  94. FORTH
  95.