TITLE < Z80 fig-FORTH 1.1 g > SUBTTL Adaptive version by EHR ; ; ; Modified frm FIG document keyed by Dennis L. Wilson 800907 ; Converted frm "8080 FIG-FORTH VERSION A0 15SEP79" ; ; fig-FORTH release 1.1 for the 8080 processor. ; ; ALL PUBLICATIONS OF THE FORTH INTEREST GROUP ; ARE PUBLIC DOMAIN. THEY MAY BE FURTHER ; DISTRIBUTED BY THE INCLUSION OF THIS CREDIT NOTICE: ; ; This publication has been made available by the ; Forth Interest Group ; P.O.Box 1105 ; San Carlos, CA 94070 ; U.S.A. ; ; Implementation on 8080 by: ; John Cassady ; 339 15th Street ; Oakland, CA 94612 ; U.S.A ; on 790528 ; Modified by: ; Kim Harris ; Acknowledgements: ; George Flammer ; Robt. D. Villwock ; ---------------------------------------------------------------------- ; Z80 Version for Cromemco CDOS & Digital Research CP/M by: ; Dennis Lee Wilson c/o ; Aristotelian Logicians ; 2631 East Pinchot Avenue ; Phoenix, AZ 85016 ; U.S.A. ; ---------------------------------------------------------------------- ; The 2 byte Z80 code for Jump Relative (JR) has been substituted for ; the 3 byte Jump (JP) wherever practical. The port I/O words P@ & P! ; have been made ROMable by use of Z80 instructions. ; ---------------------------------------------------------------------- ; Further modifications (marked ;/) by: ; Edmund Ramm ; Anderheitsallee 24 ; 2000 Hamburg 71 ; Fed. Rep. of Germany 840418 ; ---------------------------------------------------------------------- ; Disc I/O has been modified a la Albert van der Horst (HCCH) to employ ; CP/M 2.x's random access feature. ; ---------------------------------------------------------------------- ; ; Release & Version numbers ; FIGREL EQU 1 ;FIG RELEASE # FIGREV EQU 1 ;FIG REVISION # USRVER EQU 67H ;USER VERSION # g by DLW/EHR/AvdH ; ;Console & printer drivers are in external source named ;CONPRTIO.FTH & disc drivers in DISCIO.FTH. It has 4 screen ;buffers & end of memory is set to FBASE from locn. 0007H. FORM ; ASCII characters used ; ABL EQU 20H ;BLANK ACR EQU 0DH ;CR ADOT EQU 2EH ;. BELL EQU 07H ;^G BSIN EQU 08H ;backspace chr = ^H BSOUT EQU 08H DLE EQU 10H ;^P LF EQU 0AH ;^J FF EQU 0CH ;^L ; ; Memory allocation ; BDOSS EQU 0005H ;/ system entry NSCR EQU 4 ; # of 1024 byte screens KBBUF EQU 128 ; bytes/disc buffer US EQU 40H ; user variables space RTS EQU 400H ; Return Stack & term buff space CO EQU KBBUF+4 ; Disc buff + 2 header + 2 tail NBUF EQU NSCR*400H/KBBUF ; # of buffers BUFSIZ EQU CO*NBUF ;/ total disc buffer size FORM ABS ; ORG 0100H ORIG: NOP JP CLD ;VECTOR TO COLD START NOP JP WRM ;VECTOR TO WARM START DEFB FIGREL ;FIG RELEASE # DEFB FIGREV ;FIG REVISION # DEFB USRVER ;USER VERSION # DEFB 0EH ;IMPLEMENTATION ATTRIBUTES ; ; ; ; 0EH = 0000:1110 ; --------- ; B +ORIGIN ...W:IEBA ; ; W: 0=above sufficient ; 1=other differences exist ; I: Interpreter is 0=pre- ; 1=post incrementing ; E: Addr must be even: 0 yes ; 1 no ; B: High byte @ 0=low addr. ; 1=high addr. ; A: CPU Addr. 0=BYTE ; 1=WORD ; ; ; DEFW TASK-7 ; TOPMOST WORD IN FORTH VOCABULARY DEFW BSIN ; BACKSPACE CHR UPINIT: DEFW 0 ;/ INIT (UP) ; ; * FOLLOWING USED BY COLD; MUST BE IN SAME ORDER AS USER VARIABLES * ; S0INIT: DEFW 0 ;/ INIT (S0) R0INIT: DEFW 0 ;/ INIT (R0) TIBINI: DEFW 0 ;/ INIT (TIB) DEFW 1FH ; INIT (WIDTH) DEFW 0 ; INIT (WARNING) DEFW INITDP ; INIT (FENCE) DEFW INITDP ; INIT (DP) DEFW FORTH+8 ; INIT (VOC-LINK) ; ; * END DATA USED BY COLD * ; DEFW 0H,0B250H ;Z80 CPU NAME (HW,LW) ;(32 BIT BASE 36 INTEGER) FORM ; REGISTERS ; ; FORTH Z80 FORTH PRESERVATION RULES ; ----- --- ----------------------- ; IP BC should be preserved ; accross FORTH words. ; W DE sometimes output from ; NEXT, may be altered ; b4 JP'ing to NEXT, ; input only when ; "DPUSH" called. ; SP SP should be used only as ; Data Stack accross ; FORTH words, may be ; used within FORTH ; words if restored ; b4 "NEXT" ; HL Never output frm NEXT ; input only when ; "HPUSH" called ; ; UP: DEFW 0 ;/ USER AREA PTR RPP: DEFW 0 ;/ RETURN STACK PTR BUF1: DEFW 0 ;/ address of 1st disc buffer ; ; ; COMMENT CONVENTIONS: ; ; = MEANS "IS EQUAL TO" ; <-- MEANS ASSIGNMENT ; NAME = ADDR OF NAME ; (NAME) = CONTENTS @ NAME ; ((NAME))= INDIRECT CONTENTS ; CFA = CODE FIELD ADDR ; LFA = LINK FIELD ADDR ; NFA = NAME FIELD ADDR ; PFA = PARAMETER FIELD ADDR ; S1 = ADDR OF 1st WORD OF PARAMETER STACK ; S2 = -"- OF 2nd -"- OF -"- -"- ; R1 = -"- OF 1st -"- OF RETURN STACK ; R2 = -"- OF 2nd -"- OF -"- -"- ; ( above Stack posn. valid b4 & after execution of any word, not during) ; ; LSB = LEAST SIGNIFICANT BIT ; MSB = MOST SIGNIFICANT BIT ; LB = LOW BYTE ; HB = HIGH BYTE ; LW = LOW WORD ; HW = HIGH WORD ; (May be used as suffix to above names) FORM ; FORTH ADDRESS INTERPRETER ; POST INCREMENTING VERSION ; DPUSH: PUSH DE HPUSH: PUSH HL ; IY points here NEXT: LD A,(BC) ;(W)<--((IP)) IX points here LD L,A INC BC ;INC IP LD A,(BC) LD H,A ;(HL)<--CFA INC BC ;INC IP NEXT1: LD E,(HL) ;(PC)<--((W)) INC HL LD D,(HL) EX DE,HL JP (HL) ;NOTE: (DE)=CFA+1 ; JNEXT MACRO JP (IX) ENDM ; JHPUSH MACRO JP (IY) ENDM FORM ; FORTH DICTIONARY ; DICTIONARY FORMAT: ; ; BYTE ; ADDRESS NAME CONTENTS ; ------- ---- -------- ; (MSB=1 ; (P=PRECEDENCE BIT ; (S=SMUDGE BIT ; NFA NAME FIELD 1PS<LEN> <NAME LENGTH ; 0<1CHAR> MSB=0, NAME'S 1st CHAR ; 0<2CHAR> ; ... ; 1<LCHAR> MSB=1, NAME'S LAST CHAR ; LFA LINK FIELD <LINKLB> =PREVIOUS WORD'S NFA ; <LINKHB> ;LABEL: CFA CODE FIELD <CODELB> =ADDR CPU CODE ; <CODEHB> ; PFA PARAMETER <1PARAM> 1st PARAMETER BYTE ; FIELD <2PARAM> ; ... ; ; ; DP0: DEFB 83H ;LIT DM 'LIT' DEFW 0 ;(LFA)=0 MARKS END OF DICTIONARY LIT: DEFW $+2 ;(S1)<--((IP)) LD A,(BC) ;(HL)<--((IP))=LITERAL INC BC ;(IP)<--(IP)+2 LD L,A ;LB LD A,(BC) ;HB INC BC LD H,A JHPUSH ;(S1)<--(HL) ; DEFB 87H ;EXECUTE DM 'EXECUTE' DEFW LIT-6 EXEC: DEFW $+2 POP HL JP NEXT1 ; DEFB 86H ;BRANCH DM 'BRANCH' DEFW EXEC-0AH BRAN: DEFW $+2 ;(IP)<--(IP)+((IP)) BRAN1: LD H,B ;(HL)<--(IP) LD L,C LD E,(HL) ;(DE)<--((IP))=BRANCH OFFSET INC HL LD D,(HL) DEC HL ADD HL,DE ;(HL)<--(HL)+((IP)) LD C,L ;(IP)<--(HL) LD B,H JNEXT ; DEFB 87H ;0BRANCH DM '0BRANCH' DEFW BRAN-9 ZBRAN: DEFW $+2 POP HL LD A,L OR H JR Z,BRAN1 ;IF (S1)=0 THEN BRANCH INC BC ;ELSE SKIP BRANCH OFFSET INC BC JNEXT ; DEFB 86H ;(LOOP) DM '(LOOP)' DEFW ZBRAN-0AH XLOOP: DEFW $+2 LD HL,(RPP) ; ((HL))=INDEX=(R1) inc (hl) ;/ index(lb) += 1 LD E,(HL) ;/ INC HL ;/ (hl)-->index(hb) jr nz,xloop1 ;/ jump if ((hl)) < 256 inc (hl) ;/ else index(hb) += 1 xloop1: LD D,(HL) ;/ (DE)<-- new INDEX INC HL ;/ ((HL))=LIMIT LD A,E SUB (HL) LD A,D INC HL SBC A,(HL) ; INDEX<LIMIT? JP M,BRAN1 ; YES, LOOP AGAIN INC HL ; NO, DONE LD (RPP),HL ; DISCARD R1 & R2 INC BC INC BC ; SKIP BRANCH OFFSET JNEXT ; DEFB 87H ;(+LOOP) DM '(+LOOP)' DEFW XLOOP-9 XPLOO: DEFW $+2 POP DE ;(DE)<--INCR LD HL,(RPP) ;((HL))=INDEX LD A,(HL) ;INDEX<--INDEX+INCR ADD A,E LD (HL),A LD E,A INC HL LD A,(HL) ADC A,D LD (HL),A INC HL ;((HL))=LIMIT INC D DEC D LD D,A ;(DE)<--NEW INDEX JP M,XLOO2 ;IF INCR>0 LD A,E SUB (HL) ;THEN (A)<--INDEX - LIMIT LD A,D INC HL SBC A,(HL) JP XLOO3 XLOO2: LD A,(HL) ;ELSE (A)<--LIMIT - INDEX SUB E INC HL LD A,(HL) SBC A,D ; ;IF (A)<0 XLOO3: JP M,BRAN1 ;THEN LOOP AGN INC HL ;ELSE DONE LD (RPP),HL ;DISCARD R1 & R2 INC BC ;SKIP BRANCH OFFSET INC BC JNEXT ; DEFB 84H ; (DO) DM '(DO)' DEFW XPLOO-0AH XDO: DEFW $+2 EXX ;/ SAVE IP POP DE ; (DE)<--INITIAL INDEX POP BC ;/ (BC)<--LIMIT LD HL,(RPP) ; (HL)<--(RP) DEC HL LD (HL),B DEC HL LD (HL),C ;/ (R2)<--LIMIT DEC HL LD (HL),D DEC HL LD (HL),E ; (R1)<--INITIAL INDEX LD (RPP),HL ; (RP)<--(RP)-4 EXX ;/ RESTORE IP JNEXT ; DEFB 81H ;I DM 'I' DEFW XDO-7 IDO: DEFW $+2 ;(S1)<--(R1), (R1) UNCHANGED LD HL,(RPP) LD E,(HL) ;(DE)<--(R1) INC HL LD D,(HL) PUSH DE ;(S1)<--(DE) JNEXT ; DEFB 85H ;DIGIT DM 'DIGIT' DEFW IDO-4 DIGIT: DEFW $+2 POP HL ;(L)<--(S1)LB = BASE VALUE POP DE ;(E)<--(S2)LB = ASCII CHR TO BE CONVERTED LD A,E ;ACCU<--CHR SUB '0' ;>=0? JR C,DIGI2 ;/ <0 IS INVALID CP 0AH ;>9? JR C,DIGI1 ;/ NO, TEST BASE VALUE SUB 07H ;GAP BETWEEN "9" & "A", NW "A"=0AH CP 0AH ;>="A"? JR C,DIGI2 ;/ CHRs BETWEEN "9" & "A" ARE INVALID DIGI1: CP L ;<BASE VALUE? JR NC,DIGI2 ;/ NO, INVALID LD E,A ;(S2)<--(DE) = CONVERTED DIGIT LD HL,0001H ;(S1)<--TRUE JP DPUSH DIGI2: LD L,H ;(HL)<--FALSE JHPUSH ;(S1)<--FALSE ; DEFB 86H ;(FIND) (2-1)FAILURE DM '(FIND)' ; (2-3)SUCCESS DEFW DIGIT-8 PFIND: DEFW $+2 POP DE ;(DE)<--NFA PFIN1: POP HL ;(HL)<--STRING ADDR PUSH HL ;SAVE FOR NEXT ITERATION LD A,(DE) XOR (HL) ;FILTER DEVIATIONS AND 3FH ;MASK MSB & PRECEDENCE BIT JR NZ,PFIN4 ;LENGTHS DIFFER PFIN2: INC HL ;(HL)<--ADDR NEXT CHR IN STRING INC DE ;(DE)<--ADDR NEXT CHR IN NF LD A,(DE) XOR (HL) ;FILTER DEVIATIONS ADD A,A JR NZ,PFIN3 ;NO MATCH JR NC,PFIN2 ;MATCH SO FAR, LOOP AGN LD HL,0005H ;STRING MATCHES ADD HL,DE ;((SP))<--PFA EX (SP),HL PFIN6: DEC DE ;POSN DE ON NFA LD A,(DE) OR A ;MSB=1? =LENGTH BYTE JP P,PFIN6 ;NO, TRY NEXT CHR LD E,A ;(E)<--LENGTH BYTE LD D,00H LD HL,0001H ;(HL)<--TRUE JP DPUSH ;NF FOUND, RETURN ; ;ABOVE NF NOT A MATCH, TRY NEXT ONE ; PFIN3: JR C,PFIN5 ;CARRY=END OF NF PFIN4: INC DE ;FIND END OF NF LD A,(DE) OR A ;MSB=1? JP P,PFIN4 ;NO, LOOP PFIN5: INC DE ;(DE)<--LFA EX DE,HL LD E,(HL) INC HL LD D,(HL) ;(DE)<--(LFA) LD A,D OR E ;END OF DICTIONARY? (LFA)=0 JR NZ,PFIN1 ;NO, TRY PREVIOUS DEFINITION POP HL ;DROP STRING ADDR LD HL,0 ;(HL)<--FALSE JHPUSH ;NO MATCH FOUND, RETURN ; DEFB 87H ;ENCLOSE DM 'ENCLOSE' DEFW PFIND-9 ENCL: DEFW $+2 POP DE ;(DE)<--(S1)=DELIMITER CHR POP HL ;(HL)<--(S2)=ADDR OF TEXT TO SCAN PUSH HL ;(S4)<--ADDR LD A,E LD D,A ;(D)<--DELIM CHR LD E,-1 ;INIT CHR OFFSET COUNTER DEC HL ;(HL)<--ADDR-1 ENCL1: INC HL ;SKIP OVER LEADING DELIM CHRs INC E CP (HL) ;DELIM CHR? JR Z,ENCL1 ;YES, LOOP LD D,0 PUSH DE ;(S3)<--(E)=OFFSET TO 1st NON DELIM LD D,A ;(D)<--DELIM CHR LD A,(HL) AND A ;1st non-DELIM=NULL? JR NZ,ENCL2 ;NO LD D,0 ;YES INC E PUSH DE ;(S2)<--OFFSET TO BYTE FOLLOWING NULL DEC E PUSH DE ;(S1)<--OFFSET TO NULL JNEXT ENCL2: LD A,D ;(A)<--DELIM CHR INC HL ;(HL)<--ADDR NEXT CHR INC E ;(E)<--OFFSET TO NEXT CHR CP (HL) ;DELIM CHR? JR Z,ENCL4 ;YES LD A,(HL) AND A ;NULL? JR NZ,ENCL2 ;NO, CONT SCAN ENCL3: LD D,0 PUSH DE ;(S2)<--OFFSET TO NULL PUSH DE ;(S1)<--OFFSET TO NULL JNEXT ENCL4: LD D,0 PUSH DE ;(S2)<--OFFSET TO BYTE FOLLOWING TEXT INC E PUSH DE ;(S1)<--OFFSET TO 2 BYTES AFTER END OF WORD JNEXT ; DEFB 84H ;EMIT DM 'EMIT' DEFW ENCL-0AH EMIT: DEFW DOCOL DEFW PEMIT DEFW ONE,OUTT DEFW PSTOR,SEMIS ; DEFB 83H ;KEY DM 'KEY' DEFW EMIT-7 KEY: DEFW $+2 JP PKEY ; DEFB 89H ;?TERMINAL DM '?TERMINAL' DEFW KEY-6 QTERM: DEFW $+2 LD HL,0 JP PQTER ; DEFB 82H ;CR DM 'CR' DEFW QTERM-0CH CR: DEFW $+2 JP PCR ; DEFB 85H ;CMOVE DM 'CMOVE' DEFW CR-5 CMOVE: DEFW $+2 EXX ;/ SAVE IP POP BC ; (BC)<--(S1)= #CHRs POP DE ; (DE)<--(S2)= DEST ADDR POP HL ;/ (HL)<--(S3)= SOURCE ADDR LD A,B OR C ; BC=0? JR Z,EXCMOV ; YES, DON'T MOVE ANYTHING LDIR ;/ XFER STRING EXCMOV: EXX ;/ RESTORE IP JNEXT ; DEFB 82H ;U* 16*16 unsigned multiply DM 'U*' ;994 T cycles average (8080) DEFW CMOVE-8 USTAR: DEFW $+2 POP DE ;(DE)<--MPLIER POP HL ;(HL)<--MPCAND PUSH BC ;SAVE IP LD B,H LD A,L ;(BA)<--MPCAND CALL MPYX ;(AHL)1<--MPCAND.LB*MPLIER ; 1st PARTIAL PRODUCT PUSH HL ;SAVE (HL)1 LD H,A LD A,B LD B,H ;SAVE (A)1 CALL MPYX ;(AHL)2<--MPCAND.HB*MPLIER ; 2nd PARTIAL PRODUCT POP DE ;(DE)<--(HL)1 LD C,D ;(BC)<--(AH)1 ; FORM SUM OF PARTIALS: ; ; (AHL)1 ; ;+(AHL)2 ; ;------- ; ; (AHLE) ADD HL,BC ;(HL)<--(HL)2+(AH)1 ADC A,00H ;(AHLE)<--(BA)*(DE) LD D,L LD L,H LD H,A ;(HLDE)<--MPLIER*MPCAND POP BC ;RESTORE IP PUSH DE ;(S2)<--PRODUCT.LW JHPUSH ;(S1)<--PRODUCT.HW ; ; MULTIPLY PRIMITIVE ; (AHL)<--(A)*(DE) ; #BITS: 24 8 16 ; MPYX: LD HL,0 ;(HL)<--0=PARTIAL PRODUCT.LW LD C,08H ;LOOP COUNTER MPYX1: ADD HL,HL ;LEFT SHIFT (AHL) 24 BITS RLA JR NC,MPYX2 ;IF NEXT MPLIER BIT = 1 ADD HL,DE ;THEN ADD MPCAND ADC A,0 MPYX2: DEC C ;LAST MPLIER BIT? JR NZ,MPYX1 ;NO, LOOP AGN RET ;YES, DONE ; DEFB 82H ;U/ DM 'U/' DEFW USTAR-5 USLAS: DEFW $+2 LD HL,0004H ADD HL,SP ;((HL))<--NUMERATOR.LW LD E,(HL) ;(DE)<--NUMER.LW LD (HL),C ;SAVE IP ON STACK INC HL LD D,(HL) LD (HL),B POP BC ;(BC)<--DENOMINATOR POP HL ;(HL)<--NUMER.HW LD A,L SUB C LD A,H SBC A,B ;NUMER >= DENOM? JR C,USLA1 ;NO, GO AHEAD LD HL,0FFFFH ;YES, OVERFLOW LD D,H LD E,L ;/ SET REM & QUOT TO MAX JP USLA7 USLA1: LD A,10H ;LOOP COUNTER USLA2: ADD HL,HL ;LEFT SHIFT (HLDE) THRU CARRY RLA ;ROT CARRY INTO ACCU BIT 0 EX DE,HL ADD HL,HL JR NC,USLA3 INC DE ;ADD CARRY AND A ;RESET CARRY USLA3: EX DE,HL ;SHIFT DONE RRA ;RESTORE 1st CARRY & COUNTER JR NC,USLA4 ;IF CARRY=1 OR A ;/ RESET CARRY SBC HL,BC ;/ THEN (HL)<--(HL)-(BC) JP USLA5 USLA4: SBC HL,BC ;/ (HL)<--PARTIAL REMAINDER JR NC,USLA5 ADD HL,BC ;UNDERFLOW, RESTORE DEC DE USLA5: INC DE ;INC QUOT DEC A ;COUNTER=0? JP NZ,USLA2 ;NO, LOOP AGN USLA7: POP BC ;RESTORE IP PUSH HL ;(S2)<--REMAINDER PUSH DE ;(S1)<--QUOTIENT JNEXT ; DEFB 83H ;AND DM 'AND' DEFW USLAS-5 ANDD: DEFW $+2 ;(S1)<--(S1) AND (S2) POP DE POP HL LD A,E AND L LD L,A LD A,D AND H LD H,A JHPUSH ; DEFB 82H ;OR DM 'OR' DEFW ANDD-6 ORR: DEFW $+2 ;(S1)<--(S1) OR (S2) POP DE POP HL LD A,E OR L LD L,A LD A,D OR H LD H,A JHPUSH ; DEFB 83H ;XOR DM 'XOR' DEFW ORR-5 XORR: DEFW $+2 ;(S1)<--(S1) XOR (S2) POP DE POP HL LD A,E XOR L LD L,A LD A,D XOR H LD H,A JHPUSH ; DEFB 83H ;SP@ DM 'SP@' DEFW XORR-6 SPAT: DEFW $+2 ;(S1)<--(SP) LD HL,0 ADD HL,SP ;(HL)<--(SP) JHPUSH ; DEFB 83H ;SP! DM 'SP!' DEFW SPAT-6 SPSTO: DEFW $+2 ;(SP)<--(S0) (USER VARIABLE) LD HL,(UP) ;(HL)<--USER VAR BASE ADDR LD DE,0006H ADD HL,DE ;(HL)<--S0 LD E,(HL) INC HL LD D,(HL) ;(DE)<--(S0) EX DE,HL LD SP,HL ;(SP)<--(S0) JNEXT ; DEFB 83H ;RP@ DM 'RP@' DEFW SPSTO-6 RPAT: DEFW $+2 ;(S1)<--(RP) LD HL,(RPP) JHPUSH ; DEFB 83H ;RP! DM 'RP!' DEFW RPAT-6 RPSTO: DEFW $+2 ;(RP)<--(R0) (USER VARIABLE) LD HL,(UP) ;(HL)<--USER VAR BASE ADDR LD DE,0008H ADD HL,DE ;(HL)<--R0 LD E,(HL) INC HL LD D,(HL) ;(DE)<--(R0) LD (RPP),DE ;/ (RP)<--(R0) JNEXT ; DEFB 82H ; ;S DM ';S' DEFW RPSTO-6 SEMIS: DEFW $+2 ;(IP)<--(R1) LD HL,(RPP) LD C,(HL) INC HL LD B,(HL) ;(BC)<--(R1) INC HL LD (RPP),HL ;(RP)<--(RP)+2 JNEXT ; DEFB 85H ;LEAVE DM 'LEAVE' DEFW SEMIS-5 LEAVE: DEFW $+2 ;LIMIT<--INDEX LD HL,(RPP) LD E,(HL) INC HL LD D,(HL) ;(DE)<--(R1)=INDEX INC HL LD (HL),E INC HL LD (HL),D ;(R2)<--(DE)=LIMIT JNEXT ; DEFB 82H ;>R DM '>R' DEFW LEAVE-8 TOR: DEFW $+2 POP DE LD HL,(RPP) DEC HL LD (HL),D DEC HL LD (HL),E ;/ (R1)<--(DE) LD (RPP),HL ; (RP)<--(RP)-2 JNEXT ; DEFB 82H ;R> DM 'R>' DEFW TOR-5 FROMR: DEFW $+2 LD HL,(RPP) LD E,(HL) INC HL LD D,(HL) INC HL LD (RPP),HL PUSH DE ;(S1)<--(R1) JNEXT ; DEFB 81H ;R DM 'R' DEFW FROMR-5 RR: DEFW IDO+2 ; DEFB 82H ;0= DM '0=' DEFW RR-4 ZEQU: DEFW $+2 POP HL LD A,L OR H LD HL,0 JR NZ,ZEQU1 INC L ;(HL)<--TRUE ZEQU1: JHPUSH ; DEFB 82H ;0< DM '0<' DEFW ZEQU-5 ZLESS: DEFW $+2 POP AF ;/ (A)<--(S1)H RLA ;/ (CARRY)<--BIT 7 LD HL,0 ; (HL)<--FALSE JR NC,ZLES1 INC L ; (HL)<--TRUE ZLES1: JHPUSH ; DEFB 81H ;+ DM '+' DEFW ZLESS-5 PLUS: DEFW $+2 POP DE POP HL ADD HL,DE JHPUSH ; DEFB 82H ;D+ ( d1L d1H d2L d2h -- d3L d3H) DM 'D+' DEFW PLUS-4 DPLUS: DEFW $+2 EXX ;/ SAVE IP POP BC ; (BC)<--d2H POP HL ; (HL)<--d2L POP AF ;d (AF)<--d1H POP DE ; (DE)<--d1L PUSH AF ;/ (S1)<--d1H ADD HL,DE ; (HL)<--d2L+d1L=d3L EX DE,HL ; (DE)<--d3L POP HL ; (HL)<--d1H ADC HL,BC ;/ (HL)<--d1H+d2H+CARRY=d3H PUSH DE ; (S2)<--d3L PUSH HL ;/ (S1)<--d3H EXX ;/ RESTORE IP JNEXT ; DEFB 85H ;MINUS DM 'MINUS' DEFW DPLUS-5 MINUS: DEFW $+2 POP DE ;/ XOR A ;/ RESET CARRY, (A)<--0 LD H,A ;/ LD L,A ;/ LD HL,0 SBC HL,DE ;/ (HL)<--(DE)2's COMPL. JHPUSH ; DEFB 86H ;DMINUS DM 'DMINUS' DEFW MINUS-8 DMINU: DEFW $+2 POP HL ;(HL)<--d1H POP DE ;(DE)<--d1L SUB A ;(A)<--0 SUB E LD E,A ;(E)<--NEG(E) LD A,00H SBC A,D LD D,A ;(D)<--NEG(D) LD A,00H SBC A,L LD L,A ;(L)<--NEG(L) LD A,00H SBC A,H LD H,A ;(H)<--NEG(H) JP DPUSH ;(S2)<--d2L, (S1)<--d2H ; DEFB 84H ;OVER DM 'OVER' DEFW DMINU-9 OVER: DEFW $+2 POP DE POP HL PUSH HL JP DPUSH ; DEFB 84H ;DROP DM 'DROP' DEFW OVER-7 DROP: DEFW $+2 POP HL JNEXT ; DEFB 84H ;SWAP DM 'SWAP' DEFW DROP-7 SWAP: DEFW $+2 POP HL EX (SP),HL JHPUSH ; DEFB 83H ;DUP DM 'DUP' DEFW SWAP-7 DUP: DEFW $+2 POP HL PUSH HL JHPUSH ; DEFB 84H ;2DUP DM '2DUP' DEFW DUP-6 TDUP: DEFW $+2 POP HL POP DE PUSH DE PUSH HL JP DPUSH ; DEFB 82H ;+! DM '+!' DEFW TDUP-7 PSTOR: DEFW $+2 POP HL ;(HL)<--VAR ADDR POP DE ;(DE)<--NUMBER LD A,(HL) ADD A,E LD (HL),A INC HL LD A,(HL) ADC A,D LD (HL),A ;((HL))<--((HL))+NUMBER JNEXT ; DEFB 86H ;TOGGLE DM 'TOGGLE' DEFW PSTOR-5 TOGGL: DEFW $+2 POP DE ;(E)<--BIT PATTERN POP HL ;(HL)<--ADDR LD A,(HL) XOR E LD (HL),A JNEXT ; DEFB 81H ;@ DM '@' DEFW TOGGL-9 AT: DEFW $+2 POP HL LD E,(HL) INC HL LD D,(HL) PUSH DE JNEXT ; DEFB 82H ;C@ DM 'C@' DEFW AT-4 CAT: DEFW $+2 POP HL LD L,(HL) LD H,0 JHPUSH ; DEFB 82H ;2@ DM '2@' DEFW CAT-5 TAT: DEFW $+2 EXX ;/ SAVE IP POP HL ; (HL)<--ADDR LD C,(HL) INC HL LD B,(HL) ;/ (BC)<--dH INC HL LD E,(HL) INC HL LD D,(HL) ; (DE)<--dL PUSH DE ; (S2)<--dL PUSH BC ;/ (S1)<--dH EXX ;/ RESTORE IP JNEXT ; DEFB 81H ;! DM '!' DEFW TAT-5 STORE: DEFW $+2 POP HL POP DE LD (HL),E INC HL LD (HL),D JNEXT ; DEFB 82H ;C! DM 'C!' DEFW STORE-4 CSTOR: DEFW $+2 POP HL POP DE LD (HL),E JNEXT ; DEFB 82H ;2! DM '2!' DEFW CSTOR-5 TSTOR: DEFW $+2 POP HL POP DE LD (HL),E INC HL LD (HL),D INC HL POP DE LD (HL),E INC HL LD (HL),D JNEXT ; DEFB 0C1H ; : DM ':' DEFW TSTOR-5 COLON: DEFW DOCOL DEFW QEXEC DEFW SCSP DEFW CURR DEFW AT DEFW CONT DEFW STORE DEFW CREAT DEFW RBRAC DEFW PSCOD DOCOL: LD HL,(RPP) DEC HL LD (HL),B DEC HL LD (HL),C LD (RPP),HL INC DE LD C,E LD B,D JNEXT ; DEFB 0C1H ; ; DM ';' DEFW COLON-4 SEMI: DEFW DOCOL DEFW QCSP DEFW COMP DEFW SEMIS DEFW SMUDG DEFW LBRAC DEFW SEMIS ; DEFB 84H ;NOOP DM 'NOOP' DEFW SEMI-4 NOOP: DEFW DOCOL DEFW SEMIS ; DEFB 88H ;CONSTANT DM 'CONSTANT' DEFW NOOP-7 CON: DEFW DOCOL DEFW CREAT DEFW SMUDG DEFW COMMA DEFW PSCOD DOCON: INC DE EX DE,HL LD E,(HL) INC HL LD D,(HL) PUSH DE JNEXT ; DEFB 88H ;VARIABLE DM 'VARIABLE' DEFW CON-0BH VAR: DEFW DOCOL DEFW CON DEFW PSCOD DOVAR: INC DE PUSH DE JNEXT ; DEFB 84H ;USER DM 'USER' DEFW VAR-0BH USER: DEFW DOCOL DEFW CON DEFW PSCOD DOUSE: INC DE EX DE,HL LD E,(HL) LD D,00H LD HL,(UP) ADD HL,DE JHPUSH ; DEFB 81H ;0 DM '0' DEFW USER-7 ZERO: DEFW $+2 ;/ LD HL,0 ;/ JHPUSH ;/ ; DEFB 81H ;1 DM '1' DEFW ZERO-4 ONE: DEFW $+2 ;/ LD HL,1 ;/ JHPUSH ;/ ; DEFB 81H ;2 DM '2' DEFW ONE-4 TWO: DEFW $+2 ;/ LD HL,2 ;/ JHPUSH ;/ ; DEFB 81H ;3 DM '3' DEFW TWO-4 THREE: DEFW $+2 ;/ LD HL,3 ;/ JHPUSH ;/ ; DEFB 82H ;BL DM 'BL' DEFW THREE-4 BL: DEFW DOCON DEFW 20H ; DEFB 83H ;C/L DM 'C/L' DEFW BL-5 CSLL: DEFW DOCON DEFW 64 ; DEFB 85H ;FIRST DM 'FIRST' DEFW CSLL-6 FIRST: DEFW DOCON DEFW 0 ;/ set by CLD ; DEFB 85H ;LIMIT DM 'LIMIT' DEFW FIRST-8 LIMIT: DEFW DOCON DEFW 0 ;/ set by CLD ; DEFB 85H ;B/BUF DM 'B/BUF' DEFW LIMIT-8 BBUF: DEFW DOCON DEFW KBBUF ; DEFB 85H ;B/SCR DM 'B/SCR' DEFW BBUF-8 BSCR: DEFW DOCON DEFW 400H/KBBUF ; DEFB 87H ;+ORIGIN DM '+ORIGIN' DEFW BSCR-8 PORIG: DEFW DOCOL DEFW LIT DEFW ORIG DEFW PLUS DEFW SEMIS ; ; USER VARIABLES ; DEFB 82H ;S0 DM 'S0' DEFW PORIG-0AH SZERO: DEFW DOUSE DEFW 6 ; DEFB 82H ;R0 DM 'R0' DEFW SZERO-5 RZERO: DEFW DOUSE DEFW 8 ; DEFB 83H ;TIB DM 'TIB' DEFW RZERO-5 TIB: DEFW DOUSE DEFB 0AH ; DEFB 85H ;WIDTH DM 'WIDTH' DEFW TIB-6 WIDTH: DEFW DOUSE DEFB 0CH ; DEFB 87H ;WARNING DM 'WARNING' DEFW WIDTH-8 WARN: DEFW DOUSE DEFB 0EH ; DEFB 85H ;FENCE DM 'FENCE' DEFW WARN-0AH FENCE: DEFW DOUSE DEFB 10H ; DEFB 82H ;DP DM 'DP' DEFW FENCE-8 DP: DEFW DOUSE DEFB 12H ; DEFB 88H ;VOC-LINK DM 'VOC-LINK' DEFW DP-5 VOCL: DEFW DOUSE DEFW 14H ; DEFB 83H ;BLK DM 'BLK' DEFW VOCL-0BH BLK: DEFW DOUSE DEFB 16H ; DEFB 82H ;IN DM 'IN' DEFW BLK-6 INN: DEFW DOUSE DEFB 18H ; DEFB 83H ;OUT DM 'OUT' DEFW INN-5 OUTT: DEFW DOUSE DEFB 1AH ; DEFB 83H ;SCR DM 'SCR' DEFW OUTT-6 SCR: DEFW DOUSE DEFB 1CH ; DEFB 86H ;OFFSET DM 'OFFSET' DEFW SCR-6 OFSET: DEFW DOUSE DEFB 1EH ; DEFB 87H ;CONTEXT DM 'CONTEXT' DEFW OFSET-9 CONT: DEFW DOUSE DEFB 20H ; DEFB 87H ;CURRENT DM 'CURRENT' DEFW CONT-0AH CURR: DEFW DOUSE DEFB 22H ; DEFB 85H ;STATE DM 'STATE' DEFW CURR-0AH STATE: DEFW DOUSE DEFB 24H ; DEFB 84H ;BASE DM 'BASE' DEFW STATE-8 BASE: DEFW DOUSE DEFB 26H ; DEFB 83H ;DPL DM 'DPL' DEFW BASE-7 DPL: DEFW DOUSE DEFB 28H ; DEFB 83H ;FLD DM 'FLD' DEFW DPL-6 FLD: DEFW DOUSE DEFB 2AH ; DEFB 83H ;CSP DM 'CSP' DEFW FLD-6 CSPP: DEFW DOUSE DEFB 2CH ; DEFB 82H ;R# DM 'R#' DEFW CSPP-6 RNUM: DEFW DOUSE DEFB 2EH ; DEFB 83H ;HLD DM 'HLD' DEFW RNUM-5 HLD: DEFW DOUSE DEFW 30H ; ; END OF USER VARIABLES ; DEFB 82H ;1+ DM '1+' DEFW HLD-6 ONEP: DEFW $+2 ;/ POP HL ;/ INC HL ;/ JHPUSH ;/ ; DEFB 82H ;2+ DM '2+' DEFW ONEP-5 TWOP: DEFW $+2 ;/ POP HL ;/ INC HL ;/ INC HL ;/ JHPUSH ;/ ; DEFB 82H ;/ 1- DM '1-' ;/ DEFW TWOP-5 ;/ ONEMIN: DEFW $+2 ;/ POP HL ;/ DEC HL ;/ JHPUSH ;/ ; DEFB 82H ;/ 2- DM '2-' ;/ DEFW ONEMIN-5 ;/ TWOMIN: DEFW $+2 ;/ POP HL ;/ DEC HL ;/ DEC HL ;/ JHPUSH ;/ ; DEFB 82H ;/ 2* DM '2*' ;/ DEFW TWOMIN-5 ;/ TWOSTA: DEFW $+2 ;/ POP HL ;/ ADD HL,HL ;/ ASL HL JHPUSH ;/ ; DEFB 82H ;/ 2/ DM '2/' ;/ DEFW TWOSTA-5 ;/ TWOSLA: DEFW $+2 ;/ POP HL ;/ BIT 7,H ;/ JR Z,TWOSL1 ;/ INC HL ;/ TWOSL1: SRA H ;/ RR L ;/ ASR HL JHPUSH ;/ ; DEFB 84H ;HERE DM 'HERE' DEFW TWOSLA-5 HERE: DEFW DOCOL DEFW DP DEFW AT DEFW SEMIS ; DEFB 85H ;ALLOT DM 'ALLOT' DEFW HERE-7 ALLOT: DEFW DOCOL DEFW DP DEFW PSTOR DEFW SEMIS ; DEFB 81H ; , DM ',' DEFW ALLOT-8 COMMA: DEFW DOCOL DEFW HERE DEFW STORE DEFW TWO DEFW ALLOT DEFW SEMIS ; DEFB 82H ;C, DM 'C,' DEFW COMMA-4 CCOMM: DEFW DOCOL DEFW HERE DEFW CSTOR DEFW ONE DEFW ALLOT DEFW SEMIS ; DEFB 81H ;- DM '-' DEFW CCOMM-5 SUBB: DEFW $+2 POP DE POP HL OR A ;/ RESET CARRY SBC HL,DE ;/ JHPUSH ; DEFB 81H ;= DM '=' DEFW SUBB-4 EQUAL: DEFW $+2 ;/ POP DE ;/ POP HL ;/ XOR A ;/ RESET CARRY SBC HL,DE ;/ LD H,A ;/ LD L,A ;/ LD HL,0000H JR NZ,EXEQU ;/ FALSE INC L ;/ TRUE EXEQU: JHPUSH ;/ ; DEFB 81H ; < DM '<' DEFW EQUAL-4 LESS: DEFW $+2 POP DE POP HL ; (HL) (DE) < LD A,D XOR H ; ONE OF THEM NEGATIVE? JP M,LES1 ; YES, DETERMINE WHICH OR A ;/ CLR CARRY SBC HL,DE ;/ LES1: BIT 7,H ;/ (H) NEGATIVE? LD HL,0 JR Z,EXLESS ;/ NO, FALSE INC L ;/ TRUE EXLESS: JHPUSH ; DEFB 82H ;U< DM 'U<' DEFW LESS-4 ULESS: DEFW $+2 ;/ POP DE POP HL ;/ (HL) (DE) U< XOR A ;/ SBC HL,DE ;/ LD H,A ;/ LD L,A ;/ LD HL,0000H JR NC,EXULES ;/ FALSE INC L ;/ TRUE EXULES: JHPUSH ; DEFB 81H ;> DM '>' DEFW ULESS-5 GREAT: DEFW $+2 POP HL ;/ POP DE ;/ (HL) (DE) > = (DE) (HL) < LD A,D XOR H ; ONE OF THEM NEGATIVE? JP M,GREAT1 ; YES, DETERMINE WHICH OR A ;/ CLR CARRY SBC HL,DE ;/ GREAT1: BIT 7,H ;/ (H) NEGATIVE? LD HL,0 ; (HL)<--FALSE JR Z,GREAT2 ;/ NO, FALSE INC L ;/ (HL)<--TRUE GREAT2: JHPUSH ; DEFB 83H ;ROT DM 'ROT' DEFW GREAT-4 ROT: DEFW $+2 POP DE POP HL EX (SP),HL JP DPUSH ; DEFB 85H ;SPACE DM 'SPACE' DEFW ROT-6 SPACE: DEFW DOCOL DEFW BL DEFW EMIT DEFW SEMIS ; DEFB 84H ;-DUP DM '-DUP' DEFW SPACE-8 DDUP: DEFW $+2 ;/ POP HL ;/ LD A,H ;/ OR L ;/ (HL)=0? JR Z,EXDDUP ;/ YES, DON'T DUP PUSH HL ;/ EXDDUP: JHPUSH ; DEFB 88H ;TRAVERSE DM 'TRAVERSE' DEFW DDUP-7 TRAV: DEFW DOCOL DEFW SWAP TRAV1: DEFW OVER ;BEGIN DEFW PLUS DEFW LIT DEFW 7FH DEFW OVER DEFW CAT DEFW LESS DEFW ZBRAN ;UNTIL DEFW TRAV1-$ DEFW SWAP DEFW DROP DEFW SEMIS ; DEFB 86H ;LATEST DM 'LATEST' DEFW TRAV-0BH LATES: DEFW DOCOL DEFW CURR DEFW AT DEFW AT DEFW SEMIS ; DEFB 83H ;LFA DM 'LFA' DEFW LATES-9 LFA: DEFW $+2 ;/ POP HL ;/ (HL)<--PFA DEC HL ;/ DEC HL ;/ DEC HL ;/ DEC HL ;/ (HL)<--(HL)-4 = LFA JHPUSH ;/ ; DEFB 83H ;CFA DM 'CFA' DEFW LFA-6 CFA: DEFW DOCOL DEFW TWOMIN ;/ DEFW SEMIS ; DEFB 83H ;NFA DM 'NFA' DEFW CFA-6 NFA: DEFW DOCOL DEFW LIT DEFW 5 DEFW SUBB DEFW LIT DEFW -1 DEFW TRAV DEFW SEMIS ; DEFB 83H ;PFA DM 'PFA' DEFW NFA-6 PFA: DEFW DOCOL DEFW ONE DEFW TRAV DEFW LIT DEFW 5 DEFW PLUS DEFW SEMIS ; DEFB 84H ;!CSP DM '!CSP' DEFW PFA-6 SCSP: DEFW DOCOL DEFW SPAT DEFW CSPP DEFW STORE DEFW SEMIS ; DEFB 86H ;?ERROR DM '?ERROR' DEFW SCSP-7 QERR: DEFW DOCOL DEFW SWAP DEFW ZBRAN ;IF DEFW QERR1-$ DEFW ERROR DEFW BRAN ;ELSE DEFW QERR2-$ QERR1: DEFW DROP ;ENDIF QERR2: DEFW SEMIS ; DEFB 85H ;?COMP DM '?COMP' DEFW QERR-9 QCOMP: DEFW DOCOL DEFW STATE DEFW AT DEFW ZEQU DEFW LIT DEFW 11H DEFW QERR DEFW SEMIS ; DEFB 85H ;?EXEC DM '?EXEC' DEFW QCOMP-8 QEXEC: DEFW DOCOL DEFW STATE DEFW AT DEFW LIT DEFW 12H DEFW QERR DEFW SEMIS ; DEFB 86H ;?PAIRS DM '?PAIRS' DEFW QEXEC-8 QPAIR: DEFW DOCOL DEFW SUBB DEFW LIT DEFW 13H DEFW QERR DEFW SEMIS ; DEFB 84H ;?CSP DM '?CSP' DEFW QPAIR-9 QCSP: DEFW DOCOL DEFW SPAT DEFW CSPP DEFW AT DEFW SUBB DEFW LIT DEFW 14H DEFW QERR DEFW SEMIS ; DEFB 88H ;?LOADING DM '?LOADING' DEFW QCSP-7 QLOAD: DEFW DOCOL DEFW BLK DEFW AT DEFW ZEQU DEFW LIT DEFW 16H DEFW QERR DEFW SEMIS ; DEFB 87H ;COMPILE DM 'COMPILE' DEFW QLOAD-0BH COMP: DEFW DOCOL DEFW QCOMP DEFW FROMR DEFW DUP DEFW TWOP DEFW TOR DEFW AT DEFW COMMA DEFW SEMIS ; DEFB 0C1H ;[ DM '[' DEFW COMP-0AH LBRAC: DEFW DOCOL DEFW ZERO DEFW STATE DEFW STORE DEFW SEMIS ; DEFB 81H ;] DM ']' DEFW LBRAC-4 RBRAC: DEFW DOCOL DEFW LIT,0C0H DEFW STATE,STORE DEFW SEMIS ; DEFB 86H ;SMUDGE DM 'SMUDGE' DEFW RBRAC-4 SMUDG: DEFW DOCOL DEFW LATES DEFW LIT DEFW 20H DEFW TOGGL DEFW SEMIS ; DEFB 83H ;HEX DM 'HEX' DEFW SMUDG-9 HEX: DEFW DOCOL DEFW LIT DEFW 10H DEFW BASE DEFW STORE DEFW SEMIS ; DEFB 87H ;DECIMAL DM 'DECIMAL' DEFW HEX-6 DEC: DEFW DOCOL DEFW LIT DEFW 0AH DEFW BASE DEFW STORE DEFW SEMIS ; DEFB 87H ;(;CODE) DM '(;CODE)' DEFW DEC-0AH PSCOD: DEFW DOCOL DEFW FROMR DEFW LATES DEFW PFA DEFW CFA DEFW STORE DEFW SEMIS ; DEFB 0C5H ; ;CODE DM ';CODE' DEFW PSCOD-0AH SEMIC: DEFW DOCOL DEFW QCSP DEFW COMP DEFW PSCOD DEFW LBRAC SEMI1: DEFW NOOP ;ASSEMBLER DEFW SEMIS ; DEFB 87H ;<BUILDS DM '<BUILDS' DEFW SEMIC-8 BUILD: DEFW DOCOL DEFW ZERO DEFW CON DEFW SEMIS ; DEFB 85H ;DOES> DM 'DOES>' DEFW BUILD-0AH DOES: DEFW DOCOL DEFW FROMR DEFW LATES DEFW PFA DEFW STORE DEFW PSCOD DODOE: LD HL,(RPP) DEC HL LD (HL),B DEC HL LD (HL),C LD (RPP),HL INC DE EX DE,HL LD C,(HL) INC HL LD B,(HL) INC HL JHPUSH ; DEFB 85H ;COUNT DM 'COUNT' DEFW DOES-8 COUNT: DEFW DOCOL DEFW DUP DEFW ONEP DEFW SWAP DEFW CAT DEFW SEMIS ; DEFB 84H ;TYPE DM 'TYPE' DEFW COUNT-8 TYPE: DEFW DOCOL DEFW DDUP DEFW ZBRAN ;IF DEFW TYPE1-$ DEFW OVER DEFW PLUS DEFW SWAP DEFW XDO ;DO TYPE2: DEFW IDO DEFW CAT DEFW EMIT DEFW XLOOP ;LOOP DEFW TYPE2-$ DEFW BRAN ;ELSE DEFW TYPE3-$ TYPE1: DEFW DROP ;ENDIF TYPE3: DEFW SEMIS ; DEFB 89H ;-TRAILING DM '-TRAILING' DEFW TYPE-7 DTRAI: DEFW DOCOL DEFW DUP DEFW ZERO DEFW XDO ;DO DTRA1: DEFW TDUP ;/ DEFW PLUS DEFW ONEMIN ;/ DEFW CAT DEFW BL DEFW SUBB DEFW ZBRAN ;IF DEFW DTRA2-$ DEFW LEAVE DEFW BRAN ;ELSE DEFW DTRA3-$ DTRA2: DEFW ONEMIN ;/ DTRA3: DEFW XLOOP ;LOOP DEFW DTRA1-$ DEFW SEMIS ; DEFB 84H ;(.") DM '(.")' DEFW DTRAI-0CH PDOTQ: DEFW DOCOL DEFW RR DEFW COUNT DEFW DUP DEFW ONEP DEFW FROMR DEFW PLUS DEFW TOR DEFW TYPE DEFW SEMIS ; DEFB 0C2H ;." DM '."' DEFW PDOTQ-7 DOTQ: DEFW DOCOL DEFW LIT DEFW 22H DEFW STATE DEFW AT DEFW ZBRAN ;IF DEFW DOTQ1-$ DEFW COMP DEFW PDOTQ DEFW WORD DEFW HERE DEFW CAT DEFW ONEP DEFW ALLOT DEFW BRAN ;ELSE DEFW DOTQ2-$ DOTQ1: DEFW WORD DEFW HERE DEFW COUNT DEFW TYPE ;ENDIF DOTQ2: DEFW SEMIS ; DEFB 86H ;EXPECT DM 'EXPECT' DEFW DOTQ-5 EXPEC: DEFW DOCOL DEFW OVER DEFW PLUS DEFW OVER DEFW XDO ;DO EXPE1: DEFW KEY DEFW DUP DEFW LIT DEFW 0EH DEFW PORIG DEFW AT DEFW EQUAL DEFW ZBRAN ;IF DEFW EXPE2-$ DEFW DROP DEFW DUP DEFW IDO DEFW EQUAL DEFW DUP DEFW FROMR DEFW TWOMIN ;/ DEFW PLUS DEFW TOR DEFW ZBRAN ;IF DEFW EXPE6-$ DEFW LIT DEFW BELL DEFW BRAN ;ELSE DEFW EXPE7-$ EXPE6: DEFW LIT DEFW BSOUT ;ENDIF EXPE7: DEFW BRAN ;ELSE DEFW EXPE3-$ EXPE2: DEFW DUP DEFW LIT DEFW ACR ;/ DEFW EQUAL DEFW ZBRAN ;IF DEFW EXPE4-$ DEFW LEAVE DEFW DROP DEFW BL DEFW ZERO DEFW BRAN ;ELSE DEFW EXPE5-$ EXPE4: DEFW DUP ;ENDIF EXPE5: DEFW IDO DEFW CSTOR DEFW ZERO DEFW IDO DEFW ONEP DEFW STORE ;ENDIF EXPE3: DEFW EMIT DEFW XLOOP ;LOOP DEFW EXPE1-$ DEFW DROP DEFW SEMIS ; DEFB 85H ;QUERY DM 'QUERY' DEFW EXPEC-9 QUERY: DEFW DOCOL DEFW TIB DEFW AT DEFW LIT DEFW 50H DEFW EXPEC DEFW ZERO DEFW INN DEFW STORE DEFW SEMIS ; DEFB 0C1H ;NULL DEFB 80H DEFW QUERY-8 NULL: DEFW DOCOL DEFW BLK DEFW AT DEFW ZBRAN ;IF DEFW NULL1-$ DEFW ONE DEFW BLK DEFW PSTOR DEFW ZERO DEFW INN DEFW STORE DEFW BLK DEFW AT DEFW BSCR DEFW ONEMIN ;/ DEFW ANDD DEFW ZEQU DEFW ZBRAN ;IF DEFW NULL2-$ DEFW QEXEC DEFW FROMR DEFW DROP ;ENDIF NULL2: DEFW BRAN ;ELSE DEFW NULL3-$ NULL1: DEFW FROMR DEFW DROP ;ENDIF NULL3: DEFW SEMIS ; DEFB 84H ;FILL DM 'FILL' DEFW NULL-4 FILL: DEFW $+2 EXX ;/ SAVE IP POP DE ;/ (E)<--BYTE POP BC ; (BC)<--QUANTITY POP HL ;/ (HL)<--ADDR FILL1: LD A,B OR C ; QTY=0? JR Z,FILL2 ; YES LD (HL),E ;/ ((HL))<--BYTE INC HL ; INC POINTER DEC BC ; DEC COUNTER JP FILL1 ;/ FILL2: EXX ;/ RESTORE IP JNEXT ; DEFB 85H ;ERASE DM 'ERASE' DEFW FILL-7 ERASEE: DEFW DOCOL DEFW ZERO DEFW FILL DEFW SEMIS ; DEFB 86H ;BLANKS DM 'BLANKS' DEFW ERASEE-8 BLANK: DEFW DOCOL DEFW BL DEFW FILL DEFW SEMIS ; DEFB 84H ;HOLD DM 'HOLD' DEFW BLANK-9 HOLD: DEFW DOCOL DEFW LIT DEFW -1 DEFW HLD DEFW PSTOR DEFW HLD DEFW AT DEFW CSTOR DEFW SEMIS ; DEFB 83H ;PAD DM 'PAD' DEFW HOLD-7 PAD: DEFW DOCOL DEFW HERE DEFW LIT DEFW 44H DEFW PLUS DEFW SEMIS ; DEFB 84H ;WORD DM 'WORD' DEFW PAD-6 WORD: DEFW DOCOL DEFW BLK DEFW AT DEFW ZBRAN ;IF DEFW WORD1-$ DEFW BLK DEFW AT DEFW BLOCK DEFW BRAN ;ELSE DEFW WORD2-$ WORD1: DEFW TIB DEFW AT ;ENDIF WORD2: DEFW INN DEFW AT DEFW PLUS DEFW SWAP DEFW ENCL DEFW HERE DEFW LIT DEFW 22H DEFW BLANK DEFW INN DEFW PSTOR DEFW OVER DEFW SUBB DEFW TOR DEFW RR DEFW HERE DEFW CSTOR DEFW PLUS DEFW HERE DEFW ONEP DEFW FROMR DEFW CMOVE DEFW SEMIS ; DEFB 88H ;(NUMBER) DM '(NUMBER)' DEFW WORD-7 PNUMB: DEFW DOCOL PNUM1: DEFW ONEP ;BEGIN DEFW DUP DEFW TOR DEFW CAT DEFW BASE DEFW AT DEFW DIGIT DEFW ZBRAN ;WHILE DEFW PNUM2-$ DEFW SWAP DEFW BASE DEFW AT DEFW USTAR DEFW DROP DEFW ROT DEFW BASE DEFW AT DEFW USTAR DEFW DPLUS DEFW DPL DEFW AT DEFW ONEP DEFW ZBRAN ;IF DEFW PNUM3-$ DEFW ONE DEFW DPL DEFW PSTOR ;ENDIF PNUM3: DEFW FROMR DEFW BRAN ;REPEAT DEFW PNUM1-$ PNUM2: DEFW FROMR DEFW SEMIS ; DEFB 86H ;NUMBER DM 'NUMBER' DEFW PNUMB-0BH NUMB: DEFW DOCOL DEFW ZERO DEFW ZERO DEFW ROT DEFW DUP DEFW ONEP DEFW CAT DEFW LIT DEFW 2DH DEFW EQUAL DEFW DUP DEFW TOR DEFW PLUS DEFW LIT DEFW -1 NUMB1: DEFW DPL ;BEGIN DEFW STORE DEFW PNUMB DEFW DUP DEFW CAT DEFW BL DEFW SUBB DEFW ZBRAN ;WHILE DEFW NUMB2-$ DEFW DUP DEFW CAT DEFW LIT DEFW 2EH DEFW SUBB DEFW ZERO DEFW QERR DEFW ZERO DEFW BRAN ;REPEAT DEFW NUMB1-$ NUMB2: DEFW DROP DEFW FROMR DEFW ZBRAN ;IF DEFW NUMB3-$ DEFW DMINU ;ENDIF NUMB3: DEFW SEMIS ; DEFB 85H ;-FIND (0-3) SUCCESS DM '-FIND' ; (0-1) FAILURE DEFW NUMB-9 DFIND: DEFW DOCOL DEFW BL DEFW WORD DEFW HERE DEFW CONT DEFW AT DEFW AT DEFW PFIND DEFW DUP DEFW ZEQU DEFW ZBRAN ;IF DEFW DFIN1-$ DEFW DROP DEFW HERE DEFW LATES DEFW PFIND ;ENDIF DFIN1: DEFW SEMIS ; DEFB 87H ;(ABORT) DM '(ABORT)' DEFW DFIND-8 PABOR: DEFW DOCOL DEFW ABORT DEFW SEMIS ; DEFB 85H ;ERROR DM 'ERROR' DEFW PABOR-0AH ERROR: DEFW DOCOL DEFW WARN DEFW AT DEFW ZLESS DEFW ZBRAN ;IF DEFW ERRO1-$ DEFW PABOR ;ENDIF ERRO1: DEFW HERE DEFW COUNT DEFW TYPE DEFW PDOTQ DEFB 2 DB '? ' DEFW MESS DEFW SPSTO ; CHANGE FROM fig MODEL ; DEFW INN,AT,BLK,AT DEFW BLK,AT DEFW DDUP DEFW ZBRAN,ERRO2-$ ;IF DEFW INN,AT DEFW SWAP ;ENDIF ERRO2: DEFW QUIT ; DEFB 83H ;ID. DM 'ID.' DEFW ERROR-8 IDDOT: DEFW DOCOL DEFW PAD DEFW LIT DEFW 20H DEFW BLANK ;/ DEFW DUP DEFW PFA DEFW LFA DEFW OVER DEFW SUBB DEFW DUP ;/ change frm MODEL DEFW TOR ;/ to suppress BIT 7 DEFW PAD DEFW SWAP DEFW CMOVE DEFW PAD DEFW FROMR ;/ for terminals DEFW PAD ;/ with an 8 bit DEFW PLUS ;/ ASCCI character set. DEFW ONEMIN ;/ DEFW DUP ;/ DEFW AT ;/ DEFW LIT ;/ DEFW 7FH ;/ DEFW ANDD ;/ DEFW SWAP ;/ DEFW STORE ;/ DEFW COUNT DEFW LIT DEFW 1FH ; WIDTH DEFW ANDD DEFW TYPE DEFW SPACE DEFW SEMIS ; DEFB 86H ;CREATE DM 'CREATE' DEFW IDDOT-6 CREAT: DEFW DOCOL DEFW DFIND DEFW ZBRAN ;IF DEFW CREA1-$ DEFW DROP DEFW NFA DEFW IDDOT DEFW LIT DEFW 4 DEFW MESS DEFW SPACE ;ENDIF CREA1: DEFW HERE DEFW DUP DEFW CAT DEFW WIDTH DEFW AT DEFW MIN DEFW ONEP DEFW ALLOT DEFW DUP DEFW LIT DEFW 0A0H DEFW TOGGL DEFW HERE DEFW ONEMIN DEFW LIT DEFW 80H DEFW TOGGL DEFW LATES DEFW COMMA DEFW CURR DEFW AT DEFW STORE DEFW HERE DEFW TWOP DEFW COMMA DEFW SEMIS ; DEFB 0C9H ;[COMPILE] DM '[COMPILE]' DEFW CREAT-9 BCOMP: DEFW DOCOL DEFW DFIND DEFW ZEQU DEFW ZERO DEFW QERR DEFW DROP DEFW CFA DEFW COMMA DEFW SEMIS ; DEFB 0C7H ;LITERAL DM 'LITERAL' DEFW BCOMP-0CH LITER: DEFW DOCOL DEFW STATE DEFW AT DEFW ZBRAN ;IF DEFW LITE1-$ DEFW COMP DEFW LIT DEFW COMMA ;ENDIF LITE1: DEFW SEMIS ; DEFB 0C8H ;DLITERAL DM 'DLITERAL' DEFW LITER-0AH DLITE: DEFW DOCOL DEFW STATE DEFW AT DEFW ZBRAN ;IF DEFW DLIT1-$ DEFW SWAP DEFW LITER DEFW LITER ;ENDIF DLIT1: DEFW SEMIS ; DEFB 86H ;?STACK DM '?STACK' DEFW DLITE-0BH QSTAC: DEFW DOCOL DEFW SPAT DEFW SZERO DEFW AT DEFW SWAP DEFW ULESS DEFW ONE DEFW QERR DEFW SPAT DEFW HERE DEFW LIT DEFW 80H DEFW PLUS DEFW ULESS DEFW LIT DEFW 7 DEFW QERR DEFW SEMIS ; DEFB 89H ;INTERPRET DM 'INTERPRET' DEFW QSTAC-9 INTER: DEFW DOCOL INTE1: DEFW DFIND ;BEGIN DEFW ZBRAN ;IF DEFW INTE2-$ DEFW STATE DEFW AT DEFW LESS DEFW ZBRAN ;IF DEFW INTE3-$ DEFW CFA DEFW COMMA DEFW BRAN ;ELSE DEFW INTE4-$ INTE3: DEFW CFA DEFW EXEC ;ENDIF INTE4: DEFW QSTAC DEFW BRAN ;ELSE DEFW INTE5-$ INTE2: DEFW HERE DEFW NUMB DEFW DPL DEFW AT DEFW ONEP DEFW ZBRAN ;IF DEFW INTE6-$ DEFW DLITE DEFW BRAN ;ELSE DEFW INTE7-$ INTE6: DEFW DROP DEFW LITER ;ENDIF INTE7: DEFW QSTAC ;ENDIF INTE5: DEFW BRAN ;AGAIN DEFW INTE1-$ ; DEFB 89H ;IMMEDIATE DM 'IMMEDIATE' DEFW INTER-0CH IMMED: DEFW DOCOL DEFW LATES DEFW LIT DEFW 40H DEFW TOGGL DEFW SEMIS ; DEFB 8AH ;VOCABULARY DM 'VOCABULARY' DEFW IMMED-0CH VOCAB: DEFW DOCOL DEFW BUILD DEFW LIT DEFW 0A081H DEFW COMMA DEFW CURR DEFW AT DEFW CFA DEFW COMMA DEFW HERE DEFW VOCL DEFW AT DEFW COMMA DEFW VOCL DEFW STORE DEFW DOES DOVOC: DEFW TWOP DEFW CONT DEFW STORE DEFW SEMIS ; DEFB 0C5H ;FORTH DM 'FORTH' DEFW VOCAB-0DH FORTH: DEFW DODOE DEFW DOVOC DEFW 0A081H DEFW TASK-7 ;COLD START VALUE ONLY. ; CHANGED EACH TIME A DEF IS APPENDED ; TO THE FORTH VOCABULARY DEFW 0 ;END OF VOCABULARY LIST ; DEFB 8BH ;DEFINITIONS DM 'DEFINITIONS' DEFW FORTH-8 DEFIN: DEFW DOCOL DEFW CONT DEFW AT DEFW CURR DEFW STORE DEFW SEMIS ; DEFB 0C1H ;( DM '(' DEFW DEFIN-0EH PAREN: DEFW DOCOL DEFW LIT DEFW 29H DEFW WORD DEFW SEMIS ; DEFB 84H ;QUIT DM 'QUIT' DEFW PAREN-4 QUIT: DEFW DOCOL DEFW ZERO DEFW BLK DEFW STORE DEFW LBRAC QUIT1: DEFW RPSTO ;BEGIN DEFW CR DEFW QUERY DEFW INTER DEFW STATE DEFW AT DEFW ZEQU DEFW ZBRAN ;IF DEFW QUIT2-$ DEFW PDOTQ DEFB 2 DB 'ok' ;ENDIF QUIT2: DEFW BRAN ;AGAIN DEFW QUIT1-$ ; DEFB 85H ;ABORT DM 'ABORT' DEFW QUIT-7 ABORT: DEFW DOCOL DEFW SPSTO DEFW DEC DEFW QSTAC DEFW CR DEFW DOTCPU DEFW PDOTQ DEFB 0EH ;count of CHRs to follow DB 'fig-FORTH ' DEFB FIGREL+30H,ADOT,FIGREV+30H,USRVER DEFW FORTH DEFW DEFIN DEFW QUIT ; WRM: LD BC,WRM1 JNEXT WRM1: DEFW WARM ; DEFB 84H ;WARM DM 'WARM' DEFW ABORT-8 WARM: DEFW DOCOL DEFW MTBUF DEFW ABORT ; CLD: LD HL,(BDOSS+1) ;/ LD L,0 ;/ (HL)<--FBASE LD (LIMIT+2),HL ;/ set LIMIT LD DE,BUFSIZ ;/ (DE)<--total disc buffer size OR A ;/ clr carry SBC HL,DE ;/ (HL)<--addr. of 1st disc buffer LD (FIRST+2),HL ;/ set FIRST LD (USE+2),HL ;/ set USE LD (PREV+2),HL ;/ set PREV LD (BUF1),HL ;/ LD DE,US ;/ (DE)<--user variable space SBC HL,DE ;/ (HL)<--INITR0 LD (UPINIT),HL ;/ LD (R0INIT),HL ;/ LD (UP),HL ;/ LD (RPP),HL ;/ LD DE,RTS ;/ (DE)<--return stack & terminal buffer space SBC HL,DE ;/ (HL)<--INITS0 LD (S0INIT),HL ;/ LD (TIBINI),HL ;/ LD SP,HL ;/ LD BC,CLD1 LD IX,NEXT ; POINTER TO NEXT LD IY,HPUSH ; POINTER TO HPUSH JNEXT ; CLD1: DEFW COLD ; DEFB 84H ;COLD DM 'COLD' DEFW WARM-7 COLD: DEFW DOCOL DEFW MTBUF DEFW ONE,RECADR ;AvdH DEFW STORE DEFW LIT,BUF1 DEFW AT ;/ DEFW USE,STORE DEFW LIT,BUF1 DEFW AT ;/ DEFW PREV,STORE DEFW DRZER DEFW ZERO ;/ DEFW LIT,EPRINT DEFW CSTOR ;/ ; DEFW LIT DEFW ORIG+12H DEFW LIT DEFW UP DEFW AT DEFW LIT DEFW 6 DEFW PLUS DEFW LIT DEFW 10H DEFW CMOVE DEFW LIT DEFW ORIG+0CH DEFW AT DEFW LIT DEFW FORTH+6 DEFW STORE DEFW FCB ;/A DEFW LIT,OPNFIL ;/A open mass storage DEFW BDOS ;/A DEFW LIT,0FFH ;/A DEFW EQUAL ;/A file present? DEFW ZBRAN,CLD2-$ ;/A DEFW ZERO ;/A DEFW WARN,STORE ;/A DEFW CR,PDOTQ ;/A DEFB 7 ;/A DB 'No file' ;/A CLD2: DEFW ABORT ; DEFB 84H ;S->D DM 'S->D' DEFW COLD-7 STOD: DEFW $+2 POP DE LD HL,0 BIT 7,D ;/ # NEGATIVE? JR Z,STOD1 ; NO DEC HL ; YES, EXTEND SIGN STOD1: JP DPUSH ; ( n1--d1L d1H) ; DEFB 82H ;+- DM '+-' DEFW STOD-7 PM: DEFW DOCOL DEFW ZLESS DEFW ZBRAN ;IF DEFW PM1-$ DEFW MINUS ;ENDIF PM1: DEFW SEMIS ; DEFB 83H ;D+- DM 'D+-' DEFW PM-5 DPM: DEFW DOCOL DEFW ZLESS DEFW ZBRAN ;IF DEFW DPM1-$ DEFW DMINU ;ENDIF DPM1: DEFW SEMIS ; DEFB 83H ;ABS DM 'ABS' DEFW DPM-6 ABS: DEFW DOCOL DEFW DUP DEFW PM DEFW SEMIS ; DEFB 84H ;DABS DM 'DABS' DEFW ABS-6 DABS: DEFW DOCOL DEFW DUP DEFW DPM DEFW SEMIS ; DEFB 83H ;MIN DM 'MIN' DEFW DABS-7 MIN: DEFW DOCOL,TDUP DEFW GREAT DEFW ZBRAN ;IF DEFW MIN1-$ DEFW SWAP ;ENDIF MIN1: DEFW DROP DEFW SEMIS ; DEFB 83H ;MAX DM 'MAX' DEFW MIN-6 MAX: DEFW DOCOL DEFW TDUP DEFW LESS DEFW ZBRAN ;IF DEFW MAX1-$ DEFW SWAP ;ENDIF MAX1: DEFW DROP DEFW SEMIS ; DEFB 82H ;M* DM 'M*' DEFW MAX-6 MSTAR: DEFW DOCOL,TDUP DEFW XORR DEFW TOR DEFW ABS DEFW SWAP DEFW ABS DEFW USTAR DEFW FROMR DEFW DPM DEFW SEMIS ; DEFB 82H ;M/ DM 'M/' DEFW MSTAR-5 MSLAS: DEFW DOCOL DEFW OVER DEFW TOR DEFW TOR DEFW DABS DEFW RR DEFW ABS DEFW USLAS DEFW FROMR DEFW RR DEFW XORR DEFW PM DEFW SWAP DEFW FROMR DEFW PM DEFW SWAP DEFW SEMIS ; DEFB 81H ; * DM '*' DEFW MSLAS-5 STAR: DEFW $+2 EXX ;/ SAVE IP POP HL POP DE LD A,L ;/ LD C,H ;/ LD B,10H ;/ LD HL,0 ;/ STAR1: SRL C ;/ RRA ;/ SRL CA (MPCATOR) JR NC,STAR2 ;/ LSB (CA)=0? ADD HL,DE ;/ NO, ADD MPCANT TO HL STAR2: SLA E ;/ RL D ;/ SLA DE (MPCANT 2 *) DJNZ STAR1 ;/ DO ALL 16 BITS PUSH HL ;/ (S1)<--PRODUCT EXX ;/ RESTORE IP JNEXT ; DEFB 84H ; /MOD DM '/MOD' DEFW STAR-4 SLMOD: DEFW $+2 POP DE ;/ DIVISOR POP HL ;/ DIVIDEND PUSH BC ;/ SAVE IP XOR A ;/ RESET NEGATE FLAG EX AF,AF' ;/ ALT SET LD A,D ;/ OR E ;/ DIV BY 0? JR NZ,SLMOD1 ;/ LD HL,-1 ;/ YES LD D,H ;/ LD E,L ;/ QUOT & REM <-- -1 JR SLMOD7 ;/ EXIT SLMOD1: BIT 7,D ;/ DIVISOR NEGATIVE? JR Z,SLMOD2 ;/ LD A,E ;/ YES CPL ;/ LD E,A ;/ LD A,D ;/ CPL ;/ LD D,A ;/ INC DE ;/ (DE)<--(DE)'s 2's COMPLEMENT EX AF,AF' ;/ STD SET SCF ;/ SET NEGATE FLAG EX AF,AF' ;/ ALT SET SLMOD2: BIT 7,H ;/ DIVIDEND NEGATIVE? JR Z,SLMOD3 ;/ LD A,L ;/ YES CPL ;/ LD L,A ;/ LD A,H ;/ CPL ;/ LD H,A ;/ INC HL ;/ (HL)<--(HL)'s 2's COMPLEMENT EX AF,AF' ;/ STD SET CCF ;/ NEGATE FLAG INC A ;/ DIVIDEND SIGN FLAG EX AF,AF' ;/ ALT SET SLMOD3: LD A,L ;/ LD C,H ;/ (CA)<--DIVIDEND LD HL,0 ;/ PRIME REMAINDER LD B,10H ;/ LOOP COUNTER SLMOD4: RLA ;/ RL C ;/ RL CA ADC HL,HL ;/ (HL)<--(HL) 2 * CARRY + SBC HL,DE ;/ UNDERFLOW? JR NC,SLMOD5 ;/ NO ADD HL,DE ;/ YES, RESTORE REMAINDER SLMOD5: CCF ;/ DJNZ SLMOD4 ;/ DO ALL 16 BITS RLA ;/ RL C ;/ RL CA LD E,A ;/ LD D,C ;/ (DE)<--QUOTIENT EX AF,AF' ;/ STD SET JR Z,SLMOD6 ;/ DIVIDEND POSITIVE LD A,L ;/ CPL ;/ LD L,A ;/ LD A,H ;/ CPL ;/ LD H,A ;/ INC HL ;/ REM GETS DIVIDEND'S SIGN SLMOD6: JR NC,SLMOD7 ;/ QUOTIENT POSITIVE LD A,E ;/ CPL ;/ LD E,A ;/ LD A,D ;/ CPL ;/ LD D,A ;/ INC DE ;/ NEGATIVE QUOTIENT SLMOD7: POP BC ;/ RESTORE IP EX DE,HL ;/ (S2)<--REMAINDER JP DPUSH ;/ (S1)<--QUOTIENT ; DEFB 81H ; / DM '/' DEFW SLMOD-7 SLASH: DEFW $+2 POP DE ;/ DIVISOR POP HL ;/ DIVIDEND PUSH BC ;/ SAVE IP XOR A ;/ RESET NEG. FLAG EX AF,AF' ;/ ALT SET LD A,D ;/ OR E ;/ DIV BY 0? JR NZ,SLASH1 ;/ LD HL,-1 ;/ YES, SET QUOTIENT TO -1 JR SLASH6 ;/ EXIT SLASH1: BIT 7,D ;/ DIVISOR NEGATIVE? JR Z,SLASH2 ;/ LD A,E ;/ YES CPL ;/ LD E,A ;/ LD A,D ;/ CPL ;/ LD D,A ;/ INC DE ;/ (DE)<--(DE)'s 2's COMPLEMENT EX AF,AF' ;/ STD SET SCF ;/ SET NEG. FLAG EX AF,AF' ;/ ALT SET SLASH2: BIT 7,H ;/ DIVIDEND NEGATIVE? JR Z,SLASH3 ;/ LD A,L ;/ YES CPL ;/ LD L,A ;/ LD A,H ;/ CPL ;/ LD H,A ;/ INC HL ;/ (HL)<--(HL)'s 2's COMPLEMENT EX AF,AF' ;/ STD SET CCF ;/ NEG. FLAG EX AF,AF' ;/ ALT SET SLASH3: LD A,L ;/ LD C,H ;/ (CA)<--DIVIDEND LD HL,0 ;/ LD B,10H ;/ LOOP COUNTER SLASH4: RLA ;/ RL C ;/ RL CA ADC HL,HL ;/ (HL)<--(HL) 2 * CARRY + SBC HL,DE ;/ UNDERFLOW? JR NC,SLASH5 ;/ NO ADD HL,DE ;/ YES, RESTORE REMAINDER SLASH5: CCF ;/ DJNZ SLASH4 ;/ DO ALL 16 BITS RLA ;/ RL C ;/ RL CA LD L,A ;/ LD H,C ;/ (HL)<--QUOTIENT EX AF,AF' ;/ STD SET JR NC,SLASH6 ;/ POSITIVE QUOTIENT LD A,L ;/ CPL ;/ LD L,A ;/ LD A,H ;/ CPL ;/ LD H,A ;/ INC HL ;/ NEGATIVE QUOTIENT SLASH6: POP BC ;/ RESTORE IP JHPUSH ; DEFB 83H ; MOD DM 'MOD' DEFW SLASH-4 MODD: DEFW DOCOL DEFW SLMOD DEFW DROP DEFW SEMIS ; DEFB 85H ; */MOD DM '*/MOD' DEFW MODD-6 SSMOD: DEFW DOCOL DEFW TOR DEFW MSTAR DEFW FROMR DEFW MSLAS DEFW SEMIS ; DEFB 82H ; */ DM '*/' DEFW SSMOD-8 SSLA: DEFW DOCOL DEFW SSMOD DEFW SWAP DEFW DROP DEFW SEMIS ; DEFB 85H ; M/MOD DM 'M/MOD' DEFW SSLA-5 MSMOD: DEFW DOCOL DEFW TOR DEFW ZERO DEFW RR DEFW USLAS DEFW FROMR DEFW SWAP DEFW TOR DEFW USLAS DEFW FROMR DEFW SEMIS ; ; Block moved down 2 pages ; DEFB 86H ; (LINE) DM '(LINE)' DEFW MSMOD-8 PLINE: DEFW DOCOL DEFW TOR DEFW LIT DEFW 40H DEFW BBUF DEFW SSMOD DEFW FROMR DEFW BSCR DEFW STAR DEFW PLUS DEFW BLOCK DEFW PLUS DEFW LIT DEFW 40H DEFW SEMIS ; DEFB 85H ; .LINE DM '.LINE' DEFW PLINE-9 DLINE: DEFW DOCOL DEFW PLINE DEFW DTRAI DEFW TYPE DEFW SEMIS ; DEFB 87H ;MESSAGE DM 'MESSAGE' DEFW DLINE-8 MESS: DEFW DOCOL DEFW WARN DEFW AT DEFW ZBRAN ;IF DEFW MESS1-$ DEFW DDUP DEFW ZBRAN ;IF DEFW MESS2-$ DEFW LIT DEFW 4 ;1st MESSAGE SCREEN DEFW OFSET DEFW AT DEFW BSCR DEFW SLASH DEFW SUBB DEFW DLINE DEFW SPACE ;ENDIF MESS2: DEFW BRAN ;ELSE DEFW MESS3-$ MESS1: DEFW PDOTQ DEFB 6 DB 'MSG # ' DEFW DOT ;ENDIF MESS3: DEFW SEMIS ; DEFB 82H ;P@ DM 'P@' DEFW MESS-0AH PTAT: DEFW $+2 EXX ;d SAVE REGISTERS POP BC ;d (BC)<--PORT# IN L,(C) ;d (L)<--DATA BYTE LD H,0 PUSH HL EXX ;d RESTORE REGISTERS JNEXT ; DEFB 82H ;P! DM 'P!' DEFW PTAT-5 PTSTO: DEFW $+2 EXX ;d SAVE REGISTERS POP BC ;d (C)<--PORT# POP HL ;d (L)<--DATA BYTE OUT (C),L EXX ;d RESTORE REGISTERS JNEXT ; FORM *INCLUDE DISCIO.FTH FORM *INCLUDE CONPRTIO.FTH FORM ; DEFB 0C1H ; ' (tick) DEFB 0A7H DEFW ARROW-6 TICK: DEFW DOCOL DEFW DFIND DEFW ZEQU DEFW ZERO DEFW QERR DEFW DROP DEFW LITER DEFW SEMIS ; DEFB 86H ;FORGET DM 'FORGET' DEFW TICK-4 FORG: DEFW DOCOL DEFW CURR DEFW AT DEFW CONT DEFW AT DEFW SUBB DEFW LIT DEFW 18H DEFW QERR DEFW TICK DEFW DUP DEFW FENCE DEFW AT DEFW uless ;/ FORGET >8000h nw o.k. DEFW LIT DEFW 15H DEFW QERR DEFW DUP DEFW NFA DEFW DP DEFW STORE DEFW LFA DEFW AT DEFW CONT DEFW AT DEFW STORE DEFW SEMIS ; DEFB 84H ;BACK DM 'BACK' DEFW FORG-9 BACK: DEFW DOCOL DEFW HERE DEFW SUBB DEFW COMMA DEFW SEMIS ; DEFB 0C5H ;BEGIN DM 'BEGIN' DEFW BACK-7 BEGIN: DEFW DOCOL DEFW QCOMP DEFW HERE DEFW ONE DEFW SEMIS ; DEFB 0C5H ;ENDIF DM 'ENDIF' DEFW BEGIN-8 ENDIFF: DEFW DOCOL DEFW QCOMP DEFW TWO DEFW QPAIR DEFW HERE DEFW OVER DEFW SUBB DEFW SWAP DEFW STORE DEFW SEMIS ; DEFB 0C4H ;THEN DM 'THEN' DEFW ENDIFF-8 THEN: DEFW DOCOL DEFW ENDIFF DEFW SEMIS ; DEFB 0C2H ;DO DM 'DO' DEFW THEN-7 DO: DEFW DOCOL DEFW COMP DEFW XDO DEFW HERE DEFW THREE DEFW SEMIS ; DEFB 0C4H ;LOOP DM 'LOOP' DEFW DO-5 LOOP: DEFW DOCOL DEFW THREE DEFW QPAIR DEFW COMP DEFW XLOOP DEFW BACK DEFW SEMIS ; DEFB 0C5H ;+LOOP DM '+LOOP' DEFW LOOP-7 PLOOP: DEFW DOCOL DEFW THREE DEFW QPAIR DEFW COMP DEFW XPLOO DEFW BACK DEFW SEMIS ; DEFB 0C5H ;UNTIL DM 'UNTIL' DEFW PLOOP-8 UNTIL: DEFW DOCOL DEFW ONE DEFW QPAIR DEFW COMP DEFW ZBRAN DEFW BACK DEFW SEMIS ; DEFB 0C3H ;END DM 'END' DEFW UNTIL-8 ENDD: DEFW DOCOL DEFW UNTIL DEFW SEMIS ; DEFB 0C5H ;AGAIN DM 'AGAIN' DEFW ENDD-6 AGAIN: DEFW DOCOL DEFW ONE DEFW QPAIR DEFW COMP DEFW BRAN DEFW BACK DEFW SEMIS ; DEFB 0C6H ;REPEAT DM 'REPEAT' DEFW AGAIN-8 REPEA: DEFW DOCOL DEFW TOR DEFW TOR DEFW AGAIN DEFW FROMR DEFW FROMR DEFW TWOMIN ;/ DEFW ENDIFF DEFW SEMIS ; DEFB 0C2H ;IF DM 'IF' DEFW REPEA-9 IFF: DEFW DOCOL DEFW COMP DEFW ZBRAN DEFW HERE DEFW ZERO DEFW COMMA DEFW TWO DEFW SEMIS ; DEFB 0C4H ;ELSE DM 'ELSE' DEFW IFF-5 ELSEE: DEFW DOCOL DEFW TWO DEFW QPAIR DEFW COMP DEFW BRAN DEFW HERE DEFW ZERO DEFW COMMA DEFW SWAP DEFW TWO DEFW ENDIFF DEFW TWO DEFW SEMIS ; DEFB 0C5H ;WHILE DM 'WHILE' DEFW ELSEE-7 WHILE: DEFW DOCOL DEFW IFF DEFW TWOP DEFW SEMIS ; DEFB 86H ;SPACES DM 'SPACES' DEFW WHILE-8 SPACS: DEFW DOCOL DEFW ZERO DEFW MAX DEFW DDUP DEFW ZBRAN ;IF DEFW SPAX1-$ DEFW ZERO DEFW XDO ;DO SPAX2: DEFW SPACE DEFW XLOOP ;LOOP ENDIF DEFW SPAX2-$ SPAX1: DEFW SEMIS ; DEFB 82H ;<# DM '<#' DEFW SPACS-9 BDIGS: DEFW DOCOL DEFW PAD DEFW HLD DEFW STORE DEFW SEMIS ; DEFB 82H ;#> DM '#>' DEFW BDIGS-5 EDIGS: DEFW DOCOL DEFW DROP DEFW DROP DEFW HLD DEFW AT DEFW PAD DEFW OVER DEFW SUBB DEFW SEMIS ; DEFB 84H ;SIGN DM 'SIGN' DEFW EDIGS-5 SIGN: DEFW DOCOL DEFW ROT DEFW ZLESS DEFW ZBRAN ;IF DEFW SIGN1-$ DEFW LIT DEFW 2DH DEFW HOLD ;ENDIF SIGN1: DEFW SEMIS ; DEFB 81H ;# DM '#' DEFW SIGN-7 DIG: DEFW DOCOL DEFW BASE DEFW AT DEFW MSMOD DEFW ROT DEFW LIT DEFW 9 DEFW OVER DEFW LESS DEFW ZBRAN ;IF DEFW DIG1-$ DEFW LIT DEFW 7 DEFW PLUS ;ENDIF DIG1: DEFW LIT DEFW 30H DEFW PLUS DEFW HOLD DEFW SEMIS ; DEFB 82H ;#S DM '#S' DEFW DIG-4 DIGS: DEFW DOCOL DIGS1: DEFW DIG ;BEGIN DEFW TDUP ;/ DEFW ORR DEFW ZEQU DEFW ZBRAN ;UNTIL DEFW DIGS1-$ DEFW SEMIS ; DEFB 83H ;D.R DM 'D.R' DEFW DIGS-5 DDOTR: DEFW DOCOL DEFW TOR DEFW SWAP DEFW OVER DEFW DABS DEFW BDIGS DEFW DIGS DEFW SIGN DEFW EDIGS DEFW FROMR DEFW OVER DEFW SUBB DEFW SPACS DEFW TYPE DEFW SEMIS ; DEFB 82H ;.R DM '.R' DEFW DDOTR-6 DOTR: DEFW DOCOL DEFW TOR DEFW STOD DEFW FROMR DEFW DDOTR DEFW SEMIS ; DEFB 82H ;D. DM 'D.' DEFW DOTR-5 DDOT: DEFW DOCOL DEFW ZERO DEFW DDOTR DEFW SPACE DEFW SEMIS ; DEFB 81H ; . DM '.' DEFW DDOT-5 DOT: DEFW DOCOL DEFW STOD DEFW DDOT DEFW SEMIS ; DEFB 81H ;? DM '?' DEFW DOT-4 QUES: DEFW DOCOL DEFW AT DEFW DOT DEFW SEMIS ; DEFB 82H ;U. DM 'U.' DEFW QUES-4 UDOT: DEFW DOCOL DEFW ZERO DEFW DDOT DEFW SEMIS ; DEFB 85H ;VLIST DM 'VLIST' DEFW UDOT-5 VLIST: DEFW DOCOL DEFW LIT DEFW 80H DEFW OUTT DEFW STORE DEFW CONT DEFW AT DEFW AT VLIS1: DEFW OUTT ;BEGIN DEFW AT DEFW CSLL DEFW GREAT DEFW ZBRAN ;IF DEFW VLIS2-$ DEFW CR DEFW ZERO DEFW OUTT DEFW STORE ;ENDIF VLIS2: DEFW DUP DEFW IDDOT DEFW SPACE DEFW SPACE DEFW PFA DEFW LFA DEFW AT DEFW DUP DEFW ZEQU DEFW QTERM DEFW ORR DEFW ZBRAN ;UNTIL DEFW VLIS1-$ DEFW DROP DEFW SEMIS ; DEFB 83H ;BYE DM 'BYE' DEFW VLIST-8 BYE: DEFW DOCOL ;/A DEFW FLUSH ;/A DEFW FCB,LIT ;/E DEFW 10H,BDOS ;/E close file DEFW DROP ;/E discard directory code DEFW ZERO,ZERO ;/A DEFW BDOS ;/A return to CP/M DEFW SEMIS ;/A won't get this far, just for pretty ; DEFB 84H ;LIST DM 'LIST' DEFW BYE-6 LIST: DEFW DOCOL,DEC DEFW CR,DUP DEFW SCR,STORE DEFW PDOTQ DEFB 6 DB 'SCR # ' DEFW DOT DEFW LIT,10H DEFW ZERO,XDO LIST1: DEFW CR,IDO DEFW THREE ;/ WAS LIT,3 DEFW DOTR,SPACE DEFW IDO,SCR DEFW AT,DLINE DEFW QTERM DEFW ZBRAN,LIST2-$ ;IF DEFW LEAVE LIST2: DEFW XLOOP,LIST1-$ ;ENDIF DEFW CR,SEMIS ; DEFB 85H ;INDEX DM 'INDEX' DEFW LIST-7 INDEX: DEFW DOCOL DEFW LIT,FF DEFW EMIT,CR DEFW ONEP,SWAP DEFW XDO INDE1: DEFW CR,IDO DEFW THREE ;/ WAS LIT,3 DEFW DOTR,SPACE DEFW ZERO,IDO DEFW DLINE,QTERM DEFW ZBRAN,INDE2-$ ;IF DEFW LEAVE ;ENDIF INDE2: DEFW XLOOP,INDE1-$ DEFW SEMIS ; DEFB 85H ;TRIAD DM 'TRIAD' DEFW INDEX-8 TRIAD: DEFW DOCOL DEFW LIT,FF DEFW EMIT DEFW THREE ;/ WAS LIT,3 DEFW SLASH DEFW THREE ;/ WAS LIT,3 DEFW STAR DEFW THREE ;/ WAS LIT,3 DEFW OVER,PLUS DEFW SWAP,XDO TRIA1: DEFW CR,IDO DEFW LIST DEFW QTERM DEFW ZBRAN,TRIA2-$ ;IF DEFW LEAVE TRIA2: DEFW XLOOP,TRIA1-$ ;ENDIF DEFW CR DEFW LIT,15 DEFW MESS,CR DEFW SEMIS ; DEFB 84H ;.CPU DM '.CPU' DEFW TRIAD-8 DOTCPU: DEFW DOCOL DEFW BASE,AT DEFW LIT,36 DEFW BASE,STORE DEFW LIT,22H DEFW PORIG,TAT DEFW DDOT DEFW BASE,STORE DEFW SEMIS ; DEFB 84H ;TASK DM 'TASK' DEFW DOTCPU-7 TASK: DEFW DOCOL DEFW SEMIS ; INITDP: DEFW 0 ; END
file: /Techref/language/FORTH/z80fig-Forth1_1g_files/Z80FORTH.ASM, 53KB, , updated: 1997/12/31 09:21, local time: 2024/10/14 10:09,
3.236.112.101:LOG IN ©2024 PLEASE DON'T RIP! THIS SITE CLOSES OCT 28, 2024 SO LONG AND THANKS FOR ALL THE FISH!
|
©2024 These pages are served without commercial sponsorship. (No popup ads, etc...).Bandwidth abuse increases hosting cost forcing sponsorship or shutdown. This server aggressively defends against automated copying for any reason including offline viewing, duplication, etc... Please respect this requirement and DO NOT RIP THIS SITE. Questions? <A HREF="http://www.ecomorder.com/techref/language/FORTH/z80fig-Forth1_1g_files/Z80FORTH.ASM"> language FORTH z80fig-Forth1_1g_files Z80FORTH</A> |
Did you find what you needed? |
Welcome to ecomorder.com! |
Welcome to www.ecomorder.com! |
.