home *** CD-ROM | disk | FTP | other *** search
/ BMUG PD-ROM A / PD-ROM A.iso / Programming / Programming Languages / Pocket Forth rel.5 / Source code / daSource / PocketDA.asm < prev    next >
Encoding:
Assembly Source File  |  1991-07-19  |  8.3 KB  |  298 lines  |  [TEXT/ASM ]
  1. ; File is PocketDA.asm  10:04:36 AM  6/26/87
  2. ; Sat Feb 13, 1988 14:37:31 version 1.3+  move DICT control to dSupport.txt
  3. ; Tue May 10, 1988 02:46:06 version 1.4  DRVR is purgable
  4. ; Thu Jul 04, 1991 11:27:00 version 1.5
  5.  
  6. ; ----- definitions ------
  7.  
  8. INCLUDE    Traps.txt
  9. JIODone        EQU    $8FC    ; IODone entry location [pointer]
  10.  
  11. csCode        EQU    $1A    ; param block message record offset
  12. csEvent        EQU    $1C    ; param block event record offset
  13. csMenu        EQU    $1E    ; param block menu offset
  14. dCtlWindow    EQU    $1E    ; DCE window pointer offset
  15. dCtlRefNum    EQU    $18    ; DCE refNum offset
  16. WindowKind    EQU    $6C    ; Window pointer offset
  17. accEvent    EQU    $40
  18. accRun        EQU    $41
  19. accCursor    EQU    $42
  20. accMenu        EQU    $43
  21. accUndo        EQU    $44
  22. useritem    EQU    0
  23. staticText    EQU    8
  24. disabled    EQU    128
  25.  
  26. OpenJMP        EQU    4    ; offsets into the DICT
  27. CloseJMP    EQU    8
  28. ControlJMP    EQU    0
  29. ExpandJMP    EQU    12
  30.  
  31. evtNum        EQU    0    ; event field offset: event type
  32. evtASCII    EQU    4    ; event field offset: ASCII code
  33. evtMeta        EQU    14    ; event field offset: meta keys
  34. LHeight        EQU    11    ; line height
  35. WHeight        EQU    178    ; 16 lines
  36. WWidth        EQU    384    ; 64 chars
  37. CR        EQU    $0D    ; carrage return
  38. BS        EQU    8    ; backspace
  39. BL        EQU    32    ; blank
  40.  
  41. MACRO    Base    = Baddr |    ; start of the address space
  42. MACRO    theLink    = Base-6 |    ; calculate the link address
  43. MACRO    BP    = A3 |        ; base pointer
  44. MACRO    DP    = A2 |        ; compile pointer
  45. MACRO    PS    = A6 |        ; parameter stack pointer
  46. MACRO    RS    = A7 |        ; return stack pointer
  47. MACRO    IS    = A4 |        ; input stream buffer pointer
  48. MACRO    Counter    = D7 |        ; character count
  49. MACRO    Dict    = D6 |        ; start search
  50.  
  51. .ALIGN 2  ; ------ the DRVR resource ------
  52. RESOURCE 'DRVR'    26  'PocketForth1.5' 32    ; purgable
  53.  
  54. Start:    ; ----- Header ------
  55.     DC.W        $6400        ; Locked, ctlEnabled
  56.     DC.W        2        ; run every 1/30th sec
  57.     DC.W        362        ; KeyDown&Auto, button, act & update
  58.     DC.W        -1        ; a user menu
  59.  
  60.     DC.W    Openda-Start
  61.     DC.W    done-Start        ; prime - unused
  62.     DC.W    Control-Start
  63.     DC.W    done-Start        ; status - unused
  64.     DC.W    Close-Start
  65.  
  66. ; ----- Data ------
  67. ResID:        DC.W    0        ; resource ID to be set at runtime
  68. ResType:    DC.L    'DRVR'        ; resource type code
  69. ResName:    DCB.B    16,0        ; a string for the DA's name 
  70. DictH:        DC.L    0        ; the DICT's handle
  71. Running:    DC.W    0
  72.  
  73. Openda:        ; ----- Open routine ------
  74.     MOVEM.L    D0-D7/A0-A6,-(SP)
  75.     TST.L    DCtlWindow(A1)        ; be sure this DA's not open
  76.     BNE.S    GoodOpenDone        ; if so, don't make a new one
  77.     MOVE.L    A1,A4            ; hold the DCE in a stable register
  78.     LEA    Start,A0        ; A0 has the DA's pointer
  79.     _RecoverHandle            ; A0 has the DA's handle
  80.     MOVE.L    A0,-(SP)        ; Push DA handle,
  81.     PEA    ResID            ;   addr for ID number...
  82.     PEA    ResType            ;   addr for type code...
  83.     PEA    ResName            ;   addr for a Str(255)
  84.     _GetResInfo            ; set this resource ID number
  85.     JSR    OldPort            ; save old port on stack
  86.     JSR    LoadWIND        ; load the WIND resource
  87.     MOVE.L    #512,D0
  88.     _NewPtr                ; create a pStack block
  89.     MOVE.L    A0,PS            ; carry it there in A6 (PS)
  90.     JSR    LoadDICT        ; load the DICT resource
  91.     JSR    DictAddr        ; get the dictionary address into A0
  92.     LEA    doExpand,A1        ; carry the expand routine in A1
  93.     JSR    OwnedID            ; carry the ID of the DICT in D0
  94.     JSR    OpenJMP(A0)        ; jsr to the dictionary open
  95.     _SetPort        ; <-- DICT RETURNS HERE
  96.  
  97.   GoodOpenDone:
  98.     MOVEQ    #0,D0            ; return no error
  99.   OpenDone:
  100.     MOVEM.L    (A7)+,D0-D7/A0-A6
  101.   Done:    RTS                ; all done, exit
  102.  
  103.   BadOpenDone:
  104.       MOVE.W    #-1,D0            ; set error condition
  105.     BRA.S    OpenDone
  106.  
  107. Close:        ; ----- Close routine ------
  108.     MOVEM.L    D0-D7/A0-A6,-(SP)
  109.     MOVE.L    DCtlWindow(A1),-(SP)    ; push the window
  110.     CLR.L    DCtlWindow(A1)        ; clear the pointer in the DCE
  111.     _DisposWindow            ; dispose it
  112.     JSR    DictAddr        ; get the dictionary address into 
  113.     JSR    CloseJMP(A0)        ; jsr to the DICT's close routine
  114.     JSR    DisposeDICT    ; <-- DICT RETURNS HERE
  115.     BRA.S    GoodOpenDone        ; all done with close
  116.     
  117. Control:    ; ----- Control routine ------
  118.     MOVEM.L    D0-D7/A0-A6,-(SP)
  119.     LEA    running,A3
  120.     TST    (A3)
  121.     BNE.S    cdone
  122.     MOVE    #-1,(A3)
  123.     MOVE.L    A0,D4            ; pBlock always in D4 during control
  124.     JSR    OldPort            ; save old port on stack
  125.     JSR    DictAddr        ; get the dictionary address into 
  126.     JSR    ControlJMP(A0)        ; jsr to the dictionary control
  127.     _SetPort        ; <-- DICT RETURNS HERE
  128.     LEA    running,A0
  129.     CLR    (A0)
  130.  
  131. CDone:    MOVEM.L    (A7)+,D0-D7/A0-A6
  132.     MOVEQ    #0,D0            ; no error
  133.     MOVE.L    JIODone,-(SP)        ; jump to IODone
  134.     RTS
  135.  
  136. ; ----- Expand routine ( entry from DICT ) ------
  137.  
  138. doExpand:
  139.     MOVE.L    DictH,A0
  140.     _HUnlock            ; unlock the dictionary
  141.     _GetHandleSize            ; add the passed in size ...
  142.     ADD    (A6)+,D0        ;  ...to the previous size and ...
  143.     _SetHandleSize            ;  ... reset dictionary size
  144.     _HLock
  145.  
  146.     JSR    DictAddr        ; get the dictionary address
  147.     JMP    ExpandJMP(A0)        ; jsr to the dictionary expand
  148.  
  149. ; ----- subroutines ------
  150.  
  151. LoadDICT:    ; load in the DICT
  152.     CLR.L    -(SP)            ; room for dict handle
  153.     MOVE.L    #'DICT',-(SP)        ; type of resource
  154.     BSR.S    OwnedID
  155.     ADD.W    #0,D0            ; plus the 'private' ID of the DICT
  156.     MOVE.W    D0,-(SP)
  157.     _GetResource
  158.     LEA    DictH,A0        ; stash the resource handle
  159.     MOVE.L    (SP)+,(A0)
  160.     MOVE.L    (A0),A0
  161.     _HLock                ; Lock the DICT
  162.     RTS
  163.  
  164. OwnedID:  ; get an owned ID number into D0 
  165.     MOVE    ResID,D0        ; this DA's ID
  166.     ASL    #5,D0            ; times 32
  167.     OR    #$C000,D0        ; -16384
  168.     RTS
  169.  
  170. LoadWIND:
  171.     CLR.L    -(SP)            ; make room for the new window pointer
  172.     BSR.S    OwnedID
  173.     ADD.W    #0,D0            ; plus the 'private' ID of the WIND
  174.     MOVE.W    D0,-(SP)
  175.     CLR.L    -(SP)            ; put it on the heap
  176.     MOVE.L    #-1,-(SP)        ; behind none
  177.     _GetNewWindow
  178.     MOVE.L  (SP)+,A0
  179.     MOVE.L    A0,DCtlWindow(A4)    ; put window pointer into DCE
  180.     MOVE.W    DCtlRefNum(A4),WindowKind(A0)    ; mark as system window 
  181.     RTS
  182.     
  183. DICTAddr:    ; return the address of the DICT's block in A0
  184.     MOVE.L    DictH,A0        ; get the DICT's handle
  185.     MOVE.L    (A0),D0            ; dereference into D0
  186.     ANDI.L    #$1FFFFFFF,D0        ; mask out resource flags
  187.     MOVE.L    D0,A0            ; load the jump address
  188.     RTS
  189.  
  190. DisposeDICT:
  191.     MOVE.L    DictH,-(SP)        ; the DICT's handle
  192.     _ReleaseResource        ; dispose of the DICT
  193.     RTS
  194.  
  195. OldPort:
  196.     MOVE.L    (SP)+,D3        ; hold return address
  197.     SUBQ.L    #4,SP            ; open a hole in the stack
  198.     MOVE.L    SP,-(SP)        ; push address of the hole
  199.     _GetPort            ; put the port into the hole
  200.     MOVE.L    D3,-(SP)        ; restore the return address
  201.     RTS
  202.  
  203.  
  204. .ALIGN 2 ; ----- the DICT resource ------
  205. RESOURCE 'DICT' $C340  'PocketForth' 16 ; locked (not necc. to be p'able)
  206.  
  207. Baddr:                    ; start of forth's address space
  208. Bottom:    JMP    DictControl        ; jump into sections of the driver
  209.     JMP    DictOpen
  210.     JMP    DictClose
  211.     JMP    GRet
  212.  
  213. DictOpen:    ; ----- Open routine------
  214.       LEA    Baddr,BP        ; Set the base pointer
  215.     MOVE    D0,MyID-base(BP)    ; set the id holder
  216.     MOVE.L    A1,Expand-base(BP)    ; set the expand routine's address
  217.     MOVE.L    PS,PStackH-base(BP)
  218.  
  219.     MOVE.L    DCtlWindow(A4),-(SP)
  220.     MOVE.L    (SP),theWindow-base(BP) ; Put the window into theWindow
  221.     MOVE.L    (SP),-(SP)
  222.     MOVE.L    WSize-base(BP),-(SP)
  223.     CLR.W    -(SP)
  224.     _SizeWindow
  225.     MOVE.L    (SP),-(SP)
  226.     _ShowWindow
  227.     _SetPort
  228.  
  229.     ADDA.L    #512,PS
  230.     MOVE.L    PS,UFlow-base(BP)
  231.     SUBQ.L    #2,PS            ; leave a 2 byte underflow buffer
  232.     MOVE.L    PS,SZero-base(BP)
  233.  
  234.     CLR.L    Dict
  235.     MOVE    DictPt-base(BP),Dict    ; Set the dictionary search pointer
  236.     MOVE    FreePt-base(BP),D0
  237.     LEA    0(BP,D0.W),DP        ; set the compile pointer
  238.     LEA    TermBuf-base(BP),IS    ; set the input stream pointer
  239.     CLR.L    Counter            ; clear character count
  240.     CLR.L    fcolon-base(BP)        ; set the compiler flags
  241.     BSET.B    #7,fint-base(BP)
  242.     
  243.     MOVE.L    #10,D0
  244.     _NewHandle            ; pasting text block
  245.     MOVE.L    A0,TextH-base(BP)
  246.     
  247.     MOVE.L    #10,D0
  248.     _NewHandle            ; to save rStack during "key"
  249.     MOVE.L    A0,oldStackH-base(BP)
  250.     
  251.     MOVE    freesz-base(BP),-(PS)
  252.     JSR    grow-base(BP)        ; grow to the current size
  253.     JSR    ClearTermBuf-base(BP)
  254.     JSR    Page-base(BP)
  255.     
  256.     MOVE    opener-base(BP),D0
  257.     JSR    0(BP,D0)        ; run the open routine 3/30/88
  258.  
  259.     JSR    SaveFRegs-base(BP)    ; save the initial register values
  260.     RTS
  261.  
  262. DictClose:    ; ----- Close routine ------
  263.     JSR    SetFRegs        ; set the Forth registers    
  264.     MOVE    Closer-base(BP),D0
  265.     JSR    0(BP,D0.W)        ; jump to the closer vector
  266.  
  267.     MOVE.L    PStackH-base(BP),A0
  268.     _DisposPtr            ; dispose of the stack block
  269.     MOVE.L    TextH,A0
  270.     _DisposHandle            ; dispose of the private scrap block
  271.     MOVE.L    OldStackH,A0
  272.     _DisposHandle            ; dispose of "key"'s storage
  273.     RTS
  274.  
  275. INCLUDE    dSupport.txt            ; unnamed interface routines
  276. INCLUDE    dInterp.txt            ; interpreter words
  277. INCLUDE    Common.txt
  278.  
  279.     DC.B    4,'TAS'            ; "task" ( -- ) a no-op word
  280.     DC.W    qbutton-theLink        ;  use:  forget task : task ;
  281. Task:    RTS                ;  to cleanup dictionary
  282. DictEnd:
  283.  
  284. .ALIGN    2    ; ----- the WIND resource ------
  285. RESOURCE 'WIND' $C340  'PocketForth' 32 ; purgable
  286.     DC.W    40,2,41,102
  287.     DC.W    4            ; no grow doc proc
  288.     DC.W    0            ; invisable
  289.     DC.W    $100            ; closable
  290.     DC.L    0
  291.     DC.B    16,'Pocket Forth 1.5'
  292.  
  293. .ALIGN    2    ; ----- the signature resource for identification ------
  294. RESOURCE 'P4th' $C340  'PocketForth' 32 ; purgable
  295.      DC.B    23,'v1.5  C. Heilman 7/4/91'
  296.  
  297. END
  298.