* MICRO BASIC PLUS SOURCE LISTING
*
* MICRO BASIC PLUS
* COPYRIGHT (C) 1976 BY
*
* TECHNICAL SYSTEMS CONSULTANTS
* BOX 2574
* W. LAFAYETTE INDIANA 47906
*
*----------------------------------------------------------------------
* The original S19 file in this directory works, but the S19 generated
* by assembling the source file does not. I found and corrected two
* source file errors that must have occured during OCR and/or typing
* in the code from a listing:
*
* Change #1
*    PUTLB2 LDAA NUMBER +1	(original)
*    PUTLB2 LDAA NUMBER+1	(fixed)
*
* Change #2
*    BEQ EVAL1C			(original)
*    BEQ EVA11C			(fixed)
*
* 1/11/2020 Mike Douglas
*-------------------------------------------------------------------
* Source file updated to use opcodes of the form LDAA vs LDA A,
* RTS installed at EXTERN by PATCH at START to make module smaller
* for saving on disk (0D60 vs 1F00 end), and BREAK entry changed
* to support the MP-S serial interface board as the console.
*
* 1/11/2020 Mike Douglas
*-------------------------------------------------------------------

* EQUATES

STACK EQU $A07F 
PIAADR EQU $8004 
PFILBG EQU $A002 
PFILEN EQU $A004 
EXTERN EQU $1F00 
MONITR EQU $E0E3 
MONPC EQU $A048 
STKBOT EQU $A000
RETINS EQU $39 RTS OPCODE

* TEMPORARY STORAGE

RNDM RMB 4
BUFPNT RMB 2
FORSTK RMB 2
DIMPNT RMB 2
XTEMP3 RMB 2
DATAST RMB 2 
DATAPT RMB 2 
TRYVAL RMB 2 
CRFLAG RMB 1 
QMFLAG RMB 1 
ROWVAR RMB 1 
ROWCON RMB 1 
COLCON RMB 1 
TABFLG RMB 1 
DIMFLG RMB 1 
RUNFLG RMB 1 
DATAFL RMB 1 
SUBCNT RMB 1 
LETFLG RMB 1 
FLDCNT RMB 1 
NXPNTR RMB 2 
XTEMP RMB 2 
XSAVE RMB 2 
XSAVE2 RMB 2
NUMCNT RMB 1 
NEGFLG RMB 1 
NOEXFL RMB 1 
EXTRA RMB 2 
COUNT RMB 1 
STKCNT RMB 1 
AUXCNT RMB 1 
SIGN RMB 1 
AXSIGN RMB 1 
OVFLBF RMB 1 
XTEMP2 RMB 2 
XTEMP4 RMB 2 
XTEMP5 RMB 2 
CPX1 RMB 2 
CPX2 RMB 2 
STKEND RMB 3 
CHRCNT RMB 1 
OPSTAK RMB 32 
AC RMB 3 
NUMBER RMB 3 
AX RMB 3 
BUFFER RMB 72

* LABLE TABLE

LBLTBL RMB 78
STKTOP RMB 2

* CONSTANTS

BACKSP EQU $8 
DELCOD EQU $18 
PRMPTC EQU $21

 ORG $0100

* MAIN PROGRAM

START JMP PATCH PATCH RTS AT EXTRN
RESTRT JMP FILBUF

* EXTERNAL I-O ROUTINES

OUTEEE JMP $E1D1 
INCH JSR $E1AC 
* BREAK JMP INTBRK 
BREAK JMP TSTTR2 ;POINT TO RTS TO SUPPORT MP-S BOARD
MEMEND FDB $1EFF

* KEYWORD AND JUMP TABLE

KEYTBL FCC 'PRI'
 FDB PRINT

 FCC 'INP'
 FDB INPUT

 FCC 'IF '
 FDB IF

 FCC 'LET'
LETADR FDB LET

 FCC 'FOR'
 FDB FOR

 FCC 'NEX'
 FDB NEXT

 FCC 'GOT'
 FDB GOTO

 FCC 'GOS'
 FDB GOSUB

 FCC 'ON '
 FDB ONGOTO

 FCC 'RET'
 FDB RETURN

 FCC 'REA'
 FDB READ

 FCC 'DAT'
 FDB DATA

 FCC 'RES'
 FDB RESTOR

 FCC 'DIM'
 FDB DIM

 FCC 'EXT'
 FDB EXTRNL

 FCC 'MON'
 FDB MONITR

 FCC 'END'
 FDB FILBUF

 FCC 'REM'
 FDB RUNEXC

 FCC 'RUN'
 FDB RUN

 FCC 'LIS'
 FDB LIST

 FCC 'SCR'
 FDB MICBAS
 FCB 0

FCTTBL FCC 'RND'
 FDB EVAL88

 FCC 'ABS'
 FDB EVAL85
 
 FCC 'SGN'
 FDB EVAL86
 FCB 0

* INITIALIZATION

CLRBEG LDX #START
 STX XTEMP3 SAVE X
CLRBG2 LDX #DATAST SET START
 BRA CLEAR GO CLEAR

CLREND LDX MEMEND SET END
 STX XTEMP3 SAVE
 LDX ENDSTR
CLEAR CLRA CLEAR ACC.
CLEAR2 STAA 0,X CLEAR BYTE
 INX BUMP THE POINTER
 CPX XTEMP3 DONE?
 BNE CLEAR2
 RTS RETURN

MICBAS BSR CLRBEG GO CLEAR
 LDX #STORSP
 STX ENDSTR SET END STORAGE:
 BSR CLREND GO CLEAR

* GET LINE INTO INPUT BUFFER

FILBUF LDX #RESTRT
 STX MONPC SET UP RETURN POINTER 
 LDS #STACK
 LDX #BUFFER
 STX XTEMP3 SAVE BOUND 
 BSR CLRBG2
 LDX #ENDSTR SET PUHCH LIMITS 
 STX PFILBG
 LDX 0,X SET END
 STX PFILEN
 STX DIMPNT
 LDX #BUFFER POINT TO BUFFER
 JSR PCRLF OUTA CR & LF 
 LDAA #PRMPTC
 JSR OUTCH OUTPUT PROMPT
FILBU2 JSR INCHAR GETA CHARACTER
 BEQ FILBUF
 STAA 0,X SAVE CHAR.
 CMPA #$0D IS IT A C.R. ? 
 BEQ FILBU6
 INX BUMP THE POINTER
 CPX #BUFFER+72
 BNE FILBU2 END OF BUFFER? 
 BRA FILBUF
FILBU6 LDX #BUFFER RESET POINTER
 JSR BCDCO1 LINE NO. CONV.
 STX XTEMP2 SAVE POINTER
 JSR FNDKEY CHECK KEY WORD 
 TSTA
 BNE FILBU8 IF NONZERO THEN OK
 LDX BUFPNT POINT TO BUFFER
 LDAA 0,X GET CHARACTER
 CMPA #$D IS IT A C.R.? 
 BNE FILBU7
 LDAB NOEXFL DIR. EXECUTION? 
 BEQ FILBUF
 STAA CRFLAG SET FLAG
 BRA FILBU8 IT IS OK
FILBU7 JSR TSTLET LET?
 BEQ FILBU8
FILB75 LDAA #$10
 JMP MISTAK REPORT ERROR #0
FILBU8 LDAA CHRCNT GET CHAR. COUNT
 SUBA NUMCNT SUB LINE # DIGITS
 STAA CHRCNT SAVE
 LDAB NOEXFL DIRECT EXECUTE ?
 BNE STUFLN IF NOT GO PUT LINE
 JSR PCRLF OUTPUT C.R. L.F.
 JMP RUNEX4 GO TO ROUTINE

* PUT LINE IN PROGRAM STORAGE

STUFLN LDX MEMEND
 STX CPX1
 LDX XTEMP2 SET POINTER
 STX BUFPNT SAVE POINTER
 JSR FNDLIN GO FIND LINE IN STORE
 STX XSAVE SAVE POINTER
 TSTB DID WE FIND IT?
 BNE INSERT IF NOT GO INSERT


* REPLACE EXISTING LINE WITH NEW ONE

