 NAM RUNTIM (STRUBAL +)
* MODIFIED FOR CP/68
 CMN RUNSTK,80
 CMN ACCUM1,2
 CMN ACCUM2,2
 CMN ACCUM3,2
 CMN ACCUM4,2
 CMN ACCUM5,9
 CMN ADRTO,2
 CMN ADRFM,2
 CMN .EOF,2
 CMN .ERR,2
 CMN .CURIO,2
*
 ENT DIVERR
 ENT FIX
 ENT FABS
 ENT FNEG
 ENT FSIGN
 ENT ILLERR
 ENT ASCII
 ENT FCOMPR
 ENT FLOAT
 ENT INITIO
 ENT LPON
 ENT LPOFF
 ENT PDATA1
 ENT INEEE
 ENT CRLF
 ENT .RTBL
*
SYSIN JMP PUTIN
SYSOUT JMP PUTOUT
*
* DISPATCH ROUTINE
*
.RTBL STX RTEMP
  TSX
 LDAA 0,X
 LDAB 1,X
 ADDB #1
 ADCA #0
 STAA 0,X
 STAB 1,X
 LDX 0,X
 DEX
 LDAB 0,X
 CLRA
 ADDB TBL+1
 ADCA TBL
 PSHB
 PSHA
 LDX RTEMP
 RTS
TBL FDB BRTABL
RTEMP RMB 2
BRTABL EQU *
 JMP NOT
 JMP ANDZ
 JMP EXOR
 JMP OR
 JMP ADDZ
 JMP SUBZ
 JMP MULT
 JMP DIV
 JMP COMPAR
 JMP ABS
 JMP SIGN
 JMP MOD
 JMP EXP
 JMP RAND
 JMP LFEED
 JMP INPUT
 JMP OUTPUT
 JMP QOUT
 JMP STRIN
 JMP SPACES
 JMP LEN
 JMP VAL
 JMP ASCII
 JMP MID
 JMP XFER
 JMP DELAY
 JMP STRCMP
 JMP PEEK
 JMP POKE
 JMP FPRINT
 JMP FREAD
 JMP FIX
 JMP FLOAT
 JMP FABS
 JMP FSIGN
 JMP FNEG
 JMP FCOMPR
*
* FLOATING-POINT ROUTINES
*
 EXT FTAREG
 EXT FTCREG
 EXT FFDREG
 EXT FADD
 EXT FSUB
 EXT FMUL
 EXT FDIV
*
* SCIENTIFIC FUNCTIONS
*
 EXT SIN
 EXT COS
 EXT TAN
 EXT ASIN
 EXT ACOS
 EXT ATAN
 EXT LOG10
 EXT NATLOG
 EXT TENEXP
 EXT FEXP
 EXT XTOY
*
 JMP ZMOVER
 JMP FVAL
 JMP FASCII
*
* FILE I/O ROUTINES
*
 EXT OPEN
 EXT CLOSE
 EXT REWIND
 JMP IREAD
 JMP FLREAD
 JMP SREAD
 JMP IWRITE
 JMP FWRITE
 JMP QWRITE
 JMP SRECRD
 JMP FSPACE
 JMP FLFEED
*
 JMP DIGSET
 EXT MOVER
 JMP PUSHI
 JMP PUSHF
 JMP PUSHS
 JMP POPI
 JMP POPF
 JMP POPS
*
* FILE I/O DRIVER
*
 JMP CURIOB
 JMP STOP
*
 JMP PARAM
 JMP STROUT
 JMP SWRITE
 EXT GETB
 EXT OUTB
*
* NOT FUNCTION
NOT STX ACCUM2
 COM ACCUM2
 COM ACCUM2+1
 LDX ACCUM2
 RTS
* BYTE INPUT
PEEK CLRA
 LDAB 0,X
 BRA FINISH
* BYTE OUTPUT
POKE LDAA ACCUM3+1
 STAA 0,X
 RTS
* AND FUNCTION
ANDZ BSR SETUP
 ANDA ACCUM2
 ANDB ACCUM2+1
 BRA FINISH
* EXOR FUNCTION
EXOR BSR SETUP
 EORA ACCUM2
 EORB ACCUM2+1
 BRA FINISH
* OR FUNCTION
OR BSR SETUP
 ORAA ACCUM2
 ORAB ACCUM2+1
 BRA FINISH
* ADD FUNCTION
ADDZ BSR SETUP
 ADDB ACCUM2+1
 ADCA ACCUM2
 BVC *+5
 JSR OVERR
 BRA FINISH
* SUB FUNCTION
SUBZ BSR  SETUP
 SUBB ACCUM2+1
 SBCA ACCUM2
 BVC *+5
 JSR OVERR
 BRA FINISH
* COMPARE FUNCTION
COMPAR BRA SUBZ
SETUP LDAA ACCUM1
 LDAB ACCUM1+1
 STX ACCUM2
 RTS
FINISH STAA ACCUM2
 STAB ACCUM2+1
 LDX ACCUM2
 RTS
* MULTIPLY
MULT BSR SETUPS
 LDX #16
MPY1 ASLB
 ROLA
 ASL ACCUM2+1
 ROL ACCUM2
 BCC MPY2
 ADDB ACCUM1+1
 ADCA ACCUM1
 BVC *+5
 JSR OVERR
