;SAM COUPE ROM 3.0 SOURCE CODE Copyright Andrew J.A. Wright 1989-90 ;MAIN.SAM ORG 0,0 PAGE0 EQU 0 PAGE1 EQU 1 PAGE1F EQU 1FH ORG 0000H,0 L0000: DI JP MINITH POP HL ;04 FOWIA HLJUMP: JP (HL) IYJUMP: JP (IY) ;RST 08H - ERRORS NOP ;SOME HARDWARE MIGHT LIKE THIS... EXX JP ERROR2 NRWRITE: LD (HL),A RET DB 30 ;0FH. ROM VERSION NUMBER ;RST 10H - PRINT A JP RST102 ;0013H - PRINT BC FROM (DE) PRINTSTR: JP SOP2 ;13 BCJUMP: PUSH BC ;16 RET ;RST 18 - GET CHAR. SKIP ALL CONTROL CODES EXCEPT CR. GETCHAR: LD HL,(CHAD) ;18 PUSH BC JP GETCHAR1 DB 0 ;RST 20H - NEXT CHAR ;20 NEXTCHAR: LD HL,(CHAD) INC HL PUSH BC JP NEXTCHAR1 JP FPCP2 ;28 FLOATING POINT CALCULATOR DELAYB: DJNZ DELAYB ;2B IXJUMP: JP (IX) ;2D DS 1,0 JP RST30L2 ;30 PUSH DE ;33 DEJUMP RET DELYB: DJNZ DELYB RET PUSH AF ;38H INTERRUPTS PUSH BC IN A,(STATPORT) ;READ IN ABOUT 36Ts (56) 6 (9) USEC LD C,A IN A,(250) LD B,A ;B=LMPR, C=STATUS PUSH HL LD A,PAGE1F+40H OUT (250),A ;BOTH ROMS ON, PAGE ZERO IN SECTION B LD HL,(ANYIV) JP (HL) ANYI: LD (SPSTORE),SP ;ARRIVE IN ABOUT 113 (139) T 19 (23) LD SP,INTSTK CALL INTS LD SP,HL OUT (250),A POP HL POP BC POP AF EI RET DB 0 OUT (251),A JP (HL) DELBC: LD A,B OR C DEC BC JR NZ,DELBC RET NOP ;NON-MASKABLE INTERRUPT PUSH AF PUSH HL ;REGS SAVED IN ORIG PAGE - MAY CORRUPT 4 BYTES ;IF EG SP BEING USED TO CLS IN A,(250) LD H,A LD A,PAGE1F OUT (250),A ;ROM0 ON, ROM1 OFF, PAGE 0 AT 4000H LD A,H LD (NMILRP),A ;SAVE ORIG LRPORT STATUS LD (NMISP),SP LD SP,NMISTK ;PUT STACK SOMEWHERE SAFE LD HL,(NMIV) LD A,H OR L CALL NZ,HLJUMP ;NORMALLY SUPER-BREAK LD SP,(NMISP) LD A,(NMILRP) OUT (250),A POP HL POP AF RETN LDIR RET LDDR RET CPIR RET CPDR RET OTIR RET OTDR RET ;READ, SKIP NUMBER RDCN: LD A,(HL) ;SKIP 5-BYTE INVIS. NUMBER IN BASIC LINE. IF SKIP, TAKES ABOUT 34 Ts. vs 54 ZX NUMBER: CP 0EH RET NZ ;RET IF NOT NUMBER MARKER LD A,6 ADD A,L LD L,A LD A,(HL) RET NC ;RET IF HL OK AND A=NEXT CHAR INC H NRREAD: LD A,(HL) RET RDDE: LD A,(DE) RET MINITH: LD B,250 IDEL: DEC BC LD A,B OR C JR NZ,IDEL ;DELAY APPROX 1.2 MSEC *B LD A,40H+PAGE1F OUT (250),A ;ROM1 ON JP MNINIT NEXTCHAR1: LD (CHAD),HL GETCHAR1: IN A,(250) LD B,A AND 0BFH ;FORCE BIT 6 LOW OUT (250),A ;ROM1 OFF GTCH1: LD A,(HL) CP 21H JR C,GTCH3 ;JR IF 00-20H GTCH2: LD C,250 OUT (C),B ;ORIG ROM1 STATUS POP BC RET GTCH3: CP 0DH JR Z,GTCH2 ;RET IF CR INC HL ;SKIP SPACES AND CONTROL CODES LD (CHAD),HL JR GTCH1 NXCHAR: LD HL,(CHAD) INC HL LD (CHAD),HL LD A,(HL) RET ;FLOATING-POINT CALCULATOR FPCP2: EX (SP),IX ;SAVE PTR IN USE BY ANY CALLING RST 28H ROUTINE ;MAKE PTR=ADDR AFTER RST 28H LD (BCREG),BC IN A,(250) PUSH AF ;ORIG PORT STATUS OR 40H ;BIT FOR ROM1=HI (ACTIVE) OUT (250),A CALL FPCMAIN POP AF EX (SP),IX ;GET ORIG IX AS PTR, (SP) PTS. PAST EXIT OR EXIT2 LRPOUT: LD BC,(BCREG) OUT (250),A RET DS 0100H-$,0 ;JUMP TABLE AT 0100H RST 30H DW JSCRN-8000H ;0100 JP JSVIN ;0103 RST 30H DW HEAPROOM-8000H ;0106 JP WKROOM ;0109 JP MKRBIG ;010C OPEN ABC AT HL JP CALBAS ;010F CALL BASIC LINE JP SETSTRM ;0112 SET STREAM IN A REG JP POMSG ;0115 O/P MSG A FROM LIST AT DE JP EXPT1NUM ;0118 EXPECT A NUMERIC EXPR. AT (CHAD) JP EXPTSTR ;011B EXPECT A STRING EXPR AT (CHAD) JP EXPTEXPR ;011E EXPECT AN EXPRESSION AT (CHAD) JP GETINT ;0121 UNSTACK WORD FROM CALCULATOR STACK TO ; BC. HL=BC, A=C JP STKFETCH ;0124 GET STRING PARAMS. A=START PAGE, DE=START ; BC=LEN JP STKSTORE ;0127 STACK STRING PARAMS JP SBUFFET ;012A UNSTACK STRING PARAMS AND COPY TO BUFFER IN ; SYS PAGE. ERROR IF >255 BYTES JP FARLDIR ;012D MOVE (PAGCOUNT/MODCOUNT) BYTES FROM PAGE A, ; HL TO PAGE C, DE, USING LDIR JP FARLDDR ;0130 JP JPUT ;0133 JP JGRAB ;0136 JP JPLOT ;0139 JP JDRAW ;013C JP JDRAWTO ;013F JP JCIRCLE ;0142 JP JFILL ;0145 JP JBLITZ ;0148 JP JROLL ;014B JP CLSBL ;014E CLEAR ENTIRE SCREEN IF A=0, ELSE CLEAR WINDOW JP CLSLOWER ;0151 RST 30H DW JPALET-8000H ;0154 ;A=LINE (OR FFH IF NONE) B/C=COLOURS, E=PAL. ENTRY. RST 30H DW JOPSCR-8000H ;0157 MODET: RST 30H DW MODPT2-8000H ;015A RST 30H DW JTCOPY-8000H ;015D TEXT COPY RST 30H DW JGCOPY-8000H ;0160 GRAPHICS COPY JP RECLAIM2 ;0163 JP KBFLUSH ;0166 JP READKEY ;0169 ;READ KEYBOARD, FLUSH BUFFER (INKEY$). Z, NC=NONE ;CY, NZ IF A=KEY JP KYIP2 ;016C ** ;WAIT FOR A QUEUED KEY IN A. RST 30H DW BEEPP2-8000H ;016F ;DO DE-1 CYCLES AT PERIOD HL 8-T UNITS RST 30H DW SABYTES-8000H ;0172 RST 30H DW LDBYTES-8000H ;0175 JLDVD: RST 30H DW LDVD2-8000H ;0178 LOAD (IF CY) OR VERIFY CDE AT HL DISC/TAPE JP EDGE2 ;017B TAPE EDGE TIMER JPFSTRS: RST 30H DW PFSTRS-8000H ;017E STR$ OF FPCS TO BUFFER SENDA: RST 30H DW SNDA2-8000H ;0181 SEND BYTE IN A TO PRINTER ;NEW TO V11 RST 30H DW IMSCSR-8000H ;0184 SCREEN$ JP GRCOMP ;0187 GRAPHIC COPY SR JGTTOK: RST 30H DW GETTOKEN-8000H ;018A MATCH FOR A-1 WORDS FROM LIST AT HL+1 RST 30H DW JCLSCR-8000H ;018D ;MODE 1/MODE 2/MODE 3/MODE 4 ;DOES FULL CLS, SETS UP EXPANSION TABLE IF NEEDED MODECMD: CALL SYNTAX6 ;INSIST ON A NUMBER LD DE,0400H+34 CALL LIMDB ;ALLOW ORIG OF 1-4, DEC JR MODET OTCD: LD E,30H ADD A,E RST102: PUSH IX PUSH HL PUSH DE PUSH BC LD HL,(CURCHL) CALL HLJPI POP BC POP DE POP HL POP IX RET S16OP: EX AF,AF' PUSH AF LD BC,S16OSR CALL R1OF2 ;CALL S16 O/P (IN ROM0) WITH ROM1 OFF POP AF EX AF,AF' RET INPUTAD: EXX PUSH HL LD HL,(CURCHL) INC HL INC HL CALL HLJPI POP HL EXX RET HLJPI: LD E,(HL) INC HL LD D,(HL) EX DE,HL JP (HL) PRMAIN: RST 30H DW PROM1-8000H ;JP MAIN PRINT ROUTINE IN ROM1 RST30L2: EX (SP),HL ;GET CALLER'S ADDRESS IN HL PUSH AF LD A,H CP 40H JR NC,RST30L4 ;JR IF CALLED FROM OUTSIDE ROM0 - USER LD (BCSTORE),BC LD C,(HL) INC HL LD B,(HL) INC HL BIT 7,B JR NZ,RST30L3 ;JR IF NORMAL 'CALL ROM1' SET 7,B ;ELSE BIT 7 SHOWED 'JP ROM1' POP AF POP HL ;ORIG HL - JUNK 1 RET ADDR JR R1ONCLBC RST30L3: POP AF EX (SP),HL R1ONCLBC: EX AF,AF' IN A,(250) PUSH AF OR 40H JR R1OFON RST30L4: POP AF EX (SP),HL PUSH HL LD HL,(RST30V) EX (SP),HL RET ;'RET' TO VECTOR, ALL REGS INTACT ;CALL PARAM ADDR WITH ROM1 OFF. JUNK CALLING ADDR SO EQUIV. OF 'JUMP' ;(ORIG ROM1 STATUS STILL RESTORED, THOUGH) R1OFFJP: EX (SP),HL LD C,(HL) INC HL LD B,(HL) POP HL JR R1OFFCLBC ;CALL PARAM ADDR WITH ROM1 OFF. CALL CAN COME FROM ANYWHERE ;ORIG ROM1 STATUS RESTORED AT END R1OFFCL: EX (SP),HL LD C,(HL) INC HL LD B,(HL) INC HL EX (SP),HL ;BC=PARAMETER ;R1OFFCLBC. CALL BC WITH ROM1 OFF. ALL REGS CARRIED IN EXCEPT AF' (CORRUPT) ;ALL REGS CARRIED OUT EXCEPT AF'. ORIG ROM1 STATUS RESTORED AT END R1OFFCLBC: EX AF,AF' R1OF2: IN A,(250) PUSH AF ;ORIG URPORT STATUS AND 0BFH ;ROM1 BIT OFF R1OFON: OUT (250),A ;ROM1 OFF/ON EX AF,AF' CALL LDBCJP EX AF,AF' POP AF OUT (250),A EX AF,AF' RET LDBCJP: PUSH BC LD BC,(BCSTORE) RET ;TURN ROM 1 OFF, JP (BC) R1XJP: IN A,(250) AND 0BFH OUT (250),A PUSH BC RET ;STRING O/P - FROM 0013H ;ENTRY: DE PTS TO DATA, SWITCHED IN. BC=LEN ;ACTION: DO NOTHING IF BC=0, ELSE PRINT BC BYTES FROM (DE) ;EXIT: DE PTS TO JUST PAST LAST BYTE ON EXIT, BC=0, HL CORRUPT SOP2: PUSH DE LD HL,(CURCHL) ;FETCH AN OUTPUT ADDRESS POINTER LD E,(HL) INC HL LD D,(HL) EX DE,HL POP DE ;DE=SRC, HL=CHANNEL IN A,(250) PUSH AF AND 0BFH ;ROM1 OFF OUT (250),A LD A,(HL) CP 40H JR NZ,SOP3 ;JR IF SPECIAL STRING OUTPUT NOT PROVIDED BY ;CHANNEL - USE MULTIPLE CALLS OF RST 10H. INC HL INC HL INC HL ;SKIP '40H, JR XX' TO PT TO STRING O/P ROUTINE CALL HLJUMP JR SOP4 SOPL: LD A,(DE) RST 10H INC DE LD A,D CP 0C0H CALL NC,INCURPDE SOP3: LD A,B OR C DEC BC JR NZ,SOPL SOP4: POP AF OUT (250),A RET R1OFRD: PUSH BC CALL R1OFFCL DW NRREAD POP BC RET JSVIN: EXX POP HL ;RET ADDR LD E,(HL) INC HL LD D,(HL) INC HL PUSH HL ;RET ADDR TO CALLER LD C,A ;SAVE ENTRY A BRIEFLY IN A,(250) LD B,A ;ENTRY LRPORT LD A,1FH DI OUT (250),A ;SYS PAGE IN AT 4000H, ROM0 ON, ROM1 OFF LD (JVSP),SP LD SP,ISPVAL-40H EI PUSH BC LD HL,JSVIN2 ;RET ADDR TO PT 2 PUSH HL PUSH DE ;PARAM TO CALL LD A,C ;ENTRY A EXX RET ;TO PARAM ADDR WITH MAIN REGS INTACT ;THEN 'RET' TO VARSIN2 JSVIN2: EX AF,AF' POP AF DI LD SP,(JVSP) OUT (250),A ;ORIG EI EX AF,AF' RET ;INITIAL STREAM DISPLACEMENTS STRMTAB: DB 26,21,1,6,11 ;B,$,K,S,R (FIXED) FOR STREAMS FB,FC,FD,FE,FF DB 1,1,6,16 ;K,K,S,P FOR STREAMS 0,1,2,3 ;MAIN FILE - MAIN.SAM INCLUDE VARS.SAM ;VARS.SAM VAR2 EQU 5A00H ;MUST START AT PAGE BOUNDARY ;NEXT 18 BYTES INITED TOGETHER FROM 'CHIT' LNCUR EQU VAR2+00H ;CURRENT LINE CURSOR CHAR (USUALLY '>') KURCHAR EQU VAR2+01H ;(2) CURSOR CHARACTERS - LOWER CASE/UPPER CASE BIN1DIG EQU VAR2+03H ;USED BY BIN$ - USUALLY '1' BIN0DIG EQU VAR2+04H ; USUALLY '0' INSTHASH EQU VAR2+05H ;NORMALLY '#' PSLD EQU VAR2+06H ;(2) DEVICE LETTER/NUMBER ;NUMBER=TAPE SPEED/DISC NUMBER/NET STATION SPEEDINK EQU VAR2+08H ;INK FLASH COUNTER RELOAD VALUE LINIPTR EQU VAR2+09H ;(2) PTR TO LINE INTERRUPT PAL CHNG TABLE XCMDP EQU VAR2+0BH ;(3) PAGE/ADDR OF FIRST EXTERNAL CMD LIST, OR FFXXXX PRRHS EQU VAR2+0EH ;PRINTER RHS LIMIT - 79 AFTERCR EQU VAR2+0FH ;0A OR NUL ACCORDING TO WHETHER AUTO LF NEEDED LPTPRT1 EQU VAR2+10H ;(2) PRINTER CONTROL PORT/01H STROBE VALUE ;ALL reserved for DUMP TABVAR EQU VAR2+2FH ;0 IF TAB=16, ELSE TAB=8 M23LSC EQU VAR2+30H ;(2) M2/3 LOWER SCREEN COLOURS SOFE EQU VAR2+32H ;FLAG FOR SCREEN OFF ENABLE/DISABLE 0=ON TPROMPTS EQU VAR2+33H ;BIT 0=1 TO SUPPRESS PRINTED NAMES DURING LOAD ;BIT 1=1 TO SUPPRESS PROMPTS DURING SAVE ;START OF BLOCK SAVED WITH SWITCHED-OUT SCREEN BGFLG EQU VAR2+34H ;BLOCK GRAPHICS FLAG FL6OR8 EQU VAR2+35H ;00=6 BIT CHARS IN MODE 2, NZ=8 BIT CSIZE EQU VAR2+36H ;(2) HEIGHT/WIDTH UWRHS EQU VAR2+38H ;STARTS AT 31 UWLHS EQU VAR2+39H ;STARTS AT 0 UWTOP EQU VAR2+3AH ;STARTS AT 0 UWBOT EQU VAR2+3BH ;STARTS AT 18 (19 LINES IN UPPER, 2 IN LOWER SCR, 9 PIX) ;LOWER WINDOW LWRHS EQU VAR2+3CH LWLHS EQU VAR2+3DH LWTOP EQU VAR2+3EH LWBOT EQU VAR2+3FH ;STARTS AT 20 MODE EQU VAR2+40H YCOORD EQU VAR2+41H ;0-191, 0 AT TOP XCOORD EQU VAR2+42H ;(2) 0-255 (FAT) OR 0-511 (THIN) RLINE EQU XCOORD ;PERMANENT GRAPHICS/PRINT VARS THFATP EQU VAR2+44H ;00=THIN, NZ=FAT PIXELS ATTRP EQU VAR2+45H ;ATTR USED BY MODES 0 AND 1 MASKP EQU VAR2+46H PFLAGP EQU VAR2+47H ;BIT 4=PAPER 9, BIT 6=INK 9 M23PAPP EQU VAR2+48H ;NIBBLES OR DOUBLE BITS MATCH M23INKP EQU VAR2+49H ;00-FF. NIBBLES MUST MATCH UNLESS A DOTTED LINE WANTED. ;MUST BE NEXT TO OVER FOR LD DE,(M3INKT) OVERP EQU VAR2+4AH ;0-1. NORMAL OR OVER 1 (OR-ING) INVERP EQU VAR2+4BH ;00/FF FOR NORMAL/INVERSE ; GOVERP EQU VAR2+4CH ;0-3. NORMAL, XOR, OR, AND ;THESE 2 LINKED ;(GRAPHICS OVER - USED BY PUT) ;TEMPORARY GRAPHICS/PRINT VARS THFATT EQU VAR2+4DH ;COPIED FROM THFATP WHEN MODE=2, ELSE SET TO NZ (FAT) ATTRT EQU VAR2+4EH MASKT EQU VAR2+4FH PFLAGT EQU VAR2+50H ;BIT 4=PAPER 9, BIT 6=INK 9 M23PAPT EQU VAR2+51H ;NIBBLES OR DOUBLE BITS MATCH M23INKT EQU VAR2+52H ;00-FF. NIBBLES MUST MATCH UNLESS A DOTTED LINE WANTED OVERT EQU VAR2+53H ;0-1. NORMAL OR OVER 1 (OR-ING) INVERT EQU VAR2+54H ;00/FF FOR NORMAL/INVERSE ; GOVERT EQU VAR2+55H ;0-3. NORMAL, XOR, OR, AND ;LINKED ;CURRENT WINDOW (TEMP) WINDRHS EQU VAR2+56H WINDLHS EQU VAR2+57H WINDTOP EQU VAR2+58H WINDBOT EQU VAR2+59H WINDMAX EQU VAR2+5AH ;(2) U. WINDOW LOWEST BOTTOM/MAX RHS ORGOFF EQU VAR2+5CH ;GRAPHICS ORIGIN OFFSET LSOFF EQU VAR2+5DH ;LOWER SCREEN BIT OFFSET ** THESE 3 MOVED HERE ;14 SPARE SPOSNU EQU VAR2+6CH ;(2) SCREEN POSN (UPPER) WINDLHS, WINDTOP AFTER CLS SPOSNL EQU VAR2+6EH ;(2) SCREEN POSN (LOWER) 0,19 AFTER CLS ;END OF BLOCK SAVED WITH SCREEN PRPOSN EQU VAR2+70H ;(2) PRINTER POSN (1 BYTE EXTRA FOR CONVENIENT LD) OPCHAR EQU VAR2+72H ;USED BY LPRINT - CURRENT O/P CHAR DEVICE EQU VAR2+73H ;0=US, 1=LS, 2=PRINTER, 3= CLET EQU VAR2+74H ;CURRENT CHANNEL LETTER K/S/P/B/T/$ ETC IFTYPE EQU VAR2+75H ;LONG/SHORT IF REFFLG EQU VAR2+76H ;Z IF REF VAR BEING WORKED ON CURDISP EQU VAR2+77H ;CURRENT DISPLAY CUSCRNP EQU VAR2+78H ;CURRENT SCREEN PAGE CURP EQU VAR2+79H ;CURRENT UPPER RAM PORT CLRP EQU VAR2+7AH ;CURRENT LOWER RAM PORT (TEMP STORES DURING PAGING) CSA EQU VAR2+7BH ;(2) CURRENT STATEMENT ADDR FIRST EQU VAR2+7DH ;(2) LAST EQU VAR2+7FH ;(2) LINE NUMBERS IN EG LIST X TO Y. ALSO USED BY ;ARRAY SLICER ;POINTERS THAT ARE ADJUSTED BY MAKEROOM, RECLAIM: SAVARSP EQU VAR2+81H SAVARS EQU VAR2+82H ;(2) ;SAVARS/NUMEND/NVARS MUST BE IN ORDER NUMENDP EQU VAR2+84H ;NUMEND/NVARS/DATADD MUST BE IN ORDER NUMEND EQU VAR2+85H ;(2) NVARSP EQU VAR2+87H NVARS EQU VAR2+88H ;(2) DATADDP EQU VAR2+8AH DATADD EQU VAR2+8BH ;(2) WKENDP EQU VAR2+8DH WKEND EQU VAR2+8EH ;(2) WORKSPP EQU VAR2+90H WORKSP EQU VAR2+91H ;(2) ELINEP EQU VAR2+93H ELINE EQU VAR2+94H ;(2) CHADP EQU VAR2+96H CHAD EQU VAR2+97H ;(2) KCURP EQU VAR2+99H KCUR EQU VAR2+9AH ;(2) NXTLINEP EQU VAR2+9CH NXTLINE EQU VAR2+9DH ;(2) PROGP EQU VAR2+09FH PROG EQU VAR2+0A0H ;(2) XPTRP EQU VAR2+0A2H XPTR EQU VAR2+0A3H ;(2) DESTP EQU VAR2+0A5H DEST EQU VAR2+0A6H ;(2) PRPTRP EQU VAR2+0A8H PRPTR EQU VAR2+0A9H ;(2) PROC POINTER ;END OF ADJUSTED PTRS DPPTRP EQU VAR2+0ABH DPPTR EQU VAR2+0ACH ;(2) DEF PROC POINTER CLAPG EQU VAR2+0AEH CLA EQU VAR2+0AFH ;(2) DFTFB EQU VAR2+0B1H ;** STRNO EQU VAR2+0B2H ;CURRENT STREAM NO. LDCO EQU VAR2+0B3H ;LD ZX CODE OFFSET (PAGES) ; SPARE OPSTORE EQU VAR2+0B5H ;(2) DMPFG EQU VAR2+0B7H ;IF NZ PRINT O/P DUMPED LISTFLG EQU VAR2+0B8H ;0/1/2 FOR LIST FORMAT 0/1/2 LSTFT EQU VAR2+0B9H ;TEMPORARY VERSION OF LISTFLG USED BY CHANNEL 'R' INQUFG EQU VAR2+0BAH ;IN QUOTES FLAG. BIT 0=1 IF IN QUOTES. OUTLINE ZEROS ;BIT SO INITIAL STATE IS 'OUTSIDE' AND TOKENS PRINTED ;EXCEPT IN QUOTES. PRINT SETS TO 1 SO ALWAYS UDGS. SPROMPT EQU VAR2+0BBH ;IF NZ NO 'SCROLL?' PROMPTS OLDSPCS EQU VAR2+0BCH ;SPACE STATUS OF PREVIOUS LINE ** INDOPFG EQU VAR2+0BDH ;INDENTED O/P FLAG NXTSPCS EQU VAR2+0BEH CURSPCS EQU VAR2+0BFH NXTHSPCS EQU VAR2+0C0H CURTHSPCS EQU VAR2+0C1H KPOS EQU VAR2+0C2H ;(2) CURSOR SCREEN POSN ;NEXT 4 MUST STAY IN ORDER SOFFCT EQU VAR2+0C4H ;COUNTER FOR SCREEN OFF SOFLG EQU VAR2+0C5H ;FLAG FOR 'SCREEN HAS BEEN TURNED OFF' (NZ) OR ON (Z) SPEEDIC EQU VAR2+0C6H ;COUNTER FOR FLASHING INKS PALFLAG EQU VAR2+0C7H ;BIT 0 SHOWS WHICH PAL TABLE IN USE. TEMPW1 EQU VAR2+0C8H ;(2) TEMPW2 EQU VAR2+0CAH ;(2) TEMPW3 EQU VAR2+0CCH ;(2) TEMPB1 EQU VAR2+0CEH TEMPB2 EQU VAR2+0CFH TEMPB3 EQU VAR2+0D0H ;USED FOR FINAL FILL PARAM ;SYSTEM PAGE ONLY LASTSTAT EQU VAR2+0D1H ;STATPORT VALUE ON LAST INTERRUPT SPSTORE EQU VAR2+0D2H ;(2) SP STORE EXCLUSIVE TO INTERRUPTS JVSP EQU VAR2+0D5H ;(2) JSVIN SP STORE NMISP EQU VAR2+0D7H ;(2) NMI SP STORE NMILRP EQU VAR2+0D9H ;(1) LRPORT VALUE WHEN NMI OCCURRED VECTBS EQU VAR2+0DAH ;VECTOR BASE ADDR (0) USED BY LINK ROUTINE DMPV EQU VAR2+0DAH ;(2) SETIYV EQU VAR2+0DCH ;(2) PRTOKV EQU VAR2+0DEH ;(2) NMIV EQU VAR2+0E0H ;(2) FRAMIV EQU VAR2+0E2H ;(2) LINIV EQU VAR2+0E4H ;(2) COMSV EQU VAR2+0E6H ;(2) MIPV EQU VAR2+0E8H ;(2) MOPV EQU VAR2+0EAH ;(2) EDITV EQU VAR2+0ECH ;(2) RST8V EQU VAR2+0EEH ;(2) RST28V EQU VAR2+0F0H ;(2) RST30V EQU VAR2+0F2H ;(2) CMDV EQU VAR2+0F4H ;(2) EVALUV EQU VAR2+0F6H ;(2) LPRTV EQU VAR2+0F8H ;(2) MTOKV EQU VAR2+0FAH ;(2) MOUSV EQU VAR2+0FCH ;(2) KURV EQU VAR2+0FEH ;(2) CEXTAB EQU VAR2+0100H ;(32) COLOUR IS APPLIED TO THIS DATA, SO EG. F0F0 ;MIGHT BECOME A3A3, OR IF INVERSE, 3A3A. EXTAB EQU VAR2+0120H ;(32) 16 WORDS OF MODE 3 PRINT NIBBLE->WORD DATA. ;(OR 16 BYTES OF MODE 2 DOUBLED DATA) ;EACH WORD (BYTE) IS THE EXPANSION OF A NIBBLE, SO ;E.G. ENTRY 0A BIN 1010 =1111000011110000 OR 11001100 COMPFLG EQU VAR2+0140H ;FLAG BITS USED BY LABEL/FN/PROC COMPILER BREAKDI EQU VAR2+0141H ;NZ IF BREAK BETWEEN STATEMENTS DISABLED ERRSTAT EQU VAR2+0142H ; ERRLN EQU VAR2+0143H ;(2) LINE TO GOTO ON ERROR ONERRFLG EQU VAR2+0145H ;BIT 7=TEMP ON, BIT 0=PERM ON ONSTORE EQU VAR2+0146H ;ON CMD'S STATEMENT NO. BCSTORE EQU VAR2+0147H ;(2) USED BY RST 30H M3PAPP EQU VAR2+0149H ;(2) M3LSC EQU VAR2+014BH ;(2) TEMPW4 EQU VAR2+014DH ;(2) USED BY POINTERS TEMPW5 EQU VAR2+014FH ;(2) USED BY POINTERS ;1 SPARE LPT EQU VAR2+0152H ;(30) 1 BYTE PRE SCREEN LINE, MARKED IF HAS A ;LINE NUMBER ON IT ANYIV EQU VAR2+0170H ;ANY INTERRUPT VECTOR RNSTKE EQU VAR2+0172H ;(2) RENAME STACK PTR (PARPRO) CURCMD EQU VAR2+0174H ;CODE OF CMD BEING EXECUTED LTDFF EQU VAR2+0175H ;LET/DEFAULT FLAG STRM16NM EQU VAR2+0176H ;(11) TLBYTE/NAME OF VAR THAT STREAM 16 WRITES TO. GRARF EQU VAR2+0181H ;GRAPHICS RECORD FLAG (0=OFF) DHADJ EQU VAR2+0182H ;DOUBLE HEIGHT ADJ. 0 UNLESS BOTTOM OF DH CHAR O/PED PAGCOUNT EQU VAR2+0183H ;PAGE COUNTER USED BY FARLDIR MODCOUNT EQU VAR2+0184H ;(2) MOD 16K COUNTER USED BY FARLDIR BCREG EQU VAR2+0186H ;(2) FPC'S BC REG AUTOFLG EQU VAR2+0188H AUTOSTEP EQU VAR2+0189H ;(2) RSTEP EQU AUTOSTEP ;RENUM STEP LSPTR EQU VAR2+018BH ;(2) LINE SCAN PTR LNPTR EQU VAR2+018DH ;(1) MSEDP EQU VAR2+018EH ;(8) 018E-0195 BUTSTAT EQU VAR2+018FH ;MOUSE BUTTON STATUS MXCRD EQU VAR2+0196H ;(2) MOUSE X COORD MYCRD EQU VAR2+0198H ;(2) MOUSE Y COORD ;USED BY PRINTFP: FRACLIM EQU VAR2+019AH ; NPRPOS EQU VAR2+019BH ;(2) DIGITS EQU VAR2+019DH ; MUST EPOWER EQU VAR2+019EH ; ALL DECPNTED EQU VAR2+019FH ; STAY IN THIS ORDER! PRNBUFF EQU VAR2+01A0H ;(16) ALLOWS -0.0000123456789 ; OR -1.2345678E-35 BCDBUFF EQU VAR2+01B0H ;(5) OTHER EQU VAR2+01B5H ;NET DESTINATION STATION NUMBER DCT EQU VAR2+01B6H ;DISC ERROR COUNTER SLDEV EQU VAR2+01B7H ;(2) DEVICE LETTER/NUMBER (TEMP) ;NUMBER=TAPE SPEED/DISC NUMBER/NET STATION OVERF EQU VAR2+01B9H ;'SAVE OVER' FLAG. 0 IF SAVE OVER, ELSE NZ INSLV EQU VAR2+01BAH ;(2) STRLOCN EQU VAR2+01BCH ;(2) USED BY LOOKVARS TVDATA EQU VAR2+01BEH ;(2) DOSER EQU VAR2+01C0H ;(2) JUMP AFTER DOS EXECUTION DOSFLG EQU VAR2+01C2H ;Z IF NO DOS LOADED DOSCNT EQU VAR2+01C3H ;BIT 0 IS SET IF DOS IN CONTROL BSTKEND EQU VAR2+01C4H ;(2) ;NEXT 26 BYTES INITED TOGETHER FROM MAIT BASSTK EQU VAR2+01C6H ;(2) HEAPEND EQU VAR2+01C8H ;(2) HPST EQU VAR2+01CAH ;(2) FPSBOT EQU VAR2+01CCH ;(2) START OF FPCS DKDEF EQU VAR2+01CEH ;(2) KEY DEFS DKLIM EQU VAR2+01D0H ;(2) LIMIT OF DEF KEY BUFFER PATOUT EQU VAR2+01D2H ;(2) ADDR OF 'PRINTABLE CHARS' O/P ERRMSGS EQU VAR2+01D4H ;(2) UMSGS EQU VAR2+01D6H ;(2) KBTAB EQU VAR2+01D8H ;(2) CMDADDRT EQU VAR2+01DAH ;(2) START OF CMD ADDR TABLE IN ROM0 MNOP EQU VAR2+01DCH ;(2) ADDR OF MAIN O/P ROUTINE MNIP EQU VAR2+01DEH ;(2) ADDR OF MAIN I/P ROUTINE PAGER EQU VAR2+01E0H ;(14) RESERVED FOR PAGING S.R. KBUFF EQU VAR2+01EEH ;(18) - 2 TABLES OF 72 BITS LHM1 EQU 5C00H ;USED BY KEYSCAN (AS 'LASTH-1') ;LASTH EQU 5C01H ;LAST KEY HIT. 0 IF NO KEY. STOPS CHANGING IF KEYS ;ARE NOT BEING READ, WHEN BUFFER FILLS. RES 5,(FLAGS) ;IS SEEN AS A READ. KDATA EQU 5C02H LKPB EQU 5C03H ;(2) REPCT EQU 5C05H LASTKV EQU 5C06H ;(2) LASTK EQU 5C08H ;KEY FROM BUFFER QUEUE HEAD. KEEPS LAST KEY VALUE. ;NEEDS PERIODIC RESETS OF BIT 5,(FLAGS) OR BUFFER FILLS. REPDEL EQU 5C09H REPPER EQU 5C0AH ;1 SPARE STREAMS EQU 5C10H ;(42 - USES 5C0C-5C35 FOR STREAMS -5 TO 15. -4=16) CHARS EQU 5C36H ;(2) RASP EQU 5C38H PIP EQU 5C39H ERRNR EQU 5C3AH FLAGS EQU 5C3BH TVFLAG EQU 5C3CH ERRSP EQU 5C3DH ;(2) LISTSP EQU 5C3FH ;(2) NEWPPC EQU 5C42H ;(2) NSPPC EQU 5C44H PPC EQU 5C45H ;(2) SUBPPC EQU 5C47H BORDCR EQU 5C48H ;ATTRIBUTES FOR LOWER SCREEN IN MODES 1/2 EPPC EQU 5C49H ;(2) BORDCOL EQU 5C4BH ;VALUE TO SEND TO BORDER PORT CHANS EQU 5C4FH ;(2) CURCHL EQU 5C51H ;(2) DEFADDP EQU 5C53H DEFADD EQU 5C54H ;(2) NLASTH EQU 5C56H ;(3) ;8 SPARE ZIPLIB EQU 5C61H ;(2) SIMON N. GOODWIN'S ZIPTEMP EQU 5C63H ;(2) COMPILER VARS STKEND EQU 5C65H KPFLG EQU 5C67H ;FUNCTION KEYS IF EVEN, NUMBER PAD IF ODD MEM EQU 5C68H FLAGS2 EQU 5C6AH SDTOP EQU 5C6CH OLDPPC EQU 5C6EH OSPPC EQU 5C70H FLAGX EQU 5C71H STRLEN EQU 5C72H SEED EQU 5C76H FRAMES EQU 5C78H ;(3) UDG EQU 5C7BH ;(2) HUDG EQU 5C7DH ;(2) FRAMES34 EQU 5C7FH ;(2) OLDPOS EQU 5C82H SCRCT EQU 5C8CH KBQB EQU 5C8DH ;(8) KEYBOARD QUEUE ** MOVED HERE KBQP EQU 5C95H ;(2) KEYBOARD QUEUE POINTERS. LOW=END, HI=HEAD ;6 SPARE SCPTR EQU 5C9DH ;(2) ADDR OF CURRENT SCREEN IN SCLIST ;NOT CLEARED BY NEW: FISCRNP EQU 5C9FH ;PAGE OF SCREEN 1 SCLIST EQU 5CA0H ;(16) SCREENS LIST. MODE/PAGE OF SCREENS 1-16, OR FFH LASTPAGE EQU 5CB0H ;LAST PAGE RESERVED BY BASIC RAMTOPP EQU 5CB1H RAMTOP EQU 5CB2H ;(2) PRAMTP EQU 5CB4H ;LAST PAGE PRESENT IN MACHINE ;SPARE KEYWNO EQU 0C4H TSPEED EQU 112 PITOK EQU 3BH PI EQU PITOK-1AH ;SEE BELOW INSTOK EQU 4AH INSTR EQU INSTOK-1AH ;USED TO SEPARATE N/$ IMMED CODES FNTOK EQU 42H ;USED BY TPRINT BINTOK EQU 43H ;USED BY TPRINT AND CALC5BY SCRNTOK EQU 4CH ;USED BY SAVE/LOAD SINTOK EQU 53H ;USED BY TPRINT INTOK EQU 60H ; CODETOK EQU 6CH ;USED BY SAVE/LOAD CHRSTOK EQU 70H ;USED BY COPY MODTOK EQU 7AH ;USED BY TPRINT ANDTOK EQU 80H ;USED BY TPRINT USINGTOK EQU 085H ATTOK EQU 087H TABTOK EQU 088H WHILETOK EQU 08AH UNTILTOK EQU 08BH LINETOK EQU 08CH THENTOK EQU 08DH TOTOK EQU 08EH STEPTOK EQU 08FH ;FORMATTOK EQU 091H ;ERASETOK EQU 092H SAVETOK EQU 094H LOADTOK EQU 095H MERGETOK EQU 096H VERIFYTOK EQU 097H ;RECORDTOK EQU 0EFH BTHK EQU 128 ;DOS BOOT (DOS CAN IGNORE, OR INTERPRET AS ALHK) ;IX=HDR, IX+50H=HDL FOPHK EQU 129 ;DOS OPEN (GET HEADER) LDHK EQU 130 ;DOS LOAD VFYHK EQU 131 ;DOS VERIFY SVHK EQU 132 ;DOS SAVE OSHK EQU 134 ;DOS OPEN STREAM CSHK EQU 135 ;DOS CLOSE STREAM (HDR+1)=LETTER ALHK EQU 136 ;DOS LOAD AUTO-LOAD FILE - FOLLOWS BOOT DIRHK EQU 137 DVHK EQU 139 ;DOS DVAR EOFHK EQU 140 ;DOS EOF PTRHK EQU 141 ;DOS PTR PATHHK EQU 142 ;DOS PATH$ COMM EQU 224 ;DISC PORTS TRCK EQU 225 SECT EQU 226 DTRQ EQU 227 DRES EQU 9 STPIN EQU 59H STPOUT EQU 79H DRSEC EQU 80H ;SAVE/LOAD EQUATES HFG EQU 15 ;DISP TO HEADER FLAG HDT EQU 26 ;DISP TO HEADER DATE/TIME HDN EQU 31 ;DISP TO HEADER NUMBERS HDRL EQU 80 ;HDR BUFFER LEN NMLEN EQU 10 ;MAX FILE NAME LEN YOSDISP EQU 57 YRGDISP EQU 67 XOSDISP EQU 77 XRGDISP EQU 87 RSBUFF EQU 0E003H SBO EQU 8000H SBN EQU 0C000H HPEND EQU 4000H ;HEAPEND ;ROOM FOR DO/LOOP/PROC STACK BSTACK EQU 4AFFH ;BASSTK HDR EQU 4B00H ;HEADER LEN=50H. ALSO USED FOR PARPRO RENAME STK HDL EQU 4B50H ;ADDRESS OF LOADED HEADER BUFFER INTSTK EQU 4C00H ;USES DOWN TO 49EEH NORMALLY BUFF256 EQU 4C00H ;MUST BE PAGE-ALIGNED FPSB EQU 4D00H ;FPSBOT CDBUFF EQU 4D00H ;CODE BUFFER FOR E.G. MULTI-LDI. MAX LEN=0181H ;MULTI RRD, RLD, LDD (ROLL, SCROLL, CLS) ;STACK USED DOWN TO 4E98H ISPVAL EQU 4F00H ;INITIAL SP VALUE INSTBUF EQU 4F00H ;BUFFER FOR ROM1 XFER CODE, ETC. 0200H MSGBUFF EQU INSTBUF+01C0H ;MAX=MGT MSG FILBUFF EQU 5080H ALLOCT EQU 5100H ;MUST START AT PAGE EDGE. 32 BYTES - 1 PER PAGE ;PLUS TERMINATOR MEMVAL EQU 5121H TLBYTE EQU 513FH NMBUFF EQU 5140H FIRLET EQU NMBUFF NMISTK EQU 5188H SCRNBUF EQU 5188H ;8 BYTES USED BY SCREEN$ FOR COMP. FORM CHARSVAL EQU 5190H PALTAB EQU 55D8H LINICOLS EQU 5600H DKBU EQU 5800H KTAB EQU 58E0H PVBUFF EQU 0FEB0H ;IN SECOND SCREEN PAGE. HOLDS PRINT VARS OF NON- ;DISPLAYED SCREEN. BGFLG-SPOSNL AT FEB0-FEEB, ;CEXTAB/EXTAB AT FF7C-FFBB. FEEC-FF7B NOT USED. ;FF7C-FFD7 NOT USED. FILLSTK EQU PVBUFF PALBUF EQU 0FFD8H ;PALETTE OF NON-DISPLAYED SCREEN (ADDRESSED AT ;BFD8H FOR CONVENIENCE) SNDPORT EQU 0FFH KEYPORT EQU 0FEH MDIPORT EQU 0FDH VIDPORT EQU 0FCH URPORT EQU 0FBH LRPORT EQU 0FAH STATPORT EQU 0F9H CLUTPORT EQU 0F8H ;PIADVAL EQU 80H ;mode 1 screen at 8000H ;ATADVAL EQU 98H ;mode 1 attributes INCLUDE EDITOR.SAM ;EDITOR.SAM EDER: CALL KSCHK ;Z IF K/S CHANNEL JP NZ,ERRCHK CALL WARNBZ ;BUZZ AND RE-PRESENT LINE IF K OR S CHANNEL JR EDAG EDCX: XOR A LD (XPTR+1),A LD (ERRNR),A ;NEEDED BY "INPUT LINE" EDITOR: LD HL,(EDITV) LD A,H OR L CALL NZ,HLJUMP LD HL,(ERRSP) PUSH HL CALL POFETCH LD (OLDPOS),DE EDAG: LD HL,EDER PUSH HL LD (ERRSP),SP CALL AULN ;AUTOMATIC LINE NUMBER ENTERED INTO LINE IF WANTED EDLP: LD HL,EDLP PUSH HL CALL EDFK ;GET A KEY, OR ENTER USER-DEFINED KEY TEXT PUSH AF CALL NOISE POP AF CP 16H JR NC,ADCH1 ;ENTER CHARS >=16H CP 7 JR C,ADCH1 ;ENTER CHARS 00-06H CP 10H JR NC,TWOKYS ;JR IF 10H-15H (INK-OVER) ;DEAL WITH EDITING KEYS 07-0FH LD HL,EKPT-7 ;ED KEY PTR TABLE LD C,A LD E,A LD D,0 ADD HL,DE LD E,(HL) ADD HL,DE PUSH HL JP ADDRKC TWOKYS: CALL ADCH1 ;INSERT CONTROL CODE CALL WAITKEY ;GET PARAM IN A JR ADCH1 ;JR TO INSERT PARAM ;CHANNEL "R" - INSERT CHARS AT KCUR, EXPANDING KEYWORDS. USED BY EDKY ADDCHAR: CP 85H JR NC,ADCH07 LD HL,FLAGS ;INSERT 00-85H (INCLUDES CONTROL CODES) CP 20H JR Z,ADCH05 RES 0,(HL) ;"LEADING SPACE NEEDED" CP ":" JR NZ,ADCH1 LD A,(LSTFT) ;TEMP LIST FLG AND A LD A,":" JR Z,ADCH1 ADCH05: SET 0,(HL) ;NO LEADING SPACE NEEDED IF LAST CHAR=SPACE, OR ;LAST CHAR =":" AND PRETTY LISTING ON. JR ADCH1 ADCH07: LD C,A LD A,(INQUFG) RRCA LD A,C JR C,ADCH1 ;INSERT CHARS 85H+ IF TOKENS NOT TO BE EXPANDED RST 30H DW PRGR802-8000H ;PRINT KEYWORD (85-FE) OR FN (FFXX) ;ENTRY HERE ALLOWS ANYTHING TO BE INSERTED ADCH1: LD B,A CALL R1OSR ;ROM1 OFF, URPORT SAVED PUSH BC ;CHAR CALL ADDRKC ;ADDR KCUR LD BC,1 CALL MKRMCH ;MAKE ROOM FOR ONE CHAR. ALLOW ALL SPACE TO BE USED POP AF LD (HL),A INC HL LD (KCUR),HL ;KEEP KCURP UNCHANGED SO SAME BASE AS ELINE OR WS JP POPOUT ;RESTORE PREV LR AND URPORT STATUS ;GET A KEY, AND IF IT IS A DEF KEY, ENTER ASSOCIATED TEXT INTO LINE EDFK: CALL WAITKEY CP 192 RET C ;RET IF NOT IN USER-DEFINED KEY RANGE CP 202 JR NC,EDFK1 ;JR IF NOT A KEYPAD KEY LD C,A LD A,(KPFLG) RRA LD A,C JR NC,EDFK1 ;JR IF NUMBER FLAG NOT SET SUB 144 ;192-201 -> "0"-"9" RET EDFK1: CALL FNDKYD ;LOOK FOR DEFINITION LD A,D ;A=KEY CODE AGAIN RET C ;RET IF NONE PUSH HL ;DEF. START ADD HL,BC DEC HL ;HL=DEF END LD A,(HL) CP ":" JR NZ,EDFK2 DEC BC ;LOP OFF LAST CHAR IF IT IS ":" EDFK2: PUSH AF ;SAVE LAST CHAR PUSH BC ;LEN CALL ADDRKC CALL MAKEROOM ;OPEN ROOM FOR DEF KEY TEXT EX DE,HL ;DE=ROOM POP BC ;LEN POP AF POP HL ;SRC PUSH AF LDIR EX DE,HL LD (KCUR),HL ;CURSOR POSN AFTER DEF KEY TEXT CALL NOISE POP AF POP DE ;RET ADDR JP NZ,EDENT ;ENTER LINE IF LAST CHAR WASN"T ":" RET ;BACK TO EDLP ;ED KEY PTR TABLE EKPT: DB EDKY-EKPT ;7 EDIT DB EDLT-EKPT-1 ;8 LEFT DB EDRT-EKPT-2 ;9 RIGHT DB EDDN-EKPT-3 ;10 DOWN DB EDUP-EKPT-4 ;11 UP DB EDDLL-EKPT-5 ;0C DEL LEFT DB EDENT-EKPT-6 ;0D ENTER DB EDDLR-EKPT-7 ;0E DEL RIGHT DB EDKPX-EKPT-8 ;0F KEY PAD TOGGLE ;"PRINT" LINE TO ELINE EDITING BUFFER EDKY: LD A,(FLAGX) AND 20H JP NZ,CLEARSP ;JP IF INPUT - CLEAR INPUT LINE CALL EVALLINO ;SKIP ELINE NUMBER, GET IN BC. CY IF TOO BIG JR C,EDKY2 RST 18H CP 0DH JR NZ,EDKY2 ;JR IF LINE NEITHER EMPTY NOR JUST LINE NO. ;FROM EDIT (CMD) EDKY1: LD A,B OR C JR Z,EDKY2 LD (EPPC),BC ;E.G. ENTER 123 (EDIT) SETS EPPC TO 123 EDKY2: CALL CLEARSP ;CLEAR ELINE OR INPUT LINE LD HL,(EPPC) CALL FNDLINE CALL LNNM ;GET LINE NUMBER OR ZERO LD A,D OR E RET Z ;DON"T EDIT LINE ZERO LD DE,(CURCHL) PUSH DE LD A,(EPPC+1) PUSH AF PUSH HL ;LSB OF LINE NO LD A,0FFH LD (EPPC+1),A ;ENSURE NO ">" IS PRINTED CALL SETSTRM ;"R" O/P LD HL,LISTFLG LD A,(HL) LD (LSTFT),A ;PUT PRTY LISTING STATUS WHERE CHAN "R" CAN SEE IT. LD (HL),0 ;PRETTY LISTING OFF - COLONS STAY COLONS! EX (SP),HL DEC HL ;PT TO LINE START RST 30H DW OUTLINE POP HL LD A,(LSTFT) LD (HL),A ;PREV LIST FLAG RESTORED. POP AF LD (EPPC+1),A LD HL,(ELINE) LD BC,5 ADD HL,BC LD (KCUR),HL ;CURSOR ADDR IS AFTER 5-DIGIT LINE NUMBER POP HL JP CHANFLAG ;CURSOR LEFT (ALSO CALLED BY DELETE LEFT) EDLT: CALL SETDE ;GET DE=START OF LINE (HL=CURSOR ADDR). NC EDLT2: DEC HL ;KCUR MOVES LEFT SBC HL,DE ADD HL,DE RET C ;RET IF AT LINE START ALREADY (NEW POSN WOULD BE ;FF SAVARS TERMINATOR) JR Z,EDRLC ;JR IF NEW POSN WOULD BE START OF LINE DEC HL ;ELSE LOOK AT PREV. CHAR (*NOT* SAVARS TERM) LD A,(HL) INC HL INC A JR Z,EDLT2 ;MOVE AGAIN IF CURSOR WOULD POINT TO FN CODE AFTER ;FF PREFIX JR EDRLC ;CHANGE KCUR UNLESS ALREADY AT LINE START EDRT: LD A,(HL) INC HL CP 0DH RET Z ;NO MOVE RIGHT IF AT LINE END INC A JR Z,EDRT ;MOVE AGAIN IF HIT FFH FN PREFIX EDRLC: LD (KCUR),HL RET EDDN: ;A=0A EDUP: LD A,C ;KEY 0B/0A LD HL,FLAGX BIT 5,(HL) JR NZ,EDUD2 ;JR IF INPUT MODE CALL ADDRELN LD A,(HL) CP 0DH LD A,C JP Z,FUPDN ;JR IF EDIT MODE, ELINE EMPTY - MOVE ">" CURSOR EDUD2: LD HL,KPOS+1 ;CURSOR LINE CP 0BH JR Z,EDUD25 INC (HL) INC (HL) EDUD25: DEC (HL) ;CURSOR LINE ADJUSTED UP LD DE,CUOP CALL KOPSET ;ALTER CHANNEL K TO SPECIAL O/P LD HL,(WORKSP) DEC HL LD A,(FLAGX) AND 20H JR Z,EDUD3 ;JR WITH HL=END OF ELINE IF EDIT MODE LD HL,(WKEND) ;ELSE GET END OF INPUT LINE EDUD3: DEC HL LD (KCUR),HL ;SET KCUR TO END OF LINE IN CASE NO MATCH OCCURS. CALL NOISE CALL EDPRT ;PRINT LINE, SETTING KCUR TO MATCH WITH KPOS LD DE,(MNOP) ;FBA7 EQU KOPSET: LD HL,(CHANS) JR DETOHL ;TOGGLE KEYPAD BIT (FUNCTION/NUMBER PAD) EDKPX: LD HL,KPFLG INC (HL) RET ;EDITOR DELETE RIGHT (KEY 0E) EDDLR: LD A,(HL) CP 0DH JR NZ,EDDLC RET ;RET IF HIT LINE END ;EDITOR DELETE LEFT EDDLL: CALL EDLT RET C ;RET IF AT START OF LINE EDDLC: LD BC,2 ;2 BYTES TO DELETE LD A,(HL) INC A JR Z,EDDL3 ;IF FN, DELETE FN PREFIX AND CODE ;CARRIAGE RETURN USED BY LOCAL! CARET: DEC C ;ELSE DEL 1 BYTE DEC HL LD A,(HL) ;CHAR BEFORE CHAR TO DEL. (PERHAPS FF SAVARS TERM.) INC HL CP 16H JR NC,EDDL3 ;JR IF >OVER CP 10H JR C,EDDL3 ;JR IF NOT INK-OVER INC HL LD (KCUR),HL ;PT KCUR PAST PARAM, SO IT WILL BE DELED NEXT TIME DEC HL DEC HL ;DELETE CONTROL CODE NOW, NOT PARAM EDDL3: JP RECLAIM2 ;RECLAIM AT (HL) EDENT: POP AF ;JUNK EDLP POP AF ;JUNK WARNBZ ERRCHK: POP HL RESESP: LD (ERRSP),HL LD A,(ERRNR) AND A RET Z ;RET IF NO ERRORS LD SP,HL RET ;ELSE RET TO ERROR HANDLER ;CONTROL CODE PARAM HANDLING ROUTINES RESTOP: LD DE,(OPSTORE) POCHNG: LD HL,(CURCHL) DETOHL: LD (HL),E INC HL LD (HL),D RET PRERESTOP: LD DE,CCRESTOP LD (TVDATA+1),A JR POCHNG ;SPECIAL PRINT O/P ROUTINE TO CHECK IF LS POSN MATCHES DESIRED CURSOR POSN AS ;EACH CHAR IS PRINTED. IF SO, KCUR IS SET TO ADDR OF THE CHAR IN THE LINE. CUOP: RST 30H DW CUOPP-8000H ;JP ROM1 ;WARNING BUZZ - EDITOR ERRORS WARNBZ: LD A,(DEVICE) DEC A JR NZ,ERRCHK ;REPORT ERROR IF NOT LOWER SCREEN DEVICE ;CALLED BY LINE ENTRY ERRORS RSPNS: LD H,7 XOR A LD (ERRNR),A ;"NO ERROR" LD A,(RASP) JR NS2 ;PIP NOISE NOISE: LD HL,250 LD A,(PIP) NS2: LD E,A LD D,0 BEEPER: RST 30H DW BEEPP2-8000H ;RECLAIM ELINE-WORKSP-1 IF EDITING, OR WORKSP-WKEND-1 IF EDITING CLEARSP: CALL SETDE JR Z,CLRSP2 ;JR IF EDIT MODE LD HL,(WKEND) JR CLRSP3 CLRSP2: LD HL,(WORKSP) DEC HL ;PT TO 0D IN ELINE (NOT DELETED) CLRSP3: DEC HL CALL RECLAIM1 ;CLEAR ELINE SETKC: IN A,(URPORT) SETKC2: AND 1FH LD (KCURP),A LD (KCUR),HL RET ;GET DE=START OF ELINE IF IN EDIT MODE (Z), ELSE DE PTS TO INPUT LINE IN WKSPACE SETDE: PUSH HL LD A,(FLAGX) AND 20H JR NZ,SETDE2 CALL ADDRELN CP A SETDE2: PUSH AF CALL NZ,ADDRWK EX DE,HL ;USED BY DEF KEYCODE PPRET: POP AF POP HL RET ;ENTRY: USUALLY, HL PTS TO LINE NUMBER, DE TO LINE NO OF PREVIOUS LINE, AND ;EXITS WITH DE=LINE NUMBER. HOWEVER, IF HL HIT PROG TERMINATOR, PREVIOUS LINE NO ;IS RETURNED, AND IF NO LINES EXIST, DE=0 LNNM: LD A,(HL) INC A JR NZ,LNNM2 ;JR IF NOT PROG TERMINATOR EX DE,HL ;LOOK AT PREV LINE. LD A,(HL) INC A LD D,A LD E,A RET Z ;DE=0 IF NULL PROGRAM LNNM2: LD D,(HL) INC HL LD E,(HL) RET ;USED BY SCROLL/SAVE TO TAPE GTKBK: CALL KBFLUSH ;USED BY GET AND CONTROL KEY ENTRY ROUTINE WKBR: CALL BRKCR ;CHECK BREAK, STOP IF SO CALL KYIP2 JR Z,WKBR RET WAITKEY: LD HL,TVFLAG LD A,(HL) AND 20H JR NZ,WTKY2 ;JR IF THE LOWER SCREEN IS GOING TO BE CLEARED SET 3,(HL) ;"LINE TO BE PRINTED TO LS" ON 1ST CALL OF INPUTAD WTKY2: CALL INPUTAD ;CALL I/P OF CURRENT CHANNEL - OFTEN KYIP BELOW RET C ;RET IF GOT A KEY IN A JR Z,WTKY2 ;JR IF NO KEY, AND NO ERRORS RST 08H DB 22 ;"END OF FILE" ;KEYBOARD INPUT - KYIP ADDR IS IN CHANNELS THAT ALLOW KB INPUT ;EXIT: CY IF GOT KEY IN A. NC,Z IF NO KEY. NC,NZ IF END OF FILE. KYIP: LD A,(TVFLAG) AND 08H CALL NZ,EDPRT ;PRINT LINE TO LS IF REQUIRED ;USED BY GET KYIP2: LD HL,FLAGS AND A ;NC BIT 5,(HL) RET Z ;RET IF NO KEY PRESSED LD A,(LASTK) RES 5,(HL) PUSH AF INC HL BIT 5,(HL) ;TVFLAG CALL NZ,CLSLOWER POP AF CP 16H CCF RET C ;ACCEPT ANYTHING >=16H CP 6 JR Z,KYCL ;JR IF CAPS LOCK CP 10H RET C ;ACCEPT 00-0FH LD (KDATA),A ;SAVE CONTROL CODE 10H-15H (INK-OVER) LD DE,KYPM JR KYCZ ;RETURN WITH CONTROL CODE, AND ALTER I/P SO NEXT ;KEY IS ADJUSTED AND CHECKED FOR RANGE VS CC. KYPM: LD HL,FLAGS LD A,(HL) AND 20H RET Z ;RET (NC, Z) IF NO KEY LD A,(LASTK) RES 5,(HL) ;"NO KEY" SUB 30H JR C,KYPN ;ONLY ACCEPT 30H+ CP 8 JR NC,KYPN ;LIMIT TO 0-7 LD B,A LD A,(KDATA) ;10-15H CP 12H JR C,KYPM6 ;JR IF INK OR PAPER; 0-7 OK CP 15H LD A,B ;PARAM JR Z,KYPM5 ;JR IF OVER CP 2 JR NC,KYPN ;0/1 ONLY FOR FLASH/BRIGHT/INVERSE KYPM5: CP 4 JR NC,KYPN ;0-3 ONLY FOR OVER KYPM6: LD A,B LD DE,(MNIP) ;RESTORE NORMAL I/P KYCZ: SCF LD HL,(CHANS) ;KEY I/P CHANNEL ZAP INC HL INC HL JP DETOHL KYCL: LD HL,FLAGS2 LD A,(HL) XOR 8 ;REVERSE CAPS LOCK LD (HL),A LD HL,TVFLAG SET 3,(HL) ;"COPY LINE TO SCREEN" KYPN: CP A ;NC,Z - NO KEY RET ;PRINT EDIT/INPUT LINE TO LOWER SCREEN EDPRT: RST 30H DW EDPTR2-8000H ;FORCE NORMAL OUTPUT. USED BY E.G CURSOR OUTPUT TO ENSURE NORMAL OUTPUT EVEN ;IF PRINTING BETWEEN CONTROL CODE AND PARAMETER. FONOP: RST 30H DW FONOP2-8000H ;AUTOMATIC LINE NUMBER ENTRY AULN: LD A,(FLAGX) AND 20H RET NZ ;RET IF INPUT MODE LD A,(AUTOFLG) AND A RET Z ;RET IF AUTO OFF CALL ADDRELN LD A,(HL) CP 0DH RET NZ ;RET IF LINE NOT EMPTY LD HL,(EPPC) LD BC,(AUTOSTEP) ADD HL,BC LD A,H CP 0FFH RET Z ;RET IF LINE NUMBER TOO BIG PUSH HL LD A,0FFH CALL SETSTRM ;CHANNEL "R" POP BC RST 30H DW PRNUMB1 STRM0: XOR A JP SETSTRM ;FNDKYD - FIND DEF KEY DATA ;ENTRY: A=KEY CODE (192-255) ;EXIT: HL PTS TO START OF DEFINITION, BC=LEN, D=KEY CODE. CY IF NOT FOUND ;USES AF,BC,D,HL ;DEFINITIONS TERMINATED BY FFH ;ENTRY AT DKTR FINDS POSN OF TERMINATOR,+3 DKTR: LD A,0FFH FNDKYD: LD D,A LD HL,(DKDEF) FDKL: LD A,(HL) ;CODE INC HL LD C,(HL) INC HL LD B,(HL) ;BC=LEN INC HL ADD A,1 RET C ;RET IF NOT FOUND - (TERMINATOR) DEC A CP D RET Z ;RET IF FOUND ADD HL,BC ;PT TO NEXT DEFINITION JR FDKL ;Z IF K OR S CHANNEL. USED BY EDITOR AND INPUT KSCHK: LD A,(CLET) CP "K" RET Z CP "S" RET INCLUDE LIST.SAM ;AUTOLIST, LIST, SPACAN, ;LIST.SAM LIST, CLS AUTOLIST: CALL CLSLOWER LD HL,EPPC CALL REALN ;MAKE SURE EPPC HAS THE NUMBER OF A REAL LINE ;USED BY AUTO AUL2: LD HL,SDTOP CALL REALN ;DITTO FOR SDTOP CALL CLSUP ;"S" LD A,10H LD (TVFLAG),A ;"AUTOLIST, UPPER SCREEN" LD HL,FLAGS2 SET 0,(HL) ;"SCREEN IS NOT CLEAR" LD HL,(SDTOP) LD DE,(EPPC) LD (LAST),DE ;LAST LINE THAT *MUST* BE LISTED IS EPPC AND A SBC HL,DE EX DE,HL ;HL=EPPC JR NC,AUL4 ;JR IF EPPC IS ABOVE OR EQU TO TOP LINE IN ;AN AUTOLIST - ALTER SDTOP CALL FNDLINE ;ELSE ENSURE THAT SDTOP IS NOT TOO FAR ABOVE EPPC IN A,(URPORT) PUSH AF PUSH HL ;HL SHOULD BE ABOUT 0100 HIGHER THAN ADDR FOR SDTOP LD HL,(SDTOP) ;SO THAT IT APPEARS WITHOUT SCROLLING CALL FNDLINE POP DE ;EPPC ADDR DEC C DEC D ;ADDR IS 512 BEFORE EPPC IN LISTING POP AF ;EPPC PAGE AULLP: LD C,URPORT IN B,(C) ;B=SDTOP PAGE CP B JR NZ,AUL25 ;JR IF SDTOP AND EPPC PAGES DON"T MATCH SBC HL,DE ;SBC SDTOP ADDR, EPPC-0200H ADD HL,DE ;HL=SDTOP ADDR AGAIN JR NC,AUL3 ;JR IF DIFF <100H AUL25: INC HL INC HL LD C,(HL) INC HL LD B,(HL) ADD HL,BC PUSH AF CALL CHKHL POP AF INC HL ;NEXT POSSIBLE SDTOP ADDR TO CONSIDER JR AULLP AUL3: LD D,(HL) INC HL LD E,(HL) EX DE,HL ;NEW SDTOP LINE NO. AUL4: LD (SDTOP),HL LD (LISTSP),SP ;SO "SCROLL" CAN ABORT AT END OF SCREEN. CALL LIST5 ;LIST LINES FROM LINE HL, INDENTED AULX: LD HL,TVFLAG ;ALWAYS COME BACK HERE, EVEN IF "SCROLL" ABORTED RES 4,(HL) LD BC,IOPOF JP R1XJP ;ENSURE INDENTED OP IS OFF, TURN ROM1 OFF LLIST: LD C,03H DB 21H ;"JR+2" LIST: LD C,02H XOR A LD (TVFLAG),A ;NON-AUTOLIST (BIT 4=0) CALL RUNFLG LD A,C CALL C,SETSTRM RST 18H CP 91H ;FORMATTOK JR NZ,LIST1 CALL SSYNTAX6 ;SKIP, GET NUMBER LD DE,0300H+30 CALL LIMBYTE LD (LISTFLG),A ;0 IF LIST FORMAT 0 - NO INDENT RET LIST1: CALL PRHSH1 ;POSSIBLE "#" RST 18H CALL COMMASC ;COMMA OR SEMICOLON JR NZ,LIST2 RST 20H ;SKIP ,/; LIST2: CALL BRKLSSL ;CALL BRACKETLESS SLICER SR - POSSIBLE ST TO FIN LD HL,FLAGS ;CY IF ERROR BIT 7,(HL) RET Z ;RET IF NOT RUNNING PUSH AF ;CY SHOWS ERROR !! AND A JR NZ,LIST3 ;JR IF NOT 1-NUMBER SLICER ;ELSE TURN EG LIST 10 INTO LIST 10 TO END (BUT ; DELETE KEEPS DELETE 10 AS IS) DEC A ;A=FF LD (LAST+1),A ;LAST LINE=HIGH NUMBER LIST3: LD HL,(FIRST) ;GET FIRST LINE LD A,H OR L JR Z,LIST4 ;IGNORE OUT OF RANGE CAUSED BY LIST 0 POP AF ;CY SHOWS IF OUT OF RANGE JP C,IOORERR PUSH AF LIST4: POP AF LD (EPPC),HL ;NEW EPPC=FIRST LISTED LINE LIST5: CALL FNDLINE LD BC,LSTLNS JP IOPCL LSTLNS: RST 30H DW LSTR1-8000H ;CANCEL SPACES SPACAN: XOR A LD (NXTSPCS),A LD (NXTHSPCS),A RET MCLS: XOR A JR CLSBL CLS: CP "#" ;28 BYTES FOR CLS # JR NZ,CLSNH RST 30H DW CLSHS-8000H CLSNH: CALL SYNTAX3 CALL GETBYTE ;0 IF CLEAR ENTIRE SCREEN LD E,6 ;BLITZ CODE FOR "CLS" CALL GRAREC LD A,C ;PARAM OR 0 ;BLITZ ENTRY CLSBL: CP 1 JR Z,CLU1 CALL CLU1 CLSLOWER: LD HL,LWBOT LD A,(HL) DEC HL SUB (HL) ;SUB LWTOP DEC A JR Z,CLSL2 ;JR IF LW IS ONLY 2 LINES HIGH ;DEFINE A WINDOW COVERING LW OVERLAP ONTO UPPER ;WINDOW (ABOVE NORMAL 2-LINE SIZE) LD A,(HL) ;LWTOP LD (WINDTOP),A INC HL LD A,(HL) ;LWBOT DEC A DEC HL LD (HL),A ;LWTOP IS 1 LESS THAN LWBOT DEC A LD (WINDBOT),A LD HL,(LWRHS) LD (WINDRHS),HL ;RHS AND LHS LD HL,(M23PAPP) LD (M23PAPT),HL LD A,(ATTRP) LD (ATTRT),A ;ENSURE UW COLOURS CALL CLSWIND ;TEMP OVERLAP WINDOW CLEARED CLSL2: CALL STREAMFD ;"K" LD A,1 LD (TVFLAG),A ;LS, DO NOT CLEAR ON KEYSTROKE, NOT AUTOLIST CALL CLWC ;CLEAR WINDOW AND RESET CHANNEL INC H LD (SPOSNL),HL ;POSN=LHS, TOP+1 RET CLSUP: LD A,1 ;"CLEAR WINDOW, NOT ENTIRE SCREEN" CLU1: PUSH AF DB CALC ;GRAPHICS COORDS 0,0 DB STKZERO DB STKZERO DB EXIT CALL SETESP ;ENSURE NO ERROR ON CLS EVEN IF XOS ETC ODD CALL GTFCOORDS ;GET PHYSICAL COORDS FROM XOS ETC AND 0,0 JR C,CLU2 ;JR IF THINPIX - HL=X, B=Y LD L,C LD H,0 ;HL=X NOW CLU2: LD (XCOORD),HL LD A,B LD (YCOORD),A POP HL LD (ERRSP),HL XOR A LD (XPTR+1),A ;RESET ANY "?" ERROR PTR LD (ERRNR),A ;"OK" INC A LD (SCRCT),A CALL STREAMFE ;"S" POP AF AND A JR NZ,CLS2 CALL CLSE ;CLEAR ENTIRE SCREEN IF CLS OR CLS 0 CALL CLWC2 ;RESET CHANNEL CP A ;Z CLS2: CALL NZ,CLWC ;CLEAR WINDOW, RESET CHANNEL LD (SPOSNU),HL LD HL,FLAGS2 RES 0,(HL) ;"SCREEN IS CLEAR" ;ZERO TABLE ENTRIES LD HL,LPT LD B,30 XOR A ZTEL: LD (HL),A INC HL DJNZ ZTEL DEC A LD (LNPTR),A ;FF SHOWS NO CURSOR LINE RET CLWC: CALL CLSWIND CLWC2: LD DE,(CURCHL) LD HL,MNOP LD BC,4 LDIR ;REFRESH CHANNEL O/P AND I/P ADDRESSES IN CASE ;THEY HAVE BEEN ALTERED E.G. FOR COLOUR I/P LD HL,(WINDLHS) ;GET TOP LEFT OF WINDOW (FOR PRINT POSN) RET ;CLEAR ENTIRE SCREEN - QUICKLY CLSE: LD A,(MODE) CP 2 JR NC,CLS1 LD H,98H ;END OF MODE 0/1 PATTERN DATA LD E,0 ;CLEAR WITH ZEROS LD BC,8002H ;DO 1800H BYTES PUSH AF CALL CLSG ;CLEAR M0/M1 PATTERN DATA POP AF ;MODE LD DE,(ATTRP) LD H,0B8H ;END OF MODE 1 ATTRS LD BC,8002H ;DO 1800H BYTES AND A JR NZ,CLSG ;JR IF MODE 1 LD H,9BH ;END OF MODE 0 ATTRS LD BC,3001H ;DO 0300H BYTES JR CLSG CLS1: LD H,0E0H LD DE,(M23PAPP) LD BC,0006H ;CLEAR DFFF-8000H WITH M3PAPP CLSG: CALL SPSSR ;STORE PAGE, SELECT SCREEN LD D,E DI LD (TEMPW1),SP LD L,0 LD SP,HL CLSLP: PUSH DE PUSH DE PUSH DE PUSH DE PUSH DE PUSH DE PUSH DE PUSH DE ;DO 16 BYTES AT A TIME AT ABOUT 7 Ts/BYTE DJNZ CLSLP DEC C JR NZ,CLSLP ;DO 1000H BYTES LD SP,(TEMPW1) EI JP RCURPR ;RESET CURRENT UR PAGE ;BASIC"S PRINT COMMAND LPRINT: LD C,3 DB 21H PRINT: LD C,2 CALL RUNFLG LD A,C LD HL,INQUFG SET 0,(HL) ;"IN QUOTES" - MEANS KEYWORDS NOT EXPANDED CALL C,SETSTRM CALL TEMPS PRINT2: RST 18H CALL PRTERM JR Z,PRINT3 ;JR IF E.G. PRINT : MPRSEPLP: CALL PRSEPR RET Z ;RET IF TERMINATOR FOUND JR NC,MPRSEPLP ;LOOP UNTIL A NON-SEPARATOR IS FOUND CALL PRITEM CALL PRSEPR RET Z JR NC,MPRSEPLP PRINT3: CP ")" RET Z ;AVOID CR AFTER EMBEDDED PRINT ITEMS IN INPUT ;E.G. INPUT "OLD VALUE:";(X);" NEW:";X ;ENTRY FROM INPUT. CR IF RUNNING RUNCR: LD C,0DH ;PRINT C IF RUNNING PRCIFRN: CALL RUNFLG RET NC LD A,C RST 10H RET ;PRINT SEPARATORS - CONSIDER ;/,/" ;EXIT: Z IF SEPARATOR FOLLOWED BY TERMINATOR, NZ, CY IF NOT SEPARATOR, NZ, NC ;IF SEPARATOR NOT FOLLOWED BY TERMINATOR. PRSEPR: RST 18H CP ";" JR Z,PRSEPR3 LD C,6 CP "," JR Z,PRSEPR2 CP "'" SCF RET NZ LD C,0DH PRSEPR2: CALL PRCIFRN ;PRINT C IF RUNNING - CHR$ 6 FOR COMMA, CR FOR """ PRSEPR3: RST 20H ;SKIP SEPARATOR PRTERM: CP ")" RET Z CP ":" RET Z CP 0DH SCF CCF ;NC WITHOUT ALTERING ZERO FLAG RET PRITEM: RST 18H CP TABTOK JR NZ,PRITEM2 CALL SSYNTAX6 CALL GETINT LD D,C LD A,17H JR ATSR4 PRITEM2: CP ATTOK JR NZ,PRITEM4 CALL SSYNTAX8 CALL GETBYTE PUSH AF ;COL CALL GETBYTE ;C=ROW LD D,C POP AF LD E,A ;D=ROW, E=COL DB 0FEH ;"JR+1" ;PRINT AT LINE A, COL E ATSR2: LD D,A ATSR3: LD A,16H ;"AT" CONTROL CODE ATSR4: RST 10H LD A,D RST 10H LD A,E RST 10H RET PRITEM4: CALL CITEMSR RET NC CP "#" JP Z,PRHSH2 CALL EXPTEXPR RET NC ;RET IF NOT RUNNING IN A,(URPORT) PUSH AF JR NZ,PRITEM5 ;JR IF NUMERIC EXPR. CALL GETSTRING ;UNSTACK STRING, SEL PAGE CP A ;Z PRITEM5: CALL NZ,JPFSTRS ;GET STR$ OF NUMBER AS BC BYTES AT (DE) CALL PRINTSTR POP AF OUT (URPORT),A RET ;LPT = LINE PTR TABLE ;TABLE OF 30 BYTES, EACH 0 IF NO LINE NUMBER ON THAT LINE, OR FF IF THERE IS. ;LNPTR VAR. HOLDS NO OF LINE WITH CURSOR, OR >3FH IF NONE FUPDN: PUSH AF ;DIRECTION CODE - 0BH=UP, 09H=DOWN CALL STREAMFE ;"S" CHANNEL POP BC CALL FUPDN2 JP STRM0 FUPDN2: LD A,(LNPTR) CP 40H JP NC,AUTOLIST ;JP IF THERE IS NO CURSOR ON-SCREEN LD A,B CP 0BH ;UP JR NZ,LPD ;JR IF DOWN ;CURSOR UP LD HL,(EPPC) PUSH HL CALL FNDLINE LD H,D LD L,E ;HL AND DE PT TO LINE *BEFORE* EPPC. DE USED LATER LD B,(HL) INC HL LD C,(HL) ;BC=PREV LINE NO LD (EPPC),BC POP HL ;OLD EPPC AND A SBC HL,BC RET Z ;RET IF AT TOP OF PROG - EPPC UNCHANGED PUSH DE RST 30H DW EROC2 ;GET A/C=LNPTR, H=TABLE MSB, ERASE OLD CURSOR POP DE LPUL: AND A JR Z,MWDN ;JR IF AT WINDOW TOP ALREADY - MOVE WINDOW DOWN DEC A ADD A,>LPT ;ADD OFFSET LD L,A ;HL=ADDR IN TABLE (MUST BE INSIDE A PAGE) SUB A,>LPT LD B,(HL) INC B DJNZ LPC ;JR IF FOUND A LINE WITH A LINE NUMBER JR LPUL ;ELSE LOOP MWDN: PUSH DE ;START OF NEW EPPC ;GET SCREEN LINES TAKEN BY PROGRAM LINE STARTING AT DE (LEN OF NEW EPPC) INC A ;A=1 LD (DMPFG),A ;"DUMP OUTPUT" LD HL,(SPOSNU) PUSH HL LD HL,(WINDLHS) ;L=LHS LD A,41H SUB C ;LINES FROM TOP OF PREV CURSOR POSN LD H,A LD (SPOSNU),HL ;START AT HI LN, PAST ANY WINDBOT, NO SCROLLING EX DE,HL ;PT HL TO FIRST CHAR CALL IOUTLNC ;DUMMY PRINT OF LINE TO GET LENGTH XOR A LD (DMPFG),A LD HL,WINDTOP LD A,(WINDBOT) SUB (HL) INC A LD H,A LD A,(SPOSNU+1) ;END LINE POSN SUB 40H ;A=LINES TAKEN BY PROGRAM LINE CP H ;CP WINDOW HEIGHT JR C,MWDN2 ;JR IF LINE LPT ;ADD OFFSET LD L,A ;HL=ADDR IN TABLE (MUST BE INSIDE A PAGE) SUB A,>LPT LD B,(HL) ;B=0 IF NO LINE NO, OR FF INC B DEC B JR Z,LPDL ;LOOP IF NO LINE NO. ON LINE POP HL ;JUNK OLD EPPC LPC: LD C,A LD A,(WINDTOP) ADD A,C LD (LNPTR),A ;NEW LINE WITH CURSOR LD A,C LD E,5 CALL ATSR2 RST 30H DW PRLCU-8000H MWUP: CALL ADVSTOP ;MOVE TOP OF SCREEN PROG LINE DOWN BY ONE XOR A LD (OVERT),A ;OVER 0 SO OVERPRINTING LOOKS OK LD E,A ;LH COLUMN LD HL,SCRCT LD (HL),E ;PREVENT SCROLL PROMPT LD HL,WINDTOP LD A,(LNPTR) SUB (HL) CALL ATSR2 POP HL ;OLD EPPC CALL FNDLINE LD A,(OLDSPCS) LD (NXTSPCS),A ;** RESET SPACES TO SAME FOR 2ND PRINT CALL IOUTLN ;OLD EPPC MAY OVERLAP SCREEN BOTTOM - SO PRINT IT LD A,0DH ;AGAIN, PERHAPS FORCING SCROLLING. RST 10H ;CR JR IOUTLN ;PRINT NEW EPPC - IT WILL HAVE A ">" CURSOR ;ENSURE SYS VAR PTED TO BY HL CONTAINS A LINE NUMBER THAT EXISTS. (IF IT DOES ;NOT, REPLACE IT WITH NO. OF FOLLOWING "REAL" LINE) REALN: LD A,(HL) INC HL PUSH HL LD H,(HL) LD L,A ;HL=LINE NO JR ADVAC ;ADVANCE LINE NUMBER IN SYS. VAR TO NEXT LINE IF POSSIBLE ;EXIT: DE=NEW LINE NUMBER, HL IS UNCHANGED ADVSTOP: LD HL,SDTOP ;SCREEN DISPLAY TOP PROGRAM LINE JR ADVAN ADVEPPC: LD HL,EPPC ADVAN: LD A,(HL) INC HL PUSH HL LD H,(HL) LD L,A ;HL=LINE NO FROM SYS VAR. INC HL ADVAC: CALL FNDLINE ;FIND ADDR OF NEXT LINE, OR PROG END CALL LNNM ;GET LINE NO. IN DE (OR PREV LINE NO. IF PROG END) POP HL LD (HL),D DEC HL LD (HL),E RET ;TABSR, CLS, PRINT ;FUPDN, IOUTLN, PRLCU, ZTENTS, LNLEN, ;ATSR, REALN, ADVAN INCLUDE ROLL.SAM ;CALCPIX, NEXTUP, NXTDOWN, CLSWIND, EDRS, CRTBF ;****************************************************************************** ;ROLL.SAM - EG ROLL DIR,PIX,X,Y,W,L ; ROLL DIR,PIX ; ROLL DIR ; SCROLL IS SIMILAR BUT NO WRAP-ROUND ; SCROLL CLEAR - SCROLL PROMPT OFF ; SCROLL RESTORE - SCROLL PROMPT ON ;FROM JUMP TABLE: ;B=PIX, C=DIR (1-4), HL=TOP LHS COORDS, D=LEN, E=W, A=ROLL/SCROLL JROLL: DEC E LD (TEMPB3),A ;ROLL=FF, SCROLL=00 PUSH DE PUSH HL LD A,B PUSH AF JR JROLL2 ROLL: LD A,0FFH JR RSCOMM SCROLL: CP 0B3H ;CLEARTOK JR Z,SETPROMPT ;JR IF PROMPT TO BE TURNED OFF SUB 0BAH ;RESTORETOK - ZERO RESULT FOR "PROMPT ON" JR NZ,SCRNINOT SETPROMPT: LD B,A CALL SABORTER ;SKIP CLEAR/RESTORE LD A,B LD (SPROMPT),A ;0=PROMPTS ON RET SCRNINOT: XOR A RSCOMM: LD (TEMPB3),A ;ROLL=FF, SCROLL=00 CALL EXPT1NUM ;DIRECTION CP "," JR Z,ROLL4 ;GET PIX IF SPECIFIED CALL CHKEND ;ELSE CHECK END AND USE DEFAULT LD A,1 ;OF 1-PIXEL ROLL JR ROLL5 ROLL4: CALL SEXPT1NUM ; PIXELS CP "," JR Z,ROLL6 ;GET AREA IF SPECIFIED CALL CHKEND CALL GETBYTE ;PIXELS ROLL5: LD HL,0C0FFH ;LEN=192, W-1=255 ARE DEFAULTS PUSH HL LD HL,0000H ;Y=0, X=0 (TOP LHS) ARE DEFAULTS PUSH HL JR ROLL7 ROLL6: CALL SEXPT4NUMS ;SKIP X,Y,W,L - SR SHARED WITH GRAB CALL CHKEND CALL GETBYTE ;L AND A JR Z,IOORHP2 ;LENGTH MUST BE 1-255 INITIALLY PUSH AF ;LENGTH CALL GETINT ;WIDTH. LEGAL=2-256 RES 0,C ;EVEN WIDTHS ONLY DEC BC ;1-255 LD A,B AND A JR NZ,IOORHP2 POP AF ;L LD B,A ;L,W-1 IN B,C PUSH BC CALL GTFIDFCDS ;B=Y, C=X (FAT COORDS FORCED) RES 0,C ;EVEN X ONLY (OR FOR THINPIX, MULTIPLES OF 4 ONLY) PUSH BC CALL GETBYTE ;A=PIX ROLL7: PUSH AF CALL GETBYTE ;DIRECTION TO C JROLL2: PUSH BC CALL CHKMD23 CALL GRATEMPS ;SET TEMPS FROM PERM LS OR US VARS - USE FOR SCROLL CALL SPSSR ;STORE PAGE, SELECT SCREEN POP BC ;C=DIRECTION POP AF ;PIX POP HL ;COORDS POP DE ;L, W-1 AND A JR Z,IOORHP2 LD B,A ;PIX LD A,C ;DIR. 1234=L/U/R/D DEC A CP 4 JR C,ROLL75 ;ORIG DIR MUST BE 1-4 IOORHP2: RST 08H DB 30 ROLL75: LD A,H ;TOP=0, BOT=191 ADD A,D JR C,IOORHP2 CP 193 JR NC,IOORHP2 ;ERROR IF AREA FALLS OFF BOTTOM BIT 2,C JR Z,NTRDOWN LD H,A DEC H ;H=Y IF ROLL DOWN NTRDOWN: LD A,L ADD A,E ;ADD X,W-1 JR C,IOORHP2 ;JR IF OFF SCREEN ON RHS LD A,D EXX LD B,A ;B"=LENGTH (1-192) EXX SCF RR H RR L ;HL=SCR ADDR (LHS, TOP IF LT, RT OR UP; BOT IF DN) LD A,E ADD A,1 ;WIDTH=2-256. CY IF 256 RRA ;GET WIDTH IN BYTES (1-128) LD E,A ;E=WIDTH IN BYTES LD D,B ;D=PIX BIT 0,C ;01=L,10=U,11=R,100=D JP Z,RUPDN ;JP IF UP OR DOWN DEC E ;E=W-1, IN BYTES (0-127) DJNZ RLBYTE ;JR IF MOVING MORE THAN 1 PIX - USE BYTES LD D,C ;LEFT OR RIGHT BY 1 PIXEL (1 NIBBLE IN MODE 3) ;C/D=DIR, E=WIDTH-1 IN BYTES, HL=SCREEN ADDR, B"=LENGTH, A=WIDTH RST 30H DW CRBBFN DEC D ;DEC DIR JR NZ,NTNRL ;JR IF ROLL RIGHT LD A,L ADD A,E LD L,A ;HL=RHS IF ROLL LEFT BY 1 PIX LD A,E NEG LD E,A ;E=NEGATED WIDTH-1 IF ROLL LEFT. ALLOWS PT TO LHS NTNRL: LD A,(TEMPB3) ;ROLL=FF, SCROLL=00 LD D,A LD C,128 ;SCAN LEN EXX NLRLP: EXX LD B,L LD A,L ADD A,E LD L,A ;PT TO OTHER END OF LINE. CY IF E -VE (ROLL LEFT) LD A,(M23PAPT) INC D DEC D JR Z,ROLL8 ;JR IF SCROLL - A=BG COLOUR LD A,(HL) ;GET NIBBLE TO WRAP ROUND JR NC,ROLL8 ;JR IF ROLL RIGHT RRCA ;ELSE GET NIBBLE TO OTHER SIDE OF A RRCA RRCA RRCA ROLL8: LD L,B ;HL PTS TO ORIG LINE END AGAIN PUSH HL CALL CDBUFF POP HL LD B,0 ADD HL,BC EXX DJNZ NLRLP ;DO B" SCANS JR RCURPH ;RESET UR PORT ;RIGHT OR LEFT BY BYTES RLBYTE: INC B ;B=PIX (2+) LD A,B RRA ;BYTES OF MOVEMENT (1+). CALL IT M LD D,A LD A,E ;WIDTH-1 IN BYTES (0-127) SUB D ;BYTES OF MOVEMENT (M) JP C,IOORHP2 ;JR IF M ISN"T LESS THAN WIDTH INC A RST 30H DW CRTBF SCF ;CY=LEFT DEC C ;Z IF LEFT, NZ IF RIGHT JR Z,RLBY2 LD A,L ADD A,E LD L,A ;HL PTS TO RHS IF RIGHT AND BYTE MOVING. NC RLBY2: INC C LD B,0 LD A,(TEMPB3) CP 1 ;C IF SCROLL, NC IF ROLL DEC C ;Z IF LEFT, NZ IF RIGHT LD A,D ;A=M EXX JR C,SCROLLLR JR NZ,RRBMLP ;ROLL LEFT BYTES RLBMLP: EXX LD C,A ;BC=M PUSH HL PUSH HL ;SCRN PTR LD DE,RSBUFF LDIR ;SAVE M BYTES FROM LINE START, ADVANCE SRC POP DE ;ORIG HL CALL CDBUFF ;COPY THE SCAN LD HL,RSBUFF INC B ;B=0 LD C,A ;BC=M LDIR ;WRAP BYTES FROM BUFFER POP HL ;LINE START LD C,128 ADD HL,BC ;DROP 1 SCAN EXX DJNZ RLBMLP RCURPH: JP RCURPR ;ROLL RIGHT BYTES RRBMLP: EXX LD C,A ;BC=M PUSH HL PUSH HL ;SCRN PTR LD DE,RSBUFF+127 LDDR ;SAVE M BYTES FROM LINE END, MOVE SRC PTR LEFT POP DE ;ORIG HL CALL CDBUFF ;MOVE THE SCAN LD HL,RSBUFF+127 INC B LD C,A ;BC=M LDDR ;WRAP BYTES FROM BUFFER POP HL ;LINE START LD C,128 ADD HL,BC ;DROP 1 SCAN EXX DJNZ RRBMLP JR RCURPH SCROLLLR: JR NZ,SRBYPRE ;JR IF SCROLL RIGHT ;SCROLL LEFT BYTES SLBMLP: EXX LD C,A ;BC=M PUSH HL ;SCRN PTR LD D,H LD E,L ADD HL,BC CALL CDBUFF ;MOVE SCAN LEFT LD B,A LD C,A LD A,(M23PAPT) SLBBLP: LD (DE),A ;BLANK END OF SCAN INC DE DJNZ SLBBLP LD A,C POP HL LD C,128 ADD HL,BC ;DROP 1 SCAN EXX DJNZ SLBMLP RCURH2: JR RCURPH ;SCROLL RIGHT BYTES. SRBYPRE: AND A ;NC FOR FIRST SBC SRBMLP: EXX LD C,A ;BC=M PUSH HL ;SCRN PTR LD D,H LD E,L SBC HL,BC ;DE PTS TO RHS. MOVE HL SLIGHTLY (M) BYTES LEFT CALL CDBUFF ;MOVE SCAN RIGHT LD B,A ;B=M LD C,A ;SAVE M BRIEFLY LD A,(M23PAPT) SRBBLP: LD (DE),A ;BLANK LHS (M BYTES) DEC DE DJNZ SRBBLP LD A,C ;A=M POP HL LD C,128 ADD HL,BC ;DROP 1 SCAN. NC EXX DJNZ SRBMLP JR RCURH2 ;******************************************************************************* ;RUPDN - ROLL/SCROLL UP OR DOWN ;ENTRY: E=WIDTH IN BYTES, HL=TOP LHS SCRN ADDR (UP) OR BOT LHS (DOWN) ;B"=LENGTH, D=PIX OF DISP, C=DIR (1-4) RUPDN: BIT 2,C ;010=UP, 100=DOWN LD BC,128 ;BC = DISP TO ROW BELOW IF ROLL UP JR Z,RUPDN2 DEC B ;BC=FF80=-128 IF ROLL DOWN ;THIS ENTRY FROM EDRS WITH BC SET UP RUPDN2: LD A,E RST 30H DW CRTBFI ;CREATE BUFFER OF A LDI"S LD A,E EX AF,AF' LD A,D ;PIX EXX LD C,A ;C"=PIX LD A,B ;GET LENGTH FROM B" LD B,C ;B"=PIX EXX SUB D ;SUB LEN,PIX JP C,IOORHP2 ;ERROR IF MOVEMENT IS GREATER THAN WIN LEN PUSH AF ;SAVE MAIN BLOCK SCANS, Z IF MOVE=WIND LEN LD A,(TEMPB3) AND A CALL NZ,RSSTBLK ;STORE WRAPPED AREA IF ROLL POP AF ;LINES IN MAIN BLOCK JR Z,RUPFIN ;JR IF MOVEMENT=LENGTH OF WINDOW (CLS) EXX LD B,A ;B"=LINES IN MAIN BLOCK (AREA NOT WRAPPED) EXX LD A,D ;PIX LD D,H LD E,L ;DE IS SCREEN DEST ADDDISP: ADD HL,BC DEC A ;DEC PIX TO MOVE BY JR NZ,ADDDISP ;MOVE HL UP OR DOWN TO START OF MAIN BLOCK CALL RSMOVSR EX DE,HL RUPFIN: EX DE,HL ;DE=SCRN DEST LD A,(TEMPB3) AND A JR Z,SCRUDBLK ;JR IF SCROLL AND BLANKING OF NEW AREA NEEDED ;ELSE WRAP DATA FROM BUFFER LD HL,RSBUFF EXX LD B,C ;B"=PIX ;DE PTS TO BLOCK, BC=SGNED SCAN LEN, B"=SCANS TO DO SCRUDWRAP: EXX PUSH DE ;SCRN DEST PUSH BC ;DISP TO NEXT SCAN CALL CDBUFF ;COPY A SCAN POP BC POP DE EX DE,HL ADD HL,BC ;MOVE SCRN PTR UP OR DOWN A SCAN EX DE,HL EXX DJNZ SCRUDWRAP ;COPY "PIX" SCANS JR RCUHP ;DE PTS TO BLOCK, BC=SGNED SCAN LEN, C"=SCANS TO DO, M23PAPT=VALUE SCRUDBLK: EX DE,HL ;HL PTS TO BLOCK TO CLEAR LD A,(M23PAPT) EXX LD B,C ;B"=PIX SCRUBOLP: EXX LD D,H LD E,L INC E LD (HL),A PUSH BC PUSH HL CALL CDBUFF+2 POP HL POP BC ADD HL,BC ;MOVE UP OR DOWN A SCAN EXX DJNZ SCRUBOLP ;BLANK "PIX" SCANS AT TOP OR BOTTOM RCUHP: JP RCURPR ;******************************************************************************* ;RSSTBLK - STORE BLOCK. ALSO USED BY GRAB ;ENTRY: HL=SCRN ADDR (TOP OR BOT), BC=SGNED SCAN LEN, D=PIX, B"=PIX,A"=WIDTH ;EXIT: SAME EXCEPT B"=0. TEMPW2=SPACE RSSTBLK: PUSH DE PUSH HL EX AF,AF' ;WIDTH LD E,A LD HL,0 LD A,D ;A=PIX LD D,H ;DE=WIDTH CALCSPLP: ADD HL,DE DEC A JR NZ,CALCSPLP ;CALC WIDTH*PIX=STRIP MEM USE LD (TEMPW2),HL ;SAVE SPACE REQUIRED FOR DATA (FOR GRAB) LD DE,RSBUFF+16 ;E013H ADD HL,DE JR NC,STSTPOK RST 08H DB 36 ;"Stored area too big" ;ERROR IF STRIP USES MORE THAN (8K-19 BYTES) ;(16 BYTES FOR PUT STACK, 3 FOR CC,W,L) STSTPOK: POP HL PUSH HL LD DE,RSBUFF EXX STSTPLP: EXX PUSH BC ;SCAN LEN PUSH HL ;SCRN SRC CALL CDBUFF POP HL POP BC ADD HL,BC ;PT TO SCAN ABOVE OR BELOW (BC IS SIGNED SCAN LEN) EXX DJNZ STSTPLP EXX POP HL ;SCRN ADDR POP DE ;D=PIX RET ;****************************************************************************** ;CLS AND EDITOR SCROLL ROUTINES. ;CLEAR WINDOW - VARS DEFINE CHAR WINDOW CLSWIND: LD HL,WINDBOT LD A,(HL) DEC HL SUB (HL) ;SUB WINDTOP INC A ;GET ROWS OF WINDOW LEN LD C,2 ;"UP" CALL EDRSSR ;GET B"=LEN, D=DISP (SAME) LD A,(DEVICE) AND A LD A,D JR NZ,CLSW1 ;JR IF NOT UPPER SCREEN LD A,(LSOFF) ADD A,D ;INCLUDE "LEFT OVER" SCANS LD D,A CLSW1: EXX LD B,A EXX JR EDRSF ;SCROLL WINDOW DOWN BY "A" ROWS EDRSADN: LD D,0 ;SCROLL LPT DOWN PUSH AF RST 30H DW STENTS ;SCROLL LINE PTR TABLE POP AF LD C,4 ;DOWN JR EDRS ;SCROLL WINDOW UP BY 1 ROW EDRS1UP: LD A,1 ;LPT SCROLL BY 1 ROW LD D,A ;SCROLL LPT UP AS D=1 RST 30H DW STENTS LD A,1 ;WINDOW SCROLL BY 1 ROW EDRSAUP: LD C,2 ;UPWARDS ;EDRS - EDITOR"S ROLL/SCROLL ROUTINE ;ENTRY: WINDOW VARS DEFINE CHAR WINDOW, A=ROWS TO SCROLL, C=2 IF UP, 4 IF DN. EDRS: CALL EDRSSR EDRSF: CALL SPSSR ;STORE PAGE, SELECT SCREEN LD A,(MODE) CP 2 JP NC,RUPDN BIT 2,C LD BC,32 LD IX,NEXTDOWN ;IN CASE MODE 0 JR Z,EDRSM1 ;JR IF UP LD BC,-32 LD IX,NEXTUP ;IN CASE MODE 0 EDRSM1: LD A,(MODE) AND A JR Z,EDRSM0 ;JR IF MODE 0 XOR A LD (M23PAPT),A ;MAKE "PAPER COLOUR" BLANK PIXEL PATTERN PUSH BC ;SIGNED SCAN LEN PUSH DE ;D=PIX,E=WIDTH PUSH HL ;SCREEN ADDR EXX PUSH BC ;LEN IN SCANS EXX CALL RUPDN2 EXX POP BC EXX POP HL SET 5,H ;ADD 2000H - PT TO MODE 1 ATTR POP DE POP BC LD A,(ATTRT) LD (M23PAPT),A ;SET COLOUR FOR M1 ATTRIBUTE SCROLL CALL SPSSR JP RUPDN2 ;MODE 0 SCROLL ;D=PIX TO MOVE BY, E=WIDTH, HL=SCRN ADDR, BC=SGNED ATTR ROW LEN, B"=WIND LEN EDRSM0: LD A,E RST 30H DW CRTBFI PUSH BC ;+/-32 EXX LD A,B ;GET PIX OF WINDOW LEN EXX SUB D ;SUB WINDOW LEN, PIX TO MOVE BY="MAIN BLOCK" LEN JP C,IOORHP2 ;ERROR IF MOVED BY MORE THAN WIND LEN EXX LD B,A ;MAIN BLOCK LEN IN B" EXX LD A,D ;PIX. Z IF WIND LEN=MOVEMENT (CLS) PUSH AF LD C,E ;C=WIDTH LD B,D ;B=PIX LD D,H LD E,L ;DE=SCRN DEST JR Z,EDRSM0L1 EDRSM0P: CALL IXJUMP ;MOVE UP OR DOWN A SCAN DJNZ EDRSM0P ;PT HL TO SRC ;B=0 SO BC=WIDTH EDRSM0L1: POP AF ;PIX. Z/NZ PUSH AF ;PIX PUSH DE PUSH HL ;SAVE FOR ATTR SCROLL PUSH AF ;PIX, Z/NZ EXX JR Z,EDRSM0L2 EDRSM0LP: EXX PUSH HL PUSH DE PUSH BC CALL CDBUFF POP BC POP HL CALL IXJUMP ;ADJ DEST PTR EX DE,HL POP HL CALL IXJUMP ;ADJ SRC PTR EXX DJNZ EDRSM0LP ;LOOP FOR ALL SCANS EDRSM0L2: LD B,D ;B"=ROWS FOR ATTR SCROLL EXX EX DE,HL ;HL=SCRN DEST POP DE ;D=PIX TO MOVE BY (AND BLANK) LD E,00H EDRSM0DL: PUSH HL ;SCAN START LD B,C ;USE B AS WIDTH COUNTER EDRSM0BL: LD (HL),E INC L DJNZ EDRSM0BL POP HL CALL IXJUMP DEC D JR NZ,EDRSM0DL POP HL CALL CTAA ;CONVERT SRC TO ATTR ADDR EX DE,HL ;SRC IN DE POP HL CALL CTAA ;CONVERT DEST EX DE,HL POP AF ;Z/NZ POP BC ;+/-32 CALL NZ,RSMOVSR LD A,(ATTRT) LD (M23PAPT),A ;SET COLOUR FOR M1 ATTRIBUTE SCROLL ;DE PTS TO BLOCK, BC=SGNED SCAN LEN, C"=SCANS TO DO, A"=WIDTH, M23PAPT=VALUE JP SCRUDBLK ;CONVERT HL TO ATTR ADDR CTAA: LD A,H RRCA RRCA RRCA AND 3 OR 98H LD H,A RET ;SCROLL M0 ATTRS / MAIN R/S UP/DOWN ROUTINE RSMOVSR: EXX UPDNLP: EXX PUSH HL ;SCRN SRC PTR PUSH DE ;DEST PUSH BC ;DISP TO ROW ABOVE OR BELOW CALL CDBUFF POP BC ;DISP POP HL ;DEST ADD HL,BC ;ADJUST BY SCAN LEN EX DE,HL POP HL ADD HL,BC ;SRC IS AJUSTED BY SIGNED SCAN LEN EXX DJNZ UPDNLP ;DO B" SCANS EXX RET ;EDRSSR ;ACTION: GET E=WIDTH IN BYTES, HL=TOP LHS SCRN ADDR (UP) OR BOT LHS (DOWN) ;B"=LENGTH, D=PIX OF DISP, KEEP C EDRSSR: EXX LD C,A ;C"=ROWS TO MOVE BY EXX CALL CALCPIX PUSH AF ;SAVE AMOUNT TO MOVE BY, IN SCANS (PIX) XOR A LD (TEMPB3),A ;"SCROLL" LD DE,(WINDLHS) ;DE=TOP/LHS ROW BIT 1,C JR NZ,EDRS1 ;JR IF SCROLL UP LD A,(WINDBOT) ;ELSE GET BOTTOM INC A LD D,A CALL ANYDEADDR ;GET ADDR 1 SCAN (SIC) LOWER THAN NEEDED - NOW LD A,(MODE) ;BACK UP BY 1 LD HL,0FF80H ;MINUS SCAN LEN FOR M2 OR M3 CP 2 JR NC,EDRS0 ;JR IF M2 OR M3 LD L,0E0H ;MINUS SCAN LEN FOR M1=FFE0 DEC A JR Z,EDRS0 EX DE,HL CALL NEXTUP ;IF MODE 0 DB 0FEH ;"JR+1" EDRS0: ADD HL,DE EX DE,HL ;DE=DESIRED SCREEN ADDR CP A ;SET Z ;ENTRY AT EDRS1 IS NZ EDRS1: CALL NZ,ANYDEADDR ;USES DE/A ONLY. GETS DE=SCRN ADDR LD HL,WINDBOT LD A,(HL) DEC HL SUB (HL) ;SUB WINDTOP INC A ;GET ROWS OF WINDOW LEN EXX SUB C LD D,A ;ROWS TO DO (IN CASE M0 ATTR SCROLL) ADD A,C ;WINDOW LEN IN ROWS CALL CALCPIX LD B,A ;B"=SCANS OF WINDOW LEN EXX DEC HL DEC HL LD A,(HL) ;WINDRHS INC HL SUB (HL) ;SUB WINDLHS INC A ;WIDTH IN CHARS. EX DE,HL ;HL=SCREEN ADDR POP DE ;D=AMOUNT TO MOVE BY IN SCANS LD E,A ;MODE 0 OR 1 USES 1 BYTE/CHAR LD A,(MODE) CP 2 RET C CP 3 JR Z,EDRS3 LD A,(FL6OR8) AND A LD A,E JR NZ,EDRS2 ;JR IF 8 PIXEL, 2 BYTE CHARS INC E SRL E EDRS2: ADD A,E ;A=WIDTH*1.5, ROUNDED UP, WIDTH*2 LD E,A RET EDRS3: LD A,E ;MODE 3 USES 4 BYTES/CHAR ADD A,A ADD A,A LD E,A RET CALCPIXD: LD A,D ;CALCULATE NO. OF PIXELS IN "A" ROWS. RESULT IN A. ADD 8 IF BOTTOM HALF OF ;DOUBLE-HEIGHT CHARACTER CALCPIX: PUSH BC LD C,A ;C=ROWS LD A,(CSIZE) SUB 5 LD B,A ;B=HEIGHT-5 (AT LEAST 1) LD A,C ADD A,A ADD A,A ADD A,C ;A=ROWS*5 CLPXL: ADD A,C DJNZ CLPXL ;A=ROWS*6 IF B=1, ROWS*7 IF B=2 ETC LD C,A LD A,(DHADJ) ;8 IF BOTTOM HALF OF DOUBLE-HEIGHT CHAR BEING ;PRINTED, ELSE 0 ADD A,C POP BC RET ;MODE 0 MOVE HL UP BY 1 SCAN NEXTUP: DEC H LD A,H OR 0F8H INC A RET NZ LD A,L SUB 32 LD L,A RET C LD A,H SUB 0F8H LD H,A RET ;GET ADDR OF POSN 1 SCAN BELOW (HL) IN HL, MODES 0/1. USES AF,HL ONLY ;SCREEN$ SR NXTDOWN: LD A,(MODE) AND A JR Z,NEXTDOWN LD A,20H ADD A,L LD L,A RET NC INC H RET ;USED BY ROLL/SCROLL NEXTDOWN: INC H LD A,H AND 07H RET NZ ;NC=NO CRSSING OF CHAR BORDER NXTDOWN1: LD A,L ADD A,32 LD L,A RET C ;RET IF NEW THIRD LD A,H ADD A,0F8H ;SET CY LD H,A RET INCLUDE NMNLP.SAM ;MAIN LOOP ;MAINLP.SAM - SAM MAIN LOOP ;MAIN PARSER - CHECK LINE FOR SYNTAX LINESCAN: LD HL,FLAGS RES 7,(HL) ;SIGNAL SYNTAX CHECK XOR A LD H,A LD L,A LD (IFTYPE),HL ;LONG IF, "REF TYPE" (FN FLAG) NO LD (SUBPPC),A ;FIRST STATEMENT LD (ERRNR),A ;"OK" ERROR CALL EVALLINO ;SKIP ANY LINE NO. JR NC,STMTLP1 ;JR IF LINE NO. IN RANGE NONSENSE: RST 08H DB 29 ;ENTRY POINT FROM LOOP, RETURN ETC, TO ELINE. C=STAT TO GOTO LOOPEL: LD A,C LOOPEL2: LD (NSPPC),A ;ENTRY POINT FOR RUNNING OR CHECKING THE E-LINE LINERUN: XOR A LD (CLA+1),A ;ELINE SHOWN BY ODD CURRENT LINE ADDR - ALLOWS ;EG RETURN TO RECOGNIZE RET ADDR AS ELINE LD HL,0FFFFH ;FFFF - PRINT LINE NO. WILL GIVE 0 LD (PPC),HL CALL AELP ;ADDRESS ELINE, SET PAGES EX DE,HL LD HL,(WORKSP) DEC HL ;DE PTS TO ELINE START, HL TO ELINE END LD A,(NSPPC) JP NEXTLINE ;FINDER ;CALLED BY DO AND DEF PROC WITH D=INTERVENING, E=TARGET, BYTE AFTER CALL=ERROR ;IN CASE NOT FOUND. NO RETURN EVER MADE. SEARCH STARTS FROM CHAD. SEARCH: CALL SEARCHALL JP NC,0008H ;JP IF NOT FND - USE BYTE AFTER CALL AS ERR CODE ;ELSE CLA AND CHAD HAVE BEEN SET, A=STAT WHERE ;TARGET FOUND (LOOP OR END PROC) ;ENTRY WITH A=STAT, CHAD SET, CLA=LINE START OR 00?? IF ELINE. ;CHAD IS PAST END PROC, LOOP, LELSE, SELSE, END IF, NEXT (VAR SKIPPED). ;LOOP MIGHT HAVE "WHILE" OR "UNTIL" TO SKIP. ;CONTINUE EXECUTION AT CHAD. EXCHAD2 USED BY FOR, LIF POP DE ;JUNK RET ADDR LD (SUBPPC),A EXCHAD2: IN A,(URPORT) CALL STPGS ;SET CHADP, NXTLNP, CLAPG ** LD HL,(CLA) INC H DEC H JR Z,STMHOP ;JR IF ELINE - PPC AND NXTLINE CORRECT LD D,(HL) INC HL LD E,(HL) ;GET LINE NO. INC HL LD (PPC),DE ;AND SET SYS VAR LD E,(HL) INC HL LD D,(HL) ;LINE LEN INC HL ADD HL,DE LD (NXTLINE),HL ;PTR TO NEXT LINE SET STMHOP: RST 18H CP WHILETOK JR C,STMTLP2 CP UNTILTOK+1 CALL C,SKIPCSTAT ;IF WHILE/UNTIL, SKIP STATEMENT JR STMTLP2 ;THIS PART IS ALSO MAIN RUN-TIME CONTROL STMTLP: INC HL STMTLP05: LD (CHAD),HL ;FROM ELSE STMTLP1: CALL SETWORK LD HL,SUBPPC INC (HL) ;INC STATEMENT NO. ;FROM ELSE (SYNTAX CHECK) STMTLP2: LD HL,(CHAD) STMTLP25: LD A,(HL) CP 21H JR NC,STMTLP3 ;JR IF 21-FF CP 0DH JP Z,LINEEND INC HL ;SKIP 0-20 EXCEPT CR. LD (CHAD),HL JR STMTLP25 STMTLP3: CP ":" JR Z,STMTLP LD DE,NEXTSTAT ;CMDS RETURN TO NEXT STAT AFTER EXECUTION ON4ENT: PUSH DE LD (CSA),HL ;CURRENT STATEMENT ADDR LD HL,(CMDV) INC H DEC H CALL NZ,HLJUMP ;ALLOWS ADDING OF EXTRA CMDS LD (CURCMD),A ;USED BY SAVE/LOAD ETC SUB 90H JP C,PROCS CP 0F7H-90H JR NC,NONSX ADD A,A ;GET WORD DISPLACEMENT LD C,A LD B,0 LD HL,(CMDADDRT) ADD HL,BC ;PT TO WORD IN TABLE OF ROUTINE START ADDRS LD C,LRPORT IN B,(C) SET 6,B OUT (C),B ;ROM1 ON LD E,(HL) INC HL LD D,(HL) RST 20H ;SKIP TO CHAR PAST CMD BIT 7,D JR NZ,R1CMD ;JR IF CMD IN ROM1 RES 6,B OUT (C),B ;ROM1 OFF R1CMD: EX DE,HL JP (HL) ;EXECUTE CMD. CMDS CALL ABORTER FOR EARLY RETURN ;IN SYNTAX TIME. NEXTSTAT: CALL BRKSTOP NOBREAK: CALL R1OCHP ;ROM1 OFF, SELCHADP LD A,(NSPPC) INC A JR Z,STMTNEXT ;JR IF NSPPC=FF - NO JUMP TO NEW LINE/STAT LD HL,(NEWPPC) ;LINE NUMBER TO JUMP TO INC H JP Z,LINERUN ;JR IF LINE FFXX - E LINE DEC H CALL FNDLNHL ;HL=LINE START PUSH AF IN A,(URPORT) CALL STPGS POP AF LD A,(NSPPC) JR Z,LINEUSE ;JR IF LINE FOUND (FLAG FROM FNDLNHL) AND A JP NZ,STATLOST ;INSIST RETURN AND SUCH ACTUALLY GOTO DESIRED ;STATEMENT - ONLY GOTO/GOSUB AVOID THIS LD C,(HL) ;GET LINE NO. MSB OR STOPPER INC C JR NZ,LINEUSE ;JR IF NOT AT PROGRAM END OKERR: RST 08H DB 0 ;"OK" STMTNEXT: RST 18H STMTNEXT1: CP ":" STMTLPH: JP Z,STMTLP CP THENTOK ;NEEDED BY 'IF' JR Z,STMTLPH CP 0DH JR Z,LINEEND NONSX: RST 08H DB 29 ;NONSENSE REMARK: POP AF ;JUNK NEXTSTAT ;IGNORE REST OF LINE LINEEND: CALL ABORTER ;RET IF SYNTAX CHECK JR LNEND2 ;USED BY 'ON' IN RUNTIME OLNEND: CALL R1OCHP ;ROM1 OFF, SELCHADP LNEND2: LD HL,(NXTLINE) ;GET ADDRESS OF FOLLOWING LINE - FOLLOW ON LD A,(HL) INC A JR Z,OKERR ;JR IF AT PROGRAM END. (FF=STOPPER) XOR A ;STAT 0/1. LATER, 0 RATHER THAN 1 SHOWS ;WE ARE DEALING WITH A GOTO (OF A NON-EXISTENT ;LINE) BUT THAT"S IRREL. HERE. LINEUSE: CP 1 ADC A,0 ;0 BECOMES 1, REST SAME BIT 6,H JR Z,NONEWCLAPG PUSH AF CALL INCURPAGE ;JPED TO WITH A=PAGE, (SP)=STAT, HL=LINE START RLEPI: CALL STPGS ;SET CLAPG, CHADP, NXTLINEP POP AF NONEWCLAPG: LD (CLA),HL ;CUR. LINE ADDR RECORDED FOR GOSUB RETURNS ETC. LD D,(HL) INC HL LD E,(HL) INC HL LD (PPC),DE ;UPDATE PPC LD E,(HL) INC HL LD D,(HL) EX DE,HL ;DE PTS TO LINE LEN MSB. INC HL ;HL=TEXT LEN+1 ADD HL,DE ;HL PTS TO FIRST CHAR OF NEXT LINE INC DE ;DE PTS TO FIRST CHAR IN LINE NEXTLINE: LD (NXTLINE),HL EX DE,HL ;HL PTS TO FIRST CHAR IN LINE LD D,A ;STAT NO. LD A,0FFH LD (NSPPC),A ;SIGNAL NO JUMP ADD A,D ;A=STAT NO.-1 LD (SUBPPC),A JP Z,STMTLP05 ;JP IF WE WANT FIRST STAT. - LD (CHAD),HL CALL SKIPSTATS ;SKIP D STATS, END WITH CHAD PTING TO :/CR/THEN JP Z,STMTNEXT1 STATLOST: RST 08H DB 31 ;"Statement doesn't exist" BRKCR: CALL BRKTST RET NZ BRCERR: RST 08H DB 14 ;"BREAK - CONTINUE to repeat" ;CHECK BREAK, STOP IF IT IS PRESSED BRKSTOP: CALL BRKTST RET NZ ;RET IF ESC NOT PRESSED RST 08H DB 15 ;"BREAK into program" ;Z IF BREAK PRESSED AND BREAKDI=0 BRKTST: LD A,0F7H IN A,(STATPORT) AND 20H RET NZ ;RET IF ESC NOT PRESSED LD A,(BREAKDI) ;NZ IN BREAKDI DISABLES BREAK AND A RET ;******************************************************************************* ;USED BY AUTO AULL: CALL AUL2 ;AUTO-LIST, AVOIDING EPPC->CLOSEST JR MAINX ;MAIN LOOP, AFTER AUTO-LIST CALL ;MAIN CONTROLLING LOOP FOR ENTIRE INTERPRETER! ENTRY AT MAINEXEC MAINEADD: CALL INSERTLN LD A,(ERRNR) AND A JP NZ,MAINER ;JR IF NO ROOM FOR LINE MAINEXEC: CALL AUTOLIST MAINX: CALL SETMIN MAINELP: CALL STRM0 CALL EDITOR CALL TOKMAIN ;TOKENIZE LINE CALL LINESCAN ;CHECK FOR CORRECT SYNTAX/INSERT 5-BYTE FORMS LD A,(SUBPPC) RLA JR NC,MAINE1 ;JR IF 127 OR LESS STATEMENTS LD A,33 ;ELSE "No room for line" LD (ERRNR),A MAINE1: LD A,(ERRNR) AND A JR Z,MAINE2 ;JR IF "ERROR"=0 (OK) LD A,(DEVICE) DEC A JR NZ,MAINER ;JR UNLESS DEVICE 1 (LOWER SCRN) IN USE - REPORT CALL ADDRELN CALL REMOVEFP CALL RSPNS ;RASP NOISE, CANCEL ERRNR JR MAINELP MAINE2: CALL EVALLINO ;GET LINE NUMBER IN BC, ELSE BC=0, Z SET JP C,NONSENSE ;ERROR IF TOO BIG JR NZ,MAINEADD ;INSERT LINE IF THERE IS A LINE NO RST 18H CP 0DH JR Z,MAINEXEC ;JR IF LINE IS JUST LD A,(FLAGS2) RRA CALL C,CLSUP CALL CLSLOWER LD A,(UWTOP) LD B,A LD A,(SPOSNU+1) SUB B INC A ;LINES USED IN US LD (SCRCT),A LD HL,FLAGS SET 7,(HL) ;"RUNNING" DEC HL XOR A LD (HL),A ;ERROR NR=0 INC A LD (NSPPC),A ;START WITH A JUMP TO STATEMENT 1 CALL COMPILE ;IF FLAG SAYS SO, CREATE LABELS, COMPILE DEF FNS ;AND DEF PROC ADDRESSES. CALL LINERUN MAINER: CALL R1OCHP EI LD HL,SUBPPC LD A,(HL) AND A JR NZ,MAINER1 LD A,(ONSTORE) ;FETCH REAL SUBPPC IF "ON" FIDDLED WITH SYS VAR LD (HL),A MAINER1: LD HL,0 LD (DEFADD),HL LD (XPTR),HL LD A,H INC HL LD (STREAMS+6),HL ;STREAM ZERO POINTS TO CHANNEL K LD (FLAGX),A LD (AUTOFLG),A ;AUTO OFF CALL SETDISP ;DISPLAY 0 CALL SETMIN LD A,(ERRNR) AND 0EFH JR Z,MAINER3 ;NO "ON ERROR" IF "OK" OR 'STOP' (0/10H) CALL KBFLUSH ;FLUSH KEYBOARD BUFFER ** LD HL,FLAGS SET 7,(HL) ;SET RUNNING IN CASE "VAL" TURNED IT OFF LD HL,ONERRFLG BIT 7,(HL) RES 7,(HL) ;BIT 7=TEMP FLAG (OFF). BIT 0=PERM FLAG UNCHANGED JR Z,MAINER3 ;JR IF TEMP FLAG *WAS* OFF CALL ERRHAND2 ;SKIP PRINTING PART OF ERRHAND LD HL,MAINER PUSH HL ;ERR HANDLER ADDR RST 30H DW SETUPVARS ;CREATE LINO, STAT, ERROR LD A,(ERRNR) CP 15 ;"BREAK into program" JR NZ,MAINER2 CALL CONTINUE2 ;CONTINUE GETS THE CORRECT VALUES IF BREAK ;INTERRUPTED A JUMP LD (PPC),HL ;PPC LDED WITH OLDPPC DEC D LD A,D LD (SUBPPC),A ;SAME STATEMENT FOR RETURN, NOT NEXT ONE MAINER2: LD HL,(ERRLN) CALL FNDLNHL JR NZ,STATLH INC HL INC HL INC HL INC HL LD A,(ERRSTAT) LD D,A CALL SKIPSTATS RST 20H ;PT TO "ON ERROR" CP 0DDH ;ONERRORTOK STATLH: JP NZ,STATLOST RST 20H ;SKIP IT. PT TO E.G. "GOTO 10"/"GOSUB 50"/HANDLER ;CLA/NXTLINE/PPC ETC MATCH LINE WITH ERROR STILL JP STMTLP25 MAINER3: CALL CLSLOWER ;SETS CHANNEL K ALSO LD HL,TVFLAG SET 5,(HL) ;"CLEAR LOWER SCREEN ON KEYSTROKE" DEC HL ;PT TO FLAGS RES 7,(HL) ;"NOT RUNNING" SO FNDLN DOESN"T USE CLA DURING ;EDITING LD A,(ERRNR) CALL ERRHAND1 ;PRINT REPORT, ETC. JP MAINELP ERRHAND1: CP 50H JR NZ,EHZ ;MGT MESSAGE GIVEN IF "REPORT" 50H XOR A CALL UTMSG ;" MILES GORDON TECHNOLOGY plc" ;" C 1989 SAM Coup" LD HL,BGFLG LD A,82H ; e WITH AN ACCENT LD (HL),A ;NZ=FOREIGN ON RST 10H LD (HL),0 LD A," " RST 10H LD A,(PRAMTP) INC A ;16 OR 32 LD L,A LD H,0 ADD HL,HL ;32 OR 64 ADD HL,HL ;64 OR 128 ADD HL,HL ;128 OR 256 ADD HL,HL ;256 OR 512 LD B,H LD C,L RST 30H DW PRNUMB1 LD A,"K" RST 10H WTFK: CALL READKEY JR Z,WTFK ;WAIT FOR A KEYPRESS CALL CLSLOWER LD A,0FFH LD (LINICOLS),A ;TURN OFF RAINBOW SCREEN JP ERRHAND2 EHZ: JR C,EH0 ;JR IF NOT DOS ERR CODE SUB 51H ;RANGE NOW 0+ LD C,A LD A,(DOSFLG) CALL SELURPG ;DOS AT 8000H LD HL,(8210H) ;DOS ERR MSGS LD A,C DB 0DDH ;"JR+3" EH0: LD HL,(ERRMSGS) EH15: EX DE,HL RST 30H DW POMSR ;PRINT MESSAGE TO BUFFER (AND GET BC=LEN) LD A,(WINDRHS) SUB C ;A=SPACE APART FROM MESSAGE, -1 CP 13 ;ALLOW FOR 3, PLUS E.G. ", 12345:11" PUSH AF JR NC,EH1 ;JR IF OK TO PRINT ERROR MSG ON 1 LINE LD A,(LWTOP) LD (SPOSNL+1),A ;PRINT ON TOP LINE EH1: PUSH BC LD A,(ERRNR) PUSH AF RST 30H DW PRAREG ;PRINT ERROR NUMBER AS 1 OR 2 DIGITS LD A," " RST 10H POP AF SUB 2 JR NZ,EH2 ;JR IF NOT "MISSING VARIABLE" ;ELSE PRINT ITS NAME BEFORE " not found" LD B,A LD HL,TLBYTE LD A,(HL) AND 1FH LD C,A ;BC=LEN OF STR/ARRAY NAME, LEN-1 OF SIMPLE NUM BIT 5,(HL) ;NZ IF NUMERIC ARRAY INC HL ;PT TO FIRST LETTER LD D,H LD E,L ADD HL,BC ;PT PAST END OF NAME (STR/ARRAY) OR TO END IF NUM INC BC ;TRUE LEN OF SIMPLE NUM VAR NAMES, OR EXTRA ROOM ;FOR "$" OR "(" JR NZ,PMV1 ;JR IF NUMERIC ARRAY LD A,(FLAGS) BIT 6,A JR NZ,PMV2 ;JR IF A (SIMPLE) NUMERIC VAR LD (HL),"$" JR PMV2 PMV1: LD (HL),"(" INC HL LD (HL),")" INC C ;ALLOW FOR ")" IN LEN PMV2: CALL PRINTSTR ;PRINT VAR NAME EH2: POP BC LD DE,MSGBUFF CALL PRINTSTR ;PRINT ERROR MESSAGE POP AF LD A,0DH JR C,EH3 ;JR IF USING 2 LINES LD A,"," RST 10H LD A," " EH3: RST 10H LD BC,(PPC) RST 30H DW PRNUMB1 ;PRINT LINE NUMBER LD A,":" RST 10H LD A,(SUBPPC) RST 30H DW PRAREG ERRHAND2: CALL CLEARSP LD A,(ERRNR) AND A RET Z ;NO CONTINUE AFTER "O.K." - RET SUB 16 ;RESULT OF 0 IF "STOP statement", FF IF "BREAK ;into program", AND CY LD B,0 ADC A,B JR NZ,ERRHAND3 ;NO INC OF SUBPPC IF NEITHER STOP OR BREAK LD A,(CURCMD) CP 193 ;NEXT JR Z,ERRHAND3 ;B=0 NOW - CONTINUE AFTER BREAK INTO 'NEXT' ;REPEATS STATMENT INC B ERRHAND3: LD HL,NSPPC LD A,(HL) LD (HL),0FFH ;CANCEL ANY JUMP LD HL,(NEWPPC) BIT 7,A JR Z,ERRHAND4 ;JR IF JUMP WAS ABOUT TO HAPPEN LD A,(SUBPPC) ADD A,B ;INCR. SUBPPC BY 1 IF STOP OR BREAK LD HL,(PPC) ERRHAND4: INC H RET Z ;RET IF CONT WOULD HAVE BEEN TO E-LINE DEC H LD (OLDPPC),HL LD (OSPPC),A ;COPY NSPPC/NEW PPC OR SUBPPC/PPC TO OSPPC/OLDPPC RET DFKNL: EX (SP),HL ;JUNK NEXT STAT RETURN, STACK PTR TO REST OF LINE CALL STMTNEXT ;CHECK SYNTAX FOR REST OF LINE POP HL ;REMOVE FLOATING POINT FROM REST OF LINE, RET TO ;MAIN LOOP ;REMOVE INVISIBLE 5-BYTE FORMS FROM (HL) TO 0DH REMOVEFP: LD C,6 LD A,(HL) SUB 0EH LD B,A CALL Z,RECLAIM2 LD A,(HL) INC HL CP 0DH JR NZ,REMOVEFP RET ;GET LINE NO AT START OF ELINE TO BC, SET Z IF LN=0. CY IF TOO BIG. EVALLINO: CALL AELP ;ADDR ELINE, SET CHADP ETC LD (CHAD),HL RST 30H DW SMBW RST 18H CALL INTTOFP CALL FPTOBC RET C ;RET IF >64K LD A,B ADD A,1 RET C ;RET IF >65279 LD A,B OR C RET ;Z IF BC=0 AELP: CALL ADDRELN STPGS: AND 1FH LD (CLAPG),A LD (CHADP),A LD (NXTLINEP),A RET ;******************************************************************************* ;INSERT LINE - INSERT LINE BC FROM ELINE INTO PROGRAM INSERTLN: PUSH BC ;LINE NUMBER ; LD HL,(INSLV) ; INC H ; DEC H ; CALL NZ,HLJUMP CALL SCOMP ;DEF PROCS/DEF FNS AND LABELS NEED DOING - ;ANY PRE-PASS OF LABELS ETC IS OBSOLETE. LD HL,(WORKSP) LD BC,(CHAD) ;BC PTS AFTER LINE NUMBER LD A,(BC) CP " " JR NZ,INSLN3 INC BC LD A,(BC) CP 0DH JR NZ,INSLN2 ;JR, LEAVING BC INCED, TO INC CHAD AND DELETE ;FIRST SPACE IN A LINE LIKE: 10 test. PREVENTS ;SPACES ACCUMULATING WITH MULTI-EDIT/ENTERS. DEC BC ;AVOID ANY ACTION IF E.G. 10 (space) CR INSLN2: LD (CHAD),BC INSLN3: SCF SBC HL,BC ;HL=LEN OF TEXT, INCLUDING 0DH LD A,H CP 3FH JP NC,OOMERR ;LIMIT LINE LEN TO 3EFFH EX (SP),HL ;STACK LEN, GET HL=LINE NO LD (EPPC),HL CALL FNORECL ;FIND/RECLAIM LINE POP BC ;TEXT LEN LD A,C DEC A OR B RET Z ;RET IF TEXT IS JUST 0DH (LENGTH OF 1) PUSH BC ;TEXT LEN INC BC INC BC INC BC INC BC ;GET LEN INCLUDING LN AND LEN BYTES ; PUSH BC ; PUSH HL ; CALL GAPSZ ; LD (4020H),HL ;!! ; POP HL ; POP BC CALL MAKEROOM ;BC BYTES AT (HL) LD BC,(EPPC) LD (HL),B INC HL LD (HL),C ;ENTER LINE NUMBER INC HL POP BC ;TEXT LEN LD (HL),C INC HL LD (HL),B CALL SPLITBC INC HL EX DE,HL IN A,(URPORT) LD C,A ;CDE=POINTS TO ROOM FOR TEXT CALL ADDRCHAD ;TEXT START IN AHL JP FARLDIR ;SKIPCSTAT - SKIP CURRENT STATEMENT E.G. DATA, LABEL, DEF FN, LOOP UNTIL ETC. ;ENTRY: CHAD=POSN SKIPCSTAT: RST 18H LD DE,0100H ;1 STAT, NOT IN QUOTES JR SKIPS15 ;SKIPSTATS - FIND D"TH STATMENT FROM POSN. ;ENTRY: D=STATMENTS TO SKIP,+1. HL=POSN ;EXIT: CHAD PTS TO BEFORE REQUIRED STAT - TO ":" OR "THEN" OR CR. ;Z,NC IF OK, Z, CY IF HIT END OF LINE AS STAT COUNTER REACHED ZERO, NZ, CY IF ;HIT END OF LINE BEFORE STAT COUNT REACHED ZERO SKIPSTATS: DEC HL ;COMP FOR INITIAL INC SO WE DON"T MISS SHORT STATS ;FROM "ON" SKIPS0: XOR A ;"NOT IN QUOTES", NC LD E,A JR SKIPS5 SKIPS1: INC HL SKIPS15: LD A,(HL) CP 0EH CALL Z,NUMBER CP 22H JR NZ,SKIPS2 DEC E ;"INSIDE STRING" SKIPS2: CP ":" JR Z,SKIPS4 CP THENTOK JR Z,SKIPS4 CP 0DH JR NZ,SKIPS1 DEC D ;Z IF LINE END=DESIRED STAT. SCF ;"HIT LINE END" JR SKIPS6 SKIPS4: BIT 0,E JR NZ,SKIPS1 ;IF ":"/"THEN"INSIDE STRING, JR, GET NEXT CHAR SKIPS5: DEC D ;DEC "STATS TO SKIP" COUNTER JR NZ,SKIPS1 SKIPS6: LD (CHAD),HL ;PT CHAD TO JUST BEFORE DESIRED STATMENT RET DATA: CALL RUNFLG JR C,SKIPCSTAT ;SKIP STAT IF RUNNING DATA1: CALL SCANSR CP "," RET NZ ;RET IF END OF STAT RST 20H JR DATA1 INCLUDE MISC1.SAM ;PRHSH, STRMINFO, SETSTRM, CHANFLAG, ;MISC1.SAM ;MODE, TEMPS, DATA, RESTORE ;CITEM, PERMS, SETSTRM ;CALLED BY LIST PRHSH1: CP "#" RET NZ ;ENTRY FROM PRINT PRHSH2: CALL SSYNTAX6 ;NUMBER CALL GETBYTE CALL STRMINF2 JR STSM2 ;ENTRY: FPCS HOLDS STREAM NUMBER. EXIT: DE=STREAM PTR, HL PTS TO STRM-H, C=STRM STRMINFO: CALL GETBYTE ;IN A AND C STRMINF2: CP 11H JR NC,INVSTRM ;STREAMS 0-16 ARE LEGAL ;FROM SETSTRM STRMINF3: CP 10H JR NZ,STRMINF4 LD A,0FCH ;TRANSFORM STREAM 16 TO -4 (OUTPUT TO STRING) LD C,A STRMINF4: ADD A,0BH ;(07, 0B-1A IF FROM ABOVE, OR 06-0E IF FROM SETSTRM ADD A,A ;0EH, 16-34H OR 0CH-1CH LD L,A LD H,5CH ;5C0C-5C34H LD E,(HL) INC HL LD D,(HL) LD A,D OR E ;Z IF CLOSED RET INVSTRM: RST 08H DB 21 ;"Invalid stream number" SNOTOPER: RST 08H DB 47 ;"Stream is not open" STREAMFE: LD A,0FEH DB 21H STREAMFD: LD A,0FDH ;ENTRY: A=FCH-03H SETSTRM: LD (STRNO),A ;KEEP FOR DOS CALL STRMINF3 STSM2: JR Z,SNOTOPER ;JR IF STREAM NOT OPEN LD HL,(CHANS) ADD HL,DE ;PT TO 2ND BYTE OF CHANNEL DEC HL CHANFLAG: LD (CURCHL),HL INC HL INC HL INC HL INC HL LD A,(HL) ;CHANNEL LETTER LD (CLET),A ;KEEP IT FOR INPUT TO LOOK AT LD C,2 CP "P" JR Z,STSMD DEC C CP "K" JR Z,STSMD DEC C CP "S" RET NZ ;ONLY SET "DEVICE" OR CALL TEMPS FOR K/S/P STSMD: LD A,C LD (DEVICE),A ;P=2,K=1,S=0 ;COPY PERMANENT GRAPHIC VARS TO TEMP VARS. ;TEMPS FOR PRINT (COLOUR EXPANSION TABLE IF NEEDED) ;HAVE TO COLOUR TABLE *AFTER* EACH PRINTED INK/PAPER/BRIGHT ALSO - CALL COLEX TEMPS: CALL GTEMPS LD HL,(UWRHS) LD DE,(UWTOP) ;UPPER WINDOW DATA LD A,(DEVICE) DEC A JR NZ,TEMUS ;JR IF NOT LOWER SCREEN LD HL,(LWRHS) LD DE,(LWTOP) TEMUS: LD (WINDRHS),HL LD (WINDTOP),DE COLEX: LD A,(MODE) SUB 2 RET C ;RET IF M0/M1 LD B,32 ;COLOUR 32 BYTES IF M3 JR NZ,COLEX1 ;JR IF MODE 3 LD B,16 ;MODE 2 O/P NEEDS 16-BYTE COLEX TABLE COLEX1: LD DE,(M23PAPT) ;D=M3INKT, E=M3PAPT LD HL,EXTAB ;EXPANSION TABLE EXX LD HL,CEXTAB ;COLOURED EXPANSION TABLE EXX LD A,D XOR E LD C,A ;C=PAPER XOR INK COLEXLP: LD A,C AND (HL) ;USE EXPANDED NIBBLES AS MASKS TO CHOOSE INK/PAP INC L XOR E EXX LD (HL),A INC L EXX DJNZ COLEXLP RET ;GRAPHIC TEMPS LEAVES EXPANSION TABLE ALONE (FOR SPEED) AND SETS "UPPER SCRN" GRATEMPS: XOR A LD (DEVICE),A GTEMPS: LD HL,THFATP LD DE,THFATT LD BC,9 LDIR LD A,(DEVICE) AND A JR Z,TEMPS1 ;JR IF UPPER SCREEN, ELSE USE LOWER SCRN COLOURS LD H,B LD L,B LD (OVERT),HL ;OVER 0, INVERSE 0 LD A,(BORDCR) LD L,A LD (ATTRT),HL ;MASKT WILL BE ZERO LD HL,(M23LSC) ;MODES 2/3 LOWER SCREEN COLOURS LD (M23PAPT),HL ;LD PAPER AND INK TEMPS1: LD A,(MODE) CP 2 RET Z LD A,1 LD (THFATT),A ;NZ=FAT UNLESS MODE 2, THEN=COPY OF THFATP RET ;POKE, DPOKE, CALL, USR, PEEK & DPEEK ALLOW ADDRESSES OF 00000-1FFFF, RELATIVE ;TO THE CONTEXT BASE PAGE. 0000-3FFF WILL BE ROM0, 4000-7FFF WILL BE BASE PAGE, ;8000-BFFF WILL BE THE PAGE ABOVE THE BASE PAGE. 10000-13FFF WILL SWITCH PAGE ;3 ABOVE BASE PAGE INTO 8000H (IRRELEVANT EXCEPT TO NON-RELOCATABLE CALLED OR ;USRED CODE) POKE: CALL EXPT1NUM ;EVAL ADDR CALL INSISCOMA CALL EXPTEXPR JR NZ,POKE2 ;JR IF NUMERIC, ELSE DO POKE N,A$ RET NC ;RET IF SYNTAX TIME CALL STKFETCH ;ADE=SRC, BC=LEN PUSH AF PUSH DE CALL SPLITBC CALL UNSTLEN LD C,A DEC C EX DE,HL SET 7,D ;CDE=DEST ADDR POP HL POP AF ;AHL=SRC ADDR JP FARLDIR POKE2: JR NC,POKE3 DB CALC ;ADDR,N DB SWOP ;N,ADDR DB STOD0 ;N DB EXIT POKE3: LD DE,0 ;EXTRA NUMBERS COUNT RST 18H JR POKE4 POKENL: PUSH DE ;EXPR COUNT CALL SEXPT1NUM POP DE INC E BIT 5,E JP NZ,NONSENSE ;LIMIT EXTRAS TO 31 POKE4: CP "," JR Z,POKENL CALL CHKEND PUSH DE DB CALC DB RCL0 ;N1,N2,N3...Nn,ADDR DB EXIT CALL NPDPS ;GET ADJUSTED ADDR TO HL, FORMER PAGE TO A POP DE ;DE=0 IF ONLY 1 NUMBER ADD HL,DE INC E PKALP: PUSH HL ;DEST ADDR FOR TOP NUMBER ON FPCS PUSH DE ;E=NUMBER OF NUMBERS ON FPCS CALL FPTOA JP C,IOORERR JR Z,POKE5 ;JR IF +VE NEG POKE5: POP DE POP HL LD (HL),A DEC HL DEC E JR NZ,PKALP RET DPOKE: CALL SYNTAX8 ;EVAL ADDR, NUMBER CALL GETINT ;WORD TO POKE TO BC CALL NPDPS LD (HL),C INC HL LD (HL),B RET ;PDPSUBR - USED BY POKE, DPOKE, PEEK, DPEEK, CALL ;ENTRY: ADDR ON FPCS. ;EXIT: IF ADDR IS 0-64K, THEN PAGING=ROM0 (OR BASE-1), BASE PAGE, BASE+1, BASE+2 ;IF ADDR>64K, IT IS REDUCED TO 8000-BFFF RANGE AND PAGED IN. E.G. 10000H WOULD ;SWITCH PAGES BASE+3/BASE+4 IN AT 8000-FFFF, HL WOULD BE 8000H ;HL=ADDR, A=ORIG URPAGE. (LRPAGE UNCHANGED) PDPSUBR: PUSH BC ;PRESERVE BC THROUGHOUT IN A,(251) PUSH AF CALL UNSTLEN SET 7,H ;AHL=ADDR IN PAGE, 8000-BFFF FORM DB 11H ;"JR+2" ;PDPSR2. USED BY LOAD CODE (EXEC) ;ENTRY: AHL=EXEC ADDR PDPSR2: PUSH BC PUSH AF ;KEEP STACK HAPPY PDPC: CP 4 JR NC,PDPSUBR4 ;JR IF NOT 0000-FFFF LD C,2 ;PAGING WILL BE ROM0,BASE,BASE+1,BASE+2 CP C JR Z,PDPSUBR3 ;ADDR IS OK IF PAGE IS 2 JR NC,PDPSUBR2 ;JR IF PAGE 3 - ADD 4000H TO ADDR RES 7,H ;ADDR NOW 0000-3FFF AND A JR Z,PDPSUBR3 ;JR IF PAGE 0 - ADDR OK ;ELSE ADD 4000H FOR PAGE 1 ADDR PDPSUBR2: SET 6,H ;ADD 4000H TO ADDR PDPSUBR3: LD A,C PDPSUBR4: DEC A CALL TSURPG POP AF ;ORIG URPORT POP BC RET ;CHECK MODE 2 OR MODE 3 CHKMD23: LD A,(MODE) CP 2 RET NC INVMERR: RST 08H DB 34 ;"Invalid screen mode" ;READ. E.G. READ A, READ A$, READ LINE A$ READ: CP LINETOK PUSH AF ;Z IF LINE JR NZ,READ2 CALL SSYNTAX1 ;SKIP 'LINE', ASSESS VAR FOR ASSIGNMENT LD HL,FLAGS BIT 6,(HL) JP NZ,NONSENSE ;READ LINE NOT ALLOWED WITH NUMERICS ;SKIP NEXT CALL READ2: CALL NZ,SYNTAX1 CALL RUNFLG JP NC,RJUNKFLG ;JR IF SYNTAX TIME RST 18H LD (PRPTR),HL ;SAVE CHAD IN AUTO-ADJUST VAR SO IF IT PTS TO LD A,(CHADP) ;E-LINE THE ASSIGNMENT WON'T BOLIX IT LD (PRPTRP),A CALL ADDRDATA ;ADDRESS DATADD - SWITCH IN ITS PAGE, LD HL LD (CHADP),A ;WITH ADDR PART LD A,(HL) CP 20H JR Z,READ3 CP "," JR Z,READ3 ;SPACES AND COMMAS ARE OK TO READ FROM. ;OTHERWISE, NEED TO LOOK FOR NEXT DATA STAT. LD (CHAD),HL ;NEEDED BY 'SRCHPROG' LD E,0B9H ;DATATOK LD HL,(CLA) PUSH HL CALL SRCHPROG ;LOOK FOR 'DATA' FROM CHAD ONWARDS POP DE LD (CLA),DE IN A,(251) ;CHAD PTS TO JUST AFTER 'DATA' LD (CHADP),A ;ASSUME FOUND... ; LD (DATADDP),A ;** BUG FIX JR C,READ4 ;JR IF FOUND OK. PAGE MAY BE SWITCHED RST 08H DB 3 ;'DATA has all been read' READ3: INC HL LD (CHAD),HL READ4: POP AF JR Z,READLN ;JR IF 'READ LINE' CALL VALFET1 ;ASSIGNMENT FOR NON-LINE READ JR READ7 READLN: LD BC,0FFFFH PUSH HL READ5: LD A,(HL) CP 22H JR NZ,READ6 RDSTRL: INC HL INC BC CP (HL) JR NZ,RDSTRL READ6: CALL NUMBER LD (CHAD),HL ;SKIP FP FORMS INC HL INC BC ;INC COUNT OF NON-INVISIBLE CHARS CALL COMCRCO ;CHECK IF COMMA, CR OR COLON JR NZ,READ5 ;LOOP UNTIL ONE IS FOUND POP DE PUSH BC ;LEN WITH NO FP FORMS SBC HL,DE ;FIND DISTANCE CHAD MOVED LD B,H LD C,L ;LEN WITH FP FORMS,+1 CALL SCOPYWK EX DE,HL ;HL=ROOM START PUSH HL CALL REMOVEFP ;FROM (HL) TO 0DH POP DE ;FIRST CHAR IN WKSPACE POP BC ;NON-INVISIBLE CHAR COUNT CALL STKSTOREP ;STORE REGS FOR A STRING CALL ASSIGN READ7: RST 18H ;GET CHAD LD (DATADD),HL ;UPDATE DATA PTR IN A,(251) LD (DATADDP),A LD HL,(PRPTR) ;GET REAL CHAD LD (CHAD),HL LD A,(PRPTRP) CALL SETCHADP DB 0FEH ;'JR +1' RJUNKFLG: POP AF ;JUNK F RST 18H CP "," RET NZ RST 20H ;SKIP COMMA JP READ ;CITEM.SAM - COLOUR ITEMS. ;CALLED BY SYNTAX 9 SYNT9SR: CALL RUNFLG JR NC,SYN9SR1 ;JR IF SYNTAX CHECK XOR A LD (DEVICE),A ;UPPER SCREEN CALL GRATEMPS LD HL,MASKT LD A,(HL) OR 0F8H LD (HL),A INC HL RES 6,(HL) ;RES 6,PFLAGT=NOT PAPER 9 SYN9SR1: RST 18H CITEM: CALL CITEMSR RET C RST 18H CALL INSISCSC ;CHECK FOR ,/; THEN SKIP JR CITEM ;CITEMSR - CALLED BY CITEM AND BASIC"S PRINT/INPUT ;EXIT WITH CY IF COLOUR ITEM NOT FOUND CITEMSR: CP 0A1H ; INKTOK RET C ;RET IF BELOW "INK" CP 0A7H ; OVERTOK+1 CCF RET C ;RET IF ABOVE "OVER" LD C,A RST 20H ;SKIP INK/PAPER ETC LD A,C ;CALLED BY PERMS COTEMP4: SUB 0A1H-16 ;INK. CHANGE TO CONTROL CODE RANGE (16-21) PUSH AF CALL EXPT1NUM ;PARAM POP BC ;CONTROL CODE CALL RUNFLG RET NC ;ABORT WITH NC IF SYNTAX TIME ;"COLOUR ITEM DEALT WITH" PUSH BC CALL GETBYTE LD D,A ;PARAM TO D POP AF ;CONTINUE INTO PRCOITEM (ZX USED RST 8) ;CALLED BY PRINT WITH A=CONTROL CODE, D=PARAM ;NOTE: TRANSLATOR ALTERS INK/PAPER 8 OR 9 TO INK/PAPER 17/18. THERE WILL BE ;SOME FAILURES - E.G. INK N. ;INK I; BRIGHT B SELECTS INK I+8*B IN MODE 3 ;BRIGHT IS IGNORED IN MODE 2, ALTHOUGH M0/1 SYS VARS ALTER. ;INK I WITH I>7 SELECTS INK I-8; BRIGHT 1 ;OVER 0/1 ALTERS PFLAG AND OVERT, OVER 0-3 ALSO ALTERS GOVERT TO GIVE GRAB CMD"S ;XOR/AND OPTIONS. PRCOITEM: RST 30H DW PRCOITEM2 CALL COLEX ;COLOUR EXPANSION TABLE IF NEEDED AND A ;NC SHOWS COLOUR ITEM DEALT WITH RET PERMS: CALL RUNFLG JR NC,PER2 ;JR IF NOT RUNNING XOR A LD (DEVICE),A ;UPPER SCREEN CALL TEMPS PER2: LD A,(CURCMD) ;GET CMD VALUE CALL COTEMP4 ;ALTER TEMP VALUES ACCORDING TO COLOUR CMDS CALL CHKEND ;CALLED BY CLS# PER3: LD HL,ATTRT LD DE,ATTRP ;USED BY SCREEN SCROLL LDIR8: LD BC,8 LDIR ;COPY TEMP VALUES TO PERMS RET ;(ATTRT-GOVERT) ;CHLETCHK, TEMPS, DATA, RESTORE, CITEM, PERMS, ;POKE, DPOKE, PDPSR, CHKM23 INCLUDE LOOKVAR.SAM ;SETUP VARS ;LOOKVAR.SAM ;ENTRY: A VARIABLE (STARTS WITH A LETTER) IS EXPECTED AT (CHAD) ;(HL)/A=FIRST LETTER ;ACTION: LOOK IN VARIABLES AREA FOR IT ;EXIT: Z IF VAR NOT FOUND: C=TYPE/LEN BYTE; BITS 4-0=NAME LENGTH, EXCLUDING ; FIRST CHARACTER. BIT 5 IS SET FOR NUMERIC ARRAYS. ; STRINGS: HL PTS TO FF TERMINATOR OF STRING/ARRAY VARS ; NUMBERS: HL PTS TO MSB OF PTR (FF) THAT TERMINATES LIST FOR LETTER. ; NZ IF FOUND. HL POINTS TO VALUE IN VARS. (FOR NUMS, FIRST OF 5 BYTES, ; FOR STRINGS, LEN IN PAGES, FOLLOWED BY LEN MOD 16K AND TEXT) ; C=TYPE/LEN BYTE FROM VARS. NUMS: BIT 6 SET=FOR-NEXT ; STRINGS/ARRAYS: BIT 6 SET=STR ARRY, BIT 5 SET=NUM ARRY ; ;ALWAYS: BIT 6,(FLAGS) IS SET FOR NUMERICS, RES FOR STRINGS ; NAME IS IN BUFFER AT "FIRLET" (FIRST LETTER IS CODED TABLE OFFSET) LOOKVARS: RST 18H ;ENTRY FROM EVAL LKVARS2: CALL NAMTOBUF ;MOVE PAST NAME, COPY TO BUFFER, GET C=TYPE/LEN ;HL=FLAGS, A=NAME TERMINATOR ($/(/OTHER) LD (CHAD),DE ;PT PAST NAME (AND ANY (/$) IN BASIC LINE LD A,C AND 60H JP NZ,STARYLK ;JP IF AN ARRAY LD A,(HL) ;FLAGS ADD A,A JP P,STARYLK ;JP IF STRING LD A,C LD (TLBYTE),A RET NC ;RET IF SYNTAX TIME. NZ="FOUND" (BIT 7=1 FOR MINUS) ;LOOK FOR A NUMERIC VARIABLE ROUTINE ;NVARS PTS TO A TABLE OF WORD PTRS. IF THE MSB OF THE PTR IS 0FFH, THERE ; ARE NO MORE VARS STARTING WITH THAT LETTER. (SO TO CLEAR NUM VARS, INIT ; TABLE WITH FFs.) IF PTR MSB<>FF THEN ADD PTR TO GET ADDR. OF ; TYPE/LENGTH BYTE FOR NEXT VAR. NOTE: THERE MAY BE NO SECOND LETTER. ; TYPE | PTR LSB | PTR MSB | SECOND LET | .. | LAST LET | VALUE ; TYPE/LEN BYTE HAS BIT 7 SET FOR HIDDEN, BIT 6="FOR" VAR ; BITS 4-0=LEN-1. (0 FOR 1-LETTER VAR NAME, 31 FOR 32 LETTER MAX) ;ENTRY: NAME IS IN BUFFER STARTING AT "FIRLET", LETTERS UPPER CASE, NO SPACES ; C=DESIRED TYPE/LEN BYTE ;EXIT: Z IF VAR NOT FOUND, C=TYPE/LEN BYTE. ; HL PTS TO LSB OF PTR (FFFF) THAT TERMINATES LIST FOR LETTER. ; NZ IF FOUND. HL POINTS TO VALUE IN VARS, IX-1 PTS TO TYPE BYTE, ; C=TYPE/LEN FROM VARS, DE=PTR ADDED TO PREV VAR. PTR MSB ADDR TO ; PT TO THIS VAR"S T/L BYTE NUMLOOK: LD A,(FIRLET) SUB 61H ADD A,A LD E,A ;LETTER TRANSFORMED TO WORD OFFSET (A=0, B=2..) LD D,0 CALL ADDRNV ;PT. HL AT NUMERIC VARS, PAGED IN ADD HL,DE ;INDEX INTO TABLE OF WORD PTRS. DB 0FEH ;"JR+1" NVMOLP: POP HL NVMLP: LD A,C ;DESIRED TYPE/LEN LD E,(HL) INC HL ;PTR=FFFFH IF NO MORE VARS START WITH REQUIRED LD D,(HL) ; LETTER. CAUSES CARRY AND CHECK FOR FF IN NVSPOV ADD HL,DE ;ELSE DE IS A PTR TO NEXT VAR STARTING ; WITH REQUIRED LETTER. JR C,NVSPOV ;JR IF SEVERE PAGE OVERFLOW BIT 6,H JR NZ,NVSINCP ;KEEP IN 8000-BFFF REGION NVSIEN: XOR (HL) AND 0BFH ;IS IT DESIRED TYPE/NAME LENGTH? IGNORE BIT 6 ;MISMATCH ("FOR" FLAG) INC HL ;PT TO PTR LSB JR NZ,NVMLP ;LOOP TIME=84Ts LD A,C AND 1FH ;ISOLATE NAME LENGTH PUSH HL ;SAVE PTR TO PTR LSB IN CASE MATCH FAILS INC HL ; INC HL ;SKIP PTR BYTES. ;HL=PTR TO NAME 2ND. LETTER IN VARS AREA. JR Z,NVSFND ;JR IF SINGLE LETTER VAR - ALREADY MATCHED. LD B,A LD IX,FIRLET+1 ;PT TO SECOND LETTER NVMTCHLP: LD A,(IX+0) CP (HL) JR NZ,NVMOLP ;EXIT IF MATCH FAILS INC IX INC HL DJNZ NVMTCHLP ;LOOP TILL WHOLE NAME MATCHES. HL PTS TO VALUE. NVSFND: POP IX ;PTR TO PTR LSB LD C,(IX-1) ;C=TYPE/LEN FROM VARS NZST: INC A ;NZ STATUS RET ;PREV. VAR PTR MSB IS AT IX-DE-1 ;PAGE OVERFLOW - MIGHT BE DUE TO LOTS OF VARS, OR PTR MSB=FF (TERMINATOR) NVSPOV: INC D RET Z ;NOT FOUND - Z. HL HAS MOVED BACK BY 1 TO PTR LSB CALL PGOVERF CP A ;Z NVSINCP: CALL NZ,INCURPAGE LD A,C JR NVSIEN ;FROM PARPRO ;ENTRY: HL POINTS TO NAME ON BSTK, A=T/L BYTE. LKBSV: LD DE,FIRLET LD B,A AND 0FH LD C,A LD A,B LD B,0 ;BC=NAME LEN LDIR ;COPY STORED NAME FROM BSTK TO FIRLET BUFFER LD (BSTKEND),HL AND 6FH ;MASK BIT THAT SHOWS IF A GLOBAL VERSION WAS HIDDEN ;(7) - LOOK FOR "VISIBLE" FORM USED LOCALLY ;ALSO FORCE BIT 4 LOW JR STARYLK2 ;A=DESIRED T/L BYTE ;LOOK FOR A STRING OR ARRAY ;ENTRY: NAME IS IN BUFFER AT "FIRLET" ; C=TYPE/LEN BYTE. BIT 5 SET IF NUMERIC ARRAY, BIT 6 SET IF STRING ARRAY ; OR SLICED STRING. (IF BIT 6 AND BIT 5=0, SIMPLE STRING NAME) ;EXIT: Z IF VAR NOT FOUND. C=ORIG TYPE/LEN BYTE, STRLOCN/HL" PT TO STOPPER. ; NZ IF FOUND. HL POINTS TO LEN IN PAGES, C/(DE)=TYPE/LEN IN VARS, ; STRLOCN=TYPE/LEN IN VARS ;VARS AREA HOLDS TYPE/LEN BYTE, FIRST LET,..LAST LET, PADDED TO 10 CHARS, ;LEN IN PAGES, LEN MOD 16K, TEXT. REPEATED UNTIL FF STOPPER ;TYPE/LEN BIT 7=HIDDEN, 6=STRING ARRAY, 5=NUMERIC ARRAY (6 AND 5 LOW=SIMPLE $) ;USES ALL REGS STARYLK: INC C LD A,C LD (TLBYTE),A AND 1FH ;ISOLATE NAME LEN CP 11 JP NC,INVVARNM ;ERROR IF STRING/ARRAY NAME LONGER THAN 10 CHARS ;EXCLUDING $ OR ( LD A,(HL) RLA JR NC,NZST ;IF SYNTAX TIME, SET NZ ("FOUND") (A REG COULD NOT ;HAVE HELD FFH) LD A,C ;CALLED BY PROCESS PARAMS STARYLK2: EXX LD C,A ;C"=DESIRED TYPE/LEN (LEN NOW TRUE NAME LEN) LD B,1FH ;B"="LEN" MASK LD E,0BFH ;E"=MASK TO FORCE BIT 6 LOW EXX CALL ADDRSAV ;PT HL AT STR/ARRAY VARS, SWITCHED IN. IN A,(251) ;START WITH CURRENT PORT VALUE LKSTRLP: LD DE,FIRLET ;PT TO START OF STORED NAME. OUT (251),A ;NO EFFECT ON FIRST PASS, AND MANY OTHERS LD (STRLOCN),HL ;SAVE START OF CURRENT STRING/ARRAY LD A,(HL) ;GET TYPE (BITS 7-5) AND NAME LEN (BITS 4-0) EXX LD H,A ;SAVE DATA FROM VARS BRIEFLY XOR C ;XOR WITH DESIRED AND E ;AND RESULT WITH BFH. ;(SEE IF TYPE/LEN FROM VARS=DESIRED T/L IN C". ;IGNORE BIT 6 MISMATCH (SIMPLE VS. ARRAY STRINGS) JR NZ,TLNOMTCH LD A,H AND B ;B"=1FH. ISOLATE NAME LEN. (SAME FOR DESIRED EXX ;AND CANDIDATE NAME) LD B,A INC HL LD A,(DE) ;FIRLET CP (HL) ;DO A QUICK CHECK ON FIRST LETTER. JR NZ,FLNOMTCH ;JR IF FAIL ;ELSE CHECK ENTIRE NAME JR DCNMLN ;B=1-10 STMTCHLP: INC HL INC DE LD A,(DE) CP (HL) JR NZ,FLNOMTCH DCNMLN: DJNZ STMTCHLP LD HL,(STRLOCN) LD C,(HL) ;T/L BYTE FROM VARS EX DE,HL LD HL,12 DEC L ;NZ ADD HL,DE ;HL PTS TO LEN IN PAGES, DE PTS TO T/L BYTE RET TLNOMTCH: INC H ;TEST FOR FF STOPPER RET Z ;RET IF IT IS. Z SHOWS NOT FOUND, C=DESIRED T/L EXX FLNOMTCH: LD HL,(STRLOCN) LD BC,11 ADD HL,BC ;SKIP NAME, PT TO LEN IN PAGES IN A,(251) ADD A,(HL) ;ADD PAGES OF STRING/ARRAY LENGTH INC HL LD C,(HL) INC HL LD B,(HL) INC HL ;PTS TO TEXT ADD HL,BC ;BC (0-3FFF) ADDED TO PT HL TO NEXT T/L BYTE JR C,LKSTRPO ;DEAL WITH RARE CASE OF STRLOC NEAR PAGE C END, BC ;NEAR 16K BIT 6,H JR Z,LKSTRLP ;JR IF HL STILL IN 8000-BFFF REGION RES 6,H ;=SUB 4000H LKSI: INC A ;INC PAGE TO COMPENSATE JR LKSTRLP LKSTRPO: INC A ;OVERFLOWED INTO 0000-3FFF - CORRECT BY 2 PAGES SET 7,H ;8000-BFFF AGAIN JR LKSI ;NAME TO BUFFER ;ALTERS HL, DE, BC, A ;ENTRY: HL PTS TO A CHAR, ALSO HELD IN A ;EXIT: DE POINTS TO CHAR PAST NAME ; NAME, COMPRISING ALPHANUMERICS OR UNDERLINE CHARS, COPIED TO BASE PAGE ; BUFFER AT "FIRLET", WITH SPACES REMOVED AND LOWER CASE FORCED. ; HL=FLAGS ADDR ; C BITS 4-0=NAME LEN, EXCLUDING FIRST CHAR. (0-31) ; BIT 6,C SET IF STRING ARRAY OR SLICED STRING ; BIT 5,C SET IF NUMERIC ARRAY ; BIT 6,(FLAGS) SET IF NUMERIC, RES IF STRING NAMTOBUF: LD B,32 ;MAX LEN+1 FOR A NAME (EXCLUDING 1ST CHAR) LD DE,FIRLET ;PT TO NAME BUFFER IN COMMON MEMORY CALL GETALPH OR 20H LD (DE),A ;FIRST LETTER STORED NMTBL: INC HL LD A,(HL) CP 20H JR Z,NMTBL ;SKIP SPACES CALL ALPHANUM ;SEE IF LETTER, NUMBER OR UNDERLINE JR C,NMTB2 ;JR IF ALPANUMERIC CP "_" JR NZ,NAMEND JR NMTB3 NMTB2: OR 20H ;FORCE LOWER CASE (NUMS UNAFFECTED) NMTB3: INC DE LD (DE),A DJNZ NMTBL ;LOOP TILL LENGTH ILLEGAL LD (CHAD),HL ;(FOR XPTR) INVVARNM: RST 08H DB 40 ;"Invalid variable name" - USUALLY SPOTTED IN ;SYNTAX CHECK ;NAME PROPER HAS NOW ENDED, BUT TYPE CHARACTER MAY FOLLOW NAMEND: EX DE,HL LD HL,FLAGS LD A,32 SUB B LD C,A ;C=NAME LENGTH-1, RANGE 0-31. LD A,(DE) CP "$" JR NZ,NMEN2 ;JR IF NUMERIC VAR RES 6,(HL) ;"STRING" INC DE LD A,(DE) CP "(" RET NZ INC DE SET 6,C ;"STRING ARRAY" RET NMEN2: SET 6,(HL) ;"NUMERIC" CP "(" RET NZ INC DE SET 5,C ;"NUMERIC ARRAY" RET LD A,32 SUB B LD C,A ;C=NAME LENGTH-1, RANGE 0-31. RET LVFLAGS: CALL LOOKVARS EX AF,AF' ;Z IF NOT FOUND LD A,(FLAGS) ADD A,A RET ;M IF NUM, P IF $, CY IF RUNNING INCLUDE EVAL.SAM ;ROM 0 FNS ;EVAL.SAM - SAM EXPRESSION EVALUATOR (ROM0). EXITS WITH PAGING UNCHANGED. ;ENTRY: CHAD PTS TO FIRST CHAR. EXIT: RESULT ON FPCS IF RUNNING, ELSE SYNTAX ;CHECKED AND 5-BYTES INSERTED IF NEEDED. BIT 6,(FLAGS)=0 IF STRING RESULT, ;ELSE NUMERIC. CHAD PTS TO CHAR THAT CANNOT BE PART OF EXPR. A=CHAR, HL=CHAD ;******************************************************************************* SCANNING: CALL R1OFFCL DW SCANSR LD C,A ;CURRENT CHAR LD A,(FLAGS) RET SCANSR: LD D,0 ;PRIORITY "STOPPER" RST 18H ;GET FIRST CHAR. HL=CHAD DB 0FEH ;"JR+1" SCANPLP: RST 20H ;NEXT CHAR PUSH DE ;PRIORITY/CODE ;FROM UNARY PLUS WITH HL=CHAD SCANLP: LD E,A AND 0DFH ;LETTERS BECOME UPPER CASE CP 5BH ;"Z"+1 JR NC,ABOVLETS CP "A" JP C,BELOWLETS ;JR UNLESS WE HAVE A LETTER ;EVALUATE A VARIABLE SLETTER: LD A,(DEFADD+1) ;PTS PAST DEF FN "(" IF FN BEING EVALED. AND A JR NZ,SLLKFV ;CHECK DEF FN BRACKETS FOR VAR IF DEFADD-HI NZ SLET1: LD A,(HL) CALL LKVARS2 JP Z,VNFERR ;ERROR IF NOT FOUND LD A,(FLAGS) ADD A,A ;CY IF RUNNING JP P,SLET2 ;JP IF STRING BIT 5,C JR Z,SLET3 ;JR IF NOT (NUMERIC) ARRAY SLET2: CALL STKVAR2 ;IF STRING, STACK START AND LEN, IF N ARRAY ;GET HL=START ADDR OF ELEMENT LD A,(FLAGS) ADD A,A JP P,SCONT1 ;JR IF STRING - CHECK FOR SLICER, THEN OPERATOR SLET3: CALL C,HLTOFPCS ;STACK NUM IF RUNNING SLET4: CALL SELCHADP RST 18H JP OPERATOR ;AN OPERATOR OR A TERMINATOR MUST FOLLOW SLLKFV: CALL LKFNVAR JR NC,SLET1 ;JR IF NOT FOUND OR SYNTAX TIME CP "$" JP Z,SCONT2 JR SLET4 ;******************************************************************************* ABOVLETS: INC E JR NZ,EVNONSE ;ERROR UNLESS FF FUNCT LEADER FOUND INC HL LD A,(HL) ;GET FUNCTION CODE SUB 1AH ;ADJUST 3B-83H TO 21H-69H LD E,A LD (CHAD),HL ;SKIP "FF" LD HL,(EVALUV) INC H DEC H CALL NZ,HLJUMP ;IF VECTORED JUMP WITH A=FN CODE. CP SIN JR C,IMMEDCODES LD D,0CFH ;"PRIORITY 0F, N ARG, N RESULT" CP EOF+3 JR C,SCANPLP ;JR IF SIN-EOF/PTR/POS CP NOT+1 JR NC,EVNONSE ;RANGE NOW UDG-NOT SCANUMEN: LD D,0 LD HL,FNPRIORT-UDGA ADD HL,DE LD D,(HL) ;FETCH PRIORITY AND INPUT/OUTPUT TYPE. (BIT 7=1/0 ;FOR N/$ RESULT, BIT 6=DITTO FOR ARGUMENT) JR SCANPLP ;STACK DE, GET NEXT CHAR, LOOP ;******************************************************************************* ;INKEY$ - THIS IS MAIN (NON-FPC) ROUTINE IMINKEYS: RST 20H ;SKIP "INKEY" CP "#" LD E,INKEY ;FPC INKEY$ CODE POP BC ;RET ADDR (STRCONT) JR Z,SCANUMEN ;STREAM VERSION HANDLED BY FPC. "#" WILL BE SKIPPED PUSH BC CALL ABORTER ;(WE CANNOT USE THE NORMAL INPUT STREAM FOR INKEY$ ;ON ITS OWN, SINCE THAT WOULD NOT CAUSE A KEYSCAN, ;BUT WOULD JUST FETCH LAST-K CALL READKEY ;RETURNS KEY CODE IN A AND CY IF OK RST 30H DW FPINKEN-8000H ;MAKE 1-CHAR STRING AND STACK PARAMS ;******************************************************************************* ;SOME FUNCTIONS HAVE TO BE HANDLED AT ONCE BECAUSE THEY HAVE NO ARGUMENTS ;(LIKE PI) OR BECAUSE THEY HAVE SEVERAL ARGUMENTS IN BRACKETS (LIKE POINT). ;NUM. RESULT: PI, RND, POINT, FREE, LENGTH, ITEM, ATTR, FN, BIN, HIMEM, XMOUSE, ;YMOUSE, XPEN, YPEN, INARRAY, INSTR. ;STR. RESULT: INKEY$, SCREEN$, MEMORY$, CHAR$, PATH$, STRING$, USING$, SHIFT$ IMMEDCODES: SUB PI JR C,EVNONSE ;RANGE NOW PI-SHIFT$ ADD A,A LD E,A LD D,0 LD HL,IMFNATAB ADD HL,DE LD C,(HL) INC HL LD B,(HL) LD HL,NUMCONT CP 0+(INSTR-PI)*2+1 JR C,IMMEDNUM LD HL,STRCONT IMMEDNUM: PUSH HL BIT 7,B JP NZ,R1ONCLBC PUSH BC RET ;JP TO BC STRCONT: CALL SLLPEX ;SIGNAL STRING RESULT JR SCONT2 ;******************************************************************************* BELOWLETS: LD A,E CP "0" JP C,BELOWNUM CP 3AH JR C,SDECIMAL EVNONSE: RST 08H DB 29 ;"NONSENSE" ;******************************************************************************* ;HANDLE LITERAL NUMBER (0-9, DECIMAL PT., BIN OR AMPERSAND IMBIN: POP AF ;JUNK RET TO IMMEDNUM+3 RST 18H ;GET HL=CHAD SDECIMAL: LD A,(FLAGS) RLA JR NC,INSERT5B ;JR AND INSERT THE INVISIBLE FORM IF SYNTAX TIME LK0ELP: INC HL LD A,(HL) CP 0EH JR NZ,LK0ELP ;LOOP TILL NUMBER MARKER FND. INC HL LD BC,5 LD DE,(STKEND) LDIR ;COPY NUMBER TO FPCS LD (STKEND),DE SCHADNUM: LD (CHAD),HL JR NUMCONT INSERT5B: CALL CALC5BY ;FIND 5-BYTE FORM OF DEC, HEX OR BIN NUMBER LD HL,(CHAD) CALL MAKESIX ;MAKE 6 SPACES IN ELINE, PLACE 0EH, INC HL EX DE,HL CALL FDELETE LD BC,5 ;HL PTS TO DELETED NUMBER, DE TO ROOM IN ELINE LDIR ;COPY 5 BYTES TO ELINE EX DE,HL JR SCHADNUM ;SET NUMERIC, SET CHAD ;******************************************************************************* SSLICER: LD HL,FLAGS BIT 6,(HL) JR NZ,SLOOP ;NUMBERS CANNOT HAVE A SLICER - TERMINATE RST 20H ;SKIP "(" CALL SLICING RST 20H JR SLSTRLP ;******************************************************************************* NUMCONT: LD HL,FLAGS SET 6,(HL) ;SIGNAL "NUMERIC" RST 18H JR OPERATOR SCONT1: CALL SELCHADP SCONT2: RST 18H ;STRING EXPRESSIONS CAN BE FOLLOWED BY A SLICER ;EG (STR$ 123)(2) SO CHECK FOR THIS BEFORE LOOKING ;FOR AN OPERATOR OR TERMINATOR SLSTRLP: CP "(" JR Z,SSLICER ;DEAL WITH BINARY OPERATORS: +,-,*,/,^,=,>,<,<=,>=,<>,OR,AND,MOD,IDIV,BOR, ETC. OPERATOR: LD D,0 ;PRIORITY=0 INC A JR NZ,OPERAT2 ;JR IF NOT FF FN CODE LEADER INC HL LD A,(HL) ;FETCH OPERATOR CODE SUB MODTOK JR C,SLOOP CP 0AH JR NC,SLOOP ;RANGE NOW 00-09 FOR MOD TO ">=" LD (CHAD),HL ;SKIP FF ADD A,8 ;MOD TO ">=" BECOME 08-11H JR OPERAT3 OPERAT2: SUB "*"+1 ;MULT IS 0, DIVN IS 5, "<" IS 12H, ">" IS 14H JR C,SLOOP ;JR IF BELOW BINARY OPERATOR RANGE CP 4 JR Z,SLOOP ;EXCLUDE "." CP 6 JR C,OPERAT3 ;JR IF WITHIN RANGE FOR * TO / CP 12H JR C,SLOOP CP 15H JR C,OPERAT3 ;JR IF "<", "=" OR ">" (NOW 12H-14H) CP 34H ;POWER-OF LD A,4 JR NZ,SLOOP OPERAT3: LD E,A ;E=BIN OPERATOR CODE 00-14H LD HL,OPPRIORT ADD HL,DE LD D,(HL) ;FETCH OPERATOR PRIORITY, OR 0 IF NOT RECOGNISED SLOOP: POP BC ;PREV PRIORITY (B) AND OPERATION CODE (C) LD A,B SUB D AND 10H ;IF PRIORITY NIBBLE IS HIGHER IN D, BIT 4 WILL BE 1 JR NZ,PRIGRTR ;JR IF CURRENT PRIORITY HIGHER - WAIT OR B ;ELSE B PRIORITY IS >=D JP Z,0018H ;EXIT IF BOTH PRIORITIES ARE ZERO PUSH DE ;CURRENT PRIORITY/CODE LD HL,FLAGS LD A,(HL) RLA ;CY IF RUNNING JR C,EXECOP ;PERFORM OPERATION IF RUNNING LD A,B ;PRIORITY CODE OF FN TO BE CHECKED/EXECUTED XOR (HL) ;CHECK THAT FNS THAT WORK ON STRINGS HAVE STRING ;"LAST VALUE"S, AND DITTO FOR NUMERICS. BIT 6 OF ;PRIORITY CODE IS 0 IF FN WORKS ON STRINGS, ELSE 1 ADD A,A JP M,EVNONSE ;ERROR IF BIT 6,(FLAGS)<>BIT 6 OF FN CODE JR CHKEXECC EXECOP: PUSH BC LD B,C ;FN CODE TO EXECUTE DB CALC DB USEB DB EXIT POP BC LD HL,FLAGS CHKEXECC: LD A,B ;PRIORITY CODE OF FN JUST CHECKED/EXECUTED POP DE ;NEXT PRIORITY/CODE SET 6,(HL) ;"LAST VALUE IS NUMERIC" RLA ;BIT 7 OF THE P. CODE IS SET IF ITS RESULT IS A NUM JR C,SLOOP ;JR IF WE SET FLAGS CORRECTLY RES 6,(HL) ;"LAST VALUE IS STRING" JR SLOOP ;******************************************************************************* PRIGRTR: PUSH BC ;PREV PRIOR/CODE LD A,(FLAGS) ADD A,A JP M,SCANPLP ;LOOP IF NUMERIC - I.E. LEAVE TYPE CODE BITS ;ALONE IF A NUMERIC IS FOLLOWED BY A BINARY ;OPERATOR - THEY ARE SET FOR NUMERIC I/P AND O/P LD A,E ;CURRENT CODE ;ALL LEGAL $ BINARY OPS EXCEPT "+" WILL GET ;CODES 7 ABOVE THEIR NUMERIC EQUIVALENTS RES 7,D ;RESULT TYPE WILL BE STRING FOR "+" AND "AND" CP 0EH ;CP "AND" " JR Z,SCANPLPH ;IF "AND" LEAVE "INPUT" BIT AS NUMERIC FOR ;"$ AND N" RES 6,D ;ELSE "INPUT" BIT IS STRING E.G. "$+$", "$<$" INC E ;IF "+", E=2 CP 1 ;CP "+" JR Z,SCANPH2 ;JP WITH STRING INPUT AND OUTPUT FOR "+" SET 7,D ;NUMERIC OUTPUT FOR E.G. "$>$" CP 0EH ;CP "AND" JP C,NONSENSE ;E.G. $ MOD $ IS AN ERROR SCANPLPH: ADD A,7 LD E,A SCANPH2: JP SCANPLP ;JP TO STACK DE AND GET NEXT CHAR ;******************************************************************************* ;BINARY OPERATOR PRIORITY TABLE OPPRIORT: DB 0C8H ;0 2A * DB 0C6H ;1 2B + DB 0 ;2 2C DB 0C6H ;3 2D - DB 0CFH ;4 5E TO-POWER-OF DB 0C8H ;5 2F / DB 0 ;6 DB 0 ;7 DB 0CEH ;8 MOD DB 0CEH ;9 IDIV DB 0C2H ;A BOR DB 0C2H ;B BXOR DB 0C3H ;C BAND DB 0C2H ;D .. OR DB 0C3H ;E .. AND (ADD 7 FOR $ EQUIV. OF "AND" TO ">") DB 0C5H ;F .. <> DB 0C5H ;10 .. <= DB 0C5H ;11 .. >= DB 0C5H ;12 3C < DB 0C5H ;13 3D = DB 0C5H ;14 3E > ;******************************************************************************* ;UNARY FUNCTION PRIORITY TABLE (FOR MINORITY OF FNS THAT AREN"T PRI. 16,N,N) ;BIT 7=1 IF NUM RESULT. BIT 6=1 IF NUM ARG. BITS 4-0=PRIORITY FNPRIORT: DB 8FH ;UDG DB 8FH ;NUMBER DB 8FH ;LEN DB 8FH ;CODE DB 0FH ;VAL$ DB 8FH ;VAL DB 0FH ;TRUNC$ DB 4FH ;CHR$ DB 4FH ;STR$ DB 4FH ;BIN$ DB 4FH ;HEX$ DB 4FH ;USR$ DB 4FH ;INKEY$ DB 0C4H ;NOT DB 0C9H ;NEGATE ;******************************************************************************* ;IMMEDIATE FN ADDRESS TABLE. ALL ARE EVALUATED AT ONCE BECAUSE THEY HAVE NO ;ARGS, OR BRACKETED ARGS, OR #ARG. IMFNATAB: DW IMPI ;NUMERIC RESULT DW IMRND DW IMPOINT DW IMMEM DW IMLENGTH DW IMITEM DW IMATTR DW IMFN DW IMBIN DW IMMOUSEX DW IMMOUSEY DW IMPENX DW IMPENY DW IMHIMEM DW NONSENSE DW IMINSTR DW IMINKEYS ;STRING RESULT DW IMSCREENS DW IMMEMRYS DW NONSENSE DW IMPATHS DW IMSTRINGS DW NONSENSE DW NONSENSE ;******************************************************************************* ;BELOW NUMBERS ARE QUOTE, "&", OPEN BRACKET, UNARY PLUS & MINUS, DECIMAL PT. ;(22H,26H,28H,2BH,2DH,2EH) BELOWNUM: CP 22H JR Z,SQUOTE CP "&" JR Z,SDECIMALH CP "(" JR Z,SBRACKET CP "-" JR Z,UNARMIN CP "." SDECIMALH: JP Z,SDECIMAL CP "+" JP NZ,NONSENSE UNARPLU: RST 20H ;JUST SKIP A UNARY PLUS JP SCANLP UNARMIN: LD E,NEGATE ;UNARY MINUS CODE JP SCANUMEN SBRACKET: RST 20H ;SKIP "(" CALL SCANNING LD A,C CALL INSISCBRK ;INSIST ON ")" JP SCONT2 ;******************************************************************************* ;PASS PARAMS OF STRING LITERAL TO FPCS IN RUN TIME SQUOTE: INC HL ;SKIP QUOTE PUSH HL ;STRING TEXT START LD A,(FLAGS) RLA EX AF,AF' ;CY IN F" IF RUNNING LD BC,0FFFFH ;INITIALISE LENGTH QUTSRLP: LD A,(HL) INC HL INC BC ;INC LEN COUNT CP 0DH JP Z,NONSENSE CP 22H JR NZ,QUTSRLP ;LOOP UNTIL QUOTE FOUND POP DE ;START LD A,(HL) CP 22H ;CHECK IF DOUBLE QUOTE JR Z,SQUOTE2 ;JR IF EMBEDDED QUOTES USED. ELSE STRING IS ;SIMPLE AND CAN STAY IN BASIC LINE. LD (CHAD),HL ;PT PAST CLOSING QUOTE EX AF,AF' CALL C,STKSTOREP ;STACK PARAMS OF STR IN BASIC LINE, IF RUNNING STRCONTH: JP STRCONT ;EMBEDDED QUOTES - HAVE TO COPY STRING TO BUFFER, OMITTING SOME ALT. QUOTES SQUOTE2: LD HL,INSTBUF ;ALLOWS 256 BYTES LD C,0 PUSH HL ;BUFFER START SQUCOPY: LD A,(DE) ;CHAR FROM BASIC LINE INC DE CP 22H JR Z,SQUCO3 SQUCO1: LD B,A EX AF,AF' JR NC,SQUCO2 LD (HL),B INC HL SQUCO2: EX AF,AF' INC C JR NZ,SQUCOPY ;LOOP, COPYING CHARS FROM BASIC LINE TO BUFFER ;(MAX OF 255) RST 08H DB 42 ;"String too long" SQUCO3: LD A,(DE) INC DE CP 22H JR Z,SQUCO1 ;COPY IN NEXT CHAR IF IT IS A SECOND QUOTE MARK LD B,0 DEC DE ;PT TO JUST PAST FINAL QUOTE LD (CHAD),DE POP HL ;BUFFER START EX AF,AF' CALL C,CWKSTK ;IF RUNNING, COPY TO WKSPACE, STACK PARAMS. JR STRCONTH ;CALC5BY.SAM ;******************************************************************************* ;CALCULATE A 5-BYTE FORM FOR A DECIMAL, HEX OR BINARY NUMBER ;ENTRY WITH HL AND CHAD PTING TO FIRST CHAR OF NUMBER (&,.,0-9,BIN) ;EXIT WITH VALUE ON FPCS CALC5BY: LD A,(HL) CP "&" JR NZ,NAMP RST 30H DW AMPERSAND-8000H NAMP: CP BINTOK JP NZ,DECIMAL LD BC,0 ;INITIALISE RESULT NXBINDIG: RST 20H ;SKIP BIN CP "0" JR Z,BINDIG CP "1" SCF JP NZ,STACKBC ;STACK RESULT AS SOON AS NON-1, NON-0 FOUND BINDIG: RL C RL B JR NC,NXBINDIG RST 08H DB 28 ;"Number too large" ;******************************************************************************* ;HANDLE EG 0.123, .123, 1.234, 1E4, 1.23E+4, 7.89E-32, 1.E5 DECIMAL: CP "." JR NZ,DECINT RST 20H ;SKIP "." CALL NUMERIC JP NC,NONSENSE ;INSIST ON E.G. .1 OR .8 DB CALC DB STKZERO ;INTEGER PART OF A FRACTION IS ZERO DB EXIT JR CONVFRAC DECINT: CALL INTTOFP CP "." JR NZ,EFORMAT RST 20H CALL NUMERIC JR NC,EFORMAT ;JR IF NOT A DIGIT CONVFRAC: DB CALC DB STKFONE DB STOD0 ;MULTIPLIER (M) STARTS AT 1 DB EXIT RST 18H JR CONVFRAC2 CONVFRALP: SUB 30H LD B,A DB CALC DB STKBREG DB RCL0 DB STKTEN DB DIVN DB STO0 DB MULT DB ADDN DB EXIT RST 20H CONVFRAC2: CALL NUMERIC JR C,CONVFRALP ;JR IF A DIGIT EFORMAT: AND 0DFH CP "E" RET NZ RST 20H ;SKIP "E" LD C,"+" CP C JR Z,GEXSGN1 CP "-" JR NZ,GEXSGN2 LD C,A GEXSGN1: RST 20H ;SKIP +/- GEXSGN2: CALL NUMERIC JP NC,NONSENSE ;INSIST ON NUMERIC NOW PUSH BC ;C=+/- CALL INTTOFP CALL FPTOA JR C,NTLERR ;JR IF >255 RLCA JR NC,GEXSGN3 ;JR IF <=127 NTLERR: RST 08H DB 28 ;"Number too large" GEXSGN3: RRCA POP BC BIT 1,C JR NZ,POFTENH ;JR IF 0010 1011 (+) NEG POFTENH: RST 30H DW POFTEN-8000H ;MULT FPC LAST VALUE BY E+/-A REGISTER ;******************************************************************************* ;GET VALUE OF ASCII INTEGER IN A AND (CHAD+1...) TO FPCS. ZERO IF NO DIGITS. ;EXIT WITH NC AND A=NON-NUMERIC CHAR INTTOFP: LD B,A DB CALC DB STKZERO ;TOTAL=0 DB EXIT LD A,B JR INTTOFP3 INTTOFPLP: SUB 30H LD B,A DB CALC ;B GOES TO BREG DB STKTEN DB MULT ;TOTAL=TOTAL*10 DB STKBREG DB ADDN DB EXIT CALL NXCHAR ;0074 EQU - NEXT CHAR, DON"T SKIP ANYTHING INTTOFP3: CALL NUMERIC JR C,INTTOFPLP ;LOOP WHILE NUMERIC ASCII FOUND RET ;******************************************************************************* ;USR$. E.G. LET A$=USR$ 12345 OR &18000 R0USRS: LD HL,STKSTOS ;STACKS DE,BC,A DB 0FDH ;"JR+3" ;USR. E.G. LET X=USR 123456 R0USR: LD HL,STACKBC USRCOM: PUSH HL ;FROM "CALL" CALLX: PUSH IX CALL PDPSUBR ;SWITCH ADDR IN. HL=ADDR, A=ORIG URPORT LD B,H LD C,L PUSH AF ;STACKED IN SECTION B LD A,(TEMPB3) ;JUNK OR NO. OF PARAMS IF CALL CALL HLJUMP POP AF OUT (251),A ;ORIG URPORT POP IX RET ;TO STACKBC OR STKSTOS OR NEXTSTAT (IF CALL) ;******************************************************************************* ;MEMORY$ E.G. MEM$(N1 TO N2) HANDLE READING ROM? HOW? IMMEMRYS: CALL SINSISOBRK ;CHK "(" CALL EXPT1NUM ;N1 CP TOTOK ;"TO" JP NZ,NONSENSE CALL SEX1NUMCB ;SKIP, EXPT "N)", CY IF RUNNING RET NC ;RET IF NOT RUNNING RST 30H DW MEMRYSP2-8000H ;******************************************************************************* ;HIMEM - "RAMTOP" IMHIMEM: CALL SABORTER LD HL,(RAMTOP) ;MAINTAINED IN 8000-BFFF FORM,(UNLIKE OLDRT) LD A,(RAMTOPP) LD B,A ;USED BY TPEEK - ADJUST/STACK BHL ASBHL: IN A,(250) LD C,A LD A,B SUB C ;ADJUST TO RELATIVE PAGE JR STKPGFORM ;******************************************************************************* ;MEM - FREE MEMORY. IMMEM: CALL SABORTER CALL GETROOM ;AHL=19BIT NUMBER JR STK19BIT ;STACK PAGE FORM IN AHL ON FPCS STKPGFORM: CALL AHLNORM ;TURN TO 19-BIT NUMBER STK19BIT: PUSH AF CALL STACKHL POP BC DB CALC ;LSW DB STKBREG ;LSW,MSB DB STK16K DB MULT ;LSW,MSB*16K DB STKHALF DB DIVN ;LSW,MSB*32K DB STKHALF DB DIVN ;LSW,MSB*64K DB ADDN ;MSB*64K+LSW DB EXIT2 IMMOUSEX: CALL SABORTER LD HL,(MXCRD) JP STACKHL IMMOUSEY: CALL SABORTER LD A,(MYCRD) JR STACKAH IMPENX: CALL SABORTER LD BC,CLUTPORT ;A8 IS LOW IN A,(C) RRA RRA AND 3FH JR STACKAH IMPENY: CALL SABORTER LD BC,0100H+CLUTPORT ;A8 HIGH GIVES PEN Y, NOT PEN X JR FPIN2 ;IN (N1) - IN A,(BC) FPIN: CALL GETINT ;TO BC FPIN2: IN A,(C) STACKAH: JP STACKA ;******************************************************************************* ;SWOPS. CAN BE CALLED, OR USED AS FPC FUNCTIONS ;EXIT: DE=STKEND ;DIRECT CALLS FROM FOR-NEXT, OPEN, ... ;SWOP TOP AND THIRD ENTRIES FPSWOP13: LD C,-10 JR SWOPCOM1 ;SWOP SECOND AND THIRD ENTRIES FPSWOP23: LD C,-5 LD DE,-10 JR SWOPCOM2 ;SWOP TOP AND SECOND ENTRIES SWOP12: LD C,-5 SWOPCOM1: LD DE,-5 SWOPCOM2: LD B,D ;B=FF LD HL,(STKEND) ADD HL,DE LD D,H LD E,L ;DE=STKEND-5 (SWOP12 AND SWOP13) OR -10 (SWOP23) ADD HL,BC ;HL=STKEND-10 (SWOP12) OR -15 (SWOP13 AND SWOP23) ;FP "SWOP" ENTERS HERE - ;BINARY OP, SO HL AND DE PT TO STKEND-10 AND STKEND-5 FPSWOP: LD B,5 ;SWOP 5 BYTES FPSWOPLP: LD A,(DE) LD C,(HL) LD (HL),A LD A,C LD (DE),A INC HL INC DE DJNZ FPSWOPLP LD DE,(STKEND) RET ;PI (3.1415 ETC) IMPI: CALL SABORTER ;SKIP "PI", ABORT IF NOT RUNNING DB CALC DB STKHALFPI DB EXIT INC (HL) ;DOUBLE IT RET ;******************************************************************************* ;ITEM - RETURN DATA LIST STATUS. ;0=NO DATA LEFT TO READ IN CURRENT DATA STATEMENT ;1=NEXT ITEM IS STRING ;2=NEXT ITEM IS NUMERIC IMITEM: CALL SABORTER ;SKIP "ITEM", ABORT IF NOT RUNNING IN A,(URPORT) PUSH AF CALL ADDRDATA ;USE DATADD AND DATAPG TO LOOK AT DATA PTR LD BC,0 LD A,(HL) CP " " JR Z,IMITEM2 ;THERE IS MORE DATA IF DATADD PTS TO A SPACE ;(AFTER "DATA") CP "," JR NZ,IMITEM3 ;IF NO COMMA, DATA HAS ALL BEEN READ IMITEM2: INC C ;BC=1 ("STRING") CALL FORESP ;SKIP ANYTHING BELOW "!" CP 22H JR Z,IMITEM3 ;END IF QUOTE - STRING IMITEMLP: LD A,(HL) INC HL CALL ALPHANUM JR C,IMITEMLP ;JR IF LETTER OF NUMBER CP " " JR Z,IMITEMLP ;SPACE IS ALSO POSSIBLE IN VAR NAMES (_?) CP "$" JR Z,IMITEM3 ;STRING IF NAME ENDS IN $ INC C ;ELSE NUMERIC IMITEM3: POP AF OUT (URPORT),A JP STACKBC INCLUDE DO.SAM ;DO, LOOP, LOOP IF, EXIT IF, ON, GOSUB, ;DO.SAM DO: CALL WHUNT ;WHILE/UNTIL SR - ONLY RET HERE IF RUNNING JR C,DO3 ;JR IF WANT TO EXECUTE LOOP LINES ;ELSE SKIP TO "LOOP" ;ENTRY FOR EXIT IF DO2: POP DE ;NEXT STAT RET ADDR LD DE,0D4D5H ;DOTOK/LOOPTOK CALL SEARCH DB 9 ;"Missing LOOP" ;STACK A RETURN ADDR AND EXECUTE LINES IN THE DO-LOOP DO3: LD B,80H ;MASK TO SET BIT 7 OF PAGE - SHOW "DO" DATA ;MAKE BASIC STACK ENTRY (TYPE/PAGE, ADDR (OF LINE START), STAT) ;ENTRY WITH B=TYPE BYTE, FROM GOSUB OR PROC, OR DO (SEE ABOVE) ;BITS 7-5: 100=DO, 010=PROC, 000=GOSUB ;EXIT: HL PTS TO STACKED SUBPPC (GOSUB/PROC INCS IT) BSTKE: LD HL,(BSTKEND) LD DE,-4 ;SPACE NEEDED ADD HL,DE ;FIND NEW BSTKEND. CY LD DE,(HEAPEND) ;LOWER IN MEM THAN STACK - END OF USER CODE SBC HL,DE ;END-(LIM+1) - BSTK CANNOT COME AS FAR DOWN AS HEAP JR NC,BSTKOK BSFERR: RST 08H DB 41 ;"BASIC stack full" BSTKOK: ADD HL,DE INC HL LD A,(CLAPG) AND 1FH OR B ;MARK FOR TYPE LD (HL),A ;TYPE/PAGE LD A,(SUBPPC) LD DE,(CLA) SEDA: LD (BSTKEND),HL ;BSTKEND IS NOW 4 BYTES LOWER INC HL LD (HL),E INC HL LD (HL),D INC HL LD (HL),A RET LOOPIF: CALL SYNTAX6 CALL TRUETST ;DISCARD AND TEST TRUE/FALSE. RET Z ;NEXT STAT IF FALSE SCF JR LOOP1 ;UNSTACK "DO" RET ADDR, LOOP EXITIF: CALL SYNTAX6 CALL TRUETST ;DISCARD AND TEST TRUE/FALSE. NC RET Z ;NEXT STAT IF FALSE CALL LOOP1 ;UNSTACK "DO" RET ADDR, DON"T LOOP JR DO2 ;SKIP TO LOOP LOOP: CALL WHUNT ;ASSESS WHILE/UNTIL LOOP1: EX AF,AF' ;SAVE LOOP/NO LOOP AS C/NC (ALWAYS NC IF "EXIT IF", ;ALWAYS CY IF LOOP IF) LD B,80H ;"DO" TYPE CALL RETLOOP ;GET C=STAT, HL=ADDR, NZ IF ERROR, A=PAGE JR Z,LOOP2 RST 08H DB 10 ;"LOOP without DO" LOOP2: EX AF,AF' RET NC ;RET TO "NEXT STAT" IF "NO LOOP" ;RET IS TO "EXIT IF" IF CALLED FROM THERE. EX AF,AF' ;PAGE ;USED BY RETURN, END PROC, LOOP, NEXT. ESSENTIALLY A "GOTO" STAT IN LINE AT AHL. ;ENTRY: A=PAGE, HL=ADDR OR 00XX IF ELINE, C=STAT. RLEPCOM: POP DE ;JUNK NEXT STAT RET ADDR INC H DEC H JP Z,LOOPEL ;JP IF LOOPING BACK TO ELINE (ADDR MSB=0) ;(NSPPC WILL BE SET BY FROM C, ;PAGE WILL BE SET TO ELINEP, CHAD BY SKIP STATS) AND 1FH ;FROM PROCS: RLEPC2: LD B,C PUSH BC ;B=STAT CALL SELURPG JP RLEPI ;USE HL AS LINE START, A AS CHAD/CLA/NXTLN PAGE, ;(SP) AS STAT ;******************************************************************************* ;ON VALUE: STAT1: STAT2: STAT3 ON: CALL SYNTAX6 CALL GETBYTE LD D,A LD HL,SUBPPC ADD A,(HL) LD (HL),A ;ADJ SUBPPC BY VALUE RST 18H ;HL=CHAD CALL SKIPS0 ;SKIP D STATS RET C ;RET IF HIT END OF LINE - NEXT STAT ->NXT LINE RST 18H ;PT TO ":" PUSH HL RST 20H ;A=FIRST SIGNIF CHAR IN STAT POP HL ;":" PTR CALL ALPHA JR C,ON2 ;JR IF LETTER - IT"S A PROC CP 0B5H ;GOSUBTOK JR NZ,ON3 ;JR UNLESS "GOSUB" ;PROCS AND GOSUBS MUST RETURN TO NEXT LINE AFTER EXECUTING ON2: LD (CHAD),HL ;PT TO ":" LD HL,(NXTLINE) LD (CLA),HL ;MAKE IT LOOK AS THOUGH WE ARE AT NEXT LINE LD HL,SUBPPC LD A,(HL) LD (ONSTORE),A ;SAVE SUBPPC, WHICH WILL BE ZERO AFTER INCR ;ANY ERRORS WILL GIVE SENSIBLE STAT NO. BECAUSE ;ERROR HANDLER USES (ONSTORE) IF STAT NO=00. THIS LD (HL),255 ;WILL BE INCED TO ZERO. GOSUB/PROCS WILL THINK ;WE ARE AT A STAT ZERO, NEXT LINE, AND WILL RETURN ;TO STAT 1, NEXT LINE RET ;TO NEXT STAT ON3: POP DE ;NEXT STAT CP 0B4H ;GOTOTOK JR Z,ON4 ;GOTO KEEPS DE AS NEXT STAT ADDR LD DE,OLNEND ;ELSE USE LINEEND SO ONLY 1 STAT EXECUTED ON4: CP ":" ;SEE IF NULL STATEMENT JP NZ,ON4ENT ;PUSHES DE (NEXT STAT OR LINE END),EXECUTES STAT. ;RETURN GOES TO LINE END UNLESS GOTO WAS USED EX DE,HL JP (HL) ;NULL STAT (:) JPS TO LINE END GOTO2: CALL GETINT LD A,H INC A GTERRHP: JP Z,IOORERR ;RANGE 0-65279 (0000-FEFFH) GOTO3: XOR A ;STAT NO. ZERO GOTO4: LD (NSPPC),A LD (NEWPPC),HL RET CONTINUE: CALL CHKEND CONTINUE2: LD A,(OSPPC) LD HL,(OLDPPC) JR GOTO4 ;CALBAS - CALL BASIC SUBROUTINE FROM MACHINE CODE ;ENTRY: HL=LINE TO CALL. ;EXIT: Z IF OK, ELSE A=ERROR NUMBER CALBAS: CALL GOTO3 ;LD (NEWPPC),HL: ZERO (NSPPC) LD B,A ;TYPE/PAGE=GOSUB/PAGE 0 DEC A LD (SUBPPC),A ;"STATMENT" FF SHOWS M/C IN A,(251) PUSH AF CALL BSTKE ;STACK RETURN ADDR, STAT FFH. INSTEAD OF DOING A ;BASIC RETURN, "RETURN" CAUSES RET TO ERR HANDLER. CALL SETESP ;SET ERRSP SO ERRORS RETURN TO THIS ROUTINE CALL NEXTSTAT ;RUN LINE. NORMAL BASIC STACK AT "NEXTSTAT" HOLDS ;MAINER ADDR, WITH ERRSP POINTING TO IT. NOW ERRSP ;PTS TO THIS ROUTINE POP HL LD (ERRSP),HL ;RESTORE ORIG. POP AF OUT (251),A ;ORIG URPAGE LD A,(ERRNR) AND A RET RETURN: CALL CHKEND LD B,0 ;"GOSUB" TYPE CALL RETLOOP ;GET RET ADDR JR NZ,RWGERR ;HL=LINE ADDR, A=TYPE/PAGE, C=STAT, Z IF TYPE OK INC C ;RETURN TO *NEXT* STAT JR NZ,ENDP1 ;STAT IS ONLY 0FFH IF CALL CAME FROM M/C POP BC RET ;TO ERROR HANDLER (M/C) RWGERR: RST 08H DB 8 ;"RETURN without GOSUB" ENDPROC: CALL CHKEND CALL DPRA ;GET RET ADDR. C=STAT, HL=ADDR, A=PAGE PUSH HL PUSH BC PUSH AF CALL DELOCAL POP AF POP BC POP HL ;FROM RETURN, IF TYPE OK ENDP1: LD B,A LD A,(ONERRFLG) ;T BIT,000000,P BIT RRA JR NC,ENDP2 ;JR IF "ON ERROR" PERM OFF LD A,81H ;END PROC/RETURN RESET TEMP ERROR BIT TO PERM ;STATUS SO ERROR PROC OR SR EASY. LD (ONERRFLG),A ;TEMP AND PERM NOW ON ENDP2: LD A,B JP RLEPCOM ;USE HL AS LINE ADDR, A AS PAGE, C AS STAT ;WHILE/UNTIL SR OF DO AND LOOP COMMANDS WHUNT: CP WHILETOK JR Z,WHUNT2 CP UNTILTOK SCF JR Z,WHUNT2 POP HL ;RET ADDR IN DO OR LOOP ROUTINE CALL RUNFLG RET NC ;NEXT STAT IF SYNTAX TIME - CHECK "DO" OR "LOOP" JP (HL) ;RET WITH C IF NO QUALIFIERS (NO WHILE OR UNTIL) WHUNT2: PUSH AF ;WHILE/UNTIL FLAG CALL SEXPT1NUM ;SKIP WHILE/UNTIL, GET EXPR CALL RUNFLG JR NC,WHUNT3 ;GOTO NEXT STAT NOW IF SYNTAX TIME CALL TRUETST ;DROP AND TEST EXPR. JR Z,WHUNT4 ;JR IF FALSE POP AF ;IF TRUE AND UNTIL, NC CCF ;IF TRUE AND WHILE, C RET WHUNT3: POP AF ;ENTRY TO JUNK FLAG, RET ADDR, RET TO NEXT STAT WHUNT4: POP AF ;IF FALSE AND UNTIL, C RET ;IF FALSE AND WHILE, NC ;IF CALLED FROM LOOP, C MEANS EXECUTE THE LOOP, ELSE CONTINUE ;IF CALLED FROM DO , C MEANS EXECUTE DO, ELSE FIND LOOP AND JP THERE ;RETURN/LOOP SR. ENTRY: B=DESIRED TYPE OF DATA TO UNSTACK FROM BASIC STACK. ;80H=DO, 40H=PROC, 00=GOSUB ;EXIT: A=STAT NR, HL=ADDR OF LINE, C=TYPE/PAGE ;IF ENTRY WAS AT RETLOOP, NZ=WRONG TYPE/EMPTY STACK, Z=OK RETLOOP: LD HL,(BSTKEND) LD A,(HL) ;TYPE/PAGE AND 0E0H ;ISOLATE TYPE BITS CP B RET NZ ;RET IF WRONG TYPE OR STACK MT (FF STOPPER) RETLOOP2: LD A,(HL) ;TYPE/PAGE INC HL LD E,(HL) INC HL LD D,(HL) ;ADDR INC HL LD C,(HL) ;STAT INC HL LD (BSTKEND),HL EX DE,HL RET ;FIND LINE NO. "HL" (OR "BC", WITH LATER ENTRY) ;STARTS SEARCH AT PROG, OR IF RUNNING AND TARGET IS AT OR PAST EPPC, SEARCHES ;FROM CURRENT LINE (PPC) ADDRESS. USES HL,DE,BC,AF, *TEMPW1* ;ENTRY:HL=LINE NO. ;EXIT: HL PTS. TO LINE NO. MSB IN PROGRAM, DE PTS TO PREVIOUS LINE. DE IS IN ;8000-BFFF AREA, HL MIGHT HAVE CROSSED IN TO C000 BY A LINE LEN OR SO. ;IF NO PROGRAM, DE=HL ; Z=LINE FOUND ;NZ=FOUND A LATER LINE, OR FF STOPPER FNDLNHL: LD B,H LD C,L FNDLNBC: CALL RUNFLG JR NC,FNDLP ;JR IF NOT RUNNING (E.G. EDITING) LD HL,(PPC) DEC HL ;SO CY IF PPC=TARGET AND A SBC HL,BC JR NC,FNDLP ;JR IF DESIRED LINE IS BEFORE CURRENT LINE ;(ALWAYS, IF PPC=FFFF (ELINE)) LD HL,(CLA) ;START LOOKING FROM PPC LINE START LD A,(CLAPG) ;NEEDED? OR USE JR+2 JR FNDL0 ;ENTRY HERE IF WANT TO INSIST ON STARTING AT PROG (RENUM) FNDLINE: LD B,H LD C,L FNDLP: LD HL,(PROG) LD A,(PROGP) FNDL0: CALL TSURPG ;SWITCH IN A PROGRAM BLOCK LD (TEMPW1),HL ;KEEP PTR TO LINO MSB JR FNDL2 FNDL1: BIT 6,H CALL NZ,INCURPAGE LD (TEMPW1),HL ;KEEP PTR TO LINO MSB INC HL INC HL LD E,(HL) INC HL LD D,(HL) INC HL ADD HL,DE ;ADD LINE LEN TO PT TO NEXT LINE NO. FNDL2: LD A,(HL) ;GET MSB OF LINE NO. CP B ;CP MSB OF TARGET JP C,FNDL1 ;JP IF NOT AT OR PAST TARGET LINE YET JR NZ,FNDL3 ;JR IF MSB SHOWS WE ARE PAST TARGET LINE NO. INC HL LD A,(HL) ;LSB DEC HL CP C JP C,FNDL1 ;JP IF LSB SHOWS WE ARE NOT AT TARGET YET FNDL3: LD DE,(TEMPW1) RET ;IF.SAM - 2.3.89 ;******************************************************************************* ;E.G. IF x=1 THEN PRINT ; IF X=1 THEN PRINT "Y": ELSE PRINT "N" ; IF X=1: PRINT: PRINT: END IF ;BOTH LONG AND SHORT IFS COME HERE LIF: SIF: LD HL,(CHAD) SIFLP: DEC HL LD A,(HL) CP 21H JR C,SIFLP ;PT HL TO CMD CODE PUSH HL CALL EXPT1NUM POP HL LD (IFTYPE),A ;RECORD LAST IF TYPE AS SHORT/LONG USING ; "THEN"/NON "THEN" ;(IF TYPE IS SET TO "LONG" AT START OF LINE ;SYNTAX CHECK) CP THENTOK LD D,A JR NZ,IFL1 ;JR IF NOT "THEN" (SHOULD BE ":") LD (HL),0D8H ;SIFTOK ;AT LINE ENTRY, I-F IS TOKENISED AS THE "LIF" ;TOKEN BECAUSE IT OCCURS FIRST IN TOKEN LIST ;(LIF TOKEN LISTS AS I-F, LIKE THE IF TOKEN) ;NOW FORCE TOKEN TO "SIF" BECAUSE "THEN" USED. IFL1: CALL CHKEND ;IF SYNTAX CHECK, CHECK FOR OD/:/THEN, EXIT CALL TRUETST ;DROPS EXPR AND TESTS IT RET NZ ;RET IF TRUE, DO NEXT STATMENT (FPCS IS CLEARED) POP BC ;NEXT STAT LD A,D CP THENTOK JR Z,SHORTIF ;IF SHORT AND NOT TRUE, LOOK FOR ELSE OR CR EIFLP: EXX LD BC,0FF00H+0D9H ;LELSETOK EXX ;WHOLE PROG (OR ELINE), TARGET 2 RELOAD=LELSE LD BC,0100H+0D9H ;LELSETOK. COUNT=1, TARGET2=LELSE LD DE,0D7DBH ;LIFTOK/ENDIFTOK ;LOOK FOR LELSE OR ENDIF WITH LIF INTERVENING CALL SRCHALL3 JR NC,MEIERR ;ERROR IF NEITHER WAS FOUND LD (SUBPPC),A ;STAT EX AF,AF' ;FINAL TARGET CP E ;WAS IT "END IF"? JP Z,XCHDH ;IF IT WAS, CONTINUE AFTER "END IF" RST 18H CP 0D8H ;SIFTOK JP NZ,XCHDH ;JP IF "LELSE", NOT "LELSE SIF"; CONTINUE AFTER ;"LELSE" CALL SEXPT1NUM ;SKIP "SIF", EVAL CONDITION CALL TRUETST JR Z,EIFLP ;IF FALSE, KEEP LOOKING FOR ENDIF/LELSE XCHDH: JP EXCHAD2 ;IF TRUE, CONTINUE AFTER "ELSE IF cond" MEIERR: RST 08H DB 39 ;"Missing END IF" SHORTIF: EXX LD BC,THENTOK ;ONE LINE SRCH, NULL TARGET2 RELOAD EXX LD DE,0D8DAH ;SIFTOK/ELSETOK ;LOOK FOR "ELSE" WITH SIF "INTERVENING" CALL SRCHALL2 JP NC,LINEEND ;JP TO LINE END IF NO "ELSE" FOUND LD (SUBPPC),A JP STMTLP2 ;JP TO NEXT STATEMENT, JUST AFTER "ELSE" ;(CHAD, CLA, NXTLINE STILL OK - SAME LINE) ;E-L-S-E IS TOKENISED AS LELSE TOKEN BECAUSE IT APPEARS FIRST IN LIST LELSE: LD C,A ;CHAR AFTER "ELSE" CALL RUNFLG JR C,RLELSE ;JR IF RUNNING A LONG ELSE LD HL,(CHAD) FELSLP: DEC HL LD A,(HL) CP 21H JR C,FELSLP ;PT TO CMD CODE LD A,(IFTYPE) CP THENTOK JR Z,NLELS ;JR IF "SHORT" STATUS LD A,C SUB 0D8H ;SIFTOK ADC A,0 ;SIF/LIF BOTH BECOME 0 JR NZ,ELSE2 ;CHECK SYNTAX AFTER "LELSE" LD HL,(CHAD) LD (HL),0D8H ;"LELSE LIF" BECOMES "LELSE SIF" CALL SEXPT1NUM ;EVAL condition CP THENTOK RET NZ ;TO CHECK SYNTAX OF NEXT STATEMENT DNS: RST 08H ;"LELSE SIF cond THEN" NOT ALLOWED AS IT DB 29 ;WILL WORK IN A CONFUSING WAY NLELS: LD (HL),0DAH ;ELSETOK ;FORCE "SHORT ELSE" IF "SHORT IF" PRECEDED IT. ;(THERE WAS A PRECEDING "SHORT IF" ON THIS LINE) JR ELSE2 ;CHECK SYNTAX FROM CHAD ON ;LONG ELSE REQUIRES A SEARCH FOR ENDIF, WITH LIF INTERVENING RLELSE: POP DE ;JUNK NEXT STAT ** BUG FIX LD DE,0D7DBH ;LIFTOK/ENDIFTOK CALL SEARCH ;LOOK FOR "ENDIF" WITH LIF "INTERVENING" DB 0 ;"OK" IF NOT FOUND ;SHORT ELSE - SHOULD ALWAYS BE RUNNING! ELSE: CALL RUNFLG JP C,REMARK ;JP, SKIP REST OF LINE IF RUNNING A SHORT ELSE ELSE2: POP BC ;NEXT STAT JP STMTLP2 ;CHECK SYNTAX FROM CHAD ONWARDS WITHOUT ;REQUIRING CR/COLON ;DROP EXPRESSION FROM FPCS, TEST FOR TRUE/FALSE TRUETST: LD HL,(STKEND) ;PT TO END OF RESULT OF THE EXPRESSION DEC HL DEC HL LD A,(HL) ;MSB IF INTEGER DEC HL OR (HL) ;LSB DEC HL OR (HL) ;SGN - PROB NOT NEEDED IF MINUS ZERO EXCLUDED! DEC HL OR (HL) ;EXP. LD (STKEND),HL ;"DISCARD" ;NZ IF TRUE, DO NEXT STATMENT (FPCS IS CLEARED) ENDIF: RET ;DOES NOTHING - ACTS AS A MARKER ONLY ;FOR.SAM 26.5.89 ;******************************************************************************* FOR: CALL SYNTAX4 ;ASSESS FOR-VARIABLE RST 18H CP "=" JR NZ,DNS ;NONSENSE CALL SEXPT1NUM ;START VALUE CP TOTOK JP NZ,DNS ;NONSENSE CALL SEXPT1NUM ;LIMIT CP STEPTOK ;"STEP" JR Z,FORSTEP CALL CHKEND DB CALC DB STKONE ;DEFAULT STEP OF 1 DB EXIT INC D ;NZ FORSTEP: CALL Z,SSYNTAX6 ;GET THE STEP VALUE ;VALUE/LIMIT/STEP ON FPCS FOR2: RST 18H PUSH AF ;CR OR COLON CALL SWOP12 ;V/S/L CALL FPSWOP13 ;L/S/V LD HL,TLBYTE+33 SET 6,(HL) ;"FOR-NEXT" TYPE MARKED ON T/L BYTE CALL ASSISR ;IF NORMAL VAR EXISTS, DEST PTS TO PREV PTR, AND ;FLAGX BIT 0 SHOWS "NEW", SO VAR IS "LINKED OUT" ;ASSIGNS V TO FIRST 5 LOCNS. DE PTS AFTER ;THESE ON EXIT (14 EXTRA LOCATIONS AVAILABLE IF ;"OLD" FOR-NEXT, ELSE NUMEND IS PAST VAR, NEEDS ;MOVING 14 ON) LD HL,(STKEND) LD BC,10 AND A SBC HL,BC LD (STKEND),HL ;DELETE L,S LDIR ;COPY TO VARIABLE BUFFER TO GIVE V,L,S POP AF ;STAT END CHAR PUSH DE DEC DE EX DE,HL ;SRC=END OF S LD DE,MEMVAL+14 LD C,15 LDDR ;COPY V,L,S TO MEM 0,1,2 FOR NEXTTEST TO USE CP 0DH JR Z,FOR22 ;JR IF LOOPING ADDRESS IS ON NEXT LINE LD A,(SUBPPC) INC A LD C,A LD A,(PPC+1) INC A LD H,A JR Z,FOR25 ;JR IF ELINE LD HL,(CLA) ;ELSE THIS LINE, NEXT STAT JR FOR25 FOR22: LD HL,(NXTLINE) LD C,1 ;FIRST STATEMENT FOR25: EX DE,HL POP HL ;VARS PTR LD A,(NXTLINEP) ;PAGE OF CURRENT LINE (SAME AS CLAPG) LD (HL),A ;ORDER CHANGE VS. ROM 1.0** INC HL LD (HL),E INC HL LD (HL),D ;LINE ADDRESS INC HL LD (HL),C ;STAT INC HL LD A,(FLAGX) RRA EX DE,HL CALL C,NELOAD ;SET NUMEND IF "NEW" VARIABLE CALL NEXTTEST RET NZ ;RET IF A LOOP IS POSSIBLE CALL SELCHADP FORMLP: LD E,0C1H ;NEXTTOK CALL SRCHPROG ;LOOK FOR "NEXT" FROM CHAD ONWARDS JR C,FOR3 ;JR IF ONE FOUND RST 08H DB 6 ;"FOR without NEXT" FOR3: LD (SUBPPC),A ;STAT LD DE,TLBYTE+33 CALL MATCHFN ;CHECK (HL) VS (TLBYTE+33) OVER T/L+1 BYTES JR C,FORMLP ;LOOP IF THE WRONG NEXT VARIABLE LD (CHAD),DE ;SKIP var - DE PTS TO PAST VAR NAME POP DE ;JUNK NEXT STAT JP EXCHAD2 ;CONTINUE EXECUTION AFTER "NEXT var" NWFERR: RST 08H DB 5 ;"NEXT without FOR" ;******************************************************************************* NEXT: CALL SYNTAX4 ;ASSESS "FOR" VARIABLE CALL CHKEND CALL BRKSTOP ;TEST FOR BREAK (RLEPCOM BELOW AVOIDS NORMAL ;BETWEEN-STATEMENT TEST) LD A,(STRLEN) ;TYPE BYTE (FROM NVARS, IF VAR FOUND) AND 40H ;BIT 6 SET=FOR-NEXT TYPE, FOUND JR Z,NWFERR ;5 BYTE VALUE, 5 BYTE LIMIT, 5 BYTE STEP ;2 BYTE ADDRESS, 1 BYTE PAGE, 1 BYTE STAT. NO. CALL ADDRDEST ;PT TO VALUE CALL NEXTSR JR Z,NEXT1 ;JR IF INTEGER MATHS ALREADY DONE LD HL,(DEST) PUSH HL LD DE,(MEM) LD BC,15 LDIR ;COPY VAR TO CALC MEMS 0,1,2 DB CALC DB RCL0 ;V DB RCL2 ;V,S DB ADDN ;V+S DB STOD0 DB EXIT EX DE,HL ;HL PTS TO DROPPED NEW V POP DE LD BC,5 LDIR ;COPY NEW V BACK TO VARS CALL NEXTTEST RET Z ;RET IF "NO LOOP" DB 21H ;="JR +2" NEXT1: AND A RET Z ;RET IF INTEGER MATHS SHOWS "NO LOOP" LD DE,15 LD HL,(DEST) ADD HL,DE LD A,(HL) ;A=PAGE OF LOOPING LINE ** INC HL LD E,(HL) INC HL LD D,(HL) ;DE=ADDR OF LOOPING LINE (8000-BFFF) OR ;00?? IF ELINE IS THE LOOPING LINE INC HL LD C,(HL) ;LOOPING STATMENT NO. EX DE,HL ;HL=ADDR, A=PAGE, C=STAT JP RLEPCOM ;GOTO STAT C IN LINE AT AHL ;CHECK TO SEE IF "LIMIT" HAS BEEN EXCEEDED BY "VALUE" NEXTTEST: DB CALC DB RCL0 DB RCL1 DB RCL2 ;V,L,S DB GRTR0 ;V,L,TRUE/FALSE DB JPTRUE DB 02H ;TO NEXTTST1 DB SWOP ;SWOP IF STEP IS NEGATIVE NEXTTST1: DB SUBN ;V-L IF +VE STEP DB SGN DB DROP DB EXIT INC DE ;DE PTS TO DROPPED SGN(V-L) (OR L-V) SGN BYTE INC DE LD A,(DE) DEC A ;SGN IS -1/0/1 SO A=1 IF SGN 1, ELSE 00 OR FF RET ;NZ IF LOOP POSSIBLE, Z IF NOT (SGN=+VE) ;******************************************************************************* ;NEXT SUBROUTINE ;ENTRY: HL AND TEMPW1 PTS TO FIRST BYTE OF FOR-NEXT VARIABLE ;EXIT: NZ="USE FLOATING POINT". Z=INTEGER MATH DONE. A=00 IF NO LOOP, OR FF NEXTSR: XOR A CP (HL) RET NZ ;RET IF VALUE=FP INC HL LD B,(HL) INC HL LD E,(HL) INC HL LD D,(HL) ;DE=VALUE, B=SGN OF VALUE INC HL INC HL CP (HL) RET NZ ;RET IF LIMIT=F.P. INC HL INC HL INC HL INC HL INC HL CP (HL) RET NZ ;RET IF STEP=F.P. INC HL LD A,(HL) EX AF,AF' ;A AND A"=SGN OF STEP LD A,(HL) INC HL LD C,(HL) INC HL LD H,(HL) LD L,C ;HL=STEP ADD HL,DE ;ADD STEP, VALUE ADC A,B ;ADD SGN STEP,SGN VALUE,CARRY FLAG RRCA ADC A,0 RET NZ ;RET IF OVERFLOW OF INTEGER MATHS SBC A,A ;A=SGN OF NEW VALUE EX DE,HL ;DE=NEW VALUE LD HL,(DEST) INC HL ;SKIP 00 LD (HL),A ;PLACE SGN LD B,A ;B=SGN OF NEW VALUE INC HL LD (HL),E INC HL LD (HL),D ;PLACE NEW VALUE INC HL INC HL INC HL LD A,(HL) ;A=SGN OF LIMIT INC HL LD C,(HL) INC HL LD H,(HL) LD L,C ;HL=LIMIT XOR B ;XOR SGN OF LIMIT,SGN OF VALUE JR NZ,NEXTSR1 ;JR IF THEY DO NOT MATCH DEC A ;A=FF ("LOOP") SBC HL,DE RET Z ;RET IF LIMIT=VALUE - LOOP SBC A,A CPL ;A=00 IF C, FF IF NC LD B,A ;B=LOOP/NO LOOP NEXTSR1: EX AF,AF' ;A=SGN OF STEP XOR B ;REVERSE LOOP/NO LOOP DECISION IF SGN NEWVAL=-VE CP A ;SET Z ("INTEGER MATHS DONE") RET ;RET WITH LOOP/NO LOOP (FF/00) ONERROR: POP HL ;NEXT STAT CALL RUNFLG JP NC,STMTLP1 ;CHECK SYNTAX FROM CHAD ONWARDS PUSH HL RST 18H CP 0B1H ;STOPTOK JR NZ,ONERR2 RST 20H ;SKIP "STOP" XOR A ;"OFF" JR ONERR3 ONERR2: LD HL,(PPC) LD (ERRLN),HL LD A,(SUBPPC) LD (ERRSTAT),A PUSH HL CALL SKIPCSTAT POP AF INC A JR Z,ONERR3 ;OFF IF "ON ERROR" USED IN ELINE LD A,81H ;TEMP/PERM BITS ARE "ON" (BITS 7/0) ;IF AN ERROR OCCURS NOW, ERRSTAT/LN ARE USED TO ;FIND "ON ERROR" AND DO WHAT IT SAYS ONERR3: LD (ONERRFLG),A RET ;RETURN, END PROC, FNDLNHL, IF, ELSE ;CALBAS, FOR, NEXT INCLUDE TADJM.SAM ;KEYSCAN, FPSTACK, SETMIN, SEARCH ;TADJM.SAM NMISTOP: LD SP,ISPVAL LD DE,MAINER PUSH DE LD (ERRSP),SP RST 08H DB 15 ;"BREAK into program" ;GET KEY FROM BUFFER (ACTUALLY, LASTK). NZ=GOT KEY IN A, ELSE A=0 GETKEY: CALL KEYRD RET Z ;RET IF NO KEY - Z JR KBF2 ;USED BY INKEY$ READKEY: RST 30H DW TWOKSC JR Z,RKY2 ;JR IF GOT CODES IN DE XOR A RET ;RET IF NO KEY - Z,NC RKY2: RST 30H DW KYVL ;USE DE TO GET KEYMAP CODE IN A AND A ;NZ SCF ;"GOT KEY" KBFLUSH: LD HL,0 LD (KBQP),HL ;EMPTY QUEUE KBF2: LD HL,FLAGS RES 5,(HL) ;"NO KEY" RET KEYRD: RST 30H DW KEYRD2 LD A,(FLAGS) AND 20H ;Z IF NO KEY LD A,(LASTK) JR KBF2 ;SHOW "NO KEY" IN CASE WE GOT ONE ;FPSTACK.SAM - FPCS SUBROUTINES ;STACKA - STACK "A" REGISTER ON FPCS. EXIT WITH DE=STKEND ;STACKBC - DITTO WITH BC ;STACKHL - DITTO WITH HL STACKHL: LD D,L LD C,H JR STACKCM STACKA: LD B,0 LD C,A STACKBC: LD D,C LD C,B STACKCM: XOR A ;NC LD B,A LD E,A ;ENTRY FROM TRUNC$ STKSTOREX: CALL STKSTORE EX DE,HL ;DE=STKEND RET ;STORE A STRING. DE=START, BC=LEN. PAGE IS ASSUMED TO BE SWITCHED IN STKSTOREP: IN A,(251) ;STACK-STORE STKST0: AND 7FH ;BIT 7=0 IF ARRAY OR "SLICED". BITS 4-0=START PAGE STKSTOS: LD HL,FLAGS RES 6,(HL) ;STRING RESULT STKSTORE: LD HL,(STKEND) LD (HL),A ;PAGE AND FLAG IF STRING, EXPONENT IF FP NUMBER INC HL LD (HL),E ;E=SIGN IF SMALL INTEGER INC HL LD (HL),D ;START IF STRING INC HL LD (HL),C ;CD=INTEGER IF SMALL INTEGER INC HL LD (HL),B ;LEN IF STRING INC HL LD (STKEND),HL RET STKFETCH: LD HL,(STKEND) DEC HL LD B,(HL) DEC HL LD C,(HL) DEC HL LD D,(HL) DEC HL LD E,(HL) DEC HL LD A,(HL) STSTKE: LD (STKEND),HL RET ;FASTER DELETE-TOP-OF-FPCS. TO BE CALLED! THIS IS NOT A FPCS FUNCTION! ;EXIT: HL PTS TO DELETED NUMBER. FDELETE: LD HL,(STKEND) LD A,L SUB 5 LD L,A LD (STKEND),A RET NC ;ALWAYS RETS ON STANDARD SAM... DEC H JR STSTKE HLTOFPCS: LD BC,5 LD DE,(STKEND) LDIR LD (STKEND),DE RET ;GET FPCS INTEGER TO BC AND HL. A=C. IOOR IF TOO BIG OR -VE GETINT: CALL FPTOBC JR GETIBC ;GET FPCS BYTE TO A AND C. IOOR IF TOO BIG OR -VE GETBYTE: CALL FPTOA GETIBC: JR C,IOORERR RET Z ;RET IF +VE IOORERR: RST 08H DB 30 ;"Integer out of range" ;COMPRESS TOP OF FPCS TO BC AND HL. CY IF TOO BIG, NZ IF -VE. A=C FPTOBC: LD HL,(STKEND) LD BC,-5 ADD HL,BC LD A,(HL) AND A ;NC JR Z,FPBCINT DB CALC DB STKHALF DB ADDN DB INT ;CHANGES FORM TO INTEGER IF POSSIBLE DB EXIT FPBCINT: LD (STKEND),HL ;"DELETE" XOR A SUB (HL) ;NC IF SMALL INTEGER FORM (ELSE IOOR) INC HL BIT 7,(HL) ;SET NZ IF -VE INC HL LD C,(HL) INC HL LD B,(HL) LD A,C LD H,B LD L,C RET Z ;RET IF +VE RET C ;RET IF OUT OF RANGE SBC HL,HL ;HL=0 SBC HL,BC ;NEGATE BC. RESULT NZ, CY CCF LD B,H LD C,L LD A,C RET ;NEGATED RESULT IN HL/BC. C=A. NZ, NC ;COMPRESS TOP OF FPCS TO A (AND C). CY IF TOO BIG, NZ IF -VE. FPTOA: CALL FPTOBC RET C EX AF,AF' INC B ;INC B WITHOUT ALTERING THE FLAGS EX AF,AF' DJNZ FPTOA2 ;JR IF B<>0 - SIGNAL OUT OF RANGE (CY) RET FPTOA2: SCF RET ;CALLED BY MAINER, INIT SETMIN: IN A,(URPORT) PUSH AF CALL ADDRELN CALL SETKC2 ;SET KCUR LD (HL),0DH INC HL LD (HL),0FFH INC HL LD (WORKSP),HL ;CLEAR ELINE LD (WORKSPP),A POP AF OUT (URPORT),A SETWORK: LD HL,(WORKSP) LD A,(WORKSPP) LD (WKEND),HL LD (WKENDP),A ;CLEAR WORKSPACE SETSTK: LD HL,(FPSBOT) LD (STKEND),HL ;CLEAR FLOATING POINT CALC STACK RET ;SEARCH PROGRAM. CALLED TO FIND DEF FN AND DATA. ;ENTRY: E=TARGET, CHAD PTS TO START SRCHPROG: LD D,THENTOK ;NULL INTERVENING SEARCHALL: EXX LD BC,0FF00H+THENTOK ;ALL PROGRAM/NULL TARGET2 RELOAD EXX SRCHALL2: LD BC,0100H+THENTOK ;NO INTERVENING/NULL TARGET2 SRCHALL3: RST 18H ;START AT CHAD LD A,(SUBPPC) ;STAT NO FOR A" JR FINDERS ;ENTRY AT "FINDER" OR "FINDERS" (WITH A=CURRENT STAT NO) ;B=1 FOR NO INTERVENING TOKENS. ;D=INTERVENING TOKS OR "THEN" FOR NULL, E=TARGET, C=TARGET2 (LESLE OR NULL) ;HL PTS TO START ;C"=TARGET 2 RELOAD, B"=ONE LINE/ALL PROG ;EXIT: CY=FOUND JUST BEFORE HL/(CHAD) AT STAT. A FINCSTAT: EX AF,AF' ;INC STATEMENT NO. IN A" INC A FINDERS: EX AF,AF' JR FINDER FSKIP5: INC HL FSKIP4: INC HL INC HL INC HL INC HL FINDER: LD A,(HL) INC HL CP 0EH JR Z,FSKIP5 ;SKIP FP FORMS CP 0DH JR Z,FINDER5 ;JR IF LINE END CP 0B7H ;REMTOK JR Z,FREMARK ;AVOID PROBLEMS FROM EG SINGE QUOTE IN REMS CP 22H ;QUOTE JR Z,FQUOTE CP ":" JR Z,FINCSTAT ;INC STAT NO CP THENTOK ;IF COLON OR "THEN" JR Z,FINCSTAT CP D JR Z,FINTERV ;INC "INTERVENING" COUNT IN B IF FOUND ; E.G. "DO" OR "IF" (USE "THEN" AS NULL) ;THEN: JR FINDER4 ;TARGET2 IS NULL UNLESS LELSE/LIF ;SEARCH, AND INTERVENING COUNT SHOWS ;NO NESTED LIF-ENDIF STRUCTURES (B=1) CP C JR Z,FOUNDY ;JR IF TARGET 2 FOUND FINDER4: CP E JP NZ,FINDER ;JR IF NOT TARGET DJNZ FOUNDX ;JR IF B<>0 - DON"T ACCEPT FIND FOUNDY: LD (CHAD),HL ;PT CHAD TO TARGET LOCN+1 EX AF,AF' ;A=STAT NO. SCF ;"FOUND" RET FOUNDX: DJNZ FINDN1 ;JR IF COUNT WASN"T 1 EXX ;OR, IF IT WAS, PRIME TARGET2 TO BE NON-NULL LD A,C ;FETCH TARGET 2 RELOAD FROM C" EXX LD C,A FINDN1: INC B ;CORRECT INTERVENING COUNTER JR FINDER FREMARK: LD A,0DH FREMLP: CP (HL) INC HL JP NZ,FREMLP ;LOOP PAST REMS TO LINE END FINDER5: LD A,(HL) ;MSB OF NEXT LINE NUMBER, OR FF TERMINATOR EXX CP B ;B"=00 FOR 1 LINE SEARCH OR FF FOR WHOLE PROG EXX ;E-LINE NEEDS AN FF TERMINATOR RET NC ;RET IF FINISHED BIT 6,H CALL NZ,INCURPAGE ;INC UPPER RAM PAGE, ADJ HL, IF HL>BFFF LD (CLA),HL ;CURRENT LINE ADDR LD A,1 ;STATEMENT 1 EX AF,AF' ;IN A" JP FSKIP4 ;DO NEXT LINE FQUOTE: CP (HL) INC HL JP NZ,FQUOTE ;LOOP PAST LITERAL STRINGS JR FINDER ;HL IS PAST END QUOTE FINTERV: INC B ;INC COUNT OF TARGETS TO SKIP LD C,THENTOK ;TARGET2=NULL JR FINDER4 ;MAKE ROOM, ALLOWING NO OVERHEAD MKRMCH: XOR A PUSH HL CALL TSTRMBIG JR MKRM2 ;OPEN 1 BYTE AT HL MKRM1: LD BC,1 ;OPEN BC BYTES AT HL. BC MUST BE <4000H MAKEROOM: XOR A ;OPEN ABC BYTES AT HL. A=16K PAGES, BC=MOD 16K MKRBIG: PUSH HL ;LOCN CALL TSTRMBIG LD HL,150 SBC HL,DE JP NC,OOMERR ;INSIST ON A 150-BYTE OVERHEAD MKRM2: LD D,B LD E,C LD C,A LD A,D AND 3FH LD D,A ;CDE=ROOM. NC (SIGNALS "MAKEROOM") POP HL ;LOCN PUSH DE ;MOD 16K PUSH HL ;LOCN RST 30H DW XOINTERS ;EXIT WITH AHL=OLD WORKEND (SRC), MOD/PAGCOUNT SET LD DE,(WKEND) LD BC,(WKENDP) ;CDE=DEST (NEW WKEND) CALL FARLDDR POP DE ;LOCN POP HL ;MOD 16K ADD HL,DE EX DE,HL ;HL=LOCN DEC DE ;DE=END (IF <16K MADE) RET FNORECL: CALL FNDLINE RET NZ NORECL: CALL NEXTONE JR RECLAIM2 ;DELETE LINE FROM PROGRAM ;ENTRY WITH DE=LOCN, HL=END, DE PAGED IN RECLAIM1: CALL DIFFER ;GET BC, SWOP LOCN TO HL ;ENTRY WITH BC=BYTES TO RECLAIM AT HL (<16K) RECLAIM2: XOR A ;RECLAIM ABC BYTES AT HL. A=16K PAGES, BC=MOD 16K RECL2BIG: RES 7,B RES 6,B LD D,A OR B OR C RET Z LD A,D LD D,B LD E,C LD C,A ;CDE=SPACE PUSH BC ;PAGES PUSH DE ;MOD 16K PUSH HL ;LOCN SCF ;"RECLAIMING" RST 30H DW XOINTERS ;SETS PAG/MODCOUNT TO MOVE POP HL ;LOCN POP DE ;MOD 16K POP BC ;PAGES IN A,(251) PUSH AF PUSH HL ;LOCN BIT 6,H JR Z,RECL5 RES 6,H INC A RECL5: CALL ADDAHLCDE ;AHL=SRC POP DE POP BC LD C,B ;CDE=DEST (LOCN) PUSH DE CALL FARLDIR POP HL RET ;MAKE ROOM AT WKSPACE END, BC BYTES LONG. EXIT WITH BC=ROOM SIZE, DE=START, ;HL=END (IF ROOM <16K), A=UNCHANGED. ROOM PAGE SWITCHED IN. WKROOM: PUSH AF CALL TESTROOM ;CHECK BC BYTES OK, GET AHL=NEW WKEND LD D,A LD A,(WKENDP) CALL SELURPG ;SWITCH IN OLD WKEND LD A,D LD (WKENDP),A ;NEW WKENDP LD DE,(WKEND) ;START OF ROOM LD (WKEND),HL LD H,D LD L,E ADD HL,BC DEC HL ;END OF ROOM, IF ROOM<16K (HL MAY BE >C000) POP AF RET ;ADJUST SINGLE "SYS VAR" (ACTUALLY, FOR-NEXT OR DO/GOSUB/PROC ADDR) ;ENTRY: HL POINTS TO SVAR, CDE=LOCN, F'=CY IF RECLAIMING ASSV: PUSH HL POP IY LD B,1 PNLP: LD A,(IY+0) LD L,(IY+1) LD H,(IY+2) ;AHL=SVAR INC H DEC H JR Z,NPSV ;no adj if e.g. eline addr v2.1 ;COMPARE AHL AND CDE BIT 6,H JR Z,PNT2 ;JR IF IN SECTION C INC A RES 6,H ;ELSE ADJUST PNT2: AND 1FH CP C JR C,NPSV ;JR IF LOCN PAGE IS HIGHER, SO NO ADJ JR NZ,PADJ ;JR IF LOCN PAGE IS LOWER - ADJUST EX DE,HL SBC HL,DE ;ELSE COMPARE OFFSETS - SBC LOCN,SVAR ADD HL,DE EX DE,HL JR NC,NPSV ;DO NOT ADJUST SVAR IF IT IS <= LOCN PADJ: PUSH BC ;SAVE PTR COUNT AND LOCN PAGE PUSH DE LD BC,(TEMPW4) LD DE,(TEMPW5) ;CDE=AMOUNT TO ADJ BY EX AF,AF' JR C,PRECL ;JR IF RECLAIMING EX AF,AF' CALL ADDAHLCDE JR PNT3 PRECL: EX AF,AF' CALL SUBAHLCDE PNT3: POP DE POP BC LD (IY+0),A LD (IY+1),L LD (IY+2),H ;PLACE ADJUSTED SYS VAR NPSV: INC IY INC IY INC IY DJNZ PNLP RET ;ADJUST 'FOR' LOOPS IF LOCN C'D'E' IS BEFORE THEM AFLPS: EX AF,AF' LD C,D LD B,26 ;26 LETTER LISTS AFML: PUSH HL ;PT TO CURRENT LETTER LIST AFLL: LD E,(HL) INC HL LD D,(HL) ADD HL,DE JR C,AFLE ;JR IF THIS LIST ENDED BIT 6,(HL) JR Z,AFNF ;JR IF NOT FOR-VAR PUSH HL PUSH BC LD A,(HL) AND 1FH ;NAME LEN-1 ADD A,18 ;3 TO SKIP TO START OF VALUE, 15 FOR VLS LD E,A LD D,0 ADD HL,DE ;PT TO ADDR LD DE,(TEMPW3) ;CDE=LOCN CALL ASSV ;ADJUST SINGLE "SYSTEM VAR" POP BC POP HL AFNF: INC HL JR AFLL ;NEXT VAR OF THIS LETTER AFLE: POP HL ;THIS LIST ENDED NOW INC HL INC HL ;PT TO NEXT LIST DJNZ AFML EX AF,AF' RET ADDRDEST: LD L,>(DEST-1) JR ADDRSV ADDRNV: LD L,>(NVARS-1) JR ADDRSV ADDRNE: LD L,>(NUMEND-1) JR ADDRSV ADDRSAV: LD L,>(SAVARS-1) JR ADDRSV ADDRWK: LD L,>(WORKSP-1) JR ADDRSV ADDRKC: LD A,>(KCUR-1) DB 21H ADDRPROG: LD A,>(PROG-1) DB 21H ADDRELN: LD A,>(ELINE-1) DB 21H ;"JR+2" ;USED BY READ AND ITEM ADDRDATA: LD A,>(DATADD-1) DB 21H ;"JR+2" ADDRCHAD: LD A,>(CHAD-1) LD L,A ;LOOK AT SYS VAR LOCN. ENTRY: HL PTS TO SYS VAR (PAGE, OFFSET) ;EXIT: PAGE SELECTED, HL=OFFSET (IN SECTION C), A=PAGE ADDRSV: LD H,VAR2/256 ;FROM FN, WITH HL=DEFADDRP ASV2: LD A,(HL) CALL SELURPG INC HL LD A,(HL) INC HL LD H,(HL) LD L,A IN A,(251) AND 1FH RET NEXTONE: PUSH HL INC HL INC HL LD C,(HL) INC HL LD B,(HL) ;LINE LEN INC HL ADD HL,BC POP DE ;DE=OLD START, HL=NEXT LINE START DIFFER: AND A SBC HL,DE LD B,H LD C,L ADD HL,DE EX DE,HL RET ;ENTRY AS LIMBYTE, BUT FPCS VALUE DECED BEFORE CHECKING, RETURNED DECED. C IS ;NOT DECED LIMDB: LD A,0FFH DB 0FEH ;"JR+1" ;ENTRY: D=LIMIT (VALUE MUST BE BELOW IT), E=ERROR TO GIVE IF VALUE TOO HIGH. ;VALUE IS ON FPCS ;EXIT: A AND C=VALUE, DE=ORIG LIMBYTE: XOR A PUSH AF PUSH DE CALL FPTOA POP DE ;LIMIT/ERROR JR C,ERRORE ;JR IF >FF JR NZ,ERRORE ;JR IF -VE POP AF ADD A,C CP D RET C ERRORE: LD HL,ERRNR LD (HL),E PUSH HL ;WILL BE POPPED AND USED AS "RET ADDR" JP 0008H ;SET PAGCOUNT/MODCOUNT FROM BC (0000-FFFF) SPLITBC: PUSH AF LD A,B RES 7,B RES 6,B LD (MODCOUNT),BC ;LEN MOD 16K RLCA RLCA AND 03H LD (PAGCOUNT),A ;PAGES (0-3) POP AF RET ;GET ROOM. RETURN FREE MEMORY (UPPER RAMS) IN AHL AS A 19 BIT NO. NZ IF >=64K GETROOM: PUSH BC PUSH DE CALL WENORMAL GRM2: LD C,A EX DE,HL ;CDE=WKSPACE END CALL RTNORMAL ;AHL=RAMTOP (19 BIT) SCF SBC HL,DE SBC A,C POP DE POP BC RET ;AHL=ROOM (19BIT). NZ IF ROOM >=64K ;PAGE OVERFLOW. USED BY INSTRING, S16OP ;CALLED IF ADD HL,RR GIVES CARRY. CORRECTS THE PAGE AND ADDRESS IN HL ;ENTRY: HL=0000-BFFE (BFFE IF HL WAS BFFF+FFFF) PGOVERF: IN A,(URPORT) CALL PGOA JR PGOE ;CORRECT AHL AFTER PAGE OVERFLOW, BUT DON"T ALTER PAGING PGOA: ADD A,2 ;IF THERE WAS A CARRY, ADDR IS AT LEAST 0000 ;SO INC 2 PAGES SO ADDR CAN BE DROPPED 32K BIT 6,H ;IF BIT 6 IS HIGH WE CAN INC AGAIN JR Z,PGOA2 RES 6,H INC A PGOA2: BIT 7,H JR Z,PGOA3 ;IF BIT 7 IS HIGH INC TWICE ADD A,2 PGOA3: SET 7,H RET ;ADDRESS ELINE AND DEC PTR TO PT TO SAVARS END ADDRELND: CALL ADDRELN ;ENTRY: HL HOLDS AN ADDRESS. IT IS DECREMENTED, AND ADJUSTED IF IT FALLS ;TOO LOW, SO IT PTS TO 8000-BFFF, PAGING AS NEEDED. IF CALLED FROM SYNTAX4, ;HL MAY BE BELOW 8000H ALREADY. COPES WITH UNDERFLOW OF UP TO 32K DECPTR: DEC HL CHKPTR: BIT 7,H RET NZ ;RET IF STILL AT 8000H OR MORE IN A,(251) DEC A SET 7,H BIT 6,H JR NZ,DECPT2 ;JR IF FALLEN INTO 4000-7FFF - CORRECT BY 1 PAGE DEC A ;IF IN 0000-3FFF, 2 PAGES DECPT2: RES 6,H PGOE: OUT (251),A RET ;ADD ADDR,BC. ADD BC TO AN ADDRESS IN AHL. A=PAGE, HL=8000-BFFF. BC UNCHNGED. ;BC CAN HAVE ANY VALUE ;SUB ADDR,BC. DITTO ;CARRY IF OVERFLOW ADDAHLBC: CALL AHLNORM ;GET 19 BIT FORM IN AHL ADD HL,BC ADC A,0 ;ADD AHL,BC JR PAGEFORM SUBAHLBC: CALL AHLNORM AND A SBC HL,BC SBC A,0 ;SUB AHL,BC JR PAGEFORM ;ADD ADDR IN AHL (PAGE FORM) TO THE ADDRESS IN CDE (PAGE FORM) ;RESULT IN AHL (PAGE FORM). CARRY IF OVERFLOW PAGES. CDE UNCHANGED. ADDAHLCDE: PUSH BC PUSH DE CALL TWOCONV ADD HL,DE ADC A,C JR PPFCOM ;SUBTRACT FROM ADDR IN AHL (PAGE FORM) THE ADDRESS IN CDE (PAGE FORM) ;RESULT IN AHL (PAGE FORM). CARRY IF OVERFLOW. CDE UNCHANGED. SUBAHLCDE: PUSH BC PUSH DE CALL TWOCONV AND A SBC HL,DE SBC A,C ;SUB AHL,CDE PPFCOM: POP DE ;CONTINUE INTO PAGEFORM POP BC ;TRANSFORM 19-BIT NUMBER IN AHL TO PAGE, ADDR (8000-BFFF) PAGEFORM: RL H RLA RL H RLA ;NC. PAGE NOW OK RR H SCF RR H ;ADDR NOW OK IN 8000-BFFF FORM CP 20H CCF ;SET CARRY IF OVERFLOW RET;CONVERT PAGE FORMS IN AHL AND CDE TO 19-BIT. USES B TWOCONV: CALL AHLNORM ;CONVERT PAGE FORM IN CDE TO 19-BIT IN CDE. CHANGES CDE ONLY CDENORM: PUSH AF EX DE,HL LD A,C CALL AHLNORM EX DE,HL LD C,A POP AF RET RTNORMAL: LD A,(RAMTOPP) LD HL,(RAMTOP) JR AHLNORM WENORMAL: LD A,(WKENDP) LD HL,(WKEND) BIT 6,H JR Z,AHLNORM INC A ;CONVERT PAGE FORM IN AHL TO 19-BIT IN AHL. ;TOP 3 BITS OF ORIG A AND TOP 2 BITS OF HL ARE IRREL. AHLNORM: RLC H RLC H RRA RR H RRA RR H AND 07H RET ;SET ERROR STACK PTR. EXITS WITH OLD ERRSP ON STACK. AFTER A ROUTINE HAS CALLED ;HERE, IT CAN CALL OTHER SRS. AND RETURN WILL STILL OCCUR EVEN AFTER AN ERROR. ;USES HL ONLY SETESP: LD HL,(ERRSP) EX (SP),HL PUSH HL LD (ERRSP),SP RET ;READ LEN FROM "DESIRED" HEADER (TAPE) RDRLEN: LD L,>HDR+HDN+3 DB 11H ;"JR+2" ;READ LEN FROM LOADED HEADER RDLLEN: LD L,>HDL+HDN+3 LD H,017F ;OFFSET 0-FF OTHERWISE. ;E OF 0-FF+OFFSET 0-0100 IS ALWAYS IN RANGE ADD HL,DE ;REAL X CALL M2CTPLOT ;PLOT HL,B WITHOUT ALTERING COORDS SYS VARS POP BC POP DE POP IX JP (IX) ;TO CIRCEXT OR TEMPS ;******************************************************************************* ;DRAW.SAM. SAM DRAW COMMAND. ;FROM JUMP TABLE WITH X,Y IN C,B OR HL,B JDRAWTO: LD A,(THFATT) CP 1 EX AF,AF' ;CY IF THIN DRAW JR JDRTO3 DRAW: SUB TOTOK ;VAR IS ZERO IF "DRAW TO" USED LD (TEMPB3),A JR NZ,PASTTO RST 20H ;SKIP "TO" PASTTO: CALL SYNTAX9 CP "," JR NZ,DRNOCU CALL SSYNTAX6 ;GET CURVATURE LD HL,TEMPB3 LD A,(HL) AND A JR Z,DRNC2 ;JR IF NOT DRAW X,Y,Z RST 30H DW DRCURVE-8000H DRNC2: LD (HL),H ;TEMPB3=NZ, MEANS "CURVED" DB CALC DB STOD0 DB EXIT ;DELETE CURVATURE SO X,Y CAN BE ACCESSED JR DRAWTOFD DRNOCU: CALL CHKEND LD A,(TEMPB3) AND A JR NZ,DRAWFD ;JR IF NOT DRAW TO. ;ELSE DO DRAW TO. TEMPB3=0, MEANS "STRAIGHT" ;NOTE: COORDS SYSTEM WITH XOS, YOS ETC NORMAL IS 0 TO 255/512, AND -16 TO 175 ;Y COORD STORED INVERTED AS 0 (TOP) TO 191 (BOTTOM) DRAWTOFD: CALL GTFCOORDS ;FIDDLE USING XOS/YOS/XRG/YRG IF "DRAW TO" ;UNSTACK COORDS. ;B=Y, WITH 0 AT TOP. IF THIN PIX, HL=X, CY ;ELSE C=X. RANGES CHECKED ALREADY. JR C,FDRNR LD A,(TEMPB3) AND A LD E,2 ;BLITZ CODE FOR "DRAW TO - FAT" CALL Z,GRAREC ;CALL IF STRAIGHT (CURVES ARE RECURSIVE ;STRAIGHT LINE DRAWS) AND A FDRNR: EX AF,AF' ;CY IF THIN ;NOW CONVERT TO SIGNED DISPLACEMENT FROM CURRENT POSN TO NEW ONE JDRTO3: LD A,(YCOORD) SUB B ;SUB Y COORD, Y DEST LD D,0FFH ;ASSUME -VE JR NC,ADJOK2 ;JR IF COORD NEEDS -VE INCREMENT TO REACH DEST NEG LD D,01H ADJOK2: LD B,A ;B=Y DIFF, D=Y DIFF SGN EX AF,AF' ;CY IF THIN PIX JR C,THINADJ LD A,(XCOORD) SUB C ;SUB X COORD, X DEST LD E,0FFH ;ASSUME -VE JR NC,ADJOK3 ;JR IF COORD NEEDS -VE INCREMENT TO REACH DEST NEG LD E,01H ADJOK3: LD C,A ;C=Y DIFF, E=Y DIFF SGN JR ADJOK5 THINADJ: PUSH DE LD DE,(XCOORD) XOR A SBC HL,DE ;SUB X DEST, X COORD INC A ;ASSUME +VE JR NC,ADJOK4 ;JR IF COORD NEEDS +VE INCREMENT TO REACH DEST EX DE,HL LD L,A ;L=1 DEC A LD H,A ;H=0. HL=1 COMPS FOR CARRY SET HERE SBC HL,DE ;NEGATE HL. DEC A ;A=FF ADJOK4: POP DE LD E,A ADJOK5: LD A,(TEMPB3) AND A JR Z,JDRAW RST 30H DW DRTCRV-8000H ; JP DRTCRV ;REL. DRAW DRAWFD: CALL DRCOORDFD ;FIDDLE USING XRG/YRG ONLY ;REG USE: HL=LARGER AND SMALLER DIFFS, DE=SGN Y AND X, THEN D=M3 INK ; B=POINT COUNT, C=TRACKING ERROR ; HL"=Y AND X COORDS, DE"=HOR OR VERT STEP, BC"=DIAG STEP DRAWLINE: CALL TWONUMS ;B=Y DIFF, C=X DIFF, D=SGN Y, E=SGN X (01/FF) ; OR HL=X AND CY IF THINPIX ; JR C,JDRAW ;JR IF THIN DEC E ;SGN X -> FE/00 (BLITZ CODE FOR FAT REL DRAW) CALL NC,GRAREC INC E ;NORMAL AGAIN JDRAW: CALL SPSS ;SAVE PAGE, SELECT SCREEN CALL SETIY ;POINT IY TO APPROPRIATE PLOT ROUTINE. ;A=INK IF M3, CY SET IF THIN PIX M2 JP C,THINDRAW EX AF,AF' ;A"=INK TO USE FOR MODE 3 LD IX,PRLABEL ;RETURN ADDR FROM PLOT ROUTINE LD HL,(YCOORD) ;H=X COORD, L=Y LD A,H LD H,L LD L,A ;H=Y, L=X PUSH HL EXX POP HL ;HL"=COORDS EXX LD A,C AND A JR Z,CHKYCO2 ;IF X DISP=0 X WON"T RUN OFF. AVOID +/- 0 LD A,L DEC E ;DEC X SGN JR Z,DOXADD ;JR AND ADD XCOORD AND DISTANCE IF +VE AND A JR Z,OSERRHP ;ERROR IF MOVE LEFT AND X IS ZERO SUB C ;SUB X,X DISP JR CHKYCO DOXADD: CP 255 JR Z,OSERRHP ;ERROR IF MOVE RIGHT AND X IS AT RHS ADD A,C ;ADD X,X DISP CHKYCO: INC E JR C,RUNOFF ;JR IF ADD OR SUB CARRIED CHKYCO2: LD A,B AND A LD A,H JR Z,FINCHK2 ;Y WON"T RUN OFF IF DISP=0 DEC D ;INC Y SGN JR Z,DOYADD ;JR IF +VE (MOVE DOWN) AND A JR Z,OSERRHP ;ERROR IF MOVE UP AND Y IS ZERO (AT TOP) SUB B ;SUB Y,Y DISP JR FINCHK DOYADD: CP 191 OSERRHP: JR Z,OSERROR ;ERROR IF MOVE DOWN AND Y IS AT BOTTOM ADD A,B ;ADD Y,Y DISP FINCHK: INC D ;(D=SGN AGAIN. CY NOT ALTERED) JR C,RUNOFF FINCHK2: CP 192 JR C,DRMSUBC ;JR IF Y COORD IN RANGE RUNOFF: LD IX,PLOTCHK ;CHECK AFTER PLOT IF EDGE HAS BEEN REACHED, ;(IF LINE WILL RUN OFF-SCREEN) RATHER THAN ;JUST RETURNING TO DRAW ROUTINE. IF OK, RETS ;TO DRAW, ELSE EXITS WITH ERROR DRMSUBC: CALL DRMSUB EXX ;GET HL=FINAL COORDS SCF ;SIGNAL "OK" JP DRAWEND DRMSUB: PUSH DE ;U/D AND L/R FLAGS EXX POP BC INC C JR NZ,NDHDIAG DEC B ;IF C WAS FF, THEN ADDING C (-VE X DISP) TO L ; (X COORD) WILL ALWAYS CARRY TO H+B, SO DEC B. NDHDIAG: DEC C ;BC"=DIAG STEP EXX LD A,C CP B JR NC,XGRTR ;JR IF X DIFF >=Y DIFF LD L,C ;L=ABS X DIFF (LESS THAN Y DIFF) LD E,0 ;WE WILL SOMETIMES NEED TO USE LR=STAY, SINCE X ; DIFF IS LESS THAN Y DIFF. ;B=GREATEST DIFFERENCE (Y) JR DRPREL XGRTR: OR B RET Z ;RET IF BOTH DIFFS EQUAL - NO LINE! LD L,B ;L=ABS Y DIFF ( <= X DIFF) LD B,C ;B=GREATEST DIFFERENCE (X) LD D,0 ;SOMETIMES NEED UP/DOWN=STAY DRPREL: PUSH DE EXX POP DE INC E JR NZ,NDHFLAT DEC D ;IF E WAS FF, THEN ADDING E (-VE X DISP) TO L ; (X COORD) WILL ALWAYS CARRY TO H+D, SO DEC D. NDHFLAT: DEC E ;DE"=HORIZ OR VERT STEP EXX EX AF,AF' LD D,A ;D=M3 INK LD H,B ;H=GREATEST COORD DIFF LD A,B ;INITIALISE TRACKING ERROR BYTE. (IT ACCUMULATES SRL A ;ERRORS FROM NOT MOVING ALONG LESS-DIF AXIS) DRLOOP: ADD A,L ;ADD LESSER COORD DIFF TO TRACKING ERROR JR C,TWOMOVE ;JR C AND SUB GREATER DIFF, MOVE IN BOTH AXES ;(ERROR IS BOUND TO MOVE BACK INTO RANGE) CP H ;CP GREATER COORD DIFF JR C,ONEMOVE ;THE ERROR IS NOT OUT OF RANGE SO FAR. IF WE CANNOT ;YET MAKE A MOVE ON THE LESSER-CHANGING AXIS (SMALL ;ADDITIONS TO THE TRACKING ERROR DO NOT YET JUSTIFY ;IT) MOVE JUST ON THE GREATER-CHANGING AXIS (JR) TWOMOVE: SUB H ;SUB GREATER LD C,A ;SAVE TRACKING ERROR BYTE IN C EXX ADD HL,BC ;ADD DIAGONAL STEP JP (IY) ;JP TO CORRECT PLOT ROUTINE, THEN TO PRLABEL ONEMOVE: LD C,A ;SAVE TRACKING ERROR EXX ADD HL,DE ;ADD HORIZ OR VERT MOVE JP (IY) ;JP TO CORRECT PLOT ROUTINE, THEN TO PRLABEL PRLABEL: EXX LD A,C ;GET TRACKING ERROR BACK DJNZ DRLOOP ;LOOP FOR GREATER AXIS DIFF. OF POINTS RET ;RETURN WITH HL"=COORDS, DE", BC"=DIR FLAGS ;POST-CHECK ROUTINE USED AFTER PLOT IF LINE WILL RUN OFF-SCREEN PLOTCHK: LD A,L INC A CP 2 CCF JR NC,DRAWEND ;JR IF X COORD=255 OR 0 LD A,H DEC A ;0->255,191->190 CP 190 JR C,PRLABEL ;STILL OK - SO BACK TO DRAW LOOP DRAWEND: PUSH AF ;SAVE NC IF HIT EDGE LD A,H LD H,L LD L,A LD (YCOORD),HL CALL TRCURP ;TEMPS, RESET PAGE POP AF ;NC IF HIT EDGE, C IF OK RET C OSERROR: RST 08H DB 32 ;"Off screen" ;THIN PIXEL DRAW ;ENTRY: B=Y DIFF,HL=X DIFF, D=SGN Y, E=SGN X (01/FF) THINDRAW: EXX LD HL,0 ;"COORDS"=0 EXX LD IY,THINDR2 DUBT: LD A,H AND A JR Z,EASYTHIN RRA LD A,L ;HALVE X DIFF RRA ;A=HALF X DIFF LD C,A PUSH AF ;SAVE HALF X DIFF AND CY IF DIFF IS ODD LD A,B AND A RRA LD B,A PUSH AF ;SAVE HALF Y DIFF AND CY IF DIFF IS ODD PUSH DE CALL DRMSUB POP DE ;SGN FLAGS POP AF ;Y/2 ADC A,0 ;INC IF WAS ODD LD B,A POP AF ;X/2 LD H,1 ADC A,0 ;INC IF WAS ODD - COULD NOW BE ZERO IF ORIG=1FF LD L,A JR C,DUBT ;JR WITH HL=0100 IF DOUBLE NEEDED AGAIN EASYTHIN: LD C,L CALL DRMSUB JP TRCURP ;THIN DRAW KEEPS SETTING DRAW"S COORDS IN HL TO 0000, SO HL WILL EQUAL BC OR DE THINDR2: PUSH BC PUSH DE EX DE,HL LD A,(YCOORD) ADD A,D LD B,A LD HL,(XCOORD) LD A,E AND A JR Z,TPNCHNG JP P,TPINC INC B ;COMPENSATE FOR FIDDLED DIR FLAGS DEC HL ;DEC X DEC HL ;COMP FOR NEXT INSTR TPINC: INC HL LD A,H CP 2 JR NC,OSERROR ;ERROR IF X INCED TO 0200H OR DECED TO FFFFH LD A,B CP 192 JR NC,OSERROR TPNCHNG: CALL TDPLOT LD HL,0 POP DE POP BC JP PRLABEL INCLUDE GRAPH1.SAM ;DRAW CURVE, PLOT ;GRAPH1.SAM ;PLOT.SAM JPLOT: LD A,(THFATT) AND A JR NZ,JPLOT3 ;JR IF FAT JR THINPLOT PLOT: CALL SYNTAX9 CALL CHKEND ;ENTRY POINT FOR BLITZ PLOTFD: CALL GTFCOORDS ;CORRECT Y SO 0 AT TOP, 191 AT BOT. CHECK X AND Y JP C,THINPLOT ;JR IF THIN PLOT - HL=X, B=Y. ELSE C=X, B=Y LD E,1 ;BLITZ CODE FOR PLOT (FAT) CALL GRAREC JPLOT3: CALL SPSS ;SAVE PAGE, SELECT SCREEN LD H,C LD L,B LD (YCOORD),HL ;UPDATE Y COORD AND X COORD LSB LD H,B ;H=Y WITH 0 AT TOP LD L,C ;L=X CALL SETIY EXX LD D,A ;INK TO D' EXX LD IX,TRCURP JP (IY) ;******************************************************************************* ;THIN PIXEL PLOT. PLOT HL,B. HL CHECKED ALREADY, 00-01FF THINPLOT: CALL SPSS ;USED BY PLOT CALL TDPLOT JP TRCURP TDPLOT: LD (XCOORD),HL ;USED BY DRAW - AVOIDS PAGING SCREEN IN AND OUT LD A,B LD (YCOORD),A M2CTPLOT: POP IX ;USED BY CIRCLE - AVOIDS ALTERING COORD VARS. PUSH HL PUSH DE PUSH BC LD A,L ;A=X RR H RR L ;L=X/2 LD H,B ;H=Y AND 03H ;ISOLATE BIT OFFSET INC A LD B,A ;B COUNTS TIMES TO ROTATE MASK SCF RR H RR L ;HL=Y/2+X/4+8000H=ADDRESS LD A,0FCH ;BIT MASK P80RLP: RRCA RRCA DJNZ P80RLP LD C,A LD DE,(OVERT) ;E=00/01 FOR OVER 0/1, D=00/FF FOR INVERSE 0/1 LD A,(M23INKT) INC D JR NZ,M2TPIN0 ;JR IF INVERSE 0 LD A,(M23PAPT) M2TPIN0: LD B,A DEC E JR Z,M2TPOV1 ;JR IF OVER 1 LD A,(HL) XOR B AND C ;FORCE PIXEL TO INK OR PAPER COLOUR XOR B JR M2TPC M2TPOV1: DEC D JR NZ,DRPLEND2 ;DO NOTHING IF INVERSE 1, OVER 1 LD A,C CPL XOR (HL) ;REVERSE PIXEL M2TPC: LD (HL),A JR DRPLEND2 ;******************************************************************************* ;MODE 0 PLOT - USED BY DRAW. PLOT L,H M0DPLOT: PUSH HL PUSH DE PUSH BC LD B,H LD C,L CALL M0PIXAD LD B,A JR M01DPCOM ;****************************************************************************** ;MODE 1 PLOT - USED BY DRAW. PLOT L,H M1DPLOT: PUSH HL PUSH DE PUSH BC CALL M1PIXAD ;HL=Y/8+X/8+8000H=ADDRESS, B=BIT OFFSET (0-7) M01DPCOM: LD A,0FEH INC B DPM2FLP: RRCA DJNZ DPM2FLP ;OVER 0,INVERSE 0=FORCE PIXEL HIGH ;OVER 1,INVERSE 0=REVERSE PIXEL ;OVER 0,INVERSE 1=FORCE PIXEL LOW ;OVER 1,INVERSE 1=NO EFFECT LD C,A LD DE,(OVERT) ;E=0 IF OVER 0, D= 00/FF FOR INVERSE 0/1 LD A,(HL) DEC E JR Z,DYOVER1 ;JR IF OVER 1 AND C DYOVER1: INC D JR Z,DRPLEND ;JR IF INVERSE 1 XOR C CPL DRPLEND: LD (HL),A CALL POATTR01 ;CALL ATTR SETTER FOR MODES 0,1 DRPLEND2: POP BC POP DE POP HL JP (IX) ;************************************************************************** ;MODE 2 OR 3 PLOTS FOR DRAW. ALL PLOT H,L ;ENTRY: HL=COORDS (Y,X), IX=RETURN ADDR, D'=INK COLOUR ;OVER 0: M3DPOV0: SCF RR H RR L ;HL=Y/2+X/2+8000H=ADDR LD A,(HL) EXX JR C,M3DPOV0OD XOR D AND 0FH XOR D EXX LD (HL),A ADD HL,HL ;RESTORE HL JP (IX) M3DPOV0OD: XOR D AND 0F0H XOR D EXX LD (HL),A ADD HL,HL INC L ;RESTORE HL JP (IX) ;MODE 2 OR 3 ROUTINE FOR OVER 1 - XOR INK WITH WHAT IS THERE ALREADY ;HL=Y/X, D'=INK M3DPOV1: SCF RR H RR L ;HL=Y/2+X/2+8000H=ADDR EXX LD A,D EXX JR C,M3DPOV1OD ;JR IF ODD PIXEL AND 0F0H ;NO EFFECT ON RHS BITS (ODD PIX) XOR (HL) LD (HL),A ADD HL,HL ;RESTORE HL JP (IX) M3DPOV1OD: AND 0FH ;NO EFFECT ON LHS BITS (EVEN PIX) XOR (HL) LD (HL),A ADD HL,HL INC L ;RESTORE HL M3DPNUL: JP (IX) ;INVERSE 1, OVER 1 ROUTINE DOES NOTHING ;MODE 2 OR 3 ROUTINE FOR OVER 2 - OR INK WITH WHAT'S THERE ALREADY ;HL=Y/X, D'=INK M3DPOV2: SCF RR H RR L ;HL=Y/2+X/2+8000H=ADDR EXX LD A,D ;FETCH INK EXX JR C,M3DPOV2OD ;JR IF ODD PIXEL AND 0F0H ;NO EFFECT ON RHS BITS (ODD PIX) OR (HL) ;OR INK WITH SCREEN LD (HL),A ADD HL,HL ;RESTORE HL JP (IX) M3DPOV2OD: AND 0FH OR (HL) LD (HL),A ADD HL,HL INC L ;RESTORE HL JP (IX) ;MODE 2 OR 3 ROUTINE FOR OVER 3 - 'AND' INK WITH WHAT'S THERE ALREADY ;HL=Y/X, D'=INK M3DPOV3: SCF RR H RR L ;HL=Y/2+X/2+8000H=ADDR EXX LD A,D ;FETCH INK EXX JR C,M3DPOV3OD ;JR IF ODD PIXEL OR 0FH ;SO NO EFFECT ON RHS BITS (ODD PIX) AND (HL) ;AND INK WITH SCREEN LD (HL),A ADD HL,HL ;RESTORE HL JP (IX) M3DPOV3OD: OR 0F0H AND (HL) LD (HL),A ADD HL,HL INC L ;RESTORE HL JP (IX) ;******************************************************************************* ;SET IY TO APPROPRIATE PLOT ROUTINE. A=INK TO USE IF MODE 2 OR 3. CY IF MODE 2 ;THIN PLOT, IY NOT SET SETIY: LD A,(SETIYV+1) AND A LD A,(MODE) JR NZ,STIY6 LD IY,M0DPLOT AND A RET Z ;RET IF MODE 0 LD IY,M1DPLOT DEC A RET Z ;RET IF MODE 1 DEC A JR NZ,STIY1 ;JR IF NOT MODE 2 LD A,(THFATT) AND A SCF ;'THIN PLOT' RET Z ;RET IF THIN PLOT, ELSE USE M2/M3 ROUTINES STIY1: LD A,(GOVERT) LD IY,M3DPOV0 AND A JR Z,STIY3 ;JR IF OVER 0 DEC A JR Z,STIY5 ;JR IF OVER 1 LD IY,M3DPOV2 ;ORING ROUTINE DEC A JR Z,STIY3 ;JR IF OVER 2 LD IY,M3DPOV3 ;ANDING ROUTINE STIY3: LD A,(INVERT) AND A STIY4: LD A,(M23INKT) RET Z ;RET WITH A=INK IF INVERSE 0 LD A,(M23PAPT) ;ELSE A=PAPER RET ;OVER 1 STIY5: LD IY,M3DPOV1 ;ROUTINE TO XOR INK WITH SCREEN LD A,(INVERT) AND A JR Z,STIY4 ;XOR INK TO SCREEN IF OVER 1,INVERSE 0 LD IY,M3DPNUL ;DO NOTHING IF INVERSE 1,OVER 1 RET ;VECTORED STIY6: PUSH HL LD HL,(SETIYV) CALL HLJUMP POP HL AND A ;NC - NO THIN PIX RET INCLUDE GRAPH2.SAM ;BLITZ, FILL, TRANSCR, CRDFID ;GRAPH2.SAM ;BLITZ MAIN LOOP FDMAINLP: EX DE,HL PUSH DE ;LENGTH PUSH HL ;POSN LD A,(HL) ;SGN X OR CMD CODE LD E,A INC HL LD D,(HL) ;ABS X OR SINGLE PARAM INC HL LD B,(HL) ;SGN Y, OR ABS Y IF PLOT/DRAW TO/CIRCLE INC A ;SGN=00 OR 01, PLOT CODE=02, DRAW TO=03 CP 2 JR C,DRCL ;JR IF 00 OR 01 (REL. DRAW) SUB 4 ;2-> -2 (PLOT), 3-> -1 (DRAWTO), 4->0 (CIRCLE) JR NZ,FDNTCIR ;JR IF CMD WAS NOT CIRCLE INC HL LD A,(HL) ;GET RADIUS SCF FDNTCIR: JR NC,FDATTRS ;JR IF 5 OR MORE (CODE NOW 1 OR MORE) EX AF,AF' ;SAVE RADIUS AND Z FLAG, OR NZ AND -1/-2 (DTO/PLT) XOR A ;'INTEGER' LD E,A ;E (SGN) =00 (POS) LD C,E ;MSB=00 CALL STKSTORE ;STACK AEDC - 00 00 X 00. LD A,(ORGOFF) LD D,A LD A,191 SUB B ;A=Y WITH 191 AT TOP, 0 AT BOT SUB D ;SUB ORGOFF LD D,A LD A,E ;A=0 JR NC,FDPOS DEC E ;SGN=-VE ** DEC C ;MSB=FF FDPOS: CALL STKSTORE ;STACK AEDC - 00 SGN Y 00 EX AF,AF' JR NZ,FDNTRAD LD C,A ;RADIUS CALL CIRCLEFD JR MNLP4B FDNTRAD: INC A JR NZ,FDPLOT CALL DRAWTOFD ;DRAW TO COORDS ON FPCS CP A ;SET Z FDPLOT: CALL NZ,PLOTFD ;PLOT THE COORDS ON FPC STACK LD C,3 JR MAINLPH FDATTRS: DEC A JR Z,FDOVER DEC A JR Z,FDINK DEC A JR Z,FDCLS DEC A JR NZ,FDINVERR FDPAU: LD C,D LD B,0 RST 30H ;** BLITZ PAUSE BUG FIX DW PAU1 JR FD1PARAM FDCLS: LD A,D CALL CLSBL ;CLEAR WINDOW OR ALL SCREEN LD C,2 JR MAINLPH FDINK: LD A,D LD (M23INKT),A LD HL,ATTRT XOR (HL) AND 07H XOR (HL) LD (HL),A JR FD1PARAM FDOVER: LD A,D INC HL LD (GOVERT),A FD1PARAM: LD C,2 JR MAINLPH DRCL: INC HL LD A,(HL) ;ABS Y . NOW E/D=SGN X/X, B/A=SGN Y,Y ;(SGN=00 OR FF) EX AF,AF' ;SAVE Y XOR A ;'INTEGER' LD C,E ;MSB MATCHES SGN CALL STKSTORE ;STACK AEDC EX AF,AF' LD E,B LD D,A XOR A LD C,E CALL STKSTORE ;STACK AEDC CALL DRAWFD MNLP4B: LD C,4 MAINLPH: XOR A LD B,A POP HL ;POSN ADD HL,BC ;ADVANCE POSN, NC LD A,H INC A CALL Z,INCURPAGE ;ONLY IF ADDR IS FFXX IS THERE A NEED TO INC PAGE EX DE,HL POP HL ;LENGTH FDLNTST: SBC HL,BC ;SUB BYTES PROCESSED IN LAST GRAPHICS CMD JP NC,FDMAINLP ;JR TILL PAST END POP AF LD (GRARF),A RET ;FAST DRAW AND PLOT COMPILER (DRAW A STRING) ;STRING HAS EITHER: ; SGN X (00/FF), X, SGN Y (00/FF), Y ; 01, X, Y - PLOT ; 02, X, Y - DRAW TO ; 03, X,Y,R - CIRCLE ; 04, O - OVER O ; 05, I - INK I ; 06, C - CLS C (IF C=0, CLEAR ENTIRE SCREEN. IF 1, CLEAR WINDOW) ; 07, N - PAUSE N BLITZ: CALL SYNTAXA CALL GETSTRING ;DE=START, BC=LEN, PAGED IN JBLITZ: PUSH DE PUSH BC CALL GRATEMPS POP BC POP DE LD HL,GRARF LD A,(HL) PUSH AF XOR A ;NC LD (HL),A ;GR. RECORD OFF, BUT CURRENT STATUS REPLACED AT END LD H,B LD L,C ;HL=LENGTH, DE=POSN LD BC,1 ;AT START,SUB 1 FROM LEN, EXIT IF LEN WAS 0. ALSO ;ALLOWS LATER LEN TEST TO BE ON CY/NC, NOT CY+Z JR FDLNTST FDINVERR: RST 08H DB 35 ;INVALID BLITZ CODE ;FILL.SAM ;*************************************************************************** ;TEXTURED FILL COMMAND ; EG FILL X,Y ;USES CURRENT INK ; EG FILL USING A$,X,Y ;USES INKS CODED IN PATTERN STRING ; EG FILL INK 3,X,Y ; EG FILL USING A$,INK 3,X,Y GIVES SOLID FILL, IGNORES A$ ;FROM JUMP TABLE: ;IF DE=0 DO SOLID FILL. ELSE USE 128 BYTES FROM DE AS PATTERN. IF A=0 MAKE ;CHECK SCREEN. JFILL: LD (TEMPW1),HL ;BYTE OFFSET IF MODE 2 PUSH BC ;START COORDS LD B,1 ;USE 128 BYTES SINCE BC<>131 LD (TEMPB1),A JR JFILL2 FILL: CP USINGTOK JR NZ,PASTUSNG CALL SEXPTSTR CALL INSISCSC ;REQUIRE COMMA OR SEMICOLON CP A ;SET ZERO FLAG PASTUSNG: CALL NZ,CONDSTK0 ;STACK 0 IF NO 'USING' AND RUNNING CALL SYNTAX9 ;CHECK FOR COLOURS, X,Y CP "," JR NZ,FCKE CALL SSYNTAX6 ;0 OR DEFAULT MEANS 'COPY TO CHK SCRN', 1 MEANS ;'SUPRESS COPYING' LD DE,0200H+30 CALL LIMBYTE ;ACCEPT 0 OR 1 ONLY JR FSCY FCKE: CALL CHKEND XOR A FSCY: LD (TEMPB3),A CALL CHKMD23 ;INSIST ON MODE 2 OR 3 RST 30H DW CIFILSR ;COORDS TO BC, OFFSET IF MODE 2 TO TEMPW1 JR NC,FILLX4 ;JR IF MODE 3 ELSE HL=PIX OFFSET LD A,L RR H RRA RRA ;A=OFFSET/4 (BYTE) AND 7EH LD (TEMPW1),A ;OFFSET 0,2,4 ETC LD A,L AND 7 ADD A,C LD C,A FILLX4: PUSH BC ;COORDS TO START AT CALL GETSTRING ;SWITCHES IT IN, GETS DE=START, BC=LEN (<4000) JFILL2: LD HL,FILBUFF ;STORES PATTERN LD A,D OR E JR NZ,DEFPAT LD A,(M23INKT) LD (HL),A ;IF NO 'USING', USE SOLID CURRENT INK LD D,H ;STRING START OF 0 MEANS USE SOLID PATTERN LD E,L INC DE ;DE=BUFFER START+1 LD BC,127 JR SOLIDEN ;BUFFER WILL BE FILLED WITH SOLID INK DEFPAT: LD A,B AND A JR NZ,DEFPAT1 LD A,C CP 131 JR NZ,DEFPAT1 ;JR IF LEN NOT THAT OF A 2*2 GET BLOCK ;(CONTROL CODE, WIDTH, LENGTH, 128 BYTES) INC DE INC DE INC DE ;POINT TO DATA DEFPAT1: EX DE,HL LD BC,128 SOLIDEN: LDIR ;COPY STRING TO BUFFER CALL SPSS ;SAVE PAGE,SELECT SCREEN (NO USE OF HL) LD A,(TEMPB3) AND A POP HL ;START COORDS PUSH HL CALL Z,TRANSCR ;NOW COPY SCREEN TO CHECK SCREEN POP BC ;START COORDS LD (TEMPW3),SP LD SP,FILLSTK ;END OF SCREEN GIVES MORE SPACE FOR STACK CALL FILLMN LD SP,(TEMPW3) JP TRCURP ;RESET PAGE AND TEMP COLOURS FILLMN: LD A,0FEH PUSH AF ;STOPPER TO STACK, START COORDS TO HL PUSH BC ;START COORDS UNSTK: POP BC LD A,B CP 0FEH RET Z ;EXIT IF STOPPER CP 0C0H JR NC,UNSTK ;LOOP IF OFF-SCREEN (FF IF TOO LOW, B0 IF TOO HI) ;CARRY ALWAYS SET HERE LD L,C ;NOW GET CHK SCREEN ADDRESS FROM COORDS RRA ;A=B RR L RRA RR L RRA RR L OR 0E0H LD H,A ;HL=Y/8+X/8+FILL CHK SCRN (MUST BE ON 8K PAGE) LD A,C AND 07H LD E,A ;BIT OFFSET INC E LD A,01H FRTMASK: RRCA DEC E JR NZ,FRTMASK LD D,A AND (HL) JR NZ,UNSTK ;JR IF POINT IS FILLED ALREADY FINDEDG: AND (HL) JR NZ,FOUNDEDG RLC D ;MOVE BIT MASK LEFT - CARRY IF OVERFLOW DEC C ;MOVE X COORD LEFT LD A,D JR NC,FINDEDG ;JR UNLESS NEED TO ALTER ADDR DEC L ;1 BYTE LEFT INC C JR Z,FOUNDEDG1 ;JR IF WE FELL OFF LHS SCREEN EDGE DEC C JR FINDEDG FOUNDEDG: INC C ;MAKE CURRENT POSN ONE FOUNDEDG1: RRC D ; PIXEL RIGHT OF BLOCKAGE JR NC,NBACK ;JR IF NO ADDRESS CHANGE NEEDED INC L NBACK: LD (TEMPW2),HL PUSH HL POP IX ;POSN ALSO IN IX LD A,(MODE) SUB 3 JR Z,FILLFLGS LD A,80H FILLFLGS: LD E,A ;INIT FLAGS. BIT 7=1 IF MODE 2 PUSH BC ;XY EXX POP BC LD A,B ;A=Y ADD A,A ADD A,A ADD A,A OR 80H ;A=80-F8 (8*Y MOD 16) LD C,A LD H,FILBUFF/256 EXX JR FILLC FILLB: INC C JR Z,UNSTK ;JP IF X COORD PAST RHS RRC D ;ROTATE MASK CALL C,MVRGT ;CALL IF TIME TO MOVE 1 BYTE RIGHT FILLC: LD HL,(TEMPW2) LD A,D AND (HL) JR NZ,UNSTK ;JR IF PIXEL FILLED LD A,D ;ELSE OR (HL) ;FILL LD (HL),A ;PIXEL IN CHECK SCREEN LD A,B ;Y EXX SCF RRA LD D,A EXX LD A,C ;X COORD BIT 7,E EXX RRA JR NZ,FILLM2 ;JR IF MODE 2 (NZ SET BY BIT 7,E) LD E,A ;DE'=REAL SCREEN ADDR LD B,0FH JR NC,FILLOEC ;JR IF EVEN X COORD LD B,0F0H JR FILLOEC FILLM2: SRA A ;KEEP BIT 7 THE SAME AND 0BFH ;1011 1111. BIT 7 FROM Y IS KEPT, BITS 5-0=X/4 LD E,A LD A,(TEMPW1) ;OFFSET FROM LHS ADD A,E LD E,A ;DE'=REAL SCREEN ADDR EXX LD A,C ;X COORD EXX LD B,3FH ;MASK FOR BITS TO ZERO AND 3 JR Z,FILLM2M LD B,0CFH DEC A JR Z,FILLM2M LD B,0F3H DEC A JR Z,FILLM2M LD B,0FCH FILLM2M: LD A,E FILLOEC: AND 07H ;A=PHYSICAL SCREEN COLUMN MOD 8 OR C ;GET BITS DETERMINED BY Y COORD LD L,A ;HL' IS NOW COMPLETE FILBUFF ADDR LD A,(DE) XOR (HL) AND B ;MIX BITS FROM FILBUFF PATTERN AND SCREEN XOR (HL) ; ACCORDING TO MASK B LD (DE),A EXX LD A,(IX-32) ;A=BYTE ABOVE BIT 0,E JR NZ,FILLE AND D JR NZ,FILLF ;JR IF BIT FILLED DEC B ;GET Y OF LOCATION ABOVE PUSH BC ;SAVE COORDS OF PLACE ABOVE INC B SET 0,E ;'ABOVE IS FILLED' JR FILLF FILLE: AND D JR Z,FILLF ;JR IF ABOVE NOT FILLED RES 0,E ;'ABOVE NOT FILLED' FILLF: LD A,(IX+32) ;GET BYTE BELOW BIT 1,E JR NZ,FILLG AND D JR NZ,FILLB ;JR IF BELOW IS FILLED INC B ;INC Y PUSH BC ;SAVE COORDS OF PLACE BELOW DEC B SET 1,E ;'BELOW IS FILLED' JR FILLB FILLG: AND D JR Z,FILBH ;JR IF NOT FILLED BELOW RES 1,E ;'BELOW IS NOT FILLED' FILBH: JP FILLB ;***************************************************************************** ;FILL SR MOVE RIGHT MVRGT: LD IX,(TEMPW2) INC IX LD (TEMPW2),IX ;MOVE 1 COL RIGHT IN CHECK SCREEN LD A,(IX+32) ;BYTE BELOW BIT 1,E JR NZ,MVRGT1 INC A JR Z,MVRGT2 RET MVRGT1: AND A RET NZ MVRGT2: LD A,(IX-32) BIT 0,E JR NZ,MVRGT3 INC A JR Z,MVRGT4 RET MVRGT3: AND A RET NZ MVRGT4: LD HL,(TEMPW2) LD A,(HL) AND A RET NZ ;RET IF NOT SIMPLE BLANK IN CHK SCREEN LD (HL),0FFH ;ELSE FILL 8 PIX AT ONCE LD A,B EXX SCF RRA LD D,A EXX LD A,C ;X INC A ;MOVE RIGHT ONTO 1ST. PIXEL OF 8-PIX BLOCK BIT 7,E EXX RRA JR Z,FILLM3B SRA A ;KEEP BIT 7 THE SAME AND 0BFH ;1011 1111. BIT 7 FROM Y IS KEPT, BITS 5-0=X/4 LD E,A LD A,(TEMPW1) ;OFFSET FROM LHS ADD A,E LD E,A ;DE'=REAL SCREEN ADDR AND 07H ;A=PHYSICAL SCREEN COLUMN MOD 8 OR C ;GET BITS DETERMINED BY Y COORD LD L,A ;HL' IS NOW COMPLETE FILBUFF ADDR JR FILLBC ;COPY 2 BYTES FROM PATTERN IN MODE 2 FILLM3B: LD E,A ;DE'=REAL SCREEN ADDR AND 07H ;A=PHYSICAL SCREEN COLUMN MOD 8 OR C ;GET BITS DETERMINED BY Y COORD LD L,A ;HL' IS NOW COMPLETE FILBUFF ADDR ;COPY 4 BYTES FROM FILLBUF PATTERN IN M3 LD A,(HL) LD (DE),A INC E INC L LD A,(HL) LD (DE),A INC E INC L FILLBC: LD A,(HL) LD (DE),A INC E INC L LD A,(HL) LD (DE),A ;COPY 8 PIXELS EXX LD A,C ADD A,8 JR Z,MVRGT5 ;JR IF AT RHS OF SCREEN LD C,A JR MVRGT MVRGT5: POP HL ;JUNK RET ADDR JP UNSTK ;******************************************************************************* ;TRANSCR - COPY MODE 3 SCREEN TO CHECK SCREEN (8000-DFFF -> E000-F800) ; OR - COPY PART OF MODE 2 SCREEN TO CHECK SCREEN ;SET BITS IN CHECK SCREEN THAT DON'T MATCH FILL ORIGIN COLOUR ;ENTRY: HL=COORDS OF FILL ORIGIN ;TRANSODD ALSO USED AS ENTRY BY COPY, WITH A=BACKGROUND COLOUR ;USES HL,DE,BC,HL',DE',BC' TRANSCR: SCF LD C,L ;X RR H RR L LD A,(MODE) CP 3 JR Z,TRANSL1 LD A,L SRA A ;KEEP BIT 7 THE SAME AND 0BFH ;1011 1111. BIT 7 FROM Y IS KEPT, BITS 5-0=X/4 LD L,A LD A,(TEMPW1) ;OFFSET FROM LHS ADD A,L LD L,A ;HL=M2 SCREEN ADDR LD A,C ;X AND 3 INC A LD B,A LD A,(HL) TRAM2RLP: RLCA RLCA DJNZ TRAM2RLP JR TRANSODD TRANSL1: LD A,(HL) BIT 0,C JR NZ,TRANSODD RLCA RLCA RLCA RLCA ;ENTRY USED BY MODE 2/3 SCREEN DUMP WITH A=BACKGROUND COLOUR TRANSODD: EXX LD HL,0E000H ;HL' IS DEST SCREEN PTR FOR FILL CHECKING LD DE,0C020H ;D'=192 SCANS, E'=32 BYTES/SCAN IN CHECK SCREEN EXX LD HL,8000H ;REAL SCREEN START CHARCOMP2: AND 0FH ;GET COLOUR TO SET TO ZEROS IN CHECK SCREEN LD D,A RLCA RLCA RLCA RLCA ;GET DESIRED INK IN MS NIBBLE LD E,A LD A,(MODE) CP 3 JR Z,TRANSM3 LD A,(TEMPW1) LD L,A ;OFFSET REAL SCREEN ADDR LD A,D AND 3 LD D,A EXX TRAM2DLP: LD C,E ;RELOAD BYTES/SCAN COUNTER C' TRAM2CLP: LD B,2 TRAM2OLP: EXX LD E,(HL) ;E=DATA FROM M2 SCRN LD B,4 ;4 DOUBLE BITS/BYTE TRAM2ILP: LD A,E RLCA RLCA LD E,A AND 3 SUB D CP 1 RL C ;BITS IN C SHOW IF PIXEL IN M2 SCRN IS 'INK' DJNZ TRAM2ILP INC HL ;NEXT M2 SCREEN BYTE LD A,C ;GET DATA IN CASE THIS IS SECOND BYTE EXX DJNZ TRAM2OLP ;DO 2 (B') M2 SCREEN BYTES/CHECK SCREEN BYTE CPL ;PIX THAT MATCH ORIGIN=0 LD (HL),A INC HL DEC C ;DO REQUIRED BYTES ACROSS (1 OR 32) JR NZ,TRAM2CLP EXX LD BC,64 ;DROP TO NEXT SCAN IF FILL, IRREL IF CHARCOMP ADD HL,BC EXX DEC D ;DO D' SCANS JR NZ,TRAM2DLP EXX RET TRANSM3: LD B,1 ;CP WITH THIS TO SET CY IF A=0 EXX TRANSDLP: LD C,E ;RELOAD BYTES/SCAN COUNTER C' TRANSCLP: EXX LD C,B ;C=1. CY WHEN BIT ROTATED OUT AFTER 8 ROTS. TRANSBLP: LD A,(HL) AND 0F0H SUB E ;GET A=ZERO IF PIXEL MATCHES ORIGIN INK CP B ;SET CARRY IF A=0 RL C LD A,(HL) INC HL AND 0FH SUB D CP B RL C JP NC,TRANSBLP LD A,C CPL ;PIX THAT MATCH ORIGIN=0 EXX LD (HL),A ;MOVE TO CHECK SCREEN AT (HL') INC HL DEC C JR NZ,TRANSCLP ;DO C' BYTES/SCAN IN CHECK SCREEN DEC D ;AND D' SCANS JR NZ,TRANSDLP EXX RET ;******************************************************************************* ;THIS ROUTINE USED BY SCREEN$ TO COMPRESS A MODE 2/3 CHARACTER TO STANDARD FORM ;IN SCRNBUF. ENTRY: HL PTS TO POSN IN M2/3 SCREEN, DE PTS TO 8-BYTE BUFFER, ;CY=6-BIT CHARS, NZ/Z=ODD/EVEN. USES AF,HL,DE,BC,HL',DE',BC' CHARCOMP: PUSH AF CALL SPSSR ;SELECT SCREEN, ROM1 OFF POP AF PUSH DE JR NC,CHCM2 ;JR IF NOT 6-PIX CHARS LD A,(HL) ;SCREEN DATA JR Z,CHCM3 ;JR IF EVEN COLUMN - TOP LHS PIX IN BITS 7,6 RRCA ;ELSE DATA IN BITS 3,2 RRCA JR CHCM4 ;NOW IN 1,0 CHCM2: LD A,(MODE) CP 2 LD A,(HL) ;SCREEN DATA JR Z,CHCM3 ;JR IF MODE 2 - TOP LHS PIXEL DATA IS BITS 7,6 RLCA ;ELSE IT IS BITS 7,6,5,4 RLCA CHCM3: RLCA RLCA ;DATA NOW IN RH 2 OR 4 BITS CHCM4: EXX ;A=BACKGROUND COLOUR - (TOP LHS PIXEL COLOUR) POP HL ;BUFFER FOR 8-BYTE COMPRESSED FORM FOR SCREEN$ SCF ;CALLED BY GRAPHICS COPY WITH NC GRCOMP: LD B,A CALL NC,SPSSR ;SELECT SCREEN LD A,B LD B,8 ;8 SCANS CHARCLP: PUSH BC PUSH AF ;BG COLOUR LD DE,0101H ;1 SCAN AT A TIME, 1 BYTE ACROSS IN RESULT EXX PUSH HL LD (TEMPW1),HL ;OFFSET FOR SCREEN SOURCE ADDR (USED BY MODE 2 ;FILL, AND CHARCOMP2 NEEDS IT) CALL CHARCOMP2 ;DO A SCAN POP HL LD A,L ;NOW DROP TO NEXT SCAN ADD A,128 ;SCAN LEN LD L,A JR NC,CHARCNINC INC H CHARCNINC: EXX POP AF ;BG COLOUR POP BC DJNZ CHARCLP JP RCURPR ;CRDFID.SAM ;GET FIDDLED COORDS - FORCE FATPIX ;GET FIDDLED FAT COORDS - USED BY GET, ROLL/SCROLL GTFIDFCDS: CALL GTFCOORDS RET NC ;RET IF FAT PIX RR H RR L LD C,L ;HALVE X, MOVE TO C RET ;GET FIDDLED COORDS GTFCOORDS: CALL COORDFID ;APPLY OFFSETS AND RANGES ;UNSTACK COORDS. ;ENTRY: X,Y ON FPCS ;EXIT: IF THIN PIX, HL=X COORD, CHECK FOR 0-511, ELSE C=X, CHECKED FOR 0-255. ;B IS ALWAYS THE Y COORD, CORRECTED FROM -16 TO 175 ON FPCS TO 0-191, THEN ;INVERTED SO 0 AT THE TOP. CY SET IF THIN PIX USCOORDS: CALL USYCOORD PUSH AF ;Y CALL GETINT ;HL=X COORD. BC=HL LD (TEMPW2),HL ;SAVE FOR 'RECORD' TO USE LD A,(THFATT) ;A=0 IF THIN PIX AND A LD A,H ;A=X MSB POP BC ;B=Y JR NZ,THCKCHK CP 2 ;CHECK X MSB VS 2 - MUST BE ZERO OR 1 RET C ;CY SIGNALS THIN PIX ;A MUST BE 2-FF HERE THCKCHK: LD C,L ;C=X AND A RET Z ;NC JR IOORERR1 ;X MSB MUST BE 0 UNLESS THIN PIX ;UNSTACK Y COORD TO A, CHECK AND CONVERT TO 0-191 SCALE USYCOORD: CALL FPTOA ;A (AND C)=ABS Y. Z IF POSITIVE JR C,IOORERR1 LD A,(ORGOFF) ;16 IF HEIGHT=8 JR NZ,ADJNEG ;JR IF Y IS -VE ADD A,C JR NC,ADJOK1 ;ADD 16 SO 0-175 BECOME 16-191 IOORERR1: RST 08H DB 30 ADJNEG: SUB C ;(16 IF HEIGHT=8)-ABS Y JR C,IOORERR1 ;IF Y IS NEGATIVE, ABS Y MUST BE <=ORGOFF ;-1 TO -16 NOW 15 TO 0 ADJOK1: LD B,A LD A,191 SUB B JR C,IOORERR1 LD (TEMPB1),A ;A=0-191. SAVE FOR 'RECORD' TO USE RET ;TWONUMS ;UNSTACK X AND Y DISPS. B=Y DISP, C=X DISP, D=SGN Y, E=SGN X (SGN = 01/FF) ; OR IF CY, THIN PIX AND HL=X DISP TWONUMS: CALL FPTOA JR C,IOORERR1 ;ERROR IF ABS Y>255 LD B,0FFH ;-VE. REVERSE SGN BECAUSE Y COORD REVERSES JR Z,POSBYTE LD B,01H ;+VE POSBYTE: PUSH BC ;B=SGN Y, C=Y CALL FPTOBC ;BC=X. Z IF +VE. CY IF OOR JR C,IOORERR1 LD H,1 ;+VE JR Z,POSINT LD H,0FFH ;-VE. H=SGN X POSINT: POP DE ;D=SGN Y, E=Y LD A,(THFATT) ;THIN/FAT TEMP. ONLY SAYS THIN IF MODE 2. AND A LD A,B ;X MSB LD B,E ;B=Y LD E,H ;E=SGN X JR Z,THINNUMS AND A JR NZ,IOORERR1 ;X MSB MUST BE ZERO IF FAT PIX IN USE RET ;B=Y, C=X, D=SGN Y, E=SGN X. NC THINNUMS: LD L,C LD H,A ;HL=X CP 2 JR NC,IOORERR1 RET ;HL=X, E=SGN X, D=SGN Y, B=Y. CY SHOWS THIN STATUS ;BC MUST BE 01FF OR LESS ;COORDINATE FIDDLE FOR PLOT, DRAW TO, CIRCLE, PUT,GRAB. ENTRY WITH X,Y ON FPCS ;DRAW RANGE FIDDLE ONLY DRCOORDFD: SCF ;'DON'T APPLY XOS' JR RGFIDEN ;RANGE AND OFFSET FIDDLE. USED BY E.G. PLOT. COORDFID: XOR A ;NC='OFFSET' LD B,A LD C,A ;BC=0=NORMAL YOS EX AF,AF' LD E,YOSDISP CALL PSEUDOSR ;ADD YOS IF NON-NORMAL (<>ZERO) XOR A ;NC='APPLY XOS' RGFIDEN: PUSH AF SCF ;'RANGE' EX AF,AF' LD E,YRGDISP LD BC,192 CALL PSEUDOSR ;APPLY YRG UNLESS IT IS 192 CALL SWOP12 ;GET X COORD TO STACK TOP POP AF JR C,DOXRG ;NC MEANS APPLY XOS. A=0 LD B,A LD C,A EX AF,AF' LD E,XOSDISP CALL PSEUDOSR ;ADD XOS IF NON-NORMAL (<>ZERO) SCF ;'RANGE' DOXRG: EX AF,AF' LD BC,512 LD A,(THFATT) AND A JR Z,GXRANGE ;RANGE=512 IF THIN DEC B ;BC=256 GXRANGE: LD E,XRGDISP CALL PSEUDOSR ;APPLY XRG UNLESS IT IS NORMAL JP SWOP12 ;GET Y TO TOP OF FPCS ;PSEUDO VARIABLE SUBROUTINE ;ENTRY: E=OFFSET TO PSEUDO-VAR XOS/YOS/XRG/YRG. F'=CY IF RANGE, NC IF OFFSET ;BC=NORMAL VALUE OF VAR. ;ACTION: APPLY PS IF NON-NORMAL PSEUDOSR: IN A,(URPORT) PUSH AF CALL ADDRNV LD D,0 ADD HL,DE LD D,H LD E,L ;DE PTS TO PS START CALL CHECKPS ;SEE IF PSEUDO VAR=BC (NORMAL) JP Z,PPORT ;JR IF PSEUDO VAR=NORMAL, DON'T APPLY IT. ;(POP AF, OUT, RET) PUSH BC ;NORMAL VALUE EX DE,HL CALL HLTOFPCS ;ELSE STACK PSEUDO-VAR POP BC POP AF OUT (URPORT),A EX AF,AF' JR C,APPLYRG DB CALC DB ADDN ;ADD OFFSET DB EXIT2 APPLYRG: CALL STACKBC DB CALC DB SWOP DB DIVN ;NORM/RG DB MULT ;COORD*NORM/RG DB EXIT2 CHECKPS: LD A,(HL) INC HL OR (HL) RET NZ ;NORMAL VALUES ALWAYS START 00 00 INC HL LD A,C CP (HL) RET NZ INC HL LD A,B CP (HL) RET ;GRAPHICS RECORD ;PLOT, DRAW TO, CIRCLE: CALL HERE WITH CMD CODE IN E, TEMPB1=Y, TEMPW2=X ;CIRCLE HAS RADIUS IN B REG. REL. DRAW USES E,C,D,B FOR SGN X,X,SGN Y,Y. ;PEN, OVER, PAUSE, CLS USE E,C FOR CMD CODE, PARAM ;E=FE/00 IF FAT REL. DRAW ;E=1 FAT PLOT ;E=2 FAT DRAW TO ;E=3 CIRCLE ;E=4 OVER ;E=5 PEN ;E=6 CLS ;E=7 PAUSE GRAREC: LD A,(GRARF) AND A RET Z ;RET IF RECORD OFF LD A,(CURCMD) CP 187 ;PRINT RET Z ;AVOID RECORD OF E.G. PRINT PEN 5; PUSH HL PUSH DE PUSH BC LD A,E LD HL,INSTBUF DEC A ;SGN FE/00 GOES TO FD/FF CP 0FDH JR C,GRAR6 ;JR IF NOT REL. DRAW INC A JR Z,GRAR4 ;JR IF +VE X SGN (E=0) INC E ;E=FF XOR A SUB C LD C,A ;NEGATE X DISP GRAR4: INC D ;Y SGN JR Z,GRAR5 ;JR IF -VE Y SGN.. Y IS REALLY +VE - FIDDLED BY ;TWONUMS BECAUSE OF Y AXIS REVERSAL LD D,0FFH XOR A SUB B LD B,A ;NEGATE Y DISP GRAR5: LD (HL),E LD A,B LD B,D LD D,A ;SWOP B AND D LD E,3 ;PRETEND 'CIRCLE' JR GRAR66 GRAR6: CP 3 JR NC,GRAR65 GRAR62: LD A,(TEMPW2) LD C,A ;X LD A,(TEMPB1) ;Y LD B,A ;COORDS TAKEN FROM STORES USED BY CRDFID GRAR65: LD (HL),E ;BLITZ CODE GRAR66: INC HL LD (HL),C INC HL LD (HL),B ;MAY BE JUNK INC HL LD (HL),D ;MAY BE JUNK LD A,E DEC A LD C,3 CP 2 JR C,GRAR7 ;JR IF PLOT OR DRAWTO - 3 BYTES LD C,4 JR Z,GRAR7 ;JR IF CIRCLE OR REL DRAW - 4 BYTES LD C,2 GRAR7: LD HL,(CURCHL) PUSH HL PUSH BC LD A,16 CALL SETSTRM ;STREAM 16 - TO STRING POP BC LD B,0 LD DE,INSTBUF CALL PRINTSTR ;O/P BC FROM DE TO STRING POP HL LD (CURCHL),HL ;STREAM 16 DOESN'T SET ANY FLAGS, SO NO NEED POP BC ;TO CALL CHAN-FLAG TO RESET THEM. POP DE POP HL RET INCLUDE GRABPUT.SAM ;GRAB, PUT, FARLDIR, STRMOV ;GRAB.SAM - GRAB A$,X,Y,W,L GRAB: CALL SYNTAX1 ;ASSESS VAR FOR ASSIGNMENT LD HL,FLAGS BIT 6,(HL) JR NZ,GNONSH ;ERROR IF NUMERIC TYPE RST 18H CP "," GNONSH: JP NZ,NONSENSE CALL SEXPT4NUMS ;SKIP, EXPECT 4 NUMBERS CALL CHKEND CALL CHKMD23 ;INSIST ON MODE 2 OR 3 LD DE,0C000H+30 CALL LIMDB ;LEN TO A, DECED (0-191) (ORIG MUST BE 1-192) INC A PUSH AF ;A=LEN CALL GETINT DEC BC ;0->FFFF, 256->255 LD A,B AND A JP NZ,IOORERR ;INSIST ON WIDTH OF 1-256 INC BC ;BC=1-256 INC BC ;IF BC IS EVEN, SET BIT 0 (WHICH WILL BE LOST) ;IF BC IS ODD,ROUND UP E.G. WIDTH 1->2 SRL B ;B=0 RR C ;C=1-128 POP DE ;D=LEN LD E,C ;WID PUSH DE ;LEN/WID CALL GTFIDFCDS ;UNSTK X,Y TO CB. CHECK FOR LEGALITY POP DE ;LEN/WID CALL JGRAB CALL STKSTOS ;STACK REGISTERS - STRING JP ASSIGN ;D=LEN (PIX), E=WIDTH (BYTES), B=Y, C=X ;EXIT: DE=START (IN CUSCRNP), BC=LEN (INCLUDES 3 LEADER BYTES) JGRAB: CALL SPSS ;GET CURRENT SCREEN AT 8000+ LD HL,RSBUFF-3 ;E000H LD (HL),0 ;CONTROL CODE INC HL LD (HL),E ;WID INC HL LD (HL),D ;LEN CALL GPVARS ;GET A'=WID,D/B'=LEN, HL=SCRN ADDR, BC=128 LD A,E RST 30H DW CRTBFI LD A,E EX AF,AF' ;(A' WAS CORRUPTED BY RST 30) CALL RSSTBLK ;STORE ROLL/SCROLL STORE BLOCK SR LD DE,RSBUFF-3 ;PT TO CC,W,L LD BC,(TEMPW2) ;LEN OF DATA INC BC INC BC INC BC ;ALLOW FOR CC,W,L IN A,(251) JP RCURP ;******************************************************************************* ;SR TO TRUNCATE LENGTH OF A BLOCK IF HANGING OFF BOTTOM OF SCREEN ;ENTRY: D=BLOCK LENGTH, B=Y COORD GPTRUNC: LD A,D DEC A ;LENGTH-1 ADD A,B ;ADD Y COORD JR C,GPTRUNC2 SUB 192 ;ALLOW UP TO 191 RET C ;RET IF WONT FALL OFF BOTTOM SUB 40H ;COMPENSATE FOR FOLLOWING 'ADD' GPTRUNC2: ADD A,40H ;GET 'NUMBER OF SCANS HANGING OFF' - 40H+ CPL ;ELSE A=0-3FH ->FF-C0 ADD A,D LD D,A ;ADJUST LENGTH RET ;GET/PUT VARS SETTER. ENTRY: E=WID, D=LEN, BC=YX COORDS. ;EXIT: A'/E=WIDTH, D/B'=LEN, HL=SCRN ADDR, BC=128 GPVARS: LD A,E EX AF,AF' ;A'=WIDTH CALL GPTRUNC ;SHORTEN D IF NEEDED. LD A,D EXX LD B,A ;B'=LENGTH EXX LD H,B ;Y LD L,C ;X SCF RR H RR L ;GET SCREEN ADDR IN 8000 AREA IN HL LD BC,128 RET ;PUT.SAM ;****************************************************************************** ;E.G. PUT X,Y,A$. OVER 0-3 ALLOWED, ALSO INVERSE ; PUT X,Y,A$,M$ USES M$ AS A MASK FOR 'CLIPPING'. PUT: CALL SYNTAX9 ;INK/PAPER IRREL, PUT OVER/INVERSE WORK CALL EXPTCSTR ;COMMA, STRING CP "," JR NZ,PUTL1 CALL SSYNTAXA ;SKIP, EXPECT STRING LD HL,RSBUFF+0FFDH ;E003+0FFD= F000H CALL PSCHKMHL ;CHECK MASK STRING AND MOVE TO 2ND HALF OF BUFFER LD A,5 ;'MASKED' JR PUTLC PUTL1: CALL CHKEND XOR A PUTLC: PUSH AF ;0=NO MASK, 5=MASKED LD HL,RSBUFF-3 ;E000H CALL PSCHKMHL ;CHECK STRING AND MOVE TO RSBUFF CALL GTFIDFCDS ;B=Y,C=X. CALL SPSS POP AF AND A JR Z,PUTL2 ;JR IF NOT MASKED PUT. NC EXX LD HL,RSBUFF+1000H ;HL'= F003H - PTR TO MASK STRING EXX LD HL,(RSBUFF-2) ;E001/E002 LD DE,(RSBUFF+0FFEH) ;F001/F002 SBC HL,DE JR Z,PUT05 ;A=5 STILL... JR IF W,L THE SAME FOR BOTH STRINGS RST 08H DB 38 ;'PUT mask mismatch' PUTL2: LD DE,(INVERT) ;E=INVERT, D=GOVERT LD A,E ;0-3 OR D LD A,4 JR Z,PUT05 ;OVER 0, INVERSE 0 USES SPECIAL ROUTINE NO. 4 LD A,D AND 3 ;NEUROT... PUT05: LD HL,RSBUFF-2 ;STR PTR (E001H) JR PUT06 ;A=PUT TYPE 0-5, B=Y, C=X, HL PTS TO W (BYTES), LEN (PIX), HL' TO MASK DATA ;BLOCK TRUNCATED IF HANGS OFF SCREEN BOTTOM JPUT: LD E,A CALL SPSS LD A,E ;** PUT06: ADD A,A LD E,A ADD A,A ADD A,A ;*8 ADD A,E ;*10 LD E,A LD D,0 LD IY,PUTSRTAB ADD IY,DE ;IY=ADDR OF SUBROUTINE FOR 'OVER' VARIATIONS LD E,(HL) ;GET WIDTH FROM STRING (BYTES) INC HL LD D,(HL) ;LEN INC HL PUSH HL CALL GPVARS ;GET A'/E=WID,D/B'=LEN, HL=SCRN ADDR, BC=128 LD A,C SUB E ;SCAN LEN-WIDTH=DISP TO NXT SCAN POP DE ;STRING PTR LD IX,PUTRET ;SET UP IX TO AVOID CALL OVERHEADS EXX LD E,A ;E'=DISP LD A,(INVERT) ;INVERSE MASK 00/FF TO A' EX AF,AF' ;A=WIDTH LD C,A ;C'=BLOCK WIDTH PUTSCLP: EXX ;AT THIS POINT: ;HL=SCRN PTR, DE=DATA SRC, A=WIDTH ;B'=LEN, C'=WIDTH, E'=DISP TO NEXT SCAN, A'=INVERSE MASK ;HL' CAN PT TO MASK STRING ;B IS USED AS A WIDTH COUNTER, AND C AS AN INVERSE MASK LD B,A ;BLOCK WIDTH COUNTER SET UP EX AF,AF' LD C,A ;INVERSE MASK JP (IY) ;JUMP TO XOR, OR, LD or AND LOOP ;ENTRY WITH DE=SRC, HL=SCRN DEST, B=BYTES, C=INVER ;EXIT WITH B=0 PUTRET: LD A,C ;INVERSE EX AF,AF' ;PROTECT INVERSE MASK IN A' EXX LD A,E ;DISP TO NEXT SCAN FROM E' EXX LD C,A ;BC=DISP TO NEXT SCAN (SCAN LEN-BLOCK WIDTH) ADD HL,BC ;DROP 1 SCAN EXX LD A,C ;GET WIDTH VALUE FROM C' DJNZ PUTSCLP ;DEC LENGTH COUNTER, LOOP TILL ALL SCANS DONE JP RCURP ;****************************************************************************** ;PUT SUBROUTINES FOR OVER 0,1,2,3. ;ENTRY WITH DE PTING TO DATA SRC, HL TO SCRN, B=BYTES TO DO, C=INVERSE MASK ;IX='RET' ADDR ;EXIT WITH B=0. PUTSRTAB: OVER0LP: LD A,(DE) ;DATA FROM STRING XOR C ;INVERSE MASK LD (HL),A INC DE INC HL DJNZ OVER0LP JP (IX) NOP ;MAKE ALL SRs HAVE LENGTH OF 10 OVER1LP: LD A,(DE) ;DATA FROM STRING XOR C ;INVERSE MASK XOR (HL) ;OVER 1 LD (HL),A INC DE INC HL DJNZ OVER1LP JP (IX) OVER2LP: LD A,(DE) ;DATA FROM STRING XOR C ;INVERSE MASK OR (HL) ;OVER 2 LD (HL),A INC DE INC HL DJNZ OVER2LP JP (IX) OVER3LP: LD A,(DE) ;DATA FROM STRING XOR C ;INVERSE MASK AND (HL) ;OVER 3 LD (HL),A INC DE INC HL DJNZ OVER3LP ;ABOUT 64 T'S PER BYTE (USE INC L,=56) JP (IX) ;FASTER VERSION FOR WHEN INVERSE 0, OVER 0 NOINVER: EX DE,HL LD C,B LD B,0 LDIR ;32 T'S PER BYTE EX DE,HL JP (IX) NOP ;USE 'VALID DATA' MASK PTED TO BY HL'. 1'S=VALID ;MAKE MASK BY: FILL INK 0, BORDER AREA: GRAB A$: FILL INK 15, BORDER AREA ;PUT OVER 1, A$. (MAKES BORDER 1'S, FIGURE 0'S). GRAB A$: PUT INVERSE 1, A$ ;GRAB A$. GIVES BORDER 0'S, FIGURE 1'S. PMASKLP: LD A,(DE) ;DATA FROM STRING XOR C ;INVERSE MASK XOR (HL) ;XOR SCRN EXX AND (HL) ;AND MASK INC HL EXX INC DE XOR (HL) LD (HL),A INC HL DJNZ PMASKLP ;ABOUT 96 T'S PER BYTE JP (IX) PUTBLKERR: RST 08H DB 37 ;'Invalid PUT block'. ;PUT STRING CHECK/MOVE TO (HL) ;CHECK PUT STRING STARTS WITH CHR$ 0, LEN <>0. COPY TO (HL) IN SCRN MEM PSCHKMHL: LD (TEMPW1),HL ;DEST CALL CHKMD23 ; CALL SPSS ;GET CURRENT SCREEN AT 8000+ CALL GETSTRING ;DE=STRING ADDR, BC=LEN, PAGE IS SELECTED LD A,B ;!!!SPSS ACTION NEGATED!! OR C JR Z,PUTBLKERR ;REQUIRE NON-ZERO LENGTH LD A,(DE) AND A JR NZ,PUTBLKERR ;REQUIRE CHR$ 0 AS 1ST. CHAR ; CALL SCRMOV ; JP RCURP ;SCRNMOV - COPY BC BYTES FROM (DE) TO (TEMPW1) IN SPARE SCRN MEMORY ;USES HL,DE,BC,AF,AF' SCRMOV: LD HL,(TEMPW1) ADD HL,BC JR C,PUTBLKERR ;JR IF STRING WILL NOT FIT CALL SPLITBC LD A,(CUSCRNP) LD C,A ;C:(TEMPW1)=DEST IN A,(251) ;ADE=SRC SCF JR SFLDIR FARLDDR: BIT 6,H JR NZ,FLD3 ;JR IF SRC ALREADY IN SECT D DEC A ;PAGE IN SRC AT C000-FFFF SET 6,H FLD3: BIT 6,D JR NZ,FLD4 DEC C SET 6,D ;DITTO DEST FLD4: AND A ;'LDDR' DB 06H ;'JR +1' ;LDIR (PAGCOUNT) PAGES AND (MODCOUNT) BYTES FROM AHL TO CDE. MODCOUNT<=3FFF. ;PAGCOUNT OR MODCOUNT CAN BE ZERO WITHOUT PROBLEMS. PAGING UNCHANGED ON EXIT. ;EXIT WITH TEMPW1=PAST DEST, TEMPB2=PAGE OF PAST DEST, DE=PAST SRC END ;HL OR DE CAN BE ABOVE COOOH ON ENTRY WITHOUT PROBLEMS FARLDIR: SCF EX DE,HL LD (TEMPW1),HL ;DEST ADDR ;C/(TEMPW1) =DEST, ADE=SRC SFLDIR: LD H,A LD A,C LD (TEMPB2),A ;ENTRY: HDE=SRC, TEMPB2/TEMPW1=DEST. USED IF FARLDIR HAS MOVED SOME DATA ALREADY ;FROM CONCATENATE FARLDIR2: EX AF,AF' ;CY' IF LDIR CALL R1OSR ;ROM1 OFF, SAVE PORT STATUSES (STATI?) LD A,H CALL TSURPG ;SRC PAGE LD A,(PAGCOUNT) AND A JR Z,FLDIE FARLDILP: PUSH AF LD BC,4000H CALL STRMOV1 POP AF DEC A JR NZ,FARLDILP ;DO PAGCOUNT 16K MOVES FLDIE: LD BC,(MODCOUNT) CALL STRMOV JP POPOUT ;STRMOV: MOVE BC BYTES FROM (DE) IN CURRENT UR PAGE TO (TEMPW1) IN ;PAGE (TEMPB2), VIA SYS PAGE. WORKS WITH 0000 TO FFFF BYTES ;CY' IF LDIR, NC' IF LDDR ;EXIT WITH DE=PAST SRC END, PAGE SWITCHED IN, (TEMPW1)=PAST DEST END, ;(TEMPB2)=PAGE OF THE LATTER. HL=0 ;USED BY FARLDIR STRMOV: LD A,B OR C RET Z STRMOV1: LD HL,(INSLV) INC H DEC H JP NZ,HLJUMP LD H,B LD L,C ;HL=BYTES REMAINING TO DO STRMOVL: LD BC,0100H LD A,H AND A JR NZ,STRMOV2 ;JR IF 256 OR MORE TO DO STILL LD B,H LD C,L ;COUNT=REMAINING. EXIT AFTER THIS MOVE STRMOV2: PUSH HL ;BYTES REMAINING PUSH BC EX DE,HL LD DE,BUFF256 EX AF,AF' JR C,DLDIR ;JR IF LDIR ;DEST=256 BYTE BUFFER, HL=SRC, BC=256 (USUALLY) EX AF,AF' DEC E ;PT TO OTHER END OF BUFFER (E=255) LDDR POP BC BIT 6,H CALL Z,DECURPAGE ;IF SRC FALLEN INTO SECTION C, DEC PAGE AND SET 6,H JR STRM32 DLDIR: EX AF,AF' LDIR ;COPY BYTES TO BASE PAGE POP BC CALL CHKHL STRM32: PUSH HL ;SRC PTR (8000-BFFF OR C000-FFFF IF LDDR) IN A,(251) PUSH AF ;SAVE SRC PAGE LD A,(TEMPB2) CALL TSURPG ;GET DEST AT 8000+ LD DE,(TEMPW1) ;DEST PTR PUSH BC ;BYTE COUNT EX AF,AF' LD HL,BUFF256 JR C,STRM34 EX AF,AF' DEC L ;POINT TO OTHER END OF BUFFER LDDR EX DE,HL BIT 6,H CALL Z,DECURPAGE JR STRM38 STRM34: EX AF,AF' LDIR ;COPY BYTES FROM SYS PAGE TO DEST EX DE,HL CALL CHKHL STRM38: IN A,(URPORT) LD (TEMPB2),A ;POSSIBLY NEW DEST PAGE (BITS 7-5 MAY BE HI) STRMOV4: LD (TEMPW1),HL ;NEW DEST ADDR (SECTION C IF LDIR, D IF LDDR) EX DE,HL POP BC ;BYTE COUNT POP AF OUT (251),A ;RESTORE SRC PAGE POP DE ;SRC PTR POP HL ;BYTES REMAINING TO MOVE AND A SBC HL,BC JR NZ,STRMOVL RET INCLUDE ASSIGN.SAM ;STKVAR, ASSIGN, SYNTAX1, DIM, SLICER ;ASSIGN.SAM VALFET1: LD A,(FLAGS) VALFET2: PUSH AF CALL SCANNING LD A,(FLAGS) LD D,A POP AF XOR D AND 40H JP NZ,NONSENSE LD A,D RLA RET NC ;RET IF SYNTAX TIME ;RUN TIME ROUTINE ASSIGN: CALL ASSISR JP SELCHADP CGXRG: PUSH HL CALL HLTOFPCS LD B,A DB CALC ;XRG DB ONELIT DB 2 ;XRG,2 DB STKBREG ;XRG,2,(0/29H) DB JPFALSE ;JP IF ZERO, MULT DB 4 DB DIVN ;XRG/2 DB JUMP ;JP EXIT DB 2 DB MULT ;XRG*2 DB EXIT POP DE JR ASENV ;DELETE VALUE, COPY TO VARS ;FROM PARPRO CRTVAR35: LD A,(TLBYTE) ;CALLED BY MERGE, SETUPVARS CRTVAR4: LD C,A LD HL,FLAGS SET 6,(HL) ;'NUMERIC' CALL NUMLOOK CALL SYN14C ASSISR: CALL ADDRDEST ;ADDR OF LAST PTR LSB IF NEW NUMERIC VAR ;ADDR OF 1ST BYTE OF 5 IF EXISTING NUMBER ;ADDR OF SAVARS TERMINATOR IF NEW STRING (NOT USED) ;ADDR OF FIRST CHAR IF EXISTING STRING LD A,(FLAGS) ADD A,A LD A,(FLAGX) JP P,ASSTR ;JR IF STRING EX DE,HL RRA JR C,ASNN ;JR IF NUMBER IS 'NEW' ;ASSIGN TO EXISTING NUMERIC VAR. DE PTS TO EXISTING VALUE IN NVARS. ASENV: CALL FDELETE ;DELETE FPC DATA, LEAVE HL PTING TO IT LDI5: LD BC,5 LDIR ;COPY OVER OLD VALUE RET ;ASSIGN NEW NUMBER. DE PTS TO LSB OF LAST LINK PTR. CALCULATE NEW VALUE TO POINT ;TO NUMEND, WHERE NEW VARIABLE WILL BE PLACED ASNN: LD A,(DESTP) AND 1FH LD C,A LD HL,(NUMEND) LD A,(NUMENDP) SUB C JR Z,ANSP ;JR IF SAME PAGE (USUAL CASE) ELSE A=1,2,3 ETC LD BC,4000H ANSPL: ADD HL,BC DEC A JR NZ,ANSPL ;ADJUST ADDR OF NUMEND UP TILL BOTH NUMBERS ;ARE 'NORMALISED' WITH EACH OTHER. (WRAP-ROUND AND A ;DOESN'T MATTER TILL >64K) ANSP: SBC HL,DE ;GET DISP FROM LSB OF PTR TO FIRST FREE BYTE IN ;NUMS-SAVARS GAP DEC HL ;GET DISP FROM *MSB*. PUSH HL ;SAVE DISP VALUE ;(WE CAN'T ALTER THE LINK YET - THERE MAY NOT BE ;ENOUGH MEMORY TO CREATE THE VARIABLE) LD A,(NUMENDP) LD C,A LD HL,(SAVARS) LD A,(SAVARSP) CP C ;Z,NC OR NZ,NC (SAVARS *ALWAYS* HIGHER) JR Z,ABSP ;JR IF (AS UNUSUAL) NUMEND AND SAVARS-START ARE ;IN SAME PAGE SET 6,H ;ELSE SAVARS ARE JUST 1 PAGE HIGHER - ADD 4000H ;TO HL SO BOTH NUMBERS 'NORMALISED' ABSP: LD BC,(NUMEND) SBC HL,BC EX DE,HL ;DE=FREE GAP BETWEEN NUMS AND STR/ARRAYS ;HL=LSB OF PTR ADDR LD A,D AND A JR NZ,ANOK ;JR IF AT LEAST 256 BYTES FREE LD A,E CP 60 JR NC,ANOK ;JR IF AT LEAST 60 BYTES FREE (ENOUGH FOR ;LARGEST NUMERIC VARIABLE) CALL ADDRSAV CALL DECPTR LD BC,0200H CALL MAKEROOM ;OPEN 512 BYTES BEFORE SAVARS CALL ADDRDEST ;HL=PTR LSB ;OK TO CREATE NEW NUMERIC ANOK: POP DE ;DISP LD (HL),E INC HL LD (HL),D ;MAKE LINK OF PREVIOUS LAST-VAR-OF-THIS-LETTER ;PT TO NEW LAST VAR. CALL ADDRNE ;PT HL TO NUMEND (LOCN OF NEW VAR. LD A,(TLBYTE+33) LD (HL),A INC HL LD B,0FFH LD (HL),B INC HL LD (HL),B INC HL ;PTR=FFFF (LAST VAR OF THIS FIRST LETTER) EX DE,HL LD HL,FIRLET+34 ;PT TO SECOND LETTER OF NAME AND 1FH JR Z,ASNCL ;JR IF SINGLE-LET VAR LD C,A INC B ;BC=LEN OF NAME (LESS FIRST LETTER) LDIR ;COPY TO VARS ASNCL: CALL ASENV ;COPY FPC VALUE TO VARS NELOAD: LD (NUMEND),DE ;NUMEND IS PAST LAST BYTE OF VALUE BIT 6,D RET Z ;RET IF STILL 8000-BFFF RES 6,D LD A,(NUMENDP) INC A LD (NUMENDP),A JR NELOAD ;ASSIGN A STRING ASSTR: RRA ;TEST BIT 0,(FLAGX) JP C,ASNST ;JP IF IT IS A NEW STRING ;ASSIGN TO EXISTING STRING VAR LD BC,(STRLEN) ;LENGTH OF DESTINATION LD A,(DESTP) RLA JR C,ASDEL ;JR IF UNSLICED SIMPLE STRING - DELETE OLD VERSION LD A,B OR C RET Z ;RET IF E.G. LET A$(4 TO 3)="TEST" - DEST LEN=0 PUSH HL ;DEST ADDR PUSH BC ;DEST SIZE CALL STKFETCH ;ADE/BC =STRING START/LEN POP HL ;DEST SIZE SBC HL,BC ;DEST SIZE-SRC SIZE (NC HERE) JR NC,AES1 ;JR IF TRUNC NOT NEEDED ADD HL,BC ;HL=DEST SIZE AGAIN LD B,H LD C,L ;BC=TRUNCATED SRC LEN NEEDED TO FILL DEST LD HL,0 ;'PADS' NEEDED=0 AES1: EX (SP),HL ;PADS NEEDED TO STACK, DEST ADDR TO HL EX DE,HL ;DE=DEST, HL=SRC EX AF,AF' CALL SPLITBC ;LD PAGCOUNT/MODCOUNT WITH BC IN A,(251) LD C,A ;CDE=DEST EX AF,AF' ;AHL=SRC CALL FARLDIR ;COPY STRING TO DEST POP BC ;PADS LD A,B OR C RET Z LD A,(TEMPB2) CALL TSURPG LD HL,(TEMPW1) ;PT TO PAST LAST BYTE FARLDIRED EARLIER XOR A CP C ;NC ONLY IF C=0 ADC A,B ;A=B+1 UNLESS C WAS ZERO, WHEN A=B LD B,C LD C,A LD A,20H ASPSL: LD (HL),A INC HL DJNZ ASPSL DEC C RET Z CALL CHKHL JR ASPSL ;E.G. RECORD TO A$ OR: RECORD STOP RECORD: CP 0B1H ;IS IT 'RECORD STOP'? STOPTOK JR NZ,RECORD2 XOR A LD (GRARF),A ;GRAPHICS RECORD FLAG 0 (OFF) RST 20H ;SKIP 'RECORD' RET RECORD2: CP TOTOK JR NZ,RCNONS RST 20H CALL LVFLAGS JP M,NONSENSE ;ERROR IF NUMERIC JR C,RECORD3 ;JR IN RUN TIME (ALLOWS STR ARRAYS TO BE DELETED) BIT 6,C RET Z ;RET IF SIMPLE STRING, ELSE ERROR IF E.G. A$(3) RCNONS: RST 08H DB 29 RECORD3: EX AF,AF' CALL NZ,ASDEL2 ;IF FOUND, DELETE VAR PTED TO BY STRLOC LD DE,STRM16NM CALL SCOPN1 ;COPY NAME TO STRM16NM.( MAY COPY 12 BYTES, ;HITTING GRARF - BUT IRREL) LD A,D LD (GRARF),A ;GRAPHICS RECORD FLAG=NZ (ON) CALL SCOPNM ;EXIT WITH BC=0 (NULL LEN) JR ASNS1 ;ASSIGN NULL STRING TO NAME ;ASSIGN STRING, THEN DELETE OLD STRING. E.G. LET A$=A$ OR LET A$=A$+"X" ASDEL: CALL ASNST ;CREATE NEW VERSION FIRST SO E.G. LET A$=A$ WORKS CALL ADDRDEST ;HL PTS TO TEXT OF OLD STRING LD DE,-14 ADD HL,DE ;PT TO TLBYTE IN VARS CALL CHKPTR JR ASDEL3 ;CALLED BY DIM TO DELETE EXISTING ARRAYS OR STRINGS, WITH A=PAGE ASDL1: CALL SELURPG ;CALLED BY END PROC TO DELETE LOCAL STRINGS/ARRAYS, RECORD TO DELETE EXISTING ;STRING/ARRAY. ENTRY WITH STRLOCN PAGED IN ASDEL2: LD HL,(STRLOCN) ASDEL3: PUSH HL ;PTR TO TLBYTE LD BC,11 ADD HL,BC ;PT TO LEN (PAGES) CALL ADD14 LD B,H LD C,L POP HL ;PTR TO TLBYTE JP RECL2BIG ;DELETE STR/ARRAY AND 14-BYTE HEADER (ABC AT HL) ;CALLED BY TAPEMN ADD14: LD A,(HL) INC HL LD E,(HL) ;LEN MOD 16K INC HL LD D,(HL) EX DE,HL ;AHL=LEN (PAGES, LEN MOD 16K) LD BC,14 ADD HL,BC ;ADD 14 TO GET LEN INCLUDING HDR BIT 6,H RET Z ;RET IF MOD <16K INC A RET ;ASSIGN A NEW STRING ASNST: CALL STKFETCH ;DATA FOR STRING ASSIGNMENT AND 1FH LD H,A LD A,(WKENDP) LD L,A LD A,H CP L JR C,ASNS1 ;JR IF SRC PAGE LOWER THAN WKEND JR NZ,ASNS0 ;JR IF SRC PAGE HIGHER LD HL,(WKEND) SBC HL,DE JR NC,ASNS1 ;JR IF SRC <=WKEND ASNS0: LD (FIRST),DE ;ELSE SRC>WKEND AND SHOULD NOT BE AUTO-ADJUSTED LD (LAST),A LD A,0FFH ;SIGNAL 'XPTR NOT USED' ;CALLED BY 'RECORD' TO CREATE NULL STRING ASNS1: PUSH AF PUSH BC ;STRING LEN LD (XPTR),DE LD (XPTRP),A ;SAVE START IN AUTO-ADJ VAR (MAKEROOM MAY MOVE IT) LD A,14 ;ALLOW FOR TYPE/NAME LEN (1) NAME (10), TXT LEN (3) ADD A,C ;ADD TO TEXT LEN TO GET ROOM NEEDED LD C,A JR NC,ASNS2 INC B JP Z,STLERR ;TOTAL LEN MUST NOT EXCEED FFFFH ASNS2: LD A,B RLCA RLCA AND 03H CALL SAROOM POP BC ;STRING LEN CALL MBC ;COPY PAG/MOD COUNT TO VARS IN A,(251) LD C,A ;CDE=DEST POP AF INC A LD A,(XPTRP) LD HL,(XPTR) JR NZ,ASNS3 ;JR IF XPTR NOT USED LD A,(LAST) LD HL,(FIRST) ASNS3: LD (XPTR+1),A ;PAGE SHOULD HAVE BIT 7 LOW - CANCEL XPTR JP FARLDIR ;LDIR PAGCOUNT/MODCOUNT BYTES ;ASSESS FOR-NEXT VAR (USED BY 'FOR' AND 'NEXT') SYNTAX4: CALL LVFLAGS JP P,NONSENSE ;ERROR IF STRING BIT 5,C JP NZ,NONSENSE ;OR NUMERIC ARRAY NAME JR NC,SYNT41 ;JR IF SYNTAX TIME EX AF,AF' SYN42: JR Z,SYN14C ;JR IF DOESN'T EXIST BIT 6,C ;C IS FROM VARS JR NZ,SYN14C ;JR IF (EXISTING) FOR-NEXT VAR PUSH IX POP HL ;ADDR OF PTR LSB SET 5,(IX-1) ;TYPE BYTE MARKED AS 'UNUSED' ** BUG FIX ; LD C,0FFH ;'INVIS' AND 'UNUSED' - DON'T EXIST CALL NVMLP JR SYN42 ;LOOP FOR ALL COPIES ; LD C,0 ;NON-ARRAY TYPE ; DB 3EH ;'JR+1' SYNT41: EX AF,AF' JR SYN14C SSYNTAX1: RST 20H ;USED BY LET/READ/INPUT TO ASSESS VAR ABOUT TO BE ASSIGNED TO. SYNTAX1: CALL LOOKVARS ;IF FND, C=T/L FROM VARS, ELSE C=DESIRED T/L SYN14C: EX DE,HL ;IF FND, DE PTS TO START OF NUMBER, OR LEN INFO OF ;STRINGS/ARRAYS (PAGE/LEN MOD 16K) ;FROM PARAM PROCESSING SYN1PP: LD HL,FLAGX LD (HL),0 ;VAR NOT NEW (BIT 0=0) JR NZ,TSYNT12 ;JR IF VAR EXISTS, OR SYNTAX TIME ;ELSE C='DESIRED' TYPE, BITS 6 AND 5 ARE 0 ;IF SIMPLE UNSLICED STRING, OR A SIMPLE NUMBER INC (HL) ;'NEW VARIABLE' LD A,C AND 60H JR Z,TSYNT14 ;DESTP BIT 7 WILL BE 0 ('KEEP OLD VALUE') ;ERROR IF TRYING TO USE AN UNDIMED ARRAY, OR SLICE ;A NEW STRING. VNFERR: RST 08H DB 2 ;VAR EXISTS, OR SYNTAX TIME TSYNT12: LD A,(FLAGS) ADD A,A ;P IF STRING, CY IF RUNNING JP P,TSYNT13 ;JP IF STRING BIT 5,C JR Z,TSYNT14 ;JR IF A SIMPLE NUMBER, NOT AN ARRAY ;ELSE STKVAR HANDLES NUMERIC ARRAYS TSYNT13: CALL STKVAR ;PASS ARRAY/STRING DATA TO FPCS. EXIT WITH HL ;PTING TO VALUE, IF NUMERIC ARRAY, ELSE FPCS ;HOLDS STRING DETAILS LD A,(FLAGS) ADD A,A ;CY IF RUNNING, -VE IF NUMERIC JP M,TSYNT15 ;JP IF NUMERIC - HL PTS TO VALUE, PAGED IN CALL C,STKFETCH ;GET DE=START, BC=LEN, A=PAGE (IN VARS). BIT 7=1 EX DE,HL ;IF 'OLD COPY TO BE DELETED' AS IN 'LET A$="SS"' JR TSYN16 TSYNT14: EX DE,HL ;FOR NUMERICS AND NEW STRING/ARRAY VARS, STRLEN=TYPE/LEN FROM VARS AND JUNK; ;FOR EXISTING STRING/ARRAY VARS, STRLEN=LENGTH ; IF 'OLD COPY TO BE DELETED' BIT 7 OF DESTP=1 ; TLBYTE=REQUESTED TYPE/LEN, FIRLET=NAME TSYNT15: IN A,(251) AND 1FH TSYN16: LD (STRLEN),BC LD (DEST),HL ;ADDRESS OF NUMERIC OR STRING VALUE, OR PTR/STOPPER LD (DESTP),A ;PAGE OF STRING START, OR CURRENT PAGE IF NUMBER LD B,(HL) INC HL LD A,(HL) INC A OR B INC HL OR (HL) INC HL OR (HL) ;IF VAR STARTS 00 FF 00 00, A=0 LD (DFTFB),A ;IRREL IF NVAR NON-EXISTENT ;CALLED BY 'DIM' SCOPNM: LD DE,TLBYTE+33 ;CALLED BY 'RECORD TO' SCOPN1: LD HL,TLBYTE LD A,(HL) AND 1FH ;NAME LEN-1 IF NUMERIC, TRUE NAME LEN IF STR/ARRAY ADD A,2 ;ALLOW FOR TLBYTE AND (PERHAPS) ANOTHER LETTER LD C,A ;CALLED BY LENGTH SR SCOPN2: LD B,0 LDIR ;COPY NAME TO BUFFER THAT WON'T BE USED BY EVAL JP SELCHADP ;FIND START AND LEN OF AN EXISTING STRING, OR START OF A NUMBER IN AN ARRAY ;ON ENTRY: DE PTS TO PAGES OF VAR LEN, THEN LENGTH MOD 16K. C=T/L. CY IF RUNNING ;CHAD POINTS PAST '$' OR '(' (UNLESS ERROR) STKVAR: EX DE,HL ;HL PTS TO PAGES OF LEN IF RUNNING STKVAR2: JR C,SVRUNT ;JR IF RUNNING BIT 6,C JR NZ,SVSSL ;JR IF STRING ARRAY OR SLICED STRING BIT 5,C RET Z ;RET IF SIMPLE UNSLICED STRING - NO ACTION ;CONTINUE WITH NUMERIC ARRAYS DB 0FEH ;'JR+1' SVDSL: RST 20H ;CALLED BY 'DIM' SYNTAX CHECK - CHECK N,N,...N) SVDSK: CALL EXPT1NUM CP "," JR Z,SVDSL SVIBH: JP INSISCBRK ;')' ;CHECK STRING ARRAY SYNTAX; E.G. ), N,X TO Y) OR N,N,TO Y) OR N,N,Y TO) SVSSL: RST 18H CP ")" JR Z,SVSL3 ;ALLOW '()' DB 0FEH ;'JR+1' SVSSLP: RST 20H CP TOTOK JR Z,SVSL2 CALL EXPT1NUM CP "," JR Z,SVSSLP CP TOTOK JR Z,SVSL2 CALL INSISCBRK JR SLPXHP SVSL2: RST 20H ;SKIP 'TO' CP ")" JR Z,SVSL3 ;SKIP ')' IF IT IS ONE CALL EX1NUMCB ;ELSE ACCEPT 'N)' DB 0FEH ;'JR+1' SVSL3: RST 20H ;SKIP ')' SLPXHP: JP SLLPEX ;SET 'STRING' STATUS (DISTURBED BY 'EXPT1NUM') ;******************************************************************************* ;STACK VAR - RUN TIME SVRUNT: LD A,C AND 60H JR NZ,SVARRAYS ;JR IF ARRAY, ELSE HANDLE SIMPLE STRING BY ;CONVERTING THE PAGE/LEN MOD 16K DATA IN VARS TO 2 ;BYTES (SIMPLE STRINGS HAVE LEN 0000-FFFF) LD A,(HL) ;PAGES (0-3) INC HL LD C,(HL) INC HL RRCA RRCA ;??00 0000 OR (HL) LD B,A ;BC=LEN LD D,80H SVSIMPLE: EX DE,HL INC DE ;PT TO TEXT IN A,(251) BIT 6,D JR Z,SVSS2 ;JR UNLESS STR. STARTED AT E.G. BFFF, PTR NOW C001 RES 6,D INC A SVSS2: AND 1FH OR H ;BIT 7 SET (DELETE OLD COPY) IF SIMPLE STRING ;BIT 7 RES (OVERWRITE) IF 1-DIM STRING ARRAY CALL STKSTORE ;DE=ST, BC=LEN, A=START PAGE ;BIT 6,(FLAGS) IS CORRECT ALREADY CALL SELCHADP LD A,(TLBYTE) BIT 6,A RET Z ;RET IF NO BRACKET AFTER NAME - NO SLICING JP SLCL2 SVARRAYS: INC HL INC HL INC HL LD B,(HL) ;NO. OF DIMS BIT 5,C JR NZ,SVCDIS ;JR IF NUMERIC ARRAY DJNZ SVCKS ;JR IF MULTI-DIM STRING ARRAY (B=DIMS-1) LD D,B ;D=0 SO BIT 7,A LEFT AS ZERO (SIGNALS 'OVERWRITE') INC HL LD C,(HL) INC HL LD B,(HL) ;BC=LEN OF SINGLE DIMENSION ($) JR SVSIMPLE ;HANDLE LIKE A SIMPLE STRING SVCKS: LD A,(TLBYTE) ;CHECK THAT SLICING WAS USED TO REFER TO MULTI-DIM AND 40H ;STRING ARRAY JR Z,SWERHP ;ERROR IF NOT. SVCDIS: IN A,(URPORT) PUSH AF ;PAGE OF ARRAY DIM DATA PUSH BC ;B=DIM COUNT (EXCLUDING FINAL DIM IF STRING) INC HL ;PT TO FIRST DIM SIZE PUSH HL XOR A CALL STACKA ;ZERO TOTAL OF FPCS POP HL ;PTR TO DIMN. DATA IN BUFFER. POP BC ;B=DIMS (1 OR MORE, EXCLUDING LAST DIM IF STRING) SVLOOP: POP AF PUSH AF OUT (URPORT),A ;PAGE IN DIMS PUSH BC ;DIM COUNTER IN B LD C,(HL) INC HL LD B,(HL) ;BC=NEXT DIM SIZE=LIMIT VALUE FOR SUBSCRIPT INC HL PUSH HL ;PTR TO DIMN. DATA PUSH BC ;DIM SIZE CALL SELCHADP ;PAGE IN SUBSCRIPT CALL STACKBC ;DIM SIZE POP BC ;BC=DIM SIZE AGAIN CALL GETSUBS ;GET SUBSCRIPT IN HL, CHECKING IT'S >0 AND <=LIMIT, ;THEN DECING IT. SWERHP: JP NC,SWER2 ;ERROR IF OUTSIDE LIMITS CALL STACKHL DB CALC ;TOTAL,DIM SIZE,SUBS VAL DB SWOP13 ;SUBS VAL,DIM SIZE,TOTAL DB MULT DB ADDN ;TOTAL*DIM SIZE+SUBS VALUE DB EXIT POP DE ;ARRAY DATA PTR POP BC ;DIM COUNTER RST 18H DEC B JR Z,SVEXLP ;JR IF ALL DIMS DONE CP "," JR NZ,SWER2 ;INSIST ON A COMMA NOW RST 20H ;SKIP ',' EX DE,HL ;HL PTS TO DIMN. DATA JR SVLOOP ;PAGE OF ARRAY START IS ON STACK, DE=ADDR OF ARRAY START SVEXLP: BIT 5,C JR NZ,SVNUMER ;JR IF NUMERIC ARRAY POP AF OUT (URPORT),A ;PAGE IN DIMS EX DE,HL ;ALLOW LAST SUBSCRIPT OR SLICER, FOR STRINGS LD C,(HL) INC HL LD B,(HL) INC HL EX DE,HL ;DE PTS TO ARRAY START PUSH BC ;LAST SUBSCRIPT LEN CALL SVSR ;GET START ADDR OF DESIRED STRING IN AHL POP BC EX DE,HL CALL STKST0 ;STORE STRING ADDR, BIT 7,A=0 ('DON'T ERASE OLD') CALL SELCHADP RST 18H CP ")" JR Z,SVDIM ;JR IF NO SLICE OF STRING SO FAR. E.G. A$(3) CP "," JR Z,SLCL ;OK TO HAVE E.G. A$(3,2 TO 5) SWER2: RST 08H ;ANYTHING ELSE IS AN ERROR DB 4 ;'Subscript wrong' SVDIM: RST 20H CP "(" JR NZ,SLLPEX SLCL: RST 20H ;SKIP '(' OR ',' SLCL2: CALL SLICING JR SVDIM SLLPEX: LD HL,FLAGS RES 6,(HL) ;'STRING' RET ;END OF NUMERIC ARRAY SVNUMER: CP ")" JR NZ,SWER2 RST 20H ;SKIP ')' LD BC,5 POP AF ;PAGE CALL SVSR JP TSURPG ;STACK BC (LAST DIMN. LEN, OR 5 FOR NUMBERS), MULT, ADD ARRAY 'TEXT' START ;EXIT WITH AHL=ADDR OF ELEMENT SVSR: PUSH AF ;PAGE OF ARRAY START PUSH DE ;ARRAY START CALL STACKBC DB CALC ;TOTAL, LAST DIM SIZE DB MULT ;DISP TO ELEMENT WANTED DB EXIT CALL UNSTLEN ;AHL=PAGES/ MOD 16K FORM POP DE POP BC LD C,B ;CDE=ADDR OF TEXT START (8000-C???) BIT 6,D JR Z,SVSR2 ;JR IF PAGE OK INC C ;ELSE INC PAGE (ADDAHLCDE IGNORES BIT 6) SVSR2: JP ADDAHLCDE SLICING: CALL RUNFLG CALL C,STKFETCH ;GET ADE=START, BC=LEN, IF RUNNING PUSH AF ;PAGE RST 18H POP HL ;H=PAGE CP ")" JR Z,SLSTORE ;JR IF SLICE WAS () (ENTIRE STRING) LD (TEMPB2),A ;NZ SHOWS NO ERROR IN SUBSCRIPT YET PUSH DE ;STRING START PUSH HL ;H=PAGE OF START LD DE,0 ;DEFAULT SLICER START CP TOTOK JR Z,SLSEC ;JR IF E.G: ( TO X) - USE DE=1 CALL GETSUBS ;ELSE EVAL E.G. S OF (S TO T) USING BC AS LIMIT EX DE,HL ;DE=SUBS. VAL, CHECKED >0 AND <=LEN, THEN DECED RST 18H CP TOTOK JR Z,SLSEC ;WE HAVE FIRST NUMBER IN DE - JR IF 'TO' FOLLOWS IT CP ")" NONSH: JR NZ,SWER2 ;WAS NONS LD H,D LD L,E ;LAST NUMB=FIRST NUMB IF EG (5) JR SLDEF ;JR WITH NUMBERS IN HL AND DE SLSEC: RST 20H CP ")" LD H,B LD L,C DEC HL ;HL=LEN-1 (VALUES ALL USE 'DECED' FORM) JR Z,SLDEF ;JR IF EG (X TO ) OR ( TO ) - USE LEN AS 2ND NUMB. PUSH DE ;FIRST NUM CALL GETSUBS ;EVAL SECOND NUMBER, CHECKING >0, <=LEN, DECING POP DE ;FIRST NUMBER JR C,SLSE2 ;JR IF IN RANGE OR SYNTAX TIME LD A,H OR L JR Z,SLND ;NULL STRING, NOT ERROR, IF E.G. (2 TO 0) SLSE2: PUSH HL RST 18H POP HL ;SECOND NUMB IN HL, FIRST IN DE CP ")" JR NZ,NONSH SLDEF: SBC HL,DE ;SUB 2ND,1ST (NC HERE) LD BC,0 ;NUL LEN IF EG (5 TO 2) JR C,SLNUL LD A,(TEMPB2) AND A JP Z,SWER2 INC HL SLND: LD B,H LD C,L ;BC=STR LEN SLNUL: POP AF POP HL ;STRING START IN AHL (HL=8000-BFFF) ADD HL,DE ;ADD START, FIRST SLICER NUMBER-1 (DEFAULT=0) CALL C,PGOA ;ADJUST FOR PAGE OVER FLOW IF NEEDED BIT 6,H JR Z,SLDF2 RES 6,H INC A SLDF2: EX DE,HL ;ADE=SLICER START, BC=LEN LD H,A SLSTORE: LD A,(FLAGS) AND 0BFH LD (FLAGS),A ;'STRING' RLA RET NC ;RET IF NOT RUNNING LD A,H ;PAGE JP STKST0 ;STACK STRING, 'NO DELETE OF OLD' ;DIM.SAM DIM: CALL LOOKVARS IN A,(URPORT) ;PAGE OF STRING/ARRAY IF FOUND EX AF,AF' ;SAVE NZ IF FOUND PUSH BC CALL SCOPNM ;CHADP BACK IN NOW POP BC ;C=TYPE BYTE OF ARRAY LD A,(TLBYTE) ;TYPE BYTE FOR DIM NAME (VARS MAY HOLD STRING) AND 60H JP Z,NONSENSE ;ERROR IF NO OPENING BRACKET USED CALL RUNFLG JR C,DIMRUN ;JR IF RUNNING CALL SVDSK ;CHECK N,N,...N) DIM2: CP "," RET NZ ;RET UNLESS ANOTHER ARRAY FOLLOWS RST 20H ;SKIP ',' JR DIM ;ALLOW 'DIM A(8),B(6,5),A$(2)' ETC. DIMRUN: EX AF,AF' ;PAGE OF STRLOCN PUSH BC ;TYPE BYTE SAVED IN C CALL NZ,ASDL1 ;DELETE ARRAY POINTED TO BY STRLOCN IF IT EXISTS CALL SELCHADP POP BC ;C=TYPE/LEN BYTE BIT 5,C LD BC,1 JR Z,DIM4 ;JR IF A STRING ARRAY OR STRING FOUND IN VARS LD C,5 DIM4: CALL STACKBC ;ON EXIT B STILL=0...DIM COUNT DB 0FEH ;'JR+1' DIMSZLP: RST 20H ;SKIP ',' CALL GETSUBS ;GET SUBS-1 IN HL INC HL PUSH HL ;STACK DIM SIZE ON MACHINE STACK BEHIND DIM COUNTER PUSH BC CALL STACKHL ;AND ON FPCS DB CALC DB MULT ;GET E.G. 5*DIM1*DIM2 OR 1*DIM1 DB EXIT POP BC INC B ;INC DIM COUNTER RST 18H CP "," JR Z,DIMSZLP CALL INSISCBRK ;')' PUSH BC ;B=DIMS LD L,B LD H,0 ;HL=DIMS ADD HL,HL ;GET SPACE NEEDED BY WORD DIM SIZE INFO, PLUS 1 INC HL ;FOR NO. OF DIMS CALL STACKHL DB CALC ;'TEXT' SIZE, DIM INFO SIZE DB SWOP ;DIM INFO SIZE, 'TEXT' SIZE DB DUP ;DIS, TS, TS DB SWOP13 ;TS, TS, DIS DB ADDN ;TS, TS+DIS DB DUP ;TS, TS+DIS, TS+DIS DB ONELIT DB 14 ;TS, TS+DIS, TS+DIS, 14 DB ADDN ;TS, TS+DIS, TS+DIS+14 DB EXIT ;ARRAY 'TEXT' SIZE, SIZE LESS HDR, TOTAL ARRAY SIZE CALL UNSTLEN ;GET ABC=TOTAL LEN (PAGE FORM) CALL SAROOM ;OPEN ABC BYTES AT END OF SAVARS, LDIR T/L BYTE, ;NAME TO START, EXIT WITH DE PTING TO PAST NAME PUSH DE CALL UNSTLEN ;SIZE EXCLUDING 14-BYTE HEADER EX DE,HL ;ADE=SIZE INFO FOR AFTER 14-BYTE HDR POP HL LD (HL),A ;PAGES INC HL LD (HL),E INC HL LD (HL),D ;LEN MOD 16K INC HL POP AF LD (HL),A ;DIM COUNT LD E,A LD D,0 ADD HL,DE ADD HL,DE ;PT TO LOCN FOR MSB OF LAST DIM LD D,H LD E,L ;SAVE IT IN DE TOO DIMENTLP: POP BC ;POP A DIM SIZE LD (HL),B DEC HL LD (HL),C ;ENTER IT IN ARRAY HEADER DEC HL ;(DIM SIZES COME OFF STACK IN REVERSE ORDER) DEC A JR NZ,DIMENTLP PUSH DE CALL UNSTLEN CALL AHLNORM ;GET LEN-TO-CLEAR AS 19-BIT NUMBER POP DE EX DE,HL ;ADE=19 BIT NO. INC HL ;HL PTS TO START OF AREA TO CLEAR LD B,E ;B=LEN MOD 256 LD E,D LD D,A ;DE=256-BYTE PAGES LD A,B AND A JR Z,DIMNAC INC DE ;INC DE (UNLESS B=0). ALLOWS B AND DE TO ACT AS ;SEPARATE COUNTERS. DE IS *NEVER* ZERO DIMNAC: LD A,(TLBYTE+33) AND 40H ;Z IF NUMERIC LD C," " JR NZ,GARC ;JR IF STR ARRAY, C=' ' FOR CLEARING ARRAY LD C,A ;USE ZERO TO CLEAR NUMERIC ARRAYS GARC: CALL CHKHL ;CHECK WE ARE IN 8000-BFFF AREA DIMCLP: LD (HL),C INC HL DJNZ DIMCLP DEC DE LD A,D OR E JR NZ,GARC CALL SELCHADP RST 18H JP DIM2 SAROOM: PUSH AF CALL ADDRELND ;ADDRESS ELINE AND DEC PTR - PT TO END OF SAVARS POP AF CALL MKRBIG ;OPEN ABC BYTES (PAGE FORM) AT (HL) EX DE,HL ;DE PTS TO ROOM LD HL,TLBYTE+33 LD BC,11 LDIR ;COPY TYPE/LEN AND NAME TO SAVARS RET ;ENTRY: CHAD PTS TO A SUBSCRIPT VALUE. BC=LIMIT GETSUBS: PUSH BC CALL EXPT1NUM JR C,GTSBC POP BC RET ;JUST CHECK FOR A NUMBER IN SYNTAX TIME ;ENTRY: CHAD PTS TO A SUBSCRIPT VALUE. RUN TIME! ;ACTION: GET A SUBSCRIPT VALUE IN HL, CHECKING IT IS <= LIMIT IN BC, AND <>0 ;BC AND DE UNCHANGED. HL DECED BEFORE RETURN ;GTSUBS: PUSH BC ; CALL EXPT1NUM GTSBC: CALL GETINT ;IN HL, A=L POP BC ;LIMIT VALUE OR H JR Z,SWSIG ;SUBSCRIPT 0 IS ALWAYS AN ERROR DEC HL ;REDUCE BY 1 TO GIVE ALLOWED RANGE 0 TO LIMIT-1 SBC HL,BC ;IF BC=FFFF, 1-FFFF IS OK ADD HL,BC RET C SWSIG: XOR A LD (TEMPB2),A RET INCLUDE FN.SAM ;DEF FN, FN, COMPILE, DEF PROC, LOCAL, PROC ;FN.SAM ;COMPILE DEF PROCS ELCOMAL: LD A,(REFFLG) CP 1 ;CY IF ZERO CCF ;CY IF NZ (FN USED) COMALL: CALL C,COMDF ;COMPILE FNS COMDP: CALL COMLEN ;SWITCH IN PROG, GET BC AND B' AS PROG OR ELINE LEN CMDPL: LD D,0FDH CALL LKCALL ;LOOK FOR PROC CALLING BUFFER FROM HL ONWARDS RET C ;RET IF NO MORE ;ELSE HL POINTS TO BUFFER, PAGED IN PUSH BC ;BYTES LEFT CALL LOOKDP ;LOOK FOR DEF PROC name, ALTER CALLING BUFFER TO POP BC ;PAGE/ADDR IF FOUND, ELSE FLAG AS 'NO DEF PROC' JR CMDPL ;COMPILE DEF FNS ;FIRST, DO A PASS TO MAKE A TABLE OF ALL DEF FNS AS PAGE/ADDR; LOOKING ;THROUGH THE PROGRAM EACH TIME IS TOO SLOW. COMDF: LD HL,INSTBUF LD (TEMPW1),HL ;INIT PTR TO TABLE STORE CALL ADDRPROG ;SWITCH IN PROG LD A,(HL) INC A RET Z ;RET IF NO PROGRAM INC HL INC HL INC HL DFPPL: INC HL LD (CHAD),HL ;CHAD STARTS AT 1ST CHAR OF FIRST LINE, LATER ;IS RESET TO JUST AFTER EACH DEF FN FOUND LD E,0C8H ;DEFFNTOK CALL SRCHPROG ;LOOK FOR DEF FN FROM CHAD ON JR NC,CMDF2 ;JR IF ALL DONE ;ELSE HL POINTS PAST 'DEF FN' EX DE,HL DEC DE ;DE PTS TO 'DEF FN' LD HL,(TEMPW1) LD BC,-INSTBUF-509 ADD HL,BC JR C,TMDERR ;'Too many definitions' IF PTR >=INSTBUF+509 ;ALLOWS UP TO 170 DEF FNS. SBC HL,BC IN A,(251) LD (HL),A INC HL LD (HL),E INC HL LD (HL),D INC HL LD (TEMPW1),HL EX DE,HL JR DFPPL ;USED BY 'DEF FN' COMPILER AND 'DEF KEYCODE' TMDERR: RST 08H DB 52 ;'Too many definitions' CMDF2: CALL COMLEN ;SWITCH IN PROG, GET BC AND B' AS PROG OR ELINE LEN CMDFL: LD D,0FEH CALL LKCALL ;LOOK FOR CALLING BUFFER FROM HL ONWARDS RET C ;RET IF NO MORE ;ELSE HL POINTS TO BUFFER, PAGED IN PUSH BC ;PROG LEN LEFT (MOD 16K) CALL LOOKDF ;LOOK FOR DEF FN name, ALTER CALLING POP BC ;BUFFER TO PAGE/ADDR IF FOUND, OR FLAG 'NO DEF FN' JR CMDFL COMLEN: LD A,(COMPFLG) RLA JR C,PRGLEN ;JR IF PROGRAM BEING COMPILED CALL ADDRELN ;ELSE IT IS ELINE PUSH HL ;ELINE EX DE,HL LD C,A ;CDE=ELINE LD HL,(WORKSP) LD A,(WORKSPP) JR CPLENC ;SWITCH IN PROG, GET B'=8K BLOCKS IN PROG LEN, PLUS 1, BC=LEN MOD 8K PRGLEN: CALL ADDRPROG PUSH HL ;PROG EX DE,HL LD C,A ;CDE=PROG LD HL,(NVARS) LD A,(NVARSP) CPLENC: CALL SUBAHLCDE ;GET PROG LEN (PAGE FORM) PUSH HL ADD HL,HL ADD HL,HL ADD HL,HL RLA ;A=8K BLOCKS EXX INC A LD B,A EXX POP BC LD A,B AND 1FH LD B,A ;BC=LEN MOD 8K POP HL ;PROG RET ;LKCALL - LOOK FOR PROC OR FN CALL BUFFER ;BY CHECKING FOR NOT-0E 0E FD/FE FD/FE PG+80H/ADDR/LETTER. ;NO CONFUSION WITH NORMAL 0E FORMS BECAUSE THOSE ARE NOT FOLLOWED BY A LETTER, ;OR PRECEDED BY 0EH. ;NO CONFUSION WITH LINE NUMBERS BECAUSE 0E FE FE 80 = LINE LEN >32768! ;ENTRY: HL=START OF SEARCH, D=TARGET (FD/FE=PROC/FN), BC=LEN TO SEARCH, MOD 8K ;B'=8K BLOCKS (ALLOWS ROOM AFTER TARGET FOUND, TO INCREMENT PTRS) ;EXIT: HL POINTS TO LOCN FOR 'PAGE' IN CALLING BUFFER, BUFFER HOLDS LEN/NAME ;OF CALLING NAME, IF NC, ELSE CY SHOWS NO TARGETS FOUND. LKCALL: LD A,B OR C JR Z,LPC5 ;JR IF TIME FOR NEXT BLOCK LD A,D ;FE IF FN BUFFER WANTED, FD IF PROC CALL BUFFER CPIR JR NZ,LPC5 ;JR IF FD/FE NOT FOUND (BC=0) CP (HL) ;CHECK FOR SECOND FDH/FEH JR NZ,LKCALL ;KEEP LOOKING IF RED HERRING DEC HL DEC HL LD A,0EH CP (HL) ;THERE SHOULD BE A PRECEDING 0EH JR Z,LPC3 LPC2: INC HL INC HL JR LKCALL ;IF THERE IS NOT, CONTINUE SEARCH LPC3: DEC HL CP (HL) ;THERE SHOULD ONLY BE *ONE* PRECEDING 0EH INC HL ;(EXCLUDE SPURIOUS 0E 0E FE FE 80 41, SAY) INC HL INC HL JR Z,LKCALL ;LOOP BACK IF SPURIOUS (JUST AN ODD NUMBER) INC HL ;PT TO PROBABLE PAGE LD A,(HL) DEC HL ;TO SECOND FD/FE AGAIN RLA JR NC,LKCALL ;JR IF NOT 0E FE FE (>=80H). ;(AT SYNTAX CHECK, CALLING BUFFER IS CREATED WITH ;'PAGE' FD OR FEH) PUSH HL ;PTR TO SECOND FD/FE PUSH BC ;LEN LEFT TO SEARCH FOR OTHER BUFFERS DEC HL ;FIRST FD/FE DEC HL ;0EH LD BC,00FFH ;NAME LEN WILL INC TO ZERO START VALUE. B=0 FDFLP: DEC HL INC C ;NAME LEN LD A,(HL) CP "$" JR Z,FDFLP ;NAME CAN END IN '$' CALL ALNUMUND ;CHECK FOR VALID NAME CHARS (ALPHA-NUMERICS OR '_') JR C,FDFLP ;LOOP BACK PAST THE NAME, TO THE FFH FN LEADER, ;SPACE, CC, MSB OF LINE LEN OR ':', OR FFH AT ;SAVARS END (IF PROC) INC A JR NZ,LPC4 ;JR IF NOT FF 42 ('FN') LD A,D CP 0FDH JR Z,LPC4 ;JR IF PROC INC HL ;SKIP FFH DEC C ;DEC LEN BECAUSE OF FALSE INCLUSION OF 42H LPC4: INC HL ;PT TO FIRST NAME CHAR LD DE,NMBUFF LD A,C DEC A ;** AND 1FH ;** INC A ;** LIMIT LDIR LEN LD C,A ;** LD (DE),A ;LEN AT BUFFER START INC DE LDIR ;COPY NAME TO BUFFER+1 POP BC ;BYTES LEFT POP HL ;PTR TO SECOND FD/FE (WHERE CPIR HALTED) RET LPC5: LD B,20H ;C=0. DO ANOTHER 8K. (IF BLOCKS NOT ZERO YET) CALL CHKHL EXX DEC B EXX JR NZ,LKCALL ;DO B' BLOCKS SCF ;NO MORE CALLING BUFFERS RET ;LOOK DEF FN ;LOOK FOR 'DEF FN' FOLLOWED BY A SPECIFIC NAME, AND PATCH FN CALL BUFFER LOOKDF: PUSH HL ;CALLING BUFFER ADDR (SECOND FD/FE) IN A,(251) PUSH AF ;CALLING BUFFER PAGE LD HL,INSTBUF ;START OF TABLE OF PAGE/ADDR FOR EACH DEF FN LKDFLP: LD BC,(TEMPW1) ;END OF TABLE (PAST LAST ENTRY) AND A SBC HL,BC ;NC IF PTR HAS REACHED END ADD HL,BC JR NC,LKDP4 ;JR IF ALL TABLE ENTRIES TRIED WITHOUT SUCCESS. ;MARK BUFFER 'NO DEF FN' LD A,(HL) ;PORT VALUE INC HL LD E,(HL) INC HL LD D,(HL) INC HL OUT (251),A PUSH HL CALL MATCHER ;MATCH DE+1 VS. BUFFER POP HL JR C,LKDFLP ;LOOP IF MATCH FAILED JR LKDP3 ;ELSE JR AND PATCH BUFFER ;LOOK DEF PROC ;LOOK FOR 'DEF PROC' FOLLOWED BY A SPECIFIC NAME, AND PATCH PROC CALL BUFFER ;AT HL WITH PAGE/ADDR OF ADDR AFTER NAME, OR PAGE FFH IF NOT FOUND ;ENTRY: NAME LEN IS IN BUFFER, FOLLOWED BY NAME. HL POINTS TO PROC CALL BUFFER, ;SWITCHED IN LOOKDP: PUSH HL ;CALLING BUFFER ADDR IN A,(251) PUSH AF ;CALLING BUFFER PAGE CALL ADDRPROG ;START AT (PROG) DB 0FEH ;'JR +1' LKDPLP: ADD HL,DE ;PT TO START OF NEXT LINE LD BC,2100H+0CAH ;DEFPROCTOK CALL LKFC ;LOOK FOR A DEF PROC AT LINE STARTS JR C,LKDP4 ;JR IF NONE FOUND - MARK BUFFER 'NO DEF PROC' ;ELSE HL PTS TO FIRST CHAR IN LINE, ;CHAD PTS TO 'DEF PROC' PUSH DE ;LEN OF TEXT PUSH HL ;START OF TEXT IN THIS LINE LD DE,(CHAD) CALL MATCHER ;MATCH (DE+1) VS. (BUFFER+1) POP HL POP DE JR C,LKDPLP ;JR IF FAILED TO MATCH DEC HL DEC HL DEC HL DEC HL EX DE,HL ;ELSE PT DE TO LINE START LKDP3: LD B,80H LKDP35: IN A,(251) AND 1FH OR B LD B,A ;B=PAGE WITH DEF PROC NAME, BIT 7 SET DB 21H ;'JR+2' LKDP4: LD B,0FFH ;'NO DEF PROC/DEF FN' POP AF OUT (251),A ;BACK TO PROC CALL PAGE POP HL PUSH HL INC HL LD (HL),B ;PAGE INC HL LD (HL),E INC HL LD (HL),D ;ADDR OF PAST NAME OR LINE START (OR JUNK IF B=FF) POP HL ;PTR TO SECOND FD/FE (WHERE CPIR STOPPED) RET ;MATCH (HL) VS (FIRLET) OVER T/L+1 BYTES (NAMELEN) ;EXIT AS MATCHER - NOTE *DE* PTS PAST NAME MATCHERF: LD DE,TLBYTE ;CALLED BY FOR WITH DE=TLBYTE+33 MATCHFN: EX DE,HL LD A,(HL) AND 1FH INC A LD B,A ;B=NAME LEN INC HL JR MTCCM ;MATCH NAME AT (DE+1) VS NAME AT BUFFER+1 OVER (BUFFER) BYTES. SPACES IN ;(DE+1) NAME IRRELEVANT (BUT PROC AND FN NAMES HAVE NO SPACES). SPACES ;SHOULD NOT BE PRESENT IN BUFFER NAME. ;EXIT: NC IF MATCHED OK, DE PTS PAST CANDIDATE NAME, HL PAST BUFFER NAME ;USES HL, B, A. MOVES DE MATCHER: LD HL,NMBUFF ;NAME WE ARE LOOKING FOR IS AT BUFFER+1 LD B,(HL) ;NAME LEN INC HL MSKIP: INC DE MTCCM: LD A,(DE) CP 20H JR Z,MSKIP ;SKIP ANY SPACES IN CANDIDATE NAME ;MIGHT BE USED BY PROC SRS??!! XOR (HL) INC HL AND 0DFH ;IGNORE CASE MISMATCH. SCF RET NZ ;RET IF FAILED (CY) DJNZ MSKIP ;MATCH B SIGNIF. CHARS INC DE LD A,(DE) ;WE MATCHED OK SO FAR - BUT CANDIDATE NAME MUST JP ALNUMUND ;END NOW - GET CY IF NOT TERMINATED ;FN HANDLING (CALLED BY EVALUATOR) ;E.G. PRINT FN OCTAL(345) ; PRINT FN OCTAL 0E FE FE PG+80H ADDRL ADDRH (345 0E 1 2 3 4 5) ; PAGE AND ADDR ARE PTR TO '(' OR '=' IN DEF FN IMFN: CALL RUNFLG JP NC,FNSYN ;JR IF NOT RUNNING RST 20H ;SKIP 'FN' LD A,0EH FNRL: CP (HL) INC HL JR NZ,FNRL ;LOOP TILL 0EH FOUND INC HL ;SKIP FEH INC HL ;SKIP FEH LD B,(HL) ;PAGE OF DEF FN, +80H BIT 5,B JR NZ,MDFERR ;ERROR IF NO DEF FN INC HL LD E,(HL) INC HL LD D,(HL) ;ADDR OF PAST NAME IN DEF FN LD (CHAD),HL ;PT CHAD TO END OF BUFFER RST 20H CP "(" JR NZ,FNBF2 CALL FORESP ;GET SIGNIF CHAR AFTER '(' CP ")" JR NZ,FNBF ;JR IF NO '()' TO SKIP RST 20H ;SKIP '(' RST 20H ;SKIP ')' FNBF: CP A ;Z FNBF2: EX AF,AF' ;Z IF FN HAS BRACKETS (IF EMPTY, CHAD PTS PAST) EX DE,HL LD A,B CALL TSURPG ;HL POINTS TO '(' OR '=' IN DEF FN E.G. ;DEF FN TEST=123 OR DEF FN TEST(A,B)=A*B LD A,(HL) SUB "=" JR NZ,FNBC PUSH AF ;DEFADD=00XX EX AF,AF' JR NZ,FNR6 ;EVAL RESULT OF NO-PARAM DEF FN IF FN HAS NO ;BRACKETS EITHER. ELSE ERROR PARAMERR: RST 08H DB 26 ;'Parameter error' MDFERR: RST 08H DB 7 ;'FN without DEF FN' FNBC: EX AF,AF' JR NZ,PARAMERR ;IF DEF FN HAS BRACKETS, FN MUST TOO CALL FORESP ;SKIP '(', GET NEXT SIGNIF CHAR SUB ")" PUSH AF JR Z,FNRLE ;JR IF NO PARAMS IN DEF FN - DEFADD=00XX POP AF PUSH HL ;ADDR USED FOR DEFADD FNRLA: INC HL ;INITIALLY, SKIP VAR LETTER LD A,(HL) CP 0EH JR NZ,FNRLA ;LOOP TILL 0EH MARKER OF PARAM BUFFER IN DEF FN FND IN A,(251) PUSH AF ;PAGE OF DEF FN DEC HL LD A,(HL) ;'$' OR NUMERIC VAR LETTER PRECEDES 0EH BUFFER SUB "$"-1 INC HL INC HL ;PT TO 5-BYTE BUFFER PUSH AF ;A=1 IF '$' PUSH HL CALL SELCHADP ;LOOK AT CHAD (FN '(' OR ',') CALL SEXPTEXPR ;EVAL FN ARG. Z IF STRING POP DE ;5 BYTE BUFFER IN DEF FN POP BC ;B=1 IF STRING VALUE EXPECTED JR Z,FNR3 ;JR IF STRING VALUE DJNZ FNR4 ;JR IF TYPE OK FNR3: DJNZ PARAMERR ;JR IF TYPE MISMATCH FNR4: CP ")" JR NZ,FNR5 EX AF,AF' RST 20H ;SKIP FINAL ')' IF WE REACHED IT EX AF,AF' FNR5: EX AF,AF' ;SAVE CHAR AFTER FN EXPR. POP AF OUT (251),A ;DEF FN PAGE SELECTED CALL FDELETE ;DEL. EXPR (FROM FN PARAM). HL PTS TO IT ON EXIT. LD BC,5 LDIR ;COPY TO DEF FN BUFFER EX DE,HL ;HL POINTS PAST 5 BYTES IN DEF FN BRACKETS CALL FORESP1 ;LOOK FOR SIGNIFICANT CHAR IN DEF FN - ')' OR ',' LD B,A EX AF,AF' ;CHAR AFTER FN EXPR - ')' OR ',' CP B JR NZ,PARAMERR CP "," JR Z,FNRLA ;JR IF ANOTHER PARAM SHOULD FOLLOW CP ")" JR NZ,PARAMERR FNRLE: INC HL LD A,(HL) CP "=" JR NZ,FNRLE ;LOOP TILL DEF FN '=' FOUND LD BC,1 ;INC CHAD TO SKIP FINAL FN ')' FNR6: LD DE,(CHAD) LD A,(CHADP) LD B,A LD A,(DEFADDP) LD C,A LD (CHAD),HL ;PT CHAD TO '=' IN DEF FN LD HL,(DEFADD) EX (SP),HL LD (DEFADD),HL ;PT DEFADD TO DEF FN BRACKETS IN A,(251) LD (DEFADDP),A LD (CHADP),A PUSH DE ;CHAD PUSH BC ;SAVE CHAD (POINTER TO ')' AFTER FN, OR SOME OTHER ;CHAR IF NO PARAMS. SAVE DEFADD TO ALLOW FN CALLING ;FN. CALL TSURPG CALL SEXPTEXPR ;SKIP '=', EVAL POP BC LD A,C LD (DEFADDP),A LD A,B PUSH AF CALL SETCHADP POP AF ;$/N FLAG POP HL LD (CHAD),HL POP HL LD (DEFADD),HL FNTYP: RET NZ ;RET IF NUMERIC - 'FN' IS NOMINALLY NUMERIC, SO ;RET SETS FLAGS OK POP BC ;ELSE JUNK RET, JP STRCONT ;GOTO STRING FLAG SETTER ;CHECK FN SYNTAX FNSYN: RST 20H ;SKIP 'FN' LD (REFFLG),A ;NZ SHOWS FN USED IN THIS LINE (FOR COMPILER) CALL FNNAME PUSH AF ;A=1 IF STRING LD A,0FEH CALL MKCLBF CP "(" JR NZ,FNSY5 ;JR IF NO PARAMS E.G. FN TEST RST 20H ;SKIP '(' CP ")" JR Z,FNSY4 ;JR IF NO PARAMS E.G. FN TEST () FNARL: CALL SCANNING ;ALLOW NUMERIC OR STRING EXPR LD A,C CP ")" JR Z,FNSY4 CALL INSISCOMA JR FNARL FNSY4: RST 20H ;SKIP ')' FNSY5: POP AF DEC A ;Z IF STRING JR FNTYP ;IF NOT STRING, RET TO SET NUMERIC RESULT ;ELSE JUNK RET ADDR FOR NUMERIC IMMED FNS ;FN NAME ENDED '$'; SET FLAG FOR STRING ;CHECK FN NAME (CALLED BY FN AND DEF FN) FNNAME: CALL GETALPH ;INSIST NAME STARTS WITH A LETTER DFNLP: INC HL LD A,(HL) CALL ALNUMUND JR C,DFNLP ;NAME MAY CONTINUE WITH LETTERS, NUMBERS OR '_' SUB "$" JR NZ,FNN2 INC HL ;SKIP '$' FNN2: INC A ;A=1 IF STRING-TYPE NAME RET LOCAL: CALL RUNFLG LD D," " ;NULL PREVENTS 'LOCAL REF X' BEING ACCEPTED JR NC,DPSY2 ;JR IF SYNTAX TIME XOR A LD (PRPTRP),A LD HL,CARET LD (PRPTR),HL ;PT HL SO LOW THAT IT STAYS ON CR IN ROM CALL ADDRCHAD LD (DPPTRP),A LD (DPPTR),HL CALL DPRA ;GET PROC RET ADDR IN HL, PAGE/TYPE IN A, STAT IN C LD B,A PUSH BC PUSH HL CALL PROP2 ;PROPAR, WITHOUT PLACING TERMINATOR CALL PTTODP ;** LD HL,(BSTKEND) DEC HL DEC HL DEC HL DEC HL POP DE ;ADDR POP BC LD (HL),B ;TYPE/PAGE LD A,C JP SEDA ;STACK STAT, ADDR DEFPROC: CALL RUNFLG JR NC,DPROC2 POP DE ;NEXT STAT RET ADDR LD DE,THENTOK*256+0CBH ;ENDPROCTOK ;(THENTOK=NULL) CALL SEARCH ;CONTINUE AFTER END PROC, OR ERROR DB 13 ;'No END PROC' DPROC2: RST 18H CALL GETALPH ;INSIST ON A LETTER AS FIRST CHAR OF DEF PROC NAME DPNMLP: INC HL LD A,(HL) CALL ALNUMUND JR C,DPNMLP LD (CHAD),HL RST 18H CP 0B9H ;DATATOK JR NZ,DPSY1 RST 20H ;SKIP 'DATA' RET DPSY1: CALL CRCOLON RET Z ;RET IF PARAMS FINISHED LD D,0CEH ;REFTOK ;'LOCAL' SYNTAX CHECK ENTERS HERE WITH D=NULL (SPACE) DPSY2: CP D ;'REF' IF DEF PROC, NULL IF LOCAL JR NZ,DPSY3 ;IF D IS NULL, *ALWAYS* JR RST 20H ;SKIP 'REF' DPSY3: PUSH DE CALL VARAR ;CHECK FOR '()' FORMS CALL NZ,LOOKVARS ;CALL IF NOT ONE CALL RCRC ;RST 18, CRCOLON POP DE RET Z ;RET IF PARAMS FINISHED CALL INSISCOMA JR DPSY2 ;CHECK FOR VAR NAME SUCH AS frogs, price of bread, name$, abc2 ;ENTRY: CHAD PTS TO NAME START. ;EXIT: CHECK FOR LEN OK FOR SPECIAL FORM E.G. TEST$(), ALPHA() ;C=LEN (EXCLUDING SPACES). CY IF OK, NC IF TOO LONG, OR NOT A VAR NAME. VARNAME: RST 18H CALL ALPHA RET NC ;RET WITH NC IF NOT LEGAL FIRST CHAR PUSH HL LD BC,0B00H ;NAME LEN MAX (STR/ARRAY) OF 10. INIT LEN=0 VNMLP: RST 20H INC C ;LEN CALL ALNUMUND JR C,VNMLP CP "$" JR NZ,VNM2 RST 20H ;SKIP '$' VNM2: LD A,C ;NAME LEN CP B EX (SP),HL LD (CHAD),HL ;ORIG CHAD POP HL LD A,(HL) ;A=CHAR AFTER NAME RET ;CY IF LEN OK ;CHECK FOR ODD FORM SUCH AS FRED$(), DOGSARRAY(). ;USED BY 'LOCAL' AND 'DEF PROC' ;IF NOT SPECIAL FORM, CHAD IS UNCHANGED, NZ. ELSE CHAD/HL POINT PAST, A=CHAR VARAR: CALL VARNAME DEC A ;NZ - A IS A SIGNIF CHAR. RET NC ;RET WITH ORIG CHAD IF NOT LEGAL FOR '()' FORM CP "("-1 RET NZ ;RET IF NORMAL VAR. CALL FORESP CP ")" RET NZ ;RET IF E.G. ALPHA(8) - EXPRESSION LD (CHAD),HL RST 20H ;SKIP ')' CP A ;Z=SPECIAL FORM SKIPPED RET ;PROCEDURES ;ENTRY: CHAR BETWEEN 0-8FH FOUND WHEN CMD EXPECTED PROCS: ADD A,90H ;CORRECT FOR PREVIOUS SUB 90H CALL GETALPH RST 18H CALL RUNFLG JR NC,PROCSY ;JR IF SYNTAX CHECK LD A,0EH PRRL: CP (HL) INC HL JR NZ,PRRL ;LOOP TILL CALLING BUFFER FOUND INC HL ;SKIP FD INC HL ;SKIP FD LD B,(HL) ;PAGE BIT 5,B JR NZ,MDPERR ;(BIT 7 IS ALWAYS SET, BIT 6=EXTERNAL CMD, BIT 5 ;IS SET IF 'NO DEF PROC') INC HL LD E,(HL) INC HL LD D,(HL) ;ADDR OF DEF PROC LINE OR EXEC CODE INC HL LD (PRPTR),HL IN A,(251) LD (PRPTRP),A ;SET UP PROC PTR LD A,B LD (DPPTRP),A ;DEF PROC PTR PAGE CALL TSURPG ;SELECT DEF PROC OR EXEC CODE PAGE LD HL,5 ADD HL,DE ;SKIP TO FIRST POSSIBLE DEF PROC NAME START POSN CALL FORESP1 ;SKIP ANY SPACES/CC PRPNM: INC HL LD A,(HL) CALL ALNUMUND JR C,PRPNM ;LOOP PAST DEF PROC NAME LD (DPPTR),HL ;PAST NAME PUSH DE ;DEF PROC LINE ADDR CALL PROPAR ;PROCESS PARAMETERS LD B,40H CALL BSTKE ;STACK A 'PROC-TYPE' RET ADDR INC (HL) ;RET TO *NEXT* STATEMENT POP HL ;DEF PROC LINE ADDR POP DE ;JUNK NEXT STAT LD A,(DPPTRP) LD C,2 ;STAT 2 JP RLEPC2 ;UNSTACK PROC RETURN ADDR, OR ERROR DPRA: LD B,40H ;'PROC' TYPE CALL RETLOOP ;GET C=STAT, HL=ADDR, NZ IF ERROR, A=PAGE RET Z MDPERR: RST 08H DB 12 ;'Missing DEF PROC' PROCSY: INC HL LD A,(HL) CALL ALNUMUND JR C,PROCSY LD A,0FDH CALL MKCLBF ;MAKE BUFFER AFTER NAME CALL CRCOLON RET Z ;RET IF NO PARAMS PCSYL: CALL VARAR ;CHECK FOR '()' FORMS, SKIP IF SEEN CALL NZ,SCANNING ;IF NOT '()' FORM ,EVAL CALL RCRC ;RST 18, CRCOLON RET Z CALL INSISCOMA JR PCSYL ;MAKE CALLING BUFFER AT HL (0E A A A ? ?), PT CHAD AFTER IT TO SIGNIF CHAR, GET ;IT IN A. ENTRY: A=BYTE TO FILL FIRST 3 LOCNS WITH. MKCLBF: PUSH AF CALL MAKESIX ;OPEN 6 BYTES AFTER NAME FOR ADDRESS BUFFER, ;START WITH 0EH POP AF LD (HL),A INC HL LD (HL),A INC HL LD (HL),A INC HL INC HL ;BUFFER= 0E FE FE FE ?? ?? LD (CHAD),HL ;PT CHAD TO PAST BUFFER RST 20H RET MAKESIX: LD BC,6 CALL MAKEROOM LD (HL),0EH INC HL RET ;LOOK FOR A FN VARIABLE ;CALLED FROM EVAL WHEN DEFADD IS SET DURING EVAL (OF DEF FN RESULT) ;ENTRY: HL PTS TO FIRST CHAR OF NAME ;RETS WITH NC IF NOT FOUND, HL SAME - CONTINUE SEARCH IN NORMAL VARS AREA. ;ELSE CY, VAR ALREADY STACKED, NAME SKIPPED, STR/NUM SET, A='$' IF STRING LKFNVAR: CALL RUNFLG RET NC ;RET TO CALLER (EVAL) WITH NC IF SYNTAX TIME PUSH HL ;IN CASE VAR NOT FOUND LD B,(HL) ;VAR LETTER RST 20H CP "$" LD C,0EH JR NZ,LKFV0 LD C,A ;C='$' RST 20H LKFV0: CALL ALNUMUND JR C,LKFVF ;NO SEARCH FOR E.G. 'TEST', 'X1', 'ABC$' - JUST ;SINGLE LETTER VARS LD HL,DEFADD-1 CALL ASV2 ;PT TO PAST '(' IN DEF FN LKFV1: INC HL LD A,(HL) CP 0EH JR NZ,LKFV1 ;LOOK FOR A BUFFER MARKER DEC HL LD A,(HL) CP C ;C='$' IF STRING WANTED, OR 0EH FOR NULL JR NZ,LKFV2 ;JR IF A NUMERIC BUFFER FOUND DEC HL LD A,(HL) ;STRING LETTER INC HL LKFV2: XOR B ;DESIRED LETTER AND 0DFH JR Z,LKFVM ;JR IF MATCHED LD DE,7 ADD HL,DE ;PT PAST 5-BYTE BUFFER CALL FORESP1 CP "," JR Z,LKFV1 ;KEEP CHECKING IF MORE BUFFERS FOLLOW LKFVF: POP HL ;ORIG HL AND A ;NC - SEARCH FAILED RET LKFVM: INC HL ;PT TO 0EH INC HL ;PT TO BUFFER LD A,C CALL HLTOFPCS ;STACK BUFFER DATA POP BC ;ORIG HL LD HL,FLAGS RES 6,(HL) CP "$" SCF RET Z ;CY SHOWS FOUND SET 6,(HL) RET ;INC PTR HL AND RET WHEN IT POINTS TO SIGNIF CHAR FORESP: INC HL ;AVOIDS INITIAL INC FORESP1: LD A,(HL) CP 21H RET NC JR FORESP ;CALLED BY LOAD, DELETE, KEYIN, RENUM SCOMP: LD A,0FFH LD (COMPFLG),A RET ;FROM DELETE/MERGE GT4R: LD A,(SUBPPC) LD HL,(PPC) DB 11H ;'JR+2' ;FROM RENUM/KEYIN GT4P: POP AF ;STAT POP HL ;LINE ;ENTRY: A=STAT-1 TO GO TO, HL=LINE INC A CALL GOTO4 LD A,0FFH LD (PPC+1),A ;ENSURE "GOTO" SEARCHES PROG FROM START DOCOMP: CALL SCOMP ;CALLED AS ELINE IS EXECUTED, AND BY CLEAR/RUN. CHAD IS AUTO-ADJUSTED BECAUSE ;VAR CREATION MIGHT MOVE IT COMPILE: LD A,(CHADP) LD (KCURP),A LD HL,(CHAD) LD (KCUR),HL ;NEEDS AUTO-ADJUST LD HL,(CLA) PUSH HL LD A,(CLAPG) PUSH AF LD A,(COMPFLG) AND A JR Z,COMPILEL ;JR IF ONLY ELINE NEEDS COMPILE ;DO LABELS CALL ADDRPROG ;START AT (PROG) DOLBLP: LD BC,2100H+0EAH ;LABELTOK CALL LKFC ;FIND A LABEL JR C,LABSD ;END IF ALL LABELS PROCESSED ;ELSE HL POINTS TO FIRST CHAR IN LINE, CHAD IN A,(251) ;PTS TO 'LABEL', DE=LINE LEN LD (CHADP),A ;KEEP CHAD UP TO DATE FOR ASSIGN ETC.?!!? PUSH HL ADD HL,DE ;PTR TO NEXT LINE EX (SP),HL DEC HL DEC HL DEC HL LD C,(HL) DEC HL LD B,(HL) ;BC=LINE NUMBER OF LINE WITH LABEL CALL STACKBC CALL SVNUMV ;ASSESS NUMERIC VARIABLE CALL ASSIGN ;ASSIGN FPC VALUE TO VAR POP HL JR DOLBLP ;CONTINUE SEARCH AT NEXT LINE LABSD: ;'COMPILING PROGRAM'SHOWN BY BIT 7 COMPFLG HI CALL COMALL ;COMPILE PROCS/FN (CY HERE) XOR A LD (COMPFLG),A ;'COMPILING ELINE'SHOWN BY BIT 7 LOW COMPILEL: CALL ELCOMAL ;*ALWAYS* COMPILE ELINE FOR PROCS, AND FNS ;IF NEEDED. POP AF LD (CLAPG),A POP HL LD (CLA),HL LD HL,(KCUR) LD (CHAD),HL LD A,(KCURP) JP SETCHADP ;LKFC.SAM - LOOK FIRST CHAR ;LOOK FOR CHAR IN C, AT START OF LINES, SKIPPING ANY PRECEDING CC/SPACES ;ENTRY: B=21H FOR CC/SPACE SKIP, C=CHAR, HL=START ;EXIT: NC IF FOUND, HL=FIRST CHAR IN LINE (MAY NOT BE C) (CHAD)=TARGET ; CY IF SEARCHED PROG AND FAILED. LKFCLP: ADD HL,DE ;ENTRY POINT LKFC: LD A,(HL) ADD A,1 RET C ;RET IF END OF PROGRAM CALL CHKHL ;KEEP LINE START IN SECTION C INC HL INC HL LD E,(HL) INC HL LD D,(HL) ;DE=LINE LNE INC HL LD A,(HL) ;FIRST CHAR - QUICK CHECK FOR MOST COMMON CASE ;(NO PRECEDING JUNK) LKFC2: CP C JR Z,LKFC5 ;JR IF GOT IT - BUT MIGHT NEED TO SKIP CC/SPACE CP B ;CP 21H JR NC,LKFCLP ;LOOP IF CHAR WAS SIGNIF - THIS LINE WON'T DO PUSH HL ;SAVE LINE START LKFCSK: CP 0DH JR Z,LKFC4 ;STOP TRYING IF LINE ENDS INC HL ;SKIP CC/SPACE LD A,(HL) CP B ;CP 21H JR C,LKFCSK ;SKIP ALL CC/SPACES LD (CHAD),HL ;ALTER CHAD IN CASE WE HAVE A MATCH POP HL ;FIRST CHAR IN LINE PTR CP C ;CP FIRST SIGNIF CHAR IN LINE WITH DESIRED. RET Z PUSH HL LKFC4: POP HL ;FIRST CHAR IN LINE PTR JR LKFCLP LKFC5: LD (CHAD),HL RET INCLUDE NPARPRO.SAM ;PARPRO.SAM ;PARAM PROCESSING ;E.G. TEST 1,A,C,2 ;DEF PROC TEST A,B,C,D ;CHECK DEF PROC. ;IF NON-REF NUMERIC: ; LOOK FOR VAR: ; IF NOT FOUND: ; GOTO STEP 2 ; IF FOUND: ; 1.SAVE ADDR OF TYPE/LEN BYTE SO IT CAN BE MADE "INVISIBLE" WHEN ALL PARAMS ; HAVE BEEN PROCESSED, AND "REVEALED" AGAIN AT END PROC TIME. ; KEEP LOOKING SO LAST LINK IN LETTER"S "CHAIN" FOUND. ; 2.CREATE NEW VARIABLE WITH SAME NAME, USING VALUE FROM PROC CALL. THIS IS ; "INVIS" TILL ALL PARAMS PROCESSED, SINCE BIT 7 SET ON TLBYTE. ; KEEP PTR TO NEW VARIABLE SO IT CAN BE MARKED "UNUSED" (BIT 5 SET) AT END ; PROC TIME. PROCS USE SPECIAL ASSIGN ROUTINE THAT LOOKS FOR AN "UNUSED" ; VAR OF THE SAME TYPE (FOR-NEXT/NORMAL) AND NAME LEN IN THE LETTER LIST ; AND DOES A NORMAL ASSIGN IF THERE ISN"T ONE, OR OVERWRITES THE NAME AND ; VALUE OF THE UNUSED VAR AND RESETS BIT 5 TO SHOW "USED". THIS AVOIDS ; ACCUMULATION OF "UNUSED" VARS. ;IF REF NUMERIC: ; TREAT LIKE NON-REF NUMERIC, EXCEPT THAT DURING ASSIGNMENT OF LOCAL VERSION, ; THE "VALUE" SUPPLIED BY THE PROC LIST MUST BE A VARIABLE NAME. IT IS MADE ; INVISIBLE WHEN PARAMS HAVE BEEN PROCESSED, AND ITS ADDR IS STORED SO THAT AT ; END PROC IT CAN BE "REVEALED" AND ITS VALUE RESET FROM THE LOCAL VERSION. ;IF NON-REF STRING: ; LOOK FOR VAR: ; IF NOT FOUND: ; FLAG "NO INVIS VERSION" ; GOTO STEP 2 ; IF FOUND: ; 1.SAVE ADDR OF TYPE/LEN BYTE SO IT CAN BE MADE "INVISIBLE" WHEN ALL PARAMS ; HAVE BEEN PROCESSED, AND FLAG "INVIS EXISTS". ; 2.CREATE NEW VARIABLE WITH SAME NAME, USING VALUE FROM PROC CALL. THIS WILL ; BE IGNORED IF VAR. USED LATER IN PROC CALL LIST (IT IS AT SAVARS END). ; KEEP NAME OF NEW VARIABLE SO IT CAN BE DELETED AT END PROC TIME, IF IT ; EXISTS, AND SO A SEARCH CAN BE MADE FOR ANY "INVIS" VERSION IF FLAG ; SAYS ONE EXISTS ;IF REF STRING/ARRAY: ; LOOK FOR VAR: ; IF NOT FOUND: ; GOTO STEP 2 ; IF FOUND: ; 1.SAVE ADDR OF TYPE/LEN BYTE SO IT CAN BE MADE "INVISIBLE" WHEN ALL PARAMS ; HAVE BEEN PROCESSED, AND FLAG "INVIS EXISTS". ; 2.LOOK FOR VAR NAMED IN PROC CALL. COPY TLBYTE AND NAME TO STORE. COPY ; NAME GIVEN IN DEF PROC TO TLBYTE. (RENAME). ; AT END PROC, FIND VAR, COPY ORIG NAME BACK FROM STORE. ;PROCESS PARAMS ;ENTRY: PRPTR PTS TO PROC PARAMS, DPPTR PTS TO DEF PROC PARAMS PROPAR: LD HL,(BSTKEND) DEC HL XOR A LD (HL),A DEC HL LD (HL),A ;BSTK TERMINATOR LD (BSTKEND),HL PROP2: XOR A PUSH AF ;MACHINE STACK TERMINATOR LD HL,HDR ;USE TAPE HDR AREA AS RENAME STACK LD (HL),A LD (RNSTKE),HL CALL PTTODP ;POINT TO DEF PROC LIST JP Z,PPM2 ;JP IF NO LIST CP 0B9H ;DATATOK JR NZ,PPML POP AF LD HL,(PRPTR) LD A,(PRPTRP) JR RESTORE3 ;RESTORE CMD STUCK IN HERE TO ALLOW JR! RESTORE: CALL SYNTAX3 ;EXPT1NUM OR USE ZERO IF CR/COLON CALL GETINT RESTORE2: CALL FNDLINE ;RETURNS ADDR OF LINE BC. PAGE MAY BE SWITCHED DEC HL IN A,(251) RESTORE3: LD (DATADD),HL LD (DATADDP),A RET ;RESTORE-ZERO. USED BY CLEAR AND LOAD (PROGRAM) RESTOREZ: LD HL,0 JR RESTORE2 PPLOOP: CALL PTTODP ;POINT TO DEF PROC LIST JP Z,PPM2 ;JP IF LIST ENDED PPML: LD HL,(BSTKEND) LD DE,-23 ;MAX SPACE NEEDED BY 1 PARAM ADD HL,DE ;FIND NEW BSTKEND. CY LD DE,(HEAPEND) ;LOWER IN MEM THAN BSTKEND SBC HL,DE ;BSTKEND-(HEAPEND+1) - BSTK CANNOT COME AS FAR DOWN ;HEAPEND. JP C,BSFERR ;ERROR IF STACK SPACE TOO SMALL SUB 0CEH ;REFTOK LD (REFFLG),A ;Z IF REF VAR JR NZ,PPNREF RST 20H ;SKIP "REF" PPNREF: CALL LVFLAGS ;LOOK FOR VAR IN DEF PROC LIST EX DE,HL ;PROTECT ADDR OF PREV LINK (IF NOT FND) LD HL,(CHAD) LD (DPPTR),HL ;(DPPTRP IS OK STILL) JP P,PPAS ;JP IF STRING BIT 5,C ;BIT 5=1 IF NUMERIC ARRAY JP NZ,PPAS ;JP IF NUMERIC ARRAY EX AF,AF' JR Z,PPA2 ;JR IF NVAR IN DEF PROC LIST DOESN"T EXIST PUSH IX POP HL DEC HL ;PT TO TLBYTE OF VAR PUSH HL ;SAVE ADDR OF VAR TO MAKE "INVIS" IN A,(URPORT) OR 0E0H ;BIT 7 SET SO "ADDR TO REVEAL" STORED. 111xxxxx PUSH AF INC HL PPNLP: CALL NVMLP ;KEEP LOOKING. C IS TLBYTE JR Z,PPA15 ;JR IF NO SECOND COPY (D=0) LD A,0 LD (FIRLET),A PUSH HL LD (HL),A INC HL LD (HL),0FFH INC HL LD (HL),A INC HL LD (HL),A ;SECOND COPY=MINUS ZERO POP DE ;VALUE LOCN ; JR PPA2 ;VARIABLE EXISTS. IF ASSIGNMENT IS MADE FROM DB 21H ;PROC VALUE, MINUS ZERO OVERWRITTEN. IF NOT, ;DEFAULT RECOGNISES MINUS ZERO AS "NON-EXISTENT" PPA15: LD C,D ;SIGNAL SIMPLE NUMERIC (F-N BIT SEEN AS ARRAY) EX DE,HL PPA2: CALL SYN1PP ;SET UP FOR ASSIGNMENT - SETS "NEW VAR" FLAG CALL PTTOPR ;POINT TO PROC LIST JP Z,PPD2 ;JP IF PROC LIST ENDED ;LOOK FOR "UNUSED" NUMERIC VAR ;ENTRY: TLBYTE/FIRLET SET UNVLK: LD BC,(TLBYTE) ;C=TLBYTE, B=FIRLET LD A,B ADD A,A JR Z,PPA3 ;JR IF SEARCH NOT WANTED COS 2ND COPY EXISTS SUB 61H*2 LD E,A ;LETTER TRANSFORMED TO WORD OFFSET (A=0, B=2..) LD D,0 CALL ADDRNV ;PT. HL AT NUMERIC VARS, PAGED IN SET 5,C ;"UNUSED" LD A,C ;DESIRED TYPE/LEN ADD HL,DE ;INDEX INTO TABLE OF WORD PTRS. UNVLP: LD E,(HL) INC HL ;PTR=FFFFH IF NO MORE VARS START WITH REQUIRED LD D,(HL) ; LETTER. CAUSES CARRY AND CHECK FOR FF IN NVSPOV ADD HL,DE ;ELSE DE IS A PTR TO NEXT VAR STARTING ; WITH REQUIRED LETTER. JR C,PPA3 ;RET IF LIST ENDED OR SEVERE PAGE OVERFLOW ; BIT 6,H ; CALL NZ,INCURPAGE CALL CHKHL LD A,C ;IN CASE CALL WAS MADE CP (HL) INC HL ;PT TO PTR LSB JR NZ,UNVLP DEC HL ;PT TO TLBYTE OF UNUSED VAR PUSH HL LD A,(HL) SET 7,(HL) ;hidden** SO NOT USED TWICE! INC HL INC HL INC HL ;PT TO OTHER LETTERS OF NAME (OR VALUE) AND 1FH JR Z,PPA25 ;JR IF PTING TO VALUE (1-LET VAR) EX DE,HL LD HL,FIRLET+1 LD C,A LD B,0 LDIR ;COPY NAME TO "UNUSED" VAR NAME AREA EX DE,HL PPA25: LD (DEST),HL ;PTR TO VALUE AREA OF REUSED VAR POP HL ;TLBYTE PTR PUSH HL ;ADDR OF VAR TO MARK "USED" IN A,(URPORT) AND 1FH LD (DESTP),A OR 20H ;001XXXXX PUSH AF ;PAGE, AND BITS FOR "MARK AS USED" XOR A LD (FLAGX),A ;"VAR EXISTS" (BIT 0) DB 0DDH ;"JR+3" PPA3: LD HL,(NUMEND) ;VAR WILL BE CREATED HERE SINCE AN "UNUSED" VAR ;AREA IS NOT BEING RE-USED. PPA4: LD B,40H ;BIT 7 OF PAGE WILL BE RESET. BIT 6 SET SO NOT ;SEEN AS "TERMINATOR" CALL RUAHL ;RECORD ADDR OF VAR ASSIGNED TO, ALLOWING ;MARKING AS "UNUSED" BY END PROC CALL PTTOPR ;PT TO PROC LD A,(REFFLG) AND A JR NZ,PPA5 ;JR UNLESS VAR BEING "ASSIGNED" TO IS REF-TYPE ;NZ NEEDED HERE!!! CALL LVFLAGS ;INSIST PROC SUPPLIES A VAR NAME JP P,PARERR ;ERROR IF STRING EX AF,AF' JR NZ,PPRNE ;JR IF VAR EXISTS DB CALC DB STKZERO DB DUP DB EXIT CALL ASSISR ;IF PROC VAR DOES NOT EXIST CREATE DP VAR ;WITH VALUE ZERO USING NAME AT T/L+33. C=0 CALL CRTVAR35 ;LOOK FOR NON-EXISTENT PROC VAR AGAIN. ;SO NO MATCH. ;SET UP FOR ASSIGN TO PROC VAR. ;CREATE PROC VAR WITH VALUE ZERO LD A,(TLBYTE) LD C,A CALL NUMLOOK ;POINT TO (NOW EXISTING) PROC VAR XOR A ;Z PPRNE: EX AF,AF' ;SAVE Z IF ASSIGN TO DP VAR ALREADY MADE DEC IX ;PT TO TLBYTE OF PROC VAR BEING REFFED PUSH IX ;SAVE ADDR OF VAR TO MAKE "INVIS" IN A,(URPORT) OR 0E0H ;BIT 7 SET SO "ADDR TO REVEAL" STORED. 111xxxxx PUSH AF LD B,0A0H ;SET BITS 5 AND 7 OF PAGE TO SHOW "REF" AND "PROC" PUSH HL EX DE,HL LD HL,(BSTKEND) SET 5,(HL) ;SET BIT 5 OF PREVIOUS "VAR TO MARK UNUSED" TO SHOW EX DE,HL ;"REF". BIT 7 BEING RES SHOWS "DEF PROC" CALL RUAHL ;RECORD ADDR OF VALUE BEING ASSIGNED *FROM* SO IT ;CAN BE ASSIGNED BACK *TO* AT END PROC E.G. ; TEST Z ; DEF PROC TEST REF X ; VALUE OF Z HAS BEEN ASSIGNED TO X. END PROC ; ASSIGNS X'S VALUE TO Z, MARKS X "UNUSED" POP HL ;PTR TO VALUE EX AF,AF' CALL NZ,HLTOFPCS ;(NO CHANGE TO Z FLAG) CALL NZ,ASSIGN CP A ;Z - JR PPD1H ;PPA5: CALL SELCHADP ;ENSURE SEARCH OF VARS HASN'T ALTERED PAGE ** ;PPA5: CALL RCRC ;RST 18H, CALL CRCOLON ; JR NZ,PPA55 ; DB CALC ; DB STKZERO ; DB EXIT ; INC HL ; DEC (HL) ;NZ FLAG, VALUE=MINUS ZERO ; JR PPA45 PPA5: CALL NZ,VALFET1 ;ASSIGN VALUE FROM PROC LIST TO VAR FROM DEF PROC ;EXITS WITH DEST PAGED IN PPD1H: JR PPD1 ;STRINGS/ARRAYS PPAS: LD B,10H ;BIT 7 RES=NO VAR TO REVEAL, BIT 4 SET=STRING EX AF,AF' JR Z,PAS2 ;JR IF DEF PROC STRING/ARRAY DOESN"T EXIST LD B,90H ;BIT 7 SET SO "GLOBAL S/A TO REVEAL" SHOWN ;BIT 4 SET=STRING/ARRAY LD HL,(STRLOCN) ;PTS TO TLBYTE OF S/A JUST FOUND PUSH HL ;SAVE ADDR OF DEF PROC S/A TO MAKE "INVIS" IN A,(URPORT) AND 1FH ;BIT 7 RES SO NO RECORD MADE OF ADDR TO REVEAL OR 60H ;SET BIT 5 - ENSURE NOT ZERO. 011xxxxx PUSH AF PAS2: CALL PPSUB ;RECORD DEF PROC NAME ON BSTK, WITH FLAG BITS CALL PTTOPR ;POINT TO PROC LIST JR Z,PPD2 ;JR IF PROC LIST ENDED CALL SCOPNM ;COPY DEF PROC NAME TO TLBYTE+33 LD A,(REFFLG) AND A JR NZ,PPD0 ;JR IF NOT A REF VAR ;REF STRINGS/ARRAYS LD A,(FLAGS) PUSH AF CALL LVFLAGS ;LOOK FOR PROC NAME JP P,REFSTR ;JP IF PROC VAR=STRING POP AF ;BIT 6,A=1 IF DP NAME=NUMERIC RL C ;BIT 6,C=1 IF PROC VAR=ARRAY AND C ;BIT 6=1 IF NUM ARRAYS CPL DB 0EH ;"JR+1" REFSTR: POP AF AND 40H JP NZ,PARERR EX AF,AF' JR Z,PAS3 ;JR IF VAR DOESN'T EXIST LD HL,(RNSTKE) LD DE,(BSTKEND) ;PTR TO DEF PROC NAME IN BSTK INC HL LD (HL),E INC HL LD (HL),D LD DE,(STRLOCN) ;TLBYTE OF PROC NAME JUST FOUND INC HL LD (HL),E INC HL LD (HL),D IN A,(URPORT) OR 80H ;ENSURE NOT ZERO INC HL LD (HL),A LD (RNSTKE),HL PAS3: LD B,0 ;KEEP ORIG TLBYTE CALL PPSUB ;RECORD ORIGINAL PROC VAR NAME SO IT CAN ;BE RESTORED AT END PROC TIME. ;NAME "UNDER" IT MUST BE DEF PROC NAME LD HL,(BSTKEND) DEC HL LD (HL),0FFH ;PRECEDE NAME WITH FF LD (BSTKEND),HL JR PPD1 ;NON-REF STRINGS/ARRAYS PPD0: LD A,(FLAGS) ADD A,A JP M,PARERR ;ERROR IF NUMERIC ARRAY LD HL,TLBYTE+33 RES 6,(HL) ;ENSURE THAT THE TYPE IS NOT ARRAY EVEN IF DP NAME ;IS E.G. A$(). CALL EXPTSTR CALL ASNST ;CREATE STRING AT END OF SAVARS PPD1: CALL SELCHADP RST 18H PPD2: LD (PRPTR),HL ;UPDATE PROC PTR CP ")" JR NZ,PPD3 RST 20H ;SKIP CLOSING BRACKET OF E.G. "NUM()" LD (PRPTR),HL PPD3: CP "," JR NZ,PPD35 ;JR IF NO MORE PROC PARAMS ** BUG FIX RST 20H ;SKIP "," IN PROC LIST LD (PRPTR),HL PPD35: CALL PTTODP CP ")" JR NZ,PPD4 RST 20H ;SKIP CLOSING BRACKET OF E.G. "NUM()" PPD4: CP "," JR NZ,PPM2 ;EXIT IF NO MORE DEF PROC VARS ** RST 20H ;SKIP "," IN DEF PROC LIST JP PPML ;LOOP UNTIL PROC PARAMS FINISHED ; PPD5: LD A,(REFFLG) ; AND A ; JR NZ,PARERR ;ERROR IF NO VALUE AND "REF" - VAR NAME REQUIRED ; RST 20H ;SKIP COMMA, GET HL=CHAD ; JR PPD2 PPMIL: PUSH AF CALL SELURPG POP AF ;011xxxxx IF STRING/ARRAY, NO ADDR TO REVEAL ;111XXXXX IF NUMBER, ADDR TO REVEAL ;001XXXXX IF NUMBER, ADDR TO MAKE "USED" ADD A,A ;CY IF NUMERIC WITH DISP TO STORE ;P IF NEED TO MAKE USED AND NO NEED TO MAKE ;INVISIBLE POP HL RES 7,(HL) ;VISIBLE** JP P,PPM3 SET 7,(HL) ;EXISTING NUM/STR VAR MADE "INVISIBLE" LD B,80H CALL C,RUAHL ;RECORD DISP FROM NVARS OF A "NUMBER TO REVEAL" DB 21H ;"JR+2" PPM3: RES 5,(HL) ;"USED" PPM2: POP AF AND A JR NZ,PPMIL ;LOOP TILL STACKED ADDRS TO MARK "INVIS" ALL DONE RNMLP: LD HL,(RNSTKE) LD A,(HL) AND A JR Z,RNMF CALL SELURPG DEC HL LD D,(HL) DEC HL LD E,(HL) PUSH DE ;VARS PTR DEC HL LD D,(HL) DEC HL LD E,(HL) DEC HL LD (RNSTKE),HL EX DE,HL POP DE ;HL=BSTK PTR TO DP NAME, DE=VARS PTR LD A,(HL) AND 0FH LD C,A ;C=LEN (OF DP NAME) LD A,(DE) AND 70H ;"VISIBLE" OR C ;UPPER BITS (TYPE) FROM VARS, LEN FROM D.P. NAME LD B,A ;NEW TLYBTE LD A,(DE) RLA CALL C,NEGVTR ;IF VAR HAD BEEN MADE INVISIBLE, REVERSE "VAR TO ;REVEAL" BIT ON D.P. NAME IN BSTK. (HAPPENS IF ;ANY PROC VAR PASSED BY REFERENCE HAS SAME NAME ;AS AS A DEF PROC VAR. VARS THAT ARE RENAMED NEED ;NOT AND SHOULD NOT BE INVIS) LD A,B LD B,0 CALL ILDISR ;OVERWRITE NAME OF PROC VAR WITH NAME OF DEF PROC JR RNMLP RNMF: CALL PTTOPR RET Z ;RET IF PROC LIST ENDED PARERR: RST 08H DB 26 ;"Parameter error" ;LOOK FOR A PARTICULAR BSTK ENTRY SPECIFYING "VAR TO REVEAL" AND RESET BIT ;ENTRY: DE PTS TO TLBYTE OF VAR NAME IN VARS THAT IS ABOUT TO BE RENAMED NEGVTR: PUSH BC ;B=NEW TLBYTE, C=LEN OF DP NAME PUSH DE ;VARS PTR PUSH HL LD HL,(BSTKEND) FDPNL: LD A,(HL) AND A JR Z,PARERR ;ERROR IF NOT FOUND BIT 4,A JR NZ,FDPN2 ;JR IF STRING, ELSE SKIP NUMERIC DISP LD C,3 JR FDPN4 FDPN2: CP 0FFH JR NZ,FDPN3 ;JR IF NOT REF NAME INC HL ;SKIP FF LD A,(HL) FDPN3: AND 0FH LD C,A LD A,(DE) XOR (HL) INC HL AND 0AFH JR Z,FDPN5 ;JR IF MATCH ON "VAR TO REVEAL" BIT, TYPE BITS ;AND LEN BITS - IGNORE BIT 4 MISMATCH (ALWAYS ;ZERO IN VARS AREA) AND BIT 6 ($/$ ARRAY) FDPN4: LD B,0 ADD HL,BC ;SKIP STRING NAME JR FDPNL FDPN5: PUSH HL PUSH DE LD B,C ;LEN TO MATCH ON FDPBL: INC DE LD A,(DE) CP (HL) INC HL JR NZ,FDPN6 DJNZ FDPBL FDPN6: POP DE ;DP NAME PTR POP HL ;BSTK SRCH PTR JR NZ,FDPN4 ;JR IF MATCH FAILED DEC HL RES 7,(HL) ;RESET "VAR TO REVEAL" BIT POP HL ;HL=DP NAME PTR POP DE ;VARS PTR. POP BC RET ;CALCULATE DISP FROM NVARS TO CURRENT PAGE/HL, STORE IN BSTK IN PAGE/MOD 16K ;FORM, WITH BIT 7 OF PAGE SET IF VAR TO MARK UNUSED, RES IF TO MAKE VISIBLE. ;(USED LATER BY END PROC) RUAHL: LD A,(NVARSP) LD C,A LD DE,(NVARS) ;CDE=NVARS IN A,(URPORT) ;AHL=TLBYTE CALL SUBAHLCDE EX DE,HL ;ADE=DISP FROM NVARS (PAGEFORM) LD HL,(BSTKEND) DEC HL LD (HL),D DEC HL LD (HL),E DEC HL AND 0FH ;BIT 4 LOW SHOWS NUMERIC OR B ;SHOW "DISP TO VAR TO MARK "UNUSED"" AT END PROC ;(BIT 7 SET) OR "DISP TO VAR TO REVEAL" (BIT 7 RES) LD (HL),A BSSET: LD (BSTKEND),HL RET ;RECORD TLBYTE AND NAME ON BSTK, USING B REG TO SET BITS 7 AND 4 OF TLBYTE ;EXIT: BC=0 PPSUB: LD DE,TLBYTE ;TLBYTE OF VAR NAME LOOKED FOR LD HL,(BSTKEND) LD A,(DE) AND 0FH LD C,A LD A,(DE) AND 6FH ;** OR B ;BIT 4 ALWAYS SET TO SHOW STRING NAME, BIT 7 SET ;IF "GLOBAL TO REVEAL" LD B,0 ;BC=NAME LEN SBC HL,BC DEC HL ;ALLOW SPACE FOR TLBYTE (NON-STANDARD FORM) LD (BSTKEND),HL EX DE,HL ILDISR: LD (DE),A INC DE INC HL LDIR ;COPY NAME TO BSTK RET ;SUBROUTINE USED BY END PROC AND POP (PROC ADDR) ;ACTION: FOR NUMERICS, MARKS VAR (DISP ON BSTK) "UNUSED" OR "REVEALS" IT. ;FOR STR/ARRS, DELETE, AND REVEAL LAST INVIS VERSION IF ONE WAS HIDDEN BY PROC. DELOCAL: LD HL,(BSTKEND) LD A,(HL) ;0000=TERMINATOR ;FF= ORIG NAME OF A REF VAR FOLLOWS. LOOK FOR ; NEW NAME (FOLLOWS ORIG), RENAME. KEEP ; NEW NAME ON BSTK TO ALLOW DELOCAL. ;BIT 4 SET IF STRING/ARRAY NAME ; BIT 7 SET IF GLOBAL VERSION TO REVEAL, ; AS WELL AS LOCAL VERSION TO DELETE. ;BIT 4 RES IF DISP OF NUMBER FROM NVARS ; BIT 7 SET IF IT IS A GLOBAL VERSION TO ; REVEAL. ; BIT 7 RES IF IT IS LOCAL VAR TO MARK ; "UNUSED". ; BITS 7/5 SET IF VALUE OF LOCAL VAR ; IS POINTED TO. COPY TO BUFFER. ; BIT 7 RES, 5 SET IF BUFFER VALUE ; TO BE COPIED TO VAR (ADDR=TLBYTE) ; AND TLBYTE TO BE MARKED "UNUSED" INC HL INC HL AND A JR Z,BSSET ;JR IF TERMINATOR OF DATA USED BY END PROC ;NO NEED TO CHECK FOR 2 ZEROS HERE DEC HL BIT 4,A JR NZ,DLOCS ;JR IF STRING/ARRAY NAME PUSH AF LD E,(HL) INC HL LD D,(HL) INC HL LD (BSTKEND),HL AND 0FH LD C,A ;CDE=DISP (PAGE FORM) CALL ADDRNV CALL ADDAHLCDE POP AF BIT 5,A JR Z,DLOC3 ;JR IF NOT ADDR OF REF VALUE/DP VAR TLBYTE RLA JR NC,DLOC2 ;JR IF HL POINTS TO DEF PROC VAR TLBYTE ;(ALWAYS FOLLOWS REF VALUE ADDR) IN A,(URPORT) ;WE DON"T NEED THIS REF VALUE ADDR YET - SAVE PUSH AF ;PAGE PUSH HL ;AND ADDR. JR DELOCAL DLOC2: SET 5,(HL) ;VAR THAT WAS LOCAL MARKED "UNUSED" LD A,(HL) AND 1FH ADD A,7 LD C,A LD B,0 ADD HL,BC ;PT TO VALUE OF LOCAL VAR (LAST BYTE) LD DE,TEMPW1+4 ;USE TEMP AREA AS BUFFER LD C,5 LDDR ;COPY LOCAL VAR VALUE TO BUFFER INC DE EX DE,HL ;HL PTS TO TEMPW1 POP DE POP AF OUT (URPORT),A ;DE PTS TO VALUE AREA OF REF VAR LD C,5 LDIR JR DELOCAL DLOC3: RLA RES 7,(HL) ;"VISIBLE" (IN CASE GLOBAL VAR NEEDS IT) JR C,DELOCAL ;JR IF IT WAS SET 5,(HL) ;VAR THAT WAS LOCAL MARKED "UNUSED" JR DELOCAL DLOCS: CP 0FFH JR NZ,DLCS2 ;JR IF NOT A REF STRING/ARRAY LD A,(HL) ;ORIG TLBYTE AND 0FH INC A LD C,A LD B,0 PUSH HL ADD HL,BC ;PT TO DEF PROC NAME FOLLOWING ORIG NAME. LD C,(HL) ;DEF PROC CODE BYTE (BIT 7 HOLDS EXTRA ;DATA, BIT 4 IS SET) PUSH BC LD A,C AND 6FH ;NORMAL T/L BYTE FOR DP NAME ;(SIMPLE $ VS ARRAY $ IRREL. TO SEARCH ROUTINE) INC HL CALL LKBSV ;LOOK FOR DEF PROC NAME JP Z,VNFERR POP BC ;B=0, C=CODED BYTE POP DE ;DE PTS TO ORIG NAME PUSH BC ;CODE BYTE IN C LD A,(DE) AND 0FH LD C,A INC C ;BC=ORIG NAME LEN, INC T/L BYTE LD HL,(STRLOCN) ;ADDR OF T/L BYTE IN VARS XOR (HL) AND 0FH XOR (HL) ;TYPE FROM VARS, NAME LEN FROM ORIG EX DE,HL LD (HL),A LDIR ;COPY ORIG TLBYTE/NAME BACK TO VAR, BUT USE ;ACTUAL VAR'S TYPE BITS. ($ ARRAY VS $) POP BC LD A,C AND 0EFH ;RES 4,A ** JR DLCS3 ;THERE"S NEVER A VERSION TO ERASE - RENAMED INSTEAD ;LOOK FOR STRING/ARRAY AND ERASE IT IF FOUND; ALSO, IF A GLOBAL VERSION WAS ;HIDDEN, LOOK FOR IT (LAST "INVIS" VERSION OF VAR) AND REVEAL IT. DLCS2: AND 0EFH ;RES BIT 4 (VARS FORM ALWAYS HAS BIT 4 RESET) PUSH AF CALL LKBSV ;LOOK FOR VAR NAMED ON BSTK. NZ=FND CALL NZ,ASDEL2 ;DELETE STRING/ARRAY WITH PAGE/LEN AT HL IF IT ;WAS FOUND POP AF DLCS3: BIT 7,A CALL NZ,STARYLK2 ;LOOK FOR INVIS VERSION IF THERE WAS A GLOBAL ;VERSION JR Z,DELCLH ;JR IF NONE (SHOULD BE AT LEAST ONE...) ;FIND LAST INVISIBLE VERSION DLOCL: PUSH DE ;PTR TO T/L BYTE IN VARS IN A,(URPORT) PUSH AF CALL FLNOMTCH POP BC POP HL ;BHL=ADDR OF PREVIOUS "FOUND" VAR (T/L BYTE) JR NZ,DLOCL ;JR IF WE JUST FOUND ANOTHER LD A,B OUT (URPORT),A ;PT TO LAST INVIS VERSION RES 7,(HL) ;MAKE VISIBLE DELCLH: JP DELOCAL ;POINT CHAD TO DEF PROC PARAMETER LIST OR PROC PARAMETER LIST ;EXIT: Z IF CHAD POINTS TO CR/COLON. A COMMA WILL BE SKIPPED. PTTODP: LD HL,(DPPTR) LD A,(DPPTRP) JR PTTOC PTTOPR: LD HL,(PRPTR) LD A,(PRPTRP) PTTOC: LD (CHAD),HL LD (CHADP),A CALL SELURPG JP RCRC ; RST 18H ; CP 0DH ; RET Z ; CP ":" ; RET INCLUDE MISC2.SAM ;BOOT, ERRORS, BUFMV AND STUBS FOR BUFF CMDS, ;MISC2.SAM RENUM, GET, AUTO, DELETE, LET, ;OPEN, CLOSE, DEF KEYCODE, LABEL, RUN, CLEAR ;FROM RST 08H ERROR2: LD HL,(CHAD) LD (XPTR),HL EX AF,AF' LD A,(CHADP) LD (XPTRP),A POP DE LD A,(DE) INC DE PUSH DE DEC DE LD HL,(RST8V) INC H DEC H CALL NZ,HLJUMP LD A,(DOSCNT) ;0 IF DOS NOT IN CONTROL, 1 IF DOS IN CONTROL RRCA LD A,(DE) ;ERROR NUMBER JR C,NORMERR ;JR IF DOS RUNNING - DON'T RECURSE! LD A,(DOSFLG) AND A LD A,(DE) JR NZ,PTDOS ;JR IF DOS BOOTED CP 128 JR C,NORMERR ;JR IF NOT A DOS HOOK CODE NODOS: LD A,53 ;'NO DOS' NORMERR: LD (ERRNR),A LD HL,DOSCNT RES 0,(HL) ;'DOS NOT IN CONTROL' LD SP,(ERRSP) JP SETSTK ;PASS TO DOS PTDOS: AND A JR Z,NORMERR LD E,A ;ERROR NUMBER LD C,250 IN B,(C) ;B=LRPORT LD HL,0 ADD HL,SP LD A,(DOSFLG) ;0 OR DOS PAGE (1-1FH) DEC A ;GET PAGE NO. FOR SECTION A (DOS IN SECTION B) DI OUT (250),A ;DOS PAGED IN AT 4000H, ROM0 ON, ROM1 OFF LD SP,8000H ;STACK NOW OK EI PUSH BC ;B=PREV LRPORT PUSH HL ;PREV STACK PTR LD A,E ;HOOK CODE CP 128 JR NC,DOSHK ;JR WITH HOOK CODES CALL 4203H ;HANDLE ERROR CODE, RATHER THAN HOOK CODE SCF ;'COMING FROM ERROR' DOSHK: CALL NC,4200H ;HANDLE HOOK CODE IN A ;'COMING FROM HOOK' MUST SET NC! DOSC: POP HL ;PREV STACK PTR POP BC DI OUT (C),B ;PREV LRPORT RESTORED LD SP,HL ;PREV STACK EI LD HL,(DOSER) INC H DEC H JR NZ,DHLJ ;JP TO VECTOR IF WANTED JR NC,DOSNC ;NC/CY FROM 4200/4203 - JR IF WAS HOOK CODE LD HL,(ERRSP) DEC HL DEC HL LD SP,HL ;CLEAR STACK IF WAS ERROR ENTRY DOSNC: AND A JR NZ,NORMERR ;JR IF ERROR (NORMAL ERROR, OR DOS ERROR (81-127D) DEC E JP Z,LDFL ;JP IF E WAS 1 - LOAD MAIN BODY OF FILE DEC E JP Z,SVFL ;JP IF E WAS 2 - SAVE ENTIRE FILE DEC E JP Z,LKTH ;JP IF E WAS 3 - LOAD ENTIRE FILE ** NEW JUMP RET ;RET IF NO ERRORS - TO NEXT STAT IF VIA ERROR ENTRY DHLJ: JP (HL) ;STUBS OF ROUTINES THAT COPY FROM ROM1 TO BUFFER FOR EXECUTION: MEPROG: LD HL,0C000H+RENLN+GETLN+DELLN+KEYLN+POPLN+INPLN+DKLN+RDLN+DFNLN+TOKLN DB 0DDH ;'JR+3' INPUT: LD HL,0C000H+RENLN+GETLN+DELLN+KEYLN+POPLN DB 0DDH ;'JR+3' RENUM: LD HL,0C000H ;PART 2 OF RENUM LD BC,RENLN JR BUFMV ;KEYIN A$ KEYIN: LD HL,0C000H+RENLN+GETLN+DELLN LD DE,HDR ;SO OTHER CMDS DON'T CORRUPT KEYIN, EXCEPT ;LOAD/SAVE EXEC. WILL CORRUPT FIRST PART ;(HARMLESSLY) LD BC,KEYLN JR BUFMV2 TOKMAIN: CALL SETDE ;GET DE=WKSP OR ELINE START ;ENTRY FROM VAL FUNCTION TOKDE: EXX LD HL,0C000H+RENLN+GETLN+DELLN+KEYLN+POPLN+INPLN+DKLN+RDLN+DFNLN LD DE,CDBUFF+80H ; (4D80-4E24) LD BC,TOKLN JR BUFMV2 ;GET X OR GET X$ GET: LD HL,0C000H+RENLN DB 0DDH ;'JR+3' ;POP ;DELETE N TO M - DELETE PROGRAM LINES DELETE: LD HL,0C000H+RENLN+GETLN DB 0DDH ;'JR+3' POP: LD HL,0C000H+RENLN+GETLN+DELLN+KEYLN DB 0DDH ;'JR+3' DEFKEY: LD HL,0C000H+RENLN+GETLN+DELLN+KEYLN+POPLN+INPLN DB 0DDH ;'JR+3' DEFFN: LD HL,0C000H+RENLN+GETLN+DELLN+KEYLN+POPLN+INPLN+DKLN+RDLN LD BC,91H ;(DEF KEY LEN =90H) BUFMV: LD DE,INSTBUF BUFMV2: PUSH DE PUSH AF LD A,5FH OUT (250),A ;ROM1 ON LDIR LD A,1FH OUT (250),A ;ROM1 OFF POP AF RET ;TO INSTBUF DEFAULT: LD A,0FFH DB 0FEH ;'JR+1' LET: XOR A LD (LTDFF),A DB 0FEH ;'JR+1' LETLP: RST 20H CALL SYNTAX1 ;CHECK VALID VAR RST 18H CP "=" JP NZ,NONSENSE RST 20H LD A,(LTDFF) INC A JR NZ,LET3 ;JR IF 'LET', CONTINUE WITH 'DEFAULT' CALL RUNFLG ;EVEN IF 'DEFAULT', JR NC,LET3 ;ALWAYS CHECK ASSIGNED VALUE IF SYNTAX TIME LD A,(FLAGX) RRA JR C,LET3 ;JR IF VAR DOESN'T EXIST - CREATE IT, LIKE 'LET' ; LD HL,FLAGS ; BIT 6,(HL) ; JR Z,LET2 ;JR IF STRING LD A,(DFTFB) AND A JR Z,LET3 LET2: CALL EXPTEXPR ;EVAL ASSIGNED VALUE IN ORDER TO SKIP IT. (SLOW, ;BUT SAVES USE OF SPECIAL SKIPEXPR ROUTINE) CALL FDELETE JR LET4 LET3: CALL VALFET1 LET4: RST 18H CP "," JR Z,LETLP RET ;E.G. LABEL heaven: LABEL: CALL RUNFLG JP C,SKIPCSTAT ;JUST SKIP STATEMENT IF RUNNING DB 0FEH ;'JR+1' ;SKIP, CHECK FOR VALID NUMERIC VARIABLE ;USED BY COMPILE, LABEL SVNUMV: RST 20H ;FROM POP, LABEL VNUMV: CALL SYNTAX1 ;VALID VAR LD HL,FLAGS BIT 6,(HL) RET NZ ;RET IF NUMERIC RST 08H DB 29 ;'SYNTAX ERROR' ;TCLR.SAM - CLEAR, RUN RUN: CALL SYNTAX3 CALL GOTO2 ;SET NEWPPC AND NSPPC FOR JUMP CALL RESTOREZ ;DO RESTORE 0. SWITCHES IN PROGP JR CLR1 ;NOW DO CLEAR 0 CLEAR: CALL SYNTAX3 ;NUMBER OR ZERO CALL UNSTLEN LD C,A DEC C OR H OR L SET 7,H JR NZ,CLR3 ;JR IF A CLEAR PARAM USED CLR1: LD A,(RAMTOPP) LD HL,(RAMTOP) LD C,A CLR3: PUSH BC PUSH HL CALL ADDRNV EX DE,HL LD C,A ;CDE=NVARS LD HL,(ELINE) LD A,(ELINEP) CALL SUBAHLCDE ;GET ELINE-NVARS IN AHL (AT LEAST 025DH) LD BC,025DH CALL SUBAHLBC ;AHL=SPACE TO RECLAIM LD B,H LD C,L LD HL,(NVARS) CALL RECL2BIG ;RECLAIM ABC AT HL CALL CLRSR CALL DOCOMP ;COMPILE CALL MCLS ;CLEAR ENTIRE SCREEN LD HL,(WKEND) LD A,(WKENDP) LD BC,180 ;** CALL ADDAHLBC ;AHL=WKEND+180 POP DE POP BC ;CDE=CLEAR PARAM, OR RAMTOP CALL SUBAHLCDE JR NC,RTERR ;JR IF RAMTOP WILL BE TOO CLOSE TO WKEND LD A,(LASTPAGE) CP C JR NC,CLR4 ;OK IF RAMTOP PAGE <= LAST ALLOCATED PAGE RTERR: RST 08H DB 48 ;'Invalid CLEAR address' ;CLEAR MACHINE STACK (SHOULDN'T NEED IT!) CLR4: LD A,C LD (RAMTOPP),A LD (RAMTOP),DE POP HL ;NEXT STAT POP BC ;ERR HANDLER LD SP,ISPVAL PUSH BC LD (ERRSP),SP JP (HL) ;CLEAR FPCS, BASIC STACK, NUMERIC AND STRING VARS, TURNS 'RECORD' OFF ;SOUND CHIP OFF, ON ERROR OFF CLRSR: CALL CLSND ;CLEAR SOUND CHIP, A=0 LD (GRARF),A ;GRAPHICS RECORDING OFF LD (ONERRFLG),A ;ON ERROR OFF LD HL,(BASSTK) LD (HL),0FFH LD (BSTKEND),HL ;CLEAR DO/GOSUB/ETC STACK CALL ADDRNV LD B,46 CLNVP: LD (HL),0FFH INC HL DJNZ CLNVP ;INIT 23 LETTER PTRS EX DE,HL LD HL,PSVTAB LD C,26 LDIR ;COPY 3 PTRS AND YOS/YRG LD HL,PSVT2 LD C,20 LDIR ;COPY YOS/YRG AGAIN EX DE,HL CALL SETNE INC H INC H CALL SETSAV LD (HL),0FFH ;FF TERMINATOR OF SAVARS DEC H DEC H DEC HL DEC HL DEC HL LD (HL),B ;CHANGE 192 YRG TO 0 INC HL LD (HL),1 ;NOW 256 LD A,(THFATT) AND A RET NZ INC (HL) ;IF MODE 2 THIN PIX, MAKE XRG=512 RET SETSAV: LD IY,SAVARSP JR SETSYS SETNE: LD IY,NUMENDP ;SET SYS VAR TO CURRENT PAGE AND ADDR IN HL. ADJUST IF NEEDED TO 8000-BFFF, BUT ;KEEP HL THE SAME. ONLY F AND IY ALTERED SETSYS: PUSH AF IN A,(251) AND 1FH LD (IY+0),A LD (IY+1),L LD (IY+2),H POP AF BIT 6,H RET Z RES 6,(IY+2) INC (IY+0) RET CLSND: LD A,32 ;CLEAR 32 REGISTERS CSRL: LD BC,SNDPORT+0100H ;SOUND REG ADDR DEC A OUT (C),A DEC B ;BC=DATA PORT OUT (C),B AND A JR NZ,CSRL RET PSVTAB: DW 0019H ;X VARS DW 0003H ;Y VARS DW 0FFFFH ;Z VARS PSVT2: DB 2 DW 8 DB "os" DB 0,0,0,0,0 ;YOS DB 2 DW 0FFFFH DB "rg" DB 0,0,192,0,0 ;YRG ;STREAM 16 IS CONVERTED TO STREAM -4 INTERNALLY ;CLOSE #16 AND OPEN #16 NOT ALLOWED ;E.G. RECORD TO A$: LET A$="": PRINT #16;"TESTING" ADDS "TESTING (CR)" TO A$ ;O/P TO STREAM 16 LOOKS FOR STRING NAME IN (STRM16NM), AND 'PRINTS' CHARS ;TO THE END OF THE STRING. ;ALLOWS 'SERIAL FILES', TOKEN EXPANSION, CAT TO A STRING, RECORDING OF GRAPHICS ;COMMANDS, ETC. CALLED WITH ROM1 OFF S16OSR: LD B,A ;CHAR TO O/P IN A,(URPORT) ;SAVE URPORT STATUS AND RESTORE AT END PUSH AF PUSH BC LD HL,STRM16NM ;STORED TLBYTE AND NAME OF STRING LD DE,TLBYTE LD BC,11 LD A,(HL) LDIR LD C,A CALL STARYLK2 JP Z,VNFERR POP BC ;B=DATA IN A,(URPORT) PUSH AF PUSH HL ;SAVE ADDR OF $ LEN DATA PUSH BC LD A,(HL) INC HL LD C,(HL) INC HL RRCA RRCA OR (HL) LD B,A ;BC=LEN INC BC ;NEW LEN LD A,B INC A JR NZ,S16OK ;OK UNLESS STRING LEN >FEFF STLERR: RST 08H DB 42 ;'String too long' S16OK: PUSH BC ADD HL,BC ;HL PTS TO LAST BYTE CALL C,PGOVERF CALL CHKHL CALL MKRM1 ;OPEN 1 SPACE AT END OF STRING POP BC ;NEW LEN POP AF ;A=DATA LD (HL),A ;ADD CHAR TO END POP DE POP AF OUT (URPORT),A ;PAGE IN STRING HEADER AT DE CALL MBC POP AF OUT (URPORT),A RET MBC: CALL SPLITBC LD HL,PAGCOUNT LD BC,3 LDIR ;COPY PAGE/LEN TO STRING RET SSYNTAX3: RST 20H ;SYNTAX 3 - NUMBER, OR USE 0 SYNTAX3: RST 18H CALL FETCHNUM RET C ;RET IF RUNNING POP AF ;JUNK RET ADDR RET SSYNTAX6: RST 20H ;SYNTAX 6 - INSIST ON NUMBER SYNTAX6: CALL EXPT1NUM RET C POP AF RET SSYNTAX8: RST 20H ;SYNTAX 8 - INSIST ON NUMBER,NUMBER SYNTAX8: CALL EXPT2NUMS RET C POP AF RET SSYNTAXA: RST 20H ;SYNTAX A - INSIST ON A STRING SYNTAXA: CALL EXPTSTR RET C POP AF RET ;COMMA/SEMICOLON RETURN Z COMMASC: CP "," RET Z CP ";" RET COCRCOTO: CP TOTOK RET Z ;COMMA/CR/COLON RETURN Z COMCRCO: CP "," RET Z DB 0FEH ;'JR+1' RCRC: RST 18H ;CR/COLON RETURN Z CRCOLON: CP ":" RET Z CP 0DH RET RICSC: RST 18H ;INSIST ON A COMMA OR SEMI-COLON, SKIP INSISCSC: CP ";" JR Z,INSCOMN INSISCOMA: CP "," JR NZ,SYNONS INSCOMN: RST 20H RET ;SKIP, INSIST ON OPENING BRACKET SINSISOBRK: RST 20H ;INSIST ON AN OPENING BRACKET INSISOBRK: CP "(" JR NZ,SYNONS RST 20H RET ;EXPECT NUMBER, THEN CLOSING BRACKET EX1NUMCB: CALL EXPT1NUM ;INSIST ON A CLOSING BRACKET INSISCBRK: CP ")" JR NZ,SYNONS RST 20H RET ;EXPECT COMMA, THEN STRING EXPTCSTR: RST 18H CP "," JR NZ,SYNONS ;SKIP, EXPECT STRING SEXPTSTR: RST 20H ;EXPECT STRING EXPTSTR: CALL SCANNING ADD A,A ;CY IF RUNNING LD A,C ;CURRENT CHAR RET P ;RET IF STRING SYNONS: RST 08H DB 29 ;'SYNTAX ERROR' ;EXPECT COMMA, STRING, CLOSING BRACKET EXPTCSTRB: CALL EXPTCSTR JR EXCBRF ;CHECK ')', RUN FLAG ;EXPECT '(N,N)'. SET CY IF RUNNING EXB2NUMB: CALL SINSISOBRK ;SKIP, '(' CALL EXPT2NUMS ;N,N JR EXCBRF ;CHECK ')', RUN FLAG ;EXPECT Bracket, String, Comma, Number, Bracket. '(a$,n)'. CY IF RUNNING EXBSCNB: CALL SINSISOBRK ;'(' CALL EXPTSTR ;A$ CP "," JR NZ,SYNONS SEX1NUMCB: CALL SEXPT1NUM ;SKIP, GET N. CY IF RUNNING EXCBRF: CALL INSISCBRK ;')' . CY IF RUNNING RUNFLG: LD A,(FLAGS) ADD A,A ;C IF RUNNING, P IF STRING, M IF NUMBER RET ;EXPECT Bracket, Number, Comma, String, Bracket. '(n,a$)'. CY IF RUNNING EXBNCSB: CALL SINSISOBRK ;'(' CALL EXPT1NUM ;N JR EXPTCSTRB ;',A$)' ;SKIP, EXPECT N,N,N,N SEXPT4NUMS: RST 20H EXPT4NUMS: CALL EXPT2NUMS CP "," JR NZ,SYNONS ;SKIP, EXPECT N,N SEXPT2NUMS: RST 20H ;EXPECT N,N EXPT2NUMS: CALL EXPT1NUM ;EXPECT ,N EXPTCNUM: CP "," JR NZ,SYNONS ;SKIP, EXPECT NUMBER SEXPT1NUM: RST 20H ;EXPECT NUMBER EXPT1NUM: CALL SCANNING ADD A,A ;CY IF RUNNING LD A,C RET M ;RET IF NUMERIC JR SYNONS ;INSIST A=LETTER GETALPH: CALL ALPHA RET C JR SYNONS ;SYNTAX9 - DEAL WITH COLOUR ITEMS, COORDS ; EG INK 3,PAPER 1;X,Y. USED BY PLOT, CIRCLE, FILL SYNTAX9: CALL SYNT9SR JR EXPT2NUMS ;EXPECT N OR CR/COLON. RETURN WITH CY IF RUNNING FETCHNUM: CALL CRCOLON JR NZ,EXPT1NUM ;EXITS WITH CY IF RUNNING CONDSTK0: LD A,(FLAGS) RLA RET NC XOR A CALL STACKA SCF ;'RUNNING' RET SEXPTEXPR: RST 20H ;EXPECT AN EXPRESSION, SET Z IF STRING, NZ IF NUMERIC EXPTEXPR: CALL SCANNING RLA ;CY IF RUNNING BIT 7,A LD A,C RET ;USED BY INPUT,.. CHKENDCP: CALL SELCHADP DB 0FEH ;"JR+1" ;SKIP, ABORT IF SYNTAX TIME. USED BY E.G. PI, HIMEM, FREE. SABORTER: RST 20H ;JUST RETURN IF RUNNING, ELSE JUNK A RET ADDR, RET TO NEXT LEVEL. CHKEND: ABORTER: LD C,A LD A,(FLAGS) RLA LD A,C RET C POP AF RET ;CY IF A=LETTER, ELSE NC ALPHA: CP "A" CCF RET NC ;RET IF TOO LOW CP "z"+1 RET NC ;RET IF TOO HI CP "Z"+1 RET C ;RET IF UC CP "a" CCF RET ;CY IF A=LETTER OR DIGIT ALPHANUM: CALL ALPHA RET C ;CY IF A DIGIT NUMERIC: CP "9"+1 ;NC IF TOO HIGH RET NC CP "0" CCF RET ;CY IF LETTER OR UNDERLINE OR '$' ;(SO E.G. printer, print_out, print$ ARE NOT TOKENISED, BUT print1, print: ARE) ALDU: CALL ALPHA RET C CP "$" SCF RET Z JR CKUND ;CY IF LETTER, DIGIT OR UNDERLINE ALNUMUND: CALL ALPHANUM RET C CKUND: CP "_" SCF RET Z AND A RET ;EVAL. BRACKETLESS SLICER E.G. 10 TO 30, TO 100, 100 TO, TO ;ENTRY: CHAD PTS TO POSSIBLE SLICER, A=(CHAD) ;EXIT: SYS VARS SET UP, WITH VALUE, IF GIVEN, OR DEFAULT. CHAD PTS. TO NON-ALPHA ;NUMERIC CHAR, NOT 'TO'. IF RUNNING, CY=OUT OF RANGE. A=0 IF SLICER IS 1 NUMBER BRKLSSL: LD HL,1 ;MIN LD DE,0FEFFH ;MAX (LINE NUMBERS) LD (FIRST),HL LD (LAST),DE CP TOTOK JR Z,BRL2 CALL ALPHANUM RET NC ;NC='IN RANGE' IF EG LIST CALL GIR2 ;GET INT IN BC AND HL IF RUNNING, NC IF RUNNING JR C,BRL1 ;JR IF NOT RUNNING LD BC,(FIRST) ;MIN SBC HL,BC ADD HL,BC LD (FIRST),HL RET C ;RET IF MIN>VALUE BRL1: CP TOTOK LD A,0 ;CANNOT USE XOR A! JR NZ,BRL3 ;JR WITH A=0 (FLAG) IF SLICER = 1 NUMBER ;LAST=FIRST BRL2: RST 20H CALL ALPHANUM RET NC ;'IN RANGE' IF EG LIST 10 TO CALL GIR2 CCF RET NC ;END WITH NC IF SYNTAX TIME AND EG LIST 10 TO 20 LD HL,(LAST) ;MAX SBC HL,BC RET C ;RET IF VALUE>MAX LD H,B LD L,C BRL3: LD (LAST),HL AND A RET ;GET IF RUNNING - AUTO, DELETE, BRACKETLESS SLICER SR. ;ENTRY: CHAD PTS TO EXPR (GIR2) OR IS BEFORE EXPR (GIR). ;EXIT: CHAD PTS PAST EXPR, A=(CHAD), BC AND HL=INT (IF RUNNING) ;CY IF RUNNING GIR: RST 20H GIR2: CALL EXPT1NUM CCF RET C ;RET IF NOT RUNNING CALL GETINT RST 18H LD H,B LD L,C AND A RET ;INT IN BC AND HL, NC ;DISPLAY (SCREEN) DISPLAY: CALL SYNTAX3 CALL GETBYTE ;IN A AND C SETDISP: LD (CURDISP),A AND A JR Z,DEFDISP ;'DISPLAY 0' MEANS DISPLAY CURRENT SCREEN RST 30H DW SCRNTLK2 ;GET MODE/PAGE FOR SCREEN C, Z IF UNUSED JR NZ,VIDSEL ISCRERR: RST 08H DB 43 ;'INVALID SCREEN NUMBER' (ERRORS SET CURDISP TO 0) ;DEFAULT DISPLAY (USED BY 'DISPLAY' AND REPORTS) DEFDISP: LD A,(CUSCRNP) ;PAGE BEING USED FOR PRINT, PLOT, ETC.(CURRENT) ;CONTAINS MODE TOO. VIDSEL: RST 30H DW CUS2 ;SEE IF DISPLAYED=CURRENT RET Z ;RET IF NO CHANGE IN DISPLAYED SCREEN. PUSH DE ;NEW DISPLAY PAGE IN D AND A ;NC CALL SDISR ;SWITCH PREV DISPLAYED SCREEN IN AT 8000H ;AND COPY WORKING PALTAB TO IT FOR LATER USE IF ;IT IS RE-DISPLAYED POP AF OUT (VIDPORT),A ;MODE/PAGE SENT TO HARDWARE - NEW DISPLAY SCF SDISR: EX AF,AF' IN A,(251) PUSH AF EX AF,AF' PUSH AF INC A ;SO SECOND PAGE OF SCREEN AT 8000H CALL TSURPG LD HL,PALBUF-4000H ;END OF SECOND SCREEN PAGE LD DE,PALTAB POP AF JR C,SDIS2 EX DE,HL SDIS2: LD BC,28H LDIR ;COPY PALETTE TO/FROM DISPLAYED SCREEN ;AND PALTAB IN SYS VARS JP PPORT ;POP AF, OUT 251,RET PRSVARS: LD (CUSCRNP),A ;RESTORE SCREEN VARS FROM SCREEN PAGE RSVARS: SCF DB 26H ;'JR+1' ;SAVE SCREEN VARS TO SCREEN PAGE SSVARS: AND A LD HL,BGFLG LD DE,PVBUFF ;POSN, INK ETC. ATTACHED TO SCREEN JR NC,SSVRC EX DE,HL SSVRC: CALL SPSSR LD BC,PRPOSN-BGFLG LDIR LD C,CEXTAB-PRPOSN ADD HL,BC EX DE,HL ADD HL,BC EX DE,HL ;SRC AND DEST ADVANCED TO COPY CEXTAB LD C,40H LDIR JP RCURPR ;ROM 0 INSTRING R0INST: PUSH BC ;START POSN LD B,D LD C,E ;BC=BYTES TO CHECK LD DE,INSTBUF ;HL=START-OF-SEARCH PTR, (SP)=START POSN ;DE=T$ START, A=T$ LEN PUSH BC ;BYTES TO CHECK LOOKLP: PUSH AF ;TARGET$ LEN EX AF,AF' ;A'=TARGET$ LEN COUNTER LD A,(DE) ;GET FIRST TARGET$ CHARACTER CPIR ;LOOK FOR IT IN SEARCH$ USING HL AS PTR JP PO,NOTFND0 ;JR IF NOT FOUND - BC=0000 PUSH HL ;SEARCH$ PTR DB 3EH ;'JR +1' - HL IS AT SECOND CHAR ALREADY CHKNXTC: INC HL EX AF,AF' ;GET TARGET$ LEN COUNTER DEC A JR Z,FOUND ;FOUND IF ALL CHARS MATCHED EX AF,AF' INC DE LD A,(DE) ;NEXT TARGET$ CHAR CP (HL) ;CP NEXT SEARCH$ CHAR JR Z,CHKNXTC EXX CP C ;C' IS USUALLY '#' EXX JR Z,CHKNXTC ;HASH ALWAYS MATCHES LD DE,INSTBUF ;MATCH FAILS - RESTORE T$ PTR POP HL ;S$ PTR POP AF ;REFRESH TARGET$ LEN COUNTER JR LOOKLP FOUND: POP HL ;SEARCH$ PTR POP HL ;T$ LEN POP HL ;BYTES TO CHECK AND A SBC HL,BC ;SBC BYTES TO CHECK, BYTES LEFT TO CHECK ;TO GET BYTES CHECKED POP BC ;START POSN ADD HL,BC LD B,H LD C,L RET ;BC=TARGET$ POSN IN SEARCH$. NC ;ENTRY IF 1ST CHAR NEVER FOUND - HL IS PAST LAST POSN LOOKED AT NOTFND0: POP AF ;T$ LEN ; EX AF,AF' POP AF ;JUNK BYTES TO CHECK NOTFND2: POP DE ;START POSN NOTFND3: LD BC,0000H SCF RET ;LET/DEFAULT, LABEL, RUN, CLEAR, S16OP, SYNTAX ;SRS, DISPLAY, SCREEN, SETSV INCLUDE ENDPRINT.SAM ;END PRINT, ANY DE ADDR, PIXADDR, POATTR, NET ;ENDPRINT.SAM - FINAL SCREEN OUTPUT ROUTINES FOR MODES 0-3 PRINTABLE CHARS. ;ENTRY: DE=SCREEN ROW/COL, HL PTS TO CHAR DATA, B=OVER AND C=INVERSE MASK ;CALLED FROM ROM1 EPSUB: CALL R1OSR CALL SELSCRN CALL EPSSR POPOUT: POP AF OUT (250),A PPORT: POP AF OUT (251),A RET R1OSR: POP IY IN A,(251) PUSH AF IN A,(250) PUSH AF AND 0BFH OUT (250),A ;ROM1 OFF JP (IY) ;USED BY RENUM GTRLNN: EX DE,HL INC HL IN A,(251) PUSH AF CALL FNDLINE LD D,(HL) INC HL LD E,(HL) ;GET LINE NUMBER LD HL,(FIRST) JR PPORT ;COPY STRING FROM COMMON MEMORY TO WORKSPACE, STACK PARAMS ON FPCS. ;MOVE BC BYTES FROM (HL) TO WKSPACE. USED BY E.G. HEX$, CHR$, STR$. ;FOR STRINGS LEN 1-16K. EXIT: DE=STKEND, PAGING UNCHANGED. CWKSTK: CALL R1OSR PUSH HL CALL WKROOM ;DE=DEST, BC UNCHANGED POP HL PUSH DE PUSH BC LDIR POP BC POP DE CALL STKSTOREP EX DE,HL ;DE=STKEND JR POPOUT EPSSR: LD A,(CSIZE) ;HEIGHT ** PUSH HL EXX POP DE ;DE'=DATA PTR IF MODE 3/4 CP 8 JR C,HPL2 LD A,8 HPL2: LD B,A EXX ;** BUG FIX - LIMIT O/P SCANS TO 8 LD A,(MODE) CP 2 JR Z,M2PRINT JP NC,M3PRINT DEC A JR Z,M1PRINT ;******************************************************************************* ;MODE 0 PRINT. ENTRY: DE=SCREEN ROW/COL, HL=CHAR DATA, B=OVER AND C=INVERSE MASK M0PRINT: CALL M0DEADDR ;GET DE=SCREEN ADDR PUSH DE EXX M0PRLP: EXX ;SCAN COUNTER IN B' LD A,(DE) ;SCREEN DATA AND B ;OVER MASK XOR (HL) ;XOR SCRN XOR C ;XOR INVERSE MASK LD (DE),A INC HL INC D LD A,D AND 07H JR NZ,M0PRNT2 ;JR IF NOT CROSSING CHAR BOUNDARY EX DE,HL CALL NXTDOWN1 EX DE,HL M0PRNT2: EXX DJNZ M0PRLP POP HL CP A JP POATTR0 ;******************************************************************************* ;MODE 1 PRINT. ENTRY: DE=SCREEN ROW/COL, HL=CHAR DATA, B=OVER AND C=INVERSE MASK M1PRINT: CALL M1DEADDR ;GET ADDR OF ROW/COL DE IN DE EXX M1PRLP: EXX LD A,(DE) ;FETCH SCREEN DATA AND B ;AND 0 IF OVER 0, AND FF IF OVER 1 OR 2 XOR (HL) ;XOR CHAR DATA XOR C ;INVERSE MASK USED LD (DE),A ;PLACE ON SCREEN INC HL ;NEXT CHAR DATUM LD A,E ADD A,32 LD E,A ;DROP DE BY 1 SCAN. JR NC,M1PRNC INC D M1PRNC: EXX DJNZ M1PRLP ;LOOP FOR 8 SCANS EXX LD HL,1F00H ;DISP TO ATTR AREA (TOP ROW) ADD HL,DE CALL SETATTR ;USE ATTRT TO CHANGE ATTR AT (HL). HL PRESERVED, A= ;NEW ATTR LD B,7 ;7 MORE TO CHANGE LD DE,32 M1PRATTR: ADD HL,DE ;DROP TO ATTR FOR NEXT CHAR ROW LD (HL),A DJNZ M1PRATTR RET ;******************************************************************************* ;MODE 2 PRINT. ENTRY: DE=SCREEN ROW/COL, HL=CHAR DATA, B=OVER AND C=INVERSE MASK M2PRINT: CALL M2DEADDR ;CY SET IF 6-PIX CHARS, Z/NZ=EVEN/ODD LD H,CEXTAB/256 ;H IS EXPANSION TABLE MSB LD A,C EXX LD C,A ;C"=INVERSE MASK JR C,PR80COL LD HL,MEMVAL ;IF 64-COL, MUST ROTATE CHAR DATA FOR CORRECT ;ALIGNMENT WHEN USING 85-COL O/P ROUTINE PUSH BC ;** P64AL: LD A,(DE) RRCA LD (HL),A INC HL INC DE DJNZ P64AL POP BC ;** LD DE,MEMVAL ;NEW CHAR LOCN. EXX LD C,B ;MAKE RHS OVER MASK=LHS OVER MASK JR PR80EVEN ;85-COLUMN PRINT ;ENTRY: NZ IF ODD COLUMN, Z IF EVEN COLUMN. PR80COL: EXX LD A,B ;OVER MASK JR NZ,PR80ODD OR 0FH LD C,A ;RHS OVER MASK FOR EVEN COLS=0F OR FF PR80EVEN: EXX ;LHS OVER MASK FOR EVEN COLS=00 OR FF M2PREVLP: LD A,(DE) ;GET CHAR DATA FROM (DE") XOR C ;INVERSE MASK INC DE EXX PUSH AF RRCA ;01234560->00123456 RRCA ; ->60012345 RRCA ; ->56001234 AND 0FH ;GET VALUE OF HIGHER CHAR NIBBLE LD L,A ;HL PTS TO ENTRY IN 16-BYTE TABLE CONTAINING ;COLOURED EXPANDED DATA LD A,(DE) ;SCREEN DATA XOR (HL) AND B ;LHS OVER MASK XOR (HL) ;EXPANDED CHAR DATA LD (DE),A INC E ;NEXT SCREEN COLUMN POP AF ;01234560 RLCA ;12345600 AND 0FH ;GET VALUE OF LOWER CHAR NIBBLE. LD L,A ;HL PTS TO ENTRY IN 16-BYTE TABLE CONTAINING ;COLOURED EXPANDED DATA LD A,(DE) XOR (HL) AND C ;RHS OVER MASK XOR (HL) LD (DE),A LD A,E ADD A,127 LD E,A ;DROP DE TO NEXT SCAN, BACK UP 1 BYTE JR NC,M2PRNCE INC D M2PRNCE: EXX DJNZ M2PREVLP RET PR80ODD: OR 0F0H LD C,A ;LHS OVER MASK FOR ODD COLS=F0 OR FF EXX ;RHS OVER MASK FOR ODD COLS=00 OR FF M2PRODLP: LD A,(DE) ;GET CHAR DATA; 01234560 XOR C ;INVERSE MASK INC DE EXX PUSH AF RLCA ;12345600 RLCA ;23456001 RLCA ;34560012 AND 0FH ;GET VALUE OF HIGHER CHAR NIBBLE. LD L,A ;HL PTS TO ENTRY IN 16-BYTE TABLE CONTAINING ;COLOURED EXPANDED DATA LD A,(DE) ;SCREEN DATA XOR (HL) AND C ;LHS OVER MASK XOR (HL) ;EXPANDED CHAR DATA LD (DE),A INC E ;NEXT SCREEN COLUMN POP AF ;GET ORIG CHAR DATUM AGAIN RRCA ;00123456 AND 0FH ;GET VALUE OF LOWER CHAR NIBBLE. LD L,A ;HL PTS TO ENTRY IN 16-BYTE TABLE CONTAINING ;COLOURED EXPANDED DATA LD A,(DE) XOR (HL) AND B ;RHS OVER MASK XOR (HL) LD (DE),A LD A,E ADD A,127 LD E,A ;DROP DE TO NEXT SCAN, BACK UP 1 BYTE JR NC,M2PRNCO INC D M2PRNCO: EXX DJNZ M2PRODLP RET ;******************************************************************************* ;MODE 3 PRINT. ENTRY: DE=SCREEN ROW/COL, HL=CHAR DATA, B=OVER AND C=INVERSE MASK ;USES HL,DE,BC, DE",BC" ;TAKES ABOUT 294*8 Ts vs. POSSIBLE 218*8 FOR OVER 0 ONLY ROUTINE USING LDI M3PRINT: CALL M3DEADDR LD H,CEXTAB/256 ;H IS EXPANSION TABLE MSB LD A,C EXX LD C,A ;C"=INVERSE MASK M3PRLP: LD A,(DE) ;GET CHAR DATA XOR C ;INVERSE MASK INC DE EXX LD C,A RRA RRA RRA AND 1EH ;GET VALUE OF HIGHER CHAR NIBBLE,*2 LD L,A ;HL PTS TO ENTRY IN 16-WORD TABLE CONTAINING ;COLOURED EXPANDED DATA LD A,(DE) ;SCREEN DATA AND B ;OVER MASK XOR (HL) ;EXPANDED CHAR DATA LD (DE),A INC L ;NEXT EXPANDED DATUM INC E ;NEXT SCREEN COLUMN LD A,(DE) AND B ;OVER MASK XOR (HL) LD (DE),A INC E ;NEXT SCREEN COLUMN LD A,C ;GET ORIG CHAR DATUM AGAIN RLA AND 1EH ;GET VALUE OF LOWER CHAR NIBBLE,*2 LD L,A ;HL PTS TO ENTRY IN 16-WORD TABLE CONTAINING ;COLOURED EXPANDED DATA LD A,(DE) AND B ;OVER MASK XOR (HL) LD (DE),A INC L ;NEXT EXPANDED DATUM INC E ;NEXT SCREEN COLUMN LD A,(DE) AND B ;OVER MASK XOR (HL) LD (DE),A LD A,E ADD A,125 LD E,A ;DROP DE TO NEXT SCAN, BACK UP 3 BYTES JR NC,M3PRNC INC D M3PRNC: EXX DJNZ M3PRLP RET ;POFETCH - GET D=ROW, E=COL, A=RHS LIMIT, CY IF PRINTER OR OTHER POFETCH: LD A,(DEVICE) ;0=UPPER SCREEN, 1=LOWER, 2=PRINTER OR OTHER AND A ;NC, TEST FOR ZERO JR Z,POF2 ;JR IF UPPER SCREEN LD DE,(SPOSNL) DEC A JR Z,POF3 ;JR IF LOWER SCREEN LD DE,(PRPOSN) LD A,(PRRHS) ;RHS LIMIT (LINE LEN-1) SCF ;"PRINTER" RET POF2: LD DE,(SPOSNU) POF3: LD A,(WINDRHS) RET CCRESTOP: CALL RESTOP RST 30H DW CCRP2-8000H ;JP TO ROM1 TO DEAL WITH TAB, AT, PAPER, ETC. POSTFF: RST 30H DW PSTFF2-8000H ;JP TO ROM1 TO DEAL WITH FN NAME ;UTILITY MESSAGES. ENTRY WITH A=NUMBER UTMSG: LD DE,(UMSGS) ;PRINT MSG "A" FROM LIST AT DE POMSG: RST 30H DW POMSPX-8000H ;******************************************************************************* ;ANYDEADDR - GET IN DE ADDR OF ROW D, COL E FOR ANY MODE ;EXIT WITH CY IF MODE 2 6-PIX CHARS, Z/NZ =EVEN/ODD ANYDEADDR: LD A,(MODE) AND A JR Z,M0DEADDR DEC A JR Z,M1DEADDR DEC A JR Z,M2DEADDR ;GET IN DE ADDR OF ROW D, COL E FOR MODE 3 (8000H+ROW*CSIZEH*80H+COL*4) M3DEADDR: CALL CLCPO LD A,E ADD A,A ADD A,A ADD A,A ;0-248 SCF RR D RRA LD E,A RET ;GET IN DE ADDR OF ROW D, COL E FOR MODE 1 (8000H+ROW*CSIZEH*20H+COL) M1DEADDR: CALL CLCPO ;SAY A=256*PIX LD A,D RRCA ;128* RRCA ;64* RRCA ;32* LD D,A XOR E AND 0E0H ;COMBINE LOWER 3 BITS OF SCAN LINE AND COL XOR E LD E,A LD A,D AND 1FH ;UPPER 5 BITS OF SCAN LINE OR 80H LD D,A RET ;GET IN DE ADDR OF ROW D, COL E FOR MODE 0 M0DEADDR: CALL CLCPO PUSH BC LD B,D LD A,E ADD A,A ADD A,A ADD A,A LD C,A ;BC=PIX COORDS EX DE,HL CALL M0PIXAD EX DE,HL POP BC RET ;GET IN DE ADDR OF ROW D, COL E FOR MODE 2 (8000H+ROW*CSIZEH*80H+COL*2) ; OR (8000H+ROW*CSIZEH*80H+COL*3/2) ;EXIT WITH NC IF 8-PIX CHARS, OR CY AND Z/NZ=EVEN/ODD COL M2DEADDR: CALL CLCPO LD A,(FL6OR8) AND A LD A,E JR Z,M2DEADDR2 ;JR IF 6-PIX CHARS ADD A,A ;0-126 ADD A,A ;0-252 SCF RR D RRA ;NC=8-PIX CHARS LD E,A RET M2DEADDR2: ADD A,A ADD A,E ;A=ORIG COL*3 (0-252) SCF RR D RRA ;(0-126 - OFFSET FROM LHS) BIT 0,E ;Z IF ORIG COL=EVEN LD E,A SCF ;SIGNAL 6-PIX, Z/NZ=EVEN/ODD RET ;CALC PIX IN D ROWS, ADD OFFSET IF LOWER SCREEN CLCPO: CALL CALCPIXD LD D,A LD A,(DEVICE) AND A RET Z ;RET IF UPPER SCREEN LD A,(LSOFF) ADD A,D LD D,A RET ;******************************************************************************* ;ANY MODE PIXEL ADDRESS FOR PT. B,C (OR POINT B,HL IF THIN PIX) ;EXIT: HL=ADDR (8000+) A=X MOD 8 ;IF MODE 3, CY IF ODD PIXEL ANYPIXAD: LD A,(THFATT) AND A JR NZ,NTTHINPIX LD C,L ;SAVE ORIG X LSB RR H RR L ;HALVE X IF THIN PIX DB 0FEH ;"JR+1" NTTHINPIX: LD L,C LD H,B LD A,(MODE) AND A JR Z,M0PIXAD DEC A JR Z,M1PIXAD LD A,C JR M1PIXAD2 ;GET PIXEL ADDR OF POINT C,B IN HL. MODE 0. (Y AXIS HAS ZERO AT TOP) ;ALTERS HL AND A. ADDR=8000-97FF. A=PIX OFFSET M0PIXAD: LD L,B LD A,B OR A RRA RRA SCF RRA AND 9FH XOR L AND 0F8H XOR L LD H,A LD A,C RLCA RLCA RLCA XOR L AND 0C7H XOR L RLCA RLCA LD L,A LD A,C AND 07H RET ;GET MODE 1 PIXEL ADDR. ENTRY: L=X, H=Y ;EXIT: HL=ADDR, B=PIXEL OFFSET (0-7), A=B M1PIXAD: LD A,L AND A RR H ;NC ROTATED IN RR L AND A RR H RR L M1PIXAD2: AND 07H LD B,A SCF RR H RR L ;HL=Y/8+X/8+8000H=ADDRESS RET ;POATTR.SAM ;******************************************************************************* ;POATTR01. SET ATTR OF PATTERN DATA AT (HL) FOR MODE 0 OR 1 ;ENTRY: HL=SCREEN ADDR. USES HL, BC AND AF POATTR01: LD A,(MODE) AND A LD A,H SET 5,A ;ADD 2000H FOR USE IF MODE 1 ;THIS ENTRY CAN BE USED DIRECTLY BY MODE 0 POATTR0: CALL Z,CTAA LD H,A ;ENTRY POINT IF HL ALREADY PTS TO ATTR SETATTR: LD BC,(ATTRT) LD A,(HL) XOR C AND B XOR C LD BC,(PFLAGT) BIT 4,C JR Z,POATTR1 ;JR IF NOT INK 9 OR 07H BIT 5,A JR Z,POATTR1 XOR 7 POATTR1: BIT 6,C JR Z,POATTR2 ;JR IF NOT PAPER 9 OR 38H BIT 2,A JR Z,POATTR2 XOR 38H POATTR2: LD (HL),A RET ;COMPARE TWO STRINGS FROM STACK (OVER <16K). PAGING UNALTERED ON RETURN. ;EXIT: Z IF STRINGS MATCH, CY IF S1S2. HL=S1 PTR ;USES HL,BC,AF, HL" DE", BC" AF" STRCOMP: CALL R1OSR PUSH HL ;S1 PTR CALL UNSTKPRT ;BC=S2 LEN, DE=S2 ST, A=PORT VALUE PUSH DE ;S2 ST PUSH AF ;S2 PORT VALUE PUSH BC ;S2 LEN CALL UNSTKPRT ;BC=S1 LEN, DE=S1 ST, A=PORT POP HL ;S2 LEN AND A SBC HL,BC ;S2 LEN-S1 LEN ADD HL,BC JR NC,STRCOMP2 ;JR IF BC<=HL LD B,H LD C,L ;MAKE BC=SHORTEST LEN STRCOMP2: LD L,A ;L=S1 PORT EX AF,AF' ;SAVE Z IF LENS EQUAL, CY IF S1 LEN GRTR. LD A,B CP 40H JP NC,STLERR ;ONLY DEAL WITH STRINGS<16K POP AF LD H,A ;H=S2 PORT PUSH BC LD C,251 EXX POP BC ;BC"=SHORTEST LEN POP HL ;HL"=S2 ST JR SCOMPBG SCOMPLP: EXX OUT (C),L ;S1 PAGE SEL LD A,(DE) ;S1 CHAR INC DE OUT (C),H ;S2 PAGE SEL EXX CP (HL) ;S2 CHAR JR NZ,SCOMPEX ;JR WITH CY IF S2 GRTR; NZ,NC IF S1 GRTR INC HL DEC BC SCOMPBG: LD A,B OR C JR NZ,SCOMPLP ;LOOP UNTIL STRINGS MATCH OVER BC CHARS EX AF,AF' ;Z IF LENS EQUAL - STRINGS MATCH JR Z,SCOMPEX ;** COMPARISON BUG FIX CCF ;CY IF S2 STRING LONGER - IE GREATER ;NZ,NC IF S1 STRING LONGER - IE GREATER SCOMPEX: POP HL ;S1 PTR SCOMPC: EX AF,AF' POP AF OUT (250),A POP AF OUT (251),A EX AF,AF' RET ;STRING BUFFER FETCH. COPY STRING ON FPCS TO "INSTBUF" IN COMMON MEM. ERROR IF ;LEN >255 OR 0. ON EXIT, BC AND A=LEN, DE=START, PAGING UNALTERED. SBUFFET: CALL SBFSR RET NZ INVARG: RST 08H DB 27 ;AS SBUFFET, BUT LEN ZERO GIVES Z FLAG, NOT AN ERROR MSG SBFSR: LD A,0FFH SBFSR2: EX AF,AF' CALL R1OSR CALL GETSTRING ;AND SELECT PAGE EX AF,AF' ADD A,B ;ADD FF OR FE, LEN MSB JR C,INVARG ;ERROR IF T$ LEN >FF OR >01FF LD A,B OR C JR Z,SCOMPC ;RET IF LEN=0 ;A=LEN. EX DE,HL LD DE,INSTBUF ;256 BYTES IN PAGE 0 PUSH BC PUSH DE LDIR ;COPY T$ TO PAGE 0 POP DE POP BC ;BC=LEN, A=C. NC JR SCOMPC ;NZ HERE FROM 'OR C' - SCOMPC PRESERVES IT TOO ;UNSTACK STRING AND GET PORT VALUE NEEDED TO SWITCH IT IN UNSTKPRT: CALL STKFETCH ;A=PAGE, DE=START, BC=LEN LD H,A IN A,(251) XOR H AND 0E0H ;USE UPPER 3 BITS FROM PORT XOR H RET ;A=PORT VALUE ;ADDRESS OF IDERR GOES INTO SOME CHANNELS IDERR: RST 08H DB 20 ;"Invalid device" ;CHECK IF OK TO USE ABC BYTES (PAGE FORM). EXITS WITH ABC, DE CHANGED. TSTRMBIG: PUSH AF PUSH BC CALL TSTRMABC POP BC POP AF RET ;CHECK IF OK TO USE ABC BYTES (PAGE FORM). EXITS WITH DE CHANGED. NC. AHL= ;PAGE FORM OF NEW WKEND TSTRMABC: LD H,B LD L,C TSTRMAHL: CALL AHLNORM LD B,H LD C,L ;ABC=19-BIT SPACE DB 0FEH ;"JR+1" ;CHECK IF OK TO USE BC BYTES (0-FFFF). ERROR IF NOT. EXITS WITH BC UNCHANGED, NC ;AHL=PAGE FORM OF NEW WKEND, DE=FREE, OR A HIGH VALUE IF FREE>=64K TESTROOM: XOR A PUSH BC LD D,A ;DBC=SPACE CALL WENORMAL ;GET AHL=WKEND (19 BIT) ADD HL,BC ADC A,D ;AHL=NEW VALUE AFTER BC USED CALL PAGEFORM ;AHL=PAGE FORM OF NEW WKEND PUSH AF PUSH HL EX DE,HL LD C,A LD A,(RAMTOPP) LD HL,(RAMTOP) ;AHL=RAMTOP CALL SUBAHLCDE ;AHL=ROOM JR C,OOMERR ;ERROR IF NEW WKEND PAGE WOULD BE ABOVE RAMTOP CALL AHLNORM ;AHL=19 BIT ROOM EX DE,HL AND A JR Z,TRM2 SET 7,D ;IF >64K FREE, MAKE DE A HI VALUE TRM2: POP HL POP AF ;AHL=NEW WKEND POP BC ;SPACE RET OOMERR: RST 08H DB 1 ;"OUT OF MEMORY" ;COPY STRING FROM (DE), LEN BC, PORT VALUE A, TO WKSPACE. SOURCE CAN BE ANYWHERE ;AND NEED NOT BE SWITCHED IN ON ENTRY. LEN TRUNCATED TO <=255 WITHOUT ANY MSG. ;LEN 0 WILL CRASH! ROM1 MUST BE SWITCHED OFF ON ENTRY! ;EXIT: HL=PAST ROOM END, DE=ROOM START, DE"=PAST STRING END, B"=0, C"=URPORT, ;H"=SRC PORT VALUE, L"=WKSPACE PORT. WORKSPACE IS SWITCHED IN. ;NOTE: REASONABLY FAST FOR SHORT STRINGS ;USED BY READ AND VAL ONLY ;SCOPYWK: PUSH DE ;SRC ; INC B ; DEC B ; JR Z,SCOPYWK2 ;JR IF LEN<=256 ; LD BC,0FFH ;ELSE TRUNCATE - STRMOVE ONLY ALLOWS SHORT STRINGS ;SCOPYWK2: CALL WKROOM ;DE=ROOM, HL=END BYTE, BC AND A UNCHANGED ; LD B,C ;LEN COUNTER ; LD H,A ;H=STRING PORT VALUE ; IN A,(251) ; LD L,A ;L=WKSPACE PORT VALUE ; PUSH DE ;WKSPACE ; EXX ; POP HL ;DEST TO HL" ; LD D,H ; LD E,L ;KEEP A COPY OF THE START IN DE ; EXX ; POP DE ;SRC ;;MOVE B BYTES FROM (DE) PORT VALUE H TO (HL") PORT VALUE L. EXIT WITH ALT REGS. ; LD C,251 ;STRMVLP: OUT (C),H ;SRC PAGE ; LD A,(DE) ;SRC BYTE ; INC DE ; OUT (C),L ;DEST PAGE ; EXX ; LD (HL),A ;TO WKSPACE AT HL" ; INC HL ; EXX ; ; DJNZ STRMVLP ;ABOUT 80 Ts/BYTE ; EXX ;RET WITH REGS SWAPPED ;COPY BC BYTES FROM DE TO WKSPACE SCOPYWK: INC B DEC B JR Z,SCOPYWK2 ;JR IF LEN<=256 LD BC,0FFH ;ELSE TRUNCATE SCOPYWK2: CALL R1OSR EX DE,HL ;SRC TO HL LD DE,INSTBUF PUSH DE PUSH BC LDIR POP BC PUSH BC CALL WKROOM POP BC POP HL PUSH DE LDIR EX DE,HL ;HL=PAST END POP DE ;START DEC HL LD (HL),0DH POP AF OUT (250),A POP AF RET ;CALLED BY LENGTH FN AND TAPEMN LENGSR: CALL LOOKVARS ;HL POINTS TO NUMERIC VALUE, OR STRING LEN DATA PUSH AF ;FOUND/NOT FOUND FLAG PUSH BC PUSH DE LD (MEMVAL),HL IN A,(URPORT) LD DE,MEMVAL+2 LD (DE),A INC DE LD C,7 CALL SCOPN2 ;LDIR 7 BYTES, SELCHADP POP DE POP BC ;TYPE POP AF ;FLAGS RET DS 3F8CH-$,0 ;FIXED ROUTINES ;***************************************************************************** ;UNSTACK A 5-BYTE NUMBER TO AN ADDRESS IN A (PAGE) AND HL (8000-BFFF) ;(RES 7,H IF 5-BYTE IS A LENGTH, TO GIVE PAGE, +0000-3FFFH). GIVES IOOR ERROR ; IF NUMBER IS NEGATIVE OR >07FFFF UNSTLEN: DB CALC ;N DB STK16K ;N,16K DB MOD ;N MOD 16K DB RCL3 ;N MOD 16K,INT(N/16K) (PLACED BY MOD) DB EXIT CALL GETBYTE CP 21H JP NC,IOORERR ;PAGE MUST BE 00-20H (0=ROM, 1-20=RAM) PUSH AF CALL GETINT ;TO HL AND BC POP AF RET ;A=PAGE ;NEW POKE/DPOKE SR NPDPS: CALL PDPSUBR LD A,H CP 0C0H RET C JR INCURPAGE ;SELECT SCREEN, ROM1 OFF SPSSR: IN A,(250) LD (CLRP),A AND 0BFH OUT (250),A ;ROM1 OFF ;STORE PAGE SCREEN SELECT SPSS: IN A,(251) LD (CURP),A SELSCRN: LD A,(CUSCRNP) ;SCREEN PAGE JR SELURPG ;READ BYTE FROM SCREEN AT HL, FORCING SCREEN ON, ROM1 OFF SREAD: CALL SPSSR ;SELECT SCREEN, ROM1 OFF LD A,(HL) RCURPR: EX AF,AF' LD A,(CLRP) OUT (250),A DB 3EH ;'JR+1' TRCURP: RCURP: EX AF,AF' RCUR2: LD A,(CURP) OUT (251),A EX AF,AF' RET ;SET CHADP VAR AND SWITCH IT IN SETCHADP: LD (CHADP),A ;ROM1 OFF, SELCHADP R1OCHP: IN A,(250) AND 0BFH OUT (250),A ;ROM1 OFF ;SWITCH IN CHADP SELCHADP: LD A,(CHADP) ;CHAD PAGE JR TSURPG ;UNSTACK A STRING AND SELECT IT"S PAGE. DE=START (8000-BFFF), BC=LEN TGTSTR: GETSTRING: CALL STKFETCH ;A=PAGE, DE=START, BC=LEN ;SELECT UPPER RAM PAGE SELURPG: TSURPG: PUSH HL LD H,A IN A,(251) XOR H AND 0E0H ;KEEP TOP 3 BITS FROM PORT XOR H OUT (251),A POP HL RET ;INCREMENT UPPER RAM PAGE, ENSURE DE IS NOT IN C000-FFFF AREA ;USES A, ALTERS D INCURPDE: RES 6,D JR INCURCOM ;INC PAGE AND ADJUST HL POINTER IF NEEDED CHKHL: BIT 6,H RET Z ;INCREMENT UPPER RAM PAGE, ENSURE HL IS NO IN C000-FFFF AREA ;USES A, ALTERS H INCURPAGE: RES 6,H INCURCOM: IN A,(251) INC A JR SELURPG DECURPAGE: SET 6,H IN A,(251) DEC A JR SELURPG