Disassembly of Jupiter Ace ROM [German text]
|
Click here to go back to the English Version
;****************************************************************
;* ACE.MAC *
;* ROM DES JUPITER ACE *
;* =================== *
;* *
;* 23.09.96 BODO WENZEL DISASSEMBLIERT UND KOMMENTIERT *
;****************************************************************
;================================================================
; KONSTANTEN
;ZEICHENCODES
KLT EQU 001H ;PFEIL LINKS
LOK EQU 002H ;CAPS LOCK
KRT EQU 003H ;PFEIL RECHTS
GFX EQU 004H ;GRAFIK
CDL EQU 005H ;ZEICHEN LOESCHEN
KUP EQU 007H ;PFEIL AUF
INV EQU 008H ;INVERTIERT
KDN EQU 009H ;PFEIL AB
LDL EQU 00AH ;ZEILE LOESCHEN
CCR EQU 00DH ;ZEILENENDE
PND EQU 060H ;PFUND STERLING
CPR EQU 07FH ;COPYRIGHT
CINV EQU 080H ;INVERTIERUNG
CLAST EQU 080H ;LETZTES ZEICHEN EINES STRINGS
IMM EQU 040H ;WORT IST "IMMEDIATE"
SAFETY EQU 12 ;SICHERHEITSABSTAND FUER PARAMETER-STACK
FSIGN EQU 080H ;FLOAT-VORZEICHEN
FEOFFS EQU 040H ;FLOAT-EXPONENT-OFFSET
;================================================================
; EIN- UND AUSGABE, NUR A0 AUSDEKODIERT
IO EQU 0FEH ;IN LOESCHT TON-FF
;D0..4 TASTATUR-SPALTEN
; (ZEILEN IN A15..A8)
;D5 CASSETTE (EAR, EINGABE)
;OUT SETZT TON-FF
;D3 CASSETTE (MIC, AUSGABE)
;================================================================
; BILDSPEICHER (1 KBYTE)
;
; ZEILEN: 24 + 4/7 + 1 + 4/7 (60/50 HZ)
; ZEICHEN: 32 + 8 + 4 + 8
; BILD + VOR + SYNC + NACH
SCREEN EQU 02400H ;24 ZEILEN MIT 32 ZEICHEN
SCREND EQU SCREEN+24*32
PADMEM EQU 02701H ;FREIER ZWISCHENSPEICHER
FPADMEM EQU PADMEM AND NOT 00400H ;OHNE WAIT
SCRMEND EQU 02800H ;ENDE
;================================================================
; ZEICHENSATZ (1 KBYTE)
CHRSET EQU 02C00H ;128 ZEICHEN MIT 8 BYTES
;================================================================
; ARBEITSSPEICHER (AB 1 KBYTE)
MEMBEG EQU 03C00H ;ERSTE MOEGLICHE RAM-ADRESSE
FPWS EQU 03C00H ;PLATZ FUER FLOAT-RECHNUNGEN
LISTWS EQU 03C13H
LPICNT EQU 03C13H ;LIST/EDIT WORTZAEHLER
LPIBUF EQU 03C14H ;LIST/EDIT EINRUECKUNG PUFFER
LPIACT EQU 03C15H ;LIST/EDIT EINRUECKUNG AKTUELL
LPLCNT EQU 03C16H ;LIST/EDIT ZEILENZAEHLER
RAMTOP EQU 03C18H ;ERSTE NICHT-EXISTENTE ADRESSE
HLD EQU 03C1AH ;ZEIGER WAEHREND "#"
SCRPOS EQU 03C1CH ;AUSGABE-FELD CURSOR
INSCRN EQU 03C1EH ;EINGABE-FELD ANFANG
CURSOR EQU 03C20H ;EINGABE-FELD CURSOR
ENDBUF EQU 03C22H ;EINGABE-FELD ENDE
RAMVAR EQU 03C24H ;AB HIER INITIALISIERT -----
LHALF EQU 03C24H ;AUSGABE-FELD ENDE
KEYCOD EQU 03C26H ;GEDRUECKTE TASTE
KEYCNT EQU 03C27H ;ZEITZAEHLER
STATIN EQU 03C28H ;0 EINGABE FREIGEGEBEN
;1 CAPS LOCK
;2 GRAFIK
;3 INVERSE
;5 "ENTER" EINGEGEBEN
EXWRCH EQU 03C29H ;ALTERNATIVE AUSGABE
FRAMES EQU 03C2BH ;ZAEHLT DIE VSYNCS
XCOORD EQU 03C2FH ;PLOT-KOORDINATEN
YCOORD EQU 03C30H ;
VCURRENT EQU 03C31H ;ZEIGER AKTUELLES DICTION.
VCONTEXT EQU 03C33H ;ZEIGER DURCHSUCHTES DICT.
VOCLNK EQU 03C35H ;ZEIGER AUF LETZTES DICT.
STKBOT EQU 03C37H ;ZEIGER AUF FREIEN SPEICHER
DICT EQU 03C39H ;ZEIGER IN DICTIONARY
SPARE EQU 03C3BH ;ZEIGER AUF WERTESTACK
ERRNO EQU 03C3DH ;FEHLERNUMMER
FLAGS EQU 03C3EH ;2 COMPILE-MODE
;3 EDIT-BETRIEB
;4 EINGABE UNSICHTBAR
;6 COMPILER ("[","]")
VBASE EQU 03C3FH ;ZAHLENSYSTEM
DICT1ST EQU 03C40H ;DICTIONARY "FORTH"
;================================================================
; STRUKTUREN:
;
; DICTIONARY:
; DB... NAME IN ASCII, LETZTES ZEICHEN HAT BIT 7 = 1
; DW LINK ZU VORHERIGEM DICTIONARY
; DW LETZTE ADRESSE
; DB NAMENSLAENGE
; DW,DW FORTHWORTE ZUR UMSCHALTUNG
; DB IMMER 0
; DW ERSTE ADRESSE
;
; ROM-WORTE:
; DB... NAME IN ASCII, LETZTES ZEICHEN HAT BIT 7 = 1
; DW LINK ZU VORHERIGEM WORT
; DB NAMENSLAENGE
; DW ERSTE CODE-ADRESSE
; ... WEITERE DATEN
;
; RAM-WORTE:
; DB... NAME IN ASCII, LETZTES ZEICHEN HAT BIT 7 = 1
; DW ANZAHL BYTES BIS ZUM ENDE DES WORTES
; DW LINK ZU VORHERIGEM WORT
; DB NAMENSLAENGE (BIT 6 = "IMMEDIATE")
; DW ERSTE CODE-ADRESSE
; ... WEITERE DATEN
;
; FLOATS:
; 3 BYTES MANTISSE BCD
; 1 BYTE EXPONENT, OFFSET 40H, BIT 7=VORZEICHEN
;
;================================================================
; FEHLERNUMMERN
ERRNONE EQU -1 ;KEIN FEHLER
ERRMEM EQU 1 ;SPEICHER VOLL
ERRSTK EQU 2 ;STACK-UNTERLAUF (ZUVIELE DROP'S)
ERRBRK EQU 3 ;UNTERBRECHUNG DURCH BENUTZER
ERRIMM EQU 4 ;IMMEDIATE-WORT IM INTERPRETER-MODE
ERRBLK EQU 5 ;BLOCK-FEHLER (Z. B. "IF" - "ENDIF")
ERRNAME EQU 6 ;NAME ZU LANG BEI "CRHEADER"
ERRPICK EQU 7 ;FALSCHER STACKOFFSET Z. B. BEI "PICK"
ERRFLT EQU 8 ;FLOAT-UEBERLAUF
ERRAT EQU 9 ;FEHLER BEI "AT"
ERRREAD EQU 10 ;FEHLER BEI "?READ" ODER "?VERIFY"
ERRDICT EQU 11 ;F. MIT DICT. BEI "REDEFINE" & "FORGET"
ERRMODE EQU 12 ;COMPILE-MODE BEI "LINKHERE"
ERRFIND EQU 13 ;WORT NICHT GEFUNDEN
ERRLIST EQU 14 ;WORT NICHT LISTBAR BEI "LIST"
;================================================================
; RESET
ORG 00000H
DI ;KEINE INTERRUPTS
LD HL,MEMBEG
LD A,0FCH ;TESTWERT UND ADRESSMASKE
JR RMEMLP
;================================================================
; EIN ZEICHEN AUSGEBEN
ORG 00008H
RSTEMIT MACRO
RST 008H
ENDM
EXX
BIT 3,(IX+FLAGS-MEMBEG)
JP REMIT
;================================================================
; EINEN WERT IN DE AUF DEN PARAMETERSTACK SCHIEBEN
ORG 00010H
RSTPUSH MACRO
RST 010H
ENDM
CPUSH:
LD HL,(SPARE)
LD (HL),E
INC HL
JP RPUSH
;================================================================
; EINEN WERT VOM PARAMETERSTACK NACH DE HOLEN
ORG 00018H
RSTPULL MACRO
RST 018H
ENDM
CPULL:
LD HL,(SPARE)
DEC HL
LD D,(HL)
JP RPULL
;================================================================
; EINEN FEHLER MELDEN
ORG 00020H
RSTERR MACRO ERRNUM
RST 020H
DB ERRNUM
ENDM
POP HL
LD A,(HL)
LD (ERRNO),A ;FEHLERNUMMER HOLEN
JP RABORT
;================================================================
RMEMLP:
INC H
LD (HL),A
CP (HL)
JR Z,RMEMLP ;SPEICHER-ENDE SUCHEN
AND H
LD H,A ;NUR VOLLE KBYTE
LD (RAMTOP),HL ;ENDE MERKEN
LD SP,HL ;STACKPOINTER SETZEN
LD HL,ROMVAR
JR RGOON
;================================================================
; VSYNC-INTERRUPT
ORG 00038H
JP VSYNC
;================================================================
RGOON:
LD DE,RAMVAR
LD BC,ROMVEND-ROMVAR
LDIR ;VARIABLEN VORBESETZEN
LD IX,MEMBEG
LD IY,RSLNEXT ;ZEIGER SETZEN
CALL CCLS
XOR A
LD (SCREEN+24*32),A ;BILD-ENDE MARKIEREN
;----------------------------------------------------------------
LD HL,CHRSET
RGFXLP:
LD A,L
AND 0BFH ;4 SAETZE BLOCKGRAFIK
RRCA
RRCA ;XX0000XX 00
RRCA ;XX0001XX 00
JR NC,RGFXM ;XX0010XX 0F
RRCA ;XX0011XX 00
RRCA ;XX0100XX F0
RGFXM: ;XX0101XX 00
RRCA ;XX0110XX FF
LD B,A ;XX0111XX 00
SBC A,A ;XX1000XX 00
RR B ;XX1001XX 0F
LD B,A ;XX1010XX 0F
SBC A,A ;XX1011XX 0F
XOR B ;XX1100XX F0
AND 0F0H ;XX1101XX 0F
XOR B ;XX1110XX FF
LD (HL),A ;XX1111XX 0F
INC L
JR NZ,RGFXLP ;NOCH NICHT ALLE GRAFIKZEICHEN ?
LD DE,CHRSET+128*8-1
LD HL,ROMCHR-1
LD BC,8 ;8 ZEILEN
LDDR ;COPYRIGHT-ZEICHEN
EX DE,HL
LD A,128-020H-1 ;ANZAHL RESTLICHE ZEICHEN
RCHRLP:
LD C,7 ;7 ZEILEN
BIT 5,A
JR Z,RCHR7 ;ZEICHEN MIT 7 ZEILEN ?
LD (HL),B
DEC HL
DEC C ;UNTERE ZEILE HINTERGRUND
RCHR7:
EX DE,HL
LDDR ;ZEICHEN KOPIEREN
EX DE,HL
LD (HL),B
DEC HL ;OBERE ZEILE HINTERGRUND
DEC A
JR NZ,RCHRLP ;NOCH NICHT ALLE ZEICHEN ?
IM 1 ;VSYNC AUF RST 38H
JR RQUIT
;================================================================
DB 'QUI','T' OR CLAST
DW 0
DB 4
QUIT:
DW $+2
RQUIT:
LD SP,(RAMTOP) ;STACKPOINTER ZURUECKSETZEN
EI ;INTERRUPTS FREIGEBEN
JP QUITLOOP ;AUF GEHT'S
;================================================================
DB 'ABOR','T' OR CLAST
DW QUIT-1
DB 5
ABORT:
DW $+2
RABORT:
PUSH IY
LD IY,NEXT ;NORMALE FEHLERPRUEFUNG
LD HL,(STKBOT)
LD (SPARE),HL ;DATENSTACK ZURUECKSETZEN
LD HL,FLAGS
LD A,(HL)
AND NOT ((1 SHL 6) OR (1 SHL 3) OR (1 SHL 2))
BIT 2,(HL)
LD (HL),A ;COMPILER UND EDITOR AUS
JR Z,ABGOON ;KEIN COMPILER-MODE ?
CALL NEXT
DW DP,AT,GETBYTE
DB 5
DW PLUS,DUP,RESCURR ;CURRENT ZURUECKSETZEN
DW NFA,GETWORD,STKBOT
DW EXCLAM ;STACK ZURUECKSETZEN
DW SEMICODE
ABGOON:
BIT 7,(IX+ERRNO-MEMBEG)
JR NZ,ABORTEND ;KEIN FEHLER GESPEICHERT ?
CALL ROMTXT
DB 'ERRO','R' OR CLAST
CALL NEXT
DW GETWORD,ERRNO,CAT,PNT,CR
DW SEMICODE ;FEHLER MELDEN
LD (IX+ERRNO-MEMBEG),ERRNONE ;KEIN FEHLER MEHR
ABORTEND:
LD HL,(STKBOT)
LD BC,SAFETY
ADD HL,BC
LD (SPARE),HL
POP IY
JR RQUIT
;================================================================
ROMVAR:
DW SCREEN+23*32 ;LHALF
DB 0,0 ;KEYCOD
DB 0 ;STATIN
DW 0 ;EXWRCH
DB 0,0,0,0 ;FRAMES
DB 0,0 ;XCOORD/YCOORD
DW FORTH+2+RAMVAR-ROMVAR ;VCURRENT
DW FORTH+2+RAMVAR-ROMVAR ;VCONTEXT
DW FORTH+5+RAMVAR-ROMVAR ;VOCLNK
DW FREEMEM ;STKBOT
DW FORTH-5+RAMVAR-ROMVAR ;DICT
DW FREEMEM+SAFETY ;SPARE
DB -1 ;ERRNO
DB 0 ;FLAGS
DB 10 ;VBASE
DB 'FORT','H' OR CLAST ;DICT1ST
DW 0000H,1FFFH
DB 5
FORTH:
DW SETCONTEXT
DW FORTH-1+RAMVAR-ROMVAR ;FORTH IST CONTEXT
DB 0
DW 0
ROMVEND:
FREEMEM EQU ROMVEND+RAMVAR-ROMVAR ;FREIER SPEICHER
;================================================================
VSYNC:
PUSH AF
EX AF,AF'
PUSH AF
PUSH BC
PUSH DE
PUSH HL ;REGISTER RETTEN
LD B,62
VDELAY:
DJNZ VDELAY ;ETWAS WARTEN (WARUM ???)
LD HL,FRAMES
VSCNT:
INC (HL)
INC HL
JR Z,VSCNT ;VSYNC-ZAEHLER ERHOEHEN
CALL VKEY ;TASTE MIT AUTOREPEAT HOLEN
LD HL,STATIN
BIT 0,(HL)
JR Z,VSEND ;EINGABE GESPERRT ?
AND A
JR Z,VSEND ;KEINE TASTE ?
CP ' '
JR C,VSCTRL ;STEUERZEICHEN ?
BIT 1,(HL)
CALL NZ,TOUPPER ;"CAPS LOCK" ?
BIT 2,(HL)
JR Z,VSNOGRF
AND 09FH ;"GRAPHICS" ?
VSNOGRF:
BIT 3,(HL)
JR Z,VSNOINV
OR CINV ;"INVERSE" ?
VSNOINV:
CALL DCDCNORM ;ANZEIGBARES ZEICHEN
VSCTRL:
CALL DOCTRL ;STEUERZEICHEN
CALL DCSETCUR ;CURSOR SETZEN
VSEND:
POP HL
POP DE
POP BC
POP AF
EX AF,AF'
POP AF ;REGISTER HOLEN
EI ;INTERRUPTS WIEDER FREIGEBEN
RET ;(WARUM NICHT "RETI" ???)
;================================================================
DCDOCHAR:
CP CCR
JR NZ,DCDCNORM ;NICHT "ENTER" ?
LD HL,SCREEN+24*32
LD (ENDBUF),HL
LD (CURSOR),HL ;EINGABE-ZEIGER ANS BILD-ENDE
XOR A
CALL DCDCINS ;NEUES EINGABE-ENDE SETZEN
LD HL,SCREEN+23*32
LD (INSCRN),HL ;EINE ZEILE EINGABE
RET
DCDCNORM:
AND A
RET Z ;KEINE TASTE ?
DCDCINS:
EX AF,AF' ;ZEICHEN MERKEN
LD HL,(ENDBUF)
LD A,(HL)
AND A
JR Z,DCDCSCROL
LD DE,-(SCREEN+24*32)
ADD HL,DE
JR NC,DCDCEND ;EINGABE-ENDE VOR BILD-ENDE ?
DCDCSCROL:
LD DE,(LHALF)
LD HL,-(SCREEN+3*32)
ADD HL,DE
JR NC,DCDCQUIT ;AUSG.-ENDE IN ERSTEN 3 ZEILEN ?
LD HL,(SCRPOS)
LD BC,32
ADD HL,BC
SBC HL,DE
PUSH DE
CALL NC,SCROLLUP ;AUSG.-CURSOR IN LETZTER ZEILE ?
CALL DCSTREND
POP DE
CALL INSLINE ;EINGABE HOCHSCHIEBEN
LD HL,INSCRN
LD B,4 ;4-MAL ???
DCDCSLOOP:
CALL DECLINE
DJNZ DCDCSLOOP ;EINGABE-ANFANG HOCHSCHIEBEN
DCDCEND:
CALL DCGETCIN
LD D,H
LD E,L
INC HL
LD (ENDBUF),HL ;EINGABE-ENDE WEITERSCHIEBEN
DEC HL
DEC HL
JR Z,DCDCSTORE ;EINGABE-CURSOR AM ENDE ?
LDDR ;RESTLICHE EINGABE WEITERSCHIEBEN
DCDCSTORE:
EX AF,AF'
LD (DE),A ;ZEICHEN SPEICHERN
INC DE
LD (CURSOR),DE ;NEUE EINGABE-ADRESSE MERKEN
DCDCQUIT:
XOR A ;Z-FLAG SETZEN, KEIN ZEICHEN MEHR
RET
;================================================================
DOCTRL:
LD HL,DCJMPTAB
LD D,0
LD E,A
ADD HL,DE ;ZEIGER AUF TABELLEN-EINTRAG
LD E,(HL)
ADD HL,DE
JP (HL) ;ADRESSE ANSPRINGEN
DCJMPTAB:
DB DCNOP-$ ;0 (KEINE TASTE)
DB DCLEFT-$ ;1 PFEIL LINKS
DB DCFLAG-$ ;2 CAPS LOCK
DB DCRIGHT-$ ;3 PFEIL RECHTS
DB DCFLAG-$ ;4 GRAFIK
DB DCCHARDEL-$ ;5 ZEICHEN LOESCHEN
DB DCNOP-$ ;6 (UNBENUTZT)
DB DCUP-$ ;7 PFEIL AUF
DB DCFLAG-$ ;8 INVERTIERT
DB DCDOWN-$ ;9 PFEIL AB
DB DCLINEDEL-$ ;A ZEILE LOESCHEN
DB DCNOP-$ ;B (UNBENUTZT)
DB DCNOP-$ ;C (UNBENUTZT)
DB DCENTER-$ ;D ZEILENENDE
;----------------------------------------------------------------
DCFLAG:
LD HL,STATIN
XOR (HL)
LD (HL),A ;FLAG WECHSELN
RET
;----------------------------------------------------------------
DCLEFT:
LD HL,(CURSOR)
DEC HL
LD A,(HL)
AND A
RET Z ;AM EINGABE-ANFANG ?
LD (CURSOR),HL ;NEUE ADRESSE MERKEN
INC HL
LD (HL),A ;ZEICHEN UMSPEICHERN
DCNOP:
RET
;----------------------------------------------------------------
DCRIGHT:
LD HL,(CURSOR)
INC HL
LD DE,(ENDBUF)
AND A
SBC HL,DE
RET Z ;AM EINGABE-ENDE ?
ADD HL,DE
LD (CURSOR),HL ;NEUE ADRESSE MERKEN
LD A,(HL)
DEC HL
LD (HL),A ;ZEICHEN UMSPEICHERN
RET
;----------------------------------------------------------------
DCCURDEL:
LD HL,(CURSOR)
INC HL
LD (CURSOR),HL ;EINGABE-ADRESSE ERHOEHEN
DCCHARDEL:
CALL DCGETCIN
LD H,D
LD L,E
DEC DE
LD A,(DE)
AND A
RET Z ;AM EINGABE-ANFANG ?
LD (CURSOR),DE
LD A,B
OR C
JR Z,DCCDGOON ;AM EINGABE-ENDE ?
LDIR ;ZEICHEN LINKS LOESCHEN
DCCDGOON:
DEC HL
LD (HL),' ' ;LETZTES ZEICHEN LOESCHEN
LD (ENDBUF),HL ;(UEBERFLUESSIG ???)
INC C ;Z-FLAG LOESCHEN
RET
;----------------------------------------------------------------
DCUP:
CALL DCLEFT
JR Z,DCUSCROLL ;AM EINGABE-ANFANG ?
LD B,31
DCUPLOOP:
CALL DCLEFT
DJNZ DCUPLOOP ;MAXIMAL EINE ZEILE ZURUECK
RET
DCUSCROLL:
LD HL,(INSCRN)
LD DE,(LHALF)
AND A
SBC HL,DE
RET Z ;EINGABE-ANFANG AM AUSGABE-ENDE ?
CALL DCCURDEL
LD HL,(INSCRN)
LD DE,-32
XOR A
DCUSLOOP:
ADD HL,DE
CP (HL)
JR NZ,DCUSLOOP ;NAECHSTE MARKE SUCHEN
LD (INSCRN),HL
CALL DCSETEND
LD (CURSOR),HL ;NEUES EINGABE-ENDE SETZEN
;----------------------------------------------------------------
DCOUTCUR:
LD A,' ' OR CINV
CALL DCDOCHAR ;CURSOR-ZEICHEN AUSGEBEN
LD HL,(CURSOR)
DEC HL
LD (CURSOR),HL ;ADRESSE KORRIGIEREN
DCSETCUR:
LD HL,(CURSOR)
LD A,(STATIN)
RRA
LD (HL),017H OR CINV ;"NORMAL"
RRA
JR NC,SCNOCAPS
LD (HL),'C' OR CINV ;"CAPS LOCK"
SCNOCAPS:
RRA
RET NC
LD (HL),'G' OR CINV ;"GRAFIK"
RET
;----------------------------------------------------------------
DCDOWN:
CALL DCRIGHT
JR Z,DCDSCROLL ;AM EINGABE-ENDE ?
LD B,31
DCDNLOOP:
CALL DCRIGHT
DJNZ DCDNLOOP ;MAXIMAL EINE ZEILE VOR
RET
DCDSCROLL:
CALL DCSTREND
RET PO ;ENDE GEFUNDEN ?
PUSH HL
CALL DCCURDEL
POP HL
CALL DCSETBEG ;NEUEN EINGABE-ANFANG SETZEN
JR DCOUTCUR
;----------------------------------------------------------------
DCSTREND:
LD HL,SCREEN+24*32
LD DE,(INSCRN)
AND A
SBC HL,DE
LD B,H
LD C,L ;ANZAHL BERECHNEN
EX DE,HL
INC HL ;ZEIGER HINTER ANFANG
XOR A
CPIR ;NACH TEXTENDE SUCHEN
DEC HL ;ZEIGER KORRIGIEREN
RET
;----------------------------------------------------------------
DCLINEDEL:
LD HL,(ENDBUF)
DEC HL
LD (CURSOR),HL ;ZEIGER AUF EINGABE-ENDE
DCLDLOOP:
CALL DCCHARDEL
JR NZ,DCLDLOOP ;BIS ZUM ANFANG LOESCHEN
RET
;----------------------------------------------------------------
DCENTER:
LD HL,STATIN
SET 5,(HL) ;"ENTER" EINGEGEBEN
RES 0,(HL) ;EINGABE SPERREN
RET
;----------------------------------------------------------------
DCCLEAR:
LD HL,SCREEN+24*32
LD DE,(LHALF)
CALL BLANKS ;EINGABE-FELD LOESCHEN
LD HL,SCREEN+23*32
LD (LHALF),HL
LD (HL),0 ;EINGABE-ANFANG MARKIEREN
DCRETYPE:
LD HL,(LHALF)
DCSETBEG:
LD (INSCRN),HL ;EINGABE-ANFANG SETZEN
INC HL
LD (CURSOR),HL ;DAHINTER AKTUELLE ADRESSE
DCSETEND:
CALL DCSTREND
LD A,' '
DCSELOOP:
DEC HL
CP (HL)
JR Z,DCSELOOP ;EINGABE-STRINGENDE SUCHEN
INC HL
LD (ENDBUF),HL ;DORT EINGABE-ENDE SETZEN
RET
;----------------------------------------------------------------
DCGETCIN:
LD HL,(ENDBUF)
LD DE,(CURSOR)
AND A
SBC HL,DE
LD B,H
LD C,L ;ANZAHL BERECHNEN
ADD HL,DE ;ZEIGER WIEDER HERSTELLEN
RET
;----------------------------------------------------------------
VKEY:
CALL KEYGET
LD B,A ;GEDRUECKTE TASTE HOLEN
LD HL,(KEYCOD)
XOR L
JR Z,VKAGAIN ;GLEICHE TASTE NOCH GEDRUECKT ?
XOR L
JR Z,VKNEW ;KEINE TASTE GEDRUECKT ?
XOR A
CP L
RET NZ ;VORHER ANDERE TASTE GEDRUECKT ?
VKNEW:
LD L,B ;TASTE MERKEN
LD H,32 ;ZEITZAEHLER LADEN
JR VKQUIT
VKAGAIN:
DEC H ;ZEITZAEHLER ERNIEDRIGEN
LD A,H
CP 30
JR Z,VKPRESS ;TASTE ENTPRELLT ?
XOR A
CP H
JR NZ,VKQUIT ;AUTOREPEAT-ZEIT ERREICHT ?
LD H,4 ;ZEITZAEHLER ZURUECKSETZEN
VKPRESS:
LD A,L ;TASTE HOLEN
VKQUIT:
LD (KEYCOD),HL
RET
;----------------------------------------------------------------
KEYGET:
LD BC,IO OR (0FEH SHL 8) ;MASKE UND ADRESSE
IN D,(C) ;ZEILE MIT "SHIFT" UND "SYMBOL"
LD E,D ;MERKEN
SRL D
SBC A,A
AND -40 ;WENN KEIN "SHIFT", OFFSET
SRL D
JR C,KEYGNC ;KEIN "SYMBOL" ?
LD A,40 ;ANZAHL TASTEN
KEYGNC:
ADD A,2*40+7 ;NORMAL "SHIFT" "SYMBOL"
LD L,A ; 47 87 127
LD A,E
OR 3 ;ZEILE OHNE "SHIFT" UND "SYMBOL"
LD E,0FFH ;BISHER KEINE TASTE
KEYGLP:
CPL
AND 1FH
LD D,A ;TASTEN MASKIEREN
JR Z,KEYGNK ;KEINE TASTE GEDRUECKT ?
LD A,L
INC E
JR NZ,KEYGQU ;BEREITS TASTE GEDRUECKT ?
KEYGSC:
SUB 8 ;OFFSET KORRIGIEREN
SRL D
JR NC,KEYGSC ;TASTE NOCH NICHT GEFUNDEN ?
LD E,A ;OFFSET MERKEN
JR NZ,KEYGQU ;WEITERE TASTE GEDRUECKT ?
KEYGNK:
DEC L ;OFFSET KORRIGIEREN
RLC B
JR NC,KEYGQU2 ;TASTATUR FERTIG ?
IN A,(C) ;NAECHSTE ZEILE HOLEN
JR KEYGLP
KEYGQU:
LD E,-1 ;KEINE TASTE GEDRUECKT
KEYGQU2:
LD A,E
INC A
RET Z ;KEINE TASTE GEDRUECKT ?
LD HL,KEYTBL
ADD HL,DE
LD A,(HL) ;TASTENCODE HOLEN
RET
KEYTBL:
DB 'v','h','y','6','5','t','g','c' ;NORMAL
DB 'b','j','u','7','4','r','f','x'
DB 'n','k','i','8','3','e','d','z'
DB 'm','l','o','9','2','w','s',0
DB ' ',CCR,'p','0','1','q','a',0
DB 'V','H','Y',KUP,KLT,'T','G','C' ;MIT "SHIFT"
DB 'B','J','U',KDN,INV,'R','F','X'
DB 'N','K','I',KRT,'3','E','D','Z'
DB 'M','L','O',GFX,LOK,'W','S',0
DB ' ',CCR,'P',CDL,LDL,'Q','A',0
DB '/','^','[','&','%','>','}','?' ;MIT "SYMBOL"
DB '*','-',']','''','$','<','{',PND
DB ',','+',CPR,'(','#','E','\',':'
DB '.','=',';',')','@','W','|',0
DB ' ',CCR,'"','_','!','Q','~',0
;================================================================
REMIT:
JR Z,RENORM ;KEIN "EDIT" ?
CALL DCDOCHAR
EXX
RET
RENORM:
LD B,A
LD HL,(EXWRCH)
LD A,H
OR L
LD A,B
JR Z,EMITSCR
JP (HL) ;AUSGABE-VEKTOR BENUTZEN ?
EMITSCR:
LD HL,(SCRPOS)
LD DE,(LHALF)
EX DE,HL
SCF
SBC HL,DE
EX DE,HL
CALL C,SCROLLUP ;BEI BEDARF EINE ZEILE SCROLLEN
CP CCR
JR Z,ESENTER ;"ENTER" ?
LD (HL),A ;ZEICHEN SPEICHERN
INC HL ;NAECHSTE ADRESSE
JR ESQUIT
ESENTER:
INC HL
LD A,L
AND 32-1
JR NZ,ESENTER ;ZEIGER AN NAECHSTEN ZEILENANFANG
ESQUIT:
LD (SCRPOS),HL ;CURSOR-ADRESSE SPEICHERN
EXX
RET
;----------------------------------------------------------------
SCROLLUP:
PUSH AF
LD HL,SCRPOS
CALL DECLINE ;CURSOR-ADRESSE ANPASSEN
POP AF
LD HL,(LHALF)
LD DE,SCREEN+32 ;AUSGABE-FELD HOCHSCHIEBEN
INSLINE:
AND A
SBC HL,DE
LD B,H
LD C,L ;ANZAHL ZEICHEN
LD HL,-32
ADD HL,DE
EX DE,HL
LDIR ;BILDSCHIRM HOCHSCHIEBEN
LD B,32
ILLOOP:
DEC HL
LD (HL),' '
DJNZ ILLOOP ;EINGEFUEGTE ZEILE LOESCHEN
RET
;----------------------------------------------------------------
DECLINE:
LD A,(HL)
SUB 32
LD (HL),A
INC HL
JR NC,DLEND
DEC (HL)
DLEND:
INC HL
RET
;================================================================
GETVAR:
EX DE,HL
LD E,(HL)
LD D,0 ;OFFSET HOLEN
LD HL,MEMBEG
ADD HL,DE
EX DE,HL
RSTPUSH ;ADRESSE AUF STACK
JP (IY)
;================================================================
DB 'HER','E' OR CLAST
DW ABORT-1
DB 4
HERE:
DW $+2
LD DE,(STKBOT)
RSTPUSH
JP (IY)
;================================================================
DB 'CONTEX','T' OR CLAST
DW HERE-1
DB 7
CONTEXT:
DW GETVAR
DB VCONTEXT-MEMBEG
;================================================================
DB 'CURREN','T' OR CLAST
DW CONTEXT-1
DB 7
CURRENT:
DW GETVAR
DB VCURRENT-MEMBEG
;================================================================
DB 'BAS','E' OR CLAST
DW CURRENT-1
DB 4
BASE:
DW GETVAR
DB VBASE-MEMBEG
;================================================================
GETFLAGS:
DW GETVAR
DB FLAGS-MEMBEG
;================================================================
DP:
DW GETVAR
DB DICT-MEMBEG
;================================================================
DB 'PA','D' OR CLAST
DW BASE-1
DB 3
PAD:
DW DOCONSTANT,PADMEM
;================================================================
NSEMICOLON:
DB ';' OR CLAST
DW PAD-1
DB 1 OR IMM
SEMICOLON:
DW DOCOMPILER,SEMIS
DW ASSERT
DB 10 ;PRUEFWERT TESTEN
DW SEMICODE
LD HL,FLAGS
LD A,(HL)
AND NOT ((1 SHL 6) OR (1 SHL 2))
LD (HL),A ;COMPILER AUSSCHALTEN
JP (IY)
;================================================================
DB 0
DW NSEMICOLON-$-1
SEMIS:
DW RSEMIS
RSEMIS:
POP HL ;AKTUELLEN ZEIGER WEGWERFEN
NEXT:
POP HL ;ZEIGER HOLEN
NEXTSUB:
LD E,(HL)
INC HL
LD D,(HL)
INC HL
PUSH HL ;NAECHSTE FORTH-ADRESSE HOLEN
NEXTDE:
EX DE,HL
LD E,(HL)
INC HL
LD D,(HL)
INC HL
EX DE,HL
JP (HL) ;MASCHINENCODE ANSPRINGEN
;================================================================
SLNEXT:
DW RSLNEXT
RSLNEXT:
LD BC,11
LD DE,(SPARE)
LD HL,(STKBOT)
ADD HL,BC
SBC HL,DE
JR C,RSLNGOON ;NOCH PLATZ ZWISCHEN STACKS ?
ERRORSTK:
RSTERR ERRSTK
RSLNGOON:
LD BC,0
CALL MEMCHECK
CALL USERBREAK
JR NEXT
;================================================================
USERBREAK:
LD A,0FEH
IN A,(IO) ;TASTENZEILE LESEN
RRA
RET C ;"SHIFT" NICHT GEDRUECKT ?
LD A,7FH
IN A,(IO) ;TASTENZEILE LESEN
RRA
RET C ;"BREAK" NICHT GEDRUECKT ?
BREAK:
RSTERR ERRBRK
;================================================================
QUITLOOP:
CALL NEXT
QLLOOP:
DW QUERY ;EINE ZEILE HOLEN
DW LINE ; UND BEARBEITEN
DW OK ; UND "OK" SENDEN
DW DOREPEAT,QLLOOP-$-1 ; FUER IMMER...
;================================================================
DB 'LIN','E' OR CLAST
DW SEMICOLON-1
DB 4
LINE:
DW DOCOL
LINELOOP:
DW SLNEXT ;ALLE PRUEFUNGEN
DW FIND,QDUP ;WORT SUCHEN
DW DOIF,LINENUM-$-1 ;NICHT GEFUNDEN ?
DW CHKIMM ;WORT BEARBEITEN
DW DOREPEAT,LINELOOP-$-1
LINENUM:
DW NUMBER,QDUP ;ZAHL SUCHEN
DW DOIF,LINESTR-$-1 ;NICHT GEFUNDEN ?
DW CHKNUMBER ;ZAHL BEARBEITEN
DW DOREPEAT,LINELOOP-$-1
LINESTR:
DW CHKSTRING,ZEROEQ ;TEXT SUCHEN
DW DOIF,LINEERR-$-1 ;NICHT GEFUNDEN ?
DW SEMIS
LINEERR:
DW RETYPE ;FEHLER MELDEN
DW DOREPEAT,LINELOOP-$-1
;================================================================
OK:
DW $+2
LD A,(FLAGS)
BIT 6,A
JR NZ,OKQUIT ;LAEUFT DER COMPILER NOCH ?
BIT 4,A
JR NZ,OKQUIT ;EINGABE UNSICHTBAR ?
CALL ROMTXT
DB ' OK',' ' OR CLAST
LD A,CCR
RSTEMIT
OKQUIT:
JP (IY)
;================================================================
CHKIMM:
DW $+2
RSTPULL ;CODE-FELD-ADRESSE
DEC DE
LD A,(DE)
CPL
AND (IX+FLAGS-MEMBEG)
AND 1 SHL 6
INC DE
JR Z,CHKIQUIT ;COMPILER AUS ODER IMMEDIATE ?
RSTPUSH
LD DE,KOMMA
CHKIQUIT:
JP NEXTDE
;----------------------------------------------------------------
CHKNUMBER:
DW $+2
RSTPULL
BIT 6,(IX+FLAGS-MEMBEG)
JR NZ,CHKIQUIT ;COMPILER AN ?
JP (IY)
;================================================================
DB 'RETYP','E' OR CLAST
DW QUERY-1
DB 6
RETYPE:
DW $+2
CALL DCRETYPE
CALL DCOUTCUR
LD (HL),'?' OR CINV ;CURSOR AENDERN
JR QSTART
;================================================================
DB 'QUER','Y' OR CLAST
DW LINE-1
DB 5
QUERY:
DW $+2
CALL DCCLEAR
CALL DCOUTCUR
QSTART:
LD HL,STATIN
SET 0,(HL) ;EINGABE FREIGEBEN
RES 5,(HL) ;BISHER KEIN "ENTER"
QLOOP:
BIT 5,(HL)
JR Z,QLOOP ;AUF "ENTER" WARTEN
CALL DCCURDEL
JP (IY)
;================================================================
DB 'WOR','D' OR CLAST
DW RETYPE-1
DB 4
WORD:
DW $+2
RSTPULL ;DELIMITER HOLEN
LD HL,SCRMEND-2
LD B,SCRMEND-SCREND-3
WCLLOOP:
LD (HL),' '
DEC HL
DJNZ WCLLOOP ;PUFFER LOESCHEN
PUSH DE
EX DE,HL
RSTPUSH
POP DE
CALL CWORD ;TEXT EINLESEN
INC B
DEC B
JR Z,WGOON1
LD BC,255 ;ANZAHL AUF 255 BEGRENZEN
WGOON1:
LD HL,PADMEM
LD (HL),C ;ANZAHL SPEICHERN
INC HL
LD A,252
CP C
JR NC,WGOON2
LD C,A ;ANZAHL BEGRENZEN
WGOON2:
INC C
PUSH DE
PUSH BC
EX DE,HL
LDIR ;EINGABE UMSPEICHERN
POP BC
POP DE
DEC C
CALL BLWORD ;EINGABE LOESCHEN
JP (IY)
;================================================================
GETSTRING:
LD E,' ' ;LEERZEICHEN ALS BEGRENZER
CWORD:
LD HL,(LHALF)
LD (INSCRN),HL
LD BC,0 ;BISHER KEIN ZEICHEN
CWLOOP1:
INC HL
LD A,(HL)
CP E
JR Z,CWLOOP1 ;ANFANG SUCHEN
AND A
JR Z,CWNFND
PUSH HL ;ANFANG MERKEN
CWLOOP2:
INC BC ;MITZAEHLEN
INC HL
LD A,(HL)
AND A
JR Z,CWEND ;TEXTENDE ?
CP E
JR NZ,CWLOOP2 ;ENDE SUCHEN
CWEND:
POP DE ;ANFANG HOLEN
XOR A
CP B
RET ;TEST AUF ANZAHL 256
CWNFND:
PUSH DE
CALL DCSTREND
JP PO,CWERR ;EINGABE-ENDE GEFUNDEN ?
LD DE,(LHALF)
CALL BLANKS ;EINGABE-FELD LOESCHEN
LD (LHALF),HL
POP DE
JR CWORD ;NAECHSTES WORT
CWERR:
EX DE,HL ;ZEIGER AUF ENDE (???)
POP BC
LD BC,0
SCF ;MISSERFOLG MELDEN
RET
;================================================================
CHKSTRING:
DW $+2
CALL GETSTRING
LD D,B
LD E,C
RSTPUSH
JP (IY)
;================================================================
DB 'VLIS','T' OR CLAST
DW WORD-1
DB 5
VLIST:
DW $+2
LD A,CCR
RSTEMIT
LD C,0 ;ALLE WORTE FINDEN
JR RFIND
;================================================================
DB 'FIN','D' OR CLAST
DW VLIST-1
DB 4
FIND:
DW $+2
CALL GETSTRING
JR C,RZERO ;KEIN WORT EINGEGEBEN ?
RFIND:
LD HL,(VCONTEXT)
LD A,(HL)
INC HL
LD H,(HL)
LD L,A ;ERSTEN ZEIGER HOLEN
FLOOP:
LD A,(HL)
AND 3FH
JR Z,FNEXT2 ;KEIN WORT MEHR ?
XOR C
JR Z,FTEST ;GLEICHE LAENGE ?
LD A,C
AND A
JR NZ,FNEXT2 ;EINZELNES WORT GESUCHT ?
FTEST:
PUSH DE
PUSH HL
CALL PTR2NAME
OR C
JR Z,FPRINT ;WORT SOFORT AUSGEBEN ?
LD B,C ;WORTLAENGE HOLEN
FCOMPARE:
LD A,(DE)
CALL TOUPPER
INC DE
XOR (HL)
AND NOT CLAST
INC HL
JR NZ,FNEXT1 ;WORT UNGLEICH ?
DJNZ FCOMPARE ;NOCH NICHT ALLE ZEICHEN ?
POP DE
INC DE
RSTPUSH ;ZEIGER AUF CODE-FELD
POP DE
CALL BLWORD ;EVTL. EINGABE LOESCHEN
JP (IY)
FPRINT:
CALL OUTTXT
HALT ;VSYNC ABWARTEN
CALL USERBREAK
FNEXT1:
POP HL
POP DE
FNEXT2:
DEC HL
LD A,(HL)
DEC HL
LD L,(HL)
LD H,A ;NAECHSTER ZEIGER
OR L
JR NZ,FLOOP ;NOCH NICHT ALLE WORTE ?
DB 0C3H ;JP RZERO (HRM-HRM !!!)
;================================================================
ZERO:
DW $+2
RZERO:
LD DE,0
RSTPUSH
JP (IY)
;================================================================
DB 'EXECUT','E' OR CLAST
DW FIND-1
DB 7
EXECUTE:
DW $+2
RSTPULL
JP NEXTDE
;================================================================
DB 'NUMBE','R' OR CLAST
DW EXECUTE-1
DB 6
NUMBER:
DW $+2
CALL GETSTRING
JR C,RZERO ;KEIN WORT EINGEGEBEN ?
PUSH BC
PUSH DE
CALL CNVINT
JR NZ,NFLOAT ;KEIN ZWISCHENRAUM ?
LD DE,LITERAL
JR NUMBERQUIT ;16-BIT-INTEGER
NFLOAT:
RSTPULL
LD DE,0
RSTPUSH
LD DE,0 OR ((FEOFFS+5) SHL 8)
POP BC
PUSH BC
LD A,(BC)
CP '-'
JR NZ,NFGOON ;POSITIVE ZAHL ?
LD D,FSIGN OR (FEOFFS+5)
INC BC
NFGOON:
RSTPUSH
LD D,B
LD E,C
DEC HL
DEC HL
NFLOOP1:
CALL DECGET
INC HL
INC (HL)
DEC HL
JR NC,NFLOOP1 ;VORKOMMA-ANTEIL UMWANDELN
CP '.'-'0'
JR NZ,NUMBERERR ;NICHT DEZIMALPUNKT ?
NFLOOP2:
CALL DECGET
JR NC,NFLOOP2 ;NACHKOMMA-ANTEIL UMWANDELN
ADD A,'0'
CALL CNVEND
JR NZ,NFEXP ;KEIN ZWISCHENRAUM ?
LD E,0
JR NFEGOON
NFEXP:
AND NOT 020H
CP 'E'
JR NZ,NUMBERERR ;KEIN EXPONENT ?
PUSH HL
CALL CNVINT
RSTPULL
POP HL
JR NZ,NUMBERERR ;KEIN ZWISCHENRAUM ?
NFEGOON:
CALL FZEROEQ
JR Z,NFQUIT ;ZAHL = 0 ?
INC HL
LD A,(HL)
AND 7FH
ADD A,E
JP M,NUMBERERR
JR Z,NUMBERERR ;EXPONENT ZU GROSS ?
XOR (HL)
AND 7FH
XOR (HL) ;VORZEICHEN BEHALTEN
LD (HL),A ;EXPONENT SPEICHERN
NFQUIT:
LD DE,LITFLOAT
NUMBERQUIT:
RSTPUSH
POP DE
POP BC
CALL BLWORD
JP (IY)
NUMBERERR:
POP HL
POP HL
RSTPULL
RSTPULL
JP RZERO
;----------------------------------------------------------------
DECGET:
LD A,(DE)
INC DE
SUB '0'
RET C
CP 10
CCF
RET C ;ZEICHEN < '0' ODER > '9' ?
DECSHIN:
LD C,A
LD A,(HL)
AND 0F0H
RET NZ ;OBERSTE STELLE <> 0 ?
LD A,C
DECSTORE:
DEC HL
DEC HL
LD C,3
DSLOOP:
RLD
INC HL
DEC C
JR NZ,DSLOOP ;DIGIT AN UNTERSTER STELLE
DEC (HL)
DEC HL
CP A
RET ;DIGIT EINGESCHOBEN, TEST AUF 0
;----------------------------------------------------------------
FZEROEQ:
LD B,6
FZEQLP:
XOR A
CALL DECSHIN
RET NZ ;STELLE <> 0 GEFUNDEN ?
DJNZ FZEQLP ;MAXIMAL ALLE STELLEN
INC HL
LD (HL),B ;EXPONENT LOESCHEN
RET
;----------------------------------------------------------------
CNVINT:
RSTPUSH
CALL NEXT
DW DUP,CAT,GETBYTE
DB '-'
DW EQ ;NEGATIVES VORZEICHEN ?
DW DUP,NEGATE,GTR
DW PLUS,ONEMINUS ;ZEIGER ANPASSEN
DW ZERO,ZERO,ROT
DW CONVERT ;ZAHL KONVERTIEREN
DW ROT,RGT,IFN0NEG ;BEI BEDARF NEGIEREN
DW ROT,DROP ;OBERES WORT WEGWERFEN
DW SWAP
DW SEMICODE
RSTPULL
LD A,(DE)
CNVEND:
CP ' '
RET Z
AND A
RET ;TEST AUF ZWISCHENRAUM
;================================================================
DB 'CONVER','T' OR CLAST
DW NUMBER-1
DB 7
CONVERT:
DW DOCOL
CNVTLOOP:
DW ONEPLUS,DUP,GTR ;ADRESSE MERKEN
DW CAT,CNVDIGIT ;EIN ZEICHEN KONVERTIEREN
DW DOIF,CNVTEND-$-1 ;KEINE ZIFFER ?
DW SWAP
DW BASE,CAT,UMUL
DW DROP,ROT
DW BASE,CAT,UMUL
DW DPLUS ;ZIFFER EINSCHIEBEN
DW RGT ;ADRESSE HOLEN
DW DOREPEAT,CNVTLOOP-$-1
CNVTEND:
DW RGT ;STACK KORRIGIEREN
DW SEMIS
;----------------------------------------------------------------
CNVDIGIT:
DW $+2
RSTPULL
LD A,E
CALL TOUPPER ;ZEICHEN HOLEN
ADD A,-'0'
JR NC,CNVDQUIT ;ZEICHEN < '0' ?
CP 10
JR C,CNVDOK ;ZEICHEN < '9' ?
ADD A,'0'-'A'
JR NC,CNVDQUIT ;ZEICHEN < 'A' ?
ADD A,10 ;WERT KORRIGIEREN
CNVDOK:
CP (IX+VBASE-MEMBEG)
JR NC,CNVDQUIT ;ZEICHEN ZU GROSS ?
LD D,0
LD E,A
RSTPUSH ;DIGIT SPEICHERN
SCF
CNVDQUIT:
JP CMPPUSH ;TEST SPEICHERN
;================================================================
BLWORD:
LD H,D
LD L,E ;ZEIGER AUF ANFANG
INC BC
ADD HL,BC
PUSH HL ;ZEIGER HINTER TRENNZEICHEN
BIT 4,(IX+FLAGS-MEMBEG)
CALL Z,CTYPE ;EINGABE SICHTBAR ?
CALL DCSTREND ;EINGABE-ENDE SUCHEN
POP DE
AND A
SBC HL,DE
LD B,H
LD C,L ;RESTLICHE ZEICHEN BERECHNEN
LD HL,(INSCRN)
INC HL
EX DE,HL
JR C,BLANKS2
JR Z,BLANKS
LDIR ;EINGABE LOESCHEN
;----------------------------------------------------------------
BLANKS:
AND A
BLANKS2:
SBC HL,DE
EX DE,HL ;ANZAHL BERECHNEN
BLLOOP:
LD A,D
OR E
RET Z ;ALLES GELOESCHT ?
LD (HL),' '
INC HL ;NAECHSTES ZEICHEN LOESCHEN
DEC DE
JR BLLOOP
;================================================================
TOUPPER:
AND 7FH
CP 'a'
RET C
CP 'z'+1
RET NC
AND 5FH
RET
;================================================================
DB 'VI','S' OR CLAST
DW CONVERT-1
DB 3
VIS:
DW $+2
RES 4,(IX+FLAGS-MEMBEG) ;EINGABE SICHTBAR
JP (IY)
;================================================================
DB 'INVI','S' OR CLAST
DW VIS-1
DB 5
INVIS:
DW $+2
SET 4,(IX+FLAGS-MEMBEG) ;EINGABE UNSICHTBAR
JP (IY)
;================================================================
DB 'FAS','T' OR CLAST
DW INVIS-1
DB 4
FAST:
DW $+2
LD IY,NEXT
JP (IY)
;================================================================
DB 'SLO','W' OR CLAST
DW FAST-1
DB 4
SLOW:
DW $+2
LD IY,RSLNEXT
JP (IY)
;================================================================
PULLBC:
LD HL,(SPARE)
DEC HL
LD B,(HL)
DEC HL
LD C,(HL)
LD (SPARE),HL
RET
;================================================================
RPULL:
DEC HL
LD E,(HL)
LD (SPARE),HL
RET
;================================================================
RPUSH:
LD (HL),D
INC HL
LD (SPARE),HL
RET
;================================================================
DB 'DU','P' OR CLAST
DW SLOW-1
DB 3
DUP:
DW $+2
RSTPULL
RSTPUSH
RSTPUSH
JP (IY)
;================================================================
DB 'DRO','P' OR CLAST
DW DUP-1
DB 4
DROP:
DW $+2
RSTPULL
JP (IY)
;================================================================
DB 'SWA','P' OR CLAST
DW DROP-1
DB 4
SWAP:
DW $+2
RSTPULL
CALL PULLBC
RSTPUSH
LD D,B
LD E,C
RSTPUSH
JP (IY)
;================================================================
DB 'C','@' OR CLAST
DW SWAP-1
DB 2
CAT:
DW $+2
RSTPULL
LD A,(DE)
LD E,A
LD D,0
RSTPUSH
JP (IY)
;================================================================
DB 'C','!' OR CLAST
DW CAT-1
DB 2
CEXCLAM:
DW $+2
RSTPULL
CALL PULLBC
LD A,C
LD (DE),A
JP (IY)
;================================================================
DB '@' OR CLAST
DW CEXCLAM-1
DB 1
AT:
DW $+2
RSTPULL
EX DE,HL
LD E,(HL)
INC HL
LD D,(HL)
RSTPUSH
JP (IY)
;================================================================
DB '!' OR CLAST
DW AT-1
DB 1
EXCLAM:
DW $+2
RSTPULL
CALL PULLBC
EX DE,HL
LD (HL),C
INC HL
LD (HL),B
JP (IY)
;================================================================
DB '>','R' OR CLAST
DW EXCLAM-1
DB 2
GTR:
DW $+2
RSTPULL
POP BC
PUSH DE
PUSH BC
JP (IY)
;================================================================
DB 'R','>' OR CLAST
DW GTR-1
DB 2
RGT:
DW $+2
POP BC
POP DE
PUSH BC
RSTPUSH
JP (IY)
;================================================================
DB '?DU','P' OR CLAST
DW RGT-1
DB 4
QDUP:
DW $+2
RSTPULL
RSTPUSH
LD A,D
OR E
CALL NZ,CPUSH
JP (IY)
;================================================================
DB 'RO','T' OR CLAST
DW QDUP-1
DB 3
ROT:
DW DOCOL
DW GTR,SWAP,RGT,SWAP
DW SEMIS
;================================================================
DB 'OVE','R' OR CLAST
DW ROT-1
DB 4
OVER:
DW DOCOL
DW GTR,DUP,RGT,SWAP
DW SEMIS
;================================================================
DB 'PIC','K' OR CLAST
DW OVER-1
DB 4
PICK:
DW $+2
CALL CPICK
JP (IY)
;================================================================
DB 'ROL','L' OR CLAST
DW PICK-1
DB 4
ROLL:
DW $+2
CALL CPICK
EX DE,HL
LD HL,(STKBOT)
SBC HL,DE
JP NC,ERRORSTK ;STACK NICHT GENUEGEND GROSS ?
LD H,D
LD L,E
INC HL
INC HL
LDIR ;STACK VERSCHIEBEN
LD (SPARE),DE
JP (IY)
;================================================================
CPICK:
CALL PULLBC
DEC BC
SLA C
RL B
INC BC
INC BC
JR NC,CPKGOON ;OFFSET OK ?
RSTERR ERRPICK
CPKGOON:
LD HL,(SPARE)
SBC HL,BC
PUSH HL
LD E,(HL)
INC HL
LD D,(HL)
RSTPUSH ;ZAHL AUS PARAMETERSTACK HOLEN
POP HL
RET
;================================================================
DB 'TYP','E' OR CLAST
DW ROLL-1
DB 4
TYPE:
DW $+2
CALL PULLBC
RSTPULL
CALL CTYPE
JP (IY)
;================================================================
TYPEDE:
LD A,(DE)
LD C,A
INC DE
LD A,(DE)
LD B,A
INC DE
;----------------------------------------------------------------
CTYPE:
LD A,B
OR C
RET Z
LD A,(DE)
INC DE
DEC BC
RSTEMIT
JR CTYPE
;================================================================
DB '<','#' OR CLAST
DW TYPE-1
DB 2
LTNUM:
DW $+2
LD HL,SCRMEND-1
LD (HLD),HL ;ZEIGER VORBEREITEN
JP (IY)
;================================================================
DB '#','>' OR CLAST
DW LTNUM-1
DB 2
NUMGT:
DW $+2
RSTPULL
RSTPULL ;STACK PUTZEN
LD DE,(HLD)
RSTPUSH ;ZEIGER HOLEN
LD HL,SCRMEND-1
AND A
SBC HL,DE
EX DE,HL
RSTPUSH ;LAENGE BERECHNEN
JP (IY)
;================================================================
DB '.' OR CLAST
DW SIGN-1
DB 1
PNT:
DW DOCOL
DW LTNUM,DUP ;UMWANDLUNG STARTEN
DW ABS,ZERO ;DOPPELWORT AUFBAUEN
DW NUMS ;ZAHL ABSOLUT UMWANDELN
DW ROT,SIGN ;VORZEICHEN BEARBEITEN
PNTLEFT:
DW NUMGT ;BEARBEITUNG BEENDEN
DW TYPE,SPACE ;AUSGEBEN
DW SEMIS
;================================================================
DB 'U','.' OR CLAST
DW PNT-1
DB 2
UPNT:
DW DOCOL
DW ZERO,LTNUM,NUMS ;UMWANDLUNG STARTEN
DW DOREPEAT,PNTLEFT-$-1
;================================================================
DB '#','S' OR CLAST
DW UPNT-1
DB 2
NUMS:
DW DOCOL
NUMSLP:
DW NUM ;EINE STELLE UMWANDELN
DW OVER,OVER,LOR,ZEROEQ
DW DOUNTIL,NUMSLP-$-1 ;REST <> 0 ?
DW SEMIS
;================================================================
DB '#' OR CLAST
DW NUMS-1
DB 1
NUM:
DW DOCOL
DW BASE,CAT,DIV32BY16,ROT ;MIT "BASE" MODULO
DW NIBASC,HOLD ;ALS ZEICHEN SPEICHERN
DW SEMIS
;================================================================
NIBASC:
DW $+2
RSTPULL
LD A,E ;NIBBLE HOLEN
ADD A,'0'
CP '0'+10
JR C,NADEC ;KORREKTUR FUER 'A'...
ADD A,7
NADEC:
LD E,A
RSTPUSH ;ASCII SPEICHERN
JP (IY)
;================================================================
DB 'CL','S' OR CLAST
DW NUM-1
DB 3
CLS:
DW $+2
CALL CCLS
JP (IY)
CCLS:
LD DE,SCREEN+24*32-1
LD HL,(LHALF)
LD BC,32
ADD HL,BC
DEC HL
LDDR ;LETZTE AUSGABEZEILE AN BILD-ENDE
LD (XCOORD),BC ;PLOTKOORDINATEN LOESCHEN
LD HL,SCREEN
LD (SCRPOS),HL ;CURSOR HOME
INC DE
EX DE,HL
LD (LHALF),HL ;AUSGABE-ENDE SETZEN
JP BLANKS ;AUSGABE-FELD LOESCHEN
;================================================================
DB 'SIG','N' OR CLAST
DW NUMGT-1
DB 4
SIGN:
DW $+2
RSTPULL
RL D
LD E,'-'
JR C,RHOLD ;BEI BEDARF '-' SPEICHERN
JP (IY)
;================================================================
DB 'HOL','D' OR CLAST
DW CLS-1
DB 4
HOLD:
DW $+2
RSTPULL
RHOLD:
LD HL,(HLD)
DEC L
JR Z,HOLDQUIT ;PUFFER VOLL ?
LD (HLD),HL
LD (HL),E ;ZEICHEN SPEICHERN
HOLDQUIT:
JP (IY)
;================================================================
DB 'SPAC','E' OR CLAST
DW HOLD-1
DB 5
SPACE:
DW $+2
LD A,' '
RSTEMIT
SPACEQUIT:
JP (IY)
;================================================================
DB 'SPACE','S' OR CLAST
DW SPACE-1
DB 6
SPACES:
DW $+2
RSTPULL
SPCLOOP:
DEC DE
BIT 7,D
JR NZ,SPACEQUIT ;ALLE AUSGEGEBEN ?
LD A,' '
RSTEMIT
JR SPCLOOP
;================================================================
DB 'C','R' OR CLAST
DW SPACES-1
DB 2
CR:
DW $+2
LD A,CCR
RSTEMIT
JP (IY)
;================================================================
DB 'EMI','T' OR CLAST
DW CR-1
DB 4
EMIT:
DW $+2
RSTPULL
LD A,E
RSTEMIT
JP (IY)
;================================================================
DB 'F','.' OR CLAST
DW EMIT-1
DB 2
FPNT:
DW $+2
LD HL,(SPARE)
DEC HL
BIT 7,(HL)
RES 7,(HL)
JR Z,FPGOON1
LD A,'-'
RSTEMIT ;NEGATIVES VORZEICHEN AUSGEBEN
FPGOON1:
LD E,0 ;BISHER KEIN EXPONENT
LD A,(HL)
DEC A
CP FEOFFS+9
JR NC,FPGOON2
CP FEOFFS-4
JR NC,FPGOON3 ;KEIN EXPONENT NOTWENDIG ?
FPGOON2:
LD (HL),FEOFFS+1
INC A
LD E,A ;EXPONENT MERKEN
FPGOON3:
LD A,FEOFFS
SUB (HL)
JR C,FPMLOOP ;EXPONENT NEGATIV ?
LD B,A
INC B
LD A,'.'
FPH0:
RSTEMIT
LD A,'0'
DJNZ FPH0 ;FUEHRENDE NULLEN AUSGEBEN
FPMLOOP:
LD A,'@'
CP (HL)
SBC A,A
DEC HL
OR (HL)
DEC HL
OR (HL)
DEC HL
OR (HL)
INC HL
INC HL
JR Z,FP0 ;ZAHL = 0 ?
XOR A
CALL DECSTORE
ADD A,'0'
RSTEMIT ;NAECHSTE ZIFFER AUSGEBEN
INC HL
LD A,(HL)
CP FEOFFS
JR NZ,FPMLOOP ;ZAHL < 0.1 ODER ZAHL >=1.0 ?
LD A,'.'
RSTEMIT
JR FPMLOOP ;DEZIMALPUNKT AUSGEBEN
FP0:
LD A,E
AND A
JR NZ,FPEXP ;EXPONENT AUSZUGEBEN ?
LD A,' '
RSTEMIT
JR FPQUIT
FPEXP:
SUB FEOFFS+1
LD L,A
SBC A,A
LD H,A
LD A,'E'
RSTEMIT
CALL PNTHL ;EXPONENT AUSGEBEN
FPQUIT:
RSTPULL
RSTPULL
JP (IY)
;================================================================
DB 'A','T' OR CLAST
DW FPNT-1
DB 2
ATPOS:
DW $+2
RSTPULL ;SPALTE
CALL PULLBC ;ZEILE
LD A,C
CALL CATPOS
LD (SCRPOS),HL
JP (IY)
CATPOS:
ADD A,32
LD L,A
LD H,1 ;SCREEN / 32
ADD HL,HL
ADD HL,HL
ADD HL,HL
ADD HL,HL
ADD HL,HL ;SCREEN + ZEILE
LD D,0
LD A,E
AND 1FH
LD E,A
ADD HL,DE ;SCREEN + ZEILE + SPALTE
LD DE,(LHALF)
SBC HL,DE
ADD HL,DE
RET C ;NICHT HINTER AUSGABE-FELD ?
RSTERR ERRAT
;================================================================
DB 'PLO','T' OR CLAST
DW ATPOS-1
DB 4
PLOT:
DW $+2
CALL PULLBC ;0/1/2/3 = RES/SET/NOP/XOR
RSTPULL ;Y-KOORDINATE
LD (IX+YCOORD-MEMBEG),E
SRL E
RL C ;LSB-Y HOLEN
LD A,22
SUB E ;Y-KOORDINATE ALS ZEILENNUMMER
RSTPULL ;X-KOORDINATE
LD (IX+XCOORD-MEMBEG),E
SRL E
RL C ;LSB-X HOLEN
CALL CATPOS ;ZEIGER IN BILDSCHIRM
LD A,(HL) ;ALTES ZEICHEN HOLEN
AND 78H
CP 10H
LD A,(HL)
JR Z,PLGOON ;BEREITS GRAFIK-ZEICHEN ?
LD A,10H ;LEERES GRAFIK-ZEICHEN
PLGOON:
LD E,A ;AUSGANGSCODE MERKEN
LD D,87H ;MASKE SETZEN
LD A,C
AND 3
LD B,A
JR Z,PLX0Y0 ;X=0 UND Y=0 ?
CPL
ADD A,2
ADC A,3
LD D,A
LD B,E ;BITMASKEN FUER X<>0 UND Y<>0
PLX0Y0:
LD A,C
RRCA
RRCA
RRCA
SBC A,A ;LOESCHEN/SETZEN MASKE
BIT 3,C
JR NZ,PLXOR ;NOP/XOR ?
XOR E
RLCA
SBC A,A
XOR B ;LOESCHEN/SETZEN VORBEREITEN
PLXOR:
AND D
XOR E
LD (HL),A ;NEUEN CODE SPEICHERN
JP (IY)
;================================================================
DB 'BEE','P' OR CLAST
DW PLOT-1
DB 4
BEEP:
DW DOCOL
DW OVER,GETBYTE
DB 125
DW SWAP,MULDIV ;WERT ANPASSEN
DW SEMICODE
RSTPULL
CALL PULLBC
LD HL,250-1
ADD HL,BC
INC L ;(??? RUNDUNG)
DI
BLOOP:
LD A,7FH
IN A,(IO)
RRCA
JR NC,BDBREAK ;UNTERBROCHEN ?
CALL BEEPDELAY
DEC DE
LD A,D
OUT (IO),A
CALL BEEPDELAY
OR E
JP NZ,BLOOP ;ZEIT NOCH NICHT UM ?
EI
JP (IY)
BDBREAK:
RSTERR ERRBRK
BEEPDELAY:
LD B,L
LD C,H
BDLOOP:
DJNZ BDLOOP
DEC B
DEC C
JP NZ,BDLOOP ;ETWAS WARTEN...
RET
;================================================================
DB 'INKE','Y' OR CLAST
DW BEEP-1
DB 5
INKEY:
DW $+2
CALL KEYGET
LD E,A
LD D,0
RSTPUSH
JP (IY)
;================================================================
DB 'I','N' OR CLAST
DW INKEY-1
DB 2
IN:
DW $+2
CALL PULLBC
LD D,0
IN E,(C)
RSTPUSH
JP (IY)
;================================================================
DB 'OU','T' OR CLAST
DW IN-1
DB 3
OUT:
DW $+2
CALL PULLBC
RSTPULL
OUT (C),E
JP (IY)
;================================================================
DB 'AB','S' OR CLAST
DW OUT-1
DB 3
ABS:
DW DOCOL
DW DUP,IFN0NEG
DW SEMIS
;================================================================
DB '0','=' OR CLAST
DW ABS-1
DB 2
ZEROEQ:
DW $+2
RSTPULL
LD A,D
OR E
CP 1 ;C, WENN A=0
CMPPUSH:
LD A,0
LD D,A
RLA
LD E,A
RSTPUSH ;WENN C, WERT = 1, SONST 0
JP (IY)
;================================================================
DB '0','<' OR CLAST
DW ZEROEQ-1
DB 2
ZEROLT:
DW $+2
RSTPULL
RL D ;VORZEICHEN HOLEN
JR CMPPUSH
;================================================================
DB '0','>' OR CLAST
DW ZEROLT-1
DB 2
ZEROGT:
DW $+2
RSTPULL
LD A,D
OR E
JR Z,CMPPUSH ;= 0 ?
RL D
CCF
JR CMPPUSH ;INVERTIERTES VORZEICHEN HOLEN
;================================================================
DB '=' OR CLAST
DW ZEROGT-1
DB 1
EQ:
DW DOCOL
DW MINUS,ZEROEQ
DW SEMIS
;================================================================
DB '>' OR CLAST
DW EQ-1
DB 1
GT:
DW $+2
RSTPULL
PUSH DE
RSTPULL
POP HL
CALL GREATER
JR CMPPUSH
;================================================================
DB '<' OR CLAST
DW GT-1
DB 1
LT:
DW DOCOL
DW SWAP,GT
DW SEMIS
;================================================================
DB 'U','<' OR CLAST
DW LT-1
DB 2
ULT:
DW $+2
CALL PULLBC
UCMP:
RSTPULL
EX DE,HL
AND A
SBC HL,BC ;C = (BC > HL)
JR CMPPUSH
;================================================================
DB 'D','<' OR CLAST
DW ULT-1
DB 2
DLT:
DW $+2
RSTPULL
PUSH DE
CALL PULLBC
RSTPULL
POP HL
AND A
SBC HL,DE
JR Z,UCMP ;HOEHERE 16 BIT GLEICH ?
ADD HL,DE
EX DE,HL
CALL GREATER ;NUR HOEHERE 16 BIT VERGLEICHEN
RSTPULL
JR CMPPUSH
;================================================================
GREATER:
LD A,H
XOR D
JP M,GRTRQUIT ;VORZEICHEN UNGLEICH ?
SBC HL,DE
GRTRQUIT:
RL H ;VORZEICHEN IN C
RET
;================================================================
DB 'U','*' OR CLAST
DW DLT-1
DB 2
UMUL:
DW $+2
RSTPULL
CALL PULLBC
LD HL,0
LD A,16 ;BITZAEHLER SETZEN
UMULLOOP:
ADD HL,HL
EX DE,HL
ADC HL,HL
EX DE,HL
JR NC,UMULNEXT ;MULTIPLIKATOR-BIT = 0 ?
ADD HL,BC
JR NC,UMULNEXT ;KEIN UEBERTRAG ?
INC DE
UMULNEXT:
DEC A
JR NZ,UMULLOOP ;NOCH NICHT ALLE BITS ?
EX DE,HL
JR PUSHDEHL
;================================================================
DIV32BY16:
DW $+2
RSTPULL ;DIVISOR
EXX
RSTPULL ;DIVIDEND H
PUSH DE
RSTPULL ;DIVIDEND L
POP HL
LD A,H
OR L
LD A,33 ;NORMALER BITZAEHLER
JR NZ,D32GOON ;DIVIDEND > 65535 ?
EX DE,HL
LD A,17 ;BERECHNUNG ABKUERZEN
D32GOON:
EXX
LD B,A
XOR A
LD H,A
LD L,A
LD C,A ;BERECHNUNG VORBEREITEN
D32LOOP:
ADC HL,HL
SBC A,A
AND A
SBC HL,DE ;TESTWEISE SUBTRAHIEREN
SBC A,C
JR NC,D32NEXT
ADD HL,DE ;SUBTRAKTION ZURUECKNEHMEN
D32NEXT:
CCF
EXX
EX DE,HL
ADC HL,HL
EX DE,HL
ADC HL,HL
EXX
DJNZ D32LOOP ;NOCH NICHT ALLE BITS ?
EX DE,HL
RSTPUSH ;REST SPEICHERN
EXX ;QUOTIENT HOLEN
PUSHDEHL:
PUSH HL
RSTPUSH
POP DE
RSTPUSH
JP (IY)
;================================================================
DB '/MO','D' OR CLAST
DW UMUL-1
DB 4
DIVMOD:
DW DOCOL
DW SWAP,GTR,I,ABS ;DIVIDEND VORBEREITEN
DW GETBYTE
DB 0
DIVMOD2:
DW ROT,DUP,I
DW LXOR ;VORZEICHEN BERECHNEN
DW GTR,ABS ;DIVISOR VORBEREITEN
DW UDIVMOD
DW RGT,IFN0NEG,SWAP ;VORZEICHEN QUOTIENT
DW RGT,IFN0NEG,SWAP ;VORZEICHEN REST
DW SEMIS
;================================================================
DB '*/MO','D' OR CLAST
DW DIVMOD-1
DB 5
MULDIVMOD:
DW DOCOL
DW ROT,GTR,I,ABS ;FAKTOR 1 VORBEREITEN
DW ROT,DUP,RGT,LXOR ;VORZEICHEN BERECHNEN
DW GTR,ABS ;FAKTOR 2 VORBEREITEN
DW UMUL
DW DOREPEAT,DIVMOD2-$-1
;================================================================
DB '/' OR CLAST
DW MULDIVMOD-1
DB 1
DIV:
DW DOCOL
DW DIVMOD
DW SWAP,DROP ;REST LOESCHEN
DW SEMIS
;================================================================
DB 'MO','D' OR CLAST
DW DIV-1
DB 3
MOD:
DW DOCOL
DW DIVMOD
DW DROP ;QUOTIENT LOESCHEN
DW SEMIS
;================================================================
DB '*' OR CLAST
DW MOD-1
DB 1
MUL:
DW DOCOL
DW UMUL,DROP ;OBERE 16-BIT LOESCHEN
DW SEMIS
;================================================================
DB '*','/' OR CLAST
DW MUL-1
DB 2
MULDIV:
DW DOCOL
DW MULDIVMOD ;*/MOD
DW SWAP,DROP ;REST LOESCHEN
DW SEMIS
;================================================================
DB 'U/MO','D' OR CLAST
DW MULDIV-1
DB 5
UDIVMOD:
DW DOCOL
DW DIV32BY16,DROP
DW SEMIS
;================================================================
IFN0NEG:
DW DOCOL
DW ZEROLT,DOIF,I0NEND-$-1
DW NEGATE ;VORZEICHEN WIE TOS
I0NEND:
DW SEMIS
;================================================================
DB 'NEGAT','E' OR CLAST
DW UDIVMOD-1
DB 6
NEGATE:
DW $+2
LD BC,2 ;2 BYTES
JR DONEGATE
;================================================================
DB 'DNEGAT','E' OR CLAST
DW NEGATE-1
DB 7
DNEGATE:
DW $+2
LD BC,4 ;4 BYTES
DONEGATE:
LD HL,(SPARE)
AND A
SBC HL,BC ;ZEIGER AUF ZAHL IM WERTESTACK
DNLOOP:
LD A,B ;0 LADEN, OHNE C ZU LOESCHEN
SBC A,(HL)
LD (HL),A ;BYTE NEGIEREN
INC HL
DEC C
JR NZ,DNLOOP ;NOCH NICHT ALLE BYTES ?
JP (IY)
;================================================================
DB '+' OR CLAST
DW DNEGATE-1
DB 1
PLUS:
DW $+2
RSTPULL
PUSH DE
RSTPULL
POP HL
ADD HL,DE
EX DE,HL
RSTPUSH
JP (IY)
;================================================================
DB '-' OR CLAST
DW PLUS-1
DB 1
MINUS:
DW DOCOL
DW NEGATE,PLUS
DW SEMIS
;================================================================
DB 'D','+' OR CLAST
DW MINUS-1
DB 2
DPLUS:
DW $+2
RSTPULL
PUSH DE
CALL PULLBC
RSTPULL
PUSH DE
RSTPULL
EX DE,HL
ADD HL,BC
EX DE,HL
RSTPUSH
POP BC
POP HL
ADC HL,BC
EX DE,HL
RSTPUSH
JP (IY)
;================================================================
DB '1','+' OR CLAST
DW DPLUS-1
DB 2
ONEPLUS:
DW $+2
RSTPULL
JR XPLUS
;================================================================
DB '2','+' OR CLAST
DW ONEPLUS-1
DB 2
TWOPLUS:
DW $+2
RSTPULL
INC DE
XPLUS:
INC DE
JR XPLUSMINUS
;================================================================
DB '1','-' OR CLAST
DW TWOPLUS-1
DB 2
ONEMINUS:
DW $+2
RSTPULL
JR XMINUS
;================================================================
DB '2','-' OR CLAST
DW ONEMINUS-1
DB 2
TWOMINUS:
DW $+2
RSTPULL
DEC DE
XMINUS:
DEC DE
XPLUSMINUS:
RSTPUSH
JP (IY)
;================================================================
DB 'O','R' OR CLAST
DW TWOMINUS-1
DB 2
LOR:
DW $+2
RSTPULL
CALL PULLBC
LD A,E
OR C
LD E,A
LD A,D
OR B
LD D,A
RSTPUSH
JP (IY)
;================================================================
DB 'AN','D' OR CLAST
DW LOR-1
DB 3
LAND:
DW $+2
RSTPULL
CALL PULLBC
LD A,E
AND C
LD E,A
LD A,D
AND B
LD D,A
RSTPUSH
JP (IY)
;================================================================
DB 'XO','R' OR CLAST
DW LAND-1
DB 3
LXOR:
DW $+2
RSTPULL
CALL PULLBC
LD A,E
XOR C
LD E,A
LD A,D
XOR B
LD D,A
RSTPUSH
JP (IY)
;================================================================
DB 'MA','X' OR CLAST
DW LXOR-1
DB 3
MAX:
DW DOCOL
DW OVER,OVER,LT ;ZAHLEN VERGLEICHEN
DW DOELSE,MINMAX-$-1
;================================================================
DB 'MI','N' OR CLAST
DW MAX-1
DB 3
MIN:
DW DOCOL
DW OVER,OVER,GT ;ZAHLEN VERGLEICHEN
MINMAX:
DW DOIF,MINMAXEND-$-1
DW SWAP ;BEI BEDARF TAUSCHEN
MINMAXEND:
DW DROP ;FALSCHE ZAHL LOESCHEN
DW SEMIS
;================================================================
DB 'DECIMA','L' OR CLAST
DW MIN-1
DB 7
DECIMAL:
DW $+2
LD (IX+VBASE-MEMBEG),10
JP (IY)
;================================================================
NCOLON:
DB ':' OR CLAST
DW DECIMAL-1
DB 1
COLON:
DW DODEFINER,DOCOL
DW GETBYTE
DB 10 ;PRUEFWERT SETZEN
DW SEMICODE
LD HL,FLAGS
LD A,(HL)
OR (1 SHL 6) OR (1 SHL 2)
LD (HL),A ;COMPILER EINSCHALTEN
JP (IY)
;================================================================
DW NCOLON-$-1
DOCOL:
EX DE,HL ;AKTUELLEN ZEIGER FUER STACK
JP NEXTSUB
;================================================================
NCREATE:
DB 'CREAT','E' OR CLAST
DW COLON-1
DB 6
CREATE:
DW DOCOL
DW GETBYTE
DB ' '
DW WORD,CRHEADER ;HEADER VORBEREITEN
DW ZERO,KOMMA
DW CURRENT,AT
DW DUP,AT,KOMMA ;VERKETTUNG BILDEN
DW HERE,SWAP,EXCLAM ;ADRESSE MERKEN
DW PAD,CAT,CKOMMA
DW GETWORD,DOCREATE,KOMMA ;ERSTES WORT SPEICHERN
DW SEMIS
;================================================================
CRHEADER:
DW $+2
CALL LINKHERE
RSTPULL
LD A,(DE) ;NAMENSLAENGE HOLEN
DEC A
CP 03FH
JR C,CHGOON ;NAME NICHT ZU LANG ?
RSTERR ERRNAME
CHGOON:
ADD A,8 ;LINKS, LAENGENBYTE UND 1. WORT
LD C,A
LD B,0
CALL MEMCHECK
LD A,(DE)
LD C,A
LD HL,(STKBOT)
PUSH DE
CALL ALLOC ;SPEICHER RESERVIEREN
POP DE
LD A,(DE)
LD B,A ;ANZAHL ZEICHEN
CHLOOP:
INC DE
LD A,(DE)
CALL TOUPPER
LD (HL),A
INC HL
DJNZ CHLOOP ;NAMEN SPEICHERN
LD (DICT),HL
DEC HL
SET 7,(HL) ;NAMENSENDE KENNZEICHNEN
JP (IY)
;================================================================
LINKHERE:
BIT 2,(IX+FLAGS-MEMBEG)
JR Z,LHGOON ;KEIN COMPILE-MODE ?
RSTERR ERRMODE
LHGOON:
LD HL,(STKBOT)
LD DE,(DICT)
XOR A
SBC HL,DE
EX DE,HL
LD (HL),E
INC HL
LD (HL),D ;LINK AUFBAUEN
LD H,A
LD L,A
LD (DICT),HL
RET
;================================================================
DB ',' OR CLAST
DW CREATE-1
DB 1
KOMMA:
DW DOCOL
DW ALLOT2,HERE,TWOMINUS,EXCLAM
DW SEMIS
;================================================================
DB 'C',',' OR CLAST
DW KOMMA-1
DB 2
CKOMMA:
DW DOCOL
DW GETBYTE
DB 1
DW ALLOT,HERE,ONEMINUS,CEXCLAM
DW SEMIS
;================================================================
DB 'ALLO','T' OR CLAST
DW CKOMMA-1
DB 5
ALLOT:
DW $+2
CALL PULLBC
LD HL,(STKBOT)
CALL ALLOC
JP (IY)
;================================================================
ALLOT2:
DW DOCOL
DW GETBYTE
DB 2
DW ALLOT
DW SEMIS
;================================================================
MEMCHECK:
LD HL,30
MEMCHECK2:
PUSH BC
ADD HL,BC
LD BC,(SPARE)
ADD HL,BC ;NEUE ENDADRESSE
POP BC
JR C,MCERROR ;SPEICHER-UEBERLAUF ?
SBC HL,SP
RET C ;KEINE KOLLISION MIT STACK ?
MCERROR:
RSTERR ERRMEM
;================================================================
ALLOC:
EX DE,HL
LD HL,40
CALL MEMCHECK2 ;ETWAS WEITER PRUEFEN
LD HL,(STKBOT)
ADD HL,BC
LD (STKBOT),HL
LD HL,(SPARE)
PUSH HL
ADD HL,BC
LD (SPARE),HL ;ZEIGER WEITERSCHIEBEN
EX (SP),HL
PUSH HL
AND A
SBC HL,DE
LD B,H
LD C,L ;ABSTAND = ALTER SPARE - DE
POP HL
POP DE
RET Z ;NICHTS ZU VERSCHIEBEN ?
DEC HL
DEC DE
LDDR
INC HL ;PARAMETERSTACK VERSCHIEBEN
RET
;================================================================
NVARIABLE:
DB 'VARIABL','E' OR CLAST
DW ALLOT-1
DB 8
VARIABLE:
DW DODEFINER,DOVARIABLE
DW KOMMA
DW SEMIS
;================================================================
NCONSTANT:
DB 'CONSTAN','T' OR CLAST
DW VARIABLE-1
DB 8
CONSTANT:
DW DODEFINER,DOCONSTANT
DW KOMMA
DW SEMIS
;================================================================
DW NCREATE-$-1
DOCREATE:
JR DOVARIABLE
;================================================================
DW NVARIABLE-$-1
DOVARIABLE:
RSTPUSH
JP (IY)
;================================================================
DW NCONSTANT-$-1
DOCONSTANT:
EX DE,HL
LD E,(HL)
INC HL
LD D,(HL)
RSTPUSH ;WERT AUF STACK
JP (IY)
;================================================================
DB 'LITERA','L' OR CLAST
DW CONSTANT-1
DB 7 OR IMM
LITERAL:
DW DOCOMPILER,GETWORD
DW KOMMA
DW SEMIS
;================================================================
DB 2
DW -1
GETWORD:
DW $+2
LD B,1 ;NUR EIN WORT
GWLOOP:
POP HL
LD E,(HL)
INC HL
LD D,(HL) ;WORT HOLEN
GWGOON:
INC HL
PUSH HL
RSTPUSH ;WORT AUF STACK
DJNZ GWLOOP
GWQUIT:
JP (IY)
;================================================================
NASCII:
DB 'ASCI','I' OR CLAST
DW LITERAL-1
DB 5 OR IMM
ASCII:
DW DOCOL
DW GETBYTE
DB ' '
DW WORD,ONEPLUS,CAT
DW SEMICODE
BIT 6,(IX+FLAGS-MEMBEG)
JR Z,GWQUIT ;COMPILER AUS ?
CALL NEXT
DW GETWORD,GETBYTE,KOMMA
DW CKOMMA
DW SEMIS
;================================================================
DB 1
DW NASCII-$-1
GETBYTE:
DW $+2
POP HL
LD E,(HL)
LD D,0
LD B,1
JR GWGOON
;================================================================
LITFLOAT:
DW DOCOMPILER,GETFLOAT
DW SWAP,KOMMA,KOMMA
DW SEMIS
;================================================================
DB 4
DW -1
GETFLOAT:
DW $+2
LD B,2
JR GWLOOP
;================================================================
NDEFINER:
DB 'DEFINE','R' OR CLAST
DW ASCII-1
DB 7
DEFINER:
DW DODEFINER,DODEFINER
DW HERE,GETBYTE
DB 12
DW ALLOT2
DW DOREPEAT,0EB6H-$-1
;================================================================
DW NDEFINER-$-1
DODEFINER:
CALL DOVARIABLE
DW CREATE ;HEADER ERZEUGEN
DW DUP,AT
DW HERE,TWOMINUS,EXCLAM ;VERKETTUNG BILDEN
DW TWOPLUS,DROPGOON
DW SEMIS
;----------------------------------------------------------------
DROPGOON:
DW $+2
RSTPULL
JP DOCOL
;================================================================
DB 'CAL','L' OR CLAST
DW DEFINER-1
DB 4
CALL:
DW $+2
RSTPULL ;ZIELADRESSE HOLEN
EX DE,HL
JP (HL)
;================================================================
NDOESGT:
DB 'DOES','>' OR CLAST
DW COMPILER-1
DB 5 OR IMM
DOESGT:
DW DOCOMPILER,DODOESGT
DW ASSERT
DB 12 ;PRUEFWERT TESTEN
DW DOESPATCH
DW GETBYTE
DB 0CDH
DW CKOMMA
DW GETWORD,DOVARIABLE,KOMMA;"CALL DOVARIABLE"
DW GETBYTE
DB 10 ;PRUEFWERT SETZEN
DW SEMIS
;================================================================
DOESPATCH:
DW DOCOL
DW DUP,TWOMINUS,NFA
DW HERE,MINUS,ONEMINUS,KOMMA
DW HERE,SWAP,EXCLAM ;VERKETTUNG KORRIGIEREN
DW SEMIS
;================================================================
DB 5
DW NDOESGT-$-1
DODOESGT:
DW RSEMIS
;================================================================
NCOMPILER:
DB 'COMPILE','R' OR CLAST
DW CALL-1
DB 8
COMPILER:
DW DODEFINER,DOCOMPILER
DW IMMEDIATE
DW HERE
DW GETBYTE
DB 11
DW ALLOT2
DW DOREPEAT,0EB6H-$-1
;================================================================
DW NCOMPILER-$-1
DOCOMPILER:
BIT 6,(IX+FLAGS-MEMBEG)
JR NZ,DOCOMGOON ;COMPILER EINGESCHALTET ?
RSTERR ERRIMM
DOCOMGOON:
CALL DOVARIABLE
DW DUP,AT,KOMMA
DW DOREPEAT,1094H-$-1
;================================================================
NRUNSGT:
DB 'RUNS','>' OR CLAST
DW DOESGT-1
DB 5 OR IMM
RUNSGT:
DW DOCOMPILER,DORUNSGT
DW ASSERT
DB 11 ;PRUEFWERT TESTEN
DW SWAP,CKOMMA
DW DOESPATCH
DW GETWORD,RUNSCORR,KOMMA
DW GETBYTE
DB 10 ;PRUEFWERT SETZEN
DW SEMIS
;----------------------------------------------------------------
DB 5
DW NRUNSGT-$-1
DORUNSGT:
DW RSEMIS
;----------------------------------------------------------------
RUNSCORR:
POP HL
PUSH DE
EX DE,HL
RSTPUSH
LD B,D
LD C,E
POP DE
PUSH DE
DEC DE
DEC DE
CALL SKIPOFFS ;NAECHSTE FORTH-ADRESSE
POP DE
PUSH BC
JP DOCOL
;================================================================
DB 'IMMEDIAT','E' OR CLAST
DW RUNSGT-1
DB 9
IMMEDIATE:
DW DOCOL
DW CURRENT,AT,AT
DW SEMICODE
RSTPULL
EX DE,HL
SET 6,(HL) ;IMMEDIATE-BIT SETZEN
JP (IY)
;================================================================
DB 'VOCABULAR','Y' OR CLAST
DW IMMEDIATE-1
DB 10
VOCABULARY:
DW DODEFINER,SETCONTEXT
DW CURRENT,AT
DW TWOPLUS,KOMMA
DW ZERO,CKOMMA ;VERKETTUNG VORBEREITEN
DW HERE,GETWORD,VOCLNK
DW DUP,AT,KOMMA,EXCLAM ;UMSCHALTUNG COMPILIEREN
DW SEMIS
;================================================================
DB 'DEFINITION','S' OR CLAST
DW VOCABULARY-1
DB 11
DEFINITIONS:
DW $+2
LD HL,(VCONTEXT)
LD (VCURRENT),HL
JP (IY)
;----------------------------------------------------------------
SETCONTEXT:
LD (VCONTEXT),DE
JP (IY)
;================================================================
NIF:
DB 'I','F' OR CLAST
DW RSQRBR-1
DB 2 OR IMM
IF:
DW DOCOMPILER,DOIF
DW HERE,GETBYTE
DB 2
DW ALLOT2
DW SEMIS
;================================================================
NWHILE:
DB 'WHIL','E' OR CLAST
DW IF-1
DB 5 OR IMM
WHILE:
DW DOCOMPILER,DOWHILE
DW ASSERT
DB 1 ;PRUEFWERT TESTEN
DW HERE,GETBYTE
DB 4
DW ALLOT2
DW SEMIS
;================================================================
NELSE:
DB 'ELS','E' OR CLAST
DW WHILE-1
DB 4 OR IMM
ELSE:
DW DOCOMPILER,DOELSE
DW ASSERT
DB 2 ;PRUEFWERT TESTEN
DW ALLOT2
DW DOFPATCH
DW HERE,TWOMINUS
DW GETBYTE
DB 2 ;PRUEFWERT SETZEN
DW SEMIS
;================================================================
NTHEN:
DB 'THE','N' OR CLAST
DW ELSE-1
DB 4 OR IMM
THEN:
DW DOCOMPILER,DOTHEN
DW ASSERT
DB 2 ;PRUEFWERT TESTEN
DW DOFPATCH
DW SEMIS
;================================================================
NBEGIN:
DB 'BEGI','N' OR CLAST
DW THEN-1
DB 5 OR IMM
BEGIN:
DW DOCOMPILER,DOBEGIN
DW HERE
DW GETBYTE
DB 1 ;PRUEFWERT SETZEN
DW SEMIS
;================================================================
DOFPATCH:
DW DOCOL
DW DUP,HERE,SWAP,MINUS
DW ONEMINUS,SWAP,EXCLAM ;SPRUNGADRESSE PATCHEN
DW SEMIS
;================================================================
DORPATCH:
DW DOCOL
DW HERE,MINUS,ONEMINUS
DW KOMMA ;SPRUNGADRESSE PATCHEN
DW SEMIS
;================================================================
NREPEAT:
DB 'REPEA','T' OR CLAST
DW BEGIN-1
DB 6 OR IMM
REPEAT:
DW DOCOMPILER,DOREPEAT
DW ASSERT
DB 4 ;PRUEFWERT TESTEN
DW SWAP
DW DORPATCH
DW DOFPATCH
DW SEMIS
;================================================================
NUNTIL:
DB 'UNTI','L' OR CLAST
DW REPEAT-1
DB 5 OR IMM
UNTIL:
DW DOCOMPILER,DOUNTIL
DW ASSERT
DB 1 ;PRUEFWERT TESTEN
DW DORPATCH
DW SEMIS
;================================================================
DB 2
DW NELSE-$-1
DOELSE:
DW FJUMP
;================================================================
DB 2
DW NREPEAT-$-1
DOREPEAT:
DW FJUMP
;================================================================
FJUMP:
POP HL
LD E,(HL)
INC HL
LD D,(HL) ;OFFSET HOLEN
OFFSJUMP:
ADD HL,DE
JP NEXTSUB ;NEUEN FORTH-ZEIGER SETZEN
;================================================================
DB 2
DW NIF-$-1
DOIF:
DW IF0JUMP
;================================================================
DB 2
DW NWHILE-$-1
DOWHILE:
DW IF0JUMP
;================================================================
DB 2
DW NUNTIL-$-1
DOUNTIL:
DW IF0JUMP
;----------------------------------------------------------------
IF0JUMP:
CALL PULLBC
LD A,B
OR C ;TEST AUF 0
EQUJUMP:
JR Z,FJUMP ;BEGINGUNG ERFUELLT ?
POP HL
INC HL
INC HL
JP NEXTSUB ;OFFSET UEBERSPRINGEN
;================================================================
DB 0
DW NBEGIN-$-1
DOBEGIN:
DW NEXT
;================================================================
DB 0
DW NTHEN-$-1
DOTHEN:
DW NEXT
;================================================================
NDO:
DB 'D','O' OR CLAST
DW UNTIL-1
DB 2 OR IMM
DO:
DW DOCOMPILER,DODO
DW HERE
DW GETBYTE
DB 3 ;PRUEFWERT SETZEN
DW SEMIS
;================================================================
NLOOP:
DB 'LOO','P' OR CLAST
DW DO-1
DB 4 OR IMM
LOOP:
DW DOCOMPILER,DOLOOP
LOOPGOON:
DW ASSERT
DB 3 ;PRUEFWERT TESTEN
DW DORPATCH
DW SEMIS
;================================================================
NPLUSLOOP:
DB '+LOO','P' OR CLAST
DW LOOP-1
DB 5 OR IMM
PLUSLOOP:
DW DOCOMPILER,DOPLUSLOOP
DW DOREPEAT,LOOPGOON-$-1
;================================================================
ASSERT:
DW $+2
RSTPULL
POP HL
LD A,(HL)
INC HL
PUSH HL ;PRUEFWERT
SUB E
OR D
JR Z,JNEXT4 ;GLEICH MIT WERT AUF STACK ?
RSTERR ERRBLK
;================================================================
DB 'I' OR CLAST
DW DEFINITIONS-1
DB 1
I:
DW $+2
POP BC
POP DE ;SCHLEIFENZAEHLER BZW. "R"
PUSH DE
PUSH BC
RSTPUSH
JP (IY)
;================================================================
DB 'I','''' OR CLAST
DW I-1
DB 2
ITICK:
DW $+2
LD HL,4 ;"R2" (SIEHE "I")
JR RGET
;================================================================
DB 'J' OR CLAST
DW ITICK-1
DB 1
J:
DW $+2
LD HL,6 ;"R3" (SIEHE "I")
RGET:
ADD HL,SP
LD E,(HL)
INC HL
LD D,(HL) ;ZAHL VOM RETURNSTACK HOLEN
RSTPUSH
JP (IY)
;================================================================
DB 'LEAV','E' OR CLAST
DW J-1
DB 5
LEAVE:
DW $+2
POP BC
POP HL
POP HL
PUSH HL
PUSH HL ;ZAEHLER GLEICH ENDWERT MACHEN
PUSH BC
JP (IY)
;================================================================
DB 0
DW NDO-$-1
DODO:
DW $+2
CALL PULLBC
RSTPULL
POP HL
PUSH DE
PUSH BC ;ZAEHLER UND ENDWERT MERKEN
PUSH HL
JNEXT4:
JP (IY)
;================================================================
DB 2
DW NLOOP-$-1
DOLOOP:
DW $+2
LD DE,1
JR LOOPADD
;================================================================
DB 2
DW NPLUSLOOP-$-1
DOPLUSLOOP:
DW $+2
RSTPULL
LOOPADD:
POP BC
POP HL ;ZAEHLER HOLEN
AND A
ADC HL,DE ;ERHOEHEN (??? UMSTAENDLICH)
LD A,D
POP DE ;ENDWERT HOLEN
SCF
JP PE,LOOPEND ;UEBERLAUF (= ENDE) ?
PUSH DE
PUSH HL ;WERTE WIEDER SPEICHERN
RLCA
JR NC,LOOPCMP
EX DE,HL
LOOPCMP:
CALL GREATER
CCF
JR NC,LOOPEND ;NOCH NICHT ENDE ?
POP HL
POP HL ;SCHLEIFENWERTE LOESCHEN
LOOPEND:
PUSH BC
SBC A,A
JP EQUJUMP
;================================================================
NLBRACKET:
DB '(' OR CLAST
DW LSQRBR-1
DB 1 OR IMM
LBRACKET:
DW DOCOMPILER,DOLBRACKET
DW GETBYTE
DB ')'
LBREND:
DW HERE,SWAP,ALLOT2,SAVETEXT
DW SWAP,EXCLAM ;TEXT SPEICHERN
DW SEMIS
;================================================================
DB -1
DW NLBRACKET-$-1
DOLBRACKET:
DW $+2
POP HL
LD E,(HL)
INC HL
LD D,(HL) ;OFFSET HOLEN
INC DE
JP OFFSJUMP
;================================================================
NPTSTR:
DB '.','"' OR CLAST
DW LBRACKET-1
DB 2 OR IMM
PTSTR:
DW DOCOMPILER,DOPTSTR
DW GETBYTE
DB '"'
DW DOREPEAT,LBREND-$-1
;================================================================
DB -1
DW NPTSTR-$-1
DOPTSTR:
DW $+2
POP DE
CALL TYPEDE ;STRING AUSGEBEN
PUSH DE
JP (IY)
;================================================================
SAVETEXT:
DW $+2
STLOOP:
RSTPULL
PUSH DE
CALL CWORD ;ENDE SUCHEN
LD H,D
LD L,E
ADD HL,BC
LD A,(HL)
POP HL
CP L
JR Z,STFND ;ENDE GEFUNDEN ?
EX DE,HL
RSTPUSH
LD DE,RETYPE
CALL EXECDE
JR STLOOP ;NOCHMAL PROBIEREN
STFND:
PUSH DE
PUSH BC
LD HL,(STKBOT) ;GRENZE GEGEN SPARE
CALL ALLOC ;SPEICHER HOLEN
POP BC
POP DE
PUSH DE
PUSH BC
EX DE,HL
LDIR ;TEXT UMSPEICHERN
POP BC
LD D,B
LD E,C
RSTPUSH
POP DE
CALL BLWORD ;EINGABE LOESCHEN
JP (IY)
;================================================================
DB '[' OR CLAST
DW PLUSLOOP-1
DB 1 OR IMM
LSQRBR:
DW $+2
RES 6,(IX+FLAGS-MEMBEG) ;COMPILER AUSSCHALTEN
JP (IY)
;================================================================
DB ']' OR CLAST
DW LEAVE-1
DB 1
RSQRBR:
DW $+2
SET 6,(IX+FLAGS-MEMBEG) ;COMPILER EINSCHALTEN
JP (IY)
;================================================================
DB 'EXI','T' OR CLAST
DW PTSTR-1
DB 4
EXIT:
DW RSEMIS
;================================================================
RDONAME EQU 0 ;ZEIGER AUF NAME ALTES WORT
RDOCODE EQU 2 ;ZEIGER AUF CODEFELD ALTES WORTES
RDNCODE EQU 4 ;ZEIGER AUF CODEFELD NEUES WORT
RDDNAME EQU 4 ;NAMENSLAENGENDIFFERENZ
RDNRUN EQU 6 ;0 / RUN-ADRESSE NEUES WORT
RDOEND EQU 8 ;ZEIGER HINTER ALTES WORT
RDNEND EQU 10 ;ZEIGER HINTER NEUES WORT
RDDLEN EQU 10 ;LAENGENDIFFERENZ
RDNNAME EQU 12 ;ZEIGER AUF NAME NEUES WORT
;================================================================
DB 'REDEFIN','E' OR CLAST
DW EXIT-1
DB 8
REDEFINE:
DW $+2
CALL LINKHERE
LD HL,(VCURRENT)
LD E,(HL)
INC HL
LD D,(HL)
EX DE,HL
INC HL
LD (PADMEM+RDNCODE),HL ;CODEFELD NEUES WORT
PUSH HL
CALL PTR2ADDR
LD (PADMEM+RDNNAME),HL
LD (PADMEM+RDNRUN),BC
LD (PADMEM+RDNEND),DE ;ADRESSEN HOLEN
LD HL,(STKBOT)
SBC HL,DE
JP NZ,DICTERR ;NICHT NEUESTES WORT ?
POP DE
RSTPUSH ;UMZUDEFINIERENDES WORT
CALL NEXT
DW RESCURR,FIND,SEMICODE
RSTPULL ;CODEFELD-ADR. DES ALTEN WORTES
LD HL,-FREEMEM
ADD HL,DE
JP NC,REDEFABORT ;WORT NICHT IM RAM ?
EX DE,HL
LD (PADMEM+RDOCODE),HL
CALL PTR2ADDR ;ADRESSEN HOLEN
LD (PADMEM+RDONAME),HL
PUSH HL ;(SIEHE UNTEN !!!)
LD (PADMEM+RDOEND),DE
LD A,B
OR C
LD DE,(PADMEM+RDNRUN)
JR Z,RDGOON1 ;ALT OHNE SPEZIELLEN RUN-TEIL ?
LD A,D
OR E
JR Z,REDEFABORT ;NEU OHNE SPEZIELLEN RUN-TEIL ?
RDGOON1:
POP HL
LD BC,(PADMEM+RDNNAME)
SBC HL,BC
EX DE,HL
ADD HL,DE
LD (PADMEM+RDNRUN),HL ;RUN-ADRESSE KORRIGIEREN
LD HL,(PADMEM+RDNEND)
ADD HL,DE
LD BC,(PADMEM+RDOEND)
AND A
SBC HL,BC
LD (PADMEM+RDDLEN),HL ;LAENGENDIFF. BERECHNEN
LD BC,46
ADD HL,BC
BIT 7,H
JR NZ,RDGOON2 ;UM MINDESTENS 47 BYTE KLEINER ?
LD BC,(SPARE)
ADD HL,BC
JR C,REDEFABORT
SBC HL,SP
JR NC,REDEFABORT ;ZUWENIG SPEICHER ?
RDGOON2:
LD HL,(PADMEM+RDOCODE)
PUSH HL
DEC HL
DEC HL
LD B,(HL)
DEC HL
LD C,(HL)
LD HL,(PADMEM+RDNCODE)
PUSH HL
DEC HL
DEC HL
LD (HL),B
DEC HL
LD (HL),C ;WORT-VERKETTUNG HERSTELLEN
POP HL
ADD HL,DE
POP BC
AND A
SBC HL,BC
LD (PADMEM+RDDNAME),HL ;NAMENSLAENGENDIFF. BER.
LD DE,(PADMEM+RDONAME)
LD HL,(PADMEM+RDOEND)
AND A
SBC HL,DE
LD B,H
LD C,L
PUSH DE
PUSH BC
CALL DELWORD ;ALTES WORT LOESCHEN
LD HL,(PADMEM+RDDLEN)
POP BC
ADD HL,BC
LD B,H
LD C,L
POP HL
PUSH BC
CALL ALLOC ;SPEICHER FUER NEUES WORT HOLEN
EX DE,HL
LD HL,(PADMEM+RDNNAME)
LD BC,(PADMEM+RDDLEN)
ADD HL,BC ;STARTADRESSE KORRIGIEREN
POP BC
PUSH BC
PUSH HL
LDIR ;NEUES WORT KOPIEREN
POP DE
POP BC
CALL DELWORD ;ORIGINAL LOESCHEN
CALL CORRCURR ;ZEIGER KORRIGIEREN
JP (IY)
REDEFABORT:
LD HL,(VCURRENT)
LD DE,(PADMEM+RDNCODE)
DEC DE
LD (HL),E
INC HL
LD (HL),D ;CURRENT DICTIONARY SETZEN
DICTERR:
RSTERR ERRDICT
;================================================================
DELWORD:
LD HL,(STKBOT)
AND A
SBC HL,BC
LD (STKBOT),HL ;HERE ERNIEDRIGEN
LD HL,(SPARE)
SBC HL,BC
LD (SPARE),HL ;SPARE ERNIEDRIGEN
SBC HL,DE
RET Z ;WAR SCHON LETZTES WORT ?
PUSH BC
LD B,H
LD C,L
POP HL
ADD HL,DE
LDIR ;REST VERSCHIEBEN
RET
;----------------------------------------------------------------
CORRCURR:
LD BC,VCURRENT
CALL CORRPTR
CALL CORRPTR ;ZEIGER FUER CURRENT KORRIGIEREN
LD BC,DICT1ST
CORRDICT:
LD HL,(STKBOT)
SCF
SBC HL,BC
RET C ;AM ENDE ANGEKOMMEN ?
CDLOOP:
LD A,(BC)
RLA
INC BC
JR NC,CDLOOP ;NAMEN UEBERSPRINGEN
INC BC
INC BC
CALL CORRPTR ;END-ADRESSE KORRIGIEREN
INC BC
CALL CORRPTR ;ERSTES WORT DES DICT.
CALL JUMPDE
DW DOCOL
DB CDCOLON-$
DW DODEFINER
DB CDDEFCOM-$
DW DOCOMPILER
DB CDDEFCOM-$
DW SETCONTEXT
DB CDSETCTXT-$
DW 0
LD HL,-7
ADD HL,BC
LD C,(HL)
INC HL
LD B,(HL)
DEC HL
ADD HL,BC ;LINK AUF VORHERIGES DICT.
LD B,H
LD C,L
JR CORRDICT
CDDEFCOM:
CALL CORRPTR
CDCOLON:
CALL CORRWORD
JR CORRDICT
CDSETCTXT:
CALL CORRPTR
INC BC
CALL CORRPTR
JR CORRDICT
;----------------------------------------------------------------
CORRWORD:
CALL CORRPTR
LD HL,SEMIS
AND A
SBC HL,DE
RET Z ;FORTH-WORTENDE GEFUNDEN ?
CALL SKIPOFFS
JR CORRWORD
;----------------------------------------------------------------
CORRPTR:
LD A,(BC)
LD E,A
INC BC
LD A,(BC)
LD D,A
DEC BC ;ADRESSE HOLEN
CALL CORRADDR
EX DE,HL
LD A,E
LD (BC),A
INC BC
LD A,D
LD (BC),A ;KORRIGIERT SPEICHERN
INC BC
RET
;----------------------------------------------------------------
CORRADDR:
LD HL,(PADMEM+RDONAME)
AND A
SBC HL,DE
LD H,D
LD L,E
RET NC ;AELTERES WORT => KEINE ANPASSUNG
LD HL,(PADMEM+RDOEND)
SBC HL,DE
JR NC,CAWORD ;UMDEFINIERTES WORT ?
LD HL,(PADMEM+RDNNAME)
SBC HL,DE
JR C,CADICT ;ANDERES DICTIONARY ?
LD HL,(PADMEM+RDDLEN)
ADD HL,DE
RET ;NEUER => UM DIFFERENZ ANPASSEN
CAWORD:
LD HL,(PADMEM+RDOCODE)
SBC HL,DE
LD HL,(PADMEM+RDNRUN)
RET C ;MIT RUN-TEIL => NEUE ADRESSE
LD HL,(PADMEM+RDDNAME)
ADD HL,DE
RET ;UM NAMENSDIFFERENZ ANPASSEN
CADICT:
LD HL,(PADMEM+RDONAME)
ADD HL,DE
LD DE,(PADMEM+RDNNAME)
AND A
SBC HL,DE
RET ;UM LAENGENDIFFERENZ ANPASSEN
;----------------------------------------------------------------
SKIPOFFS:
DEC DE
LD A,(DE)
RLA
RET NC ;NORMALES FORTH-WORT ?
SKOFFS2:
DEC DE
DEC DE
LD A,(DE) ;OFFSET HOLEN
LD L,A
LD H,0
INC A
JR NZ,SKOGOON ;OFFSET-BYTE GUELTIG ?
LD A,(BC)
LD L,A
INC BC
LD A,(BC)
LD H,A
INC BC ;OFFSET IM CODE HOLEN
SKOGOON:
ADD HL,BC
LD B,H
LD C,L ;NEUE ADRESSE MERKEN
RET
;----------------------------------------------------------------
NFA:
DW $+2
RSTPULL
EX DE,HL
CALL FPTR2NAME
EX DE,HL
RSTPUSH
JP (IY)
;----------------------------------------------------------------
PTR2ADDR:
PUSH HL
LD E,(HL)
INC HL
LD D,(HL) ;ERSTE WORTADRESSE HOLEN
CALL JUMPDE
DW DOCOMPILER
DB P2ARUN-$
DW DODEFINER
DB P2ARUN-$
DW 0
LD BC,0 ;KEIN SPEZIELLER RUN-TEIL
JR P2AGOON
P2ARUN:
POP HL
PUSH HL
INC HL
INC HL
LD C,(HL)
INC HL
LD B,(HL) ;RUNTIME-ADRESSE HOLEN
P2AGOON:
POP HL
PUSH HL
DEC HL
DEC HL
DEC HL
DEC HL
LD D,(HL)
DEC HL
LD E,(HL)
ADD HL,DE
EX DE,HL ;ZEIGER HINTER WORT BERECHNEN
POP HL
;----------------------------------------------------------------
FPTR2NAME:
DEC HL
PTR2NAME:
LD A,H
CP MEMBEG SHR 8
LD A,(HL)
RES 6,A ;IMMEDIATE-BIT LOESCHEN
JR C,P2NGOON
ADD A,2 ;BEI WORTEN IM RAM MEHR
P2NGOON:
DEC HL
DEC HL ;VERKETTUNGSZEIGER UEBERSPRINGEN
P2NLOOP:
DEC HL
DEC A
JR NZ,P2NLOOP ;AUF NAMENSANFANG ZEIGEN
RET
;===============================================================
JDELOOP:
INC HL ;OFFSET UEBERSPRINGEN
PUSH HL
JUMPDE:
POP HL
LD A,(HL)
INC HL
PUSH HL
LD H,(HL)
LD L,A ;NAECHSTEN ZEIGER HOLEN
OR H
RET Z ;0 ? (HRM-HRM, AUF "NOP" !!!)
SBC HL,DE
POP HL
INC HL
JR NZ,JDELOOP ;ZEIGER NICHT ERREICHT ?
PUSH DE
LD D,0
LD E,(HL) ;OFFSET HOLEN
ADD HL,DE
POP DE
JP (HL) ;CODE ANSPRINGEN
;================================================================
RESCURR:
DW DOCOL
DW ONEMINUS,TWOMINUS,AT
DW CURRENT,AT,EXCLAM ;CURRENT ZURUECKSETZEN
DW SEMIS
;================================================================
FINDWORD:
CALL NEXT
DW FIND
DW SEMICODE
RSTPULL ;ADRESSE DES CODE-FELDS
LD HL,-FREEMEM
ADD HL,DE
RET C ;WORT GEFUNDEN ?
RSTERR ERRFIND
;================================================================
DB 'FORGE','T' OR CLAST
DW REDEFINE-1
DB 6
FORGET:
DW $+2
LD HL,(VCURRENT)
LD DE,(VCONTEXT)
AND A
SBC HL,DE
JP NZ,DICTERR ;VERSCHIEDENE DICTIONARIES ?
CALL FINDWORD
LD HL,-5
ADD HL,DE
LD (DICT),HL
SET 2,(IX+FLAGS-MEMBEG) ;COMPILE-MODE EINSCHALTEN
RSTERR ERRNONE
;================================================================
DB 'EDI','T' OR CLAST
DW FORGET-1
DB 4
EDIT:
DW $+2
CALL FINDWORD
SET 3,(IX+FLAGS-MEMBEG) ;"EDIT" MERKEN
JR EDITLIST
;================================================================
DB 'LIS','T' OR CLAST
DW EDIT-1
DB 4
LIST:
DW $+2
CALL FINDWORD
;----------------------------------------------------------------
EDITLIST:
LD A,CCR
RSTEMIT
BIT 3,(IX+FLAGS-MEMBEG)
PUSH DE
CALL NZ,DCCLEAR ;"EDIT" ?
POP BC
LD A,(BC)
LD E,A
INC BC
LD A,(BC)
LD D,A
DEC BC
CALL JUMPDE
DW DOCOL
DB ELCOLON-$
DW DOCOMPILER
DB ELCOMPILER-$
DW DODEFINER
DB ELDEFINER-$
DW 0
RSTERR ERRLIST
;----------------------------------------------------------------
ELCOLON:
LD HL,2
JR ELOUT
;----------------------------------------------------------------
ELCOMPILER:
PUSH DE
LD HL,2
ADD HL,BC
LD A,(HL)
INC HL
LD H,(HL)
LD L,A ;ADRESSE HINTER "DOCOMPILER"
DEC HL
DEC HL
DEC HL
LD L,(HL)
LD A,L
RLCA
SBC A,A
LD H,A ;CODEBYTE (???) AUF 16 BIT
CALL PNTHL
POP DE
;----------------------------------------------------------------
ELDEFINER:
LD HL,4
;----------------------------------------------------------------
ELOUT:
ADD HL,BC
PUSH HL
PUSH BC
CALL OUTWORD ;":" ETC. AUSGEBEN
POP DE
POP BC
CALL OUTWORD ;NAMEN AUSGEBEN
LD (IX+LPIBUF-MEMBEG),1 ;1 ZEICHEN EINRUECKEN
ELMLOOP:
LD (IX+LPLCNT-MEMBEG),16 ;16 ZEILEN
ELLLOOP:
CALL LISTPGM
JR C,ELREADY ;WORT FERTIG GELISTET ?
DEC (IX+LPLCNT-MEMBEG)
JP P,ELLLOOP ;NOCH NICHT ALLE ZEILEN BENUTZT ?
ELREADY:
BIT 3,(IX+FLAGS-MEMBEG)
JR NZ,ELEDIT ;"EDIT" ?
JR C,ELQUIT ;WORT FERTIG GELISTET ?
LD HL,KEYCOD
LD (HL),0
ELACK:
LD A,(HL)
AND A
JR Z,ELACK ;AUF BESTAETIGUNG WARTEN
CALL USERBREAK
JR ELMLOOP ;WEITERMACHEN
ELEDIT:
PUSH AF
RES 3,(IX+FLAGS-MEMBEG) ;KURZ KEIN "EDIT"
PUSH BC
CALL NEXT
DW RETYPE,LINE
DW SEMICODE ;EDITIEREN
SET 3,(IX+FLAGS-MEMBEG) ;WIEDER "EDIT"
CALL DCCLEAR
POP BC
POP AF
JR NC,ELMLOOP ;WORT NICHT FERTIG GELISTET ?
ELQUIT:
RES 3,(IX+FLAGS-MEMBEG) ;KEIN "EDIT" MEHR
JP (IY)
;----------------------------------------------------------------
LISTPGM:
LD A,(LPIBUF)
LD (LPIACT),A ;EINRUECKUNG HOLEN
LD (IX+LPICNT-MEMBEG),5 ;ERSTMAL 5 WORTE
LPLOOP:
LD A,(BC)
LD E,A
INC BC
LD A,(BC)
LD D,A
INC BC
CALL JUMPDE ;NAECHSTES WORT HOLEN
DW DOIF
DB LPIINC-$
DW DOELSE
DB LPILEFT-$
DW DOTHEN
DB LPIDEC-$
DW DOBEGIN
DB LPIINC-$
DW DOUNTIL
DB LPIDEC-$
DW DOWHILE
DB LPILEFT-$
DW DOREPEAT
DB LPIDEC-$
DW DODO
DB LPIINC-$
DW DOLOOP
DB LPIDEC-$
DW DOPLUSLOOP
DB LPIDEC-$
DW DODOESGT
DB LPILEFT-$
DW DORUNSGT
DB LPILEFT-$
DW GETWORD
DB LPWORD-$
DW GETFLOAT
DB LPFLOAT-$
DW GETBYTE
DB LPBYTE-$
DW DOLBRACKET
DB LPLBRACKET-$
DW DOPTSTR
DB LPPTSTR-$
DW SEMIS
DB LPSEMIS-$
DW 0
LPOUT:
CALL OUTWORDI
LPNEXT:
DEC (IX+LPICNT-MEMBEG)
JR NZ,LPLOOP ;WORTZAHL BEGRENZEN
AND A ;WORT NOCH NICHT FERTIG GELISTET
RET
LPIINC:
LD HL,(LPIBUF)
LD H,L
INC L ;DEMNAECHST MEHR EINRUECKEN
JR LPINDENT
LPILEFT:
LD HL,(LPIBUF)
LD H,L
DEC H ;EINMAL WENIGER EINRUECKEN
JR LPINDENT
LPIDEC:
LD HL,(LPIBUF)
DEC L
LD H,L ;JETZT WENIGER EINRUECKEN
LPINDENT:
LD (LPIBUF),HL
LD (IX+LPICNT-MEMBEG),1 ;NUR NOCH DIESES WORT
DEC (IX+LPLCNT-MEMBEG) ;ZEILE FERTIG
JR LPOUT
LPWORD:
CALL LPNXTWRD
RSTPUSH
LD DE,PNT
LPNUMBER:
CALL OUTINDENT
CALL EXECDE ;ZAHL AUSGEBEN
JR LPNEXT
LPFLOAT:
CALL LPNXTWRD
RSTPUSH
CALL LPNXTWRD
RSTPUSH
LD DE,FPNT
JR LPNUMBER
LPBYTE:
LD A,(BC)
PUSH AF
CALL OUTWORDI
POP AF
RSTEMIT
LD A,' '
RSTEMIT
JR LPNEXT
LPSEMIS:
CALL ROMTXT
DB CCR,';',CCR OR CLAST
SCF ;WORT FERTIG GELISTET
RET
LPLBRACKET:
LD A,')'
JR LPSTRING
LPPTSTR:
LD A,'"'
LPSTRING:
PUSH AF
PUSH BC
CALL OUTWORDI
POP DE
CALL TYPEDE ;ZEICHENKETTE AUSGEBEN
LD B,D
LD C,E
POP AF
RSTEMIT ;GRENZZEICHEN AUSGEBEN
AND A ;WORT NOCH NICHT FERTIG GELISTET
RET
;----------------------------------------------------------------
OUTINDENT:
LD A,(LPIACT)
AND A
RET M ;KEINE NEUE ZEILE & EINRUECKUNG ?
PUSH BC
LD B,A
LD A,CCR
RSTEMIT
INC B
DEC B
JR Z,OIQUIT ;EINRUECKUNG = 0 ?
OILOOP:
LD A,' '
RSTEMIT
DJNZ OILOOP ;EINRUECKUNG AUSGEBEN
OIQUIT:
LD (IX+LPIACT-MEMBEG),-1 ;KEINE EINRUECKUNG MEHR
POP BC
RET
;----------------------------------------------------------------
LPNXTWRD:
LD A,(BC)
LD E,A
INC BC
LD A,(BC)
LD D,A
INC BC ;NAECHSTES WORT HOLEN
RET
;----------------------------------------------------------------
OUTWORDI:
CALL OUTINDENT
OUTWORD:
EX DE,HL
DEC HL
LD A,(HL)
BIT 7,A
JR NZ,OWDOXX ;KEIN NORMALES FORTH-WORT ?
CALL PTR2NAME
JR OUTTXT
OWDOXX:
EX DE,HL
CALL SKOFFS2
INC DE
LD A,(DE)
LD L,A
INC DE
LD A,(DE)
LD H,A
ADD HL,DE ;ZEIGER AUF NAMEN
OUTTXT:
LD A,(HL)
AND 7FH ;ZEICHEN HOLEN
RSTEMIT
BIT 7,(HL)
INC HL
JR Z,OUTTXT ;NOCH NICHT ENDE ?
LD A,' '
RSTEMIT
RET
;----------------------------------------------------------------
ROMTXT:
EX (SP),HL ;ZEIGER HOLEN
CALL OUTTXT
EX (SP),HL ;RUECKSPRUNG SETZEN
RET
;================================================================
PNTHL:
LD DE,PNT
PUSH DE
EX DE,HL
RSTPUSH
POP DE
;----------------------------------------------------------------
EXECDE:
PUSH BC
CALL NEXTDE
DW $+2
DW $+2
POP BC
POP BC
RET
;================================================================
TXALL:
PUSH IY
PUSH HL
POP IY ;ADRESSE HOLEN
LD HL,TXRXQUIT
PUSH HL ;RUECKSPRUNG SETZEN
LD HL,-2000H
BIT 7,C
JR Z,TAGOON1 ;LANGER VORSPANN ?
LD H,-0400H SHR 8
TAGOON1:
INC DE
DEC IY ;ZEIGER UND ANZAHL KORRIGIEREN
DI
XOR A ;VORBEREITEN
TALOOP1:
LD B,151
TADEL1:
DJNZ TADEL1 ;LANGE WARTEN
OUT (IO),A ;PEGEL WECHSELN
XOR 8
INC L
JR NZ,TAGOON2
INC H
TAGOON2:
JR NZ,TALOOP1 ;VORSPANN SENDEN
LD B,43
TADEL2:
DJNZ TADEL2 ;KURZ WARTEN
OUT (IO),A ;PEGEL = 0
LD L,C ;STARTBYTE HOLEN
LD BC,8 + (59 SHL 8)
TADEL3:
DJNZ TADEL3 ;KURZ WARTEN
LD A,C
OUT (IO),A ;PEGEL = 1
LD B,56
JP TASTART
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
TALOOP2:
LD A,C ;PEGEL 1 HOLEN
BIT 7,B ;Z SETZEN
TADEL4:
DJNZ TADEL4 ;KURZ WARTEN
JR NC,TABIT0 ;BIT = 0 ?
LD B,61
TADEL5:
DJNZ TADEL5 ;KURZ WARTEN
TABIT0:
OUT (IO),A ;PEGEL SETZEN
LD B,58
JP NZ,TALOOP2 ;ERSTE BITHAELFTE GESENDET ?
DEC B ;ZYKLEN-KORREKTUR
XOR A ;PEGEL 0 HOLEN
TANEXT:
RL L
JP NZ,TADEL4 ;NOCH NICHT 8 BITS GESENDET ?
DEC DE ;ANZAHL ERNIEDRIGEN
INC IY ;ZEIGER ERHOEHEN
LD B,46
LD A,7FH
IN A,(IO)
RRA
RET NC ;BENUTZER-ABBRUCH ?
LD A,D
CP 0FFH
RET NC ;PRUEFZAHL GESENDET ?
OR E
JR Z,TAEND ;ALLE BYTES GESENDET ?
LD L,(IY+0) ;NAECHSTES BYTE HOLEN
TACHECK:
LD A,H
XOR L
LD H,A ;PRUEFSUMME BILDEN
TASTART:
XOR A
SCF ;FUER DIE BIT-ANZAHL
JP TANEXT
TAEND:
LD L,H ;PRUEFSUMME SENDEN
JR TACHECK
;----------------------------------------------------------------
TXRXQUIT:
POP IY
EX AF,AF'
LD B,59
TRQDEL6:
DJNZ TRQDEL6 ;KURZ WARTEN
XOR A
OUT (IO),A ;PEGEL = 0
LD A,7FH
IN A,(IO)
RRA
EI
JP NC,BREAK ;BENUTZER-ABBRUCH ?
EX AF,AF'
RET
;----------------------------------------------------------------
RXALL:
DI
PUSH IY
PUSH HL
POP IY ;ZEIGER HOLEN
LD HL,TXRXQUIT
PUSH HL ;RUECKSPRUNG SETZEN
LD H,C ;STARTBYTE MERKEN
EX AF,AF' ;READ/VERIFY-FLAG MERKEN
XOR A
LD C,A ;BISHER 0-PEGEL
RASYNC:
RET NZ ;BENUTZER-ABBRUCH ?
RALOOP1:
LD L,0
RALOOP2:
LD B,-72
CALL RXBIT
JR NC,RASYNC ;ABBRUCH ?
LD A,-33
CP B
JR NC,RALOOP1 ;KEIN SYNC-ZEICHEN ?
INC L
JR NZ,RALOOP2 ;NOCH KEINE 256 SYNC-ZEICHEN ?
RALOOP3:
LD B,-49
CALL RXLEVEL
JR NC,RASYNC ;ABBRUCH ?
LD A,B
CP -40
JR NC,RALOOP3 ;NOCH SYNC-ZEICHEN ?
CALL RXLEVEL
RET NC ;ABBRUCH ?
CALL RXBYTE
RET NC ;ABBRUCH ?
CCF
RET NZ ;ERSTES BYTE FALSCH ?
JR RASTART
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
RALOOP:
EX AF,AF'
JR NC,RAVERIFY ;NUR VERGLEICHEN ?
LD (IY+0),L ;BYTE SPEICHERN
JR RAGOON
RAVERIFY:
LD A,(IY+0)
XOR L
RET NZ ;BYTE UNGLEICH ?
RAGOON:
INC IY ;ZEIGER ERHOEHEN
DEC DE ;ANZAHL ERNIEDRIGEN
EX AF,AF'
RASTART:
CALL RXBYTE
RET NC ;ABBRUCH ?
LD A,D
OR E
JR NZ,RALOOP ;ANZAHL NOCH NICHT EMPFANGEN ?
LD A,H
CP 1 ;C SETZEN, WENN PRUEFSUMME OK
RETURN:
RET
;----------------------------------------------------------------
RXBYTE:
LD L,1 ;FUER DIE BIT-ANZAHL
RB8LOOP:
LD B,-57
CALL RXBIT
RET NC ;ABBRUCH ?
LD A,-30
CP B ;LANGE ZEIT = 1-BIT
RL L
JP NC,RB8LOOP ;NOCH NICHT 8 BITS ?
LD A,H
XOR L
LD H,A ;PRUEFSUMME BILDEN
SCF ;BYTE EMPFANGEN
RET
;----------------------------------------------------------------
RXBIT:
CALL RXLEVEL
RET NC ;ABBRUCH ?
RXLEVEL:
LD A,20
RBDELAY:
DEC A
JR NZ,RBDELAY ;KURZ WARTEN
AND A ;C LOESCHEN
RBLOOP:
INC B
RET Z ;TIMEOUT ?
LD A,7FH
IN A,(IO)
RRA
RET NC ;BENUTZER-ABBRUCH ?
XOR C
AND 020H SHR 1
JR Z,RBLOOP ;PEGEL GLEICH ?
LD A,C
CPL
LD C,A ;PEGEL MERKEN
SCF ;ALLES OK
RET
;================================================================
FFLAG EQU 0 ;00/FF = WOERTERBUCH / BINAERDATEI
FNLEN EQU 1 ;NAMENSLAENGE
; 2 ;DATEINAME
FLEN EQU 11 ;ANZAHL BYTES
FSTART EQU 13 ;STARTADRESSE
FDICT EQU 15 ;DICTIONARY
FCURR EQU 17 ;VCURRENT
; 19 ;VCONTEXT
; 21 ;VOCLNK
; 23 ;STKBOT
FSIZE EQU 25 ;GROESSE DIESES BLOCKS
;================================================================
DB 'SAV','E' OR CLAST
DW LIST-1
DB 4
SAVE:
DW DOCOL
DW FILEFHEAD,DOSAVE
DW SEMIS
;================================================================
DB 'BSAV','E' OR CLAST
DW SAVE-1
DB 5
BSAVE:
DW DOCOL
DW FILEBHEAD,DOSAVE
DW SEMIS
;================================================================
DB 'BLOA','D' OR CLAST
DW BSAVE-1
DB 5
BLOAD:
DW DOCOL
DW FILEBHEAD,READHEADER,DOBLOAD
DW SEMIS
;================================================================
DB 'VERIF','Y' OR CLAST
DW BLOAD-1
DB 6
VERIFY:
DW DOCOL
DW FILEFHEAD
DW DOELSE,DOVERIFY-$-1
;================================================================
DB 'BVERIF','Y' OR CLAST
DW VERIFY-1
DB 7
BVERIFY:
DW DOCOL
DW FILEBHEAD
DOVERIFY:
DW READHEADER,DOBVERIFY
DW SEMIS
;================================================================
DB 'LOA','D' OR CLAST
DW BVERIFY-1
DB 4
LOAD:
DW DOCOL
DW FILEFHEAD
DW SEMICODE
LD HL,(STKBOT)
LD (FPADMEM+FSTART),HL ;START
EX DE,HL
LD HL,-52
ADD HL,SP
AND A
SBC HL,DE
LD (FPADMEM+FLEN),HL ;GROESSE FREIER SPEICHER
CALL NEXT
DW READHEADER,DOBLOAD
DW SEMICODE
LD BC,(STKBOT)
LD HL,FREEMEM-1
LD (PADMEM+RDONAME),HL
INC HL
LD (PADMEM+RDOEND),HL ;KORREKTUR VORBEREITEN
LD HL,(FPADMEM+FSIZE+FLEN)
ADD HL,BC
LD (STKBOT),HL ;SPEICHER BELEGEN
LD HL,-FREEMEM
ADD HL,BC
LD (PADMEM+RDDLEN),HL
LD DE,(FPADMEM+FSIZE+FDICT)
ADD HL,DE
LD DE,(FORTH+2+RAMVAR-ROMVAR)
LD (FORTH+2+RAMVAR-ROMVAR),HL ;NEUES ENDE
PUSH BC
PUSH DE
LD (PADMEM+RDNNAME),SP
CALL CORRDICT ;GELADENES DICT. EINBINDEN
POP BC
POP HL
LDNLOOP:
BIT 7,(HL)
INC HL
JR Z,LDNLOOP ;NAMEN UEBERSPRINGEN
INC HL
INC HL
LD (HL),C
INC HL
LD (HL),B ;LAENGE DES DICT.S SPEICHERN
LD HL,(STKBOT)
LD BC,SAFETY
ADD HL,BC
LD (SPARE),HL ;PARAMETER-STACK SETZEN
JP (IY)
;================================================================
FILENAME:
DW DOCOL
DW GETBYTE
DB ' '
DW WORD
DW SEMICODE ;NAMEN HOLEN
CALL LINKHERE
RSTPULL
LD A,' '
LD (DE),A ;NAMENSLAENGE DURCH ' ' ERSETZEN
LD DE,PADMEM+FLEN
LD HL,SCRMEND-1
CALL BLANKS ;PUFFER LOESCHEN
JP (IY)
;================================================================
SEMICODE:
DW RETURN
;================================================================
FILEFHEAD:
DW DOCOL
DW FILENAME
DW SEMICODE
XOR A
LD (FPADMEM+FFLAG),A
LD HL,FREEMEM
LD (FPADMEM+FSTART),HL
EX DE,HL
LD HL,(STKBOT)
AND A
SBC HL,DE
LD (FPADMEM+FLEN),HL
LD HL,(FORTH+2+RAMVAR-ROMVAR)
LD (FPADMEM+FDICT),HL
LD HL,VCURRENT
LD DE,FPADMEM+FCURR
LD BC,8
LDIR ;HEADER VORBEREITEN
JP (IY)
;================================================================
FILEBHEAD:
DW DOCOL
DW FILENAME
DW GETWORD,FPADMEM+FLEN,EXCLAM
DW GETWORD,FPADMEM+FSTART,EXCLAM
DW SEMIS
;================================================================
DOSAVE:
DW $+2
LD A,(FPADMEM+FNLEN)
AND A
JR Z,RXERROR ;KEIN NAME ?
LD HL,(FPADMEM+FLEN)
LD A,H
OR L
JR Z,RXERROR ;LAENGE = 0 ?
PUSH HL
LD DE,25
LD HL,FPADMEM+FFLAG
LD C,D
CALL TXALL ;HEADER SENDEN
POP DE
LD HL,(FPADMEM+FSTART)
LD C,-1
CALL TXALL ;DATEN SENDEN
JP (IY)
;----------------------------------------------------------------
READHEADER:
DW $+2
RHLOOP:
LD DE,25
LD HL,FPADMEM+FSIZE+FFLAG
LD C,D
SCF
CALL RXALL ;HEADER LESEN
JR NC,RHLOOP ;NOCH NICHT OK ?
LD DE,FPADMEM+FSIZE+FFLAG
LD A,(DE)
AND A
JR NZ,RHBINARY ;BINAER-DATEI ?
CALL ROMTXT
DB CCR,'Dict',':' OR CLAST
JR RHCHECK
RHBINARY:
CALL ROMTXT
DB CCR,'Bytes',':' OR CLAST
RHCHECK:
LD HL,FPADMEM+FFLAG
LD BC,11 + (11 SHL 8)
JR RHCSTART
RHCLOOP:
LD A,(DE)
RSTEMIT ;NAMEN AUSGEBEN
RHCSTART:
LD A,(DE)
CP (HL)
JR NZ,RHCNEXT ;ZEICHEN UNGLEICH ?
DEC C
RHCNEXT:
INC HL
INC DE
DJNZ RHCLOOP ;NOCH NICHT ALLE ZEICHEN ?
JR NZ,RHLOOP ;NAME UNGLEICH ?
JP (IY)
;----------------------------------------------------------------
RXERROR:
RSTERR ERRREAD
;----------------------------------------------------------------
DOBLOAD:
DW $+2
LD B,-1 ;LESEN
JR DOBREAD
;----------------------------------------------------------------
DOBVERIFY:
DW $+2
LD HL,FPADMEM+FCURR
LD DE,FPADMEM+FSIZE+FCURR
LD B,8
DBVLOOP:
LD A,(DE)
INC DE
CP (HL)
INC HL
JR NZ,RXERROR
DJNZ DBVLOOP ;VARIABLEN VERGLEICHEN
DOBREAD:
LD HL,(FPADMEM+FLEN)
LD DE,(FPADMEM+FSIZE+FLEN)
LD A,H
OR L
JR Z,DBRGOON1 ;LAENGE NICHT TESTEN ?
SBC HL,DE
JR C,RXERROR
DBRGOON1:
LD HL,(FPADMEM+FSTART)
LD A,H
OR L
JR NZ,DBRGOON2 ;STARTADRESSE UEBERNEHMEN ?
LD HL,(FPADMEM+FSIZE+FSTART)
DBRGOON2:
LD C,-1
RR B ;READ/VERIFY-FLAG HOLEN
CALL RXALL ;DATEN LESEN
JR NC,RXERROR ;ABBRUCH ?
JP (IY)
;================================================================
FEXP1 EQU 0 ;EXPONENT OBERE ZAHL / ERGEBNIS
FEXP2 EQU 1 ;EXPONENT UNTERE ZAHL
FSGN EQU 2 ;VORZEICHEN 7=UNTEN 6=OBEN
FACCU EQU 3 ;AKKUMULATOR
FQUO EQU 7 ;QUOTIENT
FDIVOR EQU 16 ;DIVISOR
;================================================================
FINIT:
LD BC,FPWS+FDIVOR-1
XOR A
FICLEAR:
LD (BC),A
DEC C ;(ETWAS UNSAUBER!!!)
JR NZ,FICLEAR ;PUFFER LOESCHEN
LD HL,(SPARE)
LD DE,-4
DEC HL
LD C,(HL) ;EXPONENT OBERE ZAHL MERKEN
LD (HL),A ; UND LOESCHEN
ADD HL,DE
INC HL
LD (SPARE),HL ;"TOS" LOESCHEN
DEC HL
LD B,(HL) ;EXPONENT UNTERE ZAHL MERKEN
LD (HL),A ; UND LOESCHEN
LD A,C
RRCA
XOR B
AND NOT FSIGN
XOR B
LD (FPWS+FSGN),A ;VORZEICHEN MERKEN
RES 7,B
RES 7,C
LD (FPWS+FEXP1),BC ;EXPONENTEN SPEICHERN
INC HL
EX DE,HL ;ZEIGER AUF OBERE ZAHL
ADD HL,DE ;ZEIGER AUF UNTERE ZAHL
RET
;----------------------------------------------------------------
FADJUST:
LD A,9
CP B
JR NC,FADJLP1 ;EXPONENTENDIFFERENZ BEGRENZEN
LD B,A
FADJLP1:
LD C,4
INC HL
INC HL
INC HL
XOR A
FADJLP2:
RRD
DEC HL
DEC C
JR NZ,FADJLP2 ;KLEINERE ZAHL DIVIDIEREN
INC HL
DJNZ FADJLP1 ;BIS DIFFERENZ ERREICHT
ADD A,-5 ;WAR LETZTE STELLE >= 5 ?
PUSH HL
FADJLP3:
LD A,(HL)
ADC A,B
DAA
LD (HL),A
INC HL
JR C,FADJLP3 ;RUNDEN
POP HL
RET
;----------------------------------------------------------------
FNEG:
PUSH BC
PUSH HL
LD B,4
AND A
FNLOOP:
LD A,0
SBC A,(HL)
DAA
LD (HL),A
INC HL
DJNZ FNLOOP ;ALLE STELLEN NEGIEREN
POP HL
POP BC
RET
;----------------------------------------------------------------
FADDITION:
LD C,1 ;MULTIPLIKATOR 1
FMULADD:
PUSH HL
PUSH DE
PUSH BC
LD A,C
AND 0FH
LD B,A
XOR C
LD C,A
RRCA
RRCA
ADD A,C
RRCA
ADD A,B
LD C,A ;BCD ZU BINAER WANDELN
LD B,4
XOR A
FMLOOP1:
PUSH BC
PUSH DE
PUSH HL
ADD A,(HL)
DAA
LD L,A
LD A,(DE)
LD H,0
LD D,H
RL H ;UEBERTRAG AUS ADDITION
AND A
JR Z,FMNEXT ;STELLE = 0 ?
LD E,A
FMLOOP2:
SRL C
JR NC,FMNOADD ;MULTIPLIKATOR-BIT = 0 ?
LD A,L
ADD A,E
DAA
LD L,A
LD A,H
ADC A,D
DAA
LD H,A ;ADDITION
FMNOADD:
INC C
DEC C
JR Z,FMNEXT ;MULTIPLIKATOR = 0 ?
LD A,E
ADD A,A
DAA
LD E,A
LD A,D
ADC A,A
DAA
LD D,A ;ERGEBNIS SCHIEBEN
JR FMLOOP2 ;NOCHMAL
FMNEXT:
EX DE,HL
POP HL
LD (HL),E
LD A,D
POP DE
POP BC
INC DE
INC HL
DJNZ FMLOOP1 ;NOCH NICHT ALLE BYTES ?
POP BC
POP DE
POP HL
RET
;================================================================
DB 'F','-' OR CLAST
DW LOAD-1
DB 2
FMINUS:
DW DOCOL
DW FNEGATE
DW SEMICODE
JR FADDSUB
;================================================================
DB 'F','+' OR CLAST
DW FMINUS-1
DB 2
FPLUS:
DW FADDSUB
FADDSUB:
CALL FINIT ;BEARBEITUNG VORBEREITEN
LD A,C
SUB B
PUSH AF
JR NC,FASGOON1 ;EXPONENT UNTEN<=OBEN ?
EX DE,HL
NEG
LD (IX+FPWS+FEXP1-MEMBEG),B ;ZAHLEN TAUSCHEN
FASGOON1:
LD B,A
CALL NZ,FADJUST ;BEI BEDARF ANDERE ZAHL ANPASSEN
POP AF
JR NC,FASGOON2 ;EXPONENT UNTEN<=OBEN ?
EX DE,HL
FASGOON2:
LD B,2
LD C,(IX+FPWS+FSGN-MEMBEG)
FASLP1:
RL C
CALL C,FNEG
EX DE,HL
DJNZ FASLP1 ;BEI BEDARF ZAHLEN NEGIEREN
CALL FADDITION
DEC DE
LD A,(DE)
ADD A,-98H
RR B
LD (IX+FPWS+FSGN-MEMBEG),B ;NEUES VORZEICHEN MERKEN
CALL NZ,FNEG ;BEI BEDARF NEGIEREN
FASLP2:
LD A,(DE)
AND A
JR NZ,FASGOON3 ;OBERSTE STELLEN <> 0 ?
DEC (IX+FPWS+FEXP1-MEMBEG)
DEC (IX+FPWS+FEXP1-MEMBEG) ;EXPONENT KORRIGIEREN
PUSH DE
LD H,D
LD L,E
DEC HL
LD BC,255+(3 SHL 8) ;C LADEN WEGEN "LDD"
FASLP3:
OR (HL)
LDD
DJNZ FASLP3 ;STELLEN SCHIEBEN
EX DE,HL
LD (HL),B
POP DE
JR NZ,FASLP2 ;ZAHL <> 0 ?
JP (IY)
FASGOON3:
LD D,H
LD E,L ;ZAHL NOCH NICHT SCHIEBEN
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
FCORR:
PUSH DE
LD BC,4
LDIR ;ZAHL SCHIEBEN
POP HL
DEC DE
FCLP:
LD A,(DE)
AND A
JR Z,FCQUIT ;STELLEN = 0 ?
CP 10H
SBC A,A
INC A
INC A
LD B,A
ADD A,(IX+FPWS+FEXP1-MEMBEG)
LD (FPWS+FEXP1),A ;EXPONENT KORRIGIEREN
CALL FADJUST
JR FCLP
FCQUIT:
LD A,(FPWS+FEXP1)
DEC A
CP -FEOFFS-1
INC A
JR NC,FLT0 ;ZAHL ZU KLEIN ?
CP +FEOFFS+64
JR NC,FLTERR ;ZAHL ZU GROSS ?
LD B,A
LD A,(FPWS+FSGN)
LD C,A
RLA
XOR C
AND FSIGN
XOR B
LD (DE),A ;VORZEICHEN UND EXPONENT
JP (IY)
FLTERR:
RSTERR ERRFLT
FLT0:
LD BC,0+(4 SHL 8)
FLT0LP:
LD (HL),C
INC HL
DJNZ FLT0LP ;ZAHL AUF 0 SETZEN
JP (IY)
;================================================================
DB 'F','*' OR CLAST
DW FPLUS-1
DB 2
FMUL:
DW $+2
CALL FINIT ;BEARBEITUNG VORBEREITEN
XOR A
CP B
SBC A,A
AND C
JR Z,FLT0 ;EINE DER BEIDEN ZAHLEN = 0 ?
PUSH HL
LD BC,FPWS+FACCU-1
PUSH BC
LD B,3
FMLOOP:
LD C,(HL)
INC HL
EX (SP),HL
INC HL
CALL FMULADD
EX (SP),HL
DJNZ FMLOOP ;ALLE DOPPELSTELLEN MULTIPL.
LD BC,(FPWS+FEXP1)
LD A,B
ADD A,C
SUB FEOFFS+2
LD (FPWS+FEXP1),A ;EXPONENTEN BERECHNEN
POP HL
POP DE
JR FCORR
;================================================================
DB 'F','/' OR CLAST
DW FMUL-1
DB 2
FDIV:
DW $+2
CALL FINIT ;BEARBEITUNG VORBEREITEN
XOR A
CP B
JR Z,FLT0 ;DIVIDEND = 0 ?
CP C
JR Z,FLTERR ;DIVISOR = 0 ?
INC DE
INC DE
LD A,(DE)
DEC DE
DEC DE
ADD A,1
DAA
EX AF,AF' ;TEST AUF 0.99????E??
EX DE,HL
CALL FNEG ;OBERE ZAHL FUER SUBTR. NEGIEREN
EX DE,HL
PUSH HL
LD DE,FPWS+FDIVOR
LD BC,4
LDIR ;UNTERE ZAHL ZWISCHENSPEICHERN
EX DE,HL
DEC HL
LD B,5 ;ANZAHL DIVISOR-STELLEN
FDLOOP1:
PUSH DE
LD A,(HL)
DEC HL
LD E,(HL)
EX AF,AF'
LD C,A
EX AF,AF'
INC C
DEC C
JR NZ,FDGOON1 ;WAR ZAHL < 0.990000EXX ?
LD E,A
JR FDGOON2
FDGOON1:
PUSH BC
LD B,2 ;2 DIGIT PRO BYTE
FDLOOP2:
LD D,10H
FDLOOP3:
SLA E
RLA
RL D
JR NC,FDLOOP3 ;D-A-E UM EIN DIGIT SCHIEBEN
INC D
FDLOOP4:
SUB C
DAA
INC E
JR NC,FDLOOP4
DEC D
JR NZ,FDLOOP4 ;TEILDIVISION DURCH SUBTRAKTION
ADD A,C
DAA
DEC E
DJNZ FDLOOP2 ;EINZELQUOTIENTEN BERECHNEN
POP BC
FDGOON2:
LD C,E
POP DE
INC C
DEC C
JR Z,FDNEXT ;EINZELQUOTIENT = 0 ?
PUSH HL
DEC HL
DEC HL
CALL FMULADD ;SUBTRAKTION DURCHFUEHREN
PUSH DE
LD DE,FQUO-FDIVOR+4
ADD HL,DE ;ZEIGER AUSRICHTEN
LD DE,FPWS+FACCU
LD A,C
LD (DE),A
CALL FADDITION ;QUOTIENT AKKUMULIEREN
POP DE
POP HL
INC HL
INC B
FDNEXT:
DJNZ FDLOOP1 ;UND NOCH EINE RUNDE...
LD HL,(FPWS+FEXP1)
LD A,H
SUB L
ADD A,FEOFFS
LD HL,FPWS+FQUO+1
LD B,A
LD A,(FPWS+FQUO+4)
AND A
JR NZ,FDGOON3
DEC B
DEC B
DEC HL ;EXPONENTEN-KORREKTUR
FDGOON3:
LD (IX+FPWS+FEXP1-MEMBEG),B ;NEUER EXPONENT
POP DE
JP FCORR ;ERGEBNIS KORRIGIEREN
;================================================================
DB 'FNEGAT','E' OR CLAST
DW FDIV-1
DB 7
FNEGATE:
DW $+2
RSTPULL
LD A,D
AND A
JR Z,FNQUIT
XOR 80H ;ZAHLEN <> 0 NEGIEREN
FNQUIT:
LD D,A
RSTPUSH
JP (IY)
;================================================================
DB 'IN','T' OR CLAST
DW FNEGATE-1
DB 3
INT:
DW $+2
LD HL,(SPARE)
DEC HL
LD DE,0 ;WERT LOESCHEN
INTLOOP:
LD A,(HL) ;EXPONENT HOLEN
RLCA
CP 0+(FEOFFS+1) SHL 1
JR C,INTQUIT ;ABS(ZAHL) < 1.0 ?
XOR A
DEC HL
CALL DECSTORE ;UM EIN DIGIT LINKS SCHIEBEN
INC HL
EX DE,HL
LD B,H
LD C,L
ADD HL,HL
ADD HL,HL
ADD HL,BC
ADD HL,HL ;WERT * 10
LD C,A
LD B,0
ADD HL,BC ;HERAUSGESCHOBENES DIGIT ADDIEREN
EX DE,HL
JR INTLOOP
INTQUIT:
DEC HL
DEC HL
LD (HL),D
DEC HL
LD (HL),E
LD DE,IFN0NEG
JP NEXTDE ;VORZEICHEN ANPASSEN
;================================================================
DB 'UFLOA','T' OR CLAST
DW INT-1
DB 6
UFLOAT:
DW $+2
RSTPULL
EX DE,HL
LD BC,0 OR (16 SHL 8)
LD D,C
LD E,C
UFLOOP:
ADD HL,HL
LD A,E
ADC A,A
DAA
LD E,A
LD A,D
ADC A,A
DAA
LD D,A
RL C
DJNZ UFLOOP ;IN BCD-ZAHL WANDELN
RSTPUSH
LD D,FEOFFS+6
LD E,C
RSTPUSH ;ZAHL SPEICHERN
DEC HL
DEC HL
CALL FZEROEQ ;EXPONENT BEI 0 ANPASSEN
JP (IY)
;================================================================
; ZEICHENSATZ
DB 000H,000H,000H,000H
DB 000H,000H,000H ;........
;........
;........
;........
;........
;........
;........
DB 010H,010H,010H,010H
DB 000H,010H,000H ;...*....
;...*....
;...*....
;...*....
;........
;...*....
;........
DB 024H,024H,000H,000H
DB 000H,000H,000H ;..*..*..
;..*..*..
;........
;........
;........
;........
;........
DB 024H,07EH,024H,024H
DB 07EH,024H,000H ;..*..*..
;.******.
;..*..*..
;..*..*..
;.******.
;..*..*..
;........
DB 008H,03EH,028H,03EH
DB 00AH,03EH,008H ;....*...
;..*****.
;..*.*...
;..*****.
;....*.*.
;..*****.
;....*...
DB 062H,064H,008H,010H
DB 026H,046H,000H ;.**...*.
;.**..*..
;....*...
;...*....
;..*..**.
;.*...**.
;........
DB 010H,028H,010H,02AH
DB 044H,03AH,000H ;...*....
;..*.*...
;...*....
;..*.*.*.
;.*...*..
;..***.*.
;........
DB 008H,010H,000H,000H
DB 000H,000H,000H ;....*...
;...*....
;........
;........
;........
;........
;........
DB 004H,008H,008H,008H
DB 008H,004H,000H ;.....*..
;....*...
;....*...
;....*...
;....*...
;.....*..
;........
DB 020H,010H,010H,010H
DB 010H,020H,000H ;..*.....
;...*....
;...*....
;...*....
;...*....
;..*.....
;........
DB 000H,014H,008H,03EH
DB 008H,014H,000H ;........
;...*.*..
;....*...
;..*****.
;....*...
;...*.*..
;........
DB 000H,008H,008H,03EH
DB 008H,008H,000H ;........
;....*...
;....*...
;..*****.
;....*...
;....*...
;........
DB 000H,000H,000H,000H
DB 008H,008H,010H ;........
;........
;........
;........
;....*...
;....*...
;...*....
DB 000H,000H,000H,03EH
DB 000H,000H,000H ;........
;........
;........
;..*****.
;........
;........
;........
DB 000H,000H,000H,000H
DB 018H,018H,000H ;........
;........
;........
;........
;...**...
;...**...
;........
DB 000H,002H,004H,008H
DB 010H,020H,000H ;........
;......*.
;.....*..
;....*...
;...*....
;..*.....
;........
DB 03CH,046H,04AH,052H
DB 062H,03CH,000H ;..****..
;.*...**.
;.*..*.*.
;.*.*..*.
;.**...*.
;..****..
;........
DB 018H,028H,008H,008H
DB 008H,03EH,000H ;...**...
;..*.*...
;....*...
;....*...
;....*...
;..*****.
;........
DB 03CH,042H,002H,03CH
DB 040H,07EH,000H ;..****..
;.*....*.
;......*.
;..****..
;.*......
;.******.
;........
DB 03CH,042H,00CH,002H
DB 042H,03CH,000H ;..****..
;.*....*.
;....**..
;......*.
;.*....*.
;..****..
;........
DB 008H,018H,028H,048H
DB 07EH,008H,000H ;....*...
;...**...
;..*.*...
;.*..*...
;.******.
;....*...
;........
DB 07EH,040H,07CH,002H
DB 042H,03CH,000H ;.******.
;.*......
;.*****..
;......*.
;.*....*.
;..****..
;........
DB 03CH,040H,07CH,042H
DB 042H,03CH,000H ;..****..
;.*......
;.*****..
;.*....*.
;.*....*.
;..****..
;........
DB 07EH,002H,004H,008H
DB 010H,010H,000H ;.******.
;......*.
;.....*..
;....*...
;...*....
;...*....
;........
DB 03CH,042H,03CH,042H
DB 042H,03CH,000H ;..****..
;.*....*.
;..****..
;.*....*.
;.*....*.
;..****..
;........
DB 03CH,042H,042H,03EH
DB 002H,03CH,000H ;..****..
;.*....*.
;.*....*.
;..*****.
;......*.
;..****..
;........
DB 000H,000H,010H,000H
DB 000H,010H,000H ;........
;........
;...*....
;........
;........
;...*....
;........
DB 000H,010H,000H,000H
DB 010H,010H,020H ;........
;...*....
;........
;........
;...*....
;...*....
;..*.....
DB 000H,004H,008H,010H
DB 008H,004H,000H ;........
;.....*..
;....*...
;...*....
;....*...
;.....*..
;........
DB 000H,000H,03EH,000H
DB 03EH,000H,000H ;........
;........
;..*****.
;........
;..*****.
;........
;........
DB 000H,010H,008H,004H
DB 008H,010H,000H ;........
;...*....
;....*...
;.....*..
;....*...
;...*....
;........
DB 03CH,042H,004H,008H
DB 000H,008H ;..****..
;.*....*.
;.....*..
;....*...
;........
;....*...
DB 03CH,04AH,056H,05EH
DB 040H,03CH ;..****..
;.*..*.*.
;.*.*.**.
;.*.****.
;.*......
;..****..
DB 03CH,042H,042H,07EH
DB 042H,042H ;..****..
;.*....*.
;.*....*.
;.******.
;.*....*.
;.*....*.
DB 07CH,042H,07CH,042H
DB 042H,07CH ;.*****..
;.*....*.
;.*****..
;.*....*.
;.*....*.
;.*****..
DB 03CH,042H,040H,040H
DB 042H,03CH ;..****..
;.*....*.
;.*......
;.*......
;.*....*.
;..****..
DB 078H,044H,042H,042H
DB 044H,078H ;.****...
;.*...*..
;.*....*.
;.*....*.
;.*...*..
;.****...
DB 07EH,040H,07CH,040H
DB 040H,07EH ;.******.
;.*......
;.*****..
;.*......
;.*......
;.******.
DB 07EH,040H,07CH,040H
DB 040H,040H ;.******.
;.*......
;.*****..
;.*......
;.*......
;.*......
DB 03CH,042H,040H,04EH
DB 042H,03CH ;..****..
;.*....*.
;.*......
;.*..***.
;.*....*.
;..****..
DB 042H,042H,07EH,042H
DB 042H,042H ;.*....*.
;.*....*.
;.******.
;.*....*.
;.*....*.
;.*....*.
DB 03EH,008H,008H,008H
DB 008H,03EH ;..*****.
;....*...
;....*...
;....*...
;....*...
;..*****.
DB 002H,002H,002H,042H
DB 042H,03CH ;......*.
;......*.
;......*.
;.*....*.
;.*....*.
;..****..
DB 044H,048H,070H,048H
DB 044H,042H ;.*...*..
;.*..*...
;.***....
;.*..*...
;.*...*..
;.*....*.
DB 040H,040H,040H,040H
DB 040H,07EH ;.*......
;.*......
;.*......
;.*......
;.*......
;.******.
DB 042H,066H,05AH,042H
DB 042H,042H ;.*....*.
;.**..**.
;.*.**.*.
;.*....*.
;.*....*.
;.*....*.
DB 042H,062H,052H,04AH
DB 046H,042H ;.*....*.
;.**...*.
;.*.*..*.
;.*..*.*.
;.*...**.
;.*....*.
DB 03CH,042H,042H,042H
DB 042H,03CH ;..****..
;.*....*.
;.*....*.
;.*....*.
;.*....*.
;..****..
DB 07CH,042H,042H,07CH
DB 040H,040H ;.*****..
;.*....*.
;.*....*.
;.*****..
;.*......
;.*......
DB 03CH,042H,042H,052H
DB 04AH,03CH ;..****..
;.*....*.
;.*....*.
;.*.*..*.
;.*..*.*.
;..****..
DB 07CH,042H,042H,07CH
DB 044H,042H ;.*****..
;.*....*.
;.*....*.
;.*****..
;.*...*..
;.*....*.
DB 03CH,040H,03CH,002H
DB 042H,03CH ;..****..
;.*......
;..****..
;......*.
;.*....*.
;..****..
DB 0FEH,010H,010H,010H
DB 010H,010H ;*******.
;...*....
;...*....
;...*....
;...*....
;...*....
DB 042H,042H,042H,042H
DB 042H,03EH ;.*....*.
;.*....*.
;.*....*.
;.*....*.
;.*....*.
;..*****.
DB 042H,042H,042H,042H
DB 024H,018H ;.*....*.
;.*....*.
;.*....*.
;.*....*.
;..*..*..
;...**...
DB 042H,042H,042H,042H
DB 05AH,024H ;.*....*.
;.*....*.
;.*....*.
;.*....*.
;.*.**.*.
;..*..*..
DB 042H,024H,018H,018H
DB 024H,042H ;.*....*.
;..*..*..
;...**...
;...**...
;..*..*..
;.*....*.
DB 082H,044H,028H,010H
DB 010H,010H ;*.....*.
;.*...*..
;..*.*...
;...*....
;...*....
;...*....
DB 07EH,004H,008H,010H
DB 020H,07EH ;.******.
;.....*..
;....*...
;...*....
;..*.....
;.******.
DB 00EH,008H,008H,008H
DB 008H,00EH ;....***.
;....*...
;....*...
;....*...
;....*...
;....***.
DB 000H,040H,020H,010H
DB 008H,004H ;........
;.*......
;..*.....
;...*....
;....*...
;.....*..
DB 070H,010H,010H,010H
DB 010H,070H ;.***....
;...*....
;...*....
;...*....
;...*....
;.***....
DB 010H,038H,054H,010H
DB 010H,010H ;...*....
;..***...
;.*.*.*..
;...*....
;...*....
;...*....
DB 000H,000H,000H,000H
DB 000H,000H,0FFH ;........
;........
;........
;........
;........
;........
;********
DB 01CH,022H,078H,020H
DB 020H,07EH,000H ;...***..
;..*...*.
;.****...
;..*.....
;..*.....
;.******.
;........
DB 000H,038H,004H,03CH
DB 044H,03EH,000H ;........
;..***...
;.....*..
;..****..
;.*...*..
;..*****.
;........
DB 020H,020H,03CH,022H
DB 022H,03CH,000H ;..*.....
;..*.....
;..****..
;..*...*.
;..*...*.
;..****..
;........
DB 000H,01CH,020H,020H
DB 020H,01CH,000H ;........
;...***..
;..*.....
;..*.....
;..*.....
;...***..
;........
DB 004H,004H,03CH,044H
DB 044H,03EH,000H ;.....*..
;.....*..
;..****..
;.*...*..
;.*...*..
;..*****.
;........
DB 000H,038H,044H,078H
DB 040H,03CH,000H ;........
;..***...
;.*...*..
;.****...
;.*......
;..****..
;........
DB 00CH,010H,018H,010H
DB 010H,010H,000H ;....**..
;...*....
;...**...
;...*....
;...*....
;...*....
;........
DB 000H,03CH,044H,044H
DB 03CH,004H,038H ;........
;..****..
;.*...*..
;.*...*..
;..****..
;.....*..
;..***...
DB 040H,040H,078H,044H
DB 044H,044H,000H ;.*......
;.*......
;.****...
;.*...*..
;.*...*..
;.*...*..
;........
DB 010H,000H,030H,010H
DB 010H,038H,000H ;...*....
;........
;..**....
;...*....
;...*....
;..***...
;........
DB 004H,000H,004H,004H
DB 004H,024H,018H ;.....*..
;........
;.....*..
;.....*..
;.....*..
;..*..*..
;...**...
DB 020H,028H,030H,030H
DB 028H,024H,000H ;..*.....
;..*.*...
;..**....
;..**....
;..*.*...
;..*..*..
;........
DB 010H,010H,010H,010H
DB 010H,00CH,000H ;...*....
;...*....
;...*....
;...*....
;...*....
;....**..
;........
DB 000H,068H,054H,054H
DB 054H,054H,000H ;........
;.**.*...
;.*.*.*..
;.*.*.*..
;.*.*.*..
;.*.*.*..
;........
DB 000H,078H,044H,044H
DB 044H,044H,000H ;........
;.****...
;.*...*..
;.*...*..
;.*...*..
;.*...*..
;........
DB 000H,038H,044H,044H
DB 044H,038H,000H ;........
;..***...
;.*...*..
;.*...*..
;.*...*..
;..***...
;........
DB 000H,078H,044H,044H
DB 078H,040H,040H ;........
;.****...
;.*...*..
;.*...*..
;.****...
;.*......
;.*......
DB 000H,03CH,044H,044H
DB 03CH,004H,006H ;........
;..****..
;.*...*..
;.*...*..
;..****..
;.....*..
;.....**.
DB 000H,01CH,020H,020H
DB 020H,020H,000H ;........
;...***..
;..*.....
;..*.....
;..*.....
;..*.....
;........
DB 000H,038H,040H,038H
DB 004H,078H,000H ;........
;..***...
;.*......
;..***...
;.....*..
;.****...
;........
DB 010H,038H,010H,010H
DB 010H,00CH,000H ;...*....
;..***...
;...*....
;...*....
;...*....
;....**..
;........
DB 000H,044H,044H,044H
DB 044H,03CH,000H ;........
;.*...*..
;.*...*..
;.*...*..
;.*...*..
;..****..
;........
DB 000H,044H,044H,028H
DB 028H,010H,000H ;........
;.*...*..
;.*...*..
;..*.*...
;..*.*...
;...*....
;........
DB 000H,044H,054H,054H
DB 054H,028H,000H ;........
;.*...*..
;.*.*.*..
;.*.*.*..
;.*.*.*..
;..*.*...
;........
DB 000H,044H,028H,010H
DB 028H,044H,000H ;........
;.*...*..
;..*.*...
;...*....
;..*.*...
;.*...*..
;........
DB 000H,044H,044H,044H
DB 03CH,004H,038H ;........
;.*...*..
;.*...*..
;.*...*..
;..****..
;.....*..
;..***...
DB 000H,07CH,008H,010H
DB 020H,07CH,000H ;........
;.*****..
;....*...
;...*....
;..*.....
;.*****..
;........
DB 00EH,008H,030H,030H
DB 008H,00EH,000H ;....***.
;....*...
;..**....
;..**....
;....*...
;....***.
;........
DB 008H,008H,008H,008H
DB 008H,008H,000H ;....*...
;....*...
;....*...
;....*...
;....*...
;....*...
;........
DB 070H,010H,00CH,00CH
DB 010H,070H,000H ;.***....
;...*....
;....**..
;....**..
;...*....
;.***....
;........
DB 032H,04CH,000H,000H
DB 000H,000H,000H ;..**..*.
;.*..**..
;........
;........
;........
;........
;........
DB 03CH,042H,099H,0A1H
DB 0A1H,099H,042H,03CH ;..****..
;.*....*.
;*..**..*
;*.*....*
;*.*....*
;*..**..*
;.*....*.
;..****..
ROMCHR:
;================================================================
DB 0FFH
DW UFLOAT-1
DB 000H
;================================================================
END
|