#colorForth, 2001 Jul 22, Chuck Moore, Public Domain # .MODEL TINY # .486P #only SEGMENT USE32 # ASSUME .macro next adr decl %ecx jnz \adr .endm .macro DUP_ leal -4(%esi), %esi movl %eax, (%esi) .endm .macro DROP lodsl .endm #hp equ 800 #vp equ 600 #vesa equ 114h .equ hp, 1024 .equ vp, 768 .equ vesa, 0x4117 .equ buffer, 604 * 256 .include "boot.s" # boot boot0 hard # 100000 dictionary # a0000 top of return stack # 9f800 top of data stack # 9d800 free # 97000 floppy buffer # 4800 source .equ icons, 12 * 256 * 4 # 3000 # 7c00 BIOS boot sector # 0 Forth warm: DUP_ start1: mov %ebp, displ # mov screen, offset nul # xor EAX, EAX call show0 movl $buffer * 4, trash movl $(forth1 - forth0) / 4, forths # number of entries movl $(macro1 - macro0) / 4, macros movl $18, %eax # start of source block 18 call load jmp accept .equ gods, 0x28000 * 4 # 0A0000h .equ godd, gods - 750 * 4 # 09F448h .equ mains, godd - 1500 * 4 # 09DCD8h .equ maind, mains - 750 * 4 # 09D120h .balign 4 me: .int god screen: .int 0# logo round: call unpause god: .int 0# Gods-2*4 call unpause main: .int 0# mains-2*4 jmp round pause: DUP_ pushl %esi movl me, %eax movl %esp, (%eax) addl $4, %eax jmpl *%eax unpause:popl %eax movl (%eax), %esp movl %eax, me popl %esi DROP ret act: movl $maind - 4, %edx movl %eax, (%edx) movl $mains - 4, %eax pop (%eax) subl $4, %eax movl %edx, (%eax) movl %eax, main DROP ret show0: call show ret show: popl screen DUP_ xorl %eax, %eax call act 0: call graphic calll *screen(, 1) call switch incl %eax jmp 0b c_: movl $godd + 4, %esi ret mark: movl macros, %ecx movl %ecx, mk movl forths, %ecx movl %ecx, mk + 4 movl h, %ecx movl %ecx, mk + 2 * 4 ret empty: movl mk + 2 * 4, %ecx movl %ecx, h movl mk + 4, %ecx movl %ecx, forths movl mk, %ecx movl %ecx, macros movl $0, class ret mfind: movl macros, %ecx pushl %edi leal (macro0 - 4)(, %ecx, 4), %edi jmp 0f find: movl forths, %ecx pushl %edi leal (forth0 - 4)(, %ecx, 4), %edi 0: std repne scasl cld popl %edi ret ex1: decl words# from keyboard jz 0f DROP jmp ex1 0: call find jnz abort1 DROP jmpl *forth2(, %ecx, 4) execute:movl $alit, lit DUP_ movl -4(, %edi, 4), %eax ex2: andl $-020, %eax call find jnz abort DROP jmpl *forth2(, %ecx, 4) abort: movl %edi, curs shrl $10 - 2, %edi movl %edi, blk abort1: movl $gods, %esp movl $forthd, spaces + 3 * 4 movl $qcompile, spaces + 4 * 4 movl $cnum, spaces + 5 * 4 movl $cshort, spaces + 6 * 4 movl $057, %eax# ? call echo_ jmp accept sdefine:popl adefine ret macro_: call sdefine macrod: movl macros, %ecx incl macros leal macro0(, %ecx, 4), %ecx jmp 0f forth: call sdefine forthd: movl forths, %ecx incl forths leal forth0(, %ecx, 4), %ecx 0: movl -4(, %edi, 4), %edx andl $-020, %edx movl %edx, (%ecx) movl h, %edx movl %edx, (forth2 - forth0)(%ecx) leal (forth2 - forth0)(%ecx), %edx shrl $2, %edx movl %edx, last movl %esp, list movl $adup, lit testl $-1, class jz 0f jmpl *class(, 1) 0: ret cdrop: movl h, %edx movl %edx, list movb $0x0ad, (%edx)# lodsd incl h ret qdup: movl h, %edx decl %edx cmpl %edx, list jnz cdup cmpb $0x0ad, (%edx) jnz cdup movl %edx, h ret cdup: movl h, %edx movl $0x89fc768d, (%edx) movb $06, 4(%edx) addl $5, h ret adup: DUP_ ret var1: DUP_ movl (4 + forth0)(, %ecx, 4), %eax ret variable: call forthd movl $var1, (forth2 - forth0)(%ecx) incl forths# dummy entry for source address movl %edi, 4(%ecx) call macrod movl $0f, (forth2 - forth0)(%ecx) incl macros movl %edi, 4(%ecx) incl %edi ret 0: calll *lit(, 1) movl (4 + macro0)(, %ecx, 4), %eax jmp 0f cnum: calll *lit(, 1) movl (, %edi, 4), %eax incl %edi jmp 0f cshort: calll *lit(, 1) movl -4(, %edi, 4), %eax sarl $5, %eax 0: call literal DROP ret alit: movl $adup, lit literal:call qdup movl list, %edx movl %edx, list + 4 movl h, %edx movl %edx, list movb $0x0b8, (%edx) movl %eax, 1(%edx) addl $5, h ret qcompile: calll *lit(, 1) movl -4(, %edi, 4), %eax andl $-020, %eax call mfind jnz 0f DROP jmpl *macro2(, %ecx, 4) 0: call find movl forth2(, %ecx, 4), %eax 0: jnz abort call_: movl h, %edx movl %edx, list movb $0x0e8, (%edx) addl $5, %edx subl %edx, %eax movl %eax, -4(%edx) movl %edx, h DROP ret compile: calll *lit(, 1) movl -4(, %edi, 4), %eax andl $-020, %eax call mfind movl macro2(, %ecx, 4), %eax jmp 0b short_: movl $alit, lit DUP_ movl -4(, %edi, 4), %eax sarl $5, %eax ret num: movl $alit, lit DUP_ movl (, %edi, 4), %eax incl %edi ret comma: movl $4, %ecx 0: movl h, %edx movl %eax, (%edx) movl (%esi), %eax# drop leal (%edx, %ecx), %edx leal 4(%esi), %esi movl %edx, h # DROP ret comma1: movl $1, %ecx jmp 0b comma2: movl $2, %ecx jmp 0b comma3: movl $3, %ecx jmp 0b semi: movl h, %edx subl $5, %edx cmpl %edx, list jnz 0f cmpb $0x0e8, (%edx) jnz 0f incb (%edx)# jmp ret 0: movb $0x0c3, 5(%edx)# ret incl h ret then: movl %esp, list movl h, %edx subl %eax, %edx movb %dl, -1(%eax) DROP ret begin: movl %esp, list here: DUP_ movl h, %eax ret qlit: movl h, %edx leal -5(%edx), %edx cmpl %edx, list jnz 0f cmpb $0x0b8, (%edx) jnz 0f DUP_ movl list + 4, %eax movl %eax, list movl 1(%edx), %eax cmpl $0x89fc768d, -5(%edx)# dup jz q1 movl %edx, h jmp cdrop q1: addl $-10, h# flag nz ret 0: xorl %edx, %edx# flag z ret less: cmpl %eax, (%esi) js 0f# flag nz xorl %ecx, %ecx# flag z 0: ret qignore:testl $-020, -4(, %edi, 4) jnz nul popl %edi popl %edi nul: ret jump: popl %edx addl %eax, %edx leal 5(%edx, %eax, 4), %edx addl -4(%edx), %edx DROP jmpl *%edx load: shll $10 - 2, %eax pushl %edi movl %eax, %edi DROP inter: movl (, %edi, 4), %edx incl %edi andl $017, %edx calll *spaces(, %edx, 4) jmp inter .balign 4 spaces: .int qignore, execute, num adefine:.int 5 + macro_# offset macrod ? .int qcompile, cnum, cshort, compile .int short_, nul, nul, nul .int variable, nul, nul, nul lit: .int adup mk: .int 0, 0, 0 h: .int 0x40000 * 4 last: .int 0 class: .int 0 list: .int 0, 0 macros: .int 0 forths: .int 0 #macro0 dd (3 shl 4+1)shl 24 ; or # dd ((5 shl 4+6)shl 7+140o)shl 17 ; and # dd 173o shl 25 ; + macro0: .int 0170 << 25# ; .int ((0140 << 7 + 0146) << 7 + 0142) << 11# dup .int (((0177 << 7 + 0140) << 7 + 0146) << 7 + 0142) << 4# ?dup .int (((0140 << 4 + 1) << 4 + 3) << 7 + 0142) << 10# drop # dd ((6 shl 4+7)shl 7+142o)shl 17 ; nip .int (((2 << 7 + 0144) << 4 + 4) << 4 + 6) << 13# then .int ((((0143 << 4 + 4) << 5 + 025) << 4 + 7) << 4 + 6) << 8# begin macro1: .rept 128 .int 0 .endr forth0: .int (((0143 << 4 + 3) << 4 + 3) << 4 + 2) << 13# boot .int (((027 << 4 + 5) << 4 + 1) << 5 + 021) << 14# warm .int ((((0142 << 4 + 5) << 7 + 0146) << 5 + 020) << 4 + 4) << 5# pause .int ((((021 << 4 + 5) << 5 + 022) << 4 + 1) << 4 + 3) << 10# MACRO .int ((((026 << 4 + 3) << 4 + 1) << 4 + 2) << 7 + 0144) << 8# FORTH .int 022 << 27# c .int (((020 << 4 + 2) << 4 + 3) << 7 + 0142) << 12# stop .int (((1 << 4 + 4) << 4 + 5) << 7 + 0140) << 13# read .int ((((027 << 4 + 1) << 4 + 7) << 4 + 2) << 4 + 4) << 11# write .int (6 << 5 + 022) << 23# nc .int (((((022 << 4 + 3) << 5 + 021) << 5 + 021) << 4 + 5) << 4 + 6) << 5# comman d .int (((020 << 4 + 4) << 4 + 4) << 7 + 0164) << 12# seek .int ((((1 << 4 + 4) << 4 + 5) << 7 + 0140) << 5 + 023) << 8# ready # dd (((22o shl 5+24o)shl 4+1)shl 4+7)shl 14 ; clri .int ((5 << 5 + 022) << 4 + 2) << 19# ACT .int (((020 << 7 + 0144) << 4 + 3) << 5 + 027) << 11# SHOW .int (((024 << 4 + 3) << 4 + 5) << 7 + 0140) << 12# LOAD .int (((0144 << 4 + 4) << 4 + 1) << 4 + 4) << 13# here .int (((0177 << 5 + 024) << 4 + 7) << 4 + 2) << 12# ?lit .int (0153 << 7 + 0176) << 18# 3, .int (0152 << 7 + 0176) << 18# 2, .int (0151 << 7 + 0176) << 18# 1, .int 0176 << 25# , .int (((024 << 4 + 4) << 5 + 020) << 5 + 020) << 13# less .int (((0162 << 7 + 0146) << 5 + 021) << 7 + 0142) << 6# jump .int (((((5 << 5 + 022) << 5 + 022) << 4 + 4) << 7 + 0142) << 4 + 2) << 3# accept .int ((0142 << 4 + 5) << 7 + 0140) << 14# pad .int ((((4 << 4 + 1) << 4 + 5) << 5 + 020) << 4 + 4) << 11# erase .int (((022 << 4 + 3) << 7 + 0142) << 5 + 023) << 11# copy .int (((021 << 4 + 5) << 4 + 1) << 7 + 0164) << 12# mark .int (((4 << 5 + 021) << 7 + 0142) << 4 + 2) << 12# empt .int (((4 << 5 + 021) << 4 + 7) << 4 + 2) << 15# emit .int ((((0140 << 4 + 7) << 5 + 025) << 4 + 7) << 4 + 2) << 8# digit .int ((((0152 << 4 + 4) << 5 + 021) << 4 + 7) << 4 + 2) << 8# 2emit .int 0165 << 25# . .int (0144 << 7 + 0165) << 18# h. .int ((0144 << 7 + 0165) << 4 + 6) << 14# h.n .int (022 << 4 + 1) << 23# CR .int ((((020 << 7 + 0142) << 4 + 5) << 5 + 022) << 4 + 4) << 7# space .int (((0140 << 4 + 3) << 5 + 027) << 4 + 6) << 12# DOWN .int (((4 << 7 + 0140) << 4 + 7) << 4 + 2) << 13# edit .int 4 << 28# E # dd (((26o shl 4+3)shl 4+6)shl 4+2)shl 15 ; font .int (024 << 5 + 021) << 22# lm .int (1 << 5 + 021) << 23# rm .int ((((025 << 4 + 1) << 4 + 5) << 7 + 0142) << 7 + 0144) << 5# graph ic .int (((2 << 4 + 4) << 7 + 0145) << 4 + 2) << 13# text # dd (153o shl 7+140o)shl 18 ; 3d # dd (((((1 shl 4+4)shl 4+6)shl 7+140o)shl 4+4)shl 4+1)shl 5 ; render # dd ((((141o shl 4+4)shl 4+1)shl 4+2)shl 4+4)shl 9 ; verte x # dd ((((26o shl 4+1)shl 4+3)shl 4+6)shl 4+2)shl 11 ; front # dd ((2 shl 4+3)shl 7+142o)shl 17 ; top # dd (((20o shl 4+7)shl 7+140o)shl 4+4)shl 12 ; side .int ((((0164 << 4 + 4) << 5 + 023) << 7 + 0143) << 4 + 3) << 5# keybo ard .int (((0140 << 4 + 4) << 7 + 0143) << 7 + 0146) << 7# debu g .int (5 << 4 + 2) << 24# at .int ((0173 << 4 + 5) << 4 + 2) << 17# +at .int (0145 << 5 + 023) << 20# xy .int ((026 << 4 + 3) << 7 + 0141) << 16# fov .int (((026 << 4 + 7) << 5 + 026) << 4 + 3) << 14# fifo .int ((0143 << 4 + 3) << 7 + 0145) << 14# box .int (((024 << 4 + 7) << 4 + 6) << 4 + 4) << 15# line .int ((((022 << 4 + 3) << 5 + 024) << 4 + 3) << 4 + 1) << 10# color # dd (((22o shl 5+24o)shl 4+7)shl 7+142o)shl 11 ; clip .int (((((3 << 5 + 022) << 4 + 2) << 4 + 5) << 4 + 6) << 4 + 2) << 7# octant .int (020 << 7 + 0142) << 20# sp .int (((024 << 4 + 5) << 5 + 020) << 4 + 2) << 14# last .int (((((0146 << 4 + 6) << 7 + 0142) << 4 + 5) << 5 + 022)) << 5# unpac k # dd (((142o shl 4+5)shl 5+22o)shl 7+164o)shl 9 ; pack forth1: .rept 512 .int 0 .endr #macro2 dd offset cOR # dd offset cAND # dd offset PLUS macro2: .int semi .int cdup .int qdup .int cdrop # dd offset nip .int then .int begin .rept 128 .int 0 .endr forth2: .int boot .int warm .int pause .int macro_ .int forth .int c_ .int stop .int readf .int writef .int nc_ .int cmdf .int seekf .int readyf .int act .int show .int load .int here .int qlit .int comma3 .int comma2 .int comma1 .int comma .int less .int jump .int accept .int pad .int erase .int copy .int mark .int empty .int emit .int edig .int emit2 .int dot10 .int hdot .int hdotn .int cr .int space .int down .int edit .int e # dd offset font .int lms .int rms .int graphic .int text1 # dd offset set3d # dd offset render # dd offset vertex # dd offset front # dd offset top_ # dd offset side .int keyboard .int debug .int at .int pat .int xy_ .int fov_ .int fifof .int box .int line .int color # dd offset clip .int octant .int sps .int last_ .int unpack # dd offset pack .rept 512 .int 0 .endr boot: movb $0x0FE, %al# Reset outb %al, $0x64 jmp . erase: movl %eax, %ecx shll $8, %ecx DROP pushl %edi movl %eax, %edi shll $2 + 8, %edi xorl %eax, %eax rep stosl popl %edi DROP ret #move: mov ECX, EAX # DROP # mov EDI, EAX # shl EDI, 2 # DROP # push ESI # mov ESI, EAX # shl ESI, 2 # rep movsd # pop ESI # DROP # ret copy: cmpl $12, %eax jc abort1 movl %eax, %edi shll $2 + 8, %edi pushl %esi movl blk, %esi shll $2 + 8, %esi movl $256, %ecx rep movsl popl %esi movl %eax, blk DROP ret debug: movl $3 * 0x10000 + (vc - 2) * ih + 3, xy DUP_ movl god, %eax push (%eax) call dot DUP_ popl %eax call dot DUP_ movl main, %eax call dot DUP_ movl %esi, %eax jmp dot .equ iw, 16 + 6 .equ ih, 24 + 6 .equ hc, hp / iw # 46 .equ vc, vp / ih # 25 .balign 4 xy: .int 3 * 0x10000 + 3 lm: .int 3 rm: .int hc * iw# 1012 xycr: .int 0 fov: .int 10 * (2 * vp + vp / 2) nc_: DUP_ movl $(nc - start) / 4, %eax ret xy_: DUP_ movl $(xy - start) / 4, %eax ret fov_: DUP_ movl $(fov - start) / 4, %eax ret sps: DUP_ movl $(spaces - start) / 4, %eax ret last_: DUP_ movl $(last - start) / 4, %eax ret .include "gen.s" # cce.asm pio.asm ATI128.asm ATI64.asm gen.asm .equ yellow, 0x0ffff00 cyan: DUP_ movl $0x0ffff, %eax jmp color magenta: DUP_ movl $0x0ff00ff, %eax jmp color silver: DUP_ movl $0x0c0c0c0, %eax jmp color blue: DUP_ movl $0x4040ff, %eax jmp color red: DUP_ movl $0x0ff0000, %eax jmp color green: DUP_ movl $0x8000ff00, %eax jmp color history: .rept 11 .byte 0 .endr echo_: pushl %esi movl $11 - 1, %ecx lea history, %edi leal 1(%edi), %esi rep movsb popl %esi movb %al, history + 11 - 1 DROP ret right: DUP_ movl $11, %ecx lea history, %edi xorl %eax, %eax rep stosb DROP ret down: DUP_ xorl %edx, %edx movl $ih, %ecx divl %ecx movl %edx, %eax addl $3 * 0x10000 + 0x8000 - ih + 3, %edx movl %edx, xy zero: testl %eax, %eax movl $0, %eax jnz 0f incl %eax 0: ret blank: DUP_ xorl %eax, %eax movl %eax, xy call color DUP_ movl $hp, %eax DUP_ movl $vp, %eax jmp box top: movl lm, %ecx shll $16, %ecx addl $3, %ecx movl %ecx, xy movl %ecx, xycr ret qcr: movw xy + 2, %cx cmpw rm, %cx js 0f cr: movl lm, %ecx shll $16, %ecx movw xy, %cx addl $ih, %ecx movl %ecx, xy 0: ret lms: movl %eax, lm DROP ret rms: movl %eax, rm DROP ret at: movw %ax, xy DROP movw %ax, xy + 2 DROP ret pat: addw %ax, xy DROP addw %ax, xy + 2 DROP ret #cl1: xor EAX, EAX # mov [ESI], EAX # ret #clip: movsx EDX, word ptr xy # cmp EDX, vp # jns cl1 # add EAX, EDX # js cl1 # test EDX, EDX # jns @f # xor EDX, EDX #@@: cmp EAX, vp # js @f # mov EAX, vp #@@: sub EAX, EDX # mov word ptr xy, DX # movsx EDX, word ptr xy+2 # cmp EDX, hp # jns cl1 # add [ESI], EDX # js cl1 # test EDX, EDX # jns @f # xor EDX, EDX #@@: cmp dword ptr [ESI], hp # js @f # mov dword ptr [ESI], hp #@@: sub [ESI], EDX # mov word ptr xy+2, DX # ret octant: DUP_ movl $0x43, %eax# poly -last y+ x+ ;23h ; last y+ x+ movl 4(%esi), %edx testl %edx, %edx jns 0f negl %edx movl %edx, 4(%esi) xorb $1, %al 0: cmpl (%esi), %edx jns 0f xorb $4, %al 0: ret # Keyboard eight: addl $12, %edi call four call space subl $16, %edi four: movl $4, %ecx four1: pushl %ecx DUP_ xorl %eax, %eax movb 4(%edi), %al incl %edi call emit popl %ecx next four1 ret stack: movl $godd - 4, %edi 0: movl god, %edx cmpl %edi, (%edx) jnc 0f DUP_ movl (%edi), %eax subl $4, %edi call qdot jmp 0b 0: ret keyboard: call text1 movl board, %edi DUP_ movl keyc, %eax call color movl $hc * iw, rm movl $hp - 9 * iw + 3, lm movl $(hp - 9 * iw + 3) * 0x10000 + vp - 4 * ih + 3, xy call eight call eight call eight call cr addl $4 * iw * 0x10000, xy movl shift, %edi addl $4 * 4 - 4, %edi movl $3, %ecx call four1 movl $3, lm movw $3, xy + 2 call stack movw $hp - (11 + 9) * iw + 3, xy + 2 lea history - 4, %edi movl $11, %ecx jmp four1 alpha: .byte 015, 012, 1, 014 .byte 024, 2, 6, 010 .byte 023, 011, 017, 021 .byte 022, 013, 016, 7 .byte 5, 3, 4, 026 .byte 027, 044, 025, 020 graphics: .byte 031, 032, 033, 0 .byte 034, 035, 036, 030 .byte 037, 040, 041, 057 .byte 051, 050, 052, 054# : ; ! @ .byte 046, 042, 045, 056# Z J . , .byte 055, 047, 053, 043# * / + - numbers:.byte 031, 032, 033, 0 .byte 034, 035, 036, 030 .byte 037, 040, 041, 0 .byte 0, 0, 0, 0 .byte 0, 0, 0, 0 .byte 0, 0, 0, 0 octals: .byte 031, 032, 033, 0 .byte 034, 035, 036, 030 .byte 037, 040, 041, 0 .byte 0, 5, 023, 012 .byte 0, 020, 4, 016 .byte 0, 0, 0, 0 letter: cmpb $4, %al js 0f movl board, %edx movb (%edx, %eax), %al 0: ret keys: .byte 16, 17, 18, 19, 0, 0, 4, 5# 20 .byte 6, 7, 0, 0, 0, 0, 20, 21 .byte 22, 23, 0, 0, 8, 9, 10, 11# 40 .byte 0, 0, 0, 0, 24, 25, 26, 27 .byte 0, 1, 12, 13, 14, 15, 0, 0# 60 N .byte 3, 2# alt space key: DUP_ xorl %eax, %eax 0: call pause inb $0144, %al testb $1, %al jz 0b inb $0140, %al testb $0360, %al # 0xf0 jz 0b cmpb $072, %al # 3a jnc 0b movb (keys - 020)(%eax), %al # keys - 16 ret .balign 4 graph0: .int nul0, nul0, nul0, alph0 .byte 0, 0, 5, 0# a graph1: .int word0, x, lj, alph .byte 025, 045, 5, 0# x . a alpha0: .int nul0, nul0, number, star0 .byte 0, 041, 055, 0# 9 * alpha1: .int word0, x, lj, graph .byte 025, 045, 055, 0# x . * numb0: .int nul0, minus, alphn, octal .byte 043, 5, 016, 0# - a f numb1: .int number0, xn, endn, number0 .byte 025, 045, 0, 0# x . board: .int alpha - 4 shift: .int alpha0 base: .int 10 current:.int decimal keyc: .int yellow chars: .int 1 aword: .int ex1 anumber:.int nul words: .int 1 nul0: DROP jmp 0f accept: acceptn:movl $alpha0, shift lea alpha - 4, %edi accept1:movl %edi, board 0: call key cmpb $4, %al jns first movl shift, %edx jmpl *(%edx, %eax, 4) bits: .byte 28 0: addl $0120, %eax movb $7, %cl jmp 0f pack: cmpb $020, %al jnc 0b movb $4, %cl testb $010, %al jz 0f incl %ecx xorb $030, %al 0: movl %eax, %edx movb %cl, %ch 0: cmpb %cl, bits jnc 0f shrb $1, %al jc full decb %cl jmp 0b 0: shll %cl, (%esi) xorl %eax, (%esi) subb %cl, bits ret lj0: movb bits, %cl addb $4, %cl shll %cl, (%esi) ret lj: call lj0 DROP ret full: call lj0 incl words movb $28, bits subb %ch, bits movl %edx, %eax DUP_ ret x: call right movl words, %eax leal (%esi, %eax, 4), %esi DROP jmp accept word_: call right movl $1, words movl $1, chars DUP_ movl $0, (%esi) movb $28, bits word1: call letter jns 0f movl shift, %edx jmpl *(%edx, %eax, 4) 0: testb %al, %al jz word0 DUP_ call echo_ call pack incl chars word0: DROP call key jmp word1 decimal: movl $10, base movl $numb0, shift movl $numbers - 4, board ret hex: movl $16, base movl $numb0, shift# oct0 movl $octals - 4, board ret octal: xorl $(decimal - start) ^ (hex - start), current xorb $041 ^ 016, numb0 + 18# f vs 9 calll *current jmp number0 xn: DROP DROP jmp acceptn # db 0, 0, 0, 0 digit: .byte 14, 10, 0, 0 .byte 0, 0, 12, 0, 0, 0, 15, 0 .byte 13, 0, 0, 11, 0, 0, 0, 0 .byte 0, 1, 2, 3, 4, 5, 6, 7 .byte 8, 9 sign: .byte 0 minus:# mov AL, 43o ; - movb %al, sign jmp number2 number0:DROP jmp number3 number: calll *current movb $0, sign xorl %eax, %eax number3:call key call letter jns 0f movl shift, %edx jmpl *(%edx, %eax, 4) 0: testb %al, %al jz number0 movb (digit - 4)(%eax), %al testb $037, sign jz 0f negl %eax 0: movl (%esi), %edx imull base, %edx addl %eax, %edx 0: movl %edx, (%esi) number2:DROP movl $numb1, shift jmp number3 endn: DROP calll *anumber(, 1) jmp acceptn alphn: DROP alph0: movl $alpha0, shift lea alpha - 4, %edi jmp 0f star0: movl $graph0, shift lea graphics - 4, %edi 0: DROP jmp accept1 alph: movl $alpha1, shift lea alpha - 4, %edi jmp 0f graph: movl $graph1, shift lea graphics - 4, %edi 0: movl %edi, board jmp word0 first: addl $4 * 4 + 4, shift call word_ calll *aword(, 1) jmp accept hicon: .byte 030, 031, 032, 033, 034, 035, 036, 037 .byte 040, 041, 5, 023, 012, 020, 4, 016 edig1: DUP_ edig: pushl %ecx movb hicon(%eax), %al call emit popl %ecx ret odig: roll $4, %eax DUP_ andl $0x0F, %eax ret hdotn: movl %eax, %edx negl %eax leal 32(, %eax, 4), %ecx DROP rol %cl, %eax movl %edx, %ecx jmp 0f hdot: movl $8, %ecx 0: call odig call edig next 0b DROP ret dot: movl $7, %ecx 0: call odig jnz _h DROP next 0b incl %ecx 0: call odig _h1: call edig next 0b call space DROP ret _h: incl %ecx jmp _h1 qdot: cmpl $10, base jnz dot dot10: movl %eax, %edx testl %edx, %edx jns 0f negl %edx DUP_ movl $043, %eax call emit 0: movl $8, %ecx 0: movl %edx, %eax xorl %edx, %edx divl tens(, %ecx, 4) testl %eax, %eax jnz d_1 decl %ecx jns 0b jmp d_2 0: movl %edx, %eax xorl %edx, %edx divl tens(, %ecx, 4) d_1: call edig1 decl %ecx jns 0b d_2: movl %edx, %eax call edig1 call space# spcr DROP ret unpack: DUP_ testl %eax, %eax js 0f shll $4, (%esi) roll $4, %eax andl $7, %eax ret 0: shll $1, %eax js 0f shll $5, (%esi) roll $4, %eax andl $7, %eax xorb $010, %al ret 0: shll $7, (%esi) roll $6, %eax andl $077, %eax subb $020, %al ret qring: DUP_ incl (%esi) cmpl %edi, curs# from abort, insert jnz 0f movl %eax, curs 0: cmpl curs, %eax jz ring jns 0f movl %edi, pcad 0: DROP ret ring: movl %edi, cad subl $iw * 0x10000, xy# bksp DUP_ movl $0x0e04000, %eax call color movl $060, %eax # 0x30 movw xy + 2, %cx cmpw rm, %cx js 0f call emit subl $iw * 0x10000, xy# bksp ret 0: jmp emit rw: movw xy + 2, %cx cmpw lm, %cx jz 0f call cr 0: call red jmp type_ gw: call green jmp type_ mw: call cyan jmp type_ ww: DUP_ movl $yellow, %eax call color jmp type_ type0: subl $iw * 0x10000, xy# call bspcr testl $-020, -4(, %edi, 4) jnz type1 decl %edi movl %edi, lcad call space call qring popl %edx# End of block DROP jmp keyboard cap: call white DUP_ movl -4(, %edi, 4), %eax andl $-020, %eax call unpack addb $48, %al call emit jmp type2 caps: call white DUP_ movl -4(, %edi, 4), %eax andl $-020, %eax 0: call unpack jz 0f addb $48, %al call emit jmp 0b text: call white type_: type1: DUP_ movl -4(, %edi, 4), %eax andl $-020, %eax type2: call unpack jz 0f call emit jmp type2 0: call space DROP DROP ret gsw: movl -4(, %edi, 4), %edx sarl $5, %edx jmp gnw1 var: call magenta call type_ gnw: movl (, %edi, 4), %edx incl %edi gnw1: DUP_ movl $0x0f800, %eax# Green cmpl $dot10, bas jz 0f movl $0x0c000, %eax# dark green jmp 0f sw: movl -4(, %edi, 4), %edx sarl $5, %edx jmp nw1 nw: movl (, %edi, 4), %edx incl %edi nw1: DUP_ movl $yellow, %eax cmpl $dot10, bas jz 0f movl $0x0c0c000, %eax# dark yellow 0: call color DUP_ movl %edx, %eax jmpl *bas(, 1) refresh:call show call blank call text1 DUP_ # Counter movl lcad, %eax movl %eax, cad# for curs beyond end xorl %eax, %eax movl blk, %edi shll $10 - 2, %edi movl %edi, pcad# for curs=0 ref1: testl $0x0f, (, %edi, 4) jz 0f call qring 0: movl (, %edi, 4), %edx incl %edi movl $dot10, bas testb $020, %dl jz 0f movl $dot, bas 0: andl $017, %edx calll *display(, %edx, 4) jmp ref1 .balign 4 display:.int type0, ww, nw, rw .int gw, gnw, gsw, mw .int sw, text, cap, caps .int var, nul, nul, nul tens: .int 10, 100, 1000, 10000, 100000, 1000000 .int 10000000, 100000000, 1000000000 bas: .int dot10 blk: .int 18 curs: .int 0 cad: .int 0 pcad: .int 0 lcad: .int 0 trash: .int buffer * 4 ekeys: .int nul, del, eout, destack .int act1, act3, act4, shadow .int mcur, mmcur, ppcur, pcur .int mblk, actv, act7, pblk .int nul, act11, act10, act9 .int nul, nul, nul, nul ekbd0: .int nul, nul, nul, nul .byte 025, 045, 7, 0# x . i ekbd: .byte 017, 1, 015, 055# w r g * .byte 014, 026, 020, 1# l u d r .byte 043, 011, 012, 053# - m c + .byte 0, 070, 072, 2# S C t .byte 0, 0, 0, 0 .byte 0, 0, 0, 0 actc: .int yellow, 0, 0x0ff0000, 0x0c000, 0, 0, 0x0ffff .int 0, 0x0ffffff, 0x0ffffff, 0x0ffffff, 0x8080ff vector: .int 0 action: .byte 1 act1: movb $1, %al jmp 0f act3: movb $3, %al jmp 0f act4: movb $4, %al jmp 0f act9: movb $9, %al jmp 0f act10: movb $10, %al jmp 0f act11: movb $11, %al jmp 0f act7: movb $7, %al 0: movb %al, action movl (actc - 4)(, %eax, 4), %eax movl $insert, aword actn: movl %eax, keyc popl %eax DROP jmp accept actv: movb $12, action movl $0x0ff00ff, %eax# Magenta movl $0f, aword jmp actn 0: DUP_ xorl %eax, %eax incl words jmp insert mcur: decl curs jns 0f pcur: incl curs 0: ret mmcur: subl $8, curs jns 0f movl $0, curs 0: ret ppcur: addl $8, curs ret pblk: addl $2, blk addl $2, (%esi) ret mblk: cmpl $20, blk js 0f subl $2, blk subl $2, (%esi) 0: ret shadow: xorl $1, blk xorl $1, (%esi) ret e0: DROP jmp 0f edit: movl %eax, blk DROP e: DUP_ movl blk, %eax movl $format, anumber movb $045, alpha0 + 4 * 4# . movl $e0, alpha0 + 4 call refresh 0: movl $ekbd0, shift movl $ekbd - 4, board movl $yellow, keyc 0: call key calll *ekeys(, %eax, 4) DROP jmp 0b eout: popl %eax DROP DROP movl $ex1, aword movl $nul, anumber movb $0, alpha0 + 4 * 4 movl $nul0, alpha0 + 4 movl $yellow, keyc jmp accept destack:movl trash, %edx cmpl $buffer * 4, %edx jnz 0f ret 0: subl $2 * 4, %edx movl (1 * 4)(%edx), %ecx movl %ecx, words 0: DUP_ movl (%edx), %eax subl $1 * 4, %edx next 0b addl $1 * 4, %edx movl %edx, trash insert0:movl lcad, %ecx# room available? addl words, %ecx xorl lcad, %ecx andl $-0x100, %ecx jz insert1 movl words, %ecx# no 0: DROP next 0b ret insert1: pushl %esi movl lcad, %esi movl %esi, %ecx decl %esi movl %esi, %edi addl words, %edi shll $2, %edi subl cad, %ecx js 0f shll $2, %esi std rep movsl cld 0: popl %esi shrl $2, %edi incl %edi movl %edi, curs# like abort movl words, %ecx 0: decl %edi movl %eax, (, %edi, 4) DROP # requires cld next 0b ret insert: call insert0 movb action, %cl xorb %cl, (, %edi, 4) jmp accept format: testb $012, action# ignore 3 and 9 jz 0f DROP ret 0: movl %eax, %edx andl $0x0FC000000, %edx jz 0f cmpl $0x0FC000000, %edx jnz format2 0: shll $5, %eax xorb $2, %al# 6 cmpb $4, action jz 0f xorb $013, %al# 8 0: cmpl $10, base jz 0f xorb $020, %al 0: movl $1, words jmp insert format2:DUP_ movl $1, %eax# 5 cmpb $4, action jz 0f movb $3, %al# 2 0: cmpl $10, base jz 0f xorb $020, %al 0: xchgl (%esi), %eax movl $2, words jmp insert del: call enstack movl pcad, %edi movl lcad, %ecx subl %edi, %ecx shll $2, %edi pushl %esi movl cad, %esi shll $2, %esi rep movsl popl %esi jmp mcur enstack:DUP_ movl cad, %eax subl pcad, %eax jz ens movl %eax, %ecx xchgl %edx, %eax pushl %esi movl cad, %esi leal -4(, %esi, 4), %esi movl trash, %edi 0: std lodsl cld stosl next 0b xchgl %edx, %eax stosl movl %edi, trash popl %esi ens: DROP ret pad: popl %edx movl %edx, vector addl $28 * 5, %edx movl %edx, board subl $4 * 4, %edx movl %edx, shift 0: call key movl vector, %edx addl %eax, %edx leal 5(%edx, %eax, 4), %edx addl -4(%edx), %edx DROP calll *%edx jmp 0b .org (0x1200 - 1) * 4 .int 0