Subversion Repositories Kolibri OS

Rev

Rev 4868 | Go to most recent revision | Blame | Compare with Previous | Last modification | View Log | Download | RSS feed

  1. ; KolSPForth v12
  2.  
  3.  SYSTEM equ EMUL
  4.  
  5. ;Memory Map
  6. ;
  7. ;0
  8. ;0x02C7D        ;I_END
  9. ;0x05430        ;CTOP
  10.  
  11. ;0x3F800        ;Data stack
  12. ;0x3FA00        ;return stack
  13. ;0x3FC00        ;User
  14. ;0x3FE00        ;TIB
  15. ;0x30000        ;FILE BUFF
  16. ;0x40000 (256K)
  17.  
  18.    ;; Version control
  19.  
  20.    VER             EQU     1                       ;major release version
  21.    EXT             EQU     0                       ;minor extension
  22.  
  23.    ;; Constants
  24.  
  25.    TRUEE                EQU     -1                      ;true flag
  26.  
  27.    COMPO                EQU     040H                    ;lexicon compile only bit
  28.    IMEDD                EQU     080H                    ;lexicon immediate bit
  29.    MASKK                EQU     01FH                    ;lexicon bit mask
  30.  
  31.    CELLL                EQU     4                       ;size of a cell
  32.    BASEE                EQU     10                      ;default radix
  33.    VOCSS                EQU     8                       ;depth of vocabulary stack
  34.  
  35.    BKSPP                EQU     8                       ;back space
  36.    LF           EQU     10                      ;line feed
  37.    CRR          EQU     13                      ;carriage return
  38.    ERR          EQU     27                      ;error escape
  39.    TIC          EQU     39                      ;tick
  40.  
  41.    CALLL                EQU     0E8H                    ;CALL opcodes
  42.  
  43.    ROWH   EQU 13
  44.    KEY_DELAY EQU 20
  45.    FW_WIDTH equ 500
  46.    FW_HEIGHT equ 352
  47.  
  48.  
  49.    ;; Memory allocation
  50.  
  51.    EM           EQU     256*1024                ;top of memory
  52.    FILE_BS      EQU     64*1024                 ;file buff size
  53.    US           EQU     128*CELLL               ;user area size in cells
  54.    RTS          EQU     1024*CELLL              ;return stack/TIB size
  55.  
  56.    FILE_B       EQU     EM-FILE_BS              ;terminal input buffer (TIB)
  57.    TIBB         EQU     FILE_B-RTS              ;terminal input buffer (TIB)
  58. ;   UPP         EQU     TIBB-US                 ;start of user area (UP0)
  59.    RPP          EQU     UPP-RTS                 ;start of return stack (ESP0)
  60.    SPP          EQU     RPP-RTS                 ;start of data stack (EBP0)
  61.  
  62. LastNFA = 0
  63.  
  64. LastCFA EQU INIT
  65.  
  66.  
  67.  
  68. macro AHEADER FLAG,ID,F_CFA {
  69.         db      FLAG
  70.         DD      F_CFA
  71.         DD      LastNFA
  72. The_Nfa = $
  73.         DB      ID,0
  74. LastNFA = The_Nfa
  75. F_CFA:
  76. }
  77.  
  78. macro cfa_AHEADER FLAG,ID,F_CFA {
  79.         db      FLAG
  80.         DD      cfa_#F_CFA
  81.         DD      LastNFA
  82. The_Nfa = $
  83.         DB      ID,0
  84. LastNFA = The_Nfa
  85. cfa_#F_CFA:
  86. }
  87.  
  88.  
  89.    ;; Main entry points and COLD start data
  90.  
  91.  use32
  92.  
  93.         org    0x0
  94.  
  95.         db     'MENUET01'       ; 8 byte id
  96.         dd     0x01        ; header version
  97.         dd     ORIG         ; start of code
  98.         dd     I_END        ; size of image
  99. MEMS:   dd     EM           ; memory for app
  100.         dd     SPP          ; esp
  101. if SYSTEM eq MEOS
  102.         dd     FINFO.path
  103. else
  104.         dd     0
  105. end if
  106.         dd     0x0      ; I_Param , I_Icon
  107.  
  108.  lang fix ru
  109.  include 'MACROS.INC'
  110.  include "proc32.inc"
  111.  
  112. align 4
  113. proc strncmp stdcall, s1:dword, s2:dword, n:dword
  114.  
  115.            push esi
  116.            push edi
  117.            mov ecx, [n]
  118.            test ecx, ecx         ; Max length is zero?
  119.            je .done
  120.  
  121.            mov esi, [s1]         ; esi = string s1
  122.            mov edi, [s2]         ; edi = string s2
  123.            cld
  124. .compare:
  125.            cmpsb                 ; Compare two bytes
  126.            jne .done
  127.            cmp byte [esi-1], 0   ; End of string?
  128.            je .done
  129.            dec ecx               ; Length limit reached?
  130.            jne .compare
  131. .done:
  132.            seta al               ; al = (s1 > s2)
  133.            setb ah               ; ah = (s1 < s2)
  134.            sub al, ah
  135.            movsx eax, al         ; eax = (s1 > s2) - (s1 < s2), i.e. -1, 0, 1
  136.            pop edi
  137.            pop esi
  138.            ret
  139. endp
  140.  
  141. align 4
  142. proc GetPr stdcall, exp:dword, sz_name:dword
  143.            mov edx, [exp]
  144. .next:
  145.            push edx
  146.            stdcall strncmp, edx, [sz_name], 16
  147.            pop edx
  148.            test eax, eax
  149.            jz .ok
  150.            mov edx, [edx-4]
  151.            test edx, edx
  152.            jnz .next
  153.         mov eax,edx
  154.            ret
  155. .ok:
  156.            mov eax, [edx-8]
  157.            ret
  158. endp
  159.  
  160. AHEADER 0 ,'GETPR',cfa_GETPR
  161.  JMP GetPr
  162.  
  163.  
  164.    ORIG:
  165.  
  166.         MOV     EBP,RPP                 ;initialize RP
  167.         CLD                             ;ESI gets incremented
  168.         finit
  169.         call draw_window
  170.         call  calc_lines
  171.         XCHG    ESP,EBP
  172.         CALL amain
  173. BYE:    mcall -1
  174.        
  175.  
  176.    ULAST:    ;      DD      0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  177.  
  178.  
  179.  draw_cursor:
  180.  
  181.  draw_window:
  182.                 pusha
  183.                 mcall 12,1
  184.         mov   [fRed],ebx
  185.     mcall 0, <0,FW_WIDTH>, <0,FW_HEIGHT>, 0x03000000, 0x805080D0, 0x005080D0
  186.     mcall 4, <8,8>, 0x10DDEEFF, header, header.size
  187.  
  188.                 mcall 9,pinfo,-1
  189.                 mov   eax,[pinfo.x_size]
  190.                 cdq
  191.                 sub   eax,20
  192.                 mov   ebx,6
  193.                 div   ebx
  194.                 mov   [pinfo.x_start],eax
  195.  
  196.                 mov   eax,[pinfo.y_size]
  197.                 cdq
  198.                 sub   eax,40
  199.                 mov   ebx,ROWH
  200.                 div   ebx
  201.  
  202.                 mov   [pinfo.y_start],eax
  203.     call  erase_screen
  204.      mcall 12, 2
  205. if ~ SYSTEM eq EMUL
  206.     mcall 67,-1,-1,FW_WIDTH,FW_HEIGHT
  207. end if
  208.                 popa
  209.                 ret
  210.  
  211.  lsz header,\
  212.    ru,'”®àâ ¤«ï MenuetOS (SPF)',\
  213.    en,'EXAMPLE APPLICATION',\
  214.    fr,"L'exemplaire programme"
  215.  
  216.  erase_screen:
  217.                 mov   ebx,[pinfo.x_size]
  218.                 add   ebx,10 shl 16-20
  219.                 mov   ecx,[pinfo.y_size]
  220.                 add   ecx,30 shl 16-35
  221.                 mcall 13,,,0;xff
  222.    ret
  223.  
  224.  
  225. AHEADER 0,"CC_LINES",cfa_CC_LINES
  226.  calc_lines:
  227.          cmp dword[UPP+10*4],0
  228.          je  .ex
  229.                 pusha
  230.                 mov  ebp,os_work
  231.                 mov  al,0xd
  232.                 mov  edi,screen_buf
  233. ;               mov  esi,[cursor]
  234. ;               mov  byte[esi],'_'
  235. ;               inc  [cursor]
  236.         .again:
  237.                 mov  [ebp],edi
  238.                 mov  esi,[cursor]
  239.                 sub  esi,edi
  240.                 mov  ecx,[pinfo.x_start]
  241. ;   test ecx,ecx
  242. ;   jnz  .no0
  243. ;   inc  ecx
  244. ;  .no0:
  245.                 cmp  ecx,esi
  246.                 jbe  .ok
  247.                 mov  ecx,esi
  248.         .ok:
  249.                 repne scasb
  250.                 jecxz .nocrlf
  251.                 cmp  byte[edi],10
  252.                 jne  .nocrlf
  253.                 inc  edi
  254.         .nocrlf:
  255.                 mov  ecx,edi
  256.                 sub  ecx,[ebp]
  257.                 add  ebp,8
  258.                 mov  [ebp-4],ecx
  259.                 cmp  edi,[cursor]
  260.                 jb   .again
  261.                 and  dword[ebp],0
  262.  ;              dpd  esi
  263.                 mov  eax,[pinfo.y_start]
  264.                 shl  eax,3
  265.                 sub  ebp,eax
  266.                 cmp  ebp,os_work
  267.                 jae  .ok2
  268.                 mov  ebp,os_work
  269.         .ok2:
  270.          cmp  ebp,[last_ebp]
  271.    je   .ok3
  272.    mov  [last_ebp],ebp
  273.    call erase_screen
  274.   .ok3:
  275.                 mov  ebx,10 shl 16 +30
  276.  ;              ud2
  277.         .newl:
  278.                 mcall 4,,0xffffff,[ebp],[ebp+4]
  279.                 add  ebp,8
  280.                 add  ebx,ROWH
  281.                 cmp  dword[ebp],0
  282.                 jnz  .newl
  283.                 SUB   ebx,ROWH
  284.                 call set_cur
  285.                 popa
  286.  .ex:
  287.                 ret
  288.  
  289.  
  290. set_cur:
  291.         MOV     ecx,EBX
  292.         shl     ecx,16
  293.         add     ecx,EBX
  294.         MOV     EAX,[ebp+4-8]
  295.         add     EAX,2
  296.         imul    EAX,6
  297.         mov     EBX,EAX
  298.         shl     ebx,16
  299.         add     EBX,EAX
  300.         mov     [lastcur],ecx
  301.         mov     [lastcur+4],ebx
  302.         ret
  303.  
  304.  e_calc_lines:
  305.          cmp dword[UPP+10*4],0
  306.          je  e_.ex
  307.                 pusha
  308.                 mov  ebp,os_work
  309.                 mov  al,0xd
  310.                 mov  edi,screen_buf
  311. ;               mov  esi,[cursor]
  312. ;               mov  byte[esi],'_'
  313. ;               inc  [cursor]
  314.         e_.again:
  315.                 mov  [ebp],edi
  316.                 mov  esi,[cursor]
  317.                 sub  esi,edi
  318.                 mov  ecx,[pinfo.x_start]
  319. ;   test ecx,ecx
  320. ;   jnz  .no0
  321. ;   inc  ecx
  322. ;  .no0:
  323.                 cmp  ecx,esi
  324.                 jbe  e_.ok
  325.                 mov  ecx,esi
  326.         e_.ok:
  327.                 repne scasb
  328.                 jecxz e_.nocrlf
  329.                 cmp  byte[edi],10
  330.                 jne  e_.nocrlf
  331.                 inc  edi
  332.         e_.nocrlf:
  333.                 mov  ecx,edi
  334.                 sub  ecx,[ebp]
  335.                 add  ebp,8
  336.                 mov  [ebp-4],ecx
  337.                 cmp  edi,[cursor]
  338.                 jb   e_.again
  339.                 and  dword[ebp],0
  340.  ;              dpd  esi
  341.                 mov  eax,[pinfo.y_start]
  342.                 shl  eax,3
  343.                 sub  ebp,eax
  344.                 cmp  ebp,os_work
  345.                 jae  e_.ok2
  346.                 mov  ebp,os_work
  347.         e_.ok2:
  348.          cmp  ebp,[last_ebp]
  349.    je   e_.ok3
  350.    mov  [last_ebp],ebp
  351.         cmp  byte[edi],10
  352.         jne  e_.ok3
  353.  
  354.    call erase_screen
  355.   e_.ok3:
  356.                 mov  ebx,10 shl 16+30
  357.  ;              ud2
  358.         e_.newl:
  359. ;               mcall 4,,0xffffff,[ebp],[ebp+4]
  360.                 add  ebp,8
  361.                 add  ebx,ROWH
  362.                 cmp  dword[ebp],0
  363.                 jnz  e_.newl
  364.                 SUB   ebx,ROWH
  365.                 mcall 4,,0x00ffffff,[ebp-8],[ebp+4-8]
  366.                 call set_cur
  367.                 popa
  368.  e_.ex:
  369.                 ret
  370.  
  371.  
  372. AHEADER 0,"?KEY",cfa_queKEY
  373.         PUSH    EDI
  374.         XCHG    EBP,ESP
  375.         PUSH    EAX
  376.        POP  EBX
  377.        mov  eax,10
  378.        test ebx,ebx
  379.        jz   QRX0
  380.        inc  eax
  381.     QRX0:
  382.                 XOR     ECX,ECX                 ;EBX=0 setup for false flag
  383.        mcall
  384.        cmp  eax,1
  385.        jne  QRX_
  386.        call draw_window
  387.        call calc_lines
  388.     QRX_:
  389.        cmp  eax,3
  390.        je  BYE
  391.        cmp  eax,2
  392.        jne QRX3
  393.  
  394.        mcall 2
  395.    QRX1:                MOVZX   ECX,AH
  396.    QRX2:                PUSH    ECX                     ;save character
  397.    QRX_TRUE:
  398.                 MOV     ECX,TRUEE               ;true flag
  399.    QRX3:                PUSH    ECX
  400.         POP     eax
  401.         XCHG    EBP,ESP
  402.         POP     EDI
  403.         ret
  404.  
  405.    ;   ?RX              ( -- c T | F )
  406.    ;            Return input character and true, or a false if no input.
  407.  
  408.  
  409. AHEADER 0,"EMIT_N",cfa_EMIT_N
  410.  
  411.         PUSH    EDI
  412.         XCHG    EBP,ESP
  413.                         ;char in AL
  414.                 CMP     AL,0FFH                 ;0FFH is interpreted as input
  415.                 JNZ     TX2                     ;do NOT allow input
  416.                 MOV     AL,32                   ;change to blank
  417.    TX2:
  418.                 mov  ebx,[cursor]
  419.                 mov  [ebx],AL
  420.                 inc  [cursor]
  421.  
  422.         POP     eax
  423.         XCHG    EBP,ESP
  424.         POP     EDI
  425. RET
  426.  
  427.  
  428.  ;; Basic I/O
  429.  
  430. cfa_AHEADER 0,'CL_CUR',CL_CUR
  431.         PUSH    EAX
  432.         mcall 38,[lastcur+4],[lastcur],0
  433.         POP     EAX
  434.         RET
  435.  
  436.         cfa_AHEADER 0,'DR_CUR',DR_CUR
  437.         PUSH    EAX
  438.         mcall 38,[lastcur+4],[lastcur],0x00FF00FF
  439.         POP     EAX
  440.         RET
  441.        
  442.  
  443. COLOR_ORDER equ MENUETOS
  444. include 'gif_lite.inc'
  445.  
  446. cfa_AHEADER 0,'READ_GIF',READ_GIF ;( gif_ptr, out_ptr -- result )
  447.         push esi
  448.         push edi
  449.         push ebp
  450.         mov  edi, eax
  451.         mov  esi,[ebp]
  452.         mov  eax,os_work
  453.         call ReadGIF
  454.         pop  ebp
  455.         pop  edi
  456.         pop  esi
  457.         add  ebp,4
  458.         RET
  459.  
  460.    ;===============================================================
  461.  cursor  dd screen_buf
  462.   fRed  dd 1
  463.  last_ebp dd 0
  464.  
  465.  include 'amain.asm'
  466.  
  467.  FINFO:
  468.         .mode dd 0
  469.                           dd 0
  470.         .blk  dd 1
  471.         .buf  dd 0
  472.         .work dd os_work
  473.         .path:
  474.  if SYSTEM eq MEOS
  475. ;       .path db 0
  476. ;       .path db '/HD/1/FORTH/AUTORUN.DAT',0
  477. ;          db '/RD/1/AUTOLOAD.F'
  478.  else
  479.          db '/RD/1/AUTOLOAD.F'
  480. ;        db '/RD/1/EXAMPLE.F'
  481. ;          db '/RD/1/PICTURE.F'
  482. ;        db '/RD/1/AUTORUN.DAT'
  483. ;        db '/HD/1/FORTH/AUTORUN.DAT'
  484.  end if
  485.         db 0
  486.         .end_path:
  487.  
  488.  
  489.         rb 256-($-.path)
  490.  
  491.  
  492. lastcur dd 0,0
  493.  
  494. I_END:
  495.  squote_buf rb 1024
  496.  sys_v rd 6
  497.  screen_buf:
  498. ; sc_end:
  499.  rb 4096
  500.  pinfo process_information
  501.  os_work rb 16*1024
  502.  
  503.    CTOP            =     $   ;next available memory in code dictionary
  504.    ;=============================================================