REPLAC INCB INC THE COUNTER
 LDAA 0,X GET A CHARACTER
 INX BUMP THE POINTER
 CMPA #$D IS IT A C.R,? 
 BNE REPLAC
REPLA4 STAB OFSET2+1 SETUP OFFSET
 LDAA #$FF GET COUNT
 NEGB 2'S COMP. IT
 BSR ADJEND GO FIX END PNTR
 LDX XSAVE RESTORE THE POINTER
REPLA5 CPX ENDSTR END OF STORAGE?
 BEQ REPLA6
OFSET2 LDAA 0,X
 STAA 0,X MOVE A CHARACTER 
 INX BUMP THE POINTER 
 BRA REPLA5 REPEAT
REPLA6 LDX XSAVE RESTORE THE POINTER

* INSERT A LINE INTO PROGRAM STORAGE

INSERT LDAA CRFLAG LONE C.R. ?
 BNE INSER6
 LDX ENDSTR
 LDAB CHRCNT GET CHAR. COUNT
 ADDB #2 BIAS FOR LINE NUM. 
 STAB OFFSET+1 SETUP OFFSET
 BSR ADJEND FIX END PNTR
INSER2 CPX XSAVE DONE?
 BEQ INSER3
 DEX DEC THE POINTER
 LDAA 0,X GET A CHAR,
OFFSET STAA 0,X
 BRA INSER2 MOVE IT
INSER3 DEX
 JSR PUTLB2 PUT LAB
 INX BUMP THE POINTER 
 INX
INSER4 STX XSAVE SAVE POINTER
 LDX BUFPNT
 LDAA 0,X GET CHAR*
 INX BUMP THE POINTER
 STX BUFPNT SAVE
 LDX XSAVE RESTOR PNTR
 INX
 STAA 0,X SAVE IT
 CMPA #$D IS IT A C.R.? 
 BNE INSER4
INSER6 JMP FILBUF 60 TO MAIN LOOP

* ADJUST THE END OF PROGRAM POINTER

ADJEND ADDB ENDSTR+1
 ADCA ENDSTR ADD IN VALUE 
 STAB CPX2+1
 STAA CPX2 SET END POINTER 
 JSR CMPX1
 BCC ADJEN2 
 STAB ENDSTR+1
 STAA ENDSTR SAVE NEW POINTER
 RTS RETURN
ADJEN2 LDAA #$90 SET ERROR
 JMP MISTAK

* TRY TO FIND LINE 

FNDLIN LDAA NUMBER+2 
 LDAB NUMBER+1
FINDLN LDX #STORSP SETUP POINTER
FINDL1 CPX ENDSTR END OF STORAGE?
 BNE FINDL4
FINDL2 INCB
 RTS RETURN
FINDL4 CMPB 0,X CHECK M.S. DIGITS
 BHI FINDL6
 BNE FINDL2
 CMPA 1,X CHECK L.S, DIGITS 
 BHI FINDL6
 BNE FINDL2
 CLRB CEAR FLAG
 RTS RETURN
FINDL6 BSR FNDCRT GO FIND C.R,
 INX BUMP THE POINTER
 BRA FINDL1 REPEAT

* FIND A C,R, IN STORAGE

FNDCRT PSHA SAVE A 
 LDAA #$D
FNDVAL INX BUMP THE POINTER
 CMPA 0,X TEST FOR C.R. 
 BNE FNDVAL
 PULA RESTORE A
 RTS RETURN

* INPUT 

INCHAR JSR INCH GET THE CHAR.
 CMPA #BACKSP IS IT A BACKSPACE? 
 BNE INCHR2
 CPX #BUFFER BEGINNING OF BUF ? 
 BEQ INCHR4
 DEX BACKUP ONE POS.
 DEC CHRCNT DEC CHAR. COUNT 
 BRA INCHAR
INCHR2 CMPA #DELCOD DELETE LINE ?
 BEQ INCHR4
 INC CHRCNT
INCHR4 RTS RETURN

* PRINT CARRIAGE RETURN & LINEFEED

PCRLF STX XSAVE SAVE X REG
 LDX #CRLFST POINT TO STRING
PDATA1 LDAA 0,X GET CHAR
 CMPA #4 IS IT 4?
 BEQ PCRLF2
 JSR OUTCH OUTPUT CHAR
 INX BUMP THE POINTER
 BRA PDATA1 REPEAT
PCRLF2 LDX XSAVE RESTORE X REG
 CLR FLDCNT ZERO FIELD COUNT
 RTS RETURN

CRLFST FCB $D,$A,0,0,0,0,4 

* TEST FOR STATEMENT TERMINATOR

TSTTRM CMPA #$D C,R,?
 BEQ TSTTR2
 CMPA #': COLON?
TSTTR2 RTS RETURN

* CLEAR NUMBER THROUGH NUMBER+2

UPSCLR JSR STAKUP
CLRNUM CLRA
 STAA NUMBER 
 STAA NUMBER+1 
 STAA NUMBER+2 
 RTS

* CONVERT NUMBER TO PACKED BCD

BCDCON BSR CLRNUM CLEAR NUMBER 
 STAA NOEXFL 
 STAA NEGFLG 
 STAA NUMCNT
 JSR SKIPSP SKIP SPACES
 CMPA #'+ IS IT A +? 
 BEQ BCDC01
 CMPA #'- IS IT A - ? 
 BNE BCDCO1
 COM NEGFLG SET FLAG
BCDC01 INX
BCDCO1 JSR CLASS GETA DIGIT
 CMPB #3 IS IT A NUMBER? 
 BEQ BCDCO2
 LDAA NEGFLG
 JMP FIXSIN GO FIX UP THE SIGN
BCDCO2 INX BUMP THE POINTER
 STAA NOEXFL SET NO EXEC FLU
 ANDA #$0F MASK OFF ASCII
 LDAB #4 SET COUNTER
BCDCO4 ASL NUMBER+2
 ROL NUMBER+1
 ROL NUMBER SHIFT PREV. OVER
 DECB DEC THE COUNTER 
 BNE BCDCO4
 ADDA NUMBER+2
 STAA NUMBER+2 SAVE NEW VALUE 
 INC NUMCNT INC NUMBER CNTR 
 BRA BCDCO1

* FIND NEXT BLOCK

NXTBLK LDX BUFPNT RESTORE POINTER
NXTBL4 LDAA 0,X GET A CHAR.
 CMPA #'  IS IT A SPACE?
 BEQ SKIPSP
 INX BUMP THE POINTER
 BRA NXTBL4 REPEAT

* CONVERT AND SKIP 

CONSKP BSR BCDCON 
 DEX

* SKIP ALL SPACES

SKPSP0 INX
SKIPSP LDAA 0,X GET CHR FROM BUF
 CMPA #$20 IS IT A SPACE?
 BEQ SKPSP0
SKIPS4 RTS RETURN

* FIND NEXT BLOCK NOT EXPECTING A SPACE

NXTSPC LDX BUFPNT SET POINTER
NXTSP4 JSR CLASS GO CLASSIFY
 CMPB #2 IS IT A LETTER? 
 BNE SKIPSP
 INX BUMP THE POINTER 
 BRA NXTSP4

* FIND KEY WORD IF POSSIBLE

FNDKEY JSR SKIPSP SKIP SPACES
 STX BUFPNT SAVE THE POINTER 
 STX XSAVE
 LDX #KEYTBL POINT TO KEY WORDS
FNDKE2 LDAB #5
FNDKE4 CMPA 0,X TEST THE CHARACTER
 BNE FNDKE6
 STX XTEMP3 SAVE POINTER 
 LDX XSAVE
 INX BUMP POINTER
 LDAA 0,X GET CHAR. 
 STX XSAVE
 LDX XTEMP3 REST. PNTR. 
 INX
 DECB
 CMPB #2
 BNE FNDKE4 IF NOT DONE REPEAT
FNDKE5 RTS RETURN
FNDKE6 INX BUMP THE COUNTER
 DECB
 BNE FNDKE6
 LDAA 0,X GET CHARACTER
 BEQ FNDKE5 IF ZERO, END OF LIST
 STX XTEMP3 SAVE POINTER 
 LDX BUFPNT
 STX XSAVE
 LDAA 0,X GET NEW CHAR.
 LDX XTEMP3 RESTORE POINTER
 BRA FNDKE2 REPEAT


