CP/M 2.2 DOUBLE-DDISKETTE^CPM FROMNORTH * STAR ---------SYSTEM--TRACKS-BIOS USER CPM CCP CPM BDOS --------DIR.SEC1DIR.SEC2DIR.SEC3DIR.SEC4--------CPM DATADATASEC1DATASEC2DATASEC3DATASEC4........ FORTH SCR FORTH SCR !FORTH SCR"#$%&'()*+,-./01FORTH SCR23456789:;<=>?@AFORTH SCRBCDEFGHIJKLMNOPQFORTH SCR0RSTUVWFORTH79CCOMXYZ[\]^_`abcdefgFORTH79CCOMhFORTH79ECOM^ijklmnopqrstSCOPY COMuvwFORTH COMxyz{|}~FORTH COM*FPOINT $$$FPOINT $$$( FORTH79 Utilities Screen File 11-Jan-82 ) ( (c) Copyright 1981 ) ( MicroMotion ) ( 12077 Wilshire #506 ) ( Los Angeles, CA 90025 ) ( (213) 821-4340 ) ( User Personalization Screen #1 DLR 15-Dec-81 ) HEX 2 LOAD CR CR CR ." Personalization of FORTH-79 Version " 011F C@ 1 .R ." ." 0120 C@ 1 .R CR CR ." How many screen buffers do you want? " RD1DEC 2 MAX 0105 ! ( User Personalization Screen #2 DLR 16-Dec-81 ) : GETN ( addr --- addr+x n ) DUP C@ IF ( next char is non-zero ) BEGIN DUP C@ BL = WHILE 1+ REPEAT ( skip blanks ) 1- 0 0 ROT CONVERT ROT ROT DROP ELSE ( next char = 0 ) 0 THEN ; CR ." Length for creating new screen file? " RD1DEC 0107 ! CR ." Enter alternate keyboard codes for DEL: " 0109 2 SETBYTS CR ." Enter your console output DEL sequence: " 010B 3 SETBYTS CR ." Can your terminal output lower-case? " GETLN @ 0DF AND 059 = 010E C! DROP CR CR ." User Personalization completed." CR FORGET GETN SAVE : GETLN ( --- oldbase addr ) BASE @ PAD 40 EXPECT PAD ; : SDSB! ( oldbase addr n --- ) SWAP DROP SWAP BASE ! ; : RD1DEC ( --- n ) GETLN DECIMAL GETN SDSB! ; : RD1HEX ( --- n ) GETLN HEX GETN SDSB! ; : SETBYTS ( addr count --- ) GETLN HEX >R ROT R> 4 ROLL 0 DO GETN 3 PICK C! >R 1+ R> LOOP 2DROP BASE ! ; ( HELLO GO TURNKEY ONERR ) : HELLO ( print greetings ) CR ." FORTH-79 Double-Number Version 2.0" CR ." MicroMotion 12077 Wilshire #506" CR ." Los Angeles, CA 90025 213-821-4340" CR ." Copyright (c) 1981" CR ; : GO ( coldstart word ) ( Selective DESTRUCT ) HEX : DESTRUCT ( destroy compiler words ) [COMPILE] FORTH ' SPACES LFA @ BEGIN DUP ' THRU U< 0= WHILE DUP @ BF AND OVER C! PFA LFA @ ( Save current configuration as an OPTIMIZER system ) HEX : SAVE 103 @ 101 ! ( Reset JP COLDST ) FORTH DEFINITIONS OPTIMIZER HERE FENCE ! ( Save current configuration as a 79-STANDARD system ) HEX 103 @ 101 ! DECIMAL ( Reset JP COLDST ) FIND COLD (BOOT) ! ( Reset coldstart switch ) FORTH DEFINITIONS 79-STANDARD HERE FENCE ! HERE 1- 256 / ( perform any needed user initialization here ) LAST? HELLO WARM ; : TURNKEY ( TURNKEY ) ?FIND ' (BOOT) ! ; TURNKEY GO : ONERR ( ONERR ) ?FIND ' (QUIT) ! ; REPEAT DROP ; DECIMAL HERE 1- 100 / DECIMAL CR ." After the CP/M prompt '>', type:" CR ." SAVE " . ." FORTH.COM" BYE ; DECIMAL 67 CR ." After the CP/M prompt '>', type:" CR ." SAVE " . ." FORTH.COM" BYE ( Editor I/O Installation ) EDITOR C/SL C/L MIN ' C/SLN ! FORTH : EDQUIT TDONE QUIT ; : (TINIT) ' EDQUIT CFA (QUIT) ! ; : (TDONE) ' (*QUIT) CFA (QUIT) ! ; ( Direct BIOS version of CRTEMIT ) HEX ( As written, this code picks up the address of BIOS at ) ( compile time and therefore must be compiled on the same ) ( CP/M system in which it is to be run. ) CODE CONOT ( Direct BIOS version of CRTEMIT, lower -> upper case ) HEX ( As written, this code picks up the address of BIOS at ) ( compile time and therefore must be compiled on the same ) ( CP/M system in which it is to be run. ) CODE CONOT ( Version for terminal without lower case ) ( DUMP dynamic screen width version DLR 2-Jan-82 ) HEX ( display n memory locations in hex starting at addr ) : DUMP ( addr n --- ) BASE @ HEX C/SL 49 > 8 * 4 ROLL 4 ROLL CR 3 PICK IF CR 5 SPACES 10 0 DO I 3 .R LOOP CR THEN ( heading ) 1- OVER + SWAP FFF8 4 PICK - AND ( round start addr ) FIND 0 SEVEC ! FIND 1 SEVEC ! FIND (CH) 2 SEVEC ! FIND (CV) 3 SEVEC ! FIND (HOME) 4 SEVEC ! FIND (BELL) 5 SEVEC ! BC PUSH, C E LD, 1 @ 09 + CALL, BC POP, RET, END-CODE : 0 (CTL) ! ' CONOT IOVEC 2+ ! ; FIND 0 SEVEC ! DECIMAL BC PUSH, A E LD, 61 CP, CY 1 L# JR, 07B CP, NCY 1 L# JR, 20 SUB, 1 L: C A LD, 1 @ 09 + CALL, BC POP, RET, END-CODE DECIMAL : 0 (CTL) ! ' CONOT IOVEC 2+ ! ; FIND 0 SEVEC ! DO CR I 0 4 D.R SPACE ( print address ) DUP 7 + I + I DO I C@ 3 .R 1 /LOOP ( print mem contents ) 2 SPACES DUP 7 + I + I DO I C@ 7F AND DUP BL < ( print ASCII ) OVER 7F = OR IF DROP 2E THEN EMIT 1 /LOOP DUP 8 + /LOOP CR DROP BASE ! ; DECIMAL ( DUMP wide screen version ) ( Display n memory locations in hex starting at addr ) ( shortened version for CRTs of width 73 chars or wider ) HEX : DUMP ( start-addr #-bytes --- ) BASE @ ROT ROT HEX CR CR 6 SPACES 10 0 DO I 3 .R LOOP CR ( print heading ) ( DUMP narrow screen version ) ( Display n memory locations in hex starting at addr ) ( shortened version for CRTs of width 72 chars or less ) HEX : DUMP ( start-addr #-bytes --- ) BASE @ ROT ROT HEX CR CR ." ADDR: " OVER U. 1- OVER + SWAP FFF8 AND ( round addr ) DO CR I 0 4 D.R SPACE I 7 + I ( print addr ) ( .B .S Base & Stack dump DLR 21-Aug-81 ) DECIMAL : .B BASE @ DUP ." Now in base " DECIMAL . CR BASE ! ; : .S BASE @ SP@ 2+ S0 @ 2DUP = ( VLIST Full-screen optional version ) DECIMAL : VLIST 0 (CTL-C) ! CR 1 OUT ! CONTEXT @ @ BEGIN DUP C@ 31 AND OUT @ + C/SL 3 - > OVER + SWAP FFF0 AND DO ( round starting address ) CR I 0 4 D.R 2 SPACES ( print address ) I 10 + I DO I C@ 3 .R LOOP ( print memory contents ) 2 SPACES I 10 + I DO I C@ ( print ASCII contents ) 7F AND DUP 20 ( space ) < OVER 7F = OR IF DROP 2E ( "." ) THEN EMIT LOOP 10 +LOOP CR BASE ! ; DECIMAL DO I C@ 3 .R 1 ( print contents ) /LOOP 2 SPACES I 7 + I DO I C@ 7F AND DUP BL < OVER 7F = OR ( print ASCII ) IF DROP 2E THEN EMIT 1 /LOOP 8 /LOOP CR BASE ! ; DECIMAL IF CR ." " CR 2DROP ELSE SWAP DO CR I @ DUP DECIMAL 7 .R HEX ." (" 0 4 D.R ." H)" 2 +LOOP CR THEN BASE ! .B ; IF CR 1 OUT ! THEN DUP ID. SPACE SPACE PFA LFA @ DUP 0= ?KEY DUP IF KEY DROP THEN OR UNTIL DROP CR ; ( INFO VLIST begin ) HEX ( print PFA and contents of PFA ) : (ADDR) ( PFA --- ) SPACE DUP 0 4 D.R ." (" @ 0 4 D.R ." ) " ; ( INFO VLIST continues ) : (INFO) ( PFA --- ) CR DUP NFA C@ 50 ( "P" ) 40 NFBIT 4E ( "N" ) 20 NFBIT 1F AND DUP 0 3 D.R OVER (ADDR) OVER NFA ID. 9 SWAP - SPACES DUP NFA 1+ C@ BL OR A0 = IF DROP EXIT THEN CFA DUP @ DUP ' (:) - IF ( not a : word ) OVER 2+ = IF ." code " DROP ( INFO VLIST end ) : INFO ( --- ) FIND DUP 0= 0 ?ERROR 2+ ( CFA -> PFA ) BASE @ SWAP HEX (INFO) BASE ! CR ; : VLIST ( fancy VLIST ) BASE @ HEX 0 (CTL-C) ! CONTEXT @ @ ( INDEX DLR 15-Aug-81 ) : (INDEX) ( n --- ) DUP SCRLEN @ < IF CR DUP 3 .R SPACE BLOCK 64 -TRAILING TYPE ELSE DROP THEN ; ( TRIAD LPON LPOFF DLR 15-Aug-81 ) : TRIAD 0 (CTL-C) ! CR 3 / 3 * DUP 3 + SWAP DO CR I SCRLEN @ < IF I LIST THEN ?KEY ( print name-field bit indicators ) : NFBIT ( len-byte char mask --- len-byte ) 3 PICK AND NOT IF DROP BL THEN EMIT ; ELSE DUP @ NEXT = IF ( an IOVEC word ) DROP ' NOOP ELSE @ DUP C@ 0 ( Z-80 NOP ) = ( DOES>? ) IF ( search for PFA ) BEGIN 1- DUP @ ' (:) = UNTIL 2+ THEN THEN NFA ID. THEN ELSE 2DROP THEN ; BEGIN PFA DUP (INFO) LFA @ DUP 0= ?KEY DUP IF KEY DROP THEN OR UNTIL DROP CR BASE ! ; DECIMAL : INDEX ( from to --- / print index of screens ) 0 (CTL-C) ! 1+ SWAP DO I (INDEX) ?KEY IF KEY DROP LEAVE THEN LOOP CR ; IF LEAVE THEN LOOP CR ; : LPON ' LPEMIT IOVEC 2+ ! ; : LPOFF ' STDEMIT IOVEC 2+ ! ; ( LPINDEX LPTRIAD DLR 15-Aug-81 ) : LPINDEX ( first# last# --- ) 0 (CTL-C) ! LPON ( disable ctl-c, LPT on ) DUP ROT DO CR CR I 2DUP 59 + MIN SWAP DO I (INDEX) ?KEY IF LEAVE THEN 1 /LOOP CR 12 EMIT ?KEY IF KEY DROP LEAVE THEN 60 ( DOC - formats & lists screens ) ( starts on any screen #, not mod3 like TRIAD ) : DOC ( first# last# --- ) 0 (CTL-C) ! LPON ( printer on ) SWAP BEGIN 3 0 DO 2DUP I + DUP LIST > NOT ?KEY OR IF LEAVE THEN ( CATALOG ) ( Print the 1st line of each definition ) : CATALOG ( from-scr# thru-scr# --- ) 1+ SWAP CR DO I SCRLEN @ < IF I BLOCK DROP 16 0 DO I (LINE) OVER C@ BL - IF J 3 .R I 3 .R ( HUNT - words on blocks ) ( Requires String Enhancement IN$ ) : HUNT ( from-blk to-blk --- ) 1 WORD COUNT 2SWAP 1+ SWAP DO I BLOCK 16 0 DO DUP 2OVER ROT C/L IN$ ( LOAD-BUFFERS ) : LOAD-BUFFERS ( from# to# blkcount --- ) SAVE-BUFFERS EMPTY-BUFFERS 1 MAX DUP NBUF > 5 ?ERROR 0 DO 2DUP 32768 OR BUFFER SWAP 1 R/W SWAP 1+ SWAP 1+ LOOP 2DROP ; /LOOP DROP LPOFF ( printer off ) ; : LPTRIAD ( first# last# --- ) 0 (CTL-C) ! LPON ( disable ctl-c, LPT on ) SWAP DO R> 3 / 3 * >R I TRIAD 12 EMIT ?KEY IF KEY DROP LEAVE THEN 3 /LOOP LPOFF ( printer off ) ; LOOP 3 + 2DUP < NOT WHILE 12 EMIT ( form feed ) REPEAT 2DROP ?KEY IF KEY DROP THEN 12 EMIT LPOFF ( printer off ) ; SPACE -TRAILING TYPE CR ELSE 2DROP THEN LOOP ?KEY IF LEAVE THEN THEN LOOP ; IF CR J 3 .R I 3 .R SPACE DUP C/L TYPE THEN C/L + LOOP DROP ?KEY IF LEAVE THEN LOOP 2DROP ; ( COPY-BLOCKS ) : COPY-BLOCKS ( from# to# blkcount --- ) DEPTH 3 < 1 ?ERROR >R 2DUP < ( BEGIN DUP 0> ( more blocks? ) WHILE DUP NBUF MIN >R ROT R@ - ROT R@ - ROT R@ - R> 2OVER ROT LOAD-BUFFERS SAVE-BUFFERS ( Portable Comments ) : XSTANDARD ( reverse standardness ) LATEST BL TOGGLE ; : ?) ( DELIM --- ) BLK @ ( LOADING? ) IF BEGIN ( SEARCH FOR DELIMITER ) DUP WORD DUP C@ + 1+ C@ OVER = ( DELIM = ACTUAL DELIM? ) WHILE BLK @ BLOCK >IN @ + C@ 41 = ( NEXT CHAR = R.PAREN? ) IF 1 >IN +! ( SKIP R.PAREN ) DROP EXIT THEN ( FORTH-79 Enhancements begin ) : HEX 16 BASE ! ; HEX : C, HERE 1 ALLOT C! ; (( : ?ERROR ( T/F ERR# --- ) SWAP ( ERROR? ) IF CR ." *ERR# " DECIMAL . ABORT ELSE DROP THEN ; )) (( : 2* DUP + ; )) ( FORTH-79 Enhancements continue ) (( : HILO 0 100 U/MOD ; )) (( : SQUISH 100 * SWAP FF AND OR ; )) : >< HILO SWAP SQUISH ; : CARRAY ( #bytes --- ) ( # --- addr ) CREATE 1+ ALLOT DOES> + ; REPEAT ELSE R> BEGIN DUP 0> ( more blocks? ) WHILE DUP 2OVER ROT NBUF MIN LOAD-BUFFERS SAVE-BUFFERS ROT NBUF + ROT NBUF + ROT NBUF - REPEAT THEN DROP 2DROP ; REPEAT DROP THEN ; : (( ( ignore if 79-Standard, otherwise comment ) MODE @ 0= IF 41 ( R.PAREN ) ?) THEN ; IMMEDIATE : (& ( ignore if Non-standard, otherwise comment ) MODE @ IF 38 ( & ) ?) THEN ; IMMEDIATE : )) ; : &) ; ( dummies ) (( : 2/ 2 / ; )) : U2/ 2/ 7FFF AND ; : 2DUP OVER OVER ; : 2SWAP ROT >R ROT R> ; : 2OVER 4 PICK 4 PICK ; (( : 2DROP DROP DROP ; )) (( : DABS DUP 0< IF DNEGATE THEN ; )) (( : DLITERAL STATE @ IF SWAP [COMPILE] LITERAL [COMPILE] LITERAL THEN ; IMMEDIATE )) : ARRAY ( #words --- ) ( # --- addr ) CREATE 1+ 2* ALLOT DOES> SWAP 2* + ; : CTABLE ( #bytes --- ) ( # --- contents ) CREATE DOES> + C@ ; : TABLE ( #words --- ) ( # --- contents ) CREATE DOES> SWAP 2* + @ ; ( FORTH-79 Enhancements continue ) (( : STR$ ( D# --- STRING ) SWAP OVER DABS <# #S ROT SIGN #> ; )) (( : D.R ( D# WIDTH --- ) >R STR$ R> OVER - SPACES TYPE ; )) : S->D ( n --- d ) 0 OVER 0< - ; ( FORTH-79 Enhancements continue ) : 2! SWAP OVER ! 2+ ! ; : 2@ DUP 2+ @ SWAP @ ; : 2ROT 6 ROLL 6 ROLL ; : 2CONSTANT CREATE , , DOES> 2@ ; : 2VARIABLE CREATE 4 ALLOT ; : D- DNEGATE D+ ; ( FORTH-79 Enhancements end ) : ERASE 0 FILL ; : BLANKS BL FILL ; ( Non-standard double-number enhancements begin, UDN* ) CODE UDN* ( ud un --- ud ) HL POP, A 16 LD, EXX, DE POP, BC POP, IX 0 LD, HL 0 LD, 1 L: IX IX ADD, HL HL ADC, EXX, HL HL ADD, EXX, NCY 2 L# JR, IX BC ADD, HL DE ADC, 2 L: A DEC, NZ 1 L# JR, IX PUSH, HL PUSH, EXX, ( Non-standard double-number enhancements end, DN* D* ) : DN* ( d1 n --- d2 ) 2DUP XOR >R ABS >R DABS R> UDN* R> 0< IF DNEGATE THEN ; : D* ( d1 d2 --- d3 ) 3 PICK OVER XOR >R DABS ?DUP : .R ( n width --- ) >R S->D R> D.R ; : D. ( d --- ) 0 D.R SPACE ; : D+- ( d1 n --- d2 ) 0< IF DNEGATE THEN ; DECIMAL : D0= 0= SWAP 0= AND ; : D= D- D0= ; : DMIN 2OVER 2OVER D< 0= IF 2SWAP THEN 2DROP ; : DMAX 2OVER 2OVER D< IF 2SWAP THEN 2DROP ; : DU< ROT SWAP 2DUP U< IF 2DROP 2DROP 1 ELSE = IF U< ELSE 2DROP 0 THEN THEN ; NEXT JP, END-CODE IF 2SWAP DROP ABS ELSE >R DABS R> THEN UDN* R> 0< IF DNEGATE THEN ; ( String Enhancements begin ) (( CR ." ** WARNING ** (') is Non-Standard." HEX CR ." Compile-time: (') is compiled by " 22 EMIT ." (quote)" CR ." and is followed by a packed string." CR ." Run-time: (') pushes the string argument" CR ." ( --- addr len ) and passes flow-of-control" CR ." to the CFA following the string." )) HEX ( String Enhancements continue ) : S! ( string store ) ( str1 str2 --- ) DROP DUP 2- C@ ( max target length ) ROT MIN ( count ) DUP 3 PICK 1- C! CMOVE ; : STRING ( String Enhancements continue ) : STRING-ARRAY ( n-maxsiz n-dim --- ) CREATE 0 DO DUP C, 0 C, DUP ALLOT LOOP DROP DOES> ( n-index --> string ) DUP C@ 2+ ROT * + 1+ COUNT ; ( String Enhancements continue ) : LEN ( --- len ) SWAP DROP ; : MLEN ( --- max-len ) DROP 2- C@ ; : MID$ ( string n-start n-len --- addr len ) : (') ( run-time ) ( --- st-addr len ) R@ COUNT DUP 1+ R> + >R ; : " ( string literal ) ( --- temp-addr len ) 22 ( " ) STATE @ ( compile-time? ) IF COMPILE (') WORD C@ 1+ ALLOT ELSE WORD DUP C@ 1+ PAD SWAP CMOVE PAD COUNT THEN ; IMMEDIATE CREATE ( n-max --- ) 1 MAX FF MIN ( make string ) DUP C, 0 C, ALLOT ( max, current length ) DOES> ( --- st-addr len ) 1+ COUNT ; : SUB! ( str-from str-to --- ) ROT MIN 0 MAX CMOVE ; 00 STRING NULL$ >R OVER MIN 1 MAX 1- ( clip n-start ) SWAP OVER - ( clip n-len ) R> MIN >R + R> ; : RIGHT$ ( str-n-len --- substr ) OVER 1+ SWAP - 0FF MID$ ; : LEFT$ ( str-n-len --- substr ) 1 SWAP MID$ ; ( String Enhancements continue ) (( : S= ( str1 str2 --- str1=str2 ) ROT OVER = IF ( same length ) ?DUP IF ( not both null ) 1 SWAP 0 ( do each char ) DO DROP OVER C@ OVER C@ XOR 7F AND ( unequal? ) ( String Enhancements continue ) (& CODE S= ( str1 str2 --- str1=str2 ) EXX, BC POP, DE POP, ( len2 in BC, addr2 in DE ) HL POP, A C LD, L CP, ( len1 in HL, Z=1 if lengths same ) HL POP, NZ 2 L# JR, ( addr1 in HL, jp if lengths diff ) A OR, Z 2 L# JR, ( jp if lengths = 0 ) B C LD, ( get length into B ) ( String Enhancements continue ) (( : S< ( str1 str2 --- str1 >R ( len2 > min ) ?DUP ( neither is null? ) IF -1 SWAP 0 ( do each char ) DO DROP OVER C@ OVER C@ XOR 7F AND ( String Enhancements continue ) (& CODE S< ( str1 str2 --- str1=str2 ) EXX, BC POP, HL POP, DE POP, ( pop arguments ) B C LD, A E LD, B SUB, NCY 1 L# JR, B E LD, 1 L: AF AF' EX, DE POP, A B LD, A OR, Z 3 L# JR, ( String Enhancements continue ) : S+ ( str-from str-to-add-to --- ) >R OVER R@ + OVER 2- C@ MIN 2DUP SWAP 1- C! R> 1+ 0FF MID$ SUB! ; : CHR$ ( n --- str-of-len-1 ) PAD ! PAD 1 ; IF 0 LEAVE ELSE 1+ SWAP 1+ SWAP 1 THEN ( do next char ) LOOP ELSE ( both null ) 1 THEN ELSE ( unequal length ) DROP 0 THEN SWAP DROP SWAP DROP ; )) 1 L: A (DE) LD, DE INC, ( get char of str2 ) (HL) XOR, HL INC, ( compare char of str1 ) NZ 2 L# JR, 1 L# DJNZ, ( exit if different, loop if same ) 2 L: EXX, HL 0 LD, ( return FALSE if Z=0 ) NZ NEXT 1- JP, HL INC, NEXT 1- JP, ( else return TRUE ) END-CODE &) IF C@ 7F AND SWAP C@ 7F AND > LEAVE ELSE 1+ SWAP 1+ SWAP -1 THEN ( do next char ) LOOP ( -1 if no decision ) DUP 0< IF 2DROP DROP R> ELSE R> DROP THEN ELSE 2DROP R> THEN ; )) 2 L: A (HL) LD, HL INC, 7F AND, ( compare next chars ) C A LD, A (DE) LD, DE INC, 7F AND, C CP, NZ 4 L# JR, 2 L# DJNZ, ( loop if equal ) 3 L: AF AF' EX, 4 L: EXX, A 0 LD, H A LD, RLA, ( copy CY bit to flag ) L A LD, NEXT 1- JP, ( return & push HL ) END-CODE &) : ASC ( str --- ASCII-of-1st-char ) DROP C@ ; : VAL ( str --> double-precision-n ) >R PAD 1+ R@ CMOVE 0 PAD 1+ R> + C! 0 0 PAD CONVERT DROP ; ( String Enhancements continue ) (( : IN$ ( str1 str2 --> pos-str1-in-str2 ) DUP 4 PICK - ( len2 - len1 ) DUP 0> ( len2 > len1? ) IF SWAP OVER - ( str1 not NULL$ ) IF 0 SWAP 2+ 1 ( do by ch in str2 ) DO DROP 3 PICK C@ OVER C@ = ( match? ) IF 3 PICK 3 PICK 3 PICK ( String Enhancements continue ) (& CODE IN$ ( str1 str2 --> pos-str1-in-str2 ) EXX, BC POP, HL POP, DE POP, B E LD, DE POP, A B LD, A OR, Z 5 L# JR, A C LD, B SUB, NCY 1 L# JR, A XOR, 5 L# JR, 1 L: A INC, A INC, C 1 LD, 2 L: AF AF' EX, HL PUSH, DE PUSH, BC PUSH, ( String Enhancements end ) : GET$ ( n-max --- string ) ( inputs packed string at PAD ) PAD 1+ DUP ROT EXPECT 0 BEGIN 2DUP + C@ WHILE 1+ REPEAT SWAP 1- C! PAD COUNT ; ( /LOOP DLR 1-Jan-82 ) DECIMAL CODE (/LOOP) E 0 +IY) LD, D 1 +IY) LD, HL POP, HL DE ADD, 0 +IY) L LD, 1 +IY) H LD, E 2 +IY) LD, D 3 +IY) LD, DE HL EX, A OR, HL DE SBC, NCY ' BRANCH JP, ( ?FIND ) : ?FIND ( FIND with "unknown" error on failure ) FIND DUP 0= 0 ?ERROR ; OVER S= ( match ) IF I LEAVE ELSE 1+ 0 THEN ELSE 1+ 0 THEN LOOP ( try next char ) ELSE DROP 0 THEN ( scan complete ) >R 2DROP DROP R> ELSE DROP S= THEN ( len1 >= len2 ) ; )) 3 L: A (DE) LD, DE INC, (HL) XOR, HL INC, 7F AND, NZ 4 L# JR, 3 L# DJNZ, 4 L: BC POP, DE POP, HL POP, A C LD, Z 5 L# JR, HL INC, AF AF' EX, C INC, C CP, NZ 2 L# JR, A XOR, 5 L: EXX, L A LD, H 0 LD, NEXT 1- JP, END-CODE &) : INPUT$ ( --- string ) 40 GET$ ; : GET ( n --- d# ) GET$ VAL ; : INPUT ( --- d# ) 40 GET ; DECIMAL DE 4 LD, IY DE ADD, BC INC, BC INC, NEXT JP, END-CODE : /LOOP 3 - 11 ?ERROR COMPILE (/LOOP) HERE - , ; IMMEDIATE ( < HILO SWAP SQUISH ; : U2/ 2/ 7FFF AND ; : SWAPDROP SWAP DROP ; ( Some Auxiliary definitions end ) HEX : ACCEPT ( addr n --- ) ( builds packed string at addr ) >R 1+ DUP R> EXPECT 0 BEGIN 2DUP + C@ WHILE 1+ REPEAT SWAP 1- C! ; : YES/NO ." (Y/N)?" KEY DUP EMIT 59 = ; : READY? ." . READY(CR)?" KEY 0D = ; DECIMAL 3 L: A RR, L RR, NCY 4 L# JR, A H ADC, 4 L: A RR, L RR, NCY 5 L# JR, A H ADC, 5 L: A RR, L RR, NCY 6 L# JR, A H ADC, 6 L: A RR, L RR, NCY 7 L# JR, A H ADC, 7 L: A RR, L RR, NCY 8 L# JR, A H ADC, 8 L: A RR, L RR, NCY 9 L# JR, A H ADC, 9 L: A RR, L RR, H A LD, PUSH JP, END-CODE : RND ( --- n ) SEED @ 13 U* DROP HILO SWAP SQUISH 7 + DUP SEED ! ; : RANDOM ( n1 --- n2 ) ABS RND U* SWAP DROP ; : CARRAY CREATE 1+ ALLOT DOES> + ; : ARRAY CREATE 1+ 2* ALLOT DOES> SWAP 2* + ; : CTABLE CREATE DOES> + C@ ; : TABLE CREATE DOES> SWAP 2* + @ ; DECIMAL : ?TERMINAL ?KEY ; : VOC-LINK V-LINK ; : U.R >R 0 R> D.R ; : -FIND FIND DUP IF 2+ DUP NFA C@ 3F AND 1 THEN ; C/SL CONSTANT I/L DECIMAL ( CALL ass'y language from FORTH DLR 3 Jan 82 ) HEX 5 ARRAY Z80REG CODE CALL ( addr --- ) HL POP, 1 L# ) HL LD, BC PUSH, IY PUSH, HL 0 Z80REG ) LD, HL PUSH, AF POP, HL 1 Z80REG ) LD, DE 2 Z80REG ) LD, BC 3 Z80REG ) LD, (HANDY NOTATIONS for use with CALL ) : A! ( n --- ) 256 * 0 Z80REG ! ; : A. ( --- ) 0 Z80REG @ 256 / . ; : HL! ( n --- ) 1 Z80REG ! ; : HL. ( --- ) 1 Z80REG @ U. ; : DE! ( n --- ) 2 Z80REG ! ; : DE. ( --- ) 2 Z80REG @ U. ; ( PAUSE MS for various clocks ) : PAUSE ( wait on key, exit if ) KEY 13 = IF QUIT THEN ; ( Millisecond Delay for 4 MHz Z-80 ) : MS ( #-milliseconds-to-delay --- ) 0 DO 12 0 DO LOOP LOOP ; ( ASCII, >CHARS ) ( converts following char to ASCII code ) : ASCII ( --- C ) BL WORD 1+ C@ STATE @ IF [COMPILE] LITERAL THEN ; IMMEDIATE HEX ( convert string of bytes to string of chars ) ( Optimized CASE statement begins ) ( 79-STANDARD CASE ) ( n CASE n1 OF ... ENDOF n2 OF ... ENDOF otherwise ENDCASE ) HEX OPTIMIZER : CASE STATE @ 0= 9 ?ERROR CSP @ SP@ CSP ! 4 ; IMMEDIATE IX 4 Z80REG ) LD, IY 5 Z80REG ) LD, CD C, 1 L: 2 ALLOT 1 Z80REG ) HL LD, AF PUSH, HL POP, 0 Z80REG ) HL LD, 2 Z80REG ) DE LD, 3 Z80REG ) BC LD, 4 Z80REG ) IX LD, 5 Z80REG ) IY LD, IY POP, BC POP, NEXT JP, END-CODE DECIMAL : BC! ( n --- ) 3 Z80REG ! ; : BC. ( --- ) 3 Z80REG @ U. ; : IX! ( n --- ) 4 Z80REG ! ; : IX. ( --- ) 4 Z80REG @ U. ; : IY! ( n --- ) 5 Z80REG ! ; : IY. ( --- ) 5 Z80REG @ U. ; : REG. ( --- ) A. HL. DE. BC. IX. IY. ; ( Millisecond Delay for 3 MHz Z-80 ) : MS ( delay --- ) 0 DO 9 0 DO LOOP LOOP ; ( Millisecond Delay for 2.041 MHz Z-80, ie Softcard ) : MS ( delay --- ) 0 DO 5 0 DO LOOP LOOP ; ( by masking off high order bit ) : >CHARS ( addr n --- addr n ) 2DUP BEGIN DUP WHILE SWAP DUP C@ 7F AND OVER C! 1+ SWAP 1- REPEAT 2DROP ; DECIMAL : OF 4 - 0B ?ERROR COMPILE OVER COMPILE = COMPILE 0BRANCH HERE 0 , COMPILE DROP 5 ; IMMEDIATE : ENDOF 5 - 0B ?ERROR COMPILE BRANCH HERE 0 , SWAP 2 [COMPILE] THEN 4 ; IMMEDIATE ( Optimized CASE ends GODO ) : ENDCASE 4 - 0B ?ERROR COMPILE DROP BEGIN SP@ CSP @ - WHILE 2 [COMPILE] THEN REPEAT CSP ! ; IMMEDIATE ( FORTH-79 CASE PAW-1SEP81 ) VARIABLE (CASE) 5 2* ALLOT : :: : ; ( prevent recursion ) : : 0 (CASE) ! :: ; ( initialize ) : CASE 2 (CASE) +! 0 (CASE) DUP @ + ! ; IMMEDIATE : OF 1 (CASE) DUP @ + +! COMPILE OVER COMPILE = ( SCREEN ENVIRONMENT FOR APPLE CP/M BEGINS ) DECIMAL 40 ' C/SL ! 24 ' L/S ! HEX VARIABLE PV VARIABLE PH CREATE AKSAV 6 ALLOT CREATE (SCRFUN) HERE DUP 2- ! 0016 , 21 C, F397 , 19 C, 7E C, B7 C, C8 C, F2 C, HERE A + , F5 C, 3A C, F397 , CD C, HERE 3 + , ( SCREEN ENVIRONMENT FOR APPLE CP/M ENDS ) : (TINIT) 0 (CTL) ! ' CRTEMIT IOVEC 2+ ! 0B0B F3AC DUP @ AKSAV ! ! 0 F3AE DUP @ AKSAV 2+ ! ! 0202 F3B0 DUP @ AKSAV 4 + ! ! ; : (TDONE) 1 (CTL) ! ' STDEMIT IOVEC 2+ ! AKSAV @ F3AC ! AKSAV 2+ @ F3AE ! AKSAV 4 + @ F3B0 ! ; : (CV) : (GODO) 0 MAX 2+ 2* R@ 2+ 2+ @ MIN R@ + 2+ @ ; : GODO COMPILE (GODO) COMPILE EXECUTE COMPILE BRANCH HERE 0 , 2 ; IMMEDIATE DECIMAL [COMPILE] IF COMPILE DROP ; IMMEDIATE : ENDOF [COMPILE] ELSE ; IMMEDIATE : ENDCASE COMPILE DROP BEGIN (CASE) DUP @ + @ WHILE [COMPILE] THEN -1 (CASE) DUP @ + +! REPEAT -2 (CASE) +! ; IMMEDIATE F1 C, 5F C, 020E , C3 C, 0005 , CREATE CXY HERE DUP 2- ! E5FD , C5 C, 071E , CD C, ' (SCRFUN) , 3A C, ' PH , 67 C, 3A C, ' PV , 6F C, 3A C, F396 , B7 C, F2 C, HERE 5 + , 5D C, 6C C, 63 C, 5F C, 84 C, 67 C, 7B C, 85 C, E5 C, 5F C, 020E , CD C, 0005 , E1 C, 5C C, 020E , CD C, 0005 , C1 C, E1FD , C3 C, NEXT , 0 MAX L/S 1- MIN PV ! CXY ; : (CH) 0 MAX C/SL 1- MIN PH ! CXY ; CREATE (HOME) HERE DUP 2- ! E5FD , C5 C, 011E , CD C, ' (SCRFUN) , 21 C, 0000 , 22 C, ' PV , 22 C, ' PH , C1 C, E1FD , C3 C, NEXT , BELL) 7 EMIT ; DECIMAL ( SCREEN ENVIRONMENT FOR NORTHSTAR ADVANTAGE ) 80 ' C/SL ! 24 ' L/S ! VARIABLE PV VARIABLE PH HEX : (TINIT) 0 (CTL) ! ' CRTEMIT IOVEC 2+ ! ; : (TDONE) 1 (CTL) ! ' STDEMIT IOVEC 2+ ! ; : CXY 1B EMIT 3D EMIT PV @ 20 + EMIT PH @ 20 + EMIT ; : (CH) 0 MAX C/SL 1- MIN PH ! CXY ; : (CV) 0 MAX L/S 1- MIN PV ! CXY ; ( Screen Environment for TDL VDB video board ) 80 ' C/SL ! 24 ' L/S ! HEX : (TINIT) ( initialize terminal ) 0 (CTL) ! ' CRTEMIT IOVEC 2+ ! ; : (TDONE) ( release terminal ) 1 (CTL) ! ' STDEMIT IOVEC 2+ ! ; ( SCREEN ENVIRONMENT FOR LEAR-SIEGLER ADM-3 ) ( AND TELEVIDEO 910 ) 80 ' C/SL ! 24 ' L/S ! VARIABLE PV VARIABLE PH HEX : (TINIT) 0 (CTL) ! ' CRTEMIT IOVEC 2+ ! ; : (TDONE) 1 (CTL) ! ' STDEMIT IOVEC 2+ ! ; : CXY 1B EMIT 3D EMIT PV @ 20 + EMIT PH @ 20 + EMIT ; : (CH) 0 MAX C/SL 1- MIN PH ! CXY ; ( SCREEN ENVIRONMENT FOR PERKIN-ELMER BANTAM ) 80 ' C/SL ! 24 ' L/S ! HEX : (TINIT) 0 (CTL) ! ' CRTEMIT IOVEC 2+ ! ; : (TDONE) 1 (CTL) ! ' STDEMIT IOVEC 2+ ! ; : (CH) 0 MAX C/SL 1- MIN 1B EMIT 59 EMIT 20 + EMIT ; : (CV) 0 MAX L/S 1- MIN 1B EMIT 58 EMIT 20 + EMIT ; : (HOME) 1B EMIT 4B EMIT ; : (BELL) 07 EMIT ; ( SCREEN ENVIRONMENT FOR VECTOR FLASHWRITER 2 AND VECMON 4.x ) 80 ' C/SL ! 24 ' L/S ! VARIABLE PV VARIABLE PH HEX : (TINIT) 0 (CTL) ! ' CRTEMIT IOVEC 2+ ! ; : (TDONE) 1 (CTL) ! ' STDEMIT IOVEC 2+ ! ; : (HOME) 1E EMIT 0F EMIT 0 PV ! 0 PH ! ; : (BELL) 07 EMIT ; DECIMAL : (HOME) ( --- ) 0C EMIT ; : (CH) ( n --- ) 0 MAX 4F MIN D0 POUT ; : (CV) ( n --- ) 0 MAX 17 MIN C0 + D0 POUT ; : (BELL) ; DECIMAL : (CV) 0 MAX L/S 1- MIN PV ! CXY ; : (HOME) 1A EMIT 0 PV ! 0 PH ! ; : (BELL) 07 EMIT ; DECIMAL DECIMAL : CXY 1B EMIT PH @ EMIT PV @ EMIT ; : (CH) 0 MAX C/SL 1- MIN PH ! CXY ; : (CV) 0 MAX L/S 1- MIN PV ! CXY ; : (HOME) 04 EMIT 0 PV ! 0 PH ! ; : (BELL) ; DECIMAL ( SCREEN ENVIRONMENT FOR HEATH/ZENITH H/Z-19 AND H/Z-89 ) 80 ' C/SL ! 24 ' L/S ! VARIABLE PV VARIABLE PH HEX : (TINIT) 0 (CTL) ! ' CRTEMIT IOVEC 2+ ! ; : (TDONE) 1 (CTL) ! ' STDEMIT IOVEC 2+ ! ; ( EDITOR Control Table Builder words ) FORTH DEFINITIONS HEX ( define command code as HEX value ) : CMD ( n --- ) EDITOR FIND DUP 0= 0 ?ERROR SWAP CMDADR ! ; ( Control Char definitions for MicroPro Word Master emulation ) EDITOR HEX 00 CMD BELL ( ignore NULL ) CTRL A TLEFT ( move cursor left 5 char positions ) CTRL B C==> ( altenate cursor to begin. & end of line ) CTRL C FWD ( edit next higher numbered block ) CTRL D TRIGHT ( move cursor right 5 char positions ) ( Control Char definitions for MicroPro Word Master emulation ) CTRL M CCR ( move cursor to beginning of following line ) CTRL N SPLIT ( break the current line into 2 lines ) CTRL O LPOP ( insert line popped from "save" buffer ) CTRL P FLIP ( shift screen left/right if < 80 columns ) CTRL Q BELL ( ignore CTRL-Q ) CTRL R REV ( edit previous lower numbered screen ): CXY 1B EMIT 59 EMIT PV @ 20 + EMIT PH @ 20 + EMIT ; : (CH) 0 MAX C/SL 1- MIN PH ! CXY ; : (CV) 0 MAX L/S 1- MIN PV ! CXY ; : (HOME) 1B EMIT 45 EMIT 0 PV ! 0 PH ! ; : (BELL) 7 EMIT ; DECIMAL ( connect control-char to command-word ) : CTRL ( --- ) BL WORD 1+ C@ 40 - CMD ; DECIMAL CTRL E TUP ( move cursor up 5 lines ) CTRL F INSTOG ( toggle insert/replace mode ) CTRL G CDEL ( delete character under cursor ) CTRL H CLEFT ( move cursor left 1 char position ) CTRL I LCOPY ( push copy of current line to "save" buffer ) CTRL J CDOWN ( move cursor down 1 line ) CTRL K CUP ( move cursor up 1 line ) CTRL L CRIGHT ( move cursor right 1 char position ) CTRL S SCRFLUSH ( write current screen to disk block )(( CTRL T BELL )) ( ignore CTRL-T in standard version )(& CTRL T TLCLR &) ( clear "save" buffer ) CTRL U LMOVE ( push curr. line to "save" buff & delete it ) CTRL V JOIN ( replace all right of cursor w/ foll. line ) CTRL W BELL ( ignore CTRL-W ) CTRL X TDOWN ( move cursor down 5 lines ) CTRL Y BELL ( ignore CTRL-Y ) ( Control Char definitions for MicroPro Word Master emulation ) (( CTRL Z BELL )) ( ignore CTRL-Z in standard version )(& CTRL Z RENEW &) ( restore current screen from disk block ) 1B CMD BYE ( exit from editor back to FORTH interpreter ) 1C CMD BELL ( ignore CTRL-\, FS ) CTRL ] BLKLOAD ( exit editor to FORTH & LOAD current screen ) 1E CMD DOGGLE ( alternately move cursor to top & bottom ) ( EDITOR Control Table Builder words ) FORTH DEFINITIONS HEX ( define command code as HEX value ) : CMD ( n --- ) EDITOR FIND DUP 0= 0 ?ERROR SWAP CMDADR ! ; ( Control Char definitions for Apple-based editor ) EDITOR HEX 0 CMD BELL CTRL A TLEFT CTRL B C==> CTRL C CDOWN CTRL D DOGGLE CTRL E CUP ( Control Char definitions for Apple-based editor ) CTRL N BELL ( [ VIA KEY ) CTRL O LPOP CTRL P INSTOG CTRL Q SCRFLUSH CTRL R REV CTRL S CLEFT CTRL T FLIP ( Control Char definitions for Apple-based editor ) 1B CMD BYE 1C CMD BELL ( N/A ON APPLE ) CTRL ] BLKLOAD CTRL ^ JOIN 1F CMD SCLR ( N/A ON APPLE ) BL CMD CHROUT ( ALL OTHER CHARS ) 1F CMD SCLR ( clear current screen image, in memory only ) 20 CMD CHROUT ( vector for all printable chars ) 21 CMD C<== ( RUBOUT, delete character left of cursor ) DECIMAL FORTH FORGET CMD ( connect control-char to command-word ) : CTRL ( --- ) BL WORD 1+ C@ 40 - CMD ; DECIMAL CTRL F CRIGHT CTRL G TRIGHT CTRL H C<== CTRL I SPLIT CTRL J CDEL CTRL K LMOVE CTRL L LCOPY CTRL M CCR CTRL U BELL ( N/A VIA KEY ) CTRL V FWD CTRL W TUP CTRL X TDOWN (( CTRL Y BELL ( UNUSED) )) (& CTRL Y TLCLR &) (( CTRL Z BELL ( UNUSED) )) (& CTRL Z RENEW &) 21 CMD C<== ( DELETE ) DECIMAL FORTH FORGET CMD ( IBIS/CRAY BANNER FOR DTC ) : TEST BELL CR CR CR CR CR 10 SPACES ." $$$ $$$ $$$ $$$$$$ $$$$$ $$$$$$ $$$$ $$ $$ "CR 10 SPACES ." $$$ $$$ $$$ $$$ $$ $$ $ $$ $$ $ $ " CR 10 SPACES ." $$$ $$$ $$ $$ $$$ $$ $$ $ $ " CR 10 SPACES ( IBIS/CRAY BANNER CONTINUE ) CR CR CR CR CR 20 SPACES ." $$$$$$$ $$$$$$$$$$ $$ $$ " CR 20 SPACES ." $$ $$ $$ $$ $$ " CR 20 SPACES ." $$ $$ $$ $$ $$ " CR 20 SPACES ." $$ $$ $$ $$ $$ " CR 20 SPACES ." $$ $$ $$ $$ $$" CR 20 SPACES ." $$ $$ $$ $$ $$ " d(c) Copyright 1981, Computalker Consultants o g^#V_ o gNEXECUTtUNEXhOBRANCx`i^#V+MDO0BRANCȃ}ʎO4¼4~~Oznfut^VROnfut^VR srsrO<f= / #6= fN SIGE]-N\3 O ] h ]]0N#swwCRTEMIԝO:{a8{0 _ɦLPEMIԴO* #"  # 0!_!M8,^#Vz !NENCLOSN}+#(~ O#( ~ OOBDOBMNBIO|}=o_*"DM_WMCMOVŔx(OMOV2)N2,NHIL!jTMSQUIS (cNU5D}QgxDQJ UlgN!)0 ɅU/MO.k}|8!T] >))00BB0 = OANa{ozgNOҢ{ozgNXOҵ{ozgNSP!9NSP{ ORP ." $$$ $$$$$$ $$$ $$$ $$$ $$ $$$$ $$ $$ $$ " CR 10 SPACES ." $$$ $$ $ $$$ $$$ $$ $$ $ $$$$$$ $$ " CR 10 SPACES ." $$$ $$ $ $$$ $$$ $$ $$ $$ $$ $$ $$ " CR 10 SPACES ." $$$ $$$$$$ $$$ $$$$$$ $$$$$ $$ $$ $$$ $$$ $$ " --> CR 20 SPACES ." $$$$$$$ $$ $ " CR ;S ɧSTDEMIO* #" ͣ:h }_:{ a8{0 _ ! CC~(_#_:iW:0 STD?KEOͣ(>_ɦSTDKEjOͣ(_>2{DMO: (V_*|(J: (>(C: (>(8> *} { :iO(>2i> _:h(>2h{2IOVEÁ v?KE18O*$EMI(ELO*"KE<X_O* CP] C] C(CTL-Cc(CTLx(:+p+qKBO(CON^#VO(VARODIGIԽ{0  _!MlN(FINDORP * O;N#F#OLEAV2^VsrO>(H++srORA]^#V#ORV\ 0ky}!N#NNOry0)!N#N0+)!N#NNDJODRBONEGAT!RNDNEGAT!B!RO2OVE0!9V+^+~+ngM2DRO&IO2SWA?XO2DUNmMPICd}T]+)|9^#VOROLt+)8DM9^#V!ODEPTȏ* r|/g}oN+~w#~wOTOGGL~wO^#VOC n&N2  ^#V^#VO 1 s#rOC+ @ sO29 M s#r#s#rOF  ]  /  G /   / ] Z  N ] G D  R h n]  NOOЎ CONSTAN ] ]- - VARIABL  -   !N ! !N - !N' 9 !NB3  C/? @FIRSH {LIMIR HIME^ t !|9NSj n{CS{ n{R {TIŽ r{WIDTȗ FENCš ADЭ AV-LIN˹ 4BL >I OU SC CONTEX h LATES  LF ]N CF& NF6 ]N ] PF>  ]!CST  / ?ERROh  * " !rg?oN?WORy y w] COMPILŭ  w] [ F-    /  ] / HE ]3 / DECIMA ] 3 / (;CODE[ Z < / DOES3 = ii+p+q####MDOCOUNO{  TYP~zO^#L{¤O-TRAILINǒ,   ]D N 0 p 3 3 3 3 3[[[F[FIND y w]   <  ID7{ Z , N  CREAThD  D hn]  O{ ] ] -  / ]- [COMPILE݄D y w]  Z , w < - LITERA  ]- DLITERA ##?STAC5    ] ] INTERPRERD y $7 {D  \  G,  . h D  G  G > < - < r[    ]\S->zbMABDAB MI4k MAIkh M_kF&&3[MuFFp&i[p[3/MOkF[ iMO*/MOFz[*$,M/MO8F pi[Fi[(LINEGN 3 N MSe ]O  {  ER҂unknown empty stackdictionary fullbad arg not uniquetoo farblock R/ן]&rSTDR/*}] ,)))>"2o"}:\=_:oO\2!# O!DISK-ERROSAVE-BUFFERpZ   ] /  LOAā F F /  / [ / [ / -- /   THR h{ ].CZ 'D  w #FORGEHL 'FORGEfL BEGIy  THEΏ w] ] N / Dϟ  7 LOO7 N ]  N - +LOO CURREN STAT SCRLE dBAS  HL, ANS7 MODA K \ ^VOV l ^VO1f } #N2v ##N1 +N2 ++NHERś  ALLOԨ  + D   ] F p  /  Z , p  /  w[ /   / + C)  >  9 P RNJ N wX j zs R$%~ !N!NUd RgoND RRgoN h ROԯ MSPACŻ D C?DU TRAVERS ]{ [F. ]"N (]"  y { y EXPEC  h G V]\ [ FC FH]\ [G]F]#Ch&] \  0CZ / QUERO ]PX / [FILx(s# OERAS  BLANK&D HOL6]= = > PAG ]TWOR`L N ]P ]PN ]PFp >  { [{  INr    CONVERԹ{  ]-\ F{ F.\ F D D N  [@#[`IMMEDIAT ]@VOCABULAR/]- ]- - / =i  / FORTGrADEFINITION~  / ] ]) EXIԨ (*QUIT /  w OK/  / h(*CTL-CABOR 4';QUINr(QUIT4aOWARE$COLX]j]/ ]]P/ ]/ ]  / ]v / ]]/ $LASTc(  %Last available screen is # }h(BOOT\>BYnot available stack full disk errorcompilation onlyexecution only conditional? unfinished protected not FORTH-79 delimiter?ERRh  ?   ;PI~h&OPOUԩiOPREּNBU+BU]f wZ UPDAT]/ EMPTY-BUFFERZ f N  Z / Z  ]/ BUFFE$ ] / / BLOCb(  w] Z  N w0 k   / 7 N ]  N - UNTI ]  N - REPEAFF ]  N - [[ I6   - + ELSa ]   - + + WHILvf SPACEӛ e    OVEҫMDROOSWANDUNSTR;; cJD.F [N .F[$D6 $ G N  $ VZUl  $ LISx / h Screen # Z] hZ nh!R" } ( wf*"h :2GR"\ " |" +w+w+w+w" :_#~ (_>._!e~# (__$_fFORTH-79 requires CP/M v 2.0 or later. $Screen file not found. Should the file $ be created? (Y/N) $ No screen file present. $Device  =iCTABL =i TABL!=iC/S*!@L/F!SEVEQ!! TINI[!]e!rTDONq!]g!rCȅ!]i!rC֙!]k!rHOMŪ!]m!rBEL̻!]o!rVLIS! / h /   ] M!7 N  h / n Z , w/VhASSEMBLE!rJ4]REƈLDEa"!"ńAREl"! syntax$?OPER$operand$?L#ER% h ] label #$?DEFER,%s" dup label$LY%5%c%s" /  "F/ [  /  # F/  [ N   N > L%5%s"    h"$ h"/ DW%h"5%s"$" /  h"/ - E-2&h".5%s"$ # /  N  h"/  N ]]rel addr$> REM&> =i # #/ #/ ³&&&&&&&&&(C((P)( P )(()(0)(8?T=!)]N %?]CL()############$ $$h"%8;)N8)]%> S8)]]%> ?]+)# ) #/ ?]+D)F)[1BY*> =i > C)2BY*> =i ]> > C)GET0*# 0DQ* #/  #/ 0DQXl*r* $/  $/ DO.҂*#N %> ) #/ DO.R*##/  #/ *DO.Rӽ*#* ]F> )DO#\ %)]> *) #/ #P#w%#\ )Fp] \  ] ]> ]C[> #& #/ >#\ ] N ]0N %]> #{ N %{ > #&*C)ADD,#l#N % $ $% \  ] \ %0$ \ ] \ %$w ] N %] H+*]$+C)ADC-#]> ]JH+]$+C)SBCA.#]> ]BH+]$+C)SUBl.]+AND.]+XOR.]+OR.]+CP.]+INC.# ]ddirectory full. $Initializing screen file ... $Screen file is $FORTH SCR79-STANDARĉ R / ] / OPTIMIZEL R / SAVl]]/ x / ] 'h After the CP/M prompt '>', type:h SAVE Z FORTH.COMXSTANDARĄ D ? @y {  \ (   ])\   ( R w]) (W R ]& )p & BӐ > &U2 ]SWAPDROб CARRA { =iARRA { "8RREƷ"! „(0L#]   Z s"/  Z "/  Z #/  h"/ ]M#]DĂ#]Qы#](DD#]R#]##]+ĵ#]Cÿ#]C#]S#]I#](C#]A#]I#]I$]CL$ #/  #/  #/  #/  #/  #/  #/  #/  #/  #/  #/  $/  $/  $/  #/ CODM"T#!$ / Y" / ;COD$T# N ] =Y" PUS$NASMER$ error G  ;?SYNER$&&&(HL'& '&(C']> #/ DDQ'> =i #/ #/ B0'?'DS'?'H['?' Ac']0#/ Sk']0#/ AF~' $/ Iؑ' $w]>  $h'I١'$w]>  $h'(IX']> '(IY']> '+IX'' #/ +IY (' #/ (BC(]#/ (SP/(]#/ (DED(]#/ Y(#/ In(]> ]#/ |(]> ]#/ CXҕ(> =i  #/  #/ Cح(> =i  #/ N((((NC(.RS*# #*C)DO.A*FX*/)[##/  #/ *DO.H+ ] N %> r*DO.D@+#N %> *DO.S\+]> # F *[ #*C)DO.Sx+X*]%)]#+DO.QѦ+#N %> *C)COND+  #/  #/ > LD+##<# #\ F[]\ ]\ %)]@*#,#\  /) >  ] > /) #/ #0#\ /)]2> #& ]:> #&/) #/ R#0#\ /)]G>  ]W> /) #/ +)] #*C)DEC.# ] d+)] #*C)RLC/]+RRCD/]+RLU/]+RRf/]+SLAv/] +SRA/](+SRL/]8+BIT/]@+RES/]+SET/]+JP/# ]N #%]>  #/ ] #+#&C)JR/] ]#+T&C)DJNZ*0]> T&C)CALLD0]] #+#&C)RETZ0 ]] #+C)RSTv0]8]> C)DO.(N0FFpN #N  #pN N %[/)[> ) #/ DO.(C0F#N pN #N ]\ %)[]@>  #/ IN0# ]0 0 #/ C)OUT81# ]0 0 #/ C)EXd1#N % #/ #"] N %>  #/  $/  $/ :$]0N %]>  $/ ] N ]N %]>  #/ C)PUSH1]+POP2]+RLCA%2$*RRCA62$*RLAA2$*RRAL2$*DAAV2$*'CPL`2$*/SCFj2$*7CCFt2$*?NOP~2$*HALT2$*vEXX2$*كDI2$*EI2$*IM2]> { )]F> NEG2?*DRETN2?*ERETI2?*MRRDH4HOF5INSFL 5NEWFL5TLS$5TLOR15CMDAD<5!!88;88;8`8>;P8>8s8,89:7!<. 4 55C<=85 `8 5 8D 8CHROU94 5  55 { 45 N o44 5585 4h s8!(LINSA94h  nn SPLIԎ94 { 4 5 !<955 N 5 N 5N D 5N 5 D 6(LDEL94h { nn{ 4nD JOI#:4 4h >{ nN 5 N 55 N 5 N ,:6!,:6LPOZ:85N N D5 *54 95N 85/ 6!!!  5/ 7 5/  P6 7w HELLϤ=h#FORTH-79 Double-Number Version 2.0h#MicroMotion 12077 Wilshire #506h#Los Angeles, CA 90025 213-821-4340hCopyright (c) 1981hGϺ==_TURNKEW>=]/ ONERf>=]P/ (INDEX|>( h h7 ; ]@INDEؐ> / { Z >/V0hTRIA>  Now in base 'Zh3 / .@3  k\ h hG2hZ ']; ( ]$H)+ h3 / @SAVE system should be saved as FORTH79C.COM" " |" +w+w+w+w"   5/  5/  4/ o7PU755 > C5CC 8 6 7CU&8]6CDOW88 6CLEFH8]W7CRIGHX8 W7TUj846TDOW{846TLEFԋ84W7TRIGHԛ84W7C==85N 5  7CDE̾8D 55 { 45(LCOPY:85N r 585N N 85!LCOP; ;,8LMOV6; ;4 ,:6DOGGLF;5 4  4P65   76 75INSTO\; 5w 5/  64  455SCLҙ; b4D 6FW; 7RE;] 7BY; 4/ 7SCRFLUS<765BLKLOA#<< RENE:<]/ 7TLCLP<f]TD5/ 85/ EDITSCh<p<  4/  / 5 54 D \ !V4> ]N  D O]!Q5r4 EDIԈ4y!! // h7 7 7 hZ ( h Z /0hLPO>] / LPOF8?]  / LPINDEM? / ?? hhZ k];OZ >/0 ]=h] C/V0]<]=U?LPTRIAc? / ??[7 7 FZ >] C/V07 ]=U?DUM?3 M!]I ]]]h7 {h]] Z 7 ;h ]]{N hZ  ]$ ]Z Z Z  7 ; ]=+ ]Z Z Z  ]D h ]\ ].C ]=]]=h3 / . @3 d(c) Copyright 1981, Computalker Consultants o g^#V_ o gNEXECUTtUNEXhOBRANCx`i^#V+MDO0BRANCȃ}ʎO4¼4~~Oznfut^VROnfut^VR srsrO<f= / #6= fN SIGE]-N\3 O ] h ]]0N#swwCRTEMIԝO:{a8{0 _ɦLPEMIԴO* #"  # 0!_!M8,^#Vz !NENCLOSN}+#(~ O#( ~ OOBDOBMNBIO|}=o_*"DM_WMCMOVŔx(OMOV2)N2,NHIL!jTMSQUIS (cNU5D}QgxDQJ UlgN!)0 ɅU/MO.k}|8!T] >))00BB0 = OANa{ozgNOҢ{ozgNXOҵ{ozgNSP!9NSP{ ORPOC n&N2  ^#V^#VO 1 s#rOC+ @ sO29 M s#r#s#rOF  ]  /  G /   / ] Z  N ] G D  R h n]  NOOЎ CONSTAN ] ]- - VARIABL  -   !N ! !N - !N' 9 !NB3  C/? @FIRSH {LIMIR HIME^ t !|9NSj n{CS{ n{R {TIŽ r{WIDTȗ FENCš /DЭ /V-LIN˹ "BL >I JOU SC CONTEX h LATES  LF ]N CF& NF6 ]N ] PF>  ]!CST  / ?ERROh  * " !rg?oN?WORy y w] COMPILŭ  w] [ F-    /  ] / HE ]3 / DECIMA ] 3 / (;CODE[ Z < / DOES3 = ii+p+q####MDOCOUNO{  TYP~zO^#L{¤O-TRAILINǒ,   ]D N 0 p 3 3 3 3 3[[[F[FIND y w]   <  ID7{ Z , N  CREAThD  D hn]  O{ ] ] -  / ]- [COMPILE݄D y w]  Z , w < - LITERA  ]- DLITERA ##?STAC5    ] ] INTERPRERD y $7 {D  \  G,  . h D  G  G > < - < r[    ]ɧSTDEMIO* #" ͣ:h }_:{ a8{0 _ ! CC~(_#_:iW:0 STD?KEOͣ(>_ɦSTDKEjOͣ(_>2{DMO: (V_*|(J: (>(C: (>(8> *} { :iO(>2i> _:h(>2h{2IOVEÁ v?KE18O*$EMI(ELO*"KE<X_O* CP] C] C(CTL-Cc(CTLx(:+p+qKBO(CON^#VO(VARODIGIԽ{0  _!MlN(FINDORP * O;N#F#OLEAV2^VsrO>(H++srORA]^#V#ORV\ 0ky}!N#NNOry0)!N#N0+)!N#NNDJODRBONEGAT!RNDNEGAT!B!RO2OVE0!9V+^+~+ngM2DRO&IO2SWA?XO2DUNmMPICd}T]+)|9^#VOROLt+)8DM9^#V!ODEPTȏ* r|/g}oN+~w#~wOTOGGL~wO^#V CURREN STAT SCRLE dBAS  HL, X/NS7 MODA K \ ^VOV l ^VO1f } #N2v ##N1 +N2 ++NHERś  ALLOԨ  + D   ] F p  /  Z , p  /  w[ /   / + C)  >  9 P RNJ N wX j zs R$%~ !N!NUd RgoND RRgoN h ROԯ MSPACŻ D C?DU TRAVERS ]{ [F. ]"N (]"  y { y EXPEC  h G V]\ [ FC FH]\ [G]F]#Ch&] \  0CZ / QUERO ]PX / [FILx(s# OERAS  BLANK&D HOL6]= = > PAG ]TWOR`L N ]P ]PN ]PFp >  { [{  INr    CONVERԹ{  ]-\ F{ F.\ F D D N  [@#[`IMMEDIAT ]@VOCABULAR/]- ]- - / =i  / FORTGr.DEFINITION~  / ] ]) EXIԨ (*QUIT /  w OK/  / h(*CTL-CABOR 4';QUINr(QUIT4aOWARE$COLX]j]/ ]]P/ ]/ ]  / ]v / ]]/ $LASTc(  %Last available screen is # }h(BOOT+BY\S->zbMABDAB MI4k MAIkh M_kF&&3[MuFFp&i[p[3/MOkF[ iMO*/MOFz[*$,M/MO8F pi[Fi[(LINEGN 3 N MSe ]O  {  ER҂unknown empty stackdictionary fullbad arg not uniquetoo farblock R/ן]&rSTDR/*}] ,)))>"2o"}:\=_:oO\2!# O!DISK-ERROSAVE-BUFFERpZ   ] /  LOAā F F /  / [ / [ / -- /   THR h{ ].CZ 'D  w #FORGEHL 'FORGEfL BEGIy  THEΏ w] ] N / Dϟ  7 LOO7 N ]  N - +LOO" +w+w+w+w" :_#~ (_>._!e~# (__$_fFORTH-79 requires CP/M v 2.0 or later. $Screen file not found. Should the file $ be created? (Y/N) $ No screen file present. $Device  =iCTABL =i TABL!=iC/S*!@L/F!SEVEQ!! TINI[!]e!rTDONq!]g!rCȅ!]i!rC֙!]k!rHOMŪ!]m!rBEL̻!]o!rVLIS! / h /   ] M!7 N  h / n Z , w/VhB/BU!(LINEM" N 3N  GEDITOx"r?*MARGIΈ TA"L/BL"L/BLK-"N B$$BOT-SHO$8# $ALL-SHO% $&% e #OA#/ L# N #h $#"N A#  3N #N OL#/ 1%$H9%A# =%ALL-SHOW%1%"W! O! !SCR# ]; $FLIМ%L# #=%L# \  =%$CURBO%"! !hRDBL%& W!"\ f#>  L#/  A#/  8#/ %PU&#A# > C$CCC& $ =%CU_&]$CDOWq& $CLEFԁ&]%CRIGHԑ& %TUУ&"$TDOWδ&"$TLEF&"%TRIGH&"%C==&not available stack full disk errorcompilation onlyexecution only conditional? unfinished protected not FORTH-79 delimiter?ERRh  ?   ;PI~h&OPOUԩiOPREּNBU+BU]f wZ UPDAT]/ EMPTY-BUFFERZ f N  Z / Z  ]/ BUFFE$ ] / / BLOCb(  w] Z  N w0 k   / 7 N ]  N - UNTI ]  N - REPEAFF ]  N - [[ I6   - + ELSa ]   - + + WHILvf SPACEӛ e    OVEҫMDROOSWANDUNSTR;; cJD.F [N .F[$D6 $ G N  $ VZUl  $ LISx / h Screen # Z] hZ nh!R" } ( wf*"h :2GR"\ " |directory full. $Initializing screen file ... $Screen file is $FORTH SCR79-STANDARĉ R / ] / OPTIMIZEL R / SAVl]]/ x / ] 'h After the CP/M prompt '>', type:h SAVE Z FORTH.COMXSTANDARĄ D ? @y {  \ (   ])\   ( R w]) (W R ]& )p & BӐ > &U2 ]SWAPDROб CARRA { =iARRA { C/L-"?C/SL#@LK#EXITFL#V%#H3#HOF<#INSFLE#NEWFLP#TLS]#TLORj#CMDADu#!!&&)&&)!'&-)&w&&e&((%!)*!=)(!&!!*!3*T))'X'LADҁ#8# b"?FUL#"b"RCH#A# L# N 8# !!LN-SHO#! !b"L# #.INS$Y# 98#  " $  $"! ! * INSERT *A# L# N !:$8# w e"O8#/ wf#  " $ f#/ B$$V$8# $(BOT-SHOW$b"L# " Z ! !##N A#  =%CDE&D #A# {  #A# N  #> 8# $$C<='A# &Y# !'D I&CHROUQ'!# Y#  #A# { #A# N "8# $$I&A# #h &!(LINSz'"h  b"b" SPLI'8# { " # !<'#A# N A# N #N D #N A# D %(LDEL'"h { b"b"{ "b"D JOI\(8# "h >{ b"N A# N #A# N A# N e(%!e(%LPOГ(#8# 'f#N %(LCOPY(#fN LCOP))e&LMOV%))8# e(%DOGGL5)A# 8#  "$L#   =%1% =%$INSTOK)Y#wY#/ B$8#  " $$SCL҈) U"D 1%FWĿ) &RE)] &BY) /#/ &SCRFLUS*&1%$BLKLOA** EDITSC)* /#/  / Y# # # D \ !V!#> ]N  D O]!#r/# EDI"y!! /  Y#/ & L#/  $ =%I*!(/LOOP**^Vut^VRҎZ k];OZ ,/0 *h] C/V0]<*,LPTRIA, / ,[7 7 FZ y,] C/V07 *,DUMD-3 M!]I ]]]h7 {h]] Z 7 ;h ]]{N hZ  ]$ ]Z Z Z  7 ; *+ ]Z Z Z  ]D h ]\ ].C *]*h3 / .ˆ-3  Now in base 'Zh3 / .q.3  k\ h hG2hZ ']; ( ]$H)+ h3 .SCOPY V2.1 Copyright (c) 1981, MicroMotion $1J } ( J͹͹*R|??2<2p!82( ͹"!8(( "*͹!!͹G|("(:(Ͳ͸ *L͸ **R0L͹:_*R0*"Q}**R"| ͹:bk #6 #6!~:ͩ (ͩ>.ͩ~# (ͩů2>2N#F#>< 8N#F# O:2> (>0ͩ:= >0ͩ'd _ CSCOPY requires CP/M v 2.0 or later. $ Enter source screen-file name: $OK (Y/N) ? $Requested source file not found $Enter destination screen-file name: $Creating new destination fi ng to $ in destination file $ (extending destination file by $ screens) $FROM+COUNT exceeds source file length $An I/O error has occurred $reading screen$ from source file $writing screen$ to destination file $xceeds source file length $An I/O errorO/LOO*7 N ] * N - ?FIN+>w HELL#+h#FORTH-79 Double-Number Version 2.0h#MicroMotion 12077 Wilshire #506h#Los Angeles, CA 90025 213-821-4340hCopyright (c) 1981hG9+A+_TURNKE+++]/ ONER+++]P/ (INDEX+( h h7 ; ]@INDE, / { Z ,/V0hTRIAC, / h7 7 7 hZ ( h Z /0hLPOq,] / LPOFƷ,]  / LPINDE, / , hh/ v.SAVE system should be saved as FORTH79E.COM")] #*C)RLC/]+RR47D/]+RLU/]+RRf/]+SLAv/] +SRA/](+SRL/]8+BIT/]@+RES/]+SET/]+JP/# ]Z Z Z  7 ; *+ ]Z Z Z  ]D h ]\ ].C *]*h3 / .ˆ-3  Now in base 'Zh3 / .q.3  k\ h hG2hZ ']; ( ]$H)+ h3 V͹͹!6 #* +| =V͹*!ͩ(͹͹<**"*"ͩ(͹͹<**")))"! "s#r#6"*^!"*)))*:O* *^#Vr+s*"+| t͹<*^#VͿͿͿU͹G"""͹*U͹**"+U͹*U͹**"+U͹*R0͹**RU@͹͹!~ =#~Y(ybkPp#6 ͹x(+!:00le $ How many screens should be allocated? $No room in directory for new file name $The disk is full. $Source file is $ Destination file is $ $Initializing new screen file ... $ Enter from, to, count: $Copy screens $ thru $ from source file writing to $ in destination file $ (extending destination file by $ screens) $FROM+COUNT exceeds source file length $An I/O error has occurred $reading screen$ from source file $writing screen$ to destination file $xceeds source file length $An I/O error2 (c) Copyright 1981, Computalker Consultants o g^#V_ o gNEXECUTtUNEXhOBRANCx`i^#V+MDO0BRANCȃ}ʎO4¼4~~Oznfut^VROnfut^VR srsrO<f= / #6= fN SIGE]-N\3 O ] h ]]0N#swwCRTEMIԝO:{a8{0 _ɦLPEMIԴO* #"  # 0!_!M8,^#Vz !NENCLOSN}+#(~ O#( ~ OOBDOBMNBIO|}=o_*"DM_WMCMOVŔx(OMOV2)N2,NHIL!jTMSQUIS (cNU5D}QgxDQJ UlgN!)0 ɅU/MO.k}|8!T] >))00BB0 = OANa{ozgNOҢ{ozgNXOҵ{ozgNSP!9NSP{ ORPOC n&N2  ^#V^#VO 1 s#rOC+ @ sO29 M s#r#s#rOF  ]  /  G /   / ] Z  N ] G D  R h n]  NOOЎ CONSTAN ] ]- - VARIABL  -   !N ! !N - !N' 9 !NB3  C/? @FIRSH LIMIR ťHIME^ t !|9NSj nCS{ nR TIŽ rWIDTȗ FENCš UDЭ UV-LIN˹ 4BL >I OU 2SC UCONTEX h LATES  LF ]N CF& NF6 ]N ] PF>  ]!CST  / ?ERROh  * " !rg?oN?WORy y w] COMPILŭ  w] [ F-    /  ] / HE ]3 / DECIMA ] 3 / (;CODE[ Z < / DOES3 = ii+p+q####MDOCOUNO{  TYP~zO^#L{¤O-TRAILINǒ,   ]D N 0 p 3 3 3 3 3[[[F[FIND y w]   <  ID7{ Z , N  CREAThD  D hn]  O{ ] ] -  / ]- [COMPILE݄D y w]  Z , w < - LITERA  ]- DLITERA ##?STAC5    ] ] INTERPRERD y $7 {D  \  G,  . h D  G  G > < - < r[    ]ɧSTDEMIO* #" ͣ:h }_:{ a8{0 _ ! CC~(_#_:iW:0 STD?KEOͣ(>_ɦSTDKEjOͣ(_>2{DMO: (V_*|(J: (>(C: (>(8> *} { :iO(>2i> _:h(>2h{2IOVEÁ v?KE18O*$EMI(ELO*"KE<X_O* CP] C] C(CTL-Cc(CTLx(:+p+qKBO(CON^#VO(VARODIGIԽ{0  _!MlN(FINDORP * O;N#F#OLEAV2^VsrO>(H++srORA]^#V#ORV\ 0ky}!N#NNOry0)!N#N0+)!N#NNDJODRBONEGAT!RNDNEGAT!B!RO2OVE0!9V+^+~+ngM2DRO&IO2SWA?XO2DUNmMPICd}T]+)|9^#VOROLt+)8DM9^#V!ODEPTȏ* r|/g}oN+~w#~wOTOGGL~wO^#V CURREN STAT SCRLE VBAS  HL, VNS7 MODA K \ ^VOV l ^VO1f } #N2v ##N1 +N2 ++NHERś  ALLOԨ  + D   ] F p  /  Z , p  /  w[ /   / + C)  >  9 P RNJ N wX j zs R$%~ !N!NUd RgoND RRgoN h ROԯ MSPACŻ D C?DU TRAVERS ]{ [F. ]"N (]"  y { y EXPEC  h G V]\ [ FC FH]\ [G]F]#Ch&] \  0CZ / QUERO ]PX / [FILx(s# OERAS  BLANK&D HOL6]= = > PAG ]TWOR`L N ]P ]PN ]PFp >  { [{  INr    CONVERԹ{  ]-\ F{ F.\ F D D N  [@#[`IMMEDIAT ]@VOCABULAR/]- ]- - / =i  / FORTGrPDEFINITION~  / ] ]) EXIԨ (*QUIT /  w OK/  / h(*CTL-CABOR 4';QUINr(QUIT4aOWARE$COLX]j]/ ]]P/ ]/ ]  / ]v / ]]/ $LASTc(  %Last available screen is # }h(BOOT\>BY\S->zbMABDAB MI4k MAIkh M_kF&&3[MuFFp&i[p[3/MOkF[ iMO*/MOFz[*$,M/MO8F pi[Fi[(LINEGN 3 N MSe ]O  {  ER҂unknown empty stackdictionary fullbad arg not uniquetoo farblock R/ן]&rSTDR/*}] ,)))>"2o"}:\=_:oO\2!# O"DISK-ERROSAVE-BUFFERpZ   ] /  LOAā F F /  / [ / [ / -- /   THR h{ ].CZ 'D  w #FORGEHL 'FORGEfL BEGIy  THEΏ w] ] N / Dϟ  7 LOO7 N ]  N - +LOO" +w+w+w+w" :_#~ (_>._!e~# (__$_fFORTH-79 requires CP/M v 2.0 or later. $Screen file not found. Should the file $ be created? (Y/N) $ No screen file present. $Device  =iCTABL =i TABL!=iC/S*!PL/F!SEVEQ!!EE@E[ExEETINI[!]e!rTDONq!]g!rCȅ!]i!rC֙!]k!rHOMŪ!]m!rBEL̻!]o!rVLIS! / h /   ] M!7 N  h / n Z , w/VhASSEMBLE!rJ4]REƈLDEa"!"ńAREl"! syntax$?OPER$operand$?L#ER% h ] label #$?DEFER,%s" dup label$LY%5%c%s" /  "F/ [  /  # F/  [ N   N > L%5%s"    h"$ h"/ DW%h"5%s"$" /  h"/ - E-2&h".5%s"$ # /  N  h"/  N ]]rel addr$> REM&> =i # #/ #/ ³&&&&&&&&¬ available stack full disk errorcompilation onlyexecution only conditional? unfinished protected not FORTH-79 delimiter?ERRh  ?   ;PI~h&OPOUԩiOPREּNBU+BU]f wZ UPDAT]/ EMPTY-BUFFERZ f N  Z / Z  ]/ BUFFE$ ] / / BLOCb(  w] Z  N w0 k   / 7 N ]  N - UNTI ]  N - REPEAFF ]  N - [[ I6   - + ELSa ]   - + + WHILvf SPACEӛ e    OVEҫMDROOSWANDUNSTR;; cJD.F [N .F[$D6 $ G N  $ VZUl  $ LISx / h Screen # Z] hZ nh!R" } ( wf*"h :2GR"\ " |directory full. $Initializing screen file ... $Screen file is $FORTH SCR79-STANDARĉ R / ] / OPTIMIZEL R / SAVl]]/ x / ] 'h After the CP/M prompt '>', type:h SAVE Z FORTH.COMXSTANDARĄ D ? @y {  \ (   ])\   ( R w]) (W R ]& )p & BӐ > &U2 ]SWAPDROб CARRA { =iARRA { "8RREƷ"! „(0L#]   Z s"/  Z "/  Z #/  h"/ ]M#]DĂ#]Qы#](DD#]R#]##]+ĵ#]Cÿ#]C#]S#]I#](C#]A#]I#]I$]CL$ #/  #/  #/  #/  #/  #/  #/  #/  #/  #/  #/  $/  $/  $/  #/ CODM"T#!$ / Y" / ;COD$T# N ] =Y" PUS$NASMER$ error G  ;?SYNER$&&&(HL'& '&(C']> #/ DDQ'> =i #/ #/ B0'?'DS'?'H['?' Ac']0#/ Sk']0#/ AF~' $/ Iؑ' $w]>  $h'I١'$w]>  $h'(IX']> '(IY']> '+IX'' #/ +IY (' #/ (BC(]#/ (SP/(]#/ (DED(]#/ Y(#/ In(]> ]#/ |(]> ]#/ CXҕ(> =i  #/  #/ Cح(> =i  #/ N((((NC((C((P)( P )(()(0)(8?T=!)]N %?]CL()############$ $$h"%8;)N8)]%> S8)]]%> ?]+)# ) #/ ?]+D)F)[1BY*> =i > C)2BY*> =i ]> > C)GET0*# 0DQ* #/  #/ 0DQXl*r* $/  $/ DO.҂*#N %> ) #/ DO.R*##/  #/ *DO.Rӽ*#* ]F> )DO#\ %)]> *) #/ #P#w%#\ )Fp] \  ] ]> ]C[> #& #/ >#\ ] N ]0N %]> #{ N %{ > #&*C)ADD,#l#N % $ $% \  ] \ %0$ \ ] \ %$w ] N %] H+*]$+C)ADC-#]> ]JH+]$+C)SBCA.#]> ]BH+]$+C)SUBl.]+AND.]+XOR.]+OR.]+CP.]+INC.# ]d#N pN #N ]\ %)[]@>  #/ IN0# ]0 0 #/ C)OUT81# ]0 0 #/ C)EXd1#N % #/ #"] N %>  #/  $/  $/ :$]0N %]>  $/ ] N ]N %]>  #/ C)PUSH1]+POP2]+RLCA%2$*RRCA62$*RLAA2$*RRAL2$*DAAV2$*'CPL`2$*/SCFj2$*7CCFt2$*?NOP~2$*HALT2$*vEXX2$*كDI2$*EI2$*IM2]> { )]F> NEG2?*DRETN2?*ERETI2?*MRRDH4HOF5INSFL 5NEWFL5TLS$5kQTLOR15kQCMDAD<5!!88;88;8`8>;P8>8s8,89:7!<. 4 55C<=85 `8 5 8D 8CHROU94 5  55 { 45 N o44 5585 4h s8!(LINSA94h  nn SPLIԎ94 { 4 5 !<955 N 5 N 5N D 5N 5 D 6(LDEL94h { nn{ 4nD JOI#:4 4h >{ nN 5 N 55 N 5 N ,:6!,:6LPOZ:85N N D5 *54 95N 85/ 6!!!.RS*# #*C)DO.A*FX*/)[##/  #/ *DO.H+ ] N %> r*DO.D@+#N %> *DO.S\+]> # F *[ #*C)DO.Sx+X*]%)]#+DO.QѦ+#N %> *C)COND+  #/  #/ > LD+##<# #\ F[]\ ]\ %)]@*#,#\  /) >  ] > /) #/ #0#\ /)]2> #& ]:> #&/) #/ R#0#\ /)]G>  ]W> /) #/ +)] #*C)DEC.# ] d+)] #*C)RLC/]+RRCD/]+RLU/]+RRf/]+SLAv/] +SRA/](+SRL/]8+BIT/]@+RES/]+SET/]+JP/# ]N #%]>  #/ ] #+#&C)JR/] ]#+T&C)DJNZ*0]> T&C)CALLD0]] #+#&C)RETZ0 ]] #+C)RSTv0]8]> C)DO.(N0FFpN #N  #pN N %[/)[> ) #/ DO.(C0F2?*gRLD2?*oLDI3?*CPI3?*INI3?*OUTI#3?*LDD-3?*CPD83?*INDB3?*OUTDL3?*LDIRV3?*CPIRa3?*INIRl3?*OTIRw3?*LDDR3?*CPDR3?*INDR3?*OTDR3?*END-CODŮ3  /  N ]  h"/ ]  Z "Z #&hlabel # Z Z undefined h"/ h"h$ ] 3h"%:4h"%N B/BUƠ$  5/  5/  4/ o7PU755 > C5CC 8 6 7CU&8]6CDOW88 6CLEFH8]W7CRIGHX8 W7TUj846TDOW{846TLEFԋ84W7TRIGHԛ84W7C==85N 5  7CDE̾8D 55 { 45(LCOPY:85N r 585N N 85!LCOP; ;,8LMOV6; ;4 ,:6DOGGLF;5 4  4P65   76 75INSTO\; 5w 5/  64  455SCLҙ; b4D 6FW; 7RE;] 7BY; 4/ 7SCRFLUS<765BLKLOA#<< RENE:<]/ 7TLCLP<f]TD5/ 85/ EDITSCh<p<  4/  / 5 54 D \ !V4> ]N  D O]!Q5r4 EDIԈ4y!! /  5/ 7 5/  P6 7w HELLϤ=h#FORTH-79 Double-Number Version 2.0h#MicroMotion 12077 Wilshire #506h#Los Angeles, CA 90025 213-821-4340hCopyright (c) 1981hGϺ==_TURNKEW>=]/ ONERf>=]P/ (INDEX|>( h h7 ; ]@INDEؐ> / { Z >/V0hTRIA>  Now in base 'Zh3 / .@3  k\ h hG2hZ ']; ( ]$H)+ h3 / @(/LOOPAA^Vut^VRҎO/LOOЇA7 N ] A N - ?FINĸA>w B&U2B]SWAPDROPDCXE]C]=CD] CE] C(CH E eM! OE/ E(CV9E eW! OD/ E(HOMETE]C(BELLoE]CEDQUIԂE!;w 3 I3 / hVLISԛJ3  /  Z I, w/VFZ ] Z n D N j 7 ;Z 7 ; hG/0HUNL yV{ Z ] . N TESMM!hhh] <$$$ $$$ $$$ $$$$$$ $$$$$ $$$$$$ $$$$ $$ $$ h] ;$$$ $$$ $$$ $$$ $$ $$ $ $$ $$ $ $ h] ; $$$ $$$ $$ $$ $$$ $$ $$ $ $ h] :$$$ $$$$$$ $$$ $$$ $$$ $$ $$$$ $$ $$ $$ h] :$$$ $$ $ $$$ $$$ $$ $$ $ $$$$$$ $$ h] :$$$ $$ $ $$$/ h7 7 7 hZ ( h Z /0hLPO>] / LPOF8?]  / LPINDEM? / ?? hhZ k];OZ >/0 ]=h] C/V0]<]=U?LPTRIAc? / ??[7 7 FZ >] C/V07 ]=U?DUM?3 M!]I ]]]h7 {h]] Z 7 ;h ]]{N hZ  ]$ ]Z Z Z  7 ; ]=+ ]Z Z Z  ]D h ]\ ].C ]=]]=h3 / . @3 BCARRAB{ =iARRA C{  =iCTABL&C=i TABLFC=iACCEP_CF{ [X k {  > YES/N{C(Y/N)?VC]Y\ READYC . READY(CR)?V] \ ?TERMINAC/VOC-LINC U.DF [$-FIND> D  ]? I/%D@CATALOID{ hZ ( h FZ ] Z n D N j 7 ;Z 7 ; hG/0(TINITSD / ] / (TDONED / ]  / PD].C A]Ah3 / DUMhG2hZ ']; ( ]$h3 / (INDEXJ( h h7 ; ]@INDEK / { Z K/V0hTRIAlvta+M $$ $$ h]'$$$$$$$ $$ $ hhhhhh]-$$$$$$$ $$$$$$$$$$ $$ $$ h]-$$ $$ $$ $$ $$ h],$$ $$ $$ $$ $$ h]+$$ ( MicroMotion Z-80 Floating Point Package ) ( Copyright 1982 ) ( MicroMotion ) ( 12077 Wilshire Blvd., #506 ) ( Los Angeles, CA 90025 ) ( 213-821-4340 ) ( FLOATING POINT COPYRIGHT 1982 MICROMOTION 19 JAN 82 ) FORTH DEFINITIONS HEX VARIABLE FSTAT VARIABLE RSAVE 9 ALLOT RSAVE 4 + CONSTANT GUARD ( FLOATING POINT COPYRIGHT 1982 MICROMOTION 19 JAN 82 ) CODE UNFLO HL POP, RSAVE ) HL LD, A 4 LD, HL FSTAT LD, (HL) OR, (HL) A LD, DE POP, DE POP, DE 0 LD, DE PUSH, DE PUSH, HL RSAVE ) LD, (HL) JP, END-CODE -$$ $$ $$ $$ $$ h],$$ $$ $$ $$ $$ h]+$$ $$ $$ $$ $$ h])$$ $$ $$ $$ $$h])$$ $$ $$ $$ $$ h]'$$$$$$$ $$ $ hhhhhh]-$$$$$$$ $$$$$$$$$$ $$ $$ h]-$$ $$ $$ $$ $$ h],$$ $$ $$ $$ $$ h]+$$ ( Written by Martin Tracy and Ron Anderson ) RSAVE 5 + CONSTANT XPTR RSAVE 6 + CONSTANT FTEMP RSAVE 7 + CONSTANT FTEMP1 RSAVE 8 + CONSTANT FTEMP2 RSAVE 9 + CONSTANT FTEMP3 RSAVE 0A + CONSTANT FTEMP4 CODE OVFLO HL POP, RSAVE ) HL LD, A 2 LD, HL FSTAT LD, (HL) OR, (HL) A LD, DE POP, D RL, DE POP, DE FFFF LD, DE PUSH, D 7F LD, D RR, DE PUSH, HL RSAVE ) LD, (HL) JP, END-CODE ( FLOATING POINT COPYRIGHT 1982 MICROMOTION 19 JAN 82 ) ( EXP+1 ) CODE EXP+1 HL POP, RSAVE ) HL LD, HL POP, D H LD, H SLA, A H LD, A 2 ADD, AF PUSH, H A LD, D RL, H RR, AF POP, HL PUSH, PE ' OVFLO 4 + JP, HL POP, DE POP, SCF, L RR, D RR, ( FLOATING POINT COPYRIGHT 1982 MICROMOTION 19 JAN 82 ) CODE ROUND A GUARD ) LD, A OR, P RET, HL POP, RSAVE ) HL LD, ( ALTERNATE ENTRY FROM INVERT ) DE POP, HL POP, HL INC, A H LD, L OR, NZ 1 L# JP, E INC, ( FLOATING POINT COPYRIGHT 1982 MICROMOTION 19 JAN 82 ) CODE INVERT HL POP, RSAVE ) HL LD, DE POP, HL POP, A 80 LD, D XOR, D A LD, A E LD, CPL, E A LD, A H LD, CPL, H A LD, A L LD, CPL, L A LD, A GUARD ) LD, CPL, GUARD ) A LD, ( FLOATING POINT COPYRIGHT 1982 MICROMOTION 19 JAN 82 ) CODE DENORM HL POP, RSAVE ) HL LD, 20 CP, NCY ' UNFLO 0B + JP, DE POP, HL POP, 1 L: 8 CP, CY 2 L# JP, AF AF' EX, A L LD, GUARD ) A LD, AF AF' EX, L H LD, H E LD, E 0 LD, 8 SUB, 1 L# JP, ( FLOATING POINT COPYRIGHT 1982 MICROMOTION 19 JAN 82 ) CODE NORM HL POP, RSAVE ) HL LD, EXX, DE POP, HL POP, A L LD, H OR, E OR, NZ 1 L# JP, D 0 LD, 6 L# JP, 1 L: B D LD, B SLA, 2 L: A E LD, A OR, NZ 4 L# JP, E H LD, H L LD, A GUARD ) LD, L A LD, A XOR, GUARD ) A LD, A B LD, 10 SUB, B A LD, E RR, DE PUSH, HL PUSH, HL RSAVE ) LD, (HL) JP, END-CODE 1 L: HL PUSH, DE PUSH, Z ' EXP+1 2+ 2+ JP, HL RSAVE ) LD, (HL) JP, END-CODE HL PUSH, DE PUSH, HL GUARD LD, (HL) INC, Z ' ROUND 9 + JP, HL RSAVE ) LD, (HL) JP, END-CODE 2 L: A OR, Z 3 L# JP, E SRL, H RR, L RR, AF PUSH, A GUARD ) LD, RRA, GUARD ) A LD, AF POP, A DEC, 2 L# JP, 3 L: HL PUSH, DE PUSH, HL RSAVE ) LD, (HL) JP, END-CODE PO 2 L# JP, 3 L: HL PUSH, DE PUSH, EXX, ' UNFLO 4 + JP, 4 L: 7 E BIT, NZ 5 L# JP, A GUARD ) LD, A SLA, GUARD ) A LD, L RL, H RL, E RL, A B LD, 2 SUB, B A LD, PO 4 L# JP, 3 L# JP, 5 L: D RL, B RR, D B LD, 6 L: HL PUSH, DE PUSH, EXX, HL RSAVE ) LD, (HL) JP, END-CODE ( FLOATING POINT COPYRIGHT 1982 MICROMOTION 19 JAN 82 ) CODE F+- HL POP, RSAVE 2+ ) HL LD, EXX, A XOR, GUARD ) A LD, XPTR ) A LD, DE POP, E OR, NZ 1 L# JP, DE POP, EXX, HL RSAVE 2+ ) LD, (HL) JP, 1 L: IX POP, HL POP, A XOR, L OR, NZ 2 L# JP, HL POP, IX PUSH, DE PUSH, EXX, HL RSAVE 2+ ) LD, (HL) JP, 2 L: A H LD, D XOR, B A LD, C H LD, C SLA, A D LD, A SLA, ( FLOATING POINT COPYRIGHT 1982 MICROMOTION 19 JAN 82 ) ( F+ ) HL POP, A L LD, HL POP, DE POP, BC POP, HL BC ADD, A E ADC, E A LD, HL PUSH, DE PUSH, EXX, CY 9 L# JP, HL RSAVE 2+ ) LD, (HL) JP, 9 L: HL RSAVE 2+ ) LD, RSAVE ) HL LD, ' EXP+1 4 + JP, ( FLOATING POINT COPYRIGHT 1982 MICROMOTION 19 JAN 82 ) CODE F+ ' F+- CALL, ' ROUND CALL, NEXT JP, END-CODE ( FLOATING POINT COPYRIGHT 1982 MICROMOTION 19 JAN 82 ) CODE FXET HL POP, RSAVE ) HL LD, DE POP, IX POP, HL POP, A D LD, 80 AND, H XOR, H A LD, A E LD, A OR, NZ 2 L# JP, A XPTR ) LD, A OR, NZ 3 L# JP, 1 L: DE POP, DE 0 LD, DE PUSH, DE PUSH, HL RSAVE 2+ ) LD, (HL) JP, ( FLOATING POINT COPYRIGHT 1982 MICROMOTION 19 JAN 82 ) CODE (F*) HL POP, RSAVE 2+ ) HL LD, A XOR, XPTR ) A LD, ' FXET CALL, HL RSAVE 2+ ) LD, RSAVE ) HL LD, EXX, HL POP, DE POP, BC POP, H SLA, A B LD, A SLA, A H ADD, PO 1 L# JP, BC PUSH, EXX, M ' OVFLO 4 + JP, ' UNFLO 4 + JP, C SUB, PO 3 L# JP, A 3F LD, 3 L: M 4 L# JP, Z 7 L# JP, H D LD, XPTR ) A LD, 5 L# JP, 4 L: NEG, 5 L: A SRL, C A LD, A XPTR ) LD, A OR, A C LD, HL PUSH, NZ 6 L# JP, IX PUSH, DE PUSH, ' DENORM CALL, 8 L# JP, 6 L: EXX, ' DENORM CALL, EXX, IX PUSH, DE PUSH, 8 L# JP, 7 L: HL PUSH, IX PUSH, DE PUSH, 8 L: A B LD, A OR, M 10 L# JP, ( F- ) 10 L: A XPTR ) LD, A OR, HL POP, NZ 11 L# JP, BC POP, DE POP, A E LD, E L LD, HL POP, 12 L# JP, 11 L: A L LD, HL POP, DE POP, BC POP, 12 L: HL BC SBC, A E SBC, E A LD, HL PUSH, DE PUSH, EXX, NCY 13 L# JP, ' INVERT CALL, 13 L: HL RSAVE 2+ ) LD, RSAVE ) HL LD, ' NORM 4 + JP, END-CODE CODE F- HL POP, A H LD, 80 XOR, H A LD, HL PUSH, ' F+- CALL, ' ROUND CALL, NEXT JP, END-CODE 2 L: A L LD, A OR, Z 1 L# JP, HL PUSH, IX PUSH, DE PUSH, HL RSAVE ) LD, (HL) JP, 3 L: A FSTAT ) LD, 10 OR, FSTAT ) A LD, HL PUSH, HL RSAVE 2+ ) LD, RSAVE ) HL LD, ' OVFLO 4 + JP, END-CODE 1 L: B SLA, RRA, XPTR ) A LD, B L LD, HL POP, A C LD, AF PUSH, A H LD, AF PUSH, A L LD, AF PUSH, A XOR, GUARD ) A LD, H A LD, L A LD, C A LD, A 3 LD, 2 L: AF AF' EX, AF POP, A OR, NZ 3 L# JP, A L LD, GUARD ) A LD, L H LD, H C LD, C 0 LD, 6 L# JP, 3 L: A SRL, 7 A SET, 4 L: FTEMP ) A LD, NCY 5 L# JP, A C LD, HL DE ADD, A B ADC, C A LD, ( FLOATING POINT COPYRIGHT 1982 MICROMOTION 19 JAN 82 ) 5 L: C RR, H RR, L RR, A GUARD ) LD, RRA, GUARD ) A LD, A FTEMP ) LD, A SRL, NZ 4 L# JP, 6 L: AF AF' EX, A DEC, NZ 2 L# JP, HL PUSH, A XPTR ) LD, B A LD, BC PUSH, ' NORM 5 + JP, END-CODE ( FLOATING POINT COPYRIGHT 1982 MICROMOTION 19 JAN 82 ) CODE (F/) HL POP, RSAVE 2+ ) HL LD, A 1 LD, XPTR ) A LD, ' FXET CALL, HL RSAVE 2+ ) LD, RSAVE ) HL LD, D 1 LD, EXX, HL POP, DE POP, BC POP, H SLA, A B LD, A SLA, H SUB, AF PUSH, 7E CP, Z 1 L# JP, AF POP, PO 2 L# JP, BC PUSH, EXX, M ' OVFLO 4 + JP, ' UNFLO 4 + JP, ( FLOATING POINT COPYRIGHT 1982 MICROMOTION 19 JAN 82 ) AF AF' EX, EXX, D 40 LD, EXX, 8 L# JP, 6 L: NCY 10 L# JP, AF AF' EX, EXX, D 1 LD, EXX, 8 L# JP, 7 L: EXX, D A LD, EXX, 8 L: AF POP, NCY 9 L# JP, CCF, HL DE SBC, A C LD, A B SBC, C A LD, ( FLOATING POINT COPYRIGHT 1982 MICROMOTION 19 JAN 82 ) CODE F* ' (F*) CALL, ' ROUND CALL, NEXT JP, END-CODE ( FLOATING POINT COPYRIGHT 1982 MICROMOTION 19 JAN 82 ) CODE (FIT) EXX, HL POP, RSAVE 2+ ) HL LD, HL POP, A L LD, A OR, Z 4 L# JP, A H LD, A A ADD, Z 4 L# JP, P 1 L# JP, A 4 LD, 4 L# JP, 1 L: 40 CP, CY 2 L# JP, A 2 LD, 4 L# JP, 2 L: A H LD, 1 L: AF POP, 2 L: A 2 ADD, B SLA, RRA, FTEMP ) A LD, A XOR, AF AF' EX, IX FTEMP LD, B L LD, HL POP, 3 L: A C LD, B CP, NZ 4 L# JP, A H LD, D CP, NZ 4 L# JP, A L LD, E CP, 4 L: CCF, 5 L: EXX, A D LD, EXX, AF PUSH, RLA, NCY 7 L# JP, IX INC, 0 +IX) A LD, AF AF' EX, A INC, 3 CP, NZ 6 L# JP, 9 L: L SLA, H RL, C RL, CY 5 L# JP, 7 C BIT, Z 5 L# JP, 3 L# JP, 10 L: AF POP, AF AF' EX, A A ADD, A A ADD, A A ADD, A A ADD, A A ADD, A A ADD, GUARD ) A LD, L -1 +IX) LD, H -2 +IX) LD, E -3 +IX) LD, D -4 +IX) LD, ' NORM 7 + JP, END-CODE CODE F/ ' (F/) CALL, ' ROUND CALL, NEXT JP, END-CODE AF AF' EX, A L LD, HL POP, DE POP, BC POP, AF AF' EX, 3 L: AF AF' EX, L SLA, H RL, A RL, C RL, B RL, E RL, D RL, AF AF' EX, A DEC, NZ 3 L# JP, GUARD ) A LD, BC PUSH, DE PUSH, HL PUSH, H A LD, AF AF' EX, L A LD, HL PUSH, EXX, ' NORM CALL, A XOR, 5 L# JP, 4 L: HL PUSH, EXX, 5 L: H 0 LD, L A LD, HL PUSH, HL RSAVE 2+ ) LD, (HL) JP, END-CODE ( FLOATING POINT COPYRIGHT 1982 MICROMOTION 19 JAN 82 ) CODE FIT A XOR, FSTAT ) A LD, ' (FIT) CALL, NEXT JP, END-CODE ( FLOATING POINT COPYRIGHT 1982 MICROMOTION 19 JAN 82 ) CODE NORMAL A XOR, GUARD ) A LD, ' NORM CALL, NEXT JP, END-CODE ( FLOATING POINT COPYRIGHT 1982 MICROMOTION 19 JAN 82 ) CODE .FR EXX, HL POP, RSAVE 2+ ) HL LD, A XOR, B 18 LD, 1 L: (HL) A LD, HL INC, 1 L# DJNZ, DE POP, A D LD, RLA, A SRA, NEG, DE PUSH, ' DENORM CALL, DE POP, HL POP, B 18 LD, 2 L: E SRL, H RR, L RR, C 0 LD, IX RSAVE 2+ ) LD, AF AF' EX, 3 L: AF AF' EX, A 0 LD, NCY 4 L# JP, CCF, A BASE ) LD, ( FLOATING POINT COPYRIGHT 1982 MICROMOTION 19 JAN 82 ) CODE FABS HL POP, 7 H RES, HL PUSH, NEXT JP, END-CODE CODE (EXP) ( FLOATING POINT COPYRIGHT 1982 MICROMOTION 19 JAN 82 ) CODE (F<) IX POP, EXX, BC POP, DE POP, HL POP, A H LD, B XOR, P 1 L# JP, A H LD, RLCA, 1 AND, HL PUSH, EXX, (IX) JP, 1 L: A H LD, AF AF' EX, A B LD, FTEMP ) A LD, A SLA, H SLA, H SUB, PO 2 L# JP, 80 XOR, : 2BASE BASE @ 1800 NORMAL ; : FNEGATE 8000 XOR ; : FLOAT ( D# --- F# ) DUP >R DABS >R 1800 NORMAL R> 2800 NORMAL F+ R> 0< IF FNEGATE THEN ; 4 L: A 0 +IX) ADD, A SRL, 0 +IX) A LD, C INC, IX INC, AF AF' EX, A C LD, 18 XOR, NZ 3 L# JP, 2 L# DJNZ, C DEC, IX DEC, 5 L: A 0 +IX) LD, 0A CP, CY 6 L# JP, A 7 ADD, 6 L: A 30 ADD, 0 +IX) A LD, IX DEC, C DEC, P 5 L# JP, EXX, NEXT JP, END-CODE HL POP, HL PUSH, A H LD, RLA, A SRA, L A LD, RLA, A A SBC, H A LD, HL PUSH, NEXT JP, END-CODE 2 L: A SLA, B L LD, HL POP, Z 3 L# JP, CCF, 4 L# JP, 3 L: A B LD, C CP, NZ 4 L# JP, A H LD, D CP, NZ 4 L# JP, A L LD, E CP, 4 L: E RR, A FTEMP ) LD, E XOR, AF AF' EX, HL PUSH, H A LD, L B LD, HL PUSH, AF AF' EX, RLCA, 1 AND, EXX, (IX) JP, END-CODE