MPY2 DEX
 BNE MPY1
 BRA FINSHS
SETUPS CLR SIG
 STX ACCUM2
 TST ACCUM1
 BGE SET2
 COM SIG
 LDX #ACCUM1
 BSR NEGATE
SET2 TST ACCUM2
 BGE SET3
 COM SIG
 LDX #ACCUM2
 BSR NEGATE
SET3 LDAA ACCUM1
 LDAB ACCUM1+1
 RTS
FINSHS TSTA
 BGE F2
 JSR OVERR
F2 STAA ACCUM2
 STAB ACCUM2+1
 TST SIG
 BEQ F3
 LDX #ACCUM2
 BSR NEGATE
F3 LDX ACCUM2
 RTS
SIG RMB 1
* NEGATE FUNCTION
NEGATE LDAA 0,X
 LDAB 1,X
 COMA
 COMB
 ADDB #1
 ADCA #0
 STAA 0,X
 STAB 1,X
 RTS
* ABS FUNCTION
ABS STX ACCUM1
 BMI ABS2
 RTS
ABS2 LDX #ACCUM1
 BSR NEGATE
 LDX ACCUM1
 RTS
* DIVIDE FUNCTION
DIV JSR SETUPS
 LDX ACCUM2
 BNE DIV2
 JSR DIVERR
DIV2 LDAA #1
 TST ACCUM2
 BMI DIV4
DIV3 INCA
 ASL ACCUM2+1
 ROL ACCUM2
 BMI DIV4
 CMPA #17
 BNE DIV3
DIV4 STAA COUNT
 LDAA ACCUM1
 LDAB ACCUM1+1
 CLR ACCUM1
 CLR ACCUM1+1
DIV5 SUBB ACCUM2+1
 SBCA ACCUM2
 BCC DIV6
 ADDB ACCUM2+1
 ADCA ACCUM2
 CLC
 BRA DIV7
DIV6 SEC
DIV7 ROL ACCUM1+1
 ROL ACCUM1
 LSR ACCUM2
 ROR ACCUM2+1
 DEC COUNT
 BNE DIV5
 STAA COUNT
 STAB COUNT+1
 LDAA ACCUM1
 LDAB ACCUM1+1
 JMP FINSHS
COUNT RMB 1
 RMB 1
* SIGN FUNCTION
SIGN STX ACCUM2
 BNE SIGN2
 RTS
SIGN2 BMI SIGN3
 LDX #1
 RTS
SIGN3 LDX #$FFFF
 RTS
* MODULO FUNCTION
MOD JSR DIV
 LDX COUNT
 RTS
* EXPONENTIAL FUNCTION
EXP STX POWER
 BNE EXP2
 LDX #1
EXP1 RTS
EXP2 BMI EXP4
 LDX ACCUM1
 STX TEMP
EXP3 DEC POWER+1
 BEQ EXP1
 JSR MULT
 LDX TEMP
 STX ACCUM1
 LDX ACCUM2
 BRA EXP3
EXP4 JSR NEGERR
 LDX ACCUM1
 RTS
POWER RMB 2
TEMP RMB 2
* STRING COMPARISON
STRCMP STX ACCUM2
 LDX ACCUM4
STRLP LDAA 0,X
 LDX ACCUM2
 CMPA 0,X
 BEQ *+3
STREND RTS
 CMPA #4
 BEQ STREND
 INX
 STX ACCUM2
 LDX ACCUM4
 INX
 STX ACCUM4
 BRA STRLP
* RANDOM GENERATOR
RAND STX ACCUM2
 BNE RAND2
RESTRT LDX #$1357
 STX SEED
RAND2 LDX SEED
  BEQ RESTRT
 LDAA SEED
 ANDA #$60
 BEQ RAND3
 CMPA #$40
 BEQ RAND4
 CMPA #$20
 BEQ RAND4
RAND3 ASL SEED+1
 ROL SEED
 BRA RAND5
RAND4 ASL SEED+1
 ROL SEED
 INC SEED+1
RAND5 LDX SEED
 RTS
SEED RMB 2
* PUSH AND POP ROUTINES
PUSHI PULA
 STAA ACCUM1
 PULA
 STAA ACCUM1+1
 LDAA 0,X
 PSHA
 LDAA 1,X
 PSHA
RETRN LDX ACCUM1
 JMP 0,X
PUSHF PULA
 STAA ACCUM1
 PULA
 STAA ACCUM1+1
 LDAB #9
PUSHF2 LDAA 0,X
 PSHA
 INX
 DECB
 BNE PUSHF2
 BRA RETRN
PUSHS PULA
 STAA ACCUM1
 PULA
 STAA ACCUM1+1
 STX ACCUM2
PUSHS2 LDAA 0,X
 CMPA #4
 BEQ PUSHS3
 INX
 BRA PUSHS2
PUSHS3 LDAA 0,X
 PSHA
 CPX ACCUM2
 BEQ RETRN
 DEX
 BRA PUSHS3
POPI PULA
 STAA ACCUM1
 PULA
 STAA ACCUM1+1
 PULA
 STAA 1,X
 PULA
 STAA 0,X
 BRA RETRN
POPF PULA
 STAA ACCUM1
 PULA
 STAA ACCUM1+1
 LDAB #9
