;DRIVER 10/22/80 ;XYBASIC Interpreter Source Module ;Copyright (C) 1978, 1979, 1980 by Mark Williams Company, Chicago ;interpreter driver ;The interpreter driver has several entry points. ;DMOD2, after errors, resets SP and falls through to... ;DMODE, after execution, prints OK prompt, then... ;DMOD3 is the driver itself. Gets a line of user text, tokenizes it and ;either executes it (no line #) or adds it to source text, then gets another. if compl ;return to DMODE boots in COMPL version dmod2 equ boot dmodc equ boot dmode equ boot else dmod2: lxi sp,stack ;reset SP dmode: call prtm0 ;print OK message if epstn db cr, lf, 13H, 'OK', 12H, cr, lf or 80H else db cr, lf, 'OK', cr, lf or 80H endif xra a sta gchar ;clear GET character sta tracl ;clear tracing status if strng sta stemp ;clear # string temps in use endif dmod3: call lnnu0 ;reset LNNUM to 0 in case ^C typed call gtlin ;get a line from user call tkize ;tokenize it jc xsta1 ;execute it if no line # cnz addln ;else add to source text unless jmp dmod3 ;and get another line endif ;end of COMPL conditional ;NEXTC scans to next command, resets SP and falls through to NEXTS. nextc: lhld cstkp shld estkp ;reset ESTACK in case error within expr call gtdel ;scan to delimiter lxi sp,stack ;reset SP and fall through to NEXTS ;NEXTS is branched to with TEXTP pointing to a delimiter (: ' ), else it ;issues a SN error. Performs break char and interrupt tests. ;Returns to DMOD1 if at eof. Moves TEXTP to first char ;of next statement, updates LNNUM and performs break test. Then falls through ;to XSTAT for statement execution. nexts: if camac and nonst and (not rtpak) in 1 ani 2 cnz ctst0 ;read char if present else call cstat ;test console for break char rrc cc ctst0 ;read char if present endif if not wild lda intad rlc ;test whether interrupt table empty cc itest ;no, check if interrupt occurs endif lhld textp shld savtp ;save textp mov a,m ;inline CALL GTCH1 to get next char inx h cpi ' ' jz $-4 shld textp cpi ':' jz xstat ;another statement on same line if rtpak or not compl ;comments are removed if compiled cpi '''' cz rem ;on-line comment endif cpi cr jnz snerr ;syntax error -- garbage after statement mov a,m ;fetch length byte of next line ora a jz dmode ;end of source text inx h shld lnnum ;save line number address inx h inx h mov a,m ;fetch break byte inx h ;point to first text byte shld textp ;set text pointer if not compl rar ;NB carry was reset above! cc btest ;test for break if bit 0 was set ;XSTAT is branched to with TEXTP pointing to first char of a statement. ;Performs trace mode test, then falls through to XSTA1 for ;actual statement execution. ;XSTA1 is entry point from direct mode, to avoid trace checks. ;XSTA2 is entry point for THENpart of an IF statement. xstat: lda trace sta tracl ;set tracing status of current statement ora a cnz tprnt ;print trace line # if traceon endif ;skip trace tests in COMPL version xsta1: lxi b,nexts if compl xstat equ xsta1 endif push b ;stack normal return address to allow RET xsta2: lhld textp ;inline CALL GTCHA follows to get next token mov a,m inx h cpi ' ' jz $-4 shld textp ora a jp let0 ;not token, must be LET or null statement if wild cpi wbuft jz wletb ;BUFFER legal lhs in WILD version endif sui cmdtk ;subtract min token value jc snerr ;too small, not a command token cpi ncmds ;compare to number of commands jnc snerr ;too big lxi h,cmdta ;command branch table address to HL add a ; * 2 bytes per entry mov c,a mvi b,0 dad b ;add offset to base address mov a,m ;low order address to A, temporarily inx h mov h,m ;high order addr to H mov l,a ;low order addr to L pchl ;branch to address ;BTEST checks for line breakpoints. ;Called before XSTAT, so TRACL is not yet reinitialized. ;Call: A line break byte, RARed once. if not compl btest: ora a ;test further if more bits set lxi h,xsta1 ;replace XSTAT return addr with XSTA1 to xthl ; avoid resetting TRACL on return jz tprnt ;print break line and return if only bit 0 set rrc ;bit 1 of break byte to carry jnc btst2 ;no count or variables, check for DMODE break push psw ;save break byte, rotated twice ;Now the symbol table entry containing line break info must be found. lhld lnnum call bknam ;break entry 'name' to BUFAD mvi a,brkst call stlk0 ;look up break entry jc exerr ;not found -- EX error ;Next the count (# times before next break) is fetched. mov e,m inx h mov d,m ;count to DE dcx d ;decrement count mov a,d ora e jnz btst3 ;nonzero -- return ;Counted to zero, so reset count to original value and print break info. mov b,h mov c,l dcx b ;BC points to count inx h ;HL points to reset mov a,m stax b inx b inx h mov a,m stax b ;copy reset to count call tprnt ;print break [] pop psw ;restore break byte rrc ;bit 2 of break byte to Carry jnc btst1 ;skip var printing ;The break specified a , so variable values must be printed. push psw ;save break byte, RRCed 3 times inx h ;point to var list addr mov a,m inx h mov h,m mov l,a ;varlist address to HL shld txtp2 call flip ;scan var list lxi h,trace mov a,m push psw ;save TRACE mvi m,255 ;and set TRACE to true btst0: call gtlhs ;get var ref mov b,a ;save type call trva1 ;print = value call gtcom ;look for another jnc btst0 ;print more vars pop psw sta trace ;restore trace call flip ;restore textp pop psw ;BTEST returns or breaks to DMODE, depending on whether BREAK specified $. btst1: rlc btst2: ani 2 ;test bit 3 (after two rotates) rz ;no $ -- continue mvi a,cslbk ;line break entry token to A jmp stop1 ;$ btst3: mov m,d dcx h mov m,e ;new value to count pop psw ;restore break byte pop h ;POP the RETurn to XSTA1 jmp xstat ;and return to XSTAT for TRACL initialization ;BPRNT prints [] if not TRACL, and is called by NEXT and TRSET. ;TPRNT prints [] and sets TRACL to TRUE. ;Both preserve BC,DE,HL and clobber A. bprnt: lda tracl ora a rnz ;suppress break printout if traced tprnt: push3 call wcrlf ;write crlf mvi a,'[' call writc ;write [ lhld lnnum ;line number address to HL call prntl ;print the line mvi a,']' ;write ] call writc if wild call wrtsp ;write a space (no tab routine) else call prco1 ;tab to next tab stop endif mvi a,255 sta tracl ;set TRACL to indicate line traced already jmp pop3 endif ;end of NOT COMPL conditional ;ITEST determines whether interrupt occurs and then returns or interrupts. ;If no interrupt: ;Retn: A,BC,DE clobbered ; HL address of interrupt table eof ;If interrupt occurs, ITEST's return address is POPed, a normal statement ;return address is PUSHed, and a GOSUB to the appropriate line # is executed. if not wild itest: lxi h,intad ;first byte address to HL itst1: rlc ;test enable/suspend bit jnc itst3 ;suspended -- look for more mov c,a ;save $ bit in sign bit of C mov d,h mov e,l ;save first byte address in DE inx h ;point to port # byte mov a,m call rdp1 ;read the port inx h ;point to mask byte ora m inx h ;point to value byte xra m ;compare & clear carry jz itst2 stc ;carry set iff compare not zero itst2: rar ;carry to sign bit of A xra c ;sign bit set iff no interrupt jp itst4 ;interrupt occurs xchg ;restore first byte address to HL itst3: lxi d,8 dad d ;address next entry mov a,m ;first byte of table entry to A rlc ;test on/off bit rnc ;no more table entries -- return jmp itst1 ;and check it itst4: call linbc ;zero set iff direct mode rz ;no interrupts from direct mode xchg ;restore first byte address to HL xthl ;pop ITEST return, push first byte address mvi a,csint call cpush ;token, textp, lnnum to control stack pop d call mvmde xchg ; and to HL mov a,m ;fetch first byte ani 0BFH ;suspend interrupt entry mov m,a lxi d,7 dad d ;address byte 8 of entry call mvdem push h ;save entry ptr call findl ;look for ENABLE line # address jc enerr ;none, EN error inx h ;point to line # byte xthl ;push ENABLE line # address, recover ptr call mvdem ;desired interrupt routine line # to DE lxi h,nexts xthl ;pop ENABLE line # address, push return addr shld lnnum ;set lnnum in case line not found jmp goto2 ;find line #, continue from there endif ;end of NOT WILD conditional ;end of DRIVER page