* OUTPUT A NUMBER FROM PACKED BCD BYTES

OUTBCD LDX #NUMBER SET POINTER
OUTBCI LDAB #2 SET COUNTER
 CLC
 LDAA 0,X GET A WORD
 BPL OUTBC4 IF NOT NEG JMP AHEAD 
 LDAA #'-
 JSR OUTCH OUTPUT A
 INC FLDCNT
 BRA OUTBC4
OUTBC2 LDAA 0,X GET DIGITS
 BITA #$F0 MASK
 BCS OUTBC3
 BEQ OUTBC4 JMP IF ZEROES
OUTBC3 JSR OUTHL OUTPUT A DIGIT
 INC FLDCNT 
 SEC
OUTBC4 LDAA 0,X GET A DIGIT
 BITB #$FF LAST DIGIT? 
 BEQ OUTBC6
 BITA #$0F MASK
 BCS OUTBC6
 BEQ OUTBC8 JMP IF ZEROES
OUTBC6 JSR OUTHR OUTPUT A DIGIT
 INC FLDCNT 
 SEC
OUTBC8 INX BUMP THE POINTER
 DECB DEC THE COUNTER
 BPL OUTBC2 REPEAT IF NOT DONE
 RTS RETURN

* LIST USERS PROGRAM

LIST JSR NXTSPC FIND NEXT 
 CMPA #$D
 BEQ LIST3
 JSR BCDCON GET LINE NUM
 STX BUFPNT SAVE POINTER 
 JSR FNDLIN FIND LINE
 STX XSAVE SAVE IT
 JSR NXTSPC
 CMPA #$D C.R.?
 BNE LIST1 
 INC SUBCNT SET TO 1 
 BRA LIST2
LIST1 INX BUMP THE POINTER 
 JSR SKIPSP
 JSR BCDCON GET COUNT
 LDAA NUMBER+2
 STAA SUBCNT SAVE IT
LIST2 LDX XSAVE POINT TO LINE
 BRA LIST4
LIST3 LDX #STORSP SET POINTER
LIST4 CPX ENDSTR END OF STORAGE?
 BEQ LIST8
 JSR PCRLF OUTPUT A 
 LDAB #1 SETUP COUNTER 
 CLC
 BSR OUTBC2 OUT LINE NUMBER
LIST5 LDAA 0,X GET A CHARACTER
 CMPA #$D IS IT A C.R.? 
 BEQ LIST6
 BSR OUTCH OUTPUT CHARACTER 
 INX BUMP THE POINTER 
 BRA LIST5 REPEAT
LIST6 INX BUMP THE POINTER
 LDAA SUBCNT GET COUNT 
 BEQ LIST4
 ADDA #$99 DEC THE COUNT 
 DAA
 BEQ LIST8
 STAA SUBCNT SAVE
 BRA LIST4
LIST8 JMP FILBUF

OUTHL LSRA
 LSRA 
 LSRA
 LSRA MOVE TO BOTTOM
OUTHR ANDA #$0F MASK
 ADDA #$30 BIAS
OUTCH JSR BREAK CHECK FOR BREAK
 JMP OUTEEE GO PRINT

* INTERNAL BREAK ROUTINE

INTBRK PSHA
 LDAA PIAADR CHECK
 BPL BREAK2
 PULA GET CHAR
 RTS RETURN
BREAK2 LDAA PIAADR
 BPL BREAK2
 LDAA #$99 SET ERROR

* OUTPUT ERROR MESSAGE

MISTAK PSHA SAVE A
 JSR PCRLF OUTPUT A CR & LF
MISTA1 LDX #ERRSTR POINT TO ERROR STRING
 JSR PDATA1 OUTPUT IT
 PULA RESTORE A
 PSHA SAVE A
 JSR OUTHL OUTPUT DIGIT
MISTA2 PULA RESTORE A
 JSR OUTHR OUT 1'S DIGIT
 LDAB RUNFLG RUNNING?
 BNE RUNER1
MISTA4 JMP FILBUF
RUNER1 LDX #ERSTR2 POINT TO STRING
 JSR PDATA1 OUTPUT IT
 LDX BUFPNT SET POINTER
RUNER2 DEX DEC THE POINTER
 CPX #STORSP BEGINNING? 
 BEQ RUNER4
 LDAA 0,X GET CHAR
 CMPA #$D C.R.?
 BNE RUNER2
 INX BUMP THE POINTER
RUNER4 LDAB #1 
 CLC
 JSR OUTBC2 OUT LINE NUM. 
 BRA MISTA4
ERRSTR FCB 7
 FCC 'ERROR #'
 FCB 4

ERSTR2 FCC ' AT '
 FCB 4

* PRINT ROUTINE

PRINT JSR NXTSPC FIND NEXT BLOCK
PRINT0 JSR TSTTRM 
 BNE FIELD1 
 JMP PRINT8
FIELD1 CLR CRFLAG
 CMPA #', IS IT A "," 
 BNE PRINT2
 LDAB FLDCNT GET COUNT
FIELD2 LDAA #'  SPACE
 JSR OUTCH OUTPUT A SPACE 
 INCB
 BITB #7 END OF FIELD? 
 BNE FIELD2
 CMPB #$47 END OF LINE? 
 BHI FIELD3
 STAB FLDCNT SAVE FIELD INFO 
 BRA PRINT1
FIELD3 JSR PCRLF OUTA C.R. & L.F.
PRINT1 INC CRFLAG SET FLAG
 INX BUMP THE POINTER 
 JSR SKIPSP
 BRA PRINT0
PRINT2 CMPA #'; IS IT A ";"
 BEQ PRINT1
 CMPA #'" IS IT A QUOTE? 
 BNE PRINT4
 INX BUMP THE POINTER
 BSR PSTRNG OUTPUT STRING 
 BRA PRINT6
PRINT4 CLR TABFLG CLEAR FLAG
 CMPA #'T IS IT A T?
 BNE PRIN45
 STAA TABFLG SET FLAG 
 LDAA #'A
 BRA PRIN47
PRIN45 CMPA #'S IS IT A S?
 BNE PRIN55 
 LDAA #'P
PRIN47 CMPA 1,X
 BNE PRIN55
 JSR NXTSP4 FIND NEXT
 JSR EXPR EVALUATE
 JSR BINCON CONVERT 
 LDAB NUMBER+2
 BEQ PRINT6
 LDAA TABFLG CHECK FLAG
 BEQ PRINT5 
 DECB
 CMPB FLDCNT CHECK COUNT
 BLS PRINT6
 BRA PRIN51
PRINT5 ADDB FLDCNT
PRIN51 LDAA #'  SPACE
 JSR OUTCH OUTPUT SPACE
 INC FLDCNT BUMP COUNTER 
 CMPB FLDCNT
 BNE PRIN51 REPEAT
PRIN52 BRA PRINT6
PRIN55 JSR EXPR EVAL EXPRESSION
 STX XSAVE SAVE POINTER
 JSR OUTBCD OUTPUT VALUE
 LDX XSAVE RESTORE
PRINT6 JSR SKYCLS
 DECB
 BNE PRINT7 CHECK FOR ERROR
 JMP PRINT0
PRINT7 LDAA #$31 
 JMP MISTAK
PRINT8 TST CRFLAG C.R. ?
 BNE PRINT9
 JSR PCRLF OUTPUT C.R. L.F 
PRINT9 JMP RUNEXC

* PRINT STRING ROUTINE

PSTRNG LDAA 0,X GET A CHAR.
 CMPA #'" IS I T A QUOTE? 
 BEQ PSTRN4
 JSR TSTTRM IS IT A C.R.? 
 BEQ PSTRN8
 JSR OUTCH OUTPUT CHARACTER
 INC FLDCNT BUMP FIELD CNT
 INX BUMP THE POINTER
 BRA PSTRNG REPEAT
PSTRN4 INX
 JMP SKIPSP
PSTRN8 LDAA #$32
 JMP MISTAK REPORT ERROR

* FIND LABLE ROUTINE

