; ; Page 1 ; ; ; ; SYSTEM INTERFACE ; ; file '8k Basic' BASIC: ;FULL RESTART INITIALIZATION SYSINITJ: JMP INITIALZ REENTERBASIC: ;REENTER AFTER PAUSE JMP cmndrstr ; ; Monitor Routines ; co equ 406h ;c -> screen cinb equ 409h ;keyboard -> ac, carry set if any dclr equ 538h ;clear screen xco equ 4f4h ;c -> printer (blocking) ; ; NON-BLOCKING INPUT ; CHAR IN AC IF NOT ZERO ; ZERO SET IF NONE ; SYSKEYIN: push b push d push h call cinb ;get char jnc syskeynone cpi 0 jz clearscreen cpi 1fh ;us to bring to 14 jz gomonitor syskeyinret: pop h pop d pop b ret syskeynone: sub a ;set zero jmp syskeyinret clearscreen: call dclr ;clear screen jmp syskeynone gomonitor: rst 1 ;about using us (^_) nop nop ; ; SEND AC TO SCREEN ; SYSDISPL: push psw push b push d ; ; Page 2 ; push h mov c,a call co ;c to screen lda p3010 ;print on the 3010 if zero ana a cz xco ;yes print pop h pop d pop b pop psw RET ; ; CHECK FOR BREAK REQUEST ; SET ZERO TO BREAK ; SYSBREAK: call syskeyin jz nobreak sub a ret nobreak: mvi a,1 ora a ret ; ; DELAY ; SYSWAIT: RET ; ; RETURN TO MONITOR ; MONITOR EQU 0B400H SYSQUIT: JMP MONITOR ; ; Page 3 ; CR EQU 0DH LF EQU 0AH BEL EQU 07H BS EQU 08H TAB EQU 09H HT EQU 09H CD1 EQU 11H DEL EQU 7FH SI EQU 0FH ETX EQU 03H FF EQU 0CH ESC EQU 18H ; ; Page 4 ; KEYSTM EQU 80H ;STATEMENT CODES KEYDAT EQU KEYSTM KEYREM EQU KEYDAT+1 KEYLSAL EQU KEYREM+1 KEYEND EQU KEYLSAL KEYFOR EQU KEYEND+1 KEYNEX EQU KEYFOR+1 KEYINPT EQU KEYNEX+1 KEYDIM EQU KEYINPT+1 KEYREA EQU KEYDIM+1 KEYLET EQU KEYREA+1 KEYGTO EQU KEYLET+1 KEYRUN EQU KEYGTO+1 KEYIF EQU KEYRUN+1 KEYELS EQU KEYIF+1 KEYRES EQU KEYELS+1 KEYGSB EQU KEYRES+1 KEYRET EQU KEYGSB+1 KEYSTOP EQU KEYRET+1 KEYON EQU KEYSTOP+1 KEYAUT EQU KEYON+1 KEYDEL EQU KEYAUT+1 KEYPLT EQU KEYDEL+1 KEYWAI EQU KEYPLT+1 KEYPRT EQU KEYWAI+1 KEYDEF EQU KEYPRT+1 KEYCON EQU KEYDEF+1 KEYLIS EQU KEYCON+1 KEYEDI EQU KEYLIS+1 KEYCLR EQU KEYEDI+1 KEYCLD EQU KEYCLR+1 KEYCSV EQU KEYCLD+1 KEYNEW EQU KEYCSV+1 KEYSET EQU KEYNEW+1 KEYSUGR EQU KEYSET+1 KEYLSBL EQU KEYSUGR KEYTHEN EQU KEYSUGR KEYTO EQU KEYTHEN+1 KEYSTEP EQU KEYTO+1 KEYLSBH EQU KEYSTEP+1 KEYPRM EQU KEYLSBH KEYLINE EQU KEYPRM+1 KEYLSAH EQU KEYLINE+1 KEYTAB EQU KEYLSAH KEYSPC EQU KEYTAB+1 KEYFN EQU KEYSPC+1 KEYNOT EQU KEYFN+1 KEYOFF EQU KEYNOT+1 ; KEYOPR EQU KEYOFF+1 ;OPERATOR CODES KEYADD EQU KEYOPR KEYSUB EQU KEYADD+1 KEYMUL EQU KEYSUB+1 KEYDIV EQU KEYMUL+1 KEYMOD EQU KEYDIV+1 KEYEXPT EQU KEYMOD+1 ; ; Page 5 ; KEYAND EQU KEYEXPT+1 KEYOR EQU KEYAND+1 KEYMAX EQU KEYOR+1 KEYMIN EQU KEYMAX+1 ; KEYREL EQU KEYMIN+1 ;RELATION CODES KEYGT EQU KEYREL KEYEQ EQU KEYGT+1 KEYLT EQU KEYEQ+1 ; KEYFCT EQU KEYLT+1 ;FUNCTION CODES KEYSGN EQU KEYFCT KEYINT EQU KEYSGN+1 KEYABS EQU KEYINT+1 KEYSQR EQU KEYABS+1 KEYRND EQU KEYSQR+1 KEYLOG EQU KEYRND+1 KEYEXP EQU KEYLOG+1 KEYCOS EQU KEYEXP+1 KEYSIN EQU KEYCOS+1 KEYTAN EQU KEYSIN+1 KEYATA EQU KEYTAN+1 KEYUSR EQU KEYATA+1 KEYFRE EQU KEYUSR+1 KEYPORT EQU KEYFRE+1 KEYPOS EQU KEYPORT+1 KEYMEM EQU KEYPOS+1 KEYLEN EQU KEYMEM+1 KEYSTR EQU KEYLEN+1 KEYVAL EQU KEYSTR+1 KEYASC EQU KEYVAL+1 KEYCHR EQU KEYASC+1 KEYHEX EQU KEYCHR+1 KEYHXV EQU KEYHEX+1 KEYUPR EQU KEYHXV+1 KEYLFT EQU KEYUPR+1 KEYRIG EQU KEYLFT+1 KEYMID EQU KEYRIG+1 KEYINS EQU KEYMID+1 ; KEYS EQU KEYINS+1 ;LAST ENTRY ; ; Page 6 ; STMTABL: ;STATEMENT ROUTINES DW DATSTM DW REMSTM ;LISTED WITH BLANK AFTER DW ENDSTM DW FORSTM DW NEXSTM DW INPSTM DW DIMSTM DW REASTM DW LETSTM DW GTOSTM DW RUNSTM DW IFSTM DW ELSSTM DW RESSTM DW GSBSTM DW RETSTM DW STPSTM DW ONSTM DW AUTSTM DW DELSTM DW PLTSTM DW WAISTM DW PRTSTM DW DEFSTM DW CONSTM DW LISSTM DW EDISTM DW CLRSTM DW CLDSTM DW CSVSTM DW NEWSTM DW SETSTM ; ; Page 7 ; OPRTABL: ;OPERATORS AND PRECEDENCE DB 79H DW ADDOPR DB 79H DW SUBOPR DB 7BH DW MULOPR DB 7BH DW DIVOPR DB 7BH DW MODOPR DB 7FH DW EXPOPR DB 50H DW ANDOPR DB 46H DW ORNOPR DB 76H DW MAXOPR DB 76H DW MINOPR ; ; Page 8 ; FCTTABL: ;FUNCTION ROUTINES DW SGNFCT DW INTFCT DW ABSFCT DW SQRFCT DW RNDFCT DW LOGFCT DW EXPFCT DW COSFCT DW SINFCT DW TANFCT DW ATNFCT DW ERRAFC DW FREFCT DW PORFCT DW POSFCT DW MEMFCT DW LENFCT DW STRFCT DW VALFCT DW ASCFCT DW CHRFCT DW HEXFCT DW HXVFCT DW UPRFCT DW LFTFCT DW RIGFCT DW MIDFCT DW INSFCT ; ; Page 9 ; KEYWADDS: ;POINTERS TO KEYWORD GROUPS DW KEYWRD0, KEYWRD1, KEYWRD2, KEYWRD3 DW KEYWRD4, KEYWRD5, KEYWRD6, KEYWRD7 DW KEYWRD8, KEYWRD9, KEYWRDA, KEYWRDB DW KEYWRDC, KEYWRDD, KEYWRDE, KEYWRDF KEYWORDS: KEYWRD0: DB KEYPLT, 'PLO', 'T'+128 DB KEYPRT, 'PRIN', 'T'+128 DB KEYPRM, 'PROMP', 'T'+128 DB KEYPORT, 'POR', 'T'+128 DB KEYPOS-80H, 'PO', 'S'+128 KEYWRD1: DB KEYAUT, 'AUT', 'O'+128 DB KEYAND, 'AN', 'D'+128 DB KEYABS, 'AB', 'S'+128 DB KEYATA, 'AT', 'N'+128 DB KEYASC-80H, 'AS', 'C'+128 KEYWRD2: DB KEYREM, 'RE', 'M'+128 DB KEYREA, 'REA', 'D'+128 DB KEYRUN, 'RU', 'N'+128 DB KEYRES, 'RESTOR', 'E'+128 DB KEYRET, 'RETUR', 'N'+128 DB KEYRND, 'RN', 'D'+128 DB KEYRIG-80H, 'RIGHT', '$'+128 KEYWRD3: ; ; Page 10 ; DB KEYSTOP, 'STO', 'P'+128 DB KEYCON, 'CON', 'T'+128 DB KEYCLR, 'CLEA', 'R'+128 DB KEYCSV, 'SAV', 'E'+128 DB KEYSET, 'SE', 'T'+128 DB KEYSTEP, 'STE', 'P'+128 DB KEYSPC, 'SP', 'C'+128 DB KEYSGN, 'SG', 'N'+128 DB KEYSQR, 'SQ', 'R'+128 DB KEYCOS, 'CO', 'S'+128 DB KEYSIN, 'SI', 'N'+128 DB KEYSTR, 'STR', '$'+128 DB KEYCHR-80H, 'CHR', '$'+128 KEYWRD4: DB KEYDAT, 'DAT', 'A'+128 DB KEYDIM, 'DI', 'M'+128 DB KEYDEL, 'DELET', 'E'+128 DB KEYDEF, 'DE', 'F'+128 DB KEYTHEN, 'THE', 'N'+128 DB KEYTO, 'T', 'O'+128 DB KEYTAB, 'TA', 'B'+128 DB KEYTAN-80H, 'TA', 'N'+128 KEYWRD5: DB KEYEND, 'EN', 'D'+128 DB KEYELS, 'ELS', 'E'+128 DB KEYEDI, 'EDI', 'T'+128 DB KEYEXP, 'EX', 'P'+128 DB KEYUSR, 'US', 'R'+128 DB KEYUPR-80H, 'UPPER', '$'+128 ; ; Page 11 ; KEYWRD6: DB KEYFOR, 'FO', 'R'+128 DB KEYFN, 'F', 'N'+128 DB KEYFRE, 'FR', 'E'+128 DB KEYVAL-80H, 'VA', 'L'+128 KEYWRD7: DB KEYGTO, 'GOT', 'O'+128 DB KEYGSB, 'GOSU', 'B'+128 DB KEYWAI-80H, 'WAI', 'T'+128 KEYWRD8: DB KEYHEX, 'HEX', '$'+128 DB KEYHXV-80H, 'HEX', 'V'+128 KEYWRD9: DB KEYINPT, 'INPU', 'T'+128 DB KEYIF, 'I', 'F'+128 DB KEYINT, 'IN', 'T'+128 DB KEYINS-80H, 'INST', 'R'+128 KEYWRDA: DB KEYMUL-80H, '*'+128 KEYWRDB: DB KEYADD-80H, '+'+128 KEYWRDC: DB KEYLET, 'LE', 'T'+128 DB KEYLIS, 'LIS', 'T'+128 DB KEYCLD, 'LOA', 'D'+128 DB KEYLINE, 'LIN', 'E'+128 DB KEYLT, '<'+128 DB KEYLOG, 'LO', 'G'+128 DB KEYLEN, 'LE', 'N'+128 DB KEYLFT-80H, 'LEFT', '$'+128 KEYWRDD: DB KEYSUB, '-'+128 DB KEYMOD, 'MO', 'D'+128 DB KEYMAX, 'MA', 'X'+128 DB KEYMIN, 'MI', 'N'+128 ; ; Page 12 ; DB KEYEQ, '='+128 DB KEYMEM, 'ME', 'M'+128 DB KEYMID-80H, 'MID', '$'+128 KEYWRDE: DB KEYNEX, 'NEX','T'+128 DB KEYNEW, 'NE','W'+128 DB KEYNOT, 'NO','T'+128 DB KEYEXPT, '^'+128 DB KEYGT-80H, '>'+128 KEYWRDF: DB KEYPRT, '?'+128 DB KEYON, 'O', 'N'+128 DB KEYOFF, 'OF', 'F'+128 DB KEYDIV, '/'+128 DB KEYOR-80H, 'O', 'R'+128 ; ; Page 13 ERRN: ;ERROR CODES ERRNCN: DB 'CONTINUE',0 ;CONTINUE ERROR ERRNSL: DB 'DEVICE',0 ;SAVE/LOAD DEVICE ERROR ERRNDD: DB 'DIMENSION',0 ;DOUBLE DIMENSION ERRNID: DB 'DIRECT',0 ;ILLEGAL DIRECT ERRND0: DB 'DIVIDE BY 0',0 ;DIVISION BY ZERO ERRNFC: DB 'FUNCTION CALL',0 ;FUNCTION CALL ERRNLS: DB 'LONG STRING',0 ;LONG STRING ERRNOM: DB 'MEMORY SPACE',0 ;OUT OF MEMORY ERRNNF: DB 'NEXT W/O FOR',0 ;NEXT WITHOUT FOR ERRNOD: DB 'OUT OF DATA',0 ;OUT OF DATA ERRNOV: DB 'OVERFLOW',0 ;OVERFLOW ERRNRG: ; ; Page 14 ; DB 'RETN W/O GOSUB',0 ;RETURN WITHOUT GOSUB ERRNOS: DB 'STRING SPACE',0 ;OUT OF STRING SPACE ERRNST: DB 'STRING TEMPS',0 ;STRING TEMPORARIES ERRNBS: DB 'SUBSCRIPT',0 ;BAD SUBSCRIPT ERRNSN: DB 'SYNTAX',0 ;SYNTAX ERROR ERRNTM: DB 'TYPE',0 ;TYPE MISMATCH ERRNUF: DB 'UNDFND FUNCTION',0 ;UNDEFINED FUNCTION ERRNUS: DB 'UNDFND LINE',0 ;UNDEFINED STATEMENT ERRNUV: DB 'UNDFND VARIABLE',0 ;UNDEFINED VARIABLE ERRNFI: DB 'File not Saved',0 ;unknown file name ; ; Page 15 ; ; ; INTERPRETER VARIABLES ; ; VARIABLES MARKED WITH SAME CHARACTER IN COLUMN 71 ; ARE FIXED IN THAT ORDER. ; p3010: db 1 ;0 to print on 3010 REAINPFL: DB 0 ;READ/INPUT FLAG PRINTFLG: DB 0 ;PRINT/NO PRINT FLAG TRACEFLG: DB 1 ;TRACE/NO TRACE FLAG SCANPFLG: DB 0 ;SCAN/NOSCAN PARENTHESIS FLAG SCANPFLE: DB 1 ;ARRAY NAME FOR ERASE SCANPFLD EQU KEYS-'(' ;NO ARRAY ELEMENTS WANTED MATSCCNT: DB 0 ;SUBSCRIPT COUNT MATDMFLG: DB 0 ;SCANNING FOR VAR/DIMENSION V TYPEFLG: DB 0 ;TYPE FLAG V TYPEINTG EQU 2 ;TYPE OF INTEGER TYPESTRG EQU 3 ;TYPE OF STRING TYPESING EQU 4 ;TYPE OF SINGLE FLOATING POINT TYPEDUBL EQU 8 ;TYPE OF DOUBLE FLOATING POINT TYPEDEF EQU 080H/4 ;MARKING BIT FOR USER-FUNCTION STRGTMPL: DB 0 ;TEMP STRING DESCRIPTR, LEN S STRGTMPA: DW 0 ;TEMP STRING DESCRIPTR, ADDR S SCANPTR1: DW 0 ;SCAN POINTER SCANPTR2: DW 0 ;SCAN POINTER CURLINE: DW -1 ;CURRENT LINE NUMBER CURLINES: DW 0 ;SAVED CURRENT LINE NUMBER PROGCNTR: DW ENDINTRP+12 ;CURRENT PROGRAM LOCATION VARINDEX EQU PROGCNTR ;INDEX VARIABLE OF FOR PROGCNTS: DW 0 ;SAVED CURRENT PROGRAMLOCATION CURLDATA: DW 0 ;CURRENT DATA LINE NUMBER CURDATAP: DW ENDINTRP ;CURRENT DATA POINTER INPTBUFR: DW INITSTSP ;INPUT BUFFER ADDRESS PREDREL EQU 064H ;PRECEDENCE OF RELATION PREDNUM EQU 070H ;LOWER BNDRY OF NUM OP PREC. PREDNOT EQU 05AH ;PRECEDENCE OF NOT OPERATOR PREDUMIN EQU 07DH ;PRECEDENCE OF UNARY MINUS LINESYZE EQU 79+78 ;DEFAULT LINESYZE ITEMSIZE EQU 14 ;DEFAULT WIDTH OF PRINT ITEM ; ; Page 16 ; ; ; MEMORY ALLOCATIN POINTERS ; ; LIMLOWER EQU 08000H LIMUPPER EQU 0AF00H ; ; MEMORY LAYOUT ; ; ENCODE BUFFER ; PROGRAM ; VARIABLES ; ARRAYS ; FREE SPACE / STACK (INCLUDING BUFFERS) ; FREE STRING SPACE ; STRINGS ; STRING TEMPORARIES ; FREE STRING TEMPORARIES ; PROGBASE: DW ENDINTRP+13 ;BASE OF PROGRAM SPACE VARTABLE: DW ENDINTRP+15 ;BASE OF VARIABLE TABLE MATTABLE: DW ENDINTRP+15 ;BASE OF ARRAY TABLE FREELIMT: DW ENDINTRP+15 ;LOWER LIMIT OF FREE SPACE STCKBASE: DW INITSTCK ;BASE OF STACK STRGFREE: DW INITSTCK+10 ;FIRST FREE STRING SPACE STRGBASE: DW INITSTCK+10 ;BASE OF STRING SPACE STRGTMPP: DW INITSTCK+11 ;STRING TEMPORARY ALLOC PTR STRGTLIM: DW INITSTCK+10+2*3 ;STRING TEMPORARY LIMIT ACCUMLTR: DB 0,0 ;ACCUMULATOR A FLACCMSB: DB 0 ;SIGN-BIT/HIGH-ORDER MANTISSA A FLACCEXP: DB 0 ;EXPONENT A FLACCSSV: DB 0 ;SAVED SIGN A NULLCNT: DB 1 ;# OF NULLS TO INSERT AFTER (CR) CURSPOS: DB 1 ;CHARACTER CURSOR POSITION C CURSLIM: DB 256-LINESYZE ;OUTPUT CURSOR LIMIT C FLSCR0: DB 0 ;FLOATING POINT SCRATCH AREA FLSCR1: DB 1 FLSCR2: DB 2 FLSCR3: DB 3 INOTINS EQU FLSCR0 ;INPUT/OUTPUT INSTRUCTIONS OPCINP EQU 0DBH ;INPUT INSTRUCTION OPCOUT EQU 0D3H ;OUTPUT INSTRUCTION OPCRET EQU 0C9H ;RETURN INSTRUCTION RNDFCTSD: DB 052h, 0c7h, 04fh, 080h ;RANDOM SEED ; ; Page 17 ; ; ; ; GENERAL USE SUBROUTINES ; ; ; SCAN ONE CHARACTER AND CLASSIFY ; SCANNXTV: MOV A,M ;SCAN CURRENT BYTE, XTHL CMP M ;VERIFY MATCH, INX H XTHL JNZ ERRASN ;SQUAWK ABOUT SYNTAX ERROR SCANNXT: INX H ;SCAN FOR NEXT NON-BLANK CHAR MOV A,M ;C=NUMERIC CHARACTER CPI ':' ;Z=END OF STATEMENT RNC CPI ' ' JZ SCANNXT CPI '0' CMC INR A DCR A RET ; ; Page 18 ; ; ; TEST FOR ALPHABETIC CHARACTER ; ALPHACHK: MOV A,M ;TEST FOR ALPHABETIC CHARACTER ALPHACHA: CPI 'z'+1 ;LOWER CASE RNC CPI 'a' ;LOWER CASE JNC ALPHACHL CPI 'Z'+1 ;C=ALPHABETIC RNC CPI 'A' ;UPPER CASE CMC RET ALPHACHL: ADI 'A'-'a' ;CONVERT LOWER TO UPPER RET ; ; MATCH CHARACTER OF BUFFER AGAINST CHARACTER IN A ; CHARMTCH: XRA M ;MAKE MATCH TEST RZ ;Z-SUCCESS] CPI 'a'-'A' ;LOWER CASE - UPPER CASE RNZ ;NOT LOWER-UPPER DIFFERENCE CALL ALPHACHK ;ALPHABETIC? SBB A INR A ;Z=C,S=0 RET ; ; CHECK TYPE OF EXPRESSION LEN CHAR ; RETURNS: S => INTEGER 2 % ; Z => STRING 3 $ ; PO => SINGLE 4 @ ; NC => DOUBLE 8 # TYPECHK: LDA TYPEFLG TYPECHKA: CPI TYPESING+1 DCR A DCR A DCR A ORA A STC RET ; ; Page 19 ; ; ; SCAN A PAIR OF LINE NUMBER PARAMETERS ; SCANLPRZ: LXI B,0 ;DEFAULT SECOND IS FIRST SCANLPRM: CNZ SCANLINN ;DEFAULT FIRST IS IN DE PUSH PSW MOV A,B ORA C ;ZERO DEFAULT IS FIRST PARAMETER JNZ SCANLPR1 MOV B,D MOV C,E SCANLPR1: POP PSW XCHG XTHL ;PUT FIRST ONTO STACK PUSH H XCHG MOV D,B MOV E,C RZ CPI KEYDIV ;SEPARATOR MUST BE '/'. JZ SCANLPR2 CALL SCANNXTV ;bscan (val) DB ',' ; OR ',' DCX H SCANLPR2: LXI D,0FFFFH ;EMPTY SECOND OPERAND = END CALL SCANNXT ;bscan , RZ ; ; SCAN A LINE NUMBER ; SCANLINN: DCX H ;SCAN LINE # IN COMMAND/STATEMENT SCANLINR: LXI D,0 ;DEFAULT LINE IS 0, INITIALIZE SCANLINL: CALL SCANNXT ;bscan , RNC PUSH H PUSH PSW LXI H,0FFFFH/10-1 CALL CMHLLTDE JC ERRASN MOV H,D MOV L,E ;HL=10*DE DAD D DAD H DAD D DAD H POP PSW SUI '0' ;GET VALUE OF NEXT DIGIT ; ; Page 20 ; MOV E,A MVI D,000H DAD D ;AND ADD IT ON XCHG POP H JMP SCANLINL ; ; Page 21 ; ; ; SEARCH FOR A GIVEN LINE NUMBER ; LINESRCH: LHLD PROGBASE ;LOOK FOR LINE NUMBER IN DE LINESRCL: PUSH H ;C=LINE FOUND CALL LINELINK ;BC=LINE LOCATION, IF FOUND JZ POPHLRET ;=NEXT LINE, IF NOT FOUND PUSH B ;ADDRESS OF NEXT LINE MOV A,M ;GET NUMBER OF CURRENT LINE INX H MOV H,M ;(from HL,MA) MOV L,A CALL CMHLLTDE POP H ;HL=NEXT LINE POP B CMC RZ JNC LINESRCL MOV H,B MOV L,C CMC RET ; ; LINK TO NEXT LINE ; LINELINK: PUSH H ;FIND ADDRESS OF NEXT LINE MOV C,M ;Z=END OF PROGRAM INX H MOV B,M INX H XTHL DAD B ;ADD LENGTH TO ADDRESS XTHL MOV A,B ORA C POP B RET ; ; Page 22 ; ; ; INSERT/REPLACE LINE OF PROGRAM ; LINEINS: PUSH D ;DE=LINE NUMBER CNC KEYSCAN ;C=ALREADY KEY-SCANNED CALL SCANNXT ;bscan , NC=MUST BE KEY-SCANNED POP D PUSH H ;HL=TEXT TO INSERT PUSH D PUSH B ;BC=LENGTH OF TEXT PUSH PSW ;Z=DELETE, NO REPLACE CALL LINESRCH ;LOOK FOR LINE PUSH B ;SAVE LOCATION CC LINEDEL ;DELETE IF PRESENT POP D POP PSW JZ POPHL3RT ;EXIT IF NOTHING MORE LHLD FREELIMT ;PULL APART FOR NEW LINE XTHL POP B PUSH H DAD B CALL COPYCHK XCHG POP B MOV M,C ;BEGINNING OF NEW LINE INX H MOV M,B INX H POP D MOV M,E ;INSERT LINE NUMBER INX H MOV M,D INX H XCHG POP H ;RECOVER TEXT POINTER LINEINSL: MOV A,M ;INSERT TEXT OF NEW LINE STAX D INX H INX D ORA A JNZ LINEINSL JMP LINEDELU ; ; Page 23 ; ; ; DELETE TEXT FROM PROGRAM ; LINEDEL: XCHG ;BC=BEGINNING OF TEXT TO REMOVE MOV A,C SUB E ;COMPUTE NETATIVE OF MOV L,A ;NUMBER OF BYTES DELETED MOV A,B SBB D MOV H,A PUSH H LHLD FREELIMT ;HL=BEGINNING OF TEXT SURVIVING LINEDELL: LDAX D STAX B INX B INX D CALL CMHLLTDE JNC LINEDELL POP B LINEDELU: LHLD FREELIMT ;UPDATE DATA POINTERS DAD B ;BC=INCREMENT SHLD FREELIMT LHLD MATTABLE DAD B SHLD MATTABLE LHLD VARTABLE DAD B SHLD VARTABLE JMP CLEARPCN ; ; MAKE SIXTEEN BIT COMPARISON ; CMHLLTDE: MOV A,H ;COMPARE DE VS HL SUB D ;C=HL screen ;ECHO CHARACTER JMP INPTLINL INPTCRTN: DCR B ;CARRIAGE RETURN AT BEGINNING JZ INPTCRLF ;GETS ANOTHER TURN INPTEXIT: LHLD INPTBUFR DCX H CALL PRNTCRLF SUB B ;SET CONDITION CODES CMC SBB A ;NS=NC=Z = NON-EMPTY LINE RET MSGSTARS: DB '***',0 ; ; Page 36 ; ; ; SET OPTIONS COMMAND ; SETSTM: JZ ERRASN ;TURN OPTION ON OR OFF CPI KEYLIS JZ SETSTMLS PUSH PSW ;SAVE OPTION CALL SCANNXT ;bscan , JZ ERRASN SUI KEYON MOV B,A ;SAVE FLAG CALL SCANNXT ;bscan + POP PSW ;WHICH OPTION CPI KEYGTO JZ SETSTMGT ;GOTO CPI KEYPRT JNZ ERRASN SETSTMPR: MOV A,B sta p3010 ;used to be printflg ** RET SETSTMGT: MOV A,B STA TRACEFLG RET SETSTMLS: INX H CALL VALBYTE CMA ;FIND NEGATIVE OF BYTE INR A STA CURSLIM RET ; ; DELETE COMMAND PROCESSOR ; DELSTM: LXI D,0FFFFH ;DELETE COMMAND CALL SCANLPRZ XTHL ;SAVE SCAN POINTER XCHG CALL CMHLLTDE ;VERITY FIRST<=LAST JC ERRASN PUSH H CALL LINESRCH ;LOOK FOR FIRST LINE POP D PUSH B CALL LINESRCH ;LOOK FOR LAST LINE POP B CALL LINEDEL POP H RET ; ; Page 37 ; ; ; LIST COMMAND PROCESSOR ; LISSTM: LXI D,0 ;LIST COMMAND LXI B,0FFFFH ;TOTAL DEFAULT IS ENTIRE FILE JZ LISSTMSC LXI B,0 ;ELSE DEFAULT IS ONLY ONE LINE LISSTMSC: CALL SCANLPRM ;SCAN LINE PARAMETERS JNZ ERRASN XTHL XCHG PUSH H CALL LINESRCH PUSH B LISSTMLP: POP B ;MOVE ON TO NEXT LINE POP D POP H CALL SYSBREAK ;ALLOW BREAK JZ EXECUTEB PUSH B XTHL CALL LINELINK JZ POPHLRET ;END OF PROGRAM, QUIT PUSH D PUSH B PUSH H ;SAVE TEXT FOR LATER MOV C,M ;FETCH LINE NUMBER INX H MOV B,M MOV H,B MOV L,C XCHG CALL CMHLLTDE JC LISSTMXT ;LAST LINE REACHED? CALL PRNTCRLF ;LIST CURRENT LINE XCHG CALL PRINTINT ;PRINT LINE NUMBER CALL PRNTCHRI ;print (val) DB ' ' ;FOLLOWED BY BLANK POP H CALL LISEDIXP ;EXPAND TEXT CALL PRNTMSG ;AND PRINT IT LXI H,0+LINESYZE+3 DAD SP SPHL ;DEALLOCATE EXPANDED TEXT JMP LISSTMLP ; ; Page 38 ; LISSTMXT: POP H POPHL3RT: POP H POP H POPHLRET: POP H RET ; ; EXPAND KEYWORDS IN LINE / INVERSE OF KEYSCAN ; LISEDIXP: MVI C,LINESYZE/2 ;SPACE ENOUGH TO EXPAND LINE? CALL SPACESTK XCHG ;SAVE POINTER TO LINE TO EXPAND POP B ;AND CALLER LXI H,0-LINESYZE-3 DAD SP SPHL ;CREATE TEXT BUFFER ON STACK PUSH B ;PUT BACK CALLER XCHG INX H INX H ;plus 2 PUSH H ;SAVE TEXT POINTER LXI H,4 ;CREATE POINTER TO EXPAND TEXT DAD SP XCHG MVI B,LINESYZE ;INITIALIZE LENGTH COUNTER JMP LISEDIKD LISEDISC: CALL LISEDIST ;STUFF ONE CHARACTER OF LINE LISEDIKD: POP H ;DO REST OF LINE MOV A,M LISEDINC: INX H CPI ':' JNZ LISEDIKT MOV A,M CPI KEYELS ;:ELSE BECOMES ELSE JZ LISEDINC MVI A,':' LISEDIKT: ANA A ;MOVE HIGH ORDER INTO S-FLAG JZ LISEDIXT PUSH H JP LISEDISC MOV C,A ; ; Page 39 ; LXI H,KEYLSBH*256+KEYLSBL CALL LISEDISB ;OPTIONAL BLANK BEFORE KEYWORD LXI H,KEYWORDS ;SEARCH FOR KEYWORD JMP LISEDIKS LISEDIKL: ORA M INX H JP LISEDIKL LISEDIKS: MOV A,M ;FETCH KEYWORD NUMBER ORI 080H INX H XRA C JNZ LISEDIKL LISEDIKY: MOV A,M ;EXPAND KEYWORD RLC ANA A ;HIGH-ORDER TO CARRY RAR CALL LISEDIST ;STUFF THIS CHARACTER INX H JNC LISEDIKY ;DO THEM ALL MOV A,C LXI H,KEYLSAH*256+KEYLSAL CALL LISEDISB ;OPTIONAL BLANK AFTER KEYWORD JMP LISEDIKD LISEDISB: CMP L ;INSERT BLANK IN LINE IF RC ;L <= A < H CMP H RNC MVI A,' ' ;GENERATE BLANK LISEDIST: STAX D INX D DCR B RNZ ;TRUNCATE TOO LONG A LINE INR B DCX H RET LISEDIXT: STAX D MVI A,LINESYZE+1 ;COMPUTE LENGTH OF OUTPUT SUB B MOV B,A LXI H,2 ;CREATE POINTER TO EXPAND TEXT DAD SP RET ;AND RETURN ; ; Page 40 ; ; ; EDIT COMMAND PROCESSOR ; EDISTM: LXI D,0 ;SCAN PARAMETERS CALL SCANLPRZ XTHL ;SAVE SCAN, SHLD SCANPTR1 ;AND OUTPUT LINE NUMBER CALL LINESRCH ;LOOK UP LINE JNC ERRAUS ;NOT FOUND... MOV H,B MOV L,C INX H INX H ;plus 2 CALL LISEDIXP ;EXPAND LINE LHLD SCANPTR1 ;RECOVER LINE NUMBER PUSH H EDISTMLS: CALL EDISTMCR ;GIVE HIM A LOOK AT IT CALL PRNTMSG ;PRINT COPY OF TEXT CALL EDISTMCR ;A NEW EDIT LINE MVI C,1 ;POSITION COUNTER EDISTMNX: CALL EDISTMCH ;OK MASTER, TELL ME WHAT TO DO CPI ' ' ;MOVE ALONG JZ EDISTMAD CALL ALPHACHA ;CONVERT LOWER TO UPPER CPI 'D' ;DELETE JZ EDISTMDL CPI 'I' ;INSERT JZ EDISTMIN CPI 'R' ;REPLACE JZ EDISTMRP EDISTMER: MVI A,BEL ;SQUAWK ABOUT ERROR EDISTMEC: CALL PRNTCHRA ;ac -> screen JMP EDISTMNX ; ADVANCE ; EDISTMAD: MOV A,C CMP B ;CAN WE STILL ADVANCE? JNC EDISTMER INR C ;ADVANCE POSITION COUNTER MOV A,M INX H ;PRINT CHARACTER PASSED OVER JMP EDISTMEC ; ; Page 41 ; ; DELETE ; EDISTMDL: MOV A,C CMP B ;ANYTHING TO DELETE? JNC EDISTMER DCR B ;DECREASE CHARACTER COUNT PUSH H ;SAVE CURRENT POSITION MOV A,M CALL PRNTCHRA ;LIST CHARACTER DELETED MOV D,H MOV E,L EDISTMDM: INX H MOV A,M ;MOVE THIS CHARACTER DOWNWARD STAX D INX D ORA A JNZ EDISTMDM POP H JMP EDISTMNX ; INSERT ; EDISTMIN: CALL EDISTMCH ;GET SOMETHING TO PUT IN MOV D,A ;SAVE COPY OF CHARACTER EDISTMRI: MOV A,B CPI LINESYZE ;ROOM AT THE INNPUT BUFFER? JNC EDISTMER INR B ;COUNT NEWCOMER INR C ;NEXT ONE GOES AFTER HIM MOV A,D CALL PRNTCHRA ;ac -> screen ;PRINT NEWCOMER PUSH H ;SAVE CURRENT POSITION EDISTMIM: MOV E,M MOV M,A ;MOVE CHARACTERS UP ONE BYTE ORA A MOV A,E INX H JNZ EDISTMIM POP H INX H JMP EDISTMIN ; ; Page 42 ; ; REPLACE ; EDISTMRP: CALL EDISTMCH ;GET UPDATE CHARACTER MOV D,A MOV A,C CMP B ;REPLACING END OF LINE? JNC EDISTMRI ;IF SO, GO TO INSERT MOV M,D ;UPDATE THE CHARACTER INR C INX H MOV A,D CALL PRNTCHRA ;ac -> screen ;PRINT NEWCOMER JMP EDISTMRP ; SEARCH ; EDISTMSR: CALL EDISTMCH ;FIND CHARACTER TO SEARCH FOR CALL ALPHACHA ;CONVERT TO STANDARD CASE MOV D,A MVI E,0 EDISTMSL: MOV A,C CMP B JNC EDISTMER ;NO MORE, TERMINATE SEARCH CALL ALPHACHK ;FETCH CHARACTER IN STANDARD CASE CMP E JZ EDISTMNX ;GOTTA MATCH? CALL PRNTCHRA ;ac -> screen ;LIST FAILURES INR C INX H MOV E,D JMP EDISTMSL ;AND KEEP LOOKING ; ; Page 43 ; EDISTMXT: DCR C ;BEGINNING CR MEANS DONE, UPDATE JNZ EDISTMLS ;OTHERWISE, LIST, MORE EDITS POP D ;RETRIEVE LINE NUMBER LXI H,0 DAD SP ;POINT TO TEXT CALL LINEINS ;AND REINSERT EDISTMQT: LXI H,0+LINESYZE+3 DAD SP SPHL ;DEALLOCATE TEXT BUFFER POP H ;RECOVER SCAN POINTER RET ;AND RETURN ; LIST LINE, PREPARE FOR UPDATES ; EDISTMCR: POP D POP H ;RETRIEVE COPY OF LINE NUMBER PUSH H ;SAVE IT, PUSH D PUSH B ;AND LINE LENGTH CALL PRNTCRLF CALL PRINTINT ;PRINT LINE NUMBER CALL PRNTCHRI ;print (val) DB ' ' LXI H,6 DAD SP ;CREATE POINTER TO TEXT BUFFER POP B RET ; GET OPTION CHARACTER ; EDISTMCH: CALL INPTCHAR ;GET CHARACTER ROUTINE CPI ' ' RNC ;NOT CONTROL, RETURN CPI BEL RZ POP D ;REMOVE CALLER CPI HT ;SEARCH (TAB) JZ EDISTMSR CPI CR ;LIST, OR UPDATE JZ EDISTMXT CPI ESC ;TERMINATE OPTION JZ EDISTMNX CPI ETX ;ABORT, NO UPDATE JNZ EDISTMER LXI H,MSGSTARS ;TYPE BREAK MESSAGE CALL PRNTMSG POP D JMP EDISTMQT ; ; Page 44 ; ; ; SCAN STACK FOR 'FOR' LOOP ; FORBLCK EQU 16 ;SIZE OF 'FOR' STACK ENTRY FORCHK: LXI H,4 ;LOOK FOR MARK ON STACK DAD SP FORCHKL: MOV A,M INX H CPI KEYFOR RNZ MVI A,TYPESING STA TYPEFLG ;SET CORRECT TYPE FLAG MOV C,M ;MARK IS PRESENT INX H MOV B,M INX H PUSH H MOV H,B MOV L,C MOV A,D ;LOOKING FOR PARTICULAR VARIABLE? ORA E XCHG JZ FORCHKXT XCHG ;IS THIS IT? CALL CMHLLTDE FORCHKXT: LXI B,FORBLCK-3 POP H RZ DAD B JMP FORCHKL ; ; FOR STATEMENT PROCESSOR ; FORSTM: MVI A,SCANPFLD ;FOR STATEMENT STA SCANPFLG CALL LETSTM CALL TYPECHK JPE ERRATM ;MUST BE SINGLE INDEX XTHL ;SAVE SCANPTR, REMOVE CALLER XCHG SHLD VARINDEX XCHG CALL FORCHK POP D JNZ FORSTMNF DAD B SPHL FORSTMNF: XCHG MVI C,(FORBLCK+1)/2 ; ; Page 45 ; CALL SPACESTK PUSH H CALL DATSTM ;FIND FIRST STATEMENT IN FOR LOOP XTHL ;AND SAVE PUSH H LHLD CURLINE ;SAVE CURRENT LINE NUMBER XTHL CALL SCANNXTV ;bscan (val) DB KEYTO ;SCAN LIMIT VALUE, CALL VALNUMBR ;bscan numbr PUSH H CALL LDRGAC POP H PUSH B ;SAVE ON STACK PUSH D LXI B,08100H ;LOAD DEFAULT STEP=1.0 MOV D,C MOV E,D MOV A,M CPI KEYSTEP ;CHECK FOR EXPLICIT STEP SIZE MVI A,001H JNZ FORSTMST CALL SCANNXT ;bscan + CALL VALNUMBR ;bscan numbr PUSH H CALL LDRGAC POP H CALL SIGNACC FORSTMST: PUSH B ;SAVE STEP SIZE ON STACK PUSH D PUSH PSW ;SAVE DIRECTION INX SP PUSH H LHLD VARINDEX ;SAVE INDEX VARIABLE XTHL FORMARK: MVI B,KEYFOR ;MARK STACK WITH 'FOR' PUSH B INX SP ; ; Page 46 ; ; ; INTERPRETER EXECUTIVE ; EXECUTEL: CALL BREAKCHK ;USER HAVE ANY COMMENTS? SHLD PROGCNTR MOV A,M CPI ':' JZ EXECUTE ;MUTIPLE STATEMENTS ON LINE? ORA A JNZ ERRASN INX H ;END OF LINE, MOV A,M INX H ORA M INX H JZ ENDPROGM ;END OF PROGRAM? MOV E,M INX H MOV D,M XCHG SHLD CURLINE ;MOVE TO NEXT LINE XCHG EXECUTE: CALL SCANNXT ;bscan , ;EXECUTE STATEMENT LXI D,EXECUTEL PUSH D EXECUTEC: RZ EXECUTES: CPI KEYSTM ;WHAT KIND OF STATEMENT? JC LETSTM CPI KEYSUGR JNC EXECUTE2 ADD A MOV C,A MVI B,000H XCHG LXI H,STMTABL DAD B MOV C,M INX H MOV B,M PUSH B XCHG JMP SCANNXT ; ; Page 47 ; BREAKCHK: CALL SYSBREAK ;TIME TO TAKE A BREAK? STPSTM: RNZ ;STOP STATEMENT INR A EXECUTEB: SHLD PROGCNTR INPSTMBR: POP B ;THROW AWAY CALLER ENDPROGM: PUSH PSW LHLD CURLINE MOV A,L ANA H INR A JZ ENDSTMC SHLD CURLINES ;SAVE INFORMATION FOR CONTINUE LHLD PROGCNTR SHLD PROGCNTS ENDSTMC: XRA A STA PRINTFLG POP PSW LXI H,MSGBREAK JNZ ERRMSGPR JMP CMNDSTRT CONSTM: RNZ ;CONT COMMAND MVI E,ERRNCN-ERRN LHLD PROGCNTS MOV A,H ORA L JZ ERRMSG XCHG LHLD CURLINES SHLD CURLINE XCHG RET RUNSTM: JZ CLEARSET ;RUN COMMAND CALL CLEARVST LXI B,EXECUTEL JMP RUNSTMC ENDSTM: JZ EXECUTEB ;END STATEMENT CALL SCANNXTV ;bscan (val) DB KEYRUN JMP SYSQUIT ; ; Page 48 ; ; ; GOSUB/GOTO STATEMENTS ; GSBSTM: MVI C,3 ;GOSUB STATEMENT CALL SPACESTK POP B PUSH H PUSH H LHLD CURLINE XTHL MVI D,KEYGSB ;MARK STACK WITH GOSUB PUSH D INX SP RUNSTMC: PUSH B GTOSTM: CALL SCANLINN ;GOTO STATEMENT PUSH D CALL REMSTM POP D PUSH H CALL TRACE LHLD CURLINE CALL CMHLLTDE POP H INX H CC LINESRCL CNC LINESRCH MOV H,B MOV L,C DCX H RC ERRAUS: MVI E,ERRNUS-ERRN JMP ERRMSG ; ; RETURN STATEMENT ; RETSTM: RNZ ;RETURN STATEMENT MVI D,0FFH CALL FORCHK ;KILL ACTIVE FOR LOOPS SPHL ;INSIDE SUBROUTINE CPI KEYGSB MVI E,ERRNRG-ERRN JNZ ERRMSG POP D CALL TRACE XCHG SHLD CURLINE LXI H,EXECUTEL XTHL ; JMP DATSTM ; ; Page 49 ; ; ; DATA/ELSE/REM STATEMENTS ; DATSTM: MVI C,':' ;DATA STATEMENT JMP SCAN2KEY ELSSTM: REMSTM: MVI C,000H ;REM STATEMENT SCAN2KEY: MVI B,000H ;SKIP TO KEYWORD IN C DATRSKST: MOV A,C ;SET UP TERMINATING BYTE MOV C,B MOV B,A DATRSKIP: MOV A,M ;SKIP TO TERMINATING BYTE ORA A RZ CMP B RZ INX H CPI '"' ;STRING TO SKIP? JZ DATRSKST CPI KEYIF JNZ DATRSKIP INR D ;COUNT NUMBER OF IFS WE SKIP JMP DATRSKIP ; ; PROGRAM BRANCH TRACING ; TRACE: LDA TRACEFLG ;TRACING? ORA A RNZ PUSH B PUSH D ;SAVE DESTINATION LINE NUMBER CALL PRNTCHRI ;print (val) DB '[' ;LEFT BRACKET LHLD CURLINE CALL PRINTINT ;PRINT CURRENT LINE NUMBER CALL PRNTCHRI ;print (val) DB ',' POP H PUSH H CALL PRINTINT ;PRINT DESTINATION LINE NUMBER CALL PRNTCHRI ;print (val) DB ']' ;RIGHT BRACKET POPDEBCR: POP D POP B RET ; ; Page 50 ; ; ; ASSIGNMENT STATEMENT PROCESSOR ; LETSTM: CALL VARSCAN ;LET STATEMENT CALL SCANNXTV ;bscan (val) DB KEYEQ ASSIGNVL: LDA TYPEFLG PUSH PSW PUSH D CALL VALEXPR ;bscan expr POP D POP PSW ASSIGN: XCHG ;MAKE THE ASSIGMENT PUSH D ;SAVE SCAN PUSH H ;SAVE VARIABLE CALL COERCE JNZ LETSTMNM CALL STRGUNIQ ;REMOVE CONFLICT PROBLEMS CALL STRGRELT ;RELEASE STRING TEMPORARY POP H ;COPY DESCRIPTOR TO DESTINATION CALL COPYVAL POP H RET LETSTMNM: CALL LDMMAC ;MAKE NUMERIC ASSIGNMENT POP D POP H RET STRGUNIQ: LHLD ACCUMLTR ;GET STRING DESCRIPTOR XCHG ;IS STRING IN STRING SPACE? CALL STRGTEST RNC CALL CMHLLTDE ;VARIABLE REFERENCE? CNC STRGSTOR ;IF SO, MAKE NEW COPY RET ; ; Page 51 ; ; ; COERCE ACCUMULATOR TO TYPE IN A ; COERCE: CALL TYPECHKA COERCEF: JPO CSINGLE JZ CSTRING JMP ERRATM VALNUMBR: CALL VALEXPR ;bscan expr CSINGLE: CALL TYPECHK RPO JMP ERRATM CSTRING: CALL TYPECHK RZ JMP ERRATM ERRATM: MVI E,ERRNTM-ERRN JMP ERRMSG VALINTDE: CALL VALNUMBR ;bscan numbr EVAL POSITIVE INTEGER EXPR CINTPOS: CALL SIGNACC ;CONVERT TO INTEGER JM ERRAFC CINTEGER: LDA FLACCEXP CPI 090H JC FIXAC LXI B,09080H LXI D,00000H CALL FLCMP MOV D,C RZ ERRAFC: MVI E,ERRNFC-ERRN JMP ERRMSG VALBYTE2: CALL SCANNXTV ;bscan (val) DB ',' ;EVAL LATER BYTE ARGUMENTS VALBYTE: CALL VALNUMBR ;bscan numbr EVAL BYTE EXPRESSION CBYTE: CALL CINTPOS ;CONVERT ACC TO BYTE MOV A,D ORA A JNZ ERRAFC ; ; Page 52 ; DCX H CALL SCANNXT ;bscan , MOV A,E RET EXECUTE2: CPI KEYPORT ;PORT OUTPUT? JZ PORSTM CPI KEYMEM ;MEMORY ALTERATION? JZ MEMSTM ; ; MID-STRING ASSIGNMENT STATEMENT ; MIDSTM: CALL SCANNXTV ;bscan (val) DB KEYMID ;ENTER POINTING TO 'MID$' CALL SCANNXTV ;bscan (val) DB '(' CALL VARSCAN ;SCAN VARIABLE TO UPDATE CALL CSTRING ;MAKE SURE IT'S A STRING PUSH D ;SAVE REFERENCE PUSH H CALL STRGTEST ;WHERE IS STRING NOW? PUSH D ;SHOULDN'T BE IN PROGRAM CNC STRGSTOR ;OR ELSE WE MODIFY OURSELF POP H CALL COPYVAL POP H ;CONTINUE SCAN CALL VALBYTE2 ;SCAN STARTING POSITION ORA A JZ ERRAFC ;MUST BE NON-ZERO PUSH D MVI E,0FFH MOV A,M CPI ')' ;DEFAULT LENGTH? CNZ VALBYTE2 ;SCAN LENGTH, IF GIVEN CALL SCANNXTV ;bscan (val) DB ')' POP B ;CONDENSE STACK MOV D,C PUSH D CALL SCANNXTV ;bscan (val) DB KEYEQ CALL VALEXPR ;bscan expr ;EVALUATE RIGHT HAND SIDE SHLD SCANPTR1 CALL LENFCTC ;RELEASE STRING RESOURCE MOV C,M ;AND LOAD DESCRIPTOR INX H MOV B,M POP D ;GET BACK LENGTH, START CMP E JNC MIDSTMLN ;LENMOV = MIN(LENI, LENS) MOV E,A MIDSTMLN: POP H ;RECOVER DESTINATION DESCRIPTOR ; ; Page 53 ; MOV A,M ;GET ITS LENGTH DCR D SUB D ;SUBTRACT STARTING POSITION JC MIDSTMXT ;NOTHING TO DO IF BEYOND ; ; Page 54 ; CMP E JNC MIDSTMLM MOV E,A MIDSTMLM: PUSH B ;SAVE SOURCE ADDRESS CALL LDICBMM ;COMPUTE DESTINATION ADDRESS MOV L,D MVI H,0 DAD B XCHG POP B CALL COPYSTRG ;COPY STRING MIDSTMXT: LHLD SCANPTR1 RET ; ; LOCATE STRING REFERENCE BY DE ; STRGTEST: PUSH D ;DE=STRING REFERENCE XCHG INX H ;GET ADDRESS OF STRING MOV E,M INX H MOV D,M LHLD FREELIMT ;BOUNDARY CALL CMHLLTDE ;NC = STRING IN PROGRAM POP D ;C = STRIN IN BUFFER RET ;OR STRING SPACE ; ; Page 55 ; ; ; CASE/CONDITINAL STATEMENT PROCESSORS ; ONSTM: CALL VALBYTE ;ON STATEMENT MOV A,M MOV B,A CPI KEYGSB ;GOSUB RATHER THAN GOTO? JZ ONNSTMC CALL SCANNXTV ;bscan (val) DB KEYGTO ;MUST BE GOTO... DCX H ONNSTMC: MOV C,E ONNSTMSL: DCR C ;LOOK FOR RIGHT LINE NUMBER MOV A,B JZ EXECUTES ;THEN EXECUTE STATEMENT CALL SCANLINR CPI ',' RNZ JMP ONNSTMSL IFSTM: CALL VALNUMBR ;bscan numbr ;IF STATEMENT MOV A,M CPI KEYGTO JZ IFNSTMC CALL SCANNXTV ;bscan (val) DB KEYTHEN IFNSTMC: CALL SIGNACC ;TEST CONDITION JNZ IFNSTMCH MVI D,1 IFNSTMSK: MVI C,KEYELS CALL SCAN2KEY ;SKIP TO CORRESPONDING ELSE ORA A RZ ;OR END OF LINE CALL SCANNXT ;bscan + DCR D JNZ IFNSTMSK IFNSTMCH: DCX H ;bscan - CALL SCANNXT ;bscan , ;CHOICE MADE JC GTOSTM ;GOTO A LABEL, JMP EXECUTEC ;OR EXECUTE A STATEMENT ; ; Page 56 ; ; ; PRINT STATEMENT PROCESSOR ; PRTSTMN: CPI KEYTAB ;TAB OPTION? JZ PRNTOPTN CPI KEYSPC ;SPACE OPTION JZ PRNTOPTN PUSH H CPI ',' JZ PRNTCOMA CPI ';' JZ PRNTSEMI POP B CALL VALEXPR ;bscan expr DCX H ;bscan - PUSH H CALL TYPECHK JZ PRTSTRNG CALL VALSTRGN ;CREATE STRING FROM NUMBER LHLD ACCUMLTR ;VERIFY ROOM ENOUGH ON LINE MOV A,M LXI H,CURSPOS ADD M INX H ADD M CC PRNTCRLF ;NO ROOM, FIND ANOTHER LINE CALL PRNTSTRT CALL PRNTCHRI ;print (val) DB ' ' INR A PRTSTRNG: CZ PRNTSTRT ;SEND OUTPUT STRING POP H CALL SCANNXT ;bscan , PRTSTM: JNZ PRTSTMN ;PRINT STATEMENT PRNTCRLF: CALL PRNTCHRI ;print (val) DB CR ;PRINT A CR, LF CALL PRNTCHRI ;print (val) DB LF PRNTNULS: LDA NULLCNT ;PRINT NULLS AFTER CR PRNTNULL: DCR A STA CURSPOS RZ PUSH PSW XRA A CALL PRNTCHRA ;ac -> screen POP PSW JMP PRNTNULL ; ; Page 57 ; PRNTCOMA: LDA CURSPOS ;COMMA SEPARATOR CPI ((LINESYZE/ITEMSIZE)-1)*ITEMSIZE CNC PRNTCRLF JNC PRNTSEMI PRNTCOML: SUI ITEMSIZE JNC PRNTCOML CMA JMP PRNTCOMC PRNTOPTN: PUSH PSW CALL SCANNXT ;bscan + CALL VALPARNS ;GET OPTION PARAMETER CALL CSINGLE CALL CBYTE DCX H POP PSW CPI KEYSPC PUSH H MOV A,E JZ PRNTBLNK LDA CURSPOS CMA ADD E JNC PRNTSEMI PRNTCOMC: INR A PRNTBLNK: MOV B,A ;PAD OUTPUT WITH A BLANKS ORA A JZ PRNTSEMI MVI A,' ' PRNTBLNL: CALL PRNTCHRA ;ac -> screen DCR B JNZ PRNTBLNL PRNTSEMI: POP H CALL SCANNXT ;bscan , RZ JMP PRTSTMN ; ; Page 58 ; PRNTNUMS: INX H ;SEND STRING TO TRANSMITTER PRNTMSG: PUSH B PUSH D LXI B,POPDEBCR PUSH B CALL VALSTRGZ ;STRING ENDS ON ZERO PRNTSTRT: CALL STRGRELA CALL LDDCBMM INR D PRNTSTRL: DCR D RZ LDAX B CALL PRNTCHRA ;ac -> screen CPI CR CZ PRNTNULS INX B JMP PRNTSTRL ; ; RETURN CURRENT POTITION ON OUTPUT LINE ; POSFCT: LDA CURSPOS ;POS FUNCTION FLOATA: MOV B,A ;RETURN BYTE ANSWER XRA A JMP FLOATAB ; ; PLOT STATEMENT ; PLTSTM: CALL VALNUMBR ;bscan numbr ;GET X-COORDINATE CALL CINTEGER PUSH D CALL SCANNXTV ;bscan (val) DB ',' CALL VALNUMBR ;bscan numbr ;GET Y-COORDINATE CALL CINTEGER PUSH D CALL SCANNXTV ;bscan (val) DB ',' CALL VALNUMBR ;bscan numbr ;GET OPERATION CALL CINTEGER MOV A,E POP D POP B PUSH H ; CALL SYSPLOT POP H RET ; ; Page 59 ; ; ; INPUT/READ STATEMENT PROCESSORS ; MSGQUES: DB '??',0 MSGREDO: DB '?REDO FROM START',CR,LF,0 MSGEXTRA: DB '?EXTRA IGNORED',CR,LF,0 ; INPUT ; INPSTM: XRA A ;INPUT STATEMENT STA PRINTFLG ;TURN ON PRINTING INPSTMRD: PUSH H ;SAVE SCAN IN CASE OF ERROR MVI C,LINESYZE/2 CALL SPACESTK XCHG LHLD INPTBUFR ;SAVE ADDRESS OF CURRENT BUFFER PUSH H LXI H,0-LINESYZE-3 DAD SP SPHL ;AND CREATE A NEW BUFFER SHLD INPTBUFR XCHG MOV A,M CPI '"' JZ INPSTMPR CPI KEYPRM LXI D,MSGQUES+1 JNZ INPSTMIN CALL SCANNXT ;bscan + INPSTMPR: CALL VALEXPR ;bscan expr ;OPTIONAL PROMPT STRING CALL CSTRING CALL SCANNXTV ;bscan (val) DB ';' PUSH H CALL PRNTSTRT POP H LXI D,MSGQUES+2 INPSTMIN: PUSH H CALL DATAINPT ; ; Page 60 ; JMP REAINPFS ; READ ; REASTM: PUSH H ;READ STATEMENT LHLD CURDATAP MOV A,M ORA A CZ DATASRCH ;GET DATA IF NECESSARY REAINPFS: STA REAINPFL JMP REAINPLQ REAINPLP: CALL SCANNXTV ;bscan (val) DB ',' XTHL MOV A,M CPI ',' CNZ DATAGET REAINPLQ: XTHL MOV A,M CPI KEYLINE ;LINE OPTION? JZ INPSTMLN CALL VARSCAN ;FIND NEXT VARIABLE TO BE INPUT XTHL ;SAVE INPUT LIST POINTER PUSH D ;SAVE VARIABLE POINTER, LDA TYPEFLG ;AND TYPE PUSH PSW CALL REAINPDC ;DECODE INPUT REAINPLA: POP PSW ;ASSIGN VALUE POP D CALL ASSIGN DCX H ;bscan - CALL SCANNXT ;bscan , JZ REAINPCM CPI ',' ;DATA ITEMS SEPARTED BY COMMAS JNZ REAINPER REAINPCM: XTHL DCX H ;bscan - ;MORE VARIABLES? CALL SCANNXT ;bscan , JNZ REAINPLP POP D ;END OF VARLIST LDA REAINPFL ORA A XCHG JNZ RESDTPTR PUSH D PUSH PSW ORA M LXI H,MSGEXTRA INPSTMER: ; ; Page 61 ; CNZ PRNTMSG POP PSW ; ; Page 62 ; INPSTMXT: POP D ;RECOVER SCAN POINTER LXI H,0+LINESYZE+3 DAD SP SPHL ;DEALLOCATE BUFFER POP H SHLD INPTBUFR ;AND RESTORE ADDRESS OF OLD XCHG POP D RZ JM INPSTMBR ;BREAK TIME... XCHG JMP INPSTMRD ;OR REDO THE INPUT REAINPER: LDA REAINPFL ORA A JNZ ERRDATA LXI H,MSGREDO INR A PUSH PSW JMP INPSTMER ; ; SEARCH FOR DATA STATEMENT ; DATAGET: LDA REAINPFL ORA A ;READ OR INPUT? LXI D,MSGQUES JZ DATAINPT ;INPUT DATASRCH: CALL DATSTM ;LOOK FOR NEXT DATA STATEMENT ORA A JNZ DATASRCK INX H MOV A,M INX H ORA M INX H MVI E,ERRNOD-ERRN JZ ERRMSG MOV E,M INX H MOV D,M XCHG SHLD CURLDATA XCHG DATASRCK: CALL SCANNXT ;bscan , CPI KEYDAT JNZ DATASRCH RET DATAINPT: ; ; PAGE 63 ; CALL INPTRQST RZ ;INPUT OK, RETURN POP B ;BREAK *** JMP INPSTMXT REAINPDC: CALL SCANNXT ;bscan , CALL TYPECHK MOV A,M JNZ DECODE ;READ/INPUT A NUMBER CPI '"' JZ VALSTRGC MVI D,':' MVI B,',' DCX H JMP VALSTRGS ;READ/INPUT A STRING INPSTMLN: LDA REAINPFL ;LINE OPTION VALID ONLY ORA A ;FOR INPUT STATEMENT JNZ ERRASN CALL SCANNXT ;bscan + CALL VARSCAN XTHL PUSH D LDA TYPEFLG PUSH PSW MVI B,0 CALL VALSTRGY ;SWALOW REST OF INPUT LINE JMP REAINPLA ;AND ASSIGN TO STRING VARIABLE ; ; Page 64 ; ; ; NEXT STATEMENT PROCESSOR ; NEXSTM: LXI D,0 ;NEXT STATEMENT NEXSTML: CNZ VARSCAN SHLD PROGCNTR CALL FORCHK ;VERIFY WE'RE IN FOR LOOP JNZ ERRANF SPHL ;BACK UP STACK PUSH D MOV A,M ;RECOVER SIGN OF STEPSIZE INX H PUSH PSW PUSH D CALL LDRGACMM ;RECOVER STEP SIZE XTHL PUSH H CALL FLADDM ;INCREMENT CONTROL VARIABLE POP H CALL LDMMAC POP H CALL LDRGMM PUSH H CALL FLCMP POP H POP B SUB B CALL LDRGMM ;RECOER LINE NUMBR, PROGRAM CNTR JZ NEXSTMC ;CHECK LIMIT CALL TRACE XCHG SHLD CURLINE MOV H,B MOV L,C JMP FORMARK ERRANF: MVI E,ERRNNF-ERRN JMP ERRMSG NEXSTMC: SPHL ;END OF LOOP... LHLD PROGCNTR MOV A,M CPI ',' JNZ EXECUTEL ;MORE INDICES? CALL SCANNXT ;bscan , CALL NEXSTML ; ; Page 65 ; ; ; EVALUTATE AN EXPRESSION ; VALEXPR: DCX H ;SCAN & EVALUATE AN EXPRESSION MVI D,0 ;INITIAL PRECEDENCE=0 VALEXPRL: PUSH D MVI C,1 CALL SPACESTK CALL VALPRMRY ;bscan prmry SHLD SCANPTR2 VALEXPRC: LHLD SCANPTR2 VALEXPRD: POP B ;PREVIOUS PRECEDENCE MOV A,B CPI PREDNUM CNC CSINGLE MOV A,M MVI D,000H VALEXPRR: SUI KEYREL ;RELATION? JC VALEXPRO CPI KEYFCT-KEYREL JNC VALEXPRO CPI 1 ;YES RAL XRA D ;CONVERT 0,1,2 TO 1,2,4 CMP D MOV D,A JC ERRASN SHLD SCANPTR1 CALL SCANNXT ;bscan , JMP VALEXPRR VALEXPRO: MOV A,D ORA A JNZ VALREL MOV A,M SHLD SCANPTR1 SUI KEYOPR ;OPERATOR? RC CPI KEYREL-KEYOPR RNC MOV E,A ;YES CALL TYPECHK ;STRING OPERANDS? ORA E ;AND CATENATION OPERATOR? MOV A,E JZ VALCONCT ;YES ADD E ADD E MOV E,A LXI H,OPRTABL ; ; Page 66 ; DAD D MOV A,B MOV D,M CMP D RNC INX H CALL CSINGLE VALEXPR2: PUSH B ;STACK OPERATION LXI B,VALEXPRC ;EVALUATE SECOND OPERAND PUSH B MOV B,D MOV C,E CALL PUSHAC MOV D,B MOV E,C MOV C,M INX H MOV B,M PUSH B LHLD SCANPTR1 JMP VALEXPRL ; ; EVALUATE A RELATION ; VALREL: LXI H,RELOPR ;SCAN & EVALUATE RELATION LDA TYPEFLG RLC RLC RLC ORA D MOV E,A MVI D,PREDREL MOV A,B CMP D RNC JMP VALEXPR2 RELOPRXT: INR A ;MATCH RESULF OF COMPARISON ADC A ;-1,0,1 TO 1,2,4 POP B ;VERSUS RELATION TO BE TESTED ANA B ADI -1 SBB A JMP FLOATBYT ; ; Page 67 ; RELOPR: DW RELOPRC ;COMPUTE RELATION RELOPRC: MOV A,C POP B POP D PUSH PSW RRC RRC RRC ANI 00FH CALL COERCE LXI H,RELOPRXT PUSH H JNZ FLCMP ;NUMERIC COMPARISON? MVI A,TYPESING ;NO, STRING STA TYPEFLG PUSH D CALL STRGRELA ;RELEASE TEMP OF SECOND OPERAND POP D MOV C,M INX H PUSH B ;SAVE LENGTH MOV C,M INX H MOV B,M PUSH B ;AND ADDRESS CALL STRGRELD ;RELEASE TEMP OF FIRST OPERAND CALL LDDCBMM POP H XTHL MOV E,L POP H RELOPRSL: MOV A,E ;COMPARE CHARACTER BY CHARACTER ORA D RZ MOV A,E SUI 1 RC XRA A CMP D INR A RNC DCR D DCR E LDAX B CMP M INX H INX B JZ RELOPRSL CMC JMP CMPXT ; ; Page 68 ; ; ; EVALUATE A PRIMARY ; VALPRMRY: MVI A,TYPESING ;SCAN & EVALUATE A PRIMARY STA TYPEFLG CALL SCANNXT ;bscan , JC DECODE ;NUMERIC CONSTANT? CALL ALPHACHK JC VALVAR ;VARIABLE? CPI KEYADD JZ VALPRMRY CPI '.' JZ DECODE CPI KEYSUB JZ VALUMINS CPI '"' ;STRING CONSTANT? JZ VALSTRGC CPI KEYNOT JZ VALUNOT CPI KEYFN ;DEFINED FUNCTION? JZ VALFCTD CPI KEYIF ;CONDITIONAL EXPRESSION? JZ VALCOND SUI KEYFCT ;INSTRISIC FUNCTION? JNC VALFCTN VALPARNS: CALL SCANNXTV ;bscan (val) DB '(' VALPARN2: CALL VALEXPR ;bscan expr CALL SCANNXTV ;bscan (val) DB ')' RET VALUMINS: MVI D,PREDUMIN ;EVALUATE UNARY MINUS CALL VALEXPRL LHLD SCANPTR2 PUSH H CALL CMACCS VALRETNM: CALL CSINGLE POP H RET ; ; Page 69 ; ; ; EVALUATE A VARIABLE ; VALVAR: CALL VARSCAN ;SCAN & EVALUATE VARIABLE PUSH H PUSH D XCHG MVI E,ERRNUV-ERRN JNZ ERRMSG SHLD ACCUMLTR CALL TYPECHK XCHG LXI H,ACCUMLTR CNZ COPYVAL POP D POP H RET ; ; EVALUATE CONDITIONAL EXPRESSION ; VALCOND: CALL SCANNXT ;bscan , EVAL CONDITIONAL EXPRESSION CALL VALNUMBR ;bscan numbr CALL SCANNXTV ;bscan (val) DB KEYTHEN CALL SIGNACC JZ VALCONDF CALL VALEXPR ;bscan expr ;TRUE, EVALUATE THEN PORTION MVI D,1 VALCNDTL: MVI C,KEYEND CALL SCAN2KEY ;SKIP ELSE PORTION CALL SCANNXTV ;bscan (val) DB KEYEND DCR D JNZ VALCNDTL RET VALCONDF: MVI D,1 VALCNDFL: MVI C,KEYELS ;FALSE, SKIP THEN PORTION CALL SCAN2KEY CALL SCANNXTV ;bscan (val) DB KEYELS DCR D JNZ VALCNDFL CALL VALEXPR ;bscan expr ;EVALUAGE ELSE PORTION CALL SCANNXTV ;bscan (val) DB KEYEND RET ; ; Page 70 ; ; ; EVALUATE INSTRINSIC FUNCTION ; VALFCTN: MVI B,000H ;Scan & EVALUATE INSTRINSIC FUNCTION RLC MOV C,A PUSH B CALL SCANNXT ;bscan , MOV A,C CPI (KEYLFT-KEYFCT)*2-1 ;LEFT$, MID$, OR RIGHT$ JC VALFCTAR CALL SCANNXTV ;bscan (val) DB '(' CALL VALEXPR ;bscan expr CALL CSTRING XCHG LHLD ACCUMLTR XTHL ;PUSH STRING ONTO STACK JMP VALFCTLK VALFCTAR: CALL VALPARNS ;EVALUATE ARGUMENT TO FUNCTION XTHL LXI D,VALRETNM PUSH D VALFCTLK: LXI B,FCTTABL ;BRANCH TO APPROPRIATE ROUTINE DAD B MOV C,M INX H MOV H,M MOV L,C PCHL ;CALL FUNCTION ; ; Page 71 ; ; ; PROCESS STRING CONSTANT ; VALSTRGN: CALL ENCODE ;CREATE STRING FROM NUMBER VALSTRGZ: MVI B,080H DCX H JMP VALSTRGY VALSTRGC: MVI B,'"' ;SCAN & DECODE A STRING CONSTANT VALSTRGY: MOV D,B VALSTRGS: PUSH H MVI C,-1 VALSTRGL: INX H ;FIND STRING LENGTH MOV A,M INR C ORA A JZ VALSTRGE CMP D JZ VALSTRGE CMP B JNZ VALSTRGL VALSTRGE: CPI '"' CZ SCANNXT XTHL INX H XCHG MOV A,C CALL STRSTCDS XCHG CALL STRGTEST ;LOCATE STRING CMC RAR ORA B CP STRGSTOR ;MAKE COPY OF CERTAIN BUFFERS ; ; Page 72 ; ; ; ALLOCATE STRING TEMPORARY ; STRGALOT: LXI D,STRGTMPL ;USE CURRENT DESCRIPTOR STRGALOU: PUSH D MVI A,TYPESTRG ;RETURN STRING RESULT STA TYPEFLG LHLD STRGTMPP ;IN A NEW STRING TEMPORARY SHLD ACCUMLTR XCHG LHLD STRGTLIM ;ANY MORE TEMPORARIES? CALL CMHLLTDE JC ERRAST XCHG POP D ;GET DESCRIPTOR CALL COPYVAL ;COPY IT SHLD STRGTMPP POP H RET STRGALOV: PUSH H JMP STRGALOU ERRAST: MVI E,ERRNST-ERRN JMP ERRMSG ; ; Page 73 ; ; ; RELEASE STRING RESOURCES ; STRGRELA: LHLD ACCUMLTR STRGRELH: XCHG STRGRELD: CALL STRGRELT ;RELEASE TEMPORARY XCHG RNZ ;NOT OUR BOY PUSH D MOV D,B MOV E,C DCX D MOV C,M LHLD STRGFREE CALL CMHLLTDE JNZ POPHLRET MOV B,A ;RELEASE STRING SPACE DAD B SHLD STRGFREE POP H RET ; ; RELEASE STRING TEMPORARY ; STRGRELT: LHLD STRGTMPP ;RELEASE STRING TEMPORARY DCX H MOV B,M DCX H MOV C,M DCX H CALL CMHLLTDE RNZ SHLD STRGTMPP ;RELEASE STRING TEMPORARY RET ; ; Page 74 ; ; ; EVALUATE A CATENATION ; VALCONCT: PUSH B ;EVALUATE A CONCATENATION PUSH H LHLD ACCUMLTR ;SAVE FIRST OPERAND, XTHL CALL VALPRMRY ;bscan prmry ;EVALUATE SECOND XTHL CALL CSTRING MOV A,M ;ADD LENGTHS, PUSH H LHLD ACCUMLTR PUSH H ADD M MVI E,ERRNLS-ERRN JC ERRMSG CALL STRNGEN ;AND ALLOCATE OUTPUT STRING POP D CALL STRGRELD ;RELEASE STRING TEMPORARIES XTHL CALL STRGRELH PUSH H LHLD STRGTMPA ;COPY STRINGS TO OUTPUT STRING XCHG CALL VALCONCP CALL VALCONCP LXI H,VALEXPRD XTHL PUSH H JMP STRGALOT VALCONCP: POP H ;COPY STRING FOR CATENATION XTHL MOV A,M ;GET LENGTH, INX H MOV C,M ;ADDRESS OF STRING INX H MOV B,M MOV L,A COPYSTRG: INR L ;COPY A STRING OF LENGTH L COPYSTRL: DCR L ;FROM BC TO DE RZ LDAX B STAX D INX B INX D JMP COPYSTRL ; ; Page 75 ; ; ; DIMENSION STATEMENT PROCESSING ; DIMSTML: DCX H CALL SCANNXT ;bscan , RZ CALL SCANNXTV ;bscan (val) DB ',' DIMSTM: LXI B,DIMSTML ;DIM STATEMENT PUSH B MVI A,080H JMP VARSCANI ; ; SCAN A VARIABLE NAME ; VARSCAN: XRA A ;SCAN FOR VARIABLE VARSCANI: STA MATDMFLG MVI B,0*TYPEDEF VARSCNDF: CALL ALPHACHK ;ENTRY TO SCAN FOR DEFINED FCT JNC ERRASN ORA B MOV B,A MVI C,'?' MVI D,TYPESING ;ASSUME NUMERIC VARIABLE CALL SCANNXT ;bscan , JC VARSCAND CALL ALPHACHK JNC VARSCANS VARSCAND: MOV C,A VARSKIPL: CALL SCANNXT ;bscan , ;SKIP EXTRA ALPHANUMERIC JC VARSKIPL ;CHARACTERS IN NAME CALL ALPHACHK JC VARSKIPL VARSCANS: SUI '$' ;STRING VARIABLE? JNZ VARNAME MVI D,TYPESTRG ;YES CALL SCANNXT ;bscan , VARNAME: MOV A,B ;TRANSLATE IDENT OT INTERNAL FORM SUI '@' ;DEF/VARIABLE IS FIRST BIT RLC ;FIRST CHAR IS NEXT FIVE BITS RLC MOV B,A MOV A,C ;SECOND CHAR IS NEXT SIX BITS SUI '0' ; ; Page 76 ; RRC RRC RRC RRC MOV C,A XRA B ;PACK THREE BYTES INTO TWO ANI 0003H XRA B MOV B,A MOV A,D STA TYPEFLG XRA C ;TYPE IS LAST FOUR BITS ANI 00FH XRA C MOV C,A LDA SCANPFLG ADD M CPI '(' ;SUBSCRIPTED? JZ MATSCANP CPI '[' ;BY LEFT BRACKET? JZ MATSCANB XRA A STA SCANPFLG PUSH H ; ; LOOK UP VARIABLE IN TABLE ; LHLD VARTABLE VARSCANT: XCHG LHLD MATTABLE CALL CMHLLTDE ;LOOK THROUGH VARIABLE TABLE JZ VARSCANF LDAX D MOV L,A CMP C INX D JNZ VARSCANM LDAX D CMP B VARSCANM: INX D JZ VARSCANX MOV A,L ANI 00FH ;ADDRESS NEXT ENTRY MOV L,A MVI H,0 DAD D JMP VARSCANT VARSCANF: PUSH B ;NOT FOUND, CREATE ENTRY MOV A,C ANI 00FH ; ; Page 77 ; ADI 2 MOV C,A MVI B,0 XCHG LHLD FREELIMT PUSH H DAD B POP B PUSH H CALL COPYCHK ;MOVE ARRAYS FOR SPACE POP H SHLD FREELIMT MOV H,B MOV L,C SHLD MATTABLE ;ALLOCATE, ZERO ENTRY VARALLOC: DCX H MVI M,000H CALL CMHLLTDE JNZ VARALLOC POP D MOV M,E INX H MOV M,D INX H XCHG ;EXIT VARIABLE SCAN ORA E ;NZ=VAR NOT FOUND, CREATED VARSCANX: POP H ;HL=SCAN POINTER RET ; ; LOOK UP ARRAY IN TABLE ; MATSCANB: ADI ']'-'['+'('-')' ;(got me?) MATSCANP: ADI ')'-'(' PUSH H ;SCAN SUBSCRIPT OF VARIABLE LHLD MATDMFLG ORA L MOV L,A XTHL ;SAVE DIMFLAG, CLOSE CHAR, TYPE MVI D,000H MATSCANL: PUSH D ;SCAN SUBSCRIPT LIST PUSH B CALL SCANNXT ;scan , CALL VALINTDE ;EVALUATE SUBSCRIPT POP B POP PSW XCHG XTHL PUSH H XCHG INR A ;COUNT NUMBER OF SUBSCRIPTS ; ; Page 78 ; MOV D,A MOV A,M CPI ',' JZ MATSCANL XTHL SHLD MATDMFLG ;RESTORE DIMFLAG, TYPE MOV A,L POP H XRA M ADD A ;CHECK FOR CORRECT CLOSER JNZ ERRASN SHLD SCANPTR2 PUSH D LHLD MATTABLE ;LOOK FOR NAME IN JMP MATSCANO ;MAT VARIABLE TABLE MATSCANN: DAD D MATSCANO: XCHG LHLD FREELIMT XCHG CALL CMHLLTDE JZ MATSCANC MOV A,M CMP C INX H JNZ MATSCANM MOV A,M CMP B MATSCANM: INX H MOV E,M INX H MOV D,M INX H JNZ MATSCANN LDA MATDMFLG ;NAME FOUND ORA A MVI E,ERRNDD-ERRN JM ERRMSG POP PSW ;RIGHT NUMBER OF SUBSCRIPTS? CMP M JZ MATSCANI ERRABS: MVI E,ERRNBS-ERRN JMP ERRMSG MATSCANC: MOV A,C ;NAME NOT FOUND, CREATE NEW ENTRY ANI 00FH MOV E,A MVI D,0 MOV M,C INX H MOV M,B INX H ; ; Page 79 ; POP PSW STA MATSCCNT MOV C,A CALL SPACESTK SHLD SCANPTR1 INX H INX H ;plus 2 MOV B,C MOV M,B INX H MATSCNSB: LDA MATDMFLG ;SET SUBSCRIPT RANGES ORA A MOV A,B LXI B,11 ;DEFAULT RANGE=0-10 JP MATSCNSD POP B INX B MATSCNSD: MOV M,C INX H MOV M,B INX H PUSH PSW PUSH H CALL MUL16 ;UPDATE ARRAY SIZE XCHG POP H POP B DCR B JNZ MATSCNSB MOV B,D MOV C,E XCHG ;ALLOCATE ARRAY, DAD D JC ERRABS CALL SPACECHK SHLD FREELIMT MATSCANZ: DCX H ;AND ZERO MVI M,000H CALL CMHLLTDE JNZ MATSCANZ INX B ;SAVE ENTRY SIZE MOV H,A LDA MATDMFLG ORA A LDA MATSCCNT MOV L,A DAD H DAD B XCHG LHLD SCANPTR1 ;AT BEGINNING OF ENTRY MOV M,E INX H MOV M,D ; ; Page 80 ; INX H JM MATSCANX ;DIM ONLY? MATSCANI: INX H ;INITIALIZE SUBSCRIPT COMPUTATION LXI B,0 JMP MATSCANS MATSCANR: POP H ;COMPUTE SPECIFIC REFERENCE MATSCANS: MOV E,M INX H MOV D,M INX H XTHL PUSH PSW CALL CMHLLTDE JNC ERRABS PUSH H CALL MUL16 POP D DAD D POP PSW DCR A MOV B,H MOV C,L JNZ MATSCANR LDA TYPEFLG MOV E,A MVI D,0 CALL MUL16 ;MULTIPLY BY ENTRY SIZE POP B DAD B XCHG MATSCANX: LHLD SCANPTR2 CALL SCANNXT ;bscan , CMP A RET MUL16: LXI H,0 ;MULTIPLY BC*DE GIVING HL MOV A,B ORA C RZ MVI A,16 MUL16LP: DAD H JC ERRABS XCHG DAD H XCHG JNC MUL16XT DAD B JC ERRABS MUL16XT: DCR A ; ; Page 81 ; JNZ MUL16LP RET ; ; Page 82 ; ; ; USER-DEFINED FUNCTION DEFINITION ; DEFSTM: CALL SCANFNN ;DEF STATEMENT PUSH H ;CHECK IF IN DIRECT MODE LHLD CURLINE ;Z=DIRECT MODE INX H MOV A,H ORA L POP H JZ ERRAID XCHG ;SAVE REFERENCE TO DEFINITION MOV M,E INX H MOV M,D XCHG MOV A,M CPI '(' ;CHECK FOR VARLIST DEFSTML: JNZ DATSTM CALL SCANNXT ;bscan , CALL VARSCAN ;DEFINE VARIABLES IN LIST MOV A,M CPI ',' JMP DEFSTML ; USER-DEFINED FUNCTION EVALUATION ; VALFCTD: CALL SCANFNN ;SCAN & EVALUATE USER DEFINED FUNCTION LDA TYPEFLG ;SAVE TYPE OF FUNCTION ORA A PUSH PSW PUSH H ;SAVE CALL ARGUMENTS XCHG MOV A,M INX H MOV H,M ;FETCH FUNCTION DEFINITION MOV L,A ORA H MVI E,ERRNUF-ERRN JZ ERRMSG ;MUST BE DEFINED ... ; ; Page 83 ; MOV A,M CPI '(' ;PARAMETERS NEEDED? JNZ VALFCTNA ;APPARENTLY NOT CALL SCANNXT ;bscan , XTHL CALL SCANNXTV ;bscan (val) DB '(' ;MUST BE PARAMETERS IN CALL XTHL JMP VALFCTDM ; ARGUMENT SCANNING ; VALFCTDL: CALL SCANNXTV ;bscan (val) DB ',' ;COMMAS BETWEEN ARGUMENTS XTHL CALL SCANNXTV ;bscan (val) DB ',' ;AND BETWEEN PARAMETERS VALFCTDM: MVI C,4 ;VERIFY SPACE ON STACK CALL SPACESTK MVI A,SCANPFLD ;SCAN NEXT PARAMETER STA SCANPFLG CALL VALVAR ;GET CURRENT VALUE OF PARAMETER SHLD SCANPTR1 ;SAVE PARAMETER SCAN POP H SHLD SCANPTR2 ;SAVE ARGUMENT SCAN CALL TYPECHK JZ VALFCTPS ;PUSH STRINGS DIFFERENTLY CALL PUSHAC1 ;PUSH NUMERIC ACCUMULATOR PUSH H ;SAVE VARIABLE'S ADDRESS JMP VALFCTPT VALFCTPS: CALL STRGALOV ;COPY DESCRIPTOR TO TEMPORARY XRA A ;ELIMINATE ORIGINAL DESCRIPTOR DCX D DCX D DCX D ;plus 3 STAX D LHLD ACCUMLTR ;GET ADDRESS OF DESCRIPTOR PUSH H PUSH D ;PUT IT BACK HERE LATER ; ; Page 84 ; VALFCTPT: LDA TYPEFLG ;SAVE TYPE OF PARAMETER STC POP D PUSH D ;GET COPY OF ADDRESS PUSH PSW LHLD SCANPTR1 ;SAVE PARAMETER SCAN PUSH H LHLD SCANPTR2 CALL ASSIGNVL ;UPDATE VALUE OF PARAMETER MOV A,M CPI ')' JNZ VALFCTDL ;MORE ARGUMENTS CALL SCANNXT ;bscan (val) XTHL CALL SCANNXTV ;bcscan (val) DB ')' ;MUST BE END OF PARAMETERS TOO ; EVALUATE EXPRESSION ; VALFCTNA: CALL SCANNXTV ;bscan (val) DB KEYEQ ;LOOK FOR EQUALS SIGN CALL VALEXPR ;bscan expr ;EVALUATE FUNCTION DCX H CALL SCANNXT ;bscan , JNZ ERRASN POP H SHLD SCANPTR1 CALL TYPECHK JNZ VALFCTRL CALL STRGUNIQ XCHG SHLD ACCUMLTR ; ; Page 85 ; ; RESTORE PARAMETERS ; VALFCTRL: POP PSW ;RESTORE VALUES OF PARAMETERS JNC VALFCTCR POP H CALL TYPECHKA JZ VALFCTRS POP B POP D MOV M,E ;RESTORE NUMERIC VALUE INX H MOV M,D INX H MOV M,C INX H MOV M,B JMP VALFCTRL VALFCTRS: POP D ;RESTORE STRING VALUE XCHG SHLD STRGTMPP ;DEALLOCATE TEMPORARY XCHG MVI B,TYPESTRG CALL COPYVALL JMP VALFCTRL VALFCTCR: LHLD SCANPTR1 ;COERCE RESULT TO CORRECT TYPE CALL TYPECHKA JNZ COERCEF CALL CSTRING ;STRING FUNCTION PUSH H LHLD ACCUMLTR XCHG CALL STRGRELT JMP STRGALOU ERRAID: MVI E,ERRNID-ERRN JMP ERRMSG SCANFNN: CALL SCANNXTV ;bscan (val) DB KEYFN MVI A,SCANPFLD STA SCANPFLG MVI B,TYPEDEF JMP VARSCNDF ; ; Page 86 ; ; ; GENERATE A NEW CURRENT STRING ; STRNGEN: CALL STRGALOC ;GENERATE A NEW STRING, STRSTCDS: LXI H,STRGTMPL ;SET CURRENT STRING DESCRIPTOR PUSH H MOV M,A INX H MOV M,E INX H MOV M,D POP H RET ; ; ALLOCATE STORAGE IN STRING SPACE ; STRGALOC: ORA A ;ALLOCATE SPACE FOR STRING, JMP STRGALAH ;SIZE IN A STRGALAG: POP PSW ;ENTER FOR SECOND TRY STRGALAH: PUSH PSW LHLD STCKBASE XCHG LHLD STRGFREE CMA MOV C,A MVI B,0FFH DAD B INX H CALL CMHLLTDE JC STRGALGC SHLD STRGFREE INX H XCHG ;RETURNS: DE=STRING ADDRESS POPAFRET: POP PSW RET STRGALGC: POP PSW ;COLLECT GARBAGE IN STRING SPACE MVI E,ERRNOS-ERRN JZ ERRMSG CMP A PUSH PSW LXI B,STRGALAG ;THEN TRY ALLOCATION PUSH B ; ; Page 87 ; ; ; COLLECT GARBAGE IN STRING SPACE ; STRGGBCL: LHLD STRGBASE ;MAKE ALL STRINGS UNSAFE STRGGBLP: SHLD STRGFREE ;FIND HIGHEST UNSAFE STRING LXI H,0 PUSH H LHLD STCKBASE PUSH H LHLD STRGBASE ;SCAN TEMPORARIES, INX H STRGGBTL: XCHG LHLD STRGTMPP XCHG CALL CMHLLTDE LXI B,STRGGBTL JNZ STRGGBHI LHLD VARTABLE ;SCAN REGULAR VARIABLES, STRGGBVR: XCHG LHLD MATTABLE XCHG CALL CMHLLTDE JZ STRGGNAV MOV A,M INX H ANI 00FH SUI TYPESTRG MOV E,A SBB A MOV D,A MOV A,M INX H ANI 080H ;DEFINITIONS ARE STRINGS DAD D ORA E CALL STRGGBHV JMP STRGGBVR STRGGBAL: POP B STRGGNAV: XCHG ;SCAN ARRAY VARIABLES LHLD FREELIMT XCHG CALL CMHLLTDE JZ STRGGBMV CALL LDRGMM MOV A,E PUSH H DAD B ANI 00FH ; ; Page 88 ; CPI TYPESTRG JNZ STRGGBAL SHLD SCANPTR1 POP H MOV C,M MVI B,000H DAD B DAD B INX H STRGGBAS: XCHG ;LOOK THROUGH ENTIRE ARRAY LHLD SCANPTR1 XCHG CALL CMHLLTDE JZ STRGGNAV LXI B,STRGGBAS STRGGBHI: PUSH B ;COMPARE THIS STRING ADDR TO MAX XRA A STRGGBHV: MOV C,M ;LOAD STRING DESCRIPTOR INX H MOV E,M INX H MOV D,M INX H RNZ ;NOT A STRING VARIABLE MOV A,C ORA A ;CHECK FOR ZERO LENGTH RZ MOV B,H ;ALREADY SAFE? MOV C,L LHLD STRGFREE CALL CMHLLTDE MOV H,B MOV L,C RC POP H ;COMPARE WITH HIGHEST UNSAFE XTHL CALL CMHLLTDE XTHL PUSH H MOV H,B MOV L,C RNC POP B ;SAVE NEW HIGHEST UNSAFE ADDR POP PSW POP PSW PUSH H PUSH D PUSH B RET ; ; Page 89 ; STRGGBMV: POP D ;MAKE HIGHEST UNSAFE SAFE POP H MOV A,L ORA H RZ ;ANY UNSAFE? DCX H ;LOAD DESCRIPTOR MOV B,M DCX H MOV C,M PUSH H DCX H MOV L,M ;FIND END OF STRING MVI H,000H DAD B MOV D,B MOV E,C DCX H MOV B,H MOV C,L LHLD STRGFREE ;COPY IT TO END OF SAFE AREA CALL COPYTEXT POP H MOV M,C INX H MOV M,B MOV H,B MOV L,C DCX H JMP STRGGBLP ;EXTEND SAFE AREA ; ; Page 90 ; ; ; VARIOUS NUMERIC/STRING CONVERSION FUNCTIONS ; ; ; FIND LENGTH OF STRING ; LENFCT: LXI B,FLOATA ;LEN FUNCTION PUSH B LENFCTC: CALL CSTRING CALL STRGRELA MVI A,TYPESING STA TYPEFLG MOV A,M ORA A INX H RET ; ; CONVERT CHARACTER TO BYTE ; ASCFCT: CALL LENFCTC ;ASC FUNCTION JZ ERRAFC MOV C,M ;FETCH ADDRESS INX H MOV B,M LDAX B ;THEN THE FIRST CHARACTER JMP FLOATA ; ; CONVERT BYTE TO CHARACTER ; CHRFCT: MVI A,1 ;CHR$ FUNCTION CALL STRNGEN CALL CBYTE LHLD STRGTMPA MOV M,E VALRETST: POP B ;STRING FUNCTION, REMOVE CSINGLE JMP STRGALOT ; ; Page 91 ; ; ; DECODE NUMBER FROM STRING ; VALFCT: CALL LENFCTC ;VAL FUNCTION JZ ZEROAC MOV E,A MVI D,0 MOV C,M INX H MOV B,M PUSH B MOV H,B MOV L,C DAD D MOV B,M MOV M,D XTHL PUSH B MOV A,M CALL DECODE POP B POP H MOV M,B RET ; ; ENCODE NUMBER IN STRING ; STRFCT: CALL CSINGLE ;STR$ FUNCTION CALL VALSTRGN ;CREATE STRING FROM NUMBER CALL STRGRELA LXI B,VALRETST PUSH B XCHG STRGSTOR: XCHG MOV A,M ;STORE STRING INTO STRING SPACE, PUSH H ;LEAVE DESCRIPTOR IN STRGTMP CALL STRGALOC POP H CALL LDICBMM ;LOAD BUFFER ADDRESS CALL STRSTCDS PUSH H MOV L,A CALL COPYSTRG POPDERET: POP D RET ; ; Page 92 ; ; ; CONVERT HEX STRING TO NUMBER ; HXVFCT: CALL LENFCTC ;DO INITIAL PROCESSING JZ ZEROAC MOV E,A MOV C,M INX H MOV B,M LXI H,0 ;INITIAL OUTPUT TO ZERO HXVFCTL: LDAX B ;FETCH CHARACTER INX B CPI ':' ; VERIFY THAT IT'S HEX CNC HXVFCTCH JNC ERRAFC ;IF NOT, COMPLAIN SUI '0' JC ERRAFC ;MUST BE AT LEAST ZERO DAD H DAD H ;INCORPORATE NEW DIGIT DAD H DAD H ORA L MOV L,A DCR E ;COUNT DIGITS JNZ HXVFCTL FLOATHL: MOV A,H ;CONVERT INTEGER IN HL TO FLOAT MOV B,L JMP FLOATAB HXVFCTCH: CALL ALPHACHA ;CONVERT ANY ALPHA TO UPPER RNC SUI 'A'-'9'-1 ;MOVE ALPHA TO AFTER DIGITS CPI '0'+16 ;SET FLAGS CORRECTLY RET ; ; Page 93 ; ; ; CONVERT BYTE TO TWO HEX CHARACTERS ; HEXFCT: MVI A,2 ;ALLOCATE OUTPUT STRING CALL STRNGEN LDA FLACCEXP CALL FIXAC ;GET INPUT BYTE LXI H,VALRETST PUSH H LHLD STRGTMPA CALL HEXFCTL HEXFCTL: MOV A,E ;CONVERT ONE DIGIT RLC RLC RLC RLC MOV E,A ANI 00FH CPI 10 CMC ;COVERT TO CHARACTER FORM ACI '0' DAA MOV M,A INX H RET ; ; TRANSLATE STRING TO UPPER CASE ; UPRFCT: CALL CSTRING LHLD ACCUMLTR ;GET LENGTH OF OPERAND PUSH H MOV A,M CALL STRNGEN ;ALLOCATE OUTPUT STRING POP D CALL STRGRELD ;RELEASE INPUT STRING CALL LDDCBMM LHLD STRGTMPA INR D UPRFCTL: DCR D ;TRANSLATE WHILE COPYING JZ VALRETST ;DONE LDAX B CALL ALPHACHA ;CONVER LOWER TO UPPER MOV M,A INX B INX H JMP UPRFCTL ; ; Page 94 ; ; ; SUBSTRING FUNCTIONS ; LFTFCT: CALL LEFRIGAR ;LEFT$ FUNCTION XRA A ;LEFT(X,N)=MID(X,1,N) LEFRIGMR: XTHL MOV C,A ;C=START-1, B=LEN LEFRIGMD: PUSH H ;RESOLVE DESIRED LEN WITH STRING MOV A,M CMP B JC LEFRIGMC MOV A,B JMP LEFRIGMB LEFRIGAR: XCHG ;INITIAL COMMON PROCESSING CALL VALBYTE2 ;FOR LEFT$, RIGHT$ MOV B,E CALL SCANNXTV ;bscan (val) DB ')' RET LEFRIGMC: MVI C,0 LEFRIGMB: PUSH B CALL STRGALOC ;ALLOCATE ANSWER STRING POP B POP H PUSH H INX H MOV B,M ;COMPUTE ADDRESSES FOR COPY INX H MOV H,M MOV L,B ;(from HL,MB) MVI B,0 DAD B MOV B,H MOV C,L CALL STRSTCDS MOV L,A CALL COPYSTRG ;COPY POP D CALL STRGRELD JMP STRGALOT ; ; Page 95 ; RIGFCT: CALL LEFRIGAR ;RIGHT$ FUNCTION POP D PUSH D LDAX D SUB B ;RIGHT(X,N)=MID(X,LEN(X)-N+1,N) JMP LEFRIGMR MIDFCT: XCHG ;MID$ FUNCTION CALL VALBYTE2 ;SCAN STARTING POSITION MOV B,E ORA A ;NON-ZERO STARTING POSITION? JZ ERRAFC PUSH B MVI E,0FFH MOV A,M CPI ')' CNZ VALBYTE2 ;SCAN OPTIONAL THIRD ARGUMENT CALL SCANNXTV ;bscan (val) DB ')' POP PSW ;COMPUTE STARTING BYTE AND LENGTH XTHL LXI B,LEFRIGMD PUSH B DCR A CMP M MVI B,0 ;START > LENI => LENO=0 RNC MOV C,A MOV A,M SUB C CMP E MOV B,A RC ;LEN0 = MIN(LENI-START,LENR) MOV B,E RET ; ; Page 96 ; ; ; INDEX OF STRING FUNCTION ; INSFCT: XCHG CALL SCANNXTV ;bscan (val) DB ',' CALL VALPARN2 ;SCAN SECOND ARGUMENT XTHL ;SHUFFLE RETURN STACK LXI B,POPHLRET PUSH B PUSH H CALL LENFCTC ;PROCESS SECOND STRING XTHL PUSH PSW JZ INSFCTXT CALL STRGRELH ;WORK ON FIRST STRING MOV A,M POP B POP D SUB B ;COMPARE LENGTHS JC ZEROAC ;TEST IS LONGER, NO MATCHES INR A MOV C,A ;SAVE NUMBER OF ATTEMPTS PUSH B CALL LDICBMM ;GET ADDRESS OF TARGET XCHG MOV E,M ;GET ADDRESS OF MATCHER INX H MOV D,M XCHG POP D ;RECOVER LENGTH, COUNTER MVI A,1 INSFCTSL: PUSH D ;SAVE LENGTH, COUNTER PUSH PSW ;SAVE POSITION PUSH B ;SAVE ADDRESSES PUSH H MOV E,D CALL RELOPRSL ;COMPARE STRINGS POP H ;RECOVER ADDRESSES POP B INSFCTXT: POP D MOV A,D ;RECOVER POSITION POP D ;AND LENGTH, COUNTER JZ FLOATA ;ANSWER FOUND, GIVE IT BACK INR A ;INCREMENT POSITION INX B DCR E ;COUNT ATTEMPTS JNZ INSFCTSL ;KEEP TRYING JMP ZEROAC ;OR NOMATCH ; ; Page 97 ; ; ; FUNCTION RETURNING AMOUNT OF REMAINING FREE SPACE ; FREFCT: LHLD MATTABLE ;FRE FUNCTION XCHG LXI H,0 DAD SP CALL TYPECHK JNZ FREFCTNS CALL STRGRELA ;RETURN BYTES OF FREE STRNG SPACE CALL STRGGBCL LHLD STCKBASE XCHG LHLD STRGFREE FREFCTNS: MOV A,L SUB E MOV B,A MOV A,H SBB D FLOATAB: MOV D,B MVI E,000H LXI H,TYPEFLG MVI M,TYPESING MVI B,090H JMP FLOATINT ; ; MEMORY DIDDLING FACILITIES ; MEMFCT: CALL TYPECHK ;MEM FUNCTION JZ MEMFCTC CALL CINTEGER LDAX D JMP FLOATA MEMFCTC: CALL LENFCTC ;RELEASE ARGUMENT LHLD PROGBASE JZ FLOATHL ;ZERO LENGTH STRING=PROGBASE LHLD STRGTLIM JMP FLOATHL ;OTHERWISE=UPPER LIMIT MEMSTM: CALL SCANNXT ;bscan + ;MEM STATEMENT CALL VALPARNS CALL CINTEGER PUSH D CALL SCANNXTV ;bscan (val) DB KEYEQ CALL VALBYTE POP D STAX D ; ; Page 98 ; RET ; ; Page 99 ; ; ; DIRECT I/O FACILITIES ; PORFCT: CALL CBYTE ;PORT FUNCTION MVI D,OPCINP CALL INOTGEN CALL INOTINS JMP FLOATA PORSTM: CALL SCANNXT ;bscan + ;PORT STATEMENT CALL VALPARNS CALL CBYTE PUSH D CALL SCANNXTV ;bscan (val) DB KEYEQ CALL VALBYTE POP D MVI D,OPCOUT CALL INOTGEN JMP INOTINS WAISTM: CALL VALBYTE ;WAIT STATEMENT PUSH D CALL VALBYTE2 PUSH PSW MVI E,0 CNZ VALBYTE2 POP B MOV C,E POP D MVI D,OPCINP CALL INOTGEN WAISTMIN: CALL SYSWAIT ;DO A SYSTEM WAIT CALL INOTINS ;THEN CHECK DEVICE XRA C ANA B JZ WAISTMIN RET INOTGEN: PUSH H ;GENERATE INPUT/OUTPUT FOLLOWED LXI H,INOTINS ;BY RETURN MOV M,D INX H MOV M,E INX H MVI M,OPCRET POP H RET ; ; Page 100 ; ; ; CSAVE/CLOAD ROCESSORS ; save filename - save on diskette ; load filename - get from diskette ; ; load and save programs from the disk ; d14base equ 0b400h fsprom equ 0b000h bootstart equ fsprom+39bh ;load image files directorylookup equ d14base+4e0h ;find filename opens equ d14base+396h ;open stream puts equ d14base+3dch ;put char closes equ d14base+42dh ;close stream ; cldstm: call setfilename ;parse filename call directorylookup jnc namenotfound call bootstart call checkprogram call newload ;reset program pointers jmp cmndstrt namenotfound: mvi e,errnfi-errn ;file not saved jmp errmsg csvstm: call setfilename mvi b,2 ;write enable call opens ;open stream (only one in D14) jnc cannotopen ; -disk full or other bad stuff call checkprogram push h ;save end pointer lhld progbase ;first address mov c,l call puts mov c,h call puts mvi c,0 ;start address = 0 for no start call puts call puts pop d ;de has end address=1 saveloop: mov c,m ;get char inx h call puts ;and send t file mov a,h ;is this the end? cmp d jnz saveloop mov a,l cmp e jnz saveloop call closes ;yes ; ; Page 101 ; jmp cmndstrt cannotopen: mvi e,errnsl-errn jmp errmsg ; setfilename ; returns hl set to a filename string ; setfilename: lxi d,filename+1 mvi b,0 sfnloop: mov a,m ;look at char cpi 0 jz sfndone cpi ' ' jz sfndone inr b ;up count inx h stax d inx d jmp sfnloop sfndone: lxi h,filename xra a ;is the name non zero ora b jz errasn ;yes mov m,a ;store count ret ; checkprogram ; walk over the program looking for the end ; return last byte+1 in hl ; checkprogram: lhld progbase ;starts here cprogloop: mov a,m ;pick up line length inx h ora m inx h jz cprogok ;if zero then all done inx h inx h ;skip line number cprogloop2: mov a,m ora a inx h jz cprogloop ;zero at the end of the line jmp cprogloop2 cprogok: ret filename: ds 60 ; ; Page 102 ; ; ; LOGICAL OPERATORS ; ORNOPR: ORA A ;OR OPERATOR JMP LOGOPRIC ANDOPR: XRA A ;AND OPERATOR LOGOPRIC: PUSH PSW CALL CSINGLE CALL CINTEGER POP PSW XCHG POP B XTHL XCHG CALL LDACRG PUSH PSW CALL CINTEGER POP PSW POP B MOV A,C JNZ ORNOPRFN ANA E MOV C,A MOV A,B ANA D JMP LOGOPRXT ;RETURN FROM AND ORNOPRFN: ORA E MOV C,A MOV A,B ORA D LOGOPRXT: MOV B,C JMP FLOATAB ;RETURN FROM OR VALUNOT: MVI D,PREDNOT ;EVALUATE UNARY NOT CALL VALEXPRL CALL CSINGLE CALL CINTEGER MOV A,E CMA MOV C,A MOV A,D CMA CALL LOGOPRXT POP B JMP VALEXPRC ; ; Page 103 ; ; ; MOD, MAXIMUM, MINIMUM OPERATORS ; MODOPR: POP B ;MODULO FUNCTION POP D ;X MOD Y = PUSH D ;X - INT(X/Y) * Y PUSH B LHLD ACCUMLTR PUSH H LHLD FLACCMSB PUSH H CALL FLDIV CALL INTFCT POP B POP D CALL FLMUL JMP SUBOPR MAXOPR: POP B POP D CALL FLCMP ;COMPARE OPERANDS RZ ;NO DIFFERENCE JC LDACRG ;REGISTERS LARGER JMP LDRGAC ;ACUMULATOR LARGER MINOPR: POP B POP D CALL FLCMP ;COMPARE OPERANDS RZ ;NO DIFFERENCE JNC LDACRG ;REGISTERS SMALLER JMP LDRGAC ;ACCUMULATOR SMALLER ; ; Page 104 ; ; ; FLOATING POINT ADD/SUBTRACT ROUTINES ; FLADDHLF: LXI H,FLHALF FLADDM: CALL LDRGMM JMP FLADD FLMMMAC: CALL LDRGMM ;COMPUTE MM-AC JMP FLSUB SUBOPR: POP B POP D FLSUB: CALL CMACCS ;SUBTRACT ACC FROM REGISTERS FLADD: MOV A,B ;ADD ACCUMULATOR TO REGISTERS ORA A RZ LDA FLACCEXP ORA A JZ LDACRG SUB B JNC FLADDMGC CMA ;NEED LARGER IN AC, INTERCHANGE INR A XCHG CALL PUSHAC XCHG CALL LDACRG POP B POP D FLADDMGC: CPI 019H ;ARE MAGNITUDES ARE COMMENSURATE? RNC PUSH PSW CALL SIGNIFY MOV H,A POP PSW CALL SHIFTR0 ORA H LXI H,ACCUMLTR JP FLADDIFF CALL ADDM2CDE JNC FLROUND INX H INR M JZ ERRAOV MVI L,001H CALL SHIFTRLB JMP FLROUND ; ; Page 105 ; FLADDIFF: XRA A ;FIND DIFFERENCE SUB B MOV B,A MOV A,M SBB E MOV E,A INX H MOV A,M SBB D MOV D,A INX H MOV A,M SBB C MOV C,A NORMALZI: CC CMREGS NORMALIZ: MOV L,B ;NORMALIZE REGISTERS MOV H,E XRA A NORMAL8: MOV B,A ;NORMALIZE BY BYTES MOV A,C ORA A JNZ NORMAL1 MOV C,D MOV D,H MOV H,L MOV L,A MOV A,B SUI 008H CPI 0E0H JNZ NORMAL8 ZEROAC: XRA A ;ZERO ACCUMULATOR LDACCE: STA FLACCEXP RET NORMAL1L: DCR B ;NORMALIZE BY BITS DAD H MOV A,D RAL MOV D,A MOV A,C ADC A MOV C,A NORMAL1: JP NORMAL1L MOV A,B MOV E,H MOV B,L ORA A ; ; Page 106 ; JZ FLROUND LXI H,FLACCEXP ADD M MOV M,A JNC ZEROAC RZ FLROUND: MOV A,B ;ROUND RESULT FLROUNDV: LXI H,FLACCEXP ORA A CM INCCDE MOV B,M INX H MOV A,M ANI 080H XRA C MOV C,A JMP LDACRG INCCDE: INR E ;INCREMENT CDE RNZ INR D RNZ INR C RNZ MVI C,080H INR M RNZ ERRAOV: MVI E,ERRNOV-ERRN JMP ERRMSG ADDM2CDE: MOV A,M ;ADD MEMORY TO CDE ADD E MOV E,A INX H MOV A,M ADC D MOV D,A INX H MOV A,M ADC C MOV C,A RET ; ; Page 107 ; CMREGS: LXI H,FLACCSSV ;COMPLEMENT SAVED SIGN, CDEB MOV A,M CMA MOV M,A XRA A MOV L,A SUB B MOV B,A MOV A,L SBB E MOV E,A MOV A,L SBB D MOV D,A MOV A,L SBB C MOV C,A RET SHIFTR0: MVI B,000H SHIFTR: SUI 008H ;SHIFT CDEB RIGHT BY A BITS JC SHIFTRB MOV B,E MOV E,D MOV D,C MVI C,000H JMP SHIFTR SHIFTRB: ADI 009H MOV L,A SHIFTRBL: XRA A DCR L RZ MOV A,C SHIFTRLB: RAR MOV C,A MOV A,D RAR MOV D,A MOV A,E RAR MOV E,A MOV A,B RAR MOV B,A JMP SHIFTRBL ; ; Page 108 ; ; ; FLOATING POINT MULTIPLY ROUTINE ; MULOPR: POP B POP D FLMUL: CALL SIGNACC ;MULTIPLY REGISTERS BY ACC RZ MVI L,000H CALL FLMLDVEX MOV A,C STA FLSCR0 XCHG SHLD FLSCR1 LXI B,0 MOV D,B MOV E,C LXI H,NORMALIZ ;NORMALIZE ANSWER AFTER PUSH H LXI H,FLMULLP ;THREE TIMES THROUGH LOOP PUSH H PUSH H LXI H,ACCUMLTR FLMULLP: MOV A,M INX H ORA A JZ FLMULXT PUSH H MVI L,008H FLMULLQ: RAR ;NEXT BIT OF MULTIPLIER MOV H,A MOV A,C JNC FLMULNA PUSH H LHLD FLSCR1 ;BIT ON, ADD MULTIPLICAND DAD D XCHG POP H LDA FLSCR0 ADC C FLMULNA: RAR ;SHIFT CDEB RIGHT ONE BIT MOV C,A MOV A,D RAR MOV D,A MOV A,E RAR MOV E,A MOV A,B RAR ; ; Page 109 ; MOV B,A DCR L MOV A,H JNZ FLMULLQ POP H RET FLMULXT: MOV B,E MOV E,D MOV D,C MOV C,A RET FLMLDVEX: MOV A,B ;COMPUTE EXP FOR MULTIPLY/DIVIDE ORA A JZ FLMLDVEZ MOV A,L LXI H,FLACCEXP XRA M ADD B MOV B,A RAR XRA B MOV A,B JP FLMLDVEY ADI 080H MOV M,A JZ POPHLRET CALL SIGNIFY MOV M,A DCX H RET EXPRNEXC: CALL SIGNACC ;RANGE EXECEEDED FOR EXP FUNCTION CMA ;RESULT DETERMINED BY SGN(X) POP H FLMLDVEY: ORA A FLMLDVEZ: POP H JP ZEROAC JMP ERRAOV ; ; Page 110 ; ; ; FLOATING POINT DIVIDE ROUTINE ; FLDIVB10: CALL PUSHAC ;COMPUTE AC/10 LXI B,08420H LXI D,00000H CALL LDACRG DIVOPR: POP B POP D FLDIV: CALL SIGNACC ;DIVIDE REGISTERS BY ACCUMULATOR JZ ERRAD0 MVI L,0FFH CALL FLMLDVEX INR M INR M ;plus 2 DCX H MOV A,M CMA STA FLSCR2 DCX H MOV A,M CMA STA FLSCR1 DCX H MOV A,M CMA STA FLSCR0 MOV B,C XCHG XRA A MOV C,A MOV D,A MOV E,A STA FLSCR3 FLDIVLP: PUSH H PUSH B STC LDA FLSCR0 ADC L MOV L,A LDA FLSCR1 ADC H MOV H,A LDA FLSCR2 ADC B MOV B,A LDA FLSCR3 ACI 0FFH JNC FLDIVSF STA FLSCR3 ; ; Page 111 ; POP PSW ;TRIAL SUBRACT SUCCEEDED, POP PSW ;THROW AWAY SAVED DIVIDEND STC JMP FLDIVSS FLDIVSF: POP B ;TRIAL SUBTRACT FAILED, RESTORE POP H FLDIVSS: MOV A,C INR A DCR A RAR JM FLROUNDV RAL MOV A,E RAL MOV E,A MOV A,D RAL MOV D,A MOV A,C RAL MOV C,A DAD H MOV A,B RAL MOV B,A LDA FLSCR3 RAL STA FLSCR3 MOV A,C ORA D ORA E JNZ FLDIVLP PUSH H LXI H,FLACCEXP DCR M POP H JNZ FLDIVLP JMP ERRAOV ERRAD0: MVI E,ERRND0-ERRN JMP ERRMSG ; ; Page 112 ; ; ; MISCELLANEOUS AUXILIARY ROUTINES ; ; ; CPY ACCUMULATOR TO STACK ; PUSHAC: XCHG ;PUSH ACCUMULATOR ONTO STACK PUSHAC1: LHLD ACCUMLTR XTHL PUSH H LHLD FLACCMSB XTHL PUSH H XCHG RET ; ; LOAD ACCUMULATOR ; LDRGACMM: CALL LDRGMM ;LOAD FLOATING ACC AND REGISTERS LDACRG: XCHG ;LOAD ACCUMULATOR FROM REGISTERS SHLD ACCUMLTR MOV H,B MOV L,C SHLD FLACCMSB XCHG RET ; ; LOAD REGISTERS ; LDRGAC: LXI H,ACCUMLTR ;LOAD REGISTERS FROM ACCUMULATOR LDRGMM: MOV E,M ;LOAD REGISTERS FROM FLOAT NUMBER INX H LDDCBMM: MOV D,M ;LOAD REGISTERS FROM STRING LDICBMM: INX H MOV C,M INX H MOV B,M INCHLRET: INX H RET ; ; Page 113 ; ; ; STORE ACCUMULATOR / COPY A VALUE ; LDMMAC: LXI D,ACCUMLTR ;LOAD MEMORY FROM ACCUMULATOR COPYVAL: LDA TYPEFLG ;COPY VALUE FROM (DE) TO (HL) MOV B,A COPYVALL: LDAX D MOV M,A INX D INX H DCR B JNZ COPYVALL RET ; ; TURN ON HIGH ORDER MANTISSA BITS OF ACCUMULATOR/REGISTERS ; SIGNIFY: LXI H,FLACCMSB ;SET ON HIGH-ORDER MANTISSA BITS, MOV A,M ;AND SAVE SIGN IN FLACCSSV RLC STC RAR MOV M,A ;FIRST ACCUMULATOR, CMC RAR INX H INX H MOV M,A MOV A,C RLC STC RAR MOV C,A ;THEN REGISTERS RAR XRA M RET ; ; Page 114 ; ; ; FLOATING POINT COMPARISON: REGISTERS VS ACCUMULATOR ; FLCMP: MOV A,B ;FLOATING COMPARE REGS TO ACC ORA A JZ SIGNACC LXI H,FLCMPXT PUSH H CALL SIGNACC MOV A,C RZ LXI H,FLACCMSB XRA M MOV A,C RM CALL FLCMPM RAR XRA C RET FLCMPM: INX H ;COMPARE MANTISSAS MOV A,B CMP M RNZ DCX H MOV A,C CMP M RNZ DCX H MOV A,D CMP M RNZ DCX H MOV A,E SUB M RNZ POP H POP H RET ; ; Page 115 ; ; ; COMPUTER INTEGER PART OF ACCUMULATOR ; FIXAC: MOV B,A ;LOAD REGS WITH FIX(AC) MOV C,A MOV D,A MOV E,A ORA A RZ PUSH H CALL LDRGAC CALL SIGNIFY XRA M MOV H,A CM DECCDE MVI A,098H SUB B CALL SHIFTR0 MOV A,H RAL CC INCCDE MVI B,000H CC CMREGS POP H RET DECCDE: DCX D ;DECREMENT CDE MOV A,D ANA E INR A RNZ DCR C RET FLMULB10: CALL LDRGAC ;MULTIPLY CONTENTS OF AC BY 10 MOV A,B ORA A RZ ADI 002H JC ERRAOV MOV B,A CALL FLADD ;AC=AC+4*AC LXI H,FLACCEXP INR M ;AC=2*AC RNZ JMP ERRAOV SIGNACC: LDA FLACCEXP ;FIND SIGN OF ACCUMULATOR ORA A RZ LDA FLACCMSB ; ; Page 116 ; JMP SIGNXTND FLCMPXT: CMA SIGNXTND: RAL CMPXT: SBB A RNZ INR A RET CMANSWR: LXI H,CMACCS ;F(X)=-F(0) XTHL PCHL SGNFCT: CALL SIGNACC FLOATBYT: MVI B,088H LXI D,0 FLOATINT: LXI H,FLACCEXP ;CONVERT INTEGER IN ADE TO FLOAT, MOV C,A MOV M,B ;EXPONENT ASSUMED IN B MVI B,000H INX H MVI M,080H RAL JMP NORMALZI ; ; COMPUTE ABSOLUTE VALUE OF ACCUMULATOR ; ABSFCT: CALL SIGNACC ;ABS FUNCTION RP CMACCS: LXI H,FLACCMSB ;CHANGE SIGN OF ACCUMULATOR MOV A,M XRI 080H MOV M,A RET INTFCT: LXI H,FLACCEXP ;INT FUNCTION MOV A,M CPI 098H LDA ACCUMLTR RNC MOV A,M CALL FIXAC MVI M,098H MOV A,E PUSH PSW MOV A,C ; ; Page 117 ; RAL CALL NORMALZI POP PSW RET ; ; Page 118 ; ; ; FLOATING POINT DECODE ROUTINE ; DECODE: CPI '-' ;DECODE EXTERNAL FORM OF NUMBER PUSH PSW JZ DECODEIN CPI '+' JZ DECODEIN DCX H DECODEIN: CALL ZEROAC MOV B,A MOV D,A MOV E,A CMA MOV C,A DECODELP: CALL SCANNXT ;bscan , JC DECDIGIT CPI '.' JZ DECODEPT CPI 'E' ;UPPER CASE E JZ DECODEXP CPI 'e' ;LOWER CASE E JNZ DECODVAL DECODEXP: CALL SCANNXT ;bscan , PUSH H LXI H,DECODEXL XTHL DCR D CPI KEYSUB RZ CPI '-' RZ INR D CPI '+' RZ CPI KEYADD RZ POP PSW DCX H DECODEXL: CALL SCANNXT ;bscan , ;SCAN EXPONENT JNC DECODEXQ MOV A,E ;DECODE EXPONENT DIGIT RLC ;E=10*E+VAL(M) RLC ADD E RLC ADD M SUI '0' MOV E,A ; ; Page 119 ; JMP DECODEXL DECODEXQ: INR D JNZ DECODVAL XRA A SUB E MOV E,A INR C DECODEPT: INR C ;DECODE DECIMAL POINT JZ DECODELP DECODVAL: PUSH H MOV A,E SUB B DECDEXPA: CP DECMULUP ;COMBINE MANTISSA, EXPONENT JP DECDEXAL PUSH PSW CALL FLDIVB10 POP PSW INR A DECDEXAL: JNZ DECDEXPA POP D POP PSW CZ CMACCS XCHG RET ; ; Page 120 ; DECMULUP: RZ FLMLB10C: PUSH PSW CALL FLMULB10 POP PSW DCR A RET DECDIGIT: PUSH D ;DECODE DIGIT OF NUMBER MOV D,A MOV A,B ADC C MOV B,A PUSH B PUSH H PUSH D CALL FLMULB10 POP PSW SUI '0' CALL DECDGADD POP H POP B POP D JMP DECODELP DECDGADD: CALL PUSHAC CALL FLOATBYT ADDOPR: POP B POP D JMP FLADD ; ; Page 121 ; ; ; FLOATING POINT ENCODE ROUTINE ; ERRMSGIN: PUSH H ;PRINT CUR LINE NUMBER IN ERROR LXI H,MSGIN CALL PRNTMSG POP H PRINTINT: PUSH H ;PRINT AN INTEGER LXI H,PRNTNUMS XTHL ENCODEHL: XCHG ;ENCODE AN INTEGER XRA A MVI B,098H CALL FLOATINT ENCODE: LXI D,-13 ;ENCODE AC IN EXTERNAL FORM LHLD PROGBASE DAD D ;CREATE POINTER TO ENCODE BUFFER PUSH H CALL SIGNACC MVI M,' ' JP ENCODFRS MVI M,'-' ENCODFRS: INX H MVI M,'0' JZ ENCODZXT PUSH H CM CMACCS XRA A PUSH PSW CALL ENCODCMP ENCODUPL: LXI B,09143H ;FORCE NUMBER TO RANGE LXI D,04FF8H ;10**5 <= AC BY MULTIPLICATION CALL FLCMP DCR A JP ENCODRND POP PSW CALL FLMLB10C PUSH PSW JMP ENCODUPL ENCODDNL: CALL FLDIVB10 ;FORCE NUMBER TO RANGE POP PSW ;AC < 10**6 BY DIVISION INR A PUSH PSW CALL ENCODCMP ENCODRND: CALL FLADDHLF ;ROUND UP RESULT INR A ; ; Page 122 ; CALL FIXAC CALL LDACRG LXI B,00206H ;D.DDDDD POP PSW ADD C JM ENCDEXPS CPI 007H JNC ENCDEXPS INR A MOV B,A MVI A,001H ENCDEXPS: DCR A POP H PUSH PSW LXI D,ENCDCOEF ENCODDGL: DCR B MVI M,'.' CZ INCHLRET PUSH B PUSH H PUSH D CALL LDRGAC POP H MVI B,'0'-1 ;GENERATE NEXT DIGIT ENCODSBL: INR B MOV A,E SUB M MOV E,A INX H MOV A,D SBB M MOV D,A INX H MOV A,C SBB M MOV C,A DCX H DCX H JNC ENCODSBL CALL ADDM2CDE INX H CALL LDACRG XCHG POP H MOV M,B INX H POP B DCR C JNZ ENCODDGL DCR B JZ ENCODEXP ENCDRTZR: DCX H ;REMOVE TRAILING ZEROES ; ; Page 123 ; MOV A,M CPI '0' JZ ENCDRTZR CPI '.' ;REMOVE TRAILING DECIMAL POINT CNZ INCHLRET ENCODEXP: POP PSW ;ENCODE EXPONENT JZ ENCODEXT MVI M,'E' INX H MVI M,'+' JP ENCDEXPP MVI M,'-' CMA INR A ENCDEXPP: MVI B,'0'-1 ENCDEXPL: INR B SUI 10 JNC ENCDEXPL ADI '9'+1 INX H MOV M,B ENCODZXT: INX H MOV M,A INX H ENCODEXT: MOV M,C POP H RET ENCODCMP: LXI B,09474H ;10**6 LXI D,023F7H CALL FLCMP POP H DCR A JP ENCODDNL PCHL FLHALF: DB 000h, 000h, 000h, 080h ;1/2 ENCDCOEF: db 0a0h, 086h, 001h ;10**5 db 010h, 027h, 000h ;10**4 db 0e8h, 003h, 000h ;10**3 db 064h, 000h, 000h ;10**2 db 00ah, 000h, 000h ;10**1 db 001h, 000h, 000h ;10**0 ; ; Page 124 ; ; ; FLOATING POINT LOGARITHM ROUTINE ; LOGCOEF: DB 3 db 0aah, 056h, 019h, 080h db 0f1h, 022h, 076h, 080h db 045h, 0aah, 038h, 082h FLONE: db 000h, 000h, 000h, 081h ;1.0 LOGFCT: CALL SIGNACC ;LOG FUNCTION DCR A JM ERRAFC LXI H,FLACCEXP MOV A,M LXI B,08035H LXI D,004F3H SUB B PUSH PSW MOV M,B PUSH D PUSH B CALL FLADD POP B POP D INR B CALL FLDIV LXI H,FLONE CALL FLMMMAC LXI H,LOGCOEF CALL FCTPOLY2 LXI B,08080H LXI D,00000H CALL FLADD POP PSW CALL DECDGADD FLMULLN2: LXI B,08031H ;LN(2)=0.6931472 LXI D,07218H JMP FLMUL ; ; Page 125 ; ; ; FLOATING POINT SQUARE ROOT/EXPONENTIATION ROUTINE ; SQRFCT: CALL PUSHAC ;SQR FUNCTION LXI H,FLHALF ;SQR(X)=X**1/2 CALL LDRGACMM EXPOPR: POP B ;X**Y=EXP(LOG(X)*Y) POP D CALL SIGNACC JZ EXPFCT MOV A,B ORA A JZ LDACCE PUSH D PUSH B MOV A,C ORI 07FH CALL LDRGAC JP EXPEXPOS PUSH D PUSH B CALL INTFCT POP B POP D PUSH PSW CALL FLCMP POP H MOV A,H RAR EXPEXPOS: POP H SHLD FLACCMSB POP H SHLD ACCUMLTR CC CMANSWR CZ CMACCS PUSH D PUSH B CALL LOGFCT POP B POP D CALL FLMUL ; ; Page 126 ; ; ; EXPONENTIAL FUNCTION ROUTINE ; EXPFCT: CALL PUSHAC ;EXP FUNCTION LXI B,08138H ;LOG(2)E=1.442695 LXI D,0AA3BH CALL FLMUL LDA FLACCEXP CPI 088H JNC EXPRNEXC CALL INTFCT ADI 080H ADI 002H JC EXPRNEXC PUSH PSW LXI H,FLONE CALL FLADDM CALL FLMULLN2 POP PSW POP B POP D PUSH PSW CALL FLSUB CALL CMACCS LXI H,EXPCOEF CALL FCTPOLY1 LXI D,0 POP B MOV C,D JMP FLMUL EXPCOEF: DB 8 db 040h, 02eh, 094h, 074h db 070h, 04fh, 02eh, 077h db 06eh, 002h, 088h, 07ah db 0e6h, 0a0h, 02ah, 07ch db 050h, 0aah, 0aah, 07eh db 0ffh, 0ffh, 07fh, 07fh db 000h, 000h, 080h, 081h db 000h, 000h, 000h, 081h ; ; Page 127 ; ; ; FLOATING POINT POLYNOMINAL EVALUATORS ; FCTPOLY2: CALL PUSHAC ;POLYNOMIAL EVALUATOR LXI D,MULOPR ;EVALUATE P(X**2)*X PUSH D PUSH H CALL LDRGAC CALL FLMUL POP H FCTPOLY1: CALL PUSHAC ;EVALUATE P(X) MOV A,M INX H CALL LDRGACMM FCTPOLYL: POP B POP D DCR A RZ PUSH D PUSH B PUSH PSW PUSH H CALL FLMUL POP H CALL LDRGMM PUSH H CALL FLADD POP H POP PSW JMP FCTPOLYL ; ; Page 128 ; ; ; RANDOM NUMBER GENERATOR ; RNDFCT: CALL SIGNACC ;RND FUNCTION JM RNDFCTUS ;<0 - INITIALIZE SEED LXI H,RNDFCTSD CALL LDRGACMM RZ ;=0 - PREVIOUS VALUE LXI B,09835H LXI D,0447AH CALL FLMUL ;>0 - NEXT VALUE LXI B,06828H LXI D,0B146H CALL FLADD RNDFCTUS: CALL LDRGAC ;CHANGE SEED MOV A,E MOV E,C MOV C,A MVI M,080H DCX H MOV B,M MVI M,080H CALL NORMALIZ LXI H,RNDFCTSD JMP LDMMAC ; ; Page 129 ; ; ; FLOATING POINT SINE/COSINE ROUTINES ; COSFCT: LXI H,PIOVER2 ;COS FUNCTION CALL FLADDM SINFCT: CALL PUSHAC ;SIN FUNCTION LXI B,08349H ;Y=X*2*PI LXI D,00FDBH CALL LDACRG POP B POP D CALL FLDIV CALL PUSHAC ;Y=Y MOD 1 CALL INTFCT POP B POP D CALL FLSUB LXI H,FLQUART CALL FLMMMAC CALL SIGNACC STC JP SINFCTC CALL FLADDHLF CALL SIGNACC ORA A SINFCTC: PUSH PSW CP CMACCS LXI H,FLQUART CALL FLADDM POP PSW CNC CMACCS LXI H,COSCOEF JMP FCTPOLY2 PIOVER2: db 0dbh, 00fh, 049h, 081h ;PI/2 FLQUART: db 000h, 000h, 000h, 07fh ;1/4 COSCOEF: DB 5 db 0bah, 0d7h, 01eh, 086h db 064h, 026h, 099h, 087h db 058h, 034h, 023h, 087h db 0e0h, 05dh, 0a5h, 086h ; ; Page 130 ; db 0dah, 00fh, 049h, 083h ; ; Page 131 ; ; ; FLOATING POINT TANGENT/ARCTANGENT ROUTINES ; TANFCT: CALL PUSHAC ;TAN FUNCTION CALL SINFCT POP B ;TAN(X) = SIN(X)/COS(X) POP H CALL PUSHAC XCHG CALL LDACRG CALL COSFCT JMP DIVOPR ATNFCT: CALL SIGNACC CM CMANSWR CM CMACCS LDA FLACCEXP CPI 081H JC ATNFCTC LXI B,08100H MOV D,C MOV E,C CALL FLDIV LXI H,FLMMMAC PUSH H ATNFCTC: LXI H,ATNCOEF CALL FCTPOLY2 LXI H,PIOVER2 RET ATNCOEF: DB 9 db 04ah, 0d7h, 03bh, 078h db 002h, 06eh, 084h, 07bh db 0feh, 0c1h, 02fh, 07ch db 074h, 031h, 09ah, 07dh db 084h, 03dh, 05ah, 07dh db 0c8h, 07fh, 091h, 07eh db 0e4h, 0bbh, 04ch, 07eh db 06ch, 0aah, 0aah, 07fh db 000h, 000h, 000h, 081h ; ; Page 132 ; VERSNDAT: DB '02/03/78',0 ENDINTRP: DB 0 ;END OF INTERPRETER ; ; Page 133 ; ; ; INITIALIZATION ; INITIALZ: LXI H,0FFFFH SHLD CURLINE LXI H,INITSTCK SPHL SHLD STCKBASE XRA A STA PRINTFLG call dclr CALL PRNTCRLF LXI H,LIMUPPER ;ADDRESS LAST BYTE SHLD STRGTLIM LXI D,-10*3 DAD D SHLD STRGBASE SHLD STRGFREE LXI D,-256 DAD D JNC ERRAOM PUSH H LXI H,LIMLOWER ;ADDRESS OF FIRST BYTE LXI D,12 DAD D MVI M,000H INX H SHLD PROGBASE XTHL POP D SPHL SHLD STCKBASE LXI H,-13 DAD SP SPHL XCHG CALL SPACECHK MOV A,E SUB L MOV L,A MOV A,D SBB H MOV H,A LXI B,-16 DAD B CALL PRNTCRLF CALL PRINTINT LXI H,INITMFRE CALL PRNTMSG LXI H,VERSNDAT CALL PRNTMSG CALL CLEARPGM LXI H,CMNDRSTR ; ; Page 134 ; SHLD SYSINITJ+1 PCHL INITMFRE: DB ' BYTES FREE' DB CR,LF,LF db 'BASIC, Version of ', 0 INITSTSP: DS 30*2+LINESYZE ;INITIALIZE STACK SPACE INITSTCK: DS 20 END