POPF2 PULA
 STAA 6,X
 DEX
 DECB
 BNE POPF2
 BRA RETRN
POPS PULA
 STAA ACCUM1
 PULA
 STAA ACCUM1+1
POPS2 PULA
 STAA 0,X
 INX
 CMPA #4
 BNE POPS2
 BRA RETRN
* I/O ROUTINES
OUTHL LSRA
 LSRA
 LSRA
 LSRA
OUTHR ANDA #$F
 ADDA #$30
 CMPA #$39
 BLS OUTEEE
 ADDA #7
 BRA OUTEEE
OUTS LDAA #$20
 BRA OUTEEE
INEEE LDAA FRDFLG
 CMPA #$FF
 BNE INE3
INE1 CLR .EOF
 CLR .EOF+1
 JSR GETB
 BCC INE2
 COM .EOF
 COM .EOF+1
 LDAA #$D
 RTS
INE2 TSTA
 BEQ INE1
 RTS
INE3 JMP SYSIN
OUTEEE PSHA
 PSHB
 TST FLAG
 BEQ OUTE2
 STX XTEMP
 LDX XPOINT
 PULB
 PULA
 STAA 0,X
 INX
 STX XPOINT
 LDX XTEMP
 RTS
OUTE2 LDAB FWRFLG
 CMPB #$FF
 BNE OUTE3
 JSR OUTB
 PULB
 PULA
 RTS
OUTE3 JSR SYSOUT
 PULB
 PULA
OUTEND RTS
XTEMP RMB 2
XPOINT RMB 2
FLAG FCB 0
PDATA2 BSR OUTEEE
 INX
PDATA LDAA 0,X
 CMPA #4
 BNE PDATA2
 TST FLAG
 BNE OUTEND
 TST FWRFLG
 BNE OUTEND
 BRA OUTEEE
PDATA1 CLR FWRFLG
 CLR FLAG
 BRA PDATA
CRLF CLR FLAG
 BRA LFEED+3
LFEED CLR FWRFLG
 LDX #CRL
 BRA PDATA
CRL FDB $0D0A
 FCB 4
* MOVE UTILITY
ZMOVER STX ADRFM
 LDX ACCUM1
 STX ADRTO
 LDAB #9
 JMP MOVER
* STOP COMMAND
STOP SWI
 FCB 31 CALL CP/68
 RTS
* INPUT HANDLER
PRMPT FCC ' >'
 FCB 4
RETM FCB 3
BUFFER RMB 82
INEDIT CLR FLAG
 LDAA FRDFLG
 CMPA #$FF
 BEQ INP1
 LDX #PRMPT
 JSR PDATA
INP1 LDX #BUFFER
 CLR COUNT
INP2 JSR INEEE
 CMPA #$D
 BEQ INP6
INP3 CMPA RETM
 BNE INP4
 JMP STOP
INP4 STAA 0,X
 INX
 CPX #BUFFER+81
 BNE INP5
 JSR BADERR
 BRA RETRY
INP5 INC COUNT
 BRA INP2
INP6 RTS
RETRY JSR LFEED
 BRA INEDIT
INPUT CLR FRDFLG
 BSR INEDIT
 CLR RTYFLG
 LDX #BUFFER
CNVRT2 LDAA 0,X
 CMPA #$20
 BNE CNVRT3
 INX
 DEC COUNT
 BGT CNVRT2
 JSR BADERR
 TST RTYFLG
 BEQ *+6
 LDX #$FFFF
 RTS
 BSR RETRY
 JMP INPUT+5
CNVRT3 CMPA #'$
 BEQ *+5
 JMP DECIM
 CLR ACCUM1
 CLR ACCUM1+1
 LDAB COUNT
CVHB1 INX
 DECB
 BNE CVHB1
 DEX
 DEC COUNT
 BEQ RETRY
 BSR CVHBS
 STAA ACCUM1+1
 DEC COUNT
 BEQ CVHBD
 DEX
 BSR CVHBS
 ASLA
 ASLA
 ASLA
 ASLA
 ORAA ACCUM1+1
 STAA ACCUM1+1
 DEC COUNT
 BEQ CVHBD
 DEX
 BSR CVHBS
 STAA ACCUM1
 DEC COUNT
 BEQ CVHBD
 DEX
 BSR CVHBS
 ASLA
 ASLA
 ASLA
 ASLA
 ORAA ACCUM1
 STAA ACCUM1
 DEC COUNT
 BEQ CVHBD
 JSR TRUNER
CVHBD LDX ACCUM1
 RTS
* ASCII TO BINARY
CVHBS LDAA 0,X
 SUBA #$30
 BMI ERROR
 CMPA #9
 BLE CVHBSD
 SUBA #7
 CMPA #10
 BLT ERROR
 CMPA #15
 BGT ERROR
CVHBSD RTS
ERROR JSR BADERR
 INS
 INS
 TST  RTYFLG
 BEQ *+6
 LDX #$FFFF
 RTS
 JMP INPUT
* DECIMAL TO BINARY
DECIM CLR SIG2
 CMPA #'-
 BNE DECIM2
 COM SIG2
 INX
 DEC COUNT
 BNE DECIM2
 JSR RETRY
 JMP INPUT+5