FNDVAR STX BUFPNT SAVE POINTER
 JSR CLASS1 GO CLASSIFY CHAR.
 CMPB #2 CHECK FOR LETTER
 BNE FNDL25 ERROR 
 CLR XTEMP
 TAB SAVE LABLE
 ASLA MULT IT BY 2
 ABA ADD IT 
 SUBA #$13
 STAA XTEMP+1
 LDX XTEMP POINT TO IT
 RTS RETURN

* FIND DIMENSIONED VARIABLE

FNDLB0 LDAA 0,X
FNDLBL INX ADVANCE POINTER
 CLR DIMFLG
 BSR FNDVAR GO FIND VAR. 
 CLRB
 LDAA 0,X GET CHAR.
 CMPA #$0A CHECK FOR 1 DIM 
 BEQ FNDLB2
 CMPA #$0B CHECK IF 2 DIM 
 BEQ FNDLB1
 RTS
FNDLB1 INCB SET FLAG-2 DIM
FNDLB2 LDAA 1,X SET POINTER 
 PSHA
 LDAA 2,X
 PSHA
 PSHB SAVE B
 JSR NXTSPC FIND NEXT 
 PULB
 CMPA #'( IS IT A PAREN?
FNDL25 BNE FNDLB9
 TSTB
 BEQ FNDLB3 
 INX
 JSR EXPRO GO EVALUATE 
 LDAA NUMBER+2 GET RESULT
 PSHA SAVE IT
 JSR STAKDN RESTORE
 JSR NXTSPC FIND NEXT
 CMPA #', IS IT A COMMA? 
 BNE FNDLB9
 BRA FNDLB4
FNDLB3 CLRA
 PSHA SET ROWV
FNDLB4 INCA
 STAA DIMFLG SET FLAG 
 INX
 JSR EXPRO
 INX
 STX BUFPNT SAVE POINTER 
 PULA
 STAA ROWVAR SAVE 
 PULA
 STAA XTEMP+1 SAVE 
 PULA
 STAA XTEMP SAVE
 LDX XTEMP SET POINTER
 LDAA 0,X GET CHAR
 STAA COLCON SAVE IT
 INX BUMP THE POINTER 
 INX
 STX XTEMP
 JSR UPSCLR
 LDAA ROWVAR GET VAR.
 LDX XTEMP
 DEX DEC POINTER
 CMPA 0,X CHECK
 BHI FNDLB9 
 STAA NUMBER+2
 JSR UPSCLR PUSH STACK
 LDAA COLCON GET CONST,
 CMPA AC-1 CHECK
 BEQ FNDL45
 BLS FNDLB9 ERROR!
FNDL45 ADDA #1
 DAA BIAS IT 
 STAA NUMBER+2
 JSR MULT GO MULTIPLY
 JSR ADD GO ADD
FNDLB5 JSR TIMTHR

* ROUTINE TO ADD VALUE TO X-REG.

ADDX LDAA XTEMP GET M.S.BYTE 
 LDAB XTEMP+1 
 ADDB NUMBER+2 
 ADCA NUMBER+1
 STAA XTEMP SAVE SUM 
 STAB XTEMP+1
 JSR STAKDN
 LDX XTEMP SET POINTER
 CLR DIMFLG RESTORE FLAG
 RTS RETURN

FNDLB9 LDAA #$14 SET ERROR
 JMP MISTAK GO REPORT

* ROUTINE TO MULTIPLY BY 3

TIMTHR JSR UPSCLR
 LDAA #$3 SET MULTIPLIER 
 STAA NUMBER+2
 JSR MULT GO MULTIPLY

* BCD TO BINARY CONVERT.

BINCON LDAA NUMBER+2 GET LS BYTE
 PSHA SAVE 
 LDAA NUMBER+1
 PSHA SAVE: 
 CLRB
 STAB NUMBER+1
 STAB NUMBER+2 INITIALIZE 
 LDAA NUMBER
 BSR ADSHF1 ADD AND SHIFT 
 PULA
 PSHA
 BSR ADSHF0 GO ADD IN AND SHIFT
 PULA GET MS BYTE AGAIN
 BSR ADSHF1 GO ADD IN AND SHIFT
 PULA GET LS BYTE 
 PSHA
 BSR ADSHF0 
 PULA
 BRA ADDIN G0 ADD IN ONES
ADSHF0 LSRA
 LSRA 
 LSRA
 LSRA MOVE TO LS HALF
ADSHF1 BSR ADDIN GO ADD IN
 LDAB NUMBER+1
 ASLA
 ROLB MULT BY 2 
 PSHB
 PSHA SAVE 
 ASLA
 ROLB 
 ASLA
 ROLB MULT BY 4, =*8 
 STAA NUMBER+2
 PULA
 STAB NUMBER+1
 BSR ADDIN1 GO ADD IN 
 PULA
 ADDA NUMBER+1
 STAA NUMBER+1 MULTIPLY BY TEN 
 RTS
ADDIN ANDA #$0F MASK
ADDIN1 ADDA NUMBER+2
 STAA NUMBER+2
 BCC ADDIN2 CHECK FOR CARRY 
 INC NUMBER+1
ADDIN2 RTS

* PUT LABLE ROUTINE

PUTLBL LDAA NUMBER
 STAA 0,X PUT M.S. BYTE
PUTLB2 LDAA NUMBER+1
 STAA 1,X PUT NEXT 
 LDAA NUMBER+2
 STAA 2,X PUT L.S. BYTE
 RTS RETURN

* DIMENSION

DIM LDX FORSTK SET BOUNDS 
 STX CPX1
 JSR NXTSPC
DIMN JSR SKIPSP CLASSIFY
 JSR FNDVAR
 STX XTEMP3 SAVE IT
 JSR NXTSPC GET TO NEXT
 CMPA #'( IS IT A PARENT 
 BNE DIM9
DIM01 INX BUMP THE POINTER
 JSR CONSKP CONVERT DIM
 CMPA #') IS IT A PAREN 
 BNE DIM1
 CLRA
 CLRB
 PSHA SAVE IT 
 BRA DIM2
DIM1 CMPA #', COMMA?
 BNE DIM9 ERROR!
 LDAA NUMBER+2
 BEQ DIM9
 PSHA SAVE
 INX BUMP THE POINTER
 JSR CONSKP CONVERT 
 LDAB #1
 CMPA #') PAREN? 
 BEQ DIM2
DIM9 LDAA #$40 SET ERROR
 JMP MISTAK REPORT
DIM2 LDAA NUMBER+2
 BEQ DIM9
 PSHA SAVE
 STX BUFPNT SAVE POINTER
 LDX XTEMP3 SET X 
 LDAA #$0A
 ABA SET MARKER
 STAA 0,X SAVE IT
 LDAA DIMPNT GET POINTER
 STAA 1,X SAVE IT 
 LDAA DIMPNT+1 
 STAA 2,X
 LDX DIMPNT SET POINTER 
 PULA
 STAA 0,X SAVE 1ST DIM
 INX BUMP THE POINTER 
 PULB
 STAB 0,X SAVE 2ND DIM 
 INX
 STX XTEMP SAVE POINTER 
 ADDA #1
 DAA BIAS 
 PSHA
 TBA
 ADDA #1 BIAS
 DAA ADJUST
 TAB SAVE
 JSR CLRNUM CLEAR STORAGE 
 STAB NUMBER+2
 JSR UPSCLR GO CLEAR 
 PULA
 STAA NUMBER+2
 JSR MULT MULTIPLY
 JSR FNDLB5 GO FIX X
 JSR CMPX TEST BOUNDS 
 BLS DIM5
 JMP ADJEN2
DIM5 STX DIMPNT SAVE RESULT
 LDX BUFPNT RESTORE F'NTR 
 INX
 JSR SKIPSP SKIP SPACES 
 JSR TSTTRM
 BEQ RUNEXC
 INX BUMP THE POINTER
 JMP DIMN

* EXTERNAL ROUTINE JUMP

EXTRNL JSR EXTERN GO TO IT 

* RUN EXECUTIVE

RUNEXC CLRA
 STAA CRFLAG 
 STAA LETFLG 
 STAA DIMFLG 
 STAA STKCNT
 LDAA RUNFLG RUN MODE?
 BNE RUNEX0
