diff --git a/5K_BASIC_(Software#2).pdf b/5K_BASIC_(Software#2).pdf new file mode 100644 index 0000000..a2df223 Binary files /dev/null and b/5K_BASIC_(Software#2).pdf differ diff --git a/BASIC5.BIN#000000 b/BASIC5.BIN#000000 new file mode 100644 index 0000000..1b201ee Binary files /dev/null and b/BASIC5.BIN#000000 differ diff --git a/BASIC5.S#000000 b/BASIC5.S#000000 new file mode 100644 index 0000000..329dbc4 --- /dev/null +++ b/BASIC5.S#000000 @@ -0,0 +1,3495 @@ +; +; PROCESSOR TECHNOLOGY BASIC-5 +; USING ZILOG OPCODES, COURTESY OF A SED FILE +; +; SYSTEM GLOBAL EQUATES +; +BDOS EQU 0005H ;ADDRESS OF JUMP TO BDOS +CONIN EQU 1 ;CONSOLE IN +CONOUT EQU 2 ;CONSOLE OUT +CONSTS EQU 11 ;CONSOLE STATUS +FPSIZ EQU 5 +LINLEN EQU 73 ;# OF CHARS IN LEGAL INPUT LINE +FP123 EQU FPSIZ-2 +FPNIB EQU FP123*2 +DIGIT EQU FPNIB/2 +CR EQU 15Q ;CARRIAGE RETURN +NULL EQU 0 +LF EQU 12Q ;LINE FEED +ESC EQU 3Q ;CONTROL C +EOF EQU 1 ;END OF FILE +BELL EQU 7 ;BELL CHARACTER +STESIZ EQU 2+FPSIZ ;SYMBOL TABLE ELEMENT SIZE +OPBASE EQU '(' +FTYPE EQU 1 ;CONTROL STACK FOR ENTRY TYPE +FORSZ EQU FPSIZ*2+2+2+1 ;'FOR' CONTROL STACK ENTRY SIZE +GTYPE EQU 2 ;CONTROL STACK GOSUB ENTRY TYPE +ETYPE EQU 0 ;CONTROL STACK UNDERFLOW TYPE +UMINUS EQU 61Q ;UNARY MINUS +; +; STARTUP BASIC SYSTEM +; + ORG 100H +; +START: LD SP,CMNDSP + XOR A + LD (NULLCT),A ;NULL COUNT. + LD HL,BASEND ;START OF USER MEMORY + LD (BOFA),HL ;IS RIGHT AFTER THE BASIC CODE. + LD HL,(BDOS+1) ;THE ADDRESS OF BDOS IS + DEC HL ; ** Bobbi / Qkumba fix ** + LD (MEMTOP),HL ;THE END OF USER MEMORY. +ST0: LD HL,PLS ;"PROGRAM LOADED?" MESSAGE + CALL PRNT + CALL INLINE + LD A,(IBUF) +; +; OPTIONAL ENTRY POINT FOR TAPE OR DISK ROUTINES +; +; ALLOWS DIRECT PROGRAM INPUT FROM HIGH SPEED DEVICES +; SEE OPERATING INSTRUCTIONS FOR PROPER IMPLEMENTATION +; +STAR1: CP 'N' + JP Z,ST1 ;IF NO PROGRAM CLEAR AND INITIALIZE + CP 'Y' + JP NZ,ST0 + LD HL,(BOFA) +ST2: LD A,(HL) ;FIND END OF PROGRAM + CP EOF + JP Z,ST3 + CALL ADR + JP ST2 +ST3: LD (EOFA),HL + CALL CCLEAR + JP ST4 +ST1: CALL CSCR +ST4: LD A,2*FPNIB + LD (INFES),A +; INITIALIZE RANDOM NUMBER + LD DE,FRAND + LD HL,RANDS + CALL VCOPY ;FRAND=RANDOM NUMBER SEED +; +; COMMAND PROCESSOR +; +CMND1: CALL CRLF2 + LD HL,RDYS ;PRINT READY MESSAGE + CALL PRNT +CMNDR: LD A,1 ;SET DIRECT INPUT FLAG + LD (DIRF),A + LD SP,CMNDSP + CALL CRLF +CMND2: CALL INLINE ;GET INPUT LINE FROM OPERATOR + CALL PP ;PRE-PROCESS IT + JP C,CMND3 + CALL LINE ;LINE NUMBER...GO EDIT + JP CMND2 +CMND3: CALL CMND4 + JP CMNDR +CMND4: LD HL,IBUF ;POINT TO COMMAND OR STATEMENT + LD (TXA),HL + CALL GC + AND 240Q + CP 240Q ;CHECK FOR COMMAND + LD DE,CMNDD + JP Z,ISTA1 ;PROCESS COMMAND + CALL ISTAT ;PROCESS STATEMENT (IF ALLOWED) + CALL GCI + CP CR + RET Z +E1: LD BC,'BS' + JP ERROR +; ERROR MESSAGE PRINTOUT +E3: LD BC,'BA' + JP ERROR +E4: LD BC,'CS' + JP ERROR +E5: LD BC,'OB' + JP ERROR +E6: LD BC,'DM' +; +ERROR: PUSH BC + CALL CRLF + POP BC + CALL CHOUT + LD B,C + CALL CHOUT + LD HL,ERS +ERM1: CALL PRNT + LD A,(DIRF) + OR A + JP NZ,CMND1 + LD HL,INS + CALL PRNT +; FIND LINE NUMBER + LD HL,(BOFA) +ERM2: LD B,H + LD C,L + LD E,(HL) + LD D,0 + ADD HL,DE + EX DE,HL + LD HL,TXA + CALL DCMP + EX DE,HL + JP C,ERM2 + INC BC + LD A,(BC) + LD L,A + INC BC + LD A,(BC) + LD H,A + LD DE,IBUF ;USE IBUF TO ACCUMULATE THE LINE NUMBER STRING + CALL CNS + LD A,CR + LD (DE),A + LD HL,IBUF + CALL PRNTCR + JP CMND1 +; +; LINE EDITOR +; +LINE: LD HL,(BOFA) ;CHECK FOR EMPTY FILE +FIN: LD A,(HL) ;CHECK IF APPENDING LINE AT END + DEC A + JP Z,APP + EX DE,HL + INC DE + LD HL,(IBLN) ;GET INPUT LINE NUMBER + EX DE,HL + CALL DCMP ;COMPARE WITH FILE LINE NUMBER + DEC HL + JP C,INSR ;LESS THAN + JP Z,INSR ;EQUAL + LD A,(HL) ;LENGTH OF LINE + CALL ADR ;JUMP FORWARD + JP FIN +; APPEND LINE AT END CASE +APP: LD A,(IBCNT) ;DON'T APPEND NULL LINE + CP 4 + RET Z + CALL FULL ;CHECK FOR ROOM IN FILE + LD HL,(EOFA) ;PLACE LINE IN FILE + CALL IMOV + LD (HL),EOF + LD (EOFA),HL + RET +; INSERT LINE IN FILE CASE +INSR: LD B,(HL) ;OLD LINE COUNT + LD (INSA),HL ;INSERT LINE POINTER + LD A,(IBCNT) ;NEW LINE COUNT + JP C,LT ;JMP IF NEW LINE # NOT = OLD LINE NUMBER + SUB 4 + JP Z,LT1 ;TEST IF SHOULD DELETE NULL LINE + ADD A,4 +LT1: SUB B + JP Z,LIN1 ;LINE LENGTHS EQUAL + JP C,GT +; EXPAND FILE FOR NEW OR LARGER LINE +LT: LD B,A + LD A,(IBCNT) + CP 4 ;DON'T INSERT NULL LINE + RET Z + LD A,B + CALL FULL + LD HL,(INSA) + CALL NMOV + LD HL,(EOFA) + EX DE,HL + LD (EOFA),HL + INC BC + CALL RMOV + JP LIN1 +; CONTRACT FILE FOR SMALLER LINE +GT: CPL + INC A + CALL ADR + CALL NMOV + EX DE,HL + LD HL,(INSA) + CALL NZ,LMOV + LD (HL),EOF + LD (EOFA),HL +; INSERT CURRENT LINE INTO FILE +LIN1: LD HL,(INSA) + LD A,(IBCNT) + CP 4 + RET Z +; INSERT CURRENT LINE AT ADDR HL +IMOV: LD DE,IBCNT + LD A,(DE) + LD C,A + LD B,0 +; COPY BLOCK FROM BEGINNING +; HL IS DEST ADDR, DE IS SOURCE ADDR, BC IS COUNT +LMOV: LD A,(DE) + LD (HL),A + INC DE + INC HL + DEC BC + LD A,B + OR C + JP NZ,LMOV + RET +; COPY BLOCK STARTING AT END +; HL IS DEST, DE IS SOURCE, BC IS COUNT +RMOV: LD A,(DE) + LD (HL),A + DEC HL + DEC DE + DEC BC + LD A,B + OR C + JP NZ,RMOV + RET +; COMPUTE FILE MOVE COUNT +; BC GETS (EOFA) - (HL), RET Z SET MEANS ZERO COUNT +NMOV: LD A,(EOFA) + SUB L + LD C,A + LD A,(EOFA+1) + SBC A,H + LD B,A + OR C + RET +; ADD A TO HL +ADR: ADD A,L + LD L,A + RET NC + INC H + RET +; CHECK FOR FILE OVERFLOW, LEAVES NEW EOFA IN DE +; A HAS INCREASE IN SIZE +FULL: LD HL,(EOFA) + CALL ADR + EX DE,HL + LD HL,MEMTOP + CALL DCMP + JP NC,E8 + RET +; +; COMMANDS +; +CSCR: LD HL,(BOFA) + LD (HL),EOF + LD (EOFA),HL +; "CLEAR" +CCLEAR: LD HL,(EOFA) ;CLEAR FROM EOFA TO MEMTOP + INC HL + LD (MATA),HL + EX DE,HL + LD HL,MEMTOP ;END OF ASSIGNED MEMORY +CCLR1: XOR A + LD (DE),A + CALL DCMP + INC DE + JP NZ,CCLR1 + LD HL,(MEMTOP) + LD (STAA),HL + LD HL,CSTKL+CSTKSZ-1 + LD (HL),ETYPE + LD (CSTKA),HL + LD HL,ASTKL+ASTKSZ+FPSIZ-1 + LD (ASTKA),HL + RET +; "NULL" +CNULL: CALL INTGER + JP C,E3 ;NO ARGUMENT SUPPLIED + LD A,L + LD (NULLCT),A + JP CMND1 +; "LIST" +CLIST: CALL GC + CP CR + LD DE,0 + JP Z,CL0 ;JUMP IF NO ARGUMENT SUPPLIED + CALL INTGER ;ERROR DEFAULT IS LIST +CL0: LD HL,(BOFA) +CL1: LD A,(HL) + DEC A + RET Z + INC HL + CALL DCMP + DEC HL ;POINT TO COUNT CHAR AGAIN + JP C,CL2 + JP Z,CL2 +; INCREMENT TO NEXT LINE + LD A,(HL) + CALL ADR + JP CL1 +CL2: PUSH DE + LD DE,IBUF ;AREA TO UNPREPROCESS TO + CALL UPPL + INC HL + PUSH HL + LD HL,IBUF + CALL PRNTCR + CALL PCHECK + CALL CRLF + POP HL + POP DE + JP CL1 +; "RUN" +CRUN: CALL CCLEAR + LD HL,(BOFA) + LD A,(HL) + DEC A ;CHECK FOR NULL PROGRAM + JP Z,ENDX + INC HL + INC HL + INC HL + LD (TXA),HL + LD (RTXA),HL ;POINTER FOR 'READ' STATEMENT + XOR A + LD (DIRF),A ;CLEAR DIRECT FLAG AND FALL THROUGH TO DRIVER + CALL CRLF +; +; INTERPRETER DRIVER +; +ILOOP: CALL PCHECK + CALL ISTAT ;INTERPRET CURRENT STATEMENT + CALL JOE ;TEST FOR JUNK ON END + JP NC,ILOOP ;CONTINUE IF NOT AT END OF PROGRAM + JP ENDX ;EXECUTE END STATEMENT +; INTERPRET STATEMENT LOCATED BY TXA +ISTAT: CALL GC ;GET FIRST NON BLANK + OR A + JP P,LET ;MUST BE LET IF NOT RW + CP IRWLIM ;IS IT AN INITIAL RW + JP NC,E1 + LD DE,STATD ;STATEMENT DISPATCH TABLE BASE +ISTA1: CALL GCI ;ADVANCE TEXT POINTER + AND 37Q + RLCA ;MULTIPLY BY TWO PREPARING FOR TABLE LOOKUP + LD L,A + LD H,0 + ADD HL,DE + CALL LHLI + JP (HL) ;BRANCK TO STATEMENT OR COMMAND +; +; STATEMENTS +; +; "LET" +LET: CALL VAR ;CHECK FOR VARIABLE + JP C,E1 + PUSH HL ;SAVE VALUE ADDRESS + LD B,EQRW + CALL EATC + CALL EXPRB + POP DE ;DESTINATION ADDRESS + CALL POPA1 ;COPY EXPR VALUE TO VARIABLE + RET ;******* CALL, RET???!!!**************** +; "FOR" +SFOR: CALL DIRT + CALL VAR ;CONTROL VARIABLE + JP C,E1 + PUSH HL ;CONTROLVARIABLE VALUE ADDRESS + LD B,EQRW + CALL EATC + CALL EXPRB ;INITIAL VALUE + POP DE ;VARIABLE VALUE ADDRESS + PUSH DE ;SAVE + CALL POPA1 ;SET INITIAL VALUE + LD B,TORW ;RW FOR 'TO' + CALL EATC + CALL EXPRB ;LIMIT VALUE COMPUTATION + CALL GC ;CHECK NEXT CHARACTER FOR POSSIBLE STEP EXPR + CP STEPRW + JP Z,FOR1 +; USE STEP OF 1 + LD DE,FPONE + CALL PSHA1 + JP FOR2 +; COMPUTE STEP VALUE +FOR1: CALL GCI ;EAT THE STEP RW + CALL EXPRB ;THE STEP VALUE +; HERE THE STEP AND LIMIT ARE ON THE ARG STACK +FOR2: LD DE,-2 ;PREPARE TO ALLOCATE 2 BYTES ON CONTROL STACK + CALL PSHCS ;RETURNS ADDRESS OF THOSE 2 BYTES IN HL + EX DE,HL + CALL JOE ;TEST FOR JUNK ON END + JP C,E4 ;NO "FOR" STATEMENT AT END OF PROGRAM + EX DE,HL ;DE HAS LOOP TEST ADDR, HL HAS CONTROL STACK ADR + LD (HL),D ;HIGH ORDER TEXT ADDRESS BYTE + DEC HL + LD (HL),E ;LOW ORDER TEXT ADDRESS BYTE + LD DE,-FPSIZ ;ALLOCATE SPACE FOR LIMIT ON CONTROL STACK + CALL PSHCS + PUSH HL ;ADDR ON CONTROL STACK FOR LIMIT + LD DE,-FPSIZ ;ALLOCATE SPACE FOR STEP ON CONTROL STACK + CALL PSHCS + CALL POPAS ;COPY STEP VALUE TO CONTROL STACK + POP DE ;CONTROL STACK ADDR FOR LIMIT VLAUE + CALL POPA1 ;LIMIT VALUE TO CONTROL STACK + LD DE,-3 ;ALLOCATE SPACE FOR TEST ADDRESS AND CS ENTRY + CALL PSHCS + POP DE ;CONTROL VARIABLE ADDRESS + LD (HL),D ;HIGH ORDER BYTE OF CONTROL VAR ADDR + DEC HL + LD (HL),E ;LOW ORDER BYTE + DEC HL + LD (HL),FTYPE ;SET CONTROL STACK ENTRY TYPE FOR "FOR" + JP NEXT5 ;GO FINISH OFF CAREFULLY +; "NEXT" +NEXT: CALL DIRT + LD HL,(CSTKA) ;CONTROL STACK ADDRESS + LD A,(HL) ;STACK ENTRY TYPE BYTE + DEC A ;MUST BE FOR TYPE ELSE ERROR + JP NZ,E4 ;IMPROPER NEXTING ERROR + INC HL ;CONTROL STACK POINTER TO CONTROL VAR ADDR + PUSH HL + CALL VAR ;CHECK VARIABLE, IN CASE USER WANTS + JP C,NEXT1 ;SKIP CHECK IF VAR NOT THERE + EX DE,HL + POP HL ;CONTROL VARIABLE ADDRESS + PUSH HL ;SAVE IT AGAIN + CALL DCMP + JP NZ,E4 ;IMPROPER NESTING IF NOT THE SAME +NEXT1: POP HL ;CONTROL VARIABLE ADDRESS + PUSH HL + PUSH HL + LD DE,FPSIZ+2-1 ;COMPUTE ADDRESS TO STEP VALUE + ADD HL,DE + EX (SP),HL ;NOW ADDRESS TO VAR IN HL + CALL LHLI ;VARIABLE ADDRESS + LD B,H ;COPY VAR ADDRESS TO BC + LD C,L + POP DE ;STEP VALUE ADDRESS + PUSH DE + CALL FADD ;DO INCREMENT + POP HL ;STEP VALUE + DEC HL ;POINT TO SIGN OF STEP VALUE + LD A,(HL) ;SIGN 0=POS, 1=NEG + LD DE,FPSIZ+1 + ADD HL,DE ;PUTS LIMIT ADDRESS IN HL + EX DE,HL + POP HL ;VARIABLE ADDRESS + CALL LHLI ;GET ADDRESS + PUSH DE ;SAVE CONTROL STACK POINTER TO GET TEXT ADDR + OR A ;SET CONDITIONS BASED ON SIGN OF STEP VALUE + JP Z,NEXT2 ;REVERSE TEST ON NEGATIVE STEP VALUE + EX DE,HL +NEXT2: LD B,H ;SET UP ARGS FOR COMPARE + LD C,L + CALL RELOP ;TEST <= + POP DE ;TEXT ADDRESS + JP M,NEXT3 ;STILL SMALLER? + JP Z,NEXT3 ;JUMP IF WANT TO CONTINUE LOOP +; TERMINATE LOOP + LD HL,3 ;REMOVE CSTACK ENTRY + ADD HL,DE + LD (CSTKA),HL + RET +NEXT3: INC DE ;TEXT ADDRESS + EX DE,HL + CALL LHLI ;GET TEXT ADDRESS IN HL +; ITERATE, SKIPPING NORMAL JUNK ON END TEST AT ILOOP +NEXT4: EX DE,HL ;SAVE NEW TEXT ADDRESS IN DE + CALL JOE + EX DE,HL +NEXT6: LD (TXA),HL +NEXT5: LD HL,ILOOP + EX (SP),HL + RET ;TO DISPATCHER SKIPPING JOE CALL THERE +; "IF" +SIF: LD B,1 ;SPECIFY PRINCIPAL OPERATOR IS RELATIONAL + CALL EXPB1 + LD HL,(ASTKA) ;ADDRESS ON BOOLEAN VALUE ON ARG STACK + INC (HL) ;SETS ZERO CONDITION IF RELATIONAL TEST TRUE + PUSH AF ;SAVE CONDITIONS TO TEST LATER + CALL POPAS ;REMOVE VALUE FROM ARG STACK COPY TO SELF + POP AF + JP NZ,REM ;IF TEST FALSE TREAT REST OF STATEMENT AS REM +; TEST SUCCEEDED + LD B,THENRW + CALL EATC + CALL INTGER ;CHECK IF LINE NUMBER IS DESIRED ACTION + JP C,ISTAT + JP GOTO1 +; "GOTO" +SGOTO: XOR A + LD (DIRF),A ;CLEAR DIRECT STATEMENT FLAG + CALL INTGER ;RETURNS INTEGER IN HL IF LINE NUMBER PRESENT + JP C,E1 ;SYNTAX ERROR NO LINE NUMBER +GOTO1: EX DE,HL ;LN IN DE + CALL FINDLN ;RETURNS TEST ADDRESS POINTS TO COUNT VALUE +GOTO2: INC HL + INC HL + INC HL ;ADVANCE TEXT POINTER PAST LINE NUMBER ANDCOUNT + JP NEXT4 +; "GOSUB" +GOSUB: CALL DIRT + LD DE,-3 ;CREATE CONTROL STACK ENTRY + CALL PSHCS + PUSH HL ;SAVE STACK ADDRESS + CALL INTGER + JP C,E1 + EX DE,HL ;LINE NUMBER TO DE + CALL JOE + LD B,H + LD C,L + POP HL ;STACK ADDRESS + LD (HL),B ;STACK RETURN ADDRESS RETURNED BY JOE + DEC HL + LD (HL),C + DEC HL + LD (HL),GTYPE ;MAKE CONTROL STACK ENTRY TYPE "GOSUB" + CALL FINDLN + INC HL + INC HL + INC HL + JP NEXT6 +; "RETURN" +RETRN: CALL DIRT + LD (DIRF),A ;CLEARS DIRF IN ACC IS CLEAR + LD HL,(CSTKA) +RET1: LD A,(HL) + OR A ;CHECK FOR STACK EMPTY + JP Z,E4 + CP GTYPE ;CHECK FOR GOSUB TYPE + JP Z,RET2 +; REMOVE FOR TYPE ENTRY FROM STACK + LD DE,FORSZ + ADD HL,DE + JP RET1 +; FOUND A GTYPE STACK ENTRY +RET2: INC HL + LD E,(HL) ;LOW ORDER TEXT ADDRESS + INC HL + LD D,(HL) ;HIGH ORDER TEXT ADDRESS + INC HL ;ADDRESS OF PREVIOUS CONTROL STACK ENTRY + LD (CSTKA),HL + EX DE,HL ;PUT TEXT ADDRESS IN HL + LD A,(HL) ;ADDRESS POINTS TO EOF IF GOSUB WAS LAST LINE + DEC A ;END OF FILE? + JP NZ,NEXT4 + JP ENDX +; "DATA" AND "REM" +DATA: CALL DIRT ;DATA STATEMENT ILLEGAL AS DIRECT +REM: CALL GCI + CP CR + JP NZ,REM + DEC HL ;BACKUP POINTER SO NORMAL JOE WILL WORK + LD (TXA),HL + RET +; "DIM" +DIM: CALL NAME ;LOOK FOR VARIABLE NAME + JP C,E1 + LD A,C ;PREPARE TURN ON 80H BIT TO SIGNIFY MATRIX + OR 80H + LD C,A + CALL STLK + JP NC,E6 ;ERROR IF NAME ALREADY EXISTS + PUSH HL ;SYMBOL TABLE ADDRESS + LD B,LPARRW + CALL EATC + CALL EXPRB + LD B,')' + CALL EATC + CALL PFIX ;RETURN INTEGER IN DE + LD HL,MATUB ;MAXIMUM SIZE FORM MATRIX + CALL DCMP + JP NC,E6 + POP HL ;SYMBOL TABLE ADDRESS + CALL DIMS + CALL GC ;SEE IF MORE TO DO + CP ',' + RET NZ + CALL GCI ;EAT THE COMMA + JP DIM +; "STOP" +STOP: CALL DIRT +STOP1: CALL CRLF2 + LD (BRKCHR),A + LD HL,STOPS + JP ERM1 +; "END" +ENDX EQU CMND1 +; "READ" +READ: CALL DIRT + LD HL,(TXA) + PUSH HL ;SAVE TXA TEMPORARILY + LD HL,(RTXA) ;THE 'READ' TXA +READ0: LD (TXA),HL + CALL GCI + CP ',' + JP Z,READ2 ;PROCESS INPUT VALUE + CP DATARW + JP Z,READ2 + DEC A + JP Z,READ4 +; SKIP TO NEXT LINE + CALL REM ;LEAVES ADDRESS OF LAST CR IN HL + INC HL + LD A,(HL) + DEC A + JP Z,READ4 + INC HL + INC HL + INC HL ;HL NOW POINTS TO FIRST BYTE ON NEXT LINE + JP READ0 +; PROCESS VALUE +READ2: CALL EXPRB + CALL GC + CP ',' ;SKIP JOE TEST IF COMMA + JP Z,READ3 +; JUNK ON END TEST + CALL JOE +READ3: LD HL,(TXA) + LD (RTXA),HL ;SAVE NEW "READ" TEXT ADDRESS + POP HL ;REAL TXA + LD (TXA),HL + CALL VAR + JP C,E1 + CALL POPAS ;PUT READ VALUE INTO VARIABLE + CALL GC + CP ',' ;CHECK FOR ANOTHER VARIABLE + RET NZ + CALL GCI ;EAT THE COMMA + JP READ +READ4: POP HL ;PROGRAM TXA + LD (TXA),HL + LD BC,'RD' + JP ERROR +; "RESTORE" +RESTOR: LD HL,(BOFA) ;BEGINNING OF FILE POINTER + INC HL + INC HL + INC HL + LD (RTXA),HL + RET +; "PRINT" +PRINT: CALL GC + CP CR ;CHECK FOR STAND ALONE PRINT + JP Z,CRLF +PRIN2: CP '"' + JP Z,PSTR ;PRINT THE STRING + CP TABRW + JP Z,PTAB ;TABULATION + CP '%' + JP Z,PFORM ;SET FORMAT + CP CR + RET Z + CP ';' + RET Z + CALL EXPRB ;MUST BE EXPRESSION TO PRINT + LD DE,FPSINK + CALL POPA1 ;POP VALUE TO FPSINK + LD A,(PHEAD) + CP 56 + CALL NC,CRLF ;DO CRLF IF PRINT HEAD IS PAST 56 + LD HL,FPSINK + CALL FPOUT + LD B,' ' + CALL CHOUT +PR1: CALL GC ;GET DELIMITER + CP ',' + JP NZ,CRLF +PR0: CALL GCI + CALL GC + JP PRIN2 +PSTR: CALL GCI ;GOBBLE THE QUOTE + CALL PRNT ;PRINT UP TO DOUBLE QUOTE + INC HL ;MOVE POINTER PAST DOUBLE QUOTE + LD (TXA),HL + JP PR1 +PFORM: LD A,2*FPNIB + LD (INFES),A + CALL GCI ;GOBBLE PREVIOUS CHAR +PFRM1: CALL GCI + LD HL,INFES + CP '%' ;DELIMITER + JP Z,PR1 + LD B,80H + CP 'Z' ;TRAILING ZEROS? + JP Z,PF1 + LD B,1 + CP 'E' ;SCIENTIFIC NOTATION? + JP Z,PF1 + CALL NMCHK + JP NC,E1 + SUB '0' ;NUMBER OF DECIMAL PLACES + RLCA + LD B,A + LD A,(HL) + AND 301Q + LD (HL),A +PF1: LD A,(HL) + OR B + LD (HL),A + JP PFRM1 +PTAB: CALL GCI ;GOBBLE TAB RW + LD B,LPARRW + CALL EATC + CALL EXPRB + LD B,')' + CALL EATC + CALL PFIX +PTAB1: LD A,(PHEAD) + CP E + JP NC,PR1 + LD B,' ' + CALL CHOUT + JP PTAB1 +; "INPUT" +INPUT: CALL GC + CP ',' + JP Z,NCRLF + CALL CRLF +INP0: LD B,'?' + CALL CHOUT +LINP: CALL INLINE + LD DE,IBUF +IN1: PUSH DE ;SAVE FOR FPIN + CALL VAR + JP C,E1 + POP DE + LD B,0 + LD A,(DE) + CP '+' ;LOOK FOR LEADING PLUS OR MINUS ON INPUT + JP Z,IN2 + CP '-' + JP NZ,IN3 + LD B,1 +IN2: INC DE +IN3: PUSH BC + PUSH HL + CALL FPIN ;INPUT FP NUMBER + JP C,INERR + POP HL + DEC HL + POP AF + LD (HL),A + CALL GC + CP ',' + RET NZ ;DONE IF NO MORE + CALL GCI ;EAT THE COMMA + LD A,B ;GET THE TERMINATOR TO A + CP ',' + JP Z,IN1 ;GET THE NEXT INPUT VALUE FROM STRING +; GET NEW LINE FROM USER + LD B,'?' + CALL CHOUT + JP INP0 +NCRLF: CALL GCI + JP LINP ;NOW GET LINE +INERR: LD BC,'IN' + JP ERROR +; +; EVALUATE AN EXPRESSION FROM TEXT +; HL TAKE OP TABLE ADDR OF PREVIOUS OPERATOR (NOT CHANGED) +; RESULT VALUE LEFT ON TOP OF ARG STACK, ARGF LEFT TRUE +; +EXPRB: LD B,0 +EXPB1: LD HL,OPBOL + XOR A + LD (RELTYP),A +; ZERO IN B MEANS PRINCIPAL OPERATOR MAY NOT BE RELATIONAL +EXPR: PUSH BC + PUSH HL ;PUSH OPTBA + XOR A + LD (ARGF),A +EXPR1: LD A,(ARGF) + OR A + JP NZ,EXPR2 + CALL VAR ;LOOK FOR VARIABLE PERHAPS SUBSCRIPTED + CALL NC,PSHAS + JP NC,EXPR2 + CALL CONST + JP NC,EXPR2 + CALL GC + CP LPARRW + LD HL,OPLPAR + JP Z,XLPAR +; ISN'T OR SHOULDN'T BE AN ARGUMENT +EXPR2: CALL GC + CP 340Q ;CHECK FOR RESERVED WORD OPERATOR + JP NC,XOP + CP 300Q ;CHECK FOR BUILT IN FUNCTION + JP NC,XBILT +; ILLEGAL EXPRESSION CHARACTER + POP HL ;GET OPTBA + LD A,(ARGF) + OR A + JP Z,E1 +XDON1: POP AF + LD HL,RELTYP ;CHECK IF LEGAL PRINCIPAL OPERATOR + CP (HL) + RET Z + JP E1 +XOP: AND 37Q ;CLEANS OFF RW BITS + LD HL,(ARGF) ;TEST FOR ARGF TRUE + DEC L + JP Z,XOP1 +; ARGF WAS FALSE, UNARY OPS ONLY POSSIBILITY + CP '-'-OPBASE + JP Z,XOPM + CP '+'-OPBASE + JP NZ,E1 + CALL GCI ;EAT THE '+' + JP EXPR1 +XOPM: LD A,UMINUS-OPBASE +XOP1: CALL OPADR + POP DE ;PREVIOUS OPTBA + LD A,(DE) + CP (HL) + JP NC,XDON1 ;NON-INCREASING PRECEDENCE +; INCREASING PRECEDENCE CASE + PUSH DE ;SAVE PREVIOUS OPTBA + PUSH HL ;SAVE CURRENT OPTBA + CALL GCI ;TO GOBBLE OPERATOR + POP HL + PUSH HL + LD B,0 ;SPECIFY NON-RELATIONAL + CALL EXPR + POP HL +; HL HAS OPTBA ADDRESS +; SET UP ARGS AND PERFORM OPERATION ACTION +XOP2: PUSH HL + LD A,(HL) + LD HL,(ASTKA) + LD B,H + LD C,L + AND 1 + JP NZ,XOP21 +; DECREMENT STACK POINTER BY ONE VALUE BINARY CASE + LD DE,FPSIZ + ADD HL,DE + LD (ASTKA),HL + LD D,H + LD E,L +XOP21: LD HL,EXPR1 + EX (SP),HL ;CHANGE RETURN LINK + INC HL ;SKIP OVER PRECEDENCE + CALL LHLI ;LOAD ACTION ADDRESS + JP (HL) +; +; ACTION ROUTINE CONVENTION +; DE LEFT ARG AND RESULT FOR BINARY +; BC RIGHT ARG FOR BINARY, ARG AND RESULT FOR UNARY +; +; INTRINSIC FUNCTION PROCESSING +; +XBILT: CALL GCI ;EAT TOKEN + AND 77Q ;CLEAN OFF RW BITS + LD HL,(ARGF) ;BUILT IN FUNCTION MUST COME AFTER OPERATOR + DEC L + JP Z,E1 + CALL OPADR ;OPTBA TO HL +XLPAR: PUSH HL + LD B,LPARRW + CALL EATC + CALL EXPRB + LD B,')' + CALL EATC + POP HL ;CODE FOR BUILT-IN FUNCTION + JP XOP2 +; COMPUTE OPTABLE ADDRESS FOR OPERATOR IN ACC +OPADR: LD C,A + LD B,0 + LD HL,OPTAB + ADD HL,BC + ADD HL,BC + ADD HL,BC ;OPTAB ENTRY ADDR IS 3*OP+BASE + RET +; +; PREPROCESSOR, UN-PREPROCESSOR +; PREPROCESS LINE IN IBUF BACK INTO IBUF +; SETS CARRY IF LINE HAS NO LINE NUMBER +; LEAVES CORRECT LENGTH OF LINE AFTER PREPROCESSING IN IBCN +; IF THERE IS A LINE NUMBER, IT IS LOCATED AT IBLN=IBUF-2 +; TXA IS CLOBBERED +; +PP: LD HL,IBUF ;FIRST CHARACTER OF INPUT LINE + LD (TXA),HL ;SO GCI WILL WORK + CALL INTGER ;SETS CARRY IF NO LINE NUMBER + LD (IBLN),HL ;STORE LINE NUMBER VALUE(EVEN IF NONE) + PUSH AF ;SAVE STATE OF CARRY BIT FOR RETURNING + LD HL,(TXA) ;ADDRESS OF NEXT CHARACTER IN IBUF + LD C,4 ;SET UP INITIAL VALUE FOR COUNT + LD DE,IBUF ;INITIALIZE WRITE POINTER +; COME HERE TO CONTINUE PREPROCESSING +PPL: PUSH DE + LD DE,RWT ;BASE OF RWT +PPL1: PUSH HL ;SAVE TEXT ADDRESS + LD A,(DE) ;RW VALUE FOR THIS ENTRY IN RWT + LD B,A ;SAVE IN B IN CASE OF MATCH +PPL2: INC DE ;ADVANCE ENTRY POINTER TO NEXT BYTE + LD A,(DE) ;GET NEXT CHARACTER FROM ENTRY + CP (HL) ;COMPARE WITH CHARACTER IN TEXT + JP NZ,PPL3 + INC HL ;ADVANCE TEXT POINTER + JP PPL2 ;CONTINUE COMPARISON +; COME HERE WHEN COMPARISON OF BYTE FAILED +PPL3: OR A + JP M,PPL6 ;JUMP IF FOUND MATCH +; SCAN TO BEGINNING ON NEXT ENTRY +PPL4: INC DE ;ADVANCE ENTRY POINTER + LD A,(DE) ;NEXT BYTE IS EITHER CHARACTER OR RW BYTE + OR A + JP P,PPL4 ;KEEP SCANNING IF NOT RW BYTE +; NOW SEE IF AT END OF TABLE, AND FAIL OR RETURN CONDITION + POP HL ;RECOVER ORIGINAL TEXT POINTER + XOR -1 ;CHECK FOR END OF TABLE BYTE + JP NZ,PPL1 ;CONTINUE SCAN OF TABLE +; DIDN'T FIND AN ENTRY AT THE GIVER TEXT ADR + POP DE + LD A,(HL) ;GET THE TEXT CHARACTER + CP CR ;CHECK FOR END OF LINE + JP Z,PPL8 ;GO CLEAN UP AND RETURN + LD (DE),A + INC DE + INC C + INC HL ;ADVANCE TEXT POINTER + CP '"' ;CHECK FOR QUOTED STRING POSSIBILITY + JP NZ,PPL ;RESTART RWT SEARCH AT NEXT CHARACTER POSITION +; HERE WE HAVE A QUOTED STRING, SO EAT TILL ENDQUOTE +PPL5: LD A,(HL) ;NEXT CHARACTER + CP CR + JP Z,PPL8 ;NO STRING ENDQUOTE, LET INTERPRETER WORRY + LD (DE),A + INC DE + INC C + INC HL ;ADVANCE TEXT POINTER + CP '"' + JP Z,PPL ;BEGIN RWT SCAN FROM NEW CHARACTER POSITION + JP PPL5 +; FOUND MATCH SO PUT RW VALUE IN TEXT +PPL6: POP AF ;REMOVE UNNEEDED TEST POINTER FROM STACK + POP DE + LD A,B + LD (DE),A + INC DE + INC C + JP PPL +; COME HERE WHEN DONE +PPL8: LD A,CR + LD (DE),A + LD HL,IBCNT ;SET UP COUNT IN CASE LINE OF LINE NUMBER + LD (HL),C + POP AF ;RESTORE CARRY CONDITION (LINE NUMBER FLAG) + RET +; +; UN-PREPROCESS LINE ADDRESSES IN HL TO DE BUFFER +; RETURN SOURCE ADDRESS OF CR IN HL ON RETURN +; +UPPL: INC HL ;SKIP OVER COUNT BYTE + PUSH HL ;SAVE SOURCE TEXT POINTER + CALL LHLI ;LOAD LINE NUMBER VALUE + CALL CNS ;CONVERT LINE NUMBER + LD A,' ' + LD (DE),A ;PUT BLANK AFTER LINE NUMBER + INC DE ;INCREMENT DESTINATION POINTER + POP HL + INC HL ;INCREMENT H PAST LINE NUMBER +UPP0: INC HL + LD A,(HL) ;NEXT TOKEN IN SOURCE + OR A + JP M,UPP1 ;JUMP IF TOKEN IS RW + LD (DE),A ;PUT CHARACTER IN BUFFER + CP CR ;CHECK FOR DONE + RET Z + INC DE ;ADVANCE DESTINATION BUFFER ADDRESS + JP UPP0 +; COME HERE WHEN RW BYTE DETECTED IN SOURCE +UPP1: PUSH HL ;SAVE SOURCE POINTER + LD HL,RWT ;BASE OF RWT +UPP2: CP (HL) ;SEE IF RW MATCHED RWT ENTRY + INC HL ;ADVANCE RWT POINTER + JP NZ,UPP2 ;CONTINUE LOOKING IF NOT FOUND +; FOUND MATCH, ENTRY POINTER LOCATES FIRST CHARACTER +UPP3: LD A,(HL) ;CHARACTER OF RW + OR A ;CHECK FOR DONE + JP M,UPP4 + LD (DE),A + INC DE + INC HL + JP UPP3 +; COME HERE IF DONE WITH RW TRANSFER +UPP4: POP HL ;SOURCE POINTER + JP UPP0 +; +; CONSTANTS AND TABLES +; +RDYS: DEFM 'READY"' +PLS: DEFM 'PROGRAM LOADED? "' +ERS: DEFM ' ERROR"' +INS: DEFM ' IN LINE "' +STOPS: DEFM 'STOP"' +; + DEFB 0FFH ;FLAGS END OF SINE COEFFICIENT LIST + DEFB 0 + DEFB 1*16 + DEFW 0 + DEFB 0 +FPONE: DEFB 129 ;EXPONENT +; SINE COEFFICIENT LIST +; NOTE: THE FLOATING PNT 1 ABOVE IS A PART OF THIS TABLE + DEFB 16H + DEFB 66H + DEFB 67H + DEFB 1 + DEFB 128 ;-.166667 E 0 (-1/3!) + DEFB 83H + DEFB 33H + DEFB 33H + DEFB 0 + DEFB 128-2 ;.833333 E-2 (1/5!) + DEFB 19H + DEFB 84H + DEFB 13H + DEFB 1 + DEFB 128-3 ;-.198413 E-3 (-1/7!) + DEFB 27H + DEFB 55H + DEFB 73H + DEFB 0 + DEFB 128-5 ;.275573 E-5 (1/9!) + DEFB 25H + DEFB 5 + DEFB 21H + DEFB 1 +SINX: DEFB 128-7 ;-.250521 E-7 (-1/11!) +; COSINE COEFFICIENT LIST + DEFB 0FFH ;MARKS END OF LIST + DEFB 0 + DEFB 10H + DEFB 0 + DEFB 0 + DEFB 0 + DEFB 128+1 ;/100000 E 1 (1/1!) + DEFB 50H + DEFB 0 + DEFB 0 + DEFB 1 +MATUB: DEFB 128 ;-.500000 E 0 (-1/2!) + DEFB 41H + DEFB 66H + DEFB 67H + DEFB 0 +RANDS: DEFB 128-1 ;.416667 E-1 (1/4!) + DEFB 13H + DEFB 88H + DEFB 89H + DEFB 1 + DEFB 128-2 ;-.138889 E-2 (-1/6!) + DEFB 24H + DEFB 80H + DEFB 16H + DEFB 0 + DEFB 128-4 ;.248016 E-4 (1/8!) + DEFB 27H + DEFB 55H + DEFB 73H + DEFB 1 +COSX: DEFB 128-6 ;-.275573 E-6 (-1/10!) + DEFB 20H + DEFW 0 + DEFB 0 +FPTWO: DEFB 129 + DEFB 15H + DEFB 70H + DEFB 80H + DEFB 0 +PIC2: DEFB 128+1 ;PI/2 + DEFB 63H + DEFB 66H + DEFB 20H + DEFB 0 +PIC1: DEFB 128 ;2/PI +LCSTKA: DEFW CSTKL +; +; COMMAND TABLE +; +CMNDD: DEFW CRUN ; 0 + DEFW CLIST ; 1 + DEFW CNULL ; 2 + DEFW CSCR ; 3 + DEFW START ; 4 SET UP MEMORY BOUNDS + DEFW TSAV ; 5 TAPE SAVE + DEFW TLOAD ; 6 TAPE LOAD +; STATEMENT TABLE +STATD: DEFW LET ; 0 + DEFW NEXT ; 1 + DEFW SIF ; 2 + DEFW SGOTO ; 3 + DEFW GOSUB ; 4 + DEFW RETRN ; 5 + DEFW READ ; 6 + DEFW DATA ; 7 + DEFW SFOR ; 10 + DEFW PRINT ; 11 + DEFW INPUT ; 12 + DEFW DIM ; 13 + DEFW STOP ; 14 + DEFW ENDX ; 15 + DEFW RESTOR ; 16 + DEFW REM ; 17 + DEFW CCLEAR ; 20 +; +; R/W WORD TABLE FORMAT IS RESERVED WORD FOLLOWED BY CHR +; OF RESERVED WORD. LAST ENTRY IS FOLLOWED BY A 377Q +; RW'S THAT ARE SUBSTRINGS OF OTHER RW'S (E.G. >) MUST +; FOLLOW THE LARGER WORD. +; +RWT: DEFB 200Q + DEFM 'LET' + DEFB 201Q + DEFM 'NEXT' + DEFB 202Q + DEFM 'IF' + DEFB 203Q + DEFM 'GOTO' + DEFB 204Q + DEFM 'GOSUB' + DEFB 205Q + DEFM 'RETURN' + DEFB 206Q + DEFM 'READ' + DEFB 207Q + DEFM 'DATA' +DATARW EQU 207Q + DEFB 210Q + DEFM 'FOR' + DEFB 211Q + DEFM 'PRINT' + DEFB 211Q + DEFM ':' + DEFB 212Q + DEFM 'INPUT' + DEFB 213Q + DEFM 'DIM' + DEFB 214Q + DEFM 'STOP' + DEFB 215Q + DEFM 'END' + DEFB 216Q + DEFM 'RESTORE' + DEFB 217Q + DEFM 'REM' + DEFB 220Q + DEFM 'CLEAR' +CLRRW EQU 220Q +IRWLIM EQU 221Q ;LAST INITIAL RESERVED WORD VALUE+1 + DEFB 237Q + DEFM 'STEP' +STEPRW EQU 237Q + DEFB 236Q + DEFM 'TO' +TORW EQU 236Q + DEFB 235Q + DEFM 'THEN' +THENRW EQU 235Q + DEFB 234Q + DEFM 'TAB' +TABRW EQU 234Q + DEFB 240Q + DEFM 'RUN' +RUNRW EQU 240Q + DEFB 241Q + DEFM 'LIST' +LISTRW EQU 241Q + DEFB 242Q + DEFM 'NULL' +NULLRW EQU 242Q + DEFB 243Q + DEFM 'SCR' +SCRRW EQU 243Q + DEFB 244Q + DEFM 'MEM' +MEMRW EQU 245Q ;******* WRONG CODE?******* + DEFB 245Q + DEFM 'TSAV' + DEFB 246Q + DEFM 'TLOAD' +LPARRW EQU '('-OPBASE+340Q + DEFB LPARRW + DEFB '(' + DEFB '*'-OPBASE+340Q + DEFB '*' +PLSRW EQU '+'-OPBASE+340Q + DEFB PLSRW + DEFB '+' +MINRW EQU '-'-OPBASE+340Q + DEFB MINRW + DEFB '-' + DEFB '/'-OPBASE+340Q + DEFB '/' + DEFB 67Q-OPBASE+340Q + DEFM '>=' + DEFB 70Q-OPBASE+340Q + DEFM '<=' + DEFB 71Q-OPBASE+340Q + DEFM '<>' + DEFB 62Q-OPBASE+340Q + DEFM '=>' + DEFB 63Q-OPBASE+340Q + DEFM '=<' + DEFB '<'-OPBASE+340Q + DEFB '<' +EQRW EQU '='-OPBASE+340Q + DEFB EQRW + DEFB '=' + DEFB '>'-OPBASE+340Q + DEFB '>' + DEFB 301Q + DEFM 'ABS' + DEFB 306Q + DEFM 'INT' + DEFB 314Q + DEFM 'ARG' + DEFB 315Q + DEFM 'CALL' + DEFB 316Q + DEFM 'RND' + DEFB 322Q + DEFM 'SGN' + DEFB 323Q + DEFM 'SIN' + DEFB 304Q + DEFM 'SQR' + DEFB 327Q + DEFM 'TAN' + DEFB 330Q + DEFM 'COS' + DEFB 377Q +; +; OPERATION TABLE +; +OPTAB: DEFB 15 +OPLPAR EQU OPTAB + DEFW ALPAR + DEFB 15 + DEFW AABS + DEFB 10 + DEFW AMUL + DEFB 6 + DEFW AADD + DEFB 15 + DEFW ASQR + DEFB 6 + DEFW ASUB + DEFB 15 + DEFW AINT + DEFB 10 + DEFW ADIV +OPBOL: DEFB 1 + DEFW 0 + DEFB 13 + DEFW ANEG + DEFB 4 + DEFW AGE + DEFB 4 + DEFW ALE + DEFB 15 + DEFW AARG + DEFB 15 + DEFW ACALL + DEFB 15 + DEFW ARND + DEFB 4 + DEFW AGE + DEFB 4 + DEFW ALE + DEFB 4 + DEFW ANE + DEFB 15 + DEFW ASGN + DEFB 15 + DEFW ASIN + DEFB 4 + DEFW ALT + DEFB 4 + DEFW AEQ + DEFB 4 + DEFW AGT + DEFB 15 + DEFW ATAN + DEFB 15 + DEFW ACOS +; +; ACTION ROUTINES FOR RELATIONAL OPERATORS +; +AGT: CALL RELOP + JP Z,RFALSE + JP M,RTRUE +RFALSE: XOR A + LD (DE),A + RET +ALT: CALL RELOP + JP Z,RFALSE + JP M,RFALSE +RTRUE: LD A,-1 + LD (DE),A + RET +AEQ: CALL RELOP + JP Z,RTRUE + JP RFALSE +ANE: CALL RELOP + JP Z,RFALSE + JP RTRUE +AGE: CALL RELOP + JP Z,RTRUE + JP M,RTRUE + JP RFALSE +ALE: CALL RELOP + JP Z,RTRUE + JP M,RFALSE + JP RTRUE +; +; COMMON ROUTINE FOR RELATIONAL OPERATOR ACTION +; LEFT ARG ADDR IN DE, SAVED +; RIGHT ARG ADDR IN BC +; ON RETURN SIGN SET=GT, ZERO SET =EQUAL +; +RELOP: PUSH DE + DEC BC + DEC DE + LD H,B + LD L,C + LD A,(DE) + SUB (HL) + INC HL + INC DE + JP NZ,RLOP1 ;TEST SIGNS OF ARGS IF DIFFERENT THEN RET + LD BC,FPSINK + CALL FSUB + LD A,(FPSINK) ;CHECK FOR ZERO RESULT + OR A + JP Z,RLOP1 + LD A,(FPSINK-1) ;SIGN OF FPSINK + RLCA + DEC A +RLOP1: LD A,1 + LD (RELTYP),A ;SET RELTYP TRUE + POP DE + RET +; +; ACTION ROUTINES FOR ARITHMETIC OPERATORS +; (CODE WASTERS) +; +AADD: LD H,B + LD L,C + LD B,D + LD C,E +AADD1: CALL FADD + JP FPETST +ASUB: LD H,B + LD L,C + LD B,D + LD C,E +ASUB1: CALL FSUB + JP FPETST +AMUL: LD H,B + LD L,C + LD B,D + LD C,E +AMUL1: CALL FMUL + JP FPETST +ADIV: LD H,B + LD L,C + LD B,D + LD C,E +ADIV1: CALL FDIV +FPETST: XOR A + LD (RELTYP),A + LD A,(ERRI) + OR A + RET Z + LD HL,(ASTKA) ;ZERO RESULT ON UNDERFLOW +FPET1: LD (HL),0 +ALPAR: RET +; +; UNARY AND BUILT IN FUNCTION ROUTINES +; +ANEG: LD A,(BC) + OR A + JP Z,ANEG1 + DEC BC + LD A,(BC) + XOR 1 + LD (BC),A +ANEG1: XOR A + LD (RELTYP),A + RET +AABS: DEC BC + XOR A + LD (BC),A + JP ANEG1 +ASGN: CALL ANEG1 + LD D,B + LD E,C + LD A,(BC) ;GET EXPONENT + OR A + JP NZ,ASGN1 + LD (DE),A ;MAKE ARGUMENT ZERO + RET +ASGN1: DEC BC + LD A,(BC) + OR A + LD HL,FPONE + JP Z,VCOPY + LD HL,FPNONE + JP VCOPY +; +; COMPUTE SIN(X) X=TOP OF ARGUMENT STACK +; RETURN RESULT IN PLACE OF X +; +ASIN: CALL QUADC ;COMPUTE QUADRANT + LD HL,(ASTKA) + LD D,H + LD E,L + LD BC,FTEMP + CALL AMUL1 ;FTEMP=X*X + POP AF + PUSH AF ;A=QUADRANT + RRA + JP C,SIN10 ;QUAD. ODD, COMPUTE COSINE +; COMPUTE X*P(X*X) -- SINE + LD DE,FTEM1 + LD HL,(ASTKA) + CALL VCOPY ;FTEM1=X*X + LD BC,SINX + CALL POLY ;P(X*X) + CALL PREPOP + LD HL,FTEM1 + CALL AMUL1 ;X*P(X*X) +; COMPUTE SIGN OF RESULT +; POSITIVE FOR QUADRANTS 0,1. NEGATIVE FOR 2,3 +; NEGATE ABOVE FOR NEGATIVE ARGUMENTS +; +SIN5: POP AF ;QUADRANT + LD B,A + POP AF ;SIGN + RLCA ;SIGN, 2 TO THE 1ST BIT + XOR B ;QUADRANT, MAYBE MODIFIED FOR NEG. ARGUMENT + LD HL,(ASTKA) + DEC HL ;PTR TO SIGN + SUB 2 + RET M ;QUADRANT 0 OR 1 + INC (HL) ;ELSE SET RESULT NEGATIVE + RET +; COMPUTE P(X*X) -- COSINE +SIN10: LD BC,COSX + CALL POLY ;P(X*X) + JP SIN5 +; +; COMPUTE COS(X) X=TOP OF ARGUMENT STACK +; RETURN RESULT IN PLACE OF X +; COS(X) = SIN(X+PI/2) +; +ACOS: CALL PREPOP + LD HL,PIC2 ;PI/2 + CALL AADD1 ;TOS=TOS+PI/2 + JP ASIN +; +; COMPUTE TAN(X) X=TOP OF ARGUMENT STACK +; RETURN RESULT IN PLACE OF X +; TAN(X)=SIN(X)/COS(X) +; +ATAN: LD HL,(ASTKA) + CALL PSHAS ;PUSH COPY OF X ONTO ARG STACK + CALL ACOS ;COS(X) + LD DE,FTEM2 + CALL POPA1 ;FTEM2=COS(X) + CALL ASIN + CALL PREPOP + LD HL,FTEM2 + JP ADIV1 ;SIN(X)/COS(X) +; +; COMPUTE SQR(X) X=TOP OF ARGUMENT STACK +; RETURN RESULT IN PLACE OF X +; +ASQR: LD HL,(ASTKA) + LD DE,FTEMP + CALL VCOPY ;SAVE X IN FTEMP +; COMPUTE EXPONENT OF FIRST GUESS AS EXPONENT OF X/2 + LD HL,(ASTKA) + LD A,(HL) + OR A + RET Z ;X=0 + SUB 128 + JP M,SQR5 ;NEGATIVE EXPONENT + RRCA + AND 127 + JP SQR6 +SQR5: CPL + INC A + RRCA + AND 127 + CPL + INC A +SQR6: ADD A,128 + LD (HL),A +; TEST FOR NEGATIVE ARGUMENT + DEC HL + LD A,(HL) + LD BC,'NA' + OR A + JP NZ,ERROR ;NEGATIVE ARGUMENT +; +; DO NEWTON'S METHOD +; NEWGUESS=(X/OLDGUESS + OLDGUESS)/2 + LD A,6 ;DO 6 ITERATIONS +SQR20: PUSH AF ;SET NEW ITERATION COUNT + LD BC,FTEM1 + LD DE,FTEMP ;FTEMP IS 'X' + LD HL,(ASTKA) ;GUESS + CALL ADIV1 ;FTEM1=X/GUESS + LD DE,FTEM1 + LD HL,(ASTKA) + LD B,H + LD C,L + CALL AADD1 ;TOS=(X/GUESS)+GUESS + CALL PREPOP + LD HL,FPTWO + CALL ADIV1 ;TOS=(X/GUESS+GUESS)/2 + POP AF + DEC A ;DECREMENT COUNT + JP NZ,SQR20 ;DO ANOTHER ITERATION + RET +; +; COMPUTE RND(X) X=TOP OF ARGUMENT STACK +; FRAND IS UPDATED TO NEW RANDOM VALUE +; A RANDOM NUMBER IN THE RANGE 0 0 +AINT1: SUB FPNIB-1 + RET NC + LD D,A ;COUNT + DEC BC +AINT2: DEC BC + LD A,(BC) + AND 360Q + LD (BC),A + INC D + RET Z + XOR A + LD (BC),A + INC D + JP NZ,AINT2 + RET +; +; DIMENSION MATRIX +; SYMTAB ADDRESS IN HL, HL NOT CLOBBERED +; DE CONTAINS SIZE IN NUMBER OF ELEMENTS +; +DIMS: PUSH HL + INC DE + PUSH DE + LD HL,0 + LD C,FPSIZ + CALL RADD ;MULTIPLY NELTS BY BYTES PER VALUE + EX DE,HL + LD HL,(MATA) + PUSH HL + ADD HL,DE + CALL STOV ;CHECK THAT STORAGE NOT EXHAUSTED + LD (MATA),HL ;UPDATE MATRIX FREE POINTER + POP BC ;BASE ADDR + POP DE ;NELTS (NUMBER OF ELEMENTS) + POP HL ;SYMTAB ADDR + PUSH HL + LD (HL),D + DEC HL + LD (HL),E + DEC HL + LD (HL),B + DEC HL + LD (HL),C ;SYMTAB ENTRY NOW SET UP + POP HL + RET +; +; FIND VARIABLE OPTIONALLY SUBSCRIPTED IN TEXT +; SETS CARRY IF NOT FOUND +; RETURNS ADDRESS OF VARIABLE IN HL +; UPDATES TXA IF FOUND +; +VAR: CALL ALPHA + RET C + CALL NAME2 + CALL GC + CP LPARRW + JP Z,VAR1 ;TEST IF SUBSCRIPTED +; MUST BE SCALAR VARIABLE + CALL STLK ;RETURNS ENTRY ADDRESS IN HL + OR A ;CLEAR CARRY + RET +; MUST BE SUBSCRIPTED +VAR1: CALL GCI ;GOBBLE LEFT PAREN + LD A,80H + OR C + LD C,A ;SET TYPE TO MATRIX + CALL STLK + PUSH HL ;SYMBOL TABLE + LD DE,10 ;DEFAULT MATRIX SIZE + CALL C,DIMS ;DEFAULT DIMENSION MATRIX + CALL EXPRB ;EVALUATE SUBSCRIPT EXPRESSION + CALL PFIX ;DE NOW HAS INTEGER + LD B,')' + CALL EATC ;GOBBLE RIGHT PAREN + POP HL + DEC HL + CALL DCMP ;BOUNDS CHECK INDEX + JP NC,E5 + DEC HL + DEC HL + CALL LHLI ;GET BASE ADDR + LD C,FPSIZ + INC DE ;BECAUSE BASE ADDR IS TO ELEMENT - 1 + CALL RADD ;ADD INDEX, CLEAR CARRY + RET ;******** CALL, RET????!!!!!********** +; +; JUNK ON END OF STATEMENT, TEST IF AT END OF FILE +; DOES NOT CLOBBER DE +; EATS CHARACTER AND LINE COUNT AFTER CR +; LEAVES NEW TXA IN HL +; SETS CARRY IF END OF FILE +; +JOE: CALL GCI + CP ';' + RET Z + CP CR + JP NZ,E1 + LD A,(HL) + DEC A + JP Z,JOE2 + INC HL + INC HL + INC HL ;SKIP OVER COUNT AND LINE NUMBER +JOE1: LD (TXA),HL + RET +JOE2: SCF + JP JOE1 +; +; GET NAME FROM TEXT +; SETS CARRY IF NAME NOT FOUND +; IF SUCCEEDS RETURNS NAME IN BC, C=0 IF NO DIGIT IN NAME +; +NAME: CALL ALPHA + RET C +NAME2: LD B,A + LD C,0 + CALL DIG + CCF + RET NC + LD C,A + OR A ;CLEAR CARRY + RET +; +; SYMBOL TABLE LOOKUP +; BC CONTAIN NAME AND CLASS +; IF NOT FOUND THEN CREATE ZERO'ED ENTRY AND SET CARRY +; HL HAS ADDRESS ON RET +; +STLK: LD HL,(MEMTOP) + LD DE,-STESIZ ;SET UP BASE AND INCREMENT FOR SEARCH LOOP +STLK0: LD A,(HL) + OR A + JP Z,STLK2 ;TEST IF END OF TABLE + CP B + JP NZ,STLK1 ;TEST IF ALPHA COMPARES + DEC HL + LD A,(HL) ;LOOK FOR DIGIT + CP C + DEC HL + RET Z ;CARRY CLEAR TOO, RETURN + INC HL + INC HL +STLK1: ADD HL,DE ;DIDN'T COMPARE, DECREMENT POINTER + JP STLK0 +; ADD ENTRY TO SYMTAB +STLK2: LD (HL),B + DEC HL + LD (HL),C + INC HL + EX DE,HL + ADD HL,DE + LD (STAA),HL ;STORE NEW END OF STMTAB POINTER + DEC DE + DEC DE + EX DE,HL + SCF + RET +; +; GOBBLES NEXT TEXT CHARACTER IF ALPHABETIC +; SETS CARRY IF NOT +; NEXT CHAR IN ACC ON FAILURE +; +ALPHA: CALL GC + CP 'A' + RET C + CP 'Z'+1 + CCF + RET C + JP DIGT1 +; +; GOBBLES NEXT TEXT CHAR IF DIGIT +; SETS CARRY IF NOT +; NEXT CHAR IN ACC ON FAILURE +; +DIG: CALL GC + CP '0' + RET C + CP '9'+1 + CCF + RET C +DIGT1: INC HL + LD (TXA),HL + RET +; +; COPYS FPSIZ BYTES AT ADDR HL TO ADDR DE +; ON EXIT HL POINTS TO ADR-1 OF LAST BYTE COPIED +; +VCOPY: LD C,FPSIZ +VCOP1: LD A,(HL) + LD (DE),A + DEC HL + DEC DE + DEC C + JP NZ,VCOP1 + RET +; +; PUSH VALUE ADDRESSED BY HL ONTO ARG STACK +; SETS ARGF, CLEARS CARRY +; +PSHAS: EX DE,HL +PSHA1: LD HL,(ASTKA) + LD BC,-FPSIZ + ADD HL,BC + LD (ASTKA),HL ;DECREMENT ARG STACK POINTER + EX DE,HL + CALL VCOPY + LD A,1 + LD (ARGF),A ;CLEAR ARGF + OR A + RET +; +; POP ARG STACK +; HL CONTAINS ADDRESS TO PUT POPPED VALUE INTO +; +POPAS: EX DE,HL +POPA1: LD HL,(ASTKA) + PUSH HL + LD BC,FPSIZ + ADD HL,BC + LD (ASTKA),HL ;INCREMENT STACK POINTER + POP HL + JP VCOPY +; +; PUSH FRAM ONTO CONTROL STACK +; TAKES MINUS AMOUNT TO SUB FROM CSTKA IN DE +; DOES OVERFLOW TEST AND RETURNS OLD CSTKA-1 +; +PSHCS: LD HL,(CSTKA) + PUSH HL + ADD HL,DE + LD (CSTKA),HL + EX DE,HL + LD HL,LCSTKA ;ADDR CONTAINS CSTKL + CALL DCMP + JP C,E4 + POP HL + DEC HL + RET +; +; STORAGE OVERFLOW TEST +; TEST THAT VALUE IN HL IS BETWEEN MATA AND STA +; DOES NOT CLOBBER HL +; +STOV: EX DE,HL + LD HL,MATA + CALL DCMP + JP C,E8 + LD HL,STAA + CALL DCMP + EX DE,HL + RET C +E8: LD BC,'SO' + JP ERROR +; +; INCREMENT TXA IF NEXT NON-BLANK CHAR IS EQUAL TO B +; ELSE SYNTAX ERROR +; +EATC: CALL GCI + CP B + RET Z + JP E1 +; +; GET NEXT NON-BLANK CHAR INTO ACC +; INCREMENT PAST BLANKS ONLY +; +GC: CALL GCI + DEC HL + LD (TXA),HL + RET +; +; GET NEXT NON-BLANK TEXT CHAR AND INCREMENT TXA +; DOES NOT CLOBBER DE,BC +; RETURN CHAR IN ACC +; +GCI: LD HL,(TXA) +GCI0: LD A,(HL) + INC HL + CP ' ' + JP Z,GCI0 + LD (TXA),HL + RET +; +; REPEAT ADD +; ADDS DE TO HL C TIMES +; +RADD: ADD HL,DE + DEC C + JP NZ,RADD + RET +; +; PRINT MESSAGE ADDRESSED BY HL +; ENDS WITH CHARACTER PROVIDED IN C +; RETURN IN HL ADDRESS OF TERMINATOR +; +PRNTCR: LD C,CR + JP PRN1 +PRNT: LD C,'"' +PRN1: LD A,(HL) ;GET NEXT CHAR + LD B,A ;FOR CHOUT + CP C ;END OF MESSAGE TEST + RET Z + CP CR + JP Z,E1 ;NEVER PRINT A CR IN THIS ROUTINE + CALL CHOUT + INC HL + JP PRN1 +; +; 16 BIT UNSIGNED COMPARE +; COMPARE DE AGAINST VALUE ADDRESSED BY HL +; CLOBBERS A ONLY +; +DCMP: LD A,E + SUB (HL) + INC HL + LD A,D + SBC A,(HL) + DEC HL + RET NZ + LD A,E + SUB (HL) + OR A ;CLEAR CARRY + RET +; +; INDIRECT LOAD HL THRU HL +; +LHLI: PUSH AF + LD A,(HL) + INC HL + LD H,(HL) + LD L,A + POP AF + RET +; +; GET FP CONSTANT FROM TEXT +; PUSHES VALUE ON ARG STACK AND SETS ARGF FLAG +; SETS CARRY IF NOT FOUND +; +CONST: LD HL,(TXA) ;PREPARE CALL FPIN + EX DE,HL + LD HL,FPSINK + CALL FPIN + RET C + DEC DE + EX DE,HL + LD (TXA),HL ;NOW POINTS TO TERMINATOR + LD DE,FPSINK + CALL PSHA1 + XOR A + INC A ;SET A TO 1 AND CLEAR CARRY + LD (ARGF),A + RET +; +; DIRECT STATEMENT CHECKING ROUTINE +; +DIRT: LD A,(DIRF) + OR A + RET Z + LD BC,'DI' + JP ERROR +; +; FIND TEXT LINE WITH LINE NUMBER GIVEN IN DE +; RETURNS TEXT ADDRESS COUNT BYTE IN HL +; +FINDLN: LD HL,(BOFA) + LD B,0 +FIND1: LD C,(HL) + LD A,C + CP EOF + JP Z,LERR + INC HL + CALL DCMP + DEC HL + RET Z + ADD HL,BC + JP FIND1 +LERR: LD BC,'LN' + JP ERROR +; +; FIX FLOATING TO POSITIVE INTEGER +; RETURN INTEGER VALUE IN DE +; FP VALUE FROM TOP OF ARG STACK, POP ARG STACK +; +PFIX: LD HL,(ASTKA) + LD B,H + LD C,L + PUSH HL + CALL AINT + LD HL,FPSINK + CALL POPAS + POP HL + LD C,(HL) ;EXPONENT + DEC HL + LD A,(HL) ;SIGN + OR A + JP NZ,E5 ;NEGATIVE NO GOOD + LD DE,-FPSIZ+1 + ADD HL,DE + LD DE,0 + LD A,C + OR A + RET Z + DEC C ;SET UP FOR LOOP CLOSE TEST +PFIX1: INC HL + LD A,(HL) + RRCA + RRCA + RRCA + RRCA + CALL MUL10 + JP C,E5 + DEC C + RET P + LD A,(HL) + CALL MUL10 + JP C,E5 + DEC C + JP M,PFIX1 + RET +; +; TAKE NEXT DIGIT IN A (MASK TO 17Q), ACCUMULATE TO DE +; PRESERVES ALL BUT A, DE +; +MUL10: PUSH HL + INC SP + INC SP + LD H,D ;GET ORIGINAL VALUE TO HL + LD L,E + ADD HL,HL ;DOUBLE IT + RET C + ADD HL,HL ;AGAIN + RET C + ADD HL,DE ;PLUS ORIGINAL MAKES 5 TIMES ORIG + RET C + ADD HL,HL ;TIMES TWO MAKES TEN + RET C + EX DE,HL + DEC SP + DEC SP + POP HL + AND 17Q + ADD A,E + LD E,A + LD A,D + ADC A,0 ;PROPAGATE THE CARRY + LD D,A + RET +; +; GET INTEGER FROM TEXT +; SET CARRY IF NOT FOUND +; RETURN INTEGER VALUE IN HL +; RETURN TERMINATOR IN ACC +; +INTGER: CALL DIG + RET C + LD DE,0 + JP INTG2 +INTG1: CALL DIG + LD H,D + LD L,E + CCF + RET NC +INTG2: SUB '0' + CALL MUL10 + JP NC,INTG1 + RET +; +; CONVERT INTEGER TO STRING +; DE CONTAINS ADDRESS OF STRING, RETURN UPDATED VALUE IN DE +; HL CONTAINS VALUE TO CONVERT +; +CNS: XOR A ;SET FOR NO LEADING ZEROES + LD BC,-10000 + CALL RSUB + LD BC,-1000 + CALL RSUB + LD BC,-100 + CALL RSUB + LD BC,-10 + CALL RSUB + LD BC,-1 + CALL RSUB + RET NZ + LD A,'0' + LD (DE),A + INC DE + RET +; +; TAKE VALUE IN HL +; SUB MINUS NUMBER IN BC THE MOST POSSIBLE TIMES +; PUT VALUE ON STRING AT DE +; IF A=0 THEN DON'T PUT ZERO ON STRING +; RETURN NON-ZERO IN A IF PUT ON STRING +; +RSUB: PUSH DE + LD D,-1 +RSUB1: PUSH HL + INC SP + INC SP + INC D + ADD HL,BC + JP C,RSUB1 + DEC SP + DEC SP + POP HL + LD B,D + POP DE + OR B ;A GETS 0 IF A WAS 0 AND B IS 0 + RET Z + LD A,'0' + ADD A,B + LD (DE),A + INC DE + RET +; +; INPUT CHARACTER FROM TERMINAL +; FORCE TO UPPER CASE. +; +INCHAR: PUSH BC ;SAVE ALL THE REGISTERS + PUSH DE ;THAT MIGHT GET WALKED OVER + PUSH HL ;BY CP/M + LD C,CONIN ;LOAD UP FUNCTION CODE AND + CALL BDOS ;CALL THE SYSTEM. + AND 07FH ;MASK OFF PARITY BIT. + CP 'a' ;CHECK IF LOWER CASE + JP C,INCH1 ;TOO LOW + CP 'z'+1 ;CHECK IF LOWER CASE + JP NC,INCH1 ;TOO HIGH + SUB 20H ;FORCE TO UPPER CASE +INCH1: POP HL ;RESTORE THE REGISTERS + POP DE ;THAT GOT PUSHED + POP BC ;GOING IN. + LD B,A ;COPY CHARACTER TO B AND + RET ;RETURN. +; +INL0: CALL CRLF +INLINE: LD HL,IBUF + LD C,LINLEN +INL1: CALL INCHAR + CP 7FH ;DELETE ? + JP Z,INL2 + CP 15H ;CONTROL U ? + JP Z,INL0 + LD (HL),A + LD B,LF ;IN CASE ALL DONE. + CP CR + JP Z,CHOUT ;ECHO LF AND RETURN. + INC HL + DEC C + JP NZ,INL1 + LD BC,'LL' + JP ERROR +INL2: LD A,C + LD B,BELL + CP LINLEN + JP Z,INL3 + DEC HL + LD B,(HL) ;ECHO DELETED CHARACTER. + INC C +INL3: CALL CHOUT + JP INL1 +; +; TEST CONSOLE STATUS +; +STATUS: PUSH BC ;SAVE ALL THE + PUSH DE ;REGISTERS USED BY + PUSH HL ;CP/M. + LD C,CONSTS ;FIRE OFF THE + CALL BDOS ;CONSOLE STATUS CALL. + POP HL ;RESTORE + POP DE ;ALL + POP BC ;REGISTERS. + AND 01H ;SET FLAGS ON THE STATUS. + RET ;RETURN +; +; OUTPUT ROUTINES +; +CHOUT: PUSH BC ;PUSH THE REGISTERS + PUSH DE ;THAT GET WALKED OVER BY + PUSH HL ;OUR PAL CP/M. + LD C,CONOUT ;LOAD UP THE SYSTEM FUNCTION + LD E,B ;CODE, THEN CALL + CALL BDOS ;THE SYSTEM TO WRITE IT. + POP HL ;RESTORE + POP DE ;ALL THE REGISTERS + POP BC ;WE SAVED. + LD A,B ;GET A COPY OF THE CHARACTER. +; +CHCHK: CP CR + JP NZ,CHLF ;NOT CR, IS IT LF? + XOR A + JP PSTOR ;RETURN PHEAD TO ZERO +; +CHLF: CP LF + JP Z,NULCH ;IF LINE FEED PROCESS THE NULLS + CP 40Q ;NO PHEAD INCREMENT IF CONTROL CHAR + RET C + LD A,(PHEAD) + INC A +PSTOR: LD (PHEAD),A + RET +; +NULCH: LD A,(NULLCT) ;OUTPUT NULL CHARS + OR A + RET Z + PUSH BC + LD C,A + LD B,NULL +CH2: CALL CHOUT ;OUTPUT COUNT "C" NULLS + DEC C + JP NZ,CH2 + POP BC + RET +; +CRLF2: CALL CRLF +CRLF: LD B,CR + CALL CHOUT + LD B,LF + JP CHOUT +; +; CHECK IF PANIC CHARACTER HAS BEEN HIT +; +;PCHECK:LD A,(BRKCHR) +; OR A +; CALL Z,STATUS +; RET Z +PCHECK: CALL STATUS ;ANYTHING TYPED + RET Z ;RET IF NO. + CALL INCHAR ;READ THE CHARACTER IN. + CP ESC + JP Z,STOP1 +; LD (BRKCHR),A + RET +; +; GET INTEGER FROM TERMINAL +; DE CONTAINS STRING TO PRINT FIRST +; HL HAS 1 LESS THAN ACCEPTABLE LOWER BOUND +; THIS ROUTINE GOES TO START IF BAD NUMBER +; INTEGER VALUE RETURNED IN HL +; +GINT: PUSH HL + EX DE,HL + LD A,(PHEAD) + OR A + CALL NZ,CRLF + CALL PRNT + CALL INLINE + LD HL,IBUF + LD (TXA),HL + CALL INTGER + JP C,START + CP CR + JP NZ,START + POP DE + LD (IBUF),HL ;USE IBUF AS A TEMP + LD HL,IBUF + CALL DCMP + JP NC,START + LD HL,(IBUF) ;GET THE VALUE BACK TO HL + LD A,(HL) + CPL + LD (HL),A ;TRY TO STORE THERE + CP (HL) + JP NZ,START ;BAD OR MISSING MEMORY + CPL + LD (HL),A ;PUT IT BACK LIKE IT WAS + RET +; +; OUTPUT FP NUMBER ADDRESSED BY HL +; +FPOUT: LD BC,-DIGIT-1 + ADD HL,BC + LD B,H + LD C,L + LD HL,ABUF ;OUTPUT BUFFER + LD A,(INFES) ;OUTPUT FORMAT + LD (FES),A ;STORE IT + LD E,DIGIT + LD (HL),0 ;CLEAR ROUND-OFF OVERFLOW BUFFER + INC HL ;ABUF+1 +; +NXT: LD A,(BC) ;GET DIGIT AND UNPACK + LD D,A + RRA + RRA + RRA + RRA + AND 17Q ;REMOVE BOTTOM DIGIT + LD (HL),A ;STORE TOP DIGIT IN OUTPUT BUFFER (ABUF) + INC HL + LD A,D ;NOW GET BOTTOM DIGIT + AND 17Q + LD (HL),A ;STORE IT + INC HL + INC BC + DEC E + JP NZ,NXT + LD A,(BC) + LD (FSIGN),A ;STORE SIGN OF NUMBER + XOR A + LD (HL),A ;CLEAR ROUND-OFF BUFFER (ABUF+13) 12 DIGIT NO ROUND + LD HL,XSIGN ;EXPONENT SIGN STORE + LD (HL),A ;CLEAR XSIGN +; +FIX: INC BC ;GET EXPONENT + LD A,(BC) + OR A ;EXPONENT ZERO? + JP Z,ZERO + SUB 128 ;REMOVE EXPONENT BIAS + JP NZ,FIX2 + INC (HL) ;INCREMENT XSIGN TO NEGATIVE FLAG(1) LATER ZERO +FIX2: JP P,CHK13 + CPL ;IT'S A NEGATIVE EXPONENT + INC (HL) ;INCREMENT XSIGN TO NEGATIVE (1) +ZRO: INC A +CHK13: LD HL,EXPO ;EXPONENT TEMP STORE + LD (HL),A + LD E,A + CP DIGIT*2 + LD HL,FES ;FORMAT TEMP BYTE + JP C,CHKXO +CHK40: LD A,1 ;FORCE EXPONENTIAL PRINTOUT + OR (HL) ;SET FORMAT FOR XOUT + LD (HL),A +; +CHKXO: LD A,(HL) ;CHECK IF EXPONENTIAL FORMAT + RRA + JP NC,CHKX3 + AND 17Q + CP DIGIT*2 + JP C,CHKX2 + LD A,DIGIT*2-1 ;MAX DIGITS +CHKX2: LD D,A + INC A + JP ROUND +; +CHKX3: AND 17Q ;ADD EXPONENT AND DECIMAL PLACES + LD D,A + ADD A,E + CP DIGIT*2+1 + LD B,A + JP C,CHKXN + LD A,(HL) + AND 100Q + JP NZ,CHK40 +; +CHKXN: LD A,(XSIGN) ;CHECK EXPONENT SIGN + OR A + JP NZ,XNEG ;IT'S NEGATIVE + LD A,B + JP ROUND +; +XNEG: LD A,D ;SUBTRACT EXPONENT AND DECIMAL PLACE COUNT + SUB E + JP NC,XN2 +XN1: LD A,(INFES) + OR A + JP P,ZERO + AND 16Q + JP Z,ZERO + RRCA + LD E,A + DEC E + LD C,1 + LD HL,ABUF-1 + JP NRND +XN2: JP Z,XN1 + JP ROUND +; +CLEAN: LD B,37Q ;CLEAR FLAGS + AND B + CP DIGIT*2+1 + RET C + LD A,DIGIT*2+1 ;MAX DIGITS OUT + RET +; +; THIS ROUTINE IS USED TO ROUND DATA TO THE +; SPECIFIED DECIMAL PLACE +; +ROUND: CALL CLEAN + LD C,A + LD B,0 + LD HL,ABUF+1 + ADD HL,BC ;GET ROUND-OFF ADDRESS + LD (ADDT),HL + LD A,(HL) + CP 5 ;ROUND IF >=5 + JP C,TRL2-1 +; +LESS1: DEC HL + INC (HL) ;ROUND UP + LD A,(HL) + OR A + JP Z,TRL2 + CP 10 ;CHECK IF ROUNDED NUMBER >9 + JP NZ,TRAIL + LD (HL),0 + JP LESS1 +; +; THIS ROUTINE IS USED TO ELIMINATE TRAILING ZEROES +; +TRAIL: LD HL,(ADDT) + DEC HL +TRL2: LD A,(FES) ;CHECK IF TRAILING ZEROES ARE WANTED + RLA + JP C,FPRNT ;YES- GO PRINT DATA +TRL3: LD A,(HL) + OR A ;IS IT A ZERO? + JP NZ,FPRNT ;NO - GO PRINT + DEC HL + DEC C ;YES - FIX OUTPUT DIGIT COUNT + JP M,ZERO + JP TRL3 +; +; HERE START THE PRINT FORMAT ROUTINES +; +FPRNT: LD HL,ABUF + LD A,(HL) ;CHECK IF ROUNDED UP TO 1 + OR A + JP Z,NRND ;JUMP IF NOT + LD B,1 + LD A,(XSIGN) ;IS EXPONENT NEGATIVE? + OR A + JP Z,POSR + LD B,-1 +; +POSR: LD A,(EXPO) ;GET EXPONENT + OR A + JP NZ,PO2 ;IS IT ZERO (E + 0) + LD (XSIGN),A + LD B,1 +PO2: ADD A,B ;FIX EXPONENT COUNT + LD (EXPO),A + INC E + INC C + DEC HL +; +NRND: INC HL + LD A,C + CP DIGIT*2+1 ;CHECK FOR MAXIMUL DIGITS OUT + JP NZ,NRND1 + DEC C +NRND1: LD A,(FSIGN) ;CHECK IN NEGATIVE NUMBER + RRA + JP NC,PRI22 ;GO OUTPUT RADIX AND NUMBER + CALL NEG ;OUTPUT (-) + JP PRI21 +; +PRI22: CALL SPACE ;OUTPUT A SPACE +PRI21: LD A,(FES) ;GET OUTPUT FORMAT + RRA ;CHECK IF EXPONENTIAL FORMAT + JP C,XPRIN + LD A,(XSIGN) ;GET EXPONENT SIGN + OR A ;CHECK IF NEGATIVE EXPONENT + JP Z,POSIT + LD A,C + OR A + JP NZ,PRIN4 ;OUTPUT RADIX AND NUMBER + CALL ZERO ;NO DIGITS AFTER RADIX, OUTPUT ZERO AND DONE + RET ;****** CALL, RET????!!!******** +; +PRIN4: CALL RADIX ;PRINT DECIMAL POINT + XOR A + OR E + JP Z,PRIN5 ;JUMP IF NO ZEROES TO PRINT + CALL ZERO ;FORCE PRINT A ZERO + DEC E + JP NZ,PRIN4+3 +; +PRIN5: CALL NOUT ;PRINT ASCII DIGIT + JP NZ,PRIN5 + RET +; +POSIT: CALL NOUT + DEC E ;BUMP EXPONENT COUNT + JP NZ,POSIT + LD A,C ;CHECK IF MORE DIGITS TO OUTPUT + OR A + RET Z ;NO, DONE + RET M + JP PRIN4 ;NOW PRINT DECIMAL POINT +; +; GET HERE FOR EXPONENTIAL OUTPUT FORMAT +; +XPRIN: CALL NOUT + JP Z,NDEC ;INTEGER? + CALL RADIX ;NO....PRINT DECIMAL POINT +XPRI2: CALL NOUT + JP NZ,XPRI2 +; +NDEC: LD B,'E' ;OUTPUT 'E' + CALL CHOUT + LD A,(XSIGN) + OR A + JP Z,XPRI3 + CALL NEG ;PRINT EXPONENT SIGN (-) + LD A,(EXPO) + INC A + JP XOUT2 +XPRI3: LD B,'+' ;EXPONENT (+) + CALL CHOUT +; +; THIS ROUTINE IS USED TO CONVERT THE EXPONENT +; FROM BINARY TO ASCII AND PRINT THE RESULT +; +XOUT: LD A,(EXPO) + DEC A +XOUT2: LD C,100 + LD D,0 + CALL CONV + CP '0' ;SKIP LEADING ZEROES + JP Z,XO21 + INC D + CALL CHOUT +XO21: LD A,E + LD C,10 + CALL CONV + CP '0' + JP NZ,XO3 + DEC D + JP NZ,XO4 +XO3: CALL CHOUT +XO4: LD A,E + ADD A,'0' ;ADD ASCII BIAS + LD B,A + CALL CHOUT + RET ;****** CALL, RET?????!!!!!***** +CONV: LD B,'0'-1 + INC B + SUB C + JP NC,CONV+2 + ADD A,C + LD E,A + LD A,B + RET +; +; THIS ROUTINE ADD ASCII BIAS TO A BCD DIGIT +; AND CALLS THE OUTPUT ROUTINE +; +NOUT: LD A,(HL) + ADD A,'0' + LD B,A + CALL CHOUT + INC HL + DEC C ;DECREMENT TOTAL DIGITS OUT COUNT + RET +; +; COMMON SYMBOL LOADING ROUTINES +; +NEG: LD B,'-' + JP CHOUT +ZERO: LD B,'0' + JP CHOUT +SPACE: LD B,' ' + JP CHOUT +RADIX: LD B,'.' + JP CHOUT +; +; CONVERTS FP STRING AT DE, UPDATE DE PAST TERMINATOR +; PUTS TERMINATOR IN B, PUTS FP NUMBER AT ADDRESS IN HL +; SETS CARRY IF NOT FOUND +; +FPIN: PUSH HL + PUSH DE + EX DE,HL + DEC HL + LD (ADDS),HL + LD HL,OPST ;CLEAR TEMPORARY STORAGE AREAS AND BC BUFFER + LD C,DIGIT+6 + CALL CLEAR +; +SCANC: LD DE,0 + LD HL,BCX ;BC=PACK BUFFER +SCAN0: LD (BCADD),HL ;PACK BUFFER POINTER +SCANP: LD HL,SCANP + PUSH HL ;USED FOR RETURN FROM OTHER ROUTINES + XOR A + LD (XSIGN),A ;CLEAR EXPONENT SIGN BYTE +; +SCANG: CALL IBSCN + JP C,SCANX ;FOUND A NUMBER, GO PACK IT + CP '.' ;RADIX? + JP Z,SCAN5 ;PROCESS RADIX POINTERS + CP 'E' ;EXPONENT? + JP Z,EXCON ;FOUND 'E', GO PROCESS EXPONENT +; NOT A CHARACTER LEGAL IN NUMBER + LD B,A ;MOVE TERMINATOR TO B + LD A,(OPST) ;CHECK IF ANY DIGITS YET + AND 20Q + JP NZ,ENTR2 +; GET HERE IF LEGAL FP NUMBER NOT FOUND +FPIN1: POP HL ;SCANP LINK + POP DE ;TEXT POINTER + POP HL ;FP # ADDR + SCF + RET +; FOUND DECIMAL POINT +SCAN5: XOR A ;FOUND RADIX PROCESS RADIX POINTERS FOR EXP + OR D ;ANY DIGITS YET? + JP NZ,SCAN6 + ADD A,300Q ;SET ECNT - STOP COUNTING DIGITS + OR E ;NO INT DIGITS, BIT 7 IS COUNT/DON'T COUNT FLAG + LD E,A ;BIT 6 IS NEGATIVE EXPONENT FLAG + RET +SCAN6: LD A,200Q ;SET ECNT TO COUNT DIGITS + OR E + LD E,A + RET +; +SCANX: AND 17Q ;FOUND NUMBER-REMOVE ASCII BIAS + LD B,A + LD HL,OPST ;SET FIRST CHARACTER FLAG + LD A,60Q + OR (HL) + LD (HL),A + XOR A + OR B ;IS CHARACTER ZERO? + JP NZ,PACK + OR D ;LEADING ZERO? IE. ANY INT DIGITS? + JP NZ,PACK + OR E + LD E,A + RET Z ;IF COUNTING YET + INC E ;ECNT+1-COUNT ZEROS FOR EXPONENT COUNT + RET +; +; THIS SUBROUTINE BCD PACKS DIGITS INTO REG BC +; +PACK: LD A,E + RLA + JP C,PACK1 + INC E +PACK1: LD A,E + LD (ECNT),A ;DIGIT COUNT FOR EXPONENT COUNT + INC D ;TOTAL DIGIT COUNT (D ALSO HAS TOP/BOTM FLAG BIT 7) + LD A,D + AND 177Q ;REMOVE TOP/BOTM FLAG + CP DIGIT*2+1 ;LIMIT INPUT DIGITS + RET NC + XOR A + OR D + JP M,BOTM +; +TOP: OR 200Q ;SET MSB FOR TOP FLAG + LD D,A + LD A,B + LD HL,(BCADD) ;GET BC ADDRESS + RLCA + RLCA + RLCA + RLCA + LD (HL),A ;SAVE CHAR IN BC + RET +; +BOTM: AND 177Q ;STRIP MSB (BOTTOM FLAG) + LD D,A + LD A,B + LD HL,(BCADD) + OR (HL) ;OR IN TOP NUMBER + LD (HL),A ;PUT NUMBER BACK IN BC + INC HL + POP BC + JP SCAN0 +IBSCN: LD HL,(ADDS) ;INPUT BUFFER POINTER + INC HL ;GET NEXT BYTE + LD A,(HL) + CP ' ' + JP Z,IBSCN+3 + LD (ADDS),HL ;NOTE: THIS ROUTINE FALLS THROUGH +; THIS ROUTINE CHECKS FOR ASCII NUMBERS +NMCHK: CP '9'+1 + RET NC + CP '0' + CCF + RET +; +; THIS ROUTINE IS USED TO ADJUST A NUMBER IN BC BUFFER +; AND RETURNS VALUE +; +ENTR2: LD DE,0 +ENT1: PUSH BC ;TERMINATOR + CALL FIXE ;NORMALIZE FLOATING POINT NUMBER + POP BC ;TERMINATOR + POP DE ;SCANP LINK + POP DE ;OLD TEXT ADDR + POP DE ;RETURN ADDR + LD C,DIGIT+2 + LD HL,BCX+DIGIT+1 + CALL VCOPY + LD HL,(ADDS) + EX DE,HL + INC DE + OR A + RET +; +; THIS ROUTINE IS USED TO CLEAR STORAGE AREAS +; THE STARTING ADDRESS IS IN HL AND THE COUNT +; IS IN C +; +CLEAR: XOR A + LD (HL),A + INC HL + DEC C + JP NZ,CLEAR+1 + RET +; +; THIS ROUTINE CONVERTS THE ASCII EXPONENT OF +; THE NUMBER IN THE INPUT BUFFER TO BINARY, AND +; NORMALIZES THE EXPONENT ACCORDING TO THE INPUT +; FORMAT OF THE NUMBER +; +EXCON: CALL IBSCN ;GET CHARACTER + JP C,EXC3 + CP PLSRW ;CHECK FOR UNARY SIGNS + JP Z,EXC4 + CP '+' + JP Z,EXC4 + CP '-' + JP Z,EXC2 + CP MINRW + JP NZ,FPERR ;NO SIGN OR NUMBER? +EXC2: LD A,1 + LD (XSIGN),A ;SAVE SIGN +EXC4: CALL IBSCN + JP NC,FPERR ;NO NUMBER? +EXC3: CALL ASCDC ;CONVERT ASCII TO BINARY + JP ENT1 ;NORMALIZE NUMBER AND RETURN +; +; THIS ROUTINE CONVERTS ASCII TO BINARY +; THREE CONSECUTIVE NUMBERS < 128 MAY BE CONVERTED +; +ASCDC: EX DE,HL + LD HL,0 +ASC1: LD A,(DE) ;GET CHR FROM INPUT BUFFER-NO SPACES ALLOWED + CALL NMCHK ;CHECK IF NUMBER + JP NC,ASC2 + SUB '0' ;REMOVE ASCII BIAS + LD B,H + LD C,L + ADD HL,HL + ADD HL,HL + ADD HL,BC + ADD HL,HL + LD C,A + LD B,0 + ADD HL,BC + INC DE + JP ASC1 +ASC2: EX DE,HL + LD B,A ;SAVE TERMINATOR + LD (ADDS),HL ;SAVE IBUF ADDRESS + LD A,D + OR A + JP NZ,FPERR ;TOO BIG >255 + LD A,E + RLA + JP C,FPERR ;TOO BIG >127 + RRA + RET +FPERR: POP BC ;ASCDC RET LINK + JP FPIN1 +; +; THIS ROUTINE NORMALIZES THE INPUT NUMBER +; +FIXE: EX DE,HL + LD A,(BCX) + OR A ;IS IT ZERO? + JP Z,ZZ2 + CALL CHKPN ;SET EXPONENT POSITIVE/NEGATIVE + ADD A,200Q ;ADD EXPONENT BIAS +ZZ2: LD (BCX+DIGIT+1),A ;STORE NORMALIZED EXPONENT IN BC + RET +; +CHKPN: LD A,(ECNT) ;GET EXPONENT COUNT-SET IN 'SCAN' ROUTINE + LD E,A + AND 77Q ;STRIP BITS 7&8 + LD B,A + LD A,(XSIGN) + OR A + JP Z,LPOS ;EXPONENT IS POSITIVE + INC H ;SET SIGN IN H ** THIS SHOULD BE INR H NOT INX H + LD A,100Q ;L IS NEGATIVE + AND E ;CHECK IF E IS NEGATIVE + JP Z,EPOS + LD A,L ;BOTH E & L NEGATIVE + LD L,B + CALL BPOS+1 + CPL + INC A + RET ;BACK TO FIXE +; +EPOS: LD A,L ;E&L NEGATIVE + CPL + INC A ;TWO'S COMP A + ADD A,B + RET ;TO FIXE +; +LPOS: LD A,100Q ;EXPONENT POSITIVE + AND E ;IS E NEGATIVE? + JP Z,BPOS + LD A,B + LD B,L + JP EPOS+1 +; +BPOS: LD A,B ;E&L POSITIVE + ADD A,L + RET P +; + POP HL + JP FPERR + DEFB 10H + DEFW 0 + DEFB 1 +FPNONE: DEFB 129 +; +; FLOATING POINT MATH PACKAGE +; +; EACH FUNCTION OPERATES AS FOLLOWS: (BC) = (DE) # (HL) +; WHERE BC IS ADDRESS OF RESULT +; DE IS ADDRESS OF 1ST ARGUMENT +; HL IS ADDRESS OF 2ND ARGUMENT +; AND # IS ONE OF THE OPERATORS +,-,*,/ +; +; ON ENTRY ALL ADDRESS POINT TO THE EXPONENT PART OF THE +; FLOATING POINT ARGUMENT +; +; THE NUMBER ZERO IS REPRESENTED BY A ZERO EXPONENT +; +; ALL NUMBERS ARE ASSUMED TO BE NORMALIZED +; +FADD: PUSH BC + CALL EXPCK ;FETCH ARGUMENTS + LD C,0 +ADSUM: DEC DE + EX DE,HL + LD A,(SIGN) + XOR (HL) ;FORM SIGN OF RESULT + LD B,A + EX DE,HL + LD A,(DE) + DEC DE + XOR C + LD (SIGN),A + LD HL,RCTRL ;ROUNDING CONTOL FLAG + LD A,(HL) + OR A + INC HL + LD A,(HL) ;GET ROUNDING DIGIT + JP Z,ADS8 + RLCA + RLCA + RLCA + RLCA +ADS8: ADD A,0B0H ;FORCE CARRY IF DIGIT > 5 + LD A,B + RRA + JP C,ADS1 ;HAVE SUBTRACTION + RLA ;RESTORE CARRY + CALL ADDX ;PERFORM ADDITION + JP NC,ADS2 + LD B,4 + CALL RIGHT + LD HL,EXP + INC (HL) ;INCREMENT EXPONENT + JP Z,OVER +ADS2: POP BC ;GET RESULTS ADDRESS + CALL STORE ;SAVE RESULTS + RET ;******* CALL, RET????!!!!******** +ZEREX: POP HL + JP ADS2 +ADDX: LD HL,BUF+DIGIT-1 + LD B,DIGIT +ADD1: LD A,(DE) + ADC A,(HL) + DAA + LD (HL),A + DEC HL + DEC DE + DEC B + JP NZ,ADD1 + RET NC + INC (HL) + RET +; +; FLOATING POINT SUBTRACTION +; +FSUB: PUSH BC + CALL EXPCK ;GET ARGUMENTS + LD A,(SIGN) + XOR 1 ;COMPLEMENT SIGN + LD (SIGN),A + JP ADSUM +ADS1: RLA ;RESTORE CARRY + CCF ;COMPLEMENT FOR ROUNDING + CALL SUBX ;SUBTRACT ARGUMENTS + LD HL,SIGN + JP C,ADS4 + LD A,(HL) ;GET SIGN + XOR 1 ;COMPLEMENT + LD (HL),A +ADS7: DEC HL + LD B,DIGIT +ADS3: LD A,9AH + SBC A,(HL) ;COMPLEMENT RESULT + ADD A,0 + DAA + LD (HL),A + DEC HL + DEC B + CCF + JP NZ,ADS3 +ADS4: LD HL,BUF + LD BC,DIGIT +ADS5: LD A,(HL) + OR A + JP NZ,ADS6 + INC HL + INC B + INC B + DEC C + JP NZ,ADS5 + XOR A ;********* NOT NEEDED + LD (EXP),A + JP ADS2 +ADS6: CP 10H + JP NC,ADS9 + INC B +ADS9: LD HL,EXP + LD A,(HL) + SUB B + JP Z,UNDER + JP C,UNDER + LD (HL),A + LD A,B + RLCA + RLCA + LD B,A + CALL LEFT + JP ADS2 +SUBX: LD HL,BUF+DIGIT-1 + LD B,DIGIT +SUB1: LD A,99H + ADC A,0 + SUB (HL) + EX DE,HL + ADD A,(HL) + DAA + EX DE,HL + LD (HL),A + DEC HL + DEC DE + DEC B + JP NZ,SUB1 + RET +; +; FLOATING POINT MULTIPLY +; +FMUL: PUSH BC + LD A,(HL) + OR A ;ARGUMENT = 0? + JP Z,FMUL1+2 + LD A,(DE) + OR A ;ARGUMENT =0? + JP Z,FMUL1+2 + ADD A,(HL) ;FORM RESULT EXPONENT + JP C,FMOVR + JP P,UNDER + JP FMUL1 +FMOVR: JP M,OVER +FMUL1: SUB 128 ;REMOVE EXCESS BIAS + LD (EXP),A ;SAVE EXPONENT + DEC DE + DEC HL + LD A,(DE) + XOR (HL) ;FORM RESULT SIGN + DEC HL + DEC DE + PUSH HL + LD HL,SIGN ;GET SIGN ADDRESS + LD (HL),A ;SAVE SIGN + DEC HL + XOR A + LD B,DIGIT+2 +FMUL2: LD (HL),A ;ZERO WORKING BUFFER + DEC HL + DEC B + JP NZ,FMUL2 + LD A,(EXP) + OR A + JP Z,ZEREX + LD C,DIGIT + LD HL,HOLD1+DIGIT +; GET MULTIPLIER INTO HOLDING REGISTER +FMUL3: LD A,(DE) + LD (HL),A ;PUT IN REGISTER + DEC HL + DEC DE + DEC C + JP NZ,FMUL3 + LD (HL),C + DEC HL + LD B,250 ;SET LOOP COUNT +FMUL4: LD DE,DIGIT+1 + LD C,E + ADD HL,DE + EX DE,HL + ADD HL,DE ;H,L=NEXT HOLDING REGISTER + INC B + JP P,FMUL8 ;FINISHED +FMUL5: LD A,(DE) ;GET DIGITS + ADC A,A ;TIMES 2 + DAA + LD (HL),A ;PUT IN HOLDING REGISTER + DEC DE + DEC HL + DEC C + JP NZ,FMUL5 + INC B ;INCREMENT LOOP COUNT + JP NZ,FMUL4 +; +; FORM 10X BY ADDING 8X AND 2X +; FIRST GET 8X + INC HL + LD DE,HOLD5 ;NEXT HOLDING REGISTER + LD C,DIGIT+1 + LD B,C +FMUL6: LD A,(HL) + LD (DE),A + INC HL + INC DE + DEC C + JP NZ,FMUL6 + LD HL,HOLD2+DIGIT ;GET 2X + DEC DE +FMUL7: LD A,(DE) + ADC A,(HL) ;FORM 10X + DAA + LD (DE),A + DEC DE + DEC HL + DEC B + JP NZ,FMUL7 + LD B,249 + EX DE,HL + JP FMUL4 +FMUL8: EX DE,HL + INC HL + LD (HL),DIGIT+1 ;SET NEXT LOOP COUNT +; PERFORM ACCUMULATION OF PRODUCT +FMUL9: POP BC ;GET MULTIPLIER + LD HL,HOLD8+DIGIT+1 + DEC (HL) ;DECREMENT LOOP COUNT + JP Z,FMU14 ;FINISHED + LD A,(BC) + DEC BC + PUSH BC + DEC HL + EX DE,HL +FMU10: ADD A,A ;CHECK FOR BIT IN CARRY + JP C,FMU11 ;FOUND A BIT + JP Z,FMU12 ;ZERO - FINISHED THIS DIGIT + LD HL,-DIGIT-1 + ADD HL,DE ;POINT TO NEXT HOLDING REGISTER + EX DE,HL + JP FMU10 +FMU11: LD C,A + OR A ;CLEAR CARRY + CALL ADDX ;ACCUMULATE PRODUCT + LD A,(DE) + ADD A,(HL) + DAA + LD (HL),A + LD A,C + DEC DE + JP FMU10 +; ROTATE RIGHT 1 BYTE +FMU12: LD B,8 + CALL RIGHT + JP FMUL9 +FMU14: LD A,(BUF) + AND 0F0H ;CHECK IF NORMALIZING + JP Z,FMU17 + LD A,D + AND 0F0H + LD HL,SIGN-1 + JP FMU18 +FMU17: LD B,4 + LD HL,EXP + DEC (HL) + JP Z,UNDER + CALL LEFT ;NORMALIZE + LD A,D ;GET DIGIT SHIFTED OFF +; PERFORM ROUNDING + RRCA + RRCA + RRCA + RRCA +FMU18: CP 50H + JP C,FMU16 + INC A + AND 0FH + LD C,DIGIT +FMU15: ADC A,(HL) + DAA + LD (HL),A + LD A,0 + DEC HL + DEC C + JP NZ,FMU15 +; CHECK FOR ROUNDING OVERFLOW + JP NC,ADS2 ;NO OVERFLOW + INC HL + LD (HL),10H + LD HL,EXP + INC (HL) + JP NZ,ADS2 + JP OVER +; ROUNDING NOT NEEDED +FMU16: AND 0FH + ADD A,(HL) + LD (HL),A + JP ADS2 +; +; FLOATING POINT DIVISION +; +FDIV: PUSH BC + LD A,(HL) ;FETCH DIVISOR EXP + OR A ;DIVIDE BY ZERO? + JP Z,DIVZ + LD A,(DE) + OR A ;DIVIDEND 0? + JP Z,INSP + SUB (HL) + JP C,DIVUN + JP M,OVER + JP FDI1 +DIVUN: JP P,UNDER +FDI1: ADD A,129 ;FORM QUOTIENT EXP + LD (EXPD),A + EX DE,HL + PUSH DE + CALL LOAD ;FETCH DIVIDEND + POP DE + EX DE,HL + LD A,(SIGN) + DEC HL + XOR (HL) ;FORM QUOTIENT SIGN + LD (SIGND),A + EX DE,HL + DEC DE + LD BC,HOLD1 +DIV0: LD L,DIGIT+DIGIT +DIV1: PUSH BC + PUSH HL + LD C,0 ;QUOTIENT DIGIT = 0 +DIV3: SCF ;SET CARRY + LD HL,BUF+DIGIT-1 + LD B,DIGIT +DIV4: LD A,99H + ADC A,0 + EX DE,HL + SUB (HL) + EX DE,HL + ADD A,(HL) + DAA + LD (HL),A + DEC HL + DEC DE + DEC B + JP NZ,DIV4 + LD A,(HL) + CCF + SBC A,0 + LD (HL),A + RRA + LD HL,DIGIT + ADD HL,DE + EX DE,HL + INC C ;INCREMENT QUOTIENT + RLA + JP NC,DIV3 + OR A ;CLEAR CARRY + CALL ADDX ;RESTORE DIVIDEND + LD HL,DIGIT + ADD HL,DE + EX DE,HL + PUSH BC + LD B,4 + CALL LEFT ;SHIFT DIVIDEND + POP BC + DEC C + POP HL + LD H,C + POP BC + LD A,L + JP NZ,DIV5 + CP DIGIT+DIGIT + JP NZ,DIV5 + LD HL,EXPD + DEC (HL) + CALL Z,UNDER + JP DIV0 +DIV5: RRA + LD A,H + JP NC,DIV6 + LD A,(BC) + RLCA + RLCA + RLCA + RLCA + ADD A,H + LD (BC),A ;STORE QUOTIENT + INC BC + JP DIV7 +DIV6: LD (BC),A ;STORE QUOTIENT +DIV7: DEC L ;DECREMENT DIGIT COUNT + JP NZ,DIV1 + LD HL,EXPD + POP BC + CALL STORO + RET ;***** CALL, RET????!!!!!******* +; +; FETCH AND ALIGN ARGUMENTS FOR +; ADDITION AND SUBTRACTION +; +EXPCK: LD A,(DE) + SUB (HL) ;DIFFERENCE OF EXPONENTS + LD C,0 + JP NC,EXPC1 + INC C + EX DE,HL + CPL + INC A +EXPC1: LD B,A + LD A,(DE) + LD (EXP),A + LD A,B + CP DIGIT+DIGIT + JP C,EXPC2 + LD A,DIGIT+DIGIT +EXPC2: RLCA + RLCA + LD B,A + AND 4 + LD (RCTRL),A ;SET ROUNDING CONTROL + PUSH BC + PUSH DE + CALL LOAD ;LOAD SMALLER VALUE + LD A,8*DIGIT+16 + SUB B + CP 8*DIGIT+16 + JP Z,EXPC3 + AND 0F8H + RRA + RRA + RRA + ADD A,E + LD E,A + LD A,D + ADC A,0 + LD D,A + LD A,(DE) ;GET ROUNDING DIGIT + LD (RDIGI),A ;SAVE +EXPC3: CALL RIGHT ;ALIGN VALUES + POP DE + POP BC + RET +; LOAD ARGUMENT INTO BUFFER +LOAD: LD DE,SIGN + LD C,DIGIT+1 + DEC HL +LOAD1: LD A,(HL) + LD (DE),A + DEC HL + DEC DE + DEC C + JP NZ,LOAD1 + XOR A + LD (DE),A + DEC DE + LD (DE),A + LD (RDIGI),A ;ZERO ROUNDING DIGIT + RET +; STORE RESULTS IN MEMORY +STORE: LD HL,EXP +STORO: LD E,DIGIT+2 +STOR1: LD A,(HL) + LD (BC),A + DEC BC + DEC HL + DEC E + JP NZ,STOR1 + RET +; SHIFT RIGHT NUMBER OF DIGITS +; IN B/4 +RIGHT: LD C,DIGIT+1 +RIGH1: LD HL,BUF-1 + LD A,B + SUB 8 ;CHECK IF BYTE CAN BE SHIFTED + JP NC,RIGH3 + DEC B + RET M + OR A +RIGH2: LD A,(HL) + RRA + LD (HL),A + INC HL + DEC C + JP NZ,RIGH2 + JP RIGHT +; SHIFT RIGHT ONE BYTE +RIGH3: LD B,A + XOR A +RIGH4: LD D,(HL) + LD (HL),A + LD A,D + INC HL + DEC C + JP NZ,RIGH4 + JP RIGHT +; SHIFT LEFT NUMBER OF DIGITS +; IN B/4 +LEFT: LD C,DIGIT+1 + LD HL,SIGN-1 +LEF1: LD A,B + SUB 8 + JP NC,LEF3 + DEC B + RET M + OR A +LEF2: LD A,(HL) + RLA + LD (HL),A + DEC HL + DEC C + JP NZ,LEF2 + JP LEFT +; SHIFT LEFT ONE BYTE +LEF3: LD B,A + XOR A +LEF4: LD D,(HL) + LD (HL),A + LD A,D + DEC HL + DEC C + JP NZ,LEF4 + JP LEFT +; SET FLAGS FOR OVERFLOW, UNDERFLOW, +; AND DIVIDE BY ZERO +DIVZ: +OVER: LD BC,'FP' + JP ERROR +UNDER: LD A,-1 + LD (ERRI),A +INSP: INC SP + INC SP + RET +; +; FLOATING POINT RAM +; +HOLD1: DEFS DIGIT+1 +HOLD2: DEFS DIGIT+1 +HOLD3: DEFS DIGIT+1 +HOLD4: DEFS DIGIT+1 +HOLD5: DEFS DIGIT+1 +HOLD6: DEFS DIGIT+1 +HOLD7: DEFS DIGIT+1 +HOLD8: DEFS DIGIT+1 + DEFS 1 +ERRI: DEFS 1 ;ERROR FLAG + DEFS 1 +BUF: DEFS DIGIT ;WORKING BUFFER +SIGN: DEFS 1 ;SIGN BIT +EXP: DEFS 1 ;EXPONENT +RC \ No newline at end of file diff --git a/BASIC5.S.ORIG#000000 b/BASIC5.S.ORIG#000000 new file mode 100644 index 0000000..c772188 --- /dev/null +++ b/BASIC5.S.ORIG#000000 @@ -0,0 +1,3551 @@ +; +; PROCESSOR TECHNOLOGY BASIC-5 +; USING ZILOG OPCODES, COURTESY OF A SED FILE +; +; SYSTEM GLOBAL EQUATES +; +BDOS EQU 0005H ;ADDRESS OF JUMP TO BDOS +CONIN EQU 1 ;CONSOLE IN +CONOUT EQU 2 ;CONSOLE OUT +CONSTS EQU 11 ;CONSOLE STATUS +FPSIZ EQU 5 +LINLEN EQU 73 ;# OF CHARS IN LEGAL INPUT LINE +FP123 EQU FPSIZ-2 +FPNIB EQU FP123*2 +DIGIT EQU FPNIB/2 +CR EQU 15Q ;CARRIAGE RETURN +NULL EQU 0 +LF EQU 12Q ;LINE FEED +ESC EQU 3Q ;CONTROL C +EOF EQU 1 ;END OF FILE +BELL EQU 7 ;BELL CHARACTER +STESIZ EQU 2+FPSIZ ;SYMBOL TABLE ELEMENT SIZE +OPBASE EQU '(' +FTYPE EQU 1 ;CONTROL STACK FOR ENTRY TYPE +FORSZ EQU FPSIZ*2+2+2+1 ;'FOR' CONTROL STACK ENTRY SIZE +GTYPE EQU 2 ;CONTROL STACK GOSUB ENTRY TYPE +ETYPE EQU 0 ;CONTROL STACK UNDERFLOW TYPE +UMINUS EQU 61Q ;UNARY MINUS +; +; STARTUP BASIC SYSTEM +; + ORG 100H +; +START: LD SP,CMNDSP + XOR A + LD (NULLCT),A ;NULL COUNT. + LD HL,BASEND ;START OF USER MEMORY + LD (BOFA),HL ;IS RIGHT AFTER THE BASIC CODE. + LD HL,(BDOS+1) ;THE ADDRESS OF BDOS IS + LD (MEMTOP),HL ;THE END OF USER MEMORY. +ST0: LD HL,PLS ;"PROGRAM LOADED?" MESSAGE + CALL PRNT + CALL INLINE + LD A,(IBUF) +; +; OPTIONAL ENTRY POINT FOR TAPE OR DISK ROUTINES +; +; ALLOWS DIRECT PROGRAM INPUT FROM HIGH SPEED DEVICES +; SEE OPERATING INSTRUCTIONS FOR PROPER IMPLEMENTATION +; +STAR1: CP 'N' + JP Z,ST1 ;IF NO PROGRAM CLEAR AND INITIALIZE + CP 'Y' + JP NZ,ST0 + LD HL,(BOFA) +ST2: LD A,(HL) ;FIND END OF PROGRAM + CP EOF + JP Z,ST3 + CALL ADR + JP ST2 +ST3: LD (EOFA),HL + CALL CCLEAR + JP ST4 +ST1: CALL CSCR +ST4: LD A,2*FPNIB + LD (INFES),A +; INITIALIZE RANDOM NUMBER + LD DE,FRAND + LD HL,RANDS + CALL VCOPY ;FRAND=RANDOM NUMBER SEED +; +; COMMAND PROCESSOR +; +CMND1: CALL CRLF2 + LD HL,RDYS ;PRINT READY MESSAGE + CALL PRNT +CMNDR: LD A,1 ;SET DIRECT INPUT FLAG + LD (DIRF),A + LD SP,CMNDSP + CALL CRLF +CMND2: CALL INLINE ;GET INPUT LINE FROM OPERATOR + CALL PP ;PRE-PROCESS IT + JP C,CMND3 + CALL LINE ;LINE NUMBER...GO EDIT + JP CMND2 +CMND3: CALL CMND4 + JP CMNDR +CMND4: LD HL,IBUF ;POINT TO COMMAND OR STATEMENT + LD (TXA),HL + CALL GC + AND 240Q + CP 240Q ;CHECK FOR COMMAND + LD DE,CMNDD + JP Z,ISTA1 ;PROCESS COMMAND + CALL ISTAT ;PROCESS STATEMENT (IF ALLOWED) + CALL GCI + CP CR + RET Z +E1: LD BC,'BS' + JP ERROR +; ERROR MESSAGE PRINTOUT +E3: LD BC,'BA' + JP ERROR +E4: LD BC,'CS' + JP ERROR +E5: LD BC,'OB' + JP ERROR +E6: LD BC,'DM' +; +ERROR: PUSH BC + CALL CRLF + POP BC + CALL CHOUT + LD B,C + CALL CHOUT + LD HL,ERS +ERM1: CALL PRNT + LD A,(DIRF) + OR A + JP NZ,CMND1 + LD HL,INS + CALL PRNT +; FIND LINE NUMBER + LD HL,(BOFA) +ERM2: LD B,H + LD C,L + LD E,(HL) + LD D,0 + ADD HL,DE + EX DE,HL + LD HL,TXA + CALL DCMP + EX DE,HL + JP C,ERM2 + INC BC + LD A,(BC) + LD L,A + INC BC + LD A,(BC) + LD H,A + LD DE,IBUF ;USE IBUF TO ACCUMULATE THE LINE NUMBER STRING + CALL CNS + LD A,CR + LD (DE),A + LD HL,IBUF + CALL PRNTCR + JP CMND1 +; +; LINE EDITOR +; +LINE: LD HL,(BOFA) ;CHECK FOR EMPTY FILE +FIN: LD A,(HL) ;CHECK IF APPENDING LINE AT END + DEC A + JP Z,APP + EX DE,HL + INC DE + LD HL,(IBLN) ;GET INPUT LINE NUMBER + EX DE,HL + CALL DCMP ;COMPARE WITH FILE LINE NUMBER + DEC HL + JP C,INSR ;LESS THAN + JP Z,INSR ;EQUAL + LD A,(HL) ;LENGTH OF LINE + CALL ADR ;JUMP FORWARD + JP FIN +; APPEND LINE AT END CASE +APP: LD A,(IBCNT) ;DON'T APPEND NULL LINE + CP 4 + RET Z + CALL FULL ;CHECK FOR ROOM IN FILE + LD HL,(EOFA) ;PLACE LINE IN FILE + CALL IMOV + LD (HL),EOF + LD (EOFA),HL + RET +; INSERT LINE IN FILE CASE +INSR: LD B,(HL) ;OLD LINE COUNT + LD (INSA),HL ;INSERT LINE POINTER + LD A,(IBCNT) ;NEW LINE COUNT + JP C,LT ;JMP IF NEW LINE # NOT = OLD LINE NUMBER + SUB 4 + JP Z,LT1 ;TEST IF SHOULD DELETE NULL LINE + ADD A,4 +LT1: SUB B + JP Z,LIN1 ;LINE LENGTHS EQUAL + JP C,GT +; EXPAND FILE FOR NEW OR LARGER LINE +LT: LD B,A + LD A,(IBCNT) + CP 4 ;DON'T INSERT NULL LINE + RET Z + LD A,B + CALL FULL + LD HL,(INSA) + CALL NMOV + LD HL,(EOFA) + EX DE,HL + LD (EOFA),HL + INC BC + CALL RMOV + JP LIN1 +; CONTRACT FILE FOR SMALLER LINE +GT: CPL + INC A + CALL ADR + CALL NMOV + EX DE,HL + LD HL,(INSA) + CALL NZ,LMOV + LD (HL),EOF + LD (EOFA),HL +; INSERT CURRENT LINE INTO FILE +LIN1: LD HL,(INSA) + LD A,(IBCNT) + CP 4 + RET Z +; INSERT CURRENT LINE AT ADDR HL +IMOV: LD DE,IBCNT + LD A,(DE) + LD C,A + LD B,0 +; COPY BLOCK FROM BEGINNING +; HL IS DEST ADDR, DE IS SOURCE ADDR, BC IS COUNT +LMOV: LD A,(DE) + LD (HL),A + INC DE + INC HL + DEC BC + LD A,B + OR C + JP NZ,LMOV + RET +; COPY BLOCK STARTING AT END +; HL IS DEST, DE IS SOURCE, BC IS COUNT +RMOV: LD A,(DE) + LD (HL),A + DEC HL + DEC DE + DEC BC + LD A,B + OR C + JP NZ,RMOV + RET +; COMPUTE FILE MOVE COUNT +; BC GETS (EOFA) - (HL), RET Z SET MEANS ZERO COUNT +NMOV: LD A,(EOFA) + SUB L + LD C,A + LD A,(EOFA+1) + SBC A,H + LD B,A + OR C + RET +; ADD A TO HL +ADR: ADD A,L + LD L,A + RET NC + INC H + RET +; CHECK FOR FILE OVERFLOW, LEAVES NEW EOFA IN DE +; A HAS INCREASE IN SIZE +FULL: LD HL,(EOFA) + CALL ADR + EX DE,HL + LD HL,MEMTOP + CALL DCMP + JP NC,E8 + RET +; +; COMMANDS +; +CSCR: LD HL,(BOFA) + LD (HL),EOF + LD (EOFA),HL +; "CLEAR" +CCLEAR: LD HL,(EOFA) ;CLEAR FROM EOFA TO MEMTOP + INC HL + LD (MATA),HL + EX DE,HL + LD HL,MEMTOP ;END OF ASSIGNED MEMORY +CCLR1: XOR A + LD (DE),A + CALL DCMP + INC DE + JP NZ,CCLR1 + LD HL,(MEMTOP) + LD (STAA),HL + LD HL,CSTKL+CSTKSZ-1 + LD (HL),ETYPE + LD (CSTKA),HL + LD HL,ASTKL+ASTKSZ+FPSIZ-1 + LD (ASTKA),HL + RET +; "NULL" +CNULL: CALL INTGER + JP C,E3 ;NO ARGUMENT SUPPLIED + LD A,L + LD (NULLCT),A + JP CMND1 +; "LIST" +CLIST: CALL GC + CP CR + LD DE,0 + JP Z,CL0 ;JUMP IF NO ARGUMENT SUPPLIED + CALL INTGER ;ERROR DEFAULT IS LIST +CL0: LD HL,(BOFA) +CL1: LD A,(HL) + DEC A + RET Z + INC HL + CALL DCMP + DEC HL ;POINT TO COUNT CHAR AGAIN + JP C,CL2 + JP Z,CL2 +; INCREMENT TO NEXT LINE + LD A,(HL) + CALL ADR + JP CL1 +CL2: PUSH DE + LD DE,IBUF ;AREA TO UNPREPROCESS TO + CALL UPPL + INC HL + PUSH HL + LD HL,IBUF + CALL PRNTCR + CALL PCHECK + CALL CRLF + POP HL + POP DE + JP CL1 +; "RUN" +CRUN: CALL CCLEAR + LD HL,(BOFA) + LD A,(HL) + DEC A ;CHECK FOR NULL PROGRAM + JP Z,ENDX + INC HL + INC HL + INC HL + LD (TXA),HL + LD (RTXA),HL ;POINTER FOR 'READ' STATEMENT + XOR A + LD (DIRF),A ;CLEAR DIRECT FLAG AND FALL THROUGH TO DRIVER + CALL CRLF +; +; INTERPRETER DRIVER +; +ILOOP: CALL PCHECK + CALL ISTAT ;INTERPRET CURRENT STATEMENT + CALL JOE ;TEST FOR JUNK ON END + JP NC,ILOOP ;CONTINUE IF NOT AT END OF PROGRAM + JP ENDX ;EXECUTE END STATEMENT +; INTERPRET STATEMENT LOCATED BY TXA +ISTAT: CALL GC ;GET FIRST NON BLANK + OR A + JP P,LET ;MUST BE LET IF NOT RW + CP IRWLIM ;IS IT AN INITIAL RW + JP NC,E1 + LD DE,STATD ;STATEMENT DISPATCH TABLE BASE +ISTA1: CALL GCI ;ADVANCE TEXT POINTER + AND 37Q + RLCA ;MULTIPLY BY TWO PREPARING FOR TABLE LOOKUP + LD L,A + LD H,0 + ADD HL,DE + CALL LHLI + JP (HL) ;BRANCK TO STATEMENT OR COMMAND +; +; STATEMENTS +; +; "LET" +LET: CALL VAR ;CHECK FOR VARIABLE + JP C,E1 + PUSH HL ;SAVE VALUE ADDRESS + LD B,EQRW + CALL EATC + CALL EXPRB + POP DE ;DESTINATION ADDRESS + CALL POPA1 ;COPY EXPR VALUE TO VARIABLE + RET ;******* CALL, RET???!!!**************** +; "FOR" +SFOR: CALL DIRT + CALL VAR ;CONTROL VARIABLE + JP C,E1 + PUSH HL ;CONTROLVARIABLE VALUE ADDRESS + LD B,EQRW + CALL EATC + CALL EXPRB ;INITIAL VALUE + POP DE ;VARIABLE VALUE ADDRESS + PUSH DE ;SAVE + CALL POPA1 ;SET INITIAL VALUE + LD B,TORW ;RW FOR 'TO' + CALL EATC + CALL EXPRB ;LIMIT VALUE COMPUTATION + CALL GC ;CHECK NEXT CHARACTER FOR POSSIBLE STEP EXPR + CP STEPRW + JP Z,FOR1 +; USE STEP OF 1 + LD DE,FPONE + CALL PSHA1 + JP FOR2 +; COMPUTE STEP VALUE +FOR1: CALL GCI ;EAT THE STEP RW + CALL EXPRB ;THE STEP VALUE +; HERE THE STEP AND LIMIT ARE ON THE ARG STACK +FOR2: LD DE,-2 ;PREPARE TO ALLOCATE 2 BYTES ON CONTROL STACK + CALL PSHCS ;RETURNS ADDRESS OF THOSE 2 BYTES IN HL + EX DE,HL + CALL JOE ;TEST FOR JUNK ON END + JP C,E4 ;NO "FOR" STATEMENT AT END OF PROGRAM + EX DE,HL ;DE HAS LOOP TEST ADDR, HL HAS CONTROL STACK ADR + LD (HL),D ;HIGH ORDER TEXT ADDRESS BYTE + DEC HL + LD (HL),E ;LOW ORDER TEXT ADDRESS BYTE + LD DE,-FPSIZ ;ALLOCATE SPACE FOR LIMIT ON CONTROL STACK + CALL PSHCS + PUSH HL ;ADDR ON CONTROL STACK FOR LIMIT + LD DE,-FPSIZ ;ALLOCATE SPACE FOR STEP ON CONTROL STACK + CALL PSHCS + CALL POPAS ;COPY STEP VALUE TO CONTROL STACK + POP DE ;CONTROL STACK ADDR FOR LIMIT VLAUE + CALL POPA1 ;LIMIT VALUE TO CONTROL STACK + LD DE,-3 ;ALLOCATE SPACE FOR TEST ADDRESS AND CS ENTRY + CALL PSHCS + POP DE ;CONTROL VARIABLE ADDRESS + LD (HL),D ;HIGH ORDER BYTE OF CONTROL VAR ADDR + DEC HL + LD (HL),E ;LOW ORDER BYTE + DEC HL + LD (HL),FTYPE ;SET CONTROL STACK ENTRY TYPE FOR "FOR" + JP NEXT5 ;GO FINISH OFF CAREFULLY +; "NEXT" +NEXT: CALL DIRT + LD HL,(CSTKA) ;CONTROL STACK ADDRESS + LD A,(HL) ;STACK ENTRY TYPE BYTE + DEC A ;MUST BE FOR TYPE ELSE ERROR + JP NZ,E4 ;IMPROPER NEXTING ERROR + INC HL ;CONTROL STACK POINTER TO CONTROL VAR ADDR + PUSH HL + CALL VAR ;CHECK VARIABLE, IN CASE USER WANTS + JP C,NEXT1 ;SKIP CHECK IF VAR NOT THERE + EX DE,HL + POP HL ;CONTROL VARIABLE ADDRESS + PUSH HL ;SAVE IT AGAIN + CALL DCMP + JP NZ,E4 ;IMPROPER NESTING IF NOT THE SAME +NEXT1: POP HL ;CONTROL VARIABLE ADDRESS + PUSH HL + PUSH HL + LD DE,FPSIZ+2-1 ;COMPUTE ADDRESS TO STEP VALUE + ADD HL,DE + EX (SP),HL ;NOW ADDRESS TO VAR IN HL + CALL LHLI ;VARIABLE ADDRESS + LD B,H ;COPY VAR ADDRESS TO BC + LD C,L + POP DE ;STEP VALUE ADDRESS + PUSH DE + CALL FADD ;DO INCREMENT + POP HL ;STEP VALUE + DEC HL ;POINT TO SIGN OF STEP VALUE + LD A,(HL) ;SIGN 0=POS, 1=NEG + LD DE,FPSIZ+1 + ADD HL,DE ;PUTS LIMIT ADDRESS IN HL + EX DE,HL + POP HL ;VARIABLE ADDRESS + CALL LHLI ;GET ADDRESS + PUSH DE ;SAVE CONTROL STACK POINTER TO GET TEXT ADDR + OR A ;SET CONDITIONS BASED ON SIGN OF STEP VALUE + JP Z,NEXT2 ;REVERSE TEST ON NEGATIVE STEP VALUE + EX DE,HL +NEXT2: LD B,H ;SET UP ARGS FOR COMPARE + LD C,L + CALL RELOP ;TEST <= + POP DE ;TEXT ADDRESS + JP M,NEXT3 ;STILL SMALLER? + JP Z,NEXT3 ;JUMP IF WANT TO CONTINUE LOOP +; TERMINATE LOOP + LD HL,3 ;REMOVE CSTACK ENTRY + ADD HL,DE + LD (CSTKA),HL + RET +NEXT3: INC DE ;TEXT ADDRESS + EX DE,HL + CALL LHLI ;GET TEXT ADDRESS IN HL +; ITERATE, SKIPPING NORMAL JUNK ON END TEST AT ILOOP +NEXT4: EX DE,HL ;SAVE NEW TEXT ADDRESS IN DE + CALL JOE + EX DE,HL +NEXT6: LD (TXA),HL +NEXT5: LD HL,ILOOP + EX (SP),HL + RET ;TO DISPATCHER SKIPPING JOE CALL THERE +; "IF" +SIF: LD B,1 ;SPECIFY PRINCIPAL OPERATOR IS RELATIONAL + CALL EXPB1 + LD HL,(ASTKA) ;ADDRESS ON BOOLEAN VALUE ON ARG STACK + INC (HL) ;SETS ZERO CONDITION IF RELATIONAL TEST TRUE + PUSH AF ;SAVE CONDITIONS TO TEST LATER + CALL POPAS ;REMOVE VALUE FROM ARG STACK COPY TO SELF + POP AF + JP NZ,REM ;IF TEST FALSE TREAT REST OF STATEMENT AS REM +; TEST SUCCEEDED + LD B,THENRW + CALL EATC + CALL INTGER ;CHECK IF LINE NUMBER IS DESIRED ACTION + JP C,ISTAT + JP GOTO1 +; "GOTO" +SGOTO: XOR A + LD (DIRF),A ;CLEAR DIRECT STATEMENT FLAG + CALL INTGER ;RETURNS INTEGER IN HL IF LINE NUMBER PRESENT + JP C,E1 ;SYNTAX ERROR NO LINE NUMBER +GOTO1: EX DE,HL ;LN IN DE + CALL FINDLN ;RETURNS TEST ADDRESS POINTS TO COUNT VALUE +GOTO2: INC HL + INC HL + INC HL ;ADVANCE TEXT POINTER PAST LINE NUMBER ANDCOUNT + JP NEXT4 +; "GOSUB" +GOSUB: CALL DIRT + LD DE,-3 ;CREATE CONTROL STACK ENTRY + CALL PSHCS + PUSH HL ;SAVE STACK ADDRESS + CALL INTGER + JP C,E1 + EX DE,HL ;LINE NUMBER TO DE + CALL JOE + LD B,H + LD C,L + POP HL ;STACK ADDRESS + LD (HL),B ;STACK RETURN ADDRESS RETURNED BY JOE + DEC HL + LD (HL),C + DEC HL + LD (HL),GTYPE ;MAKE CONTROL STACK ENTRY TYPE "GOSUB" + CALL FINDLN + INC HL + INC HL + INC HL + JP NEXT6 +; "RETURN" +RETRN: CALL DIRT + LD (DIRF),A ;CLEARS DIRF IN ACC IS CLEAR + LD HL,(CSTKA) +RET1: LD A,(HL) + OR A ;CHECK FOR STACK EMPTY + JP Z,E4 + CP GTYPE ;CHECK FOR GOSUB TYPE + JP Z,RET2 +; REMOVE FOR TYPE ENTRY FROM STACK + LD DE,FORSZ + ADD HL,DE + JP RET1 +; FOUND A GTYPE STACK ENTRY +RET2: INC HL + LD E,(HL) ;LOW ORDER TEXT ADDRESS + INC HL + LD D,(HL) ;HIGH ORDER TEXT ADDRESS + INC HL ;ADDRESS OF PREVIOUS CONTROL STACK ENTRY + LD (CSTKA),HL + EX DE,HL ;PUT TEXT ADDRESS IN HL + LD A,(HL) ;ADDRESS POINTS TO EOF IF GOSUB WAS LAST LINE + DEC A ;END OF FILE? + JP NZ,NEXT4 + JP ENDX +; "DATA" AND "REM" +DATA: CALL DIRT ;DATA STATEMENT ILLEGAL AS DIRECT +REM: CALL GCI + CP CR + JP NZ,REM + DEC HL ;BACKUP POINTER SO NORMAL JOE WILL WORK + LD (TXA),HL + RET +; "DIM" +DIM: CALL NAME ;LOOK FOR VARIABLE NAME + JP C,E1 + LD A,C ;PREPARE TURN ON 80H BIT TO SIGNIFY MATRIX + OR 80H + LD C,A + CALL STLK + JP NC,E6 ;ERROR IF NAME ALREADY EXISTS + PUSH HL ;SYMBOL TABLE ADDRESS + LD B,LPARRW + CALL EATC + CALL EXPRB + LD B,')' + CALL EATC + CALL PFIX ;RETURN INTEGER IN DE + LD HL,MATUB ;MAXIMUM SIZE FORM MATRIX + CALL DCMP + JP NC,E6 + POP HL ;SYMBOL TABLE ADDRESS + CALL DIMS + CALL GC ;SEE IF MORE TO DO + CP ',' + RET NZ + CALL GCI ;EAT THE COMMA + JP DIM +; "STOP" +STOP: CALL DIRT +STOP1: CALL CRLF2 + LD (BRKCHR),A + LD HL,STOPS + JP ERM1 +; "END" +ENDX EQU CMND1 +; "READ" +READ: CALL DIRT + LD HL,(TXA) + PUSH HL ;SAVE TXA TEMPORARILY + LD HL,(RTXA) ;THE 'READ' TXA +READ0: LD (TXA),HL + CALL GCI + CP ',' + JP Z,READ2 ;PROCESS INPUT VALUE + CP DATARW + JP Z,READ2 + DEC A + JP Z,READ4 +; SKIP TO NEXT LINE + CALL REM ;LEAVES ADDRESS OF LAST CR IN HL + INC HL + LD A,(HL) + DEC A + JP Z,READ4 + INC HL + INC HL + INC HL ;HL NOW POINTS TO FIRST BYTE ON NEXT LINE + JP READ0 +; PROCESS VALUE +READ2: CALL EXPRB + CALL GC + CP ',' ;SKIP JOE TEST IF COMMA + JP Z,READ3 +; JUNK ON END TEST + CALL JOE +READ3: LD HL,(TXA) + LD (RTXA),HL ;SAVE NEW "READ" TEXT ADDRESS + POP HL ;REAL TXA + LD (TXA),HL + CALL VAR + JP C,E1 + CALL POPAS ;PUT READ VALUE INTO VARIABLE + CALL GC + CP ',' ;CHECK FOR ANOTHER VARIABLE + RET NZ + CALL GCI ;EAT THE COMMA + JP READ +READ4: POP HL ;PROGRAM TXA + LD (TXA),HL + LD BC,'RD' + JP ERROR +; "RESTORE" +RESTOR: LD HL,(BOFA) ;BEGINNING OF FILE POINTER + INC HL + INC HL + INC HL + LD (RTXA),HL + RET +; "PRINT" +PRINT: CALL GC + CP CR ;CHECK FOR STAND ALONE PRINT + JP Z,CRLF +PRIN2: CP '"' + JP Z,PSTR ;PRINT THE STRING + CP TABRW + JP Z,PTAB ;TABULATION + CP '%' + JP Z,PFORM ;SET FORMAT + CP CR + RET Z + CP ';' + RET Z + CALL EXPRB ;MUST BE EXPRESSION TO PRINT + LD DE,FPSINK + CALL POPA1 ;POP VALUE TO FPSINK + LD A,(PHEAD) + CP 56 + CALL NC,CRLF ;DO CRLF IF PRINT HEAD IS PAST 56 + LD HL,FPSINK + CALL FPOUT + LD B,' ' + CALL CHOUT +PR1: CALL GC ;GET DELIMITER + CP ',' + JP NZ,CRLF +PR0: CALL GCI + CALL GC + JP PRIN2 +PSTR: CALL GCI ;GOBBLE THE QUOTE + CALL PRNT ;PRINT UP TO DOUBLE QUOTE + INC HL ;MOVE POINTER PAST DOUBLE QUOTE + LD (TXA),HL + JP PR1 +PFORM: LD A,2*FPNIB + LD (INFES),A + CALL GCI ;GOBBLE PREVIOUS CHAR +PFRM1: CALL GCI + LD HL,INFES + CP '%' ;DELIMITER + JP Z,PR1 + LD B,80H + CP 'Z' ;TRAILING ZEROS? + JP Z,PF1 + LD B,1 + CP 'E' ;SCIENTIFIC NOTATION? + JP Z,PF1 + CALL NMCHK + JP NC,E1 + SUB '0' ;NUMBER OF DECIMAL PLACES + RLCA + LD B,A + LD A,(HL) + AND 301Q + LD (HL),A +PF1: LD A,(HL) + OR B + LD (HL),A + JP PFRM1 +PTAB: CALL GCI ;GOBBLE TAB RW + LD B,LPARRW + CALL EATC + CALL EXPRB + LD B,')' + CALL EATC + CALL PFIX +PTAB1: LD A,(PHEAD) + CP E + JP NC,PR1 + LD B,' ' + CALL CHOUT + JP PTAB1 +; "INPUT" +INPUT: CALL GC + CP ',' + JP Z,NCRLF + CALL CRLF +INP0: LD B,'?' + CALL CHOUT +LINP: CALL INLINE + LD DE,IBUF +IN1: PUSH DE ;SAVE FOR FPIN + CALL VAR + JP C,E1 + POP DE + LD B,0 + LD A,(DE) + CP '+' ;LOOK FOR LEADING PLUS OR MINUS ON INPUT + JP Z,IN2 + CP '-' + JP NZ,IN3 + LD B,1 +IN2: INC DE +IN3: PUSH BC + PUSH HL + CALL FPIN ;INPUT FP NUMBER + JP C,INERR + POP HL + DEC HL + POP AF + LD (HL),A + CALL GC + CP ',' + RET NZ ;DONE IF NO MORE + CALL GCI ;EAT THE COMMA + LD A,B ;GET THE TERMINATOR TO A + CP ',' + JP Z,IN1 ;GET THE NEXT INPUT VALUE FROM STRING +; GET NEW LINE FROM USER + LD B,'?' + CALL CHOUT + JP INP0 +NCRLF: CALL GCI + JP LINP ;NOW GET LINE +INERR: LD BC,'IN' + JP ERROR +; +; EVALUATE AN EXPRESSION FROM TEXT +; HL TAKE OP TABLE ADDR OF PREVIOUS OPERATOR (NOT CHANGED) +; RESULT VALUE LEFT ON TOP OF ARG STACK, ARGF LEFT TRUE +; +EXPRB: LD B,0 +EXPB1: LD HL,OPBOL + XOR A + LD (RELTYP),A +; ZERO IN B MEANS PRINCIPAL OPERATOR MAY NOT BE RELATIONAL +EXPR: PUSH BC + PUSH HL ;PUSH OPTBA + XOR A + LD (ARGF),A +EXPR1: LD A,(ARGF) + OR A + JP NZ,EXPR2 + CALL VAR ;LOOK FOR VARIABLE PERHAPS SUBSCRIPTED + CALL NC,PSHAS + JP NC,EXPR2 + CALL CONST + JP NC,EXPR2 + CALL GC + CP LPARRW + LD HL,OPLPAR + JP Z,XLPAR +; ISN'T OR SHOULDN'T BE AN ARGUMENT +EXPR2: CALL GC + CP 340Q ;CHECK FOR RESERVED WORD OPERATOR + JP NC,XOP + CP 300Q ;CHECK FOR BUILT IN FUNCTION + JP NC,XBILT +; ILLEGAL EXPRESSION CHARACTER + POP HL ;GET OPTBA + LD A,(ARGF) + OR A + JP Z,E1 +XDON1: POP AF + LD HL,RELTYP ;CHECK IF LEGAL PRINCIPAL OPERATOR + CP (HL) + RET Z + JP E1 +XOP: AND 37Q ;CLEANS OFF RW BITS + LD HL,(ARGF) ;TEST FOR ARGF TRUE + DEC L + JP Z,XOP1 +; ARGF WAS FALSE, UNARY OPS ONLY POSSIBILITY + CP '-'-OPBASE + JP Z,XOPM + CP '+'-OPBASE + JP NZ,E1 + CALL GCI ;EAT THE '+' + JP EXPR1 +XOPM: LD A,UMINUS-OPBASE +XOP1: CALL OPADR + POP DE ;PREVIOUS OPTBA + LD A,(DE) + CP (HL) + JP NC,XDON1 ;NON-INCREASING PRECEDENCE +; INCREASING PRECEDENCE CASE + PUSH DE ;SAVE PREVIOUS OPTBA + PUSH HL ;SAVE CURRENT OPTBA + CALL GCI ;TO GOBBLE OPERATOR + POP HL + PUSH HL + LD B,0 ;SPECIFY NON-RELATIONAL + CALL EXPR + POP HL +; HL HAS OPTBA ADDRESS +; SET UP ARGS AND PERFORM OPERATION ACTION +XOP2: PUSH HL + LD A,(HL) + LD HL,(ASTKA) + LD B,H + LD C,L + AND 1 + JP NZ,XOP21 +; DECREMENT STACK POINTER BY ONE VALUE BINARY CASE + LD DE,FPSIZ + ADD HL,DE + LD (ASTKA),HL + LD D,H + LD E,L +XOP21: LD HL,EXPR1 + EX (SP),HL ;CHANGE RETURN LINK + INC HL ;SKIP OVER PRECEDENCE + CALL LHLI ;LOAD ACTION ADDRESS + JP (HL) +; +; ACTION ROUTINE CONVENTION +; DE LEFT ARG AND RESULT FOR BINARY +; BC RIGHT ARG FOR BINARY, ARG AND RESULT FOR UNARY +; +; INTRINSIC FUNCTION PROCESSING +; +XBILT: CALL GCI ;EAT TOKEN + AND 77Q ;CLEAN OFF RW BITS + LD HL,(ARGF) ;BUILT IN FUNCTION MUST COME AFTER OPERATOR + DEC L + JP Z,E1 + CALL OPADR ;OPTBA TO HL +XLPAR: PUSH HL + LD B,LPARRW + CALL EATC + CALL EXPRB + LD B,')' + CALL EATC + POP HL ;CODE FOR BUILT-IN FUNCTION + JP XOP2 +; COMPUTE OPTABLE ADDRESS FOR OPERATOR IN ACC +OPADR: LD C,A + LD B,0 + LD HL,OPTAB + ADD HL,BC + ADD HL,BC + ADD HL,BC ;OPTAB ENTRY ADDR IS 3*OP+BASE + RET +; +; PREPROCESSOR, UN-PREPROCESSOR +; PREPROCESS LINE IN IBUF BACK INTO IBUF +; SETS CARRY IF LINE HAS NO LINE NUMBER +; LEAVES CORRECT LENGTH OF LINE AFTER PREPROCESSING IN IBCN +; IF THERE IS A LINE NUMBER, IT IS LOCATED AT IBLN=IBUF-2 +; TXA IS CLOBBERED +; +PP: LD HL,IBUF ;FIRST CHARACTER OF INPUT LINE + LD (TXA),HL ;SO GCI WILL WORK + CALL INTGER ;SETS CARRY IF NO LINE NUMBER + LD (IBLN),HL ;STORE LINE NUMBER VALUE(EVEN IF NONE) + PUSH AF ;SAVE STATE OF CARRY BIT FOR RETURNING + LD HL,(TXA) ;ADDRESS OF NEXT CHARACTER IN IBUF + LD C,4 ;SET UP INITIAL VALUE FOR COUNT + LD DE,IBUF ;INITIALIZE WRITE POINTER +; COME HERE TO CONTINUE PREPROCESSING +PPL: PUSH DE + LD DE,RWT ;BASE OF RWT +PPL1: PUSH HL ;SAVE TEXT ADDRESS + LD A,(DE) ;RW VALUE FOR THIS ENTRY IN RWT + LD B,A ;SAVE IN B IN CASE OF MATCH +PPL2: INC DE ;ADVANCE ENTRY POINTER TO NEXT BYTE + LD A,(DE) ;GET NEXT CHARACTER FROM ENTRY + CP (HL) ;COMPARE WITH CHARACTER IN TEXT + JP NZ,PPL3 + INC HL ;ADVANCE TEXT POINTER + JP PPL2 ;CONTINUE COMPARISON +; COME HERE WHEN COMPARISON OF BYTE FAILED +PPL3: OR A + JP M,PPL6 ;JUMP IF FOUND MATCH +; SCAN TO BEGINNING ON NEXT ENTRY +PPL4: INC DE ;ADVANCE ENTRY POINTER + LD A,(DE) ;NEXT BYTE IS EITHER CHARACTER OR RW BYTE + OR A + JP P,PPL4 ;KEEP SCANNING IF NOT RW BYTE +; NOW SEE IF AT END OF TABLE, AND FAIL OR RETURN CONDITION + POP HL ;RECOVER ORIGINAL TEXT POINTER + XOR -1 ;CHECK FOR END OF TABLE BYTE + JP NZ,PPL1 ;CONTINUE SCAN OF TABLE +; DIDN'T FIND AN ENTRY AT THE GIVER TEXT ADR + POP DE + LD A,(HL) ;GET THE TEXT CHARACTER + CP CR ;CHECK FOR END OF LINE + JP Z,PPL8 ;GO CLEAN UP AND RETURN + LD (DE),A + INC DE + INC C + INC HL ;ADVANCE TEXT POINTER + CP '"' ;CHECK FOR QUOTED STRING POSSIBILITY + JP NZ,PPL ;RESTART RWT SEARCH AT NEXT CHARACTER POSITION +; HERE WE HAVE A QUOTED STRING, SO EAT TILL ENDQUOTE +PPL5: LD A,(HL) ;NEXT CHARACTER + CP CR + JP Z,PPL8 ;NO STRING ENDQUOTE, LET INTERPRETER WORRY + LD (DE),A + INC DE + INC C + INC HL ;ADVANCE TEXT POINTER + CP '"' + JP Z,PPL ;BEGIN RWT SCAN FROM NEW CHARACTER POSITION + JP PPL5 +; FOUND MATCH SO PUT RW VALUE IN TEXT +PPL6: POP AF ;REMOVE UNNEEDED TEST POINTER FROM STACK + POP DE + LD A,B + LD (DE),A + INC DE + INC C + JP PPL +; COME HERE WHEN DONE +PPL8: LD A,CR + LD (DE),A + LD HL,IBCNT ;SET UP COUNT IN CASE LINE OF LINE NUMBER + LD (HL),C + POP AF ;RESTORE CARRY CONDITION (LINE NUMBER FLAG) + RET +; +; UN-PREPROCESS LINE ADDRESSES IN HL TO DE BUFFER +; RETURN SOURCE ADDRESS OF CR IN HL ON RETURN +; +UPPL: INC HL ;SKIP OVER COUNT BYTE + PUSH HL ;SAVE SOURCE TEXT POINTER + CALL LHLI ;LOAD LINE NUMBER VALUE + CALL CNS ;CONVERT LINE NUMBER + LD A,' ' + LD (DE),A ;PUT BLANK AFTER LINE NUMBER + INC DE ;INCREMENT DESTINATION POINTER + POP HL + INC HL ;INCREMENT H PAST LINE NUMBER +UPP0: INC HL + LD A,(HL) ;NEXT TOKEN IN SOURCE + OR A + JP M,UPP1 ;JUMP IF TOKEN IS RW + LD (DE),A ;PUT CHARACTER IN BUFFER + CP CR ;CHECK FOR DONE + RET Z + INC DE ;ADVANCE DESTINATION BUFFER ADDRESS + JP UPP0 +; COME HERE WHEN RW BYTE DETECTED IN SOURCE +UPP1: PUSH HL ;SAVE SOURCE POINTER + LD HL,RWT ;BASE OF RWT +UPP2: CP (HL) ;SEE IF RW MATCHED RWT ENTRY + INC HL ;ADVANCE RWT POINTER + JP NZ,UPP2 ;CONTINUE LOOKING IF NOT FOUND +; FOUND MATCH, ENTRY POINTER LOCATES FIRST CHARACTER +UPP3: LD A,(HL) ;CHARACTER OF RW + OR A ;CHECK FOR DONE + JP M,UPP4 + LD (DE),A + INC DE + INC HL + JP UPP3 +; COME HERE IF DONE WITH RW TRANSFER +UPP4: POP HL ;SOURCE POINTER + JP UPP0 +; +; CONSTANTS AND TABLES +; +RDYS: DEFM 'READY"' +PLS: DEFM 'PROGRAM LOADED? "' +ERS: DEFM ' ERROR"' +INS: DEFM ' IN LINE "' +STOPS: DEFM 'STOP"' +; + DEFB 0FFH ;FLAGS END OF SINE COEFFICIENT LIST + DEFB 0 + DEFB 1*16 + DEFW 0 + DEFB 0 +FPONE: DEFB 129 ;EXPONENT +; SINE COEFFICIENT LIST +; NOTE: THE FLOATING PNT 1 ABOVE IS A PART OF THIS TABLE + DEFB 16H + DEFB 66H + DEFB 67H + DEFB 1 + DEFB 128 ;-.166667 E 0 (-1/3!) + DEFB 83H + DEFB 33H + DEFB 33H + DEFB 0 + DEFB 128-2 ;.833333 E-2 (1/5!) + DEFB 19H + DEFB 84H + DEFB 13H + DEFB 1 + DEFB 128-3 ;-.198413 E-3 (-1/7!) + DEFB 27H + DEFB 55H + DEFB 73H + DEFB 0 + DEFB 128-5 ;.275573 E-5 (1/9!) + DEFB 25H + DEFB 5 + DEFB 21H + DEFB 1 +SINX: DEFB 128-7 ;-.250521 E-7 (-1/11!) +; COSINE COEFFICIENT LIST + DEFB 0FFH ;MARKS END OF LIST + DEFB 0 + DEFB 10H + DEFB 0 + DEFB 0 + DEFB 0 + DEFB 128+1 ;/100000 E 1 (1/1!) + DEFB 50H + DEFB 0 + DEFB 0 + DEFB 1 +MATUB: DEFB 128 ;-.500000 E 0 (-1/2!) + DEFB 41H + DEFB 66H + DEFB 67H + DEFB 0 +RANDS: DEFB 128-1 ;.416667 E-1 (1/4!) + DEFB 13H + DEFB 88H + DEFB 89H + DEFB 1 + DEFB 128-2 ;-.138889 E-2 (-1/6!) + DEFB 24H + DEFB 80H + DEFB 16H + DEFB 0 + DEFB 128-4 ;.248016 E-4 (1/8!) + DEFB 27H + DEFB 55H + DEFB 73H + DEFB 1 +COSX: DEFB 128-6 ;-.275573 E-6 (-1/10!) + DEFB 20H + DEFW 0 + DEFB 0 +FPTWO: DEFB 129 + DEFB 15H + DEFB 70H + DEFB 80H + DEFB 0 +PIC2: DEFB 128+1 ;PI/2 + DEFB 63H + DEFB 66H + DEFB 20H + DEFB 0 +PIC1: DEFB 128 ;2/PI +LCSTKA: DEFW CSTKL +; +; COMMAND TABLE +; +CMNDD: DEFW CRUN ; 0 + DEFW CLIST ; 1 + DEFW CNULL ; 2 + DEFW CSCR ; 3 + DEFW START ; 4 SET UP MEMORY BOUNDS + DEFW TSAV ; 5 TAPE SAVE + DEFW TLOAD ; 6 TAPE LOAD +; STATEMENT TABLE +STATD: DEFW LET ; 0 + DEFW NEXT ; 1 + DEFW SIF ; 2 + DEFW SGOTO ; 3 + DEFW GOSUB ; 4 + DEFW RETRN ; 5 + DEFW READ ; 6 + DEFW DATA ; 7 + DEFW SFOR ; 10 + DEFW PRINT ; 11 + DEFW INPUT ; 12 + DEFW DIM ; 13 + DEFW STOP ; 14 + DEFW ENDX ; 15 + DEFW RESTOR ; 16 + DEFW REM ; 17 + DEFW CCLEAR ; 20 +; +; R/W WORD TABLE FORMAT IS RESERVED WORD FOLLOWED BY CHR +; OF RESERVED WORD. LAST ENTRY IS FOLLOWED BY A 377Q +; RW'S THAT ARE SUBSTRINGS OF OTHER RW'S (E.G. >) MUST +; FOLLOW THE LARGER WORD. +; +RWT: DEFB 200Q + DEFM 'LET' + DEFB 201Q + DEFM 'NEXT' + DEFB 202Q + DEFM 'IF' + DEFB 203Q + DEFM 'GOTO' + DEFB 204Q + DEFM 'GOSUB' + DEFB 205Q + DEFM 'RETURN' + DEFB 206Q + DEFM 'READ' + DEFB 207Q + DEFM 'DATA' +DATARW EQU 207Q + DEFB 210Q + DEFM 'FOR' + DEFB 211Q + DEFM 'PRINT' + DEFB 211Q + DEFM ':' + DEFB 212Q + DEFM 'INPUT' + DEFB 213Q + DEFM 'DIM' + DEFB 214Q + DEFM 'STOP' + DEFB 215Q + DEFM 'END' + DEFB 216Q + DEFM 'RESTORE' + DEFB 217Q + DEFM 'REM' + DEFB 220Q + DEFM 'CLEAR' +CLRRW EQU 220Q +IRWLIM EQU 221Q ;LAST INITIAL RESERVED WORD VALUE+1 + DEFB 237Q + DEFM 'STEP' +STEPRW EQU 237Q + DEFB 236Q + DEFM 'TO' +TORW EQU 236Q + DEFB 235Q + DEFM 'THEN' +THENRW EQU 235Q + DEFB 234Q + DEFM 'TAB' +TABRW EQU 234Q + DEFB 240Q + DEFM 'RUN' +RUNRW EQU 240Q + DEFB 241Q + DEFM 'LIST' +LISTRW EQU 241Q + DEFB 242Q + DEFM 'NULL' +NULLRW EQU 242Q + DEFB 243Q + DEFM 'SCR' +SCRRW EQU 243Q + DEFB 244Q + DEFM 'MEM' +MEMRW EQU 245Q ;******* WRONG CODE?******* + DEFB 245Q + DEFM 'TSAV' + DEFB 246Q + DEFM 'TLOAD' +LPARRW EQU '('-OPBASE+340Q + DEFB LPARRW + DEFB '(' + DEFB '*'-OPBASE+340Q + DEFB '*' +PLSRW EQU '+'-OPBASE+340Q + DEFB PLSRW + DEFB '+' +MINRW EQU '-'-OPBASE+340Q + DEFB MINRW + DEFB '-' + DEFB '/'-OPBASE+340Q + DEFB '/' + DEFB 67Q-OPBASE+340Q + DEFM '>=' + DEFB 70Q-OPBASE+340Q + DEFM '<=' + DEFB 71Q-OPBASE+340Q + DEFM '<>' + DEFB 62Q-OPBASE+340Q + DEFM '=>' + DEFB 63Q-OPBASE+340Q + DEFM '=<' + DEFB '<'-OPBASE+340Q + DEFB '<' +EQRW EQU '='-OPBASE+340Q + DEFB EQRW + DEFB '=' + DEFB '>'-OPBASE+340Q + DEFB '>' + DEFB 301Q + DEFM 'ABS' + DEFB 306Q + DEFM 'INT' + DEFB 314Q + DEFM 'ARG' + DEFB 315Q + DEFM 'CALL' + DEFB 316Q + DEFM 'RND' + DEFB 322Q + DEFM 'SGN' + DEFB 323Q + DEFM 'SIN' + DEFB 304Q + DEFM 'SQR' + DEFB 327Q + DEFM 'TAN' + DEFB 330Q + DEFM 'COS' + DEFB 377Q +; +; OPERATION TABLE +; +OPTAB: DEFB 15 +OPLPAR EQU OPTAB + DEFW ALPAR + DEFB 15 + DEFW AABS + DEFB 10 + DEFW AMUL + DEFB 6 + DEFW AADD + DEFB 15 + DEFW ASQR + DEFB 6 + DEFW ASUB + DEFB 15 + DEFW AINT + DEFB 10 + DEFW ADIV +OPBOL: DEFB 1 + DEFW 0 + DEFB 13 + DEFW ANEG + DEFB 4 + DEFW AGE + DEFB 4 + DEFW ALE + DEFB 15 + DEFW AARG + DEFB 15 + DEFW ACALL + DEFB 15 + DEFW ARND + DEFB 4 + DEFW AGE + DEFB 4 + DEFW ALE + DEFB 4 + DEFW ANE + DEFB 15 + DEFW ASGN + DEFB 15 + DEFW ASIN + DEFB 4 + DEFW ALT + DEFB 4 + DEFW AEQ + DEFB 4 + DEFW AGT + DEFB 15 + DEFW ATAN + DEFB 15 + DEFW ACOS +; +; ACTION ROUTINES FOR RELATIONAL OPERATORS +; +AGT: CALL RELOP + JP Z,RFALSE + JP M,RTRUE +RFALSE: XOR A + LD (DE),A + RET +ALT: CALL RELOP + JP Z,RFALSE + JP M,RFALSE +RTRUE: LD A,-1 + LD (DE),A + RET +AEQ: CALL RELOP + JP Z,RTRUE + JP RFALSE +ANE: CALL RELOP + JP Z,RFALSE + JP RTRUE +AGE: CALL RELOP + JP Z,RTRUE + JP M,RTRUE + JP RFALSE +ALE: CALL RELOP + JP Z,RTRUE + JP M,RFALSE + JP RTRUE +; +; COMMON ROUTINE FOR RELATIONAL OPERATOR ACTION +; LEFT ARG ADDR IN DE, SAVED +; RIGHT ARG ADDR IN BC +; ON RETURN SIGN SET=GT, ZERO SET =EQUAL +; +RELOP: PUSH DE + DEC BC + DEC DE + LD H,B + LD L,C + LD A,(DE) + SUB (HL) + INC HL + INC DE + JP NZ,RLOP1 ;TEST SIGNS OF ARGS IF DIFFERENT THEN RET + LD BC,FPSINK + CALL FSUB + LD A,(FPSINK) ;CHECK FOR ZERO RESULT + OR A + JP Z,RLOP1 + LD A,(FPSINK-1) ;SIGN OF FPSINK + RLCA + DEC A +RLOP1: LD A,1 + LD (RELTYP),A ;SET RELTYP TRUE + POP DE + RET +; +; ACTION ROUTINES FOR ARITHMETIC OPERATORS +; (CODE WASTERS) +; +AADD: LD H,B + LD L,C + LD B,D + LD C,E +AADD1: CALL FADD + JP FPETST +ASUB: LD H,B + LD L,C + LD B,D + LD C,E +ASUB1: CALL FSUB + JP FPETST +AMUL: LD H,B + LD L,C + LD B,D + LD C,E +AMUL1: CALL FMUL + JP FPETST +ADIV: LD H,B + LD L,C + LD B,D + LD C,E +ADIV1: CALL FDIV +FPETST: XOR A + LD (RELTYP),A + LD A,(ERRI) + OR A + RET Z + LD HL,(ASTKA) ;ZERO RESULT ON UNDERFLOW +FPET1: LD (HL),0 +ALPAR: RET +; +; UNARY AND BUILT IN FUNCTION ROUTINES +; +ANEG: LD A,(BC) + OR A + JP Z,ANEG1 + DEC BC + LD A,(BC) + XOR 1 + LD (BC),A +ANEG1: XOR A + LD (RELTYP),A + RET +AABS: DEC BC + XOR A + LD (BC),A + JP ANEG1 +ASGN: CALL ANEG1 + LD D,B + LD E,C + LD A,(BC) ;GET EXPONENT + OR A + JP NZ,ASGN1 + LD (DE),A ;MAKE ARGUMENT ZERO + RET +ASGN1: DEC BC + LD A,(BC) + OR A + LD HL,FPONE + JP Z,VCOPY + LD HL,FPNONE + JP VCOPY +; +; COMPUTE SIN(X) X=TOP OF ARGUMENT STACK +; RETURN RESULT IN PLACE OF X +; +ASIN: CALL QUADC ;COMPUTE QUADRANT + LD HL,(ASTKA) + LD D,H + LD E,L + LD BC,FTEMP + CALL AMUL1 ;FTEMP=X*X + POP AF + PUSH AF ;A=QUADRANT + RRA + JP C,SIN10 ;QUAD. ODD, COMPUTE COSINE +; COMPUTE X*P(X*X) -- SINE + LD DE,FTEM1 + LD HL,(ASTKA) + CALL VCOPY ;FTEM1=X*X + LD BC,SINX + CALL POLY ;P(X*X) + CALL PREPOP + LD HL,FTEM1 + CALL AMUL1 ;X*P(X*X) +; COMPUTE SIGN OF RESULT +; POSITIVE FOR QUADRANTS 0,1. NEGATIVE FOR 2,3 +; NEGATE ABOVE FOR NEGATIVE ARGUMENTS +; +SIN5: POP AF ;QUADRANT + LD B,A + POP AF ;SIGN + RLCA ;SIGN, 2 TO THE 1ST BIT + XOR B ;QUADRANT, MAYBE MODIFIED FOR NEG. ARGUMENT + LD HL,(ASTKA) + DEC HL ;PTR TO SIGN + SUB 2 + RET M ;QUADRANT 0 OR 1 + INC (HL) ;ELSE SET RESULT NEGATIVE + RET +; COMPUTE P(X*X) -- COSINE +SIN10: LD BC,COSX + CALL POLY ;P(X*X) + JP SIN5 +; +; COMPUTE COS(X) X=TOP OF ARGUMENT STACK +; RETURN RESULT IN PLACE OF X +; COS(X) = SIN(X+PI/2) +; +ACOS: CALL PREPOP + LD HL,PIC2 ;PI/2 + CALL AADD1 ;TOS=TOS+PI/2 + JP ASIN +; +; COMPUTE TAN(X) X=TOP OF ARGUMENT STACK +; RETURN RESULT IN PLACE OF X +; TAN(X)=SIN(X)/COS(X) +; +ATAN: LD HL,(ASTKA) + CALL PSHAS ;PUSH COPY OF X ONTO ARG STACK + CALL ACOS ;COS(X) + LD DE,FTEM2 + CALL POPA1 ;FTEM2=COS(X) + CALL ASIN + CALL PREPOP + LD HL,FTEM2 + JP ADIV1 ;SIN(X)/COS(X) +; +; COMPUTE SQR(X) X=TOP OF ARGUMENT STACK +; RETURN RESULT IN PLACE OF X +; +ASQR: LD HL,(ASTKA) + LD DE,FTEMP + CALL VCOPY ;SAVE X IN FTEMP +; COMPUTE EXPONENT OF FIRST GUESS AS EXPONENT OF X/2 + LD HL,(ASTKA) + LD A,(HL) + OR A + RET Z ;X=0 + SUB 128 + JP M,SQR5 ;NEGATIVE EXPONENT + RRCA + AND 127 + JP SQR6 +SQR5: CPL + INC A + RRCA + AND 127 + CPL + INC A +SQR6: ADD A,128 + LD (HL),A +; TEST FOR NEGATIVE ARGUMENT + DEC HL + LD A,(HL) + LD BC,'NA' + OR A + JP NZ,ERROR ;NEGATIVE ARGUMENT +; +; DO NEWTON'S METHOD +; NEWGUESS=(X/OLDGUESS + OLDGUESS)/2 + LD A,6 ;DO 6 ITERATIONS +SQR20: PUSH AF ;SET NEW ITERATION COUNT + LD BC,FTEM1 + LD DE,FTEMP ;FTEMP IS 'X' + LD HL,(ASTKA) ;GUESS + CALL ADIV1 ;FTEM1=X/GUESS + LD DE,FTEM1 + LD HL,(ASTKA) + LD B,H + LD C,L + CALL AADD1 ;TOS=(X/GUESS)+GUESS + CALL PREPOP + LD HL,FPTWO + CALL ADIV1 ;TOS=(X/GUESS+GUESS)/2 + POP AF + DEC A ;DECREMENT COUNT + JP NZ,SQR20 ;DO ANOTHER ITERATION + RET +; +; COMPUTE RND(X) X=TOP OF ARGUMENT STACK +; FRAND IS UPDATED TO NEW RANDOM VALUE +; A RANDOM NUMBER IN THE RANGE 0 0 +AINT1: SUB FPNIB-1 + RET NC + LD D,A ;COUNT + DEC BC +AINT2: DEC BC + LD A,(BC) + AND 360Q + LD (BC),A + INC D + RET Z + XOR A + LD (BC),A + INC D + JP NZ,AINT2 + RET +; +; DIMENSION MATRIX +; SYMTAB ADDRESS IN HL, HL NOT CLOBBERED +; DE CONTAINS SIZE IN NUMBER OF ELEMENTS +; +DIMS: PUSH HL + INC DE + PUSH DE + LD HL,0 + LD C,FPSIZ + CALL RADD ;MULTIPLY NELTS BY BYTES PER VALUE + EX DE,HL + LD HL,(MATA) + PUSH HL + ADD HL,DE + CALL STOV ;CHECK THAT STORAGE NOT EXHAUSTED + LD (MATA),HL ;UPDATE MATRIX FREE POINTER + POP BC ;BASE ADDR + POP DE ;NELTS (NUMBER OF ELEMENTS) + POP HL ;SYMTAB ADDR + PUSH HL + LD (HL),D + DEC HL + LD (HL),E + DEC HL + LD (HL),B + DEC HL + LD (HL),C ;SYMTAB ENTRY NOW SET UP + POP HL + RET +; +; FIND VARIABLE OPTIONALLY SUBSCRIPTED IN TEXT +; SETS CARRY IF NOT FOUND +; RETURNS ADDRESS OF VARIABLE IN HL +; UPDATES TXA IF FOUND +; +VAR: CALL ALPHA + RET C + CALL NAME2 + CALL GC + CP LPARRW + JP Z,VAR1 ;TEST IF SUBSCRIPTED +; MUST BE SCALAR VARIABLE + CALL STLK ;RETURNS ENTRY ADDRESS IN HL + OR A ;CLEAR CARRY + RET +; MUST BE SUBSCRIPTED +VAR1: CALL GCI ;GOBBLE LEFT PAREN + LD A,80H + OR C + LD C,A ;SET TYPE TO MATRIX + CALL STLK + PUSH HL ;SYMBOL TABLE + LD DE,10 ;DEFAULT MATRIX SIZE + CALL C,DIMS ;DEFAULT DIMENSION MATRIX + CALL EXPRB ;EVALUATE SUBSCRIPT EXPRESSION + CALL PFIX ;DE NOW HAS INTEGER + LD B,')' + CALL EATC ;GOBBLE RIGHT PAREN + POP HL + DEC HL + CALL DCMP ;BOUNDS CHECK INDEX + JP NC,E5 + DEC HL + DEC HL + CALL LHLI ;GET BASE ADDR + LD C,FPSIZ + INC DE ;BECAUSE BASE ADDR IS TO ELEMENT - 1 + CALL RADD ;ADD INDEX, CLEAR CARRY + RET ;******** CALL, RET????!!!!!********** +; +; JUNK ON END OF STATEMENT, TEST IF AT END OF FILE +; DOES NOT CLOBBER DE +; EATS CHARACTER AND LINE COUNT AFTER CR +; LEAVES NEW TXA IN HL +; SETS CARRY IF END OF FILE +; +JOE: CALL GCI + CP ';' + RET Z + CP CR + JP NZ,E1 + LD A,(HL) + DEC A + JP Z,JOE2 + INC HL + INC HL + INC HL ;SKIP OVER COUNT AND LINE NUMBER +JOE1: LD (TXA),HL + RET +JOE2: SCF + JP JOE1 +; +; GET NAME FROM TEXT +; SETS CARRY IF NAME NOT FOUND +; IF SUCCEEDS RETURNS NAME IN BC, C=0 IF NO DIGIT IN NAME +; +NAME: CALL ALPHA + RET C +NAME2: LD B,A + LD C,0 + CALL DIG + CCF + RET NC + LD C,A + OR A ;CLEAR CARRY + RET +; +; SYMBOL TABLE LOOKUP +; BC CONTAIN NAME AND CLASS +; IF NOT FOUND THEN CREATE ZERO'ED ENTRY AND SET CARRY +; HL HAS ADDRESS ON RET +; +STLK: LD HL,(MEMTOP) + LD DE,-STESIZ ;SET UP BASE AND INCREMENT FOR SEARCH LOOP +STLK0: LD A,(HL) + OR A + JP Z,STLK2 ;TEST IF END OF TABLE + CP B + JP NZ,STLK1 ;TEST IF ALPHA COMPARES + DEC HL + LD A,(HL) ;LOOK FOR DIGIT + CP C + DEC HL + RET Z ;CARRY CLEAR TOO, RETURN + INC HL + INC HL +STLK1: ADD HL,DE ;DIDN'T COMPARE, DECREMENT POINTER + JP STLK0 +; ADD ENTRY TO SYMTAB +STLK2: LD (HL),B + DEC HL + LD (HL),C + INC HL + EX DE,HL + ADD HL,DE + LD (STAA),HL ;STORE NEW END OF STMTAB POINTER + DEC DE + DEC DE + EX DE,HL + SCF + RET +; +; GOBBLES NEXT TEXT CHARACTER IF ALPHABETIC +; SETS CARRY IF NOT +; NEXT CHAR IN ACC ON FAILURE +; +ALPHA: CALL GC + CP 'A' + RET C + CP 'Z'+1 + CCF + RET C + JP DIGT1 +; +; GOBBLES NEXT TEXT CHAR IF DIGIT +; SETS CARRY IF NOT +; NEXT CHAR IN ACC ON FAILURE +; +DIG: CALL GC + CP '0' + RET C + CP '9'+1 + CCF + RET C +DIGT1: INC HL + LD (TXA),HL + RET +; +; COPYS FPSIZ BYTES AT ADDR HL TO ADDR DE +; ON EXIT HL POINTS TO ADR-1 OF LAST BYTE COPIED +; +VCOPY: LD C,FPSIZ +VCOP1: LD A,(HL) + LD (DE),A + DEC HL + DEC DE + DEC C + JP NZ,VCOP1 + RET +; +; PUSH VALUE ADDRESSED BY HL ONTO ARG STACK +; SETS ARGF, CLEARS CARRY +; +PSHAS: EX DE,HL +PSHA1: LD HL,(ASTKA) + LD BC,-FPSIZ + ADD HL,BC + LD (ASTKA),HL ;DECREMENT ARG STACK POINTER + EX DE,HL + CALL VCOPY + LD A,1 + LD (ARGF),A ;CLEAR ARGF + OR A + RET +; +; POP ARG STACK +; HL CONTAINS ADDRESS TO PUT POPPED VALUE INTO +; +POPAS: EX DE,HL +POPA1: LD HL,(ASTKA) + PUSH HL + LD BC,FPSIZ + ADD HL,BC + LD (ASTKA),HL ;INCREMENT STACK POINTER + POP HL + JP VCOPY +; +; PUSH FRAM ONTO CONTROL STACK +; TAKES MINUS AMOUNT TO SUB FROM CSTKA IN DE +; DOES OVERFLOW TEST AND RETURNS OLD CSTKA-1 +; +PSHCS: LD HL,(CSTKA) + PUSH HL + ADD HL,DE + LD (CSTKA),HL + EX DE,HL + LD HL,LCSTKA ;ADDR CONTAINS CSTKL + CALL DCMP + JP C,E4 + POP HL + DEC HL + RET +; +; STORAGE OVERFLOW TEST +; TEST THAT VALUE IN HL IS BETWEEN MATA AND STA +; DOES NOT CLOBBER HL +; +STOV: EX DE,HL + LD HL,MATA + CALL DCMP + JP C,E8 + LD HL,STAA + CALL DCMP + EX DE,HL + RET C +E8: LD BC,'SO' + JP ERROR +; +; INCREMENT TXA IF NEXT NON-BLANK CHAR IS EQUAL TO B +; ELSE SYNTAX ERROR +; +EATC: CALL GCI + CP B + RET Z + JP E1 +; +; GET NEXT NON-BLANK CHAR INTO ACC +; INCREMENT PAST BLANKS ONLY +; +GC: CALL GCI + DEC HL + LD (TXA),HL + RET +; +; GET NEXT NON-BLANK TEXT CHAR AND INCREMENT TXA +; DOES NOT CLOBBER DE,BC +; RETURN CHAR IN ACC +; +GCI: LD HL,(TXA) +GCI0: LD A,(HL) + INC HL + CP ' ' + JP Z,GCI0 + LD (TXA),HL + RET +; +; REPEAT ADD +; ADDS DE TO HL C TIMES +; +RADD: ADD HL,DE + DEC C + JP NZ,RADD + RET +; +; PRINT MESSAGE ADDRESSED BY HL +; ENDS WITH CHARACTER PROVIDED IN C +; RETURN IN HL ADDRESS OF TERMINATOR +; +PRNTCR: LD C,CR + JP PRN1 +PRNT: LD C,'"' +PRN1: LD A,(HL) ;GET NEXT CHAR + LD B,A ;FOR CHOUT + CP C ;END OF MESSAGE TEST + RET Z + CP CR + JP Z,E1 ;NEVER PRINT A CR IN THIS ROUTINE + CALL CHOUT + INC HL + JP PRN1 +; +; 16 BIT UNSIGNED COMPARE +; COMPARE DE AGAINST VALUE ADDRESSED BY HL +; CLOBBERS A ONLY +; +DCMP: LD A,E + SUB (HL) + INC HL + LD A,D + SBC A,(HL) + DEC HL + RET NZ + LD A,E + SUB (HL) + OR A ;CLEAR CARRY + RET +; +; INDIRECT LOAD HL THRU HL +; +LHLI: PUSH AF + LD A,(HL) + INC HL + LD H,(HL) + LD L,A + POP AF + RET +; +; GET FP CONSTANT FROM TEXT +; PUSHES VALUE ON ARG STACK AND SETS ARGF FLAG +; SETS CARRY IF NOT FOUND +; +CONST: LD HL,(TXA) ;PREPARE CALL FPIN + EX DE,HL + LD HL,FPSINK + CALL FPIN + RET C + DEC DE + EX DE,HL + LD (TXA),HL ;NOW POINTS TO TERMINATOR + LD DE,FPSINK + CALL PSHA1 + XOR A + INC A ;SET A TO 1 AND CLEAR CARRY + LD (ARGF),A + RET +; +; DIRECT STATEMENT CHECKING ROUTINE +; +DIRT: LD A,(DIRF) + OR A + RET Z + LD BC,'DI' + JP ERROR +; +; FIND TEXT LINE WITH LINE NUMBER GIVEN IN DE +; RETURNS TEXT ADDRESS COUNT BYTE IN HL +; +FINDLN: LD HL,(BOFA) + LD B,0 +FIND1: LD C,(HL) + LD A,C + CP EOF + JP Z,LERR + INC HL + CALL DCMP + DEC HL + RET Z + ADD HL,BC + JP FIND1 +LERR: LD BC,'LN' + JP ERROR +; +; FIX FLOATING TO POSITIVE INTEGER +; RETURN INTEGER VALUE IN DE +; FP VALUE FROM TOP OF ARG STACK, POP ARG STACK +; +PFIX: LD HL,(ASTKA) + LD B,H + LD C,L + PUSH HL + CALL AINT + LD HL,FPSINK + CALL POPAS + POP HL + LD C,(HL) ;EXPONENT + DEC HL + LD A,(HL) ;SIGN + OR A + JP NZ,E5 ;NEGATIVE NO GOOD + LD DE,-FPSIZ+1 + ADD HL,DE + LD DE,0 + LD A,C + OR A + RET Z + DEC C ;SET UP FOR LOOP CLOSE TEST +PFIX1: INC HL + LD A,(HL) + RRCA + RRCA + RRCA + RRCA + CALL MUL10 + JP C,E5 + DEC C + RET P + LD A,(HL) + CALL MUL10 + JP C,E5 + DEC C + JP M,PFIX1 + RET +; +; TAKE NEXT DIGIT IN A (MASK TO 17Q), ACCUMULATE TO DE +; PRESERVES ALL BUT A, DE +; +MUL10: PUSH HL + INC SP + INC SP + LD H,D ;GET ORIGINAL VALUE TO HL + LD L,E + ADD HL,HL ;DOUBLE IT + RET C + ADD HL,HL ;AGAIN + RET C + ADD HL,DE ;PLUS ORIGINAL MAKES 5 TIMES ORIG + RET C + ADD HL,HL ;TIMES TWO MAKES TEN + RET C + EX DE,HL + DEC SP + DEC SP + POP HL + AND 17Q + ADD A,E + LD E,A + LD A,D + ADC A,0 ;PROPAGATE THE CARRY + LD D,A + RET +; +; GET INTEGER FROM TEXT +; SET CARRY IF NOT FOUND +; RETURN INTEGER VALUE IN HL +; RETURN TERMINATOR IN ACC +; +INTGER: CALL DIG + RET C + LD DE,0 + JP INTG2 +INTG1: CALL DIG + LD H,D + LD L,E + CCF + RET NC +INTG2: SUB '0' + CALL MUL10 + JP NC,INTG1 + RET +; +; CONVERT INTEGER TO STRING +; DE CONTAINS ADDRESS OF STRING, RETURN UPDATED VALUE IN DE +; HL CONTAINS VALUE TO CONVERT +; +CNS: XOR A ;SET FOR NO LEADING ZEROES + LD BC,-10000 + CALL RSUB + LD BC,-1000 + CALL RSUB + LD BC,-100 + CALL RSUB + LD BC,-10 + CALL RSUB + LD BC,-1 + CALL RSUB + RET NZ + LD A,'0' + LD (DE),A + INC DE + RET +; +; TAKE VALUE IN HL +; SUB MINUS NUMBER IN BC THE MOST POSSIBLE TIMES +; PUT VALUE ON STRING AT DE +; IF A=0 THEN DON'T PUT ZERO ON STRING +; RETURN NON-ZERO IN A IF PUT ON STRING +; +RSUB: PUSH DE + LD D,-1 +RSUB1: PUSH HL + INC SP + INC SP + INC D + ADD HL,BC + JP C,RSUB1 + DEC SP + DEC SP + POP HL + LD B,D + POP DE + OR B ;A GETS 0 IF A WAS 0 AND B IS 0 + RET Z + LD A,'0' + ADD A,B + LD (DE),A + INC DE + RET +; +; INPUT CHARACTER FROM TERMINAL +; FORCE TO UPPER CASE. +; +INCHAR: PUSH BC ;SAVE ALL THE REGISTERS + PUSH DE ;THAT MIGHT GET WALKED OVER + PUSH HL ;BY CP/M + LD C,CONIN ;LOAD UP FUNCTION CODE AND + CALL BDOS ;CALL THE SYSTEM. + AND 07FH ;MASK OFF PARITY BIT. + CP 'a' ;CHECK IF LOWER CASE + JP C,INCH1 ;TOO LOW + CP 'z'+1 ;CHECK IF LOWER CASE + JP NC,INCH1 ;TOO HIGH + SUB 20H ;FORCE TO UPPER CASE +INCH1: POP HL ;RESTORE THE REGISTERS + POP DE ;THAT GOT PUSHED + POP BC ;GOING IN. + LD B,A ;COPY CHARACTER TO B AND + RET ;RETURN. +; +INL0: CALL CRLF +INLINE: LD HL,IBUF + LD C,LINLEN +INL1: CALL INCHAR + CP 7FH ;DELETE ? + JP Z,INL2 + CP 15H ;CONTROL U ? + JP Z,INL0 + LD (HL),A + LD B,LF ;IN CASE ALL DONE. + CP CR + JP Z,CHOUT ;ECHO LF AND RETURN. + INC HL + DEC C + JP NZ,INL1 + LD BC,'LL' + JP ERROR +INL2: LD A,C + LD B,BELL + CP LINLEN + JP Z,INL3 + DEC HL + LD B,(HL) ;ECHO DELETED CHARACTER. + INC C +INL3: CALL CHOUT + JP INL1 +; +; TEST CONSOLE STATUS +; +STATUS: PUSH BC ;SAVE ALL THE + PUSH DE ;REGISTERS USED BY + PUSH HL ;CP/M. + LD C,CONSTS ;FIRE OFF THE + CALL BDOS ;CONSOLE STATUS CALL. + POP HL ;RESTORE + POP DE ;ALL + POP BC ;REGISTERS. + AND 01H ;SET FLAGS ON THE STATUS. + RET ;RETURN +; +; OUTPUT ROUTINES +; +CHOUT: PUSH BC ;PUSH THE REGISTERS + PUSH DE ;THAT GET WALKED OVER BY + PUSH HL ;OUR PAL CP/M. + LD C,CONOUT ;LOAD UP THE SYSTEM FUNCTION + LD E,B ;CODE, THEN CALL + CALL BDOS ;THE SYSTEM TO WRITE IT. + POP HL ;RESTORE + POP DE ;ALL THE REGISTERS + POP BC ;WE SAVED. + LD A,B ;GET A COPY OF THE CHARACTER. +; +CHCHK: CP CR + JP NZ,CHLF ;NOT CR, IS IT LF? + XOR A + JP PSTOR ;RETURN PHEAD TO ZERO +; +CHLF: CP LF + JP Z,NULCH ;IF LINE FEED PROCESS THE NULLS + CP 40Q ;NO PHEAD INCREMENT IF CONTROL CHAR + RET C + LD A,(PHEAD) + INC A +PSTOR: LD (PHEAD),A + RET +; +NULCH: LD A,(NULLCT) ;OUTPUT NULL CHARS + OR A + RET Z + PUSH BC + LD C,A + LD B,NULL +CH2: CALL CHOUT ;OUTPUT COUNT "C" NULLS + DEC C + JP NZ,CH2 + POP BC + RET +; +CRLF2: CALL CRLF +CRLF: LD B,CR + CALL CHOUT + LD B,LF + JP CHOUT +; +; CHECK IF PANIC CHARACTER HAS BEEN HIT +; +;PCHECK:LD A,(BRKCHR) +; OR A +; CALL Z,STATUS +; RET Z +PCHECK: CALL STATUS ;ANYTHING TYPED + RET Z ;RET IF NO. + CALL INCHAR ;READ THE CHARACTER IN. + CP ESC + JP Z,STOP1 +; LD (BRKCHR),A + RET +; +; GET INTEGER FROM TERMINAL +; DE CONTAINS STRING TO PRINT FIRST +; HL HAS 1 LESS THAN ACCEPTABLE LOWER BOUND +; THIS ROUTINE GOES TO START IF BAD NUMBER +; INTEGER VALUE RETURNED IN HL +; +GINT: PUSH HL + EX DE,HL + LD A,(PHEAD) + OR A + CALL NZ,CRLF + CALL PRNT + CALL INLINE + LD HL,IBUF + LD (TXA),HL + CALL INTGER + JP C,START + CP CR + JP NZ,START + POP DE + LD (IBUF),HL ;USE IBUF AS A TEMP + LD HL,IBUF + CALL DCMP + JP NC,START + LD HL,(IBUF) ;GET THE VALUE BACK TO HL + LD A,(HL) + CPL + LD (HL),A ;TRY TO STORE THERE + CP (HL) + JP NZ,START ;BAD OR MISSING MEMORY + CPL + LD (HL),A ;PUT IT BACK LIKE IT WAS + RET +; +; OUTPUT FP NUMBER ADDRESSED BY HL +; +FPOUT: LD BC,-DIGIT-1 + ADD HL,BC + LD B,H + LD C,L + LD HL,ABUF ;OUTPUT BUFFER + LD A,(INFES) ;OUTPUT FORMAT + LD (FES),A ;STORE IT + LD E,DIGIT + LD (HL),0 ;CLEAR ROUND-OFF OVERFLOW BUFFER + INC HL ;ABUF+1 +; +NXT: LD A,(BC) ;GET DIGIT AND UNPACK + LD D,A + RRA + RRA + RRA + RRA + AND 17Q ;REMOVE BOTTOM DIGIT + LD (HL),A ;STORE TOP DIGIT IN OUTPUT BUFFER (ABUF) + INC HL + LD A,D ;NOW GET BOTTOM DIGIT + AND 17Q + LD (HL),A ;STORE IT + INC HL + INC BC + DEC E + JP NZ,NXT + LD A,(BC) + LD (FSIGN),A ;STORE SIGN OF NUMBER + XOR A + LD (HL),A ;CLEAR ROUND-OFF BUFFER (ABUF+13) 12 DIGIT NO ROUND + LD HL,XSIGN ;EXPONENT SIGN STORE + LD (HL),A ;CLEAR XSIGN +; +FIX: INC BC ;GET EXPONENT + LD A,(BC) + OR A ;EXPONENT ZERO? + JP Z,ZERO + SUB 128 ;REMOVE EXPONENT BIAS + JP NZ,FIX2 + INC (HL) ;INCREMENT XSIGN TO NEGATIVE FLAG(1) LATER ZERO +FIX2: JP P,CHK13 + CPL ;IT'S A NEGATIVE EXPONENT + INC (HL) ;INCREMENT XSIGN TO NEGATIVE (1) +ZRO: INC A +CHK13: LD HL,EXPO ;EXPONENT TEMP STORE + LD (HL),A + LD E,A + CP DIGIT*2 + LD HL,FES ;FORMAT TEMP BYTE + JP C,CHKXO +CHK40: LD A,1 ;FORCE EXPONENTIAL PRINTOUT + OR (HL) ;SET FORMAT FOR XOUT + LD (HL),A +; +CHKXO: LD A,(HL) ;CHECK IF EXPONENTIAL FORMAT + RRA + JP NC,CHKX3 + AND 17Q + CP DIGIT*2 + JP C,CHKX2 + LD A,DIGIT*2-1 ;MAX DIGITS +CHKX2: LD D,A + INC A + JP ROUND +; +CHKX3: AND 17Q ;ADD EXPONENT AND DECIMAL PLACES + LD D,A + ADD A,E + CP DIGIT*2+1 + LD B,A + JP C,CHKXN + LD A,(HL) + AND 100Q + JP NZ,CHK40 +; +CHKXN: LD A,(XSIGN) ;CHECK EXPONENT SIGN + OR A + JP NZ,XNEG ;IT'S NEGATIVE + LD A,B + JP ROUND +; +XNEG: LD A,D ;SUBTRACT EXPONENT AND DECIMAL PLACE COUNT + SUB E + JP NC,XN2 +XN1: LD A,(INFES) + OR A + JP P,ZERO + AND 16Q + JP Z,ZERO + RRCA + LD E,A + DEC E + LD C,1 + LD HL,ABUF-1 + JP NRND +XN2: JP Z,XN1 + JP ROUND +; +CLEAN: LD B,37Q ;CLEAR FLAGS + AND B + CP DIGIT*2+1 + RET C + LD A,DIGIT*2+1 ;MAX DIGITS OUT + RET +; +; THIS ROUTINE IS USED TO ROUND DATA TO THE +; SPECIFIED DECIMAL PLACE +; +ROUND: CALL CLEAN + LD C,A + LD B,0 + LD HL,ABUF+1 + ADD HL,BC ;GET ROUND-OFF ADDRESS + LD (ADDT),HL + LD A,(HL) + CP 5 ;ROUND IF >=5 + JP C,TRL2-1 +; +LESS1: DEC HL + INC (HL) ;ROUND UP + LD A,(HL) + OR A + JP Z,TRL2 + CP 10 ;CHECK IF ROUNDED NUMBER >9 + JP NZ,TRAIL + LD (HL),0 + JP LESS1 +; +; THIS ROUTINE IS USED TO ELIMINATE TRAILING ZEROES +; +TRAIL: LD HL,(ADDT) + DEC HL +TRL2: LD A,(FES) ;CHECK IF TRAILING ZEROES ARE WANTED + RLA + JP C,FPRNT ;YES- GO PRINT DATA +TRL3: LD A,(HL) + OR A ;IS IT A ZERO? + JP NZ,FPRNT ;NO - GO PRINT + DEC HL + DEC C ;YES - FIX OUTPUT DIGIT COUNT + JP M,ZERO + JP TRL3 +; +; HERE START THE PRINT FORMAT ROUTINES +; +FPRNT: LD HL,ABUF + LD A,(HL) ;CHECK IF ROUNDED UP TO 1 + OR A + JP Z,NRND ;JUMP IF NOT + LD B,1 + LD A,(XSIGN) ;IS EXPONENT NEGATIVE? + OR A + JP Z,POSR + LD B,-1 +; +POSR: LD A,(EXPO) ;GET EXPONENT + OR A + JP NZ,PO2 ;IS IT ZERO (E + 0) + LD (XSIGN),A + LD B,1 +PO2: ADD A,B ;FIX EXPONENT COUNT + LD (EXPO),A + INC E + INC C + DEC HL +; +NRND: INC HL + LD A,C + CP DIGIT*2+1 ;CHECK FOR MAXIMUL DIGITS OUT + JP NZ,NRND1 + DEC C +NRND1: LD A,(FSIGN) ;CHECK IN NEGATIVE NUMBER + RRA + JP NC,PRI22 ;GO OUTPUT RADIX AND NUMBER + CALL NEG ;OUTPUT (-) + JP PRI21 +; +PRI22: CALL SPACE ;OUTPUT A SPACE +PRI21: LD A,(FES) ;GET OUTPUT FORMAT + RRA ;CHECK IF EXPONENTIAL FORMAT + JP C,XPRIN + LD A,(XSIGN) ;GET EXPONENT SIGN + OR A ;CHECK IF NEGATIVE EXPONENT + JP Z,POSIT + LD A,C + OR A + JP NZ,PRIN4 ;OUTPUT RADIX AND NUMBER + CALL ZERO ;NO DIGITS AFTER RADIX, OUTPUT ZERO AND DONE + RET ;****** CALL, RET????!!!******** +; +PRIN4: CALL RADIX ;PRINT DECIMAL POINT + XOR A + OR E + JP Z,PRIN5 ;JUMP IF NO ZEROES TO PRINT + CALL ZERO ;FORCE PRINT A ZERO + DEC E + JP NZ,PRIN4+3 +; +PRIN5: CALL NOUT ;PRINT ASCII DIGIT + JP NZ,PRIN5 + RET +; +POSIT: CALL NOUT + DEC E ;BUMP EXPONENT COUNT + JP NZ,POSIT + LD A,C ;CHECK IF MORE DIGITS TO OUTPUT + OR A + RET Z ;NO, DONE + RET M + JP PRIN4 ;NOW PRINT DECIMAL POINT +; +; GET HERE FOR EXPONENTIAL OUTPUT FORMAT +; +XPRIN: CALL NOUT + JP Z,NDEC ;INTEGER? + CALL RADIX ;NO....PRINT DECIMAL POINT +XPRI2: CALL NOUT + JP NZ,XPRI2 +; +NDEC: LD B,'E' ;OUTPUT 'E' + CALL CHOUT + LD A,(XSIGN) + OR A + JP Z,XPRI3 + CALL NEG ;PRINT EXPONENT SIGN (-) + LD A,(EXPO) + INC A + JP XOUT2 +XPRI3: LD B,'+' ;EXPONENT (+) + CALL CHOUT +; +; THIS ROUTINE IS USED TO CONVERT THE EXPONENT +; FROM BINARY TO ASCII AND PRINT THE RESULT +; +XOUT: LD A,(EXPO) + DEC A +XOUT2: LD C,100 + LD D,0 + CALL CONV + CP '0' ;SKIP LEADING ZEROES + JP Z,XO21 + INC D + CALL CHOUT +XO21: LD A,E + LD C,10 + CALL CONV + CP '0' + JP NZ,XO3 + DEC D + JP NZ,XO4 +XO3: CALL CHOUT +XO4: LD A,E + ADD A,'0' ;ADD ASCII BIAS + LD B,A + CALL CHOUT + RET ;****** CALL, RET?????!!!!!***** +CONV: LD B,'0'-1 + INC B + SUB C + JP NC,CONV+2 + ADD A,C + LD E,A + LD A,B + RET +; +; THIS ROUTINE ADD ASCII BIAS TO A BCD DIGIT +; AND CALLS THE OUTPUT ROUTINE +; +NOUT: LD A,(HL) + ADD A,'0' + LD B,A + CALL CHOUT + INC HL + DEC C ;DECREMENT TOTAL DIGITS OUT COUNT + RET +; +; COMMON SYMBOL LOADING ROUTINES +; +NEG: LD B,'-' + JP CHOUT +ZERO: LD B,'0' + JP CHOUT +SPACE: LD B,' ' + JP CHOUT +RADIX: LD B,'.' + JP CHOUT +; +; CONVERTS FP STRING AT DE, UPDATE DE PAST TERMINATOR +; PUTS TERMINATOR IN B, PUTS FP NUMBER AT ADDRESS IN HL +; SETS CARRY IF NOT FOUND +; +FPIN: PUSH HL + PUSH DE + EX DE,HL + DEC HL + LD (ADDS),HL + LD HL,OPST ;CLEAR TEMPORARY STORAGE AREAS AND BC BUFFER + LD C,DIGIT+6 + CALL CLEAR +; +SCANC: LD DE,0 + LD HL,BCX ;BC=PACK BUFFER +SCAN0: LD (BCADD),HL ;PACK BUFFER POINTER +SCANP: LD HL,SCANP + PUSH HL ;USED FOR RETURN FROM OTHER ROUTINES + XOR A + LD (XSIGN),A ;CLEAR EXPONENT SIGN BYTE +; +SCANG: CALL IBSCN + JP C,SCANX ;FOUND A NUMBER, GO PACK IT + CP '.' ;RADIX? + JP Z,SCAN5 ;PROCESS RADIX POINTERS + CP 'E' ;EXPONENT? + JP Z,EXCON ;FOUND 'E', GO PROCESS EXPONENT +; NOT A CHARACTER LEGAL IN NUMBER + LD B,A ;MOVE TERMINATOR TO B + LD A,(OPST) ;CHECK IF ANY DIGITS YET + AND 20Q + JP NZ,ENTR2 +; GET HERE IF LEGAL FP NUMBER NOT FOUND +FPIN1: POP HL ;SCANP LINK + POP DE ;TEXT POINTER + POP HL ;FP # ADDR + SCF + RET +; FOUND DECIMAL POINT +SCAN5: XOR A ;FOUND RADIX PROCESS RADIX POINTERS FOR EXP + OR D ;ANY DIGITS YET? + JP NZ,SCAN6 + ADD A,300Q ;SET ECNT - STOP COUNTING DIGITS + OR E ;NO INT DIGITS, BIT 7 IS COUNT/DON'T COUNT FLAG + LD E,A ;BIT 6 IS NEGATIVE EXPONENT FLAG + RET +SCAN6: LD A,200Q ;SET ECNT TO COUNT DIGITS + OR E + LD E,A + RET +; +SCANX: AND 17Q ;FOUND NUMBER-REMOVE ASCII BIAS + LD B,A + LD HL,OPST ;SET FIRST CHARACTER FLAG + LD A,60Q + OR (HL) + LD (HL),A + XOR A + OR B ;IS CHARACTER ZERO? + JP NZ,PACK + OR D ;LEADING ZERO? IE. ANY INT DIGITS? + JP NZ,PACK + OR E + LD E,A + RET Z ;IF COUNTING YET + INC E ;ECNT+1-COUNT ZEROS FOR EXPONENT COUNT + RET +; +; THIS SUBROUTINE BCD PACKS DIGITS INTO REG BC +; +PACK: LD A,E + RLA + JP C,PACK1 + INC E +PACK1: LD A,E + LD (ECNT),A ;DIGIT COUNT FOR EXPONENT COUNT + INC D ;TOTAL DIGIT COUNT (D ALSO HAS TOP/BOTM FLAG BIT 7) + LD A,D + AND 177Q ;REMOVE TOP/BOTM FLAG + CP DIGIT*2+1 ;LIMIT INPUT DIGITS + RET NC + XOR A + OR D + JP M,BOTM +; +TOP: OR 200Q ;SET MSB FOR TOP FLAG + LD D,A + LD A,B + LD HL,(BCADD) ;GET BC ADDRESS + RLCA + RLCA + RLCA + RLCA + LD (HL),A ;SAVE CHAR IN BC + RET +; +BOTM: AND 177Q ;STRIP MSB (BOTTOM FLAG) + LD D,A + LD A,B + LD HL,(BCADD) + OR (HL) ;OR IN TOP NUMBER + LD (HL),A ;PUT NUMBER BACK IN BC + INC HL + POP BC + JP SCAN0 +IBSCN: LD HL,(ADDS) ;INPUT BUFFER POINTER + INC HL ;GET NEXT BYTE + LD A,(HL) + CP ' ' + JP Z,IBSCN+3 + LD (ADDS),HL ;NOTE: THIS ROUTINE FALLS THROUGH +; THIS ROUTINE CHECKS FOR ASCII NUMBERS +NMCHK: CP '9'+1 + RET NC + CP '0' + CCF + RET +; +; THIS ROUTINE IS USED TO ADJUST A NUMBER IN BC BUFFER +; AND RETURNS VALUE +; +ENTR2: LD DE,0 +ENT1: PUSH BC ;TERMINATOR + CALL FIXE ;NORMALIZE FLOATING POINT NUMBER + POP BC ;TERMINATOR + POP DE ;SCANP LINK + POP DE ;OLD TEXT ADDR + POP DE ;RETURN ADDR + LD C,DIGIT+2 + LD HL,BCX+DIGIT+1 + CALL VCOPY + LD HL,(ADDS) + EX DE,HL + INC DE + OR A + RET +; +; THIS ROUTINE IS USED TO CLEAR STORAGE AREAS +; THE STARTING ADDRESS IS IN HL AND THE COUNT +; IS IN C +; +CLEAR: XOR A + LD (HL),A + INC HL + DEC C + JP NZ,CLEAR+1 + RET +; +; THIS ROUTINE CONVERTS THE ASCII EXPONENT OF +; THE NUMBER IN THE INPUT BUFFER TO BINARY, AND +; NORMALIZES THE EXPONENT ACCORDING TO THE INPUT +; FORMAT OF THE NUMBER +; +EXCON: CALL IBSCN ;GET CHARACTER + JP C,EXC3 + CP PLSRW ;CHECK FOR UNARY SIGNS + JP Z,EXC4 + CP '+' + JP Z,EXC4 + CP '-' + JP Z,EXC2 + CP MINRW + JP NZ,FPERR ;NO SIGN OR NUMBER? +EXC2: LD A,1 + LD (XSIGN),A ;SAVE SIGN +EXC4: CALL IBSCN + JP NC,FPERR ;NO NUMBER? +EXC3: CALL ASCDC ;CONVERT ASCII TO BINARY + JP ENT1 ;NORMALIZE NUMBER AND RETURN +; +; THIS ROUTINE CONVERTS ASCII TO BINARY +; THREE CONSECUTIVE NUMBERS < 128 MAY BE CONVERTED +; +ASCDC: EX DE,HL + LD HL,0 +ASC1: LD A,(DE) ;GET CHR FROM INPUT BUFFER-NO SPACES ALLOWED + CALL NMCHK ;CHECK IF NUMBER + JP NC,ASC2 + SUB '0' ;REMOVE ASCII BIAS + LD B,H + LD C,L + ADD HL,HL + ADD HL,HL + ADD HL,BC + ADD HL,HL + LD C,A + LD B,0 + ADD HL,BC + INC DE + JP ASC1 +ASC2: EX DE,HL + LD B,A ;SAVE TERMINATOR + LD (ADDS),HL ;SAVE IBUF ADDRESS + LD A,D + OR A + JP NZ,FPERR ;TOO BIG >255 + LD A,E + RLA + JP C,FPERR ;TOO BIG >127 + RRA + RET +FPERR: POP BC ;ASCDC RET LINK + JP FPIN1 +; +; THIS ROUTINE NORMALIZES THE INPUT NUMBER +; +FIXE: EX DE,HL + LD A,(BCX) + OR A ;IS IT ZERO? + JP Z,ZZ2 + CALL CHKPN ;SET EXPONENT POSITIVE/NEGATIVE + ADD A,200Q ;ADD EXPONENT BIAS +ZZ2: LD (BCX+DIGIT+1),A ;STORE NORMALIZED EXPONENT IN BC + RET +; +CHKPN: LD A,(ECNT) ;GET EXPONENT COUNT-SET IN 'SCAN' ROUTINE + LD E,A + AND 77Q ;STRIP BITS 7&8 + LD B,A + LD A,(XSIGN) + OR A + JP Z,LPOS ;EXPONENT IS POSITIVE + INC H ;SET SIGN IN H ** THIS SHOULD BE INR H NOT INX H + LD A,100Q ;L IS NEGATIVE + AND E ;CHECK IF E IS NEGATIVE + JP Z,EPOS + LD A,L ;BOTH E & L NEGATIVE + LD L,B + CALL BPOS+1 + CPL + INC A + RET ;BACK TO FIXE +; +EPOS: LD A,L ;E&L NEGATIVE + CPL + INC A ;TWO'S COMP A + ADD A,B + RET ;TO FIXE +; +LPOS: LD A,100Q ;EXPONENT POSITIVE + AND E ;IS E NEGATIVE? + JP Z,BPOS + LD A,B + LD B,L + JP EPOS+1 +; +BPOS: LD A,B ;E&L POSITIVE + ADD A,L + RET P +; + POP HL + JP FPERR + DEFB 10H + DEFW 0 + DEFB 1 +FPNONE: DEFB 129 +; +; FLOATING POINT MATH PACKAGE +; +; EACH FUNCTION OPERATES AS FOLLOWS: (BC) = (DE) # (HL) +; WHERE BC IS ADDRESS OF RESULT +; DE IS ADDRESS OF 1ST ARGUMENT +; HL IS ADDRESS OF 2ND ARGUMENT +; AND # IS ONE OF THE OPERATORS +,-,*,/ +; +; ON ENTRY ALL ADDRESS POINT TO THE EXPONENT PART OF THE +; FLOATING POINT ARGUMENT +; +; THE NUMBER ZERO IS REPRESENTED BY A ZERO EXPONENT +; +; ALL NUMBERS ARE ASSUMED TO BE NORMALIZED +; +FADD: PUSH BC + CALL EXPCK ;FETCH ARGUMENTS + LD C,0 +ADSUM: DEC DE + EX DE,HL + LD A,(SIGN) + XOR (HL) ;FORM SIGN OF RESULT + LD B,A + EX DE,HL + LD A,(DE) + DEC DE + XOR C + LD (SIGN),A + LD HL,RCTRL ;ROUNDING CONTOL FLAG + LD A,(HL) + OR A + INC HL + LD A,(HL) ;GET ROUNDING DIGIT + JP Z,ADS8 + RLCA + RLCA + RLCA + RLCA +ADS8: ADD A,0B0H ;FORCE CARRY IF DIGIT > 5 + LD A,B + RRA + JP C,ADS1 ;HAVE SUBTRACTION + RLA ;RESTORE CARRY + CALL ADDX ;PERFORM ADDITION + JP NC,ADS2 + LD B,4 + CALL RIGHT + LD HL,EXP + INC (HL) ;INCREMENT EXPONENT + JP Z,OVER +ADS2: POP BC ;GET RESULTS ADDRESS + CALL STORE ;SAVE RESULTS + RET ;******* CALL, RET????!!!!******** +ZEREX: POP HL + JP ADS2 +ADDX: LD HL,BUF+DIGIT-1 + LD B,DIGIT +ADD1: LD A,(DE) + ADC A,(HL) + DAA + LD (HL),A + DEC HL + DEC DE + DEC B + JP NZ,ADD1 + RET NC + INC (HL) + RET +; +; FLOATING POINT SUBTRACTION +; +FSUB: PUSH BC + CALL EXPCK ;GET ARGUMENTS + LD A,(SIGN) + XOR 1 ;COMPLEMENT SIGN + LD (SIGN),A + JP ADSUM +ADS1: RLA ;RESTORE CARRY + CCF ;COMPLEMENT FOR ROUNDING + CALL SUBX ;SUBTRACT ARGUMENTS + LD HL,SIGN + JP C,ADS4 + LD A,(HL) ;GET SIGN + XOR 1 ;COMPLEMENT + LD (HL),A +ADS7: DEC HL + LD B,DIGIT +ADS3: LD A,9AH + SBC A,(HL) ;COMPLEMENT RESULT + ADD A,0 + DAA + LD (HL),A + DEC HL + DEC B + CCF + JP NZ,ADS3 +ADS4: LD HL,BUF + LD BC,DIGIT +ADS5: LD A,(HL) + OR A + JP NZ,ADS6 + INC HL + INC B + INC B + DEC C + JP NZ,ADS5 + XOR A ;********* NOT NEEDED + LD (EXP),A + JP ADS2 +ADS6: CP 10H + JP NC,ADS9 + INC B +ADS9: LD HL,EXP + LD A,(HL) + SUB B + JP Z,UNDER + JP C,UNDER + LD (HL),A + LD A,B + RLCA + RLCA + LD B,A + CALL LEFT + JP ADS2 +SUBX: LD HL,BUF+DIGIT-1 + LD B,DIGIT +SUB1: LD A,99H + ADC A,0 + SUB (HL) + EX DE,HL + ADD A,(HL) + DAA + EX DE,HL + LD (HL),A + DEC HL + DEC DE + DEC B + JP NZ,SUB1 + RET +; +; FLOATING POINT MULTIPLY +; +FMUL: PUSH BC + LD A,(HL) + OR A ;ARGUMENT = 0? + JP Z,FMUL1+2 + LD A,(DE) + OR A ;ARGUMENT =0? + JP Z,FMUL1+2 + ADD A,(HL) ;FORM RESULT EXPONENT + JP C,FMOVR + JP P,UNDER + JP FMUL1 +FMOVR: JP M,OVER +FMUL1: SUB 128 ;REMOVE EXCESS BIAS + LD (EXP),A ;SAVE EXPONENT + DEC DE + DEC HL + LD A,(DE) + XOR (HL) ;FORM RESULT SIGN + DEC HL + DEC DE + PUSH HL + LD HL,SIGN ;GET SIGN ADDRESS + LD (HL),A ;SAVE SIGN + DEC HL + XOR A + LD B,DIGIT+2 +FMUL2: LD (HL),A ;ZERO WORKING BUFFER + DEC HL + DEC B + JP NZ,FMUL2 + LD A,(EXP) + OR A + JP Z,ZEREX + LD C,DIGIT + LD HL,HOLD1+DIGIT +; GET MULTIPLIER INTO HOLDING REGISTER +FMUL3: LD A,(DE) + LD (HL),A ;PUT IN REGISTER + DEC HL + DEC DE + DEC C + JP NZ,FMUL3 + LD (HL),C + DEC HL + LD B,250 ;SET LOOP COUNT +FMUL4: LD DE,DIGIT+1 + LD C,E + ADD HL,DE + EX DE,HL + ADD HL,DE ;H,L=NEXT HOLDING REGISTER + INC B + JP P,FMUL8 ;FINISHED +FMUL5: LD A,(DE) ;GET DIGITS + ADC A,A ;TIMES 2 + DAA + LD (HL),A ;PUT IN HOLDING REGISTER + DEC DE + DEC HL + DEC C + JP NZ,FMUL5 + INC B ;INCREMENT LOOP COUNT + JP NZ,FMUL4 +; +; FORM 10X BY ADDING 8X AND 2X +; FIRST GET 8X + INC HL + LD DE,HOLD5 ;NEXT HOLDING REGISTER + LD C,DIGIT+1 + LD B,C +FMUL6: LD A,(HL) + LD (DE),A + INC HL + INC DE + DEC C + JP NZ,FMUL6 + LD HL,HOLD2+DIGIT ;GET 2X + DEC DE +FMUL7: LD A,(DE) + ADC A,(HL) ;FORM 10X + DAA + LD (DE),A + DEC DE + DEC HL + DEC B + JP NZ,FMUL7 + LD B,249 + EX DE,HL + JP FMUL4 +FMUL8: EX DE,HL + INC HL + LD (HL),DIGIT+1 ;SET NEXT LOOP COUNT +; PERFORM ACCUMULATION OF PRODUCT +FMUL9: POP BC ;GET MULTIPLIER + LD HL,HOLD8+DIGIT+1 + DEC (HL) ;DECREMENT LOOP COUNT + JP Z,FMU14 ;FINISHED + LD A,(BC) + DEC BC + PUSH BC + DEC HL + EX DE,HL +FMU10: ADD A,A ;CHECK FOR BIT IN CARRY + JP C,FMU11 ;FOUND A BIT + JP Z,FMU12 ;ZERO - FINISHED THIS DIGIT + LD HL,-DIGIT-1 + ADD HL,DE ;POINT TO NEXT HOLDING REGISTER + EX DE,HL + JP FMU10 +FMU11: LD C,A + OR A ;CLEAR CARRY + CALL ADDX ;ACCUMULATE PRODUCT + LD A,(DE) + ADD A,(HL) + DAA + LD (HL),A + LD A,C + DEC DE + JP FMU10 +; ROTATE RIGHT 1 BYTE +FMU12: LD B,8 + CALL RIGHT + JP FMUL9 +FMU14: LD A,(BUF) + AND 0F0H ;CHECK IF NORMALIZING + JP Z,FMU17 + LD A,D + AND 0F0H + LD HL,SIGN-1 + JP FMU18 +FMU17: LD B,4 + LD HL,EXP + DEC (HL) + JP Z,UNDER + CALL LEFT ;NORMALIZE + LD A,D ;GET DIGIT SHIFTED OFF +; PERFORM ROUNDING + RRCA + RRCA + RRCA + RRCA +FMU18: CP 50H + JP C,FMU16 + INC A + AND 0FH + LD C,DIGIT +FMU15: ADC A,(HL) + DAA + LD (HL),A + LD A,0 + DEC HL + DEC C + JP NZ,FMU15 +; CHECK FOR ROUNDING OVERFLOW + JP NC,ADS2 ;NO OVERFLOW + INC HL + LD (HL),10H + LD HL,EXP + INC (HL) + JP NZ,ADS2 + JP OVER +; ROUNDING NOT NEEDED +FMU16: AND 0FH + ADD A,(HL) + LD (HL),A + JP ADS2 +; +; FLOATING POINT DIVISION +; +FDIV: PUSH BC + LD A,(HL) ;FETCH DIVISOR EXP + OR A ;DIVIDE BY ZERO? + JP Z,DIVZ + LD A,(DE) + OR A ;DIVIDEND 0? + JP Z,INSP + SUB (HL) + JP C,DIVUN + JP M,OVER + JP FDI1 +DIVUN: JP P,UNDER +FDI1: ADD A,129 ;FORM QUOTIENT EXP + LD (EXPD),A + EX DE,HL + PUSH DE + CALL LOAD ;FETCH DIVIDEND + POP DE + EX DE,HL + LD A,(SIGN) + DEC HL + XOR (HL) ;FORM QUOTIENT SIGN + LD (SIGND),A + EX DE,HL + DEC DE + LD BC,HOLD1 +DIV0: LD L,DIGIT+DIGIT +DIV1: PUSH BC + PUSH HL + LD C,0 ;QUOTIENT DIGIT = 0 +DIV3: SCF ;SET CARRY + LD HL,BUF+DIGIT-1 + LD B,DIGIT +DIV4: LD A,99H + ADC A,0 + EX DE,HL + SUB (HL) + EX DE,HL + ADD A,(HL) + DAA + LD (HL),A + DEC HL + DEC DE + DEC B + JP NZ,DIV4 + LD A,(HL) + CCF + SBC A,0 + LD (HL),A + RRA + LD HL,DIGIT + ADD HL,DE + EX DE,HL + INC C ;INCREMENT QUOTIENT + RLA + JP NC,DIV3 + OR A ;CLEAR CARRY + CALL ADDX ;RESTORE DIVIDEND + LD HL,DIGIT + ADD HL,DE + EX DE,HL + PUSH BC + LD B,4 + CALL LEFT ;SHIFT DIVIDEND + POP BC + DEC C + POP HL + LD H,C + POP BC + LD A,L + JP NZ,DIV5 + CP DIGIT+DIGIT + JP NZ,DIV5 + LD HL,EXPD + DEC (HL) + CALL Z,UNDER + JP DIV0 +DIV5: RRA + LD A,H + JP NC,DIV6 + LD A,(BC) + RLCA + RLCA + RLCA + RLCA + ADD A,H + LD (BC),A ;STORE QUOTIENT + INC BC + JP DIV7 +DIV6: LD (BC),A ;STORE QUOTIENT +DIV7: DEC L ;DECREMENT DIGIT COUNT + JP NZ,DIV1 + LD HL,EXPD + POP BC + CALL STORO + RET ;***** CALL, RET????!!!!!******* +; +; FETCH AND ALIGN ARGUMENTS FOR +; ADDITION AND SUBTRACTION +; +EXPCK: LD A,(DE) + SUB (HL) ;DIFFERENCE OF EXPONENTS + LD C,0 + JP NC,EXPC1 + INC C + EX DE,HL + CPL + INC A +EXPC1: LD B,A + LD A,(DE) + LD (EXP),A + LD A,B + CP DIGIT+DIGIT + JP C,EXPC2 + LD A,DIGIT+DIGIT +EXPC2: RLCA + RLCA + LD B,A + AND 4 + LD (RCTRL),A ;SET ROUNDING CONTROL + PUSH BC + PUSH DE + CALL LOAD ;LOAD SMALLER VALUE + LD A,8*DIGIT+16 + SUB B + CP 8*DIGIT+16 + JP Z,EXPC3 + AND 0F8H + RRA + RRA + RRA + ADD A,E + LD E,A + LD A,D + ADC A,0 + LD D,A + LD A,(DE) ;GET ROUNDING DIGIT + LD (RDIGI),A ;SAVE +EXPC3: CALL RIGHT ;ALIGN VALUES + POP DE + POP BC + RET +; LOAD ARGUMENT INTO BUFFER +LOAD: LD DE,SIGN + LD C,DIGIT+1 + DEC HL +LOAD1: LD A,(HL) + LD (DE),A + DEC HL + DEC DE + DEC C + JP NZ,LOAD1 + XOR A + LD (DE),A + DEC DE + LD (DE),A + LD (RDIGI),A ;ZERO ROUNDING DIGIT + RET +; STORE RESULTS IN MEMORY +STORE: LD HL,EXP +STORO: LD E,DIGIT+2 +STOR1: LD A,(HL) + LD (BC),A + DEC BC + DEC HL + DEC E + JP NZ,STOR1 + RET +; SHIFT RIGHT NUMBER OF DIGITS +; IN B/4 +RIGHT: LD C,DIGIT+1 +RIGH1: LD HL,BUF-1 + LD A,B + SUB 8 ;CHECK IF BYTE CAN BE SHIFTED + JP NC,RIGH3 + DEC B + RET M + OR A +RIGH2: LD A,(HL) + RRA + LD (HL),A + INC HL + DEC C + JP NZ,RIGH2 + JP RIGHT +; SHIFT RIGHT ONE BYTE +RIGH3: LD B,A + XOR A +RIGH4: LD D,(HL) + LD (HL),A + LD A,D + INC HL + DEC C + JP NZ,RIGH4 + JP RIGHT +; SHIFT LEFT NUMBER OF DIGITS +; IN B/4 +LEFT: LD C,DIGIT+1 + LD HL,SIGN-1 +LEF1: LD A,B + SUB 8 + JP NC,LEF3 + DEC B + RET M + OR A +LEF2: LD A,(HL) + RLA + LD (HL),A + DEC HL + DEC C + JP NZ,LEF2 + JP LEFT +; SHIFT LEFT ONE BYTE +LEF3: LD B,A + XOR A +LEF4: LD D,(HL) + LD (HL),A + LD A,D + DEC HL + DEC C + JP NZ,LEF4 + JP LEFT +; SET FLAGS FOR OVERFLOW, UNDERFLOW, +; AND DIVIDE BY ZERO +DIVZ: +OVER: LD BC,'FP' + JP ERROR +UNDER: LD A,-1 + LD (ERRI),A +INSP: INC SP + INC SP + RET +; +; FLOATING POINT RAM +; +HOLD1: DEFS DIGIT+1 +HOLD2: DEFS DIGIT+1 +HOLD3: DEFS DIGIT+1 +HOLD4: DEFS DIGIT+1 +HOLD5: DEFS DIGIT+1 +HOLD6: DEFS DIGIT+1 +HOLD7: DEFS DIGIT+1 +HOLD8: DEFS DIGIT+1 + DEFS 1 +ERRI: DEFS 1 ;ERROR FLAG + DEFS 1 +BUF: DEFS DIGIT ;WORKING BUFFER +SIGN: DEFS 1 ;SIGN BIT +EXP: DEFS 1 ;EXPONENT +RCTRL: DEFS 1 ;ROUNDING CONTROL FLAG 1=MSD +RDIGI: DEFS 1 ;ROUNDING DIGIT +SIGND EQU HOLD1+DIGIT +EXPD EQU HOLD1+DIGIT+1 +; +; SYSTEM RAM +; +EROM: DEFS 100 +CMNDSP: +PHEAD: DEFS 1 +RELTYP: DEFS 1 +NULLCT: DEFS 1 +ARGF: DEFS 1 +DIRF: DEFS 1 +TXA: DEFS 2 +CSTKSZ EQU 100 +CSTKL: DEFS 100 +ASTKSZ EQU FPSIZ*LINLEN/2 +ASTKL: DEFS FPSIZ*LINLEN/2 +RTXA: DEFS 2 +STAA: DEFS 2 +CSTKA: DEFS 2 +SINK: DEFS FPSIZ-1 +FPSINK: DEFS FPSIZ +FTEMP: DEFS FPSIZ +FTEM1: DEFS FPSIZ +FTEM2: DEFS FPSIZ +FRAND: DEFS 1 +IBCNT: DEFS 1 +IBLN: DEFS 2 +IBUF: DEFS LINLEN +ASTKA: DEFS 2 +MATA: DEFS 2 +ADDS: DEFS 2 +ADDT: DEFS 2 +BCADD: DEFS 2 +OPST: DEFS 1 +OPSTR: DEFS 1 +ECNT: DEFS 1 +FSIGN: DEFS 1 +BCX: DEFS DIGIT+2 +ABUF: DEFS DIGIT*2+2 +XSIGN: DEFS 1 +EXPO: DEFS 1 +FES: DEFS 1 +INFES: DEFS 1 +MAXL: DEFS 2 +INSA: DEFS 2 +; +; SPECIAL INTERFACE GLOBAL +; +BRKCHR: DEFS 1 +CALST: DEFS 6 +CALLA: DEFS 2 +EOFA: DEFS 2 ;END OF FILE ADDRESS +BOFA: DEFS 2 ;START OF FILE ADDRESS +MEMTOP: DEFS 2 ;STORAGE FOR LAST ASSIGNED MEMORY LOCATION +BASEND: ;END OF BASIC/START OF USER diff --git a/README.md b/README.md index af11adb..d7803d8 100644 --- a/README.md +++ b/README.md @@ -46,8 +46,11 @@ originally developed by the Mark Williams Company and which ran on PDP-11 under Coherent. This assembler has the advantage of small size, and is also written in K&R C. -`Z80as` generates Intel HEX files rather than BIN files, so I wrote a simple -converter called `HEX2BIN`. +`Z80as` compiled 'out-of-the-box' under Aztec C on the Apple II, without any +modification. + +This assembler generates Intel HEX files rather than BIN files, so I wrote a +simple converter called `HEX2BIN`. `Z80as` also builds and runs on Linux which allows larger files to be assembled and is much faster than running on 6502 at 1Mhz. @@ -90,6 +93,11 @@ There are two parts to the BDOS emulation: This is one of the BASIC interpreters from the Processor Technologies SOL-20 system. The source code was provided as an example with z80as. +I assembled this code under `Z80as` on Linux, since it defines too many +symbols to assemble natively on the Apple II in the available memory. I plan +to take a look at the Aztec C build configuration to see if it is possible +to find more memory for dynamic allocation (ie: `malloc()`). + It is a 5K BASIC, so it is rather primitive. However it does have a floating point package and trig functions. diff --git a/RUNBASIC5#040000 b/RUNBASIC5#040000 new file mode 100644 index 0000000..884cba7 --- /dev/null +++ b/RUNBASIC5#040000 @@ -0,0 +1 @@ +bload /zapple2/softcard80.bin,A$FFD,Ttxt bload /zapple2/basic5.bin,A$1100,T$00 brun /zapple2/softcard65 \ No newline at end of file diff --git a/RUNTESTSTUB#040000 b/RUNTESTSTUB#040000 new file mode 100644 index 0000000..dfaae02 --- /dev/null +++ b/RUNTESTSTUB#040000 @@ -0,0 +1 @@ +bload /zapple2/softcard80.bin,A$FFD,Ttxt brun /zapple2/softcard65 \ No newline at end of file diff --git a/SOFTCARD65#069000 b/SOFTCARD65#069000 new file mode 100644 index 0000000..6875100 Binary files /dev/null and b/SOFTCARD65#069000 differ diff --git a/SOFTCARD65.S#040000 b/SOFTCARD65.S#040000 new file mode 100644 index 0000000..4bd56be --- /dev/null +++ b/SOFTCARD65.S#040000 @@ -0,0 +1 @@ + ڸ 䍪 ڸ Ǡ Ġՠô Ġՠ Ǡՠ ڸǠՠ ڸǠՠ ڸҠՠ  ڸȠՠà ҍӠՠĠ ڸ̠ՠĠ 썍ԍĠ ڸ ҠҠ ڸ 占РԠ ōˠ 򍍪 ڸ ҠčР Ľ 占Šı 덠 РŠ 卺ıР Ľ ڸŠIJӠ Р Ǡ ؠǠ ٠Ǡ ҠР ҍǠ ؠǠ ٠Ǡ Р 덠Ӡ Ӡ ڸIJР Ľ ڸŠij 捠Ӡ ڸijР Ľ ڸŠĴԠð ɠóӠ 占 ǍРóŠ óӠ ǍóŠǠ ڸӠ ڸĴҠ̠ ˠ РРҩ \ No newline at end of file diff --git a/SOFTCARD80.ASM#040000 b/SOFTCARD80.ASM#040000 new file mode 100644 index 0000000..135ad9a --- /dev/null +++ b/SOFTCARD80.ASM#040000 @@ -0,0 +1 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Z80 code running on Softcard ; This is invoked by the companion SOFTCARD65 6502 code ; Bobbi 2019 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; SOFTCARD EQU 0E400H ; Softcard in slot 4 ($C400) CMD EQU 0F006H ; 6502 $06 AREG EQU 0F007H ; 6502 $07 XREG EQU 0F008H ; 6502 $08 YREG EQU 0F009H ; 6502 $09 ADDR EQU 0F0EBH ; 6502 $EB (LSB) ADDRH EQU 0F0ECH ; 6502 $EC (MSB) ; Addresses of 6502 routines, in 6502 address space COUT EQU 0FDEDH ; Print char in A RDKEY EQU 0FD0CH ; Read key, return in A BELL EQU 0FBE4H ; Sound the bell ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Entry point when Z80 cold starts is 0000H ORG 0000H JP START ; Skip to the actual program ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; BDOS entry point must be at address 0005H for CP/M compatibility ; Function to invoke is passed in C ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ORG 0005H BDOS JP BDOSI ; BDOS code is at top of memory ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; The application program proper starts at 0100H ; in order to be compatible with CP/M .COM programs ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ORG 0100H STCHAR EQU 65 ; First character code 'A' ENDCHAR EQU 91 ; Last character code 'Z' ; Print the alphabet using C_WRITE START LD B,STCHAR L1 LD E,B ; Character to print LD C,2 ; C_WRITE call PUSH BC ; Preserve B (and C) CALL BDOS ; CP/M BDOS call POP BC ; Restore B (and C) INC B LD A,ENDCHAR CP B JP Z,S1 JP L1 ; Loop until there is a keystroke waiting using C_STAT S1 LD C,0BH ; C_STAT call CALL BDOS ; CP/M BDOS call CP 0 ; Anything? JR Z,S1 ; If not, loop ; Print a couple of spaces LD E,32 ; LD C,2 ; C_WRITE call CALL BDOS ; CP/M BDOS call LD E,32 ; LD C,2 ; C_WRITE call CALL BDOS ; CP/M BDOS call ; Read keyboard and echo to screen C_READ, C_WRITE L2 LD C,1 ; C_READ call CALL BDOS ; CP/M BDOS call LD E,A ; Prepare to echo keystroke LD C,2 ; C_WRITE call CALL BDOS ; CP/M BDOS call JP L2 ; Forever and ever ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Implementation of BDOS ; Function to invoke is passed in C ; C=01H C_READ Console read ; C=02H C_WRITE Console write ; C=0BH C_STAT Console status ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ORG 0D000H ; $B000 on 6502 - OK FOR NOW ORG 05000H ; Move it down to avoid Z80asm bug BDOSI LD HL,BDOSVEC ; Start of vector table SLA C ; Multiply C by 2 LD B,0 ; MSB of BC is zero ADD HL,BC ; Address of vector in HL LD C,(HL) ; Read LSB of address to jump to INC HL ; Read MSB of address to jump to LD H,(HL) ; ... LD L,C ; Address needs to be in HL JP (HL) ; Jump to it! ; Vector table BDOSVEC DEFW UNIMP ; C=00H DEFW C_READ ; C=01H DEFW C_WRITE ; C=02H DEFW UNIMP ; C=03H DEFW UNIMP ; C=04H DEFW UNIMP ; C=05H DEFW UNIMP ; C=06H DEFW UNIMP ; C=07H DEFW UNIMP ; C=08H DEFW UNIMP ; C=09H DEFW UNIMP ; C=0AH DEFW C_STAT ; C=0BH DEFW UNIMP ; C=0CH ; TODO: Complete this!! ; Unimplemented BDOS call, just ring the bell UNIMP LD HL,BELL ; We are going to call BELL LD (ADDR),HL ; ... LD A,1 ; CMD=1 means call 6502 sub LD (CMD),A ; ... LD (SOFTCARD),A ; Do it! RET ; Return to calling program ; Wait for a character from the console, return it in A and L ; Also echoes the char to the console C_READ LD HL,RDKEY ; We are going to call RDKEY LD (ADDR),HL ; ... LD A,1 ; CMD=1 means call 6502 sub LD (CMD),A ; ... LD (SOFTCARD),A ; Do it! LD A,(AREG) ; Grab the return value PUSH AF ; Preserve A (and F) LD HL,COUT ; Echo the character using COUT LD (ADDR),HL ; ... LD A,1 ; CMD=1 means call 6502 sub LD (CMD),A ; ... LD (SOFTCARD),A ; Do it! POP AF ; Restore A (and F) AND 7FH ; Mask high bit LD L,A ; Copy A to L RET ; Return to calling program ; Write character in E to the console ; TODO: Handle tabs, ^S and ^Q C_WRITE LD A,80H ; Set high bit OR E ; ... CP 8AH ; Check for linefeed RET Z ; If LF, don't print it LD (AREG),A ; Pass char to COUT in 6502 A LD HL,COUT ; We are going to call COUT LD (ADDR),HL ; ... LD A,1 ; CMD=1 means call 6502 sub LD (CMD),A ; ... LD (SOFTCARD),A ; Do it! RET ; Return to calling program ; Returns 0 in A and L if no chars waiting, non zero otherwise ; TODO: Implement this C_STAT LD A,3 ; CMD=3 means peek at keyboard LD (CMD),A ; ... LD (SOFTCARD),A ; Do it LD A,(AREG) ; Grab the return value LD L,A ; Copy A to L RET ; Return to calling program \ No newline at end of file diff --git a/SOFTCARD80.BIN#040000 b/SOFTCARD80.BIN#040000 new file mode 100644 index 0000000..0342638 Binary files /dev/null and b/SOFTCARD80.BIN#040000 differ diff --git a/zapple2.po b/zapple2.po new file mode 100644 index 0000000..5cbf4b6 Binary files /dev/null and b/zapple2.po differ