| 0,0 → 1,504 |
|---|
| ; KolSPForth v12 |
| |
| SYSTEM equ EMUL |
| |
| ;Memory Map |
| ; |
| ;0 |
| ;0x02C7D ;I_END |
| ;0x05430 ;CTOP |
| |
| ;0x3F800 ;Data stack |
| ;0x3FA00 ;return stack |
| ;0x3FC00 ;User |
| ;0x3FE00 ;TIB |
| ;0x30000 ;FILE BUFF |
| ;0x40000 (256K) |
| |
| ;; Version control |
| |
| VER EQU 1 ;major release version |
| EXT EQU 0 ;minor extension |
| |
| ;; Constants |
| |
| TRUEE EQU -1 ;true flag |
| |
| COMPO EQU 040H ;lexicon compile only bit |
| IMEDD EQU 080H ;lexicon immediate bit |
| MASKK EQU 01FH ;lexicon bit mask |
| |
| CELLL EQU 4 ;size of a cell |
| BASEE EQU 10 ;default radix |
| VOCSS EQU 8 ;depth of vocabulary stack |
| |
| BKSPP EQU 8 ;back space |
| LF EQU 10 ;line feed |
| CRR EQU 13 ;carriage return |
| ERR EQU 27 ;error escape |
| TIC EQU 39 ;tick |
| |
| CALLL EQU 0E8H ;CALL opcodes |
| |
| ROWH EQU 13 |
| KEY_DELAY EQU 20 |
| FW_WIDTH equ 500 |
| FW_HEIGHT equ 352 |
| |
| |
| ;; Memory allocation |
| |
| EM EQU 256*1024 ;top of memory |
| FILE_BS EQU 64*1024 ;file buff size |
| US EQU 128*CELLL ;user area size in cells |
| RTS EQU 1024*CELLL ;return stack/TIB size |
| |
| FILE_B EQU EM-FILE_BS ;terminal input buffer (TIB) |
| TIBB EQU FILE_B-RTS ;terminal input buffer (TIB) |
| ; UPP EQU TIBB-US ;start of user area (UP0) |
| RPP EQU UPP-RTS ;start of return stack (ESP0) |
| SPP EQU RPP-RTS ;start of data stack (EBP0) |
| |
| LastNFA = 0 |
| |
| LastCFA EQU INIT |
| |
| |
| |
| macro AHEADER FLAG,ID,F_CFA { |
| db FLAG |
| DD F_CFA |
| DD LastNFA |
| The_Nfa = $ |
| DB ID,0 |
| LastNFA = The_Nfa |
| F_CFA: |
| } |
| |
| macro cfa_AHEADER FLAG,ID,F_CFA { |
| db FLAG |
| DD cfa_#F_CFA |
| DD LastNFA |
| The_Nfa = $ |
| DB ID,0 |
| LastNFA = The_Nfa |
| cfa_#F_CFA: |
| } |
| |
| |
| ;; Main entry points and COLD start data |
| |
| use32 |
| |
| org 0x0 |
| |
| db 'MENUET01' ; 8 byte id |
| dd 0x01 ; header version |
| dd ORIG ; start of code |
| dd I_END ; size of image |
| MEMS: dd EM ; memory for app |
| dd SPP ; esp |
| if SYSTEM eq MEOS |
| dd FINFO.path |
| else |
| dd 0 |
| end if |
| dd 0x0 ; I_Param , I_Icon |
| |
| lang fix ru |
| include 'MACROS.INC' |
| include "proc32.inc" |
| |
| align 4 |
| proc strncmp stdcall, s1:dword, s2:dword, n:dword |
| |
| push esi |
| push edi |
| mov ecx, [n] |
| test ecx, ecx ; Max length is zero? |
| je .done |
| |
| mov esi, [s1] ; esi = string s1 |
| mov edi, [s2] ; edi = string s2 |
| cld |
| .compare: |
| cmpsb ; Compare two bytes |
| jne .done |
| cmp byte [esi-1], 0 ; End of string? |
| je .done |
| dec ecx ; Length limit reached? |
| jne .compare |
| .done: |
| seta al ; al = (s1 > s2) |
| setb ah ; ah = (s1 < s2) |
| sub al, ah |
| movsx eax, al ; eax = (s1 > s2) - (s1 < s2), i.e. -1, 0, 1 |
| pop edi |
| pop esi |
| ret |
| endp |
| |
| align 4 |
| proc GetPr stdcall, exp:dword, sz_name:dword |
| mov edx, [exp] |
| .next: |
| push edx |
| stdcall strncmp, edx, [sz_name], 16 |
| pop edx |
| test eax, eax |
| jz .ok |
| mov edx, [edx-4] |
| test edx, edx |
| jnz .next |
| mov eax,edx |
| ret |
| .ok: |
| mov eax, [edx-8] |
| ret |
| endp |
| |
| AHEADER 0 ,'GETPR',cfa_GETPR |
| JMP GetPr |
| |
| |
| ORIG: |
| |
| MOV EBP,RPP ;initialize RP |
| CLD ;ESI gets incremented |
| finit |
| call draw_window |
| call calc_lines |
| XCHG ESP,EBP |
| CALL amain |
| BYE: mcall -1 |
| |
| |
| ULAST: ; DD 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 |
| |
| |
| draw_cursor: |
| |
| draw_window: |
| pusha |
| mcall 12,1 |
| mov [fRed],ebx |
| mcall 0, <0,FW_WIDTH>, <0,FW_HEIGHT>, 0x03000000, 0x805080D0, 0x005080D0 |
| mcall 4, <8,8>, 0x10DDEEFF, header, header.size |
| |
| mcall 9,pinfo,-1 |
| mov eax,[pinfo.x_size] |
| cdq |
| sub eax,20 |
| mov ebx,6 |
| div ebx |
| mov [pinfo.x_start],eax |
| |
| mov eax,[pinfo.y_size] |
| cdq |
| sub eax,40 |
| mov ebx,ROWH |
| div ebx |
| |
| mov [pinfo.y_start],eax |
| call erase_screen |
| mcall 12, 2 |
| if ~ SYSTEM eq EMUL |
| mcall 67,-1,-1,FW_WIDTH,FW_HEIGHT |
| end if |
| popa |
| ret |
| |
| lsz header,\ |
| ru,'®àâ ¤«ï MenuetOS (SPF)',\ |
| en,'EXAMPLE APPLICATION',\ |
| fr,"L'exemplaire programme" |
| |
| erase_screen: |
| mov ebx,[pinfo.x_size] |
| add ebx,10 shl 16-20 |
| mov ecx,[pinfo.y_size] |
| add ecx,30 shl 16-35 |
| mcall 13,,,0;xff |
| ret |
| |
| |
| AHEADER 0,"CC_LINES",cfa_CC_LINES |
| calc_lines: |
| cmp dword[UPP+10*4],0 |
| je .ex |
| pusha |
| mov ebp,os_work |
| mov al,0xd |
| mov edi,screen_buf |
| ; mov esi,[cursor] |
| ; mov byte[esi],'_' |
| ; inc [cursor] |
| .again: |
| mov [ebp],edi |
| mov esi,[cursor] |
| sub esi,edi |
| mov ecx,[pinfo.x_start] |
| ; test ecx,ecx |
| ; jnz .no0 |
| ; inc ecx |
| ; .no0: |
| cmp ecx,esi |
| jbe .ok |
| mov ecx,esi |
| .ok: |
| repne scasb |
| jecxz .nocrlf |
| cmp byte[edi],10 |
| jne .nocrlf |
| inc edi |
| .nocrlf: |
| mov ecx,edi |
| sub ecx,[ebp] |
| add ebp,8 |
| mov [ebp-4],ecx |
| cmp edi,[cursor] |
| jb .again |
| and dword[ebp],0 |
| ; dpd esi |
| mov eax,[pinfo.y_start] |
| shl eax,3 |
| sub ebp,eax |
| cmp ebp,os_work |
| jae .ok2 |
| mov ebp,os_work |
| .ok2: |
| cmp ebp,[last_ebp] |
| je .ok3 |
| mov [last_ebp],ebp |
| call erase_screen |
| .ok3: |
| mov ebx,10 shl 16 +30 |
| ; ud2 |
| .newl: |
| mcall 4,,0xffffff,[ebp],[ebp+4] |
| add ebp,8 |
| add ebx,ROWH |
| cmp dword[ebp],0 |
| jnz .newl |
| SUB ebx,ROWH |
| call set_cur |
| popa |
| .ex: |
| ret |
| |
| |
| set_cur: |
| MOV ecx,EBX |
| shl ecx,16 |
| add ecx,EBX |
| MOV EAX,[ebp+4-8] |
| add EAX,2 |
| imul EAX,6 |
| mov EBX,EAX |
| shl ebx,16 |
| add EBX,EAX |
| mov [lastcur],ecx |
| mov [lastcur+4],ebx |
| ret |
| |
| e_calc_lines: |
| cmp dword[UPP+10*4],0 |
| je e_.ex |
| pusha |
| mov ebp,os_work |
| mov al,0xd |
| mov edi,screen_buf |
| ; mov esi,[cursor] |
| ; mov byte[esi],'_' |
| ; inc [cursor] |
| e_.again: |
| mov [ebp],edi |
| mov esi,[cursor] |
| sub esi,edi |
| mov ecx,[pinfo.x_start] |
| ; test ecx,ecx |
| ; jnz .no0 |
| ; inc ecx |
| ; .no0: |
| cmp ecx,esi |
| jbe e_.ok |
| mov ecx,esi |
| e_.ok: |
| repne scasb |
| jecxz e_.nocrlf |
| cmp byte[edi],10 |
| jne e_.nocrlf |
| inc edi |
| e_.nocrlf: |
| mov ecx,edi |
| sub ecx,[ebp] |
| add ebp,8 |
| mov [ebp-4],ecx |
| cmp edi,[cursor] |
| jb e_.again |
| and dword[ebp],0 |
| ; dpd esi |
| mov eax,[pinfo.y_start] |
| shl eax,3 |
| sub ebp,eax |
| cmp ebp,os_work |
| jae e_.ok2 |
| mov ebp,os_work |
| e_.ok2: |
| cmp ebp,[last_ebp] |
| je e_.ok3 |
| mov [last_ebp],ebp |
| cmp byte[edi],10 |
| jne e_.ok3 |
| |
| call erase_screen |
| e_.ok3: |
| mov ebx,10 shl 16+30 |
| ; ud2 |
| e_.newl: |
| ; mcall 4,,0xffffff,[ebp],[ebp+4] |
| add ebp,8 |
| add ebx,ROWH |
| cmp dword[ebp],0 |
| jnz e_.newl |
| SUB ebx,ROWH |
| mcall 4,,0x00ffffff,[ebp-8],[ebp+4-8] |
| call set_cur |
| popa |
| e_.ex: |
| ret |
| |
| |
| AHEADER 0,"?KEY",cfa_queKEY |
| PUSH EDI |
| XCHG EBP,ESP |
| PUSH EAX |
| POP EBX |
| mov eax,10 |
| test ebx,ebx |
| jz QRX0 |
| inc eax |
| QRX0: |
| XOR ECX,ECX ;EBX=0 setup for false flag |
| mcall |
| cmp eax,1 |
| jne QRX_ |
| call draw_window |
| call calc_lines |
| QRX_: |
| cmp eax,3 |
| je BYE |
| cmp eax,2 |
| jne QRX3 |
| |
| mcall 2 |
| QRX1: MOVZX ECX,AH |
| QRX2: PUSH ECX ;save character |
| QRX_TRUE: |
| MOV ECX,TRUEE ;true flag |
| QRX3: PUSH ECX |
| POP eax |
| XCHG EBP,ESP |
| POP EDI |
| ret |
| |
| ; ?RX ( -- c T | F ) |
| ; Return input character and true, or a false if no input. |
| |
| |
| AHEADER 0,"EMIT_N",cfa_EMIT_N |
| |
| PUSH EDI |
| XCHG EBP,ESP |
| ;char in AL |
| CMP AL,0FFH ;0FFH is interpreted as input |
| JNZ TX2 ;do NOT allow input |
| MOV AL,32 ;change to blank |
| TX2: |
| mov ebx,[cursor] |
| mov [ebx],AL |
| inc [cursor] |
| |
| POP eax |
| XCHG EBP,ESP |
| POP EDI |
| RET |
| |
| |
| ;; Basic I/O |
| |
| cfa_AHEADER 0,'CL_CUR',CL_CUR |
| PUSH EAX |
| mcall 38,[lastcur+4],[lastcur],0 |
| POP EAX |
| RET |
| |
| cfa_AHEADER 0,'DR_CUR',DR_CUR |
| PUSH EAX |
| mcall 38,[lastcur+4],[lastcur],0x00FF00FF |
| POP EAX |
| RET |
| |
| |
| COLOR_ORDER equ MENUETOS |
| include 'gif_lite.inc' |
| |
| cfa_AHEADER 0,'READ_GIF',READ_GIF ;( gif_ptr, out_ptr -- result ) |
| push esi |
| push edi |
| push ebp |
| mov edi, eax |
| mov esi,[ebp] |
| mov eax,os_work |
| call ReadGIF |
| pop ebp |
| pop edi |
| pop esi |
| add ebp,4 |
| RET |
| |
| ;=============================================================== |
| cursor dd screen_buf |
| fRed dd 1 |
| last_ebp dd 0 |
| |
| include 'amain.asm' |
| |
| FINFO: |
| .mode dd 0 |
| dd 0 |
| .blk dd 1 |
| .buf dd 0 |
| .work dd os_work |
| .path: |
| if SYSTEM eq MEOS |
| ; .path db 0 |
| ; .path db '/HD/1/FORTH/AUTORUN.DAT',0 |
| ; db '/RD/1/AUTOLOAD.F' |
| else |
| db '/RD/1/AUTOLOAD.F' |
| ; db '/RD/1/EXAMPLE.F' |
| ; db '/RD/1/PICTURE.F' |
| ; db '/RD/1/AUTORUN.DAT' |
| ; db '/HD/1/FORTH/AUTORUN.DAT' |
| end if |
| db 0 |
| .end_path: |
| |
| |
| rb 256-($-.path) |
| |
| |
| lastcur dd 0,0 |
| |
| I_END: |
| squote_buf rb 1024 |
| sys_v rd 6 |
| screen_buf: |
| ; sc_end: |
| rb 4096 |
| pinfo process_information |
| os_work rb 16*1024 |
| |
| CTOP = $ ;next available memory in code dictionary |
| ;============================================================= |