; =========================================================
; An Assembly Listing of the "Shoulders of Giants" ZX81 ROM
; =========================================================
; -------------------------
; Last updated: 23-OCT-2003
; -------------------------
;
; The "Shoulders of Giants" ZX81 ROM.
; This file shows the altered sections of the ZX81/TS1000 ROM that produced
; the customized sg81.rom.
; The main feature is the inclusion of Newton Raphson square roots.
; The square roots are executed 3 times faster than those in the
; standard ROM. They are more accurate also and
;
; PRINT SQR 100 = INT SQR 100 gives the result 1 (true) not 0 (false)
;
; The input and storage of fractional numbers is improved
;
; PRINT 1/2 = .5 gives the result 1 (true) and not 0 (false)
;
; The output of fractional numbers to the ZX Printer is corrected
;
; LPRINT .00001 gives the output .00001 and not .0XYZ1
;
; Other alterations have been made to create the space required by the
; new square root routine and some are obscure and would not otherwise have
; been made.
; Using uncompressed constants rectifies a logic error and improves speed.
#define DEFB .BYTE ; TASM cross-assembler definitions
#define DEFW .WORD
#define EQU .EQU
#define ORG .ORG
; the backward references
subtract EQU $174C ; SUBTRACT
multiply EQU $176C ; multiply
division EQU $1882 ; division
addition EQU $1755 ; addition
truncate EQU $18E4 ; truncate
e_to_fp EQU $155A ; e-to-fp
TEST_ROOM EQU $0EC5 ; TEST-ROOM
FIND_INT EQU $0EA7 ; FIND-INT
STACK_A EQU $151D ; STACK-A
STACK_BC EQU $1520 ; STACK-BC
STK_FETCH EQU $13F8 ; STK-FETCH
STK_STO_s EQU $12C3 ; STK-STO-$
FP_TO_A EQU $15CD ; FP-TO-A
CLASS_06 EQU $0D92 ; CLASS-06
CHECK_2 EQU $0D22 ; CHECK-2
SCANNING EQU $0F55 ; SCANNING
PRINT_FP EQU $15DB ; PRINT-FP
; -----------------------------------------------------------------------------
ORG $0010
;--------------------------------
; THE 'PRINT A CHARACTER' RESTART
;--------------------------------
; This restart prints the character in the accumulator using the alternate
; register set so there is no requirement to save the main registers.
; There is sufficient room available to separate a space (zero) from other
; characters as leading spaces need not be considered with a space.
; Note. the accumulator is preserved only when printing to the screen.
PRINT_A AND A ; test for zero - space.
JP NZ,PRINT_CH ; jump forward if not to PRINT-CH.
JP PRINT_SP ; jump forward to PRINT-SP.
; ---
DEFB $01 ;+ unused location. Version. PRINT PEEK 23
; -----------------------------------------------------------------------------
ORG $0028
; -----------------------
; THE 'CALCULATE' RESTART
; -----------------------
; An immediate jump is made to the CALCULATE routine the address of which
; has changed.
FP_CALC JP CALCULATE ;+ jump to the NEW calculate routine address.
end_calc POP AF ; drop the calculator return address RE-ENTRY
EXX ; switch to the other set.
EX (SP),HL ; transfer H'L' to machine stack for the
; return address.
; when exiting recursion then the previous
; pointer is transferred to H'L'.
EXX ; back to main set.
RET ; return.
; -----------------------------------------------------------------------------
ORG $13AE
; ------------------------
; THE 'L-ENTER' SUBROUTINE
; ------------------------
; Part of the LET command contains a natural subroutine which is a
; conditional LDIR. The copy only occurs of BC is non-zero.
L_ENTER EX DE,HL ;
COND_MV LD A,B ;
OR C ;
RET Z ;
PUSH DE ;
LDIR ; Copy Bytes
POP HL ;
RET ; Return.
; -----------------------------------------------------------------------------
ORG $14E5
; ---------------------
; THE 'NEXT DIGIT' LOOP
; ---------------------
; Within the 'DECIMAL TO FLOATING POINT' routine, swapping the multiply and
; divide literals preserves accuracy and ensures that .5 is evaluated
; as 5/10 and not as .1 * 5.
NXT_DGT_1 RST 20H ; NEXT-CHAR
CALL $1514 ; routine STK-DIGIT
JR C,$14F5 ; forward to E-FORMAT
RST 28H ;; FP-CALC
DEFB $E0 ;;get-mem-0
DEFB $A4 ;;stk-ten
;;; DEFB $05 ;;division
DEFB $04 ;;+multiply
DEFB $C0 ;;st-mem-0
;;; DEFB $04 ;;multiply
DEFB $05 ;;+division
DEFB $0F ;;addition
DEFB $34 ;;end-calc
JR NXT_DGT_1 ; loop back till exhausted to NXT-DGT-1
; -----------------------------------------------------------------------------
ORG $16B2
; -------------------------------------
; THE 'FLOATING POINT PRINT ZEROS' LOOP
; -------------------------------------
; This branch deals with zeros after decimal point.
; e.g. .01 or .0000999
; Note. that printing to the ZX Printer destroys A and that A should be
; initialized to '0' at each stage of the loop.
; Originally LPRINT .00001 printed as .0XYZ1
PF_ZEROS NEG ; negate makes number positive 1 to 4.
LD B,A ; zero count to B.
LD A,$1B ; prepare character '.'
RST 10H ; PRINT-A
PF_ZRO_LP LD A,$1C ; prepare a '0' in the accumulator each time.
PFZROLP RST 10H ; PRINT-A
DJNZ PF_ZRO_LP ;+ New loop back to PF-ZRO-LP
;;; DJNZ PFZROLP ; obsolete loop back to PFZROLP
; and continue with trailing fractional digits...
; -----------------------------------------------------------------------------
ORG $1915
; Up to this point all routine addresses have been maintained so that the
; modified ROM is compatible with any machine-code software that uses ROM
; routines.
; The final section does not maintain address entry points as the routines
; within are not generally called directly.
;********************************
;** FLOATING-POINT CALCULATOR **
;********************************
; As a general rule the calculator avoids using the IY register.
; The exception is the 'val' function.
; So an assembly language programmer who has disabled interrupts to use IY
; for other purposes can still use the calculator for mathematical
; purposes.
; ------------------------
; THE 'TABLE OF CONSTANTS'
; ------------------------
; The ZX81 has only floating-point number representation.
; Both the ZX80 and the ZX Spectrum have integer numbers in some form.
; This table has been modified so that the constants are held in their
; uncompressed, ready-to-party, 5-byte form.
;;; L1915: DEFB $00 ;;Bytes: 1
;;; DEFB $B0 ;;Exponent $00
;;; DEFB $00 ;;(+00,+00,+00)
;;; L1918: DEFB $31 ;;Exponent $81, Bytes: 1
;;; DEFB $00 ;;(+00,+00,+00)
;;; L191A: DEFB $30 ;;Exponent: $80, Bytes: 1
;;; DEFB $00 ;;(+00,+00,+00)
;;; L191C: DEFB $F1 ;;Exponent: $81, Bytes: 4
;;; DEFB $49,$0F,$DA,$A2 ;;
;;; L1921: DEFB $34 ;;Exponent: $84, Bytes: 1
;;; DEFB $20 ;;(+00,+00,+00)
TAB_CNST DEFB $00 ; the value zero.
DEFB $00 ;
DEFB $00 ;
DEFB $00 ;
DEFB $00 ;
DEFB $81 ; the floating point value 1.
DEFB $00 ;
DEFB $00 ;
DEFB $00 ;
DEFB $00 ;
DEFB $80 ; the floating point value 1/2.
DEFB $00 ;
DEFB $00 ;
DEFB $00 ;
DEFB $00 ;
DEFB $81 ; the floating point value pi/2.
DEFB $49 ;
DEFB $0F ;
DEFB $DA ;
DEFB $A2 ;
DEFB $84 ; the floating point value ten.
DEFB $20 ;
DEFB $00 ;
DEFB $00 ;
DEFB $00 ;
; ------------------------
; THE 'TABLE OF ADDRESSES'
; ------------------------
;
; Starts with binary operations which have two operands and one result.
; three pseudo binary operations first.
tbl_addrs DEFW jump_true ; $00 Address: $1C2F - jump-true
DEFW exchange ; $01 Address: $1A72 - exchange
DEFW delete ; $02 Address: $19E3 - delete
; true binary operations.
DEFW subtract ; $03 Address: $174C - subtract
DEFW multiply ; $04 Address: $176C - multiply
DEFW division ; $05 Address: $1882 - division
DEFW to_power ; $06 Address: $1DE2 - to-power
DEFW or ; $07 Address: $1AED - or
DEFW no_v_no ; $08 Address: $1B03 - no-&-no
DEFW no_l_eql ; $09 Address: $1B03 - no-l-eql
DEFW no_l_eql ; $0A Address: $1B03 - no-gr-eql
DEFW no_l_eql ; $0B Address: $1B03 - nos-neql
DEFW no_l_eql ; $0C Address: $1B03 - no-grtr
DEFW no_l_eql ; $0D Address: $1B03 - no-less
DEFW no_l_eql ; $0E Address: $1B03 - nos-eql
DEFW addition ; $0F Address: $1755 - addition
DEFW str_v_no ; $10 Address: $1AF8 - str-&-no
DEFW no_l_eql ; $11 Address: $1B03 - str-l-eql
DEFW no_l_eql ; $12 Address: $1B03 - str-gr-eql
DEFW no_l_eql ; $13 Address: $1B03 - strs-neql
DEFW no_l_eql ; $14 Address: $1B03 - str-grtr
DEFW no_l_eql ; $15 Address: $1B03 - str-less
DEFW no_l_eql ; $16 Address: $1B03 - strs-eql
DEFW strs_add ; $17 Address: $1B62 - strs-add
; unary follow
DEFW negate ; $18 Address: $1AA0 - neg
DEFW code ; $19 Address: $1C06 - code
DEFW val ; $1A Address: $1BA4 - val
DEFW len ; $1B Address: $1C11 - len
DEFW sin ; $1C Address: $1D49 - sin
DEFW cos ; $1D Address: $1D3E - cos
DEFW tan ; $1E Address: $1D6E - tan
DEFW asn ; $1F Address: $1DC4 - asn
DEFW acs ; $20 Address: $1DD4 - acs
DEFW atn ; $21 Address: $1D76 - atn
DEFW ln ; $22 Address: $1CA9 - ln
DEFW exp ; $23 Address: $1C5B - exp
DEFW int ; $24 Address: $1C46 - int
DEFW sqr ; $25 Address: $1DDB - sqr
DEFW sgn ; $26 Address: $1AAF - sgn
DEFW abs ; $27 Address: $1AAA - abs
DEFW peek ; $28 Address: $1A1B - peek
DEFW usr_no ; $29 Address: $1AC5 - usr-no
DEFW strS ; $2A Address: $1BD5 - str$
DEFW chrS ; $2B Address: $1B8F - chrs
DEFW not ; $2C Address: $1AD5 - not
; end of true unary
DEFW MOVE_FP ; $2D Address: $19F6 - duplicate
DEFW n_mod_m ; $2E Address: $1C37 - n-mod-m
DEFW JUMP ; $2F Address: $1C23 - jump
DEFW stk_data ; $30 Address: $19FC - stk-data
DEFW dec_jr_nz ; $31 Address: $1C17 - dec-jr-nz
DEFW less_0 ; $32 Address: $1ADB - less-0
DEFW greater_0 ; $33 Address: $1ACE - greater-0
DEFW end_calc ; $34 Address: $002B - end-calc
DEFW get_argt ; $35 Address: $1D18 - get-argt
DEFW truncate ; $36 Address: $18E4 - truncate
DEFW fp_calc_2 ; $37 Address: $19E4 - fp-calc-2
DEFW e_to_fp ; $38 Address: $155A - e-to-fp
; the following are just the next available slots for the 128 compound
; literals which are in range $80 - $FF.
DEFW seriesg_x ; $39 Address: $1A7F - series-xx $80 - $9F.
DEFW stk_con_x ; $3A Address: $1A51 - stk-const-xx $A0 - $BF.
DEFW sto_mem_x ; $3B Address: $1A63 - st-mem-xx $C0 - $DF.
DEFW get_mem_x ; $3C Address: $1A45 - get-mem-xx $E0 - $FF.
; -------------------------------
; THE 'FLOATING POINT CALCULATOR'
; -------------------------------
;
;
CALCULATE CALL STK_PNTRS ; routine STK-PNTRS is called to set up the
; calculator stack pointers for a default
; unary operation. HL = last value on stack.
; DE = STKEND first location after stack.
; the calculate routine is called at this point by the series generator...
GEN_ENT_1 LD A,B ; fetch the Z80 B register to A
LD ($401E),A ; and store value in system variable BREG.
; this will be the counter for dec-jr-nz
; or if used from fp-calc2 the calculator
; instruction.
; ... and again later at this point
GEN_ENT_2 EXX ; switch sets
EX (SP),HL ; and store the address of next instruction,
; the return address, in H'L'.
; If this is a recursive call then the H'L'
; of the previous invocation goes on stack.
; c.f. end-calc.
EXX ; switch back to main set.
; this is the re-entry looping point when handling a string of literals.
RE_ENTRY LD ($401C),DE ; save end of stack in system variable STKEND
EXX ; switch to alt
LD A,(HL) ; get next literal
INC HL ; increase pointer'
; single operation jumps back to here
SCAN_ENT PUSH HL ; save pointer on stack *
AND A ; now test the literal
JP P,FIRST_3D ; forward to FIRST-3D if in range $00 - $3D
; anything with bit 7 set will be one of
; 128 compound literals.
; Compound literals have the following format.
; bit 7 set indicates compound.
; bits 6-5 the subgroup 0-3.
; bits 4-0 the embedded parameter $00 - $1F.
; The subgroup 0-3 needs to be manipulated to form the next available four
; address places after the simple literals in the address table.
LD D,A ; save literal in D
AND $60 ; and with 01100000 to isolate subgroup
RRCA ; rotate bits
RRCA ; 4 places to right
RRCA ; not five as we need offset * 2
RRCA ; 00000xx0
ADD A,$72 ; add ($39 * 2) to give correct offset.
; alter above if you add more literals.
LD L,A ; store in L for later indexing.
LD A,D ; bring back compound literal
AND $1F ; use mask to isolate parameter bits
JR ENT_TABLE ; forward to ENT-TABLE
; ---
; the branch was here with simple literals.
FIRST_3D CP $18 ; compare with first unary operations.
JR NC,DOUBLE_A ; to DOUBLE-A with unary operations
; it is binary so adjust pointers.
EXX ;
LD BC,$FFFB ; the value -5
LD D,H ; transfer HL, the last value, to DE.
LD E,L ;
ADD HL,BC ; subtract 5 making HL point to second
; value.
EXX ;
DOUBLE_A RLCA ; double the literal
LD L,A ; and store in L for indexing
ENT_TABLE LD DE,tbl_addrs ; Address: tbl-addrs
LD H,$00 ; prepare to index
ADD HL,DE ; add to get address of routine
LD E,(HL) ; low byte to E
INC HL ;
LD D,(HL) ; high byte to D
LD HL,RE_ENTRY ; Address: RE-ENTRY
EX (SP),HL ; goes on machine stack
; address of next literal goes to HL. *
PUSH DE ; now the address of routine is stacked.
EXX ; back to main set
; avoid using IY register.
LD BC,($401D) ; STKEND_hi
; nothing much goes to C but BREG to B
; and continue into next ret instruction
; which has a dual identity
; -----------------------
; THE 'DELETE' SUBROUTINE
; -----------------------
; (offset $02: 'delete')
; A simple return but when used as a calculator literal this
; deletes the last value from the calculator stack.
; On entry, as always with binary operations,
; HL=first number, DE=second number
; On exit, HL=result, DE=stkend.
; So nothing to do
delete RET ; return - indirect jump if from above.
; ---------------------------------
; THE 'SINGLE OPERATION' SUBROUTINE
; ---------------------------------
; offset $37: 'fp-calc-2'
; this single operation is used, in the first instance, to evaluate most
; of the mathematical and string functions found in BASIC expressions.
fp_calc_2 POP AF ; drop return address.
LD A,($401E) ; load accumulator from system variable BREG
; value will be literal eg. 'tan'
EXX ; switch to alt
JR SCAN_ENT ; back to SCAN-ENT
; next literal will be end-calc in scanning
; ------------------------------
; THE 'TEST 5 SPACES' SUBROUTINE
; ------------------------------
; This routine is called from MOVE-FP, STK-CONST and STK-STORE to
; test that there is enough space between the calculator stack and the
; machine stack for another five-byte value. It returns with BC holding
; the value 5 ready for any subsequent LDIR.
TEST_5_SP PUSH DE ; save
PUSH HL ; registers
LD BC,$0005 ; an overhead of five bytes
CALL TEST_ROOM ; routine TEST-ROOM tests free RAM raising
; an error if not.
POP HL ; else restore
POP DE ; registers.
RET ; return with BC set at 5.
; ---------------------------------------------
; THE 'MOVE A FLOATING POINT NUMBER' SUBROUTINE
; ---------------------------------------------
; offset $2D: 'duplicate'
; This simple routine is a 5-byte LDIR instruction
; that incorporates a memory check.
; When used as a calculator literal it duplicates the last value on the
; calculator stack.
; Unary so on entry HL points to last value, DE to stkend
MOVE_FP CALL TEST_5_SP ; routine TEST-5-SP test free memory
; and sets BC to 5.
LDIR ; copy the five bytes.
RET ; return with DE addressing new STKEND
; and HL addressing new last value.
; -------------------------------
; THE 'STACK LITERALS' SUBROUTINE
; -------------------------------
; offset $30: 'stk-data'
; When a calculator subroutine needs to put a value on the calculator
; stack that is not a regular constant this routine is called with a
; variable number of following data bytes that convey to the routine
; the floating point form as succinctly as is possible.
stk_data LD H,D ; transfer STKEND
LD L,E ; to HL for result.
STK_CONST CALL TEST_5_SP ; routine TEST-5-SP tests that room exists
; and sets BC to $05.
EXX ; switch to alternate set
PUSH HL ; save the pointer to next literal on stack
EXX ; switch back to main set
EX (SP),HL ; pointer to HL, destination to stack.
;;; PUSH BC ; save BC - value 5 from test room. No need.
LD A,(HL) ; fetch the byte following 'stk-data'
AND $C0 ; isolate bits 7 and 6
RLCA ; rotate
RLCA ; to bits 1 and 0 range $00 - $03.
LD C,A ; transfer to C
INC C ; and increment to give number of bytes
; to read. $01 - $04
LD A,(HL) ; reload the first byte
AND $3F ; mask off to give possible exponent.
JR NZ,FORM_EXP ; forward to FORM-EXP if it was possible to
; include the exponent.
; else byte is just a byte count and exponent comes next.
INC HL ; address next byte and
LD A,(HL) ; pick up the exponent ( - $50).
FORM_EXP ADD A,$50 ; now add $50 to form actual exponent
LD (DE),A ; and load into first destination byte.
LD A,$05 ; load accumulator with $05 and
SUB C ; subtract C to give count of trailing
; zeros plus one.
INC HL ; increment source
INC DE ; increment destination
;;; LD B,$00 ; prepare to copy. Note. B is zero.
LDIR ; copy C bytes
;;; POP BC ; restore 5 counter to BC.
EX (SP),HL ; put HL on stack as next literal pointer
; and the stack value - result pointer -
; to HL.
EXX ; switch to alternate set.
POP HL ; restore next literal pointer from stack
; to H'L'.
EXX ; switch back to main set.
LD B,A ; zero count to B
XOR A ; clear accumulator
STK_ZEROS DEC B ; decrement B counter
RET Z ; return if zero. >>
; DE points to new STKEND
; HL to new number.
LD (DE),A ; else load zero to destination
INC DE ; increase destination
JR STK_ZEROS ; loop back to STK-ZEROS until done.
; -------------------------------
; THE 'SKIP CONSTANTS' SUBROUTINE
; -------------------------------
; This routine traversed variable-length entries in the table of constants,
; stacking intermediate, unwanted constants onto a dummy calculator stack,
; in the first five bytes of the ZX81 ROM.
; Since the table now uses uncompressed values, some extra ROM space is
; required for the table but much more is released by getting rid of routines
; like this.
;;; L1A2D: AND A ; test if initially zero.
;;; L1A2E: RET Z ; return if zero. >>
;;; PUSH AF ; save count.
;;; PUSH DE ; and normal STKEND
;;; LD DE,$0000 ; dummy value for STKEND at start of ROM
;;; CALL STK_CONST ; routine STK-CONST works through variable
;;; ; length records.
;;; POP DE ; restore real STKEND
;;; POP AF ; restore count
;;; DEC A ; decrease
;;; JR L1A2E ; loop back to SKIP-NEXT
; --------------------------------
; THE 'MEMORY LOCATION' SUBROUTINE
; --------------------------------
; This routine, when supplied with a base address in HL and an index in A,
; will calculate the address of the A'th entry, where each entry occupies
; five bytes. It is used for addressing floating-point numbers in the
; calculator's memory area.
LOC_MEM LD C,A ; store the original number $00-$1F.
RLCA ; double.
RLCA ; quadruple.
ADD A,C ; now add original value to multiply by five.
LD C,A ; place the result in C.
LD B,$00 ; set B to 0.
ADD HL,BC ; add to form address of start of number in HL.
RET ; return.
; -------------------------------------
; THE 'GET FROM MEMORY AREA' SUBROUTINE
; -------------------------------------
; offsets $E0 to $FF: 'get-mem-0', 'get-mem-1' etc.
; A holds $00-$1F offset.
; The calculator stack increases by 5 bytes.
; Note. first two instructions have been swapped to create a subroutine.
get_mem_x LD HL,($401F) ; MEM is base address of the memory cells.
INDEX_5 PUSH DE ; save STKEND
CALL LOC_MEM ; routine LOC-MEM so that HL = first byte
CALL MOVE_FP ; routine MOVE-FP moves 5 bytes with memory
; check.
; DE now points to new STKEND.
POP HL ; the original STKEND is now RESULT pointer.
RET ; return.
; ---------------------------------
; THE 'STACK A CONSTANT' SUBROUTINE
; ---------------------------------
; (offset $A0: 'stk-zero')
; (offset $A1: 'stk-one')
; (offset $A2: 'stk-half')
; (offset $A3: 'stk-pi/2')
; (offset $A4: 'stk-ten')
; This routine allows a one-byte instruction to stack up to 32 constants
; held in short form in a table of constants. In fact only 5 constants are
; required. On entry the A register holds the literal ANDed with $1F.
;
; It wasn't very efficient and it is better to hold the
; numbers in full, five byte form and stack them in a similar manner
; to that which which is used by the above routine.
stk_con_x LD HL,TAB_CNST ; Address: Table of constants.
JR INDEX_5 ; and join subsroutine above.
; ---
;;; LD H,D ; save STKEND - required for result
;;; LD L,E ;
;;; EXX ; swap
;;; PUSH HL ; save pointer to next literal
;;; LD HL,L1515 ; Address: stk-zero - start of table of
;;; ; constants
;;; EXX ;
;;; CALL SKIP_CONS ; routine SKIP-CONS
;;; CALL STK_CONST ; routine STK-CONST
;;; EXX ;
;;; POP HL ; restore pointer to next literal.
;;; EXX ;
;;; RET ; return.
; ---------------------------------------
; THE 'STORE IN A MEMORY AREA' SUBROUTINE
; ---------------------------------------
; Offsets $C0 to $DF: 'st-mem-0', 'st-mem-1' etc.
; Although 32 memory storage locations can be addressed, only six
; $C0 to $C5 are required by the ROM and only the thirty bytes (6*5)
; required for these are allocated. ZX81 programmers who wish to
; use the floating point routines from assembly language may wish to
; alter the system variable MEM to point to 160 bytes of RAM to have
; use the full range available.
; A holds derived offset $00-$1F.
; Unary so on entry HL points to last value, DE to STKEND.
sto_mem_x PUSH HL ; save the result pointer.
EX DE,HL ; transfer to DE.
LD HL,($401F) ; fetch MEM the base of memory area.
CALL LOC_MEM ; routine LOC-MEM sets HL to the destination.
EX DE,HL ; swap - HL is start, DE is destination.
;;; CALL MOVE_FP ; routine MOVE-FP.
;;; ; Note. a short ld bc,5; ldir
;;; ; the embedded memory check is not required
;;; ; so these instructions would be faster!
LD C,$05 ;+ one extra byte but
LDIR ;+ faster and no memory check.
EX DE,HL ; DE = STKEND
POP HL ; restore original result pointer
RET ; return.
; -------------------------
; THE 'EXCHANGE' SUBROUTINE
; -------------------------
; offset $01: 'exchange'
; This routine exchanges the last two values on the calculator stack
; On entry, as always with binary operations,
; HL=first number, DE=second number
; On exit, HL=result, DE=stkend.
exchange LD B,$05 ; there are five bytes to be swapped
; start of loop.
SWAP_BYTE LD A,(DE) ; each byte of second
;;; LD C,(HL) ; each byte of first
;;; EX DE,HL ; swap pointers
ld c,a ;+
ld a,(hl) ;+
LD (DE),A ; store each byte of first
LD (HL),C ; store each byte of second
INC HL ; advance both
INC DE ; pointers.
DJNZ SWAP_BYTE ; loop back to SWAP-BYTE until all 5 done.
;;; EX DE,HL ; even up the exchanges (one byte saved)
RET ; return.
; ---------------------------------
; THE 'SERIES GENERATOR' SUBROUTINE
; ---------------------------------
; offset $86: 'series-06'
; offset $88: 'series-08'
; offset $8C: 'series-0C'
; The ZX81 uses Chebyshev polynomials to generate approximations for
; SIN, ATN, LN and EXP. These are named after the Russian mathematician
; Pafnuty Chebyshev, born in 1821, who did much pioneering work on numerical
; series. As far as calculators are concerned, Chebyshev polynomials have an
; advantage over other series, for example the Taylor series, as they can
; reach an approximation in just six iterations for SIN, eight for EXP and
; twelve for LN and ATN. The mechanics of the routine are interesting but
; for full treatment of how these are generated with demonstrations in
; Sinclair BASIC see "The Complete Spectrum ROM Disassembly" by Dr Ian Logan
; and Dr Frank O'Hara, published 1983 by Melbourne House.
seriesg_x LD B,A ; parameter $00 - $1F to B counter
CALL GEN_ENT_1 ; routine GEN-ENT-1 is called.
; A recursive call to a special entry point
; in the calculator that puts the B register
; in the system variable BREG. The return
; address is the next location and where
; the calculator will expect its first
; instruction - now pointed to by HL'.
; The previous pointer to the series of
; five-byte numbers goes on the machine stack.
; The initialization phase.
DEFB $2D ;;duplicate x,x
DEFB $0F ;;addition x+x
DEFB $C0 ;;st-mem-0 x+x
DEFB $02 ;;delete .
DEFB $A0 ;;stk-zero 0
DEFB $C2 ;;st-mem-2 0
; a loop is now entered to perform the algebraic calculation for each of
; the numbers in the series
G_LOOP DEFB $2D ;;duplicate v,v.
DEFB $E0 ;;get-mem-0 v,v,x+2
DEFB $04 ;;multiply v,v*x+2
DEFB $E2 ;;get-mem-2 v,v*x+2,v
DEFB $C1 ;;st-mem-1
DEFB $03 ;;subtract
DEFB $34 ;;end-calc
; the previous pointer is fetched from the machine stack to H'L' where it
; addresses one of the numbers of the series following the series literal.
CALL stk_data ; routine STK-DATA is called directly to
; push a value and advance H'L'.
CALL GEN_ENT_2 ; routine GEN-ENT-2 recursively re-enters
; the calculator without disturbing
; system variable BREG
; H'L' value goes on the machine stack and is
; then loaded as usual with the next address.
DEFB $0F ;;addition
DEFB $01 ;;exchange
DEFB $C2 ;;st-mem-2
DEFB $02 ;;delete
DEFB $31 ;;dec-jr-nz
DEFB G_LOOP - $ ;;back to L1A89, G-LOOP
; when the counted loop is complete the final subtraction yields the result
; for example SIN X.
DEFB $E1 ;;get-mem-1
DEFB $03 ;;subtract
DEFB $34 ;;end-calc
RET ; return with H'L' pointing to location
; after last number in series.
; -----------------------
; Handle unary minus (18)
; -----------------------
; Unary so on entry HL points to last value, DE to STKEND.
negate LD A,(HL) ; fetch exponent of last value on the
; calculator stack.
AND A ; test it.
RET Z ; return if zero.
INC HL ; address the byte with the sign bit.
LD A,(HL) ; fetch to accumulator.
XOR $80 ; toggle the sign bit.
LD (HL),A ; put it back.
DEC HL ; point to last value again.
RET ; return.
; -----------------------
; Absolute magnitude (27)
; -----------------------
; This calculator literal finds the absolute value of the last value,
; floating point, on calculator stack.
abs INC HL ; point to byte with sign bit.
RES 7,(HL) ; make the sign positive.
DEC HL ; point to last value again.
RET ; return.
; -----------
; Signum (26)
; -----------
; This routine replaces the last value on the calculator stack,
; (which is in floating point form), with one if positive and with minus one
; if it is negative. If it is zero then it is left unchanged.
sgn INC HL ; point to first byte of 4-byte mantissa.
LD A,(HL) ; pick up the byte with the sign bit.
DEC HL ; point to exponent.
DEC (HL) ; test the exponent for
INC (HL) ; the value zero.
SCF ; Set the carry flag.
CALL NZ,FP_0_1 ; Routine FP-0/1 replaces last value with one
; if exponent indicates the value is non-zero.
; In either case mantissa is now four zeros.
INC HL ; Point to first byte of 4-byte mantissa.
RLCA ; Rotate original sign bit to carry.
RR (HL) ; Rotate the carry into sign.
DEC HL ; Point to last value.
RET ; Return.
; -------------------------
; Handle PEEK function (28)
; -------------------------
; This function returns the contents of a memory address.
; The entire address space can be peeked including the ROM.
peek CALL FIND_INT ; routine FIND-INT puts address in BC.
LD A,(BC) ; load contents into A register.
IN_PK_STK JP STACK_A ; exit via STACK-A to put value on the
; calculator stack.
; ---------------
; USR number (29)
; ---------------
; The USR function followed by a number 0-65535 is the method by which
; the ZX81 invokes machine code programs. This function returns the
; contents of the BC register pair.
; Note. that STACK-BC re-initializes the IY register to $4000 if a user-written
; program has altered it.
usr_no CALL FIND_INT ; routine FIND-INT to fetch the
; supplied address into BC.
LD HL,STACK_BC ; address: STACK-BC is
PUSH HL ; pushed onto the machine stack.
PUSH BC ; then the address of the machine code
; routine.
RET ; make an indirect jump to the user's routine
; and, hopefully, to STACK-BC also.
; -----------------------
; Greater than zero ($33)
; -----------------------
; Test if the last value on the calculator stack is greater than zero.
; This routine is also called directly from the end-tests of the comparison
; routine.
greater_0 LD A,(HL) ; fetch exponent.
AND A ; test it for zero.
RET Z ; return if so.
LD A,$FF ; prepare XOR mask for sign bit
JR SIGN_TO_C ; forward to SIGN-TO-C
; to put sign in carry
; (carry will become set if sign is positive)
; and then overwrite location with 1 or 0
; as appropriate.
; ------------------------
; Handle NOT operator ($2C)
; ------------------------
; This overwrites the last value with 1 if it was zero else with zero
; if it was any other value.
;
; e.g. NOT 0 returns 1, NOT 1 returns 0, NOT -3 returns 0.
;
; The subroutine is also called directly from the end-tests of the comparison
; operator.
not LD A,(HL) ; get exponent byte.
NEG ; negate - sets carry if non-zero.
CCF ; complement so carry set if zero, else reset.
JR FP_0_1 ; forward to FP-0/1.
; -------------------
; Less than zero (32)
; -------------------
; Destructively test if last value on calculator stack is less than zero.
; Bit 7 of second byte will be set if so.
less_0 XOR A ; set xor mask to zero
; (carry will become set if sign is negative).
; transfer sign of mantissa to Carry Flag.
SIGN_TO_C INC HL ; address 2nd byte.
XOR (HL) ; bit 7 of HL will be set if number is negative.
DEC HL ; address 1st byte again.
RLCA ; rotate bit 7 of A to carry.
; -----------
; Zero or one
; -----------
; This routine places an integer value zero or one at the addressed location
; of calculator stack or MEM area. The value one is written if carry is set on
; entry else zero.
FP_0_1 PUSH HL ; save pointer to the first byte
LD B,$05 ; five bytes to do.
FP_loop LD (HL),$00 ; insert a zero.
INC HL ;
DJNZ FP_loop ; repeat.
POP HL ;
RET NC ;
LD (HL),$81 ; make value 1
RET ; return.
; -----------------------
; Handle OR operator (07)
; -----------------------
; The Boolean OR operator. eg. X OR Y
; The result is zero if both values are zero else a non-zero value.
;
; e.g. 0 OR 0 returns 0.
; -3 OR 0 returns -3.
; 0 OR -3 returns 1.
; -3 OR 2 returns 1.
;
; A binary operation.
; On entry HL points to first operand (X) and DE to second operand (Y).
or LD A,(DE) ; fetch exponent of second number
AND A ; test it.
RET Z ; return if zero.
SCF ; set carry flag
JR FP_0_1 ; back to FP-0/1 to overwrite the first operand
; with the value 1.
; -----------------------------
; Handle number AND number (08)
; -----------------------------
; The Boolean AND operator.
;
; e.g. -3 AND 2 returns -3.
; -3 AND 0 returns 0.
; 0 and -2 returns 0.
; 0 and 0 returns 0.
;
; Compare with OR routine above.
no_v_no LD A,(DE) ; fetch exponent of second number.
AND A ; test it.
RET NZ ; return if not zero.
JR FP_0_1 ; back to FP-0/1 to overwrite the first operand
; with zero for return value.
; -----------------------------
; Handle string AND number (10)
; -----------------------------
; e.g. "YOU WIN" AND SCORE>99 will return the string if condition is true
; or the null string if false.
str_v_no LD A,(DE) ; fetch exponent of second number.
AND A ; test it.
RET NZ ; return if number was not zero - the string
; is the result.
; if the number was zero (false) then the null string must be returned by
; altering the length of the string on the calculator stack to zero.
PUSH DE ; save pointer to the now obsolete number
; (which will become the new STKEND)
DEC DE ; point to the 5th byte of string descriptor.
XOR A ; clear the accumulator.
LD (DE),A ; place zero in high byte of length.
DEC DE ; address low byte of length.
LD (DE),A ; place zero there - now the null string.
POP DE ; restore pointer - new STKEND.
RET ; return.
; -------------------------------------
; Perform comparison ($09-$0E, $11-$16)
; -------------------------------------
; True binary operations.
;
; A single entry point is used to evaluate six numeric and six string
; comparisons. On entry, the calculator literal is in the B register and
; the two numeric values, or the two string parameters, are on the
; calculator stack.
; The individual bits of the literal are manipulated to group similar
; operations although the SUB 8 instruction does nothing useful and merely
; alters the string test bit.
; Numbers are compared by subtracting one from the other, strings are
; compared by comparing every character until a mismatch, or the end of one
; or both, is reached.
;
; Numeric Comparisons.
; --------------------
; The 'x>y' example is the easiest as it employs straight-thru logic.
; Number y is subtracted from x and the result tested for greater-0 yielding
; a final value 1 (true) or 0 (false).
; For 'x<y' the same logic is used but the two values are first swapped on the
; calculator stack.
; For 'x=y' NOT is applied to the subtraction result yielding true if the
; difference was zero and false with anything else.
; The first three numeric comparisons are just the opposite of the last three
; so the same processing steps are used and then a final NOT is applied.
;
; literal Test No sub 8 ExOrNot 1st RRCA exch sub ? End-Tests
; ========= ==== == ======== === ======== ======== ==== === = === === ===
; no-l-eql x<=y 09 00000001 dec 00000000 00000000 ---- x-y ? --- >0? NOT
; no-gr-eql x>=y 0A 00000010 dec 00000001 10000000c swap y-x ? --- >0? NOT
; nos-neql x<>y 0B 00000011 dec 00000010 00000001 ---- x-y ? NOT --- NOT
; no-grtr x>y 0C 00000100 - 00000100 00000010 ---- x-y ? --- >0? ---
; no-less x<y 0D 00000101 - 00000101 10000010c swap y-x ? --- >0? ---
; nos-eql x=y 0E 00000110 - 00000110 00000011 ---- x-y ? NOT --- ---
;
; comp -> C/F
; ==== ===
; str-l-eql x$<=y$ 11 00001001 dec 00001000 00000100 ---- x$y$ 0 !or >0? NOT
; str-gr-eql x$>=y$ 12 00001010 dec 00001001 10000100c swap y$x$ 0 !or >0? NOT
; strs-neql x$<>y$ 13 00001011 dec 00001010 00000101 ---- x$y$ 0 !or >0? NOT
; str-grtr x$>y$ 14 00001100 - 00001100 00000110 ---- x$y$ 0 !or >0? ---
; str-less x$<y$ 15 00001101 - 00001101 10000110c swap y$x$ 0 !or >0? ---
; strs-eql x$=y$ 16 00001110 - 00001110 00000111 ---- x$y$ 0 !or >0? ---
;
; String comparisons are a little different in that the eql/neql carry flag
; from the 2nd RRCA is, as before, fed into the first of the end tests but
; along the way it gets modified by the comparison process. The result on the
; stack always starts off as zero and the carry fed in determines if NOT is
; applied to it. So the only time the greater-0 test is applied is if the
; stack holds zero which is not very efficient as the test will always yield
; zero. The most likely explanation is that there were once separate end tests
; for numbers and strings.
no_l_eql LD A,B ; transfer literal to accumulator.
;;; SUB $08 ; subtract eight - which is not useful.
BIT 2,A ; isolate '>', '<', '='.
JR NZ,EX_OR_NOT ; skip to EX-OR-NOT with these.
DEC A ; else make $00-$02, $08-$0A to match bits 0-2.
EX_OR_NOT RRCA ; the first RRCA sets carry for a swap.
JR NC,NU_OR_STR ; forward to NU-OR-STR with other 8 cases
; for the other 4 cases the two values on the calculator stack are exchanged.
PUSH AF ; save A and carry.
PUSH HL ; save HL - pointer to first operand.
; (DE points to second operand).
CALL exchange ; routine exchange swaps the two values.
; (HL = second operand, DE = STKEND)
POP DE ; DE = first operand
EX DE,HL ; as we were.
POP AF ; restore A and carry.
; Note. it would be better if the 2nd RRCA preceded the string test.
; It would save two duplicate bytes and if we also got rid of that sub 8
; at the beginning we wouldn't have to alter which bit we test.
NU_OR_STR RRCA ;+ causes 'eql/neql' to set carry.
PUSH AF ;+ save the carry flag.
BIT 2,A ; test if a string comparison.
JR NZ,STRINGS ; forward to STRINGS if so.
; continue with numeric comparisons.
;;; RRCA ; 2nd RRCA causes eql/neql to set carry.
;;; PUSH AF ; save A and carry
CALL subtract ; routine subtract leaves result on stack.
JR END_TESTS ; forward to END-TESTS
; ---
STRINGS
;;; RRCA ; 2nd RRCA causes eql/neql to set carry.
;;; PUSH AF ; save A and carry.
CALL STK_FETCH ; routine STK-FETCH gets 2nd string params
PUSH DE ; save start2 *.
PUSH BC ; and the length.
CALL STK_FETCH ; routine STK-FETCH gets 1st string
; parameters - start in DE, length in BC.
POP HL ; restore length of second to HL.
; A loop is now entered to compare, by subtraction, each corresponding character
; of the strings. For each successful match, the pointers are incremented and
; the lengths decreased and the branch taken back to here. If both string
; remainders become null at the same time, then an exact match exists.
BYTE_COMP LD A,H ; test if the second string
OR L ; is the null string and hold flags.
EX (SP),HL ; put length2 on stack, bring start2 to HL *.
LD A,B ; hi byte of length1 to A
JR NZ,SEC_PLUS ; forward to SEC-PLUS if second not null.
OR C ; test length of first string.
SECND_LOW POP BC ; pop the second length off stack.
JR Z,BOTH_NULL ; forward to BOTH-NULL if first string is also
; of zero length.
; the true condition - first is longer than second (SECND-LESS)
POP AF ; restore carry (set if eql/neql)
CCF ; complement carry flag.
; Note. equality becomes false.
; Inequality is true. By swapping or applying
; a terminal 'not', all comparisons have been
; manipulated so that this is success path.
JR STR_TEST ; forward to leave via STR-TEST
; ---
; the branch was here with a match
BOTH_NULL POP AF ; restore carry - set for eql/neql
JR STR_TEST ; forward to STR-TEST
; ---
; the branch was here when 2nd string not null and low byte of first is yet
; to be tested.
SEC_PLUS OR C ; test the length of first string.
JR Z,FRST_LESS ; forward to FRST-LESS if length is zero.
; both strings have at least one character left.
LD A,(DE) ; fetch character of first string.
SUB (HL) ; subtract with that of 2nd string.
JR C,FRST_LESS ; forward to FRST-LESS if carry set
JR NZ,SECND_LOW ; back to SECND-LOW and then STR-TEST
; if not exact match.
DEC BC ; decrease length of 1st string.
INC DE ; increment 1st string pointer.
INC HL ; increment 2nd string pointer.
EX (SP),HL ; swap with length on stack
DEC HL ; decrement 2nd string length
JR BYTE_COMP ; back to BYTE-COMP
; ---
; the false condition.
FRST_LESS POP BC ; discard length
POP AF ; pop A
AND A ; clear the carry for false result.
; ---
; exact match and x$>y$ rejoin here
STR_TEST PUSH AF ; save A and carry
RST 28H ;; FP-CALC
DEFB $A0 ;;stk-zero an initial false value.
DEFB $34 ;;end-calc
; both numeric and string paths converge here.
END_TESTS POP AF ; pop carry - will be set if eql/neql
PUSH AF ; save it again.
CALL C,not ; routine NOT sets true(1) if equal(0)
; or, for strings, applies true result.
CALL greater_0 ; greater-0
POP AF ; pop A
RRCA ; the third RRCA - test for '<=', '>=' or '<>'.
CALL NC,not ; apply a terminal NOT if so.
RET ; return.
; -----------------------------------
; THE 'STRING CONCATENATION' OPERATOR
; -----------------------------------
; (offset $17: 'strs_add')
; This literal combines two strings into one e.g. LET A$ = B$ + C$
; The two parameters of the two strings to be combined are on the stack.
strs_add
CALL STK_FETCH ; routine STK-FETCH fetches string parameters
; and deletes calculator stack entry.
PUSH DE ; save start address.
PUSH BC ; and length.
CALL STK_FETCH ; routine STK-FETCH for first string
POP HL ; re-fetch first length
PUSH HL ; and save again
PUSH DE ; save start of second string
PUSH BC ; and its length.
ADD HL,BC ; add the two lengths.
LD B,H ; transfer to BC
LD C,L ; and create
RST 30H ; BC-SPACES in workspace.
; DE points to start of space.
CALL STK_STO_s ; routine STK-STO-$ stores parameters
; of new string updating STKEND.
POP BC ; length of first
POP HL ; address of start
;;; LD A,B ; test for
;;; OR C ; zero length.
;;; JR Z,OTHER_STR ; to OTHER-STR if null string
;;; LDIR ; copy string to workspace.
CALL COND_MV ;+ a conditional (NZ) ldir routine.
OTHER_STR POP BC ; now second length
POP HL ; and start of string
;;; LD A,B ; test this one
;;; OR C ; for zero length
;;; JR Z,STK_PNTRS ; skip forward to STK-PNTRS if so as complete.
;;; LDIR ; else copy the bytes.
CALL COND_MV ;+ a conditional (NZ) ldir routine.
; Continue into next routine which sets the calculator stack pointers.
; ----------------------------
; THE 'STACK POINTERS' ROUTINE
; ----------------------------
; Register DE is set to STKEND and HL, the result pointer, is set to five
; locations below this - the 'last value'.
; This routine is used when it is inconvenient to save these values at the
; time the calculator stack is manipulated due to other activity on the
; machine stack.
; This routine is also used to terminate the VAL routine for
; the same reason and to initialize the calculator stack at the start of
; the CALCULATE routine.
STK_PNTRS LD HL,($401C) ; fetch STKEND value from system variable.
LD DE,$FFFB ; the value -5
PUSH HL ; push STKEND value.
ADD HL,DE ; subtract 5 from HL.
POP DE ; pop STKEND to DE.
RET ; return.
; -------------------
; THE 'CHR$' FUNCTION
; -------------------
; (offset $2B: 'chr$')
; This function returns a single character string that is a result of
; converting a number in the range 0-255 to a string e.g. CHR$ 38 = "A".
; Note. the ZX81 does not have an ASCII character set.
chrS CALL FP_TO_A ; routine FP-TO-A puts the number in A.
JR C,REPORT_Bd ; forward to REPORT-Bd if overflow
JR NZ,REPORT_Bd ; forward to REPORT-Bd if negative
;;; PUSH AF ; save the argument.
LD BC,$0001 ; one space required.
RST 30H ; BC-SPACES makes DE point to start
;;; POP AF ; restore the number.
LD (DE),A ; and store in workspace
JR str_STK ;+ relative jump to similar sequence in str$.
;;; CALL STK_STO_s ; routine STK-STO-$ stacks descriptor.
;;; EX DE,HL ; make HL point to result and DE to STKEND.
;;; RET ; return.
; ---
REPORT_Bd RST 08H ; ERROR-1
DEFB $0A ; Error Report: Integer out of range
; ------------------
; THE 'VAL' FUNCTION
; ------------------
; (offset $1A: 'val')
; VAL treats the characters in a string as a numeric expression.
; e.g. VAL "2.3" = 2.3, VAL "2+4" = 6, VAL ("2" + "4") = 24.
val RST 18H ;+ shorter way to fetch CH_ADD.
;;; LD HL,($4016) ; fetch value of system variable CH_ADD
PUSH HL ; and save on the machine stack.
CALL STK_FETCH ; routine STK-FETCH fetches the string operand
; from calculator stack.
PUSH DE ; save the address of the start of the string.
INC BC ; increment the length for a carriage return.
RST 30H ; BC-SPACES creates the space in workspace.
POP HL ; restore start of string to HL.
LD ($4016),DE ; load CH_ADD with start DE in workspace.
PUSH DE ; save the start in workspace
LDIR ; copy string from program or variables or
; workspace to the workspace area.
EX DE,HL ; end of string + 1 to HL
DEC HL ; decrement HL to point to end of new area.
LD (HL),$76 ; insert a carriage return at end.
; ZX81 has a non-ASCII character set
RES 7,(IY+$01) ; update FLAGS - signal checking syntax.
CALL CLASS_06 ; routine CLASS-06 - SCANNING evaluates string
; expression and checks for integer result.
CALL CHECK_2 ; routine CHECK-2 checks for carriage return.
POP HL ; restore start of string in workspace.
LD ($4016),HL ; set CH_ADD to the start of the string again.
SET 7,(IY+$01) ; update FLAGS - signal running program.
CALL SCANNING ; routine SCANNING evaluates the string
; in full leaving result on calculator stack.
POP HL ; restore saved character address in program.
LD ($4016),HL ; and reset the system variable CH_ADD.
JR STK_PNTRS ; back to exit via STK-PNTRS.
; resetting the calculator stack pointers
; HL and DE from STKEND as it wasn't possible
; to preserve them during this routine.
; -------------------
; THE 'STR$' FUNCTION
; -------------------
; (offset $2A: 'str$')
; This function returns a string representation of a numeric argument.
; The method used is to trick the PRINT-FP routine into thinking it
; is writing to a collapsed display file when in fact it is writing to
; string workspace.
; If there is already a newline at the intended print position and the
; column count has not been reduced to zero then the print routine
; assumes that there is only 1K of RAM and the screen memory, like the rest
; of dynamic memory, expands as necessary using calls to the ONE-SPACE
; routine. The screen is character-mapped not bit-mapped.
strS LD BC,$0001 ; create an initial byte in workspace
RST 30H ; using BC-SPACES restart.
LD (HL),$76 ; place a carriage return there.
LD HL,($4039) ; fetch value of S_POSN column/line
PUSH HL ; and preserve on stack.
LD L,$FF ; make column value high to create a
; contrived buffer of length 254.
LD ($4039),HL ; and store in system variable S_POSN.
LD HL,($400E) ; fetch value of DF_CC
PUSH HL ; and preserve on stack also.
LD ($400E),DE ; now set DF_CC which normally addresses
; somewhere in the display file to the start
; of workspace.
PUSH DE ; save the start of new string.
CALL PRINT_FP ; routine PRINT-FP.
POP DE ; retrieve start of string.
LD HL,($400E) ; fetch end of string from DF_CC.
AND A ; prepare for true subtraction.
SBC HL,DE ; subtract to give length.
LD B,H ; and transfer to the BC
LD C,L ; register.
POP HL ; restore original
LD ($400E),HL ; DF_CC value
POP HL ; restore original
LD ($4039),HL ; S_POSN values.
; New entry-point to exploit similarities and save 3 bytes of code.
str_STK CALL STK_STO_s ; routine STK-STO-$ stores the string
; descriptor on the calculator stack.
EX DE,HL ; HL = last value, DE = STKEND.
RET ; return.
; -------------------
; THE 'CODE' FUNCTION
; -------------------
; (offset $19: 'code')
; Returns the code of a character or first character of a string
; e.g. CODE "AARDVARK" = 38 (not 65 as the ZX81 does not have an ASCII
; character set).
code CALL STK_FETCH ; routine STK-FETCH to fetch and delete the
; string parameters.
; DE points to the start, BC holds the length.
LD A,B ; test length
OR C ; of the string.
JR Z,STK_CODE ; skip to STK-CODE with zero if the null string.
LD A,(DE) ; else fetch the first character.
STK_CODE JP STACK_A ; jump back to STACK-A (with memory check)
; --------------------
; THE 'LEN' SUBROUTINE
; --------------------
; (offset $1b: 'len')
; Returns the length of a string.
; In Sinclair BASIC strings can be more than twenty thousand characters long
; so a sixteen-bit register is required to store the length
len CALL STK_FETCH ; routine STK-FETCH to fetch and delete the
; string parameters from the calculator stack.
; register BC now holds the length of string.
JP STACK_BC ; jump back to STACK-BC to save result on the
; calculator stack (with memory check).
; -------------------------------------
; THE 'DECREASE THE COUNTER' SUBROUTINE
; -------------------------------------
; (offset $31: 'dec-jr-nz')
; The calculator has an instruction that decrements a single-byte
; pseudo-register and makes consequential relative jumps just like
; the Z80's DJNZ instruction.
dec_jr_nz EXX ; switch in set that addresses code
PUSH HL ; save pointer to offset byte
LD HL,$401E ; address BREG in system variables
DEC (HL) ; decrement it
POP HL ; restore pointer
JR NZ,JUMP_2 ; to JUMP-2 if not zero
INC HL ; step past the jump length.
EXX ; switch in the main set.
RET ; return.
; Note. as a general rule the calculator avoids using the IY register
; otherwise the cumbersome 4 instructions in the middle could be replaced by
; dec (iy+$xx) - using three instruction bytes instead of six.
; ---------------------
; THE 'JUMP' SUBROUTINE
; ---------------------
; (Offset $2F; 'jump')
; This enables the calculator to perform relative jumps just like
; the Z80 chip's JR instruction.
; This is one of the few routines that was polished for the ZX Spectrum.
JUMP EXX ;switch in pointer set
JUMP_2 LD E,(HL) ; the jump byte 0-127 forward, 128-255 back.
; Note. Elegance from the ZX Spectrum.
LD A,E ;+
RLA ;+
SBC A,A ;+
; The original ZX81 code.
;;; XOR A ; clear accumulator.
;;; BIT 7,E ; test if negative jump
;;; JR Z,JUMP_3 ; skip, if positive, to JUMP-3.
;;; CPL ; else change to $FF.
JUMP_3 LD D,A ; transfer to high byte.
ADD HL,DE ; advance calculator pointer forward or back.
EXX ; switch out pointer set.
RET ; return.
; -----------------------------
; THE 'JUMP ON TRUE' SUBROUTINE
; -----------------------------
; (Offset $00; 'jump-true')
; This enables the calculator to perform conditional relative jumps
; dependent on whether the last test gave a true result
; On the ZX81, the exponent will be zero for zero or else $81 for one.
jump_true LD A,(DE) ; collect exponent byte
AND A ; is result 0 or 1 ?
JR NZ,JUMP ; back to JUMP if true (1).
EXX ; else switch in the pointer set.
INC HL ; step past the jump length.
EXX ; switch in the main set.
RET ; return.
; ------------------------
; THE 'MODULUS' SUBROUTINE
; ------------------------
; ( Offset $2E: 'n-mod-m' )
; ( i1, i2 -- i3, i4 )
; The subroutine calculate N mod M where M is the positive integer, the
; 'last value' on the calculator stack and N is the integer beneath.
; The subroutine returns the integer quotient as the last value and the
; remainder as the value beneath.
; e.g. 17 MOD 3 = 5 remainder 2
; It is invoked during the calculation of a random number and also by
; the PRINT-FP routine.
n_mod_m RST 28H ;; FP-CALC 17, 3.
DEFB $C0 ;;st-mem-0 17, 3.
DEFB $02 ;;delete 17.
DEFB $2D ;;duplicate 17, 17.
DEFB $E0 ;;get-mem-0 17, 17, 3.
DEFB $05 ;;division 17, 17/3.
DEFB $24 ;;int 17, 5.
DEFB $E0 ;;get-mem-0 17, 5, 3.
DEFB $01 ;;exchange 17, 3, 5.
DEFB $C0 ;;st-mem-0 17, 3, 5.
DEFB $04 ;;multiply 17, 15.
DEFB $03 ;;subtract 2.
DEFB $E0 ;;get-mem-0 2, 5.
DEFB $34 ;;end-calc 2, 5.
RET ; return.
; ----------------------
; THE 'INTEGER' FUNCTION
; ----------------------
; (offset $24: 'int')
; This function returns the integer of x, which is just the same as truncate
; for positive numbers. The truncate literal truncates negative numbers
; upwards so that -3.4 gives -3 whereas the BASIC INT function has to
; truncate negative numbers down so that INT -3.4 is 4.
; It is best to work through using, say, plus and minus 3.4 as examples.
int RST 28H ;; FP-CALC x. (= 3.4 or -3.4).
DEFB $2D ;;duplicate x, x.
DEFB $32 ;;less-0 x, (1/0)
DEFB $00 ;;jump-true x, (1/0)
DEFB $04 ;;to L1C46, X-NEG
DEFB $36 ;;truncate trunc 3.4 = 3.
DEFB $34 ;;end-calc 3.
RET ; return with + int x on stack.
X_NEG DEFB $2D ;;duplicate -3.4, -3.4.
DEFB $36 ;;truncate -3.4, -3.
DEFB $C0 ;;st-mem-0 -3.4, -3.
DEFB $03 ;;subtract -.4
DEFB $E0 ;;get-mem-0 -.4, -3.
DEFB $01 ;;exchange -3, -.4.
DEFB $2C ;;not -3, (0).
DEFB $00 ;;jump-true -3.
DEFB $03 ;;to L1C59, EXIT -3.
DEFB $A1 ;;stk-one -3, 1.
DEFB $03 ;;subtract -4.
EXIT DEFB $34 ;;end-calc -4.
RET ; return.
; --------------------------
; THE 'EXPONENTIAL' FUNCTION
; --------------------------
; (Offset $23: 'exp')
; The exponential function returns the exponential of the argument, or the
; value of 'e' (2.7182818...) raised to the power of the argument.
; PRINT EXP 1 gives 2.7182818
;
; EXP is the opposite of the LN function (see below) and is equivalent to
; the 'antiln' function found on pocket calculators or the 'Inverse ln'
; function found on the Windows scientific calculator.
; So PRINT EXP LN 5.3 will give 5.3 as will PRINT LN EXP 5.3 or indeed
; any number e.g. PRINT EXP LN PI.
;
; The applications of the exponential function are in areas where exponential
; growth is experienced, calculus, population growth and compound interest.
;
; Error 6 if the argument is above 88.
exp RST 28H ;; FP-CALC
DEFB $30 ;;stk-data 1/LN 2
DEFB $F1 ;;Exponent: $81, Bytes: 4
DEFB $38,$AA,$3B,$29 ;;
DEFB $04 ;;multiply
DEFB $2D ;;duplicate
DEFB $24 ;;int
DEFB $C3 ;;st-mem-3
DEFB $03 ;;subtract
DEFB $2D ;;duplicate
DEFB $0F ;;addition
DEFB $A1 ;;stk-one
DEFB $03 ;;subtract
DEFB $88 ;;series-08
DEFB $13 ;;Exponent: $63, Bytes: 1
DEFB $36 ;;(+00,+00,+00)
DEFB $58 ;;Exponent: $68, Bytes: 2
DEFB $65,$66 ;;(+00,+00)
DEFB $9D ;;Exponent: $6D, Bytes: 3
DEFB $78,$65,$40 ;;(+00)
DEFB $A2 ;;Exponent: $72, Bytes: 3
DEFB $60,$32,$C9 ;;(+00)
DEFB $E7 ;;Exponent: $77, Bytes: 4
DEFB $21,$F7,$AF,$24 ;;
DEFB $EB ;;Exponent: $7B, Bytes: 4
DEFB $2F,$B0,$B0,$14 ;;
DEFB $EE ;;Exponent: $7E, Bytes: 4
DEFB $7E,$BB,$94,$58 ;;
DEFB $F1 ;;Exponent: $81, Bytes: 4
DEFB $3A,$7E,$F8,$CF ;;
DEFB $E3 ;;get-mem-3
DEFB $34 ;;end-calc
CALL FP_TO_A ; routine FP-TO-A
JR NZ,N_NEGTV ; to N-NEGTV
JR C,REPORT_6b ; to REPORT-6b
ADD A,(HL) ;
JR NC,RESULT_OK ; to RESULT-OK
REPORT_6b RST 08H ; ERROR-1
DEFB $05 ; Error Report: Number too big
N_NEGTV JR C,RSLT_ZERO ; to RSLT-ZERO
SUB (HL) ;
JR NC,RSLT_ZERO ; to RSLT-ZERO
NEG ; Negate
RESULT_OK LD (HL),A ;
RET ; return.
RSLT_ZERO RST 28H ;; FP-CALC
DEFB $02 ;;delete
DEFB $A0 ;;stk-zero
DEFB $34 ;;end-calc
RET ; return.
; --------------------------------
; THE 'NATURAL LOGARITHM' FUNCTION
; --------------------------------
; (offset $22: 'ln')
; Like the ZX81 itself, 'natural' logarithms came from Scotland.
; They were devised in 1614 by well-traveled Scotsman John Napier who noted
; "Nothing doth more molest and hinder calculators than the multiplications,
; divisions, square and cubical extractions of great numbers".
; Napier's logarithms enabled the above operations to be accomplished by
; simple addition and subtraction simplifying the navigational and
; astronomical calculations which beset his age.
; Napier's logarithms were quickly overtaken by logarithms to the base 10
; devised, in conjunction with Napier, by Henry Briggs a Cambridge-educated
; professor of Geometry at Oxford University. These simplified the layout
; of the tables enabling humans to easily scale calculations.
;
; It is only recently with the introduction of pocket calculators and
; computers like the ZX81 that natural logarithms are once more at the fore,
; although some computers retain logarithms to the base ten.
; 'Natural' logarithms are powers to the base 'e', which like 'pi' is a
; naturally occurring number in branches of mathematics.
; Like 'pi' also, 'e' is an irrational number and starts 2.718281828...
;
; The tabular use of logarithms was that to multiply two numbers one looked
; up their two logarithms in the tables, added them together and then looked
; for the result in a table of antilogarithms to give the desired product.
;
; The EXP function is the BASIC equivalent of a calculator's 'antiln' function
; and by picking any two numbers, 1.72 and 6.89 say,
; 10 PRINT EXP ( LN 1.72 + LN 6.89 )
; will give just the same result as
; 20 PRINT 1.72 * 6.89.
; Division is accomplished by subtracting the two logs.
;
; Napier also mentioned "square and cubicle extractions".
; To raise a number to the power 3, find its 'ln', multiply by 3 and find the
; 'antiln'. e.g. PRINT EXP( LN 4 * 3 ) gives 64.
; Similarly to find the n'th root divide the logarithm by 'n'.
; The ZX81 ROM used PRINT EXP ( LN 9 / 2 ) to find the square root of the
; number 9. The Napieran square root function is just a special case of
; the 'to_power' function. A cube root or indeed any root/power would be just
; as simple.
; First test that the argument to LN is a positive, non-zero number.
ln RST 28H ;; FP-CALC x.
DEFB $2D ;;duplicate x,x.
DEFB $33 ;;greater-0 x,(0/1).
DEFB $00 ;;jump-true x.
DEFB $04 ;;to L1CB1, VALID
DEFB $34 ;;end-calc x.
REPORT_Ab RST 08H ; ERROR-1
DEFB $09 ; Error Report: Invalid argument
VALID
;;; DEFB $A0 ;;stk-zero
;;; DEFB $02 ;;delete
DEFB $34 ;;end-calc x.
; Register HL addresses the 'last value' x.
LD A,(HL) ; Fetch exponent to A.
LD (HL),$80 ; Insert 'plus zero' as exponent.
CALL STACK_A ; routine STACK-A stacks true binary exponent.
RST 28H ;; FP-CALC
DEFB $30 ;;stk-data
DEFB $38 ;;Exponent: $88, Bytes: 1
DEFB $00 ;;(+00,+00,+00)
DEFB $03 ;;subtract
DEFB $01 ;;exchange
DEFB $2D ;;duplicate
DEFB $30 ;;stk-data
DEFB $F0 ;;Exponent: $80, Bytes: 4
DEFB $4C,$CC,$CC,$CD ;;
DEFB $03 ;;subtract
DEFB $33 ;;greater-0
DEFB $00 ;;jump-true
DEFB $08 ;;to L1CD2, GRE.8
DEFB $01 ;;exchange
DEFB $A1 ;;stk-one
DEFB $03 ;;subtract
DEFB $01 ;;exchange
DEFB $34 ;;end-calc
INC (HL) ;
RST 28H ;; FP-CALC
GRE_8 DEFB $01 ;;exchange
DEFB $30 ;;stk-data LN 2
DEFB $F0 ;;Exponent: $80, Bytes: 4
DEFB $31,$72,$17,$F8 ;;
DEFB $04 ;;multiply
DEFB $01 ;;exchange
DEFB $A2 ;;stk-half
DEFB $03 ;;subtract
DEFB $A2 ;;stk-half
DEFB $03 ;;subtract
DEFB $2D ;;duplicate
DEFB $30 ;;stk-data
DEFB $32 ;;Exponent: $82, Bytes: 1
DEFB $20 ;;(+00,+00,+00)
DEFB $04 ;;multiply
DEFB $A2 ;;stk-half
DEFB $03 ;;subtract
DEFB $8C ;;series-0C
DEFB $11 ;;Exponent: $61, Bytes: 1
DEFB $AC ;;(+00,+00,+00)
DEFB $14 ;;Exponent: $64, Bytes: 1
DEFB $09 ;;(+00,+00,+00)
DEFB $56 ;;Exponent: $66, Bytes: 2
DEFB $DA,$A5 ;;(+00,+00)
DEFB $59 ;;Exponent: $69, Bytes: 2
DEFB $30,$C5 ;;(+00,+00)
DEFB $5C ;;Exponent: $6C, Bytes: 2
DEFB $90,$AA ;;(+00,+00)
DEFB $9E ;;Exponent: $6E, Bytes: 3
DEFB $70,$6F,$61 ;;(+00)
DEFB $A1 ;;Exponent: $71, Bytes: 3
DEFB $CB,$DA,$96 ;;(+00)
DEFB $A4 ;;Exponent: $74, Bytes: 3
DEFB $31,$9F,$B4 ;;(+00)
DEFB $E7 ;;Exponent: $77, Bytes: 4
DEFB $A0,$FE,$5C,$FC ;;
DEFB $EA ;;Exponent: $7A, Bytes: 4
DEFB $1B,$43,$CA,$36 ;;
DEFB $ED ;;Exponent: $7D, Bytes: 4
DEFB $A7,$9C,$7E,$5E ;;
DEFB $F0 ;;Exponent: $80, Bytes: 4
DEFB $6E,$23,$80,$93 ;;
DEFB $04 ;;multiply
DEFB $0F ;;addition
DEFB $34 ;;end-calc
RET ; return.
; ------------------------------
; THE NEW 'SQUARE ROOT' FUNCTION
; ------------------------------
; (Offset $25: 'sqr')
; "If I have seen further, it is by standing on the shoulders of giants" -
; Sir Isaac Newton, Cambridge 1676.
; The sqr function has been re-written to use the Newton-Raphson method.
; Joseph Raphson was a student of Sir Isaac Newton at Cambridge University
; and helped publicize his work.
; Although Newton's method is centuries old, this routine, appropriately, is
; based on a FORTH word written by Steven Vickers in the Jupiter Ace manual.
; Whereas that method uses an initial guess of one, this one manipulates
; the exponent byte to obtain a better starting guess.
; First test for zero and return zero, if so, as the result.
; If the argument is negative, then produce an error.
sqr RST 28H ;; FP-CALC x
DEFB $C3 ;;st-mem-3 x. (seed for guess)
DEFB $34 ;;end-calc x.
; HL now points to exponent of argument on calculator stack.
LD A,(HL) ; Test for zero argument
AND A ;
RET Z ; Return with zero on the calculator stack.
; Test for a positive argument
INC HL ; Address byte with sign bit.
BIT 7,(HL) ; Test the bit.
JR NZ,REPORT_Ab ; back to REPORT_A
; 'Invalid argument'
; This guess is based on a Usenet discussion.
; Halve the exponent to achieve a good guess.(accurate with .25 16 64 etc.)
LD HL,$4071 ; Address first byte of mem-3
LD A,(HL) ; fetch exponent of mem-3
XOR $80 ; toggle sign of exponent of mem-3
SRA A ; shift right, bit 7 unchanged.
INC A ;
JR Z,ASIS ; forward with say .25 -> .5
JP P,ASIS ; leave increment if value > .5
DEC A ; restore to shift only.
ASIS XOR $80 ; restore sign.
LD (HL),A ; and put back 'halved' exponent.
; Now re-enter the calculator.
RST 28H ;; FP-CALC x
SLOOP DEFB $2D ;;duplicate x,x.
DEFB $E3 ;;get-mem-3 x,x,guess
DEFB $C4 ;;st-mem-4 x,x,guess
DEFB $05 ;;div x,x/guess.
DEFB $E3 ;;get-mem-3 x,x/guess,guess
DEFB $0F ;;addition x,x/guess+guess
DEFB $A2 ;;stk-half x,x/guess+guess,.5
DEFB $04 ;;multiply x,(x/guess+guess)*.5
DEFB $C3 ;;st-mem-3 x,newguess
DEFB $E4 ;;get-mem-4 x,newguess,oldguess
DEFB $03 ;;subtract x,newguess-oldguess
DEFB $27 ;;abs x,difference.
DEFB $33 ;;greater-0 x,(0/1).
DEFB $00 ;;jump-true x.
DEFB SLOOP - $ ;;to sloop x.
DEFB $02 ;;delete .
DEFB $E3 ;;get-mem-3 retrieve final guess.
DEFB $34 ;;end-calc sqr x.
RET ; return with square root on stack
; or in ZX81 BASIC
;
; 5 PRINT "NEWTON RAPHSON SQUARE ROOTS"
; 10 INPUT "NUMBER ";N
; 20 INPUT "GUESS ";G
; 30 PRINT " NUMBER "; N ;" GUESS "; G
; 40 FOR I = 1 TO 10
; 50 LET B = N/G
; 60 LET C = B+G
; 70 LET G = C/2
; 80 PRINT I; " VALUE "; G
; 90 NEXT I
; 100 PRINT "NAPIER METHOD"; SQR N
; -----------------------------
; THE 'TRIGONOMETRIC' FUNCTIONS
; -----------------------------
; Trigonometry is rocket science. It is also used by carpenters and pyramid
; builders.
; Some uses can be quite abstract but the principles can be seen in simple
; right-angled triangles. Triangles have some special properties -
;
; 1) The sum of the three angles is always PI radians (180 degrees).
; Very helpful if you know two angles and wish to find the third.
; 2) In any right-angled triangle the sum of the squares of the two shorter
; sides is equal to the square of the longest side opposite the right-angle.
; Very useful if you know the length of two sides and wish to know the
; length of the third side.
; 3) Functions sine, cosine and tangent enable one to calculate the length
; of an unknown side when the length of one other side and an angle is
; known.
; 4) Functions arcsin, arccosine and arctan enable one to calculate an unknown
; angle when the length of two of the sides is known.
; --------------------------------
; THE 'REDUCE ARGUMENT' SUBROUTINE
; --------------------------------
; (offset $35: 'get-argt')
;
; This routine performs two functions on the angle, in radians, that forms
; the argument to the sine and cosine functions.
; First it ensures that the angle 'wraps round'. That if a ship turns through
; an angle of, say, 3*PI radians (540 degrees) then the net effect is to turn
; through an angle of PI radians (180 degrees).
; Secondly it converts the angle in radians to a fraction of a right angle,
; depending within which quadrant the angle lies, with the periodicity
; resembling that of the desired sine value.
; The result lies in the range -1 to +1.
;
; 90 deg.
;
; (pi/2)
; II +1 I
; |
; sin+ |\ | /| sin+
; cos- | \ | / | cos+
; tan- | \ | / | tan+
; | \|/) |
; 180 deg. (pi) 0 -|----+----|-- 0 (0) 0 degrees
; | /|\ |
; sin- | / | \ | sin-
; cos- | / | \ | cos+
; tan+ |/ | \| tan-
; |
; III -1 IV
; (3pi/2)
;
; 270 deg.
get_argt RST 28H ;; FP-CALC X.
DEFB $30 ;;stk-data
DEFB $EE ;;Exponent: $7E,
;;Bytes: 4
DEFB $22,$F9,$83,$6E ;; X, 1/(2*PI)
DEFB $04 ;;multiply X/(2*PI) = fraction
DEFB $2D ;;duplicate
DEFB $A2 ;;stk-half
DEFB $0F ;;addition
DEFB $24 ;;int
DEFB $03 ;;subtract now range -.5 to .5
DEFB $2D ;;duplicate
DEFB $0F ;;addition now range -1 to 1.
DEFB $2D ;;duplicate
DEFB $0F ;;addition now range -2 to 2.
; quadrant I (0 to +1) and quadrant IV (-1 to 0) are now correct.
; quadrant II ranges +1 to +2.
; quadrant III ranges -2 to -1.
DEFB $2D ;;duplicate Y, Y.
DEFB $27 ;;abs Y, abs(Y). range 1 to 2
DEFB $A1 ;;stk-one Y, abs(Y), 1.
DEFB $03 ;;subtract Y, abs(Y)-1. range 0 to 1
DEFB $2D ;;duplicate Y, Z, Z.
DEFB $33 ;;greater-0 Y, Z, (1/0).
DEFB $C0 ;;st-mem-0 store as possible sign
;; for cosine function.
DEFB $00 ;;jump-true
DEFB $04 ;;to L1D35, ZPLUS with quadrants II and III
; else the angle lies in quadrant I or IV and value Y is already correct.
DEFB $02 ;;delete Y delete test value.
DEFB $34 ;;end-calc Y.
RET ; return. with Q1 and Q4 >>>
; The branch was here with quadrants II (0 to 1) and III (1 to 0).
; Y will hold -2 to -1 if this is quadrant III.
ZPLUS DEFB $A1 ;;stk-one Y, Z, 1
DEFB $03 ;;subtract Y, Z-1. Q3 = 0 to -1
DEFB $01 ;;exchange Z-1, Y.
DEFB $32 ;;less-0 Z-1, (1/0).
DEFB $00 ;;jump-true Z-1.
DEFB $02 ;;to L1D3C, YNEG
;;if angle in quadrant III
; else angle is within quadrant II (-1 to 0)
DEFB $18 ;;negate range +1 to 0
YNEG DEFB $34 ;;end-calc quadrants II and III correct.
RET ; return.
; ---------------------
; THE 'COSINE' FUNCTION
; ---------------------
; (offset $1D: 'cos')
; Cosines are calculated as the sine of the opposite angle rectifying the
; sign depending on the quadrant rules.
;
;
; /|
; h /y|
; / |o
; /x |
; /----|
; a
;
; The cosine of angle x is the adjacent side (a) divided by the hypotenuse 1.
; However if we examine angle y then a/h is the sine of that angle.
; Since angle x plus angle y equals a right-angle, we can find angle y by
; subtracting angle x from pi/2.
; However it's just as easy to reduce the argument first and subtract the
; reduced argument from the value 1 (a reduced right-angle).
; It's even easier to subtract 1 from the angle and rectify the sign.
; In fact, after reducing the argument, the absolute value of the argument
; is used and rectified using the test result stored in mem-0 by 'get-argt'
; for that purpose.
cos RST 28H ;; FP-CALC angle in radians.
DEFB $35 ;;get-argt X reduce -1 to +1
DEFB $27 ;;abs ABS X 0 to 1
DEFB $A1 ;;stk-one ABS X, 1.
DEFB $03 ;;subtract now opposite angle
;; though negative sign.
DEFB $E0 ;;get-mem-0 fetch sign indicator.
DEFB $00 ;;jump-true
DEFB $06 ;;fwd to L1D4B, C-ENT
;;forward to common code if in QII or QIII
DEFB $18 ;;negate else make positive.
DEFB $2F ;;jump
DEFB $03 ;;fwd to L1D4B, C-ENT
;;with quadrants QI and QIV
; -------------------
; THE 'SINE' FUNCTION
; -------------------
; (offset $1C: 'sin')
; This is a fundamental transcendental function from which others such as cos
; and tan are directly, or indirectly, derived.
; It uses the series generator to produce Chebyshev polynomials.
;
;
; /|
; 1 / |
; / |x
; /a |
; /----|
; y
;
; The 'get-argt' function is designed to modify the angle and its sign
; in line with the desired sine value and afterwards it can launch straight
; into common code.
sin RST 28H ;; FP-CALC angle in radians
DEFB $35 ;;get-argt reduce - sign now correct.
C_ENT DEFB $2D ;;duplicate
DEFB $2D ;;duplicate
DEFB $04 ;;multiply
DEFB $2D ;;duplicate
DEFB $0F ;;addition
DEFB $A1 ;;stk-one
DEFB $03 ;;subtract
DEFB $86 ;;series-06
DEFB $14 ;;Exponent: $64, Bytes: 1
DEFB $E6 ;;(+00,+00,+00)
DEFB $5C ;;Exponent: $6C, Bytes: 2
DEFB $1F,$0B ;;(+00,+00)
DEFB $A3 ;;Exponent: $73, Bytes: 3
DEFB $8F,$38,$EE ;;(+00)
DEFB $E9 ;;Exponent: $79, Bytes: 4
DEFB $15,$63,$BB,$23 ;;
DEFB $EE ;;Exponent: $7E, Bytes: 4
DEFB $92,$0D,$CD,$ED ;;
DEFB $F1 ;;Exponent: $81, Bytes: 4
DEFB $23,$5D,$1B,$EA ;;
DEFB $04 ;;multiply
DEFB $34 ;;end-calc
RET ; return.
; ----------------------
; THE 'TANGENT' FUNCTION
; ----------------------
; (offset $1E: 'tan')
;
; Evaluates tangent x as sin(x) / cos(x).
;
;
; /|
; h / |
; / |o
; /x |
; /----|
; a
;
; The tangent of angle x is the ratio of the length of the opposite side
; divided by the length of the adjacent side. As the opposite length can
; be calculates using sin(x) and the adjacent length using cos(x) then
; the tangent can be defined in terms of the previous two functions.
; Error 6 if the argument, in radians, is too close to one like pi/2
; which has an infinite tangent. e.g. PRINT TAN (PI/2) evaluates as 1/0.
; Similarly PRINT TAN (3*PI/2), TAN (5*PI/2) etc.
tan RST 28H ;; FP-CALC x.
DEFB $2D ;;duplicate x, x.
DEFB $1C ;;sin x, sin x.
DEFB $01 ;;exchange sin x, x.
DEFB $1D ;;cos sin x, cos x.
DEFB $05 ;;division sin x/cos x (= tan x).
DEFB $34 ;;end-calc tan x.
RET ; return.
; ---------------------
; THE 'ARCTAN' FUNCTION
; ---------------------
; (Offset $21: 'atn')
; The inverse tangent function with the result in radians.
; This is a fundamental transcendental function from which others such as asn
; and acs are directly, or indirectly, derived.
; It uses the series generator to produce Chebyshev polynomials.
atn LD A,(HL) ; fetch exponent
CP $81 ; compare to that for 'one'
JR C,SMALL ; forward, if less, to SMALL
RST 28H ;; FP-CALC X.
DEFB $A1 ;;stk-one
DEFB $18 ;;negate
DEFB $01 ;;exchange
DEFB $05 ;;division
DEFB $2D ;;duplicate
DEFB $32 ;;less-0
DEFB $A3 ;;stk-pi/2
DEFB $01 ;;exchange
DEFB $00 ;;jump-true
DEFB $06 ;;to L1D8B, CASES
DEFB $18 ;;negate
DEFB $2F ;;jump
DEFB $03 ;;to L1D8B, CASES
; ---
SMALL RST 28H ;; FP-CALC
DEFB $A0 ;;stk-zero
CASES DEFB $01 ;;exchange
DEFB $2D ;;duplicate
DEFB $2D ;;duplicate
DEFB $04 ;;multiply
DEFB $2D ;;duplicate
DEFB $0F ;;addition
DEFB $A1 ;;stk-one
DEFB $03 ;;subtract
DEFB $8C ;;series-0C
DEFB $10 ;;Exponent: $60, Bytes: 1
DEFB $B2 ;;(+00,+00,+00)
DEFB $13 ;;Exponent: $63, Bytes: 1
DEFB $0E ;;(+00,+00,+00)
DEFB $55 ;;Exponent: $65, Bytes: 2
DEFB $E4,$8D ;;(+00,+00)
DEFB $58 ;;Exponent: $68, Bytes: 2
DEFB $39,$BC ;;(+00,+00)
DEFB $5B ;;Exponent: $6B, Bytes: 2
DEFB $98,$FD ;;(+00,+00)
DEFB $9E ;;Exponent: $6E, Bytes: 3
DEFB $00,$36,$75 ;;(+00)
DEFB $A0 ;;Exponent: $70, Bytes: 3
DEFB $DB,$E8,$B4 ;;(+00)
DEFB $63 ;;Exponent: $73, Bytes: 2
DEFB $42,$C4 ;;(+00,+00)
DEFB $E6 ;;Exponent: $76, Bytes: 4
DEFB $B5,$09,$36,$BE ;;
DEFB $E9 ;;Exponent: $79, Bytes: 4
DEFB $36,$73,$1B,$5D ;;
DEFB $EC ;;Exponent: $7C, Bytes: 4
DEFB $D8,$DE,$63,$BE ;;
DEFB $F0 ;;Exponent: $80, Bytes: 4
DEFB $61,$A1,$B3,$0C ;;
DEFB $04 ;;multiply
DEFB $0F ;;addition
DEFB $34 ;;end-calc
RET ; return.
; ---------------------
; THE 'ARCSIN' FUNCTION
; ---------------------
; (Offset $1F: 'asn')
; The inverse sine function with result in radians.
; Derived from arctan function above.
; Error A unless the argument is between -1 and +1 inclusive.
; Uses an adaptation of the formula asn(x) = atn(x/sqr(1-x*x))
;
;
; /|
; / |
; 1/ |x
; /a |
; /----|
; y
;
; e.g. We know the opposite side (x) and hypotenuse (1)
; and we wish to find angle a in radians.
; We can derive length y by Pythagoras and then use ATN instead.
; Since y*y + x*x = 1*1 (Pythagoras Theorem) then
; y=sqr(1-x*x) - no need to multiply 1 by itself.
; So, asn(a) = atn(x/y)
; or more fully,
; asn(a) = atn(x/sqr(1-x*x))
; Close but no cigar.
; While PRINT ATN (x/SQR (1-x*x)) gives the same results as PRINT ASN x,
; it leads to division by zero when x is 1 or -1.
; To overcome this, 1 is added to y giving half the required angle and the
; result is then doubled.
; That is, PRINT ATN (x/(SQR (1-x*x) +1)) *2
;
;
; . /|
; . c/ |
; . /1 |x
; . c b /a |
; ---------/----|
; 1 y
;
; By creating an isosceles triangle with two equal sides of 1, angles c and
; c are also equal. If b+c+c = 180 degrees and b+a = 180 degress then c=a/2.
;
; A value higher than 1 gives the required error as attempting to find the
; square root of a negative number generates an error in Sinclair BASIC.
asn RST 28H ;; FP-CALC x.
DEFB $2D ;;duplicate x, x.
DEFB $2D ;;duplicate x, x, x.
DEFB $04 ;;multiply x, x*x.
DEFB $A1 ;;stk-one x, x*x, 1.
DEFB $03 ;;subtract x, x*x-1.
DEFB $18 ;;negate x, 1-x*x.
DEFB $25 ;;sqr x, sqr(1-x*x) = y.
DEFB $A1 ;;stk-one x, y, 1.
DEFB $0F ;;addition x, y+1.
DEFB $05 ;;division x/y+1.
DEFB $21 ;;atn a/2 (half the angle)
DEFB $2D ;;duplicate a/2, a/2.
DEFB $0F ;;addition a.
DEFB $34 ;;end-calc a.
RET ; return.
; ------------------------
; THE 'ARCCOS' FUNCTION
; ------------------------
; (Offset $20: 'acs')
; the inverse cosine function with the result in radians.
; Error A unless the argument is between -1 and +1.
; Result in range 0 to pi.
; Derived from asn above which is in turn derived from the preceding atn.
; It could have been derived directly from atn using acs(x) = atn(sqr(1-x*x)/x).
; However, as sine and cosine are horizontal translations of each other,
; uses acs(x) = pi/2 - asn(x)
; e.g. the arccosine of a known x value will give the required angle b in
; radians.
; We know, from above, how to calculate the angle a using asn(x).
; Since the three angles of any triangle add up to 180 degrees, or pi radians,
; and the largest angle in this case is a right-angle (pi/2 radians), then
; we can calculate angle b as pi/2 (both angles) minus asn(x) (angle a).
;
;
; /|
; 1 /b|
; / |x
; /a |
; /----|
; y
;
acs RST 28H ;; FP-CALC x.
DEFB $1F ;;asn asn(x).
DEFB $A3 ;;stk-pi/2 asn(x), pi/2.
DEFB $03 ;;subtract asn(x) - pi/2.
DEFB $18 ;;negate pi/2 - asn(x) = acs(x).
DEFB $34 ;;end-calc acs(x)
RET ; return.
; --------------------------
; THE OLD 'SQUARE ROOT' FUNCTION
; --------------------------
; (Offset $25: 'sqr')
; Error A if argument is negative.
; This routine is remarkable for its brevity - 7 bytes.
; This routine uses Napier's method for calculating square roots which was
; devised in 1614 and calculates the value as EXP (LN 'x' * 0.5).
;
; This is a little on the slow side as it involves two polynomial series.
; A series of 12 for LN and a series of 8 for EXP. This was of no concern
; to John Napier since his tables were 'compiled forever'.
;
;;; L1DDB: RST 28H ;; FP-CALC x.
;;; DEFB $2D ;;duplicate x, x.
;;; DEFB $2C ;;not x, 1/0
;;; DEFB $00 ;;jump-true x, (1/0).
;;; DEFB $1E ;;to L1DFD, LAST exit if argument zero
;;; ;; with zero result.
;;;
;;; else continue to calculate as x ** .5
;;;
;;; DEFB $A2 ;;stk-half x, .5.
;;; DEFB $34 ;;end-calc x, .5.
; ------------------------
; THE 'TO POWER' OPERATION
; ------------------------
; (Offset $06: 'to-power')
; The 'Exponential' operation.
; This raises the first number X to the power of the second number Y.
; e.g. PRINT 2 ** 3 gives the result 8
; As with the ZX80,
; 0 ** 0 = 1
; 0 ** +n = 0
; 0 ** -n = arithmetic overflow.
to_power RST 28H ;; FP-CALC X,Y.
DEFB $01 ;;exchange Y,X.
DEFB $2D ;;duplicate Y,X,X.
DEFB $2C ;;not Y,X,(1/0).
DEFB $00 ;;jump-true
DEFB $07 ;;forward to L1DEE, XISO if X is zero.
; else X is non-zero. function 'ln' will catch a negative value of X.
DEFB $22 ;;ln Y, LN X.
; Multiply the power by the logarithm of the argument.
DEFB $04 ;;multiply Y * LN X
DEFB $34 ;;end-calc
JP exp ; jump back to EXP routine ->>
; to find the 'antiln'
; ---
; these routines form the three simple results when the number is zero.
; begin by deleting the known zero to leave Y the power factor.
XISO DEFB $02 ;;delete Y.
DEFB $2D ;;duplicate Y, Y.
DEFB $2C ;;not Y, (1/0).
DEFB $00 ;;jump-true
DEFB $09 ;;forward to L1DFB, ONE if Y is zero.
; the power factor is not zero. If negative then an error exists.
DEFB $A0 ;;stk-zero Y, 0.
DEFB $01 ;;exchange 0, Y.
DEFB $33 ;;greater-0 0, (1/0).
DEFB $00 ;;jump-true 0
DEFB $06 ;;to L1DFD, LAST if Y was any positive
;; number.
; else force division by zero thereby raising an Arithmetic overflow error.
; As an alternative, this now raises an error directly.
;;; DEFB $A1 ;;stk-one 0, 1.
;;; DEFB $01 ;;exchange 1, 0.
;;; DEFB $05 ;;division 1/0 >> error
DEFB $34 ;+ end-calc
REPORT_6c RST 08H ;+ ERROR-1
DEFB $05 ;+ Error Report: Number too big
; ---
ONE DEFB $02 ;;delete .
DEFB $A1 ;;stk-one 1.
LAST DEFB $34 ;;end-calc last value 1 or 0.
RET ; return.
; ---------------------
; THE 'SPARE LOCATIONS'
; ---------------------
L1DFE:
DEFB $FF, $FF ; Two spare bytes.
ORG $1E00
; ------------------------
; THE 'ZX81 CHARACTER SET'
; ------------------------
; $00 - Character: ' ' CHR$(0)
char_set DEFB %00000000
DEFB %00000000
DEFB %00000000
DEFB %00000000
DEFB %00000000
DEFB %00000000
DEFB %00000000
DEFB %00000000
; $01 - Character: mosaic CHR$(1)
DEFB %11110000
DEFB %11110000
DEFB %11110000
DEFB %11110000
DEFB %00000000
DEFB %00000000
DEFB %00000000
DEFB %00000000
; $02 - Character: mosaic CHR$(2)
DEFB %00001111
DEFB %00001111
DEFB %00001111
DEFB %00001111
DEFB %00000000
DEFB %00000000
DEFB %00000000
DEFB %00000000
; $03 - Character: mosaic CHR$(3)
DEFB %11111111
DEFB %11111111
DEFB %11111111
DEFB %11111111
DEFB %00000000
DEFB %00000000
DEFB %00000000
DEFB %00000000
; $04 - Character: mosaic CHR$(4)
DEFB %00000000
DEFB %00000000
DEFB %00000000
DEFB %00000000
DEFB %11110000
DEFB %11110000
DEFB %11110000
DEFB %11110000
; $05 - Character: mosaic CHR$(1)
DEFB %11110000
DEFB %11110000
DEFB %11110000
DEFB %11110000
DEFB %11110000
DEFB %11110000
DEFB %11110000
DEFB %11110000
; $06 - Character: mosaic CHR$(1)
DEFB %00001111
DEFB %00001111
DEFB %00001111
DEFB %00001111
DEFB %11110000
DEFB %11110000
DEFB %11110000
DEFB %11110000
; $07 - Character: mosaic CHR$(1)
DEFB %11111111
DEFB %11111111
DEFB %11111111
DEFB %11111111
DEFB %11110000
DEFB %11110000
DEFB %11110000
DEFB %11110000
; $08 - Character: mosaic CHR$(1)
DEFB %10101010
DEFB %01010101
DEFB %10101010
DEFB %01010101
DEFB %10101010
DEFB %01010101
DEFB %10101010
DEFB %01010101
; $09 - Character: mosaic CHR$(1)
DEFB %00000000
DEFB %00000000
DEFB %00000000
DEFB %00000000
DEFB %10101010
DEFB %01010101
DEFB %10101010
DEFB %01010101
; $0A - Character: mosaic CHR$(10)
DEFB %10101010
DEFB %01010101
DEFB %10101010
DEFB %01010101
DEFB %00000000
DEFB %00000000
DEFB %00000000
DEFB %00000000
; $0B - Character: '"' CHR$(11)
DEFB %00000000
DEFB %00100100
DEFB %00100100
DEFB %00000000
DEFB %00000000
DEFB %00000000
DEFB %00000000
DEFB %00000000
; $0B - Character: 'œ' CHR$(12)
DEFB %00000000
DEFB %00011100
DEFB %00100010
DEFB %01111000
DEFB %00100000
DEFB %00100000
DEFB %01111110
DEFB %00000000
; $0B - Character: '$' CHR$(13)
DEFB %00000000
DEFB %00001000
DEFB %00111110
DEFB %00101000
DEFB %00111110
DEFB %00001010
DEFB %00111110
DEFB %00001000
; $0B - Character: ':' CHR$(14)
DEFB %00000000
DEFB %00000000
DEFB %00000000
DEFB %00010000
DEFB %00000000
DEFB %00000000
DEFB %00010000
DEFB %00000000
; $0B - Character: '?' CHR$(15)
DEFB %00000000
DEFB %00111100
DEFB %01000010
DEFB %00000100
DEFB %00001000
DEFB %00000000
DEFB %00001000
DEFB %00000000
; $10 - Character: '(' CHR$(16)
DEFB %00000000
DEFB %00000100
DEFB %00001000
DEFB %00001000
DEFB %00001000
DEFB %00001000
DEFB %00000100
DEFB %00000000
; $11 - Character: ')' CHR$(17)
DEFB %00000000
DEFB %00100000
DEFB %00010000
DEFB %00010000
DEFB %00010000
DEFB %00010000
DEFB %00100000
DEFB %00000000
; $12 - Character: '>' CHR$(18)
DEFB %00000000
DEFB %00000000
DEFB %00010000
DEFB %00001000
DEFB %00000100
DEFB %00001000
DEFB %00010000
DEFB %00000000
; $13 - Character: '<' CHR$(19)
DEFB %00000000
DEFB %00000000
DEFB %00000100
DEFB %00001000
DEFB %00010000
DEFB %00001000
DEFB %00000100
DEFB %00000000
; $14 - Character: '=' CHR$(20)
DEFB %00000000
DEFB %00000000
DEFB %00000000
DEFB %00111110
DEFB %00000000
DEFB %00111110
DEFB %00000000
DEFB %00000000
; $15 - Character: '+' CHR$(21)
DEFB %00000000
DEFB %00000000
DEFB %00001000
DEFB %00001000
DEFB %00111110
DEFB %00001000
DEFB %00001000
DEFB %00000000
; $16 - Character: '-' CHR$(22)
DEFB %00000000
DEFB %00000000
DEFB %00000000
DEFB %00000000
DEFB %00111110
DEFB %00000000
DEFB %00000000
DEFB %00000000
; $17 - Character: '*' CHR$(23)
DEFB %00000000
DEFB %00000000
DEFB %00010100
DEFB %00001000
DEFB %00111110
DEFB %00001000
DEFB %00010100
DEFB %00000000
; $18 - Character: '/' CHR$(24)
DEFB %00000000
DEFB %00000000
DEFB %00000010
DEFB %00000100
DEFB %00001000
DEFB %00010000
DEFB %00100000
DEFB %00000000
; $19 - Character: ';' CHR$(25)
DEFB %00000000
DEFB %00000000
DEFB %00010000
DEFB %00000000
DEFB %00000000
DEFB %00010000
DEFB %00010000
DEFB %00100000
; $1A - Character: ',' CHR$(26)
DEFB %00000000
DEFB %00000000
DEFB %00000000
DEFB %00000000
DEFB %00000000
DEFB %00001000
DEFB %00001000
DEFB %00010000
; $1B - Character: '"' CHR$(27)
DEFB %00000000
DEFB %00000000
DEFB %00000000
DEFB %00000000
DEFB %00000000
DEFB %00011000
DEFB %00011000
DEFB %00000000
; $1C - Character: '0' CHR$(28)
DEFB %00000000
DEFB %00111100
DEFB %01000110
DEFB %01001010
DEFB %01010010
DEFB %01100010
DEFB %00111100
DEFB %00000000
; $1D - Character: '1' CHR$(29)
DEFB %00000000
DEFB %00011000
DEFB %00101000
DEFB %00001000
DEFB %00001000
DEFB %00001000
DEFB %00111110
DEFB %00000000
; $1E - Character: '2' CHR$(30)
DEFB %00000000
DEFB %00111100
DEFB %01000010
DEFB %00000010
DEFB %00111100
DEFB %01000000
DEFB %01111110
DEFB %00000000
; $1F - Character: '3' CHR$(31)
DEFB %00000000
DEFB %00111100
DEFB %01000010
DEFB %00001100
DEFB %00000010
DEFB %01000010
DEFB %00111100
DEFB %00000000
; $20 - Character: '4' CHR$(32)
DEFB %00000000
DEFB %00001000
DEFB %00011000
DEFB %00101000
DEFB %01001000
DEFB %01111110
DEFB %00001000
DEFB %00000000
; $21 - Character: '5' CHR$(33)
DEFB %00000000
DEFB %01111110
DEFB %01000000
DEFB %01111100
DEFB %00000010
DEFB %01000010
DEFB %00111100
DEFB %00000000
; $22 - Character: '6' CHR$(34)
DEFB %00000000
DEFB %00111100
DEFB %01000000
DEFB %01111100
DEFB %01000010
DEFB %01000010
DEFB %00111100
DEFB %00000000
; $23 - Character: '7' CHR$(35)
DEFB %00000000
DEFB %01111110
DEFB %00000010
DEFB %00000100
DEFB %00001000
DEFB %00010000
DEFB %00010000
DEFB %00000000
; $24 - Character: '8' CHR$(36)
DEFB %00000000
DEFB %00111100
DEFB %01000010
DEFB %00111100
DEFB %01000010
DEFB %01000010
DEFB %00111100
DEFB %00000000
; $25 - Character: '9' CHR$(37)
DEFB %00000000
DEFB %00111100
DEFB %01000010
DEFB %01000010
DEFB %00111110
DEFB %00000010
DEFB %00111100
DEFB %00000000
; $26 - Character: 'A' CHR$(38)
DEFB %00000000
DEFB %00111100
DEFB %01000010
DEFB %01000010
DEFB %01111110
DEFB %01000010
DEFB %01000010
DEFB %00000000
; $27 - Character: 'B' CHR$(39)
DEFB %00000000
DEFB %01111100
DEFB %01000010
DEFB %01111100
DEFB %01000010
DEFB %01000010
DEFB %01111100
DEFB %00000000
; $28 - Character: 'C' CHR$(40)
DEFB %00000000
DEFB %00111100
DEFB %01000010
DEFB %01000000
DEFB %01000000
DEFB %01000010
DEFB %00111100
DEFB %00000000
; $29 - Character: 'D' CHR$(41)
DEFB %00000000
DEFB %01111000
DEFB %01000100
DEFB %01000010
DEFB %01000010
DEFB %01000100
DEFB %01111000
DEFB %00000000
; $2A - Character: 'E' CHR$(42)
DEFB %00000000
DEFB %01111110
DEFB %01000000
DEFB %01111100
DEFB %01000000
DEFB %01000000
DEFB %01111110
DEFB %00000000
; $2B - Character: 'F' CHR$(43)
DEFB %00000000
DEFB %01111110
DEFB %01000000
DEFB %01111100
DEFB %01000000
DEFB %01000000
DEFB %01000000
DEFB %00000000
; $2C - Character: 'G' CHR$(44)
DEFB %00000000
DEFB %00111100
DEFB %01000010
DEFB %01000000
DEFB %01001110
DEFB %01000010
DEFB %00111100
DEFB %00000000
; $2D - Character: 'H' CHR$(45)
DEFB %00000000
DEFB %01000010
DEFB %01000010
DEFB %01111110
DEFB %01000010
DEFB %01000010
DEFB %01000010
DEFB %00000000
; $2E - Character: 'I' CHR$(46)
DEFB %00000000
DEFB %00111110
DEFB %00001000
DEFB %00001000
DEFB %00001000
DEFB %00001000
DEFB %00111110
DEFB %00000000
; $2F - Character: 'J' CHR$(47)
DEFB %00000000
DEFB %00000010
DEFB %00000010
DEFB %00000010
DEFB %01000010
DEFB %01000010
DEFB %00111100
DEFB %00000000
; $30 - Character: 'K' CHR$(48)
DEFB %00000000
DEFB %01000100
DEFB %01001000
DEFB %01110000
DEFB %01001000
DEFB %01000100
DEFB %01000010
DEFB %00000000
; $31 - Character: 'L' CHR$(49)
DEFB %00000000
DEFB %01000000
DEFB %01000000
DEFB %01000000
DEFB %01000000
DEFB %01000000
DEFB %01111110
DEFB %00000000
; $32 - Character: 'M' CHR$(50)
DEFB %00000000
DEFB %01000010
DEFB %01100110
DEFB %01011010
DEFB %01000010
DEFB %01000010
DEFB %01000010
DEFB %00000000
; $33 - Character: 'N' CHR$(51)
DEFB %00000000
DEFB %01000010
DEFB %01100010
DEFB %01010010
DEFB %01001010
DEFB %01000110
DEFB %01000010
DEFB %00000000
; $34 - Character: 'O' CHR$(52)
DEFB %00000000
DEFB %00111100
DEFB %01000010
DEFB %01000010
DEFB %01000010
DEFB %01000010
DEFB %00111100
DEFB %00000000
; $35 - Character: 'P' CHR$(53)
DEFB %00000000
DEFB %01111100
DEFB %01000010
DEFB %01000010
DEFB %01111100
DEFB %01000000
DEFB %01000000
DEFB %00000000
; $36 - Character: 'Q' CHR$(54)
DEFB %00000000
DEFB %00111100
DEFB %01000010
DEFB %01000010
DEFB %01010010
DEFB %01001010
DEFB %00111100
DEFB %00000000
; $37 - Character: 'R' CHR$(55)
DEFB %00000000
DEFB %01111100
DEFB %01000010
DEFB %01000010
DEFB %01111100
DEFB %01000100
DEFB %01000010
DEFB %00000000
; $38 - Character: 'S' CHR$(56)
DEFB %00000000
DEFB %00111100
DEFB %01000000
DEFB %00111100
DEFB %00000010
DEFB %01000010
DEFB %00111100
DEFB %00000000
; $39 - Character: 'T' CHR$(57)
DEFB %00000000
DEFB %11111110
DEFB %00010000
DEFB %00010000
DEFB %00010000
DEFB %00010000
DEFB %00010000
DEFB %00000000
; $3A - Character: 'U' CHR$(58)
DEFB %00000000
DEFB %01000010
DEFB %01000010
DEFB %01000010
DEFB %01000010
DEFB %01000010
DEFB %00111100
DEFB %00000000
; $3B - Character: 'V' CHR$(59)
DEFB %00000000
DEFB %01000010
DEFB %01000010
DEFB %01000010
DEFB %01000010
DEFB %00100100
DEFB %00011000
DEFB %00000000
; $3C - Character: 'W' CHR$(60)
DEFB %00000000
DEFB %01000010
DEFB %01000010
DEFB %01000010
DEFB %01000010
DEFB %01011010
DEFB %00100100
DEFB %00000000
; $3D - Character: 'X' CHR$(61)
DEFB %00000000
DEFB %01000010
DEFB %00100100
DEFB %00011000
DEFB %00011000
DEFB %00100100
DEFB %01000010
DEFB %00000000
; $3E - Character: 'Y' CHR$(62)
DEFB %00000000
DEFB %10000010
DEFB %01000100
DEFB %00101000
DEFB %00010000
DEFB %00010000
DEFB %00010000
DEFB %00000000
; $3F - Character: 'Z' CHR$(63)
DEFB %00000000
DEFB %01111110
DEFB %00000100
DEFB %00001000
DEFB %00010000
DEFB %00100000
DEFB %01111110
DEFB %00000000
.END ;TASM assembler instruction.