DECIM2 CLR DVAL
 CLR DVAL+1
 CLR TENVAL
 CLR TENVAL+1
 INC TENVAL+1
 LDAB COUNT
DECIM3 INX
 DECB
 BNE DECIM3
 DEX
 STX DXSAV
CVDB1 LDAB 0,X
 CMPB #$20
 BNE CBLNK
 LDX DXSAV
 DEX
 STX DXSAV
 DEC COUNT
 BEQ ERROR2
 BRA CVDB1
CBLNK SUBB #$30
 BPL CVDB2
ERROR2 JSR BADERR
 TST RTYFLG
 BEQ *+6
 LDX #$FFFF
 RTS
 JMP INPUT
CVDB2 CMPB #9
 BGT ERROR2
 STAB ACCUM1+1
 CLR ACCUM1
 LDX TENVAL
 JSR MULT
 STX ACCUM1
 LDX DVAL
 JSR ADDZ
 STX DVAL
 LDX DXSAV
 DEX
 STX DXSAV
 DEC COUNT
 BEQ CVDB3
 LDX TENVAL
 STX ACCUM1
 LDX TEN10
 JSR MULT
 STX TENVAL
 LDX DXSAV
 BRA CVDB1
CVDB3 TST SIG2
 BEQ DECIM4
 LDX #DVAL
 JSR NEGATE
DECIM4 LDX DVAL
  RTS
DXSAV RMB 2
DVAL RMB 2
TENVAL RMB 2
SIG2 RMB 1
RTYFLG RMB 1
* OUTPUT FUNCTION
OUTPUT CLR FWRFLG
 STX ACCUM1
 CLR FLAG
OUTSS LDX #FTEMP
 JSR FLOAT
 LDX #FTEMP
 JMP FPRINT+6
FTEMP RMB 9
XSAV RMB 2
* ERROR REPORTING
PERR CLR FLAG
 CLR FWRFLG
 JSR LFEED
 LDX BUFFER+8
 JSR PDATA
 TSX
 INX
 INX
 LDAB #4
 JSR MPRINT
 JMP LFEED
DIVERR LDX #DIVMSG
 STX BUFFER+8
 BSR PERR
 JMP STOP
DIVMSG FCC ' DIVIDE BY ZERO AT '
 FCB 4
NEGERR LDX #NEGMSG
 STX BUFFER+8
 BSR PERR
 RTS
NEGMSG FCC ' NEGATIVE EXPONENT AT '
 FCB 4
BADERR LDX #BADMSG
 STX BUFFER+8
 BSR PERR
 RTS
BADMSG FCC ' BAD INPUT AT '
 FCB 4
OVERR LDX #OVMSG
 STX BUFFER+8
 JSR PERR
 LDAA #$7F
 LDAB #$FF
 RTS
OVMSG FCC ' OVERFLOW AT '
 FCB 4
TRUNER CLR FLAG
 CLR FWRFLG
 JSR LFEED
 LDX #TERR
 JSR PDATA
 JMP LFEED
TERR FCC ' TRUNCATED'
 FCB 4
LENERR LDX #LENMSG
 STX BUFFER+8
 JSR PERR
 CLR ACCUM2
 CLR ACCUM2+1
 RTS
LENMSG FCC ' STRING TOO LONG AT '
 FCB 4
ILLERR LDX #ILLMSG
 STX BUFFER+8
 JSR PERR
 JMP STOP
ILLMSG FCC ' ILLEGAL ARGUMENT AT '
 FCB 4
* FILE I/O HANDLERS
IREAD LDAA #$FF
 STAA FRDFLG
 JSR INPUT+3
 CLR FRDFLG
 RTS
FLREAD LDAA #$FF
 STAA FRDFLG
 JSR FREAD+3
 CLR FRDFLG
 RTS
SREAD LDAA #$FF
 STAA FRDFLG
SRD1 JSR INEEE
 CMPA #$D
 BEQ SRD2
 CMPA #$A
 BEQ SRD1
 STAA 0,X
 INX
 BRA SRD1
SRD2 LDAA #4
 STAA 0,X
 CLR FRDFLG
  RTS
* SET CURRENT IOB ADDRESS
CURIOB STX .CURIO
 CLR .ERR
 CLR .ERR+1
 RTS
SRECRD LDX #0
 STX .EOF
SREC1 JSR GETB
 BCC SREC2
 LDX #$FFFF
 STX .EOF
 RTS
SREC2 CMPA #$A
 BNE SREC1
 RTS
FRDFLG RMB 1
FWRFLG RMB 1
IWRITE LDAA #$FF
 STAA FWRFLG
 JSR OUTPUT+3
IWRIT2 LDAA #$D
 JSR OUTB
 CLR FWRFLG
 RTS
FWRITE LDAA #$FF
 STAA FWRFLG
 JSR FPRINT+3
 BRA IWRIT2
SWRITE LDAA #$FF
 STAA FWRFLG
 JSR STROUT+3
 BRA IWRIT2
QWRITE LDAA #$FF
 STAA FWRFLG
 JSR QOUT+3
 BRA IWRIT2
FLFEED LDAA #$FF
 STAA FWRFLG
 JSR LFEED+3
 CLR FWRFLG
 RTS
FSPACE LDAA #$FF
 STAA FWRFLG
 JSR SPACES+3
 CLR FWRFLG
 RTS