RUNEXA JMP FILBUF
RUNEX0 LDX BUFPNT SET POINTER
RUNE05 LDAA #$D
 LDAB #': SETUP TERMINATORS
RUNEX1 CMPA 0,X C.R. ?
 BEQ RUNEX2
 CMPB 0,X IS IT A ':' ? 
 BEQ RUNE27
 INX BUMP THE POINTER
 BRA RUNEX1 REPEAT
RUNEX2 INX
RUNE22 CPX ENDSTR END OF STORAGE?
 BEQ RUNEXA
RUNE25 INX BUMP THE POINTER
RUNE27 INX
 JSR BREAK GO CHECK BREAK
RUNEX3 JSR FNDKEY FIND KEY WORD 
 TSTA
 BNE RUNEX4
 LDX BUFPNT SET POINTER 
 BSR TSTLET
 BEQ RUNEX4 
 LDAA #$10
RUNE35 JMP MISTAK
RUNEX4 LDX 0,X
 JMP 0,X GO TO ROUTINE

* TEST FOR IMPLIED LET

TSTLET JSR CLASS CHECK CHAR.
 CMPB #2 LETTER?
 BNE TSTLE2
 INX BUMP THE POINTER
 JSR SKIPSP SKIP SPACES
 CMPA #'= EQUALS?
 BEQ TSTLE1
 CMPA #'( LEFT PARENT 
 BNE TSTLE2
TSTLE1 LDX #LETADR SET POINTER
 STAA LETFLG SET FLAG 
 CLRB
TSTLE2 RTS

* RUN ROUTINE

RUN JSR CLRBEG 
 JSR CLREND 
 LDX MEMEND
 STX FORSTK
 LDX #STORSP SET POINTER 
 INC RUNFLG
 BRA RUNE22

* LET ROUTINE

LET LDX BUFPNT
 LDAA LETFLG TEST FLAG 
 BNE LET2
 JSR NXTBLK FIND NEXT
LET2 JSR EXPEQU
 JMP RUNEXC

* GOTO ROUTINE

GOTO JSR NXTSPC FIND BLOCK
GOTO1 JSR EXPR GO EVALUATE
GOTO2 JSR FNDLIN GO FIND LINE
GOTO3 TSTB FIND?
 BEQ GOTO5
 LDAA #$16 SET ERROR
GOTO4 JMP MISTAK REPORT 
GOTO5 INCB
 STAB RUNFLG SET RUN FLAG 
 JMP RUNE22

* INPUT ROUTINE

INPUT JSR NXTSPC FIND NEXT
INPUT0 CLR QMFLAG CLEAR FLAG
INPUT1 JSR SKIPSP SKIP SPACES
 CMPA #'" IS IT A QUOTE?
 BNE INPUT2
 INX BUMP THE POINTER
 JSR PSTRNG OUTPUT STRING 
 BRA INPUT6
INPUT2 JSR FNDLBL FIND LABLE
 STX XTEMP4 SAVE POINTER
INPUT3 LDX #BUFFER SET POINTER
 LDAA QMFLAG TEST FLAG
 BNE INPUT4 
 LDAA #'?
 STAA QMFLAG SET FLAG
 JSR OUTCH OUTA ?
INPUT4 JSR INCH GETA DIGIT
 CMPA #DELCOD DELETE?
 BNE INPU45
 CLR QMFLAG
 BRA INPUT3
INPU45 STAA 0,X SAVE IT
 INX
 CMPA #', 1S IT COMMA? 
 BEQ INPUT5
 CMPA #$D IS IT A C.R.?
 BNE INPUT4 
 STAA CRFLAG SET FLAG
 JSR PCRLF OUTPUT A CR & LF
INPUT5 LDX #BUFFER SET POINTER
 JSR BCDCON GO CNVRT NUM. 
 LDX XTEMP4
 BSR LABLS2
 STX BUFPNT SAVE POINTER
INPUT6 CMPA #', IS IT A COMMA?
 BNE INPUT7 
 INX
 LDAA CRFLAG TEST FLAG
 BEQ INPUT1
 BRA INPUT0
INPUT7 JSR TSTTRM
 BNE INPUT9
INPU72 LDAA CRFLAG TEST FLAG
 BEQ INPUT8
INPU75 JMP RUNEXC
INPUT8 JSR INCH GET CHAR.
 CMPA #$D C.R.?
 BNE INPUT8
 JSR PCRLF
 BRA INPU75
INPUT9 LDAA #$45
 JMP MISTAK REPORT ERROR


* GET AND PUT LABLE

LABLES JSR FNDLBL GO FIND IT
LABLS2 JSR PUTLBL GO PUT IT
 JMP NXTSPC GET TO NEXT SET


* DATA ROUTINE

DATA LDAA RUNFLG RUNNING?
 BEQ READ6
 JSR NXTSPC FIND NEXT
 STAA DATAFL SET DATA FLAG
 STX DATAST SET POINTER 
 STX DATAPT
 BRA READ6 RETURN


* READ DATA ROUTINE

READ LDAA RUNFLG RUNNING?
 BEQ READ6
 LDAA DATAFL CHECK FLAG 
 BEQ READ8
 JSR NXTBLK GET NEXT
READ2 JSR SKIPSP GO CLASSIFY
 JSR FNDLBL
 STX XTEMP4
 LDX BUFPNT
 STX XTEMP5 SAVE IT
 LDX DATAPT GET DATA PNTR
 JSR EXPR GET DATA
 LDAA 0,X GET CHAR.
 JSR TSTTRM TEST IT
 BNE READ25
 LDX DATAST SET POINTER 
 BRA READ3
READ25 INX BUMP THE POINTER
READ3 STX DATAPT
 LDX XTEMP5
 STX BUFPNT
 LDX XTEMP4
 BSR LABLS2
 CMPA #', IS IT A COMMA? 
 BNE READ4
 INX
 BRA READ2 REPEAT
READ4 JSR TSTTRM
 BNE READ8 ERROR
READ6 JMP RUNEXC RETURN
READ8 LDAA #$51
 JMP MISTAK

* RESTORE DATA STRING

RESTOR STX XSAVE SAVE POINTER
 LDX DATAST
 STX DATAPT FIX DATA PNTR
 LDX XSAVE RESTORE POINTER 
 BRA READ6

* ON GOTO ROUTINE
ONGOTO JSR NXTBLK FIND NEXT BLOCK
 JSR EXPR EVAL. EXPR.
 LDAA NUMBER+2
 ANDA #$0F MASK L.S. DIGIT
 PSHA SAVE A
 CLR CRFLAG
 INX BUMP THE POINTER 
 INX
 LDAA 0,X GET CHAR
 CMPA #'T IS IT A "T"? 
 BEQ ONGOT0
 STAA CRFLAG SET FLAG
ONGOT0 JSR NXTBL4 GET NEXT
 STX XSAVE SAVE X
 PULA RESTORE A
ONGOT1 DECA
 BEQ ONGOT4
ONGOT2 LDAB 0,X GET A CHAR,
 INX BUMP THE POINTER
 CMPB #', IS IT A COMMA? 
 BNE ONGOT3
 STX XSAVE SAVE THE POINTER
 BRA ONGOT1 REPEAT
ONGOT3 CMPB #$D C^R^ ?
 BNE ONGOT2
 LDX XSAVE RESTORE POINTER
ONGOT4 LDAB CRFLAG CHECK FLAG
 BEQ ONGOT6
 JMP GOSUB2
ONGOT6 JMP GOTO1

* ROUTINE

IF JSR NXTSPC FIND NEXT
 JSR EXPR EUAL EXPR
 LDAA 0,X GET CHAR
 BSR CLSREL REL OPERATOR?
 BNE IF9 ERROR!
 PSHA SAVE A
 LDAA 1,X GET CHAR
 BSR CLSREL REL OP?
 PULA RESTORE A 
 BNE IF1
 LDAB 1,X
 ABA FORM REL CODE
 INX BUMP THE POINTER
