From a77bd3183ff64baacc490dc9cd80b6c7552037ec Mon Sep 17 00:00:00 2001 From: endlos99 Date: Wed, 3 Apr 2024 19:01:21 +0200 Subject: [PATCH] xga99: add strict syntax (-s), Ryte Data symbols (-R) --- doc/CHANGES.md | 22 + doc/MANUAL.md | 26 +- test/as-checkerr.py | 9 + test/asm/aserrpar.asm | 9 + test/ga-checkcli.py | 5 + test/ga-checkext.py | 4 +- test/gpl/srxb6.gpl | 3639 +++++++++++++++++++++++++++++++++++++++++ xas99.py | 18 +- xbas99.py | 2 +- xda99.py | 2 +- xdg99.py | 2 +- xdm99.py | 2 +- xga99.py | 135 +- xhm99.py | 2 +- xvm99.py | 2 +- 15 files changed, 3828 insertions(+), 51 deletions(-) create mode 100644 test/asm/aserrpar.asm create mode 100644 test/gpl/srxb6.gpl diff --git a/doc/CHANGES.md b/doc/CHANGES.md index 83d38e5..cb99822 100644 --- a/doc/CHANGES.md +++ b/doc/CHANGES.md @@ -1,3 +1,25 @@ +Changes Version 3.6.5 +===================== + +xga99 GPL Cross-Assembler +------------------------- + +The native `xga99` syntax style is more modern in that it supports lower case +sources, extended expressions, relaxed labels, local labels, and relaxed use of +whitespace. + +To assemble legacy sources written for the Ryte Data or RAG assemblers, we need +to provide the _strict syntax option_ `-s`, which also disables various `xga99` +extensions. To add the predefined symbols provided by the Ryte Data assembler, +we can use the _Ryte Data symbols_ option `-R`. + +In contrast, the _relaxed syntax mode_ `-r` enables the least +restrictive syntax, where whitespace can be used freely, but comments must be +introduced by `;`. + +The `xga99` preprocessor is identical to the `xas99` one. + + Changes Version 3.6.1 ===================== diff --git a/doc/MANUAL.md b/doc/MANUAL.md index db873fd..4dbc39f 100644 --- a/doc/MANUAL.md +++ b/doc/MANUAL.md @@ -67,7 +67,7 @@ this manual. Tutorial -------- -The xdt99 tools are command line tools that lack a graphical user interface. +The xdt99 tools are command line tolls that lack a graphical user interface. While this choice will somewhat steepen the learning curve for some users, the command line is ultimately very suited for repetitive tasks, as encountered while developing programs. @@ -2547,12 +2547,12 @@ manual. As the Graphics Programming Language was never intended for public release, existing tools for assembling GPL source code differ substantially in the syntax -they use. `xga99` adopts a combination of the Ryte Data and the RAG GPL -Assemblers' syntax as its native format. +they use. `xga99` supports both the Ryte Data and the RAG assemblers' syntax as +its native format. We can choose other syntax styles, however, with the _syntax option_ `-y`. -Currently, the only extra syntax is the syntax of the TI Image Tool -disassembler, available with name `mizapf` (named after the creator of the image +Currently, the only other syntax supported is the syntax of the TI Image Tool +disassembler, available with `mizapf` (named after the creator of the image tool). $ xga99.py gahello_timt.gpl -y mizapf @@ -2560,10 +2560,20 @@ tool). Note that the original GPL syntax described in TI's _GPL Programmer's Guide_ is considered too arcane to be included in `xga99`. -The native `xga99` syntax style is more "modern" in that it supports lower case +The native `xga99` syntax style is more modern in that it supports lower case sources, extended expressions, relaxed labels, local labels, and relaxed use of -whitespace, including the relaxed syntax mode, similar to `xas99`. Both -cross-assemblers also share the same preprocessor. +whitespace. + +To assemble legacy sources written for the Ryte Data or RAG assemblers, we need +to provide the _strict syntax option_ `-s`, which also disables various `xga99` +extensions. To add the predefined symbols provided by the Ryte Data assembler, +we can use the _Ryte Data symbols_ option `-R`. + +In contrast, the _relaxed syntax mode_ `-r` enables the least +restrictive syntax, where whitespace can be used freely, but comments must be +introduced by `;`. + +The `xga99` preprocessor is identical to the `xas99` one. As for `xas99`, warnings and errors are _colored_ by default, which may be controlled with the `--color` option. Frequently used options can be stored in diff --git a/test/as-checkerr.py b/test/as-checkerr.py index 35012ac..f21835c 100755 --- a/test/as-checkerr.py +++ b/test/as-checkerr.py @@ -274,6 +274,15 @@ def runtest(): with open(Files.error, 'w') as ferr: xas(source, '-o', Files.output, stderr=ferr, rc=1) + # parser error + source = os.path.join(Dirs.sources, 'aserrpar.asm') + with open(Files.error, 'w') as ferr: + xas(source, '-R', '-o', Files.output, stderr=ferr, rc=1) + errs = content_line_array(Files.error)[1:-1:2] + lines = set(e[22] for e in errs) + if lines != set(str(i) for i in range(1, 9)): + error('parser', f'Missing error message: {lines}') + # cleanup delfile(Dirs.tmp) diff --git a/test/asm/aserrpar.asm b/test/asm/aserrpar.asm new file mode 100644 index 0000000..17aa94e --- /dev/null +++ b/test/asm/aserrpar.asm @@ -0,0 +1,9 @@ + mov r0,@2(r1 + mov @0(r1,r0 + mov r0,@2(r1)) + mov @(r1,@2) + mov r0,@r2) + mov @2(r1,r2) + mov r1,r2(r3) + mov @(r2),r0 ;WARN + end diff --git a/test/ga-checkcli.py b/test/ga-checkcli.py index 224bdd2..4326fd0 100755 --- a/test/ga-checkcli.py +++ b/test/ga-checkcli.py @@ -230,6 +230,11 @@ def runtest(): data[0x4001] != 0x2e): error('cart', 'Incorrect cart with GPL header') + # strict syntax, should not throw errors + source = os.path.join(Dirs.gplsources, 'srxb6.gpl') + with open(Files.error, 'w') as ferr: + xga(source, '-s', '-R', '-o', Files.output, stderr=ferr, rc=0) + # cleanup delfile(Dirs.tmp) diff --git a/test/ga-checkext.py b/test/ga-checkext.py index 3b1955e..c6db3e2 100755 --- a/test/ga-checkext.py +++ b/test/ga-checkext.py @@ -80,9 +80,9 @@ def runtest(): source = os.path.join(Dirs.gplsources, 'gauusym.gpl') with open(Files.error, 'w') as ferr: xga(source, '--color', 'off', '-o', Files.output, stderr=ferr, rc=0) - expected = """> gauusym.gpl <-> **** - + expected = """> gauusym.gpl <*> **** - ***** Warning: Unused constants: s1:5 - > gauusymi.gpl <-> **** - + > gauusymi.gpl <*> **** - ***** Warning: Unused constants: si:1 """ if content_lines(Files.error, skip=1) != expected: diff --git a/test/gpl/srxb6.gpl b/test/gpl/srxb6.gpl new file mode 100644 index 0000000..e5bc4ce --- /dev/null +++ b/test/gpl/srxb6.gpl @@ -0,0 +1,3639 @@ +*********************************************************** + TITL 'RXB 2024' +*********************************************************** +FSLOC EQU >2002 Free Start LOCation in ERAM +* Free end must follow it. +*********************************************************** +* RXB move INIT code to ROM 3 * +INITF EQU >2006 INIT flag address INIT has be +* called if ERAM (INITF)=>AA55 +* Free end initialized to >4000, (>FFF8 for debugger) +* Free start is initialized to the first useable memory +* location for assembly language code +* CPUBAS EQU >A040 Expansion RAM base +*********************************************************** +* GROM ADDRESSES +*********************************************************** +* GROM >6000 +MSGFST EQU >6040 +MSG10 EQU >6065 +MSG14 EQU >6076 +MSG16 EQU >6083 +MSG17 EQU >609C +MSG19 EQU >60AD +MSG24 EQU >60BB +MSG25 EQU >60D2 +MSG28 EQU >60E4 +MSG34 EQU >60F9 +MSG36 EQU >6110 +MSG39 EQU >611C +MSG40 EQU >6128 +MSG43 EQU >6137 +MSG44 EQU >6148 +MSG47 EQU >6159 +MSG48 EQU >616F +MSG49 EQU >6189 +MSG51 EQU >6198 +MSG54 EQU >61AD +MSG57 EQU >61BE +MSG60 EQU >61CC +MSG61 EQU >61DB +MSG67 EQU >61EB +MSG69 EQU >61FA +MSG70 EQU >6215 +MSG74 EQU >622D +MSG78 EQU >623A +MSG79 EQU >624D +MSG81 EQU >6257 +MSG83 EQU >626F +MSG84 EQU >627B +MSG97 EQU >6286 +MSG109 EQU >629B +MSG130 EQU >62A6 +MSG135 EQU >62B0 +MSG62 EQU >62C5 +MSGCIS EQU >630A +MSGCF EQU >6319 +MSG56 EQU >6324 +TOPLEV EQU >6372 RXB PATCH for XBPGM +SZNEW EQU >6020 RXB PATCH for NEW +TOPL15 EQU >63DD * Return from OLD or SAVE +TOPL42 EQU >6433 +TOPL55 EQU >6462 +ILLST EQU >64EF +EDITLN EQU >66CF * Edit a line into a program +READL3 EQU >6A8A +SZRUNL EQU >64A0 +G6D78 EQU >6D78 * GKXB ERR routine +ERPRNT EQU >6E0E +ERPNT5 EQU >6E1B +DISO EQU >6FBA +* GROM >8000 +GRMLST EQU >802A +* GROM >A000 +ASC EQU >A00A +LNKRT2 EQU >A01A Return to XB +LNKRTN EQU >A01C ) and return to XB +COMB EQU >BFE0 +STRFCH EQU >BFE2 +STRPAR EQU >BFE4 +STRGET EQU >BFE6 +NUMFCH EQU >BFE8 +CFIFCH EQU >BFEA +GNRTN EQU >BFEC +NGOOD EQU >BFEE +SNDER EQU >BFF0 +CIFSND EQU >BFF2 +SNDASS EQU >BFF4 +SUBLP3 EQU >BFF6 +SUBLP4 EQU >BFF8 +CLRFAC EQU >BFFA +GETNUM EQU >BFFC +* GROM >E000 +GE025 EQU >E025 RXB PATCH for EA +*********************************************************** +* EQUATES FOR ROUTINES FROM OTHER GROM SECTIONS +MSGBRK EQU >6048 * BREAKPOINT +LLIST EQU >6A74 List a line +CHKEND EQU >6A78 Check end of statement +WARNZZ EQU >6A82 WARNING MESSAGE ROUTINE +ERRZZ EQU >6A84 ERROR MESSAGE ROUTINE +* READL1 EQU >6A86 Read a line from keyboard +CLSALL EQU >8012 +GRSUB2 EQU >802C +GRSUB3 EQU >802E +*********************************************************** +* Equates for XMLs +SYNCHK EQU >00 SYNCHK XML selector +SEETWO EQU >03 SEETWO XML selector +ALSUP EQU >20 XML to user AssembLy SUBrouti +COMPCT EQU >70 PREFORM A GARBAGE COLLECTION +GETSTR EQU >71 SYSTEM GET STRING +XBCNS EQU >73 Convert number to string +PARSE EQU >74 Parse a value +CONT EQU >75 Continue parsing +VPUSH EQU >77 Push on value stack +VPOP EQU >78 Pop off value stack +PGMCHR EQU >79 GET PROGRAM CHARACTER +SYM EQU >7A Find SYMBOL entry +SMB EQU >7B Find symbol table entry +ASSGNV EQU >7C Assign VARIABLE +SPEED EQU >7E SPEED UP XML +CRUNCH EQU >7F Crunch an input line +CIF EQU >80 Convert INTEGER to FLOATING P +SCROLL EQU >83 SCROLL THE SCREEN +* GREAD EQU >85 READ DATA FROM ERAM +* MVDN EQU >88 MOVE DATA IN VDP/ERAM +MVUP EQU >89 MOVE DATA IN VDP/ERAM +* GREAD1 EQU >8C READ DATA FROM ERAM +*********************************************************** +* XML for ROM3 +RROLL EQU >70 Right ROLL screen ASSEMBLY +LROLL EQU >71 Left ROLL screen ASSEMBLY +UROLL EQU >72 Up ROLL screen ASSEMBLY +DROLL EQU >73 Down ROLL screen ASSEMBLY +HCHAR EQU >74 HCHAR ASSEMBLY +VCHAR EQU >75 VCHAR ASSEMBLY +ASCHEX EQU >76 ASC/HEX/DEC ASSEMBLY +HPUT EQU >77 HPUT ASSEMBLY +VPUT EQU >78 VPUT ASSEMBLY +INVERS EQU >79 INVERSE ASSEMBLY +SAMSR EQU >7C SAMS AMSCRU LOADER +ALPHA EQU >7E ALPHA LOCK ASSEMBLY +CHRPAT EQU >82 CHARPAT ASSEMBLY +CINIT EQU >8B CALL INIT ASSEMBLY +*********************************************************** +* Temporary workspaces in EDIT +PAD EQU >8300 +PAD1 EQU >8301 TEMPORARY +PAD2 EQU >8302 Ussually a counter +CHKSUM EQU >8302 Check sum word +STPT EQU >8302 TWO BYTES +MNUM EQU >8302 Ussually a counter +PC EQU >8304 Address in ERAM to load next v +PAD4 EQU >8304 +PABPTR EQU >8304 Pointer to current PAB +PAD6 EQU >8306 Use in MVDN only +CCPPTR EQU >8306 OFFSET WITHIN RECORED (1) +* or Pointer to current column +OFFADD EQU >8306 OFFADD of relocatable programs +* loaded into ERAM. +RECLEN EQU >8307 LENGTH OF CURRENT RECORD (1) +SETCRU EQU >8308 SBO or SBZ bytes SAMS COMMAND +CCPADR EQU >8308 RAM address of current refs +* or Actual buffer address or c +FRESTA EQU >8308 Start of free memory in ERAM +* the end of the reloacatable progr +* (start of next program) is stored +* in FRESTA once a "0" tag is found +FREEND EQU >830A End of free memory in ERAM - +* points to 1st character of last +* entry into routine name table. +* (must follow FRESTA!!!) +RAMPTR EQU >830A Pointer for crunching +BYTES EQU >830C BYTE COUNTER +* or String length for GETSTR +BUFPNT EQU >830E I/O buffer pointer +CURINC EQU >830E Increment for auto-num mode +VAR5 EQU >8310 VAR5 through VAR5+3 used in RA +TAG EQU >8310 TAG FIELD +OLDS EQU >8310 FLAG BITS +TBLPTR EQU >8310 Table pointer (CHARPAT) +FIELD EQU >8311 Value after TAG field, 4 bytes +* (must follow TAG!!!) +VAR6 EQU >8311 +COUNT EQU >8312 FLAG BITS +STRPTR EQU >8312 String pointer (CHARPAT) +CURLIN EQU >8314 Current line for auto-num +* or Starting line number for L +VAR9 EQU >8314 Used in CHARLY +STORE EQU >8314 FLAG BITS +INDEXC EQU >8315 Byte index for computing check +VARB EQU >8316 Source address for XML MVUP +TEMP EQU >8316 FLAG BITS +DEVNUM EQU >8317 DEVice NUMber for Hard drive +DSRFLG EQU >8317 INTERNAL =60, EXTERNAL =0 (1) +*********************************************************** +* Permanent workspace variables +STREND EQU >831A String space ending +SREF EQU >831C Temporary string pointer +VARW EQU >8320 Screen address (CURSOR) +ERRCOD EQU >8322 Return error code from ALC +STVSPT EQU >8324 Value-stack base +VARA EQU >832A Ending display location +PGMPTR EQU >832C Program text pointer (TOKEN) +EXTRAM EQU >832E Line number table pointer +STLN EQU >8330 Start of line number table +ENLN EQU >8332 End of line number table +FREPTR EQU >8340 Free space pointer +CHAT EQU >8342 Current charater/token +PRGFLG EQU >8344 Program/imperative flag +FLAG EQU >8345 General 8-bit flag +* BUFLEV EQU >8346 Crunch-buffer destruction level +FAC EQU >834A Floating-point ACcurmulator +FAC1 EQU >834B +FAC2 EQU >834C +FAC3 EQU >834D +FAC4 EQU >834E +FAC5 EQU >834F +FAC6 EQU >8350 +FAC7 EQU >8351 +FAC8 EQU >8352 +FAC9 EQU >8353 +FAC10 EQU >8354 +TEMP1 EQU >8354 TEMPorary CPU location 1 +FAC11 EQU >8355 +FAC12 EQU >8356 +TEMP2 EQU >8356 TEMPorary CPU location 2 +FAC13 EQU >8357 +FAC14 EQU >8358 +EEE1 EQU >8358 +FAC15 EQU >8359 +FAC16 EQU >835A +FAC17 EQU >835B +* ARG EQU >835C Floating-point ARGument +ARG1 EQU >835D +ARG2 EQU >835E +INDEX EQU >835E Label or program ID - 8 bytes +ARG3 EQU >835F +ARG4 EQU >8360 +ARG5 EQU >8361 +ARG6 EQU >8362 +* FPERAD EQU >836C Value stack pointer +* VSPTR EQU >836E Value stack pointer +HIVDP EQU >8370 +*********************************************************** +* GPL Status Block +* STACK EQU >8372 STACK FOR DATA +* SUBSTK EQU >8373 SUBROUTINE STACK +RKEY EQU >8375 KEY CODE +TIMER EQU >8379 TIMING REGISTER +ERCODE EQU >837C STATUS REGISTER +CB EQU >837D Character Buffer +*********************************************************** +RAMTOP EQU >8384 Highest address in ERAM +* = 0 if ERAM not present +* (Starts at >8A) +RAMFRE EQU >8386 Free pointer in the ERAM +GKFLAG EQU >83C2 * GKXB flag PEEK/LOAD VDP/GROM/QUIT KEY +*********************************************************** +* VDP addresses +NLNADD EQU >02E2 New LiNe ADDress +LODFLG EQU >0371 Auto-boot needed flag +* Temporary +* in FLMGRS (4 bytes used) +SYMBOL EQU >0376 Saved symbol table pointer +BUFSRT EQU >038C Edit recall start addr (VARW) +BUFEND EQU >038E Edit recall end addr (VARA) +MRGPAB EQU >039E MERGEd temporary for pab ptr +PMEM EQU >03A0 UPPER 24K MEMORY +*---------------------------------------------------------- +* Flag 0: 99/4 console, 5/29/81 +* 1: 99/4A console +CONFLG EQU >03BB +*---------------------------------------------------------- +VROAZ EQU >03C0 Temporary roll-out area +CRNBUF EQU >0820 CRuNch BUFfer address +RECBUF EQU >08C0 Edit RECall BUFfer +VRAMVS EQU >0958 Default base of value stack +*********************************************************** +* IMMEDITATE VALUES +DWNARR EQU >0A +UPARR EQU >0B +CHRTN EQU >0D +OFFSET EQU >60 OFFSET FOR VIDEO TABLES +STRING EQU >65 String ID # for FAC +*********************************************************** +* Editting command equates & keys or tokens +OLDZ EQU >05 SAMS TOKEN OLD +SAVEZ EQU >07 SAMS TOKEN SAVE +SPACE EQU >20 Space key +SAMS2Z EQU >32 SAMS TOKEN 2 +SAMS3Z EQU >33 SAMS TOKEN 3 +SAMSAZ EQU >41 SAMS TOKEN A +SAMSBZ EQU >42 SAMS TOKEN B +SAMSCZ EQU >43 SAMS TOKEN C +SAMSDZ EQU >44 SAMS TOKEN D +SAMSEZ EQU >45 SAMS TOKEN E +SAMSFZ EQU >46 SAMS TOKEN F +*********************************************************** +* PAB offset +FLG EQU 1 FLAG BYTE ENTRY +BUF EQU 2 BUFFER ENTRY +LEN EQU 4 RECORD LENGTH ENTRY +CHRCNT EQU 5 CHARACTER COUNT +SCR EQU 8 SCREEN OFFSET ENTRY +NLEN EQU 9 NAME LENGTH +PABLEN EQU 10 ACTUAL PAB LENGTH +*********************************************************** +* BASIC TOKEN TABLE +* EQU >80 spare token +ELSEZ EQU >81 ELSE +SSEPZ EQU >82 :: +TREMZ EQU >83 $ +IFZ EQU >84 IF +GOZ EQU >85 GO +GOTOZ EQU >86 GOTO +GOSUBZ EQU >87 GOSUB +RETURZ EQU >88 RETURN +DEFZ EQU >89 DEF +DIMZ EQU >8A DIM +ENDZ EQU >8B END +FORZ EQU >8C FOR +LETZ EQU >8D LET * RXB REMOVED +BREAKZ EQU >8E BREAK +UNBREZ EQU >8F UNBREAK +TRACEZ EQU >90 TRACE +UNTRAZ EQU >91 UNTRACE +INPUTZ EQU >92 INPUT +DATAZ EQU >93 DATA +RESTOZ EQU >94 RESTORE +RANDOZ EQU >95 RANDOMIZE +NEXTZ EQU >96 NEXT +READZ EQU >97 READ +STOPZ EQU >98 STOP +DELETZ EQU >99 DELETE +REMZ EQU >9A REM +ONZ EQU >9B ON +PRINTZ EQU >9C PRINT +CALLZ EQU >9D CALL +OPTIOZ EQU >9E OPTION +OPENZ EQU >9F OPEN +CLOSEZ EQU >A0 CLOSE +SUBZ EQU >A1 SUB +DISPLZ EQU >A2 DISPLAY +IMAGEZ EQU >A3 IMAGE +ACCEPZ EQU >A4 ACCEPT +ERRORZ EQU >A5 ERROR +WARNZ EQU >A6 WARNING +SUBXTZ EQU >A7 SUBEXIT +SUBNDZ EQU >A8 SUBEND +RUNZ EQU >A9 RUN +LINPUZ EQU >AA LINPUT +* EQU >AB spare token (LIBRARY) +* EQU >AC spare token (REAL) +* EQU >AD spare token (INTEGER) +* EQU >AE spare token (SCRATCH) +* EQU >AF spare token +THENZ EQU >B0 THEN +TOZ EQU >B1 TO +STEPZ EQU >B2 STEP +COMMAZ EQU >B3 , +SEMICZ EQU >B4 ; +COLONZ EQU >B5 : +RPARZ EQU >B6 ) +LPARZ EQU >B7 ( +CONCZ EQU >B8 & (CONCATENATE) +* EQU >B9 spare token +ORZ EQU >BA OR +ANDZ EQU >BB AND +XORZ EQU >BC XOR +NOTZ EQU >BD NOT +EQUALZ EQU >BE = +LESSZ EQU >BF < +GREATZ EQU >C0 > +PLUSZ EQU >C1 + +MINUSZ EQU >C2 - +MULTZ EQU >C3 * +DIVIZ EQU >C4 / +CIRCUZ EQU >C5 ^ +* EQU >C6 spare token +STRINZ EQU >C7 QUOTED STRING +UNQSTZ EQU >C8 UNQUOTED STRING +NUMZ EQU >C8 ALSO NUMERICAL STRING +NUMCOZ EQU >C8 ALSO UNQUOTED STRING +LNZ EQU >C9 LINE NUMBER CONSTANT +EOFZ EQU >CA EOF +ABSZ EQU >CB ABS +ATNZ EQU >CC ATN +COSZ EQU >CD COS +EXPZZ EQU >CE EXP +INTZ EQU >CF INT +LOGZ EQU >D0 LOG +SGNZZ EQU >D1 SGN +SINZ EQU >D2 SIN +SQRZ EQU >D3 SQR +TANZ EQU >D4 TAN +LENZ EQU >D5 LEN +CHRZZ EQU >D6 CHR$ +RNDZ EQU >D7 RND +SEGZZ EQU >D8 SEG$ +POSZ EQU >D9 POS +VALZ EQU >DA VAL +STRZZ EQU >DB STR$ +ASCZ EQU >DC ASC +PIZ EQU >DD PI +RECZ EQU >DE REC +MAXZ EQU >DF MAX +MINZ EQU >E0 MIN +RPTZZ EQU >E1 RPT$ +* EQU >E2 unused +* EQU >E3 unused +* EQU >E4 unused +* EQU >E5 unused +* EQU >E6 unused +* EQU >E7 unused +NUMERZ EQU >E8 NUMERIC +DIGITZ EQU >E9 DIGIT +UALPHZ EQU >EA UALPHA +SIZEZ EQU >EB SIZE +ALLZ EQU >EC ALL +USINGZ EQU >ED USING +BEEPZ EQU >EE BEEP +ERASEZ EQU >EF ERASE +ATZ EQU >F0 AT +BASEZ EQU >F1 BASE +* EQU >F2 spare token (TEMPORARY) +VARIAZ EQU >F3 VARIABLE +RELATZ EQU >F4 RELATIVE +INTERZ EQU >F5 INTERNAL +SEQUEZ EQU >F6 SEQUENTIAL +OUTPUZ EQU >F7 OUTPUT +UPDATZ EQU >F8 UPDATE +APPENZ EQU >F9 APPEND +FIXEDZ EQU >FA FIXED +PERMAZ EQU >FB PERMANENT +TABZ EQU >FC TAB +NUMBEZ EQU >FD # +VALIDZ EQU >FE VALIDATE +* EQU >FF ILLEGAL VALUE +*********************************************************** + GROM >C000 + AORG 0 +*********************************************************** + DATA >AA18 * VALID GROM / VERSION 2024 + DATA >0000 * (FUTURE EXPANSION) + DATA >0000 * POWERUP + DATA >0000 * PROGRAMS + DATA >0000 * DSR + DATA >0000 * CALL + DATA >0000 * INTERUPT + DATA >0000 * BASIC CALL +*********************************************************** +* ASSEMBLY LANGUAGE SUPPORT FOR 99/4 +* +* LOAD, INIT, PEEK, LINK, CHARPAT JDH 08/21/80 +*********************************************************** +* FORMAT FOR LOAD: +* CALL LOAD open load-directive (comma load-directive) +* close +* load-directive = file-name / address (comma data) +* (null / file-name) +* file-name = string-expression +* address = numeric-expression +* data = numeric-expression +* +* FILE TYPE = FIXED 80, DISPLAY , SEQUENTIAL FILE +* +* FUNCTION: +* LOADS ASSEMBLY LANGUAGE CODE INTO EXPANSION RAM +* ADDRESSES: >2000 - >>3FFF RELOCATING +* RELOCATABLE CODE INTO AVAILABLE MEMORY, ABSOLUTE CODE +* IS LOADED +* INTO ITS ABSOLUTE ADDRESS, ENTRY POINTS ARE DEFINED BY +* 'DEF' STATEMENTS, AND ARE LOADED INTO HIGH END OF ERAM +* +* RELOACATABLE OR ABSOLUTE CODE MAY BE STORED ON A FILE +* 9900 OBJECT CODE FORMAT. +* VALID TAGS = 0, 5, 6, 7, 9, A, B, C, F,: +* TAGS 1, 2, I, M, ARE IGNORED +* THE SYMT OPTION IS NOT SUPPORTED. +* ABSOLUTE CODE MAY BE LOADED DIRECTLY FROM PROGRAM +* BY SPECIFYING AN ADDRESS INSTEAD OF A FILE NAME, +* FOLLOWED BY THE DATA TO BE LOADED (WHICH IS PUT IN THE +* RANGE 0 to 255 +* THE RANGE OF THE ADDRESS OR DATA IS LIMITED TO +* 32767 to -32768 +* MULTIPLE DIRECT LOADS CAN BE IN THE SAME LOAD COMMAND +* PROVIDED THEY ARE SEPARATED BY EITHER A FILENAME OR A +* NULL STRING. +* +* RXB CHANGED MVUP TO GPL MOVE AS MOVING 2 BYTES USING 14 +* BYTES OF GPL TO MOVE RAM TO SCRATCH PAD WAS SLOWER. +* +* MVUP WAS USED TO TRANSFER DATA FROM CPU RAM TO ERAM +* SINCE IT WAS NOT KNOWN AT FIRST THAT THE MOVE +* INSTRUCTION COULD TRANSFER FROM CPU RAM TO ERAM +* (PROVIDED THAT >8300 IS SUBTRACTED FROM THE ADDRESSES) +*********************************************************** +* RXB PATCH CHANGED CALL INIT TO ROM 3 +* REPLACING ORIGINAL TO ASSEMBY IN 1 CHUNK +*********************************************************** +* RXB BRANCH TABLE FOR LONG GROMS +* >C010 was CALL LINK +*********************************************************** +* CALL LINK("subprogram-name",arguement-list,...) * +*********************************************************** + DATA SLOADF + STRI 'LINK' + DATA LINKIT +*********************************************************** +* CALL LOAD("pathname.file") * +* CALL LOAD("access-name",byte1,byte2,byte3,...) * +*********************************************************** +SLOADF DATA SINITR + STRI 'LOAD' + DATA LOAD +*********************************************************** +* CALL INIT * +*********************************************************** +SINITR DATA SPEEK + STRI 'INIT' + DATA INIT +*********************************************************** +* CALL PEEK(address,numeric-varible-list,...) * +*********************************************************** +SPEEK DATA CHARPT + STRI 'PEEK' + DATA GKPEEK +*********************************************************** +* CALL CHARPAT(character#,string-variable,...) * +*********************************************************** +CHARPT DATA POKEV + STRI 'CHARPAT' + DATA GETCHR +* LOAD - LDP1 - LDP4 - LDP5 +** CHKSUM is also used as a flag to test if a file has been +** opened (so that it gets closed) +** it is initialized to >0001 and will be changed to some +** other value if a file is used +*********************************************************** +* CALL LOAD("DSK#.FILENAME"[,...]) * +* CALL LOAD(ADDRESS,LIST[,...]) * +*********************************************************** +LOAD DST >0001,@CHKSUM {INITIALIZE FILE FLAG} +* GKXB Change load routine. Delete check for INIT +* add to clear flag bits. + CALL GKLOAD +LPD0 CEQ LPARZ,@CHAT SYNTAX ERROR if no "(" + BR ERRSY1 + XML PGMCHR Skip over +* MAIN PARESE LOOP * +* Check for file-name or address +LDP1 XML PARSE + BYTE RPARZ * PARSE up to ")" or "," + CEQ STRING,@FAC2 Process file name + BS LDP2 +* Otherwise it is an address +* Convert address to integer, save in @PC + XML CFI Convert FAC to integer + CEQ 3,@FAC10 Check for overflow + BS ERRN01 + DST @FAC,@PC Save in ERAM location pointer +* Check for "," if there then data should folow +* else end of load statement, goto LDP5 +LDP4 CEQ COMMAZ,@CHAT + BR LDP5 +* DATA follows or a STRING if no more data + XML PGMCHR Skip "," + XML PARSE Get data value or string if +* end of data + BYTE RPARZ * Parse up to ")" or "," + CEQ STRING,@FAC2 No more data + BS LDP2 +* FAC contains a numeric + XML CFI FAC to INTEGER + CEQ 3,@FAC10 Check for overflow + BS ERRN01 +* GKXB Code for CPU write moved to LOADDT. Add code to +* check VDP or GRAM bits and write to VDP. + CLOG >08,@GKFLAG Check VDP bit + BS LDGRAM No, check GRAM bit + ST @FAC1,V*PC Yes, write to VDP + DINC @PC Point to next byte + B LDP4 Continue with LOAD routine +* GROM ADDRESS >C088 FOR LDP5 +* Check for ")" IF there return ELSE SYNTAX ERROR +LDP5 CEQ RPARZ,@CHAT Return + BS LDRET + B ERRSY1 SYNTAX ERROR +* LDP2 +* Process file name +LDP2 CZ @FAC7 Check for null string + BS LDNE2 +* GKXB Change 'LOAD FILE' to check for INIT + CALL GKINIT +*************** LOAD DATA INTO ERAM *********************** +* LOAD FRESTA, FREEND from ERAM + DST FSLOC,@VARB Source + DST FRESTA,@PAD Destination + DST 4,@ARG # of bytes to move + XML MVUP Load +* Initialize PC, OFFSET in case of no "0" tag + DST @FRESTA,@PC + DST @FRESTA,@OFFADD Base address for load module +* Read in one record, evaluate the TAG field +* LDRD - LDTG +LDRD DST 0,@CHKSUM Clear check sum + CALL READIT Rear in a record +LDTG MOVE 5,V*BUFPNT,@TAG Get TAG & field + CALL LDIPCS Add 5 to BUFPNT, add ASCII + BYTE 5 * Value of chars. Read to check +* Convert @FIELD to numeric (from ASCII hex value) +* Store result: HIGH BYTE to FIELD, LOW BYTE to FIELD+1 +* Convert HIGH BYTE first: @FIELD & @FIELD+1 +* Store result in field + SUB >30,@FIELD >30 = "0" + CGT 9,@FIELD Subtract ASCII difference +* between "9" and "A" + BR GC0C7 + SUB 7,@FIELD +GC0C7 SLL 4,@FIELD FIELD=FILED*32 + SUB >30,@FIELD+1 + CGT 9,@FIELD+1 + BR GC0D5 + SUB 7,@FIELD+1 +GC0D5 ADD @FIELD+1,@FIELD Add to HIGH BYTE +* Now convert LOW BYTE: @FIELD+2 & @FIELD+3 +* Store result in LOW BYTE of FIELD to FIELD+1 + SUB >30,@FIELD+2 + CGT 9,@FIELD+2 + BR GC0E3 + SUB 7,@FIELD+2 +GC0E3 ST @FIELD+2,@FIELD+1 Store in LOW byte of result + SLL 4,@FIELD+1 FIELD+1 = FIELD+1*32 + SUB >30,@FIELD+3 + CGT 9,@FIELD+3 + BR GC0F4 + SUB 7,@FIELD+3 +GC0F4 ADD @FIELD+3,@FIELD+1 Add to low byte +* Branch to evaluation procedure for TAG + SUB >30,@TAG >30 = "0" + CGE 0,@TAG If TAG < "0" ILLEGAL CHAR + BR ERRUC1 + CGT >0A,@TAG TAGS "0" to ":" + BS GC11C + CASE @TAG + BR TAG0 "0" RELOCATABLE LENGTH + BR LDTG IGNORE "1" TAG + BR LDTG IGNORE "2" TAG + BR ERRUC1 No external REF "3" + BR ERRUC1 No external REF "4" + BR TAG5 "5" relocatable entry DEF + BR TAG6 "6" Absolute entry DEF + BR TAG7 "7" check sum + BR LDTG "8" ignore check sum + BR TAG9 "9" Absolute LOAD address + BR LDDNE ":" end of file +GC11C SUB >11,@TAG Subtract offset so +* that "A" is =0 + CGE 0,@TAG ";" to "@" illegal char + BR ERRUC1 +* Skip over "I" tag - 8 char, program ID that follows + CEQ 8,@TAG + BS LDTG2 +* Skip over "M" TAG -10 char, program ID that follows + CEQ 12,@TAG + BR LDTG3 + CALL LDIPCS + BYTE 10 + B LDTG +LDTG3 CGT 5,@TAG TAGS "G" are legal + BS ERRUC1 + CASE @TAG + BR TAGA "A" RELOCATABLE PROGRAM ADDRE + BR TAGB "B" ABSOLUTE VALUE + BR TAGC "C" RELATIVE ADDRESS + BR ERRUC1 "D" ERROR + BR ERRUC1 "E" ERROR - UNDEFINED + BR LDRD "F" END OF RECORD +* TAG0 to TAGB +* EVALUATE TAG FIELDS +TAG0 DST @FRESTA,@OFFADD NEW BASE ADDRESS + DST @FRESTA,@PC NEW PC + DADD @FIELD,@FRESTA ADD LENGTH TO FIND END OF +* RELOCATABLE PROGRAM WHICH IS +* START OF NEXT PROGRAM +* Make sure we won't run into routine name table now, so we +* don't have to check every time we load a value into ERAM +* routine table must make sure it doesn't run into +* relocatable assembly language code through. + DCHE @FREEND,@FRESTA OUT OF MEMORY + BS ERRMF1 +* SKIP OVER PROGRAM ID - 8 BYTES +LDTG2 CALL LDIPCS + BYTE 8 * INC BUFPNT, COMPUTE CHECKSUM + B LDTG +TAG5 DADD @OFFADD,@FIELD Add starting offset +* TAG6 is an absolute address so do not need to add offset +TAG6 MOVE 6,V*BUFPNT,@INDEX Get symbol name + CALL LDIPCS INC BUPNT, COMPUT CHECKSUM + BYTE 6 * We read 6 chars +* Add symbol and its address - stopped in field - to the +* routine entry table. It is put at the end of the table +* (the end of the table is towards the low end of memory) +* Since the table is searched from the end first, if there +* are any duplicate labels the last one entered will have +* precedence over the early one(s). + DDECT @FREEND Set to address field +* Load address (stored in field in CPU RAM) into routine +* Name table which is in expansion RAM + DST FIELD,@VARB Source + DST @FREEND,@PAD Destination + DST 2,@ARG # bytes to move + XML MVUP CPUR RAM to ERAM +* Load symbol into routine name table + DSUB 6,@FREEND Set to symbol field + DST INDEX,@VARB Source + DST @FREEND,@PAD Destination + DST 6,@ARG Move 6 bytes + XML MVUP CPU RAM to ERAM +* Check to see if we've run into assembly language code + DCHE @FREEND,@FRESTA Out of memory + BS ERRMF1 + B LDTG If not then continue +*********************************************************** +* ROUTINE NAME TABLE ENTRY +* +* 0 1 2 3 4 5 6 7 +* ----------------------------------- +* FREEND | S | Y | M | B | O | L | ADDRESS | +* (AFTER ENTRY) ----------------------------------- +* FREEND | | | | | | | | +* (BEFORE ENTRY) ----------------------------------- +* +* FREEND is initialized to >4000 by INIT, address is at +* a higher memory location then symbol +*********************************************************** +TAG7 DNEG @FIELD Checksum is 1's compelement + DCEQ @FIELD,@CHKSUM Check sum error + BR ERRDE1 + B LDTG +TAGA DADD @OFFADD,@FIELD PC = OFFADD ^ FIELD +* TAG 9 is an absolute address so no need to add offset +TAG9 DST @FIELD,@PC + B LDTG +TAGC DADD @OFFADD,@FIELD +* TAG B is an absolute entry so no need to add offset +* Relocatable code is checked to see if it will run into +* is no need to check now. Absolute code can go anywhere. +* +* Load field into expansion RAM using MVUP routine +TAGB DST @PC,@PAD Destination + DST FIELD,@VARB Source + DST 2,@ARG Move 2 bytes + XML MVUP CPU RAM to ERAM + DINCT @PC We loaded 2 bytes + B LDTG +********* END OF LOAD FOR CURRENT FILE ******************** +* +* FRESTA & FREEND are stored in CPU RAM (>8308) +* While loading a file into expansion RAM. +* So if the values of FRESTA or FREEND are to be changed +* then word locations >8308 and >830A must be changed and +* not expansion RAM. +* +* LDDNE - LDNE2 +* +* DONE WITH LOAD +* Put FRESTA, FREEND back into expansion RAM +* If FRESTA is odd then make it even +* so that the next program starts on an even boundry +LDDNE CLOG 1,@FRESTA+1 Low byte odd? + BS GC1C1 + DINC @FRESTA Force to next even boundry +GC1C1 DST FRESTA,@VARB Source + DST FSLOC,@PAD Destination + DST 4,@ARG Load 4 bytes + XML MVUP CPU RAM to ERAM + CALL CLSIT Close file +* Check for end of load command ")" +LDNE2 CEQ RPARZ,@CHAT Check for ")" + BS LDRET + CEQ COMMAZ,@CHAT Syntax error + BR ERRSY1 + XML PGMCHR Skip comma + B LDP1 Continue in main loop +*************** LDRET - LDRET2 **************************** +* +* Return to calling routine +LDRET XML PGMCHR Skip over +* Entry point for INIT +LDRET2 CALL CHKEND Check for end of statement + BR ERRSY1 If not end then syntax error + CALL RETURN Return to caller +********************** CHKIN ****************************** +* Check for INIT-FLAG = >AA55 +* MOVE ERAM(INITF) to CPU *FAC +PAGE EQU $ +CHKIN DCEQ >AA55,@INITF *** RXB REPLACEMENT ROUTINE **** + BR ERRSYN * SYNTAX ERROR +* No files have been opened so if there is a syntax error +* goto ERRSYN! + RTN * RETURN TO CALLING ROUTINE +*********************** FILE ROUTINES ********************* +*********************************************************** +* INCREMENT BUFFER POINTER by value after call statement +* ADD VALUES READ TO CHECKSUM unless the first character +* is a "7" = >37 , then add only "7" character to checksum +* (other value is the checksum) +* +*************************** LDIPCS ************************ +LDIPCS FETCH @INDEXC Index = # of bytes read + CEQ >37,V*BUFPNT + BR GC213 + DADD >0037,@CHKSUM Add value of "7" to checksum + DADD 5,@BUFPNT 1 for "7", 4 for checksum + B GC224 +GC213 ST V*BUFPNT,@FAC1 Convert to 2 byte value + CLR @FAC ----------------------------- + DADD @FAC,@CHKSUM Add char to checksum + DINC @BUFPNT + DEC @INDEXC Do it index # of times + CZ @INDEXC + BR GC213 +GC224 RTN +********************** OPENIT ***************************** +OPENIT DST @FAC6,@BYTES Store actual spec length + DADD PABLEN+80,@BYTES Add in the PAB length and +* buffer length + XML VPUSH Push possible temp string + XML GETSTR and try to allocate space + XML VPOP Restore original string data +* +* THE FOLLOWING VARIABLES CONTAIN IMPORTANT INFO +* +* FAC4, FAC5 Start address of original device specific +* FAC6, FAC7 Length of original device specifications +* SREF Location of PAB in VDP memory +* BYTES Length of entire PAB including specificat + MOVE @FAC6,V*FAC4,V@PABLEN(@SREF) * Device pathname + CLR V*SREF Clear the entire PAB + MOVE PABLEN-1,V*SREF,V@1(@SREF) * Clear PAB + ST @FAC7,V@NLEN(@SREF) Copy specifications length + ST >60,V@SCR(@SREF) Screen offset + ST 4,V@FLG(@SREF) Dis, fix, seq, input + DADD @SREF,@FAC6 Calculate the address of + DADD PABLEN,@FAC6 the buffer + DST @FAC6,V@BUF(@SREF) Store buffer address in PAB + CALL DSRCAL + RTN +*********************************************************** +READIT DST V@BUF(@SREF),@BUFPNT INIT buffer pointer + ST 2,V*SREF + ST V@LEN(@SREF),V@CHRCNT(@SREF) + CALL DSRCAL + RTN +************************* CLSIT *************************** +CLSIT ST 1,V*SREF Prepare to close +******************** DSRCAL - DSKERR ********************** +DSRCAL DST @SREF,@FAC12 Compute start address of spec + DADD NLEN,@FAC12 Ready to call DSR routine + CALL LINK Call DSR thourgh program link + BYTE 8 * Type = DSR (8) + BS DSKERR Couldn't find the DSR + CLOG >E0,V@FLG(@SREF) Set condition bit if no error + BR DSKERR + RTN +DSKERR DST @FREPTR,@PABPTR Set up dummy PAB + DSUB 6,@PABPTR Make it standard size + DST V*SREF,V@4(@PABPTR) Store error code + CALL CLSNOE Close File + CALL ERRZZ Issue I/O error + BYTE 36 +********************** CLSNOE ***************************** +* Try to close the current file +* Ignore any errors from the closing of the file. +* Since the PAB is not in the normal PAB list +* then we have to close the file in the load routine. +* ERRZZ will close the rest of the files. +* +** CLOSE IT ONLY IF IT HAS BEEN OPENED +CLSNOE DCEQ 1,@CHKSUM Check file flag + BS GC2B9 + ST 1,V*SREF Store close file code + DST @SREF,@FAC12 Compute start address of spec + DADD NLEN,@FAC12 Ready to CALL DSR + CALL LINK CALL DSR through program link + BYTE 8 * "8" is type of DSR +GC2B9 RTN +*********************************************************** +* INIT JDH 9/02/80 +*********************************************************** +* CALL INIT * +*********************************************************** +* Check if expansion RAM present +* Load support into expansion RAM from GROM +INIT CZ @RAMTOP If no ERAM, SYNTAX ERROR + BS ERRSYN +** Load Assembly header, support routines ** +* GKXB Correct INIT routine. + CLR @>6004 * Set ROM PAGE 3 at >6004 + XML CINIT * Move from ROM 3 to RAM + B ECRTN * RXB custom return routine +*********************************************************** +* PEEK INSTRUCTION JDH 9/04/80 +*********************************************************** +* +* FORMAT: +* CALL PEEK(address comma numeric-variable) * close +* FUNCTION: +* RETURNS THE VALUE AT address IN ERAM INTO numeric-variable +* IF MORE THAN ONE numeric-variable IS SPECIFIED THEN +* address IS INCREMENTED AND THE VALUE IN ERAM AT THE NEW +* address IS ASSIGNED TO THE NEXT VARIABLE AND SO ON. +* +PEEK CEQ LPARZ,@CHAT Chat = "(" + BR ERRSYN + XML PGMCHR Skip "(" + XML PARSE Get value of address + BYTE RPARZ + CEQ STRING,@FAC2 Address MUST BE NUMERIC + BS ERRSNM + XML CFI Convert FAC to integer + CEQ 3,@FAC10 Overflow? + BS ERRNO + DST @FAC,@PC Save peek address + CEQ COMMAZ,@CHAT CHAT = "," ? + BR ERRSYN +PEEK2 XML PGMCHR Skip "," +* The following check has been put in SYM, 5/26/81 +* If @CHAT >= >80 then ERRSYN (Don't allow token) + XML SYM Get symbol name + XML SMB Get value pointer + XML VPUSH Save FAC on stack for ASSGNV + CZ @FAC2 Must be numeric + BR ERRSNM + CLR @FAC + MOVE 7,@FAC,@FAC1 Clear FAC +** GET PEEK VALUE FROM ERAM INTO @FAC1 +* GKXB Change PEEK routine to read VDP/GRAM. Move CPU read +* code to PEEKDT and add code for bite check and VDP +* read. + CLOG >08,@GKFLAG Check VDP bit + BS PKGRAM No, check GROM bit + ST V*PC,@FAC1 Yes, read VDP + B GC308 +GC308 XML CIF Convert FAC to F.P. value + XML ASSGNV Assign to numeric-variable + CEQ COMMAZ,@CHAT + BR PEEK5 + DINC @PC INC pointer to next ERAM addr + B PEEK2 +* CHECK FOR ")" AND END OF STATEMENT +* IF ALL OK, THEN RETURN TO CALLER +* GETCHR ALSO RETURNS TO HERE +PEEK5 CEQ RPARZ,@CHAT + BR ERRSYN + XML PGMCHR Skip ")" +PEEK6 CALL CHKEND + BR ERRSYN + CALL RETURN RETURN TO CALLER +*********************************************************** +* LINK INSTRUCTION : SE Sep 1980 +*********************************************************** +* FORMAT: +* CALL LINK("file-name",parameter1,parameter2,...) +* +* LINK ROUTINE READS THE FILE NAME SPECIFIED BY THE USER A +* SAVE THE ADDRESS OF THE NAME FOR LATER USE. THE FILE WIL +* BE SEARCHED IN UTILITY CODE LATER ON. +* +* PARAMETERS ARE PASSED EITHER BY REFERENCE OR BY VALUE. +* NUMERIC OR STRING VARIABLES AND NUMERIC OR STRING ARRAYS +* ARE PASSED BY REFERENCE AND ALL OTHERS INCLUDING A USER +* DEFINED FUNCTION ARE PASSED BY VALUE. +* +* PARAMETER INFORMATION IS STORED IN CPU >8300 THROUGH >83 +* THAT GIVES A PARAMETER TYPE CODE OF EACH PARAMETER. +* CODE 0 ... Numeric expression +* CODE 1 ... String experession +* CODE 2 ... Numeric variable +* CODE 3 ... String variable +* CODE 4 ... Numeric array +* CODE 5 ... String array +* +* IF A PARAMETER IS PASSED AS A NUMERIC EXPRESSION ITSL +* ACTUAL VALUE GETS PUSHED INTO THE VALUE STACK. IN CASE O +* A STRING EXPRESSION , ITS VALUE STACK CONTAINS AN ID(>65 +* POINTER TO THE VALUE SPACE AND ITS LENGTH. IF A PARAMETE +* GETS PASSED AS A REFERENCE THE PRODUCT OF XML SYM AND XM +* SMB IN THE @FAC AREA GETS PUSHED INTO STACK. +* +* AFTER AN ASSEMBLY LANGUAGE SUBPROGRAM IS EXECUTED LINK +* ROUTINE WILL POP THE STACK TO GET RID OF PARAMETER +* INFORMATION. CONTROL WILL BE TRANSFERED TO THE XB MAIN +* PROGRAM AFTERWARDS. +* +*********************************************************** +* CALL LINK("PGNAME",numeric variable,...) * +*********************************************************** +LINKIT CALL CHKIN Check if INIT has been called + DST @VSPTR,@OLDS Save VSPTR for later use + CEQ LPARZ,@CHAT Check for "(" + BR ERRSYN + XML PGMCHR Advance program pointer + XML PARSE Get the routine name. + BYTE RPARZ * Read up to ")" + CEQ >65,@FAC2 Should be a string + BR ERRBA + DCZ @FAC6 Don't accept null string + BS ERRBA + CH 6,@FAC7 Should be less then 6 char + BS ERRBA + XML VPUSH Push to make it semi-permanen + CLR @COUNT Initialize parameter counter +*********************************************************** +* PARAMETERS get evaluated here +*********************************************************** +PAR01 CEQ RPARZ,@CHAT No arg. So execute it + BS EXE01 + CEQ COMMAZ,@CHAT Should have a comma + BR ERRSYN + DST @PGMPTR,@ERRCOD Save text pointer + XML PGMCHR Get the character + CHE >80,@CHAT Must be an expression + BS VAL01 +* If CHAT = LPARZ then pass by expression + CALL CLRFAC Clear FAC entry for SYM + XML SYM Read in the symbol table info +* After XML SYM @FAC area contains a pointer to symbo table +* Below statement checks if it is a UDF. + CLOG >40,V*FAC Pass by value + BR VAL01 + CEQ COMMAZ,@CHAT Pass by reference + BS REF01 + CEQ RPARZ,@CHAT Pass by reference + BS REF01 + CEQ LPARZ,@CHAT An array + BS ARRAY + CHE >80,@CHAT Pass by value + BS VAL01 + BR ERRSYN +*********************************************************** +* ARRAY case gets checked here +*********************************************************** +* Should look like A(,,) etc. +* Stack entry for an array will look like +* +--------------+-------+---+-------------+--------------- +* | Pointer to | >00 | | Pointer to | +* | symbol table | or | | dim info in | +* | entry | >65 | | real v.s. | +* +- FAC --------+ FAC2 -+---+- FAC4 ------+- FAC6 -------- +* +ARRAY XML PGMCHR Get the next character + CEQ RPARZ,@CHAT Pass by reference + BS ARRAY2 + CEQ COMMAZ,@CHAT More array information + BS ARRAY + DDEC @PGMPTR Adjust the pointer + ST LPARZ,@CHAT + BR REF01 Pass by reference +* In array cases the symbol table address gets stored at FA +* area, and the pointer to the value space (dimension info) +* goes into FAC4 +ARRAY2 XML PGMCHR Advance the program pointer + CLOG >80,V*FAC Test string bit + BR GC39D + ST 4,*COUNT Numeric array + BR GC3A1 +GC39D ST 5,*COUNT String array case +* Check if array is being shared. If it is then go back +* through the linkage to get the actuals symbol table +* pointer. Put the pointer to the value space (dimension in +* into FAC4. +GC3A1 CLOG >20,V*FAC Shared array? + BS GC3BE + MOVE 2,V@6(@FAC),@FAC4 If so, get pointer + CLOG >20,V@-6(@FAC4) Shared also? + BS GC3BC + MOVE 2,V*FAC4,@FAC4 Array is not shared +GC3BC BR GC3C5 +GC3BE DST @FAC,@FAC4 Array is not shared + DADD 6,@FAC4 Point to value space +GC3C5 BR PUSH +*********************************************************** +* VALUE +* Passing the parameter by value +*********************************************************** +VAL01 DST @ERRCOD,@PGMPTR Restore program pointer + XML PGMCHR Skip the first character + DST @BYTES,@TEMP In case of passing a string + XML PARSE Parsing up to comma + BYTE RPARZ + DST @TEMP,@BYTES Restore the value in >0C area +* After parsing @FAC area contains its actual numeric value +* in a numeric case, and the following information in a +* string case. +* +----------------+-----+--+------------+----------------- +* | >001C or | >65 | | Pointer to | Length of string +* | value pointer | | | string | string +* | address | | | | +* +- FAC ----------+-FAC2+--+-FAC4 ------+- FAC6 ---------- +* + CGT >63,@FAC2 If more then 99 then + BR GC3E0 + ST 1,*COUNT Store flag for string express + BR GC3E3 +GC3E0 CLR *COUNT Otherwise it is a numeric exp +GC3E3 BR PUSH Push into stack +*********************************************************** +* REFERENCE +* Passing the parameter by reference +*********************************************************** +* Variables, array element and whole array passing. +* +* After SMB @FAC entry shold look like; +* +--------------+------+-----+-------------+-------------- +* | Pointer to | >00 | | Pointer to | +* | symbol table | | | value space | +* | entry | | | | +* +-- FAC -------+ FAC2 +-----+- FAC4 ------+- FAC6 ------- +* for numeric case, and +* +--------------+------+-----+-------------+-------------- +* | Pointer to | >65 | | Pointer to | String +* | value space | | | string | length +* | entry | | | | +* +- FAC --------+ FAC2 +-----+- FAC4 ------+- FAC6 ------- +* for a string case. +REF01 XML SMB Get the location + CHE >B8,@CHAT Pass array expression + BS VAL01 + CZ @FAC2 + BR GC3F6 + ST 2,*COUNT Must be a numeric variable + BR PUSH +GC3F6 ST 3,*COUNT Must be a string variable +*********************************************************** +* PUSH routine +* Pushes @FAC entry into a value stack. +*********************************************************** +PUSH INC @COUNT + CGT 16,@COUNT Too many parameters + BS ERRBA + XML VPUSH + BR PAR01 Get the next argument. +*********************************************************** +* EXECUTE routine +* Restore file name info transfer control over to ALC +*********************************************************** +EXE01 ST >20,@FAC Store blank in the FAC area. + MOVE 5,@FAC,@FAC1 + MOVE 4,V@12(@OLDS),@STORE Get the file name info + MOVE @STORE+2,V*STORE,@FAC Move to FAC + DCLR @ERRCOD Clear program pointer for +* error code + XML ALSUP Go to CPU at >2000 to execute + BS ERROR Error found +* If no error, start checking s +*********************************************************** +* RETURN to the XB main program. +*********************************************************** +NOERR DCH @OLDS,@VSPTR Pop the stack + BR GC429 + XML VPOP Pop the stack + B NOERR +GC429 B LNKRTN Check ")" and end of statemen +*********************************************************** +* CALL CHARPAT(numeric-expression,string-variable,...) * +*********************************************************** +GETCHR CALL COMB Check for (? +GCHR2 XML PGMCHR Skip "(" or "," + XML PARSE Get char number + BYTE RPARZ + XML SPEED * CHECK FROM + DATA >021E * 30 TO 159 + DATA >009F * + DST @FAC,@VAR9 Move to PAD2 30 - 159 + DST 16,@BYTES 16 byte string in string space + XML GETSTR Get VDP string space +* SREF string pointer space + XML PGMCHR Skip comma + CALL SNDER * Get symbol table info for next arguement + CEQ STRING,@FAC2 Must be a stirng variable + BR ERRSNM ERROR STRING NUMBER MISMATCH + DST >001C,@FAC Temp string so use SREF as ad + DST @SREF,@FAC4 Pointer to string + DST 16,@FAC6 String length + XML ASSGNV Assign to string variable +* VAR9 = 30 TO 159 CHARACTER +* FAC4 = String pointer + CLR @>6004 Set ROM 3 page + XML CHRPAT + CEQ COMMAZ,@CHAT Comma? + BS GCHR2 Restart again + B PEEK5 +*********************************************************** +************** ERROR BRANCH TABLE FOR LINK **************** +*********************************************************** +ERROR CASE @ERRCOD + BR NOERR + BR NOERR + BR ERRNO 2 Numeric Overflow + BR ERRSYN 3 SYNtax error + BR ERRIBS 4 Illegal after subprogram + BR ERRNQS 5 unmatched quotes + BR ERRNTL 6 Name Too Long + BR ERRSNM 7 String Number Mismatch + BR ERROBE 8 Option Base Error + BR ERRMUV 9 iMproperly Used name + BR ERRIM 10 IMage error + BR ERRMEM 11 MEMory full + BR ERRSO 12 Stack Overflow + BR ERRNWF 13 Next Without For + BR ERRFNN 14 For Next Nesting + BR ERRSNS 15 must be in subprogram + BR ERRRSC 16 Recursive Subprogram Call + BR ERRMS 17 Missing Subend + BR ERRRWG 18 Return Without Gosub + BR ERRST 19 String Truncated + BR ERRBS 20 Bad Subscript + BR ERRSSL 21 Speech String too Long + BR ERRLNF 22 Line Not Found + BR ERRBLN 23 Bad Line Number + BR ERRLTL 24 Line Too Long + BR ERRCC 25 Can't Continue + BR ERRCIP 26 Command Illegal in Program + BR ERROLP 27 Only Legal in a Program + BR ERRBA 28 Bad Argument + BR ERRNPP 29 No Program Present + BR ERRBV 30 Bad Value + BR ERRIAL 31 Incorrect Argument List + BR ERRINP 32 INPut error + BR ERRDAT 33 DATa error + BR ERRFE 34 File Error + BR NOERR + BR ERRIO 36 I/O error + BR ERRSNF 37 Subprogram Not Found + BR NOERR + BR ERRPV 39 Protected Violation + BR ERRIVN 40 unrecognized Character + BR WRNNO 41 Numeric Number Overflow + BR WRNST 42 String Truncated + BR WRNNPP 43 No Program Present + BR WRNINP 44 INPut error + BR WRNIO 45 I/O error + BR WRNLNF 46 Line Not Found +*********************************************************** +**************** ERROR HANDLING SECTION ******************* +*********************************************************** +ERRN01 CALL CLSNOE * ENTRY FOR LOAD +ERRNO CALL ERRZZ * Numeric Overflow + BYTE 2 +ERRSY1 CALL CLSNOE * ENTRY FOR LOAD +ERRSYN CALL ERRZZ * SYNtax error + BYTE 3 +ERRIBS CALL ERRZZ * Illegal after subprogram + BYTE 4 +ERRNQS CALL ERRZZ * uNmatched QuoteS + BYTE 5 +ERRNTL CALL ERRZZ * Name Too Long + BYTE 6 +ERRSNM CALL ERRZZ * String Number Mismatch + BYTE 7 +ERROBE CALL ERRZZ * Option Base Error + BYTE 8 +ERRMUV CALL ERRZZ * Improperly used name + BYTE 9 +ERRIM CALL ERRZZ * Image Error + BYTE 10 +ERRMF1 CALL CLSNOE * ENTRY FOR LOAD +ERRMEM CALL ERRZZ * MEMory full + BYTE 11 +ERRSO CALL ERRZZ * Stack Overflow + BYTE 12 +ERRNWF CALL ERRZZ * Next Without For + BYTE 13 +ERRFNN CALL ERRZZ * For-Next Nesting + BYTE 14 +ERRSNS CALL ERRZZ * must be in subprogram + BYTE 15 +ERRRSC CALL ERRZZ * Recursive Subprogram Call + BYTE 16 +ERRMS CALL ERRZZ * Missing Subend + BYTE 17 +ERRRWG CALL ERRZZ * Return Without Gosub + BYTE 18 +ERRST CALL ERRZZ * String Truncated + BYTE 19 +ERRBS CALL ERRZZ * Bad Subscript + BYTE 20 +ERRSSL CALL ERRZZ * Speech String too Long + BYTE 21 +ERRLNF CALL ERRZZ * Line Not Found + BYTE 22 +ERRBLN CALL ERRZZ * Bad Line Number + BYTE 23 +ERRLTL CALL ERRZZ * Line Too Long + BYTE 24 +ERRCC CALL ERRZZ * Can't Continue + BYTE 25 +ERRCIP CALL ERRZZ * Command Illegal in Program + BYTE 26 +ERROLP CALL ERRZZ * Only Legal in a Program + BYTE 27 +ERRBA CALL ERRZZ * Bad Argument + BYTE 28 +ERRNPP CALL ERRZZ * No Program Present + BYTE 29 +ERRBV CALL ERRZZ * Bad Value + BYTE 30 +ERRIAL CALL ERRZZ * Incorrect Argument List + BYTE 31 +ERRINP CALL ERRZZ * INPut error + BYTE 41 +ERRDE1 CALL CLSNOE * ENTRY FOR LOAD +ERRDAT CALL ERRZZ * DATa error / Checksum error + BYTE 33 +ERRFE CALL ERRZZ * File Error + BYTE 34 +ERRIO CALL ERRZZ * I/O error + BYTE 36 +ERRSNF CALL ERRZZ * Subprogram Not Found + BYTE 37 +ERRPV CALL ERRZZ * Protection Violation + BYTE 39 +ERRUC1 CALL CLSNOE * ENTRY FOR LOAD +ERRIVN CALL ERRZZ * Unrecognized character / il + BYTE 40 +WRNNO CALL WARNZZ * Numeric Overflow + BYTE 2 + BR NOERR +WRNST CALL WARNZZ * String Truncated + BYTE 19 + BR NOERR +WRNNPP CALL WARNZZ * No Program Present + BYTE 29 + BR NOERR +WRNINP CALL WARNZZ * INPut Error + BYTE 32 + BR NOERR +WRNIO CALL WARNZZ * I/O error + BYTE 35 + BR NOERR +WRNLNF CALL WARNZZ * Line Not Found + BYTE 38 + BR NOERR +*********************************************************** +* RXB COPY OF CHKEND FROM GROM 4 FOR CALL INIT ERROR +*********************************************************** +* If it's no DISPLAY keyword ( AT, SIZE, BEEP or USING) it +* has to be a print separator or colon ":" +* If anything is specified is has to be a colon or end of +* line... for end-of-line output current record +* Check for end of statement +ENDCHK CLOG >80,@CHAT + BS ECSET + CHE TREMZ+1,@CHAT + BR ECSET2 +ECSET CZ @CHAT Set COND according to CHAT + RTNC +ECSET2 CEQ @>8300,@>8300 Force COND to "SET" + RTNC Exit with no COND change +************************** +ECRTN CALL ENDCHK Use this CHKEND instead + CALL RETURN +*********************************************************** +* Set-up for CALL GKLOAD routine +* +GKLOAD AND >F0,@GKFLAG Reset flag bits + RTN Return + + +*********************************************************** +* CALL POKEV(VDP address,numeric variable,...) * +*********************************************************** +POKEV DATA PEEKV + STRI 'POKEV' + DATA POV +POV CALL GKSETV Set VDP bit + DST 1,@CHKSUM For GKLOAD routine + B LPD0 Goto GKLOAD +*********************************************************** +* Check for CALL GKINIT on 'LOAD FILE' +* +GKINIT XML VPUSH Save FAC + CALL CHKIN Check for GKINIT + XML VPOP Restore FAC + CLOG >C,@GKFLAG Error if POKEG or POKEV + BR ERRSYN + B OPENIT Open the file +* +* New entry point for CALL PEEK, +* clears flag bits. +* +GKPEEK AND >F0,@GKFLAG + B PEEK +*********************************************************** +* CALL PEEKV(VDP address,numeric variable,...) * +*********************************************************** +PEEKV DATA PEEKG + STRI 'PEEKV' + DATA PKV +PKV CALL GKSETV Set VDP bit + B PEEK Use PEEK routine +*********************************************************** +* Set flag bit for VDP read & write +* +GKSETV AND >F0,@GKFLAG Reset both bits + OR 8,@GKFLAG Set VDP bit + RTN Return +* +* Set flag bit for GROM read & write +* +GKSETG AND >F0,@GKFLAG Reset both bits + OR 4,@GKFLAG Set GROM bit + RTN Return +*********************************************************** +* CALL PEEKG(GROM address,numeric variable,...) * +*********************************************************** +PEEKG DATA POKEG + STRI 'PEEKG' + DATA PKG +PKG CALL GKSETG Set flag bit + B PEEK Use PEEK routine +*********************************************************** +* CALL POKEG(GROM address,numeric variable,...) * +*********************************************************** +POKEG DATA CATLOG + STRI 'POKEG' + DATA POG +POG CALL GKSETG Set flag bit + DST 1,@CHKSUM For LOAD routine + B LPD0 Use LOAD routine +*********************************************************** +* Routine to write to GRAM +* +LDGRAM CLOG 4,@GKFLAG Check GROM bit + BS LOADDT No, CPU load + MOVE 1,@FAC1,G@0(@PC) Write to GRAM + DINC @PC Point to next byte + B LDP4 Continue +* +* Relocated data from GKLOAD routine. +* +LOADDT MOVE 1,@FAC1,@0(@PC) Read byte + DINC @PC INC ERAM address + B LDP4 Continue with next byte +* +* Routine to read GRAM/GROM +* +PKGRAM CLOG 4,@GKFLAG Check flag + BS PEEKDT No, CPU peek + MOVE 1,G@0(@PC),@FAC1 Yes, read GRAM + B GC308 Continue +* +* Relocated data for CPU PEEK +* +PEEKDT MOVE 1,@0(@PC),@FAC1 Read byte + B GC308 Continue +*********************************************************** +DARROW DATA >0010,>18FC,>1810,>0000 * RIGHT ARROW + DATA >0020,>60FC,>6020,>0000 * LEFT ARROW +*********************************************************** +* +* CALL CAT(pathname) * +*********************************************************** +CATLOG DATA DIRECT + STRI 'CAT' CALL CAT(path) + DATA GKCAT +*********************************************************** +* CALL DIR(pathname) * +*********************************************************** +DIRECT DATA SAMS + STRI 'DIR' + DATA GKCAT +* +* +* X-BASIC DEVICE CATALOGER +* Accessed with a CALL +* PAB is installed in crunch buffer area +* +* D.C. Warren 12/17/85 +* with modifications by Danny Michael, Jan. 86 +* +* +GKCAT CALL COMB Do we have a '(' ? +GKCATA CALL DSKNAM Get path +* +* Set up PAB at V>8C0 +* Put disk information on the screen +* + ALL >80 Clear screen + DST @FAC6,@VARB Get name length + DST 160,@BYTES Length of CAT PAB use + XML GETSTR Get some string space + MOVE 160,V@RECBUF,V*SREF Save USER PAB area + MOVE 9,G@GKPABD,V@RECBUF Install PAB + ST @FAC7,V@>08C9 Save Length + MOVE @VARB,V*FAC4,V@>08CA Get PATH +* +* Open Device +* + CALL GKDSRL Link to device +* +* Read first record +* + DST >020D,V@RECBUF Make PAB a read +GKCAT2 CALL GKDSRL Link to device +* + ST >B9,@PAD2 Y with offset + CALL GKSCRN Set up header + CLR @PAD1 For GKSCRL routine +GKCATL CALL GKTKEY Check for pause or quit + BS GKDONE Stop! + CALL GKSCRL Scroll the screen + CALL GKDSRL Read a record + CALL GKFNAM Print it on screen + BS GKDONE If finished + BR GKCATL Loop +GKDONE CALL GKCLSF Close file + CEQ COMMAZ,@CHAT Comma? + BS GKCATA Yes, another drive. + CEQ RPARZ,@CHAT Last char a ) ? + BR ERRSYN No, error + XML PGMCHR Parse past ')' + BR PEEK6 +* +* File error +* +GKERR DST RECBUF-4,@PABPTR Fake a BASIC PAB + DST V@RECBUF,@VAR5 Save error + CALL GKCLSF Close file + CALL G6D78 Return through ERR + BYTE 36 * I/O ERROR XX +* +* +* Subroutines +* +* +* Close file +* +GKCLSF DST >010D,V@RECBUF A close operation + CALL GKDSR Link to device + MOVE 151,V*SREF,V@RECBUF Restore USER PAB area + RTN Return to caller +* +* DSR LINK with error handling +* +GKDSRL CALL GKDSR + BS GKERR Branch on no-device + CEQ >0D,V@>08C1 Check for device errors + BR GKERR . + RTN Return to caller +* +* DSR LINK routine +* +GKDSR DST >08C9,@FAC12 Name length pointer + CALL >10 Call DSR + BYTE 8 * DSR CALL + RTNC Return with COND bit +GKPABD BYTE 0,>D,9,0,0,0,0,0,0 +* +* Screen - prints initial screen and disk info +* +GKSCRN FMT + SCRO >60 + ROW 1 + COL 2 + HTEX 'DIRECTORY =' + ROW+ 1 + COL 3 + HTEX 'Filename Size Type P' + ROW+ 1 + COL 2 + HTEX '---------- ---- ----------- -' + FEND + CALL GKDSTR Get path $ into FAC + CZ @FAC1 Skip if zero length + BS GKCAT3 + FMT + SCRO >60 + ROW 1 + COL 14 + HSTR 10,@FAC2 + FEND +GKCAT3 RTN Return +* +* Test for space and FCTN 4 +* +GKTKEY SCAN Scan the keyboard + BR GKTKE1 Continue if no new key + CEQ SPACE,@RKEY SPACE key? + BR GKTKE2 NO! Abort. +GKTKE3 SCAN Scan keyboard + BR GKTKE3 Loop until new key press + CEQ SPACE,@RKEY SPACE key? + BR GKTKE2 NO! Abort. +GKTKE1 RTN Return +GKTKE2 CLR @PAD Clear a byte + CZ @PAD Set COND bit + RTNC Return w/COND +* +* Scroll the screen +* +GKSCRL CH 19,@PAD1 Check line counter + BS GKSCL1 Short scroll + INC @PAD1 Line count +1 + MOVE >280,V@>A0,V@>80 Scroll screen +GKSCL2 ST SPACE+OFFSET,V@>2E0 Clear last line + MOVE >1F,V@>2E0,V@>2E1 + RTN Return +GKSCL1 MOVE >260,V@>A0,V@>80 + BR GKSCL2 +* +* Display one file on screen +* +GKFNAM CALL GKDSTR Get string into FAC + CZ @FAC1 Skip display if zero + BS GKCAT5 length + FMT + SCRO >60 Put disk name on screen + ROW 23 . + COL 02 . + HSTR 10,@FAC2 . + FEND . +GKCAT5 DADD @FAC,@VAR5 Go to next field + DADD 10,@VAR5 Continue another field + DCZ V*VAR5 Time to get out if + BS GKFNA1 zero file size + DST >02EA,@VAR9 Set up screen address + CALL GKDNUM Display file length + DSUB 9,@VAR5 Back a field + MOVE 8,V*VAR5,@FAC Move it into FAC + XML CFI Convert it to an int. + CZ @FAC Non-negative? + BS GKCAT7 YES! File not protected + ST 185,V@>02FE Put a 'Y' on screen + DNEG @FAC Make number positive +GKCAT7 DEC @FAC1 Adjust for CASE + CASE @FAC1 Show file type + BR GKDF + BR GKDV + BR GKIF + BR GKIV + BR GKPR + BR GKDIR +GKDF FMT + SCRO >60 + ROW 23 + COL 18 + HTEX 'Dis/Fix' + FEND + BR GKCAT6 +GKDV FMT + SCRO >60 + ROW 23 + COL 18 + HTEX 'Dis/Var' + FEND + BR GKCAT6 +GKIF FMT + SCRO >60 + ROW 23 + COL 18 + HTEX 'Int/Fix' + FEND + BR GKCAT6 +GKIV FMT + SCRO >60 + ROW 23 + COL 18 + HTEX 'Int/Var' + FEND + BR GKCAT6 +GKPR FMT + SCRO >60 + ROW 23 + COL 18 + HTEX 'Program' + FEND + RTN +GKDIR FMT + SCRO >60 + ROW 23 + COL 18 + HTEX 'Directory' + FEND + RTN Return +GKCAT6 DADD 18,@VAR5 Advavce two fields + DST >02F6,@VAR9 Set up screen address + CALL GKDNUM Display record length + RTN Return +GKFNA1 CLR @PAD Clear a byte + CZ @PAD Set COND bit + RTNC Return w/COND +* Display number subroutine +* ENTER: Floating number in FAC for GKDNU1 +* Screen address in VAR9 +* +GKDNUM MOVE 8,V*VAR5,@FAC Move FLP number to FAC + +GKDNU1 CLR @FAC11 Indicate a free format + XML XBCNS Convert FAC to a string + DST 7,@VARB Right justify number + SUB @FAC12,@VARB+1 + DADD @VARB,@VAR9 +GKDNU2 ADD >60,*FAC11 Add offset to string + ST *FAC11,V*VAR9 Put a char on the screen + DINC @VAR9 Increment screen addr. + INC @FAC11 Increment FAC addr. + DEC @FAC12 Decrement string length count + BR GKDNU2 Loop until done + RTN Return to caller +* +* Prepare a VDP string for FORMAT statement +* LEAVE: FAC has string length (word) +* FAC2 has string +* VAR5 pointing to next string in record +* +GKDSTR DST >0900,@VAR5 Get buffer address + CLR @FAC Clear MSB of FAC word + ST V*VAR5,@FAC1 Store disk name length + DINC @VAR5 Point to string + ST >20,@FAC2 Clear out string space + MOVE 9,@FAC2,@FAC3 + MOVE @FAC,V*VAR5,@FAC2 Move disk name into FAC + RTN +*********************************************************** +DSKDSR FETCH @FAC16 * Get Length of name + FETCH @FAC17 * Get Subroutine # + DST @FAC16,V@VROAZ * Load into PAB + DST VROAZ,@FAC12 * PAB address in VDP + CALL LINK * DSRLNK + BYTE >0A * Subroutine + BS ERRFE * File Error + SRL 5,@FAC6 * + CZ @FAC6 * + BR ERRFE * File Error + RTN * +******************************* +DSKSUB TEXT 'DSK#.' +DSKNAM CALL STRFCH Get path string + CEQ >65,@FAC2 Do we have a string? + BS DEV1 YES, normal execution + XML CFI Convert FAC to integer + CEQ >03,@FAC10 OK? + BS ERRBV No. + CHE 30,@FAC1 ASCII? + BS DEVASC Yes. + CHE 10,@FAC1 Higher then 9? + BS ERRBV No, error + ADD 48,@FAC1 Make it ASCII. +DEVASC ST @FAC1,@TEMP1 Save the number +DEV0 DST 5,@BYTES Set up for a string + XML GETSTR Get string space + MOVE 5,G@DSKSUB,V*SREF Save the string + ST @TEMP1,V@3(@SREF) Store the number + DST @BYTES,@FAC6 Copy string length. + DST @SREF,@FAC4 Copy string address. +DEV1 DCZ @FAC6 Is it a null string? + BS ERRBA YES! Bad Argument + ST V*FAC4,@TEMP1 Save device number + CEQ 1,@FAC7 Length 1? + BS DEV0 Yes + RTN +******************************************************* +* CALL SAMS(memory-boundery,memory-page[,...]) * +******************************************************* +* SAMS replaced AMSPASS, AMSMAP, AMSOFF, AMSON * +* CALL SAMS("PASS",...) * +* CALL SAMS("MAP",...) * +* CALL SAMS("OFF",...) * +* CALL SAMS("ON",...) * +***************************************************** +* SAMS replaced AMSBANK full RAM memory management * +***************************************************** +* CALL SAMS(2,page,3,page,A,page,B,page,C,page, * +* D,page,E,page,F,page,...) * +* * +* Numbers 2 is >2000, 3 is >3000 * +* Letters A is >A000, B is >B000, C is >C000 * +* Letter D is >D000, E is >D000, F is >F000 * +* page now is SAMS 4K pages from 0 to 255 * +***************************************************** +* BSAVE and BLOAD replaced with full memory address * +* 4K RAM boundries same as SAMS addressing RAM * +***************************************************** +SAMS DATA BEEP + STRI 'SAMS' + DATA $+2 + CALL COMB * ( ? +************************************************** +* Get stirng or token or numeric * +* String is for PASS,MAP,OFF, ON * +* 2 and 3 are numeric as no token exist for them * +* thus need a numeric interpetation for 2 and 3 * +* A, B, C, D, E, F are tokenized already for use * +************************************************** +SAMS2 XML PGMCHR * Skip ( OR COMMA + CEQ >C7,@CHAT * STRING? + BR SAMSPS * Must be a TOKEN? +SAMSTR CALL STRPAR * GET STRING? + CEQ >65,@FAC2 * STRING? + BR ERRBV * ERROR BAD VALUE + DCZ @FAC6 * 0 Length? + BS ERRBA * ERROR BAD ARGUMENT + DCEQ >5041,V*FAC4 * PA? PASS MODE + BR AMSMAP * SAMS MAP +* CALL AMSPASS ************** + CALL PASAMS * SAMS PASS + BR SAMS3 * CHECK FOR COMMA +AMSMAP DCEQ >4D41,V*FAC4 * MA? MAP MODE + BR AMSOFF *SAMS OFF +* CALL AMSMAP *************** + CALL MAPAMS * SAMS MAP + BR SAMS3 * CHECK FOR COMMA +AMSOFF DCEQ >4F46,V*FAC4 * OF? SAMS OFF + BR AMSON * SAMS ON +* CALL AMSOFF *************** + CALL OFFAMS * AMS OFF + BR SAMS3 * CHECK FOR COMMA +AMSON DCEQ >4F4E,V*FAC4 * ON? SAMS ON + BR ERRBA * ERROR BAD ARGUMENT +* CALL AMSON **************** + CALL ONAMS * AMS ON + BR SAMS3 * CHECK FOR COMMA +****************************************************** +* Moves 18 bytes ASSEMBLY into >8300 Scratch Pad RAM * +* Executes address at >8300 BLWP FAC & ARG workspace * +****************************************************** +PASAMS CALL AMSSUB * AMS PASS SUBROUTINE + DST >1E01,@SETCRU * LOAD PASS VALUE + BR SAMSUB * EXECUTE IT +ONAMS CALL AMSSUB * AMS ON SUBROUTINE + DST >1D00,@SETCRU * LOAD ON VALUE + BR SAMSUB * EXECUTE IT +OFFAMS CALL AMSSUB * AMS OFF SUBROUTINE + DST >1E00,@SETCRU * LOAD OFF VALUE + BR SAMSUB * EXECUTE IT +MAPAMS CALL AMSSUB * AMS MAP SUBROUTINE + DST >1D01,@SETCRU * LOAD MAP VALUE +SAMSUB XML >F0 * EXECUTE ASSEMBLY + RTN * RETURN +********************************************************** +* MOVES CPU PROGRAM TO SCRATCH PAD * +AMSSUB CLR @>6004 * ROM 3 * + XML SAMSR * GET ASSEMBLY FROM GROM * + RTN * RETURN * +********************************************************** +* SAMS PAGE CHANGE +****************************************************** +* SAMS PAGES 2,3,A,B,C,D,E,F TOKENS * +* PAGES range from 0 to 255 now instead of 16 to 255 * +* Also now all SAMS RAM range not just lower 8K * +****************************************************** +SAMSPS CALL SAMS4A * ADDRESS IN TEMP & PUSHED + CEQ COMMAZ,@CHAT * COMMA? + BR ERRSYN * ERROR SYNTAX + XML PGMCHR * Skip COMMA + CALL STRPAR * Get Number + XML CFI * PAGE Convert to integer + CALL MAPAMS * AMS MAP + CALL ONAMS * AMS ON +* TEMP has RAM address >A000 up to >F000 +* Shift address to be 2* value for SAMS register +* i.e. >F0 would be >1E so >401E would be register 15 + SRL 3,@TEMP * MOVE TO LOWER NIBBLE + EX @TEMP,@TEMP+1 * SWAP BYTES INDEX ADDRESS + EX @FAC1,@FAC * SWAP BYTES PAGE:BANK + ST @FAC1,@>4001(@TEMP) * SET BANK + ST @FAC,@>4000(@TEMP) * SET PAGE + CALL OFFAMS * AMS OFF +SAMS3 CEQ COMMAZ,@CHAT * COMMA? + BS SAMS2 +SAMS4 CEQ RPARZ,@CHAT * )? + BR ERRSYN * SYNTAX ERROR + XML PGMCHR * Skip ")" + CALL RETURN * RETURN TO CALLER +**************************************************** +* SAMS PAGES 2,3,A,B,C,D,E,F * +* Get 2 and 3 numeric or A to F tokens * +* input in CHAT is >C8 is numeric or must be token * +* output TEMP has RAM ADDRESS of 4K page to save * +**************************************************** +SAMS4A DCLR @TEMP * Clear address storage + CEQ >C8,@CHAT * NUMBER? + BR SAMSAL * No must be 2 or 3 or A to F + CALL STRPAR * Get number + XML CFI * Convert to integer + CHE 4,@FAC1 * 1 or higher + BS ERRBA * ERROR BAD ARGUEMENT + ST >20,@TEMP * Defualt address >2000 + CEQ 2,@FAC1 * 2? + BS SAMSP3 * Ok so done + CHE 4,@FAC1 * 4 or higher? + BS ERRBA * ERROR BAD ARGUEMENT + ADD >10,@TEMP * Get address +SAMSP3 RTN * RETURN +* 24K ADDRESS PAGES +SAMSAL CHE >47,@CHAT * G OR HIGHER + BS ERRBA * ERROR BAD ARGUEMENT + CHE >41,@CHAT * A OR HIGHER? + BR ERRBA * ERROR BAD ARGUEMENT + ST @CHAT,@ARG * Save TOKEN + SUB >41,@ARG * 0 TO 5 + ST >A0,@TEMP * Default address >A000 +SAMSLP CZ @ARG * 0? + BS SAMSD * RETURN + ADD >10,@TEMP * >B000 TO >F000 + DEC @ARG * 5 TO 1 + B SAMSLP * LOOP FOREVER +SAMSD XML PGMCHR * SKIP TOKEN + RTN * RETURN +*********************************************************** +* CALL EXECUTE(address[,...]) BLWP @address * +*********************************************************** +EXECLK DATA EXEBL + STRI 'EXECUTE' + DATA $+2 + CALL COMB (? +EXAGN CALL SUBLP3 Get address + MOVE 12,G@CPUPGM,@PAD Load PGM + DST @FAC,@PAD4 Load address + XML >F0 Execute address + CEQ COMMAZ,@CHAT Comma? + BS EXAGN Repeat + BR GC429 +*********************************************************** +* CPU PROGRAM FOR >8300 SCATCH PAD SUBROUTINE EXECUTE * +*********************************************************** +* AORG >8300 * +CPUPGM DATA >8302 * CPUPGM DATA >8302 First address. * + DATA >0420 * BLWP @>834A Switch contex * + DATA >834A * FAC not used * + DATA >04E0 * CLR @>837C Clear for GPL * + DATA >837C * * + DATA >045B * RT Return to GPL. * + * END * +*********************************************************** +* CALL EXE(address[,...]) BL @address * +*********************************************************** +EXEBL DATA PSAVE + STRI 'EXE' + DATA $+2 + CALL COMB (? +EXEBLA CALL SUBLP3 + DST @FAC,@PAD Load address + XML >F0 Execute address + CEQ COMMAZ,@CHAT Comma? + BS EXEBLA Repeat + BR GC429 +*********************************************************** +* CALL ISRON(variable) * +*********************************************************** +ISRON DATA ISROFF + STRI 'ISRON' + DATA $+2 + CALL COMB * (? + CALL SUBLP3 * Get value + DCZ @FAC * 0? + BS ERRBV * ERROR BAD VALUE + CALL SISRON * Do ISR + BR PEEK5 * Return +SISRON CLR @>6004 * Set ROM PAGE 3 at >6004 + XML >7C * ISR ON Assembly + RTN * Return +*********************************************************** +* CALL ISROFF(variable) * +*********************************************************** +ISROFF DATA USER + STRI 'ISROFF' + DATA $+2 + CALL COMB * (? + XML PGMCHR * Skip + CALL SNDER * Send to XB + CALL CLRFAC * Clear FAC for FP + CALL SISROF * Do ISR + CALL CIFSND * Send value + BR PEEK5 * Return +SISROF CLR @>6004 * Set ROM PAGE 3 at >6004 + XML >7D * ISR OFF Assembly + RTN * Return +********************************************************** +* CALL USER(path-string) * +********************************************************** +USER DATA POKER + STRI 'USER' + DATA $+2 + CALL COMB PARSE UP TO " + CALL STRGET Get path + ST >20,V@RECBUF Clear byte + MOVE 80,V@RECBUF,V@RECBUF+1 Ripple 80 times + MOVE 4,G@UPAB,V@RECBUF+1 Set up USER PAB + ST @FAC7,V@>08C9 Set length + MOVE @FAC6,V*FAC4,V@>08CA Load PAB path + ST >FF,V@CONFLG Set USER flag + BR PEEK5 +UPAB BYTE >14,>09,>00,80 +*********************************************************** + + AORG >0B00 +*********************************************************** +* BASIC KEYWORD TABLE +* THE TOKEN IS ITS LEFT BINDING POWER +*********************************************************** +KEYTAB DATA CHAR1,CHAR2,CHAR3,CHAR4,CHAR5 + DATA CHAR6,CHAR7,CHAR8,CHAR9,CHARA +CHAR1 TEXT '!' + BYTE TREMZ * ! + TEXT '#' + BYTE NUMBEZ * # + TEXT '&' + BYTE CONCZ * & + TEXT '(' + BYTE LPARZ * ( + TEXT ')' + BYTE RPARZ * ) + TEXT '*' + BYTE MULTZ * * + TEXT '+' + BYTE PLUSZ * + + TEXT ',' + BYTE COMMAZ * , + TEXT '-' + BYTE MINUSZ * - + TEXT '/' + BYTE DIVIZ * / + TEXT ':' + BYTE COLONZ * : + TEXT ';' + BYTE SEMICZ * ; + TEXT '<' + BYTE LESSZ * < + TEXT '=' + BYTE EQUALZ * = + TEXT '>' + BYTE GREATZ * > + TEXT '^' + BYTE CIRCUZ * ^ + BYTE >FF +CHAR2 TEXT '::' + BYTE SSEPZ * :: + TEXT 'AT' + BYTE ATZ * AT + TEXT 'GO' + BYTE GOZ * GO * RXB MOTION + TEXT 'IF' + BYTE IFZ * IF + TEXT 'ON' + BYTE ONZ * ON * RXB ONKEY + TEXT 'OR' + BYTE ORZ * OR + TEXT 'PI' + BYTE PIZ * PI + TEXT 'TO' + BYTE TOZ * TO + BYTE >FF +CHAR3 TEXT 'ABS' + BYTE ABSZ * ABS + TEXT 'ALL' + BYTE ALLZ * ALL + TEXT 'AND' + BYTE ANDZ * AND + TEXT 'ASC' + BYTE ASCZ * ASC + TEXT 'ATN' + BYTE ATNZ * ATN + TEXT 'BYE' + BYTE >03 * BYE + TEXT 'CON' + BYTE >01 * CONtinue + TEXT 'COS' + BYTE COSZ * COS + TEXT 'DEF' + BYTE DEFZ * DEF +* GKXB added token + TEXT 'DEL' + BYTE >09 * DEL + TEXT 'DIM' + BYTE DIMZ * DIM + TEXT 'END' + BYTE ENDZ * END + TEXT 'EOF' + BYTE EOFZ * EOF + TEXT 'EXP' + BYTE EXPZZ * EXP + TEXT 'FOR' + BYTE FORZ * FOR + TEXT 'INT' + BYTE INTZ * INT + TEXT 'LEN' + BYTE LENZ * LEN + TEXT 'LOG' + BYTE LOGZ * LOG + TEXT 'MAX' + BYTE MAXZ * MAX + TEXT 'MIN' + BYTE MINZ * MIN + TEXT 'NEW' + BYTE >00 * NEW * RXB CALL NEW + TEXT 'NOT' + BYTE NOTZ * NOT + TEXT 'NUM' + BYTE >04 * NUMber + TEXT 'OLD' + BYTE >05 * OLD * RXB SAMS + TEXT 'POS' + BYTE POSZ * POS + TEXT 'REC' + BYTE RECZ * REC + TEXT 'REM' + BYTE REMZ * REMark + TEXT 'RES' + BYTE >06 * RESequence + TEXT 'RND' + BYTE RNDZ * RND * RXB CHANGED + TEXT 'RUN' + BYTE RUNZ * RUN * RXB SAMS + TEXT 'SGN' + BYTE SGNZZ * SGN + TEXT 'SIN' + BYTE SINZ * SIN + TEXT 'SQR' + BYTE SQRZ * SQR + TEXT 'SUB' + BYTE SUBZ * SUB + TEXT 'TAB' + BYTE TABZ * TAB + TEXT 'TAN' + BYTE TANZ * TAN + TEXT 'VAL' + BYTE VALZ * VAL + TEXT 'XOR' + BYTE XORZ * XOR + BYTE >FF +CHAR4 TEXT 'BASE' + BYTE BASEZ * BASE + TEXT 'BEEP' + BYTE BEEPZ * BEEP + TEXT 'CALL' + BYTE CALLZ * CALL + TEXT 'CHR$' + BYTE CHRZZ * CHR$ +* GKXB added token + TEXT 'COPY' + BYTE >0A * COPY + TEXT 'DATA' + BYTE DATAZ * DATA + TEXT 'ELSE' + BYTE ELSEZ * ELSE + TEXT 'GOTO' + BYTE GOTOZ * GOTO * RXB ONKEY + TEXT 'LIST' + BYTE >02 * LIST +* GKXB added token + TEXT 'MOVE' + BYTE >0B * MOVE + TEXT 'NEXT' + BYTE NEXTZ * NEXT + TEXT 'OPEN' + BYTE OPENZ * OPEN + TEXT 'READ' + BYTE READZ * READ + TEXT 'RPT$' + BYTE RPTZZ * RPT$ + TEXT 'SAVE' + BYTE >07 * SAVE * RXB SAVE IV254 + TEXT 'SEG$' + BYTE SEGZZ * SEG$ + TEXT 'SIZE' + BYTE SIZEZ * SIZE * RXB CALL SIZE + TEXT 'STEP' + BYTE STEPZ * STEP + TEXT 'STOP' + BYTE STOPZ * STOP * RXB MOTION + TEXT 'STR$' + BYTE STRZZ * STR$ + TEXT 'THEN' + BYTE THENZ * THEN + BYTE >FF +CHAR5 TEXT 'BREAK' + BYTE BREAKZ * BREAK + TEXT 'CLOSE' + BYTE CLOSEZ * CLOSE + TEXT 'DIGIT' + BYTE DIGITZ * DIGIT + TEXT 'ERASE' + BYTE ERASEZ * ERASE + TEXT 'ERROR' + BYTE ERRORZ * ERROR + TEXT 'FIXED' + BYTE FIXEDZ * FIXED + TEXT 'GOSUB' + BYTE GOSUBZ * GOSUB + TEXT 'IMAGE' + BYTE IMAGEZ * IMAGE + TEXT 'INPUT' + BYTE INPUTZ * INPUT + TEXT 'MERGE' + BYTE >08 * MERGE + TEXT 'PRINT' + BYTE PRINTZ * PRINT + TEXT 'TRACE' + BYTE TRACEZ * TRACE + TEXT 'USING' + BYTE USINGZ * USING + BYTE >FF +CHAR6 TEXT 'ACCEPT' + BYTE ACCEPZ * ACCEPT + TEXT 'APPEND' + BYTE APPENZ * APPEND + TEXT 'DELETE' + BYTE DELETZ * DELETE + TEXT 'LINPUT' + BYTE LINPUZ * LINPUT + TEXT 'NUMBER' + BYTE >04 * NUMBER + TEXT 'OPTION' + BYTE OPTIOZ * OPTION + TEXT 'OUTPUT' + BYTE OUTPUZ * OUTPUT + TEXT 'RETURN' + BYTE RETURZ * RETURN + TEXT 'SUBEND' + BYTE SUBNDZ * SUBEND + TEXT 'UALPHA' + BYTE UALPHZ * UALPHA + TEXT 'UPDATE' + BYTE UPDATZ * UPDATE + BYTE >FF +CHAR7 TEXT 'DISPLAY' + BYTE DISPLZ * DISPLAY + TEXT 'NUMERIC' + BYTE NUMERZ * NUMERIC + TEXT 'RESTORE' + BYTE RESTOZ * RESTORE + TEXT 'SUBEXIT' + BYTE SUBXTZ * SUBEXIT + TEXT 'UNBREAK' + BYTE UNBREZ * UNBREAK + TEXT 'UNTRACE' + BYTE UNTRAZ * UNTRACE + TEXT 'WARNING' + BYTE WARNZ * WARNING + BYTE >FF +CHAR8 TEXT 'CONTINUE' + BYTE >01 * CONTINUE + TEXT 'INTERNAL' + BYTE INTERZ * INTERNAL + TEXT 'RELATIVE' + BYTE RELATZ * RELATIVE + TEXT 'VALIDATE' + BYTE VALIDZ * VALIDATE + TEXT 'VARIABLE' + BYTE VARIAZ * VARIABLE + BYTE >FF +CHAR9 TEXT 'RANDOMIZE' + BYTE RANDOZ * RANDOMIZE + BYTE >FF +CHARA TEXT 'SEQUENTIAL' + BYTE SEQUEZ * SEQUENTIAL + BYTE >FF +*********************************************************** + + AORG >0D77 +* GROM ADDRESS >CD77 FOR ERRTAB +*********************************************************** +* ERRTAB - Error table containing all of the error messages +* error numbers and the severity code for each +* error. The error call number is the data byte +* that must follow the CALL ERRZZ or CALL WARNZZ. +* Messages with severity of zero are system +* messages and not error messages. +* +* Message, Error #, Severity CALL # +*********************************************************** +ERRTAB DATA MSGFST * "READY" + BYTE 0,0 + DATA MSGBRK * "BREAKPOINT" + BYTE 0,0 + DATA MSG10 * "NUMERIC OVERFLOW" + BYTE 10,1 + DATA MSG14 * "SYNTAX ERROR" + BYTE 14,9 + DATA MSG16 * "ILLEGAL AFTER SUBPROGRAM" + BYTE 16,9 + DATA MSG17 * "UNMATCHED QUOTES" + BYTE 17,9 + DATA MSG19 * "NAME TOO LONG" + BYTE 19,9 + DATA MSG24 * "STRING-NUMBER MISMATCH" + BYTE 24,9 + DATA MSG25 * "OPTION BASE ERROR" + BYTE 25,9 + DATA MSG28 * "IMPROPERLY USED NAME" + BYTE 28,9 + DATA MSG36 * "IMAGE ERROR" + BYTE 36,9 + DATA MSG39 * "MEMORY FULL" + BYTE 39,9 + DATA MSG40 * "STACK OVERFLOW" + BYTE 40,9 + DATA MSG43 * "NEXT WITHOUT FOR" + BYTE 43,9 + DATA MSG44 * "FOR-NEXT NESTING" + BYTE 44,9 + DATA MSG47 * "MUST BE IN SUBPROGRAM" + BYTE 47,9 + DATA MSG48 * "RECURSIVE SUBPROGRAM CALL" + BYTE 48,9 + DATA MSG49 * "MISSING SUBEND" + BYTE 49,9 + DATA MSG51 * "RETURN WITHOUT GOSUB" + BYTE 51,9 + DATA MSG54 * "STRING TRUNCATED" + BYTE 54,1 + DATA MSG57 * "BAD SUBSCRIPT" + BYTE 57,9 + DATA MSG56 * "SPEECH STRING TOO LONG" + BYTE 56,9 + DATA MSG60 * "LINE NOT FOUND" + BYTE 60,9 + DATA MSG61 * "BAD LINE NUMBER" + BYTE 61,9 + DATA MSG62 * "LINE TOO LONG" + BYTE 62,9 + DATA MSG67 * "CAN'T CONTINUE" + BYTE 67,9 + DATA MSG69 * "COMMAND ILLEGAL IN PROGRAM + BYTE 69,9 + DATA MSG70 * "ONLY LEGAL IN A PROGRAM" + BYTE 70,9 + DATA MSG74 * "BAD ARGUMENT" + BYTE 74,9 + DATA MSG78 * "NO PROGRAM PRESENT" + BYTE 78,1 + DATA MSG79 * "BAD VALUE" + BYTE 79,9 + DATA MSG81 * "INCORRECT ARGUMENT LIST" + BYTE 81,9 + DATA MSG83 * "INPUT ERROR" (WARNING) + BYTE 83,1 + DATA MSG84 * "DATA ERROR" + BYTE 84,9 + DATA MSG109 * "FILE ERROR" + BYTE 109,9 + DATA MSG130 * "I/O ERROR" (WARNING) + BYTE 130,1 + DATA MSG130 * "I/O ERROR" + BYTE 130,9 + DATA MSG135 * "SUBPROGRAM NOT FOUND" + BYTE 135,9 + DATA MSG60 * "LINE NOT FOUND" (WARNING) + BYTE 60,1 + DATA MSG97 * "PROTECTION VIOLATION" + BYTE 97,9 + DATA MSG34 * "UNRECOGNIZED CHARACTER" + BYTE 20,9 +* Following message is added 6/24/81 for the INPUT bug. + DATA MSG83 * "INPUT ERROR" + BYTE 83,9 +*********************************************************** +* TRACBK - Is used to trace back the error levels through +* nested function references and subprogram calls. +* It takes care of issuing the trace back info +* messages in these two cases. It leaves the stack +* unchanged except in the case of a prescan error +* occurring in an external subprogram. If any +* messages are issued, it returns with the staus +* set, else reset. +*********************************************************** +TRACBK DST @VSPTR,@FAC8 Get a temp stack pointer +GCE22 DCH @STVSPT,@FAC8 While not end of stack + BR GCE48 + CEQ >68,V@2(@FAC8) If UDF entry + BS TRAC05 + CEQ >70,V@2(@FAC8) If temp UDF entry + BR GCE3B + DSUB 8,@VSPTR Trash it so DELINK won't + BR TRAC05 mess up the symbol table +GCE3B CEQ >6A,V@2(@FAC8) If subprogram + BS TRAC50 + DSUB 8,@FAC8 Goto next entry on stack + BR GCE22 +GCE48 RTN If no UDF or subprograms acti +* Trace back UDF reference +TRAC05 CLR @FAC12 To cheat on ERPRNT + EX @PRGFLG,@FAC12 Force line # NOT to be printe + CEQ 1,@FAC13 If warning message + BR GCE58 +* Place for the message already set in WRNZZ3 + CALL ERPNT5 Don't restore char set + BR GCE5B +GCE58 CALL ERPRNT Print the real error messgae +GCE5B ST @FAC12,@PRGFLG Restore program/imperative fl + DST @PGMPTR,@ARG Get the place of error for FN + CALL FNDLNE Find the line that the error +* is in + DST >A9AE,V@NLNADD+2 Say 'in' xx + DST NLNADD+5,@VARW Start place of line number + CALL DISO Put out the line number + XML SCROLL +TRAC09 DST V*FAC8,@ARG Save PGMPTR from the entry +TRAC10 DSUB 8,@FAC8 Go on to next entry + DCH @STVSPT,@FAC8 If not end of stack + BR GCEE2 + CEQ >68,V@2(@FAC8) If function entry + BR GCEC8 + DCEQ @ARG,V*FAC8 If recursive + BR GCEB3 + MOVE 15,G@MSGCIS,V@NLNADD+2 + XML SCROLL * CALLS ITSELF +TRAC12 DSUB 8,@FAC8 Goto next entry on stack +GCE99 CEQ >68,V@2(@FAC8) While functions + BR GCEAC + DCEQ @ARG,V*FAC8 + BR TRAC09 + DSUB 8,@FAC8 Goto next entry on stack + BR GCE99 +GCEAC CGT >65,V@2(@FAC8) If string is numeric + BR TRAC12 +GCEB3 MOVE 11,G@MSGCF,V@NLNADD+2 + CALL FNDLNE Find the line + DST NLNADD+14,@VARW Place to display it + CALL DISO Display the line number + XML SCROLL * CALLED FROM + BR TRAC09 Go on +* Jump always +GCEC8 CHE >66,V@2(@FAC8) If not permanent + BR TRAC10 +GCECF DCH VRAMVS,@FAC8 While still not at bottom + BR GCEE2 + CEQ >6A,V@2(@FAC8) If subprogram + BS TRAC51 + DSUB 8,@FAC8 Go down an entry + BR GCECF +GCEE2 CZ @PRGFLG If not imperative + BS GCEF6 + MOVE 11,G@MSGCF,V@NLNADD+2 + DST NLNADD+14,@VARW Place to display line # + CALL ASC Display it + XML SCROLL +GCEF6 BR RTNSET Return with condition set +* Trace back subprogram calls +TRAC50 CEQ 1,@FAC13 If warning message only + BR GCF02 + CALL ERPNT5 Don't restore char set + BR GCF05 +GCF02 CALL ERPRNT Print the real message +GCF05 CZ @PRGFLG + BS RTNSET +TRAC51 CZ @PRGFLG + BS RETNOS + DST >A9AE,V@NLNADD+2 Display 'IN' + DST NLNADD+6,@FAC12 Display location of name +TRAC55 DST V*FAC8,@FAC16 Get S.T. pointer + CLR @FAC10 Need a double length + ST V@1(@FAC16),@FAC10+1 Get the name length + DST V@4(@FAC16),@FAC16 Get the name pointer + MOVE @FAC10,V*FAC16,V*FAC12 Display +GCF2C ADD OFFSET,V*FAC12 + DINC @FAC12 + DDEC @FAC10 + DCZ @FAC10 + BR GCF2C + XML SCROLL Scroll the screen 'CALLED FRO + MOVE 11,G@MSGCF,V@NLNADD+2 + DST @FAC8,@FAC10 In case at top level + DST V@6(@FAC8),@FAC8 Get LSUBP off stack + DCZ @FAC8 If not top level call + BS GCF53 + DST NLNADD+15,@FAC12 Display location of name + BR TRAC55 +* Now find original number +GCF53 DST V@-6(@FAC10),@ARG2 Get pointer to line number + CALL GETLN2 Get the actual line number + DST NLNADD+15,@VARW Place to put line number + CALL DISO Display the line number + XML SCROLL Scroll the mess up +* RETURN WITH CONDITION BIT SET +RTNSET CEQ @>8300,@>8300 SET CONDITION BIT +RETNOS RTNC +GETLN2 DDECT @ARG2 + CALL GRSUB2 Read 2 bytes of data from ERA + BYTE >5E * (use GREAD1) or VDP (>5E=AR + DST @EEE1,@ARG2 Put the result into @ARG2 + RTN +* Given a specific PGMPTR (in ARG) find the line number of +* the line it points into and put the actual line number +* in ARG2 +FNDLNE DST @STLN,@ARG4 Get pointer into # buffer + DINCT @ARG4 Point at the line pointer + DST @ARG4,@ARG2 Get line pointer + DCLR @ARG6 Start with a zero value +GCF7D DCHE @ENLN,@ARG4 While in line buffer + BS GCF9C + CALL GRSUB2 Get the line # from ERAM/VDP + BYTE >60 * @ARG4: Source address on ERAM + DCGT @ARG,@EEE1 + BS GCF96 + DCH @ARG6,@EEE1 If closer + BR GCF96 + DST @ARG4,@ARG2 Make it the one + DST @EEE1,@ARG6 +GCF96 DADD 4,@ARG4 Goto next line in buffer + BR GCF7D +GCF9C CALL GETLN2 Get the line number + AND >7F,@ARG2 Reset the breakpoint if any + RTN +*********************************************************** +USERFG CZ V@CONFLG USER FLAG set? + BS NOUSR Yes, skip ahead + DCEQ >0900,V@>08C2 USER PAB there? + BS GD0F3 Yes, flag set + BR SAVLN5 +NOUSR MOVE @FAC,V*VARW,V@RECBUF Save line + BR SAVLN5 Continue +*********************************************************** +* +* EDTZZ0 EQU >D000 + + AORG >1000 +*********************************************************** +* EDIT routine - display requested line and edit any change +* in the program segment. +* +* FAC contains the line number just read in +EDTZZ0 DCEQ @ENLN,@STLN If no program + BR GD008 + B ILLST +GD008 XML SPEED + BYTE SEETWO * Try to find the line (# in FA + BR EDTZ08 * LINE NOT FOUND +EDTZ00 ST 29,@CCPPTR Force new record on first lin +* The entry in the line number table is in EXTRAM + ST OFFSET,@DSRFLG Set screen output mode + ST 28,@RECLEN Select standard record length + DCLR @PABPTR I/O to the screen + CZ @RAMTOP If ERAM + BS GD020 + CALL GRMLST Prepare to list from ERAM +GD020 CALL LLIST List the line +* VARW contains the position of the first character followi +* the line number. + CH @RECLEN,@CCPPTR Exactly at end of line + BR GD032 + XML SCROLL Scroll up one line + DSUB 32,@VARW And correct both VARW + DSUB 28,@CCPADR and CCPADR +GD032 DST @VARW,@ARG2 Set cursor at start position + AND >E0,@ARG3 Back to beginning of line + DADD 157,@ARG2 Compute theoretically highest + DST @CCPADR,@VARA Use current high position +* as high + DCHE @VARA,@ARG2 If > 4 then lines-correct + BS GD048 + DST >031D,@ARG2 Allow for one more line +*---------------------------------------------------------- +* Fix "You cannot add characters to a line whose number is +* multiple of 256, if that line was reached ty typing +* either an up arrow or a down arrow from a previous +* line" bug, the following line is changed +* CALL READL1 Allow user to make change +GD048 CALL READL3 Allow user to make change +*---------------------------------------------------------- + CALL SAVLIN Save the line for recall + CZ @RAMTOP If ERAM exists + BS GD056 + DST @FAC14,@EXTRAM saves EXTRAM in FAC +GD056 CLOG 1,@FLAG Autonumber + BR EDTZ01 + CEQ UPARR,@RKEY Ended in UP arrow + BR GD06B + DADD 4,@EXTRAM Point at next line to list + DCH @ENLN,@EXTRAM Doesn't exist + BS EDTZ01 + BR EDTZ02 +GD06B CEQ DWNARR,@RKEY Want next program line + BR GD085 + DSUB 4,@EXTRAM Point at next line to list + DCHE @STLN,@EXTRAM Passed high program + BS EDTZ02 +EDTZ01 ST CHRTN,@RKEY Set no more editing + BR GD085 +EDTZ02 CALL GRSUB3 Read from ERAM, use GREAD +* or VDP, Reset possible +* breakpoint too + BYTE >2E * @EXTRAM: Source address on ER + DST @EEE1,@ARG6 Save for general use +GD085 CZ @ARG4 If current, the line was chan + BR GD0A1 + DST CRNBUF,@RAMPTR Initialize crunch pointer + XML CRUNCH Crunch the input line + BYTE 0 * Normal crunch mode + DCZ @ERRCOD If error + BS GD097 + B TOPL42 +*---------------------------------------------------------- +* Fix "Illegal line number 0 can be created by editting a +* line" bug, 5/23/81 +* Add the following line, and the label TOPL55 at line +* (TOPL45+9) +GD097 DCZ @FAC If line number has + BR GD09E been deleted - treated as + B TOPL55 imperative state +*---------------------------------------------------------- +GD09E CALL EDITLN And edit into program buffer +GD0A1 DST @ARG6,@FAC Line number for next line + CEQ CHRTN,@RKEY Stop on carriage return + BR GD008 + B TOPL15 Don't kill the symbol table +* JUMP ALWAYS +G698C EQU >698C +EDTZ08 B G698C LINE NOT FOUND +* Save input line for edit recall +SAVLIN AND >E0,@VARW+1 Correct in case autonumber + INCT @VARW+1 Skip edge characters + DST @VARA,@FAC Get pointer to end of line + DSUB @VARW,@FAC Compute length of line + BS SAVLN5 If zero, length line + DCH 160,@FAC If line longer then buffer + BR GD0C6 + DST 160,@FAC Default to max buffer size +* RXB PATCH CODE FIX USER / REDO KEY ********************** +* GD0C6 MOVE @FAC,V*VARW,V@RECBUF Save line +GD0C6 B USERFG Check for USER FLAG +*********************************************************** +* + + AORG >10CC +SAVLN5 DST @VARW,V@BUFSRT Save pointer to line start + DST @VARA,V@BUFEND Save pointer to line end +GD0D4 DCHE >0262,V@BUFSRT If try more than 160 + BS GD0E7 +*---------------------------------------------------------- +* Fix bug "Delete characters while in REDO mode, next REDO +* still may show those deleted characters, 5/26/81 +* Replace following line +* DST >02FE,V@BUFEND Update pointer to line end + DADD 32,V@BUFEND Shift the whole buffer 32 +* down at a time +*---------------------------------------------------------- + DADD 32,V@BUFSRT Update pointer for 160 chars + BR GD0D4 +*---------------------------------------------------------- +* Also add following 3 lines for the bug above +GD0E7 DCH >02FE,V@BUFEND Update pointer to line end + BR GD0F3 + DST >02FE,V@BUFEND +*---------------------------------------------------------- +GD0F3 RTN +*********************************************************** + + AORG >10F4 +*********************************************************** +* AMS BRANCH TABLE FOR AMS ROUTINES * FIXED * + BR MAPAMS * AT * + BR PASAMS * >D0F4 * + BR OFFAMS * PERMANENTLY * + BR ONAMS * ADD TO THE * + BR SISRON * TABLE IF * + BR SISROF * NEEDED. * +*********************************************************** +RUNRXB OR >10,@GKFLAG QUIT KEY + AND >F7,@FLAG Set flag + DST @YPT,@STPT Save Row/Col values + ALL >80 + DCEQ >994A,V@>2254 + BS RUNXB + CEQ '1',V@LODFLG + BS SCNKEY + CZ V@LODFLG + BS SCNKEY + CEQ >3A,V@LODFLG + BS RXBRUN + SCAN + CEQ >FF,@RKEY + BR LDKEY + ST V@LODFLG,V@>0824 + BR SRCHLP +* RXB SCREEN +SCNKEY FMT + SCRO >60 + ROW 0 + COL 8 + HTEX 'VERSION = 2024' + ROW 2 + COL 11 + HTEX 'R X B' + ROW 4 + COL 11 + HTEX 'creator' + ROW 6 + COL 8 + HTEX 'RICH GILBERTSON' + ROW 13 + COL 0 + HTEX '>> press ============= result <<' + ROW 15 + COL 2 + HTEX 'ANY KEY = DSK#.LOAD' + ROW 17 + COL 2 + HTEX 'ENTER = DSK#.UTIL1' + ROW 19 + COL 2 + HTEX '(COMMA) , = DSK#.BATCH' + ROW 21 + COL 2 + HTEX 'SPACE BAR = RXB COMMAND MODE' + ROW 23 + COL 2 + HTEX '(PERIOD) . = EDITOR ASSEMBLER' + FEND + DST >1000,@FAC14 DELAY VALUE +RSCAN DST >0F12,@YPT + CALL CBKEY + BS RSCAN2 + DDEC @FAC14 + BS SRCHLP + BR RSCAN +RSCAN2 CEQ >0D,@RKEY ENTER? + BS UTIL1 + CEQ >2C,@RKEY COMMA? + BS BATCH + CEQ >2E,@RKEY PERIOD? + BS UTIL4 + CEQ >30,@RKEY 0? (ZERO) + BR LDKEY + MOVE 11,G@WSD,V@CRNBUF WSD1.LOAD + INC @RKEY MAKE IT A 1 +LDKEY CLR V@LODFLG + ST @RKEY,V@>0824 +SRCHLP ALL >80 Clear Screen + DST @STPT,@YPT Restore YPT/XPT + B SZRUNL +* EA RUN XB PROGRAM OR SET SEARCH ************************* +RUNXB MOVE 50,V@>2256,V@>0820 + CLR V@LODFLG + DCLR V@>2254 Clear flag + BR SRCHLP +*********************************************************** +UTIL1 CLR V@>2256 + FMT + COL 0 + ROW 15 + HCHA 32,32 + FEND + CLR @FAC + DST >1000,@FAC14 DELAY VALUE + ST >35,@CHAT +UTIL2 DST >1112,@YPT + CALL CBKEY + BS UTIL3 + DDEC @FAC14 + BS UTIL5 + BR UTIL2 +UTIL3 CEQ >0D,@RKEY ENTER? + BS UTIL2 + CEQ >20,@RKEY SPACE? + BS LDKEY + CEQ >2C,@RKEY COMMA? + BS BATCH + CEQ >2E,@RKEY PERIOD? + BS UTIL6 + CEQ >30,@RKEY 0? (ZERO) + BR UTIL4 + MOVE 12,G@EAWSD,V@>2256 + INC @RKEY + BR EA0 +UTIL4 MOVE 12,G@EAU1,V@>2256 +EA0 ST @RKEY,V@>225A +UTIL5 B GE025 +UTIL6 CLR @CHAT + BR UTIL5 +********************************* +BATCH MOVE 128,V@>01E0,V@>01E1 + DST >1000,@FAC14 LOAD DELAY + CLR @FAC +BATCH1 DST >1312,@YPT ROW/COL + CALL CBKEY + BS BATCH2 + DDEC @FAC14 + BS BATCH3 + BR BATCH1 +BATCH2 CEQ >0D,@RKEY ENTER? + BS SCNKEY + CEQ >20,@RKEY SPACE? + BS SCNKEY + CEQ >2C,@RKEY COMMA? + BS BATCH1 + CEQ >2E,@RKEY PERIOD? + BS SCNKEY + BR BATCH4 +BATCH3 ST >31,@RKEY 1 IN RKEY +BATCH4 ST >20,V@RECBUF + MOVE 80,V@RECBUF,V@RECBUF+1 + MOVE 20,G@UBATCH,V@RECBUF + INV V@CONFLG SET USER FLAG >FF + ST @RKEY,V@>08CD + CLR V@LODFLG + BR NEWSZ +********************************* +CBKEY ST @TIMER,@>83C1 + CLOG >01,@FAC15 + BR CBKEY2 + EX @CB,@FAC + SCAN +CBKEY2 RTNC +************************************** +* RXB HARD DRIVE PATH +WSD BYTE 9 + TEXT 'WSD1.LOAD' + BYTE 0 +* EDITOR ASSEMBLER +EAU1 STRI 'DSK1.UTIL1' + BYTE >0D +EAWSD STRI 'WSD1.UTIL1' + BYTE >0D +* USER PAB & BATCH FILE +UBATCH BYTE 0,>14,9,0,80,0,0,0,0 + STRI 'DSK1.BATCH' +* +*********************************************************** +* CALL BEEP * +*********************************************************** +BEEP DATA HONK + STRI 'BEEP' + DATA $+2 + CALL ACCTON + BR PEEK6 +*********************************************************** +* CALL HONK * +*********************************************************** +HONK DATA MODZ + STRI 'HONK' + DATA $+2 + CALL BADTON + BR PEEK6 +********************************************************* +* CALL PSAVE(boundry,pathstring) * +********************************************************* +PSAVE DATA PLOAD + STRI 'PSAVE' + DATA $+2 + CALL COMB * ( ? +BSAVEL CALL MYSAL * Get pathname + ST >06,V*PAD * LOAD opcode + MOVE >1000,@0(@TEMP),V@>40(@PAD) * COPY IT TO VDP + CALL MYDOIT * DSRLNK opcode + CEQ COMMAZ,@CHAT * COMMA? + BS BSAVEL * Yes loop + BR PEEK5 * Done +********************************************************** +* CALL PLOAD(boundry,pathstring) * +********************************************************** +PLOAD DATA ISRON + STRI 'PLOAD' + DATA $+2 + CALL COMB * ( ? +BLOADL CALL MYSAL * Get pathname + ST >05,V*PAD * LOAD opcode + CALL MYDOIT * DSRLNK opcode + MOVE >1000,V@>40(@PAD),@0(@TEMP) * COPY IT TO RAM + CEQ COMMAZ,@CHAT * COMMA? + BS BLOADL * Yes loop + BR PEEK5 * Done +MYDOIT DST @PAD,@FAC12 * Get buffer address in VDP + ADD 9,@FAC13 * Point to name length + CALL LINK * DSRLNK + BYTE >08 + BS ERRFE * File Error + CLOG >E0,V@1(@PAD) * Set error bits + BR ERRFE + RTN +MYSAL XML PGMCHR * Skip ( OR COMMA + CALL SAMS4A * TEMP will have address + XML COMPCT * Garbage collection VDP + DCHE >1C81,@STREND * Enough VDP space? + BR ERRSO * ERROR STACK OVERFLOW + DST >0C00,@PAD * Buffer for BSAVE/BLOAD + CALL STRGET * Pathstring + CLR V*PAD * 0 BYTE + MOVE >1080,V@0(@PAD),V@1(@PAD) * Ripple + DST @PAD,@ARG * Get PAB address + ADD >40,@ARG1 * Add in PAB buffer + DST @ARG,V@2(@PAD) * Buffer address + DST >1000,V@6(@PAD) * Number of bytes + ST @FAC7,V@9(@PAD) * Length byte + MOVE @FAC6,V*FAC4,V@10(@PAD) * Pathstring + RTN +*********************************************************** +* CALL MOD(number,divisor,quotiant,remanider[,...]) * +* M=N-INT(N/D)*D * +*********************************************************** +MODZ DATA SBIAS + STRI 'MOD' + DATA $+2 + CALL COMB +MODAGN CALL SUBLP3 Get NUMBER + DCZ @FAC 0? + BS ERRBV ERROR BAD VALUE + CLR @PAD Clear PAD + MOVE 8,@PAD,@PAD1 Ripple 8 bytes + DST @FAC,@PAD2 Save NUMBER + CALL SUBLP3 Get DIVISOR + DCZ @FAC 0? + BS ERRBV ERROR BAD VALUE + DST @FAC,@PAD6 Save DIVISOR + XML PGMCHR Skip COMMA + DDIV @PAD6,@PAD NUMBER/DIVISOR + CALL SNDER Get variable info + CALL CLRFAC Clear for FP + DST @PAD,@FAC Get QUOTIENT + CALL CIFSND Send QUOTIENT + XML PGMCHR Skip COMMA + CALL SNDER Get variable info + CALL CLRFAC Clear for FP + DST @PAD2,@FAC REMAINDER + CALL CIFSND Send REMAINDER + CEQ COMMAZ,@CHAT ,? + BS MODAGN Yes +ENDMOD B LNKRTN Done return +********************************************************* +* CALL BIAS(numeric-variable,string-variable) * +********************************************************* +SBIAS DATA SRIGHT + STRI 'BIAS' BIAS + DATA $+2 + CALL COMB ( +BIASAG CALL GETNUM Get number + DST @FAC,@PAD Save number + CALL STRGET Get string + DST @FAC4,@PAD4 Save location + DST @FAC6,@PAD6 Save length +BIASLP ST V*PAD4,@FAC1 * Character. + DCZ @PAD 0? + BS BIASM Yes. + ADD 96,@FAC1 ADD OFFSET + BR BIASSV +BIASM SUB 96,@FAC1 MINUS OFFSET +BIASSV ST @FAC1,V*PAD4 Store it + DINC @PAD4 Next one in string + DDEC @PAD6 Counter-1 + BR BIASLP Loop till zero + CEQ COMMAZ,@CHAT ,? + BS BIASAG Yes +RTNLNK B LNKRTN Done return +********************************************************* +* CALL SCROLLRIGHT * +* CALL SCROLLRIGHT(repetition,string) * +* CALL SCROLLRIGHT(repetition,string,tab) * +********************************************************* +SRIGHT DATA SLEFT + STRI 'SCROLLRIGHT' SCROLLRIGHT + DATA $+2 + CEQ LPARZ,@CHAT (? + BS SRAGN Normal + DST 1,@PAD Defualt 1 line + CLR @>6004 Set ROM3 page + XML RROLL RIGHT ROLL ASSEMBLY + DCLR @PAD2 Screen Address + ST 32,@PAD Space Character + DST 24,@FAC Repetition + CLR @>6004 Set ROM3 page + XML VCHAR Disply SPACE + BR PEEK6 Done +SRAGN CALL SUBLP3 Skip comma,REPETITION + DCZ @FAC 0? + BS ERRBV ERROR BAD VALUE + DST @FAC,@PAD ROLL REPETITION +SRLOOP CLR @>6004 Set ROM3 page + XML RROLL RIGHT ROLL ASSEMBLY + DST @PAD,@PAD4 Save ROLL REPETITION + DCLR @PAD2 Screen Address + ST 32,@PAD Space character + DST 24,@FAC Repetition + CLR @>6004 Set ROM3 page + XML VCHAR Disply them + DST @PAD4,@PAD Restore ROLL REPETITION + DDEC @PAD REPETITION-1 + BR SRLOOP 0? No loop + CEQ RPARZ,@CHAT )? + BS RTNLNK Done return + CALL SSNCHK Skip comma, $/# + DCLR @FAC Clear SCREEN ADDRESS + DST @FAC4,@PAD4 Save $ Address + DST @FAC6,@PAD6 Save $ Length + CEQ RPARZ,@CHAT )? + BS SRVAL SHOW IT + CEQ COMMAZ,@CHAT ,? + BR ERRSYN SYNTAX ERROR + CALL SUBLP3 Get TAB + DCZ @FAC 0? + BS SRVAL 0 can not be shifted + DCHE 25,@FAC 25 or higher? + BS ERRBV ERROR BAD VALUE + DEC @FAC1 Adjust for Assembly + CZ @FAC1 0? Avoid DSLL? + BS SRVAL Yes + DSLL 5,@FAC 32*LENGTH +SRVAL DST @FAC,@PAD2 Screen Address + DST @PAD4,@FAC4 String Address + DST @PAD6,@FAC6 Length + CLR @>6004 Set ROM3 page + XML VPUT Put String on screen + BR RTNLNK Done return +********************************************************* +* CALL SCROLLLEFT * +* CALL SCROLLLEFT(repetition,string) * +* CALL SCROLLLEFT(repetition,string,tab) * +********************************************************* +SLEFT DATA SUP + STRI 'SCROLLLEFT' SCROLLLEFT + DATA $+2 + CEQ LPARZ,@CHAT (? + BS SLAGN Normal + DST 1,@PAD Defualt 1 line + CLR @>6004 Set ROM3 page + XML LROLL RIGHT ROLL ASSEMBLY + DST 31,@PAD2 Screen Address + ST 32,@PAD Space + DST 24,@FAC Repetition + CLR @>6004 Set ROM3 page + XML VCHAR Disply them + BR PEEK6 Done +SLAGN CALL SUBLP3 Skip comma,REPETITION + DCZ @FAC 0? + BS ERRBV ERROR BAD VALUE + DST @FAC,@PAD REPETITION +SLLOOP CLR @>6004 Set ROM3 page + XML LROLL RIGHT ROLL ASSEMBLY + DST @PAD,@PAD4 Save ROLL REPETITION + DST 31,@PAD2 Screen Address + ST 32,@PAD Space + DST 24,@FAC Repetition + CLR @>6004 Set ROM3 page + XML VCHAR Disply them + DST @PAD4,@PAD Restore ROLL REPETITION + DDEC @PAD REPETITION-1 + BR SLLOOP 0? No loop + CEQ RPARZ,@CHAT )? + BS RTNLNK Done + CALL SSNCHK Skip comma, $/# + DST 31,@FAC Top row + DST @FAC4,@PAD4 Save $ Address + DST @FAC6,@PAD6 Save $ Length + CEQ RPARZ,@CHAT )? + BS SLVAL2 SHOW IT + CEQ COMMAZ,@CHAT ,? + BR ERRSYN SYNTAX ERROR + CALL SUBLP3 Get TAB + DCZ @FAC 0? + BS SRVAL 0 can not be shifted + DCHE 25,@FAC 25 or higher? + BS ERRBV ERROR BAD VALUE + DEC @FAC1 Adjust for Assembly + DSLL 5,@FAC 32*LENGTH +SLVAL DADD 31,@FAC Right side of screen +SLVAL2 DST @FAC,@PAD2 Screen Address + DST @PAD4,@FAC4 String Address + DST @PAD6,@FAC6 Length + CLR @>6004 Set ROM3 page + XML VPUT Put String on screen + BR RTNLNK Done return +********************************************************* +* CALL SCROLLUP * +* CALL SCROLLUP(repetition,string) * +* CALL SCROLLUP(repetition,string,tab) * +********************************************************* +SUP DATA SDOWN + STRI 'SCROLLUP' SCROLLU + DATA $+2 + CEQ LPARZ,@CHAT (? + BS SUAGN Normal + DST 1,@PAD Defualt 1 line + CLR @>6004 Set ROM3 page + XML UROLL UP ROLL ASSEMBLY + DST 736,@PAD2 Screen Address + ST 32,@PAD Space + DST 32,@FAC Repetition + CLR @>6004 Set ROM3 page + XML HCHAR Disply them + BR PEEK6 Done +SUAGN CALL SUBLP3 Skip comma,REPETITION + DCZ @FAC 0? + BS ERRBV ERROR BAD VALUE + DST @FAC,@PAD REPETITION +SULOOP CLR @>6004 Set ROM3 page + XML UROLL UP ROLL ASSEMBLY + DST @PAD,@PAD4 Save ROLL REPETITION + DST 736,@PAD2 Screen Address + ST 32,@PAD Space + DST 32,@FAC Repetition + CLR @>6004 Set ROM3 page + XML HCHAR Disply them + DST @PAD4,@PAD Restore ROLL REPETITION + DDEC @PAD REPETITION-1 + BR SULOOP 0? No loop + CEQ RPARZ,@CHAT )? + BS RTNLNK Done + CALL SSNCHK Skip comma, $/# + DCLR @FAC Clear SCREEN ADDRESS + DST @FAC4,@PAD4 Save $ Address + DST @FAC6,@PAD6 Save $ Length + CEQ RPARZ,@CHAT )? + BS SUVAL SHOW IT + CEQ COMMAZ,@CHAT ,? + BR ERRSYN SYNTAX ERROR + CALL SUBLP3 Get TAB + DCZ @FAC 0? + BS SUVAL 0 can not be shifted + DCHE 33,@FAC 32 or higher? + BS ERRBV ERROR BAD VALUE + DEC @FAC1 Adjust for Assembly + DST 736,@PAD2 ROW 24 +SUVAL DADD @FAC,@PAD2 Screen Address+TAB + DST @PAD4,@FAC4 String Address + DST @PAD6,@FAC6 Length + CLR @>6004 Set ROM3 page + XML HPUT Put String on screen + BR RTNLNK Done return +********************************************************* +* CALL SCROLLDOWN * +* CALL SCROLLDOWN(repetion,string) * +* CALL SCROLLDOWN(repetition,string,tab) * +********************************************************* +SDOWN DATA ROLLR + STRI 'SCROLLDOWN' SCROLLD + DATA $+2 + CEQ LPARZ,@CHAT (? + BS SDAGN Normal + DST 1,@PAD Defualt 1 line + CLR @>6004 Set ROM3 page + XML DROLL RIGHT ROLL ASSEMBLY + DCLR @PAD2 Screen Address + ST 32,@PAD Space + DST 32,@FAC Repetition + CLR @>6004 Set ROM3 page + XML HCHAR Disply them + BR PEEK6 Done +SDAGN CALL SUBLP3 Skip comma,REPETITION + DCZ @FAC 0? + BS ERRBV ERROR BAD VALUE + DST @FAC,@PAD REPETITION +SDLOOP CLR @>6004 Set ROM3 page + XML DROLL RIGHT ROLL ASSEMBLY + DST @PAD,@PAD4 Save ROLL REPETITION + DCLR @PAD2 Screen Address + ST 32,@PAD Space + DST 32,@FAC Repetition + CLR @>6004 Set ROM3 page + XML HCHAR Disply them + DST @PAD4,@PAD Restore ROLL REPETITION + DDEC @PAD REPETITION-1 + BR SDLOOP 0? No loop + CEQ RPARZ,@CHAT )? + BS RTNLNK Done + CALL SSNCHK Skip comma, $/# + DCLR @FAC Clear SCREEN ADDRESS + DST @FAC4,@PAD4 Save $ Address + DST @FAC6,@PAD6 Save $ Length + CEQ RPARZ,@CHAT )? + BS SDVAL SHOW IT + CEQ COMMAZ,@CHAT ,? + BR ERRSYN SYNTAX ERROR + CALL SUBLP3 Get TAB + DCZ @FAC 0? + BS SDVAL 0 can not be shifted + DCHE 33,@FAC 32 or higher? + BS ERRBV ERROR BAD VALUE + DEC @FAC1 Adjust for Assembly + CZ @FAC1 ROW 0? + BS SDVAL 0 can not be shifted +* ROW 1 COL 1 +SDVAL DST @FAC,@PAD2 Screen Address + DST @PAD4,@FAC4 String Address + DST @PAD6,@FAC6 Length + CLR @>6004 Set ROM3 page + XML HPUT Put String on screen + BR RTNLNK Done return +******************************* +SSNCHK CALL STRFCH Skip COMMA get $ or # + CEQ >65,@FAC2 $? + BS SSNOUT Yes + CLR @FAC11 Select XB FLP + XML XBCNS Convert Number to String + CEQ SPACE,*FAC11 Leading space? + BR SSNGET + INC @FAC11 Supress space out + DEC @FAC12 Shorten length +SSNGET CLR @BYTES + ST @FAC12,@BYTES+1 Length + XML GETSTR Get string + MOVE @BYTES,*FAC11,V*SREF Store in VDP rollout + DST @SREF,@FAC4 VDP rollout address + DST @BYTES,@FAC6 Store length +SSNOUT RTN +********************************************************* +* CALL ROLLRIGHT * +* CALL ROLLRIGHT(repetion) * +********************************************************* +ROLLR DATA ROLLL + STRI 'ROLLRIGHT' ROLLRIGHT + DATA $+2 + CEQ LPARZ,@CHAT (? + BS ROLLRA Normal + DST 1,@PAD Defualt 1 line + CLR @>6004 Set ROM3 page + XML RROLL RIGHT ROLL ASSEMBLY + BR PEEK6 Done +ROLLRA CALL SUBLP3 Get Repetition + DST @FAC,@PAD Save Repetition + DCZ @PAD 0? + BS RTNLNK Done return +RLOOP CLR @>6004 Set ROM3 page + XML RROLL RIGHT ROLL ASSEMBLY + DEC @PAD1 REPETITION-1 + BR RLOOP 0? No loop + BR RTNLNK Done +********************************************************* +* CALL ROLLLEFT * +* CALL ROLLLEFT(repetion) * +********************************************************* +ROLLL DATA ROLLU + STRI 'ROLLLEFT' ROLLLEFT + DATA $+2 + CEQ LPARZ,@CHAT (? + BS ROLLLA Normal + DST 1,@PAD Defualt 1 line + CLR @>6004 Set ROM3 page + XML LROLL RIGHT ROLL ASSEMBLY + BR PEEK6 Done +ROLLLA CALL SUBLP3 Get Repetition + DST @FAC,@PAD Save Repetition + DCZ @PAD 0? + BS RTNLNK Done return +LLOOP CLR @>6004 Set ROM3 page + XML LROLL RIGHT ROLL ASSEMBLY + DEC @PAD1 REPETITION-1 + BR LLOOP 0? No loop + BR RTNLNK Done return +********************************************************* +* CALL ROLLUP * +* CALL ROLLUP(repetion) * +********************************************************* +ROLLU DATA ROLLD + STRI 'ROLLUP' ROLLUP + DATA $+2 + CEQ LPARZ,@CHAT (? + BS ROLLUA Normal + DST 1,@PAD Defualt 1 line + CLR @>6004 Set ROM3 page + XML UROLL RIGHT ROLL ASSEMBLY + BR PEEK6 Done +ROLLUA CALL SUBLP3 Get Repetition + DST @FAC,@PAD Save Repetition + DCZ @PAD 0? + BS RTNLNK Done return +ULOOP CLR @>6004 Set ROM3 page + XML UROLL RIGHT ROLL ASSEMBLY + DEC @PAD1 REPETITION-1 + BR ULOOP 0? No loop + BR RTNLNK Done return +********************************************************* +* CALL ROLLDOWN * +* CALL ROLLDOWN(repetion) * +********************************************************* +ROLLD DATA EXECLK + STRI 'ROLLDOWN' ROLLDOWN + DATA $+2 + CEQ LPARZ,@CHAT (? + BS ROLLDA Normal + DST 1,@PAD Defualt 1 line + CLR @>6004 Set ROM3 page + XML DROLL RIGHT ROLL ASSEMBLY + BR PEEK6 Done +ROLLDA CALL SUBLP3 Get Repetition + DST @FAC,@PAD Save Repetition + DCZ @PAD 0? + BS RTNLNK Done return +DLOOP CLR @>6004 Set ROM3 page + XML DROLL RIGHT ROLL ASSEMBLY + DEC @PAD1 REPETITION-1 + BR DLOOP 0? No loop + BR RTNLNK Done return +*********************************************************** +* CALL POKER(vdpr#,value) * +*********************************************************** +POKER DATA INVS + STRI 'POKER' + DATA $+2 + CALL COMB +POKAGN CALL GETNUM + DCHE 255,@FAC + BS ERRBV + ST @FAC1,@PAD + CALL SUBLP3 + CASE @PAD + BR PREG0 + BR PREG1 + BR PREG2 + BR PREG3 + BR PREG4 + BR PREG5 + BR PREG6 + MOVE 1,@FAC1,#7 + BR POKEND +PREG6 MOVE 1,@FAC1,#6 + BR POKEND +PREG5 MOVE 1,@FAC1,#5 + BR POKEND +PREG4 MOVE 1,@FAC1,#4 + BR POKEND +PREG3 MOVE 1,@FAC1,#3 + BR POKEND +PREG2 MOVE 1,@FAC1,#2 + BR POKEND +PREG1 MOVE 1,@FAC1,#1 + BR POKEND +PREG0 MOVE 1,@FAC1,#0 +POKEND CEQ COMMAZ,@CHAT + BS POKAGN + BR PEEK5 +************************************************************* +* CALL INVERSE(char-number[,...]) * +* CALL INVERSE(ALL) * +************************************************************* +INVS DATA RXBIO + STRI 'INVERSE' + DATA $+2 + CALL COMB * INVERSE(CHAR#) +INVAGN XML PGMCHR * Skip ( + CEQ ALLZ,@CHAT * ALL? + BR INOALL * No + XML SPEED + DATA >00EC * ALL token? + DCLR @FAC * ALL flag for Assembly + BR INVLP * Go ALL option +INOALL XML PARSE * Get Character # + BYTE RPARZ + XML SPEED * CHECK FROM + DATA >021E * 30 TO 159 + DATA >009F + DSLL 3,@FAC * Adjust + DADD >0300,@FAC * Add in Char address +INVLP CLR @>6004 * Set ROM3 page + XML INVERS * ROM 3 INVERSE ASSEMBLY +INVNOK CEQ COMMAZ,@CHAT + BS INVAGN + B LNKRTN +********************************************************* +* CALL IO(type,address,...) * +* CALL IO(type,bits,cru-base,variable,variable,...) * +* CALL IO(type,length,VDP-address,...) * +********************************************************* +RXBIO DATA SXBRUN + STRI 'IO' + DATA $+2 + CALL COMB * IO +IOAGN CALL GETNUM * TYPE 0-6 + CHE >07,@FAC1 * 7 or more error + BS ERRBV * ERROR BAD VALUE + ST @FAC1,@PAD4 * Get TYPE + CALL SUBLP3 * ADDRESS/ + CASE @PAD4 * BITS/BYTES + BR SOG * IO Sound GROM + BR SOV * IO Sound VDP + BR CRUI * IO CRU IN + BR CRUO * IO CRU OUT + BR CSW * IO Cassette Write + BR CSR * IO Cassette Read + BR CSV * IO Cassette Verify +SOG I/O 0,@FAC IO Sound GROM + BR IODONE +SOV I/O 1,@FAC IO Sound VDP + BR IODONE +CRUI CALL CRUSET + I/O 2,@BUFPNT IO CRU IN + XML PGMCHR + CALL SNDER + CALL CLRFAC + ST @PAD,@FAC1 + CALL CIFSND * VARIABLE1 + CHE >09,@PAD4 + BS CRUI16 + BR IODONE +CRUI16 XML PGMCHR + CALL SNDER + CALL CLRFAC + ST @PAD1,@FAC1 + CALL CIFSND * VARIABLE2 + BR IODONE +CRUO CALL CRUSET + CALL SUBLP3 * VARIABLE1 + DCHE >0100,@FAC + BS ERRBV + CHE >09,@PAD4 + BS CRUO16 + ST @FAC1,@PAD + BR CRUO8 +CRUO16 DST @FAC,@PAD + CALL SUBLP3 * VARIABLE2 + DCHE >0100,@FAC + BS ERRBV + ST @FAC1,@PAD1 +CRUO8 I/O 3,@BUFPNT IO CRU OUT + BR IODONE +CSW CALL CSLOAD + I/O 4,@BUFPNT IO Cassette Write + BR IODONE +CSR CALL CSLOAD + I/O 5,@BUFPNT IO Cassette Read + BR IODONE +CSV CALL CSLOAD + I/O 6,@BUFPNT IO Cassette Verify +IODONE CEQ COMMAZ,@CHAT + BS IOAGN + B LNKRTN +CRUTMP DST @FAC,@BUFPNT + DCLR @VAR5 + DCLR @PAD + RTN +CRUSET CZ @FAC1 + BS ERRBV + CHE >11,@FAC + BS ERRBV + ST @FAC1,@PAD4 + CALL SUBLP3 * CRU-ADDRESS + CALL CRUTMP + ST @PAD4,@VAR5 + RTN +CSLOAD CALL CRUTMP + CALL SUBLP3 * ADDRESS + DST @FAC,@VAR5 + RTN +********************************************************** +* CALL XB * +* CALL XB("PATHNAME") * +* CALL XB("PATHNAME",file#) * +********************************************************** +SXBRUN DATA SFILES + STRI 'XB' * CALL XB(pathname) + DATA XBPGM +XBPGM CALL CLSALL Close all open files + CZ @CHAT ? + BR XBRUN NO, XBRUN PATH + B RXBRUN Run it +* CALL XB("PATHNAME") +XBRUN CALL COMB (? + CALL STRGET Skip ( and get $ +XBFIL DCZ @FAC6 Zero string length? + BS WRNNPP NO PROGRAM PRESENT + CLR V@>2254 Clear buffer + MOVE 50,V@>2254,V@>2255 Ripple clear + DST >994A,V@>2254 Set flag + ST @FAC7,V@>2256 Save length byte + MOVE @FAC6,V@0(@FAC4),V@>2257 Save string +RXBXBP CEQ COMMAZ,@CHAT Comma? + BR RXBRUN No + CALL RXBFIL Set files +RXBRUN B TOPLEV RUN IT +*********************************************************** +* CALL FILES(number) 0 to 15 * +*********************************************************** +SFILES DATA SSIZE + STRI 'FILES' * FILES + DATA $+2 + CALL COMB * ( + CALL CLSALL * Close all open files + CALL RXBFIL * Set files + BR RXBNEW * Go do a NEW +RXBFIL CALL SUBLP3 * Get Files value + DCZ @FAC * Zero? + BS RXBF0 * Yes, RXB CALL FILES(0) + DCHE 16,@FAC * 16 or more to high + BS ERRBV * Yes, BAD VALUE error + CEQ RPARZ,@CHAT * )? + BR ERRSYN * SYNTAX ERROR + XML PGMCHR * Skip ) + DCLR @FAC2 * Clear + ST @FAC1,@FAC2 * Load file value + DST >0116,V@VROAZ * Set files buffer space + DCHE 256,@PAD * + BR DSRDSS * + ADD >10,@VROAZ+1 * +DSRDSS DST VROAZ,@FAC12 * + CALL LINK * + BYTE >0A * + ST @ERCODE,@PAD2 * + SRL 4,@FAC6 * + CZ @FAC6 * + BR ERRFE * + CEQ >20,@PAD2 * + BS ERRFE * + RTN * +RXBF0 CEQ RPARZ,@CHAT * )? + BR ERRSYN * SYNTAX ERROR + XML PGMCHR * Skip ) + DST >3DE9,@>8370 * Set FILE(0) VDP Highest address + RTN * Return +************************************************************ +* CALL SIZE * +************************************************************ +SSIZE DATA VDPSTK + STRI 'SIZE' SIZE + DATA $+2 +SZSIZE EQU >65C8 + B SZSIZE CALL SIZE +*********************************************************** +* CALL VDPSTACK(address) * +*********************************************************** +VDPSTK DATA UP24K + STRI 'VDPSTACK' + DATA $+2 + CALL COMB * ( + CALL SUBLP3 * Get address + DCHE @>8370,@FAC * Highest possible address + BS ERRSO * ERROR STACK OVERFLOW + DST @FAC,@>836E * Save VDP Stack address + DST @FAC,@>8324 * Save VDP Stack address +ENDRTN CEQ RPARZ,@CHAT * )? + BR ERRSYN * Syntax Error + XML PGMCHR * Skip ")" +EXTRTN B RXBNEW * End program, files, reset +*********************************************************** +* CALL PRAM(start-address,end-address) * +*********************************************************** +UP24K DATA CLOSEA + STRI 'PRAM' + DATA $+2 + CZ @RAMTOP * CONSOLE ONLY? + BS RTNLNK * Yes, do not run + CALL COMB * ( + CALL GETNUM * Get START address + DST @FAC,@PAD * SAVE START + DCHE >A000,@PAD * LOW LIMIT >A000 + BR ERRBV * ERROR BAD VALUE + CALL SUBLP3 * Get END address + DCHE >A000,@FAC * LOW LIMIT + BR ERRBV * ERROR BAD VALUE + DST @PAD,@RAMTOP * LOAD START ADDRESS + DST @RAMTOP,@RAMFRE * PROGRAM FREE ADDRESS + DST @FAC,V@PMEM * LOAD END ADDRESS + BR ENDRTN +*********************************************************** +* CALL CLSALL * +*********************************************************** +CLOSEA DATA NEWNEW + STRI 'CLSALL' CLSALL + DATA $+2 + CALL CLSALL Close all open files + BR PEEK6 +*********************************************************** +* CALL NEW * +*********************************************************** +NEWNEW DATA QTON + STRI 'NEW' NEW + DATA $+2 +RXBNEW CLR V@LODFLG Clear AUTOLOAD flag + CALL CLSALL +NEWSZ B SZNEW +*********************************************************** +* CALL QUITON * +*********************************************************** +QTON DATA QTOFF + STRI 'QUITON' + DATA QTON1 +QTON1 AND >EF,@GKFLAG Reset QUIT bit + B LDRET2 Return +*********************************************************** +* CALL QUITOFF * +*********************************************************** +QTOFF DATA BASIC + STRI 'QUITOFF' + DATA QTOFF1 +QTOFF1 OR >10,@GKFLAG Set QUIT bit + BR LDRET2 Return +******************************************************** +* CALL BASIC * +******************************************************** +BASIC DATA SEARUN + STRI 'BASIC' + DATA $+2 + CALL CLSALL * Close all files + CLR V@0 + MOVE >3FFF,V@0,V@1 * Clear 4K VDP +SBASIC EQU >216E + B SBASIC * GO TO BASIC +********************************************************* +* CALL EA * +********************************************************* +SEARUN DATA BYEBYE + STRI 'EA' * EA menu + DATA $+2 + CALL CLSALL Close all open files + CLR V@0 + MOVE >3FFF,V@0,V@1 Clear 4K VDP + B GE025 Got to EA CART +*********************************************************** +* CALL BYE * +*********************************************************** +BYEBYE DATA CALPHA + STRI 'BYE' BYE + DATA $+2 + CALL CLSALL Close all open files + EXIT +*********************************************************** +* CALL ALPHALOCK(numeric-variable) * +*********************************************************** +CALPHA DATA VERSN + STRI 'ALPHALOCK' + DATA $+2 + CALL COMB Insure have left parenthesis + XML PGMCHR Skip ( + CALL SNDER Get variable info + CLR @>6004 Set ROM 3 page + XML ALPHA Check ALPHA LOCK KEY + CALL CIFSND Convert to floating point +* Assign and return to caller + B LNKRTN +*********************************************************** +* SUBPROGRAM FOR VERSION * +*********************************************************** +* CALL VERSION(numeric-variable) * +*********************************************************** +VERSN DATA >0000 + STRI 'VERSION' + DATA $+2 + CALL COMB Insure have left parenthesis + XML PGMCHR Skip ( + CALL SNDER Get variable info + DST 2024,@FAC 11/29/2023 + CALL CIFSND Convert to floating point +* Assign and return to caller + B LNKRTN +************************************************************** + + END diff --git a/xas99.py b/xas99.py index 0334e2d..7ab9916 100755 --- a/xas99.py +++ b/xas99.py @@ -2,7 +2,7 @@ # xas99: A TMS9900 cross-assembler # -# Copyright (c) 2015-2023 Ralph Benzinger +# Copyright (c) 2015-2024 Ralph Benzinger # # This program is part of the TI 99 Cross-Development Tools (xdt99). # @@ -29,7 +29,7 @@ from xcommon import Util, RFile, CommandProcessor, Warnings, Console -VERSION = '3.6.4' +VERSION = '3.6.5' CONFIG = 'XAS99_CONFIG' @@ -1646,6 +1646,9 @@ def index(self, op): index = op.rindex('(') except ValueError: return None, None + if index == 0: # treating @(Rn) is expression @n! + self.console.warn('Treating as symbol expression, did you intend register index?', + category=Warnings.BAD_USAGE) # if op is an expression, there is an operator before the '(' i = index - 1 while i >= 0 and op[i] == ' ': @@ -1690,7 +1693,10 @@ def expression(self, expr, well_defined=False, absolute=False, relaxed=False, io if op == ')': v = value.value reloc = reloc_count - value, reloc_count, op, negate, complement_correction = stack.pop() + try: + value, reloc_count, op, negate, complement_correction = stack.pop() + except IndexError: + raise AsmError('Syntax error') else: # unary operators while not term and i < len(terms) and terms[i] in '+-~(': @@ -1799,6 +1805,8 @@ def check_arith_precedence(self, operators, i=2): violation, i = self.check_arith_precedence(operators, i + 2) if violation: return True, None + elif i is None: + return False, None else: possible_sign = False # no sign after ')' continue @@ -1903,7 +1911,7 @@ def register(self, op, well_defined=False): if r is None or isinstance(r, Address): raise ValueError # unknown symbol except (TypeError, ValueError): - raise AsmError('Invalid register:' + op) + raise AsmError('Invalid register: ' + op) if self.r_prefix and not isalias and op[0].upper() != 'R' and self.symbols.pass_no > 1: self.console.warn(f'Treating {op} as register, did you intend an @address?', category=Warnings.BAD_USAGE) if not 0 <= r <= 15: @@ -3298,7 +3306,7 @@ def _format(self, message, pass_no, filename, lino, line, error=False): """format info and error message""" text = 'Error' if error else 'Warning' s_filename = filename or '***' - s_pass = pass_no if isinstance(pass_no, str) else str(pass_no) or '-' + s_pass = pass_no if isinstance(pass_no, str) else str(pass_no) or '*' s_lino = f'{lino:04d}' if lino is not None else '****' s_line = line or '' return f'> {s_filename} <{s_pass}> {s_lino} - {s_line}', f'***** {text:s}: {message}' diff --git a/xbas99.py b/xbas99.py index 85371ef..4fe373e 100755 --- a/xbas99.py +++ b/xbas99.py @@ -2,7 +2,7 @@ # xbas99: TI BASIC and TI Extended BASIC tool # -# Copyright (c) 2015-2023 Ralph Benzinger +# Copyright (c) 2015-2024 Ralph Benzinger # # This program is part of the TI 99 Cross-Development Tools (xdt99). # diff --git a/xda99.py b/xda99.py index f53e176..b71df46 100755 --- a/xda99.py +++ b/xda99.py @@ -2,7 +2,7 @@ # xda99: TMS9900 disassembler # -# Copyright (c) 2017-2023 Ralph Benzinger +# Copyright (c) 2017-2024 Ralph Benzinger # # This program is part of the TI 99 Cross-Development Tools (xdt99). # diff --git a/xdg99.py b/xdg99.py index 5863b76..eed989e 100755 --- a/xdg99.py +++ b/xdg99.py @@ -2,7 +2,7 @@ # xgd99: A GPL disassembler # -# Copyright (c) 2017-2023 Ralph Benzinger +# Copyright (c) 2017-2024 Ralph Benzinger # # This program is part of the TI 99 Cross-Development Tools (xdt99). # diff --git a/xdm99.py b/xdm99.py index cd589b1..7a4a904 100755 --- a/xdm99.py +++ b/xdm99.py @@ -2,7 +2,7 @@ # xdm99: A disk manager for TI disk images # -# Copyright (c) 2015-2023 Ralph Benzinger +# Copyright (c) 2015-2024 Ralph Benzinger # # This program is part of the TI 99 Cross-Development Tools (xdt99). # diff --git a/xga99.py b/xga99.py index 2c20da3..401dc6c 100755 --- a/xga99.py +++ b/xga99.py @@ -2,7 +2,7 @@ # xga99: A GPL cross-assembler # -# Copyright (c) 2015-2023 Ralph Benzinger +# Copyright (c) 2015-2024 Ralph Benzinger # # This program is part of the TI 99 Cross-Development Tools (xdt99). # @@ -28,7 +28,7 @@ from xcommon import CommandProcessor, RFile, Util, Warnings, Console -VERSION = '3.6.1' +VERSION = '3.6.5' CONFIG = 'XGA99_CONFIG' @@ -419,7 +419,7 @@ def process(asm, label, mnemonic, operands): class Symbols: """symbol table and line counter""" - def __init__(self, definitions=None): + def __init__(self, definitions=None, ryte_symbols=False): self.symbols = {} # name: (value, used) self.symbol_def_location = {} # symbol definition location (lino, filename) self.updated = False # has at least one value changed? @@ -453,8 +453,55 @@ def __init__(self, definitions=None): 'VPAB': 0x8356, 'VSTACK': 0x836e } + self.ryte_data_defs = { + 'ACCTON': 0x0034, + 'ATN': 0x0032, + 'BADTON': 0x0036, + 'BITREV': 0x003B, + 'CFI': 0x0012, + 'CNS': 0x0014, + 'COS': 0x002c, + 'CSN': 0x0010, + 'DIVZER': 0x0001, + 'ERRIOV': 0x0003, + 'ERRLOG': 0x0006, + 'ERRNIP': 0x0005, + 'ERRSNN': 0x0002, + 'ERRSQR': 0x0004, + 'EXPF': 0x0028, + 'FADD': 0x0006, + 'FCOMP': 0x000a, + 'FDIV': 0x0009, + 'FMUL': 0x0008, + 'FSUB': 0x0007, + 'GETSPACE': 0x0038, + 'INT': 0x0022, + 'LINK': 0x0010, + 'LOCASE': 0x0018, + 'LOG': 0x002a, + 'MEMSIZ': 0x8370, + 'NAMLNK': 0x003d, + 'PAD': 0x8300, + 'PWR': 0x0024, + 'RETURN': 0x0012, + 'SADD': 0x000b, + 'SCOMP': 0x000f, + 'SDIV': 0x000e, + 'SIN': 0x002e, + 'SMUL': 0x000d, + 'SOUND': 0x8400, + 'SQR': 0x0026, + 'SSUB': 0x000c, + 'STCASE': 0x0016, + 'TAN': 0x0030, + 'TRIGER': 0x0007, + 'UPCASE': 0x004a, + 'WRNOV': 0x0001 + } if definitions: self.add_env(definitions) + if ryte_symbols: + self.definitions.update(self.ryte_data_defs) def reset(self): self.updated = False @@ -603,6 +650,7 @@ def get(style): (r'^HCHA\b', 'HCHAR'), (r'^VCHA\b', 'VCHAR'), (r'^SCRO\b', 'BIAS'), + (r'^CARR\b', 'CARRY'), (r'&([01]+)', r':\1'), (r'^IDT\b', 'TITLE'), # RAG (r'^IO\b', 'I/O'), @@ -824,12 +872,13 @@ def __init__(self, mnemonic, lino=0, lidx=0, label=None, operands=(), line=None, class Parser: """scanner and parser class""" - def __init__(self, symbols, console, syntax, path, includes=None, relaxed=False): + def __init__(self, symbols, console, syntax, path, includes=None, strict=False, relaxed=False): self.symbols = symbols self.console = console self.syntax = Syntax.get(syntax) self.path = self.initial_path = path # current file path, used for includes self.includes = includes or [] # do not include '.' + self.strict = strict self.relaxed = relaxed self.prep = Preprocessor(self) self.text_literals = [] @@ -937,7 +986,6 @@ def lines(self): def intermediate_lines(self): """return preprocessed source code""" - #lino, line, filename, self.parser.path, self.symbols.lidx, for imline in self.intermediate_source: self.lino = imline.lino self.srcline = imline.line @@ -950,23 +998,42 @@ def line(self, line): """parse single source line""" if not line or line[0] == '*': return None, None, None, None, False - instruction, *line_comment = self.escape(line).split(';', maxsplit=1) - comment = line_comment[0] if line_comment else '' - label, *remainder = re.split(r'\s+', instruction, maxsplit=1) - instrtext = remainder[0] if remainder else '' - # convert to native syntax - for pat, repl in self.syntax.repls: - instrtext = re.sub(pat, repl, instrtext) - # analyze instruction - mnemonic, *opsremainder = re.split(r'\s+', instrtext, maxsplit=1) - opfield = opsremainder[0] if opsremainder else '' - # operands - if self.relaxed: - operands = [op.strip() for op in opfield.split(',')] if opfield else [] - else: # opfield may still contain non-delimited comments - optext, *inl_comments = re.split(r' {2,}|\t', opfield, maxsplit=1) - operands = [op.strip() for op in optext.split(',')] if optext else [] - comment = ' '.join(inl_comments) + comment + if self.strict: + if line.lstrip()[:1] == '*': + return None, None, None, None, False + label, *parts = re.split(r'\s+', self.escape(line)) + mnem, ops, *cparts = parts + ['', ''] + if ops == '*': + # '*' followed by space is start of comment + comment = ''.join([ops, *cparts]) + instrtext = mnem + else: + comment = ''.join(cparts) + instrtext = (mnem + ' ' + ops) if ops else mnem + # convert to native syntax + for pat, repl in self.syntax.repls: + instrtext = re.sub(pat, repl, instrtext) + # analyze instruction + mnemonic, *ops = re.split(r'\s+', instrtext) + operands = ops[0].split(',') if ops else [] + else: + instruction, *line_comment = self.escape(line).split(';', maxsplit=1) + comment = line_comment[0] if line_comment else '' + label, *remainder = re.split(r'\s+', instruction, maxsplit=1) + instrtext = remainder[0] if remainder else '' + # convert to native syntax + for pat, repl in self.syntax.repls: + instrtext = re.sub(pat, repl, instrtext) + # analyze instruction + mnemonic, *opsremainder = re.split(r'\s+', instrtext, maxsplit=1) + opfield = opsremainder[0] if opsremainder else '' + # operands + if self.relaxed: + operands = [op.strip() for op in opfield.split(',')] if opfield else [] + else: # opfield may still contain non-delimited comments + optext, *inl_comments = re.split(r' {2,}|\t', opfield, maxsplit=1) + operands = [op.strip() for op in optext.split(',')] if optext else [] + comment = ' '.join(inl_comments) + comment return label, mnemonic, operands, comment, True def escape(self, text): @@ -1342,20 +1409,21 @@ def __init__(self, grom, offset, code): class Assembler: """generate GPL virtual machine code""" - def __init__(self, syntax, grom, aorg, target, path, includes=None, definitions=(), relaxed=False, debug=False, - console=None): + def __init__(self, syntax, grom, aorg, target, path, includes=None, definitions=(), strict=False, relaxed=False, + ryte_symbols=False, debug=False, console=None): self.syntax = syntax self.includes = includes self.grom = grom self.offset = aorg + self.strict = strict self.relaxed = relaxed self.debug_passes = debug self.target = target self.program = Program() - self.symbols = Symbols(definitions) + self.symbols = Symbols(definitions, ryte_symbols=ryte_symbols) self.console = console or Xga99Console() - self.parser = Parser(self.symbols, self.console, syntax=self.syntax, relaxed=relaxed, path=path, - includes=self.includes) + self.parser = Parser(self.symbols, self.console, syntax=self.syntax, strict=strict, relaxed=relaxed, + path=path, includes=self.includes) self.console.set_parser(self.parser) self.listing = Listing() self.segment = None @@ -1498,7 +1566,8 @@ def finalize(self): self.segment.LC = self.symbols.LC for fn, symbols in self.symbols.get_unused_symbols().items(): symbols_text = ', '.join(symbols) - self.console.warn('Unused constants: ' + symbols_text.lower(), filename=fn, nopos=True, force=True) + self.console.warn('Unused constants: ' + (symbols_text.upper() if self.strict else symbols_text.lower()), + filename=fn, nopos=True, force=True) @staticmethod def get_target(cart, text): @@ -1785,8 +1854,8 @@ def error(self, message, nopos=False): def _format(self, message, pass_no, filename, lino, line, error=False): """print all console messages to stderr""" text = 'Error' if error else 'Warning' - s_filename = filename or '---' - s_pass = str(pass_no) if pass_no is not None else '-' + s_filename = filename or '***' + s_pass = str(pass_no) if pass_no is not None else '*' s_lino = f'{lino:04d}' if lino is not None else '****' s_line = line or '' return f'> {s_filename} <{s_pass}> {s_lino} - {s_line}', f'***** {text:s}: {message}' @@ -1903,6 +1972,8 @@ def parse(self): help='create MAME cartridge image with auto GPL header') cmd.add_argument('-t', '--text', dest='text', nargs='?', metavar='', help='create text file with binary values') + args.add_argument('-s', '--strict', action='store_true', dest='strict', + help='use strict syntax, disable xga99 extensions') args.add_argument('-n', '--name', dest='name', metavar='', help='set program name') args.add_argument('-B', '--fully-padded', action='store_true', dest='pad', @@ -1927,6 +1998,8 @@ def parse(self): help='add symbol table to listing file') args.add_argument('-E', '--symbol-file', dest='equs', metavar='', help='put symbols in EQU file') + args.add_argument('-R', '--ryte-data-symbols', action='store_true', dest='rytesyms', + help='add Ryte Data symbols') args.add_argument('-q', '--quiet', action='store_true', dest='quiet', help='quiet; do not show warnings') args.add_argument('--color', action='store', dest='color', choices=['off', 'on'], @@ -1966,7 +2039,9 @@ def run(self): path=dirname, includes=includes, definitions=Util.get_opts_list(self.opts.defs), + strict=self.opts.strict, relaxed=self.opts.relaxed, + ryte_symbols=self.opts.rytesyms, debug=self.opts.debug, console=self.console) self.asm.assemble(basename) diff --git a/xhm99.py b/xhm99.py index a0cf3ab..266756b 100755 --- a/xhm99.py +++ b/xhm99.py @@ -2,7 +2,7 @@ # xhm99: An HFE image manager that focuses on the TI 99 # -# Copyright (c) 2016-2023 Ralph Benzinger +# Copyright (c) 2016-2024 Ralph Benzinger # # This program is part of the TI 99 Cross-Development Tools (xdt99). # diff --git a/xvm99.py b/xvm99.py index 8e4913f..3781620 100755 --- a/xvm99.py +++ b/xvm99.py @@ -2,7 +2,7 @@ # xvm99: A volume manager for nanoPEB/CF7A flash cards # -# Copyright (c) 2015-2023 Ralph Benzinger +# Copyright (c) 2015-2024 Ralph Benzinger # # This program is part of the TI 99 Cross-Development Tools (xdt99). #