* LEN FUNCTION
LEN CLR ACCUM2
 CLR ACCUM2+1
LEN2 LDAA 0,X
 CMPA #4
 BEQ LEN3
 STX XSAV
 LDX ACCUM2
  INX
  STX ACCUM2
 LDAA ACCUM2
 BMI LENR
 LDX XSAV
 INX
 BRA LEN2
LENR JSR LENERR
LEN3 LDX ACCUM2
 RTS
* VALUE FUNCTION
VAL STX ACCUM1
 BSR LEN
 STX XSAV
 LDAA XSAV+1
 STAA COUNT
 BNE VAL2
 RTS
VAL2 LDX ACCUM1
 LDAA #$FF
 STAA RTYFLG
 JMP CNVRT2
* ASC  FUNCTION
ASCII CLR FLAG
 COM FLAG
 STX XPOINT
 LDX ACCUM3
 STX ACCUM1
 JSR OUTSS
ASCII2 LDAA #4
 JSR OUTEEE
 CLR FLAG
 LDX XPOINT
 DEX
 RTS
FASCII CLR FLAG
 COM FLAG
 STX XPOINT
 LDX ACCUM3
 JSR FPRINT+6
 BRA ASCII2
* MID FUNCTION
MID STX ADRFM
 LDX ACCUM4
 STX ADRTO
 LDX ACCUM3
 BPL MID2
 JSR LENERR
 LDX #1
 STX ACCUM3
MID2 LDX ADRFM
 LDAA 0,X
 INX
 STX ADRFM
 LDX ADRTO
 CMPA #4
 BEQ MID3
 STAA 0,X
 INX
 STX ADRTO
 LDX ACCUM3
 DEX
 BEQ MID3
 STX ACCUM3
 BRA MID2
MID3 LDX ADRTO
 LDAA #4
 STAA 0,X
 RTS
XFER STX ACCUM2
 LDX ACCUM1
 STX XPOINT
 LDX ACCUM2
 CLR FLAG
 COM FLAG
 JSR PDATA
 BRA ASCII2
* STRING OUTPUT ROUTINES
QOUT CLR FWRFLG
 CLR FLAG
 JMP PDATA
STROUT CLR  FWRFLG
 CLR FLAG
 LDAB SIZE
STRUT LDAA 0,X
 CMPA #4
 BEQ STRUT2
 JSR OUTEEE
 INX
 DECB
 BNE STRUT
 RTS
STRUT2 JSR OUTS
 DECB
 BNE STRUT2
 RTS
* STRING INPUT ROUTINE
STRIN CLR FRDFLG
 STX ACCUM1
 JSR INEDIT
 LDAA #4
 STAA 0,X
 LDX #BUFFER
 JMP XFER
SPACES CLR FWRFLG
 STX ACCUM2
 BMI SPCRTN
 BEQ SPCRTN
SPC1 CLR FLAG
  JSR OUTS
 LDX ACCUM2
 DEX
 STX ACCUM2
 BNE SPC1
SPCRTN RTS
PARAM TSX
 LDX 2,X
 STX ADRFM
 TSX
 LDX 0,X
 STX ADRTO
PARAM2 LDAA 2,X
 LDAB 3,X
 CMPA #$FF
 BNE PARAM3
 CMPB #$FF
 BNE PARAM3
 LDX ADRFM
 LDAA 2,X
 LDAB 3,X
 CMPA #$FF
 BNE PARERR
 CMPB #$FF
 BNE PARERR
 RTS
PARERR LDX #PARLN
 STX BUFFER+8
 JMP PERR
PARLN FCC 'PARAMETER LIST MISMATCH AT '
 FCB 4
PARAM3 LDX ADRFM
 LDAA 2,X
 LDAB 3,X
 CMPA #$FF
 BNE PARAM4
 CMPB #$FF
 BEQ PARERR
PARAM4 LDX ADRTO
 STAA 2,X
 STAB 3,X
 INX
 INX
 STX ADRTO
 LDX ADRFM
 INX
 INX
 STX ADRFM
 BRA PARAM2
* DELAY FUNCTION
DELAY LDAB DTIME
 DECB
 BNE *-1
 DEX
 BNE DELAY
 RTS
DTIME FCB 150
* SETDIGIT  ROUTINE
DIGSET STX ACCUM1
 LDAA ACCUM1
 BNE NODIG1
 LDAA ACCUM1+1
 CMPA #12
 BGT NODIG1
DIGS2 STAA DECPL
 LDAA ACCUM4
 BNE NODIG2
 LDAA ACCUM4+1
 BEQ NODIG2
 BMI NODIG2
DIGS3 STAA SIZE
 RTS
NODIG1 LDX #DERR1
 BSR DIGERR
 CLRA
 BRA DIGS2
NODIG2 LDX #DERR2
 BSR DIGERR
 LDAA #6
 BRA DIGS3
DIGERR  STX BUFFER+8
 JSR PERR
 RTS
DERR1 FCC ' DECIMAL-PLACE ERROR AT '
 FCB 4
DERR2 FCC ' INTEGER-PART SIZE ERROR AT '
 FCB 4
DECPL FCB  0
SIZE FCB 6
MPRINT LDAA 2,X
 JSR OUTHL
 COM NIBBLE
 DECB
 BEQ MQUIT