IF1 INX
 PSHA SAVE A
 JSR EXPR EVAL EXPR 
 PULA
 ANDA #$0F MASK
 SUBA #9 BIAS IT
 BMI IF9 ERROR?
 ASLA TIMES FOUR 
 ASLA
 STAA OFSET3+1
 JSR SUB GO COMPARE
 JSR ZCHK SET CC REG
OFSET3 BRA *
BRATBL BLE IF4 BRANCH TABLE 
 BRA IF8
 BNE IF4
 BRA IF8
 BGE IF4
 BRA IF8
 BLT IF4
 BRA IF8
 BEQ IF4
 BRA IF8
 BGT IF4
 BRA IF8
 BRA IF9 ERROR!
IF4 LDX BUFPNT SET POINTER
 LDAA 0,X GET CHAR
 CMPA #'T IS IT A "T"? 
 BNE IF6
 JSR NXTSPC
 STX BUFPNT SAVE POINTER
 JSR CLASS1 GO CLASSIFY
 CMPB #3 IS IT A NUMBER? 
 BNE IF6
 JMP GOTO1 GO TO GOTO
IF6 JMP RUNEX3
IF8 JMP RUNEXC GO PROCESS CMND
IF9 LDAA #$62 SET ERROR
 JMP MISTAK

* CLASSIFY RELATIONAL OPERATION

CLSREL CMPA #$3B
 BLS CLSRE5
 CMPA #$3E CHECK CHAR 
 BHI CLSRE5
 CLRB CLEAR FLAG
 RTS RETURN
CLSRE5 INCB SET FLAG
 RTS RETURN

* GOSUB ROUTINE

GOSUB LDAB RUNFLG
 BEQ IF8
 JSR NXTSPC FIND NEXT
GOSUB2 INC SUBCNT
 JSR EXPR EVALUATE EXPR 
 DEX
 JSR FNDCRT FIND C.R.
 INX BUMP THE POINTER
 LDAA 0,X GET LINE NO 
 PSHA
 LDAA 1,X
 PSHA SAVE AS RET. ADD. 
 STS CPX1 SAVE SP
 LDX #STKBOT+35
 JSR CMPX CHECK BOUNDS 
 BLS GOSUB4
 JMP ADJEN2 RPT OVFL
GOSUB4 JMP GOTO2

* RETURN ROUTINE

RETURN LDAA #$73
 DEC SUBCNT DEC COUNTER 
 BPL RETUR2
 JMP MISTAK ERROR!
RETUR2 PULA GET RET. ADD. 
 PULB
 JSR FINDLN GO FIND LINE
 JMP GOTO3

* EXPRESSION EQUATE

EXPEQU JSR FNDLB0 FIND LABLE
 STX XTEMP4 SAVE
 JSR NXTSPC 
 INX
 JSR EXPR GO EVALUATE 
 LDX XTEMP4 GET POINTER 
 JMP PUTLBL INSTALL 

* FOR ROUTINE

FOR JSR NXTBLK FIND NEXT
 PSHA
 BSR EXPEQU
 LDX DIMPNT 
 STX CPX1
 LDX FORSTK 
 PULA
 STAA 0,X
 LDAA BUFPNT+1 
 DEX DEC THE POINTER 
 STAA 0,X
 LDAA BUFPNT SET UP INDEX 
 DEX
 STAA 0,X 
 DEX
 JSR CMPX CHECK FOR OVFLW 
 BHI FOR5
 JMP ADJEN2
FOR5 STX FORSTK SAVE POINTER
 JMP RUNEXC

* NEXT ROUTINE

NEXT JSR NXTBLK FIND NEXT
 STX NXPNTR
 LDX FORSTK SET POINTER
NEXT1 CPX MEMEND OVFLW?
 BNE NEXT2
 LDX BUFPNT RESTORE PNTR
 BRA NEXT9 ERROR!
NEXT2 INX FIXUP POINTER
 INX 
 INX
 CMPA 0,X CHECK
 BNE NEXT1
 DEX FIX POINTER 
 DEX
 DEX
 STX FORSTK 
 INX
 LDX 0,X
 STX BUFPNT SAVE IT
 JSR FNDLBL FIND LABLE
 STX XTEMP4 SAVE IT
 JSR NXTSPC FIND NEXT
 JSR EXPR EVALUATE
 JSR STAKUP
 LDX XTEMP4 RESTORE PNTR
 JSR GETVAL GET LABLE VALUE 
 LDX BUFPNT
 LDAA 0,X GET CHAR
 CMPA #'S IS IT STEP? 
 BEQ NEXT4
 JSR UPSCLR 
 INCA
 STAA NUMBER+2 
 BRA NEXT5
NEXT4 JSR NXTSP4
 JSR EXPR 
 LDAA NUMBER
 STAA LETFLG SHOW NEG. 
NEXT5 JSR ADD GO ADD IN STEP
 LDX #TRYVAL SET POINTER
 JSR PUTLBL SAVE LABLE
 JSR SUB COMPARE
 JSR ZCHK SET CC REG
 LDAB LETFLG CHK FLAG 
 BMI NEXT6
 TAP SET CC
 BGE NEXT8
 BRA NEXT7
NEXT6 TAP SET CC
 BLE NEXT8
NEXT7 LDX FORSTK
 INX FIXUP PNTR 
 INX
 INX
 STX FORSTK SAVE IT
 LDX NXPNTR
 STX BUFPNT SAVE
 BRA NEXT85
NEXT8 LDX #TRYVAL 
 JSR GETVAL 
 LDX XTEMP4 
 JSR PUTLBL 
NEXT85 JMP RUNEXC
NEXT9 LDAA #$81 SET ERROR
NEXTIO JMP MISTAK

* EXPRESSION HANDLER

EXPR CLR STKCNT SET COUNT = 0
EXPRO LDAA STKCNT
 STAA AUXCNT
 BSR EVAL
 TSTA CHECK FOR ERROR
 BNE NEXTIO
EXPR1 RTS RETURN 
*
**EVAL 
* EVALUATE AN ALGEBRAIC STRING 
*
EVAL STS STKTOP SAVE SP TOP
EVA0A JSR SKYCLS
 STX BUFPNT
 CMPB #1 SEE IF EMPTY EXPRESSION 
 BNE EVAL0
 LDAA #$21 
 BRA EVAL3
EVAL0 LSRB SET UP
 CMPB #3 CHECK FOR UNARY + OR -
 BNE EVAL1
 JSR UPSCLR
EVAL1 LDX BUFPNT
EVAL1A JSR SKYCLS GET NEXT CHAR
 STX BUFPNT
 CMPB #4 CHECK FOR OPERATORS 
 BLS EVAL1Z
 LDAB #5 SET UP
EVAL1Z ASLB
 STAB OFFREL+1 SET UP BRANCH
OFFREL BRA *
 BRA EVAL2 ERROR
 BRA EVAL4 TERMINATOR
 BRA EVAL8 LETTER
 BRA EVAL7 NUMBER
 BRA EVAL1C RIGHT PAREN
 PSHA SAVE 
 INX
 BRA EVA0A AGAIN
EVAL1C TSX GET SP
 DEX ADJUST 
 LDAB DIMFLG
 CPX STKTOP CHECK FOR EMPTY 
 BEQ EVAL1E
 PULA
 CLRB
 CMPA #'( CHECK FOR L PAREN ON STACK
 BEQ EVA11C IF SO, OK
EVAL1E TSTB CHECK FOR ALRIGHT
 BEQ EVAL2 IF NOT SET, ERROR
EVAL4 CLRA
 LDAB STKCNT GET STACK STKCNT
 DECB CHECK OP STACK 
 CMPB AUXCNT
 BNE EVAL2 IF NOT EMPTY, ERROR 
 TSX
 DEX ALIGN
 CPX STKTOP CHECK OPERATOR STACK
 BEQ EVAL3A IF NOT EMPTY° ERROR
EVAL2 LDAA #$20 SET ERROR NUMBER
EVAL3 LDS STKTOP GET SP
EVAL3A LDX BUFPNT SET POINTER 
 RTS
EVAL7 JSR STAKUP SHIFT OP STACK UP
 LDX BUFPNT
 JSR BCDCON GET OPERAND 
 BRA EVAL12
