; ==================================================================================== ; Reconstructed RCA Tiny BASIC, as explained. ; ; Sept 6 2016 Herb Johnson ; the following was TMSI Tiny BASIC as produced in 1982 ; open-released by Lee Hart, around 2010. ; The TMSI source was slightly modified to assemble under A18. ; ; RCA manual CPD18S02 Evaluation Kit manual MPM-203 has ; a hex dump of RCA Tiny BASIC which is substantially the ; same binary as TMSI Tiny BASIC. ; ; September 2016 - TMSI Tiny BASIC source was edited ; by Herb Johnson to assemble to the hex-dump code described above. ; There were not that many changes. ; ; ==================================================================================== ; Modifications by Robert Coward 17/06/2020 ; ; This file is now totally correct and generates a hex file that exactly matches the ; official Tiny Basic listing in the RCA CDP18S020 Evaluation Kit manual (MPM-203), ; pages 10-24 and 10-24. This file has been uploaded to a CDP18S020 board and has ; been extensively tested in operation. ; ; The original version of this file was downloaded from this archive on Herb Johnson's site: ; http://www.retrotechnology.com/memship/rca_tiny_basic.zip ; There are a lot of files in this archive, but this particular file was called rca.asm. ; Unfortunately, there were a few issues with this file, meaning differences from ; the listing in the CDP18S020 manual. In its original state, this file would NOT function on ; the board, primarily due to incorrect linkage to the UT4 monitor routines TTYRED and TYPE. ; The hex file differences and their explanation are as follows: ; ; $0000 - RCA listing = $01, original listing = $00. This was an IDL instruction in ; the rca.asm, but should be a LDN $01 to generate the $01 opcode. This has ; no functional impact on the operation of Tiny Basic, as D is overwritten later. ; $02AC - RCA listing = $00, original listing = $08. This is down to the original listing ; specifying a vector TYPEV at $0809, instead of using TYPED at $0009. Since this ; vector is not initialised, this would not work as it stands. ; $02E0 - RCA listing = $00, original listing = $08. Exactly the same issue as at $02AC. ; $0301 - RCA listing = $00, original listing = $08. Exactly the same issue as at $02AC. ; $04E3 - RCA listing = $00, original listing = $08. This is down to the original listing ; specifying a vector KEYV at $0806, instead of using KEYBD at $0006. Since this ; vector is not initialised, this would not work as it stands. ; $0674 - RCA listing = $81, original listing = $84. This is a straightforward bug in the, ; original listing, where it was attempting to call the UT4 TTYRED routine ; at $8440, whereas the correct address is of course $8140. Since these routines ; were not being called due to the vector issue, it is likely that this has been ; missed as it has not been tested. ; ; As well as the above corrections, a number of other changes have been made to allow ; assembly from the A18 assembler, including defining the register names locally. ; The code has also been cosmetically reformatted to ensure a tidier appearance. ; ; Note that once loaded into memory, Tiny Basic can be cold-started by either pressing ; RESET and then RUN P, or by booting into UT4 (RESET and RUN U) and then executing a ; $P0 or $P1 instruction. The very first instruction has no operational impact, so $P0 ; and $P1 result in the same operation. To warm-start Tiny Basic (i.e. keep your user ; program intact), boot into UT4 and issue the $P3 instruction. ; ; ==================================================================================== ; AVOCET XASM18 MACRO-ASSEMBLER SYNONYMS ; ; CALL ADDRESS IS A SYNONYM FOR SEP R4 (D4) ; DW ADDR ; EXIT IS A SYNONYM FOR SEP R5 (D5) ; POP IS A SYNONYM FOR LDXA (72) ; PUSH IS A SYNONYM FOR STXD (73) ; ; I had to change these pseudo-ops to actual code HRJ ;-------------------------------------------------------------------; ; ; ; TTTTT I N N Y Y BBBB AAA SSSSS I CCCCC ; ; T I NN N Y Y B B A A S I C ; ; T I N N N Y Y BBBB AAAAA SSSSS I C ; ; T I N NN Y B B A A S I C ; ; T I N N Y BBBB A A SSSSS I CCCCC ; ; ; ;-------------------------------------------------------------------; ; ; TINY BASIC FOR THE COSMAC 1802 MICROCOMPUTER 2/18/82 ; WRITTEN BY TOM PITTMAN ; MODIFIED BY LEE A. HART ; COPYRIGHT 1982 BY TECHNICAL MICRO SYSTEMS, INC. ; ASSEMBLE WITH AVOCET XASM18 CROSS-ASSEMBLER ; ; ==================================================================================== ; 1802 baseline register definitions R0 EQU 0 ; PC (VIA RESET) AT ENTRY R1 EQU 1 ; R2 EQU 2 ; STACK POINTER R3 EQU 3 ; NORMAL PROGRAM COUNTER R4 EQU 4 ; MONITOR: RAM PAGE0 POINTER, BASIC: SCRT "CALL" PC R5 EQU 5 ; MONITOR: MAIN PC, BASIC: SCRT "RETURN" PC R6 EQU 6 ; BASIC: SCRT RETURN ADDR. R7 EQU 7 ; BASIC: PC FOR "FECH" R8 EQU 8 R9 EQU 9 R10 EQU 10 R11 EQU 11 R12 EQU 12 R13 EQU 13 R14 EQU 14 R15 EQU 15 ; SPECIFIC REGISTER ASSIGNMENTS FOR TINY BASIC: XX EQU R8 ; MONITOR: ?M VS. !M SWITCH, BASIC: WORK REGISTER PC EQU R9 ; IL PROGRAM COUNTER AC EQU R10 ; MONITOR: MEMORY POINTER, BASIC: 16-BIT ACCUMULATOR BP EQU R11 ; BASIC POINTER DELAY EQU R12 ; PC FOR DELAY SUBROUTINE HEXX EQU R13 ; MONITOR: HEX ADDR. ACCUMULATOR PZ EQU R13 ; BASIC: PAGE 0 POINTER BAUD EQU R14 ; RE.0=BAUD RATE CONSTANT, RE.1=USED FOR READ, TYPE X EQU R15 ; BASIC: SCRATCH REGISTER ASCII EQU R15 ; MONITOR: RF.1=ASCII I/O CHAR. RF.0=USED FOR READ, TYPE ; ==================================================================================== ; EQUATES ; LDI0 EQU 97H ; GHI R7 - CLEAR ACCUM. MACRO TYPA EQU 0D3H ; SEP R3 - TYPE CHAR. MACRO FECH EQU 0D7H ; SEP R7 - PAGE 0 MACRO ; ### Definitions for relevant UT4 monitor entry points used by Tiny Basic UT4_TTYRED EQU 8140H ; Input ASCII character, paper tape control UT4_TYPE EQU 81A4H ; Output ASCII character directly from R15 high ; ; ==================================================================================== ; SCRATCHPAD MEMORY ALLOCATION - OFFSET ADDED TO PAGE ADDRESS ; WPAGE EQU 0800H ; WORKSPACE BEGINNING KEYV EQU WPAGE+06H ; KEY-INPUT ROUTINE VECTOR TYPEV EQU WPAGE+09H ; TYPE-OUTPUT ROUTINE VECTOR BREAKV EQU WPAGE+0CH ; BREAK-DETECTION ROUTINE VECTOR ; EQU +0FH ; UNUSED BS EQU +13H ; BACKSPACE CHARACTER CAN EQU +14H ; CANCEL CHARACTER PAD EQU +15H ; NUMBER OF PAD CHARACTERS ; MSB=0 FOR NULL, =1 FOR DELETE ; +16H ; TAPE MODE ENABLE (80H=ENABLE) SPARE EQU +17H ; STACK RESERVE XEQ EQU +18H ; EXECUTION MODE FLAG LEND EQU +19H ; INPUT LINE BUFFER END AEPTR EQU +1AH ; ARITHMETIC EXPRESSION STACK POINTER ; ; AND INPUT LINE BUFFER TTYCC EQU +1BH ; PRINT COLUMN, MSB=TAPE MODE FLAG NXA EQU +1CH ; SAVED PC FOR "NXT" AIL EQU +1EH ; START ADDRESS OF "IL" BASIC EQU +20H ; START ADDRESS OF BASIC PROGRAM STACK EQU +22H ; HIGHEST ADDRESS OF USER RAM MEND EQU +24H ; END OF BASIC PROGRAM + STACK RESERVE TOPS EQU +26H ; TOP OF GOSUB STACK LINO EQU +28H ; CURRENT BASIC PROGRAM LINE NUMBER WORK EQU +2AH ; MISC. TEMPORARY STORAGE (4 BYTES) SP EQU +2EH ; SAVED POINTER LINE EQU WPAGE+30H ; INPUT LINE BUFFER (BOTTOM; 80 BYTES) AESTK EQU +80H ; ARITHMETIC EXECUTION STACK (TOP) ; +82H ; BASIC VARIABLE A ; +84H ; BASIC VARIABLE B ; ... ; ... ; +B4H ; BASIC VARIABLE Z ; WPAGE+B6H ; INTERPRETER TEMPORARIES (18 BYTES) SAVEREG EQU WPAGE+0B8H ; MONITOR SAVED REGISTERS START SAVEND EQU +0DFH ; SAVED REGISTERS END USER EQU WPAGE+100H ; START OF USER'S BASIC PROGRAM ; ; ==================================================================================== ; EXECUTION BEGINS AT 0000H, FOLLOWING A POWER-ON RESET. ORG 0 ; ==================================================================================== ; ### First instruction does nothing useful, so could be IDL, but we use a LDN 1 ; instruction in order to match the original printed listing in the CDP18S020 manual LDN R1 ; ### Dummy instruction to match original listing BR 0B0H LBR WARM ; WARM START KEYBD: LBR TTYRED ; JUMP TO KEY-INPUT ROUTINE TYPED: LBR TYPE ; JUMP TO KEY-OUTPUT ROUTINE TBRK: LBR TSTBR ; JUMP TO BREAK-DETECTION ROUTINE ; DB 5FH ; "BACKSPACE" CHARACTER DB 18H ; "CANCEL" CHARACTER ; (ANY BUT 0AH, ODH, FFH, 00H) DB 82H ; PAD CODE: ; ^-------------------LSD=# OF PAD CHARS AFTER CR ; ^--------------------MSD=8: PAD CHAR. IS NULL (00) ; =0: PAD CHAR. IS DELETE (FFH) DB 80H ; TAPE MODE DB 20H ; SPARE STACK DB 30h DB 22H DB 30H DB 20H ; ; MEMORY POKE SUBROUTINE ; POKE: STR XX ; STORE BYTE SEP R5 ; EXIT RETURN DW TBIL ; ADDRESS OF IL CONST: DW 08C8H ; ENTRY TO MONITOR PGM? DB 0 ; WRAP POINT DB HIGH(WPAGE) ; PAGE ADDR. HI BYTE ; ; MEMORY PEEK SUBROUTINE ; LDA XX SKP PEEK: DB LDI0 ; SINGLE BYTE LOAD PHI AC ; HI BYTE INTO ACCUM LDA XX ; LO BYTE INTO D SEP R5 ; EXIT RETURN ; ; I/O PORT ACCESS (IN1-7, OUT1-7) LBR IO ; ==================================================================================== ; ;---------------------------------------; ; COMMONLY-USED SUBROUTINES ; ;---------------------------------------; ; ; STANDARD CALL - USES R4 AS ITS PROGRAM COUNTER ; SEP R3 ; < EXIT: CALL: PHI X ; > ENTRY: SAVE D SEX R2 ; PUSH R6 ONTO STACK GLO R6 STXD GHI R6 STXD GLO R3 ; SAVE OLD R3 IN R6 PLO R6 GHI R3 PHI R6 LDA R6 ; LOAD SUBROUTINE PHI R3 ; ADDRESS INTO R3 LDA R6 PLO R3 GHI X ; RESTORE D BR CALL-1 ; ...AND GO TO EXIT ; ; STANDARD RETURN - USES R5 AS ITS PROGRAM COUNTER ; SEP R3 ; < EXIT: RETRN: PHI X ; > ENTRY: SAVE D SEX R2 ; COPY R6 INTO R3 GHI R6 PHI R3 GLO R6 PLO R3 INC R2 ; POP R6 FROM STACK LDA R2 PHI R6 LDN R2 PLO R6 GHI X ; RESTORE D BR RETRN-1 ; ...AND GO TO EXIT ; ; BASE PAGE RAM FETCH - USES R7 AS ITS PROGRAM COUNTER ; SEP R3 ; < EXIT: FETCH: LDA R3 ; > ENTRY: SET PZ POINTER PLO PZ ; TO BASE PAGE LDI HIGH(WPAGE) ; PLUS OFFSET (FROM CALLER) PHI PZ LDA PZ ; GET BYTE @ POINTER SEX PZ ; INCREMENT PZ POINTER BR FETCH-1 ; ...AND GO TO EXIT ; ==================================================================================== ; ;---------------------------------------; ; OPCODE TABLE ; ;---------------------------------------; TABLE: DW BACK DW HOP DW MATCH DW TSTV DW TSTN DW TEND DW RTN DW HOOK DW WARM DW XINIT DW CLEAR DW INSRT DW RETN DW RETN DW GETLN DW RETN DW RETN DW STRNG DW CRLF DW TAB DW PRS DW PRN DW LIST DW RETN DW NXT DW CMPR DW IDIV DW IMUL DW ISUB DW IADD DW INEG DW XFER DW RSTR DW SAV DW STORE DW IND DW RSBP DW SVBP DW RETN DW RETN DW BPOP DW APOP DW DUPS DW LITN DW LIT1 DW RETN TBEND: EQU $ ; OPCODES BACKWARDS FROM HERE ; ==================================================================================== ; ;-----------------------------------------------; ; COLD & WARM START INITIALIZATION ; ;-----------------------------------------------; ; ; COLD START; ENTRY FOR "NEW?" = YES ; COLD: LDI LOW($+3) ; CHANGE PROGRAM COUNTER PLO R3 ; FROM R0 TO R3 LDI HIGH($) PHI R3 SEP R3 ; DETERMINE SIZE OF USER RAM PHI AC ; GET LOW END ADDR. LDI LOW(CONST) ; OF USER PROGRAM PLO AC ; RAM (AT "CONST") LDA AC PHI R2 ; ..AND PUT IN R2 LDA AC PLO R2 LDA AC ; SET PZ TO WRAP POINT PHI PZ ; (END OF SEARCH) LDI 0 PLO PZ LDN PZ ; ..AND SAVE BYTE PHI X ; NOW AT ADDR. PZ SCAN: SEX R2 ; REPEAT TO SEARCH RAM.. INC R2 ; - GET NEXT BYTE LDX PLO X ; - SAVE A COPY XRI 0FFH ; - COMPLEMENT IT STR R2 ; - STORE IT XOR ; - SEE IF IT WORKED SEX PZ LSNZ ; - IF MATCHES, IS RAM GHI X ; SET CARRY IF AT XOR ; WRAP POINT.. ADI 0FFH ; - ELSE IS NOT RAM GLO X ; RESTORE ORIGINAL BYTE STR R2 BNF SCAN ; - ..UNTIL END OR WRAP POINT DEC R2 LDN AC ; RAM SIZED: SET PHI PZ ; POINTER PZ TO LDI STACK+1 ; WORK AREA PLO PZ GLO R2 ; STORE RAM END ADDRESS STXD GHI R2 STXD ; GET & STORE RAM BEGINNIG DEC AC ; REPEAT TO COPY PARAMETERS.. DEC AC ; - POINT TO NEXT LDN AC ; - GET PARAMETER STXD ; - STORE IN WORK AREA GLO PZ XRI BS-1 ; - TEST FOR LAST PARAMETER BNZ $-6 ; - ..UNTIL LAST COPIED SHR ; SET DF=0 FOR "CLEAR" LSKP ; ; WARM START: ENTRY FOR "NEW?" = NO ; WARM: SMI 0 ; SET DF=1 FOR "DON'T CLEAR" LDI $+3 PLO R3 ; BE SURE PROGRAM COUNTER IS R3 LDI HIGH($) PHI R3 SEP R3 PHI R4 ; INITIALIZE R4, R5, R7 PHI R5 PHI R7 LDI CALL PLO R4 LDI RETRN PLO R5 LDI FETCH PLO R7 BDF PEND ; IF COLD START, CLEAR: DB FECH,BASIC ; - MARK PROGRAM EMPTY PHI BP LDA PZ PLO BP DB LDI0 ; WITH LINE# = 0 STR BP INC BP STR BP DB FECH,SPARE-1 ; - SET MEND = START + SPARE GLO BP ; GET START ADD ; ADD LOW BYTE OF SPARE PHI X ; SAVE TEMPORARILY DB FECH,MEND ; GET MEND GHI X STXD ; STORE LOW BYTE OF MEND GHI BP ADCI 0 ; ADD CARRY STXD ; STORE HIGH BYTE OF MEND PEND: DB FECH,STACK ; SET STACK TO END OF MEMORY PHI R2 LDA PZ PLO R2 DB FECH,TOPS GLO R2 ; SET TOPS TO EMPTY STXD ; (I.E. STACK END) GHI R2 STXD SEP R4 ; CALL DW FORCE ; SET TAPE MODE "OFF" IIL: DB FECH,AIL ; SET IL PC PHI PC LDA PZ PLO PC ; CONTINUE INTO "NEXT" ; ; EXECUTE NEXT INTERMEDIATE LANGUAGE (IL) INSTRUCTION ; NEXT: SEX R2 ; GET OPCODE LDA PC SMI 30H ; IF JUMP OR BRANCH, BDF TBR ; GO HANDLE IT SDI 0D7H ; IF STACK BYTE EXCHANGE, BDF XCHG ; GO HANDLE IT SHL ; ELSE MULTIPLY BY 2 ADI TBEND ; TO POINT INTO TABLE PLO R6 LDI LOW(NEXT) ; & SET RETURN TO HERE DEC R2 ; (DUMMY STACK ENTRY) DEC R2 STXD GHI R3 STXD DOIT: GHI R7 ; TABLE PAGE PHI R6 LDA R6 ; FETCH SERVICE ADDRESS STR R2 LDA R6 PLO R6 LDX PHI R6 SEP R5 ; GO DO IT ; TBR: SMI 10H ; IF JUMP OR CALL, BNF TJMP ; GO DO IT PLO R6 ; ELSE BRANCH; SAVE OPCODE ANI 1FH ; COMPUTE DESTINATION BZ TBERR ; IF BRANCH ADDR = 0, GOTO ERROR STR R2 ; PUSH ADDRESS ONTO STACK GLO PC ; ADD RELATIVE OFFSET ADD ; LOW BYTE STXD GHI PC ; HIGH BYTE W. CARRY ADCI 0 SKP TBERR: STXD ; STORE 0 FOR ERROR STXD GLO R6 ; NOW COMPUTE SERVICE ADDRESS SHR ; WHICH IS HIGH 3 BITS SHR SHR SHR ANI 0FEH ADI LOW(TABLE) ; INDEX INTO TABLE PLO R6 BR DOIT ; TJMP: ADI 8 ; NOTE IF JUMP IN CARRY ANI 7 ; GET ADDRESS PHI R6 LDA PC PLO R6 BDF JMP ; JUMP GLO PC ; PUSH PC STXD ; PUSH GHI PC STXD ; PUSH SEP R4 ; CALL DW STEST ; CHECK STACK DEPTH ; JMP: DB FECH,AIL ; ADD JUMP ADDRESS TO IL BASE GLO R6 ADD PLO PC GHI R6 DEC PZ ADC PHI PC BR NEXT ; XCHG: SDI 7 ; SAVE OFFSET STR R2 DB FECH,AEPTR PLO PZ SEX R2 ADD PLO R6 ; R6 IS OTHER POINTER GHI PZ PHI R6 LDN PZ ; NOW SWAP THEM: STR R2 ; SAVE OLD TOP LDN R6 ; GET INNER BYTE STR PZ ; PUT ON TOP LDN R2 ; GET OLD TOP STR R6 ; PUT IN BR NEXT ; BACK: GLO R6 ; REMOVE OFFSET SMI 20H ; FOR BACKWARDS HOP PLO R6 GHI R6 SMBI 0 SKP ; HOP: GHI R6 ; FORWARD HOP BZERR: LBZ ERR ; IF ZERO, GOTO ERROR PHI PC ; ELSE PUT INTO PC GLO R6 PLO PC BR NEXT ; INC BP ; ADVANCE TO NEXT NON-BLANK CHAR. NONBL: LDN BP ; GET CHARACTER SMI 20H ; IF BLANK, BZ NONBL-1 ; INCREMENT POINTER AND TRY AGAIN SMI 10H ; IF NUMERIC (0-9), LSNF SDI 9 ; SET DF=1 NONBX: LDN BP ; GET CHARACTER SEP R5 ;EXIT AND RETURN ; STORE: SEP R4 ; CALL DW APOP ; GET VARIABLE LDA PZ ; GET POINTER PLO PZ GHI AC ; STORE THE NUMBER STR PZ INC PZ GLO AC STR PZ BR BPOP ; GO POP POINTER ; SEP R4 ; CALL DW APOP ; POP 4 BYTES APOP: SEP R4 ; CALL DW BPOP ; POP 2 BYTES PHI AC ; FIRST BYTE TO AC.1 BPOP: DB FECH,AEPTR ; POP 1 BYTE DEC PZ ADI 1 ; INCREMENT STR PZ PLO PZ DEC PZ LDA PZ ; LEAVE IT IN D PLO AC ; AND AC.0 RETN: SEP R5 ; EXIT ; TEND: SEP R4 ; CALL DW NONBL ; GET NEXT CHARACTER XRI 0DH ; IF CARRIAGE RETURN, BZ NEXT ; THEN FALL THRU IN IL BR HOP ; ELSE TAKE BRANCH ; TSTV: SEP R4 ; CALL DW NONBL ; GET NEXT CHARACTER SMI 41H ; IF LESS THAN 'A', BNF HOP ; THEN HOP SMI 1AH ; IF GREATER THAN 'Z' BDF HOP ; THEN HOP INC BP ; ELSE IS LETTER A-Z GHI X ; GET SAVED COPY SHL ; CONVERT TO VARIABLE'S ADDRESS SEP R4 ; CALL DW BPUSH ; AND PUSH ONTO STACK BR NEXT ; TSTN: SEP R4 ; CALL DW NONBL ; GET NEXT CHARACTER BNF HOP ; IF NOT A DIGIT, HOP DB LDI0 ; ELSE COMPUTE NUMBER PHI AC ; INITIALLY 0 PLO AC SEP R4 ; CALL DW APUSH ; PUSH ONTO STACK NUMB: LDA BP ; GET CHARACTER ANI 0FH ; CONVERT FROM ASCII TO NUMBER PLO AC DB LDI0 PHI AC LDI 10 ; ADD 10 TIMES THE.. PLO X SEX PZ NM10: INC PZ GLO AC ; ..PREVIOUS VALUE.. ADD PLO AC GHI AC DEC PZ ; ..WHICH IS ON STACK. ADC PHI AC DEC X ; COUNT THE ITERATIONS GLO X BNZ NM10 GHI AC ; SAVE NEW VALUE STR PZ INC PZ GLO AC STXD SEP R4 ; CALL DW NONBL ; IF ANY MORE DIGITS, LBDF NUMB ; THEN DO IT AGAIN NHOP: LBR NEXT ; UNTIL DONE ; MATCH: GHI BP ; SAVE PB IN CASE NO MATCH PHI AC GLO BP PLO AC MAL: SEP R4 ; CALL DW NONBL ; GET A BYTE (IN CAPS) ; INC BP ; COMPARE THEM STR R2 LDA PC XOR BZ MAL ; STILL EQUAL XRI 80H ; END? BZ NHOP ; YES GHI AC ; NO GOOD PHI BP ; PUT POINTER BACK GLO AC PLO BP JHOP: LBR HOP ; THEN TAKE BRANCH ; STEST: DB FECH,MEND ; POINT TO PROGRAM END GLO R2 ; COMPARE TO STACK TOP SD DEC PZ GHI R2 SDB BDF ERR ; AHA; OVERFLOW SEP R5 ; EXIT ; LIT1: LDA PC ; ONE BYTE BR BPUSH LITN: LDA PC ; TWO BYTES PHI AC ; FIRST IS HIGH BYTE, LDA PC ; THEN LOW BYTE BR APUSH+1 ; PUSH RESULT ONTO STACK ; HOOK: SEP R4 ; CALL DW HOOP ; GO DO IT, LEAVE EXIT HERE BR APUSH+1 ; PUSH RESULT ONTO STACK ; DUPS: SEP R4 ; CALL DW APOP ; POP 2 BYTES INTO AC SEP R4 ; CALL DW APUSH ; THEN PUSH TWICE APUSH: GLO AC ; PUSH 2 BYTES SEP R4 ; CALL DW BPUSH GHI AC BPUSH: STR R2 ; PUSH ONE BYTE (IN D) DB FECH,LEND ; CHECK FOR OVERFLOW SM ; COMPARE AEPTR TO LEND BDF ERR ; OOPS! LDI 1 SD STR PZ PLO PZ LDN R2 ; GET SAVED BYTE STR PZ ; STORE INTO STACK SEP5: SEP R5 ; EXIT ; & RETURN ; IND: SEP R4 ; CALL DW BPOP ; GET POINTER PLO PZ LDA PZ ; GET VARIABLE PHI AC LDA PZ BR APUSH+1 ; GO PUSH IT ; QUOTE: XRI 2FH ; TEST FOR QUOTE BZ SEP5 ; IF QUOTE, GO EXIT XRI 22H ; ELSE RESTORE CHARACTER SEP R4 ; CALL DW TYPER PRS: LDA BP ; GET NEXT BYTE XRI 0DH ; IF NOT CARRIAGE RETURN, BNZ QUOTE ; THEN CONTINUE DEC PC ; ELSE CONTINUE INTO ERROR ; ERR: DB FECH,XEQ ; ERROR: PHI XX ; SAVE XEQ FLAG SEP R4 ; CALL DW FORCE ; TURN TAPE MODE OFF LDI "!" ; PRINT "!" ON NEW LINE SEP R4 ; CALL DW TYPER DB FECH,AIL GLO PC ; CONVERT IL PC TO ERROR# SM ; BY SUBTRACTING PLO AC ; IL START FROM PC GHI PC DEC PZ ; X MUST POINT TO SMB ; PAGE0 REGISTER PZ=RD PHI AC SEP R4 ; CALL DW PRNA ; PRINT ERROR# GHI XX ; GET XEQ FLAG BZ BELL ; IF XEQ SET, LDI LOW(ATMSG) ; - THEN TYPE "AT" PLO PC GHI R3 PHI PC SEP R4 ; CALL DW STRNG DB FECH,LINO ; - GET LINE NUMBER PHI AC ; - AND PRINT IT, TOO LDA PZ PLO AC SEP R4 ; CALL DW PRNA BELL: LDI 7 ; RING THE BELL SEP R4 ; CALL DW TYPED ; ### Corrected to match original listing SEP R4 ; CALL DW CRLF ; PRINT FIN: DB FECH,TTYCC-1 DB LDI0 ; TURN TAPE MODE OFF STR PZ EXIT: DB FECH,TOPS ; RESET STACK POINTER PHI R2 LDA PZ PLO R2 LBR IIL ; RESTART IL FROM BEGINNING ; ATMSG: DB ' AT ',0A3H ; ERROR MESSAGE TEMPLATE ; TSTR: SEP R4 ; CALL DW TYPER-2 ; PRINT CHARACTER STRING STRNG: LDA PC ; GET NEXT CHARACTER OF STRING ADI 80H ; IF HI BIT=0, BNF TSTR ; THEN GO PRINT & CONTINUE BR TYPER-2 ; PRINT LAST CHAR AND EXIT ; FORCE: DB FECH,AEPTR-1 LDI AESTK ; CLEAR A.E.STACK STXD DB LDI0 ; SET "NOT EXECUTING" STXD ; LEND=0 ZERO LINE LENGTH STXD ; XEQ=0 NOT EXECUTING LSKP ; CONTINUE TO CRLF ; CRLF: DB FECH,TTYCC ; GET COLUMN COUNT SHL ; IF IN TAPE MODE (MSB=1), BDF SEP5 ; THEN JUST EXIT DB FECH,PAD ; GET # OF PAD CHARS PLO AC ; & SAVE IT LDI 0DH ; TYPE PADS: SEP R4 ; CALL DW TYPED ; ### Corrected to match original listing DB FECH,TTYCC-1 ; POINT PZ TO COLUMN COUNTER GLO AC ; GET # OF PADS TO GO SHL ; MSB SELECTS NULL OR DELETE BZ PLF ; UNTIL NO MORE PADS.. DEC AC ; DECREMENT # OF PADS TO GO DB LDI0 ; PAD=NULL=0 IF MSB=0 LSNF LDI 0FFH ; PAD=DELETE=FFH IF MSB=1 BR PADS ; ..REPEAT ; PLF: STXD ; SET COLUMN COUNTER TTYCC=0 LDI 8AH ; TYPE ; SMI 80H ; FIX HI BIT TYPER: PHI X ; SAVE CHAR DB FECH,TTYCC ; CHECK OUTPUT MODE DEC PZ ADI 81H ; INCREMENT COLUMN COUNTER TTYCC ADI 80H ; WITHOUT DISTURBING MSB BNF SEP5 ; IF MSB=1, IN TAPE MODE, NOT PRINTING STR PZ ; ELSE UPDATE COLUMN COUNTER GHI X ; GET CHAR LBR TYPED ; AND GO TYPE IT ### Corrected to match original listing ; TAB: DB FECH,TTYCC ; GET COLUMN COUNT ANI 7 ; LOW 3 BITS SDI 8 ; SUBTRACT FROM 8 TO GET PLO AC ; NUMBER OF SPACES TO NEXT TAB TABS: GLO AC BZ SKIP+1 ; UNTIL 0.. LDI ' ' ; PRINT A SPACE SEP R4 ; CALL DW TYPER DEC AC ; DECREMENT SPACES TO GO BR TABS ; ...REPEAT ; PRNA: SEP R4 ; CALL DW APUSH ; NUMBER IN AC PRN: DB FECH,AEPTR ; CHECK SIGN PLO PZ SEP R4 ; CALL DW DNEG ; IF NEGATIVE, BNF PRP LDI '-' ; PRINT '-' SEP R4 ; CALL DW TYPER PRP: DB LDI0 ; PUSH ZERO FLAG STXD ; WHICH MARKS NUMBER END PHI AC ; PUSH 10 (=DIVISOR) LDI 10 SEP R4 ; CALL DW APUSH+1 INC PZ PDVL: SEP R4 ; CALL DW PDIV ; DIVIDE BY 10 GLO AC ; REMAINDER IS NEXT DIGIT SHR ; BUT DOUBLED; HALVE IT ORI 30H ; CONVERT TO ASCII STXD ; PUSH IT INC PZ ; IS QUOTIENT=0? LDA PZ SEX PZ OR DEC PZ ; RESTORE POINTER DEC PZ BNZ PDVL ; ..REPEAT PRNL: INC R2 ; NOW, TO PRINT IT LDN R2 ; GET CHAR LBZ APOP-3 ; UNTIL ZERO (END FLAG).. SEP R4 ; CALL DW TYPER ; PRINT IT BR PRNL ; ..REPEAT ; RSBP: DB FECH,SP ; GET SP SKP SVBP: GHI BP ; GET BP XRI HIGH(LINE) ; IN THE LINE? BNZ SWAP ; NO, NOT IN SAME PAGE GLO BP STR R2 LDX SMI LOW(AESTK) BDF SWAP ; NO, BEYOND ITS END DB FECH,SP GLO BP ; YES, JUST COPY BP TO SP STXD GHI BP STR PZ TYX: SEP R5 ; EXIT ; SWAP: DB FECH,SP ; EXCHANGE BP AND SP PHI XX ; PUT SP IN TEMP LDN PZ PLO XX GLO BP ; STORE BP IN SP STXD GHI BP STR PZ GHI XX ; STORE TEMP IN BP PHI BP GLO XX PLO BP SEP R5 ; EXIT ; CMPR: SEP R4 ; CALL DW APOP ; GET FIRST NUMBER GHI AC ; PUSH ONTO STACK WITH BIAS XRI 80H ; (FOR 2'S COMPLEMENT) STXD ; (BACKWARDS) GLO AC STXD SEP R4 ; CALL DW BPOP ; GET AND SAVE PLO X ; COMPARE BITS SEP R4 ; CALL DW APOP ; GET SECOND NUMBER INC R2 GLO AC ; COMARE THEM SM ; LOW BYTE PLO AC INC R2 GHI AC ; HIGH BYTE XRI 80H ; BIAS: 0 TO 65535 INSTEAD SMB ; OF -32768 TO +32767 STR R2 BNF CLT ; LESS IF NO CARRY OUT GLO AC OR BZ CEQ ; EQUAL IF BOTH BYTES 0 GLO X ; ELSE GREATER SHR ; MOVE PROPER BIT SKP CEQ: GLO X ; (BIT 1) SHR SKP CLT: GLO X ; (BIT 0) SHR ; TO CARRY LSNF NOP SKIP: INC PC ; SKIP ONE BYTE IF TRUE SEP R5 ; EXIT ; ISUB: SEP R4 ; CALL DW INEG ; SUBTRACT IS ADD NEGATIVE IADD: SEP R4 ; CALL DW APOP ; PUT ADDEND IN AC SEX PZ INC PZ ; ADD TO AUGEND GLO AC ADD STXD GHI AC ; CARRY INTO HIGH BYTE ADC STR PZ SEP R5 ; EXIT ; IMUL: SEP R4 ; CALL DW APOP ; MULTIPLIER IN AC LDI 10H ; BIT COUNTER IN X PLO X LDA PZ ; MULTIPLICAND IN XX PHI XX LDN PZ PLO XX MULL: LDN PZ ; SHIFT PRODUCT LEFT SHL ; (ON STACK) STR PZ DEC PZ LDN PZ SHLC ; DISCARD HIGH 16 BITS STR PZ SEP R4 ; CALL DW SHAL ; GET A BIT BNF MULC ; NOT THIS TIME SEX PZ ; IF MULTIPLIER BIT=1, INC PZ GLO XX ; ADD MULTIPLICAND ADD STXD GHI XX ADC STR PZ MULC: DEC X ; REPEAT 16 TIMES GLO X INC PZ BNZ MULL SEP R5 ; EXIT ; IDIV: SEP R4 ; CALL DW APOP ; GET DIVISOR GHI AC STR R2 ; CHECK FOR DIVIDE BY ZERO GLO AC OR LBZ ERR ; IF YES, FORGET IT LDN PZ ; COMPARE SIGN OF DIVISOR XOR STXD ; SAVE FOR LATER SEP R4 ; CALL DW DNEG ; MAKE DIVEDEND POSITIVE DEC PZ ; SAME FOR DIVISOR DEC PZ SEP R4 ; CALL DW DNEG INC PZ DB LDI0 LSKP PDIV: DB LDI0 ; MARK "NO SIGN CHANGE" STXD ; FOR PRN ENTRY PLO AC ; CLEAR HIGH END PHI AC ; OF DIVIDEND IN AC LDI 17 ; COUNTER TO X PLO X DIVL: SEX PZ ; DO TRIAL SUBTRACT GLO AC SM STR R2 ; HOLD LOW BYTE FOR NOW DEC PZ GHI AC SMB BNF $+5 ; IF NEGATIVE, CANCEL IT PHI AC ; IF POSITIVE, MAKE IT REAL LDN R2 PLO AC INC PZ ; SHIFT EVERYTHING LEFT INC PZ INC PZ LDX SHLC STXD LDX SHLC STXD GLO AC ; HIGH 16 SHLC SEP R4 ; CALL DW SHCL DEC X ; DO IT 16 TIMES MORE GLO X LBNZ DIVL INC R2 ; CHECK SIGN OF QUOTIENT LDN R2 SHL BNF NEGX ; POSITIVE IS DONE INEG: DB FECH,AEPTR ; POINT TO STACK PLO PZ BR NEG DNEG: SEX PZ LDX ; FOR DIVIDE, SHL ; TEST SIGN BNF NEGX ; IF POSITIVE, LEAVE IT ALONE NEG: INC PZ ; IF NEGATIVE, DB LDI0 ; SUBTRACT IT FROM 0 SM STXD DB LDI0 SMB STR PZ SMI 0 ; AND SET CARRY=1 NEGX: SEP R5 ; EXIT ; SHAL: GLO AC ; USED BY MULTIPLY SHL SHCL: PLO AC ; AND DIVIDE GHI AC SHLC PHI AC SEP R5 ; EXIT ; NXT: DB FECH,XEQ ; IF DIRECT EXECUTION, LBZ FIN ; QUIT WITH DF=0 LDA BP ; ELSE SCAN TO NEXT XRI 0DH BNZ $-3 SEP R4 ; CALL DW GLINO ; GET LINE NUMBER BZ BERR ; ZERO IS ERROR CONT: SEP R4 ; CALL DW TBRK ; TEST FOR BREAK BDF BREAK ; IF BREAK, DB FECH,NXA ; RECOVER RESTART POINT PHI PC ; WHICH WAS SAVED BY INIT LDA PZ PLO PC RUN: DB FECH,XEQ-1 ; TURN OFF RUN MODE STR PZ ; (NON-ZERO) SEP R5 ; EXIT ; BREAK: DB FECH,AIL ; SET BREAK ADDR=0 PHI PC ; I.E. PC=IL START LDA PZ PLO PC BERR: LBR ERR ; XINIT: DB FECH,BASIC ; POINT TO START OF BASIC PROGRAM PHI BP LDA PZ PLO BP SEP R4 ; CALL DW GLINO ; GET LINE NUMBER BZ BERR ; IF 0, IS ERROR (NO PROGRAM) DB FECH,NXA ; SAVE STATEMENT GLO PC ; ANALYZER ADDRESS STXD GHI PC STR PZ BR RUN ; GO START UP ; XFER: SEP R4 ; CALL DW FIND ; GET THE LINE BZ CONT ; IF WE GOT IT, GO CONTINUE GOAL: DB FECH,LINO ; ELSE FAILED GLO AC ; MARK DESTINATION STXD GHI AC STR PZ BR BERR ; GO HANDLE ERROR ; RSTR: SEP R4 ; CALL DW TTOP ; CHECK FOR UNDERFLOW LDA R2 ; GET THE NUMBER PHI AC ; FROM STACK INTO AC LDN R2 PLO AC DB FECH,TOPS GLO R2 ; RESET TOPS FROM R2 STXD GHI R2 STXD SEP R4 ; CALL DW FIND+3 ; POINT TO THIS LINE BNZ GOAL ; NOT THERE ANY MORE BR BNEXT ; OK ; RTN: SEP R4 ; CALL DW TTOP ; CHECK FOR UNDERFLOW LDA R2 ; (2 ALREADY INCLUDED) PHI PC ; PIP ADDRESS TO PC LDN R2 PLO PC BNEXT: LBR NEXT ; TTOP: DB FECH,STACK ; GET TOP OF STACK INC R2 INC R2 GLO R2 ; MATCH TO STACK POINTER ADI 2 ; (ADJUSTED FOR RETURN) XOR DEC PZ BNZ TTOK ; NOT EQUAL GHI R2 ADCI 0 XOR BZ BERR ; MATCH IS EMPTY STACK ; TTOK: INC R2 ; (ONCE HERE SAVES TWICE) SEP R5 ; EXIT ; TAPE: DB FECH,PAD+1 ; TURN OFF TYPEOUT SKP NTAPE: DB LDI0 ; TURN ON TYPEOUT SHL ; (FLAG TO CARRY) DB FECH,TTYCC-1 DB LDI0 SHRC ; 00 OR 80H STR PZ BR KLOOP GETLN: LDI LOW(LINE) ; POINT TO LINE PLO BP SEP R4 ; CALL DW APUSH ; MARK STACK LIMIT GHI PZ PHI BP KLOOP: SEP R4 ; CALL DW KEYBD ; GET AN ECHOED BYTE ### Corrected to match original listing ANI 7FH ; SET HIGH BIT TO 0 BZ KLOOP ; IGNORE NULL STR R2 XRI 7FH BZ KLOOP ; IGNORE DELETE XRI 75H ; IF , BZ TAPE ; THEN TURN TAPE MODE ON XRI 19H ; IF (DC3=13H), BZ NTAPE ; THEN TURN TAPE MODE OFF DB FECH,CAN-1 LDN R2 XOR ; IF CANCEL, BZ CANCL ; THEN GO TO CANCEL DEC PZ LDN R2 XOR BNZ STOK ; NO DEC BP ; YES GLO BP SMI LOW(LINE) ; ANYTHING LEFT? BDF KLOOP ; YES CANCL: LDI LOW(LINE) ; IF NO, CANCEL THIS LINE PLO BP LDI 0DH ; BY FORCING A SKP STOK: LDN R2 ; STORE CHARACTER IN LINE STR BP DB FECH,AEPTR-1 GLO BP ; CHECK FOR OVERFLOW SM BNF CHIN ; OK LDI 7 ; IF NOT, RING BELL SEP R4 ; CALL DW TYPER LDN BP ; NOW LOOK AT CHAR SKP CHIN: LDA BP ; INCREMENT POINTER XRI 0DH ; IF NOT , BNZ KLOOP ; THEN GET ANOTHER SEP R4 ; CALL DW CRLF ; ELSE ECHO DB FECH,LEND-1 ; AND MARK END GLO BP STR PZ LDI LOW(LINE) ; RESET BP TO FRONT PLO BP LBR APOP ; AND GO POP DUMMY ; FIND: SEP R4 ; CALL DW APOP ; GET LINE NUMBER GLO AC STR R2 ; CHECK FOR ZERO GHI AC OR LBZ ERR ; IF 0, GO TO ERROR FINDX: DB FECH,BASIC ; START AT FRONT PHI BP LDA PZ PLO BP FLINE: SEP R4 ; CALL DW GLINO ; GET LINE NUMBER LSNZ ; NOT THER IF 0 GLO PZ ; SET NON-ZERO, FEND: SEP R5 ; EXIT ; AND RETURN SEX PZ GLO AC ; COMPARE THEM SD STR R2 ; (SAVE LOW BYTE OF DIFFERENCE) GHI AC DEC PZ SDB SEX R2 OR ; (D=0 IF EQUAL) BDF FEND ; LESS OR EQUAL IS END LDA BP ; NOT THERE YET XRI 0DH ; SCAN TO NEXT BNZ $-3 BR FLINE ; HOOP: SEP R4 ; CALL DW HOOP+3 ; ADJUST STACK SEP R4 ; CALL DW APOP ; SET UP PARAMETERS: LDA PZ ; AC PHI XX ; MIDDLE ARGUMENT TO XX LDA PZ PLO XX LDA PZ ; SUBROUTINE ADDRESS BECOMES PHI R6 ; "RETURN ADDRESS" LDA PZ PLO R6 GLO PZ ; FIX STACK POINTER STR R2 DB FECH,AEPTR-1 LDN R2 ; BY PUTTING CURRENT VALUE STR PZ ; VALUE BACK INTO IT PLO PZ ; LEAVE PZ AT STACK TOP GLO AC ; LEAVE AC.0 IN D SEP R5 ; EXIT ; GO DO IT ; LIST: DB FECH,WORK+2 GLO BP ; SAVE POINTERS STXD GHI BP STR PZ SEP R4 ; CALL DW FIND ; GET LIST LIMITS DB FECH,WORK ; SAVE UPPER GLO BP STXD GHI BP STXD SEP R4 ; CALL DW FIND ; TWO ITEMS MARK BOUNDS DEC BP ; BACK UP OVER LINE# DEC BP LLINE: DB FECH,WORK ; END? GLO BP SM DEC PZ GHI BP SMB BDF LIX ; SO IF BP>BOUNDS, LDA BP ; GET LINE# PHI AC LDA BP PLO AC BNZ $+5 GHI AC BZ LIX ; QUIT IF ZERO (PROGRAM END) SEP R4 ; CALL DW PRNA ; ELSE PRINT LINE# LDI 2DH ; THEN A SPACE LLOOP: XRI 0DH ; (RESTORE BITS FROM TEST) SEP R4 ; CALL DW TYPER SEP R4 ; CALL DW TBRK ; TEST FOR BREAK BDF LIX ; IF YES, THEN QUIT LDA BP ; NOW PRINT TEXT XRI 0DH ; UNTIL BNZ LLOOP SEP R4 ; CALL DW CRLF ; END LINE WITH BR LLINE ; ..REPEAT UNTIL DONE ; LIX: DB FECH,WORK+2; RESTORE BP PHI BP LDA PZ PLO BP SEP R5 ; EXIT ; SAV: DB FECH,TOPS ; ADJUST STACK TOP GLO R2 STXD GHI R2 STR PZ DB FECH,XEQ ; IF NOT EXECUTING, DEC PZ LSZ ; USE ZERO INSTEAD DB FECH,LINO PLO AC ; HOLD HIGH BYTE LDA PZ ; GET LOW BYTE INC R2 INC R2 SEX R2 STXD ; PUSH ONTO STACK GLO AC ; NOW THE HIGH BYTE STXD LBR NEXT ; GLINO: DB FECH,LINO-1 ; SETUP POINTER LDA BP ; GET 1ST BYTE STR PZ ; STORE IN RAM INC PZ LDA BP ; 2ND BYTE STXD OR ; D=0 IF LINE#=0 INC PZ SEP R5 ; EXIT ; INSRT: SEP R4 ; CALL DW SWAP ; SAVE POINTER IN NEW LINE SEP R4 ; CALL DW FIND ; FIND INSERT POINT ADI 0FFH ; IF DONE, SET DF DB LDI0 PLO X ; X IS SIZE DIFFERENCE BDF NEW GHI BP ; SAVE INSERT POINT PHI PZ GLO BP PLO PZ DEC X ; MEASURE OLD LINE LENGTH DEC X ; -3 FOR LINE# AND DEC X ; REPEAT.. LDA PZ ; -1 FOR EACH BYTE OF TEXT XRI 0DH ; ..UNTIL BNZ $-4 NEW: DEC BP ; BACK OVER LINE# DEC BP SEP R4 ; CALL DW SWAP ; TRADE LINE POINTERS DB FECH,LINO LDN BP XRI 0DH ; IF NEW LINE IS NULL, STXD STR PZ BZ HMUCH ; THEN GO MARK IT GHI AC ; ELSE SAVE LINE NUMBER STR PZ INC PZ GLO AC STR PZ GHI BP ; MEASURE ITS LENGTH PHI AC GLO BP PLO AC INC X ; LINE# INC X ; ENDING INC X LDA AC XRI 0DH ; AND ALL CHARS UNTIL FINAL BNZ $-4 HMUCH: DB FECH,SP ; FIGURE AMOUNT OF MOVE PHI AC LDA PZ PLO AC DB FECH,MEND ; =DISTANCE FROM INSERT GLO AC ; TO END OF PROGRAM SM PLO AC ; LEAVE IT IN AC, NEGATIVE DEC PZ GHI AC SMB PHI AC INC PZ GLO X ; NOW COMPUTE NEW MEND, ADD ; WHICH IS SUM OF OFFSET, PHI X GLO X ANI 80H ; WITH SIGN EXTEND, LSZ LDI 0FFH DEC PZ ADC ; PLUS OLD MEND SEX R2 STXD ; PUSH ONTO STACK PHI XX GHI X STXD ; (BACKWARDS) STR R2 ; CHECK FOR OVERFLOW GLO R2 SD GHI XX STR R2 GHI R2 SDB LBDF ERR-1 ; IF YES, THEN QUIT GLO X ; ELSE NO, PREPARE TO MOVE BZ STUFF ; NO MOVE NEEDED STR R2 SHL BNF MORE ; ADD SOME SPACE DB FECH,SP ; DELETE SOME PHI X ; X IS DESTINATION LDA PZ PLO X SEX R2 SM PLO XX ; XX IS SOURCE GHI X ADCI 0 PHI XX LDA XX ; NOW MOVE IT STR X INC X INC AC GHI AC BNZ $-5 BR STUFF MORE: GHI X ; SET UP POINTERS PLO X ; X IS DESTINATION GHI XX PHI X DB FECH,MEND PHI XX LDA PZ PLO XX ; XX IS SOURCE DEC AC SEX X ; NOW MOVE IT LDN XX DEC XX STXD INC AC GHI AC BNZ $-5 STUFF: DB FECH,MEND ; UPDATE MEND INC R2 LDA R2 STXD LDN R2 STR PZ DB FECH,SP ; POINT INTO PROGRAM PHI AC LDA PZ PLO AC DB FECH,LINO ; INSERT NEW LINE PLO X OR ; IF THERE IS ONE BZ INSX ; NO, EXIT GLO X ; ELSE INSERT LINE NUMBER STR AC INC AC LDA PZ STR AC INC AC LDA BP ; NOW REST OF LINE STR AC XRI 0DH ; TO BNZ $-5 INSX: LBR EXIT ; ; I/O PORT DRIVER: CALL VIA USR(38,N,B) ; N=1 TO 7: OUT1-7 & OUTPUT B ; N=9 TO 15: IN1-7 RESPECTIVELY ; IO: STXD ; PUSH OUT BYTE STR R2 DB LDI0 ; CLEAR AC PHI AC DEC PZ LDA R3 ; STORE RETURN IN RAM SEP R5 ; (THIS IS NOT EXECUTED) STR PZ DEC PZ GLO XX ; MAKE IO INSTRUCTION ANI 0FH ORI 60H STR PZ ANI 8 LSZ NOP ; INPUT, SO INC R2 ; DO INCREMENT NOW SEP PZ ; GO EXECUTE, RESULT IN D ; ; TEST FOR BREAK (TO ABORT LONG LISTINGS) ; TSTBR: ADI 0 ; SET DF=0 B4 $+6 ; IF BREAK (EF4=0, SO EF4 PIN HIGH), SMI 0 ; THEN SET DF=1 BN4 $ ; WAIT FOR EF4 PIN TO RETURN LOW SEP R5 ; EXIT ; ; MONITOR, address should be 066FH- RCA disassembled code HRJ ; Setup registers and call into UT4 serial input routine TTYRED: SEP R7 INC R1 GLO R13 STXD LBR UT4_TTYRED ; ### Fixed bug in original listing ; Setup registers and call into UT4 serial output routine TYPE: SEP R7 INC R2 BZ TT SEP R12 INC R7 DEC R13 STR R13 TT: LBR UT4_TYPE ; ; ==================================================================================== ; ;-----------------------------------------------; ; TINY BASIC INTERMEDIATE LANGUAGE ; ;-----------------------------------------------; ; ; INTERMEDIATE LANGUAGE OPERATION CODES ; SX: EQU 00H ; STACK EXCHANGE (00-07) BYTE N WITH BYTE 0 NO: EQU 08H ; NO OPERATION LB: EQU 09H ; PUSH NEXT BYTE ONTO STACK LN: EQU 0AH ; ADD NEXT NUMBER TO STACK (2 BYTES) DS: EQU 0BH ; DUPLICATE NUMBER ON TOP OF STACK (2 BYTES) SB: EQU 10H ; SAVE BASIC POINTER RP: EQU 11H ; RESTORE BASIC POINTER (PITTMAN USED RB) FV: EQU 12H ; FETCH VARIABLE SV: EQU 13H ; STORE VARIABLE GS: EQU 14H ; GOSUB SAVE RS: EQU 15H ; RESTORE SAVED LINE GO: EQU 16H ; GOTO NG: EQU 17H ; NEGATE, TWO'S COMPLEMENT (PITTMAN USED NE) AD: EQU 18H ; ADD SU: EQU 19H ; SUBTRACT MP: EQU 1AH ; MULTIPLY DV: EQU 1BH ; DIVIDE CP: EQU 1CH ; COMPARE NX: EQU 1DH ; NEXT BASIC STATEMENT LS: EQU 1FH ; LIST PROGRAM PN: EQU 20H ; PRINT NUMBER PQ: EQU 21H ; PRINT BASIC STRING PT: EQU 22H ; PRINT TAB NL: EQU 23H ; NEW LINE PS: EQU 24H ; PRINT STRING, ENDING IN CHAR W. MSB=1 GL: EQU 27H ; GET INPUT LINE IL: EQU 2AH ; INSERT BASIC LINE MT: EQU 2BH ; MARK BASIC PROGRAM SPACE EMPTY XQ: EQU 2CH ; EXECUTE WS: EQU 2DH ; STOP US: EQU 2EH ; MACHINE LANGUAGE SUBROUTINE CALL RT: EQU 2FH ; IL SUBROUTINE RETURN JS: EQU 3000H ; JUMP SUBROUTINE @ NEXTBYTE-STRT (3000-37FF) JU: EQU 3800H ; JUMP TO LABEL AT NEXTBYTE-STRT (3800-3FFF) BR: EQU 5FH ; BRANCH RELATIVE TO 5FH+LABEL-$ (40-7F) BC: EQU 7FH ; BRANCH IF NO MATCH TO 7FH+LABEL-$ (80-9F) BV: EQU 9FH ; BRANCH IF NOT A VARIABLE (A0-BF) BN: EQU 0BFH ; BRANCH IF NOT NUMBER TO BFH+LABEL-$ (C0-DF) BE: EQU 0DFH ; BRANCH IF NOT ENDLINE TO DFH+LABEL-$(E0-FF) ; ==================================================================================== ; BEGIN TINY BASIC INTERMEDIATE LANGUAGE PROGRAM ; TBIL: EQU $ STRT: DB PS,":",91H ; PS ":" PRINT PROMPT DB GL ; GL GET LINE DB SB ; SB SAVE POINTER DB BE+L0-$ ; BE L0 IF EMPTY, DB BR+STRT-$ ; BR STRT THEN START AGAIN L0: DB BN+GOTO-$ ; BN GOTO IF LINE NUMBER, DB IL ; IL THEN INSERT LINE DB BR+STRT-$ ; BR STRT AND START AGAIN X1: DB XQ ; XQ ELSE EXECUTE LINE ; ; EXECUTE STATEMENT ; GOTO: DB BC+GOSB-$ ; BC GOSB "GOTO" DB "GOT",("O"+80H) DW JS+EXPR-STRT ; JS EXPR GET LINE NUMBER XEC: DB SB ; SB SAVE POINTERS DB RP ; RP FOR RUNN WITH DB BE+G1-$ ; BE G1 CONCATENATED INPUT DB BR+G2-$ ; BR G2 GOSB: DB BC+STMT-$ ; BC STMT "GOSUB" DB "GOSU" DB ("B"+80H) DW JS+EXPR-STRT ; JS EXPR DB SB ; SB DB RP ; RP G1: DB BE+1 ; BE * DB GS ; GS G2: DB GO ; GO STMT: DB BC+PRNT-$ ; BC PRNT "LET" DB "LE",("T"+80H) DB BV+1 ; BV * MUST BE VARIABLE NAME DB BC+1 ; BC * "=" DB ("="+80H) LET: DW JS+EXPR-STRT ; JS EXPR GO GET EXPRESSION DB BE+1 ; BE * IF STATEMENT, DB SV ; SV STORE RESULT DB NX PRNT: DB BC+SKIPIT-$ ; BC SKIPIT "PR" DB "P",("R"+80H) DB BC+P0-$ ; BC P0 "INT" IF PR OR PRINT, DB "IN",("T"+80H) P0: DB BE+P1-$ ; BE P1 DB BR+P2-$ ; BR P2 P1: DB BC+P3-$ ; BC P3 ":" DB (":"+80H) P2: DW JU+P12-STRT ; JU P12 SKIPIT: DW JU+IF-STRT ; JU IF P3: DB BC+P4-$ ; BC P4 '"' DB ('"'+80H) DB PQ ; PQ QUOTE MARKS STRING DB BR+P5-$ ; BR P5 P4: DW JS+EXPR-STRT; JS EXPR DB PN ; PN P5: DB BC+P6-$ ; BC P6 "," DB (","+80H) DB PT ; PT DB BR+P7-$ ; BR P7 P6: DB BC+P9-$ ; BC P9 ";" DB (";"+80H) P7: DB BE+P8-$ ; BE P8 DB BR+P11-$ ; BR P11 P8: DB BR+P1-$ ; BR P1 P9: DB BC+P10-$ ; BC P10 "^" DB ("^"+80H) DB PS,93H ; PS "" PRINT =13H=^S P10: DB BE+1 ; BE * P12: DB NL ; NL THEN P11: DB NX ; NX IF: DB BC+INP-$ ; BC INP "IF" DB "I",("F"+80H) DW JS+EXPR-STRT ; JS EXPR DW JS+RELO-STRT ; JS RELO DW JS+EXPR-STRT ; JS EXPR DB BC+I1-$ ; BC I1 "THEN" (OPTIONAL) DB "THE",("N"+80H) I1: DB CP ; CP DB NX ; NX DW JU+GOTO-STRT ; JU STMT ; ; PROCESS INPUT STATEMENT ; INP: DB BC+RTRN-$ ; BC RTRN "IN" DB "I",("N"+80H) DB BC+I2-$ ; BC I2 "PUT" DB "PU",("T"+80H) I2: DB BV+1 ; BV * DB SB ; SB DB BE+I4-$ ; BE I4 I3: DB PS,"? " ; PS "? " TYPE "?" PROMPT, DB (11H+80H) ; THEN =11H=XON=^Q DB GL ; GL THEN READ INPUT LINE DB BE+I4-$ ; BE I4 PROCESS IT DB BR+I3-$ ; BR I3 IF NOT ENOUGH, REPEAT I4: DB BC+I5-$ ; BC I5 "," OPTIONAL COMMA? DB (","+80H) I5: DW JS+EXPR-STRT ; JS EXPR READ A NUMBER DB SV ; SV STORE IN VARIABLE DB RP ; RB SWAP DB BC+I6-$ ; BC I6 "," IF ANOTHER COMMA, DB (","+80H) DB BR+I2-$ ; BR I2 THEN PROCESS IT I6: DB BE+1 ; BE * DB NX ; NX ELSE QUIT ; ; PROCESS RETURN STATEMENT ; RTRN: DB BC+END-$ ; BC END "RET" DB "RE",("T"+80H) DB BC+RT1-$ ; BC RT1 "URN" DB "UR",("N"+80H) RT1: DB BE+1 ; BE * DB RS ; RS DB NX ; NX END: DB BC+RUNN-$ ; BC RUNN "END" DB "EN",("D"+80H) DB BE+1 ; BE * DB WS ; WS RUNN: DB BC+CLER-$ ; BC CLER "RUN" DB "RU",("N"+80H) DB SB ; SB DB RP ; RB DW JU+X1-STRT ; JU X1 CLER: DB BC+LISTIT-$ ; BC LISTIT "NEW" DB "NE",("W"+80H) DB MT ; MT LISTIT: DB BC+REM-$ ; BC REM "LIST" DB "LIS",("T"+80H) DB BE+L2-$ ; BE L2 LISX: DB LN,0,1 ; LN 1 DB LN,7FH,0FFH ; LN 32767 DB BR+L1-$ ; BR L1 L2: DW JS+EXPR-STRT ; JS EXPR DW JS+ARG-STRT ; JS ARG DB BE+1 ; BE * L1: DB PS ; PS "^@^@^@^@^@^@^J^@" DW 0,0 ; SIX ,, DB 0,0,0AH,80H ; AS A PUNCH LEADER, DB LS ; LS THEN LIST, DB PS,93H ; PS "^S" THEN TURN PUNCH OFF DB NL ; NL WITH =XOFF=^S DB NX ; NX REM: DB BC+DFLT-$ ; BC DFLT "REM" DB "RE",("M"+80H) DB NX ; NX DFLT: DB BV+1 ; BV * IF NO KEYWORD, DB BC+1 ; BC * "=" TRY FOR "=" (LET) DB ("="+80H) DW JU+LET-STRT ; JU LET ; ; IL SUBROUTINES ; ARG: DB BC+E5-$ ; BC E5 "," DB (","+80H) DB BR+EXPR-$ ; BR EXPR E5: DB DS ; DS E3: DB RT ; RT EXPR: DB BC+E0-$ ; BC E0 "-" IF UNARY MINUS, DB ("-"+80H) DW JS+TERM-STRT ; JS TERM GO PROCESS IT DB NG ; NE DB BR+E1-$ ; BR E1 E0: DB BC+E4-$ ; BC E4 "+" IGNORE LEADING PLUS DB ("+"+80H) E4: DW JS+TERM-STRT ; JS TERM E1: DB BC+E2-$ ; BC E2 "+" TERMS SEPARATED BY + DB ("+"+80H) DW JS+TERM-STRT ; JS TERM DB AD ; AD DB BR+E1-$ ; BR E1 E2: DB BC+T2-$ ; BC T2 "-" TERM SEPARATED BY - DB ("-"+80H) DW JS+TERM-STRT ; JS TERM DB SU ; SU DB BR+E1-$ ; BR E1 ; TERM: DW JS+FACT-STRT ; JS FACT T0: DB BC+T1-$ ; BC T1 "*" FACTORS SEPARATED DB ("*"+80H) ; BY TIMES DW JS+FACT-STRT ; JS FACT DB MP ; MP DB BR+T0-$ ; BR T0 T1: DB BC+T2-$ ; BC T2 "/" DB ("/"+80H) DW JS+FACT-STRT ; JS FACT DB DV ; DV DB BR+T0-$ ; BR T0 T2: DB RT ; RT FACT: DB BC+F2-$ ; BC F2 "RND(" DB "RND",("("+80H) DW JS+F6-STRT ; JS F6 DW JU+RR7-STRT ; JU RR7 F2: DB BC+F3-$ ; BC F3 "USR(" 3 ARGUMENTS POSSIBLE DB "USR",("("+80H) DW JS+EXPR-STRT ; JS EXPR ONE REQUIRED DW JS+ARG-STRT ; JS ARG 2ND OPTIONAL DW JS+ARG-STRT ; JS ARG 3RD OPTIONAL DW JS+FUNC-STRT ; JU FUNC DB US DB RT F3: DB BV+F4-$ ; BV F4 IF A VARIABLE, DB FV ; FV THEN GET IT DB RT ; RT F4: DB BN+F5-$ ; BN F5 IF A NUMBER, DB RT ; RT THEN GET IT F5: DB BC+1 ; BC * "(" ELSE MUST BE DB ("("+80H) ; AN EXPRESSION DB BR+F7-$ ; BR F7 F6: DW JS+EXPR-STRT ; JS EXPR DB DS ; DS DB BC+1 ; BC * "," ANOTHER ARGUMENT DB (","+80H) F7: DW JS+EXPR-STRT ; JS EXPR FUNC: DB BC+1 ; BC * ")" END OF PARENTHESES? DB (")"+80H) DB RT ; RT RELO: DB BC+RR0-$ ; BC RR0 "=" CONVERT RELATIONAL DB ("="+80H) ; OPERATORS TO CODE DB LB,2 ; LB 2 BYTE ON STACK DB RT ; RT RR0: DB BC+RR1-$ ; BC RR1 "<>" DB "<",(">"+80H) DB BR+RR2-$ ; BR RR2 RR1: DB BC+RR3-$ ; BC RR3 "<=" DB "<",("="+80H) DB LB,3 ; LB 3 DB RT ; RT RR3: DB BC+RR4-$ ; BC RR4 "<" DB ("<"+80H) DB LB,1 ; LB 1 DB RT ; RT RR4: DB BC+RR5-$ ; BC RR5 ">=" DB ">",("="+80H) DB LB,6 ; LB 5 DB RT ; RT RR5: DB BC+RR6-$ ; BC RR6 "><" DB ">",("<"+80H) RR2: DB LB,5 ; LB 5 DB RT ; RT RR6: DB BC+1 ; BC * ">" DB (">"+80H) DB LB,4 ; LB 4 DB RT ; RT RR7: DB SU ; SU DB NG ; NE DB LN,0,1 ; LN 257*128 STACK POINTER DB AD ; AD FOR STORE DB LB,80H ; LB 128 DB LB,80H ; LB 128 DB FV ; FV SET RANDOM NUMBER DB LN,09H,29H ; LN 2345 R:=R*2345+6789 DB MP ; MP DB LN,1AH,85H ; LN 6789 DB AD ; AD DB NO ; NO DB SV ; SV DB LB,80H ; LB 128 GET IT AGAIN DB FV ; FV DB SX+3 ; SX 3 DB SX+1 ; SX 1 DB SX+2 ; SX 2 DW JS+F1-STRT ; JS F1 SKIPPING F0: DW JS+ABS-STRT ; JS ABS DB DV ; DV DB MP ; MP DB SU ; SU DW JS+ABS-STRT ; JS ABS DB AD ; AD DB RT ; RT F1: DB DS ; DS DB SX+1 ; SX 1 PUSH TOP INTO STACK DB SX+5 ; SX 5 DB SX+1 ; SX 1 DB SX+4 ; SX 4 DB DS ; DS DB SX+1 ; SX 1 DB SX+7 ; SX 7 DB SX+1 ; SX 1 DB SX+6 ; SX 6 DB RT ; RT ABS: DB DS ; DS PERFORM ABS FUNCTION DB LB,6 ; LB 6 DB LN,0,0 ; LN 0 DB CP ; CP DB NG ; NE DB RT ; RT ; ; END TINY BASIC INTERMEDIATE LANGUAGE PROGRAM ; address should be 7FFEH DB 00H ; ==================================================================================== ; end of program listing assembly END ; ==================================================================================== ; ====================================================================================