MPRNT2 LDAA 2,X
 JSR OUTHR
 COM NIBBLE
 INX
 DECB
 BNE MPRINT
MQUIT RTS
FPRINT CLR FWRFLG
 CLR FLAG
 LDAB 0,X
 BITB #$20
 BEQ NOTZ
 JSR OUTS
 LDX #ZERO
 LDAB #1
 BRA ZDOT2A
ZERO FDB $2001
 FDB 0
 FDB 0
 FDB 0
 FCB 0
NOTZ BITB #$80
 BEQ PLUS
 LDAA #'-
 JSR OUTEEE
 BRA ZDOT
PLUS JSR OUTS
ZDOT CLR NIBBLE
 LDAB 0,X
 ANDB #$F
 BNE ZDOT2
 LDAB 1,X
 CMPB #$14
 BHI ZDOT2
 CMPB #10
 BLT ZDOT1
 SUBB #6
ZDOT1 TSTB
 BEQ EXPM
 CMPB SIZE
 BLE *+5
ZDOT2 JMP ZDOT3
 LDAA 0,X
 BITA #$40
 BNE EXPM
ZDOT2A STAB SIGDIG
 NEGB
 ADDB SIZE
 BEQ PLOOP
BLOOP JSR OUTS
 DECB
 BNE BLOOP
PLOOP LDAB SIGDIG
 JSR MPRINT
 LDAB DECPL
 BEQ PLOOP1
 LDAA #'.
 JSR OUTEEE
 LDAB DECPL
 TST NIBBLE
 BNE PLOOP2
 JSR MPRINT
PLOOP1 JMP OUTS
PLOOP2 JSR MPRNT2
 JMP OUTS
EXPM CMPB DECPL
 BGE ZDOT3
 LDAB SIZE
 DECB
BLOOP2 JSR OUTS
 DECB
 BNE BLOOP2
 LDAA #'0
 JSR OUTEEE
 LDAA #'.
 JSR OUTEEE
  LDAB 1,X
PLOOP3 BEQ PLOOP4
 LDAA #'0
 JSR OUTEEE
 DECB
 BNE PLOOP3
PLOOP4 LDAB DECPL
 SUBB 1,X
 JSR MPRINT
 JMP OUTS
ZDOT3 LDAA #'0
 JSR OUTEEE
 LDAA #'.
 JSR OUTEEE
 LDAB 0,X
 STAB ACCUM1
 LDAB 1,X
 STAB ACCUM1+1
 LDAB #14
 JSR MPRINT
 JSR OUTS
 LDAA #'E
 JSR OUTEEE
 LDAB ACCUM1
 BITB #$40
 BEQ EPLUS
 LDAA #'-
 BRA ESGN
EPLUS LDAA #'+
ESGN JSR OUTEEE
 LDAA ACCUM1
 ANDA #$F
 BEQ *+5
 JSR OUTHR
 LDAA ACCUM1+1
 JSR OUTHL
 LDAA ACCUM1+1
 JSR OUTHR
 JMP OUTS
CNTR RMB 1
NIBBLE RMB 1
SIGDIG RMB 1
DECFLG RMB 1
EXPTMP RMB 1
* STRING TO FLOATING-POINT CONVERSION
FVAL STX DXSAV
 LDX ACCUM4
 STX ACCUM1
 LDAA #$FF
 STAA RTYFLG
 BRA FR0
* FLOATING INPUT ROUTINE
FREAD CLR FRDFLG
 STX ACCUM1
 CLR RTYFLG
 JSR INEDIT
 LDAA #4
 STAA 0,X
 LDX #BUFFER
 STX DXSAV
FR0 LDX ACCUM1
 LDAB #9
FR1 CLR 0,X
 INX
 DECB
 BNE FR1
 CLR DECFLG
 CLR SIGDIG
 CLR EXPTMP
 LDX ACCUM1
 LDAB #14
 STAB TEMP
 LDAA #$20
 STAA 0,X
 LDAB #$FF
 STAB NIBBLE
 JSR INCHAR
 CMPA #'+
 BEQ GETIN
 CMPA #'-
 BNE NOTMIN
 LDAA #$80
 ORAA 0,X
 STAA 0,X
 BRA GETIN
NOTMIN CMPA #'.
 BNE CRCHK
POINT COM DECFLG
GETIN JSR INCHAR
CRCHK CMPA #$D
 BNE *+5
 JMP SETEXP
 CMPA #4
 BNE *+5
 JMP SETEXP
 SUBA #$30
 BEQ GOTZER
 BMI NOTDON
 CMPA #9
 BHI NOTDON
 TST SIGDIG
 BNE GOTZER
 LDAB 0,X
 ANDB #$DF
 STAB 0,X
 INC SIGDIG
GOTZER TST TEMP
 BEQ GETIN
 TST SIGDIG
 BNE TSTNXT
 TST DECFLG
 BEQ GETIN
 DEC EXPTMP
 BRA GETIN
TSTNXT TST DECFLG
 BNE STORE
 INC EXPTMP
STORE TST NIBBLE
 BEQ LEFTH
 ASLA
 ASLA
 ASLA
 ASLA
LEFTH ORAA 2,X
 STAA 2,X
 COM NIBBLE
 BEQ NOTNXT
 INX