EVAL8 LDAA 1,X GET NEXT CHAR
 JSR CLASS1 GO CLASSIFY
 CMPB #2 CHECK FOR LETTER
 BNE EVAL9 IF NOT, VARIABLE
 LDAA 0,X GET CHAR BACK
 STX XSAVE SET FOR ENTRY TO FIMDKEY 
 LDX #FCTTBL
 JSR FNDKE2 GO CHECK FUNCTION
 TSTA CHECK SUCCESS 
 BEQ EVAL4
 JMP RUNEX4 GO SERVICE
EVAL86 LDAA #'? GET STGNUM OPERATOR
EVAL87 PSHA PUT ON STACK
 LDX XSAVE
 JMP EVA0A
EVAL85 LDAA #'@ GET ABS OPERATOR
 BRA EVAL87
EVAL88 JSR UPSCLR MOVE STACK UP
 JSR RANDOM COMPUTE RANDOM # 
 STAA NUMBER+2
EVAL89 LDX XSAVE RESTORE POINTER
 BRA EVAL12
EVAL9 LDAB STKTOP
 PSHB
 LDAB STKTOP+1 
 PSHB
 LDAB AUXCNT GET COUNTER
 PSHB SAVE
 LDAB DIMFLG GET FLAG
 PSHB SAVE
 JSR FNDLB0 FIND VARIABLE STORAGE
 PULB GET FLAG
 STAB DIMFLG RESTORE
 PULB GET COUNTER
 STAB AUXCNT RESTORE 
 PULB
 STAB STKTOP+1 
 PULB
 STAB STKTOP
 JSR STAKUP
 LDX XTEMP
 JSR GETVAL MOVE VALUE TO NUMBER 
 BRA EVA12A
EVA11C LDX BUFPNT RESTORE POINTER 
 INX
EVAL12 STX BUFPNT SAVE POINTER 
EVA12A TSX
 DEX
 CPX STKTOP CHECK OPERATOR STACK
 BEQ EVAL10 IF EMPTY, DON'T OPERATE 
 PULA
 PSHA PUT BACK
 CMPA #'( CHECK FOR LEFT PAREM
 BEQ EVAL10 IF SO, DON'T OPERATE
 JSR CLASS1 GO CLASSYFY 
 PSHB
 LSRB SET UP ID 
 LDAA STKCNT GET COUNT 
 DECA
 CMPB #4 CHECK FOR ABS OR SON
 BEQ EVA12C IF SO, GO AHEAD
 CMPA AUXCNT OTHERWISE CHECK FOR 2 OPERANDS
 BEQ EVAL10 IF NOT, ABORT
EVA12C CMPA #9 CHECK OVERFLOW
 BLS EVA12D OK
 LDAA #$24 SET ERROR
 BRA EVAL19
EVA12D PULA GET CLASSIFICATION
 PULB GET OPERATOR
 SUBA #6 REMOVE BIAS
 ASLA #2
 STAA OPOFF+1 SET UP JMP
 LDX #OPTBL POINT
OPOFF LDX 0,X
 JSR 0,X GO OPERATE
 JSR ZCHK CHECK RESULT
 BVC EVA12A IF NO OVFL, GO OPERATE AGAIN
EVAL18 LDAA #$23 SET ERROR NUMBER
EVAL19 JMP EVAL3
EVAL10 JMP EVAL1
OPTBL FDB ADD
 FDB SUB
 FDB SIGNUM
 FDB ABSVAL 
 FDB MULT
 FDB DIVIDE
 FDB EXPON
*
** GET VALUE
* MOVE 3 BYTES POINTED TO BY X TO NUMBER
*
GETVAL LDAA 0,X GET VALUE
 STAA NUMBER STORE
 LDAA 1,X
 STAA NUMBER+1 
 LDAA 2,X
 STAA NUMBER+2 
 RTS
*
*
** STACKUP
* ROLL OPERATIONAL STACK UPWARD
*
STAKUP LDX #STKEND POINT TO END
STAKU2 LDAB 3,X
 STAB 0,X MOVE
 INX
 CPX #NUMBER SEE IF DONE
 BNE STAKU2 
 INC STKCNT 
 RTS
*
*
** STACKDOWN
* ROLL OPERATIONAL STACK DOWNWARD
*
STAKDN LDX #AX-1 POINT TO STORE
STAKD1 LDAB 0,X
 STAB 3,X 
 DEX
 CPX #STKEND-1 SEE IF DONE
 BNE STAKD1 
 DEC STKCNT 
 RTS
*
*
** UADD
* UNSIGNED ADD OF AX TO NUMBER 
*
UADD CLC ZERO THE CARRY 
UADD1 LDX #NUMBER+2 POINT TO STORE 
UADD2 LDAA 0,X GET ADDEND
 ADCA 3,X ADD IN AUGEND
 DAA
 STAA 0,X SAVE 
 DEX
 CPX #NUMBER-1 SEE IF DONE 
 BNE UADD2
UADD22 PSHB
 LDAB #$02 SET FOR OVFL
 BITA #$F0 AND AGAIN
 BNE UADD25
 CLRB RESET OFVL
UADD25 ORAB OVFLBF
 STAB OVFLBF SET OVFL IF NECESSARY
 TBA
 PULB
UADD3 RTS 
*
*
**USUB
* UNSIGNED SUBTRACT OF AX FROM NUMBER
*
USUB BSR TENCOM GO TEN'S COMPLEMENT
 SEC FIX UP
 BRA UADD1 GO ADD
* 
*
**TENCOM
* UNSIGNED TEN'S COMPLEMENT OF AX (ALMOST)
*
TENCOM LDX #AX+2 POINT TO AX
TENCO1 LDAA #$99
 SUBA 0,X SUBTRACT FROM 99
 STAA 0,X SAVE
 DEX
 CPX #AX-1
 BNE TENCO1
 ANDA #$0F RESET SIGN
 STAA 1,X STORE
 RTS
* 
*
** SET SIN
* CALCULATE RESULT SIGN 
*
SETSIN CLR OVFLBF CLEAR OVFL INDICATOR
SETSI0 LDAA AX GET SIGN
 TAB SAVE
 ANDB #$0F RESET SIGN
 STAB AX PUT BACK
 STAA AXSIGN SAVE SIGN
 EORA NUMBER FORM NEW SIGN
 STAA SIGN SAVE
ABSVAL LDAB NUMBER GET MS BYTE
 ANDB #$0F RESET SIGN
 STAB NUMBER PUT BACK
 TSTA TEST NEW SIGN
 RTS
* 
*
**
* SUBTRACT AX FROM NUMBER
*
SUB LDAA NUMBER GET MS BYTE
 EORA #$F0 CHANGE SIGN
 STAA NUMBER PUT BACK
* GO INTO ADD 
*
*
* ADD
* ADD AX TO NUMBER
*
ADD BSR RELAY
 BSR SETSIN GO CALCULATE SIGN
 BPL ADD0 USE EITHER SIGN
 BSR USUB OTHERWISE SUBTRACT
 TAP SET CCR
 BVC ADD1 CHECK OVERFLOW
 COM AXSIGN CHANGE FOR AX SMALLER
 BRA ADD15
ADD0 BSR UADD GO ADD
 BRA ADD2 GO FIX SIGN
ADD1 BSR RELAY COPY NUMBER TO AX
 JSR UPSCLR RESTORE
 BSR USUB GO NEGATE
ADD15 CLR OVFLBF
ADD2 LDAA AXSIGN GET OLD SIGN
* 
*
** FIXSIN
* SET THE SIGN ON THE RESULT 
*
FIXSIN ANDA #$F0 MASK
 LDAB #$0F SET MASK
 ANDB NUMBER RESET SIGN
 ABA TACK ON SIGN
 STAA NUMBER PUT BACK
FIX2 RTS
*
*
** MULT
* MULTIPLY AC BY AX 
*
MULT BSR RELAY MOVE STACK
 BSR SETSIN GO CALC. SIGNS
MULT0 JSR UPSCLR MOVE STACK UP
 LDAB #5 SET COUNTER
MULT1 LDAA AC GET MS BYTE OF AC
 BEQ MULT3 IF ZERO , LOOP
MULT2 JSR UADD ADD IN AX 
 DEC AC ONCE DONE 
 BNE MULT2
