; ; 2022-08-30 ; ; This is the optimised Z8 FORTH source code shown in TM-10463.pdf ; written by Oak Ridge Laboratories. ; ; Recreated from OCR text, it may well have typos, ; but the hex output matches the start of the ; binary hex dump assembly. ; ; The scanned listing may have some errors, ; some places had the same assembly lines ; with different assembled bytes. ; I put these in conditional assembly ; switched by this: ; as_per_listing equ 0 ; ; The Z8 uses big-endian words, ; so this directive: .cpu M6809 ; ; tells the assembler to assemble for a big-endian micro. ; ; This code assembles online at ; https://www.asm80.com/ ; ; I don't have a Z8 assembler on my Linux machine. ; Zilog's assembler runs on Windows. ; ; Next step is to get a Z8 assembler ; assembling the assembly language statements. ; ; .macro CALL_ .db $D6 ; call opcode .dw %%1 .endm ; L00C: ; ZILOG Z8 FORTH SYSTEM ; ; ASSEMBLY-LANGUAGE SECTION .org $0000 .dw $00A9 ; L00A9 .dw $00AB .dw $00AD .dw $00AF .dw $00B1 .dw $00B3 .org $000C ;Addr Inst ;Label Oprn Operands Comments L00C: .db $8F ; DIS ; DISABLE INTERRUPTS ; L00D: .dw $3150 ; SRP $50 L00F: .dw $EC00 ; LD RE,$00 ; LOAD REG F0-FF FROM 00B5 .dw $FCB5 ; LD RF,$B5 .dw $DCF0 ; LD RD,$F0 ; START WITH RD * F0 .dw $CC10 ; LD RC,$10 ; DO 10 (HEX) BYTES L017: .dw $C3DE ; L017: LDCI @RD,@WE .dw $CAFC ; DJNZ RC,L017 .dw $EC00 ; LD RE,$00 ; LOAD REG FILE 10-2F FROM 00C5 .dw $FCC5 ; LD RF,$C5 .dw $DC10 ; LD RD,$10 .dw $CC20 ; LD RC,$20 ; DO 20 (HEX) BYTES L023: .dw $C3DE ; L023: LDCI @RD,@WE .dw $CAFC ; DJNZ RC,L023 L027: .dw $3170 ; SRP $70 ; USE RF 70-7F TO FIND LIMITS OF ROM & RAM .dw $AC00 ; LD RA,$00 ; LOOK FOR END OF ROM IN 1K INCREMENTS .dw $BC00 ; LD RB,$00 L02D: .db $06,$EA,$04; L02D: ADD RA,$04 ; ADD 400 (HEX) TO WA (FIRST BYTE OF PAGE) .dw $C27A ; LDC R7,@WA ; LOAD BYTE POINTED TO BY WA INTO It7 .dw $68E7 ; LD R6, R7 ; COPY THE BYTE INTO R6 .dw $60E6 ; COM R6 ; COMPLIMENT THE COPY IN R6 .dw $D26A ; LDC @WA,R6 ; ATTWT TO STORE THE COPY TO MEMORY .dw $C26A ; LDC R6,@WA ; LOAD IT BACK TO R6 .dw $D27A ; LDC @WA,R7 ; RESTORE MEMORY FROM R7 (IN CASE IT WAS RAM) .dw $A267 ; CP R6,R7 ; COMPARE R6 AGAINST R7 .dw $6BED ; JR EQ,L02D ; IF EQUAL WE ARE STILL IN ROM L040: .dw $C8EA ; LD RC,RA ; STORE BEGINNING OF RAM IN WA .dw $D8EB ; LD RD,RB .dw $C912 ; LD 12,RC ; STORE BEGINNING OF RAM IN DICTIONARY PNTR .dw $D913 ; LD 13,RD L048: .db $06,$EA,$04 ; L048: ADD RA,$04 ; LOOK FOR END OF RAM IN 1K INCREMENTS .dw $C27A ; LDC R7,@WA ; LOAD BYTE POINTED TO BY WA INTO R7 .dw $68E7 ; LD R6,R7 ; COPY THE BYTE INTO R6 .dw $60E6 ; COM R6 ; COMPLIMENT THE COPY IN R6 .dw $D26A ; LDC @WA,R6 ; ATTEMPT TO STORE THE COPY TO MEMORY .dw $C26A ; LDC R6,QWA ; LOAD IT BACK TO R6 .dw $D27A ; LDC @WA,R7 ; RESTORE MEMORY FROM R7 (IN CASE IT WAS RAM) .dw $A267 ; CP R6,R7 ; COMPARE R6 AGAINST R7 L059: .dw $EBED ; JR NE,L048 ; IF NOT EQUAL WE ARE STILL IN RAM L05B: .dw $A922 ; LD 22,RA ; RSTACK AT END-OF-RAM + 1 .dw $B923 ; LD 23,RE .dw $00EA ; DEC RA ; SUBTRACT 100(HEX) FROM END-OF-EUM .dw $A920 ; LD 20,RA ; START DSTACK AT 100(HEX) LESS THAN RSTACK .dw $B921 ; LD 21,RB .dw $A91A ; LD 1A,RA ; SET TIB (1A-1B) TO BOTTOM OF RSTACK .dw $B91B ; LD 1B,RB ;Addr Inst ; Label Oprn Operands Comments .dw $80EC ; DECW WC ; LOAD STARTING ADDR (LAST WORD IN ROM) .dw $C27C ; LDC R7,@WC ; INTO R6-R.7 .dw $80EC ; DECW WC ; IF START ADDR IS FFFF THEN USE START ADDR .dw $C26C ; LDC R6,@WC ; AT LAST WORD OF Z8 ROM (@FFE) .dw $A0E6 ; INCW W6 ; TEST IF ADDR EQUALS FFFF .dw $EB04 ; JR NZ,L079 .dw $CC0F ; LD RC,$0F ; LOAD EXECUTION VECTOR WITH POINTER TO ADDRESS .dw $DCFE ; LD RD,$FE ; IN NUCLEUS (QUIT) WHERE EXECUTION IS TO BEGIN L079: .dw $3150 ; L079: SRP $50 ; POINT TO FORTH WORD REGISTER GROUP .dw $8CFF ; LD R8,$FF ; LOAD W8 WITH BAUD RATE SWITCH ADDRESS FFFD .dw $9CFD ; LD R0,$FD .dw $C278 ; LDC R7,@WR8 ; LOAD R7 WITH VALUE OF BAUD RATE SWITCHES .db $8D .dw $0F84 ; JP $0F84 ; INITIALIZE SHARED-BUS INTERRUPT ROUTINE L084: .dw $8C00 ; LD R8,$00 .dw $9CE5 ; LD R9,$E5 .dw $0297 ; ADD R9,R7 .db $16,$E8,$00; ADC R8,$00 .dw $C278 ; LDC R7,@W8 .dw $79F4 ; LD $F4,R7 L091: .db $E6,$F1,$03; LD $F1,$03 .db $E4,$20,$FE; LD $FE,$20 ; INITIALIZE STARTING VALUE OF STACK .db $E4,$21,$FF; LD $FF,$21 .db $E4,$22,$7A; LD $7A,$22 ; INITIALIZE STARTING VALUE OF RSTACK .db $E4,$23,$7B; LD $7B,$23 L0A0: .db $E6,$50,$01; LD $50,$01 ; INITIALIZE VECTOR TO "EXNV" CODE .db $E6,$51,$A3; LD $51,$A3 .db $9F ; E1 ; ENABLE INTERRUPTS .dw $3050 ; JP @50 ; GO TO NEXT CODE L0A9: ; $0A9 .db $30,$04 .db $30,$06 .db $30,$08 .db $30,$0A ; Initialize NEXT vector ; $0B1 .db $30,$0C .db $30,$0E .db $20,$00 .db $F0,$03 .db $10,$0F .db $FF,$41,$B2,$2B,$10 ; Constants for F0-FF ; $0C0 .db $00,$00,$50,$1F,$00,$00,$00,$10 .db $00,$00,$00,$00,$00,$00,$10,$00 ; Constants for 10-2F ; $0D0 .db $00,$00,$00,$00,$00,$00,$00,$00 .db $00,$00,$03,$00,$00,$00,$2c,$00 ; ; $0E0 .db $2C,$0F,$6E,$0F,$FF,$80,$01,$02 .db $04,$08,$10,$AF,$40 ; Baud rate table .org $00ED ;; LBL POP8 POP8: ; POP STACK TO W8 (R8-R9) L0ED: .dw $3150 ; SRP $50 .dw $50EE ; POP RE ; POP RETURN ADDRESS TO WE .dw $50EF ; POP RF .dw $50E8 ; POP R8 ; POP STACK TO W8 .dw $50E9 ; POP R9 .dw $305E ; JP @5E ; RETURN VIA WE .org $00F9 POPA8: ; LBL POPA8 ; POP TOP-OF-STACK TO WA (RA-RB); ; NEXT-TO-TOP-OF-STACK TO W8 (R8-R9) L0F9: .dw $3150 ; SRP $50 .dw $50EE ; POP RE ; POP RETURN ADDRESS TO WE .dw $50EF ; POP RF .dw $50EA ; POP RA ; POP STACK TO WA .dw $50EB ; POP RB .dw $8BEE ; JR L0F3 ; GO TO POP8 TO POP NEXT WORD ON STACK INTO W8 ; POPCA8: ; LBL POPCA8 ; POP TOP-OF-STACK TO WC (WC-WD); ; NEXT-TO-TOP-OF-STACK TO WA (RA-RB); ; THIRD-FROM-TOP TO W8 (R8-R9) ; 25 ;Addr Inst ; Label Oprn Operands Comments L105: .dw $3150 ; SRP $50 .dw $50EE ; POP RE ; POP RETURN ADDRESS TO WE .dw $50EF ; POP RF .dw $50EC ; POP RC ; POP STACK TO WC .dw $50ED ; POP RD .dw $8BEE ; JR L0FF ; GOTO POPAS - POP NEXT TWO WORDS TO WA & W8 PUSH8: ; LBL PUSH8 ; PUSH W8 TO STACK L111: .dw $3150 ; SRP 50 .dw $50EE ; POP RE ; POP RETURN TO WE .dw $50EF ; POP RF L117: .dw $70E9 ; L117: PUSH E9 ; PUSH W8 (R9-R8) TO STACK .dw $70E8 ; PUSH E8 .dw $305E ; JP @5E PUSHA8: ; LBL PUSHA8 ; PUSH WA THEN W8 TO THE STACK L11D: .dw $3150 ; SRP $50 .dw $50EE ; POP RE ; POP RETURN TO WE .dw $50EF ; POP RF L123: .dw $70EB ; L123: PUSH RB ; PUSH WA (RB-RA) TO STACK .dw $70EA ; PUSH RA .dw $8BEE ; JR L117 ; GOTO PUSH8 TO PUSH W8 TO STACK PUSHCA8: ; LBL PUSHCA8 ; PUSH WC, THEN WA, THEN W8 TO STACK L129 .dw $3150 ; SRP $50 .dw $50EE ; POP RE ; POP RETURN TO WE .dw $50EF ; POP RF .dw $70ED ; PUSH RD ; PUSH WC (RD-RC) TO STACK .dw $70EC ; PUSH RC .dw $8BEE ; JR L123 ; GOTO PUSHA8 TO PUSH WA, W8 TO STACK R_to_S: ; LBL R>S ; POP RSTACK - PUSH TO STACK L135: .dw $3150 ; SRP $50 .dw $50EE ; POP RE ; POP RETURN ADDRESS TO WE .dw $50EF ; POP RF .dw $687A ; LD R6,$7A ; LOAD RSTACK POINTER INTO W6 .dw $787B ; LD R7,$7B .dw $C286 ; LDC R8,@W6 ; POP RSTACK TO W8 .dw $A0E6 ; INCW W6 .dw $C296 ; LDC R9,@W6 .dw $A0E6 ; INCW W6 .dw $797B ; LD $7B,$R7 ; UPDATE RSTACK POINTER .dw $697A ; LD $7A,$R6 .dw $8BCA ; JR L117 ; PUSH W8 TO STACK L14D: S_to_R: ; LBL S>R: ; POP STACK - PUSH TO RSTACK .dw $3150 ; SRP 50 .dw $50EE ; POP RE ; POP RETURN ADDRESS TO WE .dw $50EF ; POP RF ; 26 ; Addr Inst ; Label Oprn Operands ; Comments .dw $50E8 ; POP R8 ; POP STACK TO W8 (R8-R9) .dw $50E9 ; POP R9 L157: .dw $687A ; LD R6,$7A ; RSTACK POINTER TO W6 .dw $787B ; LD R7,$7B L15B: .dw $80E6 ; L15B: DECW W6 .dw $D296 ; LDC @W6,R9 ; W8 (R9-R8) TO RSTACK .dw $80E6 ; DECW Wd .dw $D286 ; LDC @W6,R8 .dw $697A ; LD $7A,R6 ; UPDATE RSTACK POINTER .dw $797B ; LD $7B,R7 .dw $30EE ; JP @RE ; RETURN VIA WE LOADEV: ; LBL LOADEV ; LOAD NEXT VECTOR TO W8, INCREMENT IP (7C-7D) L169: .dw $3150 ; SRP 50 .dw $A87C ; LD RB,$7D ; INSTRUCTION POINTER TO WA .dw $B87D ; LDC R8,@WA .dw $C28A ; INCW WA ; VECTOR AT IP TO W8 .dw $A0EA ; LDC R9,@WA .dw $C29A ; INCW WA .dw $A0EA ; LD $7D,RB .dw $A97C ; RTN ; UPDATE INSTRUCTION POINTER .dw $B97D ; LD RA,$7C .db $AF ; IB $7C,RA ; RETURN FROM CALL SEROUT: ; LBL SEROUT ; SERIAL OUTPUT (WRITE) ROUTINE L17C: .db $76,$FA,$10; L17C: CP $FA,$10 ; IS SERIAL OUTPUT PORT READY? .dw $6BFB ; JR Z,L17C ; ZERO MEANS NOT READY .db $56,$FA,$EF; AND $FA,$EF ; AND OUT PORT READY BIT .dw $99F0 ; LD $F0,R9 ; PLACE THE CHARACTER IN 1/0 PORT .db $AF ; RTN ; RETURN FROM CALL SERIN: ; LBL SERIN ; SERIAL INPUT (READ) ROUTINE L187: .db $76,$FA,$08; L187: CP FA,$08 ; IS SERIAL INPUT PORT READY? .dw $6BFB ; JR Z,L187 ; ZERO MEANS NOT READY .db $56,$FA,$F7; AND $FA,$F7 ; SET PORT EMPTY BIT .dw $98F0 ; LD R9,$F0 ; READ CHARACTER FROM 1/0 PORT .db $AF ; RTN ; RETURN FROM CALL COPYR_to_S: ; LBL COPYR ; COPY WORD AT RSTACK TO STACK L192 .dw $3150 ; SRP $50 .dw $50E4 ; POP R4 ; POP RETURN TO W4 .dw $50E5 ; POP R5 CALL_ R_to_S ; CALL DS ; POP RSTACK TO STACK CALL_ S_to_R ; CALL S>R ; PUSH STACK TO RSTACK CALL_ PUSH8 ; CALL PUSH8 ; PUSH W8 TO STACK .dw $30E4 ; JP @R4 ; RETURN VIA R4 ; EXNV: ; LBL EXNV ; EXECUTE NEXT VECTOR L1A3: CALL_ LOADEV ; CALL LOADEV ; LOAD NEXT VECTOR ; Addr Inst Label Oprn Operands ; Comments .dw $C2A8 ; L1A6: LDC RA,@W8 ; LOAD CODE ADDRESS POINTED TO BY VECTOR INTO WA .dw $A0E8 ; INCW W8 .dw $C2B8 ; LDC RB,@W8 .dw $A0E8 ; INCW W8 .dw $897E ; LD $7E,$R8 ; UPDATE EXECUTION VECTOR (7E-7F) .dw $997F ; LD $7F,$R9 .dw $30EA ; JP @RA ; EXECUTE VIA VECTOR LOADED INTO WA EXWOS: ; LBL EXWOS ; EXECUTE WORD ON STACK L1B4: .db $D6,$00,$0ED; CALL POP8 ; STACK TO W8 .dw $8BED ; JR L1A6 ; USE END OF EXNV COLON: ; LBL COLON ; CODE FOR COLON - EXECUTE VECTOR LIST L1B9: .dw $707D ; PUSH $7D ; PUSH INSTRUCTION POINTER TO STACK .dw $707C ; PUSH $7C CALL_ S_to_R ; CALL S>R ; MOVE INSTRUCTION POINTER TO RSTACK .db $E4,$7E,$7C ; LD $7C,$7E ; MOVE EXECUTION VECTOR TO INSTRUCTION POINTER .db $E4,$7F,$7D ; LD $7D,$7F .dw $3050 ; JP @S0 RTN: ; LBL RTN ; CODE FOR SEMICOLON - RETURN FROM FORTH WORD L1C8: CALL_ R_to_S ; CALL R>S ; RSTACK TO STACK .dw $507C ; POP $7C ; STACK TO INSTRUCTION POINTER .dw $507D ; POP $7D .dw $3050 ; JP @50 KEYSUB: ; LBL KEYSUB ; CODE FOR KEY L1D1: .dw $3150 ; SRP 50 CALL_ SERIN ; CALL SERIN ; READ SERIAL PORT .dw $B0E8 ; CLR R8 ; ZERO HIGH BIT OF RESULT .db $56,$E9,$7F ; AND R9,$7F ; ELIMINATE HIGH ORDER BIT OF RESULT CALL_ PUSH8 ; CALL PUSH8 ; PUSH RESULT TO STACK .dw $3050 ; JP @50 EMITSUB: ;; LBL EMITSUB L1E0: CALL_ POP8 ; CALL POP8 ; STACK TO W8 CALL_ SEROUT ; CALL SEROUT ; WRITE CHARACTER IN R9 TO SERIAL PORT .dw $3050 ; JP @50 ;; LBL !SUB ; CODE FOR ! L1E8: CALL_ POPA8 ; CALL POPA8 ; POP ADDRESS TO WA, OBJECT TO W8 .dw $42AA ; OR RA,RA ; IS HIGH BYTE OF ADDRESS ZERO? .dw $6B08 ; JR Z,L1F4 ; IF NOT ZERO STORE IN REGISTER FILE LOCATION .dw $D28A ; LDC @WA,R8 ; CODE TO STORE W8 IN RAM - HIGH BYTE TO RAN .dw $A0EA ; INCW WA ; LOW BYTE TO RAM L1F0: .dw $D29A ; L1F0: LDC @WA,R9 .dw $3050 ; JP @50 ; RETURN L1F4: .db $F5,$E8,$5B ; L1F4: LD @5B,R8 ; CODE TO STORE R8 IN REG FILE - HIGH BYTE FIRST .dw $205B ; INC 5B ; POINT RB TO NEXT BYTE IN REGISTER FILE .db $F5,$E9,$5B ; L1F9: LD @5B,R9 ; LOW BYTE TO REG FILE .dw $3050 ; JP @50 ; RETURN ; ; LBL C!SUB ; CODE FOR C! L201: CALL_ POPA8 ; CALL POPA8 ; POP ADDRESS TO WA, OBJECT TO W8 .dw $42AA ; OR R8,R8 ; IS HIGH BYTE OF ADDRESS ZERO? .dw $6BF4 ; JR Z,L1F9 ; MAKE USE OF REG FILE PORTION OF ! .dw $8BE9 ; JR L1F3 ; WE USE OF RAM PORTION OF ! fetch_SUB: ; LBL @SUB ; CODE FOR @ L20A: CALL_ POP8 ; CALL POP8 ; POP ADDRESS TO W8 .dw $4288 ; OR R8,R8 ; TEST FOR FETCH FROM REG FILE OR RAM .dw $6B0C ; JR Z,L21D ; IF ZERO, FETCH FROM REGISTER FILE .dw $C2A8 ; LDC RA,@W8 ; FETCH FROM RAM .dw $A0E8 ; INCW W8 L215: .dw $C2B8 ; L215: LDC RB,@W8 L217: .dw $70EB ; L217: PUSH RB ; PUSH W8 TO STACK .dw $70EA ; PUSH RA .dw $3050 ; JP @50 ; RETURN L21D: .dw $E3A9 ; L21D: LD RA,@R9 ; FETCH FROM REGISTER FILE .db $9E ; INC R9 L220: .dw $E3B9 ; L220: LD RB,@R9 .dw $8BF3 ; JR L217 ; USE LAST PART OF RAM FETCH TO PUSH TO STACK C_fetch: ; LBL C@SUB ; CODE FOR C@ L224: CALL_ POP8 ; CALL POP8 ; POP ADDRESS TO W8 .dw $B0EA ; CLR RA ; SET HIGH BYTE OF RESULT TO ZERO .dw $4288 ; OR R8,R8 ; TEST FOR FETCH FROM REG FILE OR RAM .dw $6BF3 ; JR Z,L220 ; IF ZERO FETCH FROM REG FILE .dw $8BE6 ; JR L215 ; USE PORTIONS OF @ FOR ONE-BYTE FETCHES to_RSUB: ; LBL >RSUB ; CODE FOR >R L22F: CALL_ S_to_R ; CALL S>R ; MOVE STACK TO RSTACK .dw $3050 ; JP @50 ; RETURN R_to_SUB: ; LBL R>SUB ; CODE FOR R> L234: CALL_ R_to_S ; CALL R>S ; MOVE RSTACK TO STACK .dw $3050 ; JP @50 ; RETURN NRSUB: ; LBL NRSUB ; CODE FOR THE NUMBER RUNNER L239: CALL_ LOADEV ; CALL LOADEV ; LOAD VECTOR AT IP TO W8 CALL_ PUSH8 ; CALL PUSH8 ; PUSH VECTOR TO STACK .dw $3050 ; JP @50 ; RETURN JRSUB: ; LBL JRSUB ; JUMP RELATIVE SUBROUTINE L241: CALL_ LOADEV; CALL LOADEV ; LOAD IP INCREMENT TO W8 .dw $807C ; DECW $7C ; BACK UP IP TO THE INCREMENT .dw $807C ; DECW $7C .db $04,$E9,$7D; ADD $7D,R9 ; ADD INCREMENT TO INSTRUCTION POINTER ;; 29 ;; Addr Inst Label Oprn Operands .db $14,$E8,$7C; ADC 7C,R8 .dw $3050 ; JP @50 ; RETURN JRZSUB: ; LBL JRZSUB ; SUBROUTINE TO JUMP RELATIVE IF TOS ZERO L250: CALL_ POP8 ; CALL POP8 ; POP STACK TO W8 .dw $4289 ; OR R8,R9 ; TEST WHETHER W8 IS ZERO .dw $6BEA ; JR Z,L241 ; IF TOS ZERO USE ADDRESS TO ADJUST IP CALL_ LOADEV ; CALL LOADEV ; OTHERWISE SKIP OVER THE INCREMENT .dw $3050 ; JP @50 SWAPSUB: ; LBL SWAPSUB ; CODE FOR SWAP L25C: CALL_ POPA8 ; CALL POPA8 ; POP ONE WORD INTO R8 THE OTHER INTO WA CALL_ PUSHA8 ; CALL PUSHA8 ; PUSH WA THEN W8 ONTO THE STACK .dw $3050 ; JP @50 ; RETURN DUPSUB: ; LBL DUPSUB ; CODE FOR DUP L264: CALL_ POP8 ; CALL POP8 CALL_ PUSH8 ; CALL PUSH8 CALL_ PUSH8 ; CALL PUSH8 .dw $3050 ; JP @50 DROPSUB: ; LBL DROPSUB ; CODE FOR DROP L26F: CALL_ POP8; CALL POP8 .dw $3050; JP @50 ANDSUB: ; LBL ANDSUB ; CODE FOR AND L274: CALL_ POPA8 ; CALL POPA8 ; POP ARGUMENTS INTO W8 .dw $528A ; AND R8,RA .dw $529B ; AND R9,RB CALL_ PUSH8 ; CALL PUSH8 ; PUSH RESULT ONTO STACK .dw $3050 ; JP @50 ORSUB: ; LBL ORSUB ; CODE FOR OR L280: CALL_ POPA8 ; CALL POPA8 ; POP ARGUMENTS INTO W8 WA .dw $428A ; OR R8,RA .dw $429B ; OR R9,RA CALL_ PUSH8 ; CALL PUSH8 ; PUSH RESULT ONTO STACK .dw $3050 ; JP @50 XORSUB: ; LBL XORSUB ; CODE FOR XOR WA L28C: CALL_ POPA8 ; CALL POPA8 ; POP ARGUMENTS INTO W8,WA .dw $B28A ; XOR R8,RA .dw $B29B ; XOR R8,RA ; should be RB ??? CALL_ PUSH8 ; CALL PUSH8 ; PUSH RESULT ONTO STACK .dw $3050 ; JP @50 PLUS_SUB: ; LBL +SUB ; CODE FOR + L298: CALL_ POPA8 ; CALL POPA8 ; POP ARGUMENTS INTO W8 .dw $029B ; ADD R9,RB ; 30 ; Addr Inst Label Oprn Operands .dw $128A ; ADD R8,RA CALL_ PUSH8 ; CALL PUSH8 .dw $3050 ; JP @50 NEGSUB: ; LBL NEGSUB ;; L02A8: ??? ; CODE FOR NEGATE CALL_ POP8 ; CALL POP8 .dw $60E9 ; COM R9 .dw $60E8 ; COM R8 .dw $A0E8 ; INCW W8 CALL_ PUSH8 ; CALL PUSH8 .dw $3050 ; JP @50 MULSUB: ; LBL MULSUB ; CODE FOR UNSIGNED MULTIPLY L2B2: CALL_ POPA8 ; CALL POPA8 ; POP ARGUMENTS INTO W8, WA .dw $B0EC ; CLR RC ; CLEAR PRODUCT REGISTER .dw $B0ED ; CLR RD .dw $7C11 ; LD R7,$11 ; GO THROUGH BIT-LOOP 17 TIMES .db $CF ; RCF L2BC: .dw $C0EC ; L2BC: RRC RC ; ROTATE QUAD REGISTER C,D,A,B RIGHT .dw $C0ED ; RRC RD .dw $C0EA ; RRC RA .dw $C0EB ; RRC RB .dw $FB04 ; JR OV,L2C9 ; IF BIT IN CARRY IS ZERO, ADD IN MULT .dw $02D9 ; ADD RD,R9 .dw $12C8 ; ADC RC,R8 L2C9: .dw $7AF0 ; L2C9: DJNZ R7,L2BC ; TEST FOR END OF BIT-LOOP .dw $88EC ; LD R8,RC ; LOAD W8 WITH HIGH PART OF RESULT (WC) .dw $98ED ; LD R9,RD CALL_ PUSHA8 ; CALL PUSHA8 ; PUSH BOTH WORDS OF RESULT TO STACK .dw $3050 ; JP @50 DIVSUB: ; LBL DIVSUB ; CODE FOR UNSIGNED DIVIDE L2D5: CALL_ $0105 ; CALL POPCA8 ; POP DBL WORD QUOTIENT IN WC/WA, DIVISOR TO W8 .dw $B0EE ; CLR RE ; CLEAR DOUBLE WORD RESULT .dw $B0EF ; CLR RF .dw $B0E6 ; CLR R6 .dw $B0E7 ; CLR R7 .dw $B0E5 ; CLR R5 ; CLEAR LEADING BIT COUNT REGISTER .dw $4C20 ; LD R4,$20 ; EXAMINE 32 BIT OF QUOTIENT .db $CF ; RCF .db $76,$EE,$80; L2E5: TM RE,$80 ; IS THIS THE LEADING BIT OF THE QUOTIENT? .dw $EB18 ; JR NZ,L302 ; YES - GO DO THE DIVISION .db $5E ; DEC R5 ; NO - ROTATE QUAD REG D,C,F,E LEFT .dw $10ED ; RLC RD .dw $10EC ; RLC RC .dw $10EF ; RLC RF .dw $10EE ; RLC RE .dw $4AEF ; DJNZ R4,L2E5 ; KEEP LOOKING FOR THE LEADING BIT .dw $ACFF ; LD RA,$FF ; DIDN'T FIND A LEADING BIT - SO LOAD DBL WORD ; Comments ;; 31 ;; Addr Inst Label Oprn Operands ; Comments .dw $BCFF ; LD RB,$FF ; RESULT WITH -1 AND RETURN .dw $9CFF ; LD R9,$FF .dw $8CFF ; LD R8,$FF CALL_ PUSHA8 ; CALL PUSHA8 ; PUSH DOUBLE WORD RESULT TO STACK .dw $3050 ; JP @50 L302: .db $5E ; L302 INC R5 ; INCREMENT BIT COUNT .db $CF ; L303 RCF .dw $10E7 ; RLC R7 .dw $10E6 ; RLC R6 .dw $229D ; SUB R9,RD ; SUBTRACT QUAD DENOMINATOR FROM QUAD QUOTIENT .dw $328C ; SBC R8,RC .dw $32BF ; SBC RB,RF .dw $32AE ; SBC RA,RE .dw $FB0A ; JR NC,L31C .dw $029D ; ADD R9,RD ; ADD QUAD DENOMINATOR TO QUAD QUOTIENT .dw $128C ; ADC R8,RD ; possibly RC ? .dw $12BF ; ADC RB,RF .dw $12AE ; ADC RA,RE .dw $8B02 ; JR L31E L31C: .dw $A0E6 ; INCW W6 .db $CF ; RCF .dw $C0EE ; RRC RE ; ROTATE QUAD REG E,F,C,D RIGHT .dw $C0EF ; RRC RF .dw $C0EC ; RRC RC .dw $C0ED ; RRC RD .dw $5ADA ; DJNZ R5,L303 .dw $70E9 ; PUSH R9 ; PUSH DOUBLE WORD RESULT TO STACK .dw $70E8 ; PUSH R8 .dw $70E7 ; PUSH R7 .dw $70E6 ; PUSH R6 .dw $3050 ; JP @50 ; RETURN L333: ZERO_EQ: ; LBL 0=SUB ; CODE FOR 0= CALL_ POP8 ; CALL POP8 .dw $4289 ; OR R8,R9 ; TEST IF ARGUMENT IS ZERO .dw $B0E8 ; CLR R8 ; ZERO RESULT REGISTER .dw $B0E9 ; CLR R9 .dw $EB01 ; JP NZ,L33F ; SKIP SETTING RESULT TO 1 IF ARG WAS ZERO .db $9E ; L33E: INC R9 CALL_ PUSH8 ; L33F: CALL PUSH8 ; PUSH RESULT TO STACK .dw $3050 ; JP @50 ge_SUB: ; LBL >=SUB ; CODE FOR >= L344: CALL_ POPA8 ; CALL POPA8 ; POP LEFT ARG TO RA RIGHT ARG TO R8 .dw $229B ; SUB R9,RB .dw $328A ; SBC R8,RA ; SUBTRACT RIGHT ARG FROM LEFT ARG .dw $B0E8 ; CLR R8 .dw $B0E9 ; CLR R9 ; ZERO RESULT REGISTER .if as_per_listing .dw $EBED ; JR UGE,L33E ; MAKE USE OF CODE AT END OF 0- .else .dw $fBED ; .endif .dw $8BEC ; JR L33F CONSUB: ; LBL CONSUB ; LOAD A CONSTANT ON STACK L353: .dw $3150 ; SRP $50 .dw $A87E ; LD RA,$7E ; INSTRUCTION POINTER TO WA .dw $B87F ; LD RB,$7F .dw $C28A ; LDC R8,@WA ; LOAD CONSTANT AT WA TO W8 .dw $A0EA ; INCW RA .dw $C29A ; LDC R9,@WA .dw $8BDE ; JR L33F ; EXIT USING LAST PART OF 0= CODE IP_to_S: ; LBL IP>S ; CODE TO PUSH INSTRUCTION POINTER TO STACK L361: .dw $707F ; PUSH $7F .dw $707E ; PUSH $7E .dw $3050 ; JP @50 DOSUB: ; LBL DOSUB ; CODE FOR DO L367: CALL_ POPA8 ; CALL POPA8 ; SWAP CALL_ PUSHA8 ; CALL PUSHA8 IF as_per_listing CALL_ $0A4D ; CALL S>R ; PUSH LIMIT TO STACK CALL_ S_to_R ; CALL S>R ; PUSH INITIAL INDEX TO STACK ELSE CALL_ S_to_R ; CALL S>R ; PUSH LIMIT TO STACK CALL_ S_to_R ; CALL S>R ; PUSH INITIAL INDEX TO STACK ENDIF .dw $3050 ; JP @50 ;; ; LBL +LOOPSUB ; CODE FOR +LOOP (INCREMENT IS ON STACK) L375: CALL_ R_to_S ; CALL R>S ; MOVE INDEX TO STACK CALL_ POPA8 ; L378: CALL POPA8 ; INDEX TO WA, INCREMENT TO W8 .dw $029B ; ADD R9,RB ; INDEX + INCREMENT TO W8 .dw $128A ; ADC R8,RA CALL_ PUSH8 ; CALL PUSH8 ; PUSH UPDATED INDEX TO STACK CALL_ COPYR_to_S; CALL COPYR>S ; COPY LIMIT TO STACK CALL_ POPA8 ; CALL POPA8 ; LIMIT TO WA, UPDATED INDEX TO R8 .dw $22B9 ; SUB RB,R9 ; SUBTRACT UPDATED INDEX FROM LIMIT .dw $32A8 ; SBC RA,R8 .dw $7B09 ; JR MI,L397 ; MINUS IF UPDATED INDEX EXCEEDS LIMIT CALL_ PUSH8 ; CALL PUSH8 ; PUSH UPDATED INDEX TO STACK CALL_ S_to_R ; CALL S>R ; UPDATED INDEX FROM STACK TO RSTACK .db $8D .dw $0241 ; JP L241 L397: CALL_ R_to_S ; L397: CALL R>S ; BACK UP TO HEAD OF LOOP CALL_ POP8 ; CALL POP8 ; POP LIMIT FROM STACK CALL_ LOADEV ; CALL LOADEV ; SKIP OVER IP ADDRESS ADJUSTMENT .dw $3050 ; JP @50 ; EXIT LOOP - MOVE LIMIT FROM RSTACK TO STACK plusLoop_SUB: ; LBL +LOOPSUB ; CODE FOR LOOP L3A2: .dw $3150 ; SRP $50 .dw $9C01 ; LD R9,"01" ; SET INCREMENT TO 1 .dw $B0E8 ; CLA R8 CALL_ PUSH8 ; CALL PUSH8 ; PUSH THE INCREMENT ONTO THE STACK .dw $8BC8 ; JR L378 ; PROCESS THROUGH +LOOP ;; 33 ; Addr Inst Label Oprn Operands Comments ;; LBL ISUB ; CODE FOR I L3AD: CALL_ COPYR_to_S; CALL COPYR>S .dw $3050 ; JP @50 JSUB: ; LBL JSUB ; CODE FOR J L3B2: CALL_ R_to_S ; CALL R>S ; MOVE INNER INDEX TO STACK CALL_ R_to_S ; CALL R>S ; MOVE INNER LIMIT TO STACK CALL_ COPYR_to_S; CALL COPYR>S ; MOVE OUTER INDEX TO STACK .dw $50E4 ; POP R4 ; POP OUTER INDEX TO W4 .dw $50E5 ; POP R5 CALL_ S_to_R ; CALL S>R ; MOVE INNER LIMIT BACK TO RSTACK CALL_ S_to_R ; CALL S>R ; MOVE INNER INDEX BACK TO RSTACK .dw $70E5 ; PUSH R5 ; PUSH W4 ONTO THE STACK .dw $70E4 ; PUSH R4 ; CODE FOR LEAVE .dw $3050 ; JP @50 ; UL LEAVESUB L3CB: CALL_ R_to_S ; CALL R>S ; MOVE INDEX TO STACK CALL_ POP8 ; CALL POP8 ; PURGE INDEX FROM STACK CALL_ COPYR_to_S; CALL COPYR>S ; COPY LIMIT TO STACK CALL_ S_to_R ; CALL S>R ; SET INDEX TO LIMIT .dw $3050 ; JP @50 ; filler bytes CMOVESUB: ; LBL CMOVESUB ; CODE FOR CMOVE L3D9: CALL_ $0105; CALL POPCA8 ; COUNT TO WC, TARGET ADDR TO WA, SOURCE TO W8 L3DC: .dw $B0E7 ; L3DC: CLR R7 ; CLEAR SOURCE/DESTINATION FLAG .dw $4288 ; OR R8,R8 ; R8 IS ZERO IF SOURCE IS IN REGFILE .dw $6B01 ; JR Z,L3E5 .db $7E ; INC R7 ; SET LOW BIT OF R7 TO INDICATE SOURCE IN RAM L3E5: .dw $42AA ; L3E5: OR RA,RA ; RA IS ZERO IF DESTINATION IS IN REGFILE .dw $6B03 ; JR Z,L3EA .db $46,$E7,$02; OR R7,$02 ; BIT 1 OF R7 IS SET FOR DESTINATION IN RAM L3EA: .dw $4277 ; L3EA: OR R7,R7 ; R7 ZERO IF SOURCE AND DEST IN REG FILE .dw $6B18 ; JR Z,Z3F6 .db $A6,$E7,$01; CP R7,$O1 ; R7 IS 1 FOR SOURCE IN RF, DEST IN RAM .dw $6B0F ; JR Z,L3F2 .db $A6,$E7,$02; CP R7,$02 ; R7 IS 2 FOR SOURCE IN RAM, DEST IN RF .dw $6B06 ; JR Z,L3EE .dw $C268 ; LDC R6,@W8 ; BOTH SOURCE AND DESTINATION IN RAM L3FA: .dw $D26A ; L3EA: LDC @WA,R6 .dw $8B0C ; JR L3FA ; LOOP EXIT L3FE: ; Labels in listing don't match actual addresses when assembled, ; I have appended __ to indicate this. L3EE__: .IF 0 .dw $e369 ; L3EE: LD R6,@R9 ; SOURCE IN RF, DESTINATION IN RAM .ELSE .dw $e369 ; L3EE: LD R6,@R9 ; SOURCE IN RF, DESTINATION IN RAM .ENDIF .dw $8BF8 ; JR L3EA ; STORE IN RAM L3F2__: .dw $C268 ; L3F2: LDC R6,@W8 ; SOURCE IN RAM, DESTINATION IN RF .dw $8B02 ; JR L3F8 ; L3F6__: .dw $E369 ; L3F6: LD R6,@R9 ; BOTH SOURCE AND DEST IN REG FILE L3F8__: .dw $F3B6 ; L3F8: LD @RB,R6 ; STORE IN REG FILE L3FA__: .dw $A0E8 ; L3FA: INCW R8 ; INCREMENT SOURCE ADDRESS .dw $A0EA ; INCW WA ; INCREMENT DESTINATION ADDRESS .dw $80EC ; DECW RC ; DECREMENT COUNT ;; 34 ;; Addr Inst Label Oprn Operands ; Comments .dw $EBCA ; JR NZ,L3DC ; IF NOT ZERO, REPEAT THE LOOP .dw $3050 ; JP @50 HERESUB: ; LBL HERESUB ; CODE FOR HERE L414: .dw $7013; PUSH $13 ; PUSH HERE (REG FILE 12/13) TO STACK .dw $7012 ; PUSH $12 .dw $3050 ; JP @50 comma: ; LBL ,SUB ; CODE FOR , (COMMA - COMPILE STACK) L41A: CALL_ POP8 ; CALL POP8 ; POP WORD TO COMPILE OFF STACK .dw $A812 ; LD RA,$12 ; DICTIONARY POINTER TO WA .dw $B813 ; LD RB,$13 IF 0 .dw $D213 ; LDC @WA,R8 ; STORE W8 AT END ON DICTIONARY ELSE .dw $D28A ENDIF .dw $A0EA ; INCW WA L425: .dw $D29A ; L425: LDC @WA,R9 ; STORE LOW BYTE OF W8 AT END OF DICTIONARY .dw $A0EA ; INCW WA ; SET DICTIONARY POINTER TO NEXT UNUSED LOCATION .dw $A912 ; LD $12,RA ; STORE UPDATE DICTIONARY POINTER IN REGFILE 12/13 .dw $B913 ; LD $13,RB .dw $3050 ; JP @50 C_comma_SUB: ; LBL C,SUB ; CODE FOR C, (C, - COMPILE BYTE TO STACK) L42F: CALL_ POP8 ; CALL POP8 .dw $A812 ; LD RA,$12 ; DICTIONARY POINTER TO WA .dw $B813 ; LD RB,$13 .dw $8BED ; JR L425 H_dot_SUB: ; LBL H.SUB ; CODE TO PRINT BYTE ON STACK L438: CALL_ POP8 ; CALL POP8 ; POP WORD OFF TOP OF STACK .dw $A8E9 ; LD RA,R9 ; TOP BYTE TO RA .dw $BC04 ; LD RB,$04 ; DO FOUR CHARACTERS .dw $98E8 ; LA3F: LD R9,$R8 .dw $F0E9 ; SWAP R9 .db $56,$E9,$0F; AND R9,$0F ; AND OUT LEADING NIBBLE .db $06,$E9,$30; ADD R9,$30 ; MAKE IT A CHARACTER .db $A6,$E9,$3A; CP R9,$3A ; WAS IT A-F? .dw $7B03 ; JR ULT,L451 .db $06,$E9,$07; ADD R9,7 ; ADD 7 TO WE IT A-F L451: CALL_ SEROUT ; L451: CALL SEROUT ; WRITE THE CHARACTER TO SERIAL OUTPUT PORT .db $A6,$EB,$03; CP RB,$03 ; IF COUNTER IS THREE GET LOWER BYTE .dw $EB04 ; JR NZ,L45D .dw $88EA ; LD R8,RA ; LOAD LOWER BYTE INTO R8 L45B: .dw $8B02 ; L45B: JR L45F L45D: .dw $F0E8 ; L45D: SWAP R8 ; SWAP TO MAKE LOW BYTE THE ONE THAT'S WORKED ON L45F: .dw $BADE ; L45F: DJNZ RB,L43F ; DO ANOTHER NIBBLE .dw $3050 ; JP e50 one_plus: ; LBL 1+SUB ; CODE FOR 1+ L463: CALL_ POP8 ; CALL POP8 .dw $A0E8 ; INCW W8 ; 35 ; Addr Inst Label Oprn Operands Comments CALL_ PUSH8 ; CALL PUSH8 .dw $3050 ; JP @50 2DROPSUB: ; LBL 2DROPSUB ; CODE FOR 2DROP L46D: CALL_ POP8 ; CALL POP8 ; PRUNE TWO WORDS FROM STACK CALL_ POP8 ; CALL POP8 .dw $3050 ; JP @50 DLITSUB: ; LBL DLITSUB CODE FOR DLITERAL L475: CALL_ LOADEV ; CALL LOADEV ; LOAD HIGH WORD OF DOUBLE WORD CALL_ PUSH8 ; CALL PUSH8 ; PUSH IT ONTO THE STACK CALL_ LOADEV ; CALL LOADEV ; LOAD LOW WORD OF DOUBLE WORD CALL_ PUSH8 ; CALL PUSH8 ; PUSH IT ONTO THE STACK .db $8D .dw $025C ; US1 JP L25C ; EXIT VIA CODE FOR SWAP Dplus_SUB: ; LBL D+SUB ; CODE FOR D+ L484: CALL_ POPA8 ; CALL POPA8 ; POP ONE DOUBLE WORD ARGUMENT TO WA,W8 .dw $50E6 ; POP R6 ; POP THE OTHER TO W6,W4 .dw $50E7 ; POP R7 .dw $50E4 ; POP R4 .dw $50E5 ; POP R5 .dw $0295 ; ADD R9,R5 ; ADD W6,W4 TO WA,W8 .dw $1284 ; ADC R8,R4 .dw $12B7 ; ADC RB,R7 .dw $12A6 ; ADC RA,R6 L497: CALL_ PUSHA8 ; L497: CALL PUSHA8 ; PUSH WA THEN W8 ONTO STACK .dw $8BE5 ; JR U81 ; EXIT VIA CODE FOR SWAP DNEGSUB: ; LBL DNEGSUB ; CODE FOR DNEGATE L49C: CALL_ POPA8 ; CALL POPA8 ; POP THE DOUBLE WORD ARGUMENT TO WA,W8 .dw $60E9 ; COM R9 .dw $60E8 ; COM R8 .dw $60EB ; COM RB .dw $60EA ; COM RA .db $06,$E9,$01; ADD R9,$01 ; ADD ONE FOR TWOS COMPLEMENT .db $16,$E8,$00; ADC R8,$00 .db $16,$EB,$00; ADC RB,$00 .db $16,$EA,$00; ADC RA,$00 .dw $8BE2 ; JR L497 ; EXIT VIA CODE FOR D+ DOES_SUB: ; LBL DOES_SUB ; CODE FOR DOES L4B5: .dw $707D ; PUSH $7D ; PUSH EXECUTION VECTOR ONTO THE STACK .dw $707C ; PUSH $7C CALL_ S_to_R ; CALL S>R ; PUSH EXECUTION VECTOR TO RSTACK .dw $3170 ; SRP $70 .dw $C2CE ; LD RC,@WE ; LOAD EXECUTION VECTOR @IP .dw $A0EE ; INCW RE .dw $C2DE ; LD RD,@WE .dw $A0EE ; INCW RE ; 36 ; Addr Inst Label Oprn Operands Comments .dw $70EF ; PUSH RF ; PUSH IP TO STACK .dw $70EE ; PUSH RE .dw $3050 ; JP @50 WORDAUX: ; LBL WORDAUX ; SUBROUTINE FOR WORD CODE L4CC: .dw $68E8 ; LD R6,R8 ; BUFFER ADDRESS TO W6 .dw $78E9 ; LD R7,R9 .db $04,$15,$E7; ADD R7,$15 ; ADD >IN TO BUFFER ADDRESS .db $14,$14,$E6; ADC R6,$14 .dw $C2A6 ; LDC RA,@W6 ; FETCH CHARACTER FROM BUFFER TO RA .dw $42AA ; OR RA,RA ; TEST WHETHER ITS ZERO .db $AF ; RTN WORDSUB: ; LBL WORDSUB ; CODE FOR WORD L4DB: CALL_ POPA8 ; CALL POPA8 ; FENCE TO RB, BUFFER ADDRESS TO W8 L4DE: CALL_ WORDAUX ; L4DE: CALL WORDAUX ; SKIP TO FIRST OCCURRENCE OF FENCE .dw $6B2C ; JR Z,L50F ; ZERO IF END OF BUFFER .dw $A2AB ; CP RA,RB ; TEST CHARACTER AGAINST FENCE L4E5: .dw $EB04 ; JR NZ,L4ED ; NON-ZERO IF CHAR WAS NOT THE FENCE .dw $A014 ; INCW $14 ; INCREMENT OFFSET L4E9: .dw $8BF3 ; JR L4DE L4EB: .dw $C8E6 ; LD RC,R6 ; LOAD CHARACTER ADDRESS TO WD L4ED: .dw $D8E7 ; L4ED: LD RD,R7 L4EF: .dw $A014 ; L4EF: INCW 14 ; INCREMENT >IN CALL_ WORDAUX ; CALL WORDAUX ; GET ANOTHER .dw $6B19 ; JR Z,L50D .dw $A2AB ; CP RA,RB ; COMPARE CHAR WITH FENCE .dw $EBF5 ; JR NZ,L4EF .dw $88E6 ; LD R8,R6 ; CHAR ADDRESS TO W8 .dw $98E7 ; LD R9,R7 .dw $229D ; SUB R9,RD ; LENGTH OF WORD TO W8 L500: .dw $328C ; SBC R8,RC L502: .dw $A812 ; L502: LD RA,$12 ; DIRECTORY POINTER (TARGET) TO WA .dw $B813 ; LD RB,$13 .dw $D29A ; LDC @WA,R9 ; LENGTH BYTE TO DICTIONARY .dw $A0EA ; INCW WA ; POINT TO DESTINATION FOR TEXT CALL_ PUSHCA8 ; CALL PUSHCA8 ; FROM ADDR IN WC, TO IN WA, COUNT IN W8 .dw $3050 ; L50D JP,@50 L50F: .dw $B014 ; L50F: CLR $14 ; CASE WHEN BUFFER STARTS WITH ZERO .dw $B015 ; CLR $15 ; CLEAR >IN .dw $C8E6 ; LD RC,R6 ; CHARACTER ADDRESS TO WC .dw $D8E7 ; LD RD,R7 .dw $B0E8 ; CLR R8 ; SET CHARACTER COUNT TO 1 .dw $9C01 ; LD R9,$01 L51B: .dw $8BE5 ; JR L502 FINDCC: ; LBL FINDCC ; COMPARE CHARACTERS ROUTINE (FOR FIND) L51D: .dw $C2C8 ; LDC RC,@W8 ; GET CHARACTER FROM DIRECTORY .dw $C2DA ; LDC RC,@WA ; GET CHARACTER FROM WORD ; 37 ; Addr Inst Label Oprn Operands Comments .dw $52C7 ; AND RC,R7 ; AND OUT CHARACTERS TO TEST .dw $52D7 ; AND RD,R7 .dw $A2CD ; CP RC,RD .db $AF ; RTN FINDSB: ; LBL FINDSB ; FIND STOP BIT ROUTINE (FOR FIND) L528: .dw $C2D8 ; LDC RD,@W8 ; GET THE CHARACTER FROM WORD .db $56,$ED,$80; AND RD,$80 ; GET THE STOP BIT .db $AF ; RTN L52E: CALL_ POPA8 ; CALL POPA8 ; ADDRESS OF WORD TO RA DICTIONARY IN R8 .dw $4288 ; OR R8,R8 ; DICTIONARY ADDRESS IN REG FILE? .dw $EB0B ; JR NZ,L54D ; NZ IF DICTIONARY ADDRESS EXPLICIT .db $E5,$59,$EC; LD RC,@R9 ; IF DICT ARG IN REG FILE ITS A POINTER .db $9E ; INC R9 ; LOAD POINTER TO WC .db $E5,$59,$ED; LD RD,@R9 .dw $88EC ; LD R8,RC ; NOW LOAD THE DICTIONARY ADDRESS .dw $98ED ; LD R9,RD L540: .dw $7C1F ; L540: LD R7,$1F ; TEST EQUALITY OF WORD COUNTS L542: CALL_ FINDCC ; L542: CALL FINDCC .dw $EB20 ; JR NZ,L562 ; IF NOT EQUAL GO GET NEXT DICTIONARY ENTRY L547: .dw $A0E8 ; L547: INCW W8 ; POINT TO NEXT BYTE IN DICTIONARY .dw $A0EA ; INCW WA ; POINT TO NEXT BYTE IN WORD .dw $7C7F ; LD R7,$7F ; SET UP TO TEST THE ASCII CHARACTERS CALL_ FINDCC ; CALL FINDCC .dw $EB10 ; JR NZ,L562 ; IF NOT EQUAL GO GET NEXT DICTIONARY ENTRY CALL_ FINDSB ; CALL FINDSB ; CHECK IF THE DICTIONARY ENTRY STOP BIT IS SET .dw $6BF0 ; JR EQ,L547 ; IF NOT SET GO CHECK NEXT CHAR IN DICTIONARY .dw $A0E8 ; INCW R8 ; DICTIONARY ENTRY MATCHES WORD - POINT TO .dw $A0E8 ; INCW R8 ; PARAMETER PART OF DICTIONARY ENTRY .dw $A0E8 ; INCW R8 CALL_ PUSH8 ; CALL PUSH8 ; PUSH ADDRESS OF PARAMETER ENTRY (OR ZERO) .dw $3050 ; JP @50 ; ONTO STACK AND RETURN L562: CALL_ FINDSB ; L562: CALL FINDSB ; CHAR OF ENTRY DIDN'T MATCH - IS SEARCH AT THE .dw $EB04 ; JR NZ,L56B ; END OF THE DICTIONARY ENTRY? .dw $A0E8 ; INCW W8 ; IF NOT, LOOK AT THE NEXT CHAR IN THE DICTIONARY .dw $8BF7 ; JR L562 L56B: .dw $A0E8 ; INCW W8 ; DICTIONARY ENTRY DIDN'T MATCH - GO TO NEXT ENTRY .dw $C2C8 ; LDC RC,@W8 ; LOAD LINK TO NEXT ENTRY INTO WC .dw $A0E8 ; INCW W8 .dw $C2D8 ; LDC RD,@W8 .dw $88EC ; LD R8,RC ; LOAD ADDRESS OF DICTIONARY ENTRY TO W8 .dw $98ED ; LD R9,RD .dw $42CD ; OR RC,RD ; IS THE LINK ADDRESS ZERO? .dw $6BE2 ; JR EQ,L55D .dw $A812 ; LD RA,$12 ; RESTORE ADDRESS OF WORD INTO WA .dw $B813 ; LD RB,$13 .dw $8BBF ; JR L540 ; 38 ; Addr Inst Label Oprn Operands Comments dot_quote: ; LBL ."SUB ; CODE TO EXECUTE DOT-QUOTE L581: .dw $3150 ; SRP $50 .dw $B87D ; LD RF3,$7D ; LOAD INSTRUCTION POINTER INTO RA .dw $A87C ; LD RA,$7C .dw $C28A ; LDC R8,@RA ; LOAD CHARACTER COUNT FROM TEXT .dw $A0EA ; INCW WA L589: .dw $C29A ; L589: LDC R9,@WA ; LOAD SUCCEEDING CHARACTER FROM TEXT CALL_ SEROUT ; CALL SEROUT ; WRITE CHARACTER TO SERIAL OUTPUT PORT .dw $8AF7 ; DJNZ R8,L589 .dw $A0EA ; INCW WA .dw $B97D ; LD $7D,RB ; RESTORE IP FROM WA .dw $A97C ; LD $7C,RA .dw $3050 ; JR @50 .end