NOTNXT DEC TEMP
 BRA GETIN
NOTDON ADDA #$30
 CMPA #'E
 BEQ EXPIN
 CMPA #'.
 BNE SYNERR
 TST DECFLG
 BNE SYNERR
 COM DECFLG
 BRA GETIN
SYNERR JSR BADERR
 TST RTYFLG
 BEQ *+3
 RTS
 LDX ACCUM1
 JMP FREAD+6
EXPIN BSR INCHAR
 LDX ACCUM1
 CLR CNTR
 CMPA #'+
 BEQ EXPIN2
 CMPA #'-
 BNE CHKNXT
 LDAB #$40
 ORAB 0,X
 STAB 0,X
EXPIN2 BSR INCHAR
 CMPA #$D
 BEQ SETEXP
 CMPA #4
 BEQ SETEXP
CHKNXT SUBA #$30
 BMI SYNERR
 CMPA #9
 BLS EXPOK
 BRA SYNERR
EXPOK LDAB 1,X
 ASLB
 ASLB
 ASLB
 ASLB
 ABA
 STAA 1,X
 TST CNTR
 BNE SETEXP
 COM CNTR
 BRA EXPIN2
* FIX UP BCD EXPONENT
SETEXP LDX ACCUM1
 LDAA 1,X
 ANDA #$F
 PSHA
 LDAA 1,X
 ANDA #$F0
 LSRA
 TAB
 LSRA
 LSRA
 ABA
 PULB
 ABA
 LDAB 0,X
 BITB #$40
 BEQ NOSIGN
 NEGA
NOSIGN ADDA EXPTMP
 BPL SETX2
 NEGA
 LDAB #$40
 ORAB 0,X
 STAB 0,X
SETX2 CLRB
SETX3 CMPA #10
 BCS SETX4
 SUBA #10
 ADDB #$10
 BRA SETX3
SETX4 ABA
 DAA
 BCC NOINC
 INC 0,X
NOINC STAA 1,X
 RTS
INCHAR STX DVAL
INCH2 LDX DXSAV
 LDAA 0,X
 INX
 STX DXSAV
 CMPA #$20
 BEQ INCH2
 LDX DVAL
 RTS
* FLOATING TO INTEGER CONVERSION
FIX LDAA 0,X
 STAA CNTR
 BITA #$60
 BEQ FIX2
FIX0 LDX #0
 RTS
FIX2 ANDA #$F
 BNE FIXERR
 LDAA 1,X
 BEQ FIX0
 CMPA #6
 BCS FIX3
FIXERR JSR OVERR
 STAA ACCUM1
 STAB ACCUM1+1
 BRA FIX7
FIX3 STAA SIGDIG
 CLR ACCUM1
 CLR ACCUM1+1
 CLR NIBBLE
FIX4 LDAA 2,X
 TST NIBBLE
 BEQ FIX5
 ANDA #$F
 BRA FIX6
FIX5 LSRA
 LSRA
 LSRA
 LSRA
FIX6 CLRB
 ADDA ACCUM1+1
 ADCB ACCUM1
 BCS FIXERR
 STAA ACCUM1+1
 STAB ACCUM1
 DEC SIGDIG
 BEQ FIX7
 STX DXSAV
 LDX #10
 JSR MULT
 STX ACCUM1
 LDX DXSAV
 COM NIBBLE
 BNE FIX4
 INX
 BRA FIX4
FIX7 LDAA CNTR
 BITA #$80
 BEQ FIX8
 LDX #ACCUM1
 JSR NEGATE
FIX8 LDX ACCUM1
 RTS
* INTEGER TO FLOATING CONVERSION
FLOAT STX DVAL
 LDAB #9
FLOT2 CLR 0,X
 INX
 DECB
 BNE FLOT2
 CLR NIBBLE
 CLR SIGDIG
 LDX ACCUM1
 BNE FLOT3
 LDX DVAL
 LDAA #$20
  STAA 0,X
 RTS
FLOT3 BPL FLOT4
 LDAA #$80
 LDX DVAL
 STAA 0,X
 LDX #ACCUM1
 JSR NEGATE
FLOT4 LDX DVAL
 STX ACCUM2
 LDX #KIOK
 STX DXSAV
 LDAA #5
 STAA EXPTMP
FLOT5 CLR CNTR
 LDAA ACCUM1
 LDAB ACCUM1+1
FLOT6 SUBB 1,X
 SBCA 0,X
 BCS FLOT7
 INC CNTR
 BRA FLOT6
FLOT7 ADDB 1,X
 ADCA 0,X
 STAA ACCUM1
 STAB ACCUM1+1
 TST SIGDIG
 BNE FLOT9
 TST CNTR
 BNE FLOT8
 DEC EXPTMP
 BRA FLOT11
FLOT8 INC SIGDIG
FLOT9 LDX ACCUM2
 LDAA CNTR
 TST NIBBLE
 BNE FLOT10
 ASLA
 ASLA
 ASLA
 ASLA
FLOT10 ORAA 2,X
 STAA 2,X
 COM NIBBLE
 BNE FLOT11
 INX
 STX ACCUM2