MULT3 DECB ONCE DONE
 BEQ MULT4 CHECK IF ALL DONE
 BSR ACLEFT SHIFT AC LEFT
 LDAA NUMBER
 JSR UADD22
 BRA MULT1
* 
* 
** DIVIDE 
* DIVIDE AC-NUMBER BY AX 
*
DIVIDE BSR RELAY
 LDX #AX
 JSR ZCHK1 GO CHECK IF AX=O
 BNE DIVID1 IF NOT, OK
DIVID0 LDAA #$22 SET ERROR
 JMP EVAL3
RELAY JMP STAKDN RELAY TO STACK DOWN
DIVID1 JSR SETSIN CALC, SIGNS
 JSR STAKUP PUSH BACK
 BSR ACLEFT SHIFT DOWN
 CLR 2,X
 CLR 3,X ZERO OUT NUMBER
 LDAB #5 SET LOOP COUNT
DIVID2 BSR ACLEFT MOVE AC DOWN
DIVI2A JSR TENCOM TAKE 10'S COMP
DIVID3 BSR DADD GO SPECIAL ADD
 BITA #$F0 CHECK FOR OVERFLOW
 BNE DIVID4
 JSR TENCOM IF SO, RESTORE AX
 CLC
 BSR DADD1 ADD BACK IN
 DECB ONE PASS MADE
 BNE DIVID2
MULT4 LDAA SIGN GET THE SIGN
 BSR FIXSIN GO FIX UP THE SIGN
 LDX #AC-1 POINT TO AC
 JMP STAKD1 MOVE STACK BACK
DIVID4 INC NUMBER+2 ADD ONE IN
 BRA DIVID3 GO DO AGAIN
* 
* 
** ACLEFT
* SHIFT AC-NUMBER LEFT 4 BITS
*
ACLEFT LDAA #4 SET FOR 4 BITS
ACLEF1 LDX #AX-1 POINT X 
 CLC
ACLEF2 ROL 0,X ROTATE
 DEX
 CPX #AC-1 CHECK IF DONE 
 BNE ACLEF2
 DECA CHECK FOR DONE 
 BNE ACLEF1
 RTS
*
*
** DADD
* ADD AX TO A C
*
DADD SEC
DADD1 LDX #AC+2
 LDAA AC GET MS BYTE
 ANDA #$0F RESET SIGN
 STAA AC STORE BACK
DADD2 LDAA 0,X GET ADDEND
 ADCA 6,X ADD IN
 DAA
 STAA 0,X SAVE 
 DEX
 CPX #AC-1 SEE IF DONE
 BNE DADD2
 RTS
*
** SIGNUM
* CALCULATE SIGNUM FUNCTION
*
SIGNUM BSR ZCHK GO CHECK = O
 BEQ SIGNU2 IF SOY RESULT =0
 LDAB NUMBER OTHERWISE GET SIGN
SIGNU1 BSR SIGNU2 GO CLEAR
 INC NUMBER+2 MAKE = I
 TBA SET FOR FIXSIN
 JMP FIXSIN GO SET THE SIGN
SIGNU2 JMP CLRNUM 
*
*
** EXPON
* CALCULATE EXPONENTIATION
* ONLY POSITIVE EXPONENTS UP TO 99 ALLOWED
*
EXPON BSR RELAY MOVE OPERANDS DOWN
 CLRB
 STAB OVFLBF CLEAR OVER FLOW
 LDAA AX+2 GET EXPONENT
 BEQ SIGNU1 IF O, GO MAKE RESULT +1
 JSR STAKUP GET TWO COPIES
 BSR RELAY MOVE DOWN
EXPON1 ADDA #$99 DECREMENT
 DAA
 BEQ CMPX2 WHEN 0 ALL DONE
 PSHA SAVE EXP
 JSR SETSI0 GO FIX SIGNS
 JSR MULT0 GO MULTIPLY
 PULA GET EXPONENT
 BRA EXPON1 LOOP
* 
*
** CMPX
* FULL COMPARE ON X
* COMPARES X WITH CONTENTS OF CPX1
*
CMPX STX CPX2 SAVE
CMPX1 LDAA CPX2 GET MS BYTE
 CMPA CPX1 COMPARE
 BNE CMPX2 IF NOT EQUAL, DONE
 LDAB CPX2+1 GET LS BYTE
 CMPB CPX1+1 COMPARE
CMPX2 RTS DOME
* 
* 
** ZCHK
* CHECK OPERAND FOR EQUAL TO 0 
*
ZCHK LDX #NUMBER
ZCHK1 CLRB
 TST 2,X
 BNE ZCHK2
 TST 1,X
 BNE ZCHK2
 LDAA 0,X GET MS BYTE 
 ANDA #$0F
 BNE ZCHK2 CHECK FOR 0
 STAA 0,X RESET SIGN BITS 
 LDAB #4
ZCHK2 LDAA 0,X GET MS BYTE
 RORA MOVE A SIGN BIT TO N
 ANDA #8 MASK N BIT
 ABA MERGE Z AND N
 ORAA OVFLBF ADD IN V
 TAP SET CCR 
 RTS
*
*
**
SKYCLS JSR SKIPSP
 BRA CLASS1
* 
* 
**CLASS
*CLASSIFY A CHARACTER IN THEA ACCUMULATOR
*CLASSIFICATION RETURNED IN B
*  0 ERROR
*  1 TERMINATOR
*  2 LETTER
*  3 NUMBER
*  4 )
*  5 (
*  6 +
*  7 -
*  8 SGN
*  9 ABS
* 10 *
* 11 /
* 12 ~
CLASS LDAA 0,X GET CHAR
CLASS1 LDAB #1 SET UP
 CMPA #$D CHECK FOR CR 
 BEQ CLAS25
 DECB
 PSHA SAVE CHAR
CLAS2B SUBA #'( REMOVE BIAS
 BMI CLASS2 CHECK ILLEGAL
 CMPA #'@-'( CHECK LIMIT
 BLS CLASS3 NOT LETTER
 CMPA #'Z-'( CHECK FOR LETTER 
 BLS CLAS1B
 CMPA #'^-'( CHECK FOR ILLEGAL 
 BNE CLASS2
 LDAB #10 FIX UP
CLAS1B ADDB #02
CLASS2 PULA RESTORE CHARACTER
CLAS25 RTS DONE
CLASS3 STX XSAVE2 SAVE X REG
 LDX #CLSTBL POINT TO TABLE 
 STAA CLSOFF+1 SET BIAS
CLSOFF LDAB 0,X GET CLASSIFICATION
 LDX XSAVE2 RESTORE X REG, 
 BRA CLASS2
CLSTBL FCB 5,4,10,6,1,7,0,11,3,3,3,3
 FCB 3,3,3,3,3,3,1,1,1,1,1,8,9
*
*
* RANDOM GENERATOR
*
RANDOM LDAB #8 SET COUNTER
 LDX #RNDM
RPT LDAA 3,X GET M.S. BYTE OF RANDOM NO.
 ASLA SHIFT IT LEFT THREE:
 ASLA TIMES TO GET BIT 28
 ASLA IN LINE WITH BIT 31
 EORA 3,X XOR A WITH RANDOM NO
 ASLA PUT BIT 28.XOR31 IN
 ASLA CARRY BY SHIFTING LEFT
 ROL 0,X ROTATE ALL FOUR BYTES OF
 ROL 1,X THE RANDOM NO, ROTATING
 ROL 2,X THE CARRY INTO THE LSB
 ROL 3,X THE MSB IS LOST
 DECB DECREMENT THE COUNTER
 BNE RPT IF ITS NOT O, GO REPEAT
 LDAA 0,X PUT RANDOM # IN A
 CMPA #$9F CHECK IN RANGE
 BHI RANDOM IN NOT GET ANOTHER
 ADDA #0 SET HALF CARRY 
 DAA
 RTS
*
* PATCH - PUT RTS AT EXTRN ADDRESS
*
PATCH LDAA #RETINS
 STAA EXTERN
 JMP MICBAS JMP TO BEGIN

ENDSTR RMB 2
STORSP EQU *

* ORG EXTERN
* RTS
 END
