CP/M

home *** CD-ROM | disk | FTP | other *** search

/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol070 / forth110.asm < prev next >

Wrap

Assembly Source File | 1985-02-10 | 62.0 KB | 4,108 lines

TITLE '8080 FIG-FORTH 1.1 VERSION A0 17SEP79' ; ; 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 ; ; IMPLEMENTATION BY: ; JOHN CASSADY ; FOR THE FORTH IMPLEMENTATION TEAM (FIT) MARCH 1979 ; MODIFIED for CP/M by: ; KIM HARRIS ; FIT LIBRARIAN SEPT 1979 ; ACKNOWLEDGEMENTS: ; GEORGE FLAMMER ; ROBT. D. VILLWOCK ; Microsystems inc. Pasadena Ca. ; ; DISTRIBUTED BY FORTH POWER ; P.O. BOX 2455 SAN RAFAEL CA ; 94902 415-471-1762 ; SUPPORT, SYSTEMS PROGRAMMING, ; APPLICATIONS PROGRAMMING ; ; UNLESS OTHERWISE INDICATED, THIS DISTRIBUTION IS SUPPORTED ; SOLELY BY THE FORTH INTEREST GROUP (LISTINGS) AND BY ; FORTH POWER (MACHINE READABLE COPIES AND EXTENSIONS). ; ; COPYRIGHT AND TRADEMARK NOTICES: ; FORTH (C) 1974,1975,1976,1977,1978,1979 FORTH INC. ; FIST (C) 1979 FORTH INTERNATIONAL STANDARDS TEAM ; FIG, FORTH DIMENSIONS, FIT, (C) 1978, 1979 FORTH INTEREST GROUP ; FORTH POWER (C) 1978, 1979 MARIN SERVICES, INC. ; FORTH 77, FORTH 78, FORTH 79, STANDARD FORTH, FORTH INTERNATIONAL ; STANDARD, (C) 1976, 1977, 1978, 1979, FIST ; MULTI-FORTH (C) 1978, 1979 CREATIVE SOLUTIONS ; CP/M (C) 1979 DIGITAL RESEARCH INC. ; MOST ANYTHING WITH AN 11 IN IT (C) DIGITAL EQUIPMENT CORP ; THERE MAY BE OTHERS ! ! ; MINIFORTH, MICROFORTH, POLYFORTH, FORTH TM FORTH INC. ; FIG-FORTH (C) 1978 1979 FORTH INTEREST GROUP ; ALL RIGHTS RESERVED EXCEPT AS EXPRESSLY INDICATED ! ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ; UPDATES, PATCHES, BUG REPORTS, EXTENSIONS ; FOR THIS SOFTWARE IN FORTH DIMENSIONS ; NEWSLETTER OF FORTH INTEREST GROUP (FIG) ; 6 issues $5.00 includes fig membership ; ; DOCUMENTATION FROM FIG or FORTH POWER ; ; FORTH PRIMER (240pp) Richard Stevens ; KITT PEAK NATIONAL OBSERVATORY $20.00 ; ; FORTH IMPLEMENTATION TEAM LANGUAGE MODEL, EDITOR SOURCE, ; LANGUAGE GLOSSARY, AND IMPLEMENTATION GUIDE $10.00 ; ; FORTH FOR MICROCOMPUTERS by JOHN S JAMES ; reprint from DDJ #25 $2.00 ; ; FORTH POCKET PROGRAMMERS CARD FREE W/ S.A.S.E. ; ; SOURCE CODE FOR TI990, 6502, 6800, PDP11, PACE, ; 8080 (included here) $10.00/ LISTING ; ; DOCUMENTATION FROM FIG ; ; USING FORTH by ELIZABETH RATHER (200pp) ; FORTH INC. 1979 $20.00 ; ; DOCUMENTATION FROM FORTH POWER ; ; ; CP/M MULTI-FORTH USERS MANUAL $20.00 ; FORTH 79 INTERNATIONAL STANDARD ; ; CP/M 8080 FORTH BY FIG 8" DISKETT IBM STD. ; WITH EDITOR AND ASSEMBLER, COPY AND PRINT, ; AND USERS GUIDE $65.00 ; ; also on 5" CP/M, 5 & 8 Northstar DOS ; ; CP/M Multi-Forth, Full 79 International ; Standard with extensions, Strings, Prom burner, ; Real time clock, VIDEO EDITOR, UTILITIES ; A PROFESSIONAL LEVEL PRODUCT $150.00 ; includes manual ; ; PDP 11 FORTH by JOHN S. JAMES ; 8" RX01 diskett or 9 track 800 bpi DOS tape ; runs under OS or stand alone ; WITH USERS GUIDE $150.00 ; ; FIG TRS 80 FORTH cassette or diskette ; WRITE FOR PRICES ; ; APPLE FORTH BY CapN' SOFTWARE $40.00 ; EASYWRITER (word processor for APPLE ; by CapN' SOFTWARE) $100.00 ; ; APPLE FORTH BY UNIVERSITY OF UTRECHT, ; includes floating pt and many extensions ; A PROFESSIONAL LEVEL PRODUCT $100.00 ; ; FORTH FOR MICROPROSSOR DEVELOPMENT SYSTEMS, ; FORTH FOR D.G., VAX 11, INTERDATA, Series 1, ; C.A., HONEYWELL LEVEL 6, and others, Write for prices ; ; DOCUMENTATION FROM CALTECH ; CALTECH FORTH MANUAL $6.00 ; CAL TECH BOOKSTORE PASADENA CA ; by MARTIN S. EWING 100pp postpaid ; ; CALL FOR PAPERS, ARTICLES, SPEAKERS: FOR FORTH DIMENSIONS ; AND TRADE PUBLICATIONS SEND TO FIG. FOR SPEAKERS, WORKSHOPS, ; SHOWS AND CONVENTIONS CONTACT FIG. FIG SOLICITES FORTH SOFTWARE ; FOR INCLUSION IN THIS EFFORT. ; FORTH INTERNATIONAL STANDARDS TEAM (FIT) ; FORTH 79 INTERNATIONAL STANDARD, REQUIRED AND ; RESERVED WORD GLOSSARY, AND STANDARDS ACTIVITY ; DISTRIBUTION. $30.00 TO FIT c/o FIG or to ; ; CAROLYN ROSENBERG, FIT SECRETARY ; c/o FORTH INC. MANHATTAN BEACH CA. ; ; ;----------------------------------------------------- ; LABELS USED WHICH DIFFER FROM FIG-FORTH PUBLISHED ; 8080 LISTING 1.0: ; ; REL 1.1 REL 1.0 ; ------- ------- ; ANDD AND ; CSPP CSP ; ELSEE ELSE ; ENDD END ; ENDIFF ENDIF ; ERASEE ERASE ; IDO I ; IFF IF ; INN IN ; MODD MOD ; ORR OR ; OUTT OUT ; RR R ; RPP RP ; SUBB SUB ; XORR XOR ; ; SEE ALSO: ; RELEASE & VERSION NUMBERS ; ASCII CHARACTER EQUATES ; MEMORY ALLOCATION ; DISK INTERFACE ; CONSOLE & PRINTER INTERFACE ; PAGE ; ;---------------------------------------------------------- ; ; RELEASE & VERSION NUMBERS ; FIGREL EQU 1 ; FIG RELEASE # FIGREV EQU 1 ; FIG REVISION # USRVER EQU 0 ; USER VERSION # ; ; ASCII CHARACTERS USED ; ABL EQU 20H ; SPACE ACR EQU 0DH ; CARRIAGE RETURN ADOT EQU 02EH ; PERIOD BELL EQU 07H ; (^G) BSIN EQU 7FH ; INPUT BACKSPACE CHR = RUBOUT BSOUT EQU 08H ; OUTPUT BACKSPACE (^H) DLE EQU 10H ; (^P) LF EQU 0AH ; LINE FEED FF EQU 0CH ; FORM FEED (^L) ; ; MEMORY ALLOCATION ; EM EQU 4000H ; TOP OF MEMORY + 1 = LIMIT NSCR EQU 1 ; NUMBER OF 1024 BYTE SCREENS KBBUF EQU 128 ; DATA BYTES PER DISK BUFFER US EQU 40H ; USER VARIABLES SPACE RTS EQU 0A0H ; RETURN STACK & TERM BUFF SPACE ; CO EQU KBBUF+4 ; DISK BUFFER + 2 HEADER + 2 TAIL NBUF EQU NSCR*400H/KBBUF ; NUMBER OF BUFFERS BUF1 EQU EM-CO*NBUF ; ADDR FIRST DISK BUFFER INITR0 EQU BUF1-US ; (R0) INITS0 EQU INITR0-RTS ; (S0) ; PAGE ; ;------------------------------------------------------- ; ORG 100H ORIG NOP JMP CLD ; VECTOR TO COLD START NOP JMP WRM ; VECTOR TO WARM START DB FIGREL ; FIG RELEASE # DB FIGREV ; FIG REVISION # DB USRVER ; USER VERSION # DB 0EH ; IMPLEMENTATION ATTRIBUTES DW TASK-7 ; TOPMOST WORD IN FORTH VOCABULARY DW BSIN ; BKSPACE CHARACTER DW INITR0 ; INIT (UP) ;<<<<<< FOLLOWING USED BY COLD; ; MUST BE IN SAME ORDER AS USER VARIABLES DW INITS0 ; INIT (S0) DW INITR0 ; INIT (R0) DW INITS0 ; INIT (TIB) DW 20H ; INIT (WIDTH) DW 0 ; INIT (WARNING) DW INITDP ; INIT (FENCE) DW INITDP ; INIT (DP) DW FORTH+6 ; INIT (VOC-LINK) ;<<<<<< END DATA USED BY COLD DW 5H,0B320H ; CPU NAME ( HW,LW ) ; ( 32 BIT, BASE 36 INTEGER ) ; ; ; +---------------+ ; B +ORIGIN | . . .W:I.E.B.A| IMPLEMENTATION ; +---------------+ ATTRIBUTES ; ^ ^ ^ ^ ^ ; | | | | +-- PROCESSOR ADDR = ; | | | | { 0 BYTE | 1 WORD } ; | | | +---- HIGH BYTE AT ; | | | { 0 LOW ADDR | ; | | | 1 HIGH ADDR } ; | | +------ ADDR MUST BE EVEN ; | | { 0 YES | 1 NO } ; | +-------- INTERPRETER IS ; | { 0 PRE | 1 POST } ; | INCREMENTING ; +---------- { 0 ABOVE SUFFICIENT ; | 1 OTHER DIFFER- ; ENCES EXIST } ; PAGE ; ;------------------------------------------------------ ; ; FORTH REGISTERS ; ; FORTH 8080 FORTH PRESERVATION RULES ; ----- ---- ------------------------------------------------------------------------HH+ ; IP BC SHOULD BE PRESERVED ACROSS ; FORTH WORDS ; W DE SOMETIMES OUTPUT FROM NEXT ; MAY BE ALTERED BEFORE JMP'ING TO NEXT ; INPUT ONLY WHEN 'DPUSH' CALLED ; SP SP SHOULD BE USED ONLY AS DATA STACK ; ACROSS FORTH WORDS ; MAY BE USED WITHIN FORTH WORDS ; IF RESTORED BEFORE 'NEXT' ; HL NEVER OUTPUT FROM NEXT ; INPUT ONLY WHEN 'HPUSH' CALLED ; UP DW INITR0 ; USER AREA POINTER RPP DW INITR0 ; RETURN STACK POINTER ; ;------------------------------------------------------ ; ; COMMENT CONVENTIONS: ; ; = MEANS "IS EQUAL TO" ; <- MEANS ASSIGNMENT ; ; NAME = ADDRESS OF NAME ; (NAME) = CONTENTS AT NAME ; ((NAME))= INDIRECT CONTENTS ; ; CFA = ADDRESS OF CODE FIELD ; LFA = ADDRESS OF LINK FIELD ; NFA = ADDR OF START OF NAME FIELD ; PFA = ADDR OF START OF PARAMETER FIELD ; ; S1 = ADDR OF 1ST WORD OF PARAMETER STACK ; S2 = ADDR OF 2ND WORD OF PARAMETER STACK ; R1 = ADDR OF 1ST WORD OF RETURN STACK ; R2 = ADDR OF 2ND WORD OF RETURN STACK ; ( ABOVE STACK POSITIONS VALID BEFORE & 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 ) ; PAGE ; ;--------------------------------------------------- ; DEBUG SUPPORT ; ; TO USE: ; (1) SET 'BIP' TO IP VALUE TO HALT, CANNOT BE CFA ; (2) SET MONITOR'S BREAKPOINT PC TO 'BREAK' ; OR PATCH 'HLT' INSTR. THERE ; (3) PATCH A 'JMP TNEXT' AT 'NEXT' ; WHEN (IP) = (BIP) CPU WILL HALT ; BIP DW 0 ; BREAKPOINT ON IP VALUE ; TNEXT LXI H,BIP MOV A,M ; LB CMP C JNZ TNEXT1 INX H MOV A,M ; HB CMP B JNZ TNEXT1 BREAK NOP ; PLACE BREAKPOINT HERE NOP NOP TNEXT1 LDAX B INX B MOV L,A JMP NEXT+3 ; ;-------------------------------------------------- ; ; NEXT, THE FORTH ADDRESS INTERPRETER ; ( POST INCREMENTING VERSION ) ; DPUSH PUSH D HPUSH PUSH H NEXT LDAX B ;(W) <- ((IP)) INX B ;(IP) <- (IP)+2 MOV L,A LDAX B INX B MOV H,A ; (HL) <- CFA NEXT1: MOV E,M ;(PC) <- ((W)) INX H MOV D,M XCHG PCHL ; NOTE: (DE) = CFA+1 ; PAGE ; ; 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 CHR ; 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: DB 83H ; LIT DB 'LI' DB 'T'+80H DW 0 ; (LFA)=0 MARKS END OF DICTIONARY LIT DW $+2 ;(S1) <- ((IP)) LDAX B ; (HL) <- ((IP)) = LITERAL INX B ; (IP) <- (IP) + 2 MOV L,A ; LB LDAX B ; HB INX B MOV H,A JMP HPUSH ; (S1) <- (HL) ; DB 87H ; EXECUTE DB 'EXECUT' DB 'E'+80H DW LIT-6 EXEC DW $+2 POP H ; (HL) <- (S1) = CFA JMP NEXT1 ; DB 86H ; BRANCH DB 'BRANC' DB 'H'+80H DW EXEC-0AH BRAN DW $+2 ;(IP) <- (IP) + ((IP)) BRAN1 MOV H,B ; (HL) <- (IP) MOV L,C MOV E,M ; (DE) <- ((IP)) = BRANCH OFFSET INX H MOV D,M DCX H DAD D ; (HL) <- (HL) + ((IP)) MOV C,L ; (IP) <- (HL) MOV B,H JMP NEXT ; DB 87H ; 0BRANCH DB '0BRANC' DB 'H'+80H DW BRAN-9 ZBRAN DW $+2 POP H MOV A,L ORA H JZ BRAN1 ; IF (S1)=0 THEN BRANCH INX B ; ELSE SKIP BRANCH OFFSET INX B JMP NEXT ; DB 86H ; (LOOP) DB '(LOOP' DB ')'+80H DW ZBRAN-0AH XLOOP DW $+2 LXI D,1 ; (DE) <- INCREMENT XLOO1 LHLD RPP ; ((HL)) = INDEX MOV A,M ; INDEX <- INDEX + INCR ADD E MOV M,A MOV E,A INX H MOV A,M ADC D MOV M,A INX H ; ((HL)) = LIMIT INR D DCR D MOV D,A ; (DE) <- NEW INDEX JM XLOO2 ; IF INCR > 0 MOV A,E SUB M ; THEN (A) <- INDEX - LIMIT MOV A,D INX H SBB M JMP XLOO3 XLOO2 MOV A,M ; ELSE (A) <- LIMIT - INDEX SUB E INX H MOV A,M SBB D ; ; IF (A) < 0 XLOO3 JM BRAN1 ; THEN LOOP AGAIN INX H ; ELSE DONE SHLD RPP ; DISCARD R1 & R2 INX B ; SKIP BRANCH OFFSET INX B JMP NEXT ; DB 87H ; (+LOOP) DB '(+LOOP' DB ')'+80H DW XLOOP-9 XPLOO DW $+2 POP D ; (DE) <- INCR JMP XLOO1 ; DB 84H ; (DO) DB '(DO' DB ')'+80H DW XPLOO-0AH XDO DW $+2 LHLD RPP ; (RP) <- (RP) - 4 DCX H DCX H DCX H DCX H SHLD RPP POP D ; (R1) <- (S1) = INIT INDEX MOV M,E INX H MOV M,D POP D ; (R2) <- (S2) = LIMIT INX H MOV M,E INX H MOV M,D JMP NEXT ; DB 81H ; I DB 'I'+80H DW XDO-7 IDO DW $+2 ;(S1) <- (R1) , (R1) UNCHANGED LHLD RPP MOV E,M ; (DE) <- (R1) INX H MOV D,M PUSH D ; (S1) <- (DE) JMP NEXT ; DB 85H ; DIGIT DB 'DIGI' DB 'T'+80H DW IDO-4 DIGIT DW $+2 POP H ; (L) <- (S1)LB = ASCII CHR TO BE ; CONVERTED POP D ; (DE) <- (S2) = BASE VALUE MOV A,E SUI 30H ; IF CHR > "0" JM DIGI2 CPI 0AH ; AND IF CHR > "9" JM DIGI1 SUI 7 CPI 0AH ; AND IF CHR >= "A" JM DIGI2 ; ; THEN VALID NUMERIC OR ALPHA CHR DIGI1 CMP L ; IF < BASE VALUE JP DIGI2 ; ; THEN VALID DIGIT CHR MOV E,A ; (S2) <- (DE) = CONVERTED DIGIT LXI H,1 ; (S1) <- TRUE JMP DPUSH ; ; ELSE INVALID DIGIT CHR DIGI2 MOV L,H ; (HL) <- FALSE JMP HPUSH ; (S1) <- FALSE ; DB 86H ; (FIND) (2-1)FAILURE DB '(FIND' ; (2-3)SUCCESS DB ')'+80H DW DIGIT-8 PFIND DW $+2 POP D ; (DE) <- NFA PFIN1 POP H ; (HL) <- STRING ADDR PUSH H ; SAVE STRING ADDR FOR NEXT ITERATION LDAX D XRA M ; CHECK LENGTHS & SMUDGE BIT ANI 3FH JNZ PFIN4 ; LENGTHS DIFFERENT ; ; LENGTHS MATCH, CHECK EACH CHR PFIN2 INX H ; (HL) <- ADDR NEXT CHR IN STRING INX D ; (DE) <- ADDR NEXT CHR IN NF LDAX D XRA M ; IGNORE MSB ADD A JNZ PFIN3 ; NO MATCH JNC PFIN2 ; MATCH SO FAR, LOOP AGAIN LXI H,5 ; STRING MATCHES DAD D ; ((SP)) <- PFA XTHL ; ; BACK UP TO LENGTH BYTE OF NF = NFA PFIN6 DCX D LDAX D ORA A JP PFIN6 ; IF MSB = 1 THEN (DE) = NFA MOV E,A ; (DE) <- LENGTH BYTE MVI D,0 LXI H,1 ; (HL) <- TRUE JMP DPUSH ; RETURN, NF FOUND ; ABOVE NF NOT A MATCH, TRY ANOTHER PFIN3 JC PFIN5 ; IF NOT END OF NF PFIN4 INX D ; THEN FIND END OF NF LDAX D ORA A JP PFIN4 PFIN5 INX D ; (DE) <- LFA XCHG MOV E,M ; (DE) <- (LFA) INX H MOV D,M MOV A,D ORA E ; IF (LFA) <> 0 JNZ PFIN1 ; THEN TRY PREVIOUS DICT. DEF. ; ; ELSE END OF DICTIONARY POP H ; DISCARD STRING ADDR LXI H,0 ; (HL) <- FALSE JMP HPUSH ; RETURN, NO MATCH FOUND ; DB 87H ; ENCLOSE DB 'ENCLOS' DB 'E'+80H DW PFIND-9 ENCL DW $+2 POP D ; (DE) <- (S1) = DELIMITER CHAR POP H ; (HL) <- (S2) = ADDR TEXT TO SCAN PUSH H ; (S4) <- ADDR MOV A,E MOV D,A ; (D) <- DELIM CHR MVI E,-1 ; INITIALIZE CHR OFFSET COUNTER DCX H ; (HL) <- ADDR-1 ; ; SKIP OVER LEADING DELIMITER CHRS ENCL1 INX H INR E CMP M ; IF TEXT CHR = DELIM CHR JZ ENCL1 ; THEN LOOP AGAIN ; ; ELSE NON-DELIM CHR FOUND MVI D,0 ; (S3) <- (E) = OFFSET TO 1ST NON-DELIM PUSH D MOV D,A ; (D) <- DELIM CHR MOV A,M ; IF 1ST NON-DELIM = NULL ANA A JNZ ENCL2 MVI D,0 ; THEN (S2) <- OFFSET TO BYTE INR E ; FOLLOWING NULL PUSH D DCR E ; (S1) <- OFFSET TO NULL PUSH D JMP NEXT ; ; ELSE TEXT CONTAINS NON-DELIM & ; NON-NULL CHR ENCL2 MOV A,D ; (A) <- DELIM CHR INX H ; (HL) <- ADDR NEXT CHR INR E ; (E) <- OFFSET TO NEXT CHR CMP M ; IF NEXT CHR <> DELIM CHR JZ ENCL4 MOV A,M ; AND IF NEXT CHR <> NULL ANA A JNZ ENCL2 ; THEN CONTINUE SCAN ; ; ELSE CHR = NULL ENCL3 MVI D,0 ; (S2) <- OFFSET TO NULL PUSH D PUSH D ; (S1) <- OFFSET TO NULL JMP NEXT ; ; ELSE CHR = DELIM CHR ENCL4 MVI D,0 ; (S2) <- OFFSET TO BYTE ; FOLLOWING TEXT PUSH D INR E ; (S1) <- OFFSET TO 2 BYTES AFTER ; END OF WORD PUSH D JMP NEXT ; DB 84H ; EMIT DB 'EMI' DB 'T'+80H DW ENCL-0AH EMIT DW DOCOL DW PEMIT DW ONE,OUTT DW PSTOR,SEMIS ; DB 83H ; KEY DB 'KE' DB 'Y'+80H DW EMIT-7 KEY DW $+2 JMP PKEY ; DB 89H ; ?TERMINAL DB '?TERMINA' DB 'L'+80H DW KEY-6 QTERM DW $+2 LXI H,0 JMP PQTER ; DB 82H ; CR DB 'C' DB 'R'+80H DW QTERM-0CH CR DW $+2 JMP PCR ; DB 85H ; CMOVE DB 'CMOV' DB 'E'+80H DW CR-5 CMOVE DW $+2 MOV L,C ; (HL) <- (IP) MOV H,B POP B ; (BC) <- (S1) = #CHRS POP D ; (DE) <- (S2) = DEST ADDR XTHL ; (HL) <- (S3) = SOURCE ADDR ; ; (S1) <- (IP) JMP CMOV2 ; RETURN IF #CHRS = 0 CMOV1 MOV A,M ; ((DE)) <- ((HL)) INX H ; INC SOURCE ADDR STAX D INX D ; INC DEST ADDR DCX B ; DEC #CHRS CMOV2 MOV A,B ORA C JNZ CMOV1 ; REPEAT IF #CHRS <> 0 POP B ; RESTORE (IP) FROM (S1) JMP NEXT ; DB 82H ; U* 16X16 UNSIGNED MULTIPLY DB 'U' ; AVG EXECUUION TIME = 994 CYCLES DB '*'+80H DW CMOVE-8 USTAR DW $+2 POP D ; (DE) <- MPLIER POP H ; (HL) <- MPCAND PUSH B ; SAVE IP MOV B,H MOV A,L ; (BA) <- MPCAND CALL MPYX ; (AHL)1 <- MPCAND.LB * MPLIER ; 1ST PARTIAL PRODUCT PUSH H ; SAVE (HL)1 MOV H,A MOV A,B MOV B,H ; SAVE (A)1 CALL MPYX ; (AHL)2 <- MPCAND.HB * MPLIER ; 2ND PARTIAL PRODUCT POP D ; (DE) <- (HL)1 MOV C,D ; (BC) <- (AH)1 ; FORM SUM OF PARTIALS: ; (AHL) 1 ; + (AHL) 2 ; -------- ; (AHLE) DAD B ; (HL) <- (HL)2 + (AH)1 ACI 0 ; (AHLE) <- (BA) * (DE) MOV D,L MOV L,H MOV H,A ; (HLDE) <- MPLIER * MPCAND POP B ; RESTORE IP PUSH D ; (S2) <- PRODUCT.LW JMP HPUSH ; (S1) <- PRODUCT.HW ; ; MULTIPLY PRIMITIVE ; (AHL) <- (A) * (DE) ; #BITS = 24 8 16 MPYX LXI H,0 ; (HL) <- 0 = PARTIAL PRODUCT.LW MVI C,8 ; LOOP COUNTER MPYX1 DAD H ; LEFT SHIFT (AHL) 24 BITS RAL JNC MPYX2 ; IF NEXT MPLIER BIT = 1 DAD D ; THEN ADD MPCAND ACI 0 MPYX2 DCR C ; IF NOT LAST MPLIER BIT JNZ MPYX1 ; THEN LOOP AGAIN RET ; ELSE DONE ; DB 82H ; U/ DB 'U' DB '/'+80H DW USTAR-5 USLAS DW $+2 LXI H,4 DAD SP ; ((HL)) <- NUMERATOR.LW MOV E,M ; (DE) <- NUMER.LW MOV M,C ; SAVE IP ON STACK INX H MOV D,M MOV M,B POP B ; (BC) <- DENOMINATOR POP H ; (HL) <- NUMER.HW MOV A,L SUB C ; IF NUMER >= DENOM MOV A,H SBB B JC USLA1 LXI H,0FFFFH ; THEN OVERFLOW LXI D,0FFFFH ; SET REM & QUOT TO MAX JMP USLA7 USLA1 MVI A,16 ; LOOP COUNTER USLA2 DAD H ; LEFT SHIFT (HLDE) THRU CARRY RAL XCHG DAD H JNC USLA3 INX D ANA A USLA3 XCHG ; SHIFT DONE RAR ; RESTORE 1ST CARRY PUSH PSW ; SAVE COUNTER JNC USLA4 ; IF CARRY = 1 MOV A,L ; THEN (HL) <- (HL) - (BC) SUB C MOV L,A MOV A,H SBB B MOV H,A JMP USLA5 USLA4 MOV A,L ; ELSE TRY (HL) <- (HL) - (BC) SUB C MOV L,A MOV A,H SBB B ; (HL) <- PARTIAL REMAINDER MOV H,A JNC USLA5 DAD B ; UNDERFLOW, RESTORE DCX D USLA5 INX D ; INC QUOT USLA6 POP PSW ; RESTORE COUNTER DCR A ; IF COUNTER > 0 JNZ USLA2 ; THEN LOOP AGAIN USLA7 POP B ; ELSE DONE, RESTORE IP PUSH H ; (S2) <- REMAINDER PUSH D ; (S1) <- QUOTIENT JMP NEXT ; DB 83H ; AND DB 'AN' DB 'D'+80H DW USLAS-5 ANDD DW $+2 ; (S1) <- (S1) AND (S2) POP D POP H MOV A,E ANA L MOV L,A MOV A,D ANA H MOV H,A JMP HPUSH ; DB 82H ; OR DB 'O' DB 'V'+80H DW ANDD-6 ORR DW $+2 ; (S1) <- (S1) OR (S2) POP D POP H MOV A,E ORA L MOV L,A MOV A,D ORA H MOV H,A JMP HPUSH ; DB 83H ; XOR DB 'XO' DB 'R'+80H DW ORR-5 XORR DW $+2 ; (S1) <- (S1) XOR (S2) POP D POP H MOV A,E XRA L MOV L,A MOV A,D XRA H MOV H,A JMP HPUSH ; DB 83H ; SP@ DB 'SP' DB '@'+80H DW XORR-6 SPAT DW $+2 ;(S1) <- (SP) LXI H,0 DAD SP ; (HL) <- (SP) JMP HPUSH ; (S1) <- (HL) ; DB 83H ; STACK POINTER STORE DB 'SP' DB '!'+80H DW SPAT-6 SPSTO DW $+2 ;(SP) <- (S0) ( USER VARIABLE ) LHLD UP ; (HL) <- USER VAR BASE ADDR LXI D,6 DAD D ; (HL) <- S0 MOV E,M ; (DE) <- (S0) INX H MOV D,M XCHG SPHL ; (SP) <- (S0) JMP NEXT ; DB 83H ; RP@ DB 'RP' DB '@'+80H DW SPSTO-6 RPAT DW $+2 ;(S1) <- (RP) LHLD RPP JMP HPUSH ; DB 83H ; RETURN STACK POINTER STORE DB 'RP' DB '!'+80H DW RPAT-6 RPSTO DW $+2 ;(RP) <- (R0) ( USER VARIABLE ) LHLD UP ; (HL) <- USER VARIABLE BASE ADDR LXI D,8 DAD D ; (HL) <- R0 MOV E,M ; (DE) <- (R0) INX H MOV D,M XCHG SHLD RPP ; (RP) <- (R0) JMP NEXT ; DB 82H ; ;S DB ';' DB 'S'+80H DW RPSTO-6 SEMIS DW $+2 ;(IP) <- (R1) LHLD RPP MOV C,M ; (BC) <- (R1) INX H MOV B,M INX H SHLD RPP ; (RP) <- (RP) + 2 JMP NEXT ; DB 85H ; LEAVE DB 'LEAV' DB 'E'+80H DW SEMIS-5 LEAVE DW $+2 ;LIMIT <- INDEX LHLD RPP MOV E,M ; (DE) <- (R1) = INDEX INX H MOV D,M INX H MOV M,E ; (R2) <- (DE) = LIMIT INX H MOV M,D JMP NEXT ; DB 82H ; >R DB '>' DB 'R'+80H DW LEAVE-8 TOR DW $+2 ;(R1) <- (S1) POP D ; (DE) <- (S1) LHLD RPP DCX H ; (RP) <- (RP) - 2 DCX H SHLD RPP MOV M,E ; ((HL)) <- (DE) INX H MOV M,D JMP NEXT ; DB 82H ; R> DB 'R' DB '>'+80H DW TOR-5 FROMR DW $+2 ;(S1) <- (R1) LHLD RPP MOV E,M ; (DE) <- (R1) INX H MOV D,M INX H SHLD RPP ; (RP) <- (RP) + 2 PUSH D ; (S1) <- (DE) JMP NEXT ; DB 81H ; R DB 'R'+80H DW FROMR-5 RR DW IDO+2 ; DB 82H ; 0= DB '0' DB '='+80H DW RR-4 ZEQU DW $+2 POP H ; (HL) <- (S1) MOV A,L ORA H ; IF (HL) = 0 LXI H,0 ; THEN (HL) <- FALSE JNZ ZEQU1 INX H ; ELSE (HL) <- TRUE ZEQU1 JMP HPUSH ; (S1) <- (HL) ; DB 82H ; 0< DB '0' DB '<'+80H DW ZEQU-5 ZLESS DW $+2 POP H ; (HL) <- (S1) DAD H ; IF (HL) >= 0 LXI H,0 ; THEN (HL) <- FALSE JNC ZLES1 INX H ; ELSE (HL) <- TRUE ZLES1 JMP HPUSH ; (S1) <- (HL) ; DB 81H ; + DB '+'+80H DW ZLESS-5 PLUS DW $+2 ;(S1) <- (S1) + (S2) POP D POP H DAD D JMP HPUSH ; DB 82H ; D+ (4-2) DB 'D' ; XLW XHW YLW YHW --- SLW SHW DB '+'+80H ; S4 S3 S2 S1 S2 S1 DW PLUS-4 DPLUS DW $+2 LXI H,6 DAD SP ; ((HL)) = XLW MOV E,M ; (DE) = XLW MOV M,C ; SAVE IP ON STACK INX H MOV D,M MOV M,B POP B ; (BC) <- YHW POP H ; (HL) <- YLW DAD D XCHG ; (DE) <- YLW + XLW = SUM.LW POP H ; (HL) <- XHW MOV A,L ADC C MOV L,A ; (HL) <- YHW + XHW + CARRY MOV A,H ADC B MOV H,A POP B ; RESTORE IP PUSH D ; (S2) <- SUM.LW JMP HPUSH ; (S1) <- SUM.HW ; DB 85H ; MINUS DB 'MINU' DB 'S'+80H DW DPLUS-5 MINUS DW $+2 ;(S1) <- -(S1) ( 2'S COMPLEMENT ) POP H MOV A,L CMA MOV L,A MOV A,H CMA MOV H,A INX H JMP HPUSH ; DB 86H ; DMINUS DB 'DMINU' DB 'S'+80H DW MINUS-8 DMINU DW $+2 POP H ; (HL) <- HW POP D ; (DE) <- LW SUB A SUB E ; (DE) <- 0 - (DE) MOV E,A MVI A,0 SBB D MOV D,A MVI A,0 SBB L ; (HL) <- 0 - (HL) MOV L,A MVI A,0 SBB H MOV H,A PUSH D ; (S2) <- LW JMP HPUSH ; (S1) <- HW ; DB 84H ; OVER DB 'OVE' DB 'R'+80H DW DMINU-9 OVER DW $+2 POP D POP H PUSH H JMP DPUSH ; DB 84H ; DROP DB 'DRO' DB 'P'+80H DW OVER-7 DROP DW $+2 POP H JMP NEXT ; DB 84H ; SWAP DB 'SWA' DB 'P'+80H DW DROP-7 SWAP DW $+2 POP H XTHL JMP HPUSH ; DB 83H ; DUP DB 'DU' DB 'P'+80H DW SWAP-7 DUP DW $+2 POP H PUSH H JMP HPUSH ; DB 84H ; 2DUP DB '2DU' DB 'P'+80H DW DUP-6 TDUP DW $+2 POP H POP D PUSH D PUSH H JMP DPUSH ; DB 82H ; PLUS STORE DB '+' DB '!'+80H DW TDUP-7 PSTOR DW $+2 ;((S1)) <- ((S1)) + (S2) POP H ; (HL) <- (S1) = ADDR POP D ; (DE) <- (S2) = INCR MOV A,M ; ((HL)) <- ((HL)) + (DE) ADD E MOV M,A INX H MOV A,M ADC D MOV M,A JMP NEXT ; DB 86H ; TOGGLE DB 'TOGGL' DB 'E'+80H DW PSTOR-5 TOGGL DW $+2 ;((S2)) <- ((S2)) XOR (S1)LB POP D ; (E) <- BYTE MASK POP H ; (HL) <- ADDR MOV A,M XRA E MOV M,A ; (ADDR) <- (ADDR) XOR (E) JMP NEXT ; DB 81H ; @ DB '@'+80H DW TOGGL-9 AT DW $+2 ;(S1) <- ((S1)) POP H ; (HL) <- ADDR MOV E,M ; (DE) <- (ADDR) INX H MOV D,M PUSH D ; (S1) <- (DE) JMP NEXT ; DB 82H ; C@ DB 'C' DB '@'+80H DW AT-4 CAT DW $+2 ;(S1) <- ((S1))LB POP H ; (HL) <- ADDR MOV L,M ; (HL) <- (ADDR)LB MVI H,0 JMP HPUSH ; DB 82H ; 2@ DB '2' DB '@'+80H DW CAT-5 TAT DW $+2 POP H ; (HL) <- ADDR HW LXI D,2 DAD D ; (HL) <- ADDR LW MOV E,M ; (DE) <- LW INX H MOV D,M PUSH D ; (S2) <- LW LXI D,-3 ; (HL) <- ADDR HW DAD D MOV E,M ; (DE) <- HW INX H MOV D,M PUSH D ; (S1) <- HW JMP NEXT ; DB 81H ; STORE DB '!'+80H DW TAT-5 STORE DW $+2 ;((S1)) <- (S2) POP H ; (HL) <- (S1) = ADDR POP D ; (DE) <- (S2) = VALUE MOV M,E ; ((HL)) <- (DE) INX H MOV M,D JMP NEXT ; DB 82H ; C STORE DB 'C' DB '!'+80H DW STORE-4 CSTOR DW $+2 ;((S1))LB <- (S2)LB POP H ; (HL) <- (S1) = ADDR POP D ; (DE) <- (S2) = BYTE MOV M,E ; ((HL))LB <- (E) JMP NEXT ; DB 82H ; 2 STORE DB '2' DB '!'+80H DW CSTOR-5 TSTOR DW $+2 POP H ; (HL) <- ADDR POP D ; (DE) <- HW MOV M,E ; (ADDR) <- HW INX H MOV M,D INX H ; (HL) <- ADDR LW POP D ; (DE) <- LW MOV M,E ; (ADDR+2) <- LW INX H MOV M,D JMP NEXT ; DB 0C1H ; : DB ':'+80H DW TSTOR-5 COLON DW DOCOL DW QEXEC DW SCSP DW CURR DW AT DW CONT DW STORE DW CREAT DW RBRAC DW PSCOD DOCOL LHLD RPP DCX H ; (R1) <- (IP) MOV M,B DCX H ; (RP) <- (RP) - 2 MOV M,C SHLD RPP INX D ; (DE) <- CFA+2 = (W) MOV C,E ; (IP) <- (DE) = (W) MOV B,D JMP NEXT ; DB 0C1H ; ; DB ';'+80H DW COLON-4 SEMI DW DOCOL DW QCSP DW COMP DW SEMIS DW SMUDG DW LBRAC DW SEMIS ; DB 84H ; NOOP DB 'NOO' DB 'P'+80H DW SEMI-4 NOOP DW DOCOL DW SEMIS ; DB 88H ; CONSTANT DB 'CONSTAN' DB 'T'+80H DW NOOP-7 CON DW DOCOL DW CREAT DW SMUDG DW COMMA DW PSCOD DOCON INX D ; (DE) <- PFA XCHG MOV E,M ; (DE) <- (PFA) INX H MOV D,M PUSH D ; (S1) <- (PFA) JMP NEXT ; DB 88H ; VARIABLE DB 'VARIABL' DB 'E'+80H DW CON-0BH VAR DW DOCOL DW CON DW PSCOD DOVAR INX D ; (DE) <- PFA PUSH D ; (S1) <- PFA JMP NEXT ; DB 84H ; USER DB 'USE' DB 'R'+80H DW VAR-0BH USER DW DOCOL DW CON DW PSCOD DOUSE INX D ; (DE) <- PFA XCHG MOV E,M ; (DE) <- USER VARIABLE OFFSET MVI D,0 LHLD UP ; (HL) <- USER VARIABLE BASE ADDR DAD D ; (HL) <- (HL) + (DE) JMP HPUSH ; (S1) <- BASE + OFFSET ; DB 81H ; 0 DB '0'+80H DW USER-7 ZERO DW DOCON DW 0 ; DB 81H ; 1 DB '1'+80H DW ZERO-4 ONE DW DOCON DW 1 ; DB 81H ; 2 DB '2'+80H DW ONE-4 TWO DW DOCON DW 2 ; DB 81H ; 3 DB '3'+80H DW TWO-4 THREE DW DOCON DW 3 ; DB 82H ; BL DB 'B' DB 'L'+80H DW THREE-4 BL DW DOCON DW 20H ; DB 83H ; C/L ( CHARACTERS/LINE ) DB 'C/' DB 'L'+80H DW BL-5 CSLL DW DOCON DW 64 ; DB 85H ; FIRST DB 'FIRS' DB 'T'+80H DW CSLL-6 FIRST DW DOCON DW BUF1 ; DB 85H ; LIMIT DB 'LIMI' DB 'T'+80H DW FIRST-8 LIMIT DW DOCON DW EM ; DB 85H ; B/BUF ( BYTES/BUFFER ) DB 'B/BU' DB 'F'+80H DW LIMIT-8 BBUF DW DOCON DW KBBUF ; DB 85H ; B/SCR ( BUFFERS/SCREEN ) DB 'B/SC' DB 'R'+80H DW BBUF-8 BSCR DW DOCON DW 400H/KBBUF ; DB 87H ; +ORIGIN DB '+ORIGI' DB 'N'+80H DW BSCR-8 PORIG DW DOCOL DW LIT DW ORIG DW PLUS DW SEMIS ; ; USER VARIABLES ; DB 82H ; S0 DB 'S' DB '0'+80H DW PORIG-0AH SZERO DW DOUSE DW 6 ; DB 82H ; R0 DB 'R' DB '0'+80H DW SZERO-5 RZERO DW DOUSE DW 8 ; DB 83H ; TIB DB 'TI' DB 'B'+80H DW RZERO-5 TIB DW DOUSE DB 0AH ; DB 85H ; WIDTH DB 'WIDT' DB 'H'+80H DW TIB-6 WIDTH DW DOUSE DB 0CH ; DB 87H ; WARNING DB 'WARNIN' DB 'G'+80H DW WIDTH-8 WARN DW DOUSE DB 0EH ; DB 85H ; FENCE DB 'FENC' DB 'E'+80H DW WARN-0AH FENCE DW DOUSE DB 10H ; DB 82H ; DP DB 'D' DB 'P'+80H DW FENCE-8 DP DW DOUSE DB 12H ; DB 88H ; VOC-LINK DB 'VOC-LIN' DB 'K'+80H DW DP-5 VOCL DW DOUSE DW 14H ; DB 83H ; BLK DB 'BL' DB 'K'+80H DW VOCL-0BH BLK DW DOUSE DB 16H ; DB 82H ; IN DB 'I' DB 'N'+80H DW BLK-6 INN DW DOUSE DB 18H ; DB 83H ; OUT DB 'OU' DB 'T'+80H DW INN-5 OUTT DW DOUSE DB 1AH ; DB 83H ; SCR DB 'SC' DB 'R'+80H DW OUTT-6 SCR DW DOUSE DB 1CH ; DB 86H ; OFFSET DB 'OFFSE' DB 'T'+80H DW SCR-6 OFSET DW DOUSE DB 1EH ; DB 87H ; CONTEXT DB 'CONTEX' DB 'T'+80H DW OFSET-9 CONT DW DOUSE DB 20H ; DB 87H ; CURRENT DB 'CURREN' DB 'T'+80H DW CONT-0AH CURR DW DOUSE DB 22H ; DB 85H ; STATE DB 'STAT' DB 'E'+80H DW CURR-0AH STATE DW DOUSE DB 24H ; DB 84H ; BASE DB 'BAS' DB 'E'+80H DW STATE-8 BASE DW DOUSE DB 26H ; DB 83H ; DPL DB 'DP' DB 'L'+80H DW BASE-7 DPL DW DOUSE DB 28H ; DB 83H ; FLD DB 'FL' DB 'D'+80H DW DPL-6 FLD DW DOUSE DB 2AH ; DB 83H ; CSP DB 'CS' DB 'P'+80H DW FLD-6 CSPP DW DOUSE DB 2CH ; DB 82H ; R# DB 'R' DB '#'+80H DW CSPP-6 RNUM DW DOUSE DB 2EH ; DB 83H ; HLD DB 'HL' DB 'D'+80H DW RNUM-5 HLD DW DOUSE DW 30H ; ; END OF USER VARIABLES ; DB 82H ; 1+ DB '1' DB '+'+80H DW HLD-6 ONEP DW DOCOL DW ONE DW PLUS DW SEMIS ; DB 82H ; 2+ DB '2' DB '+'+80H DW ONEP-5 TWOP DW DOCOL DW TWO DW PLUS DW SEMIS ; DB 84H ; HERE DB 'HER' DB 'E'+80H DW TWOP-5 HERE DW DOCOL DW DP DW AT DW SEMIS ; DB 85H ; ALLOT DB 'ALLO' DB 'T'+80H DW HERE-7 ALLOT DW DOCOL DW DP DW PSTOR DW SEMIS ; DB 81H ; , DB ','+80H DW ALLOT-8 COMMA DW DOCOL DW HERE DW STORE DW TWO DW ALLOT DW SEMIS ; DB 82H ; C, DB 'C' DB ','+80H DW COMMA-4 CCOMM DW DOCOL DW HERE DW CSTOR DW ONE DW ALLOT DW SEMIS ; ; SUBROUTINE USED BY - AND < ; ; (HL) <- (HL) - (DE) SSUB MOV A,L ; LB SUB E MOV L,A MOV A,H ; HB SBB D MOV H,A RET ; DB 81H ; - DB '-'+80H DW CCOMM-5 SUBB DW $+2 POP D ; (DE) <- (S1) = Y POP H ; (HL) <- (S2) = X CALL SSUB JMP HPUSH ; (S1) <- X - Y ; DB 81H ; = DB '='+80H DW SUBB-4 EQUAL DW DOCOL DW SUBB DW ZEQU DW SEMIS ; DB 81H ; < DB '<'+80H ; X < Y DW EQUAL-4 ; S2 S1 LESS DW $+2 POP D ; (DE) <- (S1) = Y POP H ; (HL) <- (S2) = X MOV A,D ; IF X & Y HAVE SAME SIGNS XRA H JM LES1 CALL SSUB ; (HL) <- X - Y LES1 INR H ; IF (HL) >= 0 DCR H JM LES2 LXI H,0 ; THEN X >= Y JMP HPUSH ; (S1) <- FALSE LES2 LXI H,1 ; ELSE X < Y JMP HPUSH ; (S1) <- TRUE ; DB 82H ; U< ( UNSIGNED < ) DB 'U' DB '<'+80H DW LESS-4 ULESS DW DOCOL,TDUP DW XORR,ZLESS DW ZBRAN,ULES1-$ ; IF DW DROP,ZLESS DW ZEQU DW BRAN,ULES2-$ ULES1 DW SUBB,ZLESS ; ELSE ULES2 DW SEMIS ; ENDIF ; DB 81H ; > DB '>'+80H DW ULESS-5 GREAT DW DOCOL DW SWAP DW LESS DW SEMIS ; DB 83H ; ROT DB 'RO' DB 'T'+80H DW GREAT-4 ROT DW $+2 POP D POP H XTHL JMP DPUSH ; DB 85H ; SPACE DB 'SPAC' DB 'E'+80H DW ROT-6 SPACE DW DOCOL DW BL DW EMIT DW SEMIS ; DB 84H ; -DUP DB '-DU' DB 'P'+80H DW SPACE-8 DDUP DW DOCOL DW DUP DW ZBRAN ; IF DW DDUP1-$ DW DUP ; ENDIF DDUP1 DW SEMIS ; DB 88H ; TRAVERSE DB 'TRAVERS' DB 'E'+80H DW DDUP-7 TRAV DW DOCOL DW SWAP TRAV1 DW OVER ; BEGIN DW PLUS DW LIT DW 7FH DW OVER DW CAT DW LESS DW ZBRAN ; UNTIL DW TRAV1-$ DW SWAP DW DROP DW SEMIS ; DB 86H ; LATEST DB 'LATES' DB 'T'+80H DW TRAV-0BH LATES DW DOCOL DW CURR DW AT DW AT DW SEMIS ; DB 83H ; LFA DB 'LF' DB 'A'+80H DW LATES-9 LFA DW DOCOL DW LIT DW 4 DW SUBB DW SEMIS ; DB 83H ; CFA DB 'CF' DB 'A'+80H DW LFA-6 CFA DW DOCOL DW TWO DW SUBB DW SEMIS ; DB 83H ; NFA DB 'NF' DB 'A'+80H DW CFA-6 NFA DW DOCOL DW LIT DW 5 DW SUBB DW LIT DW -1 DW TRAV DW SEMIS ; DB 83H ; PFA DB 'PF' DB 'A'+80H DW NFA-6 PFA DW DOCOL DW ONE DW TRAV DW LIT DW 5 DW PLUS DW SEMIS ; DB 84H ; STORE CSP DB '!CS' DB 'P'+80H DW PFA-6 SCSP DW DOCOL DW SPAT DW CSPP DW STORE DW SEMIS ; DB 86H ; ?ERROR DB '?ERRO' DB 'R'+80H DW SCSP-7 QERR DW DOCOL DW SWAP DW ZBRAN ; IF DW QERR1-$ DW ERROR DW BRAN ; ELSE DW QERR2-$ QERR1 DW DROP ; ENDIF QERR2 DW SEMIS ; DB 85H ; ?COMP DB '?COM' DB 'P'+80H DW QERR-9 QCOMP DW DOCOL DW STATE DW AT DW ZEQU DW LIT DW 11H DW QERR DW SEMIS ; DB 85H ; ?EXEC DB '?EXE' DB 'C'+80H DW QCOMP-8 QEXEC DW DOCOL DW STATE DW AT DW LIT DW 12H DW QERR DW SEMIS ; DB 86H ; ?PAIRS DB '?PAIR' DB 'S'+80H DW QEXEC-8 QPAIR DW DOCOL DW SUBB DW LIT DW 13H DW QERR DW SEMIS ; DB 84H ; ?CSP DB '?CS' DB 'P'+80H DW QPAIR-9 QCSP DW DOCOL DW SPAT DW CSPP DW AT DW SUBB DW LIT DW 14H DW QERR DW SEMIS ; DB 88H ; ?LOADING DB '?LOADIN' DB 'G'+80H DW QCSP-7 QLOAD DW DOCOL DW BLK DW AT DW ZEQU DW LIT DW 16H DW QERR DW SEMIS ; DB 87H ; COMPILE DB 'COMPIL' DB 'E'+80H DW QLOAD-0BH COMP DW DOCOL DW QCOMP DW FROMR DW DUP DW TWOP DW TOR DW AT DW COMMA DW SEMIS ; DB 0C1H ; [ DB '['+80H DW COMP-0AH LBRAC DW DOCOL DW ZERO DW STATE DW STORE DW SEMIS ; DB 81H ; ] DB ']'+80H DW LBRAC-4 RBRAC DW DOCOL DW LIT,0C0H DW STATE,STORE DW SEMIS ; DB 86H ; SMUDGE DB 'SMUDG' DB 'E'+80H DW RBRAC-4 SMUDG DW DOCOL DW LATES DW LIT DW 20H DW TOGGL DW SEMIS ; DB 83H ; HEX DB 'HE' DB 'X'+80H DW SMUDG-9 HEX DW DOCOL DW LIT DW 10H DW BASE DW STORE DW SEMIS ; DB 87H ; DECIMAL DB 'DECIMA' DB 'L'+80H DW HEX-6 DEC DW DOCOL DW LIT DW 0AH DW BASE DW STORE DW SEMIS ; DB 87H ; (;CODE) DB '(;CODE' DB ')'+80H DW DEC-0AH PSCOD DW DOCOL DW FROMR DW LATES DW PFA DW CFA DW STORE DW SEMIS ; DB 0C5H ; ;CODE DB ';COD' DB 'E'+80H DW PSCOD-0AH SEMIC DW DOCOL DW QCSP DW COMP DW PSCOD DW LBRAC SEMI1 DW NOOP ; ( ASSEMBLER ) DW SEMIS ; DB 87H ; <BUILDS DB '<BUILD' DB 'S'+80H DW SEMIC-8 BUILD DW DOCOL DW ZERO DW CON DW SEMIS ; DB 85H ; DOES> DB 'DOES' DB '>'+80H DW BUILD-0AH DOES DW DOCOL DW FROMR DW LATES DW PFA DW STORE DW PSCOD DODOE LHLD RPP ; (HL) <- (RP) DCX H MOV M,B ; (R1) <- (IP) = PFA = (SUBSTITUTE CFA) DCX H MOV M,C SHLD RPP ; (RP) <- (RP) - 2 INX D ; (DE) <- PFA = (SUBSTITUTE CFA) XCHG MOV C,M ; (IP) <- (SUBSTITUTE CFA) INX H MOV B,M INX H JMP HPUSH ; (S1) <- PFA+2 = SUBSTITUTE PFA ; DB 85H ; COUNT DB 'COUN' DB 'T'+80H DW DOES-8 COUNT DW DOCOL DW DUP DW ONEP DW SWAP DW CAT DW SEMIS ; DB 84H ; TYPE DB 'TYP' DB 'E'+80H DW COUNT-8 TYPE DW DOCOL DW DDUP DW ZBRAN ; IF DW TYPE1-$ DW OVER DW PLUS DW SWAP DW XDO ; DO TYPE2 DW IDO DW CAT DW EMIT DW XLOOP ; LOOP DW TYPE2-$ DW BRAN ; ELSE DW TYPE3-$ TYPE1 DW DROP ; ENDIF TYPE3 DW SEMIS ; DB 89H ; -TRAILING DB '-TRAILIN' DB 'G'+80H DW TYPE-7 DTRAI DW DOCOL DW DUP DW ZERO DW XDO ; DO DTRA1 DW OVER DW OVER DW PLUS DW ONE DW SUBB DW CAT DW BL DW SUBB DW ZBRAN ; IF DW DTRA2-$ DW LEAVE DW BRAN ; ELSE DW DTRA3-$ DTRA2 DW ONE DW SUBB ; ENDIF DTRA3 DW XLOOP ; LOOP DW DTRA1-$ DW SEMIS ; DB 84H ; (.") DB '(."' DB ')'+80H DW DTRAI-0CH PDOTQ DW DOCOL DW RR DW COUNT DW DUP DW ONEP DW FROMR DW PLUS DW TOR DW TYPE DW SEMIS ; DB 0C2H ; ." DB '.' DB '"'+80H DW PDOTQ-7 DOTQ DW DOCOL DW LIT DW 22H DW STATE DW AT DW ZBRAN ; IF DW DOTQ1-$ DW COMP DW PDOTQ DW WORD DW HERE DW CAT DW ONEP DW ALLOT DW BRAN ; ELSE DW DOTQ2-$ DOTQ1 DW WORD DW HERE DW COUNT DW TYPE ; ENDIF DOTQ2 DW SEMIS ; DB 86H ; EXPECT DB 'EXPEC' DB 'T'+80H DW DOTQ-5 EXPEC DW DOCOL DW OVER DW PLUS DW OVER DW XDO ; DO EXPE1 DW KEY DW DUP DW LIT DW 0EH DW PORIG DW AT DW EQUAL DW ZBRAN ; IF DW EXPE2-$ DW DROP DW DUP DW IDO DW EQUAL DW DUP DW FROMR DW TWO DW SUBB DW PLUS DW TOR DW ZBRAN ; IF DW EXPE6-$ DW LIT DW BELL DW BRAN ; ELSE DW EXPE7-$ EXPE6 DW LIT DW BSOUT ; ENDIF EXPE7 DW BRAN ; ELSE DW EXPE3-$ EXPE2 DW DUP DW LIT DW 0DH DW EQUAL DW ZBRAN ; IF DW EXPE4-$ DW LEAVE DW DROP DW BL DW ZERO DW BRAN ; ELSE DW EXPE5-$ EXPE4 DW DUP ; ENDIF EXPE5 DW IDO DW CSTOR DW ZERO DW IDO DW ONEP DW STORE ; ENDIF EXPE3 DW EMIT DW XLOOP ; LOOP DW EXPE1-$ DW DROP DW SEMIS ; DB 85H ; QUERY DB 'QUER' DB 'Y'+80H DW EXPEC-9 QUERY DW DOCOL DW TIB DW AT DW LIT DW 50H DW EXPEC DW ZERO DW INN DW STORE DW SEMIS ; DB 0C1H ; 0 (NULL) DB 80H DW QUERY-8 NULL DW DOCOL DW BLK DW AT DW ZBRAN ; IF DW NULL1-$ DW ONE DW BLK DW PSTOR DW ZERO DW INN DW STORE DW BLK DW AT DW BSCR DW ONE DW SUBB DW ANDD DW ZEQU DW ZBRAN ; IF DW NULL2-$ DW QEXEC DW FROMR DW DROP ; ENDIF NULL2 DW BRAN ; ELSE DW NULL3-$ NULL1 DW FROMR DW DROP ; ENDIF NULL3 DW SEMIS ; DB 84H ; FILL DB 'FIL' DB 'L'+80H DW NULL-4 FILL DW $+2 MOV L,C MOV H,B POP D POP B XTHL XCHG FILL1 MOV A,B ; BEGIN ORA C JZ FILL2 ; WHILE MOV A,L STAX D INX D DCX B JMP FILL1 ; REPEAT FILL2 POP B JMP NEXT ; DB 85H ; ERASE DB 'ERAS' DB 'E'+80H DW FILL-7 ERASEE DW DOCOL DW ZERO DW FILL DW SEMIS ; DB 86H ; BLANKS DB 'BLANK' DB 'S'+80H DW ERASEE-8 BLANK DW DOCOL DW BL DW FILL DW SEMIS ; DB 84H ; HOLD DB 'HOL' DB 'D'+80H DW BLANK-9 HOLD DW DOCOL DW LIT DW -1 DW HLD DW PSTOR DW HLD DW AT DW CSTOR DW SEMIS ; DB 83H ; PAD DB 'PA' DB 'D'+80H DW HOLD-7 PAD DW DOCOL DW HERE DW LIT DW 44H DW PLUS DW SEMIS ; DB 84H ; WORD DB 'WOR' DB 'D'+80H DW PAD-6 WORD DW DOCOL DW BLK DW AT DW ZBRAN ; IF DW WORD1-$ DW BLK DW AT DW BLOCK DW BRAN ; ELSE DW WORD2-$ WORD1 DW TIB DW AT ; ENDIF WORD2 DW INN DW AT DW PLUS DW SWAP DW ENCL DW HERE DW LIT DW 22H DW BLANK DW INN DW PSTOR DW OVER DW SUBB DW TOR DW RR DW HERE DW CSTOR DW PLUS DW HERE DW ONEP DW FROMR DW CMOVE DW SEMIS ; DB 88H ; (NUMBER) DB '(NUMBER' DB ')'+80H DW WORD-7 PNUMB DW DOCOL PNUM1 DW ONEP ; BEGIN DW DUP DW TOR DW CAT DW BASE DW AT DW DIGIT DW ZBRAN ; WHILE DW PNUM2-$ DW SWAP DW BASE DW AT DW USTAR DW DROP DW ROT DW BASE DW AT DW USTAR DW DPLUS DW DPL DW AT DW ONEP DW ZBRAN ; IF DW PNUM3-$ DW ONE DW DPL DW PSTOR ; ENDIF PNUM3 DW FROMR DW BRAN ; REPEAT DW PNUM1-$ PNUM2 DW FROMR DW SEMIS ; DB 86H ; NUMBER DB 'NUMBE' DB 'R'+80H DW PNUMB-0BH NUMB DW DOCOL DW ZERO DW ZERO DW ROT DW DUP DW ONEP DW CAT DW LIT DW 2DH DW EQUAL DW DUP DW TOR DW PLUS DW LIT DW -1 NUMB1 DW DPL ; BEGIN DW STORE DW PNUMB DW DUP DW CAT DW BL DW SUBB DW ZBRAN ; WHILE DW NUMB2-$ DW DUP DW CAT DW LIT DW 2EH DW SUBB DW ZERO DW QERR DW ZERO DW BRAN ; REPEAT DW NUMB1-$ NUMB2 DW DROP DW FROMR DW ZBRAN ; IF DW NUMB3-$ DW DMINU ; ENDIF NUMB3 DW SEMIS ; DB 85H ; -FIND (0-3) SUCCESS DB '-FIN' ; (0-1) FAILURE DB 'D'+80H DW NUMB-9 DFIND DW DOCOL DW BL DW WORD DW HERE DW CONT DW AT DW AT DW PFIND DW DUP DW ZEQU DW ZBRAN ; IF DW DFIN1-$ DW DROP DW HERE DW LATES DW PFIND ; ENDIF DFIN1 DW SEMIS ; DB 87H ; (ABORT) DB '(ABORT' DB ')'+80H DW DFIND-8 PABOR DW DOCOL DW ABORT DW SEMIS ; DB 85H ; ERROR DB 'ERRO' DB 'R'+80H DW PABOR-0AH ERROR DW DOCOL DW WARN DW AT DW ZLESS DW ZBRAN ; IF DW ERRO1-$ DW PABOR ; ENDIF ERRO1 DW HERE DW COUNT DW TYPE DW PDOTQ DB 2 DB '? ' DW MESS DW SPSTO ; CHANGE FROM FIG MODEL ; DW INN,AT,BLK,AT DW BLK,AT DW DDUP DW ZBRAN,ERRO2-$ ; IF DW INN,AT DW SWAP ; ENDIF ERRO2 DW QUIT ; DB 83H ; ID. DB 'ID' DB '.'+80H DW ERROR-8 IDDOT DW DOCOL DW PAD DW LIT DW 20H DW LIT DW 5FH DW FILL DW DUP DW PFA DW LFA DW OVER DW SUBB DW PAD DW SWAP DW CMOVE DW PAD DW COUNT DW LIT DW 1FH DW ANDD DW TYPE DW SPACE DW SEMIS ; DB 86H ; CREATE DB 'CREAT' DB 'E'+80H DW IDDOT-6 CREAT DW DOCOL DW DFIND DW ZBRAN ; IF DW CREA1-$ DW DROP DW NFA DW IDDOT DW LIT DW 4 DW MESS DW SPACE ; ENDIF CREA1 DW HERE DW DUP DW CAT DW WIDTH DW AT DW MIN DW ONEP DW ALLOT DW DUP DW LIT DW 0A0H DW TOGGL DW HERE DW ONE DW SUBB DW LIT DW 80H DW TOGGL DW LATES DW COMMA DW CURR DW AT DW STORE DW HERE DW TWOP DW COMMA DW SEMIS ; DB 0C9H ; [COMPILE] DB '[COMPILE' DB ']'+80H DW CREAT-9 BCOMP DW DOCOL DW DFIND DW ZEQU DW ZERO DW QERR DW DROP DW CFA DW COMMA DW SEMIS ; DB 0C7H ; LITERAL DB 'LITERA' DB 'L'+80H DW BCOMP-0CH LITER DW DOCOL DW STATE DW AT DW ZBRAN ; IF DW LITE1-$ DW COMP DW LIT DW COMMA ; ENDIF LITE1 DW SEMIS ; DB 0C8H ; DLITERAL DB 'DLITERA' DB 'L'+80H DW LITER-0AH DLITE DW DOCOL DW STATE DW AT DW ZBRAN ; IF DW DLIT1-$ DW SWAP DW LITER DW LITER ; ENDIF DLIT1 DW SEMIS ; DB 86H ; ?STACK DB '?STAC' DB 'K'+80H DW DLITE-0BH QSTAC DW DOCOL DW SPAT DW SZERO DW AT DW SWAP DW ULESS DW ONE DW QERR DW SPAT DW HERE DW LIT DW 80H DW PLUS DW ULESS DW LIT DW 7 DW QERR DW SEMIS ; DB 89H ; INTERPRET DB 'INTERPRE' DB 'T'+80H DW QSTAC-9 INTER DW DOCOL INTE1 DW DFIND ; BEGIN DW ZBRAN ; IF DW INTE2-$ DW STATE DW AT DW LESS DW ZBRAN ; IF DW INTE3-$ DW CFA DW COMMA DW BRAN ; ELSE DW INTE4-$ INTE3 DW CFA DW EXEC ; ENDIF INTE4 DW QSTAC DW BRAN ; ELSE DW INTE5-$ INTE2 DW HERE DW NUMB DW DPL DW AT DW ONEP DW ZBRAN ; IF DW INTE6-$ DW DLITE DW BRAN ; ELSE DW INTE7-$ INTE6 DW DROP DW LITER ; ENDIF INTE7 DW QSTAC ; ENDIF INTE5 DW BRAN ; AGAIN DW INTE1-$ ; DB 89H ; IMMEDIATE DB 'IMMEDIAT' DB 'E'+80H DW INTER-0CH IMMED DW DOCOL DW LATES DW LIT DW 40H DW TOGGL DW SEMIS ; DB 8AH ; VOCABULARY DB 'VOCABULAR' DB 'Y'+80H DW IMMED-0CH VOCAB DW DOCOL DW BUILD DW LIT DW 0A081H DW COMMA DW CURR DW AT DW CFA DW COMMA DW HERE DW VOCL DW AT DW COMMA DW VOCL DW STORE DW DOES DOVOC DW TWOP DW CONT DW STORE DW SEMIS ; DB 0C5H ; FORTH DB 'FORT' DB 'H'+80H DW VOCAB-0DH FORTH DW DODOE DW DOVOC DW 0A081H DW TASK-7 ; COLD START VALUE ONLY ; CHANGED EACH TIME A DEF IS APPENDED ; TO THE FORTH VOCABULARY DW 0 ; END OF VOCABULARY LIST ; DB 8BH ; DEFINITIONS DB 'DEFINITION' DB 'S'+80H DW FORTH-8 DEFIN DW DOCOL DW CONT DW AT DW CURR DW STORE DW SEMIS ; DB 0C1H ; ( DB '('+80H DW DEFIN-0EH PAREN DW DOCOL DW LIT DW 29H DW WORD DW SEMIS ; DB 84H ; QUIT DB 'QUI' DB 'T'+80H DW PAREN-4 QUIT DW DOCOL DW ZERO DW BLK DW STORE DW LBRAC QUIT1 DW RPSTO ; BEGIN DW CR DW QUERY DW INTER DW STATE DW AT DW ZEQU DW ZBRAN ; IF DW QUIT2-$ DW PDOTQ DB 2 DB 'OK' ; ENDIF QUIT2 DW BRAN ; AGAIN DW QUIT1-$ ; DB 85H ; ABORT DB 'ABOR' DB 'T'+80H DW QUIT-7 ABORT DW DOCOL DW SPSTO DW DEC DW QSTAC DW CR DW DOTCPU DW PDOTQ DB 0DH DB 'fig-FORTH ' DB FIGREL+30H,ADOT,FIGREV+30H DW FORTH DW DEFIN DW QUIT ; WRM LXI B,WRM1 JMP NEXT WRM1 DW WARM ; DB 84H ; WARM DB 'WAR' DB 'M'+80H DW ABORT-8 WARM DW DOCOL DW MTBUF DW ABORT ; CLD LXI B,CLD1 LHLD ORIG+12H SPHL JMP NEXT CLD1 DW COLD ; DB 84H ; COLD DB 'COL' DB 'D'+80H DW WARM-7 COLD DW DOCOL DW MTBUF DW ZERO,DENSTY DW STORE DW LIT,BUF1 DW USE,STORE DW LIT,BUF1 DW PREV,STORE DW DRZER DW LIT,0 DW LIT,EPRINT DW STORE ; DW LIT DW ORIG+12H DW LIT DW UP DW AT DW LIT DW 6 DW PLUS DW LIT DW 10H DW CMOVE DW LIT DW ORIG+0CH DW AT DW LIT DW FORTH+6 DW STORE DW ABORT ; DB 84H ; S->D DB 'S->' DB 'D'+80H DW COLD-7 STOD DW $+2 POP D LXI H,0 MOV A,D ANI 80H JZ STOD1 DCX H STOD1 JMP DPUSH ; DB 82H ; +- DB '+' DB '-'+80H DW STOD-7 PM DW DOCOL DW ZLESS DW ZBRAN ; IF DW PM1-$ DW MINUS ; ENDIF PM1 DW SEMIS ; DB 83H ; D+- DB 'D+' DB '-'+80H DW PM-5 DPM DW DOCOL DW ZLESS DW ZBRAN ; IF DW DPM1-$ DW DMINU ; ENDIF DPM1 DW SEMIS ; DB 83H ; ABS DB 'AB' DB 'S'+80H DW DPM-6 ABS DW DOCOL DW DUP DW PM DW SEMIS ; DB 84H ; DABS DB 'DAB' DB 'S'+80H DW ABS-6 DABS DW DOCOL DW DUP DW DPM DW SEMIS ; DB 83H ; MIN DB 'MI' DB 'N'+80H DW DABS-7 MIN DW DOCOL,TDUP DW GREAT DW ZBRAN ; IF DW MIN1-$ DW SWAP ; ENDIF MIN1 DW DROP DW SEMIS ; DB 83H ; MAX DB 'MA' DB 'X'+80H DW MIN-6 MAX DW DOCOL,TDUP DW LESS DW ZBRAN ; IF DW MAX1-$ DW SWAP ; ENDIF MAX1 DW DROP DW SEMIS ; DB 82H ; M* DB 'M' DB '*'+80H DW MAX-6 MSTAR DW DOCOL,TDUP DW XORR DW TOR DW ABS DW SWAP DW ABS DW USTAR DW FROMR DW DPM DW SEMIS ; DB 82H ; M/ DB 'M' DB '/'+80H DW MSTAR-5 MSLAS DW DOCOL DW OVER DW TOR DW TOR DW DABS DW RR DW ABS DW USLAS DW FROMR DW RR DW XORR DW PM DW SWAP DW FROMR DW PM DW SWAP DW SEMIS ; DB 81H ; * DB '*'+80H DW MSLAS-5 STAR DW DOCOL DW MSTAR DW DROP DW SEMIS ; DB 84H ; /MOD DB '/MO' DB 'D'+80H DW STAR-4 SLMOD DW DOCOL DW TOR DW STOD DW FROMR DW MSLAS DW SEMIS ; DB 81H ; / DB '/'+80H DW SLMOD-7 SLASH DW DOCOL DW SLMOD DW SWAP DW DROP DW SEMIS ; DB 83H ; MOD DB 'MO' DB 'D'+80H DW SLASH-4 MODD DW DOCOL DW SLMOD DW DROP DW SEMIS ; DB 85H ; */MOD DB '*/MO' DB 'D'+80H DW MODD-6 SSMOD DW DOCOL DW TOR DW MSTAR DW FROMR DW MSLAS DW SEMIS ; DB 82H ; */ DB '*' DB '/'+80H DW SSMOD-8 SSLA DW DOCOL DW SSMOD DW SWAP DW DROP DW SEMIS ; DB 85H ; M/MOD DB 'M/MO' DB 'D'+80H DW SSLA-5 MSMOD DW DOCOL DW TOR DW ZERO DW RR DW USLAS DW FROMR DW SWAP DW TOR DW USLAS DW FROMR DW SEMIS ; ; BLOCK MOVED DOWN 2 PAGES ; ; DB 86H ; (LINE) DB '(LINE' DB ')'+80H DW MSMOD-8 PLINE DW DOCOL DW TOR DW LIT DW 40H DW BBUF DW SSMOD DW FROMR DW BSCR DW STAR DW PLUS DW BLOCK DW PLUS DW LIT DW 40H DW SEMIS ; DB 85H ; .LINE DB '.LIN' DB 'E'+80H DW PLINE-9 DLINE DW DOCOL DW PLINE DW DTRAI DW TYPE DW SEMIS ; DB 87H ; MESSAGE DB 'MESSAG' DB 'E'+80H DW DLINE-8 MESS DW DOCOL DW WARN DW AT DW ZBRAN ; IF DW MESS1-$ DW DDUP DW ZBRAN ; IF DW MESS2-$ DW LIT DW 4 DW OFSET DW AT DW BSCR DW SLASH DW SUBB DW DLINE DW SPACE ; ENDIF MESS2 DW BRAN ; ELSE DW MESS3-$ MESS1 DW PDOTQ DB 6 DB 'MSG # ' DW DOT ; ENDIF MESS3 DW SEMIS PAGE ;------------------------------------------ ; ; 8080 PORT FETCH AND STORE ; ( SELF MODIFYING CODE, NOT REENTRANT ) ; DB 82H ; P@ "PORT @" DB 'P' DB '@'+80H DW MESS-0AH PTAT: DW $+2 POP D ;E <- PORT# LXI H,$+5 MOV M,E IN 0 ;( PORT# MODIFIED ) MOV L,A ;L <- (PORT#) MVI H,0 JMP HPUSH ; DB 82H ; "PORT STORE" DB 'P' DB '!'+80H DW PTAT-5 PTSTO: DW $+2 POP D ;E <- PORT# LXI H,$+7 MOV M,E POP H ;H <- CDATA MOV A,L OUT 0 ;( PORT# MODIFIED ) JMP NEXT PAGE ;-------------------------------------------------- ; CP/M DISK INTERFACE ; ; CP/M BIOS CALLS USED ; ( NOTE EQU'S ARE 3 LOWER THAN DOCUMENTED OFFSETS ; BECAUSE BASE ADDR IS BIOS+3 ) ; RITSEC EQU 39 RDSEC EQU 36 SETDMA EQU 33 SETSEC EQU 30 SETTRK EQU 27 SETDSK EQU 24 ; ; DOUBLE DENSITY 8" FLOPPY CAPACITIES SPT2 EQU 52 ; SECTORS PER TRACK TRKS2 EQU 77 ; NUMBER OF TRACKS SPDRV2 EQU SPT2*TRKS2 ; SECTORS/DRIVE ; SINGLE DENSITY 8" FLOPPY CAPACITIES SPT1 EQU 26 ; SECTORS/TRACK TRKS1 EQU 77 ; # TRACKS SPDRV1 EQU SPT1*TRKS1 ; SECTORS/DRIVE ; BPS EQU 128 ; BYTES PER SECTOR MXDRV EQU 2 ; MAX # DRIVES ; ; FORTH VARIABLES AND CONSTANTS USED IN DISK INTERFACE ; DB 85H ; DRIVE ( CURRENT DRIVE # ) DB 'DRIV' DB 'E'+80H DW PTSTO-5 DRIVE DW DOVAR,0 ; DB 83H ; SEC ( SECTOR # ) DB 'SE' DB 'C'+80H DW DRIVE-8 SEC: DW DOVAR DW 0 ; DB 85H ; TRACK ( TRACK # ) DB 'TRAC' DB 'K'+80H DW SEC-6 TRACK: DW DOVAR,0 ; DB 83H ; USE ( ADDR OF NEXT BUFFER TO USE ) DB 'US' DB 'E'+80H DW TRACK-8 USE: DW DOVAR DW BUF1 ; DB 84H ; PREV ; ( ADDR OF PREVIOUSLY USED BUFFER ) DB 'PRE' DB 'V'+80H DW USE-6 PREV DW DOVAR DW BUF1 ; DB 87H ; SEC/BLK ( # SECTORS/BLOCK ) DB 'SEC/BL' DB 'K'+80H DW PREV-7 SPBLK DW DOCON DW KBBUF/BPS ; DB 85H ; #BUFF ( NUMBER OF BUFFERS ) DB '#BUF' DB 'F'+80H DW SPBLK-10 NOBUF DW DOCON,NBUF ; DB 87H ; DENSITY ( 0 = SINGLE , 1 = DOUBLE ) DB 'DENSIT' DB 'Y'+80H DW NOBUF-8 DENSTY DW DOVAR DW 0 ; DB 8AH ; DISK-ERROR ( DISK ERROR STATUS ) DB 'DISK-ERRO' DB 'R'+80H DW DENSTY-10 DSKERR DW DOVAR,0 ; ; DISK INTERFACE HIGH-LEVEL ROUTINES ; DB 84H ; +BUF ( ADVANCE BUFFER ) DB '+BU' DB 'F'+80H DW DSKERR-13 PBUF DW DOCOL DW LIT,CO DW PLUS,DUP DW LIMIT,EQUAL DW ZBRAN,PBUF1-$ DW DROP,FIRST PBUF1: DW DUP,PREV DW AT,SUBB DW SEMIS ; DB 86H ; UPDATE DB 'UPDAT' DB 'E'+80H DW PBUF-7 UPDAT DW DOCOL,PREV DW AT,AT DW LIT,8000H DW ORR DW PREV,AT DW STORE,SEMIS ; DB 8DH ; EMPTY-BUFFERS DB 'EMPTY-BUFFER' DB 'S'+80H DW UPDAT-9 MTBUF DW DOCOL,FIRST DW LIMIT,OVER DW SUBB,ERASEE DW SEMIS ; DB 83H ; DR0 DB 'DR' DB '0'+80H DW MTBUF-16 DRZER DW DOCOL,ZERO DW OFSET,STORE DW SEMIS ; DB 83H ; DR1 DB 'DR' DB '1'+80H DW ERZER-6 DRONE DW DOCOL DW DENSTY,AT DW ZBRAN,DRON1-$ DW LIT,SPDRV2 DW BRAN,DRON2-$ DRON1 DW LIT,SPDRV1 DRON2 DW OFSET,STORE DW SEMIS ; DB 86H ; BUFFER DB 'BUFFE' DB 'R'+80H DW DRONE-6 BUFFE: DW DOCOL,USE DW AT,DUP DW TOR BUFF1 DW PBUF ; WON'T WORK IF SINGLE BUFFER DW ZBRAN,BUFF1-$ DW USE,STORE DW RR,AT DW ZLESS DW ZBRAN,BUFF2-$ DW RR,TWOP DW RR,AT DW LIT,7FFFH DW ANDD,ZERO DW RSLW BUFF2 DW RR,STORE DW RR,PREV DW STORE,FROMR DW TWOP,SEMIS ; DB 85H ; BLOCK DB 'BLOC' DB 'K'+80H DW BUFFE-9 BLOCK DW DOCOL,OFSET DW AT,PLUS DW TOR,PREV DW AT,DUP DW AT,RR DW SUBB DW DUP,PLUS DW ZBRAN,BLOC1-$ BLOC2 DW PBUF,ZEQU DW ZBRAN,BLOC3-$ DW DROP,RR DW BUFFE,DUP DW RR,ONE DW RSLW DW TWO,SUBB BLOC3 DW DUP,AT DW RR,SUBB DW DUP,PLUS DW ZEQU DW ZBRAN,BLOC2-$ DW DUP,PREV DW STORE BLOC1 DW FROMR,DROP DW TWOP,SEMIS ; ; ; CP/M INTERFACE ROUTINES ; ; SERVICE REQUEST ; IOS LHLD 1 ; (HL) <- BIOS TABLE ADDR+3 DAD D ; + SERVICE REQUEST OFFSET PCHL ; EXECUTE REQUEST ; RET FUNCTION PROVIDED BY CP/M ; DB 86H ; SET-IO ; ( ASSIGN SECTOR, TRACK FOR BDOS ) DB 'SET-I' DB 'O'+80H DW BLOCK-8 SETIO: DW $+2 PUSH B ; SAVE (IP) LHLD USE+2 ; (BC) <- ADDR BUFFER MOV B,H MOV C,L LXI D,SETDMA ; SEND BUFFER ADDR TO CP/M CALL IOS ; LHLD SEC+2 ; (BC) <- (SEC) = SECTOR # MOV C,L LXI D,SETSEC ; SEND SECTOR # TO CP/M CALL IOS ; LHLD TRACK+2 ; (BC) <- (TRACK) = TRACK # MOV B,H MOV C,L LXI D,SETTRK CALL IOS ; POP B ; RESTORE (IP) JMP NEXT ; DB 89H ; SET-DRIVE DB 'SET-DRIV' DB 'E'+80H DW SETIO-9 SETDRV: DW $+2 PUSH B ; SAVE (IP) LDA DRIVE+2 ; (C) <- (DRIVE) = DRIVE # MOV C,A LXI D,SETDSK ; SEND DRIVE # TO CP/M CALL IOS POP B ; RESTORE (IP) JMP NEXT ; ; T&SCALC ( CALCULATES DRIVE#, TRACK#, & SECTOR# ) ; STACK INPUT: SECTOR-DISPLACEMENT = BLK# * SEC/BLK ; OUTPUT: VARIABLES DRIVE, TRACK, & SEC ; DB 87H ; T&SCALC DB 'T&SCAL' DB 'C'+80H DW SETDRV-12 TSCALC: DW DOCOL,DENSTY DW AT DW ZBRAN,TSCALS-$ DW LIT,SPDRV2 DW SLMOD DW LIT,MXDRV DW MIN DW DUP,DRIVE DW AT,EQUAL DW ZBRAN,TSCAL1-$ DW DROP DW BRAN,TSCAL2-$ TSCAL1 DW DRIVE,STORE DW SETDRV TSCAL2 DW LIT,SPT2 DW SLMOD,TRACK DW STORE,ONEP DW SEC,STORE DW SEMIS ; SINGLE DENSITY TSCALS DW LIT,SPDRV1 DW SLMOD DW LIT,MXDRV DW MIN DW DUP,DRIVE DW AT,EQUAL DW ZBRAN,TSCAL3-$ DW DROP DW BRAN,TSCAL4-$ TSCAL3 DW DRIVE,STORE DW SETDRV TSCAL4 DW LIT,SPT1 DW SLMOD,TRACK DW STORE,ONEP DW SEC,STORE DW SEMIS ; ; SEC-READ ; ( READ A SECTOR SETUP BY 'SET-DRIVE' & 'SETIO' ) ; DB 88H ; SEC-READ DB 'SEC-REA' DB 'D'+80H DW TSCALC-10 SECRD DW $+2 PUSH B ; SAVE (IP) LXI D,RDSEC ; ASK CP/M TO READ SECTOR CALL IOS STA DSKERR+2 ; (DSKERR) <- ERROR STATUS POP B ; RESTORE (IP) JMP NEXT ; ; SEC-WRITE ; ( WRITE A SECTOR SETUP BY 'SET-DRIVE' & 'SETIO' ) ; DB 89H ; SEC-WRITE DB 'SEC-WRIT' DB 'E'+80H DW SECRD-11 SECWT DW $+2 PUSH B ; SAVE (IP) LXI D,RITSEC ; ASK CP/M TO WRITE SECTOR CALL IOS STA DSKERR+2 ; (DSKERR) <- ERROR STATUS POP B ; RESTORE (IP) JMP NEXT ; DB 83H ; R/W ( FORTH DISK PRIMATIVE ) DB 'R/' DB 'W'+80H DW SECWT-12 RSLW DW DOCOL DW USE,AT DW TOR DW SWAP,SPBLK DW STAR,ROT DW USE,STORE DW SPBLK,ZERO DW XDO RSLW1 DW OVER,OVER DW TSCALC,SETIO DW ZBRAN,RSLW2-$ DW SECRD DW BRAN,RSLW3-$ RSLW2 DW SECWT RSLW3 DW ONEP DW LIT,80H DW USE,PSTOR DW XLOOP,RSLW1-$ DW DROP,DROP DW FROMR,USE DW STORE,SEMIS ; ;-------------------------------------------------------- ; ; ALTERNATIVE R/W FOR NO DISK INTERFACE ; ;RSLW DW DOCOL,DROP,DROP,DROP,SEMIS ; ;-------------------------------------------------------- ; DB 85H ; FLUSH DB 'FLUS' DB 'H'+80H DW RSLW-6 FLUSH DW DOCOL DW NOBUF,ONEP DW ZERO,XDO FLUS1 DW ZERO,BUFFE DW DROP DW XLOOP,FLUS1-$ DW SEMIS ; DB 84H ; LOAD DB 'LOA' DB 'D'+80H DW FLUSH-8 LOAD DW DOCOL,BLK DW AT,TOR DW INN,AT DW TOR,ZERO DW INN,STORE DW BSCR,STAR DW BLK,STORE ; BLK <- SCR * B/SCR DW INTER ; INTERPRET FROM OTHER SCREEN DW FROMR,INN DW STORE DW FROMR,BLK DW STORE DW SEMIS ; DB 0C3H ; --> DB '--' DB '>'+80H DW LOAD-7 ARROW DW DOCOL DW QLOAD DW ZERO DW INN DW STORE DW BSCR DW BLK DW AT DW OVER DW MODD DW SUBB DW BLK DW PSTOR DW SEMIS ; PAGE ;------------------------------------------------- ; ; CP/M CONSOLE & PRINTER INTERFACE ; ; CP/M BIOS CALLS USED ; ( NOTE: BELOW OFFSETS ARE 3 LOWER THAN CP/M ; DOCUMENTATION SINCE BASE ADDR = BIOS+3 ) ; KCSTAT EQU 3 ; CONSOLE STATUS KCIN EQU 6 ; CONSOLE INPUT KCOUT EQU 9 ; CONSOLE OUTPUT KPOUT EQU 0CH ; PRINTER OUTPUT ; EPRINT DW 0 ; ENABLE PRINTER VARIABLE ; ; 0 = DISABLED, 1 = ENABLED ; ; BELOW BIOS CALLS USE 'IOS' IN DISK INTERFACE ; CSTAT PUSH B ; CONSOLE STATUS LXI D,KCSTAT ; CHECK IF ANY CHR HAS BEEN TYPED CALL IOS POP B ; IF CHR TYPED THEN (A) <- 0FFH RET ; ELSE (A) <- 0 ; ; CHR IGNORED ; CIN PUSH B ; CONSOLE INPUT LXI D,KCIN ; WAIT FOR CHR TO BE TYPED CALL IOS ; (A) <- CHR, (MSB) <- 0 POP B RET ; COUT PUSH H ; CONSOLE OUTPUT LXI D,KCOUT ; WAIT UNTIL READY CALL IOS ; THEN OUTPUT (C) POP H RET ; POUT LXI D,KPOUT ; PRINTER OUTPUT CALL IOS ; WAIT UNTIL READY RET ; THEN OUTPUT (C) ; CPOUT CALL COUT ; OUTPUT (C) TO CONSOLE XCHG LXI H,EPRINT MOV A,M ; IF (EPRINT) <> 0 ORA A JZ CPOU1 MOV C,E ; THEN OUTPUT (C) TO PRINTER CALL POUT CPOU1 RET ; ; FORTH TO CP/M SERIAL IO INTERFACE ; PQTER CALL CSTAT ; IF CHR TYPED LXI H,0 ORA A JZ PQTE1 INR L ; THEN (S1) <- TRUE PQTE1 JMP HPUSH ; ELSE (S1) <- FALSE ; PKEY CALL CIN ; READ CHR FROM CONSOLE CPI DLE ; IF CHR = (^P) MOV E,A JNZ PKEY1 LXI H,EPRINT ; THEN TOGGLE (EPRINT)LSB MVI E,ABL ; CHR <- BLANK MOV A,M XRI 1 MOV M,A PKEY1 MOV L,E MVI H,0 JMP HPUSH ; (S1)LB <- CHR ; PEMIT DW $+2 ; (EMIT) ORPHAN POP H ; (L) <- (S1)LB = CHR PUSH B ; SAVE (IP) MOV C,L CALL CPOUT ; OUTPUT CHR TO CONSOLE ; ; & MAYBE PRINTER POP B ; RESTORE (IP) JMP NEXT ; PCR PUSH B ; SAVE (IP) MVI C,ACR ; OUTPUT (CR) TO CONSOLE MOV L,C CALL CPOUT ; & MAYBE TO PRINTER MVI C,LF ; OUTPUT (LF) TO CONSOLE MOV L,C CALL CPOUT ; & MAYBE TO PRINTER POP B ; RESTORE (IP) JMP NEXT ; ;---------------------------------------------------- PAGE ; DB 0C1H ; ' ( TICK ) DB 0A7H DW ARROW-6 TICK DW DOCOL DW DFIND DW ZEQU DW ZERO DW QERR DW DROP DW LITER DW SEMIS ; DB 86H ; FORGET DB 'FORGE' DB 'T'+80H DW TICK-4 FORG DW DOCOL DW CURR DW AT DW CONT DW AT DW SUBB DW LIT DW 18H DW QERR DW TICK DW DUP DW FENCE DW AT DW LESS DW LIT DW 15H DW QERR DW DUP DW NFA DW DP DW STORE DW LFA DW AT DW CONT DW AT DW STORE DW SEMIS ; DB 84H ; BACK DB 'BAC' DB 'K'+80H DW FORG-9 BACK DW DOCOL DW HERE DW SUBB DW COMMA DW SEMIS ; DB 0C5H ; BEGIN DB 'BEGI' DB 'N'+80H DW BACK-7 BEGIN DW DOCOL DW QCOMP DW HERE DW ONE DW SEMIS ; DB 0C5H ; ENDIF DB 'ENDI' DB 'F'+80H DW BEGIN-8 ENDIFF DW DOCOL DW QCOMP DW TWO DW QPAIR DW HERE DW OVER DW SUBB DW SWAP DW STORE DW SEMIS ; DB 0C4H ; THEN DB 'THE' DB 'N'+80H DW ENDIFF-8 THEN DW DOCOL DW ENDIFF DW SEMIS ; DB 0C2H ; DO DB 'D' DB 'O'+80H DW THEN-7 DO DW DOCOL DW COMP DW XDO DW HERE DW THREE DW SEMIS ; DB 0C4H ; LOOP DB 'LOO' DB 'P'+80H DW DO-5 LOOP DW DOCOL DW THREE DW QPAIR DW COMP DW XLOOP DW BACK DW SEMIS ; DB 0C5H ; +LOOP DB '+LOO' DB 'P'+80H DW LOOP-7 PLOOP DW DOCOL DW THREE DW QPAIR DW COMP DW XPLOO DW BACK DW SEMIS ; DB 0C5H ; UNTIL DB 'UNTI' DB 'L'+80H DW PLOOP-8 UNTIL DW DOCOL DW ONE DW QPAIR DW COMP DW ZBRAN DW BACK DW SEMIS ; DB 0C3H ; END DB 'EN' DB 'D'+80H DW UNTIL-8 ENDD DW DOCOL DW UNTIL DW SEMIS ; DB 0C5H ; AGAIN DB 'AGAI' DB 'N'+80H DW ENDD-6 AGAIN DW DOCOL DW ONE DW QPAIR DW COMP DW BRAN DW BACK DW SEMIS ; DB 0C6H ; REPEAT DB 'REPEA' DB 'T'+80H DW AGAIN-8 REPEA DW DOCOL DW TOR DW TOR DW AGAIN DW FROMR DW FROMR DW TWO DW SUBB DW ENDIFF DW SEMIS ; DB 0C2H ; IF DB 'I' DB 'F'+80H DW REPEA-9 IFF DW DOCOL DW COMP DW ZBRAN DW HERE DW ZERO DW COMMA DW TWO DW SEMIS ; DB 0C4H ; ELSE DB 'ELS' DB 'E'+80H DW IFF-5 ELSEE DW DOCOL DW TWO DW QPAIR DW COMP DW BRAN DW HERE DW ZERO DW COMMA DW SWAP DW TWO DW ENDIFF DW TWO DW SEMIS ; DB 0C5H ; WHILE DB 'WHIL' DB 'E'+80H DW ELSEE-7 WHILE DW DOCOL DW IFF DW TWOP DW SEMIS ; DB 86H ; SPACES DB 'SPACE' DB 'S'+80H DW WHILE-8 SPACS DW DOCOL DW ZERO DW MAX DW DDUP DW ZBRAN ; IF DW SPAX1-$ DW ZERO DW XDO ; DO SPAX2 DW SPACE DW XLOOP ; LOOP ENDIF DW SPAX2-$ SPAX1 DW SEMIS ; DB 82H ; <# DB '<' DB '#'+80H DW SPACS-9 BDIGS DW DOCOL DW PAD DW HLD DW STORE DW SEMIS ; DB 82H ; #> DB '#' DB '>'+80H DW BDIGS-5 EDIGS DW DOCOL DW DROP DW DROP DW HLD DW AT DW PAD DW OVER DW SUBB DW SEMIS ; DB 84H ; SIGN DB 'SIG' DB 'N'+80H DW EDIGS-5 SIGN DW DOCOL DW ROT DW ZLESS DW ZBRAN ; IF DW SIGN1-$ DW LIT DW 2DH DW HOLD ; ENDIF SIGN1 DW SEMIS ; DB 81H ; # DB '#'+80H DW SIGN-7 DIG DW DOCOL DW BASE DW AT DW MSMOD DW ROT DW LIT DW 9 DW OVER DW LESS DW ZBRAN ; IF DW DIG1-$ DW LIT DW 7 DW PLUS ; ENDIF DIG1 DW LIT DW 30H DW PLUS DW HOLD DW SEMIS ; DB 82H ; #S DB '#' DB 'S'+80H DW DIG-4 DIGS DW DOCOL DIGS1 DW DIG ; BEGIN DW OVER DW OVER DW ORR DW ZEQU DW ZBRAN ; UNTIL DW DIGS1-$ DW SEMIS ; DB 83H ; D.R DB 'D.' DB 'R'+80H DW DIGS-5 DDOTR DW DOCOL DW TOR DW SWAP DW OVER DW DABS DW BDIGS DW DIGS DW SIGN DW EDIGS DW FROMR DW OVER DW SUBB DW SPACS DW TYPE DW SEMIS ; DB 82H ; .R DB '.' DB 'R'+80H DW DDOTR-6 DOTR DW DOCOL DW TOR DW STOD DW FROMR DW DDOTR DW SEMIS ; DB 82H ; D. DB 'D' DB '.'+80H DW DOTR-5 DDOT DW DOCOL DW ZERO DW DDOTR DW SPACE DW SEMIS ; DB 81H ; . DB '.'+80H DW DDOT-5 DOT DW DOCOL DW STOD DW DDOT DW SEMIS ; DB 81H ; ? DB '?'+80H DW DOT-4 QUES DW DOCOL DW AT DW DOT DW SEMIS ; DB 82H ; U. DB 'U' DB '.'+80H DW QUES-4 UDOT DW DOCOL DW ZERO DW DDOT DW SEMIS ; DB 85H ; VLIST DB 'VLIS' DB 'T'+80H DW UDOT-5 VLIST DW DOCOL DW LIT DW 80H DW OUTT DW STORE DW CONT DW AT DW AT VLIS1 DW OUTT ; BEGIN DW AT DW CSLL DW GREAT DW ZBRAN ; IF DW VLIS2-$ DW CR DW ZERO DW OUTT DW STORE ; ENDIF VLIS2 DW DUP DW IDDOT DW SPACE DW SPACE DW PFA DW LFA DW AT DW DUP DW ZEQU DW QTERM DW ORR DW ZBRAN ; UNTIL DW VLIS1-$ DW DROP DW SEMIS ; ;------ EXIT CP/M ----------------------- ; DB 83H ; BYE DB 'BY' DB 'E'+80H DW VLIST-8 BYE DW $+2 JMP 0 ;----------------------------------------------- ; DB 84H ; LIST DB 'LIS' DB 'T'+80H DW BYE-6 LIST DW DOCOL,DEC DW CR,DUP DW SCR,STORE DW PDOTQ DB 6,'SCR # ' DW DOT DW LIT,10H DW ZERO,XDO LIST1 DW CR,IDO DW LIT,3 DW DOTR,SPACE DW IDO,SCR DW AT,DLINE DW QTERM ; ?TERMINAL DW ZBRAN,LIST2-$ ; IF DW LEAVE ; LEAVE LIST2 DW XLOOP,LIST1-$ ; ENDIF DW CR,SEMIS ; DB 85H ; INDEX DB 'INDE' DB 'X'+80H DW LIST-7 INDEX DW DOCOL DW LIT,FF DW EMIT,CR DW ONEP,SWAP DW XDO INDE1 DW CR,IDO DW LIT,3 DW DOTR,SPACE DW ZERO,IDO DW DLINE,QTERM DW ZBRAN,INDE2-$ DW LEAVE INDE2 DW XLOOP,INDE1-$ DW SEMIS ; DB 85H ; TRIAD DB 'TRIA' DB 'D'+80H DW INDEX-8 TRIAD DW DOCOL DW LIT,FF DW EMIT DW LIT,3 DW SLASH DW LIT,3 DW STAR DW LIT,3 DW OVER,PLUS DW SWAP,XDO TRIA1 DW CR,IDO DW LIST DW QTERM ; ?TERMINAL DW ZBRAN,TRIA2-$ ; IF DW LEAVE ; LEAVE TRIA2 DW XLOOP,TRIA1-$ ; ENDIF DW CR DW LIT,15 DW MESS,CR DW SEMIS ; DB 84H ; .CPU DB '.CP' DB 'U'+80H DW TRIAD-8 DOTCPU DW DOCOL DW BASE,AT DW LIT,36 DW BASE,STORE DW LIT,22H DW PORIG,TAT DW DDOT DW BASE,STORE DW SEMIS ; DB 84H ; TASK DB 'TAS' DB 'K'+80H DW DOTCPU-7 TASK DW DOCOL DW SEMIS ; INITDP: DS EM-$ ;CONSUME MEMORY TO LIMIT ; PAGE ; ; MEMORY MAP ; ( THE FOLLOWING EQUATES ARE NOT REFERENCED ELSEWHERE ) ; ; LOCATION CONTENTS ; -------- -------- MCOLD EQU ORIG ;JMP TO COLD START MWARM EQU ORIG+4 ;JMP TO WARM START MA2 EQU ORIG+8 ;COLD START PARAMETERS MUP EQU UP ;USER VARIABLES' BASE 'REG' MRP EQU RPP ;RETURN STACK 'REGISTER' ; MBIP EQU BIP ;DEBUG SUPPORT MDPUSH EQU DPUSH ;ADDRESS INTERPRETER MHPUSH EQU HPUSH MNEXT EQU NEXT ; MDP0 EQU DP0 ;START FORTH DICTIONARY MDIO EQU DRIVE ;CP/M DISK INTERFACE MCIO EQU EPRINT ;CONSOLE & PRINTER INTERFACE MIDP EQU INITDP ;END INITIAL FORTH DICTIONARY ; = COLD (DP) VALUE ; = COLD (FENCE) VALUE ; | NEW ; | DEFINITIONS ; V ; ; ^ ; | DATA ; | STACK MIS0 EQU INITS0 ; = COLD (SP) VALUE = (S0) ; = (TIB) ; | TERMINAL INPUT ; | BUFFER ; V ; ; ^ ; | RETURN ; | STACK MIR0 EQU INITR0 ;START USER VARIABLES ; = COLD (RP) VALUE = (R0) ; = (UP) ; ;END USER VARIABLES MFIRST EQU BUF1 ;START DISK BUFFERS ; = FIRST MEND EQU EM-1 ;END DISK BUFFERS MLIMIT EQU EM ;LAST MEMORY LOC USED + 1 ; = LIMIT ; ; END ORIG HHHHDT=0 LEAVE ; LEAVE TRIA2 DW XLOOP,TRIA1-$ ; ENDIF DW CR DW LIT,15 DW MESS,CR DW SEMIS ; DB 84H ; .CPU DB '.CP' DB 'U'+80H DW TRIAD-8 DOTCPUPPORT MDPUSH EQU DPUSH ;ADDRESS INTERPR