; ; 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