IMD 1.17: 5/01/2010 7:46:18 8080/z80 fig-FORTH cp/m ver 1.3 7/18/81 model & source  @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@  FORTH130ASM FORTH130ASM !FORTH130ASM"#$%&'()*+,-./01FORTH130ASM23456789:;<=>?@AG RELEASE # FIGREV EQU 3 ; FIG REVISION # USRVER EQU 0 ; USER VERSION # ; ; ASCII CHARACTERS USED ; ABL EQU 20H ; SPACE AHIS PUBLICATION HAS BEEN MADE AVAILABLE BY THE ; FORTH INTEREST GROUP ; P. O. BOX 1105 ; SAN CARLOS, CA 940FORTH130ASM:BCDEFGHIFORTH130COM@JKLMNOPQFORTH130USERSCR EQU 0DH ; CARRIAGE RETURN ADOT EQU 02EH ; PERIOD BELL EQU 07H ; (^G) BSIN EQU 08H ; INPUT BACKSPACE BSOUT EQU 08H ; OUTPU70 ; ; IMPLEMENTATION BY: ( 790528 ) ; JOHN CASSADY ; 339 15TH STREET ; OAKLAND,CA 94612 ; MODIFIED BY: ; KIM HARRT BACKSPACE (^H) DLE EQU 10H ; (^P) LF EQU 0AH ; LINE FEED FF EQU 0CH ; FORM FEED (^L) ; ; MEMORY ALLOCATION ; EM EQU 327IS ; ACKNOWLEDGEMENTS: ; GEORGE SHAW ; TERRY HOLMES ; MIKE PERRY ; DON COLBURN ; GEORGE FLAMMER ; ROBT. D. VILLWOCK TITLE '8080 FIG-FORTH 1.3 VERSION 0 18JUL81' ; FIG-FORTH RELEASE 1.3 FOR THE 8080 PROCESSOR ; ; ALL PUBLICATIONS OF THE F68 ; TOP OF MEMORY + 1 = LIMIT NSCR EQU 4 ; NUMBER OF 1024 BYTE SCREENS KBBUF EQU 1024 ; DATA BYTES PER DISK BUFFER US EQU 40 ; PAGE ; ;---------------------------------------------------------- ; ; RELEASE & VERSION NUMBERS ; FIGREL EQU 1 ; FIORTH INTEREST GROUP ; ARE PUBLIC DOMAIN. THEY MAY BE FURTHER ; DISTRIBUTED BY THE INCLUSION OF THIS CREDIT ; NOTICE: ; ; T H ; USER VARIABLES SPACE RTS EQU 0A0H ; RETURN STACK & TERM BUFF SPACE ; CO EQU KBBUF+4 ; DISK BUFFER + 2 HEADER + 2 TAIL NBRETER IS ; | { 0 PRE | 1 POST } ; | INCREMENTING ; +---------- { 0 ABOVE SUFFICIENT ;  ELAST ; LAST EDITOR DEF. ;OASM DW ALAST ; SAME FOR ASSEMBLER IF RESIDENT ; ; ; +---------------+ ; B +ORIGIN | . . .W:I.PARAMETER FIELD ; ; S1 = ADDR OF 1ST WORD OF PARAMETER STACK ; S2 = ADDR OF 2ND WORD OF PARAMETER STACK ; R1 = ADDR OF 1ST WFOR DW FLAST ; TOPMOST WORD IN FORTH VOCABULARY DW BSIN ; BKSPACE CHARACTER DW INITR0 ; INIT (UP) ;<<<<<< FOLLOWING USED BYD BEFORE 'NEXT' ; HL NEVER OUTPUT FROM NEXT ; INPUT ONLY WHEN 'HPUSH' CALLED ; UP DW INITR0 ; USER AREA POINTER RPP DW IUF EQU NSCR*1024/KBBUF ; NUMBER OF BUFFERS BUF1 EQU EM-CO*NBUF ; ADDR FIRST DISK BUFFER INITR0 EQU BUF1-US ; (R0) INITS0 EQU | 1 OTHER DIFFER- ; ENCES EXIST } ; PAGE ; ;------------------------------------------------------ ; ; FORTE.B.A| IMPLEMENTATION ; +---------------+ ATTRIBUTES ; ^ ^ ^ ^ ^ ; | | | | +-- PROCESSOR ADDR = ; ORD OF RETURN STACK ; R2 = ADDR OF 2ND WORD OF RETURN STACK ; ( ABOVE STACK POSITIONS VALID BEFORE & AFTER EXECUTION ; OF ANY COLD; ; MUST BE IN SAME ORDER AS USER VARIABLES OCLD0 DW INITS0 ; INIT (S0) DW INITR0 ; INIT (R0) DW INITS0 ; INIT (TIB) NITR0 ; RETURN STACK POINTER ; ;------------------------------------------------------ ; ; COMMENT CONVENTIONS: ; ; = MEAN INITR0-RTS ; (S0) ; PAGE ; ;------------------------------------------------------- ; ORG 100H ; ENTRY FOR INITIAL EXEH REGISTERS ; ; FORTH 8080 FORTH PRESERVATION RULES ; ----- ---- ------------------------ ; IP BC SHOULD BE PRESERVED ACROSS | | | | { 0 BYTE | 1 WORD } ; | | | +---- HIGH BYTE AT ; | | | { 0 LOW ADDR | ; | | | WORD, NOT DURING. ) ; ; LSB = LEAST SIGNIFICANT BIT ; MSB = MOST SIGNIFICANT BIT ; LB = LOW BYTE ; HB = HIGH BYTE ; LW =  DW 31 ; INIT (WIDTH) DW 0 ; INIT (WARNING) DW FLAST ; INIT (FENCE) DW INITDP ; INIT (DP) DW FORTH+6 ; INIT (VOC-LS "IS EQUAL TO" ; <- MEANS ASSIGNMENT ; ; NAME = ADDRESS OF NAME ; (NAME) = CONTENTS AT NAME ; ((NAME))= INDIRECT CONTENTS CUTION AND COLD START ORIG NOP JMP CLD ; VECTOR TO COLD START ; ENTRY FOR WARM START NOP JMP WRM ; VECTOR TO WARM START  ; FORTH WORDS ; W DE SOMETIMES OUTPUT FROM NEXT ; MAY BE ALTERED BEFORE JMP'ING TO NEXT ; INPUT ONLY WHEN 'DPUSH' C 1 HIGH ADDR } ; | | +------ ADDR MUST BE EVEN ; | | { 0 YES | 1 NO } ; | +-------- INTERPLOW WORD ; HW = HIGH WORD ; ( MAY BE USED AS SUFFIX TO ABOVE NAMES ) ; PAGE ; ;------------------------------------------INK) OCLD1 EQU $ ;<<<<<< END DATA USED BY COLD DW 5H,0B320H ; CPU NAME ( HW,LW ) ; ( 32 BIT, BASE 36 INTEGER ) OED DW ; ; CFA = ADDRESS OF CODE FIELD ; LFA = ADDRESS OF LINK FIELD ; NFA = ADDR OF START OF NAME FIELD ; PFA = ADDR OF START OF  ; DB FIGREL ; FIG RELEASE # DB FIGREV ; FIG REVISION # DB USRVER ; USER VERSION # DB 0EH ; IMPLEMENTATION ATTRIBUTES OALLED ; SP SP SHOULD BE USED ONLY AS DATA STACK ; ACROSS FORTH WORDS ; MAY BE USED WITHIN FORTH WORDS ; IF RESTORE --------- ; DEBUG SUPPORT ; ; TO USE: ; (1) SET 'BIP' TO IP VALUE TO HALT, CANNOT BE CFA ; (2) SET MONITOR'S BREAKPOINT PC ECUT' DB 'E'+80H DW LIT-6 EXEC DW $+2 POP H ; (HL) <- (S1) = CFA JMP NEXT1 ; DB 86H ; BRANCH DB 'BRANC' DB 'H'+8=1, NAME'S LAST CHR ; LFA LINK FIELD = PREVIOUS WORD'S NFA ; ;LABEL: CFA CODE FIELD = ADDR CPA,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 D 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) <- HLD RPP ; ((HL)) = INDEX = (R1) MOV E,M ; (DE) <- INDEX INX H MOV D,M INX D ; INDEX <- INDEX + 1 MOV M,D ; (R1) <- NEWTO 'BREAK' ; OR PATCH 'HLT' INSTR. THERE ; (3) PATCH A 'JMP TNEXT' AT 'NEXT' ; WHEN (IP) = (BIP) CPU WILL HALT ; BIP DW 00H DW EXEC-0AH BRAN DW $+2 ;(IP) <- (IP) + ((IP)) BRAN1 MOV H,B ; (HL) <- (IP) MOV L,C MOV E,M ; (DE) <- ((IP)) = BRANCHU CODE ; ; PFA PARAMETER <1PARAM> 1ST PARAMETER BYTE ; FIELD <2PARAM> ; ... ; ; DP0 DB 83H ; LIT DBCR D MOV D,A ; (DE) <- NEW INDEX JM XLOO2 ; IF INCR > 0 MOV A,E ; THEN (A) <- INDEX - LIMIT SUB M MOV A,D INX H SB((W)) INX H MOV D,M XCHG PCHL ; NOTE: (DE) = CFA+1 ; PAGE ; ; FORTH DICTIONARY ; ; ; DICTIONARY FORMAT: ; ;  INDEX DCX H MOV M,E INX H INX H ; ((HL)) = LIMIT MOV A,E ; IF INDEX < LIMIT SUB M MOV A,D INX H SBB M JM BR ; 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 B 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 ; 0B 'LI' DB 'T'+80H DW 0 ; (LFA)=0 MARKS END OF DICTIONARY LIT DW $+2 ;(S1) <- ((IP)) LDAX B ; (HL) <- ((IP)) = LITERAL INB 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 ; BYTE ; ADDRESS NAME CONTENTS ; ------- ---- -------- ; ( MSB=1 ; ( P=PRECEDENCE BIT ; ( S=SMUDGE BITAN1 ; THEN LOOP AGAIN INX H ; ELSE DONE SHLD RPP ; DISCARD R1 & R2 INX B ; SKIP BRANCH OFFSET INX B JMP NEXT ; DB 8REAK NOP ; PLACE BREAKPOINT HERE NOP NOP TNEXT1 LDAX B INX B MOV L,A JMP NEXT+3 ; ;-------------------------------RANCH 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 X B ; (IP) <- (IP) + 2 MOV L,A ; LB LDAX B ; HB INX B MOV H,A JMP HPUSH ; (S1) <- (HL) ; DB 87H ; EXECUTE DB 'EX THEN LOOP AGAIN INX H ; ELSE DONE SHLD RPP ; DROP R1 AND R2 INX B ; SKIP BRANCH OFFSET INX B JMP NEXT ; DB 84H ; ( ; NFA NAME FIELD 1PS < NAME LENGTH ; 0<1CHAR> MSB=0, NAME'S 1ST CHAR ; 0<2CHAR> ; ... ; 1 MSB7H ; (+LOOP) 1.3 DB '(+LOOP' DB ')'+80H DW XLOOP-9 XPLOO DW $+2 POP D ; (DE) <- INCR LHLD RPP ; ((HL)) = INDEX MOV ------------------- ; ; NEXT, THE FORTH ADDRESS INTERPRETER ; ( POST INCREMENTING VERSION ) ; DPUSH PUSH D HPUSH PUSH H ; ELSE SKIP BRANCH OFFSET INX B JMP NEXT ; DB 86H ; (LOOP) 1.3 DB '(LOOP' DB ')'+80H DW ZBRAN-0AH XLOOP DW $+2 L 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 FIN2 INX H ; (HL) <- ADDR NEXT CHR IN STRING INX D ; (DE) <- ADDR NEXT CHR IN NF LDAX D XRA M ; IGNORE MSB JZ PFIN2 ; MAD DIGIT MVI L,1 ; (L) <- TRUE JC DPUSH ; THEN SUCCESSFUL ; (S2) <- CONVERTED DIGIT ; (S1) <- TRUE ; ; ELSE INVAS ENCL1 INX H INX D CMP M ; IF TEXT CHR = DELIM CHR JZ ENCL1 ; THEN LOOP AGAIN ; ; ELSE NON-DELIM CHR FOUND PUSH D ; INX H INX H INX H INX H ; ((HL)) = (R3) JMP IDO1 ; DB 85H ; DIGIT 1.3 DB 'DIGI' DB 'T'+80H DW IDO-4 DIGIT DW(LFA) INX H MOV D,M MOV A,D ORA E ; IF (LFA) <> 0 JNZ PFIN1 ; THEN TRY PREVIOUS DICT. DEF. ; ; ELSE END OF DICTIONA 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 MTCH SO FAR, LOOP AGAIN ADD A JNZ PFIN3 ; NO MATCH LXI H,5 ; STRING MATCHES DAD D ; ((SP)) <- PFA XTHL ; ; BACK UP TLID DIGIT CHR DIGI2 MOV L,H ; (HL) <- FALSE JMP HPUSH ; (S1) <- FALSE ; DB 86H ; (FIND) 1.3 DB '(FIND' ; DB ')'+80H  (S3) <- (DE) = OFFSET TO 1ST NON-DELIM MOV D,A ; SAVE A MOV A,M ; IF 1ST NON-DELIM = NULL ANA A MOV A,D ; RESTORE A P $+2 POP H ; (L) <- (S1)LB = ASCII CHR TO BE ; CONVERTED MVI H,0 POP D ; (DE) <- (S2) = BASE VALUE MOV A,E ; (BASE) RY POP H ; DISCARD STRING ADDR PUSH D ; (S1) <- FALSE JMP NEXT ; DB 87H ; ENCLOSE 1.3 DB 'ENCLOS' DB 'E'+80H DW P,D JMP NEXT ; DB 81H ; I 1.3 DB 'I'+80H DW XDO-7 IDO DW $+2 ;(S1) <- (R1) , (R1) UNCHANGED LHLD RPP IDO1 MOV E,M ; O 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 DW DIGIT-8 PFIND DW $+2 POP D ; (DE) <- NFA PFIN1 POP H ; (HL) <- STRING ADDR PUSH H ; SAVE STRING ADDR FOR NEXT ITERATIONOP D PUSH D JNZ ENCL2 INX D ; THEN (S2) <- OFFSET TO BYTE PUSH D ; FOLLOWING NULL DCX D ; (S1) <- OFFSET TO NULL P< 255 ASSUMED SUI 30H ; IF CHR > "0" CPI 0AH ; AND IF CHR > "9" JC DIGI1 ; THEN GO TEST BASE SUI 7 CPI 0AH ; OR IF CHRFIND-9 ENCL DW $+2 POP D ; (DE) <- (S1) = DELIMITER CHAR POP H ; (HL) <- (S2) = ADDR TEXT TO SCAN PUSH H ; (S4) <- ADDR (DE) <- (R1) INX H MOV D,M PUSH D ; (S1) <- (DE) JMP NEXT ; DB 82H ; I' 1.3 DB 'I' DB 27H+80H DW IDO-4 IPRIM D 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 LDAX D XRA M ; CHECK LENGTHS & SMUDGE BIT ANI 3FH JNZ PFIN4 ; LENGTHS DIFFERENT ; ; LENGTHS MATCH, CHECK EACH CHR PUSH D JMP NEXT ; ; ELSE TEXT CONTAINS NON-DELIM & ; NON-NULL CHR ENCL2 PUSH B ; SAVE IP MOV B,A ; (B) <- DELIM CHR  >= "A" JC DIGI2 ; ; THEN VALID NUMERIC OR ALPHA CHR DIGI1 CMP L ; IF DIGIT VALUE < BASE VALUE MOV E,A ; (E) <- CONVERTE MOV A,E ; (E) <- DELIM CHR LXI D,-1 ; INIT CHR OFFSET COUNTER DCX H ; (HL) <- ADDR-1 ; ; SKIP OVER LEADING DELIMITER CHRW $+2 LHLD RPP INX H INX H ; ((HL)) = (R2) JMP IDO1 ; DB 81H ; J 1.3 DB 'J'+80H DW IPRIM-5 J DW $+2 LHLD RPP  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) <-   ENCL5 INX H ; (HL) <- ADDR NEXT CHR INX D ; (DE) <- OFFSET TO NEXT CHR MOV A,M ; IF NEXT CHR <> DELIM CHR CMP B JZ ENCL H XCHG ; (DE) <- END DEST ADDR JMP GCMOV2 ; RETURN IF #CHRS = 0 GCMOV1 MOV A,M ; ((DE)) <- ((HL)) DCX H ; DECR SOURCE AOV 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 24 8 16 MPYX LXI H,0 ; (HL) <- 0 = PARTIAL PRODUCT.LW MVI C,4 ; LOOP COUNTER MPYX1 DAD H ; LEFT SHIFT (AHL) 24 BITS RAL 83H ; KEY DB 'KE' DB 'Y'+80H DW EMIT-7 KEY DW $+2 JMP PKEY ; DB 89H ; ?TERMINAL DB '?TERMINA' DB 'L'+80H DW KE,A MOV A,B MOV B,H ; SAVE (A)1 CALL MPYX ; (AHL)2 <- MPCAND.HB * MPLIER ; 2ND PARTIAL PRODUCT POP D ; (DE) <- 4 ANA A ; AND IF NEXT CHR <> NULL JNZ ENCL5 ; THEN CONTINUE SCAN ; ; ELSE CHR = NULL ENCL3 POP B ; RESTORE IP PUSH D ;DDR STAX D DCX D ; DECR DEST ADDR DCX B ; DECR #CHRS GCMOV2 MOV A,B ; IF #CHRS LEFT <> 0 ORA C JNZ GCMOV1 ; THEN LOOP JNZ CMOV1 ; REPEAT IF #CHRS <> 0 POP B ; RESTORE (IP) FROM (S1) JMP NEXT ; DB 86H ; >CMOVE 1.3 DB '>CMOV' DB 'E'+80 JNC MPYX2 ; IF NEXT MPLIER BIT = 1 DAD D ; THEN ADD MPCAND ACI 0 MPYX2 DAD H RAL JNC MPYX3 DAD D ACI 0 MPYX3 DCRY-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 ;(HL)1 MOV C,D ; (BC) <- (AH)1 ; FORM SUM OF PARTIALS: ; (AHL) 1 ; + (AHL) 2 ; -------- ; (AHLE) DAD B ; ( (S2) <- OFFSET TO NULL PUSH D ; (S1) <- OFFSET TO NULL JMP NEXT ; ; ELSE CHR = DELIM CHR ENCL4 POP B ; RESTORE IP PUS AGAIN POP B ; RESTORE IP JMP NEXT ; DB 82H ; U* 1.3 ; 16X16 UNSIGNED MULTIPLY DB 'U' ; AVG EXECUTION TIME = 880 CH DW CMOVE-8 GCMOV DW $+2 MOV L,C ; (HL) <- (IP) MOV H,B POP B ; (BC) <- (S1) = #CHRS POP D ; (DE) <- (S2) = DEST AD C ; IF NOT LAST MPLIER BIT JNZ MPYX1 ; THEN LOOP AGAIN RET ; ELSE DONE ; DB 82H ; U/ 1.3 DB 'U' DB '/'+80H DW US 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 HL) <- (HL)2 + (AH)1 ACI 0 ; (AHLE) <- (BA) * (DE) MOV D,L MOV L,H MOV H,A ; (HLDE) <- MPLIER * MPCAND POP B ; RESTOREH D ; (S2) <- OFFSET TO BYTE ; FOLLOWING TEXT INX D ; (S1) <- OFFSET TO 2 BYTES AFTER ; END OF WORD PUSH D JMPYCLES DB '*'+80H DW GCMOV-9 USTAR DW $+2 POP D ; (DE) <- MPLIER POP H ; (HL) <- MPCAND PUSH B ; SAVE IP MOV B,H MDR XTHL ; (HL) <- (S3) = SOURCE ADDR ; (S1) <- (IP) TEMP. DAD B ; (HL) <- END SOURCE ADDR DCX H XCHG DAD B DCXTAR-5 USLAS DW $+2 MOV H,B MOV L,C ; (HL) <- (IP) POP B ; (BC) <- (S1) = DENOMINATOR POP D ; (DE) <- (S2) = NUMERATOR.HD ; (DE) <- (S2) = DEST ADDR XTHL ; (HL) <- (S3) = SOURCE ADDR ; ; (S1) <- (IP) JMP CMOV2 ; RETURN IF #CHRS = 0 CMOV1 M IP PUSH D ; (S2) <- PRODUCT.LW JMP HPUSH ; (S1) <- PRODUCT.HW ; ; MULTIPLY PRIMITIVE ; (AHL) <- (A) * (DE) ; #BITS =  NEXT ; DB 84H ; EMIT DB 'EMI' DB 'T'+80H DW ENCL-0AH EMIT DW DOCOL DW PEMIT DW ONE,OUTT DW PSTOR,SEMIS ; DB OV A,L ; (BA) <- MPCAND CALL MPYX ; (AHL)1 <- MPCAND.LB * MPLIER ; 1ST PARTIAL PRODUCT PUSH H ; SAVE (HL)1 MOV H IGH XTHL ; (S1) <- (IP) XCHG ; (HLDE) = NUMERATOR, 32 BITS MOV A,L SUB C MOV A,H ; IF OVERFLOW SBB B JNC USBAD ; 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 ;(S1E AS U/ DB 'D'+80H DW USLAS-5 USLMD DW USLAS+2 ; DB 83H ; AND DB 'AN' DB 'D'+80H DW USLMD-8 ANDD DW $+2 ; (S1) <-B 'E'+80H DW EXIT-7 LEAVE DW $+2 ;LIMIT <- INDEX LHLD RPP MOV E,M ; (DE) <- (R1) = INDEX INX H MOV D,M INX H MOV Y MOV A,H ; THEN ADD (BC) INTO (AH) ADD C MOV H,A MOV A,E DCR D RZ ; RETURN FROM USLA ; USLA DAD H ; 24BIT LEFT-S RPAT-6 RPSTO DW $+2 ;(RP) <- (R0) ( USER VARIABLE ) LHLD UP ; (HL) <- USER VARIABLE BASE ADDR LXI D,8 DAD D ; (HL) <- R0 THEN RETURN BAD VALUE MOV A,H MOV H,L MOV L,D ; (AHL) <- 24 BITS OF NUMERATOR MVI D,8 ; (D) <- INIT COUNTER PUSH D ; ) <- (SP) LXI H,0 DAD SP ; (HL) <- (SP) JMP HPUSH ; (S1) <- (HL) ; DB 83H ; STACK POINTER STORE DB 'SP' DB '!'+80H  (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' DM,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) <-HIFT ( *2 ) RAL JNC USL0 ; SUBTRACT & TEST MOV E,A MOV A,H SUB C ; (AH) <- (AH) - (BC) MOV H,A MOV A,E SBB B US MOV E,M ; (DE) <- (R0) INX H MOV D,M XCHG SHLD RPP ; (RP) <- (R0) JMP NEXT ; DB 82H ; ;S DB ';' DB 'S'+80H SAVE D & E CALL USLA ; PARTIAL DIVISION POP D ; RESTORE COUNTER & NUM.MSBYTE PUSH H ; (S1) <- (L) = BYTE OF QUOTIENT MOV DW SPAT-6 SPSTO DW $+2 ;(SP) <- (S0) ( USER VARIABLE ) LHLD UP ; (HL) <- USER VAR BASE ADDR LXI D,6 DAD D ; (HL) <- S0 B 'R'+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 (S1) POP D ; (DE) <- (S1) LHLD RPP DCX H ; (RP) <- (RP) - 2 DCX H SHLD RPP MOV M,E ; ((HL)) <- (DE) INX H MOV ML1 INR L ; 1 BIT OF QUOT INTO RIGHT SIDE DCR D ; OF (AHL) JNZ USLA ; CONTINUE DIVISION RET ; ALL 8 TRIAL COMPLETE ; U 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)  L,E CALL USLA MOV D,A MOV E,H ; (DE) <- REMAINDER POP B ; RESTORE QUOTIENT.HIGH MOV H,C ; (HL) <- QUOTIENT POP B ;  MOV E,M ; (DE) <- (S0) INX H MOV D,M XCHG SPHL ; (SP) <- (S0) JMP NEXT ; DB 83H ; RP@ DB 'RP' DB '@'+80H D 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 ,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) SBAD LXI H,-1 ; OVERFLOW, RETURN 32BIT -1 POP B ; RESTORE (IP) PUSH H JMP HPUSH ; DB 85H ; U/MOD 1.3 DB 'U/MO' ; SAM+ 2 JMP NEXT ; DB 84H ; EXIT 1.3 DB 'EXI' DB 'T'+80H DW SEMIS-5 EXIT DW SEMIS+2 ; DB 85H ; LEAVE DB 'LEAV' DRESTORE (IP) JMP DPUSH ; SUCCESSFULLY DONE ; USL0 MOV E,A MOV A,H SUB C MOV H,A MOV A,E SBB B JNC USL1 ; IF CARRW SPSTO-6 RPAT DW $+2 ;(S1) <- (RP) LHLD RPP JMP HPUSH ; DB 83H ; RETURN STACK POINTER STORE DB 'RP' DB '!'+80H DW  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 FRODMINU 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 M.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 <- (HL) DCX SP DCX SP XCHG ; (DE) <- (HL) ; ; (HL) <- (DE) JMP DPUSH ; (S1) <- (HL) ; ; (S2) <- (DE) ; DB 85HPUSH ; THEN (S1) <- FALSE INR L JMP HPUSH ; ELSE (S1) <- TRUE ; DB 81H ; + DB '+'+80H DW ZLESS-5 PLUS DW $+2 ;(S1) <84H ; 2DUP DB '2DU' DB 'P'+80H DW DUP-6 TDUP DW $+2 POP H POP D PUSH D PUSH H JMP DPUSH ; DB 85H ; 2DROP 1.MR-5 RR DW IDO+2 ; DB 82H ; R@ 1.3 DB 'R' DB '@'+80H DW RR-4 RAT DW IDO+2 ; DB 82H ; 0= DB '0' DB '='+80H D 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 ; D IP PUSH D ; (S2) <- SUM.LW JMP HPUSH ; (S1) <- SUM.HW ; DB 85H ; MINUS DB 'MINU' DB 'S'+80H DW DPLUS-5 MINUS DW $ ; 2OVER DB '2OVE' DB 'R'+80H DW TSWAP-8 TOVER DW $+2 ; NOTE: THIS WON'T WORK WITH INTERRUPTS INX SP INX SP INX S- (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 3 DB '2DRO' DB 'P'+80H DW TDUP-7 TDROP DW $+2 POP H POP H JMP NEXT ; DB 85H ; 2SWAP 1.3 DB '2SWA' DB 'P'+80W RAT-5 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 ;B 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+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 86HP INX SP POP H ; (HL) <- (S3) PUSH H INX SP INX SP POP D ; (DE) <- (S4) PUSH D DCX SP DCX SP DCX SP DCX SP; 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 ; SH DW TDROP-8 TSWAP DW $+2 ; NOTE: THIS WON'T WORK WITH INTERRUPTS POP H ; (HL) <- (S1) POP D ; (DE) <- (S2) XTHL ;  ELSE (HL) <- TRUE ZEQU1 JMP HPUSH ; (S1) <- (HL) ; DB 83H ; NOT 1.3 DB 'NO' DB 'T'+80H DW ZEQU-5 NOTT DW ZEQU+2 ; ' 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  ; NEGATE 1.3 DB 'NEGAT' DB 'E'+80H DW MINUS-8 NEG DW MINUS+2 ; DB 86H ; DMINUS DB 'DMINU' DB 'S'+80H DW NEG-9  DCX SP DCX SP JMP DPUSH ; (S1) <- (HL) ; ; (S2) <- (DE) ; DB 82H ; PLUS STORE DB '+' DB '!'+80H DW TOVER-8 PAVE 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 = SU(HL) <- (S3) ; ; (S3) <- (HL) XCHG ; (DE) <- (HL) ; ; (HL) <- (DE) INX SP INX SP XTHL ; (HL) <- (S4) ; ; (S4) DB 82H ; 0< DB '0' DB '<'+80H DW NOTT-6 ZLESS DW $+2 POP PSW ; (A) <- (S1.HIGH) ORA A ; IF (A) < 0 LXI H,0 JP H 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  STOR DW $+2 ;((S1)) <- ((S1)) + (S2) POP H ; (HL) <- (S1) = ADDR POP D ; (DE) <- (S2) = INCR MOV A,M ; ((HL)) <- ((HL)) + OV M,D JMP NEXT ; DB 0C1H ; : DB ':'+80H DW TSTOR-5 COLON DW DOCOL DW QEXEC DW SCSP DW CURR DW AT DW CONT ; (DE) <- (S2) = VALUE MOV M,E ; ((HL)) <- (DE) INX H MOV M,D JMP NEXT ; DB 82H ; C STORE DB 'C' DB '!'+80H DW T MVI D,0 LHLD UP ; (HL) <- USER VARIABLE BASE ADDR DAD D ; (HL) <- (HL) + (DE) JMP HPUSH ; (S1) <- BASE + OFFSET ; DAT 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' +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) <-(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-DW STORE DW CREAT DW RBRAC DW PSCOD ; EXECUTION-TIME CODE: DOCOL LHLD RPP ; 1.3 DCX H ; (RP) <- (RP) - 2 DCX H STORE-4 CSTOR DW $+2 ;((S1))LB <- (S2)LB POP H ; (HL) <- (S1) = ADDR POP D ; (DE) <- (S2) = BYTE MOV M,E ; ((HL))LB <- (EB 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 8 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 (PFA) INX H MOV D,M PUSH D ; (S1) <- (PFA) JMP NEXT ; DB 88H ; VARIABLE DB 'VARIABL' DB 'E'+80H DW CON-0BH VA5 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 ; (ADSHLD RPP MOV M,C INX H MOV M,B ; (R1) <- (IP) INX D ; (DE) <- CFA+2 = (W) MOV C,E ; (IP) <- (DE) = (W) MOV B,D JMP) JMP NEXT ; DB 82H ; 2 STORE DB '2' DB '!'+80H DW CSTOR-5 TSTOR DW $+2 POP H ; (HL) <- ADDR POP D ; (DE) <- HW 1H ; 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 ; 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) <R DW DOCOL DW CON DW PSCOD DOVAR INX D ; (DE) <- PFA PUSH D ; (S1) <- PFA JMP NEXT ; DB 84H ; USER DB 'USE' DB 'DR) <- (ADDR) XOR (E) JMP NEXT ; DB 81H ; @ DB '@'+80H DW TOGGL-9 AT DW $+2 ;(S1) <- ((S1)) POP H ; (HL) <- ADDR M NEXT ; DB 0C1H ; ; DB ';'+80H DW COLON-4 SEMI DW DOCOL DW QCSP DW COMP DW SEMIS DW SMUDG DW LBRAC DW SEMIS  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 M 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 B- HW JMP NEXT ; DB 81H ; STORE DB '!'+80H DW TAT-5 STORE DW $+2 ;((S1)) <- (S2) POP H ; (HL) <- (S1) = ADDR POP D R'+80H DW VAR-0BH USER DW DOCOL DW CON DW PSCOD DOUSE INX D ; (DE) <- PFA XCHG MOV E,M ; (DE) <- USER VARIABLE OFFSEOV 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 C ; DB 84H ; NOOP DB 'NOO' DB 'P'+80H DW SEMI-4 NOOP DW DOCOL DW SEMIS ; DB 88H ; CONSTANT DB 'CONSTAN' DB 'T'  L-5 CSLL DW DOCON DW 64 ; DB 85H ; FIRST DB 'FIRS' DB 'T'+80H DW CSLL-6 FIRST DW DOCON DW BUF1 ; DB 85H ; LIMI 20H ; DB 87H ; CURRENT DB 'CURREN' DB 'T'+80H DW CONT-0AH CURR DW DOUSE DB 22H ; DB 85H ; STATE DB 'STAT' DBDB 'K'+80H DW DP-5 VOCL DW DOUSE DB 14H ; DB 83H ; BLK DB 'BL' DB 'K'+80H DW VOCL-0BH BLK DW DOUSE DB 16H ; L RAL MOV L,A MOV A,H RAL MOV H,A JMP HPUSH ; DB 82H ; 2/ 1.3 DB '2' DB '/'+80H DW TWOT-5 TWOD DW $+2 DB 82H ; R0 DB 'R' DB '0'+80H DW SZERO-5 RZERO DW DOUSE DB 8 ; DB 83H ; TIB DB 'TI' DB 'B'+80H DW RZERO-5 TIBEND OF USER VARIABLES ; DB 82H ; 1+ DB '1' DB '+'+80H DW HLD-6 ONEP DW $+2 POP H INX H JMP HPUSH ; DB 82H ; 2T 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  '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 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 DWPOP H MOV A,H RLC RRC RAR MOV H,A MOV A,L RAR MOV L,A JMP HPUSH ; DB 84H ; HERE DB 'HER' DB 'E'+80H D DW DOUSE DB 0AH ; DB 85H ; WIDTH DB 'WIDT' DB 'H'+80H DW TIB-6 WIDTH DW DOUSE DB 0CH ; DB 87H ; WARNING DB '+ DB '2' DB '+'+80H DW ONEP-5 TWOP DW $+2 POP H INX H INX H JMP HPUSH ; DB 82H ; 1- 1.3 DB '1' DB '-'+80HDW 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  ; 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  DOUSE DB 1AH ; DB 83H ; SCR DB 'SC' DB 'R'+80H DW OUTT-6 SCR DW DOUSE DB 1CH ; DB 86H ; OFFSET DB 'OFFSE' W TWOD-5 HERE DW DOCOL DW DP DW AT DW SEMIS ; DB 85H ; ALLOT DB 'ALLO' DB 'T'+80H DW HERE-7 ALLOT DW DOCOL DWWARNIN' DB 'G'+80H DW WIDTH-8 WARN DW DOUSE DB 0EH ; DB 85H ; FENCE DB 'FENC' DB 'E'+80H DW WARN-0AH FENCE DW D DW TWOP-5 ONEM DW $+2 POP H DCX H JMP HPUSH ; DB 82H ; 2- 1.3 DB '2' DB '-'+80H DW ONEM-5 TWOM DW $+2 POP DW 1024/KBBUF ; 1024 BYTES/SCREEN ; DB 87H ; +ORIGIN DB '+ORIGI' DB 'N'+80H DW BSCR-8 PORIG DW DOCOL DW LIT DW O 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' DDB '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 DP DW PSTOR DW SEMIS ; DB 81H ; , DB ','+80H DW ALLOT-8 COMMA DW DOCOL DW HERE DW STORE DW TWO DW ALLOT 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'  H DCX H DCX H JMP HPUSH ; DB 82H ; 2* 1.3 DB '2' DB '*'+80H DW TWOM-5 TWOT DW $+2 POP H STC CMC MOV A,RIG DW PLUS DW SEMIS ; ; USER VARIABLES ; DB 82H ; S0 DB 'S' DB '0'+80H DW PORIG-0AH SZERO DW DOUSE DB 6 ; B '#'+80H DW CSPP-6 RNUM DW DOUSE DB 2EH ; DB 83H ; HLD DB 'HL' DB 'D'+80H DW RNUM-5 HLD DW DOUSE DB 30H ; ;  W SEMIS ; DB 82H ; C, DB 'C' DB ','+80H DW COMMA-4 CCOMM DW DOCOL DW HERE DW CSTOR DW ONE DW ALLOT DW SEMIS  DW ROT,ROT DW SEMIS ; DB 85H ; SPACE DB 'SPAC' DB 'E'+80H DW DROT-7 SPACE DW DOCOL DW BL DW EMIT DW SEMIS ; OCOL,TDUP DW XORR,ZLESS DW ZBRAN,ULES1-$ ; IF DW DROP,ZLESS DW ZEQU DW BRAN,ULES2-$ ULES1 DW SUBB,ZLESS ; ELSE ULES2 ; 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 '=NO' DB 'T'+80H DW NEQU-5 ENOT DW DOCOL DW NEQU DW SEMIS ; DB 81H ; < DB '<'+80H ; X < Y DW ENOT-7 ; S2 S 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 D ; ; 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, DB 84H ; -DUP DB '-DU' DB 'P'+80H DW SPACE-8 DDUP DW DOCOL DW DUP DW ZBRAN ; IF DW DDUP1-$ DW DUP ; ENDIF DDUP DW SEMIS ; ENDIF ; DB 81H ; > DB '>'+80H DW ULESS-5 GREAT DW DOCOL DW SWAP DW LESS DW SEMIS ; DB 82H ; 0> 1.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 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 W 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 ; DBA RET ; DB 81H ; - DB '-'+80H DW CCOMM-5 SUBB DW $+2 POP D ; (DE) <- (S1) = Y POP H ; (HL) <- (S2) = X CALL SSUB1 DW SEMIS ; DB 84H ; ?DUP 1.3 DB '?DU' DB 'P'+80H DW DDUP-7 QDUP DW DDUP+2 ; DB 88H ; TRAVERSE DB 'TRAVERS' D3 DB '0' DB '>'+80H DW GREAT-4 ZGREA DW DOCOL DW ZERO,GREAT DW SEMIS ; DB 83H ; ROT DB 'RO' DB 'T'+80H DW ZG-$ QERR1 DW DROP ; ENDIF QERR2 DW SEMIS ; DB 85H ; ?COMP DB '?COM' DB 'P'+80H DW QERR-9 QCOMP DW DOCOL DW STATE  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 LE 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 ;  JMP HPUSH ; (S1) <- X - Y ; DB 81H ; = DB '='+80H DW SUBB-4 EQUAL DW DOCOL DW SUBB DW ZEQU DW SEMIS ; DB 82HB 'E'+80H DW QDUP-7 TRAV DW DOCOL DW SWAP TRAV1 DW OVER ; BEGIN DW PLUS DW LIT DW 7FH DW OVER DW CAT DW LESS REA-5 ROT DW $+2 POP D POP H XTHL JMP DPUSH ; DB 84H ; -ROT 1.3 DB '-RO' DB 'T'+80H DW ROT-6 DROT DW DOCOL 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 DOCOLS2 LXI H,1 ; ELSE X < Y JMP HPUSH ; (S1) <- TRUE ; DB 82H ; U< ( UNSIGNED < ) DB 'U' DB '<'+80H DW LESS-4 ULESS DW DDB 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 ; <> 1.3 DB '<' DB '>'+80H DW EQUAL-4 NEQU DW DOCOL DW SUBB DW ZEQU DW ZEQU DW SEMIS ; DB 84H ; =NOT 1.3  DW ZBRAN ; UNTIL DW TRAV1-$ DW SWAP DW DROP DW SEMIS ; DB 86H ; LATEST DB 'LATES' DB 'T'+80H DW TRAV-0BH LATE   DW STATE DW AT DW LIT DW 12H DW QERR DW SEMIS ; DB 86H ; ?PAIRS DB '?PAIR' DB 'S'+80H DW QEXEC-8 QPAIR DWS'+80H DW SEMIC-8 BUILD DW DOCOL DW ZERO DW CON DW SEMIS ; DB 85H ; DOES> DB 'DOES' DB '>'+80H DW BUILD-0AH DDOCOL DW LIT DW 0AH DW BASE DW STORE DW SEMIS ; DB 86H ; BINARY 1.3 DB 'BINAR' DB 'Y'+80H DW DEC-10 BIN DW D DTRA3-$ DTRA2 DW ONE DW SUBB ; ENDIF DTRA3 DW XLOOP ; LOOP DW DTRA1-$ DW SEMIS ; DB 84H ; (.") DB '(."' DB ')'+8 DB 0C1H ; [ DB '['+80H DW COMP-0AH LBRAC DW DOCOL DW ZERO DW STATE DW STORE DW SEMIS ; DB 81H ; ] DB ']'+80H  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 TYPE 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 OES DW DOCOL DW FROMR DW LATES DW PFA DW STORE DW PSCOD DODOE LHLD RPP ; (HL) <- (RP) DCX H MOV M,B ; (R1) <- (IPOCOL DW LIT,2 DW BASE,STORE DW SEMIS ; DB 87H ; (;CODE) DB '(;CODE' DB ')'+80H DW BIN-9 PSCOD DW DOCOL DW FROM0H DW DTRAI-0CH PDOTQ DW DOCOL DW RR DW COUNT DW DUP DW ONEP DW FROMR DW PLUS DW TOR DW TYPE DW SEMIS ;  DW LBRAC-4 RBRAC DW DOCOL DW LIT,0C0H DW STATE,STORE DW SEMIS ; DB 86H ; SMUDGE DB 'SMUDG' DB 'E'+80H DW RBRAC2 DW IDO DW CAT DW EMIT DW XLOOP ; LOOP DW TYPE2-$ DW BRAN ; ELSE DW TYPE3-$ TYPE1 DW DROP ; ENDIF TYPE3 DW SEMIS  DW SPAT DW CSPP DW AT DW SUBB DW LIT DW 14H DW QERR DW SEMIS ; DB 88H ; ?LOADING DB '?LOADIN' DB 'G'+80H ) = PFA = (SUBSTITUTE CFA) DCX H MOV M,C SHLD RPP ; (RP) <- (RP) - 2 INX D ; (DE) <- PFA = (SUBSTITUTE CFA) XCHG MOVR DW LATES DW PFA DW CFA DW STORE DW SEMIS ; DB 0C5H ; ;CODE DB ';COD' DB 'E'+80H DW PSCOD-0AH SEMIC DW DOCODB 0C2H ; ." DB '.' DB '"'+80H DW PDOTQ-7 DOTQ DW DOCOL DW LIT DW 22H DW STATE DW AT DW ZBRAN ; IF DW DOTQ1-$-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 ; 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 QCSP-7 QLOAD DW DOCOL DW BLK DW AT DW ZEQU DW LIT DW 16H DW QERR DW SEMIS ; DB 87H ; COMPILE DB 'COMPIL' C,M ; (IP) <- (SUBSTITUTE CFA) INX H MOV B,M INX H JMP HPUSH ; (S1) <- PFA+2 = SUBSTITUTE PFA ; DB 85H ; COUNT DB L DW QCSP DW COMP DW PSCOD DW LBRAC SEMI1 DW NOOP ; ( ASSEMBLER ) DW SEMIS ; DB 87H ; D DB 'S->' DB 'D'+80H DW COLD-7 STOD DW $+2 POP D LXI H,0 MOV A,D ANI 8 DB 84H ; COLD 1.3 DB 'COL' DB 'D'+80H DW WARM-7 COLD DW DOCOL DW MTBUF DW ZERO,DENSTY DW STORE DW FIRST DW SLAS 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 QUIT2-$ DW PDOTQ DB 2 DB 'OK' ; ENDIF QUIT2 DW BRAN ; AGAIN DW QUIT1-$ ; DB 85H ; ABORT DB 'ABOR' DB 'T'+80H D83H ; MIN DB 'MI' DB 'N'+80H DW DABS-7 MIN DW DOCOL,TDUP DW GREAT DW ZBRAN ; IF DW MIN1-$ DW SWAP ; ENDIF MIN1 D TO THE FORTH VOCABULARY DW 0 ; END OF VOCABULARY LIST ; DB 8BH ; DEFINITIONS DB 'DEFINITION' DB 'S'+80H DW FORTH-0H JZ STOD1 DCX H STOD1 JMP DPUSH ; DB 82H ; +- DB '+' DB '-'+80H DW STOD-7 PM DW DOCOL DW ZLESS DW ZBRAN ; IUSE,STORE DW FIRST DW PREV,STORE DW DRZER DW LIT,0 DW LIT,EPRINT DW STORE ; ; INIT SOME USER VARIABLES DW LIT  DW FROMR DW PM DW SWAP DW SEMIS ; DB 81H ; * DB '*'+80H DW MSLAS-5 STAR DW DOCOL DW MSTAR DW DROP DW SEMIS W QUIT-7 ABORT DW DOCOL DW SPSTO DW DEC DW QSTAC DW CR DW DOTCPU DW PDOTQ DB 0DH DB 'fig-FORTH ' DB FIGREL+30W 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-$ 8 DEFIN DW DOCOL DW CONT DW AT DW CURR DW STORE DW SEMIS ; DB 0C1H ; ( DB '('+80H DW DEFIN-0EH PAREN DW DOCOLF DW PM1-$ DW MINUS ; ENDIF PM1 DW SEMIS ; DB 83H ; D+- DB 'D+' DB '-'+80H DW PM-5 DPM DW DOCOL DW ZLESS DW Z  ; DB 84H ; /MOD DB '/MO' DB 'D'+80H DW STAR-4 SLMOD DW DOCOL DW TOR DW STOD DW FROMR DW MSLAS DW SEMIS ; AH 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 HPU 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 ---------------------------------- BPS EQU 128 ; BYTES PER SECTOR MXDRV EQU 2 ; MAX # DRIVES ; ; SINGLE DENSITY 8" FLOPPY  DW ZERO DW RR DW USLAS DW FROMR DW SWAP DW TOR DW USLAS DW FROMR DW SEMIS ; ; BLOCK MOVED DOWN 2 PAGES ; SECTORS/BUF I BUFFER ; TRACK I I I I I ; ===+ ----I-------I-------V---- +==== SCREEN ; I I I I ; ========+DB 81H ; / DB '/'+80H DW SLMOD-7 SLASH DW DOCOL DW SLMOD DW SWAP DW DROP DW SEMIS ; DB 83H ; MOD DB 'MO' DB SH ; 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 DW OFSET DW AT DW BSCR DW SLASH DW SUBB DW DLINE DW SPACE ; ENDIF MESS2 DW BRAN ; ELSE DW MESS3-$ MESS1 DW PDOTQCAPACITIES SEPTR1 EQU 26 ; SECTORS/TRACK TRPDR1 EQU 77 ; TRACKS/DRIVE SEPDR1 EQU SEPTR1*TRPDR1 ; SECTORS/DRIVE SEPBU1 EQU ; DB 86H ; (LINE) DB '(LINE' DB ')'+80H DW MSMOD-8 PLINE DW DOCOL DW TOR DW LIT DW 40H DW BBUF DW SSMOD DW  I SECTORS/SCREEN I ; I I I I ; ===+ ----I-------V------------ +============ ; D I I I ; R ===+ SCREE'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 SS;H <- CDATA MOV A,L OUT 0 ;( PORT# MODIFIED ) JMP NEXT PAGE ;------------------------------------------------------ ;  DB 6 DB 'MSG # ' DW DOT ; ENDIF MESS3 DW SEMIS PAGE ;------------------------------------------ ; ; 8080 PORT FETCHKBBUF/BPS ; SECTORS/BUFFER BUPSC1 EQU 1024/KBBUF ; BUFFERS/SCREEN SEPSC1 EQU SEPBU1*BUPSC1 ; SECTORS/SCREEN SCPDR1 EQU SEPDR1FROMR DW BSCR DW STAR DW PLUS DW BLOCK DW PLUS DW LIT DW 40H DW SEMIS ; DB 85H ; .LINE DB '.LIN' DB 'E'+8NS I ; I I ------- I ; V ========+ DRIVE +==== ; E I I I ; ===+ I I ; I I I ; ===+ --MOD DW DOCOL DW TOR DW MSTAR DW FROMR DW MSLAS DW SEMIS ; DB 82H ; */ DB '*' DB '/'+80H DW SSMOD-8 SSLA DW DFORTH DISK INTERFACE ; ; MAPPING DISK SECTORS ONTO FORTH BUFFERS & SCREENS ; ( THE FOLLOWING DIAGRAM IS ONLY AN EXAMPLE )  AND STORE ; ( SELF MODIFYING CODE, NOT REENTRANT ; OR ROM-ABLE ) ; DB 82H ; P@ "PORT @" DB 'P' DB '@'+80H DW MESS-0/SEPSC1 ; SCREENS/DRIVE BUPDR1 EQU BUPSC1*SCPDR1 ; BUFFERS/DRIVE USPDR1 EQU SCPDR1*SEPSC1 ; USABLE SEC/DRV ; ; DOUBLE DENSIT0H DW PLINE-9 DLINE DW DOCOL DW PLINE DW DTRAI DW TYPE DW SEMIS ; DB 87H ; MESSAGE DB 'MESSAG' DB 'E'+80H DW--V-------------------- +============ ; ////////// I <----- NOT USED BY FORTH ; =============+ ; ;------------------OCOL 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 ; ; DISK MEMORY ; ; =============+ ----^-------^-------^---- +============ ; SECTOR I I I I I ; ===+ I I  Y 8" FLOPPY CAPACITIES SEPTR2 EQU 52 ; SECTORS/TRACK TRPDR2 EQU 77 ; TRACKS/DRIVE SEPDR2 EQU SEPTR2*TRPDR2 ; SECTORS/DRIVE PDR1 NSCR2 DW SEMIS ; DB 87H ; DENSITY ( 0 = SINGLE , 1 = DOUBLE ) DB 'DENSIT' DB 'Y'+80H DW NSCRD-11 DENSTY DW DOVAR ADDR OF BUFFER PREVIOUSLY ACCESSED BY CPU ) DB 'PRE' DB 'V'+80H DW USE-6 PREV DW DOVAR DW BUF1 ; DB 87H ; SEC/BLK (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 D SETTRK EQU 27 SETDSK EQU 24 ; ; ; FORTH VARIABLES AND CONSTANTS USED IN DISK INTERFACE ; DB 85H ; DRIVE ( CURRENT DRIVEE,SEMIS ; DB 8DH ; EMPTY-BUFFERS DB 'EMPTY-BUFFER' DB 'S'+80H DW UPDAT-9 MTBUF DW DOCOL,FIRST DW LIMIT,OVER DW SUB SEPBU2 EQU KBBUF/BPS ; SECTORS/BUFFER BUPSC2 EQU 1024/KBBUF ; BUFFERS/SCREEN SEPSC2 EQU SEPBU2*BUPSC2 ; SECTORS/SCREEN SCPDR DW 0 ; DB 8AH ; DISK-ERROR ( DISK ERROR STATUS ) DB 'DISK-ERRO' DB 'R'+80H DW DENSTY-10 DSKERR DW DOVAR,0 ; ; DI # SECTORS/BLOCK ) DB 'SEC/BL' DB 'K'+80H DW PREV-7 SPBLK DW DOCON DW KBBUF/BPS ; DB 85H ; #BUFF ( NUMBER OF BUFFERW 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  # ) DB 'DRIV' DB 'E'+80H DW PTSTO-5 DRIVE DW DOVAR,0 ; DB 83H ; SEC ( SECTOR # ) DB 'SE' DB 'C'+80H DW DRIVE-8 B,ERASEE DW SEMIS ; DB 83H ; DR0 DB 'DR' DB '0'+80H DW MTBUF-16 DRZER DW DOCOL,ZERO DW OFSET,STORE DW SEMIS ; 2 EQU SEPDR2/SEPSC2 ; SCREENS/DRIVE BUPDR2 EQU BUPSC2*SCPDR2 ; BUFFERS/DRIVE USPDR2 EQU SCPDR2*SEPSC2 ; USABLE SEC/DRV PAGE SK INTERFACE HIGH-LEVEL ROUTINES ; DB 84H ; +BUF ( ADVANCE BUFFER ) DB '+BU' DB 'F'+80H DW DSKERR-13 PBUF DW DOCOL DS ) DB '#BUF' DB 'F'+80H DW SPBLK-10 NOBUF DW DOCON,NBUF ; DB 88H ; #SCR/DRV ( # SCREENS/DRIVE ) 1.3 DB '#SCR/DRSTORE,FROMR DW TWOP,SEMIS ; DB 85H ; BLOCK DB 'BLOC' DB 'K'+80H DW BUFFE-9 BLOCK DW DOCOL,OFSET DW AT,PLUS DW TO SEC: DW DOVAR DW 0 ; DB 85H ; TRACK ( TRACK # ) DB 'TRAC' DB 'K'+80H DW SEC-6 TRACK: DW DOVAR,0 ; DB 83H ; USE ( DB 83H ; DR1 DB 'DR' DB '1'+80H DW DRZER-6 DRONE DW DOCOL DW DENSTY,AT DW ZBRAN,DRON1-$ DW LIT,BUPDR2 DW BRAN,DR ;------------------------------------------------------- ; CP/M DISK INTERFACE ; ; CP/M BIOS CALLS USED ; ( NOTE EQU'S ARE W LIT,CO DW PLUS,DUP DW LIMIT,EQUAL DW ZBRAN,PBUF1-$ DW DROP,FIRST PBUF1: DW DUP,PREV DW AT,SUBB DW SEMIS ; DB 8' DB 'V'+80H DW NOBUF-8 NSCRD DW DOCOL DW DENSTY,AT DW ZBRAN,NSCR1-$ DW LIT,SCPDR2 DW BRAN,NSCR2-$ NSCR1 DW LIT,SCR,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 D ADDR OF NEXT BUFFER ; TO BE REPLACED ) DB 'US' DB 'E'+80H DW TRACK-8 USE: DW DOVAR DW BUF1 ; DB 84H ; PREV ; (ON2-$ DRON1 DW LIT,BUPDR1 DRON2 DW OFSET,STORE DW SEMIS ; DB 86H ; BUFFER DB 'BUFFE' DB 'R'+80H DW DRONE-6 BUFFE: 3 LOWER THAN DOCUMENTED OFFSETS ; BECAUSE BASE ADDR IS BIOS+3 ) ; RITSEC EQU 39 RDSEC EQU 36 SETDMA EQU 33 SETSEC EQU 306H ; 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 STOR W 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 DU DW SLMOD DW LIT,MXDRV-1 DW MIN DW DUP,DRIVE DW AT,EQUAL DW ZBRAN,TSCAL3-$ DW DROP DW BRAN,TSCAL4-$ TSCAL3 DW DRTACK INPUT: SECTOR-DISPLACEMENT = BLK# * SEC/BLK ; OUTPUT: VARIABLES DRIVE, TRACK, & SEC ; DB 87H ; T&SCALC DB 'T&SCAL'  ; ELSE RESET SECTOR # STA SEC+2 LDA TRACK+2 ; AND INCR TRACK # INR A STA TRACK+2 JMP NEXT ; DB 87H ; +SECTOR ( (BC) <- (SEC) = SECTOR # MOV C,L LXI D,SETSEC ; SEND SECTOR # TO CP/M CALL IOS ; LHLD TRACK+2 ; (BC) <- (TRACK) = TRAC'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 ; (P,PREV DW STORE BLOC1 DW FROMR,DROP DW TWOP,SEMIS ; ; ; CP/M INTERFACE ROUTINES ; ; SERVICE REQUEST ; IOS LHLD 1 ; IVE,STORE DW SETDRV TSCAL4 DW LIT,SEPTR1 DW SLMOD,TRACK DW STORE,ONEP DW SEC,STORE DW SEMIS ; ; SEC-READ ; ( READ DB 'C'+80H DW SETDRV-12 TSCALC: DW DOCOL,DENSTY DW AT DW ZBRAN,TSCALS-$ ; DOUBLE DENSITY DW LIT,USPDR2 DW SLMOD DW ADVANCE SECTOR ) 1.3 DB '+SECTO' DB 'R'+80H DW PTRAC-9 PSEC DW $+2 LDA SEC+2 ; INCR SECTOR # INR A STA SEC+2 PUSK # MOV B,H MOV C,L LXI D,SETTRK CALL IOS ; POP B ; RESTORE (IP) JMP NEXT ; DB 89H ; SET-DRIVE DB 'SET-DRIV' DSKERR) <- ERROR STATUS POP B ; RESTORE (IP) JMP NEXT ; DB 86H ; +TRACK ( ADVANCE TRACK ) 1.3 DB '+TRAC' DB 'K'+80H (HL) <- BIOS TABLE ADDR+3 DAD D ; + SERVICE REQUEST OFFSET PCHL ; EXECUTE REQUEST ; RET FUNCTION PROVIDED BY CP/M ; DB A SECTOR SETUP BY 'SET-DRIVE' & 'SETIO' ) ; DB 88H ; SEC-READ DB 'SEC-REA' DB 'D'+80H DW TSCALC-10 SECRD DW $+2 PUSH LIT,MXDRV-1 DW MIN DW DUP,DRIVE DW AT,EQUAL DW ZBRAN,TSCAL1-$ DW DROP DW BRAN,TSCAL2-$ TSCAL1 DW DRIVE,STORE DW H D ; SAVE W LHLD USE+2 ; INCR USE LXI D,BPS DAD D SHLD USE+2 POP D ; RESTORE W JMP NEXT ; DB 84H ; SELECT READ O 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  DW SECWT-12 PTRAC DW $+2 LDA DENSTY+2 ; GET #SECTORS/DRIVE ORA A ; IF DENSITY = 0 MVI A,SEPTR1+1 ; THEN SINGLE DENSITY86H ; SET-IO 1.3 ; ( ASSIGN SECTOR, TRACK FOR BDOS ) DB 'SET-I' DB 'O'+80H DW BLOCK-8 SETIO: DW $+2 PUSH B ; SAVE (I B ; SAVE (IP) LXI D,RDSEC ; ASK CP/M TO READ SECTOR CALL IOS STA DSKERR+2 ; (DSKERR) <- ERROR STATUS POP B ; RESTORE (ISETDRV TSCAL2 DW LIT,SEPTR2 DW SLMOD,TRACK DW STORE,ONEP DW SEC,STORE DW SEMIS ; SINGLE DENSITY TSCALS DW LIT,USPDR1 R WRITE 1.3 DB '?R/' ; ( F --- F ) DB 'W'+80H DW PSEC-10 QRW DW $+2 XTHL ; (HL) <- (S1) = R/W FLAG MOV A,L ; IF F; SEND DRIVE # TO CP/M CALL IOS POP B ; RESTORE (IP) JMP NEXT ; ; T&SCALC ( CALCULATES DRIVE#, TRACK#, & SECTOR# ) ; S JZ PTRA1 MVI A,SEPTR2+1 ; ELSE DOUBLE PTRA1 LHLD SEC+2 ; IF NOT AT END OF TRACK CMP L JNZ NEXT ; THEN DONE MVI A,1P) 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 ;P) JMP NEXT ; ; SEC-WRITE ; ( WRITE A SECTOR SETUP BY 'SET-DRIVE' & 'SETIO' ) ; DB 89H ; SEC-WRITE DB 'SEC-WRIT' DB  LAG = 1 ORA H XTHL JZ QRW1 ; THEN READ SECTOR PUSH B ; SAVE IP LXI D,RDSEC CALL IOS STA DSKERR+2 POP B ; REP,SWAP DW XDO ; DO THRU1 DW IDO,LOAD DW XLOOP,THRU1-$ ; LOOP DW SEMIS ; PAGE ;-------------------------------------- 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 JZ CPOU1 MOV C,E ; THEN OUTPUT (C) TO PRINTER CALL POUT CPOU1 RET ; ; FORTH TO CP/M SERIAL IO INTERFACE ; PQTER CALL ------------------------------------------------- ; ; ALTERNATIVE R/W FOR NO DISK INTERFACE ; ;RSLW DW DOCOL,DROP,DROP,DROP,IOS POP B ; IF CHR TYPED THEN (A) <- 0FFH RET ; ELSE (A) <- 0 ; ; CHR IGNORED ; CIN PUSH B ; CONSOLE INPUT LXI D,KCISTORE IP JMP NEXT ; ELSE WRITE SECTOR QRW1 PUSH B ; SAVE IP LXI D,RITSEC CALL IOS STA DSKERR+2 POP B ; RESTORE I----------- ; ; CP/M CONSOLE & PRINTER INTERFACE ; ; CP/M BIOS CALLS USED ; ( NOTE: BELOW OFFSETS ARE 3 LOWER THAN CP/M ;  INTER ; INTERPRET FROM OTHER SCREEN DW FROMR,INN DW STORE DW FROMR,BLK DW STORE DW SEMIS ; DB 0C3H ; --> DB '--CSTAT ; IF CHR TYPED LXI H,0 ORA A JZ PQTE1 INR L ; THEN (S1) <- TRUE PQTE1 JMP HPUSH ; ELSE (S1) <- FALSE ; PKEY CALSEMIS ; ;-------------------------------------------------------- ; DB 85H ; FLUSH DB 'FLUS' DB 'H'+80H DW RSLW-6 FLN ; WAIT FOR CHR TO BE TYPED CALL IOS ; (A) <- CHR, (MSB) <- 0 POP B RET ; COUT PUSH H ; CONSOLE OUTPUT LXI D,KCOUT ; P JMP NEXT ; DB 83H ; R/W ( FORTH DISK PRIMITIVE ) 1.3 DB 'R/' DB 'W'+80H DW QRW-7 RSLW DW DOCOL DW USE,AT DW TO DOCUMENTATION SINCE BASE ADDR = BIOS+3 ) ; KCSTAT EQU 3 ; CONSOLE STATUS KCIN EQU 6 ; CONSOLE INPUT KCOUT EQU 9 ; CONSOLE ' 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 MOL CIN ; READ CHR FROM CONSOLE CPI DLE ; IF CHR = (^P) MOV E,A JNZ PKEY1 LXI H,EPRINT ; THEN TOGGLE (EPRINT)LSB MVI E,USH DW DOCOL DW NOBUF,ONEP DW ZERO,XDO FLUS1 DW ZERO,BUFFE DW DROP DW XLOOP,FLUS1-$ DW SEMIS ; DB 84H ; SAVE 1.3 WAIT UNTIL READY CALL IOS ; THEN OUTPUT (C) POP H RET ; POUT LXI D,KPOUT ; PRINTER OUTPUT CALL IOS ; WAIT UNTIL READY R DW SWAP,SPBLK DW STAR,ROT DW USE,STORE DW TSCALC DW SPBLK,ZERO DW XDO ; DO RSLW1 DW SETIO ; SET-IO DW QRW ; OUTPUT KPOUT EQU 0CH ; PRINTER OUTPUT ; EPRINT DW 0 ; ENABLE PRINTER VARIABLE ; ; 0 = DISABLED, 1 = ENABLED ; ; BELOW BIDD DW SUBB DW BLK DW PSTOR DW SEMIS ; DB 84H ; THRU 1.3 DB 'THR' DB 'U'+80H DW ARROW-6 THRU DW DOCOL DW ONEABL ; 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) OR DB 'SAV' DB 'E'+80H DW FLUSH-8 SAVE DW DOCOL DW FLUSH DW SEMIS ; DB 84H ; LOAD DB 'LOA' DB 'D'+80H DW SAVE-7 RET ; THEN OUTPUT (C) ; CPOUT CALL COUT ; OUTPUT (C) TO CONSOLE XCHG LXI H,EPRINT MOV A,M ; IF (EPRINT) <> 0 ORA A ?R/W DW PTRAC ; +TRACK DW PSEC ; +SECTOR DW XLOOP,RSLW1-$ ; LOOP DW DROP DW FROMR,USE DW STORE,SEMIS ; ;-------OS CALLS USE 'IOS' IN DISK INTERFACE ; CSTAT PUSH B ; CONSOLE STATUS LXI D,KCSTAT ; CHECK IF ANY CHR HAS BEEN TYPED CALL  PHAN POP H ; (L) <- (S1)LB = CHR PUSH B ; SAVE (IP) MOV C,L CALL CPOUT ; OUTPUT CHR TO CONSOLE ; ; & MAYBE PRINTER OOP DB '+LOO' DB 'P'+80H DW LOOP-7 PLOOP DW DOCOL DW THREE DW QPAIR DW COMP DW XPLOO DW BACK DW SEMIS ; DBF 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  SPACS DW DOCOL DW ZERO DW MAX DW DDUP DW ZBRAN ; IF DW SPAX1-$ DW ZERO DW XDO ; DO SPAX2 DW SPACE DW XLOOP ; LICK-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 DIFF 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 POP B ; RESTORE (IP) JMP NEXT ; PCR PUSH B ; SAVE (IP) MVI C,ACR ; OUTPUT (CR) TO CONSOLE MOV L,C CALL CPOUT ; & MAYBE 0C5H ; UNTIL DB 'UNTI' DB 'L'+80H DW PLOOP-8 UNTIL DW DOCOL DW ONE DW QPAIR DW COMP DW ZBRAN DW BACK DW SEMI DW STORE DW SEMIS ; DB 0C4H ; THEN DB 'THE' DB 'N'+80H DW ENDIFF-8 THEN DW DOCOL DW ENDIFF DW SEMIS ; DB 0COOP ENDIF DW SPAX2-$ SPAX1 DW SEMIS ; DB 82H ; <# DB '<' DB '#'+80H DW SPACS-9 BDIGS DW DOCOL DW PAD DW HLD DW AT DW ULESS DW LIT DW 15H DW QERR DW DUP DW NFA DW DP DW STORE DW LFA DW AT DW CONT DW AT DW STORE 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  TO PRINTER MVI C,LF ; OUTPUT (LF) TO CONSOLE MOV L,C CALL CPOUT ; & MAYBE TO PRINTER POP B ; RESTORE (IP) JMP NEXT ;S ; DB 0C3H ; END DB 'EN' DB 'D'+80H DW UNTIL-8 ENDD DW DOCOL DW UNTIL DW SEMIS ; DB 0C5H ; AGAIN DB 'AGAI' 2H ; 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 W STORE DW SEMIS ; DB 82H ; #> DB '#' DB '>'+80H DW BDIGS-5 EDIGS DW DOCOL DW DROP DW DROP DW HLD DW AT DW DW SEMIS ; DB 84H ; BACK DB 'BAC' DB 'K'+80H DW FORG-9 BACK DW DOCOL DW HERE DW SUBB DW COMMA DW SEMIS ; D DW BRAN DW HERE DW ZERO DW COMMA DW SWAP DW TWO DW ENDIFF DW TWO DW SEMIS ; DB 0C5H ; WHILE DB 'WHIL' DB ;---------------------------------------------------- PAGE ; DB 0C1H ; ' ( TICK ) DB 0A7H DW THRU-7 TICK DW DOCOL  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 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 ; +L 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 B 0C5H ; BEGIN DB 'BEGI' DB 'N'+80H DW BACK-7 BEGIN DW DOCOL DW QCOMP DW HERE DW ONE DW SEMIS ; DB 0C5H ; ENDI '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 DW DFIND DW ZEQU DW ZERO DW QERR DW DROP DW LITER DW SEMIS ; DB 86H ; FORGET 1.3 DB 'FORGE' DB 'T'+80H DW T'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 END  DW ZBRAN ; IF DW SIGN1-$ DW LIT DW 2DH DW HOLD ; ENDIF SIGN1 DW SEMIS ; DB 81H ; # DB '#'+80H DW SIGN-7 DIG DW DW 11H DW EQUAL DW ZEQU DW ZBRAN ; IF DW VLIS3-$ DW SPSTO DW QUIT ;THEN DW BRAN DW VLIS3-$ ; ELSE VLIS9 DW SPS DOCOL DW ZERO DW DDOT DW SEMIS ; DB 85H ; VLIST DB 'VLIS' DB 'T'+80H DW UDOT-5 VLIST DW DOCOL DW LIT DW 80HNDEX-8 TRIAD DW DOCOL DW PAG DW LIT,3 DW SLASH DW LIT,3 DW STAR DW LIT,3 DW OVER,PLUS DW SWAP,XDO TRIA1 DW CR,OMR DW OVER DW SUBB DW SPACS DW TYPE DW SEMIS ; DB 82H ; .R DB '.' DB 'R'+80H DW DDOTR-6 DOTR DW DOCOL DW T,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,LI 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 DTO DW QUIT ; THEN VLIS3 DW ZEQU DW ZBRAN ; UNTIL DW VLIS1-$ DW DROP DW SEMIS ; ;------ EXIT CP/M ----------------- 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-$IDO DW LIST DW QTERM ; ?TERMINAL DW ZBRAN,TRIA2-$ ; IF DW LEAVE ; LEAVE TRIA2 DW XLOOP,TRIA1-$ ; ENDIF DW CR DW LTOR DW STOD DW FROMR DW DDOTR DW SEMIS ; DB 82H ; D. DB 'D' DB '.'+80H DW DOTR-5 DDOT DW DOCOL DW ZERO DW ST2-$ ; IF DW LEAVE ; LEAVE LIST2 DW XLOOP,LIST1-$ ; ENDIF DW CR,SEMIS ; DB 85H ; INDEX 1.3 DB 'INDE' DB 'X'+80H W 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 D------ ; DB 83H ; BYE DB 'BY' DB 'E'+80H DW VLIST-8 BYE DW $+2 JMP 0 ;--------------------------------------------- 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 DUIT,15 DW MESS,CR DW SEMIS ; DB 84H ; SHOW 1.3 DB 'SHO' DB 'W'+80H DW TRIAD-8 SHOW DW DOCOL DW ONEP,SWAP DW XDDDOTR DW SPACE DW SEMIS ; DB 81H ; . DB '.'+80H DW DDOT-5 DOT DW DOCOL DW STOD DW DDOT DW SEMIS ; DB 81H ;  DW LIST-7 INDEX DW DOCOL DW PAG DW ONEP,SWAP DW XDO INDE1 DW CR,IDO DW LIT,3 DW DOTR,SPACE DW ZERO,IDO DW DLINEOCOL DIGS1 DW DIG ; BEGIN DW TDUP DW ORR DW ZEQU DW ZBRAN ; UNTIL DW DIGS1-$ DW SEMIS ; DB 83H ; D.R DB 'D.' -- ; DB 84H ; PAGE 1.3 DB 'PAG' DB 'E'+80H DW BYE-6 PAG DW DOCOL DW LIT,FF DW EMIT,CR DW SEMIS ; DB 84H ; LIP DW QTERM DW ZBRAN ; IF DW VLIS3-$ DW KEY DW LIT DW 13H DW EQUAL DW ZBRAN ; IF DW VLIS9-$ DW KEY DW LIT O SHOW1 DW PAG,IDO DW TRIAD DW LIT,3 DW XPLOO,SHOW1-$ DW SEMIS ; DB 84H ; .CPU DB '.CP' DB 'U'+80H DW SHOW-7 ? 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,QTERM DW ZBRAN,INDE2-$ DW LEAVE INDE2 DW XLOOP,INDE1-$ DW SEMIS ; DB 85H ; TRIAD 1.3 DB 'TRIA' DB 'D'+80H DW I 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 FRST 1.3 DB 'LIS' DB 'T'+80H DW PAG-7 LIST DW DOCOL DW CR,DUP DW SCR,STORE DW PDOTQ DB 6,'SCR # ' DW DOT DW LI 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 ; DW TEXT-7 LINE: DW DOCOL DW DUP DW LIT DW 0FFF0H DW ANDD DW LIT DW 17H DW QERR DW SCR DW AT DW PLINE DW DR<-- I MOV E,B MVI D,0 DAD D ; (HL) <-- I+N POP B ; IP LXI D,1 ; SUCCEED JMP DPUSH ; DB 85H ; DEPTH = NUMBER DB NLEAD DW DOCOL ; OFFSET DW NLOCAT DW LINE DW SWAP DW SEMIS ; DB 84H ; #LAG DB '#LA' ; CURSOR ADDR, DB 'G'+80H ; E PAD PUSH B ; SAVE N,LEN-I MVI C,1 ; J=MATCH COUNT=1 MATCH2: INR C MOV A,B CMP C ; J > N ? JM MATCH5 ; SUCCEED INXE DW CAT DW SUBB DW SPACS DW LIT DW 5EH DW EMIT DW BCOMP DW EDITOR DW QUIT DW SEMIS PAGE ; ; EDITOR DEFIB 85H ; MATCH DB 'MATC' DB 'H'+80H DW DOTCPU-7 MATCH: DW $+2 MOV L,C ; (HL) <-- (BC) MOV H,B POP B ; (BC) <-- (0,N)OP DW SEMIS ; DB 0C6H ; EDITOR DB 'EDITO' DB 'R'+80H DW LINE-7 EDITOR: DW DODOE DW DOVOC DW 0A081H EDITP DW ELA 'DEPT' ; OF WORDS DB 'H'+80H ; ON STACK DW MATCH-8 DEPTH DW DOCOL DW SPAT DW SZERO DW AT DW SWAP DW SUBB DW COUNT AFTER DW NLEAD-8 ; CURSOR NLAG DW DOCOL DW NLEAD DW DUP DW TOR DW PLUS DW CSLL DW FROMR DW SUBB DW SEMI D INX H LDAX D XRA M ; MATCH ? JZ MATCH2 ; NEXT CHAR POP B ; RESTORE PARAMS POP D POP H JMP MATCH1 ; MATCH4: NITIONS ; DB 83H ; TOP DB 'TO' DB 'P'+80H DW FORTH+4 ; CHAIN EDITOR VOCAB TO FORTH VOCAB TOP DW DOCOL DW ZERO DW R MOV A,C POP D ; (DE) <-- PAD POP B ; (BC) <-- (0,LENGTH) MOV B,A ; (BC) <-- (N,LEN) XTHL ; (S1) <-- (IP) ; (HL) ST ; COLD START VALUE ONLY ; CHANGED WHEN NEW EDITOR DEF ADDED DW 0 ; DB 85H ; WHERE DB 'WHER' DB 'E'+80H DW EDITTWO DW SLASH DW SEMIS ; DB 84H ; TEXT DB 'TEX' DB 'T'+80H DW DEPTH-8 TEXT: DW DOCOL DW HERE DW CSLL DW ONEP S ; DB 85H ; -MOVE DB '-MOV' ; DB 'E'+80H DW NLAG-7 DMOVE DW DOCOL DW LINE DW CSLL DW CMOVE DW UPDAT DW SEMPOP D ; (DE) <-- N,LEN POP H ; CURSAD POP B ; IP MVI D,0 XCHG LXI D,0 ; FAIL JMP DPUSH ; MATCH5: POP B ; N,LEN-I NUM DW STORE DW SEMIS ; DB 87H ; #LOCATE DB '#LOCAT' DB 'E'+80H ; LEAVE CURSOR DW TOP-6 ; OFFSET,LINE NLOCAT DW DO<-- (CURSOR) PUSH H ; SAVE CURSOR OVER IP PUSH B ; SAVE N,LEN INR C DCX H MATCH1: DCR C MOV A,C CMP B ; LEN < N ? OR-9 WHERE: DW DOCOL DW DUP DW BSCR DW SLASH DW DUP DW SCR DW STORE DW PDOTQ DB 6 DB 'SCR # ' DW DEC DW D DW BLANK DW WORD DW HERE DW PAD DW CSLL DW ONEP DW CMOVE DW SEMIS ; DB 84H ; LINE DB 'LIN' DB 'E'+80H DIS ; DB 81H ; H DB 'H'+80H DW DMOVE-8 EDH DW DOCOL DW LINE DW PAD DW ONEP DW CSLL DW DUP DW PAD DW CSTOR  POP D ; PAD POP H ; CURSAD+I POP B ; N,LEN POP D ; CURSAD MOV A,L SUB E MOV L,A MOV A,H SBB D MOV H,A ; (HL) COL DW RNUM DW AT DW CSLL DW SLMOD DW SEMIS ; DB 85H ; #LEAD DB '#LEA' DB 'D'+80H ; LINE ADDR, DW NLOCAT-0AH  JM MATCH4 ; FAIL INX H LDAX D XRA M ; (PAD) = (CURSAD) ? JNZ MATCH1 ; TRY AGAIN PUSH H ; SAVE CURSOR+I PUSH D ; SAVOT DW SWAP DW CSLL DW SLMOD DW CSLL DW STAR DW ROT DW BLOCK DW PLUS DW CR DW CSLL DW TYPE DW CR DW HER  DW CMOVE DW SEMIS ; DB 81H ; E DB 'E'+80H DW EDH-4 EDE DW DOCOL DW LINE DW CSLL DW BLANK DW UPDAT DW SEMIS D DW COUNT DW MATCH DW RNUM DW PSTOR DW SEMIS ; DB 84H ; FIND DB 'FIN' DB 'D'+80H DW ONELN-8 FIND DW DOCOL ;DW 10H DW ZERO DW XDO CLEA1 DW IDO DW EDE DW XLOOP DW CLEA1-$ DW SEMIS ; DB 84H ; COPY DB 'COP' DB 'Y'+80H  DW PAD DW CAT DW MINUS DW EDM DW SEMIS ; DB 81H ; X DB 'X'+80H DW EDB-4 EDX DW DOCOL DW ONE DW TEXT DW F DW CR DW NLOCAT DW LIT DW 3 DW DOTR DW SPACE DW DROP DW NLEAD DW TYPE DW LIT DW 5EH DW EMIT DW NLAG DR'+80H DW DELETE-9 EDR DW DOCOL DW PAD DW ONEP DW SWAP DW DMOVE DW SEMIS ; DB 81H ; P DB 'P'+80H DW EDR-4 E ; DB 81H ; S DB 'S'+80H DW EDE-4 EDS DW DOCOL DW DUP DW ONE DW SUBB DW LIT DW 0EH DW XDO EDS1 DW IDO DW L BEGIN FIN1 DW LIT DW 3FFH DW RNUM DW AT DW LESS DW ZBRAN ; IF DW FIN2-$ DW TOP DW PAD DW HERE DW CSLL DW DW CLEAR-8 COPY DW DOCOL DW BSCR DW STAR DW OFSET DW AT DW PLUS DW SWAP DW BSCR DW STAR DW BSCR DW OVER IND DW PAD DW CAT DW DELETE DW ZERO DW EDM DW SEMIS ; DB 84H ; TILL DB 'TIL' DB 'L'+80H DW EDX-4 TILL DW DW TYPE DW SEMIS ; DB 81H ; T DB 'T'+80H DW EDM-4 EDT DW DOCOL DW DUP DW CSLL DW STAR DW RNUM DW STORE DW DDP DW DOCOL DW ONE DW TEXT DW EDR DW SEMIS ; DB 81H ; I DB 'I'+80H DW EDP-4 EDI DW DOCOL DW DUP DW EDS DW INE DW IDO DW ONEP DW DMOVE DW LIT DW -1H DW XPLOO DW EDS1-$ DW EDE DW SEMIS ; DB 81H ; D DB 'D'+80H DW ONEP DW CMOVE DW ZERO DW ERROR ; ENDIF FIN2 DW ONELN DW ZBRAN ; UNTIL DW FIN1-$ DW SEMIS ; DB 86H ; DELETE DBDW PLUS DW SWAP DW XDO COP1 DW DUP DW IDO DW BLOCK DW TWO DW SUBB DW STORE DW ONEP DW UPDAT DW XLOOP DW COCOL DW NLEAD DW PLUS DW ONE DW TEXT DW ONELN DW ZEQU DW ZERO DW QERR DW NLEAD DW PLUS DW SWAP DW SUBB UP DW EDH DW ZERO DW EDM DW SEMIS ; DB 81H ; L DB 'L'+80H DW EDT-4 EDL DW DOCOL DW SCR DW AT DW LIST DW EDR DW SEMIS ; DB 81H ; N DB 'N'+80H DW EDI-4 EDN DW DOCOL DW FIND DW ZERO DW EDM DW SEMIS ; DB 81H ; F D EDS-4 EDD DW DOCOL DW DUP DW EDH DW LIT DW 0FH DW DUP DW ROT DW XDO EDD1 DW IDO DW ONEP DW LINE DW IDO  'DELET' DB 'E'+80H DW FIND-7 DELETE DW DOCOL DW TOR DW NLAG DW PLUS DW RR DW SUBB DW NLAG DW RR DW MINUS OP1-$ DW DROP DW FLUSH DW SEMIS ; DB 85H ; 1LINE DB '1LIN' DB 'E'+80H DW COPY-7 ONELN DW DOCOL DW NLAG DW PA DW DELETE DW ZERO DW EDM DW SEMIS ; DB 83H ; PUT DB 'PU' DB 'T'+80H DW TILL-7 EPUT DW DOCOL DW PAD DW COUNTZERO DW EDM DW SEMIS ; DB 85H ; CLEAR DB 'CLEA' DB 'R'+80H DW EDL-4 CLEAR DW DOCOL DW SCR DW STORE DW LIT B 'F'+80H DW EDN-4 EDF DW DOCOL DW ONE DW TEXT DW EDN DW SEMIS ; DB 81H ; B DB 'B'+80H DW EDF-4 EDB DW DOCOL DW DMOVE DW XLOOP DW EDD1-$ DW EDE DW SEMIS ; DB 81H ; M DB 'M'+80H DW EDD-4 EDM DW DOCOL DW RNUM DW PSTOR  DW RNUM DW PSTOR DW NLEAD DW PLUS DW SWAP DW CMOVE DW FROMR DW BLANK DW UPDAT DW SEMIS ; DB 81H ; R DB '  DW NLAG DW ROT DW OVER DW MIN DW TOR DW RR DW RNUM DW PSTOR DW RR DW SUBB DW TOR DW DUP DW HERE DW  EQU EM ;LAST MEMORY LOC USED + 1 ; = LIMIT ; ; END ORIG OLD (DP) VALUE ; = COLD (FENCE) VALUE ; | NEW ; | DEFINITIONS ; V ; ; ^ ; | DATA ; (DO **++++"*s#r#s#rG&**^#VGI 7**##)0E**####)DIGI Y&{0 l s_.ElF(FINDO -------- -------- MCOLD EQU ORIG ;JMP TO COLD START MWARM EQU ORIG+4 ;JMP TO WARM START MA2 EQU ORIG+8 ;COLD START PARARR DW CMOVE DW HERE DW NLEAD DW PLUS DW FROMR DW CMOVE DW FROMR DW CMOVE DW UPDAT DW ZERO DW EDM DW SEMI | STACK MIS0 EQU INITS0 ; = COLD (SP) VALUE = (S0) ; = (TIB) ; | TERMINAL INPUT ; | BUFFER ; V ?®#ʌ«!_!Eڴ^#VzƒGENCLOSw{+#W~zGG#~GMETERS MUP EQU UP ;USER VARIABLES' BASE 'REG' MRP EQU RPP ;RETURN STACK 'REGISTER' ; MBIP EQU BIP ;DEBUG SUPPORT MDPUSH S ; ELAST DB 81H ; C DB 'C'+80H DW EPUT-6 EDC DW DOCOL DW ONE DW TEXT DW EPUT DW SEMIS ; ; FORTH DEFINITIONS ( ; ; ^ ; | RETURN ; | STACK MIR0 EQU INITR0 ;START USER VARIABLES ; = COLD (RP) VALUE = (R0) ; GEMIf:@KE#v?TERMINA4!hC&AÚCMOV:Ni`[~# xVG>CMOVDoi` + +Â~+EQU DPUSH ;ADDRESS INTERPRETER MHPUSH EQU HPUSH MNEXT EQU NEXT ; MDP0 EQU DP0 ;START FORTH DICTIONARY MDIO EQU DRIVE ;õ oooo 3 oo!,~?#~? oJ o g^#VLIZ o gFEXECUTRoMBRANCc~`iCONTINUED ) ; FLAST DB 84H ; TASK DB 'TAS' DB 'K'+80H DW WHERE-8 TASK DW DOCOL DW SEMIS ; INITDP DS EM-$ ;CONSUME M= (UP) ; ;END USER VARIABLES MFIRST EQU BUF1 ;START DISK BUFFERS ; = FIRST MEND EQU EM-1 ;END DISK BUFFERS MLIMIT x}GUdD}ͮgxDͮJ UlgF!)һ) ³ɂU`i}||ejkW\aE_|g{ |g{CP/M DISK INTERFACE MCIO EQU EPRINT ;CONSOLE & PRINTER INTERFACE MIDP EQU INITDP ;END INITIAL FORTH DICTIONARY ; = C^#V+MDG0BRANCs}~G(LOOP**^#Vr+s##{z#~#"*G(+LOOP**~w_#~w#W{z#~#~~#"*GEMORY TO LIMIT ; PAGE ; ; MEMORY MAP ; ( THE FOLLOWING EQUATES ARE NOT REFERENCED ELSEWHERE ) ; ; LOCATION CONTENTS ; )_|g{,!FU/MOAN-{ozgFO%?{ozgFXO8R{ozgFSPJe!9FSP]t*(^#VFp XP X1 PF~ f1 XI!CSД c?ERROҨ L|?COMй teX ?EXE teX &DPwN(FLāN*CSЊN,RN.HLĜN01#F2##F1+F2++F27?}o|gF2|g}-FINı \ee  V (ABORT ERRO4e7> F Y ? r)e  1efIDo^#V^#VG}s#rGCsG2s#r#s#rG ie\y **++"*q#pKBG U  k PEC I!Xe^ *$^ nP I X|X|(X ^ ^|$^$QUERGRPl**FRP*(^#V"*G;ӑ**N#F#"*GEXIԪLEAVž**^#V#s#rG>**++"*s#rGR**^#?PAIR P X ?CS ceP X ?LOADIN )eX COMPIL0  e( K ^tg XtoFHEReALLO @  n C$  f }o|gɁ4 R E FL P W>o>gFOVEґEDROбGSWAFDUF2DUE2DRO   I$t|-TRA -DU ?DU  TRAVERS IXt LATES& ieeLFM XP CF` nP N X INTERPRE]te  v ( |v mf| eK|.f|IMMEDIATŊV X@WVOCABULARFENCNDNVOC-LIN NBLNI#NOU,NSC4NOFFSE=NCONTEXFN CURRENRN"STAT_N$BASlN,~e ~eVef@|NUMBEd^^ tX-^ IXotP tX.P ^ ^|G2SWA33;;E2OVE(333333;;;;;;E+B~w#~wGTOGGL;Y~wGNg^#VGCavn&F2ILINR ^IfP tP |fP (."{  F IY . X"teU  t |  F Y EX  X( iev ( e(  \FORT+  DEFINITION%\ei7X)QUIQ^)k ? te^=5FLUSbZ^^?SAVŚLOAĸ)e1e^1)1)--BLOC6OeI@ee P I4 ? fhnP e P I@*SET-I*7DM!*!MINDEع?$X ^$2TRIAXXXI?$2?X?SHO37IIX@.LINpy Y MESSAGŗe XOeP  | MSG # P!so&FP ^( n)nWHILSPACE^  ^ _ˆ!*-DMGSET-DRIV":OGT&SCALe8XXe^ | X4+X$;X.CPu~eX$~X"~MATCȔi`yG + y# x#E! s}GDRIV<SE <TRAC<US#<oPRE/<oSEC/BL9"#BUFD"#SCR/DRRe X|Xh~eZ X  XIX0I #Ӂ=D.ҫ~GoVP *Y .6D^X(eXIXLX eX3X&eX~S->8!zC+E+/7yD+F7ABWKDABi3 ~wk&FMWG iW iWG^ .FORGEԫie\eP X  e X  f e\eBXe^ | X+SEC-REA1$2GSEC-WRITű'2G+TRAC:>>5*!}o|gXEDEPTȹceP nTEX   LLIN/X+X CeyEDITON+  DENSIT^<DISK-ERROҁ<+BUƏXI^ @eP UPDATŠ@eeX=@eEMPTY-BUFFERP  6eU^VLISX:\ee:e  ?^:  f e2(!X^ !X^ ]MIw MA؆ MPoo]M~ o PKKAC˿ P ( BEGI fENDI n P THE!)D=U  vLOOJv U +LOO[v U G>2!:-<2-G+SECTO :!<2!*7"7G?R/?}T$2G'2GR/65eN 5;NWHERoC SCR #  I?Y ? tP *X^xfTO1^#LOCATe#LEA DR^ODRe X|XOBUFFE5e5 e7  eX+^h  @rf|rfBY)PAGśX ?LISԦ?C SCR # X^?$X $Ce2?/MO6MO*/MO!*/7M/MOC^ (LINERX@UNTIpf U ENĆAGAIΜf U |REPEAԨnP )IƾU  ^( nELSn U | U#LAIP -MOV UL$U  L8U PfP X$U$,Xsing PIP (or XFER). 3. Insert an empty (but formatted) disk in drive A. This will become your "Forth screens disk." Ives FORTH130.USE this explanation. If the your system is different from that described for the COM file, you can re @ P  L ILL^n f6t TAS˂EMPTY message. If you have a printer which works with CP/M, you can use it with this Forth by entering Control-P tT`<X $U$,T͈@?X Y X^Y Ԯ<^Ce^t will not be compatible with CP/M's file system; it should be used only by Forth. Use Forth's editor to put text ontassemble the ASM file using CP/M's assemblers ASM or MAC (not supplied). Enter "FORTH130" and a carriage return.  HOW TO USE fig-FORTH 8080 CP/M 1. Boot CP/M (or CDOS). None of the disks supplied is bootable; yoo turn it on or off. The first Control-P turns it on, the next turns it off, etc. See the fig Installation Manual foCLEACX^$TCOPOeII$nP 1LIN" F @FIN_o this disk and LOAD to compile source programs. First, use the editor to put error messages on screens 4 and 5  After Forth is loaded and initialized, you should see: 8080 fig-FORTH 1.3 Remove this disk from drive A. Do not writeu must use your own. 2. Insert the disk labeled "fig-FORTH 8080 CP/M v1.3" in drive A. A "DIR" will show: FORTHr a Glossary listing the words available and for how to use the Editor. You can enter "VLIST" any time to see what woXe   L^LgDELETwI P  y@IL Ҧ ,f6d(see the Installation Manual). Be sure to enter FLUSH after editing. All FORTH words must use upper case letters. Th on it using Forth because Forth does not use CP/M's directory or file structure. You can put other CP/M files on it u130.ASM the assembly source file FORTH130.COM above assembled for 32K bytes of memory and two 8" single density disk drirds are usable. To terminate a VLIST before it is finished, enter any character. ~^ f6   ty f6~ t^TIL- If6g^ IP ^PUE  F  en say 1 WARNING ! to use the error messages. Try using . when the stack is empty; you should get the STACK       ! " # $ % & ' ( ) * + , - . / 0 1 2 3 4 5 6 7 8 9 : ; < = > ? @ A B C D E F G H I J K L