FLOT11 LDX DXSAV
 INX
 INX
 STX DXSAV
 CPX #KIOK+10
 BNE FLOT5
 LDAA EXPTMP
 LDX DVAL
 STAA 1,X
 RTS
KIOK FDB 10000
 FDB 1000
 FDB 100
TEN10 FDB 10
 FDB 1
* FLOATING POINT COMPARE
FCOMPR JSR FTAREG
 LDX ACCUM1
 JSR FTCREG
 JSR FSUB
 LDX #FTEMP
  JSR FFDREG
 LDAA FTEMP
 BITA #$20
 BNE FEQUAL
 BITA #$80
 BNE FLTHAN
FGTHAN LDAA #1
 RTS
FLTHAN LDAA #$FF
 RTS
FEQUAL LDAA #0
 RTS
* FLOATING-POINT ABSOLUTE VALUE
FABS LDAA 0,X
 ANDA #$7F
 STAA 0,X
 RTS
* FLOATING-POINT SIGN
FSIGN LDAA 0,X
 BITA #$20
 BNE FSIGN2
 LDAB #$10
 STAB 2,X
 CLR 3,X
 CLR 4,X
 CLR 5,X
 CLR 6,X
 CLR 7,X
 CLR 8,X
 CLR 1,X
 INC 1,X
 CLR 0,X
 TSTA
 BPL FSIGN2
 LDAA #$80
 STAA 0,X
FSIGN2 RTS
* FLOATING-POINT NEGATE
FNEG LDAA 0,X
 EORA #$80
 STAA 0,X
 RTS
*
* SPECIAL CODE FOR CP/68 INTERFACE
* LINEPRINTER FCB
*
LPTFCB RMB 2
 FCC 'LPT'
 FDB $0080
 FDB LPTBUF
 RMB 33
LPTBUF RMB 132
* CONSOLE INPUT FCB
CNFCBI RMB 2
 FCC 'CON'
 FDB $0000
 FDB CNBUF1
 RMB 33
CNBUF1 RMB 132
* CONSOLE OUTPUT
CNFCBO RMB 2
 FCC 'CON'
 FDB $0080
 FDB CNBUF2
 RMB 33
CNBUF2 RMB 132
* FCB EQUATES
FCBSTA EQU 5
FCBDBA EQU 7
FCBIND EQU 39
INITIO SWI CALL CP/68
 FCB  51
 LDX #CNFCBO
 CLR FCBSTA,X
 LDAA FCBDBA,X
 LDAB FCBDBA+1,X
 STAA FCBIND,X
 STAB FCBIND+1,X
 LDX #LPTFCB
 CLR FCBSTA,X
 LDX FCBDBA,X
 LDAA #$C
 STAA 0,X
 INX
 SWI CALL CP/68
 FCB 2
 LDX #LPTFCB
 STAA FCBIND,X
 STAB FCBIND+1,X
 LDX #CNFCBI
 CLR FCBSTA,X
 CLR FCBIND,X
OUTRET RTS
OUTLPT CMPA #4
 BEQ OUTRET
 CMPA #$A
 BEQ OUTRET
 SWI CALL CP/68
 FCB 0
 LDX #LPTFCB
 LDX FCBIND,X
 STAA 0,X
 INX
 PSHA
 SWI CALL CP/68
 FCB 2
 LDX #LPTFCB
OUTL1 STAA FCBIND,X
 STAB FCBIND+1,X
 PULA
 CMPA #$D
  BEQ OUTL2
 SWI CALL CP/68
 FCB 1
 RTS
OUTL2 SWI CALL CP/68
 FCB 19
 LDAA FCBDBA,X
 LDAB FCBDBA+1,X
 STAA FCBIND,X
 STAB FCBIND+1,X
 CLR FCBSTA,X
 SWI CALL CP/68
 FCB 1
 RTS
PUTOUT CMPA #$A
 BEQ OUTRET
 SWI CALL CP/68
 FCB 0
 LDX #CNFCBO
 LDX FCBIND,X
 STAA 0,X
 INX
 PSHA
 SWI CALL CP/68
 FCB 2
 LDX #CNFCBO
 STAA FCBIND,X
 STAB FCBIND+1,X
 PULA
 CMPA #$D
 BEQ OUTL2
 CMPA #4
 BEQ OUTL2
 SWI CALL CP/68
 FCB 1
 RTS
PUTIN PSHB
 SWI CALL CP/68
 FCB 5
 LDX #CNFCBI
 TST FCBIND,X
 BNE IN2
IN1 SWI CALL CP/68
 FCB 19
 LDAA FCBDBA,X
 LDAB FCBDBA+1,X
 STAA FCBIND,X
 STAB FCBIND+1,X
 CLR FCBSTA,X
IN2 LDX FCBIND,X
 LDAA 0,X
 INX
 PSHA
 SWI CALL CP/68
 FCB 2
 LDX #CNFCBI
 STAA FCBIND,X
 STAB FCBIND+1,X
 PULA
 CMPA #$D
 BEQ IN3
 SWI CALL CP/68
 FCB 6
 PULB
 RTS
IN3 CLR FCBIND,X
 SWI CALL CP/68
 FCB 6
 PULB
 RTS
LPON LDX #OUTLPT
 STX SYSOUT+1
 RTS
LPOFF LDX #PUTOUT
 STX SYSOUT+1
 RTS
 END
